PageRenderTime 39ms CodeModel.GetById 13ms RepoModel.GetById 1ms app.codeStats 0ms

/wrfv2_fire/external/esmf_time_f90/ESMF_BaseTime.F90

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