127 lines
2.9 KiB
Fortran
127 lines
2.9 KiB
Fortran
!!-----------------------------------------------------------------------------
|
|
!!
|
|
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
|