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.
traadv.F90 in NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/OCE/TRA – NEMO

source: NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/OCE/TRA/traadv.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: 15.9 KB
Line 
1MODULE traadv
2   !!==============================================================================
3   !!                       ***  MODULE  traadv  ***
4   !! Ocean active tracers:  advection trend
5   !!==============================================================================
6   !! History :  2.0  !  2005-11  (G. Madec)  Original code
7   !!            3.3  !  2010-09  (C. Ethe, G. Madec)  merge TRC-TRA + switch from velocity to transport
8   !!            3.6  !  2011-06  (G. Madec)  Addition of Mixed Layer Eddy parameterisation
9   !!            3.7  !  2014-05  (G. Madec)  Add 2nd/4th order cases for CEN and FCT schemes
10   !!             -   !  2014-12  (G. Madec) suppression of cross land advection option
11   !!            3.6  !  2015-06  (E. Clementi) Addition of Stokes drift in case of wave coupling
12   !!----------------------------------------------------------------------
13
14   !!----------------------------------------------------------------------
15   !!   tra_adv       : compute ocean tracer advection trend
16   !!   tra_adv_init  : control the different options of advection scheme
17   !!----------------------------------------------------------------------
18   USE oce            ! ocean dynamics and active tracers
19   USE dom_oce        ! ocean space and time domain
20   USE domvvl         ! variable vertical scale factors
21   USE sbcwave        ! wave module
22   USE sbc_oce        ! surface boundary condition: ocean
23   USE traadv_cen     ! centered scheme            (tra_adv_cen  routine)
24   USE traadv_fct     ! FCT      scheme            (tra_adv_fct  routine)
25   USE traadv_mus     ! MUSCL    scheme            (tra_adv_mus  routine)
26   USE traadv_ubs     ! UBS      scheme            (tra_adv_ubs  routine)
27   USE traadv_qck     ! QUICKEST scheme            (tra_adv_qck  routine)
28   USE tramle         ! Mixed Layer Eddy transport (tra_mle_trp  routine)
29   USE ldftra         ! Eddy Induced transport     (ldf_eiv_trp  routine)
30   USE ldfslp         ! Lateral diffusion: slopes of neutral surfaces
31   USE trd_oce        ! trends: ocean variables
32   USE trdtra         ! trends manager: tracers
33   USE diaptr         ! Poleward heat transport
34   !
35   USE in_out_manager ! I/O manager
36   USE iom            ! I/O module
37   USE prtctl         ! Print control
38   USE lib_mpp        ! MPP library
39   USE timing         ! Timing
40
41   IMPLICIT NONE
42   PRIVATE
43
44   PUBLIC   tra_adv        ! called by step.F90
45   PUBLIC   tra_adv_init   ! called by nemogcm.F90
46
47   !                            !!* Namelist namtra_adv *
48   LOGICAL ::   ln_traadv_OFF    ! no advection on T and S
49   LOGICAL ::   ln_traadv_cen    ! centered scheme flag
50   INTEGER ::      nn_cen_h, nn_cen_v   ! =2/4 : horizontal and vertical choices of the order of CEN scheme
51   LOGICAL ::   ln_traadv_fct    ! FCT scheme flag
52   INTEGER ::      nn_fct_h, nn_fct_v   ! =2/4 : horizontal and vertical choices of the order of FCT scheme
53   LOGICAL ::   ln_traadv_mus    ! MUSCL scheme flag
54   LOGICAL ::      ln_mus_ups           ! use upstream scheme in vivcinity of river mouths
55   LOGICAL ::   ln_traadv_ubs    ! UBS scheme flag
56   INTEGER ::      nn_ubs_v             ! =2/4 : vertical choice of the order of UBS scheme
57   LOGICAL ::   ln_traadv_qck    ! QUICKEST scheme flag
58
59   INTEGER ::   nadv             ! choice of the type of advection scheme
60   !                             ! associated indices:
61   INTEGER, PARAMETER ::   np_NO_adv  = 0   ! no T-S advection
62   INTEGER, PARAMETER ::   np_CEN     = 1   ! 2nd/4th order centered scheme
63   INTEGER, PARAMETER ::   np_FCT     = 2   ! 2nd/4th order Flux Corrected Transport scheme
64   INTEGER, PARAMETER ::   np_MUS     = 3   ! MUSCL scheme
65   INTEGER, PARAMETER ::   np_UBS     = 4   ! 3rd order Upstream Biased Scheme
66   INTEGER, PARAMETER ::   np_QCK     = 5   ! QUICK scheme
67   
68   !! * Substitutions
69#  include "vectopt_loop_substitute.h90"
70   !!----------------------------------------------------------------------
71   !! NEMO/OCE 4.0 , NEMO Consortium (2018)
72   !! $Id$
73   !! Software governed by the CeCILL license (see ./LICENSE)
74   !!----------------------------------------------------------------------
75CONTAINS
76
77   SUBROUTINE tra_adv( kt, Kbb, Kmm, pts, Krhs )
78      !!----------------------------------------------------------------------
79      !!                  ***  ROUTINE tra_adv  ***
80      !!
81      !! ** Purpose :   compute the ocean tracer advection trend.
82      !!
83      !! ** Method  : - Update (uu(:,:,:,Krhs),vv(:,:,:,Krhs)) with the advection term following nadv
84      !!----------------------------------------------------------------------
85      INTEGER                                  , INTENT(in)    :: kt             ! ocean time-step index
86      INTEGER                                  , INTENT(in)    :: Kbb, Kmm, Krhs ! time level indices
87      REAL(wp), DIMENSION(jpi,jpj,jpk,jpts,jpt), INTENT(inout) :: pts            ! active tracers and RHS of tracer equation
88      !
89      INTEGER ::   jk   ! dummy loop index
90      REAL(wp), DIMENSION(jpi,jpj,jpk)        :: zuu, zvv, zww   ! 3D workspace
91      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::   ztrdt, ztrds
92      !!----------------------------------------------------------------------
93      !
94      IF( ln_timing )   CALL timing_start('tra_adv')
95      !
96      !                                          ! set time step
97      IF( neuler == 0 .AND. kt == nit000 ) THEN   ;   r2dt =         rdt   ! at nit000             (Euler)
98      ELSEIF( kt <= nit000 + 1 )           THEN   ;   r2dt = 2._wp * rdt   ! at nit000 or nit000+1 (Leapfrog)
99      ENDIF
100      !
101      !                                         !==  effective transport  ==!
102      zuu(:,:,jpk) = 0._wp
103      zvv(:,:,jpk) = 0._wp
104      zww(:,:,jpk) = 0._wp
105      IF( ln_wave .AND. ln_sdw )  THEN
106         DO jk = 1, jpkm1                                                       ! eulerian transport + Stokes Drift
107            zuu(:,:,jk) = e2u  (:,:) * e3u(:,:,jk,Kmm) * ( uu(:,:,jk,Kmm) + usd(:,:,jk) )
108            zvv(:,:,jk) = e1v  (:,:) * e3v(:,:,jk,Kmm) * ( vv(:,:,jk,Kmm) + vsd(:,:,jk) )
109            zww(:,:,jk) = e1e2t(:,:)                 * ( ww(:,:,jk) + wsd(:,:,jk) )
110         END DO
111      ELSE
112         DO jk = 1, jpkm1
113            zuu(:,:,jk) = e2u  (:,:) * e3u(:,:,jk,Kmm) * uu(:,:,jk,Kmm)               ! eulerian transport only
114            zvv(:,:,jk) = e1v  (:,:) * e3v(:,:,jk,Kmm) * vv(:,:,jk,Kmm)
115            zww(:,:,jk) = e1e2t(:,:)                 * ww(:,:,jk)
116         END DO
117      ENDIF
118      !
119      IF( ln_vvl_ztilde .OR. ln_vvl_layer ) THEN                                ! add z-tilde and/or vvl corrections
120         zuu(:,:,:) = zuu(:,:,:) + un_td(:,:,:)
121         zvv(:,:,:) = zvv(:,:,:) + vn_td(:,:,:)
122      ENDIF
123      !
124      zuu(:,:,jpk) = 0._wp                                                      ! no transport trough the bottom
125      zvv(:,:,jpk) = 0._wp
126      zww(:,:,jpk) = 0._wp
127      !
128      IF( ln_ldfeiv .AND. .NOT. ln_traldf_triad )   &
129         &              CALL ldf_eiv_trp( kt, nit000, zuu, zvv, zww, 'TRA', Kmm, Krhs )   ! add the eiv transport (if necessary)
130      !
131      IF( ln_mle    )   CALL tra_mle_trp( kt, nit000, zuu, zvv, zww, 'TRA' )   ! add the mle transport (if necessary)
132      !
133      CALL iom_put( "uocetr_eff", zuu )                                        ! output effective transport     
134      CALL iom_put( "vocetr_eff", zvv )
135      CALL iom_put( "wocetr_eff", zww )
136      !
137!!gm ???
138      IF( ln_diaptr )   CALL dia_ptr( zvv )                                    ! diagnose the effective MSF
139!!gm ???
140      !
141      IF( l_trdtra )   THEN                    !* Save ta and sa trends
142         ALLOCATE( ztrdt(jpi,jpj,jpk), ztrds(jpi,jpj,jpk) )
143         ztrdt(:,:,:) = pts(:,:,:,jp_tem,Krhs)
144         ztrds(:,:,:) = pts(:,:,:,jp_sal,Krhs)
145      ENDIF
146      !
147      SELECT CASE ( nadv )                      !==  compute advection trend and add it to general trend  ==!
148      !
149      CASE ( np_CEN )                                 ! Centered scheme : 2nd / 4th order
150         CALL tra_adv_cen    ( kt, nit000, 'TRA',         zuu, zvv, zww, Kmm, pts, jpts, Krhs, nn_cen_h, nn_cen_v )
151      CASE ( np_FCT )                                 ! FCT scheme      : 2nd / 4th order
152         CALL tra_adv_fct    ( kt, nit000, 'TRA', r2dt, zuu, zvv, zww, Kbb, Kmm, pts, jpts, Krhs, nn_fct_h, nn_fct_v )
153      CASE ( np_MUS )                                 ! MUSCL
154         CALL tra_adv_mus    ( kt, nit000, 'TRA', r2dt, zuu, zvv, zww, Kbb, Kmm, pts, jpts, Krhs, ln_mus_ups ) 
155      CASE ( np_UBS )                                 ! UBS
156         CALL tra_adv_ubs    ( kt, nit000, 'TRA', r2dt, zuu, zvv, zww, Kbb, Kmm, pts, jpts, Krhs, nn_ubs_v   )
157      CASE ( np_QCK )                                 ! QUICKEST
158         CALL tra_adv_qck    ( kt, nit000, 'TRA', r2dt, zuu, zvv, zww, Kbb, Kmm, pts, jpts, Krhs )
159      !
160      END SELECT
161      !
162      IF( l_trdtra )   THEN                      ! save the advective trends for further diagnostics
163         DO jk = 1, jpkm1
164            ztrdt(:,:,jk) = pts(:,:,jk,jp_tem,Krhs) - ztrdt(:,:,jk)
165            ztrds(:,:,jk) = pts(:,:,jk,jp_sal,Krhs) - ztrds(:,:,jk)
166         END DO
167         CALL trd_tra( kt, Kmm, Krhs, 'TRA', jp_tem, jptra_totad, ztrdt )
168         CALL trd_tra( kt, Kmm, Krhs, 'TRA', jp_sal, jptra_totad, ztrds )
169         DEALLOCATE( ztrdt, ztrds )
170      ENDIF
171      !                                              ! print mean trends (used for debugging)
172      IF(ln_ctl)   CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' adv  - Ta: ', mask1=tmask,               &
173         &                       tab3d_2=tsa(:,:,:,jp_sal), clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' )
174      !
175      IF( ln_timing )   CALL timing_stop( 'tra_adv' )
176      !
177   END SUBROUTINE tra_adv
178
179
180   SUBROUTINE tra_adv_init
181      !!---------------------------------------------------------------------
182      !!                  ***  ROUTINE tra_adv_init  ***
183      !!               
184      !! ** Purpose :   Control the consistency between namelist options for
185      !!              tracer advection schemes and set nadv
186      !!----------------------------------------------------------------------
187      INTEGER ::   ioptio, ios   ! Local integers
188      !
189      NAMELIST/namtra_adv/ ln_traadv_OFF,                        &   ! No advection
190         &                 ln_traadv_cen , nn_cen_h, nn_cen_v,   &   ! CEN
191         &                 ln_traadv_fct , nn_fct_h, nn_fct_v,   &   ! FCT
192         &                 ln_traadv_mus , ln_mus_ups,           &   ! MUSCL
193         &                 ln_traadv_ubs ,           nn_ubs_v,   &   ! UBS
194         &                 ln_traadv_qck                             ! QCK
195      !!----------------------------------------------------------------------
196      !
197      !                                !==  Namelist  ==!
198      REWIND( numnam_ref )                   ! Namelist namtra_adv in reference namelist : Tracer advection scheme
199      READ  ( numnam_ref, namtra_adv, IOSTAT = ios, ERR = 901)
200901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namtra_adv in reference namelist', lwp )
201      !
202      REWIND( numnam_cfg )                   ! Namelist namtra_adv in configuration namelist : Tracer advection scheme
203      READ  ( numnam_cfg, namtra_adv, IOSTAT = ios, ERR = 902 )
204902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namtra_adv in configuration namelist', lwp )
205      IF(lwm) WRITE( numond, namtra_adv )
206      !
207      IF(lwp) THEN                           ! Namelist print
208         WRITE(numout,*)
209         WRITE(numout,*) 'tra_adv_init : choice/control of the tracer advection scheme'
210         WRITE(numout,*) '~~~~~~~~~~~~'
211         WRITE(numout,*) '   Namelist namtra_adv : chose a advection scheme for tracers'
212         WRITE(numout,*) '      No advection on T & S                     ln_traadv_OFF = ', ln_traadv_OFF
213         WRITE(numout,*) '      centered scheme                           ln_traadv_cen = ', ln_traadv_cen
214         WRITE(numout,*) '            horizontal 2nd/4th order               nn_cen_h   = ', nn_fct_h
215         WRITE(numout,*) '            vertical   2nd/4th order               nn_cen_v   = ', nn_fct_v
216         WRITE(numout,*) '      Flux Corrected Transport scheme           ln_traadv_fct = ', ln_traadv_fct
217         WRITE(numout,*) '            horizontal 2nd/4th order               nn_fct_h   = ', nn_fct_h
218         WRITE(numout,*) '            vertical   2nd/4th order               nn_fct_v   = ', nn_fct_v
219         WRITE(numout,*) '      MUSCL scheme                              ln_traadv_mus = ', ln_traadv_mus
220         WRITE(numout,*) '            + upstream scheme near river mouths    ln_mus_ups = ', ln_mus_ups
221         WRITE(numout,*) '      UBS scheme                                ln_traadv_ubs = ', ln_traadv_ubs
222         WRITE(numout,*) '            vertical   2nd/4th order               nn_ubs_v   = ', nn_ubs_v
223         WRITE(numout,*) '      QUICKEST scheme                           ln_traadv_qck = ', ln_traadv_qck
224      ENDIF
225      !
226      !                                !==  Parameter control & set nadv ==!
227      ioptio = 0                       
228      IF( ln_traadv_OFF ) THEN   ;   ioptio = ioptio + 1   ;   nadv = np_NO_adv   ;   ENDIF
229      IF( ln_traadv_cen ) THEN   ;   ioptio = ioptio + 1   ;   nadv = np_CEN      ;   ENDIF
230      IF( ln_traadv_fct ) THEN   ;   ioptio = ioptio + 1   ;   nadv = np_FCT      ;   ENDIF
231      IF( ln_traadv_mus ) THEN   ;   ioptio = ioptio + 1   ;   nadv = np_MUS      ;   ENDIF
232      IF( ln_traadv_ubs ) THEN   ;   ioptio = ioptio + 1   ;   nadv = np_UBS      ;   ENDIF
233      IF( ln_traadv_qck ) THEN   ;   ioptio = ioptio + 1   ;   nadv = np_QCK      ;   ENDIF
234      !
235      IF( ioptio /= 1 )   CALL ctl_stop( 'tra_adv_init: Choose ONE advection option in namelist namtra_adv' )
236      !
237      IF( ln_traadv_cen .AND. ( nn_cen_h /= 2 .AND. nn_cen_h /= 4 )   &          ! Centered
238                        .AND. ( nn_cen_v /= 2 .AND. nn_cen_v /= 4 )   ) THEN
239        CALL ctl_stop( 'tra_adv_init: CEN scheme, choose 2nd or 4th order' )
240      ENDIF
241      IF( ln_traadv_fct .AND. ( nn_fct_h /= 2 .AND. nn_fct_h /= 4 )   &          ! FCT
242                        .AND. ( nn_fct_v /= 2 .AND. nn_fct_v /= 4 )   ) THEN
243        CALL ctl_stop( 'tra_adv_init: FCT scheme, choose 2nd or 4th order' )
244      ENDIF
245      IF( ln_traadv_ubs .AND. ( nn_ubs_v /= 2 .AND. nn_ubs_v /= 4 )   ) THEN     ! UBS
246        CALL ctl_stop( 'tra_adv_init: UBS scheme, choose 2nd or 4th order' )
247      ENDIF
248      IF( ln_traadv_ubs .AND. nn_ubs_v == 4 ) THEN
249         CALL ctl_warn( 'tra_adv_init: UBS scheme, only 2nd FCT scheme available on the vertical. It will be used' )
250      ENDIF
251      IF( ln_isfcav ) THEN                                                       ! ice-shelf cavities
252         IF(  ln_traadv_cen .AND. nn_cen_v == 4    .OR.   &                            ! NO 4th order with ISF
253            & ln_traadv_fct .AND. nn_fct_v == 4   )   CALL ctl_stop( 'tra_adv_init: 4th order COMPACT scheme not allowed with ISF' )
254      ENDIF
255      !
256      !                                !==  Print the choice  ==! 
257      IF(lwp) THEN
258         WRITE(numout,*)
259         SELECT CASE ( nadv )
260         CASE( np_NO_adv  )   ;   WRITE(numout,*) '   ==>>>   NO T-S advection'
261         CASE( np_CEN     )   ;   WRITE(numout,*) '   ==>>>   CEN      scheme is used. Horizontal order: ', nn_cen_h,   &
262            &                                                                        ' Vertical   order: ', nn_cen_v
263         CASE( np_FCT     )   ;   WRITE(numout,*) '   ==>>>   FCT      scheme is used. Horizontal order: ', nn_fct_h,   &
264            &                                                                        ' Vertical   order: ', nn_fct_v
265         CASE( np_MUS     )   ;   WRITE(numout,*) '   ==>>>   MUSCL    scheme is used'
266         CASE( np_UBS     )   ;   WRITE(numout,*) '   ==>>>   UBS      scheme is used'
267         CASE( np_QCK     )   ;   WRITE(numout,*) '   ==>>>   QUICKEST scheme is used'
268         END SELECT
269      ENDIF
270      !
271      CALL tra_mle_init            !== initialisation of the Mixed Layer Eddy parametrisation (MLE)  ==!
272      !
273   END SUBROUTINE tra_adv_init
274
275  !!======================================================================
276END MODULE traadv
Note: See TracBrowser for help on using the repository browser.