Class gtool_historyauto_internal
In: gtool/gtool_historyauto/gtool_historyauto_internal.f90

gtool_historyauto 内で呼ばれる内部向け定数, 変数, 手続き群

Constants, variable, procedures used in "gtool_historyauto" internally

Note that Japanese and English are described in parallel.

Methods

AXES_WEIGHT   AverageReduce   AverageReduce   AverageReduce   AverageReduce   AverageReduce   AverageReduce   AverageReduce   AverageReduce   AverageReduce   AverageReduce   AverageReduce   AverageReduce   AverageReduce   AverageReduce   AverageReduce   AverageReduce   AverageReduce   AverageReduce   AverageReduce   AverageReduce   AverageReduce   AverageReduceDouble1   AverageReduceDouble2   AverageReduceDouble3   AverageReduceDouble4   AverageReduceDouble5   AverageReduceDouble6   AverageReduceDouble7   AverageReduceInt1   AverageReduceInt2   AverageReduceInt3   AverageReduceInt4   AverageReduceInt5   AverageReduceInt6   AverageReduceInt7   AverageReduceReal1   AverageReduceReal2   AverageReduceReal3   AverageReduceReal4   AverageReduceReal5   AverageReduceReal6   AverageReduceReal7   GT_HISTORY_AXIS_DATA   GT_HISTORY_MULTI   HstFileCreate   HstVarsOutputCheck   MAX_DIMS_DEPENDED_BY_VAR   MAX_VARS   SLICE_INFO   SPACE_AVR_INFO   all_output_save   cal_save   checked_tstep_varnum   checked_tstepnum   close_timing_vars   conventions_save   create_timing_vars   data_axes   data_axes_whole   data_weights   flag_allvarfixed   flag_output_prev_vars   gt_version_save   gthst_axes   gthst_history_vars   gthst_vars   gthst_weights   gthstnml   histaddvar_vars   initialized   institution_save   interval_time_vars   interval_unitsym_vars   max_remainder_range   newfile_createtime_vars   newfile_inttime_vars   numdims   numvars   numwgts   origin_time_vars   output_timing_avr_vars   output_timing_vars   output_valid_vars   prev_outtime_vars   rank_save   renew_timing_vars   save_mpi_gather   save_mpi_split   save_tstepnum   saved_time   saved_tstep   slice_vars   source_save   space_avr_vars   sub_sname   tavr_vars   terminus_time_vars   time_unit_bycreate   time_unit_suffix   title_save   varname_vars   version   weight_vars   wgtsuf   zero_time  

Included Modules

gtool_history gtool_history_nmlinfo netcdf_f77 dc_calendar dc_date_types dc_types dc_trace dc_error dc_date dc_string dc_message gtool_history_nmlinfo_generic

Public Instance methods

AXES_WEIGHT
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

AverageReduce( array, space_average, weight1, array_avr )
Subroutine :
array(:) :integer, intent(in), target
space_average(1) :logical, intent(in)
weight1(:) :real(DP), intent(in)
array_avr(:) :integer, pointer
: (out)

space_average で .true. に指定された次元に対して, array を平均化して array_avr に返します. 平均化には重み weight1 〜 weight7 が用いられます. array_avr の配列の次元そのものは減りません. その代わり, 平均化された次元の配列のサイズは 1 になります.

Alias for AverageReduceInt1

AverageReduce( array, space_average, weight1, array_avr )
Subroutine :
array(:) :real(DP), intent(in), target
space_average(1) :logical, intent(in)
weight1(:) :real(DP), intent(in)
array_avr(:) :real(DP), pointer
: (out)

space_average で .true. に指定された次元に対して, array を平均化して array_avr に返します. 平均化には重み weight1 〜 weight7 が用いられます. array_avr の配列の次元そのものは減りません. その代わり, 平均化された次元の配列のサイズは 1 になります.

Alias for AverageReduceDouble1

AverageReduce( array, space_average, weight1, array_avr )
Subroutine :
array(:) :real, intent(in), target
space_average(1) :logical, intent(in)
weight1(:) :real(DP), intent(in)
array_avr(:) :real, pointer
: (out)

