Initial commit

unix/sys1.f

@@ -0,0 +1,126 @@
+!!-----------------------------------------------------------------------------
+!!
+	subroutine sys_parse(result, reslen, file, default, mode) !!
+!!	---------------------------------------------------------
+!!
+!! parse file name
+!! mode=0: skip default directory
+!! mode=1: name only
+!! mode=2: extension only
+!! mode=3: name+extension only
+
+	implicit none
+
+	character*(*) result, file, default
+	integer reslen, mode
+
+	character*1024 dir1, dir2, res
+
+	integer l1,l2,d1,d2,n1,n2,e1,e2
+
+	call sys_split_path(file, d1, n1, e1)
+	call sys_split_path(default, d2, n2, e2)
+
+	reslen=0
+	if (mode .eq. 0) then
+	  if (d1 .gt. 0) then
+	    call sys_realpath(dir1, l1, file(1:max(1,d1-1)))
+	  elseif (d2 .gt. 0) then
+	    call sys_realpath(dir1, l1, default(1:max(1,d2-1)))
+	  else
+	    goto 19
+	  endif
+	  call getcwd(dir2)
+	  call sys_realpath(dir2, l2, dir2)
+	  if (dir1(1:l1) .ne. dir2(1:l2)) then
+	    if (d1 .gt. 0) then
+	      call str_append(res, reslen, file(1:max(1,d1-1)))
+	    elseif (d2 .gt. 0) then
+	      call str_append(res, reslen, default(1:max(1,d2-1)))
+	    else
+	      stop 'SYS_PARSE: fatal error'
+	    endif
+	    if (reslen .gt. 1) then
+	      call str_append(res, reslen, '/')
+	    endif
+	  endif
+19	  continue
+	elseif (mode .lt. 0 .or. mode .gt. 3) then
+	  stop 'SYS_PARSE: illegal mode'
+	endif
+
+	if (mode .ne. 2) then
+	  if (n1 .gt. d1) then
+	    call str_append(res, reslen, file(d1+1:n1))
+	  elseif (n2 .gt. d2) then
+	    call str_append(res, reslen, default(d2+1:n2))
+	  endif
+	endif
+
+	if (mode .ne. 1) then
+	  if (e1 .gt. n1) then
+	    call str_append(res, reslen, file(n1+1:e1))
+	  elseif (e2 .gt. n2) then
+	    call str_append(res, reslen, default(n2+1:e2))
+	  endif
+	endif
+        if (reslen .eq. 0) then
+          result=' '
+        else
+          result=res(1:reslen)
+	endif
+	end
+
+
+	subroutine sys_split_path(path, enddir, endnam, endext)
+!
+! examine a path and report the position of the end of the directory,
+! of the filename, and the extension
+! Example: call sys_split_path("/home/user/file.name.txt", ed, en, ee)
+!                                         ^        ^   ^
+!                                      ed=9    en=18 ee=22
+
+	character path*(*)
+	integer enddir, endnam, endext
+
+	integer i, mx
+
+	i=index(path, '/')
+	if (i .eq. 0) then
+	  enddir=0
+	else
+	  mx=i
+	  do while (i .lt. len(path))
+	    i=i+1
+	    if (path(i:i) .eq. '/') mx=i
+	  enddo
+          enddir=mx
+          i=mx
+	endif
+
+	mx=len(path)
+	endnam=mx
+	do while (i .lt. mx)
+	  i=i+1
+	  if (path(i:i) .eq. '.') endnam=i-1
+	  if (path(i:i) .le. ' ') then
+	    mx=i-1
+	  endif
+	enddo
+	endext=mx
+	if (endnam .gt. mx) endnam=mx
+	end
+
+!!-----------------------------------------------------------------------------
+	subroutine sys_find_file !!
+!! not available on DEC Unix
+	end
+!!-----------------------------------------------------------------------------
+!!
+        subroutine get_tasmad_high(file, numor) !!
+!!
+        character file*(*)
+        integer numor
+
+	call dat_get_datanumber(file, numor)
+	end