!!----------------------------------------------------------------------------- !! 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