MICROCERN/geteni.c

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