Changeset 403
- Timestamp:
- 2006-03-20T16:45:14+01:00 (18 years ago)
- Location:
- trunk/NEMO/TOP_SRC/TRP
- Files:
-
- 2 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/NEMO/TOP_SRC/TRP/trcbbl.F90
r349 r403 19 19 USE trc ! ocean passive tracers variables 20 20 USE prtctl_trc ! Print control for debbuging 21 21 USE eosbn2 22 22 IMPLICIT NONE 23 23 PRIVATE … … 28 28 29 29 !! * Shared module variables 30 LOGICAL, PUBLIC, PARAMETER :: & !: 31 lk_trcbbl_dif = .TRUE. !: diffusive bottom boundary layer flag 30 # if defined key_trcbbl_dif 31 LOGICAL, PUBLIC, PARAMETER :: & !: 32 lk_trcbbl_dif = .TRUE. !: advective bottom boundary layer flag 33 34 # else 35 LOGICAL, PUBLIC, PARAMETER :: & !: 36 lk_trcbbl_dif = .FALSE. !: advective bottom boundary layer flag 37 # endif 38 32 39 # if defined key_trcbbl_adv 33 40 LOGICAL, PUBLIC, PARAMETER :: & !: … … 45 52 INTEGER, DIMENSION(jpi,jpj) :: & !: 46 53 mbkt, mbku, mbkv ! ??? 54 55 REAL(wp) :: & !!! * trcbbl namelist * 56 atrcbbl = 1.e+3 ! lateral coeff. for bottom boundary layer scheme (m2/s) 47 57 48 58 !! * Substitutions … … 182 192 ze3u = MIN( fse3u(ji,jj,iku1), fse3u(ji,jj,iku2) ) 183 193 ze3v = MIN( fse3v(ji,jj,ikv1), fse3v(ji,jj,ikv2) ) 184 zahu(ji,jj) = atr bbl * e2u(ji,jj) * ze3u / e1u(ji,jj) * umask(ji,jj,1)185 zahv(ji,jj) = atr bbl * e1v(ji,jj) * ze3v / e2v(ji,jj) * vmask(ji,jj,1)194 zahu(ji,jj) = atrcbbl * e2u(ji,jj) * ze3u / e1u(ji,jj) * umask(ji,jj,1) 195 zahv(ji,jj) = atrcbbl * e1v(ji,jj) * ze3v / e2v(ji,jj) * vmask(ji,jj,1) 186 196 # if ! defined key_vectopt_loop || defined key_autotasking 187 197 END DO … … 198 208 iku = mbku(ji,jj) 199 209 ikv = mbkv(ji,jj) 200 zahu(ji,jj) = atr bbl * e2u(ji,jj) * fse3u(ji,jj,iku) / e1u(ji,jj) * umask(ji,jj,1)201 zahv(ji,jj) = atr bbl * e1v(ji,jj) * fse3v(ji,jj,ikv) / e2v(ji,jj) * vmask(ji,jj,1)210 zahu(ji,jj) = atrcbbl * e2u(ji,jj) * fse3u(ji,jj,iku) / e1u(ji,jj) * umask(ji,jj,1) 211 zahv(ji,jj) = atrcbbl * e1v(ji,jj) * fse3v(ji,jj,ikv) / e2v(ji,jj) * vmask(ji,jj,1) 202 212 # if ! defined key_vectopt_loop || defined key_autotasking 203 213 END DO … … 252 262 ! Sign of the local density gradient along the i- and j-slopes 253 263 ! multiplied by the slope of the ocean bottom 264 SELECT CASE ( neos ) 265 266 CASE ( 0 ) ! Jackett and McDougall (1994) formulation 254 267 255 268 # if defined key_vectopt_loop && ! defined key_autotasking … … 301 314 END DO 302 315 316 CASE ( 1 ) ! Linear formulation function of temperature only 317 318 # if defined key_vectopt_loop && ! defined key_autotasking 319 jj = 1 320 DO ji = 1, jpij-jpi ! vector opt. (forced unrolling) 321 # else 322 DO jj = 1, jpjm1 323 DO ji = 1, jpim1 324 # endif 325 ! local density gradient along i-bathymetric slope 326 zgdrho = ( ztnb(ji+1,jj) - ztnb(ji,jj) ) 327 ! sign of local i-gradient of density multiplied by the i-slope 328 zsign = SIGN( 0.5, - zgdrho * ( zdep(ji+1,jj) - zdep(ji,jj) ) ) 329 zki(ji,jj) = ( 0.5 - zsign ) * zahu(ji,jj) 330 # if ! defined key_vectopt_loop || defined key_autotasking 331 END DO 332 # endif 333 END DO 334 335 # if defined key_vectopt_loop && ! defined key_autotasking 336 jj = 1 337 DO ji = 1, jpij-jpi ! vector opt. (forced unrolling) 338 # else 339 DO jj = 1, jpjm1 340 DO ji = 1, jpim1 341 # endif 342 ! local density gradient along j-bathymetric slope 343 zgdrho = ( ztnb(ji,jj+1) - ztnb(ji,jj) ) 344 ! sign of local j-gradient of density multiplied by the j-slope 345 zsign = sign( 0.5, -zgdrho * ( zdep(ji,jj+1) - zdep(ji,jj) ) ) 346 zkj(ji,jj) = ( 0.5 - zsign ) * zahv(ji,jj) 347 348 # if ! defined key_vectopt_loop || defined key_autotasking 349 END DO 350 # endif 351 END DO 352 353 CASE ( 2 ) ! Linear formulation function of temperature and salinity 354 355 DO jj = 1, jpjm1 356 DO ji = 1, fs_jpim1 ! vector opt. 357 ! local density gradient along i-bathymetric slope 358 zgdrho = - ( rbeta*( zsnb(ji+1,jj) - zsnb(ji,jj) ) & 359 - ralpha*( ztnb(ji+1,jj) - ztnb(ji,jj) ) ) 360 ! sign of local i-gradient of density multiplied by the i-slope 361 zsign = SIGN( 0.5, - zgdrho * ( zdep(ji+1,jj) - zdep(ji,jj) ) ) 362 zki(ji,jj) = ( 0.5 - zsign ) * zahu(ji,jj) 363 END DO 364 END DO 365 366 DO jj = 1, jpjm1 367 DO ji = 1, fs_jpim1 ! vector opt. 368 ! local density gradient along j-bathymetric slope 369 zgdrho = - ( rbeta*( zsnb(ji,jj+1) - zsnb(ji,jj) ) & 370 - ralpha*( ztnb(ji,jj+1) - ztnb(ji,jj) ) ) 371 ! sign of local j-gradient of density multiplied by the j-slope 372 zsign = sign( 0.5, -zgdrho * ( zdep(ji,jj+1) - zdep(ji,jj) ) ) 373 zkj(ji,jj) = ( 0.5 - zsign ) * zahv(ji,jj) 374 END DO 375 END DO 376 377 378 CASE DEFAULT 379 380 IF(lwp) WRITE(numout,cform_err) 381 IF(lwp) WRITE(numout,*) ' bad flag value for neos = ', neos 382 nstop = nstop + 1 383 384 END SELECT 385 303 386 ! 2. Additional second order diffusive trends 304 387 ! ------------------------------------------- … … 333 416 # endif 334 417 END DO 335 336 #endif337 418 338 419 IF( cp_cfg == "orca" ) THEN … … 425 506 !! * Local declarations 426 507 INTEGER :: ji, jj ! dummy loop indices 427 428 !!---------------------------------------------------------------------- 508 INTEGER :: numnat=80 509 NAMELIST/namtrcbbl/ atrcbbl 510 511 !!---------------------------------------------------------------------- 512 ! Read Namelist namtrcbbl : bottom boundary layer scheme 513 ! -------------------- 514 515 OPEN(numnat,FILE='namelist.trp.cfc') 516 REWIND ( numnat ) 517 READ ( numnat, namtrcbbl ) 518 CLOSE(numnat) 429 519 430 520 … … 435 525 WRITE(numout,*) 'trc_bbl_init : * Diffusive Bottom Boundary Layer' 436 526 WRITE(numout,*) '~~~~~~~~~~~~' 527 WRITE(numout,*) ' bottom boundary layer coef. atrcbbl = ', atrcbbl 437 528 # if defined key_trcbbl_adv 438 529 WRITE(numout,*) ' * Advective Bottom Boundary Layer' -
trunk/NEMO/TOP_SRC/TRP/trcbbl_adv.h90
r349 r403 54 54 !! * Modules used 55 55 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 56 USE eosbn2 56 57 57 58 !! * Arguments … … 137 138 END DO 138 139 #endif 139 140 140 141 ! boundary conditions on zunb and zvnb (changed sign) 141 142 CALL lbc_lnk( zunb, 'U', -1. ) ; CALL lbc_lnk( zvnb, 'V', -1. ) 142 143 143 ! Conditional diffusion along the slope in the bottom boundary layer144 145 #if defined key_trcbbl_dif146 # if defined key_vectopt_loop && ! defined key_autotasking147 jj = 1148 DO ji = 1, jpij-jpi ! vector opt. (forced unrolling)149 # else150 DO jj = 1, jpjm1151 DO ji = 1, jpim1152 # endif153 iku = mbku(ji,jj)154 ikv = mbkv(ji,jj)155 zahu(ji,jj) = atrbbl*e2u(ji,jj)*fse3u(ji,jj,iku)/e1u(ji,jj) * umask(ji,jj,1)156 zahv(ji,jj) = atrbbl*e1v(ji,jj)*fse3v(ji,jj,ikv)/e2v(ji,jj) * vmask(ji,jj,1)157 # if ! defined key_vectopt_loop || defined key_autotasking158 END DO159 # endif160 END DO161 #endif162 144 163 145 … … 216 198 CASE ( 1 ) ! Linear formulation function of temperature only 217 199 218 IF(lwp) WRITE(numout,cform_err) 219 IF(lwp) WRITE(numout,*) ' use of linear eos rho(T,S) = rau0 * ( rbeta * S - ralpha * T )' 220 IF(lwp) WRITE(numout,*) ' bbl not implented: easy to do it ' 221 nstop = nstop + 1 200 201 # if defined key_vectopt_loop && ! defined key_autotasking 202 jj = 1 203 DO ji = 1, jpij-jpi ! vector opt. (forced unrolling) 204 # else 205 DO jj = 1, jpjm1 206 DO ji = 1, jpim1 207 # endif 208 ! temperature, salinity anomalie and depth 209 zt = 0.5 * ( ztnb(ji,jj) + ztnb(ji+1,jj) ) 210 zs = 0.5 * ( zsnb(ji,jj) + zsnb(ji+1,jj) ) - 35.0 211 zh = 0.5 * ( zdep(ji,jj) + zdep(ji+1,jj) ) 212 ! masked ratio alpha/beta 213 ! local density gradient along i-bathymetric slope 214 zgdrho = ( ztnb(ji+1,jj) - ztnb(ji,jj) ) 215 ! sign of local i-gradient of density multiplied by the i-slope 216 zsign = SIGN( 0.5, - zgdrho * ( zdep(ji+1,jj) - zdep(ji,jj) ) ) 217 zki(ji,jj) = ( 0.5 - zsign ) * zahu(ji,jj) 218 219 zsigna= sign(0.5, zunb(ji,jj)*( zdep(ji+1,jj) - zdep(ji,jj) )) 220 zalphax(ji,jj)=(0.5-zsigna)*(0.5-zsign)*umask(ji,jj,1) 221 # if ! defined key_vectopt_loop || defined key_autotasking 222 END DO 223 # endif 224 END DO 225 226 # if defined key_vectopt_loop && ! defined key_autotasking 227 jj = 1 228 DO ji = 1, jpij-jpi ! vector opt. (forced unrolling) 229 # else 230 DO jj = 1, jpjm1 231 DO ji = 1, jpim1 232 # endif 233 ! temperature, salinity anomalie and depth 234 zt = 0.5 * ( ztnb(ji,jj+1) + ztnb(ji,jj) ) 235 zs = 0.5 * ( zsnb(ji,jj+1) + zsnb(ji,jj) ) - 35.0 236 zh = 0.5 * ( zdep(ji,jj+1) + zdep(ji,jj) ) 237 ! masked ratio alpha/beta 238 ! local density gradient along j-bathymetric slope 239 zgdrho = ( ztnb(ji,jj+1) - ztnb(ji,jj) ) 240 ! sign of local j-gradient of density multiplied by the j-slope 241 zsign = sign( 0.5, -zgdrho * ( zdep(ji,jj+1) - zdep(ji,jj) ) ) 242 zkj(ji,jj) = ( 0.5 - zsign ) * zahv(ji,jj) 243 244 zsigna= sign(0.5, zvnb(ji,jj)*(zdep(ji,jj+1) - zdep(ji,jj) ) ) 245 zalphay(ji,jj)=(0.5-zsigna)*(0.5-zsign)*vmask(ji,jj,1) 246 # if ! defined key_vectopt_loop || defined key_autotasking 247 END DO 248 # endif 249 END DO 222 250 223 251 CASE ( 2 ) ! Linear formulation function of temperature and salinity 224 252 225 IF(lwp) WRITE(numout,cform_err) 226 IF(lwp) WRITE(numout,*) ' use of linear eos rho(T,S) = rau0 * ( rbeta * S - ralpha * T )' 227 IF(lwp) WRITE(numout,*) ' bbl not implented: easy to do it ' 228 nstop = nstop + 1 253 DO jj = 1, jpjm1 254 DO ji = 1, fs_jpim1 ! vector opt. 255 ! local density gradient along i-bathymetric slope 256 zgdrho = - ( rbeta*( zsnb(ji+1,jj) - zsnb(ji,jj) ) & 257 - ralpha*( ztnb(ji+1,jj) - ztnb(ji,jj) ) ) 258 ! sign of local i-gradient of density multiplied by the i-slope 259 zsign = SIGN( 0.5, - zgdrho * ( zdep(ji+1,jj) - zdep(ji,jj) ) ) 260 261 zsigna= sign(0.5, zunb(ji,jj)*( zdep(ji+1,jj) - zdep(ji,jj) )) 262 zalphax(ji,jj)=(0.5-zsigna)*(0.5-zsign)*umask(ji,jj,1) 263 END DO 264 END DO 265 266 DO jj = 1, jpjm1 267 DO ji = 1, fs_jpim1 ! vector opt. 268 ! local density gradient along j-bathymetric slope 269 zgdrho = - ( rbeta*( zsnb(ji,jj+1) - zsnb(ji,jj) ) & 270 - ralpha*( ztnb(ji,jj+1) - ztnb(ji,jj) ) ) 271 ! sign of local j-gradient of density multiplied by the j-slope 272 zsign = sign( 0.5, -zgdrho * ( zdep(ji,jj+1) - zdep(ji,jj) ) ) 273 274 zsigna= sign(0.5, zvnb(ji,jj)*(zdep(ji,jj+1) - zdep(ji,jj) ) ) 275 zalphay(ji,jj)=(0.5-zsigna)*(0.5-zsign)*vmask(ji,jj,1) 276 END DO 277 END DO 278 229 279 230 280 CASE DEFAULT … … 284 334 END DO 285 335 286 #if defined key_trcbbl_dif287 ! 4. Additional second order diffusive trends288 ! -------------------------------------------289 290 ! ... first derivative (gradient)291 DO jj = 1, jpjm1292 DO ji = 1, fs_jpim1 ! vertor opt.293 zkx(ji,jj) = zki(ji,jj)*( ztrb(ji+1,jj) - ztrb(ji,jj) )294 zky(ji,jj) = zkj(ji,jj)*( ztrb(ji,jj+1) - ztrb(ji,jj) )295 END DO296 END DO297 298 IF( cp_cfg == "orca" ) THEN299 SELECT CASE ( jp_cfg )300 ! ! =======================301 CASE ( 2 ) ! ORCA_R2 configuration302 ! ! =======================303 ! Gibraltar enhancement of BBL304 zkx( mi0(139):mi1(140) , mj0(102):mj1(102) ) = 4.e0 * zkx( mi0(139):mi1(140) , mj0(102):mj1(102) )305 zky( mi0(139):mi1(140) , mj0(102):mj1(102) ) = 4.e0 * zky( mi0(139):mi1(140) , mj0(102):mj1(102) )306 307 ! Red Sea enhancement of BBL308 zkx( mi0(161):mi1(162) , mj0(88):mj1(88) ) = 10.e0 * zkx( mi0(161):mi1(162) , mj0(88):mj1(88) )309 zky( mi0(161):mi1(162) , mj0(88):mj1(88) ) = 10.e0 * zky( mi0(161):mi1(162) , mj0(88):mj1(88) )310 311 ! ! =======================312 CASE ( 4 ) ! ORCA_R4 configuration313 ! ! =======================314 ! Gibraltar enhancement of BBL315 zkx( mi0(70):mi1(71) , mj0(52):mj1(52) ) = 4.e0 * zkx( mi0(70):mi1(71) , mj0(52):mj1(52) )316 zky( mi0(70):mi1(71) , mj0(52):mj1(52) ) = 4.e0 * zky( mi0(70):mi1(71) , mj0(52):mj1(52) )317 318 END SELECT319 320 ENDIF321 322 ! ... second derivative (divergence) and add to the general tracer trend323 324 # if defined key_vectopt_loop && ! defined key_autotasking325 jj = 1326 DO ji = jpi+2, jpij-jpi-1 ! vector opt. (forced unrolling)327 # else328 DO jj = 2, jpjm1329 DO ji = 2, jpim1330 # endif331 ik = mbkt(ji,jj)332 zbtr = 1. / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,ik) )333 ztra = ( zkx(ji,jj) - zkx(ji-1,jj ) &334 & + zky(ji,jj) - zky(ji ,jj-1) ) * zbtr335 tra(ji,jj,ik,jn) = tra(ji,jj,ik,jn) + ztra336 #if ! defined key_vectopt_loop || defined key_autotasking337 END DO338 #endif339 END DO340 341 #endif342 343 336 344 337 ! 5. Along sigma advective trend … … 360 353 zwx(ji,jj) = ( ( zfui + ABS( zfui ) ) * ztrb(ji ,jj ) & 361 354 & +( zfui - ABS( zfui ) ) * ztrb(ji+1,jj ) ) * 0.5 362 zwy(ji,jj) = ( ( zf ui+ ABS( zfvj ) ) * ztrb(ji ,jj ) &363 & +( zf ui- ABS( zfvj ) ) * ztrb(ji ,jj+1) ) * 0.5355 zwy(ji,jj) = ( ( zfvj + ABS( zfvj ) ) * ztrb(ji ,jj ) & 356 & +( zfvj - ABS( zfvj ) ) * ztrb(ji ,jj+1) ) * 0.5 364 357 #if ! defined key_vectopt_loop || defined key_autotasking 365 358 END DO … … 378 371 ztra = - zbtr * ( zwx(ji,jj) - zwx(ji-1,jj ) & 379 372 & + zwy(ji,jj) - zwy(ji ,jj-1) ) 380 373 381 374 ! add it to the general tracer trends 382 375 tra(ji,jj,ik,jn) = tra(ji,jj,ik,jn) + ztra
Note: See TracChangeset
for help on using the changeset viewer.