gdncfileclose.f90

Go to the documentation of this file.

!>
!> @file gdncfileclose.f90
!>
!> @author Yasuhiro MORIKAWA, Eizi TOYODA
!> @copyright Copyright (C) GFD Dennou Club, 2000-2026. All rights reserved. <br/>
!>            License is BSD-2-Clause. See [COPYRIGHT](@ref COPYRIGHT) in detail
!>
!> @en
!> @brief Close a netCDF file
!> @enden
!>
!> @ja
!> @brief netCDF ファイルを閉じる
!> @endja
!>
 
!>
!> @en
!> @brief Close a netCDF file
!>
!> Decrements the reference count of the specified file ID. When the
!> reference count reaches zero, the file is actually closed using
!> nf90_close and removed from the internal file list.
!> @enden
!>
!> @ja
!> @brief netCDF ファイルを閉じる
!>
!> 指定されたファイル ID の参照カウントを減算します。
!> 参照カウントがゼロになると、nf90_close を使用して実際にファイルを閉じ、
!> 内部ファイルリストから削除します。
!> @endja
!>
!> @param[in]  fileid @en netCDF file ID @enden @ja netCDF ファイル ID @endja
!> @param[out] err    @en Error flag (optional) @enden @ja エラーフラグ (省略可能) @endja
!>
subroutine gdncfileclose(fileid, err)
  use gtdata_netcdf_file_types, only: gd_nc_file_id_entry
  use gtdata_netcdf_file_internal, only: id_head, id_used
  use netcdf, only: nf90_close, nf90_enotnc, nf90_noerr
  use dc_error, only: storeerror
  use dc_trace, only: beginsub, endsub, dbgmessage
  integer, intent(in):: fileid
  logical, intent(out), optional:: err
  type(gd_nc_file_id_entry), pointer:: identptr, prev
  integer:: stat
  character(*), parameter:: subname = "GDNcFileClose"
continue
  call beginsub(subname)
  stat = nf90_enotnc
  if (.not. id_used) goto 999
  identptr => id_head
  nullify(prev)
  do
    if (.not. associated(identptr)) goto 999
    if (identptr % id == fileid) exit
    prev => identptr
    identptr => identptr % next
  enddo
  identptr % count = identptr % count - 1
  if (identptr % count <= 0) then
    stat = nf90_close(fileid)
    if (associated(prev)) then
      prev%next => identptr % next
    else
      id_head => identptr % next
      if (.not. associated(id_head)) id_used = .false.
    endif
    call dbgmessage(subname // ': <%c> closed', c1=trim(identptr % filename))
    deallocate(identptr)
  else
    call dbgmessage(subname // ': %d<%c> skipped for refcount=%d', &
      & c1=trim(identptr % filename), i=(/fileid, identptr % count/))
    stat = nf90_noerr
  endif
999 continue
  call endsub(subname)
  call storeerror(stat, 'GDNcFileClose', err)
end subroutine gdncfileclose