!===============================================================================
! SVN $Id: shr_date_mod.F90 11998 2008-09-30 05:47:54Z erik $
! SVN $URL: https://svn-ccsm-models.cgd.ucar.edu/csm_share/branch_tags/cesm1_0_rel_tags/cesm1_0_rel01_share3_100616/shr/shr_date_mod.F90 $
!===============================================================================
!BOP ===========================================================================
!
! !MODULE: shr_date_mod -- date/time module, built upon a calendar module
!
! !DESCRIPTION:
! Keeps track of model date, including elapsed seconds in current date.
!
! !REVISION HISTORY:
! 2001-Sep-13 - B. Kauffman - created initial version
!
! !REMARKS:
! This module is independant of a particular calendar, e.g. is ignorant of
! whether the underlying calendar does or doesn't implement leap years.
!
! !INTERFACE: ------------------------------------------------------------------
module shr_date_mod 2,9
! !USES:
use shr_cal_mod
! underlying calendar
use shr_sys_mod
! system call wrappers
use shr_kind_mod
! kinds
use shr_log_mod
, only: s_loglev => shr_log_Level
use shr_log_mod
, only: s_logunit => shr_log_Unit
implicit none
private ! except
! !PUBLIC TYPES:
public :: shr_date
type shr_date
sequence ! place in contiguous memory
private ! no public access to internal components
integer(SHR_KIND_IN) :: y ! calendar year
integer(SHR_KIND_IN) :: m ! calendar month
integer(SHR_KIND_IN) :: d ! calendar day
integer(SHR_KIND_IN) :: s ! elapsed seconds in current day
integer(SHR_KIND_IN) :: cDate ! coded calendar date (yymmdd)
integer(SHR_KIND_IN) :: eDay ! elsapsed days relative to calendar's reference date
integer(SHR_KIND_IN) :: stepInDay ! current time-step in current day
integer(SHR_KIND_IN) :: stepsPerDay ! number of time-steps per day
end type shr_date
! !PUBLIC MEMBER FUNCTIONS:
public :: shr_date_adv1step ! advance the date one time step
public :: shr_date_advNextDay ! advance date to next day, 0 seconds
public :: shr_date_initYMD ! init date given YMD
public :: shr_date_initEDay ! init date given elapsed days
public :: shr_date_initCDate ! init date given coded date (yymmdd)
public :: shr_date_getYMD ! returns integers yy,mm,dd,sssss
public :: shr_date_getEDay ! returns elased day, sssss
public :: shr_date_getCDate ! returns coded date, ssssS
public :: shr_date_getStepsPerDay ! returns steps per day
public :: shr_date_getStepInDay ! returns step in the day
public :: shr_date_getJulian ! returns julian day number
public :: assignment(=) ! sets (date a) equal to (date b)
public :: operator(==) ! true iff (date a) == (date b)
public :: operator(<) ! true iff (date a) < (date b)
public :: operator(>) ! true iff (date a) > (date b)
! !PUBLIC DATA MEMBERS:
real(SHR_KIND_R8), parameter,public :: shr_date_secsPerDay = 86400.0_SHR_KIND_R8 ! seconds per day
integer(SHR_KIND_IN), parameter :: shr_date_nsecsPerDay = shr_date_secsPerDay
!EOP
interface assignment(=)
module procedure shr_date_assign
end interface
interface operator(==)
module procedure shr_date_equals
end interface
interface operator(>)
module procedure shr_date_greater
end interface
interface operator(<)
module procedure shr_date_less
end interface
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
contains
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!===============================================================================
!===============================================================================
subroutine shr_date_assign(a,b) 1
type(shr_date),intent(out) :: a
type(shr_date),intent(in ) :: b
!-------------------------------------------------------------------------------
! Make date a equal to date b
!-------------------------------------------------------------------------------
a%y = b%y
a%m = b%m
a%d = b%d
a%s = b%s
a%eday = b%eday
a%cDate = b%cDate
a%stepInDay = b%stepInDay
a%stepsPerDay = b%stepsPerDay
end subroutine shr_date_assign
!===============================================================================
!===============================================================================
function shr_date_equals(a,b) 1
type(shr_date),intent(in) :: a,b
logical :: shr_date_equals
!-------------------------------------------------------------------------------
! Is date a equal to date b ??
!-------------------------------------------------------------------------------
if (a%eday == b%eday .and. a%s == b%s) then
shr_date_equals=.true.
else
shr_date_equals =.false.
end if
end function shr_date_equals
!===============================================================================
!===============================================================================
function shr_date_greater(a,b) 1
type(shr_date),intent(in) :: a,b
logical :: shr_date_greater
!-------------------------------------------------------------------------------
! Is date a greater than date b ??
!-------------------------------------------------------------------------------
if (a%eday < b%eday) then
shr_date_greater = .false.
else if (a%eday > b%eday) then
shr_date_greater = .true.
else if (a%s > b%s ) then
shr_date_greater = .true.
else
shr_date_greater = .false.
end if
end function shr_date_greater
!===============================================================================
!===============================================================================
function shr_date_less(a,b) 1
type(shr_date),intent(in) :: a,b
logical :: shr_date_less
!-------------------------------------------------------------------------------
! Is date a less than date b ??
!-------------------------------------------------------------------------------
if (a%eday < b%eday) then
shr_date_less = .true.
else if (a%eday > b%eday) then
shr_date_less = .false.
else if (a%s < b%s ) then
shr_date_less = .true.
else
shr_date_less = .false.
end if
end function shr_date_less
!===============================================================================
!BOP ===========================================================================
!
! !IROUTINE: shr_date_initYMD - Initialize date given y,m,d, steps per day.
!
! !DESCRIPTION:
! Initialize date given y,m,d, and steps per day.
!
! !REVISION HISTORY:
! 2001-Sep-13 - B. Kauffman - initial version.
!
! !INTERFACE: -----------------------------------------------------------------
type(shr_date) function shr_date_initYMD(y,m,d,ns,sec) 12,4
implicit none
! !INPUT/OUTPUT PARAMETERS:
integer(SHR_KIND_IN),intent(in) :: y ! year
integer(SHR_KIND_IN),intent(in) :: m ! month
integer(SHR_KIND_IN),intent(in) :: d ! day
integer(SHR_KIND_IN),intent(in) :: ns ! number of steps per day.
integer(SHR_KIND_IN),intent(in), optional :: sec ! seconds into day
!EOP
!----- local -----
type(shr_date) :: date
!-------------------------------------------------------------------------------
!
!-------------------------------------------------------------------------------
if (shr_cal_validYMD
(y,m,d) ) then
date%y = y
date%m = m
date%d = d
date%s = 0
date%stepInDay = 0
date%stepsPerDay = ns
if (present(sec)) then
date%s = sec
date%stepInDay = nint(date%s*ns/shr_date_secsPerDay)
end if
call shr_cal_ymd2date
(y,m,d,date%cDate)
call shr_cal_ymd2eDay
(y,m,d,date%eDay )
else
write(s_logunit,*) 'ERROR: invalid y,m,d = ', y,m,d
call shr_sys_abort
('(shr_date_initYMD) invalid date')
end if
shr_date_initYMD = date
end function shr_date_initYMD
!===============================================================================
!BOP ===========================================================================
!
! !IROUTINE: shr_date_initEDay - Initialize date given an elapsed day
!
! !DESCRIPTION:
! Initialize date given elapsed days and the number of steps per day.
!
! !REVISION HISTORY:
! 2003-May-27 - B. Kauffman - initial version.
!
! !INTERFACE: -----------------------------------------------------------------
type(shr_date) function shr_date_initEDay(eDay,ns),4
implicit none
! !INPUT/OUTPUT PARAMETERS:
integer(SHR_KIND_IN),intent(in) :: eDay ! elpased days
integer(SHR_KIND_IN),intent(in) :: ns ! number of steps per day.
!EOP
!----- local -----
type(shr_date) :: date ! date to return
integer(SHR_KIND_IN) :: y,m,d ! year, month, day
!-------------------------------------------------------------------------------
!
!-------------------------------------------------------------------------------
call shr_cal_eDay2ymd
(eDay,y,m,d) ! convert eDay to y,m,d
if ( shr_cal_validYMD
(y,m,d) ) then
date = shr_date_initYMD
(y,m,d,ns)
else
write(s_logunit,*) 'ERROR: invalid eDay = ', eDay
write(s_logunit,*) 'ERROR: invalid y,m,d = ', y,m,d
call shr_sys_abort
('(shr_date_initEDay) invalid eDay')
end if
shr_date_initEDay = date
end function shr_date_initEDay
!===============================================================================
!BOP ===========================================================================
!
! !IROUTINE: shr_date_initCDate - Initialize date given coded date (yymmdd).
!
! !DESCRIPTION:
! Initialize date given coded date (yymmdd) and the number of steps per day.
!
! !REVISION HISTORY:
! 2001-Sep-13 - B. Kauffman - initial version.
!
! !INTERFACE: -----------------------------------------------------------------
type(shr_date) function shr_date_initCDate(cDate,ns,sec),5
implicit none
! !INPUT/OUTPUT PARAMETERS:
integer(SHR_KIND_IN),intent(in) :: cDate ! coded date (yymmdd)
integer(SHR_KIND_IN),intent(in) :: ns ! number of steps per day.
integer(SHR_KIND_IN),intent(in), optional :: sec ! seconds into day
!EOP
!----- local -----
type(shr_date) :: date ! date to return
integer(SHR_KIND_IN) :: y,m,d ! year, month, day
!-------------------------------------------------------------------------------
!
!-------------------------------------------------------------------------------
if (shr_cal_validDate
(cDate) ) then
call shr_cal_date2ymd
(cDate,y,m,d)
date = shr_date_initYMD
(y,m,d,ns)
if (present(sec)) then
date = shr_date_initYMD
(y,m,d,ns,sec)
end if
else
write(s_logunit,*) 'ERROR: invalid cDate = ', cDate
call shr_sys_abort
('(shr_date_initCDate) invalid date')
end if
shr_date_initCDate = date
end function shr_date_initCDate
!===============================================================================
!BOP ===========================================================================
!
! !IROUTINE: shr_date_adv1step - advance the date by one time step
!
! !DESCRIPTION:
! Advance the date by one time step.
!
! !REVISION HISTORY:
! 2001-Sep-13 - B. Kauffman - initial version.
!
! !INTERFACE: -----------------------------------------------------------------
subroutine shr_date_adv1step(date) 1,1
implicit none
! !INPUT/OUTPUT PARAMETERS:
type(shr_date),intent(inout) :: date ! number of elapsed days
!EOP
!-------------------------------------------------------------------------------
!
!-------------------------------------------------------------------------------
date%stepInDay = date%stepInDay + 1
if (date%stepInDay < date%stepsPerDay) then
date%s = nint((shr_date_secsPerDay*date%stepInDay)/date%stepsPerDay)
else
call shr_date_advNextDay
(date)
end if
end subroutine shr_date_adv1step
!===============================================================================
!BOP ===========================================================================
!
! !IROUTINE: shr_date_rev1step - reverse the date by one time step
!
! !DESCRIPTION:
! Reverse the date by one time step.
!
! !REVISION HISTORY:
! 2008-Jul-01 - E. Kluzek - initial version.
!
! !INTERFACE: -----------------------------------------------------------------
subroutine shr_date_rev1step(date) 1,1
implicit none
! !INPUT/OUTPUT PARAMETERS:
type(shr_date),intent(inout) :: date ! number of elapsed days
!EOP
!-------------------------------------------------------------------------------
!
!-------------------------------------------------------------------------------
date%stepInDay = date%stepInDay - 1
if (date%stepInDay >= 0) then
date%s = nint((shr_date_secsPerDay*date%stepInDay)/date%stepsPerDay)
else
call shr_date_revPrevDay
(date)
date%stepInDay = date%stepsPerDay - 1
date%s = nint((shr_date_secsPerDay*date%stepInDay)/date%stepsPerDay)
end if
end subroutine shr_date_rev1step
!===============================================================================
!BOP ===========================================================================
!
! !IROUTINE: shr_date_advNextDay - advance the date to start of next day.
!
! !DESCRIPTION:
! Advance the date to the start of next day.
!
! !REVISION HISTORY:
! 2001-Sep-13 - B. Kauffman - initial version.
!
! !INTERFACE: -----------------------------------------------------------------
subroutine shr_date_advNextDay(date) 1,2
implicit none
! !INPUT/OUTPUT PARAMETERS:
type(shr_date),intent(inout) :: date ! number of elapsed days
!EOP
!-------------------------------------------------------------------------------
!
!-------------------------------------------------------------------------------
date%eDay = date%eDay + 1
date%stepInDay = 0
date%s = 0
call shr_cal_eDay2ymd
(date%eDay,date%y,date%m,date%d)
call shr_cal_eDay2date
(date%eDay,date%cDate)
end subroutine shr_date_advNextDay
!===============================================================================
!BOP ===========================================================================
!
! !IROUTINE: shr_date_revPrevDay - reverse the date to start of previous day.
!
! !DESCRIPTION:
! Reverse the date to the start of previous day.
!
! !REVISION HISTORY:
! 2008-Jul-01 - E. Kluzek - initial version.
!
! !INTERFACE: -----------------------------------------------------------------
subroutine shr_date_revPrevDay(date) 1,2
implicit none
! !INPUT/OUTPUT PARAMETERS:
type(shr_date),intent(inout) :: date ! number of elapsed days
!EOP
!-------------------------------------------------------------------------------
!
!-------------------------------------------------------------------------------
date%eDay = date%eDay - 1
date%stepInDay = 0
date%s = 0
call shr_cal_eDay2ymd
(date%eDay,date%y,date%m,date%d)
call shr_cal_eDay2date
(date%eDay,date%cDate)
end subroutine shr_date_revPrevDay
!===============================================================================
!BOP ===========================================================================
!
! !IROUTINE: shr_date_getYMD - return yy,mm,dd,ss of date
!
! !DESCRIPTION:
! return yy,mm,dd,ss of date.
!
! !REVISION HISTORY:
! 2001-Sep-13 - B. Kauffman - initial version.
!
! !INTERFACE: -----------------------------------------------------------------
subroutine shr_date_getYMD(date,y,m,d,s) 8
implicit none
! !INPUT/OUTPUT PARAMETERS:
type(shr_date),intent(in) :: date ! input date
integer(SHR_KIND_IN),intent(out) :: y ! year
integer(SHR_KIND_IN),intent(out) :: m ! month
integer(SHR_KIND_IN),intent(out) :: d ! day
integer(SHR_KIND_IN),intent(out) :: s ! elapsed seconds on date
!EOP
!-------------------------------------------------------------------------------
!
!-------------------------------------------------------------------------------
y = date%y
m = date%m
d = date%d
s = date%s
end subroutine shr_date_getYMD
!===============================================================================
!BOP ===========================================================================
!
! !IROUTINE: shr_date_getCDate - return coded date of a date
!
! !DESCRIPTION:
! return coded date of a date
!
! !REVISION HISTORY:
! 2001-Sep-13 - B. Kauffman - initial version.
!
! !INTERFACE: -----------------------------------------------------------------
subroutine shr_date_getCDATE(date,cDate,s,previous) 1,1
implicit none
! !INPUT/OUTPUT PARAMETERS:
type(shr_date),intent(in) :: date ! number of elapsed days
integer(SHR_KIND_IN),intent(out) :: cDate ! coded date
integer(SHR_KIND_IN),intent(out) :: s ! elapsed seconds on date
logical, optional ,intent(in) :: previous ! flag if true return values for previous time step
!EOP
type(shr_date) :: ldate ! local date
!-------------------------------------------------------------------------------
!
!-------------------------------------------------------------------------------
ldate = date
if ( present(previous) )then
if ( previous )then
call shr_date_rev1step
(ldate)
end if
end if
cDate = ldate%cDate
s = ldate%s
end subroutine shr_date_getCDate
!===============================================================================
!BOP ===========================================================================
!
! !IROUTINE: shr_date_getEDay - return elapsed days of a date
!
! !DESCRIPTION:
! return elapsed days of a date
!
! !REVISION HISTORY:
! 2001-Sep-13 - B. Kauffman - initial version.
!
! !INTERFACE: -----------------------------------------------------------------
subroutine shr_date_getEDay(date,eDay,s) 3
implicit none
! !INPUT/OUTPUT PARAMETERS:
type(shr_date),intent(in) :: date ! input date
integer(SHR_KIND_IN),intent(out) :: eDay ! elapsed days of date
integer(SHR_KIND_IN),intent(out) :: s ! elapsed seconds on date
!EOP
!-------------------------------------------------------------------------------
!
!-------------------------------------------------------------------------------
eDay = date%eDay
s = date%s
end subroutine shr_date_getEDay
!===============================================================================
!BOP ===========================================================================
!
! !IROUTINE: shr_date_getStepsPerDay - return elapsed days of a date
!
! !DESCRIPTION:
! return elapsed days of a date
!
! !REVISION HISTORY:
! 2001-Sep-13 - B. Kauffman - initial version.
!
! !INTERFACE: -----------------------------------------------------------------
integer function shr_date_getStepsPerDay(date) 1
implicit none
! !INPUT/OUTPUT PARAMETERS:
type(shr_date),intent(in) :: date ! input date
!EOP
!-------------------------------------------------------------------------------
!
!-------------------------------------------------------------------------------
shr_date_getStepsPerDay = date%stepsPerDay
end function shr_date_getStepsPerDay
!===============================================================================
!BOP ===========================================================================
!
! !IROUTINE: shr_date_getStepInDay - return elapsed days of a date
!
! !DESCRIPTION:
! return timestep in this day
!
! !REVISION HISTORY:
! 2001-Nov-13 - T. Craig - initial version.
!
! !INTERFACE: -----------------------------------------------------------------
integer function shr_date_getStepInDay(date) 1
implicit none
! !INPUT/OUTPUT PARAMETERS:
type(shr_date),intent(in) :: date ! input date
!EOP
!-------------------------------------------------------------------------------
!
!-------------------------------------------------------------------------------
shr_date_getStepInDay = date%StepInDay
end function shr_date_getStepInDay
!===============================================================================
!BOP ===========================================================================
!
! !IROUTINE: shr_date_getJulian - return julian day
!
! !DESCRIPTION:
! return julian day
!
! !REVISION HISTORY:
! 2002-Oct-28 - R. Jacob -initial version
!
! !INTERFACE: -----------------------------------------------------------------
real(SHR_KIND_R8) function shr_date_getJulian(date,shift),3
implicit none
! !INPUT/OUTPUT PARAMETERS:
type(shr_date),intent(in) :: date ! input date
integer(SHR_KIND_IN),intent(in),optional :: shift ! seconds to shift calculation
!EOP
! local
type(shr_date) :: ldate ! local date
integer(SHR_KIND_IN) :: nsteps ! number of steps to advance
integer(SHR_KIND_IN) :: n ! step index
!-------------------------------------------------------------------------------
!
!-------------------------------------------------------------------------------
ldate = date
if( present(shift) )then
if ( mod(shift,int(shr_date_nsecsPerDay/date%stepsPerDay) ) /= 0 )then
write(s_logunit,*) 'ERROR: invalid shift = ', shift, ' needs to be divisible by: ', &
shr_date_nsecsPerDay/date%stepsPerDay
call shr_sys_abort
('(shr_date_getJulian) invalid amount to shift')
end if
nsteps = shift * date%stepsPerDay / shr_date_nsecsPerDay
do n = 1, nsteps
call shr_date_adv1step
( ldate )
end do
end if
shr_date_getJulian = shr_cal_elapsDaysStrtMonth
(ldate%y,ldate%m) &
+ ldate%d + ldate%s/shr_date_secsPerDay
end function shr_date_getJulian
!===============================================================================
!===============================================================================
end module shr_date_mod