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/trunk/src/OCE/TRA – NEMO

source: NEMO/trunk/src/OCE/TRA/traadv.F90 @ 12377

Last change on this file since 12377 was 12377, checked in by acc, 4 years ago

The big one. Merging all 2019 developments from the option 1 branch back onto the trunk.

This changeset reproduces 2019/dev_r11943_MERGE_2019 on the trunk using a 2-URL merge
onto a working copy of the trunk. I.e.:

svn merge --ignore-ancestry \

​svn+ssh://acc@forge.ipsl.jussieu.fr/ipsl/forge/projets/nemo/svn/NEMO/trunk \
​svn+ssh://acc@forge.ipsl.jussieu.fr/ipsl/forge/projets/nemo/svn/NEMO/branches/2019/dev_r11943_MERGE_2019 ./

The --ignore-ancestry flag avoids problems that may otherwise arise from the fact that
the merge history been trunk and branch may have been applied in a different order but
care has been taken before this step to ensure that all applicable fixes and updates
are present in the merge branch.

The trunk state just before this step has been branched to releases/release-4.0-HEAD
and that branch has been immediately tagged as releases/release-4.0.2. Any fixes
or additions in response to tickets on 4.0, 4.0.1 or 4.0.2 should be done on
releases/release-4.0-HEAD. From now on future 'point' releases (e.g. 4.0.2) will
remain unchanged with periodic releases as needs demand. Note release-4.0-HEAD is a
transitional naming convention. Future full releases, say 4.2, will have a release-4.2
branch which fulfills this role and the first point release (e.g. 4.2.0) will be made
immediately following the release branch creation.

2020 developments can be started from any trunk revision later than this one.
  • Property svn:keywords set to Id