space_average で .true. に指定された次元に対して, array を平均化して array_avr に返します. 平均化には重み weight1 〜 weight7 が用いられます. array_avr の配列の次元そのものは減りません. その代わり, 平均化された次元の配列のサイズは 1 になります.

Alias for AverageReduceReal1

AverageReduce( array, space_average, weight1, weight2, array_avr )
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
: (out)

space_average で .true. に指定された次元に対して, array を平均化して array_avr に返します. 平均化には重み weight1 〜 weight7 が用いられます. array_avr の配列の次元そのものは減りません. その代わり, 平均化された次元の配列のサイズは 1 になります.

Alias for AverageReduceInt2

AverageReduce( array, space_average, weight1, weight2, array_avr )
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
: (out)

space_average で .true. に指定された次元に対して, array を平均化して array_avr に返します. 平均化には重み weight1 〜 weight7 が用いられます. array_avr の配列の次元そのものは減りません. その代わり, 平均化された次元の配列のサイズは 1 になります.

Alias for AverageReduceDouble2

AverageReduce( array, space_average, weight1, weight2, array_avr )
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
: (out)

space_average で .true. に指定された次元に対して, array を平均化して array_avr に返します. 平均化には重み weight1 〜 weight7 が用いられます. array_avr の配列の次元そのものは減りません. その代わり, 平均化された次元の配列のサイズは 1 になります.

Alias for AverageReduceReal2

AverageReduce( array, space_average, weight1, weight2, weight3, array_avr )
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
: (out)

space_average で .true. に指定された次元に対して, array を平均化して array_avr に返します. 平均化には重み weight1 〜 weight7 が用いられます. array_avr の配列の次元そのものは減りません. その代わり, 平均化された次元の配列のサイズは 1 になります.

Alias for AverageReduceInt3

AverageReduce( array, space_average, weight1, weight2, weight3, array_avr )
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
: (out)

space_average で .true. に指定された次元に対して, array を平均化して array_avr に返します. 平均化には重み weight1 〜 weight7 が用いられます. array_avr の配列の次元そのものは減りません. その代わり, 平均化された次元の配列のサイズは 1 になります.

Alias for AverageReduceDouble3

AverageReduce( array, space_average, weight1, weight2, weight3, array_avr )
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
: (out)

space_average で .true. に指定された次元に対して, array を平均化して array_avr に返します. 平均化には重み weight1 〜 weight7 が用いられます. array_avr の配列の次元そのものは減りません. その代わり, 平均化された次元の配列のサイズは 1 になります.

Alias for AverageReduceReal3

AverageReduce( array, space_average, weight1, weight2, weight3, weight4, array_avr )
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
: (out)

space_average で .true. に指定された次元に対して, array を平均化して array_avr に返します. 平均化には重み weight1 〜 weight7 が用いられます. array_avr の配列の次元そのものは減りません. その代わり, 平均化された次元の配列のサイズは 1 になります.

Alias for AverageReduceInt4

AverageReduce( array, space_average, weight1, weight2, weight3, weight4, array_avr )
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
: (out)

space_average で .true. に指定された次元に対して, array を平均化して array_avr に返します. 平均化には重み weight1 〜 weight7 が用いられます. array_avr の配列の次元そのものは減りません. その代わり, 平均化された次元の配列のサイズは 1 になります.

Alias for AverageReduceDouble4

AverageReduce( array, space_average, weight1, weight2, weight3, weight4, array_avr )
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
: (out)

space_average で .true. に指定された次元に対して, array を平均化して array_avr に返します. 平均化には重み weight1 〜 weight7 が用いられます. array_avr の配列の次元そのものは減りません. その代わり, 平均化された次元の配列のサイズは 1 になります.

Alias for AverageReduceReal4

AverageReduce( array, space_average, weight1, weight2, weight3, weight4, weight5, array_avr )
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
: (out)

space_average で .true. に指定された次元に対して, array を平均化して array_avr に返します. 平均化には重み weight1 〜 weight7 が用いられます. array_avr の配列の次元そのものは減りません. その代わり, 平均化された次元の配列のサイズは 1 になります.

Alias for AverageReduceInt5

AverageReduce( array, space_average, weight1, weight2, weight3, weight4, weight5, array_avr )
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
: (out)

