** TAG CREATION **
[WPS-merge.git] / metgrid / src / module_date_pack.F
blobc1e6c10e1399bdbe37185cf747f3ecf28fd4a7b1
1 MODULE date_pack
3 !  This module is able to perform three date and time functions:
5 !  1.  geth_idts (ndate, odate, idts)
6 !  Get the time period between two dates.
8 !  2. geth_newdate ( ndate, odate, idts)
9 !  Get the new date based on the old date and a time difference.
11 !  3. split_date_char ( date , century_year , month , day , hour , minute , second )
12 !  Given the date, return the integer components.
14 use module_debug
16 CONTAINS
18 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
20    SUBROUTINE geth_idts (ndate, odate, idts)
21    
22       IMPLICIT NONE
23       
24       !  From 2 input mdates ('YYYY-MM-DD HH:MM:SS.ffff'), 
25       !  compute the time difference.
26       
27       !  on entry     -  ndate  -  the new hdate.
28       !                  odate  -  the old hdate.
29       
30       !  on exit      -  idts    -  the change in time in seconds.
31       
32       CHARACTER (LEN=*) , INTENT(INOUT) :: ndate, odate
33       INTEGER           , INTENT(OUT)   :: idts
34       
35       !  Local Variables
36       
37       !  yrnew    -  indicates the year associated with "ndate"
38       !  yrold    -  indicates the year associated with "odate"
39       !  monew    -  indicates the month associated with "ndate"
40       !  moold    -  indicates the month associated with "odate"
41       !  dynew    -  indicates the day associated with "ndate"
42       !  dyold    -  indicates the day associated with "odate"
43       !  hrnew    -  indicates the hour associated with "ndate"
44       !  hrold    -  indicates the hour associated with "odate"
45       !  minew    -  indicates the minute associated with "ndate"
46       !  miold    -  indicates the minute associated with "odate"
47       !  scnew    -  indicates the second associated with "ndate"
48       !  scold    -  indicates the second associated with "odate"
49       !  i        -  loop counter
50       !  mday     -  a list assigning the number of days in each month
51       
52       CHARACTER (LEN=24) :: tdate
53       INTEGER :: olen, nlen
54       INTEGER :: yrnew, monew, dynew, hrnew, minew, scnew
55       INTEGER :: yrold, moold, dyold, hrold, miold, scold
56       INTEGER :: mday(12), i, newdys, olddys
57       LOGICAL :: npass, opass
58       INTEGER :: isign
59       
60       IF (odate.GT.ndate) THEN
61          isign = -1
62          tdate=ndate
63          ndate=odate
64          odate=tdate
65       ELSE
66          isign = 1
67       END IF
68       
69       !  Assign the number of days in a months
70       
71       mday( 1) = 31
72       mday( 2) = 28
73       mday( 3) = 31
74       mday( 4) = 30
75       mday( 5) = 31
76       mday( 6) = 30
77       mday( 7) = 31
78       mday( 8) = 31
79       mday( 9) = 30
80       mday(10) = 31
81       mday(11) = 30
82       mday(12) = 31
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.59).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.59).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.59).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.59).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          call mprintf(.true.,ERROR,'Screwy NDATE: %s',s1=ndate(1:nlen))
219       END IF
220       
221       IF (.not. opass) THEN
222          call mprintf(.true.,ERROR,'Screwy ODATE: %s',s1=odate(1:olen))
223       END IF
224       
225       !  Date Checks are completed.  Continue.
226       
227       !  Compute number of days from 1 January ODATE, 00:00:00 until ndate
228       !  Compute number of hours from 1 January ODATE, 00:00:00 until ndate
229       !  Compute number of minutes from 1 January ODATE, 00:00:00 until ndate
230       
231       newdys = 0
232       DO i = yrold, yrnew - 1
233          newdys = newdys + (365 + (nfeb(i)-28))
234       END DO
235       
236       IF (monew .GT. 1) THEN
237          mday(2) = nfeb(yrnew)
238          DO i = 1, monew - 1
239             newdys = newdys + mday(i)
240          END DO
241          mday(2) = 28
242       END IF
243       
244       newdys = newdys + dynew-1
245       
246       !  Compute number of hours from 1 January ODATE, 00:00:00 until odate
247       !  Compute number of minutes from 1 January ODATE, 00:00:00 until odate
248       
249       olddys = 0
250       
251       IF (moold .GT. 1) THEN
252          mday(2) = nfeb(yrold)
253          DO i = 1, moold - 1
254             olddys = olddys + mday(i)
255          END DO
256          mday(2) = 28
257       END IF
258       
259       olddys = olddys + dyold-1
260       
261       !  Determine the time difference in seconds
262       
263       idts = (newdys - olddys) * 86400
264       idts = idts + (hrnew - hrold) * 3600
265       idts = idts + (minew - miold) * 60
266       idts = idts + (scnew - scold)
267       
268       IF (isign .eq. -1) THEN
269          tdate=ndate
270          ndate=odate
271          odate=tdate
272          idts = idts * isign
273       END IF
274    
275    END SUBROUTINE geth_idts
277 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
279    SUBROUTINE geth_newdate (ndate, odate, idt)
280    
281       IMPLICIT NONE
282       
283       !  From old date ('YYYY-MM-DD HH:MM:SS.ffff') and 
284       !  delta-time, compute the new date.
285    
286       !  on entry     -  odate  -  the old hdate.
287       !                  idt    -  the change in time
288    
289       !  on exit      -  ndate  -  the new hdate.
290       
291       INTEGER , INTENT(IN)           :: idt
292       CHARACTER (LEN=*) , INTENT(OUT) :: ndate
293       CHARACTER (LEN=*) , INTENT(IN)  :: odate
294       
295        
296       !  Local Variables
297        
298       !  yrold    -  indicates the year associated with "odate"
299       !  moold    -  indicates the month associated with "odate"
300       !  dyold    -  indicates the day associated with "odate"
301       !  hrold    -  indicates the hour associated with "odate"
302       !  miold    -  indicates the minute associated with "odate"
303       !  scold    -  indicates the second associated with "odate"
304        
305       !  yrnew    -  indicates the year associated with "ndate"
306       !  monew    -  indicates the month associated with "ndate"
307       !  dynew    -  indicates the day associated with "ndate"
308       !  hrnew    -  indicates the hour associated with "ndate"
309       !  minew    -  indicates the minute associated with "ndate"
310       !  scnew    -  indicates the second associated with "ndate"
311        
312       !  mday     -  a list assigning the number of days in each month
313       
314       !  i        -  loop counter
315       !  nday     -  the integer number of days represented by "idt"
316       !  nhour    -  the integer number of hours in "idt" after taking out
317       !              all the whole days
318       !  nmin     -  the integer number of minutes in "idt" after taking out
319       !              all the whole days and whole hours.
320       !  nsec     -  the integer number of minutes in "idt" after taking out
321       !              all the whole days, whole hours, and whole minutes.
322        
323       INTEGER :: nlen, olen
324       INTEGER :: yrnew, monew, dynew, hrnew, minew, scnew, frnew
325       INTEGER :: yrold, moold, dyold, hrold, miold, scold, frold
326       INTEGER :: mday(12), nday, nhour, nmin, nsec, nfrac, i, ifrc
327       LOGICAL :: opass
328       CHARACTER (LEN=10) :: hfrc
329       CHARACTER (LEN=1) :: sp
330       ! INTEGER, EXTERNAL :: nfeb  ! in the same module now
332       !  Assign the number of days in a months
333       
334       mday( 1) = 31
335       mday( 2) = 28
336       mday( 3) = 31
337       mday( 4) = 30
338       mday( 5) = 31
339       mday( 6) = 30
340       mday( 7) = 31
341       mday( 8) = 31
342       mday( 9) = 30
343       mday(10) = 31
344       mday(11) = 30
345       mday(12) = 31
346       
347       !  Break down old hdate into parts
348       
349       hrold = 0
350       miold = 0
351       scold = 0
352       frold = 0
353       olen = LEN(odate)
354       IF (olen.GE.11) THEN
355          sp = odate(11:11)
356       else
357          sp = ' '
358       END IF
359       
360       !  Use internal READ statements to convert the CHARACTER string
361       !  date into INTEGER components.
362    
363       READ(odate(1:4),  '(I4)') yrold
364       READ(odate(6:7),  '(I2)') moold
365       READ(odate(9:10), '(I2)') dyold
366       IF (olen.GE.13) THEN
367          READ(odate(12:13),'(I2)') hrold
368          IF (olen.GE.16) THEN
369             READ(odate(15:16),'(I2)') miold
370             IF (olen.GE.19) THEN
371                READ(odate(18:19),'(I2)') scold
372                IF (olen.GT.20) THEN
373                   READ(odate(21:olen),'(I2)') frold
374                END IF
375             END IF
376          END IF
377       END IF
378       
379       !  Set the number of days in February for that year.
380       
381       mday(2) = nfeb(yrold)
382       
383       !  Check that ODATE makes sense.
384       
385       opass = .TRUE.
386       
387       !  Check that the month of ODATE makes sense.
388       
389       IF ((moold.GT.12).or.(moold.LT.1)) THEN
390          WRITE(*,*) 'GETH_NEWDATE:  Month of ODATE = ', moold
391          opass = .FALSE.
392       END IF
393       
394       !  Check that the day of ODATE makes sense.
395       
396       IF ((dyold.GT.mday(moold)).or.(dyold.LT.1)) THEN
397          WRITE(*,*) 'GETH_NEWDATE:  Day of ODATE = ', dyold
398          opass = .FALSE.
399       END IF
400       
401       !  Check that the hour of ODATE makes sense.
402       
403       IF ((hrold.GT.23).or.(hrold.LT.0)) THEN
404          WRITE(*,*) 'GETH_NEWDATE:  Hour of ODATE = ', hrold
405          opass = .FALSE.
406       END IF
407       
408       !  Check that the minute of ODATE makes sense.
409       
410       IF ((miold.GT.59).or.(miold.LT.0)) THEN
411          WRITE(*,*) 'GETH_NEWDATE:  Minute of ODATE = ', miold
412          opass = .FALSE.
413       END IF
414       
415       !  Check that the second of ODATE makes sense.
416       
417       IF ((scold.GT.59).or.(scold.LT.0)) THEN
418          WRITE(*,*) 'GETH_NEWDATE:  Second of ODATE = ', scold
419          opass = .FALSE.
420       END IF
421       
422       !  Check that the fractional part  of ODATE makes sense.
423       
424       
425       IF (.not.opass) THEN
426          call mprintf(.true.,ERROR,'GETH_NEWDATE: Crazy ODATE: %s %i',s1=odate(1:olen),i1=olen)
427       END IF
428       
429       !  Date Checks are completed.  Continue.
430       
431       
432       !  Compute the number of days, hours, minutes, and seconds in idt
433       
434       IF (olen.GT.20) THEN !idt should be in fractions of seconds
435          ifrc = olen-20
436          ifrc = 10**ifrc
437          nday   = ABS(idt)/(86400*ifrc)
438          nhour  = MOD(ABS(idt),86400*ifrc)/(3600*ifrc)
439          nmin   = MOD(ABS(idt),3600*ifrc)/(60*ifrc)
440          nsec   = MOD(ABS(idt),60*ifrc)/(ifrc)
441          nfrac = MOD(ABS(idt), ifrc)
442       ELSE IF (olen.eq.19) THEN  !idt should be in seconds
443          ifrc = 1
444          nday   = ABS(idt)/86400 ! Integer number of days in delta-time
445          nhour  = MOD(ABS(idt),86400)/3600
446          nmin   = MOD(ABS(idt),3600)/60
447          nsec   = MOD(ABS(idt),60)
448          nfrac  = 0
449       ELSE IF (olen.eq.16) THEN !idt should be in minutes
450          ifrc = 1
451          nday   = ABS(idt)/1440 ! Integer number of days in delta-time
452          nhour  = MOD(ABS(idt),1440)/60
453          nmin   = MOD(ABS(idt),60)
454          nsec   = 0
455          nfrac  = 0
456       ELSE IF (olen.eq.13) THEN !idt should be in hours
457          ifrc = 1
458          nday   = ABS(idt)/24 ! Integer number of days in delta-time
459          nhour  = MOD(ABS(idt),24)
460          nmin   = 0
461          nsec   = 0
462          nfrac  = 0
463       ELSE IF (olen.eq.10) THEN !idt should be in days
464          ifrc = 1
465          nday   = ABS(idt)/24 ! Integer number of days in delta-time
466          nhour  = 0
467          nmin   = 0
468          nsec   = 0
469          nfrac  = 0
470       ELSE
471          call mprintf(.true.,ERROR,'GETH_NEWDATE: Strange length for ODATE: %i',i1=olen)
472       END IF
473       
474       IF (idt.GE.0) THEN
475       
476          frnew = frold + nfrac
477          IF (frnew.GE.ifrc) THEN
478             frnew = frnew - ifrc
479             nsec = nsec + 1
480          END IF
481       
482          scnew = scold + nsec
483          IF (scnew .GE. 60) THEN
484             scnew = scnew - 60
485             nmin  = nmin + 1
486          END IF
487       
488          minew = miold + nmin
489          IF (minew .GE. 60) THEN
490             minew = minew - 60
491             nhour  = nhour + 1
492          END IF
493       
494          hrnew = hrold + nhour
495          IF (hrnew .GE. 24) THEN
496             hrnew = hrnew - 24
497             nday  = nday + 1
498          END IF
499       
500          dynew = dyold
501          monew = moold
502          yrnew = yrold
503          DO i = 1, nday
504             dynew = dynew + 1
505             IF (dynew.GT.mday(monew)) THEN
506                dynew = dynew - mday(monew)
507                monew = monew + 1
508                IF (monew .GT. 12) THEN
509                   monew = 1
510                   yrnew = yrnew + 1
511                   ! If the year changes, recompute the number of days in February
512                   mday(2) = nfeb(yrnew)
513                END IF
514             END IF
515          END DO
516       
517       ELSE IF (idt.LT.0) THEN
518       
519          frnew = frold - nfrac
520          IF (frnew .LT. 0) THEN
521             frnew = frnew + ifrc
522             nsec = nsec - 1
523          END IF
524       
525          scnew = scold - nsec
526          IF (scnew .LT. 00) THEN
527             scnew = scnew + 60
528             nmin  = nmin + 1
529          END IF
530       
531          minew = miold - nmin
532          IF (minew .LT. 00) THEN
533             minew = minew + 60
534             nhour  = nhour + 1
535          END IF
536       
537          hrnew = hrold - nhour
538          IF (hrnew .LT. 00) THEN
539             hrnew = hrnew + 24
540             nday  = nday + 1
541          END IF
542       
543          dynew = dyold
544          monew = moold
545          yrnew = yrold
546          DO i = 1, nday
547             dynew = dynew - 1
548             IF (dynew.eq.0) THEN
549                monew = monew - 1
550                IF (monew.eq.0) THEN
551                   monew = 12
552                   yrnew = yrnew - 1
553                   ! If the year changes, recompute the number of days in February
554                   mday(2) = nfeb(yrnew)
555                END IF
556                dynew = mday(monew)
557             END IF
558          END DO
559       END IF
560       
561       !  Now construct the new mdate
562       
563       nlen = LEN(ndate)
564       
565       IF (nlen.GT.20) THEN
566          WRITE(ndate(1:19),19) yrnew, monew, dynew, hrnew, minew, scnew
567          WRITE(hfrc,'(I10)') frnew+1000000000
568          ndate = ndate(1:19)//'.'//hfrc(31-nlen:10)
569       
570       ELSE IF (nlen.eq.19.or.nlen.eq.20) THEN
571          WRITE(ndate(1:19),19) yrnew, monew, dynew, hrnew, minew, scnew
572       19   format(I4,'-',I2.2,'-',I2.2,'_',I2.2,':',I2.2,':',I2.2)
573          IF (nlen.eq.20) ndate = ndate(1:19)//'.'
574       
575       ELSE IF (nlen.eq.16) THEN
576          WRITE(ndate,16) yrnew, monew, dynew, hrnew, minew
577       16   format(I4,'-',I2.2,'-',I2.2,'_',I2.2,':',I2.2)
578       
579       ELSE IF (nlen.eq.13) THEN
580          WRITE(ndate,13) yrnew, monew, dynew, hrnew
581       13   format(I4,'-',I2.2,'-',I2.2,'_',I2.2)
582       
583       ELSE IF (nlen.eq.10) THEN
584          WRITE(ndate,10) yrnew, monew, dynew
585       10   format(I4,'-',I2.2,'-',I2.2)
586       
587       END IF
588       
589       IF (olen.GE.11) ndate(11:11) = sp
590    
591    END SUBROUTINE geth_newdate
593 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
595    FUNCTION nfeb ( year ) RESULT (num_days)
596    
597       ! Compute the number of days in February for the given year
598    
599       IMPLICIT NONE
600    
601       INTEGER :: year
602       INTEGER :: num_days
604 #ifdef NO_LEAP_CALENDAR
605       num_days = 28 ! February always has 28 days for No Leap Calendar ...
606 #else
607       num_days = 28 ! By default, February has 28 days ...
608       IF (MOD(year,4).eq.0) THEN  
609          num_days = 29       ! But every four years, it has 29 days ...
610          IF (MOD(year,100).eq.0) THEN
611             num_days = 28    ! Except every 100 years, when it has 28 days ...
612             IF (MOD(year,400).eq.0) THEN
613                num_days = 29 ! Except every 400 years, when it has 29 days.
614             END IF
615          END IF
616       END IF
617 #endif
618    
619    END FUNCTION nfeb
621 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
622    SUBROUTINE split_date_char ( date , century_year , month , day , hour , minute , second )
623      
624       IMPLICIT NONE
625    
626       !  Input data.
627    
628       CHARACTER(LEN=19) , INTENT(IN) :: date 
629    
630       !  Output data.
631    
632       INTEGER , INTENT(OUT) :: century_year , month , day , hour , minute , second
633       
634       READ(date,FMT='(    I4.4)') century_year
635       READ(date,FMT='( 5X,I2.2)') month
636       READ(date,FMT='( 8X,I2.2)') day
637       READ(date,FMT='(11X,I2.2)') hour
638       READ(date,FMT='(14X,I2.2)') minute
639       READ(date,FMT='(17X,I2.2)') second
640    
641    END SUBROUTINE split_date_char
642    
643 END MODULE date_pack