gtvargetpointernum.f90

Path: gtvargetpointernum.f90
Last Update: Mon Jan 16 06:43:14 JST 2006

ポインタ配列への数値データの入力

Authors:Yasuhiro MORIKAWA, Eizi TOYODA
Version:$Id: gtvargetpointernum.f90,v 1.5 2006/01/15 21:43:14 morikawa Exp $
Tag Name:$Name: gt4f90io-20060121-1 $
Copyright:Copyright (C) GFD Dennou Club, 2000-2005. All rights reserved.
License:See COPYRIGHT

以下のサブルーチン、関数は gtdata_generic から gtdata_generic#Get として提供されます。

Methods

Included Modules

gtdata_types gtdata_generic gt_map an_generic dc_types dc_trace dc_error

Public Instance methods

Subroutine :
var :type(GT_VARIABLE), intent(inout)
value(:) :real(DP), pointer
: (out)
err :logical, intent(out), optional

ポインタ配列への数値データの入力

変数 var から value に数値データが入力されます。 value はポインタ配列であり、数値データのサイズに合わせた 配列サイズが自動的に割り付けられます。 Get は複数のサブルーチンの総称名であり、 1 〜 7 次元のポインタを与えることが可能です。 また value に固定長配列を与えることが可能な手続きもあります。 下記を参照してください。