space_average で .true. に指定された次元に対して, array を平均化して array_avr に返します. 平均化には重み weight1 〜 weight7 が用いられます. array_avr の配列の次元そのものは減りません. その代わり, 平均化された次元の配列のサイズは 1 になります.

Alias for AverageReduceDouble5

AverageReduce( array, space_average, weight1, weight2, weight3, weight4, weight5, array_avr )
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
: (out)

space_average で .true. に指定された次元に対して, array を平均化して array_avr に返します. 平均化には重み weight1 〜 weight7 が用いられます. array_avr の配列の次元そのものは減りません. その代わり, 平均化された次元の配列のサイズは 1 になります.

Alias for AverageReduceReal5

AverageReduce( array, space_average, weight1, weight2, weight3, weight4, weight5, weight6, array_avr )
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
: (out)

space_average で .true. に指定された次元に対して, array を平均化して array_avr に返します. 平均化には重み weight1 〜 weight7 が用いられます. array_avr の配列の次元そのものは減りません. その代わり, 平均化された次元の配列のサイズは 1 になります.

Alias for AverageReduceInt6

AverageReduce( array, space_average, weight1, weight2, weight3, weight4, weight5, weight6, array_avr )
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
: (out)

space_average で .true. に指定された次元に対して, array を平均化して array_avr に返します. 平均化には重み weight1 〜 weight7 が用いられます. array_avr の配列の次元そのものは減りません. その代わり, 平均化された次元の配列のサイズは 1 になります.

Alias for AverageReduceDouble6

AverageReduce( array, space_average, weight1, weight2, weight3, weight4, weight5, weight6, array_avr )
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
: (out)

space_average で .true. に指定された次元に対して, array を平均化して array_avr に返します. 平均化には重み weight1 〜 weight7 が用いられます. array_avr の配列の次元そのものは減りません. その代わり, 平均化された次元の配列のサイズは 1 になります.

Alias for AverageReduceReal6

AverageReduce( array, space_average, weight1, weight2, weight3, weight4, weight5, weight6, weight7, array_avr )
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
: (out)

space_average で .true. に指定された次元に対して, array を平均化して array_avr に返します. 平均化には重み weight1 〜 weight7 が用いられます. array_avr の配列の次元そのものは減りません. その代わり, 平均化された次元の配列のサイズは 1 になります.

Alias for AverageReduceInt7

AverageReduce( array, space_average, weight1, weight2, weight3, weight4, weight5, weight6, weight7, array_avr )
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
: (out)

space_average で .true. に指定された次元に対して, array を平均化して array_avr に返します. 平均化には重み weight1 〜 weight7 が用いられます. array_avr の配列の次元そのものは減りません. その代わり, 平均化された次元の配列のサイズは 1 になります.

Alias for AverageReduceDouble7

AverageReduce( array, space_average, weight1, weight2, weight3, weight4, weight5, weight6, weight7, array_avr )
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
: (out)

space_average で .true. に指定された次元に対して, array を平均化して array_avr に返します. 平均化には重み weight1 〜 weight7 が用いられます. array_avr の配列の次元そのものは減りません. その代わり, 平均化された次元の配列のサイズは 1 になります.

Alias for AverageReduceReal7

GT_HISTORY_AXIS_DATA
Derived Type :
a_axis(:) =>null() :real(DP), pointer

座標軸データ用の構造型 Derived type for axes data

GT_HISTORY_MULTI
Derived Type :
gthist =>null() :type(GT_HISTORY), pointer

GT_HISTORY 型変数を指す構造体 Derived type for indication to "GT_HISTORY"

HstFileCreate( gthist, varname, time )
Subroutine :
gthist :type(GT_HISTORY), intent(inout)
: gtool_history モジュール用構造体. Derived type for "gtool_history" module
varname :character(*), intent(in)
: 変数の名前. Variable name
time :real(DP), intent(in)
: 現在時刻. Current time

ファイル作成用内部サブルーチン

Internal subroutine for creation of files

[Source]

  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
HstVarsOutputCheck( time, stime_index )
Subroutine :
time :real(DP), intent(in)
: 現在時刻. Current time
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.

[Source]

  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
