source: branches/2015/dev_r5021_UKMO1_CICE_coupling/NEMOGCM/NEMO/SAS_SRC/daymod.F90 @ 5443

Last change on this file since 5443 was 5443, checked in by davestorkey, 5 years ago

Update 2015/dev_r5021_UKMO1_CICE_coupling branch to revision 5442 of the trunk.

  • Property svn:keywords set to Id
File size: 14.0 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 restart         !
35   USE timing          ! Timing
36
37   IMPLICIT NONE
38   PRIVATE
39
40   PUBLIC   day        ! called by step.F90
41   PUBLIC   day_init   ! called by istate.F90
42
43   INTEGER ::   nsecd, nsecd05, ndt, ndt05
44
45   !!----------------------------------------------------------------------
46   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
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
70      REAL(wp) ::   zjul
71      !!----------------------------------------------------------------------
72      !
73      ! all calendar staff is based on the fact that MOD( rday, rdttra(1) ) == 0
74      IF( MOD( rday     , rdttra(1) ) /= 0. )   CALL ctl_stop( 'the time step must devide the number of second of in a day' )
75      IF( MOD( rday     , 2.        ) /= 0. )   CALL ctl_stop( 'the number of second of in a day must be an even number'    )
76      IF( MOD( rdttra(1), 2.        ) /= 0. )   CALL ctl_stop( 'the time step (in second) must be an even number'           )
77      nsecd   = NINT(rday           )
78      nsecd05 = NINT(0.5 * rday     )
79      ndt     = NINT(      rdttra(1))
80      ndt05   = NINT(0.5 * rdttra(1))
81
82      ! parameters corresponding to nit000 - 1 (as we start the step loop with a call to day)
83      ndastp = ndate0 - 1        ! ndate0 read in the namelist in dom_nam, we assume that we start run at 00:00
84      adatrj = ( REAL( nit000-1, wp ) * rdttra(1) ) / rday
85      IF( ABS(adatrj  - REAL(NINT(adatrj),wp)) < 0.1 / rday )   adatrj = REAL(NINT(adatrj),wp)   ! avoid truncation error
86      !
87      IF(lwp) THEN
88         WRITE(numout,*) ' *** Info used values : '
89         WRITE(numout,*) '   date ndastp                                      : ', ndastp
90         WRITE(numout,*) '   number of elapsed days since the begining of run : ', adatrj
91         WRITE(numout,*)
92      ENDIF
93
94      ! set the calendar from ndastp (read in restart file and namelist)
95
96      nyear   =   ndastp / 10000
97      nmonth  = ( ndastp - (nyear * 10000) ) / 100
98      nday    =   ndastp - (nyear * 10000) - ( nmonth * 100 ) 
99
100      CALL ymds2ju( nyear, nmonth, nday, 0.0, fjulday )  ! we assume that we start run at 00:00
101      IF( ABS(fjulday - REAL(NINT(fjulday),wp)) < 0.1 / rday )   fjulday = REAL(NINT(fjulday),wp)   ! avoid truncation error
102      fjulday = fjulday + 1.                             ! move back to the day at nit000 (and not at nit000 - 1)
103
104      nsec1jan000 = 0
105      CALL day_mth
106     
107      IF ( nday == 0 ) THEN     !   for ex if ndastp = ndate0 - 1
108         nmonth = nmonth - 1 
109         nday = nmonth_len(nmonth)
110      ENDIF
111      IF ( nmonth == 0 ) THEN   ! go at the end of previous year
112         nmonth = 12
113         nyear = nyear - 1
114         nsec1jan000 = nsec1jan000 - nsecd * nyear_len(0)
115         IF( nleapy == 1 )   CALL day_mth
116      ENDIF
117     
118      ! day since january 1st
119      nday_year = nday + SUM( nmonth_len(1:nmonth - 1) )
120
121      !compute number of days between last monday and today     
122      CALL ymds2ju( 1900, 01, 01, 0.0, zjul )  ! compute julian day value of 01.01.1900 (our reference that was a Monday)
123      inbday = NINT(fjulday - zjul)            ! compute nb day between  01.01.1900 and current day 
124      idweek = MOD(inbday, 7)                  ! compute nb day between last monday and current day 
125
126      ! number of seconds since the beginning of current year/month/week/day at the middle of the time-step
127      nsec_year  = nday_year * nsecd - ndt05   ! 1 time step before the middle of the first time step
128      nsec_month = nday      * nsecd - ndt05   ! because day will be called at the beginning of step
129      nsec_week  = idweek    * nsecd - ndt05
130      nsec_day   =             nsecd - ndt05
131
132      ! control print
133      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 = ',   &
134           &                   nyear, '/', nmonth, '/', nday, '  nsec_day:', nsec_day, '  nsec_week:', nsec_week
135
136      ! Up to now, calendar parameters are related to the end of previous run (nit000-1)
137      ! call day to set the calendar parameters at the begining of the current simulaton. needed by iom_init
138      CALL day( nit000 )
139      !
140   END SUBROUTINE day_init
141
142
143   SUBROUTINE day_mth
144      !!----------------------------------------------------------------------
145      !!                   ***  ROUTINE day_init  ***
146      !!
147      !! ** Purpose :   calendar values related to the months
148      !!
149      !! ** Action  : - nmonth_len    : length in days of the months of the current year
150      !!              - nyear_len     : length in days of the previous/current year
151      !!              - nmonth_half   : second since the beginning of the year and the halft of the months
152      !!              - nmonth_end    : second since the beginning of the year and the end of the months
153      !!----------------------------------------------------------------------
154      INTEGER  ::   jm               ! dummy loop indice
155      !!----------------------------------------------------------------------
156
157      ! length of the month of the current year (from nleapy, read in namelist)
158      IF ( nleapy < 2 ) THEN
159         nmonth_len(:) = (/ 31, 31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31, 31 /)
160         nyear_len(:) = 365
161         IF ( nleapy == 1 ) THEN   ! we are using calandar with leap years
162            IF ( MOD(nyear-1, 4) == 0 .AND. ( MOD(nyear-1, 400) == 0 .OR. MOD(nyear-1, 100) /= 0 ) ) THEN
163               nyear_len(0)  = 366
164            ENDIF
165            IF ( MOD(nyear  , 4) == 0 .AND. ( MOD(nyear  , 400) == 0 .OR. MOD(nyear  , 100) /= 0 ) ) THEN
166               nmonth_len(2) = 29
167               nyear_len(1)  = 366
168            ENDIF
169            IF ( MOD(nyear+1, 4) == 0 .AND. ( MOD(nyear+1, 400) == 0 .OR. MOD(nyear+1, 100) /= 0 ) ) THEN
170               nyear_len(2)  = 366
171            ENDIF
172         ENDIF
173      ELSE
174         nmonth_len(:) = nleapy   ! all months with nleapy days per year
175         nyear_len(:) = 12 * nleapy
176      ENDIF
177
178      ! half month in second since the begining of the year:
179      ! time since Jan 1st   0     1     2    ...    11    12    13
180      !          ---------*--|--*--|--*--| ... |--*--|--*--|--*--|--------------------------------------
181      !                 <---> <---> <--->  ...  <---> <---> <--->       
182      ! month number      0     1     2    ...    11    12    13
183      !
184      ! nmonth_half(jm) = rday * REAL( 0.5 * nmonth_len(jm) + SUM(nmonth_len(1:jm-1)) )
185      nmonth_half(0) = - nsecd05 * nmonth_len(0)
186      DO jm = 1, 13
187         nmonth_half(jm) = nmonth_half(jm-1) + nsecd05 * ( nmonth_len(jm-1) + nmonth_len(jm) )
188      END DO
189
190      nmonth_end(0) = 0
191      DO jm = 1, 13
192         nmonth_end(jm) = nmonth_end(jm-1) + nsecd * nmonth_len(jm)
193      END DO
194      !           
195   END SUBROUTINE
196
197
198   SUBROUTINE day( kt )
199      !!----------------------------------------------------------------------
200      !!                      ***  ROUTINE day  ***
201      !!
202      !! ** Purpose :   Compute the date with a day iteration IF necessary.
203      !!
204      !! ** Method  : - ???
205      !!
206      !! ** Action  : - nyear     : current year
207      !!              - nmonth    : current month of the year nyear
208      !!              - nday      : current day of the month nmonth
209      !!              - nday_year : current day of the year nyear
210      !!              - ndastp    : = nyear*10000 + nmonth*100 + nday
211      !!              - adatrj    : date in days since the beginning of the run
212      !!              - nsec_year : current time of the year (in second since 00h, jan 1st)
213      !!----------------------------------------------------------------------     
214      INTEGER, INTENT(in) ::   kt        ! ocean time-step indices
215      !
216      CHARACTER (len=25) ::   charout
217      REAL(wp)           ::   zprec      ! fraction of day corresponding to 0.1 second
218      !!----------------------------------------------------------------------
219      !
220      IF( nn_timing == 1 )  CALL timing_start('day')
221      !
222      zprec = 0.1 / rday
223      !                                                 ! New time-step
224      nsec_year  = nsec_year  + ndt 
225      nsec_month = nsec_month + ndt                 
226      nsec_week  = nsec_week  + ndt
227      nsec_day   = nsec_day   + ndt               
228      adatrj  = adatrj  + rdttra(1) / rday
229      fjulday = fjulday + rdttra(1) / rday
230      IF( ABS(fjulday - REAL(NINT(fjulday),wp)) < zprec )   fjulday = REAL(NINT(fjulday),wp)   ! avoid truncation error
231      IF( ABS(adatrj  - REAL(NINT(adatrj ),wp)) < zprec )   adatrj  = REAL(NINT(adatrj ),wp)   ! avoid truncation error
232     
233      IF( nsec_day > nsecd ) THEN                       ! New day
234         !
235         nday      = nday + 1
236         nday_year = nday_year + 1
237         nsec_day  = ndt05
238         !
239         IF( nday == nmonth_len(nmonth) + 1 ) THEN      ! New month
240            nday   = 1
241            nmonth = nmonth + 1
242            nsec_month = ndt05
243            IF( nmonth == 13 ) THEN                     ! New year
244               nyear     = nyear + 1
245               nmonth    = 1
246               nday_year = 1
247               nsec_year = ndt05
248               IF( nsec1jan000 >= 2 * (2**30 - nsecd * nyear_len(1) / 2 ) ) THEN   ! test integer 4 max value
249                  CALL ctl_stop( 'The number of seconds between Jan. 1st 00h of nit000 year and Jan. 1st 00h ',   &
250                     &           'of the current year is exceeding the INTEGER 4 max VALUE: 2^31-1 -> 68.09 years in seconds', &
251                     & 'You must do a restart at higher frequency (or remove this STOP and recompile everything in I8)' )
252               ENDIF
253               nsec1jan000 = nsec1jan000 + nsecd * nyear_len(1)
254               IF( nleapy == 1 )   CALL day_mth
255            ENDIF
256         ENDIF
257         !
258         ndastp = nyear * 10000 + nmonth * 100 + nday   ! New date
259         !
260         !compute first day of the year in julian days
261         CALL ymds2ju( nyear, 01, 01, 0.0, fjulstartyear )
262         !
263         IF(lwp) WRITE(numout,'(a,i8,a,i4.4,a,i2.2,a,i2.2,a,i3.3)') '======>> time-step =', kt,   &
264              &   '      New day, DATE Y/M/D = ', nyear, '/', nmonth, '/', nday, '      nday_year = ', nday_year
265         IF(lwp) WRITE(numout,'(a,i8,a,i7,a,i5)') '         nsec_year = ', nsec_year,   &
266              &   '   nsec_month = ', nsec_month, '   nsec_day = ', nsec_day, '   nsec_week = ', nsec_week
267      ENDIF
268
269      IF( nsec_week > 7*nsecd )   nsec_week = ndt05     ! New week
270     
271      IF(ln_ctl) THEN
272         WRITE(charout,FMT="('kt =', I4,'  d/m/y =',I2,I2,I4)") kt, nday, nmonth, nyear
273         CALL prt_ctl_info(charout)
274      ENDIF
275
276      ! since we no longer call rst_opn, need to define nitrst here, used by ice restart routine
277      IF( kt == nit000 ) nitrst = nitend
278      IF( MOD( kt - 1, nstock ) == 0 ) THEN
279         ! we use kt - 1 and not kt - nit000 to keep the same periodicity from the beginning of the experiment
280         nitrst = kt + nstock - 1                  ! define the next value of nitrst for restart writing
281         IF( nitrst > nitend )   nitrst = nitend   ! make sure we write a restart at the end of the run
282      ENDIF
283
284      IF( nn_timing == 1 )  CALL timing_stop('day')
285      !
286   END SUBROUTINE day
287   !!======================================================================
288END MODULE daymod
Note: See TracBrowser for help on using the repository browser.