!!------------------------------------------------------------------------------
!! MODULE SYS
!!------------------------------------------------------------------------------
!! 26.11.02 M. Zolliker
!!
!! System dependent subroutines for unix
!!------------------------------------------------------------------------------
!!
	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

!!-----------------------------------------------------------------------------
!!
	subroutine SYS_DATE(YEAR, MONTH, DAY) !!
!!      -------------------------------------
!!
!! get actual date
!!
	integer YEAR, MONTH, DAY !! 4-Digits year, month and day

	integer darray(3)
	external idate

	call idate(darray)
	day=darray(1)
	month=darray(2)
	year=darray(3)
	end

!!-----------------------------------------------------------------------------
!!
	subroutine SYS_GET_CMDPAR(STR, L)	!!
!!	---------------------------------
!!
	character*(*) STR !!
	integer L	!!

        integer i,iargc
        
	l=0
	str=' '
	do i=1,iargc()
	  if (l .lt. len(str)) then
	    call getarg(i, str(l+1:))
	    call str_trim(str, str, l)
	    l=l+1
	  endif
	enddo
	if (l .gt. 0) then
	  if (str(1:l) .eq. ' ') l=0
	endif
	end

!!-----------------------------------------------------------------------------
!!
	subroutine SYS_REMOTE_HOST(STR, TYPE) !!
