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