SUBROUTINE SHALCV(IM,IX,KM,DT,DEL,PRSI,PRSL,PRSLK,KUO,Q,T,levshc
     &,                 phil, kinver, ctei_r, ctei_rm, lprnt, ipr)
!
      USE MACHINE , ONLY : kind_phys
      USE PHYSCONS, grav => con_g, CP => con_CP, HVAP => con_HVAP
     &,             RD => con_RD
      implicit none
!
      logical lprnt
      integer ipr
      integer              IM, IX, KM, KUO(IM), kinver(im), levshc(im)
      real(kind=kind_phys) DEL(IX,KM),   PRSI(IX,KM+1), PRSL(IX,KM),
     &                     PRSLK(IX,KM), phil(ix,km),
     &                     Q(IX,KM),     T(IX,KM),      DT
     &,                    ctei_r(im),   ctei_rm
!
!     Locals
!
      real(kind=kind_phys) ck,    cpdt,   dmse,   dsdz1, dsdz2,
     &                     dsig,  dtodsl, dtodsu, eldq,  g,
     &                     gocp,  rtdls
!
      integer              k,k1,k2,kliftl,kliftu,kt,N2,I,iku,ik1,ik,ii
      integer              INDEX2(IM), KLCL(IM), KBOT(IM), KTOP(IM),kk
     &,                    KTOPM(IM)
!
      PARAMETER(G=GRAV, GOCP=G/CP)       !  PHYSICAL PARAMETERS
      PARAMETER(KLIFTL=2,KLIFTU=2)       !  BOUNDS OF PARCEL ORIGIN
      LOGICAL   LSHC(IM)
      real(kind=kind_phys) Q2(IM*KM),     T2(IM*KM),
     &                     PRSL2(IM*KM),  PRSLK2(IM*KM),
     &                     AL(IM*(KM-1)), AD(IM*KM), AU(IM*(KM-1))
!-----------------------------------------------------------------------
!  COMPRESS FIELDS TO POINTS WITH NO DEEP CONVECTION
!  AND MOIST STATIC INSTABILITY.
      DO I=1,IM
        LSHC(I)=.FALSE.
      ENDDO
      DO K=1,KM-1
        DO I=1,IM
          IF(KUO(I).EQ.0) THEN
            ELDQ    = HVAP*(Q(I,K)-Q(I,K+1))
            CPDT    = CP*(T(I,K)-T(I,K+1))
            DMSE    = ELDQ + CPDT + phil(i,k) - phil(i,k+1)
            LSHC(I) = LSHC(I).OR.DMSE.GT.0.
          ENDIF
        ENDDO
      ENDDO
      N2 = 0
      DO I=1,IM
        IF(LSHC(I)) THEN
          N2         = N2 + 1
          INDEX2(N2) = I
        ENDIF
      ENDDO
!     if (lprnt) print *,' in shalcnv N2=',n2,' ipr=',ipr,' im=',im
      IF(N2.EQ.0) RETURN
      DO K=1,KM
        KK = (K-1)*N2
        DO I=1,N2
          IK         = KK + I
          ii         = index2(i)
          Q2(IK)     = Q(II,K)
          T2(IK)     = T(II,K)
          PRSL2(IK)  = PRSL(II,K)
          PRSLK2(IK) = PRSLK(II,K)
        ENDDO
      ENDDO
!
      do i=1,N2
        ii         = index2(i)
        ktopm(i)   = levshc(ii)
!       if (ctei_r(ii) < ctei_rm) then
!         ktopm(i)  = min(ktopm(i),kinver(ii))
!       endif
!       if (lprnt .and. ii == ipr) print *,' ktopm=',ktopm(i)
!    &                                    ,' kinver=',kinver(ii)
      enddo
!-----------------------------------------------------------------------
!  COMPUTE MOIST ADIABAT AND DETERMINE LIMITS OF SHALLOW CONVECTION.
!  CHECK FOR MOIST STATIC INSTABILITY AGAIN WITHIN CLOUD.
      CALL MSTADBTN(N2,KM-1,KLIFTL,KLIFTU,PRSL2,PRSLK2,T2,Q2,
     &            KLCL,KBOT,KTOP,AL,AU,ktopm,lprnt,ipr,index2)
!    &            KLCL,KBOT,KTOP,AL,AU)
      DO I=1,N2
!       if (lprnt .and. index2(i) == ipr) print *,' kbotb=',kbot(i)
!    &,                                           ' ktopb=',ktop(i)
        if (ktop(i) > kbot(i)) then
          KBOT(I) = min(KLCL(I)-1, ktopm(i)-1)