File size: 15.7 KB
RevLine 
[458]1MODULE traadv
2   !!==============================================================================
3   !!                       ***  MODULE  traadv  ***
4   !! Ocean active tracers:  advection trend
5   !!==============================================================================
[2528]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
[5836]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
[7646]11   !!            3.6  !  2015-06  (E. Clementi) Addition of Stokes drift in case of wave coupling
[458]12   !!----------------------------------------------------------------------
[503]13
14   !!----------------------------------------------------------------------
[5836]15   !!   tra_adv       : compute ocean tracer advection trend
[9019]16   !!   tra_adv_init  : control the different options of advection scheme
[458]17   !!----------------------------------------------------------------------
[5836]18   USE oce            ! ocean dynamics and active tracers
19   USE dom_oce        ! ocean space and time domain
20   USE domvvl         ! variable vertical scale factors
[9019]21   USE sbcwave        ! wave module
22   USE sbc_oce        ! surface boundary condition: ocean
[9531]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)
[5836]30   USE ldfslp         ! Lateral diffusion: slopes of neutral surfaces
[9019]31   USE trd_oce        ! trends: ocean variables
32   USE trdtra         ! trends manager: tracers
33   USE diaptr         ! Poleward heat transport
[5147]34   !
[5836]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
[458]41   IMPLICIT NONE
42   PRIVATE
43
[9019]44   PUBLIC   tra_adv        ! called by step.F90
45   PUBLIC   tra_adv_init   ! called by nemogcm.F90
[2715]46
[5836]47   !                            !!* Namelist namtra_adv *
[9526]48   LOGICAL ::   ln_traadv_OFF    ! no advection on T and S
[5836]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
[458]58
[9019]59   INTEGER ::   nadv             ! choice of the type of advection scheme
60   !                             ! associated indices:
[5836]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
[9019]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
[5836]67   
[458]68   !!----------------------------------------------------------------------
[9598]69   !! NEMO/OCE 4.0 , NEMO Consortium (2018)
[2528]70   !! $Id$
[10068]71   !! Software governed by the CeCILL license (see ./LICENSE)
[458]72   !!----------------------------------------------------------------------
73CONTAINS
74
[12377]75   SUBROUTINE tra_adv( kt, Kbb, Kmm, pts, Krhs )
[458]76      !!----------------------------------------------------------------------
77      !!                  ***  ROUTINE tra_adv  ***
78      !!
79      !! ** Purpose :   compute the ocean tracer advection trend.
80      !!
[12377]81      !! ** Method  : - Update (uu(:,:,:,Krhs),vv(:,:,:,Krhs)) with the advection term following nadv
[458]82      !!----------------------------------------------------------------------
[12377]83      INTEGER                                  , INTENT(in)    :: kt             ! ocean time-step index
84      INTEGER                                  , INTENT(in)    :: Kbb, Kmm, Krhs ! time level indices
85      REAL(wp), DIMENSION(jpi,jpj,jpk,jpts,jpt), INTENT(inout) :: pts            ! active tracers and RHS of tracer equation
[2528]86      !
[7753]87      INTEGER ::   jk   ! dummy loop index
[12377]88      REAL(wp), DIMENSION(jpi,jpj,jpk)        :: zuu, zvv, zww   ! 3D workspace
[9019]89      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::   ztrdt, ztrds
[458]90      !!----------------------------------------------------------------------
[2715]91      !
[9019]92      IF( ln_timing )   CALL timing_start('tra_adv')
[3294]93      !
[2528]94      !                                          ! set time step
[9531]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)
[458]97      ENDIF
[2528]98      !
[5836]99      !                                         !==  effective transport  ==!
[12377]100      zuu(:,:,jpk) = 0._wp
101      zvv(:,:,jpk) = 0._wp
102      zww(:,:,jpk) = 0._wp
[7646]103      IF( ln_wave .AND. ln_sdw )  THEN
104         DO jk = 1, jpkm1                                                       ! eulerian transport + Stokes Drift
[12377]105            zuu(:,:,jk) = e2u  (:,:) * e3u(:,:,jk,Kmm) * ( uu(:,:,jk,Kmm) + usd(:,:,jk) )
106            zvv(:,:,jk) = e1v  (:,:) * e3v(:,:,jk,Kmm) * ( vv(:,:,jk,Kmm) + vsd(:,:,jk) )
107            zww(:,:,jk) = e1e2t(:,:)                 * ( ww(:,:,jk) + wsd(:,:,jk) )
[7646]108         END DO
109      ELSE
110         DO jk = 1, jpkm1
[12377]111            zuu(:,:,jk) = e2u  (:,:) * e3u(:,:,jk,Kmm) * uu(:,:,jk,Kmm)               ! eulerian transport only
112            zvv(:,:,jk) = e1v  (:,:) * e3v(:,:,jk,Kmm) * vv(:,:,jk,Kmm)
113            zww(:,:,jk) = e1e2t(:,:)                 * ww(:,:,jk)
[7646]114         END DO
115      ENDIF
[4292]116      !
[5836]117      IF( ln_vvl_ztilde .OR. ln_vvl_layer ) THEN                                ! add z-tilde and/or vvl corrections
[12377]118         zuu(:,:,:) = zuu(:,:,:) + un_td(:,:,:)
119         zvv(:,:,:) = zvv(:,:,:) + vn_td(:,:,:)
[4292]120      ENDIF
121      !
[12377]122      zuu(:,:,jpk) = 0._wp                                                      ! no transport trough the bottom
123      zvv(:,:,jpk) = 0._wp
124      zww(:,:,jpk) = 0._wp
[2528]125      !
[5836]126      IF( ln_ldfeiv .AND. .NOT. ln_traldf_triad )   &
[12377]127         &              CALL ldf_eiv_trp( kt, nit000, zuu, zvv, zww, 'TRA', Kmm, Krhs )   ! add the eiv transport (if necessary)
[2528]128      !
[12377]129      IF( ln_mle    )   CALL tra_mle_trp( kt, nit000, zuu, zvv, zww, 'TRA', Kmm       )   ! add the mle transport (if necessary)
[5147]130      !
[12377]131      CALL iom_put( "uocetr_eff", zuu )                                        ! output effective transport     
132      CALL iom_put( "vocetr_eff", zvv )
133      CALL iom_put( "wocetr_eff", zww )
[5147]134      !
[5836]135!!gm ???
[12377]136      CALL dia_ptr( kt, Kmm, zvv )                                    ! diagnose the effective MSF
[5836]137!!gm ???
[5147]138      !
[12377]139
[7646]140      IF( l_trdtra )   THEN                    !* Save ta and sa trends
[9019]141         ALLOCATE( ztrdt(jpi,jpj,jpk), ztrds(jpi,jpj,jpk) )
[12377]142         ztrdt(:,:,:) = pts(:,:,:,jp_tem,Krhs)
143         ztrds(:,:,:) = pts(:,:,:,jp_sal,Krhs)
[7646]144      ENDIF
145      !
[5836]146      SELECT CASE ( nadv )                      !==  compute advection trend and add it to general trend  ==!
[503]147      !
[9019]148      CASE ( np_CEN )                                 ! Centered scheme : 2nd / 4th order
[12377]149         CALL tra_adv_cen    ( kt, nit000, 'TRA',         zuu, zvv, zww, Kmm, pts, jpts, Krhs, nn_cen_h, nn_cen_v )
[9019]150      CASE ( np_FCT )                                 ! FCT scheme      : 2nd / 4th order
[12377]151         CALL tra_adv_fct    ( kt, nit000, 'TRA', r2dt, zuu, zvv, zww, Kbb, Kmm, pts, jpts, Krhs, nn_fct_h, nn_fct_v )
[9019]152      CASE ( np_MUS )                                 ! MUSCL
[12377]153         CALL tra_adv_mus    ( kt, nit000, 'TRA', r2dt, zuu, zvv, zww, Kbb, Kmm, pts, jpts, Krhs, ln_mus_ups ) 
[9019]154      CASE ( np_UBS )                                 ! UBS
[12377]155         CALL tra_adv_ubs    ( kt, nit000, 'TRA', r2dt, zuu, zvv, zww, Kbb, Kmm, pts, jpts, Krhs, nn_ubs_v   )
[9019]156      CASE ( np_QCK )                                 ! QUICKEST
[12377]157         CALL tra_adv_qck    ( kt, nit000, 'TRA', r2dt, zuu, zvv, zww, Kbb, Kmm, pts, jpts, Krhs )
[5836]158      !
[458]159      END SELECT
[2528]160      !
[7646]161      IF( l_trdtra )   THEN                      ! save the advective trends for further diagnostics
162         DO jk = 1, jpkm1
[12377]163            ztrdt(:,:,jk) = pts(:,:,jk,jp_tem,Krhs) - ztrdt(:,:,jk)
164            ztrds(:,:,jk) = pts(:,:,jk,jp_sal,Krhs) - ztrds(:,:,jk)
[7646]165         END DO
[12377]166         CALL trd_tra( kt, Kmm, Krhs, 'TRA', jp_tem, jptra_totad, ztrdt )
167         CALL trd_tra( kt, Kmm, Krhs, 'TRA', jp_sal, jptra_totad, ztrds )
[9019]168         DEALLOCATE( ztrdt, ztrds )
[7646]169      ENDIF
170      !                                              ! print mean trends (used for debugging)
[12377]171      IF(sn_cfctl%l_prtctl)   CALL prt_ctl( tab3d_1=pts(:,:,:,jp_tem,Krhs), clinfo1=' adv  - Ta: ', mask1=tmask,               &
172         &                                  tab3d_2=pts(:,:,:,jp_sal,Krhs), clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' )
[503]173      !
[9019]174      IF( ln_timing )   CALL timing_stop( 'tra_adv' )
[2715]175      !
[458]176   END SUBROUTINE tra_adv
177
178
[2528]179   SUBROUTINE tra_adv_init
[458]180      !!---------------------------------------------------------------------
[2528]181      !!                  ***  ROUTINE tra_adv_init  ***
[458]182      !!               
[503]183      !! ** Purpose :   Control the consistency between namelist options for
184      !!              tracer advection schemes and set nadv
[458]185      !!----------------------------------------------------------------------
[5836]186      INTEGER ::   ioptio, ios   ! Local integers
187      !
[9526]188      NAMELIST/namtra_adv/ ln_traadv_OFF,                        &   ! No advection
[9019]189         &                 ln_traadv_cen , nn_cen_h, nn_cen_v,   &   ! CEN
190         &                 ln_traadv_fct , nn_fct_h, nn_fct_v,   &   ! FCT
191         &                 ln_traadv_mus , ln_mus_ups,           &   ! MUSCL
192         &                 ln_traadv_ubs ,           nn_ubs_v,   &   ! UBS
193         &                 ln_traadv_qck                             ! QCK
[458]194      !!----------------------------------------------------------------------
[5836]195      !
196      !                                !==  Namelist  ==!
[4147]197      READ  ( numnam_ref, namtra_adv, IOSTAT = ios, ERR = 901)
[11536]198901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namtra_adv in reference namelist' )
[5836]199      !
[4147]200      READ  ( numnam_cfg, namtra_adv, IOSTAT = ios, ERR = 902 )
[11536]201902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namtra_adv in configuration namelist' )
[6140]202      IF(lwm) WRITE( numond, namtra_adv )
203      !
[5836]204      IF(lwp) THEN                           ! Namelist print
[458]205         WRITE(numout,*)
[2528]206         WRITE(numout,*) 'tra_adv_init : choice/control of the tracer advection scheme'
[9019]207         WRITE(numout,*) '~~~~~~~~~~~~'
[1601]208         WRITE(numout,*) '   Namelist namtra_adv : chose a advection scheme for tracers'
[9526]209         WRITE(numout,*) '      No advection on T & S                     ln_traadv_OFF = ', ln_traadv_OFF
[5836]210         WRITE(numout,*) '      centered scheme                           ln_traadv_cen = ', ln_traadv_cen
211         WRITE(numout,*) '            horizontal 2nd/4th order               nn_cen_h   = ', nn_fct_h
212         WRITE(numout,*) '            vertical   2nd/4th order               nn_cen_v   = ', nn_fct_v
213         WRITE(numout,*) '      Flux Corrected Transport scheme           ln_traadv_fct = ', ln_traadv_fct
214         WRITE(numout,*) '            horizontal 2nd/4th order               nn_fct_h   = ', nn_fct_h
215         WRITE(numout,*) '            vertical   2nd/4th order               nn_fct_v   = ', nn_fct_v
216         WRITE(numout,*) '      MUSCL scheme                              ln_traadv_mus = ', ln_traadv_mus
217         WRITE(numout,*) '            + upstream scheme near river mouths    ln_mus_ups = ', ln_mus_ups
218         WRITE(numout,*) '      UBS scheme                                ln_traadv_ubs = ', ln_traadv_ubs
219         WRITE(numout,*) '            vertical   2nd/4th order               nn_ubs_v   = ', nn_ubs_v
220         WRITE(numout,*) '      QUICKEST scheme                           ln_traadv_qck = ', ln_traadv_qck
[2528]221      ENDIF
[6140]222      !
[9019]223      !                                !==  Parameter control & set nadv ==!
224      ioptio = 0                       
[9526]225      IF( ln_traadv_OFF ) THEN   ;   ioptio = ioptio + 1   ;   nadv = np_NO_adv   ;   ENDIF
226      IF( ln_traadv_cen ) THEN   ;   ioptio = ioptio + 1   ;   nadv = np_CEN      ;   ENDIF
227      IF( ln_traadv_fct ) THEN   ;   ioptio = ioptio + 1   ;   nadv = np_FCT      ;   ENDIF
228      IF( ln_traadv_mus ) THEN   ;   ioptio = ioptio + 1   ;   nadv = np_MUS      ;   ENDIF
229      IF( ln_traadv_ubs ) THEN   ;   ioptio = ioptio + 1   ;   nadv = np_UBS      ;   ENDIF
230      IF( ln_traadv_qck ) THEN   ;   ioptio = ioptio + 1   ;   nadv = np_QCK      ;   ENDIF
[5836]231      !
[9019]232      IF( ioptio /= 1 )   CALL ctl_stop( 'tra_adv_init: Choose ONE advection option in namelist namtra_adv' )
[5836]233      !
234      IF( ln_traadv_cen .AND. ( nn_cen_h /= 2 .AND. nn_cen_h /= 4 )   &          ! Centered
235                        .AND. ( nn_cen_v /= 2 .AND. nn_cen_v /= 4 )   ) THEN
236        CALL ctl_stop( 'tra_adv_init: CEN scheme, choose 2nd or 4th order' )
237      ENDIF
238      IF( ln_traadv_fct .AND. ( nn_fct_h /= 2 .AND. nn_fct_h /= 4 )   &          ! FCT
239                        .AND. ( nn_fct_v /= 2 .AND. nn_fct_v /= 4 )   ) THEN
240        CALL ctl_stop( 'tra_adv_init: FCT scheme, choose 2nd or 4th order' )
241      ENDIF
242      IF( ln_traadv_ubs .AND. ( nn_ubs_v /= 2 .AND. nn_ubs_v /= 4 )   ) THEN     ! UBS
243        CALL ctl_stop( 'tra_adv_init: UBS scheme, choose 2nd or 4th order' )
244      ENDIF
245      IF( ln_traadv_ubs .AND. nn_ubs_v == 4 ) THEN
246         CALL ctl_warn( 'tra_adv_init: UBS scheme, only 2nd FCT scheme available on the vertical. It will be used' )
247      ENDIF
248      IF( ln_isfcav ) THEN                                                       ! ice-shelf cavities
[6140]249         IF(  ln_traadv_cen .AND. nn_cen_v == 4    .OR.   &                            ! NO 4th order with ISF
250            & ln_traadv_fct .AND. nn_fct_v == 4   )   CALL ctl_stop( 'tra_adv_init: 4th order COMPACT scheme not allowed with ISF' )
[5836]251      ENDIF
252      !
[9019]253      !                                !==  Print the choice  ==! 
254      IF(lwp) THEN
[503]255         WRITE(numout,*)
[6140]256         SELECT CASE ( nadv )
[9190]257         CASE( np_NO_adv  )   ;   WRITE(numout,*) '   ==>>>   NO T-S advection'
258         CASE( np_CEN     )   ;   WRITE(numout,*) '   ==>>>   CEN      scheme is used. Horizontal order: ', nn_cen_h,   &
259            &                                                                        ' Vertical   order: ', nn_cen_v
260         CASE( np_FCT     )   ;   WRITE(numout,*) '   ==>>>   FCT      scheme is used. Horizontal order: ', nn_fct_h,   &
261            &                                                                        ' Vertical   order: ', nn_fct_v
262         CASE( np_MUS     )   ;   WRITE(numout,*) '   ==>>>   MUSCL    scheme is used'
263         CASE( np_UBS     )   ;   WRITE(numout,*) '   ==>>>   UBS      scheme is used'
264         CASE( np_QCK     )   ;   WRITE(numout,*) '   ==>>>   QUICKEST scheme is used'
[6140]265         END SELECT
[458]266      ENDIF
[503]267      !
[9531]268      CALL tra_mle_init            !== initialisation of the Mixed Layer Eddy parametrisation (MLE)  ==!
[4245]269      !
[2528]270   END SUBROUTINE tra_adv_init
[458]271
272  !!======================================================================
273END MODULE traadv
Note: See TracBrowser for help on using the repository browser.