time_manager.f90

CCSM Research Tools: Community Atmosphere Model (CAM)

   implicit none
   
! Return value
   integer :: get_step_size

! Local variables
   character(len=*), parameter :: sub = 'get_step_size'
   integer :: days, seconds
   integer :: rc
!-----------------------------------------------------------------------------------------

   call esmf_timemgrgetstepsize(tm_id, days, seconds, rc)
   call chkrc(rc, sub//': error return from esmf_timemgrgetstepsize')
   get_step_size = 86400*days + seconds

end function get_step_size
!=========================================================================================

function get_nstep()

! Return the timestep number.

   implicit none
   
! Return value
   integer :: get_nstep

! Local variables
   character(len=*), parameter :: sub = 'get_nstep'
   integer :: rc
!-----------------------------------------------------------------------------------------

   get_nstep = esmf_timemgrgetnstep(tm_id, rc)
   call chkrc(rc, sub//': error return from esmf_timemgrgetnstep')

end function get_nstep
!=========================================================================================

subroutine get_curr_date(yr, mon, day, tod, offset)

! Return date components valid at end of current timestep with an optional
! offset (positive or negative) in seconds.

   implicit none
   
! Arguments
   integer, intent(out) ::&
      yr,    &! year
      mon,   &! month
      day,   &! day of month
      tod     ! time of day (seconds past 0Z)

   integer, optional, intent(in) :: offset  ! Offset from current time in seconds.
                                            ! Positive for future times, negative 
                                            ! for previous times.

! Local variables
   character(len=*), parameter :: sub = 'get_curr_date'
   integer :: rc
   type(esmf_date) :: date
   type(esmf_time) :: off
   integer :: ymd
!-----------------------------------------------------------------------------------------

   date = esmf_timemgrgetcurrdate(tm_id, rc)
   call chkrc(rc, sub//': error return from esmf_timemgrgetcurrdate')

   if (present(offset)) then
      if (offset > 0) then
         date = esmf_dateincrementsec(date, offset, rc)
         call chkrc(rc, sub//': error incrementing current date')
      else if (offset < 0) then
         off = esmf_timeinit(0, -offset, rc)
         call chkrc(rc, sub//': error setting offset time type')
         date = esmf_datedecrement(date, off, rc)
         call chkrc(rc, sub//': error decrementing current date')
      end if
   end if

   call esmf_dateget(date, ymd, tod, rc)
   call chkrc(rc, sub//': error return from esmf_dateget')
   yr = ymd/10000
   mon = mod(ymd, 10000) / 100
   day = mod(ymd, 100)

end subroutine get_curr_date
!=========================================================================================

subroutine get_prev_date(yr, mon, day, tod)

! Return date components valid at beginning of current timestep.

   implicit none
   
! Arguments
   integer, intent(out) ::&
      yr,    &! year
      mon,   &! month
      day,   &! day of month
      tod     ! time of day (seconds past 0Z)

! Local variables
   character(len=*), parameter :: sub = 'get_prev_date'
   integer :: rc
   type(esmf_date) :: date
   integer :: ymd
!-----------------------------------------------------------------------------------------

   date = esmf_timemgrgetprevdate(tm_id, rc)
   call chkrc(rc, sub//': error return from esmf_timemgrgetprevdate')

   call esmf_dateget(date, ymd, tod, rc)
   call chkrc(rc, sub//': error return from esmf_dateget')
   yr = ymd/10000
   mon = mod(ymd, 10000) / 100
   day = mod(ymd, 100)

end subroutine get_prev_date
!=========================================================================================

subroutine get_start_date(yr, mon, day, tod)

! Return date components valid at beginning of initial run.

   implicit none
   
! Arguments
   integer, intent(out) ::&
      yr,    &! year
      mon,   &! month
      day,   &! day of month
      tod     ! time of day (seconds past 0Z)

! Local variables
   character(len=*), parameter :: sub = 'get_start_date'
   integer :: rc
   type(esmf_date) :: date
   integer :: ymd
!-----------------------------------------------------------------------------------------

   date = esmf_timemgrgetstartdate(tm_id, rc)
   call chkrc(rc, sub//': error return from esmf_timemgrgetstartdate')

   call esmf_dateget(date, ymd, tod, rc)
   call chkrc(rc, sub//': error return from esmf_dateget')
   yr = ymd/10000
   mon = mod(ymd, 10000) / 100
   day = mod(ymd, 100)

end subroutine get_start_date
!=========================================================================================

subroutine get_ref_date(yr, mon, day, tod)

! Return date components of the reference date.

   implicit none
   
! Arguments
   integer, intent(out) ::&
      yr,    &! year
      mon,   &! month
      day,   &! day of month
      tod     ! time of day (seconds past 0Z)

! Local variables
   character(len=*), parameter :: sub = 'get_ref_date'
   integer :: rc
   type(esmf_date) :: date
   integer :: ymd
!-----------------------------------------------------------------------------------------

   date = esmf_timemgrgetbasedate(tm_id, rc)
   call chkrc(rc, sub//': error return from esmf_timemgrgetbasedate')

   call esmf_dateget(date, ymd, tod, rc)
   call chkrc(rc, sub//': error return from esmf_dateget')
   yr = ymd/10000
   mon = mod(ymd, 10000) / 100
   day = mod(ymd, 100)

end subroutine get_ref_date
!=========================================================================================

subroutine get_curr_time(days, seconds)

! Return time components valid at end of current timestep.
! Current time is the time interval between the current date and the reference date.

   implicit none
   
! Arguments
   integer, intent(out) ::&
      days,   &! number of whole days in time interval
      seconds  ! remaining seconds in time interval

! Local variables
   character(len=*), parameter :: sub = 'get_curr_time'
   integer :: rc
   type(esmf_date) :: cdate, rdate
   type(esmf_time) :: diff
   logical :: islater
!-----------------------------------------------------------------------------------------

   cdate = esmf_timemgrgetcurrdate(tm_id, rc)
   call chkrc(rc, sub//': error return from esmf_timemgrgetcurrdate')

   rdate = esmf_timemgrgetbasedate(tm_id, rc)
   call chkrc(rc, sub//': error return from esmf_timemgrgetbasedate')

   call esmf_datediff(rdate, cdate, diff, islater, rc)
   call chkrc(rc, sub//': error return from esmf_datediff')

   call esmf_timeget(diff, days, seconds, rc)
   call chkrc(rc, sub//': error return from esmf_timeget')

end subroutine get_curr_time
!=========================================================================================

function get_curr_calday(offset)

! Return calendar day at end of current timestep with optional offset.
! Calendar day 1.0 = 0Z on Jan 1.

   implicit none
   
! Arguments
   integer, optional, intent(in) :: offset  ! Offset from current time in seconds.
                                            ! Positive for future times, negative 
                                            ! for previous times.
! Return value
   real(r8) :: get_curr_calday

! Local variables
   character(len=*), parameter :: sub = 'get_curr_calday'
   integer :: rc
   type(esmf_date) :: date
   type(esmf_time) :: off
   integer :: ymd, tod
!-----------------------------------------------------------------------------------------

   date = esmf_timemgrgetcurrdate(tm_id, rc)
   call chkrc(rc, sub//': error return from esmf_timemgrgetcurrdate')

   if (present(offset)) then
      if (offset > 0) then
         date = esmf_dateincrementsec(date, offset, rc)
         call chkrc(rc, sub//': error incrementing current date')
      else if (offset < 0) then
         off = esmf_timeinit(0, -offset, rc)
         call chkrc(rc, sub//': error setting offset time type')
         date = esmf_datedecrement(date, off, rc)
         call chkrc(rc, sub//': error decrementing current date')
      end if
   end if

   get_curr_calday = esmf_dategetfltdayofyear(date, rc)
   call chkrc(rc, sub//': error return from esmf_dategetfltdayofyear')

end function get_curr_calday
!=========================================================================================

function is_end_curr_day()

! Return true if current timestep is last timestep in current day.

   implicit none
   
! Return value
   logical :: is_end_curr_day

! Local variables
   integer ::&
      yr,    &! year
      mon,   &! month
      day,   &! day of month
      tod     ! time of day (seconds past 0Z)
!-----------------------------------------------------------------------------------------

   call get_curr_date(yr, mon, day, tod)
   is_end_curr_day = (tod == 0)

end function is_end_curr_day
!=========================================================================================

function is_end_curr_month()

! Return true if current timestep is last timestep in current month.

   implicit none
   
! Return value
   logical :: is_end_curr_month

! Local variables
   integer ::&
      yr,    &! year
      mon,   &! month
      day,   &! day of month
      tod     ! time of day (seconds past 0Z)
!-----------------------------------------------------------------------------------------

   call get_curr_date(yr, mon, day, tod)
   is_end_curr_month = (day == 1  .and.  tod == 0)

end function is_end_curr_month
!=========================================================================================

function is_first_step()

! Return true on first step of initial run only.

   implicit none
   
! Return value
   logical :: is_first_step

! Local variables
   character(len=*), parameter :: sub = 'is_first_step'
   integer :: rc
   integer :: nstep
!-----------------------------------------------------------------------------------------

   nstep = esmf_timemgrgetnstep(tm_id, rc)
   call chkrc(rc, sub//': error return from esmf_timemgrgetnstep')
   is_first_step = (nstep == 0)

end function is_first_step
!=========================================================================================

function is_first_restart_step()

! Return true on first step of restart run only.

   implicit none
   
! Return value
   logical :: is_first_restart_step
!-----------------------------------------------------------------------------------------

   is_first_restart_step = first_restart_step

end function is_first_restart_step

!=========================================================================================

function is_last_step()

! Return true on last timestep.

   implicit none
   
! Return value
   logical :: is_last_step

! Local variables
   character(len=*), parameter :: sub = 'is_last_step'
   integer :: rc
!-----------------------------------------------------------------------------------------

   is_last_step = esmf_timemgrlaststep(tm_id, rc)
   call chkrc(rc, sub//': error return from esmf_timemgrlaststep')

end function is_last_step
!=========================================================================================

subroutine timemgr_write_restart(ftn_unit)

! Write information needed on restart to a binary Fortran file.
! It is assumed that this routine is called only from the master proc if in SPMD mode.

   implicit none

! Arguments
   integer, intent(in) :: ftn_unit  ! Fortran unit number

! Local variables
   character(len=*), parameter :: sub = 'timemgr_write_restart'
   integer :: rc   ! return code
!-----------------------------------------------------------------------------------------

   call esmf_timemgrrestartwrite(tm_id, rst_type, rst_nstep, rst_step_days, rst_step_sec, &
                                rst_start_ymd, rst_start_tod, rst_stop_ymd, rst_stop_tod, rst_ref_ymd, &
                                rst_ref_tod, rst_curr_ymd, rst_curr_tod, rc)
   call chkrc(rc, sub//': error return from esmf_timemgrrestartwrite')

   write(ftn_unit, iostat=rc) rst_type, rst_nstep, rst_step_days, rst_step_sec, &
                              rst_start_ymd, rst_start_tod, rst_stop_ymd, rst_stop_tod, rst_ref_ymd, &
                              rst_ref_tod, rst_curr_ymd, rst_curr_tod

   if (rc /= 0 ) then
      write (6,*) 'WRITE iostat= ',rc,' on i/o unit = ',ftn_unit
      call endrun
   end if

end subroutine timemgr_write_restart
!=========================================================================================

subroutine timemgr_read_restart(ftn_unit)

! Read information needed on restart from a binary Fortran file.
! It is assumed that this routine is called only from the master proc if in SPMD mode.

   implicit none

! Arguments
   integer, intent(in) :: ftn_unit  ! Fortran unit number

! Local variables
   character(len=*), parameter :: sub = 'timemgr_read_restart'
   integer :: rc   ! return code
!-----------------------------------------------------------------------------------------

   read(ftn_unit, iostat=rc) rst_type, rst_nstep, rst_step_days, rst_step_sec, &
                             rst_start_ymd, rst_start_tod, rst_stop_ymd, rst_stop_tod, rst_ref_ymd, &
                             rst_ref_tod, rst_curr_ymd, rst_curr_tod

   if (rc /= 0 ) then
      write (6,*) 'READ iostat= ',rc,' on i/o unit = ',ftn_unit
      call endrun
   end if

end subroutine timemgr_read_restart
!=========================================================================================

subroutine chkrc(rc, mes)
   implicit none
   integer, intent(in)          :: rc   ! return code from time management library
   character(len=*), intent(in) :: mes  ! error message
   if ( rc == esmf_success ) return
   write(6,*) mes
   call esmf_errprint(rc)
   call endrun
end subroutine chkrc

!=========================================================================================

#endif

end module time_manager