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.
trcadv.F90 in NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/TOP/TRP – NEMO

source: NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/TOP/TRP/trcadv.F90 @ 10946

Last change on this file since 10946 was 10946, checked in by acc, 5 years ago

2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps : Convert STO, TRD and USR modules and all knock on effects of these conversions. Note change to USR module may have implications for the TEST CASES (not tested yet). Standard SETTE tested only
  • Property svn:keywords set to Id
File size: 14.1 KB
Line 
1MODULE trcadv
2   !!==============================================================================
3   !!                       ***  MODULE  trcadv  ***
4   !! Ocean passive tracers:  advection trend
5   !!==============================================================================
6   !! History :  2.0  !  2005-11  (G. Madec)  Original code
7   !!            3.0  !  2010-06  (C. Ethe)   Adapted to passive tracers
8   !!            3.7  !  2014-05  (G. Madec, C. Ethe)  Add 2nd/4th order cases for CEN and FCT schemes
9   !!            4.0  !  2017-09  (G. Madec)  remove vertical time-splitting option
10   !!----------------------------------------------------------------------
11#if defined key_top
12   !!----------------------------------------------------------------------
13   !!   'key_top'                                                TOP models
14   !!----------------------------------------------------------------------
15   !!   trc_adv       : compute ocean tracer advection trend
16   !!   trc_adv_ini   : control the different options of advection scheme
17   !!----------------------------------------------------------------------
18   USE oce_trc        ! ocean dynamics and active tracers
19   USE trc            ! ocean passive tracers variables
20   USE sbcwave        ! wave module
21   USE sbc_oce        ! surface boundary condition: ocean
22   USE traadv_cen     ! centered scheme           (tra_adv_cen  routine)
23   USE traadv_fct     ! FCT      scheme           (tra_adv_fct  routine)
24   USE traadv_mus     ! MUSCL    scheme           (tra_adv_mus  routine)
25   USE traadv_ubs     ! UBS      scheme           (tra_adv_ubs  routine)
26   USE traadv_qck     ! QUICKEST scheme           (tra_adv_qck  routine)
27   USE tramle         ! ML eddy induced transport (tra_adv_mle  routine)
28   USE ldftra         ! lateral diffusion: eddy diffusivity & EIV coeff.
29   USE ldfslp         ! Lateral diffusion: slopes of neutral surfaces
30   !
31   USE prtctl_trc     ! control print
32   USE timing         ! Timing
33
34   IMPLICIT NONE
35   PRIVATE
36
37   PUBLIC   trc_adv       ! called by trctrp.F90
38   PUBLIC   trc_adv_ini   ! called by trcini.F90
39
40   !                            !!* Namelist namtrc_adv *
41   LOGICAL ::   ln_trcadv_OFF    ! no advection on passive tracers
42   LOGICAL ::   ln_trcadv_cen    ! centered scheme flag
43   INTEGER ::      nn_cen_h, nn_cen_v   ! =2/4 : horizontal and vertical choices of the order of CEN scheme
44   LOGICAL ::   ln_trcadv_fct    ! FCT scheme flag
45   INTEGER ::      nn_fct_h, nn_fct_v   ! =2/4 : horizontal and vertical choices of the order of FCT scheme
46   LOGICAL ::   ln_trcadv_mus    ! MUSCL scheme flag
47   LOGICAL ::      ln_mus_ups           ! use upstream scheme in vivcinity of river mouths
48   LOGICAL ::   ln_trcadv_ubs    ! UBS scheme flag
49   INTEGER ::      nn_ubs_v             ! =2/4 : vertical choice of the order of UBS scheme
50   LOGICAL ::   ln_trcadv_qck    ! QUICKEST scheme flag
51
52   INTEGER ::   nadv             ! choice of the type of advection scheme
53   !                             ! associated indices:
54   INTEGER, PARAMETER ::   np_NO_adv  = 0   ! no T-S advection
55   INTEGER, PARAMETER ::   np_CEN     = 1   ! 2nd/4th order centered scheme
56   INTEGER, PARAMETER ::   np_FCT     = 2   ! 2nd/4th order Flux Corrected Transport scheme
57   INTEGER, PARAMETER ::   np_MUS     = 3   ! MUSCL scheme
58   INTEGER, PARAMETER ::   np_UBS     = 4   ! 3rd order Upstream Biased Scheme
59   INTEGER, PARAMETER ::   np_QCK     = 5   ! QUICK scheme
60   
61   !! * Substitutions
62#  include "vectopt_loop_substitute.h90"
63   !!----------------------------------------------------------------------
64   !! NEMO/TOP 4.0 , NEMO Consortium (2018)
65   !! $Id$
66   !! Software governed by the CeCILL license (see ./LICENSE)
67   !!----------------------------------------------------------------------
68CONTAINS
69
70   SUBROUTINE trc_adv( kt, Kbb, Kmm, ptr, Krhs  )
71      !!----------------------------------------------------------------------
72      !!                  ***  ROUTINE trc_adv  ***
73      !!
74      !! ** Purpose :   compute the ocean tracer advection trend.
75      !!
76      !! ** Method  : - Update after tracers (tra) with the advection term following nadv
77      !!----------------------------------------------------------------------
78      INTEGER                                   , INTENT(in)    :: kt   ! ocean time-step index
79      INTEGER                                   , INTENT(in)    :: Kbb, Kmm, Krhs ! time level indices
80      REAL(wp), DIMENSION(jpi,jpj,jpk,jptra,jpt), INTENT(inout) :: ptr            ! passive tracers and RHS of tracer equation
81      !
82      INTEGER ::   jk   ! dummy loop index
83      CHARACTER (len=22) ::   charout
84      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zun, zvn, zwn  ! effective velocity
85      !!----------------------------------------------------------------------
86      !
87      IF( ln_timing )   CALL timing_start('trc_adv')
88      !
89      !                                         !==  effective transport  ==!
90      IF( l_offline ) THEN
91         zun(:,:,:) = un(:,:,:)                    ! already in (un,vn,wn)
92         zvn(:,:,:) = vn(:,:,:)
93         zwn(:,:,:) = wn(:,:,:)
94      ELSE                                         ! build the effective transport
95         zun(:,:,jpk) = 0._wp
96         zvn(:,:,jpk) = 0._wp
97         zwn(:,:,jpk) = 0._wp
98         IF( ln_wave .AND. ln_sdw )  THEN
99            DO jk = 1, jpkm1                                                       ! eulerian transport + Stokes Drift
100               zun(:,:,jk) = e2u  (:,:) * e3u_n(:,:,jk) * ( un(:,:,jk) + usd(:,:,jk) )
101               zvn(:,:,jk) = e1v  (:,:) * e3v_n(:,:,jk) * ( vn(:,:,jk) + vsd(:,:,jk) )
102               zwn(:,:,jk) = e1e2t(:,:)                 * ( wn(:,:,jk) + wsd(:,:,jk) )
103            END DO
104         ELSE
105            DO jk = 1, jpkm1
106               zun(:,:,jk) = e2u  (:,:) * e3u_n(:,:,jk) * un(:,:,jk)                   ! eulerian transport
107               zvn(:,:,jk) = e1v  (:,:) * e3v_n(:,:,jk) * vn(:,:,jk)
108               zwn(:,:,jk) = e1e2t(:,:)                 * wn(:,:,jk)
109            END DO
110         ENDIF
111         !
112         IF( ln_vvl_ztilde .OR. ln_vvl_layer ) THEN                                 ! add z-tilde and/or vvl corrections
113            zun(:,:,:) = zun(:,:,:) + un_td(:,:,:)
114            zvn(:,:,:) = zvn(:,:,:) + vn_td(:,:,:)
115         ENDIF
116         !
117         IF( ln_ldfeiv .AND. .NOT. ln_traldf_triad )   & 
118            &              CALL ldf_eiv_trp( kt, nittrc000, zun, zvn, zwn, 'TRC', Kmm, Krhs )  ! add the eiv transport
119         !
120         IF( ln_mle    )   CALL tra_mle_trp( kt, nittrc000, zun, zvn, zwn, 'TRC' )  ! add the mle transport
121         !
122      ENDIF
123      !
124      SELECT CASE ( nadv )                      !==  compute advection trend and add it to general trend  ==!
125      !
126      CASE ( np_CEN )                                 ! Centered : 2nd / 4th order
127         CALL tra_adv_cen( kt, nittrc000,'TRC',          zun, zvn, zwn,      Kmm, ptr, jptra, Krhs, nn_cen_h, nn_cen_v )
128      CASE ( np_FCT )                                 ! FCT      : 2nd / 4th order
129         CALL tra_adv_fct( kt, nittrc000,'TRC', r2dttrc, zun, zvn, zwn, Kbb, Kmm, ptr, jptra, Krhs, nn_fct_h, nn_fct_v )
130      CASE ( np_MUS )                                 ! MUSCL
131         CALL tra_adv_mus( kt, nittrc000,'TRC', r2dttrc, zun, zvn, zwn, Kbb, Kmm, ptr, jptra, Krhs, ln_mus_ups         ) 
132      CASE ( np_UBS )                                 ! UBS
133         CALL tra_adv_ubs( kt, nittrc000,'TRC', r2dttrc, zun, zvn, zwn, Kbb, Kmm, ptr, jptra, Krhs, nn_ubs_v           )
134      CASE ( np_QCK )                                 ! QUICKEST
135         CALL tra_adv_qck( kt, nittrc000,'TRC', r2dttrc, zun, zvn, zwn, Kbb, Kmm, ptr, jptra, Krhs                     )
136      !
137      END SELECT
138      !                 
139      IF( ln_ctl ) THEN                         !== print mean trends (used for debugging)
140         WRITE(charout, FMT="('adv ')")
141         CALL prt_ctl_trc_info(charout)
142         CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' )
143      END IF
144      !
145      IF( ln_timing )   CALL timing_stop('trc_adv')
146      !
147   END SUBROUTINE trc_adv
148
149
150   SUBROUTINE trc_adv_ini
151      !!---------------------------------------------------------------------
152      !!                  ***  ROUTINE trc_adv_ini  ***
153      !!               
154      !! ** Purpose :   Control the consistency between namelist options for
155      !!              passive tracer advection schemes and set nadv
156      !!----------------------------------------------------------------------
157      INTEGER ::   ioptio, ios   ! Local integer
158      !!
159      NAMELIST/namtrc_adv/ ln_trcadv_OFF,                        &   ! No advection
160         &                 ln_trcadv_cen, nn_cen_h, nn_cen_v,    &   ! CEN
161         &                 ln_trcadv_fct, nn_fct_h, nn_fct_v,    &   ! FCT
162         &                 ln_trcadv_mus, ln_mus_ups,            &   ! MUSCL
163         &                 ln_trcadv_ubs,           nn_ubs_v,    &   ! UBS
164         &                 ln_trcadv_qck                             ! QCK
165      !!----------------------------------------------------------------------
166      !
167      !                                !==  Namelist  ==!
168      REWIND( numnat_ref )                   !  namtrc_adv in reference namelist
169      READ  ( numnat_ref, namtrc_adv, IOSTAT = ios, ERR = 901)
170901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namtrc_adv in reference namelist', lwp )
171      REWIND( numnat_cfg )                   ! namtrc_adv in configuration namelist
172      READ  ( numnat_cfg, namtrc_adv, IOSTAT = ios, ERR = 902 )
173902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namtrc_adv in configuration namelist', lwp )
174      IF(lwm) WRITE ( numont, namtrc_adv )
175      !
176      IF(lwp) THEN                           ! Namelist print
177         WRITE(numout,*)
178         WRITE(numout,*) 'trc_adv_ini : choice/control of the tracer advection scheme'
179         WRITE(numout,*) '~~~~~~~~~~~'
180         WRITE(numout,*) '   Namelist namtrc_adv : chose a advection scheme for tracers'
181         WRITE(numout,*) '      No advection on passive tracers           ln_trcadv_OFF = ', ln_trcadv_OFF
182         WRITE(numout,*) '      centered scheme                           ln_trcadv_cen = ', ln_trcadv_cen
183         WRITE(numout,*) '            horizontal 2nd/4th order               nn_cen_h   = ', nn_fct_h
184         WRITE(numout,*) '            vertical   2nd/4th order               nn_cen_v   = ', nn_fct_v
185         WRITE(numout,*) '      Flux Corrected Transport scheme           ln_trcadv_fct = ', ln_trcadv_fct
186         WRITE(numout,*) '            horizontal 2nd/4th order               nn_fct_h   = ', nn_fct_h
187         WRITE(numout,*) '            vertical   2nd/4th order               nn_fct_v   = ', nn_fct_v
188         WRITE(numout,*) '      MUSCL scheme                              ln_trcadv_mus = ', ln_trcadv_mus
189         WRITE(numout,*) '            + upstream scheme near river mouths    ln_mus_ups = ', ln_mus_ups
190         WRITE(numout,*) '      UBS scheme                                ln_trcadv_ubs = ', ln_trcadv_ubs
191         WRITE(numout,*) '            vertical   2nd/4th order               nn_ubs_v   = ', nn_ubs_v
192         WRITE(numout,*) '      QUICKEST scheme                           ln_trcadv_qck = ', ln_trcadv_qck
193      ENDIF
194      !
195      !                                !==  Parameter control & set nadv ==!
196      ioptio = 0
197      IF( ln_trcadv_OFF ) THEN   ;   ioptio = ioptio + 1   ;   nadv = np_NO_adv   ;   ENDIF
198      IF( ln_trcadv_cen ) THEN   ;   ioptio = ioptio + 1   ;   nadv = np_CEN      ;   ENDIF
199      IF( ln_trcadv_fct ) THEN   ;   ioptio = ioptio + 1   ;   nadv = np_FCT      ;   ENDIF
200      IF( ln_trcadv_mus ) THEN   ;   ioptio = ioptio + 1   ;   nadv = np_MUS      ;   ENDIF
201      IF( ln_trcadv_ubs ) THEN   ;   ioptio = ioptio + 1   ;   nadv = np_UBS      ;   ENDIF
202      IF( ln_trcadv_qck ) THEN   ;   ioptio = ioptio + 1   ;   nadv = np_QCK      ;   ENDIF
203      !
204      IF( ioptio /= 1 )   CALL ctl_stop( 'trc_adv_ini: Choose ONE advection option in namelist namtrc_adv' )
205      !
206      IF( ln_trcadv_cen .AND. ( nn_cen_h /= 2 .AND. nn_cen_h /= 4 )   &
207                        .AND. ( nn_cen_v /= 2 .AND. nn_cen_v /= 4 )   ) THEN
208        CALL ctl_stop( 'trc_adv_ini: CEN scheme, choose 2nd or 4th order' )
209      ENDIF
210      IF( ln_trcadv_fct .AND. ( nn_fct_h /= 2 .AND. nn_fct_h /= 4 )   &
211                        .AND. ( nn_fct_v /= 2 .AND. nn_fct_v /= 4 )   ) THEN
212        CALL ctl_stop( 'trc_adv_ini: FCT scheme, choose 2nd or 4th order' )
213      ENDIF
214      IF( ln_trcadv_ubs .AND. ( nn_ubs_v /= 2 .AND. nn_ubs_v /= 4 )   ) THEN
215        CALL ctl_stop( 'trc_adv_ini: UBS scheme, choose 2nd or 4th order' )
216      ENDIF
217      IF( ln_trcadv_ubs .AND. nn_ubs_v == 4 ) THEN
218         CALL ctl_warn( 'trc_adv_ini: UBS scheme, only 2nd FCT scheme available on the vertical. It will be used' )
219      ENDIF
220      IF( ln_isfcav ) THEN                                                       ! ice-shelf cavities
221         IF(  ln_trcadv_cen .AND. nn_cen_v == 4    .OR.   &                            ! NO 4th order with ISF
222            & ln_trcadv_fct .AND. nn_fct_v == 4   )   CALL ctl_stop( 'tra_adv_ini: 4th order COMPACT scheme not allowed with ISF' )
223      ENDIF
224      !
225      !                                !==  Print the choice  ==! 
226      IF(lwp) THEN
227         WRITE(numout,*)
228         SELECT CASE ( nadv )
229         CASE( np_NO_adv  )   ;   WRITE(numout,*) '      ===>>   NO passive tracer advection'
230         CASE( np_CEN     )   ;   WRITE(numout,*) '      ===>>   CEN      scheme is used. Horizontal order: ', nn_cen_h,   &
231            &                                                                     ' Vertical   order: ', nn_cen_v
232         CASE( np_FCT     )   ;   WRITE(numout,*) '      ===>>   FCT      scheme is used. Horizontal order: ', nn_fct_h,   &
233            &                                                                      ' Vertical   order: ', nn_fct_v
234         CASE( np_MUS     )   ;   WRITE(numout,*) '      ===>>   MUSCL    scheme is used'
235         CASE( np_UBS     )   ;   WRITE(numout,*) '      ===>>   UBS      scheme is used'
236         CASE( np_QCK     )   ;   WRITE(numout,*) '      ===>>   QUICKEST scheme is used'
237         END SELECT
238      ENDIF
239      !
240   END SUBROUTINE trc_adv_ini
241   
242#endif
243
244  !!======================================================================
245END MODULE trcadv
Note: See TracBrowser for help on using the repository browser.