! $Id$ ! ! Earth System Modeling Framework ! Copyright 2002-2003, University Corporation for Atmospheric Research, ! Massachusetts Institute of Technology, Geophysical Fluid Dynamics ! Laboratory, University of Michigan, National Centers for Environmental ! Prediction, Los Alamos National Laboratory, Argonne National Laboratory, ! NASA Goddard Space Flight Center. ! Licensed under the GPL. ! !============================================================================== ! ! ESMF Calendar Module module ESMF_CalendarMod ! !============================================================================== ! ! This file contains the Calendar class definition and all Calendar class ! methods. ! !------------------------------------------------------------------------------ ! INCLUDES #include <ESMF_TimeMgr.inc> !============================================================================== !BOPI ! !MODULE: ESMF_CalendarMod ! ! !DESCRIPTION: ! Part of Time Manager F90 API wrapper of C++ implemenation ! ! Defines F90 wrapper entry points for corresponding ! C++ class { \tt ESMC\_Calendar} implementation ! ! See {\tt ../include/ESMC\_Calendar.h} for complete description ! !------------------------------------------------------------------------------ ! !USES: ! inherit from ESMF base class use ESMF_BaseMod ! inherit from base time class use ESMF_BaseTimeMod implicit none ! !------------------------------------------------------------------------------ ! !PRIVATE TYPES: private !------------------------------------------------------------------------------ INTEGER, PARAMETER :: mday(MONTHS_PER_YEAR) & = (/31,28,31,30,31,30,31,31,30,31,30,31/) INTEGER, PARAMETER :: mdayleap(MONTHS_PER_YEAR) & = (/31,29,31,30,31,30,31,31,30,31,30,31/) INTEGER, DIMENSION(365) :: daym INTEGER, DIMENSION(366) :: daymleap INTEGER :: mdaycum(0:MONTHS_PER_YEAR) INTEGER :: mdayleapcum(0:MONTHS_PER_YEAR) TYPE(ESMF_BaseTime), TARGET :: monthbdys(0:MONTHS_PER_YEAR) TYPE(ESMF_BaseTime), TARGET :: monthbdysleap(0:MONTHS_PER_YEAR) TYPE(ESMF_BaseTime), TARGET :: monthedys(0:MONTHS_PER_YEAR) TYPE(ESMF_BaseTime), TARGET :: monthedysleap(0:MONTHS_PER_YEAR) !------------------------------------------------------------------------------ ! ! ESMF_CalKind_Flag ! ! ! F90 "enum" type to match C++ ESMC_CalKind_Flag enum type ESMF_CalKind_Flag integer :: caltype end type type(ESMF_CalKind_Flag), parameter :: & ESMF_CALKIND_GREGORIAN = ESMF_CalKind_Flag(1), & ESMF_CALKIND_NOLEAP = ESMF_CalKind_Flag(2) ! type(ESMF_CalKind_Flag), parameter :: & ! ESMF_CALKIND_GREGORIAN = ESMF_CalKind_Flag(1), & ! ESMF_CALKIND_JULIAN = ESMF_CalKind_Flag(2), & ! ! like Gregorian, except Feb always has 28 days ! ESMF_CALKIND_NOLEAP = ESMF_CalKind_Flag(3), & ! ! 12 months, 30 days each ! ESMF_CALKIND_360DAY = ESMF_CalKind_Flag(4), & ! ! user defined ! ESMF_CALKIND_GENERIC = ESMF_CalKind_Flag(5), & ! ! track base time seconds only ! ESMF_CALKIND_NOCALENDAR = ESMF_CalKind_Flag(6) !------------------------------------------------------------------------------ ! ! ESMF_Calendar ! ! ! F90 class type to match C++ Calendar class in size only; ! ! all dereferencing within class is performed by C++ implementation ! !------------------------------------------------------------------------------ ! ! ! ESMF_DaysPerYear ! type ESMF_DaysPerYear integer :: D = 0 ! whole days per year integer :: Dn = 0 ! fractional days per year numerator integer :: Dd = 1 ! fractional days per year denominator end type ! e.g. for Venus, D=0, Dn=926, Dd=1000 ! !------------------------------------------------------------------------------ ! ! ESMF_Calendar ! ! type ESMF_Calendar type(ESMF_CalKind_Flag) :: Type logical :: Set = .false. integer, dimension(MONTHS_PER_YEAR) :: DaysPerMonth = 0 integer :: SecondsPerDay = 0 integer :: SecondsPerYear = 0 type(ESMF_DaysPerYear) :: DaysPerYear end type !------------------------------------------------------------------------------ ! !PUBLIC DATA: added by Juanxiong He, in order to breakthe cycle call between ! ESMF_Stubs and ESMF_Time TYPE(ESMF_Calendar), public, save, pointer :: defaultCal ! Default Calendar TYPE(ESMF_Calendar), public, save, pointer :: gregorianCal ! gregorian Calendar TYPE(ESMF_Calendar), public, save, pointer :: noleapCal ! noleap Calendar ! !------------------------------------------------------------------------------ ! !PUBLIC TYPES: public initdaym ! public mday ! public mdayleap ! public monthbdys ! public monthbdysleap ! public monthedys ! public monthedysleap ! public daym ! public daymleap ! public mdaycum ! public mdayleapcum public ndaysinmonth public nsecondsinmonth public ndaysinyear public nsecondsinyear public nmonthinyearsec public ndayinyearsec public nsecondsinyearmonth public isleap public ESMF_CalKind_Flag public ESMF_CALKIND_GREGORIAN, ESMF_CALKIND_NOLEAP ! ESMF_CALKIND_360DAY, ESMF_CALKIND_NOCALENDAR ! public ESMF_CAL_JULIAN ! public ESMF_CAL_GENERIC public ESMF_Calendar public ESMF_DaysPerYear !------------------------------------------------------------------------------ ! ! !PUBLIC MEMBER FUNCTIONS: public ESMF_CalendarCreate ! Required inherited and overridden ESMF_Base class methods public ESMF_CalendarInitialized ! Only in this implementation, intended ! to be private within ESMF methods !EOPI !------------------------------------------------------------------------------ ! The following line turns the CVS identifier string into a printable variable. character(*), parameter, private :: version = & '$Id$' !============================================================================== contains !============================================================================== !BOP ! !IROUTINE: ESMF_CalendarCreate - Create a new ESMF Calendar of built-in type ! !INTERFACE: ! Private name; call using ESMF_CalendarCreate() function ESMF_CalendarCreate(name, calkindflag, rc) ! !RETURN VALUE: type(ESMF_Calendar) :: ESMF_CalendarCreate ! !ARGUMENTS: character (len=*), intent(in), optional :: name type(ESMF_CalKind_Flag), intent(in) :: calkindflag integer, intent(out), optional :: rc ! !DESCRIPTION: ! Creates and sets a {\tt calendar} to the given built-in ! {\tt ESMF\_CalKind_Flag}. ! ! This is a private method; invoke via the public overloaded entry point ! {\tt ESMF\_CalendarCreate()}. ! ! The arguments are: ! \begin{description} ! \item[{[name]}] ! The name for the newly created calendar. If not specified, a ! default unique name will be generated: "CalendarNNN" where NNN ! is a unique sequence number from 001 to 999. ! \item[calkindflag] ! The built-in {\tt ESMF\_CalKind_Flag}. Valid values are: ! {\tt ESMF\_CAL\_360DAY}, {\tt ESMF\_CAL\_GREGORIAN}, ! {\tt ESMF\_CAL\_JULIANDAY}, {\tt ESMF\_CAL\_NOCALENDAR}, and ! {\tt ESMF\_CAL\_NOLEAP}. ! See the "Time Manager Reference" document for a description of ! each calendar type. ! \item[{[rc]}] ! Return code; equals {\tt ESMF\_SUCCESS} if there are no errors. ! \end{description} ! !EOP ! !REQUIREMENTS: ! TMGn.n.n type(ESMF_DaysPerYear) :: dayspy if ( present(rc) ) rc = ESMF_FAILURE ! Calendar is hard-coded. Use ESMF library if more flexibility is needed. ! write(6,*) 'tcx ESMF_CalendarCreate ',calkindflag%caltype, ESMF_CALKIND_NOLEAP%caltype, ESMF_CALKIND_GREGORIAN%caltype if ( calkindflag%caltype == ESMF_CALKIND_NOLEAP%caltype ) then ! write(6,*) 'tcx ESMF_CalendarCreate: initialize noleap calendar ' ESMF_CalendarCreate%Type = ESMF_CALKIND_NOLEAP elseif ( calkindflag%caltype == ESMF_CALKIND_GREGORIAN%caltype ) then ! write(6,*) 'tcx ESMF_CalendarCreate: initialize gregorian calendar ' ESMF_CalendarCreate%Type = ESMF_CALKIND_GREGORIAN else ! write(6,*) 'tcx ESMF_CalendarCreate: ERROR initialize invalid calendar' call wrf_error_fatal( "Error:: ESMF_CalendarCreate invalid calendar") endif !$$$ This is a bug on some systems -- need initial value set by compiler at !$$$ startup. ESMF_CalendarCreate%Set = .true. ESMF_CalendarCreate%SecondsPerDay = SECONDS_PER_DAY ! DaysPerYear and SecondsPerYear are incorrect for Gregorian calendars... dayspy%D = size(daym) dayspy%Dn = 0 dayspy%Dd = 1 ESMF_CalendarCreate%DaysPerYear = dayspy ESMF_CalendarCreate%SecondsPerYear = ESMF_CalendarCreate%SecondsPerDay & * dayspy%D ESMF_CalendarCreate%DaysPerMonth(:) = mday(:) if ( present(rc) ) rc = ESMF_SUCCESS end function ESMF_CalendarCreate !============================================================================== !BOP ! !IROUTINE: ESMF_CalendarInitialized - check if calendar was created ! !INTERFACE: function ESMF_CalendarInitialized(calendar) ! !RETURN VALUE: logical ESMF_CalendarInitialized ! !ARGUMENTS: type(ESMF_Calendar), intent(in) :: calendar ! !DESCRIPTION: !EOP ! !REQUIREMENTS: ! TMGn.n.n ESMF_CalendarInitialized = calendar%set if ( calendar%SecondsPerDay == 0 ) & ESMF_CalendarInitialized = .false. end function ESMF_CalendarInitialized !============================================================================== SUBROUTINE initdaym 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 ! End of month seconds, day before the beginning of next month DO i = 0,MONTHS_PER_YEAR j = i + 1 if ( i == MONTHS_PER_YEAR ) j = 0 monthedys(i) = monthbdys(j) monthedys(i)%S = monthedys(i)%S - SECONDS_PER_DAY 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 of month seconds, day before the beginning of next month DO i = 0,MONTHS_PER_YEAR j = i + 1 if ( i == MONTHS_PER_YEAR ) j = 0 monthedysleap(i) = monthbdysleap(j) monthedysleap(i)%S = monthedysleap(i)%S - SECONDS_PER_DAY ENDDO END SUBROUTINE initdaym !============================================================================== integer(esmf_kind_i8) FUNCTION nsecondsinyear ( year, calkindflag ) ! Compute the number of seconds in the given year IMPLICIT NONE INTEGER, INTENT(IN) :: year type(ESMF_CalKind_Flag),intent(in) :: calkindflag nsecondsinyear = SECONDS_PER_DAY * INT( ndaysinyear(year, calkindflag) , ESMF_KIND_I8 ) END FUNCTION nsecondsinyear !============================================================================== integer function ndaysinmonth( year,month,calkindflag) ! Compute number of days in month for year, month, cal IMPLICIT NONE INTEGER, INTENT(in) :: year,month type(ESMF_CalKind_Flag),intent(in) :: calkindflag ! locals IF ( ( MONTH < 1 ) .OR. ( MONTH > MONTHS_PER_YEAR ) ) THEN CALL wrf_error_fatal( 'ERROR ndaysinmonth: MONTH out of range' ) ENDIF IF ( isleap(year,calkindflag) ) THEN ndaysinmonth = mdayleap(month) ELSE ndaysinmonth = mday(month) ENDIF END function ndaysinmonth !============================================================================== integer(esmf_kind_i8) function nsecondsinmonth( year,month,calkindflag) ! Compute number of days in month for year, month, cal IMPLICIT NONE INTEGER, INTENT(in) :: year,month type(ESMF_CalKind_Flag),intent(in) :: calkindflag ! locals nsecondsinmonth = ndaysinmonth(year,month,calkindflag)*SECONDS_PER_DAY END function nsecondsinmonth !============================================================================== integer function nmonthinyearsec(year,basetime,calkindflag) ! Compute month for year, basetime, cal IMPLICIT NONE INTEGER, INTENT(in) :: year type(ESMF_BaseTime), intent(in) :: basetime type(ESMF_CalKind_Flag),intent(in) :: calkindflag ! locals TYPE(ESMF_BaseTime), pointer :: MMbdys(:) integer :: mm,i IF ( isleap(year,calkindflag) ) THEN MMbdys => monthbdysleap ELSE MMbdys => monthbdys ENDIF MM = -1 DO i = 1,MONTHS_PER_YEAR IF ( ( basetime >= MMbdys(i-1) ) .AND. ( basetime < MMbdys(i) ) ) THEN MM = i EXIT ENDIF ENDDO IF ( MM == -1 ) THEN CALL wrf_error_fatal( 'nmonthinyearsec: could not extract month of year from time' ) ENDIF nmonthinyearsec = mm END function nmonthinyearsec !============================================================================== integer function ndayinyearsec(year, basetime, calkindflag) ! Compute day of year for year, basetime, cal IMPLICIT NONE INTEGER, INTENT(in) :: year type(ESMF_BaseTime), intent(in) :: basetime type(ESMF_CalKind_Flag),intent(in) :: calkindflag ! locals TYPE(ESMF_BaseTime), pointer :: MMbdys(:) TYPE(ESMF_BaseTime) :: tmpbasetime integer :: mm mm = nmonthinyearsec(year, basetime, calkindflag) IF ( isleap(year,calkindflag) ) THEN MMbdys => monthbdysleap ELSE MMbdys => monthbdys ENDIF tmpbasetime = basetime - MMbdys(mm-1) ndayinyearsec = ( tmpbasetime%S / SECONDS_PER_DAY ) + 1 end function ndayinyearsec !============================================================================== integer(esmf_kind_i8) function nsecondsinyearmonth(year, month, calkindflag) ! Compute number of seconds from start of year for year, month, cal IMPLICIT NONE INTEGER, INTENT(in) :: year INTEGER, INTENT(in) :: month type(ESMF_CalKind_Flag),intent(in) :: calkindflag ! locals TYPE(ESMF_BaseTime), pointer :: MMbdys(:) IF ( ( MONTH < 1 ) .OR. ( MONTH > MONTHS_PER_YEAR ) ) THEN CALL wrf_error_fatal( 'ERROR nsecondsinyearmonth(): MONTH out of range' ) ENDIF IF ( isleap(year, calkindflag) ) THEN MMbdys => monthbdysleap ELSE MMbdys => monthbdys ENDIF nsecondsinyearmonth = MMbdys(month-1)%s end function nsecondsinyearmonth !============================================================================== integer FUNCTION ndaysinyear ( year,calkindflag ) ! Compute the number of days in the given year IMPLICIT NONE INTEGER, INTENT(IN) :: year type(ESMF_CalKind_Flag),intent(in) :: calkindflag IF ( isleap( year,calkindflag ) ) THEN ndaysinyear = 366 ELSE ndaysinyear = 365 ENDIF END FUNCTION ndaysinyear !============================================================================== logical FUNCTION isleap ( year, calkindflag ) ! Compute the number of days in February for the given year IMPLICIT NONE INTEGER,intent(in) :: year type(ESMF_CalKind_Flag) :: calkindflag ! local INTEGER :: lyear lyear = abs(year) ! make sure it handles negative years isleap = .false. ! By default, February has 28 days ... if (calkindflag%caltype == ESMF_CALKIND_GREGORIAN%caltype) then IF (MOD(lyear,4).eq.0) THEN isleap = .true. ! But every four years, it has 29 days ... IF (MOD(lyear,100).eq.0) THEN isleap = .false. ! Except every 100 years, when it has 28 days ... IF (MOD(lyear,400).eq.0) THEN isleap = .true. ! Except every 400 years, when it has 29 days. END IF END IF END IF endif END FUNCTION isleap !============================================================================== end module ESMF_CalendarMod