Initial commit

unix/sys_getenv.f

@@ -0,0 +1,75 @@
+!!------------------------------------------------------------------------------
+!!
+	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