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

source: branches/2011/dev_r2802_TOP_substepping/NEMOGCM/NEMO/OPA_SRC/TRA/tranxt.F90 @ 2830

Last change on this file since 2830 was 2830, checked in by kpedwards, 13 years ago

Updates to average physics variables for TOP substepping.
  • Property svn:keywords set to Id
File size: 17.3 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 bdy_par         ! Unstructured open boundary condition (bdy_tra_frs routine)
39   USE bdytra          ! Unstructured open boundary condition (bdy_tra_frs routine)
40   USE in_out_manager  ! I/O manager
41   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
42   USE prtctl          ! Print control
43   USE traqsr          ! penetrative solar radiation (needed for nksr)
44   USE traswp          ! swap array
45   USE obc_oce 
46#if defined key_agrif
47   USE agrif_opa_update
48   USE agrif_opa_interp
49#endif
50#if defined key_top
51   USE trc, ONLY: nittrc000  !get first time step for passive tracers
52#endif
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   !! * 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 radiative open boundaries (lk_obc=T),
87      !!             at the relaxed   open boundaries (lk_bdy=T), and
88      !!             at the AGRIF zoom     boundaries (lk_agrif=T)
89      !!
90      !!              - Update lateral boundary conditions on AGRIF children
91      !!             domains (lk_agrif=T)
92      !!
93      !! ** Action  : - (tb,sb) and (tn,sn) ready for the next time step
94      !!              - (ta,sa) time averaged (t,s)   (ln_dynhpg_imp = T)
95      !!----------------------------------------------------------------------
96      INTEGER, INTENT(in) ::   kt    ! ocean time-step index
97      !!
98      INTEGER  ::   jk, jn    ! dummy loop indices
99      REAL(wp) ::   zfact     ! local scalars
100      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  ztrdt, ztrds
101      !!----------------------------------------------------------------------
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 * (1. + atfp) * (1. + atfp) * ( 1. - atfp)      ! Brown & Campana parameter for semi-implicit hpg
109      ENDIF
110
111      ! Update after tracer on domain lateral boundaries
112      !
113      CALL lbc_lnk( tsa(:,:,:,jp_tem), 'T', 1. )      ! local domain boundaries  (T-point, unchanged sign)
114      CALL lbc_lnk( tsa(:,:,:,jp_sal), 'T', 1. )
115      !
116#if defined key_obc || defined key_bdy || defined key_agrif
117      CALL tra_unswap
118#endif
119
120#if defined key_obc 
121      IF( lk_obc )   CALL obc_tra( kt )  ! OBC open boundaries
122#endif
123#if defined key_bdy 
124      IF( lk_bdy )   CALL bdy_tra_frs( kt )  ! BDY open boundaries
125#endif
126#if defined key_agrif
127      CALL Agrif_tra                     ! AGRIF zoom boundaries
128#endif
129
130#if defined key_obc || defined key_bdy || defined key_agrif
131      CALL tra_swap
132#endif
133 
134      ! set time step size (Euler/Leapfrog)
135      IF( neuler == 0 .AND. kt == nit000 ) THEN   ;   r2dtra(:) =     rdttra(:)      ! at nit000             (Euler)
136      ELSEIF( kt <= nit000 + 1 )           THEN   ;   r2dtra(:) = 2.* rdttra(:)      ! at nit000 or nit000+1 (Leapfrog)
137      ENDIF
138
139      ! trends computation initialisation
140      IF( l_trdtra )   THEN                    ! store now fields before applying the Asselin filter
141         ALLOCATE( ztrdt(jpi,jpj,jpk) )   ;    ztrdt(:,:,:) = tsn(:,:,:,jp_tem) 
142         ALLOCATE( ztrds(jpi,jpj,jpk) )   ;    ztrds(:,:,:) = tsn(:,:,:,jp_sal)
143      ENDIF
144
145      IF( neuler == 0 .AND. kt == nit000 ) THEN       ! Euler time-stepping at first time-step (only swap)
146         DO jn = 1, jpts
147            DO jk = 1, jpkm1
148               tsn(:,:,jk,jn) = tsa(:,:,jk,jn)   
149            END DO
150         END DO
151      ELSE                                            ! Leap-Frog + Asselin filter time stepping
152         !
153         IF( lk_vvl )  THEN   ;   CALL tra_nxt_vvl( kt, 'TRA', tsb, tsn, tsa, jpts )  ! variable volume level (vvl)     
154         ELSE                 ;   CALL tra_nxt_fix( kt, 'TRA', tsb, tsn, tsa, jpts )  ! fixed    volume level
155         ENDIF
156      ENDIF 
157      !
158#if defined key_agrif
159      ! Update tracer at AGRIF zoom boundaries
160      CALL tra_unswap
161      IF( .NOT.Agrif_Root() )    CALL Agrif_Update_Tra( kt )      ! children only
162      CALL tra_swap
163#endif     
164      !
165      ! trends computation
166      IF( l_trdtra ) THEN      ! trend of the Asselin filter (tb filtered - tb)/dt     
167         DO jk = 1, jpkm1
168            zfact = 1.e0 / r2dtra(jk)             
169            ztrdt(:,:,jk) = ( tsb(:,:,jk,jp_tem) - ztrdt(:,:,jk) ) * zfact
170            ztrds(:,:,jk) = ( tsb(:,:,jk,jp_sal) - ztrds(:,:,jk) ) * zfact
171         END DO
172         CALL trd_tra( kt, 'TRA', jp_tem, jptra_trd_atf, ztrdt )
173         CALL trd_tra( kt, 'TRA', jp_sal, jptra_trd_atf, ztrds )
174         DEALLOCATE( ztrdt )      ;     DEALLOCATE( ztrds ) 
175      END IF
176      !
177      !                        ! control print
178      IF(ln_ctl)   CALL prt_ctl( tab3d_1=tsn(:,:,:,jp_tem), clinfo1=' nxt  - Tn: ', mask1=tmask,   &
179         &                       tab3d_2=tsn(:,:,:,jp_sal), clinfo2=       ' Sn: ', mask2=tmask )
180      !
181   END SUBROUTINE tra_nxt
182
183
184   SUBROUTINE tra_nxt_fix( kt, cdtype, ptb, ptn, pta, kjpt )
185      !!----------------------------------------------------------------------
186      !!                   ***  ROUTINE tra_nxt_fix  ***
187      !!
188      !! ** Purpose :   fixed volume: apply the Asselin time filter and
189      !!                swap the tracer fields.
190      !!
191      !! ** Method  : - Apply a Asselin time filter on now fields.
192      !!              - save in (ta,sa) an average over the three time levels
193      !!             which will be used to compute rdn and thus the semi-implicit
194      !!             hydrostatic pressure gradient (ln_dynhpg_imp = T)
195      !!              - swap tracer fields to prepare the next time_step.
196      !!                This can be summurized for tempearture as:
197      !!             ztm = tn + rbcp * [ta -2 tn + tb ]       ln_dynhpg_imp = T
198      !!             ztm = 0                                   otherwise
199      !!                   with rbcp=1/4 * (1-atfp^4) / (1-atfp)
200      !!             tb  = tn + atfp*[ tb - 2 tn + ta ]
201      !!             tn  = ta 
202      !!             ta  = ztm       (NB: reset to 0 after eos_bn2 call)
203      !!
204      !! ** Action  : - (tb,sb) and (tn,sn) ready for the next time step
205      !!              - (ta,sa) time averaged (t,s)   (ln_dynhpg_imp = T)
206      !!----------------------------------------------------------------------
207      INTEGER         , INTENT(in   )                               ::   kt       ! ocean time-step index
208      CHARACTER(len=3), INTENT(in   )                               ::   cdtype   ! =TRA or TRC (tracer indicator)
209      INTEGER         , INTENT(in   )                               ::   kjpt     ! number of tracers
210      REAL(wp)        , INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt)  ::   ptb      ! before tracer fields
211      REAL(wp)        , INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt)  ::   ptn      ! now tracer fields
212      REAL(wp)        , INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt)  ::   pta      ! tracer trend
213      !
214      INTEGER  ::   ji, jj, jk, jn   ! dummy loop indices
215      LOGICAL  ::   ll_tra_hpg       ! local logical
216      REAL(wp) ::   ztn, ztd         ! local scalars
217      !!----------------------------------------------------------------------
218
219#if defined key_top
220      IF( kt == nit000 .OR. (kt == nittrc000 .AND. cdtype == 'TRC'))  THEN
221#else
222      IF( kt == nit000 )  THEN
223#endif
224         IF(lwp) WRITE(numout,*)
225         IF(lwp) WRITE(numout,*) 'tra_nxt_fix : time stepping', cdtype
226         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~'
227      ENDIF
228      !
229      IF( cdtype == 'TRA' )  THEN   ;   ll_tra_hpg = ln_dynhpg_imp    ! active  tracers case  and  semi-implicit hpg   
230      ELSE                          ;   ll_tra_hpg = .FALSE.          ! passive tracers case or NO semi-implicit hpg
231      ENDIF
232      !
233      DO jn = 1, kjpt
234         !
235         DO jk = 1, jpkm1
236            DO jj = 1, jpj
237               DO ji = 1, jpi
238                  ztn = ptn(ji,jj,jk,jn)                                   
239                  ztd = pta(ji,jj,jk,jn) - 2. * ztn + ptb(ji,jj,jk,jn)      !  time laplacian on tracers
240                  !
241                  ptb(ji,jj,jk,jn) = ztn + atfp * ztd                       ! ptb <-- filtered ptn
242                  ptn(ji,jj,jk,jn) = pta(ji,jj,jk,jn)                       ! ptn <-- pta
243                  !
244                  IF( ll_tra_hpg )   pta(ji,jj,jk,jn) = ztn + rbcp * ztd    ! pta <-- Brown & Campana average
245               END DO
246           END DO
247         END DO
248         !
249      END DO
250      !
251   END SUBROUTINE tra_nxt_fix
252
253
254   SUBROUTINE tra_nxt_vvl( kt, cdtype, ptb, ptn, pta, kjpt )
255      !!----------------------------------------------------------------------
256      !!                   ***  ROUTINE tra_nxt_vvl  ***
257      !!
258      !! ** Purpose :   Time varying volume: apply the Asselin time filter 
259      !!                and swap the tracer fields.
260      !!
261      !! ** Method  : - Apply a thickness weighted Asselin time filter on now fields.
262      !!              - save in (ta,sa) a thickness weighted average over the three
263      !!             time levels which will be used to compute rdn and thus the semi-
264      !!             implicit hydrostatic pressure gradient (ln_dynhpg_imp = T)
265      !!              - swap tracer fields to prepare the next time_step.
266      !!                This can be summurized for tempearture as:
267      !!             ztm = ( e3t_n*tn + rbcp*[ e3t_b*tb - 2 e3t_n*tn + e3t_a*ta ] )   ln_dynhpg_imp = T
268      !!                  /( e3t_n    + rbcp*[ e3t_b    - 2 e3t_n    + e3t_a    ] )   
269      !!             ztm = 0                                                       otherwise
270      !!             tb  = ( e3t_n*tn + atfp*[ e3t_b*tb - 2 e3t_n*tn + e3t_a*ta ] )
271      !!                  /( e3t_n    + atfp*[ e3t_b    - 2 e3t_n    + e3t_a    ] )
272      !!             tn  = ta
273      !!             ta  = zt        (NB: reset to 0 after eos_bn2 call)
274      !!
275      !! ** Action  : - (tb,sb) and (tn,sn) ready for the next time step
276      !!              - (ta,sa) time averaged (t,s)   (ln_dynhpg_imp = T)
277      !!----------------------------------------------------------------------
278      INTEGER         , INTENT(in   )                               ::   kt       ! ocean time-step index
279      CHARACTER(len=3), INTENT(in   )                               ::   cdtype   ! =TRA or TRC (tracer indicator)
280      INTEGER         , INTENT(in   )                               ::   kjpt     ! number of tracers
281      REAL(wp)        , INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt)  ::   ptb      ! before tracer fields
282      REAL(wp)        , INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt)  ::   ptn      ! now tracer fields
283      REAL(wp)        , INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt)  ::   pta      ! tracer trend
284      !!     
285      LOGICAL  ::   ll_tra, ll_tra_hpg, ll_traqsr   ! local logical
286      INTEGER  ::   ji, jj, jk, jn              ! dummy loop indices
287      REAL(wp) ::   zfact1, ztc_a , ztc_n , ztc_b , ztc_f , ztc_d    ! local scalar
288      REAL(wp) ::   zfact2, ze3t_b, ze3t_n, ze3t_a, ze3t_f, ze3t_d   !   -      -
289      !!----------------------------------------------------------------------
290
291#if defined key_top
292      IF( kt == nit000 .OR. (kt == nittrc000 .AND. cdtype == 'TRC'))  THEN
293#else
294      IF( kt == nit000 )  THEN
295#endif
296         IF(lwp) WRITE(numout,*)
297         IF(lwp) WRITE(numout,*) 'tra_nxt_vvl : time stepping', cdtype
298         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~'
299      ENDIF
300      !
301      IF( cdtype == 'TRA' )  THEN   
302         ll_tra     = .TRUE.           ! active tracers case 
303         ll_tra_hpg = ln_dynhpg_imp    ! active  tracers case  and  semi-implicit hpg
304         ll_traqsr  = ln_traqsr        ! active  tracers case  and  solar penetration
305      ELSE                         
306         ll_tra     = .FALSE.          ! passive tracers case
307         ll_tra_hpg = .FALSE.          ! passive tracers case or NO semi-implicit hpg
308         ll_traqsr  = .FALSE.          ! active  tracers case and NO solar penetration
309      ENDIF
310      !
311      DO jn = 1, kjpt     
312         DO jk = 1, jpkm1
313            zfact1 = atfp * rdttra(jk)
314            zfact2 = zfact1 / rau0
315            DO jj = 1, jpj
316               DO ji = 1, jpi
317                  ze3t_b = fse3t_b(ji,jj,jk)
318                  ze3t_n = fse3t_n(ji,jj,jk)
319                  ze3t_a = fse3t_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( ll_tra .AND. jk == 1 ) THEN           ! first level only for T & S
332                      ze3t_f = ze3t_f - zfact2 * ( emp_b(ji,jj) - emp(ji,jj) )
333                      ztc_f  = ztc_f  - zfact1 * ( sbc_tsc(ji,jj,jn) - sbc_tsc_b(ji,jj,jn) )
334                  ENDIF
335                  IF( ll_traqsr .AND. jn == jp_tem .AND. jk <= nksr )   &     ! solar penetration (temperature only)
336                     &     ztc_f  = ztc_f  - zfact1 * ( qsr_hc(ji,jj,jk) - qsr_hc_b(ji,jj,jk) ) 
337
338                   ze3t_f = 1.e0 / ze3t_f
339                   ptb(ji,jj,jk,jn) = ztc_f * ze3t_f       ! ptb <-- ptn filtered
340                   ptn(ji,jj,jk,jn) = pta(ji,jj,jk,jn)     ! ptn <-- pta
341                   !
342                   IF( ll_tra_hpg ) THEN        ! semi-implicit hpg (T & S only)
343                      ze3t_d           = 1.e0   / ( ze3t_n + rbcp * ze3t_d )
344                      pta(ji,jj,jk,jn) = ze3t_d * ( ztc_n  + rbcp * ztc_d  )   ! ta <-- Brown & Campana average
345                   ENDIF
346               END DO
347            END DO
348         END DO
349         !
350      END DO
351      !
352   END SUBROUTINE tra_nxt_vvl
353
354   !!======================================================================
355END MODULE tranxt
Note: See TracBrowser for help on using the repository browser.