source: trunk/WRF.COMMON/WRFV3/external/esmf_time_f90/ESMF_TimeInterval.F90 @ 2759

Last change on this file since 2759 was 2759, checked in by aslmd, 2 years ago

adding unmodified code from WRFV3.0.1.1, expurged from useless data +1M size

File size: 38.8 KB
Line 
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
Note: See TracBrowser for help on using the repository browser.