historyput.f90 File Reference

Go to the source code of this file.

Functions/Subroutines
recursive subroutine	historyputrealex (varname, array, arraysize, history, range, time, quiet, difftime, timed, time_average_store, err)
	データ出力
recursive subroutine	historyputdoubleex (varname, array, arraysize, history, range, time, quiet, difftime, timed, time_average_store, err)
	データ出力
recursive subroutine	historyputintex (varname, array, arraysize, history, range, time, quiet, difftime, timed, time_average_store, err)
	データ出力
recursive subroutine	historyputcharex (varname, array, arraysize, history, range, time, quiet, difftime, timed, time_average_store, err)
	データ出力
subroutine	historyputaxismpireal (varname, array, history, err)
subroutine	historyputaxismpidouble (varname, array, history, err)
subroutine	historyputaxismpiint (varname, array, history, err)
subroutine	historyputdouble0 (varname, value, history, range, time, quiet, difftime, timed, time_average_store, err)
	データ出力
subroutine	historyputdouble1 (varname, array, history, range, time, quiet, difftime, timed, time_average_store, err)
subroutine	historyputdouble2 (varname, array, history, range, time, quiet, difftime, timed, time_average_store, err)
subroutine	historyputdouble3 (varname, array, history, range, time, quiet, difftime, timed, time_average_store, err)
subroutine	historyputdouble4 (varname, array, history, range, time, quiet, difftime, timed, time_average_store, err)
subroutine	historyputdouble5 (varname, array, history, range, time, quiet, difftime, timed, time_average_store, err)
subroutine	historyputdouble6 (varname, array, history, range, time, quiet, difftime, timed, time_average_store, err)
subroutine	historyputdouble7 (varname, array, history, range, time, quiet, difftime, timed, time_average_store, err)
subroutine	historyputreal0 (varname, value, history, range, time, quiet, difftime, timed, time_average_store, err)
subroutine	historyputreal1 (varname, array, history, range, time, quiet, difftime, timed, time_average_store, err)
subroutine	historyputreal2 (varname, array, history, range, time, quiet, difftime, timed, time_average_store, err)
subroutine	historyputreal3 (varname, array, history, range, time, quiet, difftime, timed, time_average_store, err)
subroutine	historyputreal4 (varname, array, history, range, time, quiet, difftime, timed, time_average_store, err)
subroutine	historyputreal5 (varname, array, history, range, time, quiet, difftime, timed, time_average_store, err)
subroutine	historyputreal6 (varname, array, history, range, time, quiet, difftime, timed, time_average_store, err)
subroutine	historyputreal7 (varname, array, history, range, time, quiet, difftime, timed, time_average_store, err)
subroutine	historyputint0 (varname, value, history, range, time, quiet, difftime, timed, time_average_store, err)
subroutine	historyputint1 (varname, array, history, range, time, quiet, difftime, timed, time_average_store, err)
subroutine	historyputint2 (varname, array, history, range, time, quiet, difftime, timed, time_average_store, err)
subroutine	historyputint3 (varname, array, history, range, time, quiet, difftime, timed, time_average_store, err)
subroutine	historyputint4 (varname, array, history, range, time, quiet, difftime, timed, time_average_store, err)
subroutine	historyputint5 (varname, array, history, range, time, quiet, difftime, timed, time_average_store, err)
subroutine	historyputint6 (varname, array, history, range, time, quiet, difftime, timed, time_average_store, err)
subroutine	historyputint7 (varname, array, history, range, time, quiet, difftime, timed, time_average_store, err)
subroutine	historyputchar0 (varname, value, history, range, time, quiet, difftime, timed, time_average_store, err)
subroutine	timegoahead (varname, var, head, history, err)

Function/Subroutine Documentation

historyputaxismpidouble()

subroutine historyputaxismpidouble	(	character(*), intent(in)	varname,
		real(dp), dimension(:), intent(in)	array,
		type(gt_history), intent(inout), optional, target	history,
		logical, intent(out), optional	err
	)

Definition at line 2552 of file historyput.f90.

    !
    ! MPI 使用時に, 各々のノード上のデータを単一ファイルに
    ! 集約して出力する場合には,
    ! このサブルーチンに領域全体の座標データを与えてください.
    ! また, HistoryCreate のオプショナル論理型引数 *flag_mpi_gather*
    ! に .true. を与えてください.
    !
    ! HistoryPut よりも後に使用してください
    ! HistoryAddVariable, HistoryAddAttr よりも前に使用してください.
    !
    ! When MPI is used, if data on each node is integrated and
    ! output to one file, give data of axes in whole area to
    ! this subroutine.
    ! And give .true. to optional logical argument *flag_mpi_gather*
    ! in "HistoryCreate".
    !
    ! Use this subroutine after "HistoryPut", and
    ! before "HistoryAddVariable", "HistoryAddAttr".
    !
    use gtool_history_generic, only: historyaxisinquire
    use gtdata_generic, only: create, put_attr, put
    use gtdata_types, only: gt_variable
    use dc_error, only: storeerror, dc_noerr, dc_enotinit, &
      & gt_ebaddimname
    use dc_url, only: urlmerge
    use dc_date_generic, only: evalbyunit
    use dc_date_types, only: dc_difftime
    use dc_string, only: tochar, lchar, strhead
    use dc_message, only: messagenotify
    use gtool_history_types, only: gt_history, gt_history_axis, gt_history_varinfo, gt_history_attr
    use gtool_history_internal, only: default
    use dc_trace, only: beginsub, endsub, dbgmessage
    use dc_types, only: string, dp
    implicit none
    character(*), intent(in):: varname
                                                  ! 座標変数の名称.
                              !
                              ! ここで指定するものは, HistoryCreate の
                              ! 引数 *dims* で既に指定されてい
                              ! なければなりません.
                              !
                              ! Name of dimensional variable.
                              !
                              ! This name must be specified by
                              ! an argument *dims* in "HistoryCreate".
                              !
    real(DP), intent(in):: array(:)
                                                  ! 座標データ.
                              !
                              ! Data of axes.
    type(GT_HISTORY), intent(inout), optional, target:: history
                                                  ! 出力ファイルの設定に関する情報を
                              ! 格納した GT_HISTORY 型変数
                              !
                              ! ここに指定するものは,
                              ! HistoryCreate によって初期設定
                              ! されていなければなりません.
                              !
                              ! A "GT_HISTORY" type variable that
                              ! stores information about configuration of
                              ! an output file
                              !
                              ! This must be initialized by
                              ! "HistoryCreate".
                              !
    logical, intent(out), optional:: err
                                                  ! 例外処理用フラグ.
                              ! デフォルトでは, この手続き内でエラーが
                              ! 生じた場合, プログラムは強制終了します.
                              ! 引数 *err* が与えられる場合,
                              ! プログラムは強制終了せず, 代わりに
                              ! *err* に .true. が代入されます.
                              !
                              ! Exception handling flag.
                              ! By default, when error occur in
                              ! this procedure, the program aborts.
                              ! If this *err* argument is given,
                              ! .true. is substituted to *err* and
                              ! the program does not abort.
    type(GT_HISTORY), pointer:: hst =>null()
    integer:: dimord, dimsize, numdims, i, j, attr_size
    type(GT_HISTORY_ATTR), pointer:: attrs(:) =>null()
    character(STRING):: dimname
    character(STRING):: name, longname, units, xtype, origin_str, url
    real(DP):: origin_work
    integer:: stat
    character(STRING):: cause_c
    character(*), parameter:: subname = "HistoryPutAxisMPIDouble"
  continue
    call beginsub(subname, 'varname=%c', c1 = trim(varname) )
    stat = dc_noerr
    cause_c = ""
    if (present(history)) then
      hst => history
    else
      hst => default
    endif
    if ( .not. hst % initialized ) then
      stat = dc_enotinit
      cause_c = 'GT_HISTORY'
      goto 999
    end if
    call dbgmessage( 'mpi_gather=<%b>', l = (/ hst % mpi_gather /) )
    if ( .not. hst % mpi_gather ) then
      goto 999
    else
      numdims = size( hst % dimvars )
      dimord = -1
      do i = 1, numdims
        call historyaxisinquire( &
          & hst % mpi_fileinfo % axes(i), & ! (in)
          & name = dimname )                ! (out)
        if ( trim(varname) == trim(dimname) ) then
          dimord = i
          exit
        end if
      end do
      if ( dimord < 1 ) then
        stat = gt_ebaddimname
        cause_c = varname
        goto 999
      end if
      dimsize = size( array )
      if ( associated( hst % mpi_dimdata_all( dimord ) % a_Axis ) ) then
        deallocate( hst % mpi_dimdata_all( dimord ) % a_Axis )
      end if
      allocate( hst % mpi_dimdata_all( dimord ) % a_Axis(dimsize) )
      hst % mpi_dimdata_all( dimord ) % a_Axis = array
      hst % mpi_dimdata_all( dimord ) % length = dimsize
    end if
    ! 全ての (時刻以外の) 座標データが登録されたらファイル出力
    ! Output file if data of all axes (excluding time) are registered
    !
    numdims = size( hst % dimvars )
    do i = 1, numdims
      if ( hst % unlimited_index == i ) cycle
      if ( hst % time_nv_index == i ) cycle
      if ( hst % mpi_dimdata_all( i ) % length < 1 ) goto 999
    end do
    if ( hst % mpi_myrank /= 0 ) goto 2000
    if ( hst % mpi_fileinfo % already_output ) goto 999
    do i = 1, numdims
      call historyaxisinquire( hst % mpi_fileinfo % axes(i), & ! (in)
        & name, dimsize, longname, units, xtype )              ! (out)
      url = urlmerge(file = hst % mpi_fileinfo % file, var = name)
      ! 座標の長さを, このサブルーチンで取得したものに修正
      ! Length of axes is modified to one that is gotten by this subroutine
      !
      if ( hst % unlimited_index /= i ) then
        dimsize = hst % mpi_dimdata_all( i ) % length
      end if
      ! ファイル作成
      ! Create file
      !
      call create( &
        & hst % dimvars(i), trim(url), &
        & dimsize, xtype = xtype, &
        & overwrite = hst % mpi_fileinfo % overwrite )
      ! 属性の付加
      ! Add attributes
      !
      call put_attr(hst % dimvars(i), '+Conventions', trim(hst % mpi_fileinfo % conventions ))
      if ( hst % mpi_fileinfo % gtver_add ) then
        call put_attr(hst % dimvars(i), '+gt_version', trim(hst % mpi_fileinfo % gt_version ))
      endif
      ! title, source, institution, history, long_name, units 属性の付加
      call put_attr(hst % dimvars(i), '+title', hst % mpi_fileinfo % title)
      call put_attr(hst % dimvars(i), '+source', hst % mpi_fileinfo % source)
      call put_attr(hst % dimvars(i), '+institution', trim(hst % mpi_fileinfo % institution))
      call put_attr(hst % dimvars(i), '+history', trim(hst % mpi_fileinfo % nc_history))
      call put_attr(hst % dimvars(i), 'long_name', longname)
      call put_attr(hst % dimvars(i), 'units', units)
      origin_work = hst % origin
!      origin_work = EvalByUnit( hst % origin, '', hst % unlimited_units_symbol )
      origin_str = trim( tochar( origin_work ) ) // &
        &          ' [' // trim( hst % unlimited_units ) // ']'
      ! 座標データの出力
      ! Output data of axes
      !
      if ( hst % unlimited_index /= i ) then
        call put(hst % dimvars(i), &
          & hst % mpi_dimdata_all( i ) % a_Axis, dimsize )
        hst % dim_value_written(i) = .true.
      end if
      ! 座標の属性の付加
      ! Add attributes of axes
      !
      attrs => hst % mpi_dimdata_all(i) % attrs
      if ( associated( attrs ) ) then
        attr_size = size( attrs )
        do j = 1, attr_size
          if ( strhead( 'char', trim(lchar(attrs(j)%attrtype))) ) then
            call put_attr(hst % dimvars(i), &
              & attrs(j) % attrname, trim( attrs(j) % Charvalue ) )
          elseif ( strhead( 'int', trim(lchar(attrs(j)%attrtype))) ) then
            if ( attrs(j)%array ) then
              call dbgmessage('Intarray(:) is selected.')
              call put_attr(hst % dimvars(i), &
                & attrs(j) % attrname, attrs(j) % Intarray )
            else
              call dbgmessage('Intvalue is selected')
              call put_attr(hst % dimvars(i), &
                & attrs(j) % attrname, (/attrs(j) % Intvalue/) )
            endif
          elseif ( strhead( 'real', trim(lchar(attrs(j)%attrtype))) ) then
            if ( attrs(j)%array ) then
              call dbgmessage('Realarray(:) is selected.')
              call put_attr(hst % dimvars(i), &
                & attrs(j) % attrname, attrs(j) % Realarray )
            else
              call dbgmessage('Realvalue is selected')
              call put_attr(hst % dimvars(i), &
                & attrs(j) % attrname, (/attrs(j) % Realvalue/) )
            endif
          elseif ( strhead( 'double', trim(lchar(attrs(j)%attrtype))) ) then
            if ( attrs(j)%array ) then
              call dbgmessage('Doublearray(:) is selected.')
              call put_attr(hst % dimvars(i), &
                & attrs(j) % attrname, attrs(j) % Doublearray )
            else
              call dbgmessage('Doublevalue is selected')
              call put_attr(hst % dimvars(i), &
                & attrs(j) % attrname, (/attrs(j) % Doublevalue/) )
            endif
          elseif ( strhead( 'logical', trim(lchar(attrs(j)%attrtype))) ) then
            call put_attr(hst % dimvars(i), &
              & attrs(j) % attrname, attrs(j) % Logicalvalue )
          else
            call dbgmessage('attrtype=<%c>=<%c>is Invalid.'   , &
              &      c1=trim(attrs(j)%attrtype)         , &
              &      c2=trim(lchar(attrs(j)%attrtype))      )
          endif
        end do
      end if
    end do
    if ( .not. hst % mpi_fileinfo % quiet ) then
      call messagenotify('M', subname, &
        & '"%c" is created (origin=%c)', &
        & c1 = trim( hst % mpi_fileinfo % file ), &
        & c2 = trim( origin_str ) )
    end if
2000 continue
    hst % mpi_fileinfo % already_output = .true.
    ! 終了処理, 例外処理
    ! Termination and Exception handling
    !
999 continue
    call storeerror( stat, subname, err, cause_c )
    call endsub(subname)

References dc_trace::beginsub(), dc_trace::dbgmessage(), dc_error::dc_enotinit, dc_error::dc_noerr, gtool_history_internal::default, dc_types::dp, dc_trace::endsub(), dc_error::gt_ebaddimname, dc_error::storeerror(), and dc_types::string.

Here is the call graph for this function:

historyputaxismpiint()

subroutine historyputaxismpiint	(	character(*), intent(in)	varname,
		integer, dimension(:), intent(in)	array,
		type(gt_history), intent(inout), optional, target	history,
		logical, intent(out), optional	err
	)

Definition at line 2804 of file historyput.f90.

    !
    ! MPI 使用時に, 各々のノード上のデータを単一ファイルに
    ! 集約して出力する場合には,
    ! このサブルーチンに領域全体の座標データを与えてください.
    ! また, HistoryCreate のオプショナル論理型引数 *flag_mpi_gather*
    ! に .true. を与えてください.
    !
    ! HistoryPut よりも後に使用してください
    ! HistoryAddVariable, HistoryAddAttr よりも前に使用してください.
    !
    ! When MPI is used, if data on each node is integrated and
    ! output to one file, give data of axes in whole area to
    ! this subroutine.
    ! And give .true. to optional logical argument *flag_mpi_gather*
    ! in "HistoryCreate".
    !
    ! Use this subroutine after "HistoryPut", and
    ! before "HistoryAddVariable", "HistoryAddAttr".
    !
    use gtool_history_generic, only: historyaxisinquire
    use gtdata_generic, only: create, put_attr, put
    use gtdata_types, only: gt_variable
    use dc_error, only: storeerror, dc_noerr, dc_enotinit, &
      & gt_ebaddimname
    use dc_url, only: urlmerge
    use dc_date_generic, only: evalbyunit
    use dc_date_types, only: dc_difftime
    use dc_string, only: tochar, lchar, strhead
    use dc_message, only: messagenotify
    use gtool_history_types, only: gt_history, gt_history_axis, gt_history_varinfo, gt_history_attr
    use gtool_history_internal, only: default
    use dc_trace, only: beginsub, endsub, dbgmessage
    use dc_types, only: string, dp
    implicit none
    character(*), intent(in):: varname
    integer, intent(in):: array(:)
    type(GT_HISTORY), intent(inout), optional, target:: history
    logical, intent(out), optional:: err
    type(GT_HISTORY), pointer:: hst =>null()
    integer:: dimord, dimsize, numdims, i, j, attr_size
    type(GT_HISTORY_ATTR), pointer:: attrs(:) =>null()
    character(STRING):: dimname
    character(STRING):: name, longname, units, xtype, origin_str, url
    real(DP):: origin_work
    integer:: stat
    character(STRING):: cause_c
    character(*), parameter:: subname = "HistoryPutAxisMPIInt"
  continue
    call beginsub(subname, 'varname=%c', c1 = trim(varname) )
    stat = dc_noerr
    cause_c = ""
    if (present(history)) then
      hst => history
    else
      hst => default
    endif
    if ( .not. hst % initialized ) then
      stat = dc_enotinit
      cause_c = 'GT_HISTORY'
      goto 999
    end if
    call dbgmessage( 'mpi_gather=<%b>', l = (/ hst % mpi_gather /) )
    if ( .not. hst % mpi_gather ) then
      goto 999
    else
      numdims = size( hst % dimvars )
      dimord = -1
      do i = 1, numdims
        call historyaxisinquire( &
          & hst % mpi_fileinfo % axes(i), & ! (in)
          & name = dimname )                ! (out)
        if ( trim(varname) == trim(dimname) ) then
          dimord = i
          exit
        end if
      end do
      if ( dimord < 1 ) then
        stat = gt_ebaddimname
        cause_c = varname
        goto 999
      end if
      dimsize = size( array )
      if ( associated( hst % mpi_dimdata_all( dimord ) % a_Axis ) ) then
        deallocate( hst % mpi_dimdata_all( dimord ) % a_Axis )
      end if
      allocate( hst % mpi_dimdata_all( dimord ) % a_Axis(dimsize) )
      hst % mpi_dimdata_all( dimord ) % a_Axis = array
      hst % mpi_dimdata_all( dimord ) % length = dimsize
    end if
    ! 全ての (時刻以外の) 座標データが登録されたらファイル出力
    ! Output file if data of all axes (excluding time) are registered
    !
    numdims = size( hst % dimvars )
    do i = 1, numdims
      if ( hst % unlimited_index == i ) cycle
      if ( hst % time_nv_index == i ) cycle
      if ( hst % mpi_dimdata_all( i ) % length < 1 ) goto 999
    end do
    if ( hst % mpi_myrank /= 0 ) goto 2000
    if ( hst % mpi_fileinfo % already_output ) goto 999
    do i = 1, numdims
      call historyaxisinquire( hst % mpi_fileinfo % axes(i), & ! (in)
        & name, dimsize, longname, units, xtype )              ! (out)
      url = urlmerge(file = hst % mpi_fileinfo % file, var = name)
      ! 座標の長さを, このサブルーチンで取得したものに修正
      ! Length of axes is modified to one that is gotten by this subroutine
      !
      if ( hst % unlimited_index /= i ) then
        dimsize = hst % mpi_dimdata_all( i ) % length
      end if
      ! ファイル作成
      ! Create file
      !
      call create( &
        & hst % dimvars(i), trim(url), &
        & dimsize, xtype = xtype, &
        & overwrite = hst % mpi_fileinfo % overwrite )
      ! 属性の付加
      ! Add attributes
      !
      call put_attr(hst % dimvars(i), '+Conventions', trim(hst % mpi_fileinfo % conventions ))
      if ( hst % mpi_fileinfo % gtver_add ) then
        call put_attr(hst % dimvars(i), '+gt_version', trim(hst % mpi_fileinfo % gt_version ))
      endif
      ! title, source, institution, history, long_name, units 属性の付加
      call put_attr(hst % dimvars(i), '+title', hst % mpi_fileinfo % title)
      call put_attr(hst % dimvars(i), '+source', hst % mpi_fileinfo % source)
      call put_attr(hst % dimvars(i), '+institution', trim(hst % mpi_fileinfo % institution))
      call put_attr(hst % dimvars(i), '+history', trim(hst % mpi_fileinfo % nc_history))
      call put_attr(hst % dimvars(i), 'long_name', longname)
      call put_attr(hst % dimvars(i), 'units', units)
      origin_work = hst % origin
!      origin_work = EvalByUnit( hst % origin, '', hst % unlimited_units_symbol )
      origin_str = trim( tochar( origin_work ) ) // &
        &          ' [' // trim( hst % unlimited_units ) // ']'
      ! 座標データの出力
      ! Output data of axes
      !
      if ( hst % unlimited_index /= i ) then
        call put(hst % dimvars(i), &
          & hst % mpi_dimdata_all( i ) % a_Axis, dimsize )
        hst % dim_value_written(i) = .true.
      end if
      ! 座標の属性の付加
      ! Add attributes of axes
      !
      attrs => hst % mpi_dimdata_all(i) % attrs
      if ( associated( attrs ) ) then
        attr_size = size( attrs )
        do j = 1, attr_size
          if ( strhead( 'char', trim(lchar(attrs(j)%attrtype))) ) then
            call put_attr(hst % dimvars(i), &
              & attrs(j) % attrname, trim( attrs(j) % Charvalue ) )
          elseif ( strhead( 'int', trim(lchar(attrs(j)%attrtype))) ) then
            if ( attrs(j)%array ) then
              call dbgmessage('Intarray(:) is selected.')
              call put_attr(hst % dimvars(i), &
                & attrs(j) % attrname, attrs(j) % Intarray )
            else
              call dbgmessage('Intvalue is selected')
              call put_attr(hst % dimvars(i), &
                & attrs(j) % attrname, (/attrs(j) % Intvalue/) )
            endif
          elseif ( strhead( 'real', trim(lchar(attrs(j)%attrtype))) ) then
            if ( attrs(j)%array ) then
              call dbgmessage('Realarray(:) is selected.')
              call put_attr(hst % dimvars(i), &
                & attrs(j) % attrname, attrs(j) % Realarray )
            else
              call dbgmessage('Realvalue is selected')
              call put_attr(hst % dimvars(i), &
                & attrs(j) % attrname, (/attrs(j) % Realvalue/) )
            endif
          elseif ( strhead( 'double', trim(lchar(attrs(j)%attrtype))) ) then
            if ( attrs(j)%array ) then
              call dbgmessage('Doublearray(:) is selected.')
              call put_attr(hst % dimvars(i), &
                & attrs(j) % attrname, attrs(j) % Doublearray )
            else
              call dbgmessage('Doublevalue is selected')
              call put_attr(hst % dimvars(i), &
                & attrs(j) % attrname, (/attrs(j) % Doublevalue/) )
            endif
          elseif ( strhead( 'logical', trim(lchar(attrs(j)%attrtype))) ) then
            call put_attr(hst % dimvars(i), &
              & attrs(j) % attrname, attrs(j) % Logicalvalue )
          else
            call dbgmessage('attrtype=<%c>=<%c>is Invalid.'   , &
              &      c1=trim(attrs(j)%attrtype)         , &
              &      c2=trim(lchar(attrs(j)%attrtype))      )
          endif
        end do
      end if
    end do
    if ( .not. hst % mpi_fileinfo % quiet ) then
      call messagenotify('M', subname, &
        & '"%c" is created (origin=%c)', &
        & c1 = trim( hst % mpi_fileinfo % file ), &
        & c2 = trim( origin_str ) )
    end if
2000 continue
    hst % mpi_fileinfo % already_output = .true.
    ! 終了処理, 例外処理
    ! Termination and Exception handling
    !
999 continue
    call storeerror( stat, subname, err, cause_c )
    call endsub(subname)

References dc_trace::beginsub(), dc_trace::dbgmessage(), dc_error::dc_enotinit, dc_error::dc_noerr, gtool_history_internal::default, dc_types::dp, dc_trace::endsub(), dc_error::gt_ebaddimname, dc_error::storeerror(), and dc_types::string.

Here is the call graph for this function:

historyputaxismpireal()

subroutine historyputaxismpireal	(	character(*), intent(in)	varname,
		real, dimension(:), intent(in)	array,
		type(gt_history), intent(inout), optional, target	history,
		logical, intent(out), optional	err
	)

