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.
daymod.F90 in branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/DOM – NEMO

source: branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/DOM/daymod.F90 @ 6808

Last change on this file since 6808 was 6808, checked in by jamesharle, 8 years ago

merge with trunk@6232 for consistency with SSB code

  • Property svn:keywords set to Id
File size: 20.3 KB
Line 
1MODULE daymod
2   !!======================================================================
3   !!                       ***  MODULE  daymod  ***
4   !! Ocean        :  calendar
5   !!=====================================================================
6   !! History :  OPA  ! 1994-09  (M. Pontaud M. Imbard)  Original code
7   !!                 ! 1997-03  (O. Marti)
8   !!                 ! 1997-05  (G. Madec)
9   !!                 ! 1997-08  (M. Imbard)
10   !!   NEMO     1.0  ! 2003-09  (G. Madec)  F90 + nyear, nmonth, nday
11   !!                 ! 2004-01  (A.M. Treguier) new calculation based on adatrj
12   !!                 ! 2006-08  (G. Madec)  surface module major update
13   !!                 ! 2015-11  (D. Lea) Allow non-zero initial time of day
14   !!----------------------------------------------------------------------
15
16   !!----------------------------------------------------------------------
17   !!   day        : calendar
18   !!
19   !!           -------------------------------
20   !!           ----------- WARNING -----------
21   !!
22   !!   we suppose that the time step is deviding the number of second of in a day
23   !!             ---> MOD( rday, rdt ) == 0
24   !!
25   !!           ----------- WARNING -----------
26   !!           -------------------------------
27   !!
28   !!----------------------------------------------------------------------
29   USE dom_oce        ! ocean space and time domain
30   USE phycst         ! physical constants
31   USE in_out_manager ! I/O manager
32   USE iom            !
33   USE ioipsl  , ONLY :   ymds2ju   ! for calendar
34   USE prtctl         ! Print control
35   USE trc_oce , ONLY : lk_offline ! offline flag
36   USE timing         ! Timing
37   USE restart        ! restart
38
39   IMPLICIT NONE
40   PRIVATE
41
42   PUBLIC   day        ! called by step.F90
43   PUBLIC   day_init   ! called by istate.F90
44   PUBLIC   day_mth    ! Needed by TAM
45
46   INTEGER, PUBLIC ::   nsecd, nsecd05, ndt, ndt05   !: (PUBLIC for TAM)
47
48   !!----------------------------------------------------------------------
49   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
50   !! $Id$
51   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
52   !!----------------------------------------------------------------------
53CONTAINS
54
55   SUBROUTINE day_init
56      !!----------------------------------------------------------------------
57      !!                   ***  ROUTINE day_init  ***
58      !!
59      !! ** Purpose :   Initialization of the calendar values to their values 1 time step before nit000
60      !!                because day will be called at the beginning of step
61      !!
62      !! ** Action  : - nyear        : current year
63      !!              - nmonth       : current month of the year nyear
64      !!              - nday         : current day of the month nmonth
65      !!              - nday_year    : current day of the year nyear
66      !!              - nsec_year    : current time step counted in second since 00h jan 1st of the current year
67      !!              - nsec_month   : current time step counted in second since 00h 1st day of the current month
68      !!              - nsec_day     : current time step counted in second since 00h of the current day
69      !!              - nsec1jan000  : second since Jan. 1st 00h of nit000 year and Jan. 1st 00h of the current year
70      !!              - nmonth_len, nyear_len, nmonth_half, nmonth_end through day_mth
71      !!----------------------------------------------------------------------
72      INTEGER  ::   inbday, idweek
73      REAL(wp) ::   zjul
74      !!----------------------------------------------------------------------
75      !
76      ! max number of seconds between each restart
77      IF( REAL( nitend - nit000 + 1 ) * rdt > REAL( HUGE( nsec1jan000 ) ) ) THEN
78         CALL ctl_stop( 'The number of seconds between each restart exceeds the integer 4 max value: 2^31-1. ',   &
79            &           'You must do a restart at higher frequency (or remove this stop and recompile the code in I8)' )
80      ENDIF
81      ! all calendar staff is based on the fact that MOD( rday, rdt ) == 0
82      IF( MOD( rday     , rdt   ) /= 0. )   CALL ctl_stop( 'the time step must devide the number of second of in a day' )
83      IF( MOD( rday     , 2.    ) /= 0. )   CALL ctl_stop( 'the number of second of in a day must be an even number'    )
84      IF( MOD( rdt      , 2.    ) /= 0. )   CALL ctl_stop( 'the time step (in second) must be an even number'           )
85      nsecd   = NINT(rday       )
86      nsecd05 = NINT(0.5 * rday )
87      ndt     = NINT(      rdt  )
88      ndt05   = NINT(0.5 * rdt  )
89
90      IF( .NOT. lk_offline ) CALL day_rst( nit000, 'READ' )
91
92      ! set the calandar from ndastp (read in restart file and namelist)
93
94      nyear   =   ndastp / 10000
95      nmonth  = ( ndastp - (nyear * 10000) ) / 100
96      nday    =   ndastp - (nyear * 10000) - ( nmonth * 100 )
97
98      nhour   =   nn_time0 / 100
99      nminute = ( nn_time0 - nhour * 100 )
100
101      CALL ymds2ju( nyear, nmonth, nday, nhour*3600._wp+nminute*60._wp, fjulday ) 
102      IF( ABS(fjulday - REAL(NINT(fjulday),wp)) < 0.1 / rday )   fjulday = REAL(NINT(fjulday),wp)   ! avoid truncation error
103      IF( nn_time0*3600 - ndt05 .lt. 0 ) fjulday = fjulday + 1.                    ! move back to the day at nit000 (and not at nit000 - 1)
104
105      nsec1jan000 = 0
106      CALL day_mth
107
108      IF ( nday == 0 ) THEN     !   for ex if ndastp = ndate0 - 1
109         nmonth = nmonth - 1
110         nday = nmonth_len(nmonth)
111      ENDIF
112      IF ( nmonth == 0 ) THEN   ! go at the end of previous year
113         nmonth = 12
114         nyear = nyear - 1
115         nsec1jan000 = nsec1jan000 - nsecd * nyear_len(0)
116         IF( nleapy == 1 )   CALL day_mth
117      ENDIF
118
119      ! day since january 1st
120      nday_year = nday + SUM( nmonth_len(1:nmonth - 1) )
121
122      !compute number of days between last monday and today
123      CALL ymds2ju( 1900, 01, 01, 0.0, zjul )  ! compute julian day value of 01.01.1900 (our reference that was a Monday)
124      inbday = FLOOR(fjulday - zjul)            ! compute nb day between  01.01.1900 and start of current day
125      idweek = MOD(inbday, 7)                  ! compute nb day between last monday and current day
126      IF (idweek .lt. 0) idweek=idweek+7       ! Avoid negative values for dates before 01.01.1900
127
128      ! number of seconds since the beginning of current year/month/week/day at the middle of the time-step
129      IF (nhour*3600+nminute*60-ndt05 .gt. 0) THEN
130         ! 1 timestep before current middle of first time step is still the same day
131         nsec_year  = (nday_year-1) * nsecd + nhour*3600+nminute*60 - ndt05 
132         nsec_month = (nday-1)      * nsecd + nhour*3600+nminute*60 - ndt05   
133      ELSE
134         ! 1 time step before the middle of the first time step is the previous day
135         nsec_year  = nday_year * nsecd + nhour*3600+nminute*60 - ndt05 
136         nsec_month = nday      * nsecd + nhour*3600+nminute*60 - ndt05   
137      ENDIF
138      nsec_week  = idweek    * nsecd + nhour*3600+nminute*60 - ndt05
139      nsec_day   =             nhour*3600+nminute*60 - ndt05 
140      IF( nsec_day .lt. 0 ) nsec_day = nsec_day + nsecd
141      IF( nsec_week .lt. 0 ) nsec_week = nsec_week + nsecd*7
142
143      ! control print
144      IF(lwp) WRITE(numout,'(a,i6,a,i2,a,i2,a,i8,a,i8,a,i8,a,i8)')' =======>> 1/2 time step before the start of the run DATE Y/M/D = ',   &
145           &                   nyear, '/', nmonth, '/', nday, '  nsec_day:', nsec_day, '  nsec_week:', nsec_week, '  &
146           &                   nsec_month:', nsec_month , '  nsec_year:' , nsec_year
147
148      ! Up to now, calendar parameters are related to the end of previous run (nit000-1)
149      ! call day to set the calendar parameters at the begining of the current simulaton. needed by iom_init
150      CALL day( nit000 )
151      !
152   END SUBROUTINE day_init
153
154
155   SUBROUTINE day_mth
156      !!----------------------------------------------------------------------
157      !!                   ***  ROUTINE day_init  ***
158      !!
159      !! ** Purpose :   calendar values related to the months
160      !!
161      !! ** Action  : - nmonth_len    : length in days of the months of the current year
162      !!              - nyear_len     : length in days of the previous/current year
163      !!              - nmonth_half   : second since the beginning of the year and the halft of the months
164      !!              - nmonth_end    : second since the beginning of the year and the end of the months
165      !!----------------------------------------------------------------------
166      INTEGER  ::   jm               ! dummy loop indice
167      !!----------------------------------------------------------------------
168
169      ! length of the month of the current year (from nleapy, read in namelist)
170      IF ( nleapy < 2 ) THEN
171         nmonth_len(:) = (/ 31, 31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31, 31 /)
172         nyear_len(:) = 365
173         IF ( nleapy == 1 ) THEN   ! we are using calandar with leap years
174            IF ( MOD(nyear-1, 4) == 0 .AND. ( MOD(nyear-1, 400) == 0 .OR. MOD(nyear-1, 100) /= 0 ) ) THEN
175               nyear_len(0)  = 366
176            ENDIF
177            IF ( MOD(nyear  , 4) == 0 .AND. ( MOD(nyear  , 400) == 0 .OR. MOD(nyear  , 100) /= 0 ) ) THEN
178               nmonth_len(2) = 29
179               nyear_len(1)  = 366
180            ENDIF
181            IF ( MOD(nyear+1, 4) == 0 .AND. ( MOD(nyear+1, 400) == 0 .OR. MOD(nyear+1, 100) /= 0 ) ) THEN
182               nyear_len(2)  = 366
183            ENDIF
184         ENDIF
185      ELSE
186         nmonth_len(:) = nleapy   ! all months with nleapy days per year
187         nyear_len(:) = 12 * nleapy
188      ENDIF
189
190      ! half month in second since the begining of the year:
191      ! time since Jan 1st   0     1     2    ...    11    12    13
192      !          ---------*--|--*--|--*--| ... |--*--|--*--|--*--|--------------------------------------
193      !                 <---> <---> <--->  ...  <---> <---> <--->
194      ! month number      0     1     2    ...    11    12    13
195      !
196      ! nmonth_half(jm) = rday * REAL( 0.5 * nmonth_len(jm) + SUM(nmonth_len(1:jm-1)) )
197      nmonth_half(0) = - nsecd05 * nmonth_len(0)
198      DO jm = 1, 13
199         nmonth_half(jm) = nmonth_half(jm-1) + nsecd05 * ( nmonth_len(jm-1) + nmonth_len(jm) )
200      END DO
201
202      nmonth_end(0) = 0
203      DO jm = 1, 13
204         nmonth_end(jm) = nmonth_end(jm-1) + nsecd * nmonth_len(jm)
205      END DO
206      !
207   END SUBROUTINE
208
209
210   SUBROUTINE day( kt )
211      !!----------------------------------------------------------------------
212      !!                      ***  ROUTINE day  ***
213      !!
214      !! ** Purpose :   Compute the date with a day iteration IF necessary.
215      !!
216      !! ** Method  : - ???
217      !!
218      !! ** Action  : - nyear     : current year
219      !!              - nmonth    : current month of the year nyear
220      !!              - nday      : current day of the month nmonth
221      !!              - nday_year : current day of the year nyear
222      !!              - ndastp    : = nyear*10000 + nmonth*100 + nday
223      !!              - adatrj    : date in days since the beginning of the run
224      !!              - nsec_year : current time of the year (in second since 00h, jan 1st)
225      !!----------------------------------------------------------------------
226      INTEGER, INTENT(in) ::   kt        ! ocean time-step indices
227      !
228      CHARACTER (len=25) ::   charout
229      REAL(wp)           ::   zprec      ! fraction of day corresponding to 0.1 second
230      !!----------------------------------------------------------------------
231      !
232      IF( nn_timing == 1 )  CALL timing_start('day')
233      !
234      zprec = 0.1 / rday
235      !                                                 ! New time-step
236      nsec_year  = nsec_year  + ndt
237      nsec_month = nsec_month + ndt
238      nsec_week  = nsec_week  + ndt
239      nsec_day   = nsec_day   + ndt
240      adatrj  = adatrj  + rdt / rday
241      fjulday = fjulday + rdt / rday
242      IF( ABS(fjulday - REAL(NINT(fjulday),wp)) < zprec )   fjulday = REAL(NINT(fjulday),wp)   ! avoid truncation error
243      IF( ABS(adatrj  - REAL(NINT(adatrj ),wp)) < zprec )   adatrj  = REAL(NINT(adatrj ),wp)   ! avoid truncation error
244
245      IF( nsec_day > nsecd ) THEN                       ! New day
246         !
247         nday      = nday + 1
248         nday_year = nday_year + 1
249         nsec_day  = ndt05
250         !
251         IF( nday == nmonth_len(nmonth) + 1 ) THEN      ! New month
252            nday   = 1
253            nmonth = nmonth + 1
254            nsec_month = ndt05
255            IF( nmonth == 13 ) THEN                     ! New year
256               nyear     = nyear + 1
257               nmonth    = 1
258               nday_year = 1
259               nsec_year = ndt05
260               nsec1jan000 = nsec1jan000 + nsecd * nyear_len(1)
261               IF( nleapy == 1 )   CALL day_mth
262            ENDIF
263         ENDIF
264         !
265         ndastp = nyear * 10000 + nmonth * 100 + nday   ! New date
266         !
267         !compute first day of the year in julian days
268         CALL ymds2ju( nyear, 01, 01, 0.0, fjulstartyear )
269         !
270         IF(lwp) WRITE(numout,'(a,i8,a,i4.4,a,i2.2,a,i2.2,a,i3.3)') '======>> time-step =', kt,   &
271              &   '      New day, DATE Y/M/D = ', nyear, '/', nmonth, '/', nday, '      nday_year = ', nday_year
272         IF(lwp) WRITE(numout,'(a,i8,a,i7,a,i5)') '         nsec_year = ', nsec_year,   &
273              &   '   nsec_month = ', nsec_month, '   nsec_day = ', nsec_day, '   nsec_week = ', nsec_week
274      ENDIF
275
276      IF( nsec_week > 7*nsecd )   nsec_week = ndt05     ! New week
277
278      IF(ln_ctl) THEN
279         WRITE(charout,FMT="('kt =', I4,'  d/m/y =',I2,I2,I4)") kt, nday, nmonth, nyear
280         CALL prt_ctl_info(charout)
281      ENDIF
282
283      IF( .NOT. lk_offline ) CALL rst_opn( kt )               ! Open the restart file if needed and control lrst_oce
284      IF( lrst_oce         ) CALL day_rst( kt, 'WRITE' )      ! write day restart information
285      !
286      IF( nn_timing == 1 )  CALL timing_stop('day')
287      !
288   END SUBROUTINE day
289
290
291   SUBROUTINE day_rst( kt, cdrw )
292      !!---------------------------------------------------------------------
293      !!                   ***  ROUTINE ts_rst  ***
294      !!
295      !!  ** Purpose : Read or write calendar in restart file:
296      !!
297      !!  WRITE(READ) mode:
298      !!       kt        : number of time step since the begining of the experiment at the
299      !!                   end of the current(previous) run
300      !!       adatrj(0) : number of elapsed days since the begining of the experiment at the
301      !!                   end of the current(previous) run (REAL -> keep fractions of day)
302      !!       ndastp    : date at the end of the current(previous) run (coded as yyyymmdd integer)
303      !!
304      !!   According to namelist parameter nrstdt,
305      !!       nrstdt = 0  no control on the date (nit000 is  arbitrary).
306      !!       nrstdt = 1  we verify that nit000 is equal to the last
307      !!                   time step of previous run + 1.
308      !!       In both those options, the  exact duration of the experiment
309      !!       since the beginning (cumulated duration of all previous restart runs)
310      !!       is not stored in the restart and is assumed to be (nit000-1)*rdt.
311      !!       This is valid is the time step has remained constant.
312      !!
313      !!       nrstdt = 2  the duration of the experiment in days (adatrj)
314      !!                    has been stored in the restart file.
315      !!----------------------------------------------------------------------
316      INTEGER         , INTENT(in) ::   kt         ! ocean time-step
317      CHARACTER(len=*), INTENT(in) ::   cdrw       ! "READ"/"WRITE" flag
318      !
319      REAL(wp) ::   zkt, zndastp, zdayfrac, ksecs, ktime
320      INTEGER  ::   ihour, iminute
321      !!----------------------------------------------------------------------
322
323      IF( TRIM(cdrw) == 'READ' ) THEN
324
325         IF( iom_varid( numror, 'kt', ldstop = .FALSE. ) > 0 ) THEN
326            ! Get Calendar informations
327            CALL iom_get( numror, 'kt', zkt )   ! last time-step of previous run
328            IF(lwp) THEN
329               WRITE(numout,*) ' *** Info read in restart : '
330               WRITE(numout,*) '   previous time-step                               : ', NINT( zkt )
331               WRITE(numout,*) ' *** restart option'
332               SELECT CASE ( nrstdt )
333               CASE ( 0 )   ;   WRITE(numout,*) ' nrstdt = 0 : no control of nit000'
334               CASE ( 1 )   ;   WRITE(numout,*) ' nrstdt = 1 : no control the date at nit000 (use ndate0 read in the namelist)'
335               CASE ( 2 )   ;   WRITE(numout,*) ' nrstdt = 2 : calendar parameters read in restart'
336               END SELECT
337               WRITE(numout,*)
338            ENDIF
339            ! Control of date
340            IF( nit000 - NINT( zkt ) /= 1 .AND. nrstdt /= 0 )                                         &
341                 &   CALL ctl_stop( ' ===>>>> : problem with nit000 for the restart',                 &
342                 &                  ' verify the restart file or rerun with nrstdt = 0 (namelist)' )
343            ! define ndastp and adatrj
344            IF ( nrstdt == 2 ) THEN
345               ! read the parameters corresponding to nit000 - 1 (last time step of previous run)
346               CALL iom_get( numror, 'ndastp', zndastp )
347               ndastp = NINT( zndastp )
348               CALL iom_get( numror, 'adatrj', adatrj  )
349          CALL iom_get( numror, 'ntime', ktime )
350          nn_time0=INT(ktime)
351               ! calculate start time in hours and minutes
352          zdayfrac=adatrj-INT(adatrj)
353          ksecs = NINT(zdayfrac*86400)        ! Nearest second to catch rounding errors in adatrj         
354          ihour = INT(ksecs/3600)
355          iminute = ksecs/60-ihour*60
356           
357               ! Add to nn_time0
358               nhour   =   nn_time0 / 100
359               nminute = ( nn_time0 - nhour * 100 )
360          nminute=nminute+iminute
361         
362          IF( nminute >= 60 ) THEN
363             nminute=nminute-60
364        nhour=nhour+1
365          ENDIF
366          nhour=nhour+ihour
367          IF( nhour >= 24 ) THEN
368        nhour=nhour-24
369             adatrj=adatrj+1
370          ENDIF         
371          nn_time0 = nhour * 100 + nminute
372          adatrj = INT(adatrj)                    ! adatrj set to integer as nn_time0 updated         
373            ELSE
374               ! parameters corresponding to nit000 - 1 (as we start the step loop with a call to day)
375               ndastp = ndate0        ! ndate0 read in the namelist in dom_nam
376               nhour   =   nn_time0 / 100
377               nminute = ( nn_time0 - nhour * 100 )
378               IF( nhour*3600+nminute*60-ndt05 .lt. 0 )  ndastp=ndastp-1      ! Start hour is specified in the namelist (default 0)
379               adatrj = ( REAL( nit000-1, wp ) * rdt ) / rday
380               ! note this is wrong if time step has changed during run
381            ENDIF
382         ELSE
383            ! parameters corresponding to nit000 - 1 (as we start the step loop with a call to day)
384            ndastp = ndate0           ! ndate0 read in the namelist in dom_nam
385            nhour   =   nn_time0 / 100
386       nminute = ( nn_time0 - nhour * 100 )
387            IF( nhour*3600+nminute*60-ndt05 .lt. 0 )  ndastp=ndastp-1      ! Start hour is specified in the namelist (default 0)
388            adatrj = ( REAL( nit000-1, wp ) * rdt ) / rday
389         ENDIF
390         IF( ABS(adatrj  - REAL(NINT(adatrj),wp)) < 0.1 / rday )   adatrj = REAL(NINT(adatrj),wp)   ! avoid truncation error
391         !
392         IF(lwp) THEN
393            WRITE(numout,*) ' *** Info used values : '
394            WRITE(numout,*) '   date ndastp                                      : ', ndastp
395            WRITE(numout,*) '   number of elapsed days since the begining of run : ', adatrj
396       WRITE(numout,*) '   nn_time0                                         : ',nn_time0
397            WRITE(numout,*)
398         ENDIF
399         !
400      ELSEIF( TRIM(cdrw) == 'WRITE' ) THEN
401         !
402         IF( kt == nitrst ) THEN
403            IF(lwp) WRITE(numout,*)
404            IF(lwp) WRITE(numout,*) 'rst_write : write oce restart file  kt =', kt
405            IF(lwp) WRITE(numout,*) '~~~~~~~'
406         ENDIF
407         ! calendar control
408         CALL iom_rstput( kt, nitrst, numrow, 'kt'     , REAL( kt    , wp) )   ! time-step
409         CALL iom_rstput( kt, nitrst, numrow, 'ndastp' , REAL( ndastp, wp) )   ! date
410         CALL iom_rstput( kt, nitrst, numrow, 'adatrj' , adatrj            )   ! number of elapsed days since
411         !                                                                     ! the begining of the run [s]
412    CALL iom_rstput( kt, nitrst, numrow, 'ntime'  , REAL( nn_time0, wp) ) ! time
413      ENDIF
414      !
415   END SUBROUTINE day_rst
416
417   !!======================================================================
418END MODULE daymod
Note: See TracBrowser for help on using the repository browser.