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

source: trunk/NEMO/OPA_SRC/daymod.F90 @ 1409

Last change on this file since 1409 was 1359, checked in by smasson, 15 years ago

first implementation of iom_put, see ticket:387
  • Property svn:eol-style set to native
  • Property svn:keywords set to Id
File size: 17.3 KB
Line 
1MODULE daymod
2   !!======================================================================
3   !!                       ***  MODULE  daymod  ***
4   !! Ocean        :  calendar
5   !!=====================================================================
6   !! History :        !  94-09  (M. Pontaud M. Imbard)  Original code
7   !!                  !  97-03  (O. Marti)
8   !!                  !  97-05  (G. Madec)
9   !!                  !  97-08  (M. Imbard)
10   !!             9.0  !  03-09  (G. Madec)  F90 + nyear, nmonth, nday
11   !!                  !  04-01  (A.M. Treguier) new calculation based on adatrj
12   !!                  !  06-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 restart         !
35
36   IMPLICIT NONE
37   PRIVATE
38
39   PUBLIC day        ! called by step.F90
40   PUBLIC day_init   ! called by istate.F90
41
42   INTEGER , PUBLIC ::   nyear       !: current year
43   INTEGER , PUBLIC ::   nmonth      !: current month
44   INTEGER , PUBLIC ::   nday        !: current day of the month
45   INTEGER , PUBLIC ::   ndastp      !: time step date in yyyymmdd format
46   INTEGER , PUBLIC ::   nday_year   !: current day counted from jan 1st of the current year
47   REAL(wp), PUBLIC ::   rsec_year   !: current time step counted in second since 00h jan 1st of the current year
48   REAL(wp), PUBLIC ::   rsec_month  !: current time step counted in second since 00h 1st day of the current month
49   REAL(wp), PUBLIC ::   rsec_day    !: current time step counted in second since 00h of the current day
50
51   REAL(wp), PUBLIC ::   fjulday     !: julian day
52   REAL(wp), PUBLIC ::   adatrj      !: number of elapsed days since the begining of the run
53   !                                 !: it is the accumulated duration of previous runs
54   !                                 !: that may have been run with different time steps.
55   INTEGER , PUBLIC, DIMENSION(0:1)  ::   nyear_len    !: length in days of the previous/current year
56   INTEGER , PUBLIC, DIMENSION(0:13) ::   nmonth_len   !: length in days of the months of the current year
57   REAL(wp), PUBLIC, DIMENSION(0:13) ::   rmonth_half  !: second since the beginning of the year and the halft of the months
58   REAL(wp), PUBLIC, DIMENSION(0:13) ::   rmonth_end   !: second since the beginning of the year and the end of the months
59   REAL(wp), PUBLIC                  ::   sec1jan000   !: second since Jan. 1st 00h of nit000 year and Jan. 1st 00h of the current year
60
61   ! this two variables are wrong DO NOT USE THEM !!!
62   INTEGER, PUBLIC, DIMENSION(12) ::   nbiss = (/ 31, 29, 31, 30, 31, 30,    &  !: number of days per month
63      &                                           31, 31, 30, 31, 30, 31 /)     !: (leap-year)
64   INTEGER, PUBLIC, DIMENSION(12) ::   nobis = (/ 31, 28, 31, 30, 31, 30,    &  !: number of days per month
65      &                                           31, 31, 30, 31, 30, 31 /)     !: (365 days a year)
66
67
68   !!----------------------------------------------------------------------
69   !!  OPA 9.0 , LOCEAN-IPSL (2006)
70   !! $Id$
71   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
72   !!----------------------------------------------------------------------
73
74CONTAINS
75
76   SUBROUTINE day_init
77      !!----------------------------------------------------------------------
78      !!                   ***  ROUTINE day_init  ***
79      !!
80      !! ** Purpose :   Initialization of the calendar values to their values 1 time step before nit000
81      !!                because day will be called at the beginning of step
82      !!
83      !! ** Action  : - nyear        : current year
84      !!              - nmonth       : current month of the year nyear
85      !!              - nday         : current day of the month nmonth
86      !!              - nday_year    : current day of the year nyear
87      !!              - rsec_year    : current time step counted in second since 00h jan 1st of the current year
88      !!              - rsec_month   : current time step counted in second since 00h 1st day of the current month
89      !!              - rsec_day     : current time step counted in second since 00h of the current day
90      !!              - sec1jan000   : second since Jan. 1st 00h of nit000 year and Jan. 1st 00h of the current year
91      !!              - nmonth_len, nyear_len, rmonth_half, rmonth_end through day_mth
92      !!----------------------------------------------------------------------
93
94      ! all calendar staff is based on the fact that MOD( rday, rdttra(1) ) == 0
95      IF( MOD( rday, rdttra(1) ) /= 0 )   CALL ctl_stop( 'the time step must devide the number of second of in a day' )
96
97      CALL day_rst( nit000, 'READ' ) 
98
99      ! set the calandar from ndastp (read in restart file and namelist)
100
101      nyear   =   ndastp / 10000
102      nmonth  = ( ndastp - (nyear * 10000) ) / 100
103      nday    =   ndastp - (nyear * 10000) - ( nmonth * 100 ) 
104
105      CALL ymds2ju( nyear, nmonth, nday, 0.0, fjulday )  ! we assume that we start run at 00:00
106      fjulday = fjulday + 1.                             ! move back to the day at nit000 (and not at nit000 - 1)
107
108      sec1jan000 = 0.e0
109      CALL day_mth
110     
111      IF ( nday == 0 ) THEN     !   for ex if ndastp = ndate0 - 1
112         nmonth = nmonth - 1 
113         nday = nmonth_len(nmonth)
114      ENDIF
115      IF ( nmonth == 0 ) THEN   ! go at the end of previous year
116         nmonth = 12
117         nyear = nyear - 1
118         sec1jan000 = sec1jan000 - rday * REAL( nyear_len(0), wp )
119         IF( nleapy == 1 )   CALL day_mth
120      ENDIF
121     
122      ! day since january 1st
123      nday_year = nday + SUM( nmonth_len(1:nmonth - 1) )
124     
125      ! number of seconds since the beginning of current year/month at the middle of the time-step
126      rsec_year  = REAL( nday_year, wp ) * rday - 0.5 * rdttra(1)   ! 1 time step before the middle of the first time step
127      rsec_month = REAL( nday     , wp ) * rday - 0.5 * rdttra(1)   ! because day will be called at the beginning of step
128      rsec_day   =                         rday - 0.5 * rdttra(1)
129
130      ! control print
131      IF(lwp) WRITE(numout,*)' ==============>> 1/2 time step before the start of the run DATE Y/M/D = ',   &
132           &                   nyear, '/', nmonth, '/', nday, '  rsec_day:', rsec_day
133     
134   END SUBROUTINE day_init
135
136
137   SUBROUTINE day_mth
138      !!----------------------------------------------------------------------
139      !!                   ***  ROUTINE day_init  ***
140      !!
141      !! ** Purpose :   calendar values related to the months
142      !!
143      !! ** Action  : - nmonth_len    : length in days of the months of the current year
144      !!              - nyear_len     : length in days of the previous/current year
145      !!              - rmonth_half   : second since the beginning of the year and the halft of the months
146      !!              - rmonth_end    : second since the beginning of the year and the end of the months
147      !!----------------------------------------------------------------------
148      INTEGER  ::   jm               ! dummy loop indice
149      !!----------------------------------------------------------------------
150
151      ! length of the month of the current year (from nleapy, read in namelist)
152      IF ( nleapy < 2 ) THEN
153         nmonth_len(:) = (/ 31, 31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31, 31 /)
154         nyear_len(:) = 365
155         IF ( nleapy == 1 ) THEN   ! we are using calandar with leap years
156            IF ( MOD(nyear-1, 4) == 0 .AND. ( MOD(nyear-1, 400) == 0 .OR. MOD(nyear-1, 100) /= 0 ) ) THEN
157               nyear_len(0) = 366
158            ENDIF
159            IF ( MOD(nyear, 4) == 0 .AND. ( MOD(nyear, 400) == 0 .OR. MOD(nyear, 100) /= 0 ) ) THEN
160               nmonth_len(2) = 29
161               nyear_len(1) = 366
162            ENDIF
163         ENDIF
164      ELSE
165         nmonth_len(:) = nleapy   ! all months with nleapy days per year
166         nyear_len(:) = 12 * nleapy
167      ENDIF
168
169      ! half month in second since the begining of the year:
170      ! time since Jan 1st   0     1     2    ...    11    12    13
171      !          ---------*--|--*--|--*--| ... |--*--|--*--|--*--|--------------------------------------
172      !                 <---> <---> <--->  ...  <---> <---> <--->       
173      ! month number      0     1     2    ...    11    12    13
174      !
175      ! rmonth_half(jm) = rday * REAL( 0.5 * nmonth_len(jm) + SUM(nmonth_len(1:jm-1)) )
176      rmonth_half(0) = - 0.5 * rday * REAL( nmonth_len(0), wp )
177      DO jm = 1, 13
178         rmonth_half(jm) = rmonth_half(jm-1) + 0.5 * rday * REAL( nmonth_len(jm-1) + nmonth_len(jm), wp )
179      END DO
180
181      rmonth_end(0) = 0.
182      DO jm = 1, 13
183         rmonth_end(jm) = rmonth_end(jm-1) + rday * REAL( nmonth_len(jm), wp )
184      END DO
185                 
186   END SUBROUTINE
187
188
189   SUBROUTINE day( kt )
190      !!----------------------------------------------------------------------
191      !!                      ***  ROUTINE day  ***
192      !!
193      !! ** Purpose :   Compute the date with a day iteration IF necessary.
194      !!
195      !! ** Method  : - ???
196      !!
197      !! ** Action  : - nyear     : current year
198      !!              - nmonth    : current month of the year nyear
199      !!              - nday      : current day of the month nmonth
200      !!              - nday_year : current day of the year nyear
201      !!              - ndastp    : = nyear*10000 + nmonth*100 + nday
202      !!              - adatrj    : date in days since the beginning of the run
203      !!              - rsec_year : current time of the year (in second since 00h, jan 1st)
204      !!----------------------------------------------------------------------     
205      INTEGER, INTENT(in) ::   kt        ! ocean time-step indices
206      !
207      CHARACTER (len=25) ::   charout
208      !!----------------------------------------------------------------------
209
210      !                                                 ! New time-step
211      rsec_year  = rsec_year  + rdttra(1) 
212      rsec_month = rsec_month + rdttra(1)                 
213      rsec_day   = rsec_day   + rdttra(1)                 
214      adatrj  = adatrj  + rdttra(1) / rday
215      fjulday = fjulday + rdttra(1) / rday
216     
217      IF( rsec_day > rday ) THEN                        ! NEW day
218         !
219         nday      = nday + 1
220         nday_year = nday_year + 1
221         rsec_day  = 0.5 * rdttra(1)                 
222         !
223         IF( nday == nmonth_len(nmonth) + 1 ) THEN      ! NEW month
224            nday   = 1
225            nmonth = nmonth + 1
226            rsec_month = 0.5 * rdttra(1)
227            IF( nmonth == 13 ) THEN                     ! NEW year
228               nyear     = nyear + 1
229               nmonth    = 1
230               nday_year = 1
231               rsec_year = 0.5 * rdttra(1)
232               sec1jan000 = sec1jan000 + rday * REAL( nyear_len(1), wp )
233               IF( nleapy == 1 )   CALL day_mth
234            ENDIF
235         ENDIF
236         !
237         ndastp = nyear * 10000 + nmonth * 100 + nday   ! NEW date
238         !
239         IF(lwp) WRITE(numout,'(a,i8,a,i4.4,a,i2.2,a,i2.2,a,i3.3)') '======>> time-step =', kt,   &
240              &   '      New day, DATE Y/M/D = ', nyear, '/', nmonth, '/', nday, '      nday_year = ', nday_year
241         IF(lwp) WRITE(numout,'(a,F9.0,a,F9.0,a,F9.0)') '         rsec_year = ', rsec_year,   &
242              &   '   rsec_month = ', rsec_month, '   rsec_day = ', rsec_day
243      ENDIF
244     
245      IF(ln_ctl) THEN
246         WRITE(charout,FMT="('kt =', I4,'  d/m/y =',I2,I2,I4)") kt, nday, nmonth, nyear
247         CALL prt_ctl_info(charout)
248      ENDIF
249
250      IF( lrst_oce )   CALL day_rst( kt, 'WRITE' )
251      !
252   END SUBROUTINE day
253
254
255   SUBROUTINE day_rst( kt, cdrw )
256      !!---------------------------------------------------------------------
257      !!                   ***  ROUTINE ts_rst  ***
258      !!
259      !!  ** Purpose : Read or write calendar in restart file:
260      !!
261      !!  WRITE(READ) mode:
262      !!       kt        : number of time step since the begining of the experiment at the
263      !!                   end of the current(previous) run
264      !!       adatrj(0) : number of elapsed days since the begining of the experiment at the
265      !!                   end of the current(previous) run (REAL -> keep fractions of day)
266      !!       ndastp    : date at the end of the current(previous) run (coded as yyyymmdd integer)
267      !!
268      !!   According to namelist parameter nrstdt,
269      !!       nrstdt = 0  no control on the date (nit000 is  arbitrary).
270      !!       nrstdt = 1  we verify that nit000 is equal to the last
271      !!                   time step of previous run + 1.
272      !!       In both those options, the  exact duration of the experiment
273      !!       since the beginning (cumulated duration of all previous restart runs)
274      !!       is not stored in the restart and is assumed to be (nit000-1)*rdt.
275      !!       This is valid is the time step has remained constant.
276      !!
277      !!       nrstdt = 2  the duration of the experiment in days (adatrj)
278      !!                    has been stored in the restart file.
279      !!----------------------------------------------------------------------
280      INTEGER         , INTENT(in) ::   kt         ! ocean time-step
281      CHARACTER(len=*), INTENT(in) ::   cdrw       ! "READ"/"WRITE" flag
282      !
283      REAL(wp) ::   zkt, zndastp
284      !!----------------------------------------------------------------------
285     
286      IF( TRIM(cdrw) == 'READ' ) THEN
287
288         IF( iom_varid( numror, 'kt', ldstop = .FALSE. ) > 0 ) THEN
289            ! Get Calendar informations
290            CALL iom_get( numror, 'kt', zkt )   ! last time-step of previous run
291            IF(lwp) THEN
292               WRITE(numout,*) ' *** Info read in restart : '
293               WRITE(numout,*) '   previous time-step                               : ', NINT( zkt )
294               WRITE(numout,*) ' *** restart option'
295               SELECT CASE ( nrstdt )
296               CASE ( 0 )   ;   WRITE(numout,*) ' nrstdt = 0 : no control of nit000'
297               CASE ( 1 )   ;   WRITE(numout,*) ' nrstdt = 1 : no control the date at nit000 (use ndate0 read in the namelist)'
298               CASE ( 2 )   ;   WRITE(numout,*) ' nrstdt = 2 : calendar parameters read in restart'
299               END SELECT
300               WRITE(numout,*)
301            ENDIF
302            ! Control of date
303            IF( nit000 - NINT( zkt ) /= 1 .AND. nrstdt /= 0 )                                         & 
304                 &   CALL ctl_stop( ' ===>>>> : problem with nit000 for the restart',                 & 
305                 &                  ' verify the restart file or rerun with nrstdt = 0 (namelist)' )
306            ! define ndastp and adatrj
307            IF ( nrstdt == 2 ) THEN 
308               ! read the parameters correspondting to nit000 - 1 (last time step of previous run)
309               CALL iom_get( numror, 'ndastp', zndastp )
310               ndastp = NINT( zndastp )
311               CALL iom_get( numror, 'adatrj', adatrj  )
312            ELSE 
313               ! parameters correspondting to nit000 - 1 (as we start the step loop with a call to day)
314               ndastp = ndate0 - 1     ! ndate0 read in the namelist in dom_nam, we assume that we start run at 00:00
315               adatrj = ( REAL( nit000-1, wp ) * rdttra(1) ) / rday 
316               ! note this is wrong if time step has changed during run
317            ENDIF
318         ELSE
319            ! parameters correspondting to nit000 - 1 (as we start the step loop with a call to day)
320            ndastp = ndate0 - 1        ! ndate0 read in the namelist in dom_nam, we assume that we start run at 00:00
321            adatrj = ( REAL( nit000-1, wp ) * rdttra(1) ) / rday 
322         ENDIF
323         !
324         IF(lwp) THEN
325            WRITE(numout,*) ' *** Info used values : '
326            WRITE(numout,*) '   date ndastp                                      : ', ndastp
327            WRITE(numout,*) '   number of elapsed days since the begining of run : ', adatrj
328            WRITE(numout,*)
329         ENDIF
330         !
331      ELSEIF( TRIM(cdrw) == 'WRITE' ) THEN
332         !
333         IF( kt == nitrst ) THEN
334            IF(lwp) WRITE(numout,*)
335            IF(lwp) WRITE(numout,*) 'rst_write : write oce restart file  kt =', kt
336            IF(lwp) WRITE(numout,*) '~~~~~~~'         
337         ENDIF
338         ! calendar control
339         CALL iom_rstput( kt, nitrst, numrow, 'kt'     , REAL( kt    , wp) )   ! time-step
340         CALL iom_rstput( kt, nitrst, numrow, 'ndastp' , REAL( ndastp, wp) )   ! date
341         CALL iom_rstput( kt, nitrst, numrow, 'adatrj' , adatrj            )   ! number of elapsed days since
342         !                                                                     ! the begining of the run [s]
343      ENDIF
344      !
345   END SUBROUTINE day_rst
346
347   !!======================================================================
348END MODULE daymod
Note: See TracBrowser for help on using the repository browser.