Newer
Older
MODULE trcadv
!!==============================================================================
!! *** MODULE trcadv ***
!! Ocean passive tracers: advection trend
!!==============================================================================
!! History : 2.0 ! 2005-11 (G. Madec) Original code
!! 3.0 ! 2010-06 (C. Ethe) Adapted to passive tracers
!! 3.7 ! 2014-05 (G. Madec, C. Ethe) Add 2nd/4th order cases for CEN and FCT schemes
!! 4.0 ! 2017-09 (G. Madec) remove vertical time-splitting option
!! 4.5 ! 2021-08 (G. Madec, S. Techene) add advective velocities as optional arguments
!! - ! 2022-06 (S. Techene, G, Madec) refactorization to reduce local memory usage
!!----------------------------------------------------------------------
#if defined key_top
!!----------------------------------------------------------------------
!! 'key_top' TOP models
!!----------------------------------------------------------------------
!! trc_adv : compute ocean tracer advection trend
!! trc_adv_ini : control the different options of advection scheme
!!----------------------------------------------------------------------
USE par_trc ! need jptra, number of passive tracers
USE oce_trc ! ocean dynamics and active tracers
USE trc ! ocean passive tracers variables
USE sbcwave ! wave module
USE sbc_oce ! surface boundary condition: ocean
USE traadv_cen ! centered scheme (tra_adv_cen routine)
USE traadv_fct ! FCT scheme (tra_adv_fct routine)
USE traadv_mus ! MUSCL scheme (tra_adv_mus routine)
USE traadv_ubs ! UBS scheme (tra_adv_ubs routine)
USE traadv_qck ! QUICKEST scheme (tra_adv_qck routine)
USE tramle ! ML eddy induced transport (tra_adv_mle routine)
USE ldftra ! lateral diffusion: eddy diffusivity & EIV coeff.
USE ldfslp ! Lateral diffusion: slopes of neutral surfaces
!
USE prtctl ! control print
USE timing ! Timing
IMPLICIT NONE
PRIVATE
PUBLIC trc_adv ! called by trctrp.F90 and stprk3_stg.F90
PUBLIC trc_adv_ini ! called by trcini.F90
! !!* Namelist namtrc_adv *
LOGICAL :: ln_trcadv_OFF ! no advection on passive tracers
LOGICAL :: ln_trcadv_cen ! centered scheme flag
INTEGER :: nn_cen_h, nn_cen_v ! =2/4 : horizontal and vertical choices of the order of CEN scheme
LOGICAL :: ln_trcadv_fct ! FCT scheme flag
INTEGER :: nn_fct_h, nn_fct_v ! =2/4 : horizontal and vertical choices of the order of FCT scheme
LOGICAL, PUBLIC :: ln_trcadv_mus ! MUSCL scheme flag
LOGICAL :: ln_mus_ups ! use upstream scheme in vivcinity of river mouths
LOGICAL :: ln_trcadv_ubs ! UBS scheme flag
INTEGER :: nn_ubs_v ! =2/4 : vertical choice of the order of UBS scheme
LOGICAL :: ln_trcadv_qck ! QUICKEST scheme flag
INTEGER :: nadv ! choice of the type of advection scheme
! ! associated indices:
INTEGER, PARAMETER :: np_NO_adv = 0 ! no T-S advection
INTEGER, PARAMETER :: np_CEN = 1 ! 2nd/4th order centered scheme
INTEGER, PARAMETER :: np_FCT = 2 ! 2nd/4th order Flux Corrected Transport scheme
INTEGER, PARAMETER :: np_MUS = 3 ! MUSCL scheme
INTEGER, PARAMETER :: np_UBS = 4 ! 3rd order Upstream Biased Scheme
INTEGER, PARAMETER :: np_QCK = 5 ! QUICK scheme
!! * Substitutions
# include "do_loop_substitute.h90"
!! * Substitutions
# include "do_loop_substitute.h90"
# include "domzgr_substitute.h90"
!!----------------------------------------------------------------------
!! NEMO/TOP 4.0 , NEMO Consortium (2018)
!! $Id: trcadv.F90 15510 2021-11-15 15:33:37Z techene $
!! Software governed by the CeCILL license (see ./LICENSE)
!!----------------------------------------------------------------------
CONTAINS
SUBROUTINE trc_adv( kt, Kbb, Kmm, ptr, Krhs, pau, pav, paw )
!!----------------------------------------------------------------------
!! *** ROUTINE trc_adv ***
!!
!! ** Purpose : compute the ocean tracer advection trend.
!!
!! ** Method : - Update tr(Krhs) with the advective trend following nadv
!!----------------------------------------------------------------------
INTEGER , INTENT(in ) :: kt ! ocean time-step index
INTEGER , INTENT(in ) :: Kbb, Kmm, Krhs ! time level indices
REAL(wp), DIMENSION(:,:,:), OPTIONAL, TARGET, INTENT(in ) :: pau, pav, paw ! advective velocity
REAL(wp), DIMENSION(jpi,jpj,jpk,jptra,jpt) , INTENT(inout) :: ptr ! passive tracers and RHS of tracer equation
!
INTEGER :: ji, jj, jk ! dummy loop index
CHARACTER (len=22) :: charout
REAL(wp), DIMENSION(:,:,:), POINTER :: zptu, zptv, zptw
REAL(wp), DIMENSION(jpi,jpj,jpk) :: zuu, zvv, zww ! effective velocity
!!----------------------------------------------------------------------
!
IF( ln_timing ) CALL timing_start('trc_adv')
!
! !== effective transport ==!
IF( l_offline ) THEN
DO_3D( nn_hls, nn_hls-1, nn_hls, nn_hls-1, 1, jpk )
zuu(ji,jj,jk) = uu(ji,jj,jk,Kmm) ! already in (uu(Kmm),vv(Kmm),ww)
zvv(ji,jj,jk) = vv(ji,jj,jk,Kmm)
END_3D
DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpk )
zww(ji,jj,jk) = ww(ji,jj,jk)
END_3D
ELSE ! build the effective transport
DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls-1 )
zuu(ji,jj,jpk) = 0._wp
zvv(ji,jj,jpk) = 0._wp
END_2D
DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )
zww(ji,jj,jpk) = 0._wp
END_2D
!
IF( PRESENT( pau ) ) THEN ! RK3: advective velocity (pau,pav,paw) /= advected velocity (uu,vv,ww)
zptu => pau(:,:,:)
zptv => pav(:,:,:)
zptw => paw(:,:,:)
ELSE ! MLF: advective velocity = (uu,vv,ww)
zptu => uu(:,:,:,Kmm)
zptv => vv(:,:,:,Kmm)
zptw => ww(:,:,: )
ENDIF
!
IF( ln_wave .AND. ln_sdw ) THEN
DO_3D( nn_hls, nn_hls-1, nn_hls, nn_hls-1, 1, jpkm1 ) ! eulerian transport + Stokes Drift
zuu(ji,jj,jk) = e2u (ji,jj) * e3u(ji,jj,jk,Kmm) * ( zptu(ji,jj,jk) + usd(ji,jj,jk) )
zvv(ji,jj,jk) = e1v (ji,jj) * e3v(ji,jj,jk,Kmm) * ( zptv(ji,jj,jk) + vsd(ji,jj,jk) )
END_3D
DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpkm1 )
zww(ji,jj,jk) = e1e2t(ji,jj) * ( zptw(ji,jj,jk) + wsd(ji,jj,jk) )
END_3D
ELSE
DO_3D( nn_hls, nn_hls-1, nn_hls, nn_hls-1, 1, jpkm1 )
zuu(ji,jj,jk) = e2u (ji,jj) * e3u(ji,jj,jk,Kmm) * zptu(ji,jj,jk) ! eulerian transport
zvv(ji,jj,jk) = e1v (ji,jj) * e3v(ji,jj,jk,Kmm) * zptv(ji,jj,jk)
END_3D
DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpkm1 )
zww(ji,jj,jk) = e1e2t(ji,jj) * zptw(ji,jj,jk)
END_3D
ENDIF
!
IF( ln_vvl_ztilde .OR. ln_vvl_layer ) THEN ! add z-tilde and/or vvl corrections
DO_3D( nn_hls, nn_hls-1, nn_hls, nn_hls-1, 1, jpkm1 )
zuu(ji,jj,jk) = zuu(ji,jj,jk) + un_td(ji,jj,jk)
zvv(ji,jj,jk) = zvv(ji,jj,jk) + vn_td(ji,jj,jk)
END_3D
ENDIF
!
IF( ln_ldfeiv .AND. .NOT. ln_traldf_triad ) &
& CALL ldf_eiv_trp( kt, nittrc000, zuu, zvv, zww, 'TRC', Kmm, Krhs ) ! add the eiv transport
!
IF( ln_mle ) CALL tra_mle_trp( kt, nittrc000, zuu, zvv, zww, 'TRC', Kmm ) ! add the mle transport
!
ENDIF
!
SELECT CASE ( nadv ) !== compute advection trend and add it to general trend ==!
!
CASE ( np_CEN ) ! Centered : 2nd / 4th order
IF( nn_hls == 1 ) THEN
CALL tra_adv_cen_hls1( kt, nittrc000,'TRC', zuu, zvv, zww, Kmm, ptr, jptra, Krhs, nn_cen_h, nn_cen_v )
ELSE
CALL tra_adv_cen ( kt, nittrc000,'TRC', zuu, zvv, zww, Kmm, ptr, jptra, Krhs, nn_cen_h, nn_cen_v )
ENDIF
CASE ( np_FCT ) ! FCT : 2nd / 4th order
CALL tra_adv_fct( kt, nittrc000,'TRC', rDt_trc, zuu, zvv, zww, Kbb, Kmm, ptr, jptra, Krhs, nn_fct_h, nn_fct_v )
CASE ( np_MUS ) ! MUSCL
IF( nn_hls == 1 ) THEN
CALL tra_adv_mus_hls1( kt, nittrc000,'TRC', rDt_trc, zuu, zvv, zww, Kbb, Kmm, ptr, jptra, Krhs, ln_mus_ups )
ELSE
CALL tra_adv_mus( kt, nittrc000,'TRC', rDt_trc, zuu, zvv, zww, Kbb, Kmm, ptr, jptra, Krhs, ln_mus_ups )
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
CASE ( np_UBS ) ! UBS
CALL tra_adv_ubs ( kt, nittrc000,'TRC', rDt_trc, zuu, zvv, zww, Kbb, Kmm, ptr, jptra, Krhs, nn_ubs_v )
CASE ( np_QCK ) ! QUICKEST
CALL tra_adv_qck ( kt, nittrc000,'TRC', rDt_trc, zuu, zvv, zww, Kbb, Kmm, ptr, jptra, Krhs )
!
END SELECT
!
IF( sn_cfctl%l_prttrc ) THEN !== print mean trends (used for debugging)
WRITE(charout, FMT="('adv ')")
CALL prt_ctl_info( charout, cdcomp = 'top' )
CALL prt_ctl( tab4d_1=tr(:,:,:,:,Krhs), mask1=tmask, clinfo=ctrcnm, clinfo3='trd' )
END IF
!
IF( ln_timing ) CALL timing_stop('trc_adv')
!
END SUBROUTINE trc_adv
SUBROUTINE trc_adv_ini
!!---------------------------------------------------------------------
!! *** ROUTINE trc_adv_ini ***
!!
!! ** Purpose : Control the consistency between namelist options for
!! passive tracer advection schemes and set nadv
!!----------------------------------------------------------------------
INTEGER :: ioptio, ios ! Local integer
!!
NAMELIST/namtrc_adv/ ln_trcadv_OFF, & ! No advection
& ln_trcadv_cen, nn_cen_h, nn_cen_v, & ! CEN
& ln_trcadv_fct, nn_fct_h, nn_fct_v, & ! FCT
& ln_trcadv_mus, ln_mus_ups, & ! MUSCL
& ln_trcadv_ubs, nn_ubs_v, & ! UBS
& ln_trcadv_qck ! QCK
!!----------------------------------------------------------------------
!
! !== Namelist ==!
READ ( numnat_ref, namtrc_adv, IOSTAT = ios, ERR = 901)
901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_adv in reference namelist' )
READ ( numnat_cfg, namtrc_adv, IOSTAT = ios, ERR = 902 )
902 IF( ios > 0 ) CALL ctl_nam ( ios , 'namtrc_adv in configuration namelist' )
IF(lwm) WRITE ( numont, namtrc_adv )
!
IF(lwp) THEN ! Namelist print
WRITE(numout,*)
WRITE(numout,*) 'trc_adv_ini : choice/control of the tracer advection scheme'
WRITE(numout,*) '~~~~~~~~~~~'
WRITE(numout,*) ' Namelist namtrc_adv : chose a advection scheme for tracers'
WRITE(numout,*) ' No advection on passive tracers ln_trcadv_OFF = ', ln_trcadv_OFF
WRITE(numout,*) ' centered scheme ln_trcadv_cen = ', ln_trcadv_cen
WRITE(numout,*) ' horizontal 2nd/4th order nn_cen_h = ', nn_fct_h
WRITE(numout,*) ' vertical 2nd/4th order nn_cen_v = ', nn_fct_v
WRITE(numout,*) ' Flux Corrected Transport scheme ln_trcadv_fct = ', ln_trcadv_fct
WRITE(numout,*) ' horizontal 2nd/4th order nn_fct_h = ', nn_fct_h
WRITE(numout,*) ' vertical 2nd/4th order nn_fct_v = ', nn_fct_v
WRITE(numout,*) ' MUSCL scheme ln_trcadv_mus = ', ln_trcadv_mus
WRITE(numout,*) ' + upstream scheme near river mouths ln_mus_ups = ', ln_mus_ups
WRITE(numout,*) ' UBS scheme ln_trcadv_ubs = ', ln_trcadv_ubs
WRITE(numout,*) ' vertical 2nd/4th order nn_ubs_v = ', nn_ubs_v
WRITE(numout,*) ' QUICKEST scheme ln_trcadv_qck = ', ln_trcadv_qck
ENDIF
!
! !== Parameter control & set nadv ==!
ioptio = 0
IF( ln_trcadv_OFF ) THEN ; ioptio = ioptio + 1 ; nadv = np_NO_adv ; ENDIF
IF( ln_trcadv_cen ) THEN ; ioptio = ioptio + 1 ; nadv = np_CEN ; ENDIF
IF( ln_trcadv_fct ) THEN ; ioptio = ioptio + 1 ; nadv = np_FCT ; ENDIF
IF( ln_trcadv_mus ) THEN ; ioptio = ioptio + 1 ; nadv = np_MUS ; ENDIF
IF( ln_trcadv_ubs ) THEN ; ioptio = ioptio + 1 ; nadv = np_UBS ; ENDIF
IF( ln_trcadv_qck ) THEN ; ioptio = ioptio + 1 ; nadv = np_QCK ; ENDIF
!
IF( ioptio /= 1 ) CALL ctl_stop( 'trc_adv_ini: Choose ONE advection option in namelist namtrc_adv' )
!
IF( ln_trcadv_cen .AND. ( nn_cen_h /= 2 .AND. nn_cen_h /= 4 ) &
.AND. ( nn_cen_v /= 2 .AND. nn_cen_v /= 4 ) ) THEN
CALL ctl_stop( 'trc_adv_ini: CEN scheme, choose 2nd or 4th order' )
ENDIF
IF( ln_trcadv_fct .AND. ( nn_fct_h /= 2 .AND. nn_fct_h /= 4 ) &
.AND. ( nn_fct_v /= 2 .AND. nn_fct_v /= 4 ) ) THEN
CALL ctl_stop( 'trc_adv_ini: FCT scheme, choose 2nd or 4th order' )
ENDIF
IF( ln_trcadv_ubs .AND. ( nn_ubs_v /= 2 .AND. nn_ubs_v /= 4 ) ) THEN
CALL ctl_stop( 'trc_adv_ini: UBS scheme, choose 2nd or 4th order' )
ENDIF
IF( ln_trcadv_ubs .AND. nn_ubs_v == 4 ) THEN
CALL ctl_warn( 'trc_adv_ini: UBS scheme, only 2nd FCT scheme available on the vertical. It will be used' )
ENDIF
IF( ln_isfcav ) THEN ! ice-shelf cavities
IF( ln_trcadv_cen .AND. nn_cen_v == 4 .OR. & ! NO 4th order with ISF
& ln_trcadv_fct .AND. nn_fct_v == 4 ) CALL ctl_stop( 'tra_adv_ini: 4th order COMPACT scheme not allowed with ISF' )
ENDIF
!
! !== Print the choice ==!
IF(lwp) THEN
WRITE(numout,*)
SELECT CASE ( nadv )
CASE( np_NO_adv ) ; WRITE(numout,*) ' ===>> NO passive tracer advection'
CASE( np_CEN ) ; WRITE(numout,*) ' ===>> CEN scheme is used. Horizontal order: ', nn_cen_h, &
& ' Vertical order: ', nn_cen_v
CASE( np_FCT ) ; WRITE(numout,*) ' ===>> FCT scheme is used. Horizontal order: ', nn_fct_h, &
& ' Vertical order: ', nn_fct_v
CASE( np_MUS ) ; WRITE(numout,*) ' ===>> MUSCL scheme is used'
CASE( np_UBS ) ; WRITE(numout,*) ' ===>> UBS scheme is used'
CASE( np_QCK ) ; WRITE(numout,*) ' ===>> QUICKEST scheme is used'
END SELECT
ENDIF
!
END SUBROUTINE trc_adv_ini
#endif
!!======================================================================
END MODULE trcadv