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 trunk/NEMOGCM/NEMO/OPA_SRC/DOM – NEMO

source: trunk/NEMOGCM/NEMO/OPA_SRC/DOM/daymod.F90 @ 7753

Last change on this file since 7753 was 7646, checked in by timgraham, 7 years ago

Merge of dev_merge_2016 into trunk. UPDATE TO ARCHFILES NEEDED for XIOS2.
LIM_SRC_s/limrhg.F90 to follow in next commit due to change of kind (I'm unable to do it in this commit).
Merged using the following steps:

1) svn merge --reintegrate svn+ssh://forge.ipsl.jussieu.fr/ipsl/forge/projets/nemo/svn/trunk .
2) Resolve minor conflicts in sette.sh and namelist_cfg for ORCA2LIM3 (due to a change in trunk after branch was created)
3) svn commit
4) svn switch svn+ssh://forge.ipsl.jussieu.fr/ipsl/forge/projets/nemo/svn/trunk
5) svn merge svn+ssh://forge.ipsl.jussieu.fr/ipsl/forge/projets/nemo/svn/branches/2016/dev_merge_2016 .
6) At this stage I checked out a clean copy of the branch to compare against what is about to be committed to the trunk.
6) svn commit #Commit code to the trunk

In this commit I have also reverted a change to Fcheck_archfile.sh which was causing problems on the Paris machine.

  • Property svn:keywords set to Id
