55 lines
1.8 KiB
Fortran
55 lines
1.8 KiB
Fortran
!!-----------------------------------------------------------------------------
|
|
!!
|
|
subroutine SYS_OPEN(LUN, FILE, ACCESS, IOSTAT) !!
|
|
!! ==============================================
|
|
!!
|
|
!! ACCESS='r': open file for read
|
|
!! ACCESS='w': open or create file for write (on vms: new version, on unix: overwrite)
|
|
!! ACCESS='wo': overwrite existing file (do not make a new version)
|
|
!! ACCESS='wn': keep old file (on unix systems, a tilde '~' is appended to the name)
|
|
!! ACCESS='a': open or create file for append
|
|
|
|
integer LUN !! (in) logical unit number
|
|
character FILE*(*) !! (in) filename
|
|
character ACCESS*(*) !! (in) access mode
|
|
integer IOSTAT !! (out) status
|
|
|
|
character acc*2
|
|
character amnt*128
|
|
integer i,l,ios
|
|
|
|
call str_upcase(acc, access)
|
|
|
|
if (acc .eq. 'R') then
|
|
open(lun, file=file, iostat=iostat, status='old')
|
|
if (iostat .eq. 0) RETURN ! success
|
|
l=0
|
|
i=1
|
|
do while (i .ne. 0)
|
|
l=l+i
|
|
i=index(file(l+1:),'/')
|
|
enddo
|
|
if (l .eq. 1) RETURN ! no directory given
|
|
open(lun, file=file(1:l-1), iostat=ios, status='old')
|
|
if (ios .eq. 0) then
|
|
close(lun)
|
|
RETURN ! directory exists -> already mounted
|
|
endif
|
|
call sys_getenv('dat_automount', amnt)
|
|
if (amnt .eq. ' ') RETURN
|
|
call sys_cmd(amnt) !try to mount
|
|
open(lun, file=file, iostat=iostat, status='old')
|
|
else if (acc .eq. 'W' .or. acc .eq. 'WO') then
|
|
open(lun, file=file, iostat=iostat, status='unknown')
|
|
else if (acc .eq. 'WN') then
|
|
! rename to be done
|
|
open(lun, file=file, iostat=iostat, status='unknown')
|
|
else if (acc .eq. 'A') then
|
|
open(lun, file=file, iostat=iostat, status='unknown'
|
|
1, access='append')
|
|
else
|
|
print *,'unknown access mode: ',acc
|
|
stop 'error in SYS_OPEN'
|
|
endif
|
|
end
|