      SUBROUTINE CLOSUR10(Q,T,P,Z,S,TP,QS,QU,SU,MC,DU,MU,MD,QD,SD,ALPHA,        
     1                   QHAT,SHAT,DP,QSTP,ZF,QL,DSUBCLD,MB,QDB,SDB,DSR,
     2                   UG,VG,BETAU,BETAD,CAPE,TL,LCL,LEL,JT,MX,J0,
     3                   DELT,ILEV,ILG,IL1G,IL2G,RD,GRAV,CP,MSG,CAPELMT)
C
C     * APR 30/2012 - M.LAZARE.    NEW VERSION FOR GCM16:
C     *                            ALF INCREASED FROM 1.E8 TO 5.E8. 
C     * DEC 18/2007 - M.LAZARE     PREVIOUS VERSION CLOSUR9 FOR GCM15G/H/I:
C     *                            ALF DECREASED FROM 1.E9 TO 1.E8.
C     * JUN 15/2006 - M.LAZARE.    PREVIOUS VERSION CLOSUR8 FOR GCM15F:
C     *                            - NOW USES INTERNAL WORK ARRAYS
C     *                              INSTEAD OF PASSED WORKSPACE.    
C     *                            - "ZERO" DATA CONSTANT ADDED
C     *                               AND USED IN CALL TO INTRINSICS. 
C     * DEC 07/2004 - M.LAZARE.    PREVIOUS VERSION CLOSUR7 FOR GCM15C/D/E:
C     *                            PROGNOSTIC CLOSURE NOW DEFAULT (ICLOS=1).
C
      IMPLICIT REAL   (A-H,O-Z),
     +INTEGER (I-N)
C
C     * I/O FIELDS:
C                                                                             
      REAL  , DIMENSION(ILG,ILEV) :: Q,T,P,Z,S,TP,QS,QU,SU,
     1                               MC,DU,MU,MD,QD,SD,ALPHA,            
     2                               QHAT,SHAT,DP,QSTP,ZF,QL,UG,VG,DSR
      REAL  , DIMENSION(ILG)      :: MB,QDB,SDB,BETAU,BETAD,CAPE,TL,                 
     1                               DSUBCLD
      INTEGER,DIMENSION(ILG)      :: LCL,LEL,JT,MX,J0
C                                                                               
C     * INTERNAL WORK FIELDS:                                                          
C                                                                               
      REAL  , DIMENSION(ILG,ILEV) :: DTPDT,DQSDTP,DTMDT,DQMDT,
     1                               DBOYDT,THETAVP,THETAVM
      REAL  , DIMENSION(ILG)      :: DTBDT,DQBDT,DTLDT,RL,PMAX,TMAX,
     1                               QMAX,QHATMAX,SHATMAX,SUMAX,
     2                               SDMAX,MUMAX,MDMAX,QUMAX,QDMAX,
     3                               DADT,DZT,VSHEAR,UGB,VGB,MBTEST
C
      COMMON/EPS   / A,B,EPS1,EPS2                                            
      COMMON/HTCP  / TFREEZ,T2S,AI,BI,AW,BW,SLP                               
C
      DATA ICLOS/1/                                                               
      DATA TAU /2400./                                    
      DATA ZERO    / 0.     /
C---------------------------------------------------------------------------  
CCC   *************************************************************           
CCC   CHANGE OF SUBCLOUD LAYER PROPERTIES DUE TO CONVECTION IS                
CCC   RELATED TO CUMULUS UPDRAFTS AND DOWNDRAFTS.                             
CCC   MC(Z)=F(Z)*MB, MUB=BETAU*MB, MDB=BETAD*MB ARE USED                      
CCC   TO DEFINE BETAU, BETAD AND F(Z).                                         
CCC   NOTE THAT THIS IMPLIES ALL TIME DERIVATIVES ARE IN EFFECT                
CCC   TIME DERIVATIVES PER UNIT CLOUD-BASE MASS FLUX, I.E. THEY                
CCC   HAVE UNITS OF 1/MB INSTEAD OF 1/SEC.                                     
CCC   *************************************************************
C
C     * CONSTANTS FOR PROGNOSTIC CLOSURE SCHEME.
C
      ALF=5.E8
      TAUS1=6.*3600.
      REFM=1./2.4E-4
      TAUSMIN=180.
C
C     * OBTAIN GATHERED FIELDS AT "MX" FOR ENSUING USE.
C     * INITIALIZE "DADT" ARRAY.
C
      DO 50 K=MSG+1,ILEV 
      DO 50 IL=IL1G,IL2G
        IF(K.EQ.MX(IL))                                          THEN
          PMAX   (IL)=P   (IL,K)
          TMAX   (IL)=T   (IL,K)
          QMAX   (IL)=Q   (IL,K)
          QHATMAX(IL)=QHAT(IL,K)
          QUMAX  (IL)=QU  (IL,K)
          QDMAX  (IL)=QD  (IL,K)
          SHATMAX(IL)=SHAT(IL,K)
          SUMAX  (IL)=SU  (IL,K)
          SDMAX  (IL)=SD  (IL,K)
          MUMAX  (IL)=MU  (IL,K)
          MDMAX  (IL)=MD  (IL,K) 
        ENDIF 
   50 CONTINUE      
