gtdata_netcdf_internal.f90

Go to the documentation of this file.

!>
!> @file gtdata_netcdf_internal.f90
!>
!> @author Yasuhiro MORIKAWA, Eizi TOYODA
!> @copyright Copyright (C) GFD Dennou Club, 2001-2026. All rights reserved. <br/>
!>            License is BSD-2-Clause. See [COPYRIGHT](@ref COPYRIGHT) in detail
!>
!> @en
!> @brief Internal constants, variables, procedures used in "gtdata_netcdf"
!> @enden
!>
!> @ja
!> @brief gtdata_netcdf 内で使用される内部向け定数, 変数, 手続き群
!> @endja
!>
 
!>
!> @private
!>
!> @en
!> @brief Internal constants, variables, procedures used in "gtdata_netcdf"
!>
!> This module provides the internal variable table (gdnctab) and
!> procedures to manage it.
!>
!> | Procedure | Description |
!> |-----------|-------------|
!> | vtable_add | Add entry to variable table |
!> | vtable_delete | Delete entry from variable table |
!> | vtable_lookup | Look up entry in variable table |
!> | vtable_set_attrid | Set attribute iterator ID |
!>
!> @enden
!>
!> @ja
!> @brief gtdata_netcdf 内で使用される内部向け定数, 変数, 手続き群
!>
!> このモジュールは内部変数テーブル (gdnctab) とその管理手続きを提供します。
!>
!> | 手続き | 説明 |
!> |--------|------|
!> | vtable_add | 変数テーブルにエントリを追加 |
!> | vtable_delete | 変数テーブルからエントリを削除 |
!> | vtable_lookup | 変数テーブルでエントリを検索 |
!> | vtable_set_attrid | 属性イテレータ ID を設定 |
!>
!> @endja
!>
module gtdata_netcdf_internal
  !
 
  use netcdf
  use gtdata_netcdf_types, only: &
    & gd_nc_variable, gd_nc_variable_entry, gd_nc_variable_search
  use dc_error
  use dc_trace, only: dbgmessage
  implicit none
  private
 
  type(GD_NC_VARIABLE_ENTRY), save, target, allocatable:: gdnctab(:)
  integer, parameter:: gdnctab_init_size = 16
 
  public:: vtable_add, vtable_delete, vtable_lookup, gd_nc_variable_entry
  public:: vtable_set_attrid
 
