!=============================================================================== !BOP =========================================================================== ! ! !MODULE: shr_cal_mod -- calendar module, relates elapsed days to calendar date. ! ! !DESCRIPTION: ! These calendar routines do conversions between... ! \begin{itemize} ! \item the integer number of elapsed days ! \item the integers year, month, day (three inter-related integers) ! \item the integer coded calendar date (yyyymmdd) ! \end{itemize} ! Possible uses include: a calling routine can increment the elapsed days ! integer and use this module to determine what the corresponding calendar ! date is; this module can be used to determine how many days apart two ! arbitrary calendar dates are. ! ! !REVISION HISTORY: ! 2001-dec-28 - B. Kauffman - created initial version, taken from cpl5 ! 2012-feb-10 - T. Craig - update to esmf 5.2.0rp1, some noleap functions ! associated with elapsed days must still be done internally ! ! !REMARKS: ! Following are some internal assumptions. These assumptions are somewhat ! arbitrary -- they were chosen because they result in the simplest code given ! the requirements of this module. These assumptions can be relaxed as ! necessary: ! o the valid range of years is [-999,9999] ! o elapsed days = 0 <=> January 1st, year 0000 for noleap ! ! !INTERFACE: ------------------------------------------------------------------ module shr_cal_mod ! !USES: use shr_kind_mod ! kinds use shr_const_mod ! constants use shr_sys_mod ! system use shr_string_mod, only: shr_string_toLower use shr_log_mod, only: s_loglev => shr_log_Level use shr_log_mod, only: s_logunit => shr_log_Unit use esmf implicit none private ! except ! !PUBLIC TYPES: ! none ! !PUBLIC MEMBER FUNCTIONS: public :: shr_cal_calendarName ! checks and returns valid cal name public :: shr_cal_numDaysinMonth ! number of days in a month public :: shr_cal_numDaysinYear ! number of days in a year public :: shr_cal_elapsDaysStrtMonth ! elapsed days on start of month public :: shr_cal_timeset ! set ESMF Time from ymd, s, shr_cal calendar public :: shr_cal_date2ymd ! converts coded-date to yr,month,day public :: shr_cal_date2julian! converts coded-date,sec to julian days public :: shr_cal_ymd2julian ! converts yr,month,day,sec to julian days public :: shr_cal_ymd2date ! converts yr,month,day to coded-date public :: shr_cal_advDate ! advance date/secs real seconds public :: shr_cal_advDateInt ! advance date/secs integer seconds public :: shr_cal_validDate ! logical function: is coded-date valid? public :: shr_cal_validYMD ! logical function: are yr,month,day valid? public :: shr_cal_validHMS ! logical function: are hr, min, sec valid? public :: shr_cal_getDebug ! get internal debug level public :: shr_cal_setDebug ! set internal debug level ! !PUBLIC DATA MEMBERS: ! none !EOP integer(SHR_KIND_IN),parameter,public :: shr_cal_calMaxLen = 64 character(len=*),parameter,public :: & shr_cal_noleap = 'NO_LEAP', & shr_cal_gregorian = 'GREGORIAN' !--- this is the noleap calendar --- integer(SHR_KIND_IN),parameter :: dpy = 365 integer(SHR_KIND_IN),parameter :: dpm(12) = & ! Days Per Month & (/31,28,31, 30, 31, 30, 31, 31, 30, 31, 30, 31/) !--- trigger internal debug output --- integer(SHR_KIND_IN) :: debug = 0 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ contains !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ !=============================================================================== !BOP =========================================================================== ! ! !IROUTINE: shr_cal_calendarName - check calendar name and translate ! ! !DESCRIPTION: ! Check the validity of the calendar name and translate to standard naming ! ! !REVISION HISTORY: ! 2010-oct-7 - T Craig - initial version. ! ! !INTERFACE: ----------------------------------------------------------------- function shr_cal_calendarName(calendar,trap) implicit none ! !INPUT/OUTPUT PARAMETERS: character(*) ,intent(in) :: calendar ! calendar type logical ,optional,intent(in) :: trap character(len=shr_cal_calMaxLen) :: shr_cal_calendarName !EOP character(len=shr_cal_calMaxLen) :: lcal logical :: ltrap character(len=shr_cal_calMaxLen) :: lowercalendar character(*),parameter :: subName = "(shr_cal_calendarName)" ltrap = .true. if (present(trap)) then ltrap = trap endif lcal = ' ' lowercalendar = trim(shr_string_toLower(trim(calendar))) lcal = trim(calendar) selectcase(trim(lowercalendar)) case ('noleap') lcal = trim(shr_cal_noleap) case ('no_leap') lcal = trim(shr_cal_noleap) case ('365_day') lcal = trim(shr_cal_noleap) case ('365day') lcal = trim(shr_cal_noleap) case ('gregorian') lcal = trim(shr_cal_gregorian) case ('standard') lcal = trim(shr_cal_gregorian) case ('proleptic_gregorian') lcal = trim(shr_cal_gregorian) case default if (ltrap) then write(s_logunit,*) trim(subname),' : ERROR calendar not supported : ',trim(calendar) call shr_sys_abort(trim(subname)//' : calendar not supported : '//trim(calendar)) endif end select shr_cal_calendarName = trim(lcal) end function shr_cal_calendarName !=============================================================================== !BOP =========================================================================== ! ! !IROUTINE: shr_cal_timeSet - create and esmf_time type for ymd, sec and calendar ! ! !DESCRIPTION: ! Create ESMF_Time type from ymd, sec, calendar ! ! !REVISION HISTORY: ! 2012-feb-10 - T. Craig - initial version. ! ! !INTERFACE: ----------------------------------------------------------------- subroutine shr_cal_timeSet(etime,ymd,sec,calendar) implicit none ! !INPUT/OUTPUT PARAMETERS: type(ESMF_Time),intent(out) :: etime integer(SHR_KIND_IN),intent(in ) :: ymd,sec ! ymd, sec character(*) ,intent(in) :: calendar ! calendar type !EOP integer(SHR_KIND_IN) :: year,month,day type(ESMF_CALKIND_FLAG) :: calkind character(len=shr_cal_calMaxLen) :: lcalendar integer :: rc character(*),parameter :: subName = "(shr_cal_timeSet)" !------------------------------------------------------------------------------- ! !------------------------------------------------------------------------------- lcalendar = shr_cal_calendarName(calendar) calkind = ESMF_CALKIND_NOLEAP if (trim(lcalendar) == trim(shr_cal_gregorian)) then calkind = ESMF_CALKIND_GREGORIAN endif call shr_cal_date2ymd(ymd,year,month,day) call ESMF_TimeSet(etime,yy=year,mm=month,dd=day,s=sec,calkindflag=calkind,rc=rc) if(rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) end subroutine shr_cal_timeSet !=============================================================================== !BOP =========================================================================== ! ! !IROUTINE: shr_cal_numDaysInMonth - return the number of days in a month. ! ! !DESCRIPTION: ! Deturn the number of days in a month. ! ! !REVISION HISTORY: ! 2002-sep-18 - B. Kauffman - initial version. ! ! !INTERFACE: ----------------------------------------------------------------- integer function shr_cal_numDaysInMonth(year,month,calendar) implicit none ! !INPUT/OUTPUT PARAMETERS: integer(SHR_KIND_IN),intent(in ) :: year,month ! calendar year,month character(*) ,intent(in) :: calendar ! calendar type !EOP type(ESMF_time) :: time1,time2 type(ESMF_timeInterval) :: timeint type(ESMF_CALKIND_FLAG) :: calkind integer(SHR_KIND_IN) :: eday character(len=shr_cal_calMaxLen) :: lcalendar integer :: rc character(*),parameter :: subName = "(shr_cal_numDaysInMonth)" !------------------------------------------------------------------------------- ! !------------------------------------------------------------------------------- lcalendar = shr_cal_calendarName(calendar) calkind = ESMF_CALKIND_NOLEAP if (trim(lcalendar) == trim(shr_cal_gregorian)) then calkind = ESMF_CALKIND_GREGORIAN endif call ESMF_TimeSet(time1,yy=year,mm=month,dd=1,s=0,calkindflag=calkind,rc=rc) if(rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) if (month < 12) then call ESMF_TimeSet(time2,yy=year,mm=month+1,dd=1,s=0,calkindflag=calkind,rc=rc) if(rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) else call ESMF_TimeSet(time2,yy=year+1,mm=1,dd=1,s=0,calkindflag=calkind,rc=rc) if(rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) endif timeint = time2-time1 call ESMF_TimeIntervalGet(timeint,StartTimeIn=time1,d=eday) shr_cal_numDaysInMonth = eday end function shr_cal_numDaysInMonth !=============================================================================== !BOP =========================================================================== ! ! !IROUTINE: shr_cal_numDaysInYear - return the number of days in a year. ! ! !DESCRIPTION: ! Deturn the number of days in a year. ! ! !REVISION HISTORY: ! 2002-sep-18 - B. Kauffman - initial version. ! ! !INTERFACE: ----------------------------------------------------------------- integer function shr_cal_numDaysInYear(year,calendar) implicit none ! !INPUT/OUTPUT PARAMETERS: integer(SHR_KIND_IN),intent(in ) :: year ! calendar year character(*) ,intent(in) :: calendar ! calendar type !EOP type(ESMF_time) :: time1,time2 type(ESMF_timeInterval) :: timeint type(ESMF_CALKIND_FLAG) :: calkind integer(SHR_KIND_IN) :: eday character(len=shr_cal_calMaxLen) :: lcalendar integer :: rc character(*),parameter :: subName = "(shr_cal_numDaysInYear)" !------------------------------------------------------------------------------- ! !------------------------------------------------------------------------------- lcalendar = shr_cal_calendarName(calendar) calkind = ESMF_CALKIND_NOLEAP if (trim(lcalendar) == trim(shr_cal_gregorian)) then calkind = ESMF_CALKIND_GREGORIAN endif call ESMF_TimeSet(time1,yy=year,mm=1,dd=1,s=0,calkindflag=calkind,rc=rc) if(rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) call ESMF_TimeSet(time2,yy=year+1,mm=1,dd=1,s=0,calkindflag=calkind,rc=rc) if(rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) timeint = time2-time1 call ESMF_TimeIntervalGet(timeint,StartTimeIn=time1,d=eday) shr_cal_numDaysInYear = eday end function shr_cal_numDaysInYear !=============================================================================== !BOP =========================================================================== ! ! !IROUTINE: shr_cal_elapsDaysStrtMonth - return the number of elapsed days ! at start of month ! ! !DESCRIPTION: ! Return the number of elapsed days at start of a month. ! ! !REVISION HISTORY: ! 2002-Oct-29 - R. Jacob - initial version ! ! !INTERFACE: ----------------------------------------------------------------- integer function shr_cal_elapsDaysStrtMonth(year,month,calendar) implicit none ! !INPUT/OUTPUT PARAMETERS: integer(SHR_KIND_IN),intent(in ) :: year,month ! calendar year,month character(*) ,intent(in) :: calendar ! calendar type !EOP integer :: rc integer :: k character(*),parameter :: subName = "(shr_cal_elapsDaysStrtMonth)" !------------------------------------------------------------------------------- ! !------------------------------------------------------------------------------- shr_cal_elapsDaysStrtMonth = 0 do k = 1,month-1 shr_cal_elapsDaysStrtMonth = shr_cal_elapsDaysStrtMonth + & shr_cal_numDaysInMonth(year,k,calendar) enddo end function shr_cal_elapsDaysStrtMonth !=============================================================================== !BOP =========================================================================== ! ! !IROUTINE: shr_cal_date2ymd - converts coded-date to year/month/day. ! ! !DESCRIPTION: ! Converts coded-date (yyyymmdd) to year/month/day. ! ! !REVISION HISTORY: ! 2001-dec-28 - B. Kauffman - initial version, taken from cpl5 ! ! !INTERFACE: ----------------------------------------------------------------- subroutine shr_cal_date2ymd (date,year,month,day) implicit none ! !INPUT/OUTPUT PARAMETERS: integer(SHR_KIND_IN),intent(in) :: date ! coded-date (yyyymmdd) integer(SHR_KIND_IN),intent(out) :: year,month,day ! calendar year,month,day !EOP integer(SHR_KIND_IN) :: tdate ! temporary date character(*),parameter :: subName = "(shr_cal_date2ymd)" !------------------------------------------------------------------------------- ! !------------------------------------------------------------------------------- if (debug > 1) write(s_logunit,*) trim(subname),'_a ',date tdate = abs(date) year =int( tdate /10000) if (date < 0) year = -year month=int( mod(tdate,10000)/ 100) day = mod(tdate, 100) if (debug > 1) write(s_logunit,*) trim(subname),'_b ',year,month,day end subroutine shr_cal_date2ymd !=============================================================================== !BOP =========================================================================== ! ! !IROUTINE: shr_cal_date2julian - converts coded-date to julian day of year ! ! !DESCRIPTION: ! Converts coded-date to julian day of year ! ! !REVISION HISTORY: ! 2009-Oct-23 - T. Craig - initial version ! ! !INTERFACE: ----------------------------------------------------------------- subroutine shr_cal_date2julian(date,sec,jday,calendar) implicit none ! !INPUT/OUTPUT PARAMETERS: integer(SHR_KIND_IN),intent(in ) :: date ! coded (yyyymmdd) calendar date integer(SHR_KIND_IN),intent(in ) :: sec ! seconds real (SHR_KIND_R8),intent(out) :: jday ! julian day of year character(*) ,intent(in) :: calendar ! calendar type !EOP !--- local --- integer(SHR_KIND_IN) :: year,month,day character(*),parameter :: subName = "(shr_cal_date2julian)" !------------------------------------------------------------------------------- ! NOTE: ! julian day of year since yy-01-01-00000 !------------------------------------------------------------------------------- if (debug > 1) write(s_logunit,*) trim(subname),'_a ',date,sec call shr_cal_date2ymd(date,year,month,day) call shr_cal_ymd2julian(year,month,day,sec,jday,calendar) if (debug > 1) write(s_logunit,*) trim(subname),'_b ',jday end subroutine shr_cal_date2julian !=============================================================================== !BOP =========================================================================== ! ! !IROUTINE: shr_cal_ymd2julian - converts y,m,d,s to julian day of year ! ! !DESCRIPTION: ! Converts y,m,d,s to julian day of year ! ! !REVISION HISTORY: ! 2009-Oct-23 - T. Craig - initial version ! ! !INTERFACE: ----------------------------------------------------------------- subroutine shr_cal_ymd2julian(year,month,day,sec,jday,calendar) implicit none ! !INPUT/OUTPUT PARAMETERS: integer(SHR_KIND_IN),intent(in ) :: year ! year integer(SHR_KIND_IN),intent(in ) :: month ! month integer(SHR_KIND_IN),intent(in ) :: day ! day integer(SHR_KIND_IN),intent(in ) :: sec ! seconds real (SHR_KIND_R8),intent(out) :: jday ! julian day of year character(*) ,intent(in) :: calendar ! calendar type !EOP !--- local --- character(*),parameter :: subName = "(shr_cal_ymd2julian)" !------------------------------------------------------------------------------- ! NOTE: ! julian day of year since yy-01-01-000000 !------------------------------------------------------------------------------- if (debug > 1) write(s_logunit,*) trim(subname),'_a ',year,month,day,sec if (.not. shr_cal_validYMD(year,month,day,calendar)) then write(s_logunit,*) trim(subname),' ERROR: invalid ymd',year,month,day call shr_sys_abort(trim(subname)//' ERROR: invalid ymd') endif jday = shr_cal_elapsDaysStrtMonth(year,month,calendar) + day + sec/SHR_CONST_CDAY if (debug > 1) write(s_logunit,*) trim(subname),'_b ',jday end subroutine shr_cal_ymd2julian !=============================================================================== !BOP =========================================================================== ! ! !IROUTINE: shr_cal_ymd2date - converts year, month, day to coded-date ! ! !DESCRIPTION: ! Converts year, month, day to coded-date ! ! !REVISION HISTORY: ! 2001-dec-28 - B. Kauffman - initial version, taken from cpl5 ! ! !INTERFACE: ----------------------------------------------------------------- subroutine shr_cal_ymd2date(year,month,day,date) implicit none ! !INPUT/OUTPUT PARAMETERS: integer(SHR_KIND_IN),intent(in ) :: year,month,day ! calendar year,month,day integer(SHR_KIND_IN),intent(out) :: date ! coded (yyyymmdd) calendar date !EOP !--- local --- character(*),parameter :: subName = "(shr_cal_ymd2date)" !------------------------------------------------------------------------------- ! NOTE: ! this calendar has a year zero (but no day or month zero) !------------------------------------------------------------------------------- if (debug > 1) write(s_logunit,*) trim(subname),'_a ',year,month,day date = abs(year)*10000 + month*100 + day ! coded calendar date if (year < 0) date = -date if (debug > 1) write(s_logunit,*) trim(subname),'_b ',date end subroutine shr_cal_ymd2date !=============================================================================== !BOP =========================================================================== ! ! !IROUTINE: shr_cal_advDate - advances a date and seconds with a delta time ! ! !DESCRIPTION: ! Advances a date and seconds with a delta time ! Accuracy only good to nearest second ! ! !REVISION HISTORY: ! 2009-Jun-09 - T. Craig - allows delta < 0 ! 2005-Jun-10 - B. Kauffman - bug fix, simplified algorithm ! 2005-May-15 - T. Craig - initial version ! ! !INTERFACE: ----------------------------------------------------------------- subroutine shr_cal_advDate(delta,units,dateIN,secIN,dateOUT,secOUT,calendar) implicit none ! !INPUT/OUTPUT PARAMETERS: real (SHR_KIND_R8) ,intent(in) :: delta ! time increment character(*) ,intent(in) :: units ! units of increment integer(SHR_KIND_IN) ,intent(in) :: dateIN ! base date, yyyymmdd real (SHR_KIND_R8) ,intent(in) :: secIN ! base seconds integer(SHR_KIND_IN) ,intent(out) :: dateOUT ! new date, yyyymmdd real (SHR_KIND_R8) ,intent(out) :: secOUT ! new seconds character(*) ,intent(in) :: calendar ! calendar type !EOP !--- local --- type(ESMF_time) :: timeIn, timeOut type(ESMF_timeInterval) :: dt real (SHR_KIND_R8) :: dSec ! delta-sec: advance date this many seconds integer(SHR_KIND_I8) :: i8dsec, i8dday ! delta sec and day in i8 integer(SHR_KIND_I8) :: spd ! seconds per day in i8 integer(SHR_KIND_I4) :: idday, idsec ! delta sec and dat in i4 integer(SHR_KIND_I4) :: year, month, day, sec ! calendar stuff character(len=shr_cal_calMaxLen) :: lcalendar type(ESMF_CALKIND_FLAG) :: calkind !--- formats --- character(*),parameter :: subName = "(shr_cal_advDate)" character(*),parameter :: F00 = "('(shr_cal_advDate) ',a,i5)" character(*),parameter :: F02 = "('(shr_cal_advDate) ',a,i8.8,f10.3)" !------------------------------------------------------------------------------- ! NOTE: !------------------------------------------------------------------------------- !--- calculate delta-time in seconds --- if (trim(units) == 'days' ) then dSec = delta * SHR_CONST_CDAY elseif (trim(units) == 'hours' ) then dSec = delta * 3600.0_SHR_KIND_R8 elseif (trim(units) == 'minutes') then dSec = delta * 60.0_SHR_KIND_R8 elseif (trim(units) == 'seconds') then dSec = delta * 1.0_SHR_KIND_R8 else call shr_sys_abort(trim(subname)//' ERROR: unrecognized time units '//trim(units)) endif ! take secIn into account here since it's real dSec = dSec - secIn ! i8 math, convert reals to nearest second i8dSec = nint(dSec,SHR_KIND_I8) spd = nint(SHR_CONST_CDAY) i8dday = i8dsec/spd i8dsec = i8dsec - i8dday*spd ! convert to i4 idday = i8dday idsec = i8dsec calkind = ESMF_CALKIND_NOLEAP lcalendar = shr_cal_calendarName(calendar) if (trim(lcalendar) == trim(shr_cal_gregorian)) then calkind = ESMF_CALKIND_GREGORIAN endif call shr_cal_date2ymd(dateIn,year,month,day) call ESMF_TimeSet(timeIN,yy=year,mm=month,dd=day,calkindflag=calkind) call ESMF_TimeIntervalSet(dt,d=idday,s=idsec) timeOut = timeIn + dt call ESMF_TimeGet(timeOut,yy=year,mm=month,dd=day,s=sec) call shr_cal_ymd2date(year,month,day,dateOut) secOut = sec if (debug>0) then if (s_loglev > 0) write(s_logunit,*) subName," units,delta,calendar=",trim(units),delta,' ',trim(calendar) if (s_loglev > 0) write(s_logunit,F02) "dateIN ,secIN =",dateIN ,secIN if (s_loglev > 0) write(s_logunit,F02) "dateOUT,secOUT=",dateOUT,secOUT end if end subroutine shr_cal_advDate !=============================================================================== !BOP =========================================================================== ! ! !IROUTINE: shr_cal_advDateInt - advances a date and seconds with a delta time ! ! !DESCRIPTION: ! Advances a date and seconds with a delta time ! ! !REVISION HISTORY: ! 2009-???-?? - ?? - replicated from shr_cal_advDate() ! ! !INTERFACE: ----------------------------------------------------------------- subroutine shr_cal_advDateInt(delta,units,dateIN,secIN,dateOUT,secOUT,calendar) implicit none ! !INPUT/OUTPUT PARAMETERS: integer(SHR_KIND_IN) ,intent(in) :: delta ! time increment character(*) ,intent(in) :: units ! units of increment integer(SHR_KIND_IN) ,intent(in) :: dateIN ! base date, yyyymmdd integer(SHR_KIND_IN) ,intent(in) :: secIN ! base seconds integer(SHR_KIND_IN) ,intent(out) :: dateOUT ! new date, yyyymmdd integer(SHR_KIND_IN) ,intent(out) :: secOUT ! new seconds character(*) ,intent(in) :: calendar ! calendar type !EOP !--- local --- type(ESMF_time) :: timeIn, timeOut type(ESMF_timeInterval) :: dt integer(SHR_KIND_IN) :: year,month,day character(len=shr_cal_calMaxLen) :: lcalendar type(ESMF_CALKIND_FLAG) :: calkind !--- formats --- character(*),parameter :: subName = "(shr_cal_advDateInt)" character(*),parameter :: F00 = "('(shr_cal_advDateInt) ',a,i5)" character(*),parameter :: F02 = "('(shr_cal_advDateInt) ',a,i8.8,f10.3)" !------------------------------------------------------------------------------- ! NOTE: !------------------------------------------------------------------------------- lcalendar = shr_cal_calendarName(calendar) calkind = ESMF_CALKIND_NOLEAP if (trim(lcalendar) == trim(shr_cal_gregorian)) then calkind = ESMF_CALKIND_GREGORIAN endif call shr_cal_date2ymd(dateIn,year,month,day) call ESMF_TimeSet(timeIN,yy=year,mm=month,dd=day,s=secIn,calkindflag=calkind) !--- calculate delta-time in seconds --- if (trim(units) == 'days' ) then call ESMF_TimeIntervalSet(dt,d=delta) elseif (trim(units) == 'hours' ) then call ESMF_TimeIntervalSet(dt,h=delta) elseif (trim(units) == 'minutes') then call ESMF_TimeIntervalSet(dt,m=delta) elseif (trim(units) == 'seconds') then call ESMF_TimeIntervalSet(dt,s=delta) else call shr_sys_abort(trim(subname)//' ERROR: unrecognized time units '//trim(units)) endif timeOut = timeIn + dt call ESMF_TimeGet(timeOut,yy=year,mm=month,dd=day,s=secOut) call shr_cal_ymd2date(year,month,day,dateOut) if (debug>0) then if (s_loglev > 0) write(s_logunit,*) subName," units,delta,calendar=",trim(units),delta,' ',trim(calendar) if (s_loglev > 0) write(s_logunit,F02) "dateIN ,secIN =",dateIN ,secIN if (s_loglev > 0) write(s_logunit,F02) "dateOUT,secOUT=",dateOUT,secOUT end if end subroutine shr_cal_advDateInt !=============================================================================== !BOP =========================================================================== ! ! !IROUTINE: shr_cal_validDate - determines if coded-date is a valid date ! ! !DESCRIPTION: ! Determines if the given coded-date is a valid date. ! ! !REVISION HISTORY: ! 2001-dec-28 - B. Kauffman - initial version, taken from cpl5 ! ! !INTERFACE: ----------------------------------------------------------------- logical function shr_cal_validDate(date,calendar) implicit none ! !INPUT/OUTPUT PARAMETERS: integer(SHR_KIND_IN),intent(in ) :: date ! coded (yyyymmdd) calendar date character(len=*) ,intent(in ) :: calendar ! calendar !EOP !--- local --- integer(SHR_KIND_IN) :: year,month,day integer(SHR_KIND_IN) :: tdate character(*),parameter :: subName = "(shr_cal_validDate)" !------------------------------------------------------------------------------- ! !------------------------------------------------------------------------------- call shr_cal_date2ymd(date,year,month,day) shr_cal_validDate = shr_cal_validYMD(year,month,day,calendar) end function shr_cal_validDate !=============================================================================== !BOP =========================================================================== ! ! !IROUTINE: shr_cal_validYMD - determines if year, month, day is a valid date ! ! !DESCRIPTION: ! Determines if the given year, month, and day indicate a valid date. ! ! !REVISION HISTORY: ! 2001-dec-28 - B. Kauffman - initial version, taken from cpl5 ! ! !INTERFACE: ----------------------------------------------------------------- logical function shr_cal_validYMD(year,month,day,calendar) implicit none ! !INPUT/OUTPUT PARAMETERS: integer(SHR_KIND_IN),intent(in ) :: year,month,day ! year,month,day character(len=*) ,intent(in ) :: calendar ! calendar !EOP !--- local --- !------------------------------------------------------------------------------- ! !------------------------------------------------------------------------------- shr_cal_validYMD = .true. if (year < -999) shr_cal_validYMD = .false. if (year > 9999) shr_cal_validYMD = .false. if (month < 1) shr_cal_validYMD = .false. if (month > 12) shr_cal_validYMD = .false. if (day < 1) shr_cal_validYMD = .false. if (day > shr_cal_numDaysInMonth(year,month,calendar)) & shr_cal_validYMD = .false. end function shr_cal_validYMD !=============================================================================== !BOP =========================================================================== ! ! !IROUTINE: shr_cal_validHMS - determines if hour, min, sec is valid ! ! !DESCRIPTION: ! Determines if the given hour, min, sec is valid ! ! !REVISION HISTORY: ! 2005-May-15 - T. Craig - initial version ! ! !INTERFACE: ----------------------------------------------------------------- logical function shr_cal_validHMS(hr,min,sec) implicit none ! !INPUT/OUTPUT PARAMETERS: integer(SHR_KIND_IN),intent(in ) :: hr, min, sec ! hour, minute, second !EOP !--- local --- character(*),parameter :: subName = "(shr_cal_validHMS)" !------------------------------------------------------------------------------- ! !------------------------------------------------------------------------------- shr_cal_validHMS = .true. if (hr < 0) shr_cal_validHMS = .false. if (hr > 23) shr_cal_validHMS = .false. if (min < 0) shr_cal_validHMS = .false. if (min > 59) shr_cal_validHMS = .false. if (sec < 0) shr_cal_validHMS = .false. if (sec > 60) shr_cal_validHMS = .false. end function shr_cal_validHMS !=============================================================================== !BOP =========================================================================== ! ! !IROUTINE: shr_cal_setDebug -- Set local shr_cal debug level ! ! !DESCRIPTION: ! Set local shr\_cal debug level, 0 = production ! \newline ! General Usage: call shr\_cal\_setDebug(2) ! ! !REVISION HISTORY: ! 2005-May-10 - B. Kauffman - first version ! ! !INTERFACE: ------------------------------------------------------------------ subroutine shr_cal_setDebug(level) implicit none ! !INPUT/OUTPUT PARAMETERS: integer,intent(in) :: level !EOP !--- formats --- character(*),parameter :: subName = "(shr_cal_setDebug) " character(*),parameter :: F00 = "('(shr_cal_setDebug) ',a) " character(*),parameter :: F01 = "('(shr_cal_setDebug) ',a,i4) " !------------------------------------------------------------------------------- ! !------------------------------------------------------------------------------- debug = level if (s_loglev > 0) write(s_logunit,F01) "debug level reset to ",level end subroutine shr_cal_setDebug !=============================================================================== !BOP =========================================================================== ! ! !IROUTINE: shr_cal_getDebug -- get shr_cal internal debug level ! ! !DESCRIPTION: ! Get shr_cal internal debug level, 0 = production ! \newline ! General Usage: call shr\_cal\_getDebug(level) ! ! !REVISION HISTORY: ! 2005-May-10 - B. Kauffman - first version ! ! !INTERFACE: ------------------------------------------------------------------ subroutine shr_cal_getDebug(level) implicit none ! !INPUT/OUTPUT PARAMETERS: integer,intent(out) :: level !EOP !--- formats --- character(*),parameter :: subName = "(shr_cal_getDebug) " character(*),parameter :: F00 = "('(shr_cal_getDebug) ',a) " !------------------------------------------------------------------------------- ! !------------------------------------------------------------------------------- level = debug end subroutine shr_cal_getDebug !=============================================================================== !=============================================================================== end module shr_cal_mod