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

source: trunk/NEMOGCM/NEMO/OPA_SRC/TRA/tranxt.F90 @ 5836

Last change on this file since 5836 was 5836, checked in by cetlod, 8 years ago

merge the simplification branch onto the trunk, see ticket #1612

  • Property svn:keywords set to Id
File size: 19.2 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          ! lateral physics on tracers
40   USE ldfslp
41   USE bdy_oce         ! BDY open boundary condition variables
42   USE bdytra          ! open boundary condition (bdy_tra routine)
43   !
44   USE in_out_manager  ! I/O manager
45   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
46   USE prtctl          ! Print control
47   USE wrk_nemo        ! Memory allocation
48   USE timing          ! Timing
49#if defined key_agrif
50   USE agrif_opa_interp
51#endif
52
53   IMPLICIT NONE
54   PRIVATE
55
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
59
60   REAL(wp) ::   rbcp   ! Brown & Campana parameters for semi-implicit hpg
61
62   !! * Substitutions
63#  include "domzgr_substitute.h90"
64   !!----------------------------------------------------------------------
65   !! NEMO/OPA 3.3 , NEMO-Consortium (2010)
66   !! $Id$
67   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
68   !!----------------------------------------------------------------------
69CONTAINS
70
71   SUBROUTINE tra_nxt( kt )
72      !!----------------------------------------------------------------------
73      !!                   ***  ROUTINE tranxt  ***
74      !!
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.
78      !!
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.
82      !!
83      !!              - Apply lateral boundary conditions on (ta,sa)
84      !!             at the local domain   boundaries through lbc_lnk call,
85      !!             at the one-way open boundaries (lk_bdy=T),
86      !!             at the AGRIF zoom   boundaries (lk_agrif=T)
87      !!
88      !!              - Update lateral boundary conditions on AGRIF children
89      !!             domains (lk_agrif=T)
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)
93      !!----------------------------------------------------------------------
94      INTEGER, INTENT(in) ::   kt    ! ocean time-step index
95      !!
96      INTEGER  ::   jk, jn    ! dummy loop indices
97      REAL(wp) ::   zfact     ! local scalars
98      REAL(wp), POINTER, DIMENSION(:,:,:) ::  ztrdt, ztrds
99      !!----------------------------------------------------------------------
100      !
101      IF( nn_timing == 1 )  CALL timing_start( 'tra_nxt')
102      !
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,*) '~~~~~~~'
107         !
108         rbcp = 0.25_wp * (1._wp + atfp) * (1._wp + atfp) * ( 1._wp - atfp)      ! Brown & Campana parameter for semi-implicit hpg
109      ENDIF
110
111      ! Update after tracer on domain lateral boundaries
112      !
113#if defined key_agrif
114      CALL Agrif_tra                     ! AGRIF zoom boundaries
115#endif
116      !
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 )
119      !
120#if defined key_bdy 
121      IF( lk_bdy )   CALL bdy_tra( kt )  ! BDY open boundaries
122#endif
123 
124      ! set time step size (Euler/Leapfrog)
125      IF( neuler == 0 .AND. kt == nit000 ) THEN   ;   r2dtra(:) =     rdttra(:)      ! at nit000             (Euler)
126      ELSEIF( kt <= nit000 + 1 )           THEN   ;   r2dtra(:) = 2._wp* rdttra(:)      ! at nit000 or nit000+1 (Leapfrog)
127      ENDIF
128
129      ! trends computation initialisation
130      IF( l_trdtra )   THEN                    ! store now fields before applying the Asselin filter
131         CALL wrk_alloc( jpi, jpj, jpk, ztrdt, ztrds )
132         ztrdt(:,:,:) = tsn(:,:,:,jp_tem) 
133         ztrds(:,:,:) = tsn(:,:,:,jp_sal)
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
138      ENDIF
139
140      IF( neuler == 0 .AND. kt == nit000 ) THEN       ! Euler time-stepping at first time-step (only swap)
141         DO jn = 1, jpts
142            DO jk = 1, jpkm1
143               tsn(:,:,jk,jn) = tsa(:,:,jk,jn)   
144            END DO
145         END DO
146      ELSE                                            ! Leap-Frog + Asselin filter time stepping
147         !
148         IF( lk_vvl )  THEN   ;   CALL tra_nxt_vvl( kt, nit000, rdttra, 'TRA', tsb, tsn, tsa,   &
149           &                                                              sbc_tsc, sbc_tsc_b, jpts )  ! variable volume level (vvl)
150         ELSE                 ;   CALL tra_nxt_fix( kt, nit000,         'TRA', tsb, tsn, tsa, jpts )  ! fixed    volume level
151         ENDIF
152      ENDIF     
153      !
154      ! trends computation
155      IF( l_trdtra ) THEN      ! trend of the Asselin filter (tb filtered - tb)/dt     
156         DO jk = 1, jpkm1
157            zfact = 1._wp / r2dtra(jk)             
158            ztrdt(:,:,jk) = ( tsb(:,:,jk,jp_tem) - ztrdt(:,:,jk) ) * zfact
159            ztrds(:,:,jk) = ( tsb(:,:,jk,jp_sal) - ztrds(:,:,jk) ) * zfact
160         END DO
161         CALL trd_tra( kt, 'TRA', jp_tem, jptra_atf, ztrdt )
162         CALL trd_tra( kt, 'TRA', jp_sal, jptra_atf, ztrds )
163         CALL wrk_dealloc( jpi, jpj, jpk, ztrdt, ztrds )
164      END IF
165      !
166      !                        ! control print
167      IF(ln_ctl)   CALL prt_ctl( tab3d_1=tsn(:,:,:,jp_tem), clinfo1=' nxt  - Tn: ', mask1=tmask,   &
168         &                       tab3d_2=tsn(:,:,:,jp_sal), clinfo2=       ' Sn: ', mask2=tmask )
169      !
170      IF( nn_timing == 1 )   CALL timing_stop('tra_nxt')
171      !
172   END SUBROUTINE tra_nxt
173
174
175   SUBROUTINE tra_nxt_fix( kt, kit000, cdtype, ptb, ptn, pta, kjpt )
176      !!----------------------------------------------------------------------
177      !!                   ***  ROUTINE tra_nxt_fix  ***
178      !!
179      !! ** Purpose :   fixed volume: apply the Asselin time filter and
180      !!                swap the tracer fields.
181      !!
182      !! ** Method  : - Apply a Asselin time filter on now fields.
183      !!              - save in (ta,sa) an average over the three time levels
184      !!             which will be used to compute rdn and thus the semi-implicit
185      !!             hydrostatic pressure gradient (ln_dynhpg_imp = T)
186      !!              - swap tracer fields to prepare the next time_step.
187      !!                This can be summurized for tempearture as:
188      !!             ztm = tn + rbcp * [ta -2 tn + tb ]       ln_dynhpg_imp = T
189      !!             ztm = 0                                   otherwise
190      !!                   with rbcp=1/4 * (1-atfp^4) / (1-atfp)
191      !!             tb  = tn + atfp*[ tb - 2 tn + ta ]
192      !!             tn  = ta 
193      !!             ta  = ztm       (NB: reset to 0 after eos_bn2 call)
194      !!
195      !! ** Action  : - (tb,sb) and (tn,sn) ready for the next time step
196      !!              - (ta,sa) time averaged (t,s)   (ln_dynhpg_imp = T)
197      !!----------------------------------------------------------------------
198      INTEGER         , INTENT(in   )                               ::   kt       ! ocean time-step index
199      INTEGER         , INTENT(in   )                               ::   kit000   ! first time step index
200      CHARACTER(len=3), INTENT(in   )                               ::   cdtype   ! =TRA or TRC (tracer indicator)
201      INTEGER         , INTENT(in   )                               ::   kjpt     ! number of tracers
202      REAL(wp)        , INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt)  ::   ptb      ! before tracer fields
203      REAL(wp)        , INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt)  ::   ptn      ! now tracer fields
204      REAL(wp)        , INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt)  ::   pta      ! tracer trend
205      !
206      INTEGER  ::   ji, jj, jk, jn   ! dummy loop indices
207      LOGICAL  ::   ll_tra_hpg       ! local logical
208      REAL(wp) ::   ztn, ztd         ! local scalars
209      !!----------------------------------------------------------------------
210
211      IF( kt == kit000 )  THEN
212         IF(lwp) WRITE(numout,*)
213         IF(lwp) WRITE(numout,*) 'tra_nxt_fix : time stepping', cdtype
214         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~'
215      ENDIF
216      !
217      IF( cdtype == 'TRA' )  THEN   ;   ll_tra_hpg = ln_dynhpg_imp    ! active  tracers case  and  semi-implicit hpg   
218      ELSE                          ;   ll_tra_hpg = .FALSE.          ! passive tracers case or NO semi-implicit hpg
219      ENDIF
220      !
221      DO jn = 1, kjpt
222         !
223         DO jk = 1, jpkm1
224            DO jj = 1, jpj
225               DO ji = 1, jpi
226                  ztn = ptn(ji,jj,jk,jn)                                   
227                  ztd = pta(ji,jj,jk,jn) - 2. * 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                  !
232                  IF( ll_tra_hpg )   pta(ji,jj,jk,jn) = ztn + rbcp * ztd    ! pta <-- Brown & Campana average
233               END DO
234           END DO
235         END DO
236         !
237      END DO
238      !
239   END SUBROUTINE tra_nxt_fix
240
241
242   SUBROUTINE tra_nxt_vvl( kt, kit000, p2dt, cdtype, ptb, ptn, pta, psbc_tc, psbc_tc_b, kjpt )
243      !!----------------------------------------------------------------------
244      !!                   ***  ROUTINE tra_nxt_vvl  ***
245      !!
246      !! ** Purpose :   Time varying volume: apply the Asselin time filter 
247      !!                and swap the tracer fields.
248      !!
249      !! ** Method  : - Apply a thickness weighted Asselin time filter on now fields.
250      !!              - save in (ta,sa) a thickness weighted average over the three
251      !!             time levels which will be used to compute rdn and thus the semi-
252      !!             implicit hydrostatic pressure gradient (ln_dynhpg_imp = T)
253      !!              - swap tracer fields to prepare the next time_step.
254      !!                This can be summurized for tempearture as:
255      !!             ztm = ( e3t_n*tn + rbcp*[ e3t_b*tb - 2 e3t_n*tn + e3t_a*ta ] )   ln_dynhpg_imp = T
256      !!                  /( e3t_n    + rbcp*[ e3t_b    - 2 e3t_n    + e3t_a    ] )   
257      !!             ztm = 0                                                       otherwise
258      !!             tb  = ( e3t_n*tn + atfp*[ e3t_b*tb - 2 e3t_n*tn + e3t_a*ta ] )
259      !!                  /( e3t_n    + atfp*[ e3t_b    - 2 e3t_n    + e3t_a    ] )
260      !!             tn  = ta
261      !!             ta  = zt        (NB: reset to 0 after eos_bn2 call)
262      !!
263      !! ** Action  : - (tb,sb) and (tn,sn) ready for the next time step
264      !!              - (ta,sa) time averaged (t,s)   (ln_dynhpg_imp = T)
265      !!----------------------------------------------------------------------
266      INTEGER         , INTENT(in   )                               ::  kt       ! ocean time-step index
267      INTEGER         , INTENT(in   )                               ::  kit000   ! first time step index
268      REAL(wp)        , INTENT(in   ), DIMENSION(jpk)               ::  p2dt     ! time-step
269      CHARACTER(len=3), INTENT(in   )                               ::  cdtype   ! =TRA or TRC (tracer indicator)
270      INTEGER         , INTENT(in   )                               ::  kjpt     ! number of tracers
271      REAL(wp)        , INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt)  ::  ptb      ! before tracer fields
272      REAL(wp)        , INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt)  ::  ptn      ! now tracer fields
273      REAL(wp)        , INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt)  ::  pta      ! tracer trend
274      REAL(wp)        , INTENT(in   ), DIMENSION(jpi,jpj,kjpt)      ::  psbc_tc   ! surface tracer content
275      REAL(wp)        , INTENT(in   ), DIMENSION(jpi,jpj,kjpt)      ::  psbc_tc_b ! before surface tracer content
276
277      !!     
278      LOGICAL  ::   ll_tra_hpg, ll_traqsr, ll_rnf, ll_isf   ! local logical
279      INTEGER  ::   ji, jj, jk, jn              ! dummy loop indices
280      REAL(wp) ::   zfact1, ztc_a , ztc_n , ztc_b , ztc_f , ztc_d    ! local scalar
281      REAL(wp) ::   zfact2, ze3t_b, ze3t_n, ze3t_a, ze3t_f, ze3t_d   !   -      -
282      !!----------------------------------------------------------------------
283      !
284      IF( kt == kit000 )  THEN
285         IF(lwp) WRITE(numout,*)
286         IF(lwp) WRITE(numout,*) 'tra_nxt_vvl : time stepping', cdtype
287         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~'
288      ENDIF
289      !
290      IF( cdtype == 'TRA' )  THEN   
291         ll_tra_hpg = ln_dynhpg_imp    ! active  tracers case  and  semi-implicit hpg
292         ll_traqsr  = ln_traqsr        ! active  tracers case  and  solar penetration
293         ll_rnf     = ln_rnf           ! active  tracers case  and  river runoffs
294         IF (nn_isf .GE. 1) THEN
295            ll_isf = .TRUE.            ! active  tracers case  and  ice shelf melting/freezing
296         ELSE
297            ll_isf = .FALSE.
298         END IF
299      ELSE                         
300         ll_tra_hpg = .FALSE.          ! passive tracers case or NO semi-implicit hpg
301         ll_traqsr  = .FALSE.          ! active  tracers case and NO solar penetration
302         ll_rnf     = .FALSE.          ! passive tracers or NO river runoffs
303         ll_isf     = .FALSE.          ! passive tracers or NO ice shelf melting/freezing
304      ENDIF
305      !
306      DO jn = 1, kjpt     
307         DO jk = 1, jpkm1
308            zfact1 = atfp * p2dt(jk)
309            zfact2 = zfact1 / rau0
310            DO jj = 1, jpj
311               DO ji = 1, jpi
312                  ze3t_b = fse3t_b(ji,jj,jk)
313                  ze3t_n = fse3t_n(ji,jj,jk)
314                  ze3t_a = fse3t_a(ji,jj,jk)
315                  !                                         ! tracer content at Before, now and after
316                  ztc_b  = ptb(ji,jj,jk,jn) * ze3t_b
317                  ztc_n  = ptn(ji,jj,jk,jn) * ze3t_n
318                  ztc_a  = pta(ji,jj,jk,jn) * ze3t_a
319                  !
320                  ze3t_d = ze3t_a - 2. * ze3t_n + ze3t_b
321                  ztc_d  = ztc_a  - 2. * ztc_n  + ztc_b
322                  !
323                  ze3t_f = ze3t_n + atfp * ze3t_d
324                  ztc_f  = ztc_n  + atfp * ztc_d
325                  !
326                  IF( jk == mikt(ji,jj) ) THEN           ! first level
327                     ze3t_f = ze3t_f - zfact2 * ( (emp_b(ji,jj)    - emp(ji,jj)   )  &
328                            &                   - (rnf_b(ji,jj)    - rnf(ji,jj)   )  &
329                            &                   + (fwfisf_b(ji,jj) - fwfisf(ji,jj))  )
330                     ztc_f  = ztc_f  - zfact1 * ( psbc_tc(ji,jj,jn) - psbc_tc_b(ji,jj,jn) )
331                  ENDIF
332
333                  ! solar penetration (temperature only)
334                  IF( ll_traqsr .AND. jn == jp_tem .AND. jk <= nksr )                            & 
335                     &     ztc_f  = ztc_f  - zfact1 * ( qsr_hc(ji,jj,jk) - qsr_hc_b(ji,jj,jk) ) 
336
337                  ! river runoff
338                  IF( ll_rnf .AND. jk <= nk_rnf(ji,jj) )                                          &
339                     &     ztc_f  = ztc_f  - zfact1 * ( rnf_tsc(ji,jj,jn) - rnf_tsc_b(ji,jj,jn) ) & 
340                     &                              * fse3t_n(ji,jj,jk) / h_rnf(ji,jj)
341
342                  ! ice shelf
343                  IF( ll_isf ) THEN
344                     ! level fully include in the Losch_2008 ice shelf boundary layer
345                     IF ( jk >= misfkt(ji,jj) .AND. jk < misfkb(ji,jj) )                          &
346                        ztc_f  = ztc_f  - zfact1 * ( risf_tsc(ji,jj,jn) - risf_tsc_b(ji,jj,jn) )  &
347                               &                 * fse3t_n(ji,jj,jk) * r1_hisf_tbl (ji,jj)
348                     ! level partially include in Losch_2008 ice shelf boundary layer
349                     IF ( jk == misfkb(ji,jj) )                                                   &
350                        ztc_f  = ztc_f  - zfact1 * ( risf_tsc(ji,jj,jn) - risf_tsc_b(ji,jj,jn) )  &
351                               &                 * fse3t_n(ji,jj,jk) * r1_hisf_tbl (ji,jj) * ralpha(ji,jj)
352                  END IF
353
354                  ze3t_f = 1.e0 / ze3t_f
355                  ptb(ji,jj,jk,jn) = ztc_f * ze3t_f       ! ptb <-- ptn filtered
356                  ptn(ji,jj,jk,jn) = pta(ji,jj,jk,jn)     ! ptn <-- pta
357                  !
358                  IF( ll_tra_hpg ) THEN        ! semi-implicit hpg (T & S only)
359                     ze3t_d           = 1.e0   / ( ze3t_n + rbcp * ze3t_d )
360                     pta(ji,jj,jk,jn) = ze3t_d * ( ztc_n  + rbcp * ztc_d  )   ! ta <-- Brown & Campana average
361                  ENDIF
362               END DO
363            END DO
364         END DO
365         !
366      END DO
367      !
368   END SUBROUTINE tra_nxt_vvl
369
370   !!======================================================================
371END MODULE tranxt
Note: See TracBrowser for help on using the repository browser.