!copyright (C) 2001 MSC-RPN COMM %%%RPNKUO%%%
***S/P LIN_KUOSYM_AD
*
#include "phy_macros_f.h"
SUBROUTINE LIN_KUOSYM_AD ( CTT5,CQT5,ilab,CCF5,DBDT5,CRR5,CSR5, 1,7
+ 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.
*
* ================
* Adjoint 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 ( ZPP5 , REAL , (NI,NK))
AUTOMATIC ( ZDSG5 , 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 ( ZTC6 , REAL , (NI,NK))
AUTOMATIC ( ZQC6 , 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
AUTOMATIC ( ZTDIF6 , REAL , (NI,NK))
AUTOMATIC ( ZQDIF6 , REAL , (NI,NK))
AUTOMATIC ( ZCP6 , REAL , (NI,NK))
AUTOMATIC ( LLO1 , LOGICAL , (NI,NK))
AUTOMATIC ( LLO2 , LOGICAL , (NI,NK))
AUTOMATIC ( LLO3 , LOGICAL , (NI,NK))
AUTOMATIC ( LLO4 , LOGICAL , (NI,NK))
C
*
************************************************************************
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 ************************** TRAJECTORY *****************************
C
C
C* 2. PRELIMINARY COMPUTATIONS.
C ----------- -------------
C
C* 2.0 INITIALISATION OF OUTPUT FIELDS
C
ilab(:,:) = 0
CTT5(:,:) = 0.0
CQT5(:,:) = 0.0
CCF5(:,:) = 0.0
CRR5(:) = 0.0
CSR5(:) = 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
ZPP5(jl,jk)=SIGMA(jl,jk)*PSP5(jl)
ZDP5(jl,jk)=ZDSG5(jl,jk)*PSP5(jl)
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
ZESE5(jl,jk)=ZA1*EXP(ZA3*(ZTE5(jl,jk)-TRPL)/(ZTE5(jl,jk)-ZA4))
ZQSE5(jl,jk)=EPS1*ZESE5(jl,jk)/(ZPP5(jl,jk)-EPS2*ZESE5(jl,jk))
IF (ZQSE5(jl,jk) > QM5(jl,jk)) THEN
ZQE5(jl,jk) = QM5(jl,jk)
ELSE
ZQE5(jl,jk) = ZQSE5(jl,jk)
ENDIF
ZTVE5(jl,jk) = ZTE5(jl,jk)*(1.0 + DELTA*ZQE5(jl,jk))
C
ZTAC5(jl,jk)=(TP5(jl,jk)-TM5(jl,jk))*ZDP5(jl,jk)/TAU
ZQAC5(jl,jk)=(QP5(jl,jk)-ZQE5(jl,jk))*ZDP5(jl,jk)/TAU
C
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
ZTC5(jl,NK)=ZTE5(jl,NK)
ZQC5(jl,NK)=0.
IF (ZHAC5(jl,NK) > 0.) THEN
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
ZCP5(jl)=CPD*(1.+DELTA2*ZQC5(jl,jk+1))
ZCP6(jl,jk) = ZCP5(jl)
LLO1(jl,jk) = ZTC5(jl,jk+1) > ZTE5(jl,jk+1) ! store switch
IF ( ZTC5(jl,jk+1) > ZTE5(jl,jk+1) ) THEN
ZTDIF5 = ZTC5(jl,jk+1)-ZTE5(jl,jk+1)
ELSE
ZTDIF5 = 0.0
ENDIF
ZTDIF6(jl,jk) = ZTDIF5 ! extra storage for adjoint part
ZTC5(jl,jk)=ZTC5(jl,jk+1)+(GZM5(jl,jk+1)-GZM5(jl,jk))*
* (1./ZCP5(jl)+ENTRM*ZTDIF5)
LLO2(jl,jk) = ZQC5(jl,jk+1) > ZQE5(jl,jk+1) ! store switch
IF ( ZQC5(jl,jk+1) > ZQE5(jl,jk+1) ) THEN
ZQDIF5 = ZQC5(jl,jk+1)-ZQE5(jl,jk+1)
ELSE
ZQDIF5 = 0.0
ENDIF
ZQDIF6(jl,jk) = ZQDIF5 ! extra storage for adjoint part
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
ZP15(jl) = ZPP5(jl,jk)
ZT15(jl) = ZTC5(jl,jk)
ZQ15(jl) = ZQC5(jl,jk)
C
C* Store extra fields for the call of adjoint routine
C
ZTC6(jl,jk) = ZTC5 (jl,jk)
ZQC6(jl,jk) = ZQC5 (jl,jk)
C
END DO
C
CALL LIN_ADJTQ ( ZT15, ZQ15, ZP15, NI )
C
DO jl=1,NI
LO1(jl) = ZT15(jl) /= ZTC5(jl,jk)
ZTC5(jl,jk) = ZT15(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
LLO3(jl,jk) = ilab(jl,jk).EQ.0 ! store switch
IF (LO1(jl)) THEN
ZTC5(jl,jk) = ZTE5(jl,jk)
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
LLO4(jl,jk) = LO1(jl).AND.(ZHAC5(jl,jk) > 0.) ! store switch
IF (LO1(jl).AND.(ZHAC5(jl,jk) > 0.)) THEN
ZTC5(jl,jk) = ZTE5(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
ZSHAC5(jl,:) = 0.0
ZSTAC5(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
ZSHAC5(jl,jk) = ZSHAC5(jl,jk+1)+ZHAC5(jl,jk)
ZSTAC5(jl,jk) = ZSTAC5(jl,jk+1)+ZTAC5(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
ZSHAC5(jl,jk) = ZSHAC5(jl,jkm1)
ZSTAC5(jl,jk) = ZSTAC5(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
ZSDH5(jl,:)=0.
END DO
C
DO jk=NK-1,IKB,-1
DO jl=1,NI
ZTVC5 = ZTC5(jl,jk)*(1.0 + DELTA*ZQC5(jl,jk))
ZDQ5(jl,jk) = (ZQSE5(jl,jk)-ZQE5(jl,jk))*ZDP5(jl,jk)
ZDT5(jl,jk) = (ZTVC5-ZTVE5(jl,jk))*ZDP5(jl,jk)
ZDH5 = ZDT5(jl,jk)+ZLDCP0(jl)*ZDQ5(jl,jk)
IF (ilab(jl,jk) == 2) THEN
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
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
ZQAC5(jl,jk) = 0.0
ZTAC5(jl,jk) = 0.0
ZSHAC5(jl,jk) = 0.0
ENDIF
IF (ZSDH5(jl,jk) <= 0.) THEN
ZSDH5(jl,jk) = -1.0
ENDIF
C
ZK5 = ZSHAC5(jl,jk)/ZSDH5(jl,jk)
C
CQT5(jl,jk) = (ZK5*ZDQ5(jl,jk)-ZQAC5(jl,jk))/ZDP5(jl,jk)
CTT5(jl,jk) = (ZK5*ZDT5(jl,jk)-ZTAC5(jl,jk))/ZDP5(jl,jk)
C
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
CRR5(jl) = ZPR5(jl) / GRAV
ELSE
CSR5(jl) = ZPR5(jl) / GRAV
ENDIF
END DO
C
C* Convective cloud fraction
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
C **************************** ADJOINT ****************************
C
C
C 1.0 INITIALISATION OF LOCAL ARRAYS AND VARIABLES
C --------------------------------------------
C
ZTVC = 0.0
ZK = 0.0
ZDH = 0.0
ZTDIF = 0.0
ZQDIF = 0.0
C
ZCP (:) = 0.0
ZPR (:) = 0.0
ZT1 (:) = 0.0
ZQ1 (:) = 0.0
ZP1 (:) = 0.0
C
ZPP (:,:) = 0.0
ZDP (:,:) = 0.0
ZSDP (:,:) = 0.0
ZQAC (:,:) = 0.0
ZTAC (:,:) = 0.0
ZSTAC (:,:) = 0.0
ZHAC (:,:) = 0.0
ZSHAC (:,:) = 0.0
ZQSE (:,:) = 0.0
ZTC (:,:) = 0.0
ZQC (:,:) = 0.0
ZTE (:,:) = 0.0
ZQE (:,:) = 0.0
ZTVE (:,:) = 0.0
ZDQ (:,:) = 0.0
ZDT (:,:) = 0.0
ZSDH (:,:) = 0.0
ZESE (:,:) = 0.0
C
C* STORE SURFACE PRECIPITATION
C
DO jl=1,NI
IF (ZTE5(jl,NK) > TRPL) THEN
ZPR (jl) = ZPR(jl) + CRR(jl) / GRAV
CRR (jl) = 0.0
ELSE
ZPR (jl) = ZPR(jl) + CSR(jl) / GRAV
CSR (jl) = 0.0
ENDIF
END DO
C ------------------------------------------------------------------
C
C* 5. HEATING AND MOISTENING
C ----------------------
CC
C* 5.2 COMPUTE CONVECTIVE HEATING AND MOISTENING.
C* ESTIMATE CONVECTIVE CLOUD FRACTION.
C
DO jk=NK-1,IKB,-1
DO jl=1,NI
C
ZK5 = ZSHAC5(jl,jk)/ZSDH5(jl,jk)
C
CTT (jl,jk) = CTT (jl,jk) + ZPR (jl)/ZLDCP0(jl)*ZDP5(jl,jk)
ZDP (jl,jk) = ZDP (jl,jk) + ZPR (jl)*CTT5(jl,jk)/ZLDCP0(jl)
C
IF (LNOISE) THEN
ZDT (jl,jk) = ZDT (jl,jk) + CTT (jl,jk)*ZK5/ZDP5(jl,jk)
ZK = ZK + CTT (jl,jk)*ZDT5(jl,jk)/ZDP5(jl,jk)
ENDIF
ZTAC (jl,jk) = ZTAC (jl,jk) - CTT (jl,jk)/ZDP5(jl,jk)
ZDP (jl,jk) = ZDP (jl,jk) - CTT (jl,jk)*
* (ZK5*ZDT5(jl,jk)-ZTAC5(jl,jk))/ZDP5(jl,jk)**2
CTT (jl,jk) = 0.0
IF (LNOISE) THEN
ZDQ (jl,jk) = ZDQ (jl,jk) + CQT (jl,jk)*ZK5/ZDP5(jl,jK)
ZK = ZK + CQT (jl,jk)*ZDQ5(jl,jk)/ZDP5(jl,jk)
ENDIF
ZQAC (jl,jk) = ZQAC (jl,jk) - CQT (jl,jk)/ZDP5(jl,jk)
ZDP (jl,jk) = ZDP (jl,jk) - CQT (jl,jk)*
* (ZK5*ZDQ5(jl,jk)-ZQAC5(jl,jk))/ZDP5(jl,jk)**2
CQT(jl,jk) = 0.0
C
ZSHAC (jl,jk) = ZSHAC (jl,jk) + ZK/ZSDH5(jl,jk)
ZSDH(jl,jk) = ZSDH(jl,jk) - ZK*ZSHAC5(jl,jk)/ZSDH5(jl,jk)**2
ZK = 0.0
C
IF (ZSDH5(jl,jk) <= 0.) THEN
ZSDH (jl,jk) = 0.0
ENDIF
IF (ilab(jl,jk) == 0) THEN
ZQAC (jl,jk) = 0.0
ZTAC (jl,jk) = 0.0
ZSHAC (jl,jk) = 0.0
ENDIF
C
END DO
END DO
C
C* 5.1 COMPUTE THE TOTAL CLOUD-ENVIRONMENT ENTHALPY
C* DIFFERENCE IN CLOUD LAYERS.
C
DO jk=NK-1,IKB+1,-1
DO jl=1,NI
IF ((ilab(jl,jk) == 2).AND.(ilab(jl,jk-1) == 2)) THEN
ZSDH (jl,jk-1) = ZSDH (jl,jk-1) + ZSDH (jl,jk)
ZSDH (jl,jk)= 0.0
ENDIF
END DO
END DO
C
DO jk=IKB,NK-1
DO jl=1,NI
ZTVC5 = ZTC5(jl,jk)*(1.0 + DELTA*ZQC5(jl,jk))
IF (ilab(jl,jk) == 2) THEN
ZDH = ZDH + ZSDH (jl,jk)
ZSDH (jl,jk+1)= ZSDH (jl,jk+1) + ZSDH (jl,jk)
ZSDH (jl,jk) = 0.0
ENDIF
ZDT (jl,jk) = ZDT (jl,jk) + ZDH
ZDQ (jl,jk) = ZDQ (jl,jk) + ZDH*ZLDCP0(jl)
ZDH = 0.0
ZTVC = ZTVC + ZDT (jl,jk)*ZDP5(jl,jk)
ZTVE (jl,jk) = ZTVE (jl,jk) - ZDT (jl,jk)*ZDP5(jl,jk)
ZDP (jl,jk) = ZDP (jl,jk) + ZDT (jl,jk)*(ZTVC5-ZTVE5(jl,jk))
ZDT (jl,jk) = 0.0
ZQSE (jl,jk) = ZQSE(jl,jk) + ZDQ (jl,jk)*ZDP5(jl,jk)
ZQE (jl,jk) = ZQE (jl,jk) - ZDQ(jl,jk)*ZDP5(jl,jk)
ZDP (jl,jk) = ZDP (jl,jk) + ZDQ (jl,jk)*
* (ZQSE5(jl,jk)-ZQE5(jl,jk))
ZDQ (jl,jk) = 0.0
ZTC (jl,jk) = ZTC (jl,jk) + ZTVC*(1.0 + DELTA*ZQC5(jl,jk))
ZQC (jl,jk) = ZQC (jl,jk) + ZTVC*DELTA*ZTC5(jl,jk)
ZTVC = 0.0
END DO
END DO
C
DO jl=1,NI
ZSDH (jl,:)=0.
END DO
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 jk=NK-1,IKA,-1
jkm1=max0(jk-1,1)
C
DO jl=1,NI
IF ((ilab(jl,jk) == 2).AND.(ilab(jl,jkm1) == 2)) THEN
ZSDP (jl,jkm1) = ZSDP (jl,jkm1) + ZSDP (jl,jk)
ZSDP (jl,jk) = 0.0
ZSTAC (jl,jkm1) = ZSTAC (jl,jkm1) + ZSTAC (jl,jk)
ZSTAC (jl,jk) = 0.0
ZSHAC (jl,jkm1) = ZSHAC (jl,jkm1) + ZSHAC (jl,jk)
ZSHAC (jl,jk) = 0.0
ENDIF
END DO
END DO
DO jk=IKA,NK-1
DO jl=1,NI
IF (ilab(jl,jk) == 2) THEN
ZSDP (jl,jk+1) = ZSDP (jl,jk+1) + ZSDP (jl,jk)
ZDP (jl,jk) = ZDP (jl,jk) + ZSDP (jl,jk)
ZSDP (jl,jk) = 0.0
ZSTAC (jl,jk+1) = ZSTAC (jl,jk+1) + ZSTAC (jl,jk)
ZTAC (jl,jk) = ZTAC (jl,jk) + ZSTAC (jl,jk)
ZSTAC (jl,jk) = 0.0
ZSHAC (jl,jk+1) = ZSHAC (jl,jk+1) + ZSHAC (jl,jk)
ZHAC (jl,jk) = ZHAC (jl,jk) + ZSHAC (jl,jk)
ZSHAC (jl,jk) = 0.0
ENDIF
END DO
END DO
C
DO jl=1,NI
ZSHAC (jl,:) = 0.0
ZSTAC (jl,:) = 0.0
ZSDP (jl,:) = 0.0
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=1,NK-1
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 ( LLO4(jl,jk) ) THEN
ZTE (jl,jk) = ZTE (jl,jk) + ZTC (jl,jk)
ZTC (jl,jk) = 0.0
ZQE (jl,jk) = ZQE (jl,jk) + ZQC (jl,jk)
ZQC (jl,jk) = 0.0
ENDIF
END DO
ENDIF
C
DO jl=1,NI
IF ( LLO3(jl,jk) ) THEN
ZTE (jl,jk) = ZTE (jl,jk) + ZTC (jl,jk)
ZTC (jl,jk) = 0.0
ZQC (jl,jk) = 0.0
ENDIF
END DO
C
DO jl=1,NI
ZT1 (jl) = ZT1 (jl) + ZTC (jl,jk)
ZTC (jl,jk) = 0.0
ZQ1 (jl) = ZQ1 (jl) + ZQC (jl,jk)
ZQC (jl,jk) = 0.0
ENDDO
C
C* Set-up correct trajectory inputs before adjoint call
C
DO jl=1,NI
ZT15(jl) = ZTC6 (jl,jk)
ZQ15(jl) = ZQC6 (jl,jk)
ZP15(jl) = ZPP5 (jl,jk)
END DO
C
CALL LIN_ADJTQ_AD ( ZT15, ZQ15, ZP15, ZT1, ZQ1, ZP1, NI )
C
DO jl=1,NI
ZQC (jl,jk) = ZQC (jl,jk) + ZQ1 (jl)
ZQ1 (jl) = 0.0
ZTC (jl,jk) = ZTC (jl,jk) + ZT1 (jl)
ZT1 (jl) = 0.0
ZPP (jl,jk) = ZPP (jl,jk) + ZP1 (jl)
ZP1 (jl) = 0.0
END DO
C
DO jl=1,NI
ZTDIF5 = ZTDIF6 (jl,jk)
ZQDIF5 = ZQDIF6 (jl,jk)
ZCP5(jl) = ZCP6(jl,jk)
C
ZQC (jl,jk+1) = ZQC (jl,jk+1) + ZQC (jl,jk)
GZM (jl,jk+1) = GZM (jl,jk+1) + ZQC (jl,jk)*ENTRM*ZQDIF5
GZM (jl,jk) = GZM (jl,jk) - ZQC (jl,jk)*ENTRM*ZQDIF5
ZQDIF = ZQDIF + ZQC (jl,jk)*ENTRM*(GZM5(jl,jk+1)-GZM5(jl,jk))
ZQC (jl,jk) = 0.0
IF ( LLO2(jl,jk) ) THEN
ZQC (jl,jk+1) = ZQC (jl,jk+1) + ZQDIF
ZQE (jl,jk+1) = ZQE (jl,jk+1) - ZQDIF
ZQDIF = 0.0
ELSE
ZQDIF = 0.0
ENDIF
ZTC (jl,jk+1) = ZTC (jl,jk+1) + ZTC (jl,jk)
GZM (jl,jk+1) = GZM (jl,jk+1) + ZTC (jl,jk)*
* (1./ZCP5(jl)+ENTRM*ZTDIF5)
GZM (jl,jk) = GZM (jl,jk) - ZTC (jl,jk)*
* (1./ZCP5(jl)+ENTRM*ZTDIF5)
ZCP (jl) = ZCP (jl) - ZTC (jl,jk)*
* (GZM5(jl,jk+1)-GZM5(jl,jk))/ZCP5(jl)**2
ZTDIF = ZTDIF + ZTC (jl,jk)*ENTRM*
* (GZM5(jl,jk+1)-GZM5(jl,jk))
ZTC (jl,jk) = 0.0
IF ( LLO1(jl,jk) ) THEN
ZTC (jl,jk+1) = ZTC (jl,jk+1) + ZTDIF
ZTE (jl,jk+1) = ZTE (jl,jk+1) - ZTDIF
ZTDIF = 0.0
ELSE
ZTDIF = 0.0
ENDIF
ZQC (jl,jk+1) = ZQC (jl,jk+1) + ZCP (jl)*CPD*DELTA2
ZCP (jl) = 0.0
END DO
C***
END DO
C***
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
IF (ZHAC5(jl,NK) > 0.) THEN
ZQE (jl,NK) = ZQE (jl,NK) + ZQC (jl,NK)
ZQC (jl,NK) = 0.0
ENDIF
ZTE (jl,NK) = ZTE (jl,NK) + ZTC (jl,NK)
ZTC (jl,NK) = 0.0
ZQC (jl,NK) = 0.0
END DO
C
C
C* 2.1 ENVIRONMENTAL PROFILES AND PARAMETERS,
C* DRY AND MOIST ENTHALPY ACCESSIONS (divided by cp)
C* AND INITIALIZATIONS.
C
C
DO jk=NK,1,-1
DO jl=1,NI
IF (ZTE5(jl,jk) > TRPL) THEN
ZA3=17.269
ZA4=35.860
ELSE
ZA3=21.875
ZA4= 7.660
ENDIF
ZTAC (jl,jk) = ZTAC (jl,jk) + ZHAC (jl,jk)
ZQAC (jl,jk) = ZQAC (jl,jk) + ZHAC (jl,jk)*ZLDCP0(jl)
ZHAC (jl,jk) = 0.0
QP (jl,jk) = QP (jl,jk) + ZQAC (jl,jk)*ZDP5(jl,jk)/TAU
ZQE (jl,jk) = ZQE (jl,jk) - ZQAC (jl,jk)*ZDP5(jl,jk)/TAU
ZDP (jl,jk) = ZDP (jl,jk) + ZQAC (jl,jk)*
* (QP5(jl,jk)-ZQE5(jl,jk))/TAU
ZQAC (jl,jk) = 0.0
TP (jl,jk) = TP (jl,jk) + ZTAC (jl,jk)*ZDP5(jl,jk)/TAU
TM (jl,jk) = TM (jl,jk) - ZTAC (jl,jk)*ZDP5(jl,jk)/TAU
ZDP (jl,jk) = ZDP (jl,jk) + ZTAC (jl,jk)*
* (TP5(jl,jk)-TM5(jl,jk))/TAU
ZTAC (jl,jk) = 0.0
ZTE (jl,jk) = ZTE (jl,jk) + ZTVE (jl,jk)*
* (1.0 + DELTA*ZQE5(jl,jk))
ZQE (jl,jk) = ZQE (jl,jk) + ZTVE (jl,jk)*DELTA*ZTE5(jl,jk)
ZTVE (jl,jk) = 0.0
IF (ZQSE5(jl,jk) > QM5(jl,jk)) THEN
QM (jl,jk) = QM (jl,jk) + ZQE (jl,jk)
ZQE (jl,jk) = 0.0
ELSE
ZQSE (jl,jk) = ZQSE (jl,jk) + ZQE (jl,jk)
ZQE (jl,jk) = 0.0
ENDIF
ZESE (jl,jk) = ZESE (jl,jk) + ZQSE (jl,jk)*EPS1*ZPP5(jl,jk)/
* ((ZPP5(jl,jk)-EPS2*ZESE5(jl,jk))**2)
ZPP (jl,jk) = ZPP (jl,jk) - ZQSE (jl,jk)*EPS1*ZESE5(jl,jk)/
* ((ZPP5(jl,jk)-EPS2*ZESE5(jl,jk))**2)
ZQSE (jl,jk) = 0.0
ZTE (jl,jk) = ZTE (jl,jk) + ZESE(jl,jk)*ZA1*ZA3*(TRPL-ZA4)/
* ((ZTE5(jl,jk)-ZA4)**2)*
* EXP(ZA3*(ZTE5(jl,jk)-TRPL)/(ZTE5(jl,jk)-ZA4))
ZESE (jl,jk) = 0.0
C
TP (jl,jk) = TP (jl,jk) + ZTE (jl,jk)
ZTE (jl,jk) = 0.0
PSP (jl) = PSP (jl) + ZDSG5(jl,jk)*ZDP (jl,jk)
ZDP (jl,jk) = 0.0
PSP (jl) = PSP (jl) + SIGMA(jl,jk)*ZPP (jl,jk)
ZPP (jl,jk) = 0.0
C
END DO
END DO
C
C* 2.0 INITIALISATION OF OUTPUT FIELDS
C
CTT (:,:) = 0.0
CQT (:,:) = 0.0
CRR (:) = 0.0
CSR (:) = 0.0
ZPR (:) = 0.0
C
RETURN
END SUBROUTINE LIN_KUOSYM_AD