Changeset 4380 for branches/2013
- Timestamp:
- 2014-01-29T14:54:00+01:00 (10 years ago)
- Location:
- branches/2013/dev_r4050_NOC_WaD/NEMOGCM/NEMO/OPA_SRC
- Files:
-
- 2 edited
-
DOM/domzgr.F90 (modified) (2 diffs)
-
DYN/dynspg_ts.F90 (modified) (8 diffs)
Legend:
- Unmodified
- Added
- Removed
-
branches/2013/dev_r4050_NOC_WaD/NEMOGCM/NEMO/OPA_SRC/DOM/domzgr.F90
r4375 r4380 372 372 h_oce = gdepw_0(jpk) 373 373 ELSE ! bump centered in the basin 374 !IF(lwp) WRITE(numout,*) 375 !IF(lwp) WRITE(numout,*) ' bathymetry field: flat basin with a bump' 376 !ii_bump = jpidta / 2 ! i-index of the bump center 377 !ij_bump = jpjdta / 2 ! j-index of the bump center 378 !r_bump = 50000._wp ! bump radius (meters) 379 !h_bump = 2700._wp ! bump height (meters) 380 !h_oce = gdepw_0(jpk) ! background ocean depth (meters) 381 !IF(lwp) WRITE(numout,*) ' bump characteristics: ' 382 !IF(lwp) WRITE(numout,*) ' bump center (i,j) = ', ii_bump, ii_bump 383 !IF(lwp) WRITE(numout,*) ' bump height = ', h_bump , ' meters' 384 !IF(lwp) WRITE(numout,*) ' bump radius = ', r_bump , ' index' 385 !IF(lwp) WRITE(numout,*) ' background ocean depth = ', h_oce , ' meters' 386 !! 387 !DO jj = 1, jpjdta ! zdta : 388 ! DO ji = 1, jpidta 389 ! zi = FLOAT( ji - ii_bump ) * ppe1_m / r_bump 390 ! zj = FLOAT( jj - ij_bump ) * ppe2_m / r_bump 391 ! zdta(ji,jj) = h_oce - h_bump * EXP( -( zi*zi + zj*zj ) ) 392 ! END DO 393 !END DO 394 374 395 IF(lwp) WRITE(numout,*) 375 IF(lwp) WRITE(numout,*) ' bathymetry field: flat basin with a bump'376 ii_bump = jpidta / 2 ! i-index of the bumpcenter377 ij_bump = jpjdta / 2 ! j-index of the bumpcenter378 r_bump = 50000._wp ! bumpradius (meters)379 h_bump = 2700._wp ! bump height(meters)396 IF(lwp) WRITE(numout,*) ' bathymetry field: Thacker''s parabolic basin' 397 ii_bump = jpidta / 2 + 1 ! i-index of the basin center 398 ij_bump = jpjdta / 2 + 1 ! j-index of the basin center 399 r_bump = 430620._wp ! basin radius (meters) 400 h_bump = 50._wp ! basin depth (meters) 380 401 h_oce = gdepw_0(jpk) ! background ocean depth (meters) 381 IF(lwp) WRITE(numout,*) ' bumpcharacteristics: '382 IF(lwp) WRITE(numout,*) ' bumpcenter (i,j) = ', ii_bump, ii_bump383 IF(lwp) WRITE(numout,*) ' bump height= ', h_bump , ' meters'384 IF(lwp) WRITE(numout,*) ' bumpradius = ', r_bump , ' index'402 IF(lwp) WRITE(numout,*) ' basin characteristics: ' 403 IF(lwp) WRITE(numout,*) ' basin center (i,j) = ', ii_bump, ii_bump 404 IF(lwp) WRITE(numout,*) ' basin depth = ', h_bump , ' meters' 405 IF(lwp) WRITE(numout,*) ' basin radius = ', r_bump , ' index' 385 406 IF(lwp) WRITE(numout,*) ' background ocean depth = ', h_oce , ' meters' 386 !407 387 408 DO jj = 1, jpjdta ! zdta : 388 409 DO ji = 1, jpidta 389 zi = FLOAT( ji - ii_bump ) * ppe1_m / r_bump390 zj = FLOAT( jj - ij_bump ) * ppe2_m / r_bump391 zdta(ji,jj) = h_ oce - h_bump * EXP( -( zi*zi + zj*zj) )410 zi = FLOAT( ji - ii_bump ) * ppe1_m 411 zj = FLOAT( jj - ij_bump ) * ppe2_m 412 zdta(ji,jj) = h_bump * ( 1._wp - ( zi*zi + zj*zj ) / (r_bump * r_bump) ) 392 413 END DO 393 414 END DO 415 !IF(lwp) WRITE(numout,*) 416 !IF(lwp) WRITE(numout,*) ' bathymetry field: Thacker''s parabolic channel' 417 !ii_bump = jpidta / 2 ! i-index of the bump center 418 !r_bump = 81000._wp ! bump radius (meters) 419 !h_bump = 20._wp ! bump height (meters) 420 !h_oce = gdepw_0(jpk) ! background ocean depth (meters) 421 !IF(lwp) WRITE(numout,*) ' channel characteristics: ' 422 !IF(lwp) WRITE(numout,*) ' channel center (i,j) = ', ii_bump, ii_bump 423 !IF(lwp) WRITE(numout,*) ' channel depth = ', h_bump , ' meters' 424 !IF(lwp) WRITE(numout,*) ' channel radius = ', r_bump , ' index' 425 !IF(lwp) WRITE(numout,*) ' background ocean depth = ', h_oce , ' meters' 426 ! 427 !DO jj = 1, jpjdta ! zdta : 428 ! DO ji = 1, jpidta 429 ! zi = FLOAT( ji - ii_bump ) * ppe1_m 430 ! zdta(ji,jj) = h_bump * ( 1._wp - (zi/r_bump) ** 2) - 10._wp 431 ! END DO 432 !END DO 394 433 ! ! idta : 395 434 IF( ln_sco ) THEN ! s-coordinate (zsc ): idta()=jpk … … 1418 1457 IF( scobot(ji,jj) >= fsdept(ji,jj,jk) ) THEN 1419 1458 mbathy(ji,jj) = MAX( 2, jk ) 1420 ELSE IF(scobot(ji,jj) <= rn_landele) THEN1459 ELSE IF(scobot(ji,jj) <= - rn_landele) THEN 1421 1460 mbathy(ji,jj) = 0 1422 1461 ELSE -
branches/2013/dev_r4050_NOC_WaD/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_ts.F90
r4376 r4380 127 127 REAL(wp), POINTER, DIMENSION(:,:) :: zcu, zcv, zwx, zwy, zbfru, zbfrv, zu_sum, zv_sum 128 128 129 REAL(wp), POINTER, DIMENSION(:,:) :: zwadflt 129 REAL(wp), POINTER, DIMENSION(:,:) :: zwadfltu, zwadfltv 130 130 !!---------------------------------------------------------------------- 131 131 ! … … 136 136 CALL wrk_alloc( jpi, jpj, zcu, zcv, zwx, zwy, zbfru, zbfrv, zu_sum, zv_sum ) 137 137 138 IF(ln_wad) CALL wrk_alloc( jpi, jpj, zwadflt )138 IF(ln_wad) CALL wrk_alloc( jpi, jpj, zwadfltu, zwadfltv) 139 139 ! 140 140 IF( kt == nit000 ) THEN !* initialisation … … 185 185 ENDIF 186 186 187 IF(ln_wad) zwadflt(:,:) = 1._wp 187 IF(ln_wad) THEN 188 zwadfltu(:,:) = 1._wp 189 zwadfltv(:,:) = 1._wp 190 END IF 188 191 189 192 ! ----------------------------------------------------------------------------- … … 412 415 ! !* after ssh_e 413 416 ! ! ----------- 414 DO jj = 2, jpjm1 ! Horizontal divergence of barotropic transports 415 DO ji = fs_2, fs_jpim1 ! vector opt. 416 zhdiv(ji,jj) = ( e2u(ji ,jj) * zun_e(ji ,jj) * hu_e(ji ,jj) & 417 & - e2u(ji-1,jj) * zun_e(ji-1,jj) * hu_e(ji-1,jj) & 418 & + e1v(ji,jj ) * zvn_e(ji,jj ) * hv_e(ji,jj ) & 419 & - e1v(ji,jj-1) * zvn_e(ji,jj-1) * hv_e(ji,jj-1) ) / ( e1t(ji,jj) * e2t(ji,jj) ) 420 END DO 421 END DO 417 IF(ln_wad) THEN 418 DO jj = 2, jpjm1 ! Horizontal divergence of barotropic transports 419 DO ji = fs_2, fs_jpim1 ! vector opt. 420 zhdiv(ji,jj) = ( e2u(ji ,jj) * zun_e(ji ,jj) * hu_e(ji ,jj) * zwadfltu(ji, jj ) & 421 & - e2u(ji-1,jj) * zun_e(ji-1,jj) * hu_e(ji-1,jj) * zwadfltu(ji-1, jj ) & 422 & + e1v(ji,jj ) * zvn_e(ji,jj ) * hv_e(ji,jj ) * zwadfltv(ji, jj ) & 423 & - e1v(ji,jj-1) * zvn_e(ji,jj-1) * hv_e(ji,jj-1) * zwadfltv(ji, jj-1) ) & 424 & / ( e1t(ji,jj) * e2t(ji,jj) ) 425 END DO 426 END DO 427 ELSE 428 DO jj = 2, jpjm1 ! Horizontal divergence of barotropic transports 429 DO ji = fs_2, fs_jpim1 ! vector opt. 430 zhdiv(ji,jj) = ( e2u(ji ,jj) * zun_e(ji ,jj) * hu_e(ji ,jj) & 431 & - e2u(ji-1,jj) * zun_e(ji-1,jj) * hu_e(ji-1,jj) & 432 & + e1v(ji,jj ) * zvn_e(ji,jj ) * hv_e(ji,jj ) & 433 & - e1v(ji,jj-1) * zvn_e(ji,jj-1) * hv_e(ji,jj-1) ) & 434 & / ( e1t(ji,jj) * e2t(ji,jj) ) 435 END DO 436 END DO 437 END IF 422 438 ! 423 439 #if defined key_obc … … 433 449 #endif 434 450 ! 451 DO jj = 2, jpjm1 ! leap-frog on ssh_e 452 DO ji = fs_2, fs_jpim1 ! vector opt. 453 ssha_e(ji,jj) = ( zsshb_e(ji,jj) - z2dt_e * & 454 & ( zraur * ( emp(ji,jj)-rnf(ji,jj) ) + zhdiv(ji,jj) ) ) * tmask(ji,jj,1) 455 END DO 456 END DO 457 458 !! generate W/D filter 435 459 IF(ln_wad) THEN 436 DO jj = 2, jpjm1 ! leap-frog on ssh_e460 DO jj = 2, jpjm1 437 461 DO ji = fs_2, fs_jpim1 ! vector opt. 438 ssha_e(ji,jj) = ( zsshb_e(ji,jj) - z2dt_e * & 439 & ( zraur * ( emp(ji,jj)-rnf(ji,jj) ) + zhdiv(ji,jj) ) ) * tmask(ji,jj,1) 440 IF(ssha_e(ji,jj) <= rn_wadmin) THEN 441 zwadflt(ji, jj ) = 0._wp 442 zwadflt(ji-1, jj ) = 0._wp 443 zwadflt(ji, jj-1) = 0._wp 444 zwadflt(ji-1, jj-1) = 0._wp 462 IF(ssha_e(ji,jj) + bathy(ji,jj) <= rn_wadmin) THEN 463 zwadfltu(ji, jj ) = 0._wp 464 zwadfltu(ji-1, jj ) = 0._wp 465 zwadfltv(ji, jj ) = 0._wp 466 zwadfltv(ji, jj-1) = 0._wp 445 467 END IF 446 468 END DO 447 469 END DO 448 ELSE 449 DO jj = 2, jpjm1 ! leap-frog on ssh_e 450 DO ji = fs_2, fs_jpim1 ! vector opt. 451 ssha_e(ji,jj) = ( zsshb_e(ji,jj) - z2dt_e * & 452 & ( zraur * ( emp(ji,jj)-rnf(ji,jj) ) + zhdiv(ji,jj) ) ) * tmask(ji,jj,1) 453 END DO 454 END DO 470 CALL lbc_lnk(zwadfltu, 'U', 1._wp) 471 CALL lbc_lnk(zwadfltv, 'V', 1._wp) 455 472 END IF 473 456 474 457 475 ! !* after barotropic velocities (vorticity scheme dependent) … … 622 640 #endif 623 641 642 IF(ln_wad) THEN 643 DO jj = 2, jpjm1 644 DO ji = fs_2, fs_jpim1 ! vector opt. 645 ua_e(ji,jj) = ua_e(ji,jj) * zwadfltu(ji,jj) 646 va_e(ji,jj) = va_e(ji,jj) * zwadfltv(ji,jj) 647 END DO 648 END DO 649 END IF 650 624 651 ! 625 652 CALL lbc_lnk( ua_e , 'U', -1. ) ! local domain boundaries … … 693 720 IF(ln_wad) THEN 694 721 DO jk=1,jpkm1 695 ua(:,:,jk) = ua(:,:,jk) + ( zu_sum(:,:) - ub_b(:,:) ) * z1_2dt_b * zwadflt (:,:)696 va(:,:,jk) = va(:,:,jk) + ( zv_sum(:,:) - vb_b(:,:) ) * z1_2dt_b * zwadflt (:,:)722 ua(:,:,jk) = ua(:,:,jk) + ( zu_sum(:,:) - ub_b(:,:) ) * z1_2dt_b * zwadfltu(:,:) 723 va(:,:,jk) = va(:,:,jk) + ( zv_sum(:,:) - vb_b(:,:) ) * z1_2dt_b * zwadfltv(:,:) 697 724 END DO 698 725 ELSE … … 714 741 CALL wrk_dealloc( jpi, jpj, zcu, zcv, zwx, zwy, zbfru, zbfrv, zu_sum, zv_sum ) 715 742 716 IF(ln_wad) CALL wrk_dealloc( jpi, jpj, zwadflt )743 IF(ln_wad) CALL wrk_dealloc( jpi, jpj, zwadfltu, zwadfltv) 717 744 ! 718 745 IF( nn_timing == 1 ) CALL timing_stop('dyn_spg_ts')
Note: See TracChangeset
for help on using the changeset viewer.
