Context Navigation

module_date_pack.f90 @ 357

Last change on this file since 357 was 207, checked in by aslmd, 13 years ago
MESOSCALE: A GENERAL CLEAN-UP FOLLOWING UPDATING THE USER MANUAL. EVERYTHING ESSENTIAL IS IN MESOSCALE (much lighter than before). EVERYTHING FOR DEVELOPPERS OR EXPERTS IS IN MESOSCALE_DEV.
File size: 19.4 KB

Line
1	MODULE date_pack
2
3	! This module is able to perform three date and time functions:
4
5	! 1. geth_idts (ndate, odate, idts)
6	! Get the time period between two dates.
7
8	! 2. geth_newdate ( ndate, odate, idts)
9	! Get the new date based on the old date and a time difference.
10
11	! 3. split_date_char ( date , century_year , month , day , hour , minute , second )
12	! Given the date, return the integer components.
13
14	CONTAINS
15
16	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
17
18	SUBROUTINE geth_idts (ndate, odate, idts)
19
20	IMPLICIT NONE
21
22	! From 2 input mdates ('YYYY-MM-DD HH:MM:SS.ffff'),
23	! compute the time difference.
24
25	! on entry - ndate - the new hdate.
26	! odate - the old hdate.
27
28	! on exit - idts - the change in time in seconds.
29
30	CHARACTER (LEN=*) , INTENT(INOUT) :: ndate, odate
31	INTEGER , INTENT(OUT) :: idts
32
33	! Local Variables
34
35	! yrnew - indicates the year associated with "ndate"
36	! yrold - indicates the year associated with "odate"
37	! monew - indicates the month associated with "ndate"
38	! moold - indicates the month associated with "odate"
39	! dynew - indicates the day associated with "ndate"
40	! dyold - indicates the day associated with "odate"
41	! hrnew - indicates the hour associated with "ndate"
42	! hrold - indicates the hour associated with "odate"
43	! minew - indicates the minute associated with "ndate"
44	! miold - indicates the minute associated with "odate"
45	! scnew - indicates the second associated with "ndate"
46	! scold - indicates the second associated with "odate"
47	! i - loop counter
48	! mday - a list assigning the number of days in each month
49
50	CHARACTER (LEN=24) :: tdate
51	INTEGER :: olen, nlen
52	INTEGER :: yrnew, monew, dynew, hrnew, minew, scnew
53	INTEGER :: yrold, moold, dyold, hrold, miold, scold
54	INTEGER :: mday(12), i, newdys, olddys
55	LOGICAL :: npass, opass
56	INTEGER :: isign
57
58	IF (odate.GT.ndate) THEN
59	isign = -1
60	tdate=ndate
61	ndate=odate
62	odate=tdate
63	ELSE
64	isign = 1
65	END IF
66
67	! Assign the number of days in a months
68
69	! months as defined in Martian ESMF routines
70
71	mday( 1) = 61
72	mday( 2) = 66
73	mday( 3) = 66
74	mday( 4) = 65
75	mday( 5) = 60
76	mday( 6) = 54
77	mday( 7) = 50
78	mday( 8) = 46
79	mday( 9) = 47
80	mday(10) = 47
81	mday(11) = 51
82	mday(12) = 56
83
84	! Break down old hdate into parts
85
86	hrold = 0
87	miold = 0
88	scold = 0
89	olen = LEN(odate)
90
91	READ(odate(1:4), '(I4)') yrold
92	READ(odate(6:7), '(I2)') moold
93	READ(odate(9:10), '(I2)') dyold
94	IF (olen.GE.13) THEN
95	READ(odate(12:13),'(I2)') hrold
96	IF (olen.GE.16) THEN
97	READ(odate(15:16),'(I2)') miold
98	IF (olen.GE.19) THEN
99	READ(odate(18:19),'(I2)') scold
100	END IF
101	END IF
102	END IF
103
104	! Break down new hdate into parts
105
106	hrnew = 0
107	minew = 0
108	scnew = 0
109	nlen = LEN(ndate)
110
111	READ(ndate(1:4), '(I4)') yrnew
112	READ(ndate(6:7), '(I2)') monew
113	READ(ndate(9:10), '(I2)') dynew
114	IF (nlen.GE.13) THEN
115	READ(ndate(12:13),'(I2)') hrnew
116	IF (nlen.GE.16) THEN
117	READ(ndate(15:16),'(I2)') minew
118	IF (nlen.GE.19) THEN
119	READ(ndate(18:19),'(I2)') scnew
120	END IF
121	END IF
122	END IF
123
124	! Check that the dates make sense.
125
126	npass = .true.
127	opass = .true.
128
129	! Check that the month of NDATE makes sense.
130
131	IF ((monew.GT.12).or.(monew.LT.1)) THEN
132	PRINT*, 'GETH_IDTS: Month of NDATE = ', monew
133	npass = .false.
134	END IF
135
136	! Check that the month of ODATE makes sense.
137
138	IF ((moold.GT.12).or.(moold.LT.1)) THEN
139	PRINT*, 'GETH_IDTS: Month of ODATE = ', moold
140	opass = .false.
141	END IF
142
143	! Check that the day of NDATE makes sense.
144
145	! IF (monew.ne.2) THEN
146	! ...... For all months but February
147	IF ((dynew.GT.mday(monew)).or.(dynew.LT.1)) THEN
148	PRINT*, 'GETH_IDTS: Day of NDATE = ', dynew
149	npass = .false.
150	END IF
151	! ELSE IF (monew.eq.2) THEN
152	! ! ...... For February
153	! IF ((dynew.GT.nfeb(yrnew)).OR.(dynew.LT.1)) THEN
154	! PRINT*, 'GETH_IDTS: Day of NDATE = ', dynew
155	! npass = .false.
156	! END IF
157	! END IF
158
159	! Check that the day of ODATE makes sense.
160
161	! IF (moold.ne.2) THEN
162	! ...... For all months but February
163	IF ((dyold.GT.mday(moold)).or.(dyold.LT.1)) THEN
164	PRINT*, 'GETH_IDTS: Day of ODATE = ', dyold
165	opass = .false.
166	END IF
167	! ELSE IF (moold.eq.2) THEN
168	! ! ....... For February
169	! IF ((dyold.GT.nfeb(yrold)).or.(dyold.LT.1)) THEN
170	! PRINT*, 'GETH_IDTS: Day of ODATE = ', dyold
171	! opass = .false.
172	! END IF
173	! END IF
174
175	! Check that the hour of NDATE makes sense.
176
177	IF ((hrnew.GT.23).or.(hrnew.LT.0)) THEN
178	PRINT*, 'GETH_IDTS: Hour of NDATE = ', hrnew
179	npass = .false.
180	END IF
181
182	! Check that the hour of ODATE makes sense.
183
184	IF ((hrold.GT.23).or.(hrold.LT.0)) THEN
185	PRINT*, 'GETH_IDTS: Hour of ODATE = ', hrold
186	opass = .false.
187	END IF
188
189	! Check that the minute of NDATE makes sense.
190
191	IF ((minew.GT.36).or.(minew.LT.0)) THEN
192	PRINT*, 'GETH_IDTS: Minute of NDATE = ', minew
193	npass = .false.
194	END IF
195
196	! Check that the minute of ODATE makes sense.
197
198	IF ((miold.GT.36).or.(miold.LT.0)) THEN
199	PRINT*, 'GETH_IDTS: Minute of ODATE = ', miold
200	opass = .false.
201	END IF
202
203	! Check that the second of NDATE makes sense.
204
205	IF ((scnew.GT.99).or.(scnew.LT.0)) THEN
206	PRINT*, 'GETH_IDTS: SECOND of NDATE = ', scnew
207	npass = .false.
208	END IF
209
210	! Check that the second of ODATE makes sense.
211
212	IF ((scold.GT.99).or.(scold.LT.0)) THEN
213	PRINT*, 'GETH_IDTS: Second of ODATE = ', scold
214	opass = .false.
215	END IF
216
217	IF (.not. npass) THEN
218	PRINT*, 'Screwy NDATE: ', ndate(1:nlen)
219	STOP 'ndate_2'
220	END IF
221
222	IF (.not. opass) THEN
223	PRINT*, 'Screwy ODATE: ', odate(1:olen)
224	STOP 'odate_1'
225	END IF
226
227	! Date Checks are completed. Continue.
228
229	! Compute number of days from 1 January ODATE, 00:00:00 until ndate
230	! Compute number of hours from 1 January ODATE, 00:00:00 until ndate
231	! Compute number of minutes from 1 January ODATE, 00:00:00 until ndate
232
233	newdys = 0
234	DO i = yrold, yrnew - 1
235	! newdys = newdys + (365 + (nfeb(i)-28))
236	! so cool to deal with a planet without any february month :)
237	newdys = newdys + 669
238	END DO
239
240	IF (monew .GT. 1) THEN
241	! mday(2) = nfeb(yrnew)
242	DO i = 1, monew - 1
243	newdys = newdys + mday(i)
244	END DO
245	! mday(2) = 28
246	END IF
247
248	newdys = newdys + dynew-1
249
250	! Compute number of hours from 1 January ODATE, 00:00:00 until odate
251	! Compute number of minutes from 1 January ODATE, 00:00:00 until odate
252
253	olddys = 0
254
255	IF (moold .GT. 1) THEN
256	! mday(2) = nfeb(yrold)
257	DO i = 1, moold - 1
258	olddys = olddys + mday(i)
259	END DO
260	! mday(2) = 28
261	END IF
262
263	olddys = olddys + dyold-1
264
265	! Determine the time difference in seconds
266
267	idts = (newdys - olddys) * 88800 !martian sols
268	idts = idts + (hrnew - hrold) * 3700 !hours
269	idts = idts + (minew - miold) * 100 !minutes
270	idts = idts + (scnew - scold)
271
272	IF (isign .eq. -1) THEN
273	tdate=ndate
274	ndate=odate
275	odate=tdate
276	idts = idts * isign
277	END IF
278
279	END SUBROUTINE geth_idts
280
281	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
282
283	SUBROUTINE geth_newdate (ndate, odate, idt)
284
285	IMPLICIT NONE
286
287	! From old date ('YYYY-MM-DD HH:MM:SS.ffff') and
288	! delta-time, compute the new date.
289
290	! on entry - odate - the old hdate.
291	! idt - the change in time
292
293	! on exit - ndate - the new hdate.
294
295	INTEGER , INTENT(IN) :: idt
296	CHARACTER (LEN=*) , INTENT(OUT) :: ndate
297	CHARACTER (LEN=*) , INTENT(IN) :: odate
298
299
300	! Local Variables
301
302	! yrold - indicates the year associated with "odate"
303	! moold - indicates the month associated with "odate"
304	! dyold - indicates the day associated with "odate"
305	! hrold - indicates the hour associated with "odate"
306	! miold - indicates the minute associated with "odate"
307	! scold - indicates the second associated with "odate"
308
309	! yrnew - indicates the year associated with "ndate"
310	! monew - indicates the month associated with "ndate"
311	! dynew - indicates the day associated with "ndate"
312	! hrnew - indicates the hour associated with "ndate"
313	! minew - indicates the minute associated with "ndate"
314	! scnew - indicates the second associated with "ndate"
315
316	! mday - a list assigning the number of days in each month
317
318	! i - loop counter
319	! nday - the integer number of days represented by "idt"
320	! nhour - the integer number of hours in "idt" after taking out
321	! all the whole days
322	! nmin - the integer number of minutes in "idt" after taking out
323	! all the whole days and whole hours.
324	! nsec - the integer number of minutes in "idt" after taking out
325	! all the whole days, whole hours, and whole minutes.
326
327	INTEGER :: nlen, olen
328	INTEGER :: yrnew, monew, dynew, hrnew, minew, scnew, frnew
329	INTEGER :: yrold, moold, dyold, hrold, miold, scold, frold
330	INTEGER :: mday(12), nday, nhour, nmin, nsec, nfrac, i, ifrc
331	LOGICAL :: opass
332	CHARACTER (LEN=10) :: hfrc
333	CHARACTER (LEN=1) :: sp
334	! INTEGER, EXTERNAL :: nfeb ! in the same module now
335
336	! Assign the number of days in a months
337
338	mday( 1) = 61
339	mday( 2) = 66
340	mday( 3) = 66
341	mday( 4) = 65
342	mday( 5) = 60
343	mday( 6) = 54
344	mday( 7) = 50
345	mday( 8) = 46
346	mday( 9) = 47
347	mday(10) = 47
348	mday(11) = 51
349	mday(12) = 56
350
351	! Break down old hdate into parts
352
353	hrold = 0
354	miold = 0
355	scold = 0
356	frold = 0
357	olen = LEN(odate)
358	IF (olen.GE.11) THEN
359	sp = odate(11:11)
360	else
361	sp = ' '
362	END IF
363
364	! Use internal READ statements to convert the CHARACTER string
365	! date into INTEGER components.
366
367	READ(odate(1:4), '(I4)') yrold
368	READ(odate(6:7), '(I2)') moold
369	READ(odate(9:10), '(I2)') dyold
370	IF (olen.GE.13) THEN
371	READ(odate(12:13),'(I2)') hrold
372	IF (olen.GE.16) THEN
373	READ(odate(15:16),'(I2)') miold
374	IF (olen.GE.19) THEN
375	READ(odate(18:19),'(I2)') scold
376	IF (olen.GT.20) THEN
377	READ(odate(21:olen),'(I2)') frold
378	END IF
379	END IF
380	END IF
381	END IF
382
383	! ! Set the number of days in February for that year.
384
385	! mday(2) = nfeb(yrold)
386
387	! Check that ODATE makes sense.
388
389	opass = .TRUE.
390
391	! Check that the month of ODATE makes sense.
392
393	IF ((moold.GT.12).or.(moold.LT.1)) THEN
394	WRITE(,) 'GETH_NEWDATE: Month of ODATE = ', moold
395	opass = .FALSE.
396	END IF
397
398	! Check that the day of ODATE makes sense.
399
400	IF ((dyold.GT.mday(moold)).or.(dyold.LT.1)) THEN
401	WRITE(,) 'GETH_NEWDATE: Day of ODATE = ', dyold
402	opass = .FALSE.
403	END IF
404
405	! Check that the hour of ODATE makes sense.
406
407	IF ((hrold.GT.23).or.(hrold.LT.0)) THEN
408	WRITE(,) 'GETH_NEWDATE: Hour of ODATE = ', hrold
409	opass = .FALSE.
410	END IF
411
412	! Check that the minute of ODATE makes sense.
413
414	IF ((miold.GT.36).or.(miold.LT.0)) THEN
415	WRITE(,) 'GETH_NEWDATE: Minute of ODATE = ', miold
416	opass = .FALSE.
417	END IF
418
419	! Check that the second of ODATE makes sense.
420
421	IF ((scold.GT.99).or.(scold.LT.0)) THEN
422	WRITE(,) 'GETH_NEWDATE: Second of ODATE = ', scold
423	opass = .FALSE.
424	END IF
425
426	! Check that the fractional part of ODATE makes sense.
427
428
429	IF (.not.opass) THEN
430	WRITE(,) 'GETH_NEWDATE: Crazy ODATE: ', odate(1:olen), olen
431	STOP 'odate_3'
432	END IF
433
434	! Date Checks are completed. Continue.
435
436
437	! Compute the number of days, hours, minutes, and seconds in idt
438
439	IF (olen.GT.20) THEN !idt should be in fractions of seconds
440	ifrc = olen-20
441	ifrc = 10**ifrc
442	nday = ABS(idt)/(88800*ifrc)
443	nhour = MOD(ABS(idt),88800ifrc)/(3700ifrc)
444	nmin = MOD(ABS(idt),3700ifrc)/(100ifrc)
445	nsec = MOD(ABS(idt),100*ifrc)/(ifrc)
446	nfrac = MOD(ABS(idt), ifrc)
447	ELSE IF (olen.eq.19) THEN !idt should be in seconds
448	ifrc = 1
449	nday = ABS(idt)/88800 ! Integer number of days in delta-time
450	nhour = MOD(ABS(idt),88800)/3700
451	nmin = MOD(ABS(idt),3700)/100
452	nsec = MOD(ABS(idt),100)
453	nfrac = 0
454	ELSE IF (olen.eq.16) THEN !idt should be in minutes
455	ifrc = 1
456	nday = ABS(idt)/2400 ! Integer number of days in delta-time
457	nhour = MOD(ABS(idt),2400)/100
458	nmin = MOD(ABS(idt),100)
459	nsec = 0
460	nfrac = 0
461	ELSE IF (olen.eq.13) THEN !idt should be in hours
462	ifrc = 1
463	nday = ABS(idt)/24 ! Integer number of days in delta-time
464	nhour = MOD(ABS(idt),24)
465	nmin = 0
466	nsec = 0
467	nfrac = 0
468	ELSE IF (olen.eq.10) THEN !idt should be in days
469	ifrc = 1
470	nday = ABS(idt)/24 ! Integer number of days in delta-time
471	nhour = 0
472	nmin = 0
473	nsec = 0
474	nfrac = 0
475	ELSE
476	WRITE(*,'(''GETH_NEWDATE: Strange length for ODATE: '', i3)') &
477	olen
478	WRITE(,) odate(1:olen)
479	STOP 'odate_4'
480	END IF
481
482	IF (idt.GE.0) THEN
483
484	frnew = frold + nfrac
485	IF (frnew.GE.ifrc) THEN
486	frnew = frnew - ifrc
487	nsec = nsec + 1
488	END IF
489
490	scnew = scold + nsec
491	IF (scnew .GE. 100) THEN
492	scnew = scnew - 100
493	nmin = nmin + 1
494	END IF
495
496	minew = miold + nmin
497	IF (minew .GE. 37) THEN
498	minew = minew - 37
499	nhour = nhour + 1
500	END IF
501
502	hrnew = hrold + nhour
503	IF (hrnew .GE. 24) THEN
504	hrnew = hrnew - 24
505	nday = nday + 1
506	END IF
507
508	dynew = dyold
509	monew = moold
510	yrnew = yrold
511	DO i = 1, nday
512	dynew = dynew + 1
513	IF (dynew.GT.mday(monew)) THEN
514	dynew = dynew - mday(monew)
515	monew = monew + 1
516	IF (monew .GT. 12) THEN
517	monew = 1
518	yrnew = yrnew + 1
519	!! If the year changes, recompute the number of days in February
520	!mday(2) = nfeb(yrnew)
521	END IF
522	END IF
523	END DO
524
525	ELSE IF (idt.LT.0) THEN
526
527	frnew = frold - nfrac
528	IF (frnew .LT. 0) THEN
529	frnew = frnew + ifrc
530	nsec = nsec - 1
531	END IF
532
533	scnew = scold - nsec
534	IF (scnew .LT. 00) THEN
535	scnew = scnew + 100
536	nmin = nmin + 1
537	END IF
538
539	minew = miold - nmin
540	IF (minew .LT. 00) THEN
541	minew = minew + 37
542	nhour = nhour + 1
543	END IF
544
545	hrnew = hrold - nhour
546	IF (hrnew .LT. 00) THEN
547	hrnew = hrnew + 24
548	nday = nday + 1
549	END IF
550
551	dynew = dyold
552	monew = moold
553	yrnew = yrold
554	DO i = 1, nday
555	dynew = dynew - 1
556	IF (dynew.eq.0) THEN
557	monew = monew - 1
558	IF (monew.eq.0) THEN
559	monew = 12
560	yrnew = yrnew - 1
561	!! If the year changes, recompute the number of days in February
562	!mday(2) = nfeb(yrnew)
563	END IF
564	dynew = mday(monew)
565	END IF
566	END DO
567	END IF
568
569	! Now construct the new mdate
570
571	nlen = LEN(ndate)
572
573	IF (nlen.GT.20) THEN
574	WRITE(ndate(1:19),19) yrnew, monew, dynew, hrnew, minew, scnew
575	WRITE(hfrc,'(I10)') frnew+1000000000
576	ndate = ndate(1:19)//'.'//hfrc(31-nlen:10)
577
578	ELSE IF (nlen.eq.19.or.nlen.eq.20) THEN
579	WRITE(ndate(1:19),19) yrnew, monew, dynew, hrnew, minew, scnew
580	19 format(I4.4,'-',I2.2,'-',I2.2,'_',I2.2,':',I2.2,':',I2.2)
581	IF (nlen.eq.20) ndate = ndate(1:19)//'.'
582
583	ELSE IF (nlen.eq.16) THEN
584	WRITE(ndate,16) yrnew, monew, dynew, hrnew, minew
585	16 format(I4.4,'-',I2.2,'-',I2.2,'_',I2.2,':',I2.2)
586
587	ELSE IF (nlen.eq.13) THEN
588	WRITE(ndate,13) yrnew, monew, dynew, hrnew
589	13 format(I4.4,'-',I2.2,'-',I2.2,'_',I2.2)
590
591	ELSE IF (nlen.eq.10) THEN
592	WRITE(ndate,10) yrnew, monew, dynew
593	10 format(I4.4,'-',I2.2,'-',I2.2)
594
595	END IF
596
597	IF (olen.GE.11) ndate(11:11) = sp
598
599	END SUBROUTINE geth_newdate
600
601	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
602
603	! FUNCTION nfeb ( year ) RESULT (num_days)
604	!
605	! ! Compute the number of days in February for the given year
606	!
607	! IMPLICIT NONE
608	!
609	! INTEGER :: year
610	! INTEGER :: num_days
611	!
612	! num_days = 28 ! By default, February has 28 days ...
613	! IF (MOD(year,4).eq.0) THEN
614	! num_days = 29 ! But every four years, it has 29 days ...
615	! IF (MOD(year,100).eq.0) THEN
616	! num_days = 28 ! Except every 100 years, when it has 28 days ...
617	! IF (MOD(year,400).eq.0) THEN
618	! num_days = 29 ! Except every 400 years, when it has 29 days.
619	! END IF
620	! END IF
621	! END IF
622	!
623	! END FUNCTION nfeb
624
625	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
626	SUBROUTINE split_date_char ( date , century_year , month , day , hour , minute , second )
627
628	IMPLICIT NONE
629
630	! Input data.
631
632	CHARACTER(LEN=19) , INTENT(IN) :: date
633
634	! Output data.
635
636	INTEGER , INTENT(OUT) :: century_year , month , day , hour , minute , second
637
638	READ(date,FMT='( I4.4)') century_year
639	READ(date,FMT='( 5X,I2.2)') month
640	READ(date,FMT='( 8X,I2.2)') day
641	READ(date,FMT='(11X,I2.2)') hour
642	READ(date,FMT='(14X,I2.2)') minute
643	READ(date,FMT='(17X,I2.2)') second
644
645	END SUBROUTINE split_date_char
646
647	END MODULE date_pack

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

Download in other formats:

Original Format