!copyright (C) 2001 MSC-RPN COMM %%%RPNPHY%%%
***S/P CONRES1
*
#include "phy_macros_f.h"
SUBROUTINE CONRES1(RI,GAMA,GAMAQ,FN,T,TVE,Q,QE,PS,HOL,SIGMA,SE,S, 1,1
% QC,N,M,NK)
#include "impnone.cdk"
*
INTEGER N,M,NK,j,k
*
REAL RI(N,NK),GAMA(N,NK),GAMAQ(N,NK),FN(N,NK)
REAL T(M,NK),TVE(N,NK),Q(M,NK),QE(N,NK)
REAL PS(N),HOL(N)
REAL SIGMA(n,NK),SE(n,NK),S(N,NK)
REAL QC(N)
*
INTEGER MODP
*
REAL X,TVK,TVN,TVBAR,GAMAA,GAMAV,GAMAVS,FAC,DZ,DLNP
REAL BETA,GAMAS,AA,RGASD_OV_GRAV,GRAV_OV_CPD
************************************************************************
* AUTOMATIC ARRAYS
************************************************************************
*
AUTOMATIC (WORK,REAL , (N,NK))
AUTOMATIC (TE ,REAL , (N,NK))
AUTOMATIC (QSAT,REAL , (N,NK))
AUTOMATIC (PRES,REAL , (N,NK))
*
*Author
* C .Girard RPN March 1993
*
*Revisions
* 001 R. Benoit (August 93) - Local sigma (Sigma, SE (2D))
* 002 C .Girard (March 96) - Clean-up and New shallow convection
* 003 M. Lepine (March 2003) - CVMG... Replacements
* 004 A. Plante (May 2003) - IBM conversion
* - replace CVMG* by if/else statements
* - calls to vslog routine (from massvp4 library)
* - calls to optimized routin mfoqst
* - constantes precomputations
*
*Object
* Parameterization of certain effects of shallow convection:
* -Estimate a convective cloud fraction which will interact
* with radiation schemes
* -Modify the stability through Ri for all diffused variables
* including wind
* -Modify the equilibrium gradients of temperature and moisture
*
*
*Arguments
*
* -Input/Output-
* RI nombre de Richardson
* GAMA Gradient at equilibrium for temperature
* GAMAQ Gradient at equilibrium for moisture
* FN Cloud fraction related to shallow convection
*
* -Input-
* T Temperature (M,NK)
* TVE Virtual Temperature at level 'E' (N,NK)
* Q Specific humidity(M,NK)
* QE Specific humidity at level 'E' (N,NK)
* PS surface pressure (N)
* HOL Indicator of stability in the boundary layer (N)
* (Unstable when negative)
* SIGMA Sigma level (n,NK)
* SE Sigma level for 'E' (n,NK)
* N Horizontal dimension
* M 1st dimension of T and Q in the calling program
* NK vertical dimension
*
* -Work-
* QC specific humidity of cloud (N)
*
**
*
*
#
#include "consphy.cdk"
#include "dintern.cdk"
#include "fintern.cdk"
*
RGASD_OV_GRAV=RGASD/GRAV
GRAV_OV_CPD=GRAV/CPD
*
DO j=1,N
*
* POSSIBILITE DE PRESENCE D'UN NUAGE CONVECTIF:
* QC=QNK -AU-DESSUS D'UNE COUCHE LIMITE INSTABLE
*
if (-HOL(j) .ge. 0.) then
QC(j) = Q(j,NK)
else
QC(j) = 0.
endif
*
END DO
*
* Precomputations for optimisation on IBM
DO k=1,NK
DO j=1,N
WORK(j,k)=SIGMA(j,NK)/SIGMA(j,k)
TE(j,k)=FOTTV(TVE(j,k),QE(j,k))
PRES(j,k)=SE(j,k)*PS(j)
END DO
END DO
call vslog(WORK,WORK,N*NK)
*
MODP=3
* NOTE : SE IS NOT USED IN MODE MODP=3.
CALL MFOQST(QSAT,TE,SE,PRES,MODP,N,NK,N)
*
DO k=NK-1,2,-1
DO j=1,N
*
* CALCUL DE TVK, TVN ET TVBAR
*
TVK = FOTVT(T(j,k),Q(j,k))
TVN = FOTVT(T(j,NK),Q(j,NK))
TVBAR = 0.5*(TVK+TVN)
*
* CALCUL APPROX. DE GAMAV
*
DZ = RGASD_OV_GRAV*TVBAR*WORK(J,K)
GAMAV = (TVK-TVN)/DZ + GRAV_OV_CPD
*
* CALCUL APPROX. DE GAMAVS
*
BETA=1.35E7*QSAT(j,k)/(TE(j,k)*TVE(j,k))
GAMAS=GRAV_OV_CPD*(1.-6.46E-4*TE(j,k))*BETA/(1.+BETA)
*
GAMAVS=(TVE(j,k)/TE(j,k))*GAMAS
*
* CALCUL DU RAPPORT: -GAMAV/GAMAVS
*
X = - GAMAV/GAMAVS
*
* DOIT ETRE ENTRE -1. ET 0.
*
X = MAX(-1.,MIN(0.,X))
*
* CALCUL DE LA FRACTION NUAGEUSE: FN
* (variante de la formule de Bjerknes)
*
FN(j,k) = (1+X)/(2+X)
*
* QC S'EVANOUIT LORSQUE FN=0
*
if (FN(j,k) .eq. 0.)then
QC(j) = 0.
endif
*
* FN S'EVANOUIT A SON TOUR SI QC.LT.QSAT
*
if (QC(j).LT.QSAT(j,k))then
FN(j,k) = 0.
endif
*
* CALCUL DE GAMA = AA x GAMAS
*
AA=SQRT(FN(j,k))
GAMAA=AA*GAMAS
*
* MODIFICATION DE RI
*
FAC = GRAV / ( TE(j,k) * S(j,k) )
RI(j,k) = RI(j,k) - FAC * GAMAA
*
GAMA(j,k) = GAMA(j,k) + GAMAA
*
GAMAQ(j,k) = GAMAQ(j,k)
*
END DO
END DO
*
RETURN
END