contains
 
  !>
  !> @en
  !> @brief Add entry to variable table
  !>
  !> Adds a new entry to gdnctab or returns existing entry if already registered.
  !> @enden
  !>
  !> @ja
  !> @brief 変数テーブルにエントリを追加
  !>
  !> gdnctab に新しいエントリを追加、または既登録なら既存エントリを返します。
  !> @endja
  !>
  !> @param[out] var    @en Variable handle @enden @ja 変数ハンドル @endja
  !> @param[in]  entry  @en Entry to add @enden @ja 追加するエントリ @endja
  !> @return            @en NF90_NOERR on success, NF90_ENOMEM on allocation failure @enden
  !>                    @ja 成功時 NF90_NOERR、割当失敗時 NF90_ENOMEM @endja
  !>
  integer function vtable_add(var, entry) result(result)
    type(gd_nc_variable), intent(out):: var
    type(gd_nc_variable_search), intent(in):: entry
    type(gd_nc_variable_entry), allocatable:: tmp_table(:)
    integer:: i, n
 
    ! --- 必要なら初期確保 ---
    if (.not. allocated(gdnctab)) then
      allocate(gdnctab(gdnctab_init_size), stat=result)
      if (result /= 0) goto 999
      do, i = 1, gdnctab_init_size
        gdnctab(i)%fileid = 0
        gdnctab(i)%varid = 0
        gdnctab(i)%dimid = 0
        gdnctab(i)%attrid = 0
        nullify(gdnctab(i)%dimids)
      enddo
    endif
    ! --- 同じ内容が既登録ならばそれを返す (attrid は変更しない) ---
    do, i = 1, size(gdnctab)
      if (gdnctab(i)%fileid == entry%fileid &
        & .and. gdnctab(i)%varid == entry%varid &
        & .and. gdnctab(i)%dimid == entry%dimid) then
        var = gd_nc_variable(i)
        result = nf90_noerr
        call dbgmessage('gtdata_netcdf_internal.add: found %d', i=(/i/))
        return
      endif
    enddo
    !
    ! --- 空き地があればそこに割り当て ---
    var = gd_nc_variable(-1)
    do, i = 1, size(gdnctab)
      if (gdnctab(i)%fileid == 0) then
        var = gd_nc_variable(i)
        exit
      endif
    enddo
    if (var%id == -1) then
      ! --- 空き地はなかったのだから倍幅確保 ---
      n = size(gdnctab)
      allocate(tmp_table(n), stat=result)
      if (result /= 0) goto 999
      tmp_table(:) = gdnctab(:)
      deallocate(gdnctab, stat=result)
      if (result /= 0) goto 999
      allocate(gdnctab(n * 2), stat=result)
      if (result /= 0) goto 999
      gdnctab(1:n) = tmp_table(1:n)
      deallocate(tmp_table, stat=result)
      if (result /= 0) goto 999
      !
      gdnctab(n+2)%fileid = 0
      gdnctab(n+2)%varid = 0
      gdnctab(n+2)%dimid = 0
      gdnctab(n+2)%attrid = 0
      nullify(gdnctab(n+2)%dimids)
      gdnctab(n+3: n*2) = gdnctab(n+2)
      ! 確保域の先頭を使用
      var = gd_nc_variable(n + 1)
    endif
    gdnctab(var%id)%fileid = entry%fileid
    gdnctab(var%id)%varid = entry%varid
    gdnctab(var%id)%dimid = entry%dimid
    !
    ! --- 次元表の確保 ---
    call internal_build_dimids(gdnctab(var%id), result)
    if (result /= nf90_noerr) goto 999
    !
    result = nf90_noerr
    call dbgmessage('gtdata_netcdf_internal.add: added %d', i=(/var%id/))
    return
    !
999 continue
    var = gd_nc_variable(-1)
    result = nf90_enomem
    return
 
  contains
 
    subroutine internal_build_dimids(ent, stat)
!!      use netcdf, only: &
!!        & NF90_NOERR, NF90_ENOMEM, NF90_INQUIRE_VARIABLE
      type(gd_nc_variable_entry), intent(inout):: ent
      integer, intent(out):: stat
      integer:: ndims
      if (ent%varid > 0) then
        stat = nf90_inquire_variable(ent%fileid, ent%varid, ndims = ndims)
        if (stat /= nf90_noerr) return
        if ((ent%dimid > 0) .and. (ndims /= 1)) goto 100
        if (ndims == 0) then
          nullify(ent%dimids)
          stat = nf90_noerr
          return
        endif
        allocate(ent%dimids(ndims), stat=stat)
        if (stat /= 0) then
          stat = nf90_enomem
          return
        endif
        stat = nf90_inquire_variable(ent%fileid, ent%varid, dimids = ent%dimids)
        if (stat /= nf90_noerr) return
        if ((ent%dimid > 0) .and. (ent%dimids(1) /= ent%dimid)) then
          deallocate(ent%dimids)
          goto 100
        endif
      else
        allocate(ent%dimids(1), stat=stat)
        if (stat /= 0) then
          stat = nf90_enomem
          return
        endif
        ent%dimids(1) = ent%dimid
      endif
      stat = nf90_noerr
      return
 
