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

source: branches/NERC/dev_r5518_GO6_package_trdtrc/NEMOGCM/NEMO/OPA_SRC/TRA/tranxt.F90 @ 8535

Last change on this file since 8535 was 8535, checked in by jpalmier, 7 years ago

JPALM -- trdtrc -- found ATF trend bug relative to TRC case
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 = 1._wp / r2dtra(jk)
344            zfact = 0.5_wp *p2dt(jk)
345            zfact1 = atfp * p2dt(jk)
346            zfact2 = zfact1 / rau0
347            DO jj = 1, jpj
348               DO ji = 1, jpi
349                  ze3t_b = fse3t_b(ji,jj,jk)
350                  ze3t_n = fse3t_n(ji,jj,jk)
351                  ze3t_a = fse3t_a(ji,jj,jk)
352                  !                                         ! tracer content at Before, now and after
353                  ztc_b  = ptb(ji,jj,jk,jn) * ze3t_b
354                  ztc_n  = ptn(ji,jj,jk,jn) * ze3t_n
355                  ztc_a  = pta(ji,jj,jk,jn) * ze3t_a
356                  !
357                  ze3t_d = ze3t_a - 2. * ze3t_n + ze3t_b
358                  ztc_d  = ztc_a  - 2. * ztc_n  + ztc_b
359                  !
360                  ze3t_f = ze3t_n + atfp * ze3t_d
361                  ztc_f  = ztc_n  + atfp * ztc_d
362                  !
363                  IF( jk == mikt(ji,jj) ) THEN           ! first level
364                     ze3t_f = ze3t_f - zfact2 * ( (emp_b(ji,jj)    - emp(ji,jj)   )  &
365                            &                   - (rnf_b(ji,jj)    - rnf(ji,jj)   )  &
366                            &                   + (fwfisf_b(ji,jj) - fwfisf(ji,jj))  )
367                     ztc_f  = ztc_f  - zfact1 * ( psbc_tc(ji,jj,jn) - psbc_tc_b(ji,jj,jn) )
368                  ENDIF
369
370                  ! solar penetration (temperature only)
371                  IF( ll_traqsr .AND. jn == jp_tem .AND. jk <= nksr )                            & 
372                     &     ztc_f  = ztc_f  - zfact1 * ( qsr_hc(ji,jj,jk) - qsr_hc_b(ji,jj,jk) ) 
373
374                  ! river runoff
375                  IF( ll_rnf .AND. jk <= nk_rnf(ji,jj) )                                          &
376                     &     ztc_f  = ztc_f  - zfact1 * ( rnf_tsc(ji,jj,jn) - rnf_tsc_b(ji,jj,jn) ) & 
377                     &                              * fse3t_n(ji,jj,jk) / h_rnf(ji,jj)
378
379                  ! ice shelf
380                  IF( ll_isf ) THEN
381                     ! level fully include in the Losch_2008 ice shelf boundary layer
382                     IF ( jk >= misfkt(ji,jj) .AND. jk < misfkb(ji,jj) )                          &
383                        ztc_f  = ztc_f  - zfact1 * ( risf_tsc(ji,jj,jn) - risf_tsc_b(ji,jj,jn) )  &
384                               &                 * fse3t_n(ji,jj,jk) * r1_hisf_tbl (ji,jj)
385                     ! level partially include in Losch_2008 ice shelf boundary layer
386                     IF ( jk == misfkb(ji,jj) )                                                   &
387                        ztc_f  = ztc_f  - zfact1 * ( risf_tsc(ji,jj,jn) - risf_tsc_b(ji,jj,jn) )  &
388                               &                 * fse3t_n(ji,jj,jk) * r1_hisf_tbl (ji,jj) * ralpha(ji,jj)
389                  END IF
390
391                  ze3t_f = 1.e0 / ze3t_f
392                  ptb(ji,jj,jk,jn) = ztc_f * ze3t_f       ! ptb <-- ptn filtered
393                  ptn(ji,jj,jk,jn) = pta(ji,jj,jk,jn)     ! ptn <-- pta
394                  !
395                  IF( ll_tra_hpg ) THEN        ! semi-implicit hpg (T & S only)
396                     ze3t_d           = 1.e0   / ( ze3t_n + rbcp * ze3t_d )
397                     pta(ji,jj,jk,jn) = ze3t_d * ( ztc_n  + rbcp * ztc_d  )   ! ta <-- Brown & Campana average
398                  ENDIF
399                  IF( ( l_trdtra .and. cdtype == 'TRA' ) .OR. ( l_trdtrc .and. cdtype == 'TRC' ) ) THEN
400                     ztrd_atf(ji,jj,jk,jn) = (ztc_f - ztc_n) * zfact/ze3t_n
401                  ENDIF
402               END DO
403            END DO
404         END DO
405         !
406      END DO
407      !
408      IF( l_trdtra .and. cdtype == 'TRA' ) THEN
409         CALL trd_tra( kt, cdtype, jp_tem, jptra_atf, ztrd_atf(:,:,:,jp_tem) )
410         CALL trd_tra( kt, cdtype, jp_sal, jptra_atf, ztrd_atf(:,:,:,jp_sal) )
411         CALL wrk_dealloc( jpi, jpj, jpk, kjpt, ztrd_atf )
412      ENDIF
413      IF( l_trdtrc .and. cdtype == 'TRC' ) THEN
414         DO jn = 1, kjpt
415            CALL trd_tra( kt, cdtype, jn, jptra_atf, ztrd_atf(:,:,:,jn) )
416         END DO
417         CALL wrk_dealloc( jpi, jpj, jpk, kjpt, ztrd_atf )
418      ENDIF
419
420   END SUBROUTINE tra_nxt_vvl
421
422   !!======================================================================
423END MODULE tranxt
Note: See TracBrowser for help on using the repository browser.