- Timestamp:
- 2017-12-13T18:08:50+01:00 (6 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/DYN/dynhpg.F90
r9019 r9023 422 422 !!---------------------------------------------------------------------- 423 423 ! 424 IF( ln_wd_il ) CALL wrk_alloc( jpi,jpj, zcpx, zcpy ) 425 ! 424 426 IF( kt == nit000 ) THEN 425 427 IF(lwp) WRITE(numout,*) … … 433 435 ENDIF 434 436 ! 435 IF( ln_wd ) THEN 436 ALLOCATE( zcpx(jpi,jpj) , zcpy(jpi,jpj) ) 437 DO jj = 2, jpjm1 438 DO ji = 2, jpim1 439 ll_tmp1 = MIN( sshn(ji,jj) , sshn(ji+1,jj) ) > & 440 & MAX( -ht_wd(ji,jj) , -ht_wd(ji+1,jj) ) .AND. & 441 & MAX( sshn(ji,jj) + ht_wd(ji,jj), sshn(ji+1,jj) + ht_wd(ji+1,jj) ) & 442 & > rn_wdmin1 + rn_wdmin2 443 ll_tmp2 = ( ABS( sshn(ji,jj) - sshn(ji+1,jj) ) > 1.E-12 ) .AND. ( & 444 & MAX( sshn(ji,jj) , sshn(ji+1,jj) ) > & 445 & MAX( -ht_wd(ji,jj) , -ht_wd(ji+1,jj) ) + rn_wdmin1 + rn_wdmin2 ) 446 447 IF(ll_tmp1) THEN 448 zcpx(ji,jj) = 1.0_wp 449 ELSE IF(ll_tmp2) THEN 450 ! no worries about sshn(ji+1,jj) - sshn(ji ,jj) = 0, it won't happen ! here 451 zcpx(ji,jj) = ABS( ( sshn(ji+1,jj)+ht_wd(ji+1,jj) - sshn(ji,jj)-ht_wd(ji,jj) ) & 452 & / ( sshn(ji+1,jj) - sshn(ji,jj) ) ) 453 ELSE 454 zcpx(ji,jj) = 0._wp 455 ENDIF 456 ! 457 ll_tmp1 = MIN( sshn(ji,jj) , sshn(ji,jj+1) ) > & 458 & MAX( -ht_wd(ji,jj) , -ht_wd(ji,jj+1) ) .AND. & 459 & MAX( sshn(ji,jj) + ht_wd(ji,jj), sshn(ji,jj+1) + ht_wd(ji,jj+1) ) & 460 & > rn_wdmin1 + rn_wdmin2 461 ll_tmp2 = ( ABS( sshn(ji,jj) - sshn(ji,jj+1) ) > 1.E-12 ) .AND. ( & 462 & MAX( sshn(ji,jj) , sshn(ji,jj+1) ) > & 463 & MAX( -ht_wd(ji,jj) , -ht_wd(ji,jj+1) ) + rn_wdmin1 + rn_wdmin2 ) 437 IF( ln_wd_il ) THEN 438 DO jj = 2, jpjm1 439 DO ji = 2, jpim1 440 ll_tmp1 = MIN( sshn(ji,jj) , sshn(ji+1,jj) ) > & 441 & MAX( -ht_0(ji,jj) , -ht_0(ji+1,jj) ) .AND. & 442 & MAX( sshn(ji,jj) + ht_0(ji,jj), sshn(ji+1,jj) + ht_0(ji+1,jj) ) & 443 & > rn_wdmin1 + rn_wdmin2 444 ll_tmp2 = ( ABS( sshn(ji,jj) - sshn(ji+1,jj) ) > 1.E-12 ) .AND. ( & 445 & MAX( sshn(ji,jj) , sshn(ji+1,jj) ) > & 446 & MAX( -ht_0(ji,jj) , -ht_0(ji+1,jj) ) + rn_wdmin1 + rn_wdmin2 ) 447 448 IF(ll_tmp1) THEN 449 zcpx(ji,jj) = 1.0_wp 450 ELSE IF(ll_tmp2) THEN 451 ! no worries about sshn(ji+1,jj) - sshn(ji ,jj) = 0, it won't happen ! here 452 zcpx(ji,jj) = ABS( (sshn(ji+1,jj) + ht_0(ji+1,jj) - sshn(ji,jj) - ht_0(ji,jj)) & 453 & / (sshn(ji+1,jj) - sshn(ji ,jj)) ) 454 ELSE 455 zcpx(ji,jj) = 0._wp 456 END IF 457 458 ll_tmp1 = MIN( sshn(ji,jj) , sshn(ji,jj+1) ) > & 459 & MAX( -ht_0(ji,jj) , -ht_0(ji,jj+1) ) .AND. & 460 & MAX( sshn(ji,jj) + ht_0(ji,jj), sshn(ji,jj+1) + ht_0(ji,jj+1) ) & 461 & > rn_wdmin1 + rn_wdmin2 462 ll_tmp2 = ( ABS( sshn(ji,jj) - sshn(ji,jj+1) ) > 1.E-12 ) .AND. ( & 463 & MAX( sshn(ji,jj) , sshn(ji,jj+1) ) > & 464 & MAX( -ht_0(ji,jj) , -ht_0(ji,jj+1) ) + rn_wdmin1 + rn_wdmin2 ) 464 465 ! 465 466 IF(ll_tmp1) THEN … … 476 477 CALL lbc_lnk( zcpx, 'U', 1._wp ) ; CALL lbc_lnk( zcpy, 'V', 1._wp ) 477 478 ENDIF 479 480 IF(ll_tmp1) THEN 481 zcpy(ji,jj) = 1.0_wp 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) + ht_0(ji,jj+1) - sshn(ji,jj) - ht_0(ji,jj)) & 485 & / (sshn(ji,jj+1) - sshn(ji,jj )) ) 486 ELSE 487 zcpy(ji,jj) = 0._wp 488 END IF 489 END DO 490 END DO 491 CALL lbc_lnk( zcpx, 'U', 1._wp ) ; CALL lbc_lnk( zcpy, 'V', 1._wp ) 492 END IF 478 493 479 494 ! Surface value … … 491 506 & * ( gde3w_n(ji,jj+1,1) - gde3w_n(ji,jj,1) ) * r1_e2v(ji,jj) 492 507 ! 493 IF( ln_wd ) THEN508 IF( ln_wd_il ) THEN 494 509 zhpi(ji,jj,1) = zhpi(ji,jj,1) * zcpx(ji,jj) 495 510 zhpj(ji,jj,1) = zhpj(ji,jj,1) * zcpy(ji,jj) … … 521 536 & * ( gde3w_n(ji ,jj+1,jk) - gde3w_n(ji,jj,jk) ) * r1_e2v(ji,jj) 522 537 ! 523 IF( ln_wd ) THEN538 IF( ln_wd_il ) THEN 524 539 zhpi(ji,jj,jk) = zhpi(ji,jj,jk) * zcpx(ji,jj) 525 540 zhpj(ji,jj,jk) = zhpj(ji,jj,jk) * zcpy(ji,jj) … … 535 550 END DO 536 551 ! 537 IF( ln_wd ) DEALLOCATE( zcpx , zcpy )552 IF( ln_wd_il ) DEALLOCATE( zcpx , zcpy ) 538 553 ! 539 554 END SUBROUTINE hpg_sco … … 667 682 !!---------------------------------------------------------------------- 668 683 ! 669 IF( ln_wd ) THEN684 IF( ln_wd_il ) THEN 670 685 ALLOCATE( zcpx(jpi,jpj) , zcpy(jpi,jpj) ) 671 DO jj = 2, jpjm1 672 DO ji = 2, jpim1 673 ll_tmp1 = MIN( sshn(ji,jj) , sshn(ji+1,jj) ) > & 674 & MAX( -ht_wd(ji,jj) , -ht_wd(ji+1,jj) ) .AND. & 675 & MAX( sshn(ji,jj) + ht_wd(ji,jj), sshn(ji+1,jj) + ht_wd(ji+1,jj) ) & 676 & > rn_wdmin1 + rn_wdmin2 677 ll_tmp2 = ( ABS( sshn(ji,jj) - sshn(ji+1,jj) ) > 1.E-12 ) .AND. ( & 678 & MAX( sshn(ji,jj) , sshn(ji+1,jj) ) > & 679 & MAX( -ht_wd(ji,jj) , -ht_wd(ji+1,jj) ) + rn_wdmin1 + rn_wdmin2 ) 680 681 IF(ll_tmp1) THEN 682 zcpx(ji,jj) = 1.0_wp 683 ELSE IF(ll_tmp2) THEN 684 ! no worries about sshn(ji+1,jj) - sshn(ji ,jj) = 0, it won't happen ! here 685 zcpx(ji,jj) = ABS( (sshn(ji+1,jj) + ht_wd(ji+1,jj) - sshn(ji,jj) - ht_wd(ji,jj)) & 686 & / (sshn(ji+1,jj) - sshn(ji ,jj)) ) 687 ELSE 688 zcpx(ji,jj) = 0._wp 689 ENDIF 686 DO jj = 2, jpjm1 687 DO ji = 2, jpim1 688 ll_tmp1 = MIN( sshn(ji,jj) , sshn(ji+1,jj) ) > & 689 & MAX( -ht_0(ji,jj) , -ht_0(ji+1,jj) ) .AND. & 690 & MAX( sshn(ji,jj) + ht_0(ji,jj), sshn(ji+1,jj) + ht_0(ji+1,jj) ) & 691 & > rn_wdmin1 + rn_wdmin2 692 ll_tmp2 = ( ABS( sshn(ji,jj) - sshn(ji+1,jj) ) > 1.E-12 ) .AND. ( & 693 & MAX( sshn(ji,jj) , sshn(ji+1,jj) ) > & 694 & MAX( -ht_0(ji,jj) , -ht_0(ji+1,jj) ) + rn_wdmin1 + rn_wdmin2 ) 695 IF(ll_tmp1) THEN 696 zcpx(ji,jj) = 1.0_wp 697 ELSE IF(ll_tmp2) THEN 698 ! no worries about sshn(ji+1,jj) - sshn(ji ,jj) = 0, it won't happen ! here 699 zcpx(ji,jj) = ABS( (sshn(ji+1,jj) + ht_0(ji+1,jj) - sshn(ji,jj) - ht_0(ji,jj)) & 700 & / (sshn(ji+1,jj) - sshn(ji ,jj)) ) 701 ELSE 702 zcpx(ji,jj) = 0._wp 703 END IF 690 704 691 ll_tmp1 = MIN( sshn(ji,jj) ,sshn(ji,jj+1) ) > &692 & MAX( -ht_ wd(ji,jj) , -ht_wd(ji,jj+1) ) .AND. &693 & MAX( sshn(ji,jj) + ht_wd(ji,jj), sshn(ji,jj+1) + ht_wd(ji,jj+1) )&694 & 695 ll_tmp2 = ( ABS( sshn(ji,jj) - sshn(ji,jj+1) ) > 1.E-12 ) .AND. (&696 & MAX( sshn(ji,jj) ,sshn(ji,jj+1) ) > &697 & MAX( -ht_wd(ji,jj) , -ht_wd(ji,jj+1) ) + rn_wdmin1 + rn_wdmin2 )698 699 700 701 702 703 zcpy(ji,jj) = ABS( (sshn(ji,jj+1) + ht_wd(ji,jj+1) - sshn(ji,jj) - ht_wd(ji,jj)) &704 & / (sshn(ji,jj+1) -sshn(ji,jj )) )705 706 707 ENDIF708 709 710 711 END IF705 ll_tmp1 = MIN( sshn(ji,jj) , sshn(ji,jj+1) ) > & 706 & MAX( -ht_0(ji,jj) , -ht_0(ji,jj+1) ) .AND. & 707 & MAX( sshn(ji,jj) + ht_0(ji,jj), sshn(ji,jj+1) + ht_0(ji,jj+1) ) & 708 & > rn_wdmin1 + rn_wdmin2 709 ll_tmp2 = ( ABS( sshn(ji,jj) - sshn(ji,jj+1) ) > 1.E-12 ) .AND. ( & 710 & MAX( sshn(ji,jj) , sshn(ji,jj+1) ) > & 711 & MAX( -ht_0(ji,jj) , -ht_0(ji,jj+1) ) + rn_wdmin1 + rn_wdmin2 ) 712 713 IF(ll_tmp1) THEN 714 zcpy(ji,jj) = 1.0_wp 715 ELSE IF(ll_tmp2) THEN 716 ! no worries about sshn(ji,jj+1) - sshn(ji,jj ) = 0, it won't happen ! here 717 zcpy(ji,jj) = ABS( (sshn(ji,jj+1) + ht_0(ji,jj+1) - sshn(ji,jj) - ht_0(ji,jj)) & 718 & / (sshn(ji,jj+1) - sshn(ji,jj )) ) 719 ELSE 720 zcpy(ji,jj) = 0._wp 721 END IF 722 END DO 723 END DO 724 CALL lbc_lnk( zcpx, 'U', 1._wp ) ; CALL lbc_lnk( zcpy, 'V', 1._wp ) 725 END IF 712 726 713 727 IF( kt == nit000 ) THEN … … 880 894 zhpi(ji,jj,1) = ( rho_k(ji+1,jj ,1) - rho_k(ji,jj,1) - rho_i(ji,jj,1) ) * r1_e1u(ji,jj) 881 895 zhpj(ji,jj,1) = ( rho_k(ji ,jj+1,1) - rho_k(ji,jj,1) - rho_j(ji,jj,1) ) * r1_e2v(ji,jj) 882 IF( ln_wd ) THEN896 IF( ln_wd_il ) THEN 883 897 zhpi(ji,jj,1) = zhpi(ji,jj,1) * zcpx(ji,jj) 884 898 zhpj(ji,jj,1) = zhpj(ji,jj,1) * zcpy(ji,jj) … … 903 917 & + ( ( rho_k(ji,jj+1,jk) - rho_k(ji,jj,jk ) ) & 904 918 & -( rho_j(ji,jj ,jk) - rho_j(ji,jj,jk-1) ) ) * r1_e2v(ji,jj) 905 IF( ln_wd ) THEN919 IF( ln_wd_il ) THEN 906 920 zhpi(ji,jj,jk) = zhpi(ji,jj,jk) * zcpx(ji,jj) 907 921 zhpj(ji,jj,jk) = zhpj(ji,jj,jk) * zcpy(ji,jj) … … 914 928 END DO 915 929 ! 916 IF( ln_wd ) DEALLOCATE( zcpx, zcpy )930 IF( ln_wd_il ) DEALLOCATE( zcpx, zcpy ) 917 931 ! 918 932 END SUBROUTINE hpg_djc … … 959 973 IF( ln_linssh ) znad = 0._wp 960 974 961 IF( ln_wd ) THEN975 IF( ln_wd_il ) THEN 962 976 ALLOCATE( zcpx(jpi,jpj) , zcpy(jpi,jpj) ) 963 977 DO jj = 2, jpjm1 964 DO ji = 2, jpim1 965 ll_tmp1 = MIN( sshn(ji,jj) , sshn(ji+1,jj) ) > & 966 & MAX( -ht_wd(ji,jj) , -ht_wd(ji+1,jj) ) .AND. & 967 & MAX( sshn(ji,jj) + ht_wd(ji,jj), sshn(ji+1,jj) + ht_wd(ji+1,jj) ) & 968 & > rn_wdmin1 + rn_wdmin2 969 ll_tmp2 = ( ABS( sshn(ji,jj) - sshn(ji+1,jj) ) > 1.E-12 ) .AND. ( & 970 & MAX( sshn(ji,jj) , sshn(ji+1,jj) ) > & 971 & MAX( -ht_wd(ji,jj) , -ht_wd(ji+1,jj) ) + rn_wdmin1 + rn_wdmin2 ) 972 973 IF(ll_tmp1) THEN 974 zcpx(ji,jj) = 1.0_wp 975 ELSE IF(ll_tmp2) THEN 976 ! no worries about sshn(ji+1,jj) - sshn(ji ,jj) = 0, it won't happen ! here 977 zcpx(ji,jj) = ABS( (sshn(ji+1,jj) + ht_wd(ji+1,jj) - sshn(ji,jj) - ht_wd(ji,jj)) & 978 & / (sshn(ji+1,jj) - sshn(ji ,jj)) ) 979 ELSE 980 zcpx(ji,jj) = 0._wp 981 ENDIF 978 DO ji = 2, jpim1 979 ll_tmp1 = MIN( sshn(ji,jj) , sshn(ji+1,jj) ) > & 980 & MAX( -ht_0(ji,jj) , -ht_0(ji+1,jj) ) .AND. & 981 & MAX( sshn(ji,jj) + ht_0(ji,jj), sshn(ji+1,jj) + ht_0(ji+1,jj) ) & 982 & > rn_wdmin1 + rn_wdmin2 983 ll_tmp2 = ( ABS( sshn(ji,jj) - sshn(ji+1,jj) ) > 1.E-12 ) .AND. ( & 984 & MAX( sshn(ji,jj) , sshn(ji+1,jj) ) > & 985 & MAX( -ht_0(ji,jj) , -ht_0(ji+1,jj) ) + rn_wdmin1 + rn_wdmin2 ) 986 987 IF(ll_tmp1) THEN 988 zcpx(ji,jj) = 1.0_wp 989 ELSE IF(ll_tmp2) THEN 990 ! no worries about sshn(ji+1,jj) - sshn(ji ,jj) = 0, it won't happen ! here 991 zcpx(ji,jj) = ABS( (sshn(ji+1,jj) + ht_0(ji+1,jj) - sshn(ji,jj) - ht_0(ji,jj)) & 992 & / (sshn(ji+1,jj) - sshn(ji ,jj)) ) 993 994 zcpx(ji,jj) = max(min( zcpx(ji,jj) , 1.0_wp),0.0_wp) 995 ELSE 996 zcpx(ji,jj) = 0._wp 997 END IF 982 998 983 ll_tmp1 = MIN( sshn(ji,jj) , sshn(ji,jj+1) ) > & 984 & MAX( -ht_wd(ji,jj) , -ht_wd(ji,jj+1) ) .AND. & 985 & MAX( sshn(ji,jj) + ht_wd(ji,jj), sshn(ji,jj+1) + ht_wd(ji,jj+1) ) & 986 & > rn_wdmin1 + rn_wdmin2 987 ll_tmp2 = ( ABS( sshn(ji,jj) - sshn(ji,jj+1) ) > 1.E-12 ) .AND. ( & 988 & MAX( sshn(ji,jj) , sshn(ji,jj+1) ) > & 989 & MAX( -ht_wd(ji,jj) , -ht_wd(ji,jj+1) ) + rn_wdmin1 + rn_wdmin2 ) 990 991 IF(ll_tmp1) THEN 992 zcpy(ji,jj) = 1.0_wp 993 ELSE IF(ll_tmp2) THEN 994 ! no worries about sshn(ji,jj+1) - sshn(ji,jj ) = 0, it won't happen ! here 995 zcpy(ji,jj) = ABS( (sshn(ji,jj+1) + ht_wd(ji,jj+1) - sshn(ji,jj) - ht_wd(ji,jj)) & 996 & / (sshn(ji,jj+1) - sshn(ji,jj )) ) 999 ll_tmp1 = MIN( sshn(ji,jj) , sshn(ji,jj+1) ) > & 1000 & MAX( -ht_0(ji,jj) , -ht_0(ji,jj+1) ) .AND. & 1001 & MAX( sshn(ji,jj) + ht_0(ji,jj), sshn(ji,jj+1) + ht_0(ji,jj+1) ) & 1002 & > rn_wdmin1 + rn_wdmin2 1003 ll_tmp2 = ( ABS( sshn(ji,jj) - sshn(ji,jj+1) ) > 1.E-12 ) .AND. ( & 1004 & MAX( sshn(ji,jj) , sshn(ji,jj+1) ) > & 1005 & MAX( -ht_0(ji,jj) , -ht_0(ji,jj+1) ) + rn_wdmin1 + rn_wdmin2 ) 1006 1007 IF(ll_tmp1) THEN 1008 zcpy(ji,jj) = 1.0_wp 1009 ELSE IF(ll_tmp2) THEN 1010 ! no worries about sshn(ji,jj+1) - sshn(ji,jj ) = 0, it won't happen ! here 1011 zcpy(ji,jj) = ABS( (sshn(ji,jj+1) + ht_0(ji,jj+1) - sshn(ji,jj) - ht_0(ji,jj)) & 1012 & / (sshn(ji,jj+1) - sshn(ji,jj )) ) 1013 zcpy(ji,jj) = max(min( zcpy(ji,jj) , 1.0_wp),0.0_wp) 1014 997 1015 ELSE 998 1016 zcpy(ji,jj) = 0._wp … … 1185 1203 zdpdx2 = zcoef0 * r1_e1u(ji,jj) * REAL(jis-jid, wp) * (zpwes + zpwed) 1186 1204 ENDIF 1187 IF( ln_wd ) THEN1188 zdpdx1 = zdpdx1 * zcpx(ji,jj) 1189 zdpdx2 = zdpdx2 * zcpx(ji,jj) 1205 IF( ln_wd_il ) THEN 1206 zdpdx1 = zdpdx1 * zcpx(ji,jj) * wdrampu(ji,jj) 1207 zdpdx2 = zdpdx2 * zcpx(ji,jj) * wdrampu(ji,jj) 1190 1208 ENDIF 1191 1209 ua(ji,jj,jk) = ua(ji,jj,jk) + (zdpdx1 + zdpdx2) * umask(ji,jj,jk) … … 1244 1262 zdpdy2 = zcoef0 * r1_e2v(ji,jj) * REAL(jjs-jjd, wp) * (zpnss + zpnsd ) 1245 1263 ENDIF 1246 IF( ln_wd ) THEN1247 zdpdy1 = zdpdy1 * zcpy(ji,jj) 1248 zdpdy2 = zdpdy2 * zcpy(ji,jj) 1264 IF( ln_wd_il ) THEN 1265 zdpdy1 = zdpdy1 * zcpy(ji,jj) * wdrampv(ji,jj) 1266 zdpdy2 = zdpdy2 * zcpy(ji,jj) * wdrampv(ji,jj) 1249 1267 ENDIF 1250 1268 … … 1256 1274 END DO 1257 1275 ! 1258 IF( ln_wd ) DEALLOCATE( zcpx, zcpy )1276 IF( ln_wd_il ) DEALLOCATE( zcpx, zcpy ) 1259 1277 ! 1260 1278 END SUBROUTINE hpg_prj
Note: See TracChangeset
for help on using the changeset viewer.
