*IF DEF,A05_2A,OR,DEF,A05_2C,OR,DEF,A05_3B,OR,DEF,A05_3C AJX1F405.148
C ******************************COPYRIGHT****************************** GTS2F400.10189
C (c) CROWN COPYRIGHT 1995, METEOROLOGICAL OFFICE, All Rights Reserved. GTS2F400.10190
C GTS2F400.10191
C Use, duplication or disclosure of this code is subject to the GTS2F400.10192
C restrictions as set forth in the contract. GTS2F400.10193
C GTS2F400.10194
C Meteorological Office GTS2F400.10195
C London Road GTS2F400.10196
C BRACKNELL GTS2F400.10197
C Berkshire UK GTS2F400.10198
C RG12 2SZ GTS2F400.10199
C GTS2F400.10200
C If no contract has been raised with this copy of the code, the use, GTS2F400.10201
C duplication or disclosure of it is strictly prohibited. Permission GTS2F400.10202
C to do so must first be obtained in writing from the Head of Numerical GTS2F400.10203
C Modelling at the above address. GTS2F400.10204
C ******************************COPYRIGHT****************************** GTS2F400.10205
C GTS2F400.10206
CLL SUBROUTINE THETAR------------------------------------------------- THETAR1A.3
CLL THETAR1A.4
CLL PURPOSE : CALCULATES THE POTENTIAL TEMPERATURE OF THE DETRAINING THETAR1A.5
CLL AIR IN LAYER K AND ALSO THE DIFFERENCE IN THE THETAR1A.6
CLL WATER VAPOUR CONTENT OF THE DETRAINING AIR FROM THAT THETAR1A.7
CLL OF THE MEAN PARCEL IN LAYER K THETAR1A.8
CLL THETAR1A.9
CLL SUITABLE FOR SINGLE COLUMN MODEL USE THETAR1A.10
CLL THETAR1A.11
CLL CODE REWORKED FOR CRAY Y-MP BY D.GREGORY AUTUMN/WINTER 1989/90 THETAR1A.12
CLL THETAR1A.13
CLL MODEL MODIFICATION HISTORY FROM MODEL VERSION 3.0: THETAR1A.14
CLL VERSION DATE THETAR1A.15
CLL THETAR1A.16
CLL 4.1 6/6/96 Extra check added to ensure that API2F401.1
CLL negative values of parcel water API2F401.2
CLL content are not generated. API2F401.3
CLL Pete Inness. API2F401.4
CLL 4.5 Jul. 98 Kill the IBM specific lines (JCThil) AJC1F405.20
CLL PROGRAMMING STANDARDS : UNIFIED MODEL DOCUMENTATION PAPER NO. 4 THETAR1A.17
CLL VERSION NO. 1 THETAR1A.18
CLL THETAR1A.19
CLL LOGICAL COMPONENTS COVERED : P27 THETAR1A.20
CLL THETAR1A.21
CLL DOCUMENTATION : UNIFIED MODEL DOCUMENTATION PAPER P27 THETAR1A.22
CLL THETAR1A.23
CLLEND----------------------------------------------------------------- THETAR1A.24
C THETAR1A.25
C*L ARGUMENTS--------------------------------------------------------- THETAR1A.26
C THETAR1A.27
SUBROUTINE THETAR (NPNTS,THRK,QRK,XSQR,BGMK,THEK,QEK,QPK,QSEK, 1,1THETAR1A.28
* DQSK,BWKP1,EXK,PK) THETAR1A.29
C THETAR1A.30
IMPLICIT NONE THETAR1A.31
C THETAR1A.32
C---------------------------------------------------------------------- THETAR1A.33
C MODEL CONSTANTS THETAR1A.34
C---------------------------------------------------------------------- THETAR1A.35
C THETAR1A.36
*CALL C_EPSLON 
THETAR1A.37
C THETAR1A.38
C---------------------------------------------------------------------- THETAR1A.39
C VECTOR LENGTHS AND LOOP COUNTERS THETAR1A.40
C---------------------------------------------------------------------- THETAR1A.41
C THETAR1A.42
INTEGER NPNTS ! VECTOR LENGTH THETAR1A.46
C THETAR1A.47
INTEGER I ! LOOP COUNTER THETAR1A.48
C THETAR1A.49
C THETAR1A.50
C---------------------------------------------------------------------- THETAR1A.51
C VARIABLES THAT ARE INPUT THETAR1A.52
C---------------------------------------------------------------------- THETAR1A.53
C THETAR1A.54
REAL THEK(NPNTS) ! IN ENVIRONMENT POTENTIAL TEMPERATURE THETAR1A.55
! IN LAYER K (K) THETAR1A.56
C THETAR1A.57
REAL QEK(NPNTS) ! IN ENVIRONMENT MIXING RATIO THETAR1A.58
! IN LAYER K (KG/KG) THETAR1A.59
C THETAR1A.60
REAL QPK(NPNTS) ! IN PARCEL MIXING RATIO IN LAYER K THETAR1A.61
! (KG/KG) THETAR1A.62
C THETAR1A.63
REAL QSEK(NPNTS) ! IN SATURATION MIXING RATIO OF THE THETAR1A.64
! ENVIRONMENT IN LAYER K (KG/KG) THETAR1A.65
C THETAR1A.66
REAL DQSK(NPNTS) ! IN GRADIENT OF SATURATION MIXING RATIO THETAR1A.67
! WITH POTENTIAL TEMPERATURE FOR THE THETAR1A.68
! ENVIRONMENT OF LAYER K (KG/KG/K) THETAR1A.69
C THETAR1A.70
LOGICAL BGMK(NPNTS) ! IN MASK FOR PARCELS SATURATED IN LAYER K THETAR1A.71
C THETAR1A.72
LOGICAL BWKP1(NPNTS) ! IN MASK FOR POINTS AT WHICH CONDENSATE THETAR1A.73
! IS LIQUID IN LAYER K+1 THETAR1A.74
C THETAR1A.75
REAL EXK(NPNTS) ! IN EXNER RATIO FOR LEVEL K THETAR1A.76
C THETAR1A.77
REAL PK(NPNTS) ! IN PRESSURE AT LEVEL K (PA) THETAR1A.78
C THETAR1A.79
C THETAR1A.80
C---------------------------------------------------------------------- THETAR1A.81
C VARIABLES THAT ARE OUTPUT THETAR1A.82
C---------------------------------------------------------------------- THETAR1A.83
C THETAR1A.84
REAL THRK(NPNTS) ! OUT PARCEL DETRAINMENT POTENTIAL THETAR1A.85
! TEMPERATURE IN LAYER K (K) THETAR1A.86
C THETAR1A.87
REAL QRK(NPNTS) ! OUT PARCEL DETRAINMENT MIXING RATIO THETAR1A.88
! IN LAYER K (KG/KG) THETAR1A.89
C THETAR1A.90
REAL XSQR(NPNTS) ! OUT EXCESS WATER VAPOUR OF THETAR1A.91
! DETRAINING AIR (KG/KG) THETAR1A.92
C THETAR1A.93
C THETAR1A.94
C---------------------------------------------------------------------- THETAR1A.95
C VARIABLES THAT ARE DEFINED LOCALLY THETAR1A.96
C THETAR1A.97
REAL TT(NPNTS) ! TEMPORARY TEMPERATURE FOR CALCULATION THETAR1A.108
! OF SATURATION MIXING RATIO (K) THETAR1A.109
C THETAR1A.110
C THETAR1A.112
C---------------------------------------------------------------------- THETAR1A.113
C EXTERNAL ROUTINES CALLED THETAR1A.114
C---------------------------------------------------------------------- THETAR1A.115
C THETAR1A.116
EXTERNAL QSAT THETAR1A.117
C THETAR1A.118
C*---------------------------------------------------------------------- THETAR1A.119
C THETAR1A.120
DO 20 I=1,NPNTS THETAR1A.121
CL THETAR1A.122
CL---------------------------------------------------------------------- THETAR1A.123
CL CALCULATE THE POTENTIAL TEMPERATURE OF DETRAINING AIR THETAR1A.124
CL THETAR1A.125
CL UM DOCUMENTATION PAPER P27 THETAR1A.126
CL SECTION (6), EQUATION (26) THETAR1A.127
CL---------------------------------------------------------------------- THETAR1A.128
CL THETAR1A.129
IF (.NOT.BGMK(I)) THEN THETAR1A.130
THRK(I)=THEK(I) * (1. + C_VIRTUAL*QEK(I)) / THETAR1A.131
* (1. + C_VIRTUAL*QPK(I)) THETAR1A.132
ELSE THETAR1A.133
THRK(I) = THEK(I)*(1.0 + C_VIRTUAL*(QEK(I)-QSEK(I))/ THETAR1A.134
* (1.0 + C_VIRTUAL*THEK(I)*DQSK(I))) THETAR1A.135
ENDIF THETAR1A.136
CL THETAR1A.137
CL---------------------------------------------------------------------- THETAR1A.138
CL CALCULATE THE MIXING RATIO OF THE DETRAINING AIR AIR THE THETAR1A.139
CL DIFFERENCE BETWEEN THIS AND THE MIXING RATIO OF THE MEAN THETAR1A.140
CL PARCEL IN LAYER K THETAR1A.141
CL THETAR1A.142
CL THE MOISTURE DIFFERENCE IS USED TO CALCULATE THE THETAR1A.143
CL COND_DET_K TERM OF EQUATION (30), SECTION (6), THETAR1A.144
CL UM DOCUMENTATIONM PAPER P27 THETAR1A.145
CL---------------------------------------------------------------------- THETAR1A.146
CL THETAR1A.147
C THETAR1A.148
C----------------------------------------------------------------------- THETAR1A.149
C CONVERT POTENTIAL TEMPERATURE TO TEMPERATURE AND CALCULATE THETAR1A.150
C PRESSURE OF LAYER K FOR CALCULATION OF SATURATED THETAR1A.151
C MIXING RATIO THETAR1A.152
C----------------------------------------------------------------------- THETAR1A.153
C THETAR1A.154
TT(I) = THRK(I)*EXK(I) THETAR1A.155
20 CONTINUE THETAR1A.156
CALL QSAT (XSQR,TT,PK,NPNTS) THETAR1A.157
C THETAR1A.158
DO 30 I=1,NPNTS THETAR1A.159
CL---------------------------------------------------------------------- API2F401.5
CL SMALL NUMERICAL APPROXIMATIONS IN THE ABOVE CALCULATIONS CAN MEAN API2F401.6
CL THAT THE DETRAINING PARCEL IS NO LONGER SATURATED AT THRK. ADD A API2F401.7
CL CHECK TO SEE IF THE PARCEL IS STILL SATURATED, AND RESET BGMK TO API2F401.8
CL FALSE IF IT IS NOT. API2F401.9
CL--------------------------------------------------------------------- API2F401.10
IF(XSQR(I).GT.QPK(I))BGMK(I)=.FALSE. API2F401.11
API2F401.12
API2F401.13
IF (BGMK(I)) THEN THETAR1A.160
QRK(I) = XSQR(I) THETAR1A.161
XSQR(I) = QPK(I) - XSQR(I) THETAR1A.162
ELSE THETAR1A.163
QRK(I) = QPK(I) THETAR1A.164
XSQR(I) = 0. THETAR1A.165
ENDIF THETAR1A.166
30 CONTINUE THETAR1A.167
C THETAR1A.168
RETURN THETAR1A.169
END THETAR1A.170
*ENDIF THETAR1A.171