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