Definition at line 2341 of file historyput.f90.

    !
    ! MPI 使用時に, 各々のノード上のデータを単一ファイルに
    ! 集約して出力する場合には,
    ! このサブルーチンに領域全体の座標データを与えてください.
    ! また, HistoryCreate のオプショナル論理型引数 *flag_mpi_gather*
    ! に .true. を与えてください.
    !
    ! HistoryPut よりも後に使用してください
    ! HistoryAddVariable, HistoryAddAttr よりも前に使用してください.
    !
    ! When MPI is used, if data on each node is integrated and
    ! output to one file, give data of axes in whole area to
    ! this subroutine.
    ! And give .true. to optional logical argument *flag_mpi_gather*
    ! in "HistoryCreate".
    !
    ! Use this subroutine after "HistoryPut", and
    ! before "HistoryAddVariable", "HistoryAddAttr".
    !
    use gtool_history_generic, only: historyaxisinquire
    use gtdata_generic, only: create, put_attr, put
    use gtdata_types, only: gt_variable
    use dc_error, only: storeerror, dc_noerr, dc_enotinit, &
      & gt_ebaddimname
    use dc_url, only: urlmerge
    use dc_date_generic, only: evalbyunit
    use dc_date_types, only: dc_difftime
    use dc_string, only: tochar, lchar, strhead
    use dc_message, only: messagenotify
    use gtool_history_types, only: gt_history, gt_history_axis, gt_history_varinfo, gt_history_attr
    use gtool_history_internal, only: default
    use dc_trace, only: beginsub, endsub, dbgmessage
    use dc_types, only: string, dp
    implicit none
    character(*), intent(in):: varname
    real, intent(in):: array(:)
    type(GT_HISTORY), intent(inout), optional, target:: history
    logical, intent(out), optional:: err
    type(GT_HISTORY), pointer:: hst =>null()
    integer:: dimord, dimsize, numdims, i, j, attr_size
    type(GT_HISTORY_ATTR), pointer:: attrs(:) =>null()
    character(STRING):: dimname
    character(STRING):: name, longname, units, xtype, origin_str, url
    real(DP):: origin_work
    integer:: stat
    character(STRING):: cause_c
    character(*), parameter:: subname = "HistoryPutAxisMPIReal"
  continue
    call beginsub(subname, 'varname=%c', c1 = trim(varname) )
    stat = dc_noerr
    cause_c = ""
    if (present(history)) then
      hst => history
    else
      hst => default
    endif
    if ( .not. hst % initialized ) then
      stat = dc_enotinit
      cause_c = 'GT_HISTORY'
      goto 999
    end if
    call dbgmessage( 'mpi_gather=<%b>', l = (/ hst % mpi_gather /) )
    if ( .not. hst % mpi_gather ) then
      goto 999
    else
      numdims = size( hst % dimvars )
      dimord = -1
      do i = 1, numdims
        call historyaxisinquire( &
          & hst % mpi_fileinfo % axes(i), & ! (in)
          & name = dimname )                ! (out)
        if ( trim(varname) == trim(dimname) ) then
          dimord = i
          exit
        end if
      end do
      if ( dimord < 1 ) then
        stat = gt_ebaddimname
        cause_c = varname
        goto 999
      end if
      dimsize = size( array )
      if ( associated( hst % mpi_dimdata_all( dimord ) % a_Axis ) ) then
        deallocate( hst % mpi_dimdata_all( dimord ) % a_Axis )
      end if
      allocate( hst % mpi_dimdata_all( dimord ) % a_Axis(dimsize) )
      hst % mpi_dimdata_all( dimord ) % a_Axis = array
      hst % mpi_dimdata_all( dimord ) % length = dimsize
    end if
    ! 全ての (時刻以外の) 座標データが登録されたらファイル出力
    ! Output file if data of all axes (excluding time) are registered
    !
    numdims = size( hst % dimvars )
    do i = 1, numdims
      if ( hst % unlimited_index == i ) cycle
      if ( hst % time_nv_index == i ) cycle
      if ( hst % mpi_dimdata_all( i ) % length < 1 ) goto 999
    end do
    if ( hst % mpi_myrank /= 0 ) goto 2000
    if ( hst % mpi_fileinfo % already_output ) goto 999
    do i = 1, numdims
      call historyaxisinquire( hst % mpi_fileinfo % axes(i), & ! (in)
        & name, dimsize, longname, units, xtype )              ! (out)
      url = urlmerge(file = hst % mpi_fileinfo % file, var = name)
      ! 座標の長さを, このサブルーチンで取得したものに修正
      ! Length of axes is modified to one that is gotten by this subroutine
      !
      if ( hst % unlimited_index /= i ) then
        dimsize = hst % mpi_dimdata_all( i ) % length
      end if
      ! ファイル作成
      ! Create file
      !
      call create( &
        & hst % dimvars(i), trim(url), &
        & dimsize, xtype = xtype, &
        & overwrite = hst % mpi_fileinfo % overwrite )
      ! 属性の付加
      ! Add attributes
      !
      call put_attr(hst % dimvars(i), '+Conventions', trim(hst % mpi_fileinfo % conventions ))
      if ( hst % mpi_fileinfo % gtver_add ) then
        call put_attr(hst % dimvars(i), '+gt_version', trim(hst % mpi_fileinfo % gt_version ))
      endif
      ! title, source, institution, history, long_name, units 属性の付加
      call put_attr(hst % dimvars(i), '+title', hst % mpi_fileinfo % title)
      call put_attr(hst % dimvars(i), '+source', hst % mpi_fileinfo % source)
      call put_attr(hst % dimvars(i), '+institution', trim(hst % mpi_fileinfo % institution))
      call put_attr(hst % dimvars(i), '+history', trim(hst % mpi_fileinfo % nc_history))
      call put_attr(hst % dimvars(i), 'long_name', longname)
      call put_attr(hst % dimvars(i), 'units', units)
      origin_work = hst % origin
!      origin_work = EvalByUnit( hst % origin, '', hst % unlimited_units_symbol )
      origin_str = trim( tochar( origin_work ) ) // &
        &          ' [' // trim( hst % unlimited_units ) // ']'
      ! 座標データの出力
      ! Output data of axes
      !
      if ( hst % unlimited_index /= i ) then
        call put(hst % dimvars(i), &
          & hst % mpi_dimdata_all( i ) % a_Axis, dimsize )
        hst % dim_value_written(i) = .true.
      end if
      ! 座標の属性の付加
      ! Add attributes of axes
      !
      attrs => hst % mpi_dimdata_all(i) % attrs
      if ( associated( attrs ) ) then
        attr_size = size( attrs )
        do j = 1, attr_size
          if ( strhead( 'char', trim(lchar(attrs(j)%attrtype))) ) then
            call put_attr(hst % dimvars(i), &
              & attrs(j) % attrname, trim( attrs(j) % Charvalue ) )
          elseif ( strhead( 'int', trim(lchar(attrs(j)%attrtype))) ) then
            if ( attrs(j)%array ) then
              call dbgmessage('Intarray(:) is selected.')
              call put_attr(hst % dimvars(i), &
                & attrs(j) % attrname, attrs(j) % Intarray )
            else
              call dbgmessage('Intvalue is selected')
              call put_attr(hst % dimvars(i), &
                & attrs(j) % attrname, (/attrs(j) % Intvalue/) )
            endif
          elseif ( strhead( 'real', trim(lchar(attrs(j)%attrtype))) ) then
            if ( attrs(j)%array ) then
              call dbgmessage('Realarray(:) is selected.')
              call put_attr(hst % dimvars(i), &
                & attrs(j) % attrname, attrs(j) % Realarray )
            else
              call dbgmessage('Realvalue is selected')
              call put_attr(hst % dimvars(i), &
                & attrs(j) % attrname, (/attrs(j) % Realvalue/) )
            endif
          elseif ( strhead( 'double', trim(lchar(attrs(j)%attrtype))) ) then
            if ( attrs(j)%array ) then
              call dbgmessage('Doublearray(:) is selected.')
              call put_attr(hst % dimvars(i), &
                & attrs(j) % attrname, attrs(j) % Doublearray )
            else
              call dbgmessage('Doublevalue is selected')
              call put_attr(hst % dimvars(i), &
                & attrs(j) % attrname, (/attrs(j) % Doublevalue/) )
            endif
          elseif ( strhead( 'logical', trim(lchar(attrs(j)%attrtype))) ) then
            call put_attr(hst % dimvars(i), &
              & attrs(j) % attrname, attrs(j) % Logicalvalue )
          else
            call dbgmessage('attrtype=<%c>=<%c>is Invalid.'   , &
              &      c1=trim(attrs(j)%attrtype)         , &
              &      c2=trim(lchar(attrs(j)%attrtype))      )
          endif
        end do
      end if
    end do
    if ( .not. hst % mpi_fileinfo % quiet ) then
      call messagenotify('M', subname, &
        & '"%c" is created (origin=%c)', &
        & c1 = trim( hst % mpi_fileinfo % file ), &
        & c2 = trim( origin_str ) )
    end if
2000 continue
    hst % mpi_fileinfo % already_output = .true.
    ! 終了処理, 例外処理
    ! Termination and Exception handling
    !
999 continue
    call storeerror( stat, subname, err, cause_c )
    call endsub(subname)

References dc_trace::beginsub(), dc_trace::dbgmessage(), dc_error::dc_enotinit, dc_error::dc_noerr, gtool_history_internal::default, dc_types::dp, dc_trace::endsub(), dc_error::gt_ebaddimname, dc_error::storeerror(), and dc_types::string.

Here is the call graph for this function:

historyputchar0()

subroutine historyputchar0	(	character(*), intent(in)	varname,
		character(*), intent(in)	value,
		type(gt_history), intent(inout), optional, target	history,
		character(*), intent(in), optional	range,
		real, intent(in), optional	time,
		logical, intent(in), optional	quiet,
		type(dc_difftime), intent(in), optional	difftime,
		real(dp), intent(in), optional	timed,
		logical, intent(in), optional	time_average_store,
		logical, intent(out), optional	err
	)

Definition at line 4524 of file historyput.f90.

    !
    !
    use gtool_history_types, only: gt_history
    use dc_date_types, only: dc_difftime
    use dc_types, only: dp
    use dc_trace, only: beginsub, endsub, dbgmessage
    implicit none
    character(*), intent(in):: varname
    character(*), intent(in):: value
    type(GT_HISTORY), intent(inout), optional, target:: history
    character(*), intent(in), optional:: range
    real, intent(in), optional:: time
    logical, intent(in), optional:: quiet
    type(DC_DIFFTIME), intent(in), optional:: difftime
    real(DP), intent(in), optional:: timed
    logical, intent(in), optional:: time_average_store
    logical, intent(out), optional:: err
    interface historyputcharex
      subroutine historyputcharex( &
        & varname, array, arraysize, history, range, &
        & time, quiet, difftime, timed, time_average_store, err )
        use gtool_history_types, only: gt_history
        use dc_date_types, only: dc_difftime
        use dc_types, only: dp
        character(*), intent(in):: varname
        integer, intent(in):: arraysize
        character(*), intent(in):: array(arraysize)
        type(GT_HISTORY), intent(inout), target, optional:: history
        character(*), intent(in), optional:: range
        real, intent(in), optional:: time
        logical, intent(in), optional:: quiet
        type(DC_DIFFTIME), intent(in), optional:: difftime
        real(DP), intent(in), optional:: timed
        logical, intent(in), optional:: time_average_store
        logical, intent(out), optional:: err
      end subroutine historyputcharex
    end interface
    character(*), parameter:: subname = "HistoryPutChar0"
  continue
    call beginsub(subname)
    call historyputcharex( &
      & varname, &               ! (in)
      & (/value/), 1, &   ! (in)
      & history = history, &     ! (inout) optional
      & range = range, &         ! (in) optional
      & time = time, &           ! (in) optional
      & quiet = quiet, &         ! (in) optional
      & difftime = difftime, &   ! (in) optional
      & timed = timed, &         ! (in) optional
      & time_average_store = &
      &    time_average_store, & ! (in) optional
      & err = err )              ! (out) optional
    call endsub(subname)

References dc_trace::beginsub(), dc_trace::dbgmessage(), dc_types::dp, dc_trace::endsub(), and historyputcharex().

Here is the call graph for this function:

historyputcharex()

recursive subroutine historyputcharex	(	character(*), intent(in)	varname,
		character(*), dimension(arraysize), intent(in)	array,
		integer, intent(in)	arraysize,
		type(gt_history), intent(inout), optional, target	history,
		character(*), intent(in), optional	range,
		real, intent(in), optional	time,
		logical, intent(in), optional	quiet,
		type(dc_difftime), intent(in), optional	difftime,
		real(dp), intent(in), optional	timed,
		logical, intent(in), optional	time_average_store,
		logical, intent(out), optional	err
	)

データ出力

Parameters

[in]

varname

iline 1

こちらは配列サイズを指定する必要があるため、 HistoryPut を利用してください。

