Context Navigation

module_date_time.F @ 3709

Last change on this file since 3709 was 2287, checked in by mlefevre, 6 years ago
MESOSCALE. Corrections of local time calculations for Venus mesoscale and LES model.
File size: 31.4 KB

Line
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(3700gmt)
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),88800ifrc)/(3700ifrc)
608	nmin = MOD(ABS(idt),3700ifrc)/(100ifrc)
609	nsec = MOD(ABS(idt),100*ifrc)/(ifrc)
610	!!****VENUS
611	! nday = ABS(idt)/(4212*ifrc)
612	! nhour = MOD(ABS(idt),4212ifrc)/(117ifrc)
613	! nmin = MOD(ABS(idt),117ifrc)/(9ifrc)
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

Note: See TracBrowser for help on using the repository browser.

Download in other formats:

Original Format