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 13077 for NEMO/branches/2020/r4.0-HEAD_ticket2425/src/OCE/SBC/sbccpl.F90 – NEMO

Ignore:
Timestamp:
2020-06-09T17:00:38+02:00 (4 years ago)
Author:
davestorkey
Message:

branches/2020/r4.0-HEAD_ticket2425: update to r13076 of r4.0-HEAD

File:
1 edited

Legend:

Unmodified
Added
Removed
  • NEMO/branches/2020/r4.0-HEAD_ticket2425/src/OCE/SBC/sbccpl.F90

    r12288 r13077  
    14821482      INTEGER ::   ji, jj   ! dummy loop indices 
    14831483      INTEGER ::   itx      ! index of taux over ice 
     1484      REAL(wp)                     ::   zztmp1, zztmp2 
    14841485      REAL(wp), DIMENSION(jpi,jpj) ::   ztx, zty  
    14851486      !!---------------------------------------------------------------------- 
     
    15451546            p_taui(:,:) = frcv(jpr_itx1)%z3(:,:,1)                   ! (U,V) ==> (U,V) 
    15461547            p_tauj(:,:) = frcv(jpr_ity1)%z3(:,:,1) 
    1547          CASE( 'F' ) 
    1548             DO jj = 2, jpjm1                                   ! F ==> (U,V) 
    1549                DO ji = fs_2, fs_jpim1   ! vector opt. 
    1550                   p_taui(ji,jj) = 0.5 * ( frcv(jpr_itx1)%z3(ji,jj,1) + frcv(jpr_itx1)%z3(ji  ,jj-1,1) ) 
    1551                   p_tauj(ji,jj) = 0.5 * ( frcv(jpr_ity1)%z3(ji,jj,1) + frcv(jpr_ity1)%z3(ji-1,jj  ,1) ) 
    1552                END DO 
    1553             END DO 
    15541548         CASE( 'T' ) 
    15551549            DO jj = 2, jpjm1                                   ! T ==> (U,V) 
    15561550               DO ji = fs_2, fs_jpim1   ! vector opt. 
    1557                   p_taui(ji,jj) = 0.5 * ( frcv(jpr_itx1)%z3(ji+1,jj  ,1) + frcv(jpr_itx1)%z3(ji,jj,1) ) 
    1558                   p_tauj(ji,jj) = 0.5 * ( frcv(jpr_ity1)%z3(ji  ,jj+1,1) + frcv(jpr_ity1)%z3(ji,jj,1) ) 
     1551                  ! take care of the land-sea mask to avoid "pollution" of coastal stress. p[uv]taui used in frazil and  rheology  
     1552                  zztmp1 = 0.5_wp * ( 2. - umask(ji,jj,1) ) * MAX( tmask(ji,jj,1),tmask(ji+1,jj  ,1) ) 
     1553                  zztmp2 = 0.5_wp * ( 2. - vmask(ji,jj,1) ) * MAX( tmask(ji,jj,1),tmask(ji  ,jj+1,1) ) 
     1554                  p_taui(ji,jj) = zztmp1 * ( frcv(jpr_itx1)%z3(ji+1,jj  ,1) + frcv(jpr_itx1)%z3(ji,jj,1) ) 
     1555                  p_tauj(ji,jj) = zztmp2 * ( frcv(jpr_ity1)%z3(ji  ,jj+1,1) + frcv(jpr_ity1)%z3(ji,jj,1) ) 
    15591556               END DO 
    15601557            END DO 
    1561          CASE( 'I' ) 
    1562             DO jj = 2, jpjm1                                   ! I ==> (U,V) 
    1563                DO ji = 2, jpim1   ! NO vector opt. 
    1564                   p_taui(ji,jj) = 0.5 * ( frcv(jpr_itx1)%z3(ji+1,jj+1,1) + frcv(jpr_itx1)%z3(ji+1,jj  ,1) ) 
    1565                   p_tauj(ji,jj) = 0.5 * ( frcv(jpr_ity1)%z3(ji+1,jj+1,1) + frcv(jpr_ity1)%z3(ji  ,jj+1,1) ) 
    1566                END DO 
    1567             END DO 
     1558            CALL lbc_lnk_multi( 'sbccpl', p_taui, 'U',  -1., p_tauj, 'V',  -1. ) 
    15681559         END SELECT 
    1569          IF( srcv(jpr_itx1)%clgrid /= 'U' ) THEN  
    1570             CALL lbc_lnk_multi( 'sbccpl', p_taui, 'U',  -1., p_tauj, 'V',  -1. ) 
    1571          ENDIF 
    15721560          
    15731561      ENDIF 
     
    17981786            ENDDO 
    17991787         ELSE 
    1800             qns_tot(:,:) = qns_tot(:,:) + picefr(:,:) * frcv(jpr_qnsice)%z3(:,:,1) 
     1788            zqns_tot(:,:) = zqns_tot(:,:) + picefr(:,:) * frcv(jpr_qnsice)%z3(:,:,1) 
    18011789            DO jl = 1, jpl 
    1802                zqns_tot(:,:   ) = zqns_tot(:,:) + picefr(:,:) * frcv(jpr_qnsice)%z3(:,:,1) 
    18031790               zqns_ice(:,:,jl) = frcv(jpr_qnsice)%z3(:,:,1) 
    18041791            END DO 
     
    19391926            END DO 
    19401927         ELSE 
    1941             qsr_tot(:,:   ) = qsr_tot(:,:) + picefr(:,:) * frcv(jpr_qsrice)%z3(:,:,1) 
     1928            zqsr_tot(:,:) = zqsr_tot(:,:) + picefr(:,:) * frcv(jpr_qsrice)%z3(:,:,1) 
    19421929            DO jl = 1, jpl 
    1943                zqsr_tot(:,:   ) = zqsr_tot(:,:) + picefr(:,:) * frcv(jpr_qsrice)%z3(:,:,1) 
    19441930               zqsr_ice(:,:,jl) = frcv(jpr_qsrice)%z3(:,:,1) 
    19451931            END DO 
Note: See TracChangeset for help on using the changeset viewer.