File size: 20.0 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   USE trc_oce , ONLY :   l_offline   ! offline flag
29   !
30   USE in_out_manager ! I/O manager
31   USE prtctl         ! Print control
32   USE iom            !
33   USE timing         ! Timing
34   USE restart        ! restart
35
36   IMPLICIT NONE
37   PRIVATE
38
39   PUBLIC   day        ! called by step.F90
40   PUBLIC   day_init   ! called by istate.F90
41   PUBLIC   day_mth    ! Needed by TAM
42
43   INTEGER, PUBLIC ::   nsecd, nsecd05, ndt, ndt05   !: (PUBLIC for TAM)
44
45   !!----------------------------------------------------------------------
46   !! NEMO/OPA 4.0 , NEMO Consortium (2016)
47   !! $Id$
48   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
49   !!----------------------------------------------------------------------
50CONTAINS
51
52   SUBROUTINE day_init
53      !!----------------------------------------------------------------------
54      !!                   ***  ROUTINE day_init  ***
55      !!
56      !! ** Purpose :   Initialization of the calendar values to their values 1 time step before nit000
57      !!                because day will be called at the beginning of step
58      !!
59      !! ** Action  : - nyear        : current year
60      !!              - nmonth       : current month of the year nyear
61      !!              - nday         : current day of the month nmonth
62      !!              - nday_year    : current day of the year nyear
63      !!              - nsec_year    : current time step counted in second since 00h jan 1st of the current year
64      !!              - nsec_month   : current time step counted in second since 00h 1st day of the current month
65      !!              - nsec_day     : current time step counted in second since 00h of the current day
66      !!              - nsec1jan000  : second since Jan. 1st 00h of nit000 year and Jan. 1st 00h of the current year
67      !!              - nmonth_len, nyear_len, nmonth_half, nmonth_end through day_mth
68      !!----------------------------------------------------------------------
69      INTEGER  ::   inbday, idweek   ! local integers
70      REAL(wp) ::   zjul             ! local scalar
71      !!----------------------------------------------------------------------
72      !
73      ! max number of seconds between each restart
74      IF( REAL( nitend - nit000 + 1 ) * rdt > REAL( HUGE( nsec1jan000 ) ) ) THEN
75         CALL ctl_stop( 'The number of seconds between each restart exceeds the integer 4 max value: 2^31-1. ',   &
76            &           'You must do a restart at higher frequency (or remove this stop and recompile the code in I8)' )
77      ENDIF
78      nsecd   = NINT( rday       )
79      nsecd05 = NINT( 0.5 * rday )
80      ndt     = NINT(       rdt  )
81      ndt05   = NINT( 0.5 * rdt  )
82
83      IF( .NOT. l_offline )   CALL day_rst( nit000, 'READ' )
84
85      ! set the calandar from ndastp (read in restart file and namelist)
86      nyear   =   ndastp / 10000
87      nmonth  = ( ndastp - (nyear * 10000) ) / 100
88      nday    =   ndastp - (nyear * 10000) - ( nmonth * 100 )
89
90      nhour   =   nn_time0 / 100
91      nminute = ( nn_time0 - nhour * 100 )
92
93      CALL ymds2ju( nyear, nmonth, nday, nhour*3600._wp+nminute*60._wp, fjulday ) 
94      IF( ABS(fjulday - REAL(NINT(fjulday),wp)) < 0.1 / rday )   fjulday = REAL(NINT(fjulday),wp)   ! avoid truncation error
95      IF( nn_time0*3600 - ndt05 .lt. 0 ) fjulday = fjulday + 1.                    ! move back to the day at nit000 (and not at nit000 - 1)
96
97      nsec1jan000 = 0
98      CALL day_mth
99
100      IF ( nday == 0 ) THEN     !   for ex if ndastp = ndate0 - 1
101         nmonth = nmonth - 1
102         nday = nmonth_len(nmonth)
103      ENDIF
104      IF ( nmonth == 0 ) THEN   ! go at the end of previous year
105         nmonth = 12
106         nyear = nyear - 1
107         nsec1jan000 = nsec1jan000 - nsecd * nyear_len(0)
108         IF( nleapy == 1 )   CALL day_mth
109      ENDIF
110
111      ! day since january 1st
112      nday_year = nday + SUM( nmonth_len(1:nmonth - 1) )
113
114      !compute number of days between last monday and today
115      CALL ymds2ju( 1900, 01, 01, 0.0, zjul )  ! compute julian day value of 01.01.1900 (our reference that was a Monday)
116      inbday = FLOOR(fjulday - zjul)            ! compute nb day between  01.01.1900 and start of current day
117      idweek = MOD(inbday, 7)                  ! compute nb day between last monday and current day
118      IF (idweek .lt. 0) idweek=idweek+7       ! Avoid negative values for dates before 01.01.1900
119
120      ! number of seconds since the beginning of current year/month/week/day at the middle of the time-step
121      IF (nhour*3600+nminute*60-ndt05 .gt. 0) THEN
122         ! 1 timestep before current middle of first time step is still the same day
123         nsec_year  = (nday_year-1) * nsecd + nhour*3600+nminute*60 - ndt05 
124         nsec_month = (nday-1)      * nsecd + nhour*3600+nminute*60 - ndt05   
125      ELSE
126         ! 1 time step before the middle of the first time step is the previous day
127         nsec_year  = nday_year * nsecd + nhour*3600+nminute*60 - ndt05 
128         nsec_month = nday      * nsecd + nhour*3600+nminute*60 - ndt05   
129      ENDIF
130      nsec_week  = idweek    * nsecd + nhour*3600+nminute*60 - ndt05
131      nsec_day   =             nhour*3600+nminute*60 - ndt05 
132      IF( nsec_day .lt. 0 ) nsec_day = nsec_day + nsecd
133      IF( nsec_week .lt. 0 ) nsec_week = nsec_week + nsecd*7
134
135      ! control print
136      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 = ',   &
137           &                   nyear, '/', nmonth, '/', nday, '  nsec_day:', nsec_day, '  nsec_week:', nsec_week, '  &
138           &                   nsec_month:', nsec_month , '  nsec_year:' , nsec_year
139
140      ! Up to now, calendar parameters are related to the end of previous run (nit000-1)
141      ! call day to set the calendar parameters at the begining of the current simulaton. needed by iom_init
142      CALL day( nit000 )
143      !
144   END SUBROUTINE day_init
145
146
147   SUBROUTINE day_mth
148      !!----------------------------------------------------------------------
149      !!                   ***  ROUTINE day_init  ***
150      !!
151      !! ** Purpose :   calendar values related to the months
152      !!
153      !! ** Action  : - nmonth_len    : length in days of the months of the current year
154      !!              - nyear_len     : length in days of the previous/current year
155      !!              - nmonth_half   : second since the beginning of the year and the halft of the months
156      !!              - nmonth_end    : second since the beginning of the year and the end of the months
157      !!----------------------------------------------------------------------
158      INTEGER  ::   jm               ! dummy loop indice
159      !!----------------------------------------------------------------------
160
161      ! length of the month of the current year (from nleapy, read in namelist)
162      IF ( nleapy < 2 ) THEN
163         nmonth_len(:) = (/ 31, 31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31, 31 /)
164         nyear_len(:) = 365
165         IF ( nleapy == 1 ) THEN   ! we are using calandar with leap years
166            IF ( MOD(nyear-1, 4) == 0 .AND. ( MOD(nyear-1, 400) == 0 .OR. MOD(nyear-1, 100) /= 0 ) ) THEN
167               nyear_len(0)  = 366
168            ENDIF
169            IF ( MOD(nyear  , 4) == 0 .AND. ( MOD(nyear  , 400) == 0 .OR. MOD(nyear  , 100) /= 0 ) ) THEN
170               nmonth_len(2) = 29
171               nyear_len(1)  = 366
172            ENDIF
173            IF ( MOD(nyear+1, 4) == 0 .AND. ( MOD(nyear+1, 400) == 0 .OR. MOD(nyear+1, 100) /= 0 ) ) THEN
174               nyear_len(2)  = 366
175            ENDIF
176         ENDIF
177      ELSE
178         nmonth_len(:) = nleapy   ! all months with nleapy days per year
179         nyear_len(:) = 12 * nleapy
180      ENDIF
181
182      ! half month in second since the begining of the year:
183      ! time since Jan 1st   0     1     2    ...    11    12    13
184      !          ---------*--|--*--|--*--| ... |--*--|--*--|--*--|--------------------------------------
185      !                 <---> <---> <--->  ...  <---> <---> <--->
186      ! month number      0     1     2    ...    11    12    13
187      !
188      ! nmonth_half(jm) = rday * REAL( 0.5 * nmonth_len(jm) + SUM(nmonth_len(1:jm-1)) )
189      nmonth_half(0) = - nsecd05 * nmonth_len(0)
190      DO jm = 1, 13
191         nmonth_half(jm) = nmonth_half(jm-1) + nsecd05 * ( nmonth_len(jm-1) + nmonth_len(jm) )
192      END DO
193
194      nmonth_end(0) = 0
195      DO jm = 1, 13
196         nmonth_end(jm) = nmonth_end(jm-1) + nsecd * nmonth_len(jm)
197      END DO
198      !
199   END SUBROUTINE
200
201
202   SUBROUTINE day( kt )
203      !!----------------------------------------------------------------------
204      !!                      ***  ROUTINE day  ***
205      !!
206      !! ** Purpose :   Compute the date with a day iteration IF necessary.
207      !!
208      !! ** Method  : - ???
209      !!
210      !! ** Action  : - nyear     : current year
211      !!              - nmonth    : current month of the year nyear
212      !!              - nday      : current day of the month nmonth
213      !!              - nday_year : current day of the year nyear
214      !!              - ndastp    : = nyear*10000 + nmonth*100 + nday
215      !!              - adatrj    : date in days since the beginning of the run
216      !!              - nsec_year : current time of the year (in second since 00h, jan 1st)
217      !!----------------------------------------------------------------------
218      INTEGER, INTENT(in) ::   kt        ! ocean time-step indices
219      !
220      CHARACTER (len=25) ::   charout
221      REAL(wp)           ::   zprec      ! fraction of day corresponding to 0.1 second
222      !!----------------------------------------------------------------------
223      !
224      IF( nn_timing == 1 )  CALL timing_start('day')
225      !
226      zprec = 0.1 / rday
227      !                                                 ! New time-step
228      nsec_year  = nsec_year  + ndt
229      nsec_month = nsec_month + ndt
230      nsec_week  = nsec_week  + ndt
231      nsec_day   = nsec_day   + ndt
232      adatrj  = adatrj  + rdt / rday
233      fjulday = fjulday + rdt / rday
234      IF( ABS(fjulday - REAL(NINT(fjulday),wp)) < zprec )   fjulday = REAL(NINT(fjulday),wp)   ! avoid truncation error
235      IF( ABS(adatrj  - REAL(NINT(adatrj ),wp)) < zprec )   adatrj  = REAL(NINT(adatrj ),wp)   ! avoid truncation error
236
237      IF( nsec_day > nsecd ) THEN                       ! New day
238         !
239         nday      = nday + 1
240         nday_year = nday_year + 1
241         nsec_day  = ndt05
242         !
243         IF( nday == nmonth_len(nmonth) + 1 ) THEN      ! New month
244            nday   = 1
245            nmonth = nmonth + 1
246            nsec_month = ndt05
247            IF( nmonth == 13 ) THEN                     ! New year
248               nyear     = nyear + 1
249               nmonth    = 1
250               nday_year = 1
251               nsec_year = ndt05
252               nsec1jan000 = nsec1jan000 + nsecd * nyear_len(1)
253               IF( nleapy == 1 )   CALL day_mth
254            ENDIF
255         ENDIF
256         !
257         ndastp = nyear * 10000 + nmonth * 100 + nday   ! New date
258         !
259         !compute first day of the year in julian days
260         CALL ymds2ju( nyear, 01, 01, 0.0, fjulstartyear )
261         !
262         IF(lwp) WRITE(numout,'(a,i8,a,i4.4,a,i2.2,a,i2.2,a,i3.3)') '======>> time-step =', kt,   &
263              &   '      New day, DATE Y/M/D = ', nyear, '/', nmonth, '/', nday, '      nday_year = ', nday_year
264         IF(lwp) WRITE(numout,'(a,i8,a,i7,a,i5)') '         nsec_year = ', nsec_year,   &
265              &   '   nsec_month = ', nsec_month, '   nsec_day = ', nsec_day, '   nsec_week = ', nsec_week
266      ENDIF
267
268      IF( nsec_week > 7*nsecd )   nsec_week = ndt05     ! New week
269
270      IF(ln_ctl) THEN
271         WRITE(charout,FMT="('kt =', I4,'  d/m/y =',I2,I2,I4)") kt, nday, nmonth, nyear
272         CALL prt_ctl_info(charout)
273      ENDIF
274
275      IF( .NOT. l_offline ) CALL rst_opn( kt )               ! Open the restart file if needed and control lrst_oce
276      IF( lrst_oce         ) CALL day_rst( kt, 'WRITE' )      ! write day restart information
277      !
278      IF( nn_timing == 1 )  CALL timing_stop('day')
279      !
280   END SUBROUTINE day
281
282
283   SUBROUTINE day_rst( kt, cdrw )
284      !!---------------------------------------------------------------------
285      !!                   ***  ROUTINE ts_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 )   ! 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 )
339               ndastp = NINT( zndastp )
340               CALL iom_get( numror, 'adatrj', adatrj  )
341          CALL iom_get( numror, 'ntime', ktime )
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         CALL iom_rstput( kt, nitrst, numrow, 'kt'     , REAL( kt    , wp) )   ! time-step
401         CALL iom_rstput( kt, nitrst, numrow, 'ndastp' , REAL( ndastp, wp) )   ! date
402         CALL iom_rstput( kt, nitrst, numrow, 'adatrj' , adatrj            )   ! number of elapsed days since
403         !                                                                     ! the begining of the run [s]
404    CALL iom_rstput( kt, nitrst, numrow, 'ntime'  , REAL( nn_time0, wp) ) ! time
405      ENDIF
406      !
407   END SUBROUTINE day_rst
408
409   !!======================================================================
410END MODULE daymod
Note: See TracBrowser for help on using the repository browser.