!copyright (C) 2001  MSC-RPN COMM  %%%RPNPHY%%%
***S/P LIN_CONDS1
*

      SUBROUTINE LIN_CONDS1 (TE,QE,SRR,SSR,TP1,QP1,PSP1, 1
     %                       SIGMA,TAU,N,NK)
*
#include "impnone.cdk"
      INTEGER N, NK
      REAL TE(N,NK),QE(N,NK),SRR(N),SSR(N)
      REAL TP1(N,NK),QP1(N,NK),PSP1(N)
      REAL SIGMA(N,NK), TAU
*
*Author
*          S. Laroche (May 2001)
*
*Object
*          to calculate the T and Q tendencies due to large scale
*          precipitation. This subroutine have been derived from
*          CONDS in the RPN physics library.
*
*Arguments
*
*          - Output -
* TE       temperature tendency due to stratiform processes
* QE       specific humidity tendency due to stratiform processes
* SRR      rate of liquid precipitation
* SSR      rate of solid precipitation
*
*          - Input -
* TP1      temperature
* QP1      specific humidity
* PSP1     surface pressure
* SIGMA    sigma levels
* TAU      timestep
* N        dimension of some arrays
* NK       vertical dimension
*
**
#include "phy_macros_f.h"
#include "consphy.cdk"

      INTEGER i,k,iter,niter
      REAL A1,A3,A4,LC
      REAL CHLS,ZCONS2

      PARAMETER(niter=2)
      REAL QS(niter),DQSDT(niter),DELQ(niter)
      REAL TW(niter+1),QW(niter+1),ZRIT

C
C*    POINTEURS POUR ALLOCATION DYNAMIQUE
C*    -----------------------------------
C
      AUTOMATIC ( ZDSG,  REAL , (N,NK) )
      AUTOMATIC ( ZPP1,  REAL , (N,NK) )
      AUTOMATIC ( ZDPP1, REAL , (N,NK) )
      AUTOMATIC ( ZRFLN, REAL , (N) )
      AUTOMATIC ( ZRFL , REAL , (N) )
      AUTOMATIC ( ZSFLN, REAL , (N) )
      AUTOMATIC ( ZSFL , REAL , (N) )
      AUTOMATIC ( ZFLN , REAL , (N) )

C
C*    COMPUTATIONAL CONSTANTS
C     -----------------------
C
      CHLS   = CHLC + CHLF
      ZCONS2 = 1./(TAU*GRAV)
      A1     = 610.78

      DO i=1,N
       ZDSG(i,1) = 0.5*(SIGMA(i,2)-SIGMA(i,1))
       DO k=2,NK-1
        ZDSG(i,k) = 0.5*(SIGMA(i,k+1)-SIGMA(i,k-1))
       ENDDO
       ZDSG(i,NK) = 0.5*(1.-SIGMA(i,NK-1))+0.5*(1.-SIGMA(i,NK))
      ENDDO

      DO k=1,NK
       DO i=1,N
        ZPP1(i,k)  = SIGMA(i,k)*PSP1(i)
        ZDPP1(i,k) = ZDSG(i,k) *PSP1(i)
       ENDDO
      ENDDO

      DO i=1,N
       ZRFL(i)=0.
       ZSFL(i)=0.
       ZFLN(i)=0.
      ENDDO
C
C*    CALCULATE TW AND QW IN SUPERSATURATED LAYERS
C*    --------------------------------------------
C
      DO k=1,NK
       DO i=1,N

        TW(1) = TP1(i,k)
        QW(1) = QP1(i,k)
        IF(TP1(i,k).ge.TGL) THEN
          A3 = 17.269
          A4 = 35.860
          LC = CHLC
        ELSE
          A3 = 21.875
          A4 =  7.660
          LC = CHLS
        ENDIF

        QS(1) = EPS1*A1*exp(A3*(TW(1) - TGL)/(TW(1) - A4))/ZPP1(i,k)
        IF(QS(1).lt.QP1(i,k)) THEN
          DO iter = 1,niter
               QS(iter) = EPS1*A1*exp(A3*(TW(iter) - TGL)/(TW(iter) - A4))/ZPP1(i,k)
            DQSDT(iter) = QS(iter)*A3*(TGL - A4)/((TW(iter) - A4)**2)
             DELQ(iter) = (QW(iter) - QS(iter))/(1.0 + (LC/CPD)*DQSDT(iter))
             TW(iter+1) = TW(iter) + (LC/CPD)*DELQ(iter)
             QW(iter+1) = QW(iter) - DELQ(iter)
          ENDDO
        ELSE
         QW(niter+1) = QW(1)
         TW(niter+1) = TW(1)
        ENDIF
C
C*      CALCULATE RAIN/SNOW FLUX IN SUPERSATURATED LAYERS
C*      -------------------------------------------------
C
        ZRFLN(i) = ZRFL(i)
        ZSFLN(i) = ZSFL(i)
        IF(QW(niter+1).lt.QP1(i,k)) THEN
         IF(TP1(i,k).gt.TGL) THEN
           ZRFLN(i) = ZRFLN(i) + (QP1(i,k)-QW(niter+1))*ZDPP1(i,k)*ZCONS2
         ELSE
           ZSFLN(i) = ZSFLN(i) + (QP1(i,k)-QW(niter+1))*ZDPP1(i,k)*ZCONS2
         ENDIF
        ENDIF

        IF (k.GT.1) THEN
C
C         ===================================================================
C*        DOES NOT INCLUDE THE EVAPORATION OF PRECIPITATIONS YET.
C*        (SEE ROUTINE CONDS IN PHYSICS LIBRARY AND MAHFOUF99 FOR THE REASON)
C         ===================================================================
C
C
C*        MELTING/FREEZING OF PRECIPITATIONS
C*        ----------------------------------
C
           ZFLN(i) = ZRFLN(i) + ZSFLN(i)
           IF(TP1(i,k).lt.TGL) ZRIT = 1.
           IF(TP1(i,k).ge.TGL) ZRIT = 0.
           ZSFLN(i) =     ZRIT *ZFLN(i)
           ZRFLN(i) = (1.-ZRIT)*ZFLN(i)
        ENDIF
C
C*      TENDENCIES DUE TO CONDENSATION, SURFACE FLUXES
C*      ----------------------------------------------
C
        QE(i,k) = -((ZRFLN(i)-ZRFL(i)) +         (ZSFLN(i)-ZSFL(i)))
     %            *(GRAV/ZDPP1(i,k))
        TE(i,k) = ((ZRFLN(i)-ZRFL(i))*CHLC/CPD + (ZSFLN(i)-ZSFL(i))*CHLS/CPD)
     %            *(GRAV/ZDPP1(i,k))
C
C*      STABLE RAIN AND SNOW RATES
C*      --------------------------
C
        ZRFL(i) = ZRFLN(i)
        ZSFL(i) = ZSFLN(i)

       ENDDO  !( DO ON i)
      ENDDO  !( DO ON k)

C
C*    PRECIPITATION RATE AT THE GROUND LEVEL
C*    --------------------------------------
C
      DO i=1,N
        SRR(i) = ZRFL(i)
        SSR(i) = ZSFL(i)
      ENDDO
*
      RETURN
      END