1 | ! |
---|
2 | ! Earth System Modeling Framework |
---|
3 | ! Copyright 2002-2003, University Corporation for Atmospheric Research, |
---|
4 | ! Massachusetts Institute of Technology, Geophysical Fluid Dynamics |
---|
5 | ! Laboratory, University of Michigan, National Centers for Environmental |
---|
6 | ! Prediction, Los Alamos National Laboratory, Argonne National Laboratory, |
---|
7 | ! NASA Goddard Space Flight Center. |
---|
8 | ! Licensed under the University of Illinois-NCSA license. |
---|
9 | ! |
---|
10 | !============================================================================== |
---|
11 | ! |
---|
12 | ! ESMF Calendar Module |
---|
13 | module ESMF_CalendarMod |
---|
14 | ! |
---|
15 | !============================================================================== |
---|
16 | ! |
---|
17 | ! This file contains the Calendar class definition and all Calendar class |
---|
18 | ! methods. |
---|
19 | ! |
---|
20 | !------------------------------------------------------------------------------ |
---|
21 | ! INCLUDES |
---|
22 | #include <ESMF_TimeMgr.inc> |
---|
23 | |
---|
24 | !============================================================================== |
---|
25 | !BOPI |
---|
26 | ! !MODULE: ESMF_CalendarMod |
---|
27 | ! |
---|
28 | ! !DESCRIPTION: |
---|
29 | ! Part of Time Manager F90 API wrapper of C++ implemenation |
---|
30 | ! |
---|
31 | ! Defines F90 wrapper entry points for corresponding |
---|
32 | ! C++ class { \tt ESMC\_Calendar} implementation |
---|
33 | ! |
---|
34 | ! See {\tt ../include/ESMC\_Calendar.h} for complete description |
---|
35 | ! |
---|
36 | !------------------------------------------------------------------------------ |
---|
37 | ! !USES: |
---|
38 | ! inherit from ESMF base class |
---|
39 | use ESMF_BaseMod |
---|
40 | |
---|
41 | ! inherit from base time class |
---|
42 | use ESMF_BaseTimeMod |
---|
43 | |
---|
44 | implicit none |
---|
45 | ! |
---|
46 | !------------------------------------------------------------------------------ |
---|
47 | ! !PRIVATE TYPES: |
---|
48 | private |
---|
49 | !------------------------------------------------------------------------------ |
---|
50 | |
---|
51 | |
---|
52 | |
---|
53 | INTEGER, PARAMETER :: MONTHS_PER_YEAR = 12 |
---|
54 | INTEGER, PARAMETER :: mday(MONTHS_PER_YEAR) & |
---|
55 | = (/31,28,31,30,31,30,31,31,30,31,30,31/) |
---|
56 | INTEGER, PARAMETER :: mdayleap(MONTHS_PER_YEAR) & |
---|
57 | = (/31,29,31,30,31,30,31,31,30,31,30,31/) |
---|
58 | INTEGER, DIMENSION(365) :: daym |
---|
59 | INTEGER, DIMENSION(366) :: daymleap |
---|
60 | INTEGER :: mdaycum(0:MONTHS_PER_YEAR) |
---|
61 | INTEGER :: mdayleapcum(0:MONTHS_PER_YEAR) |
---|
62 | TYPE(ESMF_BaseTime), TARGET :: monthbdys(0:MONTHS_PER_YEAR) |
---|
63 | TYPE(ESMF_BaseTime), TARGET :: monthbdysleap(0:MONTHS_PER_YEAR) |
---|
64 | |
---|
65 | |
---|
66 | !------------------------------------------------------------------------------ |
---|
67 | ! ! ESMF_CalendarType |
---|
68 | ! |
---|
69 | ! ! F90 "enum" type to match C++ ESMC_CalendarType enum |
---|
70 | |
---|
71 | type ESMF_CalendarType |
---|
72 | private |
---|
73 | integer :: caltype |
---|
74 | end type |
---|
75 | |
---|
76 | type(ESMF_CalendarType), parameter :: & |
---|
77 | ESMF_CAL_GREGORIAN = ESMF_CalendarType(1), & |
---|
78 | ESMF_CAL_JULIAN = ESMF_CalendarType(2), & |
---|
79 | ! like Gregorian, except Feb always has 28 days |
---|
80 | ESMF_CAL_NOLEAP = ESMF_CalendarType(3), & |
---|
81 | ! 12 months, 30 days each |
---|
82 | ESMF_CAL_360DAY = ESMF_CalendarType(4), & |
---|
83 | ! user defined |
---|
84 | ESMF_CAL_GENERIC = ESMF_CalendarType(5), & |
---|
85 | ! track base time seconds only |
---|
86 | ESMF_CAL_NOCALENDAR = ESMF_CalendarType(6) |
---|
87 | |
---|
88 | !------------------------------------------------------------------------------ |
---|
89 | ! ! ESMF_Calendar |
---|
90 | ! |
---|
91 | ! ! F90 class type to match C++ Calendar class in size only; |
---|
92 | ! ! all dereferencing within class is performed by C++ implementation |
---|
93 | ! |
---|
94 | !------------------------------------------------------------------------------ |
---|
95 | ! |
---|
96 | ! ! ESMF_DaysPerYear |
---|
97 | ! |
---|
98 | type ESMF_DaysPerYear |
---|
99 | private |
---|
100 | integer :: D ! whole days per year |
---|
101 | ! Fractional days-per-year are not yet used in this implementation. |
---|
102 | ! integer :: Dn ! fractional days per year numerator |
---|
103 | ! integer :: Dd ! fractional days per year denominator |
---|
104 | end type ! e.g. for Venus, D=0, Dn=926, Dd=1000 |
---|
105 | ! |
---|
106 | !------------------------------------------------------------------------------ |
---|
107 | ! ! ESMF_Calendar |
---|
108 | ! |
---|
109 | ! |
---|
110 | type ESMF_Calendar |
---|
111 | private |
---|
112 | type(ESMF_CalendarType) :: Type |
---|
113 | ! TBH: When NO_DT_COMPONENT_INIT is set, code that uses F95 compile-time |
---|
114 | ! TBH: initialization of components of derived types is not included. |
---|
115 | ! TBH: Some older compilers, like PGI 5.x do not support this F95 feature. |
---|
116 | #ifdef NO_DT_COMPONENT_INIT |
---|
117 | logical :: Set |
---|
118 | #else |
---|
119 | logical :: Set = .false. |
---|
120 | #endif |
---|
121 | integer, dimension(MONTHS_PER_YEAR) :: DaysPerMonth |
---|
122 | integer :: SecondsPerDay |
---|
123 | integer :: SecondsPerYear |
---|
124 | type(ESMF_DaysPerYear) :: DaysPerYear |
---|
125 | end type |
---|
126 | |
---|
127 | !------------------------------------------------------------------------------ |
---|
128 | ! !PUBLIC DATA: |
---|
129 | TYPE(ESMF_Calendar), public, save, pointer :: defaultCal ! Default Calendar |
---|
130 | |
---|
131 | |
---|
132 | ! |
---|
133 | !------------------------------------------------------------------------------ |
---|
134 | ! !PUBLIC TYPES: |
---|
135 | public MONTHS_PER_YEAR |
---|
136 | public mday |
---|
137 | public mdayleap |
---|
138 | public monthbdys |
---|
139 | public monthbdysleap |
---|
140 | public daym |
---|
141 | public daymleap |
---|
142 | public mdaycum |
---|
143 | public mdayleapcum |
---|
144 | public ESMF_CalendarType |
---|
145 | public ESMF_CAL_GREGORIAN, ESMF_CAL_NOLEAP, & |
---|
146 | ESMF_CAL_360DAY, ESMF_CAL_NOCALENDAR |
---|
147 | ! public ESMF_CAL_JULIAN |
---|
148 | ! public ESMF_CAL_GENERIC |
---|
149 | public ESMF_Calendar |
---|
150 | |
---|
151 | !------------------------------------------------------------------------------ |
---|
152 | ! |
---|
153 | ! !PUBLIC MEMBER FUNCTIONS: |
---|
154 | public ESMF_CalendarCreate |
---|
155 | |
---|
156 | ! Required inherited and overridden ESMF_Base class methods |
---|
157 | |
---|
158 | public ESMF_CalendarInitialized ! Only in this implementation, intended |
---|
159 | ! to be private within ESMF methods |
---|
160 | !EOPI |
---|
161 | |
---|
162 | !============================================================================== |
---|
163 | |
---|
164 | contains |
---|
165 | |
---|
166 | |
---|
167 | !============================================================================== |
---|
168 | !BOP |
---|
169 | ! !IROUTINE: ESMF_CalendarCreate - Create a new ESMF Calendar of built-in type |
---|
170 | |
---|
171 | ! !INTERFACE: |
---|
172 | ! Private name; call using ESMF_CalendarCreate() |
---|
173 | function ESMF_CalendarCreate(name, calendartype, rc) |
---|
174 | |
---|
175 | ! !RETURN VALUE: |
---|
176 | type(ESMF_Calendar) :: ESMF_CalendarCreate |
---|
177 | |
---|
178 | ! !ARGUMENTS: |
---|
179 | character (len=*), intent(in), optional :: name |
---|
180 | type(ESMF_CalendarType), intent(in) :: calendartype |
---|
181 | integer, intent(out), optional :: rc |
---|
182 | |
---|
183 | ! !DESCRIPTION: |
---|
184 | ! Creates and sets a {\tt calendar} to the given built-in |
---|
185 | ! {\tt ESMF\_CalendarType}. |
---|
186 | ! |
---|
187 | ! This is a private method; invoke via the public overloaded entry point |
---|
188 | ! {\tt ESMF\_CalendarCreate()}. |
---|
189 | ! |
---|
190 | ! The arguments are: |
---|
191 | ! \begin{description} |
---|
192 | ! \item[{[name]}] |
---|
193 | ! The name for the newly created calendar. If not specified, a |
---|
194 | ! default unique name will be generated: "CalendarNNN" where NNN |
---|
195 | ! is a unique sequence number from 001 to 999. |
---|
196 | ! \item[calendartype] |
---|
197 | ! The built-in {\tt ESMF\_CalendarType}. Valid values are: |
---|
198 | ! {\tt ESMF\_CAL\_360DAY}, {\tt ESMF\_CAL\_GREGORIAN}, |
---|
199 | ! {\tt ESMF\_CAL\_JULIANDAY}, {\tt ESMF\_CAL\_NOCALENDAR}, and |
---|
200 | ! {\tt ESMF\_CAL\_NOLEAP}. |
---|
201 | ! See the "Time Manager Reference" document for a description of |
---|
202 | ! each calendar type. |
---|
203 | ! \item[{[rc]}] |
---|
204 | ! Return code; equals {\tt ESMF\_SUCCESS} if there are no errors. |
---|
205 | ! \end{description} |
---|
206 | ! |
---|
207 | !EOP |
---|
208 | ! !REQUIREMENTS: |
---|
209 | ! TMGn.n.n |
---|
210 | type(ESMF_DaysPerYear) :: dayspy |
---|
211 | |
---|
212 | if ( present(rc) ) rc = ESMF_FAILURE |
---|
213 | ! Calendar type is hard-coded. Use ESMF library if more flexibility is |
---|
214 | ! needed. |
---|
215 | #ifdef NO_LEAP_CALENDAR |
---|
216 | if ( calendartype%caltype /= ESMF_CAL_NOLEAP%caltype ) then |
---|
217 | write(6,*) 'Not a valid calendar type for this implementation' |
---|
218 | write(6,*) 'This implementation only allows ESMF_CAL_NOLEAP' |
---|
219 | write(6,*) 'calender type set to = ', calendartype%caltype |
---|
220 | write(6,*) 'NO_LEAP calendar type is = ', ESMF_CAL_NOLEAP%caltype |
---|
221 | return |
---|
222 | end if |
---|
223 | ESMF_CalendarCreate%Type = ESMF_CAL_NOLEAP |
---|
224 | #else |
---|
225 | if ( calendartype%caltype /= ESMF_CAL_GREGORIAN%caltype ) then |
---|
226 | write(6,*) 'Not a valid calendar type for this implementation' |
---|
227 | write(6,*) 'This implementation only allows ESMF_CAL_GREGORIAN' |
---|
228 | write(6,*) 'calender type set to = ', calendartype%caltype |
---|
229 | write(6,*) 'GREGORIAN calendar type is = ', ESMF_CAL_GREGORIAN%caltype |
---|
230 | return |
---|
231 | end if |
---|
232 | ESMF_CalendarCreate%Type = ESMF_CAL_GREGORIAN |
---|
233 | #endif |
---|
234 | ! This is a bug on some systems -- need initial value set by compiler at |
---|
235 | ! startup. |
---|
236 | ! However, note that some older compilers do not support compile-time |
---|
237 | ! initialization of data members of Fortran derived data types. For example, |
---|
238 | ! PGI 5.x compilers do not support this F95 feature. See |
---|
239 | ! NO_DT_COMPONENT_INIT. |
---|
240 | ESMF_CalendarCreate%Set = .true. |
---|
241 | ESMF_CalendarCreate%SecondsPerDay = SECONDS_PER_DAY |
---|
242 | ! DaysPerYear and SecondsPerYear are incorrect for Gregorian calendars... |
---|
243 | dayspy%D = size(daym) |
---|
244 | !TBH: TODO: Replace DaysPerYear and SecondsPerYear with methods |
---|
245 | !TBH: TODO: since they only make sense for the NO_LEAP calendar! |
---|
246 | ESMF_CalendarCreate%DaysPerYear = dayspy |
---|
247 | ESMF_CalendarCreate%SecondsPerYear = ESMF_CalendarCreate%SecondsPerDay & |
---|
248 | * dayspy%D |
---|
249 | !TBH: TODO: use mdayleap for leap-year calendar |
---|
250 | ESMF_CalendarCreate%DaysPerMonth(:) = mday(:) |
---|
251 | |
---|
252 | if ( present(rc) ) rc = ESMF_SUCCESS |
---|
253 | |
---|
254 | end function ESMF_CalendarCreate |
---|
255 | |
---|
256 | |
---|
257 | !============================================================================== |
---|
258 | !BOP |
---|
259 | ! !IROUTINE: ESMF_CalendarInitialized - check if calendar was created |
---|
260 | |
---|
261 | ! !INTERFACE: |
---|
262 | function ESMF_CalendarInitialized(calendar) |
---|
263 | |
---|
264 | ! !RETURN VALUE: |
---|
265 | logical ESMF_CalendarInitialized |
---|
266 | |
---|
267 | ! !ARGUMENTS: |
---|
268 | type(ESMF_Calendar), intent(in) :: calendar |
---|
269 | |
---|
270 | ! !DESCRIPTION: |
---|
271 | !EOP |
---|
272 | ! !REQUIREMENTS: |
---|
273 | ! TMGn.n.n |
---|
274 | ! Note that return value from this function will be bogus for older compilers |
---|
275 | ! that do not support compile-time initialization of data members of Fortran |
---|
276 | ! derived data types. For example, PGI 5.x compilers do not support this F95 |
---|
277 | ! feature. At the moment, the call to this fuction is #ifdefd out when the |
---|
278 | ! leap-year calendar is used so this is not an issue for WRF (see |
---|
279 | ! NO_DT_COMPONENT_INIT). |
---|
280 | ESMF_CalendarInitialized = calendar%set |
---|
281 | |
---|
282 | end function ESMF_CalendarInitialized |
---|
283 | |
---|
284 | end module ESMF_CalendarMod |
---|