gtool_historyauto_internal::hstfilecreate Interface Reference

Private Member Functions
subroutine	hstfilecreate (gthist, varname, time)

Detailed Description

Definition at line 345 of file gtool_historyauto_internal.f90.

Constructor & Destructor Documentation

hstfilecreate()

subroutine gtool_historyauto_internal::hstfilecreate::hstfilecreate ( type(gt_history), intent(inout)  gthist, character(*), intent(in)  varname, real(dp), intent(in)  time  )

private

Definition at line 625 of file gtool_historyauto_internal.f90.

    !
    ! ファイル作成用内部サブルーチン
    !
    ! Internal subroutine for creation of files
    !
    use dc_trace, only: beginsub, endsub
    use dc_error, only: storeerror, dc_noerr, hst_ebadvarname, &
      & hst_ebadslice, hst_empinoaxisdata
    use dc_calendar, only: dccalconvertbyunit
    use dc_date_types, only: dc_difftime
    use dc_date, only: dcdifftimecreate, evalbyunit
    use dc_string, only: cprintf, strinclude, tochar, joinchar
    use dc_message, only: messagenotify
    use gtool_history_nmlinfo_generic, only: &
      & hstnmlinfooutputvalid, hstnmlinfoinquire, hstnmlinfoputline
    use gtool_history, only: gt_history, &
      & historycreate, historyaddvariable, historyaddattr, &
      & historyinitialized, historyput, historyputaxismpi, &
      & historyaxiscreate, historyaxisinquire, historyaxiscopy, &
      & historyvarinfoinquire, historyvarinfocreate, &
      & historyvarinfocopy, historyvarinfoinitialized, &
      & historyvarinfoclear

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

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

    real(DP):: origin_sec
    integer:: newfile_intvalue
    real(DP):: newfile_intvalued
                              ! ファイル分割時間間隔.
                              ! Interval of time of separation of a file.
    character(TOKEN):: newfile_intunit
                              ! ファイル分割時間間隔の単位.
                              ! Unit of interval of time of separation of a file.

    character(STRING):: file, file_base, file_suffix, file_newfile_time, file_rank
                              ! 出力ファイル名.
                              ! Output file name.
    integer:: stat, i, j, k, vnum, numdims_slice, dim_size, cnt
    character(STRING):: name, units, longname, cause_c, wgt_name
    character(TOKEN):: xtype
    type(gt_history_axis):: gthst_axes_time
    type(gt_history_axis), pointer:: gthst_axes_slices(:) =>null()
    type(gt_history_axis_data), pointer:: data_axes_slices(:) =>null()
    type(gt_history_axis_data), pointer:: data_weights_slices(:) =>null()
    real(DP):: wgt_sum, wgt_sum_s
    logical:: slice_valid
    integer:: slice_start(1:numdims-1)
                              ! 空間方向の開始点.
                              ! Start points of spaces.
    integer:: slice_end(1:numdims-1)
                              ! 空間方向の終了点.
                              ! End points of spaces.
    integer:: slice_stride(1:numdims-1)
                              ! 空間方向の刻み幅.
                              ! Strides of spaces

    character(*), parameter:: subname = "HstFileCreate"
  continue
    call beginsub(subname, 'varname=%c', c1 = trim(varname) )
    stat = dc_noerr
    cause_c = ""

    ! varname から変数情報の探査
    ! Search information of a variable from "varname"
    !
    vnum = 0
    do i = 1, numvars
      call historyvarinfoinquire( &
        & varinfo = gthst_vars(i), &  ! (in)
        & 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, &                 ! (in)
      & name = varname, &                      ! (in)
      & file = file, &                         ! (out)
      & interval_unit  = interval_unit )       ! (out)

    call historyaxiscopy( &
      & gthst_axes_time, &     ! (out)
      & gthst_axes(numdims), & ! (in)
      & units = trim(interval_unit) // ' ' // &
      &         trim(time_unit_suffix) ) ! (in)

    ! 空間方向のスライスに対応して, 座標および座標重み情報の作り直し
    ! Remake axes and weights information correspond to spatial slices
    !
    call hstnmlinfoinquire( &
      & gthstnml = gthstnml, &         ! (in)
      & name = varname, &              ! (in)
      & slice_start = slice_start, &   ! (out)
      & slice_end = slice_end, &       ! (out)
      & 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) , &  ! (out)
              & 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), &  ! (in)
            & name = name, &           ! (out)
            & size = dim_size, &       ! (out)
            & longname = longname, &   ! (out)
            & units = units, &         ! (out)
            & 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), &  ! (out)
            & name = name, &                  ! (in)
            & size = numdims_slice, &         ! (in)
            & longname = longname, &          ! (in)
            & units = units, &                ! (in)
            & 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), & ! (in)
              & 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, &                 ! (in)
        & name = varname, &                      ! (in)
        & file = file, &                         ! (out)
        & origin_value   = origin_value, &       ! (out)
        & origin_unit    = origin_unit, &        ! (out)
        & interval_unit  = interval_unit, &      ! (out)
        & newfile_intvalue = newfile_intvalue, & ! (out)
        & newfile_intunit = newfile_intunit )    ! (out)

      ! データ出力時刻の設定
      ! Configure data output time
      !
      origin_sec = &
        & dccalconvertbyunit( &
        &   real( origin_value, DP ), origin_unit, 'sec', cal_save )

