!!------------------------------------------------------------------------------ !! subroutine SYS_GETENV(NAME, VALUE) !! !! ================================== !! !! Get environment variable NAME !! try all uppercase also implicit none !! Arguments: character*(*) NAME !! logical name character*(*) VALUE !! result integer l character nam*128 call sys_loadenv call str_trim(nam, name, l) call getenv(nam(1:l), value) if (value .ne. ' ') RETURN if (nam(1:1) .ge. 'a') then call str_upcase(nam(1:l), nam(1:l)) else call str_lowcase(nam(1:l), nam(1:l)) endif call getenv(nam(1:l), value) end !!------------------------------------------------------------------------------ !! subroutine SYS_GETENV_IDX(NAME, VALUE, IDX) !! !! =========================================== !! !! Get environment variable NAME, only list element IDX (start with 0) !! (separated by comma) implicit none !! Arguments: character*(*) NAME !! logical name character*(*) VALUE !! result integer IDX !! index integer l,pos,j,i character nam*128, list*1024 call str_trim(nam, name, l) call getenv(nam(1:l), list) if (list .eq. ' ') then if (nam(1:1) .ge. 'a') then call str_upcase(nam(1:l), nam(1:l)) else call str_lowcase(nam(1:l), nam(1:l)) endif call getenv(nam(1:l), list) endif pos=0 do i=1,idx j=index(list(pos+1:), ',') if (j .eq. 0) then value=' ' RETURN endif pos=pos+j enddo j=index(list(pos+1:), ',') if (j .eq. 1) then value=' ' RETURN endif if (j .le. 0) then value=list(pos+1:) else value=list(pos+1:pos+j-1) endif end