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/dev_2802_OBStools/NEMOGCM/TOOLS/OBSTOOLS/src – NEMO

source: branches/dev_2802_OBStools/NEMOGCM/TOOLS/OBSTOOLS/src/date_utils.F90 @ 3000

Last change on this file since 3000 was 3000, checked in by djlea, 12 years ago

Updated obstools. Addition of headers to programs which explain what each utility does and how to run it. All the programs now build using the naketools utility.
File size: 9.3 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   SUBROUTINE split_date(iyyyymmddhh,iyyyy,imm,idd,ihh)
38
39      ! Splits a date in YYYYMMDDHH format into iyyyy, imm, idd, ihh
40
41      IMPLICIT NONE
42      INTEGER,INTENT(in) :: iyyyymmddhh
43      INTEGER,INTENT(out) :: iyyyy,imm,idd,ihh
44
45      iyyyy=iyyyymmddhh/1000000
46      imm=iyyyymmddhh/10000-iyyyy*100
47      idd=iyyyymmddhh/100-(iyyyy*10000+imm*100)
48      ihh=MOD(iyyyymmddhh,100)
49
50   END SUBROUTINE split_date
51
52   SUBROUTINE jul2greg( ksec, kminut, khour, kday, kmonth, kyear, &
53      &                           prelday )
54
55      IMPLICIT NONE
56      !!-----------------------------------------------------------------------
57      !!
58      !!                     ***  ROUTINE jul2greg  ***
59      !!
60      !! ** Purpose : Take the relative time in days and re-express in terms of
61      !!              seconds, minutes, hours, days, month, year.
62      !!
63      !! ** Method  : Reference date : 19500101
64      !!
65      !! ** Action  :
66      !!
67      !! History
68      !!      ! 06-04  (A. Vidard) Original
69      !!      ! 06-05  (A. Vidard) Reformatted and refdate     
70      !!      ! 06-10  (A. Weaver) Cleanup
71      !!-----------------------------------------------------------------------
72
73      ! * Arguments
74      INTEGER, INTENT(OUT) :: &
75         & ksec,   &
76         & kminut, &
77         & khour,  &
78         & kday,   &
79         & kmonth, &
80         & kyear
81      REAL(KIND=dp), INTENT(IN) :: &
82         & prelday
83
84      !! * Local declarations
85      INTEGER, PARAMETER :: &
86         & jpgreg = 2299161, &
87         & jporef = 2433283, &
88         & jparef = 2415021
89      INTEGER :: &
90         & ijulian, &
91         & ij1,     &
92         & ija,     &
93         & ijb,     &
94         & ijc,     &
95         & ijd,     &
96         & ije,     &
97         & isec,    &
98         & imin,    &
99         & ihou,    &
100         & iday,    &
101         & imon,    &
102         & iyea,    &
103         & iref
104      REAL(KIND=wp) :: &
105         & zday, &
106         & zref
107
108      ! Main computation
109      iref = jporef 
110
111      zday = prelday
112      ksec = NINT( 86400. * MOD( zday, 1.0_wp ) )
113
114      IF ( ksec < 0. ) ksec = 86400. + ksec
115
116      khour  = ksec / 3600
117      kminut = ( ksec - 3600 * khour ) / 60
118      ksec   = MOD( ksec , 60 )
119
120      ijulian = iref + INT( zday )
121      IF ( zday < 0. ) ijulian = ijulian - 1
122
123      ! If input date after 10/15/1582 :
124      IF ( ijulian >= jpgreg ) THEN
125         ij1 = INT( ( DBLE( ijulian - 1867216 ) - 0.25 ) / 36524.25 )
126         ija = ijulian + 1 + ij1 - INT( ( 0.25 * ij1 ) )
127      ELSE
128         ija = ijulian
129      ENDIF
130
131      ijb = ija + 1524
132      ijc = INT( 6680. + ( DBLE ( ijb - 2439870 ) - 122.1 ) / 365.25 )
133      ijd = 365 * ijc + INT( 0.25 * ijc )
134      ije = INT( ( ijb - ijd ) / 30.6001 )
135      kday = ijb - ijd - INT( 30.6001 * ije )
136      kmonth = ije - 1
137      IF ( kmonth > 12 ) kmonth = kmonth - 12
138      kyear = ijc - 4715
139      IF ( kmonth > 2 ) kyear = kyear - 1
140      IF ( kyear <= 0 ) kyear = kyear - 1
141
142   END SUBROUTINE jul2greg
143
144   SUBROUTINE greg2jul( ksec, kmin, khour, kday, kmonth, kyear, pjulian )
145
146      IMPLICIT NONE
147      !!-----------------------------------------------------------------------
148      !!
149      !!                     ***  ROUTINE greg2jul  ***
150      !!
151      !! ** Purpose : Produce the time relative to the current date and time.
152      !!
153      !! ** Method  : The units are days, so hours and minutes transform to
154      !!              fractions of a day.
155      !!
156      !!              Reference date : 19500101
157      !! ** Action  :
158      !!
159      !! History :
160      !!      ! 06-04  (A. Vidard) Original
161      !!      ! 06-04  (A. Vidard) Reformatted
162      !!      ! 06-10  (A. Weaver) Cleanup
163      !!-----------------------------------------------------------------------
164
165      ! * Arguments
166      INTEGER, INTENT(IN) :: &
167         & ksec,   &
168         & kmin,   &
169         & khour,  & 
170         & kday,   &
171         & kmonth, & 
172         & kyear
173      REAL(KIND=dp), INTENT(OUT) :: &
174         & pjulian
175
176      !! * Local declarations
177      INTEGER, PARAMETER :: &
178         & jpgreg = 15 + 31 * ( 10 + 12 * 1582 ), &  ! Gregorian calendar introduction date
179         & jpjref = 2433283                          ! Julian reference date: 19500101
180      INTEGER :: &
181         & ija,     &
182         & ijy,     &
183         & ijm,     &
184         & ijultmp, &
185         & ijyear
186
187      ! Main computation
188      ijyear = kyear
189      IF ( ijyear < 0 ) ijyear = ijyear + 1
190      IF ( kmonth > 2 ) THEN
191         ijy = ijyear
192         ijm = kmonth + 1
193      ELSE
194         ijy = ijyear  - 1
195         ijm = kmonth + 13
196      ENDIF
197      ijultmp = INT( 365.25 * ijy ) + INT( 30.6001 * ijm ) + kday + 1720995
198      IF ( kday + 31 * ( kmonth + 12 * ijyear ) >= jpgreg ) THEN
199         ija = INT( 0.01 * ijy )
200         ijultmp = ijultmp + 2 - ija + INT( 0.25 * ija )
201      ENDIF
202      pjulian = ( ijultmp - jpjref ) + ( ( 60 * khour + kmin ) * 60 + ksec ) / 86400.
203
204   END SUBROUTINE greg2jul
205
206
207   SUBROUTINE addseconds(iyear,imon,iday,ihour,imin,isec,iaddsec)
208
209      ! Add iaddsecs to the date and return the new date (in place)
210
211      !! Arguments
212
213      INTEGER,intent(inout) :: iyear,imon,iday,ihour,imin,isec,iaddsec
214
215      !! Local variables
216
217      INTEGER :: itotsec,idays,isecs
218      INTEGER :: mday(12) = (/31,28,31,30,31,30,31,31,30,31,30,31/) 
219
220      itotsec=iaddsec+ihour*3600*imin*60+isec
221
222      IF (itotsec<0) THEN
223         WRITE(*,*)'Negative itotsec in addseconds'
224         WRITE(*,*)'This does not work'
225         RETURN
226      ENDIF
227
228      ihour=0
229      imin=0
230      isec=0
231
232      idays=itotsec/86400
233      isecs=itotsec-idays*86400
234      iday=iday+idays
235
236      ! Compute the date
237      DO
238         ! Leap year
239         mday(2)=28
240         IF (MOD(iyear,4).EQ.0) mday(2)=29
241         IF (MOD(iyear,100).EQ.0) mday(2)=28
242         IF (MOD(iyear,400).EQ.0) mday(2)=29
243         IF (MOD(iyear,4000).EQ.0) mday(2)=28
244
245         IF (iday.GT.mday(imon))THEN
246            iday=iday-mday(imon)
247            imon=imon+1
248            IF(imon.GT.12)THEN
249               imon=1
250               iyear=iyear+1
251            ENDIF
252         ELSE
253            EXIT
254         ENDIF
255
256      ENDDO
257
258      ! Set the time
259      ihour=isecs/3600
260      imin=isecs/60-ihour*60
261      isec=isecs-ihour*3600-imin*60
262
263   END SUBROUTINE addseconds
264
265   INTEGER FUNCTION nextdate(idate)
266
267      ! Return next date.
268      ! Date format is assumed to be YYYYMMDD
269
270      IMPLICIT NONE
271
272      !! Arguments
273
274      INTEGER :: idate ! Initial date
275
276      !! Local variables
277
278      INTEGER :: year,day,mon
279      INTEGER :: mday(12) = (/31,28,31,30,31,30,31,31,30,31,30,31/)
280
281
282      day=MOD(idate,100)
283      mon=MOD((idate-day)/100,100)
284      year=idate/10000
285
286      mday(2)=28
287      IF (MOD(year,4).EQ.0) mday(2)=29
288      IF (MOD(year,100).EQ.0) mday(2)=28
289      IF (MOD(year,400).EQ.0) mday(2)= 29
290      IF (MOD(year,4000).EQ.0) mday(2) = 28
291
292      day=day+1
293      IF (day.GT.mday(mon))THEN
294         day=1
295         mon=mon+1
296         IF(mon.GT.12)THEN
297            mon=1
298            year=year+1
299         ENDIF
300      ENDIF
301      nextdate=year*10000+mon*100+day
302      RETURN
303
304   END FUNCTION nextdate
305
306   INTEGER FUNCTION prevdate(idate)
307
308      ! Return previous date.
309      ! Date format is assumed to be YYYYMMDD
310
311      IMPLICIT NONE
312
313      !! Arguments
314
315      INTEGER :: idate ! Initial date
316
317      !! Local variables
318
319      INTEGER :: year,day,mon
320      INTEGER :: mday(12) = (/31,28,31,30,31,30,31,31,30,31,30,31/)
321
322
323      day=MOD(idate,100)
324      mon=MOD((idate-day)/100,100)
325      year=idate/10000
326
327      mday(2)=28
328      IF (MOD(year,4).EQ.0) mday(2)=29
329      IF (MOD(year,100).EQ.0) mday(2)=28
330      IF (MOD(year,400).EQ.0) mday(2)= 29
331      IF (MOD(year,4000).EQ.0) mday(2) = 28
332
333      day=day-1
334      IF (day.LT.1)THEN
335         mon=mon-1
336         IF(mon.LT.1)THEN
337            mon=12
338            year=year-1
339         ENDIF
340         day=mday(mon)
341      ENDIF
342      prevdate=year*10000+mon*100+day
343      RETURN
344
345   END FUNCTION prevdate
346
347   INTEGER FUNCTION diffdate(idate1,idate2)
348
349      ! Compute difference in days between dates
350      ! Assumes YYYYMMDD format for dates
351
352      IMPLICIT NONE
353
354      !! Argument
355
356      INTEGER :: idate1,idate2    ! Dates to be diffed.
357
358      !! Local variables
359
360      INTEGER :: itdate1,itdate2
361      INTEGER :: it
362
363      itdate1=MIN(idate1,idate2)
364      itdate2=MAX(idate1,idate2)
365
366      IF (itdate1==itdate2) THEN
367         diffdate=0
368         RETURN
369      ENDIF
370      diffdate=0
371      it=itdate1
372      DO
373         it=nextdate(it)
374         diffdate=diffdate+1
375         IF (it==itdate2) EXIT
376      ENDDO
377      RETURN
378
379   END FUNCTION diffdate
380
381
382END MODULE date_utils
Note: See TracBrowser for help on using the repository browser.