Changeset 7157
- Timestamp:
- 2016-10-28T15:47:10+02:00 (8 years ago)
- Location:
- branches/2016/dev_r6393_NOC_WAD/NEMOGCM/NEMO/OPA_SRC/DYN
- Files:
-
- 2 edited
-
dynhpg.F90 (modified) (18 diffs)
-
dynspg_ts.F90 (modified) (2 diffs)
Legend:
- Unmodified
- Added
- Removed
-
branches/2016/dev_r6393_NOC_WAD/NEMOGCM/NEMO/OPA_SRC/DYN/dynhpg.F90
r7030 r7157 432 432 INTEGER :: ji, jj, jk, jii, jjj ! dummy loop indices 433 433 REAL(wp) :: zcoef0, zuap, zvap, znad, ztmp ! temporary scalars 434 LOGICAL :: ll_tmp1, ll_tmp2 , ll_tmp3! local logical variables434 LOGICAL :: ll_tmp1, ll_tmp2 ! local logical variables 435 435 REAL(wp), POINTER, DIMENSION(:,:,:) :: zhpi, zhpj 436 436 REAL(wp), POINTER, DIMENSION(:,:) :: zcpx, zcpy !W/D pressure filter … … 438 438 ! 439 439 CALL wrk_alloc( jpi,jpj,jpk, zhpi, zhpj ) 440 IF( ln_wd) CALL wrk_alloc( jpi,jpj, zcpx, zcpy )440 IF( ln_wd ) CALL wrk_alloc( jpi,jpj, zcpx, zcpy ) 441 441 ! 442 442 IF( kt == nit000 ) THEN … … 451 451 ENDIF 452 452 ! 453 IF( ln_wd) THEN453 IF( ln_wd ) THEN 454 454 DO jj = 2, jpjm1 455 455 DO ji = 2, jpim1 456 ll_tmp1 = MIN(sshn(ji,jj), sshn(ji+1,jj)) > MAX(-bathy(ji,jj), -bathy(ji+1,jj)) 457 ll_tmp2 = MAX(sshn(ji,jj) + bathy(ji,jj), sshn(ji+1,jj) + bathy(ji+1,jj)) > rn_wdmin1 + rn_wdmin2 458 ll_tmp3 = MAX(sshn(ji,jj), sshn(ji+1,jj)) > MAX(-bathy(ji,jj), -bathy(ji+1,jj)) + & 459 & rn_wdmin1 + rn_wdmin2 460 461 IF(ll_tmp1.AND.ll_tmp2) THEN 456 ll_tmp1 = MIN( sshn(ji,jj) , sshn(ji+1,jj) ) > & 457 & MAX( -bathy(ji,jj) , -bathy(ji+1,jj) ) .AND. & 458 & MAX( sshn(ji,jj) + bathy(ji,jj), sshn(ji+1,jj) + bathy(ji+1,jj) ) & 459 & > rn_wdmin1 + rn_wdmin2 460 ll_tmp2 = MAX( sshn(ji,jj) , sshn(ji+1,jj) ) > & 461 & MAX( -bathy(ji,jj) , -bathy(ji+1,jj) ) + rn_wdmin1 + rn_wdmin2 462 463 IF(ll_tmp1) THEN 462 464 zcpx(ji,jj) = 1.0_wp 463 ELSE IF(ll_tmp 3) THEN464 ! no worries about sshn(ji+1,jj)-sshn(ji,jj) = 0, it won't happen ! here465 zcpx(ji,jj) = ABS( (sshn(ji+1,jj) + bathy(ji+1,jj) - sshn(ji,jj) - bathy(ji,jj)) /&466 & (sshn(ji+1,jj) - sshn(ji,jj)))465 ELSE IF(ll_tmp2) THEN 466 ! no worries about sshn(ji+1,jj) - sshn(ji ,jj) = 0, it won't happen ! here 467 zcpx(ji,jj) = ABS( (sshn(ji+1,jj) + bathy(ji+1,jj) - sshn(ji,jj) - bathy(ji,jj)) & 468 & / (sshn(ji+1,jj) - sshn(ji ,jj)) ) 467 469 ELSE 468 470 zcpx(ji,jj) = 0._wp 469 471 END IF 470 472 471 ll_tmp1 = MIN(sshn(ji,jj), sshn(ji,jj+1)) > MAX(-bathy(ji,jj), -bathy(ji,jj+1)) 472 ll_tmp2 = MAX(sshn(ji,jj) + bathy(ji,jj), sshn(ji,jj+1) + bathy(ji,jj+1)) > rn_wdmin1 + rn_wdmin2 473 ll_tmp3 = MAX(sshn(ji,jj), sshn(ji,jj+1)) > MAX(-bathy(ji,jj), -bathy(ji,jj+1)) + & 474 & rn_wdmin1 + rn_wdmin2 475 476 IF(ll_tmp1.AND.ll_tmp2) THEN 473 ll_tmp1 = MIN( sshn(ji,jj) , sshn(ji,jj+1) ) > & 474 & MAX( -bathy(ji,jj) , -bathy(ji,jj+1) ) .AND. & 475 & MAX( sshn(ji,jj) + bathy(ji,jj), sshn(ji,jj+1) + bathy(ji,jj+1) ) & 476 & > rn_wdmin1 + rn_wdmin2 477 ll_tmp2 = MAX( sshn(ji,jj) , sshn(ji,jj+1) ) > & 478 & MAX( -bathy(ji,jj) , -bathy(ji,jj+1) ) + rn_wdmin1 + rn_wdmin2 479 480 IF(ll_tmp1) THEN 477 481 zcpy(ji,jj) = 1.0_wp 478 ELSE IF(ll_tmp 3) THEN479 ! no worries about sshn(ji,jj+1)-sshn(ji,jj) = 0, it won't happen ! here480 zcpy(ji,jj) = ABS( (sshn(ji,jj+1) + bathy(ji,jj+1) - sshn(ji,jj) - bathy(ji,jj)) /&481 & (sshn(ji,jj+1) - sshn(ji,jj)))482 ELSE IF(ll_tmp2) THEN 483 ! no worries about sshn(ji,jj+1) - sshn(ji,jj ) = 0, it won't happen ! here 484 zcpy(ji,jj) = ABS( (sshn(ji,jj+1) + bathy(ji,jj+1) - sshn(ji,jj) - bathy(ji,jj)) & 485 & / (sshn(ji,jj+1) - sshn(ji,jj )) ) 482 486 ELSE 483 487 zcpy(ji,jj) = 0._wp … … 486 490 END DO 487 491 CALL lbc_lnk( zcpx, 'U', 1._wp ) ; CALL lbc_lnk( zcpy, 'V', 1._wp ) 488 ENDIF 489 492 END IF 490 493 491 494 ! Surface value … … 504 507 505 508 506 IF( ln_wd) THEN509 IF( ln_wd ) THEN 507 510 508 511 zhpi(ji,jj,1) = zhpi(ji,jj,1) * zcpx(ji,jj) … … 535 538 & * ( gde3w_n(ji ,jj+1,jk) - gde3w_n(ji,jj,jk) ) * r1_e2v(ji,jj) 536 539 537 IF( ln_wd) THEN540 IF( ln_wd ) THEN 538 541 zhpi(ji,jj,jk) = zhpi(ji,jj,jk) * zcpx(ji,jj) 539 542 zhpj(ji,jj,jk) = zhpj(ji,jj,jk) * zcpy(ji,jj) … … 550 553 ! 551 554 CALL wrk_dealloc( jpi,jpj,jpk, zhpi, zhpj ) 552 IF( ln_wd) CALL wrk_dealloc( jpi,jpj, zcpx, zcpy )555 IF( ln_wd ) CALL wrk_dealloc( jpi,jpj, zcpx, zcpy ) 553 556 ! 554 557 END SUBROUTINE hpg_sco … … 695 698 CALL wrk_alloc( jpi, jpj, jpk, drhox, drhoy, drhoz, drhou, drhov, drhow ) 696 699 CALL wrk_alloc( jpi, jpj, jpk, rho_i, rho_j, rho_k, zhpi, zhpj ) 697 IF( ln_wd) CALL wrk_alloc( jpi,jpj, zcpx, zcpy )698 ! 699 ! 700 IF( ln_wd) THEN700 IF( ln_wd ) CALL wrk_alloc( jpi,jpj, zcpx, zcpy ) 701 ! 702 ! 703 IF( ln_wd ) THEN 701 704 DO jj = 2, jpjm1 702 705 DO ji = 2, jpim1 703 ll_tmp1 = MIN(sshn(ji,jj), sshn(ji+1,jj)) > MAX(-bathy(ji,jj), -bathy(ji+1,jj)) & 704 & .and. MAX(sshn(ji,jj) + bathy(ji,jj), sshn(ji+1,jj) + bathy(ji+1,jj)) & 705 & > rn_wdmin1 + rn_wdmin2 706 ll_tmp2 = MAX(sshn(ji,jj), sshn(ji+1,jj)) > MAX(-bathy(ji,jj), -bathy(ji+1,jj)) +& 707 & rn_wdmin1 + rn_wdmin2 706 ll_tmp1 = MIN( sshn(ji,jj) , sshn(ji+1,jj) ) > & 707 & MAX( -bathy(ji,jj) , -bathy(ji+1,jj) ) .AND. & 708 & MAX( sshn(ji,jj) + bathy(ji,jj), sshn(ji+1,jj) + bathy(ji+1,jj) ) & 709 & > rn_wdmin1 + rn_wdmin2 710 ll_tmp2 = MAX( sshn(ji,jj) , sshn(ji+1,jj) ) > & 711 & MAX( -bathy(ji,jj) , -bathy(ji+1,jj) ) + rn_wdmin1 + rn_wdmin2 708 712 709 713 IF(ll_tmp1) THEN 710 714 zcpx(ji,jj) = 1.0_wp 711 715 ELSE IF(ll_tmp2) THEN 712 ! no worries about sshn(ji+1,jj)-sshn(ji,jj) = 0, it won't happen ! here713 zcpx(ji,jj) = ABS( (sshn(ji+1,jj) + bathy(ji+1,jj) - sshn(ji,jj) - bathy(ji,jj)) /&714 & (sshn(ji+1,jj) - sshn(ji,jj)))716 ! no worries about sshn(ji+1,jj) - sshn(ji ,jj) = 0, it won't happen ! here 717 zcpx(ji,jj) = ABS( (sshn(ji+1,jj) + bathy(ji+1,jj) - sshn(ji,jj) - bathy(ji,jj)) & 718 & / (sshn(ji+1,jj) - sshn(ji ,jj)) ) 715 719 ELSE 716 720 zcpx(ji,jj) = 0._wp 717 721 END IF 718 722 719 ll_tmp1 = MIN(sshn(ji,jj), sshn(ji,jj+1)) > MAX(-bathy(ji,jj), -bathy(ji,jj+1)) & 720 & .and. MAX(sshn(ji,jj) + bathy(ji,jj), sshn(ji,jj+1) + bathy(ji,jj+1)) & 721 & > rn_wdmin1 + rn_wdmin2 722 ll_tmp2 = MAX(sshn(ji,jj), sshn(ji,jj+1)) > MAX(-bathy(ji,jj), -bathy(ji,jj+1)) +& 723 & rn_wdmin1 + rn_wdmin2 723 ll_tmp1 = MIN( sshn(ji,jj) , sshn(ji,jj+1) ) > & 724 & MAX( -bathy(ji,jj) , -bathy(ji,jj+1) ) .AND. & 725 & MAX( sshn(ji,jj) + bathy(ji,jj), sshn(ji,jj+1) + bathy(ji,jj+1) ) & 726 & > rn_wdmin1 + rn_wdmin2 727 ll_tmp2 = MAX( sshn(ji,jj) , sshn(ji,jj+1) ) > & 728 & MAX( -bathy(ji,jj) , -bathy(ji,jj+1) ) + rn_wdmin1 + rn_wdmin2 724 729 725 730 IF(ll_tmp1) THEN 726 731 zcpy(ji,jj) = 1.0_wp 727 732 ELSE IF(ll_tmp2) THEN 728 ! no worries about sshn(ji,jj+1)-sshn(ji,jj) = 0, it won't happen ! here729 zcpy(ji,jj) = ABS( (sshn(ji,jj+1) + bathy(ji,jj+1) - sshn(ji,jj) - bathy(ji,jj)) /&730 & (sshn(ji,jj+1) - sshn(ji,jj)))733 ! no worries about sshn(ji,jj+1) - sshn(ji,jj ) = 0, it won't happen ! here 734 zcpy(ji,jj) = ABS( (sshn(ji,jj+1) + bathy(ji,jj+1) - sshn(ji,jj) - bathy(ji,jj)) & 735 & / (sshn(ji,jj+1) - sshn(ji,jj )) ) 731 736 ELSE 732 737 zcpy(ji,jj) = 0._wp … … 735 740 END DO 736 741 CALL lbc_lnk( zcpx, 'U', 1._wp ) ; CALL lbc_lnk( zcpy, 'V', 1._wp ) 737 ENDIF 738 742 END IF 739 743 740 744 IF( kt == nit000 ) THEN … … 907 911 zhpi(ji,jj,1) = ( rho_k(ji+1,jj ,1) - rho_k(ji,jj,1) - rho_i(ji,jj,1) ) * r1_e1u(ji,jj) 908 912 zhpj(ji,jj,1) = ( rho_k(ji ,jj+1,1) - rho_k(ji,jj,1) - rho_j(ji,jj,1) ) * r1_e2v(ji,jj) 909 IF( ln_wd) THEN913 IF( ln_wd ) THEN 910 914 zhpi(ji,jj,1) = zhpi(ji,jj,1) * zcpx(ji,jj) 911 915 zhpj(ji,jj,1) = zhpj(ji,jj,1) * zcpy(ji,jj) … … 930 934 & + ( ( rho_k(ji,jj+1,jk) - rho_k(ji,jj,jk ) ) & 931 935 & -( rho_j(ji,jj ,jk) - rho_j(ji,jj,jk-1) ) ) * r1_e2v(ji,jj) 932 IF( ln_wd) THEN936 IF( ln_wd ) THEN 933 937 zhpi(ji,jj,jk) = zhpi(ji,jj,jk) * zcpx(ji,jj) 934 938 zhpj(ji,jj,jk) = zhpj(ji,jj,jk) * zcpy(ji,jj) … … 944 948 CALL wrk_dealloc( jpi, jpj, jpk, drhox, drhoy, drhoz, drhou, drhov, drhow ) 945 949 CALL wrk_dealloc( jpi, jpj, jpk, rho_i, rho_j, rho_k, zhpi, zhpj ) 946 IF( ln_wd) CALL wrk_dealloc( jpi,jpj, zcpx, zcpy )950 IF( ln_wd ) CALL wrk_dealloc( jpi,jpj, zcpx, zcpy ) 947 951 ! 948 952 END SUBROUTINE hpg_djc … … 981 985 CALL wrk_alloc( jpi,jpj,jpk, zdept, zrhh ) 982 986 CALL wrk_alloc( jpi,jpj, zsshu_n, zsshv_n ) 983 IF( ln_wd) CALL wrk_alloc( jpi,jpj, zcpx, zcpy )987 IF( ln_wd ) CALL wrk_alloc( jpi,jpj, zcpx, zcpy ) 984 988 ! 985 989 IF( kt == nit000 ) THEN … … 994 998 IF( ln_linssh ) znad = 0._wp 995 999 996 IF( ln_wd) THEN1000 IF( ln_wd ) THEN 997 1001 DO jj = 2, jpjm1 998 1002 DO ji = 2, jpim1 999 ll_tmp1 = MIN(sshn(ji,jj), sshn(ji+1,jj)) > MAX(-bathy(ji,jj), -bathy(ji+1,jj)) & 1000 & .and. MAX(sshn(ji,jj) + bathy(ji,jj), sshn(ji+1,jj) + bathy(ji+1,jj)) & 1001 & > rn_wdmin1 + rn_wdmin2 1002 ll_tmp2 = MAX(sshn(ji,jj), sshn(ji+1,jj)) > MAX(-bathy(ji,jj), -bathy(ji+1,jj)) +& 1003 & rn_wdmin1 + rn_wdmin2 1003 ll_tmp1 = MIN( sshn(ji,jj) , sshn(ji+1,jj) ) > & 1004 & MAX( -bathy(ji,jj) , -bathy(ji+1,jj) ) .AND. & 1005 & MAX( sshn(ji,jj) + bathy(ji,jj), sshn(ji+1,jj) + bathy(ji+1,jj) ) & 1006 & > rn_wdmin1 + rn_wdmin2 1007 ll_tmp2 = MAX( sshn(ji,jj) , sshn(ji+1,jj) ) > & 1008 & MAX( -bathy(ji,jj) , -bathy(ji+1,jj) ) + rn_wdmin1 + rn_wdmin2 1004 1009 1005 1010 IF(ll_tmp1) THEN 1006 1011 zcpx(ji,jj) = 1.0_wp 1007 1012 ELSE IF(ll_tmp2) THEN 1008 ! no worries about sshn(ji+1,jj)-sshn(ji,jj) = 0, it won't happen ! here1009 zcpx(ji,jj) = ABS( (sshn(ji+1,jj) + bathy(ji+1,jj) - sshn(ji,jj) - bathy(ji,jj)) /&1010 & (sshn(ji+1,jj) - sshn(ji,jj)))1013 ! no worries about sshn(ji+1,jj) - sshn(ji ,jj) = 0, it won't happen ! here 1014 zcpx(ji,jj) = ABS( (sshn(ji+1,jj) + bathy(ji+1,jj) - sshn(ji,jj) - bathy(ji,jj)) & 1015 & / (sshn(ji+1,jj) - sshn(ji ,jj)) ) 1011 1016 ELSE 1012 1017 zcpx(ji,jj) = 0._wp 1013 1018 END IF 1014 1019 1015 ll_tmp1 = MIN(sshn(ji,jj), sshn(ji,jj+1)) > MAX(-bathy(ji,jj), -bathy(ji,jj+1)) & 1016 & .and. MAX(sshn(ji,jj) + bathy(ji,jj), sshn(ji,jj+1) + bathy(ji,jj+1)) & 1017 & > rn_wdmin1 + rn_wdmin2 1018 ll_tmp2 = MAX(sshn(ji,jj), sshn(ji,jj+1)) > MAX(-bathy(ji,jj), -bathy(ji,jj+1)) +& 1019 & rn_wdmin1 + rn_wdmin2 1020 1021 IF(ll_tmp1.OR.ll_tmp2) THEN 1020 ll_tmp1 = MIN( sshn(ji,jj) , sshn(ji,jj+1) ) > & 1021 & MAX( -bathy(ji,jj) , -bathy(ji,jj+1) ) .AND. & 1022 & MAX( sshn(ji,jj) + bathy(ji,jj), sshn(ji,jj+1) + bathy(ji,jj+1) ) & 1023 & > rn_wdmin1 + rn_wdmin2 1024 ll_tmp2 = MAX( sshn(ji,jj) , sshn(ji,jj+1) ) > & 1025 & MAX( -bathy(ji,jj) , -bathy(ji,jj+1) ) + rn_wdmin1 + rn_wdmin2 1026 1027 IF(ll_tmp1) THEN 1022 1028 zcpy(ji,jj) = 1.0_wp 1023 1029 ELSE IF(ll_tmp2) THEN 1024 ! no worries about sshn(ji,jj+1)-sshn(ji,jj) = 0, it won't happen ! here1025 zcpy(ji,jj) = ABS( (sshn(ji,jj+1) + bathy(ji,jj+1) - sshn(ji,jj) - bathy(ji,jj)) /&1026 & (sshn(ji,jj+1) - sshn(ji,jj)))1030 ! no worries about sshn(ji,jj+1) - sshn(ji,jj ) = 0, it won't happen ! here 1031 zcpy(ji,jj) = ABS( (sshn(ji,jj+1) + bathy(ji,jj+1) - sshn(ji,jj) - bathy(ji,jj)) & 1032 & / (sshn(ji,jj+1) - sshn(ji,jj )) ) 1027 1033 ELSE 1028 1034 zcpy(ji,jj) = 0._wp … … 1031 1037 END DO 1032 1038 CALL lbc_lnk( zcpx, 'U', 1._wp ) ; CALL lbc_lnk( zcpy, 'V', 1._wp ) 1033 END IF1039 END IF 1034 1040 1035 1041 ! Clean 3-D work arrays … … 1215 1221 zdpdx2 = zcoef0 * r1_e1u(ji,jj) * REAL(jis-jid, wp) * (zpwes + zpwed) 1216 1222 ENDIF 1217 IF( ln_wd) THEN1223 IF( ln_wd ) THEN 1218 1224 zdpdx1 = zdpdx1 * zcpx(ji,jj) 1219 1225 zdpdx2 = zdpdx2 * zcpx(ji,jj) … … 1274 1280 zdpdy2 = zcoef0 * r1_e2v(ji,jj) * REAL(jjs-jjd, wp) * (zpnss + zpnsd ) 1275 1281 ENDIF 1276 IF( ln_wd) THEN1282 IF( ln_wd ) THEN 1277 1283 zdpdy1 = zdpdy1 * zcpy(ji,jj) 1278 1284 zdpdy2 = zdpdy2 * zcpy(ji,jj) … … 1289 1295 CALL wrk_dealloc( jpi,jpj,jpk, zdept, zrhh ) 1290 1296 CALL wrk_dealloc( jpi,jpj, zsshu_n, zsshv_n ) 1291 IF( ln_wd) CALL wrk_dealloc( jpi,jpj, zcpx, zcpy )1297 IF( ln_wd ) CALL wrk_dealloc( jpi,jpj, zcpx, zcpy ) 1292 1298 ! 1293 1299 END SUBROUTINE hpg_prj -
branches/2016/dev_r6393_NOC_WAD/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_ts.F90
r7016 r7157 373 373 IF( .NOT.ln_linssh ) THEN ! Variable volume : remove surface pressure gradient 374 374 IF( ln_wd ) THEN ! Calculating and applying W/D gravity filters 375 DO jj = 2, jpjm1 376 DO ji = 2, jpim1 377 ll_tmp1 = MIN(sshn(ji,jj), sshn(ji+1,jj)) > MAX(-bathy(ji,jj), -bathy(ji+1,jj)) & 378 & .and. MAX(sshn(ji,jj) + bathy(ji,jj), sshn(ji+1,jj) + bathy(ji+1,jj)) & 379 & > rn_wdmin1 + rn_wdmin2 380 ll_tmp2 = MAX(sshn(ji,jj), sshn(ji+1,jj)) > MAX(-bathy(ji,jj), -bathy(ji+1,jj)) & 381 & + rn_wdmin1 + rn_wdmin2 375 DO jj = 2, jpjm1 376 DO ji = 2, jpim1 377 ll_tmp1 = MIN( sshn(ji,jj) , sshn(ji+1,jj) ) > & 378 & MAX( -bathy(ji,jj) , -bathy(ji+1,jj) ) .AND. & 379 & MAX( sshn(ji,jj) + bathy(ji,jj), sshn(ji+1,jj) + bathy(ji+1,jj) ) & 380 & > rn_wdmin1 + rn_wdmin2 381 ll_tmp2 = MAX( sshn(ji,jj) , sshn(ji+1,jj) ) > & 382 & MAX( -bathy(ji,jj) , -bathy(ji+1,jj) ) + rn_wdmin1 + rn_wdmin2 383 382 384 IF(ll_tmp1) THEN 383 zcpx(ji,jj) 384 ELSE IF(ll_tmp2) THEN385 ! no worries about sshn(ji+1,jj)-sshn(ji,jj) = 0, it won't happenhere386 zcpx(ji,jj) = ABS( (sshn(ji+1,jj) + bathy(ji+1,jj) - sshn(ji,jj) - bathy(ji,jj)) &387 & /(sshn(ji+1,jj) - sshn(ji,jj)))385 zcpx(ji,jj) = 1.0_wp 386 ELSE IF(ll_tmp2) THEN 387 ! no worries about sshn(ji+1,jj) - sshn(ji ,jj) = 0, it won't happen ! here 388 zcpx(ji,jj) = ABS( (sshn(ji+1,jj) + bathy(ji+1,jj) - sshn(ji,jj) - bathy(ji,jj)) & 389 & / (sshn(ji+1,jj) - sshn(ji ,jj)) ) 388 390 ELSE 389 zcpx(ji,jj) 391 zcpx(ji,jj) = 0._wp 390 392 END IF 391 392 ll_tmp1 = MIN(sshn(ji,jj), sshn(ji,jj+1)) > MAX(-bathy(ji,jj), -bathy(ji,jj+1)) & 393 & .and. MAX(sshn(ji,jj) + bathy(ji,jj), sshn(ji,jj+1) + bathy(ji,jj+1)) & 394 & > rn_wdmin1 + rn_wdmin2 395 ll_tmp2 = MAX(sshn(ji,jj), sshn(ji,jj+1)) > MAX(-bathy(ji,jj), -bathy(ji,jj+1)) & 396 & + rn_wdmin1 + rn_wdmin2 393 394 ll_tmp1 = MIN( sshn(ji,jj) , sshn(ji,jj+1) ) > & 395 & MAX( -bathy(ji,jj) , -bathy(ji,jj+1) ) .AND. & 396 & MAX( sshn(ji,jj) + bathy(ji,jj), sshn(ji,jj+1) + bathy(ji,jj+1) ) & 397 & > rn_wdmin1 + rn_wdmin2 398 ll_tmp2 = MAX( sshn(ji,jj) , sshn(ji,jj+1) ) > & 399 & MAX( -bathy(ji,jj) , -bathy(ji,jj+1) ) + rn_wdmin1 + rn_wdmin2 400 397 401 IF(ll_tmp1) THEN 398 zcpy(ji,jj)= 1.0_wp399 ELSE IF(ll_tmp2) THEN400 ! no worries about sshn(ji,jj+1)-sshn(ji,jj) = 0, it won't happenhere401 zcpy(ji,jj) = ABS( (sshn(ji,jj+1) + bathy(ji,jj+1) - sshn(ji,jj) - bathy(ji,jj)) &402 & /(sshn(ji,jj+1) - sshn(ji,jj)))402 zcpy(ji,jj) = 1.0_wp 403 ELSE IF(ll_tmp2) THEN 404 ! no worries about sshn(ji,jj+1) - sshn(ji,jj ) = 0, it won't happen ! here 405 zcpy(ji,jj) = ABS( (sshn(ji,jj+1) + bathy(ji,jj+1) - sshn(ji,jj) - bathy(ji,jj)) & 406 & / (sshn(ji,jj+1) - sshn(ji,jj )) ) 403 407 ELSE 404 zcpy(ji,jj) = 0._wp 405 ENDIF 406 407 END DO 408 zcpy(ji,jj) = 0._wp 409 END IF 410 END DO 408 411 END DO 409 410 412 411 413 DO jj = 2, jpjm1 412 414 DO ji = 2, jpim1 413 zu_trd(ji,jj) = (zu_trd(ji,jj) - grav * ( sshn(ji+1,jj ) - sshn(ji ,jj ) ) &414 & * r1_e1u(ji,jj) )* zcpx(ji,jj)415 zv_trd(ji,jj) = (zv_trd(ji,jj) - grav * ( sshn(ji ,jj+1) - sshn(ji ,jj ) ) &416 & * r1_e2v(ji,jj) )* zcpy(ji,jj)415 zu_trd(ji,jj) = zu_trd(ji,jj) - grav * ( sshn(ji+1,jj ) - sshn(ji ,jj ) ) & 416 & * r1_e1u(ji,jj) * zcpx(ji,jj) 417 zv_trd(ji,jj) = zv_trd(ji,jj) - grav * ( sshn(ji ,jj+1) - sshn(ji ,jj ) ) & 418 & * r1_e2v(ji,jj) * zcpy(ji,jj) 417 419 END DO 418 420 END DO … … 735 737 zsshp2_e(:,:) = za0 * ssha_e(:,:) + za1 * sshn_e (:,:) & 736 738 & + za2 * sshb_e(:,:) + za3 * sshbb_e(:,:) 739 737 740 IF( ln_wd ) THEN ! Calculating and applying W/D gravity filters 738 741 DO jj = 2, jpjm1 739 DO ji = 2, jpim1 740 ll_tmp1 = MIN( zsshp2_e(ji,jj), zsshp2_e(ji+1,jj) ) > MAX( -bathy(ji,jj), -bathy(ji+1,jj) ) & 741 & .AND. MAX( zsshp2_e(ji,jj) + bathy(ji,jj), zsshp2_e(ji+1,jj) + bathy(ji+1,jj) ) & 742 & > rn_wdmin1 + rn_wdmin2 743 ll_tmp2 = MAX( zsshp2_e(ji,jj), zsshp2_e(ji+1,jj) ) > MAX( -bathy(ji,jj), -bathy(ji+1,jj) ) & 744 & + rn_wdmin1 + rn_wdmin2 745 IF(ll_tmp1) THEN 746 zcpx(ji,jj) = 1._wp 747 ELSE IF(ll_tmp2) THEN 748 ! no worries about zsshp2_e(ji+1,jj)-zsshp2_e(ji,jj) = 0, it won't happen here 749 zcpx(ji,jj) = ABS( (zsshp2_e(ji+1,jj) + bathy(ji+1,jj) - zsshp2_e(ji,jj) - bathy(ji,jj)) & 750 & / (zsshp2_e(ji+1,jj) - zsshp2_e(ji,jj)) ) 751 ELSE 752 zcpx(ji,jj) = 0._wp 753 END IF 754 755 ll_tmp1 = MIN( zsshp2_e(ji,jj), zsshp2_e(ji,jj+1) ) > MAX( -bathy(ji,jj), -bathy(ji,jj+1) ) & 756 & .AND. MAX( zsshp2_e(ji,jj) + bathy(ji,jj), zsshp2_e(ji,jj+1) + bathy(ji,jj+1) ) & 757 & > rn_wdmin1 + rn_wdmin2 758 ll_tmp2 = MAX( zsshp2_e(ji,jj), zsshp2_e(ji,jj+1) ) > MAX( -bathy(ji,jj), -bathy(ji,jj+1) ) & 759 & + rn_wdmin1 + rn_wdmin2 760 IF(ll_tmp1) THEN 761 zcpy(ji,jj) = 1._wp 762 ELSE IF(ll_tmp2) THEN 763 ! no worries about zsshp2_e(ji,jj+1)-zsshp2_e(ji,jj) = 0, it won't happen here 764 zcpy(ji,jj) = ABS( (zsshp2_e(ji,jj+1) + bathy(ji,jj+1) - zsshp2_e(ji,jj) - bathy(ji,jj)) & 765 & / (zsshp2_e(ji,jj+1) - zsshp2_e(ji,jj)) ) 766 ELSE 767 zcpy(ji,jj) = 0._wp 768 END IF 742 DO ji = 2, jpim1 743 ll_tmp1 = MIN( zsshp2_e(ji,jj) , zsshp2_e(ji+1,jj) ) > & 744 & MAX( -bathy(ji,jj) , -bathy(ji+1,jj) ) .AND. & 745 & MAX( zsshp2_e(ji,jj) + bathy(ji,jj), zsshp2_e(ji+1,jj) + bathy(ji+1,jj) ) & 746 & > rn_wdmin1 + rn_wdmin2 747 ll_tmp2 = MAX( zsshp2_e(ji,jj) , zsshp2_e(ji+1,jj) ) > & 748 & MAX( -bathy(ji,jj) , -bathy(ji+1,jj) ) + rn_wdmin1 + rn_wdmin2 749 750 IF(ll_tmp1) THEN 751 zcpx(ji,jj) = 1.0_wp 752 ELSE IF(ll_tmp2) THEN 753 ! no worries about zsshp2_e(ji+1,jj) - zsshp2_e(ji ,jj) = 0, it won't happen ! here 754 zcpx(ji,jj) = ABS( (zsshp2_e(ji+1,jj) + bathy(ji+1,jj) - zsshp2_e(ji,jj) - bathy(ji,jj)) & 755 & / (zsshp2_e(ji+1,jj) - zsshp2_e(ji ,jj)) ) 756 ELSE 757 zcpx(ji,jj) = 0._wp 758 END IF 759 760 ll_tmp1 = MIN( zsshp2_e(ji,jj) , zsshp2_e(ji,jj+1) ) > & 761 & MAX( -bathy(ji,jj) , -bathy(ji,jj+1) ) .AND. & 762 & MAX( zsshp2_e(ji,jj) + bathy(ji,jj), zsshp2_e(ji,jj+1) + bathy(ji,jj+1) ) & 763 & > rn_wdmin1 + rn_wdmin2 764 ll_tmp2 = MAX( zsshp2_e(ji,jj) , zsshp2_e(ji,jj+1) ) > & 765 & MAX( -bathy(ji,jj) , -bathy(ji,jj+1) ) + rn_wdmin1 + rn_wdmin2 766 767 IF(ll_tmp1) THEN 768 zcpy(ji,jj) = 1.0_wp 769 ELSE IF(ll_tmp2) THEN 770 ! no worries about zsshp2_e(ji,jj+1) - zsshp2_e(ji,jj ) = 0, it won't happen ! here 771 zcpy(ji,jj) = ABS( (zsshp2_e(ji,jj+1) + bathy(ji,jj+1) - zsshp2_e(ji,jj) - bathy(ji,jj)) & 772 & / (zsshp2_e(ji,jj+1) - zsshp2_e(ji,jj )) ) 773 ELSE 774 zcpy(ji,jj) = 0._wp 775 END IF 769 776 END DO 770 771 END IF777 END DO 778 END IF 772 779 ! 773 780 ! Compute associated depths at U and V points:
Note: See TracChangeset
for help on using the changeset viewer.
