<HTML> <BODY BGCOLOR=#ccccdd LINK=#0000aa VLINK=#0000ff ALINK=#ff0000 ><BASE TARGET="bottom_target"><PRE>
#include <ESMF_TimeMgr.inc>
! Factor so abs(Sn) < Sd and ensure that signs of S and Sn match.
! Also, enforce consistency.
! YR and MM fields are ignored.
<A NAME='NORMALIZE_BASETIME'><A href='../../html_code/build/Meat.F90.html#NORMALIZE_BASETIME' TARGET='top_target'><IMG SRC="../../gif/bar_red.gif" border=0></A>
SUBROUTINE normalize_basetime( basetime ) 12,10
USE esmf_basemod
USE esmf_basetimemod
IMPLICIT NONE
TYPE(ESMF_BaseTime), INTENT(INOUT) :: basetime
!PRINT *,'DEBUG: BEGIN normalize_basetime()'
! Consistency check...
IF ( basetime%Sd < 0 ) THEN
CALL wrf_error_fatal( &
'normalize_basetime: denominator of seconds cannot be negative' )
ENDIF
IF ( ( basetime%Sd == 0 ) .AND. ( basetime%Sn .NE. 0 ) ) THEN
CALL wrf_error_fatal( &
'normalize_basetime: denominator of seconds cannot be zero when numerator is non-zero' )
ENDIF
! factor so abs(Sn) < Sd
IF ( basetime%Sd > 0 ) THEN
IF ( ABS( basetime%Sn ) .GE. basetime%Sd ) THEN
!PRINT *,'DEBUG: normalize_basetime() A1: S,Sn,Sd = ',basetime%S,basetime%Sn,basetime%Sd
basetime%S = basetime%S + ( basetime%Sn / basetime%Sd )
basetime%Sn = mod( basetime%Sn, basetime%Sd )
!PRINT *,'DEBUG: normalize_basetime() A2: S,Sn,Sd = ',basetime%S,basetime%Sn,basetime%Sd
ENDIF
! change sign of Sn if it does not match S
IF ( ( basetime%S > 0 ) .AND. ( basetime%Sn < 0 ) ) THEN
!PRINT *,'DEBUG: normalize_basetime() B1: S,Sn,Sd = ',basetime%S,basetime%Sn,basetime%Sd
basetime%S = basetime%S - 1_ESMF_KIND_I8
basetime%Sn = basetime%Sn + basetime%Sd
!PRINT *,'DEBUG: normalize_basetime() B2: S,Sn,Sd = ',basetime%S,basetime%Sn,basetime%Sd
ENDIF
IF ( ( basetime%S < 0 ) .AND. ( basetime%Sn > 0 ) ) THEN
!PRINT *,'DEBUG: normalize_basetime() C1: S,Sn,Sd = ',basetime%S,basetime%Sn,basetime%Sd
basetime%S = basetime%S + 1_ESMF_KIND_I8
basetime%Sn = basetime%Sn - basetime%Sd
!PRINT *,'DEBUG: normalize_basetime() C2: S,Sn,Sd = ',basetime%S,basetime%Sn,basetime%Sd
ENDIF
ENDIF
!PRINT *,'DEBUG: END normalize_basetime()'
END SUBROUTINE normalize_basetime
! A normalized time has time%basetime >= 0, time%basetime less than the current
! year expressed as a timeInterval, and time%YR can take any value
<A NAME='NORMALIZE_TIME'><A href='../../html_code/build/Meat.F90.html#NORMALIZE_TIME' TARGET='top_target'><IMG SRC="../../gif/bar_red.gif" border=0></A>
SUBROUTINE normalize_time( time ) 6,18
USE esmf_basemod
USE esmf_basetimemod
USE esmf_timemod
IMPLICIT NONE
TYPE(ESMF_Time), INTENT(INOUT) :: time
INTEGER(ESMF_KIND_I8) :: nsecondsinyear
! locals
TYPE(ESMF_BaseTime) :: cmptime, zerotime
INTEGER :: rc
LOGICAL :: done
! first, normalize basetime
! this will force abs(Sn) < Sd and ensure that signs of S and Sn match
CALL normalize_basetime( time%basetime )
!$$$ add tests for these edge cases
! next, underflow negative seconds into YEARS
! time%basetime must end up non-negative
!$$$ push this down into ESMF_BaseTime constructor
zerotime%S = 0
zerotime%Sn = 0
zerotime%Sd = 0
DO WHILE ( time%basetime < zerotime )
time%YR = time%YR - 1
!$$$ push this down into ESMF_BaseTime constructor
cmptime%S = nsecondsinyear( time%YR )
cmptime%Sn = 0
cmptime%Sd = 0
time%basetime = time%basetime + cmptime
ENDDO
! next, overflow seconds into YEARS
done = .FALSE.
DO WHILE ( .NOT. done )
!$$$ push this down into ESMF_BaseTime constructor
cmptime%S = nsecondsinyear( time%YR )
cmptime%Sn = 0
cmptime%Sd = 0
IF ( time%basetime >= cmptime ) THEN
time%basetime = time%basetime - cmptime
time%YR = time%YR + 1
ELSE
done = .TRUE.
ENDIF
ENDDO
END SUBROUTINE normalize_time
<A NAME='NORMALIZE_TIMEINT'><A href='../../html_code/build/Meat.F90.html#NORMALIZE_TIMEINT' TARGET='top_target'><IMG SRC="../../gif/bar_red.gif" border=0></A>
SUBROUTINE normalize_timeint( timeInt ) 18,9
USE esmf_basetimemod
USE esmf_timeintervalmod
IMPLICIT NONE
TYPE(ESMF_TimeInterval), INTENT(INOUT) :: timeInt
! normalize basetime
! this will force abs(Sn) < Sd and ensure that signs of S and Sn match
! YR and MM are ignored
CALL normalize_basetime( timeInt%basetime )
END SUBROUTINE normalize_timeint
<A NAME='SIGNNORMTIMEINT'><A href='../../html_code/build/Meat.F90.html#SIGNNORMTIMEINT' TARGET='top_target'><IMG SRC="../../gif/bar_green.gif" border=0></A>
FUNCTION signnormtimeint ( timeInt ),11
! Compute the sign of a time interval.
! YR and MM fields are *IGNORED*.
! returns 1, 0, or -1 or exits if timeInt fields have inconsistent signs.
USE esmf_basemod
USE esmf_basetimemod
USE esmf_timeintervalmod
IMPLICIT NONE
TYPE(ESMF_TimeInterval), INTENT(IN) :: timeInt
INTEGER :: signnormtimeint
LOGICAL :: positive, negative
positive = .FALSE.
negative = .FALSE.
signnormtimeint = 0
! Note that Sd is required to be non-negative. This is enforced in
! normalize_timeint().
! Note that Sn is required to be zero when Sd is zero. This is enforced
! in normalize_timeint().
IF ( ( timeInt%basetime%S > 0 ) .OR. &
( timeInt%basetime%Sn > 0 ) ) THEN
positive = .TRUE.
ENDIF
IF ( ( timeInt%basetime%S < 0 ) .OR. &
( timeInt%basetime%Sn < 0 ) ) THEN
negative = .TRUE.
ENDIF
IF ( positive .AND. negative ) THEN
CALL wrf_error_fatal( &
'signnormtimeint: signs of fields cannot be mixed' )
ELSE IF ( positive ) THEN
signnormtimeint = 1
ELSE IF ( negative ) THEN
signnormtimeint = -1
ENDIF
END FUNCTION signnormtimeint
! Exits with error message if timeInt is not normalized.
<A NAME='TIMEINTCHECKNORMALIZED'><A href='../../html_code/build/Meat.F90.html#TIMEINTCHECKNORMALIZED' TARGET='top_target'><IMG SRC="../../gif/bar_red.gif" border=0></A>
SUBROUTINE timeintchecknormalized( timeInt, msgstr ) 75,5
USE esmf_timeintervalmod
IMPLICIT NONE
TYPE(ESMF_TimeInterval), INTENT(IN) :: timeInt
CHARACTER(LEN=*), INTENT(IN) :: msgstr
! locals
CHARACTER(LEN=256) :: outstr
IF ( ( timeInt%YR /= 0 ) ) THEN
outstr = 'un-normalized TimeInterval not allowed: '//TRIM(msgstr)
CALL wrf_error_fatal( outstr )
ENDIF
END SUBROUTINE timeintchecknormalized
! added from share/module_date_time in WRF.
<A NAME='NFEB'><A href='../../html_code/build/Meat.F90.html#NFEB' TARGET='top_target'><IMG SRC="../../gif/bar_green.gif" border=0></A>
FUNCTION nfeb ( year ) RESULT (num_days) 14
! Compute the number of days in February for the given year
IMPLICIT NONE
INTEGER :: year
INTEGER :: num_days
! TBH: TODO: Replace this hack with run-time decision based on
! TBH: TODO: passed-in calendar.
#ifdef NO_LEAP_CALENDAR
num_days = 28 ! By default, February has 28 days ...
#else
num_days = 28 ! By default, February has 28 days ...
IF (MOD(year,4).eq.0) THEN
num_days = 29 ! But every four years, it has 29 days ...
IF (MOD(year,100).eq.0) THEN
num_days = 28 ! Except every 100 years, when it has 28 days ...
IF (MOD(year,400).eq.0) THEN
num_days = 29 ! Except every 400 years, when it has 29 days.
END IF
END IF
END IF
#endif
END FUNCTION nfeb
<A NAME='NDAYSINYEAR'><A href='../../html_code/build/Meat.F90.html#NDAYSINYEAR' TARGET='top_target'><IMG SRC="../../gif/bar_green.gif" border=0></A>
FUNCTION ndaysinyear ( year ) RESULT (num_diy)
! Compute the number of days in the given year
IMPLICIT NONE
INTEGER, INTENT(IN) :: year
INTEGER :: num_diy
INTEGER :: nfeb
#if defined MARS
num_diy = 669
#elif defined TITAN
num_diy = 686
#else
IF ( nfeb( year ) .EQ. 29 ) THEN
num_diy = 366
ELSE
num_diy = 365
ENDIF
#endif
END FUNCTION ndaysinyear
<A NAME='NSECONDSINYEAR'><A href='../../html_code/build/Meat.F90.html#NSECONDSINYEAR' TARGET='top_target'><IMG SRC="../../gif/bar_green.gif" border=0></A>
FUNCTION nsecondsinyear ( year ) RESULT (numseconds) 6,3
! Compute the number of seconds in the given year
USE esmf_basemod
IMPLICIT NONE
INTEGER, INTENT(IN) :: year
INTEGER(ESMF_KIND_I8) :: numseconds
INTEGER :: ndaysinyear
numseconds = SECONDS_PER_DAY * INT( ndaysinyear(year) , ESMF_KIND_I8 )
END FUNCTION nsecondsinyear
<A NAME='INITDAYM'><A href='../../html_code/build/Meat.F90.html#INITDAYM' TARGET='top_target'><IMG SRC="../../gif/bar_red.gif" border=0></A>
SUBROUTINE initdaym 3,9
USE esmf_basemod
USE esmf_basetimemod
USE ESMF_CalendarMod, only : months_per_year, mday, daym, mdaycum, monthbdys, &
mdayleap, mdayleapcum, monthbdysleap, daymleap
IMPLICIT NONE
INTEGER i,j,m
m = 1
mdaycum(0) = 0
!$$$ push this down into ESMF_BaseTime constructor
monthbdys(0)%S = 0
monthbdys(0)%Sn = 0
monthbdys(0)%Sd = 0
DO i = 1,MONTHS_PER_YEAR
DO j = 1,mday(i)
daym(m) = i
m = m + 1
ENDDO
mdaycum(i) = mdaycum(i-1) + mday(i)
!$$$ push this down into ESMF_BaseTime constructor
monthbdys(i)%S = SECONDS_PER_DAY * INT( mdaycum(i), ESMF_KIND_I8 )
monthbdys(i)%Sn = 0
monthbdys(i)%Sd = 0
ENDDO
m = 1
mdayleapcum(0) = 0
!$$$ push this down into ESMF_BaseTime constructor
monthbdysleap(0)%S = 0
monthbdysleap(0)%Sn = 0
monthbdysleap(0)%Sd = 0
DO i = 1,MONTHS_PER_YEAR
DO j = 1,mdayleap(i)
daymleap(m) = i
m = m + 1
ENDDO
mdayleapcum(i) = mdayleapcum(i-1) + mdayleap(i)
!$$$ push this down into ESMF_BaseTime constructor
monthbdysleap(i)%S = SECONDS_PER_DAY * INT( mdayleapcum(i), ESMF_KIND_I8 )
monthbdysleap(i)%Sn = 0
monthbdysleap(i)%Sd = 0
ENDDO
END SUBROUTINE initdaym
!$$$ useful, but not used at the moment...
<A NAME='COMPUTE_DAYINYEAR'><A href='../../html_code/build/Meat.F90.html#COMPUTE_DAYINYEAR' TARGET='top_target'><IMG SRC="../../gif/bar_red.gif" border=0></A>
SUBROUTINE compute_dayinyear(YR,MM,DD,dayinyear),3
use ESMF_CalendarMod, only : mday
IMPLICIT NONE
INTEGER, INTENT(IN) :: YR,MM,DD ! DD is day of month
INTEGER, INTENT(OUT) :: dayinyear
INTEGER i
integer nfeb
#ifdef PLANET
dayinyear = DD
#else
dayinyear = 0
DO i = 1,MM-1
if (i.eq.2) then
dayinyear = dayinyear + nfeb(YR)
else
dayinyear = dayinyear + mday(i)
endif
ENDDO
dayinyear = dayinyear + DD
#endif
END SUBROUTINE compute_dayinyear
<A NAME='TIMEGETMONTH'><A href='../../html_code/build/Meat.F90.html#TIMEGETMONTH' TARGET='top_target'><IMG SRC="../../gif/bar_red.gif" border=0></A>
SUBROUTINE timegetmonth( time, MM ) 15,14
USE esmf_basemod
USE esmf_basetimemod
USE esmf_timemod
USE ESMF_CalendarMod, only : MONTHS_PER_YEAR, monthbdys, monthbdysleap
IMPLICIT NONE
TYPE(ESMF_Time), INTENT(IN) :: time
INTEGER, INTENT(OUT) :: MM
! locals
INTEGER :: nfeb
INTEGER :: i
#if defined PLANET
MM = 0
#else
MM = -1
IF ( nfeb(time%YR) == 29 ) THEN
DO i = 1,MONTHS_PER_YEAR
IF ( ( time%basetime >= monthbdysleap(i-1) ) .AND. ( time%basetime < monthbdysleap(i) ) ) THEN
MM = i
EXIT
ENDIF
ENDDO
ELSE
DO i = 1,MONTHS_PER_YEAR
IF ( ( time%basetime >= monthbdys(i-1) ) .AND. ( time%basetime < monthbdys(i) ) ) THEN
MM = i
EXIT
ENDIF
ENDDO
ENDIF
#endif
IF ( MM == -1 ) THEN
CALL wrf_error_fatal( 'timegetmonth: could not extract month of year from time' )
ENDIF
END SUBROUTINE timegetmonth
!$$$ may need to change dependencies in Makefile...
<A NAME='TIMEGETDAYOFMONTH'><A href='../../html_code/build/Meat.F90.html#TIMEGETDAYOFMONTH' TARGET='top_target'><IMG SRC="../../gif/bar_red.gif" border=0></A>
SUBROUTINE timegetdayofmonth( time, DD ) 6,15
USE esmf_basemod
USE esmf_basetimemod
USE esmf_timemod
USE esmf_calendarmod, only : monthbdys, monthbdysleap
IMPLICIT NONE
TYPE(ESMF_Time), INTENT(IN) :: time
INTEGER, INTENT(OUT) :: DD
! locals
INTEGER :: nfeb
INTEGER :: MM
TYPE(ESMF_BaseTime) :: tmpbasetime
#if defined PLANET
tmpbasetime = time%basetime
#else
CALL timegetmonth( time, MM )
IF ( nfeb(time%YR) == 29 ) THEN
tmpbasetime = time%basetime - monthbdysleap(MM-1)
ELSE
tmpbasetime = time%basetime - monthbdys(MM-1)
ENDIF
#endif
DD = ( tmpbasetime%S / SECONDS_PER_DAY ) + 1
END SUBROUTINE timegetdayofmonth
! Increment Time by number of seconds between start of year and start
! of month MM.
! 1 <= MM <= 12
! Time is NOT normalized.
<A NAME='TIMEADDMONTHS'><A href='../../html_code/build/Meat.F90.html#TIMEADDMONTHS' TARGET='top_target'><IMG SRC="../../gif/bar_red.gif" border=0></A>
SUBROUTINE timeaddmonths( time, MM, ierr ) 3,12
USE esmf_basemod
USE esmf_basetimemod
USE esmf_timemod
USE esmf_calendarmod, only : MONTHS_PER_YEAR, monthbdys, monthbdysleap
IMPLICIT NONE
TYPE(ESMF_Time), INTENT(INOUT) :: time
INTEGER, INTENT(IN) :: MM
INTEGER, INTENT(OUT) :: ierr
! locals
INTEGER :: nfeb
ierr = ESMF_SUCCESS
! PRINT *,'DEBUG: BEGIN timeaddmonths()'
#if defined PLANET
! time%basetime = time%basetime
#else
IF ( ( MM < 1 ) .OR. ( MM > MONTHS_PER_YEAR ) ) THEN
ierr = ESMF_FAILURE
ELSE
IF ( nfeb(time%YR) == 29 ) THEN
time%basetime = time%basetime + monthbdysleap(MM-1)
ELSE
time%basetime = time%basetime + monthbdys(MM-1)
ENDIF
ENDIF
#endif
END SUBROUTINE timeaddmonths
! Increment Time by number of seconds in the current month.
! Time is NOT normalized.
<A NAME='TIMEINCMONTH'><A href='../../html_code/build/Meat.F90.html#TIMEINCMONTH' TARGET='top_target'><IMG SRC="../../gif/bar_red.gif" border=0></A>
SUBROUTINE timeincmonth( time ) 2,15
USE esmf_basemod
USE esmf_basetimemod
USE esmf_timemod
USE esmf_calendarmod, only : mday, mdayleap
IMPLICIT NONE
TYPE(ESMF_Time), INTENT(INOUT) :: time
! locals
INTEGER :: nfeb
INTEGER :: MM
#if defined PLANET
! time%basetime%S = time%basetime%S
#else
CALL timegetmonth( time, MM )
IF ( nfeb(time%YR) == 29 ) THEN
time%basetime%S = time%basetime%S + &
( INT( mdayleap(MM), ESMF_KIND_I8 ) * SECONDS_PER_DAY )
ELSE
time%basetime%S = time%basetime%S + &
( INT( mday(MM), ESMF_KIND_I8 ) * SECONDS_PER_DAY )
ENDIF
#endif
END SUBROUTINE timeincmonth
! Decrement Time by number of seconds in the previous month.
! Time is NOT normalized.
<A NAME='TIMEDECMONTH'><A href='../../html_code/build/Meat.F90.html#TIMEDECMONTH' TARGET='top_target'><IMG SRC="../../gif/bar_red.gif" border=0></A>
SUBROUTINE timedecmonth( time ) 2,15
USE esmf_basemod
USE esmf_basetimemod
USE esmf_timemod
USE esmf_calendarmod, only : mday, months_per_year, mdayleap
IMPLICIT NONE
TYPE(ESMF_Time), INTENT(INOUT) :: time
! locals
INTEGER :: nfeb
INTEGER :: MM
#if defined PLANET
! time%basetime%S = time%basetime%S
#else
CALL timegetmonth( time, MM ) ! current month, 1-12
! find previous month
MM = MM - 1
IF ( MM == 0 ) THEN
! wrap around Jan -> Dec
MM = MONTHS_PER_YEAR
ENDIF
IF ( nfeb(time%YR) == 29 ) THEN
time%basetime%S = time%basetime%S - &
( INT( mdayleap(MM), ESMF_KIND_I8 ) * SECONDS_PER_DAY )
ELSE
time%basetime%S = time%basetime%S - &
( INT( mday(MM), ESMF_KIND_I8 ) * SECONDS_PER_DAY )
ENDIF
#endif
END SUBROUTINE timedecmonth
! spaceship operator for Times
<A NAME='TIMECMP'><A href='../../html_code/build/Meat.F90.html#TIMECMP' TARGET='top_target'><IMG SRC="../../gif/bar_red.gif" border=0></A>
SUBROUTINE timecmp(time1, time2, retval ) 18,12
USE esmf_basemod
USE esmf_basetimemod
USE esmf_timemod
IMPLICIT NONE
INTEGER, INTENT(OUT) :: retval
!
! !ARGUMENTS:
TYPE(ESMF_Time), INTENT(IN) :: time1
TYPE(ESMF_Time), INTENT(IN) :: time2
IF ( time1%YR .GT. time2%YR ) THEN ; retval = 1 ; RETURN ; ENDIF
IF ( time1%YR .LT. time2%YR ) THEN ; retval = -1 ; RETURN ; ENDIF
CALL seccmp( time1%basetime%S, time1%basetime%Sn, time1%basetime%Sd, &
time2%basetime%S, time2%basetime%Sn, time2%basetime%Sd, &
retval )
END SUBROUTINE timecmp
! spaceship operator for TimeIntervals
<A NAME='TIMEINTCMP'><A href='../../html_code/build/Meat.F90.html#TIMEINTCMP' TARGET='top_target'><IMG SRC="../../gif/bar_red.gif" border=0></A>
SUBROUTINE timeintcmp(timeint1, timeint2, retval ) 18,18
USE esmf_basemod
USE esmf_basetimemod
USE esmf_timeintervalmod
IMPLICIT NONE
INTEGER, INTENT(OUT) :: retval
!
! !ARGUMENTS:
TYPE(ESMF_TimeInterval), INTENT(IN) :: timeint1
TYPE(ESMF_TimeInterval), INTENT(IN) :: timeint2
CALL timeintchecknormalized( timeint1, 'timeintcmp arg1' )
CALL timeintchecknormalized( timeint2, 'timeintcmp arg2' )
CALL seccmp( timeint1%basetime%S, timeint1%basetime%Sn, &
timeint1%basetime%Sd, &
timeint2%basetime%S, timeint2%basetime%Sn, &
timeint2%basetime%Sd, retval )
END SUBROUTINE timeintcmp
! spaceship operator for seconds + Sn/Sd
<A NAME='SECCMP'><A href='../../html_code/build/Meat.F90.html#SECCMP' TARGET='top_target'><IMG SRC="../../gif/bar_red.gif" border=0></A>
SUBROUTINE seccmp(S1, Sn1, Sd1, S2, Sn2, Sd2, retval ) 24,6
USE esmf_basemod
IMPLICIT NONE
INTEGER, INTENT(OUT) :: retval
!
! !ARGUMENTS:
INTEGER(ESMF_KIND_I8), INTENT(IN) :: S1, Sn1, Sd1
INTEGER(ESMF_KIND_I8), INTENT(IN) :: S2, Sn2, Sd2
! local
INTEGER(ESMF_KIND_I8) :: lcd, n1, n2
n1 = Sn1
n2 = Sn2
if ( ( n1 .ne. 0 ) .or. ( n2 .ne. 0 ) ) then
CALL compute_lcd( Sd1, Sd2, lcd )
if ( Sd1 .ne. 0 ) n1 = n1 * ( lcd / Sd1 )
if ( Sd2 .ne. 0 ) n2 = n2 * ( lcd / Sd2 )
endif
if ( S1 .GT. S2 ) retval = 1
if ( S1 .LT. S2 ) retval = -1
IF ( S1 .EQ. S2 ) THEN
IF (n1 .GT. n2) retval = 1
IF (n1 .LT. n2) retval = -1
IF (n1 .EQ. n2) retval = 0
ENDIF
END SUBROUTINE seccmp
<A NAME='C_ESMC_BASETIMEEQ'><A href='../../html_code/build/Meat.F90.html#C_ESMC_BASETIMEEQ' TARGET='top_target'><IMG SRC="../../gif/bar_red.gif" border=0></A>
SUBROUTINE c_esmc_basetimeeq (time1, time2, outflag) 3,27
USE esmf_alarmmod
USE esmf_basemod
USE esmf_basetimemod
USE esmf_calendarmod
USE esmf_clockmod
USE esmf_fractionmod
USE esmf_timeintervalmod
USE esmf_timemod
IMPLICIT NONE
logical, intent(OUT) :: outflag
type(ESMF_Time), intent(in) :: time1
type(ESMF_Time), intent(in) :: time2
integer res
CALL timecmp(time1,time2,res)
outflag = (res .EQ. 0)
END SUBROUTINE c_esmc_basetimeeq
<A NAME='C_ESMC_BASETIMEGE'><A href='../../html_code/build/Meat.F90.html#C_ESMC_BASETIMEGE' TARGET='top_target'><IMG SRC="../../gif/bar_red.gif" border=0></A>
SUBROUTINE c_esmc_basetimege(time1, time2, outflag) 3,27
USE esmf_alarmmod
USE esmf_basemod
USE esmf_basetimemod
USE esmf_calendarmod
USE esmf_clockmod
USE esmf_fractionmod
USE esmf_timeintervalmod
USE esmf_timemod
logical, intent(OUT) :: outflag
type(ESMF_Time), intent(in) :: time1
type(ESMF_Time), intent(in) :: time2
integer res
CALL timecmp(time1,time2,res)
outflag = (res .EQ. 1 .OR. res .EQ. 0)
END SUBROUTINE c_esmc_basetimege
<A NAME='C_ESMC_BASETIMEGT'><A href='../../html_code/build/Meat.F90.html#C_ESMC_BASETIMEGT' TARGET='top_target'><IMG SRC="../../gif/bar_red.gif" border=0></A>
SUBROUTINE c_esmc_basetimegt(time1, time2, outflag) 3,27
USE esmf_alarmmod
USE esmf_basemod
USE esmf_basetimemod
USE esmf_calendarmod
USE esmf_clockmod
USE esmf_fractionmod
USE esmf_timeintervalmod
USE esmf_timemod
IMPLICIT NONE
logical, intent(OUT) :: outflag
type(ESMF_Time), intent(in) :: time1
type(ESMF_Time), intent(in) :: time2
integer res
CALL timecmp(time1,time2,res)
outflag = (res .EQ. 1)
END SUBROUTINE c_esmc_basetimegt
<A NAME='C_ESMC_BASETIMELE'><A href='../../html_code/build/Meat.F90.html#C_ESMC_BASETIMELE' TARGET='top_target'><IMG SRC="../../gif/bar_red.gif" border=0></A>
SUBROUTINE c_esmc_basetimele(time1, time2, outflag) 3,27
USE esmf_alarmmod
USE esmf_basemod
USE esmf_basetimemod
USE esmf_calendarmod
USE esmf_clockmod
USE esmf_fractionmod
USE esmf_timeintervalmod
USE esmf_timemod
IMPLICIT NONE
logical, intent(OUT) :: outflag
type(ESMF_Time), intent(in) :: time1
type(ESMF_Time), intent(in) :: time2
integer res
CALL timecmp(time1,time2,res)
outflag = (res .EQ. -1 .OR. res .EQ. 0)
END SUBROUTINE c_esmc_basetimele
<A NAME='C_ESMC_BASETIMELT'><A href='../../html_code/build/Meat.F90.html#C_ESMC_BASETIMELT' TARGET='top_target'><IMG SRC="../../gif/bar_red.gif" border=0></A>
SUBROUTINE c_esmc_basetimelt(time1, time2, outflag) 3,27
USE esmf_alarmmod
USE esmf_basemod
USE esmf_basetimemod
USE esmf_calendarmod
USE esmf_clockmod
USE esmf_fractionmod
USE esmf_timeintervalmod
USE esmf_timemod
IMPLICIT NONE
logical, intent(OUT) :: outflag
type(ESMF_Time), intent(in) :: time1
type(ESMF_Time), intent(in) :: time2
integer res
CALL timecmp(time1,time2,res)
outflag = (res .EQ. -1)
END SUBROUTINE c_esmc_basetimelt
<A NAME='C_ESMC_BASETIMENE'><A href='../../html_code/build/Meat.F90.html#C_ESMC_BASETIMENE' TARGET='top_target'><IMG SRC="../../gif/bar_red.gif" border=0></A>
SUBROUTINE c_esmc_basetimene(time1, time2, outflag) 3,27
USE esmf_alarmmod
USE esmf_basemod
USE esmf_basetimemod
USE esmf_calendarmod
USE esmf_clockmod
USE esmf_fractionmod
USE esmf_timeintervalmod
USE esmf_timemod
IMPLICIT NONE
logical, intent(OUT) :: outflag
type(ESMF_Time), intent(in) :: time1
type(ESMF_Time), intent(in) :: time2
integer res
CALL timecmp(time1,time2,res)
outflag = (res .NE. 0)
END SUBROUTINE c_esmc_basetimene
<A NAME='C_ESMC_BASETIMEINTEQ'><A href='../../html_code/build/Meat.F90.html#C_ESMC_BASETIMEINTEQ' TARGET='top_target'><IMG SRC="../../gif/bar_red.gif" border=0></A>
SUBROUTINE c_esmc_basetimeinteq(timeint1, timeint2, outflag) 3,6
USE esmf_timeintervalmod
IMPLICIT NONE
LOGICAL, INTENT(OUT) :: outflag
TYPE(ESMF_TimeInterval), INTENT(IN) :: timeint1
TYPE(ESMF_TimeInterval), INTENT(IN) :: timeint2
INTEGER :: res
CALL timeintcmp(timeint1,timeint2,res)
outflag = (res .EQ. 0)
END SUBROUTINE c_esmc_basetimeinteq
<A NAME='C_ESMC_BASETIMEINTNE'><A href='../../html_code/build/Meat.F90.html#C_ESMC_BASETIMEINTNE' TARGET='top_target'><IMG SRC="../../gif/bar_red.gif" border=0></A>
SUBROUTINE c_esmc_basetimeintne(timeint1, timeint2, outflag) 3,6
USE esmf_timeintervalmod
IMPLICIT NONE
LOGICAL, INTENT(OUT) :: outflag
TYPE(ESMF_TimeInterval), INTENT(IN) :: timeint1
TYPE(ESMF_TimeInterval), INTENT(IN) :: timeint2
INTEGER :: res
CALL timeintcmp(timeint1,timeint2,res)
outflag = (res .NE. 0)
END SUBROUTINE c_esmc_basetimeintne
<A NAME='C_ESMC_BASETIMEINTLT'><A href='../../html_code/build/Meat.F90.html#C_ESMC_BASETIMEINTLT' TARGET='top_target'><IMG SRC="../../gif/bar_red.gif" border=0></A>
SUBROUTINE c_esmc_basetimeintlt(timeint1, timeint2, outflag) 3,6
USE esmf_timeintervalmod
IMPLICIT NONE
LOGICAL, INTENT(OUT) :: outflag
TYPE(ESMF_TimeInterval), INTENT(IN) :: timeint1
TYPE(ESMF_TimeInterval), INTENT(IN) :: timeint2
INTEGER :: res
CALL timeintcmp(timeint1,timeint2,res)
outflag = (res .LT. 0)
END SUBROUTINE c_esmc_basetimeintlt
<A NAME='C_ESMC_BASETIMEINTGT'><A href='../../html_code/build/Meat.F90.html#C_ESMC_BASETIMEINTGT' TARGET='top_target'><IMG SRC="../../gif/bar_red.gif" border=0></A>
SUBROUTINE c_esmc_basetimeintgt(timeint1, timeint2, outflag) 3,6
USE esmf_timeintervalmod
IMPLICIT NONE
LOGICAL, INTENT(OUT) :: outflag
TYPE(ESMF_TimeInterval), INTENT(IN) :: timeint1
TYPE(ESMF_TimeInterval), INTENT(IN) :: timeint2
INTEGER :: res
CALL timeintcmp(timeint1,timeint2,res)
outflag = (res .GT. 0)
END SUBROUTINE c_esmc_basetimeintgt
<A NAME='C_ESMC_BASETIMEINTLE'><A href='../../html_code/build/Meat.F90.html#C_ESMC_BASETIMEINTLE' TARGET='top_target'><IMG SRC="../../gif/bar_red.gif" border=0></A>
SUBROUTINE c_esmc_basetimeintle(timeint1, timeint2, outflag) 3,6
USE esmf_timeintervalmod
IMPLICIT NONE
LOGICAL, INTENT(OUT) :: outflag
TYPE(ESMF_TimeInterval), INTENT(IN) :: timeint1
TYPE(ESMF_TimeInterval), INTENT(IN) :: timeint2
INTEGER :: res
CALL timeintcmp(timeint1,timeint2,res)
outflag = (res .LE. 0)
END SUBROUTINE c_esmc_basetimeintle
<A NAME='C_ESMC_BASETIMEINTGE'><A href='../../html_code/build/Meat.F90.html#C_ESMC_BASETIMEINTGE' TARGET='top_target'><IMG SRC="../../gif/bar_red.gif" border=0></A>
SUBROUTINE c_esmc_basetimeintge(timeint1, timeint2, outflag) 3,6
USE esmf_timeintervalmod
IMPLICIT NONE
LOGICAL, INTENT(OUT) :: outflag
TYPE(ESMF_TimeInterval), INTENT(IN) :: timeint1
TYPE(ESMF_TimeInterval), INTENT(IN) :: timeint2
INTEGER :: res
CALL timeintcmp(timeint1,timeint2,res)
outflag = (res .GE. 0)
END SUBROUTINE c_esmc_basetimeintge
<A NAME='COMPUTE_LCD'><A href='../../html_code/build/Meat.F90.html#COMPUTE_LCD' TARGET='top_target'><IMG SRC="../../gif/bar_red.gif" border=0></A>
SUBROUTINE compute_lcd( e1, e2, lcd ) 6,3
USE esmf_basemod
IMPLICIT NONE
INTEGER(ESMF_KIND_I8), INTENT(IN) :: e1, e2
INTEGER(ESMF_KIND_I8), INTENT(OUT) :: lcd
INTEGER, PARAMETER :: nprimes = 9
INTEGER(ESMF_KIND_I8), DIMENSION(nprimes), PARAMETER :: primes = (/2,3,5,7,11,13,17,19,23/)
INTEGER i
INTEGER(ESMF_KIND_I8) d1, d2, p
d1 = e1 ; d2 = e2
IF ( d1 .EQ. 0 .AND. d2 .EQ. 0 ) THEN ; lcd = 1 ; RETURN ; ENDIF
IF ( d1 .EQ. 0 ) d1 = d2
IF ( d2 .EQ. 0 ) d2 = d1
IF ( d1 .EQ. d2 ) THEN ; lcd = d1 ; RETURN ; ENDIF
lcd = d1 * d2
DO i = 1, nprimes
p = primes(i)
DO WHILE (lcd/p .NE. 0 .AND. &
mod(lcd/p,d1) .EQ. 0 .AND. mod(lcd/p,d2) .EQ. 0)
lcd = lcd / p
END DO
ENDDO
END SUBROUTINE compute_lcd
<A NAME='SIMPLIFY'><A href='../../html_code/build/Meat.F90.html#SIMPLIFY' TARGET='top_target'><IMG SRC="../../gif/bar_red.gif" border=0></A>
SUBROUTINE simplify( ni, di, no, do ) 3,3
USE esmf_basemod
IMPLICIT NONE
INTEGER(ESMF_KIND_I8), INTENT(IN) :: ni, di
INTEGER(ESMF_KIND_I8), INTENT(OUT) :: no, do
INTEGER, PARAMETER :: nprimes = 9
INTEGER(ESMF_KIND_I8), DIMENSION(nprimes), PARAMETER :: primes = (/2,3,5,7,11,13,17,19,23/)
INTEGER(ESMF_KIND_I8) :: pr, d, n
INTEGER :: np
LOGICAL keepgoing
IF ( ni .EQ. 0 ) THEN
do = 1
no = 0
RETURN
ENDIF
IF ( mod( di , ni ) .EQ. 0 ) THEN
do = di / ni
no = 1
RETURN
ENDIF
d = di
n = ni
DO np = 1, nprimes
pr = primes(np)
keepgoing = .TRUE.
DO WHILE ( keepgoing )
keepgoing = .FALSE.
IF ( d/pr .NE. 0 .AND. n/pr .NE. 0 .AND. MOD(d,pr) .EQ. 0 .AND. MOD(n,pr) .EQ. 0 ) THEN
d = d / pr
n = n / pr
keepgoing = .TRUE.
ENDIF
ENDDO
ENDDO
do = d
no = n
RETURN
END SUBROUTINE simplify
!$$$ this should be named "c_esmc_timesum" or something less misleading
<A NAME='C_ESMC_BASETIMESUM'><A href='../../html_code/build/Meat.F90.html#C_ESMC_BASETIMESUM' TARGET='top_target'><IMG SRC="../../gif/bar_red.gif" border=0></A>
SUBROUTINE c_esmc_basetimesum( time1, timeinterval, timeOut ) 3,19
USE esmf_basemod
USE esmf_basetimemod
USE esmf_timeintervalmod
USE esmf_timemod
IMPLICIT NONE
TYPE(ESMF_Time), INTENT(IN) :: time1
TYPE(ESMF_TimeInterval), INTENT(IN) :: timeinterval
TYPE(ESMF_Time), INTENT(INOUT) :: timeOut
! locals
INTEGER :: m
timeOut = time1
timeOut%basetime = timeOut%basetime + timeinterval%basetime
#if 0
!jm Month has no meaning for a timeinterval; removed 20100319
#if defined PLANET
! Do nothing...
#else
DO m = 1, abs(timeinterval%MM)
IF ( timeinterval%MM > 0 ) THEN
CALL timeincmonth( timeOut )
ELSE
CALL timedecmonth( timeOut )
ENDIF
ENDDO
#endif
#endif
timeOut%YR = timeOut%YR + timeinterval%YR
CALL normalize_time( timeOut )
END SUBROUTINE c_esmc_basetimesum
!$$$ this should be named "c_esmc_timedec" or something less misleading
<A NAME='C_ESMC_BASETIMEDEC'><A href='../../html_code/build/Meat.F90.html#C_ESMC_BASETIMEDEC' TARGET='top_target'><IMG SRC="../../gif/bar_red.gif" border=0></A>
SUBROUTINE c_esmc_basetimedec( time1, timeinterval, timeOut ) 3,12
USE esmf_basemod
USE esmf_basetimemod
USE esmf_timeintervalmod
USE esmf_timemod
IMPLICIT NONE
TYPE(ESMF_Time), INTENT(IN) :: time1
TYPE(ESMF_TimeInterval), INTENT(IN) :: timeinterval
TYPE(ESMF_Time), INTENT(OUT) :: timeOut
! locals
TYPE (ESMF_TimeInterval) :: neginterval
neginterval = timeinterval
!$$$push this down into a unary negation operator on TimeInterval
neginterval%basetime%S = -neginterval%basetime%S
neginterval%basetime%Sn = -neginterval%basetime%Sn
neginterval%YR = -neginterval%YR
#if 0
!jm month has no meaning for an interval; removed 20100319
#ifndef PLANET
neginterval%MM = -neginterval%MM
#endif
#endif
timeOut = time1 + neginterval
END SUBROUTINE c_esmc_basetimedec
!$$$ this should be named "c_esmc_timediff" or something less misleading
<A NAME='C_ESMC_BASETIMEDIFF'><A href='../../html_code/build/Meat.F90.html#C_ESMC_BASETIMEDIFF' TARGET='top_target'><IMG SRC="../../gif/bar_red.gif" border=0></A>
SUBROUTINE c_esmc_basetimediff( time1, time2, timeIntOut ) 3,18
USE esmf_basemod
USE esmf_basetimemod
USE esmf_timeintervalmod
USE esmf_timemod
IMPLICIT NONE
TYPE(ESMF_Time), INTENT(IN) :: time1
TYPE(ESMF_Time), INTENT(IN) :: time2
TYPE(ESMF_TimeInterval), INTENT(OUT) :: timeIntOut
! locals
INTEGER(ESMF_KIND_I8) :: nsecondsinyear
INTEGER :: yr
CALL ESMF_TimeIntervalSet( timeIntOut )
timeIntOut%basetime = time1%basetime - time2%basetime
! convert difference in years to basetime...
IF ( time1%YR > time2%YR ) THEN
DO yr = time2%YR, ( time1%YR - 1 )
timeIntOut%basetime%S = timeIntOut%basetime%S + nsecondsinyear( yr )
ENDDO
ELSE IF ( time2%YR > time1%YR ) THEN
DO yr = time1%YR, ( time2%YR - 1 )
timeIntOut%basetime%S = timeIntOut%basetime%S - nsecondsinyear( yr )
ENDDO
ENDIF
!$$$ add tests for multi-year differences
CALL normalize_timeint( timeIntOut )
END SUBROUTINE c_esmc_basetimediff
! some extra wrf stuff
! Convert fraction to string with leading sign.
! If fraction simplifies to a whole number or if
! denominator is zero, return empty string.
! INTEGER*8 interface.
<A NAME='FRACTION_TO_STRINGI8'><A href='../../html_code/build/Meat.F90.html#FRACTION_TO_STRINGI8' TARGET='top_target'><IMG SRC="../../gif/bar_red.gif" border=0></A>
SUBROUTINE fraction_to_stringi8( numerator, denominator, frac_str ) 3,3
USE ESMF_basemod
IMPLICIT NONE
INTEGER(ESMF_KIND_I8), INTENT(IN) :: numerator
INTEGER(ESMF_KIND_I8), INTENT(IN) :: denominator
CHARACTER (LEN=*), INTENT(OUT) :: frac_str
IF ( denominator > 0 ) THEN
IF ( mod( numerator, denominator ) /= 0 ) THEN
IF ( numerator > 0 ) THEN
WRITE(frac_str,FMT="('+',I2.2,'/',I2.2)") abs(numerator), denominator
ELSE ! numerator < 0
WRITE(frac_str,FMT="('-',I2.2,'/',I2.2)") abs(numerator), denominator
ENDIF
ELSE ! includes numerator == 0 case
frac_str = ''
ENDIF
ELSE ! no-fraction case
frac_str = ''
ENDIF
END SUBROUTINE fraction_to_stringi8
! Convert fraction to string with leading sign.
! If fraction simplifies to a whole number or if
! denominator is zero, return empty string.
! INTEGER interface.
<A NAME='FRACTION_TO_STRING'><A href='../../html_code/build/Meat.F90.html#FRACTION_TO_STRING' TARGET='top_target'><IMG SRC="../../gif/bar_red.gif" border=0></A>
SUBROUTINE fraction_to_string( numerator, denominator, frac_str ) 34,6
USE ESMF_basemod
IMPLICIT NONE
INTEGER, INTENT(IN) :: numerator
INTEGER, INTENT(IN) :: denominator
CHARACTER (LEN=*), INTENT(OUT) :: frac_str
! locals
INTEGER(ESMF_KIND_I8) :: numerator_i8, denominator_i8
numerator_i8 = INT( numerator, ESMF_KIND_I8 )
denominator_i8 = INT( denominator, ESMF_KIND_I8 )
CALL fraction_to_stringi8( numerator_i8, denominator_i8, frac_str )
END SUBROUTINE fraction_to_string
<A NAME='PRINT_A_TIME'><A href='../../html_code/build/Meat.F90.html#PRINT_A_TIME' TARGET='top_target'><IMG SRC="../../gif/bar_red.gif" border=0></A>
SUBROUTINE print_a_time( time ),9
use ESMF_basemod
use ESMF_Timemod
IMPLICIT NONE
type(ESMF_Time) time
character*128 :: s
integer rc
CALL ESMF_TimeGet( time, timeString=s, rc=rc )
print *,'Print a time|',TRIM(s),'|'
return
END SUBROUTINE print_a_time
<A NAME='PRINT_A_TIMEINTERVAL'><A href='../../html_code/build/Meat.F90.html#PRINT_A_TIMEINTERVAL' TARGET='top_target'><IMG SRC="../../gif/bar_red.gif" border=0></A>
SUBROUTINE print_a_timeinterval( time ),9
use ESMF_basemod
use ESMF_TimeIntervalmod
IMPLICIT NONE
type(ESMF_TimeInterval) time
character*128 :: s
integer rc
CALL ESMFold_TimeIntervalGetString( time, s, rc )
print *,'Print a time interval|',TRIM(s),'|'
return
END SUBROUTINE print_a_timeinterval