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

source: trunk/NEMOGCM/NEMO/OPA_SRC/TRA/tranxt.F90 @ 6140

Last change on this file since 6140 was 6140, checked in by timgraham, 8 years ago

Merge of branches/2015/dev_merge_2015 back into trunk. Merge excludes NEMOGCM/TOOLS/OBSTOOLS/ for now due to issues with the change of file type. Will sort these manually with further commits.

Branch merged as follows:
In the working copy of branch ran:
svn merge ​svn+ssh://forge.ipsl.jussieu.fr/ipsl/forge/projets/nemo/svn/trunk@HEAD
Small conflicts due to bug fixes applied to trunk since the dev_merge_2015 was copied. Bug fixes were applied to the branch as well so these were easy to resolve.
Branch committed at this stage

In working copy run:
svn switch ​svn+ssh://forge.ipsl.jussieu.fr/ipsl/forge/projets/nemo/svn/trunk
to switch working copy

Run:
svn merge --reintegrate ​svn+ssh://forge.ipsl.jussieu.fr/ipsl/forge/projets/nemo/svn/branches/2015/dev_merge_2015
to merge the branch into the trunk and then commit - no conflicts at this stage.
  • Property svn:keywords set to Id
File size: 16.5 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 sbcrnf          ! river runoffs
30   USE sbcisf          ! ice shelf melting
31   USE zdf_oce         ! ocean vertical mixing
32   USE domvvl          ! variable volume
33   USE trd_oce         ! trends: ocean variables
34   USE trdtra          ! trends manager: tracers
35   USE traqsr          ! penetrative solar radiation (needed for nksr)
36   USE phycst          ! physical constant
37   USE ldftra          ! lateral physics on tracers
38   USE ldfslp
39   USE bdy_oce         ! BDY open boundary condition variables
40   USE bdytra          ! open boundary condition (bdy_tra routine)
41   !
42   USE in_out_manager  ! I/O manager
43   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
44   USE prtctl          ! Print control
45   USE wrk_nemo        ! Memory allocation
46   USE timing          ! Timing
47#if defined key_agrif
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   !! * Substitutions
59#  include "vectopt_loop_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  : - tsb & tsn ready for the next time step
88      !!----------------------------------------------------------------------
89      INTEGER, INTENT(in) ::   kt    ! ocean time-step index
90      !!
91      INTEGER  ::   ji, jj, jk, jn   ! dummy loop indices
92      REAL(wp) ::   zfact            ! local scalars
93      REAL(wp), POINTER, DIMENSION(:,:,:) ::  ztrdt, ztrds
94      !!----------------------------------------------------------------------
95      !
96      IF( nn_timing == 1 )  CALL timing_start( 'tra_nxt')
97      !
98      IF( kt == nit000 ) THEN
99         IF(lwp) WRITE(numout,*)
100         IF(lwp) WRITE(numout,*) 'tra_nxt : achieve the time stepping by Asselin filter and array swap'
101         IF(lwp) WRITE(numout,*) '~~~~~~~'
102      ENDIF
103
104      ! Update after tracer on domain lateral boundaries
105      !
106#if defined key_agrif
107      CALL Agrif_tra                     ! AGRIF zoom boundaries
108#endif
109      !
110      CALL lbc_lnk( tsa(:,:,:,jp_tem), 'T', 1._wp )      ! local domain boundaries  (T-point, unchanged sign)
111      CALL lbc_lnk( tsa(:,:,:,jp_sal), 'T', 1._wp )
112      !
113#if defined key_bdy 
114      IF( lk_bdy )   CALL bdy_tra( kt )  ! BDY open boundaries
115#endif
116 
117      ! set time step size (Euler/Leapfrog)
118      IF( neuler == 0 .AND. kt == nit000 ) THEN   ;   r2dt =     rdt      ! at nit000             (Euler)
119      ELSEIF( kt <= nit000 + 1 )           THEN   ;   r2dt = 2._wp* rdt   ! at nit000 or nit000+1 (Leapfrog)
120      ENDIF
121
122      ! trends computation initialisation
123      IF( l_trdtra )   THEN                    ! store now fields before applying the Asselin filter
124         CALL wrk_alloc( jpi, jpj, jpk, ztrdt, ztrds )
125         ztrdt(:,:,:) = tsn(:,:,:,jp_tem) 
126         ztrds(:,:,:) = tsn(:,:,:,jp_sal)
127         IF( ln_traldf_iso ) THEN              ! diagnose the "pure" Kz diffusive trend
128            CALL trd_tra( kt, 'TRA', jp_tem, jptra_zdfp, ztrdt )
129            CALL trd_tra( kt, 'TRA', jp_sal, jptra_zdfp, ztrds )
130         ENDIF
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         !
140      ELSE                                            ! Leap-Frog + Asselin filter time stepping
141         !
142         IF( ln_linssh ) THEN   ;   CALL tra_nxt_fix( kt, nit000,      'TRA', tsb, tsn, tsa, jpts )  ! linear free surface
143         ELSE                   ;   CALL tra_nxt_vvl( kt, nit000, rdt, 'TRA', tsb, tsn, tsa,   &
144           &                                                                sbc_tsc, sbc_tsc_b, jpts )  ! non-linear free surface
145         ENDIF
146         !
147         DO jn = 1, jpts
148            CALL lbc_lnk( tsb(:,:,:,jn), 'T', 1._wp ) 
149            CALL lbc_lnk( tsn(:,:,:,jn), 'T', 1._wp )
150            CALL lbc_lnk( tsa(:,:,:,jn), 'T', 1._wp )
151         END DO
152      ENDIF     
153      !
154      IF( l_trdtra ) THEN      ! trend of the Asselin filter (tb filtered - tb)/dt     
155         DO jk = 1, jpkm1
156            zfact = 1._wp / r2dt             
157            ztrdt(:,:,jk) = ( tsb(:,:,jk,jp_tem) - ztrdt(:,:,jk) ) * zfact
158            ztrds(:,:,jk) = ( tsb(:,:,jk,jp_sal) - ztrds(:,:,jk) ) * zfact
159         END DO
160         CALL trd_tra( kt, 'TRA', jp_tem, jptra_atf, ztrdt )
161         CALL trd_tra( kt, 'TRA', jp_sal, jptra_atf, ztrds )
162         CALL wrk_dealloc( jpi, jpj, jpk, ztrdt, ztrds )
163      END IF
164      !
165      !                        ! control print
166      IF(ln_ctl)   CALL prt_ctl( tab3d_1=tsn(:,:,:,jp_tem), clinfo1=' nxt  - Tn: ', mask1=tmask,   &
167         &                       tab3d_2=tsn(:,:,:,jp_sal), clinfo2=       ' Sn: ', mask2=tmask )
168      !
169      IF( nn_timing == 1 )   CALL timing_stop('tra_nxt')
170      !
171   END SUBROUTINE tra_nxt
172
173
174   SUBROUTINE tra_nxt_fix( kt, kit000, cdtype, ptb, ptn, pta, kjpt )
175      !!----------------------------------------------------------------------
176      !!                   ***  ROUTINE tra_nxt_fix  ***
177      !!
178      !! ** Purpose :   fixed volume: apply the Asselin time filter and
179      !!                swap the tracer fields.
180      !!
181      !! ** Method  : - Apply a Asselin time filter on now fields.
182      !!              - swap tracer fields to prepare the next time_step.
183      !!
184      !! ** Action  : - tsb & tsn ready for the next time step
185      !!----------------------------------------------------------------------
186      INTEGER                              , INTENT(in   ) ::  kt        ! ocean time-step index
187      INTEGER                              , INTENT(in   ) ::  kit000    ! first time step index
188      CHARACTER(len=3)                     , INTENT(in   ) ::  cdtype    ! =TRA or TRC (tracer indicator)
189      INTEGER                              , INTENT(in   ) ::  kjpt      ! number of tracers
190      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::  ptb       ! before tracer fields
191      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::  ptn       ! now tracer fields
192      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::  pta       ! tracer trend
193      !
194      INTEGER  ::   ji, jj, jk, jn   ! dummy loop indices
195      REAL(wp) ::   ztn, ztd         ! local scalars
196      !!----------------------------------------------------------------------
197      !
198      IF( kt == kit000 )  THEN
199         IF(lwp) WRITE(numout,*)
200         IF(lwp) WRITE(numout,*) 'tra_nxt_fix : time stepping', cdtype
201         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~'
202      ENDIF
203      !
204      DO jn = 1, kjpt
205         !
206         DO jk = 1, jpkm1
207            DO jj = 2, jpjm1
208               DO ji = fs_2, fs_jpim1
209                  ztn = ptn(ji,jj,jk,jn)                                   
210                  ztd = pta(ji,jj,jk,jn) - 2._wp * ztn + ptb(ji,jj,jk,jn)  ! time laplacian on tracers
211                  !
212                  ptb(ji,jj,jk,jn) = ztn + atfp * ztd                      ! ptb <-- filtered ptn
213                  ptn(ji,jj,jk,jn) = pta(ji,jj,jk,jn)                      ! ptn <-- pta
214               END DO
215           END DO
216         END DO
217         !
218      END DO
219      !
220   END SUBROUTINE tra_nxt_fix
221
222
223   SUBROUTINE tra_nxt_vvl( kt, kit000, p2dt, cdtype, ptb, ptn, pta, psbc_tc, psbc_tc_b, kjpt )
224      !!----------------------------------------------------------------------
225      !!                   ***  ROUTINE tra_nxt_vvl  ***
226      !!
227      !! ** Purpose :   Time varying volume: apply the Asselin time filter 
228      !!                and swap the tracer fields.
229      !!
230      !! ** Method  : - Apply a thickness weighted Asselin time filter on now fields.
231      !!              - swap tracer fields to prepare the next time_step.
232      !!             tb  = ( e3t_n*tn + atfp*[ e3t_b*tb - 2 e3t_n*tn + e3t_a*ta ] )
233      !!                  /( e3t_n    + atfp*[ e3t_b    - 2 e3t_n    + e3t_a    ] )
234      !!             tn  = ta
235      !!
236      !! ** Action  : - tsb & tsn ready for the next time step
237      !!----------------------------------------------------------------------
238      INTEGER                              , INTENT(in   ) ::  kt        ! ocean time-step index
239      INTEGER                              , INTENT(in   ) ::  kit000    ! first time step index
240      REAL(wp)                             , INTENT(in   ) ::  p2dt      ! time-step
241      CHARACTER(len=3)                     , INTENT(in   ) ::  cdtype    ! =TRA or TRC (tracer indicator)
242      INTEGER                              , INTENT(in   ) ::  kjpt      ! number of tracers
243      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::  ptb       ! before tracer fields
244      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::  ptn       ! now tracer fields
245      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::  pta       ! tracer trend
246      REAL(wp), DIMENSION(jpi,jpj    ,kjpt), INTENT(in   ) ::  psbc_tc   ! surface tracer content
247      REAL(wp), DIMENSION(jpi,jpj    ,kjpt), INTENT(in   ) ::  psbc_tc_b ! before surface tracer content
248      !
249      LOGICAL  ::   ll_traqsr, ll_rnf, ll_isf   ! local logical
250      INTEGER  ::   ji, jj, jk, jn              ! dummy loop indices
251      REAL(wp) ::   zfact1, ztc_a , ztc_n , ztc_b , ztc_f , ztc_d    ! local scalar
252      REAL(wp) ::   zfact2, ze3t_b, ze3t_n, ze3t_a, ze3t_f, ze3t_d   !   -      -
253      !!----------------------------------------------------------------------
254      !
255      IF( kt == kit000 )  THEN
256         IF(lwp) WRITE(numout,*)
257         IF(lwp) WRITE(numout,*) 'tra_nxt_vvl : time stepping', cdtype
258         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~'
259      ENDIF
260      !
261      IF( cdtype == 'TRA' )  THEN   
262         ll_traqsr  = ln_traqsr        ! active  tracers case  and  solar penetration
263         ll_rnf     = ln_rnf           ! active  tracers case  and  river runoffs
264         ll_isf     = ln_isf           ! active  tracers case  and  ice shelf melting
265      ELSE                          ! passive tracers case
266         ll_traqsr  = .FALSE.          ! NO solar penetration
267         ll_rnf     = .FALSE.          ! NO river runoffs ????          !!gm BUG ? 
268         ll_isf     = .FALSE.          ! NO ice shelf melting/freezing  !!gm BUG ??
269      ENDIF
270      !
271      DO jn = 1, kjpt     
272         DO jk = 1, jpkm1
273            zfact1 = atfp * p2dt
274            zfact2 = zfact1 * r1_rau0
275            DO jj = 2, jpjm1
276               DO ji = fs_2, fs_jpim1
277                  ze3t_b = e3t_b(ji,jj,jk)
278                  ze3t_n = e3t_n(ji,jj,jk)
279                  ze3t_a = e3t_a(ji,jj,jk)
280                  !                                         ! tracer content at Before, now and after
281                  ztc_b  = ptb(ji,jj,jk,jn) * ze3t_b
282                  ztc_n  = ptn(ji,jj,jk,jn) * ze3t_n
283                  ztc_a  = pta(ji,jj,jk,jn) * ze3t_a
284                  !
285                  ze3t_d = ze3t_a - 2. * ze3t_n + ze3t_b
286                  ztc_d  = ztc_a  - 2. * ztc_n  + ztc_b
287                  !
288                  ze3t_f = ze3t_n + atfp * ze3t_d
289                  ztc_f  = ztc_n  + atfp * ztc_d
290                  !
291                  IF( jk == mikt(ji,jj) ) THEN           ! first level
292                     ze3t_f = ze3t_f - zfact2 * ( (emp_b(ji,jj)    - emp(ji,jj)   )  &
293                            &                   - (rnf_b(ji,jj)    - rnf(ji,jj)   )  &
294                            &                   + (fwfisf_b(ji,jj) - fwfisf(ji,jj))  )
295                     ztc_f  = ztc_f  - zfact1 * ( psbc_tc(ji,jj,jn) - psbc_tc_b(ji,jj,jn) )
296                  ENDIF
297                  !
298                  ! solar penetration (temperature only)
299                  IF( ll_traqsr .AND. jn == jp_tem .AND. jk <= nksr )                            & 
300                     &     ztc_f  = ztc_f  - zfact1 * ( qsr_hc(ji,jj,jk) - qsr_hc_b(ji,jj,jk) ) 
301                     !
302                  ! river runoff
303                  IF( ll_rnf .AND. jk <= nk_rnf(ji,jj) )                                          &
304                     &     ztc_f  = ztc_f  - zfact1 * ( rnf_tsc(ji,jj,jn) - rnf_tsc_b(ji,jj,jn) ) & 
305                     &                              * e3t_n(ji,jj,jk) / h_rnf(ji,jj)
306                     !
307                  ! ice shelf
308                  IF( ll_isf ) THEN
309                     ! level fully include in the Losch_2008 ice shelf boundary layer
310                     IF ( jk >= misfkt(ji,jj) .AND. jk < misfkb(ji,jj) )                          &
311                        ztc_f  = ztc_f  - zfact1 * ( risf_tsc(ji,jj,jn) - risf_tsc_b(ji,jj,jn) )  &
312                               &                 * e3t_n(ji,jj,jk) * r1_hisf_tbl (ji,jj)
313                     ! level partially include in Losch_2008 ice shelf boundary layer
314                     IF ( jk == misfkb(ji,jj) )                                                   &
315                        ztc_f  = ztc_f  - zfact1 * ( risf_tsc(ji,jj,jn) - risf_tsc_b(ji,jj,jn) )  &
316                               &                 * e3t_n(ji,jj,jk) * r1_hisf_tbl (ji,jj) * ralpha(ji,jj)
317                  END IF
318                  !
319                  ze3t_f = 1.e0 / ze3t_f
320                  ptb(ji,jj,jk,jn) = ztc_f * ze3t_f       ! ptb <-- ptn filtered
321                  ptn(ji,jj,jk,jn) = pta(ji,jj,jk,jn)     ! ptn <-- pta
322                  !
323               END DO
324            END DO
325         END DO
326         !
327      END DO
328      !
329   END SUBROUTINE tra_nxt_vvl
330
331   !!======================================================================
332END MODULE tranxt
Note: See TracBrowser for help on using the repository browser.