MAX_DIMS_DEPENDED_BY_VAR
Constant :
MAX_DIMS_DEPENDED_BY_VAR = 7 :integer, parameter, public
MAX_VARS
Constant :
MAX_VARS = 256 :integer, parameter, public
: 出力可能な変数の最大値 Maximum value of output variables
SLICE_INFO
Derived Type :
st(:) =>null() :integer, pointer
: 空間方向の開始点. Start points of spaces.
ed(:) =>null() :integer, pointer
: 空間方向の終了点. End points of spaces.
sd(:) =>null() :integer, pointer
: 空間方向の刻み幅. Strides of spaces

空間切り出し情報管理用の構造型 Derived type for information of slice of space

SPACE_AVR_INFO
Derived Type :
avr(:) =>null() :logical, pointer
: 平均化のフラグ. Flag of average.

空間平均情報管理用の構造型 Derived type for information of average in space direction

all_output_save
Variable :
all_output_save = .false. :logical, save, public
cal_save
Variable :
cal_save :type(DC_CAL), save, public
checked_tstep_varnum
Variable :
checked_tstep_varnum = 0 :integer, save, public
: チェックされた変数の数. Number of checked variables
checked_tstepnum
Variable :
checked_tstepnum = 0 :integer, save, public
: チェックされた時間ステップの数. Number of checked time step
close_timing_vars
Variable :
close_timing_vars(1:MAX_VARS, 1:save_tstepnum) = .false. :logical, save, public
: 各時間ステップではファイルをクローズするか Whether file is closed or not at eath time step.
conventions_save
Variable :
conventions_save :character(STRING), save, public
create_timing_vars
Variable :
create_timing_vars(1:MAX_VARS, 1:save_tstepnum) = .false. :logical, save, public
: 各時間ステップではファイルを作成するか Whether file is created or not at eath time step.
data_axes
Variable :
data_axes(1:NF_MAX_DIMS) :type(GT_HISTORY_AXIS_DATA), save, target, public
data_axes_whole
Variable :
data_axes_whole(1:NF_MAX_DIMS) :type(GT_HISTORY_AXIS_DATA), save, target, public
data_weights
Variable :
data_weights(1:NF_MAX_DIMS) :type(GT_HISTORY_AXIS_DATA), save, target, public
flag_allvarfixed
Variable :
flag_allvarfixed = .false. :logical, save, public
flag_output_prev_vars
Variable :
flag_output_prev_vars(1:MAX_VARS) = .false. :logical, save, public
: ファイル出力を一度でも行ったかどうかのフラグ Flag implying that file is output previously
gt_version_save
Variable :
gt_version_save :character(TOKEN), save, public
gthst_axes
Variable :
gthst_axes(1:NF_MAX_DIMS) :type(GT_HISTORY_AXIS), save, target, public
gthst_history_vars
Variable :
gthst_history_vars(1:MAX_VARS) :type(GT_HISTORY_MULTI), save, public
gthst_vars
Variable :
gthst_vars(1:MAX_VARS) :type(GT_HISTORY_VARINFO), save, public
gthst_weights
Variable :
gthst_weights(1:NF_MAX_DIMS) :type(GT_HISTORY_VARINFO), save, public
gthstnml
Variable :
gthstnml :type(GTHST_NMLINFO), save, public
histaddvar_vars
Variable :
histaddvar_vars(1:MAX_VARS) = .false. :logical, save, public
: HistoryAddVariable 済みかどうか Whether "HistoryAddVariable" is done or not.
initialized
Variable :
initialized = .false. :logical, save, public
institution_save
Variable :
institution_save :character(STRING), save, public
interval_time_vars
Variable :
interval_time_vars(1:MAX_VARS) :real(DP), save, public
: 出力時間間隔. Interval time of output.
interval_unitsym_vars
Variable :
interval_unitsym_vars(1:MAX_VARS) :integer, save, public
: 出力時間間隔の単位 (シンボル). Units (symbols) of interval time of output.
max_remainder_range
Constant :
max_remainder_range = 1.0e-3_DP :real(DP), parameter, public
newfile_createtime_vars
Variable :
newfile_createtime_vars(1:MAX_VARS) :real(DP), save, public
: ファイルを新規に作り直した時間. Time of remake of file
newfile_inttime_vars
Variable :
newfile_inttime_vars(1:MAX_VARS) :real(DP), save, public
: ファイルを新規に作り直す時間間隔. Interval time of remake of file
numdims
Variable :
numdims :integer, save, public
numvars
Variable :
numvars = 0 :integer, save, public
numwgts
Variable :
numwgts = 0 :integer, save, public
origin_time_vars
Variable :
origin_time_vars(1:MAX_VARS) :real(DP), save, public
: 出力開始時刻. Start time of output
output_timing_avr_vars
Variable :
output_timing_avr_vars(1:MAX_VARS, 1:save_tstepnum) = .false. :logical, save, public
: 各時間ステップでは平均値出力を行うか否か. Whether output of averaged values is done or not at eath time step.
output_timing_vars
Variable :
output_timing_vars(1:MAX_VARS, 1:save_tstepnum) = .false. :logical, save, public
: 各時間ステップでは出力を行うか否か. Whether output is done or not at eath time step.
output_valid_vars
Variable :
output_valid_vars(1:MAX_VARS) = .false. :logical, save, public
: 変数出力が有効か否か. Whether output of variables is valid or not.
prev_outtime_vars
Variable :
prev_outtime_vars(1:MAX_VARS) :real(DP), save, public
: 前回に出力した時間. Time of previous output
rank_save
Variable :
rank_save :character(TOKEN), save, public
renew_timing_vars
Variable :
renew_timing_vars(1:MAX_VARS, 1:save_tstepnum) = .false. :logical, save, public
: 各時間ステップではファイルを再オープンするか Whether file is closed and opened or not at eath time step.
save_mpi_gather
Variable :
save_mpi_gather = .false. :logical, save, public
save_mpi_split
Variable :
save_mpi_split = .false. :logical, save, public
save_tstepnum
Constant :
save_tstepnum = 1 :integer, parameter, public
: 保存する時間ステップの数. Number of saved time step
saved_time
Variable :
saved_time(1:save_tstepnum) :real(DP), save, public
saved_tstep
Variable :
saved_tstep = 1 :integer, save, public
: 前回チェックされた時間ステップ. (HstVarsOutputCheck で使用する).

