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 utils/tools_dev_r12970_AGRIF_CMEMS/DOMAINcfg/src – NEMO

source: utils/tools_dev_r12970_AGRIF_CMEMS/DOMAINcfg/src/daymod.f90 @ 13056

Last change on this file since 13056 was 13056, checked in by rblod, 4 years ago

ticket #2129 : cleaning domcfg
File size: 7.8 KB
Line 
1MODULE daymod
2   !!======================================================================
3   !!                       ***  MODULE  daymod  ***
4   !! Ocean :   management of the model 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   !!                    ----------- WARNING -----------
20   !!                    -------------------------------
21   !!   sbcmod assume that the time step is dividing the number of second of
22   !!   in a day, i.e. ===> MOD( rday, rdt ) == 0
23   !!   except when user defined forcing is used (see sbcmod.F90)
24   !!----------------------------------------------------------------------
25   USE dom_oce        ! ocean space and time domain
26   USE phycst         ! physical constants
27   USE ioipsl  , ONLY :   ymds2ju      ! for calendar
28   !
29   USE in_out_manager ! I/O manager
30   USE iom            !
31
32   IMPLICIT NONE
33   PRIVATE
34
35   PUBLIC   day        ! called by step.F90
36   PUBLIC   day_mth    ! Needed by TAM
37
38   INTEGER, PUBLIC ::   nsecd, nsecd05, ndt, ndt05   !: (PUBLIC for TAM)
39
40   !!----------------------------------------------------------------------
41   !! NEMO/OCE 4.0 , NEMO Consortium (2018)
42   !! $Id: daymod.F90 10068 2018-08-28 14:09:04Z nicolasmartin $
43   !! Software governed by the CeCILL license (see ./LICENSE)
44   !!----------------------------------------------------------------------
45CONTAINS
46
47   SUBROUTINE day_mth
48      !!----------------------------------------------------------------------
49      !!                   ***  ROUTINE day_init  ***
50      !!
51      !! ** Purpose :   calendar values related to the months
52      !!
53      !! ** Action  : - nmonth_len    : length in days of the months of the current year
54      !!              - nyear_len     : length in days of the previous/current year
55      !!              - nmonth_half   : second since the beginning of the year and the halft of the months
56      !!              - nmonth_end    : second since the beginning of the year and the end of the months
57      !!----------------------------------------------------------------------
58      INTEGER  ::   jm               ! dummy loop indice
59      !!----------------------------------------------------------------------
60
61      ! length of the month of the current year (from nleapy, read in namelist)
62      IF ( nleapy < 2 ) THEN
63         nmonth_len(:) = (/ 31, 31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31, 31 /)
64         nyear_len(:) = 365
65         IF ( nleapy == 1 ) THEN   ! we are using calandar with leap years
66            IF ( MOD(nyear-1, 4) == 0 .AND. ( MOD(nyear-1, 400) == 0 .OR. MOD(nyear-1, 100) /= 0 ) ) THEN
67               nyear_len(0)  = 366
68            ENDIF
69            IF ( MOD(nyear  , 4) == 0 .AND. ( MOD(nyear  , 400) == 0 .OR. MOD(nyear  , 100) /= 0 ) ) THEN
70               nmonth_len(2) = 29
71               nyear_len(1)  = 366
72            ENDIF
73            IF ( MOD(nyear+1, 4) == 0 .AND. ( MOD(nyear+1, 400) == 0 .OR. MOD(nyear+1, 100) /= 0 ) ) THEN
74               nyear_len(2)  = 366
75            ENDIF
76         ENDIF
77      ELSE
78         nmonth_len(:) = nleapy   ! all months with nleapy days per year
79         nyear_len(:) = 12 * nleapy
80      ENDIF
81
82      ! half month in second since the begining of the year:
83      ! time since Jan 1st   0     1     2    ...    11    12    13
84      !          ---------*--|--*--|--*--| ... |--*--|--*--|--*--|--------------------------------------
85      !                 <---> <---> <--->  ...  <---> <---> <--->
86      ! month number      0     1     2    ...    11    12    13
87      !
88      ! nmonth_half(jm) = rday * REAL( 0.5 * nmonth_len(jm) + SUM(nmonth_len(1:jm-1)) )
89      nmonth_half(0) = - nsecd05 * nmonth_len(0)
90      DO jm = 1, 13
91         nmonth_half(jm) = nmonth_half(jm-1) + nsecd05 * ( nmonth_len(jm-1) + nmonth_len(jm) )
92      END DO
93
94      nmonth_end(0) = 0
95      DO jm = 1, 13
96         nmonth_end(jm) = nmonth_end(jm-1) + nsecd * nmonth_len(jm)
97      END DO
98      !
99   END SUBROUTINE
100
101
102   SUBROUTINE day( kt )
103      !!----------------------------------------------------------------------
104      !!                      ***  ROUTINE day  ***
105      !!
106      !! ** Purpose :   Compute the date with a day iteration IF necessary.
107      !!
108      !! ** Method  : - ???
109      !!
110      !! ** Action  : - nyear     : current year
111      !!              - nmonth    : current month of the year nyear
112      !!              - nday      : current day of the month nmonth
113      !!              - nday_year : current day of the year nyear
114      !!              - ndastp    : = nyear*10000 + nmonth*100 + nday
115      !!              - adatrj    : date in days since the beginning of the run
116      !!              - nsec_year : current time of the year (in second since 00h, jan 1st)
117      !!----------------------------------------------------------------------
118      INTEGER, INTENT(in) ::   kt        ! ocean time-step indices
119      !
120      CHARACTER (len=25) ::   charout
121      REAL(wp)           ::   zprec      ! fraction of day corresponding to 0.1 second
122      !!----------------------------------------------------------------------
123      !
124      zprec = 0.1 / rday
125      !                                                 ! New time-step
126      nsec_year  = nsec_year  + ndt
127      nsec_month = nsec_month + ndt
128      nsec_week  = nsec_week  + ndt
129      nsec_day   = nsec_day   + ndt
130      adatrj  = adatrj  + rdt / rday
131      fjulday = fjulday + rdt / rday
132      IF( ABS(fjulday - REAL(NINT(fjulday),wp)) < zprec )   fjulday = REAL(NINT(fjulday),wp)   ! avoid truncation error
133      IF( ABS(adatrj  - REAL(NINT(adatrj ),wp)) < zprec )   adatrj  = REAL(NINT(adatrj ),wp)   ! avoid truncation error
134
135      IF( nsec_day > nsecd ) THEN                       ! New day
136         !
137         nday      = nday + 1
138         nday_year = nday_year + 1
139         nsec_day  = ndt05
140         !
141         IF( nday == nmonth_len(nmonth) + 1 ) THEN      ! New month
142            nday   = 1
143            nmonth = nmonth + 1
144            nsec_month = ndt05
145            IF( nmonth == 13 ) THEN                     ! New year
146               nyear     = nyear + 1
147               nmonth    = 1
148               nday_year = 1
149               nsec_year = ndt05
150               nsec1jan000 = nsec1jan000 + nsecd * nyear_len(1)
151               IF( nleapy == 1 )   CALL day_mth
152            ENDIF
153         ENDIF
154         !
155         ndastp = nyear * 10000 + nmonth * 100 + nday   ! New date
156         !
157         !compute first day of the year in julian days
158         CALL ymds2ju( nyear, 01, 01, 0.0, fjulstartyear )
159         !
160         IF(lwp) WRITE(numout,'(a,i8,a,i4.4,a,i2.2,a,i2.2,a,i3.3)') '======>> time-step =', kt,   &
161              &   '      New day, DATE Y/M/D = ', nyear, '/', nmonth, '/', nday, '      nday_year = ', nday_year
162         IF(lwp) WRITE(numout,'(a,i8,a,i7,a,i5)') '         nsec_year = ', nsec_year,   &
163              &   '   nsec_month = ', nsec_month, '   nsec_day = ', nsec_day, '   nsec_week = ', nsec_week
164      ENDIF
165
166      IF( nsec_week > 7*nsecd )   nsec_week = ndt05     ! New week
167      !
168   END SUBROUTINE day
169
170   !!======================================================================
171END MODULE daymod
Note: See TracBrowser for help on using the repository browser.