ESMF_BaseTime.F90
References to this file elsewhere.
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 BaseTime Module
13 module ESMF_BaseTimeMod
14 !
15 !==============================================================================
16 !
17 ! This file contains the BaseTime class definition and all BaseTime class
18 ! methods.
19 !
20 !------------------------------------------------------------------------------
21 ! INCLUDES
22
23 #include <ESMF_TimeMgr.inc>
24 !
25 !===============================================================================
26 !BOPI
27 ! !MODULE: ESMF_BaseTimeMod - Base ESMF time definition
28 !
29 ! !DESCRIPTION:
30 ! Part of Time Manager F90 API wrapper of C++ implemenation
31 !
32 ! This module serves only as the common Time definition inherited
33 ! by {\tt ESMF\_TimeInterval} and {\tt ESMF\_Time}
34 !
35 ! See {\tt ../include/ESMC\_BaseTime.h} for complete description
36 !
37 !------------------------------------------------------------------------------
38 ! !USES:
39 use ESMF_BaseMod ! ESMF Base class
40 implicit none
41 !
42 !------------------------------------------------------------------------------
43 ! !PRIVATE TYPES:
44 private
45 !------------------------------------------------------------------------------
46 ! ! ESMF_BaseTime
47 !
48 ! ! Base class type to match C++ BaseTime class in size only;
49 ! ! all dereferencing within class is performed by C++ implementation
50
51 type ESMF_BaseTime
52 integer(ESMF_KIND_I8) :: S ! whole seconds
53 integer(ESMF_KIND_I8) :: Sn ! fractional seconds, numerator
54 integer(ESMF_KIND_I8) :: Sd ! fractional seconds, denominator
55 end type
56
57 !------------------------------------------------------------------------------
58 ! !PUBLIC TYPES:
59 public ESMF_BaseTime
60 !------------------------------------------------------------------------------
61 !
62 ! !PUBLIC MEMBER FUNCTIONS:
63 !
64 ! overloaded operators
65 public operator(+)
66 private ESMF_BaseTimeSum
67 public operator(-)
68 private ESMF_BaseTimeDifference
69 public operator(/)
70 private ESMF_BaseTimeQuotI
71 private ESMF_BaseTimeQuotI8
72 public operator(.EQ.)
73 private ESMF_BaseTimeEQ
74 public operator(.NE.)
75 private ESMF_BaseTimeNE
76 public operator(.LT.)
77 private ESMF_BaseTimeLT
78 public operator(.GT.)
79 private ESMF_BaseTimeGT
80 public operator(.LE.)
81 private ESMF_BaseTimeLE
82 public operator(.GE.)
83 private ESMF_BaseTimeGE
84
85 !==============================================================================
86 !
87 ! INTERFACE BLOCKS
88 !
89 !==============================================================================
90 interface operator(+)
91 module procedure ESMF_BaseTimeSum
92 end interface
93 interface operator(-)
94 module procedure ESMF_BaseTimeDifference
95 end interface
96 interface operator(/)
97 module procedure ESMF_BaseTimeQuotI,ESMF_BaseTimeQuotI8
98 end interface
99 interface operator(.EQ.)
100 module procedure ESMF_BaseTimeEQ
101 end interface
102 interface operator(.NE.)
103 module procedure ESMF_BaseTimeNE
104 end interface
105 interface operator(.LT.)
106 module procedure ESMF_BaseTimeLT
107 end interface
108 interface operator(.GT.)
109 module procedure ESMF_BaseTimeGT
110 end interface
111 interface operator(.LE.)
112 module procedure ESMF_BaseTimeLE
113 end interface
114 interface operator(.GE.)
115 module procedure ESMF_BaseTimeGE
116 end interface
117
118
119 !==============================================================================
120
121 contains
122
123 !==============================================================================
124
125
126 ! Add two basetimes
127 FUNCTION ESMF_BaseTimeSum( basetime1, basetime2 )
128 TYPE(ESMF_BaseTime) :: ESMF_BaseTimeSum
129 TYPE(ESMF_BaseTime), INTENT(IN) :: basetime1
130 TYPE(ESMF_BaseTime), INTENT(IN) :: basetime2
131 ! locals
132 INTEGER (ESMF_KIND_I8) :: Sn1, Sd1, Sn2, Sd2, lcd
133 ! PRINT *,'DEBUG: BEGIN ESMF_BaseTimeSum()'
134 ! PRINT *,'DEBUG: ESMF_BaseTimeSum(): basetime1%S = ',basetime1%S
135 ! PRINT *,'DEBUG: ESMF_BaseTimeSum(): basetime1%Sn = ',basetime1%Sn
136 ! PRINT *,'DEBUG: ESMF_BaseTimeSum(): basetime1%Sd = ',basetime1%Sd
137 ! PRINT *,'DEBUG: ESMF_BaseTimeSum(): basetime2%S = ',basetime2%S
138 ! PRINT *,'DEBUG: ESMF_BaseTimeSum(): basetime2%Sn = ',basetime2%Sn
139 ! PRINT *,'DEBUG: ESMF_BaseTimeSum(): basetime2%Sd = ',basetime2%Sd
140 ESMF_BaseTimeSum = basetime1
141 ESMF_BaseTimeSum%S = ESMF_BaseTimeSum%S + basetime2%S
142 Sn1 = basetime1%Sn
143 Sd1 = basetime1%Sd
144 Sn2 = basetime2%Sn
145 Sd2 = basetime2%Sd
146 ! PRINT *,'DEBUG: ESMF_BaseTimeSum(): Sn1 = ',Sn1
147 ! PRINT *,'DEBUG: ESMF_BaseTimeSum(): Sd1 = ',Sd1
148 ! PRINT *,'DEBUG: ESMF_BaseTimeSum(): Sn2 = ',Sn2
149 ! PRINT *,'DEBUG: ESMF_BaseTimeSum(): Sd2 = ',Sd2
150 IF ( ( Sd1 .EQ. 0 ) .AND. ( Sd2 .EQ. 0 ) ) THEN
151 ! PRINT *,'DEBUG: ESMF_BaseTimeSum(): no fractions'
152 ESMF_BaseTimeSum%Sn = 0
153 ESMF_BaseTimeSum%Sd = 0
154 ELSE IF ( ( Sd1 .NE. 0 ) .AND. ( Sd2 .EQ. 0 ) ) THEN
155 ESMF_BaseTimeSum%Sn = Sn1
156 ESMF_BaseTimeSum%Sd = Sd1
157 ELSE IF ( ( Sd1 .EQ. 0 ) .AND. ( Sd2 .NE. 0 ) ) THEN
158 ESMF_BaseTimeSum%Sn = Sn2
159 ESMF_BaseTimeSum%Sd = Sd2
160 ELSE IF ( ( Sd1 .NE. 0 ) .AND. ( Sd2 .NE. 0 ) ) THEN
161 CALL compute_lcd( Sd1 , Sd2 , lcd )
162 ESMF_BaseTimeSum%Sd = lcd
163 ESMF_BaseTimeSum%Sn = (Sn1 * lcd / Sd1) + (Sn2 * lcd / Sd2)
164 ENDIF
165 ! PRINT *,'DEBUG: ESMF_BaseTimeSum(): ESMF_BaseTimeSum%S = ',ESMF_BaseTimeSum%S
166 ! PRINT *,'DEBUG: ESMF_BaseTimeSum(): ESMF_BaseTimeSum%Sn = ',ESMF_BaseTimeSum%Sn
167 ! PRINT *,'DEBUG: ESMF_BaseTimeSum(): ESMF_BaseTimeSum%Sd = ',ESMF_BaseTimeSum%Sd
168 CALL normalize_basetime( ESMF_BaseTimeSum )
169 ! PRINT *,'DEBUG: END ESMF_BaseTimeSum()'
170 END FUNCTION ESMF_BaseTimeSum
171
172
173 ! Subtract two basetimes
174 FUNCTION ESMF_BaseTimeDifference( basetime1, basetime2 )
175 TYPE(ESMF_BaseTime) :: ESMF_BaseTimeDifference
176 TYPE(ESMF_BaseTime), INTENT(IN) :: basetime1
177 TYPE(ESMF_BaseTime), INTENT(IN) :: basetime2
178 ! locals
179 TYPE(ESMF_BaseTime) :: neg2
180
181 neg2%S = -basetime2%S
182 neg2%Sn = -basetime2%Sn
183 neg2%Sd = basetime2%Sd
184
185 ESMF_BaseTimeDifference = basetime1 + neg2
186
187 END FUNCTION ESMF_BaseTimeDifference
188
189
190 ! Divide basetime by 8-byte integer
191 FUNCTION ESMF_BaseTimeQuotI8( basetime, divisor )
192 TYPE(ESMF_BaseTime) :: ESMF_BaseTimeQuotI8
193 TYPE(ESMF_BaseTime), INTENT(IN) :: basetime
194 INTEGER(ESMF_KIND_I8), INTENT(IN) :: divisor
195 ! locals
196 INTEGER(ESMF_KIND_I8) :: d, n, dinit
197
198 !PRINT *,'DEBUG ESMF_BaseTimeQuotI8() A: S,Sn,Sd = ', &
199 ! basetime%S,basetime%Sn,basetime%Sd
200 !PRINT *,'DEBUG ESMF_BaseTimeQuotI8() A: divisor = ', divisor
201 IF ( divisor == 0_ESMF_KIND_I8 ) THEN
202 CALL wrf_error_fatal( 'ESMF_BaseTimeQuotI8: divide by zero' )
203 ENDIF
204
205 !$$$ move to default constructor
206 ESMF_BaseTimeQuotI8%S = 0
207 ESMF_BaseTimeQuotI8%Sn = 0
208 ESMF_BaseTimeQuotI8%Sd = 0
209
210 ! convert to a fraction and divide by multipling the denonminator by
211 ! the divisor
212 IF ( basetime%Sd == 0 ) THEN
213 dinit = 1_ESMF_KIND_I8
214 ELSE
215 dinit = basetime%Sd
216 ENDIF
217 n = basetime%S * dinit + basetime%Sn
218 d = dinit * divisor
219 !PRINT *,'DEBUG ESMF_BaseTimeQuotI8() B: n,d = ',n,d
220 CALL simplify( n, d, ESMF_BaseTimeQuotI8%Sn, ESMF_BaseTimeQuotI8%Sd )
221 !PRINT *,'DEBUG ESMF_BaseTimeQuotI8() C: S,Sn,Sd = ', &
222 ! ESMF_BaseTimeQuotI8%S,ESMF_BaseTimeQuotI8%Sn,ESMF_BaseTimeQuotI8%Sd
223 CALL normalize_basetime( ESMF_BaseTimeQuotI8 )
224 !PRINT *,'DEBUG ESMF_BaseTimeQuotI8() D: S,Sn,Sd = ', &
225 ! ESMF_BaseTimeQuotI8%S,ESMF_BaseTimeQuotI8%Sn,ESMF_BaseTimeQuotI8%Sd
226 END FUNCTION ESMF_BaseTimeQuotI8
227
228 ! Divide basetime by integer
229 FUNCTION ESMF_BaseTimeQuotI( basetime, divisor )
230 TYPE(ESMF_BaseTime) :: ESMF_BaseTimeQuotI
231 TYPE(ESMF_BaseTime), INTENT(IN) :: basetime
232 INTEGER, INTENT(IN) :: divisor
233 IF ( divisor == 0 ) THEN
234 CALL wrf_error_fatal( 'ESMF_BaseTimeQuotI: divide by zero' )
235 ENDIF
236 ESMF_BaseTimeQuotI = basetime / INT( divisor, ESMF_KIND_I8 )
237 END FUNCTION ESMF_BaseTimeQuotI
238
239
240 ! .EQ. for two basetimes
241 FUNCTION ESMF_BaseTimeEQ( basetime1, basetime2 )
242 LOGICAL :: ESMF_BaseTimeEQ
243 TYPE(ESMF_BaseTime), INTENT(IN) :: basetime1
244 TYPE(ESMF_BaseTime), INTENT(IN) :: basetime2
245 INTEGER :: retval
246 CALL seccmp( basetime1%S, basetime1%Sn, basetime1%Sd, &
247 basetime2%S, basetime2%Sn, basetime2%Sd, &
248 retval )
249 ESMF_BaseTimeEQ = ( retval .EQ. 0 )
250 END FUNCTION ESMF_BaseTimeEQ
251
252
253 ! .NE. for two basetimes
254 FUNCTION ESMF_BaseTimeNE( basetime1, basetime2 )
255 LOGICAL :: ESMF_BaseTimeNE
256 TYPE(ESMF_BaseTime), INTENT(IN) :: basetime1
257 TYPE(ESMF_BaseTime), INTENT(IN) :: basetime2
258 INTEGER :: retval
259 CALL seccmp( basetime1%S, basetime1%Sn, basetime1%Sd, &
260 basetime2%S, basetime2%Sn, basetime2%Sd, &
261 retval )
262 ESMF_BaseTimeNE = ( retval .NE. 0 )
263 END FUNCTION ESMF_BaseTimeNE
264
265
266 ! .LT. for two basetimes
267 FUNCTION ESMF_BaseTimeLT( basetime1, basetime2 )
268 LOGICAL :: ESMF_BaseTimeLT
269 TYPE(ESMF_BaseTime), INTENT(IN) :: basetime1
270 TYPE(ESMF_BaseTime), INTENT(IN) :: basetime2
271 INTEGER :: retval
272 CALL seccmp( basetime1%S, basetime1%Sn, basetime1%Sd, &
273 basetime2%S, basetime2%Sn, basetime2%Sd, &
274 retval )
275 ESMF_BaseTimeLT = ( retval .LT. 0 )
276 END FUNCTION ESMF_BaseTimeLT
277
278
279 ! .GT. for two basetimes
280 FUNCTION ESMF_BaseTimeGT( basetime1, basetime2 )
281 LOGICAL :: ESMF_BaseTimeGT
282 TYPE(ESMF_BaseTime), INTENT(IN) :: basetime1
283 TYPE(ESMF_BaseTime), INTENT(IN) :: basetime2
284 INTEGER :: retval
285 CALL seccmp( basetime1%S, basetime1%Sn, basetime1%Sd, &
286 basetime2%S, basetime2%Sn, basetime2%Sd, &
287 retval )
288 ESMF_BaseTimeGT = ( retval .GT. 0 )
289 END FUNCTION ESMF_BaseTimeGT
290
291
292 ! .LE. for two basetimes
293 FUNCTION ESMF_BaseTimeLE( basetime1, basetime2 )
294 LOGICAL :: ESMF_BaseTimeLE
295 TYPE(ESMF_BaseTime), INTENT(IN) :: basetime1
296 TYPE(ESMF_BaseTime), INTENT(IN) :: basetime2
297 INTEGER :: retval
298 CALL seccmp( basetime1%S, basetime1%Sn, basetime1%Sd, &
299 basetime2%S, basetime2%Sn, basetime2%Sd, &
300 retval )
301 ESMF_BaseTimeLE = ( retval .LE. 0 )
302 END FUNCTION ESMF_BaseTimeLE
303
304
305 ! .GE. for two basetimes
306 FUNCTION ESMF_BaseTimeGE( basetime1, basetime2 )
307 LOGICAL :: ESMF_BaseTimeGE
308 TYPE(ESMF_BaseTime), INTENT(IN) :: basetime1
309 TYPE(ESMF_BaseTime), INTENT(IN) :: basetime2
310 INTEGER :: retval
311 CALL seccmp( basetime1%S, basetime1%Sn, basetime1%Sd, &
312 basetime2%S, basetime2%Sn, basetime2%Sd, &
313 retval )
314 ESMF_BaseTimeGE = ( retval .GE. 0 )
315 END FUNCTION ESMF_BaseTimeGE
316
317
318 end module ESMF_BaseTimeMod