Time step checked at previous time (Used in "HstVarsOutputCheck").

slice_vars
Variable :
slice_vars(1:MAX_VARS) :type(SLICE_INFO), save, target, public
source_save
Variable :
source_save :character(STRING), save, public
space_avr_vars
Variable :
space_avr_vars(1:MAX_VARS) :type(SPACE_AVR_INFO), save, target, public
sub_sname
Constant :
sub_sname = "HistAuto" :character(*), parameter, public
tavr_vars
Variable :
tavr_vars(1:MAX_VARS) = .false. :logical, save, public
: 時間平均フラグ. Flag for time average
terminus_time_vars
Variable :
terminus_time_vars(1:MAX_VARS) :real(DP), save, public
: ファイルをクローズする時刻. time of closure of file
time_unit_bycreate
Variable :
time_unit_bycreate = ’’ :character(TOKEN), save, public
time_unit_suffix
Variable :
time_unit_suffix = ’’ :character(STRING), save, public
title_save
Variable :
title_save :character(STRING), save, public
varname_vars
Variable :
varname_vars(1:MAX_VARS) = ’’ :character(TOKEN), save, public
version
Constant :
version = ’$Name: gtool5-20101228-1 $’ // ’$Id: gtool_historyauto_internal.f90,v 1.6 2010-07-04 22:01:51 morikawa Exp $’ :character(*), parameter, public
weight_vars
Variable :
weight_vars(1:MAX_VARS) :type(AXES_WEIGHT), save, target, public
wgtsuf
Constant :
wgtsuf = ‘_weight‘ :character(*), parameter, public
zero_time
Variable :
zero_time :real(DP), save, public
: ゼロ秒. Zero second

Private Instance methods

AverageReduceDouble1( array, space_average, weight1, array_avr )
Subroutine :
array(:) :real(DP), intent(in), target
space_average(1) :logical, intent(in)
weight1(:) :real(DP), intent(in)
array_avr(:) :real(DP), pointer
: (out)

