- Timestamp:
- 2014-01-29T14:54:00+01:00 (10 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
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.
