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_tam.F90 in branches/2012/dev_r3604_LEGI8_TAM/NEMOGCM/NEMO/OPATAM_SRC/DOM – NEMO

source: branches/2012/dev_r3604_LEGI8_TAM/NEMOGCM/NEMO/OPATAM_SRC/DOM/daymod_tam.F90 @ 3611

Last change on this file since 3611 was 3611, checked in by pabouttier, 11 years ago

Add TAM code and ORCA2_TAM configuration - see Ticket #1007
  • Property svn:executable set to *
File size: 9.3 KB
Line 
1MODULE daymod_tam
2#ifdef key_tam
3   !!======================================================================
4   !!                       ***  MODULE  daymod_tam  ***
5   !! Ocean        :  calendar, tangent and adjoint model version
6   !!=====================================================================
7   !! History :  OPA  ! 1994-09  (M. Pontaud M. Imbard)  Original code
8   !!                 ! 1997-03  (O. Marti)
9   !!                 ! 1997-05  (G. Madec)
10   !!                 ! 1997-08  (M. Imbard)
11   !!   NEMO     1.0  ! 2003-09  (G. Madec)  F90 + nyear, nmonth, nday
12   !!                 ! 2004-01  (A.M. Treguier) new calculation based on adatrj
13   !!                 ! 2006-08  (G. Madec)  surface module major update
14   !! History :
15   !!            OPA  ! 1998-2004 (A. Weaver, N. Daget) daytam
16   !!            NEMO ! 2005-08  (A. Vidard) skeleton
17   !!                 ! 2008-08  (A. Vidard) 04-01 version, based on daytam
18   !!                 ! 2009-02  (A. Vidard) 06-08 version
19   !!            3.2  ! 2010-03  (F. Vigilant)
20   !!            3.2  ! 2012-07  (P.-A. Bouttier) Phasing with 3.4
21   !!----------------------------------------------------------------------
22   !!----------------------------------------------------------------------
23   !!   day_tam        : calendar
24   !!
25   !!           -------------------------------
26   !!           ----------- WARNING -----------
27   !!
28   !!   we assume that the time step is a divisor of the number of second of in a day
29   !!             ---> MOD( rday, rdttra(1) ) == 0
30   !!
31   !!           ----------- WARNING -----------
32   !!           -------------------------------
33   !!
34   !!----------------------------------------------------------------------
35   !! * Modules used
36   USE par_kind
37   USE phycst
38   USE dom_oce
39   USE in_out_manager
40   USE daymod
41   USE prtctl
42   USE ioipsl, ONLY : ymds2ju
43
44   IMPLICIT NONE
45   PRIVATE
46
47   !! * Routine accessibility
48   PUBLIC day_tam        ! called by steptan.F90 and stepadj.F90
49
50CONTAINS
51
52
53   SUBROUTINE day_tam( kt, kindic )
54      !!----------------------------------------------------------------------
55      !!                      ***  ROUTINE day_tam  ***
56      !!
57      !! ** Purpose :   Compute the date with a day iteration IF necessary.
58      !!             forward for the tangent linear, backward for the adjoint
59      !!
60      !! * Arguments
61      INTEGER, INTENT( in ) ::   kt      ! ocean time-step indices
62      INTEGER, INTENT( in ) ::   kindic  ! forward (0) or backward (1)
63      !!----------------------------------------------------------------------
64
65
66
67
68      SELECT CASE ( kindic )
69      CASE ( 0 )
70         ! ----------------------------------------------
71         ! Forward running Calendar for the tangent model
72         ! ----------------------------------------------
73         CALL day_tan( kt )
74      CASE ( 1 )
75         ! ----------------------------------------------
76         ! Backward running Calendar for the adjoint model
77         ! ----------------------------------------------
78         CALL day_adj( kt )
79      CASE default
80         IF (lwp) WRITE(numout,*) 'day_tam called with a wrong kindic: ',kindic
81         CALL abort
82      END SELECT
83   END SUBROUTINE day_tam
84
85   SUBROUTINE day_tan ( kt )
86      !!----------------------------------------------------------------------
87      !!                      ***  ROUTINE day_tan  ***
88      !!
89      !! ** Purpose :   Compute the date with a day iteration IF necessary.
90      !!
91      !! ** Method  : - ???
92      !!
93      !! ** Action  : - nyear     : current year
94      !!              - nmonth    : current month of the year nyear
95      !!              - nday      : current day of the month nmonth
96      !!              - nday_year : current day of the year nyear
97      !!              - ndastp    : = nyear*10000 + nmonth*100 + nday
98      !!              - adatrj    : date in days since the beginning of the run
99      !!              - nsec_year : current time of the year (in second since 00h, jan 1st)
100      !!----------------------------------------------------------------------
101      INTEGER, INTENT(in) ::   kt        ! ocean time-step indices
102      !
103      CHARACTER (len=25) ::   charout
104      REAL(wp)           ::   zprec      ! fraction of day corresponding to 0.1 second
105      !!----------------------------------------------------------------------
106      !
107      zprec = 0.1 / rday
108      !                                                 ! New time-step
109      nsec_year  = nsec_year  + ndt
110      nsec_month = nsec_month + ndt
111      nsec_week  = nsec_week  + ndt
112      nsec_day   = nsec_day   + ndt
113      adatrj  = adatrj  + rdttra(1) / rday
114      fjulday = fjulday + rdttra(1) / rday
115      IF( ABS(fjulday - REAL(NINT(fjulday),wp)) < zprec )   fjulday = REAL(NINT(fjulday),wp)   ! avoid truncation error
116      IF( ABS(adatrj  - REAL(NINT(adatrj ),wp)) < zprec )   adatrj  = REAL(NINT(adatrj ),wp)   ! avoid truncation error
117
118      IF( nsec_day > nsecd ) THEN                       ! New day
119         !
120         nday      = nday + 1
121         nday_year = nday_year + 1
122         nsec_day  = ndt05
123         !
124         IF( nday == nmonth_len(nmonth) + 1 ) THEN      ! New month
125            nday   = 1
126            nmonth = nmonth + 1
127            nsec_month = ndt05
128            IF( nmonth == 13 ) THEN                     ! New year
129               nyear     = nyear + 1
130               nmonth    = 1
131               nday_year = 1
132               nsec_year = ndt05
133               nsec1jan000 = nsec1jan000 + nsecd * nyear_len(1)
134               IF( nleapy == 1 )   CALL day_mth
135            ENDIF
136         ENDIF
137         !
138         ndastp = nyear * 10000 + nmonth * 100 + nday   ! New date
139         !
140         !compute first day of the year in julian days
141         CALL ymds2ju( nyear, 01, 01, 0.0, fjulstartyear )
142         !
143         IF(lwp) WRITE(numout,'(a,i8,a,i4.4,a,i2.2,a,i2.2,a,i3.3)') '======>> time-step =', kt,   &
144              &   '      New day, DATE Y/M/D = ', nyear, '/', nmonth, '/', nday, '      nday_year = ', nday_year
145         IF(lwp) WRITE(numout,'(a,i8,a,i7,a,i5)') '         nsec_year = ', nsec_year,   &
146              &   '   nsec_month = ', nsec_month, '   nsec_day = ', nsec_day, '   nsec_week = ', nsec_week
147      ENDIF
148
149      IF( nsec_week > 7*nsecd )   nsec_week = ndt05     ! New week
150
151      IF(ln_ctl) THEN
152         WRITE(charout,FMT="('kt =', I4,'  d/m/y =',I2,I2,I4)") kt, nday, nmonth, nyear
153         CALL prt_ctl_info(charout)
154      ENDIF
155      !
156   END SUBROUTINE day_tan
157
158   SUBROUTINE day_adj( kt )
159      !!----------------------------------------------------------------------
160      !!                      ***  ROUTINE day_adj  ***
161      !!
162      !! ** Purpose :   Compute the date with a day iteration backward
163      !!                if necessary.
164      !!
165      !! ** Method  : - ???
166      !!
167      !! ** Action  : - nyear     : current year
168      !!              - nmonth    : current month of the year nyear
169      !!              - nday      : current day of the month nmonth
170      !!              - nday_year : current day of the year nyear
171      !!              - ndastp    : = nyear*10000 + nmonth*100 + nday
172      !!              - adatrj    : date in days since the beginning of the run
173      !!              - nsec_year : current time of the year (in second since 00h, jan 1st)
174      !!----------------------------------------------------------------------
175      INTEGER, INTENT(in) ::   kt        ! ocean time-step indices
176      !
177      CHARACTER (len=25) ::   charout
178      REAL(wp)           ::   zprec      ! fraction of day corresponding to 0.1 second
179      !!----------------------------------------------------------------------
180
181      !                                                 ! New time-step
182      nsec_year  = nsec_year  - ndt
183      nsec_month = nsec_month - ndt
184      nsec_day   = nsec_day   - ndt
185      adatrj = adatrj + rdttra(1) / rday
186      fjulday = fjulday + rdttra(1) / rday
187      IF( ABS(fjulday - REAL(NINT(fjulday),wp)) < zprec )   fjulday = REAL(NINT(fjulday),wp)   ! avoid truncation error
188      IF( ABS(adatrj  - REAL(NINT(adatrj ),wp)) < zprec )   adatrj  = REAL(NINT(adatrj ),wp)   ! avoid truncation error
189
190      IF( nsec_day < 0 ) THEN                        ! NEW day
191         !
192         nday      = nday - 1
193         nday_year = nday_year - 1
194         nsec_day  = rday - ndt05
195         !
196         IF( nday == 0 ) THEN      ! NEW month
197            nmonth = nmonth - 1
198            IF( nmonth == 0 ) THEN                     ! NEW year
199               nyear     = nyear - 1
200               nmonth    = 12
201               nday_year = nyear_len(0)
202               nsec_year = nday_year * rday - ndt05
203               IF( nleapy == 1 )   CALL day_mth
204            ENDIF
205            nday   = nmonth_len(nmonth)
206            nsec_month = nmonth_len(nmonth) * rday - ndt05
207         ENDIF
208         !
209         ndastp = nyear * 10000 + nmonth * 100 + nday   ! NEW date
210         !
211         IF(lwp) WRITE(numout,'(a,i8,a,i4.4,a,i2.2,a,i2.2,a,i3.3)') '======>> time-step =', kt,   &
212              &   '      New day, DATE Y/M/D = ', nyear, '/', nmonth, '/', nday, '      nday_year = ', nday_year
213         IF(lwp) WRITE(numout,'(a,i8,a,i7,a,i5)') '         nsec_year = ', nsec_year,   &
214              &   '   nsec_month = ', nsec_month, '   nsec_day = ', nsec_day
215      ENDIF
216
217      !
218   END SUBROUTINE day_adj
219
220   !!======================================================================
221#endif
222END MODULE daymod_tam
Note: See TracBrowser for help on using the repository browser.