subroutine GDNcFileOpen(fileid, filename, writable, overwrite, stat, err)
use gtdata_netcdf_file_types, only: GD_NC_FILE_ID_ENTRY
use gtdata_netcdf_file_internal, only: id_head, id_used
use netcdf_f77, only: NF_WRITE, NF_NOWRITE, NF_ENOTNC, NF_NOERR, NF_NOCLOBBER, NF_CLOBBER, NF_OPEN, NF_CREATE
use dc_message, only: MessageNotify
use dc_error, only: StoreError
use dc_types, only: STRING
use dc_trace, only: BeginSub, EndSub
implicit none
integer, intent(out):: fileid
character(len = *), intent(in):: filename
logical, intent(in), optional:: writable
! .TRUE. $B$O=q$-9~$_%b!<%I!"(B
! .FALSE. $B$OFI9~%b!<%I!#(B
! $BFI9~%b!<%I$N:]$K%U%!%$%k$,(B
! $B%U%!%$%k$,B8:_$7$J$$$H(B
! $B%(%i!<$K$J$k!#(B
! $B%G%U%)%k%H$OFI$_9~$_%b!<%I(B
logical, intent(in), optional:: overwrite
! writable $B$,(B .TRUE. $B$N(B
! $B>l9g$N$_M-8z!#(B
! .TRUE. $B$J$i$P>e=q$-%b!<%I(B
! .FALSE. $B$N>l9g!"4{B8$N(B
! $B%U%!%$%k$,B8:_$9$k$H(B
! $B%(%i!<$K$J$k(B
logical, intent(out), optional:: err
integer, intent(out), optional:: stat
logical:: writable_required
logical:: overwrite_required
type(GD_NC_FILE_ID_ENTRY), pointer:: identptr, prev
integer:: mystat, mode
character(len = 256):: real_filename
character(len = STRING):: cause_c
character(*), parameter:: subname = "GDNcFileOpen"
continue
fileid = -1
!
! $B%*%W%7%g%s$N2r<a(B
!
writable_required = .FALSE.
overwrite_required = .FALSE.
if (present(writable)) writable_required = writable
if (present(overwrite)) overwrite_required = overwrite
call BeginSub(subname, 'writable=%y overwrite=%y file=%c', L=(/writable_required, overwrite_required/), c1=trim(filename))
!
! $BF1$8L>A0$G=q9~$_2DG=@-$bE,9g$7$F$$$l$P(B nf_open $B$7$J$$$G:Q$^$;$k(B
!
if (id_used) then
identptr => id_head
nullify(prev)
do
if ((identptr % filename == filename) .and. (identptr % writable .or. .not. writable_required)) then
fileid = identptr % id
identptr % count = identptr % count + 1
if (present(err)) err = .FALSE.
if (present(stat)) stat = NF_NOERR
mystat = NF_NOERR
goto 999
endif
prev => identptr
identptr => identptr % next
if (.not. associated(identptr)) exit
enddo
allocate(identptr)
prev%next => identptr
else
nullify(prev)
allocate(id_head)
identptr => id_head
id_used = .TRUE.
endif
nullify(identptr % next)
identptr % filename = filename
identptr % writable = writable_required
identptr % count = 1
!
! URL $B$NItJ,E*%5%]!<%H(B
!
real_filename = filename
if (real_filename(1:8) == 'file:///') then
real_filename = real_filename(8: )
else if (real_filename(1:5) == 'file:' .AND. real_filename(6:6) /= '/') then
real_filename = real_filename(6: )
endif
!
! $B$$$6(B nf_open
!
mode = NF_NOWRITE
if (writable_required) mode = ior(mode, NF_WRITE)
! $B4{$K(B nc $B%U%!%$%k$,$"$k$H;W$C$F3+$1$F$_$k(B
mystat = nf_open(real_filename, mode, identptr % id)
!
! $B%U%!%$%k$,4{$KB8:_$9$k>l9g(B
!
if (mystat == NF_NOERR) then
! $B=q$-9~$_%b!<%I$N>l9g(B
if (writable_required) then
if (overwrite_required) then
! $B>e=q$-%b!<%I$N>l9g(B
mode = NF_CLOBBER
call MessageNotify('M', subname, '"%c" is overwritten.', c1=trim(filename), rank_mpi = -1)
else
! $B>e=q$-6X;_%b!<%I$N>l9g(B
mode = NF_NOCLOBBER
call MessageNotify('W', subname, '"%c" is opened in write-protect mode.', c1=trim(filename), rank_mpi = -1)
end if
mystat = nf_create(real_filename, mode, identptr % id)
if (mystat /= NF_NOERR) then
cause_c=filename
if (present(stat)) stat = mystat
goto 999
end if
endif
! $BFI$_9~$_%b!<%I$N>l9g$O2?$b$7$J$$(B
else
!
! $B%U%!%$%k$,L5$+$C$?>l9g(B
!
if (.not. writable_required) then
! $BFI$_9~$_%b!<%I$N>l9g(B
!
! $B!VL5$$$h!W$H%(%i!<$rEG$$$F=*N;(B
if (mystat /= NF_NOERR) then
cause_c=filename
if (present(stat)) stat = mystat
goto 999
end if
else
! $B=q$-9~$_%b!<%I$N>l9g(B
mode = NF_CLOBBER
! $B%U%!%$%k$r:n@.$9$k(B
mystat = nf_create(real_filename, mode, identptr % id)
if (mystat /= NF_NOERR) then
cause_c=filename
if (present(stat)) stat = mystat
goto 999
end if
endif
endif
fileid = identptr % id
! $B<:GT$7$?$i>C$7$F$*$/(B
if (mystat /= NF_NOERR) then
if (associated(prev)) then
prev%next => identptr % next
else
id_head => identptr % next
if (.not. associated(id_head)) id_used = .FALSE.
endif
deallocate(identptr)
fileid = -1
endif
if (present(stat)) then
stat = mystat
if (present(err)) err = (stat /= NF_NOERR)
else
cause_c=filename
goto 999
endif
999 continue
call StoreError(mystat, subname, err, cause_c)
call EndSub(subname, 'id=%d stat=%d', i=(/fileid, mystat/))
end subroutine GDNcFileOpen