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.
tranxt.F90 in branches/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO/OPA_SRC/TRA – NEMO

source: branches/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO/OPA_SRC/TRA/tranxt.F90 @ 7549

Last change on this file since 7549 was 7549, checked in by davestorkey, 7 years ago

Correct calculation of total tracer trend. New calculation uses ta-tn rather than
ta-tb. This is cleaner since ta and tn are both non-time-filtered whereas tb is
time-filtered. The new variable passes the sanity check whereby the time mean of
the total trend multiplied by the time-interval gives the change between the start
and end fields.
File size: 19.7 KB
Line 
1MODULE tranxt
2   !!======================================================================
3   !!                       ***  MODULE  tranxt  ***
4   !! Ocean active tracers:  time stepping on temperature and salinity
5   !!======================================================================
6   !! History :  OPA  !  1991-11  (G. Madec)  Original code
7   !!            7.0  !  1993-03  (M. Guyon)  symetrical conditions
8   !!            8.0  !  1996-02  (G. Madec & M. Imbard)  opa release 8.0
9   !!             -   !  1996-04  (A. Weaver)  Euler forward step
10   !!            8.2  !  1999-02  (G. Madec, N. Grima)  semi-implicit pressure grad.
11   !!  NEMO      1.0  !  2002-08  (G. Madec)  F90: Free form and module
12   !!             -   !  2002-11  (C. Talandier, A-M Treguier) Open boundaries
13   !!             -   !  2005-04  (C. Deltel) Add Asselin trend in the ML budget
14   !!            2.0  !  2006-02  (L. Debreu, C. Mazauric) Agrif implementation
15   !!            3.0  !  2008-06  (G. Madec)  time stepping always done in trazdf
16   !!            3.1  !  2009-02  (G. Madec, R. Benshila)  re-introduce the vvl option
17   !!            3.3  !  2010-04  (M. Leclair, G. Madec)  semi-implicit hpg with asselin filter + modified LF-RA
18   !!             -   !  2010-05  (C. Ethe, G. Madec)  merge TRC-TRA
19   !!----------------------------------------------------------------------
20
21   !!----------------------------------------------------------------------
22   !!   tra_nxt       : time stepping on tracers
23   !!   tra_nxt_fix   : time stepping on tracers : fixed    volume case
24   !!   tra_nxt_vvl   : time stepping on tracers : variable volume case
25   !!----------------------------------------------------------------------
26   USE oce             ! ocean dynamics and tracers variables
27   USE dom_oce         ! ocean space and time domain variables
28   USE sbc_oce         ! surface boundary condition: ocean
29   USE sbcrnf          ! river runoffs
30   USE sbcisf          ! ice shelf melting/freezing
31   USE zdf_oce         ! ocean vertical mixing
32   USE domvvl          ! variable volume
33   USE dynspg_oce      ! surface     pressure gradient variables
34   USE dynhpg          ! hydrostatic pressure gradient
35   USE trd_oce         ! trends: ocean variables
36   USE trdtra          ! trends manager: tracers
37   USE traqsr          ! penetrative solar radiation (needed for nksr)
38   USE phycst          ! physical constant
39   USE ldftra_oce      ! lateral physics on tracers
40   USE bdy_oce         ! BDY open boundary condition variables
41   USE bdytra          ! open boundary condition (bdy_tra routine)
42   !
43   USE in_out_manager  ! I/O manager
44   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
45   USE prtctl          ! Print control
46   USE wrk_nemo        ! Memory allocation
47   USE timing          ! Timing
48#if defined key_agrif
49   USE agrif_opa_interp
50#endif
51
52   IMPLICIT NONE
53   PRIVATE
54
55   PUBLIC   tra_nxt       ! routine called by step.F90
56   PUBLIC   tra_nxt_fix   ! to be used in trcnxt
57   PUBLIC   tra_nxt_vvl   ! to be used in trcnxt
58
59   REAL(wp) ::   rbcp   ! Brown & Campana parameters for semi-implicit hpg
60
61   !! * Substitutions
62#  include "domzgr_substitute.h90"
63   !!----------------------------------------------------------------------
64   !! NEMO/OPA 3.3 , NEMO-Consortium (2010)
65   !! $Id$
66   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
67   !!----------------------------------------------------------------------
68CONTAINS
69
70   SUBROUTINE tra_nxt( kt )
71      !!----------------------------------------------------------------------
72      !!                   ***  ROUTINE tranxt  ***
73      !!
74      !! ** Purpose :   Apply the boundary condition on the after temperature 
75      !!             and salinity fields, achieved the time stepping by adding
76      !!             the Asselin filter on now fields and swapping the fields.
77      !!
78      !! ** Method  :   At this stage of the computation, ta and sa are the
79      !!             after temperature and salinity as the time stepping has
80      !!             been performed in trazdf_imp or trazdf_exp module.
81      !!
82      !!              - Apply lateral boundary conditions on (ta,sa)
83      !!             at the local domain   boundaries through lbc_lnk call,
84      !!             at the one-way open boundaries (lk_bdy=T),
85      !!             at the AGRIF zoom   boundaries (lk_agrif=T)
86      !!
87      !!              - Update lateral boundary conditions on AGRIF children
88      !!             domains (lk_agrif=T)
89      !!
90      !! ** Action  : - (tb,sb) and (tn,sn) ready for the next time step
91      !!              - (ta,sa) time averaged (t,s)   (ln_dynhpg_imp = T)
92      !!----------------------------------------------------------------------
93      INTEGER, INTENT(in) ::   kt    ! ocean time-step index
94      !!
95      INTEGER  ::   jk, jn    ! dummy loop indices
96      REAL(wp) ::   zfact     ! local scalars
97      REAL(wp), POINTER, DIMENSION(:,:,:) ::  ztrdt, ztrds
98      !!----------------------------------------------------------------------
99      !
100      IF( nn_timing == 1 )  CALL timing_start( 'tra_nxt')
101      !
102      IF( kt == nit000 ) THEN
103         IF(lwp) WRITE(numout,*)
104         IF(lwp) WRITE(numout,*) 'tra_nxt : achieve the time stepping by Asselin filter and array swap'
105         IF(lwp) WRITE(numout,*) '~~~~~~~'
106         !
107         rbcp = 0.25_wp * (1._wp + atfp) * (1._wp + atfp) * ( 1._wp - atfp)      ! Brown & Campana parameter for semi-implicit hpg
108      ENDIF
109
110      ! Update after tracer on domain lateral boundaries
111      !
112#if defined key_agrif
113      CALL Agrif_tra                     ! AGRIF zoom boundaries
114#endif
115      !
116      CALL lbc_lnk( tsa(:,:,:,jp_tem), 'T', 1._wp )      ! local domain boundaries  (T-point, unchanged sign)
117      CALL lbc_lnk( tsa(:,:,:,jp_sal), 'T', 1._wp )
118      !
119#if defined key_bdy 
120      IF( lk_bdy )   CALL bdy_tra( kt )  ! BDY open boundaries
121#endif
122 
123      ! set time step size (Euler/Leapfrog)
124      IF( neuler == 0 .AND. kt == nit000 ) THEN   ;   r2dtra(:) =     rdttra(:)      ! at nit000             (Euler)
125      ELSEIF( kt <= nit000 + 1 )           THEN   ;   r2dtra(:) = 2._wp* rdttra(:)      ! at nit000 or nit000+1 (Leapfrog)
126      ENDIF
127
128      ! trends computation initialisation
129      IF( l_trdtra )   THEN                    ! store now fields before applying the Asselin filter
130         CALL wrk_alloc( jpi, jpj, jpk, ztrdt, ztrds )
131         ! Asselin filter trend
132         ztrdt(:,:,:) = tsn(:,:,:,jp_tem) 
133         ztrds(:,:,:) = tsn(:,:,:,jp_sal)
134         IF( ln_traldf_iso ) THEN              ! diagnose the "pure" Kz diffusive trend
135            CALL trd_tra( kt, 'TRA', jp_tem, jptra_zdfp, ztrdt )
136            CALL trd_tra( kt, 'TRA', jp_sal, jptra_zdfp, ztrds )
137         ENDIF
138         ! total trend for the non-time-filtered variables.
139         ztrdt(:,:,:) = 0._wp
140         ztrds(:,:,:) = 0._wp
141         DO jk = 1, jpkm1
142            zfact = 1.0 / rdttra(jk)
143            ztrdt(:,:,jk) = ( tsa(:,:,jk,jp_tem) - tsn(:,:,jk,jp_tem) ) * zfact 
144            ztrds(:,:,jk) = ( tsa(:,:,jk,jp_sal) - tsn(:,:,jk,jp_sal) ) * zfact 
145         END DO
146         CALL trd_tra( kt, 'TRA', jp_tem, jptra_tot, ztrdt )
147         CALL trd_tra( kt, 'TRA', jp_sal, jptra_tot, ztrds )
148      ENDIF
149
150      IF( neuler == 0 .AND. kt == nit000 ) THEN       ! Euler time-stepping at first time-step (only swap)
151         DO jn = 1, jpts
152            DO jk = 1, jpkm1
153               tsn(:,:,jk,jn) = tsa(:,:,jk,jn)   
154            END DO
155         END DO
156      ELSE                                            ! Leap-Frog + Asselin filter time stepping
157         !
158         IF( lk_vvl )  THEN   ;   CALL tra_nxt_vvl( kt, nit000, rdttra, 'TRA', tsb, tsn, tsa,   &
159           &                                                              sbc_tsc, sbc_tsc_b, jpts )  ! variable volume level (vvl)
160         ELSE                 ;   CALL tra_nxt_fix( kt, nit000,         'TRA', tsb, tsn, tsa, jpts )  ! fixed    volume level
161         ENDIF
162      ENDIF     
163      !
164     ! trends computation
165      IF( l_trdtra ) THEN      ! trend of the Asselin filter (tb filtered - tb)/dt     
166         DO jk = 1, jpkm1
167            zfact = 1._wp / r2dtra(jk)             
168            ztrdt(:,:,jk) = ( tsb(:,:,jk,jp_tem) - ztrdt(:,:,jk) ) * zfact
169            ztrds(:,:,jk) = ( tsb(:,:,jk,jp_sal) - ztrds(:,:,jk) ) * zfact
170         END DO
171         CALL trd_tra( kt, 'TRA', jp_tem, jptra_atf, ztrdt )
172         CALL trd_tra( kt, 'TRA', jp_sal, jptra_atf, ztrds )
173         CALL wrk_dealloc( jpi, jpj, jpk, ztrdt, ztrds )
174      END IF
175      !
176      !                        ! control print
177      IF(ln_ctl)   CALL prt_ctl( tab3d_1=tsn(:,:,:,jp_tem), clinfo1=' nxt  - Tn: ', mask1=tmask,   &
178         &                       tab3d_2=tsn(:,:,:,jp_sal), clinfo2=       ' Sn: ', mask2=tmask )
179      !
180      IF( nn_timing == 1 )   CALL timing_stop('tra_nxt')
181      !
182   END SUBROUTINE tra_nxt
183
184
185   SUBROUTINE tra_nxt_fix( kt, kit000, cdtype, ptb, ptn, pta, kjpt )
186      !!----------------------------------------------------------------------
187      !!                   ***  ROUTINE tra_nxt_fix  ***
188      !!
189      !! ** Purpose :   fixed volume: apply the Asselin time filter and
190      !!                swap the tracer fields.
191      !!
192      !! ** Method  : - Apply a Asselin time filter on now fields.
193      !!              - save in (ta,sa) an average over the three time levels
194      !!             which will be used to compute rdn and thus the semi-implicit
195      !!             hydrostatic pressure gradient (ln_dynhpg_imp = T)
196      !!              - swap tracer fields to prepare the next time_step.
197      !!                This can be summurized for tempearture as:
198      !!             ztm = tn + rbcp * [ta -2 tn + tb ]       ln_dynhpg_imp = T
199      !!             ztm = 0                                   otherwise
200      !!                   with rbcp=1/4 * (1-atfp^4) / (1-atfp)
201      !!             tb  = tn + atfp*[ tb - 2 tn + ta ]
202      !!             tn  = ta 
203      !!             ta  = ztm       (NB: reset to 0 after eos_bn2 call)
204      !!
205      !! ** Action  : - (tb,sb) and (tn,sn) ready for the next time step
206      !!              - (ta,sa) time averaged (t,s)   (ln_dynhpg_imp = T)
207      !!----------------------------------------------------------------------
208      INTEGER         , INTENT(in   )                               ::   kt       ! ocean time-step index
209      INTEGER         , INTENT(in   )                               ::   kit000   ! first time step index
210      CHARACTER(len=3), INTENT(in   )                               ::   cdtype   ! =TRA or TRC (tracer indicator)
211      INTEGER         , INTENT(in   )                               ::   kjpt     ! number of tracers
212      REAL(wp)        , INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt)  ::   ptb      ! before tracer fields
213      REAL(wp)        , INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt)  ::   ptn      ! now tracer fields
214      REAL(wp)        , INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt)  ::   pta      ! tracer trend
215      !
216      INTEGER  ::   ji, jj, jk, jn   ! dummy loop indices
217      LOGICAL  ::   ll_tra_hpg       ! local logical
218      REAL(wp) ::   ztn, ztd         ! local scalars
219      !!----------------------------------------------------------------------
220
221      IF( kt == kit000 )  THEN
222         IF(lwp) WRITE(numout,*)
223         IF(lwp) WRITE(numout,*) 'tra_nxt_fix : time stepping', cdtype
224         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~'
225      ENDIF
226      !
227      IF( cdtype == 'TRA' )  THEN   ;   ll_tra_hpg = ln_dynhpg_imp    ! active  tracers case  and  semi-implicit hpg   
228      ELSE                          ;   ll_tra_hpg = .FALSE.          ! passive tracers case or NO semi-implicit hpg
229      ENDIF
230      !
231      DO jn = 1, kjpt
232         !
233         DO jk = 1, jpkm1
234            DO jj = 1, jpj
235               DO ji = 1, jpi
236                  ztn = ptn(ji,jj,jk,jn)                                   
237                  ztd = pta(ji,jj,jk,jn) - 2. * ztn + ptb(ji,jj,jk,jn)      !  time laplacian on tracers
238                  !
239                  ptb(ji,jj,jk,jn) = ztn + atfp * ztd                       ! ptb <-- filtered ptn
240                  ptn(ji,jj,jk,jn) = pta(ji,jj,jk,jn)                       ! ptn <-- pta
241                  !
242                  IF( ll_tra_hpg )   pta(ji,jj,jk,jn) = ztn + rbcp * ztd    ! pta <-- Brown & Campana average
243               END DO
244           END DO
245         END DO
246         !
247      END DO
248      !
249   END SUBROUTINE tra_nxt_fix
250
251
252   SUBROUTINE tra_nxt_vvl( kt, kit000, p2dt, cdtype, ptb, ptn, pta, psbc_tc, psbc_tc_b, kjpt )
253      !!----------------------------------------------------------------------
254      !!                   ***  ROUTINE tra_nxt_vvl  ***
255      !!
256      !! ** Purpose :   Time varying volume: apply the Asselin time filter 
257      !!                and swap the tracer fields.
258      !!
259      !! ** Method  : - Apply a thickness weighted Asselin time filter on now fields.
260      !!              - save in (ta,sa) a thickness weighted average over the three
261      !!             time levels which will be used to compute rdn and thus the semi-
262      !!             implicit hydrostatic pressure gradient (ln_dynhpg_imp = T)
263      !!              - swap tracer fields to prepare the next time_step.
264      !!                This can be summurized for tempearture as:
265      !!             ztm = ( e3t_n*tn + rbcp*[ e3t_b*tb - 2 e3t_n*tn + e3t_a*ta ] )   ln_dynhpg_imp = T
266      !!                  /( e3t_n    + rbcp*[ e3t_b    - 2 e3t_n    + e3t_a    ] )   
267      !!             ztm = 0                                                       otherwise
268      !!             tb  = ( e3t_n*tn + atfp*[ e3t_b*tb - 2 e3t_n*tn + e3t_a*ta ] )
269      !!                  /( e3t_n    + atfp*[ e3t_b    - 2 e3t_n    + e3t_a    ] )
270      !!             tn  = ta
271      !!             ta  = zt        (NB: reset to 0 after eos_bn2 call)
272      !!
273      !! ** Action  : - (tb,sb) and (tn,sn) ready for the next time step
274      !!              - (ta,sa) time averaged (t,s)   (ln_dynhpg_imp = T)
275      !!----------------------------------------------------------------------
276      INTEGER         , INTENT(in   )                               ::  kt       ! ocean time-step index
277      INTEGER         , INTENT(in   )                               ::  kit000   ! first time step index
278      REAL(wp)        , INTENT(in   ), DIMENSION(jpk)               ::  p2dt     ! time-step
279      CHARACTER(len=3), INTENT(in   )                               ::  cdtype   ! =TRA or TRC (tracer indicator)
280      INTEGER         , INTENT(in   )                               ::  kjpt     ! number of tracers
281      REAL(wp)        , INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt)  ::  ptb      ! before tracer fields
282      REAL(wp)        , INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt)  ::  ptn      ! now tracer fields
283      REAL(wp)        , INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt)  ::  pta      ! tracer trend
284      REAL(wp)        , INTENT(in   ), DIMENSION(jpi,jpj,kjpt)      ::  psbc_tc   ! surface tracer content
285      REAL(wp)        , INTENT(in   ), DIMENSION(jpi,jpj,kjpt)      ::  psbc_tc_b ! before surface tracer content
286
287      !!     
288      LOGICAL  ::   ll_tra_hpg, ll_traqsr, ll_rnf, ll_isf   ! local logical
289      INTEGER  ::   ji, jj, jk, jn              ! dummy loop indices
290      REAL(wp) ::   zfact1, ztc_a , ztc_n , ztc_b , ztc_f , ztc_d    ! local scalar
291      REAL(wp) ::   zfact2, ze3t_b, ze3t_n, ze3t_a, ze3t_f, ze3t_d   !   -      -
292      !!----------------------------------------------------------------------
293      !
294      IF( kt == kit000 )  THEN
295         IF(lwp) WRITE(numout,*)
296         IF(lwp) WRITE(numout,*) 'tra_nxt_vvl : time stepping', cdtype
297         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~'
298      ENDIF
299      !
300      IF( cdtype == 'TRA' )  THEN   
301         ll_tra_hpg = ln_dynhpg_imp    ! active  tracers case  and  semi-implicit hpg
302         ll_traqsr  = ln_traqsr        ! active  tracers case  and  solar penetration
303         ll_rnf     = ln_rnf           ! active  tracers case  and  river runoffs
304         IF (nn_isf .GE. 1) THEN
305            ll_isf = .TRUE.            ! active  tracers case  and  ice shelf melting/freezing
306         ELSE
307            ll_isf = .FALSE.
308         END IF
309      ELSE                         
310         ll_tra_hpg = .FALSE.          ! passive tracers case or NO semi-implicit hpg
311         ll_traqsr  = .FALSE.          ! active  tracers case and NO solar penetration
312         ll_rnf     = .FALSE.          ! passive tracers or NO river runoffs
313         ll_isf     = .FALSE.          ! passive tracers or NO ice shelf melting/freezing
314      ENDIF
315      !
316      DO jn = 1, kjpt     
317         DO jk = 1, jpkm1
318            zfact1 = atfp * p2dt(jk)
319            zfact2 = zfact1 / rau0
320            DO jj = 1, jpj
321               DO ji = 1, jpi
322                  ze3t_b = fse3t_b(ji,jj,jk)
323                  ze3t_n = fse3t_n(ji,jj,jk)
324                  ze3t_a = fse3t_a(ji,jj,jk)
325                  !                                         ! tracer content at Before, now and after
326                  ztc_b  = ptb(ji,jj,jk,jn) * ze3t_b
327                  ztc_n  = ptn(ji,jj,jk,jn) * ze3t_n
328                  ztc_a  = pta(ji,jj,jk,jn) * ze3t_a
329                  !
330                  ze3t_d = ze3t_a - 2. * ze3t_n + ze3t_b
331                  ztc_d  = ztc_a  - 2. * ztc_n  + ztc_b
332                  !
333                  ze3t_f = ze3t_n + atfp * ze3t_d
334                  ztc_f  = ztc_n  + atfp * ztc_d
335                  !
336                  IF( jk == mikt(ji,jj) ) THEN           ! first level
337                     ze3t_f = ze3t_f - zfact2 * ( (emp_b(ji,jj)    - emp(ji,jj)   )  &
338                            &                   - (rnf_b(ji,jj)    - rnf(ji,jj)   )  &
339                            &                   + (fwfisf_b(ji,jj) - fwfisf(ji,jj))  )
340                     ztc_f  = ztc_f  - zfact1 * ( psbc_tc(ji,jj,jn) - psbc_tc_b(ji,jj,jn) )
341                  ENDIF
342
343                  ! solar penetration (temperature only)
344                  IF( ll_traqsr .AND. jn == jp_tem .AND. jk <= nksr )                            & 
345                     &     ztc_f  = ztc_f  - zfact1 * ( qsr_hc(ji,jj,jk) - qsr_hc_b(ji,jj,jk) ) 
346
347                  ! river runoff
348                  IF( ll_rnf .AND. jk <= nk_rnf(ji,jj) )                                          &
349                     &     ztc_f  = ztc_f  - zfact1 * ( rnf_tsc(ji,jj,jn) - rnf_tsc_b(ji,jj,jn) ) & 
350                     &                              * fse3t_n(ji,jj,jk) / h_rnf(ji,jj)
351
352                  ! ice shelf
353                  IF( ll_isf ) THEN
354                     ! level fully include in the Losch_2008 ice shelf boundary layer
355                     IF ( jk >= misfkt(ji,jj) .AND. jk < misfkb(ji,jj) )                          &
356                        ztc_f  = ztc_f  - zfact1 * ( risf_tsc(ji,jj,jn) - risf_tsc_b(ji,jj,jn) )  &
357                               &                 * fse3t_n(ji,jj,jk) * r1_hisf_tbl (ji,jj)
358                     ! level partially include in Losch_2008 ice shelf boundary layer
359                     IF ( jk == misfkb(ji,jj) )                                                   &
360                        ztc_f  = ztc_f  - zfact1 * ( risf_tsc(ji,jj,jn) - risf_tsc_b(ji,jj,jn) )  &
361                               &                 * fse3t_n(ji,jj,jk) * r1_hisf_tbl (ji,jj) * ralpha(ji,jj)
362                  END IF
363
364                  ze3t_f = 1.e0 / ze3t_f
365                  ptb(ji,jj,jk,jn) = ztc_f * ze3t_f       ! ptb <-- ptn filtered
366                  ptn(ji,jj,jk,jn) = pta(ji,jj,jk,jn)     ! ptn <-- pta
367                  !
368                  IF( ll_tra_hpg ) THEN        ! semi-implicit hpg (T & S only)
369                     ze3t_d           = 1.e0   / ( ze3t_n + rbcp * ze3t_d )
370                     pta(ji,jj,jk,jn) = ze3t_d * ( ztc_n  + rbcp * ztc_d  )   ! ta <-- Brown & Campana average
371                  ENDIF
372               END DO
373            END DO
374         END DO
375         !
376      END DO
377      !
378   END SUBROUTINE tra_nxt_vvl
379
380   !!======================================================================
381END MODULE tranxt
Note: See TracBrowser for help on using the repository browser.