                 SUBROUTINE KFDRIVE(HTOP,HBOT,CNVTOP,CNVBOT)
C     ******************************************************************
C$$$  SUBPROGRAM DOCUMENTATION BLOCK
C                .      .    .
C SUBPROGRAM:    KFDRIVE     CONVECTIVE PRECIPITATION PARAMETERIZATION
C   PRGRMMR: KAIN            ORG: W/NP2      DATE: 00-03-30
C
C ABSTRACT:
C     KFDRIVE IS THE MAIN DRIVER FOR THE KAIN-FRITSCH CONVECTION.
C     GRID POINTS ARE ISOLATED TO BE CHECKED FOR POSSIBLE
C     INITAITION OF THE K-F SCHEME.
C
C
C PROGRAM HISTORY LOG:
C   ??-??-??  KAIN       - ORIGINATOR
C   00-04-13  BLACK      - INCORPORATED INTO ETA MODEL
C
C USAGE: CALL KFDRIVE FROM MAIN PROGRAM EBU
C
C   INPUT ARGUMENT LIST:
C     NONE
C
C   OUTPUT ARGUMENT LIST:
C     HTOP   - CONVECTIVE CLOUD TOP (MODEL LAYER) FOR RADTN
C     HBOT   - CONVECTIVE CLOUD BOTTOM (MODEL LAYER) FOR RADTN
C     CNVTOP - CONVECTIVE CLOUD TOP (MODEL LAYER) FOR CHKOUT
C     CNVBOT - CONVECTIVE CLOUD BOTTOM (MODEL LAYER) FOR CHKOUT
C
C   SUBPROGRAMS CALLED:
C
C     UNIQUE:
C        KFPARA
C
C     LIBRARY:
C        NONE
C
C   COMMON BLOCKS: CTLBLK
C                  VRBLS
C                  PVRBLS
C                  MASKS
C                  CONTIN
C                  DYNAM
C                  LOOPS
C                  KFFDBK
C
C ATTRIBUTES:
C   LANGUAGE: FORTRAN 90
C   MACHINE : IBM SP
C$$$
C----------------------------------------------------------------------
      INCLUDE "parmeta"
      INCLUDE "mpp.h"
      INCLUDE "mpif.h"
C----------------------------------------------------------------------
      PARAMETER(LP1=LM+1,JAM=6+2*(JM-10))
C----------------------------------------------------------------------
      INCLUDE "CTLBLK.comm"
C----------------------------------------------------------------------
      INCLUDE "VRBLS.comm"
C----------------------------------------------------------------------
      INCLUDE "PVRBLS.comm"
C----------------------------------------------------------------------
      INCLUDE "MASKS.comm"
C----------------------------------------------------------------------
      INCLUDE "CONTIN.comm"
C----------------------------------------------------------------------
      INCLUDE "DYNAM.comm"
C----------------------------------------------------------------------
      INCLUDE "LOOPS.comm"
C----------------------------------------------------------------------
      INCLUDE "KFFDBK.comm"
C----------------------------------------------------------------------
      PARAMETER(CP=1004.6,XLV=2.5E6,G=9.8)
      PARAMETER(ALIQ=613.3,BLIQ=17.502,CLIQ=4780.8
     1,         DLIQ=32.19)
C----------------------------------------------------------------------
                              R E A L
     1 HTOP  (IDIM1:IDIM2,JDIM1:JDIM2),HBOT  (IDIM1:IDIM2,JDIM1:JDIM2)
     2,CNVTOP(IDIM1:IDIM2,JDIM1:JDIM2),CNVBOT(IDIM1:IDIM2,JDIM1:JDIM2)
C
                              R E A L
     1 SEM(LM),SEMS(LM),PRS(LM),TV0(LM),Z00(LM),SED(LM),DP(LM)
C
                              I N T E G E R
     1 ICUYES(IDIM1:IDIM2),LSB(IDIM1:IDIM2),NSHALL(JDIM1:JDIM2)
C------------------------------------------------------------------
      ROVG=R/G
C------------------------------------------------------------------
C...NOTE:  SEARCHING ONLY LOWEST 200 mb!!!!!
C------------------------------------------------------------------
      DO L=1,LM
        DO J=MYJS,MYJE
        DO I=MYIS,MYIE
          W0=-OMGALF(I,J,L)*CP/(G*DT)
          W0AVG(I,J,L)=(W0AVG(I,J,L)*(TST-1.)+W0)/TST
        ENDDO
        ENDDO
      ENDDO
C
CJLG      IF(MOD(NTSD-NCLDCK/2,NCLDCK).NE.0)RETURN
      IF(MOD(NTSD,NCLDCK).NE.0)RETURN
C
      DO J=JDIM1,JDIM2
        NSHALL(J)=0
      ENDDO
C- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 
C
C***  MAKE A QUICK FOR CHECK FOR THESE THINGS THAT CAN ELIMINATE
C***  GRID POINTS FROM THE POSSIBILITY OF CONVECTIVE INITIATION:
C
C        1.) CONVECTION ALREADY ACTIVE AT THIS POINT
C        2.) POINT CLOSE TO GRID-DOMAIN BOUNDARY
C        3.) DOWNWARD MOTION AT ALL LEVELS IN LOWEST 300 MB
C        4.) NO CAPE
C- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 
C
!$omp parallel do
!$omp& private(dp,es,i,icuyes,isink,l,l200,l400,lg,lsb,
!$omp&         ncuyes,p200,p400,prs,psfck,qss,qtmp,
!$omp&         sed,sem,sems,ttmp,tv0,z00)
      DO 100 J=MYJS2,MYJE2
