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 TimeInterval Module |
---|
13 | module ESMF_TimeIntervalMod |
---|
14 | ! |
---|
15 | !============================================================================== |
---|
16 | ! |
---|
17 | ! This file contains the TimeInterval class definition and all TimeInterval |
---|
18 | ! class methods. |
---|
19 | ! |
---|
20 | !------------------------------------------------------------------------------ |
---|
21 | ! INCLUDES |
---|
22 | #include <ESMF_TimeMgr.inc> |
---|
23 | ! |
---|
24 | !=============================================================================== |
---|
25 | !BOPI |
---|
26 | ! !MODULE: ESMF_TimeIntervalMod |
---|
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++ implementaion of class {\tt ESMC\_TimeInterval} |
---|
33 | ! |
---|
34 | ! See {\tt ../include/ESMC\_TimeInterval.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 | ! associated derived types |
---|
45 | use ESMF_FractionMod, only : ESMF_Fraction |
---|
46 | use ESMF_CalendarMod |
---|
47 | |
---|
48 | implicit none |
---|
49 | ! |
---|
50 | !------------------------------------------------------------------------------ |
---|
51 | ! !PRIVATE TYPES: |
---|
52 | private |
---|
53 | !------------------------------------------------------------------------------ |
---|
54 | ! ! ESMF_TimeInterval |
---|
55 | ! |
---|
56 | ! ! F90 class type to match C++ TimeInterval class in size only; |
---|
57 | ! ! all dereferencing within class is performed by C++ implementation |
---|
58 | |
---|
59 | type ESMF_TimeInterval |
---|
60 | ! time interval is expressed as basetime |
---|
61 | type(ESMF_BaseTime) :: basetime ! inherit base class |
---|
62 | ! Relative year and month fields support monthly or yearly time |
---|
63 | ! intervals. Many operations are undefined when these fields are |
---|
64 | ! non-zero! |
---|
65 | INTEGER :: YR ! relative year |
---|
66 | INTEGER :: MM ! relative month |
---|
67 | end type |
---|
68 | |
---|
69 | !------------------------------------------------------------------------------ |
---|
70 | ! !PUBLIC TYPES: |
---|
71 | public ESMF_TimeInterval |
---|
72 | !------------------------------------------------------------------------------ |
---|
73 | ! |
---|
74 | ! !PUBLIC MEMBER FUNCTIONS: |
---|
75 | public ESMF_TimeIntervalGet |
---|
76 | public ESMF_TimeIntervalSet |
---|
77 | public ESMFold_TimeIntervalGetString |
---|
78 | public ESMF_TimeIntervalAbsValue |
---|
79 | public ESMF_TimeIntervalNegAbsValue |
---|
80 | |
---|
81 | ! Required inherited and overridden ESMF_Base class methods |
---|
82 | |
---|
83 | !!!!!!!!! added 20051012, JM |
---|
84 | ! public WRFADDITION_TimeIntervalDIVQuot |
---|
85 | !!!!!!!!! renamed to simplify testing 20060320, TH |
---|
86 | public ESMF_TimeIntervalDIVQuot |
---|
87 | |
---|
88 | ! This convenience routine is only used by other modules in |
---|
89 | ! esmf_time_f90. |
---|
90 | public ESMF_TimeIntervalIsPositive |
---|
91 | |
---|
92 | |
---|
93 | ! !PRIVATE MEMBER FUNCTIONS: |
---|
94 | |
---|
95 | ! overloaded operator functions |
---|
96 | |
---|
97 | public operator(/) |
---|
98 | private ESMF_TimeIntervalQuotI |
---|
99 | |
---|
100 | public operator(*) |
---|
101 | private ESMF_TimeIntervalProdI |
---|
102 | |
---|
103 | ! Inherited and overloaded from ESMF_BaseTime |
---|
104 | |
---|
105 | public operator(+) |
---|
106 | private ESMF_TimeIntervalSum |
---|
107 | |
---|
108 | public operator(-) |
---|
109 | private ESMF_TimeIntervalDiff |
---|
110 | |
---|
111 | public operator(.EQ.) |
---|
112 | private ESMF_TimeIntervalEQ |
---|
113 | |
---|
114 | public operator(.NE.) |
---|
115 | private ESMF_TimeIntervalNE |
---|
116 | |
---|
117 | public operator(.LT.) |
---|
118 | private ESMF_TimeIntervalLT |
---|
119 | |
---|
120 | public operator(.GT.) |
---|
121 | private ESMF_TimeIntervalGT |
---|
122 | |
---|
123 | public operator(.LE.) |
---|
124 | private ESMF_TimeIntervalLE |
---|
125 | |
---|
126 | public operator(.GE.) |
---|
127 | private ESMF_TimeIntervalGE |
---|
128 | !EOPI |
---|
129 | |
---|
130 | !============================================================================== |
---|
131 | ! |
---|
132 | ! INTERFACE BLOCKS |
---|
133 | ! |
---|
134 | !============================================================================== |
---|
135 | !BOP |
---|
136 | ! !INTERFACE: |
---|
137 | interface operator(*) |
---|
138 | |
---|
139 | ! !PRIVATE MEMBER FUNCTIONS: |
---|
140 | module procedure ESMF_TimeIntervalProdI |
---|
141 | |
---|
142 | ! !DESCRIPTION: |
---|
143 | ! This interface overloads the * operator for the {\tt ESMF\_TimeInterval} |
---|
144 | ! class |
---|
145 | ! |
---|
146 | !EOP |
---|
147 | end interface |
---|
148 | ! |
---|
149 | !------------------------------------------------------------------------------ |
---|
150 | !BOP |
---|
151 | ! !INTERFACE: |
---|
152 | interface operator(/) |
---|
153 | |
---|
154 | ! !PRIVATE MEMBER FUNCTIONS: |
---|
155 | module procedure ESMF_TimeIntervalQuotI |
---|
156 | |
---|
157 | ! !DESCRIPTION: |
---|
158 | ! This interface overloads the / operator for the |
---|
159 | ! {\tt ESMF\_TimeInterval} class |
---|
160 | ! |
---|
161 | !EOP |
---|
162 | end interface |
---|
163 | ! |
---|
164 | !------------------------------------------------------------------------------ |
---|
165 | !BOP |
---|
166 | ! !INTERFACE: |
---|
167 | interface operator(+) |
---|
168 | |
---|
169 | ! !PRIVATE MEMBER FUNCTIONS: |
---|
170 | module procedure ESMF_TimeIntervalSum |
---|
171 | |
---|
172 | ! !DESCRIPTION: |
---|
173 | ! This interface overloads the + operator for the |
---|
174 | ! {\tt ESMF\_TimeInterval} class |
---|
175 | ! |
---|
176 | !EOP |
---|
177 | end interface |
---|
178 | ! |
---|
179 | !------------------------------------------------------------------------------ |
---|
180 | !BOP |
---|
181 | ! !INTERFACE: |
---|
182 | interface operator(-) |
---|
183 | |
---|
184 | ! !PRIVATE MEMBER FUNCTIONS: |
---|
185 | module procedure ESMF_TimeIntervalDiff |
---|
186 | |
---|
187 | ! !DESCRIPTION: |
---|
188 | ! This interface overloads the - operator for the |
---|
189 | ! {\tt ESMF\_TimeInterval} class |
---|
190 | ! |
---|
191 | !EOP |
---|
192 | end interface |
---|
193 | ! |
---|
194 | !------------------------------------------------------------------------------ |
---|
195 | !BOP |
---|
196 | ! !INTERFACE: |
---|
197 | interface operator(.EQ.) |
---|
198 | |
---|
199 | ! !PRIVATE MEMBER FUNCTIONS: |
---|
200 | module procedure ESMF_TimeIntervalEQ |
---|
201 | |
---|
202 | ! !DESCRIPTION: |
---|
203 | ! This interface overloads the .EQ. operator for the |
---|
204 | ! {\tt ESMF\_TimeInterval} class |
---|
205 | ! |
---|
206 | !EOP |
---|
207 | end interface |
---|
208 | ! |
---|
209 | !------------------------------------------------------------------------------ |
---|
210 | !BOP |
---|
211 | ! !INTERFACE: |
---|
212 | interface operator(.NE.) |
---|
213 | |
---|
214 | ! !PRIVATE MEMBER FUNCTIONS: |
---|
215 | module procedure ESMF_TimeIntervalNE |
---|
216 | |
---|
217 | ! !DESCRIPTION: |
---|
218 | ! This interface overloads the .NE. operator for the |
---|
219 | ! {\tt ESMF\_TimeInterval} class |
---|
220 | ! |
---|
221 | !EOP |
---|
222 | end interface |
---|
223 | ! |
---|
224 | !------------------------------------------------------------------------------ |
---|
225 | !BOP |
---|
226 | ! !INTERFACE: |
---|
227 | interface operator(.LT.) |
---|
228 | |
---|
229 | ! !PRIVATE MEMBER FUNCTIONS: |
---|
230 | module procedure ESMF_TimeIntervalLT |
---|
231 | |
---|
232 | ! !DESCRIPTION: |
---|
233 | ! This interface overloads the .LT. operator for the |
---|
234 | ! {\tt ESMF\_TimeInterval} class |
---|
235 | ! |
---|
236 | !EOP |
---|
237 | end interface |
---|
238 | ! |
---|
239 | !------------------------------------------------------------------------------ |
---|
240 | !BOP |
---|
241 | ! !INTERFACE: |
---|
242 | interface operator(.GT.) |
---|
243 | |
---|
244 | ! !PRIVATE MEMBER FUNCTIONS: |
---|
245 | module procedure ESMF_TimeIntervalGT |
---|
246 | |
---|
247 | ! !DESCRIPTION: |
---|
248 | ! This interface overloads the .GT. operator for the |
---|
249 | ! {\tt ESMF\_TimeInterval} class |
---|
250 | ! |
---|
251 | !EOP |
---|
252 | end interface |
---|
253 | ! |
---|
254 | !------------------------------------------------------------------------------ |
---|
255 | !BOP |
---|
256 | ! !INTERFACE: |
---|
257 | interface operator(.LE.) |
---|
258 | |
---|
259 | ! !PRIVATE MEMBER FUNCTIONS: |
---|
260 | module procedure ESMF_TimeIntervalLE |
---|
261 | |
---|
262 | ! !DESCRIPTION: |
---|
263 | ! This interface overloads the .LE. operator for the |
---|
264 | ! {\tt ESMF\_TimeInterval} class |
---|
265 | ! |
---|
266 | !EOP |
---|
267 | end interface |
---|
268 | ! |
---|
269 | !------------------------------------------------------------------------------ |
---|
270 | !BOP |
---|
271 | ! !INTERFACE: |
---|
272 | interface operator(.GE.) |
---|
273 | |
---|
274 | ! !PRIVATE MEMBER FUNCTIONS: |
---|
275 | module procedure ESMF_TimeIntervalGE |
---|
276 | |
---|
277 | ! !DESCRIPTION: |
---|
278 | ! This interface overloads the .GE. operator for the |
---|
279 | ! {\tt ESMF\_TimeInterval} class |
---|
280 | ! |
---|
281 | !EOP |
---|
282 | end interface |
---|
283 | ! |
---|
284 | !------------------------------------------------------------------------------ |
---|
285 | |
---|
286 | !============================================================================== |
---|
287 | |
---|
288 | contains |
---|
289 | |
---|
290 | !============================================================================== |
---|
291 | ! |
---|
292 | ! Generic Get/Set routines which use F90 optional arguments |
---|
293 | ! |
---|
294 | !------------------------------------------------------------------------------ |
---|
295 | !BOP |
---|
296 | ! !IROUTINE: ESMF_TimeIntervalGet - Get value in user-specified units |
---|
297 | |
---|
298 | ! !INTERFACE: |
---|
299 | subroutine ESMF_TimeIntervalGet(timeinterval, D, d_r8, S, Sn, Sd, & |
---|
300 | TimeString, rc ) |
---|
301 | |
---|
302 | ! !ARGUMENTS: |
---|
303 | type(ESMF_TimeInterval), intent(in) :: timeinterval |
---|
304 | integer, intent(out), optional :: D |
---|
305 | real(ESMF_KIND_R8), intent(out), optional :: d_r8 |
---|
306 | integer, intent(out), optional :: S |
---|
307 | integer, intent(out), optional :: Sn |
---|
308 | integer, intent(out), optional :: Sd |
---|
309 | character*(*), optional, intent(out) :: TimeString |
---|
310 | integer, intent(out), optional :: rc |
---|
311 | |
---|
312 | |
---|
313 | ! !DESCRIPTION: |
---|
314 | ! Get the value of the {\tt ESMF\_TimeInterval} in units specified by the |
---|
315 | ! user via F90 optional arguments. |
---|
316 | ! |
---|
317 | ! Time manager represents and manipulates time internally with integers |
---|
318 | ! to maintain precision. Hence, user-specified floating point values are |
---|
319 | ! converted internally from integers. |
---|
320 | ! |
---|
321 | ! See {\tt ../include/ESMC\_BaseTime.h} and |
---|
322 | ! {\tt ../include/ESMC\_TimeInterval.h} for complete description. |
---|
323 | ! |
---|
324 | ! The arguments are: |
---|
325 | ! \begin{description} |
---|
326 | ! \item[timeinterval] |
---|
327 | ! The object instance to query |
---|
328 | ! \item[{[YY]}] |
---|
329 | ! Integer years (>= 32-bit) |
---|
330 | ! \item[{[YYl]}] |
---|
331 | ! Integer years (large, >= 64-bit) |
---|
332 | ! \item[{[MO]}] |
---|
333 | ! Integer months (>= 32-bit) |
---|
334 | ! \item[{[MOl]}] |
---|
335 | ! Integer months (large, >= 64-bit) |
---|
336 | ! \item[{[D]}] |
---|
337 | ! Integer days (>= 32-bit) |
---|
338 | ! \item[{[Dl]}] |
---|
339 | ! Integer days (large, >= 64-bit) |
---|
340 | ! \item[{[H]}] |
---|
341 | ! Integer hours |
---|
342 | ! \item[{[M]}] |
---|
343 | ! Integer minutes |
---|
344 | ! \item[{[S]}] |
---|
345 | ! Integer seconds (>= 32-bit) |
---|
346 | ! \item[{[Sl]}] |
---|
347 | ! Integer seconds (large, >= 64-bit) |
---|
348 | ! \item[{[MS]}] |
---|
349 | ! Integer milliseconds |
---|
350 | ! \item[{[US]}] |
---|
351 | ! Integer microseconds |
---|
352 | ! \item[{[NS]}] |
---|
353 | ! Integer nanoseconds |
---|
354 | ! \item[{[d\_]}] |
---|
355 | ! Double precision days |
---|
356 | ! \item[{[h\_]}] |
---|
357 | ! Double precision hours |
---|
358 | ! \item[{[m\_]}] |
---|
359 | ! Double precision minutes |
---|
360 | ! \item[{[s\_]}] |
---|
361 | ! Double precision seconds |
---|
362 | ! \item[{[ms\_]}] |
---|
363 | ! Double precision milliseconds |
---|
364 | ! \item[{[us\_]}] |
---|
365 | ! Double precision microseconds |
---|
366 | ! \item[{[ns\_]}] |
---|
367 | ! Double precision nanoseconds |
---|
368 | ! \item[{[Sn]}] |
---|
369 | ! Integer fractional seconds - numerator |
---|
370 | ! \item[{[Sd]}] |
---|
371 | ! Integer fractional seconds - denominator |
---|
372 | ! \item[{[rc]}] |
---|
373 | ! Return code; equals {\tt ESMF\_SUCCESS} if there are no errors. |
---|
374 | ! \end{description} |
---|
375 | ! |
---|
376 | ! !REQUIREMENTS: |
---|
377 | ! TMG1.1 |
---|
378 | !EOP |
---|
379 | INTEGER(ESMF_KIND_I8) :: seconds |
---|
380 | INTEGER :: ierr |
---|
381 | |
---|
382 | ierr = ESMF_SUCCESS |
---|
383 | seconds = timeinterval%basetime%S |
---|
384 | ! note that S is overwritten below (if present) if other args are also |
---|
385 | ! present |
---|
386 | IF ( PRESENT(S) ) S = seconds |
---|
387 | IF ( PRESENT( D ) ) THEN |
---|
388 | D = seconds / SECONDS_PER_DAY |
---|
389 | IF ( PRESENT(S) ) S = MOD( seconds, SECONDS_PER_DAY ) |
---|
390 | ENDIF |
---|
391 | IF ( PRESENT( d_r8 ) ) THEN |
---|
392 | D_r8 = REAL( seconds, ESMF_KIND_R8 ) / & |
---|
393 | REAL( SECONDS_PER_DAY, ESMF_KIND_R8 ) |
---|
394 | IF ( PRESENT(S) ) S = MOD( seconds, SECONDS_PER_DAY ) |
---|
395 | ENDIF |
---|
396 | IF ( PRESENT(Sn) ) THEN |
---|
397 | Sn = timeinterval%basetime%Sn |
---|
398 | ENDIF |
---|
399 | IF ( PRESENT(Sd) ) THEN |
---|
400 | Sd = timeinterval%basetime%Sd |
---|
401 | ENDIF |
---|
402 | IF ( PRESENT( timeString ) ) THEN |
---|
403 | CALL ESMFold_TimeIntervalGetString( timeinterval, timeString, rc=ierr ) |
---|
404 | ENDIF |
---|
405 | IF ( PRESENT(rc) ) rc = ierr |
---|
406 | |
---|
407 | end subroutine ESMF_TimeIntervalGet |
---|
408 | |
---|
409 | !------------------------------------------------------------------------------ |
---|
410 | !BOP |
---|
411 | ! !IROUTINE: ESMF_TimeIntervalSet - Initialize via user-specified unit set |
---|
412 | |
---|
413 | ! !INTERFACE: |
---|
414 | subroutine ESMF_TimeIntervalSet(timeinterval, YY, YYl, MM, MOl, D, Dl, & |
---|
415 | H, M, S, Sl, MS, US, NS, & |
---|
416 | d_, h_, m_, s_, ms_, us_, ns_, & |
---|
417 | Sn, Sd, rc) |
---|
418 | |
---|
419 | ! !ARGUMENTS: |
---|
420 | type(ESMF_TimeInterval), intent(out) :: timeinterval |
---|
421 | integer, intent(in), optional :: YY |
---|
422 | integer(ESMF_KIND_I8), intent(in), optional :: YYl |
---|
423 | integer, intent(in), optional :: MM |
---|
424 | integer(ESMF_KIND_I8), intent(in), optional :: MOl |
---|
425 | integer, intent(in), optional :: D |
---|
426 | integer(ESMF_KIND_I8), intent(in), optional :: Dl |
---|
427 | integer, intent(in), optional :: H |
---|
428 | integer, intent(in), optional :: M |
---|
429 | integer, intent(in), optional :: S |
---|
430 | integer(ESMF_KIND_I8), intent(in), optional :: Sl |
---|
431 | integer, intent(in), optional :: MS |
---|
432 | integer, intent(in), optional :: US |
---|
433 | integer, intent(in), optional :: NS |
---|
434 | double precision, intent(in), optional :: d_ |
---|
435 | double precision, intent(in), optional :: h_ |
---|
436 | double precision, intent(in), optional :: m_ |
---|
437 | double precision, intent(in), optional :: s_ |
---|
438 | double precision, intent(in), optional :: ms_ |
---|
439 | double precision, intent(in), optional :: us_ |
---|
440 | double precision, intent(in), optional :: ns_ |
---|
441 | integer, intent(in), optional :: Sn |
---|
442 | integer, intent(in), optional :: Sd |
---|
443 | integer, intent(out), optional :: rc |
---|
444 | ! locals |
---|
445 | INTEGER :: nfeb |
---|
446 | |
---|
447 | ! !DESCRIPTION: |
---|
448 | ! Set the value of the {\tt ESMF\_TimeInterval} in units specified by |
---|
449 | ! the user via F90 optional arguments |
---|
450 | ! |
---|
451 | ! Time manager represents and manipulates time internally with integers |
---|
452 | ! to maintain precision. Hence, user-specified floating point values are |
---|
453 | ! converted internally to integers. |
---|
454 | ! |
---|
455 | ! See {\tt ../include/ESMC\_BaseTime.h} and |
---|
456 | ! {\tt ../include/ESMC\_TimeInterval.h} for complete description. |
---|
457 | ! |
---|
458 | ! The arguments are: |
---|
459 | ! \begin{description} |
---|
460 | ! \item[timeinterval] |
---|
461 | ! The object instance to initialize |
---|
462 | ! \item[{[YY]}] |
---|
463 | ! Integer number of interval years (>= 32-bit) |
---|
464 | ! \item[{[YYl]}] |
---|
465 | ! Integer number of interval years (large, >= 64-bit) |
---|
466 | ! \item[{[MM]}] |
---|
467 | ! Integer number of interval months (>= 32-bit) |
---|
468 | ! \item[{[MOl]}] |
---|
469 | ! Integer number of interval months (large, >= 64-bit) |
---|
470 | ! \item[{[D]}] |
---|
471 | ! Integer number of interval days (>= 32-bit) |
---|
472 | ! \item[{[Dl]}] |
---|
473 | ! Integer number of interval days (large, >= 64-bit) |
---|
474 | ! \item[{[H]}] |
---|
475 | ! Integer hours |
---|
476 | ! \item[{[M]}] |
---|
477 | ! Integer minutes |
---|
478 | ! \item[{[S]}] |
---|
479 | ! Integer seconds (>= 32-bit) |
---|
480 | ! \item[{[Sl]}] |
---|
481 | ! Integer seconds (large, >= 64-bit) |
---|
482 | ! \item[{[MS]}] |
---|
483 | ! Integer milliseconds |
---|
484 | ! \item[{[US]}] |
---|
485 | ! Integer microseconds |
---|
486 | ! \item[{[NS]}] |
---|
487 | ! Integer nanoseconds |
---|
488 | ! \item[{[d\_]}] |
---|
489 | ! Double precision days |
---|
490 | ! \item[{[h\_]}] |
---|
491 | ! Double precision hours |
---|
492 | ! \item[{[m\_]}] |
---|
493 | ! Double precision minutes |
---|
494 | ! \item[{[s\_]}] |
---|
495 | ! Double precision seconds |
---|
496 | ! \item[{[ms\_]}] |
---|
497 | ! Double precision milliseconds |
---|
498 | ! \item[{[us\_]}] |
---|
499 | ! Double precision microseconds |
---|
500 | ! \item[{[ns\_]}] |
---|
501 | ! Double precision nanoseconds |
---|
502 | ! \item[{[Sn]}] |
---|
503 | ! Integer fractional seconds - numerator |
---|
504 | ! \item[{[Sd]}] |
---|
505 | ! Integer fractional seconds - denominator |
---|
506 | ! \item[{[rc]}] |
---|
507 | ! Return code; equals {\tt ESMF\_SUCCESS} if there are no errors. |
---|
508 | ! \end{description} |
---|
509 | ! |
---|
510 | ! !REQUIREMENTS: |
---|
511 | ! TMGn.n.n |
---|
512 | !EOP |
---|
513 | |
---|
514 | IF ( PRESENT(rc) ) rc = ESMF_FAILURE |
---|
515 | ! note that YR and MM are relative |
---|
516 | timeinterval%YR = 0 |
---|
517 | IF ( PRESENT( YY ) ) THEN |
---|
518 | timeinterval%YR = YY |
---|
519 | ENDIF |
---|
520 | timeinterval%MM = 0 |
---|
521 | IF ( PRESENT( MM ) ) THEN |
---|
522 | timeinterval%MM = MM |
---|
523 | ENDIF |
---|
524 | ! Rollover months to years |
---|
525 | IF ( abs(timeinterval%MM) .GE. MONTHS_PER_YEAR ) THEN |
---|
526 | timeinterval%YR = timeinterval%YR + timeinterval%MM/MONTHS_PER_YEAR |
---|
527 | timeinterval%MM = mod(timeinterval%MM,MONTHS_PER_YEAR) |
---|
528 | ENDIF |
---|
529 | |
---|
530 | timeinterval%basetime%S = 0 |
---|
531 | ! For 365-day calendar, immediately convert years to days since we know |
---|
532 | ! how to do it in this case. |
---|
533 | !$$$ replace this hack with something saner... |
---|
534 | IF ( nfeb( 2004 ) == 28 ) THEN |
---|
535 | timeinterval%basetime%S = timeinterval%basetime%S + & |
---|
536 | ( 365_ESMF_KIND_I8 * & |
---|
537 | INT( timeinterval%YR, ESMF_KIND_I8 ) * SECONDS_PER_DAY ) |
---|
538 | timeinterval%YR = 0 |
---|
539 | ENDIF |
---|
540 | IF ( PRESENT( D ) ) THEN |
---|
541 | timeinterval%basetime%S = timeinterval%basetime%S + & |
---|
542 | ( SECONDS_PER_DAY * INT( D, ESMF_KIND_I8 ) ) |
---|
543 | ENDIF |
---|
544 | !$$$ Push H,M,S,Sn,Sd,MS down into BaseTime constructor from EVERYWHERE |
---|
545 | !$$$ and THEN add ESMF scaling behavior when other args are present... |
---|
546 | IF ( PRESENT( H ) ) THEN |
---|
547 | timeinterval%basetime%S = timeinterval%basetime%S + & |
---|
548 | ( SECONDS_PER_HOUR * INT( H, ESMF_KIND_I8 ) ) |
---|
549 | ENDIF |
---|
550 | IF ( PRESENT( M ) ) THEN |
---|
551 | timeinterval%basetime%S = timeinterval%basetime%S + & |
---|
552 | ( SECONDS_PER_MINUTE * INT( M, ESMF_KIND_I8 ) ) |
---|
553 | ENDIF |
---|
554 | IF ( PRESENT( S ) ) THEN |
---|
555 | timeinterval%basetime%S = timeinterval%basetime%S + & |
---|
556 | INT( S, ESMF_KIND_I8 ) |
---|
557 | ENDIF |
---|
558 | IF ( PRESENT( Sn ) .AND. ( .NOT. PRESENT( Sd ) ) ) THEN |
---|
559 | CALL wrf_error_fatal( & |
---|
560 | "ESMF_TimeIntervalSet: Must specify Sd if Sn is specified") |
---|
561 | ENDIF |
---|
562 | IF ( PRESENT( Sd ) .AND. PRESENT( MS ) ) THEN |
---|
563 | CALL wrf_error_fatal( & |
---|
564 | "ESMF_TimeIntervalSet: Must not specify both Sd and MS") |
---|
565 | ENDIF |
---|
566 | timeinterval%basetime%Sn = 0 |
---|
567 | timeinterval%basetime%Sd = 0 |
---|
568 | IF ( PRESENT( MS ) ) THEN |
---|
569 | timeinterval%basetime%Sn = MS |
---|
570 | timeinterval%basetime%Sd = 1000_ESMF_KIND_I8 |
---|
571 | ELSE IF ( PRESENT( Sd ) ) THEN |
---|
572 | timeinterval%basetime%Sd = Sd |
---|
573 | IF ( PRESENT( Sn ) ) THEN |
---|
574 | timeinterval%basetime%Sn = Sn |
---|
575 | ENDIF |
---|
576 | ENDIF |
---|
577 | CALL normalize_timeint( timeinterval ) |
---|
578 | |
---|
579 | IF ( PRESENT(rc) ) rc = ESMF_SUCCESS |
---|
580 | |
---|
581 | end subroutine ESMF_TimeIntervalSet |
---|
582 | |
---|
583 | !------------------------------------------------------------------------------ |
---|
584 | !BOP |
---|
585 | ! !IROUTINE: ESMFold_TimeIntervalGetString - Get time interval value in string format |
---|
586 | |
---|
587 | ! !INTERFACE: |
---|
588 | subroutine ESMFold_TimeIntervalGetString(timeinterval, TimeString, rc) |
---|
589 | |
---|
590 | ! !ARGUMENTS: |
---|
591 | type(ESMF_TimeInterval), intent(in) :: timeinterval |
---|
592 | character*(*), intent(out) :: TimeString |
---|
593 | integer, intent(out), optional :: rc |
---|
594 | ! locals |
---|
595 | integer :: signnormtimeint |
---|
596 | LOGICAL :: negative |
---|
597 | INTEGER(ESMF_KIND_I8) :: iS, iSn, iSd, H, M, S |
---|
598 | character (len=1) :: signstr |
---|
599 | |
---|
600 | ! !DESCRIPTION: |
---|
601 | ! Convert {\tt ESMF\_TimeInterval}'s value into string format |
---|
602 | ! |
---|
603 | ! The arguments are: |
---|
604 | ! \begin{description} |
---|
605 | ! \item[timeinterval] |
---|
606 | ! The object instance to convert |
---|
607 | ! \item[TimeString] |
---|
608 | ! The string to return |
---|
609 | ! \item[{[rc]}] |
---|
610 | ! Return code; equals {\tt ESMF\_SUCCESS} if there are no errors. |
---|
611 | ! \end{description} |
---|
612 | ! |
---|
613 | ! !REQUIREMENTS: |
---|
614 | ! TMG1.5.9 |
---|
615 | !EOP |
---|
616 | |
---|
617 | ! NOTE: YR, MM, Sn, and Sd are not yet included in the returned string... |
---|
618 | !PRINT *,'DEBUG ESMFold_TimeIntervalGetString(): YR,MM,S,Sn,Sd = ', & |
---|
619 | ! timeinterval%YR, & |
---|
620 | ! timeinterval%MM, & |
---|
621 | ! timeinterval%basetime%S, & |
---|
622 | ! timeinterval%basetime%Sn, & |
---|
623 | ! timeinterval%basetime%Sd |
---|
624 | |
---|
625 | negative = ( signnormtimeint( timeInterval ) == -1 ) |
---|
626 | IF ( negative ) THEN |
---|
627 | iS = -timeinterval%basetime%S |
---|
628 | iSn = -timeinterval%basetime%Sn |
---|
629 | signstr = '-' |
---|
630 | ELSE |
---|
631 | iS = timeinterval%basetime%S |
---|
632 | iSn = timeinterval%basetime%Sn |
---|
633 | signstr = '' |
---|
634 | ENDIF |
---|
635 | iSd = timeinterval%basetime%Sd |
---|
636 | |
---|
637 | H = mod( iS, SECONDS_PER_DAY ) / SECONDS_PER_HOUR |
---|
638 | M = mod( iS, SECONDS_PER_HOUR) / SECONDS_PER_MINUTE |
---|
639 | S = mod( iS, SECONDS_PER_MINUTE ) |
---|
640 | |
---|
641 | !$$$here... need to print Sn and Sd when they are used ??? |
---|
642 | |
---|
643 | write(TimeString,FMT="(A,I10.10,'_',I3.3,':',I3.3,':',I3.3)") & |
---|
644 | TRIM(signstr), ( iS / SECONDS_PER_DAY ), H, M, S |
---|
645 | |
---|
646 | !write(0,*)'TimeIntervalGetString Sn ',timeinterval%basetime%Sn,' Sd ',timeinterval%basetime%Sd |
---|
647 | |
---|
648 | rc = ESMF_SUCCESS |
---|
649 | |
---|
650 | end subroutine ESMFold_TimeIntervalGetString |
---|
651 | |
---|
652 | !------------------------------------------------------------------------------ |
---|
653 | !BOP |
---|
654 | ! !IROUTINE: ESMF_TimeIntervalAbsValue - Get the absolute value of a time interval |
---|
655 | |
---|
656 | ! !INTERFACE: |
---|
657 | function ESMF_TimeIntervalAbsValue(timeinterval) |
---|
658 | |
---|
659 | ! !RETURN VALUE: |
---|
660 | type(ESMF_TimeInterval) :: ESMF_TimeIntervalAbsValue |
---|
661 | |
---|
662 | ! !ARGUMENTS: |
---|
663 | type(ESMF_TimeInterval), intent(in) :: timeinterval |
---|
664 | ! !LOCAL: |
---|
665 | integer :: rc |
---|
666 | |
---|
667 | ! !DESCRIPTION: |
---|
668 | ! Return a {\tt ESMF\_TimeInterval}'s absolute value. |
---|
669 | ! |
---|
670 | ! The arguments are: |
---|
671 | ! \begin{description} |
---|
672 | ! \item[timeinterval] |
---|
673 | ! The object instance to take the absolute value of. |
---|
674 | ! Absolute value returned as value of function. |
---|
675 | ! \end{description} |
---|
676 | ! |
---|
677 | ! !REQUIREMENTS: |
---|
678 | ! TMG1.5.8 |
---|
679 | !EOP |
---|
680 | CALL timeintchecknormalized( timeinterval, 'ESMF_TimeIntervalAbsValue arg1' ) |
---|
681 | ESMF_TimeIntervalAbsValue = timeinterval |
---|
682 | !$$$here... move implementation into BaseTime |
---|
683 | ESMF_TimeIntervalAbsValue%basetime%S = & |
---|
684 | abs(ESMF_TimeIntervalAbsValue%basetime%S) |
---|
685 | ESMF_TimeIntervalAbsValue%basetime%Sn = & |
---|
686 | abs(ESMF_TimeIntervalAbsValue%basetime%Sn ) |
---|
687 | |
---|
688 | end function ESMF_TimeIntervalAbsValue |
---|
689 | |
---|
690 | !------------------------------------------------------------------------------ |
---|
691 | !BOP |
---|
692 | ! !IROUTINE: ESMF_TimeIntervalNegAbsValue - Get the negative absolute value of a time interval |
---|
693 | |
---|
694 | ! !INTERFACE: |
---|
695 | function ESMF_TimeIntervalNegAbsValue(timeinterval) |
---|
696 | |
---|
697 | ! !RETURN VALUE: |
---|
698 | type(ESMF_TimeInterval) :: ESMF_TimeIntervalNegAbsValue |
---|
699 | |
---|
700 | ! !ARGUMENTS: |
---|
701 | type(ESMF_TimeInterval), intent(in) :: timeinterval |
---|
702 | ! !LOCAL: |
---|
703 | integer :: rc |
---|
704 | |
---|
705 | ! !DESCRIPTION: |
---|
706 | ! Return a {\tt ESMF\_TimeInterval}'s negative absolute value. |
---|
707 | ! |
---|
708 | ! The arguments are: |
---|
709 | ! \begin{description} |
---|
710 | ! \item[timeinterval] |
---|
711 | ! The object instance to take the negative absolute value of. |
---|
712 | ! Negative absolute value returned as value of function. |
---|
713 | ! \end{description} |
---|
714 | ! |
---|
715 | ! !REQUIREMENTS: |
---|
716 | ! TMG1.5.8 |
---|
717 | !EOP |
---|
718 | CALL timeintchecknormalized( timeinterval, 'ESMF_TimeIntervalNegAbsValue arg1' ) |
---|
719 | |
---|
720 | ESMF_TimeIntervalNegAbsValue = timeinterval |
---|
721 | !$$$here... move implementation into BaseTime |
---|
722 | ESMF_TimeIntervalNegAbsValue%basetime%S = & |
---|
723 | -abs(ESMF_TimeIntervalNegAbsValue%basetime%S) |
---|
724 | ESMF_TimeIntervalNegAbsValue%basetime%Sn = & |
---|
725 | -abs(ESMF_TimeIntervalNegAbsValue%basetime%Sn ) |
---|
726 | |
---|
727 | end function ESMF_TimeIntervalNegAbsValue |
---|
728 | |
---|
729 | !------------------------------------------------------------------------------ |
---|
730 | ! |
---|
731 | ! This section includes overloaded operators defined only for TimeInterval |
---|
732 | ! (not inherited from BaseTime) |
---|
733 | ! Note: these functions do not have a return code, since F90 forbids more |
---|
734 | ! than 2 arguments for arithmetic overloaded operators |
---|
735 | ! |
---|
736 | !------------------------------------------------------------------------------ |
---|
737 | |
---|
738 | !!!!!!!!!!!!!!!!!! added jm 20051012 |
---|
739 | ! new WRF-specific function, Divide two time intervals and return the whole integer, without remainder |
---|
740 | function ESMF_TimeIntervalDIVQuot(timeinterval1, timeinterval2) |
---|
741 | |
---|
742 | ! !RETURN VALUE: |
---|
743 | INTEGER :: ESMF_TimeIntervalDIVQuot |
---|
744 | |
---|
745 | ! !ARGUMENTS: |
---|
746 | type(ESMF_TimeInterval), intent(in) :: timeinterval1 |
---|
747 | type(ESMF_TimeInterval), intent(in) :: timeinterval2 |
---|
748 | |
---|
749 | ! !LOCAL |
---|
750 | INTEGER :: retval, isgn, rc |
---|
751 | type(ESMF_TimeInterval) :: zero, i1,i2 |
---|
752 | |
---|
753 | ! !DESCRIPTION: |
---|
754 | ! Returns timeinterval1 divided by timeinterval2 as a fraction quotient. |
---|
755 | ! |
---|
756 | ! The arguments are: |
---|
757 | ! \begin{description} |
---|
758 | ! \item[timeinterval1] |
---|
759 | ! The dividend |
---|
760 | ! \item[timeinterval2] |
---|
761 | ! The divisor |
---|
762 | ! \end{description} |
---|
763 | ! |
---|
764 | ! !REQUIREMENTS: |
---|
765 | ! TMG1.5.5 |
---|
766 | !EOP |
---|
767 | |
---|
768 | CALL timeintchecknormalized( timeinterval1, 'ESMF_TimeIntervalDIVQuot arg1' ) |
---|
769 | CALL timeintchecknormalized( timeinterval2, 'ESMF_TimeIntervalDIVQuot arg2' ) |
---|
770 | |
---|
771 | call ESMF_TimeIntervalSet( zero, rc=rc ) |
---|
772 | i1 = timeinterval1 |
---|
773 | i2 = timeinterval2 |
---|
774 | isgn = 1 |
---|
775 | if ( i1 .LT. zero ) then |
---|
776 | i1 = ESMF_TimeIntervalProdI(i1, -1) |
---|
777 | isgn = -isgn |
---|
778 | endif |
---|
779 | if ( i2 .LT. zero ) then |
---|
780 | i2 = ESMF_TimeIntervalProdI(i2, -1) |
---|
781 | isgn = -isgn |
---|
782 | endif |
---|
783 | ! repeated subtraction |
---|
784 | retval = 0 |
---|
785 | DO WHILE ( i1 .GE. i2 ) |
---|
786 | i1 = i1 - i2 |
---|
787 | retval = retval + 1 |
---|
788 | ENDDO |
---|
789 | retval = retval * isgn |
---|
790 | |
---|
791 | ESMF_TimeIntervalDIVQuot = retval |
---|
792 | |
---|
793 | end function ESMF_TimeIntervalDIVQuot |
---|
794 | !!!!!!!!!!!!!!!!!! |
---|
795 | |
---|
796 | |
---|
797 | |
---|
798 | !------------------------------------------------------------------------------ |
---|
799 | !BOP |
---|
800 | ! !IROUTINE: ESMF_TimeIntervalQuotI - Divide time interval by an integer, return time interval result |
---|
801 | |
---|
802 | ! !INTERFACE: |
---|
803 | function ESMF_TimeIntervalQuotI(timeinterval, divisor) |
---|
804 | |
---|
805 | ! !RETURN VALUE: |
---|
806 | type(ESMF_TimeInterval) :: ESMF_TimeIntervalQuotI |
---|
807 | |
---|
808 | ! !ARGUMENTS: |
---|
809 | type(ESMF_TimeInterval), intent(in) :: timeinterval |
---|
810 | integer, intent(in) :: divisor |
---|
811 | |
---|
812 | ! !DESCRIPTION: |
---|
813 | ! Divides a {\tt ESMF\_TimeInterval} by an integer divisor, returns |
---|
814 | ! quotient as a {\tt ESMF\_TimeInterval} |
---|
815 | ! |
---|
816 | ! The arguments are: |
---|
817 | ! \begin{description} |
---|
818 | ! \item[timeinterval] |
---|
819 | ! The dividend |
---|
820 | ! \item[divisor] |
---|
821 | ! Integer divisor |
---|
822 | ! \end{description} |
---|
823 | ! |
---|
824 | ! !REQUIREMENTS: |
---|
825 | ! TMG1.5.6, TMG5.3, TMG7.2 |
---|
826 | !EOP |
---|
827 | |
---|
828 | !PRINT *,'DEBUG ESMF_TimeIntervalQuotI() A: S,Sn,Sd = ', & |
---|
829 | ! timeinterval%basetime%S,timeinterval%basetime%Sn,timeinterval%basetime%Sd |
---|
830 | !PRINT *,'DEBUG ESMF_TimeIntervalQuotI() A: divisor = ', divisor |
---|
831 | |
---|
832 | CALL timeintchecknormalized( timeinterval, 'ESMF_TimeIntervalQuotI arg1' ) |
---|
833 | |
---|
834 | IF ( divisor == 0 ) THEN |
---|
835 | CALL wrf_error_fatal( 'ESMF_TimeIntervalQuotI: divide by zero' ) |
---|
836 | ENDIF |
---|
837 | ESMF_TimeIntervalQuotI = timeinterval |
---|
838 | !PRINT *,'DEBUG ESMF_TimeIntervalQuotI() B: S,Sn,Sd = ', & |
---|
839 | ! ESMF_TimeIntervalQuotI%basetime%S,ESMF_TimeIntervalQuotI%basetime%Sn,ESMF_TimeIntervalQuotI%basetime%Sd |
---|
840 | ESMF_TimeIntervalQuotI%basetime = & |
---|
841 | timeinterval%basetime / divisor |
---|
842 | !PRINT *,'DEBUG ESMF_TimeIntervalQuotI() C: S,Sn,Sd = ', & |
---|
843 | ! ESMF_TimeIntervalQuotI%basetime%S,ESMF_TimeIntervalQuotI%basetime%Sn,ESMF_TimeIntervalQuotI%basetime%Sd |
---|
844 | |
---|
845 | CALL normalize_timeint( ESMF_TimeIntervalQuotI ) |
---|
846 | !PRINT *,'DEBUG ESMF_TimeIntervalQuotI() D: S,Sn,Sd = ', & |
---|
847 | ! ESMF_TimeIntervalQuotI%basetime%S,ESMF_TimeIntervalQuotI%basetime%Sn,ESMF_TimeIntervalQuotI%basetime%Sd |
---|
848 | |
---|
849 | end function ESMF_TimeIntervalQuotI |
---|
850 | |
---|
851 | !------------------------------------------------------------------------------ |
---|
852 | !BOP |
---|
853 | ! !IROUTINE: ESMF_TimeIntervalProdI - Multiply a time interval by an integer |
---|
854 | |
---|
855 | ! !INTERFACE: |
---|
856 | function ESMF_TimeIntervalProdI(timeinterval, multiplier) |
---|
857 | |
---|
858 | ! !RETURN VALUE: |
---|
859 | type(ESMF_TimeInterval) :: ESMF_TimeIntervalProdI |
---|
860 | |
---|
861 | ! !ARGUMENTS: |
---|
862 | type(ESMF_TimeInterval), intent(in) :: timeinterval |
---|
863 | integer, intent(in) :: multiplier |
---|
864 | ! !LOCAL: |
---|
865 | integer :: rc |
---|
866 | |
---|
867 | ! !DESCRIPTION: |
---|
868 | ! Multiply a {\tt ESMF\_TimeInterval} by an integer, return product as a |
---|
869 | ! {\tt ESMF\_TimeInterval} |
---|
870 | ! |
---|
871 | ! The arguments are: |
---|
872 | ! \begin{description} |
---|
873 | ! \item[timeinterval] |
---|
874 | ! The multiplicand |
---|
875 | ! \item[mutliplier] |
---|
876 | ! Integer multiplier |
---|
877 | ! \end{description} |
---|
878 | ! |
---|
879 | ! !REQUIREMENTS: |
---|
880 | ! TMG1.5.7, TMG7.2 |
---|
881 | !EOP |
---|
882 | CALL timeintchecknormalized( timeinterval, 'ESMF_TimeIntervalProdI arg1' ) |
---|
883 | |
---|
884 | CALL ESMF_TimeIntervalSet( ESMF_TimeIntervalProdI, rc=rc ) |
---|
885 | !$$$move this into overloaded operator(*) in BaseTime |
---|
886 | ESMF_TimeIntervalProdI%basetime%S = & |
---|
887 | timeinterval%basetime%S * INT( multiplier, ESMF_KIND_I8 ) |
---|
888 | ESMF_TimeIntervalProdI%basetime%Sn = & |
---|
889 | timeinterval%basetime%Sn * INT( multiplier, ESMF_KIND_I8 ) |
---|
890 | ! Don't multiply Sd |
---|
891 | ESMF_TimeIntervalProdI%basetime%Sd = timeinterval%basetime%Sd |
---|
892 | CALL normalize_timeint( ESMF_TimeIntervalProdI ) |
---|
893 | |
---|
894 | end function ESMF_TimeIntervalProdI |
---|
895 | |
---|
896 | !------------------------------------------------------------------------------ |
---|
897 | ! |
---|
898 | ! This section includes the inherited ESMF_BaseTime class overloaded operators |
---|
899 | ! |
---|
900 | !------------------------------------------------------------------------------ |
---|
901 | !BOP |
---|
902 | ! !IROUTINE: ESMF_TimeIntervalSum - Add two time intervals together |
---|
903 | |
---|
904 | ! !INTERFACE: |
---|
905 | function ESMF_TimeIntervalSum(timeinterval1, timeinterval2) |
---|
906 | |
---|
907 | ! !RETURN VALUE: |
---|
908 | type(ESMF_TimeInterval) :: ESMF_TimeIntervalSum |
---|
909 | |
---|
910 | ! !ARGUMENTS: |
---|
911 | type(ESMF_TimeInterval), intent(in) :: timeinterval1 |
---|
912 | type(ESMF_TimeInterval), intent(in) :: timeinterval2 |
---|
913 | ! !LOCAL: |
---|
914 | integer :: rc |
---|
915 | ! !DESCRIPTION: |
---|
916 | ! Add two {\tt ESMF\_TimeIntervals}, return sum as a |
---|
917 | ! {\tt ESMF\_TimeInterval}. Maps overloaded (+) operator interface |
---|
918 | ! function to {\tt ESMF\_BaseTime} base class. |
---|
919 | ! |
---|
920 | ! The arguments are: |
---|
921 | ! \begin{description} |
---|
922 | ! \item[timeinterval1] |
---|
923 | ! The augend |
---|
924 | ! \item[timeinterval2] |
---|
925 | ! The addend |
---|
926 | ! \end{description} |
---|
927 | ! |
---|
928 | ! !REQUIREMENTS: |
---|
929 | ! TMG1.5.4, TMG2.4.4, TMG2.4.5, TMG2.4.6, TMG5.1, TMG5.2, |
---|
930 | ! TMG7.2 |
---|
931 | !EOP |
---|
932 | CALL timeintchecknormalized( timeinterval1, 'ESMF_TimeIntervalSum arg1' ) |
---|
933 | CALL timeintchecknormalized( timeinterval2, 'ESMF_TimeIntervalSum arg2' ) |
---|
934 | |
---|
935 | ESMF_TimeIntervalSum = timeinterval1 |
---|
936 | ESMF_TimeIntervalSum%basetime = ESMF_TimeIntervalSum%basetime + & |
---|
937 | timeinterval2%basetime |
---|
938 | |
---|
939 | CALL normalize_timeint( ESMF_TimeIntervalSum ) |
---|
940 | |
---|
941 | end function ESMF_TimeIntervalSum |
---|
942 | |
---|
943 | !------------------------------------------------------------------------------ |
---|
944 | !BOP |
---|
945 | ! !IROUTINE: ESMF_TimeIntervalDiff - Subtract one time interval from another |
---|
946 | |
---|
947 | ! !INTERFACE: |
---|
948 | function ESMF_TimeIntervalDiff(timeinterval1, timeinterval2) |
---|
949 | |
---|
950 | ! !RETURN VALUE: |
---|
951 | type(ESMF_TimeInterval) :: ESMF_TimeIntervalDiff |
---|
952 | |
---|
953 | ! !ARGUMENTS: |
---|
954 | type(ESMF_TimeInterval), intent(in) :: timeinterval1 |
---|
955 | type(ESMF_TimeInterval), intent(in) :: timeinterval2 |
---|
956 | ! !LOCAL: |
---|
957 | integer :: rc |
---|
958 | ! !DESCRIPTION: |
---|
959 | ! Subtract timeinterval2 from timeinterval1, return remainder as a |
---|
960 | ! {\tt ESMF\_TimeInterval}. |
---|
961 | ! Map overloaded (-) operator interface function to {\tt ESMF\_BaseTime} |
---|
962 | ! base class. |
---|
963 | ! |
---|
964 | ! The arguments are: |
---|
965 | ! \begin{description} |
---|
966 | ! \item[timeinterval1] |
---|
967 | ! The minuend |
---|
968 | ! \item[timeinterval2] |
---|
969 | ! The subtrahend |
---|
970 | ! \end{description} |
---|
971 | ! |
---|
972 | ! !REQUIREMENTS: |
---|
973 | ! TMG1.5.4, TMG2.4.4, TMG2.4.5, TMG2.4.6, TMG5.1, TMG5.2, TMG7.2 |
---|
974 | !EOP |
---|
975 | CALL timeintchecknormalized( timeinterval1, 'ESMF_TimeIntervalDiff arg1' ) |
---|
976 | CALL timeintchecknormalized( timeinterval2, 'ESMF_TimeIntervalDiff arg2' ) |
---|
977 | |
---|
978 | ESMF_TimeIntervalDiff = timeinterval1 |
---|
979 | ESMF_TimeIntervalDiff%basetime = ESMF_TimeIntervalDiff%basetime - & |
---|
980 | timeinterval2%basetime |
---|
981 | CALL normalize_timeint( ESMF_TimeIntervalDiff ) |
---|
982 | |
---|
983 | end function ESMF_TimeIntervalDiff |
---|
984 | |
---|
985 | !------------------------------------------------------------------------------ |
---|
986 | !BOP |
---|
987 | ! !IROUTINE: ESMF_TimeIntervalEQ - Compare two time intervals for equality |
---|
988 | |
---|
989 | ! !INTERFACE: |
---|
990 | function ESMF_TimeIntervalEQ(timeinterval1, timeinterval2) |
---|
991 | ! |
---|
992 | ! !RETURN VALUE: |
---|
993 | logical :: ESMF_TimeIntervalEQ |
---|
994 | |
---|
995 | ! !ARGUMENTS: |
---|
996 | type(ESMF_TimeInterval), intent(in) :: timeinterval1 |
---|
997 | type(ESMF_TimeInterval), intent(in) :: timeinterval2 |
---|
998 | |
---|
999 | !DESCRIPTION: |
---|
1000 | ! Return true if both given time intervals are equal, false otherwise. |
---|
1001 | ! Maps overloaded (==) operator interface function to {\tt ESMF\_BaseTime} |
---|
1002 | ! base class. |
---|
1003 | ! |
---|
1004 | ! The arguments are: |
---|
1005 | ! \begin{description} |
---|
1006 | ! \item[timeinterval1] |
---|
1007 | ! First time interval to compare |
---|
1008 | ! \item[timeinterval2] |
---|
1009 | ! Second time interval to compare |
---|
1010 | ! \end{description} |
---|
1011 | ! |
---|
1012 | ! !REQUIREMENTS: |
---|
1013 | ! TMG1.5.3, TMG2.4.3, TMG7.2 |
---|
1014 | !EOP |
---|
1015 | CALL timeintchecknormalized( timeinterval1, 'ESMF_TimeIntervalEQ arg1' ) |
---|
1016 | CALL timeintchecknormalized( timeinterval2, 'ESMF_TimeIntervalEQ arg2' ) |
---|
1017 | |
---|
1018 | !$$$here... move all this out of Meat.F90 ? |
---|
1019 | ! call ESMC_BaseTime base class function |
---|
1020 | call c_ESMC_BaseTimeIntEQ(timeinterval1, timeinterval2, ESMF_TimeIntervalEQ) |
---|
1021 | |
---|
1022 | end function ESMF_TimeIntervalEQ |
---|
1023 | |
---|
1024 | !------------------------------------------------------------------------------ |
---|
1025 | !BOP |
---|
1026 | ! !IROUTINE: ESMF_TimeIntervalNE - Compare two time intervals for inequality |
---|
1027 | |
---|
1028 | ! !INTERFACE: |
---|
1029 | function ESMF_TimeIntervalNE(timeinterval1, timeinterval2) |
---|
1030 | ! |
---|
1031 | ! !RETURN VALUE: |
---|
1032 | logical :: ESMF_TimeIntervalNE |
---|
1033 | |
---|
1034 | ! !ARGUMENTS: |
---|
1035 | type(ESMF_TimeInterval), intent(in) :: timeinterval1 |
---|
1036 | type(ESMF_TimeInterval), intent(in) :: timeinterval2 |
---|
1037 | |
---|
1038 | ! !DESCRIPTION: |
---|
1039 | ! Return true if both given time intervals are not equal, false otherwise. |
---|
1040 | ! Maps overloaded (/=) operator interface function to {\tt ESMF\_BaseTime} |
---|
1041 | ! base class. |
---|
1042 | ! |
---|
1043 | ! The arguments are: |
---|
1044 | ! \begin{description} |
---|
1045 | ! \item[timeinterval1] |
---|
1046 | ! First time interval to compare |
---|
1047 | ! \item[timeinterval2] |
---|
1048 | ! Second time interval to compare |
---|
1049 | ! \end{description} |
---|
1050 | ! |
---|
1051 | ! !REQUIREMENTS: |
---|
1052 | ! TMG1.5.3, TMG2.4.3, TMG7.2 |
---|
1053 | !EOP |
---|
1054 | CALL timeintchecknormalized( timeinterval1, 'ESMF_TimeIntervalNE arg1' ) |
---|
1055 | CALL timeintchecknormalized( timeinterval2, 'ESMF_TimeIntervalNE arg2' ) |
---|
1056 | |
---|
1057 | ! call ESMC_BaseTime base class function |
---|
1058 | call c_ESMC_BaseTimeIntNE(timeinterval1, timeinterval2, ESMF_TimeIntervalNE) |
---|
1059 | |
---|
1060 | end function ESMF_TimeIntervalNE |
---|
1061 | |
---|
1062 | !------------------------------------------------------------------------------ |
---|
1063 | !BOP |
---|
1064 | ! !IROUTINE: ESMF_TimeIntervalLT - Time interval 1 less than time interval 2 ? |
---|
1065 | |
---|
1066 | ! !INTERFACE: |
---|
1067 | function ESMF_TimeIntervalLT(timeinterval1, timeinterval2) |
---|
1068 | ! |
---|
1069 | ! !RETURN VALUE: |
---|
1070 | logical :: ESMF_TimeIntervalLT |
---|
1071 | |
---|
1072 | ! !ARGUMENTS: |
---|
1073 | type(ESMF_TimeInterval), intent(in) :: timeinterval1 |
---|
1074 | type(ESMF_TimeInterval), intent(in) :: timeinterval2 |
---|
1075 | |
---|
1076 | ! !DESCRIPTION: |
---|
1077 | ! Return true if first time interval is less than second time interval, |
---|
1078 | ! false otherwise. Maps overloaded (<) operator interface function to |
---|
1079 | ! {\tt ESMF\_BaseTime} base class. |
---|
1080 | ! |
---|
1081 | ! The arguments are: |
---|
1082 | ! \begin{description} |
---|
1083 | ! \item[timeinterval1] |
---|
1084 | ! First time interval to compare |
---|
1085 | ! \item[timeinterval2] |
---|
1086 | ! Second time interval to compare |
---|
1087 | ! \end{description} |
---|
1088 | ! |
---|
1089 | ! !REQUIREMENTS: |
---|
1090 | ! TMG1.5.3, TMG2.4.3, TMG7.2 |
---|
1091 | !EOP |
---|
1092 | CALL timeintchecknormalized( timeinterval1, 'ESMF_TimeIntervalLT arg1' ) |
---|
1093 | CALL timeintchecknormalized( timeinterval2, 'ESMF_TimeIntervalLT arg2' ) |
---|
1094 | |
---|
1095 | ! call ESMC_BaseTime base class function |
---|
1096 | call c_ESMC_BaseTimeIntLT(timeinterval1, timeinterval2, ESMF_TimeIntervalLT) |
---|
1097 | |
---|
1098 | end function ESMF_TimeIntervalLT |
---|
1099 | |
---|
1100 | !------------------------------------------------------------------------------ |
---|
1101 | !BOP |
---|
1102 | ! !IROUTINE: ESMF_TimeIntervalGT - Time interval 1 greater than time interval 2? |
---|
1103 | |
---|
1104 | ! !INTERFACE: |
---|
1105 | function ESMF_TimeIntervalGT(timeinterval1, timeinterval2) |
---|
1106 | ! |
---|
1107 | ! !RETURN VALUE: |
---|
1108 | logical :: ESMF_TimeIntervalGT |
---|
1109 | |
---|
1110 | ! !ARGUMENTS: |
---|
1111 | type(ESMF_TimeInterval), intent(in) :: timeinterval1 |
---|
1112 | type(ESMF_TimeInterval), intent(in) :: timeinterval2 |
---|
1113 | |
---|
1114 | ! !DESCRIPTION: |
---|
1115 | ! Return true if first time interval is greater than second time interval, |
---|
1116 | ! false otherwise. Maps overloaded (>) operator interface function to |
---|
1117 | ! {\tt ESMF\_BaseTime} base class. |
---|
1118 | ! |
---|
1119 | ! The arguments are: |
---|
1120 | ! \begin{description} |
---|
1121 | ! \item[timeinterval1] |
---|
1122 | ! First time interval to compare |
---|
1123 | ! \item[timeinterval2] |
---|
1124 | ! Second time interval to compare |
---|
1125 | ! \end{description} |
---|
1126 | ! |
---|
1127 | ! !REQUIREMENTS: |
---|
1128 | ! TMG1.5.3, TMG2.4.3, TMG7.2 |
---|
1129 | !EOP |
---|
1130 | CALL timeintchecknormalized( timeinterval1, 'ESMF_TimeIntervalGT arg1' ) |
---|
1131 | CALL timeintchecknormalized( timeinterval2, 'ESMF_TimeIntervalGT arg2' ) |
---|
1132 | |
---|
1133 | ! call ESMC_BaseTime base class function |
---|
1134 | call c_ESMC_BaseTimeIntGT(timeinterval1, timeinterval2, ESMF_TimeIntervalGT) |
---|
1135 | |
---|
1136 | end function ESMF_TimeIntervalGT |
---|
1137 | |
---|
1138 | !------------------------------------------------------------------------------ |
---|
1139 | !BOP |
---|
1140 | ! !IROUTINE: ESMF_TimeIntervalLE - Time interval 1 less than or equal to time interval 2 ? |
---|
1141 | |
---|
1142 | ! !INTERFACE: |
---|
1143 | function ESMF_TimeIntervalLE(timeinterval1, timeinterval2) |
---|
1144 | |
---|
1145 | ! !RETURN VALUE: |
---|
1146 | logical :: ESMF_TimeIntervalLE |
---|
1147 | |
---|
1148 | ! !ARGUMENTS: |
---|
1149 | type(ESMF_TimeInterval), intent(in) :: timeinterval1 |
---|
1150 | type(ESMF_TimeInterval), intent(in) :: timeinterval2 |
---|
1151 | |
---|
1152 | ! !DESCRIPTION: |
---|
1153 | ! Return true if first time interval is less than or equal to second time |
---|
1154 | ! interval, false otherwise. |
---|
1155 | ! Maps overloaded (<=) operator interface function to {\tt ESMF\_BaseTime} |
---|
1156 | ! base class. |
---|
1157 | ! |
---|
1158 | ! The arguments are: |
---|
1159 | ! \begin{description} |
---|
1160 | ! \item[timeinterval1] |
---|
1161 | ! First time interval to compare |
---|
1162 | ! \item[timeinterval2] |
---|
1163 | ! Second time interval to compare |
---|
1164 | ! \end{description} |
---|
1165 | ! |
---|
1166 | ! !REQUIREMENTS: |
---|
1167 | ! TMG1.5.3, TMG2.4.3, TMG7.2 |
---|
1168 | !EOP |
---|
1169 | CALL timeintchecknormalized( timeinterval1, 'ESMF_TimeIntervalLE arg1' ) |
---|
1170 | CALL timeintchecknormalized( timeinterval2, 'ESMF_TimeIntervalLE arg2' ) |
---|
1171 | |
---|
1172 | ! call ESMC_BaseTime base class function |
---|
1173 | call c_ESMC_BaseTimeIntLE(timeinterval1, timeinterval2, ESMF_TimeIntervalLE) |
---|
1174 | |
---|
1175 | end function ESMF_TimeIntervalLE |
---|
1176 | |
---|
1177 | !------------------------------------------------------------------------------ |
---|
1178 | !BOP |
---|
1179 | ! !IROUTINE: ESMF_TimeIntervalGE - Time interval 1 greater than or equal to time interval 2 ? |
---|
1180 | |
---|
1181 | ! !INTERFACE: |
---|
1182 | function ESMF_TimeIntervalGE(timeinterval1, timeinterval2) |
---|
1183 | ! |
---|
1184 | ! !RETURN VALUE: |
---|
1185 | logical :: ESMF_TimeIntervalGE |
---|
1186 | |
---|
1187 | ! !ARGUMENTS: |
---|
1188 | type(ESMF_TimeInterval), intent(in) :: timeinterval1 |
---|
1189 | type(ESMF_TimeInterval), intent(in) :: timeinterval2 |
---|
1190 | |
---|
1191 | ! !DESCRIPTION: |
---|
1192 | ! Return true if first time interval is greater than or equal to second |
---|
1193 | ! time interval, false otherwise. Maps overloaded (>=) operator interface |
---|
1194 | ! function to {\tt ESMF\_BaseTime} base class. |
---|
1195 | ! |
---|
1196 | ! The arguments are: |
---|
1197 | ! \begin{description} |
---|
1198 | ! \item[timeinterval1] |
---|
1199 | ! First time interval to compare |
---|
1200 | ! \item[timeinterval2] |
---|
1201 | ! Second time interval to compare |
---|
1202 | ! \end{description} |
---|
1203 | ! |
---|
1204 | ! !REQUIREMENTS: |
---|
1205 | ! TMG1.5.3, TMG2.4.3, TMG7.2 |
---|
1206 | !EOP |
---|
1207 | CALL timeintchecknormalized( timeinterval1, 'ESMF_TimeIntervalGE arg1' ) |
---|
1208 | CALL timeintchecknormalized( timeinterval2, 'ESMF_TimeIntervalGE arg2' ) |
---|
1209 | |
---|
1210 | ! call ESMC_BaseTime base class function |
---|
1211 | call c_ESMC_BaseTimeIntGE(timeinterval1, timeinterval2, ESMF_TimeIntervalGE) |
---|
1212 | |
---|
1213 | end function ESMF_TimeIntervalGE |
---|
1214 | |
---|
1215 | |
---|
1216 | !------------------------------------------------------------------------------ |
---|
1217 | !BOP |
---|
1218 | ! !IROUTINE: ESMF_TimeIntervalIsPositive - Time interval greater than zero? |
---|
1219 | |
---|
1220 | ! !INTERFACE: |
---|
1221 | function ESMF_TimeIntervalIsPositive(timeinterval) |
---|
1222 | ! |
---|
1223 | ! !RETURN VALUE: |
---|
1224 | logical :: ESMF_TimeIntervalIsPositive |
---|
1225 | |
---|
1226 | ! !ARGUMENTS: |
---|
1227 | type(ESMF_TimeInterval), intent(in) :: timeinterval |
---|
1228 | |
---|
1229 | ! !LOCALS: |
---|
1230 | type(ESMF_TimeInterval) :: zerotimeint |
---|
1231 | integer :: rcint |
---|
1232 | |
---|
1233 | ! !DESCRIPTION: |
---|
1234 | ! Return true if time interval is greater than zero, |
---|
1235 | ! false otherwise. |
---|
1236 | ! |
---|
1237 | ! The arguments are: |
---|
1238 | ! \begin{description} |
---|
1239 | ! \item[timeinterval] |
---|
1240 | ! Time interval to compare |
---|
1241 | ! \end{description} |
---|
1242 | !EOP |
---|
1243 | CALL timeintchecknormalized( timeinterval, & |
---|
1244 | 'ESMF_TimeIntervalIsPositive arg' ) |
---|
1245 | |
---|
1246 | CALL ESMF_TimeIntervalSet ( zerotimeint, rc=rcint ) |
---|
1247 | IF ( rcint /= ESMF_SUCCESS ) THEN |
---|
1248 | CALL wrf_error_fatal( & |
---|
1249 | 'ESMF_TimeIntervalIsPositive: ESMF_TimeIntervalSet failed' ) |
---|
1250 | ENDIF |
---|
1251 | ! hack for bug in PGI 5.1-x |
---|
1252 | ! ESMF_TimeIntervalIsPositive = timeinterval > zerotimeint |
---|
1253 | ESMF_TimeIntervalIsPositive = ESMF_TimeIntervalGT( timeinterval, & |
---|
1254 | zerotimeint ) |
---|
1255 | end function ESMF_TimeIntervalIsPositive |
---|
1256 | |
---|
1257 | end module ESMF_TimeIntervalMod |
---|
1258 | |
---|
1259 | |
---|