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_r11613_ENHANCE-04_namelists_as_internalfiles/src/TOP/TRP – NEMO

source: NEMO/branches/2019/dev_r11613_ENHANCE-04_namelists_as_internalfiles/src/TOP/TRP/trcadv.F90 @ 11671

Last change on this file since 11671 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: 13.6 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 )
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      !
80      INTEGER ::   jk   ! dummy loop index
81      CHARACTER (len=22) ::   charout
82      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zun, zvn, zwn  ! effective velocity
83      !!----------------------------------------------------------------------
84      !
85      IF( ln_timing )   CALL timing_start('trc_adv')
86      !
87      !                                         !==  effective transport  ==!
88      IF( l_offline ) THEN
89         zun(:,:,:) = un(:,:,:)                    ! already in (un,vn,wn)
90         zvn(:,:,:) = vn(:,:,:)
91         zwn(:,:,:) = wn(:,:,:)
92      ELSE                                         ! build the effective transport
93         zun(:,:,jpk) = 0._wp
94         zvn(:,:,jpk) = 0._wp
95         zwn(:,:,jpk) = 0._wp
96         IF( ln_wave .AND. ln_sdw )  THEN
97            DO jk = 1, jpkm1                                                       ! eulerian transport + Stokes Drift
98               zun(:,:,jk) = e2u  (:,:) * e3u_n(:,:,jk) * ( un(:,:,jk) + usd(:,:,jk) )
99               zvn(:,:,jk) = e1v  (:,:) * e3v_n(:,:,jk) * ( vn(:,:,jk) + vsd(:,:,jk) )
100               zwn(:,:,jk) = e1e2t(:,:)                 * ( wn(:,:,jk) + wsd(:,:,jk) )
101            END DO
102         ELSE
103            DO jk = 1, jpkm1
104               zun(:,:,jk) = e2u  (:,:) * e3u_n(:,:,jk) * un(:,:,jk)                   ! eulerian transport
105               zvn(:,:,jk) = e1v  (:,:) * e3v_n(:,:,jk) * vn(:,:,jk)
106               zwn(:,:,jk) = e1e2t(:,:)                 * wn(:,:,jk)
107            END DO
108         ENDIF
109         !
110         IF( ln_vvl_ztilde .OR. ln_vvl_layer ) THEN                                 ! add z-tilde and/or vvl corrections
111            zun(:,:,:) = zun(:,:,:) + un_td(:,:,:)
112            zvn(:,:,:) = zvn(:,:,:) + vn_td(:,:,:)
113         ENDIF
114         !
115         IF( ln_ldfeiv .AND. .NOT. ln_traldf_triad )   & 
116            &              CALL ldf_eiv_trp( kt, nittrc000, zun, zvn, zwn, 'TRC' )  ! add the eiv transport
117         !
118         IF( ln_mle    )   CALL tra_mle_trp( kt, nittrc000, zun, zvn, zwn, 'TRC' )  ! add the mle transport
119         !
120      ENDIF
121      !
122      SELECT CASE ( nadv )                      !==  compute advection trend and add it to general trend  ==!
123      !
124      CASE ( np_CEN )                                 ! Centered : 2nd / 4th order
125         CALL tra_adv_cen( kt, nittrc000,'TRC',          zun, zvn, zwn     , trn, tra, jptra, nn_cen_h, nn_cen_v )
126      CASE ( np_FCT )                                 ! FCT      : 2nd / 4th order
127         CALL tra_adv_fct( kt, nittrc000,'TRC', r2dttrc, zun, zvn, zwn, trb, trn, tra, jptra, nn_fct_h, nn_fct_v )
128      CASE ( np_MUS )                                 ! MUSCL
129         CALL tra_adv_mus( kt, nittrc000,'TRC', r2dttrc, zun, zvn, zwn, trb,      tra, jptra        , ln_mus_ups ) 
130      CASE ( np_UBS )                                 ! UBS
131         CALL tra_adv_ubs( kt, nittrc000,'TRC', r2dttrc, zun, zvn, zwn, trb, trn, tra, jptra          , nn_ubs_v )
132      CASE ( np_QCK )                                 ! QUICKEST
133         CALL tra_adv_qck( kt, nittrc000,'TRC', r2dttrc, zun, zvn, zwn, trb, trn, tra, jptra                     )
134      !
135      END SELECT
136      !                 
137      IF( ln_ctl ) THEN                         !== print mean trends (used for debugging)
138         WRITE(charout, FMT="('adv ')")
139         CALL prt_ctl_trc_info(charout)
140         CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' )
141      END IF
142      !
143      IF( ln_timing )   CALL timing_stop('trc_adv')
144      !
145   END SUBROUTINE trc_adv
146
147
148   SUBROUTINE trc_adv_ini
149      !!---------------------------------------------------------------------
150      !!                  ***  ROUTINE trc_adv_ini  ***
151      !!               
152      !! ** Purpose :   Control the consistency between namelist options for
153      !!              passive tracer advection schemes and set nadv
154      !!----------------------------------------------------------------------
155      INTEGER ::   ioptio, ios   ! Local integer
156      !!
157      NAMELIST/namtrc_adv/ ln_trcadv_OFF,                        &   ! No advection
158         &                 ln_trcadv_cen, nn_cen_h, nn_cen_v,    &   ! CEN
159         &                 ln_trcadv_fct, nn_fct_h, nn_fct_v,    &   ! FCT
160         &                 ln_trcadv_mus, ln_mus_ups,            &   ! MUSCL
161         &                 ln_trcadv_ubs,           nn_ubs_v,    &   ! UBS
162         &                 ln_trcadv_qck                             ! QCK
163      !!----------------------------------------------------------------------
164      !
165      !                                !==  Namelist  ==!
166      READ  ( numnat_ref, namtrc_adv, IOSTAT = ios, ERR = 901)
167901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namtrc_adv in reference namelist' )
168      READ  ( numnat_cfg, namtrc_adv, IOSTAT = ios, ERR = 902 )
169902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namtrc_adv in configuration namelist' )
170      IF(lwm) WRITE ( numont, namtrc_adv )
171      !
172      IF(lwp) THEN                           ! Namelist print
173         WRITE(numout,*)
174         WRITE(numout,*) 'trc_adv_ini : choice/control of the tracer advection scheme'
175         WRITE(numout,*) '~~~~~~~~~~~'
176         WRITE(numout,*) '   Namelist namtrc_adv : chose a advection scheme for tracers'
177         WRITE(numout,*) '      No advection on passive tracers           ln_trcadv_OFF = ', ln_trcadv_OFF
178         WRITE(numout,*) '      centered scheme                           ln_trcadv_cen = ', ln_trcadv_cen
179         WRITE(numout,*) '            horizontal 2nd/4th order               nn_cen_h   = ', nn_fct_h
180         WRITE(numout,*) '            vertical   2nd/4th order               nn_cen_v   = ', nn_fct_v
181         WRITE(numout,*) '      Flux Corrected Transport scheme           ln_trcadv_fct = ', ln_trcadv_fct
182         WRITE(numout,*) '            horizontal 2nd/4th order               nn_fct_h   = ', nn_fct_h
183         WRITE(numout,*) '            vertical   2nd/4th order               nn_fct_v   = ', nn_fct_v
184         WRITE(numout,*) '      MUSCL scheme                              ln_trcadv_mus = ', ln_trcadv_mus
185         WRITE(numout,*) '            + upstream scheme near river mouths    ln_mus_ups = ', ln_mus_ups
186         WRITE(numout,*) '      UBS scheme                                ln_trcadv_ubs = ', ln_trcadv_ubs
187         WRITE(numout,*) '            vertical   2nd/4th order               nn_ubs_v   = ', nn_ubs_v
188         WRITE(numout,*) '      QUICKEST scheme                           ln_trcadv_qck = ', ln_trcadv_qck
189      ENDIF
190      !
191      !                                !==  Parameter control & set nadv ==!
192      ioptio = 0
193      IF( ln_trcadv_OFF ) THEN   ;   ioptio = ioptio + 1   ;   nadv = np_NO_adv   ;   ENDIF
194      IF( ln_trcadv_cen ) THEN   ;   ioptio = ioptio + 1   ;   nadv = np_CEN      ;   ENDIF
195      IF( ln_trcadv_fct ) THEN   ;   ioptio = ioptio + 1   ;   nadv = np_FCT      ;   ENDIF
196      IF( ln_trcadv_mus ) THEN   ;   ioptio = ioptio + 1   ;   nadv = np_MUS      ;   ENDIF
197      IF( ln_trcadv_ubs ) THEN   ;   ioptio = ioptio + 1   ;   nadv = np_UBS      ;   ENDIF
198      IF( ln_trcadv_qck ) THEN   ;   ioptio = ioptio + 1   ;   nadv = np_QCK      ;   ENDIF
199      !
200      IF( ioptio /= 1 )   CALL ctl_stop( 'trc_adv_ini: Choose ONE advection option in namelist namtrc_adv' )
201      !
202      IF( ln_trcadv_cen .AND. ( nn_cen_h /= 2 .AND. nn_cen_h /= 4 )   &
203                        .AND. ( nn_cen_v /= 2 .AND. nn_cen_v /= 4 )   ) THEN
204        CALL ctl_stop( 'trc_adv_ini: CEN scheme, choose 2nd or 4th order' )
205      ENDIF
206      IF( ln_trcadv_fct .AND. ( nn_fct_h /= 2 .AND. nn_fct_h /= 4 )   &
207                        .AND. ( nn_fct_v /= 2 .AND. nn_fct_v /= 4 )   ) THEN
208        CALL ctl_stop( 'trc_adv_ini: FCT scheme, choose 2nd or 4th order' )
209      ENDIF
210      IF( ln_trcadv_ubs .AND. ( nn_ubs_v /= 2 .AND. nn_ubs_v /= 4 )   ) THEN
211        CALL ctl_stop( 'trc_adv_ini: UBS scheme, choose 2nd or 4th order' )
212      ENDIF
213      IF( ln_trcadv_ubs .AND. nn_ubs_v == 4 ) THEN
214         CALL ctl_warn( 'trc_adv_ini: UBS scheme, only 2nd FCT scheme available on the vertical. It will be used' )
215      ENDIF
216      IF( ln_isfcav ) THEN                                                       ! ice-shelf cavities
217         IF(  ln_trcadv_cen .AND. nn_cen_v == 4    .OR.   &                            ! NO 4th order with ISF
218            & ln_trcadv_fct .AND. nn_fct_v == 4   )   CALL ctl_stop( 'tra_adv_ini: 4th order COMPACT scheme not allowed with ISF' )
219      ENDIF
220      !
221      !                                !==  Print the choice  ==! 
222      IF(lwp) THEN
223         WRITE(numout,*)
224         SELECT CASE ( nadv )
225         CASE( np_NO_adv  )   ;   WRITE(numout,*) '      ===>>   NO passive tracer advection'
226         CASE( np_CEN     )   ;   WRITE(numout,*) '      ===>>   CEN      scheme is used. Horizontal order: ', nn_cen_h,   &
227            &                                                                     ' Vertical   order: ', nn_cen_v
228         CASE( np_FCT     )   ;   WRITE(numout,*) '      ===>>   FCT      scheme is used. Horizontal order: ', nn_fct_h,   &
229            &                                                                      ' Vertical   order: ', nn_fct_v
230         CASE( np_MUS     )   ;   WRITE(numout,*) '      ===>>   MUSCL    scheme is used'
231         CASE( np_UBS     )   ;   WRITE(numout,*) '      ===>>   UBS      scheme is used'
232         CASE( np_QCK     )   ;   WRITE(numout,*) '      ===>>   QUICKEST scheme is used'
233         END SELECT
234      ENDIF
235      !
236   END SUBROUTINE trc_adv_ini
237   
238#endif
239
240  !!======================================================================
241END MODULE trcadv
Note: See TracBrowser for help on using the repository browser.