New URL for NEMO forge!   http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
Changeset 7157 for branches/2016/dev_r6393_NOC_WAD/NEMOGCM/NEMO/OPA_SRC/DYN/dynhpg.F90 – NEMO

Ignore:
Timestamp:
2016-10-28T15:47:10+02:00 (8 years ago)
Author:
acc
Message:

Branch dev_r6393_NOC_WAD. Tidied up and made code-consistent calculation of zcpx and zcpy factors (ln_wd). Also made bug correction in dynspg_ts phase 1 (zu_trd)

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/2016/dev_r6393_NOC_WAD/NEMOGCM/NEMO/OPA_SRC/DYN/dynhpg.F90

    r7030 r7157  
    432432      INTEGER  ::   ji, jj, jk, jii, jjj                 ! dummy loop indices 
    433433      REAL(wp) ::   zcoef0, zuap, zvap, znad, ztmp       ! temporary scalars 
    434       LOGICAL  ::   ll_tmp1, ll_tmp2, ll_tmp3            ! local logical variables 
     434      LOGICAL  ::   ll_tmp1, ll_tmp2                     ! local logical variables 
    435435      REAL(wp), POINTER, DIMENSION(:,:,:) ::  zhpi, zhpj 
    436436      REAL(wp), POINTER, DIMENSION(:,:)   ::  zcpx, zcpy !W/D pressure filter 
     
    438438      ! 
    439439      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 ) 
    441441      ! 
    442442      IF( kt == nit000 ) THEN 
     
    451451      ENDIF 
    452452      ! 
    453       IF(ln_wd) THEN 
     453      IF( ln_wd ) THEN 
    454454        DO jj = 2, jpjm1 
    455455           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 
    462464               zcpx(ji,jj) = 1.0_wp 
    463              ELSE IF(ll_tmp3) THEN 
    464                ! no worries about sshn(ji+1,jj)-sshn(ji,jj) = 0, it won't happen ! here 
    465                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)) ) 
    467469             ELSE 
    468470               zcpx(ji,jj) = 0._wp 
    469471             END IF 
    470472       
    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 
    477481               zcpy(ji,jj) = 1.0_wp 
    478              ELSE IF(ll_tmp3) THEN 
    479                ! no worries about sshn(ji,jj+1)-sshn(ji,jj) = 0, it won't happen ! here 
    480                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  )) ) 
    482486             ELSE 
    483487               zcpy(ji,jj) = 0._wp 
     
    486490        END DO 
    487491        CALL lbc_lnk( zcpx, 'U', 1._wp )    ;   CALL lbc_lnk( zcpy, 'V', 1._wp ) 
    488       ENDIF 
    489  
     492      END IF 
    490493 
    491494      ! Surface value 
     
    504507 
    505508 
    506             IF(ln_wd) THEN 
     509            IF( ln_wd ) THEN 
    507510 
    508511              zhpi(ji,jj,1) = zhpi(ji,jj,1) * zcpx(ji,jj) 
     
    535538                  &           * ( gde3w_n(ji  ,jj+1,jk) - gde3w_n(ji,jj,jk) ) * r1_e2v(ji,jj) 
    536539 
    537                IF(ln_wd) THEN 
     540               IF( ln_wd ) THEN 
    538541                 zhpi(ji,jj,jk) = zhpi(ji,jj,jk) * zcpx(ji,jj) 
    539542                 zhpj(ji,jj,jk) = zhpj(ji,jj,jk) * zcpy(ji,jj)  
     
    550553      ! 
    551554      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 ) 
    553556      ! 
    554557   END SUBROUTINE hpg_sco 
     
    695698      CALL wrk_alloc( jpi, jpj, jpk, drhox, drhoy, drhoz, drhou, drhov, drhow ) 
    696699      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) THEN 
     700      IF( ln_wd ) CALL wrk_alloc( jpi,jpj, zcpx, zcpy ) 
     701      ! 
     702      ! 
     703      IF( ln_wd ) THEN 
    701704        DO jj = 2, jpjm1 
    702705           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 
    708712 
    709713             IF(ll_tmp1) THEN 
    710714               zcpx(ji,jj) = 1.0_wp 
    711715             ELSE IF(ll_tmp2) THEN 
    712                ! no worries about sshn(ji+1,jj)-sshn(ji,jj) = 0, it won't happen ! here 
    713                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)) ) 
    715719             ELSE 
    716720               zcpx(ji,jj) = 0._wp 
    717721             END IF 
    718722       
    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 
    724729 
    725730             IF(ll_tmp1) THEN 
    726731               zcpy(ji,jj) = 1.0_wp 
    727732             ELSE IF(ll_tmp2) THEN 
    728                ! no worries about sshn(ji,jj+1)-sshn(ji,jj) = 0, it won't happen ! here 
    729                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  )) ) 
    731736             ELSE 
    732737               zcpy(ji,jj) = 0._wp 
     
    735740        END DO 
    736741        CALL lbc_lnk( zcpx, 'U', 1._wp )    ;   CALL lbc_lnk( zcpy, 'V', 1._wp ) 
    737       ENDIF 
    738  
     742      END IF 
    739743 
    740744      IF( kt == nit000 ) THEN 
     
    907911            zhpi(ji,jj,1) = ( rho_k(ji+1,jj  ,1) - rho_k(ji,jj,1) - rho_i(ji,jj,1) ) * r1_e1u(ji,jj) 
    908912            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) THEN 
     913            IF( ln_wd ) THEN 
    910914              zhpi(ji,jj,1) = zhpi(ji,jj,1) * zcpx(ji,jj) 
    911915              zhpj(ji,jj,1) = zhpj(ji,jj,1) * zcpy(ji,jj)  
     
    930934                  &           + (  ( rho_k(ji,jj+1,jk) - rho_k(ji,jj,jk  ) )    & 
    931935                  &               -( rho_j(ji,jj  ,jk) - rho_j(ji,jj,jk-1) )  ) * r1_e2v(ji,jj) 
    932                IF(ln_wd) THEN 
     936               IF( ln_wd ) THEN 
    933937                 zhpi(ji,jj,jk) = zhpi(ji,jj,jk) * zcpx(ji,jj) 
    934938                 zhpj(ji,jj,jk) = zhpj(ji,jj,jk) * zcpy(ji,jj)  
     
    944948      CALL wrk_dealloc( jpi, jpj, jpk, drhox, drhoy, drhoz, drhou, drhov, drhow ) 
    945949      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 ) 
    947951      ! 
    948952   END SUBROUTINE hpg_djc 
     
    981985      CALL wrk_alloc( jpi,jpj,jpk,   zdept, zrhh ) 
    982986      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 ) 
    984988      ! 
    985989      IF( kt == nit000 ) THEN 
     
    994998      IF( ln_linssh )   znad = 0._wp 
    995999 
    996       IF(ln_wd) THEN 
     1000      IF( ln_wd ) THEN 
    9971001        DO jj = 2, jpjm1 
    9981002           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 
    10041009 
    10051010             IF(ll_tmp1) THEN 
    10061011               zcpx(ji,jj) = 1.0_wp 
    10071012             ELSE IF(ll_tmp2) THEN 
    1008                ! no worries about sshn(ji+1,jj)-sshn(ji,jj) = 0, it won't happen ! here 
    1009                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)) ) 
    10111016             ELSE 
    10121017               zcpx(ji,jj) = 0._wp 
    10131018             END IF 
    10141019       
    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 
    10221028               zcpy(ji,jj) = 1.0_wp 
    10231029             ELSE IF(ll_tmp2) THEN 
    1024                ! no worries about sshn(ji,jj+1)-sshn(ji,jj) = 0, it won't happen ! here 
    1025                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  )) ) 
    10271033             ELSE 
    10281034               zcpy(ji,jj) = 0._wp 
     
    10311037        END DO 
    10321038        CALL lbc_lnk( zcpx, 'U', 1._wp )    ;   CALL lbc_lnk( zcpy, 'V', 1._wp ) 
    1033       ENDIF 
     1039      END IF 
    10341040 
    10351041      ! Clean 3-D work arrays 
     
    12151221                 zdpdx2 = zcoef0 * r1_e1u(ji,jj) * REAL(jis-jid, wp) * (zpwes + zpwed) 
    12161222               ENDIF 
    1217                IF(ln_wd) THEN 
     1223               IF( ln_wd ) THEN 
    12181224                  zdpdx1 = zdpdx1 * zcpx(ji,jj) 
    12191225                  zdpdx2 = zdpdx2 * zcpx(ji,jj) 
     
    12741280                  zdpdy2 = zcoef0 * r1_e2v(ji,jj) * REAL(jjs-jjd, wp) * (zpnss + zpnsd ) 
    12751281               ENDIF 
    1276                IF(ln_wd) THEN 
     1282               IF( ln_wd ) THEN 
    12771283                  zdpdy1 = zdpdy1 * zcpy(ji,jj) 
    12781284                  zdpdy2 = zdpdy2 * zcpy(ji,jj) 
     
    12891295      CALL wrk_dealloc( jpi,jpj,jpk,   zdept, zrhh ) 
    12901296      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 ) 
    12921298      ! 
    12931299   END SUBROUTINE hpg_prj 
Note: See TracChangeset for help on using the changeset viewer.