*IF DEF,A10_1C THETLQ1C.2
C ******************************COPYRIGHT****************************** THETLQ1C.3
C (c) CROWN COPYRIGHT 1997, METEOROLOGICAL OFFICE, All Rights Reserved. THETLQ1C.4
C THETLQ1C.5
C Use, duplication or disclosure of this code is subject to the THETLQ1C.6
C restrictions as set forth in the contract. THETLQ1C.7
C THETLQ1C.8
C Meteorological Office THETLQ1C.9
C London Road THETLQ1C.10
C BRACKNELL THETLQ1C.11
C Berkshire UK THETLQ1C.12
C RG12 2SZ THETLQ1C.13
C THETLQ1C.14
C If no contract has been raised with this copy of the code, the use, THETLQ1C.15
C duplication or disclosure of it is strictly prohibited. Permission THETLQ1C.16
C to do so must first be obtained in writing from the Head of Numerical THETLQ1C.17
C Modelling at the above address. THETLQ1C.18
C ******************************COPYRIGHT****************************** THETLQ1C.19
C THETLQ1C.20
CLL SUBROUTINE THETL_QT ----------------------------------------- THETLQ1C.21
CLL THETLQ1C.22
CLL PURPOSE: CALCULATES THETAL AND QT FROM THETA,Q, AND QC USING THETLQ1C.23
CLL EQUATIONS (10) AND (11),SUBTRACTS THETA_REF FROM THETAL. THETLQ1C.24
CLL NOT SUITABLE FOR I.B.M USE. THETLQ1C.25
CLL WAS VERSION FOR CRAY Y-MP THETLQ1C.26
CLL THETLQ1C.27
CLL WRITTEN BY M.H MAWSON. THETLQ1C.28
CLL THETLQ1C.29
CLL MODEL MODIFICATION HISTORY: THETLQ1C.30
CLL VERSION DATE THETLQ1C.31
!LL 4.4 07/10/97 New version optimised for T3E THETLQ1C.32
!LL Not bit-reproducible with THETLQ1A THETLQ1C.33
CLL THETLQ1C.34
CLL PROGRAMMING STANDARD: THETLQ1C.35
CLL THETLQ1C.36
CLL SYSTEM COMPONENTS COVERED: P192 THETLQ1C.37
CLL THETLQ1C.38
CLL SYSTEM TASK: P1 THETLQ1C.39
CLL THETLQ1C.40
CLL DOCUMENTATION: EQUATIONS (10) AND (11) THETLQ1C.41
CLL IN UNIFIED MODEL DOCUMENTATION PAPER THETLQ1C.42
CLL NO. 10 M.J.P. CULLEN,T.DAVIES AND M.H.MAWSON THETLQ1C.43
CLL THETLQ1C.44
CLLEND------------------------------------------------------------- THETLQ1C.45
THETLQ1C.46
C*L ARGUMENTS:--------------------------------------------------- THETLQ1C.47
SUBROUTINE THETL_QT 8THETLQ1C.48
1 (PSTAR,THETA,Q,QCL,QCF,P_EXNER,AKH,BKH, THETLQ1C.49
2 P_FIELD,P_LEVELS,Q_LEVELS) THETLQ1C.50
THETLQ1C.51
IMPLICIT NONE THETLQ1C.52
THETLQ1C.53
INTEGER THETLQ1C.54
* P_FIELD !IN DIMENSION OF FIELDS ON PRESSURE GRID THETLQ1C.55
*, P_LEVELS !IN NUMBER OF MODEL LEVELS. THETLQ1C.56
*, Q_LEVELS !IN NUMBER OF MOIST MODEL LEVELS. THETLQ1C.57
THETLQ1C.58
REAL THETLQ1C.59
* PSTAR(P_FIELD) !IN PSTAR FIELD THETLQ1C.60
*,THETA(P_FIELD,P_LEVELS) !INOUT THETA FIELD IN, THETAL OUT. THETLQ1C.61
*,Q(P_FIELD,Q_LEVELS) !INOUT Q FIELD IN, QT FIELD OUT. THETLQ1C.62
THETLQ1C.63
REAL THETLQ1C.64
* QCL(P_FIELD,Q_LEVELS) !IN QCL FIELD. THETLQ1C.65
*,QCF(P_FIELD,Q_LEVELS) !IN QCF FIELD. THETLQ1C.66
*,P_EXNER(P_FIELD,P_LEVELS+1) !IN Exner Pressure on half levels. THETLQ1C.67
*,AKH(P_LEVELS+1) !IN Hybrid Coords. A and B values THETLQ1C.68
*,BKH(P_LEVELS+1) !IN for half levels. THETLQ1C.69
C*--------------------------------------------------------------------- THETLQ1C.70
THETLQ1C.71
C*L DEFINE ARRAYS AND VARIABLES USED IN THIS ROUTINE----------------- THETLQ1C.72
C DEFINE LOCAL ARRAYS: NONE ARE REQUIRED THETLQ1C.73
THETLQ1C.74
C*--------------------------------------------------------------------- THETLQ1C.75
C DEFINE LOCAL VARIABLES THETLQ1C.76
THETLQ1C.77
REAL THETLQ1C.78
* P_EXNER_FULL_R !HOLDS RECIP EXNER PRESSURE AT FULL LEVEL. THETLQ1C.79
* ,PKP1,PK !Pressures at half levels k+1 and k. THETLQ1C.80
THETLQ1C.81
C COUNT VARIABLES FOR DO LOOPS ETC. THETLQ1C.82
INTEGER THETLQ1C.83
* I,K THETLQ1C.84
THETLQ1C.85
C*L NO EXTERNAL SUBROUTINE CALLS:------------------------------------ THETLQ1C.86
C*--------------------------------------------------------------------- THETLQ1C.87
CL CALL COMDECK TO GET CONSTANTS USED. THETLQ1C.88
THETLQ1C.89
*CALL C_THETLQ 
THETLQ1C.90
THETLQ1C.91
CL MAXIMUM VECTOR LENGTH ASSUMED IS P_FIELD THETLQ1C.92
CL--------------------------------------------------------------------- THETLQ1C.93
CL INTERNAL STRUCTURE. THETLQ1C.94
CL--------------------------------------------------------------------- THETLQ1C.95
CL THETLQ1C.96
*CALL P_EXNERC THETLQ1C.97
THETLQ1C.98
CL--------------------------------------------------------------------- THETLQ1C.99
CL SECTION 1. CALCULATE THETAL AND QT. THETLQ1C.100
CL--------------------------------------------------------------------- THETLQ1C.101
THETLQ1C.102
CL LOOP OVER MOIST LEVELS IE: Q_LEVELS. THETLQ1C.103
THETLQ1C.104
DO 100 K=1,Q_LEVELS THETLQ1C.105
THETLQ1C.106
CFPP$ SELECT(CONCUR) THETLQ1C.107
cdir$ nosplit THETLQ1C.108
THETLQ1C.109
DO 110 I= 1,P_FIELD THETLQ1C.110
THETLQ1C.111
PKP1 = AKH(K+1) + BKH(K+1)*PSTAR(I) THETLQ1C.112
PK = AKH(K) + BKH(K) *PSTAR(I) THETLQ1C.113
P_EXNER_FULL_R = R_P_EXNER_C THETLQ1C.114
* (P_EXNER(I,K+1),P_EXNER(I,K),PKP1,PK,KAPPA) THETLQ1C.115
Q(I,K) = Q(I,K) + QCL(I,K) + QCF(I,K) THETLQ1C.116
THETA(I,K) = THETA(I,K) - (LC*QCL(I,K)+(LC+LF)*QCF(I,K)) THETLQ1C.117
* *P_EXNER_FULL_R/CP THETLQ1C.118
110 CONTINUE THETLQ1C.119
THETLQ1C.120
CL END LOOP OVER MOIST LEVELS. THETLQ1C.121
100 CONTINUE THETLQ1C.122
THETLQ1C.123
CL END OF ROUTINE THETL_QT THETLQ1C.124
THETLQ1C.125
RETURN THETLQ1C.126
END THETLQ1C.127
*ENDIF THETLQ1C.128