- Timestamp:
- 2017-12-13T15:58:53+01:00 (6 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/TRA/traadv.F90
r7753 r9019 14 14 !!---------------------------------------------------------------------- 15 15 !! tra_adv : compute ocean tracer advection trend 16 !! tra_adv_ ctl: control the different options of advection scheme16 !! tra_adv_init : control the different options of advection scheme 17 17 !!---------------------------------------------------------------------- 18 18 USE oce ! ocean dynamics and active tracers 19 19 USE dom_oce ! ocean space and time domain 20 20 USE domvvl ! variable vertical scale factors 21 USE sbcwave ! wave module 22 USE sbc_oce ! surface boundary condition: ocean 21 23 USE traadv_cen ! centered scheme (tra_adv_cen routine) 22 24 USE traadv_fct ! FCT scheme (tra_adv_fct routine) … … 27 29 USE ldftra ! lateral diffusion: eddy diffusivity & EIV coeff. 28 30 USE ldfslp ! Lateral diffusion: slopes of neutral surfaces 29 USE trd_oce ! trends: ocean variables 30 USE trdtra ! trends manager: tracers 31 USE trd_oce ! trends: ocean variables 32 USE trdtra ! trends manager: tracers 33 USE diaptr ! Poleward heat transport 31 34 ! 32 35 USE in_out_manager ! I/O manager … … 34 37 USE prtctl ! Print control 35 38 USE lib_mpp ! MPP library 36 USE wrk_nemo ! Memory Allocation37 39 USE timing ! Timing 38 USE sbcwave ! wave module39 USE sbc_oce ! surface boundary condition: ocean40 USE diaptr ! Poleward heat transport41 40 42 41 IMPLICIT NONE 43 42 PRIVATE 44 43 45 PUBLIC tra_adv ! routine called by step module46 PUBLIC tra_adv_init ! routine called by opa module44 PUBLIC tra_adv ! called by step.F90 45 PUBLIC tra_adv_init ! called by nemogcm.F90 47 46 48 47 ! !!* Namelist namtra_adv * 48 LOGICAL :: ln_traadv_NONE ! no advection on T and S 49 49 LOGICAL :: ln_traadv_cen ! centered scheme flag 50 50 INTEGER :: nn_cen_h, nn_cen_v ! =2/4 : horizontal and vertical choices of the order of CEN scheme 51 51 LOGICAL :: ln_traadv_fct ! FCT scheme flag 52 52 INTEGER :: nn_fct_h, nn_fct_v ! =2/4 : horizontal and vertical choices of the order of FCT scheme 53 INTEGER :: nn_fct_zts ! >=1 : 2nd order FCT with vertical sub-timestepping54 53 LOGICAL :: ln_traadv_mus ! MUSCL scheme flag 55 54 LOGICAL :: ln_mus_ups ! use upstream scheme in vivcinity of river mouths … … 58 57 LOGICAL :: ln_traadv_qck ! QUICKEST scheme flag 59 58 60 INTEGER :: nadv ! choice of the type of advection scheme 61 ! 62 ! ! associated indices: 59 INTEGER :: nadv ! choice of the type of advection scheme 60 ! ! associated indices: 63 61 INTEGER, PARAMETER :: np_NO_adv = 0 ! no T-S advection 64 62 INTEGER, PARAMETER :: np_CEN = 1 ! 2nd/4th order centered scheme 65 63 INTEGER, PARAMETER :: np_FCT = 2 ! 2nd/4th order Flux Corrected Transport scheme 66 INTEGER, PARAMETER :: np_FCT_zts = 3 ! 2nd order FCT scheme with vertical sub-timestepping 67 INTEGER, PARAMETER :: np_MUS = 4 ! MUSCL scheme 68 INTEGER, PARAMETER :: np_UBS = 5 ! 3rd order Upstream Biased Scheme 69 INTEGER, PARAMETER :: np_QCK = 6 ! QUICK 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 70 67 71 68 !! * Substitutions 72 69 # include "vectopt_loop_substitute.h90" 73 70 !!---------------------------------------------------------------------- 74 !! NEMO/OPA 3.7 , NEMO Consortium (2014)71 !! NEMO/OPA 4.0 , NEMO Consortium (2017) 75 72 !! $Id$ 76 73 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) … … 86 83 !! ** Method : - Update (ua,va) with the advection term following nadv 87 84 !!---------------------------------------------------------------------- 88 INTEGER, INTENT( in) :: kt ! ocean time-step index85 INTEGER, INTENT(in) :: kt ! ocean time-step index 89 86 ! 90 87 INTEGER :: jk ! dummy loop index 91 REAL(wp), POINTER, DIMENSION(:,:,:) :: zun, zvn, zwn 92 REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrdt, ztrds ! 3D workspace 93 !!---------------------------------------------------------------------- 94 ! 95 IF( nn_timing == 1 ) CALL timing_start('tra_adv') 96 ! 97 CALL wrk_alloc( jpi,jpj,jpk, zun, zvn, zwn ) 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') 98 93 ! 99 94 ! ! set time step 100 zun(:,:,:) = 0.0 101 zvn(:,:,:) = 0.0 102 zwn(:,:,:) = 0.0 103 ! 104 IF( neuler == 0 .AND. kt == nit000 ) THEN ! at nit000 105 r2dt = rdt ! = rdt (restarting with Euler time stepping) 106 ELSEIF( kt <= nit000 + 1) THEN ! at nit000 or nit000+1 107 r2dt = 2._wp * rdt ! = 2 rdt (leapfrog) 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) 108 97 ENDIF 109 98 ! 110 99 ! !== effective transport ==! 100 zun(:,:,jpk) = 0._wp 101 zvn(:,:,jpk) = 0._wp 102 zwn(:,:,jpk) = 0._wp 111 103 IF( ln_wave .AND. ln_sdw ) THEN 112 104 DO jk = 1, jpkm1 ! eulerian transport + Stokes Drift … … 146 138 ! 147 139 IF( l_trdtra ) THEN !* Save ta and sa trends 148 CALL wrk_alloc( jpi, jpj, jpk, ztrdt, ztrds)140 ALLOCATE( ztrdt(jpi,jpj,jpk), ztrds(jpi,jpj,jpk) ) 149 141 ztrdt(:,:,:) = tsa(:,:,:,jp_tem) 150 142 ztrds(:,:,:) = tsa(:,:,:,jp_sal) … … 153 145 SELECT CASE ( nadv ) !== compute advection trend and add it to general trend ==! 154 146 ! 155 CASE ( np_CEN ) 147 CASE ( np_CEN ) ! Centered scheme : 2nd / 4th order 156 148 CALL tra_adv_cen ( kt, nit000, 'TRA', zun, zvn, zwn , tsn, tsa, jpts, nn_cen_h, nn_cen_v ) 157 CASE ( np_FCT ) 149 CASE ( np_FCT ) ! FCT scheme : 2nd / 4th order 158 150 CALL tra_adv_fct ( kt, nit000, 'TRA', r2dt, zun, zvn, zwn, tsb, tsn, tsa, jpts, nn_fct_h, nn_fct_v ) 159 CASE ( np_FCT_zts ) ! 2nd order FCT with vertical time-splitting 160 CALL tra_adv_fct_zts( kt, nit000, 'TRA', r2dt, zun, zvn, zwn, tsb, tsn, tsa, jpts , nn_fct_zts ) 161 CASE ( np_MUS ) ! MUSCL 151 CASE ( np_MUS ) ! MUSCL 162 152 CALL tra_adv_mus ( kt, nit000, 'TRA', r2dt, zun, zvn, zwn, tsb, tsa, jpts , ln_mus_ups ) 163 CASE ( np_UBS ) 153 CASE ( np_UBS ) ! UBS 164 154 CALL tra_adv_ubs ( kt, nit000, 'TRA', r2dt, zun, zvn, zwn, tsb, tsn, tsa, jpts , nn_ubs_v ) 165 CASE ( np_QCK ) 155 CASE ( np_QCK ) ! QUICKEST 166 156 CALL tra_adv_qck ( kt, nit000, 'TRA', r2dt, zun, zvn, zwn, tsb, tsn, tsa, jpts ) 167 157 ! … … 175 165 CALL trd_tra( kt, 'TRA', jp_tem, jptra_totad, ztrdt ) 176 166 CALL trd_tra( kt, 'TRA', jp_sal, jptra_totad, ztrds ) 177 CALL wrk_dealloc( jpi, jpj, jpk,ztrdt, ztrds )167 DEALLOCATE( ztrdt, ztrds ) 178 168 ENDIF 179 169 ! ! print mean trends (used for debugging) … … 181 171 & tab3d_2=tsa(:,:,:,jp_sal), clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' ) 182 172 ! 183 IF( nn_timing == 1 ) CALL timing_stop( 'tra_adv' ) 184 ! 185 CALL wrk_dealloc( jpi,jpj,jpk, zun, zvn, zwn ) 186 ! 173 IF( ln_timing ) CALL timing_stop( 'tra_adv' ) 174 ! 187 175 END SUBROUTINE tra_adv 188 176 … … 197 185 INTEGER :: ioptio, ios ! Local integers 198 186 ! 199 NAMELIST/namtra_adv/ ln_traadv_cen, nn_cen_h, nn_cen_v, & ! CEN 200 & ln_traadv_fct, nn_fct_h, nn_fct_v, nn_fct_zts, & ! FCT 201 & ln_traadv_mus, ln_mus_ups, & ! MUSCL 202 & ln_traadv_ubs, nn_ubs_v, & ! UBS 203 & ln_traadv_qck ! QCK 187 NAMELIST/namtra_adv/ ln_traadv_NONE, & ! 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 204 193 !!---------------------------------------------------------------------- 205 194 ! … … 217 206 WRITE(numout,*) 218 207 WRITE(numout,*) 'tra_adv_init : choice/control of the tracer advection scheme' 219 WRITE(numout,*) '~~~~~~~~~~~ '208 WRITE(numout,*) '~~~~~~~~~~~~' 220 209 WRITE(numout,*) ' Namelist namtra_adv : chose a advection scheme for tracers' 210 WRITE(numout,*) ' No advection on T & S ln_traadv_NONE= ', ln_traadv_NONE 221 211 WRITE(numout,*) ' centered scheme ln_traadv_cen = ', ln_traadv_cen 222 212 WRITE(numout,*) ' horizontal 2nd/4th order nn_cen_h = ', nn_fct_h … … 225 215 WRITE(numout,*) ' horizontal 2nd/4th order nn_fct_h = ', nn_fct_h 226 216 WRITE(numout,*) ' vertical 2nd/4th order nn_fct_v = ', nn_fct_v 227 WRITE(numout,*) ' 2nd order + vertical sub-timestepping nn_fct_zts = ', nn_fct_zts228 217 WRITE(numout,*) ' MUSCL scheme ln_traadv_mus = ', ln_traadv_mus 229 218 WRITE(numout,*) ' + upstream scheme near river mouths ln_mus_ups = ', ln_mus_ups … … 233 222 ENDIF 234 223 ! 235 ioptio = 0 !== Parameter control ==! 236 IF( ln_traadv_cen ) ioptio = ioptio + 1 237 IF( ln_traadv_fct ) ioptio = ioptio + 1 238 IF( ln_traadv_mus ) ioptio = ioptio + 1 239 IF( ln_traadv_ubs ) ioptio = ioptio + 1 240 IF( ln_traadv_qck ) ioptio = ioptio + 1 241 ! 242 IF( ioptio == 0 ) THEN 243 nadv = np_NO_adv 244 CALL ctl_warn( 'tra_adv_init: You are running without tracer advection.' ) 245 ENDIF 246 IF( ioptio /= 1 ) CALL ctl_stop( 'tra_adv_init: Choose ONE advection scheme in namelist namtra_adv' ) 224 ! !== Parameter control & set nadv ==! 225 ioptio = 0 226 IF( ln_traadv_NONE ) THEN ; ioptio = ioptio + 1 ; nadv = np_NO_adv ; ENDIF 227 IF( ln_traadv_cen ) THEN ; ioptio = ioptio + 1 ; nadv = np_CEN ; ENDIF 228 IF( ln_traadv_fct ) THEN ; ioptio = ioptio + 1 ; nadv = np_FCT ; ENDIF 229 IF( ln_traadv_mus ) THEN ; ioptio = ioptio + 1 ; nadv = np_MUS ; ENDIF 230 IF( ln_traadv_ubs ) THEN ; ioptio = ioptio + 1 ; nadv = np_UBS ; ENDIF 231 IF( ln_traadv_qck ) THEN ; ioptio = ioptio + 1 ; nadv = np_QCK ; ENDIF 232 ! 233 IF( ioptio /= 1 ) CALL ctl_stop( 'tra_adv_init: Choose ONE advection option in namelist namtra_adv' ) 247 234 ! 248 235 IF( ln_traadv_cen .AND. ( nn_cen_h /= 2 .AND. nn_cen_h /= 4 ) & ! Centered … … 254 241 CALL ctl_stop( 'tra_adv_init: FCT scheme, choose 2nd or 4th order' ) 255 242 ENDIF 256 IF( ln_traadv_fct .AND. nn_fct_zts > 0 ) THEN257 IF( nn_fct_h == 4 ) THEN258 nn_fct_h = 2259 CALL ctl_stop( 'tra_adv_init: force 2nd order FCT scheme, 4th order does not exist with sub-timestepping' )260 ENDIF261 IF( .NOT.ln_linssh ) THEN262 CALL ctl_stop( 'tra_adv_init: vertical sub-timestepping not allow in non-linear free surface' )263 ENDIF264 IF( nn_fct_zts == 1 ) CALL ctl_warn( 'tra_adv_init: FCT with ONE sub-timestep = FCT without sub-timestep' )265 ENDIF266 243 IF( ln_traadv_ubs .AND. ( nn_ubs_v /= 2 .AND. nn_ubs_v /= 4 ) ) THEN ! UBS 267 244 CALL ctl_stop( 'tra_adv_init: UBS scheme, choose 2nd or 4th order' ) … … 275 252 ENDIF 276 253 ! 277 ! !== used advection scheme ==! 278 ! ! set nadv 279 IF( ln_traadv_cen ) nadv = np_CEN 280 IF( ln_traadv_fct ) nadv = np_FCT 281 IF( ln_traadv_fct .AND. nn_fct_zts > 0 ) nadv = np_FCT_zts 282 IF( ln_traadv_mus ) nadv = np_MUS 283 IF( ln_traadv_ubs ) nadv = np_UBS 284 IF( ln_traadv_qck ) nadv = np_QCK 285 ! 286 IF(lwp) THEN ! Print the choice 254 ! !== Print the choice ==! 255 IF(lwp) THEN 287 256 WRITE(numout,*) 288 257 SELECT CASE ( nadv ) … … 292 261 CASE( np_FCT ) ; WRITE(numout,*) ' ===>> FCT scheme is used. Horizontal order: ', nn_fct_h, & 293 262 & ' Vertical order: ', nn_fct_v 294 CASE( np_FCT_zts ) ; WRITE(numout,*) ' ===>> use 2nd order FCT with ', nn_fct_zts,'vertical sub-timestepping'295 263 CASE( np_MUS ) ; WRITE(numout,*) ' ===>> MUSCL scheme is used' 296 264 CASE( np_UBS ) ; WRITE(numout,*) ' ===>> UBS scheme is used'
Note: See TracChangeset
for help on using the changeset viewer.
