| Class | io_gt4_out_mod |
| In: |
io/io_gt4_out.f90
|
Copyright (C) GFD Dennou Club, 2005. All rights reserved.
!=begin
* Developers: Morikawa Yasuhiro * Version: $Id: io_gt4_out.f90,v 1.10 2005/01/19 08:52:36 morikawa Exp $ * Tag Name: $Name: $ * Change History:
This module output data with gtool4 netCDF conventions. gtool4 netCDF 規約に基づくデータを出力する。
* 1つのファイルに異なる StepInterval が設定される場合、
HistoryCreate には先に設定されたものの StepInterval で時間間隔を
決めるため、後で設定した変数の StepInterval が前のものよりも
小さい場合には整合的でなくなる。
* 回避方法
* 異なる StepInterval を設定する場合にはそれらは
別個のファイルに分ける。
!=end
機能は ((< io_gt4_out_Put3Real >)) と基本的に同じ。 ただしこちらは倍精度実数 2 次元のデータを出力する。
subroutine io_gt4_out_Put0Double (varkey, Var)
!==== Dependency
use type_mod, only : REKIND, DBKIND, INTKIND, TOKEN, STRING
use time_mod, only : StepInterval, OutputStep, CurrentLoop
use varinfo_mod, only : varinfo_inquire, VAR_INFO
use gt4_history, only : HistoryPut
use dc_trace, only : SetDebug, BeginSub, EndSub, DbgMessage
use dc_message, only : MessageNotify
!=end
implicit none
!=begin
!==== Input
!
character(*), intent(in):: varkey ! 変数名
real(DBKIND), intent(in):: Var ! 出力データ
!=end
!----- 作業用内部変数 -----
type(IO_GT4_OUT_VARS), pointer:: vars_tmp1
integer(INTKIND) :: i, stat
logical :: hit_vars_output = .false.
type(VAR_INFO) :: info
integer(INTKIND) :: StepIntervalTmp
integer(INTKIND) :: OutputStepTmp
character(STRING), parameter:: subname = "io_gt4_out_Put0Double"
continue
!-----------------------------------------------------------------
! Check Initialization
!-----------------------------------------------------------------
call BeginSub( subname, 'varkey=<%c>', c1=trim(varkey) )
if (.not. io_gt4_out_initialized) then
call EndSub( subname, 'Call io_gt4_out_init before call %c', &
& c1=trim(subname) )
return
endif
!-----------------------------------------------------------------
! Get Information from varinfo_mod about varkey.
!-----------------------------------------------------------------
call varinfo_inquire &
& ( varkey , & ! intent(in) : 変数キー
& info , & ! intent(out): VAR_INFO データ
& stat ) ! intent(out): ステータス
if (stat > 0) then
call EndSub(subname, 'varkey=<%c> is not found in varinfo_mod', &
& c1=trim(varkey) )
return
endif
!-----------------------------------------------------------------
! Check CurrentLoop in time_mod
!-----------------------------------------------------------------
if ( info%StepInterval < 1 ) then
StepIntervalTmp = StepInterval ! in time_mod
else
StepIntervalTmp = info%StepInterval ! in varinfo_mod
end if
if ( info%OutputStep < 1 ) then
OutputStepTmp = OutputStep ! in time_mod
else
OutputStepTmp = info%OutputStep ! in varinfo_mod
end if
if ( mod(CurrentLoop, StepIntervalTmp) /= 0 ) then
call EndSub( subname, &
& 'This is not Output Step. ' // &
& '[CurrentLoop=<%d>, StepInterval=<%d>, OutputStep=<%d>]', &
& c1=trim(subname), &
& i=(/CurrentLoop, StepIntervalTmp, OutputStepTmp/) )
return
end if
if ( CurrentLoop > StepIntervalTmp * OutputStepTmp ) then
call EndSub( subname, &
& 'Already CurrentLoop exceed StepInterval*OutputStep. ' // &
& '[CurrentLoop=<%d>, StepInterval=<%d>, OutputStep=<%d>]', &
& c1=trim(subname), &
& i=(/CurrentLoop, StepIntervalTmp, OutputStepTmp/) )
return
end if
!-----------------------------------------------------------------
! Search vars_output for varkey's infomation.
!-----------------------------------------------------------------
hit_vars_output = .false.
vars_tmp1 => vars_output%next
do
if ( .not. associated(vars_tmp1) ) then
call MessageNotify('E', subname, &
& message='Varkey is not found.')
elseif ( allocated(vars_tmp1%varkeys) ) then
do i = 1, size(vars_tmp1%varkeys)
if ( varkey == vars_tmp1%varkeys(i) ) then
hit_vars_output = .true.
endif
call DbgMessage('search vars_output [varkeys(%d)=<%c>, file=<%c>]', &
& i=(/i/) , &
& c1=trim( vars_tmp1%varkeys(i) ) , &
& c2=trim( vars_tmp1%file ) )
call DbgMessage(' hit_vars_output=<%b>', L=(/hit_vars_output/) )
enddo
endif
if (hit_vars_output) exit
vars_tmp1 => vars_tmp1%next
enddo
!-----------------------------------------------------------------
! Output by HistoryPut [in gt4f90io]
!-----------------------------------------------------------------
call HistoryPut( &
& varname=info%varinfo%name , & ! intent(in) : 変数名
& value=Var , & ! intent(in) : 出力値
& history=vars_tmp1%gt_history ) ! intent(inout) : GT_HISTORY
call EndSub( subname, &
& 'This is Just Output Step. ' // &
& '[CurrentLoop=<%d>, StepInterval=<%d>, OutputStep=<%d>]', &
& c1=trim(subname), &
& i=(/CurrentLoop, StepIntervalTmp, OutputStepTmp/) )
end subroutine
機能は ((< io_gt4_out_Put3Real >)) と基本的に同じ。 ただしこちらは単精度実数 0 次元のデータを出力する。
subroutine io_gt4_out_Put0Real (varkey, Var)
!==== Dependency
use type_mod, only : REKIND, DBKIND, INTKIND, TOKEN, STRING
use time_mod, only : StepInterval, OutputStep, CurrentLoop
use varinfo_mod, only : varinfo_inquire, VAR_INFO
use gt4_history, only : HistoryPut
use dc_trace, only : SetDebug, BeginSub, EndSub, DbgMessage
use dc_message, only : MessageNotify
!=end
implicit none
!=begin
!==== Input
!
character(*), intent(in):: varkey ! 変数名
real(REKIND), intent(in):: Var ! 出力データ
!=end
!----- 作業用内部変数 -----
type(IO_GT4_OUT_VARS), pointer:: vars_tmp1
integer(INTKIND) :: i, stat
logical :: hit_vars_output = .false.
type(VAR_INFO) :: info
integer(INTKIND) :: StepIntervalTmp
integer(INTKIND) :: OutputStepTmp
character(STRING), parameter:: subname = "io_gt4_out_Put0Real"
continue
!-----------------------------------------------------------------
! Check Initialization
!-----------------------------------------------------------------
call BeginSub( subname, 'varkey=<%c>', c1=trim(varkey) )
if (.not. io_gt4_out_initialized) then
call EndSub( subname, 'Call io_gt4_out_init before call %c', &
& c1=trim(subname) )
return
endif
!-----------------------------------------------------------------
! Get Information from varinfo_mod about varkey.
!-----------------------------------------------------------------
call varinfo_inquire &
& ( varkey , & ! intent(in) : 変数キー
& info , & ! intent(out): VAR_INFO データ
& stat ) ! intent(out): ステータス
if (stat > 0) then
call EndSub(subname, 'varkey=<%c> is not found in varinfo_mod', &
& c1=trim(varkey) )
return
endif
!-----------------------------------------------------------------
! Check CurrentLoop in time_mod
!-----------------------------------------------------------------
if ( info%StepInterval < 1 ) then
StepIntervalTmp = StepInterval ! in time_mod
else
StepIntervalTmp = info%StepInterval ! in varinfo_mod
end if
if ( info%OutputStep < 1 ) then
OutputStepTmp = OutputStep ! in time_mod
else
OutputStepTmp = info%OutputStep ! in varinfo_mod
end if
if ( mod(CurrentLoop, StepIntervalTmp) /= 0 ) then
call EndSub( subname, &
& 'This is not Output Step. ' // &
& '[CurrentLoop=<%d>, StepInterval=<%d>, OutputStep=<%d>]', &
& c1=trim(subname), &
& i=(/CurrentLoop, StepIntervalTmp, OutputStepTmp/) )
return
end if
if ( CurrentLoop > StepIntervalTmp * OutputStepTmp ) then
call EndSub( subname, &
& 'Already CurrentLoop exceed StepInterval*OutputStep. ' // &
& '[CurrentLoop=<%d>, StepInterval=<%d>, OutputStep=<%d>]', &
& c1=trim(subname), &
& i=(/CurrentLoop, StepIntervalTmp, OutputStepTmp/) )
return
end if
!-----------------------------------------------------------------
! Search vars_output for varkey's infomation.
!-----------------------------------------------------------------
hit_vars_output = .false.
vars_tmp1 => vars_output%next
do
if ( .not. associated(vars_tmp1) ) then
call MessageNotify('E', subname, &
& message='Varkey is not found.')
elseif ( allocated(vars_tmp1%varkeys) ) then
do i = 1, size(vars_tmp1%varkeys)
if ( varkey == vars_tmp1%varkeys(i) ) then
hit_vars_output = .true.
endif
call DbgMessage('search vars_output [varkeys(%d)=<%c>, file=<%c>]', &
& i=(/i/) , &
& c1=trim( vars_tmp1%varkeys(i) ) , &
& c2=trim( vars_tmp1%file ) )
call DbgMessage(' hit_vars_output=<%b>', L=(/hit_vars_output/) )
enddo
endif
if (hit_vars_output) exit
vars_tmp1 => vars_tmp1%next
enddo
!-----------------------------------------------------------------
! Output by HistoryPut [in gt4f90io]
!-----------------------------------------------------------------
call HistoryPut( &
& varname=info%varinfo%name , & ! intent(in) : 変数名
& value=Var , & ! intent(in) : 出力値
& history=vars_tmp1%gt_history ) ! intent(inout) : GT_HISTORY
call EndSub( subname, &
& 'This is Just Output Step. ' // &
& '[CurrentLoop=<%d>, StepInterval=<%d>, OutputStep=<%d>]', &
& c1=trim(subname), &
& i=(/CurrentLoop, StepIntervalTmp, OutputStepTmp/) )
end subroutine
機能は ((< io_gt4_out_Put3Real >)) と基本的に同じ。 ただしこちらは倍精度実数 2 次元のデータを出力する。
subroutine io_gt4_out_Put2Double (varkey, xy_Var)
!==== Dependency
use type_mod, only : REKIND, DBKIND, INTKIND, TOKEN, STRING
use time_mod, only : StepInterval, OutputStep, CurrentLoop
use varinfo_mod, only : varinfo_inquire, VAR_INFO
use gt4_history, only : HistoryPut
use dc_trace, only : SetDebug, BeginSub, EndSub, DbgMessage
use dc_message, only : MessageNotify
!=end
implicit none
!=begin
!==== Input
!
character(*), intent(in):: varkey ! 変数名
real(DBKIND), intent(in):: xy_Var(:,:) ! 出力データ
!=end
!----- 作業用内部変数 -----
type(IO_GT4_OUT_VARS), pointer:: vars_tmp1
integer(INTKIND) :: i, stat
logical :: hit_vars_output = .false.
type(VAR_INFO) :: info
integer(INTKIND) :: StepIntervalTmp
integer(INTKIND) :: OutputStepTmp
character(STRING), parameter:: subname = "io_gt4_out_Put2Double"
continue
!-----------------------------------------------------------------
! Check Initialization
!-----------------------------------------------------------------
call BeginSub( subname, 'varkey=<%c>', c1=trim(varkey) )
if (.not. io_gt4_out_initialized) then
call EndSub( subname, 'Call io_gt4_out_init before call %c', &
& c1=trim(subname) )
return
endif
!-----------------------------------------------------------------
! Get Information from varinfo_mod about varkey.
!-----------------------------------------------------------------
call varinfo_inquire &
& ( varkey , & ! intent(in) : 変数キー
& info , & ! intent(out): VAR_INFO データ
& stat ) ! intent(out): ステータス
if (stat > 0) then
call EndSub(subname, 'varkey=<%c> is not found in varinfo_mod', &
& c1=trim(varkey) )
return
endif
!-----------------------------------------------------------------
! Check CurrentLoop in time_mod
!-----------------------------------------------------------------
if ( info%StepInterval < 1 ) then
StepIntervalTmp = StepInterval ! in time_mod
else
StepIntervalTmp = info%StepInterval ! in varinfo_mod
end if
if ( info%OutputStep < 1 ) then
OutputStepTmp = OutputStep ! in time_mod
else
OutputStepTmp = info%OutputStep ! in varinfo_mod
end if
if ( mod(CurrentLoop, StepIntervalTmp) /= 0 ) then
call EndSub( subname, &
& 'This is not Output Step. ' // &
& '[CurrentLoop=<%d>, StepInterval=<%d>, OutputStep=<%d>]', &
& c1=trim(subname), &
& i=(/CurrentLoop, StepIntervalTmp, OutputStepTmp/) )
return
end if
if ( CurrentLoop > StepIntervalTmp * OutputStepTmp ) then
call EndSub( subname, &
& 'Already CurrentLoop exceed StepInterval*OutputStep. ' // &
& '[CurrentLoop=<%d>, StepInterval=<%d>, OutputStep=<%d>]', &
& c1=trim(subname), &
& i=(/CurrentLoop, StepIntervalTmp, OutputStepTmp/) )
return
end if
!-----------------------------------------------------------------
! Search vars_output for varkey's infomation.
!-----------------------------------------------------------------
hit_vars_output = .false.
vars_tmp1 => vars_output%next
do
if ( .not. associated(vars_tmp1) ) then
call MessageNotify('E', subname, &
& message='Varkey is not found.')
elseif ( allocated(vars_tmp1%varkeys) ) then
do i = 1, size(vars_tmp1%varkeys)
if ( varkey == vars_tmp1%varkeys(i) ) then
hit_vars_output = .true.
endif
call DbgMessage('search vars_output [varkeys(%d)=<%c>, file=<%c>]', &
& i=(/i/) , &
& c1=trim( vars_tmp1%varkeys(i) ) , &
& c2=trim( vars_tmp1%file ) )
call DbgMessage(' hit_vars_output=<%b>', L=(/hit_vars_output/) )
enddo
endif
if (hit_vars_output) exit
vars_tmp1 => vars_tmp1%next
enddo
!-----------------------------------------------------------------
! Output by HistoryPut [in gt4f90io]
!-----------------------------------------------------------------
call HistoryPut( &
& varname=info%varinfo%name , & ! intent(in) : 変数名
& array=xy_Var , & ! intent(in) : 出力値
& history=vars_tmp1%gt_history ) ! intent(inout) : GT_HISTORY
call EndSub( subname, &
& 'This is Just Output Step. ' // &
& '[CurrentLoop=<%d>, StepInterval=<%d>, OutputStep=<%d>]', &
& c1=trim(subname), &
& i=(/CurrentLoop, StepIntervalTmp, OutputStepTmp/) )
end subroutine
機能は ((< io_gt4_out_Put3Real >)) と基本的に同じ。 ただしこちらは単精度実数 2 次元のデータを出力する。
subroutine io_gt4_out_Put2Real (varkey, xy_Var)
!==== Dependency
use type_mod, only : REKIND, DBKIND, INTKIND, TOKEN, STRING
use time_mod, only : StepInterval, OutputStep, CurrentLoop
use varinfo_mod, only : varinfo_inquire, VAR_INFO
use gt4_history, only : HistoryPut
use dc_trace, only : SetDebug, BeginSub, EndSub, DbgMessage
use dc_message, only : MessageNotify
!=end
implicit none
!=begin
!==== Input
!
character(*), intent(in):: varkey ! 変数名
real(REKIND), intent(in):: xy_Var(:,:) ! 出力データ
!=end
!----- 作業用内部変数 -----
type(IO_GT4_OUT_VARS), pointer:: vars_tmp1
integer(INTKIND) :: i, stat
logical :: hit_vars_output = .false.
type(VAR_INFO) :: info
integer(INTKIND) :: StepIntervalTmp
integer(INTKIND) :: OutputStepTmp
character(STRING), parameter:: subname = "io_gt4_out_Put2Real"
continue
!-----------------------------------------------------------------
! Check Initialization
!-----------------------------------------------------------------
call BeginSub( subname, 'varkey=<%c>', c1=trim(varkey) )
if (.not. io_gt4_out_initialized) then
call EndSub( subname, 'Call io_gt4_out_init before call %c', &
& c1=trim(subname) )
return
endif
!-----------------------------------------------------------------
! Get Information from varinfo_mod about varkey.
!-----------------------------------------------------------------
call varinfo_inquire &
& ( varkey , & ! intent(in) : 変数キー
& info , & ! intent(out): VAR_INFO データ
& stat ) ! intent(out): ステータス
if (stat > 0) then
call EndSub(subname, 'varkey=<%c> is not found in varinfo_mod', &
& c1=trim(varkey) )
return
endif
!-----------------------------------------------------------------
! Check CurrentLoop in time_mod
!-----------------------------------------------------------------
if ( info%StepInterval < 1 ) then
StepIntervalTmp = StepInterval ! in time_mod
else
StepIntervalTmp = info%StepInterval ! in varinfo_mod
end if
if ( info%OutputStep < 1 ) then
OutputStepTmp = OutputStep ! in time_mod
else
OutputStepTmp = info%OutputStep ! in varinfo_mod
end if
if ( mod(CurrentLoop, StepIntervalTmp) /= 0 ) then
call EndSub( subname, &
& 'This is not Output Step. ' // &
& '[CurrentLoop=<%d>, StepInterval=<%d>, OutputStep=<%d>]', &
& c1=trim(subname), &
& i=(/CurrentLoop, StepIntervalTmp, OutputStepTmp/) )
return
end if
if ( CurrentLoop > StepIntervalTmp * OutputStepTmp ) then
call EndSub( subname, &
& 'Already CurrentLoop exceed StepInterval*OutputStep. ' // &
& '[CurrentLoop=<%d>, StepInterval=<%d>, OutputStep=<%d>]', &
& c1=trim(subname), &
& i=(/CurrentLoop, StepIntervalTmp, OutputStepTmp/) )
return
end if
!-----------------------------------------------------------------
! Search vars_output for varkey's infomation.
!-----------------------------------------------------------------
hit_vars_output = .false.
vars_tmp1 => vars_output%next
do
if ( .not. associated(vars_tmp1) ) then
call MessageNotify('E', subname, &
& message='Varkey is not found.')
elseif ( allocated(vars_tmp1%varkeys) ) then
do i = 1, size(vars_tmp1%varkeys)
if ( varkey == vars_tmp1%varkeys(i) ) then
hit_vars_output = .true.
endif
call DbgMessage('search vars_output [varkeys(%d)=<%c>, file=<%c>]', &
& i=(/i/) , &
& c1=trim( vars_tmp1%varkeys(i) ) , &
& c2=trim( vars_tmp1%file ) )
call DbgMessage(' hit_vars_output=<%b>', L=(/hit_vars_output/) )
enddo
endif
if (hit_vars_output) exit
vars_tmp1 => vars_tmp1%next
enddo
!-----------------------------------------------------------------
! Output by HistoryPut [in gt4f90io]
!-----------------------------------------------------------------
call HistoryPut( &
& varname=info%varinfo%name , & ! intent(in) : 変数名
& array=xy_Var , & ! intent(in) : 出力値
& history=vars_tmp1%gt_history ) ! intent(inout) : GT_HISTORY
call EndSub( subname, &
& 'This is Just Output Step. ' // &
& '[CurrentLoop=<%d>, StepInterval=<%d>, OutputStep=<%d>]', &
& c1=trim(subname), &
& i=(/CurrentLoop, StepIntervalTmp, OutputStepTmp/) )
end subroutine
機能は ((< io_gt4_out_Put3Real >)) と基本的に同じ。 ただしこちらは倍精度実数 3 次元のデータを出力する。
subroutine io_gt4_out_Put3Double (varkey, xyz_Var)
!==== Dependency
use type_mod, only : REKIND, DBKIND, INTKIND, TOKEN, STRING
use time_mod, only : StepInterval, OutputStep, CurrentLoop
use varinfo_mod, only : varinfo_inquire, VAR_INFO
use gt4_history, only : HistoryPut
use dc_trace, only : SetDebug, BeginSub, EndSub, DbgMessage
use dc_message, only : MessageNotify
!=end
implicit none
!=begin
!==== Input
!
character(*), intent(in):: varkey ! 変数名
real(DBKIND), intent(in):: xyz_Var(:,:,:) ! 出力データ
!=end
!----- 作業用内部変数 -----
type(IO_GT4_OUT_VARS), pointer:: vars_tmp1
integer(INTKIND) :: i, stat
logical :: hit_vars_output = .false.
type(VAR_INFO) :: info
integer(INTKIND) :: StepIntervalTmp
integer(INTKIND) :: OutputStepTmp
character(STRING), parameter:: subname = "io_gt4_out_Put3Double"
continue
!-----------------------------------------------------------------
! Check Initialization
!-----------------------------------------------------------------
call BeginSub( subname, 'varkey=<%c>', c1=trim(varkey) )
if (.not. io_gt4_out_initialized) then
call EndSub( subname, 'Call io_gt4_out_init before call %c', &
& c1=trim(subname) )
return
endif
!-----------------------------------------------------------------
! Get Information from varinfo_mod about varkey.
!-----------------------------------------------------------------
call varinfo_inquire &
& ( varkey , & ! intent(in) : 変数キー
& info , & ! intent(out): VAR_INFO データ
& stat ) ! intent(out): ステータス
if (stat > 0) then
call EndSub(subname, 'varkey=<%c> is not found in varinfo_mod', &
& c1=trim(varkey) )
return
endif
!-----------------------------------------------------------------
! Check CurrentLoop in time_mod
!-----------------------------------------------------------------
if ( info%StepInterval < 1 ) then
StepIntervalTmp = StepInterval ! in time_mod
else
StepIntervalTmp = info%StepInterval ! in varinfo_mod
end if
if ( info%OutputStep < 1 ) then
OutputStepTmp = OutputStep ! in time_mod
else
OutputStepTmp = info%OutputStep ! in varinfo_mod
end if
if ( mod(CurrentLoop, StepIntervalTmp) /= 0 ) then
call EndSub( subname, &
& 'This is not Output Step. ' // &
& '[CurrentLoop=<%d>, StepInterval=<%d>, OutputStep=<%d>]', &
& c1=trim(subname), &
& i=(/CurrentLoop, StepIntervalTmp, OutputStepTmp/) )
return
end if
if ( CurrentLoop > StepIntervalTmp * OutputStepTmp ) then
call EndSub( subname, &
& 'Already CurrentLoop exceed StepInterval*OutputStep. ' // &
& '[CurrentLoop=<%d>, StepInterval=<%d>, OutputStep=<%d>]', &
& c1=trim(subname), &
& i=(/CurrentLoop, StepIntervalTmp, OutputStepTmp/) )
return
end if
!-----------------------------------------------------------------
! Search vars_output for varkey's infomation.
!-----------------------------------------------------------------
hit_vars_output = .false.
vars_tmp1 => vars_output%next
do
if ( .not. associated(vars_tmp1) ) then
call MessageNotify('E', subname, &
& message='Varkey is not found.')
elseif ( allocated(vars_tmp1%varkeys) ) then
do i = 1, size(vars_tmp1%varkeys)
if ( varkey == vars_tmp1%varkeys(i) ) then
hit_vars_output = .true.
endif
call DbgMessage('search vars_output [varkeys(%d)=<%c>, file=<%c>]', &
& i=(/i/) , &
& c1=trim( vars_tmp1%varkeys(i) ) , &
& c2=trim( vars_tmp1%file ) )
call DbgMessage(' hit_vars_output=<%b>', L=(/hit_vars_output/) )
enddo
endif
if (hit_vars_output) exit
vars_tmp1 => vars_tmp1%next
enddo
!-----------------------------------------------------------------
! Output by HistoryPut [in gt4f90io]
!-----------------------------------------------------------------
call HistoryPut( &
& varname=info%varinfo%name , & ! intent(in) : 変数名
& array=xyz_Var , & ! intent(in) : 出力値
& history=vars_tmp1%gt_history ) ! intent(inout) : GT_HISTORY
call EndSub( subname, &
& 'This is Just Output Step. ' // &
& '[CurrentLoop=<%d>, StepInterval=<%d>, OutputStep=<%d>]', &
& c1=trim(subname), &
& i=(/CurrentLoop, StepIntervalTmp, OutputStepTmp/) )
end subroutine
変数キー varkey にデータ xyz_Var を出力する。 ((< varinfo_mod >)) の ((< varinfo_init >)) の NAMELIST ((< varinfo_nml >)) で対応する varkey が 与えられていない場合、データは出力されない。
各 varkey に対応する ((< varinfo_mod >)) の StepInterval および OutputStep と、((< time_mod >)) の CurrentLoop から、 出力するタイミングが正しいかどうかをチェックして出力する。 出力するタイミングでないと判定された場合は何もせずに終了する。 なお、((< varinfo_mod >)) の StepInterval および OutputStep が 無効な値 (ゼロ以下) の場合には ((< time_mod >)) の StepInterval と OutputStep が用いられる。具体的な判定方法は以下の通りである。
大きくなってしまったら以降出力は行なわない。
subroutine io_gt4_out_Put3Real (varkey, xyz_Var)
!==== Dependency
use type_mod, only : REKIND, DBKIND, INTKIND, TOKEN, STRING
use time_mod, only : StepInterval, OutputStep, CurrentLoop
use varinfo_mod, only : varinfo_inquire, VAR_INFO
use gt4_history, only : HistoryPut
use dc_trace, only : SetDebug, BeginSub, EndSub, DbgMessage
use dc_message, only : MessageNotify
!=end
implicit none
!=begin
!==== Input
!
character(*), intent(in):: varkey ! 変数名
real(REKIND), intent(in):: xyz_Var(:,:,:) ! 出力データ
!=end
!----- 作業用内部変数 -----
type(IO_GT4_OUT_VARS), pointer:: vars_tmp1
integer(INTKIND) :: i, stat
logical :: hit_vars_output = .false.
type(VAR_INFO) :: info
integer(INTKIND) :: StepIntervalTmp
integer(INTKIND) :: OutputStepTmp
character(STRING), parameter:: subname = "io_gt4_out_Put3Real"
continue
!-----------------------------------------------------------------
! Check Initialization
!-----------------------------------------------------------------
call BeginSub( subname, 'varkey=<%c>', c1=trim(varkey) )
if (.not. io_gt4_out_initialized) then
call EndSub( subname, 'Call io_gt4_out_init before call %c', &
& c1=trim(subname) )
return
endif
!-----------------------------------------------------------------
! Get Information from varinfo_mod about varkey.
!-----------------------------------------------------------------
call varinfo_inquire &
& ( varkey , & ! intent(in) : 変数キー
& info , & ! intent(out): VAR_INFO データ
& stat ) ! intent(out): ステータス
if (stat > 0) then
call EndSub(subname, 'varkey=<%c> is not found in varinfo_mod', &
& c1=trim(varkey) )
return
endif
!-----------------------------------------------------------------
! Check CurrentLoop in time_mod
!-----------------------------------------------------------------
if ( info%StepInterval < 1 ) then
StepIntervalTmp = StepInterval ! in time_mod
else
StepIntervalTmp = info%StepInterval ! in varinfo_mod
end if
if ( info%OutputStep < 1 ) then
OutputStepTmp = OutputStep ! in time_mod
else
OutputStepTmp = info%OutputStep ! in varinfo_mod
end if
if ( mod(CurrentLoop, StepIntervalTmp) /= 0 ) then
call EndSub( subname, &
& 'This is not Output Step. ' // &
& '[CurrentLoop=<%d>, StepInterval=<%d>, OutputStep=<%d>]', &
& c1=trim(subname), &
& i=(/CurrentLoop, StepIntervalTmp, OutputStepTmp/) )
return
end if
if ( CurrentLoop > StepIntervalTmp * OutputStepTmp ) then
call EndSub( subname, &
& 'Already CurrentLoop exceed StepInterval*OutputStep. ' // &
& '[CurrentLoop=<%d>, StepInterval=<%d>, OutputStep=<%d>]', &
& c1=trim(subname), &
& i=(/CurrentLoop, StepIntervalTmp, OutputStepTmp/) )
return
end if
!-----------------------------------------------------------------
! Search vars_output for varkey's infomation.
!-----------------------------------------------------------------
hit_vars_output = .false.
vars_tmp1 => vars_output%next
do
if ( .not. associated(vars_tmp1) ) then
call MessageNotify('E', subname, &
& message='Varkey is not found.')
elseif ( allocated(vars_tmp1%varkeys) ) then
do i = 1, size(vars_tmp1%varkeys)
if ( varkey == vars_tmp1%varkeys(i) ) then
hit_vars_output = .true.
endif
call DbgMessage('search vars_output [varkeys(%d)=<%c>, file=<%c>]', &
& i=(/i/) , &
& c1=trim( vars_tmp1%varkeys(i) ) , &
& c2=trim( vars_tmp1%file ) )
call DbgMessage(' hit_vars_output=<%b>', L=(/hit_vars_output/) )
enddo
endif
if (hit_vars_output) exit
vars_tmp1 => vars_tmp1%next
enddo
!-----------------------------------------------------------------
! Output by HistoryPut [in gt4f90io]
!-----------------------------------------------------------------
call HistoryPut( &
& varname=info%varinfo%name , & ! intent(in) : 変数名
& array=xyz_Var , & ! intent(in) : 出力値
& history=vars_tmp1%gt_history ) ! intent(inout) : GT_HISTORY
call EndSub( subname, &
& 'This is Just Output Step. ' // &
& '[CurrentLoop=<%d>, StepInterval=<%d>, OutputStep=<%d>]', &
& c1=trim(subname), &
& i=(/CurrentLoop, StepIntervalTmp, OutputStepTmp/) )
end subroutine
出力する gtool4 netCDF データの座標情報を設定する。 複数回呼ぶ事で複数の座標を設定する。 現在の所、設定した座標は出力する全ての netCDF ファイルに 出力される。
subroutine io_gt4_out_SetDims (axis)
!==== Dependency
use type_mod, only : REKIND, DBKIND, INTKIND, TOKEN, STRING
use axis_type_mod, only : AXISINFO, axis_type_copy
use dc_trace, only : SetDebug, BeginSub, EndSub, DbgMessage
!=end
implicit none
!=begin
!==== Input
!
type(AXISINFO), intent(in) :: axis
!=end
!----- 作業用内部変数 -----
type(AXISINFO), allocatable :: axes_store_tmp(:)
character(STRING), parameter:: subname = "io_gt4_out_SetDims"
continue
!----------------------------------------------------------------
! Check Initialization
!----------------------------------------------------------------
call BeginSub( subname, 'dimname=<%c>', c1=trim(axis%axisinfo%name) )
if (.not. io_gt4_out_initialized) then
call EndSub( subname, 'Call io_gt4_out_init before call %c', &
& c1=trim(subname) )
return
endif
!----------------------------------------------------------------
! 次元名と次元データを axes_store 構造体に格納
!----------------------------------------------------------------
! 初回のデータ入力
if (.not. axes_store_used) then
call DbgMessage('axes_store_used = %b. allocate(axes_store_used(1))', &
& l=(/axes_store_used/))
allocate( axes_store(1) )
axes_store_used = .true.
call axis_type_copy( axis, axes_store(1) )
call DbgMessage('Store axis=<%c> to axes_store(1).', &
& c1=trim(axis%axisinfo%name) )
! 2 回目以降
else
call DbgMessage('axes_store_used = %b. allocate(axes_store_used(%d))', &
& l=(/axes_store_used/), i=(/size(axes_store)+1/))
allocate( axes_store_tmp(size(axes_store)) )
call axis_type_copy( &
& axes_store(1:size(axes_store)), &
& axes_store_tmp(1:size(axes_store)) )
deallocate(axes_store)
allocate( axes_store(size(axes_store_tmp)+1) )
call axis_type_copy( &
& axes_store_tmp(1:size(axes_store_tmp)), &
& axes_store(1:size(axes_store_tmp)) )
call axis_type_copy( axis, axes_store(size(axes_store)) )
call DbgMessage('Store axis=<%c> to axes_store(%d).', &
& c1=trim(axis%axisinfo%name), i=(/size(axes_store)/))
endif
call EndSub(subname)
end subroutine
出力する変数を設定する。 複数回呼ぶ事で複数の変数を設定できる。 このサブルーチンで設定するのは変数キー varkey のみであり、 具体的な情報は ((< varinfo_mod >)) の ((< varinfo_init >)) にて NAMELIST ((< varinfo_nml >)) で設定される。 (本来は、デフォルトの値はプログラム無いにハードコードすべきかも知れない)。
subroutine io_gt4_out_SetVars (varkey)
!==== Dependency
use type_mod, only : REKIND, DBKIND, INTKIND, TOKEN, STRING
use time_mod, only : InitTime, DelTime, StepInterval, &
& tvar, ttype, tname, tunit
use varinfo_mod, only : varinfo_inquire, VAR_INFO
use gt4_history, only : GT_HISTORY , GT_HISTORY_AXIS , &
& HistoryCreate, HistoryAddVariable , &
& HistoryCopyVariable , &
& HistoryAddAttr, HistoryPut
use dc_string, only : JoinChar
use dc_trace, only : SetDebug, BeginSub, EndSub, DbgMessage
!=end
implicit none
!=begin
!==== Input
!
character(*), intent(in) :: varkey ! 変数キー
!=end
!----- 作業用内部変数 -----
type(VAR_INFO) :: info ! varinfo_mod データ格納
character(STRING) :: output_file ! デフォルト出力ファイル
character(STRING), allocatable:: var_tmp(:)
type(IO_GT4_OUT_VARS), pointer:: vars_tmp1
type(IO_GT4_OUT_VARS), pointer:: vars_tmp2
type(GT_HISTORY_AXIS), allocatable :: axes_gt4(:) ! 次元情報格納変数
integer(INTKIND) :: i, stat
integer(INTKIND) :: StepIntervalTmp
character(STRING), parameter:: subname = "io_gt4_out_SetVars"
continue
!-----------------------------------------------------------------
! Check Initialization
!-----------------------------------------------------------------
call BeginSub( subname, 'varkey=<%c>', c1=trim(varkey) )
if (.not. io_gt4_out_initialized) then
call EndSub( subname, 'Call io_gt4_out_init before call %c', &
& c1=trim(subname) )
return
endif
!-----------------------------------------------------------------
! varinfo モジュールより、var をキーにして情報を取得
!-----------------------------------------------------------------
call varinfo_inquire &
& ( varkey , & ! intent(in) : 変数キー
& info , & ! intent(out): VAR_INFO データ
& stat ) ! intent(out): ステータス
if (stat > 0) then
call EndSub(subname, 'varkey=<%c> is not found in varinfo_mod', &
& c1=trim(varkey) )
return
endif
if ( info%StepInterval < 1 ) then
StepIntervalTmp = StepInterval ! in time_mod
else
StepIntervalTmp = info%StepInterval ! in varinfo_mod
end if
!-----------------------------------------------------------------
! ファイル名が空 (または空白) の場合はデフォルトの値を用いる。
!-----------------------------------------------------------------
if ( trim(info%file) == '' ) then
output_file = file_save
else
output_file = info%file
endif
call DbgMessage('Varkey=<%c> is output to file=<%c>.' , &
& c1=trim(varkey), c2=(trim(output_file)) )
!-----------------------------------------------------------------
! 変数キーと出力ファイルを vars_output 構造体に格納
!-----------------------------------------------------------------
! 初回のデータ入力
if (.not. vars_output_used) then
call DbgMessage('vars_output_used = %b. allocate(vars_output_used(1))', &
& l=(/vars_output_used/) )
allocate(vars_output)
vars_output_used = .true.
! 変数キーとデータの格納
allocate(vars_output%next)
allocate(vars_output%next%varkeys(1))
vars_output%next%varkeys(1) = varkey
vars_output%next%file = output_file
vars_output%next%created = .false.
nullify(vars_output%next%next)
vars_tmp1 => vars_output%next
call DbgMessage('store vars_output [varkeys(1)=<%c>, file=<%c>]' , &
& c1=trim(vars_tmp1%varkeys(1)), c2=trim(vars_tmp1%file) )
! 2 回目以降
else
call DbgMessage('vars_output_used = %b.', l=(/vars_output_used/) )
vars_tmp1 => vars_output
vars_tmp2 => vars_tmp1%next
! データが格納されていないか、file が同じところまで進む
do
if ( associated(vars_tmp2) ) then
call DbgMessage('Search vars_output ' // &
& '[varkeys(:)=<%c>, file=<%c>, created=<%b>].', &
& c1=trim( JoinChar(vars_tmp2%varkeys(:)) ) , &
& c2=trim( vars_tmp2%file ) , &
& l=(/vars_tmp2%created/) )
if ( trim(vars_tmp2%file) == trim(output_file) ) then
call DbgMessage('file=<%c> is already created. ' // &
& 'Existing vars=<%c> ', &
& c1=trim( vars_tmp2%file ) , &
& c2=trim( JoinChar(vars_tmp2%varkeys(:)) ) )
vars_tmp1 => vars_tmp2
exit
endif
elseif ( .not. associated(vars_tmp2) ) then
call DbgMessage('file=<%c> is not created. ', &
& c1=trim( vars_tmp1%file ) )
allocate(vars_tmp1%next)
vars_tmp1 => vars_tmp1%next
exit
endif
vars_tmp1 => vars_tmp2
vars_tmp2 => vars_tmp1%next
enddo
!
! 変数キーと出力ファイルの格納
!
! 既に同じ出力ファイル名が存在する場合
if ( allocated(vars_tmp1%varkeys) ) then
allocate( var_tmp(size(vars_tmp1%varkeys)) )
var_tmp(:) = vars_tmp1%varkeys(:)
deallocate(vars_tmp1%varkeys)
allocate( vars_tmp1%varkeys(size(var_tmp) + 1) )
vars_tmp1%varkeys(1:size(var_tmp)) = var_tmp(:)
vars_tmp1%varkeys( size(var_tmp) + 1) = varkey
deallocate(var_tmp)
! 新規の出力ファイル名の場合
else
allocate( vars_tmp1%varkeys(1) )
vars_tmp1%varkeys(1) = varkey
vars_tmp1%file = output_file
vars_tmp1%created = .false.
endif
call DbgMessage('store vars_output [varkeys(%d)=<%c>, file=<%c>]', &
& i=(/size(vars_tmp1%varkeys)/) , &
& c1=trim( vars_tmp1%varkeys(size(vars_tmp1%varkeys)) ) , &
& c2=trim( vars_tmp1%file ) )
nullify(vars_tmp1%next)
endif
!-----------------------------------------------------------------
! axes_store から次元情報格納構造体 GT_HISTORY_AXIS 変数作成
!-----------------------------------------------------------------
if (axes_store_used) then
call DbgMessage('Generate gtool4 axes data from axes_store(1:%d).', &
& i=(/size(axes_store)/))
! 時間次元用に1つ多めに確保
allocate( axes_gt4(size(axes_store) + 1) )
do i = 1, size(axes_store)
axes_gt4(i) = axes_store(i)%axisinfo
enddo
else
call DbgMessage('Can not Generate gtool4 axes data Because axes_store is not found.')
endif
!-----------------------------------------------------------------
! axes_gt4 に時間の次元を追加
!-----------------------------------------------------------------
if (.not. allocated(axes_gt4)) then
allocate( axes_gt4(1) )
endif
axes_gt4( size(axes_gt4) )%name = tvar
axes_gt4( size(axes_gt4) )%length = 0
axes_gt4( size(axes_gt4) )%longname = tname
axes_gt4( size(axes_gt4) )%units = tunit
axes_gt4( size(axes_gt4) )%xtype = ttype
!-----------------------------------------------------------------
! HistoryCreate (io_gt4_out_init で取得した情報を用いる)
!-----------------------------------------------------------------
if ( .not. vars_tmp1%created) then
call HistoryCreate( & ! ヒストリー作成
& file=trim(vars_tmp1%file), & ! intent(in) : 出力ファイル名
& title=trim(title_save) , & ! intent(in) : タイトル
& source=trim(source_save) , & ! intent(in) : 作成手段
& institution=trim(institution_save) , &
& ! intent(in) : 作成者
& axes=axes_gt4 , & ! intent(in) : 次元データ全て
& origin=real(InitTime) , & ! intent(in) : 時間の原点
& interval=real(StepIntervalTmp*DelTime), &
& ! intent(in) : 出力時間間隔
& history=vars_tmp1%gt_history ) ! intent(out): GT_HISTORY
vars_tmp1%created = .true.
else
call DbgMessage('file=<%c> is already created', c1=trim(vars_tmp1%file) )
endif
!-----------------------------------------------------------------
! HistoryPut [in gt4f90io] による次元データの設定
!-----------------------------------------------------------------
do i = 1, size(axes_store)
call HistoryPut &
& ( axes_store(i)%axisinfo%name , & ! intent(in) : 次元名
& axes_store(i)%a_Dim , & ! intent(in) : 次元データ
& vars_tmp1%gt_history ) ! intent(inout): GT_HISTORY
enddo
!-----------------------------------------------------------------
! HistoryAddAttr [in gt4f90io] による次元データへの属性の設定
!-----------------------------------------------------------------
do i = 1, size(axes_store)
if (allocated(axes_store(i)%attrs) ) then
call HistoryAddAttr &
& ( axes_store(i)%axisinfo%name , & ! intent(in): 次元名
& axes_store(i)%attrs , & ! intent(in): 属性情報
& vars_tmp1%gt_history ) ! intent(inout): GT_HISTORY
endif
enddo
!-----------------------------------------------------------------
! HistoryAddVariable [in gt4f90io] による変数の設定
!-----------------------------------------------------------------
call HistoryAddVariable( &
& varinfo=info%varinfo , & ! intent(in): GT_HISTORY_VARINFO
& history=vars_tmp1%gt_history ) ! intent(inout) : GT_HISTORY
!-----------------------------------------------------------------
! HistoryCopyVariable [in gt4f90io] による変数の設定
!-----------------------------------------------------------------
!!$ call HistoryCopyVariable( &
!!$ & file=trim(info_file) , & ! intent(in) : コピー元ファイル
!!$ & varkey=trim( vars_tmp1%varkeys(size(vars_tmp1%varkeys)) ), &
!!$ & ! intent(in) : 変数名
!!$ & history=vars_tmp1%gt_history ) ! intent(inout) : GT_HISTORY
!-----------------------------------------------------------------
! HistoryAddAttr [in gt4f90io] による変数への属性付加
!-----------------------------------------------------------------
if (allocated(info%attrs) ) then
call HistoryAddAttr( &
& varname=info%varinfo%name , & ! intent(in): 変数名
& attrs=info%attrs , & ! intent(in): GT_HISTORY_ATTR
& history=vars_tmp1%gt_history )! intent(inout) : GT_HISTORY
endif
call EndSub(subname)
end subroutine