historysettime.f90

Go to the documentation of this file.

 
  subroutine historysettime(time, history, difftime, timed)
    !
    use gtool_history_types, only: gt_history, gt_history_axis, gt_history_varinfo, gt_history_attr
    use gtool_history_internal, only: default
    use gtdata_generic, only: slice, put, get
    use gtdata_types, only: gt_variable
    use dc_date_generic, only: dcdifftimecreate, operator(<), operator(>), &
      & evalbyunit, min, max, dcdifftimeputline
    use dc_date_types, only: dc_difftime
    use dc_trace, only: beginsub, endsub, dbgmessage, debug
    use dc_types, only: dp
    use mpi
    implicit none
    real, intent(in), optional:: time
                              ! 時刻
                              ! 
                              ! ここで言う "時刻" とは、
                              ! HistoryCreate の *dims* で "0"
                              ! と指定されたものです。
                              ! もしも時刻が定義されていな
                              ! い場合は、 このサブルーチン
                              ! は何の効果も及ぼしません。
                              ! 
    type(gt_history), intent(inout), optional, target:: history
                              ! 出力ファイルの設定に関する情報を
                              ! 格納した構造体
                              ! 
                              ! ここに指定するものは、
                              ! HistoryCreate によって初期設定
                              ! されていなければなりません。
                              ! 
    type(dc_difftime), intent(in), optional:: difftime
                              ! 時刻 (dc_date_types::DC_DIFFTIME 型)
                              ! 
                              ! ここで言う "時刻" とは、
                              ! HistoryCreate の *dims* で "0"
                              ! と指定されたものです。
                              ! もしも時刻が定義されていな
                              ! い場合は、 このサブルーチン
                              ! は何の効果も及ぼしません。
                              ! 
    real(DP), intent(in), optional:: timed
                              ! 時刻 (倍精度実数型)
                              ! 
                              ! ここで言う "時刻" とは、
                              ! HistoryCreate の *dims* で "0"
                              ! と指定されたものです。
                              ! もしも時刻が定義されていな
                              ! い場合は、 このサブルーチン
                              ! は何の効果も及ぼしません。
                              ! 
    type(gt_history), pointer:: hst =>null()
    type(gt_variable):: var
    real, pointer:: buffer(:) =>null()
    real(DP):: dt
!    type(DC_DIFFTIME):: dt
    real(DP):: timew
    logical:: err, dbg_mode
    integer:: err_mpi
    character(*), parameter:: subname = "HistorySetTime"
  continue
    dt = 0.0_dp
    timew = 0.0_dp
    call beginsub(subname)
    if (present(history)) then
      hst => history
    else
      hst => default
    endif
    call debug( dbg_mode ) 
    if ( dbg_mode ) then
      if ( present(difftime) ) then
        timew = evalbyunit( difftime, '', hst % unlimited_units_symbol )
        call dbgmessage('time=%f', d = (/timew/) )
      elseif ( present(timed) ) then
        call dbgmessage('time=%f', d = (/timed/) )
      elseif ( present(time) ) then
        call dbgmessage('time=%r', r = (/time/) )
      end if
    end if
    if (hst % unlimited_index == 0) then
      goto 999
    endif
    var = hst % dimvars(hst % unlimited_index)
    hst % dim_value_written(hst % unlimited_index) = .true.
    if ( present(difftime) ) then
      dt = evalbyunit( difftime, '', hst % unlimited_units_symbol )
      timew = dt 
    elseif ( present(timed) ) then
      dt = timed
!!$      call DCDiffTimeCreate( dt, &                          ! (out)
!!$        & real( timed ), '', hst % unlimited_units_symbol ) ! (in)
      timew = timed
    elseif ( present(time) ) then
      dt = time
!!$      call DCDiffTimeCreate( dt, &                 ! (out)
!!$        & time, '', hst % unlimited_units_symbol ) ! (in)
      timew = time
    end if
    if (      dt < hst % oldest &
      &  .or. dt > hst % newest &
      &  .or. hst % count(2) == 0 ) then
      hst % count(:) = maxval(hst % count(:)) + 1
      hst % newest = max(hst % newest, dt)
      hst % oldest = min(hst % oldest, dt)
      if ( .not. hst % mpi_gather &
        &  .or. ( hst % mpi_gather .and. hst % mpi_myrank == 0 ) ) then
      call slice(var, 1, start=hst % count(1), count=1)
      timew = dt
!      timew = EvalByUnit( dt, '', hst % unlimited_units_symbol )
      call put(var, (/timew/), 1, err)
      if (err) call dumperror()
      end if
      goto 999
    endif
    if ( .not. hst % mpi_gather &
      &  .or. ( hst % mpi_gather .and. hst % mpi_myrank == 0 ) ) then
    call slice(var, 1, start=1, count=hst % count(2))
    call get(var, buffer, err)
    hst % count(1:1) = minloc(abs(buffer - timew))
    deallocate(buffer)
      if ( hst % mpi_gather .and. hst % mpi_myrank == 0 ) then
        call mpi_bcast( hst % count(1:1), 1, mpi_integer, 0, mpi_comm_world, err_mpi )
      end if
    elseif ( hst % mpi_gather .and. hst % mpi_myrank /= 0 ) then
      call mpi_bcast( hst % count(1:1), 1, mpi_integer, 0, mpi_comm_world, err_mpi )
    end if
999 continue
    call endsub(subname)
  end subroutine historysettime