gtvarexchdim.f90

Go to the documentation of this file.

!> @file gtvarexchdim.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 Exchange dimension order numbers
!>
!> This subroutine is provided as gtdata_generic#Exch_dim
!> through gtdata_generic.
!> @enden
!>
!> @ja
!> @brief 次元順序番号の交換
!>
!> このサブルーチンは gtdata_generic から gtdata_generic#Exch_dim
!> として提供されます。
!> @endja
!>
 
!>
!> @en
!> @brief Exchange dimensions at specified order numbers
!>
!> Exchanges dimensions at dimension order numbers dimord1 and dimord2
!> in variable var.
!>
!> If count_compact is .true., operates including degenerate dimensions.
!>
!> If an error occurs, outputs a message and terminates the program.
!> If err is provided, returns .true. and program does not terminate.
!> @param[in]  var           Variable handle
!> @param[in]  dimord1       First dimension order number
!> @param[in]  dimord2       Second dimension order number
!> @param[in]  count_compact Include degenerate dimensions (optional)
!> @param[out] err           Error flag
!> @enden
!>
!> @ja
!> @brief 指定順序番号の次元を交換
!>
!> 変数 var の次元順序番号 dimord1, dimord2 のそれぞれに対応する次元を入れ替えます。
!>
!> count_compact に .true. を渡すと、縮退した次元も含めて動作します。
!>
!> エラーが生じた場合、メッセージを出力してプログラムは強制終了します。
!> err を与えてある場合にはの引数に .true. が返り、プログラムは終了しません。
!> @param[in]  var           変数ハンドル
!> @param[in]  dimord1       1番目の次元順序番号
!> @param[in]  dimord2       2番目の次元順序番号
!> @param[in]  count_compact 縮退次元を含むか (省略可能)
!> @param[out] err           エラーフラグ
!> @endja
!>
subroutine gtvarexchdim(var, dimord1, dimord2, count_compact, err)
  use gtdata_types, only: gt_variable
  use gtdata_internal_map, only: map_lookup, gt_dimmap, map_set_ndims, map_set, &
    & dimord_skip_compact
  use dc_trace, only: beginsub, endsub, dbgmessage
  implicit none
  type(gt_variable), intent(in):: var
  integer, intent(in):: dimord1, dimord2
  logical, intent(in), optional:: count_compact
  logical, intent(out):: err
  type(gt_dimmap), allocatable:: map(:)
  type(gt_dimmap):: tmpmap
  integer:: ndimsp, stat, idim1, idim2
  logical:: direct_mode
  character(*), parameter:: subname = 'GTVarExchDim'
continue
  err = .true.
  direct_mode = .false.
  if (present(count_compact)) then
    direct_mode = count_compact
  endif
  call beginsub(subname)
  if (dimord1 < 1 .or. dimord2 < 1) then
    call endsub(subname, "negative dimord=%d %d invalid", i=(/dimord1, dimord2/))
    return
  endif
  call map_lookup(var, ndims=ndimsp)
  if (ndimsp <= 0) then
    call endsub(subname, "variable invalid")
    return
  else if (dimord1 > ndimsp .or. dimord2 > ndimsp) then
    call endsub(subname, "dimord=%d %d not exist", i=(/dimord1, dimord2/))
    return
  endif
 
  allocate(map(ndimsp))
  call map_lookup(var, map=map)
 
  if (.not. direct_mode) then
    idim1 = dimord_skip_compact(dimord1, map)
    idim2 = dimord_skip_compact(dimord2, map)
    if (idim1 < 0 .or. idim2 < 0) then
      call endsub(subname, "dimord=%d %d not found after compaction", &
        & i=(/dimord1, dimord2/))
      deallocate(map)
      return
    endif
  else
    idim1 = dimord1
    idim2 = dimord2
  endif
 
  tmpmap = map(idim1)
  map(idim1) = map(idim2)
  map(idim2) = tmpmap
  call map_set(var, map, stat)
  deallocate(map)
 
  err = stat /= 0
  call endsub(subname)
end subroutine gtvarexchdim