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 5602 for branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/LDF/ldfslp.F90 – NEMO

Ignore:
Timestamp:
2015-07-16T13:55:15+02:00 (9 years ago)
Author:
cbricaud
Message:

merge change from trunk rev 5003 to 5519 ( rev where branche 3.6_stable were created )

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/LDF/ldfslp.F90

    r5601 r5602  
    143143            DO jj = 1, jpjm1 
    144144               DO ji = 1, jpim1 
    145 ! IF should be useless check zpshde (PM) 
    146                IF ( mbku(ji,jj) > 1 ) zgru(ji,jj,mbku(ji,jj)) = gru(ji,jj) 
    147                IF ( mbkv(ji,jj) > 1 ) zgrv(ji,jj,mbkv(ji,jj)) = grv(ji,jj) 
     145                  zgru(ji,jj,mbku(ji,jj)) = gru(ji,jj) 
     146                  zgrv(ji,jj,mbkv(ji,jj)) = grv(ji,jj) 
     147               END DO 
     148            END DO 
     149         ENDIF 
     150         IF( ln_zps .AND. ln_isfcav ) THEN           ! partial steps correction at the bottom ocean level 
     151            DO jj = 1, jpjm1 
     152               DO ji = 1, jpim1 
    148153               IF ( miku(ji,jj) > 1 ) zgru(ji,jj,miku(ji,jj)) = grui(ji,jj)  
    149154               IF ( mikv(ji,jj) > 1 ) zgrv(ji,jj,mikv(ji,jj)) = grvi(ji,jj) 
     
    152157         ENDIF 
    153158         ! 
    154          zdzr(:,:,1) = 0._wp        !==   Local vertical density gradient at T-point   == !   (evaluated from N^2) 
    155          DO jk = 1, jpkm1 
     159         !==   Local vertical density gradient at T-point   == !   (evaluated from N^2) 
     160         ! interior value 
     161         DO jk = 2, jpkm1 
    156162            !                                ! zdzr = d/dz(prd)= - ( prd ) / grav * mk(pn2) -- at t point 
    157163            !                                !   trick: tmask(ik  )  = 0   =>   all pn2   = 0   =>   zdzr = 0 
     
    163169         END DO 
    164170         ! surface initialisation  
    165          DO jj = 1, jpjm1 
    166             DO ji = 1, jpim1 
    167               zdzr(ji,jj,1:mikt(ji,jj)) = 0._wp 
    168             END DO 
    169          END DO 
     171         zdzr(:,:,1) = 0._wp  
     172         IF ( ln_isfcav ) THEN 
     173            ! if isf need to overwrite the interior value at at the first ocean point 
     174            DO jj = 1, jpjm1 
     175               DO ji = 1, jpim1 
     176                  zdzr(ji,jj,1:mikt(ji,jj)) = 0._wp 
     177               END DO 
     178            END DO 
     179         END IF 
    170180         ! 
    171181         !                          !==   Slopes just below the mixed layer   ==! 
     
    176186         ! ===========================      | vslp = d/dj( prd ) / d/dz( prd ) 
    177187         ! 
    178          DO jj = 2, jpjm1 
    179             DO ji = fs_2, fs_jpim1   ! vector opt. 
    180                IF (miku(ji,jj) .GT. miku(ji+1,jj)) zhmlpu(ji,jj) = hmlpt(ji  ,jj) 
    181                IF (miku(ji,jj) .LT. miku(ji+1,jj)) zhmlpu(ji,jj) = hmlpt(ji+1,jj) 
    182                IF (miku(ji,jj) .EQ. miku(ji+1,jj)) zhmlpu(ji,jj) = MAX(hmlpt(ji  ,jj), hmlpt(ji+1,jj)) 
    183                IF (mikv(ji,jj) .GT. miku(ji,jj+1)) zhmlpv(ji,jj) = hmlpt(ji  ,jj) 
    184                IF (mikv(ji,jj) .LT. miku(ji,jj+1)) zhmlpv(ji,jj) = hmlpt(ji,jj+1) 
    185                IF (mikv(ji,jj) .EQ. miku(ji,jj+1)) zhmlpv(ji,jj) = MAX(hmlpt(ji,jj), hmlpt(ji,jj+1)) 
     188         IF ( ln_isfcav ) THEN 
     189            DO jj = 2, jpjm1 
     190               DO ji = fs_2, fs_jpim1   ! vector opt. 
     191                  IF (miku(ji,jj) .GT. miku(ji+1,jj)) zhmlpu(ji,jj) = MAX(hmlpt(ji  ,jj  ),                   5._wp) 
     192                  IF (miku(ji,jj) .LT. miku(ji+1,jj)) zhmlpu(ji,jj) = MAX(hmlpt(ji+1,jj  ),                   5._wp) 
     193                  IF (miku(ji,jj) .EQ. miku(ji+1,jj)) zhmlpu(ji,jj) = MAX(hmlpt(ji  ,jj  ), hmlpt(ji+1,jj  ), 5._wp) 
     194                  IF (mikv(ji,jj) .GT. miku(ji,jj+1)) zhmlpv(ji,jj) = MAX(hmlpt(ji  ,jj  ),                   5._wp) 
     195                  IF (mikv(ji,jj) .LT. miku(ji,jj+1)) zhmlpv(ji,jj) = MAX(hmlpt(ji  ,jj+1),                   5._wp) 
     196                  IF (mikv(ji,jj) .EQ. miku(ji,jj+1)) zhmlpv(ji,jj) = MAX(hmlpt(ji  ,jj  ), hmlpt(ji  ,jj+1), 5._wp) 
     197               ENDDO 
    186198            ENDDO 
    187          ENDDO 
     199         ELSE 
     200            DO jj = 2, jpjm1 
     201               DO ji = fs_2, fs_jpim1   ! vector opt. 
     202                  zhmlpu(ji,jj) = MAX(hmlpt(ji,jj), hmlpt(ji+1,jj  ), 5._wp) 
     203                  zhmlpv(ji,jj) = MAX(hmlpt(ji,jj), hmlpt(ji  ,jj+1), 5._wp) 
     204               ENDDO 
     205            ENDDO 
     206         END IF 
    188207         DO jk = 2, jpkm1                            !* Slopes at u and v points 
    189208            DO jj = 2, jpjm1 
     
    199218                  zbv = MIN(  zbv, -100._wp* ABS( zav ) , -7.e+3_wp/fse3v(ji,jj,jk)* ABS( zav )  ) 
    200219                  !                                      ! uslp and vslp output in zwz and zww, resp. 
    201                   zfi = MAX( omlmask(ji,jj,jk), omlmask(ji+1,jj,jk) )  
    202                   zfj = MAX( omlmask(ji,jj,jk), omlmask(ji,jj+1,jk) )  
     220                  zfi = MAX( omlmask(ji,jj,jk), omlmask(ji+1,jj  ,jk) ) 
     221                  zfj = MAX( omlmask(ji,jj,jk), omlmask(ji  ,jj+1,jk) ) 
    203222                  ! thickness of water column between surface and level k at u/v point 
    204                   zdepu = 0.5_wp * (( fsdept(ji,jj,jk) + fsdept(ji+1,jj  ,jk) )                   & 
    205                              - 2 * MAX( risfdep(ji,jj), risfdep(ji+1,jj  ) )  & 
    206                              - fse3u(ji,jj,miku(ji,jj))                                         ) 
    207                   zdepv = 0.5_wp * (( fsdept(ji,jj,jk) + fsdept(ji  ,jj+1,jk) )                   & 
    208                              - 2 * MAX( risfdep(ji,jj), risfdep(ji,jj+1) ) & 
    209                              - fse3v(ji,jj,mikv(ji,jj))                                         ) 
    210                   zwz(ji,jj,jk) = ( 1. - zfi) * zau / ( zbu - zeps )                                              & 
    211                      &                 + zfi  * uslpml(ji,jj)                                                     & 
    212                      &                        * zdepu / MAX( zhmlpu(ji,jj), 5._wp ) 
    213                   zwz(ji,jj,jk) = zwz(ji,jj,jk) * umask(ji,jj,jk) * umask(ji,jj,jk-1) 
    214                   zww(ji,jj,jk) = ( 1. - zfj) * zav / ( zbv - zeps )                                              & 
    215                      &                 + zfj  * vslpml(ji,jj)                                                     & 
    216                      &                        * zdepv / MAX( zhmlpv(ji,jj), 5._wp )  
    217                   zww(ji,jj,jk) = zww(ji,jj,jk) * vmask(ji,jj,jk) * vmask(ji,jj,jk-1) 
     223                  zdepu = 0.5_wp * ( ( fsdept(ji,jj,jk) + fsdept(ji+1,jj  ,jk) )                              & 
     224                                   - 2 * MAX( risfdep(ji,jj), risfdep(ji+1,jj  ) ) - fse3u(ji,jj,miku(ji,jj)) ) 
     225                  zdepv = 0.5_wp * ( ( fsdept(ji,jj,jk) + fsdept(ji  ,jj+1,jk) )                              & 
     226                                   - 2 * MAX( risfdep(ji,jj), risfdep(ji  ,jj+1) ) - fse3v(ji,jj,mikv(ji,jj)) ) 
     227                  ! 
     228                  zwz(ji,jj,jk) = ( 1. - zfi) * zau / ( zbu - zeps )                                          & 
     229                     &                 + zfi  * uslpml(ji,jj) * zdepu / zhmlpu(ji,jj) 
     230                  zwz(ji,jj,jk) = zwz(ji,jj,jk) * wumask(ji,jj,jk) 
     231                  zww(ji,jj,jk) = ( 1. - zfj) * zav / ( zbv - zeps )                                          & 
     232                     &                 + zfj  * vslpml(ji,jj) * zdepv / zhmlpv(ji,jj)  
     233                  zww(ji,jj,jk) = zww(ji,jj,jk) * wvmask(ji,jj,jk) 
    218234                   
    219235                  
     
    268284                  uslp(ji,jj,jk) = uslp(ji,jj,jk) * ( umask(ji,jj+1,jk) + umask(ji,jj-1,jk  ) ) * 0.5_wp   & 
    269285                     &                            * ( umask(ji,jj  ,jk) + umask(ji,jj  ,jk+1) ) * 0.5_wp   & 
    270                      &                            *   umask(ji,jj,jk-1) !* umask(ji,jj,jk) * umask(ji,jj,jk+1) 
     286                     &                            *   umask(ji,jj,jk-1) 
    271287                  vslp(ji,jj,jk) = vslp(ji,jj,jk) * ( vmask(ji+1,jj,jk) + vmask(ji-1,jj,jk  ) ) * 0.5_wp   & 
    272288                     &                            * ( vmask(ji  ,jj,jk) + vmask(ji  ,jj,jk+1) ) * 0.5_wp   & 
    273                      &                            *   vmask(ji,jj,jk-1) !* vmask(ji,jj,jk) * vmask(ji,jj,jk+1) 
     289                     &                            *   vmask(ji,jj,jk-1) 
    274290               END DO 
    275291            END DO 
     
    284300               DO ji = fs_2, fs_jpim1   ! vector opt. 
    285301                  !                                  !* Local vertical density gradient evaluated from N^2 
    286                   zbw = zm1_2g * pn2 (ji,jj,jk) * ( prd (ji,jj,jk) + prd (ji,jj,jk-1) + 2. ) * tmask(ji,jj,jk) * tmask(ji,jj,jk-1) 
     302                  zbw = zm1_2g * pn2 (ji,jj,jk) * ( prd (ji,jj,jk) + prd (ji,jj,jk-1) + 2. ) * wmask(ji,jj,jk) 
    287303                  !                                  !* Slopes at w point 
    288304                  !                                        ! i- & j-gradient of density at w-points 
     
    300316                  zbj = MIN( zbw , -100._wp* ABS( zaj ) , -7.e+3_wp/fse3w(ji,jj,jk)* ABS( zaj )  ) 
    301317                  !                                        ! wslpi and wslpj with ML flattening (output in zwz and zww, resp.) 
    302                   zfk = MAX( omlmask(ji,jj,jk), omlmask(ji,jj,jk-1) )    ! zfk=1 in the ML otherwise zfk=0 
     318                  zfk = MAX( omlmask(ji,jj,jk), omlmask(ji,jj,jk-1) )   ! zfk=1 in the ML otherwise zfk=0 
    303319                  zck = ( fsdepw(ji,jj,jk) - fsdepw(ji,jj,mikt(ji,jj) ) ) / MAX( hmlp(ji,jj), 10._wp ) 
    304320                  zwz(ji,jj,jk) = (  zai / ( zbi - zeps ) * ( 1._wp - zfk ) & 
    305                      &            + zck * wslpiml(ji,jj) * zfk  ) * tmask(ji,jj,jk) * tmask(ji,jj,jk-1) 
     321                     &            + zck * wslpiml(ji,jj) * zfk  ) * wmask(ji,jj,jk) 
    306322                  zww(ji,jj,jk) = (  zaj / ( zbj - zeps ) * ( 1._wp - zfk ) & 
    307                      &            + zck * wslpjml(ji,jj) * zfk  ) * tmask(ji,jj,jk) * tmask(ji,jj,jk-1) 
     323                     &            + zck * wslpjml(ji,jj) * zfk  ) * wmask(ji,jj,jk) 
    308324 
    309325!!gm  modif to suppress omlmask....  (as in Griffies operator) 
     
    358374                  zck =   ( umask(ji,jj,jk) + umask(ji-1,jj,jk) )   & 
    359375                     &  * ( vmask(ji,jj,jk) + vmask(ji,jj-1,jk) ) * 0.25 
    360                   wslpi(ji,jj,jk) = wslpi(ji,jj,jk) * zck * tmask(ji,jj,jk-1) * tmask(ji,jj,jk) 
    361                   wslpj(ji,jj,jk) = wslpj(ji,jj,jk) * zck * tmask(ji,jj,jk-1) * tmask(ji,jj,jk) 
     376                  wslpi(ji,jj,jk) = wslpi(ji,jj,jk) * zck * wmask(ji,jj,jk) 
     377                  wslpj(ji,jj,jk) = wslpj(ji,jj,jk) * zck * wmask(ji,jj,jk) 
    362378               END DO 
    363379            END DO 
     
    425441                  vslp(ji,jj,jk) = -1./e2v(ji,jj) * ( fsdept_b(ji,jj+1,jk) - fsdept_b(ji ,jj ,jk) ) * vmask(ji,jj,jk)  
    426442                  wslpi(ji,jj,jk) = -1./e1t(ji,jj) * ( fsdepw_b(ji+1,jj,jk) - fsdepw_b(ji-1,jj,jk) ) & 
    427                     &                              * tmask(ji,jj,jk) * tmask(ji,jj,jk-1) * 0.5  
     443                    &                              * wmask(ji,jj,jk) * 0.5  
    428444                  wslpj(ji,jj,jk) = -1./e2t(ji,jj) * ( fsdepw_b(ji,jj+1,jk) - fsdepw_b(ji,jj-1,jk) ) & 
    429                     &                              * tmask(ji,jj,jk) * tmask(ji,jj,jk-1) * 0.5  
     445                    &                              * wmask(ji,jj,jk) * 0.5  
    430446               END DO  
    431447            END DO  
     
    746762            DO ji = 1, jpi 
    747763               ik = nmln(ji,jj) - 1 
    748                IF( jk <= ik .AND. jk >= mikt(ji,jj) ) THEN   ;   omlmask(ji,jj,jk) = 1._wp 
    749                ELSE                  ;   omlmask(ji,jj,jk) = 0._wp 
     764               IF( jk <= ik .AND. jk >= mikt(ji,jj) ) THEN 
     765                  omlmask(ji,jj,jk) = 1._wp 
     766               ELSE 
     767                  omlmask(ji,jj,jk) = 0._wp 
    750768               ENDIF 
    751769            END DO 
     
    804822            zbj = MIN(  zbw , -100._wp* ABS( zaj ) , -7.e+3_wp/fse3w(ji,jj,ik)* ABS( zaj )  ) 
    805823            !                        !- i- & j-slope at w-points (wslpiml, wslpjml) 
    806             wslpiml(ji,jj) = zai / ( zbi - zeps ) * tmask (ji,jj,ik) 
    807             wslpjml(ji,jj) = zaj / ( zbj - zeps ) * tmask (ji,jj,ik) 
     824            wslpiml(ji,jj) = zai / ( zbi - zeps ) * wmask (ji,jj,ik) 
     825            wslpjml(ji,jj) = zaj / ( zbj - zeps ) * wmask (ji,jj,ik) 
    808826         END DO 
    809827      END DO 
     
    857875         wslpj(:,:,:) = 0._wp   ;   wslpjml(:,:) = 0._wp 
    858876 
    859          IF( ln_traldf_hor .OR. ln_dynldf_hor ) THEN 
     877         IF(ln_sco .AND.  (ln_traldf_hor .OR. ln_dynldf_hor )) THEN 
    860878            IF(lwp)   WRITE(numout,*) '          Horizontal mixing in s-coordinate: slope = slope of s-surfaces' 
    861879 
Note: See TracChangeset for help on using the changeset viewer.