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_r11613_ENHANCE-04_namelists_as_internalfiles/src/OCE/TRA – NEMO

source: NEMO/branches/2019/dev_r11613_ENHANCE-04_namelists_as_internalfiles/src/OCE/TRA/traadv.F90 @ 11954

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

Branch 2019/dev_r11613_ENHANCE-04_namelists_as_internalfiles. Final, non-substantive changes to complete this branch. These changes remove all REWIND statements on the old namelist fortran units (now character variables for internal files). These changes have been left until last since they are easily repeated via a script and it may be preferable to use the previous revision for merge purposes and reapply these last changes separately. This branch has been fully SETTE tested.
  • Property svn:keywords set to Id
File size: 15.3 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 )
78      !!----------------------------------------------------------------------
79      !!                  ***  ROUTINE tra_adv  ***
80      !!
81      !! ** Purpose :   compute the ocean tracer advection trend.
82      !!
83      !! ** Method  : - Update (ua,va) with the advection term following nadv
84      !!----------------------------------------------------------------------
85      INTEGER, INTENT(in) ::   kt   ! ocean time-step index
86      !
87      INTEGER ::   jk   ! dummy loop index
88      REAL(wp), DIMENSION(jpi,jpj,jpk)        :: zun, zvn, zwn   ! 3D workspace
89      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::   ztrdt, ztrds
90      !!----------------------------------------------------------------------
91      !
92      IF( ln_timing )   CALL timing_start('tra_adv')
93      !
94      !                                          ! set time step
95      IF( neuler == 0 .AND. kt == nit000 ) THEN   ;   r2dt =         rdt   ! at nit000             (Euler)
96      ELSEIF( kt <= nit000 + 1 )           THEN   ;   r2dt = 2._wp * rdt   ! at nit000 or nit000+1 (Leapfrog)
97      ENDIF
98      !
99      !                                         !==  effective transport  ==!
100      zun(:,:,jpk) = 0._wp
101      zvn(:,:,jpk) = 0._wp
102      zwn(:,:,jpk) = 0._wp
103      IF( ln_wave .AND. ln_sdw )  THEN
104         DO jk = 1, jpkm1                                                       ! eulerian transport + Stokes Drift
105            zun(:,:,jk) = e2u  (:,:) * e3u_n(:,:,jk) * ( un(:,:,jk) + usd(:,:,jk) )
106            zvn(:,:,jk) = e1v  (:,:) * e3v_n(:,:,jk) * ( vn(:,:,jk) + vsd(:,:,jk) )
107            zwn(:,:,jk) = e1e2t(:,:)                 * ( wn(:,:,jk) + wsd(:,:,jk) )
108         END DO
109      ELSE
110         DO jk = 1, jpkm1
111            zun(:,:,jk) = e2u  (:,:) * e3u_n(:,:,jk) * un(:,:,jk)               ! eulerian transport only
112            zvn(:,:,jk) = e1v  (:,:) * e3v_n(:,:,jk) * vn(:,:,jk)
113            zwn(:,:,jk) = e1e2t(:,:)                 * wn(:,:,jk)
114         END DO
115      ENDIF
116      !
117      IF( ln_vvl_ztilde .OR. ln_vvl_layer ) THEN                                ! add z-tilde and/or vvl corrections
118         zun(:,:,:) = zun(:,:,:) + un_td(:,:,:)
119         zvn(:,:,:) = zvn(:,:,:) + vn_td(:,:,:)
120      ENDIF
121      !
122      zun(:,:,jpk) = 0._wp                                                      ! no transport trough the bottom
123      zvn(:,:,jpk) = 0._wp
124      zwn(:,:,jpk) = 0._wp
125      !
126      IF( ln_ldfeiv .AND. .NOT. ln_traldf_triad )   &
127         &              CALL ldf_eiv_trp( kt, nit000, zun, zvn, zwn, 'TRA' )   ! add the eiv transport (if necessary)
128      !
129      IF( ln_mle    )   CALL tra_mle_trp( kt, nit000, zun, zvn, zwn, 'TRA' )   ! add the mle transport (if necessary)
130      !
131      CALL iom_put( "uocetr_eff", zun )                                        ! output effective transport     
132      CALL iom_put( "vocetr_eff", zvn )
133      CALL iom_put( "wocetr_eff", zwn )
134      !
135!!gm ???
136      IF( ln_diaptr )   CALL dia_ptr( zvn )                                    ! diagnose the effective MSF
137!!gm ???
138      !
139      IF( l_trdtra )   THEN                    !* Save ta and sa trends
140         ALLOCATE( ztrdt(jpi,jpj,jpk), ztrds(jpi,jpj,jpk) )
141         ztrdt(:,:,:) = tsa(:,:,:,jp_tem)
142         ztrds(:,:,:) = tsa(:,:,:,jp_sal)
143      ENDIF
144      !
145      SELECT CASE ( nadv )                      !==  compute advection trend and add it to general trend  ==!
146      !
147      CASE ( np_CEN )                                 ! Centered scheme : 2nd / 4th order
148         CALL tra_adv_cen    ( kt, nit000, 'TRA',         zun, zvn, zwn     , tsn, tsa, jpts, nn_cen_h, nn_cen_v )
149      CASE ( np_FCT )                                 ! FCT scheme      : 2nd / 4th order
150         CALL tra_adv_fct    ( kt, nit000, 'TRA', r2dt, zun, zvn, zwn, tsb, tsn, tsa, jpts, nn_fct_h, nn_fct_v )
151      CASE ( np_MUS )                                 ! MUSCL
152         CALL tra_adv_mus    ( kt, nit000, 'TRA', r2dt, zun, zvn, zwn, tsb,      tsa, jpts        , ln_mus_ups ) 
153      CASE ( np_UBS )                                 ! UBS
154         CALL tra_adv_ubs    ( kt, nit000, 'TRA', r2dt, zun, zvn, zwn, tsb, tsn, tsa, jpts        , nn_ubs_v   )
155      CASE ( np_QCK )                                 ! QUICKEST
156         CALL tra_adv_qck    ( kt, nit000, 'TRA', r2dt, zun, zvn, zwn, tsb, tsn, tsa, jpts                     )
157      !
158      END SELECT
159      !
160      IF( l_trdtra )   THEN                      ! save the advective trends for further diagnostics
161         DO jk = 1, jpkm1
162            ztrdt(:,:,jk) = tsa(:,:,jk,jp_tem) - ztrdt(:,:,jk)
163            ztrds(:,:,jk) = tsa(:,:,jk,jp_sal) - ztrds(:,:,jk)
164         END DO
165         CALL trd_tra( kt, 'TRA', jp_tem, jptra_totad, ztrdt )
166         CALL trd_tra( kt, 'TRA', jp_sal, jptra_totad, ztrds )
167         DEALLOCATE( ztrdt, ztrds )
168      ENDIF
169      !                                              ! print mean trends (used for debugging)
170      IF(ln_ctl)   CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' adv  - Ta: ', mask1=tmask,               &
171         &                       tab3d_2=tsa(:,:,:,jp_sal), clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' )
172      !
173      IF( ln_timing )   CALL timing_stop( 'tra_adv' )
174      !
175   END SUBROUTINE tra_adv
176
177
178   SUBROUTINE tra_adv_init
179      !!---------------------------------------------------------------------
180      !!                  ***  ROUTINE tra_adv_init  ***
181      !!               
182      !! ** Purpose :   Control the consistency between namelist options for
183      !!              tracer advection schemes and set nadv
184      !!----------------------------------------------------------------------
185      INTEGER ::   ioptio, ios   ! Local integers
186      !
187      NAMELIST/namtra_adv/ ln_traadv_OFF,                        &   ! No advection
188         &                 ln_traadv_cen , nn_cen_h, nn_cen_v,   &   ! CEN
189         &                 ln_traadv_fct , nn_fct_h, nn_fct_v,   &   ! FCT
190         &                 ln_traadv_mus , ln_mus_ups,           &   ! MUSCL
191         &                 ln_traadv_ubs ,           nn_ubs_v,   &   ! UBS
192         &                 ln_traadv_qck                             ! QCK
193      !!----------------------------------------------------------------------
194      !
195      !                                !==  Namelist  ==!
196      READ  ( numnam_ref, namtra_adv, IOSTAT = ios, ERR = 901)
197901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namtra_adv in reference namelist' )
198      !
199      READ  ( numnam_cfg, namtra_adv, IOSTAT = ios, ERR = 902 )
200902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namtra_adv in configuration namelist' )
201      IF(lwm) WRITE( numond, namtra_adv )
202      !
203      IF(lwp) THEN                           ! Namelist print
204         WRITE(numout,*)
205         WRITE(numout,*) 'tra_adv_init : choice/control of the tracer advection scheme'
206         WRITE(numout,*) '~~~~~~~~~~~~'
207         WRITE(numout,*) '   Namelist namtra_adv : chose a advection scheme for tracers'
208         WRITE(numout,*) '      No advection on T & S                     ln_traadv_OFF = ', ln_traadv_OFF
209         WRITE(numout,*) '      centered scheme                           ln_traadv_cen = ', ln_traadv_cen
210         WRITE(numout,*) '            horizontal 2nd/4th order               nn_cen_h   = ', nn_fct_h
211         WRITE(numout,*) '            vertical   2nd/4th order               nn_cen_v   = ', nn_fct_v
212         WRITE(numout,*) '      Flux Corrected Transport scheme           ln_traadv_fct = ', ln_traadv_fct
213         WRITE(numout,*) '            horizontal 2nd/4th order               nn_fct_h   = ', nn_fct_h
214         WRITE(numout,*) '            vertical   2nd/4th order               nn_fct_v   = ', nn_fct_v
215         WRITE(numout,*) '      MUSCL scheme                              ln_traadv_mus = ', ln_traadv_mus
216         WRITE(numout,*) '            + upstream scheme near river mouths    ln_mus_ups = ', ln_mus_ups
217         WRITE(numout,*) '      UBS scheme                                ln_traadv_ubs = ', ln_traadv_ubs
218         WRITE(numout,*) '            vertical   2nd/4th order               nn_ubs_v   = ', nn_ubs_v
219         WRITE(numout,*) '      QUICKEST scheme                           ln_traadv_qck = ', ln_traadv_qck
220      ENDIF
221      !
222      !                                !==  Parameter control & set nadv ==!
223      ioptio = 0                       
224      IF( ln_traadv_OFF ) THEN   ;   ioptio = ioptio + 1   ;   nadv = np_NO_adv   ;   ENDIF
225      IF( ln_traadv_cen ) THEN   ;   ioptio = ioptio + 1   ;   nadv = np_CEN      ;   ENDIF
226      IF( ln_traadv_fct ) THEN   ;   ioptio = ioptio + 1   ;   nadv = np_FCT      ;   ENDIF
227      IF( ln_traadv_mus ) THEN   ;   ioptio = ioptio + 1   ;   nadv = np_MUS      ;   ENDIF
228      IF( ln_traadv_ubs ) THEN   ;   ioptio = ioptio + 1   ;   nadv = np_UBS      ;   ENDIF
229      IF( ln_traadv_qck ) THEN   ;   ioptio = ioptio + 1   ;   nadv = np_QCK      ;   ENDIF
230      !
231      IF( ioptio /= 1 )   CALL ctl_stop( 'tra_adv_init: Choose ONE advection option in namelist namtra_adv' )
232      !
233      IF( ln_traadv_cen .AND. ( nn_cen_h /= 2 .AND. nn_cen_h /= 4 )   &          ! Centered
234                        .AND. ( nn_cen_v /= 2 .AND. nn_cen_v /= 4 )   ) THEN
235        CALL ctl_stop( 'tra_adv_init: CEN scheme, choose 2nd or 4th order' )
236      ENDIF
237      IF( ln_traadv_fct .AND. ( nn_fct_h /= 2 .AND. nn_fct_h /= 4 )   &          ! FCT
238                        .AND. ( nn_fct_v /= 2 .AND. nn_fct_v /= 4 )   ) THEN
239        CALL ctl_stop( 'tra_adv_init: FCT scheme, choose 2nd or 4th order' )
240      ENDIF
241      IF( ln_traadv_ubs .AND. ( nn_ubs_v /= 2 .AND. nn_ubs_v /= 4 )   ) THEN     ! UBS
242        CALL ctl_stop( 'tra_adv_init: UBS scheme, choose 2nd or 4th order' )
243      ENDIF
244      IF( ln_traadv_ubs .AND. nn_ubs_v == 4 ) THEN
245         CALL ctl_warn( 'tra_adv_init: UBS scheme, only 2nd FCT scheme available on the vertical. It will be used' )
246      ENDIF
247      IF( ln_isfcav ) THEN                                                       ! ice-shelf cavities
248         IF(  ln_traadv_cen .AND. nn_cen_v == 4    .OR.   &                            ! NO 4th order with ISF
249            & ln_traadv_fct .AND. nn_fct_v == 4   )   CALL ctl_stop( 'tra_adv_init: 4th order COMPACT scheme not allowed with ISF' )
250      ENDIF
251      !
252      !                                !==  Print the choice  ==! 
253      IF(lwp) THEN
254         WRITE(numout,*)
255         SELECT CASE ( nadv )
256         CASE( np_NO_adv  )   ;   WRITE(numout,*) '   ==>>>   NO T-S advection'
257         CASE( np_CEN     )   ;   WRITE(numout,*) '   ==>>>   CEN      scheme is used. Horizontal order: ', nn_cen_h,   &
258            &                                                                        ' Vertical   order: ', nn_cen_v
259         CASE( np_FCT     )   ;   WRITE(numout,*) '   ==>>>   FCT      scheme is used. Horizontal order: ', nn_fct_h,   &
260            &                                                                        ' Vertical   order: ', nn_fct_v
261         CASE( np_MUS     )   ;   WRITE(numout,*) '   ==>>>   MUSCL    scheme is used'
262         CASE( np_UBS     )   ;   WRITE(numout,*) '   ==>>>   UBS      scheme is used'
263         CASE( np_QCK     )   ;   WRITE(numout,*) '   ==>>>   QUICKEST scheme is used'
264         END SELECT
265      ENDIF
266      !
267      CALL tra_mle_init            !== initialisation of the Mixed Layer Eddy parametrisation (MLE)  ==!
268      !
269   END SUBROUTINE tra_adv_init
270
271  !!======================================================================
272END MODULE traadv
Note: See TracBrowser for help on using the repository browser.