gtvargetpointernum.f90

Path: src/gtvargetpointernum.f90
Last Update: Thu Sep 08 22:21:49 JST 2005
    Copyright (C) GFD Dennou Club, 2000-2005. All rights reserved.

Get multi-dimensional data from GT_VARIABLE to pointer arguments

Cautions

This file is created by "gtvargetpointertype.m4" by m4 command using "intrinsic_types.m4". Don‘t edit each files directly.

[JAPANESE]

この f90 ファイルは gtvargetpointertype.m4 から m4 コマンドを用いて生成 されています. f90 ファイルを直接編集しないで下さい. なお, m4 コマンドからの生成の際には intrinsic_types.m4 をインクルード しています.

Overview

This subroutines integrated "gtdata_generic" module, and provided as generic name "Get".

[JAPANESE]

このサブルーチン群は gtdata_generic モジュールで集約され, 総称名称 "Get" としてユーザに提供される.

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 returnd instead of abort with messages when error is occured.

[JAPANESE]

このサブルーチンは引数 value に多次元データを返す. 引数 var には GT_VARIABLE 変数を与えなければならない. 論理変数 err を与えた場合には, もしもプログラム内部でエラーが 生じた場合に .true. が返る. err を与えない場合, エラーが生じると 適切なメッセージを出力してプログラムは終了する.

Methods

Included Modules

gtdata_types gtdata_generic gt_map an_generic dc_types dc_trace dc_error

Public Instance methods

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

このサブルーチンは引数 value に多次元データを返す. 引数 var には GT_VARIABLE 変数を与えなければならない. 論理変数 err を与えた場合には, もしもプログラム内部でエラーが 生じた場合に .true. が返る. err を与えない場合, エラーが生じると 適切なメッセージを出力してプログラムは終了する.

[Source]

  subroutine GTVarGetPointerDouble1(var, value, err)

    implicit none
    type(GT_VARIABLE), intent(inout):: var
    real(DP),pointer :: value(:)
    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_EARGSIZEMISMATCH
          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
var :type(GT_VARIABLE), intent(inout)
value(:,:) :real(DP),pointer
err :logical, intent(out), optional

このサブルーチンは引数 value に多次元データを返す. 引数 var には GT_VARIABLE 変数を与えなければならない. 論理変数 err を与えた場合には, もしもプログラム内部でエラーが 生じた場合に .true. が返る. err を与えない場合, エラーが生じると 適切なメッセージを出力してプログラムは終了する.

[Source]

  subroutine GTVarGetPointerDouble2(var, value, err)

    implicit none
    type(GT_VARIABLE), intent(inout):: var
    real(DP),pointer :: value(:,:)
    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_EARGSIZEMISMATCH
          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
var :type(GT_VARIABLE), intent(inout)
value(:,:,:) :real(DP),pointer
err :logical, intent(out), optional

このサブルーチンは引数 value に多次元データを返す. 引数 var には GT_VARIABLE 変数を与えなければならない. 論理変数 err を与えた場合には, もしもプログラム内部でエラーが 生じた場合に .true. が返る. err を与えない場合, エラーが生じると 適切なメッセージを出力してプログラムは終了する.

[Source]

  subroutine GTVarGetPointerDouble3(var, value, err)

    implicit none
    type(GT_VARIABLE), intent(inout):: var
    real(DP),pointer :: value(:,:,:)
    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_EARGSIZEMISMATCH
          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
var :type(GT_VARIABLE), intent(inout)
value(:,:,:,:) :real(DP),pointer
err :logical, intent(out), optional

このサブルーチンは引数 value に多次元データを返す. 引数 var には GT_VARIABLE 変数を与えなければならない. 論理変数 err を与えた場合には, もしもプログラム内部でエラーが 生じた場合に .true. が返る. err を与えない場合, エラーが生じると 適切なメッセージを出力してプログラムは終了する.

[Source]

  subroutine GTVarGetPointerDouble4(var, value, err)

    implicit none
    type(GT_VARIABLE), intent(inout):: var
    real(DP),pointer :: value(:,:,:,:)
    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_EARGSIZEMISMATCH
          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
var :type(GT_VARIABLE), intent(inout)
value(:,:,:,:,:) :real(DP),pointer
err :logical, intent(out), optional

このサブルーチンは引数 value に多次元データを返す. 引数 var には GT_VARIABLE 変数を与えなければならない. 論理変数 err を与えた場合には, もしもプログラム内部でエラーが 生じた場合に .true. が返る. err を与えない場合, エラーが生じると 適切なメッセージを出力してプログラムは終了する.

[Source]

  subroutine GTVarGetPointerDouble5(var, value, err)

    implicit none
    type(GT_VARIABLE), intent(inout):: var
    real(DP),pointer :: value(:,:,:,:,:)
    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_EARGSIZEMISMATCH
          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
var :type(GT_VARIABLE), intent(inout)
value(:,:,:,:,:,:) :real(DP),pointer
err :logical, intent(out), optional

このサブルーチンは引数 value に多次元データを返す. 引数 var には GT_VARIABLE 変数を与えなければならない. 論理変数 err を与えた場合には, もしもプログラム内部でエラーが 生じた場合に .true. が返る. err を与えない場合, エラーが生じると 適切なメッセージを出力してプログラムは終了する.

[Source]

  subroutine GTVarGetPointerDouble6(var, value, err)

    implicit none
    type(GT_VARIABLE), intent(inout):: var
    real(DP),pointer :: value(:,:,:,:,:,:)
    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_EARGSIZEMISMATCH
          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
