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_FOAMv14_bgcupdates/NEMOGCM/NEMO/OPA_SRC/TRA – NEMO

source: branches/UKMO/dev_r5518_GO6_package_FOAMv14_bgcupdates/NEMOGCM/NEMO/OPA_SRC/TRA/tranxt.F90 @ 10232

Last change on this file since 10232 was 10232, checked in by dford, 5 years ago

Merge in revisions 8447:10159 of dev_r5518_GO6_package.
File size: 21.8 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
53   IMPLICIT NONE
54   PRIVATE
55
56   PUBLIC   tra_nxt       ! routine called by step.F90
57   PUBLIC   tra_nxt_fix   ! to be used in trcnxt
58   PUBLIC   tra_nxt_vvl   ! to be used in trcnxt
59
60   REAL(wp) ::   rbcp   ! Brown & Campana parameters for semi-implicit hpg
61
62   !! * Substitutions
63#  include "domzgr_substitute.h90"
64   !!----------------------------------------------------------------------
65   !! NEMO/OPA 3.3 , NEMO-Consortium (2010)
66   !! $Id$
67   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
68   !!----------------------------------------------------------------------
69CONTAINS
70
71   SUBROUTINE tra_nxt( kt )
72      !!----------------------------------------------------------------------
73      !!                   ***  ROUTINE tranxt  ***
74      !!
75      !! ** Purpose :   Apply the boundary condition on the after temperature 
76      !!             and salinity fields, achieved the time stepping by adding
77      !!             the Asselin filter on now fields and swapping the fields.
78      !!
79      !! ** Method  :   At this stage of the computation, ta and sa are the
80      !!             after temperature and salinity as the time stepping has
81      !!             been performed in trazdf_imp or trazdf_exp module.
82      !!
83      !!              - Apply lateral boundary conditions on (ta,sa)
84      !!             at the local domain   boundaries through lbc_lnk call,
85      !!             at the one-way open boundaries (lk_bdy=T),
86      !!             at the AGRIF zoom   boundaries (lk_agrif=T)
87      !!
88      !!              - Update lateral boundary conditions on AGRIF children
89      !!             domains (lk_agrif=T)
90      !!
91      !! ** Action  : - (tb,sb) and (tn,sn) ready for the next time step
92      !!              - (ta,sa) time averaged (t,s)   (ln_dynhpg_imp = T)
93      !!----------------------------------------------------------------------
94      INTEGER, INTENT(in) ::   kt    ! ocean time-step index
95      !!
96      INTEGER  ::   jk, jn    ! dummy loop indices
97      REAL(wp) ::   zfact     ! local scalars
98      REAL(wp), POINTER, DIMENSION(:,:,:) ::  ztrdt, ztrds
99      !!----------------------------------------------------------------------
100      !
101      IF( nn_timing == 1 )  CALL timing_start( 'tra_nxt')
102      !
103      IF( kt == nit000 ) THEN
104         IF(lwp) WRITE(numout,*)
105         IF(lwp) WRITE(numout,*) 'tra_nxt : achieve the time stepping by Asselin filter and array swap'
106         IF(lwp) WRITE(numout,*) '~~~~~~~'
107         !
108         rbcp = 0.25_wp * (1._wp + atfp) * (1._wp + atfp) * ( 1._wp - atfp)      ! Brown & Campana parameter for semi-implicit hpg
109      ENDIF
110
111      ! Update after tracer on domain lateral boundaries
112      !
113#if defined key_agrif
114      CALL Agrif_tra                     ! AGRIF zoom boundaries
115#endif
116      !
117      CALL lbc_lnk( tsa(:,:,:,jp_tem), 'T', 1._wp )      ! local domain boundaries  (T-point, unchanged sign)
118      CALL lbc_lnk( tsa(:,:,:,jp_sal), 'T', 1._wp )
119      !
120#if defined key_bdy 
121      IF( lk_bdy )   CALL bdy_tra( kt )  ! BDY open boundaries
122#endif
123 
124      ! set time step size (Euler/Leapfrog)
125      IF( neuler == 0 .AND. kt == nit000 ) THEN   ;   r2dtra(:) =     rdttra(:)      ! at nit000             (Euler)
126      ELSEIF( kt <= nit000 + 1 )           THEN   ;   r2dtra(:) = 2._wp* rdttra(:)      ! at nit000 or nit000+1 (Leapfrog)
127      ENDIF
128
129      ! trends computation initialisation
130      IF( l_trdtra )   THEN                   
131         CALL wrk_alloc( jpi, jpj, jpk, ztrdt, ztrds )
132         ztrdt(:,:,jpk) = 0._wp
133         ztrds(:,:,jpk) = 0._wp
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         ! G Nurser 23 Mar 2017. Recalculate trend as Delta(e3t*T)/e3tn; e3tn cancel from tsn terms
140         IF( lk_vvl ) THEN
141            DO jk = 1, jpkm1
142               zfact = 1.0 / rdttra(jk)
143               ztrdt(:,:,jk) = ( tsa(:,:,jk,jp_tem)*fse3t_a(:,:,jk) / fse3t_n(:,:,jk) - tsn(:,:,jk,jp_tem)) * zfact
144               ztrds(:,:,jk) = ( tsa(:,:,jk,jp_sal)*fse3t_a(:,:,jk) / fse3t_n(:,:,jk) - tsn(:,:,jk,jp_sal)) * zfact
145            END DO
146         ELSE
147            DO jk = 1, jpkm1
148               zfact = 1.0 / rdttra(jk)
149               ztrdt(:,:,jk) = ( tsa(:,:,jk,jp_tem) - tsn(:,:,jk,jp_tem) ) * zfact 
150               ztrds(:,:,jk) = ( tsa(:,:,jk,jp_sal) - tsn(:,:,jk,jp_sal) ) * zfact 
151            END DO
152         END IF
153         CALL trd_tra( kt, 'TRA', jp_tem, jptra_tot, ztrdt )
154         CALL trd_tra( kt, 'TRA', jp_sal, jptra_tot, ztrds )
155         IF( .NOT.lk_vvl )  THEN
156            ! Store now fields before applying the Asselin filter
157            ! in order to calculate Asselin filter trend later.
158            ztrdt(:,:,:) = tsn(:,:,:,jp_tem) 
159            ztrds(:,:,:) = tsn(:,:,:,jp_sal)
160         END IF
161      ENDIF
162
163      IF( neuler == 0 .AND. kt == nit000 ) THEN       ! Euler time-stepping at first time-step (only swap)
164         DO jn = 1, jpts
165            DO jk = 1, jpkm1
166               tsn(:,:,jk,jn) = tsa(:,:,jk,jn)   
167            END DO
168         END DO
169         IF (l_trdtra.AND.lk_vvl) THEN      ! Zero Asselin filter contribution must be explicitly written out since for vvl
170                                            ! Asselin filter is output by tra_nxt_vvl that is not called on this time step
171            ztrdt(:,:,:) = 0._wp
172            ztrds(:,:,:) = 0._wp
173            CALL trd_tra( kt, 'TRA', jp_tem, jptra_atf, ztrdt )
174            CALL trd_tra( kt, 'TRA', jp_sal, jptra_atf, ztrds )
175         END IF
176      ELSE                                            ! Leap-Frog + Asselin filter time stepping
177         !
178         IF( lk_vvl )  THEN   ;   CALL tra_nxt_vvl( kt, nit000, rdttra, 'TRA', tsb, tsn, tsa,   &
179           &                                                              sbc_tsc, sbc_tsc_b, jpts )  ! variable volume level (vvl)
180         ELSE                 ;   CALL tra_nxt_fix( kt, nit000,         'TRA', tsb, tsn, tsa, jpts )  ! fixed    volume level
181         ENDIF
182      ENDIF     
183      !
184     ! trends computation
185      IF( l_trdtra.AND..NOT.lk_vvl) THEN      ! trend of the Asselin filter (tb filtered - tb)/dt     
186         DO jk = 1, jpkm1
187            zfact = 1._wp / r2dtra(jk)             
188            ztrdt(:,:,jk) = ( tsb(:,:,jk,jp_tem) - ztrdt(:,:,jk) ) * zfact
189            ztrds(:,:,jk) = ( tsb(:,:,jk,jp_sal) - ztrds(:,:,jk) ) * zfact
190         END DO
191         CALL trd_tra( kt, 'TRA', jp_tem, jptra_atf, ztrdt )
192         CALL trd_tra( kt, 'TRA', jp_sal, jptra_atf, ztrds )
193      END IF
194      IF( l_trdtra) CALL wrk_dealloc( jpi, jpj, jpk, ztrdt, ztrds )
195      !
196      !                        ! control print
197      IF(ln_ctl)   CALL prt_ctl( tab3d_1=tsn(:,:,:,jp_tem), clinfo1=' nxt  - Tn: ', mask1=tmask,   &
198         &                       tab3d_2=tsn(:,:,:,jp_sal), clinfo2=       ' Sn: ', mask2=tmask )
199      !
200      IF( nn_timing == 1 )   CALL timing_stop('tra_nxt')
201      !
202   END SUBROUTINE tra_nxt
203
204
205   SUBROUTINE tra_nxt_fix( kt, kit000, cdtype, ptb, ptn, pta, kjpt )
206      !!----------------------------------------------------------------------
207      !!                   ***  ROUTINE tra_nxt_fix  ***
208      !!
209      !! ** Purpose :   fixed volume: apply the Asselin time filter and
210      !!                swap the tracer fields.
211      !!
212      !! ** Method  : - Apply a Asselin time filter on now fields.
213      !!              - save in (ta,sa) an average over the three time levels
214      !!             which will be used to compute rdn and thus the semi-implicit
215      !!             hydrostatic pressure gradient (ln_dynhpg_imp = T)
216      !!              - swap tracer fields to prepare the next time_step.
217      !!                This can be summurized for tempearture as:
218      !!             ztm = tn + rbcp * [ta -2 tn + tb ]       ln_dynhpg_imp = T
219      !!             ztm = 0                                   otherwise
220      !!                   with rbcp=1/4 * (1-atfp^4) / (1-atfp)
221      !!             tb  = tn + atfp*[ tb - 2 tn + ta ]
222      !!             tn  = ta 
223      !!             ta  = ztm       (NB: reset to 0 after eos_bn2 call)
224      !!
225      !! ** Action  : - (tb,sb) and (tn,sn) ready for the next time step
226      !!              - (ta,sa) time averaged (t,s)   (ln_dynhpg_imp = T)
227      !!----------------------------------------------------------------------
228      INTEGER         , INTENT(in   )                               ::   kt       ! ocean time-step index
229      INTEGER         , INTENT(in   )                               ::   kit000   ! first time step index
230      CHARACTER(len=3), INTENT(in   )                               ::   cdtype   ! =TRA or TRC (tracer indicator)
231      INTEGER         , INTENT(in   )                               ::   kjpt     ! number of tracers
232      REAL(wp)        , INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt)  ::   ptb      ! before tracer fields
233      REAL(wp)        , INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt)  ::   ptn      ! now tracer fields
234      REAL(wp)        , INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt)  ::   pta      ! tracer trend
235      !
236      INTEGER  ::   ji, jj, jk, jn   ! dummy loop indices
237      LOGICAL  ::   ll_tra_hpg       ! local logical
238      REAL(wp) ::   ztn, ztd         ! local scalars
239      !!----------------------------------------------------------------------
240
241      IF( kt == kit000 )  THEN
242         IF(lwp) WRITE(numout,*)
243         IF(lwp) WRITE(numout,*) 'tra_nxt_fix : time stepping', cdtype
244         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~'
245      ENDIF
246      !
247      IF( cdtype == 'TRA' )  THEN   ;   ll_tra_hpg = ln_dynhpg_imp    ! active  tracers case  and  semi-implicit hpg   
248      ELSE                          ;   ll_tra_hpg = .FALSE.          ! passive tracers case or NO semi-implicit hpg
249      ENDIF
250      !
251      DO jn = 1, kjpt
252         !
253         DO jk = 1, jpkm1
254            DO jj = 1, jpj
255               DO ji = 1, jpi
256                  ztn = ptn(ji,jj,jk,jn)                                   
257                  ztd = pta(ji,jj,jk,jn) - 2. * ztn + ptb(ji,jj,jk,jn)      !  time laplacian on tracers
258                  !
259                  ptb(ji,jj,jk,jn) = ztn + atfp * ztd                       ! ptb <-- filtered ptn
260                  ptn(ji,jj,jk,jn) = pta(ji,jj,jk,jn)                       ! ptn <-- pta
261                  !
262                  IF( ll_tra_hpg )   pta(ji,jj,jk,jn) = ztn + rbcp * ztd    ! pta <-- Brown & Campana average
263               END DO
264           END DO
265         END DO
266         !
267      END DO
268      !
269   END SUBROUTINE tra_nxt_fix
270
271
272   SUBROUTINE tra_nxt_vvl( kt, kit000, p2dt, cdtype, ptb, ptn, pta, psbc_tc, psbc_tc_b, kjpt )
273      !!----------------------------------------------------------------------
274      !!                   ***  ROUTINE tra_nxt_vvl  ***
275      !!
276      !! ** Purpose :   Time varying volume: apply the Asselin time filter 
277      !!                and swap the tracer fields.
278      !!
279      !! ** Method  : - Apply a thickness weighted Asselin time filter on now fields.
280      !!              - save in (ta,sa) a thickness weighted average over the three
281      !!             time levels which will be used to compute rdn and thus the semi-
282      !!             implicit hydrostatic pressure gradient (ln_dynhpg_imp = T)
283      !!              - swap tracer fields to prepare the next time_step.
284      !!                This can be summurized for tempearture as:
285      !!             ztm = ( e3t_n*tn + rbcp*[ e3t_b*tb - 2 e3t_n*tn + e3t_a*ta ] )   ln_dynhpg_imp = T
286      !!                  /( e3t_n    + rbcp*[ e3t_b    - 2 e3t_n    + e3t_a    ] )   
287      !!             ztm = 0                                                       otherwise
288      !!             tb  = ( e3t_n*tn + atfp*[ e3t_b*tb - 2 e3t_n*tn + e3t_a*ta ] )
289      !!                  /( e3t_n    + atfp*[ e3t_b    - 2 e3t_n    + e3t_a    ] )
290      !!             tn  = ta
291      !!             ta  = zt        (NB: reset to 0 after eos_bn2 call)
292      !!
293      !! ** Action  : - (tb,sb) and (tn,sn) ready for the next time step
294      !!              - (ta,sa) time averaged (t,s)   (ln_dynhpg_imp = T)
295      !!----------------------------------------------------------------------
296      INTEGER         , INTENT(in   )                               ::  kt       ! ocean time-step index
297      INTEGER         , INTENT(in   )                               ::  kit000   ! first time step index
298      REAL(wp)        , INTENT(in   ), DIMENSION(jpk)               ::  p2dt     ! time-step
299      CHARACTER(len=3), INTENT(in   )                               ::  cdtype   ! =TRA or TRC (tracer indicator)
300      INTEGER         , INTENT(in   )                               ::  kjpt     ! number of tracers
301      REAL(wp)        , INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt)  ::  ptb      ! before tracer fields
302      REAL(wp)        , INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt)  ::  ptn      ! now tracer fields
303      REAL(wp)        , INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt)  ::  pta      ! tracer trend
304      REAL(wp)        , INTENT(in   ), DIMENSION(jpi,jpj,kjpt)      ::  psbc_tc   ! surface tracer content
305      REAL(wp)        , INTENT(in   ), DIMENSION(jpi,jpj,kjpt)      ::  psbc_tc_b ! before surface tracer content
306
307      !!     
308      LOGICAL  ::   ll_tra_hpg, ll_traqsr, ll_rnf, ll_isf   ! local logical
309      INTEGER  ::   ji, jj, jk, jn              ! dummy loop indices
310      REAL(wp) ::   zfact, zfact1, ztc_a , ztc_n , ztc_b , ztc_f , ztc_d    ! local scalar
311      REAL(wp) ::   zfact2, ze3t_b, ze3t_n, ze3t_a, ze3t_f, ze3t_d   !   -      -
312      REAL(wp), POINTER, DIMENSION(:,:,:,:) :: ztrd_atf
313      !!----------------------------------------------------------------------
314      !
315      IF( kt == kit000 )  THEN
316         IF(lwp) WRITE(numout,*)
317         IF(lwp) WRITE(numout,*) 'tra_nxt_vvl : time stepping', cdtype
318         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~'
319      ENDIF
320      !
321      IF( cdtype == 'TRA' )  THEN   
322         ll_tra_hpg = ln_dynhpg_imp    ! active  tracers case  and  semi-implicit hpg
323         ll_traqsr  = ln_traqsr        ! active  tracers case  and  solar penetration
324         ll_rnf     = ln_rnf           ! active  tracers case  and  river runoffs
325         IF (nn_isf .GE. 1) THEN
326            ll_isf = .TRUE.            ! active  tracers case  and  ice shelf melting/freezing
327         ELSE
328            ll_isf = .FALSE.
329         END IF
330      ELSE                         
331         ll_tra_hpg = .FALSE.          ! passive tracers case or NO semi-implicit hpg
332         ll_traqsr  = .FALSE.          ! active  tracers case and NO solar penetration
333         ll_rnf     = .FALSE.          ! passive tracers or NO river runoffs
334         ll_isf     = .FALSE.          ! passive tracers or NO ice shelf melting/freezing
335      ENDIF
336      !
337      IF( ( l_trdtra .and. cdtype == 'TRA' ) .OR. ( l_trdtrc .and. cdtype == 'TRC' ) )   THEN
338         CALL wrk_alloc( jpi, jpj, jpk, kjpt, ztrd_atf )
339         ztrd_atf(:,:,:,:) = 0.0_wp
340      ENDIF
341      DO jn = 1, kjpt     
342         DO jk = 1, jpkm1
343            zfact  = 0.5_wp / p2dt(jk)
344            zfact1 = atfp * p2dt(jk)
345            zfact2 = zfact1 / rau0
346            DO jj = 1, jpj
347               DO ji = 1, jpi
348                  ze3t_b = fse3t_b(ji,jj,jk)
349                  ze3t_n = fse3t_n(ji,jj,jk)
350                  ze3t_a = fse3t_a(ji,jj,jk)
351                  !                                         ! tracer content at Before, now and after
352                  ztc_b  = ptb(ji,jj,jk,jn) * ze3t_b
353                  ztc_n  = ptn(ji,jj,jk,jn) * ze3t_n
354                  ztc_a  = pta(ji,jj,jk,jn) * ze3t_a
355                  !
356                  ze3t_d = ze3t_a - 2. * ze3t_n + ze3t_b
357                  ztc_d  = ztc_a  - 2. * ztc_n  + ztc_b
358                  !
359                  ze3t_f = ze3t_n + atfp * ze3t_d
360                  ztc_f  = ztc_n  + atfp * ztc_d
361                  !
362                  IF( jk == mikt(ji,jj) ) THEN           ! first level
363                     ze3t_f = ze3t_f - zfact2 * ( (emp_b(ji,jj)    - emp(ji,jj)   )  &
364                            &                   - (rnf_b(ji,jj)    - rnf(ji,jj)   )  &
365                            &                   + (fwfisf_b(ji,jj) - fwfisf(ji,jj))  )
366                     ztc_f  = ztc_f  - zfact1 * ( psbc_tc(ji,jj,jn) - psbc_tc_b(ji,jj,jn) )
367                  ENDIF
368
369                  ! solar penetration (temperature only)
370                  IF( ll_traqsr .AND. jn == jp_tem .AND. jk <= nksr )                            & 
371                     &     ztc_f  = ztc_f  - zfact1 * ( qsr_hc(ji,jj,jk) - qsr_hc_b(ji,jj,jk) ) 
372
373                  ! river runoff
374                  IF( ll_rnf .AND. jk <= nk_rnf(ji,jj) )                                          &
375                     &     ztc_f  = ztc_f  - zfact1 * ( rnf_tsc(ji,jj,jn) - rnf_tsc_b(ji,jj,jn) ) & 
376                     &                              * fse3t_n(ji,jj,jk) / h_rnf(ji,jj)
377
378                  ! ice shelf
379                  IF( ll_isf ) THEN
380                     ! level fully include in the Losch_2008 ice shelf boundary layer
381                     IF ( jk >= misfkt(ji,jj) .AND. jk < misfkb(ji,jj) )                          &
382                        ztc_f  = ztc_f  - zfact1 * ( risf_tsc(ji,jj,jn) - risf_tsc_b(ji,jj,jn) )  &
383                               &                 * fse3t_n(ji,jj,jk) * r1_hisf_tbl (ji,jj)
384                     ! level partially include in Losch_2008 ice shelf boundary layer
385                     IF ( jk == misfkb(ji,jj) )                                                   &
386                        ztc_f  = ztc_f  - zfact1 * ( risf_tsc(ji,jj,jn) - risf_tsc_b(ji,jj,jn) )  &
387                               &                 * fse3t_n(ji,jj,jk) * r1_hisf_tbl (ji,jj) * ralpha(ji,jj)
388                  END IF
389
390                  ze3t_f = 1.e0 / ze3t_f
391                  ptb(ji,jj,jk,jn) = ztc_f * ze3t_f       ! ptb <-- ptn filtered
392                  ptn(ji,jj,jk,jn) = pta(ji,jj,jk,jn)     ! ptn <-- pta
393                  !
394                  IF( ll_tra_hpg ) THEN        ! semi-implicit hpg (T & S only)
395                     ze3t_d           = 1.e0   / ( ze3t_n + rbcp * ze3t_d )
396                     pta(ji,jj,jk,jn) = ze3t_d * ( ztc_n  + rbcp * ztc_d  )   ! ta <-- Brown & Campana average
397                  ENDIF
398                  IF( ( l_trdtra .and. cdtype == 'TRA' ) .OR. ( l_trdtrc .and. cdtype == 'TRC' ) ) THEN
399                     ztrd_atf(ji,jj,jk,jn) = (ztc_f - ztc_n) * zfact/ze3t_n
400                  ENDIF
401               END DO
402            END DO
403         END DO
404         !
405      END DO
406      !
407      IF( l_trdtra .and. cdtype == 'TRA' ) THEN
408         CALL trd_tra( kt, cdtype, jp_tem, jptra_atf, ztrd_atf(:,:,:,jp_tem) )
409         CALL trd_tra( kt, cdtype, jp_sal, jptra_atf, ztrd_atf(:,:,:,jp_sal) )
410         CALL wrk_dealloc( jpi, jpj, jpk, kjpt, ztrd_atf )
411      ENDIF
412      IF( l_trdtrc .and. cdtype == 'TRC' ) THEN
413         DO jn = 1, kjpt
414            CALL trd_tra( kt, cdtype, jn, jptra_atf, ztrd_atf(:,:,:,jn) )
415         END DO
416         CALL wrk_dealloc( jpi, jpj, jpk, kjpt, ztrd_atf )
417      ENDIF
418
419   END SUBROUTINE tra_nxt_vvl
420
421   !!======================================================================
422END MODULE tranxt
Note: See TracBrowser for help on using the repository browser.