source: NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps_rewrite_time_filterswap/src/OCE/TRA/traatf.F90 @ 11099

Last change on this file since 11099 was 11099, checked in by davestorkey, 18 months ago

dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps_rewrite_time_filterswap : Updates and bug fixes. This version still doesn't pass all SETTE tests.

  • Property svn:keywords set to Id
File size: 19.5 KB
Line 
1MODULE traatf
2   !!======================================================================
3   !!                       ***  MODULE  traatf  ***
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_atf       : time stepping on tracers
23   !!   tra_atf_fix   : time stepping on tracers : fixed    volume case
24   !!   tra_atf_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 : tracers
38   USE ldfslp          ! lateral physics : slopes
39   USE bdy_oce  , ONLY : ln_bdy
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 timing          ! Timing
46#if defined key_agrif
47   USE agrif_oce_interp
48#endif
49
50   IMPLICIT NONE
51   PRIVATE
52
53   PUBLIC   tra_atf       ! routine called by step.F90
54   PUBLIC   tra_atf_fix   ! to be used in trcnxt
55   PUBLIC   tra_atf_vvl   ! to be used in trcnxt
56
57   !! * Substitutions
58#  include "vectopt_loop_substitute.h90"
59   !!----------------------------------------------------------------------
60   !! NEMO/OCE 4.0 , NEMO Consortium (2018)
61   !! $Id$
62   !! Software governed by the CeCILL license (see ./LICENSE)
63   !!----------------------------------------------------------------------
64CONTAINS
65
66   SUBROUTINE tra_atf( kt, Kbb, Kmm, Kaa, pts )
67      !!----------------------------------------------------------------------
68      !!                   ***  ROUTINE traatf  ***
69      !!
70      !!       !!!!!!!!!!!!!!!!!  REWRITE HEADER COMMENTS !!!!!!!!!!!!!!!
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 (ln_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  : - ts(Kbb) & ts(Kmm) ready for the next time step
89      !!----------------------------------------------------------------------
90      INTEGER                                  , INTENT(in   ) :: kt             ! ocean time-step index
91      INTEGER                                  , INTENT(in   ) :: Kbb, Kmm, Kaa  ! time level indices
92      REAL(wp), DIMENSION(jpi,jpj,jpk,jpts,jpt), INTENT(inout) :: pts            ! active tracers
93      !!
94      INTEGER  ::   ji, jj, jk, jn   ! dummy loop indices
95      REAL(wp) ::   zfact            ! local scalars
96      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::   ztrdt, ztrds
97      !!----------------------------------------------------------------------
98      !
99      IF( ln_timing )   CALL timing_start( 'tra_atf')
100      !
101      IF( kt == nit000 ) THEN
102         IF(lwp) WRITE(numout,*)
103         IF(lwp) WRITE(numout,*) 'tra_atf : achieve the time stepping by Asselin filter and array swap'
104         IF(lwp) WRITE(numout,*) '~~~~~~~'
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      !                                              ! local domain boundaries  (T-point, unchanged sign)
113      CALL lbc_lnk_multi( 'traatf', pts(:,:,:,jp_tem,Kaa), 'T', 1., pts(:,:,:,jp_sal,Kaa), 'T', 1. )
114      !
115      IF( ln_bdy )   CALL bdy_tra( kt, Kbb, pts, Kaa )  ! BDY open boundaries
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                   
124         ALLOCATE( ztrdt(jpi,jpj,jpk) , ztrds(jpi,jpj,jpk) )
125         ztrdt(:,:,jpk) = 0._wp
126         ztrds(:,:,jpk) = 0._wp
127         IF( ln_traldf_iso ) THEN              ! diagnose the "pure" Kz diffusive trend
128            CALL trd_tra( kt, Kmm, Kaa, 'TRA', jp_tem, jptra_zdfp, ztrdt )
129            CALL trd_tra( kt, Kmm, Kaa, 'TRA', jp_sal, jptra_zdfp, ztrds )
130         ENDIF
131         ! total trend for the non-time-filtered variables.
132         zfact = 1.0 / rdt
133         ! G Nurser 23 Mar 2017. Recalculate trend as Delta(e3t*T)/e3tn; e3tn cancel from pts(Kmm) terms
134         DO jk = 1, jpkm1
135            ztrdt(:,:,jk) = ( pts(:,:,jk,jp_tem,Kaa)*e3t(:,:,jk,Kaa) / e3t(:,:,jk,Kmm) - pts(:,:,jk,jp_tem,Kmm)) * zfact
136            ztrds(:,:,jk) = ( pts(:,:,jk,jp_sal,Kaa)*e3t(:,:,jk,Kaa) / e3t(:,:,jk,Kmm) - pts(:,:,jk,jp_sal,Kmm)) * zfact
137         END DO
138         CALL trd_tra( kt, Kmm, Kaa, 'TRA', jp_tem, jptra_tot, ztrdt )
139         CALL trd_tra( kt, Kmm, Kaa, 'TRA', jp_sal, jptra_tot, ztrds )
140         IF( ln_linssh ) THEN       ! linear sea surface height only
141            ! Store now fields before applying the Asselin filter
142            ! in order to calculate Asselin filter trend later.
143            ztrdt(:,:,:) = pts(:,:,:,jp_tem,Kmm) 
144            ztrds(:,:,:) = pts(:,:,:,jp_sal,Kmm)
145         ENDIF
146      ENDIF
147
148      IF( neuler == 0 .AND. kt == nit000 ) THEN       ! Euler time-stepping
149         !
150         IF (l_trdtra .AND. .NOT. ln_linssh ) THEN   ! Zero Asselin filter contribution must be explicitly written out since for vvl
151            !                                        ! Asselin filter is output by tra_atf_vvl that is not called on this time step
152            ztrdt(:,:,:) = 0._wp
153            ztrds(:,:,:) = 0._wp
154            CALL trd_tra( kt, Kmm, Kaa, 'TRA', jp_tem, jptra_atf, ztrdt )
155            CALL trd_tra( kt, Kmm, Kaa, 'TRA', jp_sal, jptra_atf, ztrds )
156         END IF
157         !
158      ELSE                                            ! Leap-Frog + Asselin filter time stepping
159         !
160         IF( ln_linssh ) THEN   ;   CALL tra_atf_fix( kt, Kbb, Kmm, Kaa, nit000,      'TRA', pts, jpts )  ! linear free surface
161         ELSE                   ;   CALL tra_atf_vvl( kt, Kbb, Kmm, Kaa, nit000, rdt, 'TRA', pts, sbc_tsc, sbc_tsc_b, jpts )  ! non-linear free surface
162         ENDIF
163         !
164         CALL lbc_lnk_multi( 'traatf', pts(:,:,:,jp_tem,Kbb) , 'T', 1., pts(:,:,:,jp_sal,Kbb) , 'T', 1., &
165                  &                    pts(:,:,:,jp_tem,Kmm) , 'T', 1., pts(:,:,:,jp_sal,Kmm) , 'T', 1., &
166                  &                    pts(:,:,:,jp_tem,Kaa), 'T', 1., pts(:,:,:,jp_sal,Kaa), 'T', 1.  )
167         !
168      ENDIF     
169      !
170      IF( l_trdtra .AND. ln_linssh ) THEN      ! trend of the Asselin filter (tb filtered - tb)/dt     
171         zfact = 1._wp / r2dt             
172         DO jk = 1, jpkm1
173            ztrdt(:,:,jk) = ( pts(:,:,jk,jp_tem,Kmm) - ztrdt(:,:,jk) ) * zfact
174            ztrds(:,:,jk) = ( pts(:,:,jk,jp_sal,Kmm) - ztrds(:,:,jk) ) * zfact
175         END DO
176         CALL trd_tra( kt, Kmm, Kaa, 'TRA', jp_tem, jptra_atf, ztrdt )
177         CALL trd_tra( kt, Kmm, Kaa, 'TRA', jp_sal, jptra_atf, ztrds )
178      END IF
179      IF( l_trdtra )   DEALLOCATE( ztrdt , ztrds )
180      !
181      !                        ! control print
182      IF(ln_ctl)   CALL prt_ctl( tab3d_1=pts(:,:,:,jp_tem,Kmm), clinfo1=' nxt  - Tn: ', mask1=tmask,   &
183         &                       tab3d_2=pts(:,:,:,jp_sal,Kmm), clinfo2=       ' Sn: ', mask2=tmask )
184      !
185      IF( ln_timing )   CALL timing_stop('tra_atf')
186      !
187   END SUBROUTINE tra_atf
188
189
190   SUBROUTINE tra_atf_fix( kt, Kbb, Kmm, Kaa, kit000, cdtype, pt, kjpt )
191      !!----------------------------------------------------------------------
192      !!                   ***  ROUTINE tra_atf_fix  ***
193      !!
194      !! ** Purpose :   fixed volume: apply the Asselin time filter and
195      !!                swap the tracer fields.
196      !!
197      !! ** Method  : - Apply a Asselin time filter on now fields.
198      !!              - swap tracer fields to prepare the next time_step.
199      !!
200      !! ** Action  : - ptb & ptn ready for the next time step
201      !!----------------------------------------------------------------------
202      INTEGER                                  , INTENT(in   ) ::  kt            ! ocean time-step index
203      INTEGER                                  , INTENT(in   ) ::  Kbb, Kmm, Kaa ! time level indices
204      INTEGER                                  , INTENT(in   ) ::  kit000        ! first 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), DIMENSION(jpi,jpj,jpk,kjpt,jpt), INTENT(inout) ::  pt            ! tracer fields
208      !
209      INTEGER  ::   ji, jj, jk, jn   ! dummy loop indices
210      REAL(wp) ::   ztn, ztd         ! local scalars
211      !!----------------------------------------------------------------------
212      !
213      IF( kt == kit000 )  THEN
214         IF(lwp) WRITE(numout,*)
215         IF(lwp) WRITE(numout,*) 'tra_atf_fix : time stepping', cdtype
216         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~'
217      ENDIF
218      !
219      DO jn = 1, kjpt
220         !
221         DO jk = 1, jpkm1
222            DO jj = 2, jpjm1
223               DO ji = fs_2, fs_jpim1
224                  ztn = pt(ji,jj,jk,jn,Kmm)                                   
225                  ztd = pt(ji,jj,jk,jn,Kaa) - 2._wp * ztn + pt(ji,jj,jk,jn,Kbb)  ! time laplacian on tracers
226                  !
227                  pt(ji,jj,jk,jn,Kmm) = ztn + atfp * ztd                      ! ptb <-- filtered ptn
228               END DO
229           END DO
230         END DO
231         !
232      END DO
233      !
234   END SUBROUTINE tra_atf_fix
235
236
237   SUBROUTINE tra_atf_vvl( kt, Kbb, Kmm, Kaa, kit000, p2dt, cdtype, pt, psbc_tc, psbc_tc_b, kjpt )
238      !!----------------------------------------------------------------------
239      !!                   ***  ROUTINE tra_atf_vvl  ***
240      !!
241      !! ** Purpose :   Time varying volume: apply the Asselin time filter 
242      !!                and swap the tracer fields.
243      !!
244      !! ** Method  : - Apply a thickness weighted Asselin time filter on now fields.
245      !!              - swap tracer fields to prepare the next time_step.
246      !!             tb  = ( e3t(Kmm)*tn + atfp*[ e3t(Kbb)*tb - 2 e3t(Kmm)*tn + e3t_a*ta ] )
247      !!                  /( e3t(Kmm)    + atfp*[ e3t(Kbb)    - 2 e3t(Kmm)    + e3t(Kaa)    ] )
248      !!             tn  = ta
249      !!
250      !! ** Action  : - ptb & ptn ready for the next time step
251      !!----------------------------------------------------------------------
252      INTEGER                                  , INTENT(in   ) ::  kt        ! ocean time-step index
253      INTEGER                                  , INTENT(in   ) ::  Kbb, Kmm, Kaa ! time level indices
254      INTEGER                                  , INTENT(in   ) ::  kit000    ! first time step index
255      REAL(wp)                                 , INTENT(in   ) ::  p2dt      ! time-step
256      CHARACTER(len=3)                         , INTENT(in   ) ::  cdtype    ! =TRA or TRC (tracer indicator)
257      INTEGER                                  , INTENT(in   ) ::  kjpt      ! number of tracers
258      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt,jpt), INTENT(inout) ::  pt        ! tracer fields
259      REAL(wp), DIMENSION(jpi,jpj    ,kjpt)    , INTENT(in   ) ::  psbc_tc   ! surface tracer content
260      REAL(wp), DIMENSION(jpi,jpj    ,kjpt)    , INTENT(in   ) ::  psbc_tc_b ! before surface tracer content
261      !
262      LOGICAL  ::   ll_traqsr, ll_rnf, ll_isf   ! local logical
263      INTEGER  ::   ji, jj, jk, jn              ! dummy loop indices
264      REAL(wp) ::   zfact, zfact1, ztc_a , ztc_n , ztc_b , ztc_f , ztc_d    ! local scalar
265      REAL(wp) ::   zfact2, ze3t_b, ze3t_n, ze3t_a, ze3t_f, ze3t_d   !   -      -
266      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:) ::   ztrd_atf
267      !!----------------------------------------------------------------------
268      !
269      IF( kt == kit000 )  THEN
270         IF(lwp) WRITE(numout,*)
271         IF(lwp) WRITE(numout,*) 'tra_atf_vvl : time stepping', cdtype
272         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~'
273      ENDIF
274      !
275      IF( cdtype == 'TRA' )  THEN   
276         ll_traqsr  = ln_traqsr        ! active  tracers case  and  solar penetration
277         ll_rnf     = ln_rnf           ! active  tracers case  and  river runoffs
278         ll_isf     = ln_isf           ! active  tracers case  and  ice shelf melting
279      ELSE                          ! passive tracers case
280         ll_traqsr  = .FALSE.          ! NO solar penetration
281         ll_rnf     = .FALSE.          ! NO river runoffs ????          !!gm BUG ? 
282         ll_isf     = .FALSE.          ! NO ice shelf melting/freezing  !!gm BUG ??
283      ENDIF
284      !
285      IF( ( l_trdtra .AND. cdtype == 'TRA' ) .OR. ( l_trdtrc .AND. cdtype == 'TRC' ) )   THEN
286         ALLOCATE( ztrd_atf(jpi,jpj,jpk,kjpt) )
287         ztrd_atf(:,:,:,:) = 0.0_wp
288      ENDIF
289      zfact = 1._wp / p2dt
290      zfact1 = atfp * p2dt
291      zfact2 = zfact1 * r1_rau0
292      DO jn = 1, kjpt     
293         DO jk = 1, jpkm1
294            DO jj = 2, jpjm1
295               DO ji = fs_2, fs_jpim1
296                  ze3t_b = e3t(ji,jj,jk,Kbb)
297                  ze3t_n = e3t(ji,jj,jk,Kmm)
298                  ze3t_a = e3t(ji,jj,jk,Kaa)
299                  !                                         ! tracer content at Before, now and after
300                  ztc_b  = pt(ji,jj,jk,jn,Kbb) * ze3t_b
301                  ztc_n  = pt(ji,jj,jk,jn,Kmm) * ze3t_n
302                  ztc_a  = pt(ji,jj,jk,jn,Kaa) * ze3t_a
303                  !
304                  ze3t_d = ze3t_a - 2. * ze3t_n + ze3t_b
305                  ztc_d  = ztc_a  - 2. * ztc_n  + ztc_b
306                  !
307                  ze3t_f = ze3t_n + atfp * ze3t_d
308                  ztc_f  = ztc_n  + atfp * ztc_d
309                  !
310                  IF( jk == mikt(ji,jj) ) THEN           ! first level
311                     ze3t_f = ze3t_f - zfact2 * ( (emp_b(ji,jj)    - emp(ji,jj)   )  &
312                            &                   + (fwfisf_b(ji,jj) - fwfisf(ji,jj))  )
313                     ztc_f  = ztc_f  - zfact1 * ( psbc_tc(ji,jj,jn) - psbc_tc_b(ji,jj,jn) )
314                  ENDIF
315                  IF( ln_rnf_depth ) THEN
316                     ! Rivers are not just at the surface must go down to nk_rnf(ji,jj)
317                     IF( mikt(ji,jj) <=jk .and. jk <= nk_rnf(ji,jj)  ) THEN
318                        ze3t_f = ze3t_f - zfact2 * ( - (rnf_b(ji,jj) - rnf(ji,jj)   )  ) &
319                    &                            * ( e3t(ji,jj,jk,Kmm) / h_rnf(ji,jj) ) 
320                     ENDIF
321                  ELSE
322                     IF( jk == mikt(ji,jj) ) THEN           ! first level
323                        ze3t_f = ze3t_f - zfact2 * ( - (rnf_b(ji,jj)    - rnf(ji,jj)   ) ) 
324                     ENDIF
325                  ENDIF
326
327                  !
328                  ! solar penetration (temperature only)
329                  IF( ll_traqsr .AND. jn == jp_tem .AND. jk <= nksr )                            & 
330                     &     ztc_f  = ztc_f  - zfact1 * ( qsr_hc(ji,jj,jk) - qsr_hc_b(ji,jj,jk) ) 
331                     !
332                  ! river runoff
333                  IF( ll_rnf .AND. jk <= nk_rnf(ji,jj) )                                          &
334                     &     ztc_f  = ztc_f  - zfact1 * ( rnf_tsc(ji,jj,jn) - rnf_tsc_b(ji,jj,jn) ) & 
335                     &                              * e3t(ji,jj,jk,Kmm) / h_rnf(ji,jj)
336                     !
337                  ! ice shelf
338                  IF( ll_isf ) THEN
339                     ! level fully include in the Losch_2008 ice shelf boundary layer
340                     IF ( jk >= misfkt(ji,jj) .AND. jk < misfkb(ji,jj) )                          &
341                        ztc_f  = ztc_f  - zfact1 * ( risf_tsc(ji,jj,jn) - risf_tsc_b(ji,jj,jn) )  &
342                               &                 * e3t(ji,jj,jk,Kmm) * r1_hisf_tbl (ji,jj)
343                     ! level partially include in Losch_2008 ice shelf boundary layer
344                     IF ( jk == misfkb(ji,jj) )                                                   &
345                        ztc_f  = ztc_f  - zfact1 * ( risf_tsc(ji,jj,jn) - risf_tsc_b(ji,jj,jn) )  &
346                               &                 * e3t(ji,jj,jk,Kmm) * r1_hisf_tbl (ji,jj) * ralpha(ji,jj)
347                  END IF
348                  !
349                  ze3t_f = 1.e0 / ze3t_f
350                  pt(ji,jj,jk,jn,Kmm) = ztc_f * ze3t_f    ! time filtered "now" field
351                  !
352                  IF( ( l_trdtra .and. cdtype == 'TRA' ) .OR. ( l_trdtrc .and. cdtype == 'TRC' ) ) THEN
353                     ztrd_atf(ji,jj,jk,jn) = (ztc_f - ztc_n) * zfact/ze3t_n
354                  ENDIF
355                  !
356               END DO
357            END DO
358         END DO
359         !
360      END DO
361      !
362      IF( ( l_trdtra .AND. cdtype == 'TRA' ) .OR. ( l_trdtrc .AND. cdtype == 'TRC' ) )   THEN
363         IF( l_trdtra .AND. cdtype == 'TRA' ) THEN
364            CALL trd_tra( kt, Kmm, Kaa, cdtype, jp_tem, jptra_atf, ztrd_atf(:,:,:,jp_tem) )
365            CALL trd_tra( kt, Kmm, Kaa, cdtype, jp_sal, jptra_atf, ztrd_atf(:,:,:,jp_sal) )
366         ENDIF
367         IF( l_trdtrc .AND. cdtype == 'TRC' ) THEN
368            DO jn = 1, kjpt
369               CALL trd_tra( kt, Kmm, Kaa, cdtype, jn, jptra_atf, ztrd_atf(:,:,:,jn) )
370            END DO
371         ENDIF
372         DEALLOCATE( ztrd_atf )
373      ENDIF
374      !
375   END SUBROUTINE tra_atf_vvl
376
377   !!======================================================================
378END MODULE traatf
Note: See TracBrowser for help on using the repository browser.