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

GTVarGetPointerDouble1   GTVarGetPointerDouble2   GTVarGetPointerDouble3   GTVarGetPointerDouble4   GTVarGetPointerDouble5   GTVarGetPointerDouble6   GTVarGetPointerDouble7   GTVarGetPointerReal1   GTVarGetPointerReal2   GTVarGetPointerReal3   GTVarGetPointerReal4   GTVarGetPointerReal5   GTVarGetPointerReal6   GTVarGetPointerReal7  

Included Modules

gtdata_types gtdata_generic gt_map an_generic dc_types dc_trace dc_error

Public Instance methods

GTVarGetPointerDouble1(var, value, err)
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
GTVarGetPointerDouble2(var, value, err)
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
GTVarGetPointerDouble3(var, value, err)
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
GTVarGetPointerDouble4(var, value, err)
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
GTVarGetPointerDouble5(var, value, err)
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
GTVarGetPointerDouble6(var, value, err)
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
GTVarGetPointerDouble7(var, value, err)
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
GTVarGetPointerReal1(var, value, err)
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
GTVarGetPointerReal2(var, value, err)
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
GTVarGetPointerReal3(var, value, err)
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
GTVarGetPointerReal4(var, value, err)
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
GTVarGetPointerReal5(var, value, err)
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
GTVarGetPointerReal6(var, value, err)
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
GTVarGetPointerReal7(var, value, err)
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]