*IF DEF,A05_2A,OR,DEF,A05_2C AJX1F405.160
C ******************************COPYRIGHT****************************** GTS2F400.7201
C (c) CROWN COPYRIGHT 1995, METEOROLOGICAL OFFICE, All Rights Reserved. GTS2F400.7202
C GTS2F400.7203
C Use, duplication or disclosure of this code is subject to the GTS2F400.7204
C restrictions as set forth in the contract. GTS2F400.7205
C GTS2F400.7206
C Meteorological Office GTS2F400.7207
C London Road GTS2F400.7208
C BRACKNELL GTS2F400.7209
C Berkshire UK GTS2F400.7210
C RG12 2SZ GTS2F400.7211
C GTS2F400.7212
C If no contract has been raised with this copy of the code, the use, GTS2F400.7213
C duplication or disclosure of it is strictly prohibited. Permission GTS2F400.7214
C to do so must first be obtained in writing from the Head of Numerical GTS2F400.7215
C Modelling at the above address. GTS2F400.7216
C ******************************COPYRIGHT****************************** GTS2F400.7217
C GTS2F400.7218
CLL SUBROUTINE PEVP_BCB----------------------------------------------- PEVBCB2A.3
CLL PEVBCB2A.4
CLL PURPOSE : EVAPORATE RAIN BELOW CLOUD BASE IF NO DOWNDRAUGHT PEVBCB2A.5
CLL PEVBCB2A.6
CLL SUITABLE FOR SINGLE COLUMN MODEL USE PEVBCB2A.7
CLL PEVBCB2A.8
CLL CODE WRITTEN FOR CRAY Y-MP BY S.BETT AND D.GREGORY AUTUMN 1991 PEVBCB2A.9
CLL PEVBCB2A.10
CLL MODEL MODIFICATION HISTORY FROM MODEL VERSION 3.0: PEVBCB2A.11
CLL VERSION DATE PEVBCB2A.12
CLL 4.5 Jul. 98 Kill the IBM specific lines (JCThil) AJC1F405.15
CLL PEVBCB2A.13
CLL PROGRAMMING STANDARDS : UNIFIED MODEL DOCUMENTATION PAPER NO. 3 PEVBCB2A.14
CLL VERSION NO. 4 DATED 5/2/92 PEVBCB2A.15
CLL PEVBCB2A.16
CLL LOGICAL COMPONENTS COVERED: PEVBCB2A.17
CLL PEVBCB2A.18
CLL SYSTEM TASK : P27 PEVBCB2A.19
CLL PEVBCB2A.20
CLL DOCUMENTATION : UNIFIED MODEL DOCUMENTATION PAPER P27 PEVBCB2A.21
CLL PEVBCB2A.22
CLLEND----------------------------------------------------------------- PEVBCB2A.23
C PEVBCB2A.24
C*L ARGUMENTS--------------------------------------------------------- PEVBCB2A.25
C PEVBCB2A.26
SUBROUTINE PEVP_BCB (NPNTS,K,ICCB,TH,PK,Q,DELP,RAIN,SNOW, 4,8PEVBCB2A.27
* DTHBYDT,DQBYDT,EXK,TIMESTEP,CCA) PEVBCB2A.28
C PEVBCB2A.29
IMPLICIT NONE PEVBCB2A.30
C PEVBCB2A.31
C----------------------------------------------------------------------- PEVBCB2A.32
C CONSTANTS PEVBCB2A.33
C----------------------------------------------------------------------- PEVBCB2A.34
C PEVBCB2A.35
*CALL C_LHEAT 
PEVBCB2A.36
*CALL C_R_CP PEVBCB2A.37
*CALL C_G PEVBCB2A.38
*CALL CLDAREA PEVBCB2A.39
C PEVBCB2A.40
C----------------------------------------------------------------------- PEVBCB2A.41
C VECTOR LENGTHS AND LOOP COUNTERS PEVBCB2A.42
C----------------------------------------------------------------------- PEVBCB2A.43
C PEVBCB2A.44
C PEVBCB2A.48
INTEGER I ! IN LOOP COUNTER PEVBCB2A.49
C PEVBCB2A.50
INTEGER NPNTS ! VECTOR LENGTH PEVBCB2A.51
C PEVBCB2A.52
INTEGER K ! IN PRESENT MODEL LAYER PEVBCB2A.53
C PEVBCB2A.54
C----------------------------------------------------------------------- PEVBCB2A.55
C VARIABLES WHICH ARE INPUT PEVBCB2A.56
C----------------------------------------------------------------------- PEVBCB2A.57
C PEVBCB2A.58
INTEGER ICCB(NPNTS) ! IN CONVECTIVE CLOUD BASE LAYER PEVBCB2A.59
C PEVBCB2A.60
REAL PK(NPNTS) ! IN PRESSURE (PA) PEVBCB2A.61
C PEVBCB2A.62
REAL Q(NPNTS) ! IN MIXING RATIO (KG/KG) PEVBCB2A.63
C PEVBCB2A.64
REAL TH(NPNTS) ! IN POTENTIAL TEMPERATURE (K) PEVBCB2A.65
C PEVBCB2A.66
REAL DELP(NPNTS) ! IN CHANGE IN PRESSURE ACROSS PEVBCB2A.67
! LAYER K-1 (PA) PEVBCB2A.68
C PEVBCB2A.69
REAL EXK(NPNTS) ! IN EXNER RATIO OF LAYER K PEVBCB2A.70
C PEVBCB2A.71
REAL TIMESTEP ! IN MODEL TIMESTEP (S) PEVBCB2A.72
C PEVBCB2A.73
REAL CCA(NPNTS) ! IN CONVECTIVE CLOUD AMOUNT PEVBCB2A.74
C PEVBCB2A.75
C----------------------------------------------------------------------- PEVBCB2A.76
C VARIABLES WHICH ARE INPUT AND OUTPUT PEVBCB2A.77
C----------------------------------------------------------------------- PEVBCB2A.78
C PEVBCB2A.79
REAL DTHBYDT(NPNTS) ! INOUT PEVBCB2A.80
! IN INCREMENT TO MODEL POTENTIAL PEVBCB2A.81
! TEMPERATURE (K/S) PEVBCB2A.82
! OUT UPDATED INCREMENT TO MODEL PEVBCB2A.83
! POTENTIAL TEMPERATURE (K/S) PEVBCB2A.84
C PEVBCB2A.85
REAL DQBYDT(NPNTS) ! INOUT PEVBCB2A.86
! IN INCREMENT TO MODEL MIXING RATIO PEVBCB2A.87
! (KG/KG/S) PEVBCB2A.88
! OUT UPDATED INCREMENT TO MIXING RATIO PEVBCB2A.89
! AFTER EVAPORATION BELOW CLOUD PEVBCB2A.90
! BASE (KG/KG/S) PEVBCB2A.91
C PEVBCB2A.92
REAL RAIN(NPNTS) ! INOUT PEVBCB2A.93
! IN AMOUNT OF FALLING RAIN PEVBCB2A.94
! (KG/M**2/S) PEVBCB2A.95
! OUT UPDATED AMOUNT OF FALLING RAIN PEVBCB2A.96
! (KG/M**2/S) PEVBCB2A.97
C PEVBCB2A.98
REAL SNOW(NPNTS) ! INOUT PEVBCB2A.99
! IN AMOUNT OF FALLING SNOW PEVBCB2A.100
! (KG/M**2/S) PEVBCB2A.101
! OUT UPDATED AMOUNT OF FALLING SNOW PEVBCB2A.102
! (KG/M**2/S) PEVBCB2A.103
C PEVBCB2A.104
C----------------------------------------------------------------------- PEVBCB2A.105
C VARIABLES WHICH ARE DEFINED LOCALLY PEVBCB2A.106
C----------------------------------------------------------------------- PEVBCB2A.107
C PEVBCB2A.108
C PEVBCB2A.143
REAL T(NPNTS) ! MODEL TEMPERATURE (K) PEVBCB2A.144
C PEVBCB2A.145
REAL EVAP_RAIN(NPNTS) ! AMOUNT OF EVAPORATION OF RAIN PEVBCB2A.146
C PEVBCB2A.147
REAL SUB_SNOW(NPNTS) ! AMOUNT OF SNOW SUBLIMATION PEVBCB2A.148
C PEVBCB2A.149
REAL QSATE(NPNTS) ! SATURATED MIXING RATIO IN PEVBCB2A.150
! ENVIRONMENT (KG/KG) PEVBCB2A.151
C PEVBCB2A.152
REAL DELQ(NPNTS) ! CHANGE IN MIXING RATIO ACROSS LAYER K PEVBCB2A.153
! (KG/KG) PEVBCB2A.154
C PEVBCB2A.155
REAL THS(NPNTS) ! SATURATED PARCEL POTENTIAL PEVBCB2A.156
! TEMPERATURE (K) PEVBCB2A.157
C PEVBCB2A.158
REAL QS(NPNTS) ! SATURATED PARCEL MIXING RATIO PEVBCB2A.159
C PEVBCB2A.160
LOGICAL BEVAP(NPNTS) ! MASK FOR THOSE POINTS WHERE PEVBCB2A.161
! EVAPORATION OCCURS PEVBCB2A.162
C PEVBCB2A.163
REAL DTHBYDT_EVP(NPNTS) ! INCREMENT TO POTENTIAL TEMPERATURE PEVBCB2A.164
! DUE TO EVAPORATION (K) PEVBCB2A.165
C PEVBCB2A.166
REAL DQBYDT_EVP(NPNTS) ! INCREMENT TO MIXING RATIO DUE TO PEVBCB2A.167
! EVAPORATION (KG/KG) PEVBCB2A.168
C PEVBCB2A.169
REAL DTHBYDT_SAT(NPNTS) ! INCREMENT TO POTENTIAL TEMPERATURE PEVBCB2A.170
! DUE TO SATURATION (K) PEVBCB2A.171
C PEVBCB2A.172
REAL FACTOR(NPNTS) ! DTHBYDT_SAT / DTHBYDT_EVP PEVBCB2A.173
C PEVBCB2A.174
REAL RHO(NPNTS) ! DENSITY OF AIR IN PARCEL PEVBCB2A.175
C PEVBCB2A.176
C----------------------------------------------------------------------- PEVBCB2A.178
C EXTERNAL ROUTINES CALLED PEVBCB2A.179
C----------------------------------------------------------------------- PEVBCB2A.180
C PEVBCB2A.181
EXTERNAL QSAT, EVP, SATCAL PEVBCB2A.182
C PEVBCB2A.183
C----------------------------------------------------------------------- PEVBCB2A.184
C EVAPORATE RAIN IN LAYER K IF LAYER K IS BELOW CLOUD BASE PEVBCB2A.185
C CALCULATE MOISTURE SUB-SATURATION PEVBCB2A.186
C----------------------------------------------------------------------- PEVBCB2A.187
C PEVBCB2A.188
DO I=1,NPNTS PEVBCB2A.189
T(I) = TH(I)*EXK(I) PEVBCB2A.190
BEVAP(I) = .FALSE. PEVBCB2A.191
END DO PEVBCB2A.192
C PEVBCB2A.193
CALL QSAT(QSATE,T,PK,NPNTS) PEVBCB2A.194
C PEVBCB2A.195
DO I=1,NPNTS PEVBCB2A.196
IF (K .LT. ICCB(I)) THEN PEVBCB2A.197
DELQ(I) = QSATE(I)-Q(I) PEVBCB2A.198
C PEVBCB2A.199
C----------------------------------------------------------------------- PEVBCB2A.200
C CHECK IF EVAPORATION POSSIBLE PEVBCB2A.201
C----------------------------------------------------------------------- PEVBCB2A.202
C PEVBCB2A.203
IF ((RAIN(I).GT.0.0 .OR. SNOW(I).GT.0.0) .AND. PEVBCB2A.204
& DELQ(I) .GT. 0.0) THEN PEVBCB2A.205
C PEVBCB2A.206
BEVAP(I) = .TRUE. PEVBCB2A.207
RHO(I) = PK(I) / (R*T(I)) PEVBCB2A.208
END IF PEVBCB2A.209
END IF PEVBCB2A.210
END DO PEVBCB2A.211
C PEVBCB2A.212
C----------------------------------------------------------------------- PEVBCB2A.213
C CALCULATE EVAPORATION PEVBCB2A.214
C----------------------------------------------------------------------- PEVBCB2A.215
C PEVBCB2A.216
CALL EVP (NPNTS,RAIN,T,CCA,RHO,DELQ,DELP,EVAP_RAIN, PEVBCB2A.217
& BEVAP,1,CLDAREA) PEVBCB2A.218
C PEVBCB2A.219
CALL EVP (NPNTS,SNOW,T,CCA,RHO,DELQ,DELP,SUB_SNOW, PEVBCB2A.220
& BEVAP,2,CLDAREA) PEVBCB2A.221
C PEVBCB2A.222
C----------------------------------------------------------------------- PEVBCB2A.223
C CALCULATE TEMPERATURE AND MIXING RATIO IF LAYER BROUGHT TO PEVBCB2A.224
C SATURATION BY EVAPORATION AND SUBLIMATION PEVBCB2A.225
C----------------------------------------------------------------------- PEVBCB2A.226
C PEVBCB2A.227
CALL SATCAL(NPNTS,T,TH,PK,QS,THS,K,EXK,Q,TH) PEVBCB2A.228
C PEVBCB2A.229
C PEVBCB2A.230
DO I=1,NPNTS PEVBCB2A.231
IF (BEVAP(I)) THEN PEVBCB2A.232
DTHBYDT_EVP(I) = -((LC*EVAP_RAIN(I))+((LC+LF)*SUB_SNOW(I)))*G/ PEVBCB2A.233
& (CP*EXK(I)*DELP(I)) PEVBCB2A.234
DQBYDT_EVP(I) = (EVAP_RAIN(I)+SUB_SNOW(I))*G/DELP(I) PEVBCB2A.235
C PEVBCB2A.236
DTHBYDT_SAT(I) = (THS(I)-TH(I))/TIMESTEP PEVBCB2A.237
C PEVBCB2A.238
IF (DTHBYDT_EVP(I).LT.DTHBYDT_SAT(I)) THEN PEVBCB2A.239
C PEVBCB2A.240
C--------------------------------------------------------------------- PEVBCB2A.241
C ADJUST EVAPORATION AND SUBLIMATION RATES TO GIVE SATURATION PEVBCB2A.242
C--------------------------------------------------------------------- PEVBCB2A.243
C PEVBCB2A.244
FACTOR(I) = DTHBYDT_SAT(I)/DTHBYDT_EVP(I) PEVBCB2A.245
DTHBYDT_EVP(I) = DTHBYDT_SAT(I) PEVBCB2A.246
DQBYDT_EVP(I) = DQBYDT_EVP(I)*FACTOR(I) PEVBCB2A.247
EVAP_RAIN(I) = EVAP_RAIN(I)*FACTOR(I) PEVBCB2A.248
SUB_SNOW(I) = SUB_SNOW(I)*FACTOR(I) PEVBCB2A.249
END IF PEVBCB2A.250
C PEVBCB2A.251
C--------------------------------------------------------------------- PEVBCB2A.252
C UPDATE INCREMENTS AND RAINFALL AND ADJUST BACK TO GRIDBOX MEANS PEVBCB2A.253
C--------------------------------------------------------------------- PEVBCB2A.254
C PEVBCB2A.255
DTHBYDT(I) = DTHBYDT(I)+DTHBYDT_EVP(I)*CCA(I)*CLDAREA PEVBCB2A.256
DQBYDT(I) = DQBYDT(I)+DQBYDT_EVP(I)*CCA(I)*CLDAREA PEVBCB2A.257
*IF DEF,SCMA,AND,-DEF,T3E AJC0F405.231
IF (RAIN(I).LT.1E-30) RAIN(I) = 0.0 AJC0F405.232
IF (EVAP_RAIN(I).LT.1E-30) EVAP_RAIN(I) = 0.0 AJC0F405.233
*ENDIF AJC0F405.234
RAIN(I) = RAIN(I)-EVAP_RAIN(I)*CCA(I)*CLDAREA PEVBCB2A.258
SNOW(I) = SNOW(I)-SUB_SNOW(I)*CCA(I)*CLDAREA PEVBCB2A.259
END IF PEVBCB2A.260
END DO PEVBCB2A.261
C PEVBCB2A.262
RETURN PEVBCB2A.263
END PEVBCB2A.264
C PEVBCB2A.265
*ENDIF PEVBCB2A.266