C
      NCUYES=0
C
      DO I=MYIS,MYIE
        ICUYES(I)=0
        LSB(I)=0
      ENDDO
C
      DO 60 I=MYIS1,MYIE1
C
      IF(NCA(I,J).GT.NCLDCK.OR.HBM2(I,J).EQ.0.)GO TO 60
      LG=LMH(I,J)
      PSFCK=PD(I,J)*RES(I,J)*AETA(LG)+PT
c     P300=PSFCK-3.E4
      P200=PSFCK-2.E4
      P400=PSFCK-4.E4
C
      DO L=LG,1,-1
        PRS(L)=PD(I,J)*RES(I,J)*AETA(L)+PT  
      ENDDO
C
      DO L=LG,1,-1
        IF(PRS(L).GT.P200)L200=L
        IF(PRS(L).GT.P400)L400=L
      ENDDO
C
C***  VERTICAL VELOCITY MUST BE UPWARD AT SOME LEVEL IN THE
C***  LOWEST 300 MB...
C***  LOWEST 400 MB...!!!!! 9/25/97 JSK
C
      ISINK=0
C
c     DO L=LG,L400,-1
      DO L=LG,L200,-1
c       IF(OMGALF(I,J,L).LT.0.)GO TO 25
        IF(OMGALF(I,J,L).LT.0..OR.Q2(I,J,L).GT.1.)GO TO 25
      ENDDO
C
      ISINK=1
C
   25 CONTINUE
C
C***  CALCULATE MOIST STATIC ENERGY AND SATURATION MOIST STATIC ENERGY
C***  AT EACH VERTICAL LEVEL.
C
      DO L=LG,1,-1
        TTMP=T(I,J,L)
        QTMP=Q(I,J,L)
        DP(L)=(ETA(L+1)-ETA(L))*PD(I,J)*RES(I,J)
        TV0(L)=TTMP*(1.+0.608*QTMP)
C
        IF(L.EQ.LG)THEN
          Z00(L)=0.
        ELSE
          Z00(L)=Z00(L+1)-ROVG*0.5*(TV0(L)+TV0(L+1))*
     1           ALOG(PRS(L)/PRS(L+1))
        ENDIF
C
        ES=ALIQ*EXP((BLIQ*TTMP-CLIQ)/(TTMP-DLIQ))
        QSS=0.622*ES/(PRS(L)-ES)
        SED(L)=CP*TTMP+G*Z00(L)
        SEMS(L)=SED(L)+XLV*QSS
        SEM(L)=SED(L)+XLV*QTMP
      ENDDO
C
C***  IF AIR IS SINKING EVERYWHERE IN LOWEST 400 MB, 
C***  REQUIRE SUPERADIABATIC LAYER IN LOWEST 200 MB 
C***  BEFORE CHECKING FOR CONVECTION IN KF SCHEME.
C
      IF(ISINK.EQ.1)THEN
        DO L=LG,L200-1,-1
          DO NL=L-1,L200,-1 
            IF(SED(L).GT.SED(NL))THEN
              NCUYES=NCUYES+1
              ICUYES(NCUYES)=I
              LSB(I)=LG-L+1
              GO TO 60   
            ENDIF
          ENDDO
        ENDDO
      ELSE
C
C***  IF THERE IS UPWARD MOTION, REQUIRE CONDITIONAL INSTABILITY 
C***  FOR A PARCEL ORIGINATING IN THE LOWEST 400 MB.
C
c       DO L=LG,L400,-1
        DO L=LG,L200,-1
          DO NL=L-1,1,-1
           IF(SEM(L).GT.SEMS(NL))THEN
             NCUYES=NCUYES+1
             ICUYES(NCUYES)=I
             LSB(I)=LG-L+1
             GO TO 60
          ENDIF
          ENDDO
        ENDDO
C
      ENDIF
C- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 
   60 CONTINUE       ! End of I loop
C- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 
      IF(NCUYES.GT.0)THEN
        CALL KFPARA(NCUYES,ICUYES,J,LSB,HTOP,HBOT
     1,             CNVTOP,CNVBOT,NSHALL(J))
      ENDIF
C-----------------------------------------------------------------
  100 CONTINUE       ! End of J loop
C-----------------------------------------------------------------
      NSHALLOW=0
C
      DO J=MYJS2,MYJE2
        NSHALLOW=NSHALLOW+NSHALL(J)
      ENDDO
C
      CALL MPI_REDUCE(NSHALLOW,NSHAL,1,MPI_INTEGER,MPI_SUM,0
     1,               MPI_COMM_COMP,IRECV)
C-----------------------------------------------------------------
c     IF(MYPE.EQ.0)THEN
c       PRINT*,'at NTSD =',NTSD,' NSHALL =',NSHAL
c     ENDIF
C-----------------------------------------------------------------
      RETURN
      END     
