| 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 GPL. |
|---|
| 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 |
|---|
