New URL for NEMO forge!   http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
date_utils.F90 in branches/2014/dev_r4650_UKMO14.11_SETTE_OBSASM/NEMOGCM/TOOLS/OBSTOOLS/src – NEMO

source: branches/2014/dev_r4650_UKMO14.11_SETTE_OBSASM/NEMOGCM/TOOLS/OBSTOOLS/src/date_utils.F90 @ 5591

Last change on this file since 5591 was 4751, checked in by djlea, 10 years ago

Changes to include an OBS test in SETTE. At the moment this uses an example profile observation.
File size: 11.6 KB
Line 
1MODULE date_utils
2
3   USE toolspar_kind
4   IMPLICIT NONE
5
6CONTAINS
7
8   SUBROUTINE add_date(initial_date,hours,final_date)
9
10      ! Add a number of hours to initial_date and return it in final_date
11
12      IMPLICIT NONE
13
14
15      !! Arguments
16      INTEGER,INTENT(in) :: initial_date ! Initial date (YYYYMMDDHH)
17      INTEGER,INTENT(in) :: hours        ! Number of hours to add
18      INTEGER,INTENT(out) :: final_date  ! Final date (YYYYMMDDHH)
19
20      !! Local variables
21
22      INTEGER :: isec,imin,ihours,iyear,imon,iday ! temporary results
23      REAL(dp):: juld
24
25      CALL split_date(initial_date,iyear,imon,iday,ihours)
26
27      CALL greg2jul(0,0,ihours,iday,imon,iyear,juld)
28
29      juld=juld+REAL(hours)/24.0
30
31      CALL jul2greg(isec,imin,ihours,iday,imon,iyear,juld)
32
33      final_date=iyear*1000000+imon*10000+iday*100+ihours
34
35   END SUBROUTINE add_date
36
37
38   SUBROUTINE add_days_to_date(initial_date,days,final_date)
39
40      ! Add a number of days to initial_date and return it in final_date
41
42      IMPLICIT NONE
43
44
45      !! Arguments
46      INTEGER,INTENT(in) :: initial_date ! Initial date (YYYYMMDD)
47      INTEGER,INTENT(in) :: days         ! Number of days to add
48      INTEGER,INTENT(out) :: final_date  ! Final date (YYYYMMDD)
49
50      !! Local variables
51
52      INTEGER :: isec,imin,ihours,iyear,imon,iday ! temporary results
53      REAL(dp):: juld
54
55      ! Account for lack of hours in date format (initial_date*100)
56      CALL split_date(initial_date*100,iyear,imon,iday,ihours)
57
58      CALL greg2jul(0,0,ihours,iday,imon,iyear,juld)
59
60      juld=juld+REAL(days)
61
62      CALL jul2greg(isec,imin,ihours,iday,imon,iyear,juld)
63
64      final_date=(iyear*1000000+imon*10000+iday*100+ihours)/100
65
66   END SUBROUTINE add_days_to_date
67
68
69   SUBROUTINE split_date(iyyyymmddhh,iyyyy,imm,idd,ihh)
70
71      ! Splits a date in YYYYMMDDHH format into iyyyy, imm, idd, ihh
72
73      IMPLICIT NONE
74      INTEGER,INTENT(in) :: iyyyymmddhh
75      INTEGER,INTENT(out) :: iyyyy,imm,idd,ihh
76
77      iyyyy=iyyyymmddhh/1000000
78      imm=iyyyymmddhh/10000-iyyyy*100
79      idd=iyyyymmddhh/100-(iyyyy*10000+imm*100)
80      ihh=MOD(iyyyymmddhh,100)
81
82   END SUBROUTINE split_date
83
84   SUBROUTINE jul2greg( ksec, kminut, khour, kday, kmonth, kyear, &
85      &                           prelday )
86
87      IMPLICIT NONE
88      !!-----------------------------------------------------------------------
89      !!
90      !!                     ***  ROUTINE jul2greg  ***
91      !!
92      !! ** Purpose : Take the relative time in days and re-express in terms of
93      !!              seconds, minutes, hours, days, month, year.
94      !!
95      !! ** Method  : Reference date : 19500101
96      !!
97      !! ** Action  :
98      !!
99      !! History
100      !!      ! 06-04  (A. Vidard) Original
101      !!      ! 06-05  (A. Vidard) Reformatted and refdate     
102      !!      ! 06-10  (A. Weaver) Cleanup
103      !!-----------------------------------------------------------------------
104
105      ! * Arguments
106      INTEGER, INTENT(OUT) :: &
107         & ksec,   &
108         & kminut, &
109         & khour,  &
110         & kday,   &
111         & kmonth, &
112         & kyear
113      REAL(KIND=dp), INTENT(IN) :: &
114         & prelday
115
116      !! * Local declarations
117      INTEGER, PARAMETER :: &
118         & jpgreg = 2299161, &
119         & jporef = 2433283, &
120         & jparef = 2415021
121      INTEGER :: &
122         & ijulian, &
123         & ij1,     &
124         & ija,     &
125         & ijb,     &
126         & ijc,     &
127         & ijd,     &
128         & ije,     &
129         & isec,    &
130         & imin,    &
131         & ihou,    &
132         & iday,    &
133         & imon,    &
134         & iyea,    &
135         & iref
136      REAL(KIND=wp) :: &
137         & zday, &
138         & zref
139
140      ! Main computation
141      iref = jporef 
142
143      zday = prelday
144      ksec = NINT( 86400. * MOD( zday, 1.0_wp ) )
145
146      IF ( ksec < 0. ) ksec = 86400. + ksec
147
148      khour  = ksec / 3600
149      kminut = ( ksec - 3600 * khour ) / 60
150      ksec   = MOD( ksec , 60 )
151
152      ijulian = iref + INT( zday )
153      IF ( zday < 0. ) ijulian = ijulian - 1
154
155      ! If input date after 10/15/1582 :
156      IF ( ijulian >= jpgreg ) THEN
157         ij1 = INT( ( DBLE( ijulian - 1867216 ) - 0.25 ) / 36524.25 )
158         ija = ijulian + 1 + ij1 - INT( ( 0.25 * ij1 ) )
159      ELSE
160         ija = ijulian
161      ENDIF
162
163      ijb = ija + 1524
164      ijc = INT( 6680. + ( DBLE ( ijb - 2439870 ) - 122.1 ) / 365.25 )
165      ijd = 365 * ijc + INT( 0.25 * ijc )
166      ije = INT( ( ijb - ijd ) / 30.6001 )
167      kday = ijb - ijd - INT( 30.6001 * ije )
168      kmonth = ije - 1
169      IF ( kmonth > 12 ) kmonth = kmonth - 12
170      kyear = ijc - 4715
171      IF ( kmonth > 2 ) kyear = kyear - 1
172      IF ( kyear <= 0 ) kyear = kyear - 1
173
174   END SUBROUTINE jul2greg
175
176   SUBROUTINE greg2jul( ksec, kmin, khour, kday, kmonth, kyear, pjulian )
177
178      IMPLICIT NONE
179      !!-----------------------------------------------------------------------
180      !!
181      !!                     ***  ROUTINE greg2jul  ***
182      !!
183      !! ** Purpose : Produce the time relative to the current date and time.
184      !!
185      !! ** Method  : The units are days, so hours and minutes transform to
186      !!              fractions of a day.
187      !!
188      !!              Reference date : 19500101
189      !! ** Action  :
190      !!
191      !! History :
192      !!      ! 06-04  (A. Vidard) Original
193      !!      ! 06-04  (A. Vidard) Reformatted
194      !!      ! 06-10  (A. Weaver) Cleanup
195      !!-----------------------------------------------------------------------
196
197      ! * Arguments
198      INTEGER, INTENT(IN) :: &
199         & ksec,   &
200         & kmin,   &
201         & khour,  & 
202         & kday,   &
203         & kmonth, & 
204         & kyear
205      REAL(KIND=dp), INTENT(OUT) :: &
206         & pjulian
207
208      !! * Local declarations
209      INTEGER, PARAMETER :: &
210         & jpgreg = 15 + 31 * ( 10 + 12 * 1582 ), &  ! Gregorian calendar introduction date
211         & jpjref = 2433283                          ! Julian reference date: 19500101
212      INTEGER :: &
213         & ija,     &
214         & ijy,     &
215         & ijm,     &
216         & ijultmp, &
217         & ijyear
218
219      ! Main computation
220      ijyear = kyear
221      IF ( ijyear < 0 ) ijyear = ijyear + 1
222      IF ( kmonth > 2 ) THEN
223         ijy = ijyear
224         ijm = kmonth + 1
225      ELSE
226         ijy = ijyear  - 1
227         ijm = kmonth + 13
228      ENDIF
229      ijultmp = INT( 365.25 * ijy ) + INT( 30.6001 * ijm ) + kday + 1720995
230      IF ( kday + 31 * ( kmonth + 12 * ijyear ) >= jpgreg ) THEN
231         ija = INT( 0.01 * ijy )
232         ijultmp = ijultmp + 2 - ija + INT( 0.25 * ija )
233      ENDIF
234      pjulian = ( ijultmp - jpjref ) + ( ( 60 * khour + kmin ) * 60 + ksec ) / 86400.
235
236   END SUBROUTINE greg2jul
237
238
239   SUBROUTINE addseconds(iyear,imon,iday,ihour,imin,isec,iaddsec)
240
241      ! Add iaddsecs to the date and return the new date (in place)
242
243      !! Arguments
244
245      INTEGER,intent(inout) :: iyear,imon,iday,ihour,imin,isec,iaddsec
246
247      !! Local variables
248
249      INTEGER :: itotsec,idays,isecs
250      INTEGER :: mday(12) = (/31,28,31,30,31,30,31,31,30,31,30,31/) 
251
252      itotsec=iaddsec+ihour*3600*imin*60+isec
253
254      IF (itotsec<0) THEN
255         WRITE(*,*)'Negative itotsec in addseconds'
256         WRITE(*,*)'This does not work'
257         RETURN
258      ENDIF
259
260      ihour=0
261      imin=0
262      isec=0
263
264      idays=itotsec/86400
265      isecs=itotsec-idays*86400
266      iday=iday+idays
267
268      ! Compute the date
269      DO
270         ! Leap year
271         mday(2)=28
272         IF (MOD(iyear,4).EQ.0) mday(2)=29
273         IF (MOD(iyear,100).EQ.0) mday(2)=28
274         IF (MOD(iyear,400).EQ.0) mday(2)=29
275         IF (MOD(iyear,4000).EQ.0) mday(2)=28
276
277         IF (iday.GT.mday(imon))THEN
278            iday=iday-mday(imon)
279            imon=imon+1
280            IF(imon.GT.12)THEN
281               imon=1
282               iyear=iyear+1
283            ENDIF
284         ELSE
285            EXIT
286         ENDIF
287
288      ENDDO
289
290      ! Set the time
291      ihour=isecs/3600
292      imin=isecs/60-ihour*60
293      isec=isecs-ihour*3600-imin*60
294
295   END SUBROUTINE addseconds
296
297   INTEGER FUNCTION nextdate(idate)
298
299      ! Return next date.
300      ! Date format is assumed to be YYYYMMDD
301
302      IMPLICIT NONE
303
304      !! Arguments
305
306      INTEGER :: idate ! Initial date
307
308      !! Local variables
309
310      INTEGER :: year,day,mon
311      INTEGER :: mday(12) = (/31,28,31,30,31,30,31,31,30,31,30,31/)
312
313
314      day=MOD(idate,100)
315      mon=MOD((idate-day)/100,100)
316      year=idate/10000
317
318      mday(2)=28
319      IF (MOD(year,4).EQ.0) mday(2)=29
320      IF (MOD(year,100).EQ.0) mday(2)=28
321      IF (MOD(year,400).EQ.0) mday(2)= 29
322      IF (MOD(year,4000).EQ.0) mday(2) = 28
323
324      day=day+1
325      IF (day.GT.mday(mon))THEN
326         day=1
327         mon=mon+1
328         IF(mon.GT.12)THEN
329            mon=1
330            year=year+1
331         ENDIF
332      ENDIF
333      nextdate=year*10000+mon*100+day
334      RETURN
335
336   END FUNCTION nextdate
337
338   INTEGER FUNCTION prevdate(idate)
339
340      ! Return previous date.
341      ! Date format is assumed to be YYYYMMDD
342
343      IMPLICIT NONE
344
345      !! Arguments
346
347      INTEGER :: idate ! Initial date
348
349      !! Local variables
350
351      INTEGER :: year,day,mon
352      INTEGER :: mday(12) = (/31,28,31,30,31,30,31,31,30,31,30,31/)
353
354
355      day=MOD(idate,100)
356      mon=MOD((idate-day)/100,100)
357      year=idate/10000
358
359      mday(2)=28
360      IF (MOD(year,4).EQ.0) mday(2)=29
361      IF (MOD(year,100).EQ.0) mday(2)=28
362      IF (MOD(year,400).EQ.0) mday(2)= 29
363      IF (MOD(year,4000).EQ.0) mday(2) = 28
364
365      day=day-1
366      IF (day.LT.1)THEN
367         mon=mon-1
368         IF(mon.LT.1)THEN
369            mon=12
370            year=year-1
371         ENDIF
372         day=mday(mon)
373      ENDIF
374      prevdate=year*10000+mon*100+day
375      RETURN
376
377   END FUNCTION prevdate
378
379   INTEGER FUNCTION diffdate(idate1,idate2)
380
381      ! Compute difference in days between dates
382      ! Assumes YYYYMMDD format for dates
383
384      IMPLICIT NONE
385
386      !! Argument
387
388      INTEGER :: idate1,idate2    ! Dates to be diffed.
389
390      !! Local variables
391
392      INTEGER :: itdate1,itdate2
393      INTEGER :: it
394
395      itdate1=MIN(idate1,idate2)
396      itdate2=MAX(idate1,idate2)
397
398      IF (itdate1==itdate2) THEN
399         diffdate=0
400         RETURN
401      ENDIF
402      diffdate=0
403      it=itdate1
404      DO
405         it=nextdate(it)
406         diffdate=diffdate+1
407         IF (it==itdate2) EXIT
408      ENDDO
409      RETURN
410
411   END FUNCTION diffdate
412
413   INTEGER FUNCTION difftime(itime1,itime2)
414
415      ! Compute difference in minutes between times
416      ! Assumes HHMM or HMM or MM or M format for dates
417      !
418      ! ORDER MATTERS - itime1 is ealier time
419      ! Result is an integer number of minutes
420
421      IMPLICIT NONE
422      INTEGER, INTENT(IN) :: itime1,itime2    ! Times to be diffed.
423      INTEGER :: imin1, imin2, ihr1, ihr2
424
425      ihr1 = (itime1/100)
426      ihr2 = (itime2/100)
427     
428      imin1 = (itime1 - ihr1*100) + (60 * ihr1)
429      imin2 = (itime2 - ihr2*100) + (60 * ihr2)
430     
431      ! Assume that itime2 is later, so wrap around midnight if necessary.
432      IF (imin2 < imin1) THEN
433         imin2 = imin2 + 24*60
434      END IF
435     
436      difftime = imin2 - imin1
437     
438   END FUNCTION difftime
439
440
441   INTEGER FUNCTION add_mins_to_time(itime1, imin_add)
442
443      ! Add number of minutes onto given time
444      ! Assumes time in HHMM or HMM or MM or M format
445      !
446      ! Result is in HHMM format
447
448      IMPLICIT NONE
449      INTEGER, INTENT(IN) :: itime1,imin_add
450      INTEGER :: imin1, ihr1, imin2, ihr2
451
452      ihr1 = (itime1/100)
453     
454      ! itime1 in minutes from previous midnight
455      imin1 = (itime1 - ihr1*100) + (60 * ihr1)
456     
457      imin1 = imin1 + imin_add
458     
459      ! Add 1day if time went nagative
460      IF (imin1 < 0) THEN
461         imin1 = imin1 + 24*60
462      END IF
463     
464      ! Turn number of minutes back into HHMM
465      ihr2 = imin1/60
466      imin2 = imin1 - ihr2*60
467
468      DO
469         IF (ihr2<0) THEN
470            ihr2 = ihr2 + 24
471         ELSE IF (ihr2>=24) THEN
472            ihr2 = ihr2 - 24
473         END IF
474         IF ((ihr2>=0).OR.(ihr2<24)) EXIT
475      END DO
476
477      add_mins_to_time = ihr2*100 + imin2
478   
479   END FUNCTION add_mins_to_time
480
481
482END MODULE date_utils
Note: See TracBrowser for help on using the repository browser.