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/2018/dev_r9838_ENHANCE04_RK3/src/OCE/TRA – NEMO

source: NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/TRA/tranxt.F90 @ 10876

Last change on this file since 10876 was 9939, checked in by gm, 6 years ago

#1911 (ENHANCE-04): RK3 branche phased with MLF@9937 branche
  • Property svn:keywords set to Id
File size: 18.6 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
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 licence     (./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), DIMENSION(:,:,:,:), ALLOCATABLE ::   ztrd   ! 4D workspace
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( tsa(:,:,:,jp_tem), 'T', 1., tsa(:,:,:,jp_sal), 'T', 1. )
110      !
111      IF( ln_bdy )   CALL bdy_tra( kt )  ! BDY open boundaries
112 
113      IF( l_trdtra )   THEN               ! trends computation initialisation
114         ALLOCATE( ztrd(jpi,jpj,jpk,jpts) )
115         ztrd(:,:,jpk,:) = 0._wp
116         IF( ln_traldf_iso ) THEN              ! diagnose the "pure" Kz diffusive trend
117            CALL trd_tra( kt, 'TRA', jp_tem, jptra_zdfp, ztrd(:,:,:,jp_tem) )
118            CALL trd_tra( kt, 'TRA', jp_sal, jptra_zdfp, ztrd(:,:,:,jp_sal) )
119         ENDIF
120         ! total trend for the non-time-filtered variables.
121         zfact = 1.0 / rn_Dt
122         ! G Nurser 23 Mar 2017. Recalculate trend as Delta(e3t*T)/e3tn; e3tn cancel from tsn terms
123         DO jn = 1, jpts
124            DO jk = 1, jpkm1
125               ztrd(:,:,jk,jn) = ( tsa(:,:,jk,jn)*e3t_a(:,:,jk) / e3t_n(:,:,jk) - tsn(:,:,jk,jn)) * zfact
126            END DO
127         END DO
128         CALL trd_tra( kt, 'TRA', jp_tem, jptra_tot, ztrd(:,:,:,jp_tem) )
129         CALL trd_tra( kt, 'TRA', jp_sal, jptra_tot, ztrd(:,:,:,jp_sal) )
130         IF( ln_linssh ) THEN       ! linear sea surface height only Store now fields before applying
131            !                       ! the Asselin filter in order to calculate Asselin filter trend later.
132            ztrd(:,:,:,:) = tsn(:,:,:,:) 
133         ENDIF
134      ENDIF
135
136      IF( l_1st_euler ) THEN        ! Euler time-stepping at first time-step (only swap)
137         DO jn = 1, jpts
138            DO jk = 1, jpkm1
139               tsn(:,:,jk,jn) = tsa(:,:,jk,jn)   
140            END DO
141         END DO
142         IF (l_trdtra .AND. .NOT. ln_linssh ) THEN   ! Zero Asselin filter contribution must be explicitly written out since for vvl
143            !                                        ! Asselin filter is output by tra_nxt_vvl that is not called on this time step
144            ztrd(:,:,:,:) = 0._wp
145            CALL trd_tra( kt, 'TRA', jp_tem, jptra_atf, ztrd(:,:,:,jp_tem) )
146            CALL trd_tra( kt, 'TRA', jp_sal, jptra_atf, ztrd(:,:,:,jp_sal) )
147         END IF
148         !
149      ELSE                          ! Leap-Frog + Asselin filter time stepping
150         !
151         IF( ln_linssh ) THEN   ;   CALL tra_nxt_fix( kt, nit000,       'TRA', tsb, tsn, tsa, jpts )  ! linear free surface
152         ELSE                   ;   CALL tra_nxt_vvl( kt, nit000, rn_Dt,'TRA', tsb, tsn, tsa,   &
153           &                                                               sbc_tsc, sbc_tsc_b, jpts )  ! non-linear free surface
154         ENDIF
155         !
156         CALL lbc_lnk_multi( tsb, 'T', 1., tsn, 'T', 1., tsa, 'T', 1.  )
157         !
158      ENDIF     
159      !
160      IF( l_trdtra .AND. ln_linssh ) THEN      ! trend of the Asselin filter (tb filtered - tb)/dt     
161         DO jk = 1, jpkm1
162            ztrd(:,:,jk,:) = ( tsb(:,:,jk,:) - ztrd(:,:,jk,:) ) * r1_Dt
163         END DO
164         CALL trd_tra( kt, 'TRA', jp_tem, jptra_atf, ztrd(:,:,:,jp_tem) )
165         CALL trd_tra( kt, 'TRA', jp_sal, jptra_atf, ztrd(:,:,:,jp_sal) )
166      END IF
167      IF( l_trdtra )   DEALLOCATE( ztrd )
168      !
169      !                        ! control print
170      IF(ln_ctl)   CALL prt_ctl( tab3d_1=tsn(:,:,:,jp_tem), clinfo1=' nxt  - Tn: ', mask1=tmask,   &
171         &                       tab3d_2=tsn(:,:,:,jp_sal), clinfo2=       ' Sn: ', mask2=tmask )
172      !
173      IF( ln_timing )   CALL timing_stop('tra_nxt')
174      !
175   END SUBROUTINE tra_nxt
176
177
178   SUBROUTINE tra_nxt_fix( kt, kit000, cdtype, ptb, ptn, pta, kjpt )
179      !!----------------------------------------------------------------------
180      !!                   ***  ROUTINE tra_nxt_fix  ***
181      !!
182      !! ** Purpose :   fixed volume: apply the Asselin time filter and
183      !!                swap the tracer fields.
184      !!
185      !! ** Method  : - Apply a Asselin time filter on now fields.
186      !!              - swap tracer fields to prepare the next time_step.
187      !!
188      !! ** Action  : - tsb & tsn ready for the next time step
189      !!----------------------------------------------------------------------
190      INTEGER                              , INTENT(in   ) ::  kt        ! ocean time-step index
191      INTEGER                              , INTENT(in   ) ::  kit000    ! first time step index
192      CHARACTER(len=3)                     , INTENT(in   ) ::  cdtype    ! =TRA or TRC (tracer indicator)
193      INTEGER                              , INTENT(in   ) ::  kjpt      ! number of tracers
194      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::  ptb       ! before tracer fields
195      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::  ptn       ! now tracer fields
196      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::  pta       ! tracer trend
197      !
198      INTEGER  ::   ji, jj, jk, jn   ! dummy loop indices
199      REAL(wp) ::   ztn, ztd         ! local scalars
200      !!----------------------------------------------------------------------
201      !
202      IF( kt == kit000 )  THEN
203         IF(lwp) WRITE(numout,*)
204         IF(lwp) WRITE(numout,*) 'tra_nxt_fix : time stepping', cdtype
205         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~'
206      ENDIF
207      !
208      DO jn = 1, kjpt
209         !
210         DO jk = 1, jpkm1
211            DO jj = 2, jpjm1
212               DO ji = fs_2, fs_jpim1
213                  ztn = ptn(ji,jj,jk,jn)                                   
214                  ztd = pta(ji,jj,jk,jn) - 2._wp * ztn + ptb(ji,jj,jk,jn)  ! time laplacian on tracers
215                  !
216                  ptb(ji,jj,jk,jn) = ztn + rn_atfp * ztd                   ! ptb <-- filtered ptn
217                  ptn(ji,jj,jk,jn) = pta(ji,jj,jk,jn)                      ! ptn <-- pta
218               END DO
219           END DO
220         END DO
221         !
222      END DO
223      !
224   END SUBROUTINE tra_nxt_fix
225
226
227   SUBROUTINE tra_nxt_vvl( kt, kit000, pdt, cdtype, ptb, ptn, pta, psbc_tc, psbc_tc_b, kjpt )
228      !!----------------------------------------------------------------------
229      !!                   ***  ROUTINE tra_nxt_vvl  ***
230      !!
231      !! ** Purpose :   Time varying volume: apply the Asselin time filter 
232      !!                and swap the tracer fields.
233      !!
234      !! ** Method  : - Apply a thickness weighted Asselin time filter on now fields.
235      !!              - swap tracer fields to prepare the next time_step.
236      !!             tb  = ( e3t_n*tn + rn_atfp*[ e3t_b*tb - 2 e3t_n*tn + e3t_a*ta ] )
237      !!                  /( e3t_n    + rn_atfp*[ e3t_b    - 2 e3t_n    + e3t_a    ] )
238      !!             tn  = ta
239      !!
240      !! ** Action  : - tsb & tsn ready for the next time step
241      !!----------------------------------------------------------------------
242      INTEGER                              , INTENT(in   ) ::  kt        ! ocean time-step index
243      INTEGER                              , INTENT(in   ) ::  kit000    ! first time step index
244      REAL(wp)                             , INTENT(in   ) ::  pdt       ! time-step
245      CHARACTER(len=3)                     , INTENT(in   ) ::  cdtype    ! =TRA or TRC (tracer indicator)
246      INTEGER                              , INTENT(in   ) ::  kjpt      ! number of tracers
247      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::  ptb       ! before tracer fields
248      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::  ptn       ! now tracer fields
249      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::  pta       ! tracer trend
250      REAL(wp), DIMENSION(jpi,jpj    ,kjpt), INTENT(in   ) ::  psbc_tc   ! surface tracer content
251      REAL(wp), DIMENSION(jpi,jpj    ,kjpt), INTENT(in   ) ::  psbc_tc_b ! before surface tracer content
252      !
253      LOGICAL  ::   ll_traqsr, ll_rnf, ll_isf   ! local logical
254      INTEGER  ::   ji, jj, jk, jn              ! dummy loop indices
255      REAL(wp) ::   zfact, zfact1, ztc_a , ztc_n , ztc_b , ztc_f , ztc_d    ! local scalar
256      REAL(wp) ::   zfact2, ze3t_b, ze3t_n, ze3t_a, ze3t_f, ze3t_d   !   -      -
257      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:) ::   ztrd_atf
258      !!----------------------------------------------------------------------
259      !
260      IF( kt == kit000 )  THEN
261         IF(lwp) WRITE(numout,*)
262         IF(lwp) WRITE(numout,*) 'tra_nxt_vvl : time stepping', cdtype
263         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~'
264      ENDIF
265      !
266      IF( cdtype == 'TRA' )  THEN   
267         ll_traqsr  = ln_traqsr        ! active  tracers case  and  solar penetration
268         ll_rnf     = ln_rnf           ! active  tracers case  and  river runoffs
269         ll_isf     = ln_isf           ! active  tracers case  and  ice shelf melting
270      ELSE                          ! passive tracers case
271         ll_traqsr  = .FALSE.          ! NO solar penetration
272         ll_rnf     = .FALSE.          ! NO river runoffs ????          !!gm BUG ? 
273         ll_isf     = .FALSE.          ! NO ice shelf melting/freezing  !!gm BUG ??
274      ENDIF
275      !
276      IF( ( l_trdtra .AND. cdtype == 'TRA' ) .OR. ( l_trdtrc .AND. cdtype == 'TRC' ) )   THEN
277         ALLOCATE( ztrd_atf(jpi,jpj,jpk,kjpt) )
278         ztrd_atf(:,:,:,:) = 0._wp
279      ENDIF
280      !
281      zfact = r1_Dt
282      zfact1 = rn_atfp * pdt
283      zfact2 = zfact1 * r1_rho0
284      DO jn = 1, kjpt
285         DO jk = 1, jpkm1
286            DO jj = 2, jpjm1
287               DO ji = fs_2, fs_jpim1
288                  ze3t_b = e3t_b(ji,jj,jk)
289                  ze3t_n = e3t_n(ji,jj,jk)
290                  ze3t_a = e3t_a(ji,jj,jk)
291                  !                                         ! tracer content at Before, now and after
292                  ztc_b  = ptb(ji,jj,jk,jn) * ze3t_b
293                  ztc_n  = ptn(ji,jj,jk,jn) * ze3t_n
294                  ztc_a  = pta(ji,jj,jk,jn) * ze3t_a
295                  !
296                  ze3t_d = ze3t_a - 2. * ze3t_n + ze3t_b
297                  ztc_d  = ztc_a  - 2. * ztc_n  + ztc_b
298                  !
299                  ze3t_f = ze3t_n + rn_atfp * ze3t_d
300                  ztc_f  = ztc_n  + rn_atfp * ztc_d
301                  !
302                  IF( jk == mikt(ji,jj) ) THEN           ! first level
303                     ze3t_f = ze3t_f - zfact2 * ( (emp_b(ji,jj)    - emp(ji,jj)   )  &
304                            &                   + (fwfisf_b(ji,jj) - fwfisf(ji,jj))  )
305                     ztc_f  = ztc_f  - zfact1 * ( psbc_tc(ji,jj,jn) - psbc_tc_b(ji,jj,jn) )
306                  ENDIF
307                  IF( ln_rnf_depth ) THEN
308                     ! Rivers are not just at the surface must go down to nk_rnf(ji,jj)
309                     IF( mikt(ji,jj) <=jk .and. jk <= nk_rnf(ji,jj)  ) THEN
310                        ze3t_f = ze3t_f - zfact2 * ( - (rnf_b(ji,jj) - rnf(ji,jj)   )  ) &
311                    &                            * ( e3t_n(ji,jj,jk) / h_rnf(ji,jj) ) 
312                     ENDIF
313                  ELSE
314                     IF( jk == mikt(ji,jj) ) THEN           ! first level
315                        ze3t_f = ze3t_f - zfact2 * ( - (rnf_b(ji,jj)    - rnf(ji,jj)   ) ) 
316                     ENDIF
317                  ENDIF
318
319                  !
320                  ! solar penetration (temperature only)
321                  IF( ll_traqsr .AND. jn == jp_tem .AND. jk <= nksr )                            & 
322                     &     ztc_f  = ztc_f  - zfact1 * ( qsr_hc(ji,jj,jk) - qsr_hc_b(ji,jj,jk) ) 
323                     !
324                  ! river runoff
325                  IF( ll_rnf .AND. jk <= nk_rnf(ji,jj) )                                          &
326                     &     ztc_f  = ztc_f  - zfact1 * ( rnf_tsc(ji,jj,jn) - rnf_tsc_b(ji,jj,jn) ) & 
327                     &                              * e3t_n(ji,jj,jk) / h_rnf(ji,jj)
328                     !
329                  ! ice shelf
330                  IF( ll_isf ) THEN
331                     ! level fully include in the Losch_2008 ice shelf boundary layer
332                     IF ( jk >= misfkt(ji,jj) .AND. jk < misfkb(ji,jj) )                          &
333                        ztc_f  = ztc_f  - zfact1 * ( risf_tsc(ji,jj,jn) - risf_tsc_b(ji,jj,jn) )  &
334                               &                 * e3t_n(ji,jj,jk) * r1_hisf_tbl (ji,jj)
335                     ! level partially include in Losch_2008 ice shelf boundary layer
336                     IF ( jk == misfkb(ji,jj) )                                                   &
337                        ztc_f  = ztc_f  - zfact1 * ( risf_tsc(ji,jj,jn) - risf_tsc_b(ji,jj,jn) )  &
338                               &                 * e3t_n(ji,jj,jk) * r1_hisf_tbl (ji,jj) * ralpha(ji,jj)
339                  END IF
340                  !
341                  ze3t_f = 1.e0 / ze3t_f
342                  ptb(ji,jj,jk,jn) = ztc_f * ze3t_f       ! ptb <-- ptn filtered
343                  ptn(ji,jj,jk,jn) = pta(ji,jj,jk,jn)     ! ptn <-- pta
344                  !
345                  IF( ( l_trdtra .and. cdtype == 'TRA' ) .OR. ( l_trdtrc .and. cdtype == 'TRC' ) ) THEN
346                     ztrd_atf(ji,jj,jk,jn) = (ztc_f - ztc_n) * zfact/ze3t_n
347                  ENDIF
348                  !
349               END DO
350            END DO
351         END DO
352         !
353      END DO
354      !
355      IF( ( l_trdtra .AND. cdtype == 'TRA' ) .OR. ( l_trdtrc .AND. cdtype == 'TRC' ) )   THEN
356         IF( l_trdtra .AND. cdtype == 'TRA' ) THEN
357            CALL trd_tra( kt, cdtype, jp_tem, jptra_atf, ztrd_atf(:,:,:,jp_tem) )
358            CALL trd_tra( kt, cdtype, jp_sal, jptra_atf, ztrd_atf(:,:,:,jp_sal) )
359         ENDIF
360         IF( l_trdtrc .AND. cdtype == 'TRC' ) THEN
361            DO jn = 1, kjpt
362               CALL trd_tra( kt, cdtype, jn, jptra_atf, ztrd_atf(:,:,:,jn) )
363            END DO
364         ENDIF
365         DEALLOCATE( ztrd_atf )
366      ENDIF
367      !
368   END SUBROUTINE tra_nxt_vvl
369
370   !!======================================================================
371END MODULE tranxt
Note: See TracBrowser for help on using the repository browser.