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

source: branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/TRA/tranxt.F90 @ 5916

Last change on this file since 5916 was 5916, checked in by acc, 8 years ago

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