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