space_average で .true. に指定された次元に対して, array を平均化して array_avr に返します. 平均化には重み weight1 〜 weight7 が用いられます. array_avr の配列の次元そのものは減りません. その代わり, 平均化された次元の配列のサイズは 1 になります.

[Source]

  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
AverageReduceDouble2( array, space_average, weight1, weight2, array_avr )
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
: (out)

space_average で .true. に指定された次元に対して, array を平均化して array_avr に返します. 平均化には重み weight1 〜 weight7 が用いられます. array_avr の配列の次元そのものは減りません. その代わり, 平均化された次元の配列のサイズは 1 になります.

[Source]

  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
AverageReduceDouble3( array, space_average, weight1, weight2, weight3, array_avr )
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
: (out)

space_average で .true. に指定された次元に対して, array を平均化して array_avr に返します. 平均化には重み weight1 〜 weight7 が用いられます. array_avr の配列の次元そのものは減りません. その代わり, 平均化された次元の配列のサイズは 1 になります.

[Source]

  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
AverageReduceDouble4( array, space_average, weight1, weight2, weight3, weight4, array_avr )
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
: (out)

space_average で .true. に指定された次元に対して, array を平均化して array_avr に返します. 平均化には重み weight1 〜 weight7 が用いられます. array_avr の配列の次元そのものは減りません. その代わり, 平均化された次元の配列のサイズは 1 になります.

[Source]

  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
AverageReduceDouble5( array, space_average, weight1, weight2, weight3, weight4, weight5, array_avr )
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
: (out)

space_average で .true. に指定された次元に対して, array を平均化して array_avr に返します. 平均化には重み weight1 〜 weight7 が用いられます. array_avr の配列の次元そのものは減りません. その代わり, 平均化された次元の配列のサイズは 1 になります.

[Source]

  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
AverageReduceDouble6( array, space_average, weight1, weight2, weight3, weight4, weight5, weight6, array_avr )
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
: (out)

space_average で .true. に指定された次元に対して, array を平均化して array_avr に返します. 平均化には重み weight1 〜 weight7 が用いられます. array_avr の配列の次元そのものは減りません. その代わり, 平均化された次元の配列のサイズは 1 になります.

[Source]

  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
AverageReduceDouble7( array, space_average, weight1, weight2, weight3, weight4, weight5, weight6, weight7, array_avr )
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
: (out)

space_average で .true. に指定された次元に対して, array を平均化して array_avr に返します. 平均化には重み weight1 〜 weight7 が用いられます. array_avr の配列の次元そのものは減りません. その代わり, 平均化された次元の配列のサイズは 1 になります.

[Source]

  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
AverageReduceInt1( array, space_average, weight1, array_avr )
Subroutine :
array(:) :integer, intent(in), target
space_average(1) :logical, intent(in)
weight1(:) :real(DP), intent(in)
array_avr(:) :integer, pointer
: (out)

space_average で .true. に指定された次元に対して, array を平均化して array_avr に返します. 平均化には重み weight1 〜 weight7 が用いられます. array_avr の配列の次元そのものは減りません. その代わり, 平均化された次元の配列のサイズは 1 になります.

[Source]

  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
AverageReduceInt2( array, space_average, weight1, weight2, array_avr )
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
: (out)

space_average で .true. に指定された次元に対して, array を平均化して array_avr に返します. 平均化には重み weight1 〜 weight7 が用いられます. array_avr の配列の次元そのものは減りません. その代わり, 平均化された次元の配列のサイズは 1 になります.

[Source]

  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
AverageReduceInt3( array, space_average, weight1, weight2, weight3, array_avr )
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
: (out)

space_average で .true. に指定された次元に対して, array を平均化して array_avr に返します. 平均化には重み weight1 〜 weight7 が用いられます. array_avr の配列の次元そのものは減りません. その代わり, 平均化された次元の配列のサイズは 1 になります.

[Source]

  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
AverageReduceInt4( array, space_average, weight1, weight2, weight3, weight4, array_avr )
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
: (out)

space_average で .true. に指定された次元に対して, array を平均化して array_avr に返します. 平均化には重み weight1 〜 weight7 が用いられます. array_avr の配列の次元そのものは減りません. その代わり, 平均化された次元の配列のサイズは 1 になります.

