source: lmdz_wrf/WRFV3/external/esmf_time_f90/Meat.F90 @ 1

Last change on this file since 1 was 1, checked in by lfita, 10 years ago
  • -- --- Opening of the WRF+LMDZ coupling repository --- -- -

WRF: version v3.3
LMDZ: version v1818

More details in:

File size: 26.2 KB
Line 
1#include <ESMF_TimeMgr.inc>
2
3! Factor so abs(Sn) < Sd and ensure that signs of S and Sn match. 
4! Also, enforce consistency. 
5! YR and MM fields are ignored. 
6
7SUBROUTINE normalize_basetime( basetime )
8  USE esmf_basemod
9  USE esmf_basetimemod
10  IMPLICIT NONE
11  TYPE(ESMF_BaseTime), INTENT(INOUT) :: basetime
12!PRINT *,'DEBUG:  BEGIN normalize_basetime()'
13  ! Consistency check... 
14  IF ( basetime%Sd < 0 ) THEN
15    CALL wrf_error_fatal( &
16      'normalize_basetime:  denominator of seconds cannot be negative' )
17  ENDIF
18  IF ( ( basetime%Sd == 0 ) .AND. ( basetime%Sn .NE. 0 ) ) THEN
19    CALL wrf_error_fatal( &
20      'normalize_basetime:  denominator of seconds cannot be zero when numerator is non-zero' )
21  ENDIF
22  ! factor so abs(Sn) < Sd
23  IF ( basetime%Sd > 0 ) THEN
24    IF ( ABS( basetime%Sn ) .GE. basetime%Sd ) THEN
25!PRINT *,'DEBUG:  normalize_basetime() A1:  S,Sn,Sd = ',basetime%S,basetime%Sn,basetime%Sd
26      basetime%S = basetime%S + ( basetime%Sn / basetime%Sd )
27      basetime%Sn = mod( basetime%Sn, basetime%Sd )
28!PRINT *,'DEBUG:  normalize_basetime() A2:  S,Sn,Sd = ',basetime%S,basetime%Sn,basetime%Sd
29    ENDIF
30    ! change sign of Sn if it does not match S
31    IF ( ( basetime%S > 0 ) .AND. ( basetime%Sn < 0 ) ) THEN
32!PRINT *,'DEBUG:  normalize_basetime() B1:  S,Sn,Sd = ',basetime%S,basetime%Sn,basetime%Sd
33      basetime%S = basetime%S - 1_ESMF_KIND_I8
34      basetime%Sn = basetime%Sn + basetime%Sd
35!PRINT *,'DEBUG:  normalize_basetime() B2:  S,Sn,Sd = ',basetime%S,basetime%Sn,basetime%Sd
36    ENDIF
37    IF ( ( basetime%S < 0 ) .AND. ( basetime%Sn > 0 ) ) THEN
38!PRINT *,'DEBUG:  normalize_basetime() C1:  S,Sn,Sd = ',basetime%S,basetime%Sn,basetime%Sd
39      basetime%S = basetime%S + 1_ESMF_KIND_I8
40      basetime%Sn = basetime%Sn - basetime%Sd
41!PRINT *,'DEBUG:  normalize_basetime() C2:  S,Sn,Sd = ',basetime%S,basetime%Sn,basetime%Sd
42    ENDIF
43  ENDIF
44!PRINT *,'DEBUG:  END normalize_basetime()'
45END SUBROUTINE normalize_basetime
46
47
48
49! A normalized time has time%basetime >= 0, time%basetime less than the current
50! year expressed as a timeInterval, and time%YR can take any value
51SUBROUTINE normalize_time( time )
52  USE esmf_basemod
53  USE esmf_basetimemod
54  USE esmf_timemod
55  IMPLICIT NONE
56  TYPE(ESMF_Time), INTENT(INOUT) :: time
57  INTEGER(ESMF_KIND_I8) :: nsecondsinyear
58  ! locals
59  TYPE(ESMF_BaseTime) :: cmptime, zerotime
60  INTEGER :: rc
61  LOGICAL :: done
62
63  ! first, normalize basetime
64  ! this will force abs(Sn) < Sd and ensure that signs of S and Sn match
65  CALL normalize_basetime( time%basetime )
66
67!$$$ add tests for these edge cases
68
69  ! next, underflow negative seconds into YEARS
70  ! time%basetime must end up non-negative
71!$$$ push this down into ESMF_BaseTime constructor
72  zerotime%S  = 0
73  zerotime%Sn = 0
74  zerotime%Sd = 0
75  DO WHILE ( time%basetime < zerotime )
76    time%YR = time%YR - 1
77!$$$ push this down into ESMF_BaseTime constructor
78    cmptime%S  = nsecondsinyear( time%YR )
79    cmptime%Sn = 0
80    cmptime%Sd = 0
81    time%basetime = time%basetime + cmptime
82  ENDDO
83
84  ! next, overflow seconds into YEARS
85  done = .FALSE.
86  DO WHILE ( .NOT. done )
87!$$$ push this down into ESMF_BaseTime constructor
88    cmptime%S  = nsecondsinyear( time%YR )
89    cmptime%Sn = 0
90    cmptime%Sd = 0
91    IF ( time%basetime >= cmptime ) THEN
92      time%basetime = time%basetime - cmptime
93      time%YR = time%YR + 1
94    ELSE
95      done = .TRUE.
96    ENDIF
97  ENDDO
98END SUBROUTINE normalize_time
99
100
101
102SUBROUTINE normalize_timeint( timeInt )
103  USE esmf_basetimemod
104  USE esmf_timeintervalmod
105  IMPLICIT NONE
106  TYPE(ESMF_TimeInterval), INTENT(INOUT) :: timeInt
107
108  ! normalize basetime
109  ! this will force abs(Sn) < Sd and ensure that signs of S and Sn match
110  ! YR and MM are ignored
111  CALL normalize_basetime( timeInt%basetime )
112END SUBROUTINE normalize_timeint
113
114
115
116
117FUNCTION signnormtimeint ( timeInt )
118  ! Compute the sign of a time interval. 
119  ! YR and MM fields are *IGNORED*. 
120  ! returns 1, 0, or -1 or exits if timeInt fields have inconsistent signs.
121  USE esmf_basemod
122  USE esmf_basetimemod
123  USE esmf_timeintervalmod
124  IMPLICIT NONE
125  TYPE(ESMF_TimeInterval), INTENT(IN) :: timeInt
126  INTEGER :: signnormtimeint
127  LOGICAL :: positive, negative
128
129  positive = .FALSE.
130  negative = .FALSE.
131  signnormtimeint = 0
132  ! Note that Sd is required to be non-negative.  This is enforced in
133  ! normalize_timeint(). 
134  ! Note that Sn is required to be zero when Sd is zero.  This is enforced
135  ! in normalize_timeint(). 
136  IF ( ( timeInt%basetime%S > 0 ) .OR. &
137       ( timeInt%basetime%Sn > 0 ) ) THEN
138    positive = .TRUE.
139  ENDIF
140  IF ( ( timeInt%basetime%S < 0 ) .OR. &
141       ( timeInt%basetime%Sn < 0 ) ) THEN
142    negative = .TRUE.
143  ENDIF
144  IF ( positive .AND. negative ) THEN
145    CALL wrf_error_fatal( &
146      'signnormtimeint:  signs of fields cannot be mixed' )
147  ELSE IF ( positive ) THEN
148    signnormtimeint = 1
149  ELSE IF ( negative ) THEN
150    signnormtimeint = -1
151  ENDIF
152END FUNCTION signnormtimeint
153
154
155! Exits with error message if timeInt is not normalized. 
156SUBROUTINE timeintchecknormalized( timeInt, msgstr )
157  USE esmf_timeintervalmod
158  IMPLICIT NONE
159  TYPE(ESMF_TimeInterval), INTENT(IN) :: timeInt
160  CHARACTER(LEN=*), INTENT(IN) :: msgstr
161  ! locals
162  CHARACTER(LEN=256) :: outstr
163  IF ( ( timeInt%YR /= 0 ) ) THEN
164    outstr = 'un-normalized TimeInterval not allowed:  '//TRIM(msgstr)
165    CALL wrf_error_fatal( outstr )
166  ENDIF
167END SUBROUTINE timeintchecknormalized
168
169
170! added from share/module_date_time in WRF.
171FUNCTION nfeb ( year ) RESULT (num_days)
172      ! Compute the number of days in February for the given year
173      IMPLICIT NONE
174      INTEGER :: year
175      INTEGER :: num_days
176! TBH:  TODO:  Replace this hack with run-time decision based on
177! TBH:  TODO:  passed-in calendar. 
178#ifdef NO_LEAP_CALENDAR
179      num_days = 28 ! By default, February has 28 days ...
180#else
181      num_days = 28 ! By default, February has 28 days ...
182      IF (MOD(year,4).eq.0) THEN
183         num_days = 29  ! But every four years, it has 29 days ...
184         IF (MOD(year,100).eq.0) THEN
185            num_days = 28  ! Except every 100 years, when it has 28 days ...
186            IF (MOD(year,400).eq.0) THEN
187               num_days = 29  ! Except every 400 years, when it has 29 days.
188            END IF
189         END IF
190      END IF
191#endif
192END FUNCTION nfeb
193
194
195
196FUNCTION ndaysinyear ( year ) RESULT (num_diy)
197  ! Compute the number of days in the given year
198  IMPLICIT NONE
199  INTEGER, INTENT(IN) :: year
200  INTEGER :: num_diy
201  INTEGER :: nfeb
202#if defined MARS
203  num_diy = 669
204#elif defined TITAN
205  num_diy = 686
206#else
207  IF ( nfeb( year ) .EQ. 29 ) THEN
208    num_diy = 366
209  ELSE
210    num_diy = 365
211  ENDIF
212#endif
213END FUNCTION ndaysinyear
214
215
216
217FUNCTION nsecondsinyear ( year ) RESULT (numseconds)
218  ! Compute the number of seconds in the given year
219  USE esmf_basemod
220  IMPLICIT NONE
221  INTEGER, INTENT(IN) :: year
222  INTEGER(ESMF_KIND_I8) :: numseconds
223  INTEGER :: ndaysinyear
224  numseconds = SECONDS_PER_DAY * INT( ndaysinyear(year) , ESMF_KIND_I8 )
225END FUNCTION nsecondsinyear
226
227
228
229SUBROUTINE initdaym
230  USE esmf_basemod
231  USE esmf_basetimemod
232  USE ESMF_CalendarMod, only : months_per_year, mday, daym, mdaycum, monthbdys, &
233                               mdayleap, mdayleapcum, monthbdysleap, daymleap
234  IMPLICIT NONE
235  INTEGER i,j,m
236  m = 1
237  mdaycum(0) = 0
238!$$$ push this down into ESMF_BaseTime constructor
239  monthbdys(0)%S  = 0
240  monthbdys(0)%Sn = 0
241  monthbdys(0)%Sd = 0
242  DO i = 1,MONTHS_PER_YEAR
243    DO j = 1,mday(i)
244      daym(m) = i
245      m = m + 1
246    ENDDO
247    mdaycum(i) = mdaycum(i-1) + mday(i)
248!$$$ push this down into ESMF_BaseTime constructor
249    monthbdys(i)%S  = SECONDS_PER_DAY * INT( mdaycum(i), ESMF_KIND_I8 )
250    monthbdys(i)%Sn = 0
251    monthbdys(i)%Sd = 0
252  ENDDO
253  m = 1
254  mdayleapcum(0) = 0
255!$$$ push this down into ESMF_BaseTime constructor
256  monthbdysleap(0)%S  = 0
257  monthbdysleap(0)%Sn = 0
258  monthbdysleap(0)%Sd = 0
259  DO i = 1,MONTHS_PER_YEAR
260    DO j = 1,mdayleap(i)
261      daymleap(m) = i
262      m = m + 1
263    ENDDO
264    mdayleapcum(i) = mdayleapcum(i-1) + mdayleap(i)
265!$$$ push this down into ESMF_BaseTime constructor
266    monthbdysleap(i)%S  = SECONDS_PER_DAY * INT( mdayleapcum(i), ESMF_KIND_I8 )
267    monthbdysleap(i)%Sn = 0
268    monthbdysleap(i)%Sd = 0
269  ENDDO
270END SUBROUTINE initdaym
271
272
273!$$$ useful, but not used at the moment... 
274SUBROUTINE compute_dayinyear(YR,MM,DD,dayinyear)
275  use ESMF_CalendarMod, only : mday
276IMPLICIT NONE
277      INTEGER, INTENT(IN)  :: YR,MM,DD   ! DD is day of month
278      INTEGER, INTENT(OUT) :: dayinyear
279      INTEGER i
280      integer nfeb
281
282#ifdef PLANET
283      dayinyear = DD
284#else
285      dayinyear = 0
286      DO i = 1,MM-1
287        if (i.eq.2) then
288          dayinyear = dayinyear + nfeb(YR)
289        else
290          dayinyear = dayinyear + mday(i)
291        endif
292      ENDDO
293      dayinyear = dayinyear + DD
294#endif
295END SUBROUTINE compute_dayinyear
296
297
298
299SUBROUTINE timegetmonth( time, MM )
300  USE esmf_basemod
301  USE esmf_basetimemod
302  USE esmf_timemod
303  USE ESMF_CalendarMod, only : MONTHS_PER_YEAR, monthbdys, monthbdysleap
304  IMPLICIT NONE
305  TYPE(ESMF_Time), INTENT(IN) :: time
306  INTEGER, INTENT(OUT) :: MM
307  ! locals
308  INTEGER :: nfeb
309  INTEGER :: i
310#if defined PLANET
311  MM = 0
312#else
313  MM = -1
314  IF ( nfeb(time%YR) == 29 ) THEN
315    DO i = 1,MONTHS_PER_YEAR
316      IF ( ( time%basetime >= monthbdysleap(i-1) ) .AND. ( time%basetime < monthbdysleap(i) ) ) THEN
317        MM = i
318        EXIT
319      ENDIF
320    ENDDO
321  ELSE
322    DO i = 1,MONTHS_PER_YEAR
323      IF ( ( time%basetime >= monthbdys(i-1) ) .AND. ( time%basetime < monthbdys(i) ) ) THEN
324        MM = i
325        EXIT
326      ENDIF
327    ENDDO
328  ENDIF
329#endif
330  IF ( MM == -1 ) THEN
331    CALL wrf_error_fatal( 'timegetmonth:  could not extract month of year from time' )
332  ENDIF
333END SUBROUTINE timegetmonth
334
335
336!$$$ may need to change dependencies in Makefile... 
337
338SUBROUTINE timegetdayofmonth( time, DD )
339  USE esmf_basemod
340  USE esmf_basetimemod
341  USE esmf_timemod
342  USE esmf_calendarmod, only : monthbdys, monthbdysleap
343  IMPLICIT NONE
344  TYPE(ESMF_Time), INTENT(IN) :: time
345  INTEGER, INTENT(OUT) :: DD
346  ! locals
347  INTEGER :: nfeb
348  INTEGER :: MM
349  TYPE(ESMF_BaseTime) :: tmpbasetime
350#if defined PLANET
351  tmpbasetime = time%basetime
352#else
353  CALL timegetmonth( time, MM )
354  IF ( nfeb(time%YR) == 29 ) THEN
355    tmpbasetime = time%basetime - monthbdysleap(MM-1)
356  ELSE
357    tmpbasetime = time%basetime - monthbdys(MM-1)
358  ENDIF
359#endif
360  DD = ( tmpbasetime%S / SECONDS_PER_DAY ) + 1
361END SUBROUTINE timegetdayofmonth
362
363
364! Increment Time by number of seconds between start of year and start
365! of month MM. 
366! 1 <= MM <= 12
367! Time is NOT normalized. 
368SUBROUTINE timeaddmonths( time, MM, ierr )
369  USE esmf_basemod
370  USE esmf_basetimemod
371  USE esmf_timemod
372  USE esmf_calendarmod, only : MONTHS_PER_YEAR, monthbdys, monthbdysleap
373  IMPLICIT NONE
374  TYPE(ESMF_Time), INTENT(INOUT) :: time
375  INTEGER, INTENT(IN) :: MM
376  INTEGER, INTENT(OUT) :: ierr
377  ! locals
378  INTEGER :: nfeb
379  ierr = ESMF_SUCCESS
380!  PRINT *,'DEBUG:  BEGIN timeaddmonths()'
381#if defined PLANET
382!  time%basetime = time%basetime
383#else
384  IF ( ( MM < 1 ) .OR. ( MM > MONTHS_PER_YEAR ) ) THEN
385    ierr = ESMF_FAILURE
386  ELSE
387    IF ( nfeb(time%YR) == 29 ) THEN
388      time%basetime = time%basetime + monthbdysleap(MM-1)
389    ELSE
390      time%basetime = time%basetime + monthbdys(MM-1)
391    ENDIF
392  ENDIF
393#endif
394END SUBROUTINE timeaddmonths
395
396
397! Increment Time by number of seconds in the current month. 
398! Time is NOT normalized. 
399SUBROUTINE timeincmonth( time )
400  USE esmf_basemod
401  USE esmf_basetimemod
402  USE esmf_timemod
403  USE esmf_calendarmod, only : mday, mdayleap
404  IMPLICIT NONE
405  TYPE(ESMF_Time), INTENT(INOUT) :: time
406  ! locals
407  INTEGER :: nfeb
408  INTEGER :: MM
409#if defined PLANET
410!    time%basetime%S = time%basetime%S
411#else
412  CALL timegetmonth( time, MM )
413  IF ( nfeb(time%YR) == 29 ) THEN
414    time%basetime%S = time%basetime%S + &
415      ( INT( mdayleap(MM), ESMF_KIND_I8 ) * SECONDS_PER_DAY )
416  ELSE
417    time%basetime%S = time%basetime%S + &
418      ( INT( mday(MM), ESMF_KIND_I8 ) * SECONDS_PER_DAY )
419  ENDIF
420#endif
421END SUBROUTINE timeincmonth
422
423
424
425! Decrement Time by number of seconds in the previous month. 
426! Time is NOT normalized. 
427SUBROUTINE timedecmonth( time )
428  USE esmf_basemod
429  USE esmf_basetimemod
430  USE esmf_timemod
431  USE esmf_calendarmod, only : mday, months_per_year, mdayleap
432  IMPLICIT NONE
433  TYPE(ESMF_Time), INTENT(INOUT) :: time
434  ! locals
435  INTEGER :: nfeb
436  INTEGER :: MM
437#if defined PLANET
438!    time%basetime%S = time%basetime%S
439#else
440  CALL timegetmonth( time, MM )  ! current month, 1-12
441  ! find previous month
442  MM = MM - 1
443  IF ( MM == 0 ) THEN
444    ! wrap around Jan -> Dec
445    MM = MONTHS_PER_YEAR
446  ENDIF
447  IF ( nfeb(time%YR) == 29 ) THEN
448    time%basetime%S = time%basetime%S - &
449      ( INT( mdayleap(MM), ESMF_KIND_I8 ) * SECONDS_PER_DAY )
450  ELSE
451    time%basetime%S = time%basetime%S - &
452      ( INT( mday(MM), ESMF_KIND_I8 ) * SECONDS_PER_DAY )
453  ENDIF
454#endif
455END SUBROUTINE timedecmonth
456
457
458
459! spaceship operator for Times
460SUBROUTINE timecmp(time1, time2, retval )
461  USE esmf_basemod
462  USE esmf_basetimemod
463  USE esmf_timemod
464  IMPLICIT NONE
465  INTEGER, INTENT(OUT) :: retval
466!
467! !ARGUMENTS:
468  TYPE(ESMF_Time), INTENT(IN) :: time1
469  TYPE(ESMF_Time), INTENT(IN) :: time2
470  IF ( time1%YR .GT. time2%YR ) THEN ; retval = 1 ; RETURN ; ENDIF
471  IF ( time1%YR .LT. time2%YR ) THEN ; retval = -1 ; RETURN ; ENDIF
472  CALL seccmp( time1%basetime%S, time1%basetime%Sn, time1%basetime%Sd, &
473               time2%basetime%S, time2%basetime%Sn, time2%basetime%Sd, &
474               retval )
475END SUBROUTINE timecmp
476
477
478
479! spaceship operator for TimeIntervals
480SUBROUTINE timeintcmp(timeint1, timeint2, retval )
481  USE esmf_basemod
482  USE esmf_basetimemod
483  USE esmf_timeintervalmod
484  IMPLICIT NONE
485  INTEGER, INTENT(OUT) :: retval
486!
487! !ARGUMENTS:
488  TYPE(ESMF_TimeInterval), INTENT(IN) :: timeint1
489  TYPE(ESMF_TimeInterval), INTENT(IN) :: timeint2
490  CALL timeintchecknormalized( timeint1, 'timeintcmp arg1' )
491  CALL timeintchecknormalized( timeint2, 'timeintcmp arg2' )
492  CALL seccmp( timeint1%basetime%S, timeint1%basetime%Sn, &
493               timeint1%basetime%Sd,                      &
494               timeint2%basetime%S, timeint2%basetime%Sn, &
495               timeint2%basetime%Sd, retval )
496END SUBROUTINE timeintcmp
497
498
499
500! spaceship operator for seconds + Sn/Sd
501SUBROUTINE seccmp(S1, Sn1, Sd1, S2, Sn2, Sd2, retval )
502  USE esmf_basemod
503  IMPLICIT NONE
504  INTEGER, INTENT(OUT) :: retval
505!
506! !ARGUMENTS:
507  INTEGER(ESMF_KIND_I8), INTENT(IN) :: S1, Sn1, Sd1
508  INTEGER(ESMF_KIND_I8), INTENT(IN) :: S2, Sn2, Sd2
509! local
510  INTEGER(ESMF_KIND_I8) :: lcd, n1, n2
511
512  n1 = Sn1
513  n2 = Sn2
514  if ( ( n1 .ne. 0 ) .or. ( n2 .ne. 0 ) ) then
515    CALL compute_lcd( Sd1, Sd2, lcd )
516    if ( Sd1 .ne. 0 ) n1 = n1 * ( lcd / Sd1 )
517    if ( Sd2 .ne. 0 ) n2 = n2 * ( lcd / Sd2 )
518  endif
519
520  if ( S1 .GT. S2 ) retval = 1
521  if ( S1 .LT. S2 ) retval = -1
522  IF ( S1 .EQ. S2 ) THEN
523    IF (n1 .GT. n2) retval = 1
524    IF (n1 .LT. n2) retval = -1
525    IF (n1 .EQ. n2) retval = 0
526  ENDIF
527END SUBROUTINE seccmp
528
529
530SUBROUTINE c_esmc_basetimeeq (time1, time2, outflag)
531  USE esmf_alarmmod
532  USE esmf_basemod
533  USE esmf_basetimemod
534  USE esmf_calendarmod
535  USE esmf_clockmod
536  USE esmf_fractionmod
537  USE esmf_timeintervalmod
538  USE esmf_timemod
539IMPLICIT NONE
540      logical, intent(OUT) :: outflag
541      type(ESMF_Time), intent(in) :: time1
542      type(ESMF_Time), intent(in) :: time2
543      integer res
544      CALL timecmp(time1,time2,res)
545      outflag = (res .EQ. 0)
546END SUBROUTINE c_esmc_basetimeeq
547SUBROUTINE c_esmc_basetimege(time1, time2, outflag)
548  USE esmf_alarmmod
549  USE esmf_basemod
550  USE esmf_basetimemod
551  USE esmf_calendarmod
552  USE esmf_clockmod
553  USE esmf_fractionmod
554  USE esmf_timeintervalmod
555  USE esmf_timemod
556      logical, intent(OUT) :: outflag
557      type(ESMF_Time), intent(in) :: time1
558      type(ESMF_Time), intent(in) :: time2
559      integer res
560      CALL timecmp(time1,time2,res)
561      outflag = (res .EQ. 1 .OR. res .EQ. 0)
562END SUBROUTINE c_esmc_basetimege
563SUBROUTINE c_esmc_basetimegt(time1, time2, outflag)
564  USE esmf_alarmmod
565  USE esmf_basemod
566  USE esmf_basetimemod
567  USE esmf_calendarmod
568  USE esmf_clockmod
569  USE esmf_fractionmod
570  USE esmf_timeintervalmod
571  USE esmf_timemod
572IMPLICIT NONE
573      logical, intent(OUT) :: outflag
574      type(ESMF_Time), intent(in) :: time1
575      type(ESMF_Time), intent(in) :: time2
576      integer res
577      CALL timecmp(time1,time2,res)
578      outflag = (res .EQ. 1)
579END SUBROUTINE c_esmc_basetimegt
580SUBROUTINE c_esmc_basetimele(time1, time2, outflag)
581  USE esmf_alarmmod
582  USE esmf_basemod
583  USE esmf_basetimemod
584  USE esmf_calendarmod
585  USE esmf_clockmod
586  USE esmf_fractionmod
587  USE esmf_timeintervalmod
588  USE esmf_timemod
589IMPLICIT NONE
590      logical, intent(OUT) :: outflag
591      type(ESMF_Time), intent(in) :: time1
592      type(ESMF_Time), intent(in) :: time2
593      integer res
594      CALL timecmp(time1,time2,res)
595      outflag = (res .EQ. -1 .OR. res .EQ. 0)
596END SUBROUTINE c_esmc_basetimele
597SUBROUTINE c_esmc_basetimelt(time1, time2, outflag)
598  USE esmf_alarmmod
599  USE esmf_basemod
600  USE esmf_basetimemod
601  USE esmf_calendarmod
602  USE esmf_clockmod
603  USE esmf_fractionmod
604  USE esmf_timeintervalmod
605  USE esmf_timemod
606IMPLICIT NONE
607      logical, intent(OUT) :: outflag
608      type(ESMF_Time), intent(in) :: time1
609      type(ESMF_Time), intent(in) :: time2
610      integer res
611      CALL timecmp(time1,time2,res)
612      outflag = (res .EQ. -1)
613END SUBROUTINE c_esmc_basetimelt
614SUBROUTINE c_esmc_basetimene(time1, time2, outflag)
615  USE esmf_alarmmod
616  USE esmf_basemod
617  USE esmf_basetimemod
618  USE esmf_calendarmod
619  USE esmf_clockmod
620  USE esmf_fractionmod
621  USE esmf_timeintervalmod
622  USE esmf_timemod
623IMPLICIT NONE
624      logical, intent(OUT) :: outflag
625      type(ESMF_Time), intent(in) :: time1
626      type(ESMF_Time), intent(in) :: time2
627      integer res
628      CALL timecmp(time1,time2,res)
629      outflag = (res .NE. 0)
630END SUBROUTINE c_esmc_basetimene
631
632SUBROUTINE c_esmc_basetimeinteq(timeint1, timeint2, outflag)
633  USE esmf_timeintervalmod
634  IMPLICIT NONE
635  LOGICAL, INTENT(OUT) :: outflag
636  TYPE(ESMF_TimeInterval), INTENT(IN) :: timeint1
637  TYPE(ESMF_TimeInterval), INTENT(IN) :: timeint2
638  INTEGER :: res
639  CALL timeintcmp(timeint1,timeint2,res)
640  outflag = (res .EQ. 0)
641END SUBROUTINE c_esmc_basetimeinteq
642SUBROUTINE c_esmc_basetimeintne(timeint1, timeint2, outflag)
643  USE esmf_timeintervalmod
644  IMPLICIT NONE
645  LOGICAL, INTENT(OUT) :: outflag
646  TYPE(ESMF_TimeInterval), INTENT(IN) :: timeint1
647  TYPE(ESMF_TimeInterval), INTENT(IN) :: timeint2
648  INTEGER :: res
649  CALL timeintcmp(timeint1,timeint2,res)
650  outflag = (res .NE. 0)
651END SUBROUTINE c_esmc_basetimeintne
652SUBROUTINE c_esmc_basetimeintlt(timeint1, timeint2, outflag)
653  USE esmf_timeintervalmod
654  IMPLICIT NONE
655  LOGICAL, INTENT(OUT) :: outflag
656  TYPE(ESMF_TimeInterval), INTENT(IN) :: timeint1
657  TYPE(ESMF_TimeInterval), INTENT(IN) :: timeint2
658  INTEGER :: res
659  CALL timeintcmp(timeint1,timeint2,res)
660  outflag = (res .LT. 0)
661END SUBROUTINE c_esmc_basetimeintlt
662SUBROUTINE c_esmc_basetimeintgt(timeint1, timeint2, outflag)
663  USE esmf_timeintervalmod
664  IMPLICIT NONE
665  LOGICAL, INTENT(OUT) :: outflag
666  TYPE(ESMF_TimeInterval), INTENT(IN) :: timeint1
667  TYPE(ESMF_TimeInterval), INTENT(IN) :: timeint2
668  INTEGER :: res
669  CALL timeintcmp(timeint1,timeint2,res)
670  outflag = (res .GT. 0)
671END SUBROUTINE c_esmc_basetimeintgt
672SUBROUTINE c_esmc_basetimeintle(timeint1, timeint2, outflag)
673  USE esmf_timeintervalmod
674  IMPLICIT NONE
675  LOGICAL, INTENT(OUT) :: outflag
676  TYPE(ESMF_TimeInterval), INTENT(IN) :: timeint1
677  TYPE(ESMF_TimeInterval), INTENT(IN) :: timeint2
678  INTEGER :: res
679  CALL timeintcmp(timeint1,timeint2,res)
680  outflag = (res .LE. 0)
681END SUBROUTINE c_esmc_basetimeintle
682SUBROUTINE c_esmc_basetimeintge(timeint1, timeint2, outflag)
683  USE esmf_timeintervalmod
684  IMPLICIT NONE
685  LOGICAL, INTENT(OUT) :: outflag
686  TYPE(ESMF_TimeInterval), INTENT(IN) :: timeint1
687  TYPE(ESMF_TimeInterval), INTENT(IN) :: timeint2
688  INTEGER :: res
689  CALL timeintcmp(timeint1,timeint2,res)
690  outflag = (res .GE. 0)
691END SUBROUTINE c_esmc_basetimeintge
692
693SUBROUTINE compute_lcd( e1, e2, lcd )
694  USE esmf_basemod
695      IMPLICIT NONE
696      INTEGER(ESMF_KIND_I8), INTENT(IN) :: e1, e2
697      INTEGER(ESMF_KIND_I8), INTENT(OUT) :: lcd
698      INTEGER, PARAMETER ::  nprimes = 9
699      INTEGER(ESMF_KIND_I8), DIMENSION(nprimes), PARAMETER :: primes = (/2,3,5,7,11,13,17,19,23/)
700      INTEGER i
701      INTEGER(ESMF_KIND_I8) d1, d2, p
702
703      d1 = e1 ; d2 = e2
704      IF ( d1 .EQ. 0 .AND. d2 .EQ. 0 ) THEN ; lcd = 1 ; RETURN ; ENDIF
705      IF ( d1 .EQ. 0 ) d1 = d2
706      IF ( d2 .EQ. 0 ) d2 = d1
707      IF ( d1 .EQ. d2 ) THEN ; lcd = d1 ; RETURN ; ENDIF
708      lcd = d1 * d2
709      DO i = 1, nprimes
710        p = primes(i)
711        DO WHILE (lcd/p .NE. 0 .AND. &
712          mod(lcd/p,d1) .EQ. 0 .AND. mod(lcd/p,d2) .EQ. 0)
713          lcd = lcd / p
714        END DO
715      ENDDO
716END SUBROUTINE compute_lcd
717
718SUBROUTINE simplify( ni, di, no, do )
719  USE esmf_basemod
720    IMPLICIT NONE
721    INTEGER(ESMF_KIND_I8), INTENT(IN)  :: ni, di
722    INTEGER(ESMF_KIND_I8), INTENT(OUT) :: no, do
723    INTEGER, PARAMETER ::  nprimes = 9
724    INTEGER(ESMF_KIND_I8), DIMENSION(nprimes), PARAMETER :: primes = (/2,3,5,7,11,13,17,19,23/)
725    INTEGER(ESMF_KIND_I8) :: pr, d, n
726    INTEGER :: np
727    LOGICAL keepgoing
728    IF ( ni .EQ. 0 ) THEN
729      do = 1
730      no = 0
731      RETURN
732    ENDIF
733    IF ( mod( di , ni ) .EQ. 0 ) THEN
734      do = di / ni
735      no = 1
736      RETURN
737    ENDIF
738    d = di
739    n = ni
740    DO np = 1, nprimes
741      pr = primes(np)
742      keepgoing = .TRUE.
743      DO WHILE ( keepgoing )
744        keepgoing = .FALSE.
745        IF ( d/pr .NE. 0 .AND. n/pr .NE. 0 .AND. MOD(d,pr) .EQ. 0 .AND. MOD(n,pr) .EQ. 0 ) THEN
746          d = d / pr
747          n = n / pr
748          keepgoing = .TRUE.
749        ENDIF
750      ENDDO
751    ENDDO
752    do = d
753    no = n
754    RETURN
755END SUBROUTINE simplify
756
757
758!$$$ this should be named "c_esmc_timesum" or something less misleading
759SUBROUTINE c_esmc_basetimesum( time1, timeinterval, timeOut )
760  USE esmf_basemod
761  USE esmf_basetimemod
762  USE esmf_timeintervalmod
763  USE esmf_timemod
764  IMPLICIT NONE
765  TYPE(ESMF_Time), INTENT(IN) :: time1
766  TYPE(ESMF_TimeInterval), INTENT(IN) :: timeinterval
767  TYPE(ESMF_Time), INTENT(INOUT) :: timeOut
768  ! locals
769  INTEGER :: m
770  timeOut = time1
771  timeOut%basetime = timeOut%basetime + timeinterval%basetime
772#if 0
773!jm Month has no meaning for a timeinterval; removed 20100319
774#if defined PLANET
775  ! Do nothing...
776#else
777 DO m = 1, abs(timeinterval%MM)
778    IF ( timeinterval%MM > 0 ) THEN
779      CALL timeincmonth( timeOut )
780    ELSE
781      CALL timedecmonth( timeOut )
782    ENDIF
783  ENDDO
784#endif
785#endif
786  timeOut%YR = timeOut%YR + timeinterval%YR
787  CALL normalize_time( timeOut )
788END SUBROUTINE c_esmc_basetimesum
789
790
791!$$$ this should be named "c_esmc_timedec" or something less misleading
792SUBROUTINE c_esmc_basetimedec( time1, timeinterval, timeOut )
793  USE esmf_basemod
794  USE esmf_basetimemod
795  USE esmf_timeintervalmod
796  USE esmf_timemod
797  IMPLICIT NONE
798  TYPE(ESMF_Time), INTENT(IN) :: time1
799  TYPE(ESMF_TimeInterval), INTENT(IN) :: timeinterval
800  TYPE(ESMF_Time), INTENT(OUT) :: timeOut
801  ! locals
802  TYPE (ESMF_TimeInterval)  :: neginterval
803  neginterval = timeinterval
804!$$$push this down into a unary negation operator on TimeInterval
805  neginterval%basetime%S = -neginterval%basetime%S
806  neginterval%basetime%Sn = -neginterval%basetime%Sn
807  neginterval%YR = -neginterval%YR
808#if 0
809!jm month has no meaning for an interval; removed 20100319
810#ifndef PLANET
811  neginterval%MM = -neginterval%MM
812#endif
813#endif
814  timeOut = time1 + neginterval
815END SUBROUTINE c_esmc_basetimedec
816
817
818!$$$ this should be named "c_esmc_timediff" or something less misleading
819SUBROUTINE c_esmc_basetimediff( time1, time2, timeIntOut )
820  USE esmf_basemod
821  USE esmf_basetimemod
822  USE esmf_timeintervalmod
823  USE esmf_timemod
824  IMPLICIT NONE
825  TYPE(ESMF_Time), INTENT(IN) :: time1
826  TYPE(ESMF_Time), INTENT(IN) :: time2
827  TYPE(ESMF_TimeInterval), INTENT(OUT) :: timeIntOut
828  ! locals
829  INTEGER(ESMF_KIND_I8) :: nsecondsinyear
830  INTEGER :: yr
831  CALL ESMF_TimeIntervalSet( timeIntOut )
832  timeIntOut%basetime = time1%basetime - time2%basetime
833  ! convert difference in years to basetime... 
834  IF ( time1%YR > time2%YR ) THEN
835    DO yr = time2%YR, ( time1%YR - 1 )
836      timeIntOut%basetime%S = timeIntOut%basetime%S + nsecondsinyear( yr )
837    ENDDO
838  ELSE IF ( time2%YR > time1%YR ) THEN
839    DO yr = time1%YR, ( time2%YR - 1 )
840      timeIntOut%basetime%S = timeIntOut%basetime%S - nsecondsinyear( yr )
841    ENDDO
842  ENDIF
843!$$$ add tests for multi-year differences
844  CALL normalize_timeint( timeIntOut )
845END SUBROUTINE c_esmc_basetimediff
846
847
848! some extra wrf stuff
849
850
851! Convert fraction to string with leading sign.
852! If fraction simplifies to a whole number or if
853! denominator is zero, return empty string.
854! INTEGER*8 interface. 
855SUBROUTINE fraction_to_stringi8( numerator, denominator, frac_str )
856  USE ESMF_basemod
857  IMPLICIT NONE
858  INTEGER(ESMF_KIND_I8), INTENT(IN) :: numerator
859  INTEGER(ESMF_KIND_I8), INTENT(IN) :: denominator
860  CHARACTER (LEN=*), INTENT(OUT) :: frac_str
861  IF ( denominator > 0 ) THEN
862    IF ( mod( numerator, denominator ) /= 0 ) THEN
863      IF ( numerator > 0 ) THEN
864        WRITE(frac_str,FMT="('+',I2.2,'/',I2.2)") abs(numerator), denominator
865      ELSE   ! numerator < 0
866        WRITE(frac_str,FMT="('-',I2.2,'/',I2.2)") abs(numerator), denominator
867      ENDIF
868    ELSE   ! includes numerator == 0 case
869      frac_str = ''
870    ENDIF
871  ELSE   ! no-fraction case
872    frac_str = ''
873  ENDIF
874END SUBROUTINE fraction_to_stringi8
875
876
877! Convert fraction to string with leading sign.
878! If fraction simplifies to a whole number or if
879! denominator is zero, return empty string.
880! INTEGER interface. 
881SUBROUTINE fraction_to_string( numerator, denominator, frac_str )
882  USE ESMF_basemod
883  IMPLICIT NONE
884  INTEGER, INTENT(IN) :: numerator
885  INTEGER, INTENT(IN) :: denominator
886  CHARACTER (LEN=*), INTENT(OUT) :: frac_str
887  ! locals
888  INTEGER(ESMF_KIND_I8) :: numerator_i8, denominator_i8
889  numerator_i8 = INT( numerator, ESMF_KIND_I8 )
890  denominator_i8 = INT( denominator, ESMF_KIND_I8 )
891  CALL fraction_to_stringi8( numerator_i8, denominator_i8, frac_str )
892END SUBROUTINE fraction_to_string
893
894
895SUBROUTINE print_a_time( time )
896   use ESMF_basemod
897   use ESMF_Timemod
898   IMPLICIT NONE
899   type(ESMF_Time) time
900   character*128 :: s
901   integer rc
902   CALL ESMF_TimeGet( time, timeString=s, rc=rc )
903   print *,'Print a time|',TRIM(s),'|'
904   return
905END SUBROUTINE print_a_time
906
907SUBROUTINE print_a_timeinterval( time )
908   use ESMF_basemod
909   use ESMF_TimeIntervalmod
910   IMPLICIT NONE
911   type(ESMF_TimeInterval) time
912   character*128 :: s
913   integer rc
914   CALL ESMFold_TimeIntervalGetString( time, s, rc )
915   print *,'Print a time interval|',TRIM(s),'|'
916   return
917END SUBROUTINE print_a_timeinterval
918
Note: See TracBrowser for help on using the repository browser.