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

source: branches/UKMO/r6232_tracer_advection/NEMOGCM/NEMO/OPA_SRC/TRA/tranxt.F90

Last change on this file was 9299, checked in by jcastill, 6 years ago

First implementation of tracers - it has not been properly tested yet
File size: 21.9 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         ztrdt(:,:,jpk) = 0._wp 
132         ztrds(:,:,jpk) = 0._wp
133         IF( ln_traldf_iso ) THEN              ! diagnose the "pure" Kz diffusive trend
134            CALL trd_tra( kt, 'TRA', jp_tem, jptra_zdfp, ztrdt )
135            CALL trd_tra( kt, 'TRA', jp_sal, jptra_zdfp, ztrds )
136         ENDIF
137         ! total trend for the non-time-filtered variables.
138         ! G Nurser 23 Mar 2017. Recalculate trend as Delta(e3t*T)/e3tn; e3tn cancel from tsn terms
139         IF( lk_vvl ) THEN
140            DO jk = 1, jpkm1 
141               zfact = 1.0 / rdttra(jk) 
142               ztrdt(:,:,jk) = ( tsa(:,:,jk,jp_tem)*fse3t_a(:,:,jk) / fse3t_n(:,:,jk) - tsn(:,:,jk,jp_tem)) * zfact 
143               ztrds(:,:,jk) = ( tsa(:,:,jk,jp_sal)*fse3t_a(:,:,jk) / fse3t_n(:,:,jk) - tsn(:,:,jk,jp_sal)) * zfact 
144            END DO
145         ELSE
146            DO jk = 1, jpkm1 
147               zfact = 1.0 / rdttra(jk) 
148               ztrdt(:,:,jk) = ( tsa(:,:,jk,jp_tem) - tsn(:,:,jk,jp_tem) ) * zfact 
149               ztrds(:,:,jk) = ( tsa(:,:,jk,jp_sal) - tsn(:,:,jk,jp_sal) ) * zfact 
150            END DO
151         END IF
152         CALL trd_tra( kt, 'TRA', jp_tem, jptra_atf, ztrdt )
153         CALL trd_tra( kt, 'TRA', jp_sal, jptra_atf, ztrds )
154         IF( .NOT.lk_vvl )  THEN
155            ! Store now fields before applying the Asselin filter
156            ! in order to calculate Asselin filter trend later.
157            ztrdt(:,:,:) = tsn(:,:,:,jp_tem) 
158            ztrds(:,:,:) = tsn(:,:,:,jp_sal)
159         END IF
160      END IF
161      !
162      IF( neuler == 0 .AND. kt == nit000 ) THEN       ! Euler time-stepping at first time-step (only swap)
163         DO jn = 1, jpts
164            DO jk = 1, jpkm1
165               tsn(:,:,jk,jn) = tsa(:,:,jk,jn)   
166            END DO
167         END DO
168         IF (l_trdtra.AND.lk_vvl) THEN      ! Zero Asselin filter contribution must be explicitly written out since for vvl
169                                            ! Asselin filter is output by tra_nxt_vvl that is not called on this time step
170            ztrdt(:,:,:) = 0._wp
171            ztrds(:,:,:) = 0._wp
172            CALL trd_tra( kt, 'TRA', jp_tem, jptra_atf, ztrdt )
173            CALL trd_tra( kt, 'TRA', jp_sal, jptra_atf, ztrds )
174         END IF
175      ELSE                                            ! Leap-Frog + Asselin filter time stepping
176         !
177         IF( lk_vvl )  THEN   ;   CALL tra_nxt_vvl( kt, nit000, rdttra, 'TRA', tsb, tsn, tsa,   &
178           &                                                              sbc_tsc, sbc_tsc_b, jpts )  ! variable volume level (vvl)
179         ELSE                 ;   CALL tra_nxt_fix( kt, nit000,         'TRA', tsb, tsn, tsa, jpts )  ! fixed    volume level
180         ENDIF
181      ENDIF     
182      !
183     ! trends computation
184      IF( l_trdtra.AND..NOT.lk_vvl) THEN      ! trend of the Asselin filter (tb filtered - tb)/dt     
185         DO jk = 1, jpkm1
186            zfact = 1._wp / r2dtra(jk)             
187            ztrdt(:,:,jk) = ( tsb(:,:,jk,jp_tem) - ztrdt(:,:,jk) ) * zfact
188            ztrds(:,:,jk) = ( tsb(:,:,jk,jp_sal) - ztrds(:,:,jk) ) * zfact
189         END DO
190         CALL trd_tra( kt, 'TRA', jp_tem, jptra_atf, ztrdt )
191         CALL trd_tra( kt, 'TRA', jp_sal, jptra_atf, ztrds )
192      END IF
193      IF( l_trdtra) CALL wrk_dealloc( jpi, jpj, jpk, ztrdt, ztrds )
194      !                        ! control print
195      IF(ln_ctl)   CALL prt_ctl( tab3d_1=tsn(:,:,:,jp_tem), clinfo1=' nxt  - Tn: ', mask1=tmask,   &
196         &                       tab3d_2=tsn(:,:,:,jp_sal), clinfo2=       ' Sn: ', mask2=tmask )
197      !
198      IF( nn_timing == 1 )   CALL timing_stop('tra_nxt')
199      !
200   END SUBROUTINE tra_nxt
201
202
203   SUBROUTINE tra_nxt_fix( kt, kit000, cdtype, ptb, ptn, pta, kjpt )
204      !!----------------------------------------------------------------------
205      !!                   ***  ROUTINE tra_nxt_fix  ***
206      !!
207      !! ** Purpose :   fixed volume: apply the Asselin time filter and
208      !!                swap the tracer fields.
209      !!
210      !! ** Method  : - Apply a Asselin time filter on now fields.
211      !!              - save in (ta,sa) an average over the three time levels
212      !!             which will be used to compute rdn and thus the semi-implicit
213      !!             hydrostatic pressure gradient (ln_dynhpg_imp = T)
214      !!              - swap tracer fields to prepare the next time_step.
215      !!                This can be summurized for tempearture as:
216      !!             ztm = tn + rbcp * [ta -2 tn + tb ]       ln_dynhpg_imp = T
217      !!             ztm = 0                                   otherwise
218      !!                   with rbcp=1/4 * (1-atfp^4) / (1-atfp)
219      !!             tb  = tn + atfp*[ tb - 2 tn + ta ]
220      !!             tn  = ta 
221      !!             ta  = ztm       (NB: reset to 0 after eos_bn2 call)
222      !!
223      !! ** Action  : - (tb,sb) and (tn,sn) ready for the next time step
224      !!              - (ta,sa) time averaged (t,s)   (ln_dynhpg_imp = T)
225      !!----------------------------------------------------------------------
226      INTEGER         , INTENT(in   )                               ::   kt       ! ocean time-step index
227      INTEGER         , INTENT(in   )                               ::   kit000   ! first time step index
228      CHARACTER(len=3), INTENT(in   )                               ::   cdtype   ! =TRA or TRC (tracer indicator)
229      INTEGER         , INTENT(in   )                               ::   kjpt     ! number of tracers
230      REAL(wp)        , INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt)  ::   ptb      ! before tracer fields
231      REAL(wp)        , INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt)  ::   ptn      ! now tracer fields
232      REAL(wp)        , INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt)  ::   pta      ! tracer trend
233      !
234      INTEGER  ::   ji, jj, jk, jn   ! dummy loop indices
235      LOGICAL  ::   ll_tra_hpg       ! local logical
236      REAL(wp) ::   ztn, ztd         ! local scalars
237      !!----------------------------------------------------------------------
238
239      IF( kt == kit000 )  THEN
240         IF(lwp) WRITE(numout,*)
241         IF(lwp) WRITE(numout,*) 'tra_nxt_fix : time stepping', cdtype
242         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~'
243      ENDIF
244      !
245      IF( cdtype == 'TRA' )  THEN   ;   ll_tra_hpg = ln_dynhpg_imp    ! active  tracers case  and  semi-implicit hpg   
246      ELSE                          ;   ll_tra_hpg = .FALSE.          ! passive tracers case or NO semi-implicit hpg
247      ENDIF
248      !
249      DO jn = 1, kjpt
250         !
251         DO jk = 1, jpkm1
252            DO jj = 1, jpj
253               DO ji = 1, jpi
254                  ztn = ptn(ji,jj,jk,jn)                                   
255                  ztd = pta(ji,jj,jk,jn) - 2. * ztn + ptb(ji,jj,jk,jn)      !  time laplacian on tracers
256                  !
257                  ptb(ji,jj,jk,jn) = ztn + atfp * ztd                       ! ptb <-- filtered ptn
258                  ptn(ji,jj,jk,jn) = pta(ji,jj,jk,jn)                       ! ptn <-- pta
259                  !
260                  IF( ll_tra_hpg )   pta(ji,jj,jk,jn) = ztn + rbcp * ztd    ! pta <-- Brown & Campana average
261               END DO
262           END DO
263         END DO
264         !
265      END DO
266      !
267   END SUBROUTINE tra_nxt_fix
268
269
270   SUBROUTINE tra_nxt_vvl( kt, kit000, p2dt, cdtype, ptb, ptn, pta, psbc_tc, psbc_tc_b, kjpt )
271      !!----------------------------------------------------------------------
272      !!                   ***  ROUTINE tra_nxt_vvl  ***
273      !!
274      !! ** Purpose :   Time varying volume: apply the Asselin time filter 
275      !!                and swap the tracer fields.
276      !!
277      !! ** Method  : - Apply a thickness weighted Asselin time filter on now fields.
278      !!              - save in (ta,sa) a thickness weighted average over the three
279      !!             time levels which will be used to compute rdn and thus the semi-
280      !!             implicit hydrostatic pressure gradient (ln_dynhpg_imp = T)
281      !!              - swap tracer fields to prepare the next time_step.
282      !!                This can be summurized for tempearture as:
283      !!             ztm = ( e3t_n*tn + rbcp*[ e3t_b*tb - 2 e3t_n*tn + e3t_a*ta ] )   ln_dynhpg_imp = T
284      !!                  /( e3t_n    + rbcp*[ e3t_b    - 2 e3t_n    + e3t_a    ] )   
285      !!             ztm = 0                                                       otherwise
286      !!             tb  = ( e3t_n*tn + atfp*[ e3t_b*tb - 2 e3t_n*tn + e3t_a*ta ] )
287      !!                  /( e3t_n    + atfp*[ e3t_b    - 2 e3t_n    + e3t_a    ] )
288      !!             tn  = ta
289      !!             ta  = zt        (NB: reset to 0 after eos_bn2 call)
290      !!
291      !! ** Action  : - (tb,sb) and (tn,sn) ready for the next time step
292      !!              - (ta,sa) time averaged (t,s)   (ln_dynhpg_imp = T)
293      !!----------------------------------------------------------------------
294      INTEGER         , INTENT(in   )                               ::  kt       ! ocean time-step index
295      INTEGER         , INTENT(in   )                               ::  kit000   ! first time step index
296      REAL(wp)        , INTENT(in   ), DIMENSION(jpk)               ::  p2dt     ! time-step
297      CHARACTER(len=3), INTENT(in   )                               ::  cdtype   ! =TRA or TRC (tracer indicator)
298      INTEGER         , INTENT(in   )                               ::  kjpt     ! number of tracers
299      REAL(wp)        , INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt)  ::  ptb      ! before tracer fields
300      REAL(wp)        , INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt)  ::  ptn      ! now tracer fields
301      REAL(wp)        , INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt)  ::  pta      ! tracer trend
302      REAL(wp)        , INTENT(in   ), DIMENSION(jpi,jpj,kjpt)      ::  psbc_tc   ! surface tracer content
303      REAL(wp)        , INTENT(in   ), DIMENSION(jpi,jpj,kjpt)      ::  psbc_tc_b ! before surface tracer content
304
305      !!     
306      LOGICAL  ::   ll_tra_hpg, ll_traqsr, ll_rnf, ll_isf   ! local logical
307      INTEGER  ::   ji, jj, jk, jn              ! dummy loop indices
308      REAL(wp) ::   zfact, zfact1, ztc_a , ztc_n , ztc_b , ztc_f , ztc_d    ! local scalar
309      REAL(wp) ::   zfact2, ze3t_b, ze3t_n, ze3t_a, ze3t_f, ze3t_d   !   -      -
310      REAL(wp), POINTER, DIMENSION(:,:,:,:) :: ztrd_atf
311      !!----------------------------------------------------------------------
312      !
313      IF( kt == kit000 )  THEN
314         IF(lwp) WRITE(numout,*)
315         IF(lwp) WRITE(numout,*) 'tra_nxt_vvl : time stepping', cdtype
316         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~'
317      ENDIF
318      !
319      IF( cdtype == 'TRA' )  THEN   
320         ll_tra_hpg = ln_dynhpg_imp    ! active  tracers case  and  semi-implicit hpg
321         ll_traqsr  = ln_traqsr        ! active  tracers case  and  solar penetration
322         ll_rnf     = ln_rnf           ! active  tracers case  and  river runoffs
323         IF (nn_isf .GE. 1) THEN
324            ll_isf = .TRUE.            ! active  tracers case  and  ice shelf melting/freezing
325         ELSE
326            ll_isf = .FALSE.
327         END IF
328      ELSE                         
329         ll_tra_hpg = .FALSE.          ! passive tracers case or NO semi-implicit hpg
330         ll_traqsr  = .FALSE.          ! active  tracers case and NO solar penetration
331         ll_rnf     = .FALSE.          ! passive tracers or NO river runoffs
332         ll_isf     = .FALSE.          ! passive tracers or NO ice shelf melting/freezing
333      ENDIF
334      !
335      IF( ( l_trdtra .AND. cdtype == 'TRA' ) .OR. ( l_trdtrc .AND. cdtype == 'TRC' ) )   THEN
336         CALL wrk_alloc( jpi, jpj, jpk, kjpt, ztrd_atf ) 
337         ztrd_atf(:,:,:,:) = 0.0_wp 
338      ENDIF
339      DO jn = 1, kjpt     
340         DO jk = 1, jpkm1
341            zfact = 1._wp / p2dt(jk)
342            zfact1 = atfp * p2dt(jk)
343            zfact2 = zfact1 / rau0
344            DO jj = 1, jpj
345               DO ji = 1, jpi
346                  ze3t_b = fse3t_b(ji,jj,jk)
347                  ze3t_n = fse3t_n(ji,jj,jk)
348                  ze3t_a = fse3t_a(ji,jj,jk)
349                  !                                         ! tracer content at Before, now and after
350                  ztc_b  = ptb(ji,jj,jk,jn) * ze3t_b
351                  ztc_n  = ptn(ji,jj,jk,jn) * ze3t_n
352                  ztc_a  = pta(ji,jj,jk,jn) * ze3t_a
353                  !
354                  ze3t_d = ze3t_a - 2. * ze3t_n + ze3t_b
355                  ztc_d  = ztc_a  - 2. * ztc_n  + ztc_b
356                  !
357                  ze3t_f = ze3t_n + atfp * ze3t_d
358                  ztc_f  = ztc_n  + atfp * ztc_d
359                  !
360                  IF( jk == mikt(ji,jj) ) THEN           ! first level
361                     ze3t_f = ze3t_f - zfact2 * ( (emp_b(ji,jj)    - emp(ji,jj)   )  &
362                            &                   - (rnf_b(ji,jj)    - rnf(ji,jj)   )  &
363                            &                   + (fwfisf_b(ji,jj) - fwfisf(ji,jj))  )
364                     ztc_f  = ztc_f  - zfact1 * ( psbc_tc(ji,jj,jn) - psbc_tc_b(ji,jj,jn) )
365                  ENDIF
366
367                  ! solar penetration (temperature only)
368                  IF( ll_traqsr .AND. jn == jp_tem .AND. jk <= nksr )                            & 
369                     &     ztc_f  = ztc_f  - zfact1 * ( qsr_hc(ji,jj,jk) - qsr_hc_b(ji,jj,jk) ) 
370
371                  ! river runoff
372                  IF( ll_rnf .AND. jk <= nk_rnf(ji,jj) )                                          &
373                     &     ztc_f  = ztc_f  - zfact1 * ( rnf_tsc(ji,jj,jn) - rnf_tsc_b(ji,jj,jn) ) & 
374                     &                              * fse3t_n(ji,jj,jk) / h_rnf(ji,jj)
375
376                  ! ice shelf
377                  IF( ll_isf ) THEN
378                     ! level fully include in the Losch_2008 ice shelf boundary layer
379                     IF ( jk >= misfkt(ji,jj) .AND. jk < misfkb(ji,jj) )                          &
380                        ztc_f  = ztc_f  - zfact1 * ( risf_tsc(ji,jj,jn) - risf_tsc_b(ji,jj,jn) )  &
381                               &                 * fse3t_n(ji,jj,jk) * r1_hisf_tbl (ji,jj)
382                     ! level partially include in Losch_2008 ice shelf boundary layer
383                     IF ( jk == misfkb(ji,jj) )                                                   &
384                        ztc_f  = ztc_f  - zfact1 * ( risf_tsc(ji,jj,jn) - risf_tsc_b(ji,jj,jn) )  &
385                               &                 * fse3t_n(ji,jj,jk) * r1_hisf_tbl (ji,jj) * ralpha(ji,jj)
386                  END IF
387
388                  ze3t_f = 1.e0 / ze3t_f
389                  ptb(ji,jj,jk,jn) = ztc_f * ze3t_f       ! ptb <-- ptn filtered
390                  ptn(ji,jj,jk,jn) = pta(ji,jj,jk,jn)     ! ptn <-- pta
391                  !
392                  IF( ll_tra_hpg ) THEN        ! semi-implicit hpg (T & S only)
393                     ze3t_d           = 1.e0   / ( ze3t_n + rbcp * ze3t_d )
394                     pta(ji,jj,jk,jn) = ze3t_d * ( ztc_n  + rbcp * ztc_d  )   ! ta <-- Brown & Campana average
395                  ENDIF
396                  IF( ( l_trdtra .AND. cdtype == 'TRA' ) .OR. ( l_trdtrc .AND. cdtype == 'TRC' ) ) THEN
397                     ztrd_atf(ji,jj,jk,jn) = (ztc_f - ztc_n) * zfact/ze3t_n 
398                  ENDIF
399               END DO
400            END DO
401         END DO
402         !
403      END DO
404      !
405      IF( l_trdtra .AND. cdtype == 'TRA' ) THEN 
406         CALL trd_tra( kt, cdtype, jp_tem, jptra_atf, ztrd_atf(:,:,:,jp_tem) ) 
407         CALL trd_tra( kt, cdtype, jp_sal, jptra_atf, ztrd_atf(:,:,:,jp_sal) ) 
408         CALL wrk_dealloc( jpi, jpj, jpk, kjpt, ztrd_atf ) 
409      ENDIF
410      IF( l_trdtrc .AND. cdtype == 'TRC' ) THEN
411         DO jn = 1, kjpt 
412            CALL trd_tra( kt, cdtype, jn, jptra_atf, ztrd_atf(:,:,:,jn) ) 
413         END DO
414         CALL wrk_dealloc( jpi, jpj, jpk, kjpt, ztrd_atf ) 
415      ENDIF
416
417   END SUBROUTINE tra_nxt_vvl
418
419   !!======================================================================
420END MODULE tranxt
Note: See TracBrowser for help on using the repository browser.