100   continue
      ent%varid = 0
      allocate(ent%dimids(1))
      ent%dimids(1) = ent%dimid
    end subroutine internal_build_dimids
 
  end function vtable_add
 
  !>
  !> @en
  !> @brief Delete entry from variable table
  !>
  !> Returns fileid on success, NF90_ENOTVAR on failure.
  !> @enden
  !>
  !> @ja
  !> @brief 変数テーブルからエントリを削除
  !>
  !> 成功時は fileid を、失敗時は NF90_ENOTVAR を返します。
  !> @endja
  !>
  !> @param[in] var @en Variable handle @enden @ja 変数ハンドル @endja
  !> @return        @en fileid on success, NF90_ENOTVAR on failure @enden
  !>                @ja 成功時 fileid、失敗時 NF90_ENOTVAR @endja
  !>
  integer function vtable_delete(var) result(result)
    type(gd_nc_variable), intent(in):: var
    if (.not. allocated(gdnctab)) goto 999
    if (var%id <= 0 .or. var%id > size(gdnctab)) goto 999
    if (gdnctab(var%id)%fileid == 0) goto 999
    result = gdnctab(var%id)%fileid
    gdnctab(var%id)%fileid = 0
    gdnctab(var%id)%varid = 0
    gdnctab(var%id)%dimid = 0
    gdnctab(var%id)%attrid = 0
    if (associated(gdnctab(var%id)%dimids)) &
      & deallocate(gdnctab(var%id)%dimids)
    call dbgmessage('gtdata_netcdf_internal.delete: delete %d', i=(/var%id/))
    return
    !
999 continue
    result = nf90_enotvar
  end function vtable_delete
 
  !>
  !> @en
  !> @brief Look up entry in variable table
  !> @enden
  !> @ja
  !> @brief 変数テーブルでエントリを検索
  !> @endja
  !>
  !> @param[in]  var   @en Variable handle @enden @ja 変数ハンドル @endja
  !> @param[out] entry @en Found entry @enden @ja 見つかったエントリ @endja
  !> @return           @en NF90_NOERR on success, NF90_ENOTVAR if not found @enden
  !>                   @ja 成功時 NF90_NOERR、未発見時 NF90_ENOTVAR @endja
  !>
  integer function vtable_lookup(var, entry) result(result)
    type(gd_nc_variable), intent(in):: var
    type(gd_nc_variable_entry), intent(out):: entry
    if (.not. allocated(gdnctab)) goto 999
    if (var%id <= 0 .or. var%id > size(gdnctab)) goto 999
    if (gdnctab(var%id)%fileid == 0) goto 999
    entry = gdnctab(var%id)
    result = nf90_noerr
    return
    !
999 continue
    nullify(entry%dimids)
    entry%fileid = -1
    entry%varid = -1
    entry%dimid = -1
    entry%attrid = -1
    result = nf90_enotvar
  end function vtable_lookup
 
  !>
  !> @en
  !> @brief Set attribute iterator ID for a variable
  !> @enden
  !> @ja
  !> @brief 変数の属性イテレータ ID を設定
  !> @endja
  !>
  !> @param[in] var    @en Variable handle @enden @ja 変数ハンドル @endja
  !> @param[in] attrid @en Attribute iterator ID @enden @ja 属性イテレータ ID @endja
  !> @return           @en NF90_NOERR on success, NF90_ENOTVAR on failure @enden
  !>                   @ja 成功時 NF90_NOERR、失敗時 NF90_ENOTVAR @endja
  !>
  integer function vtable_set_attrid(var, attrid) result(result)
    type(gd_nc_variable), intent(in):: var
    integer, intent(in):: attrid
    continue
    if (.not. allocated(gdnctab)) goto 999
    if (var%id <= 0 .or. var%id > size(gdnctab)) goto 999
    if (gdnctab(var%id)%fileid == 0) goto 999
    gdnctab(var%id)%attrid = attrid
    result = nf90_noerr
    return
    !
999 continue
    result = nf90_enotvar
  end function vtable_set_attrid
 
end module gtdata_netcdf_internal