#include "f2c.h" #undef abs #include #include extern char *F77_aloc (ftnlen, char *); /* * getenv - f77 subroutine to return environment variables * * called by: * call getenv (ENV_NAME, char_var) * where: * ENV_NAME is the name of an environment variable * char_var is a character variable which will receive * the current value of ENV_NAME, or all blanks * if ENV_NAME is not defined */ void G77_getenv_0 (char *fname, char *value, ftnlen flen, ftnlen vlen) { char buf[256], *ep, *fp; integer i; if (flen <= 0) goto add_blanks; for (i = 0; i < (integer) sizeof (buf); i++) { if (i == flen || (buf[i] = fname[i]) == ' ') { buf[i] = 0; ep = getenv (buf); goto have_ep; } } while (i < flen && fname[i] != ' ') i++; strncpy (fp = F77_aloc (i + 1, "getenv_"), fname, (int) i); fp[i] = 0; ep = getenv (fp); free (fp); have_ep: if (ep) while (*ep && vlen-- > 0) *value++ = *ep++; add_blanks: while (vlen-- > 0) *value++ = ' '; }