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/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/RK3_SRC/TRA – NEMO

source: branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/RK3_SRC/TRA/tranxt.F90 @ 8568

Last change on this file since 8568 was 8568, checked in by gm, 7 years ago

#1911 (ENHANCE-09): PART I.2 - _NONE option + remove zts + see associated wiki page
  • Property svn:keywords set to Id
File size: 16.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
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_opa_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/OPA 3.3 , NEMO-Consortium (2010)
61   !! $Id$
62   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
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      !
109      CALL lbc_lnk( tsa(:,:,:,jp_tem), 'T', 1._wp )      ! local domain boundaries  (T-point, unchanged sign)
110      CALL lbc_lnk( tsa(:,:,:,jp_sal), 'T', 1._wp )
111      !
112      IF( ln_bdy )   CALL bdy_tra( kt )  ! BDY open boundaries
113 
114      ! set time step size (Euler/Leapfrog)
115      IF( neuler == 0 .AND. kt == nit000 ) THEN   ;   r2dt =     rdt      ! at nit000             (Euler)
116      ELSEIF( kt <= nit000 + 1 )           THEN   ;   r2dt = 2._wp* rdt   ! at nit000 or nit000+1 (Leapfrog)
117      ENDIF
118
119      ! trends computation initialisation
120      IF( l_trdtra )   THEN                   
121         ALLOCATE( ztrdt(jpi,jpj,jpk) , ztrds(jpi,jpj,jpk) )
122         ztrdt(:,:,jk) = 0._wp
123         ztrds(:,:,jk) = 0._wp
124         IF( ln_traldf_iso ) THEN              ! diagnose the "pure" Kz diffusive trend
125            CALL trd_tra( kt, 'TRA', jp_tem, jptra_zdfp, ztrdt )
126            CALL trd_tra( kt, 'TRA', jp_sal, jptra_zdfp, ztrds )
127         ENDIF
128         ! total trend for the non-time-filtered variables.
129            zfact = 1.0 / rdt
130         DO jk = 1, jpkm1
131            ztrdt(:,:,jk) = ( tsa(:,:,jk,jp_tem) - tsn(:,:,jk,jp_tem) ) * zfact 
132            ztrds(:,:,jk) = ( tsa(:,:,jk,jp_sal) - 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         ! Store now fields before applying the Asselin filter
137         ! in order to calculate Asselin filter trend later.
138         ztrdt(:,:,:) = tsn(:,:,:,jp_tem) 
139         ztrds(:,:,:) = tsn(:,:,:,jp_sal)
140      ENDIF
141
142      IF( neuler == 0 .AND. kt == nit000 ) THEN       ! Euler time-stepping at first time-step (only swap)
143         DO jn = 1, jpts
144            DO jk = 1, jpkm1
145               tsn(:,:,jk,jn) = tsa(:,:,jk,jn)   
146            END DO
147         END DO
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, rdt, 'TRA', tsb, tsn, tsa,   &
153           &                                                                sbc_tsc, sbc_tsc_b, jpts )  ! non-linear free surface
154         ENDIF
155         !
156         DO jn = 1, jpts
157            CALL lbc_lnk( tsb(:,:,:,jn), 'T', 1._wp ) 
158            CALL lbc_lnk( tsn(:,:,:,jn), 'T', 1._wp )
159            CALL lbc_lnk( tsa(:,:,:,jn), 'T', 1._wp )
160         END DO
161      ENDIF     
162      !
163      IF( l_trdtra ) THEN      ! trend of the Asselin filter (tb filtered - tb)/dt     
164         DO jk = 1, jpkm1
165            zfact = 1._wp / r2dt             
166            ztrdt(:,:,jk) = ( tsb(:,:,jk,jp_tem) - ztrdt(:,:,jk) ) * zfact
167            ztrds(:,:,jk) = ( tsb(:,:,jk,jp_sal) - ztrds(:,:,jk) ) * zfact
168         END DO
169         CALL trd_tra( kt, 'TRA', jp_tem, jptra_atf, ztrdt )
170         CALL trd_tra( kt, 'TRA', jp_sal, jptra_atf, ztrds )
171         DEALLOCATE( ztrdt , ztrds )
172      END IF
173      !
174      !                        ! control print
175      IF(ln_ctl)   CALL prt_ctl( tab3d_1=tsn(:,:,:,jp_tem), clinfo1=' nxt  - Tn: ', mask1=tmask,   &
176         &                       tab3d_2=tsn(:,:,:,jp_sal), clinfo2=       ' Sn: ', mask2=tmask )
177      !
178      IF( ln_timing )   CALL timing_stop('tra_nxt')
179      !
180   END SUBROUTINE tra_nxt
181
182
183   SUBROUTINE tra_nxt_fix( kt, kit000, cdtype, ptb, ptn, pta, kjpt )
184      !!----------------------------------------------------------------------
185      !!                   ***  ROUTINE tra_nxt_fix  ***
186      !!
187      !! ** Purpose :   fixed volume: apply the Asselin time filter and
188      !!                swap the tracer fields.
189      !!
190      !! ** Method  : - Apply a Asselin time filter on now fields.
191      !!              - swap tracer fields to prepare the next time_step.
192      !!
193      !! ** Action  : - tsb & tsn ready for the next time step
194      !!----------------------------------------------------------------------
195      INTEGER                              , INTENT(in   ) ::  kt        ! ocean time-step index
196      INTEGER                              , INTENT(in   ) ::  kit000    ! first time step index
197      CHARACTER(len=3)                     , INTENT(in   ) ::  cdtype    ! =TRA or TRC (tracer indicator)
198      INTEGER                              , INTENT(in   ) ::  kjpt      ! number of tracers
199      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::  ptb       ! before tracer fields
200      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::  ptn       ! now tracer fields
201      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::  pta       ! tracer trend
202      !
203      INTEGER  ::   ji, jj, jk, jn   ! dummy loop indices
204      REAL(wp) ::   ztn, ztd         ! local scalars
205      !!----------------------------------------------------------------------
206      !
207      IF( kt == kit000 )  THEN
208         IF(lwp) WRITE(numout,*)
209         IF(lwp) WRITE(numout,*) 'tra_nxt_fix : time stepping', cdtype
210         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~'
211      ENDIF
212      !
213      DO jn = 1, kjpt
214         !
215         DO jk = 1, jpkm1
216            DO jj = 2, jpjm1
217               DO ji = fs_2, fs_jpim1
218                  ztn = ptn(ji,jj,jk,jn)                                   
219                  ztd = pta(ji,jj,jk,jn) - 2._wp * ztn + ptb(ji,jj,jk,jn)  ! time laplacian on tracers
220                  !
221                  ptb(ji,jj,jk,jn) = ztn + atfp * ztd                      ! ptb <-- filtered ptn
222                  ptn(ji,jj,jk,jn) = pta(ji,jj,jk,jn)                      ! ptn <-- pta
223               END DO
224           END DO
225         END DO
226         !
227      END DO
228      !
229   END SUBROUTINE tra_nxt_fix
230
231
232   SUBROUTINE tra_nxt_vvl( kt, kit000, p2dt, cdtype, ptb, ptn, pta, psbc_tc, psbc_tc_b, kjpt )
233      !!----------------------------------------------------------------------
234      !!                   ***  ROUTINE tra_nxt_vvl  ***
235      !!
236      !! ** Purpose :   Time varying volume: apply the Asselin time filter 
237      !!                and swap the tracer fields.
238      !!
239      !! ** Method  : - Apply a thickness weighted Asselin time filter on now fields.
240      !!              - swap tracer fields to prepare the next time_step.
241      !!             tb  = ( e3t_n*tn + atfp*[ e3t_b*tb - 2 e3t_n*tn + e3t_a*ta ] )
242      !!                  /( e3t_n    + atfp*[ e3t_b    - 2 e3t_n    + e3t_a    ] )
243      !!             tn  = ta
244      !!
245      !! ** Action  : - tsb & tsn ready for the next time step
246      !!----------------------------------------------------------------------
247      INTEGER                              , INTENT(in   ) ::  kt        ! ocean time-step index
248      INTEGER                              , INTENT(in   ) ::  kit000    ! first time step index
249      REAL(wp)                             , INTENT(in   ) ::  p2dt      ! time-step
250      CHARACTER(len=3)                     , INTENT(in   ) ::  cdtype    ! =TRA or TRC (tracer indicator)
251      INTEGER                              , INTENT(in   ) ::  kjpt      ! number of tracers
252      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::  ptb       ! before tracer fields
253      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::  ptn       ! now tracer fields
254      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::  pta       ! tracer trend
255      REAL(wp), DIMENSION(jpi,jpj    ,kjpt), INTENT(in   ) ::  psbc_tc   ! surface tracer content
256      REAL(wp), DIMENSION(jpi,jpj    ,kjpt), INTENT(in   ) ::  psbc_tc_b ! before surface tracer content
257      !
258      LOGICAL  ::   ll_traqsr, ll_rnf, ll_isf   ! local logical
259      INTEGER  ::   ji, jj, jk, jn              ! dummy loop indices
260      REAL(wp) ::   zfact1, ztc_a , ztc_n , ztc_b , ztc_f , ztc_d    ! local scalar
261      REAL(wp) ::   zfact2, ze3t_b, ze3t_n, ze3t_a, ze3t_f, ze3t_d   !   -      -
262      !!----------------------------------------------------------------------
263      !
264      IF( kt == kit000 )  THEN
265         IF(lwp) WRITE(numout,*)
266         IF(lwp) WRITE(numout,*) 'tra_nxt_vvl : time stepping', cdtype
267         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~'
268      ENDIF
269      !
270      IF( cdtype == 'TRA' )  THEN   
271         ll_traqsr  = ln_traqsr        ! active  tracers case  and  solar penetration
272         ll_rnf     = ln_rnf           ! active  tracers case  and  river runoffs
273         ll_isf     = ln_isf           ! active  tracers case  and  ice shelf melting
274      ELSE                          ! passive tracers case
275         ll_traqsr  = .FALSE.          ! NO solar penetration
276         ll_rnf     = .FALSE.          ! NO river runoffs ????          !!gm BUG ? 
277         ll_isf     = .FALSE.          ! NO ice shelf melting/freezing  !!gm BUG ??
278      ENDIF
279      !
280      DO jn = 1, kjpt     
281         DO jk = 1, jpkm1
282            zfact1 = atfp * p2dt
283            zfact2 = zfact1 * r1_rau0
284            DO jj = 2, jpjm1
285               DO ji = fs_2, fs_jpim1
286                  ze3t_b = e3t_b(ji,jj,jk)
287                  ze3t_n = e3t_n(ji,jj,jk)
288                  ze3t_a = e3t_a(ji,jj,jk)
289                  !                                         ! tracer content at Before, now and after
290                  ztc_b  = ptb(ji,jj,jk,jn) * ze3t_b
291                  ztc_n  = ptn(ji,jj,jk,jn) * ze3t_n
292                  ztc_a  = pta(ji,jj,jk,jn) * ze3t_a
293                  !
294                  ze3t_d = ze3t_a - 2. * ze3t_n + ze3t_b
295                  ztc_d  = ztc_a  - 2. * ztc_n  + ztc_b
296                  !
297                  ze3t_f = ze3t_n + atfp * ze3t_d
298                  ztc_f  = ztc_n  + atfp * ztc_d
299                  !
300                  IF( jk == mikt(ji,jj) ) THEN           ! first level
301                     ze3t_f = ze3t_f - zfact2 * ( (emp_b(ji,jj)    - emp(ji,jj)   )  &
302                            &                   - (rnf_b(ji,jj)    - rnf(ji,jj)   )  &
303                            &                   + (fwfisf_b(ji,jj) - fwfisf(ji,jj))  )
304                     ztc_f  = ztc_f  - zfact1 * ( psbc_tc(ji,jj,jn) - psbc_tc_b(ji,jj,jn) )
305                  ENDIF
306                  !
307                  ! solar penetration (temperature only)
308                  IF( ll_traqsr .AND. jn == jp_tem .AND. jk <= nksr )                            & 
309                     &     ztc_f  = ztc_f  - zfact1 * ( qsr_hc(ji,jj,jk) - qsr_hc_b(ji,jj,jk) ) 
310                     !
311                  ! river runoff
312                  IF( ll_rnf .AND. jk <= nk_rnf(ji,jj) )                                          &
313                     &     ztc_f  = ztc_f  - zfact1 * ( rnf_tsc(ji,jj,jn) - rnf_tsc_b(ji,jj,jn) ) & 
314                     &                              * e3t_n(ji,jj,jk) / h_rnf(ji,jj)
315                     !
316                  ! ice shelf
317                  IF( ll_isf ) THEN
318                     ! level fully include in the Losch_2008 ice shelf boundary layer
319                     IF ( jk >= misfkt(ji,jj) .AND. jk < misfkb(ji,jj) )                          &
320                        ztc_f  = ztc_f  - zfact1 * ( risf_tsc(ji,jj,jn) - risf_tsc_b(ji,jj,jn) )  &
321                               &                 * e3t_n(ji,jj,jk) * r1_hisf_tbl (ji,jj)
322                     ! level partially include in Losch_2008 ice shelf boundary layer
323                     IF ( jk == misfkb(ji,jj) )                                                   &
324                        ztc_f  = ztc_f  - zfact1 * ( risf_tsc(ji,jj,jn) - risf_tsc_b(ji,jj,jn) )  &
325                               &                 * e3t_n(ji,jj,jk) * r1_hisf_tbl (ji,jj) * ralpha(ji,jj)
326                  END IF
327                  !
328                  ze3t_f = 1.e0 / ze3t_f
329                  ptb(ji,jj,jk,jn) = ztc_f * ze3t_f       ! ptb <-- ptn filtered
330                  ptn(ji,jj,jk,jn) = pta(ji,jj,jk,jn)     ! ptn <-- pta
331                  !
332               END DO
333            END DO
334         END DO
335         !
336      END DO
337      !
338   END SUBROUTINE tra_nxt_vvl
339
340   !!======================================================================
341END MODULE tranxt
Note: See TracBrowser for help on using the repository browser.