!!
!! get remote host name/number
!!
!! type: TN telnet, RT: decnet, LO: local, XW: X-window (ssh or telnet)
!!
	character STR*(*), TYPE*(*) !!

	character host*128, line*128, path*256, os*7
	integer i,j,lun,iostat

	integer system
	external system

	call sys_getenv('OS', os)
	if (os .eq. 'Windows') then
	  str='local'
	  type='LO'
	  return
	endif
	call sys_getenv('HOST', host)
	call sys_getenv('DISPLAY', str)
	i=index(str,':')
	type=' '
	if (i .gt. 1) then
	  str=str(1:i-1)
	  type='XW'
	  if (str .ne. 'localhost') goto 80 
	endif
	call sys_getenv('REMOTEHOST', str)
        if (str .eq. ' ') then
          call sys_temp_name('.whoami', path)
          call sys_delete_file(path)
	  i=system('who -m > '//path)
          call sys_get_lun(lun)
          call sys_open(lun, path, 'r', iostat)
          if (iostat .ne. 0) goto 9
          read(lun,'(a)',end=9,err=9) line
9         close(lun)
          call sys_delete_file(path)
          i=index(line,'(')
          if (i .ne. 0 .and. i .lt. len(line)) then
            str=line(i+1:)
            i=index(str, ')')
            if (i .ne. 0) str(i:)=' '
          endif
        endif
	i=index(str,':')
	if (i .ne. 0) str(i:)=' '
	if (str .ne. ' ') then
	  if (type .eq. ' ') type='TN'
	else
	  str=host
	  type='LO'
	endif

c   add domain to short host names
80	i=index(str, '.') 
	j=index(host, '.')
	if (j .gt. 0 .and. i .eq. 0) then
	  call str_trim(str, str, i)
	  str(i+1:)=host(j:)
	endif
	end

!!-----------------------------------------------------------------------------
!!
	subroutine SYS_GET_LUN(LUN)    !!
!!
!! allocate logical unit number

	integer LUN     !! out

	logical*1 act(50:100)/51*.false./
	save act

	integer l

	l=50
	do while (l .lt. 99 .and. act(l))
	  l=l+1
	enddo
	if (l .eq. 100) stop 'SYS_GET_LUN: no more luns available'
	lun=l
	act(l)=.true.
	return
!!
	entry SYS_FREE_LUN(LUN)        !!
!!
!! deallocate logical unit number

	if (act(lun)) then
	  act(lun)=.false.
	else
	  stop 'SYS_FREE_LUN: lun already free'
	endif
	end

!!-----------------------------------------------------------------------------
!!
	subroutine SYS_TEMP_NAME0(NAME, PATH) !!
!!	====================================
!! get a temporary file name (disabled)
!!
	character*(*) NAME !! (in) name
	character*(*) PATH !! (out) path

	character line*64, pid*12, user*64
	integer i, l

	integer getppid

	call sys_getenv('USER', user)
	line(1:6)='/tmp/.'
	line(7:)=name
	call str_trim(line, line, l)
	if (user .ne. ' ') then
	  line(l+1:)='_'//user
	  call str_trim(line, line, l)
	endif
	write(pid,'(i12)') getppid()
	i=1
1	if (pid(i:i) .eq. ' ') then
	  i=i+1
	  goto 1
	endif
	path=line(1:l)//'.'//pid(i:12)
	end

!!-----------------------------------------------------------------------------
!!
!	subroutine SYS_LOAD_ENV(FILE) !!
!!	=============================
!! load environment from temporary file
!!
!	character*(*) FILE !! filename
!
!	character path*128, line*128
!	integer lun, i, l, iostat
!
!	integer getppid
!
!	call sys_temp_name(file, path)
!	call sys_get_lun(lun)
!	call sys_open(lun, path, 'r', iostat)
!	if (iostat .ne. 0) goto 9
!5	read(lun,'(a)',end=8) line
!	call str_trim(line, line, l)
!	i=index(line,'=')
!	if (i .eq. 0) then
!	  if (l .gt. 0) call sys_setenv(line(1:l), ' ')
!	elseif (i .gt. 1 .and. i .lt. l) then
!	  call sys_setenv(line(1:i-1),line(i+1:l))
!	endif	  
!	goto 5
!8	close(lun)
!9	call sys_free_lun(lun)
!	end
!
!!-----------------------------------------------------------------------------
!!
	subroutine SYS_SAVE_ENV(FILE, NAMES, N_NAMES) !!
!!	=============================================
!! save environment on temporary file
!!
	character*(*) FILE      !! filename
	integer N_NAMES         !! number of names
	character*(*) NAMES(N_NAMES)    !! names of variables to save

	character path*128, line*128
	integer lun, i, j, l, iostat

	call sys_temp_name(file, path)
	call sys_get_lun(lun)

	call sys_open(lun, path, 'wo', iostat)
	if (iostat .ne. 0) goto 19

	do i=1,n_names
	  call sys_getenv(names(i), line)
	  call str_trim(names(i),names(i), j)
	  call str_trim(line,line, l)
	  write(lun,'(3a)') names(i)(1:j),'=',line(1:l)
	enddo

	close(lun)
9	call sys_free_lun(lun)
	return

19	print *,'SYS_SAVE_ENV: can not open tmp. file'
	goto 9
	end

!!-----------------------------------------------------------------------------
!!
	subroutine SYS_WAIT(SECONDS)	!!
!!      ============================
!! wait for SECONDS
	real SECONDS !! resolution should be better than 0.1 sec.

	real tim, del

	tim=secnds(0.0)
1	del=seconds-secnds(tim)
	if (del .ge. 0.999) then
	  call sleep(int(del))
	  goto 1
	endif
	if (del .gt. 0) then	
	  call usleep(int(del*1E6))
	  goto 1
	endif
	end

!!-----------------------------------------------------------------------------
!!
	subroutine SYS_RENAME_FILE(OLD, NEW)      !!
!!      ====================================
!!
	character OLD*(*), NEW*(*)      !! (in) old, new filename

	call rename(OLD, NEW)
	end

!!-----------------------------------------------------------------------------
!!
	subroutine SYS_DELETE_FILE(NAME)      !!
!!      ================================
!!
	character NAME*(*)      !! (in) filename

	call unlink(NAME)
	end

!!-----------------------------------------------------------------------------
!!
	subroutine SYS_HOME(HOME)   !!
!!      =========================
!!
!! get home directory (+ dot)

	character HOME*(*)      !! (out) filename

	integer l

	call sys_getenv('HOME',home)
	call str_trim(home, home, l)
	if (l .lt. len(home)-1) then
	  if (home(l:l) .ne. '/') then
	    home(l+1:l+1)='/'
	    l=l+1
	  endif
	  home(l+1:l+1)='.'
	  l=l+1
	endif
	end
