1#include "f2c.h" 2#undef abs 3#ifdef KR_headers 4extern char *F77_aloc(), *getenv(); 5#else 6#include <stdlib.h> 7#include <string.h> 8extern char *F77_aloc(ftnlen, char*); 9#endif 10 11/* 12 * getenv - f77 subroutine to return environment variables 13 * 14 * called by: 15 * call getenv (ENV_NAME, char_var) 16 * where: 17 * ENV_NAME is the name of an environment variable 18 * char_var is a character variable which will receive 19 * the current value of ENV_NAME, or all blanks 20 * if ENV_NAME is not defined 21 */ 22 23#ifdef KR_headers 24 VOID 25G77_getenv_0 (fname, value, flen, vlen) char *value, *fname; ftnlen vlen, flen; 26#else 27 void 28G77_getenv_0 (char *fname, char *value, ftnlen flen, ftnlen vlen) 29#endif 30{ 31 char buf[256], *ep, *fp; 32 integer i; 33 34 if (flen <= 0) 35 goto add_blanks; 36 for(i = 0; i < sizeof(buf); i++) { 37 if (i == flen || (buf[i] = fname[i]) == ' ') { 38 buf[i] = 0; 39 ep = getenv(buf); 40 goto have_ep; 41 } 42 } 43 while(i < flen && fname[i] != ' ') 44 i++; 45 strncpy(fp = F77_aloc(i+1, "getenv_"), fname, (int)i); 46 fp[i] = 0; 47 ep = getenv(fp); 48 free(fp); 49 have_ep: 50 if (ep) 51 while(*ep && vlen-- > 0) 52 *value++ = *ep++; 53 add_blanks: 54 while(vlen-- > 0) 55 *value++ = ' '; 56 } 57