- Timestamp:
- 2016-12-01T11:30:29+01:00 (8 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2016/dev_merge_2016/NEMOGCM/NEMO/OPA_SRC/DYN/wet_dry.F90
r6152 r7412 33 33 !! --------------------------------------------------------------------- 34 34 35 REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:) :: wduflt, wdvflt !: u- and v- filter36 35 REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:) :: wdmask !: u- and v- limiter 37 36 … … 46 45 PUBLIC wad_lmt ! routine called by sshwzv.F90 47 46 PUBLIC wad_lmt_bt ! routine called by dynspg_ts.F90 47 PUBLIC wad_istate ! routine called by istate.F90 and domvvl.F90 48 48 49 49 !! * Substitutions … … 87 87 88 88 IF(ln_wd) THEN 89 ALLOCATE( wd uflt(jpi,jpj), wdvflt(jpi,jpj), wdmask(jpi,jpj), STAT=ierr )89 ALLOCATE( wdmask(jpi,jpj), STAT=ierr ) 90 90 IF( ierr /= 0 ) CALL ctl_stop('STOP', 'wad_init : Array allocation error') 91 91 ENDIF … … 145 145 ! Horizontal Flux in u and v direction 146 146 DO jk = 1, jpkm1 147 DO jj = 1, jpj m1148 DO ji = 1, jpi m1147 DO jj = 1, jpj 148 DO ji = 1, jpi 149 149 zflxu(ji,jj) = zflxu(ji,jj) + e3u_n(ji,jj,jk) * un(ji,jj,jk) * umask(ji,jj,jk) 150 150 zflxv(ji,jj) = zflxv(ji,jj) + e3v_n(ji,jj,jk) * vn(ji,jj,jk) * vmask(ji,jj,jk) … … 156 156 zflxv(:,:) = zflxv(:,:) * e1v(:,:) 157 157 158 DO jj = 2, jpjm1 159 DO ji = 2, jpim1 158 wdmask(:,:) = 1 159 DO jj = 2, jpj 160 DO ji = 2, jpi 160 161 161 162 IF(tmask(ji, jj, 1) < 0.5_wp) CYCLE ! we don't care about land cells … … 168 169 169 170 zdep2 = bathy(ji,jj) + sshb1(ji,jj) - rn_wdmin1 170 IF(zdep2 <0._wp) THEN !add more safty, but not necessary171 IF(zdep2 .le. 0._wp) THEN !add more safty, but not necessary 171 172 !zdep2 = 0._wp 172 173 sshb1(ji,jj) = rn_wdmin1 - bathy(ji,jj) 174 wdmask(ji,jj) = 0._wp 173 175 END IF 174 176 ENDDO … … 183 185 zflxv1(:,:) = zflxv(:,:) * zwdlmtv(:,:) 184 186 185 DO jj = 2, jpj m1186 DO ji = 2, jpi m1187 DO jj = 2, jpj 188 DO ji = 2, jpi 187 189 188 wdmask(ji,jj) = 0189 190 IF(tmask(ji, jj, 1) < 0.5_wp) CYCLE 190 191 IF(bathy(ji,jj) > zdepwd) CYCLE … … 202 203 IF(zdep1 > zdep2) THEN 203 204 zflag = 1 204 wdmask(ji, jj) = 1205 wdmask(ji, jj) = 0 205 206 zcoef = ( ( zdep2 - rn_wdmin2 ) * ztmp - zzflxn * z2dt ) / ( zflxp(ji,jj) * z2dt ) 206 207 zcoef = max(zcoef, 0._wp) … … 209 210 IF(zflxu1(ji-1,jj) < 0._wp) zwdlmtu(ji-1,jj) = zcoef 210 211 IF(zflxv1(ji, jj) > 0._wp) zwdlmtv(ji ,jj) = zcoef 211 IF(zflxv1(ji,jj-1) < 0._wp) zwdlmtv(ji -1,jj) = zcoef212 IF(zflxv1(ji,jj-1) < 0._wp) zwdlmtv(ji,jj-1) = zcoef 212 213 END IF 213 214 END DO ! ji loop … … 231 232 CALL lbc_lnk( un, 'U', -1. ) 232 233 CALL lbc_lnk( vn, 'V', -1. ) 234 ! 235 un_b(:,:) = un_b(:,:) * zwdlmtu(:, :) 236 vn_b(:,:) = vn_b(:,:) * zwdlmtv(:, :) 237 CALL lbc_lnk( un_b, 'U', -1. ) 238 CALL lbc_lnk( vn_b, 'V', -1. ) 233 239 234 240 IF(zflag == 1 .AND. lwp) WRITE(numout,*) 'Need more iterations in wad_lmt!!!' … … 291 297 zflxp(:,:) = 0._wp 292 298 zflxn(:,:) = 0._wp 293 !zflxu(:,:) = 0._wp294 !zflxv(:,:) = 0._wp295 299 296 300 zwdlmtu(:,:) = 1._wp … … 299 303 ! Horizontal Flux in u and v direction 300 304 301 !zflxu(:,:) = zflxu(:,:) * e2u(:,:) 302 !zflxv(:,:) = zflxv(:,:) * e1v(:,:) 303 304 DO jj = 2, jpjm1 305 DO ji = 2, jpim1 305 DO jj = 2, jpj 306 DO ji = 2, jpi 306 307 307 308 IF(tmask(ji, jj, 1) < 0.5_wp) CYCLE ! we don't care about land cells … … 314 315 315 316 zdep2 = bathy(ji,jj) + sshn_e(ji,jj) - rn_wdmin1 316 IF(zdep2 < 0._wp) THEN !add more safty, but not necessary317 !zdep2 = 0._wp318 sshn_e(ji,jj) = rn_wdmin1 - bathy(ji,jj)319 END IF320 317 ENDDO 321 318 END DO … … 329 326 zflxv1(:,:) = zflxv(:,:) * zwdlmtv(:,:) 330 327 331 DO jj = 2, jpj m1332 DO ji = 2, jpi m1328 DO jj = 2, jpj 329 DO ji = 2, jpi 333 330 334 wdmask(ji,jj) = 0335 331 IF(tmask(ji, jj, 1) < 0.5_wp) CYCLE 336 332 IF(bathy(ji,jj) > zdepwd) CYCLE … … 349 345 IF(zdep1 > zdep2) THEN 350 346 zflag = 1 351 !wdmask(ji, jj) = 1352 347 zcoef = ( ( zdep2 - rn_wdmin2 ) * ztmp - zzflxn * z2dt ) / ( zflxp(ji,jj) * z2dt ) 353 348 zcoef = max(zcoef, 0._wp) … … 356 351 IF(zflxu1(ji-1,jj) < 0._wp) zwdlmtu(ji-1,jj) = zcoef 357 352 IF(zflxv1(ji, jj) > 0._wp) zwdlmtv(ji ,jj) = zcoef 358 IF(zflxv1(ji,jj-1) < 0._wp) zwdlmtv(ji -1,jj) = zcoef353 IF(zflxv1(ji,jj-1) < 0._wp) zwdlmtv(ji,jj-1) = zcoef 359 354 END IF 360 355 END DO ! ji loop … … 379 374 IF(zflag == 1 .AND. lwp) WRITE(numout,*) 'Need more iterations in wad_lmt_bt!!!' 380 375 381 !IF( ln_rnf ) CALL sbc_rnf_div( hdivn ) ! runoffs (update hdivn field)382 !IF( nn_cla == 1 ) CALL cla_div ( kt ) ! Cross Land Advection (update hdivn field)383 376 ! 384 377 ! … … 390 383 IF( nn_timing == 1 ) CALL timing_stop('wad_lmt') 391 384 END SUBROUTINE wad_lmt_bt 385 386 SUBROUTINE wad_istate 387 !!---------------------------------------------------------------------- 388 !! *** ROUTINE wad_istate *** 389 !! 390 !! ** Purpose : Initialization of the dynamics and tracers for WAD test 391 !! configurations (channels or bowls with initial ssh gradients) 392 !! 393 !! ** Method : - set temperature field 394 !! - set salinity field 395 !! - set ssh slope (needs to be repeated in domvvl_rst_init to 396 !! set vertical metrics ) 397 !!---------------------------------------------------------------------- 398 ! 399 INTEGER :: ji, jj ! dummy loop indices 400 REAL(wp) :: zi, zj 401 !!---------------------------------------------------------------------- 402 ! 403 ! Uniform T & S in all test cases 404 tsn(:,:,:,jp_tem) = 10._wp 405 tsb(:,:,:,jp_tem) = 10._wp 406 tsn(:,:,:,jp_sal) = 35._wp 407 tsb(:,:,:,jp_sal) = 35._wp 408 SELECT CASE ( jp_cfg ) 409 ! ! ==================== 410 CASE ( 1 ) ! WAD 1 configuration 411 ! ! ==================== 412 ! 413 IF(lwp) WRITE(numout,*) 414 IF(lwp) WRITE(numout,*) 'istate_wad : Closed box with EW linear bottom slope' 415 IF(lwp) WRITE(numout,*) '~~~~~~~~~~' 416 ! 417 do ji = 1,jpi 418 sshn(ji,:) = ( -5.5_wp + 5.5_wp*FLOAT(mig(ji))/FLOAT(jpidta-1))*tmask(ji,:,1) 419 end do 420 ! ! ==================== 421 CASE ( 2 ) ! WAD 2 configuration 422 ! ! ==================== 423 ! 424 IF(lwp) WRITE(numout,*) 425 IF(lwp) WRITE(numout,*) 'istate_wad : Parobolic EW channel, mid-range initial ssh slope' 426 IF(lwp) WRITE(numout,*) '~~~~~~~~~~' 427 ! 428 do ji = 1,jpi 429 sshn(ji,:) = ( -5.5_wp + 3.9_wp*FLOAT(jpidta - mig(ji))/FLOAT(jpidta-1))*tmask(ji,:,1) 430 end do 431 ! ! ==================== 432 CASE ( 3 ) ! WAD 3 configuration 433 ! ! ==================== 434 ! 435 IF(lwp) WRITE(numout,*) 436 IF(lwp) WRITE(numout,*) 'istate_wad : Parobolic EW channel, extreme initial ssh slope' 437 IF(lwp) WRITE(numout,*) '~~~~~~~~~~' 438 ! 439 do ji = 1,jpi 440 sshn(ji,:) = ( -7.5_wp + 6.9_wp*FLOAT(jpidta - mig(ji))/FLOAT(jpidta-1))*tmask(ji,:,1) 441 end do 442 443 ! 444 ! ! ==================== 445 CASE ( 4 ) ! WAD 4 configuration 446 ! ! ==================== 447 ! 448 IF(lwp) WRITE(numout,*) 449 IF(lwp) WRITE(numout,*) 'istate_wad : Parobolic bowl, mid-range initial ssh slope' 450 IF(lwp) WRITE(numout,*) '~~~~~~~~~~' 451 ! 452 DO ji = 1, jpi 453 zi = MAX(1.0-FLOAT((mig(ji)-25)**2)/400.0, 0.0 ) 454 DO jj = 1, jpj 455 zj = MAX(1.0-FLOAT((mjg(jj)-17)**2)/144.0, 0.0 ) 456 sshn(ji,jj) = -8.5_wp + 8.5_wp*zi*zj 457 END DO 458 END DO 459 460 ! 461 ! ! =========================== 462 CASE ( 5 ) ! WAD 5 configuration 463 ! ! ==================== 464 ! 465 IF(lwp) WRITE(numout,*) 466 IF(lwp) WRITE(numout,*) 'istate_wad : Double slope with shelf' 467 IF(lwp) WRITE(numout,*) '~~~~~~~~~~' 468 ! 469 ! Needed rn_wdmin2 increased to 0.01 for this case? 470 do ji = 1,jpi 471 sshn(ji,:) = ( -5.5_wp + 9.0_wp*FLOAT(mig(ji))/FLOAT(jpidta-1))*tmask(ji,:,1) 472 end do 473 474 ! 475 ! ! =========================== 476 CASE ( 6 ) ! WAD 6 configuration 477 ! ! ==================== 478 ! 479 IF(lwp) WRITE(numout,*) 480 IF(lwp) WRITE(numout,*) 'istate_wad : Parobolic EW channel with gaussian ridge' 481 IF(lwp) WRITE(numout,*) '~~~~~~~~~~' 482 ! 483 do ji = 1,jpi 484 !6a 485 sshn(ji,:) = ( -5.5_wp + 9.0_wp*FLOAT(jpidta - mig(ji))/FLOAT(jpidta-1))*tmask(ji,:,1) 486 !Some variations in initial slope that have been tested 487 !6b 488 !sshn(ji,:) = ( -5.5_wp + 6.5_wp*FLOAT(jpidta - mig(ji))/FLOAT(jpidta-1))*tmask(ji,:,1) 489 !6c 490 !sshn(ji,:) = ( -5.5_wp + 7.5_wp*FLOAT(jpidta - mig(ji))/FLOAT(jpidta-1))*tmask(ji,:,1) 491 !6d 492 !sshn(ji,:) = ( -4.5_wp + 8.0_wp*FLOAT(jpidta - mig(ji))/FLOAT(jpidta-1))*tmask(ji,:,1) 493 end do 494 495 ! 496 ! ! =========================== 497 CASE DEFAULT ! NONE existing configuration 498 ! ! =========================== 499 WRITE(ctmp1,*) 'WAD test with a ', jp_cfg,' option is not coded' 500 ! 501 CALL ctl_stop( ctmp1 ) 502 ! 503 END SELECT 504 ! 505 ! Apply minimum wetdepth criterion 506 ! 507 do jj = 1,jpj 508 do ji = 1,jpi 509 IF( bathy(ji,jj) + sshn(ji,jj) < rn_wdmin1 ) THEN 510 sshn(ji,jj) = tmask(ji,jj,1)*( rn_wdmin1 - bathy(ji,jj) ) 511 ENDIF 512 end do 513 end do 514 sshb = sshn 515 ssha = sshn 516 ! 517 END SUBROUTINE wad_istate 518 519 !!===================================================================== 392 520 END MODULE wet_dry
Note: See TracChangeset
for help on using the changeset viewer.
