!copyright (C) 2001 MSC-RPN COMM %%%RPNKUO%%%
***S/P LIN_KUOSYM_TL
*
#include "phy_macros_f.h"
SUBROUTINE LIN_KUOSYM_TL ( CTT5,CQT5,ilab,CCF5,DBDT5,CRR5,CSR5, 1,4
+ CTT ,CQT , CRR, CSR ,
+ TP5,TM5,QP5,QM5,GZM5,PSP5,
+ TP ,TM ,QP ,QM ,GZM ,PSP ,
+ SIGMA, TAU, NI, NK )
#include "impnone.cdk"
*
C
INTEGER NI,NK
REAL CTT(NI,NK),CQT(NI,NK)
REAL CTT5(NI,NK),CQT5(NI,NK)
INTEGER ilab(NI,NK)
REAL CCF5(NI,NK),DBDT5(NI),CRR(NI),CSR(NI)
REAL CRR5(NI),CSR5(NI)
REAL TP
(NI,NK),TM(NI,NK),QP(NI,NK),QM(NI,NK),GZM(NI,NK)
REAL TP5(NI,NK),TM5(NI,NK),QP5(NI,NK),QM5(NI,NK),GZM5(NI,NK)
REAL PSP(NI),SIGMA(NI,NK)
REAL PSP5(NI)
REAL TAU
*
*Author
* J.-F. Mahfouf (Sept 2002)
*
*Revision
* 001 J.-F. Mahfouf (Feb 2004) - LNOISE
*
*Object
* To calculate the convective tendencies of T and Q
* using a scheme with a "symmetric Kuo-type closure".
* Geleyn's method is used to obtain the cloud profiles.
*
* ======================
* Tangent-linear version
* ======================
*
*Arguments
*
* - Outputs -
* CTT convective temperature tendency
* CQT convective specific humidity tendency
* CRR rate of liquid convective precipitation
* CSR rate of solid convective precipitation
*
* CTT5 convective temperature tendency [trajectory]
* CQT5 convective specific humidity tendency [trajectory]
* ilab flag array: an indication of convective activity [trajectory]
* CCF5 estimated cumulus cloud fraction [trajectory]
* DBDT5 estimated averaged cloud fraction growth rate [trajectory]
* CRR5 rate of liquid convective precipitation [trajectory]
* CSR5 rate of solid convective precipitation [trajectory]
*
* - Inputs -
* TP temperature at (t+dt)
* TM temperature at (t-dt)
* QP specific humidity at (t+dt)
* QM specific humidity at (t-dt)
* GZM geopotential
* PSP surface pressure at (t+dt)
*
* TP5 temperature at (t+dt) [trajectory]
* TM5 temperature at (t-dt) [trajectory]
* QP5 specific humidity at (t+dt) [trajectory]
* QM5 specific humidity at (t-dt) [trajectory]
* GZM5 geopotential [trajectory]
* PSP5 surface pressure at (t+dt) [trajectory]
*
* SIGMA sigma levels
* TAU effective timestep (2*dt)
* NI horizontal dimension
* NK vertical dimension
*
*Notes
* The routine is divided into 5 parts:
* 1)allocation and position for work space
* 2)preliminary computations
* 3)cloud ascent and flagging
* 4)total dry and moist enthalpy accession calculations
* 5)cloud heating and moistening (drying) calculations
*
**
LOGICAL LO, LNOISE
INTEGER IS,IKA,IKB,jk,jkm1,jl
REAL ZTVC5
REAL ZTVC
REAL ENTRM,TAUCU,CHLS,DELTA2
REAL ZA1,ZA3,ZA4,ZSIG5
REAL ZK5,ZDH5,ZTDIF5,ZQDIF5
REAL ZK,ZDH,ZTDIF,ZQDIF
*
C
************************************************************************
* AUTOMATIC ARRAYS
************************************************************************
*
AUTOMATIC ( LO1 , LOGICAL , (NI ))
*
AUTOMATIC ( ZCP5 , REAL , (NI ))
AUTOMATIC ( ZLDCP0 , REAL , (NI ))
AUTOMATIC ( ZPR5 , REAL , (NI ))
AUTOMATIC ( ZT15 , REAL , (NI ))
AUTOMATIC ( ZQ15 , REAL , (NI ))
AUTOMATIC ( ZP15 , REAL , (NI ))
AUTOMATIC ( ZDSG5 , REAL , (NI,NK))
AUTOMATIC ( ZPP5 , REAL , (NI,NK))
AUTOMATIC ( ZDP5 , REAL , (NI,NK))
AUTOMATIC ( ZSDP5 , REAL , (NI,NK))
AUTOMATIC ( ZQAC5 , REAL , (NI,NK))
AUTOMATIC ( ZTAC5 , REAL , (NI,NK))
AUTOMATIC ( ZSTAC5 , REAL , (NI,NK))
AUTOMATIC ( ZHAC5 , REAL , (NI,NK))
AUTOMATIC ( ZSHAC5 , REAL , (NI,NK))
AUTOMATIC ( ZQSE5 , REAL , (NI,NK))
AUTOMATIC ( ZTC5 , REAL , (NI,NK))
AUTOMATIC ( ZQC5 , REAL , (NI,NK))
AUTOMATIC ( ZTE5 , REAL , (NI,NK))
AUTOMATIC ( ZQE5 , REAL , (NI,NK))
AUTOMATIC ( ZTVE5 , REAL , (NI,NK))
AUTOMATIC ( ZDQ5 , REAL , (NI,NK))
AUTOMATIC ( ZDT5 , REAL , (NI,NK))
AUTOMATIC ( ZSDH5 , REAL , (NI,NK))
AUTOMATIC ( ZESE5 , REAL , (NI,NK))
AUTOMATIC ( ZCP , REAL , (NI ))
AUTOMATIC ( ZPR , REAL , (NI ))
AUTOMATIC ( ZT1 , REAL , (NI ))
AUTOMATIC ( ZQ1 , REAL , (NI ))
AUTOMATIC ( ZP1 , REAL , (NI ))
AUTOMATIC ( ZPP , REAL , (NI,NK))
AUTOMATIC ( ZDP , REAL , (NI,NK))
AUTOMATIC ( ZSDP , REAL , (NI,NK))
AUTOMATIC ( ZQAC , REAL , (NI,NK))
AUTOMATIC ( ZTAC , REAL , (NI,NK))
AUTOMATIC ( ZSTAC , REAL , (NI,NK))
AUTOMATIC ( ZHAC , REAL , (NI,NK))
AUTOMATIC ( ZSHAC , REAL , (NI,NK))
AUTOMATIC ( ZQSE , REAL , (NI,NK))
AUTOMATIC ( ZTC , REAL , (NI,NK))
AUTOMATIC ( ZQC , REAL , (NI,NK))
AUTOMATIC ( ZTE , REAL , (NI,NK))
AUTOMATIC ( ZQE , REAL , (NI,NK))
AUTOMATIC ( ZTVE , REAL , (NI,NK))
AUTOMATIC ( ZDQ , REAL , (NI,NK))
AUTOMATIC ( ZDT , REAL , (NI,NK))
AUTOMATIC ( ZSDH , REAL , (NI,NK))
AUTOMATIC ( ZESE , REAL , (NI,NK))
*
************************************************************************
C
C* PHYSICAL CONSTANTS.
C -------- ----------
C
#include "consphy.cdk"
C
ENTRM = 5.E-6
TAUCU = 3600.
DELTA2 = CPV/CPD - 1.
CHLS = CHLC + CHLF
ZA1 = 610.78
C
LNOISE=.false.
C
C ------------------------------------------------------------------
C
C* 1. ALLOCATION AND POSITION FOR WORK SPACE.
C ---------- --- -------- --- ---- ------
C
C
C
C***
C
C METHOD.
C -------
C
C IN (3) A NEARLY ADIABATIC ASCENT IS ATTEMPTED FOR A CLOUD
C PARCEL STARTING FROM THE LOWEST MODEL LAYER. THIS CLOUD ASCENT
C IS COMPUTED IN TERMS OF TEMPERATURE AND SPECIFIC HUMIDITY.
C ENTRAINMENT IS SIMULATED VIA AN ENTRAINMENT PARAMETER.
C THE LAYERS ARE FLAGGED ACCORDING TO THE FOLLOWING CODE:
C 0 = STABLE OR INACTIVE LAYER,
C 1 = PART OF THE WELL MIXED BOUNDARY LAYER OR DRY UNSTABLE LAYER,
C 2 = MOIST UNSTABLE OR ACTIVE OR CLOUD LAYER.
C THE 1-FLAGS ARE RESET TO 0-FLAGS FOR THE NEXT SECTION.
C IN (4) THE INTEGRATED MOIST AND DRY ENTHALPY ACCESSIONS
C FOR EACH CLOUD LAYER ARE STORED INTO ALL THE CORRESPONDING
C LAYERS IF THE FIRST IS POSITIVE WHILE THE SECOND IS NEGATIVE,
C OTHERWISE, THE 2-FLAGS ARE ALSO RESET TO 0-FLAGS.
C IN (5) THE ACTUAL MODIFICATIONS OF TEMPERATURE AND SPECIFIC
C HUMIDITY ARE COMPUTED. A CLOUD-COVER VALUE IS ESTIMATED BY
C COMPARING THE TIME AT WHICH THE ENVIRONMENT WOULD REACH
C EQUILIBRIUM WITH THE CLOUD TO A PRESCRIBED CLOUD LIFE-TIME.
C
C ------------------------------------------------------------------
C
C* 2. PRELIMINARY COMPUTATIONS.
C ----------- -------------
C
C* 2.0 INITIALISATION OF OUTPUT FIELDS
C
ilab(:,:) = 0
CTT (:,:) = 0.0
CTT5(:,:) = 0.0
CQT (:,:) = 0.0
CQT5(:,:) = 0.0
CCF5(:,:) = 0.0
CRR (:) = 0.0
CRR5(:) = 0.0
CSR (:) = 0.0
CSR5(:) = 0.0
ZPR (:) = 0.0
ZPR5(:) = 0.0
DBDT5(:) = 0.0
C
C* 2.1 ENVIRONMENTAL PROFILES AND PARAMETERS,
C* DRY AND MOIST ENTHALPY ACCESSIONS (divided by cp)
C* AND INITIALIZATIONS.
C
DO jl=1,NI
ZDSG5(jl,1)=0.5*(SIGMA(jl,2)-SIGMA(jl,1))
END DO
C
DO jk=2,NK-1
DO jl=1,NI
ZDSG5(jl,jk)=0.5*(SIGMA(jl,jk+1)-SIGMA(jl,jk-1))
END DO
END DO
C
DO jl=1,NI
ZDSG5(jl,NK)=0.5*(1.-SIGMA(jl,NK-1))+0.5*(1.-SIGMA(jl,NK))
END DO
C
DO jl=1,NI
IF (TP5(jl,NK) < TRPL) THEN
ZLDCP0(jl) = CHLS / CPD
ELSE
ZLDCP0(jl) = CHLC / CPD
ENDIF
END DO
C
DO jk=1,NK
DO jl=1,NI
ZPP (jl,jk)=SIGMA(jl,jk)*PSP (jl)
ZPP5(jl,jk)=SIGMA(jl,jk)*PSP5(jl)
ZDP (jl,jk)=ZDSG5(jl,jk)*PSP (jl)
ZDP5(jl,jk)=ZDSG5(jl,jk)*PSP5(jl)
ZTE (jl,jk)=TP
(jl,jk)
ZTE5(jl,jk)=TP5(jl,jk)
IF (ZTE5(jl,jk) > TRPL) THEN
ZA3=17.269
ZA4=35.860
ELSE
ZA3=21.875
ZA4= 7.660
ENDIF
ZESE (jl,jk)=ZA1*ZA3*(TRPL-ZA4)/((ZTE5(jl,jk)-ZA4)**2)*
* EXP(ZA3*(ZTE5(jl,jk)-TRPL)/(ZTE5(jl,jk)-ZA4))*
* ZTE(jl,jk)
ZESE5(jl,jk)=ZA1*EXP(ZA3*(ZTE5(jl,jk)-TRPL)/(ZTE5(jl,jk)-ZA4))
ZQSE (jl,jk)=EPS1*(ZPP5(jl,jk)*ZESE(jl,jk)-ZPP(jl,jk)*
* ZESE5(jl,jk))/
* ((ZPP5(jl,jk)-EPS2*ZESE5(jl,jk))**2)
ZQSE5(jl,jk)=EPS1*ZESE5(jl,jk)/(ZPP5(jl,jk)-EPS2*ZESE5(jl,jk))
IF (ZQSE5(jl,jk) > QM5(jl,jk)) THEN
ZQE (jl,jk) = QM (jl,jk)
ZQE5(jl,jk) = QM5(jl,jk)
ELSE
ZQE (jl,jk) = ZQSE (jl,jk)
ZQE5(jl,jk) = ZQSE5(jl,jk)
ENDIF
ZTVE (jl,jk) = ZTE (jl,jk)*(1.0 + DELTA*ZQE5(jl,jk)) +
* ZTE5(jl,jk)* DELTA*ZQE (jl,jk)
ZTVE5(jl,jk) = ZTE5(jl,jk)*(1.0 + DELTA*ZQE5(jl,jk))
C
ZTAC (jl,jk)=(TP
(jl,jk)-TM (jl,jk))*ZDP5(jl,jk)/TAU +
* (TP5(jl,jk)-TM5(jl,jk))*ZDP (jl,jk)/TAU
ZTAC5(jl,jk)=(TP5(jl,jk)-TM5(jl,jk))*ZDP5(jl,jk)/TAU
ZQAC (jl,jk)=(QP (jl,jk)-ZQE (jl,jk))*ZDP5(jl,jk)/TAU +
* (QP5(jl,jk)-ZQE5(jl,jk))*ZDP (jl,jk)/TAU
ZQAC5(jl,jk)=(QP5(jl,jk)-ZQE5(jl,jk))*ZDP5(jl,jk)/TAU
C
ZHAC (jl,jk)= ZTAC (jl,jk) + ZLDCP0(jl)*ZQAC (jl,jk)
ZHAC5(jl,jk)= ZTAC5(jl,jk) + ZLDCP0(jl)*ZQAC5(jl,jk)
END DO
END DO
C
C* 2.2 SPECIFY TC AND QC AT THE LOWEST LAYER TO START THE
C* CLOUD ASCENT. CHECK FOR POSITIVE ACCESSION
C* BETWEEN SURFACE AND CLOUD BASE.
C* ZQC=0 INDICATES STABLE CONDITIONS.
C
DO jl=1,NI
ZTC (jl,NK)=ZTE (jl,NK)
ZTC5(jl,NK)=ZTE5(jl,NK)
ZQC (jl,NK)=0.
ZQC5(jl,NK)=0.
IF (ZHAC5(jl,NK) > 0.) THEN
ZQC (jl,NK)=ZQE (jl,NK)
ZQC5(jl,NK)=ZQE5(jl,NK)
ilab(jl,NK) = 1
ENDIF
END DO
C
C ------------------------------------------------------------------
C
C* 3. CLOUD ASCENT AND FLAGGING.
C ----- ------ --- ---------
C
C* 3.1 CALCULATE TC AND QC AT UPPER LEVELS BY DRY ADIABATIC
C* LIFTING FOLLOWED BY LATENT HEAT RELEASE WHEN REQUIRED.
C* CONDENSATION CALCULATIONS ARE DONE WITH TWO ITERATIONS.
C***
DO jk=NK-1,1,-1
C***
DO jl=1,NI
ZCP (jl)=CPD* DELTA2*ZQC (jl,jk+1)
ZCP5(jl)=CPD*(1.+DELTA2*ZQC5(jl,jk+1))
IF ( ZTC5(jl,jk+1) > ZTE5(jl,jk+1) ) THEN
ZTDIF = ZTC (jl,jk+1)-ZTE (jl,jk+1)
ZTDIF5 = ZTC5(jl,jk+1)-ZTE5(jl,jk+1)
ELSE
ZTDIF = 0.0
ZTDIF5 = 0.0
ENDIF
ZTC (jl,jk)=ZTC (jl,jk+1)+(GZM (jl,jk+1)-GZM (jl,jk))*
* (1./ZCP5(jl)+ENTRM*ZTDIF5) +
* (GZM5(jl,jk+1)-GZM5(jl,jk))*
* (-ZCP(jl)/ZCP5(jl)**2+ENTRM*ZTDIF)
ZTC5(jl,jk)=ZTC5(jl,jk+1)+(GZM5(jl,jk+1)-GZM5(jl,jk))*
* (1./ZCP5(jl)+ENTRM*ZTDIF5)
IF ( ZQC5(jl,jk+1) > ZQE5(jl,jk+1) ) THEN
ZQDIF = ZQC (jl,jk+1)-ZQE (jl,jk+1)
ZQDIF5 = ZQC5(jl,jk+1)-ZQE5(jl,jk+1)
ELSE
ZQDIF = 0.0
ZQDIF5 = 0.0
ENDIF
ZQC (jl,jk)=ZQC (jl,jk+1)+(GZM (jl,jk+1)-GZM (jl,jk))*
* ENTRM*ZQDIF5 +
* (GZM5(jl,jk+1)-GZM5(jl,jk))*
* ENTRM*ZQDIF
ZQC5(jl,jk)=ZQC5(jl,jk+1)+(GZM5(jl,jk+1)-GZM5(jl,jk))*
* ENTRM*ZQDIF5
ZTVC5 = ZTC5(jl,jk)*(1.0 + DELTA*ZQC5(jl,jk))
LO= ZTVC5.GT.ZTVE5(jl,jk) .AND. ZQC5(jl,jk).NE.0.
IF (LO) ilab(jl,jk) = 1
END DO
C
DO jl=1,NI
ZP1 (jl) = ZPP (jl,jk)
ZP15(jl) = ZPP5(jl,jk)
ZT1 (jl) = ZTC (jl,jk)
ZT15(jl) = ZTC5(jl,jk)
ZQ1 (jl) = ZQC (jl,jk)
ZQ15(jl) = ZQC5(jl,jk)
END DO
C
CALL LIN_ADJTQ_TL
( ZT15, ZQ15, ZP15, ZT1, ZQ1, ZP1, NI )
C
DO jl=1,NI
LO1(jl) = ZT15(jl) /= ZTC5(jl,jk)
ZTC (jl,jk) = ZT1 (jl)
ZTC5(jl,jk) = ZT15(jl)
ZQC (jl,jk) = ZQ1 (jl)
ZQC5(jl,jk) = ZQ15(jl)
END DO
C
DO jl=1,NI
ZTVC5=ZTC5(jl,jk)*(1.0+DELTA*ZQC5(jl,jk))
LO= ZTVC5.GT.ZTVE5(jl,jk) .AND. LO1(jl)
IF (LO) ilab(jl,jk) = 2
LO1(jl)=ilab(jl,jk).EQ.0
IF (LO1(jl)) THEN
ZTC (jl,jk) = ZTE (jl,jk)
ZTC5(jl,jk) = ZTE5(jl,jk)
ZQC (jl,jk) = 0.0
ZQC5(jl,jk) = 0.0
ENDIF
END DO
C
C* 3.2 IF NOT AT THE TOP CHECK FOR NEW LIFTING LEVEL, I.E.
C* ENTHALPY ACCESSION IN A STABLE LAYER.
C***
IF (jk.NE.1) THEN
DO jl=1,NI
IF (LO1(jl).AND.(ZHAC5(jl,jk) > 0.)) THEN
ZTC (jl,jk) = ZTE (jl,jk)
ZTC5(jl,jk) = ZTE5(jl,jk)
ZQC (jl,jk) = ZQE (jl,jk)
ZQC5(jl,jk) = ZQE5(jl,jk)
ENDIF
END DO
ENDIF
C***
END DO
C***
C* 3.3 ilab=0 UNLESS ilab=2
C* IKA INDICATES THE HIGHEST TOP OF A CLOUD
C* (TO AVOID UNNECESSARY COMPUTATIONS LATER).
C
IKA=NK+1
C
DO jk=1,NK
C
DO jl=1,NI
IF (ilab(jl,jk) == 1) ilab(jl,jk) = 0
END DO
C
IF (IKA == NK+1) THEN
IS=0
DO jl=1,NI
IS=IS+ilab(jl,jk)
END DO
IF (IS.NE.0) IKA=jk
ENDIF
C
END DO
C***
IF (IKA == NK+1) RETURN
C***
C ------------------------------------------------------------------
C
C* 4. TOTAL ENERGY ACCESSION
C ----- ------ ---------
C
C* 4.1 CALCULATE TOTAL ENTHALPY ACCESSIONS REQUIRING THAT
C* - TOTAL MOIST ENTHALPY ACCESSION BE > 0
C* - TOTAL DRY ENTHALPY ACCESSION BE < 0
C* IKB IS AN UPDATE OF IKA.
C
DO jl=1,NI
ZSHAC (jl,:) = 0.0
ZSHAC5(jl,:) = 0.0
ZSTAC (jl,:) = 0.0
ZSTAC5(jl,:) = 0.0
ZSDP (jl,:) = 0.0
ZSDP5(jl,:) = 0.0
END DO
C
DO jk=NK-1,IKA,-1
DO jl=1,NI
IF (ilab(jl,jk) == 2) THEN
ZSHAC (jl,jk) = ZSHAC (jl,jk+1)+ZHAC (jl,jk)
ZSHAC5(jl,jk) = ZSHAC5(jl,jk+1)+ZHAC5(jl,jk)
ZSTAC (jl,jk) = ZSTAC (jl,jk+1)+ZTAC (jl,jk)
ZSTAC5(jl,jk) = ZSTAC5(jl,jk+1)+ZTAC5(jl,jk)
ZSDP (jl,jk) = ZSDP (jl,jk+1)+ZDP (jl,jk)
ZSDP5(jl,jk) = ZSDP5(jl,jk+1)+ZDP5(jl,jk)
ENDIF
END DO
END DO
C
IKB=NK+1
C
DO jk=IKA,NK-1
jkm1=max0(jk-1,1)
C
DO jl=1,NI
IF ((ilab(jl,jk) == 2).AND.(ilab(jl,jkm1) == 2)) THEN
ZSHAC (jl,jk) = ZSHAC (jl,jkm1)
ZSHAC5(jl,jk) = ZSHAC5(jl,jkm1)
ZSTAC (jl,jk) = ZSTAC (jl,jkm1)
ZSTAC5(jl,jk) = ZSTAC5(jl,jkm1)
ZSDP (jl,jk) = ZSDP (jl,jkm1)
ZSDP5(jl,jk) = ZSDP5(jl,jkm1)
ENDIF
LO = ZSHAC5(jl,jk).GT.0. .and. ZSTAC5(jl,jk).LT.0.
& and. ZSDP5(jl,jk).GT.0.
IF (.not.LO) ilab(jl,jk) = 0
END DO
C
IF (IKB == NK+1) THEN
IS=0
DO jl=1,NI
IS=IS+ilab(jl,jk)
END DO
IF (IS.NE.0) IKB=jk
ENDIF
C
END DO
C***
IF (IKB == NK+1) RETURN
C***
C ------------------------------------------------------------------
C
C* 5. HEATING AND MOISTENING
C ----------------------
C
C* 5.1 COMPUTE THE TOTAL CLOUD-ENVIRONMENT ENTHALPY
C* DIFFERENCE IN CLOUD LAYERS.
C
DO jl=1,NI
ZSDH (jl,:)=0.
ZSDH5(jl,:)=0.
END DO
C
DO jk=NK-1,IKB,-1
DO jl=1,NI
ZTVC = ZTC (jl,jk)*(1.0 + DELTA*ZQC5(jl,jk)) +
* ZTC5(jl,jk)* DELTA*ZQC (jl,jk)
ZTVC5 = ZTC5(jl,jk)*(1.0 + DELTA*ZQC5(jl,jk))
ZDQ (jl,jk) = (ZQSE (jl,jk)-ZQE (jl,jk))*ZDP5(jl,jk) +
* (ZQSE5(jl,jk)-ZQE5(jl,jk))*ZDP (jl,jk)
ZDQ5(jl,jk) = (ZQSE5(jl,jk)-ZQE5(jl,jk))*ZDP5(jl,jk)
ZDT (jl,jk) = (ZTVC -ZTVE (jl,jk))*ZDP5(jl,jk) +
* (ZTVC5-ZTVE5(jl,jk))*ZDP (jl,jk)
ZDT5(jl,jk) = (ZTVC5-ZTVE5(jl,jk))*ZDP5(jl,jk)
ZDH = ZDT (jl,jk)+ZLDCP0(jl)*ZDQ (jl,jk)
ZDH5 = ZDT5(jl,jk)+ZLDCP0(jl)*ZDQ5(jl,jk)
IF (ilab(jl,jk) == 2) THEN
ZSDH (jl,jk) = ZSDH (jl,jk+1) + ZDH
ZSDH5(jl,jk) = ZSDH5(jl,jk+1) + ZDH5
ENDIF
END DO
END DO
C
DO jk=IKB+1,NK-1
DO jl=1,NI
IF ((ilab(jl,jk) == 2).AND.(ilab(jl,jk-1) == 2)) THEN
ZSDH (jl,jk)= ZSDH (jl,jk-1)
ZSDH5(jl,jk)= ZSDH5(jl,jk-1)
ENDIF
END DO
END DO
C
C* 5.2 COMPUTE CONVECTIVE HEATING AND MOISTENING.
C* ESTIMATE CONVECTIVE CLOUD FRACTION.
C
DO jk=IKB,NK-1
DO jl=1,NI
IF (ilab(jl,jk) == 0) THEN
ZQAC (jl,jk) = 0.0
ZQAC5(jl,jk) = 0.0
ZTAC (jl,jk) = 0.0
ZTAC5(jl,jk) = 0.0
ZSHAC (jl,jk) = 0.0
ZSHAC5(jl,jk) = 0.0
ENDIF
IF (ZSDH5(jl,jk) <= 0.) THEN
ZSDH (jl,jk) = 0.0
ZSDH5(jl,jk) = -1.0
ENDIF
C
ZK = ZSHAC (jl,jk)/ZSDH5(jl,jk) -
* ZSDH(jl,jk)*ZSHAC5(jl,jk)/ZSDH5(jl,jk)**2
ZK5 = ZSHAC5(jl,jk)/ZSDH5(jl,jk)
C
IF (LNOISE) THEN
CQT (jl,jk) = (ZK5*ZDQ (jl,jk)+ZK*ZDQ5(jl,jk)-ZQAC (jl,jk))/
* ZDP5(jl,jk) -
* ZDP(jl,jk)*(ZK5*ZDQ5(jl,jk)-ZQAC5(jl,jk))/
* ZDP5(jl,jk)**2
ELSE
CQT (jl,jk) = (-ZQAC (jl,jk))/
* ZDP5(jl,jk) -
* ZDP(jl,jk)*(ZK5*ZDQ5(jl,jk)-ZQAC5(jl,jk))/
* ZDP5(jl,jk)**2
ENDIF
CQT5(jl,jk) = (ZK5*ZDQ5(jl,jk)-ZQAC5(jl,jk))/ZDP5(jl,jk)
IF (LNOISE) THEN
CTT (jl,jk) = (ZK5*ZDT (jl,jk)+ZK*ZDT5(jl,jk)-ZTAC (jl,jk))/
* ZDP5(jl,jk) -
* ZDP(jl,jk)*(ZK5*ZDT5(jl,jk)-ZTAC5(jl,jk))/
* ZDP5(jl,jk)**2
ELSE
CTT (jl,jk) = (-ZTAC (jl,jk))/
* ZDP5(jl,jk) -
* ZDP(jl,jk)*(ZK5*ZDT5(jl,jk)-ZTAC5(jl,jk))/
* ZDP5(jl,jk)**2
ENDIF
CTT5(jl,jk) = (ZK5*ZDT5(jl,jk)-ZTAC5(jl,jk))/ZDP5(jl,jk)
C
ZPR (jl) = ZPR (jl) + CTT (jl,jk)/ZLDCP0(jl)*ZDP5(jl,jk) +
* CTT5(jl,jk)/ZLDCP0(jl)*ZDP (jl,jk)
ZPR5(jl) = ZPR5(jl) + CTT5(jl,jk)/ZLDCP0(jl)*ZDP5(jl,jk)
C
IF (DBDT5(jl) < ZK5) THEN
DBDT5(jl) = ZK5
ENDIF
C
END DO
END DO
C
C* STORE SURFACE PRECIPITATION
C
DO jl=1,NI
IF (ZTE5(jl,NK) > TRPL) THEN
CRR (jl) = ZPR (jl) / GRAV
CRR5(jl) = ZPR5(jl) / GRAV
ELSE
CSR (jl) = ZPR (jl) / GRAV
CSR5(jl) = ZPR5(jl) / GRAV
ENDIF
END DO
C
C* Convective cloud fraction (not yet linearized)
C
DO jl=1,NI
ZPR5(jl) = ZPR5(jl) / ( GRAV * 1.E3 )
IF (ZPR5(jl) < 1.0E-12) THEN
ZPR5(jl) = 1.0E-12
ENDIF
ZPR5(jl) = 2.5 + 0.125 * ALOG(ZPR5(jl))
IF (ZPR5(jl) < DBDT5(jl) * TAU) THEN
ZPR5(jl) = DBDT5(jl) * TAU
ENDIF
IF (ZPR5(jl) > 0.8) THEN
ZPR5(jl) = 0.8
ENDIF
END DO
C
DO jk=IKB,NK-1
DO jl=1,NI
IF (ilab(jl,jk) == 2) THEN
CCF5(jl,jk) = ZPR5(jl)
ELSE
CCF5(jl,jk) = 0.0
ENDIF
ZSIG5=(SIGMA(jl,jk)/0.8)**2
IF (ZSIG5 > 1.0) ZSIG5=1.0
CCF5(jl,jk) = CCF5(jl,jk) * ZSIG5
END DO
END DO
C
RETURN
END SUBROUTINE LIN_KUOSYM_TL