Changeset 403 for trunk/NEMO/TOP_SRC/TRP/trcbbl_adv.h90
- Timestamp:
- 2006-03-20T16:45:14+01:00 (18 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
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.