!!$      ! dc_date モジュール使用時
!!$      !
!!$      call DCDiffTimeCreate( &
!!$        & origin_sec, &           ! (out)
!!$        & origin_value, origin_unit )  ! (in)

      if ( newfile_intvalue < 1 ) then

        origin_value = dccalconvertbyunit( &
          & origin_sec, 'sec', interval_unit, cal_save )

!        origin_value = EvalbyUnit( origin_sec, interval_unit )
      else

        origin_value = &
          & dccalconvertbyunit( time, 'sec', interval_unit, cal_save )

!        origin_value = EvalbyUnit( time, interval_unit )
      end if

      ! ファイル名の設定
      ! Configure file name
      !
      if ( len_trim( file ) - index(file, '.nc', .true.) == 2 ) then
        file_base = file(1:len_trim( file ) - 3)
        file_suffix = '.nc'
      else
        file_base = file
        file_suffix = ''
      end if
      if ( trim(rank_save) == '' ) then
        file_rank = ''
      else
        file_rank = '_rank' // trim( adjustl(rank_save) )
      end if
      if ( newfile_intvalue > 0 ) then
        newfile_intvalued = &
          & dccalconvertbyunit( time, 'sec', newfile_intunit, cal_save )

        file_newfile_time = &
          & cprintf( '_time%08d', i = (/ int( newfile_intvalued ) /) )
!          &   i = (/ int( EvalbyUnit( time, newfile_intunit ) ) /) )
      else
        file_newfile_time = ''
      end if

      file = trim(file_base) // trim(file_rank) // trim(file_newfile_time) // trim(file_suffix)

      ! HistoryCreate によるファイル作成
      ! Files are created by "HistoryCreate"
      !
      call historycreate( &
        & history = gthist, &                                     ! (inout)
        & file = file, title = title_save, &                      ! (in)
        & source = source_save, institution = institution_save, & ! (in)
        & axes = gthst_axes_slices(1:numdims), &                  ! (in)
        & origind = origin_value, &                               ! (in)
        & conventions = conventions_save, &                       ! (in)
        & gt_version = gt_version_save, &                         ! (in)
        & flag_mpi_split = save_mpi_split, &                      ! (in)
        & flag_mpi_gather = save_mpi_gather )                     ! (in)

      ! 座標データを出力
      ! Output axes data
      !
      do i = 1, numdims - 1
        call historyaxisinquire( &
          & axis = gthst_axes_slices(i), &  ! (in)
          & name = name )                   ! (out)
        call historyput( &
          & history = gthist, &                    ! (inout) optional
          & varname = name, &                      ! (in)
          & 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), &  ! (in)
            & 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, &                   ! (inout) optional
            & varname = name, &                     ! (in)
            & 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, &           ! (inout)
          & varinfo = gthst_weights(i) )  ! (in)
        call historyvarinfoinquire( &
          & varinfo = gthst_weights(i), &  ! (in)
          & name = name )                  ! (out)
        call historyput( &
          & history = gthist, &                       ! (inout) optional
          & varname = name, &                         ! (in)
          & 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), &  ! (in)
      & history = gthist )             ! (inout) optional

999 continue
    call storeerror(stat, subname, cause_c = cause_c)
    call endsub(subname)

---

The documentation for this interface was generated from the following file:

• gtool/gtool_historyauto/gtool_historyauto_internal.f90