value が既に割り付けられており、且つ入力する数値データと配列 サイズが異なる場合、エラー (コード dc_error#GT_EBADALLOCATESIZE) を生じます。原則的には value を空状態にして与えることを 推奨します。不定状態で与えることは予期せぬ動作を招く可能性が あるため禁止します。

数値データ入力や上記の割り付けの際にエラーが生じた場合、メッセージ を出力してプログラムは強制終了します。err を与えてある場合には の引数に .true. が返り、プログラムは終了しません。

入力しようとするデータの型が引数の型と異なる場合、データは引数の 型に変換されます。 この変換は netCDF の機能を用いています。 詳しくは netCDF 日本語版マニュアル の 3.3 型変換 を参照してください。

This subroutine returns multi-dimensional data to argument "value". You need to provide GT_VARIABLE variable to argument "var". If you provide logical argument "err", .true. is returned instead of abort with messages when error is occurred.

[Source]

subroutine GTVarGetPointerDouble1(var, value, err)
  !
  !
  !== ポインタ配列への数値データの入力
  !
  ! 変数 *var* から *value* に数値データが入力されます。
  ! *value* はポインタ配列であり、数値データのサイズに合わせた
  ! 配列サイズが自動的に割り付けられます。
  ! *Get* は複数のサブルーチンの総称名であり、
  ! 1 〜 7 次元のポインタを与えることが可能です。
  ! また *value* に固定長配列を与えることが可能な手続きもあります。
  ! 下記を参照してください。
  !
  ! *value* が既に割り付けられており、且つ入力する数値データと配列
  ! サイズが異なる場合、エラー (コード dc_error#GT_EBADALLOCATESIZE)
  ! を生じます。原則的には *value* を空状態にして与えることを
  ! 推奨します。不定状態で与えることは予期せぬ動作を招く可能性が
  ! あるため禁止します。
  !
  ! 数値データ入力や上記の割り付けの際にエラーが生じた場合、メッセージ
  ! を出力してプログラムは強制終了します。*err* を与えてある場合には
  ! の引数に .true. が返り、プログラムは終了しません。
  !
  ! 入力しようとするデータの型が引数の型と異なる場合、データは引数の
  ! 型に変換されます。 この変換は netCDF の機能を用いています。
  ! 詳しくは {netCDF 日本語版マニュアル}[link:../xref.htm#label-10]
  ! の 3.3 型変換 を参照してください。
  !
  !
  ! This subroutine returns multi-dimensional data to argument "value".
  ! You need to provide GT_VARIABLE variable to argument "var".
  ! If you provide logical argument "err", .true. is returned
  ! instead of abort with messages when error is occurred.
  !
  use gtdata_types,   only: GT_VARIABLE
  use gtdata_generic, only: Get_Slice, GTVarGetDouble, GTVarGetReal
  use gt_map,         only: map_set_rank
  use an_generic,     only: Get, AN_VARIABLE
  use dc_types,       only: STRING, DP
  use dc_trace,       only: BeginSub, EndSub, DbgMessage
  use dc_error,       only: StoreError, DC_NOERR, GT_EBADALLOCATESIZE
  implicit none
  type(GT_VARIABLE), intent(inout):: var
  real(DP), pointer :: value(:) !(out)
  logical, intent(out), optional  :: err
  integer                         :: stat, n(1)

continue

  call BeginSub('GTVarGetPointerDouble1', 'var.mapid=%d', i=(/var%mapid/))
  call map_set_rank(var, 1, stat)
  if (stat /= DC_NOERR) goto 999
  call Get_Slice(var, dimord=1, count=n(1), count_compact=.false.)
  ! value が allocate されていなければ allocate する.
  ! value が既に allocate されていてサイズが取得するデータと同じで
  ! あればそのまま取得.
  ! value が allocate されていてサイズが異なる場合はエラー.
  !
  if ( associated(value) ) then
    if (  .not. size(value,1) == n(1) .or.  .false.                             ) then

      stat = GT_EBADALLOCATESIZE
      if (stat /= DC_NOERR) goto 999
    else
      call DbgMessage('@ value is already allocated')
    endif
  else
    call DbgMessage('@ allocate value')
    allocate( value (    n(1)  )    )
  endif

  call GTVarGetDouble(var, value, product(n), err)
!    call DbgMessage('max=%f min=%f', d=(/maxval(value), minval(value)/))
999 continue
  call StoreError(stat, "GTVarGetPointerDouble", err)
  call EndSub('GTVarGetPointerDouble1', 'n=%d', i=(/n/))
end subroutine GTVarGetPointerDouble1
Subroutine :
var :type(GT_VARIABLE), intent(inout)
value(:,:) :real(DP), pointer
: (out)
err :logical, intent(out), optional

[Source]

subroutine GTVarGetPointerDouble2(var, value, err)
  !

  !
  use gtdata_types,   only: GT_VARIABLE
  use gtdata_generic, only: Get_Slice, GTVarGetDouble, GTVarGetReal
  use gt_map,         only: map_set_rank
  use an_generic,     only: Get, AN_VARIABLE
  use dc_types,       only: STRING, DP
  use dc_trace,       only: BeginSub, EndSub, DbgMessage
  use dc_error,       only: StoreError, DC_NOERR, GT_EBADALLOCATESIZE
  implicit none
  type(GT_VARIABLE), intent(inout):: var
  real(DP), pointer :: value(:,:) !(out)
  logical, intent(out), optional  :: err
  integer                         :: stat, n(2)

continue

  call BeginSub('GTVarGetPointerDouble2', 'var.mapid=%d', i=(/var%mapid/))
  call map_set_rank(var, 2, stat)
  if (stat /= DC_NOERR) goto 999
  call Get_Slice(var, dimord=1, count=n(1), count_compact=.false.)
  call Get_Slice(var, dimord=2, count=n(2), count_compact=.false.)
  ! value が allocate されていなければ allocate する.
  ! value が既に allocate されていてサイズが取得するデータと同じで
  ! あればそのまま取得.
  ! value が allocate されていてサイズが異なる場合はエラー.
  !
  if ( associated(value) ) then
    if (  .not. size(value,1) == n(1) .or.  .not. size(value,2) == n(2) .or.  .false.                             ) then

      stat = GT_EBADALLOCATESIZE
      if (stat /= DC_NOERR) goto 999
    else
      call DbgMessage('@ value is already allocated')
    endif
  else
    call DbgMessage('@ allocate value')
    allocate( value (    n(1),     n(2)  )    )
  endif

  call GTVarGetDouble(var, value, product(n), err)
!    call DbgMessage('max=%f min=%f', d=(/maxval(value), minval(value)/))
999 continue
  call StoreError(stat, "GTVarGetPointerDouble", err)
  call EndSub('GTVarGetPointerDouble2', 'n=%d', i=(/n/))
end subroutine GTVarGetPointerDouble2
Subroutine :
var :type(GT_VARIABLE), intent(inout)
value(:,:,:) :real(DP), pointer
: (out)
err :logical, intent(out), optional

[Source]

subroutine GTVarGetPointerDouble3(var, value, err)
  !

  !
  use gtdata_types,   only: GT_VARIABLE
  use gtdata_generic, only: Get_Slice, GTVarGetDouble, GTVarGetReal
  use gt_map,         only: map_set_rank
  use an_generic,     only: Get, AN_VARIABLE
  use dc_types,       only: STRING, DP
  use dc_trace,       only: BeginSub, EndSub, DbgMessage
  use dc_error,       only: StoreError, DC_NOERR, GT_EBADALLOCATESIZE
  implicit none
  type(GT_VARIABLE), intent(inout):: var
  real(DP), pointer :: value(:,:,:) !(out)
  logical, intent(out), optional  :: err
  integer                         :: stat, n(3)

continue

  call BeginSub('GTVarGetPointerDouble3', 'var.mapid=%d', i=(/var%mapid/))
  call map_set_rank(var, 3, stat)
  if (stat /= DC_NOERR) goto 999
  call Get_Slice(var, dimord=1, count=n(1), count_compact=.false.)
  call Get_Slice(var, dimord=2, count=n(2), count_compact=.false.)
  call Get_Slice(var, dimord=3, count=n(3), count_compact=.false.)
  ! value が allocate されていなければ allocate する.
  ! value が既に allocate されていてサイズが取得するデータと同じで
  ! あればそのまま取得.
  ! value が allocate されていてサイズが異なる場合はエラー.
  !
  if ( associated(value) ) then
    if (  .not. size(value,1) == n(1) .or.  .not. size(value,2) == n(2) .or.  .not. size(value,3) == n(3) .or.  .false.                             ) then

      stat = GT_EBADALLOCATESIZE
      if (stat /= DC_NOERR) goto 999
    else
      call DbgMessage('@ value is already allocated')
    endif
  else
    call DbgMessage('@ allocate value')
    allocate( value (    n(1),     n(2),     n(3)  )    )
  endif

  call GTVarGetDouble(var, value, product(n), err)
!    call DbgMessage('max=%f min=%f', d=(/maxval(value), minval(value)/))
999 continue
  call StoreError(stat, "GTVarGetPointerDouble", err)
  call EndSub('GTVarGetPointerDouble3', 'n=%d', i=(/n/))
end subroutine GTVarGetPointerDouble3
Subroutine :
var :type(GT_VARIABLE), intent(inout)
value(:,:,:,:) :real(DP), pointer
: (out)
err :logical, intent(out), optional

[Source]

subroutine GTVarGetPointerDouble4(var, value, err)
  !

  !
  use gtdata_types,   only: GT_VARIABLE
  use gtdata_generic, only: Get_Slice, GTVarGetDouble, GTVarGetReal
  use gt_map,         only: map_set_rank
  use an_generic,     only: Get, AN_VARIABLE
  use dc_types,       only: STRING, DP
  use dc_trace,       only: BeginSub, EndSub, DbgMessage
  use dc_error,       only: StoreError, DC_NOERR, GT_EBADALLOCATESIZE
  implicit none
  type(GT_VARIABLE), intent(inout):: var
  real(DP), pointer :: value(:,:,:,:) !(out)
  logical, intent(out), optional  :: err
  integer                         :: stat, n(4)

continue

  call BeginSub('GTVarGetPointerDouble4', 'var.mapid=%d', i=(/var%mapid/))
  call map_set_rank(var, 4, stat)
  if (stat /= DC_NOERR) goto 999
  call Get_Slice(var, dimord=1, count=n(1), count_compact=.false.)
  call Get_Slice(var, dimord=2, count=n(2), count_compact=.false.)
  call Get_Slice(var, dimord=3, count=n(3), count_compact=.false.)
  call Get_Slice(var, dimord=4, count=n(4), count_compact=.false.)
  ! value が allocate されていなければ allocate する.
  ! value が既に allocate されていてサイズが取得するデータと同じで
  ! あればそのまま取得.
  ! value が allocate されていてサイズが異なる場合はエラー.
  !
  if ( associated(value) ) then
    if (  .not. size(value,1) == n(1) .or.  .not. size(value,2) == n(2) .or.  .not. size(value,3) == n(3) .or.  .not. size(value,4) == n(4) .or.  .false.                             ) then

      stat = GT_EBADALLOCATESIZE
      if (stat /= DC_NOERR) goto 999
    else
      call DbgMessage('@ value is already allocated')
    endif
  else
    call DbgMessage('@ allocate value')
    allocate( value (    n(1),     n(2),     n(3),     n(4)  )    )
  endif

  call GTVarGetDouble(var, value, product(n), err)
!    call DbgMessage('max=%f min=%f', d=(/maxval(value), minval(value)/))
999 continue
  call StoreError(stat, "GTVarGetPointerDouble", err)
  call EndSub('GTVarGetPointerDouble4', 'n=%d', i=(/n/))
end subroutine GTVarGetPointerDouble4
Subroutine :
var :type(GT_VARIABLE), intent(inout)
value(:,:,:,:,:) :real(DP), pointer
: (out)
err :logical, intent(out), optional

[Source]

subroutine GTVarGetPointerDouble5(var, value, err)
  !

  !
  use gtdata_types,   only: GT_VARIABLE
  use gtdata_generic, only: Get_Slice, GTVarGetDouble, GTVarGetReal
  use gt_map,         only: map_set_rank
  use an_generic,     only: Get, AN_VARIABLE
  use dc_types,       only: STRING, DP
  use dc_trace,       only: BeginSub, EndSub, DbgMessage
  use dc_error,       only: StoreError, DC_NOERR, GT_EBADALLOCATESIZE
  implicit none
  type(GT_VARIABLE), intent(inout):: var
  real(DP), pointer :: value(:,:,:,:,:) !(out)
  logical, intent(out), optional  :: err
  integer                         :: stat, n(5)

continue

  call BeginSub('GTVarGetPointerDouble5', 'var.mapid=%d', i=(/var%mapid/))
  call map_set_rank(var, 5, stat)
  if (stat /= DC_NOERR) goto 999
  call Get_Slice(var, dimord=1, count=n(1), count_compact=.false.)
  call Get_Slice(var, dimord=2, count=n(2), count_compact=.false.)
  call Get_Slice(var, dimord=3, count=n(3), count_compact=.false.)
  call Get_Slice(var, dimord=4, count=n(4), count_compact=.false.)
  call Get_Slice(var, dimord=5, count=n(5), count_compact=.false.)
  ! value が allocate されていなければ allocate する.
  ! value が既に allocate されていてサイズが取得するデータと同じで
  ! あればそのまま取得.
  ! value が allocate されていてサイズが異なる場合はエラー.
  !
  if ( associated(value) ) then
    if (  .not. size(value,1) == n(1) .or.  .not. size(value,2) == n(2) .or.  .not. size(value,3) == n(3) .or.  .not. size(value,4) == n(4) .or.  .not. size(value,5) == n(5) .or.  .false.                             ) then

      stat = GT_EBADALLOCATESIZE
      if (stat /= DC_NOERR) goto 999
    else
      call DbgMessage('@ value is already allocated')
    endif
  else
    call DbgMessage('@ allocate value')
    allocate( value (    n(1),     n(2),     n(3),     n(4),     n(5)  )    )
  endif

  call GTVarGetDouble(var, value, product(n), err)
!    call DbgMessage('max=%f min=%f', d=(/maxval(value), minval(value)/))
999 continue
  call StoreError(stat, "GTVarGetPointerDouble", err)
  call EndSub('GTVarGetPointerDouble5', 'n=%d', i=(/n/))
end subroutine GTVarGetPointerDouble5
Subroutine :
var :type(GT_VARIABLE), intent(inout)
value(:,:,:,:,:,:) :real(DP), pointer
: (out)
err :logical, intent(out), optional

[Source]

subroutine GTVarGetPointerDouble6(var, value, err)
  !

  !
  use gtdata_types,   only: GT_VARIABLE
  use gtdata_generic, only: Get_Slice, GTVarGetDouble, GTVarGetReal
  use gt_map,         only: map_set_rank
  use an_generic,     only: Get, AN_VARIABLE
  use dc_types,       only: STRING, DP
  use dc_trace,       only: BeginSub, EndSub, DbgMessage
  use dc_error,       only: StoreError, DC_NOERR, GT_EBADALLOCATESIZE
  implicit none
  type(GT_VARIABLE), intent(inout):: var
  real(DP), pointer :: value(:,:,:,:,:,:) !(out)
  logical, intent(out), optional  :: err
  integer                         :: stat, n(6)

continue

  call BeginSub('GTVarGetPointerDouble6', 'var.mapid=%d', i=(/var%mapid/))
  call map_set_rank(var, 6, stat)
  if (stat /= DC_NOERR) goto 999
  call Get_Slice(var, dimord=1, count=n(1), count_compact=.false.)
  call Get_Slice(var, dimord=2, count=n(2), count_compact=.false.)
  call Get_Slice(var, dimord=3, count=n(3), count_compact=.false.)
  call Get_Slice(var, dimord=4, count=n(4), count_compact=.false.)
  call Get_Slice(var, dimord=5, count=n(5), count_compact=.false.)
  call Get_Slice(var, dimord=6, count=n(6), count_compact=.false.)
  ! value が allocate されていなければ allocate する.
  ! value が既に allocate されていてサイズが取得するデータと同じで
  ! あればそのまま取得.
  ! value が allocate されていてサイズが異なる場合はエラー.
  !
  if ( associated(value) ) then
    if (  .not. size(value,1) == n(1) .or.  .not. size(value,2) == n(2) .or.  .not. size(value,3) == n(3) .or.  .not. size(value,4) == n(4) .or.  .not. size(value,5) == n(5) .or.  .not. size(value,6) == n(6) .or.  .false.                             ) then

      stat = GT_EBADALLOCATESIZE
      if (stat /= DC_NOERR) goto 999
    else
      call DbgMessage('@ value is already allocated')
    endif
  else
    call DbgMessage('@ allocate value')
    allocate( value (    n(1),     n(2),     n(3),     n(4),     n(5),     n(6)  )    )
  endif

  call GTVarGetDouble(var, value, product(n), err)
!    call DbgMessage('max=%f min=%f', d=(/maxval(value), minval(value)/))
999 continue
  call StoreError(stat, "GTVarGetPointerDouble", err)
  call EndSub('GTVarGetPointerDouble6', 'n=%d', i=(/n/))
end subroutine GTVarGetPointerDouble6
Subroutine :
var :type(GT_VARIABLE), intent(inout)
value(:,:,:,:,:,:,:) :real(DP), pointer
: (out)
err :logical, intent(out), optional

[Source]

subroutine GTVarGetPointerDouble7(var, value, err)
  !

  !
  use gtdata_types,   only: GT_VARIABLE
  use gtdata_generic, only: Get_Slice, GTVarGetDouble, GTVarGetReal
  use gt_map,         only: map_set_rank
  use an_generic,     only: Get, AN_VARIABLE
  use dc_types,       only: STRING, DP
  use dc_trace,       only: BeginSub, EndSub, DbgMessage
  use dc_error,       only: StoreError, DC_NOERR, GT_EBADALLOCATESIZE
  implicit none
  type(GT_VARIABLE), intent(inout):: var
  real(DP), pointer :: value(:,:,:,:,:,:,:) !(out)
  logical, intent(out), optional  :: err
  integer                         :: stat, n(7)

continue

  call BeginSub('GTVarGetPointerDouble7', 'var.mapid=%d', i=(/var%mapid/))
  call map_set_rank(var, 7, stat)
  if (stat /= DC_NOERR) goto 999
  call Get_Slice(var, dimord=1, count=n(1), count_compact=.false.)
  call Get_Slice(var, dimord=2, count=n(2), count_compact=.false.)
  call Get_Slice(var, dimord=3, count=n(3), count_compact=.false.)
  call Get_Slice(var, dimord=4, count=n(4), count_compact=.false.)
  call Get_Slice(var, dimord=5, count=n(5), count_compact=.false.)
  call Get_Slice(var, dimord=6, count=n(6), count_compact=.false.)
  call Get_Slice(var, dimord=7, count=n(7), count_compact=.false.)
  ! value が allocate されていなければ allocate する.
  ! value が既に allocate されていてサイズが取得するデータと同じで
  ! あればそのまま取得.
  ! value が allocate されていてサイズが異なる場合はエラー.
  !
  if ( associated(value) ) then
    if (  .not. size(value,1) == n(1) .or.  .not. size(value,2) == n(2) .or.  .not. size(value,3) == n(3) .or.  .not. size(value,4) == n(4) .or.  .not. size(value,5) == n(5) .or.  .not. size(value,6) == n(6) .or.  .not. size(value,7) == n(7) .or.  .false.                             ) then

      stat = GT_EBADALLOCATESIZE
      if (stat /= DC_NOERR) goto 999
    else
      call DbgMessage('@ value is already allocated')
    endif
  else
    call DbgMessage('@ allocate value')
    allocate( value (    n(1),     n(2),     n(3),     n(4),     n(5),     n(6),     n(7)  )    )
  endif

  call GTVarGetDouble(var, value, product(n), err)
!    call DbgMessage('max=%f min=%f', d=(/maxval(value), minval(value)/))
999 continue
  call StoreError(stat, "GTVarGetPointerDouble", err)
  call EndSub('GTVarGetPointerDouble7', 'n=%d', i=(/n/))
end subroutine GTVarGetPointerDouble7
Subroutine :
var :type(GT_VARIABLE), intent(inout)
value(:) :real, pointer
: (out)
err :logical, intent(out), optional

[Source]

subroutine GTVarGetPointerReal1(var, value, err)
  !

  !
  use gtdata_types,   only: GT_VARIABLE
  use gtdata_generic, only: Get_Slice, GTVarGetDouble, GTVarGetReal
  use gt_map,         only: map_set_rank
  use an_generic,     only: Get, AN_VARIABLE
  use dc_types,       only: STRING, DP
  use dc_trace,       only: BeginSub, EndSub, DbgMessage
  use dc_error,       only: StoreError, DC_NOERR, GT_EBADALLOCATESIZE
  implicit none
  type(GT_VARIABLE), intent(inout):: var
  real, pointer :: value(:) !(out)
  logical, intent(out), optional  :: err
  integer                         :: stat, n(1)

continue

  call BeginSub('GTVarGetPointerReal1', 'var.mapid=%d', i=(/var%mapid/))
  call map_set_rank(var, 1, stat)
  if (stat /= DC_NOERR) goto 999
  call Get_Slice(var, dimord=1, count=n(1), count_compact=.false.)
  ! value が allocate されていなければ allocate する.
  ! value が既に allocate されていてサイズが取得するデータと同じで
  ! あればそのまま取得.
  ! value が allocate されていてサイズが異なる場合はエラー.
  !
  if ( associated(value) ) then
    if (  .not. size(value,1) == n(1) .or.  .false.                             ) then

      stat = GT_EBADALLOCATESIZE
      if (stat /= DC_NOERR) goto 999
    else
      call DbgMessage('@ value is already allocated')
    endif
  else
    call DbgMessage('@ allocate value')
    allocate( value (    n(1)  )    )
  endif

  call GTVarGetReal(var, value, product(n), err)
!    call DbgMessage('max=%f min=%f', d=(/maxval(value), minval(value)/))
999 continue
  call StoreError(stat, "GTVarGetPointerReal", err)
  call EndSub('GTVarGetPointerReal1', 'n=%d', i=(/n/))
end subroutine GTVarGetPointerReal1
Subroutine :
var :type(GT_VARIABLE), intent(inout)
value(:,:) :real, pointer
: (out)
err :logical, intent(out), optional

[Source]

subroutine GTVarGetPointerReal2(var, value, err)
  !

  !
  use gtdata_types,   only: GT_VARIABLE
  use gtdata_generic, only: Get_Slice, GTVarGetDouble, GTVarGetReal
  use gt_map,         only: map_set_rank
  use an_generic,     only: Get, AN_VARIABLE
  use dc_types,       only: STRING, DP
  use dc_trace,       only: BeginSub, EndSub, DbgMessage
  use dc_error,       only: StoreError, DC_NOERR, GT_EBADALLOCATESIZE
  implicit none
  type(GT_VARIABLE), intent(inout):: var
  real, pointer :: value(:,:) !(out)
  logical, intent(out), optional  :: err
  integer                         :: stat, n(2)

continue

  call BeginSub('GTVarGetPointerReal2', 'var.mapid=%d', i=(/var%mapid/))
  call map_set_rank(var, 2, stat)
  if (stat /= DC_NOERR) goto 999
  call Get_Slice(var, dimord=1, count=n(1), count_compact=.false.)
  call Get_Slice(var, dimord=2, count=n(2), count_compact=.false.)
  ! value が allocate されていなければ allocate する.
  ! value が既に allocate されていてサイズが取得するデータと同じで
  ! あればそのまま取得.
  ! value が allocate されていてサイズが異なる場合はエラー.
  !
  if ( associated(value) ) then
    if (  .not. size(value,1) == n(1) .or.  .not. size(value,2) == n(2) .or.  .false.                             ) then

      stat = GT_EBADALLOCATESIZE
      if (stat /= DC_NOERR) goto 999
    else
      call DbgMessage('@ value is already allocated')
    endif
  else
    call DbgMessage('@ allocate value')
    allocate( value (    n(1),     n(2)  )    )
  endif

  call GTVarGetReal(var, value, product(n), err)
!    call DbgMessage('max=%f min=%f', d=(/maxval(value), minval(value)/))
999 continue
  call StoreError(stat, "GTVarGetPointerReal", err)
  call EndSub('GTVarGetPointerReal2', 'n=%d', i=(/n/))
end subroutine GTVarGetPointerReal2
Subroutine :
var :type(GT_VARIABLE), intent(inout)
value(:,:,:) :real, pointer
: (out)
err :logical, intent(out), optional

[Source]

subroutine GTVarGetPointerReal3(var, value, err)
  !

  !
  use gtdata_types,   only: GT_VARIABLE
  use gtdata_generic, only: Get_Slice, GTVarGetDouble, GTVarGetReal
  use gt_map,         only: map_set_rank
  use an_generic,     only: Get, AN_VARIABLE
  use dc_types,       only: STRING, DP
  use dc_trace,       only: BeginSub, EndSub, DbgMessage
  use dc_error,       only: StoreError, DC_NOERR, GT_EBADALLOCATESIZE
  implicit none
  type(GT_VARIABLE), intent(inout):: var
  real, pointer :: value(:,:,:) !(out)
  logical, intent(out), optional  :: err
  integer                         :: stat, n(3)

continue

  call BeginSub('GTVarGetPointerReal3', 'var.mapid=%d', i=(/var%mapid/))
  call map_set_rank(var, 3, stat)
  if (stat /= DC_NOERR) goto 999
  call Get_Slice(var, dimord=1, count=n(1), count_compact=.false.)
  call Get_Slice(var, dimord=2, count=n(2), count_compact=.false.)
  call Get_Slice(var, dimord=3, count=n(3), count_compact=.false.)
  ! value が allocate されていなければ allocate する.
  ! value が既に allocate されていてサイズが取得するデータと同じで
  ! あればそのまま取得.
  ! value が allocate されていてサイズが異なる場合はエラー.
  !
  if ( associated(value) ) then
    if (  .not. size(value,1) == n(1) .or.  .not. size(value,2) == n(2) .or.  .not. size(value,3) == n(3) .or.  .false.                             ) then

      stat = GT_EBADALLOCATESIZE
      if (stat /= DC_NOERR) goto 999
    else
      call DbgMessage('@ value is already allocated')
    endif
  else
    call DbgMessage('@ allocate value')
    allocate( value (    n(1),     n(2),     n(3)  )    )
  endif

  call GTVarGetReal(var, value, product(n), err)
!    call DbgMessage('max=%f min=%f', d=(/maxval(value), minval(value)/))
999 continue
  call StoreError(stat, "GTVarGetPointerReal", err)
  call EndSub('GTVarGetPointerReal3', 'n=%d', i=(/n/))
end subroutine GTVarGetPointerReal3
Subroutine :
var :type(GT_VARIABLE), intent(inout)
value(:,:,:,:) :real, pointer
: (out)
err :logical, intent(out), optional

[Source]

subroutine GTVarGetPointerReal4(var, value, err)
  !

  !
  use gtdata_types,   only: GT_VARIABLE
  use gtdata_generic, only: Get_Slice, GTVarGetDouble, GTVarGetReal
  use gt_map,         only: map_set_rank
  use an_generic,     only: Get, AN_VARIABLE
  use dc_types,       only: STRING, DP
  use dc_trace,       only: BeginSub, EndSub, DbgMessage
  use dc_error,       only: StoreError, DC_NOERR, GT_EBADALLOCATESIZE
  implicit none
  type(GT_VARIABLE), intent(inout):: var
  real, pointer :: value(:,:,:,:) !(out)
  logical, intent(out), optional  :: err
  integer                         :: stat, n(4)

continue

  call BeginSub('GTVarGetPointerReal4', 'var.mapid=%d', i=(/var%mapid/))
  call map_set_rank(var, 4, stat)
  if (stat /= DC_NOERR) goto 999
  call Get_Slice(var, dimord=1, count=n(1), count_compact=.false.)
  call Get_Slice(var, dimord=2, count=n(2), count_compact=.false.)
  call Get_Slice(var, dimord=3, count=n(3), count_compact=.false.)
  call Get_Slice(var, dimord=4, count=n(4), count_compact=.false.)
  ! value が allocate されていなければ allocate する.
  ! value が既に allocate されていてサイズが取得するデータと同じで
  ! あればそのまま取得.
  ! value が allocate されていてサイズが異なる場合はエラー.
  !
  if ( associated(value) ) then
    if (  .not. size(value,1) == n(1) .or.  .not. size(value,2) == n(2) .or.  .not. size(value,3) == n(3) .or.  .not. size(value,4) == n(4) .or.  .false.                             ) then

      stat = GT_EBADALLOCATESIZE
      if (stat /= DC_NOERR) goto 999
    else
      call DbgMessage('@ value is already allocated')
    endif
  else
    call DbgMessage('@ allocate value')
    allocate( value (    n(1),     n(2),     n(3),     n(4)  )    )
  endif

  call GTVarGetReal(var, value, product(n), err)
!    call DbgMessage('max=%f min=%f', d=(/maxval(value), minval(value)/))
999 continue
  call StoreError(stat, "GTVarGetPointerReal", err)
  call EndSub('GTVarGetPointerReal4', 'n=%d', i=(/n/))
end subroutine GTVarGetPointerReal4
Subroutine :
var :type(GT_VARIABLE), intent(inout)
value(:,:,:,:,:) :real, pointer
: (out)
err :logical, intent(out), optional

[Source]

subroutine GTVarGetPointerReal5(var, value, err)
  !

  !
  use gtdata_types,   only: GT_VARIABLE
  use gtdata_generic, only: Get_Slice, GTVarGetDouble, GTVarGetReal
  use gt_map,         only: map_set_rank
  use an_generic,     only: Get, AN_VARIABLE
  use dc_types,       only: STRING, DP
  use dc_trace,       only: BeginSub, EndSub, DbgMessage
  use dc_error,       only: StoreError, DC_NOERR, GT_EBADALLOCATESIZE
  implicit none
  type(GT_VARIABLE), intent(inout):: var
  real, pointer :: value(:,:,:,:,:) !(out)
  logical, intent(out), optional  :: err
  integer                         :: stat, n(5)

continue

  call BeginSub('GTVarGetPointerReal5', 'var.mapid=%d', i=(/var%mapid/))
  call map_set_rank(var, 5, stat)
  if (stat /= DC_NOERR) goto 999
  call Get_Slice(var, dimord=1, count=n(1), count_compact=.false.)
  call Get_Slice(var, dimord=2, count=n(2), count_compact=.false.)
  call Get_Slice(var, dimord=3, count=n(3), count_compact=.false.)
  call Get_Slice(var, dimord=4, count=n(4), count_compact=.false.)
  call Get_Slice(var, dimord=5, count=n(5), count_compact=.false.)
  ! value が allocate されていなければ allocate する.
  ! value が既に allocate されていてサイズが取得するデータと同じで
  ! あればそのまま取得.
  ! value が allocate されていてサイズが異なる場合はエラー.
  !
  if ( associated(value) ) then
    if (  .not. size(value,1) == n(1) .or.  .not. size(value,2) == n(2) .or.  .not. size(value,3) == n(3) .or.  .not. size(value,4) == n(4) .or.  .not. size(value,5) == n(5) .or.  .false.                             ) then

      stat = GT_EBADALLOCATESIZE
      if (stat /= DC_NOERR) goto 999
    else
      call DbgMessage('@ value is already allocated')
    endif
  else
    call DbgMessage('@ allocate value')
    allocate( value (    n(1),     n(2),     n(3),     n(4),     n(5)  )    )
  endif

  call GTVarGetReal(var, value, product(n), err)
!    call DbgMessage('max=%f min=%f', d=(/maxval(value), minval(value)/))
999 continue
  call StoreError(stat, "GTVarGetPointerReal", err)
  call EndSub('GTVarGetPointerReal5', 'n=%d', i=(/n/))
end subroutine GTVarGetPointerReal5
Subroutine :
var :type(GT_VARIABLE), intent(inout)
value(:,:,:,:,:,:) :real, pointer
: (out)
err :logical, intent(out), optional

[Source]

subroutine GTVarGetPointerReal6(var, value, err)
  !

  !
  use gtdata_types,   only: GT_VARIABLE
  use gtdata_generic, only: Get_Slice, GTVarGetDouble, GTVarGetReal
  use gt_map,         only: map_set_rank
  use an_generic,     only: Get, AN_VARIABLE
  use dc_types,       only: STRING, DP
  use dc_trace,       only: BeginSub, EndSub, DbgMessage
  use dc_error,       only: StoreError, DC_NOERR, GT_EBADALLOCATESIZE
  implicit none
  type(GT_VARIABLE), intent(inout):: var
  real, pointer :: value(:,:,:,:,:,:) !(out)
  logical, intent(out), optional  :: err
  integer                         :: stat, n(6)

continue

  call BeginSub('GTVarGetPointerReal6', 'var.mapid=%d', i=(/var%mapid/))
  call map_set_rank(var, 6, stat)
  if (stat /= DC_NOERR) goto 999
  call Get_Slice(var, dimord=1, count=n(1), count_compact=.false.)
  call Get_Slice(var, dimord=2, count=n(2), count_compact=.false.)
  call Get_Slice(var, dimord=3, count=n(3), count_compact=.false.)
  call Get_Slice(var, dimord=4, count=n(4), count_compact=.false.)
  call Get_Slice(var, dimord=5, count=n(5), count_compact=.false.)
  call Get_Slice(var, dimord=6, count=n(6), count_compact=.false.)
  ! value が allocate されていなければ allocate する.
  ! value が既に allocate されていてサイズが取得するデータと同じで
  ! あればそのまま取得.
  ! value が allocate されていてサイズが異なる場合はエラー.
  !
  if ( associated(value) ) then
    if (  .not. size(value,1) == n(1) .or.  .not. size(value,2) == n(2) .or.  .not. size(value,3) == n(3) .or.  .not. size(value,4) == n(4) .or.  .not. size(value,5) == n(5) .or.  .not. size(value,6) == n(6) .or.  .false.                             ) then

      stat = GT_EBADALLOCATESIZE
      if (stat /= DC_NOERR) goto 999
    else
      call DbgMessage('@ value is already allocated')
    endif
  else
    call DbgMessage('@ allocate value')
    allocate( value (    n(1),     n(2),     n(3),     n(4),     n(5),     n(6)  )    )
  endif

  call GTVarGetReal(var, value, product(n), err)
!    call DbgMessage('max=%f min=%f', d=(/maxval(value), minval(value)/))
999 continue
  call StoreError(stat, "GTVarGetPointerReal", err)
  call EndSub('GTVarGetPointerReal6', 'n=%d', i=(/n/))
end subroutine GTVarGetPointerReal6
Subroutine :
var :type(GT_VARIABLE), intent(inout)
value(:,:,:,:,:,:,:) :real, pointer
: (out)
err :logical, intent(out), optional

[Source]

subroutine GTVarGetPointerReal7(var, value, err)
  !

  !
  use gtdata_types,   only: GT_VARIABLE
  use gtdata_generic, only: Get_Slice, GTVarGetDouble, GTVarGetReal
  use gt_map,         only: map_set_rank
  use an_generic,     only: Get, AN_VARIABLE
  use dc_types,       only: STRING, DP
  use dc_trace,       only: BeginSub, EndSub, DbgMessage
  use dc_error,       only: StoreError, DC_NOERR, GT_EBADALLOCATESIZE
  implicit none
  type(GT_VARIABLE), intent(inout):: var
  real, pointer :: value(:,:,:,:,:,:,:) !(out)
  logical, intent(out), optional  :: err
  integer                         :: stat, n(7)

continue

  call BeginSub('GTVarGetPointerReal7', 'var.mapid=%d', i=(/var%mapid/))
  call map_set_rank(var, 7, stat)
  if (stat /= DC_NOERR) goto 999
  call Get_Slice(var, dimord=1, count=n(1), count_compact=.false.)
  call Get_Slice(var, dimord=2, count=n(2), count_compact=.false.)
  call Get_Slice(var, dimord=3, count=n(3), count_compact=.false.)
  call Get_Slice(var, dimord=4, count=n(4), count_compact=.false.)
  call Get_Slice(var, dimord=5, count=n(5), count_compact=.false.)
  call Get_Slice(var, dimord=6, count=n(6), count_compact=.false.)
  call Get_Slice(var, dimord=7, count=n(7), count_compact=.false.)
  ! value が allocate されていなければ allocate する.
  ! value が既に allocate されていてサイズが取得するデータと同じで
  ! あればそのまま取得.
  ! value が allocate されていてサイズが異なる場合はエラー.
  !
  if ( associated(value) ) then
    if (  .not. size(value,1) == n(1) .or.  .not. size(value,2) == n(2) .or.  .not. size(value,3) == n(3) .or.  .not. size(value,4) == n(4) .or.  .not. size(value,5) == n(5) .or.  .not. size(value,6) == n(6) .or.  .not. size(value,7) == n(7) .or.  .false.                             ) then

      stat = GT_EBADALLOCATESIZE
      if (stat /= DC_NOERR) goto 999
    else
      call DbgMessage('@ value is already allocated')
    endif
  else
    call DbgMessage('@ allocate value')
    allocate( value (    n(1),     n(2),     n(3),     n(4),     n(5),     n(6),     n(7)  )    )
  endif

  call GTVarGetReal(var, value, product(n), err)
!    call DbgMessage('max=%f min=%f', d=(/maxval(value), minval(value)/))
999 continue
  call StoreError(stat, "GTVarGetPointerReal", err)
  call EndSub('GTVarGetPointerReal7', 'n=%d', i=(/n/))
end subroutine GTVarGetPointerReal7

[Validate]