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 NEMO/branches/2019/ENHANCE-02_ISF_nemo/src/OCE/TRA – NEMO

source: NEMO/branches/2019/ENHANCE-02_ISF_nemo/src/OCE/TRA/tranxt.F90 @ 11931

Last change on this file since 11931 was 11931, checked in by mathiot, 4 years ago

ENHANCE-02_ISF_nemo: add comments, improve memory usage of ln_isfcpl_cons option, fix issue in ISOMIP+ configuration
  • Property svn:keywords set to Id
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 isf             ! ice shelf melting
31   USE zdf_oce         ! ocean vertical mixing
32   USE domvvl          ! variable volume
33   USE trd_oce         ! trends: ocean variables
34   USE trdtra          ! trends manager: tracers
35   USE traqsr          ! penetrative solar radiation (needed for nksr)
36   USE phycst          ! physical constant
37   USE ldftra          ! lateral physics : tracers
38   USE ldfslp          ! lateral physics : slopes
39   USE bdy_oce  , ONLY : ln_bdy
40   USE bdytra          ! open boundary condition (bdy_tra routine)
41   !
42   USE in_out_manager  ! I/O manager
43   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
44   USE prtctl          ! Print control
45   USE timing          ! Timing
46#if defined key_agrif
47   USE agrif_oce_interp
48#endif
49
50   IMPLICIT NONE
51   PRIVATE
52
53   PUBLIC   tra_nxt       ! routine called by step.F90
54   PUBLIC   tra_nxt_fix   ! to be used in trcnxt
55   PUBLIC   tra_nxt_vvl   ! to be used in trcnxt
56
57   !! * Substitutions
58#  include "vectopt_loop_substitute.h90"
59   !!----------------------------------------------------------------------
60   !! NEMO/OCE 4.0 , NEMO Consortium (2018)
61   !! $Id$
62   !! Software governed by the CeCILL license (see ./LICENSE)
63   !!----------------------------------------------------------------------
64CONTAINS
65
66   SUBROUTINE tra_nxt( kt )
67      !!----------------------------------------------------------------------
68      !!                   ***  ROUTINE tranxt  ***
69      !!
70      !! ** Purpose :   Apply the boundary condition on the after temperature 
71      !!             and salinity fields, achieved the time stepping by adding
72      !!             the Asselin filter on now fields and swapping the fields.
73      !!
74      !! ** Method  :   At this stage of the computation, ta and sa are the
75      !!             after temperature and salinity as the time stepping has
76      !!             been performed in trazdf_imp or trazdf_exp module.
77      !!
78      !!              - Apply lateral boundary conditions on (ta,sa)
79      !!             at the local domain   boundaries through lbc_lnk call,
80      !!             at the one-way open boundaries (ln_bdy=T),
81      !!             at the AGRIF zoom   boundaries (lk_agrif=T)
82      !!
83      !!              - Update lateral boundary conditions on AGRIF children
84      !!             domains (lk_agrif=T)
85      !!
86      !! ** Action  : - tsb & tsn ready for the next time step
87      !!----------------------------------------------------------------------
88      INTEGER, INTENT(in) ::   kt    ! ocean time-step index
89      !!
90      INTEGER  ::   ji, jj, jk, jn   ! dummy loop indices
91      REAL(wp) ::   zfact            ! local scalars
92      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::   ztrdt, ztrds
93      !!----------------------------------------------------------------------
94      !
95      IF( ln_timing )   CALL timing_start( 'tra_nxt')
96      !
97      IF( kt == nit000 ) THEN
98         IF(lwp) WRITE(numout,*)
99         IF(lwp) WRITE(numout,*) 'tra_nxt : achieve the time stepping by Asselin filter and array swap'
100         IF(lwp) WRITE(numout,*) '~~~~~~~'
101      ENDIF
102
103      ! Update after tracer on domain lateral boundaries
104      !
105#if defined key_agrif
106      CALL Agrif_tra                     ! AGRIF zoom boundaries
107#endif
108      !                                              ! local domain boundaries  (T-point, unchanged sign)
109      CALL lbc_lnk_multi( 'tranxt', tsa(:,:,:,jp_tem), 'T', 1., tsa(:,:,:,jp_sal), 'T', 1. )
110      !
111      IF( ln_bdy )   CALL bdy_tra( kt )  ! BDY open boundaries
112 
113      ! set time step size (Euler/Leapfrog)
114      IF( neuler == 0 .AND. kt == nit000 ) THEN   ;   r2dt =        rdt   ! at nit000             (Euler)
115      ELSEIF( kt <= nit000 + 1 )           THEN   ;   r2dt = 2._wp* rdt   ! at nit000 or nit000+1 (Leapfrog)
116      ENDIF
117
118      ! trends computation initialisation
119      IF( l_trdtra )   THEN                   
120         ALLOCATE( ztrdt(jpi,jpj,jpk) , ztrds(jpi,jpj,jpk) )
121         ztrdt(:,:,jpk) = 0._wp
122         ztrds(:,:,jpk) = 0._wp
123         IF( ln_traldf_iso ) THEN              ! diagnose the "pure" Kz diffusive trend
124            CALL trd_tra( kt, 'TRA', jp_tem, jptra_zdfp, ztrdt )
125            CALL trd_tra( kt, 'TRA', jp_sal, jptra_zdfp, ztrds )
126         ENDIF
127         ! total trend for the non-time-filtered variables.
128         zfact = 1.0 / rdt
129         ! G Nurser 23 Mar 2017. Recalculate trend as Delta(e3t*T)/e3tn; e3tn cancel from tsn terms
130         DO jk = 1, jpkm1
131            ztrdt(:,:,jk) = ( tsa(:,:,jk,jp_tem)*e3t_a(:,:,jk) / e3t_n(:,:,jk) - tsn(:,:,jk,jp_tem)) * zfact
132            ztrds(:,:,jk) = ( tsa(:,:,jk,jp_sal)*e3t_a(:,:,jk) / e3t_n(:,:,jk) - tsn(:,:,jk,jp_sal)) * zfact
133         END DO
134         CALL trd_tra( kt, 'TRA', jp_tem, jptra_tot, ztrdt )
135         CALL trd_tra( kt, 'TRA', jp_sal, jptra_tot, ztrds )
136         IF( ln_linssh ) THEN       ! linear sea surface height only
137            ! Store now fields before applying the Asselin filter
138            ! in order to calculate Asselin filter trend later.
139            ztrdt(:,:,:) = tsn(:,:,:,jp_tem) 
140            ztrds(:,:,:) = tsn(:,:,:,jp_sal)
141         ENDIF
142      ENDIF
143
144      IF( neuler == 0 .AND. kt == nit000 ) THEN       ! Euler time-stepping at first time-step (only swap)
145         DO jn = 1, jpts
146            DO jk = 1, jpkm1
147               tsn(:,:,jk,jn) = tsa(:,:,jk,jn)   
148            END DO
149         END DO
150         IF (l_trdtra .AND. .NOT. ln_linssh ) THEN   ! Zero Asselin filter contribution must be explicitly written out since for vvl
151            !                                        ! Asselin filter is output by tra_nxt_vvl that is not called on this time step
152            ztrdt(:,:,:) = 0._wp
153            ztrds(:,:,:) = 0._wp
154            CALL trd_tra( kt, 'TRA', jp_tem, jptra_atf, ztrdt )
155            CALL trd_tra( kt, 'TRA', jp_sal, jptra_atf, ztrds )
156         END IF
157         !
158      ELSE                                            ! Leap-Frog + Asselin filter time stepping
159         !
160         IF( ln_linssh ) THEN   ;   CALL tra_nxt_fix( kt, nit000,      'TRA', tsb, tsn, tsa, jpts )  ! linear free surface
161         ELSE                   ;   CALL tra_nxt_vvl( kt, nit000, rdt, 'TRA', tsb, tsn, tsa,   &
162           &                                                                sbc_tsc, sbc_tsc_b, jpts )  ! non-linear free surface
163         ENDIF
164         !
165         CALL lbc_lnk_multi( 'tranxt', tsb(:,:,:,jp_tem), 'T', 1., tsb(:,:,:,jp_sal), 'T', 1., &
166                  &          tsn(:,:,:,jp_tem), 'T', 1., tsn(:,:,:,jp_sal), 'T', 1., &
167                  &          tsa(:,:,:,jp_tem), 'T', 1., tsa(:,:,:,jp_sal), 'T', 1.  )
168         !
169      ENDIF     
170      !
171      IF( l_trdtra .AND. ln_linssh ) THEN      ! trend of the Asselin filter (tb filtered - tb)/dt     
172         zfact = 1._wp / r2dt             
173         DO jk = 1, jpkm1
174            ztrdt(:,:,jk) = ( tsb(:,:,jk,jp_tem) - ztrdt(:,:,jk) ) * zfact
175            ztrds(:,:,jk) = ( tsb(:,:,jk,jp_sal) - ztrds(:,:,jk) ) * zfact
176         END DO
177         CALL trd_tra( kt, 'TRA', jp_tem, jptra_atf, ztrdt )
178         CALL trd_tra( kt, 'TRA', jp_sal, jptra_atf, ztrds )
179      END IF
180      IF( l_trdtra )   DEALLOCATE( ztrdt , ztrds )
181      !
182      !                        ! control print
183      IF(ln_ctl)   CALL prt_ctl( tab3d_1=tsn(:,:,:,jp_tem), clinfo1=' nxt  - Tn: ', mask1=tmask,   &
184         &                       tab3d_2=tsn(:,:,:,jp_sal), clinfo2=       ' Sn: ', mask2=tmask )
185      !
186      IF( ln_timing )   CALL timing_stop('tra_nxt')
187      !
188   END SUBROUTINE tra_nxt
189
190
191   SUBROUTINE tra_nxt_fix( kt, kit000, cdtype, ptb, ptn, pta, kjpt )
192      !!----------------------------------------------------------------------
193      !!                   ***  ROUTINE tra_nxt_fix  ***
194      !!
195      !! ** Purpose :   fixed volume: apply the Asselin time filter and
196      !!                swap the tracer fields.
197      !!
198      !! ** Method  : - Apply a Asselin time filter on now fields.
199      !!              - swap tracer fields to prepare the next time_step.
200      !!
201      !! ** Action  : - tsb & tsn ready for the next time step
202      !!----------------------------------------------------------------------
203      INTEGER                              , INTENT(in   ) ::  kt        ! ocean time-step index
204      INTEGER                              , INTENT(in   ) ::  kit000    ! first time step index
205      CHARACTER(len=3)                     , INTENT(in   ) ::  cdtype    ! =TRA or TRC (tracer indicator)
206      INTEGER                              , INTENT(in   ) ::  kjpt      ! number of tracers
207      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::  ptb       ! before tracer fields
208      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::  ptn       ! now tracer fields
209      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::  pta       ! tracer trend
210      !
211      INTEGER  ::   ji, jj, jk, jn   ! dummy loop indices
212      REAL(wp) ::   ztn, ztd         ! local scalars
213      !!----------------------------------------------------------------------
214      !
215      IF( kt == kit000 )  THEN
216         IF(lwp) WRITE(numout,*)
217         IF(lwp) WRITE(numout,*) 'tra_nxt_fix : time stepping', cdtype
218         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~'
219      ENDIF
220      !
221      DO jn = 1, kjpt
222         !
223         DO jk = 1, jpkm1
224            DO jj = 2, jpjm1
225               DO ji = fs_2, fs_jpim1
226                  ztn = ptn(ji,jj,jk,jn)                                   
227                  ztd = pta(ji,jj,jk,jn) - 2._wp * ztn + ptb(ji,jj,jk,jn)  ! time laplacian on tracers
228                  !
229                  ptb(ji,jj,jk,jn) = ztn + atfp * ztd                      ! ptb <-- filtered ptn
230                  ptn(ji,jj,jk,jn) = pta(ji,jj,jk,jn)                      ! ptn <-- pta
231               END DO
232           END DO
233         END DO
234         !
235      END DO
236      !
237   END SUBROUTINE tra_nxt_fix
238
239
240   SUBROUTINE tra_nxt_vvl( kt, kit000, p2dt, cdtype, ptb, ptn, pta, psbc_tc, psbc_tc_b, kjpt )
241      !!----------------------------------------------------------------------
242      !!                   ***  ROUTINE tra_nxt_vvl  ***
243      !!
244      !! ** Purpose :   Time varying volume: apply the Asselin time filter 
245      !!                and swap the tracer fields.
246      !!
247      !! ** Method  : - Apply a thickness weighted Asselin time filter on now fields.
248      !!              - swap tracer fields to prepare the next time_step.
249      !!             tb  = ( e3t_n*tn + atfp*[ e3t_b*tb - 2 e3t_n*tn + e3t_a*ta ] )
250      !!                  /( e3t_n    + atfp*[ e3t_b    - 2 e3t_n    + e3t_a    ] )
251      !!             tn  = ta
252      !!
253      !! ** Action  : - tsb & tsn ready for the next time step
254      !!----------------------------------------------------------------------
255      INTEGER                              , INTENT(in   ) ::  kt        ! ocean time-step index
256      INTEGER                              , INTENT(in   ) ::  kit000    ! first time step index
257      REAL(wp)                             , INTENT(in   ) ::  p2dt      ! time-step
258      CHARACTER(len=3)                     , INTENT(in   ) ::  cdtype    ! =TRA or TRC (tracer indicator)
259      INTEGER                              , INTENT(in   ) ::  kjpt      ! number of tracers
260      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::  ptb       ! before tracer fields
261      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::  ptn       ! now tracer fields
262      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::  pta       ! tracer trend
263      REAL(wp), DIMENSION(jpi,jpj    ,kjpt), INTENT(in   ) ::  psbc_tc   ! surface tracer content
264      REAL(wp), DIMENSION(jpi,jpj    ,kjpt), INTENT(in   ) ::  psbc_tc_b ! before surface tracer content
265      !
266      LOGICAL  ::   ll_traqsr, ll_rnf, ll_isf   ! local logical
267      INTEGER  ::   ji, jj, jk, jn              ! dummy loop indices
268      REAL(wp) ::   zfact, zfact1, ztc_a , ztc_n , ztc_b , ztc_f , ztc_d    ! local scalar
269      REAL(wp) ::   zfact2, ze3t_b, ze3t_n, ze3t_a, ze3t_f, ze3t_d   !   -      -
270      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:) ::   ztrd_atf
271      !!----------------------------------------------------------------------
272      !
273      IF( kt == kit000 )  THEN
274         IF(lwp) WRITE(numout,*)
275         IF(lwp) WRITE(numout,*) 'tra_nxt_vvl : time stepping', cdtype
276         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~'
277      ENDIF
278      !
279      IF( cdtype == 'TRA' )  THEN   
280         ll_traqsr  = ln_traqsr        ! active  tracers case  and  solar penetration
281         ll_rnf     = ln_rnf           ! active  tracers case  and  river runoffs
282         ll_isf     = ln_isf           ! active  tracers case  and  ice shelf melting
283      ELSE                          ! passive tracers case
284         ll_traqsr  = .FALSE.          ! NO solar penetration
285         ll_rnf     = .FALSE.          ! NO river runoffs ????          !!gm BUG ? 
286         ll_isf     = .FALSE.          ! NO ice shelf melting/freezing  !!gm BUG ??
287      ENDIF
288      !
289      IF( ( l_trdtra .AND. cdtype == 'TRA' ) .OR. ( l_trdtrc .AND. cdtype == 'TRC' ) )   THEN
290         ALLOCATE( ztrd_atf(jpi,jpj,jpk,kjpt) )
291         ztrd_atf(:,:,:,:) = 0.0_wp
292      ENDIF
293      zfact = 1._wp / p2dt
294      zfact1 = atfp * p2dt
295      zfact2 = zfact1 * r1_rau0
296      DO jn = 1, kjpt     
297         DO jk = 1, jpkm1
298            DO jj = 2, jpjm1
299               DO ji = fs_2, fs_jpim1
300                  ze3t_b = e3t_b(ji,jj,jk)
301                  ze3t_n = e3t_n(ji,jj,jk)
302                  ze3t_a = e3t_a(ji,jj,jk)
303                  !                                         ! tracer content at Before, now and after
304                  ztc_b  = ptb(ji,jj,jk,jn) * ze3t_b
305                  ztc_n  = ptn(ji,jj,jk,jn) * ze3t_n
306                  ztc_a  = pta(ji,jj,jk,jn) * ze3t_a
307                  !
308                  ze3t_d = ze3t_a - 2. * ze3t_n + ze3t_b
309                  ztc_d  = ztc_a  - 2. * ztc_n  + ztc_b
310                  !
311                  ze3t_f = ze3t_n + atfp * ze3t_d
312                  ztc_f  = ztc_n  + atfp * ztc_d
313                  !
314                  IF( jk == 1 ) THEN           ! first level
315                     ze3t_f = ze3t_f - zfact2 * ( emp_b(ji,jj) - emp(ji,jj)   )
316                     ztc_f  = ztc_f  - zfact1 * ( psbc_tc(ji,jj,jn) - psbc_tc_b(ji,jj,jn) )
317                  ENDIF
318                  !
319                  ! river runoff
320                  IF( ln_rnf_depth ) THEN
321                     ! Rivers are not just at the surface must go down to nk_rnf(ji,jj)
322                     IF( jk <= nk_rnf(ji,jj)  ) THEN
323                        ze3t_f = ze3t_f - zfact2 * ( - (rnf_b(ji,jj) - rnf(ji,jj)   )  ) &
324                    &                            * ( e3t_n(ji,jj,jk) / h_rnf(ji,jj) ) 
325                     ENDIF
326                  ELSE
327                     IF( jk == 1 ) THEN           ! first level
328                        ze3t_f = ze3t_f - zfact2 * ( - (rnf_b(ji,jj)    - rnf(ji,jj)   ) ) 
329                     ENDIF
330                  ENDIF
331                  !
332                  IF( ll_rnf .AND. jk <= nk_rnf(ji,jj) )                                          &
333                     &     ztc_f  = ztc_f  - zfact1 * ( rnf_tsc(ji,jj,jn) - rnf_tsc_b(ji,jj,jn) ) & 
334                     &                              * e3t_n(ji,jj,jk) / h_rnf(ji,jj)
335                  !
336                  ! solar penetration (temperature only)
337                  IF( ll_traqsr .AND. jn == jp_tem .AND. jk <= nksr )                            & 
338                     &     ztc_f  = ztc_f  - zfact1 * ( qsr_hc(ji,jj,jk) - qsr_hc_b(ji,jj,jk) ) 
339                  !
340                  ! ice shelf
341                  IF( ll_isf ) THEN
342                     !
343                     ! melt in the cavity
344                     IF ( ln_isfcav_mlt ) THEN
345                        ! level fully include in the Losch_2008 ice shelf boundary layer
346                        IF ( jk >= misfkt_cav(ji,jj) .AND. jk < misfkb_cav(ji,jj) ) THEN
347                           ztc_f  = ztc_f  - zfact1 * ( risf_cav_tsc(ji,jj,jn) - risf_cav_tsc_b(ji,jj,jn) ) &
348                              &                     * e3t_n(ji,jj,jk) / rhisf_tbl_cav(ji,jj)
349                           ze3t_f = ze3t_f - zfact2 * ( fwfisf_cav_b(ji,jj) - fwfisf_cav(ji,jj) )           &
350                              &                     * e3t_n(ji,jj,jk) / rhisf_tbl_cav(ji,jj)
351                        END IF
352                        ! level partially include in Losch_2008 ice shelf boundary layer
353                        IF ( jk == misfkb_cav(ji,jj) ) THEN
354                           ztc_f  = ztc_f  - zfact1 * ( risf_cav_tsc(ji,jj,jn) - risf_cav_tsc_b(ji,jj,jn) )  &
355                                  &                 * e3t_n(ji,jj,jk) / rhisf_tbl_cav(ji,jj) * rfrac_tbl_cav(ji,jj)
356                           ze3t_f = ze3t_f - zfact2 * ( fwfisf_cav_b(ji,jj) - fwfisf_cav(ji,jj) )            &
357                              &                     * e3t_n(ji,jj,jk) / rhisf_tbl_cav(ji,jj) * rfrac_tbl_cav(ji,jj)
358                        END IF
359                     END IF
360                     !
361                     ! parametrised melt (cavity closed)
362                     IF ( ln_isfpar_mlt ) THEN
363                        ! level fully include in the Losch_2008 ice shelf boundary layer
364                        IF ( jk >= misfkt_par(ji,jj) .AND. jk < misfkb_par(ji,jj) ) THEN
365                           ztc_f  = ztc_f  - zfact1 * ( risf_par_tsc(ji,jj,jn) - risf_par_tsc_b(ji,jj,jn) )  &
366                                  &                 * e3t_n(ji,jj,jk) / rhisf_tbl_par(ji,jj)
367                           ze3t_f = ze3t_f - zfact2 * ( fwfisf_par_b(ji,jj) - fwfisf_par(ji,jj) )            &
368                              &                     * e3t_n(ji,jj,jk) / rhisf_tbl_par(ji,jj)
369                        END IF
370                        ! level partially include in Losch_2008 ice shelf boundary layer
371                        IF ( jk == misfkb_par(ji,jj) ) THEN
372                           ztc_f  = ztc_f  - zfact1 * ( risf_par_tsc(ji,jj,jn) - risf_par_tsc_b(ji,jj,jn) )  &
373                                  &                 * e3t_n(ji,jj,jk) / rhisf_tbl_par(ji,jj) * rfrac_tbl_par(ji,jj)
374                           ze3t_f = ze3t_f - zfact2 * ( fwfisf_par_b(ji,jj) - fwfisf_par(ji,jj) )            &
375                              &                     * e3t_n(ji,jj,jk) / rhisf_tbl_par(ji,jj) * rfrac_tbl_par(ji,jj)
376                        END IF
377                     END IF
378                     !
379                     ! ice sheet coupling correction
380                     IF ( ln_isfcpl ) THEN
381                        !
382                        ! at kt = nit000,  risfcpl_vol_n = 0 and risfcpl_vol_b = risfcpl_vol so contribution nul
383                        IF ( ln_rstart .AND. kt == nit000+1 ) THEN
384                           ztc_f  = ztc_f  + zfact1 * risfcpl_tsc(ji,jj,jk,jn) * r1_e1e2t(ji,jj)
385                           ze3t_f = ze3t_f - zfact1 * risfcpl_vol(ji,jj,jk   ) * r1_e1e2t(ji,jj)
386                        END IF
387                        !
388                     END IF
389                     !
390                  END IF
391                  !
392                  ze3t_f = 1.e0 / ze3t_f
393                  ptb(ji,jj,jk,jn) = ztc_f * ze3t_f       ! ptb <-- ptn filtered
394                  ptn(ji,jj,jk,jn) = pta(ji,jj,jk,jn)     ! ptn <-- pta
395                  !
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                  !
400               END DO
401            END DO
402         END DO
403         !
404      END DO
405      !
406      IF( ( l_trdtra .AND. cdtype == 'TRA' ) .OR. ( l_trdtrc .AND. cdtype == 'TRC' ) )   THEN
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         ENDIF
411         IF( l_trdtrc .AND. cdtype == 'TRC' ) THEN
412            DO jn = 1, kjpt
413               CALL trd_tra( kt, cdtype, jn, jptra_atf, ztrd_atf(:,:,:,jn) )
414            END DO
415         ENDIF
416         DEALLOCATE( 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.