      SUBROUTINE LRGSCL(SATCRI,GESHEM,      TF,QS,QF,PS,SATC,DEL,PREC,
     1 SL,B,SUPER,DPOVG)
C***  QF=Q(N+1),QS=SAT. Q AT T(N+1)=TF. PS=SURF. PRESS(CB)
C***
      DIMENSION GESHEM( 50 ),TF( 50 , 7 ),
     1QF( 50 , 6 ),QS( 50 , 6 ),PS( 50 ),
     2SATC( 50 , 6 ),DEL( 7 ),PREC( 50 ), SL( 7 ),
     3DPOVG( 50 , 6 ),SUPER( 50 ),B( 50 ),FACT( 6 )
      RLOCP=2.5E+6/ 1005.
      NVAL= 50 * 6
      RLRV=-2.51E+10/(1.61*2.87E+6)
      CONST=6.11*EXP(-RLRV/273.16) / 10.
      C1=CONST*  0.622
      C2=CONST*(-0.378)
      DO 10 K=1, 6
      DO  9 I=1, 50
      DPOVG(I,K)=RLRV/TF(I,K)
9     CONTINUE
10    CONTINUE
      DO 12 K=1, 6
      DO 11 I=1, 50
      QS(I,K) = EXP(DPOVG(I,K))
11    CONTINUE
12    CONTINUE
      DO 14 K=1, 6
      DO 13 I=1, 50
      QS(I,K)=C1*QS(I,K)/(SL(K)*PS(I) + C2*QS(I,K))
13    CONTINUE
14    CONTINUE
      DO 2 K=1, 6
      DO 1 I=1, 50
      DPOVG(I,K)=DEL(K)*PS(I)/ 9.8
1     CONTINUE
2     CONTINUE
      CALL XSTORE(PREC(1),0.0, 50 )
      CALL XSTORE(SATC,1.0, 50 * 6 )
C*** SET EVAPORATION FACTOR
      FACT(1)=.25
      FACT(2)=.16
      FACT(3)=.09
      DO 22 K=4, 6
      FACT(K)=.04
22    CONTINUE
C*** PCPN PROCESS.....TOP LYR DOWNWARD
      RHSAT = .80
      DO 2190 K=1, 6
      L= 6 +1-K
      IF(L.EQ.1)RHSAT=.90
      DO 2110 I=1, 50
      SUPER(I)=(QF(I,L)-QS(I,L))*DPOVG(I,L)
      B(I)=PREC(I)
2110  CONTINUE
      DO 3000 I=1, 50
      IF (SUPER(I).LE.0.)  GO TO 2120
C     HERE IF SUPER GT 0., COMPUTE WET-BULB
C     ADJUSTMENT TO T AND Q, AND AUGMENT
C     PRECIPITATION FALLING THROUGH COLUMN.
      ALPHA = -RLRV/(TF(I,L)**2)
      BETA = 1./RLOCP + ALPHA*QS(I,L)
      QCOND = (SUPER(I)/DPOVG(I,L)) * (1./(RLOCP*BETA))
      TF(I,L) = TF(I,L) + RLOCP*QCOND
      QF(I,L) = QF(I,L) - QCOND
      PREC(I) = PREC(I) + QCOND*DPOVG(I,L)
C     FINISHED WITH SUPER-SATURATED POINT
      GO TO 3000
2120  CONTINUE
C     HERE IF POINT IS NOT SUPER SATURATED
C     CHECK IF FALLING PRECIPITATION IS
C     PRESENT AND IF IT SHOULD BE
C     EVAPORATED.
      IF (PREC(I).LE.0.)  GO TO 3000
      EVAP = (QF(I,L)-QS(I,L)*RHSAT) * DPOVG(I,L)
      IF (EVAP.GE.0.)  GO TO 3000
      EVAP = -EVAP
C     HERE IF EVAPORATION OF FALLING
C     PRECIPITATION IS TO BE COMPUTED
C     COMPUTE POTENTIAL EVAPORATION
      POTEVP = FACT(L)*EVAP
C     ASK IF POTEVP EXCEEDS AVAILABLE
C     FALLING PRECIPITATION, COMPUTE
C     AMOUNT OF WATER EVAPORATED.
      EXCESS = PREC(I) - POTEVP
      AMTEVP = POTEVP
      IF (EXCESS.LT.0.)  AMTEVP=PREC(I)
C     ADJUST T AND Q TO ACCOUNT
C     FOR EVAPORATION, MODIFY PREC.
      ALPHA = -RLRV/(TF(I,L)**2)
      BETA = 1./RLOCP + ALPHA*QS(I,L)
      QEVAP = (AMTEVP/DPOVG(I,L)) * (1./(RLOCP*BETA))
      TF(I,L) = TF(I,L) - RLOCP*QEVAP
      QF(I,L) = QF(I,L) + QEVAP
      PREC(I) = PREC(I) - QEVAP*DPOVG(I,L)
      PREC(I) = AMAX1(PREC(I),0.)
C     FINISHED WITH POINT AT WHICH
C     FALLING PRECIP IS EVAPORATED
      GO TO 3000
3000  CONTINUE
2190  CONTINUE
C*** PCPN REACHES GROUND LEVEL....FACTOR OF .5 SINCE PCPN IS FOR
C*** TWO (LEAPFROG) TIME-STEPS....ACCUM PCPN (GESHEM) IS NOT LEAPFROGGED
      DO 20 I=1, 50
      GESHEM(I)=GESHEM(I)+PREC(I)*.5
  20   CONTINUE
C(DEBUGLINE) VERSION CREATED JULY 8 1982 BY J.SELA,NMC.
      RETURN
      END