C
      DO 100 IL=IL1G,IL2G                                                    
         DADT   (IL) = 0.
         DZT    (IL) = 0.
         VSHEAR (IL) = 0.
         UGB    (IL) = UG(IL,LCL(IL))
         VGB    (IL) = VG(IL,LCL(IL))                                        
         EB          = PMAX(IL)*QMAX(IL)/(EPS1+QMAX(IL))                       
         DTBDT(IL)   = (1./DSUBCLD(IL))                                       
     1                 *( MUMAX(IL)*( SHATMAX(IL)-SUMAX(IL) )               
     2                 +MDMAX(IL)*( SHATMAX(IL)-SDMAX(IL) ) )                 
         DQBDT(IL)   = (1./DSUBCLD(IL))                                    
     1                 *( MUMAX(IL)*( QHATMAX(IL)-QUMAX(IL) )                
     2                 +MDMAX(IL)*( QHATMAX(IL)-QDMAX(IL) ) )                 
         DEBDT       = EPS1*PMAX(IL)/(EPS1+QMAX(IL))**2*DQBDT(IL)           
         DTLDT(IL)   =-2840.*(3.5/TMAX(IL)*DTBDT(IL)-DEBDT/EB)/                
     1                 (3.5*LOG(TMAX(IL))-LOG(EB)-4.805)**2                 
  100 CONTINUE
C                                                                            
CCC   ******************************************************************    
CCC     DTMDT AND DQMDT ARE CUMULUS HEATING AND DRYING.                       
CCC   ******************************************************************       
C
      DO 150 K=MSG+1,ILEV                                                      
      DO 150 IL=IL1G,IL2G                                                      
        DTMDT(IL,K)=0.                                                         
        DQMDT(IL,K)=0.                                                         
  150 CONTINUE
C
      DO 175 K=MSG+1,ILEV-1                                                    
      DO 175 IL=IL1G,IL2G                                                     
        IF(K.EQ.JT(IL))                                             THEN       
C         RL(IL)=(2.501-.00237*(T(IL,K+1)-TFREEZ))*1.E6                        
          RL(IL)=2.501E6                                                       
          DTMDT(IL,K)=(DSR(IL,K)/DP(IL,K))                                            
     1               *(MU(IL,K+1)*(SU(IL,K+1)-SHAT(IL,K+1)                     
     2                             -RL(IL)/CP*QL(IL,K+1) ) +                   
     3                 MD(IL,K+1)*(SD(IL,K+1)-SHAT(IL,K+1)) )                  
          DQMDT(IL,K)=(DSR(IL,K)/DP(IL,K))                                            
     1               *(MU(IL,K+1)*(QU(IL,K+1)-QHAT(IL,K+1)+QL(IL,K+1)) +       
     2                 MD(IL,K+1)*(QD(IL,K+1)-QHAT(IL,K+1)) )                  
        ENDIF                                                                  
  175 CONTINUE                                                                 
C                   
      BETA=1.                                                                  
      DO 180 K=MSG+1,ILEV-1                                                    
      DO 180 IL=IL1G,IL2G                                                      
        IF(K.GT.JT(IL) .AND. K.LT.MX(IL))                           THEN       
C         RL(IL)=(2.501-.00237*(T(IL,K)-TFREEZ))*1.E6                         
          RL(IL)=2.501E6                                                      
          DTMDT(IL,K)=DSR(IL,K)*(MC(IL,K)*(SHAT(IL,K)-S(IL,K))                          
     1                +MC(IL,K+1)*(S(IL,K)-SHAT(IL,K+1)))/DP(IL,K)            
     2      -RL(IL)/CP*DU(IL,K)*(BETA*QL(IL,K)+(1-BETA)*QL(IL,K+1))            
          DQMDT(IL,K)=DSR(IL,K)*(MC(IL,K)*(QHAT(IL,K)-Q(IL,K))                           
     1                +MC(IL,K+1)*(Q(IL,K)-QHAT(IL,K+1)))/DP(IL,K)             
     2                +DU(IL,K)*(QS(IL,K)-Q(IL,K))                             
     3                +DU(IL,K)*(BETA*QL(IL,K)+(1-BETA)*QL(IL,K+1))            
        ENDIF                                                                  
  180 CONTINUE                                                                 
C                   
      DO 200 K=MSG+1,ILEV                                                      
      DO 200 IL=IL1G,IL2G                                                      
        IF(K.GE.LEL(IL) .AND. K.LE.LCL(IL))                         THEN       
