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

source: branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/TRA/tranxt.F90 @ 7806

Last change on this file since 7806 was 7806, checked in by cbricaud, 7 years ago

phaze dev_r5003_MERCATOR6_CRS branch with rev7805 of 3.6_stable branch
  • Property svn:keywords set to Id
File size: 26.0 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   USE crs
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   PUBLIC   tra_nxt_vvl_crs ! to be used in trcnxt
60
61   REAL(wp) ::   rbcp   ! Brown & Campana parameters for semi-implicit hpg
62
63   !! * Substitutions
64#  include "domzgr_substitute.h90"
65   !!----------------------------------------------------------------------
66   !! NEMO/OPA 3.3 , NEMO-Consortium (2010)
67   !! $Id$
68   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
69   !!----------------------------------------------------------------------
70CONTAINS
71
72   SUBROUTINE tra_nxt( kt )
73      !!----------------------------------------------------------------------
74      !!                   ***  ROUTINE tranxt  ***
75      !!
76      !! ** Purpose :   Apply the boundary condition on the after temperature 
77      !!             and salinity fields, achieved the time stepping by adding
78      !!             the Asselin filter on now fields and swapping the fields.
79      !!
80      !! ** Method  :   At this stage of the computation, ta and sa are the
81      !!             after temperature and salinity as the time stepping has
82      !!             been performed in trazdf_imp or trazdf_exp module.
83      !!
84      !!              - Apply lateral boundary conditions on (ta,sa)
85      !!             at the local domain   boundaries through lbc_lnk call,
86      !!             at the one-way open boundaries (lk_bdy=T),
87      !!             at the AGRIF zoom   boundaries (lk_agrif=T)
88      !!
89      !!              - Update lateral boundary conditions on AGRIF children
90      !!             domains (lk_agrif=T)
91      !!
92      !! ** Action  : - (tb,sb) and (tn,sn) ready for the next time step
93      !!              - (ta,sa) time averaged (t,s)   (ln_dynhpg_imp = T)
94      !!----------------------------------------------------------------------
95      INTEGER, INTENT(in) ::   kt    ! ocean time-step index
96      !!
97      INTEGER  ::   jk, jn    ! dummy loop indices
98      REAL(wp) ::   zfact     ! local scalars
99      REAL(wp), POINTER, DIMENSION(:,:,:) ::  ztrdt, ztrds
100      !!----------------------------------------------------------------------
101      !
102      IF( nn_timing == 1 )  CALL timing_start( 'tra_nxt')
103      !
104      IF( kt == nit000 ) THEN
105         IF(lwp) WRITE(numout,*)
106         IF(lwp) WRITE(numout,*) 'tra_nxt : achieve the time stepping by Asselin filter and array swap'
107         IF(lwp) WRITE(numout,*) '~~~~~~~'
108         !
109         rbcp = 0.25_wp * (1._wp + atfp) * (1._wp + atfp) * ( 1._wp - atfp)      ! Brown & Campana parameter for semi-implicit hpg
110      ENDIF
111
112      ! Update after tracer on domain lateral boundaries
113      !
114#if defined key_agrif
115      CALL Agrif_tra                     ! AGRIF zoom boundaries
116#endif
117      !
118      CALL lbc_lnk( tsa(:,:,:,jp_tem), 'T', 1._wp )      ! local domain boundaries  (T-point, unchanged sign)
119      CALL lbc_lnk( tsa(:,:,:,jp_sal), 'T', 1._wp )
120      !
121#if defined key_bdy 
122      IF( lk_bdy )   CALL bdy_tra( kt )  ! BDY open boundaries
123#endif
124 
125      ! set time step size (Euler/Leapfrog)
126      IF( neuler == 0 .AND. kt == nit000 ) THEN   ;   r2dtra(:) =     rdttra(:)      ! at nit000             (Euler)
127      ELSEIF( kt <= nit000 + 1 )           THEN   ;   r2dtra(:) = 2._wp* rdttra(:)      ! at nit000 or nit000+1 (Leapfrog)
128      ENDIF
129
130      ! trends computation initialisation
131      IF( l_trdtra )   THEN                   
132         CALL wrk_alloc( jpi, jpj, jpk, ztrdt, ztrds )
133         ztrdt(:,:,jk) = 0._wp
134         ztrds(:,:,jk) = 0._wp
135         IF( ln_traldf_iso ) THEN              ! diagnose the "pure" Kz diffusive trend
136            CALL trd_tra( kt, 'TRA', jp_tem, jptra_zdfp, ztrdt )
137            CALL trd_tra( kt, 'TRA', jp_sal, jptra_zdfp, ztrds )
138         ENDIF
139         ! total trend for the non-time-filtered variables.
140         DO jk = 1, jpkm1
141            zfact = 1.0 / rdttra(jk)
142            ztrdt(:,:,jk) = ( tsa(:,:,jk,jp_tem) - tsn(:,:,jk,jp_tem) ) * zfact 
143            ztrds(:,:,jk) = ( tsa(:,:,jk,jp_sal) - tsn(:,:,jk,jp_sal) ) * zfact 
144         END DO
145         CALL trd_tra( kt, 'TRA', jp_tem, jptra_tot, ztrdt )
146         CALL trd_tra( kt, 'TRA', jp_sal, jptra_tot, ztrds )
147         ! Store now fields before applying the Asselin filter
148         ! in order to calculate Asselin filter trend later.
149         ztrdt(:,:,:) = tsn(:,:,:,jp_tem) 
150         ztrds(:,:,:) = tsn(:,:,:,jp_sal)
151      ENDIF
152
153      IF( neuler == 0 .AND. kt == nit000 ) THEN       ! Euler time-stepping at first time-step (only swap)
154         DO jn = 1, jpts
155            DO jk = 1, jpkm1
156               tsn(:,:,jk,jn) = tsa(:,:,jk,jn)   
157            END DO
158         END DO
159      ELSE                                            ! Leap-Frog + Asselin filter time stepping
160         !
161         IF( lk_vvl )  THEN   ;   CALL tra_nxt_vvl( kt, nit000, rdttra, 'TRA', tsb, tsn, tsa,   &
162           &                                                              sbc_tsc, sbc_tsc_b, jpts )  ! variable volume level (vvl)
163         ELSE                 ;   CALL tra_nxt_fix( kt, nit000,         'TRA', tsb, tsn, tsa, jpts )  ! fixed    volume level
164         ENDIF
165      ENDIF     
166      !
167     ! trends computation
168      IF( l_trdtra ) THEN      ! trend of the Asselin filter (tb filtered - tb)/dt     
169         DO jk = 1, jpkm1
170            zfact = 1._wp / r2dtra(jk)             
171            ztrdt(:,:,jk) = ( tsb(:,:,jk,jp_tem) - ztrdt(:,:,jk) ) * zfact
172            ztrds(:,:,jk) = ( tsb(:,:,jk,jp_sal) - ztrds(:,:,jk) ) * zfact
173         END DO
174         CALL trd_tra( kt, 'TRA', jp_tem, jptra_atf, ztrdt )
175         CALL trd_tra( kt, 'TRA', jp_sal, jptra_atf, ztrds )
176         CALL wrk_dealloc( jpi, jpj, jpk, ztrdt, ztrds )
177      END IF
178      !
179      !                        ! control print
180      IF(ln_ctl)   CALL prt_ctl( tab3d_1=tsn(:,:,:,jp_tem), clinfo1=' nxt  - Tn: ', mask1=tmask,   &
181         &                       tab3d_2=tsn(:,:,:,jp_sal), clinfo2=       ' Sn: ', mask2=tmask )
182      !
183      IF( nn_timing == 1 )   CALL timing_stop('tra_nxt')
184      !
185   END SUBROUTINE tra_nxt
186
187
188   SUBROUTINE tra_nxt_fix( kt, kit000, cdtype, ptb, ptn, pta, kjpt )
189      !!----------------------------------------------------------------------
190      !!                   ***  ROUTINE tra_nxt_fix  ***
191      !!
192      !! ** Purpose :   fixed volume: apply the Asselin time filter and
193      !!                swap the tracer fields.
194      !!
195      !! ** Method  : - Apply a Asselin time filter on now fields.
196      !!              - save in (ta,sa) an average over the three time levels
197      !!             which will be used to compute rdn and thus the semi-implicit
198      !!             hydrostatic pressure gradient (ln_dynhpg_imp = T)
199      !!              - swap tracer fields to prepare the next time_step.
200      !!                This can be summurized for tempearture as:
201      !!             ztm = tn + rbcp * [ta -2 tn + tb ]       ln_dynhpg_imp = T
202      !!             ztm = 0                                   otherwise
203      !!                   with rbcp=1/4 * (1-atfp^4) / (1-atfp)
204      !!             tb  = tn + atfp*[ tb - 2 tn + ta ]
205      !!             tn  = ta 
206      !!             ta  = ztm       (NB: reset to 0 after eos_bn2 call)
207      !!
208      !! ** Action  : - (tb,sb) and (tn,sn) ready for the next time step
209      !!              - (ta,sa) time averaged (t,s)   (ln_dynhpg_imp = T)
210      !!----------------------------------------------------------------------
211      INTEGER         , INTENT(in   )                               ::   kt       ! ocean time-step index
212      INTEGER         , INTENT(in   )                               ::   kit000   ! first time step index
213      CHARACTER(len=3), INTENT(in   )                               ::   cdtype   ! =TRA or TRC (tracer indicator)
214      INTEGER         , INTENT(in   )                               ::   kjpt     ! number of tracers
215      REAL(wp)        , INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt)  ::   ptb      ! before tracer fields
216      REAL(wp)        , INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt)  ::   ptn      ! now tracer fields
217      REAL(wp)        , INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt)  ::   pta      ! tracer trend
218      !
219      INTEGER  ::   ji, jj, jk, jn   ! dummy loop indices
220      LOGICAL  ::   ll_tra_hpg       ! local logical
221      REAL(wp) ::   ztn, ztd         ! local scalars
222      !!----------------------------------------------------------------------
223
224      IF( kt == kit000 )  THEN
225         IF(lwp) WRITE(numout,*)
226         IF(lwp) WRITE(numout,*) 'tra_nxt_fix : time stepping', cdtype
227         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~'
228      ENDIF
229      !
230      IF( cdtype == 'TRA' )  THEN   ;   ll_tra_hpg = ln_dynhpg_imp    ! active  tracers case  and  semi-implicit hpg   
231      ELSE                          ;   ll_tra_hpg = .FALSE.          ! passive tracers case or NO semi-implicit hpg
232      ENDIF
233      !
234      DO jn = 1, kjpt
235         !
236         DO jk = 1, jpkm1
237            DO jj = 1, jpj
238               DO ji = 1, jpi
239                  ztn = ptn(ji,jj,jk,jn)                                   
240                  ztd = pta(ji,jj,jk,jn) - 2. * ztn + ptb(ji,jj,jk,jn)      !  time laplacian on tracers
241                  !
242                  ptb(ji,jj,jk,jn) = ztn + atfp * ztd                       ! ptb <-- filtered ptn
243                  ptn(ji,jj,jk,jn) = pta(ji,jj,jk,jn)                       ! ptn <-- pta
244                  !
245                  IF( ll_tra_hpg )   pta(ji,jj,jk,jn) = ztn + rbcp * ztd    ! pta <-- Brown & Campana average
246               END DO
247           END DO
248         END DO
249         !
250      END DO
251      !
252   END SUBROUTINE tra_nxt_fix
253
254
255   SUBROUTINE tra_nxt_vvl( kt, kit000, p2dt, cdtype, ptb, ptn, pta, psbc_tc, psbc_tc_b, kjpt )
256      !!----------------------------------------------------------------------
257      !!                   ***  ROUTINE tra_nxt_vvl  ***
258      !!
259      !! ** Purpose :   Time varying volume: apply the Asselin time filter 
260      !!                and swap the tracer fields.
261      !!
262      !! ** Method  : - Apply a thickness weighted Asselin time filter on now fields.
263      !!              - save in (ta,sa) a thickness weighted average over the three
264      !!             time levels which will be used to compute rdn and thus the semi-
265      !!             implicit hydrostatic pressure gradient (ln_dynhpg_imp = T)
266      !!              - swap tracer fields to prepare the next time_step.
267      !!                This can be summurized for tempearture as:
268      !!             ztm = ( e3t_n*tn + rbcp*[ e3t_b*tb - 2 e3t_n*tn + e3t_a*ta ] )   ln_dynhpg_imp = T
269      !!                  /( e3t_n    + rbcp*[ e3t_b    - 2 e3t_n    + e3t_a    ] )   
270      !!             ztm = 0                                                       otherwise
271      !!             tb  = ( e3t_n*tn + atfp*[ e3t_b*tb - 2 e3t_n*tn + e3t_a*ta ] )
272      !!                  /( e3t_n    + atfp*[ e3t_b    - 2 e3t_n    + e3t_a    ] )
273      !!             tn  = ta
274      !!             ta  = zt        (NB: reset to 0 after eos_bn2 call)
275      !!
276      !! ** Action  : - (tb,sb) and (tn,sn) ready for the next time step
277      !!              - (ta,sa) time averaged (t,s)   (ln_dynhpg_imp = T)
278      !!----------------------------------------------------------------------
279      INTEGER         , INTENT(in   )                               ::  kt       ! ocean time-step index
280      INTEGER         , INTENT(in   )                               ::  kit000   ! first time step index
281      REAL(wp)        , INTENT(in   ), DIMENSION(jpk)               ::  p2dt     ! time-step
282      CHARACTER(len=3), INTENT(in   )                               ::  cdtype   ! =TRA or TRC (tracer indicator)
283      INTEGER         , INTENT(in   )                               ::  kjpt     ! number of tracers
284      REAL(wp)        , INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt)  ::  ptb      ! before tracer fields
285      REAL(wp)        , INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt)  ::  ptn      ! now tracer fields
286      REAL(wp)        , INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt)  ::  pta      ! tracer trend
287      REAL(wp)        , INTENT(in   ), DIMENSION(jpi,jpj,kjpt)      ::  psbc_tc   ! surface tracer content
288      REAL(wp)        , INTENT(in   ), DIMENSION(jpi,jpj,kjpt)      ::  psbc_tc_b ! before surface tracer content
289
290      !!     
291      LOGICAL  ::   ll_tra_hpg, ll_traqsr, ll_rnf, ll_isf   ! local logical
292      INTEGER  ::   ji, jj, jk, jn              ! dummy loop indices
293      REAL(wp) ::   zfact1, ztc_a , ztc_n , ztc_b , ztc_f , ztc_d    ! local scalar
294      REAL(wp) ::   zfact2, ze3t_b, ze3t_n, ze3t_a, ze3t_f, ze3t_d   !   -      -
295      !!----------------------------------------------------------------------
296      !
297      IF( kt == kit000 )  THEN
298         IF(lwp) WRITE(numout,*)
299         IF(lwp) WRITE(numout,*) 'tra_nxt_vvl : time stepping', cdtype
300         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~'
301      ENDIF
302      !
303      IF( cdtype == 'TRA' )  THEN   
304         ll_tra_hpg = ln_dynhpg_imp    ! active  tracers case  and  semi-implicit hpg
305         ll_traqsr  = ln_traqsr        ! active  tracers case  and  solar penetration
306         ll_rnf     = ln_rnf           ! active  tracers case  and  river runoffs
307         IF (nn_isf .GE. 1) THEN
308            ll_isf = .TRUE.            ! active  tracers case  and  ice shelf melting/freezing
309         ELSE
310            ll_isf = .FALSE.
311         END IF
312      ELSE                         
313         ll_tra_hpg = .FALSE.          ! passive tracers case or NO semi-implicit hpg
314         ll_traqsr  = .FALSE.          ! active  tracers case and NO solar penetration
315         ll_rnf     = .FALSE.          ! passive tracers or NO river runoffs
316         ll_isf     = .FALSE.          ! passive tracers or NO ice shelf melting/freezing
317      ENDIF
318      !
319      DO jn = 1, kjpt     
320         DO jk = 1, jpkm1
321            zfact1 = atfp * p2dt(jk)
322            zfact2 = zfact1 / rau0
323            DO jj = 1, jpj
324               DO ji = 1, jpi
325                  ze3t_b = fse3t_b(ji,jj,jk)
326                  ze3t_n = fse3t_n(ji,jj,jk)
327                  ze3t_a = fse3t_a(ji,jj,jk)
328                  !                                         ! tracer content at Before, now and after
329                  ztc_b  = ptb(ji,jj,jk,jn) * ze3t_b
330                  ztc_n  = ptn(ji,jj,jk,jn) * ze3t_n
331                  ztc_a  = pta(ji,jj,jk,jn) * ze3t_a
332                  !
333                  ze3t_d = ze3t_a - 2. * ze3t_n + ze3t_b
334                  ztc_d  = ztc_a  - 2. * ztc_n  + ztc_b
335                  !
336                  ze3t_f = ze3t_n + atfp * ze3t_d
337                  ztc_f  = ztc_n  + atfp * ztc_d
338                  !
339                  IF( jk == mikt(ji,jj) ) THEN           ! first level
340                     ze3t_f = ze3t_f - zfact2 * ( (emp_b(ji,jj)    - emp(ji,jj)   )  &
341                            &                   - (rnf_b(ji,jj)    - rnf(ji,jj)   )  &
342                            &                   + (fwfisf_b(ji,jj) - fwfisf(ji,jj))  )
343                     ztc_f  = ztc_f  - zfact1 * ( psbc_tc(ji,jj,jn) - psbc_tc_b(ji,jj,jn) )
344                  ENDIF
345
346                  ! solar penetration (temperature only)
347                  IF( ll_traqsr .AND. jn == jp_tem .AND. jk <= nksr )                            & 
348                     &     ztc_f  = ztc_f  - zfact1 * ( qsr_hc(ji,jj,jk) - qsr_hc_b(ji,jj,jk) ) 
349
350                  ! river runoff
351                  IF( ll_rnf .AND. jk <= nk_rnf(ji,jj) )                                          &
352                     &     ztc_f  = ztc_f  - zfact1 * ( rnf_tsc(ji,jj,jn) - rnf_tsc_b(ji,jj,jn) ) & 
353                     &                              * fse3t_n(ji,jj,jk) / h_rnf(ji,jj)
354
355                  ! ice shelf
356                  IF( ll_isf ) THEN
357                     ! level fully include in the Losch_2008 ice shelf boundary layer
358                     IF ( jk >= misfkt(ji,jj) .AND. jk < misfkb(ji,jj) )                          &
359                        ztc_f  = ztc_f  - zfact1 * ( risf_tsc(ji,jj,jn) - risf_tsc_b(ji,jj,jn) )  &
360                               &                 * fse3t_n(ji,jj,jk) * r1_hisf_tbl (ji,jj)
361                     ! level partially include in Losch_2008 ice shelf boundary layer
362                     IF ( jk == misfkb(ji,jj) )                                                   &
363                        ztc_f  = ztc_f  - zfact1 * ( risf_tsc(ji,jj,jn) - risf_tsc_b(ji,jj,jn) )  &
364                               &                 * fse3t_n(ji,jj,jk) * r1_hisf_tbl (ji,jj) * ralpha(ji,jj)
365                  END IF
366
367                  ze3t_f = 1.e0 / ze3t_f
368                  ptb(ji,jj,jk,jn) = ztc_f * ze3t_f       ! ptb <-- ptn filtered
369                  ptn(ji,jj,jk,jn) = pta(ji,jj,jk,jn)     ! ptn <-- pta
370                  !
371                  IF( ll_tra_hpg ) THEN        ! semi-implicit hpg (T & S only)
372                     ze3t_d           = 1.e0   / ( ze3t_n + rbcp * ze3t_d )
373                     pta(ji,jj,jk,jn) = ze3t_d * ( ztc_n  + rbcp * ztc_d  )   ! ta <-- Brown & Campana average
374                  ENDIF
375               END DO
376            END DO
377         END DO
378         !
379      END DO
380      !
381   END SUBROUTINE tra_nxt_vvl
382
383  SUBROUTINE tra_nxt_vvl_crs( kt, kit000, p2dt, cdtype, ptb, ptn, pta, psbc_tc, psbc_tc_b, kjpt )
384      !!----------------------------------------------------------------------
385      !!                   ***  ROUTINE tra_nxt_vvl  ***
386      !!
387      !! ** Purpose :   Time varying volume: apply the Asselin time filter 
388      !!                and swap the tracer fields.
389      !!
390      !! ** Method  : - Apply a thickness weighted Asselin time filter on now fields.
391      !!              - save in (ta,sa) a thickness weighted average over the three
392      !!             time levels which will be used to compute rdn and thus the semi-
393      !!             implicit hydrostatic pressure gradient (ln_dynhpg_imp = T)
394      !!              - swap tracer fields to prepare the next time_step.
395      !!                This can be summurized for tempearture as:
396      !!             ztm = ( e3t_n*tn + rbcp*[ e3t_b*tb - 2 e3t_n*tn + e3t_a*ta ] )   ln_dynhpg_imp = T
397      !!                  /( e3t_n    + rbcp*[ e3t_b    - 2 e3t_n    + e3t_a    ] )   
398      !!             ztm = 0                                                       otherwise
399      !!             tb  = ( e3t_n*tn + atfp*[ e3t_b*tb - 2 e3t_n*tn + e3t_a*ta ] )
400      !!                  /( e3t_n    + atfp*[ e3t_b    - 2 e3t_n    + e3t_a    ] )
401      !!             tn  = ta
402      !!             ta  = zt        (NB: reset to 0 after eos_bn2 call)
403      !!
404      !! ** Action  : - (tb,sb) and (tn,sn) ready for the next time step
405      !!              - (ta,sa) time averaged (t,s)   (ln_dynhpg_imp = T)
406      !!----------------------------------------------------------------------
407      INTEGER         , INTENT(in   )                               ::  kt       ! ocean time-step index
408      INTEGER         , INTENT(in   )                               ::  kit000   ! first time step index
409      REAL(wp)        , INTENT(in   ), DIMENSION(jpk)               ::  p2dt     ! time-step
410      CHARACTER(len=3), INTENT(in   )                               ::  cdtype   ! =TRA or TRC (tracer indicator)
411      INTEGER         , INTENT(in   )                               ::  kjpt     ! number of tracers
412      REAL(wp)        , INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt)  ::  ptb      ! before tracer fields
413      REAL(wp)        , INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt)  ::  ptn      ! now tracer fields
414      REAL(wp)        , INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt)  ::  pta      ! tracer trend
415      REAL(wp)        , INTENT(in   ), DIMENSION(jpi,jpj,kjpt)      ::  psbc_tc   ! surface tracer content
416      REAL(wp)        , INTENT(in   ), DIMENSION(jpi,jpj,kjpt)      ::  psbc_tc_b ! before surface tracer content
417
418      !!     
419      LOGICAL  ::   ll_tra_hpg, ll_traqsr, ll_rnf   ! local logical
420      INTEGER  ::   ji, jj, jk, jn              ! dummy loop indices
421      REAL(wp) ::   zfact1, ztc_a , ztc_n , ztc_b , ztc_f , ztc_d    ! local scalar
422      REAL(wp) ::   zfact2, ze3t_b, ze3t_n, ze3t_a, ze3t_f, ze3t_d   !   -      -
423      !!----------------------------------------------------------------------
424      !!----------------------------------------------------------------------
425      !
426      IF( kt == kit000 )  THEN
427         IF(lwp) WRITE(numout,*)
428         IF(lwp) WRITE(numout,*) 'tra_nxt_vvl : time stepping', cdtype
429         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~'
430      ENDIF
431      !
432      IF( cdtype == 'TRA' )  THEN
433         ll_tra_hpg = ln_dynhpg_imp    ! active  tracers case  and  semi-implicit hpg
434         ll_traqsr  = ln_traqsr        ! active  tracers case  and  solar penetration
435         ll_rnf     = ln_rnf           ! active  tracers case  and  river runoffs
436      ELSE
437         ll_tra_hpg = .FALSE.          ! passive tracers case or NO semi-implicit hpg
438         ll_traqsr  = .FALSE.          ! active  tracers case and NO solar penetration
439         ll_rnf     = .FALSE.          ! passive tracers or NO river runoffs
440      ENDIF
441      !
442      DO jn = 1, kjpt
443         DO jk = 1, jpkm1
444            zfact1 = atfp * p2dt(jk)
445            zfact2 = zfact1 / rau0
446            DO jj = 1, jpj
447               DO ji = 1, jpi
448                  ze3t_b = fse3t_b_crs(ji,jj,jk)
449                  ze3t_n = fse3t_n_crs(ji,jj,jk)
450                  ze3t_a = fse3t_a_crs(ji,jj,jk)
451                  !                                         ! tracer content at Before, now and after
452                  ztc_b  = ptb(ji,jj,jk,jn) * ze3t_b
453                  ztc_n  = ptn(ji,jj,jk,jn) * ze3t_n
454                  ztc_a  = pta(ji,jj,jk,jn) * ze3t_a
455                  !
456                  ze3t_d = ze3t_a - 2. * ze3t_n + ze3t_b
457                  ztc_d  = ztc_a  - 2. * ztc_n  + ztc_b
458                  !
459                  ze3t_f = ze3t_n + atfp * ze3t_d
460                  ztc_f  = ztc_n  + atfp * ztc_d
461                  !
462                  IF( jk == 1 ) THEN           ! first level
463                     ze3t_f = ze3t_f - zfact2 * ( emp_b_crs(ji,jj) - emp_crs(ji,jj) + rnf_crs(ji,jj) - rnf_b_crs(ji,jj) )
464                     ztc_f  = ztc_f  - zfact1 * ( psbc_tc(ji,jj,jn) - psbc_tc_b(ji,jj,jn) )
465                  ENDIF
466!cbr as it is a subroutine dedicated to crs, TRA options are not necessary
467!cbr                  IF( ll_traqsr .AND. jn == jp_tem .AND. jk <= nksr )   &     ! solar penetration (temperature only)
468!cbr                     &     ztc_f  = ztc_f  - zfact1 * ( qsr_hc(ji,jj,jk) - qsr_hc_b(ji,jj,jk) )
469!cbr
470!cbr                  IF( ll_rnf .AND. jk <= nk_rnf(ji,jj) )   &                  ! river runoffs
471!cbr                     &     ztc_f  = ztc_f  - zfact1 * ( rnf_tsc(ji,jj,jn) - rnf_tsc_b(ji,jj,jn) ) &
472!cbr                     &                              * fse3t_n(ji,jj,jk) / h_rnf(ji,jj)
473
474                  ze3t_f = 1.e0 / ze3t_f
475                  ptb(ji,jj,jk,jn) = ztc_f * ze3t_f       ! ptb <-- ptn filtered
476                  ptn(ji,jj,jk,jn) = pta(ji,jj,jk,jn)     ! ptn <-- pta
477                  !
478                  IF( ll_tra_hpg ) THEN        ! semi-implicit hpg (T & S only)
479                     ze3t_d           = 1.e0   / ( ze3t_n + rbcp * ze3t_d )
480                     pta(ji,jj,jk,jn) = ze3t_d * ( ztc_n  + rbcp * ztc_d  )   ! ta <-- Brown & Campana average
481                  ENDIF
482               END DO
483            END DO
484         END DO
485         !
486      END DO
487      !
488   END SUBROUTINE tra_nxt_vvl_crs
489
490
491   !!======================================================================
492END MODULE tranxt
Note: See TracBrowser for help on using the repository browser.