[Source]

  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
AverageReduceInt5( array, space_average, weight1, weight2, weight3, weight4, weight5, array_avr )
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
: (out)

space_average で .true. に指定された次元に対して, array を平均化して array_avr に返します. 平均化には重み weight1 〜 weight7 が用いられます. array_avr の配列の次元そのものは減りません. その代わり, 平均化された次元の配列のサイズは 1 になります.

[Source]

  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
AverageReduceInt6( array, space_average, weight1, weight2, weight3, weight4, weight5, weight6, array_avr )
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
: (out)

space_average で .true. に指定された次元に対して, array を平均化して array_avr に返します. 平均化には重み weight1 〜 weight7 が用いられます. array_avr の配列の次元そのものは減りません. その代わり, 平均化された次元の配列のサイズは 1 になります.

[Source]

  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
AverageReduceInt7( array, space_average, weight1, weight2, weight3, weight4, weight5, weight6, weight7, array_avr )
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
: (out)

space_average で .true. に指定された次元に対して, array を平均化して array_avr に返します. 平均化には重み weight1 〜 weight7 が用いられます. array_avr の配列の次元そのものは減りません. その代わり, 平均化された次元の配列のサイズは 1 になります.

[Source]

  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
AverageReduceReal1( array, space_average, weight1, array_avr )
Subroutine :
array(:) :real, intent(in), target
space_average(1) :logical, intent(in)
weight1(:) :real(DP), intent(in)
array_avr(:) :real, pointer
: (out)

space_average で .true. に指定された次元に対して, array を平均化して array_avr に返します. 平均化には重み weight1 〜 weight7 が用いられます. array_avr の配列の次元そのものは減りません. その代わり, 平均化された次元の配列のサイズは 1 になります.

[Source]

  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
AverageReduceReal2( array, space_average, weight1, weight2, array_avr )
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
: (out)

space_average で .true. に指定された次元に対して, array を平均化して array_avr に返します. 平均化には重み weight1 〜 weight7 が用いられます. array_avr の配列の次元そのものは減りません. その代わり, 平均化された次元の配列のサイズは 1 になります.

[Source]

  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
AverageReduceReal3( array, space_average, weight1, weight2, weight3, array_avr )
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
: (out)

space_average で .true. に指定された次元に対して, array を平均化して array_avr に返します. 平均化には重み weight1 〜 weight7 が用いられます. array_avr の配列の次元そのものは減りません. その代わり, 平均化された次元の配列のサイズは 1 になります.

[Source]

  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
AverageReduceReal4( array, space_average, weight1, weight2, weight3, weight4, array_avr )
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
: (out)

space_average で .true. に指定された次元に対して, array を平均化して array_avr に返します. 平均化には重み weight1 〜 weight7 が用いられます. array_avr の配列の次元そのものは減りません. その代わり, 平均化された次元の配列のサイズは 1 になります.

[Source]

  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
AverageReduceReal5( array, space_average, weight1, weight2, weight3, weight4, weight5, array_avr )
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
: (out)

space_average で .true. に指定された次元に対して, array を平均化して array_avr に返します. 平均化には重み weight1 〜 weight7 が用いられます. array_avr の配列の次元そのものは減りません. その代わり, 平均化された次元の配列のサイズは 1 になります.

[Source]

  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
AverageReduceReal6( array, space_average, weight1, weight2, weight3, weight4, weight5, weight6, array_avr )
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
: (out)

space_average で .true. に指定された次元に対して, array を平均化して array_avr に返します. 平均化には重み weight1 〜 weight7 が用いられます. array_avr の配列の次元そのものは減りません. その代わり, 平均化された次元の配列のサイズは 1 になります.

[Source]

  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
AverageReduceReal7( array, space_average, weight1, weight2, weight3, weight4, weight5, weight6, weight7, array_avr )
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
: (out)

space_average で .true. に指定された次元に対して, array を平均化して array_avr に返します. 平均化には重み weight1 〜 weight7 が用いられます. array_avr の配列の次元そのものは減りません. その代わり, 平均化された次元の配列のサイズは 1 になります.

[Source]

  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