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   GT_HISTORY_AXIS_DATA   GT_HISTORY_MULTI   HstFileCreate   HstVarsOutputCheck   MAX_DIMS_DEPENDED_BY_VAR   MAX_VARS   SLICE_INFO   SPACE_AVR_INFO   all_output_save   checked_tstep_varnum   checked_tstepnum   close_timing_vars   conventions_save   create_timing_vars   data_axes   data_axes_whole   data_weights   flag_allvarfixed   gt_version_save   gthst_axes   gthst_history_vars   gthst_vars   gthst_weights   gthstnml   histaddvar_vars   initialized   institution_save   interval_time_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_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 になります.

[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
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 になります.

[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
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 になります.

[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
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 になります.

[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
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 になります.

[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
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 になります.

[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
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 になります.

[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
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 になります.

[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
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 になります.

[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
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 になります.

[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
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 になります.

[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
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 になります.

[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
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 になります.

[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
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 になります.

[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
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 になります.

[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
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 になります.

[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
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 になります.

[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
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 になります.

[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
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 になります.

[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
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 になります.

[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
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 になります.

[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
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 :type(DC_DIFFTIME), 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_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
    type(DC_DIFFTIME), intent(in):: time
                              ! 現在時刻. Current time

    character(TOKEN):: interval_unit
                              ! データの出力間隔の単位. 
                              ! Unit for interval of history data output
    real:: origin_value
                              ! データの出力開始時刻の数値. 
                              ! Numerical value for start time of history data output
    character(TOKEN):: origin_unit
                              ! データの出力開始時刻の単位. 
                              ! Unit for start time of history data output

    type(DC_DIFFTIME):: origin_difftime
    integer:: newfile_intvalue
                              ! ファイル分割時間間隔. 
                              ! 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
      !
      call DCDiffTimeCreate( origin_difftime, origin_value, origin_unit )  ! (in)

      if ( newfile_intvalue < 1 ) then
        origin_value = EvalbyUnit( origin_difftime, interval_unit )
      else
        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
        file_newfile_time = CPrintf( '_time%08d', 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), origin = 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 :type(DC_DIFFTIME), 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
    type(DC_DIFFTIME), 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 /) )


    ! * output_timing_vars(:,2:3) を output_timing_vars(:,1:2) へ 
    ! * saved_time(2:3) を saved_time(1:2) へ 
    ! * time を saved_time(3) へ 
    ! * saved_tstep = checked_tstepnum とする. 
    ! * stime_index = saved_tstep とする. 
    ! * タイミングチェックして output_timing_vars(:,3) へ 

    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
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
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) :type(DC_DIFFTIME), save, public
: 出力時間間隔. 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) :type(DC_DIFFTIME), save, public
: ファイルを新規に作り直した時間. Time of remake of file
newfile_inttime_vars
Variable :
newfile_inttime_vars(1:MAX_VARS) :type(DC_DIFFTIME), 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) :type(DC_DIFFTIME), 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) :type(DC_DIFFTIME), 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) :type(DC_DIFFTIME), 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) :type(DC_DIFFTIME), 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-20090809 $’ // ’$Id: gtool_historyauto_internal.f90,v 1.2 2009-05-31 14:36:33 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 :type(DC_DIFFTIME), save, public
: ゼロ秒. Zero second

[Validate]