C         RL(IL)=(2.501-.00237*(TP(IL,K)-TFREEZ))*1.E6                        
          RL(IL)=2.501E6                                                      
          THETAVP(IL,K)=TP(IL,K)*(1000./P(IL,K))**(RD/CP)                     
     1                  *(1.+1.608*QSTP(IL,K)-QMAX(IL))                    
          THETAVM(IL,K)=T(IL,K)*(1000./P(IL,K))                                
     1                  **(RD/CP)*(1.+0.608*Q(IL,K))                           
          DQSDTP(IL,K)=QSTP(IL,K)*(1.+QSTP(IL,K)/EPS1)                        
     1                 *EPS1*RL(IL)/(RD*TP(IL,K)**2)                          
CCC     ******************************************************************     
CCC       DTPDT IS THE PARCEL TEMPERATURE CHANGE DUE TO CHANGE OF              
CCC       SUBCLOUD LAYER PROPERTIES DURING CONVECTION.                         
CCC     ******************************************************************     
          DTPDT(IL,K)=TP(IL,K)                                                 
     1               /(1.+RL(IL)/CP*(DQSDTP(IL,K)-QSTP(IL,K)/TP(IL,K)))*       
     2               (   DTBDT(IL)/TMAX(IL)+RL(IL)/CP*                       
     3               (DQBDT(IL)/TL(IL)-QMAX(IL)/TL(IL)**2*DTLDT(IL)          
     4                                                                ))       
CCC     ******************************************************************     
CCC       DBOYDT IS THE INTEGRAND OF CAPE CHANGE.                              
CCC     ******************************************************************     
          DBOYDT(IL,K)=((DTPDT(IL,K)/TP(IL,K)                                  
     1                 +1./(1.+1.608*QSTP(IL,K)-QMAX(IL))                    
     2                 *(1.608*DQSDTP(IL,K)*DTPDT(IL,K)-DQBDT(IL)))            
     3                 -(DTMDT(IL,K)/T(IL,K)+0.608/(1.+0.608*Q(IL,K))          
     4                 *DQMDT(IL,K)))*GRAV*THETAVP(IL,K)/THETAVM(IL,K)         
CCC     ******************************************************************     
        ENDIF                                                                  
 200  CONTINUE
C                                                                              
      DO 250 K=MSG+1,ILEV                                                      
      DO 250 IL=IL1G,IL2G                                                      
        IF(K.GT.LCL(IL) .AND. K.LT.MX(IL))                          THEN       
C         RL(IL)=(2.501-.00237*(TP(IL,K)-TFREEZ))*1.E6                         
          RL(IL)=2.501E6                                                       
          THETAVP(IL,K)=TP(IL,K)*(1000./P(IL,K))**(RD/CP)                      
     1                  *(1.+0.608*QMAX(IL))                                 
          THETAVM(IL,K)=T(IL,K)*(1000./P(IL,K))                                
     1                  **(RD/CP)*(1.+0.608*Q(IL,K))                           
CCC     ******************************************************************     
CCC       DBOYDT IS THE INTEGRAND OF CAPE CHANGE.                              
CCC     ******************************************************************     
          DBOYDT(IL,K)=(DTBDT(IL)/TMAX(IL)                                   
     1                 +0.608/(1.+0.608*QMAX(IL))*DQBDT(IL)                  
     2                 -DTMDT(IL,K)/T(IL,K)                                    
     3                 -0.608/(1.+0.608*Q(IL,K))*DQMDT(IL,K))                  
     4                 *GRAV*THETAVP(IL,K)/THETAVM(IL,K)                       
CCC     ******************************************************************     
        ENDIF                                                                  
 250  CONTINUE
C                                                                              
      IF(ICLOS.EQ.0) THEN    
C
       DO 300 K=MSG+1,ILEV
       DO 300 IL=IL1G,IL2G
        IF(K.GE.LEL(IL) .AND. K.LT.MX(IL))                        THEN      
          DADT(IL)=DADT(IL)+DBOYDT(IL,K)*(ZF(IL,K)-ZF(IL,K+1))   
        ENDIF                         
  300  CONTINUE                                                            
C
       DO 350 IL=IL1G,IL2G                                                     
        MB(IL)      = 0. 
        DLTAA=-1.*(CAPE(IL)-CAPELMT)
        IF(DADT(IL).NE.0.)     MB(IL)=MAX(DLTAA/TAU/DADT(IL),ZERO)   
  350  CONTINUE    
C
      ELSE
C
       DO 400 K=MSG+1,ILEV
       DO 400 IL=IL1G,IL2G
        IF(K.GE.LEL(IL) .AND. K.LT.MX(IL))                        THEN  
          ADZ=ZF(IL,K)-ZF(IL,K+1)   
          DADT(IL)=DADT(IL)+DBOYDT(IL,K)*ADZ
        ENDIF                         
  400  CONTINUE                                                         
C
       DO 450 IL=IL1G,IL2G                                              
        DLTAA=(CAPE(IL)-CAPELMT)
        IF(DADT(IL).LT.0..AND.DLTAA.GT.0.) THEN
           FR=-DADT(IL)
           MB(IL)=(DLTAA/ALF*DELT+MB(IL))
     1           /(1.+DELT/TAUS1)     
        ELSE
           MB(IL)=0.
        ENDIF   
  450  CONTINUE      
      ENDIF
C                                                                             
      RETURN                                                                  
      END        