!         KTOP(I) = min(KTOP(I)+1, ktopm(i))
!!!!      KTOP(I) = min(KTOP(I), ktopm(i))
          if (ctei_r(index2(i)) >= ctei_rm) then
            KTOP(I) = min(KTOP(I)+1, ktopm(i))
          else
            KTOP(I) = min(KTOP(I), ktopm(i))
          endif
        endif
        LSHC(I) = .FALSE.
!       if (lprnt .and. index2(i) == ipr) print *,' kbot=',kbot(i)
!    &,                                           ' ktop=',ktop(i)
      ENDDO
      DO K=1,KM-1
        KK = (K-1)*N2
        DO I=1,N2
          IF(K.GE.KBOT(I).AND.K.LT.KTOP(I)) THEN
            IK      = KK + I
            IKU     = IK + N2
            ELDQ    = HVAP * (Q2(IK)-Q2(IKU))
            CPDT    = CP   * (T2(IK)-T2(IKU))
!           RTDLS   = (PRSL2(IK)-PRSL2(IKU)) /
!    &                 PRSI(index2(i),K+1)*RD*0.5*(T2(IK)+T2(IKU))
            RTDLS   = phil(index2(i),k+1) - phil(index2(i),k)
            DMSE    = ELDQ + CPDT - RTDLS
            LSHC(I) = LSHC(I).OR.DMSE.GT.0.
            AU(IK)  = G/RTDLS
          ENDIF
        ENDDO
      ENDDO
      K1=KM+1
      K2=0
      DO I=1,N2
        IF(.NOT.LSHC(I)) THEN
          KBOT(I) = KM+1
          KTOP(I) = 0
        ENDIF
        K1 = MIN(K1,KBOT(I))
        K2 = MAX(K2,KTOP(I))
      ENDDO
      KT = K2-K1+1
      IF(KT.LT.2) RETURN
!-----------------------------------------------------------------------
!  SET EDDY VISCOSITY COEFFICIENT CKU AT SIGMA INTERFACES.
!  COMPUTE DIAGONALS AND RHS FOR TRIDIAGONAL MATRIX SOLVER.
!  EXPAND FINAL FIELDS.
      KK = (K1-1) * N2
      DO I=1,N2
        IK     = KK + I
        AD(IK) = 1.
      ENDDO
!
!     DTODSU=DT/DEL(K1)
      DO K=K1,K2-1
!       DTODSL=DTODSU
!       DTODSU=   DT/DEL(K+1)
!       DSIG=SL(K)-SL(K+1)
        KK = (K-1) * N2
        DO I=1,N2
          ii     = index2(i)
          DTODSL = DT/DEL(II,K)
          DTODSU = DT/DEL(II,K+1)
          DSIG   = PRSL(II,K) - PRSL(II,K+1)
          IK     = KK + I
          IKU    = IK + N2
          IF(K.EQ.KBOT(I)) THEN
            CK=1.5
          ELSEIF(K.EQ.KTOP(I)-1) THEN
            CK=1.
          ELSEIF(K.EQ.KTOP(I)-2) THEN
            CK=3.
          ELSEIF(K.GT.KBOT(I).AND.K.LT.KTOP(I)-2) THEN
            CK=5.
          ELSE
            CK=0.
          ENDIF
          DSDZ1   = CK*DSIG*AU(IK)*GOCP
          DSDZ2   = CK*DSIG*AU(IK)*AU(IK)
          AU(IK)  = -DTODSL*DSDZ2
          AL(IK)  = -DTODSU*DSDZ2
          AD(IK)  = AD(IK)-AU(IK)
          AD(IKU) = 1.-AL(IK)
          T2(IK)  = T2(IK)+DTODSL*DSDZ1
          T2(IKU) = T2(IKU)-DTODSU*DSDZ1
        ENDDO
      ENDDO
      IK1=(K1-1)*N2+1
      CALL TRIDI2T3(N2,KT,AL(IK1),AD(IK1),AU(IK1),Q2(IK1),T2(IK1),
     &                                  AU(IK1),Q2(IK1),T2(IK1))
      DO K=K1,K2
        KK = (K-1)*N2
        DO I=1,N2
          IK = KK + I
          Q(INDEX2(I),K) = Q2(IK)
          T(INDEX2(I),K) = T2(IK)
        ENDDO
      ENDDO
!-----------------------------------------------------------------------
      RETURN
      END