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

source: branches/2011/dev_LOCEAN_CMCC_INGV_MERCATOR_2011/NEMOGCM/NEMO/OPA_SRC/TRA/tranxt.F90 @ 3103

Last change on this file since 3103 was 2977, checked in by cetlod, 13 years ago

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