*IF DEF,A05_2A,OR,DEF,A05_2C AJX1F405.132
C ******************************COPYRIGHT****************************** GTS2F400.5275
C (c) CROWN COPYRIGHT 1995, METEOROLOGICAL OFFICE, All Rights Reserved. GTS2F400.5276
C GTS2F400.5277
C Use, duplication or disclosure of this code is subject to the GTS2F400.5278
C restrictions as set forth in the contract. GTS2F400.5279
C GTS2F400.5280
C Meteorological Office GTS2F400.5281
C London Road GTS2F400.5282
C BRACKNELL GTS2F400.5283
C Berkshire UK GTS2F400.5284
C RG12 2SZ GTS2F400.5285
C GTS2F400.5286
C If no contract has been raised with this copy of the code, the use, GTS2F400.5287
C duplication or disclosure of it is strictly prohibited. Permission GTS2F400.5288
C to do so must first be obtained in writing from the Head of Numerical GTS2F400.5289
C Modelling at the above address. GTS2F400.5290
C ******************************COPYRIGHT****************************** GTS2F400.5291
C GTS2F400.5292
CLL SUBROUTINE LIFT_PAR----------------------------------------------- LIFPAR1A.3
CLL LIFPAR1A.4
CLL PURPOSE : LIFTS THE PARCEL FROM LAYER K TO K+1 LIFPAR1A.5
CLL TAKING ENTRAINEMNT AND MOIST PROCESSES INTO ACOUNT LIFPAR1A.6
CLL LIFPAR1A.7
CLL SUBROUTINE LATENT_H CALCULATES THE MOIST PROCESSES LIFPAR1A.8
CLL LIFPAR1A.9
CLL SUITABLE FOR SINGLE COLUMN MODEL USE LIFPAR1A.10
CLL LIFPAR1A.11
CLL CODE REWORKED FOR CRAY Y-MP BY D.GREGORY AUTUMN/WINTER 1989/90 LIFPAR1A.12
CLL LIFPAR1A.13
CLL MODEL MODIFICATION HISTORY FROM MODEL VERSION 3.0: LIFPAR1A.14
CLL VERSION DATE LIFPAR1A.15
CLL 4.5 Jul. 98 Kill the IBM specific lines (JCThil) AJC1F405.13
CLL LIFPAR1A.16
CLL PROGRAMMING STANDARDS : UNIFIED MODEL DOCUMENTATION PAPER NO. 4 LIFPAR1A.17
CLL VERSION NO. 1 LIFPAR1A.18
CLL LIFPAR1A.19
CLL LOGICAL COMPONENTS COVERED: P27 LIFPAR1A.20
CLL LIFPAR1A.21
CLL DOCUMENTATION : UNIFIED MODEL DOCUMENTATION PAPER NO. ## LIFPAR1A.22
CLL LIFPAR1A.23
CLLEND----------------------------------------------------------------- LIFPAR1A.24
C LIFPAR1A.25
C*L ARGUMENTS--------------------------------------------------------- LIFPAR1A.26
C LIFPAR1A.27
SUBROUTINE LIFT_PAR (NPNTS,THPKP1,QPKP1,XSQKP1,BGMKP1,BWKP1, 10,6LIFPAR1A.28
* THPK,QPK,THEKP1,QEKP1,THEK,QEK,QSEKP1, LIFPAR1A.29
* DQSKP1,PKP1,EXKP1,EKP14,EKP34) LIFPAR1A.30
C LIFPAR1A.31
IMPLICIT NONE LIFPAR1A.32
C LIFPAR1A.33
C---------------------------------------------------------------------- LIFPAR1A.34
C VECTOR LENGTHS AND LOOP COUNTERS LIFPAR1A.35
C---------------------------------------------------------------------- LIFPAR1A.36
C LIFPAR1A.37
INTEGER NPNTS ! IN VECTOR LENGTH LIFPAR1A.41
C LIFPAR1A.42
INTEGER I ! LOOP COUNTER LIFPAR1A.43
C LIFPAR1A.44
C---------------------------------------------------------------------- LIFPAR1A.45
C VARAIBLES WHICH ARE INPUT LIFPAR1A.46
C---------------------------------------------------------------------- LIFPAR1A.47
C LIFPAR1A.48
REAL THEK(NPNTS) ! IN POTENTIAL TEMPERATURE OF CLOUD LIFPAR1A.49
! ENVIRONMENT IN LAYER K (K) LIFPAR1A.50
C LIFPAR1A.51
REAL THEKP1(NPNTS) ! IN POTENTIAL TEMPERATURE OF CLOUD LIFPAR1A.52
! ENVIRONMENT IN LAYER K+1 (K) LIFPAR1A.53
C LIFPAR1A.54
REAL QEK(NPNTS) ! IN MIXING RATIO OF CLOUD LIFPAR1A.55
! ENVIRONMENT IN LAYER K (KG/KG) LIFPAR1A.56
C LIFPAR1A.57
REAL QEKP1(NPNTS) ! IN MIXING RATIO OF CLOUD LIFPAR1A.58
! ENVIRONMENT IN LAYER K+1 (KG/KG) LIFPAR1A.59
C LIFPAR1A.60
REAL QSEKP1(NPNTS) ! IN SATURATION MIXING RATIO OF CLOUD LIFPAR1A.61
! ENVIRONMENT IN LAYER K+1 (KG/KG) LIFPAR1A.62
C LIFPAR1A.63
REAL DQSKP1(NPNTS) ! IN GRADIENT OF SATURATION MIXING RATIO LIFPAR1A.64
! WITH POTENTIAL TEMPERATURE FOR THE LIFPAR1A.65
! CLOUD ENVIRONMENT IN LAYER K+1 LIFPAR1A.66
! (KG/KG/K) LIFPAR1A.67
C LIFPAR1A.68
REAL THPK(NPNTS) ! IN PARCEL POTENTIAL TEMPERATURE IN LIFPAR1A.69
! LAYER K (K) LIFPAR1A.70
C LIFPAR1A.71
REAL QPK(NPNTS) ! IN PARCEL MIXING RATIO IN LAYER K (KG/KG) LIFPAR1A.72
C LIFPAR1A.73
LOGICAL BWKP1(NPNTS) ! IN MASK FOR WHETHER CONDENSATE IS LIFPAR1A.74
! LIQUID IN LAYER K+1 LIFPAR1A.75
C LIFPAR1A.76
REAL PKP1(NPNTS) ! IN PRESSURE AT LEVEL K+1 (PA) LIFPAR1A.77
C LIFPAR1A.78
REAL EXKP1(NPNTS) ! IN EXNER RATIO AT MID-POINT OF LAYER K+1 LIFPAR1A.79
C LIFPAR1A.80
REAL EKP14(NPNTS) ! IN ENTRAINMENT COEFFICIENT AT LEVEL LIFPAR1A.81
! K+1/4 MULTIPLIED BY APPROPRIATE LIFPAR1A.82
! LAYER THICKNESS LIFPAR1A.83
C LIFPAR1A.84
REAL EKP34(NPNTS) ! IN ENTRAINMENT COEFFICIENT AT LEVEL LIFPAR1A.85
! K+3/4 MULTIPLIED BY APPROPRIATE LIFPAR1A.86
! LAYER THICKNESS LIFPAR1A.87
C LIFPAR1A.88
C LIFPAR1A.89
C---------------------------------------------------------------------- LIFPAR1A.90
C VARIABLES WHICH ARE OUTPUT LIFPAR1A.91
C---------------------------------------------------------------------- LIFPAR1A.92
C LIFPAR1A.93
REAL THPKP1(NPNTS) ! OUT PARCEL POTENTIAL TEMPERATURE IN LIFPAR1A.94
! LAYER K+1 AFTER ENTRAINMENT AND LIFPAR1A.95
! LATENT HEATING (K) LIFPAR1A.96
C LIFPAR1A.97
REAL QPKP1(NPNTS) ! OUT PARCEL MIXING RATIO IN LAYER K+1 LIFPAR1A.98
! AFTER ENTRAINMENT AND LATENT HEATING LIFPAR1A.99
! (KG/KG) LIFPAR1A.100
C LIFPAR1A.101
REAL XSQKP1(NPNTS) ! OUT EXCESS PARCEL WATER AFTER LIFPAR1A.102
! LIFTING FROM LAYER K TO K+1 LIFPAR1A.103
! (KG/KG) LIFPAR1A.104
C LIFPAR1A.105
LOGICAL BGMKP1(NPNTS) ! OUT MASK FOR PARCELS WHICH ARE LIFPAR1A.106
! SATURATED IN LAYER K+1 AFTER LIFPAR1A.107
! ENTRAINMENT AND LATENT HEATING LIFPAR1A.108
C LIFPAR1A.109
C LIFPAR1A.110
C---------------------------------------------------------------------- LIFPAR1A.111
C VARIABLES WHICH ARE DEFINED LOCALLY LIFPAR1A.112
C LIFPAR1A.113
REAL THPKP1T(NPNTS) ! INITIAL ESTIMATE OF PARCEL TEMPERATURE LIFPAR1A.130
! IN LAYER K+1 AFTER ENTRAINMENT (K) LIFPAR1A.131
C LIFPAR1A.132
REAL TT(NPNTS) ! TEMPORARY TEMPERATURE USED IN CALCULATION LIFPAR1A.133
! OF SATURATION MIXING RATIO (K) LIFPAR1A.134
C LIFPAR1A.135
REAL QSPKP1(NPNTS) ! SATURATION MIXING RATIO OF PARCEL LIFPAR1A.136
! AFTER DRY ASCENT (KG/KG) LIFPAR1A.137
C LIFPAR1A.138
C LIFPAR1A.140
C---------------------------------------------------------------------- LIFPAR1A.141
C EXTERNAL ROUTINES CALLED LIFPAR1A.142
C---------------------------------------------------------------------- LIFPAR1A.143
C LIFPAR1A.144
EXTERNAL QSAT,LATENT_H LIFPAR1A.145
C LIFPAR1A.146
C*--------------------------------------------------------------------- LIFPAR1A.147
C LIFPAR1A.148
DO 10 I=1,NPNTS LIFPAR1A.149
CL LIFPAR1A.150
CL---------------------------------------------------------------------- LIFPAR1A.151
CL LIFT PARCEL MIXING RATIO AND POTENTIAL TEMPERATURE TO THE NEXT LEVEL LIFPAR1A.152
CL---------------------------------------------------------------------- LIFPAR1A.153
CL LIFPAR1A.154
CL---------------------------------------------------------------------- LIFPAR1A.155
CL INITIAL 'DRY' ASCENT LIFPAR1A.156
CL LIFPAR1A.157
CL UM DOCUMENTATION PAPER P27 LIFPAR1A.158
CL SECTION (3), EQUATIONS (11B), (12B) LIFPAR1A.159
CL---------------------------------------------------------------------- LIFPAR1A.160
CL LIFPAR1A.161
THPKP1(I) = ( THPK(I) LIFPAR1A.162
* + EKP14(I)*THEK(I) + EKP34(I)*(1.+EKP14(I))*THEKP1(I) LIFPAR1A.163
* ) / ((1.+EKP14(I))*(1.+EKP34(I))) LIFPAR1A.164
C LIFPAR1A.165
QPKP1(I) = ( QPK(I) LIFPAR1A.166
* + EKP14(I)*QEK(I) + EKP34(I)*(1.+EKP14(I))*QEKP1(I) LIFPAR1A.167
* ) / ((1.+EKP14(I))*(1.+EKP34(I))) LIFPAR1A.168
C LIFPAR1A.169
C----------------------------------------------------------------------- LIFPAR1A.170
C CALCULATE WHERE THE PARCEL IS SUPERSATURATED (IE WHERE GAMMA(K+1)=1 LIFPAR1A.171
C SEE DCTN 29 PAGE 123) LIFPAR1A.172
C----------------------------------------------------------------------- LIFPAR1A.173
C LIFPAR1A.174
C LIFPAR1A.175
C----------------------------------------------------------------------- LIFPAR1A.176
C CONVERT POTENTIAL TEMPERATURE TO TEMPERATURE AND CALCULATE LIFPAR1A.177
C PRESSURE OF LAYER K FOR CALCULATION OF SATURATED LIFPAR1A.178
C MIXING RATIO LIFPAR1A.179
C----------------------------------------------------------------------- LIFPAR1A.180
C LIFPAR1A.181
TT(I) = THPKP1(I)*EXKP1(I) LIFPAR1A.182
10 CONTINUE LIFPAR1A.183
CALL QSAT
(QSPKP1,TT,PKP1,NPNTS) LIFPAR1A.184
C LIFPAR1A.185
DO 20 I=1,NPNTS LIFPAR1A.186
BGMKP1(I) = QPKP1(I) .GT. QSPKP1(I) LIFPAR1A.187
CL LIFPAR1A.188
CL---------------------------------------------------------------------- LIFPAR1A.189
CL CONDENSATION CALCULATION LIFPAR1A.190
CL LIFPAR1A.191
CL SUBROUTINE LATENT_H LIFPAR1A.192
CL LIFPAR1A.193
CL UM DOCUMENTATION PAPER P27 LIFPAR1A.194
CL SECTION (4) LIFPAR1A.195
CL---------------------------------------------------------------------- LIFPAR1A.196
CL LIFPAR1A.197
THPKP1T(I) = THPKP1(I) LIFPAR1A.198
20 CONTINUE LIFPAR1A.199
C LIFPAR1A.200
CALL LATENT_H (NPNTS,THPKP1T,QPKP1,THEKP1,QSEKP1,DQSKP1, LIFPAR1A.201
* BGMKP1,BWKP1,EXKP1) LIFPAR1A.202
C LIFPAR1A.203
C----------------------------------------------------------------------- LIFPAR1A.204
C CALCULATE A MORE ACCURATE PARCEL SATURATED MIXING RATIO AND CONDENSE LIFPAR1A.205
C OUT ANY EXCESS WATER VAPOUR. STORE THE EXCESS AMOUNTS IN 'XSQKP1' LIFPAR1A.206
C FOR LATER. SET PARCEL POTENTIAL TEMPERATURES TO THE PROVISIONAL LIFPAR1A.207
C VALUES EXCEPT WHERE THE PARCEL IS NOT SUPERSATURATED WRT THE NEW LIFPAR1A.208
C SATURATED MIXING RATIO. RECALCULATE BIT VECTOR 'BGMKP1'. LIFPAR1A.209
C----------------------------------------------------------------------- LIFPAR1A.210
C LIFPAR1A.211
C LIFPAR1A.212
C----------------------------------------------------------------------- LIFPAR1A.213
C CONVERT POTENTIAL TEMPERATURE TO TEMPERATURE AND CALCULATE LIFPAR1A.214
C PRESSURE OF LAYER K FOR CALCULATION OF SATURATED LIFPAR1A.215
C MIXING RATIO LIFPAR1A.216
C----------------------------------------------------------------------- LIFPAR1A.217
C LIFPAR1A.218
DO 35 I = 1,NPNTS LIFPAR1A.219
TT(I) = THPKP1T(I)*EXKP1(I) LIFPAR1A.220
35 CONTINUE LIFPAR1A.221
CALL QSAT (QSPKP1,TT,PKP1,NPNTS) LIFPAR1A.222
C LIFPAR1A.223
DO 40 I=1,NPNTS LIFPAR1A.224
XSQKP1(I) = QPKP1(I) - QSPKP1(I) LIFPAR1A.225
C LIFPAR1A.226
IF(XSQKP1(I) .LE. 0.0) THEN LIFPAR1A.227
BGMKP1(I) = .FALSE. LIFPAR1A.228
XSQKP1(I) = 0.0 LIFPAR1A.229
ELSE LIFPAR1A.230
BGMKP1(I) = .TRUE. LIFPAR1A.231
THPKP1(I) = THPKP1T(I) LIFPAR1A.232
END IF LIFPAR1A.233
C LIFPAR1A.234
QPKP1(I) = QPKP1(I) - XSQKP1(I) LIFPAR1A.235
40 CONTINUE LIFPAR1A.236
C LIFPAR1A.237
RETURN LIFPAR1A.238
END LIFPAR1A.239
*ENDIF LIFPAR1A.240