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

source: branches/r6232_hadgem3_cplfld/NEMOGCM/NEMO/OPA_SRC/TRA/tranxt.F90 @ 7462

Last change on this file since 7462 was 7462, checked in by jcastill, 7 years ago

Remove svn keys

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