gdncvaropenbydimord.f90

Go to the documentation of this file.

!> @file gdncvaropenbydimord.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 Open netCDF dimension variable by dimension order
!> @enden
!>
!> @ja
!> @brief 次元順序による netCDF 次元変数のオープン
!> @endja
!>
 
!>
!> @en
!> @brief Open the dimension variable at specified position
!>
!> Opens the variable corresponding to the dimord-th dimension of
!> an already opened variable src_var, and stores it in var.
!>
!> On error, outputs a message and terminates the program.
!> If err is provided, it returns .true. instead of terminating.
!> @enden
!>
!> @ja
!> @brief 指定位置の次元変数をオープン
!>
!> 既に開かれた変数 src_var の dimord 番目の次元にあたる変数を
!> 開き var に格納します。
!>
!> エラー時はメッセージを出力してプログラムを終了します。
!> err を与えた場合は終了せず .true. が返されます。
!> @endja
!>
!> @param[out] var     @en Opened dimension variable @enden @ja オープンした次元変数 @endja
!> @param[in]  src_var @en Source variable @enden @ja ソース変数 @endja
!> @param[in]  dimord  @en Dimension order (1-based) @enden @ja 次元順序 (1始まり) @endja
!> @param[out] err     @en Error flag (optional) @enden @ja エラーフラグ (省略可能) @endja
!>
subroutine gdncvaropenbydimord(var, src_var, dimord, err)
  use gtdata_netcdf_types, only: gd_nc_variable, gd_nc_variable_entry, gd_nc_variable_search
  use gtdata_netcdf_internal, only: vtable_lookup, vtable_add
  use gtdata_netcdf_file_generic, only: gdncfilereopen, gdncfileclose
  use netcdf, only: nf90_max_name, nf90_noerr, nf90_einval, nf90_enotvar, &
    & nf90_inquire_dimension, nf90_inq_varid
  use dc_error
  implicit none
  type(gd_nc_variable), intent(out):: var
  type(gd_nc_variable), intent(in):: src_var
  integer, intent(in):: dimord
  logical, intent(out), optional:: err
  type(gd_nc_variable_entry):: src_ent
  type(gd_nc_variable_search):: ent
  character(len = NF90_MAX_NAME):: dimname
  integer:: stat
continue
  stat = vtable_lookup(src_var, src_ent)
  if (stat /= nf90_noerr) goto 999
  !
  if (dimord <= 0) then
    !
    ! dimord == 0 の特別扱いは廃止 (gtdata 層でやる)。
    ! (同じハンドルを返すと参照カウントが増えないので多重クローズが
    ! 禁止されてしまい、Open のセマンティクスに不適合なため。)
    !
    var = src_var
    stat = nf90_einval
    goto 999
  endif
  if (.not. associated(src_ent%dimids)) then
    stat = gt_enomoredims
    goto 999
  else if (dimord > size(src_ent%dimids)) then
    stat = gt_enomoredims
    goto 999
  endif
  !
  ! 決定された次元 id を使って変数 id の確定を試みる
  !
  ent%fileid = src_ent%fileid
  ent%dimid = src_ent%dimids(dimord)
  stat = nf90_inquire_dimension(ent%fileid, ent%dimid, name = dimname)
  if (stat /= nf90_noerr) goto 999
  stat = nf90_inq_varid(ent%fileid, dimname, ent%varid)
  if (stat == nf90_enotvar) then
    ! 変数が対応しなければ無視するだけ
    ent%varid = 0
    stat = nf90_noerr
  else if (stat /= nf90_noerr) then
    goto 999
  endif
  !
  ! 成功しそうなので参照カウント値を増やす
  call gdncfilereopen(ent%fileid)
  ! 不適合な変数が開かれている場合は vtable_add が変数部を無視する。
  stat = vtable_add(var, ent)
  if (stat /= nf90_noerr) then
    call gdncfileclose(ent%fileid)
    goto 999
  endif
 
999 continue
  call storeerror(stat, 'GDNcVarOpenByDimOrd', err, cause_i=dimord)
end subroutine