gdncfileclose.f90
Go to the documentation of this file.
1 subroutine gdncfileclose(fileid, err)
2  ! おなじ id のファイルの参照カウンタを減算し、ゼロになったら閉じる
5  use netcdf, only: nf90_close, nf90_enotnc, nf90_noerr
6  use dc_error, only: storeerror
8  integer, intent(in):: fileid
9  logical, intent(out), optional:: err
10  type(gd_nc_file_id_entry), pointer:: identptr, prev
11  integer:: stat
12  character(*), parameter:: subname = "GDNcFileClose"
13 continue
14  call beginsub(subname)
15  stat = nf90_enotnc
16  if (.not. id_used) goto 999
17  identptr => id_head
18  nullify(prev)
19  do
20  if (.not. associated(identptr)) goto 999
21  if (identptr % id == fileid) exit
22  prev => identptr
23  identptr => identptr % next
24  enddo
25  identptr % count = identptr % count - 1
26  if (identptr % count <= 0) then
27  stat = nf90_close(fileid)
28  if (associated(prev)) then
29  prev%next => identptr % next
30  else
31  id_head => identptr % next
32  if (.not. associated(id_head)) id_used = .false.
33  endif
34  call dbgmessage(subname // ': <%c> closed', c1=trim(identptr % filename))
35  deallocate(identptr)
36  else
37  call dbgmessage(subname // ': %d<%c> skipped for refcount=%d', &
38  & c1=trim(identptr % filename), i=(/fileid, identptr % count/))
39  stat = nf90_noerr
40  endif
41 999 continue
42  call endsub(subname)
43  call storeerror(stat, 'GDNcFileClose', err)
44 end subroutine gdncfileclose
subroutine gdncfileclose(fileid, err)
subroutine, public storeerror(number, where, err, cause_c, cause_i)
Definition: dc_error.f90:830
type(gd_nc_file_id_entry), pointer, save id_head
subroutine, public dbgmessage(fmt, i, r, d, L, n, c1, c2, c3, ca)
Definition: dc_trace.f90:509
subroutine, public beginsub(name, fmt, i, r, d, L, n, c1, c2, c3, ca, version)
Definition: dc_trace.f90:351
subroutine, public endsub(name, fmt, i, r, d, L, n, c1, c2, c3, ca)
Definition: dc_trace.f90:446