source: CONFIG/UNIFORM/v7/IPSLCM7/SOURCES/NEMO/trcstp.F90 @ 6883

Last change on this file since 6883 was 6883, checked in by cetlod, 12 days ago

CM7_work : Bugfix to ensure NEMO-PISCES restartability
File size: 13.3 KB
Line 
1MODULE trcstp
2   !!======================================================================
3   !!                       ***  MODULE trcstp  ***
4   !! Time-stepping    : time loop of opa for passive tracer
5   !!======================================================================
6   !! History :  1.0  !  2004-03  (C. Ethe)  Original
7   !!            4.1  !  2019-08  (A. Coward, D. Storkey) rewrite in preparation for new timestepping scheme
8   !!----------------------------------------------------------------------
9#if defined key_top
10   !!----------------------------------------------------------------------
11   !!   trc_stp       : passive tracer system time-stepping
12   !!----------------------------------------------------------------------
13   USE par_trc        ! need jptra, number of passive tracers
14   USE oce_trc        ! ocean dynamics and active tracers variables
15   USE sbc_oce
16   USE trc
17   USE trcbc           ! Tracers boundary condtions          ( trc_bc routine)
18   USE trcais          ! Antarctic Ice Sheet tracers         (trc_ais routine)
19   USE trctrp         ! passive tracers transport
20   USE trcsms         ! passive tracers sources and sinks
21   USE trcwri
22   USE trcrst
23   USE trdtrc_oce
24   USE trdmxl_trc
25   USE sms_pisces,  ONLY : ln_check_mass
26   !
27   USE prtctl         ! Print control for debbuging
28   USE iom            !
29   USE in_out_manager !
30
31   IMPLICIT NONE
32   PRIVATE
33
34   PUBLIC   trc_stp    ! called by step
35
36   LOGICAL  ::   llnew                   ! ???
37   REAL(wp) ::   rdt_sampl               ! ???
38   INTEGER  ::   nb_rec_per_day, ktdcy   ! ???
39   REAL(wp) ::   rsecfst, rseclast       ! ???
40   REAL(wp), DIMENSION(:,:,:), SAVE, ALLOCATABLE ::   qsr_arr   ! save qsr during TOP time-step
41
42#  include "domzgr_substitute.h90"
43   !!----------------------------------------------------------------------
44   !! NEMO/TOP 4.0 , NEMO Consortium (2018)
45   !! $Id: trcstp.F90 15446 2021-10-26 14:34:38Z cetlod $
46   !! Software governed by the CeCILL license (see ./LICENSE)
47   !!----------------------------------------------------------------------
48CONTAINS
49
50   SUBROUTINE trc_stp( kt, Kbb, Kmm, Krhs, Kaa )
51      !!-------------------------------------------------------------------
52      !!                     ***  ROUTINE trc_stp  ***
53      !!                     
54      !! ** Purpose :   Time loop of opa for passive tracer
55      !!
56      !! ** Method  :   Compute the passive tracers trends
57      !!                Update the passive tracers
58      !!-------------------------------------------------------------------
59      INTEGER, INTENT( in ) :: kt                  ! ocean time-step index
60      INTEGER, INTENT( in ) :: Kbb, Kmm, Krhs, Kaa ! time level indices
61      !
62      INTEGER ::   jk, jn   ! dummy loop indices
63      INTEGER ::   ibb      ! local time-level index
64      REAL(wp)::   ztrai    ! local scalar
65      LOGICAL ::   ll_trcstat, ll_trcpis ! local logical
66      CHARACTER (len=25) ::   charout   !
67      !!-------------------------------------------------------------------
68      !
69      IF( ln_timing )   CALL timing_start('trc_stp')
70      !
71      ibb = Kbb                     ! default "before" time-level index
72      IF( l_1st_euler .OR. ln_top_euler ) THEN     ! at nittrc000
73         rDt_trc =  rn_Dt           ! = rn_Dt (use or restarting with Euler time stepping)
74         ibb = Kmm                  ! time-level index used to substitute the "before" with the "now" time level
75      ELSEIF( kt <= nittrc000 + 1 ) THEN                                     ! at nittrc000 or nittrc000+1
76         rDt_trc = 2. * rn_Dt       ! = 2 rn_Dt (leapfrog)
77      ENDIF
78      !
79      ll_trcstat  = ( sn_cfctl%l_trcstat ) .AND. &
80     &              ( ( MOD( kt, sn_cfctl%ptimincr ) == 0 ) .OR. ( kt == nitend ) )
81
82      IF( kt == nittrc000 )                      CALL trc_stp_ctl   ! control
83      IF( kt == nittrc000 .AND. lk_trdmxl_trc )  CALL trd_mxl_trc_init    ! trends: Mixed-layer
84      !
85      IF( .NOT.ln_linssh ) THEN                                           ! update ocean volume due to ssh temporal evolution
86         DO jk = 1, jpk
87            cvol(:,:,jk) = e1e2t(:,:) * e3t(:,:,jk,Kmm) * tmask(:,:,jk)
88         END DO
89         IF( ln_pisces )  THEN
90            IF ( iom_use( "pno3tot" ) .OR. iom_use( "ppo4tot" ) .OR. iom_use( "psiltot" ) &
91               &  .OR. iom_use( "palktot" ) .OR. iom_use( "pfertot" ) ) &
92               & ll_trcpis = .TRUE.
93         ELSE
94            ll_trcpis = .FALSE.
95         ENDIF
96         IF ( ll_trcstat .OR. kt == nitrst .OR. ( ln_check_mass .AND. kt == nitend ) .OR. ll_trcpis ) &
97            &     areatot = glob_sum( 'trcstp', cvol(:,:,:) )
98      ENDIF
99      !
100      IF( l_trcdm2dc )   CALL trc_mean_qsr( kt )
101      !   
102      !
103      IF(sn_cfctl%l_prttrc) THEN
104         WRITE(charout,FMT="('kt =', I4,'  d/m/y =',I2,I2,I4)") kt, nday, nmonth, nyear
105         CALL prt_ctl_info( charout, cdcomp = 'top' )
106      ENDIF
107      !
108      tr(:,:,:,:,Krhs) = 0._wp
109      !
110      CALL trc_rst_opn  ( kt )                            ! Open tracer restart file
111      IF( lrst_trc )  CALL trc_rst_cal  ( kt, 'WRITE' )   ! calendar
112      CALL trc_wri      ( kt,      Kmm            )       ! output of passive tracers with iom I/O manager
113      IF( ln_trcbc .AND. lltrcbc )  CALL trc_bc ( kt, Kmm, tr, Krhs )      ! tracers: surface and lateral Boundary Conditions
114      IF( ln_trcais )               CALL trc_ais( kt, Kmm, tr, Krhs )      ! tracers from Antarctic Ice Sheet (icb, isf)
115      CALL trc_sms      ( kt, ibb, Kmm, Krhs      )       ! tracers: sinks and sources
116#if ! defined key_sed_off
117      CALL trc_trp      ( kt, ibb, Kmm, Krhs, Kaa )       ! transport of passive tracers
118#endif
119           !
120           ! Note passive tracers have been time-filtered in trc_trp but the time level
121           ! indices will not be swapped until after tra_atf/dyn_atf/ssh_atf in stp. Subsequent calls here
122           ! anticipate this update which will be: Nrhs= Nbb ; Nbb = Nnn ; Nnn = Naa ; Naa = Nrhs
123           ! and use the filtered levels explicitly.
124           !
125      IF( kt == nittrc000 ) THEN
126         CALL iom_close( numrtr )                         ! close input tracer restart file
127         IF(lrxios) CALL iom_context_finalize(      cr_toprst_cxt          )
128         IF(lwm) CALL FLUSH( numont )                     ! flush namelist output
129      ENDIF
130      IF( lk_trdmxl_trc  )      CALL trd_mxl_trc  ( kt,      Kaa       )       ! trends: Mixed-layer
131      !
132      IF( ln_top_euler ) THEN 
133         ! For Euler timestepping for TOP we need to copy the "after" to the "now" fields
134         ! here then after the (leapfrog) swapping of the time-level indices in OCE/step.F90 we have
135         ! "before" fields = "now" fields.
136         tr(:,:,:,:,Kmm) = tr(:,:,:,:,Kaa)
137      ENDIF
138      !
139      IF( lrst_trc ) CALL trc_rst_wri( kt, Kmm, Kaa, ibb )   ! write tracer restart file
140      !
141      IF (ll_trcstat) THEN
142         ztrai = 0._wp                                                   !  content of all tracers
143         DO jn = 1, jptra
144            ztrai = ztrai + glob_sum( 'trcstp', tr(:,:,:,jn,Kaa) * cvol(:,:,:)   )
145         END DO
146         IF( lwm ) WRITE(numstr,9300) kt,  ztrai / areatot
147      ENDIF
1489300  FORMAT(i10,D23.16)
149      !
150      IF( ln_timing )   CALL timing_stop('trc_stp')
151      !
152   END SUBROUTINE trc_stp
153
154
155   SUBROUTINE trc_stp_ctl
156      !!----------------------------------------------------------------------
157      !!                     ***  ROUTINE trc_stp_ctl  ***
158      !!----------------------------------------------------------------------
159      !
160      ! Define logical parameter ton control dirunal cycle in TOP
161      l_trcdm2dc = ( ln_trcdc2dm .AND. .NOT. ln_dm2dc  ) 
162      !
163      IF( l_trcdm2dc .AND. lwp )   CALL ctl_warn( 'Coupling with passive tracers and used of diurnal cycle.',   &
164         &                           'Computation of a daily mean shortwave for some biogeochemical models ' )
165      !
166   END SUBROUTINE trc_stp_ctl
167
168
169   SUBROUTINE trc_mean_qsr( kt )
170      !!----------------------------------------------------------------------
171      !!             ***  ROUTINE trc_mean_qsr  ***
172      !!
173      !! ** Purpose :  Compute daily mean qsr for biogeochemical model in case
174      !!               of diurnal cycle
175      !!
176      !! ** Method  : store in TOP the qsr every hour ( or every time-step if the latter
177      !!              is greater than 1 hour ) and then, compute the  mean with
178      !!              a moving average over 24 hours.
179      !!              In coupled mode, the sampling is done at every coupling frequency
180      !!----------------------------------------------------------------------
181      INTEGER, INTENT( in ) ::   kt   ! ocean time-step index
182      !
183      INTEGER  ::   jn   ! dummy loop indices
184      REAL(wp) ::   zkt, zrec     ! local scalars
185      CHARACTER(len=1) ::   cl1   ! 1 character
186      CHARACTER(len=2) ::   cl2   ! 2 characters
187      !!----------------------------------------------------------------------
188      !
189      IF( ln_timing )   CALL timing_start('trc_mean_qsr')
190      !
191      IF( kt == nittrc000 ) THEN
192         !
193         rdt_sampl = REAL( ncpl_qsr_freq )
194         nb_rec_per_day = INT( rday / ncpl_qsr_freq )
195         !
196         IF(lwp) THEN
197            WRITE(numout,*) 
198            WRITE(numout,*) ' Sampling frequency dt = ', rdt_sampl, 's','   Number of sampling per day  nrec = ', nb_rec_per_day
199            WRITE(numout,*) 
200         ENDIF
201         !
202         ALLOCATE( qsr_arr(jpi,jpj,nb_rec_per_day ) )
203         !
204         !                                            !* Restart: read in restart file
205         IF( ln_rsttr .AND. nn_rsttr /= 0 .AND. iom_varid( numrtr, 'qsr_mean' , ldstop = .FALSE. ) > 0  &
206           &                              .AND. iom_varid( numrtr, 'qsr_arr_1', ldstop = .FALSE. ) > 0  &
207           &                              .AND. iom_varid( numrtr, 'ktdcy'    , ldstop = .FALSE. ) > 0  &
208           &                              .AND. iom_varid( numrtr, 'nrdcy'    , ldstop = .FALSE. ) > 0  ) THEN
209            CALL iom_get( numrtr, 'ktdcy', zkt ) 
210            rsecfst = INT( zkt ) * rn_Dt
211            IF(lwp) WRITE(numout,*) 'trc_qsr_mean:   qsr_mean read in the restart file at time-step rsecfst =', rsecfst, ' s '
212            CALL iom_get( numrtr, jpdom_auto, 'qsr_mean', qsr_mean )   !  A mean of qsr
213            CALL iom_get( numrtr, 'nrdcy', zrec )   !  Number of record per days
214            IF( INT( zrec ) == nb_rec_per_day ) THEN
215               DO jn = 1, nb_rec_per_day 
216                  IF( jn <= 9 )  THEN
217                    WRITE(cl1,'(i1)') jn
218                    CALL iom_get( numrtr, jpdom_auto, 'qsr_arr_'//cl1, qsr_arr(:,:,jn) )   !  A mean of qsr
219                  ELSE
220                    WRITE(cl2,'(i2.2)') jn
221                    CALL iom_get( numrtr, jpdom_auto, 'qsr_arr_'//cl2, qsr_arr(:,:,jn) )   !  A mean of qsr
222                  ENDIF
223              END DO
224            ELSE
225               DO jn = 1, nb_rec_per_day
226                  qsr_arr(:,:,jn) = qsr_mean(:,:)
227               ENDDO
228            ENDIF
229         ELSE                                         !* no restart: set from nit000 values
230            IF(lwp) WRITE(numout,*) 'trc_qsr_mean:   qsr_mean set to nit000 values'
231            rsecfst  = kt * rn_Dt
232            !
233            qsr_mean(:,:) = qsr(:,:)
234            DO jn = 1, nb_rec_per_day
235               qsr_arr(:,:,jn) = qsr_mean(:,:)
236            END DO
237         ENDIF
238         !
239      ENDIF
240      !
241      rseclast = kt * rn_Dt
242      !
243      llnew   = ( rseclast - rsecfst ) .ge.  rdt_sampl    !   new shortwave to store
244      IF( llnew ) THEN
245          ktdcy = kt
246          IF( lwp .AND. kt < nittrc000 + 100 ) WRITE(numout,*) ' New shortwave to sample for TOP at time kt = ', ktdcy, &
247             &                      ' time = ', rseclast/3600.,'hours '
248          rsecfst = rseclast
249          DO jn = 1, nb_rec_per_day - 1
250             qsr_arr(:,:,jn) = qsr_arr(:,:,jn+1)
251          ENDDO
252          qsr_arr (:,:,nb_rec_per_day) = qsr(:,:)
253          qsr_mean(:,:                ) = SUM( qsr_arr(:,:,:), 3 ) / nb_rec_per_day
254      ENDIF
255      !
256      IF( lrst_trc ) THEN    !* Write the mean of qsr in restart file
257         IF(lwp) WRITE(numout,*)
258         IF(lwp) WRITE(numout,*) 'trc_mean_qsr : write qsr_mean in restart file  kt =', kt
259         IF(lwp) WRITE(numout,*) '~~~~~~~'
260         zkt  = REAL( ktdcy, wp )
261         zrec = REAL( nb_rec_per_day, wp )
262         CALL iom_rstput( kt, nitrst, numrtw, 'ktdcy', zkt  )
263         CALL iom_rstput( kt, nitrst, numrtw, 'nrdcy', zrec )
264          DO jn = 1, nb_rec_per_day 
265             IF( jn <= 9 )  THEN
266               WRITE(cl1,'(i1)') jn
267               CALL iom_rstput( kt, nitrst, numrtw, 'qsr_arr_'//cl1, qsr_arr(:,:,jn) )
268             ELSE
269               WRITE(cl2,'(i2.2)') jn
270               CALL iom_rstput( kt, nitrst, numrtw, 'qsr_arr_'//cl2, qsr_arr(:,:,jn) )
271             ENDIF
272         END DO
273         CALL iom_rstput( kt, nitrst, numrtw, 'qsr_mean', qsr_mean(:,:) )
274      ENDIF
275      !
276      IF( ln_timing )   CALL timing_stop('trc_mean_qsr')
277      !
278   END SUBROUTINE trc_mean_qsr
279
280#else
281   !!----------------------------------------------------------------------
282   !!   Default key                                     NO passive tracers
283   !!----------------------------------------------------------------------
284CONTAINS
285   SUBROUTINE trc_stp( kt )        ! Empty routine
286      WRITE(*,*) 'trc_stp: You should not have seen this print! error?', kt
287   END SUBROUTINE trc_stp
288#endif
289
290   !!======================================================================
291END MODULE trcstp
Note: See TracBrowser for help on using the repository browser.