Path: | src/gtvargetpointernum.f90 |
Last Update: | Thu Sep 08 22:21:49 JST 2005 |
Copyright (C) GFD Dennou Club, 2000-2005. All rights reserved.
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 をインクルード しています.
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 を与えない場合, エラーが生じると 適切なメッセージを出力してプログラムは終了する.
var : | type(GT_VARIABLE), intent(inout) |
value(:) : | real(DP),pointer |
err : | logical, intent(out), optional |
このサブルーチンは引数 value に多次元データを返す. 引数 var には GT_VARIABLE 変数を与えなければならない. 論理変数 err を与えた場合には, もしもプログラム内部でエラーが 生じた場合に .true. が返る. err を与えない場合, エラーが生じると 適切なメッセージを出力してプログラムは終了する.
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 を与えない場合, エラーが生じると 適切なメッセージを出力してプログラムは終了する.
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 を与えない場合, エラーが生じると 適切なメッセージを出力してプログラムは終了する.
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 を与えない場合, エラーが生じると 適切なメッセージを出力してプログラムは終了する.
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 を与えない場合, エラーが生じると 適切なメッセージを出力してプログラムは終了する.
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 を与えない場合, エラーが生じると 適切なメッセージを出力してプログラムは終了する.
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 を与えない場合, エラーが生じると 適切なメッセージを出力してプログラムは終了する.
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 |
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 を与えない場合, エラーが生じると 適切なメッセージを出力してプログラムは終了する.
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 を与えない場合, エラーが生じると 適切なメッセージを出力してプログラムは終了する.
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 を与えない場合, エラーが生じると 適切なメッセージを出力してプログラムは終了する.
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 を与えない場合, エラーが生じると 適切なメッセージを出力してプログラムは終了する.
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 を与えない場合, エラーが生じると 適切なメッセージを出力してプログラムは終了する.
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 を与えない場合, エラーが生じると 適切なメッセージを出力してプログラムは終了する.
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