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 6225 for branches/2014/dev_r4704_NOC5_MPP_BDY_UPDATE/NEMOGCM/NEMO/LIM_SRC_3/limadv.F90 – NEMO

Ignore:
Timestamp:
2016-01-08T10:35:19+01:00 (8 years ago)
Author:
jamesharle
Message:

Update MPP_BDY_UPDATE branch to be consistent with head of trunk

File:
1 edited

Legend:

Unmodified
Added
Removed

  • branches/2014/dev_r4704_NOC5_MPP_BDY_UPDATE/NEMOGCM/NEMO/LIM_SRC_3/limadv.F90

    r4688 r6225  
    3030   PUBLIC   lim_adv_x   ! called by lim_trp 
    3131   PUBLIC   lim_adv_y   ! called by lim_trp 
    32  
    33    REAL(wp)  ::   epsi20 = 1.e-20_wp   ! constant values 
    3432 
    3533   !! * Substitutions 
    … …  
    6563      !!  
    6664      INTEGER  ::   ji, jj                               ! dummy loop indices 
    67       REAL(wp) ::   zs1max, zrdt, zslpmax, ztemp, zin0   ! local scalars 
     65      REAL(wp) ::   zs1max, zrdt, zslpmax, ztemp         ! local scalars 
    6866      REAL(wp) ::   zs1new, zalf , zalfq , zbt           !   -      - 
    6967      REAL(wp) ::   zs2new, zalf1, zalf1q, zbt1          !   -      - 
    … …  
    8785            zs2new  = MIN(  2.0 * zslpmax - 0.3334 * ABS( zs1new ),      & 
    8886               &            MAX( ABS( zs1new ) - zslpmax, psxx(ji,jj) )  ) 
    89             zin0    = ( 1.0 - MAX( 0._wp, SIGN( 1._wp, -zslpmax) ) ) * tms(ji,jj)   ! Case of empty boxes & Apply mask 
     87            rswitch = ( 1.0 - MAX( 0._wp, SIGN( 1._wp, -zslpmax) ) ) * tmask(ji,jj,1)   ! Case of empty boxes & Apply mask 
    9088 
    9189            ps0 (ji,jj) = zslpmax   
    92             psx (ji,jj) = zs1new      * zin0 
    93             psxx(ji,jj) = zs2new      * zin0 
    94             psy (ji,jj) = psy (ji,jj) * zin0 
    95             psyy(ji,jj) = psyy(ji,jj) * zin0 
    96             psxy(ji,jj) = MIN( zslpmax, MAX( -zslpmax, psxy(ji,jj) ) ) * zin0 
     90            psx (ji,jj) = zs1new      * rswitch 
     91            psxx(ji,jj) = zs2new      * rswitch 
     92            psy (ji,jj) = psy (ji,jj) * rswitch 
     93            psyy(ji,jj) = psyy(ji,jj) * rswitch 
     94            psxy(ji,jj) = MIN( zslpmax, MAX( -zslpmax, psxy(ji,jj) ) ) * rswitch 
    9795         END DO 
    9896      END DO 
    9997 
    10098      !  Initialize volumes of boxes  (=area if adv_x first called, =psm otherwise)                                      
    101       psm (:,:)  = MAX( pcrh * area(:,:) + ( 1.0 - pcrh ) * psm(:,:) , epsi20 ) 
     99      psm (:,:)  = MAX( pcrh * e1e2t(:,:) + ( 1.0 - pcrh ) * psm(:,:) , epsi20 ) 
    102100 
    103101      !  Calculate fluxes and moments between boxes i<-->i+1               
    … …  
    209207 
    210208      !-- Lateral boundary conditions 
    211       CALL lbc_lnk( psm , 'T',  1. )   ;   CALL lbc_lnk( ps0 , 'T',  1. ) 
    212       CALL lbc_lnk( psx , 'T', -1. )   ;   CALL lbc_lnk( psy , 'T', -1. )      ! caution gradient ==> the sign changes 
    213       CALL lbc_lnk( psxx, 'T',  1. )   ;   CALL lbc_lnk( psyy, 'T',  1. ) 
    214       CALL lbc_lnk( psxy, 'T',  1. ) 
     209      CALL lbc_lnk_multi( psm , 'T',  1., ps0 , 'T',  1.   & 
     210         &              , psx , 'T', -1., psy , 'T', -1.   &   ! caution gradient ==> the sign changes 
     211         &              , psxx, 'T',  1., psyy, 'T',  1.   & 
     212         &              , psxy, 'T',  1. ) 
    215213 
    216214      IF(ln_ctl) THEN 
    … …  
    250248      !! 
    251249      INTEGER  ::   ji, jj                               ! dummy loop indices 
    252       REAL(wp) ::   zs1max, zrdt, zslpmax, ztemp, zin0   ! temporary scalars 
     250      REAL(wp) ::   zs1max, zrdt, zslpmax, ztemp         ! temporary scalars 
    253251      REAL(wp) ::   zs1new, zalf , zalfq , zbt           !    -         - 
    254252      REAL(wp) ::   zs2new, zalf1, zalf1q, zbt1          !    -         - 
    … …  
    272270            zs2new  = MIN(  ( 2.0 * zslpmax - 0.3334 * ABS( zs1new ) ),   & 
    273271               &             MAX( ABS( zs1new )-zslpmax, psyy(ji,jj) )  ) 
    274             zin0    = ( 1.0 - MAX( 0._wp, SIGN( 1._wp, -zslpmax) ) ) * tms(ji,jj)   ! Case of empty boxes & Apply mask 
     272            rswitch = ( 1.0 - MAX( 0._wp, SIGN( 1._wp, -zslpmax) ) ) * tmask(ji,jj,1)   ! Case of empty boxes & Apply mask 
    275273            ! 
    276274            ps0 (ji,jj) = zslpmax   
    277             psx (ji,jj) = psx (ji,jj) * zin0 
    278             psxx(ji,jj) = psxx(ji,jj) * zin0 
    279             psy (ji,jj) = zs1new * zin0 
    280             psyy(ji,jj) = zs2new * zin0 
    281             psxy(ji,jj) = MIN( zslpmax, MAX( -zslpmax, psxy(ji,jj) ) ) * zin0 
     275            psx (ji,jj) = psx (ji,jj) * rswitch 
     276            psxx(ji,jj) = psxx(ji,jj) * rswitch 
     277            psy (ji,jj) = zs1new * rswitch 
     278            psyy(ji,jj) = zs2new * rswitch 
     279            psxy(ji,jj) = MIN( zslpmax, MAX( -zslpmax, psxy(ji,jj) ) ) * rswitch 
    282280         END DO 
    283281      END DO 
    284282 
    285283      !  Initialize volumes of boxes (=area if adv_x first called, =psm otherwise) 
    286       psm(:,:)  = MAX(  pcrh * area(:,:) + ( 1.0 - pcrh ) * psm(:,:) , epsi20  ) 
     284      psm(:,:)  = MAX(  pcrh * e1e2t(:,:) + ( 1.0 - pcrh ) * psm(:,:) , epsi20  ) 
    287285 
    288286      !  Calculate fluxes and moments between boxes j<-->j+1               
    … …  
    395393 
    396394      !-- Lateral boundary conditions 
    397       CALL lbc_lnk( psm , 'T',  1. )   ;   CALL lbc_lnk( ps0 , 'T',  1. ) 
    398       CALL lbc_lnk( psx , 'T', -1. )   ;   CALL lbc_lnk( psy , 'T', -1. )      ! caution gradient ==> the sign changes 
    399       CALL lbc_lnk( psxx, 'T',  1. )   ;   CALL lbc_lnk( psyy, 'T',  1. ) 
    400       CALL lbc_lnk( psxy, 'T',  1. ) 
     395      CALL lbc_lnk_multi( psm , 'T',  1.,  ps0 , 'T',  1.   & 
     396         &              , psx , 'T', -1.,  psy , 'T', -1.   &   ! caution gradient ==> the sign changes 
     397         &              , psxx, 'T',  1.,  psyy, 'T',  1.   & 
     398         &              , psxy, 'T',  1. ) 
    401399 
    402400      IF(ln_ctl) THEN 
Note: See TracChangeset for help on using the changeset viewer.