gtvarslicenext.f90

Go to the documentation of this file.

!> @file gtvarslicenext.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 Move I/O range
!>
!> This subroutine is provided as gtdata_generic#Slice_Next
!> through gtdata_generic.
!> @enden
!>
!> @ja
!> @brief 入出力範囲を移動
!>
!> このサブルーチンは gtdata_generic から gtdata_generic#Slice_Next
!> として提供されます。
!> @endja
!>
 
!>
!> @en
!> @brief Advance I/O range to next slice
!>
!> Moves the dimension range by incrementing the start value of
!> the dimord-th dimension of variable var by stride * count.
!> If dimord is omitted, this operation is performed on any dimension.
!> On success, stat becomes 0.
!>
!> By setting a Slice with start and stride values of 1 for any dimension
!> and sequentially calling Slice_Next, you can scan the entire variable.
!>
!> If an error occurs while moving the I/O range, outputs a message
!> and terminates the program. If err is provided, returns .true.
!> and program does not terminate.
!> @param[inout] var    Variable handle
!> @param[in]    dimord Dimension order number (optional)
!> @param[out]   err    Error flag (optional)
!> @param[out]   stat   Status (0 on success) (optional)
!> @enden
!>
!> @ja
!> @brief 入出力範囲を次のスライスに移動
!>
!> 変数 var の dimord 番目の次元の start 値を stride * count 個だけ
!> 増やすことによって次元範囲を移動します。dimord を省略すると、
!> どれかの次元についてこの操作を行います。成功した場合 stat が 0 になります。
!>
!> いずれかの次元について start, stride 値が 1 になるような
!> Slice を設定しておいて、Slice_Next を順次呼び出すと変数全体
!> を走査することができます。
!>
!> 入出力範囲を移動する際にエラーが生じた場合、メッセージを出力
!> してプログラムは強制終了します。err を与えてある場合には
!> の引数に .true. が返り、プログラムは終了しません。
!> @param[inout] var    変数ハンドル
!> @param[in]    dimord 次元順序番号 (省略可能)
!> @param[out]   err    エラーフラグ (省略可能)
!> @param[out]   stat   ステータス (成功時0) (省略可能)
!> @endja
!>
subroutine gtvarslicenext(var, dimord, err, stat)
  use gtdata_types, only: gt_variable
  use dc_error, only: storeerror, dc_noerr, gt_enomoredims, &
    & nf90_einval, nf90_enotvar
  use gtdata_internal_map, only: map_lookup, gt_dimmap, map_set
  use dc_trace, only: beginsub, endsub, dbgmessage
  implicit none
  type(gt_variable), intent(in out):: var
  integer, intent(in), optional:: dimord
  logical, intent(out), optional:: err
  integer, intent(out), optional:: stat
  type(gt_dimmap), allocatable:: map(:)
  integer:: mystat, vid, id, nd, idim_lo, idim_hi, ilast
continue
  call beginsub('gtvarslicenext')
  if (present(dimord)) call dbgmessage('dimord=%d', i=(/dimord/))
 
  call map_lookup(var, vid=vid, ndims=nd)
  if (vid < 0) then
    mystat = nf90_enotvar
    goto 999
  endif
  if (nd <= 0) then
    call dbgmessage('dimension map not associated')
    mystat = gt_enomoredims
    goto 999
  endif
  allocate(map(nd))
  call map_lookup(var, map=map)
 
  if (present(dimord)) then
    if (dimord < 0 .or. dimord <= size(map)) then
      call dbgmessage('dimord=%d is out of 1..%d', i=(/dimord, size(map)/))
      mystat = nf90_einval
      goto 995
    endif
    idim_lo = dimord
    idim_hi = dimord
  else
    idim_lo = 1
    idim_hi = size(map)
  endif
  call dbgmessage('idim scan range=(%d:%d)', i=(/idim_lo, idim_hi/))
 
  mystat = gt_enomoredims
  do, id = idim_lo, idim_hi
    ilast = map(id)%start + (map(id)%count * 2 - 1) * map(id)%stride
    call dbgmessage('last_index=%d allcount=%d', &
      & i=(/ilast, map(id)%allcount/))
    if (ilast >= 1 .and. ilast <= map(id)%allcount) then
      map(id)%start = map(id)%start + map(id)%count * map(id)%stride
      mystat = dc_noerr
      exit
    endif
  enddo
  if (mystat /= dc_noerr) goto 995
  call map_set(var, map, mystat)
 
995 continue
  deallocate(map)
 
999 continue
  if (present(stat)) then
    stat = mystat
    if (present(err)) err = (mystat /= dc_noerr)
  else
    call storeerror(mystat, "GTVarSliceNext", err)
  endif
  call endsub('gtvarslicenext', 'stat=%d', i=(/mystat/))
end subroutine gtvarslicenext