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

source: branches/UKMO/dev_r5518_GO6_under_ice_relax_dr_hook/NEMOGCM/NEMO/OPA_SRC/DOM/daymod.F90 @ 11738

Last change on this file since 11738 was 11738, checked in by marc, 4 years ago

The Dr Hook changes from my perl code.

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