*IF DEF,A05_2A,OR,DEF,A05_2C AJX1F405.157
C ******************************COPYRIGHT****************************** GTS2F400.1945
C (c) CROWN COPYRIGHT 1995, METEOROLOGICAL OFFICE, All Rights Reserved. GTS2F400.1946
C GTS2F400.1947
C Use, duplication or disclosure of this code is subject to the GTS2F400.1948
C restrictions as set forth in the contract. GTS2F400.1949
C GTS2F400.1950
C Meteorological Office GTS2F400.1951
C London Road GTS2F400.1952
C BRACKNELL GTS2F400.1953
C Berkshire UK GTS2F400.1954
C RG12 2SZ GTS2F400.1955
C GTS2F400.1956
C If no contract has been raised with this copy of the code, the use, GTS2F400.1957
C duplication or disclosure of it is strictly prohibited. Permission GTS2F400.1958
C to do so must first be obtained in writing from the Head of Numerical GTS2F400.1959
C Modelling at the above address. GTS2F400.1960
C ******************************COPYRIGHT****************************** GTS2F400.1961
C GTS2F400.1962
CLL SUBROUTINE DEVAP-------------------------------------------------- DEVAP2A.3
CLL DEVAP2A.4
CLL PURPOSE : EVAPORATION ROUTINE DEVAP2A.5
CLL DEVAP2A.6
CLL CARRIES OUT EVAPORATION AND UPDATES PRECIPITATION DEVAP2A.7
CLL DEVAP2A.8
CLL SUITABLE FOR SINGLE COLUMN MODEL USE DEVAP2A.9
CLL DEVAP2A.10
CLL CODE WRITTEN FOR CRAY Y-MP BY S.BETT AND D.GREGORY AUTUMN 1990 DEVAP2A.11
CLL DEVAP2A.12
CLL MODEL MODIFICATION HISTORY FROM MODEL VERSION 3.0: DEVAP2A.13
CLL VERSION DATE DEVAP2A.14
CLL 4.5 Jul. 98 Kill the IBM specific lines (JCThil) AJC1F405.9
CLL DEVAP2A.15
CLL PROGRAMMING STANDARDS : UNIFIED MODEL DOCUMENTATION PAPER NO. 3 DEVAP2A.16
CLL VERSION NO. 4 DATED 5/2/92 DEVAP2A.17
CLL DEVAP2A.18
CLL SYSTEM TASK : P27 DEVAP2A.19
CLL DEVAP2A.20
CLL DOCUMENTATION : UNIFIED MODEL DOCUMENTATION PAPER P27 DEVAP2A.21
CLL DEVAP2A.22
CLLEND----------------------------------------------------------------- DEVAP2A.23
C DEVAP2A.24
C*L ARGUMENTS--------------------------------------------------------- DEVAP2A.25
C DEVAP2A.26
SUBROUTINE DEVAP(NPNTS,THDD_K,THDD_KM1,QDD_KM1,THDDS,QDDS, 3,4DEVAP2A.27
* FLX_DD_KM1,EXK,EXKM1,QSATDD,RAIN,SNOW, DEVAP2A.28
* DELPKM1,BDDWT_KM1,CCA,PKM1) DEVAP2A.29
C DEVAP2A.30
IMPLICIT NONE DEVAP2A.31
C DEVAP2A.32
C----------------------------------------------------------------------- DEVAP2A.33
C MODEL CONSTANTS DEVAP2A.34
C----------------------------------------------------------------------- DEVAP2A.35
C DEVAP2A.36
*CALL C_G 
DEVAP2A.37
*CALL C_LHEAT DEVAP2A.38
*CALL C_R_CP DEVAP2A.39
*CALL DDAREA DEVAP2A.40
C DEVAP2A.41
C----------------------------------------------------------------------- DEVAP2A.42
C VECTOR LENGTHS AND LOOP COUNTERS DEVAP2A.43
C----------------------------------------------------------------------- DEVAP2A.44
C DEVAP2A.45
C DEVAP2A.49
INTEGER I ! LOOP COUNTER DEVAP2A.50
C DEVAP2A.51
INTEGER NPNTS ! IN VECTOR LENGTH DEVAP2A.52
C DEVAP2A.53
C----------------------------------------------------------------------- DEVAP2A.54
C VARIABLES WHICH ARE INPUT DEVAP2A.55
C----------------------------------------------------------------------- DEVAP2A.56
C DEVAP2A.57
REAL THDDS(NPNTS) ! IN SATURATED POTENTIAL DEVAP2A.58
! TEMPERATURE OF DOWNDRAUGHT DEVAP2A.59
! (K) DEVAP2A.60
C DEVAP2A.61
REAL QDDS(NPNTS) ! IN MIXING RATIO OF SATURATED DEVAP2A.62
! DOWNDRAUGHT (KG/KG) DEVAP2A.63
C DEVAP2A.64
REAL FLX_DD_KM1(NPNTS) ! IN DOWNDRAUGHT MASS FLUX IN DEVAP2A.65
! LAYER K-1 (PA/S) DEVAP2A.66
C DEVAP2A.67
REAL THDD_K(NPNTS) ! IN POTENTIAL TEMPERATURE OF DEVAP2A.68
! DOWNDRAUGHT IN LAYER K (K) DEVAP2A.69
C DEVAP2A.70
REAL EXK(NPNTS) ! IN EXNER RATIO OF LAYER K DEVAP2A.71
C DEVAP2A.72
REAL EXKM1(NPNTS) ! IN EXNER RATIO OF LAYER K-1 DEVAP2A.73
C DEVAP2A.74
REAL QSATDD(NPNTS) ! IN SATURATED DOWNDRAUGHT DEVAP2A.75
! MIXING RATIO (KG/KG) DEVAP2A.76
C DEVAP2A.77
REAL DELPKM1(NPNTS) ! IN CHANGE IN PRESSURE ACROSS DEVAP2A.78
! LAYER K-1 (PA) DEVAP2A.79
C DEVAP2A.80
LOGICAL BDDWT_KM1(NPNTS)! IN MASK WHERE PRECIPITATION IN DEVAP2A.81
! DOWNDRAUGHT IS LIQUID DEVAP2A.82
C DEVAP2A.83
REAL CCA(NPNTS) ! IN CONVECTIVE CLOUD AMOUNT DEVAP2A.84
C DEVAP2A.85
REAL PKM1(NPNTS) ! IN PRESSURE OF LAYER K-1 DEVAP2A.86
C DEVAP2A.87
C----------------------------------------------------------------------- DEVAP2A.88
C VARIABLES WHICH ARE INPUT AND OUTPUT DEVAP2A.89
C----------------------------------------------------------------------- DEVAP2A.90
C DEVAP2A.91
REAL THDD_KM1(NPNTS) ! INOUT DEVAP2A.92
! IN POTENTIAL TEMPERATURE OF DEVAP2A.93
! DOWNDRAUGHT IN LAYER K-1 (K) DEVAP2A.94
! OUT UPDATED POTENTIAL TEMPERATURE DEVAP2A.95
! OF DOWNDRAUGHT IN LAYER K-1 DEVAP2A.96
! AFTER EVAPORATION OR DEVAP2A.97
! SATURATION (K) DEVAP2A.98
C DEVAP2A.99
REAL QDD_KM1(NPNTS) ! INOUT DEVAP2A.100
! IN MODEL MIXING RATIO OF DEVAP2A.101
! DOWNDRAUGHT IN LAYER K-1 DEVAP2A.102
! (KG/KG) DEVAP2A.103
! OUT UPDATED MODEL MIXING RATIO DEVAP2A.104
! OF DOWNDRAUGHT IN LAYER K-1 DEVAP2A.105
! AFTER EVAPORATION OR DEVAP2A.106
! SATURATION (KG/KG) DEVAP2A.107
C DEVAP2A.108
REAL RAIN(NPNTS) ! INOUT DEVAP2A.109
! IN AMOUNT OF RAIN (KG/M**2/S) DEVAP2A.110
! OUT UPDATED RAINFALL (KG/M**2/S) DEVAP2A.111
C DEVAP2A.112
REAL SNOW(NPNTS) ! INOUT DEVAP2A.113
! IN AMOUNT OF SNOW (KG/M**2/S) DEVAP2A.114
! OUT UPDATED SNOWFALL (KG/M**2/S) DEVAP2A.115
C DEVAP2A.116
C----------------------------------------------------------------------- DEVAP2A.117
C VARIABLES WHICH ARE LOCALLY DEFINED DEVAP2A.118
C----------------------------------------------------------------------- DEVAP2A.119
C DEVAP2A.120
C DEVAP2A.159
REAL TEVP(NPNTS) ! TEMPERATURE USED IN EVAPORATION DEVAP2A.160
! CALCULATION (K) DEVAP2A.161
C DEVAP2A.162
LOGICAL BEVAP(NPNTS) ! MASK FOR THOSE POINTS AT WHICH DEVAP2A.163
! EVAPORATION CALCULATION IS TO DEVAP2A.164
! BE CARRIED OUT DEVAP2A.165
C DEVAP2A.166
LOGICAL BSAT(NPNTS) ! MASK FOR THOSE POINTS WHICH DEVAP2A.167
! ARE SUBSATURATED DEVAP2A.168
C DEVAP2A.169
REAL EVAP_RAIN(NPNTS) ! AMOUNT OF EVAPORATION OF RAIN DEVAP2A.170
C DEVAP2A.171
REAL SUB_SNOW(NPNTS) ! AMOUNT OF SNOW SUBLIMATION DEVAP2A.172
C DEVAP2A.173
REAL DELQ(NPNTS) ! DIFFERENCE IN MIXING RATIOS DEVAP2A.174
! (KG/KG) DEVAP2A.175
C DEVAP2A.176
REAL DELTH(NPNTS) ! INCREMENT TO DOWNDRAUGHT POTENTIAL DEVAP2A.177
! TEMPERATURE IN LAYER K-1 DUE TO DEVAP2A.178
! EVAPORATION DEVAP2A.179
C DEVAP2A.180
REAL DELQE(NPNTS) ! INCREMENT TO DOWNDRAUGHT MIXING RATIO DEVAP2A.181
! IN LAYER K-1 DUE TO EVAPORATION DEVAP2A.182
C DEVAP2A.183
REAL DELTHS(NPNTS) ! SATURATED POTENTIAL TEMPERATURE MINUS DEVAP2A.184
! POTENTIAL TEMPERATURE OF DOWNDRAUGHT DEVAP2A.185
C DEVAP2A.186
REAL FACTOR(NPNTS) ! DELTHS / DELTH DEVAP2A.187
C DEVAP2A.188
REAL PINCR(NPNTS) ! INCREASE IN PRECIPITATION IF PARCEL DEVAP2A.189
! SUPERSATURATES DEVAP2A.190
C DEVAP2A.191
REAL RHO(NPNTS) ! DENSITY OF AIR IN PARCEL DEVAP2A.192
C DEVAP2A.193
C DEVAP2A.195
C----------------------------------------------------------------------- DEVAP2A.196
C EXTERNAL ROUTINES CALLED DEVAP2A.197
C----------------------------------------------------------------------- DEVAP2A.198
C DEVAP2A.199
EXTERNAL EVP DEVAP2A.200
C DEVAP2A.201
C----------------------------------------------------------------------- DEVAP2A.202
C CHECK IF EVAPORATION POSSIBLE DEVAP2A.203
C----------------------------------------------------------------------- DEVAP2A.204
C DEVAP2A.205
DO I=1,NPNTS DEVAP2A.206
DELQ(I) = QSATDD(I)-QDD_KM1(I) DEVAP2A.207
C DEVAP2A.208
BEVAP(I) =((RAIN(I).GT.0.0) .OR. (SNOW(I).GT.0.0)) DEVAP2A.209
* .AND. (DELQ(I).GT.0.0) DEVAP2A.210
BSAT(I) = DELQ(I) .LT. 0.0 DEVAP2A.211
C DEVAP2A.212
C----------------------------------------------------------------------- DEVAP2A.213
C CALCULATE TEMPERATURE USED IN CALCULATION OF EVAPORATION CONSTANTS DEVAP2A.214
C BASED ON TEMPERATURE OF PARCEL AFTER UNSATURATED DESCENT DEVAP2A.215
C----------------------------------------------------------------------- DEVAP2A.216
C DEVAP2A.217
IF (BEVAP(I)) THEN DEVAP2A.218
TEVP(I) = ((THDD_K(I)*EXK(I))+(THDD_KM1(I)*EXKM1(I)))*0.5 DEVAP2A.219
RHO(I) = PKM1(I) / (R*TEVP(I)) DEVAP2A.220
END IF DEVAP2A.221
END DO DEVAP2A.222
C DEVAP2A.223
C----------------------------------------------------------------------- DEVAP2A.224
C EVAPORATION CALCULATION - CALCULATE RATES FOR RAIN AND SNOW DEVAP2A.225
C----------------------------------------------------------------------- DEVAP2A.226
C DEVAP2A.227
CALL EVP(NPNTS,RAIN,TEVP,CCA,RHO,DELQ,DELPKM1,EVAP_RAIN, DEVAP2A.228
& BEVAP,1,DDCLDFRA) DEVAP2A.229
C DEVAP2A.230
CALL EVP(NPNTS,SNOW,TEVP,CCA,RHO,DELQ,DELPKM1,SUB_SNOW, DEVAP2A.231
& BEVAP,2,DDCLDFRA) DEVAP2A.232
C DEVAP2A.233
DO I=1,NPNTS DEVAP2A.234
IF (BEVAP(I)) THEN DEVAP2A.235
C DEVAP2A.236
C----------------------------------------------------------------------- DEVAP2A.237
C ADJUST EVAPORATION AND SUBLIMNATION RATES BACK TO GRID BOX MEAN DEVAP2A.238
C----------------------------------------------------------------------- DEVAP2A.239
C DEVAP2A.240
EVAP_RAIN(I) = EVAP_RAIN(I)*CCA(I)*DDCLDFRA DEVAP2A.241
SUB_SNOW(I) = SUB_SNOW(I)*CCA(I)*DDCLDFRA DEVAP2A.242
C DEVAP2A.243
C----------------------------------------------------------------------- DEVAP2A.244
C CHECK IF PARCEL SUPERSATURATED DEVAP2A.245
C----------------------------------------------------------------------- DEVAP2A.246
C DEVAP2A.247
DELTH(I) = -((LC*EVAP_RAIN(I))+((LC+LF)*SUB_SNOW(I)))*G/ DEVAP2A.248
& (CP*EXKM1(I)*FLX_DD_KM1(I)) DEVAP2A.249
DELQE(I) = (EVAP_RAIN(I)+SUB_SNOW(I))*G/FLX_DD_KM1(I) DEVAP2A.250
C DEVAP2A.251
DELTHS(I) = THDDS(I)-THDD_KM1(I) DEVAP2A.252
IF (DELTH(I).LT.DELTHS(I)) THEN DEVAP2A.253
C DEVAP2A.254
C----------------------------------------------------------------------- DEVAP2A.255
C ADJUST EVAP AND SUBLIMATION RATES TO GIVE SATURATION DEVAP2A.256
C----------------------------------------------------------------------- DEVAP2A.257
C DEVAP2A.258
FACTOR(I) = DELTHS(I)/DELTH(I) DEVAP2A.259
DELTH(I) = DELTHS(I) DEVAP2A.260
DELQE(I) = DELQE(I)*FACTOR(I) DEVAP2A.261
EVAP_RAIN(I) = EVAP_RAIN(I)*FACTOR(I) DEVAP2A.262
SUB_SNOW(I) = SUB_SNOW(I)*FACTOR(I) DEVAP2A.263
END IF DEVAP2A.264
C DEVAP2A.265
C----------------------------------------------------------------------- DEVAP2A.266
C UPDATE T,Q AND PRECIPITATION DEVAP2A.267
C----------------------------------------------------------------------- DEVAP2A.268
C DEVAP2A.269
RAIN(I) = RAIN(I)-EVAP_RAIN(I) DEVAP2A.270
SNOW(I) = SNOW(I)-SUB_SNOW(I) DEVAP2A.271
THDD_KM1(I) = THDD_KM1(I)+DELTH(I) DEVAP2A.272
QDD_KM1(I) = QDD_KM1(I)+DELQE(I) DEVAP2A.273
C DEVAP2A.274
C----------------------------------------------------------------------- DEVAP2A.275
C PARCEL IS SUPERSATURATED BEFORE EVAPORATION OCCURS DEVAP2A.276
C BRING PARCEL TO SATURATION AND PRECIPITATE WATER DEVAP2A.277
C----------------------------------------------------------------------- DEVAP2A.278
C DEVAP2A.279
ELSE IF (BSAT(I)) THEN DEVAP2A.280
PINCR(I) = (QDD_KM1(I)-QDDS(I))*FLX_DD_KM1(I)/G DEVAP2A.281
QDD_KM1(I) = QDDS(I) DEVAP2A.282
THDD_KM1(I) = THDDS(I) DEVAP2A.283
IF (BDDWT_KM1(I)) THEN DEVAP2A.284
RAIN(I) = RAIN(I)+PINCR(I) DEVAP2A.285
ELSE DEVAP2A.286
SNOW(I) = SNOW(I)+PINCR(I) DEVAP2A.287
END IF DEVAP2A.288
END IF DEVAP2A.289
END DO DEVAP2A.290
C DEVAP2A.291
RETURN DEVAP2A.292
END DEVAP2A.293
C DEVAP2A.294
*ENDIF DEVAP2A.295