Changeset 5332 for trunk/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfbfr.F90
 Timestamp:
 20150601T18:59:09+02:00 (6 years ago)
 File:

 1 edited
Legend:
 Unmodified
 Added
 Removed

trunk/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfbfr.F90
r5120 r5332 171 171 END DO 172 172 END DO 173 CALL lbc_lnk( bfrua, 'U', 1. ) ; CALL lbc_lnk( bfrva, 'V', 1. ) ! Lateral boundary condition 174 173 175 IF ( ln_isfcav ) THEN 174 176 DO jj = 2, jpjm1 175 177 DO ji = 2, jpim1 176 178 ! (ISF) ======================================================================== 177 ikbu = miku(ji,jj) ! ocean bottomlevel at u and vpoints178 ikbv = mikv(ji,jj) ! ( deepest ocean u and vpoints)179 ikbu = miku(ji,jj) ! ocean top level at u and vpoints 180 ikbv = mikv(ji,jj) ! (1st wet ocean u and vpoints) 179 181 ! 180 182 zvu = 0.25 * ( vn(ji,jj ,ikbu) + vn(ji+1,jj ,ikbu) & … … 183 185 & + un(ji,jj+1,ikbv) + un(ji1,jj+1,ikbv) ) 184 186 ! 185 zecu = SQRT( un(ji,jj,ikbu) * un(ji,jj,ikbu) + zvu*zvu + rn_ bfeb2 )186 zecv = SQRT( vn(ji,jj,ikbv) * vn(ji,jj,ikbv) + zuv*zuv + rn_ bfeb2 )187 zecu = SQRT( un(ji,jj,ikbu) * un(ji,jj,ikbu) + zvu*zvu + rn_tfeb2 ) 188 zecv = SQRT( vn(ji,jj,ikbv) * vn(ji,jj,ikbv) + zuv*zuv + rn_tfeb2 ) 187 189 ! 188 190 tfrua(ji,jj) =  0.5_wp * ( ztfrt(ji,jj) + ztfrt(ji+1,jj ) ) * zecu * (1._wp  umask(ji,jj,1)) … … 202 204 END DO 203 205 END DO 204 END IF205 !206 CALL lbc_lnk( bfrua, 'U', 1. ) ; CALL lbc_lnk( bfrva, 'V', 1. ) ! Lateral boundary condition206 CALL lbc_lnk( tfrua, 'U', 1. ) ; CALL lbc_lnk( tfrva, 'V', 1. ) ! Lateral boundary condition 207 END IF 208 ! 207 209 ! 208 210 IF(ln_ctl) CALL prt_ctl( tab2d_1=bfrua, clinfo1=' bfr  u: ', mask1=umask, & … … 277 279 IF(lwp) WRITE(numout,*) ' coef rn_bfri2 enhancement factor rn_bfrien = ',rn_bfrien 278 280 ENDIF 279 IF(lwp) WRITE(numout,*) ' top friction coef. rn_bfri1 = ', rn_bfri1 280 IF( ln_tfr2d ) THEN 281 IF(lwp) WRITE(numout,*) ' read coef. enhancement distribution from file ln_tfr2d = ', ln_tfr2d 282 IF(lwp) WRITE(numout,*) ' coef rn_tfri2 enhancement factor rn_tfrien = ',rn_tfrien 283 ENDIF 281 IF ( ln_isfcav ) THEN 282 IF(lwp) WRITE(numout,*) ' top friction coef. rn_bfri1 = ', rn_tfri1 283 IF( ln_tfr2d ) THEN 284 IF(lwp) WRITE(numout,*) ' read coef. enhancement distribution from file ln_tfr2d = ', ln_tfr2d 285 IF(lwp) WRITE(numout,*) ' coef rn_tfri2 enhancement factor rn_tfrien = ',rn_tfrien 286 ENDIF 287 END IF 284 288 ! 285 289 IF(ln_bfr2d) THEN … … 295 299 bfrua(:,:) =  bfrcoef2d(:,:) 296 300 bfrva(:,:) =  bfrcoef2d(:,:) 301 ! 302 IF ( ln_isfcav ) THEN 303 IF(ln_tfr2d) THEN 304 ! tfr_coef is a coefficient in [0,1] giving the mask where to apply the bfr enhancement 305 CALL iom_open('tfr_coef.nc',inum) 306 CALL iom_get (inum, jpdom_data, 'tfr_coef',tfrcoef2d,1) ! tfrcoef2d is used as tmp array 307 CALL iom_close(inum) 308 tfrcoef2d(:,:) = rn_tfri1 * ( 1 + rn_tfrien * tfrcoef2d(:,:) ) 309 ELSE 310 tfrcoef2d(:,:) = rn_tfri1 ! initialize tfrcoef2d to the namelist variable 311 ENDIF 312 ! 313 tfrua(:,:) =  tfrcoef2d(:,:) 314 tfrva(:,:) =  tfrcoef2d(:,:) 315 END IF 297 316 ! 298 317 CASE( 2 ) … … 311 330 IF(lwp) WRITE(numout,*) ' coef rn_bfri2 enhancement factor rn_bfrien = ',rn_bfrien 312 331 ENDIF 313 IF(lwp) WRITE(numout,*) ' quadratic top friction' 314 IF(lwp) WRITE(numout,*) ' friction coef. rn_bfri2 = ', rn_tfri2 315 IF(lwp) WRITE(numout,*) ' Max. coef. (log case) rn_tfri2_max = ', rn_tfri2_max 316 IF(lwp) WRITE(numout,*) ' background tke rn_tfeb2 = ', rn_tfeb2 317 IF(lwp) WRITE(numout,*) ' log formulation ln_tfr2d = ', ln_loglayer 318 IF(lwp) WRITE(numout,*) ' bottom roughness rn_tfrz0 [m] = ', rn_tfrz0 319 IF( rn_tfrz0<=0.e0 ) THEN 320 WRITE(ctmp1,*) ' bottom roughness must be strictly positive' 321 CALL ctl_stop( ctmp1 ) 322 ENDIF 323 IF( ln_tfr2d ) THEN 324 IF(lwp) WRITE(numout,*) ' read coef. enhancement distribution from file ln_tfr2d = ', ln_tfr2d 325 IF(lwp) WRITE(numout,*) ' coef rn_tfri2 enhancement factor rn_tfrien = ',rn_tfrien 326 ENDIF 332 IF ( ln_isfcav ) THEN 333 IF(lwp) WRITE(numout,*) ' quadratic top friction' 334 IF(lwp) WRITE(numout,*) ' friction coef. rn_tfri2 = ', rn_tfri2 335 IF(lwp) WRITE(numout,*) ' Max. coef. (log case) rn_tfri2_max = ', rn_tfri2_max 336 IF(lwp) WRITE(numout,*) ' background tke rn_tfeb2 = ', rn_tfeb2 337 IF(lwp) WRITE(numout,*) ' log formulation ln_tfr2d = ', ln_loglayer 338 IF(lwp) WRITE(numout,*) ' top roughness rn_tfrz0 [m] = ', rn_tfrz0 339 IF( rn_tfrz0<=0.e0 ) THEN 340 WRITE(ctmp1,*) ' top roughness must be strictly positive' 341 CALL ctl_stop( ctmp1 ) 342 ENDIF 343 IF( ln_tfr2d ) THEN 344 IF(lwp) WRITE(numout,*) ' read coef. enhancement distribution from file ln_tfr2d = ', ln_tfr2d 345 IF(lwp) WRITE(numout,*) ' coef rn_tfri2 enhancement factor rn_tfrien = ',rn_tfrien 346 ENDIF 347 END IF 327 348 ! 328 349 IF(ln_bfr2d) THEN … … 336 357 bfrcoef2d(:,:) = rn_bfri2 ! initialize bfrcoef2d to the namelist variable 337 358 ENDIF 359 360 IF ( ln_isfcav ) THEN 361 IF(ln_tfr2d) THEN 362 ! tfr_coef is a coefficient in [0,1] giving the mask where to apply the bfr enhancement 363 CALL iom_open('tfr_coef.nc',inum) 364 CALL iom_get (inum, jpdom_data, 'tfr_coef',tfrcoef2d,1) ! tfrcoef2d is used as tmp array 365 CALL iom_close(inum) 366 ! 367 tfrcoef2d(:,:) = rn_tfri2 * ( 1 + rn_tfrien * tfrcoef2d(:,:) ) 368 ELSE 369 tfrcoef2d(:,:) = rn_tfri2 ! initialize tfrcoef2d to the namelist variable 370 ENDIF 371 END IF 338 372 ! 339 373 IF ( ln_loglayer.AND.(.NOT.lk_vvl) ) THEN ! set "log layer" bottom friction once for all … … 346 380 END DO 347 381 END DO 382 IF ( ln_isfcav ) THEN 383 DO jj = 1, jpj 384 DO ji = 1, jpi 385 ikbt = mikt(ji,jj) 386 ztmp = tmask(ji,jj,ikbt) * ( vkarmn / LOG( 0.5_wp * fse3t_n(ji,jj,ikbt) / rn_tfrz0 ))**2._wp 387 tfrcoef2d(ji,jj) = MAX(tfrcoef2d(ji,jj), ztmp) 388 tfrcoef2d(ji,jj) = MIN(tfrcoef2d(ji,jj), rn_tfri2_max) 389 END DO 390 END DO 391 END IF 348 392 ENDIF 349 393 ! … … 398 442 zminbfr = MIN( zminbfr, MIN( zfru, ABS( bfrcoef2d(ji,jj) ) ) ) 399 443 zmaxbfr = MAX( zmaxbfr, MIN( zfrv, ABS( bfrcoef2d(ji,jj) ) ) ) 444 ! (ISF) 445 IF ( ln_isfcav ) THEN 446 ikbu = miku(ji,jj) ! 1st wet ocean level at u and vpoints 447 ikbv = mikv(ji,jj) 448 zfru = 0.5 * fse3u(ji,jj,ikbu) / rdt 449 zfrv = 0.5 * fse3v(ji,jj,ikbv) / rdt 450 IF( ABS( tfrcoef2d(ji,jj) ) > zfru ) THEN 451 IF( ln_ctl ) THEN 452 WRITE(numout,*) 'TFR ', narea, nimpp+ji, njmpp+jj, ikbu 453 WRITE(numout,*) 'TFR ', ABS( tfrcoef2d(ji,jj) ), zfru 454 ENDIF 455 ictu = ictu + 1 456 ENDIF 457 IF( ABS( tfrcoef2d(ji,jj) ) > zfrv ) THEN 458 IF( ln_ctl ) THEN 459 WRITE(numout,*) 'TFR ', narea, nimpp+ji, njmpp+jj, ikbv 460 WRITE(numout,*) 'TFR ', tfrcoef2d(ji,jj), zfrv 461 ENDIF 462 ictv = ictv + 1 463 ENDIF 464 zmintfr = MIN( zmintfr, MIN( zfru, ABS( tfrcoef2d(ji,jj) ) ) ) 465 zmaxtfr = MAX( zmaxtfr, MIN( zfrv, ABS( tfrcoef2d(ji,jj) ) ) ) 466 END IF 467 ! END ISF 400 468 END DO 401 469 END DO … … 405 473 CALL mpp_min( zminbfr ) 406 474 CALL mpp_max( zmaxbfr ) 475 IF ( ln_isfcav) CALL mpp_min( zmintfr ) 476 IF ( ln_isfcav) CALL mpp_max( zmaxtfr ) 407 477 ENDIF 408 478 IF( .NOT.ln_bfrimp) THEN 409 479 IF( lwp .AND. ictu + ictv > 0 ) THEN 410 WRITE(numout,*) ' Bottom friction stability check failed at ', ictu, ' Upoints '411 WRITE(numout,*) ' Bottom friction stability check failed at ', ictv, ' Vpoints '480 WRITE(numout,*) ' Bottom/Top friction stability check failed at ', ictu, ' Upoints ' 481 WRITE(numout,*) ' Bottom/Top friction stability check failed at ', ictv, ' Vpoints ' 412 482 WRITE(numout,*) ' Bottom friction coefficient now ranges from: ', zminbfr, ' to ', zmaxbfr 413 WRITE(numout,*) ' Bottomfriction coefficient now ranges from: ', zmintfr, ' to ', zmaxtfr414 WRITE(numout,*) ' Bottom friction coefficient will be reduced where necessary'483 IF ( ln_isfcav ) WRITE(numout,*) ' Top friction coefficient now ranges from: ', zmintfr, ' to ', zmaxtfr 484 WRITE(numout,*) ' Bottom/Top friction coefficient will be reduced where necessary' 415 485 ENDIF 416 486 ENDIF
Note: See TracChangeset
for help on using the changeset viewer.