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/dynspg_ts.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/dynspg_ts.F90

    r7016 r7157  
    373373      IF( .NOT.ln_linssh ) THEN                 ! Variable volume : remove surface pressure gradient 
    374374        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    
    382384                IF(ll_tmp1) THEN 
    383                   zcpx(ji,jj)    = 1.0_wp 
    384                 ELSEIF(ll_tmp2) THEN 
    385                    ! no worries about sshn(ji+1,jj)-sshn(ji,jj) = 0, it won't happen here 
    386                   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)) ) 
    388390                ELSE 
    389                   zcpx(ji,jj)    = 0._wp 
     391                  zcpx(ji,jj) = 0._wp 
    390392                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    
    397401                IF(ll_tmp1) THEN 
    398                    zcpy(ji,jj)    = 1.0_wp 
    399                 ELSEIF(ll_tmp2) THEN 
    400                    ! no worries about sshn(ji,jj+1)-sshn(ji,jj) = 0, it won't happen here 
    401                   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  )) ) 
    403407                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 
    408411           END DO 
    409  
    410  
     412  
    411413           DO jj = 2, jpjm1 
    412414              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) 
    417419              END DO 
    418420           END DO 
    … …  
    735737         zsshp2_e(:,:) = za0 *  ssha_e(:,:) + za1 *  sshn_e (:,:) & 
    736738          &            + za2 *  sshb_e(:,:) + za3 *  sshbb_e(:,:) 
     739 
    737740         IF( ln_wd ) THEN                   ! Calculating and applying W/D gravity filters 
    738741           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 
    769776              END DO 
    770             END DO 
    771          ENDIF 
     777           END DO 
     778         END IF 
    772779         ! 
    773780         ! Compute associated depths at U and V points: 
Note: See TracChangeset for help on using the changeset viewer.