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.
traatf_qco.F90 in NEMO/trunk/src/OCE/TRA – NEMO

source: NEMO/trunk/src/OCE/TRA/traatf_qco.F90 @ 14072

Last change on this file since 14072 was 14072, checked in by laurent, 3 years ago

Merging branch "2020/dev_r13648_ASINTER-04_laurent_bulk_ice", ticket #2369
  • Property svn:keywords set to Id
File size: 19.1 KB
Line 
1MODULE traatf_qco
2   !!======================================================================
3   !!                       ***  MODULE  traatf_qco  ***
4   !! Ocean active tracers:  Asselin time filtering for 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   !!            4.1  !  2019-08  (A. Coward, D. Storkey) rename tranxt.F90 -> traatfLF.F90. Now only does time filtering.
20   !!----------------------------------------------------------------------
21
22   !!----------------------------------------------------------------------
23   !!   tra_atf       : time filtering on tracers
24   !!   tra_atf_fix   : time filtering on tracers : fixed    volume case
25   !!   tra_atf_vvl   : time filtering on tracers : variable volume case
26   !!----------------------------------------------------------------------
27   USE oce             ! ocean dynamics and tracers variables
28   USE dom_oce         ! ocean space and time domain variables
29   USE sbc_oce         ! surface boundary condition: ocean
30   USE sbcrnf          ! river runoffs
31   USE isf_oce         ! ice shelf melting
32   USE zdf_oce         ! ocean vertical mixing
33   USE domvvl          ! variable volume
34   USE trd_oce         ! trends: ocean variables
35   USE trdtra          ! trends manager: tracers
36   USE traqsr          ! penetrative solar radiation (needed for nksr)
37   USE phycst          ! physical constant
38   USE ldftra          ! lateral physics : tracers
39   USE ldfslp          ! lateral physics : slopes
40   USE bdy_oce  , ONLY : ln_bdy
41   USE bdytra          ! open boundary condition (bdy_tra routine)
42   !
43   USE in_out_manager  ! I/O manager
44   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
45   USE prtctl          ! Print control
46   USE timing          ! Timing
47
48   IMPLICIT NONE
49   PRIVATE
50
51   PUBLIC   tra_atf_qco       ! routine called by step.F90
52   PUBLIC   tra_atf_fix_lf    ! to be used in trcnxt !!st WARNING discrepancy here interpol is used by PISCES
53   PUBLIC   tra_atf_qco_lf    ! to be used in trcnxt !!st WARNING discrepancy here interpol is used by PISCES
54
55   !! * Substitutions
56#  include "do_loop_substitute.h90"
57#  include "domzgr_substitute.h90"
58   !!----------------------------------------------------------------------
59   !! NEMO/OCE 4.0 , NEMO Consortium (2018)
60   !! $Id$
61   !! Software governed by the CeCILL license (see ./LICENSE)
62   !!----------------------------------------------------------------------
63CONTAINS
64
65   SUBROUTINE tra_atf_qco( kt, Kbb, Kmm, Kaa, pts )
66      !!----------------------------------------------------------------------
67      !!                   ***  ROUTINE traatfLF  ***
68      !!
69      !! ** Purpose :   Apply the boundary condition on the after temperature
70      !!             and salinity fields and add the Asselin time filter on now fields.
71      !!
72      !! ** Method  :   At this stage of the computation, ta and sa are the
73      !!             after temperature and salinity as the time stepping has
74      !!             been performed in trazdf_imp or trazdf_exp module.
75      !!
76      !!              - Apply lateral boundary conditions on (ta,sa)
77      !!             at the local domain   boundaries through lbc_lnk call,
78      !!             at the one-way open boundaries (ln_bdy=T),
79      !!             at the AGRIF zoom   boundaries (lk_agrif=T)
80      !!
81      !!              - Update lateral boundary conditions on AGRIF children
82      !!             domains (lk_agrif=T)
83      !!
84      !! ** Action  : - ts(Kmm) time filtered
85      !!----------------------------------------------------------------------
86      INTEGER                                  , INTENT(in   ) :: kt             ! ocean time-step index
87      INTEGER                                  , INTENT(in   ) :: Kbb, Kmm, Kaa  ! time level indices
88      REAL(wp), DIMENSION(jpi,jpj,jpk,jpts,jpt), INTENT(inout) :: pts            ! active tracers
89      !!
90      INTEGER  ::   ji, jj, jk, jn   ! dummy loop indices
91      REAL(wp) ::   zfact            ! local scalars
92      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::   ztrdt, ztrds
93      !!----------------------------------------------------------------------
94      !
95      IF( ln_timing )   CALL timing_start( 'tra_atf_qco')
96      !
97      IF( kt == nit000 ) THEN
98         IF(lwp) WRITE(numout,*)
99         IF(lwp) WRITE(numout,*) 'tra_atf_qco : apply Asselin time filter to "now" fields'
100         IF(lwp) WRITE(numout,*) '~~~~~~~'
101      ENDIF
102!!st  Update after tracer on domain lateral boundaries as been removed outside
103
104      ! trends computation initialisation
105      IF( l_trdtra )   THEN
106         ALLOCATE( ztrdt(jpi,jpj,jpk) , ztrds(jpi,jpj,jpk) )
107         ztrdt(:,:,jpk) = 0._wp
108         ztrds(:,:,jpk) = 0._wp
109         IF( ln_traldf_iso ) THEN              ! diagnose the "pure" Kz diffusive trend
110            CALL trd_tra( kt, Kmm, Kaa, 'TRA', jp_tem, jptra_zdfp, ztrdt )
111            CALL trd_tra( kt, Kmm, Kaa, 'TRA', jp_sal, jptra_zdfp, ztrds )
112         ENDIF
113         ! total trend for the non-time-filtered variables.
114         zfact = 1.0 / rn_Dt
115         ! G Nurser 23 Mar 2017. Recalculate trend as Delta(e3t*T)/e3tn; e3tn cancel from pts(Kmm) terms
116         DO jk = 1, jpkm1
117            ztrdt(:,:,jk) = ( pts(:,:,jk,jp_tem,Kaa) * (1._wp + r3t(:,:,Kaa) * tmask(:,:,jk))/(1._wp + r3t(:,:,Kmm) * tmask(:,:,jk))  &
118               &            - pts(:,:,jk,jp_tem,Kmm) ) * zfact
119            ztrds(:,:,jk) = ( pts(:,:,jk,jp_sal,Kaa) * (1._wp + r3t(:,:,Kaa) * tmask(:,:,jk))/(1._wp + r3t(:,:,Kmm) * tmask(:,:,jk))  &
120               &            - pts(:,:,jk,jp_sal,Kmm) ) * zfact
121         END DO
122         CALL trd_tra( kt, Kmm, Kaa, 'TRA', jp_tem, jptra_tot, ztrdt )
123         CALL trd_tra( kt, Kmm, Kaa, 'TRA', jp_sal, jptra_tot, ztrds )
124         IF( ln_linssh ) THEN       ! linear sea surface height only
125            ! Store now fields before applying the Asselin filter
126            ! in order to calculate Asselin filter trend later.
127            ztrdt(:,:,:) = pts(:,:,:,jp_tem,Kmm)
128            ztrds(:,:,:) = pts(:,:,:,jp_sal,Kmm)
129         ENDIF
130      ENDIF
131
132      IF( l_1st_euler ) THEN       ! Euler time-stepping
133         !
134         IF (l_trdtra .AND. .NOT. ln_linssh ) THEN   ! Zero Asselin filter contribution must be explicitly written out since for vvl
135            !                                        ! Asselin filter is output by tra_atf_vvl that is not called on this time step
136            ztrdt(:,:,:) = 0._wp
137            ztrds(:,:,:) = 0._wp
138            CALL trd_tra( kt, Kmm, Kaa, 'TRA', jp_tem, jptra_atf, ztrdt )
139            CALL trd_tra( kt, Kmm, Kaa, 'TRA', jp_sal, jptra_atf, ztrds )
140         END IF
141         !
142      ELSE                                            ! Leap-Frog + Asselin filter time stepping
143         !
144         IF ( ln_linssh ) THEN   ;   CALL tra_atf_fix_lf( kt, Kbb, Kmm, Kaa, nit000,        'TRA', pts, jpts )  ! linear free surface
145         ELSE                    ;   CALL tra_atf_qco_lf( kt, Kbb, Kmm, Kaa, nit000, rn_Dt, 'TRA', pts, sbc_tsc, sbc_tsc_b, jpts )  ! non-linear free surface
146         ENDIF
147         !
148         CALL lbc_lnk_multi( 'traatfqco', pts(:,:,:,jp_tem,Kmm) , 'T', 1._wp, pts(:,:,:,jp_sal,Kmm) , 'T', 1._wp )
149         !
150      ENDIF
151      !
152      IF( l_trdtra .AND. ln_linssh ) THEN      ! trend of the Asselin filter (tb filtered - tb)/dt
153         DO jk = 1, jpkm1
154            ztrdt(:,:,jk) = ( pts(:,:,jk,jp_tem,Kmm) - ztrdt(:,:,jk) ) * r1_Dt
155            ztrds(:,:,jk) = ( pts(:,:,jk,jp_sal,Kmm) - ztrds(:,:,jk) ) * r1_Dt
156         END DO
157         CALL trd_tra( kt, Kmm, Kaa, 'TRA', jp_tem, jptra_atf, ztrdt )
158         CALL trd_tra( kt, Kmm, Kaa, 'TRA', jp_sal, jptra_atf, ztrds )
159      END IF
160      IF( l_trdtra )   DEALLOCATE( ztrdt , ztrds )
161      !
162      !                        ! control print
163      IF(sn_cfctl%l_prtctl)   CALL prt_ctl( tab3d_1=pts(:,:,:,jp_tem,Kmm), clinfo1=' nxt  - Tn: ', mask1=tmask,   &
164         &                                  tab3d_2=pts(:,:,:,jp_sal,Kmm), clinfo2=       ' Sn: ', mask2=tmask )
165      !
166      IF( ln_timing )   CALL timing_stop('tra_atf_qco')
167      !
168   END SUBROUTINE tra_atf_qco
169
170
171   SUBROUTINE tra_atf_fix_lf( kt, Kbb, Kmm, Kaa, kit000, cdtype, pt, kjpt )
172      !!----------------------------------------------------------------------
173      !!                   ***  ROUTINE tra_atf_fix  ***
174      !!
175      !! ** Purpose :   fixed volume: apply the Asselin time filter to the "now" field
176      !!
177      !! ** Method  : - Apply a Asselin time filter on now fields.
178      !!
179      !! ** Action  : - pt(Kmm) ready for the next time step
180      !!----------------------------------------------------------------------
181      INTEGER                                  , INTENT(in   ) ::  kt            ! ocean time-step index
182      INTEGER                                  , INTENT(in   ) ::  Kbb, Kmm, Kaa ! time level indices
183      INTEGER                                  , INTENT(in   ) ::  kit000        ! first time step index
184      CHARACTER(len=3)                         , INTENT(in   ) ::  cdtype        ! =TRA or TRC (tracer indicator)
185      INTEGER                                  , INTENT(in   ) ::  kjpt          ! number of tracers
186      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt,jpt), INTENT(inout) ::  pt            ! tracer fields
187      !
188      INTEGER  ::   ji, jj, jk, jn   ! dummy loop indices
189      REAL(wp) ::   ztn, ztd         ! local scalars
190      !!----------------------------------------------------------------------
191      !
192      IF( kt == kit000 )  THEN
193         IF(lwp) WRITE(numout,*)
194         IF(lwp) WRITE(numout,*) 'tra_atf_fix_lf : time filtering', cdtype
195         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~'
196      ENDIF
197      !
198      DO jn = 1, kjpt
199         !
200         DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1 )
201            ztn = pt(ji,jj,jk,jn,Kmm)
202            ztd = pt(ji,jj,jk,jn,Kaa) - 2._wp * ztn + pt(ji,jj,jk,jn,Kbb)  ! time laplacian on tracers
203            !
204            pt(ji,jj,jk,jn,Kmm) = ztn + rn_atfp * ztd                      ! pt <-- filtered pt
205         END_3D
206         !
207      END DO
208      !
209   END SUBROUTINE tra_atf_fix_lf
210
211
212   SUBROUTINE tra_atf_qco_lf( kt, Kbb, Kmm, Kaa, kit000, p2dt, cdtype, pt, psbc_tc, psbc_tc_b, kjpt )
213      !!----------------------------------------------------------------------
214      !!                   ***  ROUTINE tra_atf_vvl  ***
215      !!
216      !! ** Purpose :   Time varying volume: apply the Asselin time filter
217      !!
218      !! ** Method  : - Apply a thickness weighted Asselin time filter on now fields.
219      !!             pt(Kmm)  = ( e3t_m*pt(Kmm) + rn_atfp*[ e3t_b*pt(Kbb) - 2 e3t_m*pt(Kmm) + e3t_a*pt(Kaa) ] )
220      !!                       /( e3t_m         + rn_atfp*[ e3t_b         - 2 e3t_m         + e3t_a    ] )
221      !!
222      !! ** Action  : - pt(Kmm) ready for the next time step
223      !!----------------------------------------------------------------------
224      INTEGER                                  , INTENT(in   ) ::  kt        ! ocean time-step index
225      INTEGER                                  , INTENT(in   ) ::  Kbb, Kmm, Kaa ! time level indices
226      INTEGER                                  , INTENT(in   ) ::  kit000    ! first time step index
227      REAL(wp)                                 , INTENT(in   ) ::  p2dt      ! time-step
228      CHARACTER(len=3)                         , INTENT(in   ) ::  cdtype    ! =TRA or TRC (tracer indicator)
229      INTEGER                                  , INTENT(in   ) ::  kjpt      ! number of tracers
230      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt,jpt), INTENT(inout) ::  pt        ! tracer fields
231      REAL(wp), DIMENSION(jpi,jpj    ,kjpt)    , INTENT(in   ) ::  psbc_tc   ! surface tracer content
232      REAL(wp), DIMENSION(jpi,jpj    ,kjpt)    , INTENT(in   ) ::  psbc_tc_b ! before surface tracer content
233      !
234      LOGICAL  ::   ll_traqsr, ll_rnf, ll_isf   ! local logical
235      INTEGER  ::   ji, jj, jk, jn              ! dummy loop indices
236      REAL(wp) ::   zfact, zfact1, ztc_a , ztc_n , ztc_b , ztc_f , ztc_d    ! local scalar
237      REAL(wp) ::   zfact2, ze3t_b, ze3t_n, ze3t_a, ze3t_f                  !   -      -
238      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:) ::   ztrd_atf
239      !!----------------------------------------------------------------------
240      !
241      IF( kt == kit000 )  THEN
242         IF(lwp) WRITE(numout,*)
243         IF(lwp) WRITE(numout,*) 'tra_atf_qco : time filtering', cdtype
244         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~'
245      ENDIF
246      !
247      IF( cdtype == 'TRA' )  THEN
248         ll_traqsr  = ln_traqsr        ! active  tracers case  and  solar penetration
249         ll_rnf     = ln_rnf           ! active  tracers case  and  river runoffs
250         ll_isf     = ln_isf           ! active  tracers case  and  ice shelf melting
251      ELSE                          ! passive tracers case
252         ll_traqsr  = .FALSE.          ! NO solar penetration
253         ll_rnf     = .FALSE.          ! NO river runoffs ????          !!gm BUG ?
254         ll_isf     = .FALSE.          ! NO ice shelf melting/freezing  !!gm BUG ??
255      ENDIF
256      !
257      IF( ( l_trdtra .AND. cdtype == 'TRA' ) .OR. ( l_trdtrc .AND. cdtype == 'TRC' ) )   THEN
258         ALLOCATE( ztrd_atf(jpi,jpj,jpk,kjpt) )
259         ztrd_atf(:,:,:,:) = 0.0_wp
260      ENDIF
261      zfact = 1._wp / p2dt
262      zfact1 = rn_atfp * p2dt
263      zfact2 = zfact1 * r1_rho0
264      DO jn = 1, kjpt
265         DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1 )
266            ze3t_b = e3t(ji,jj,jk,Kbb)
267            ze3t_n = e3t(ji,jj,jk,Kmm)
268            ze3t_a = e3t(ji,jj,jk,Kaa)
269            !                                         ! tracer content at Before, now and after
270            ztc_b  = pt(ji,jj,jk,jn,Kbb) * ze3t_b
271            ztc_n  = pt(ji,jj,jk,jn,Kmm) * ze3t_n
272            ztc_a  = pt(ji,jj,jk,jn,Kaa) * ze3t_a
273            !
274            ztc_d  = ztc_a  - 2. * ztc_n  + ztc_b
275            !
276            ztc_f  = ztc_n  + rn_atfp * ztc_d
277            !
278            ! Asselin correction on scale factors is done via ssh in r3t_f
279            ze3t_f = e3t_0(ji,jj,jk) * ( 1._wp + r3t_f(ji,jj) * tmask(ji,jj,jk) )
280
281            !
282            IF( jk == mikt(ji,jj) ) THEN           ! first level
283               ztc_f  = ztc_f  - zfact1 * ( psbc_tc(ji,jj,jn) - psbc_tc_b(ji,jj,jn) )
284            ENDIF
285            !
286            ! solar penetration (temperature only)
287            IF( ll_traqsr .AND. jn == jp_tem .AND. jk <= nksr )                            &
288               &     ztc_f  = ztc_f  - zfact1 * ( qsr_hc(ji,jj,jk) - qsr_hc_b(ji,jj,jk) )
289               !
290            !
291            IF( ll_rnf .AND. jk <= nk_rnf(ji,jj) )                                          &
292               &     ztc_f  = ztc_f  - zfact1 * ( rnf_tsc(ji,jj,jn) - rnf_tsc_b(ji,jj,jn) ) &
293               &                              * e3t(ji,jj,jk,Kmm) / h_rnf(ji,jj)
294
295            !
296            ! ice shelf
297            IF( ll_isf ) THEN
298               !
299               ! melt in the cavity
300               IF ( ln_isfcav_mlt ) THEN
301                  ! level fully include in the Losch_2008 ice shelf boundary layer
302                  IF ( jk >= misfkt_cav(ji,jj) .AND. jk < misfkb_cav(ji,jj) ) THEN
303                     ztc_f  = ztc_f  - zfact1 * ( risf_cav_tsc(ji,jj,jn) - risf_cav_tsc_b(ji,jj,jn) ) &
304                        &                     * e3t(ji,jj,jk,Kmm) / rhisf_tbl_cav(ji,jj)
305                  END IF
306                  ! level partially include in Losch_2008 ice shelf boundary layer
307                  IF ( jk == misfkb_cav(ji,jj) ) THEN
308                     ztc_f  = ztc_f  - zfact1 * ( risf_cav_tsc(ji,jj,jn) - risf_cav_tsc_b(ji,jj,jn) )  &
309                            &                 * e3t(ji,jj,jk,Kmm) / rhisf_tbl_cav(ji,jj)               &
310                            &                 * rfrac_tbl_cav(ji,jj)
311                  END IF
312               END IF
313               !
314               ! parametrised melt (cavity closed)
315               IF ( ln_isfpar_mlt ) THEN
316                  ! level fully include in the Losch_2008 ice shelf boundary layer
317                  IF ( jk >= misfkt_par(ji,jj) .AND. jk < misfkb_par(ji,jj) ) THEN
318                     ztc_f  = ztc_f  - zfact1 * ( risf_par_tsc(ji,jj,jn) - risf_par_tsc_b(ji,jj,jn) )  &
319                            &                 * e3t(ji,jj,jk,Kmm) / rhisf_tbl_par(ji,jj)
320                  END IF
321                  ! level partially include in Losch_2008 ice shelf boundary layer
322                  IF ( jk == misfkb_par(ji,jj) ) THEN
323                     ztc_f  = ztc_f  - zfact1 * ( risf_par_tsc(ji,jj,jn) - risf_par_tsc_b(ji,jj,jn) )  &
324                            &                 * e3t(ji,jj,jk,Kmm) / rhisf_tbl_par(ji,jj)               &
325                            &                 * rfrac_tbl_par(ji,jj)
326                  END IF
327               END IF
328               !
329               ! ice sheet coupling correction
330               IF ( ln_isfcpl ) THEN
331                  !
332                  ! at kt = nit000,  risfcpl_vol_n = 0 and risfcpl_vol_b = risfcpl_vol so contribution nul
333                  IF ( ln_rstart .AND. kt == nit000+1 ) THEN
334                     ztc_f  = ztc_f  + zfact1 * risfcpl_tsc(ji,jj,jk,jn) * r1_e1e2t(ji,jj)
335                     ! Shouldn't volume increment be spread according thanks to zscale  ?
336                  END IF
337                  !
338               END IF
339               !
340            END IF
341            !
342            ze3t_f = 1.e0 / ze3t_f
343            pt(ji,jj,jk,jn,Kmm) = ztc_f * ze3t_f    ! time filtered "now" field
344            !
345            IF( ( l_trdtra .and. cdtype == 'TRA' ) .OR. ( l_trdtrc .and. cdtype == 'TRC' ) ) THEN
346               ztrd_atf(ji,jj,jk,jn) = (ztc_f - ztc_n) * zfact/ze3t_n
347            ENDIF
348            !
349         END_3D
350         !
351      END DO
352      !
353      IF( ( l_trdtra .AND. cdtype == 'TRA' ) .OR. ( l_trdtrc .AND. cdtype == 'TRC' ) )   THEN
354         IF( l_trdtra .AND. cdtype == 'TRA' ) THEN
355            CALL trd_tra( kt, Kmm, Kaa, cdtype, jp_tem, jptra_atf, ztrd_atf(:,:,:,jp_tem) )
356            CALL trd_tra( kt, Kmm, Kaa, cdtype, jp_sal, jptra_atf, ztrd_atf(:,:,:,jp_sal) )
357         ENDIF
358         IF( l_trdtrc .AND. cdtype == 'TRC' ) THEN
359            DO jn = 1, kjpt
360               CALL trd_tra( kt, Kmm, Kaa, cdtype, jn, jptra_atf, ztrd_atf(:,:,:,jn) )
361            END DO
362         ENDIF
363         DEALLOCATE( ztrd_atf )
364      ENDIF
365      !
366   END SUBROUTINE tra_atf_qco_lf
367
368   !!======================================================================
369END MODULE traatf_qco
Note: See TracBrowser for help on using the repository browser.