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

source: branches/UKMO/r5936_CO6_CO5_shelfdiagnostic/NEMOGCM/NEMO/OPA_SRC/TRA/tranxt.F90 @ 7113

Last change on this file since 7113 was 7113, checked in by jcastill, 7 years ago

Remove again the svn keywords, as it did not work before

File size: 16.4 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/freezing
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
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 one-way open boundaries (lk_bdy=T),
83      !!             at the AGRIF zoom   boundaries (lk_agrif=T)
84      !!
85      !!              - Update lateral boundary conditions on AGRIF children
86      !!             domains (lk_agrif=T)
87      !!
88      !! ** Action  : - (tb,sb) and (tn,sn) ready for the next time step
89      !!
90      !!----------------------------------------------------------------------
91      INTEGER, INTENT(in) ::   kt    ! ocean time-step index
92      !!
93      INTEGER  ::   jk, jn    ! dummy loop indices
94      REAL(wp) ::   zfact     ! local scalars
95      REAL(wp), POINTER, DIMENSION(:,:,:) ::  ztrdt, ztrds
96      !!----------------------------------------------------------------------
97      !
98      IF( nn_timing == 1 )  CALL timing_start( 'tra_nxt')
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      ENDIF
105
106      ! Update after tracer on domain lateral boundaries
107      !
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         IF( ln_traldf_iso ) THEN              ! diagnose the "pure" Kz diffusive trend
131            CALL trd_tra( kt, 'TRA', jp_tem, jptra_zdfp, ztrdt )
132            CALL trd_tra( kt, 'TRA', jp_sal, jptra_zdfp, ztrds )
133         ENDIF
134      ENDIF
135
136      IF( neuler == 0 .AND. kt == nit000 ) THEN       ! Euler time-stepping at first time-step (only swap)
137         DO jn = 1, jpts
138            DO jk = 1, jpkm1
139               tsn(:,:,jk,jn) = tsa(:,:,jk,jn)   
140            END DO
141         END DO
142      ELSE                                            ! Leap-Frog + Asselin filter time stepping
143         !
144         IF( lk_vvl )  THEN   ;   CALL tra_nxt_vvl( kt, nit000, rdttra, 'TRA', tsb, tsn, tsa,   &
145           &                                                              sbc_tsc, sbc_tsc_b, jpts )  ! variable volume level (vvl)
146         ELSE                 ;   CALL tra_nxt_fix( kt, nit000,         'TRA', tsb, tsn, tsa, jpts )  ! fixed    volume level
147         ENDIF
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._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_atf, ztrdt )
158         CALL trd_tra( kt, 'TRA', jp_sal, jptra_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      IF( nn_timing == 1 )   CALL timing_stop('tra_nxt')
167      !
168   END SUBROUTINE tra_nxt
169
170
171   SUBROUTINE tra_nxt_fix( kt, kit000, cdtype, ptb, ptn, pta, kjpt )
172      !!----------------------------------------------------------------------
173      !!                   ***  ROUTINE tra_nxt_fix  ***
174      !!
175      !! ** Purpose :   fixed volume: apply the Asselin time filter and
176      !!                swap the tracer fields.
177      !!
178      !! ** Method  : - Apply a Asselin time filter on now fields.
179      !!              - swap tracer fields to prepare the next time_step.
180      !!
181      !! ** Action  : - (tb,sb) and (tn,sn) ready for the next time step
182      !!             
183      !!----------------------------------------------------------------------
184      INTEGER         , INTENT(in   )                               ::   kt       ! ocean time-step index
185      INTEGER         , INTENT(in   )                               ::   kit000   ! first time step index
186      CHARACTER(len=3), INTENT(in   )                               ::   cdtype   ! =TRA or TRC (tracer indicator)
187      INTEGER         , INTENT(in   )                               ::   kjpt     ! number of tracers
188      REAL(wp)        , INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt)  ::   ptb      ! before tracer fields
189      REAL(wp)        , INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt)  ::   ptn      ! now tracer fields
190      REAL(wp)        , INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt)  ::   pta      ! tracer trend
191      !
192      INTEGER  ::   ji, jj, jk, jn   ! dummy loop indices
193      REAL(wp) ::   ztn, ztd         ! local scalars
194      !!----------------------------------------------------------------------
195
196      IF( kt == kit000 )  THEN
197         IF(lwp) WRITE(numout,*)
198         IF(lwp) WRITE(numout,*) 'tra_nxt_fix : time stepping', cdtype
199         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~'
200      ENDIF
201      !
202      !
203      DO jn = 1, kjpt
204         !
205         DO jk = 1, jpkm1
206            DO jj = 1, jpj
207               DO ji = 1, jpi
208                  ztn = ptn(ji,jj,jk,jn)                                   
209                  ztd = pta(ji,jj,jk,jn) - 2. * ztn + ptb(ji,jj,jk,jn)      !  time laplacian on tracers
210                  !
211                  ptb(ji,jj,jk,jn) = ztn + atfp * ztd                       ! ptb <-- filtered ptn
212                  ptn(ji,jj,jk,jn) = pta(ji,jj,jk,jn)                       ! ptn <-- pta
213                  !
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      !!                This can be summurized for tempearture as:
233      !!
234      !! ** Action  : - (tb,sb) and (tn,sn) ready for the next time step
235      !!
236      !!----------------------------------------------------------------------
237      INTEGER         , INTENT(in   )                               ::  kt       ! ocean time-step index
238      INTEGER         , INTENT(in   )                               ::  kit000   ! first time step index
239      REAL(wp)        , INTENT(in   ), DIMENSION(jpk)               ::  p2dt     ! time-step
240      CHARACTER(len=3), INTENT(in   )                               ::  cdtype   ! =TRA or TRC (tracer indicator)
241      INTEGER         , INTENT(in   )                               ::  kjpt     ! number of tracers
242      REAL(wp)        , INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt)  ::  ptb      ! before tracer fields
243      REAL(wp)        , INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt)  ::  ptn      ! now tracer fields
244      REAL(wp)        , INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt)  ::  pta      ! tracer trend
245      REAL(wp)        , INTENT(in   ), DIMENSION(jpi,jpj,kjpt)      ::  psbc_tc   ! surface tracer content
246      REAL(wp)        , INTENT(in   ), DIMENSION(jpi,jpj,kjpt)      ::  psbc_tc_b ! before surface tracer content
247
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         IF (nn_isf .GE. 1) THEN
265            ll_isf = .TRUE.            ! active  tracers case  and  ice shelf melting/freezing
266         ELSE
267            ll_isf = .FALSE.
268         END IF
269      ELSE                         
270         ll_traqsr  = .FALSE.          ! active  tracers case and NO solar penetration
271         ll_rnf     = .FALSE.          ! passive tracers or NO river runoffs
272         ll_isf     = .FALSE.          ! passive tracers or NO ice shelf melting/freezing
273      ENDIF
274      !
275      DO jn = 1, kjpt     
276         DO jk = 1, jpkm1
277            zfact1 = atfp * p2dt(jk)
278            zfact2 = zfact1 / rau0
279            DO jj = 1, jpj
280               DO ji = 1, jpi
281                  ze3t_b = fse3t_b(ji,jj,jk)
282                  ze3t_n = fse3t_n(ji,jj,jk)
283                  ze3t_a = fse3t_a(ji,jj,jk)
284                  !                                         ! tracer content at Before, now and after
285                  ztc_b  = ptb(ji,jj,jk,jn) * ze3t_b
286                  ztc_n  = ptn(ji,jj,jk,jn) * ze3t_n
287                  ztc_a  = pta(ji,jj,jk,jn) * ze3t_a
288                  !
289                  ze3t_d = ze3t_a - 2. * ze3t_n + ze3t_b
290                  ztc_d  = ztc_a  - 2. * ztc_n  + ztc_b
291                  !
292                  ze3t_f = ze3t_n + atfp * ze3t_d
293                  ztc_f  = ztc_n  + atfp * ztc_d
294                  !
295                  IF( jk == mikt(ji,jj) ) THEN           ! first level
296                     ze3t_f = ze3t_f - zfact2 * ( (emp_b(ji,jj)    - emp(ji,jj)   )  &
297                            &                   - (rnf_b(ji,jj)    - rnf(ji,jj)   )  &
298                            &                   + (fwfisf_b(ji,jj) - fwfisf(ji,jj))  )
299                     ztc_f  = ztc_f  - zfact1 * ( psbc_tc(ji,jj,jn) - psbc_tc_b(ji,jj,jn) )
300                  ENDIF
301
302                  ! solar penetration (temperature only)
303                  IF( ll_traqsr .AND. jn == jp_tem .AND. jk <= nksr )                            & 
304                     &     ztc_f  = ztc_f  - zfact1 * ( qsr_hc(ji,jj,jk) - qsr_hc_b(ji,jj,jk) ) 
305
306                  ! river runoff
307                  IF( ll_rnf .AND. jk <= nk_rnf(ji,jj) )                                          &
308                     &     ztc_f  = ztc_f  - zfact1 * ( rnf_tsc(ji,jj,jn) - rnf_tsc_b(ji,jj,jn) ) & 
309                     &                              * fse3t_n(ji,jj,jk) / h_rnf(ji,jj)
310
311                  ! ice shelf
312                  IF( ll_isf ) THEN
313                     ! level fully include in the Losch_2008 ice shelf boundary layer
314                     IF ( jk >= misfkt(ji,jj) .AND. jk < misfkb(ji,jj) )                          &
315                        ztc_f  = ztc_f  - zfact1 * ( risf_tsc(ji,jj,jn) - risf_tsc_b(ji,jj,jn) )  &
316                               &                 * fse3t_n(ji,jj,jk) * r1_hisf_tbl (ji,jj)
317                     ! level partially include in Losch_2008 ice shelf boundary layer
318                     IF ( jk == misfkb(ji,jj) )                                                   &
319                        ztc_f  = ztc_f  - zfact1 * ( risf_tsc(ji,jj,jn) - risf_tsc_b(ji,jj,jn) )  &
320                               &                 * fse3t_n(ji,jj,jk) * r1_hisf_tbl (ji,jj) * ralpha(ji,jj)
321                  END IF
322
323                  ze3t_f = 1.e0 / ze3t_f
324                  ptb(ji,jj,jk,jn) = ztc_f * ze3t_f       ! ptb <-- ptn filtered
325                  ptn(ji,jj,jk,jn) = pta(ji,jj,jk,jn)     ! ptn <-- pta
326                  !
327               END DO
328            END DO
329         END DO
330         !
331      END DO
332      !
333   END SUBROUTINE tra_nxt_vvl
334
335   !!======================================================================
336END MODULE tranxt
Note: See TracBrowser for help on using the repository browser.