- Timestamp:
- 2015-01-07T19:03:53+01:00 (9 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2015/dev_r4826_NOC_WAD/NEMOGCM/NEMO/OPA_SRC/DYN/dynhpg.F90
r4624 r5014 16 16 !! 3.4 ! 2011-11 (H. Liu) hpg_prj: Original code for s-coordinates 17 17 !! ! (A. Coward) suppression of hel, wdj and rot options 18 !! 3.6? ! 2014-09 (H. Liu) add Wetting/Drying pressure filter 18 19 !!---------------------------------------------------------------------- 19 20 … … 369 370 !! 370 371 INTEGER :: ji, jj, jk ! dummy loop indices 371 REAL(wp) :: zcoef0, zuap, zvap, znad ! temporary scalars 372 REAL(wp) :: zcoef0, zuap, zvap, znad, ztmp ! temporary scalars 373 LOGICAL :: ll_tmp1, ll_tmp2 ! local logical variables 372 374 REAL(wp), POINTER, DIMENSION(:,:,:) :: zhpi, zhpj 375 REAL(wp), POINTER, DIMENSION(:,:) :: zcpx, zcpy !W/D pressure filter 373 376 !!---------------------------------------------------------------------- 374 377 ! 375 378 CALL wrk_alloc( jpi,jpj,jpk, zhpi, zhpj ) 379 IF(ln_wd) CALL wrk_alloc( jpi,jpj, zcpx, zcpy ) 376 380 ! 377 381 IF( kt == nit000 ) THEN … … 386 390 IF ( lk_vvl ) THEN ; znad = 1._wp ! Variable volume 387 391 ELSE ; znad = 0._wp ! Fixed volume 392 ENDIF 393 394 IF(ln_wd) THEN 395 DO jj = 2, jpjm1 396 DO ji = 2, jpim1 397 ll_tmp1 = MIN(sshn(ji,jj), sshn(ji+1,jj)) > MAX(-bathy(ji,jj), -bathy(ji+1,jj)) 398 ll_tmp2 = MAX(sshn(ji,jj), sshn(ji+1,jj)) > MAX(-bathy(ji,jj), -bathy(ji+1,jj)) +& 399 & rn_wdmin1 + rn_wdmin2 400 401 IF(ll_tmp1) THEN 402 zcpx(ji,jj) = 1.0_wp 403 ELSE IF(ll_tmp2) THEN 404 ! no worries about sshn(ji+1,jj)-sshn(ji,jj) = 0, it won't happen ! here 405 zcpx(ji,jj) = ABS((sshn(ji+1,jj) + bathy(ji+1,jj) - sshn(ji,jj) - bathy(ji,jj)) /& 406 & (sshn(ji+1,jj) - sshn(ji,jj))) 407 ELSE 408 zcpx(ji,jj) = 0._wp 409 END IF 410 411 ll_tmp1 = MIN(sshn(ji,jj), sshn(ji,jj+1)) > MAX(-bathy(ji,jj), -bathy(ji,jj+1)) 412 ll_tmp2 = MAX(sshn(ji,jj), sshn(ji,jj+1)) > MAX(-bathy(ji,jj), -bathy(ji,jj+1)) +& 413 & rn_wdmin1 + rn_wdmin2 414 415 IF(ll_tmp1) THEN 416 zcpy(ji,jj) = 1.0_wp 417 ELSE IF(ll_tmp2) THEN 418 ! no worries about sshn(ji,jj+1)-sshn(ji,jj) = 0, it won't happen ! here 419 zcpy(ji,jj) = ABS((sshn(ji,jj+1) + bathy(ji,jj+1) - sshn(ji,jj) - bathy(ji,jj)) /& 420 & (sshn(ji,jj+1) - sshn(ji,jj))) 421 ELSE 422 zcpy(ji,jj) = 0._wp 423 END IF 424 END DO 425 END DO 426 CALL lbc_lnk( zcpx, 'U', 1._wp ) ; CALL lbc_lnk( zcpy, 'V', 1._wp ) 388 427 ENDIF 389 428 … … 401 440 zvap = -zcoef0 * ( rhd (ji,jj+1,1) + rhd (ji,jj,1) + 2._wp * znad ) & 402 441 & * ( fsde3w(ji,jj+1,1) - fsde3w(ji,jj,1) ) / e2v(ji,jj) 442 443 IF(ln_wd) THEN 444 zhpi(ji,jj,1) = zhpi(ji,jj,1) * zcpx(ji,jj) 445 zhpj(ji,jj,1) = zhpj(ji,jj,1) * zcpy(ji,jj) 446 zuap = zuap * zcpx(ji,jj) 447 zvap = zvap * zcpy(ji,jj) 448 ENDIF 449 403 450 ! add to the general momentum trend 404 451 ua(ji,jj,1) = ua(ji,jj,1) + zhpi(ji,jj,1) + zuap … … 423 470 zvap = -zcoef0 * ( rhd (ji ,jj+1,jk) + rhd (ji,jj,jk) + 2._wp * znad ) & 424 471 & * ( fsde3w(ji ,jj+1,jk) - fsde3w(ji,jj,jk) ) / e2v(ji,jj) 472 473 IF(ln_wd) THEN 474 zhpi(ji,jj,jk) = zhpi(ji,jj,jk) * zcpx(ji,jj) 475 zhpj(ji,jj,jk) = zhpj(ji,jj,jk) * zcpy(ji,jj) 476 zuap = zuap * zcpx(ji,jj) 477 zvap = zvap * zcpy(ji,jj) 478 ENDIF 479 425 480 ! add to the general momentum trend 426 481 ua(ji,jj,jk) = ua(ji,jj,jk) + zhpi(ji,jj,jk) + zuap … … 431 486 ! 432 487 CALL wrk_dealloc( jpi,jpj,jpk, zhpi, zhpj ) 488 IF(ln_wd) CALL wrk_dealloc( jpi,jpj, zcpx, zcpy ) 433 489 ! 434 490 END SUBROUTINE hpg_sco … … 448 504 REAL(wp) :: z1_10, cffu, cffx ! " " 449 505 REAL(wp) :: z1_12, cffv, cffy ! " " 506 LOGICAL :: ll_tmp1, ll_tmp2 ! local logical variables 450 507 REAL(wp), POINTER, DIMENSION(:,:,:) :: zhpi, zhpj 451 508 REAL(wp), POINTER, DIMENSION(:,:,:) :: dzx, dzy, dzz, dzu, dzv, dzw 452 509 REAL(wp), POINTER, DIMENSION(:,:,:) :: drhox, drhoy, drhoz, drhou, drhov, drhow 453 510 REAL(wp), POINTER, DIMENSION(:,:,:) :: rho_i, rho_j, rho_k 511 REAL(wp), POINTER, DIMENSION(:,:) :: zcpx, zcpy !W/D pressure filter 454 512 !!---------------------------------------------------------------------- 455 513 ! … … 457 515 CALL wrk_alloc( jpi, jpj, jpk, drhox, drhoy, drhoz, drhou, drhov, drhow ) 458 516 CALL wrk_alloc( jpi, jpj, jpk, rho_i, rho_j, rho_k, zhpi, zhpj ) 459 ! 517 IF(ln_wd) CALL wrk_alloc( jpi,jpj, zcpx, zcpy ) 518 ! 519 !!---------------------------------------------------------------------- 520 ! 521 ! 522 IF(ln_wd) THEN 523 DO jj = 2, jpjm1 524 DO ji = 2, jpim1 525 ll_tmp1 = MIN(sshn(ji,jj), sshn(ji+1,jj)) > MAX(-bathy(ji,jj), -bathy(ji+1,jj)) 526 ll_tmp2 = MAX(sshn(ji,jj), sshn(ji+1,jj)) > MAX(-bathy(ji,jj), -bathy(ji+1,jj)) +& 527 & rn_wdmin1 + rn_wdmin2 528 529 IF(ll_tmp1) THEN 530 zcpx(ji,jj) = 1.0_wp 531 ELSE IF(ll_tmp2) THEN 532 ! no worries about sshn(ji+1,jj)-sshn(ji,jj) = 0, it won't happen ! here 533 zcpx(ji,jj) = ABS((sshn(ji+1,jj) + bathy(ji+1,jj) - sshn(ji,jj) - bathy(ji,jj)) /& 534 & (sshn(ji+1,jj) - sshn(ji,jj))) 535 ELSE 536 zcpx(ji,jj) = 0._wp 537 END IF 538 539 ll_tmp1 = MIN(sshn(ji,jj), sshn(ji,jj+1)) > MAX(-bathy(ji,jj), -bathy(ji,jj+1)) 540 ll_tmp2 = MAX(sshn(ji,jj), sshn(ji,jj+1)) > MAX(-bathy(ji,jj), -bathy(ji,jj+1)) +& 541 & rn_wdmin1 + rn_wdmin2 542 543 IF(ll_tmp1) THEN 544 zcpy(ji,jj) = 1.0_wp 545 ELSE IF(ll_tmp2) THEN 546 ! no worries about sshn(ji,jj+1)-sshn(ji,jj) = 0, it won't happen ! here 547 zcpy(ji,jj) = ABS((sshn(ji,jj+1) + bathy(ji,jj+1) - sshn(ji,jj) - bathy(ji,jj)) /& 548 & (sshn(ji,jj+1) - sshn(ji,jj))) 549 ELSE 550 zcpy(ji,jj) = 0._wp 551 END IF 552 END DO 553 END DO 554 CALL lbc_lnk( zcpx, 'U', 1._wp ) ; CALL lbc_lnk( zcpy, 'V', 1._wp ) 555 ENDIF 556 460 557 461 558 IF( kt == nit000 ) THEN … … 628 725 zhpi(ji,jj,1) = ( rho_k(ji+1,jj ,1) - rho_k(ji,jj,1) - rho_i(ji,jj,1) ) / e1u(ji,jj) 629 726 zhpj(ji,jj,1) = ( rho_k(ji ,jj+1,1) - rho_k(ji,jj,1) - rho_j(ji,jj,1) ) / e2v(ji,jj) 727 IF(ln_wd) THEN 728 zhpi(ji,jj,1) = zhpi(ji,jj,1) * zcpx(ji,jj) 729 zhpj(ji,jj,1) = zhpj(ji,jj,1) * zcpy(ji,jj) 730 ENDIF 630 731 ! add to the general momentum trend 631 732 ua(ji,jj,1) = ua(ji,jj,1) + zhpi(ji,jj,1) … … 647 748 & + ( ( rho_k(ji,jj+1,jk) - rho_k(ji,jj,jk ) ) & 648 749 & -( rho_j(ji,jj ,jk) - rho_j(ji,jj,jk-1) ) ) / e2v(ji,jj) 750 IF(ln_wd) THEN 751 zhpi(ji,jj,jk) = zhpi(ji,jj,jk) * zcpx(ji,jj) 752 zhpj(ji,jj,jk) = zhpj(ji,jj,jk) * zcpy(ji,jj) 753 ENDIF 649 754 ! add to the general momentum trend 650 755 ua(ji,jj,jk) = ua(ji,jj,jk) + zhpi(ji,jj,jk) … … 657 762 CALL wrk_dealloc( jpi, jpj, jpk, drhox, drhoy, drhoz, drhou, drhov, drhow ) 658 763 CALL wrk_dealloc( jpi, jpj, jpk, rho_i, rho_j, rho_k, zhpi, zhpj ) 764 IF(ln_wd) CALL wrk_dealloc( jpi,jpj, zcpx, zcpy ) 659 765 ! 660 766 END SUBROUTINE hpg_djc … … 682 788 !! The local variables for the correction term 683 789 INTEGER :: jk1, jis, jid, jjs, jjd 790 LOGICAL :: ll_tmp1, ll_tmp2 ! local logical variables 684 791 REAL(wp) :: zuijk, zvijk, zpwes, zpwed, zpnss, zpnsd, zdeps 685 792 REAL(wp) :: zrhdt1 … … 687 794 REAL(wp), POINTER, DIMENSION(:,:,:) :: zdept, zrhh 688 795 REAL(wp), POINTER, DIMENSION(:,:,:) :: zhpi, zu, zv, fsp, xsp, asp, bsp, csp, dsp 689 !!---------------------------------------------------------------------- 796 REAL(wp), POINTER, DIMENSION(:,:) :: zcpx, zcpy !W/D pressure filter 797 !!---------------------------------------------------------------------- 798 ! 690 799 ! 691 800 CALL wrk_alloc( jpi,jpj,jpk, zhpi, zu, zv, fsp, xsp, asp, bsp, csp, dsp ) 692 801 CALL wrk_alloc( jpi,jpj,jpk, zdept, zrhh ) 802 IF(ln_wd) CALL wrk_alloc( jpi,jpj, zcpx, zcpy ) 693 803 ! 694 804 IF( kt == nit000 ) THEN … … 703 813 znad = 0.0_wp 704 814 IF( lk_vvl ) znad = 1._wp 815 816 IF(ln_wd) THEN 817 DO jj = 2, jpjm1 818 DO ji = 2, jpim1 819 ll_tmp1 = MIN(sshn(ji,jj), sshn(ji+1,jj)) > MAX(-bathy(ji,jj), -bathy(ji+1,jj)) 820 ll_tmp2 = MAX(sshn(ji,jj), sshn(ji+1,jj)) > MAX(-bathy(ji,jj), -bathy(ji+1,jj)) +& 821 & rn_wdmin1 + rn_wdmin2 822 823 IF(ll_tmp1) THEN 824 zcpx(ji,jj) = 1.0_wp 825 ELSE IF(ll_tmp2) THEN 826 ! no worries about sshn(ji+1,jj)-sshn(ji,jj) = 0, it won't happen ! here 827 zcpx(ji,jj) = ABS((sshn(ji+1,jj) + bathy(ji+1,jj) - sshn(ji,jj) - bathy(ji,jj)) /& 828 & (sshn(ji+1,jj) - sshn(ji,jj))) 829 ELSE 830 zcpx(ji,jj) = 0._wp 831 END IF 832 833 ll_tmp1 = MIN(sshn(ji,jj), sshn(ji,jj+1)) > MAX(-bathy(ji,jj), -bathy(ji,jj+1)) 834 ll_tmp2 = MAX(sshn(ji,jj), sshn(ji,jj+1)) > MAX(-bathy(ji,jj), -bathy(ji,jj+1)) +& 835 & rn_wdmin1 + rn_wdmin2 836 837 IF(ll_tmp1.OR.ll_tmp2) THEN 838 zcpy(ji,jj) = 1.0_wp 839 ELSE IF(ll_tmp2) THEN 840 ! no worries about sshn(ji,jj+1)-sshn(ji,jj) = 0, it won't happen ! here 841 zcpy(ji,jj) = ABS((sshn(ji,jj+1) + bathy(ji,jj+1) - sshn(ji,jj) - bathy(ji,jj)) /& 842 & (sshn(ji,jj+1) - sshn(ji,jj))) 843 ELSE 844 zcpy(ji,jj) = 0._wp 845 END IF 846 END DO 847 END DO 848 CALL lbc_lnk( zcpx, 'U', 1._wp ) ; CALL lbc_lnk( zcpy, 'V', 1._wp ) 849 ENDIF 705 850 706 851 ! Clean 3-D work arrays … … 862 1007 ENDIF 863 1008 864 ua(ji,jj,jk) = ua(ji,jj,jk) + (zdpdx1 + zdpdx2) * & 865 & umask(ji,jj,jk) * tmask(ji,jj,jk) * tmask(ji+1,jj,jk) 1009 IF(ln_wd) THEN 1010 zdpdx1 = zdpdx1 * zcpx(ji,jj) 1011 zdpdx2 = zdpdx2 * zcpx(ji,jj) 1012 ENDIF 1013 ua(ji,jj,jk) = ua(ji,jj,jk) + (zdpdx1 + zdpdx2) * umask(ji,jj,jk) 866 1014 ENDIF 867 1015 … … 919 1067 ENDIF 920 1068 921 va(ji,jj,jk) = va(ji,jj,jk) + (zdpdy1 + zdpdy2)*& 922 & vmask(ji,jj,jk)*tmask(ji,jj,jk)*tmask(ji,jj+1,jk) 1069 IF(ln_wd) THEN 1070 zdpdy1 = zdpdy1 * zcpy(ji,jj) 1071 zdpdy2 = zdpdy2 * zcpy(ji,jj) 1072 ENDIF 1073 1074 va(ji,jj,jk) = va(ji,jj,jk) + (zdpdy1 + zdpdy2) * vmask(ji,jj,jk) 923 1075 ENDIF 924 1076 … … 930 1082 CALL wrk_dealloc( jpi,jpj,jpk, zhpi, zu, zv, fsp, xsp, asp, bsp, csp, dsp ) 931 1083 CALL wrk_dealloc( jpi,jpj,jpk, zdept, zrhh ) 1084 IF(ln_wd) CALL wrk_dealloc( jpi,jpj, zcpx, zcpy ) 932 1085 ! 933 1086 END SUBROUTINE hpg_prj
Note: See TracChangeset
for help on using the changeset viewer.
