MICROCERN/geteni.c

   1 /*
   2  * $Id$
   3  *
   4  * $Log$
   5  * Revision 1.2.4.1  2002/11/26 16:46:57  hristov
   6  * Merging NewIO with v3-09-04
   7  *
   8  * Revision 1.2  2002/10/14 14:57:10  hristov
   9  * Merging the VirtualMC branch to the main development branch (HEAD)
  10  *
  11  * Revision 1.1.2.1  2002/07/11 17:15:24  alibrary
  12  * Adding MICROCERN
  13  *
  14  * Revision 1.1.1.1  1999/05/18 15:55:28  fca
  15  * AliRoot sources
  16  *
  17  * Revision 1.3  1997/09/02 14:26:36  mclareni
  18  * WINNT correction
  19  *
  20  * Revision 1.2  1997/02/04 17:34:17  mclareni
  21  * Merge Winnt and 97a versions
  22  *
  23  * Revision 1.1.1.1.2.1  1997/01/21 11:29:27  mclareni
  24  * All mods for Winnt 96a on winnt branch
  25  *
  26  * Revision 1.1.1.1  1996/02/15 17:49:22  mclareni
  27  * Kernlib
  28  *
  29  */
  30 #include "kerngen/pilot.h"
  31 #include "kerngen/fortranc.h"
  32
  33 /*>    ROUTINE GETENI
  34   CERN PROGLIB# Z265    GETENI          .VERSION KERNFOR  4.31  911111
  35   ORIG. 22/02/91, JZ
  36   Fortran interface routine to getenv
  37
  38       CALL GETENVF (NAME, TEXT*)
  39
  40           NAME  the name of the environment variable,
  41           TEXT  returns its value
  42                 ISLATE(1) returns its length
  43 */
  44 #include <stdio.h>
  45 #include <stdlib.h>
  46 #include "kerngen/fortchar.h"
  47 #if defined(CERNLIB_QX_SC)
  48 void type_of_call geteni_(fname, ftext, lgtext, lgname)
  49 #endif
  50 #if defined(CERNLIB_QXNO_SC)
  51 void type_of_call geteni(fname, ftext, lgtext, lgname)
  52 #endif
  53 #if defined(CERNLIB_QXCAPT)
  54 #  ifdef CERNLIB_MSSTDCALL
  55     void type_of_call GETENI(fname, len_fname, ftext, len_ftext, lgtext, lgname)
  56      int len_fname, len_ftext;
  57 #  else
  58     void type_of_call GETENI(fname, ftext, lgtext, lgname)
  59 # endif
  60 #endif
  61 #if defined(CERNLIB_QMCRY)
  62       _fcd  fname,  ftext;
  63 #endif
  64 #if !defined(CERNLIB_QMCRY)
  65       char *fname, *ftext;
  66 #endif
  67       int  *lgtext, *lgname;
  68 {
  69       char *ptname, *fchtak();
  70       char *pttext, *getenv();
  71       int  fchput();
  72
  73       pttext = NULL;
  74       ptname = fchtak(fname,*lgname);
  75       if (ptname == NULL)          goto out;
  76       pttext = getenv (ptname);
  77       free(ptname);
  78
  79 out:  *lgtext = fchput (pttext,ftext,*lgtext);
  80       return;
  81 }
  82 /*> END <----------------------------------------------------------*/