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

source: branches/nemo_v3_3_beta/NEMOGCM/NEMO/OPA_SRC/TRA/tranxt.F90 @ 2257

Last change on this file since 2257 was 2257, checked in by cetlod, 14 years ago

Apply the modified leap-frog scheme on runoff & correct a bug on time stepping for hpg implicit case
  • Property svn:eol-style set to native
  • Property svn:keywords set to Id
File size: 16.8 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 zdf_oce         ! ???
30   USE domvvl          ! variable volume
31   USE dynspg_oce      ! surface     pressure gradient variables
32   USE dynhpg          ! hydrostatic pressure gradient
33   USE trdmod_oce      ! ocean space and time domain variables
34   USE trdtra          ! ocean active tracers trends
35   USE phycst
36   USE obc_oce
37   USE obctra          ! open boundary condition (obc_tra routine)
38   USE bdytra          ! Unstructured open boundary condition (bdy_tra routine)
39   USE in_out_manager  ! I/O manager
40   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
41   USE prtctl          ! Print control
42   USE traqsr          ! penetrative solar radiation (needed for nksr)
43   USE traswp          ! swap array
44   USE obc_oce 
45#if defined key_agrif
46   USE agrif_opa_update
47   USE agrif_opa_interp
48#endif
49
50   IMPLICIT NONE
51   PRIVATE
52
53   PUBLIC   tra_nxt       ! routine called by step.F90
54   PUBLIC   tra_nxt_fix   ! to be used in trcnxt
55   PUBLIC   tra_nxt_vvl   ! to be used in trcnxt
56
57   REAL(wp)                 ::   rbcp            ! Brown & Campana parameters for semi-implicit hpg
58   REAL(wp), DIMENSION(jpk) ::   r2dt   ! vertical profile time step, =2*rdttra (leapfrog) or =rdttra (Euler)
59   LOGICAL  :: l_tra           ! active tracers or passive tracers
60
61   !! * Substitutions
62#  include "domzgr_substitute.h90"
63   !!----------------------------------------------------------------------
64   !! NEMO/OPA 3.3 , LOCEAN-IPSL (2010)
65   !! $Id$
66   !! Software governed by the CeCILL licence  (NEMOGCM/License_CeCILL.txt)
67   !!----------------------------------------------------------------------
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 radiative open boundaries (lk_obc=T),
86      !!             at the relaxed   open boundaries (lk_bdy=T), and
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), DIMENSION(:,:,:), ALLOCATABLE ::  ztrdt, ztrds
100      !!----------------------------------------------------------------------
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 * (1. + atfp) * (1. + atfp) * ( 1. - atfp)       ! Brown & Campana parameter for semi-implicit hpg
108      ENDIF
109
110      ! Update after tracer on domain lateral boundaries
111      !
112      CALL lbc_lnk( tsa(:,:,:,jp_tem), 'T', 1. )      ! local domain boundaries  (T-point, unchanged sign)
113      CALL lbc_lnk( tsa(:,:,:,jp_sal), 'T', 1. )
114      !
115#if defined key_obc || defined key_bdy || defined key_agrif
116      CALL tra_unswap
117#endif
118
119#if defined key_obc 
120      IF( lk_obc )   CALL obc_tra( kt )  ! OBC open boundaries
121#endif
122#if defined key_bdy 
123      IF( lk_bdy )   CALL bdy_tra( kt )  ! BDY open boundaries
124#endif
125#if defined key_agrif
126      CALL Agrif_tra                   ! AGRIF zoom boundaries
127#endif
128
129#if defined key_obc || defined key_bdy || defined key_agrif
130      CALL tra_swap
131#endif
132 
133      ! set time step size (Euler/Leapfrog)
134      IF( neuler == 0 .AND. kt == nit000 ) THEN   ;   r2dt(:) =     rdttra(:)      ! at nit000             (Euler)
135      ELSEIF( kt <= nit000 + 1 )           THEN   ;   r2dt(:) = 2.* rdttra(:)      ! at nit000 or nit000+1 (Leapfrog)
136      ENDIF
137
138      ! trends computation initialisation
139      IF( l_trdtra )   THEN                    !* store now fields before applying the Asselin filter
140         ALLOCATE( ztrdt(jpi,jpj,jpk) )   ;    ztrdt(:,:,:) = tsn(:,:,:,jp_tem) 
141         ALLOCATE( ztrds(jpi,jpj,jpk) )   ;    ztrds(:,:,:) = tsn(:,:,:,jp_sal)
142      ENDIF
143
144      ! Leap-Frog + Asselin filter time stepping
145      IF( neuler == 0 .AND. kt == nit000 ) THEN        ! Euler time-stepping at first time-step
146         !                                             ! (only swap)
147         DO jn = 1, jpts
148            DO jk = 1, jpkm1
149               tsn(:,:,jk,jn) = tsa(:,:,jk,jn)   
150            END DO
151         END DO
152         !                                             
153      ELSE
154         IF( lk_vvl )  THEN   ;   CALL tra_nxt_vvl( kt, 'TRA', tsb, tsn, tsa, jpts )  ! variable volume level (vvl)     
155         ELSE                 ;   CALL tra_nxt_fix( kt, 'TRA', tsb, tsn, tsa, jpts )  ! fixed    volume level
156         ENDIF
157      ENDIF 
158
159#if defined key_agrif
160      CALL tra_unswap
161      ! Update tracer at AGRIF zoom boundaries
162      IF( .NOT.Agrif_Root() )    CALL Agrif_Update_Tra( kt )      ! children only
163      CALL tra_swap
164#endif     
165
166      ! trends computation
167      IF( l_trdtra ) THEN              ! trend of the Asselin filter (tb filtered - tb)/dt     
168         DO jk = 1, jpkm1
169            zfact = 1.e0 / r2dt(jk)             
170            ztrdt(:,:,jk) = ( tsb(:,:,jk,jp_tem) - ztrdt(:,:,jk) ) * zfact
171            ztrds(:,:,jk) = ( tsb(:,:,jk,jp_sal) - ztrds(:,:,jk) ) * zfact
172         END DO
173         CALL trd_tra( kt, 'TRA', jp_tem, jptra_trd_atf, ztrdt )
174         CALL trd_tra( kt, 'TRA', jp_sal, jptra_trd_atf, ztrds )
175         DEALLOCATE( ztrdt )      ;     DEALLOCATE( ztrds ) 
176      END IF
177
178      !                        ! control print
179      IF(ln_ctl)   CALL prt_ctl( tab3d_1=tsn(:,:,:,jp_tem), clinfo1=' nxt  - Tn: ', mask1=tmask,   &
180         &                       tab3d_2=tsn(:,:,:,jp_sal), clinfo2=       ' Sn: ', mask2=tmask )
181      !
182   END SUBROUTINE tra_nxt
183
184
185   SUBROUTINE tra_nxt_fix( kt, cdtype, ptb, ptn, pta, kjpt )
186      !!----------------------------------------------------------------------
187      !!                   ***  ROUTINE tra_nxt_fix  ***
188      !!
189      !! ** Purpose :   fixed volume: apply the Asselin time filter and
190      !!                swap the tracer fields.
191      !!
192      !! ** Method  : - Apply a Asselin time filter on now fields.
193      !!              - save in (ta,sa) an average over the three time levels
194      !!             which will be used to compute rdn and thus the semi-implicit
195      !!             hydrostatic pressure gradient (ln_dynhpg_imp = T)
196      !!              - swap tracer fields to prepare the next time_step.
197      !!                This can be summurized for tempearture as:
198      !!             ztm = tn + rbcp * [ta -2 tn + tb ]       ln_dynhpg_imp = T
199      !!             ztm = 0                                   otherwise
200      !!                   with rbcp=1/4 * (1-atfp^4) / (1-atfp)
201      !!             tb  = tn + atfp*[ tb - 2 tn + ta ]
202      !!             tn  = ta 
203      !!             ta  = ztm       (NB: reset to 0 after eos_bn2 call)
204      !!
205      !! ** Action  : - (tb,sb) and (tn,sn) ready for the next time step
206      !!              - (ta,sa) time averaged (t,s)   (ln_dynhpg_imp = T)
207      !!----------------------------------------------------------------------
208      INTEGER         , INTENT(in   )                               ::  kt       ! ocean time-step index
209      CHARACTER(len=3), INTENT(in   )                               ::  cdtype   ! =TRA or TRC (tracer indicator)
210      INTEGER         , INTENT(in   )                               ::  kjpt     ! number of tracers
211      REAL(wp)        , INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt)  ::  ptb      ! before tracer fields
212      REAL(wp)        , INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt)  ::  ptn      ! now tracer fields
213      REAL(wp)        , INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt)  ::  pta      ! tracer trend
214      INTEGER  :: ji, jj, jk, jn   ! dummy loop indices
215      REAL(wp) :: ztn, ztd, ztm         ! temporary scalars
216      !!----------------------------------------------------------------------
217
218      IF( kt == nit000 )  THEN
219         IF(lwp) WRITE(numout,*)
220         IF(lwp) WRITE(numout,*) 'tra_nxt_fix : time stepping'
221         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~'
222      ENDIF
223      !
224      IF( cdtype == 'TRA' )  THEN   ;   l_tra     = .TRUE.    ! active tracers case     
225      ELSE                          ;   l_tra     = .FALSE.   ! passive tracers case
226      ENDIF
227      !
228      DO jn = 1, kjpt
229         !
230         DO jk = 1, jpkm1
231            DO jj = 1, jpj
232               DO ji = 1, jpi
233                  IF( l_tra .AND. ln_dynhpg_imp )  ztn = ptn(ji,jj,jk,jn)               ! implicit hpg: keep tn, sn in memory
234                  !
235                  ztd = pta(ji,jj,jk,jn) - 2.* ptn(ji,jj,jk,jn) + ptb(ji,jj,jk,jn)      !  time laplacian on tracers
236                  !
237                  ptb(ji,jj,jk,jn) = ptn(ji,jj,jk,jn) + atfp * ztd                      ! ptb <-- filtered ptn
238                  ptn(ji,jj,jk,jn) = pta(ji,jj,jk,jn)                                   ! ptn <-- pta
239                  !
240                  IF( l_tra .AND. ln_dynhpg_imp )  pta(ji,jj,jk,jn) = ztn + rbcp * ztd  ! pta <-- Brown & Campana average
241               END DO
242           END DO
243         END DO
244         !
245      END DO
246      !
247   END SUBROUTINE tra_nxt_fix
248
249
250   SUBROUTINE tra_nxt_vvl( kt, cdtype, ptb, ptn, pta, kjpt )
251      !!----------------------------------------------------------------------
252      !!                   ***  ROUTINE tra_nxt_vvl  ***
253      !!
254      !! ** Purpose :   Time varying volume: apply the Asselin time filter 
255      !!                and swap the tracer fields.
256      !!
257      !! ** Method  : - Apply a thickness weighted Asselin time filter on now fields.
258      !!              - save in (ta,sa) a thickness weighted average over the three
259      !!             time levels which will be used to compute rdn and thus the semi-
260      !!             implicit hydrostatic pressure gradient (ln_dynhpg_imp = T)
261      !!              - swap tracer fields to prepare the next time_step.
262      !!                This can be summurized for tempearture as:
263      !!             ztm = ( e3t_n*tn + rbcp*[ e3t_b*tb - 2 e3t_n*tn + e3t_a*ta ] )   ln_dynhpg_imp = T
264      !!                  /( e3t_n    + rbcp*[ e3t_b    - 2 e3t_n    + e3t_a    ] )   
265      !!             ztm = 0                                                       otherwise
266      !!             tb  = ( e3t_n*tn + atfp*[ e3t_b*tb - 2 e3t_n*tn + e3t_a*ta ] )
267      !!                  /( e3t_n    + atfp*[ e3t_b    - 2 e3t_n    + e3t_a    ] )
268      !!             tn  = ta
269      !!             ta  = zt        (NB: reset to 0 after eos_bn2 call)
270      !!
271      !! ** Action  : - (tb,sb) and (tn,sn) ready for the next time step
272      !!              - (ta,sa) time averaged (t,s)   (ln_dynhpg_imp = T)
273      !!----------------------------------------------------------------------
274      INTEGER         , INTENT(in   )                               ::  kt       ! ocean time-step index
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      !!     
281      INTEGER  ::   ji, jj, jk, jn                 ! dummy loop indices
282      REAL(wp) ::   ztc_a , ztc_n , ztc_b          ! temporary scalar
283      REAL(wp) ::   ztc_f , ztc_d , ztc_m          !    -         -
284      REAL(wp) ::   ze3t_b, ze3t_n, ze3t_a         !    -         -
285      REAL(wp) ::   ze3t_f, ze3t_d, ze3t_m         !    -         -
286      REAL     ::   zfact1, zfact2                 !    -         -
287      !!----------------------------------------------------------------------
288
289      IF( kt == nit000 ) THEN
290         IF(lwp) WRITE(numout,*)
291         IF(lwp) WRITE(numout,*) 'tra_nxt_vvl : time stepping'
292         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~'
293      ENDIF
294      !
295      IF( cdtype == 'TRA' )  THEN   ;   l_tra     = .TRUE.    ! active tracers case     
296      ELSE                          ;   l_tra     = .FALSE.   ! passive tracers case
297      ENDIF
298      !
299      DO jn = 1, kjpt     
300         DO jk = 1, jpkm1
301            zfact1 = atfp * rdttra(jk)
302            zfact2 = zfact1 / rau0
303            DO jj = 1, jpj
304               DO ji = 1, jpi
305                  ze3t_b = fse3t_b(ji,jj,jk)
306                  ze3t_n = fse3t_n(ji,jj,jk)
307                  ze3t_a = fse3t_a(ji,jj,jk)
308                  !                                         ! tracer content at Before, now and after
309                  ztc_b  = ptb(ji,jj,jk,jn) * ze3t_b
310                  ztc_n  = ptn(ji,jj,jk,jn) * ze3t_n
311                  ztc_a  = pta(ji,jj,jk,jn) * ze3t_a
312                  !
313                  ze3t_d = ze3t_a - 2. * ze3t_n + ze3t_b
314                  ztc_d  = ztc_a  - 2. * ztc_n  + ztc_b
315                  !
316                  ze3t_f = ze3t_n + atfp * ze3t_d
317                  ztc_f  = ztc_n  + atfp * ztc_d
318
319                  IF( l_tra .AND. jk == 1 ) THEN
320                      ze3t_f = ze3t_f - zfact2 * ( emp_b(ji,jj) - emp(ji,jj) )
321                      ztc_f  = ztc_f  - zfact1 * ( sbc_tsc(ji,jj,jn) - sbc_tsc_b(ji,jj,jn) )
322                  ENDIF
323                  IF( l_tra .AND. jn == jp_tem .AND. ln_traqsr .AND. jk <= nksr )  &
324                     &     ztc_f  = ztc_f  - zfact1 * ( qsr_hc(ji,jj,jk) - qsr_hc_b(ji,jj,jk) ) 
325
326                   ze3t_f = 1.e0 / ze3t_f
327                   ptb(ji,jj,jk,jn) = ztc_f * ze3t_f       ! ptb <-- ptn filtered
328                   ptn(ji,jj,jk,jn) = pta(ji,jj,jk,jn)     ! ptn <-- pta
329                   !
330                   IF( l_tra .AND. ln_dynhpg_imp ) THEN
331                      ze3t_d           = 1.e0   / ( ze3t_n + rbcp * ze3t_d )
332                      pta(ji,jj,jk,jn) = ze3t_d * ( ztc_n  + rbcp * ztc_d  )   ! ta <-- Brown & Campana average
333                   ENDIF
334               END DO
335            END DO
336         END DO
337         !
338      END DO
339      !
340   END SUBROUTINE tra_nxt_vvl
341
342   !!======================================================================
343END MODULE tranxt
Note: See TracBrowser for help on using the repository browser.