gtvardeldim.f90

Go to the documentation of this file.

!> @file gtvardeldim.f90
!>
!> @author Eizi TOYODA, Yasuhiro MORIKAWA
!> @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 Delete dimension
!>
!> This subroutine is provided as gtdata_generic#Del_dim
!> through gtdata_generic.
!> @enden
!>
!> @ja
!> @brief 次元の削除
!>
!> このサブルーチンは gtdata_generic から gtdata_generic#Del_dim
!> として提供されます。
!> @endja
!>
 
!>
!> @en
!> @brief Delete dimension from variable
!>
!> Deletes dimension dimord from variable var.
!> Since this only lowers the rank in the dimension correspondence table
!> and decrements the valid dimension count, I/O is still possible
!> after this operation if the dimension is already degenerate.
!>
!> If an error occurs, outputs a message and terminates the program.
!> If err is provided, returns .true. and program does not terminate.
!>
!> @note In NetCDF implementation, variable is not deleted but renamed.
!>       This is because netCDF API lacks variable deletion.
!> @param[in]  var    Variable handle
!> @param[in]  dimord Dimension order number to delete
!> @param[out] err    Error flag
!> @enden
!>
!> @ja
!> @brief 変数から次元を削除
!>
!> 変数 var の次元 dimord を削除します。
!> 次元対応表の順位を下げ有効次元数をデクリメントするだけなので、
!> 当該次元がすでに縮退していれば、この操作のあとでも入出力が可能です。
!>
!> エラーが生じた場合、メッセージを出力してプログラムは強制終了します。
!> err を与えてある場合にはの引数に .true. が返り、プログラムは終了しません。
!>
!> @note NetCDF 実装においては、変数は削除されず別の名称に改名されるだけです。
!>       これは netCDF API に変数の削除が欠けているためです。
!> @param[in]  var    変数ハンドル
!> @param[in]  dimord 削除する次元順序番号
!> @param[out] err    エラーフラグ
!> @endja
!>
subroutine gtvardeldim(var, dimord, err)
  use gtdata_types, only: gt_variable
  use gtdata_internal_map, only: map_lookup, gt_dimmap, map_set_ndims, map_set
  use dc_trace, only: beginsub, endsub, dbgmessage
  implicit none
  type(gt_variable), intent(in):: var
  integer, intent(in):: dimord
  logical, intent(out):: err
  type(gt_dimmap), allocatable:: map(:)
  type(gt_dimmap):: tmpmap
  integer:: ndimsp, stat
  character(*), parameter:: subname = 'GTVarDelDim'
continue
  err = .true.
  call beginsub(subname)
  if (dimord < 1) then
    call endsub(subname, "negative dimord=%d invalid", i=(/dimord/))
    return
  endif
  call map_lookup(var, ndims=ndimsp)
  if (ndimsp <= 0) then
    call endsub(subname, "variable invalid")
    return
  else if (dimord > ndimsp) then
    call endsub(subname, "dimord=%d not exist", i=(/dimord/))
    return
  endif
 
  allocate(map(ndimsp))
  call map_lookup(var, map=map)
  tmpmap = map(dimord)
  map(dimord: ndimsp-1) = map(dimord+1: ndimsp)
  map(ndimsp) = tmpmap
  call map_set(var, map, stat)
  deallocate(map)
 
  call map_set_ndims(var, ndims = ndimsp - 1, stat=stat)
  err = stat /= 0
  call endsub(subname)
end subroutine gtvardeldim