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

source: branches/2014/dev_r4765_CNRS_agrif/NEMOGCM/NEMO/OPA_SRC/TRA/tranxt.F90 @ 4785

Last change on this file since 4785 was 4785, checked in by rblod, 10 years ago

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