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 utils/tools_dev_r12970_AGRIF_CMEMS/DOMAINcfg/src – NEMO

source: utils/tools_dev_r12970_AGRIF_CMEMS/DOMAINcfg/src/daymod.f90 @ 13024

Last change on this file since 13024 was 13024, checked in by rblod, 4 years ago

First version of new nesting tools merged with domaincfg, see ticket #2129
File size: 20.4 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(ln_ctl) THEN
277         WRITE(charout,FMT="('kt =', I4,'  d/m/y =',I2,I2,I4)") kt, nday, nmonth, nyear
278         CALL prt_ctl_info(charout)
279      ENDIF
280
281      IF( lrst_oce         ) CALL day_rst( kt, 'WRITE' )      ! write day restart information
282      !
283      IF( ln_timing )   CALL timing_stop('day')
284      !
285   END SUBROUTINE day
286
287
288   SUBROUTINE day_rst( kt, cdrw )
289      !!---------------------------------------------------------------------
290      !!                   ***  ROUTINE day_rst  ***
291      !!
292      !!  ** Purpose : Read or write calendar in restart file:
293      !!
294      !!  WRITE(READ) mode:
295      !!       kt        : number of time step since the begining of the experiment at the
296      !!                   end of the current(previous) run
297      !!       adatrj(0) : number of elapsed days since the begining of the experiment at the
298      !!                   end of the current(previous) run (REAL -> keep fractions of day)
299      !!       ndastp    : date at the end of the current(previous) run (coded as yyyymmdd integer)
300      !!
301      !!   According to namelist parameter nrstdt,
302      !!       nrstdt = 0  no control on the date (nit000 is  arbitrary).
303      !!       nrstdt = 1  we verify that nit000 is equal to the last
304      !!                   time step of previous run + 1.
305      !!       In both those options, the  exact duration of the experiment
306      !!       since the beginning (cumulated duration of all previous restart runs)
307      !!       is not stored in the restart and is assumed to be (nit000-1)*rdt.
308      !!       This is valid is the time step has remained constant.
309      !!
310      !!       nrstdt = 2  the duration of the experiment in days (adatrj)
311      !!                    has been stored in the restart file.
312      !!----------------------------------------------------------------------
313      INTEGER         , INTENT(in) ::   kt         ! ocean time-step
314      CHARACTER(len=*), INTENT(in) ::   cdrw       ! "READ"/"WRITE" flag
315      !
316      REAL(wp) ::   zkt, zndastp, zdayfrac, ksecs, ktime
317      INTEGER  ::   ihour, iminute
318      !!----------------------------------------------------------------------
319
320      IF( TRIM(cdrw) == 'READ' ) THEN
321
322         IF( iom_varid( numror, 'kt', ldstop = .FALSE. ) > 0 ) THEN
323            ! Get Calendar informations
324            CALL iom_get( numror, 'kt', zkt, ldxios = lrxios )   ! last time-step of previous run
325            IF(lwp) THEN
326               WRITE(numout,*) ' *** Info read in restart : '
327               WRITE(numout,*) '   previous time-step                               : ', NINT( zkt )
328               WRITE(numout,*) ' *** restart option'
329               SELECT CASE ( nrstdt )
330               CASE ( 0 )   ;   WRITE(numout,*) ' nrstdt = 0 : no control of nit000'
331               CASE ( 1 )   ;   WRITE(numout,*) ' nrstdt = 1 : no control the date at nit000 (use ndate0 read in the namelist)'
332               CASE ( 2 )   ;   WRITE(numout,*) ' nrstdt = 2 : calendar parameters read in restart'
333               END SELECT
334               WRITE(numout,*)
335            ENDIF
336            ! Control of date
337            IF( nit000 - NINT( zkt ) /= 1 .AND. nrstdt /= 0 )                                         &
338                 &   CALL ctl_stop( ' ===>>>> : problem with nit000 for the restart',                 &
339                 &                  ' verify the restart file or rerun with nrstdt = 0 (namelist)' )
340            ! define ndastp and adatrj
341            IF ( nrstdt == 2 ) THEN
342               ! read the parameters corresponding to nit000 - 1 (last time step of previous run)
343               CALL iom_get( numror, 'ndastp', zndastp, ldxios = lrxios )
344               ndastp = NINT( zndastp )
345               CALL iom_get( numror, 'adatrj', adatrj , ldxios = lrxios )
346          CALL iom_get( numror, 'ntime' , ktime  , ldxios = lrxios )
347          nn_time0=INT(ktime)
348               ! calculate start time in hours and minutes
349          zdayfrac=adatrj-INT(adatrj)
350          ksecs = NINT(zdayfrac*86400)        ! Nearest second to catch rounding errors in adatrj         
351          ihour = INT(ksecs/3600)
352          iminute = ksecs/60-ihour*60
353           
354               ! Add to nn_time0
355               nhour   =   nn_time0 / 100
356               nminute = ( nn_time0 - nhour * 100 )
357          nminute=nminute+iminute
358         
359          IF( nminute >= 60 ) THEN
360             nminute=nminute-60
361        nhour=nhour+1
362          ENDIF
363          nhour=nhour+ihour
364          IF( nhour >= 24 ) THEN
365        nhour=nhour-24
366             adatrj=adatrj+1
367          ENDIF         
368          nn_time0 = nhour * 100 + nminute
369          adatrj = INT(adatrj)                    ! adatrj set to integer as nn_time0 updated         
370            ELSE
371               ! parameters corresponding to nit000 - 1 (as we start the step loop with a call to day)
372               ndastp = ndate0        ! ndate0 read in the namelist in dom_nam
373               nhour   =   nn_time0 / 100
374               nminute = ( nn_time0 - nhour * 100 )
375               IF( nhour*3600+nminute*60-ndt05 .lt. 0 )  ndastp=ndastp-1      ! Start hour is specified in the namelist (default 0)
376               adatrj = ( REAL( nit000-1, wp ) * rdt ) / rday
377               ! note this is wrong if time step has changed during run
378            ENDIF
379         ELSE
380            ! parameters corresponding to nit000 - 1 (as we start the step loop with a call to day)
381            ndastp = ndate0           ! ndate0 read in the namelist in dom_nam
382            nhour   =   nn_time0 / 100
383       nminute = ( nn_time0 - nhour * 100 )
384            IF( nhour*3600+nminute*60-ndt05 .lt. 0 )  ndastp=ndastp-1      ! Start hour is specified in the namelist (default 0)
385            adatrj = ( REAL( nit000-1, wp ) * rdt ) / rday
386         ENDIF
387         IF( ABS(adatrj  - REAL(NINT(adatrj),wp)) < 0.1 / rday )   adatrj = REAL(NINT(adatrj),wp)   ! avoid truncation error
388         !
389         IF(lwp) THEN
390            WRITE(numout,*) ' *** Info used values : '
391            WRITE(numout,*) '   date ndastp                                      : ', ndastp
392            WRITE(numout,*) '   number of elapsed days since the begining of run : ', adatrj
393       WRITE(numout,*) '   nn_time0                                         : ',nn_time0
394            WRITE(numout,*)
395         ENDIF
396         !
397      ELSEIF( TRIM(cdrw) == 'WRITE' ) THEN
398         !
399         IF( kt == nitrst ) THEN
400            IF(lwp) WRITE(numout,*)
401            IF(lwp) WRITE(numout,*) 'rst_write : write oce restart file  kt =', kt
402            IF(lwp) WRITE(numout,*) '~~~~~~~'
403         ENDIF
404         ! calendar control
405         IF( lwxios ) CALL iom_swap(      cwxios_context          )
406         CALL iom_rstput( kt, nitrst, numrow, 'kt'     , REAL( kt    , wp)  , ldxios = lwxios )   ! time-step
407         CALL iom_rstput( kt, nitrst, numrow, 'ndastp' , REAL( ndastp, wp)  , ldxios = lwxios )   ! date
408         CALL iom_rstput( kt, nitrst, numrow, 'adatrj' , adatrj             , ldxios = lwxios            )   ! number of elapsed days since
409         !                                                                                                   ! the begining of the run [s]
410         CALL iom_rstput( kt, nitrst, numrow, 'ntime'  , REAL( nn_time0, wp), ldxios = lwxios ) ! time
411         IF( lwxios ) CALL iom_swap(      cxios_context          )
412      ENDIF
413      !
414   END SUBROUTINE day_rst
415
416   !!======================================================================
417END MODULE daymod
Note: See TracBrowser for help on using the repository browser.