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/r8395_India_uncoupled/NEMOGCM/TOOLS/DOMAINcfg/src – NEMO

source: branches/UKMO/r8395_India_uncoupled/NEMOGCM/TOOLS/DOMAINcfg/src/daymod.f90 @ 10684

Last change on this file since 10684 was 10684, checked in by jcastill, 5 years ago

Remove svn keywords

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