external/esmf_time_f90/ESMF_BaseTime.F90

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