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

source: branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/TRA/tranxt.F90 @ 2696

Last change on this file since 2696 was 2690, checked in by gm, 13 years ago

dynamic mem: #785 ; homogeneization of the coding style associated with dyn allocation
  • Property svn:keywords set to Id
File size: 17.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 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
51   IMPLICIT NONE
52   PRIVATE
53
54   PUBLIC   tra_nxt       ! routine called by step.F90
55   PUBLIC   tra_nxt_fix   ! to be used in trcnxt
56   PUBLIC   tra_nxt_vvl   ! to be used in trcnxt
57
58   REAL(wp) ::   rbcp   ! Brown & Campana parameters for semi-implicit hpg
59
60   !! * Substitutions
61#  include "domzgr_substitute.h90"
62   !!----------------------------------------------------------------------
63   !! NEMO/OPA 3.3 , NEMO-Consortium (2010)
64   !! $Id$
65   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
66   !!----------------------------------------------------------------------
67CONTAINS
68
69   SUBROUTINE tra_nxt( kt )
70      !!----------------------------------------------------------------------
71      !!                   ***  ROUTINE tranxt  ***
72      !!
73      !! ** Purpose :   Apply the boundary condition on the after temperature 
74      !!             and salinity fields, achieved the time stepping by adding
75      !!             the Asselin filter on now fields and swapping the fields.
76      !!
77      !! ** Method  :   At this stage of the computation, ta and sa are the
78      !!             after temperature and salinity as the time stepping has
79      !!             been performed in trazdf_imp or trazdf_exp module.
80      !!
81      !!              - Apply lateral boundary conditions on (ta,sa)
82      !!             at the local domain   boundaries through lbc_lnk call,
83      !!             at the radiative open boundaries (lk_obc=T),
84      !!             at the relaxed   open boundaries (lk_bdy=T), and
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), DIMENSION(:,:,:), ALLOCATABLE ::  ztrdt, ztrds
98      !!----------------------------------------------------------------------
99
100      IF( kt == nit000 ) THEN
101         IF(lwp) WRITE(numout,*)
102         IF(lwp) WRITE(numout,*) 'tra_nxt : achieve the time stepping by Asselin filter and array swap'
103         IF(lwp) WRITE(numout,*) '~~~~~~~'
104         !
105         rbcp = 0.25 * (1. + atfp) * (1. + atfp) * ( 1. - atfp)      ! Brown & Campana parameter for semi-implicit hpg
106      ENDIF
107
108      ! Update after tracer on domain lateral boundaries
109      !
110      CALL lbc_lnk( tsa(:,:,:,jp_tem), 'T', 1. )      ! local domain boundaries  (T-point, unchanged sign)
111      CALL lbc_lnk( tsa(:,:,:,jp_sal), 'T', 1. )
112      !
113#if defined key_obc || defined key_bdy || defined key_agrif
114      CALL tra_unswap
115#endif
116
117#if defined key_obc 
118      IF( lk_obc )   CALL obc_tra( kt )  ! OBC open boundaries
119#endif
120#if defined key_bdy 
121      IF( lk_bdy )   CALL bdy_tra_frs( kt )  ! BDY open boundaries
122#endif
123#if defined key_agrif
124      CALL Agrif_tra                     ! AGRIF zoom boundaries
125#endif
126
127#if defined key_obc || defined key_bdy || defined key_agrif
128      CALL tra_swap
129#endif
130 
131      ! set time step size (Euler/Leapfrog)
132      IF( neuler == 0 .AND. kt == nit000 ) THEN   ;   r2dtra(:) =     rdttra(:)      ! at nit000             (Euler)
133      ELSEIF( kt <= nit000 + 1 )           THEN   ;   r2dtra(:) = 2.* rdttra(:)      ! at nit000 or nit000+1 (Leapfrog)
134      ENDIF
135
136      ! trends computation initialisation
137      IF( l_trdtra )   THEN                    ! store now fields before applying the Asselin filter
138         ALLOCATE( ztrdt(jpi,jpj,jpk) )   ;    ztrdt(:,:,:) = tsn(:,:,:,jp_tem) 
139         ALLOCATE( ztrds(jpi,jpj,jpk) )   ;    ztrds(:,:,:) = tsn(:,:,:,jp_sal)
140      ENDIF
141
142      IF( neuler == 0 .AND. kt == nit000 ) THEN       ! Euler time-stepping at first time-step (only swap)
143         DO jn = 1, jpts
144            DO jk = 1, jpkm1
145               tsn(:,:,jk,jn) = tsa(:,:,jk,jn)   
146            END DO
147         END DO
148      ELSE                                            ! Leap-Frog + Asselin filter time stepping
149         !
150         IF( lk_vvl )  THEN   ;   CALL tra_nxt_vvl( kt, 'TRA', tsb, tsn, tsa, jpts )  ! variable volume level (vvl)     
151         ELSE                 ;   CALL tra_nxt_fix( kt, 'TRA', tsb, tsn, tsa, jpts )  ! fixed    volume level
152         ENDIF
153      ENDIF 
154      !
155#if defined key_agrif
156      ! Update tracer at AGRIF zoom boundaries
157      CALL tra_unswap
158      IF( .NOT.Agrif_Root() )    CALL Agrif_Update_Tra( kt )      ! children only
159      CALL tra_swap
160#endif     
161      !
162      ! trends computation
163      IF( l_trdtra ) THEN      ! trend of the Asselin filter (tb filtered - tb)/dt     
164         DO jk = 1, jpkm1
165            zfact = 1.e0 / r2dtra(jk)             
166            ztrdt(:,:,jk) = ( tsb(:,:,jk,jp_tem) - ztrdt(:,:,jk) ) * zfact
167            ztrds(:,:,jk) = ( tsb(:,:,jk,jp_sal) - ztrds(:,:,jk) ) * zfact
168         END DO
169         CALL trd_tra( kt, 'TRA', jp_tem, jptra_trd_atf, ztrdt )
170         CALL trd_tra( kt, 'TRA', jp_sal, jptra_trd_atf, ztrds )
171         DEALLOCATE( ztrdt )      ;     DEALLOCATE( ztrds ) 
172      END IF
173      !
174      !                        ! control print
175      IF(ln_ctl)   CALL prt_ctl( tab3d_1=tsn(:,:,:,jp_tem), clinfo1=' nxt  - Tn: ', mask1=tmask,   &
176         &                       tab3d_2=tsn(:,:,:,jp_sal), clinfo2=       ' Sn: ', mask2=tmask )
177      !
178   END SUBROUTINE tra_nxt
179
180
181   SUBROUTINE tra_nxt_fix( kt, 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      CHARACTER(len=3), INTENT(in   )                               ::   cdtype   ! =TRA or TRC (tracer indicator)
206      INTEGER         , INTENT(in   )                               ::   kjpt     ! number of tracers
207      REAL(wp)        , INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt)  ::   ptb      ! before tracer fields
208      REAL(wp)        , INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt)  ::   ptn      ! now tracer fields
209      REAL(wp)        , INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt)  ::   pta      ! tracer trend
210      !
211      INTEGER  ::   ji, jj, jk, jn   ! dummy loop indices
212      LOGICAL  ::   ll_tra_hpg       ! local logical
213      REAL(wp) ::   ztn, ztd         ! local scalars
214      !!----------------------------------------------------------------------
215
216      IF( kt == nit000 )  THEN
217         IF(lwp) WRITE(numout,*)
218         IF(lwp) WRITE(numout,*) 'tra_nxt_fix : time stepping'
219         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~'
220      ENDIF
221      !
222      IF( cdtype == 'TRA' )  THEN   ;   ll_tra_hpg = ln_dynhpg_imp    ! active  tracers case  and  semi-implicit hpg   
223      ELSE                          ;   ll_tra_hpg = .FALSE.          ! passive tracers case or NO semi-implicit hpg
224      ENDIF
225      !
226      DO jn = 1, kjpt
227         !
228         DO jk = 1, jpkm1
229            DO jj = 1, jpj
230               DO ji = 1, jpi
231                  ztn = ptn(ji,jj,jk,jn)                                   
232                  ztd = pta(ji,jj,jk,jn) - 2. * ztn + ptb(ji,jj,jk,jn)      !  time laplacian on tracers
233                  !
234                  ptb(ji,jj,jk,jn) = ztn + atfp * ztd                       ! ptb <-- filtered ptn
235                  ptn(ji,jj,jk,jn) = pta(ji,jj,jk,jn)                       ! ptn <-- pta
236                  !
237                  IF( ll_tra_hpg )   pta(ji,jj,jk,jn) = ztn + rbcp * ztd    ! pta <-- Brown & Campana average
238               END DO
239           END DO
240         END DO
241         !
242      END DO
243      !
244   END SUBROUTINE tra_nxt_fix
245
246
247   SUBROUTINE tra_nxt_vvl( kt, cdtype, ptb, ptn, pta, kjpt )
248      !!----------------------------------------------------------------------
249      !!                   ***  ROUTINE tra_nxt_vvl  ***
250      !!
251      !! ** Purpose :   Time varying volume: apply the Asselin time filter 
252      !!                and swap the tracer fields.
253      !!
254      !! ** Method  : - Apply a thickness weighted Asselin time filter on now fields.
255      !!              - save in (ta,sa) a thickness weighted average over the three
256      !!             time levels which will be used to compute rdn and thus the semi-
257      !!             implicit hydrostatic pressure gradient (ln_dynhpg_imp = T)
258      !!              - swap tracer fields to prepare the next time_step.
259      !!                This can be summurized for tempearture as:
260      !!             ztm = ( e3t_n*tn + rbcp*[ e3t_b*tb - 2 e3t_n*tn + e3t_a*ta ] )   ln_dynhpg_imp = T
261      !!                  /( e3t_n    + rbcp*[ e3t_b    - 2 e3t_n    + e3t_a    ] )   
262      !!             ztm = 0                                                       otherwise
263      !!             tb  = ( e3t_n*tn + atfp*[ e3t_b*tb - 2 e3t_n*tn + e3t_a*ta ] )
264      !!                  /( e3t_n    + atfp*[ e3t_b    - 2 e3t_n    + e3t_a    ] )
265      !!             tn  = ta
266      !!             ta  = zt        (NB: reset to 0 after eos_bn2 call)
267      !!
268      !! ** Action  : - (tb,sb) and (tn,sn) ready for the next time step
269      !!              - (ta,sa) time averaged (t,s)   (ln_dynhpg_imp = T)
270      !!----------------------------------------------------------------------
271      INTEGER         , INTENT(in   )                               ::   kt       ! ocean time-step index
272      CHARACTER(len=3), INTENT(in   )                               ::   cdtype   ! =TRA or TRC (tracer indicator)
273      INTEGER         , INTENT(in   )                               ::   kjpt     ! number of tracers
274      REAL(wp)        , INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt)  ::   ptb      ! before tracer fields
275      REAL(wp)        , INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt)  ::   ptn      ! now tracer fields
276      REAL(wp)        , INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt)  ::   pta      ! tracer trend
277      !!     
278      LOGICAL  ::   ll_tra, ll_tra_hpg, ll_traqsr   ! local logical
279      INTEGER  ::   ji, jj, jk, jn              ! dummy loop indices
280      REAL(wp) ::   zfact1, ztc_a , ztc_n , ztc_b , ztc_f , ztc_d    ! local scalar
281      REAL(wp) ::   zfact2, ze3t_b, ze3t_n, ze3t_a, ze3t_f, ze3t_d   !   -      -
282      !!----------------------------------------------------------------------
283
284      IF( kt == nit000 ) THEN
285         IF(lwp) WRITE(numout,*)
286         IF(lwp) WRITE(numout,*) 'tra_nxt_vvl : time stepping'
287         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~'
288      ENDIF
289      !
290      IF( cdtype == 'TRA' )  THEN   
291         ll_tra     = .TRUE.           ! active tracers case 
292         ll_tra_hpg = ln_dynhpg_imp    ! active  tracers case  and  semi-implicit hpg
293         ll_traqsr  = ln_traqsr        ! active  tracers case  and  solar penetration
294      ELSE                         
295         ll_tra     = .FALSE.          ! passive tracers case
296         ll_tra_hpg = .FALSE.          ! passive tracers case or NO semi-implicit hpg
297         ll_traqsr  = .FALSE.          ! active  tracers case and NO solar penetration
298      ENDIF
299      !
300      DO jn = 1, kjpt     
301         DO jk = 1, jpkm1
302            zfact1 = atfp * rdttra(jk)
303            zfact2 = zfact1 / rau0
304            DO jj = 1, jpj
305               DO ji = 1, jpi
306                  ze3t_b = fse3t_b(ji,jj,jk)
307                  ze3t_n = fse3t_n(ji,jj,jk)
308                  ze3t_a = fse3t_a(ji,jj,jk)
309                  !                                         ! tracer content at Before, now and after
310                  ztc_b  = ptb(ji,jj,jk,jn) * ze3t_b
311                  ztc_n  = ptn(ji,jj,jk,jn) * ze3t_n
312                  ztc_a  = pta(ji,jj,jk,jn) * ze3t_a
313                  !
314                  ze3t_d = ze3t_a - 2. * ze3t_n + ze3t_b
315                  ztc_d  = ztc_a  - 2. * ztc_n  + ztc_b
316                  !
317                  ze3t_f = ze3t_n + atfp * ze3t_d
318                  ztc_f  = ztc_n  + atfp * ztc_d
319                  !
320                  IF( ll_tra .AND. jk == 1 ) THEN           ! first level only for T & S
321                      ze3t_f = ze3t_f - zfact2 * ( emp_b(ji,jj) - emp(ji,jj) )
322                      ztc_f  = ztc_f  - zfact1 * ( sbc_tsc(ji,jj,jn) - sbc_tsc_b(ji,jj,jn) )
323                  ENDIF
324                  IF( ll_traqsr .AND. jn == jp_tem .AND. jk <= nksr )   &     ! solar penetration (temperature only)
325                     &     ztc_f  = ztc_f  - zfact1 * ( qsr_hc(ji,jj,jk) - qsr_hc_b(ji,jj,jk) ) 
326
327                   ze3t_f = 1.e0 / ze3t_f
328                   ptb(ji,jj,jk,jn) = ztc_f * ze3t_f       ! ptb <-- ptn filtered
329                   ptn(ji,jj,jk,jn) = pta(ji,jj,jk,jn)     ! ptn <-- pta
330                   !
331                   IF( ll_tra_hpg ) THEN        ! semi-implicit hpg (T & S only)
332                      ze3t_d           = 1.e0   / ( ze3t_n + rbcp * ze3t_d )
333                      pta(ji,jj,jk,jn) = ze3t_d * ( ztc_n  + rbcp * ztc_d  )   ! ta <-- Brown & Campana average
334                   ENDIF
335               END DO
336            END DO
337         END DO
338         !
339      END DO
340      !
341   END SUBROUTINE tra_nxt_vvl
342
343   !!======================================================================
344END MODULE tranxt
Note: See TracBrowser for help on using the repository browser.