var :type(GT_VARIABLE), intent(inout)
value(:,:,:,:,:,:,:) :real(DP),pointer
err :logical, intent(out), optional

このサブルーチンは引数 value に多次元データを返す. 引数 var には GT_VARIABLE 変数を与えなければならない. 論理変数 err を与えた場合には, もしもプログラム内部でエラーが 生じた場合に .true. が返る. err を与えない場合, エラーが生じると 適切なメッセージを出力してプログラムは終了する.

[Source]

  subroutine GTVarGetPointerDouble7(var, value, err)

    implicit none
    type(GT_VARIABLE), intent(inout):: var
    real(DP),pointer :: value(:,:,:,:,:,:,:)
    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_EARGSIZEMISMATCH
          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
var :type(GT_VARIABLE), intent(inout)
value(:) :real(SP),pointer
err :logical, intent(out), optional

[Source]

  subroutine GTVarGetPointerReal1(var, value, err)

    implicit none
    type(GT_VARIABLE), intent(inout):: var
    real(SP),pointer :: value(:)
    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_EARGSIZEMISMATCH
          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
var :type(GT_VARIABLE), intent(inout)
value(:,:) :real(SP),pointer
err :logical, intent(out), optional

このサブルーチンは引数 value に多次元データを返す. 引数 var には GT_VARIABLE 変数を与えなければならない. 論理変数 err を与えた場合には, もしもプログラム内部でエラーが 生じた場合に .true. が返る. err を与えない場合, エラーが生じると 適切なメッセージを出力してプログラムは終了する.

[Source]

  subroutine GTVarGetPointerReal2(var, value, err)

    implicit none
    type(GT_VARIABLE), intent(inout):: var
    real(SP),pointer :: value(:,:)
    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_EARGSIZEMISMATCH
          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
var :type(GT_VARIABLE), intent(inout)
value(:,:,:) :real(SP),pointer
err :logical, intent(out), optional

このサブルーチンは引数 value に多次元データを返す. 引数 var には GT_VARIABLE 変数を与えなければならない. 論理変数 err を与えた場合には, もしもプログラム内部でエラーが 生じた場合に .true. が返る. err を与えない場合, エラーが生じると 適切なメッセージを出力してプログラムは終了する.

[Source]

  subroutine GTVarGetPointerReal3(var, value, err)

    implicit none
    type(GT_VARIABLE), intent(inout):: var
    real(SP),pointer :: value(:,:,:)
    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_EARGSIZEMISMATCH
          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
var :type(GT_VARIABLE), intent(inout)
value(:,:,:,:) :real(SP),pointer
err :logical, intent(out), optional

このサブルーチンは引数 value に多次元データを返す. 引数 var には GT_VARIABLE 変数を与えなければならない. 論理変数 err を与えた場合には, もしもプログラム内部でエラーが 生じた場合に .true. が返る. err を与えない場合, エラーが生じると 適切なメッセージを出力してプログラムは終了する.

[Source]

  subroutine GTVarGetPointerReal4(var, value, err)

    implicit none
    type(GT_VARIABLE), intent(inout):: var
    real(SP),pointer :: value(:,:,:,:)
    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_EARGSIZEMISMATCH
          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
var :type(GT_VARIABLE), intent(inout)
value(:,:,:,:,:) :real(SP),pointer
err :logical, intent(out), optional

このサブルーチンは引数 value に多次元データを返す. 引数 var には GT_VARIABLE 変数を与えなければならない. 論理変数 err を与えた場合には, もしもプログラム内部でエラーが 生じた場合に .true. が返る. err を与えない場合, エラーが生じると 適切なメッセージを出力してプログラムは終了する.

[Source]

  subroutine GTVarGetPointerReal5(var, value, err)

    implicit none
    type(GT_VARIABLE), intent(inout):: var
    real(SP),pointer :: value(:,:,:,:,:)
    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_EARGSIZEMISMATCH
          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
var :type(GT_VARIABLE), intent(inout)
value(:,:,:,:,:,:) :real(SP),pointer
err :logical, intent(out), optional

このサブルーチンは引数 value に多次元データを返す. 引数 var には GT_VARIABLE 変数を与えなければならない. 論理変数 err を与えた場合には, もしもプログラム内部でエラーが 生じた場合に .true. が返る. err を与えない場合, エラーが生じると 適切なメッセージを出力してプログラムは終了する.

[Source]

  subroutine GTVarGetPointerReal6(var, value, err)

    implicit none
    type(GT_VARIABLE), intent(inout):: var
    real(SP),pointer :: value(:,:,:,:,:,:)
    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_EARGSIZEMISMATCH
          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
var :type(GT_VARIABLE), intent(inout)
value(:,:,:,:,:,:,:) :real(SP),pointer
err :logical, intent(out), optional

このサブルーチンは引数 value に多次元データを返す. 引数 var には GT_VARIABLE 変数を与えなければならない. 論理変数 err を与えた場合には, もしもプログラム内部でエラーが 生じた場合に .true. が返る. err を与えない場合, エラーが生じると 適切なメッセージを出力してプログラムは終了する.

[Source]

  subroutine GTVarGetPointerReal7(var, value, err)

    implicit none
    type(GT_VARIABLE), intent(inout):: var
    real(SP),pointer :: value(:,:,:,:,:,:,:)
    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_EARGSIZEMISMATCH
          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]