Changeset 403 for trunk/NEMO/TOP_SRC/TRP/trcbbl.F90
- Timestamp:
- 2006-03-20T16:45:14+01:00 (18 years ago)
- File:
-
- 1 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'
Note: See TracChangeset
for help on using the changeset viewer.