subroutine GRFileOpen(fileid, filename, writable, overwrite, stat, err)
use dc_string
use netcdf_f77
use dc_error
use dcl, only: DclGetUnitNum
implicit none
integer, intent(out):: fileid
character(len = *), intent(in):: filename
logical, intent(in), optional:: writable
logical, intent(in), optional:: overwrite
logical, intent(out), optional:: err
integer, intent(out), optional:: stat
logical:: writable_required
logical:: overwrite_required
type(GR_FILE_ENTRY), pointer:: cursor, prev
integer:: mystat
integer:: recl
character(len = 7):: new
character(len = 256):: dsetname
continue
!
! オプション操作
!
writable_required = .FALSE.
if (present(writable)) writable_required = writable
if (present(overwrite)) then
writable_required = .TRUE.
overwrite_required = overwrite
else
overwrite_required = .FALSE.
endif
!
! 同じ名前で書込み可能性も適合していれば open しないで済ませる
!
if (file_table_used) then
cursor => file_table_head
nullify(prev)
do
if ((cursor%ctlfile == filename) .and. (cursor%writable .or. .not. writable_required)) then
fileid = cursor%id
cursor%count = cursor%count + 1
if (present(err)) err = .FALSE.
return
endif
prev => cursor
cursor => cursor%next
if (.not. associated(cursor)) exit
enddo
allocate(cursor)
prev%next => cursor
else
nullify(prev)
allocate(file_table_head)
cursor => file_table_head
file_table_used = .TRUE.
endif
!
! ファイル表の新しく確保したエントリに書き込む
!
nullify(cursor%next, cursor%lat, cursor%lon, cursor%lev)
call parse_ctl_file(cursor, filename, writable_required, mystat)
if (mystat /= 0) goto 900
dsetname = cursor%dsetfile
inquire(iolength=recl) 0.0
cursor%id = DclGetUnitNum()
if (.not. writable_required) then
open(unit=cursor%id, file=dsetname, access="DIRECT", recl=recl, form="UNFORMATTED", status="OLD", action="READ", iostat=mystat)
else
open(unit=cursor%id, file=dsetname, access="DIRECT", recl=recl, form="UNFORMATTED", status="OLD", action="READWRITE", iostat=mystat)
if (mystat /= 0) then
new = "NEW"
if (overwrite_required) new = "REPLACE"
open(unit=cursor%id, file=dsetname, access="DIRECT", recl=recl, form="UNFORMATTED", status=new, action="READWRITE", iostat=mystat)
endif
endif
fileid = cursor%id
900 continue
! 失敗したら GR_FILE 表から消しておく
if (mystat /= 0) then
if (associated(prev)) then
prev%next => cursor%next
else
file_table_head => cursor%next
if (.not. associated(file_table_head)) file_table_used = .FALSE.
endif
deallocate(cursor)
fileid = -1
endif
if (present(stat)) then
stat = mystat
if (present(err)) err = (stat /= 0)
else if (present(err)) then
err = (stat /= 0)
else
call StoreError(mystat, 'GrFileOpen', err, cause_c=trim(filename))
endif
end subroutine