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

      SUBROUTINE SHALOW(RI,GAMA,GAMAQ,GAMAL,FN,T,TVE,Q,QE,QL,PS, 1
     %                  SIGMA,SE,DUDZ2,BB,ISHALOW,N,M,NK)
#include "impnone.cdk"
*
      INTEGER N,M,NK,ISHALOW(2),j,k
*
      REAL RI(N,NK),GAMA(N,NK),GAMAQ(N,NK),FN(N,NK)
      REAL GAMAL(N,NK),QL(N,NK)
      REAL T(M,NK),TVE(N,NK),Q(M,NK),QE(N,NK),PS(N)
      REAL SIGMA(n,NK),SE(n,NK),DUDZ2(N,NK),BB(N)
*
      REAL VIRCOR,FAC,BETA,GAMAM,GMmGS,TE,QSAT
      REAL b,dz,dlnp,dbdz,bGMmGS,bGMmGSv,bGMmGSa,bGMmGSb
      REAL ENTqv,ENTql,ENTtt,mu,nu,ksi
*
*Author
*        C .Girard November 1995
*
*Revisions
*
*Object
*        Parameterization of certain effects of the shallow convection:
*        -To calculate gradients at equilibrium for temperature
*         and moisture which will affect the diffusion in two ways:
*           a) in modifying the stability (via the Richardson number)
*           b) in modifying the equilibrium gradients for the variables
*              to be diffused.
*
*
*Arguments
*
*          -Output-
* RI       Modified Richardson number.
* GAMA     Modified equilibrium gradient for temperature
* GAMAQ    Modified equilibrium gradient for moisture
*
*          -Input-
* FN       Cloud fraction from shallow convection
* T        Temperature
* TVE      Virtual Temperature at intermediate levels
* Q        Specific humidity
* QE       Specific humidity at intermediate levels
* PS       surface pressure
* SIGMA    Sigma level
* SE       Intermediate sigma level
* DUDZ2        (dV/dz)**2
* N        Horizontal dimension
* M        1st dimension of T and Q in the calling program
* NK       vertical dimension
*
*          -Work
* BB       Detrained cloud fraction
*
**
*
*
#
#include "consphy.cdk"
#include "dintern.cdk"
#include "fintern.cdk"
*
*     entrainment: mu=1; detrainment: 1/nu = 1 km
*
      mu = 1.
      nu = 1./1.E3
      ksi = .0
*
      DO j=1,N
         BB(j)=0.
      END DO
*
      DO k=NK-1,2,-1
         DO j=1,N
*
*           CALCUL APPROX. DE GMmGS = GAMAM - GAMAS
*
*                  GAMAM = g/cp
*
*                  cp = CPD*(Tv/T)
*                  BETA = L/cp dqs/dT = 1.35e7*qs/(T*T)
*                  1.35e7 = eps*L*L/Rd/cpd
*                  ALFA = (T/eps)*(Tv/T) dqs/dT
*                  6.46e-4*T = ALFA/BETA
*                  6.46e-4 = cpd/(eps*L)
*
*                  GAMAS = GAMAM*(1+ALFA)/(1+BETA)
*
            TE=FOTTV(TVE(j,k),QE(j,k))
            QSAT=FOQST(TE,SE(j,k)*PS(j))
            BETA=1.35E7*QSAT/(TE*TE)
            VIRCOR=TVE(j,k)/TE
            GAMAM=GRAV/(CPD*VIRCOR)
            GMmGS=GAMAM*(1.-6.46E-4*TE)*BETA/(1.+BETA)
*
*           CALCUL DE dbdz
*
            dlnp =  ALOG( SIGMA(j,k+1)/SIGMA(j,k) )
            dz = RGASD * TVE(j,k) * dlnp / GRAV
            b=.5*(FN(j,k+1)+FN(j,k))
            BB(j) = max( b, BB(j) * max( 0., 1. - nu * dz ) )
            dbdz=mu*max(-nu*BB(j),(FN(j,k)-FN(j,k+1))/dz)
*
*           CALCUL DE  B x GMmGS
*
            bGMmGS=BB(j)*GMmGS
            bGMmGSv=VIRCOR*(1.-2.44E-4*TE)*bGMmGS
            bGMmGSa=(1.-2.44E-4*TE)*bGMmGS
*           bGMmGSa=bGMmGS
            bGMmGSb=bGMmGS/2.5E+3
*
*           CALCUL DE L'ENTRAINEMENT/DETRAINEMENT
*
            ENTqv=(QSAT-QE(j,k))/(1.02-BB(j))*dbdz
            ENTql=.5*(QL(j,k+1)+QL(j,k))/(0.02+BB(j))*dbdz
* en attendant d'etudier l'effet de ql
*           ENTql=ksi*ENTqv
            ENTtt=-TE*(DELTA*ENTqv-ENTql)/(1.+3.3E3*QSAT/TE)
*
*           MODIFICATION DE RI
*
            FAC = GRAV / ( TVE(j,k) * DUDZ2(j,k) )
            RI(j,k) =  RI(j,k) - FAC * bGMmGSv
*
*           MODIFICATION DE GAMA, GAMAQ ET GAMAL
*
            GAMA(j,k)  = GAMA(j,k)  + bGMmGSa + ENTtt
*
            GAMAQ(j,k) = GAMAQ(j,k) - bGMmGSb + ENTqv
*
            GAMAL(j,k) =            + bGMmGSb + ENTql
*
            if( ISHALOW(1).eq.3 ) then
*              en diffusant qv comme si c'etait qt
               GAMAQ(j,k) = GAMAQ(j,k) + GAMAL(j,k)
               GAMAL(j,k) = 0.
            endif
*
         END DO
      END DO
*
      DO j=1,N
         RI(j,NK) =  RI(j,NK-1)
      END DO
*
      RETURN
      END