76 lines
1.8 KiB
Fortran
76 lines
1.8 KiB
Fortran
!!------------------------------------------------------------------------------
|
|
!!
|
|
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
|