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 @ 9163

Last change on this file since 9163 was 9163, checked in by frrh, 6 years ago

Add code from Julien Palmieri's Met Office GMED ticket 338.
This incorporates code from branches/NERC/dev_r5518_GO6_package_trdtrc
revisions 8454:9020 inclusive.

File size: 21.8 KB
RevLine 
[3]1MODULE tranxt
2   !!======================================================================
3   !!                       ***  MODULE  tranxt  ***
4   !! Ocean active tracers:  time stepping on temperature and salinity
5   !!======================================================================
[1110]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
[1438]16   !!            3.1  !  2009-02  (G. Madec, R. Benshila)  re-introduce the vvl option
[2528]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
[3]19   !!----------------------------------------------------------------------
[503]20
21   !!----------------------------------------------------------------------
[2528]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
[3]25   !!----------------------------------------------------------------------
26   USE oce             ! ocean dynamics and tracers variables
27   USE dom_oce         ! ocean space and time domain variables
[2528]28   USE sbc_oce         ! surface boundary condition: ocean
[5467]29   USE sbcrnf          ! river runoffs
[6487]30   USE sbcisf          ! ice shelf melting/freezing
[4990]31   USE zdf_oce         ! ocean vertical mixing
[1438]32   USE domvvl          ! variable volume
[1601]33   USE dynspg_oce      ! surface     pressure gradient variables
34   USE dynhpg          ! hydrostatic pressure gradient
[4990]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
[3294]41   USE bdytra          ! open boundary condition (bdy_tra routine)
[4990]42   !
[3]43   USE in_out_manager  ! I/O manager
44   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
[258]45   USE prtctl          ! Print control
[4990]46   USE wrk_nemo        ! Memory allocation
47   USE timing          ! Timing
[2528]48#if defined key_agrif
[389]49   USE agrif_opa_interp
[2528]50#endif
[3]51
[9163]52
[3]53   IMPLICIT NONE
54   PRIVATE
55
[2528]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
[592]59
[2715]60   REAL(wp) ::   rbcp   ! Brown & Campana parameters for semi-implicit hpg
[1438]61
[592]62   !! * Substitutions
63#  include "domzgr_substitute.h90"
[3]64   !!----------------------------------------------------------------------
[2528]65   !! NEMO/OPA 3.3 , NEMO-Consortium (2010)
[2715]66   !! $Id$
67   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
[3]68   !!----------------------------------------------------------------------
69CONTAINS
70
71   SUBROUTINE tra_nxt( kt )
72      !!----------------------------------------------------------------------
73      !!                   ***  ROUTINE tranxt  ***
74      !!
[1110]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.
[3]78      !!
[1110]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.
[3]82      !!
[1110]83      !!              - Apply lateral boundary conditions on (ta,sa)
84      !!             at the local domain   boundaries through lbc_lnk call,
[4328]85      !!             at the one-way open boundaries (lk_bdy=T),
[4990]86      !!             at the AGRIF zoom   boundaries (lk_agrif=T)
[1110]87      !!
[1438]88      !!              - Update lateral boundary conditions on AGRIF children
89      !!             domains (lk_agrif=T)
[1110]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)
[503]93      !!----------------------------------------------------------------------
94      INTEGER, INTENT(in) ::   kt    ! ocean time-step index
95      !!
[2528]96      INTEGER  ::   jk, jn    ! dummy loop indices
97      REAL(wp) ::   zfact     ! local scalars
[3294]98      REAL(wp), POINTER, DIMENSION(:,:,:) ::  ztrdt, ztrds
[3]99      !!----------------------------------------------------------------------
[3294]100      !
101      IF( nn_timing == 1 )  CALL timing_start( 'tra_nxt')
102      !
[1110]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,*) '~~~~~~~'
[2528]107         !
[4230]108         rbcp = 0.25_wp * (1._wp + atfp) * (1._wp + atfp) * ( 1._wp - atfp)      ! Brown & Campana parameter for semi-implicit hpg
[592]109      ENDIF
110
[1110]111      ! Update after tracer on domain lateral boundaries
112      !
[6487]113#if defined key_agrif
114      CALL Agrif_tra                     ! AGRIF zoom boundaries
115#endif
116      !
[4230]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 )
[1110]119      !
[2528]120#if defined key_bdy 
[3294]121      IF( lk_bdy )   CALL bdy_tra( kt )  ! BDY open boundaries
[1110]122#endif
[1438]123 
124      ! set time step size (Euler/Leapfrog)
[2715]125      IF( neuler == 0 .AND. kt == nit000 ) THEN   ;   r2dtra(:) =     rdttra(:)      ! at nit000             (Euler)
[4230]126      ELSEIF( kt <= nit000 + 1 )           THEN   ;   r2dtra(:) = 2._wp* rdttra(:)      ! at nit000 or nit000+1 (Leapfrog)
[1438]127      ENDIF
[3]128
[1110]129      ! trends computation initialisation
[7554]130      IF( l_trdtra )   THEN                   
[3294]131         CALL wrk_alloc( jpi, jpj, jpk, ztrdt, ztrds )
[7573]132         ztrdt(:,:,jpk) = 0._wp
133         ztrds(:,:,jpk) = 0._wp
[4990]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
[8104]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
[7061]153         CALL trd_tra( kt, 'TRA', jp_tem, jptra_tot, ztrdt )
154         CALL trd_tra( kt, 'TRA', jp_sal, jptra_tot, ztrds )
[8104]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
[1110]161      ENDIF
162
[2528]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
[8104]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
[2528]176      ELSE                                            ! Leap-Frog + Asselin filter time stepping
177         !
[5385]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
[2528]181         ENDIF
[6487]182      ENDIF     
[2715]183      !
[6487]184     ! trends computation
[8104]185      IF( l_trdtra.AND..NOT.lk_vvl) THEN      ! trend of the Asselin filter (tb filtered - tb)/dt     
[1110]186         DO jk = 1, jpkm1
[4990]187            zfact = 1._wp / r2dtra(jk)             
[2528]188            ztrdt(:,:,jk) = ( tsb(:,:,jk,jp_tem) - ztrdt(:,:,jk) ) * zfact
189            ztrds(:,:,jk) = ( tsb(:,:,jk,jp_sal) - ztrds(:,:,jk) ) * zfact
[1110]190         END DO
[4990]191         CALL trd_tra( kt, 'TRA', jp_tem, jptra_atf, ztrdt )
192         CALL trd_tra( kt, 'TRA', jp_sal, jptra_atf, ztrds )
[1438]193      END IF
[8104]194      IF( l_trdtra) CALL wrk_dealloc( jpi, jpj, jpk, ztrdt, ztrds )
[2715]195      !
[1438]196      !                        ! control print
[2528]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 )
[1438]199      !
[4990]200      IF( nn_timing == 1 )   CALL timing_stop('tra_nxt')
[3294]201      !
[1438]202   END SUBROUTINE tra_nxt
203
204
[3294]205   SUBROUTINE tra_nxt_fix( kt, kit000, cdtype, ptb, ptn, pta, kjpt )
[1438]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:
[2528]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)
[1438]221      !!             tb  = tn + atfp*[ tb - 2 tn + ta ]
[2528]222      !!             tn  = ta 
[1438]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      !!----------------------------------------------------------------------
[2715]228      INTEGER         , INTENT(in   )                               ::   kt       ! ocean time-step index
[3294]229      INTEGER         , INTENT(in   )                               ::   kit000   ! first time step index
[2715]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      !
[2528]236      INTEGER  ::   ji, jj, jk, jn   ! dummy loop indices
237      LOGICAL  ::   ll_tra_hpg       ! local logical
238      REAL(wp) ::   ztn, ztd         ! local scalars
[1438]239      !!----------------------------------------------------------------------
240
[3294]241      IF( kt == kit000 )  THEN
[1438]242         IF(lwp) WRITE(numout,*)
[3294]243         IF(lwp) WRITE(numout,*) 'tra_nxt_fix : time stepping', cdtype
[1438]244         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~'
245      ENDIF
246      !
[2528]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
[1438]252         !
[2528]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
[3]263               END DO
[2528]264           END DO
265         END DO
[1110]266         !
[2528]267      END DO
[1438]268      !
269   END SUBROUTINE tra_nxt_fix
[3]270
[1110]271
[5385]272   SUBROUTINE tra_nxt_vvl( kt, kit000, p2dt, cdtype, ptb, ptn, pta, psbc_tc, psbc_tc_b, kjpt )
[1438]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:
[2528]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
[1438]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      !!----------------------------------------------------------------------
[5385]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
[1438]307      !!     
[6487]308      LOGICAL  ::   ll_tra_hpg, ll_traqsr, ll_rnf, ll_isf   ! local logical
[2528]309      INTEGER  ::   ji, jj, jk, jn              ! dummy loop indices
[8104]310      REAL(wp) ::   zfact, zfact1, ztc_a , ztc_n , ztc_b , ztc_f , ztc_d    ! local scalar
[2715]311      REAL(wp) ::   zfact2, ze3t_b, ze3t_n, ze3t_a, ze3t_f, ze3t_d   !   -      -
[8104]312      REAL(wp), POINTER, DIMENSION(:,:,:,:) :: ztrd_atf
[1438]313      !!----------------------------------------------------------------------
[3294]314      !
315      IF( kt == kit000 )  THEN
[1438]316         IF(lwp) WRITE(numout,*)
[3294]317         IF(lwp) WRITE(numout,*) 'tra_nxt_vvl : time stepping', cdtype
[1438]318         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~'
319      ENDIF
[2528]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
[5467]324         ll_rnf     = ln_rnf           ! active  tracers case  and  river runoffs
[6487]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
[2528]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
[5467]333         ll_rnf     = .FALSE.          ! passive tracers or NO river runoffs
[6487]334         ll_isf     = .FALSE.          ! passive tracers or NO ice shelf melting/freezing
[2528]335      ENDIF
336      !
[8333]337      IF( ( l_trdtra .and. cdtype == 'TRA' ) .OR. ( l_trdtrc .and. cdtype == 'TRC' ) )   THEN
[8104]338         CALL wrk_alloc( jpi, jpj, jpk, kjpt, ztrd_atf )
339         ztrd_atf(:,:,:,:) = 0.0_wp
340      ENDIF
[2528]341      DO jn = 1, kjpt     
342         DO jk = 1, jpkm1
[9163]343            zfact  = 0.5_wp / p2dt(jk)
[5385]344            zfact1 = atfp * p2dt(jk)
[2528]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                  !
[6487]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))  )
[5385]366                     ztc_f  = ztc_f  - zfact1 * ( psbc_tc(ji,jj,jn) - psbc_tc_b(ji,jj,jn) )
[2528]367                  ENDIF
[5467]368
[6487]369                  ! solar penetration (temperature only)
370                  IF( ll_traqsr .AND. jn == jp_tem .AND. jk <= nksr )                            & 
[2528]371                     &     ztc_f  = ztc_f  - zfact1 * ( qsr_hc(ji,jj,jk) - qsr_hc_b(ji,jj,jk) ) 
[1438]372
[6487]373                  ! river runoff
374                  IF( ll_rnf .AND. jk <= nk_rnf(ji,jj) )                                          &
[5467]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
[6487]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
[5467]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
[8333]398                  IF( ( l_trdtra .and. cdtype == 'TRA' ) .OR. ( l_trdtrc .and. cdtype == 'TRC' ) ) THEN
[8104]399                     ztrd_atf(ji,jj,jk,jn) = (ztc_f - ztc_n) * zfact/ze3t_n
400                  ENDIF
[1438]401               END DO
402            END DO
[2528]403         END DO
404         !
405      END DO
[503]406      !
[8333]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) )
[8104]410         CALL wrk_dealloc( jpi, jpj, jpk, kjpt, ztrd_atf )
411      ENDIF
[8333]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
[8104]418
[1438]419   END SUBROUTINE tra_nxt_vvl
[3]420
421   !!======================================================================
422END MODULE tranxt
Note: See TracBrowser for help on using the repository browser.