| Class | io_gt4_out_mod |
| In: |
src/shared/io/io_gt4_out.f90
|
| varkey : | character(*), intent(in)
| ||
| Var : | real(DBKIND), intent(in)
|
機能は ((< io_gt4_out_Put3Real >)) と基本的に同じ。 ただしこちらは倍精度実数 2 次元のデータを出力する。
subroutine io_gt4_out_Put0Double(varkey, Var)
!==== Dependency
!=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 , 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 ( associated(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 , value=Var , 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_Put0Double
| varkey : | character(*), intent(in)
| ||
| xy_Var(:,:) : | real(DBKIND), intent(in)
|
機能は ((< io_gt4_out_Put3Real >)) と基本的に同じ。 ただしこちらは倍精度実数 2 次元のデータを出力する。
subroutine io_gt4_out_Put2Double(varkey, xy_Var)
!==== Dependency
!=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 , 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 ( associated(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 , array=xy_Var , 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_Put2Double
| varkey : | character(*), intent(in)
| ||
| xyz_Var(:,:,:) : | real(DBKIND), intent(in)
|
機能は ((< io_gt4_out_Put3Real >)) と基本的に同じ。 ただしこちらは倍精度実数 3 次元のデータを出力する。
subroutine io_gt4_out_Put3Double(varkey, xyz_Var)
!==== Dependency
!=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 , 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 ( associated(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 , array=xyz_Var , 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_Put3Double
| varkey : | character(*), intent(in)
| ||
| xyz_Var(:,:,:) : | real(REKIND), intent(in)
|
* CurrentLoop を StepInterval で割り、余りが 0 の場合には出力。 * CurrentLoop が StepInterval * OutputStep よりも 大きくなってしまったら以降出力は行なわない。
subroutine io_gt4_out_Put3Real(varkey, xyz_Var)
!==== Dependency
!=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 , 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 ( associated(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 , array=xyz_Var , 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
| varkey : | character(*), intent(in)
| ||
| Var : | real(REKIND), intent(in)
|
機能は ((< io_gt4_out_Put3Real >)) と基本的に同じ。 ただしこちらは単精度実数 0 次元のデータを出力する。
subroutine io_gt4_out_Put0Real(varkey, Var)
!==== Dependency
!=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 , 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 ( associated(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 , value=Var , 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_Put0Real
| varkey : | character(*), intent(in)
| ||
| xy_Var(:,:) : | real(REKIND), intent(in)
|
機能は ((< io_gt4_out_Put3Real >)) と基本的に同じ。 ただしこちらは単精度実数 2 次元のデータを出力する。
subroutine io_gt4_out_Put2Real(varkey, xy_Var)
!==== Dependency
!=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 , 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 ( associated(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 , array=xy_Var , 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_Put2Real
| axis : | type(AXISINFO), intent(in)
|
出力する gtool4 netCDF データの座標情報を設定する。 複数回呼ぶ事で複数の座標を設定する。 現在の所、設定した座標は出力する全ての netCDF ファイルに 出力される。
subroutine io_gt4_out_SetDims(axis)
!==== Dependency
!=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 io_gt4_out_SetDims
| varkey : | character(*), intent(in)
|
(本来は、デフォルトの値はプログラム無いにハードコードすべきかも知れない)。
subroutine io_gt4_out_SetVars(varkey)
!==== Dependency
!=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 , 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 ( associated(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), title=trim(title_save) , source=trim(source_save) , institution=trim(institution_save) , axes=axes_gt4 , origin=real(InitTime) , interval=real(StepIntervalTmp*DelTime), 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 , axes_store(i)%a_Dim , vars_tmp1%gt_history ) ! intent(inout): GT_HISTORY
enddo
!-----------------------------------------------------------------
! HistoryAddAttr [in gt4f90io] による次元データへの属性の設定
!-----------------------------------------------------------------
do i = 1, size(axes_store)
if (associated(axes_store(i)%attrs) ) then
call HistoryAddAttr ( axes_store(i)%axisinfo%name , axes_store(i)%attrs , vars_tmp1%gt_history ) ! intent(inout): GT_HISTORY
endif
enddo
!-----------------------------------------------------------------
! HistoryAddVariable [in gt4f90io] による変数の設定
!-----------------------------------------------------------------
call HistoryAddVariable( varinfo=info%varinfo , history=vars_tmp1%gt_history ) ! intent(inout) : GT_HISTORY
!-----------------------------------------------------------------
! HistoryCopyVariable [in gt4f90io] による変数の設定
!-----------------------------------------------------------------
!!$ call HistoryCopyVariable(
!!$ file=trim(info_file) ,
!!$ varkey=trim( vars_tmp1%varkeys(size(vars_tmp1%varkeys)) ),
!!$
!!$ history=vars_tmp1%gt_history ) ! intent(inout) : GT_HISTORY
!-----------------------------------------------------------------
! HistoryAddAttr [in gt4f90io] による変数への属性付加
!-----------------------------------------------------------------
if (associated(info%attrs) ) then
call HistoryAddAttr( varname=info%varinfo%name , attrs=info%attrs , history=vars_tmp1%gt_history )! intent(inout) : GT_HISTORY
endif
call EndSub(subname)
end subroutine io_gt4_out_SetVars
((< nmlfile_init >)) で指定されることが想定されているが、 もしもこの初期化ルーチンより以前に指定されていなければ、 ((< nmlfile_init >)) のデフォルトで指定される NAMELIST ファイルを 読む。
subroutine io_gt4_out_init
!==== Dependency
!=end
implicit none
!=begin
!
!==== NAMELIST
!
!出力ファイル設定。
!file に与えたものがデフォルトの出力ファイルとなる。
!その他の情報は出力する gtool4 netCDF データの大域データとして
!与えられる。
!
character(STRING) :: file = 'result.nc' , title = 'GCM Test' , source = 'DCPAM' , institution = 'GFD Dennou Club' ! 実行者名 (作成者)
namelist /io_gt4_out_nml/ file , title , source , institution ! 実行者名 (作成者)
!=end
!----- 作業用内部変数 -----
integer(INTKIND) :: nmlstat, nmlunit
logical :: nmlreadable
character(STRING), parameter:: subname = "io_gt4_out_init"
continue
!----------------------------------------------------------------
! Check Initialization
!----------------------------------------------------------------
call BeginSub(subname)
if (io_gt4_out_initialized) then
call EndSub( subname, '%c is already called', c1=trim(subname) )
return
else
io_gt4_out_initialized = .true.
endif
!----------------------------------------------------------------
! Version identifier
!----------------------------------------------------------------
call DbgMessage('%c :: %c', c1=trim(version), c2=trim(tagname))
!----------------------------------------------------------------
! read io_gt4_out_nml
!----------------------------------------------------------------
! Initialization
file = 'result.nc' ! 出力ファイル名 (デフォルト)
title = 'GCM Test' ! タイトル
source = 'DCPAM' ! モデル名 (作成手段)
institution = 'GFD Dennou Club' ! 実行者名 (作成者)
call nmlfile_init
call nmlfile_open(nmlunit, nmlreadable)
if (nmlreadable) then
read(nmlunit, nml=io_gt4_out_nml, iostat=nmlstat)
call DbgMessage('Stat of NAMELIST io_gt4_out_nml Input is <%d>', i=(/nmlstat/))
write(0, nml=io_gt4_out_nml)
else
call DbgMessage('Not Read NAMELIST io_gt4_out_nml')
call MessageNotify('W', subname, 'Can not Read NAMELIST io_gt4_out_nml. Force Use Default Value.')
end if
call nmlfile_close
!----------------------------------------------------------------
! receive NAMELIST information
!----------------------------------------------------------------
file_save = file
title_save = title
source_save = source
institution_save = institution
!----------------------------------------------------------------
! time_mod の初期化ルーチン time_init を呼ぶ。
!----------------------------------------------------------------
call time_init
!----------------------------------------------------------------
! varinfo_mod の初期化ルーチン varinfo_init を呼ぶ。
!----------------------------------------------------------------
call varinfo_init
call EndSub(subname)
end subroutine io_gt4_out_init