Definition at line 2053 of file historyput.f90.

    !
    !
    use gtool_history_types, only: gt_history
    use gtool_history_generic, only: historyaxisinquire
    use gtool_history_internal, only: default, lookup_variable_ord
    use gtool_history_internal, only: gtmpi_axis_register, gtmpi_vars_mkindex
    use gtdata_generic, only: put, gtvarsync, slice, inquire, &
      & get_slice, get, putline, open, close
    use gtdata_types, only: gt_variable
    use dc_types, only: string, dp
    use dc_string, only: stoa, printf, tochar, joinchar
    use dc_present, only: present_and_not_empty, present_select, &
      & present_and_false, present_and_true
    use dc_error, only: storeerror, dc_noerr, dc_enotinit, usr_errno
    use dc_message, only: messagenotify
    use dc_url, only: urlsplit, urlmerge
    use dc_date_types, only: dc_difftime
    use dc_date_generic, only: operator(==), dcdifftimecreate, &
      & mod, operator(-), evalbyunit, operator(/), tochar
    use dc_trace, only: beginsub, endsub, dbgmessage
    use mpi
    implicit none
    character(*), intent(in):: varname
    integer, intent(in):: arraysize
    character(*), intent(in):: array(arraysize)
    type(GT_HISTORY), intent(inout), target, optional:: history
    character(*), intent(in), optional:: range
                              ! gtool4 のコンマ記法による
                              ! データの出力範囲指定
                              !
                              ! このオプションを用いる
                              ! 際には、必ず *HistorySetTime*
                              ! によって明示的に時刻の設定
                              ! を行ってください。
                              ! また、*HistoryGet* と異なり、
                              ! 時刻に関する範囲指定は
                              ! 行なえません。
                              !
                              ! 書式に関する詳細は
                              ! {gtool4 netCDF 規約}[link:../xref.htm#label-6]
                              ! の「5.4 コンマ記法」を参照して
                              ! ください。
    real, intent(in), optional:: time
                              !
                              ! 時刻. (単精度実数型)
                              !
                              ! この引数を与える場合,
                              ! 出力するかどうかをプログラムが
                              ! 自動的に判断します.
                              ! *time* に与えられた数値が
                              ! HistoryCreate に与えた *interval*
                              ! で割り切れる場合には出力が行われます.
                              !
                              ! HistoryAddVariable で
                              ! *time_average* (または *average*)
                              ! に .true. を与えた場合には,
                              ! *time*, *difftime*
                              ! のどちらの引数も与えない場合に,
                              ! プログラムはエラーを発生させます.
                              !
                              ! また, この引数と *range* は併用できません.
                              ! 併用した場合には,
                              ! プログラムはエラーを発生させます.
                              !
    logical, intent(in), optional:: quiet
                              ! .false. を与えた場合,
                              ! このサブルーチンが呼ばれる毎に
                              ! ファイル名と時刻が表示されます.
                              ! デフォルトは .true. です.
                              !
                              ! If ".false." is given,
                              ! a filename and time is displayed
                              ! when this subroutine is called.
                              ! Default value is ".true.".
                              !
    type(DC_DIFFTIME), intent(in), optional:: difftime
                              !
                              ! 時刻 (dc_date_types::DC_DIFFTIME 型)
                              !
                              ! 効果は *time* と同様です.
                              !
    real(DP), intent(in), optional:: timed
                              !
                              ! 時刻 (倍精度実数型)
                              !
                              ! 効果は *time* と同様です.
                              !
    logical, intent(in), optional:: time_average_store
                              !
                              ! 平均値の出力フラグ.
                              ! この値に .true. を与えた場合には,
                              ! 出力せずに与えられた値を一旦蓄えます.
                              ! .false. を与えた場合には,
                              ! *time* もしくは *difftime* と
                              ! HistoryCreate に与えた *interval* に
                              ! 関わらず出力を行います.
                              !
                              ! HistoryAddVariable で
                              ! *time_average* (または *average*)
                              ! に .true. を与えない場合は無効です.
                              !
                              ! *time* と *difftime*
                              ! のどちらかを同時に与える必要があります.
                              !
    logical, intent(out), optional:: err
                              ! 例外処理用フラグ.
                              ! デフォルトでは, この手続き内でエラーが
                              ! 生じた場合, プログラムは強制終了します.
                              ! 引数 *err* が与えられる場合,
                              ! プログラムは強制終了せず, 代わりに
                              ! *err* に .true. が代入されます.
                              !
                              ! Exception handling flag.
                              ! By default, when error occur in
                              ! this procedure, the program aborts.
                              ! If this *err* argument is given,
                              ! .true. is substituted to *err* and
                              ! the program does not abort.
    type(GT_VARIABLE):: var, timevar
    character(STRING):: url, file, time_str
    real:: time_value(1:1)
    type(GT_HISTORY), pointer:: hst =>null()
    integer :: v_ord
    character(STRING):: avr_msg
    integer:: stat
    integer:: err_mpi
    character(STRING):: cause_c
    interface timegoahead
      subroutine timegoahead( varname, var, head, history, err )
        use gtdata_types, only: gt_variable
        use gtool_history_types, only: gt_history
        character(len = *), intent(in):: varname
        type(GT_VARIABLE), intent(out):: var
        real, intent(in):: head
        type(GT_HISTORY), intent(inout), optional, target:: history
        logical, intent(out), optional:: err
      end subroutine timegoahead
    end interface
    character(*), parameter:: subname = "HistoryPutCharEx"
  continue
    call beginsub(subname, 'varname=%a range=%a', &
      & ca=stoa(varname, present_select('', '(no-range)', range)))
    stat = dc_noerr
    cause_c = ""
    if (present(history)) then
      hst => history
    else
      hst => default
    endif
    !-----------------------------------------------------------------
    !  初期設定のチェック
    !  Check initialization
    !-----------------------------------------------------------------
    if ( .not. hst % initialized ) then
      stat = dc_enotinit
      cause_c = 'GT_HISTORY'
      goto 999
    end if
    !-----------------------------------------------------------------
    !  time と range の同時使用の禁止
    !  Permit concurrent use of "time" and "range"
    !-----------------------------------------------------------------
    if ( ( present(time) .or. present(difftime) .or. present(timed) ) &
      &  .and. present_and_not_empty(range) ) then
      call messagenotify('W', subname, &
        & '(varname=%c) "range" and "time" or "timed" or "difftime" are not suppored at the same time', &
        & c1 = trim(varname) )
      stat = usr_errno
      cause_c = '"range" and "time" or "timed" or "difftime" are not suppored at the same time'
      goto 999
    end if
    !-----------------------------------------------------------------
    !  hst 内の varname 変数の変数番号を取得
    !  Get variable number of "varname" in "hst"
    !-----------------------------------------------------------------
    if ( .not. hst % mpi_gather ) then
      v_ord = lookup_variable_ord(hst, varname)
    else
      if ( hst % mpi_myrank == 0 ) then
        v_ord = lookup_variable_ord(hst, varname)
      end if
      call mpi_bcast( v_ord, 1, mpi_integer, 0, mpi_comm_world, err_mpi )
      call dbgmessage('v_ord=<%d> is shared on all nodes.', i = (/v_ord/) )
    end if
                        if ( present(time_average_store) ) then
      continue
    end if
    !-----------------------------------------------------------------
    !  初期時刻の設定
    !  Configure initial time
    !-----------------------------------------------------------------
    if ( .not. hst % origin_setting ) then
      if ( present(difftime) ) then
        hst % origin         = evalbyunit( difftime, '', hst % unlimited_units_symbol )
        hst % time_bnds      = evalbyunit( difftime, '', hst % unlimited_units_symbol )
        hst % origin_setting = .true.
      elseif ( present(timed) ) then
        hst % origin         = timed
        hst % time_bnds      = timed
        hst % origin_setting = .true.
      elseif ( present(time) ) then
        hst % origin         = time
        hst % time_bnds      = time
        hst % origin_setting = .true.
      end if
!!$      if ( present(difftime) ) then
!!$        hst % origin         = difftime
!!$        hst % time_bnds      = EvalByUnit( difftime, '', hst % unlimited_units_symbol )
!!$        hst % origin_setting = .true.
!!$      elseif ( present(timed) ) then
!!$        call DCDiffTimeCreate( hst % origin, &              ! (out)
!!$          & real(timed), '', hst % unlimited_units_symbol ) ! (in)
!!$        hst % time_bnds      = timed
!!$        hst % origin_setting = .true.
!!$      elseif ( present(time) ) then
!!$        call DCDiffTimeCreate( hst % origin, &       ! (out)
!!$          & time, '', hst % unlimited_units_symbol ) ! (in)
!!$        hst % time_bnds      = time
!!$        hst % origin_setting = .true.
!!$      end if
    end if
                        avr_msg = ''
    !-----------------------------------------------------------------
    !  時刻を1つ進めて, データ出力
    !  Progress one time, and output data
    !-----------------------------------------------------------------
    if ( .not. hst % mpi_gather &
      &  .or. ( hst % mpi_gather    .and. &
      &         hst % mpi_myrank == 0 .and. &
      &         hst % mpi_fileinfo % already_output) ) then
    call timegoahead( &
      & varname = varname, &     ! (in)
                          & head = 0.0, &            ! (in)
      & var = var, &             ! (out)
      & history = history, &     ! (inout)
      & err = err )              ! (out)
                        if (present_and_not_empty(range)) then
      call dbgmessage('varname=<%c> is string. so range is ignoread.', &
      & c1=trim(varname))
    end if
    call put(var, array, arraysize)
    call gtvarsync(var)
    end if
    !-----------------------------------------------------------------
    !  メッセージ出力
    !  Output messages
    !-----------------------------------------------------------------
    if ( .not. hst % mpi_gather &
      &  .or. ( hst % mpi_gather    .and. &
      &         hst % mpi_myrank == 0 .and. &
      &         hst % mpi_fileinfo % already_output ) ) then
    if ( present_and_false(quiet) ) then
      call inquire( hst % dimvars(1), & ! (in)
        & url = url )                   ! (out)
      call urlsplit( fullname = url, &  ! (in)
        & file = file )                 ! (out)
      if ( hst % unlimited_index < 1 ) then
        time_str = ''
      else
        timevar = hst % dimvars(hst % unlimited_index)
        call slice( timevar, &                     ! (in)
          & 1, start = hst % count(v_ord), count = 1 ) ! (in)
        call get( timevar, & ! (inout)
          & time_value, &    ! (out)
          & 1, &             ! (in)
          & err )            ! (out)
        time_str = '(time=' // trim( tochar( time_value(1) )) // ')'
      end if
      call messagenotify('M', 'HistoryPut', &
        & '"%a" => "%a" %a %a', &
        & ca = stoa( varname, file, time_str, avr_msg ) )
    end if
    end if
    !-----------------------------------------------------------------
    !  終了処理, 例外処理
    !  Termination and Exception handling
    !-----------------------------------------------------------------
999 continue
    call storeerror( stat, subname, err, cause_c )
    call endsub(subname)

References dc_trace::beginsub(), dc_trace::dbgmessage(), dc_error::dc_enotinit, dc_error::dc_noerr, gtool_history_internal::default, dc_types::dp, dc_trace::endsub(), dc_string::joinchar(), dc_present::present_and_false(), dc_present::present_and_not_empty(), dc_present::present_and_true(), dc_error::storeerror(), dc_types::string, timegoahead(), and dc_error::usr_errno.

Here is the call graph for this function:

historyputdouble0()

subroutine historyputdouble0	(	character(*), intent(in)	varname,
		real(dp), intent(in)	value,
		type(gt_history), intent(inout), optional, target	history,
		character(*), intent(in), optional	range,
		real, intent(in), optional	time,
		logical, intent(in), optional	quiet,
		type(dc_difftime), intent(in), optional	difftime,
		real(dp), intent(in), optional	timed,
		logical, intent(in), optional	time_average_store,
		logical, intent(out), optional	err
	)

データ出力

Parameters

[in]

varname

iline 1

gtool4 データ内の変数へデータの出力を行います。 このサブルーチンを用いる前に、HistoryCreate による初期設定が必要です。

HistoryPut は複数のサブルーチンの総称名です。value に 変数 (整数型、単精度実数型、倍精度実数型、文字型) もしくは 1 〜 7 次元の配列 (整数型、単精度実数型、倍精度実数型) を与えることが可能です。 下記の同名のサブルーチンを参照ください。 ただし、多次元配列を与える際の引数キーワードには array を用いてください。

HistoryPut を最初に呼んだ時、時間次元の変数は HistoryCreate の origin の値に設定されます。

ある変数 varname に対して HistoryPut を複数回呼ぶと、 HistoryCreate の interval × HistoryPut を呼んだ回数、 の分だけ 時間次元の変数の値が増やされます。 ただし、時間平均値を出力する場合は例外です。 以下の時間平均に関する項目を参照ください。

これらの時間次元の変数の値を明示的に設定したい場合は HistorySetTime を用いるか、HistoryPut 自身で時間次元の変数へ値 を出力してください。

時間平均について

時間平均については HistoryAddVariable を参照ください。

Definition at line 3015 of file historyput.f90.

    !
                                            !
    !
    !
    use gtool_history_types, only: gt_history
    use dc_date_types, only: dc_difftime
    use dc_types, only: dp
    use dc_trace, only: beginsub, endsub, dbgmessage
    implicit none
    character(*), intent(in):: varname
                                                                      ! 変数の名前
                              !
                              ! ただし、ここで指定するもの
                              ! は、 HistoryCreateの *dims*
                              ! または HistoryAddVariable や
                              ! HistoryCopyVariable の
                              ! *varname* で既に指定されてい
                              ! なければなりません。
                              !
    real(DP), intent(in):: value
                                                                      ! 変数が出力するデータ
                              !
                              ! 型は単精度実数型でも
                              ! 倍精度実数型でもよいですが、
                              ! HistoryAddVariable の
                              ! *xtype* で指定した
                              ! データ型と異なる
                              ! 型を渡した場合、xtype で
                              ! 指定した型に変換されます。
                              !
    type(GT_HISTORY), intent(inout), optional, target:: history
                                                                      ! 出力ファイルの設定に関する情報を
                              ! 格納した構造体
                              !
                              ! ここに指定するものは、
                              ! HistoryCreate によって初期設定
                              ! されていなければなりません。
                              !
    character(*), intent(in), optional:: range
                                                                      ! gtool4 のコンマ記法による
                              ! データの出力範囲指定
                              !
                              ! このオプションを用いる
                              ! 際には、必ず *HistorySetTime*
                              ! によって明示的に時刻の設定
                              ! を行ってください。
                              ! また、*HistoryGet* と異なり、
                              ! 時刻に関する範囲指定は
                              ! 行なえません。
                              !
                              ! 書式に関する詳細は
                              ! {gtool4 netCDF 規約}[link:../xref.htm#label-6]
                              ! の「5.4 コンマ記法」を参照して
                              ! ください。
    real, intent(in), optional:: time
                                                                      !
                              ! 時刻. (単精度実数型)
                              !
                              ! この引数を与える場合,
                              ! 出力するかどうかをプログラムが
                              ! 自動的に判断します.
                              ! *time* に与えられた数値が
                              ! HistoryCreate に与えた *interval*
                              ! で割り切れる場合には出力が行われます.
                              !
                              ! HistoryAddVariable で
                              ! *time_average* (または *average*)
                              ! に .true. を与えた場合には,
                              ! *time*, *difftime*
                              ! のどちらの引数も与えない場合に,
                              ! プログラムはエラーを発生させます.
                              !
                              ! この引数と *difftime*, *time_average_store*
                              ! が同時に与えられた場合,
                              ! *time_average_store* が優先されます.
                              !
                              ! また, この引数と *range* は併用できません.
                              ! 併用した場合には,
                              ! プログラムはエラーを発生させます.
                              !
    logical, intent(in), optional:: quiet
                                                                      ! .true. を与えた場合,
                              ! メッセージ出力が抑制されます.
                              !
                              ! If ".true." is given,
                              ! messages are suppressed.
                              !
    type(DC_DIFFTIME), intent(in), optional:: difftime
                                                                      !
                              ! 時刻 (dc_date_types::DC_DIFFTIME 型)
                              !
                              ! 効果は *time* と同様です.
    real(DP), intent(in), optional:: timed
                                                                      !
                              ! 時刻 (倍精度実数型)
                              !
                              ! 効果は *time* と同様です.
    logical, intent(in), optional:: time_average_store
                                                                      !
                              ! 平均値の出力フラグ.
                              ! この値に .true. を与えた場合には,
                              ! 出力せずに与えられた値を一旦蓄えます.
                              ! .false. を与えた場合には,
                              ! *time* もしくは *difftime* と
                              ! HistoryCreate に与えた *interval* に
                              ! 関わらず出力を行います.
                              !
                              ! HistoryAddVariable で
                              ! *time_average* (または *average*)
                              ! に .true. を与えない場合は無効です.
                              !
                              ! *time* と *difftime*
                              ! のどちらかを同時に与える必要があります.
                              !
    logical, intent(out), optional:: err
                                                                      ! 例外処理用フラグ.
                              ! デフォルトでは, この手続き内でエラーが
                              ! 生じた場合, プログラムは強制終了します.
                              ! 引数 *err* が与えられる場合,
                              ! プログラムは強制終了せず, 代わりに
                              ! *err* に .true. が代入されます.
                              !
                              ! Exception handling flag.
                              ! By default, when error occur in
                              ! this procedure, the program aborts.
                              ! If this *err* argument is given,
                              ! .true. is substituted to *err* and
                              ! the program does not abort.
    interface historyputdoubleex
      subroutine historyputdoubleex( &
        & varname, array, arraysize, history, range, &
        & time, quiet, difftime, timed, time_average_store, err )
        use gtool_history_types, only: gt_history
        use dc_date_types, only: dc_difftime
        use dc_types, only: dp
        character(*), intent(in):: varname
        integer, intent(in):: arraysize
        real(DP), intent(in):: array(arraysize)
        type(GT_HISTORY), intent(inout), target, optional:: history
        character(*), intent(in), optional:: range
        real, intent(in), optional:: time
        logical, intent(in), optional:: quiet
        type(DC_DIFFTIME), intent(in), optional:: difftime
        real(DP), intent(in), optional:: timed
        logical, intent(in), optional:: time_average_store
        logical, intent(out), optional:: err
      end subroutine historyputdoubleex
    end interface
    character(*), parameter:: subname = "HistoryPutDouble0"
  continue
    call beginsub(subname)
    call historyputdoubleex( &
      & varname, &               ! (in)
      & (/value/), 1, &   ! (in)
      & history = history, &     ! (inout) optional
      & range = range, &         ! (in) optional
      & time = time, &           ! (in) optional
      & quiet = quiet, &         ! (in) optional
      & difftime = difftime, &   ! (in) optional
      & timed = timed, &         ! (in) optional
      & time_average_store = &
      &    time_average_store, & ! (in) optional
      & err = err )              ! (out) optional
    call endsub(subname)

References dc_trace::beginsub(), dc_trace::dbgmessage(), dc_types::dp, dc_trace::endsub(), and historyputdoubleex().

Here is the call graph for this function:

historyputdouble1()

subroutine historyputdouble1	(	character(*), intent(in)	varname,
		real(dp), dimension(:), intent(in)	array,
		type(gt_history), intent(inout), optional, target	history,
		character(*), intent(in), optional	range,
		real, intent(in), optional	time,
		logical, intent(in), optional	quiet,
		type(dc_difftime), intent(in), optional	difftime,
		real(dp), intent(in), optional	timed,
		logical, intent(in), optional	time_average_store,
		logical, intent(out), optional	err
	)

Definition at line 3213 of file historyput.f90.

    !
    !
    use gtool_history_types, only: gt_history
    use dc_date_types, only: dc_difftime
    use dc_types, only: dp
    use dc_trace, only: beginsub, endsub, dbgmessage
    implicit none
    character(*), intent(in):: varname
    real(DP), intent(in):: array(:)
    type(GT_HISTORY), intent(inout), optional, target:: history
    character(*), intent(in), optional:: range
    real, intent(in), optional:: time
    logical, intent(in), optional:: quiet
    type(DC_DIFFTIME), intent(in), optional:: difftime
    real(DP), intent(in), optional:: timed
    logical, intent(in), optional:: time_average_store
    logical, intent(out), optional:: err
    interface historyputdoubleex
      subroutine historyputdoubleex( &
        & varname, array, arraysize, history, range, &
        & time, quiet, difftime, timed, time_average_store, err )
        use gtool_history_types, only: gt_history
        use dc_date_types, only: dc_difftime
        use dc_types, only: dp
        character(*), intent(in):: varname
        integer, intent(in):: arraysize
        real(DP), intent(in):: array(arraysize)
        type(GT_HISTORY), intent(inout), target, optional:: history
        character(*), intent(in), optional:: range
        real, intent(in), optional:: time
        logical, intent(in), optional:: quiet
        type(DC_DIFFTIME), intent(in), optional:: difftime
        real(DP), intent(in), optional:: timed
        logical, intent(in), optional:: time_average_store
        logical, intent(out), optional:: err
      end subroutine historyputdoubleex
    end interface
    character(*), parameter:: subname = "HistoryPutDouble1"
  continue
    call beginsub(subname)
    call historyputdoubleex( &
      & varname, &               ! (in)
      & pack(array, .true.), size(array), &   ! (in)
      & history = history, &     ! (inout) optional
      & range = range, &         ! (in) optional
      & time = time, &           ! (in) optional
      & quiet = quiet, &         ! (in) optional
      & difftime = difftime, &   ! (in) optional
      & timed = timed, &         ! (in) optional
      & time_average_store = &
      &    time_average_store, & ! (in) optional
      & err = err )              ! (out) optional
    call endsub(subname)

References dc_trace::beginsub(), dc_trace::dbgmessage(), dc_types::dp, dc_trace::endsub(), and historyputdoubleex().

Here is the call graph for this function:

historyputdouble2()

subroutine historyputdouble2	(	character(*), intent(in)	varname,
		real(dp), dimension(:,:), intent(in)	array,
		type(gt_history), intent(inout), optional, target	history,
		character(*), intent(in), optional	range,
		real, intent(in), optional	time,
		logical, intent(in), optional	quiet,
		type(dc_difftime), intent(in), optional	difftime,
		real(dp), intent(in), optional	timed,
		logical, intent(in), optional	time_average_store,
		logical, intent(out), optional	err
	)

Definition at line 3270 of file historyput.f90.

    !
    !
    use gtool_history_types, only: gt_history
    use dc_date_types, only: dc_difftime
    use dc_types, only: dp
    use dc_trace, only: beginsub, endsub, dbgmessage
    implicit none
    character(*), intent(in):: varname
    real(DP), intent(in):: array(:,:)
    type(GT_HISTORY), intent(inout), optional, target:: history
    character(*), intent(in), optional:: range
    real, intent(in), optional:: time
    logical, intent(in), optional:: quiet
    type(DC_DIFFTIME), intent(in), optional:: difftime
    real(DP), intent(in), optional:: timed
    logical, intent(in), optional:: time_average_store
    logical, intent(out), optional:: err
    interface historyputdoubleex
      subroutine historyputdoubleex( &
        & varname, array, arraysize, history, range, &
        & time, quiet, difftime, timed, time_average_store, err )
        use gtool_history_types, only: gt_history
        use dc_date_types, only: dc_difftime
        use dc_types, only: dp
        character(*), intent(in):: varname
        integer, intent(in):: arraysize
        real(DP), intent(in):: array(arraysize)
        type(GT_HISTORY), intent(inout), target, optional:: history
        character(*), intent(in), optional:: range
        real, intent(in), optional:: time
        logical, intent(in), optional:: quiet
        type(DC_DIFFTIME), intent(in), optional:: difftime
        real(DP), intent(in), optional:: timed
        logical, intent(in), optional:: time_average_store
        logical, intent(out), optional:: err
      end subroutine historyputdoubleex
    end interface
    character(*), parameter:: subname = "HistoryPutDouble2"
  continue
    call beginsub(subname)
    call historyputdoubleex( &
      & varname, &               ! (in)
      & pack(array, .true.), size(array), &   ! (in)
      & history = history, &     ! (inout) optional
      & range = range, &         ! (in) optional
      & time = time, &           ! (in) optional
      & quiet = quiet, &         ! (in) optional
      & difftime = difftime, &   ! (in) optional
      & timed = timed, &         ! (in) optional
      & time_average_store = &
      &    time_average_store, & ! (in) optional
      & err = err )              ! (out) optional
    call endsub(subname)

References dc_trace::beginsub(), dc_trace::dbgmessage(), dc_types::dp, dc_trace::endsub(), and historyputdoubleex().

Here is the call graph for this function:

historyputdouble3()

subroutine historyputdouble3	(	character(*), intent(in)	varname,
		real(dp), dimension(:,:,:), intent(in)	array,
		type(gt_history), intent(inout), optional, target	history,
		character(*), intent(in), optional	range,
		real, intent(in), optional	time,
		logical, intent(in), optional	quiet,
		type(dc_difftime), intent(in), optional	difftime,
		real(dp), intent(in), optional	timed,
		logical, intent(in), optional	time_average_store,
		logical, intent(out), optional	err
	)

Definition at line 3327 of file historyput.f90.

    !
    !
    use gtool_history_types, only: gt_history
    use dc_date_types, only: dc_difftime
    use dc_types, only: dp
    use dc_trace, only: beginsub, endsub, dbgmessage
    implicit none
    character(*), intent(in):: varname
    real(DP), intent(in):: array(:,:,:)
    type(GT_HISTORY), intent(inout), optional, target:: history
    character(*), intent(in), optional:: range
    real, intent(in), optional:: time
    logical, intent(in), optional:: quiet
    type(DC_DIFFTIME), intent(in), optional:: difftime
    real(DP), intent(in), optional:: timed
    logical, intent(in), optional:: time_average_store
    logical, intent(out), optional:: err
    interface historyputdoubleex
      subroutine historyputdoubleex( &
        & varname, array, arraysize, history, range, &
        & time, quiet, difftime, timed, time_average_store, err )
        use gtool_history_types, only: gt_history
        use dc_date_types, only: dc_difftime
        use dc_types, only: dp
        character(*), intent(in):: varname
        integer, intent(in):: arraysize
        real(DP), intent(in):: array(arraysize)
        type(GT_HISTORY), intent(inout), target, optional:: history
        character(*), intent(in), optional:: range
        real, intent(in), optional:: time
        logical, intent(in), optional:: quiet
        type(DC_DIFFTIME), intent(in), optional:: difftime
        real(DP), intent(in), optional:: timed
        logical, intent(in), optional:: time_average_store
        logical, intent(out), optional:: err
      end subroutine historyputdoubleex
    end interface
    character(*), parameter:: subname = "HistoryPutDouble3"
  continue
    call beginsub(subname)
    call historyputdoubleex( &
      & varname, &               ! (in)
      & pack(array, .true.), size(array), &   ! (in)
      & history = history, &     ! (inout) optional
      & range = range, &         ! (in) optional
      & time = time, &           ! (in) optional
      & quiet = quiet, &         ! (in) optional
      & difftime = difftime, &   ! (in) optional
      & timed = timed, &         ! (in) optional
      & time_average_store = &
      &    time_average_store, & ! (in) optional
      & err = err )              ! (out) optional
    call endsub(subname)

References dc_trace::beginsub(), dc_trace::dbgmessage(), dc_types::dp, dc_trace::endsub(), and historyputdoubleex().

Here is the call graph for this function:

historyputdouble4()

subroutine historyputdouble4	(	character(*), intent(in)	varname,
		real(dp), dimension(:,:,:,:), intent(in)	array,
		type(gt_history), intent(inout), optional, target	history,
		character(*), intent(in), optional	range,
		real, intent(in), optional	time,
		logical, intent(in), optional	quiet,
		type(dc_difftime), intent(in), optional	difftime,
		real(dp), intent(in), optional	timed,
		logical, intent(in), optional	time_average_store,
		logical, intent(out), optional	err
	)

Definition at line 3384 of file historyput.f90.

    !
    !
    use gtool_history_types, only: gt_history
    use dc_date_types, only: dc_difftime
    use dc_types, only: dp
    use dc_trace, only: beginsub, endsub, dbgmessage
    implicit none
    character(*), intent(in):: varname
    real(DP), intent(in):: array(:,:,:,:)
    type(GT_HISTORY), intent(inout), optional, target:: history
    character(*), intent(in), optional:: range
    real, intent(in), optional:: time
    logical, intent(in), optional:: quiet
    type(DC_DIFFTIME), intent(in), optional:: difftime
    real(DP), intent(in), optional:: timed
    logical, intent(in), optional:: time_average_store
    logical, intent(out), optional:: err
    interface historyputdoubleex
      subroutine historyputdoubleex( &
        & varname, array, arraysize, history, range, &
        & time, quiet, difftime, timed, time_average_store, err )
        use gtool_history_types, only: gt_history
        use dc_date_types, only: dc_difftime
        use dc_types, only: dp
        character(*), intent(in):: varname
        integer, intent(in):: arraysize
        real(DP), intent(in):: array(arraysize)
        type(GT_HISTORY), intent(inout), target, optional:: history
        character(*), intent(in), optional:: range
        real, intent(in), optional:: time
        logical, intent(in), optional:: quiet
        type(DC_DIFFTIME), intent(in), optional:: difftime
        real(DP), intent(in), optional:: timed
        logical, intent(in), optional:: time_average_store
        logical, intent(out), optional:: err
      end subroutine historyputdoubleex
    end interface
    character(*), parameter:: subname = "HistoryPutDouble4"
  continue
    call beginsub(subname)
    call historyputdoubleex( &
      & varname, &               ! (in)
      & pack(array, .true.), size(array), &   ! (in)
      & history = history, &     ! (inout) optional
      & range = range, &         ! (in) optional
      & time = time, &           ! (in) optional
      & quiet = quiet, &         ! (in) optional
      & difftime = difftime, &   ! (in) optional
      & timed = timed, &         ! (in) optional
      & time_average_store = &
      &    time_average_store, & ! (in) optional
      & err = err )              ! (out) optional
    call endsub(subname)

References dc_trace::beginsub(), dc_trace::dbgmessage(), dc_types::dp, dc_trace::endsub(), and historyputdoubleex().

Here is the call graph for this function:

historyputdouble5()

subroutine historyputdouble5	(	character(*), intent(in)	varname,
		real(dp), dimension(:,:,:,:,:), intent(in)	array,
		type(gt_history), intent(inout), optional, target	history,
		character(*), intent(in), optional	range,
		real, intent(in), optional	time,
		logical, intent(in), optional	quiet,
		type(dc_difftime), intent(in), optional	difftime,
		real(dp), intent(in), optional	timed,
		logical, intent(in), optional	time_average_store,
		logical, intent(out), optional	err
	)

Definition at line 3441 of file historyput.f90.

    !
    !
    use gtool_history_types, only: gt_history
    use dc_date_types, only: dc_difftime
    use dc_types, only: dp
    use dc_trace, only: beginsub, endsub, dbgmessage
    implicit none
    character(*), intent(in):: varname
    real(DP), intent(in):: array(:,:,:,:,:)
    type(GT_HISTORY), intent(inout), optional, target:: history
    character(*), intent(in), optional:: range
    real, intent(in), optional:: time
    logical, intent(in), optional:: quiet
    type(DC_DIFFTIME), intent(in), optional:: difftime
    real(DP), intent(in), optional:: timed
    logical, intent(in), optional:: time_average_store
    logical, intent(out), optional:: err
    interface historyputdoubleex
      subroutine historyputdoubleex( &
        & varname, array, arraysize, history, range, &
        & time, quiet, difftime, timed, time_average_store, err )
        use gtool_history_types, only: gt_history
        use dc_date_types, only: dc_difftime
        use dc_types, only: dp
        character(*), intent(in):: varname
        integer, intent(in):: arraysize
        real(DP), intent(in):: array(arraysize)
        type(GT_HISTORY), intent(inout), target, optional:: history
        character(*), intent(in), optional:: range
        real, intent(in), optional:: time
        logical, intent(in), optional:: quiet
        type(DC_DIFFTIME), intent(in), optional:: difftime
        real(DP), intent(in), optional:: timed
        logical, intent(in), optional:: time_average_store
        logical, intent(out), optional:: err
      end subroutine historyputdoubleex
    end interface
    character(*), parameter:: subname = "HistoryPutDouble5"
  continue
    call beginsub(subname)
    call historyputdoubleex( &
      & varname, &               ! (in)
      & pack(array, .true.), size(array), &   ! (in)
      & history = history, &     ! (inout) optional
      & range = range, &         ! (in) optional
      & time = time, &           ! (in) optional
      & quiet = quiet, &         ! (in) optional
      & difftime = difftime, &   ! (in) optional
      & timed = timed, &         ! (in) optional
      & time_average_store = &
      &    time_average_store, & ! (in) optional
      & err = err )              ! (out) optional
    call endsub(subname)

References dc_trace::beginsub(), dc_trace::dbgmessage(), dc_types::dp, dc_trace::endsub(), and historyputdoubleex().

Here is the call graph for this function:

historyputdouble6()

subroutine historyputdouble6	(	character(*), intent(in)	varname,
		real(dp), dimension(:,:,:,:,:,:), intent(in)	array,
		type(gt_history), intent(inout), optional, target	history,
		character(*), intent(in), optional	range,
		real, intent(in), optional	time,
		logical, intent(in), optional	quiet,
		type(dc_difftime), intent(in), optional	difftime,
		real(dp), intent(in), optional	timed,
		logical, intent(in), optional	time_average_store,
		logical, intent(out), optional	err
	)

Definition at line 3498 of file historyput.f90.

    !
    !
    use gtool_history_types, only: gt_history
    use dc_date_types, only: dc_difftime
    use dc_types, only: dp
    use dc_trace, only: beginsub, endsub, dbgmessage
    implicit none
    character(*), intent(in):: varname
    real(DP), intent(in):: array(:,:,:,:,:,:)
    type(GT_HISTORY), intent(inout), optional, target:: history
    character(*), intent(in), optional:: range
    real, intent(in), optional:: time
    logical, intent(in), optional:: quiet
    type(DC_DIFFTIME), intent(in), optional:: difftime
    real(DP), intent(in), optional:: timed
    logical, intent(in), optional:: time_average_store
    logical, intent(out), optional:: err
    interface historyputdoubleex
      subroutine historyputdoubleex( &
        & varname, array, arraysize, history, range, &
        & time, quiet, difftime, timed, time_average_store, err )
        use gtool_history_types, only: gt_history
        use dc_date_types, only: dc_difftime
        use dc_types, only: dp
        character(*), intent(in):: varname
        integer, intent(in):: arraysize
        real(DP), intent(in):: array(arraysize)
        type(GT_HISTORY), intent(inout), target, optional:: history
        character(*), intent(in), optional:: range
        real, intent(in), optional:: time
        logical, intent(in), optional:: quiet
        type(DC_DIFFTIME), intent(in), optional:: difftime
        real(DP), intent(in), optional:: timed
        logical, intent(in), optional:: time_average_store
        logical, intent(out), optional:: err
      end subroutine historyputdoubleex
    end interface
    character(*), parameter:: subname = "HistoryPutDouble6"
  continue
    call beginsub(subname)
    call historyputdoubleex( &
      & varname, &               ! (in)
      & pack(array, .true.), size(array), &   ! (in)
      & history = history, &     ! (inout) optional
      & range = range, &         ! (in) optional
      & time = time, &           ! (in) optional
      & quiet = quiet, &         ! (in) optional
      & difftime = difftime, &   ! (in) optional
      & timed = timed, &         ! (in) optional
      & time_average_store = &
      &    time_average_store, & ! (in) optional
      & err = err )              ! (out) optional
    call endsub(subname)

References dc_trace::beginsub(), dc_trace::dbgmessage(), dc_types::dp, dc_trace::endsub(), and historyputdoubleex().

Here is the call graph for this function:

historyputdouble7()

subroutine historyputdouble7	(	character(*), intent(in)	varname,
		real(dp), dimension(:,:,:,:,:,:,:), intent(in)	array,
		type(gt_history), intent(inout), optional, target	history,
		character(*), intent(in), optional	range,
		real, intent(in), optional	time,
		logical, intent(in), optional	quiet,
		type(dc_difftime), intent(in), optional	difftime,
		real(dp), intent(in), optional	timed,
		logical, intent(in), optional	time_average_store,
		logical, intent(out), optional	err
	)

Definition at line 3555 of file historyput.f90.

    !
    !
    use gtool_history_types, only: gt_history
    use dc_date_types, only: dc_difftime
    use dc_types, only: dp
    use dc_trace, only: beginsub, endsub, dbgmessage
    implicit none
    character(*), intent(in):: varname
    real(DP), intent(in):: array(:,:,:,:,:,:,:)
    type(GT_HISTORY), intent(inout), optional, target:: history
    character(*), intent(in), optional:: range
    real, intent(in), optional:: time
    logical, intent(in), optional:: quiet
    type(DC_DIFFTIME), intent(in), optional:: difftime
    real(DP), intent(in), optional:: timed
    logical, intent(in), optional:: time_average_store
    logical, intent(out), optional:: err
    interface historyputdoubleex
      subroutine historyputdoubleex( &
        & varname, array, arraysize, history, range, &
        & time, quiet, difftime, timed, time_average_store, err )
        use gtool_history_types, only: gt_history
        use dc_date_types, only: dc_difftime
        use dc_types, only: dp
        character(*), intent(in):: varname
        integer, intent(in):: arraysize
        real(DP), intent(in):: array(arraysize)
        type(GT_HISTORY), intent(inout), target, optional:: history
        character(*), intent(in), optional:: range
        real, intent(in), optional:: time
        logical, intent(in), optional:: quiet
        type(DC_DIFFTIME), intent(in), optional:: difftime
        real(DP), intent(in), optional:: timed
        logical, intent(in), optional:: time_average_store
        logical, intent(out), optional:: err
      end subroutine historyputdoubleex
    end interface
    character(*), parameter:: subname = "HistoryPutDouble7"
  continue
    call beginsub(subname)
    call historyputdoubleex( &
      & varname, &               ! (in)
      & pack(array, .true.), size(array), &   ! (in)
      & history = history, &     ! (inout) optional
      & range = range, &         ! (in) optional
      & time = time, &           ! (in) optional
      & quiet = quiet, &         ! (in) optional
      & difftime = difftime, &   ! (in) optional
      & timed = timed, &         ! (in) optional
      & time_average_store = &
      &    time_average_store, & ! (in) optional
      & err = err )              ! (out) optional
    call endsub(subname)

References dc_trace::beginsub(), dc_trace::dbgmessage(), dc_types::dp, dc_trace::endsub(), and historyputdoubleex().

Here is the call graph for this function:

historyputdoubleex()

recursive subroutine historyputdoubleex	(	character(*), intent(in)	varname,
		real(dp), dimension(arraysize), intent(in)	array,
		integer, intent(in)	arraysize,
		type(gt_history), intent(inout), optional, target	history,
		character(*), intent(in), optional	range,
		real, intent(in), optional	time,
		logical, intent(in), optional	quiet,
		type(dc_difftime), intent(in), optional	difftime,
		real(dp), intent(in), optional	timed,
		logical, intent(in), optional	time_average_store,
		logical, intent(out), optional	err
	)

データ出力

Parameters

[in]

varname

iline 1

こちらは配列サイズを指定する必要があるため、 HistoryPut を利用してください。

Definition at line 709 of file historyput.f90.

    !
    !
    use gtool_history_types, only: gt_history
    use gtool_history_generic, only: historyaxisinquire
    use gtool_history_internal, only: default, lookup_variable_ord
    use gtool_history_internal, only: gtmpi_axis_register, gtmpi_vars_mkindex
    use gtdata_generic, only: put, gtvarsync, slice, inquire, &
      & get_slice, get, putline, open, close
    use gtdata_types, only: gt_variable
    use dc_types, only: string, dp, dp_eps
    use dc_string, only: stoa, printf, tochar, joinchar
    use dc_present, only: present_and_not_empty, present_select, &
      & present_and_false, present_and_true
    use dc_error, only: storeerror, dc_noerr, dc_enotinit, usr_errno, dc_earglack, gt_eargsizemismatch
    use dc_message, only: messagenotify
    use dc_url, only: urlsplit, urlmerge
    use dc_date_types, only: dc_difftime
    use dc_date_generic, only: operator(==), dcdifftimecreate, &
      & mod, operator(-), evalbyunit, operator(/), tochar
    use dc_trace, only: beginsub, endsub, dbgmessage
    use mpi
    implicit none
    character(*), intent(in):: varname
    integer, intent(in):: arraysize
    real(DP), intent(in):: array(arraysize)
    type(GT_HISTORY), intent(inout), target, optional:: history
    character(*), intent(in), optional:: range
                              ! gtool4 のコンマ記法による
                              ! データの出力範囲指定
                              !
                              ! このオプションを用いる
                              ! 際には、必ず *HistorySetTime*
                              ! によって明示的に時刻の設定
                              ! を行ってください。
                              ! また、*HistoryGet* と異なり、
                              ! 時刻に関する範囲指定は
                              ! 行なえません。
                              !
                              ! 書式に関する詳細は
                              ! {gtool4 netCDF 規約}[link:../xref.htm#label-6]
                              ! の「5.4 コンマ記法」を参照して
                              ! ください。
    real, intent(in), optional:: time
                              !
                              ! 時刻. (単精度実数型)
                              !
                              ! この引数を与える場合,
                              ! 出力するかどうかをプログラムが
                              ! 自動的に判断します.
                              ! *time* に与えられた数値が
                              ! HistoryCreate に与えた *interval*
                              ! で割り切れる場合には出力が行われます.
                              !
                              ! HistoryAddVariable で
                              ! *time_average* (または *average*)
                              ! に .true. を与えた場合には,
                              ! *time*, *difftime*
                              ! のどちらの引数も与えない場合に,
                              ! プログラムはエラーを発生させます.
                              !
                              ! また, この引数と *range* は併用できません.
                              ! 併用した場合には,
                              ! プログラムはエラーを発生させます.
                              !
    logical, intent(in), optional:: quiet
                              ! .false. を与えた場合,
                              ! このサブルーチンが呼ばれる毎に
                              ! ファイル名と時刻が表示されます.
                              ! デフォルトは .true. です.
                              !
                              ! If ".false." is given,
                              ! a filename and time is displayed
                              ! when this subroutine is called.
                              ! Default value is ".true.".
                              !
    type(DC_DIFFTIME), intent(in), optional:: difftime
                              !
                              ! 時刻 (dc_date_types::DC_DIFFTIME 型)
                              !
                              ! 効果は *time* と同様です.
                              !
    real(DP), intent(in), optional:: timed
                              !
                              ! 時刻 (倍精度実数型)
                              !
                              ! 効果は *time* と同様です.
                              !
    logical, intent(in), optional:: time_average_store
                              !
                              ! 平均値の出力フラグ.
                              ! この値に .true. を与えた場合には,
                              ! 出力せずに与えられた値を一旦蓄えます.
                              ! .false. を与えた場合には,
                              ! *time* もしくは *difftime* と
                              ! HistoryCreate に与えた *interval* に
                              ! 関わらず出力を行います.
                              !
                              ! HistoryAddVariable で
                              ! *time_average* (または *average*)
                              ! に .true. を与えない場合は無効です.
                              !
                              ! *time* と *difftime*
                              ! のどちらかを同時に与える必要があります.
                              !
    logical, intent(out), optional:: err
                              ! 例外処理用フラグ.
                              ! デフォルトでは, この手続き内でエラーが
                              ! 生じた場合, プログラムは強制終了します.
                              ! 引数 *err* が与えられる場合,
                              ! プログラムは強制終了せず, 代わりに
                              ! *err* に .true. が代入されます.
                              !
                              ! Exception handling flag.
                              ! By default, when error occur in
                              ! this procedure, the program aborts.
                              ! If this *err* argument is given,
                              ! .true. is substituted to *err* and
                              ! the program does not abort.
    type(GT_VARIABLE):: var, timevar
    character(STRING):: url, file, time_str
    real:: time_value(1:1)
    type(GT_HISTORY), pointer:: hst =>null()
    integer :: v_ord
    character(STRING):: avr_msg
                        real(DP), target:: array_work(arraysize)
    real(DP), pointer:: array_work2(:) =>null()
    integer:: arraysize_work2
    integer, allocatable:: start(:), count(:), stride(:)
    integer :: i, dims
    logical :: slice_err
    character(STRING):: time_name
    character(*), parameter:: bnds_suffix = '_bnds'
    type(GT_VARIABLE):: bndsvar
    integer:: bnds_ord, time_count, bnds_rank
    logical:: output_step
    real(DP):: timedw
!    type(DC_DIFFTIME):: difftimew
    real(DP):: avr_coef
    integer, allocatable:: array_overwrap(:)
    integer:: new_index
    integer:: numdims, dimord, dimsize, dimsize_max, allcount, ra
    character(STRING):: dimname
    integer:: st_mpi(MPI_STATUS_SIZE)
    real(DP), allocatable:: array_mpi_tmp(:)
    real(DP), allocatable:: array_mpi_all(:,:)
    integer:: stat
    integer:: err_mpi
    character(STRING):: cause_c
    interface timegoahead
      subroutine timegoahead( varname, var, head, history, err )
        use gtdata_types, only: gt_variable
        use gtool_history_types, only: gt_history
        character(len = *), intent(in):: varname
        type(GT_VARIABLE), intent(out):: var
        real, intent(in):: head
        type(GT_HISTORY), intent(inout), optional, target:: history
        logical, intent(out), optional:: err
      end subroutine timegoahead
    end interface
    character(*), parameter:: subname = "HistoryPutDoubleEx"
  continue
    call beginsub(subname, 'varname=%a range=%a', &
      & ca=stoa(varname, present_select('', '(no-range)', range)))
    stat = dc_noerr
    cause_c = ""
    if (present(history)) then
      hst => history
    else
      hst => default
    endif
    !-----------------------------------------------------------------
    !  初期設定のチェック
    !  Check initialization
    !-----------------------------------------------------------------
    if ( .not. hst % initialized ) then
      stat = dc_enotinit
      cause_c = 'GT_HISTORY'
      goto 999
    end if
    !-----------------------------------------------------------------
    !  time と range の同時使用の禁止
    !  Permit concurrent use of "time" and "range"
    !-----------------------------------------------------------------
    if ( ( present(time) .or. present(difftime) .or. present(timed) ) &
      &  .and. present_and_not_empty(range) ) then
      call messagenotify('W', subname, &
        & '(varname=%c) "range" and "time" or "timed" or "difftime" are not suppored at the same time', &
        & c1 = trim(varname) )
      stat = usr_errno
      cause_c = '"range" and "time" or "timed" or "difftime" are not suppored at the same time'
      goto 999
    end if
    !-----------------------------------------------------------------
    !  hst 内の varname 変数の変数番号を取得
    !  Get variable number of "varname" in "hst"
    !-----------------------------------------------------------------
    if ( .not. hst % mpi_gather ) then
      v_ord = lookup_variable_ord(hst, varname)
    else
      if ( hst % mpi_myrank == 0 ) then
        v_ord = lookup_variable_ord(hst, varname)
      end if
      call mpi_bcast( v_ord, 1, mpi_integer, 0, mpi_comm_world, err_mpi )
      call dbgmessage('v_ord=<%d> is shared on all nodes.', i = (/v_ord/) )
    end if
                        timedw = 0.0_dp
    !-----------------------------------------------------------------
    !  時間平均値のためのデータ格納
    !  Store data for time average value
    !-----------------------------------------------------------------
    if ( present(difftime) ) then
      timedw = evalbyunit( difftime, '', hst % unlimited_units_symbol )
    elseif ( present(timed) ) then
      timedw = timed
    elseif ( present(time) ) then
      timedw = time
    end if
    if ( v_ord > 0 ) then
      !
      ! var_avr_count == -1: 平均処理は行わない.
      ! var_avr_count >=  0: 平均処理を行う.
      !
      ! これらは HistoryAddVariable で指定される.
      !
      if ( hst % var_avr_count( v_ord ) > -1 ) then
        ! 時刻が指定されない場合には平均処理が不可能なため
        ! エラー発生. dc_error のエラーメッセージだけでは多少
        ! 不親切なので, エラー直前に下記の警告メッセージ表示.
        !
        if (       .not. present(time) &
          &  .and. .not. present(timed) &
          &  .and. .not. present(difftime) ) then
          call messagenotify('W', subname, &
            & '(varname=%c) arguments "time" or "timed" or "difftime" are needed ' // &
            & 'when "time_average=.true." is specified to "HistoryAddVariable"', &
            & c1 = trim(varname) )
          stat = dc_earglack
          cause_c = 'time'
          goto 999
        end if
        ! 与えられたデータのサイズと内部で積算しているデータのサイズが
        ! 一致しない場合にもエラーを発生.
        ! データサイズは HistoryPut -> HistoryPutEx の際に
        ! 全て 1 次元化しているため, 単純に配列サイズでのみ判定.
        ! dc_error のエラーメッセージだけでは多少
        ! 不親切なので, エラー直前に下記の警告メッセージ表示.
        !
        if ( arraysize /= hst % var_avr_data( v_ord ) % length ) then
          call messagenotify('W', subname, &
            & '(varname=%c) size of array should be (%d). size of array is (%d)', &
            & i = (/hst % var_avr_data( v_ord ) % length, arraysize/), &
            & c1 = trim(varname) )
          stat = gt_eargsizemismatch
          cause_c = 'array'
          goto 999
        end if
        ! この if 〜 end if では以下の動作を行う.
        !
        ! * 平均処理時の係数 (avr_coef) の算出
        ! * 係数を算出するための以下の値の設定
        !   * 基本時間間隔 (var_avr_baseint)
        !   * 前回出力の時刻 (var_avr_prevtime)
        ! * 初回出力の判定を行うラベル (var_avr_firstput) の設定
        !
        ! 1 度目に呼ばれた場合はとりあえず係数を 1.0 にするとともに,
        ! prevtime に現在時刻を保管
        !
        if ( hst % var_avr_firstput( v_ord ) ) then
          if ( hst % var_avr_count( v_ord ) == 0 ) then
            avr_coef = 1.0_dp
            hst % var_avr_prevtime( v_ord ) = timedw
          else
            hst % var_avr_baseint( v_ord ) = &
              & timedw - hst % var_avr_prevtime( v_ord )
            avr_coef = 1.0_dp
            hst % var_avr_prevtime( v_ord ) = timedw
            hst % var_avr_firstput( v_ord ) = .false.
          end if
        ! 2 度目以降に呼ばれた場合
        !
        else
          ! 前回出力を行った (var_avr_count == 0 に初期化された)
          ! 場合には baseint に前回時刻と今回時刻の差を設定.
          ! avr_coef には 1 を設定.
          ! 最後に prevtime に今回の時刻を保管.
          !
          if ( hst % var_avr_count( v_ord ) == 0 ) then
            hst % var_avr_baseint( v_ord ) = &
              & timedw - hst % var_avr_prevtime( v_ord )
            avr_coef = 1.0_dp
            hst % var_avr_prevtime( v_ord ) = timedw
          ! var_avr_count > 0 (平均処理されるデータが蓄積されている)
          ! 場合には avr_coef には前回時刻と今回時刻の差の,
          ! baseint からの比を設定する.
          ! 最後に prevtime に今回の時刻を保管.
          !
          else
            avr_coef = ( timedw - hst % var_avr_prevtime( v_ord ) ) &
              &          / hst % var_avr_baseint( v_ord )
            hst % var_avr_prevtime( v_ord ) = timedw
          end if
        end if
        ! 積算値 a_DataAvr に, 今回のデータに係数を掛けたもの
        ! を加算する.
        !
        hst % var_avr_data( v_ord ) % a_DataAvr = &
          & hst % var_avr_data( v_ord ) % a_DataAvr + array * avr_coef
        ! 積算カウント var_avr_count に +1 し,
        ! 係数の積算値 var_avr_coefsum に今回設定された
        ! 係数を加算する.
        !
        hst % var_avr_count( v_ord ) = &
          & hst % var_avr_count( v_ord ) + 1
        hst % var_avr_coefsum( v_ord ) = &
          & hst % var_avr_coefsum( v_ord ) + avr_coef
        ! time_bnds(2) に今回の時刻を設定する.
        ! (毎回上書きされる).
        !
        if ( present(difftime) ) then
          hst % time_bnds(2:2) = evalbyunit( difftime, '', hst % unlimited_units_symbol )
        elseif ( present (timed) ) then
          hst % time_bnds(2:2) = timed
        else
          hst % time_bnds(2:2) = time
        end if
      end if
    end if
    !-----------------------------------------------------------------
    !  初期時刻の設定
    !  Configure initial time
    !-----------------------------------------------------------------
    if ( .not. hst % origin_setting ) then
      if ( present(difftime) ) then
        hst % origin         = evalbyunit( difftime, '', hst % unlimited_units_symbol )
        hst % time_bnds      = evalbyunit( difftime, '', hst % unlimited_units_symbol )
        hst % origin_setting = .true.
      elseif ( present(timed) ) then
        hst % origin         = timed
        hst % time_bnds      = timed
        hst % origin_setting = .true.
      elseif ( present(time) ) then
        hst % origin         = time
        hst % time_bnds      = time
        hst % origin_setting = .true.
      end if
!!$      if ( present(difftime) ) then
!!$        hst % origin         = difftime
!!$        hst % time_bnds      = EvalByUnit( difftime, '', hst % unlimited_units_symbol )
!!$        hst % origin_setting = .true.
!!$      elseif ( present(timed) ) then
!!$        call DCDiffTimeCreate( hst % origin, &              ! (out)
!!$          & real(timed), '', hst % unlimited_units_symbol ) ! (in)
!!$        hst % time_bnds      = timed
!!$        hst % origin_setting = .true.
!!$      elseif ( present(time) ) then
!!$        call DCDiffTimeCreate( hst % origin, &       ! (out)
!!$          & time, '', hst % unlimited_units_symbol ) ! (in)
!!$        hst % time_bnds      = time
!!$        hst % origin_setting = .true.
!!$      end if
    end if
                        !-----------------------------------------------------------------
    !  時刻の自動チェック
    !  Check time automatically
    !-----------------------------------------------------------------
    output_step = .true.
    if ( present_and_false(time_average_store) ) then
      output_step = .true.
    elseif ( present_and_true(time_average_store) ) then
      output_step = .false.
    elseif ( present(difftime) .or. present(timed) .or. present(time) ) then
      output_step = .false.
      if ( abs( hst % interval ) < dp_eps ) then
        output_step = .true.
      else
        if ( abs( mod( timedw - hst % origin, hst % interval ) ) < dp_eps ) then
          output_step = .true.
        end if
      end if
    end if
    !-------------------------
    !  時間平均値出力のための情報処理
    !  Information processing for output time-averaged value
    if ( .not. output_step ) then
      goto 999
    else
      array_work = array
      avr_msg = ''
      if ( v_ord > 0 ) then
        if ( hst % var_avr_count( v_ord ) > -1 ) then
          if ( present_and_false(quiet) ) then
            avr_msg = '(time average of ' // trim( tochar(hst % var_avr_count( v_ord )) ) // ' step data)'
          end if
          !-------------------
          !  蓄えた値の時間平均化
          !  Average stored value in time direction
          ! a_DataAvr に蓄えられた値を係数の積算値で割って,
          ! これを出力値とする.
          !
                              array_work = real( &
            & ( hst % var_avr_data( v_ord ) % a_DataAvr ) / ( hst % var_avr_coefsum( v_ord ) ), &
            & kind = kind(array_work) )
          ! 積算値, 積算カウント, 係数の積算値をクリアする.
          !
          hst % var_avr_data( v_ord ) % a_DataAvr = 0.0
          hst % var_avr_count( v_ord ) = 0
          hst % var_avr_coefsum( v_ord ) = 0.0_dp
          hst % var_avr_firstput( v_ord ) = .false.
        end if
      end if
    end if
    if ( .not. hst % mpi_gather ) then
      array_work2 => array_work
      arraysize_work2 = arraysize
    else
      !-----------------------------------------------------------------
      !  MPI 使用時に, 座標軸のデータが与えられた場合には, そのデータを保管.
      !  If data of axis is given, the data is stored when MPI is used
      !-----------------------------------------------------------------
      numdims = size( hst % mpi_fileinfo % axes )
      if ( hst % mpi_myrank == 0 ) then
        dimord = 0
        do i = 1, numdims
          call historyaxisinquire( &
            & hst % mpi_fileinfo % axes(i), & ! (in)
            & name = dimname )                ! (out)
          if ( trim(varname) == trim(dimname) ) then
            dimord = i
            exit
          end if
        end do
        call mpi_bcast( dimord, 1, mpi_integer, 0, mpi_comm_world, err_mpi )
      else
        call mpi_bcast( dimord, 1, mpi_integer, 0, mpi_comm_world, err_mpi )
      end if
      if ( dimord > 0 ) then
        call historyaxisinquire( &
          & hst % mpi_fileinfo % axes(dimord), & ! (in)
          & size = dimsize_max )                 ! (out)
        dimsize = size( array )
        if ( dimsize > dimsize_max .and. hst % unlimited_index /= dimord ) then
          call messagenotify('W', subname, &
            & 'dim=<%c> data size (%d) exceeds size of the dim (%d) by HistoryCreate. ' //  &
            & 'the data will be trancated. ', &
            & i = (/ dimsize, dimsize_max /), c1 = trim(varname) )
          dimsize = dimsize_max
        end if
        if ( associated( hst % mpi_dimdata_each( dimord ) % a_Axis ) ) then
          deallocate( hst % mpi_dimdata_each( dimord ) % a_Axis )
        end if
        allocate( hst % mpi_dimdata_each( dimord ) % a_Axis(dimsize) )
        hst % mpi_dimdata_each( dimord ) % a_Axis = array(1:dimsize)
        hst % mpi_dimdata_each( dimord ) % length = dimsize
      end if
      !-----------------------------------------------------------------
      !  MPI 使用時に, 従属変数のデータが与えられた場合, データ集約の情報を整理.
      !  If data of dependent variables is given,
      !    information for integration is arranged when MPI is used
      !-----------------------------------------------------------------
      if ( v_ord > 0 ) then
        if ( .not. associated( hst % mpi_gthr_info ) ) then
          call gtmpi_axis_register( hst, err ) ! (inout)
        end if
        if ( present_and_true( err ) ) goto 999
        if ( .not. associated( hst % mpi_vars_index( v_ord ) % allcount ) ) then
          call gtmpi_vars_mkindex( hst, v_ord, err ) ! (inout)
        end if
        if ( present_and_true( err ) ) goto 999
      end if
      !-----------------------------------------------------------------
      !  MPI 使用時は, 各ノードのデータを rank == 0 へ集約する.
      !  Data on each node is integrated when MPI is used
      !-----------------------------------------------------------------
      if ( v_ord > 0 ) then
        arraysize_work2 = hst % mpi_vars_index(v_ord) % allcount_all
        if ( arraysize_work2 < 1 ) arraysize_work2 = 1
        if ( hst % mpi_myrank == 0 ) then
          do ra = 1, hst % mpi_nprocs - 1
            allcount = hst % mpi_vars_index(v_ord) % allcount(ra)
            call mpi_send( allcount, 1, mpi_integer, ra, 0, mpi_comm_world, err_mpi )
          end do
        else
          call mpi_recv( allcount, 1, mpi_integer, 0, 0, mpi_comm_world, st_mpi, err_mpi )
        end if
        if ( hst % mpi_myrank /= 0 ) then
          call mpi_send( array_work, allcount, &
            & mpi_double_precision, 0, 0, mpi_comm_world, err_mpi )
        else
          allocate( array_mpi_all(0: hst % mpi_nprocs - 1, arraysize_work2 ) )
          allocate( array_mpi_tmp( arraysize_work2 ) )
          array_mpi_all(:,:) = 0.0_dp
          array_mpi_tmp(:) = 0.0_dp
          allcount = hst % mpi_vars_index(v_ord) % allcount(0)
          array_mpi_all(0,1:allcount) = array_work
          do ra = 1, hst % mpi_nprocs - 1
            allcount = hst % mpi_vars_index(v_ord) % allcount(ra)
            call mpi_recv( array_mpi_tmp(1:allcount), allcount, &
              & mpi_double_precision, ra, 0, mpi_comm_world, st_mpi, err_mpi )
            array_mpi_all(ra,1:allcount) = array_mpi_tmp(1:allcount)
          end do
          allocate( array_work2( arraysize_work2 ) )
          allocate( array_overwrap( arraysize_work2 ) )
          array_work2 = 0.0_dp
          array_overwrap(:) = 0
          do ra = 0, hst % mpi_nprocs - 1
            do i = 1, hst % mpi_vars_index(v_ord) % allcount(ra)
              new_index = hst % mpi_vars_index(v_ord) % each2all(ra, i)
              array_work2( new_index ) = &
                & array_work2( new_index ) + array_mpi_all( ra, i )
              array_overwrap( new_index ) = array_overwrap( new_index ) + 1
            end do
          end do
          where ( array_overwrap == 0 )
            array_overwrap = 1
          end where
          array_work2(:) = array_work2(:) / array_overwrap(:)
          deallocate( array_mpi_all, array_mpi_tmp, array_overwrap )
          ! array_work2 はデータ出力の後に割り付け解除される.
        end if
      else
        array_work2 => array_work
        arraysize_work2 = arraysize
      end if
    end if
    !-----------------------------------------------------------------
    !  時刻を1つ進めて, データ出力
    !  Progress one time, and output data
    !-----------------------------------------------------------------
    if ( .not. hst % mpi_gather &
      &  .or. ( hst % mpi_gather    .and. &
      &         hst % mpi_myrank == 0 .and. &
      &         hst % mpi_fileinfo % already_output) ) then
    call timegoahead( &
      & varname = varname, &     ! (in)
                          & head = real(array_work2(1)), & ! (in)
      & var = var, &             ! (out)
      & history = history, &     ! (inout)
      & err = err )              ! (out)
    call inquire( var, & ! (in)
      & alldims=dims )   ! (out)
    if (present_and_not_empty(range) .and. (dims < 1)) then
      call dbgmessage('varname=<%c> has no dimension. so range is ignoread.', &
      & c1=trim(varname))
    end if
    if (.not. (present_and_not_empty(range) .and. (dims > 0))) then
      ! range 無しの普通の出力の場合
      call put(var, array_work2, arraysize_work2)
    else
      ! range があり, 且つ varname がちゃんと次元を持っている場合
      !
      ! 元々の start, count, stride を保持. データを与えた後に復元する.
      allocate(start(dims), count(dims), stride(dims))
      do i = 1, dims
        call get_slice(var, i, start(i), count(i), stride(i))
      end do
      slice_err = .false. ! 不要だが Slice の引用仕様として必要なため
      call slice(var, range, slice_err)
      call put(var, array_work2, arraysize_work2)
      ! 復元
      do i = 1, dims
        call slice(var, i, start(i), count(i), stride(i))
      end do
      deallocate(start, count, stride)
    end if
    call gtvarsync(var)
    if ( hst % mpi_gather .and. v_ord > 0 ) then
      deallocate( array_work2 )
    end if
    end if
                        !-----------------------------------------------------------------
    !  "time_bnds" 変数への出力
    !  Output to "time_bnds" variable
    !-----------------------------------------------------------------
    if ( .not. hst % mpi_gather &
      &  .or. ( hst % mpi_gather    .and. &
      &         hst % mpi_myrank == 0 .and. &
      &         hst % mpi_fileinfo % already_output ) ) then
    if ( v_ord > 0 ) then
      if ( hst % var_avr_count( v_ord ) > -1 ) then
        !-------------------
        !  時間次元の名前とファイル名を取得
        !  Get name of time dimension, and filename
        timevar = hst % dimvars( hst % unlimited_index )
        call inquire( &
          & var = timevar, &   ! (in)
          & url = url, &       ! (out)
          & name = time_name ) ! (out)
        call urlsplit( fullname = url, &  ! (in)
          & file = file )                 ! (out)
        !-------------------
        !  "time_bnds" 変数の取得
        !  Get "time_bnds" variable
        call open( var = bndsvar, &
          & url = urlmerge(file=file, var=trim(time_name) // bnds_suffix) )
        bnds_ord = lookup_variable_ord( hst, trim(time_name) // bnds_suffix)
        !-------------------
        !  "time_bnds" 変数への出力
        !  Output to "time_bnds" variable
        call inquire( &
          & var = bndsvar, &                        ! (in)
          & rank = bnds_rank )                      ! (out)
        time_count = 1
        if ( bnds_rank > 1 ) then
          call inquire( &
            & var = bndsvar, &                             ! (in)
            & dimord = hst % growable_indices(bnds_ord), & ! (in)
            & allcount = time_count )                      ! (out)
        end if
        if  ( (hst % time_bnds_output_count < 1) &
          &  .or. (hst % time_bnds_output_count < time_count) ) then
          call slice(bndsvar, hst % growable_indices(bnds_ord), & ! (in)
            & start=hst % time_bnds_output_count+1, count=1)        ! (in)
          call put(bndsvar, hst % time_bnds, 2)
          hst % time_bnds_output_count = hst % time_bnds_output_count + 1
        end if
        call close( var = bndsvar ) ! (inout)
        if ( present(difftime) ) then
          hst % time_bnds(1:1) = &
            & evalbyunit( difftime, '', hst % unlimited_units_symbol )
        elseif ( present(timed) ) then
          hst % time_bnds(1:1) = timed
        else
          hst % time_bnds(1:1) = time
        end if
      end if
    end if
    end if
    !-----------------------------------------------------------------
    !  メッセージ出力
    !  Output messages
    !-----------------------------------------------------------------
    if ( .not. hst % mpi_gather &
      &  .or. ( hst % mpi_gather    .and. &
      &         hst % mpi_myrank == 0 .and. &
      &         hst % mpi_fileinfo % already_output ) ) then
    if ( present_and_false(quiet) ) then
      call inquire( hst % dimvars(1), & ! (in)
        & url = url )                   ! (out)
      call urlsplit( fullname = url, &  ! (in)
        & file = file )                 ! (out)
      if ( hst % unlimited_index < 1 ) then
        time_str = ''
      else
        timevar = hst % dimvars(hst % unlimited_index)
        call slice( timevar, &                     ! (in)
          & 1, start = hst % count(v_ord), count = 1 ) ! (in)
        call get( timevar, & ! (inout)
          & time_value, &    ! (out)
          & 1, &             ! (in)
          & err )            ! (out)
        time_str = '(time=' // trim( tochar( time_value(1) )) // ')'
      end if
      call messagenotify('M', 'HistoryPut', &
        & '"%a" => "%a" %a %a', &
        & ca = stoa( varname, file, time_str, avr_msg ) )
    end if
    end if
    !-----------------------------------------------------------------
    !  終了処理, 例外処理
    !  Termination and Exception handling
    !-----------------------------------------------------------------
999 continue
    call storeerror( stat, subname, err, cause_c )
    call endsub(subname)

References dc_trace::beginsub(), dc_trace::dbgmessage(), dc_error::dc_earglack, dc_error::dc_enotinit, dc_error::dc_noerr, gtool_history_internal::default, dc_types::dp, dc_types::dp_eps, dc_trace::endsub(), dc_error::gt_eargsizemismatch, dc_string::joinchar(), dc_present::present_and_false(), dc_present::present_and_not_empty(), dc_present::present_and_true(), dc_error::storeerror(), dc_types::string, timegoahead(), and dc_error::usr_errno.

Here is the call graph for this function:

historyputint0()

subroutine historyputint0	(	character(*), intent(in)	varname,
		integer, intent(in)	value,
		type(gt_history), intent(inout), optional, target	history,
		character(*), intent(in), optional	range,
		real, intent(in), optional	time,
		logical, intent(in), optional	quiet,
		type(dc_difftime), intent(in), optional	difftime,
		real(dp), intent(in), optional	timed,
		logical, intent(in), optional	time_average_store,
		logical, intent(out), optional	err
	)

Definition at line 4068 of file historyput.f90.

    !
    !
    use gtool_history_types, only: gt_history
    use dc_date_types, only: dc_difftime
    use dc_types, only: dp
    use dc_trace, only: beginsub, endsub, dbgmessage
    implicit none
    character(*), intent(in):: varname
    integer, intent(in):: value
    type(GT_HISTORY), intent(inout), optional, target:: history
    character(*), intent(in), optional:: range
    real, intent(in), optional:: time
    logical, intent(in), optional:: quiet
    type(DC_DIFFTIME), intent(in), optional:: difftime
    real(DP), intent(in), optional:: timed
    logical, intent(in), optional:: time_average_store
    logical, intent(out), optional:: err
    interface historyputintex
      subroutine historyputintex( &
        & varname, array, arraysize, history, range, &
        & time, quiet, difftime, timed, time_average_store, err )
        use gtool_history_types, only: gt_history
        use dc_date_types, only: dc_difftime
        use dc_types, only: dp
        character(*), intent(in):: varname
        integer, intent(in):: arraysize
        integer, intent(in):: array(arraysize)
        type(GT_HISTORY), intent(inout), target, optional:: history
        character(*), intent(in), optional:: range
        real, intent(in), optional:: time
        logical, intent(in), optional:: quiet
        type(DC_DIFFTIME), intent(in), optional:: difftime
        real(DP), intent(in), optional:: timed
        logical, intent(in), optional:: time_average_store
        logical, intent(out), optional:: err
      end subroutine historyputintex
    end interface
    character(*), parameter:: subname = "HistoryPutInt0"
  continue
    call beginsub(subname)
    call historyputintex( &
      & varname, &               ! (in)
      & (/value/), 1, &   ! (in)
      & history = history, &     ! (inout) optional
      & range = range, &         ! (in) optional
      & time = time, &           ! (in) optional
      & quiet = quiet, &         ! (in) optional
      & difftime = difftime, &   ! (in) optional
      & timed = timed, &         ! (in) optional
      & time_average_store = &
      &    time_average_store, & ! (in) optional
      & err = err )              ! (out) optional
    call endsub(subname)

References dc_trace::beginsub(), dc_trace::dbgmessage(), dc_types::dp, dc_trace::endsub(), and historyputintex().

Here is the call graph for this function:

historyputint1()

subroutine historyputint1	(	character(*), intent(in)	varname,
		integer, dimension(:), intent(in)	array,
		type(gt_history), intent(inout), optional, target	history,
		character(*), intent(in), optional	range,
		real, intent(in), optional	time,
		logical, intent(in), optional	quiet,
		type(dc_difftime), intent(in), optional	difftime,
		real(dp), intent(in), optional	timed,
		logical, intent(in), optional	time_average_store,
		logical, intent(out), optional	err
	)

Definition at line 4125 of file historyput.f90.

    !
    !
    use gtool_history_types, only: gt_history
    use dc_date_types, only: dc_difftime
    use dc_types, only: dp
    use dc_trace, only: beginsub, endsub, dbgmessage
    implicit none
    character(*), intent(in):: varname
    integer, intent(in):: array(:)
    type(GT_HISTORY), intent(inout), optional, target:: history
    character(*), intent(in), optional:: range
    real, intent(in), optional:: time
    logical, intent(in), optional:: quiet
    type(DC_DIFFTIME), intent(in), optional:: difftime
    real(DP), intent(in), optional:: timed
    logical, intent(in), optional:: time_average_store
    logical, intent(out), optional:: err
    interface historyputintex
      subroutine historyputintex( &
        & varname, array, arraysize, history, range, &
        & time, quiet, difftime, timed, time_average_store, err )
        use gtool_history_types, only: gt_history
        use dc_date_types, only: dc_difftime
        use dc_types, only: dp
        character(*), intent(in):: varname
        integer, intent(in):: arraysize
        integer, intent(in):: array(arraysize)
        type(GT_HISTORY), intent(inout), target, optional:: history
        character(*), intent(in), optional:: range
        real, intent(in), optional:: time
        logical, intent(in), optional:: quiet
        type(DC_DIFFTIME), intent(in), optional:: difftime
        real(DP), intent(in), optional:: timed
        logical, intent(in), optional:: time_average_store
        logical, intent(out), optional:: err
      end subroutine historyputintex
    end interface
    character(*), parameter:: subname = "HistoryPutInt1"
  continue
    call beginsub(subname)
    call historyputintex( &
      & varname, &               ! (in)
      & pack(array, .true.), size(array), &   ! (in)
      & history = history, &     ! (inout) optional
      & range = range, &         ! (in) optional
      & time = time, &           ! (in) optional
      & quiet = quiet, &         ! (in) optional
      & difftime = difftime, &   ! (in) optional
      & timed = timed, &         ! (in) optional
      & time_average_store = &
      &    time_average_store, & ! (in) optional
      & err = err )              ! (out) optional
    call endsub(subname)

References dc_trace::beginsub(), dc_trace::dbgmessage(), dc_types::dp, dc_trace::endsub(), and historyputintex().

Here is the call graph for this function:

historyputint2()

subroutine historyputint2	(	character(*), intent(in)	varname,
		integer, dimension(:,:), intent(in)	array,
		type(gt_history), intent(inout), optional, target	history,
		character(*), intent(in), optional	range,
		real, intent(in), optional	time,
		logical, intent(in), optional	quiet,
		type(dc_difftime), intent(in), optional	difftime,
		real(dp), intent(in), optional	timed,
		logical, intent(in), optional	time_average_store,
		logical, intent(out), optional	err
	)

Definition at line 4182 of file historyput.f90.

    !
    !
    use gtool_history_types, only: gt_history
    use dc_date_types, only: dc_difftime
    use dc_types, only: dp
    use dc_trace, only: beginsub, endsub, dbgmessage
    implicit none
    character(*), intent(in):: varname
    integer, intent(in):: array(:,:)
    type(GT_HISTORY), intent(inout), optional, target:: history
    character(*), intent(in), optional:: range
    real, intent(in), optional:: time
    logical, intent(in), optional:: quiet
    type(DC_DIFFTIME), intent(in), optional:: difftime
    real(DP), intent(in), optional:: timed
    logical, intent(in), optional:: time_average_store
    logical, intent(out), optional:: err
    interface historyputintex
      subroutine historyputintex( &
        & varname, array, arraysize, history, range, &
        & time, quiet, difftime, timed, time_average_store, err )
        use gtool_history_types, only: gt_history
        use dc_date_types, only: dc_difftime
        use dc_types, only: dp
        character(*), intent(in):: varname
        integer, intent(in):: arraysize
        integer, intent(in):: array(arraysize)
        type(GT_HISTORY), intent(inout), target, optional:: history
        character(*), intent(in), optional:: range
        real, intent(in), optional:: time
        logical, intent(in), optional:: quiet
        type(DC_DIFFTIME), intent(in), optional:: difftime
        real(DP), intent(in), optional:: timed
        logical, intent(in), optional:: time_average_store
        logical, intent(out), optional:: err
      end subroutine historyputintex
    end interface
    character(*), parameter:: subname = "HistoryPutInt2"
  continue
    call beginsub(subname)
    call historyputintex( &
      & varname, &               ! (in)
      & pack(array, .true.), size(array), &   ! (in)
      & history = history, &     ! (inout) optional
      & range = range, &         ! (in) optional
      & time = time, &           ! (in) optional
      & quiet = quiet, &         ! (in) optional
      & difftime = difftime, &   ! (in) optional
      & timed = timed, &         ! (in) optional
      & time_average_store = &
      &    time_average_store, & ! (in) optional
      & err = err )              ! (out) optional
    call endsub(subname)

References dc_trace::beginsub(), dc_trace::dbgmessage(), dc_types::dp, dc_trace::endsub(), and historyputintex().

Here is the call graph for this function:

historyputint3()

subroutine historyputint3	(	character(*), intent(in)	varname,
		integer, dimension(:,:,:), intent(in)	array,
		type(gt_history), intent(inout), optional, target	history,
		character(*), intent(in), optional	range,
		real, intent(in), optional	time,
		logical, intent(in), optional	quiet,
		type(dc_difftime), intent(in), optional	difftime,
		real(dp), intent(in), optional	timed,
		logical, intent(in), optional	time_average_store,
		logical, intent(out), optional	err
	)

Definition at line 4239 of file historyput.f90.

    !
    !
    use gtool_history_types, only: gt_history
    use dc_date_types, only: dc_difftime
    use dc_types, only: dp
    use dc_trace, only: beginsub, endsub, dbgmessage
    implicit none
    character(*), intent(in):: varname
    integer, intent(in):: array(:,:,:)
    type(GT_HISTORY), intent(inout), optional, target:: history
    character(*), intent(in), optional:: range
    real, intent(in), optional:: time
    logical, intent(in), optional:: quiet
    type(DC_DIFFTIME), intent(in), optional:: difftime
    real(DP), intent(in), optional:: timed
    logical, intent(in), optional:: time_average_store
    logical, intent(out), optional:: err
    interface historyputintex
      subroutine historyputintex( &
        & varname, array, arraysize, history, range, &
        & time, quiet, difftime, timed, time_average_store, err )
        use gtool_history_types, only: gt_history
        use dc_date_types, only: dc_difftime
        use dc_types, only: dp
        character(*), intent(in):: varname
        integer, intent(in):: arraysize
        integer, intent(in):: array(arraysize)
        type(GT_HISTORY), intent(inout), target, optional:: history
        character(*), intent(in), optional:: range
        real, intent(in), optional:: time
        logical, intent(in), optional:: quiet
        type(DC_DIFFTIME), intent(in), optional:: difftime
        real(DP), intent(in), optional:: timed
        logical, intent(in), optional:: time_average_store
        logical, intent(out), optional:: err
      end subroutine historyputintex
    end interface
    character(*), parameter:: subname = "HistoryPutInt3"
  continue
    call beginsub(subname)
    call historyputintex( &
      & varname, &               ! (in)
      & pack(array, .true.), size(array), &   ! (in)
      & history = history, &     ! (inout) optional
      & range = range, &         ! (in) optional
      & time = time, &           ! (in) optional
      & quiet = quiet, &         ! (in) optional
      & difftime = difftime, &   ! (in) optional
      & timed = timed, &         ! (in) optional
      & time_average_store = &
      &    time_average_store, & ! (in) optional
      & err = err )              ! (out) optional
    call endsub(subname)

References dc_trace::beginsub(), dc_trace::dbgmessage(), dc_types::dp, dc_trace::endsub(), and historyputintex().

Here is the call graph for this function:

historyputint4()

subroutine historyputint4	(	character(*), intent(in)	varname,
		integer, dimension(:,:,:,:), intent(in)	array,
		type(gt_history), intent(inout), optional, target	history,
		character(*), intent(in), optional	range,
		real, intent(in), optional	time,
		logical, intent(in), optional	quiet,
		type(dc_difftime), intent(in), optional	difftime,
		real(dp), intent(in), optional	timed,
		logical, intent(in), optional	time_average_store,
		logical, intent(out), optional	err
	)

Definition at line 4296 of file historyput.f90.

    !
    !
    use gtool_history_types, only: gt_history
    use dc_date_types, only: dc_difftime
    use dc_types, only: dp
    use dc_trace, only: beginsub, endsub, dbgmessage
    implicit none
    character(*), intent(in):: varname
    integer, intent(in):: array(:,:,:,:)
    type(GT_HISTORY), intent(inout), optional, target:: history
    character(*), intent(in), optional:: range
    real, intent(in), optional:: time
    logical, intent(in), optional:: quiet
    type(DC_DIFFTIME), intent(in), optional:: difftime
    real(DP), intent(in), optional:: timed
    logical, intent(in), optional:: time_average_store
    logical, intent(out), optional:: err
    interface historyputintex
      subroutine historyputintex( &
        & varname, array, arraysize, history, range, &
        & time, quiet, difftime, timed, time_average_store, err )
        use gtool_history_types, only: gt_history
        use dc_date_types, only: dc_difftime
        use dc_types, only: dp
        character(*), intent(in):: varname
        integer, intent(in):: arraysize
        integer, intent(in):: array(arraysize)
        type(GT_HISTORY), intent(inout), target, optional:: history
        character(*), intent(in), optional:: range
        real, intent(in), optional:: time
        logical, intent(in), optional:: quiet
        type(DC_DIFFTIME), intent(in), optional:: difftime
        real(DP), intent(in), optional:: timed
        logical, intent(in), optional:: time_average_store
        logical, intent(out), optional:: err
      end subroutine historyputintex
    end interface
    character(*), parameter:: subname = "HistoryPutInt4"
  continue
    call beginsub(subname)
    call historyputintex( &
      & varname, &               ! (in)
      & pack(array, .true.), size(array), &   ! (in)
      & history = history, &     ! (inout) optional
      & range = range, &         ! (in) optional
      & time = time, &           ! (in) optional
      & quiet = quiet, &         ! (in) optional
      & difftime = difftime, &   ! (in) optional
      & timed = timed, &         ! (in) optional
      & time_average_store = &
      &    time_average_store, & ! (in) optional
      & err = err )              ! (out) optional
    call endsub(subname)

References dc_trace::beginsub(), dc_trace::dbgmessage(), dc_types::dp, dc_trace::endsub(), and historyputintex().

Here is the call graph for this function:

historyputint5()

subroutine historyputint5	(	character(*), intent(in)	varname,
		integer, dimension(:,:,:,:,:), intent(in)	array,
		type(gt_history), intent(inout), optional, target	history,
		character(*), intent(in), optional	range,
		real, intent(in), optional	time,
		logical, intent(in), optional	quiet,
		type(dc_difftime), intent(in), optional	difftime,
		real(dp), intent(in), optional	timed,
		logical, intent(in), optional	time_average_store,
		logical, intent(out), optional	err
	)

Definition at line 4353 of file historyput.f90.

    !
    !
    use gtool_history_types, only: gt_history
    use dc_date_types, only: dc_difftime
    use dc_types, only: dp
    use dc_trace, only: beginsub, endsub, dbgmessage
    implicit none
    character(*), intent(in):: varname
    integer, intent(in):: array(:,:,:,:,:)
    type(GT_HISTORY), intent(inout), optional, target:: history
    character(*), intent(in), optional:: range
    real, intent(in), optional:: time
    logical, intent(in), optional:: quiet
    type(DC_DIFFTIME), intent(in), optional:: difftime
    real(DP), intent(in), optional:: timed
    logical, intent(in), optional:: time_average_store
    logical, intent(out), optional:: err
    interface historyputintex
      subroutine historyputintex( &
        & varname, array, arraysize, history, range, &
        & time, quiet, difftime, timed, time_average_store, err )
        use gtool_history_types, only: gt_history
        use dc_date_types, only: dc_difftime
        use dc_types, only: dp
        character(*), intent(in):: varname
        integer, intent(in):: arraysize
        integer, intent(in):: array(arraysize)
        type(GT_HISTORY), intent(inout), target, optional:: history
        character(*), intent(in), optional:: range
        real, intent(in), optional:: time
        logical, intent(in), optional:: quiet
        type(DC_DIFFTIME), intent(in), optional:: difftime
        real(DP), intent(in), optional:: timed
        logical, intent(in), optional:: time_average_store
        logical, intent(out), optional:: err
      end subroutine historyputintex
    end interface
    character(*), parameter:: subname = "HistoryPutInt5"
  continue
    call beginsub(subname)
    call historyputintex( &
      & varname, &               ! (in)
      & pack(array, .true.), size(array), &   ! (in)
      & history = history, &     ! (inout) optional
      & range = range, &         ! (in) optional
      & time = time, &           ! (in) optional
      & quiet = quiet, &         ! (in) optional
      & difftime = difftime, &   ! (in) optional
      & timed = timed, &         ! (in) optional
      & time_average_store = &
      &    time_average_store, & ! (in) optional
      & err = err )              ! (out) optional
    call endsub(subname)

References dc_trace::beginsub(), dc_trace::dbgmessage(), dc_types::dp, dc_trace::endsub(), and historyputintex().

Here is the call graph for this function:

historyputint6()

subroutine historyputint6	(	character(*), intent(in)	varname,
		integer, dimension(:,:,:,:,:,:), intent(in)	array,
		type(gt_history), intent(inout), optional, target	history,
		character(*), intent(in), optional	range,
		real, intent(in), optional	time,
		logical, intent(in), optional	quiet,
		type(dc_difftime), intent(in), optional	difftime,
		real(dp), intent(in), optional	timed,
		logical, intent(in), optional	time_average_store,
		logical, intent(out), optional	err
	)

Definition at line 4410 of file historyput.f90.

    !
    !
    use gtool_history_types, only: gt_history
    use dc_date_types, only: dc_difftime
    use dc_types, only: dp
    use dc_trace, only: beginsub, endsub, dbgmessage
    implicit none
    character(*), intent(in):: varname
    integer, intent(in):: array(:,:,:,:,:,:)
    type(GT_HISTORY), intent(inout), optional, target:: history
    character(*), intent(in), optional:: range
    real, intent(in), optional:: time
    logical, intent(in), optional:: quiet
    type(DC_DIFFTIME), intent(in), optional:: difftime
    real(DP), intent(in), optional:: timed
    logical, intent(in), optional:: time_average_store
    logical, intent(out), optional:: err
    interface historyputintex
      subroutine historyputintex( &
        & varname, array, arraysize, history, range, &
        & time, quiet, difftime, timed, time_average_store, err )
        use gtool_history_types, only: gt_history
        use dc_date_types, only: dc_difftime
        use dc_types, only: dp
        character(*), intent(in):: varname
        integer, intent(in):: arraysize
        integer, intent(in):: array(arraysize)
        type(GT_HISTORY), intent(inout), target, optional:: history
        character(*), intent(in), optional:: range
        real, intent(in), optional:: time
        logical, intent(in), optional:: quiet
        type(DC_DIFFTIME), intent(in), optional:: difftime
        real(DP), intent(in), optional:: timed
        logical, intent(in), optional:: time_average_store
        logical, intent(out), optional:: err
      end subroutine historyputintex
    end interface
    character(*), parameter:: subname = "HistoryPutInt6"
  continue
    call beginsub(subname)
    call historyputintex( &
      & varname, &               ! (in)
      & pack(array, .true.), size(array), &   ! (in)
      & history = history, &     ! (inout) optional
      & range = range, &         ! (in) optional
      & time = time, &           ! (in) optional
      & quiet = quiet, &         ! (in) optional
      & difftime = difftime, &   ! (in) optional
      & timed = timed, &         ! (in) optional
      & time_average_store = &
      &    time_average_store, & ! (in) optional
      & err = err )              ! (out) optional
    call endsub(subname)

References dc_trace::beginsub(), dc_trace::dbgmessage(), dc_types::dp, dc_trace::endsub(), and historyputintex().

Here is the call graph for this function:

historyputint7()

subroutine historyputint7	(	character(*), intent(in)	varname,
		integer, dimension(:,:,:,:,:,:,:), intent(in)	array,
		type(gt_history), intent(inout), optional, target	history,
		character(*), intent(in), optional	range,
		real, intent(in), optional	time,
		logical, intent(in), optional	quiet,
		type(dc_difftime), intent(in), optional	difftime,
		real(dp), intent(in), optional	timed,
		logical, intent(in), optional	time_average_store,
		logical, intent(out), optional	err
	)

Definition at line 4467 of file historyput.f90.

    !
    !
    use gtool_history_types, only: gt_history
    use dc_date_types, only: dc_difftime
    use dc_types, only: dp
    use dc_trace, only: beginsub, endsub, dbgmessage
    implicit none
    character(*), intent(in):: varname
    integer, intent(in):: array(:,:,:,:,:,:,:)
    type(GT_HISTORY), intent(inout), optional, target:: history
    character(*), intent(in), optional:: range
    real, intent(in), optional:: time
    logical, intent(in), optional:: quiet
    type(DC_DIFFTIME), intent(in), optional:: difftime
    real(DP), intent(in), optional:: timed
    logical, intent(in), optional:: time_average_store
    logical, intent(out), optional:: err
    interface historyputintex
      subroutine historyputintex( &
        & varname, array, arraysize, history, range, &
        & time, quiet, difftime, timed, time_average_store, err )
        use gtool_history_types, only: gt_history
        use dc_date_types, only: dc_difftime
        use dc_types, only: dp
        character(*), intent(in):: varname
        integer, intent(in):: arraysize
        integer, intent(in):: array(arraysize)
        type(GT_HISTORY), intent(inout), target, optional:: history
        character(*), intent(in), optional:: range
        real, intent(in), optional:: time
        logical, intent(in), optional:: quiet
        type(DC_DIFFTIME), intent(in), optional:: difftime
        real(DP), intent(in), optional:: timed
        logical, intent(in), optional:: time_average_store
        logical, intent(out), optional:: err
      end subroutine historyputintex
    end interface
    character(*), parameter:: subname = "HistoryPutInt7"
  continue
    call beginsub(subname)
    call historyputintex( &
      & varname, &               ! (in)
      & pack(array, .true.), size(array), &   ! (in)
      & history = history, &     ! (inout) optional
      & range = range, &         ! (in) optional
      & time = time, &           ! (in) optional
      & quiet = quiet, &         ! (in) optional
      & difftime = difftime, &   ! (in) optional
      & timed = timed, &         ! (in) optional
      & time_average_store = &
      &    time_average_store, & ! (in) optional
      & err = err )              ! (out) optional
    call endsub(subname)

References dc_trace::beginsub(), dc_trace::dbgmessage(), dc_types::dp, dc_trace::endsub(), and historyputintex().

Here is the call graph for this function:

historyputintex()

recursive subroutine historyputintex	(	character(*), intent(in)	varname,
		integer, dimension(arraysize), intent(in)	array,
		integer, intent(in)	arraysize,
		type(gt_history), intent(inout), optional, target	history,
		character(*), intent(in), optional	range,
		real, intent(in), optional	time,
		logical, intent(in), optional	quiet,
		type(dc_difftime), intent(in), optional	difftime,
		real(dp), intent(in), optional	timed,
		logical, intent(in), optional	time_average_store,
		logical, intent(out), optional	err
	)

データ出力

Parameters

[in]

varname

iline 1

こちらは配列サイズを指定する必要があるため、 HistoryPut を利用してください。

Definition at line 1381 of file historyput.f90.

    !
    !
    use gtool_history_types, only: gt_history
    use gtool_history_generic, only: historyaxisinquire
    use gtool_history_internal, only: default, lookup_variable_ord
    use gtool_history_internal, only: gtmpi_axis_register, gtmpi_vars_mkindex
    use gtdata_generic, only: put, gtvarsync, slice, inquire, &
      & get_slice, get, putline, open, close
    use gtdata_types, only: gt_variable
    use dc_types, only: string, dp, dp_eps
    use dc_string, only: stoa, printf, tochar, joinchar
    use dc_present, only: present_and_not_empty, present_select, &
      & present_and_false, present_and_true
    use dc_error, only: storeerror, dc_noerr, dc_enotinit, usr_errno, dc_earglack, gt_eargsizemismatch
    use dc_message, only: messagenotify
    use dc_url, only: urlsplit, urlmerge
    use dc_date_types, only: dc_difftime
    use dc_date_generic, only: operator(==), dcdifftimecreate, &
      & mod, operator(-), evalbyunit, operator(/), tochar
    use dc_trace, only: beginsub, endsub, dbgmessage
    use mpi
    implicit none
    character(*), intent(in):: varname
    integer, intent(in):: arraysize
    integer, intent(in):: array(arraysize)
    type(GT_HISTORY), intent(inout), target, optional:: history
    character(*), intent(in), optional:: range
                              ! gtool4 のコンマ記法による
                              ! データの出力範囲指定
                              !
                              ! このオプションを用いる
                              ! 際には、必ず *HistorySetTime*
                              ! によって明示的に時刻の設定
                              ! を行ってください。
                              ! また、*HistoryGet* と異なり、
                              ! 時刻に関する範囲指定は
                              ! 行なえません。
                              !
                              ! 書式に関する詳細は
                              ! {gtool4 netCDF 規約}[link:../xref.htm#label-6]
                              ! の「5.4 コンマ記法」を参照して
                              ! ください。
    real, intent(in), optional:: time
                              !
                              ! 時刻. (単精度実数型)
                              !
                              ! この引数を与える場合,
                              ! 出力するかどうかをプログラムが
                              ! 自動的に判断します.
                              ! *time* に与えられた数値が
                              ! HistoryCreate に与えた *interval*
                              ! で割り切れる場合には出力が行われます.
                              !
                              ! HistoryAddVariable で
                              ! *time_average* (または *average*)
                              ! に .true. を与えた場合には,
                              ! *time*, *difftime*
                              ! のどちらの引数も与えない場合に,
                              ! プログラムはエラーを発生させます.
                              !
                              ! また, この引数と *range* は併用できません.
                              ! 併用した場合には,
                              ! プログラムはエラーを発生させます.
                              !
    logical, intent(in), optional:: quiet
                              ! .false. を与えた場合,
                              ! このサブルーチンが呼ばれる毎に
                              ! ファイル名と時刻が表示されます.
                              ! デフォルトは .true. です.
                              !
                              ! If ".false." is given,
                              ! a filename and time is displayed
                              ! when this subroutine is called.
                              ! Default value is ".true.".
                              !
    type(DC_DIFFTIME), intent(in), optional:: difftime
                              !
                              ! 時刻 (dc_date_types::DC_DIFFTIME 型)
                              !
                              ! 効果は *time* と同様です.
                              !
    real(DP), intent(in), optional:: timed
                              !
                              ! 時刻 (倍精度実数型)
                              !
                              ! 効果は *time* と同様です.
                              !
    logical, intent(in), optional:: time_average_store
                              !
                              ! 平均値の出力フラグ.
                              ! この値に .true. を与えた場合には,
                              ! 出力せずに与えられた値を一旦蓄えます.
                              ! .false. を与えた場合には,
                              ! *time* もしくは *difftime* と
                              ! HistoryCreate に与えた *interval* に
                              ! 関わらず出力を行います.
                              !
                              ! HistoryAddVariable で
                              ! *time_average* (または *average*)
                              ! に .true. を与えない場合は無効です.
                              !
                              ! *time* と *difftime*
                              ! のどちらかを同時に与える必要があります.
                              !
    logical, intent(out), optional:: err
                              ! 例外処理用フラグ.
                              ! デフォルトでは, この手続き内でエラーが
                              ! 生じた場合, プログラムは強制終了します.
                              ! 引数 *err* が与えられる場合,
                              ! プログラムは強制終了せず, 代わりに
                              ! *err* に .true. が代入されます.
                              !
                              ! Exception handling flag.
                              ! By default, when error occur in
                              ! this procedure, the program aborts.
                              ! If this *err* argument is given,
                              ! .true. is substituted to *err* and
                              ! the program does not abort.
    type(GT_VARIABLE):: var, timevar
    character(STRING):: url, file, time_str
    real:: time_value(1:1)
    type(GT_HISTORY), pointer:: hst =>null()
    integer :: v_ord
    character(STRING):: avr_msg
                        integer, target:: array_work(arraysize)
    integer, pointer:: array_work2(:) =>null()
    integer:: arraysize_work2
    integer, allocatable:: start(:), count(:), stride(:)
    integer :: i, dims
    logical :: slice_err
    character(STRING):: time_name
    character(*), parameter:: bnds_suffix = '_bnds'
    type(GT_VARIABLE):: bndsvar
    integer:: bnds_ord, time_count, bnds_rank
    logical:: output_step
    real(DP):: timedw
!    type(DC_DIFFTIME):: difftimew
    real(DP):: avr_coef
    integer, allocatable:: array_overwrap(:)
    integer:: new_index
    integer:: numdims, dimord, dimsize, dimsize_max, allcount, ra
    character(STRING):: dimname
    integer:: st_mpi(MPI_STATUS_SIZE)
    integer, allocatable:: array_mpi_tmp(:)
    integer, allocatable:: array_mpi_all(:,:)
    integer:: stat
    integer:: err_mpi
    character(STRING):: cause_c
    interface timegoahead
      subroutine timegoahead( varname, var, head, history, err )
        use gtdata_types, only: gt_variable
        use gtool_history_types, only: gt_history
        character(len = *), intent(in):: varname
        type(GT_VARIABLE), intent(out):: var
        real, intent(in):: head
        type(GT_HISTORY), intent(inout), optional, target:: history
        logical, intent(out), optional:: err
      end subroutine timegoahead
    end interface
    character(*), parameter:: subname = "HistoryPutIntEx"
  continue
    call beginsub(subname, 'varname=%a range=%a', &
      & ca=stoa(varname, present_select('', '(no-range)', range)))
    stat = dc_noerr
    cause_c = ""
    if (present(history)) then
      hst => history
    else
      hst => default
    endif
    !-----------------------------------------------------------------
    !  初期設定のチェック
    !  Check initialization
    !-----------------------------------------------------------------
    if ( .not. hst % initialized ) then
      stat = dc_enotinit
      cause_c = 'GT_HISTORY'
      goto 999
    end if
    !-----------------------------------------------------------------
    !  time と range の同時使用の禁止
    !  Permit concurrent use of "time" and "range"
    !-----------------------------------------------------------------
    if ( ( present(time) .or. present(difftime) .or. present(timed) ) &
      &  .and. present_and_not_empty(range) ) then
      call messagenotify('W', subname, &
        & '(varname=%c) "range" and "time" or "timed" or "difftime" are not suppored at the same time', &
        & c1 = trim(varname) )
      stat = usr_errno
      cause_c = '"range" and "time" or "timed" or "difftime" are not suppored at the same time'
      goto 999
    end if
    !-----------------------------------------------------------------
    !  hst 内の varname 変数の変数番号を取得
    !  Get variable number of "varname" in "hst"
    !-----------------------------------------------------------------
    if ( .not. hst % mpi_gather ) then
      v_ord = lookup_variable_ord(hst, varname)
    else
      if ( hst % mpi_myrank == 0 ) then
        v_ord = lookup_variable_ord(hst, varname)
      end if
      call mpi_bcast( v_ord, 1, mpi_integer, 0, mpi_comm_world, err_mpi )
      call dbgmessage('v_ord=<%d> is shared on all nodes.', i = (/v_ord/) )
    end if
                        timedw = 0.0_dp
    !-----------------------------------------------------------------
    !  時間平均値のためのデータ格納
    !  Store data for time average value
    !-----------------------------------------------------------------
    if ( present(difftime) ) then
      timedw = evalbyunit( difftime, '', hst % unlimited_units_symbol )
    elseif ( present(timed) ) then
      timedw = timed
    elseif ( present(time) ) then
      timedw = time
    end if
    if ( v_ord > 0 ) then
      !
      ! var_avr_count == -1: 平均処理は行わない.
      ! var_avr_count >=  0: 平均処理を行う.
      !
      ! これらは HistoryAddVariable で指定される.
      !
      if ( hst % var_avr_count( v_ord ) > -1 ) then
        ! 時刻が指定されない場合には平均処理が不可能なため
        ! エラー発生. dc_error のエラーメッセージだけでは多少
        ! 不親切なので, エラー直前に下記の警告メッセージ表示.
        !
        if (       .not. present(time) &
          &  .and. .not. present(timed) &
          &  .and. .not. present(difftime) ) then
          call messagenotify('W', subname, &
            & '(varname=%c) arguments "time" or "timed" or "difftime" are needed ' // &
            & 'when "time_average=.true." is specified to "HistoryAddVariable"', &
            & c1 = trim(varname) )
          stat = dc_earglack
          cause_c = 'time'
          goto 999
        end if
        ! 与えられたデータのサイズと内部で積算しているデータのサイズが
        ! 一致しない場合にもエラーを発生.
        ! データサイズは HistoryPut -> HistoryPutEx の際に
        ! 全て 1 次元化しているため, 単純に配列サイズでのみ判定.
        ! dc_error のエラーメッセージだけでは多少
        ! 不親切なので, エラー直前に下記の警告メッセージ表示.
        !
        if ( arraysize /= hst % var_avr_data( v_ord ) % length ) then
          call messagenotify('W', subname, &
            & '(varname=%c) size of array should be (%d). size of array is (%d)', &
            & i = (/hst % var_avr_data( v_ord ) % length, arraysize/), &
            & c1 = trim(varname) )
          stat = gt_eargsizemismatch
          cause_c = 'array'
          goto 999
        end if
        ! この if 〜 end if では以下の動作を行う.
        !
        ! * 平均処理時の係数 (avr_coef) の算出
        ! * 係数を算出するための以下の値の設定
        !   * 基本時間間隔 (var_avr_baseint)
        !   * 前回出力の時刻 (var_avr_prevtime)
        ! * 初回出力の判定を行うラベル (var_avr_firstput) の設定
        !
        ! 1 度目に呼ばれた場合はとりあえず係数を 1.0 にするとともに,
        ! prevtime に現在時刻を保管
        !
        if ( hst % var_avr_firstput( v_ord ) ) then
          if ( hst % var_avr_count( v_ord ) == 0 ) then
            avr_coef = 1.0_dp
            hst % var_avr_prevtime( v_ord ) = timedw
          else
            hst % var_avr_baseint( v_ord ) = &
              & timedw - hst % var_avr_prevtime( v_ord )
            avr_coef = 1.0_dp
            hst % var_avr_prevtime( v_ord ) = timedw
            hst % var_avr_firstput( v_ord ) = .false.
          end if
        ! 2 度目以降に呼ばれた場合
        !
        else
          ! 前回出力を行った (var_avr_count == 0 に初期化された)
          ! 場合には baseint に前回時刻と今回時刻の差を設定.
          ! avr_coef には 1 を設定.
          ! 最後に prevtime に今回の時刻を保管.
          !
          if ( hst % var_avr_count( v_ord ) == 0 ) then
            hst % var_avr_baseint( v_ord ) = &
              & timedw - hst % var_avr_prevtime( v_ord )
            avr_coef = 1.0_dp
            hst % var_avr_prevtime( v_ord ) = timedw
          ! var_avr_count > 0 (平均処理されるデータが蓄積されている)
          ! 場合には avr_coef には前回時刻と今回時刻の差の,
          ! baseint からの比を設定する.
          ! 最後に prevtime に今回の時刻を保管.
          !
          else
            avr_coef = ( timedw - hst % var_avr_prevtime( v_ord ) ) &
              &          / hst % var_avr_baseint( v_ord )
            hst % var_avr_prevtime( v_ord ) = timedw
          end if
        end if
        ! 積算値 a_DataAvr に, 今回のデータに係数を掛けたもの
        ! を加算する.
        !
        hst % var_avr_data( v_ord ) % a_DataAvr = &
          & hst % var_avr_data( v_ord ) % a_DataAvr + array * avr_coef
        ! 積算カウント var_avr_count に +1 し,
        ! 係数の積算値 var_avr_coefsum に今回設定された
        ! 係数を加算する.
        !
        hst % var_avr_count( v_ord ) = &
          & hst % var_avr_count( v_ord ) + 1
        hst % var_avr_coefsum( v_ord ) = &
          & hst % var_avr_coefsum( v_ord ) + avr_coef
        ! time_bnds(2) に今回の時刻を設定する.
        ! (毎回上書きされる).
        !
        if ( present(difftime) ) then
          hst % time_bnds(2:2) = evalbyunit( difftime, '', hst % unlimited_units_symbol )
        elseif ( present (timed) ) then
          hst % time_bnds(2:2) = timed
        else
          hst % time_bnds(2:2) = time
        end if
      end if
    end if
    !-----------------------------------------------------------------
    !  初期時刻の設定
    !  Configure initial time
    !-----------------------------------------------------------------
    if ( .not. hst % origin_setting ) then
      if ( present(difftime) ) then
        hst % origin         = evalbyunit( difftime, '', hst % unlimited_units_symbol )
        hst % time_bnds      = evalbyunit( difftime, '', hst % unlimited_units_symbol )
        hst % origin_setting = .true.
      elseif ( present(timed) ) then
        hst % origin         = timed
        hst % time_bnds      = timed
        hst % origin_setting = .true.
      elseif ( present(time) ) then
        hst % origin         = time
        hst % time_bnds      = time
        hst % origin_setting = .true.
      end if
!!$      if ( present(difftime) ) then
!!$        hst % origin         = difftime
!!$        hst % time_bnds      = EvalByUnit( difftime, '', hst % unlimited_units_symbol )
!!$        hst % origin_setting = .true.
!!$      elseif ( present(timed) ) then
!!$        call DCDiffTimeCreate( hst % origin, &              ! (out)
!!$          & real(timed), '', hst % unlimited_units_symbol ) ! (in)
!!$        hst % time_bnds      = timed
!!$        hst % origin_setting = .true.
!!$      elseif ( present(time) ) then
!!$        call DCDiffTimeCreate( hst % origin, &       ! (out)
!!$          & time, '', hst % unlimited_units_symbol ) ! (in)
!!$        hst % time_bnds      = time
!!$        hst % origin_setting = .true.
!!$      end if
    end if
                        !-----------------------------------------------------------------
    !  時刻の自動チェック
    !  Check time automatically
    !-----------------------------------------------------------------
    output_step = .true.
    if ( present_and_false(time_average_store) ) then
      output_step = .true.
    elseif ( present_and_true(time_average_store) ) then
      output_step = .false.
    elseif ( present(difftime) .or. present(timed) .or. present(time) ) then
      output_step = .false.
      if ( abs( hst % interval ) < dp_eps ) then
        output_step = .true.
      else
        if ( abs( mod( timedw - hst % origin, hst % interval ) ) < dp_eps ) then
          output_step = .true.
        end if
      end if
    end if
    !-------------------------
    !  時間平均値出力のための情報処理
    !  Information processing for output time-averaged value
    if ( .not. output_step ) then
      goto 999
    else
      array_work = array
      avr_msg = ''
      if ( v_ord > 0 ) then
        if ( hst % var_avr_count( v_ord ) > -1 ) then
          if ( present_and_false(quiet) ) then
            avr_msg = '(time average of ' // trim( tochar(hst % var_avr_count( v_ord )) ) // ' step data)'
          end if
          !-------------------
          !  蓄えた値の時間平均化
          !  Average stored value in time direction
          ! a_DataAvr に蓄えられた値を係数の積算値で割って,
          ! これを出力値とする.
          !
                              array_work = int( &
            & ( hst % var_avr_data( v_ord ) % a_DataAvr ) / ( hst % var_avr_coefsum( v_ord ) ), &
            & kind = kind(array_work) )
          ! 積算値, 積算カウント, 係数の積算値をクリアする.
          !
          hst % var_avr_data( v_ord ) % a_DataAvr = 0.0
          hst % var_avr_count( v_ord ) = 0
          hst % var_avr_coefsum( v_ord ) = 0.0_dp
          hst % var_avr_firstput( v_ord ) = .false.
        end if
      end if
    end if
    if ( .not. hst % mpi_gather ) then
      array_work2 => array_work
      arraysize_work2 = arraysize
    else
      !-----------------------------------------------------------------
      !  MPI 使用時に, 座標軸のデータが与えられた場合には, そのデータを保管.
      !  If data of axis is given, the data is stored when MPI is used
      !-----------------------------------------------------------------
      numdims = size( hst % mpi_fileinfo % axes )
      if ( hst % mpi_myrank == 0 ) then
        dimord = 0
        do i = 1, numdims
          call historyaxisinquire( &
            & hst % mpi_fileinfo % axes(i), & ! (in)
            & name = dimname )                ! (out)
          if ( trim(varname) == trim(dimname) ) then
            dimord = i
            exit
          end if
        end do
        call mpi_bcast( dimord, 1, mpi_integer, 0, mpi_comm_world, err_mpi )
      else
        call mpi_bcast( dimord, 1, mpi_integer, 0, mpi_comm_world, err_mpi )
      end if
      if ( dimord > 0 ) then
        call historyaxisinquire( &
          & hst % mpi_fileinfo % axes(dimord), & ! (in)
          & size = dimsize_max )                 ! (out)
        dimsize = size( array )
        if ( dimsize > dimsize_max .and. hst % unlimited_index /= dimord ) then
          call messagenotify('W', subname, &
            & 'dim=<%c> data size (%d) exceeds size of the dim (%d) by HistoryCreate. ' //  &
            & 'the data will be trancated. ', &
            & i = (/ dimsize, dimsize_max /), c1 = trim(varname) )
          dimsize = dimsize_max
        end if
        if ( associated( hst % mpi_dimdata_each( dimord ) % a_Axis ) ) then
          deallocate( hst % mpi_dimdata_each( dimord ) % a_Axis )
        end if
        allocate( hst % mpi_dimdata_each( dimord ) % a_Axis(dimsize) )
        hst % mpi_dimdata_each( dimord ) % a_Axis = array(1:dimsize)
        hst % mpi_dimdata_each( dimord ) % length = dimsize
      end if
      !-----------------------------------------------------------------
      !  MPI 使用時に, 従属変数のデータが与えられた場合, データ集約の情報を整理.
      !  If data of dependent variables is given,
      !    information for integration is arranged when MPI is used
      !-----------------------------------------------------------------
      if ( v_ord > 0 ) then
        if ( .not. associated( hst % mpi_gthr_info ) ) then
          call gtmpi_axis_register( hst, err ) ! (inout)
        end if
        if ( present_and_true( err ) ) goto 999
        if ( .not. associated( hst % mpi_vars_index( v_ord ) % allcount ) ) then
          call gtmpi_vars_mkindex( hst, v_ord, err ) ! (inout)
        end if
        if ( present_and_true( err ) ) goto 999
      end if
      !-----------------------------------------------------------------
      !  MPI 使用時は, 各ノードのデータを rank == 0 へ集約する.
      !  Data on each node is integrated when MPI is used
      !-----------------------------------------------------------------
      if ( v_ord > 0 ) then
        arraysize_work2 = hst % mpi_vars_index(v_ord) % allcount_all
        if ( arraysize_work2 < 1 ) arraysize_work2 = 1
        if ( hst % mpi_myrank == 0 ) then
          do ra = 1, hst % mpi_nprocs - 1
            allcount = hst % mpi_vars_index(v_ord) % allcount(ra)
            call mpi_send( allcount, 1, mpi_integer, ra, 0, mpi_comm_world, err_mpi )
          end do
        else
          call mpi_recv( allcount, 1, mpi_integer, 0, 0, mpi_comm_world, st_mpi, err_mpi )
        end if
        if ( hst % mpi_myrank /= 0 ) then
          call mpi_send( array_work, allcount, &
            & mpi_integer, 0, 0, mpi_comm_world, err_mpi )
        else
          allocate( array_mpi_all(0: hst % mpi_nprocs - 1, arraysize_work2 ) )
          allocate( array_mpi_tmp( arraysize_work2 ) )
          array_mpi_all(:,:) = 0
          array_mpi_tmp(:) = 0
          allcount = hst % mpi_vars_index(v_ord) % allcount(0)
          array_mpi_all(0,1:allcount) = array_work
          do ra = 1, hst % mpi_nprocs - 1
            allcount = hst % mpi_vars_index(v_ord) % allcount(ra)
            call mpi_recv( array_mpi_tmp(1:allcount), allcount, &
              & mpi_integer, ra, 0, mpi_comm_world, st_mpi, err_mpi )
            array_mpi_all(ra,1:allcount) = array_mpi_tmp(1:allcount)
          end do
          allocate( array_work2( arraysize_work2 ) )
          allocate( array_overwrap( arraysize_work2 ) )
          array_work2 = 0
          array_overwrap(:) = 0
          do ra = 0, hst % mpi_nprocs - 1
            do i = 1, hst % mpi_vars_index(v_ord) % allcount(ra)
              new_index = hst % mpi_vars_index(v_ord) % each2all(ra, i)
              array_work2( new_index ) = &
                & array_work2( new_index ) + array_mpi_all( ra, i )
              array_overwrap( new_index ) = array_overwrap( new_index ) + 1
            end do
          end do
          where ( array_overwrap == 0 )
            array_overwrap = 1
          end where
          array_work2(:) = array_work2(:) / array_overwrap(:)
          deallocate( array_mpi_all, array_mpi_tmp, array_overwrap )
          ! array_work2 はデータ出力の後に割り付け解除される.
        end if
      else
        array_work2 => array_work
        arraysize_work2 = arraysize
      end if
    end if
    !-----------------------------------------------------------------
    !  時刻を1つ進めて, データ出力
    !  Progress one time, and output data
    !-----------------------------------------------------------------
    if ( .not. hst % mpi_gather &
      &  .or. ( hst % mpi_gather    .and. &
      &         hst % mpi_myrank == 0 .and. &
      &         hst % mpi_fileinfo % already_output) ) then
    call timegoahead( &
      & varname = varname, &     ! (in)
                          & head = real(array_work2(1)), & ! (in)
      & var = var, &             ! (out)
      & history = history, &     ! (inout)
      & err = err )              ! (out)
    call inquire( var, & ! (in)
      & alldims=dims )   ! (out)
    if (present_and_not_empty(range) .and. (dims < 1)) then
      call dbgmessage('varname=<%c> has no dimension. so range is ignoread.', &
      & c1=trim(varname))
    end if
    if (.not. (present_and_not_empty(range) .and. (dims > 0))) then
      ! range 無しの普通の出力の場合
      call put(var, array_work2, arraysize_work2)
    else
      ! range があり, 且つ varname がちゃんと次元を持っている場合
      !
      ! 元々の start, count, stride を保持. データを与えた後に復元する.
      allocate(start(dims), count(dims), stride(dims))
      do i = 1, dims
        call get_slice(var, i, start(i), count(i), stride(i))
      end do
      slice_err = .false. ! 不要だが Slice の引用仕様として必要なため
      call slice(var, range, slice_err)
      call put(var, array_work2, arraysize_work2)
      ! 復元
      do i = 1, dims
        call slice(var, i, start(i), count(i), stride(i))
      end do
      deallocate(start, count, stride)
    end if
    call gtvarsync(var)
    if ( hst % mpi_gather .and. v_ord > 0 ) then
      deallocate( array_work2 )
    end if
    end if
                        !-----------------------------------------------------------------
    !  "time_bnds" 変数への出力
    !  Output to "time_bnds" variable
    !-----------------------------------------------------------------
    if ( .not. hst % mpi_gather &
      &  .or. ( hst % mpi_gather    .and. &
      &         hst % mpi_myrank == 0 .and. &
      &         hst % mpi_fileinfo % already_output ) ) then
    if ( v_ord > 0 ) then
      if ( hst % var_avr_count( v_ord ) > -1 ) then
        !-------------------
        !  時間次元の名前とファイル名を取得
        !  Get name of time dimension, and filename
        timevar = hst % dimvars( hst % unlimited_index )
        call inquire( &
          & var = timevar, &   ! (in)
          & url = url, &       ! (out)
          & name = time_name ) ! (out)
        call urlsplit( fullname = url, &  ! (in)
          & file = file )                 ! (out)
        !-------------------
        !  "time_bnds" 変数の取得
        !  Get "time_bnds" variable
        call open( var = bndsvar, &
          & url = urlmerge(file=file, var=trim(time_name) // bnds_suffix) )
        bnds_ord = lookup_variable_ord( hst, trim(time_name) // bnds_suffix)
        !-------------------
        !  "time_bnds" 変数への出力
        !  Output to "time_bnds" variable
        call inquire( &
          & var = bndsvar, &                        ! (in)
          & rank = bnds_rank )                      ! (out)
        time_count = 1
        if ( bnds_rank > 1 ) then
          call inquire( &
            & var = bndsvar, &                             ! (in)
            & dimord = hst % growable_indices(bnds_ord), & ! (in)
            & allcount = time_count )                      ! (out)
        end if
        if  ( (hst % time_bnds_output_count < 1) &
          &  .or. (hst % time_bnds_output_count < time_count) ) then
          call slice(bndsvar, hst % growable_indices(bnds_ord), & ! (in)
            & start=hst % time_bnds_output_count+1, count=1)        ! (in)
          call put(bndsvar, hst % time_bnds, 2)
          hst % time_bnds_output_count = hst % time_bnds_output_count + 1
        end if
        call close( var = bndsvar ) ! (inout)
        if ( present(difftime) ) then
          hst % time_bnds(1:1) = &
            & evalbyunit( difftime, '', hst % unlimited_units_symbol )
        elseif ( present(timed) ) then
          hst % time_bnds(1:1) = timed
        else
          hst % time_bnds(1:1) = time
        end if
      end if
    end if
    end if
    !-----------------------------------------------------------------
    !  メッセージ出力
    !  Output messages
    !-----------------------------------------------------------------
    if ( .not. hst % mpi_gather &
      &  .or. ( hst % mpi_gather    .and. &
      &         hst % mpi_myrank == 0 .and. &
      &         hst % mpi_fileinfo % already_output ) ) then
    if ( present_and_false(quiet) ) then
      call inquire( hst % dimvars(1), & ! (in)
        & url = url )                   ! (out)
      call urlsplit( fullname = url, &  ! (in)
        & file = file )                 ! (out)
      if ( hst % unlimited_index < 1 ) then
        time_str = ''
      else
        timevar = hst % dimvars(hst % unlimited_index)
        call slice( timevar, &                     ! (in)
          & 1, start = hst % count(v_ord), count = 1 ) ! (in)
        call get( timevar, & ! (inout)
          & time_value, &    ! (out)
          & 1, &             ! (in)
          & err )            ! (out)
        time_str = '(time=' // trim( tochar( time_value(1) )) // ')'
      end if
      call messagenotify('M', 'HistoryPut', &
        & '"%a" => "%a" %a %a', &
        & ca = stoa( varname, file, time_str, avr_msg ) )
    end if
    end if
    !-----------------------------------------------------------------
    !  終了処理, 例外処理
    !  Termination and Exception handling
    !-----------------------------------------------------------------
999 continue
    call storeerror( stat, subname, err, cause_c )
    call endsub(subname)

References dc_trace::beginsub(), dc_trace::dbgmessage(), dc_error::dc_earglack, dc_error::dc_enotinit, dc_error::dc_noerr, gtool_history_internal::default, dc_types::dp, dc_types::dp_eps, dc_trace::endsub(), dc_error::gt_eargsizemismatch, dc_string::joinchar(), dc_present::present_and_false(), dc_present::present_and_not_empty(), dc_present::present_and_true(), dc_error::storeerror(), dc_types::string, timegoahead(), and dc_error::usr_errno.

Here is the call graph for this function:

historyputreal0()

subroutine historyputreal0	(	character(*), intent(in)	varname,
		real, intent(in)	value,
		type(gt_history), intent(inout), optional, target	history,
		character(*), intent(in), optional	range,
		real, intent(in), optional	time,
		logical, intent(in), optional	quiet,
		type(dc_difftime), intent(in), optional	difftime,
		real(dp), intent(in), optional	timed,
		logical, intent(in), optional	time_average_store,
		logical, intent(out), optional	err
	)

Definition at line 3612 of file historyput.f90.

    !
    !
    use gtool_history_types, only: gt_history
    use dc_date_types, only: dc_difftime
    use dc_types, only: dp
    use dc_trace, only: beginsub, endsub, dbgmessage
    implicit none
    character(*), intent(in):: varname
    real, intent(in):: value
    type(GT_HISTORY), intent(inout), optional, target:: history
    character(*), intent(in), optional:: range
    real, intent(in), optional:: time
    logical, intent(in), optional:: quiet
    type(DC_DIFFTIME), intent(in), optional:: difftime
    real(DP), intent(in), optional:: timed
    logical, intent(in), optional:: time_average_store
    logical, intent(out), optional:: err
    interface historyputrealex
      subroutine historyputrealex( &
        & varname, array, arraysize, history, range, &
        & time, quiet, difftime, timed, time_average_store, err )
        use gtool_history_types, only: gt_history
        use dc_date_types, only: dc_difftime
        use dc_types, only: dp
        character(*), intent(in):: varname
        integer, intent(in):: arraysize
        real, intent(in):: array(arraysize)
        type(GT_HISTORY), intent(inout), target, optional:: history
        character(*), intent(in), optional:: range
        real, intent(in), optional:: time
        logical, intent(in), optional:: quiet
        type(DC_DIFFTIME), intent(in), optional:: difftime
        real(DP), intent(in), optional:: timed
        logical, intent(in), optional:: time_average_store
        logical, intent(out), optional:: err
      end subroutine historyputrealex
    end interface
    character(*), parameter:: subname = "HistoryPutReal0"
  continue
    call beginsub(subname)
    call historyputrealex( &
      & varname, &               ! (in)
      & (/value/), 1, &   ! (in)
      & history = history, &     ! (inout) optional
      & range = range, &         ! (in) optional
      & time = time, &           ! (in) optional
      & quiet = quiet, &         ! (in) optional
      & difftime = difftime, &   ! (in) optional
      & timed = timed, &         ! (in) optional
      & time_average_store = &
      &    time_average_store, & ! (in) optional
      & err = err )              ! (out) optional
    call endsub(subname)

References dc_trace::beginsub(), dc_trace::dbgmessage(), dc_types::dp, dc_trace::endsub(), and historyputrealex().

Here is the call graph for this function:

historyputreal1()

subroutine historyputreal1	(	character(*), intent(in)	varname,
		real, dimension(:), intent(in)	array,
		type(gt_history), intent(inout), optional, target	history,
		character(*), intent(in), optional	range,
		real, intent(in), optional	time,
		logical, intent(in), optional	quiet,
		type(dc_difftime), intent(in), optional	difftime,
		real(dp), intent(in), optional	timed,
		logical, intent(in), optional	time_average_store,
		logical, intent(out), optional	err
	)

Definition at line 3669 of file historyput.f90.

    !
    !
    use gtool_history_types, only: gt_history
    use dc_date_types, only: dc_difftime
    use dc_types, only: dp
    use dc_trace, only: beginsub, endsub, dbgmessage
    implicit none
    character(*), intent(in):: varname
    real, intent(in):: array(:)
    type(GT_HISTORY), intent(inout), optional, target:: history
    character(*), intent(in), optional:: range
    real, intent(in), optional:: time
    logical, intent(in), optional:: quiet
    type(DC_DIFFTIME), intent(in), optional:: difftime
    real(DP), intent(in), optional:: timed
    logical, intent(in), optional:: time_average_store
    logical, intent(out), optional:: err
    interface historyputrealex
      subroutine historyputrealex( &
        & varname, array, arraysize, history, range, &
        & time, quiet, difftime, timed, time_average_store, err )
        use gtool_history_types, only: gt_history
        use dc_date_types, only: dc_difftime
        use dc_types, only: dp
        character(*), intent(in):: varname
        integer, intent(in):: arraysize
        real, intent(in):: array(arraysize)
        type(GT_HISTORY), intent(inout), target, optional:: history
        character(*), intent(in), optional:: range
        real, intent(in), optional:: time
        logical, intent(in), optional:: quiet
        type(DC_DIFFTIME), intent(in), optional:: difftime
        real(DP), intent(in), optional:: timed
        logical, intent(in), optional:: time_average_store
        logical, intent(out), optional:: err
      end subroutine historyputrealex
    end interface
    character(*), parameter:: subname = "HistoryPutReal1"
  continue
    call beginsub(subname)
    call historyputrealex( &
      & varname, &               ! (in)
      & pack(array, .true.), size(array), &   ! (in)
      & history = history, &     ! (inout) optional
      & range = range, &         ! (in) optional
      & time = time, &           ! (in) optional
      & quiet = quiet, &         ! (in) optional
      & difftime = difftime, &   ! (in) optional
      & timed = timed, &         ! (in) optional
      & time_average_store = &
      &    time_average_store, & ! (in) optional
      & err = err )              ! (out) optional
    call endsub(subname)

References dc_trace::beginsub(), dc_trace::dbgmessage(), dc_types::dp, dc_trace::endsub(), and historyputrealex().

Here is the call graph for this function:

historyputreal2()

subroutine historyputreal2	(	character(*), intent(in)	varname,
		real, dimension(:,:), intent(in)	array,
		type(gt_history), intent(inout), optional, target	history,
		character(*), intent(in), optional	range,
		real, intent(in), optional	time,
		logical, intent(in), optional	quiet,
		type(dc_difftime), intent(in), optional	difftime,
		real(dp), intent(in), optional	timed,
		logical, intent(in), optional	time_average_store,
		logical, intent(out), optional	err
	)

Definition at line 3726 of file historyput.f90.

    !
    !
    use gtool_history_types, only: gt_history
    use dc_date_types, only: dc_difftime
    use dc_types, only: dp
    use dc_trace, only: beginsub, endsub, dbgmessage
    implicit none
    character(*), intent(in):: varname
    real, intent(in):: array(:,:)
    type(GT_HISTORY), intent(inout), optional, target:: history
    character(*), intent(in), optional:: range
    real, intent(in), optional:: time
    logical, intent(in), optional:: quiet
    type(DC_DIFFTIME), intent(in), optional:: difftime
    real(DP), intent(in), optional:: timed
    logical, intent(in), optional:: time_average_store
    logical, intent(out), optional:: err
    interface historyputrealex
      subroutine historyputrealex( &
        & varname, array, arraysize, history, range, &
        & time, quiet, difftime, timed, time_average_store, err )
        use gtool_history_types, only: gt_history
        use dc_date_types, only: dc_difftime
        use dc_types, only: dp
        character(*), intent(in):: varname
        integer, intent(in):: arraysize
        real, intent(in):: array(arraysize)
        type(GT_HISTORY), intent(inout), target, optional:: history
        character(*), intent(in), optional:: range
        real, intent(in), optional:: time
        logical, intent(in), optional:: quiet
        type(DC_DIFFTIME), intent(in), optional:: difftime
        real(DP), intent(in), optional:: timed
        logical, intent(in), optional:: time_average_store
        logical, intent(out), optional:: err
      end subroutine historyputrealex
    end interface
    character(*), parameter:: subname = "HistoryPutReal2"
  continue
    call beginsub(subname)
    call historyputrealex( &
      & varname, &               ! (in)
      & pack(array, .true.), size(array), &   ! (in)
      & history = history, &     ! (inout) optional
      & range = range, &         ! (in) optional
      & time = time, &           ! (in) optional
      & quiet = quiet, &         ! (in) optional
      & difftime = difftime, &   ! (in) optional
      & timed = timed, &         ! (in) optional
      & time_average_store = &
      &    time_average_store, & ! (in) optional
      & err = err )              ! (out) optional
    call endsub(subname)

References dc_trace::beginsub(), dc_trace::dbgmessage(), dc_types::dp, dc_trace::endsub(), and historyputrealex().

Here is the call graph for this function:

historyputreal3()

subroutine historyputreal3	(	character(*), intent(in)	varname,
		real, dimension(:,:,:), intent(in)	array,
		type(gt_history), intent(inout), optional, target	history,
		character(*), intent(in), optional	range,
		real, intent(in), optional	time,
		logical, intent(in), optional	quiet,
		type(dc_difftime), intent(in), optional	difftime,
		real(dp), intent(in), optional	timed,
		logical, intent(in), optional	time_average_store,
		logical, intent(out), optional	err
	)

Definition at line 3783 of file historyput.f90.

    !
    !
    use gtool_history_types, only: gt_history
    use dc_date_types, only: dc_difftime
    use dc_types, only: dp
    use dc_trace, only: beginsub, endsub, dbgmessage
    implicit none
    character(*), intent(in):: varname
    real, intent(in):: array(:,:,:)
    type(GT_HISTORY), intent(inout), optional, target:: history
    character(*), intent(in), optional:: range
    real, intent(in), optional:: time
    logical, intent(in), optional:: quiet
    type(DC_DIFFTIME), intent(in), optional:: difftime
    real(DP), intent(in), optional:: timed
    logical, intent(in), optional:: time_average_store
    logical, intent(out), optional:: err
    interface historyputrealex
      subroutine historyputrealex( &
        & varname, array, arraysize, history, range, &
        & time, quiet, difftime, timed, time_average_store, err )
        use gtool_history_types, only: gt_history
        use dc_date_types, only: dc_difftime
        use dc_types, only: dp
        character(*), intent(in):: varname
        integer, intent(in):: arraysize
        real, intent(in):: array(arraysize)
        type(GT_HISTORY), intent(inout), target, optional:: history
        character(*), intent(in), optional:: range
        real, intent(in), optional:: time
        logical, intent(in), optional:: quiet
        type(DC_DIFFTIME), intent(in), optional:: difftime
        real(DP), intent(in), optional:: timed
        logical, intent(in), optional:: time_average_store
        logical, intent(out), optional:: err
      end subroutine historyputrealex
    end interface
    character(*), parameter:: subname = "HistoryPutReal3"
  continue
    call beginsub(subname)
    call historyputrealex( &
      & varname, &               ! (in)
      & pack(array, .true.), size(array), &   ! (in)
      & history = history, &     ! (inout) optional
      & range = range, &         ! (in) optional
      & time = time, &           ! (in) optional
      & quiet = quiet, &         ! (in) optional
      & difftime = difftime, &   ! (in) optional
      & timed = timed, &         ! (in) optional
      & time_average_store = &
      &    time_average_store, & ! (in) optional
      & err = err )              ! (out) optional
    call endsub(subname)

References dc_trace::beginsub(), dc_trace::dbgmessage(), dc_types::dp, dc_trace::endsub(), and historyputrealex().

Here is the call graph for this function:

historyputreal4()

subroutine historyputreal4	(	character(*), intent(in)	varname,
		real, dimension(:,:,:,:), intent(in)	array,
		type(gt_history), intent(inout), optional, target	history,
		character(*), intent(in), optional	range,
		real, intent(in), optional	time,
		logical, intent(in), optional	quiet,
		type(dc_difftime), intent(in), optional	difftime,
		real(dp), intent(in), optional	timed,
		logical, intent(in), optional	time_average_store,
		logical, intent(out), optional	err
	)

Definition at line 3840 of file historyput.f90.

    !
    !
    use gtool_history_types, only: gt_history
    use dc_date_types, only: dc_difftime
    use dc_types, only: dp
    use dc_trace, only: beginsub, endsub, dbgmessage
    implicit none
    character(*), intent(in):: varname
    real, intent(in):: array(:,:,:,:)
    type(GT_HISTORY), intent(inout), optional, target:: history
    character(*), intent(in), optional:: range
    real, intent(in), optional:: time
    logical, intent(in), optional:: quiet
    type(DC_DIFFTIME), intent(in), optional:: difftime
    real(DP), intent(in), optional:: timed
    logical, intent(in), optional:: time_average_store
    logical, intent(out), optional:: err
    interface historyputrealex
      subroutine historyputrealex( &
        & varname, array, arraysize, history, range, &
        & time, quiet, difftime, timed, time_average_store, err )
        use gtool_history_types, only: gt_history
        use dc_date_types, only: dc_difftime
        use dc_types, only: dp
        character(*), intent(in):: varname
        integer, intent(in):: arraysize
        real, intent(in):: array(arraysize)
        type(GT_HISTORY), intent(inout), target, optional:: history
        character(*), intent(in), optional:: range
        real, intent(in), optional:: time
        logical, intent(in), optional:: quiet
        type(DC_DIFFTIME), intent(in), optional:: difftime
        real(DP), intent(in), optional:: timed
        logical, intent(in), optional:: time_average_store
        logical, intent(out), optional:: err
      end subroutine historyputrealex
    end interface
    character(*), parameter:: subname = "HistoryPutReal4"
  continue
    call beginsub(subname)
    call historyputrealex( &
      & varname, &               ! (in)
      & pack(array, .true.), size(array), &   ! (in)
      & history = history, &     ! (inout) optional
      & range = range, &         ! (in) optional
      & time = time, &           ! (in) optional
      & quiet = quiet, &         ! (in) optional
      & difftime = difftime, &   ! (in) optional
      & timed = timed, &         ! (in) optional
      & time_average_store = &
      &    time_average_store, & ! (in) optional
      & err = err )              ! (out) optional
    call endsub(subname)

References dc_trace::beginsub(), dc_trace::dbgmessage(), dc_types::dp, dc_trace::endsub(), and historyputrealex().

Here is the call graph for this function:

historyputreal5()

subroutine historyputreal5	(	character(*), intent(in)	varname,
		real, dimension(:,:,:,:,:), intent(in)	array,
		type(gt_history), intent(inout), optional, target	history,
		character(*), intent(in), optional	range,
		real, intent(in), optional	time,
		logical, intent(in), optional	quiet,
		type(dc_difftime), intent(in), optional	difftime,
		real(dp), intent(in), optional	timed,
		logical, intent(in), optional	time_average_store,
		logical, intent(out), optional	err
	)

Definition at line 3897 of file historyput.f90.

    !
    !
    use gtool_history_types, only: gt_history
    use dc_date_types, only: dc_difftime
    use dc_types, only: dp
    use dc_trace, only: beginsub, endsub, dbgmessage
    implicit none
    character(*), intent(in):: varname
    real, intent(in):: array(:,:,:,:,:)
    type(GT_HISTORY), intent(inout), optional, target:: history
    character(*), intent(in), optional:: range
    real, intent(in), optional:: time
    logical, intent(in), optional:: quiet
    type(DC_DIFFTIME), intent(in), optional:: difftime
    real(DP), intent(in), optional:: timed
    logical, intent(in), optional:: time_average_store
    logical, intent(out), optional:: err
    interface historyputrealex
      subroutine historyputrealex( &
        & varname, array, arraysize, history, range, &
        & time, quiet, difftime, timed, time_average_store, err )
        use gtool_history_types, only: gt_history
        use dc_date_types, only: dc_difftime
        use dc_types, only: dp
        character(*), intent(in):: varname
        integer, intent(in):: arraysize
        real, intent(in):: array(arraysize)
        type(GT_HISTORY), intent(inout), target, optional:: history
        character(*), intent(in), optional:: range
        real, intent(in), optional:: time
        logical, intent(in), optional:: quiet
        type(DC_DIFFTIME), intent(in), optional:: difftime
        real(DP), intent(in), optional:: timed
        logical, intent(in), optional:: time_average_store
        logical, intent(out), optional:: err
      end subroutine historyputrealex
    end interface
    character(*), parameter:: subname = "HistoryPutReal5"
  continue
    call beginsub(subname)
    call historyputrealex( &
      & varname, &               ! (in)
      & pack(array, .true.), size(array), &   ! (in)
      & history = history, &     ! (inout) optional
      & range = range, &         ! (in) optional
      & time = time, &           ! (in) optional
      & quiet = quiet, &         ! (in) optional
      & difftime = difftime, &   ! (in) optional
      & timed = timed, &         ! (in) optional
      & time_average_store = &
      &    time_average_store, & ! (in) optional
      & err = err )              ! (out) optional
    call endsub(subname)

References dc_trace::beginsub(), dc_trace::dbgmessage(), dc_types::dp, dc_trace::endsub(), and historyputrealex().

Here is the call graph for this function:

historyputreal6()

subroutine historyputreal6	(	character(*), intent(in)	varname,
		real, dimension(:,:,:,:,:,:), intent(in)	array,
		type(gt_history), intent(inout), optional, target	history,
		character(*), intent(in), optional	range,
		real, intent(in), optional	time,
		logical, intent(in), optional	quiet,
		type(dc_difftime), intent(in), optional	difftime,
		real(dp), intent(in), optional	timed,
		logical, intent(in), optional	time_average_store,
		logical, intent(out), optional	err
	)

Definition at line 3954 of file historyput.f90.

    !
    !
    use gtool_history_types, only: gt_history
    use dc_date_types, only: dc_difftime
    use dc_types, only: dp
    use dc_trace, only: beginsub, endsub, dbgmessage
    implicit none
    character(*), intent(in):: varname
    real, intent(in):: array(:,:,:,:,:,:)
    type(GT_HISTORY), intent(inout), optional, target:: history
    character(*), intent(in), optional:: range
    real, intent(in), optional:: time
    logical, intent(in), optional:: quiet
    type(DC_DIFFTIME), intent(in), optional:: difftime
    real(DP), intent(in), optional:: timed
    logical, intent(in), optional:: time_average_store
    logical, intent(out), optional:: err
    interface historyputrealex
      subroutine historyputrealex( &
        & varname, array, arraysize, history, range, &
        & time, quiet, difftime, timed, time_average_store, err )
        use gtool_history_types, only: gt_history
        use dc_date_types, only: dc_difftime
        use dc_types, only: dp
        character(*), intent(in):: varname
        integer, intent(in):: arraysize
        real, intent(in):: array(arraysize)
        type(GT_HISTORY), intent(inout), target, optional:: history
        character(*), intent(in), optional:: range
        real, intent(in), optional:: time
        logical, intent(in), optional:: quiet
        type(DC_DIFFTIME), intent(in), optional:: difftime
        real(DP), intent(in), optional:: timed
        logical, intent(in), optional:: time_average_store
        logical, intent(out), optional:: err
      end subroutine historyputrealex
    end interface
    character(*), parameter:: subname = "HistoryPutReal6"
  continue
    call beginsub(subname)
    call historyputrealex( &
      & varname, &               ! (in)
      & pack(array, .true.), size(array), &   ! (in)
      & history = history, &     ! (inout) optional
      & range = range, &         ! (in) optional
      & time = time, &           ! (in) optional
      & quiet = quiet, &         ! (in) optional
      & difftime = difftime, &   ! (in) optional
      & timed = timed, &         ! (in) optional
      & time_average_store = &
      &    time_average_store, & ! (in) optional
      & err = err )              ! (out) optional
    call endsub(subname)

References dc_trace::beginsub(), dc_trace::dbgmessage(), dc_types::dp, dc_trace::endsub(), and historyputrealex().

Here is the call graph for this function:

historyputreal7()

subroutine historyputreal7	(	character(*), intent(in)	varname,
		real, dimension(:,:,:,:,:,:,:), intent(in)	array,
		type(gt_history), intent(inout), optional, target	history,
		character(*), intent(in), optional	range,
		real, intent(in), optional	time,
		logical, intent(in), optional	quiet,
		type(dc_difftime), intent(in), optional	difftime,
		real(dp), intent(in), optional	timed,
		logical, intent(in), optional	time_average_store,
		logical, intent(out), optional	err
	)

Definition at line 4011 of file historyput.f90.

    !
    !
    use gtool_history_types, only: gt_history
    use dc_date_types, only: dc_difftime
    use dc_types, only: dp
    use dc_trace, only: beginsub, endsub, dbgmessage
    implicit none
    character(*), intent(in):: varname
    real, intent(in):: array(:,:,:,:,:,:,:)
    type(GT_HISTORY), intent(inout), optional, target:: history
    character(*), intent(in), optional:: range
    real, intent(in), optional:: time
    logical, intent(in), optional:: quiet
    type(DC_DIFFTIME), intent(in), optional:: difftime
    real(DP), intent(in), optional:: timed
    logical, intent(in), optional:: time_average_store
    logical, intent(out), optional:: err
    interface historyputrealex
      subroutine historyputrealex( &
        & varname, array, arraysize, history, range, &
        & time, quiet, difftime, timed, time_average_store, err )
        use gtool_history_types, only: gt_history
        use dc_date_types, only: dc_difftime
        use dc_types, only: dp
        character(*), intent(in):: varname
        integer, intent(in):: arraysize
        real, intent(in):: array(arraysize)
        type(GT_HISTORY), intent(inout), target, optional:: history
        character(*), intent(in), optional:: range
        real, intent(in), optional:: time
        logical, intent(in), optional:: quiet
        type(DC_DIFFTIME), intent(in), optional:: difftime
        real(DP), intent(in), optional:: timed
        logical, intent(in), optional:: time_average_store
        logical, intent(out), optional:: err
      end subroutine historyputrealex
    end interface
    character(*), parameter:: subname = "HistoryPutReal7"
  continue
    call beginsub(subname)
    call historyputrealex( &
      & varname, &               ! (in)
      & pack(array, .true.), size(array), &   ! (in)
      & history = history, &     ! (inout) optional
      & range = range, &         ! (in) optional
      & time = time, &           ! (in) optional
      & quiet = quiet, &         ! (in) optional
      & difftime = difftime, &   ! (in) optional
      & timed = timed, &         ! (in) optional
      & time_average_store = &
      &    time_average_store, & ! (in) optional
      & err = err )              ! (out) optional
    call endsub(subname)

References dc_trace::beginsub(), dc_trace::dbgmessage(), dc_types::dp, dc_trace::endsub(), and historyputrealex().

Here is the call graph for this function:

historyputrealex()

recursive subroutine historyputrealex	(	character(*), intent(in)	varname,
		real, dimension(arraysize), intent(in)	array,
		integer, intent(in)	arraysize,
		type(gt_history), intent(inout), optional, target	history,
		character(*), intent(in), optional	range,
		real, intent(in), optional	time,
		logical, intent(in), optional	quiet,
		type(dc_difftime), intent(in), optional	difftime,
		real(dp), intent(in), optional	timed,
		logical, intent(in), optional	time_average_store,
		logical, intent(out), optional	err
	)

データ出力

Parameters

[in]

varname

iline 1

こちらは配列サイズを指定する必要があるため、 HistoryPut を利用してください。

Definition at line 37 of file historyput.f90.

    !
    !
    use gtool_history_types, only: gt_history
    use gtool_history_generic, only: historyaxisinquire
    use gtool_history_internal, only: default, lookup_variable_ord
    use gtool_history_internal, only: gtmpi_axis_register, gtmpi_vars_mkindex
    use gtdata_generic, only: put, gtvarsync, slice, inquire, &
      & get_slice, get, putline, open, close
    use gtdata_types, only: gt_variable
    use dc_types, only: string, dp, dp_eps
    use dc_string, only: stoa, printf, tochar, joinchar
    use dc_present, only: present_and_not_empty, present_select, &
      & present_and_false, present_and_true
    use dc_error, only: storeerror, dc_noerr, dc_enotinit, usr_errno, dc_earglack, gt_eargsizemismatch
    use dc_message, only: messagenotify
    use dc_url, only: urlsplit, urlmerge
    use dc_date_types, only: dc_difftime
    use dc_date_generic, only: operator(==), dcdifftimecreate, &
      & mod, operator(-), evalbyunit, operator(/), tochar
    use dc_trace, only: beginsub, endsub, dbgmessage
    use mpi
    implicit none
    character(*), intent(in):: varname
    integer, intent(in):: arraysize
    real, intent(in):: array(arraysize)
    type(GT_HISTORY), intent(inout), target, optional:: history
    character(*), intent(in), optional:: range
                              ! gtool4 のコンマ記法による
                              ! データの出力範囲指定
                              !
                              ! このオプションを用いる
                              ! 際には、必ず *HistorySetTime*
                              ! によって明示的に時刻の設定
                              ! を行ってください。
                              ! また、*HistoryGet* と異なり、
                              ! 時刻に関する範囲指定は
                              ! 行なえません。
                              !
                              ! 書式に関する詳細は
                              ! {gtool4 netCDF 規約}[link:../xref.htm#label-6]
                              ! の「5.4 コンマ記法」を参照して
                              ! ください。
    real, intent(in), optional:: time
                              !
                              ! 時刻. (単精度実数型)
                              !
                              ! この引数を与える場合,
                              ! 出力するかどうかをプログラムが
                              ! 自動的に判断します.
                              ! *time* に与えられた数値が
                              ! HistoryCreate に与えた *interval*
                              ! で割り切れる場合には出力が行われます.
                              !
                              ! HistoryAddVariable で
                              ! *time_average* (または *average*)
                              ! に .true. を与えた場合には,
                              ! *time*, *difftime*
                              ! のどちらの引数も与えない場合に,
                              ! プログラムはエラーを発生させます.
                              !
                              ! また, この引数と *range* は併用できません.
                              ! 併用した場合には,
                              ! プログラムはエラーを発生させます.
                              !
    logical, intent(in), optional:: quiet
                              ! .false. を与えた場合,
                              ! このサブルーチンが呼ばれる毎に
                              ! ファイル名と時刻が表示されます.
                              ! デフォルトは .true. です.
                              !
                              ! If ".false." is given,
                              ! a filename and time is displayed
                              ! when this subroutine is called.
                              ! Default value is ".true.".
                              !
    type(DC_DIFFTIME), intent(in), optional:: difftime
                              !
                              ! 時刻 (dc_date_types::DC_DIFFTIME 型)
                              !
                              ! 効果は *time* と同様です.
                              !
    real(DP), intent(in), optional:: timed
                              !
                              ! 時刻 (倍精度実数型)
                              !
                              ! 効果は *time* と同様です.
                              !
    logical, intent(in), optional:: time_average_store
                              !
                              ! 平均値の出力フラグ.
                              ! この値に .true. を与えた場合には,
                              ! 出力せずに与えられた値を一旦蓄えます.
                              ! .false. を与えた場合には,
                              ! *time* もしくは *difftime* と
                              ! HistoryCreate に与えた *interval* に
                              ! 関わらず出力を行います.
                              !
                              ! HistoryAddVariable で
                              ! *time_average* (または *average*)
                              ! に .true. を与えない場合は無効です.
                              !
                              ! *time* と *difftime*
                              ! のどちらかを同時に与える必要があります.
                              !
    logical, intent(out), optional:: err
                              ! 例外処理用フラグ.
                              ! デフォルトでは, この手続き内でエラーが
                              ! 生じた場合, プログラムは強制終了します.
                              ! 引数 *err* が与えられる場合,
                              ! プログラムは強制終了せず, 代わりに
                              ! *err* に .true. が代入されます.
                              !
                              ! Exception handling flag.
                              ! By default, when error occur in
                              ! this procedure, the program aborts.
                              ! If this *err* argument is given,
                              ! .true. is substituted to *err* and
                              ! the program does not abort.
    type(GT_VARIABLE):: var, timevar
    character(STRING):: url, file, time_str
    real:: time_value(1:1)
    type(GT_HISTORY), pointer:: hst =>null()
    integer :: v_ord
    character(STRING):: avr_msg
                        real, target:: array_work(arraysize)
    real, pointer:: array_work2(:) =>null()
    integer:: arraysize_work2
    integer, allocatable:: start(:), count(:), stride(:)
    integer :: i, dims
    logical :: slice_err
    character(STRING):: time_name
    character(*), parameter:: bnds_suffix = '_bnds'
    type(GT_VARIABLE):: bndsvar
    integer:: bnds_ord, time_count, bnds_rank
    logical:: output_step
    real(DP):: timedw
!    type(DC_DIFFTIME):: difftimew
    real(DP):: avr_coef
    integer, allocatable:: array_overwrap(:)
    integer:: new_index
    integer:: numdims, dimord, dimsize, dimsize_max, allcount, ra
    character(STRING):: dimname
    integer:: st_mpi(MPI_STATUS_SIZE)
    real, allocatable:: array_mpi_tmp(:)
    real, allocatable:: array_mpi_all(:,:)
    integer:: stat
    integer:: err_mpi
    character(STRING):: cause_c
    interface timegoahead
      subroutine timegoahead( varname, var, head, history, err )
        use gtdata_types, only: gt_variable
        use gtool_history_types, only: gt_history
        character(len = *), intent(in):: varname
        type(GT_VARIABLE), intent(out):: var
        real, intent(in):: head
        type(GT_HISTORY), intent(inout), optional, target:: history
        logical, intent(out), optional:: err
      end subroutine timegoahead
    end interface
    character(*), parameter:: subname = "HistoryPutRealEx"
  continue
    call beginsub(subname, 'varname=%a range=%a', &
      & ca=stoa(varname, present_select('', '(no-range)', range)))
    stat = dc_noerr
    cause_c = ""
    if (present(history)) then
      hst => history
    else
      hst => default
    endif
    !-----------------------------------------------------------------
    !  初期設定のチェック
    !  Check initialization
    !-----------------------------------------------------------------
    if ( .not. hst % initialized ) then
      stat = dc_enotinit
      cause_c = 'GT_HISTORY'
      goto 999
    end if
    !-----------------------------------------------------------------
    !  time と range の同時使用の禁止
    !  Permit concurrent use of "time" and "range"
    !-----------------------------------------------------------------
    if ( ( present(time) .or. present(difftime) .or. present(timed) ) &
      &  .and. present_and_not_empty(range) ) then
      call messagenotify('W', subname, &
        & '(varname=%c) "range" and "time" or "timed" or "difftime" are not suppored at the same time', &
        & c1 = trim(varname) )
      stat = usr_errno
      cause_c = '"range" and "time" or "timed" or "difftime" are not suppored at the same time'
      goto 999
    end if
    !-----------------------------------------------------------------
    !  hst 内の varname 変数の変数番号を取得
    !  Get variable number of "varname" in "hst"
    !-----------------------------------------------------------------
    if ( .not. hst % mpi_gather ) then
      v_ord = lookup_variable_ord(hst, varname)
    else
      if ( hst % mpi_myrank == 0 ) then
        v_ord = lookup_variable_ord(hst, varname)
      end if
      call mpi_bcast( v_ord, 1, mpi_integer, 0, mpi_comm_world, err_mpi )
      call dbgmessage('v_ord=<%d> is shared on all nodes.', i = (/v_ord/) )
    end if
                        timedw = 0.0_dp
    !-----------------------------------------------------------------
    !  時間平均値のためのデータ格納
    !  Store data for time average value
    !-----------------------------------------------------------------
    if ( present(difftime) ) then
      timedw = evalbyunit( difftime, '', hst % unlimited_units_symbol )
    elseif ( present(timed) ) then
      timedw = timed
    elseif ( present(time) ) then
      timedw = time
    end if
    if ( v_ord > 0 ) then
      !
      ! var_avr_count == -1: 平均処理は行わない.
      ! var_avr_count >=  0: 平均処理を行う.
      !
      ! これらは HistoryAddVariable で指定される.
      !
      if ( hst % var_avr_count( v_ord ) > -1 ) then
        ! 時刻が指定されない場合には平均処理が不可能なため
        ! エラー発生. dc_error のエラーメッセージだけでは多少
        ! 不親切なので, エラー直前に下記の警告メッセージ表示.
        !
        if (       .not. present(time) &
          &  .and. .not. present(timed) &
          &  .and. .not. present(difftime) ) then
          call messagenotify('W', subname, &
            & '(varname=%c) arguments "time" or "timed" or "difftime" are needed ' // &
            & 'when "time_average=.true." is specified to "HistoryAddVariable"', &
            & c1 = trim(varname) )
          stat = dc_earglack
          cause_c = 'time'
          goto 999
        end if
        ! 与えられたデータのサイズと内部で積算しているデータのサイズが
        ! 一致しない場合にもエラーを発生.
        ! データサイズは HistoryPut -> HistoryPutEx の際に
        ! 全て 1 次元化しているため, 単純に配列サイズでのみ判定.
        ! dc_error のエラーメッセージだけでは多少
        ! 不親切なので, エラー直前に下記の警告メッセージ表示.
        !
        if ( arraysize /= hst % var_avr_data( v_ord ) % length ) then
          call messagenotify('W', subname, &
            & '(varname=%c) size of array should be (%d). size of array is (%d)', &
            & i = (/hst % var_avr_data( v_ord ) % length, arraysize/), &
            & c1 = trim(varname) )
          stat = gt_eargsizemismatch
          cause_c = 'array'
          goto 999
        end if
        ! この if 〜 end if では以下の動作を行う.
        !
        ! * 平均処理時の係数 (avr_coef) の算出
        ! * 係数を算出するための以下の値の設定
        !   * 基本時間間隔 (var_avr_baseint)
        !   * 前回出力の時刻 (var_avr_prevtime)
        ! * 初回出力の判定を行うラベル (var_avr_firstput) の設定
        !
        ! 1 度目に呼ばれた場合はとりあえず係数を 1.0 にするとともに,
        ! prevtime に現在時刻を保管
        !
        if ( hst % var_avr_firstput( v_ord ) ) then
          if ( hst % var_avr_count( v_ord ) == 0 ) then
            avr_coef = 1.0_dp
            hst % var_avr_prevtime( v_ord ) = timedw
          else
            hst % var_avr_baseint( v_ord ) = &
              & timedw - hst % var_avr_prevtime( v_ord )
            avr_coef = 1.0_dp
            hst % var_avr_prevtime( v_ord ) = timedw
            hst % var_avr_firstput( v_ord ) = .false.
          end if
        ! 2 度目以降に呼ばれた場合
        !
        else
          ! 前回出力を行った (var_avr_count == 0 に初期化された)
          ! 場合には baseint に前回時刻と今回時刻の差を設定.
          ! avr_coef には 1 を設定.
          ! 最後に prevtime に今回の時刻を保管.
          !
          if ( hst % var_avr_count( v_ord ) == 0 ) then
            hst % var_avr_baseint( v_ord ) = &
              & timedw - hst % var_avr_prevtime( v_ord )
            avr_coef = 1.0_dp
            hst % var_avr_prevtime( v_ord ) = timedw
          ! var_avr_count > 0 (平均処理されるデータが蓄積されている)
          ! 場合には avr_coef には前回時刻と今回時刻の差の,
          ! baseint からの比を設定する.
          ! 最後に prevtime に今回の時刻を保管.
          !
          else
            avr_coef = ( timedw - hst % var_avr_prevtime( v_ord ) ) &
              &          / hst % var_avr_baseint( v_ord )
            hst % var_avr_prevtime( v_ord ) = timedw
          end if
        end if
        ! 積算値 a_DataAvr に, 今回のデータに係数を掛けたもの
        ! を加算する.
        !
        hst % var_avr_data( v_ord ) % a_DataAvr = &
          & hst % var_avr_data( v_ord ) % a_DataAvr + array * avr_coef
        ! 積算カウント var_avr_count に +1 し,
        ! 係数の積算値 var_avr_coefsum に今回設定された
        ! 係数を加算する.
        !
        hst % var_avr_count( v_ord ) = &
          & hst % var_avr_count( v_ord ) + 1
        hst % var_avr_coefsum( v_ord ) = &
          & hst % var_avr_coefsum( v_ord ) + avr_coef
        ! time_bnds(2) に今回の時刻を設定する.
        ! (毎回上書きされる).
        !
        if ( present(difftime) ) then
          hst % time_bnds(2:2) = evalbyunit( difftime, '', hst % unlimited_units_symbol )
        elseif ( present (timed) ) then
          hst % time_bnds(2:2) = timed
        else
          hst % time_bnds(2:2) = time
        end if
      end if
    end if
    !-----------------------------------------------------------------
    !  初期時刻の設定
    !  Configure initial time
    !-----------------------------------------------------------------
    if ( .not. hst % origin_setting ) then
      if ( present(difftime) ) then
        hst % origin         = evalbyunit( difftime, '', hst % unlimited_units_symbol )
        hst % time_bnds      = evalbyunit( difftime, '', hst % unlimited_units_symbol )
        hst % origin_setting = .true.
      elseif ( present(timed) ) then
        hst % origin         = timed
        hst % time_bnds      = timed
        hst % origin_setting = .true.
      elseif ( present(time) ) then
        hst % origin         = time
        hst % time_bnds      = time
        hst % origin_setting = .true.
      end if
!!$      if ( present(difftime) ) then
!!$        hst % origin         = difftime
!!$        hst % time_bnds      = EvalByUnit( difftime, '', hst % unlimited_units_symbol )
!!$        hst % origin_setting = .true.
!!$      elseif ( present(timed) ) then
!!$        call DCDiffTimeCreate( hst % origin, &              ! (out)
!!$          & real(timed), '', hst % unlimited_units_symbol ) ! (in)
!!$        hst % time_bnds      = timed
!!$        hst % origin_setting = .true.
!!$      elseif ( present(time) ) then
!!$        call DCDiffTimeCreate( hst % origin, &       ! (out)
!!$          & time, '', hst % unlimited_units_symbol ) ! (in)
!!$        hst % time_bnds      = time
!!$        hst % origin_setting = .true.
!!$      end if
    end if
                        !-----------------------------------------------------------------
    !  時刻の自動チェック
    !  Check time automatically
    !-----------------------------------------------------------------
    output_step = .true.
    if ( present_and_false(time_average_store) ) then
      output_step = .true.
    elseif ( present_and_true(time_average_store) ) then
      output_step = .false.
    elseif ( present(difftime) .or. present(timed) .or. present(time) ) then
      output_step = .false.
      if ( abs( hst % interval ) < dp_eps ) then
        output_step = .true.
      else
        if ( abs( mod( timedw - hst % origin, hst % interval ) ) < dp_eps ) then
          output_step = .true.
        end if
      end if
    end if
    !-------------------------
    !  時間平均値出力のための情報処理
    !  Information processing for output time-averaged value
    if ( .not. output_step ) then
      goto 999
    else
      array_work = array
      avr_msg = ''
      if ( v_ord > 0 ) then
        if ( hst % var_avr_count( v_ord ) > -1 ) then
          if ( present_and_false(quiet) ) then
            avr_msg = '(time average of ' // trim( tochar(hst % var_avr_count( v_ord )) ) // ' step data)'
          end if
          !-------------------
          !  蓄えた値の時間平均化
          !  Average stored value in time direction
          ! a_DataAvr に蓄えられた値を係数の積算値で割って,
          ! これを出力値とする.
          !
                              array_work = real( &
            & ( hst % var_avr_data( v_ord ) % a_DataAvr ) / ( hst % var_avr_coefsum( v_ord ) ), &
            & kind = kind(array_work) )
          ! 積算値, 積算カウント, 係数の積算値をクリアする.
          !
          hst % var_avr_data( v_ord ) % a_DataAvr = 0.0
          hst % var_avr_count( v_ord ) = 0
          hst % var_avr_coefsum( v_ord ) = 0.0_dp
          hst % var_avr_firstput( v_ord ) = .false.
        end if
      end if
    end if
    if ( .not. hst % mpi_gather ) then
      array_work2 => array_work
      arraysize_work2 = arraysize
    else
      !-----------------------------------------------------------------
      !  MPI 使用時に, 座標軸のデータが与えられた場合には, そのデータを保管.
      !  If data of axis is given, the data is stored when MPI is used
      !-----------------------------------------------------------------
      numdims = size( hst % mpi_fileinfo % axes )
      if ( hst % mpi_myrank == 0 ) then
        dimord = 0
        do i = 1, numdims
          call historyaxisinquire( &
            & hst % mpi_fileinfo % axes(i), & ! (in)
            & name = dimname )                ! (out)
          if ( trim(varname) == trim(dimname) ) then
            dimord = i
            exit
          end if
        end do
        call mpi_bcast( dimord, 1, mpi_integer, 0, mpi_comm_world, err_mpi )
      else
        call mpi_bcast( dimord, 1, mpi_integer, 0, mpi_comm_world, err_mpi )
      end if
      if ( dimord > 0 ) then
        call historyaxisinquire( &
          & hst % mpi_fileinfo % axes(dimord), & ! (in)
          & size = dimsize_max )                 ! (out)
        dimsize = size( array )
        if ( dimsize > dimsize_max .and. hst % unlimited_index /= dimord ) then
          call messagenotify('W', subname, &
            & 'dim=<%c> data size (%d) exceeds size of the dim (%d) by HistoryCreate. ' //  &
            & 'the data will be trancated. ', &
            & i = (/ dimsize, dimsize_max /), c1 = trim(varname) )
          dimsize = dimsize_max
        end if
        if ( associated( hst % mpi_dimdata_each( dimord ) % a_Axis ) ) then
          deallocate( hst % mpi_dimdata_each( dimord ) % a_Axis )
        end if
        allocate( hst % mpi_dimdata_each( dimord ) % a_Axis(dimsize) )
        hst % mpi_dimdata_each( dimord ) % a_Axis = array(1:dimsize)
        hst % mpi_dimdata_each( dimord ) % length = dimsize
      end if
      !-----------------------------------------------------------------
      !  MPI 使用時に, 従属変数のデータが与えられた場合, データ集約の情報を整理.
      !  If data of dependent variables is given,
      !    information for integration is arranged when MPI is used
      !-----------------------------------------------------------------
      if ( v_ord > 0 ) then
        if ( .not. associated( hst % mpi_gthr_info ) ) then
          call gtmpi_axis_register( hst, err ) ! (inout)
        end if
        if ( present_and_true( err ) ) goto 999
        if ( .not. associated( hst % mpi_vars_index( v_ord ) % allcount ) ) then
          call gtmpi_vars_mkindex( hst, v_ord, err ) ! (inout)
        end if
        if ( present_and_true( err ) ) goto 999
      end if
      !-----------------------------------------------------------------
      !  MPI 使用時は, 各ノードのデータを rank == 0 へ集約する.
      !  Data on each node is integrated when MPI is used
      !-----------------------------------------------------------------
      if ( v_ord > 0 ) then
        arraysize_work2 = hst % mpi_vars_index(v_ord) % allcount_all
        if ( arraysize_work2 < 1 ) arraysize_work2 = 1
        if ( hst % mpi_myrank == 0 ) then
          do ra = 1, hst % mpi_nprocs - 1
            allcount = hst % mpi_vars_index(v_ord) % allcount(ra)
            call mpi_send( allcount, 1, mpi_integer, ra, 0, mpi_comm_world, err_mpi )
          end do
        else
          call mpi_recv( allcount, 1, mpi_integer, 0, 0, mpi_comm_world, st_mpi, err_mpi )
        end if
        if ( hst % mpi_myrank /= 0 ) then
          call mpi_send( array_work, allcount, &
            & mpi_real, 0, 0, mpi_comm_world, err_mpi )
        else
          allocate( array_mpi_all(0: hst % mpi_nprocs - 1, arraysize_work2 ) )
          allocate( array_mpi_tmp( arraysize_work2 ) )
          array_mpi_all(:,:) = 0.0
          array_mpi_tmp(:) = 0.0
          allcount = hst % mpi_vars_index(v_ord) % allcount(0)
          array_mpi_all(0,1:allcount) = array_work
          do ra = 1, hst % mpi_nprocs - 1
            allcount = hst % mpi_vars_index(v_ord) % allcount(ra)
            call mpi_recv( array_mpi_tmp(1:allcount), allcount, &
              & mpi_real, ra, 0, mpi_comm_world, st_mpi, err_mpi )
            array_mpi_all(ra,1:allcount) = array_mpi_tmp(1:allcount)
          end do
          allocate( array_work2( arraysize_work2 ) )
          allocate( array_overwrap( arraysize_work2 ) )
          array_work2 = 0.0
          array_overwrap(:) = 0
          do ra = 0, hst % mpi_nprocs - 1
            do i = 1, hst % mpi_vars_index(v_ord) % allcount(ra)
              new_index = hst % mpi_vars_index(v_ord) % each2all(ra, i)
              array_work2( new_index ) = &
                & array_work2( new_index ) + array_mpi_all( ra, i )
              array_overwrap( new_index ) = array_overwrap( new_index ) + 1
            end do
          end do
          where ( array_overwrap == 0 )
            array_overwrap = 1
          end where
          array_work2(:) = array_work2(:) / array_overwrap(:)
          deallocate( array_mpi_all, array_mpi_tmp, array_overwrap )
          ! array_work2 はデータ出力の後に割り付け解除される.
        end if
      else
        array_work2 => array_work
        arraysize_work2 = arraysize
      end if
    end if
    !-----------------------------------------------------------------
    !  時刻を1つ進めて, データ出力
    !  Progress one time, and output data
    !-----------------------------------------------------------------
    if ( .not. hst % mpi_gather &
      &  .or. ( hst % mpi_gather    .and. &
      &         hst % mpi_myrank == 0 .and. &
      &         hst % mpi_fileinfo % already_output) ) then
    call timegoahead( &
      & varname = varname, &     ! (in)
                          & head = real(array_work2(1)), & ! (in)
      & var = var, &             ! (out)
      & history = history, &     ! (inout)
      & err = err )              ! (out)
    call inquire( var, & ! (in)
      & alldims=dims )   ! (out)
    if (present_and_not_empty(range) .and. (dims < 1)) then
      call dbgmessage('varname=<%c> has no dimension. so range is ignoread.', &
      & c1=trim(varname))
    end if
    if (.not. (present_and_not_empty(range) .and. (dims > 0))) then
      ! range 無しの普通の出力の場合
      call put(var, array_work2, arraysize_work2)
    else
      ! range があり, 且つ varname がちゃんと次元を持っている場合
      !
      ! 元々の start, count, stride を保持. データを与えた後に復元する.
      allocate(start(dims), count(dims), stride(dims))
      do i = 1, dims
        call get_slice(var, i, start(i), count(i), stride(i))
      end do
      slice_err = .false. ! 不要だが Slice の引用仕様として必要なため
      call slice(var, range, slice_err)
      call put(var, array_work2, arraysize_work2)
      ! 復元
      do i = 1, dims
        call slice(var, i, start(i), count(i), stride(i))
      end do
      deallocate(start, count, stride)
    end if
    call gtvarsync(var)
    if ( hst % mpi_gather .and. v_ord > 0 ) then
      deallocate( array_work2 )
    end if
    end if
                        !-----------------------------------------------------------------
    !  "time_bnds" 変数への出力
    !  Output to "time_bnds" variable
    !-----------------------------------------------------------------
    if ( .not. hst % mpi_gather &
      &  .or. ( hst % mpi_gather    .and. &
      &         hst % mpi_myrank == 0 .and. &
      &         hst % mpi_fileinfo % already_output ) ) then
    if ( v_ord > 0 ) then
      if ( hst % var_avr_count( v_ord ) > -1 ) then
        !-------------------
        !  時間次元の名前とファイル名を取得
        !  Get name of time dimension, and filename
        timevar = hst % dimvars( hst % unlimited_index )
        call inquire( &
          & var = timevar, &   ! (in)
          & url = url, &       ! (out)
          & name = time_name ) ! (out)
        call urlsplit( fullname = url, &  ! (in)
          & file = file )                 ! (out)
        !-------------------
        !  "time_bnds" 変数の取得
        !  Get "time_bnds" variable
        call open( var = bndsvar, &
          & url = urlmerge(file=file, var=trim(time_name) // bnds_suffix) )
        bnds_ord = lookup_variable_ord( hst, trim(time_name) // bnds_suffix)
        !-------------------
        !  "time_bnds" 変数への出力
        !  Output to "time_bnds" variable
        call inquire( &
          & var = bndsvar, &                        ! (in)
          & rank = bnds_rank )                      ! (out)
        time_count = 1
        if ( bnds_rank > 1 ) then
          call inquire( &
            & var = bndsvar, &                             ! (in)
            & dimord = hst % growable_indices(bnds_ord), & ! (in)
            & allcount = time_count )                      ! (out)
        end if
        if  ( (hst % time_bnds_output_count < 1) &
          &  .or. (hst % time_bnds_output_count < time_count) ) then
          call slice(bndsvar, hst % growable_indices(bnds_ord), & ! (in)
            & start=hst % time_bnds_output_count+1, count=1)        ! (in)
          call put(bndsvar, hst % time_bnds, 2)
          hst % time_bnds_output_count = hst % time_bnds_output_count + 1
        end if
        call close( var = bndsvar ) ! (inout)
        if ( present(difftime) ) then
          hst % time_bnds(1:1) = &
            & evalbyunit( difftime, '', hst % unlimited_units_symbol )
        elseif ( present(timed) ) then
          hst % time_bnds(1:1) = timed
        else
          hst % time_bnds(1:1) = time
        end if
      end if
    end if
    end if
    !-----------------------------------------------------------------
    !  メッセージ出力
    !  Output messages
    !-----------------------------------------------------------------
    if ( .not. hst % mpi_gather &
      &  .or. ( hst % mpi_gather    .and. &
      &         hst % mpi_myrank == 0 .and. &
      &         hst % mpi_fileinfo % already_output ) ) then
    if ( present_and_false(quiet) ) then
      call inquire( hst % dimvars(1), & ! (in)
        & url = url )                   ! (out)
      call urlsplit( fullname = url, &  ! (in)
        & file = file )                 ! (out)
      if ( hst % unlimited_index < 1 ) then
        time_str = ''
      else
        timevar = hst % dimvars(hst % unlimited_index)
        call slice( timevar, &                     ! (in)
          & 1, start = hst % count(v_ord), count = 1 ) ! (in)
        call get( timevar, & ! (inout)
          & time_value, &    ! (out)
          & 1, &             ! (in)
          & err )            ! (out)
        time_str = '(time=' // trim( tochar( time_value(1) )) // ')'
      end if
      call messagenotify('M', 'HistoryPut', &
        & '"%a" => "%a" %a %a', &
        & ca = stoa( varname, file, time_str, avr_msg ) )
    end if
    end if
    !-----------------------------------------------------------------
    !  終了処理, 例外処理
    !  Termination and Exception handling
    !-----------------------------------------------------------------
999 continue
    call storeerror( stat, subname, err, cause_c )
    call endsub(subname)

References dc_trace::beginsub(), dc_trace::dbgmessage(), dc_error::dc_earglack, dc_error::dc_enotinit, dc_error::dc_noerr, gtool_history_internal::default, dc_types::dp, dc_types::dp_eps, dc_trace::endsub(), dc_error::gt_eargsizemismatch, dc_string::joinchar(), dc_present::present_and_false(), dc_present::present_and_not_empty(), dc_present::present_and_true(), dc_error::storeerror(), dc_types::string, timegoahead(), and dc_error::usr_errno.

Here is the call graph for this function:

timegoahead()

subroutine timegoahead	(	character(len = *), intent(in)	varname,
		type(gt_variable), intent(out)	var,
		real, intent(in)	head,
		type(gt_history), intent(inout), optional, target	history,
		logical, intent(out), optional	err
	)

Definition at line 4581 of file historyput.f90.

    !
    ! *history* 内の (省略された場合は gtool_history 内に内包
    ! される GT_HISTORY 変数) の変数名 *varname* の時間を1つ分
    ! 進め、その最新の時間断面で切り取った変数 ID を *var* に返します。
    !
    !--
    ! そのデフォルトでは変数ごとにカウンタを設置し、呼んだ数だけ
    ! 「時刻」方向を進め、時刻データを入力する。
    ! これに対し、HistorySetTime で時刻の変数に一度でもスカラ値を投入
    ! すると、明示的にそれを設定したときにだけ時刻が進むようになる。
    ! このルーチンでは後退はできない。
    !
    ! [詳細]
    ! 変数名 varname に対応する変数 ID var を探査し、その変数が
    ! 時間次元に依存する場合には hst % count の値を1つ増やす (時間を進める)。
    ! そして、hst % origin と hst % interval から時間次元データに値を与える。
    !
    ! なお、HistorySetTime で既に値が設定され、hst % count の値が
    ! 増やされる場合には、こちらでは hst % count の値を変更しない。
    ! データも入力しない。
    !++
    use gtool_history_types, only: gt_history
    use gtool_history_internal, only: default, lookup_variable, lookup_dimension
    use gtdata_generic, only: slice, get_slice, put, get, get_attr
    use gtdata_types, only: gt_variable
    use dc_types, only: string, dp
    use dc_error, only: storeerror, nf90_enotvar, dc_noerr
    use,non_intrinsic :: dc_date_generic, only: evalbyunit, operator(+), operator(*), &
      & dcdifftimecreate, min, max, evalsec, dcdifftimeputline
    use dc_date_types, only: dc_difftime
    use dc_trace, only: beginsub, endsub, dbgmessage
    implicit none
    character(len = *), intent(in)            :: varname
    type(GT_VARIABLE),  intent(out)           :: var
    real, intent(in):: head
    type(GT_HISTORY), intent(inout), optional, target:: history
    logical,            intent(out), optional :: err
    !
    type(GT_HISTORY), pointer:: hst =>null()
    type(GT_VARIABLE)        :: timevar
    real, pointer:: time(:) =>null()
    integer:: v_ord ! varname の history における次元添字番号
    integer:: d_ord
    integer:: timestart, rest
    integer:: stat
    logical:: get_err
    real(DP):: curtime
!    type(DC_DIFFTIME):: headdiff
    character(STRING):: cause_c, subname_r
    character(*), parameter:: subname = "TimeGoAhead"
  continue
    call beginsub(subname, 'varname=%c head=%r', &
      & c1=trim(varname), r=(/head/))
    stat = dc_noerr
    cause_c = ''
    subname_r = subname
    if (present(history)) then
      hst => history
    else
      hst => default
    endif
    ! hst 内での変数 varname の変数 ID を var に、
    ! hst における変数添字を v_ord に取得
    var = lookup_variable( hst, varname, & ! (in)
      &                    ord = v_ord )   ! (out)
    if (v_ord == 0) goto 1000
    ! 変数 v_ord に時間次元が無い場合は終了
    if (hst % growable_indices(v_ord) == 0) then
      goto 999
    endif
    if (hst % dim_value_written(hst % unlimited_index)) then
      !-----------------------
      ! HistorySetTime を利用する場合
      !
      ! 時間次元に既に値が書き込まれている場合は count を増やさない
      !
      call slice(var, hst % growable_indices(v_ord), & ! (in)
        & start=hst % count(1), count=1)               ! (in)
    else
      !-----------------------
      ! HistorySetTime を利用しない場合
      !
      ! 時間次元に値が書き込まれていない場合, count を増やす
      ! (history % interval を利用する)
      !
      hst % count(v_ord) = hst % count(v_ord) + 1
      call slice(var, hst % growable_indices(v_ord), & ! (in)
        & start=hst % count(v_ord), count=1)           ! (in)
      !-----------------------
      ! 時間次元変数へのデータ出力
      !
      ! 変数の count と時間次元変数の count を比較し,
      ! 変数の count が大きい場合, 時間次元変数の count も
      ! 同値になるようデータを出力する.
      !
      timevar = hst % dimvars(hst % unlimited_index)
      call get_slice(timevar, 1, start=timestart)
      call dbgmessage('map(timevar)start is <%d>. map(%c)start is <%d>', &
        &       i=(/timestart, hst % count(v_ord)/), &
        &       c1=trim(varname) )
      call get(timevar, time, get_err)
      call dbgmessage('time(%d)=<%*r>, err=<%b>',      &
        &       i=(/size(time)/), r=(/time(:)/), &
        &       l=(/get_err/), n=(/size(time)/)         )
      if (get_err .or. hst % count(v_ord) == 1 .and. timestart == 1) then
        !---------------------
        ! 時間次元のデータの初期値作成
        !
        ! 時間次元のデータがまだ作成されていない場合、
        ! 初期値となるデータを作成
        call slice(timevar, 1, start=1, count=1)
        curtime = hst % origin
!        curtime = EvalByUnit( hst % origin, '', hst % unlimited_units_symbol )
        call put(timevar, (/curtime/), 1) ! (in)
      elseif (hst % count(v_ord) > timestart) then
        !---------------------
        ! 時間次元のデータの初期値以外を作成
        !
        ! 変数の count が時間次元の start より大きい場合、
        ! hst % interval でその間を埋める。
        rest = timestart + 1
        do
          call slice(timevar, 1, start=rest, count=1)
          curtime = hst % origin + hst % interval * (rest - 1)
!!$          curtime = EvalByUnit( &
!!$            & hst % origin + hst % interval * (rest - 1), &
!!$            & '', hst % unlimited_units_symbol )
          call put(timevar, (/curtime/), 1 ) ! (in)
          rest = rest + 1
          if ( rest > hst % count(v_ord) ) exit
        enddo
      endif
      deallocate(time)
    endif
    goto 999
1000 continue
    !-----------------------------------------------------------------
    !  hst 内に次元以外の変数 ID が見つからない場合
    !-----------------------------------------------------------------
    !
    ! 次元 ID を探査
    var = lookup_dimension(hst, varname, ord=d_ord)
    !-------------------------
    !  次元も含めた変数の中に varname が無い場合は stat に
    !  NF90_ENOTVAR (Variable not Found) を返す.
    !  (上のサブルーチンが停止させることを想定)
    if (d_ord == 0) then
      subname_r = 'HistoryPut'
      stat = nf90_enotvar
      cause_c = 'varname="' // trim(varname) // '" is not found'
      goto 999
    endif
    hst % dim_value_written(d_ord) = .true.
    if (d_ord /= hst % unlimited_index) then
      goto 999
    endif
    !-------------------------
    ! ややトリッキーだが、count の2番目以降の要素にも時刻を入れて
    ! おくことで、HistorySetTime による巻き戻し後にも値を保持する。
    hst % count(:) = maxval(hst % count(:)) + 1
!!$    call DCDiffTimeCreate( headdiff, &           ! (out)
!!$      & head, '', hst % unlimited_units_symbol ) ! (in)
    ! hst % newest = max(hst % newest, head)
    ! hst % oldest = min(hst % oldest, head)
    call slice(var, 1, start=hst % count(1), count=1)
999 continue
    call storeerror(stat, trim(subname_r), err, cause_c)
    call endsub(subname)

References dc_trace::beginsub(), dc_trace::dbgmessage(), dc_error::dc_noerr, dcdifftimeputline(), gtool_history_internal::default, dc_types::dp, dc_trace::endsub(), dc_error::storeerror(), and dc_types::string.

Here is the call graph for this function: