| Class | gtool_historyauto_internal |
| In: |
gtool/gtool_historyauto/gtool_historyauto_internal.f90
|
Note that Japanese and English are described in parallel.
| Derived Type : | |
| wgt1(:) =>null() : | real(DP), pointer |
| wgt2(:) =>null() : | real(DP), pointer |
| wgt3(:) =>null() : | real(DP), pointer |
| wgt4(:) =>null() : | real(DP), pointer |
| wgt5(:) =>null() : | real(DP), pointer |
| wgt6(:) =>null() : | real(DP), pointer |
| wgt7(:) =>null() : | real(DP), pointer |
座標重み情報管理用の構造型 Derived type for information of axes weight
| Subroutine : | |||
| array(:) : | integer, intent(in), target | ||
| space_average(1) : | logical, intent(in) | ||
| weight1(:) : | real(DP), intent(in) | ||
| array_avr(:) : | integer, pointer
|
space_average で .true. に指定された次元に対して, array を平均化して array_avr に返します. 平均化には重み weight1 〜 weight7 が用いられます. array_avr の配列の次元そのものは減りません. その代わり, 平均化された次元の配列のサイズは 1 になります.
Alias for AverageReduceInt1
| Subroutine : | |||
| array(:) : | real(DP), intent(in), target | ||
| space_average(1) : | logical, intent(in) | ||
| weight1(:) : | real(DP), intent(in) | ||
| array_avr(:) : | real(DP), pointer
|
space_average で .true. に指定された次元に対して, array を平均化して array_avr に返します. 平均化には重み weight1 〜 weight7 が用いられます. array_avr の配列の次元そのものは減りません. その代わり, 平均化された次元の配列のサイズは 1 になります.
Alias for AverageReduceDouble1
| Subroutine : | |||
| array(:) : | real, intent(in), target | ||
| space_average(1) : | logical, intent(in) | ||
| weight1(:) : | real(DP), intent(in) | ||
| array_avr(:) : | real, pointer
|
space_average で .true. に指定された次元に対して, array を平均化して array_avr に返します. 平均化には重み weight1 〜 weight7 が用いられます. array_avr の配列の次元そのものは減りません. その代わり, 平均化された次元の配列のサイズは 1 になります.
Alias for AverageReduceReal1
| Subroutine : | |||
| array(:,:) : | integer, intent(in), target | ||
| space_average(2) : | logical, intent(in) | ||
| weight1(:) : | real(DP), intent(in) | ||
| weight2(:) : | real(DP), intent(in) | ||
| array_avr(:,:) : | integer, pointer
|
space_average で .true. に指定された次元に対して, array を平均化して array_avr に返します. 平均化には重み weight1 〜 weight7 が用いられます. array_avr の配列の次元そのものは減りません. その代わり, 平均化された次元の配列のサイズは 1 になります.
Alias for AverageReduceInt2
| Subroutine : | |||
| array(:,:) : | real(DP), intent(in), target | ||
| space_average(2) : | logical, intent(in) | ||
| weight1(:) : | real(DP), intent(in) | ||
| weight2(:) : | real(DP), intent(in) | ||
| array_avr(:,:) : | real(DP), pointer
|
space_average で .true. に指定された次元に対して, array を平均化して array_avr に返します. 平均化には重み weight1 〜 weight7 が用いられます. array_avr の配列の次元そのものは減りません. その代わり, 平均化された次元の配列のサイズは 1 になります.
Alias for AverageReduceDouble2
| Subroutine : | |||
| array(:,:) : | real, intent(in), target | ||
| space_average(2) : | logical, intent(in) | ||
| weight1(:) : | real(DP), intent(in) | ||
| weight2(:) : | real(DP), intent(in) | ||
| array_avr(:,:) : | real, pointer
|
space_average で .true. に指定された次元に対して, array を平均化して array_avr に返します. 平均化には重み weight1 〜 weight7 が用いられます. array_avr の配列の次元そのものは減りません. その代わり, 平均化された次元の配列のサイズは 1 になります.
Alias for AverageReduceReal2
| Subroutine : | |||
| array(:,:,:) : | integer, intent(in), target | ||
| space_average(3) : | logical, intent(in) | ||
| weight1(:) : | real(DP), intent(in) | ||
| weight2(:) : | real(DP), intent(in) | ||
| weight3(:) : | real(DP), intent(in) | ||
| array_avr(:,:,:) : | integer, pointer
|
space_average で .true. に指定された次元に対して, array を平均化して array_avr に返します. 平均化には重み weight1 〜 weight7 が用いられます. array_avr の配列の次元そのものは減りません. その代わり, 平均化された次元の配列のサイズは 1 になります.
Alias for AverageReduceInt3
| Subroutine : | |||
| array(:,:,:) : | real(DP), intent(in), target | ||
| space_average(3) : | logical, intent(in) | ||
| weight1(:) : | real(DP), intent(in) | ||
| weight2(:) : | real(DP), intent(in) | ||
| weight3(:) : | real(DP), intent(in) | ||
| array_avr(:,:,:) : | real(DP), pointer
|
space_average で .true. に指定された次元に対して, array を平均化して array_avr に返します. 平均化には重み weight1 〜 weight7 が用いられます. array_avr の配列の次元そのものは減りません. その代わり, 平均化された次元の配列のサイズは 1 になります.
Alias for AverageReduceDouble3
| Subroutine : | |||
| array(:,:,:) : | real, intent(in), target | ||
| space_average(3) : | logical, intent(in) | ||
| weight1(:) : | real(DP), intent(in) | ||
| weight2(:) : | real(DP), intent(in) | ||
| weight3(:) : | real(DP), intent(in) | ||
| array_avr(:,:,:) : | real, pointer
|
space_average で .true. に指定された次元に対して, array を平均化して array_avr に返します. 平均化には重み weight1 〜 weight7 が用いられます. array_avr の配列の次元そのものは減りません. その代わり, 平均化された次元の配列のサイズは 1 になります.
Alias for AverageReduceReal3
| Subroutine : | |||
| array(:,:,:,:) : | integer, intent(in), target | ||
| space_average(4) : | logical, intent(in) | ||
| weight1(:) : | real(DP), intent(in) | ||
| weight2(:) : | real(DP), intent(in) | ||
| weight3(:) : | real(DP), intent(in) | ||
| weight4(:) : | real(DP), intent(in) | ||
| array_avr(:,:,:,:) : | integer, pointer
|
space_average で .true. に指定された次元に対して, array を平均化して array_avr に返します. 平均化には重み weight1 〜 weight7 が用いられます. array_avr の配列の次元そのものは減りません. その代わり, 平均化された次元の配列のサイズは 1 になります.
Alias for AverageReduceInt4
| Subroutine : | |||
| array(:,:,:,:) : | real(DP), intent(in), target | ||
| space_average(4) : | logical, intent(in) | ||
| weight1(:) : | real(DP), intent(in) | ||
| weight2(:) : | real(DP), intent(in) | ||
| weight3(:) : | real(DP), intent(in) | ||
| weight4(:) : | real(DP), intent(in) | ||
| array_avr(:,:,:,:) : | real(DP), pointer
|
space_average で .true. に指定された次元に対して, array を平均化して array_avr に返します. 平均化には重み weight1 〜 weight7 が用いられます. array_avr の配列の次元そのものは減りません. その代わり, 平均化された次元の配列のサイズは 1 になります.
Alias for AverageReduceDouble4
| Subroutine : | |||
| array(:,:,:,:) : | real, intent(in), target | ||
| space_average(4) : | logical, intent(in) | ||
| weight1(:) : | real(DP), intent(in) | ||
| weight2(:) : | real(DP), intent(in) | ||
| weight3(:) : | real(DP), intent(in) | ||
| weight4(:) : | real(DP), intent(in) | ||
| array_avr(:,:,:,:) : | real, pointer
|
space_average で .true. に指定された次元に対して, array を平均化して array_avr に返します. 平均化には重み weight1 〜 weight7 が用いられます. array_avr の配列の次元そのものは減りません. その代わり, 平均化された次元の配列のサイズは 1 になります.
Alias for AverageReduceReal4
| Subroutine : | |||
| array(:,:,:,:,:) : | integer, intent(in), target | ||
| space_average(5) : | logical, intent(in) | ||
| weight1(:) : | real(DP), intent(in) | ||
| weight2(:) : | real(DP), intent(in) | ||
| weight3(:) : | real(DP), intent(in) | ||
| weight4(:) : | real(DP), intent(in) | ||
| weight5(:) : | real(DP), intent(in) | ||
| array_avr(:,:,:,:,:) : | integer, pointer
|
space_average で .true. に指定された次元に対して, array を平均化して array_avr に返します. 平均化には重み weight1 〜 weight7 が用いられます. array_avr の配列の次元そのものは減りません. その代わり, 平均化された次元の配列のサイズは 1 になります.
Alias for AverageReduceInt5
| Subroutine : | |||
| array(:,:,:,:,:) : | real(DP), intent(in), target | ||
| space_average(5) : | logical, intent(in) | ||
| weight1(:) : | real(DP), intent(in) | ||
| weight2(:) : | real(DP), intent(in) | ||
| weight3(:) : | real(DP), intent(in) | ||
| weight4(:) : | real(DP), intent(in) | ||
| weight5(:) : | real(DP), intent(in) | ||
| array_avr(:,:,:,:,:) : | real(DP), pointer
|
space_average で .true. に指定された次元に対して, array を平均化して array_avr に返します. 平均化には重み weight1 〜 weight7 が用いられます. array_avr の配列の次元そのものは減りません. その代わり, 平均化された次元の配列のサイズは 1 になります.
Alias for AverageReduceDouble5
| Subroutine : | |||
| array(:,:,:,:,:) : | real, intent(in), target | ||
| space_average(5) : | logical, intent(in) | ||
| weight1(:) : | real(DP), intent(in) | ||
| weight2(:) : | real(DP), intent(in) | ||
| weight3(:) : | real(DP), intent(in) | ||
| weight4(:) : | real(DP), intent(in) | ||
| weight5(:) : | real(DP), intent(in) | ||
| array_avr(:,:,:,:,:) : | real, pointer
|
space_average で .true. に指定された次元に対して, array を平均化して array_avr に返します. 平均化には重み weight1 〜 weight7 が用いられます. array_avr の配列の次元そのものは減りません. その代わり, 平均化された次元の配列のサイズは 1 になります.
Alias for AverageReduceReal5
| Subroutine : | |||
| array(:,:,:,:,:,:) : | integer, intent(in), target | ||
| space_average(6) : | logical, intent(in) | ||
| weight1(:) : | real(DP), intent(in) | ||
| weight2(:) : | real(DP), intent(in) | ||
| weight3(:) : | real(DP), intent(in) | ||
| weight4(:) : | real(DP), intent(in) | ||
| weight5(:) : | real(DP), intent(in) | ||
| weight6(:) : | real(DP), intent(in) | ||
| array_avr(:,:,:,:,:,:) : | integer, pointer
|
space_average で .true. に指定された次元に対して, array を平均化して array_avr に返します. 平均化には重み weight1 〜 weight7 が用いられます. array_avr の配列の次元そのものは減りません. その代わり, 平均化された次元の配列のサイズは 1 になります.
Alias for AverageReduceInt6
| Subroutine : | |||
| array(:,:,:,:,:,:) : | real(DP), intent(in), target | ||
| space_average(6) : | logical, intent(in) | ||
| weight1(:) : | real(DP), intent(in) | ||
| weight2(:) : | real(DP), intent(in) | ||
| weight3(:) : | real(DP), intent(in) | ||
| weight4(:) : | real(DP), intent(in) | ||
| weight5(:) : | real(DP), intent(in) | ||
| weight6(:) : | real(DP), intent(in) | ||
| array_avr(:,:,:,:,:,:) : | real(DP), pointer
|
space_average で .true. に指定された次元に対して, array を平均化して array_avr に返します. 平均化には重み weight1 〜 weight7 が用いられます. array_avr の配列の次元そのものは減りません. その代わり, 平均化された次元の配列のサイズは 1 になります.
Alias for AverageReduceDouble6
| Subroutine : | |||
| array(:,:,:,:,:,:) : | real, intent(in), target | ||
| space_average(6) : | logical, intent(in) | ||
| weight1(:) : | real(DP), intent(in) | ||
| weight2(:) : | real(DP), intent(in) | ||
| weight3(:) : | real(DP), intent(in) | ||
| weight4(:) : | real(DP), intent(in) | ||
| weight5(:) : | real(DP), intent(in) | ||
| weight6(:) : | real(DP), intent(in) | ||
| array_avr(:,:,:,:,:,:) : | real, pointer
|
space_average で .true. に指定された次元に対して, array を平均化して array_avr に返します. 平均化には重み weight1 〜 weight7 が用いられます. array_avr の配列の次元そのものは減りません. その代わり, 平均化された次元の配列のサイズは 1 になります.
Alias for AverageReduceReal6
| Subroutine : | |||
| array(:,:,:,:,:,:,:) : | integer, intent(in), target | ||
| space_average(7) : | logical, intent(in) | ||
| weight1(:) : | real(DP), intent(in) | ||
| weight2(:) : | real(DP), intent(in) | ||
| weight3(:) : | real(DP), intent(in) | ||
| weight4(:) : | real(DP), intent(in) | ||
| weight5(:) : | real(DP), intent(in) | ||
| weight6(:) : | real(DP), intent(in) | ||
| weight7(:) : | real(DP), intent(in) | ||
| array_avr(:,:,:,:,:,:,:) : | integer, pointer
|
space_average で .true. に指定された次元に対して, array を平均化して array_avr に返します. 平均化には重み weight1 〜 weight7 が用いられます. array_avr の配列の次元そのものは減りません. その代わり, 平均化された次元の配列のサイズは 1 になります.
Alias for AverageReduceInt7
| Subroutine : | |||
| array(:,:,:,:,:,:,:) : | real(DP), intent(in), target | ||
| space_average(7) : | logical, intent(in) | ||
| weight1(:) : | real(DP), intent(in) | ||
| weight2(:) : | real(DP), intent(in) | ||
| weight3(:) : | real(DP), intent(in) | ||
| weight4(:) : | real(DP), intent(in) | ||
| weight5(:) : | real(DP), intent(in) | ||
| weight6(:) : | real(DP), intent(in) | ||
| weight7(:) : | real(DP), intent(in) | ||
| array_avr(:,:,:,:,:,:,:) : | real(DP), pointer
|
space_average で .true. に指定された次元に対して, array を平均化して array_avr に返します. 平均化には重み weight1 〜 weight7 が用いられます. array_avr の配列の次元そのものは減りません. その代わり, 平均化された次元の配列のサイズは 1 になります.
Alias for AverageReduceDouble7
| Subroutine : | |||
| array(:,:,:,:,:,:,:) : | real, intent(in), target | ||
| space_average(7) : | logical, intent(in) | ||
| weight1(:) : | real(DP), intent(in) | ||
| weight2(:) : | real(DP), intent(in) | ||
| weight3(:) : | real(DP), intent(in) | ||
| weight4(:) : | real(DP), intent(in) | ||
| weight5(:) : | real(DP), intent(in) | ||
| weight6(:) : | real(DP), intent(in) | ||
| weight7(:) : | real(DP), intent(in) | ||
| array_avr(:,:,:,:,:,:,:) : | real, pointer
|
space_average で .true. に指定された次元に対して, array を平均化して array_avr に返します. 平均化には重み weight1 〜 weight7 が用いられます. array_avr の配列の次元そのものは減りません. その代わり, 平均化された次元の配列のサイズは 1 になります.
Alias for AverageReduceReal7
| Derived Type : | |
| a_axis(:) =>null() : | real(DP), pointer |
座標軸データ用の構造型 Derived type for axes data
| Derived Type : | |
| gthist =>null() : | type(GT_HISTORY), pointer |
GT_HISTORY 型変数を指す構造体 Derived type for indication to "GT_HISTORY"
| Subroutine : | |||
| gthist : | type(GT_HISTORY), intent(inout)
| ||
| varname : | character(*), intent(in)
| ||
| time : | real(DP), intent(in)
|
ファイル作成用内部サブルーチン
Internal subroutine for creation of files
subroutine HstFileCreate( gthist, varname, time )
!
! ファイル作成用内部サブルーチン
!
! Internal subroutine for creation of files
!
use dc_trace, only: BeginSub, EndSub
use dc_error, only: StoreError, DC_NOERR, HST_EBADVARNAME, HST_EBADSLICE, HST_EMPINOAXISDATA
use dc_calendar, only: DCCalConvertByUnit
use dc_date_types, only: DC_DIFFTIME
use dc_date, only: DCDiffTimeCreate, EvalbyUnit
use dc_string, only: CPrintf, StrInclude, toChar, JoinChar
use dc_message, only: MessageNotify
use gtool_history_nmlinfo_generic, only: HstNmlInfoOutputValid, HstNmlInfoInquire, HstNmlInfoPutLine
use gtool_history, only: GT_HISTORY, HistoryCreate, HistoryAddVariable, HistoryAddAttr, HistoryInitialized, HistoryPut, HistoryPutAxisMPI, HistoryAxisCreate, HistoryAxisInquire, HistoryAxisCopy, HistoryVarinfoInquire, HistoryVarinfoCreate, HistoryVarinfoCopy, HistoryVarinfoInitialized, HistoryVarinfoClear
implicit none
type(GT_HISTORY), intent(inout):: gthist
! gtool_history モジュール用構造体.
! Derived type for "gtool_history" module
character(*), intent(in):: varname
! 変数の名前.
! Variable name
real(DP), intent(in):: time
! 現在時刻. Current time
character(TOKEN):: interval_unit
! データの出力間隔の単位.
! Unit for interval of history data output
real(DP):: origin_value
! データの出力開始時刻の数値.
! Numerical value for start time of history data output
character(TOKEN):: origin_unit
! データの出力開始時刻の単位.
! Unit for start time of history data output
real(DP):: origin_sec
integer:: newfile_intvalue
real(DP):: newfile_intvalued
! ファイル分割時間間隔.
! Interval of time of separation of a file.
character(TOKEN):: newfile_intunit
! ファイル分割時間間隔の単位.
! Unit of interval of time of separation of a file.
character(STRING):: file, file_base, file_suffix, file_newfile_time, file_rank
! 出力ファイル名.
! Output file name.
integer:: stat, i, j, k, vnum, numdims_slice, dim_size, cnt
character(STRING):: name, units, longname, cause_c, wgt_name
character(TOKEN):: xtype
type(GT_HISTORY_AXIS):: gthst_axes_time
type(GT_HISTORY_AXIS), pointer:: gthst_axes_slices(:) =>null()
type(GT_HISTORY_AXIS_DATA), pointer:: data_axes_slices(:) =>null()
type(GT_HISTORY_AXIS_DATA), pointer:: data_weights_slices(:) =>null()
real(DP):: wgt_sum, wgt_sum_s
logical:: slice_valid
integer:: slice_start(1:numdims-1)
! 空間方向の開始点.
! Start points of spaces.
integer:: slice_end(1:numdims-1)
! 空間方向の終了点.
! End points of spaces.
integer:: slice_stride(1:numdims-1)
! 空間方向の刻み幅.
! Strides of spaces
character(*), parameter:: subname = "HstFileCreate"
continue
call BeginSub(subname, 'varname=%c', c1 = trim(varname) )
stat = DC_NOERR
cause_c = ""
! varname から変数情報の探査
! Search information of a variable from "varname"
!
vnum = 0
do i = 1, numvars
call HistoryVarinfoInquire( varinfo = gthst_vars(i), name = name ) ! (out)
if ( trim(varname) == trim(name) ) vnum = i
end do
if ( vnum == 0 ) then
stat = HST_EBADVARNAME
cause_c = varname
goto 999
end if
! 出力が有効かどうかを確認する
! Confirm whether the output is effective
!
if ( .not. HstNmlInfoOutputValid( gthstnml, varname ) ) then
goto 999
end if
! 出力間隔の単位に応じて時間座標情報の作り直し
! Remake time axis information correspond to units of output interval
!
call HstNmlInfoInquire( gthstnml = gthstnml, name = varname, file = file, interval_unit = interval_unit ) ! (out)
call HistoryAxisCopy( gthst_axes_time, gthst_axes(numdims), units = trim(interval_unit) // ' ' // trim(time_unit_suffix) ) ! (in)
! 空間方向のスライスに対応して, 座標および座標重み情報の作り直し
! Remake axes and weights information correspond to spatial slices
!
call HstNmlInfoInquire( gthstnml = gthstnml, name = varname, slice_start = slice_start, slice_end = slice_end, slice_stride = slice_stride ) ! (out)
! ファイルが未作成の場合は, まずファイル作成
! At first, the file is created if the file is not created yet
!
if ( .not. HistoryInitialized( gthist ) ) then
if ( all( slice_start == (/ ( 1, i = 1, numdims -1 ) /) ) .and. all( slice_end < (/ ( 1, i = 1, numdims -1 ) /) ) .and. all( slice_stride == (/ ( 1, i = 1, numdims -1 ) /) ) ) then
allocate( gthst_axes_slices (1:numdims) )
gthst_axes_slices(1:numdims-1) = gthst_axes(1:numdims-1)
gthst_axes_slices(numdims:numdims) = gthst_axes_time
data_axes_slices => data_axes
data_weights_slices => data_weights
slice_valid = .false.
else
allocate( gthst_axes_slices (1:numdims) )
allocate( data_axes_slices (1:numdims) )
allocate( data_weights_slices (1:numdims) )
do i = 1, numdims-1
! スライス値の有効性をチェック
! Check validity of slices
!
if ( slice_start(i) < 1 ) then
stat = HST_EBADSLICE
cause_c = CPrintf('slice_start=%d', i = (/ slice_start(i) /) )
goto 999
end if
if ( slice_stride(i) < 1 ) then
stat = HST_EBADSLICE
cause_c = CPrintf('slice_stride=%d', i = (/ slice_stride(i) /) )
goto 999
end if
! 再生成の必要性をチェック
! Check necessity of remaking
!
if ( ( slice_start(i) == 1 ) .and. ( slice_end(i) < 1 ) .and. ( slice_stride(i) == 1 ) ) then
call HistoryAxisCopy( axis_dest = gthst_axes_slices(i) , axis_src = gthst_axes(i) ) ! (in)
data_axes_slices (i) = data_axes (i)
cycle
end if
! 座標情報の再生成
! Remake information of axis
!
call HistoryAxisInquire( axis = gthst_axes(i), name = name, size = dim_size, longname = longname, units = units, xtype = xtype ) ! (out)
! 終点のスライス値の補正 ; Correct end points of slices
if ( slice_end(i) < 1 ) slice_end(i) = dim_size
if ( slice_end(i) > dim_size ) then
call MessageNotify( 'W', subname, 'slice options to (%c) are undesirable ' // '(@slice_end=%d). @slice_end is corrected forcibly to (%d) ', c1 = trim(name), i = (/ slice_end(i), dim_size /) )
slice_end(i) = dim_size
end if
! スライス値の有効性をチェック ; Check validity of slices
if ( slice_start(i) > slice_end(i) ) then
stat = HST_EBADSLICE
cause_c = CPrintf('slice_start=%d, slice_end=%d', i = (/ slice_start(i), slice_end(i) /) )
goto 999
end if
numdims_slice = int( ( slice_end(i) - slice_start(i) + 1 ) / slice_stride(i) )
! スライス値の有効性をチェック ; Check validity of slices
if ( numdims_slice < 1 ) then
call MessageNotify( 'W', subname, 'slice options to (%c) are invalid. ' // '(@slice_start=%d @slice_end=%d @slice_stride=%d)', c1 = trim(name), i = (/ slice_start(i), slice_end(i), slice_stride(i) /) )
stat = HST_EBADSLICE
cause_c = CPrintf('slice_start=%d, slice_end=%d, slice_stride=%d', i = (/ slice_start(i), slice_end(i), slice_stride(i) /) )
goto 999
end if
call HistoryAxisCreate( axis = gthst_axes_slices(i), name = name, size = numdims_slice, longname = longname, units = units, xtype = xtype ) ! (in)
! 座標データの再生成
! Regenerate data of axis
!
allocate( data_axes_slices(i) % a_axis( numdims_slice ) )
cnt = 1
do j = slice_start(i), slice_end(i), slice_stride(i)
data_axes_slices(i) % a_axis( cnt ) = data_axes(i) % a_axis( j )
cnt = cnt + 1
end do
! 座標重みデータの再生成
! Remake information of axis data
!
do j = 1, numwgts
call HistoryVarinfoInquire( varinfo = gthst_weights(j), name = wgt_name ) ! (out) optional
if ( trim(name) // wgtsuf == trim(wgt_name) ) then
! 座標重みの計算は結構いい加減...
! Calculation about axis weight is irresponsible...
!
wgt_sum = sum( data_weights(j) % a_axis )
allocate( data_weights_slices(j) % a_axis( numdims_slice ) )
cnt = 1
do k = slice_start(i), slice_end(i), slice_stride(i)
data_weights_slices(j) % a_axis( cnt ) = data_weights(j) % a_axis( k )
cnt = cnt + 1
end do
wgt_sum_s = sum( data_weights_slices(j) % a_axis )
data_weights_slices(j) % a_axis = data_weights_slices(j) % a_axis * ( wgt_sum / wgt_sum_s )
end if
end do
end do
! 空間切り出しされていない座標に関する座標重みデータを作成
! Make data of axis weight not sliced
!
do i = 1, numwgts
if ( .not. associated( data_weights_slices(i) % a_axis ) ) then
allocate( data_weights_slices(i) % a_axis( size(data_weights(i) % a_axis ) ) )
data_weights_slices(i) % a_axis = data_weights (i) % a_axis
end if
end do
! 時刻次元のコピー
! Copy time dimension
!
gthst_axes_slices(numdims) = gthst_axes_time
slice_valid = .true.
end if
! HistoryCreate のための設定値の取得
! Get the settings for "HistoryCreate"
!
call HstNmlInfoInquire( gthstnml = gthstnml, name = varname, file = file, origin_value = origin_value, origin_unit = origin_unit, interval_unit = interval_unit, newfile_intvalue = newfile_intvalue, newfile_intunit = newfile_intunit ) ! (out)
! データ出力時刻の設定
! Configure data output time
!
origin_sec = DCCalConvertByUnit( real( origin_value, DP ), origin_unit, 'sec', cal_save )
!!$ ! dc_date モジュール使用時
!!$ !
!!$ call DCDiffTimeCreate( &
!!$ & origin_sec, & ! (out)
!!$ & origin_value, origin_unit ) ! (in)
if ( newfile_intvalue < 1 ) then
origin_value = DCCalConvertByUnit( origin_sec, 'sec', interval_unit, cal_save )
! origin_value = EvalbyUnit( origin_sec, interval_unit )
else
origin_value = DCCalConvertByUnit( time, 'sec', interval_unit, cal_save )
! origin_value = EvalbyUnit( time, interval_unit )
end if
! ファイル名の設定
! Configure file name
!
if ( len_trim( file ) - index(file, '.nc', .true.) == 2 ) then
file_base = file(1:len_trim( file ) - 3)
file_suffix = '.nc'
else
file_base = file
file_suffix = ''
end if
if ( trim(rank_save) == '' ) then
file_rank = ''
else
file_rank = '_rank' // trim( adjustl(rank_save) )
end if
if ( newfile_intvalue > 0 ) then
newfile_intvalued = DCCalConvertByUnit( time, 'sec', newfile_intunit, cal_save )
file_newfile_time = CPrintf( '_time%08d', i = (/ int( newfile_intvalued ) /) )
! & i = (/ int( EvalbyUnit( time, newfile_intunit ) ) /) )
else
file_newfile_time = ''
end if
file = trim(file_base) // trim(file_rank) // trim(file_newfile_time) // trim(file_suffix)
! HistoryCreate によるファイル作成
! Files are created by "HistoryCreate"
!
call HistoryCreate( history = gthist, file = file, title = title_save, source = source_save, institution = institution_save, axes = gthst_axes_slices(1:numdims), origind = origin_value, flag_mpi_split = save_mpi_split, flag_mpi_gather = save_mpi_gather ) ! (in)
! 座標データを出力
! Output axes data
!
do i = 1, numdims - 1
call HistoryAxisInquire( axis = gthst_axes_slices(i), name = name ) ! (out)
call HistoryPut( history = gthist, varname = name, array = data_axes_slices(i) % a_axis ) ! (in)
end do
! MPI 用に領域全体の座標データを出力
! Output axes data in whole area for MPI
!
if ( save_mpi_gather ) then
do i = 1, numdims - 1
call HistoryAxisInquire( axis = gthst_axes_slices(i), name = name ) ! (out)
if ( .not. associated( data_axes_whole(i) % a_axis ) ) then
call MessageNotify('W', subname, 'data of axis (%c) in whole area is lack. ' // 'Specify the data by "HistoryAutoPutAxisMPI" explicitly.', c1 = trim(name) )
stat = HST_EMPINOAXISDATA
cause_c = name
end if
call HistoryPutAxisMPI( history = gthist, varname = name, array = data_axes_whole(i) % a_axis ) ! (in)
end do
end if
! 割付解除
! Deallocation
!
if ( slice_valid ) then
deallocate( gthst_axes_slices )
deallocate( data_axes_slices )
else
deallocate( gthst_axes_slices )
nullify( data_axes_slices )
end if
! 座標重みデータを追加
! Add axes weights data
!
do i = 1, numwgts
call HistoryAddVariable( history = gthist, varinfo = gthst_weights(i) ) ! (in)
call HistoryVarinfoInquire( varinfo = gthst_weights(i), name = name ) ! (out)
call HistoryPut( history = gthist, varname = name, array = data_weights_slices(i) % a_axis ) ! (in)
end do
if ( slice_valid ) then
deallocate( data_weights_slices )
else
nullify( data_weights_slices )
end if
! ファイル作成おしまい; Creation of file is finished
end if
! 変数情報を追加
! Add information of variables
!
call HistoryAddVariable( varinfo = gthst_vars(vnum), history = gthist ) ! (inout) optional
999 continue
call StoreError(stat, subname, cause_c = cause_c)
call EndSub(subname)
end subroutine HstFileCreate
| Subroutine : | |||
| time : | real(DP), intent(in)
| ||
| stime_index : | integer, intent(out) |
与えられた時刻 time が各変数にとって出力のタイミングかどうかを 調査して output_timing_vars, output_timing_avr_vars, create_timing_vars, close_timing_vars, renew_timing_vars, へ反映し, time に対応する saved_time の配列添字を stime_index へ返します.
また, ファイルのオープンクローズのタイミングであれば, それらもこのサブルーチン内で行います.
It is investigated whether "time" is output timing for each variable, and the information is reflected to "output_timing_vars", "output_timing_avr_vars", "create_timing_vars", "close_timing_vars", "renew_timing_vars". And index of array "saved_time" is returned to "stime_index".
And if current time is timing of open/close of files, they are done in this subroutine.
subroutine HstVarsOutputCheck ( time, stime_index )
!
! 与えられた時刻 *time* が各変数にとって出力のタイミングかどうかを
! 調査して output_timing_vars, output_timing_avr_vars,
! create_timing_vars, close_timing_vars, renew_timing_vars,
! へ反映し, *time* に対応する
! saved_time の配列添字を stime_index へ返します.
!
! また, ファイルのオープンクローズのタイミングであれば,
! それらもこのサブルーチン内で行います.
!
! It is investigated whether "time" is output timing for
! each variable, and the information is reflected to
! "output_timing_vars", "output_timing_avr_vars",
! "create_timing_vars", "close_timing_vars", "renew_timing_vars".
! And index of array "saved_time" is returned to "stime_index".
!
! And if current time is timing of open/close of files,
! they are done in this subroutine.
!
use dc_trace, only: BeginSub, EndSub, DbgMessage
use dc_error, only: StoreError, DC_NOERR
use gtool_history, only: HistoryInitialized, HistoryClose
use dc_date_types, only: DC_DIFFTIME
use dc_date, only: operator(==), operator(>), operator(<), operator(>=), operator(<=), operator(-), DCDiffTimePutLine, EvalSec
implicit none
real(DP), intent(in):: time
! 現在時刻. Current time
integer, intent(out):: stime_index
integer:: tstep
integer:: stat, i, startnum, endnum
character(STRING):: cause_c
character(*), parameter:: subname = "HstVarsOutputCheck"
continue
call BeginSub(subname)
stat = DC_NOERR
cause_c = ""
! 与えられた時刻がチェック済みかどうかを調べる
! Examine whether given time is already checked or not
!
TimeStepSearch: do
do i = saved_tstep, checked_tstepnum
if ( saved_time(i) == time ) then
tstep = i
exit TimeStepSearch
end if
end do
do i = 1, saved_tstep - 1
if ( saved_time(i) == time ) then
tstep = i
exit TimeStepSearch
end if
end do
tstep = 0
exit TimeStepSearch
end do TimeStepSearch
saved_tstep = tstep
if ( saved_tstep /= 0 .and. checked_tstep_varnum == numvars ) then
! * output_timing_vars(:,saved_tstep) を使う.
! * saved_tstep を stime_index として返す.
stime_index = saved_tstep
call DbgMessage( 'saved_tstep=<%d> is already checked.', i =(/ saved_tstep /) )
goto 999
end if
! チェックする時間ステップと, 変数 ID の設定
! Configure checked time step, and variable ID
!
if ( saved_tstep /= 0 ) then
startnum = checked_tstep_varnum + 1
endnum = numvars
stime_index = saved_tstep
else
startnum = 1
endnum = numvars
if ( save_tstepnum < 2 ) then
checked_tstepnum = 1
saved_time(checked_tstepnum) = time
saved_tstep = checked_tstepnum
stime_index = saved_tstep
elseif ( .not. checked_tstepnum < save_tstepnum ) then
create_timing_vars(:,1:checked_tstepnum-1) = create_timing_vars(:,2:checked_tstepnum)
close_timing_vars(:,1:checked_tstepnum-1) = close_timing_vars(:,2:checked_tstepnum)
renew_timing_vars(:,1:checked_tstepnum-1) = renew_timing_vars(:,2:checked_tstepnum)
output_timing_vars(:,1:checked_tstepnum-1) = output_timing_vars(:,2:checked_tstepnum)
output_timing_avr_vars(:,1:checked_tstepnum-1) = output_timing_avr_vars(:,2:checked_tstepnum)
saved_time(1:checked_tstepnum-1) = saved_time(2:checked_tstepnum)
saved_time(checked_tstepnum) = time
saved_tstep = checked_tstepnum
stime_index = saved_tstep
else
checked_tstepnum = checked_tstepnum + 1
saved_time(checked_tstepnum) = time
saved_tstep = checked_tstepnum
stime_index = saved_tstep
end if
end if
call DbgMessage( 'numvar=<%d:%d> in saved_tstep=<%d> will be checked from now.', i =(/ startnum, endnum, saved_tstep /) )
! それぞれのタイミングをチェックして各変数に格納
!
! * ファイルオープン: create_timing_vars
! * ファイルクローズ: close_timing_vars
! * ファイルクローズ/作成: renew_timing_vars
! * データ出力: output_timing_vars
! * データ平均化: output_avr_timing_vars
create_timing_vars(startnum:endnum, checked_tstepnum:checked_tstepnum) = .false.
close_timing_vars(startnum:endnum, checked_tstepnum:checked_tstepnum) = .false.
renew_timing_vars(startnum:endnum, checked_tstepnum:checked_tstepnum) = .false.
output_timing_vars(startnum:endnum, checked_tstepnum:checked_tstepnum) = .false.
output_timing_avr_vars(startnum:endnum, checked_tstepnum:checked_tstepnum) = .false.
do i = startnum, endnum
if ( .not. output_valid_vars(i) ) cycle
if ( origin_time_vars(i) > time ) cycle
if ( origin_time_vars(i) <= time .and. ( terminus_time_vars(i) < zero_time .or. terminus_time_vars(i) >= time ) .and. .not. histaddvar_vars(i) ) then
create_timing_vars(i,checked_tstepnum) = .true.
if ( newfile_inttime_vars(i) > zero_time ) then
newfile_createtime_vars(i) = time
end if
output_timing_vars(i,checked_tstepnum) = .true.
output_timing_avr_vars(i,checked_tstepnum) = tavr_vars(i)
cycle
end if
if ( terminus_time_vars(i) > zero_time .and. terminus_time_vars(i) < time ) then
close_timing_vars(i,checked_tstepnum) = .true.
output_timing_vars(i,checked_tstepnum) = .false.
output_timing_avr_vars(i,checked_tstepnum) = .false.
cycle
end if
! * newfile_inttime_vars だけでは, ぴったり一致しないとうまく行かない.
! * そこで...
! * 前回に出力した時刻を記憶しておく.
! * 前回の時刻と今回の時刻の差が newfile_inttime_vars
! よりも大きい場合には現ファイルを閉じ, 新ファイルを作成する.
if ( newfile_inttime_vars(i) > zero_time ) then
if ( time - newfile_createtime_vars(i) >= newfile_inttime_vars(i) ) then
renew_timing_vars(i,checked_tstepnum) = .true.
output_timing_vars(i,checked_tstepnum) = .true.
output_timing_avr_vars(i,checked_tstepnum) = tavr_vars(i)
cycle
end if
end if
if ( time - prev_outtime_vars(i) >= interval_time_vars(i) ) then
output_timing_vars(i,checked_tstepnum) = .true.
output_timing_avr_vars(i,checked_tstepnum) = tavr_vars(i)
cycle
end if
output_timing_vars(i,checked_tstepnum) = .false.
output_timing_avr_vars(i,checked_tstepnum) = tavr_vars(i)
end do
checked_tstep_varnum = numvars
999 continue
call StoreError(stat, subname, cause_c = cause_c)
call EndSub(subname)
end subroutine HstVarsOutputCheck
| Constant : | |||
| MAX_VARS = 256 : | integer, parameter, public
|
| Derived Type : | |||
| st(:) =>null() : | integer, pointer
| ||
| ed(:) =>null() : | integer, pointer
| ||
| sd(:) =>null() : | integer, pointer
|
空間切り出し情報管理用の構造型 Derived type for information of slice of space
| Derived Type : | |||
| avr(:) =>null() : | logical, pointer
|
空間平均情報管理用の構造型 Derived type for information of average in space direction
| Variable : | |||
| checked_tstep_varnum = 0 : | integer, save, public
|
| Variable : | |||
| checked_tstepnum = 0 : | integer, save, public
|
| Variable : | |||
| close_timing_vars(1:MAX_VARS, 1:save_tstepnum) = .false. : | logical, save, public
|
| Variable : | |||
| create_timing_vars(1:MAX_VARS, 1:save_tstepnum) = .false. : | logical, save, public
|
| Variable : | |
| data_axes_whole(1:NF_MAX_DIMS) : | type(GT_HISTORY_AXIS_DATA), save, target, public |
| Variable : | |
| data_weights(1:NF_MAX_DIMS) : | type(GT_HISTORY_AXIS_DATA), save, target, public |
| Variable : | |||
| flag_output_prev_vars(1:MAX_VARS) = .false. : | logical, save, public
|
| Variable : | |||
| histaddvar_vars(1:MAX_VARS) = .false. : | logical, save, public
|
| Variable : | |||
| interval_time_vars(1:MAX_VARS) : | real(DP), save, public
|
| Variable : | |||
| interval_unitsym_vars(1:MAX_VARS) : | integer, save, public
|
| Variable : | |||
| newfile_createtime_vars(1:MAX_VARS) : | real(DP), save, public
|
| Variable : | |||
| newfile_inttime_vars(1:MAX_VARS) : | real(DP), save, public
|
| Variable : | |||
| origin_time_vars(1:MAX_VARS) : | real(DP), save, public
|
| Variable : | |||
| output_timing_avr_vars(1:MAX_VARS, 1:save_tstepnum) = .false. : | logical, save, public
|
| Variable : | |||
| output_timing_vars(1:MAX_VARS, 1:save_tstepnum) = .false. : | logical, save, public
|
| Variable : | |||
| output_valid_vars(1:MAX_VARS) = .false. : | logical, save, public
|
| Variable : | |||
| prev_outtime_vars(1:MAX_VARS) : | real(DP), save, public
|
| Variable : | |||
| renew_timing_vars(1:MAX_VARS, 1:save_tstepnum) = .false. : | logical, save, public
|
| Constant : | |||
| save_tstepnum = 1 : | integer, parameter, public
|
| Variable : | |||
| saved_tstep = 1 : | integer, save, public
|
| Variable : | |||
| tavr_vars(1:MAX_VARS) = .false. : | logical, save, public
|
| Variable : | |||
| terminus_time_vars(1:MAX_VARS) : | real(DP), save, public
|
| Constant : | |
| version = ’$Name: gtool5-20100705 $’ // ’$Id: gtool_historyauto_internal.f90,v 1.6 2010-07-04 22:01:51 morikawa Exp $’ : | character(*), parameter, public |
| Subroutine : | |||
| array(:) : | real(DP), intent(in), target | ||
| space_average(1) : | logical, intent(in) | ||
| weight1(:) : | real(DP), intent(in) | ||
| array_avr(:) : | real(DP), pointer
|
space_average で .true. に指定された次元に対して, array を平均化して array_avr に返します. 平均化には重み weight1 〜 weight7 が用いられます. array_avr の配列の次元そのものは減りません. その代わり, 平均化された次元の配列のサイズは 1 になります.
subroutine AverageReduceDouble1( array, space_average, weight1, array_avr )
!
! space_average で .true. に指定された次元に対して,
! array を平均化して array_avr に返します.
! 平均化には重み weight1 〜 weight7 が用いられます.
! array_avr の配列の次元そのものは減りません. その代わり,
! 平均化された次元の配列のサイズは 1 になります.
!
implicit none
real(DP), intent(in), target:: array(:)
logical, intent(in):: space_average(1)
real(DP), intent(in):: weight1(:)
real(DP), pointer:: array_avr(:) ! (out)
real(DP), pointer:: array_avr_work(:)
real(DP), pointer:: array_avr_work1(:)
integer:: array_shape(1)
integer:: i, dim_size
real(DP):: weight_sum
continue
array_shape = shape( array )
array_avr_work => array
if ( space_average(1) ) then
dim_size = array_shape(1)
array_shape(1) = 1
allocate( array_avr_work1( array_shape(1) ) )
array_avr_work1 = 0.0_DP
weight_sum = 0.0_DP
do i = 1, dim_size
array_avr_work1(1) = array_avr_work1(1) + array_avr_work(i) * weight1(i)
weight_sum = weight_sum + weight1(i)
end do
array_avr_work1 = array_avr_work1 / weight_sum
array_avr_work => array_avr_work1
end if
allocate( array_avr( array_shape(1) ) )
array_avr = array_avr_work
nullify( array_avr_work )
if ( associated( array_avr_work1 ) ) deallocate( array_avr_work1 )
end subroutine AverageReduceDouble1
| Subroutine : | |||
| array(:,:) : | real(DP), intent(in), target | ||
| space_average(2) : | logical, intent(in) | ||
| weight1(:) : | real(DP), intent(in) | ||
| weight2(:) : | real(DP), intent(in) | ||
| array_avr(:,:) : | real(DP), pointer
|
space_average で .true. に指定された次元に対して, array を平均化して array_avr に返します. 平均化には重み weight1 〜 weight7 が用いられます. array_avr の配列の次元そのものは減りません. その代わり, 平均化された次元の配列のサイズは 1 になります.
subroutine AverageReduceDouble2( array, space_average, weight1, weight2, array_avr )
!
! space_average で .true. に指定された次元に対して,
! array を平均化して array_avr に返します.
! 平均化には重み weight1 〜 weight7 が用いられます.
! array_avr の配列の次元そのものは減りません. その代わり,
! 平均化された次元の配列のサイズは 1 になります.
!
implicit none
real(DP), intent(in), target:: array(:,:)
logical, intent(in):: space_average(2)
real(DP), intent(in):: weight1(:)
real(DP), intent(in):: weight2(:)
real(DP), pointer:: array_avr(:,:) ! (out)
real(DP), pointer:: array_avr_work(:,:)
real(DP), pointer:: array_avr_work1(:,:)
real(DP), pointer:: array_avr_work2(:,:)
integer:: array_shape(2)
integer:: i, dim_size
real(DP):: weight_sum
continue
array_shape = shape( array )
array_avr_work => array
if ( space_average(1) ) then
dim_size = array_shape(1)
array_shape(1) = 1
allocate( array_avr_work1( array_shape(1) , array_shape(2) ) )
array_avr_work1 = 0.0_DP
weight_sum = 0.0_DP
do i = 1, dim_size
array_avr_work1(1,:) = array_avr_work1(1,:) + array_avr_work(i,:) * weight1(i)
weight_sum = weight_sum + weight1(i)
end do
array_avr_work1 = array_avr_work1 / weight_sum
array_avr_work => array_avr_work1
end if
if ( space_average(2) ) then
dim_size = array_shape(2)
array_shape(2) = 1
allocate( array_avr_work2( array_shape(1) , array_shape(2) ) )
array_avr_work2 = 0.0_DP
weight_sum = 0.0_DP
do i = 1, dim_size
array_avr_work2(:,1) = array_avr_work2(:,1) + array_avr_work(:,i) * weight2(i)
weight_sum = weight_sum + weight2(i)
end do
array_avr_work2 = array_avr_work2 / weight_sum
array_avr_work => array_avr_work2
end if
allocate( array_avr( array_shape(1) , array_shape(2) ) )
array_avr = array_avr_work
nullify( array_avr_work )
if ( associated( array_avr_work1 ) ) deallocate( array_avr_work1 )
if ( associated( array_avr_work2 ) ) deallocate( array_avr_work2 )
end subroutine AverageReduceDouble2
| Subroutine : | |||
| array(:,:,:) : | real(DP), intent(in), target | ||
| space_average(3) : | logical, intent(in) | ||
| weight1(:) : | real(DP), intent(in) | ||
| weight2(:) : | real(DP), intent(in) | ||
| weight3(:) : | real(DP), intent(in) | ||
| array_avr(:,:,:) : | real(DP), pointer
|
space_average で .true. に指定された次元に対して, array を平均化して array_avr に返します. 平均化には重み weight1 〜 weight7 が用いられます. array_avr の配列の次元そのものは減りません. その代わり, 平均化された次元の配列のサイズは 1 になります.
subroutine AverageReduceDouble3( array, space_average, weight1, weight2, weight3, array_avr )
!
! space_average で .true. に指定された次元に対して,
! array を平均化して array_avr に返します.
! 平均化には重み weight1 〜 weight7 が用いられます.
! array_avr の配列の次元そのものは減りません. その代わり,
! 平均化された次元の配列のサイズは 1 になります.
!
implicit none
real(DP), intent(in), target:: array(:,:,:)
logical, intent(in):: space_average(3)
real(DP), intent(in):: weight1(:)
real(DP), intent(in):: weight2(:)
real(DP), intent(in):: weight3(:)
real(DP), pointer:: array_avr(:,:,:) ! (out)
real(DP), pointer:: array_avr_work(:,:,:)
real(DP), pointer:: array_avr_work1(:,:,:)
real(DP), pointer:: array_avr_work2(:,:,:)
real(DP), pointer:: array_avr_work3(:,:,:)
integer:: array_shape(3)
integer:: i, dim_size
real(DP):: weight_sum
continue
array_shape = shape( array )
array_avr_work => array
if ( space_average(1) ) then
dim_size = array_shape(1)
array_shape(1) = 1
allocate( array_avr_work1( array_shape(1) , array_shape(2) , array_shape(3) ) )
array_avr_work1 = 0.0_DP
weight_sum = 0.0_DP
do i = 1, dim_size
array_avr_work1(1,:,:) = array_avr_work1(1,:,:) + array_avr_work(i,:,:) * weight1(i)
weight_sum = weight_sum + weight1(i)
end do
array_avr_work1 = array_avr_work1 / weight_sum
array_avr_work => array_avr_work1
end if
if ( space_average(2) ) then
dim_size = array_shape(2)
array_shape(2) = 1
allocate( array_avr_work2( array_shape(1) , array_shape(2) , array_shape(3) ) )
array_avr_work2 = 0.0_DP
weight_sum = 0.0_DP
do i = 1, dim_size
array_avr_work2(:,1,:) = array_avr_work2(:,1,:) + array_avr_work(:,i,:) * weight2(i)
weight_sum = weight_sum + weight2(i)
end do
array_avr_work2 = array_avr_work2 / weight_sum
array_avr_work => array_avr_work2
end if
if ( space_average(3) ) then
dim_size = array_shape(3)
array_shape(3) = 1
allocate( array_avr_work3( array_shape(1) , array_shape(2) , array_shape(3) ) )
array_avr_work3 = 0.0_DP
weight_sum = 0.0_DP
do i = 1, dim_size
array_avr_work3(:,:,1) = array_avr_work3(:,:,1) + array_avr_work(:,:,i) * weight3(i)
weight_sum = weight_sum + weight3(i)
end do
array_avr_work3 = array_avr_work3 / weight_sum
array_avr_work => array_avr_work3
end if
allocate( array_avr( array_shape(1) , array_shape(2) , array_shape(3) ) )
array_avr = array_avr_work
nullify( array_avr_work )
if ( associated( array_avr_work1 ) ) deallocate( array_avr_work1 )
if ( associated( array_avr_work2 ) ) deallocate( array_avr_work2 )
if ( associated( array_avr_work3 ) ) deallocate( array_avr_work3 )
end subroutine AverageReduceDouble3
| Subroutine : | |||
| array(:,:,:,:) : | real(DP), intent(in), target | ||
| space_average(4) : | logical, intent(in) | ||
| weight1(:) : | real(DP), intent(in) | ||
| weight2(:) : | real(DP), intent(in) | ||
| weight3(:) : | real(DP), intent(in) | ||
| weight4(:) : | real(DP), intent(in) | ||
| array_avr(:,:,:,:) : | real(DP), pointer
|
space_average で .true. に指定された次元に対して, array を平均化して array_avr に返します. 平均化には重み weight1 〜 weight7 が用いられます. array_avr の配列の次元そのものは減りません. その代わり, 平均化された次元の配列のサイズは 1 になります.
subroutine AverageReduceDouble4( array, space_average, weight1, weight2, weight3, weight4, array_avr )
!
! space_average で .true. に指定された次元に対して,
! array を平均化して array_avr に返します.
! 平均化には重み weight1 〜 weight7 が用いられます.
! array_avr の配列の次元そのものは減りません. その代わり,
! 平均化された次元の配列のサイズは 1 になります.
!
implicit none
real(DP), intent(in), target:: array(:,:,:,:)
logical, intent(in):: space_average(4)
real(DP), intent(in):: weight1(:)
real(DP), intent(in):: weight2(:)
real(DP), intent(in):: weight3(:)
real(DP), intent(in):: weight4(:)
real(DP), pointer:: array_avr(:,:,:,:) ! (out)
real(DP), pointer:: array_avr_work(:,:,:,:)
real(DP), pointer:: array_avr_work1(:,:,:,:)
real(DP), pointer:: array_avr_work2(:,:,:,:)
real(DP), pointer:: array_avr_work3(:,:,:,:)
real(DP), pointer:: array_avr_work4(:,:,:,:)
integer:: array_shape(4)
integer:: i, dim_size
real(DP):: weight_sum
continue
array_shape = shape( array )
array_avr_work => array
if ( space_average(1) ) then
dim_size = array_shape(1)
array_shape(1) = 1
allocate( array_avr_work1( array_shape(1) , array_shape(2) , array_shape(3) , array_shape(4) ) )
array_avr_work1 = 0.0_DP
weight_sum = 0.0_DP
do i = 1, dim_size
array_avr_work1(1,:,:,:) = array_avr_work1(1,:,:,:) + array_avr_work(i,:,:,:) * weight1(i)
weight_sum = weight_sum + weight1(i)
end do
array_avr_work1 = array_avr_work1 / weight_sum
array_avr_work => array_avr_work1
end if
if ( space_average(2) ) then
dim_size = array_shape(2)
array_shape(2) = 1
allocate( array_avr_work2( array_shape(1) , array_shape(2) , array_shape(3) , array_shape(4) ) )
array_avr_work2 = 0.0_DP
weight_sum = 0.0_DP
do i = 1, dim_size
array_avr_work2(:,1,:,:) = array_avr_work2(:,1,:,:) + array_avr_work(:,i,:,:) * weight2(i)
weight_sum = weight_sum + weight2(i)
end do
array_avr_work2 = array_avr_work2 / weight_sum
array_avr_work => array_avr_work2
end if
if ( space_average(3) ) then
dim_size = array_shape(3)
array_shape(3) = 1
allocate( array_avr_work3( array_shape(1) , array_shape(2) , array_shape(3) , array_shape(4) ) )
array_avr_work3 = 0.0_DP
weight_sum = 0.0_DP
do i = 1, dim_size
array_avr_work3(:,:,1,:) = array_avr_work3(:,:,1,:) + array_avr_work(:,:,i,:) * weight3(i)
weight_sum = weight_sum + weight3(i)
end do
array_avr_work3 = array_avr_work3 / weight_sum
array_avr_work => array_avr_work3
end if
if ( space_average(4) ) then
dim_size = array_shape(4)
array_shape(4) = 1
allocate( array_avr_work4( array_shape(1) , array_shape(2) , array_shape(3) , array_shape(4) ) )
array_avr_work4 = 0.0_DP
weight_sum = 0.0_DP
do i = 1, dim_size
array_avr_work4(:,:,:,1) = array_avr_work4(:,:,:,1) + array_avr_work(:,:,:,i) * weight4(i)
weight_sum = weight_sum + weight4(i)
end do
array_avr_work4 = array_avr_work4 / weight_sum
array_avr_work => array_avr_work4
end if
allocate( array_avr( array_shape(1) , array_shape(2) , array_shape(3) , array_shape(4) ) )
array_avr = array_avr_work
nullify( array_avr_work )
if ( associated( array_avr_work1 ) ) deallocate( array_avr_work1 )
if ( associated( array_avr_work2 ) ) deallocate( array_avr_work2 )
if ( associated( array_avr_work3 ) ) deallocate( array_avr_work3 )
if ( associated( array_avr_work4 ) ) deallocate( array_avr_work4 )
end subroutine AverageReduceDouble4
| Subroutine : | |||
| array(:,:,:,:,:) : | real(DP), intent(in), target | ||
| space_average(5) : | logical, intent(in) | ||
| weight1(:) : | real(DP), intent(in) | ||
| weight2(:) : | real(DP), intent(in) | ||
| weight3(:) : | real(DP), intent(in) | ||
| weight4(:) : | real(DP), intent(in) | ||
| weight5(:) : | real(DP), intent(in) | ||
| array_avr(:,:,:,:,:) : | real(DP), pointer
|
space_average で .true. に指定された次元に対して, array を平均化して array_avr に返します. 平均化には重み weight1 〜 weight7 が用いられます. array_avr の配列の次元そのものは減りません. その代わり, 平均化された次元の配列のサイズは 1 になります.
subroutine AverageReduceDouble5( array, space_average, weight1, weight2, weight3, weight4, weight5, array_avr )
!
! space_average で .true. に指定された次元に対して,
! array を平均化して array_avr に返します.
! 平均化には重み weight1 〜 weight7 が用いられます.
! array_avr の配列の次元そのものは減りません. その代わり,
! 平均化された次元の配列のサイズは 1 になります.
!
implicit none
real(DP), intent(in), target:: array(:,:,:,:,:)
logical, intent(in):: space_average(5)
real(DP), intent(in):: weight1(:)
real(DP), intent(in):: weight2(:)
real(DP), intent(in):: weight3(:)
real(DP), intent(in):: weight4(:)
real(DP), intent(in):: weight5(:)
real(DP), pointer:: array_avr(:,:,:,:,:) ! (out)
real(DP), pointer:: array_avr_work(:,:,:,:,:)
real(DP), pointer:: array_avr_work1(:,:,:,:,:)
real(DP), pointer:: array_avr_work2(:,:,:,:,:)
real(DP), pointer:: array_avr_work3(:,:,:,:,:)
real(DP), pointer:: array_avr_work4(:,:,:,:,:)
real(DP), pointer:: array_avr_work5(:,:,:,:,:)
integer:: array_shape(5)
integer:: i, dim_size
real(DP):: weight_sum
continue
array_shape = shape( array )
array_avr_work => array
if ( space_average(1) ) then
dim_size = array_shape(1)
array_shape(1) = 1
allocate( array_avr_work1( array_shape(1) , array_shape(2) , array_shape(3) , array_shape(4) , array_shape(5) ) )
array_avr_work1 = 0.0_DP
weight_sum = 0.0_DP
do i = 1, dim_size
array_avr_work1(1,:,:,:,:) = array_avr_work1(1,:,:,:,:) + array_avr_work(i,:,:,:,:) * weight1(i)
weight_sum = weight_sum + weight1(i)
end do
array_avr_work1 = array_avr_work1 / weight_sum
array_avr_work => array_avr_work1
end if
if ( space_average(2) ) then
dim_size = array_shape(2)
array_shape(2) = 1
allocate( array_avr_work2( array_shape(1) , array_shape(2) , array_shape(3) , array_shape(4) , array_shape(5) ) )
array_avr_work2 = 0.0_DP
weight_sum = 0.0_DP
do i = 1, dim_size
array_avr_work2(:,1,:,:,:) = array_avr_work2(:,1,:,:,:) + array_avr_work(:,i,:,:,:) * weight2(i)
weight_sum = weight_sum + weight2(i)
end do
array_avr_work2 = array_avr_work2 / weight_sum
array_avr_work => array_avr_work2
end if
if ( space_average(3) ) then
dim_size = array_shape(3)
array_shape(3) = 1
allocate( array_avr_work3( array_shape(1) , array_shape(2) , array_shape(3) , array_shape(4) , array_shape(5) ) )
array_avr_work3 = 0.0_DP
weight_sum = 0.0_DP
do i = 1, dim_size
array_avr_work3(:,:,1,:,:) = array_avr_work3(:,:,1,:,:) + array_avr_work(:,:,i,:,:) * weight3(i)
weight_sum = weight_sum + weight3(i)
end do
array_avr_work3 = array_avr_work3 / weight_sum
array_avr_work => array_avr_work3
end if
if ( space_average(4) ) then
dim_size = array_shape(4)
array_shape(4) = 1
allocate( array_avr_work4( array_shape(1) , array_shape(2) , array_shape(3) , array_shape(4) , array_shape(5) ) )
array_avr_work4 = 0.0_DP
weight_sum = 0.0_DP
do i = 1, dim_size
array_avr_work4(:,:,:,1,:) = array_avr_work4(:,:,:,1,:) + array_avr_work(:,:,:,i,:) * weight4(i)
weight_sum = weight_sum + weight4(i)
end do
array_avr_work4 = array_avr_work4 / weight_sum
array_avr_work => array_avr_work4
end if
if ( space_average(5) ) then
dim_size = array_shape(5)
array_shape(5) = 1
allocate( array_avr_work5( array_shape(1) , array_shape(2) , array_shape(3) , array_shape(4) , array_shape(5) ) )
array_avr_work5 = 0.0_DP
weight_sum = 0.0_DP
do i = 1, dim_size
array_avr_work5(:,:,:,:,1) = array_avr_work5(:,:,:,:,1) + array_avr_work(:,:,:,:,i) * weight5(i)
weight_sum = weight_sum + weight5(i)
end do
array_avr_work5 = array_avr_work5 / weight_sum
array_avr_work => array_avr_work5
end if
allocate( array_avr( array_shape(1) , array_shape(2) , array_shape(3) , array_shape(4) , array_shape(5) ) )
array_avr = array_avr_work
nullify( array_avr_work )
if ( associated( array_avr_work1 ) ) deallocate( array_avr_work1 )
if ( associated( array_avr_work2 ) ) deallocate( array_avr_work2 )
if ( associated( array_avr_work3 ) ) deallocate( array_avr_work3 )
if ( associated( array_avr_work4 ) ) deallocate( array_avr_work4 )
if ( associated( array_avr_work5 ) ) deallocate( array_avr_work5 )
end subroutine AverageReduceDouble5
| Subroutine : | |||
| array(:,:,:,:,:,:) : | real(DP), intent(in), target | ||
| space_average(6) : | logical, intent(in) | ||
| weight1(:) : | real(DP), intent(in) | ||
| weight2(:) : | real(DP), intent(in) | ||
| weight3(:) : | real(DP), intent(in) | ||
| weight4(:) : | real(DP), intent(in) | ||
| weight5(:) : | real(DP), intent(in) | ||
| weight6(:) : | real(DP), intent(in) | ||
| array_avr(:,:,:,:,:,:) : | real(DP), pointer
|
space_average で .true. に指定された次元に対して, array を平均化して array_avr に返します. 平均化には重み weight1 〜 weight7 が用いられます. array_avr の配列の次元そのものは減りません. その代わり, 平均化された次元の配列のサイズは 1 になります.
subroutine AverageReduceDouble6( array, space_average, weight1, weight2, weight3, weight4, weight5, weight6, array_avr )
!
! space_average で .true. に指定された次元に対して,
! array を平均化して array_avr に返します.
! 平均化には重み weight1 〜 weight7 が用いられます.
! array_avr の配列の次元そのものは減りません. その代わり,
! 平均化された次元の配列のサイズは 1 になります.
!
implicit none
real(DP), intent(in), target:: array(:,:,:,:,:,:)
logical, intent(in):: space_average(6)
real(DP), intent(in):: weight1(:)
real(DP), intent(in):: weight2(:)
real(DP), intent(in):: weight3(:)
real(DP), intent(in):: weight4(:)
real(DP), intent(in):: weight5(:)
real(DP), intent(in):: weight6(:)
real(DP), pointer:: array_avr(:,:,:,:,:,:) ! (out)
real(DP), pointer:: array_avr_work(:,:,:,:,:,:)
real(DP), pointer:: array_avr_work1(:,:,:,:,:,:)
real(DP), pointer:: array_avr_work2(:,:,:,:,:,:)
real(DP), pointer:: array_avr_work3(:,:,:,:,:,:)
real(DP), pointer:: array_avr_work4(:,:,:,:,:,:)
real(DP), pointer:: array_avr_work5(:,:,:,:,:,:)
real(DP), pointer:: array_avr_work6(:,:,:,:,:,:)
integer:: array_shape(6)
integer:: i, dim_size
real(DP):: weight_sum
continue
array_shape = shape( array )
array_avr_work => array
if ( space_average(1) ) then
dim_size = array_shape(1)
array_shape(1) = 1
allocate( array_avr_work1( array_shape(1) , array_shape(2) , array_shape(3) , array_shape(4) , array_shape(5) , array_shape(6) ) )
array_avr_work1 = 0.0_DP
weight_sum = 0.0_DP
do i = 1, dim_size
array_avr_work1(1,:,:,:,:,:) = array_avr_work1(1,:,:,:,:,:) + array_avr_work(i,:,:,:,:,:) * weight1(i)
weight_sum = weight_sum + weight1(i)
end do
array_avr_work1 = array_avr_work1 / weight_sum
array_avr_work => array_avr_work1
end if
if ( space_average(2) ) then
dim_size = array_shape(2)
array_shape(2) = 1
allocate( array_avr_work2( array_shape(1) , array_shape(2) , array_shape(3) , array_shape(4) , array_shape(5) , array_shape(6) ) )
array_avr_work2 = 0.0_DP
weight_sum = 0.0_DP
do i = 1, dim_size
array_avr_work2(:,1,:,:,:,:) = array_avr_work2(:,1,:,:,:,:) + array_avr_work(:,i,:,:,:,:) * weight2(i)
weight_sum = weight_sum + weight2(i)
end do
array_avr_work2 = array_avr_work2 / weight_sum
array_avr_work => array_avr_work2
end if
if ( space_average(3) ) then
dim_size = array_shape(3)
array_shape(3) = 1
allocate( array_avr_work3( array_shape(1) , array_shape(2) , array_shape(3) , array_shape(4) , array_shape(5) , array_shape(6) ) )
array_avr_work3 = 0.0_DP
weight_sum = 0.0_DP
do i = 1, dim_size
array_avr_work3(:,:,1,:,:,:) = array_avr_work3(:,:,1,:,:,:) + array_avr_work(:,:,i,:,:,:) * weight3(i)
weight_sum = weight_sum + weight3(i)
end do
array_avr_work3 = array_avr_work3 / weight_sum
array_avr_work => array_avr_work3
end if
if ( space_average(4) ) then
dim_size = array_shape(4)
array_shape(4) = 1
allocate( array_avr_work4( array_shape(1) , array_shape(2) , array_shape(3) , array_shape(4) , array_shape(5) , array_shape(6) ) )
array_avr_work4 = 0.0_DP
weight_sum = 0.0_DP
do i = 1, dim_size
array_avr_work4(:,:,:,1,:,:) = array_avr_work4(:,:,:,1,:,:) + array_avr_work(:,:,:,i,:,:) * weight4(i)
weight_sum = weight_sum + weight4(i)
end do
array_avr_work4 = array_avr_work4 / weight_sum
array_avr_work => array_avr_work4
end if
if ( space_average(5) ) then
dim_size = array_shape(5)
array_shape(5) = 1
allocate( array_avr_work5( array_shape(1) , array_shape(2) , array_shape(3) , array_shape(4) , array_shape(5) , array_shape(6) ) )
array_avr_work5 = 0.0_DP
weight_sum = 0.0_DP
do i = 1, dim_size
array_avr_work5(:,:,:,:,1,:) = array_avr_work5(:,:,:,:,1,:) + array_avr_work(:,:,:,:,i,:) * weight5(i)
weight_sum = weight_sum + weight5(i)
end do
array_avr_work5 = array_avr_work5 / weight_sum
array_avr_work => array_avr_work5
end if
if ( space_average(6) ) then
dim_size = array_shape(6)
array_shape(6) = 1
allocate( array_avr_work6( array_shape(1) , array_shape(2) , array_shape(3) , array_shape(4) , array_shape(5) , array_shape(6) ) )
array_avr_work6 = 0.0_DP
weight_sum = 0.0_DP
do i = 1, dim_size
array_avr_work6(:,:,:,:,:,1) = array_avr_work6(:,:,:,:,:,1) + array_avr_work(:,:,:,:,:,i) * weight6(i)
weight_sum = weight_sum + weight6(i)
end do
array_avr_work6 = array_avr_work6 / weight_sum
array_avr_work => array_avr_work6
end if
allocate( array_avr( array_shape(1) , array_shape(2) , array_shape(3) , array_shape(4) , array_shape(5) , array_shape(6) ) )
array_avr = array_avr_work
nullify( array_avr_work )
if ( associated( array_avr_work1 ) ) deallocate( array_avr_work1 )
if ( associated( array_avr_work2 ) ) deallocate( array_avr_work2 )
if ( associated( array_avr_work3 ) ) deallocate( array_avr_work3 )
if ( associated( array_avr_work4 ) ) deallocate( array_avr_work4 )
if ( associated( array_avr_work5 ) ) deallocate( array_avr_work5 )
if ( associated( array_avr_work6 ) ) deallocate( array_avr_work6 )
end subroutine AverageReduceDouble6
| Subroutine : | |||
| array(:,:,:,:,:,:,:) : | real(DP), intent(in), target | ||
| space_average(7) : | logical, intent(in) | ||
| weight1(:) : | real(DP), intent(in) | ||
| weight2(:) : | real(DP), intent(in) | ||
| weight3(:) : | real(DP), intent(in) | ||
| weight4(:) : | real(DP), intent(in) | ||
| weight5(:) : | real(DP), intent(in) | ||
| weight6(:) : | real(DP), intent(in) | ||
| weight7(:) : | real(DP), intent(in) | ||
| array_avr(:,:,:,:,:,:,:) : | real(DP), pointer
|
space_average で .true. に指定された次元に対して, array を平均化して array_avr に返します. 平均化には重み weight1 〜 weight7 が用いられます. array_avr の配列の次元そのものは減りません. その代わり, 平均化された次元の配列のサイズは 1 になります.
subroutine AverageReduceDouble7( array, space_average, weight1, weight2, weight3, weight4, weight5, weight6, weight7, array_avr )
!
! space_average で .true. に指定された次元に対して,
! array を平均化して array_avr に返します.
! 平均化には重み weight1 〜 weight7 が用いられます.
! array_avr の配列の次元そのものは減りません. その代わり,
! 平均化された次元の配列のサイズは 1 になります.
!
implicit none
real(DP), intent(in), target:: array(:,:,:,:,:,:,:)
logical, intent(in):: space_average(7)
real(DP), intent(in):: weight1(:)
real(DP), intent(in):: weight2(:)
real(DP), intent(in):: weight3(:)
real(DP), intent(in):: weight4(:)
real(DP), intent(in):: weight5(:)
real(DP), intent(in):: weight6(:)
real(DP), intent(in):: weight7(:)
real(DP), pointer:: array_avr(:,:,:,:,:,:,:) ! (out)
real(DP), pointer:: array_avr_work(:,:,:,:,:,:,:)
real(DP), pointer:: array_avr_work1(:,:,:,:,:,:,:)
real(DP), pointer:: array_avr_work2(:,:,:,:,:,:,:)
real(DP), pointer:: array_avr_work3(:,:,:,:,:,:,:)
real(DP), pointer:: array_avr_work4(:,:,:,:,:,:,:)
real(DP), pointer:: array_avr_work5(:,:,:,:,:,:,:)
real(DP), pointer:: array_avr_work6(:,:,:,:,:,:,:)
real(DP), pointer:: array_avr_work7(:,:,:,:,:,:,:)
integer:: array_shape(7)
integer:: i, dim_size
real(DP):: weight_sum
continue
array_shape = shape( array )
array_avr_work => array
if ( space_average(1) ) then
dim_size = array_shape(1)
array_shape(1) = 1
allocate( array_avr_work1( array_shape(1) , array_shape(2) , array_shape(3) , array_shape(4) , array_shape(5) , array_shape(6) , array_shape(7) ) )
array_avr_work1 = 0.0_DP
weight_sum = 0.0_DP
do i = 1, dim_size
array_avr_work1(1,:,:,:,:,:,:) = array_avr_work1(1,:,:,:,:,:,:) + array_avr_work(i,:,:,:,:,:,:) * weight1(i)
weight_sum = weight_sum + weight1(i)
end do
array_avr_work1 = array_avr_work1 / weight_sum
array_avr_work => array_avr_work1
end if
if ( space_average(2) ) then
dim_size = array_shape(2)
array_shape(2) = 1
allocate( array_avr_work2( array_shape(1) , array_shape(2) , array_shape(3) , array_shape(4) , array_shape(5) , array_shape(6) , array_shape(7) ) )
array_avr_work2 = 0.0_DP
weight_sum = 0.0_DP
do i = 1, dim_size
array_avr_work2(:,1,:,:,:,:,:) = array_avr_work2(:,1,:,:,:,:,:) + array_avr_work(:,i,:,:,:,:,:) * weight2(i)
weight_sum = weight_sum + weight2(i)
end do
array_avr_work2 = array_avr_work2 / weight_sum
array_avr_work => array_avr_work2
end if
if ( space_average(3) ) then
dim_size = array_shape(3)
array_shape(3) = 1
allocate( array_avr_work3( array_shape(1) , array_shape(2) , array_shape(3) , array_shape(4) , array_shape(5) , array_shape(6) , array_shape(7) ) )
array_avr_work3 = 0.0_DP
weight_sum = 0.0_DP
do i = 1, dim_size
array_avr_work3(:,:,1,:,:,:,:) = array_avr_work3(:,:,1,:,:,:,:) + array_avr_work(:,:,i,:,:,:,:) * weight3(i)
weight_sum = weight_sum + weight3(i)
end do
array_avr_work3 = array_avr_work3 / weight_sum
array_avr_work => array_avr_work3
end if
if ( space_average(4) ) then
dim_size = array_shape(4)
array_shape(4) = 1
allocate( array_avr_work4( array_shape(1) , array_shape(2) , array_shape(3) , array_shape(4) , array_shape(5) , array_shape(6) , array_shape(7) ) )
array_avr_work4 = 0.0_DP
weight_sum = 0.0_DP
do i = 1, dim_size
array_avr_work4(:,:,:,1,:,:,:) = array_avr_work4(:,:,:,1,:,:,:) + array_avr_work(:,:,:,i,:,:,:) * weight4(i)
weight_sum = weight_sum + weight4(i)
end do
array_avr_work4 = array_avr_work4 / weight_sum
array_avr_work => array_avr_work4
end if
if ( space_average(5) ) then
dim_size = array_shape(5)
array_shape(5) = 1
allocate( array_avr_work5( array_shape(1) , array_shape(2) , array_shape(3) , array_shape(4) , array_shape(5) , array_shape(6) , array_shape(7) ) )
array_avr_work5 = 0.0_DP
weight_sum = 0.0_DP
do i = 1, dim_size
array_avr_work5(:,:,:,:,1,:,:) = array_avr_work5(:,:,:,:,1,:,:) + array_avr_work(:,:,:,:,i,:,:) * weight5(i)
weight_sum = weight_sum + weight5(i)
end do
array_avr_work5 = array_avr_work5 / weight_sum
array_avr_work => array_avr_work5
end if
if ( space_average(6) ) then
dim_size = array_shape(6)
array_shape(6) = 1
allocate( array_avr_work6( array_shape(1) , array_shape(2) , array_shape(3) , array_shape(4) , array_shape(5) , array_shape(6) , array_shape(7) ) )
array_avr_work6 = 0.0_DP
weight_sum = 0.0_DP
do i = 1, dim_size
array_avr_work6(:,:,:,:,:,1,:) = array_avr_work6(:,:,:,:,:,1,:) + array_avr_work(:,:,:,:,:,i,:) * weight6(i)
weight_sum = weight_sum + weight6(i)
end do
array_avr_work6 = array_avr_work6 / weight_sum
array_avr_work => array_avr_work6
end if
if ( space_average(7) ) then
dim_size = array_shape(7)
array_shape(7) = 1
allocate( array_avr_work7( array_shape(1) , array_shape(2) , array_shape(3) , array_shape(4) , array_shape(5) , array_shape(6) , array_shape(7) ) )
array_avr_work7 = 0.0_DP
weight_sum = 0.0_DP
do i = 1, dim_size
array_avr_work7(:,:,:,:,:,:,1) = array_avr_work7(:,:,:,:,:,:,1) + array_avr_work(:,:,:,:,:,:,i) * weight7(i)
weight_sum = weight_sum + weight7(i)
end do
array_avr_work7 = array_avr_work7 / weight_sum
array_avr_work => array_avr_work7
end if
allocate( array_avr( array_shape(1) , array_shape(2) , array_shape(3) , array_shape(4) , array_shape(5) , array_shape(6) , array_shape(7) ) )
array_avr = array_avr_work
nullify( array_avr_work )
if ( associated( array_avr_work1 ) ) deallocate( array_avr_work1 )
if ( associated( array_avr_work2 ) ) deallocate( array_avr_work2 )
if ( associated( array_avr_work3 ) ) deallocate( array_avr_work3 )
if ( associated( array_avr_work4 ) ) deallocate( array_avr_work4 )
if ( associated( array_avr_work5 ) ) deallocate( array_avr_work5 )
if ( associated( array_avr_work6 ) ) deallocate( array_avr_work6 )
if ( associated( array_avr_work7 ) ) deallocate( array_avr_work7 )
end subroutine AverageReduceDouble7
| Subroutine : | |||
| array(:) : | integer, intent(in), target | ||
| space_average(1) : | logical, intent(in) | ||
| weight1(:) : | real(DP), intent(in) | ||
| array_avr(:) : | integer, pointer
|
space_average で .true. に指定された次元に対して, array を平均化して array_avr に返します. 平均化には重み weight1 〜 weight7 が用いられます. array_avr の配列の次元そのものは減りません. その代わり, 平均化された次元の配列のサイズは 1 になります.
subroutine AverageReduceInt1( array, space_average, weight1, array_avr )
!
! space_average で .true. に指定された次元に対して,
! array を平均化して array_avr に返します.
! 平均化には重み weight1 〜 weight7 が用いられます.
! array_avr の配列の次元そのものは減りません. その代わり,
! 平均化された次元の配列のサイズは 1 になります.
!
implicit none
integer, intent(in), target:: array(:)
logical, intent(in):: space_average(1)
real(DP), intent(in):: weight1(:)
integer, pointer:: array_avr(:) ! (out)
integer, pointer:: array_avr_work(:)
integer, pointer:: array_avr_work1(:)
integer:: array_shape(1)
integer:: i, dim_size
real(DP):: weight_sum
continue
array_shape = shape( array )
array_avr_work => array
if ( space_average(1) ) then
dim_size = array_shape(1)
array_shape(1) = 1
allocate( array_avr_work1( array_shape(1) ) )
array_avr_work1 = 0
weight_sum = 0.0_DP
do i = 1, dim_size
array_avr_work1(1) = array_avr_work1(1) + array_avr_work(i) * weight1(i)
weight_sum = weight_sum + weight1(i)
end do
array_avr_work1 = array_avr_work1 / weight_sum
array_avr_work => array_avr_work1
end if
allocate( array_avr( array_shape(1) ) )
array_avr = array_avr_work
nullify( array_avr_work )
if ( associated( array_avr_work1 ) ) deallocate( array_avr_work1 )
end subroutine AverageReduceInt1
| Subroutine : | |||
| array(:,:) : | integer, intent(in), target | ||
| space_average(2) : | logical, intent(in) | ||
| weight1(:) : | real(DP), intent(in) | ||
| weight2(:) : | real(DP), intent(in) | ||
| array_avr(:,:) : | integer, pointer
|
space_average で .true. に指定された次元に対して, array を平均化して array_avr に返します. 平均化には重み weight1 〜 weight7 が用いられます. array_avr の配列の次元そのものは減りません. その代わり, 平均化された次元の配列のサイズは 1 になります.
subroutine AverageReduceInt2( array, space_average, weight1, weight2, array_avr )
!
! space_average で .true. に指定された次元に対して,
! array を平均化して array_avr に返します.
! 平均化には重み weight1 〜 weight7 が用いられます.
! array_avr の配列の次元そのものは減りません. その代わり,
! 平均化された次元の配列のサイズは 1 になります.
!
implicit none
integer, intent(in), target:: array(:,:)
logical, intent(in):: space_average(2)
real(DP), intent(in):: weight1(:)
real(DP), intent(in):: weight2(:)
integer, pointer:: array_avr(:,:) ! (out)
integer, pointer:: array_avr_work(:,:)
integer, pointer:: array_avr_work1(:,:)
integer, pointer:: array_avr_work2(:,:)
integer:: array_shape(2)
integer:: i, dim_size
real(DP):: weight_sum
continue
array_shape = shape( array )
array_avr_work => array
if ( space_average(1) ) then
dim_size = array_shape(1)
array_shape(1) = 1
allocate( array_avr_work1( array_shape(1) , array_shape(2) ) )
array_avr_work1 = 0
weight_sum = 0.0_DP
do i = 1, dim_size
array_avr_work1(1,:) = array_avr_work1(1,:) + array_avr_work(i,:) * weight1(i)
weight_sum = weight_sum + weight1(i)
end do
array_avr_work1 = array_avr_work1 / weight_sum
array_avr_work => array_avr_work1
end if
if ( space_average(2) ) then
dim_size = array_shape(2)
array_shape(2) = 1
allocate( array_avr_work2( array_shape(1) , array_shape(2) ) )
array_avr_work2 = 0
weight_sum = 0.0_DP
do i = 1, dim_size
array_avr_work2(:,1) = array_avr_work2(:,1) + array_avr_work(:,i) * weight2(i)
weight_sum = weight_sum + weight2(i)
end do
array_avr_work2 = array_avr_work2 / weight_sum
array_avr_work => array_avr_work2
end if
allocate( array_avr( array_shape(1) , array_shape(2) ) )
array_avr = array_avr_work
nullify( array_avr_work )
if ( associated( array_avr_work1 ) ) deallocate( array_avr_work1 )
if ( associated( array_avr_work2 ) ) deallocate( array_avr_work2 )
end subroutine AverageReduceInt2
| Subroutine : | |||
| array(:,:,:) : | integer, intent(in), target | ||
| space_average(3) : | logical, intent(in) | ||
| weight1(:) : | real(DP), intent(in) | ||
| weight2(:) : | real(DP), intent(in) | ||
| weight3(:) : | real(DP), intent(in) | ||
| array_avr(:,:,:) : | integer, pointer
|
space_average で .true. に指定された次元に対して, array を平均化して array_avr に返します. 平均化には重み weight1 〜 weight7 が用いられます. array_avr の配列の次元そのものは減りません. その代わり, 平均化された次元の配列のサイズは 1 になります.
subroutine AverageReduceInt3( array, space_average, weight1, weight2, weight3, array_avr )
!
! space_average で .true. に指定された次元に対して,
! array を平均化して array_avr に返します.
! 平均化には重み weight1 〜 weight7 が用いられます.
! array_avr の配列の次元そのものは減りません. その代わり,
! 平均化された次元の配列のサイズは 1 になります.
!
implicit none
integer, intent(in), target:: array(:,:,:)
logical, intent(in):: space_average(3)
real(DP), intent(in):: weight1(:)
real(DP), intent(in):: weight2(:)
real(DP), intent(in):: weight3(:)
integer, pointer:: array_avr(:,:,:) ! (out)
integer, pointer:: array_avr_work(:,:,:)
integer, pointer:: array_avr_work1(:,:,:)
integer, pointer:: array_avr_work2(:,:,:)
integer, pointer:: array_avr_work3(:,:,:)
integer:: array_shape(3)
integer:: i, dim_size
real(DP):: weight_sum
continue
array_shape = shape( array )
array_avr_work => array
if ( space_average(1) ) then
dim_size = array_shape(1)
array_shape(1) = 1
allocate( array_avr_work1( array_shape(1) , array_shape(2) , array_shape(3) ) )
array_avr_work1 = 0
weight_sum = 0.0_DP
do i = 1, dim_size
array_avr_work1(1,:,:) = array_avr_work1(1,:,:) + array_avr_work(i,:,:) * weight1(i)
weight_sum = weight_sum + weight1(i)
end do
array_avr_work1 = array_avr_work1 / weight_sum
array_avr_work => array_avr_work1
end if
if ( space_average(2) ) then
dim_size = array_shape(2)
array_shape(2) = 1
allocate( array_avr_work2( array_shape(1) , array_shape(2) , array_shape(3) ) )
array_avr_work2 = 0
weight_sum = 0.0_DP
do i = 1, dim_size
array_avr_work2(:,1,:) = array_avr_work2(:,1,:) + array_avr_work(:,i,:) * weight2(i)
weight_sum = weight_sum + weight2(i)
end do
array_avr_work2 = array_avr_work2 / weight_sum
array_avr_work => array_avr_work2
end if
if ( space_average(3) ) then
dim_size = array_shape(3)
array_shape(3) = 1
allocate( array_avr_work3( array_shape(1) , array_shape(2) , array_shape(3) ) )
array_avr_work3 = 0
weight_sum = 0.0_DP
do i = 1, dim_size
array_avr_work3(:,:,1) = array_avr_work3(:,:,1) + array_avr_work(:,:,i) * weight3(i)
weight_sum = weight_sum + weight3(i)
end do
array_avr_work3 = array_avr_work3 / weight_sum
array_avr_work => array_avr_work3
end if
allocate( array_avr( array_shape(1) , array_shape(2) , array_shape(3) ) )
array_avr = array_avr_work
nullify( array_avr_work )
if ( associated( array_avr_work1 ) ) deallocate( array_avr_work1 )
if ( associated( array_avr_work2 ) ) deallocate( array_avr_work2 )
if ( associated( array_avr_work3 ) ) deallocate( array_avr_work3 )
end subroutine AverageReduceInt3
| Subroutine : | |||
| array(:,:,:,:) : | integer, intent(in), target | ||
| space_average(4) : | logical, intent(in) | ||
| weight1(:) : | real(DP), intent(in) | ||
| weight2(:) : | real(DP), intent(in) | ||
| weight3(:) : | real(DP), intent(in) | ||
| weight4(:) : | real(DP), intent(in) | ||
| array_avr(:,:,:,:) : | integer, pointer
|
space_average で .true. に指定された次元に対して, array を平均化して array_avr に返します. 平均化には重み weight1 〜 weight7 が用いられます. array_avr の配列の次元そのものは減りません. その代わり, 平均化された次元の配列のサイズは 1 になります.
subroutine AverageReduceInt4( array, space_average, weight1, weight2, weight3, weight4, array_avr )
!
! space_average で .true. に指定された次元に対して,
! array を平均化して array_avr に返します.
! 平均化には重み weight1 〜 weight7 が用いられます.
! array_avr の配列の次元そのものは減りません. その代わり,
! 平均化された次元の配列のサイズは 1 になります.
!
implicit none
integer, intent(in), target:: array(:,:,:,:)
logical, intent(in):: space_average(4)
real(DP), intent(in):: weight1(:)
real(DP), intent(in):: weight2(:)
real(DP), intent(in):: weight3(:)
real(DP), intent(in):: weight4(:)
integer, pointer:: array_avr(:,:,:,:) ! (out)
integer, pointer:: array_avr_work(:,:,:,:)
integer, pointer:: array_avr_work1(:,:,:,:)
integer, pointer:: array_avr_work2(:,:,:,:)
integer, pointer:: array_avr_work3(:,:,:,:)
integer, pointer:: array_avr_work4(:,:,:,:)
integer:: array_shape(4)
integer:: i, dim_size
real(DP):: weight_sum
continue
array_shape = shape( array )
array_avr_work => array
if ( space_average(1) ) then
dim_size = array_shape(1)
array_shape(1) = 1
allocate( array_avr_work1( array_shape(1) , array_shape(2) , array_shape(3) , array_shape(4) ) )
array_avr_work1 = 0
weight_sum = 0.0_DP
do i = 1, dim_size
array_avr_work1(1,:,:,:) = array_avr_work1(1,:,:,:) + array_avr_work(i,:,:,:) * weight1(i)
weight_sum = weight_sum + weight1(i)
end do
array_avr_work1 = array_avr_work1 / weight_sum
array_avr_work => array_avr_work1
end if
if ( space_average(2) ) then
dim_size = array_shape(2)
array_shape(2) = 1
allocate( array_avr_work2( array_shape(1) , array_shape(2) , array_shape(3) , array_shape(4) ) )
array_avr_work2 = 0
weight_sum = 0.0_DP
do i = 1, dim_size
array_avr_work2(:,1,:,:) = array_avr_work2(:,1,:,:) + array_avr_work(:,i,:,:) * weight2(i)
weight_sum = weight_sum + weight2(i)
end do
array_avr_work2 = array_avr_work2 / weight_sum
array_avr_work => array_avr_work2
end if
if ( space_average(3) ) then
dim_size = array_shape(3)
array_shape(3) = 1
allocate( array_avr_work3( array_shape(1) , array_shape(2) , array_shape(3) , array_shape(4) ) )
array_avr_work3 = 0
weight_sum = 0.0_DP
do i = 1, dim_size
array_avr_work3(:,:,1,:) = array_avr_work3(:,:,1,:) + array_avr_work(:,:,i,:) * weight3(i)
weight_sum = weight_sum + weight3(i)
end do
array_avr_work3 = array_avr_work3 / weight_sum
array_avr_work => array_avr_work3
end if
if ( space_average(4) ) then
dim_size = array_shape(4)
array_shape(4) = 1
allocate( array_avr_work4( array_shape(1) , array_shape(2) , array_shape(3) , array_shape(4) ) )
array_avr_work4 = 0
weight_sum = 0.0_DP
do i = 1, dim_size
array_avr_work4(:,:,:,1) = array_avr_work4(:,:,:,1) + array_avr_work(:,:,:,i) * weight4(i)
weight_sum = weight_sum + weight4(i)
end do
array_avr_work4 = array_avr_work4 / weight_sum
array_avr_work => array_avr_work4
end if
allocate( array_avr( array_shape(1) , array_shape(2) , array_shape(3) , array_shape(4) ) )
array_avr = array_avr_work
nullify( array_avr_work )
if ( associated( array_avr_work1 ) ) deallocate( array_avr_work1 )
if ( associated( array_avr_work2 ) ) deallocate( array_avr_work2 )
if ( associated( array_avr_work3 ) ) deallocate( array_avr_work3 )
if ( associated( array_avr_work4 ) ) deallocate( array_avr_work4 )
end subroutine AverageReduceInt4
| Subroutine : | |||
| array(:,:,:,:,:) : | integer, intent(in), target | ||
| space_average(5) : | logical, intent(in) | ||
| weight1(:) : | real(DP), intent(in) | ||
| weight2(:) : | real(DP), intent(in) | ||
| weight3(:) : | real(DP), intent(in) | ||
| weight4(:) : | real(DP), intent(in) | ||
| weight5(:) : | real(DP), intent(in) | ||
| array_avr(:,:,:,:,:) : | integer, pointer
|
space_average で .true. に指定された次元に対して, array を平均化して array_avr に返します. 平均化には重み weight1 〜 weight7 が用いられます. array_avr の配列の次元そのものは減りません. その代わり, 平均化された次元の配列のサイズは 1 になります.
subroutine AverageReduceInt5( array, space_average, weight1, weight2, weight3, weight4, weight5, array_avr )
!
! space_average で .true. に指定された次元に対して,
! array を平均化して array_avr に返します.
! 平均化には重み weight1 〜 weight7 が用いられます.
! array_avr の配列の次元そのものは減りません. その代わり,
! 平均化された次元の配列のサイズは 1 になります.
!
implicit none
integer, intent(in), target:: array(:,:,:,:,:)
logical, intent(in):: space_average(5)
real(DP), intent(in):: weight1(:)
real(DP), intent(in):: weight2(:)
real(DP), intent(in):: weight3(:)
real(DP), intent(in):: weight4(:)
real(DP), intent(in):: weight5(:)
integer, pointer:: array_avr(:,:,:,:,:) ! (out)
integer, pointer:: array_avr_work(:,:,:,:,:)
integer, pointer:: array_avr_work1(:,:,:,:,:)
integer, pointer:: array_avr_work2(:,:,:,:,:)
integer, pointer:: array_avr_work3(:,:,:,:,:)
integer, pointer:: array_avr_work4(:,:,:,:,:)
integer, pointer:: array_avr_work5(:,:,:,:,:)
integer:: array_shape(5)
integer:: i, dim_size
real(DP):: weight_sum
continue
array_shape = shape( array )
array_avr_work => array
if ( space_average(1) ) then
dim_size = array_shape(1)
array_shape(1) = 1
allocate( array_avr_work1( array_shape(1) , array_shape(2) , array_shape(3) , array_shape(4) , array_shape(5) ) )
array_avr_work1 = 0
weight_sum = 0.0_DP
do i = 1, dim_size
array_avr_work1(1,:,:,:,:) = array_avr_work1(1,:,:,:,:) + array_avr_work(i,:,:,:,:) * weight1(i)
weight_sum = weight_sum + weight1(i)
end do
array_avr_work1 = array_avr_work1 / weight_sum
array_avr_work => array_avr_work1
end if
if ( space_average(2) ) then
dim_size = array_shape(2)
array_shape(2) = 1
allocate( array_avr_work2( array_shape(1) , array_shape(2) , array_shape(3) , array_shape(4) , array_shape(5) ) )
array_avr_work2 = 0
weight_sum = 0.0_DP
do i = 1, dim_size
array_avr_work2(:,1,:,:,:) = array_avr_work2(:,1,:,:,:) + array_avr_work(:,i,:,:,:) * weight2(i)
weight_sum = weight_sum + weight2(i)
end do
array_avr_work2 = array_avr_work2 / weight_sum
array_avr_work => array_avr_work2
end if
if ( space_average(3) ) then
dim_size = array_shape(3)
array_shape(3) = 1
allocate( array_avr_work3( array_shape(1) , array_shape(2) , array_shape(3) , array_shape(4) , array_shape(5) ) )
array_avr_work3 = 0
weight_sum = 0.0_DP
do i = 1, dim_size
array_avr_work3(:,:,1,:,:) = array_avr_work3(:,:,1,:,:) + array_avr_work(:,:,i,:,:) * weight3(i)
weight_sum = weight_sum + weight3(i)
end do
array_avr_work3 = array_avr_work3 / weight_sum
array_avr_work => array_avr_work3
end if
if ( space_average(4) ) then
dim_size = array_shape(4)
array_shape(4) = 1
allocate( array_avr_work4( array_shape(1) , array_shape(2) , array_shape(3) , array_shape(4) , array_shape(5) ) )
array_avr_work4 = 0
weight_sum = 0.0_DP
do i = 1, dim_size
array_avr_work4(:,:,:,1,:) = array_avr_work4(:,:,:,1,:) + array_avr_work(:,:,:,i,:) * weight4(i)
weight_sum = weight_sum + weight4(i)
end do
array_avr_work4 = array_avr_work4 / weight_sum
array_avr_work => array_avr_work4
end if
if ( space_average(5) ) then
dim_size = array_shape(5)
array_shape(5) = 1
allocate( array_avr_work5( array_shape(1) , array_shape(2) , array_shape(3) , array_shape(4) , array_shape(5) ) )
array_avr_work5 = 0
weight_sum = 0.0_DP
do i = 1, dim_size
array_avr_work5(:,:,:,:,1) = array_avr_work5(:,:,:,:,1) + array_avr_work(:,:,:,:,i) * weight5(i)
weight_sum = weight_sum + weight5(i)
end do
array_avr_work5 = array_avr_work5 / weight_sum
array_avr_work => array_avr_work5
end if
allocate( array_avr( array_shape(1) , array_shape(2) , array_shape(3) , array_shape(4) , array_shape(5) ) )
array_avr = array_avr_work
nullify( array_avr_work )
if ( associated( array_avr_work1 ) ) deallocate( array_avr_work1 )
if ( associated( array_avr_work2 ) ) deallocate( array_avr_work2 )
if ( associated( array_avr_work3 ) ) deallocate( array_avr_work3 )
if ( associated( array_avr_work4 ) ) deallocate( array_avr_work4 )
if ( associated( array_avr_work5 ) ) deallocate( array_avr_work5 )
end subroutine AverageReduceInt5
| Subroutine : | |||
| array(:,:,:,:,:,:) : | integer, intent(in), target | ||
| space_average(6) : | logical, intent(in) | ||
| weight1(:) : | real(DP), intent(in) | ||
| weight2(:) : | real(DP), intent(in) | ||
| weight3(:) : | real(DP), intent(in) | ||
| weight4(:) : | real(DP), intent(in) | ||
| weight5(:) : | real(DP), intent(in) | ||
| weight6(:) : | real(DP), intent(in) | ||
| array_avr(:,:,:,:,:,:) : | integer, pointer
|
space_average で .true. に指定された次元に対して, array を平均化して array_avr に返します. 平均化には重み weight1 〜 weight7 が用いられます. array_avr の配列の次元そのものは減りません. その代わり, 平均化された次元の配列のサイズは 1 になります.
subroutine AverageReduceInt6( array, space_average, weight1, weight2, weight3, weight4, weight5, weight6, array_avr )
!
! space_average で .true. に指定された次元に対して,
! array を平均化して array_avr に返します.
! 平均化には重み weight1 〜 weight7 が用いられます.
! array_avr の配列の次元そのものは減りません. その代わり,
! 平均化された次元の配列のサイズは 1 になります.
!
implicit none
integer, intent(in), target:: array(:,:,:,:,:,:)
logical, intent(in):: space_average(6)
real(DP), intent(in):: weight1(:)
real(DP), intent(in):: weight2(:)
real(DP), intent(in):: weight3(:)
real(DP), intent(in):: weight4(:)
real(DP), intent(in):: weight5(:)
real(DP), intent(in):: weight6(:)
integer, pointer:: array_avr(:,:,:,:,:,:) ! (out)
integer, pointer:: array_avr_work(:,:,:,:,:,:)
integer, pointer:: array_avr_work1(:,:,:,:,:,:)
integer, pointer:: array_avr_work2(:,:,:,:,:,:)
integer, pointer:: array_avr_work3(:,:,:,:,:,:)
integer, pointer:: array_avr_work4(:,:,:,:,:,:)
integer, pointer:: array_avr_work5(:,:,:,:,:,:)
integer, pointer:: array_avr_work6(:,:,:,:,:,:)
integer:: array_shape(6)
integer:: i, dim_size
real(DP):: weight_sum
continue
array_shape = shape( array )
array_avr_work => array
if ( space_average(1) ) then
dim_size = array_shape(1)
array_shape(1) = 1
allocate( array_avr_work1( array_shape(1) , array_shape(2) , array_shape(3) , array_shape(4) , array_shape(5) , array_shape(6) ) )
array_avr_work1 = 0
weight_sum = 0.0_DP
do i = 1, dim_size
array_avr_work1(1,:,:,:,:,:) = array_avr_work1(1,:,:,:,:,:) + array_avr_work(i,:,:,:,:,:) * weight1(i)
weight_sum = weight_sum + weight1(i)
end do
array_avr_work1 = array_avr_work1 / weight_sum
array_avr_work => array_avr_work1
end if
if ( space_average(2) ) then
dim_size = array_shape(2)
array_shape(2) = 1
allocate( array_avr_work2( array_shape(1) , array_shape(2) , array_shape(3) , array_shape(4) , array_shape(5) , array_shape(6) ) )
array_avr_work2 = 0
weight_sum = 0.0_DP
do i = 1, dim_size
array_avr_work2(:,1,:,:,:,:) = array_avr_work2(:,1,:,:,:,:) + array_avr_work(:,i,:,:,:,:) * weight2(i)
weight_sum = weight_sum + weight2(i)
end do
array_avr_work2 = array_avr_work2 / weight_sum
array_avr_work => array_avr_work2
end if
if ( space_average(3) ) then
dim_size = array_shape(3)
array_shape(3) = 1
allocate( array_avr_work3( array_shape(1) , array_shape(2) , array_shape(3) , array_shape(4) , array_shape(5) , array_shape(6) ) )
array_avr_work3 = 0
weight_sum = 0.0_DP
do i = 1, dim_size
array_avr_work3(:,:,1,:,:,:) = array_avr_work3(:,:,1,:,:,:) + array_avr_work(:,:,i,:,:,:) * weight3(i)
weight_sum = weight_sum + weight3(i)
end do
array_avr_work3 = array_avr_work3 / weight_sum
array_avr_work => array_avr_work3
end if
if ( space_average(4) ) then
dim_size = array_shape(4)
array_shape(4) = 1
allocate( array_avr_work4( array_shape(1) , array_shape(2) , array_shape(3) , array_shape(4) , array_shape(5) , array_shape(6) ) )
array_avr_work4 = 0
weight_sum = 0.0_DP
do i = 1, dim_size
array_avr_work4(:,:,:,1,:,:) = array_avr_work4(:,:,:,1,:,:) + array_avr_work(:,:,:,i,:,:) * weight4(i)
weight_sum = weight_sum + weight4(i)
end do
array_avr_work4 = array_avr_work4 / weight_sum
array_avr_work => array_avr_work4
end if
if ( space_average(5) ) then
dim_size = array_shape(5)
array_shape(5) = 1
allocate( array_avr_work5( array_shape(1) , array_shape(2) , array_shape(3) , array_shape(4) , array_shape(5) , array_shape(6) ) )
array_avr_work5 = 0
weight_sum = 0.0_DP
do i = 1, dim_size
array_avr_work5(:,:,:,:,1,:) = array_avr_work5(:,:,:,:,1,:) + array_avr_work(:,:,:,:,i,:) * weight5(i)
weight_sum = weight_sum + weight5(i)
end do
array_avr_work5 = array_avr_work5 / weight_sum
array_avr_work => array_avr_work5
end if
if ( space_average(6) ) then
dim_size = array_shape(6)
array_shape(6) = 1
allocate( array_avr_work6( array_shape(1) , array_shape(2) , array_shape(3) , array_shape(4) , array_shape(5) , array_shape(6) ) )
array_avr_work6 = 0
weight_sum = 0.0_DP
do i = 1, dim_size
array_avr_work6(:,:,:,:,:,1) = array_avr_work6(:,:,:,:,:,1) + array_avr_work(:,:,:,:,:,i) * weight6(i)
weight_sum = weight_sum + weight6(i)
end do
array_avr_work6 = array_avr_work6 / weight_sum
array_avr_work => array_avr_work6
end if
allocate( array_avr( array_shape(1) , array_shape(2) , array_shape(3) , array_shape(4) , array_shape(5) , array_shape(6) ) )
array_avr = array_avr_work
nullify( array_avr_work )
if ( associated( array_avr_work1 ) ) deallocate( array_avr_work1 )
if ( associated( array_avr_work2 ) ) deallocate( array_avr_work2 )
if ( associated( array_avr_work3 ) ) deallocate( array_avr_work3 )
if ( associated( array_avr_work4 ) ) deallocate( array_avr_work4 )
if ( associated( array_avr_work5 ) ) deallocate( array_avr_work5 )
if ( associated( array_avr_work6 ) ) deallocate( array_avr_work6 )
end subroutine AverageReduceInt6
| Subroutine : | |||
| array(:,:,:,:,:,:,:) : | integer, intent(in), target | ||
| space_average(7) : | logical, intent(in) | ||
| weight1(:) : | real(DP), intent(in) | ||
| weight2(:) : | real(DP), intent(in) | ||
| weight3(:) : | real(DP), intent(in) | ||
| weight4(:) : | real(DP), intent(in) | ||
| weight5(:) : | real(DP), intent(in) | ||
| weight6(:) : | real(DP), intent(in) | ||
| weight7(:) : | real(DP), intent(in) | ||
| array_avr(:,:,:,:,:,:,:) : | integer, pointer
|
space_average で .true. に指定された次元に対して, array を平均化して array_avr に返します. 平均化には重み weight1 〜 weight7 が用いられます. array_avr の配列の次元そのものは減りません. その代わり, 平均化された次元の配列のサイズは 1 になります.
subroutine AverageReduceInt7( array, space_average, weight1, weight2, weight3, weight4, weight5, weight6, weight7, array_avr )
!
! space_average で .true. に指定された次元に対して,
! array を平均化して array_avr に返します.
! 平均化には重み weight1 〜 weight7 が用いられます.
! array_avr の配列の次元そのものは減りません. その代わり,
! 平均化された次元の配列のサイズは 1 になります.
!
implicit none
integer, intent(in), target:: array(:,:,:,:,:,:,:)
logical, intent(in):: space_average(7)
real(DP), intent(in):: weight1(:)
real(DP), intent(in):: weight2(:)
real(DP), intent(in):: weight3(:)
real(DP), intent(in):: weight4(:)
real(DP), intent(in):: weight5(:)
real(DP), intent(in):: weight6(:)
real(DP), intent(in):: weight7(:)
integer, pointer:: array_avr(:,:,:,:,:,:,:) ! (out)
integer, pointer:: array_avr_work(:,:,:,:,:,:,:)
integer, pointer:: array_avr_work1(:,:,:,:,:,:,:)
integer, pointer:: array_avr_work2(:,:,:,:,:,:,:)
integer, pointer:: array_avr_work3(:,:,:,:,:,:,:)
integer, pointer:: array_avr_work4(:,:,:,:,:,:,:)
integer, pointer:: array_avr_work5(:,:,:,:,:,:,:)
integer, pointer:: array_avr_work6(:,:,:,:,:,:,:)
integer, pointer:: array_avr_work7(:,:,:,:,:,:,:)
integer:: array_shape(7)
integer:: i, dim_size
real(DP):: weight_sum
continue
array_shape = shape( array )
array_avr_work => array
if ( space_average(1) ) then
dim_size = array_shape(1)
array_shape(1) = 1
allocate( array_avr_work1( array_shape(1) , array_shape(2) , array_shape(3) , array_shape(4) , array_shape(5) , array_shape(6) , array_shape(7) ) )
array_avr_work1 = 0
weight_sum = 0.0_DP
do i = 1, dim_size
array_avr_work1(1,:,:,:,:,:,:) = array_avr_work1(1,:,:,:,:,:,:) + array_avr_work(i,:,:,:,:,:,:) * weight1(i)
weight_sum = weight_sum + weight1(i)
end do
array_avr_work1 = array_avr_work1 / weight_sum
array_avr_work => array_avr_work1
end if
if ( space_average(2) ) then
dim_size = array_shape(2)
array_shape(2) = 1
allocate( array_avr_work2( array_shape(1) , array_shape(2) , array_shape(3) , array_shape(4) , array_shape(5) , array_shape(6) , array_shape(7) ) )
array_avr_work2 = 0
weight_sum = 0.0_DP
do i = 1, dim_size
array_avr_work2(:,1,:,:,:,:,:) = array_avr_work2(:,1,:,:,:,:,:) + array_avr_work(:,i,:,:,:,:,:) * weight2(i)
weight_sum = weight_sum + weight2(i)
end do
array_avr_work2 = array_avr_work2 / weight_sum
array_avr_work => array_avr_work2
end if
if ( space_average(3) ) then
dim_size = array_shape(3)
array_shape(3) = 1
allocate( array_avr_work3( array_shape(1) , array_shape(2) , array_shape(3) , array_shape(4) , array_shape(5) , array_shape(6) , array_shape(7) ) )
array_avr_work3 = 0
weight_sum = 0.0_DP
do i = 1, dim_size
array_avr_work3(:,:,1,:,:,:,:) = array_avr_work3(:,:,1,:,:,:,:) + array_avr_work(:,:,i,:,:,:,:) * weight3(i)
weight_sum = weight_sum + weight3(i)
end do
array_avr_work3 = array_avr_work3 / weight_sum
array_avr_work => array_avr_work3
end if
if ( space_average(4) ) then
dim_size = array_shape(4)
array_shape(4) = 1
allocate( array_avr_work4( array_shape(1) , array_shape(2) , array_shape(3) , array_shape(4) , array_shape(5) , array_shape(6) , array_shape(7) ) )
array_avr_work4 = 0
weight_sum = 0.0_DP
do i = 1, dim_size
array_avr_work4(:,:,:,1,:,:,:) = array_avr_work4(:,:,:,1,:,:,:) + array_avr_work(:,:,:,i,:,:,:) * weight4(i)
weight_sum = weight_sum + weight4(i)
end do
array_avr_work4 = array_avr_work4 / weight_sum
array_avr_work => array_avr_work4
end if
if ( space_average(5) ) then
dim_size = array_shape(5)
array_shape(5) = 1
allocate( array_avr_work5( array_shape(1) , array_shape(2) , array_shape(3) , array_shape(4) , array_shape(5) , array_shape(6) , array_shape(7) ) )
array_avr_work5 = 0
weight_sum = 0.0_DP
do i = 1, dim_size
array_avr_work5(:,:,:,:,1,:,:) = array_avr_work5(:,:,:,:,1,:,:) + array_avr_work(:,:,:,:,i,:,:) * weight5(i)
weight_sum = weight_sum + weight5(i)
end do
array_avr_work5 = array_avr_work5 / weight_sum
array_avr_work => array_avr_work5
end if
if ( space_average(6) ) then
dim_size = array_shape(6)
array_shape(6) = 1
allocate( array_avr_work6( array_shape(1) , array_shape(2) , array_shape(3) , array_shape(4) , array_shape(5) , array_shape(6) , array_shape(7) ) )
array_avr_work6 = 0
weight_sum = 0.0_DP
do i = 1, dim_size
array_avr_work6(:,:,:,:,:,1,:) = array_avr_work6(:,:,:,:,:,1,:) + array_avr_work(:,:,:,:,:,i,:) * weight6(i)
weight_sum = weight_sum + weight6(i)
end do
array_avr_work6 = array_avr_work6 / weight_sum
array_avr_work => array_avr_work6
end if
if ( space_average(7) ) then
dim_size = array_shape(7)
array_shape(7) = 1
allocate( array_avr_work7( array_shape(1) , array_shape(2) , array_shape(3) , array_shape(4) , array_shape(5) , array_shape(6) , array_shape(7) ) )
array_avr_work7 = 0
weight_sum = 0.0_DP
do i = 1, dim_size
array_avr_work7(:,:,:,:,:,:,1) = array_avr_work7(:,:,:,:,:,:,1) + array_avr_work(:,:,:,:,:,:,i) * weight7(i)
weight_sum = weight_sum + weight7(i)
end do
array_avr_work7 = array_avr_work7 / weight_sum
array_avr_work => array_avr_work7
end if
allocate( array_avr( array_shape(1) , array_shape(2) , array_shape(3) , array_shape(4) , array_shape(5) , array_shape(6) , array_shape(7) ) )
array_avr = array_avr_work
nullify( array_avr_work )
if ( associated( array_avr_work1 ) ) deallocate( array_avr_work1 )
if ( associated( array_avr_work2 ) ) deallocate( array_avr_work2 )
if ( associated( array_avr_work3 ) ) deallocate( array_avr_work3 )
if ( associated( array_avr_work4 ) ) deallocate( array_avr_work4 )
if ( associated( array_avr_work5 ) ) deallocate( array_avr_work5 )
if ( associated( array_avr_work6 ) ) deallocate( array_avr_work6 )
if ( associated( array_avr_work7 ) ) deallocate( array_avr_work7 )
end subroutine AverageReduceInt7
| Subroutine : | |||
| array(:) : | real, intent(in), target | ||
| space_average(1) : | logical, intent(in) | ||
| weight1(:) : | real(DP), intent(in) | ||
| array_avr(:) : | real, pointer
|
space_average で .true. に指定された次元に対して, array を平均化して array_avr に返します. 平均化には重み weight1 〜 weight7 が用いられます. array_avr の配列の次元そのものは減りません. その代わり, 平均化された次元の配列のサイズは 1 になります.
subroutine AverageReduceReal1( array, space_average, weight1, array_avr )
!
! space_average で .true. に指定された次元に対して,
! array を平均化して array_avr に返します.
! 平均化には重み weight1 〜 weight7 が用いられます.
! array_avr の配列の次元そのものは減りません. その代わり,
! 平均化された次元の配列のサイズは 1 になります.
!
implicit none
real, intent(in), target:: array(:)
logical, intent(in):: space_average(1)
real(DP), intent(in):: weight1(:)
real, pointer:: array_avr(:) ! (out)
real, pointer:: array_avr_work(:)
real, pointer:: array_avr_work1(:)
integer:: array_shape(1)
integer:: i, dim_size
real(DP):: weight_sum
continue
array_shape = shape( array )
array_avr_work => array
if ( space_average(1) ) then
dim_size = array_shape(1)
array_shape(1) = 1
allocate( array_avr_work1( array_shape(1) ) )
array_avr_work1 = 0.0
weight_sum = 0.0_DP
do i = 1, dim_size
array_avr_work1(1) = array_avr_work1(1) + array_avr_work(i) * weight1(i)
weight_sum = weight_sum + weight1(i)
end do
array_avr_work1 = array_avr_work1 / weight_sum
array_avr_work => array_avr_work1
end if
allocate( array_avr( array_shape(1) ) )
array_avr = array_avr_work
nullify( array_avr_work )
if ( associated( array_avr_work1 ) ) deallocate( array_avr_work1 )
end subroutine AverageReduceReal1
| Subroutine : | |||
| array(:,:) : | real, intent(in), target | ||
| space_average(2) : | logical, intent(in) | ||
| weight1(:) : | real(DP), intent(in) | ||
| weight2(:) : | real(DP), intent(in) | ||
| array_avr(:,:) : | real, pointer
|
space_average で .true. に指定された次元に対して, array を平均化して array_avr に返します. 平均化には重み weight1 〜 weight7 が用いられます. array_avr の配列の次元そのものは減りません. その代わり, 平均化された次元の配列のサイズは 1 になります.
subroutine AverageReduceReal2( array, space_average, weight1, weight2, array_avr )
!
! space_average で .true. に指定された次元に対して,
! array を平均化して array_avr に返します.
! 平均化には重み weight1 〜 weight7 が用いられます.
! array_avr の配列の次元そのものは減りません. その代わり,
! 平均化された次元の配列のサイズは 1 になります.
!
implicit none
real, intent(in), target:: array(:,:)
logical, intent(in):: space_average(2)
real(DP), intent(in):: weight1(:)
real(DP), intent(in):: weight2(:)
real, pointer:: array_avr(:,:) ! (out)
real, pointer:: array_avr_work(:,:)
real, pointer:: array_avr_work1(:,:)
real, pointer:: array_avr_work2(:,:)
integer:: array_shape(2)
integer:: i, dim_size
real(DP):: weight_sum
continue
array_shape = shape( array )
array_avr_work => array
if ( space_average(1) ) then
dim_size = array_shape(1)
array_shape(1) = 1
allocate( array_avr_work1( array_shape(1) , array_shape(2) ) )
array_avr_work1 = 0.0
weight_sum = 0.0_DP
do i = 1, dim_size
array_avr_work1(1,:) = array_avr_work1(1,:) + array_avr_work(i,:) * weight1(i)
weight_sum = weight_sum + weight1(i)
end do
array_avr_work1 = array_avr_work1 / weight_sum
array_avr_work => array_avr_work1
end if
if ( space_average(2) ) then
dim_size = array_shape(2)
array_shape(2) = 1
allocate( array_avr_work2( array_shape(1) , array_shape(2) ) )
array_avr_work2 = 0.0
weight_sum = 0.0_DP
do i = 1, dim_size
array_avr_work2(:,1) = array_avr_work2(:,1) + array_avr_work(:,i) * weight2(i)
weight_sum = weight_sum + weight2(i)
end do
array_avr_work2 = array_avr_work2 / weight_sum
array_avr_work => array_avr_work2
end if
allocate( array_avr( array_shape(1) , array_shape(2) ) )
array_avr = array_avr_work
nullify( array_avr_work )
if ( associated( array_avr_work1 ) ) deallocate( array_avr_work1 )
if ( associated( array_avr_work2 ) ) deallocate( array_avr_work2 )
end subroutine AverageReduceReal2
| Subroutine : | |||
| array(:,:,:) : | real, intent(in), target | ||
| space_average(3) : | logical, intent(in) | ||
| weight1(:) : | real(DP), intent(in) | ||
| weight2(:) : | real(DP), intent(in) | ||
| weight3(:) : | real(DP), intent(in) | ||
| array_avr(:,:,:) : | real, pointer
|
space_average で .true. に指定された次元に対して, array を平均化して array_avr に返します. 平均化には重み weight1 〜 weight7 が用いられます. array_avr の配列の次元そのものは減りません. その代わり, 平均化された次元の配列のサイズは 1 になります.
subroutine AverageReduceReal3( array, space_average, weight1, weight2, weight3, array_avr )
!
! space_average で .true. に指定された次元に対して,
! array を平均化して array_avr に返します.
! 平均化には重み weight1 〜 weight7 が用いられます.
! array_avr の配列の次元そのものは減りません. その代わり,
! 平均化された次元の配列のサイズは 1 になります.
!
implicit none
real, intent(in), target:: array(:,:,:)
logical, intent(in):: space_average(3)
real(DP), intent(in):: weight1(:)
real(DP), intent(in):: weight2(:)
real(DP), intent(in):: weight3(:)
real, pointer:: array_avr(:,:,:) ! (out)
real, pointer:: array_avr_work(:,:,:)
real, pointer:: array_avr_work1(:,:,:)
real, pointer:: array_avr_work2(:,:,:)
real, pointer:: array_avr_work3(:,:,:)
integer:: array_shape(3)
integer:: i, dim_size
real(DP):: weight_sum
continue
array_shape = shape( array )
array_avr_work => array
if ( space_average(1) ) then
dim_size = array_shape(1)
array_shape(1) = 1
allocate( array_avr_work1( array_shape(1) , array_shape(2) , array_shape(3) ) )
array_avr_work1 = 0.0
weight_sum = 0.0_DP
do i = 1, dim_size
array_avr_work1(1,:,:) = array_avr_work1(1,:,:) + array_avr_work(i,:,:) * weight1(i)
weight_sum = weight_sum + weight1(i)
end do
array_avr_work1 = array_avr_work1 / weight_sum
array_avr_work => array_avr_work1
end if
if ( space_average(2) ) then
dim_size = array_shape(2)
array_shape(2) = 1
allocate( array_avr_work2( array_shape(1) , array_shape(2) , array_shape(3) ) )
array_avr_work2 = 0.0
weight_sum = 0.0_DP
do i = 1, dim_size
array_avr_work2(:,1,:) = array_avr_work2(:,1,:) + array_avr_work(:,i,:) * weight2(i)
weight_sum = weight_sum + weight2(i)
end do
array_avr_work2 = array_avr_work2 / weight_sum
array_avr_work => array_avr_work2
end if
if ( space_average(3) ) then
dim_size = array_shape(3)
array_shape(3) = 1
allocate( array_avr_work3( array_shape(1) , array_shape(2) , array_shape(3) ) )
array_avr_work3 = 0.0
weight_sum = 0.0_DP
do i = 1, dim_size
array_avr_work3(:,:,1) = array_avr_work3(:,:,1) + array_avr_work(:,:,i) * weight3(i)
weight_sum = weight_sum + weight3(i)
end do
array_avr_work3 = array_avr_work3 / weight_sum
array_avr_work => array_avr_work3
end if
allocate( array_avr( array_shape(1) , array_shape(2) , array_shape(3) ) )
array_avr = array_avr_work
nullify( array_avr_work )
if ( associated( array_avr_work1 ) ) deallocate( array_avr_work1 )
if ( associated( array_avr_work2 ) ) deallocate( array_avr_work2 )
if ( associated( array_avr_work3 ) ) deallocate( array_avr_work3 )
end subroutine AverageReduceReal3
| Subroutine : | |||
| array(:,:,:,:) : | real, intent(in), target | ||
| space_average(4) : | logical, intent(in) | ||
| weight1(:) : | real(DP), intent(in) | ||
| weight2(:) : | real(DP), intent(in) | ||
| weight3(:) : | real(DP), intent(in) | ||
| weight4(:) : | real(DP), intent(in) | ||
| array_avr(:,:,:,:) : | real, pointer
|
space_average で .true. に指定された次元に対して, array を平均化して array_avr に返します. 平均化には重み weight1 〜 weight7 が用いられます. array_avr の配列の次元そのものは減りません. その代わり, 平均化された次元の配列のサイズは 1 になります.
subroutine AverageReduceReal4( array, space_average, weight1, weight2, weight3, weight4, array_avr )
!
! space_average で .true. に指定された次元に対して,
! array を平均化して array_avr に返します.
! 平均化には重み weight1 〜 weight7 が用いられます.
! array_avr の配列の次元そのものは減りません. その代わり,
! 平均化された次元の配列のサイズは 1 になります.
!
implicit none
real, intent(in), target:: array(:,:,:,:)
logical, intent(in):: space_average(4)
real(DP), intent(in):: weight1(:)
real(DP), intent(in):: weight2(:)
real(DP), intent(in):: weight3(:)
real(DP), intent(in):: weight4(:)
real, pointer:: array_avr(:,:,:,:) ! (out)
real, pointer:: array_avr_work(:,:,:,:)
real, pointer:: array_avr_work1(:,:,:,:)
real, pointer:: array_avr_work2(:,:,:,:)
real, pointer:: array_avr_work3(:,:,:,:)
real, pointer:: array_avr_work4(:,:,:,:)
integer:: array_shape(4)
integer:: i, dim_size
real(DP):: weight_sum
continue
array_shape = shape( array )
array_avr_work => array
if ( space_average(1) ) then
dim_size = array_shape(1)
array_shape(1) = 1
allocate( array_avr_work1( array_shape(1) , array_shape(2) , array_shape(3) , array_shape(4) ) )
array_avr_work1 = 0.0
weight_sum = 0.0_DP
do i = 1, dim_size
array_avr_work1(1,:,:,:) = array_avr_work1(1,:,:,:) + array_avr_work(i,:,:,:) * weight1(i)
weight_sum = weight_sum + weight1(i)
end do
array_avr_work1 = array_avr_work1 / weight_sum
array_avr_work => array_avr_work1
end if
if ( space_average(2) ) then
dim_size = array_shape(2)
array_shape(2) = 1
allocate( array_avr_work2( array_shape(1) , array_shape(2) , array_shape(3) , array_shape(4) ) )
array_avr_work2 = 0.0
weight_sum = 0.0_DP
do i = 1, dim_size
array_avr_work2(:,1,:,:) = array_avr_work2(:,1,:,:) + array_avr_work(:,i,:,:) * weight2(i)
weight_sum = weight_sum + weight2(i)
end do
array_avr_work2 = array_avr_work2 / weight_sum
array_avr_work => array_avr_work2
end if
if ( space_average(3) ) then
dim_size = array_shape(3)
array_shape(3) = 1
allocate( array_avr_work3( array_shape(1) , array_shape(2) , array_shape(3) , array_shape(4) ) )
array_avr_work3 = 0.0
weight_sum = 0.0_DP
do i = 1, dim_size
array_avr_work3(:,:,1,:) = array_avr_work3(:,:,1,:) + array_avr_work(:,:,i,:) * weight3(i)
weight_sum = weight_sum + weight3(i)
end do
array_avr_work3 = array_avr_work3 / weight_sum
array_avr_work => array_avr_work3
end if
if ( space_average(4) ) then
dim_size = array_shape(4)
array_shape(4) = 1
allocate( array_avr_work4( array_shape(1) , array_shape(2) , array_shape(3) , array_shape(4) ) )
array_avr_work4 = 0.0
weight_sum = 0.0_DP
do i = 1, dim_size
array_avr_work4(:,:,:,1) = array_avr_work4(:,:,:,1) + array_avr_work(:,:,:,i) * weight4(i)
weight_sum = weight_sum + weight4(i)
end do
array_avr_work4 = array_avr_work4 / weight_sum
array_avr_work => array_avr_work4
end if
allocate( array_avr( array_shape(1) , array_shape(2) , array_shape(3) , array_shape(4) ) )
array_avr = array_avr_work
nullify( array_avr_work )
if ( associated( array_avr_work1 ) ) deallocate( array_avr_work1 )
if ( associated( array_avr_work2 ) ) deallocate( array_avr_work2 )
if ( associated( array_avr_work3 ) ) deallocate( array_avr_work3 )
if ( associated( array_avr_work4 ) ) deallocate( array_avr_work4 )
end subroutine AverageReduceReal4
| Subroutine : | |||
| array(:,:,:,:,:) : | real, intent(in), target | ||
| space_average(5) : | logical, intent(in) | ||
| weight1(:) : | real(DP), intent(in) | ||
| weight2(:) : | real(DP), intent(in) | ||
| weight3(:) : | real(DP), intent(in) | ||
| weight4(:) : | real(DP), intent(in) | ||
| weight5(:) : | real(DP), intent(in) | ||
| array_avr(:,:,:,:,:) : | real, pointer
|
space_average で .true. に指定された次元に対して, array を平均化して array_avr に返します. 平均化には重み weight1 〜 weight7 が用いられます. array_avr の配列の次元そのものは減りません. その代わり, 平均化された次元の配列のサイズは 1 になります.
subroutine AverageReduceReal5( array, space_average, weight1, weight2, weight3, weight4, weight5, array_avr )
!
! space_average で .true. に指定された次元に対して,
! array を平均化して array_avr に返します.
! 平均化には重み weight1 〜 weight7 が用いられます.
! array_avr の配列の次元そのものは減りません. その代わり,
! 平均化された次元の配列のサイズは 1 になります.
!
implicit none
real, intent(in), target:: array(:,:,:,:,:)
logical, intent(in):: space_average(5)
real(DP), intent(in):: weight1(:)
real(DP), intent(in):: weight2(:)
real(DP), intent(in):: weight3(:)
real(DP), intent(in):: weight4(:)
real(DP), intent(in):: weight5(:)
real, pointer:: array_avr(:,:,:,:,:) ! (out)
real, pointer:: array_avr_work(:,:,:,:,:)
real, pointer:: array_avr_work1(:,:,:,:,:)
real, pointer:: array_avr_work2(:,:,:,:,:)
real, pointer:: array_avr_work3(:,:,:,:,:)
real, pointer:: array_avr_work4(:,:,:,:,:)
real, pointer:: array_avr_work5(:,:,:,:,:)
integer:: array_shape(5)
integer:: i, dim_size
real(DP):: weight_sum
continue
array_shape = shape( array )
array_avr_work => array
if ( space_average(1) ) then
dim_size = array_shape(1)
array_shape(1) = 1
allocate( array_avr_work1( array_shape(1) , array_shape(2) , array_shape(3) , array_shape(4) , array_shape(5) ) )
array_avr_work1 = 0.0
weight_sum = 0.0_DP
do i = 1, dim_size
array_avr_work1(1,:,:,:,:) = array_avr_work1(1,:,:,:,:) + array_avr_work(i,:,:,:,:) * weight1(i)
weight_sum = weight_sum + weight1(i)
end do
array_avr_work1 = array_avr_work1 / weight_sum
array_avr_work => array_avr_work1
end if
if ( space_average(2) ) then
dim_size = array_shape(2)
array_shape(2) = 1
allocate( array_avr_work2( array_shape(1) , array_shape(2) , array_shape(3) , array_shape(4) , array_shape(5) ) )
array_avr_work2 = 0.0
weight_sum = 0.0_DP
do i = 1, dim_size
array_avr_work2(:,1,:,:,:) = array_avr_work2(:,1,:,:,:) + array_avr_work(:,i,:,:,:) * weight2(i)
weight_sum = weight_sum + weight2(i)
end do
array_avr_work2 = array_avr_work2 / weight_sum
array_avr_work => array_avr_work2
end if
if ( space_average(3) ) then
dim_size = array_shape(3)
array_shape(3) = 1
allocate( array_avr_work3( array_shape(1) , array_shape(2) , array_shape(3) , array_shape(4) , array_shape(5) ) )
array_avr_work3 = 0.0
weight_sum = 0.0_DP
do i = 1, dim_size
array_avr_work3(:,:,1,:,:) = array_avr_work3(:,:,1,:,:) + array_avr_work(:,:,i,:,:) * weight3(i)
weight_sum = weight_sum + weight3(i)
end do
array_avr_work3 = array_avr_work3 / weight_sum
array_avr_work => array_avr_work3
end if
if ( space_average(4) ) then
dim_size = array_shape(4)
array_shape(4) = 1
allocate( array_avr_work4( array_shape(1) , array_shape(2) , array_shape(3) , array_shape(4) , array_shape(5) ) )
array_avr_work4 = 0.0
weight_sum = 0.0_DP
do i = 1, dim_size
array_avr_work4(:,:,:,1,:) = array_avr_work4(:,:,:,1,:) + array_avr_work(:,:,:,i,:) * weight4(i)
weight_sum = weight_sum + weight4(i)
end do
array_avr_work4 = array_avr_work4 / weight_sum
array_avr_work => array_avr_work4
end if
if ( space_average(5) ) then
dim_size = array_shape(5)
array_shape(5) = 1
allocate( array_avr_work5( array_shape(1) , array_shape(2) , array_shape(3) , array_shape(4) , array_shape(5) ) )
array_avr_work5 = 0.0
weight_sum = 0.0_DP
do i = 1, dim_size
array_avr_work5(:,:,:,:,1) = array_avr_work5(:,:,:,:,1) + array_avr_work(:,:,:,:,i) * weight5(i)
weight_sum = weight_sum + weight5(i)
end do
array_avr_work5 = array_avr_work5 / weight_sum
array_avr_work => array_avr_work5
end if
allocate( array_avr( array_shape(1) , array_shape(2) , array_shape(3) , array_shape(4) , array_shape(5) ) )
array_avr = array_avr_work
nullify( array_avr_work )
if ( associated( array_avr_work1 ) ) deallocate( array_avr_work1 )
if ( associated( array_avr_work2 ) ) deallocate( array_avr_work2 )
if ( associated( array_avr_work3 ) ) deallocate( array_avr_work3 )
if ( associated( array_avr_work4 ) ) deallocate( array_avr_work4 )
if ( associated( array_avr_work5 ) ) deallocate( array_avr_work5 )
end subroutine AverageReduceReal5
| Subroutine : | |||
| array(:,:,:,:,:,:) : | real, intent(in), target | ||
| space_average(6) : | logical, intent(in) | ||
| weight1(:) : | real(DP), intent(in) | ||
| weight2(:) : | real(DP), intent(in) | ||
| weight3(:) : | real(DP), intent(in) | ||
| weight4(:) : | real(DP), intent(in) | ||
| weight5(:) : | real(DP), intent(in) | ||
| weight6(:) : | real(DP), intent(in) | ||
| array_avr(:,:,:,:,:,:) : | real, pointer
|
space_average で .true. に指定された次元に対して, array を平均化して array_avr に返します. 平均化には重み weight1 〜 weight7 が用いられます. array_avr の配列の次元そのものは減りません. その代わり, 平均化された次元の配列のサイズは 1 になります.
subroutine AverageReduceReal6( array, space_average, weight1, weight2, weight3, weight4, weight5, weight6, array_avr )
!
! space_average で .true. に指定された次元に対して,
! array を平均化して array_avr に返します.
! 平均化には重み weight1 〜 weight7 が用いられます.
! array_avr の配列の次元そのものは減りません. その代わり,
! 平均化された次元の配列のサイズは 1 になります.
!
implicit none
real, intent(in), target:: array(:,:,:,:,:,:)
logical, intent(in):: space_average(6)
real(DP), intent(in):: weight1(:)
real(DP), intent(in):: weight2(:)
real(DP), intent(in):: weight3(:)
real(DP), intent(in):: weight4(:)
real(DP), intent(in):: weight5(:)
real(DP), intent(in):: weight6(:)
real, pointer:: array_avr(:,:,:,:,:,:) ! (out)
real, pointer:: array_avr_work(:,:,:,:,:,:)
real, pointer:: array_avr_work1(:,:,:,:,:,:)
real, pointer:: array_avr_work2(:,:,:,:,:,:)
real, pointer:: array_avr_work3(:,:,:,:,:,:)
real, pointer:: array_avr_work4(:,:,:,:,:,:)
real, pointer:: array_avr_work5(:,:,:,:,:,:)
real, pointer:: array_avr_work6(:,:,:,:,:,:)
integer:: array_shape(6)
integer:: i, dim_size
real(DP):: weight_sum
continue
array_shape = shape( array )
array_avr_work => array
if ( space_average(1) ) then
dim_size = array_shape(1)
array_shape(1) = 1
allocate( array_avr_work1( array_shape(1) , array_shape(2) , array_shape(3) , array_shape(4) , array_shape(5) , array_shape(6) ) )
array_avr_work1 = 0.0
weight_sum = 0.0_DP
do i = 1, dim_size
array_avr_work1(1,:,:,:,:,:) = array_avr_work1(1,:,:,:,:,:) + array_avr_work(i,:,:,:,:,:) * weight1(i)
weight_sum = weight_sum + weight1(i)
end do
array_avr_work1 = array_avr_work1 / weight_sum
array_avr_work => array_avr_work1
end if
if ( space_average(2) ) then
dim_size = array_shape(2)
array_shape(2) = 1
allocate( array_avr_work2( array_shape(1) , array_shape(2) , array_shape(3) , array_shape(4) , array_shape(5) , array_shape(6) ) )
array_avr_work2 = 0.0
weight_sum = 0.0_DP
do i = 1, dim_size
array_avr_work2(:,1,:,:,:,:) = array_avr_work2(:,1,:,:,:,:) + array_avr_work(:,i,:,:,:,:) * weight2(i)
weight_sum = weight_sum + weight2(i)
end do
array_avr_work2 = array_avr_work2 / weight_sum
array_avr_work => array_avr_work2
end if
if ( space_average(3) ) then
dim_size = array_shape(3)
array_shape(3) = 1
allocate( array_avr_work3( array_shape(1) , array_shape(2) , array_shape(3) , array_shape(4) , array_shape(5) , array_shape(6) ) )
array_avr_work3 = 0.0
weight_sum = 0.0_DP
do i = 1, dim_size
array_avr_work3(:,:,1,:,:,:) = array_avr_work3(:,:,1,:,:,:) + array_avr_work(:,:,i,:,:,:) * weight3(i)
weight_sum = weight_sum + weight3(i)
end do
array_avr_work3 = array_avr_work3 / weight_sum
array_avr_work => array_avr_work3
end if
if ( space_average(4) ) then
dim_size = array_shape(4)
array_shape(4) = 1
allocate( array_avr_work4( array_shape(1) , array_shape(2) , array_shape(3) , array_shape(4) , array_shape(5) , array_shape(6) ) )
array_avr_work4 = 0.0
weight_sum = 0.0_DP
do i = 1, dim_size
array_avr_work4(:,:,:,1,:,:) = array_avr_work4(:,:,:,1,:,:) + array_avr_work(:,:,:,i,:,:) * weight4(i)
weight_sum = weight_sum + weight4(i)
end do
array_avr_work4 = array_avr_work4 / weight_sum
array_avr_work => array_avr_work4
end if
if ( space_average(5) ) then
dim_size = array_shape(5)
array_shape(5) = 1
allocate( array_avr_work5( array_shape(1) , array_shape(2) , array_shape(3) , array_shape(4) , array_shape(5) , array_shape(6) ) )
array_avr_work5 = 0.0
weight_sum = 0.0_DP
do i = 1, dim_size
array_avr_work5(:,:,:,:,1,:) = array_avr_work5(:,:,:,:,1,:) + array_avr_work(:,:,:,:,i,:) * weight5(i)
weight_sum = weight_sum + weight5(i)
end do
array_avr_work5 = array_avr_work5 / weight_sum
array_avr_work => array_avr_work5
end if
if ( space_average(6) ) then
dim_size = array_shape(6)
array_shape(6) = 1
allocate( array_avr_work6( array_shape(1) , array_shape(2) , array_shape(3) , array_shape(4) , array_shape(5) , array_shape(6) ) )
array_avr_work6 = 0.0
weight_sum = 0.0_DP
do i = 1, dim_size
array_avr_work6(:,:,:,:,:,1) = array_avr_work6(:,:,:,:,:,1) + array_avr_work(:,:,:,:,:,i) * weight6(i)
weight_sum = weight_sum + weight6(i)
end do
array_avr_work6 = array_avr_work6 / weight_sum
array_avr_work => array_avr_work6
end if
allocate( array_avr( array_shape(1) , array_shape(2) , array_shape(3) , array_shape(4) , array_shape(5) , array_shape(6) ) )
array_avr = array_avr_work
nullify( array_avr_work )
if ( associated( array_avr_work1 ) ) deallocate( array_avr_work1 )
if ( associated( array_avr_work2 ) ) deallocate( array_avr_work2 )
if ( associated( array_avr_work3 ) ) deallocate( array_avr_work3 )
if ( associated( array_avr_work4 ) ) deallocate( array_avr_work4 )
if ( associated( array_avr_work5 ) ) deallocate( array_avr_work5 )
if ( associated( array_avr_work6 ) ) deallocate( array_avr_work6 )
end subroutine AverageReduceReal6
| Subroutine : | |||
| array(:,:,:,:,:,:,:) : | real, intent(in), target | ||
| space_average(7) : | logical, intent(in) | ||
| weight1(:) : | real(DP), intent(in) | ||
| weight2(:) : | real(DP), intent(in) | ||
| weight3(:) : | real(DP), intent(in) | ||
| weight4(:) : | real(DP), intent(in) | ||
| weight5(:) : | real(DP), intent(in) | ||
| weight6(:) : | real(DP), intent(in) | ||
| weight7(:) : | real(DP), intent(in) | ||
| array_avr(:,:,:,:,:,:,:) : | real, pointer
|
space_average で .true. に指定された次元に対して, array を平均化して array_avr に返します. 平均化には重み weight1 〜 weight7 が用いられます. array_avr の配列の次元そのものは減りません. その代わり, 平均化された次元の配列のサイズは 1 になります.
subroutine AverageReduceReal7( array, space_average, weight1, weight2, weight3, weight4, weight5, weight6, weight7, array_avr )
!
! space_average で .true. に指定された次元に対して,
! array を平均化して array_avr に返します.
! 平均化には重み weight1 〜 weight7 が用いられます.
! array_avr の配列の次元そのものは減りません. その代わり,
! 平均化された次元の配列のサイズは 1 になります.
!
implicit none
real, intent(in), target:: array(:,:,:,:,:,:,:)
logical, intent(in):: space_average(7)
real(DP), intent(in):: weight1(:)
real(DP), intent(in):: weight2(:)
real(DP), intent(in):: weight3(:)
real(DP), intent(in):: weight4(:)
real(DP), intent(in):: weight5(:)
real(DP), intent(in):: weight6(:)
real(DP), intent(in):: weight7(:)
real, pointer:: array_avr(:,:,:,:,:,:,:) ! (out)
real, pointer:: array_avr_work(:,:,:,:,:,:,:)
real, pointer:: array_avr_work1(:,:,:,:,:,:,:)
real, pointer:: array_avr_work2(:,:,:,:,:,:,:)
real, pointer:: array_avr_work3(:,:,:,:,:,:,:)
real, pointer:: array_avr_work4(:,:,:,:,:,:,:)
real, pointer:: array_avr_work5(:,:,:,:,:,:,:)
real, pointer:: array_avr_work6(:,:,:,:,:,:,:)
real, pointer:: array_avr_work7(:,:,:,:,:,:,:)
integer:: array_shape(7)
integer:: i, dim_size
real(DP):: weight_sum
continue
array_shape = shape( array )
array_avr_work => array
if ( space_average(1) ) then
dim_size = array_shape(1)
array_shape(1) = 1
allocate( array_avr_work1( array_shape(1) , array_shape(2) , array_shape(3) , array_shape(4) , array_shape(5) , array_shape(6) , array_shape(7) ) )
array_avr_work1 = 0.0
weight_sum = 0.0_DP
do i = 1, dim_size
array_avr_work1(1,:,:,:,:,:,:) = array_avr_work1(1,:,:,:,:,:,:) + array_avr_work(i,:,:,:,:,:,:) * weight1(i)
weight_sum = weight_sum + weight1(i)
end do
array_avr_work1 = array_avr_work1 / weight_sum
array_avr_work => array_avr_work1
end if
if ( space_average(2) ) then
dim_size = array_shape(2)
array_shape(2) = 1
allocate( array_avr_work2( array_shape(1) , array_shape(2) , array_shape(3) , array_shape(4) , array_shape(5) , array_shape(6) , array_shape(7) ) )
array_avr_work2 = 0.0
weight_sum = 0.0_DP
do i = 1, dim_size
array_avr_work2(:,1,:,:,:,:,:) = array_avr_work2(:,1,:,:,:,:,:) + array_avr_work(:,i,:,:,:,:,:) * weight2(i)
weight_sum = weight_sum + weight2(i)
end do
array_avr_work2 = array_avr_work2 / weight_sum
array_avr_work => array_avr_work2
end if
if ( space_average(3) ) then
dim_size = array_shape(3)
array_shape(3) = 1
allocate( array_avr_work3( array_shape(1) , array_shape(2) , array_shape(3) , array_shape(4) , array_shape(5) , array_shape(6) , array_shape(7) ) )
array_avr_work3 = 0.0
weight_sum = 0.0_DP
do i = 1, dim_size
array_avr_work3(:,:,1,:,:,:,:) = array_avr_work3(:,:,1,:,:,:,:) + array_avr_work(:,:,i,:,:,:,:) * weight3(i)
weight_sum = weight_sum + weight3(i)
end do
array_avr_work3 = array_avr_work3 / weight_sum
array_avr_work => array_avr_work3
end if
if ( space_average(4) ) then
dim_size = array_shape(4)
array_shape(4) = 1
allocate( array_avr_work4( array_shape(1) , array_shape(2) , array_shape(3) , array_shape(4) , array_shape(5) , array_shape(6) , array_shape(7) ) )
array_avr_work4 = 0.0
weight_sum = 0.0_DP
do i = 1, dim_size
array_avr_work4(:,:,:,1,:,:,:) = array_avr_work4(:,:,:,1,:,:,:) + array_avr_work(:,:,:,i,:,:,:) * weight4(i)
weight_sum = weight_sum + weight4(i)
end do
array_avr_work4 = array_avr_work4 / weight_sum
array_avr_work => array_avr_work4
end if
if ( space_average(5) ) then
dim_size = array_shape(5)
array_shape(5) = 1
allocate( array_avr_work5( array_shape(1) , array_shape(2) , array_shape(3) , array_shape(4) , array_shape(5) , array_shape(6) , array_shape(7) ) )
array_avr_work5 = 0.0
weight_sum = 0.0_DP
do i = 1, dim_size
array_avr_work5(:,:,:,:,1,:,:) = array_avr_work5(:,:,:,:,1,:,:) + array_avr_work(:,:,:,:,i,:,:) * weight5(i)
weight_sum = weight_sum + weight5(i)
end do
array_avr_work5 = array_avr_work5 / weight_sum
array_avr_work => array_avr_work5
end if
if ( space_average(6) ) then
dim_size = array_shape(6)
array_shape(6) = 1
allocate( array_avr_work6( array_shape(1) , array_shape(2) , array_shape(3) , array_shape(4) , array_shape(5) , array_shape(6) , array_shape(7) ) )
array_avr_work6 = 0.0
weight_sum = 0.0_DP
do i = 1, dim_size
array_avr_work6(:,:,:,:,:,1,:) = array_avr_work6(:,:,:,:,:,1,:) + array_avr_work(:,:,:,:,:,i,:) * weight6(i)
weight_sum = weight_sum + weight6(i)
end do
array_avr_work6 = array_avr_work6 / weight_sum
array_avr_work => array_avr_work6
end if
if ( space_average(7) ) then
dim_size = array_shape(7)
array_shape(7) = 1
allocate( array_avr_work7( array_shape(1) , array_shape(2) , array_shape(3) , array_shape(4) , array_shape(5) , array_shape(6) , array_shape(7) ) )
array_avr_work7 = 0.0
weight_sum = 0.0_DP
do i = 1, dim_size
array_avr_work7(:,:,:,:,:,:,1) = array_avr_work7(:,:,:,:,:,:,1) + array_avr_work(:,:,:,:,:,:,i) * weight7(i)
weight_sum = weight_sum + weight7(i)
end do
array_avr_work7 = array_avr_work7 / weight_sum
array_avr_work => array_avr_work7
end if
allocate( array_avr( array_shape(1) , array_shape(2) , array_shape(3) , array_shape(4) , array_shape(5) , array_shape(6) , array_shape(7) ) )
array_avr = array_avr_work
nullify( array_avr_work )
if ( associated( array_avr_work1 ) ) deallocate( array_avr_work1 )
if ( associated( array_avr_work2 ) ) deallocate( array_avr_work2 )
if ( associated( array_avr_work3 ) ) deallocate( array_avr_work3 )
if ( associated( array_avr_work4 ) ) deallocate( array_avr_work4 )
if ( associated( array_avr_work5 ) ) deallocate( array_avr_work5 )
if ( associated( array_avr_work6 ) ) deallocate( array_avr_work6 )
if ( associated( array_avr_work7 ) ) deallocate( array_avr_work7 )
end subroutine AverageReduceReal7