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

source: branches/UKMO/test_moci_test_suite/NEMOGCM/NEMO/OPA_SRC/DOM/daymod.F90 @ 8243

Last change on this file since 8243 was 8243, checked in by andmirek, 7 years ago

#1914 working XIOS read, XIOS write and single processor read

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