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 NEMO/branches/2019/ENHANCE-03_domcfg/src – NEMO

source: NEMO/branches/2019/ENHANCE-03_domcfg/src/daymod.f90 @ 11129

Last change on this file since 11129 was 11129, checked in by mathiot, 5 years ago

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