PageRenderTime 41ms CodeModel.GetById 14ms RepoModel.GetById 0ms app.codeStats 0ms

/wrfv2_fire/share/module_date_time.F

http://github.com/jbeezley/wrf-fire
FORTRAN Legacy | 1005 lines | 642 code | 164 blank | 199 comment | 0 complexity | bc849709d77a72f25ef1fdb8a569142f MD5 | raw file
Possible License(s): AGPL-1.0
  1. !WRF:MODEL_LAYER:UTIL
  2. !
  3. MODULE module_date_time
  4. USE module_wrf_error
  5. USE module_configure
  6. USE module_model_constants
  7. CHARACTER* 24 :: start_date = ' '
  8. CHARACTER* 24 :: current_date
  9. INTEGER , PARAMETER :: len_current_date = 24
  10. REAL , PRIVATE :: xtime
  11. ! 1. geth_idts (ndate, odate, idts)
  12. ! Get the time period between two dates.
  13. ! 2. geth_newdate ( ndate, odate, idts)
  14. ! Get the new date based on the old date and a time difference.
  15. ! 3. split_date_char ( date , century_year , month , day , hour , minute , second , ten_thousandth)
  16. ! Given the date, return the integer components.
  17. CONTAINS
  18. !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  19. SUBROUTINE get_julgmt(date_str,julyr,julday,gmt)
  20. IMPLICIT NONE
  21. ! Arguments
  22. CHARACTER (LEN=24) , INTENT(IN) :: date_str
  23. INTEGER, INTENT(OUT ) :: julyr
  24. INTEGER, INTENT(OUT ) :: julday
  25. REAL , INTENT(OUT ) :: gmt
  26. ! Local
  27. INTEGER :: ny , nm , nd , nh , ni , ns , nt
  28. INTEGER :: my1, my2, my3, monss
  29. INTEGER, DIMENSION(12) :: mmd
  30. DATA MMD/31,28,31,30,31,30,31,31,30,31,30,31/
  31. CALL split_date_char ( date_str , ny , nm , nd , nh , ni , ns , nt )
  32. #ifdef PLANET
  33. GMT=nh+FLOAT(ni)/60.+(FLOAT(ns)+FLOAT(nt)/1.e6)/3600.
  34. JULDAY=nd
  35. JULYR=ny
  36. #else
  37. GMT=nh+FLOAT(ni)/60.+FLOAT(ns)/3600.
  38. MY1=MOD(ny,4)
  39. MY2=MOD(ny,100)
  40. MY3=MOD(ny,400)
  41. IF(MY1.EQ.0.AND.MY2.NE.0.OR.MY3.EQ.0)MMD(2)=29
  42. JULDAY=nd
  43. JULYR=ny
  44. DO MONSS=1,nm-1
  45. JULDAY=JULDAY+MMD(MONSS)
  46. ENDDO
  47. #endif
  48. END SUBROUTINE get_julgmt
  49. SUBROUTINE geth_julgmt(julyr,julday, gmt)
  50. IMPLICIT NONE
  51. ! Arguments
  52. INTEGER, INTENT(OUT ) :: julyr
  53. INTEGER, INTENT(OUT ) :: julday
  54. REAL , INTENT(OUT ) :: gmt
  55. ! Local
  56. INTEGER :: ny , nm , nd , nh , ni , ns , nt
  57. INTEGER :: my1, my2, my3, monss
  58. INTEGER, DIMENSION(12) :: mmd
  59. DATA MMD/31,28,31,30,31,30,31,31,30,31,30,31/
  60. CALL split_date_char ( current_date , ny , nm , nd , nh , ni , ns , nt )
  61. #ifdef PLANET
  62. GMT=nh+FLOAT(ni)/60.+(FLOAT(ns)+FLOAT(nt)/1.e6)/3600.
  63. JULDAY=nd
  64. JULYR=ny
  65. #else
  66. GMT=nh+FLOAT(ni)/60.+FLOAT(ns)/3600.
  67. MY1=MOD(ny,4)
  68. MY2=MOD(ny,100)
  69. MY3=MOD(ny,400)
  70. IF(MY1.EQ.0.AND.MY2.NE.0.OR.MY3.EQ.0)MMD(2)=29
  71. JULDAY=nd
  72. JULYR=ny
  73. DO MONSS=1,nm-1
  74. JULDAY=JULDAY+MMD(MONSS)
  75. ENDDO
  76. #endif
  77. END SUBROUTINE geth_julgmt
  78. SUBROUTINE calc_current_date (id, time)
  79. ! This subroutines calculates current_date and xtime
  80. IMPLICIT NONE
  81. ! Arguments
  82. INTEGER, INTENT(IN ) :: id ! grid id
  83. REAL, INTENT(IN ) :: time ! time in seconds since start time
  84. ! Local
  85. INTEGER :: julyr, julday, idt
  86. CHARACTER*19 new_date
  87. CHARACTER*24 base_date
  88. CHARACTER*128 mess
  89. REAL :: gmt
  90. xtime = time/60.
  91. CALL nl_get_gmt (id, gmt)
  92. CALL nl_get_julyr (id, julyr)
  93. CALL nl_get_julday (id, julday)
  94. idt = 86400*(julday-1)+nint(3600*gmt)
  95. write (mess,*) 'calc_current_date called: time = ',time,' idt = ',idt
  96. CALL wrf_debug(300,TRIM(mess))
  97. write (mess,*) 'calc_current_date called: gmt = ',gmt
  98. CALL wrf_debug(300,TRIM(mess))
  99. write (mess,*) 'calc_current_date called: julyr = ',julyr
  100. CALL wrf_debug(300,TRIM(mess))
  101. write (mess,*) 'calc_current_date called: julday = ',julday
  102. CALL wrf_debug(300,TRIM(mess))
  103. #ifdef PLANET
  104. base_date = '0000-00001_00:00:00.0000'
  105. #else
  106. base_date = '0000-01-01_00:00:00.0000'
  107. #endif
  108. write(base_date(1:4),'(I4.4)')julyr
  109. CALL geth_newdate (start_date(1:19), base_date(1:19), idt)
  110. CALL geth_newdate (new_date, start_date(1:19), nint(time))
  111. write (current_date(1:24),fmt=340)new_date
  112. 340 format(a19, '.0000')
  113. write (mess,*) current_date,gmt,julday,julyr,'=current_date,gmt,julday,julyr: calc_current_date'
  114. CALL wrf_debug(300,TRIM(mess))
  115. END SUBROUTINE calc_current_date
  116. !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  117. SUBROUTINE geth_idts (ndate, odate, idts)
  118. IMPLICIT NONE
  119. ! From 2 input mdates ('YYYY-MM-DD HH:MM:SS.ffff'),
  120. ! or ('YYYY-DDDDD HH:MM:SS.ffff'),
  121. ! compute the time difference.
  122. ! on entry - ndate - the new hdate.
  123. ! odate - the old hdate.
  124. ! on exit - idts - the change in time in seconds.
  125. CHARACTER (LEN=*) , INTENT(INOUT) :: ndate, odate
  126. INTEGER , INTENT(OUT) :: idts
  127. ! Local Variables
  128. ! yrnew - indicates the year associated with "ndate"
  129. ! yrold - indicates the year associated with "odate"
  130. ! monew - indicates the month associated with "ndate"
  131. ! moold - indicates the month associated with "odate"
  132. ! dynew - indicates the day associated with "ndate"
  133. ! dyold - indicates the day associated with "odate"
  134. ! hrnew - indicates the hour associated with "ndate"
  135. ! hrold - indicates the hour associated with "odate"
  136. ! minew - indicates the minute associated with "ndate"
  137. ! miold - indicates the minute associated with "odate"
  138. ! scnew - indicates the second associated with "ndate"
  139. ! scold - indicates the second associated with "odate"
  140. ! i - loop counter
  141. ! mday - a list assigning the number of days in each month
  142. CHARACTER (LEN=24) :: tdate
  143. INTEGER :: olen, nlen
  144. INTEGER :: yrnew, monew, dynew, hrnew, minew, scnew
  145. INTEGER :: yrold, moold, dyold, hrold, miold, scold
  146. INTEGER :: mday(12), i, newdys, olddys
  147. LOGICAL :: npass, opass
  148. INTEGER :: isign
  149. IF (odate.GT.ndate) THEN
  150. isign = -1
  151. tdate=ndate
  152. ndate=odate
  153. odate=tdate
  154. ELSE
  155. isign = 1
  156. END IF
  157. ! Assign the number of days in a months
  158. mday( 1) = 31
  159. mday( 2) = 28
  160. mday( 3) = 31
  161. mday( 4) = 30
  162. mday( 5) = 31
  163. mday( 6) = 30
  164. mday( 7) = 31
  165. mday( 8) = 31
  166. mday( 9) = 30
  167. mday(10) = 31
  168. mday(11) = 30
  169. mday(12) = 31
  170. ! Break down old hdate into parts
  171. hrold = 0
  172. miold = 0
  173. scold = 0
  174. olen = LEN(odate)
  175. READ(odate(1:4), '(I4)') yrold
  176. #ifdef PLANET
  177. READ(odate(6:10), '(I5)') dyold
  178. moold=0.
  179. #else
  180. READ(odate(6:7), '(I2)') moold
  181. READ(odate(9:10), '(I2)') dyold
  182. #endif
  183. IF (olen.GE.13) THEN
  184. READ(odate(12:13),'(I2)') hrold
  185. IF (olen.GE.16) THEN
  186. READ(odate(15:16),'(I2)') miold
  187. IF (olen.GE.19) THEN
  188. READ(odate(18:19),'(I2)') scold
  189. END IF
  190. END IF
  191. END IF
  192. ! Break down new hdate into parts
  193. hrnew = 0
  194. minew = 0
  195. scnew = 0
  196. nlen = LEN(ndate)
  197. READ(ndate(1:4), '(I4)') yrnew
  198. #ifdef PLANET
  199. READ(ndate(6:10), '(I5)') dynew
  200. monew=0.
  201. #else
  202. READ(ndate(6:7), '(I2)') monew
  203. READ(ndate(9:10), '(I2)') dynew
  204. #endif
  205. IF (nlen.GE.13) THEN
  206. READ(ndate(12:13),'(I2)') hrnew
  207. IF (nlen.GE.16) THEN
  208. READ(ndate(15:16),'(I2)') minew
  209. IF (nlen.GE.19) THEN
  210. READ(ndate(18:19),'(I2)') scnew
  211. END IF
  212. END IF
  213. END IF
  214. ! Check that the dates make sense.
  215. npass = .true.
  216. opass = .true.
  217. #ifdef PLANET
  218. ! Check that the day of NDATE makes sense.
  219. IF ((dynew > PLANET_YEAR).or.(dynew < 1)) THEN
  220. PRINT*, 'GETH_IDTS: Day of NDATE = ', dynew
  221. npass = .false.
  222. END IF
  223. ! Check that the day of ODATE makes sense.
  224. IF ((dyold > PLANET_YEAR).or.(dyold < 1)) THEN
  225. PRINT*, 'GETH_IDTS: Day of ODATE = ', dyold
  226. opass = .false.
  227. END IF
  228. #else
  229. ! Check that the month of NDATE makes sense.
  230. IF ((monew.GT.12).or.(monew.LT.1)) THEN
  231. PRINT*, 'GETH_IDTS: Month of NDATE = ', monew
  232. npass = .false.
  233. END IF
  234. ! Check that the month of ODATE makes sense.
  235. IF ((moold.GT.12).or.(moold.LT.1)) THEN
  236. PRINT*, 'GETH_IDTS: Month of ODATE = ', moold
  237. opass = .false.
  238. END IF
  239. ! Check that the day of NDATE makes sense.
  240. IF (monew.ne.2) THEN
  241. ! ...... For all months but February
  242. IF ((dynew.GT.mday(monew)).or.(dynew.LT.1)) THEN
  243. PRINT*, 'GETH_IDTS: Day of NDATE = ', dynew
  244. npass = .false.
  245. END IF
  246. ELSE IF (monew.eq.2) THEN
  247. ! ...... For February
  248. IF ((dynew.GT.nfeb(yrnew)).OR.(dynew.LT.1)) THEN
  249. PRINT*, 'GETH_IDTS: Day of NDATE = ', dynew
  250. npass = .false.
  251. END IF
  252. END IF
  253. ! Check that the day of ODATE makes sense.
  254. IF (moold.ne.2) THEN
  255. ! ...... For all months but February
  256. IF ((dyold.GT.mday(moold)).or.(dyold.LT.1)) THEN
  257. PRINT*, 'GETH_IDTS: Day of ODATE = ', dyold
  258. opass = .false.
  259. END IF
  260. ELSE IF (moold.eq.2) THEN
  261. ! ....... For February
  262. IF ((dyold.GT.nfeb(yrold)).or.(dyold.LT.1)) THEN
  263. PRINT*, 'GETH_IDTS: Day of ODATE = ', dyold
  264. opass = .false.
  265. END IF
  266. END IF
  267. #endif
  268. ! Check that the hour of NDATE makes sense.
  269. IF ((hrnew.GT.23).or.(hrnew.LT.0)) THEN
  270. PRINT*, 'GETH_IDTS: Hour of NDATE = ', hrnew
  271. npass = .false.
  272. END IF
  273. ! Check that the hour of ODATE makes sense.
  274. IF ((hrold.GT.23).or.(hrold.LT.0)) THEN
  275. PRINT*, 'GETH_IDTS: Hour of ODATE = ', hrold
  276. opass = .false.
  277. END IF
  278. ! Check that the minute of NDATE makes sense.
  279. IF ((minew.GT.59).or.(minew.LT.0)) THEN
  280. PRINT*, 'GETH_IDTS: Minute of NDATE = ', minew
  281. npass = .false.
  282. END IF
  283. ! Check that the minute of ODATE makes sense.
  284. IF ((miold.GT.59).or.(miold.LT.0)) THEN
  285. PRINT*, 'GETH_IDTS: Minute of ODATE = ', miold
  286. opass = .false.
  287. END IF
  288. ! Check that the second of NDATE makes sense.
  289. IF ((scnew.GT.59).or.(scnew.LT.0)) THEN
  290. PRINT*, 'GETH_IDTS: SECOND of NDATE = ', scnew
  291. npass = .false.
  292. END IF
  293. ! Check that the second of ODATE makes sense.
  294. IF ((scold.GT.59).or.(scold.LT.0)) THEN
  295. PRINT*, 'GETH_IDTS: Second of ODATE = ', scold
  296. opass = .false.
  297. END IF
  298. IF (.not. npass) THEN
  299. WRITE( wrf_err_message , * ) 'module_date_time: geth_idts: Bad NDATE: ', ndate(1:nlen)
  300. CALL wrf_error_fatal ( TRIM ( wrf_err_message ) )
  301. END IF
  302. IF (.not. opass) THEN
  303. WRITE( wrf_err_message , * ) 'module_date_time: geth_idts: Bad ODATE: ', odate(1:olen)
  304. CALL wrf_error_fatal ( TRIM ( wrf_err_message ) )
  305. END IF
  306. ! Date Checks are completed. Continue.
  307. ! Compute number of days from 1 January ODATE, 00:00:00 until ndate
  308. ! Compute number of hours from 1 January ODATE, 00:00:00 until ndate
  309. ! Compute number of minutes from 1 January ODATE, 00:00:00 until ndate
  310. newdys = 0
  311. #ifdef PLANET
  312. DO i = yrold, yrnew - 1
  313. newdys = newdys + PLANET_YEAR
  314. END DO
  315. #else
  316. DO i = yrold, yrnew - 1
  317. newdys = newdys + (365 + (nfeb(i)-28))
  318. END DO
  319. IF (monew .GT. 1) THEN
  320. mday(2) = nfeb(yrnew)
  321. DO i = 1, monew - 1
  322. newdys = newdys + mday(i)
  323. END DO
  324. mday(2) = 28
  325. END IF
  326. #endif
  327. newdys = newdys + dynew-1
  328. ! Compute number of hours from 1 January ODATE, 00:00:00 until odate
  329. ! Compute number of minutes from 1 January ODATE, 00:00:00 until odate
  330. olddys = 0
  331. #ifndef PLANET
  332. IF (moold .GT. 1) THEN
  333. mday(2) = nfeb(yrold)
  334. DO i = 1, moold - 1
  335. olddys = olddys + mday(i)
  336. END DO
  337. mday(2) = 28
  338. END IF
  339. #endif
  340. olddys = olddys + dyold-1
  341. ! Determine the time difference in seconds
  342. idts = (newdys - olddys) * 86400
  343. idts = idts + (hrnew - hrold) * 3600
  344. idts = idts + (minew - miold) * 60
  345. idts = idts + (scnew - scold)
  346. IF (isign .eq. -1) THEN
  347. tdate=ndate
  348. ndate=odate
  349. odate=tdate
  350. idts = idts * isign
  351. END IF
  352. END SUBROUTINE geth_idts
  353. !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  354. SUBROUTINE geth_newdate (ndate, odate, idt)
  355. IMPLICIT NONE
  356. ! From old date ('YYYY-MM-DD HH:MM:SS.ffff') and
  357. ! [or ('YYYY-DDDDD HH:MM:SS.ffff')]
  358. ! delta-time, compute the new date.
  359. ! on entry - odate - the old hdate.
  360. ! idt - the change in time
  361. ! on exit - ndate - the new hdate.
  362. INTEGER , INTENT(IN) :: idt
  363. CHARACTER (LEN=*) , INTENT(OUT) :: ndate
  364. CHARACTER (LEN=*) , INTENT(IN) :: odate
  365. ! Local Variables
  366. ! yrold - indicates the year associated with "odate"
  367. ! moold - indicates the month associated with "odate"
  368. ! dyold - indicates the day associated with "odate"
  369. ! hrold - indicates the hour associated with "odate"
  370. ! miold - indicates the minute associated with "odate"
  371. ! scold - indicates the second associated with "odate"
  372. ! yrnew - indicates the year associated with "ndate"
  373. ! monew - indicates the month associated with "ndate"
  374. ! dynew - indicates the day associated with "ndate"
  375. ! hrnew - indicates the hour associated with "ndate"
  376. ! minew - indicates the minute associated with "ndate"
  377. ! scnew - indicates the second associated with "ndate"
  378. ! mday - a list assigning the number of days in each month
  379. ! i - loop counter
  380. ! nday - the integer number of days represented by "idt"
  381. ! nhour - the integer number of hours in "idt" after taking out
  382. ! all the whole days
  383. ! nmin - the integer number of minutes in "idt" after taking out
  384. ! all the whole days and whole hours.
  385. ! nsec - the integer number of minutes in "idt" after taking out
  386. ! all the whole days, whole hours, and whole minutes.
  387. INTEGER :: nlen, olen
  388. INTEGER :: yrnew, monew, dynew, hrnew, minew, scnew, frnew
  389. INTEGER :: yrold, moold, dyold, hrold, miold, scold, frold
  390. INTEGER :: mday(12), nday, nhour, nmin, nsec, nfrac, i, ifrc
  391. LOGICAL :: opass
  392. CHARACTER (LEN=10) :: hfrc
  393. CHARACTER (LEN=1) :: sp
  394. ! INTEGER, EXTERNAL :: nfeb ! in the same module now
  395. ! Assign the number of days in a months
  396. mday( 1) = 31
  397. mday( 2) = 28
  398. mday( 3) = 31
  399. mday( 4) = 30
  400. mday( 5) = 31
  401. mday( 6) = 30
  402. mday( 7) = 31
  403. mday( 8) = 31
  404. mday( 9) = 30
  405. mday(10) = 31
  406. mday(11) = 30
  407. mday(12) = 31
  408. ! Break down old hdate into parts
  409. hrold = 0
  410. miold = 0
  411. scold = 0
  412. frold = 0
  413. olen = LEN(odate)
  414. IF (olen.GE.11) THEN
  415. sp = odate(11:11)
  416. else
  417. sp = ' '
  418. END IF
  419. ! Use internal READ statements to convert the CHARACTER string
  420. ! date into INTEGER components.
  421. READ(odate(1:4), '(I4)') yrold
  422. #ifdef PLANET
  423. READ(odate(6:10), '(I5)') dyold
  424. moold=0.
  425. #else
  426. READ(odate(6:7), '(I2)') moold
  427. READ(odate(9:10), '(I2)') dyold
  428. #endif
  429. IF (olen.GE.13) THEN
  430. READ(odate(12:13),'(I2)') hrold
  431. IF (olen.GE.16) THEN
  432. READ(odate(15:16),'(I2)') miold
  433. IF (olen.GE.19) THEN
  434. READ(odate(18:19),'(I2)') scold
  435. IF (olen.GT.20) THEN
  436. READ(odate(21:olen),'(I2)') frold
  437. END IF
  438. END IF
  439. END IF
  440. END IF
  441. ! Set the number of days in February for that year.
  442. mday(2) = nfeb(yrold)
  443. ! Check that ODATE makes sense.
  444. opass = .TRUE.
  445. #ifdef PLANET
  446. ! Check that the day of ODATE makes sense.
  447. IF ((dyold.GT.PLANET_YEAR).or.(dyold.LT.1)) THEN
  448. WRITE(*,*) 'GETH_NEWDATE: Day of ODATE = ', dyold
  449. opass = .FALSE.
  450. END IF
  451. #else
  452. ! Check that the month of ODATE makes sense.
  453. IF ((moold.GT.12).or.(moold.LT.1)) THEN
  454. WRITE(*,*) 'GETH_NEWDATE: Month of ODATE = ', moold
  455. opass = .FALSE.
  456. END IF
  457. ! Check that the day of ODATE makes sense.
  458. IF ((dyold.GT.mday(moold)).or.(dyold.LT.1)) THEN
  459. WRITE(*,*) 'GETH_NEWDATE: Day of ODATE = ', dyold
  460. opass = .FALSE.
  461. END IF
  462. #endif
  463. ! Check that the hour of ODATE makes sense.
  464. IF ((hrold.GT.23).or.(hrold.LT.0)) THEN
  465. WRITE(*,*) 'GETH_NEWDATE: Hour of ODATE = ', hrold
  466. opass = .FALSE.
  467. END IF
  468. ! Check that the minute of ODATE makes sense.
  469. IF ((miold.GT.59).or.(miold.LT.0)) THEN
  470. WRITE(*,*) 'GETH_NEWDATE: Minute of ODATE = ', miold
  471. opass = .FALSE.
  472. END IF
  473. ! Check that the second of ODATE makes sense.
  474. IF ((scold.GT.59).or.(scold.LT.0)) THEN
  475. WRITE(*,*) 'GETH_NEWDATE: Second of ODATE = ', scold
  476. opass = .FALSE.
  477. END IF
  478. ! Check that the fractional part of ODATE makes sense.
  479. IF (.not.opass) THEN
  480. WRITE( wrf_err_message , * ) 'module_date_time: GETH_NEWDATE: Bad ODATE: ', odate(1:olen), olen
  481. CALL wrf_error_fatal ( TRIM ( wrf_err_message ) )
  482. END IF
  483. ! Date Checks are completed. Continue.
  484. ! Compute the number of days, hours, minutes, and seconds in idt
  485. IF (olen.GT.20) THEN !idt should be in fractions of seconds
  486. ifrc = olen-20
  487. ifrc = 10**ifrc
  488. nday = ABS(idt)/(86400*ifrc)
  489. nhour = MOD(ABS(idt),86400*ifrc)/(3600*ifrc)
  490. nmin = MOD(ABS(idt),3600*ifrc)/(60*ifrc)
  491. nsec = MOD(ABS(idt),60*ifrc)/(ifrc)
  492. nfrac = MOD(ABS(idt), ifrc)
  493. ELSE IF (olen.eq.19) THEN !idt should be in seconds
  494. ifrc = 1
  495. nday = ABS(idt)/86400 ! Integer number of days in delta-time
  496. nhour = MOD(ABS(idt),86400)/3600
  497. nmin = MOD(ABS(idt),3600)/60
  498. nsec = MOD(ABS(idt),60)
  499. nfrac = 0
  500. ELSE IF (olen.eq.16) THEN !idt should be in minutes
  501. ifrc = 1
  502. nday = ABS(idt)/1440 ! Integer number of days in delta-time
  503. nhour = MOD(ABS(idt),1440)/60
  504. nmin = MOD(ABS(idt),60)
  505. nsec = 0
  506. nfrac = 0
  507. ELSE IF (olen.eq.13) THEN !idt should be in hours
  508. ifrc = 1
  509. nday = ABS(idt)/24 ! Integer number of days in delta-time
  510. nhour = MOD(ABS(idt),24)
  511. nmin = 0
  512. nsec = 0
  513. nfrac = 0
  514. ELSE IF (olen.eq.10) THEN !idt should be in days
  515. ifrc = 1
  516. nday = ABS(idt)/24 ! Integer number of days in delta-time
  517. nhour = 0
  518. nmin = 0
  519. nsec = 0
  520. nfrac = 0
  521. ELSE
  522. WRITE( wrf_err_message , * ) 'module_date_time: GETH_NEWDATE: Strange length for ODATE: ',olen
  523. CALL wrf_error_fatal ( TRIM ( wrf_err_message ) )
  524. END IF
  525. IF (idt.GE.0) THEN
  526. frnew = frold + nfrac
  527. IF (frnew.GE.ifrc) THEN
  528. frnew = frnew - ifrc
  529. nsec = nsec + 1
  530. END IF
  531. scnew = scold + nsec
  532. IF (scnew .GE. 60) THEN
  533. scnew = scnew - 60
  534. nmin = nmin + 1
  535. END IF
  536. minew = miold + nmin
  537. IF (minew .GE. 60) THEN
  538. minew = minew - 60
  539. nhour = nhour + 1
  540. END IF
  541. hrnew = hrold + nhour
  542. IF (hrnew .GE. 24) THEN
  543. hrnew = hrnew - 24
  544. nday = nday + 1
  545. END IF
  546. dynew = dyold
  547. monew = moold
  548. yrnew = yrold
  549. DO i = 1, nday
  550. dynew = dynew + 1
  551. #ifdef PLANET
  552. IF (dynew .GT. PLANET_YEAR) THEN
  553. dynew = dynew - PLANET_YEAR
  554. yrnew = yrnew + 1
  555. END IF
  556. #else
  557. IF (dynew.GT.mday(monew)) THEN
  558. dynew = dynew - mday(monew)
  559. monew = monew + 1
  560. IF (monew .GT. 12) THEN
  561. monew = 1
  562. yrnew = yrnew + 1
  563. ! If the year changes, recompute the number of days in February
  564. mday(2) = nfeb(yrnew)
  565. END IF
  566. END IF
  567. #endif
  568. END DO
  569. ELSE IF (idt.LT.0) THEN
  570. frnew = frold - nfrac
  571. IF (frnew .LT. 0) THEN
  572. frnew = frnew + ifrc
  573. nsec = nsec - 1
  574. END IF
  575. scnew = scold - nsec
  576. IF (scnew .LT. 00) THEN
  577. scnew = scnew + 60
  578. nmin = nmin + 1
  579. END IF
  580. minew = miold - nmin
  581. IF (minew .LT. 00) THEN
  582. minew = minew + 60
  583. nhour = nhour + 1
  584. END IF
  585. hrnew = hrold - nhour
  586. IF (hrnew .LT. 00) THEN
  587. hrnew = hrnew + 24
  588. nday = nday + 1
  589. END IF
  590. dynew = dyold
  591. monew = moold
  592. yrnew = yrold
  593. DO i = 1, nday
  594. dynew = dynew - 1
  595. #ifdef PLANET
  596. IF (dynew.eq.0) THEN
  597. dynew = PLANET_YEAR
  598. yrnew = yrnew - 1
  599. END IF
  600. #else
  601. IF (dynew.eq.0) THEN
  602. monew = monew - 1
  603. IF (monew.eq.0) THEN
  604. monew = 12
  605. yrnew = yrnew - 1
  606. ! If the year changes, recompute the number of days in February
  607. mday(2) = nfeb(yrnew)
  608. END IF
  609. dynew = mday(monew)
  610. END IF
  611. #endif
  612. END DO
  613. END IF
  614. ! Now construct the new mdate
  615. nlen = LEN(ndate)
  616. #ifdef PLANET
  617. IF (nlen.GT.20) THEN
  618. WRITE(ndate(1:19),19) yrnew, dynew, hrnew, minew, scnew
  619. WRITE(hfrc,'(I10)') frnew+1000000000
  620. ndate = ndate(1:19)//'.'//hfrc(31-nlen:10)
  621. ELSE IF (nlen.eq.19.or.nlen.eq.20) THEN
  622. WRITE(ndate(1:19),19) yrnew, dynew, hrnew, minew, scnew
  623. 19 format(I4.4,'-',I5.5,'_',I2.2,':',I2.2,':',I2.2)
  624. IF (nlen.eq.20) ndate = ndate(1:19)//'.'
  625. ELSE IF (nlen.eq.16) THEN
  626. WRITE(ndate,16) yrnew, dynew, hrnew, minew
  627. 16 format(I4.4,'-',I5.5,'_',I2.2,':',I2.2)
  628. ELSE IF (nlen.eq.13) THEN
  629. WRITE(ndate,13) yrnew, dynew, hrnew
  630. 13 format(I4.4,'-',I5.5,'_',I2.2)
  631. ELSE IF (nlen.eq.10) THEN
  632. WRITE(ndate,10) yrnew, dynew
  633. 10 format(I4.4,'-',I5.5)
  634. END IF
  635. IF (olen.GE.11) ndate(11:11) = sp
  636. #else
  637. IF (nlen.GT.20) THEN
  638. WRITE(ndate(1:19),19) yrnew, monew, dynew, hrnew, minew, scnew
  639. WRITE(hfrc,'(I10)') frnew+1000000000
  640. ndate = ndate(1:19)//'.'//hfrc(31-nlen:10)
  641. ELSE IF (nlen.eq.19.or.nlen.eq.20) THEN
  642. WRITE(ndate(1:19),19) yrnew, monew, dynew, hrnew, minew, scnew
  643. 19 format(I4,'-',I2.2,'-',I2.2,'_',I2.2,':',I2.2,':',I2.2)
  644. IF (nlen.eq.20) ndate = ndate(1:19)//'.'
  645. ELSE IF (nlen.eq.16) THEN
  646. WRITE(ndate,16) yrnew, monew, dynew, hrnew, minew
  647. 16 format(I4,'-',I2.2,'-',I2.2,'_',I2.2,':',I2.2)
  648. ELSE IF (nlen.eq.13) THEN
  649. WRITE(ndate,13) yrnew, monew, dynew, hrnew
  650. 13 format(I4,'-',I2.2,'-',I2.2,'_',I2.2)
  651. ELSE IF (nlen.eq.10) THEN
  652. WRITE(ndate,10) yrnew, monew, dynew
  653. 10 format(I4,'-',I2.2,'-',I2.2)
  654. END IF
  655. IF (olen.GE.11) ndate(11:11) = sp
  656. #endif
  657. END SUBROUTINE geth_newdate
  658. !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  659. FUNCTION nfeb ( year ) RESULT (num_days)
  660. ! Compute the number of days in February for the given year
  661. IMPLICIT NONE
  662. INTEGER :: year
  663. INTEGER :: num_days
  664. #ifdef NO_LEAP_CALENDAR
  665. num_days = 28 ! By default, February has 28 days ...
  666. #else
  667. num_days = 28 ! By default, February has 28 days ...
  668. IF (MOD(year,4).eq.0) THEN
  669. num_days = 29 ! But every four years, it has 29 days ...
  670. IF (MOD(year,100).eq.0) THEN
  671. num_days = 28 ! Except every 100 years, when it has 28 days ...
  672. IF (MOD(year,400).eq.0) THEN
  673. num_days = 29 ! Except every 400 years, when it has 29 days.
  674. END IF
  675. END IF
  676. END IF
  677. #endif
  678. END FUNCTION nfeb
  679. !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  680. SUBROUTINE split_date_char ( date , century_year , month , day , hour , minute , second , ten_thousandth)
  681. IMPLICIT NONE
  682. ! Input data.
  683. CHARACTER(LEN=24) , INTENT(IN) :: date
  684. ! Output data.
  685. INTEGER , INTENT(OUT) :: century_year , month , day , hour , minute , second , ten_thousandth
  686. READ(date,FMT='( I4)') century_year
  687. #ifdef PLANET
  688. month = 0
  689. READ(date,FMT='( 5X,I5)') day
  690. #else
  691. READ(date,FMT='( 5X,I2)') month
  692. READ(date,FMT='( 8X,I2)') day
  693. #endif
  694. READ(date,FMT='(11X,I2)') hour
  695. READ(date,FMT='(14X,I2)') minute
  696. READ(date,FMT='(17X,I2)') second
  697. READ(date,FMT='(20X,I4)') ten_thousandth
  698. END SUBROUTINE split_date_char
  699. SUBROUTINE init_module_date_time
  700. END SUBROUTINE init_module_date_time
  701. END MODULE module_date_time
  702. ! TBH: NOTE:
  703. ! TBH: Linkers whine if these routines are placed inside the module. Not
  704. ! TBH: sure if these should live here or inside an external package. They
  705. ! TBH: have dependencies both on WRF (for the format of the WRF date-time
  706. ! TBH: strings) and on the time manager. Currently, the format of the WRF
  707. ! TBH: date-time strings is a slight variant on ISO 8601 (ISO is
  708. ! TBH: "YYYY-MM-DDThh:mm:ss" while WRF is "YYYY-MM-DD_hh:mm:ss"). If we
  709. ! TBH: change the WRF format to match the standard, then we remove the
  710. ! TBH: WRF dependence...
  711. ! Converts WRF date-time string into an WRFU_Time object.
  712. ! The format of the WRF date-time strings is a slight variant on ISO 8601:
  713. ! ISO is "YYYY-MM-DDThh:mm:ss" while WRF is "YYYY-MM-DD_hh:mm:ss".
  714. SUBROUTINE wrf_atotime ( str, time )
  715. USE module_utility
  716. CHARACTER (LEN=*), INTENT(INOUT) :: str
  717. TYPE(WRFU_Time), INTENT(OUT) :: time
  718. INTEGER yr, mm, dd, h, m, s, ms
  719. INTEGER rc
  720. IF ( LEN( str ) .GE. 20 ) THEN
  721. IF ( str(20:20) .EQ. '.' ) THEN
  722. #ifdef PLANET
  723. READ(str,'(I4.4,1x,I5.5,1x,I2.2,1x,I2.2,1x,I2.2,1x,I4.4)') yr,dd,h,m,s,ms
  724. mm = 1
  725. #else
  726. READ(str,34) yr,mm,dd,h,m,s,ms
  727. #endif
  728. ! last four digits are ten-thousandths of a sec, convert to ms
  729. ms=nint(real(ms)/10)
  730. ELSE
  731. #ifdef PLANET
  732. READ(str,'(I4.4,1x,I5.5,1x,I2.2,1x,I2.2,1x,I2.2)') yr,dd,h,m,s
  733. mm = 1
  734. #else
  735. READ(str,33) yr,mm,dd,h,m,s
  736. #endif
  737. ms = 0
  738. ENDIF
  739. ELSE
  740. #ifdef PLANET
  741. READ(str,'(I4.4,1x,I5.5,1x,I2.2,1x,I2.2,1x,I2.2)') yr,dd,h,m,s
  742. mm = 1
  743. #else
  744. READ(str,33) yr,mm,dd,h,m,s
  745. #endif
  746. ms = 0
  747. ENDIF
  748. CALL WRFU_TimeSet( time, YY=yr, MM=mm, DD=dd, H=h, M=m, S=s, MS=ms, rc=rc )
  749. CALL wrf_check_error( WRFU_SUCCESS, rc, &
  750. 'WRFU_TimeSet() in wrf_atotime() FAILED', &
  751. __FILE__ , &
  752. __LINE__ )
  753. 33 FORMAT (I4.4,1x,I2.2,1x,I2.2,1x,I2.2,1x,I2.2,1x,I2.2)
  754. 34 FORMAT (I4.4,1x,I2.2,1x,I2.2,1x,I2.2,1x,I2.2,1x,I2.2,1x,I4.4)
  755. RETURN
  756. END SUBROUTINE wrf_atotime
  757. ! Converts an WRFU_Time object into a WRF date-time string.
  758. ! The format of the WRF date-time strings is a slight variant on ISO 8601:
  759. ! ISO is "YYYY-MM-DDThh:mm:ss" while WRF is "YYYY-MM-DD_hh:mm:ss".
  760. SUBROUTINE wrf_timetoa ( time, str )
  761. USE module_utility, ONLY : WRFU_Time, WRFU_TimeGet, WRFU_SUCCESS
  762. IMPLICIT NONE
  763. TYPE(WRFU_Time), INTENT(INOUT) :: time
  764. CHARACTER (LEN=*), INTENT(OUT) :: str
  765. INTEGER strlen, rc
  766. CHARACTER (LEN=256) :: mess, tmpstr
  767. ! Assertion
  768. IF ( LEN(str) < 19 ) THEN
  769. CALL wrf_error_fatal( 'wrf_timetoa: str is too short' )
  770. ENDIF
  771. tmpstr = ''
  772. CALL WRFU_TimeGet( time, timeString=tmpstr, rc=rc )
  773. WRITE(mess,*)'WRFU_TimeGet() returns ',rc,' in wrf_timetoa() FAILED: timeString >',TRIM(tmpstr),'<'
  774. CALL wrf_check_error( WRFU_SUCCESS, rc, &
  775. mess, &
  776. __FILE__ , &
  777. __LINE__ )
  778. ! change ISO 8601 'T' to WRF '_' and hack off fraction if str is not
  779. ! big enough to hold it
  780. strlen = MIN( LEN(str), LEN_TRIM(tmpstr) )
  781. str = ''
  782. str(1:strlen) = tmpstr(1:strlen)
  783. str(11:11) = '_'
  784. WRITE (mess,*) 'DEBUG wrf_timetoa(): returning with str = [',TRIM(str),']'
  785. CALL wrf_debug ( 150 , TRIM(mess) )
  786. RETURN
  787. END SUBROUTINE wrf_timetoa
  788. ! Converts an WRFU_TimeInterval object into a time-interval string.
  789. SUBROUTINE wrf_timeinttoa ( timeinterval, str )
  790. USE module_utility
  791. IMPLICIT NONE
  792. TYPE(WRFU_TimeInterval), INTENT(INOUT) :: timeinterval
  793. CHARACTER (LEN=*), INTENT(OUT) :: str
  794. INTEGER rc
  795. CHARACTER (LEN=256) :: mess
  796. CALL WRFU_TimeIntervalGet( timeinterval, timeString=str, rc=rc )
  797. CALL wrf_check_error( WRFU_SUCCESS, rc, &
  798. 'WRFU_TimeIntervalGet() in wrf_timeinttoa() FAILED', &
  799. __FILE__ , &
  800. __LINE__ )
  801. WRITE (mess,*) 'DEBUG wrf_timeinttoa(): returning with str = [',TRIM(str),']'
  802. CALL wrf_debug ( 150 , TRIM(mess) )
  803. RETURN
  804. END SUBROUTINE wrf_timeinttoa
  805. ! Debug routine to print key clock information.
  806. ! Every printed line begins with pre_str.
  807. SUBROUTINE wrf_clockprint ( level, clock, pre_str )
  808. USE module_utility
  809. INTEGER, INTENT( IN) :: level
  810. TYPE(WRFU_Clock), INTENT( IN) :: clock
  811. CHARACTER (LEN=*), INTENT( IN) :: pre_str
  812. INTEGER rc
  813. INTEGER :: debug_level
  814. TYPE(WRFU_Time) :: currTime, startTime, stopTime
  815. TYPE(WRFU_TimeInterval) :: timeStep
  816. CHARACTER (LEN=64) :: currTime_str, startTime_str, stopTime_str
  817. CHARACTER (LEN=64) :: timeStep_str
  818. CHARACTER (LEN=256) :: mess
  819. CALL get_wrf_debug_level( debug_level )
  820. IF ( level .LE. debug_level ) THEN
  821. CALL WRFU_ClockGet( clock, CurrTime=currTime, StartTime=startTime, &
  822. StopTime=stopTime, TimeStep=timeStep, rc=rc )
  823. CALL wrf_check_error( WRFU_SUCCESS, rc, &
  824. 'wrf_clockprint: WRFU_ClockGet() FAILED', &
  825. __FILE__ , &
  826. __LINE__ )
  827. CALL wrf_timetoa( currTime, currTime_str )
  828. CALL wrf_timetoa( startTime, startTime_str )
  829. CALL wrf_timetoa( stopTime, stopTime_str )
  830. CALL wrf_timeinttoa( timeStep, timeStep_str )
  831. WRITE (mess,*) TRIM(pre_str),' clock start time = ',TRIM(startTime_str)
  832. CALL wrf_message(TRIM(mess))
  833. WRITE (mess,*) TRIM(pre_str),' clock current time = ',TRIM(currTime_str)
  834. CALL wrf_message(TRIM(mess))
  835. WRITE (mess,*) TRIM(pre_str),' clock stop time = ',TRIM(stopTime_str)
  836. CALL wrf_message(TRIM(mess))
  837. WRITE (mess,*) TRIM(pre_str),' clock time step = ',TRIM(timeStep_str)
  838. CALL wrf_message(TRIM(mess))
  839. ENDIF
  840. RETURN
  841. END SUBROUTINE wrf_clockprint