*IF DEF,A03_5A SFEVAP5A.2
C *****************************COPYRIGHT****************************** SFEVAP5A.3
C (c) CROWN COPYRIGHT 1996, METEOROLOGICAL OFFICE, All Rights Reserved. SFEVAP5A.4
C SFEVAP5A.5
C Use, duplication or disclosure of this code is subject to the SFEVAP5A.6
C restrictions as set forth in the contract. SFEVAP5A.7
C SFEVAP5A.8
C Meteorological Office SFEVAP5A.9
C London Road SFEVAP5A.10
C BRACKNELL SFEVAP5A.11
C Berkshire UK SFEVAP5A.12
C RG12 2SZ SFEVAP5A.13
C SFEVAP5A.14
C If no contract has been raised with this copy of the code, the use, SFEVAP5A.15
C duplication or disclosure of it is strictly prohibited. Permission SFEVAP5A.16
C to do so must first be obtained in writing from the Head of Numerical SFEVAP5A.17
C Modelling at the above address. SFEVAP5A.18
C ******************************COPYRIGHT****************************** SFEVAP5A.19
C*LL SUBROUTINE SF_EVAP------------------------------------------------ SFEVAP5A.20
CLL SFEVAP5A.21
CLL Purpose: Calculate surface evaporation and sublimation amounts SFEVAP5A.22
CLL (without applying them to the surface stores). SFEVAP5A.23
CLL Also calculate heat flux due to sea-ice melting. SFEVAP5A.24
CLL Also calculate 1.5 metre T and Q. SFEVAP5A.25
CLL SFEVAP5A.26
CLL SFEVAP5A.27
CLL Suitable for single column usage. SFEVAP5A.28
CLL SFEVAP5A.29
CLL Model Modification history: SFEVAP5A.30
CLL version Date SFEVAP5A.31
CLL SFEVAP5A.32
CLL 4.1 New deck. SFEVAP5A.33
CLL 4.2 Oct. 96 T3E migration - *DEF CRAY removed GSS2F402.289
CLL S J Swarbrick GSS2F402.290
CLL 4.5 Jul. 98 Kill the IBM specific lines (JCThil) AJC1F405.126
CLL SFEVAP5A.34
CLL Programming standard: Unified Model Documentation Paper No 4, SFEVAP5A.35
CLL version 2, dated 18/1/90. SFEVAP5A.36
CLL SFEVAP5A.37
CLL Logical component covered: P245. SFEVAP5A.38
CLL SFEVAP5A.39
CLL System task: SFEVAP5A.40
CLL SFEVAP5A.41
CLL Documentation: UMDP 24 SFEVAP5A.42
CLL SFEVAP5A.43
CLL--------------------------------------------------------------------- SFEVAP5A.44
C* SFEVAP5A.45
C*L Arguments :--------------------------------------------------------- SFEVAP5A.46
SUBROUTINE SF_EVAP ( 4,14SFEVAP5A.47
+ P_FIELD,P1,LAND_FIELD,LAND1 SFEVAP5A.48
+,POINTS,BL_LEVELS,LAND_MASK,LAND_PTS,LAND_INDEX SFEVAP5A.52
+,ALPHA1,ASURF,ASHTF,CANOPY,CATCH SFEVAP5A.54
+,DTRDZ,DTRDZ_RML,E_SEA,FRACA SFEVAP5A.55
+,ICE_FRACT,NRML,RHOKH_1,SMC,TIMESTEP,CER1P5M,CHR1P5M SFEVAP5A.56
+,PSTAR,RESFS,RESFT,Z1,Z0M,Z0H,SQ1P5,ST1P5,SIMLT,SMLT SFEVAP5A.57
+,FTL,FQW,LYING_SNOW,QW,SURF_HT_FLUX SFEVAP5A.58
+,TL,TSTAR,TI,ECAN,ES,EI SFEVAP5A.59
+,SICE_MLT_HTF,SNOMLT_SURF_HTF,SNOWMELT SFEVAP5A.60
+,Q1P5M,T1P5M,LTIMER SFEVAP5A.61
+) SFEVAP5A.62
IMPLICIT NONE SFEVAP5A.63
LOGICAL LTIMER SFEVAP5A.64
INTEGER SFEVAP5A.65
+ P_FIELD ! IN No. of gridpoints in the whole grid. SFEVAP5A.66
+,P1 ! IN 1st P-pt in full field to be processed. SFEVAP5A.67
+,LAND_FIELD ! IN No. of landpoints in the whole grid. SFEVAP5A.68
+,LAND1 ! IN 1st L-pt in full field to be processed. SFEVAP5A.69
+,POINTS ! IN No. of gridpoints to be processed. SFEVAP5A.70
+,BL_LEVELS ! IN No. of levels treated by b.l. scheme. SFEVAP5A.71
+,LAND_PTS ! IN No. of land points to be processed. SFEVAP5A.72
LOGICAL SFEVAP5A.73
+ LAND_MASK(P_FIELD) ! IN T for land points, F otherwise. SFEVAP5A.74
INTEGER SFEVAP5A.76
+ LAND_INDEX(P_FIELD) ! IN Index of land points on the P-grid. SFEVAP5A.77
C ! The ith element contains the position SFEVAP5A.78
C ! in whole grid of the ith land point. SFEVAP5A.79
REAL SFEVAP5A.81
+ ALPHA1(P_FIELD) ! IN Gradient of saturated specific SFEVAP5A.82
C ! humidity with respect to temp. SFEVAP5A.83
C ! between the bottom model layer SFEVAP5A.84
C ! and the surface. SFEVAP5A.85
+,ASURF(P_FIELD) ! IN Soil coefficient from P242 (sq m K per SFEVAP5A.86
C ! per Joule * timestep). SFEVAP5A.87
+,ASHTF(P_FIELD) ! IN Coefficient to calculate SFEVAP5A.88
C ! the soil heat flux SFEVAP5A.89
C ! between the surface and top soil SFEVAP5A.90
C ! layer (W/m2/K) SFEVAP5A.91
+,CANOPY(LAND_FIELD) ! IN Gridbox mean canopy / surface water SFEVAP5A.92
C ! store (kg per sq m). SFEVAP5A.93
+,CATCH(LAND_FIELD) ! IN Canopy / surface water store capacity SFEVAP5A.94
C ! (kg per sq m). SFEVAP5A.95
+,DTRDZ(P_FIELD, ! IN -g.dt/dp for each model layer on p-grid SFEVAP5A.96
+ BL_LEVELS) ! From P244 ((kg/sq m/s)**-1). SFEVAP5A.97
+,DTRDZ_RML(P_FIELD) ! IN -g.dt/dp for the rapidly mixing layer SFEVAP5A.98
C ! (if it exists) on the p-grid from P244. SFEVAP5A.99
+,E_SEA(P_FIELD) ! IN Evaporation from sea (weighted with SFEVAP5A.100
C ! leads fraction at sea-ice points). SFEVAP5A.101
+,FRACA(P_FIELD) ! IN Fraction of surface moisture flux SFEVAP5A.102
C ! with only aerodynamic resistance. SFEVAP5A.103
C ! Diagnostics defined on land and sea. SFEVAP5A.105
+,ICE_FRACT(P_FIELD) ! IN Fraction of gridbox which is covered by SFEVAP5A.107
C ! sea-ice (decimal fraction, but most of SFEVAP5A.108
C ! this sub-component assumes it to be SFEVAP5A.109
C ! either 1.0 or 0.0 precisely). SFEVAP5A.110
C ! NB Dimension is PFIELD not LAND_FIELD f SFEVAP5A.112
C ! snow on sea-ice in coupled model runs. SFEVAP5A.113
+,SMC(LAND_FIELD) ! IN Soil moisture content (kg per sq m). SFEVAP5A.115
+,TIMESTEP ! IN Timestep (sec). SFEVAP5A.116
LOGICAL SFEVAP5A.117
+ SQ1P5 ! IN STASH flag for 1.5-metre sp humidity. SFEVAP5A.118
+,ST1P5 ! IN STASH flag for 1.5-metre temperature. SFEVAP5A.119
+,SIMLT ! IN STASH flag for sea-ice melting ht flux. SFEVAP5A.120
+,SMLT ! IN STASH flag for snow melting ht flux. SFEVAP5A.121
REAL SFEVAP5A.122
+ CER1P5M(P_FIELD) ! IN Transfer coefficient ratio, from P243. SFEVAP5A.123
+,CHR1P5M(P_FIELD) ! IN Transfer coefficient ratio, from P243. SFEVAP5A.124
+,PSTAR(P_FIELD) ! IN Surface pressure (Pa). SFEVAP5A.125
+,RESFS(P_FIELD) ! IN Combined soil, stomatal and SFEVAP5A.126
C ! aerodynamic resistance factor SFEVAP5A.127
+,RESFT(P_FIELD) ! IN Total resistance factor SFEVAP5A.128
C ! FRACA+(1-FRACA)*RESFS. SFEVAP5A.129
+,Z1(P_FIELD) ! IN Height of lowest atmospheric level SFEVAP5A.130
C ! (i.e. middle of lowest layer). Metres. SFEVAP5A.131
+,Z0M(P_FIELD) ! IN Roughness length for momentum (m) SFEVAP5A.132
+,Z0H(P_FIELD) ! IN Roughness length for heat and moisture SFEVAP5A.133
INTEGER SFEVAP5A.134
& NRML(P_FIELD) ! IN The Number of model layers in the SFEVAP5A.135
C ! Rapidly Mixing Layer. SFEVAP5A.136
REAL SFEVAP5A.137
+ RHOKH_1(P_FIELD) ! IN Turbulent surface exchange SFEVAP5A.138
C ! coefficient for sensible heat. SFEVAP5A.139
+,FTL(P_FIELD, ! INOUT Sensible heat flux from layer k-1 to SFEVAP5A.140
+ BL_LEVELS) ! layer k (W/sq m). From P243 and SFEVAP5A.141
C ! P244, units changed in P24 top level. SFEVAP5A.142
+,FQW(P_FIELD, ! INOUT Turbulent moisture flux from level SFEVAP5A.143
+ BL_LEVELS) ! k-1 to k (kg/sq m/s). From P243/4. SFEVAP5A.144
C ! Diagnostics defined on land and sea. SFEVAP5A.146
+,LYING_SNOW(P_FIELD) ! INOUT Lying snow (kg per sq m). SFEVAP5A.148
+,QW(P_FIELD,BL_LEVELS)! INOUT Total water content (kg(water)/ SFEVAP5A.149
C ! kg(air)). From P243/4. SFEVAP5A.150
C SFEVAP5A.151
+,SURF_HT_FLUX(P_FIELD)! INOUT Net downward heat flux at surface SFEVAP5A.152
C ! over land or sea-ice fraction of SFEVAP5A.153
C ! gridbox (W/m2). SFEVAP5A.154
+,TSTAR(P_FIELD) ! INOUT Surface temperature (K). SFEVAP5A.155
+,TI(P_FIELD) ! INOUT Sea-ice surface layer temp. (K). SFEVAP5A.156
+,TL(P_FIELD,BL_LEVELS)! INOUT Liquid/frozen water temperature (K). SFEVAP5A.157
REAL SFEVAP5A.158
+ ECAN(P_FIELD) ! OUT Gridbox mean evaporation from canopy/ SFEVAP5A.159
C ! surface store (kg per sq m per s). SFEVAP5A.160
C ! Zero over sea and sea-ice. SFEVAP5A.161
+,ES(P_FIELD) ! OUT Surface evapotranspiration (through SFEVAP5A.162
C ! a resistance which is not entirely SFEVAP5A.163
C ! aerodynamic). Always non-negative. SFEVAP5A.164
C ! Kg per sq m per sec. SFEVAP5A.165
C ! Diagnostics defined on land and sea. SFEVAP5A.167
+,EI(P_FIELD) ! OUT Sublimation from lying snow or sea- SFEVAP5A.169
C ! ice (kg per sq m per s). SFEVAP5A.170
REAL SFEVAP5A.171
+ SICE_MLT_HTF(P_FIELD)! OUT Heat flux due to melting of sea-ice SFEVAP5A.172
C ! (Watts per square metre). SFEVAP5A.173
+,SNOMLT_SURF_HTF(P_FIELD)! OUT Heat flux due to surface melting SFEVAP5A.174
C ! of snow (W/m2). SFEVAP5A.175
+,SNOWMELT(P_FIELD) ! OUT Surface snowmelt (kg/m2/s). SFEVAP5A.176
+,Q1P5M(P_FIELD) ! OUT Specific humidity at screen height of SFEVAP5A.177
C ! 1.5 metres (kg water per kg air). SFEVAP5A.178
+,T1P5M(P_FIELD) ! OUT Temperature at 1.5 metres above the SFEVAP5A.179
C ! surface (K). SFEVAP5A.180
C* SFEVAP5A.181
C*L External subprogram(s) required :- SFEVAP5A.182
EXTERNAL QSAT,SF_MELT SFEVAP5A.183
EXTERNAL TIMER SFEVAP5A.184
C* SFEVAP5A.185
C*L Local and other symbolic constants used :- SFEVAP5A.186
*CALL C_0_DG_C 
SFEVAP5A.187
*CALL C_LHEAT SFEVAP5A.188
*CALL C_G SFEVAP5A.189
*CALL C_HT_M ! Contains Z1P5M SFEVAP5A.190
*CALL C_R_CP SFEVAP5A.191
*CALL C_GAMMA SFEVAP5A.192
*CALL C_KAPPAI SFEVAP5A.193
REAL GRCP SFEVAP5A.194
PARAMETER ( SFEVAP5A.195
+ GRCP=G/CP ! Accn due to gravity / standard heat capacity of SFEVAP5A.196
C ! air at const pressure. Used in diagnosis of 1.5 SFEVAP5A.197
C ! metre temperature. SFEVAP5A.198
+) SFEVAP5A.199
C* SFEVAP5A.200
REAL SFEVAP5A.202
+ DFQW(P_FIELD) ! Adjustment increment to the flux of SFEVAP5A.203
C ! total water SFEVAP5A.204
+,DIFF_SENS_HTF(P_FIELD)! Adjustment increment to the sensible SFEVAP5A.205
C ! heat flux SFEVAP5A.206
+,DQW(P_FIELD) ! Increment to specific humidity SFEVAP5A.207
+,DTL(P_FIELD) ! Increment to temperature SFEVAP5A.208
+,DTRDZ_1(P_FIELD) ! -g.dt/dp for surface layer or rml if it SFEVAP5A.209
C ! exists from P244 ((kg/sq m/s)**-1). SFEVAP5A.210
+,EOLD(P_FIELD) ! Used to store initial value of evap. SFEVAP5A.211
C ! from P244 SFEVAP5A.212
+,EW(P_FIELD) ! Total surface flux of water, excluding SFEVAP5A.213
C ! sublimation/frost deposition, over land. SFEVAP5A.214
+,LEOLD(P_FIELD) ! Used to store initial value of latent SFEVAP5A.215
C ! heat flux from P244 SFEVAP5A.216
+,QS(P_FIELD) ! Used for saturated specific humidity SFEVAP5A.217
C ! at surface, in Q1P5M calculation. SFEVAP5A.218
+,RHOKH1_PRIME(P_FIELD) ! Modified forward time-weighted transfer SFEVAP5A.219
C ! coefficient SFEVAP5A.220
C Local scalars SFEVAP5A.243
REAL SFEVAP5A.244
+ DIFF_LAT_HTF ! Increment to the latent heat flux. SFEVAP5A.245
+,DIFF_SURF_HTF ! Increment to the surface heat flux. SFEVAP5A.246
+,DTSTAR ! Increment for surface temperature. SFEVAP5A.247
+,EA ! Surface evaporation with only aero- SFEVAP5A.248
C ! dynamic resistance (+ve), or condens- SFEVAP5A.249
C ! ation (-ve), averaged over gridbox SFEVAP5A.250
C ! (kg/m2/s). SFEVAP5A.251
+,EADT ! EA (q.v.) integrated over timestep. SFEVAP5A.252
+,ECANDT ! ECAN (q.v.) integrated over timestep. SFEVAP5A.253
+,EDT ! E=FQW(,1) (q.v.) integrated over timestep. SFEVAP5A.254
+,EIDT ! EI (q.v.) integrated over timestep. SFEVAP5A.255
+,ESDT ! ES (q.v.) integrated over timestep. SFEVAP5A.256
+,ESL ! ES (q.v.) without fractional weighting SFEVAP5A.257
C ! factor FRACS ('L' is for 'local') SFEVAP5A.258
C ! (kg/m2/s). SFEVAP5A.259
+,ESLDT ! ESL (q.v.) integrated over timestep. SFEVAP5A.260
+,FRACS ! Fraction of gridbox at which moisture flux SFEVAP5A.261
C ! is additionally impeded by a surface and/or SFEVAP5A.262
C ! stomatal resistance. SFEVAP5A.263
INTEGER SFEVAP5A.264
+ I ! Loop counter - full horizontal field index. SFEVAP5A.265
+,L ! Loop counter - land field index. SFEVAP5A.266
+,K ! Loop counter in the vertical. SFEVAP5A.267
+,KM1 ! K - 1 SFEVAP5A.268
C SFEVAP5A.269
C----------------------------------------------------------------------- SFEVAP5A.270
CL 1. Initialise some output variables and flux increments to zero. SFEVAP5A.271
C----------------------------------------------------------------------- SFEVAP5A.272
C SFEVAP5A.273
IF (LTIMER) THEN SFEVAP5A.274
CALL TIMER('SFEVAP ',3) SFEVAP5A.275
ENDIF SFEVAP5A.276
DO 1 I=P1,P1+POINTS-1 SFEVAP5A.277
ECAN(I) = 0.0 SFEVAP5A.278
EI(I) = 0.0 SFEVAP5A.279
DIFF_SENS_HTF(I) = 0.0 SFEVAP5A.280
DFQW(I) = 0.0 SFEVAP5A.281
1 CONTINUE SFEVAP5A.282
C SFEVAP5A.283
C--------------------------------------------------------------------- SFEVAP5A.284
CL 2. Do calculations for land points. SFEVAP5A.285
C--------------------------------------------------------------------- SFEVAP5A.286
C SFEVAP5A.287
CMIC$ DO ALL VECTOR SHARED(P_FIELD, LAND_FIELD, BL_LEVELS, LAND1, SFEVAP5A.288
CMIC$1 LAND_PTS, LAND_INDEX, ESL, TIMESTEP, ES, LYING_SNOW, ECAN, SFEVAP5A.289
CMIC$2 EA, CATCH, CANOPY, SMC, EI, TSTAR, FQW, EOLD, LEOLD, SFEVAP5A.290
CMIC$3 P1,POINTS,LC,LF,TM,LAND_MASK,EW,FRACA,RESFT,RESFS) SFEVAP5A.291
CMIC$4 PRIVATE(I, L, ESLDT, SFEVAP5A.292
CMIC$5 ESDT, EADT, EDT, ECANDT, FRACS, EIDT) SFEVAP5A.293
CDIR$ IVDEP SFEVAP5A.294
! Fujitsu vectorization directive GRB0F405.451
!OCL NOVREC GRB0F405.452
DO 2 L=LAND1,LAND1+LAND_PTS-1 SFEVAP5A.300
I = LAND_INDEX(L) SFEVAP5A.301
IF (FQW(I,1).EQ.0.0) THEN SFEVAP5A.303
EA = 0.0 SFEVAP5A.304
ESL = 0.0 SFEVAP5A.305
ELSE SFEVAP5A.306
EA = FQW(I,1) / RESFT(I) * FRACA(I) SFEVAP5A.307
ESL = FQW(I,1) / RESFT(I) * RESFS(I) SFEVAP5A.308
END IF SFEVAP5A.309
ES(I) = ESL * (1. - FRACA(I)) SFEVAP5A.310
C SFEVAP5A.311
C----------------------------------------------------------------------- SFEVAP5A.312
CL 2.1 Calculate fluxes integrated over timestep. SFEVAP5A.313
C----------------------------------------------------------------------- SFEVAP5A.314
C SFEVAP5A.315
ESLDT = ESL * TIMESTEP SFEVAP5A.316
EADT = EA * TIMESTEP SFEVAP5A.317
ESDT = ES(I) * TIMESTEP SFEVAP5A.318
EDT = EADT + ESDT SFEVAP5A.319
C SFEVAP5A.320
C----------------------------------------------------------------------- SFEVAP5A.321
CL 2.2 Do calculations for snow-free land. Canopy processes operate. SFEVAP5A.322
CL LYING_SNOW is defined on sea and land points for snow on sea-ice SFEVAP5A.324
CL in coupled model runs. SFEVAP5A.325
C----------------------------------------------------------------------- SFEVAP5A.327
C SFEVAP5A.328
IF (LYING_SNOW(I).LE.0.0) THEN SFEVAP5A.329
C SFEVAP5A.330
C********************************************************************** SFEVAP5A.331
C Store initial value of evaporation and latent heat flux SFEVAP5A.332
C********************************************************************** SFEVAP5A.333
C SFEVAP5A.334
EOLD(I) = FQW(I,1) SFEVAP5A.335
LEOLD(I) = FQW(I,1) * LC SFEVAP5A.336
IF (EDT.GE.0.0) THEN SFEVAP5A.337
C SFEVAP5A.338
C----------------------------------------------------------------------- SFEVAP5A.339
CL 2.2.1 Non-negative moisture flux over snow-free land. SFEVAP5A.340
C----------------------------------------------------------------------- SFEVAP5A.341
C SFEVAP5A.342
C- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - SFEVAP5A.343
CL (a) Water in canopy and soil is assumed to be liquid, so all SFEVAP5A.344
CL positive moisture flux over snow-free land is evaporation SFEVAP5A.345
CL rather than sublimation, even if TSTAR is less than or equal SFEVAP5A.346
CL to TM. SFEVAP5A.347
C- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - SFEVAP5A.348
C SFEVAP5A.349
ECAN(I) = EA SFEVAP5A.350
ECANDT = EADT SFEVAP5A.351
C SFEVAP5A.352
C If EDT is non-negative, then ECANDT must be non-negative. SFEVAP5A.353
C SFEVAP5A.354
FRACA(I) = 0.0 SFEVAP5A.355
IF (CATCH(L).GT.0.0) SFEVAP5A.356
+ FRACA(I) = CANOPY(L) / CATCH(L) SFEVAP5A.357
IF (CANOPY(L).LT.ECANDT) THEN SFEVAP5A.358
C SFEVAP5A.359
C- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - SFEVAP5A.360
CL (b) It is assumed that any 'canopy' moisture flux in excess of the SFEVAP5A.361
CL current canopy water amount is in fact soil evaporation. SFEVAP5A.362
C- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - SFEVAP5A.363
C SFEVAP5A.364
C This situation is highly improbable - it will occur at, at SFEVAP5A.365
C most, a few gridpoints in any given timestep. SFEVAP5A.366
C SFEVAP5A.367
FRACS = 1.0 - FRACA(I)*( CANOPY(L) / ECANDT ) SFEVAP5A.368
ESDT = ESLDT * FRACS SFEVAP5A.369
ECANDT = CANOPY(L) SFEVAP5A.370
ECAN(I) = ECANDT / TIMESTEP SFEVAP5A.371
ES(I) = ESDT / TIMESTEP SFEVAP5A.372
ENDIF SFEVAP5A.373
C SFEVAP5A.374
C (The canopy store is depleted by evaporation in P252, and not here, SFEVAP5A.375
C according to the formula: CANOPY=CANOPY-ECANDT) SFEVAP5A.376
C SFEVAP5A.377
C- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - SFEVAP5A.378
CL (c) Adjustments to evaporation from soil as calculated so far :- SFEVAP5A.379
C- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - SFEVAP5A.380
C SFEVAP5A.381
IF (SMC(L).LE.0.0) THEN SFEVAP5A.382
C SFEVAP5A.383
CL (i) If there is currently no soil moisture, there must be no SFEVAP5A.384
CL evaporation of soil moisture, so this flux is set to zero. SFEVAP5A.385
C SFEVAP5A.386
ESDT = 0.0 SFEVAP5A.387
ES(I) = 0.0 SFEVAP5A.388
ELSEIF (SMC(L).LT.ESDT) THEN SFEVAP5A.389
C SFEVAP5A.390
CL (ii) Ensure that the soil evaporation is not greater than the SFEVAP5A.391
CL current soil moisture store. SFEVAP5A.392
C This situation is extremely unlikely at any given gridpoint SFEVAP5A.393
C at any given timestep. SFEVAP5A.394
C SFEVAP5A.395
ESDT = SMC(L) SFEVAP5A.396
ES(I) = ESDT / TIMESTEP SFEVAP5A.397
ENDIF SFEVAP5A.398
C SFEVAP5A.399
C (The soil moisture store is depleted by evaporation in P253, and not SFEVAP5A.400
C here, using the formula: SMC=SMC-ESDT) SFEVAP5A.401
C SFEVAP5A.402
EW(I) = ECAN(I) + ES(I) SFEVAP5A.403
EI(I) = 0.0 SFEVAP5A.404
C SFEVAP5A.405
C----------------------------------------------------------------------- SFEVAP5A.406
CL 2.2.2 Negative moisture flux onto snow-free land above freezing SFEVAP5A.407
C----------------------------------------------------------------------- SFEVAP5A.408
CL (i.e. condensation onto snow-free land). The whole flux is SFEVAP5A.409
CL into the surface/canopy store. SFEVAP5A.410
C SFEVAP5A.411
ELSEIF (TSTAR(I).GT.TM) THEN ! ELSE of evaporation / SFEVAP5A.412
C ! condensation block. SFEVAP5A.413
C SFEVAP5A.414
C Condensation implies ES=0, so ECAN=EA=EW=E (=FQW(,1)) SFEVAP5A.415
C SFEVAP5A.416
ECAN(I) = FQW(I,1) SFEVAP5A.417
ES(I) = 0.0 SFEVAP5A.418
EW(I) = ECAN(I) SFEVAP5A.419
EI(I) = 0.0 SFEVAP5A.420
C SFEVAP5A.421
C (The canopy store is augmented by interception of condensation at SFEVAP5A.422
C P252, and not here.) SFEVAP5A.423
C SFEVAP5A.424
C----------------------------------------------------------------------- SFEVAP5A.425
CL 2.2.3 Negative moisture flux onto snow-free land below freezing SFEVAP5A.426
CL (i.e. deposition of frost). SFEVAP5A.427
C----------------------------------------------------------------------- SFEVAP5A.428
C SFEVAP5A.429
ELSE ! ELSE of condensation / frost deposition block. SFEVAP5A.430
EI(I) = FQW(I,1) SFEVAP5A.431
ES(I) = 0.0 SFEVAP5A.432
EW(I) = 0.0 SFEVAP5A.433
C SFEVAP5A.434
C (Negative EI is used to increment the snowdepth store - there is SFEVAP5A.435
C no separate "frost" store. This incrementing is done in P251, SFEVAP5A.436
C according to: LYING_SNOW = LYING_SNOW - EI*TIMESTEP) SFEVAP5A.437
C SFEVAP5A.438
ENDIF ! End of evaporation/condensation/deposition block. SFEVAP5A.439
C SFEVAP5A.440
C----------------------------------------------------------------------- SFEVAP5A.441
CL 2.3 Do calculations for snow-covered land. SFEVAP5A.442
C----------------------------------------------------------------------- SFEVAP5A.443
C SFEVAP5A.444
ELSEIF (LYING_SNOW(I).LE.EDT) THEN ! ELSEIF of no-snow. SFEVAP5A.445
C SFEVAP5A.446
C********************************************************************** SFEVAP5A.447
C Store initial value of evaporation and latent heat flux SFEVAP5A.448
C********************************************************************** SFEVAP5A.449
C SFEVAP5A.450
EOLD(I) = FQW(I,1) SFEVAP5A.451
LEOLD(I) = FQW(I,1) * ( LC + LF ) SFEVAP5A.452
C SFEVAP5A.453
C----------------------------------------------------------------------- SFEVAP5A.454
CL 2.3.1 Shallow snow (lying snow or frost which is being exhausted SFEVAP5A.455
CL by evaporation). All the snow is sublimated, the remaining SFEVAP5A.456
CL moisture flux being taken from the canopy and soil, with all SFEVAP5A.457
CL the palaver of section 1.2.1 above. SFEVAP5A.458
C----------------------------------------------------------------------- SFEVAP5A.459
C SFEVAP5A.460
C This is extremely unlikely at more than one or two gridpoints SFEVAP5A.461
C at any given timestep, yet the complicated logic probably SFEVAP5A.462
C slows down the routine considerably - this section is a SFEVAP5A.463
C suitable candidate for further consideration as regards SFEVAP5A.464
C making the model optimally efficient. SFEVAP5A.465
C SFEVAP5A.466
EI(I) = LYING_SNOW(I) / TIMESTEP SFEVAP5A.467
EIDT = LYING_SNOW(I) SFEVAP5A.468
C SFEVAP5A.469
C Set EDT = ( E - SNOSUB ) * TIMESTEP. This is the moisture in kg per SFEVAP5A.470
C square metre left over to be evaporated from the canopy and soil. SFEVAP5A.471
C N.B. E=FQW(,1) SFEVAP5A.472
C SFEVAP5A.473
EDT = EDT - EIDT SFEVAP5A.474
C SFEVAP5A.475
C (Snowdepth is decreased using EI at P251, and not here. The formula SFEVAP5A.476
C used is simply: LYING_SNOW = LYING_SNOW - EI*TIMESTEP.) SFEVAP5A.477
C SFEVAP5A.478
C Now that all the snow has sublimed, canopy processes come into SFEVAP5A.479
C operation (FRACA no longer necessarily equal to 1). SFEVAP5A.480
C SFEVAP5A.481
FRACA(I) = 0.0 SFEVAP5A.482
IF (CATCH(L).GT.0.0) SFEVAP5A.483
+ FRACA(I) = CANOPY(L) / CATCH(L) SFEVAP5A.484
ECANDT = EDT * FRACA(I) SFEVAP5A.485
IF (CANOPY(L).LT.ECANDT) THEN SFEVAP5A.486
C SFEVAP5A.487
C Dry out the canopy completely and assume the remaining moisture flux SFEVAP5A.488
C is soil evaporation. SFEVAP5A.489
C SFEVAP5A.490
FRACS = 1.0 - FRACA(I)*( CANOPY(L) / ECANDT ) SFEVAP5A.491
ESDT = EDT * FRACS SFEVAP5A.492
ECANDT = CANOPY(L) SFEVAP5A.493
ELSE SFEVAP5A.494
C SFEVAP5A.495
C Calculate soil evaporation. SFEVAP5A.496
C SFEVAP5A.497
FRACS = 1.0 - FRACA(I) SFEVAP5A.498
ESDT = EDT * FRACS SFEVAP5A.499
ENDIF SFEVAP5A.500
ECAN(I) = ECANDT / TIMESTEP SFEVAP5A.501
ES(I) = ESDT / TIMESTEP SFEVAP5A.502
C SFEVAP5A.503
C (ECAN is used to deplete the canopy store at P252, and not here. The SFEVAP5A.504
C formula used is simply: CANOPY = CANOPY - ECAN*TIMESTEP.) SFEVAP5A.505
C SFEVAP5A.506
C Evaporation from soil. SFEVAP5A.507
C SFEVAP5A.508
IF (SMC(L).LE.0.0) THEN SFEVAP5A.509
C SFEVAP5A.510
C No evaporation from soil possible when there is no soil moisture. SFEVAP5A.511
C SFEVAP5A.512
ESDT = 0.0 SFEVAP5A.513
ES(I) = 0.0 SFEVAP5A.514
ELSEIF (SMC(L).LT.ESDT) THEN SFEVAP5A.515
C SFEVAP5A.516
C Limit evaporation of soil moisture in the extremely unlikely event SFEVAP5A.517
C that soil moisture is exhausted by the evaporation left over from SFEVAP5A.518
C sublimation which exhausted the snow store. SFEVAP5A.519
C SFEVAP5A.520
ESDT = SMC(L) SFEVAP5A.521
ES(I) = ESDT / TIMESTEP SFEVAP5A.522
ENDIF SFEVAP5A.523
C SFEVAP5A.524
C (ES is used to deplete the soil moisture store at P253, and not here, SFEVAP5A.525
C according to the formula: SMC = SMC - ES*TIMESTEP.) SFEVAP5A.526
C SFEVAP5A.527
EW(I) = ECAN(I) + ES(I) SFEVAP5A.528
C SFEVAP5A.529
C----------------------------------------------------------------------- SFEVAP5A.530
CL 2.3.2 Deep snow (i.e. not being exhausted by evaporation). This SFEVAP5A.531
CL covers two cases: (a) sublimation from deep snow (if total SFEVAP5A.532
CL moisture flux over the timestep is non-negative but less than SFEVAP5A.533
CL the lying snow amount), and (b) deposition onto an already SFEVAP5A.534
CL snowy surface (if the total moisture flux is negative and SFEVAP5A.535
CL the lying snow amount is positive). SFEVAP5A.536
C----------------------------------------------------------------------- SFEVAP5A.537
C SFEVAP5A.538
ELSE ! ELSE of shallow snow / deep snow block. SFEVAP5A.539
EI(I) = FQW(I,1) SFEVAP5A.540
EW(I) = 0.0 SFEVAP5A.541
C SFEVAP5A.542
C********************************************************************** SFEVAP5A.543
C Store initial value of evaporation and latent heat flux SFEVAP5A.544
C********************************************************************** SFEVAP5A.545
C SFEVAP5A.546
EOLD(I) = FQW(I,1) SFEVAP5A.547
LEOLD(I) = FQW(I,1) * ( LC + LF ) SFEVAP5A.548
C SFEVAP5A.549
C (EI is used to increase or decrease the snowdepth at P251, and not SFEVAP5A.550
C here, according to the formula: SFEVAP5A.551
C LYING_SNOW = LYING_SNOW - EI*TIMESTEP . ) SFEVAP5A.552
C SFEVAP5A.553
ENDIF ! End of no snow/shallow snow/deep snow block. SFEVAP5A.554
FQW(I,1) = EW(I) + EI(I) SFEVAP5A.555
2 CONTINUE SFEVAP5A.557
C SFEVAP5A.558
C Split loop 2 here so that it will vectorise. SFEVAP5A.559
C SFEVAP5A.560
CMIC$ DO ALL VECTOR SHARED(DTRDZ_1,DTRDZ,RHOKH_1,GAMMA, SFEVAP5A.561
CMIC$1 NRML,DTRDZ_RML,EI,EW,LEOLD,DIFF_LAT_HTF,FQW, SFEVAP5A.562
CMIC$2 EOLD,DFQW,ASHTF,DIFF_SENS_HTF,DIFF_SURF_HTF, SFEVAP5A.563
CMIC$3 ASURF,TIMESTEP,TSTAR,LAND_INDEX,RHOKH1_PRIME, SFEVAP5A.564
CMIC$4 SURF_HT_FLUX) PRIVATE(DTSTAR,I,L) SFEVAP5A.565
CDIR$ IVDEP SFEVAP5A.566
! Fujitsu vectorization directive GRB0F405.453
!OCL NOVREC GRB0F405.454
DO 24 L=LAND1,LAND1+LAND_PTS-1 SFEVAP5A.567
I = LAND_INDEX(L) SFEVAP5A.568
C SFEVAP5A.570
C*********************************************************************** SFEVAP5A.571
C 2.4 Calculate increments to surface and subsurface temperatures, SFEVAP5A.572
C surface heat and moisture fluxes and soil heat flux. Apply SFEVAP5A.573
C increments to TSTAR to give interim values before any SFEVAP5A.574
C snowmelt. SFEVAP5A.575
C*********************************************************************** SFEVAP5A.576
IF (NRML(I).GE.2) THEN SFEVAP5A.577
DTRDZ_1(I) = DTRDZ_RML(I) SFEVAP5A.578
ELSE SFEVAP5A.579
DTRDZ_1(I) = DTRDZ(I,1) SFEVAP5A.580
ENDIF SFEVAP5A.581
RHOKH1_PRIME(I) = 1.0 / ( 1.0 / RHOKH_1(I) SFEVAP5A.582
& + GAMMA(1) * DTRDZ_1(I) ) SFEVAP5A.583
DIFF_LAT_HTF = (LC + LF) * EI(I) + LC * EW(I) - LEOLD(I) SFEVAP5A.584
DFQW(I) = FQW(I,1) - EOLD(I) SFEVAP5A.585
DIFF_SENS_HTF(I) = - DIFF_LAT_HTF / SFEVAP5A.586
& ( 1. + ASHTF(I) /(RHOKH1_PRIME(I) * CP) ) SFEVAP5A.587
DIFF_SURF_HTF = - DIFF_LAT_HTF / ( 1.0 + SFEVAP5A.588
& RHOKH1_PRIME(I) * CP / ASHTF(I) ) SFEVAP5A.589
SURF_HT_FLUX(I) = SURF_HT_FLUX(I) + DIFF_SURF_HTF SFEVAP5A.590
DTSTAR = DIFF_SURF_HTF / ASHTF(I) SFEVAP5A.591
TSTAR(I) = TSTAR(I) + DTSTAR SFEVAP5A.592
24 CONTINUE SFEVAP5A.596
C SFEVAP5A.598
C----------------------------------------------------------------------- SFEVAP5A.599
CL 2.5 Do calculations for sea points. SFEVAP5A.600
C----------------------------------------------------------------------- SFEVAP5A.601
C SFEVAP5A.602
CMIC$ DO ALL VECTOR SHARED(P_FIELD, BL_LEVELS, P1, POINTS,NRML, SFEVAP5A.604
CMIC$1 LAND_MASK, ES, ECAN, EI, EOLD, SFEVAP5A.605
CMIC$2 ICE_FRACT, FQW, E_SEA,DTRDZ_RML, SFEVAP5A.606
CMIC$3 TSTAR, SMLT, SICE_MLT_HTF, KAPPAI, SFEVAP5A.607
CMIC$4 DTRDZ_1,DTRDZ,RHOKH_1,GAMMA,RHOKH1_PRIME, SFEVAP5A.608
CMIC$5 TIMESTEP,TM,TFS) PRIVATE(I, TSTARMAX) SFEVAP5A.609
CDIR$ IVDEP SFEVAP5A.610
! Fujitsu vectorization directive GRB0F405.455
!OCL NOVREC GRB0F405.456
DO 25 I=P1,P1+POINTS-1 SFEVAP5A.611
IF (.NOT.LAND_MASK(I)) THEN SFEVAP5A.612
C SFEVAP5A.614
C----------------------------------------------------------------------- SFEVAP5A.615
CL 2.5.1 Set soil and canopy evaporation amounts to zero, and set SFEVAP5A.616
CL sublimation to zero for liquid sea points. SFEVAP5A.617
C----------------------------------------------------------------------- SFEVAP5A.618
C SFEVAP5A.619
ES(I) = 0.0 SFEVAP5A.620
ECAN(I) = 0.0 SFEVAP5A.621
EI(I) = 0.0 SFEVAP5A.622
C----------------------------------------------------------------------- SFEVAP5A.623
CL 2.5.3 For sea-ice points :- SFEVAP5A.624
C----------------------------------------------------------------------- SFEVAP5A.625
C SFEVAP5A.626
IF (ICE_FRACT(I).GT.0.0) THEN SFEVAP5A.627
EOLD(I) = FQW(I,1) SFEVAP5A.628
EI(I) = FQW(I,1) - E_SEA(I) SFEVAP5A.629
IF (NRML(I).GE.2) THEN SFEVAP5A.630
DTRDZ_1(I) = DTRDZ_RML(I) SFEVAP5A.631
ELSE SFEVAP5A.632
DTRDZ_1(I) = DTRDZ(I,1) SFEVAP5A.633
ENDIF SFEVAP5A.634
RHOKH1_PRIME(I) = 1.0 / ( 1.0 / RHOKH_1(I) SFEVAP5A.635
& + ICE_FRACT(I)*GAMMA(1)*DTRDZ_1(I) ) SFEVAP5A.636
ENDIF ! End of liquid sea/sea-ice block. SFEVAP5A.637
ENDIF ! End of sea point calculations. SFEVAP5A.642
25 CONTINUE SFEVAP5A.643
C SFEVAP5A.645
C----------------------------------------------------------------------- SFEVAP5A.646
C Calculate fluxes and increments associated with melting of snow SFEVAP5A.647
C or sea-ice. SFEVAP5A.648
C----------------------------------------------------------------------- SFEVAP5A.649
CALL SF_MELT(P_FIELD,P1,LAND_FIELD,LAND1 SFEVAP5A.650
+,POINTS,LAND_MASK,LAND_PTS,LAND_INDEX SFEVAP5A.654
+,ALPHA1,ASHTF,ASURF,ICE_FRACT SFEVAP5A.656
+,RHOKH1_PRIME,TIMESTEP,SIMLT,SMLT,DFQW,DIFF_SENS_HTF SFEVAP5A.657
+,EI,LYING_SNOW,SURF_HT_FLUX,TSTAR,TI SFEVAP5A.658
+,SICE_MLT_HTF,SNOMLT_SURF_HTF,SNOWMELT,LTIMER) SFEVAP5A.659
C SFEVAP5A.660
C----------------------------------------------------------------------- SFEVAP5A.661
C 3. Update heat and moisture fluxes due to limited evaporation and snow SFEVAP5A.662
C or sea-ice melting. SFEVAP5A.663
C----------------------------------------------------------------------- SFEVAP5A.664
C SFEVAP5A.665
DO I = P1,P1+POINTS-1 SFEVAP5A.666
IF ( LAND_MASK(I) .OR. ICE_FRACT(I).GT.0.0 ) THEN SFEVAP5A.667
DQW(I) = DTRDZ_1(I) * DFQW(I) SFEVAP5A.668
DTL(I) = DTRDZ_1(I) * DIFF_SENS_HTF(I) / CP SFEVAP5A.669
TL(I,1) = TL(I,1) + DTL(I) SFEVAP5A.670
QW(I,1) = QW(I,1) + DQW(I) SFEVAP5A.671
FTL(I,1) = FTL(I,1) + DIFF_SENS_HTF(I) SFEVAP5A.672
FQW(I,1) = EOLD(I) + DFQW(I) SFEVAP5A.673
ENDIF ! LAND_MASK etc. SFEVAP5A.674
ENDDO ! P1+POINTS-1 SFEVAP5A.675
C----------------------------------------------------------------------- SFEVAP5A.676
C Apply increments to rapidly mixing layer. SFEVAP5A.677
C----------------------------------------------------------------------- SFEVAP5A.678
DO K = 2,BL_LEVELS-1 SFEVAP5A.679
KM1 = K - 1 SFEVAP5A.680
DO I = P1,P1+POINTS-1 SFEVAP5A.681
IF ( LAND_MASK(I) .OR. ICE_FRACT(I).GT.0.0 ) THEN SFEVAP5A.682
IF ( K .LE. NRML(I) ) THEN SFEVAP5A.683
TL(I,K) = TL(I,K) + DTL(I) SFEVAP5A.684
QW(I,K) = QW(I,K) + DQW(I) SFEVAP5A.685
DIFF_SENS_HTF(I) = DIFF_SENS_HTF(I) SFEVAP5A.686
& - CP * DTL(I) / DTRDZ(I,KM1) SFEVAP5A.687
DFQW(I) = DFQW(I) - DQW(I) / DTRDZ(I,KM1) SFEVAP5A.688
FTL(I,K) = FTL(I,K) + DIFF_SENS_HTF(I) SFEVAP5A.689
FQW(I,K) = FQW(I,K) + DFQW(I) SFEVAP5A.690
ENDIF ! Rapidly mixing layer SFEVAP5A.691
ENDIF ! Land or sea-ice SFEVAP5A.692
ENDDO ! Loop over points SFEVAP5A.693
ENDDO ! Loop over levels SFEVAP5A.694
C SFEVAP5A.695
C----------------------------------------------------------------------- SFEVAP5A.696
CL 4. Diagnose temperature and/or specific humidity at screen height SFEVAP5A.697
CL (1.5 metres), as requested via the STASH flags. SFEVAP5A.698
C----------------------------------------------------------------------- SFEVAP5A.699
C SFEVAP5A.700
IF (SQ1P5 .OR. ST1P5) THEN SFEVAP5A.701
IF (SQ1P5) CALL QSAT(QS(P1),TSTAR(P1),PSTAR(P1),POINTS) SFEVAP5A.702
DO 4 I=P1,P1+POINTS-1 SFEVAP5A.703
IF (ST1P5) T1P5M(I) = TSTAR(I) - GRCP*Z1P5M + CHR1P5M(I) * SFEVAP5A.704
+ ( TL(I,1) - TSTAR(I) + GRCP*(Z1(I)+Z0M(I)-Z0H(I)) ) SFEVAP5A.705
IF (SQ1P5) Q1P5M(I) = QW(I,1) + CER1P5M(I)*( QW(I,1) - QS(I) ) SFEVAP5A.706
4 CONTINUE SFEVAP5A.707
ENDIF SFEVAP5A.708
IF (LTIMER) THEN SFEVAP5A.709
CALL TIMER('SFEVAP ',4) SFEVAP5A.710
ENDIF SFEVAP5A.711
RETURN SFEVAP5A.712
END SFEVAP5A.713
*ENDIF SFEVAP5A.714