*IF DEF,A03_6A ACB1F405.8
C *****************************COPYRIGHT****************************** SFEVAP5B.3
C (c) CROWN COPYRIGHT 1997, METEOROLOGICAL OFFICE, All Rights Reserved. SFEVAP5B.4
C SFEVAP5B.5
C Use, duplication or disclosure of this code is subject to the SFEVAP5B.6
C restrictions as set forth in the contract. SFEVAP5B.7
C SFEVAP5B.8
C Meteorological Office SFEVAP5B.9
C London Road SFEVAP5B.10
C BRACKNELL SFEVAP5B.11
C Berkshire UK SFEVAP5B.12
C RG12 2SZ SFEVAP5B.13
C SFEVAP5B.14
C If no contract has been raised with this copy of the code, the use, SFEVAP5B.15
C duplication or disclosure of it is strictly prohibited. Permission SFEVAP5B.16
C to do so must first be obtained in writing from the Head of Numerical SFEVAP5B.17
C Modelling at the above address. SFEVAP5B.18
C ******************************COPYRIGHT****************************** SFEVAP5B.19
! SFEVAP5B.20
!!! SUBROUTINE SF_EVAP------------------------------------------------ SFEVAP5B.21
!!! SFEVAP5B.22
!!! Purpose: Calculate surface evaporation and sublimation amounts SFEVAP5B.23
!!! (without applying them to the surface stores). SFEVAP5B.24
!!! Also calculate heat flux due to sea-ice melting. SFEVAP5B.25
!!! Also calculate 1.5 metre T and Q. SFEVAP5B.26
!!! SFEVAP5B.27
!!! SFEVAP5B.28
!!! Suitable for single column usage. SFEVAP5B.29
!!! SFEVAP5B.30
!!! Model Modification history: SFEVAP5B.31
!!! version Date SFEVAP5B.32
!!! SFEVAP5B.33
!!! Programming standard: Unified Model Documentation Paper No 4, SFEVAP5B.34
!!! version 2, dated 18/1/90. SFEVAP5B.35
!!! SFEVAP5B.36
!!! 4.3 New deck. SFEVAP5B.37
CLL 4.5 Jul. 98 Kill the IBM specific lines (JCThil) AJC1F405.125
!!! SFEVAP5B.38
!!! Logical component covered: P245. SFEVAP5B.39
!!! SFEVAP5B.40
!!! System task: SFEVAP5B.41
!!! SFEVAP5B.42
!!! Documentation: UMDP 24 SFEVAP5B.43
!!! SFEVAP5B.44
!!!--------------------------------------------------------------------- SFEVAP5B.45
SFEVAP5B.46
! Arguments :--------------------------------------------------------- SFEVAP5B.47
SUBROUTINE SF_EVAP ( 4,14SFEVAP5B.48
& P_FIELD,P1,N_TYPES,LAND_FIELD,LAND1,GAMMA SFEVAP5B.49
&,POINTS,BL_LEVELS,LAND_MASK,LAND_PTS,LAND_INDEX SFEVAP5B.53
&,TILE_FRAC,ALPHA1,ASURF,ASHTF,CANOPY,CATCH SFEVAP5B.55
&,DTRDZ,DTRDZ_RML,E_SEA,FRACA SFEVAP5B.56
&,ICE_FRACT,NRML,RHOKH_1,SMC,TIMESTEP,CER1P5M,CHR1P5M SFEVAP5B.57
&,PSTAR,RESFS,RESFT,Z0M,Z0H,SQ1P5,ST1P5,SIMLT,SMLT SFEVAP5B.58
&,FTL,FTL_TILE,FQW,FQW_TILE,LYING_SNOW,QW,SURF_HT_FLUX SFEVAP5B.59
&,TL,TSTAR_TILE,TSTAR_GB,TI,ECAN_GB,ES,EI_GB SFEVAP5B.60
&,SICE_MLT_HTF,SNOMLT_SURF_HTF,SNOWMELT_GB SFEVAP5B.61
&,H_BLEND,HEAT_BLEND_FACTOR,QCL_1,QCF_1,Z1_TQ ARN0F405.1806
&,Q1P5M,T1P5M,LTIMER SFEVAP5B.63
&) SFEVAP5B.64
SFEVAP5B.65
IMPLICIT NONE SFEVAP5B.66
SFEVAP5B.67
LOGICAL LTIMER SFEVAP5B.68
SFEVAP5B.69
INTEGER SFEVAP5B.70
& P_FIELD ! IN No. of gridpoints in the whole grid. SFEVAP5B.71
&,P1 ! IN 1st P-pt in full field to be SFEVAP5B.72
! processed. SFEVAP5B.73
&,N_TYPES ! IN No. of land tiles SFEVAP5B.74
&,LAND_FIELD ! IN No. of landpoints in the whole grid. SFEVAP5B.75
&,LAND1 ! IN 1st L-pt in full field to be SFEVAP5B.76
! processed. SFEVAP5B.77
&,POINTS ! IN No. of gridpoints to be processed. SFEVAP5B.78
&,BL_LEVELS ! IN No. of levels treated by b.l. scheme. SFEVAP5B.79
&,LAND_PTS ! IN No. of land points to be processed. SFEVAP5B.80
SFEVAP5B.81
LOGICAL SFEVAP5B.82
& LAND_MASK(P_FIELD) ! IN T for land points, F otherwise. SFEVAP5B.83
SFEVAP5B.84
INTEGER SFEVAP5B.86
& LAND_INDEX(P_FIELD) ! IN Index of land points on the P-grid. SFEVAP5B.87
! The ith element contains the position SFEVAP5B.88
! in whole grid of the ith land point. SFEVAP5B.89
SFEVAP5B.91
REAL SFEVAP5B.92
SFEVAP5B.93
& ALPHA1(P_FIELD,N_TYPES)! IN Gradient of saturated specific SFEVAP5B.94
! humidity with respect to temp. SFEVAP5B.95
! between the bottom model layer SFEVAP5B.96
! and the surface. SFEVAP5B.97
&,ASURF(P_FIELD) ! IN Soil coefficient from P242 (m2 K per SFEVAP5B.98
! per Joule * timestep). SFEVAP5B.99
&,ASHTF(P_FIELD) ! IN Coefficient to calculate the soil SFEVAP5B.100
! heat flux between the surface and SFEVAP5B.101
! top soil layer (W/m2/K) SFEVAP5B.102
&,CANOPY(LAND_FIELD) ! IN Gridbox mean canopy / surface water SFEVAP5B.103
! store (kg/m2). SFEVAP5B.104
&,CATCH(LAND_FIELD,N_TYPES) SFEVAP5B.105
! IN Canopy / surface water store capacity SFEVAP5B.106
! (kg per sq m). SFEVAP5B.107
&,CER1P5M(P_FIELD) ! IN Interpolation coefficient, from P243 SFEVAP5B.108
&,CHR1P5M(P_FIELD) ! IN Interpolation coefficient, from P243. SFEVAP5B.109
&,DTRDZ(P_FIELD,BL_LEVELS)!IN -g.dt/dp for each model layer on SFEVAP5B.110
! p-grid From P244 ((kg/m2/s)**-1). SFEVAP5B.111
&,DTRDZ_RML(P_FIELD) ! IN -g.dt/dp for the rapidly mixing layer SFEVAP5B.112
! (if it exists) on the p-grid from SFEVAP5B.113
! P244 SFEVAP5B.114
&,E_SEA(P_FIELD) ! IN Evaporation from sea (weighted with SFEVAP5B.115
! leads fraction at sea-ice points). SFEVAP5B.116
&,FRACA(P_FIELD,N_TYPES) ! IN Fraction of surface moisture flux SFEVAP5B.117
! with only aerodynamic resistance. SFEVAP5B.118
! Diagnostics defined on land and sea. SFEVAP5B.120
&,GAMMA(BL_LEVELS) ! IN Weights for implicit BL scheme. SFEVAP5B.122
&,H_BLEND(P_FIELD) ! IN Blending height SFEVAP5B.123
&,HEAT_BLEND_FACTOR(P_FIELD) SFEVAP5B.124
! IN Used for tile adjustment SFEVAP5B.125
&,Z1_TQ(P_FIELD) ! IN Height of lowest tq level (m). ARN0F405.1807
&,ICE_FRACT(P_FIELD) ! IN Fraction of gridbox which is covered SFEVAP5B.126
! by sea-ice (decimal fraction, but SFEVAP5B.127
! mostly this sub-component assumes it SFEVAP5B.128
! to be either 1.0 or 0.0 precisely). SFEVAP5B.129
! NB Dimension is PFIELD not LAND_FIELD SFEVAP5B.131
! for snow on sea-ice in coupled model SFEVAP5B.132
! runs. SFEVAP5B.133
&,PSTAR(P_FIELD) ! IN Surface pressure (Pa). SFEVAP5B.135
&,QCL_1(P_FIELD) ! IN Liquid water at level 1 SFEVAP5B.136
&,QCF_1(P_FIELD) ! IN frozen water at level 1 SFEVAP5B.137
&,RESFS(P_FIELD,N_TYPES) ! IN Combined soil, stomatal and SFEVAP5B.138
! aerodynamic resistance factor SFEVAP5B.139
&,RESFT(P_FIELD,N_TYPES) ! IN Total resistance factor SFEVAP5B.140
! FRACA+(1-FRACA)*RESFS. SFEVAP5B.141
&,RHOKH_1(P_FIELD,N_TYPES)!IN Turbulent surface exchange SFEVAP5B.142
! coefficient for sensible heat. SFEVAP5B.143
&,SMC(LAND_FIELD,N_TYPES)! IN Soil moisture content (kg per sq m). SFEVAP5B.144
&,TILE_FRAC(P_FIELD,N_TYPES) SFEVAP5B.145
! IN fractional coverage for each tile SFEVAP5B.146
&,TIMESTEP ! IN Timestep (sec). SFEVAP5B.147
&,Z0M(P_FIELD,N_TYPES) ! IN Roughness length for momentum (m) SFEVAP5B.148
&,Z0H(P_FIELD,N_TYPES) ! IN Roughness length for heat and SFEVAP5B.149
! moisture SFEVAP5B.150
SFEVAP5B.151
INTEGER SFEVAP5B.152
& NRML(P_FIELD) ! IN The Number of model layers in the SFEVAP5B.153
! Rapidly Mixing Layer. SFEVAP5B.154
SFEVAP5B.155
LOGICAL SFEVAP5B.156
& SQ1P5 ! IN STASH flag for 1.5-metre sp humidity. SFEVAP5B.157
&,ST1P5 ! IN STASH flag for 1.5-metre temperature. SFEVAP5B.158
&,SIMLT ! IN STASH flag for sea-ice melting ht SFEVAP5B.159
! flux. SFEVAP5B.160
&,SMLT ! IN STASH flag for snow melting ht flux. SFEVAP5B.161
SFEVAP5B.162
REAL SFEVAP5B.163
& FTL(P_FIELD,BL_LEVELS) ! INOUT Sensible heat flux from layer k-1 SFEVAP5B.164
! to layer k (W/sq m). From P243 SFEVAP5B.165
! and P244, units changed in P24 SFEVAP5B.166
! top level. SFEVAP5B.167
&,FTL_TILE(P_FIELD,N_TYPES) SFEVAP5B.168
! INOUT Sensible surf heat flux for tile SFEVAP5B.169
&,FQW(P_FIELD,BL_LEVELS) ! INOUT Turbulent moisture flux from level SFEVAP5B.170
! k-1 to k (kg/sq m/s). From P243/4. SFEVAP5B.171
! Diagnostics defined on land and SFEVAP5B.173
! sea SFEVAP5B.174
&,FQW_TILE(P_FIELD,N_TYPES) SFEVAP5B.176
! INOUT Moisture flux for tile SFEVAP5B.177
&,LYING_SNOW(P_FIELD) ! INOUT Lying snow (kg per sq m). SFEVAP5B.178
&,QW(P_FIELD,BL_LEVELS) ! INOUT Total water content (kg(water)/ SFEVAP5B.179
! kg(air)). From P243/4. SFEVAP5B.180
&,SURF_HT_FLUX(P_FIELD,N_TYPES) SFEVAP5B.181
! INOUT Net downward heat flux at surface SFEVAP5B.182
! over land or sea-ice fraction of SFEVAP5B.183
! gridbox (W/m2). SFEVAP5B.184
&,TL(P_FIELD,BL_LEVELS) ! INOUT Liquid/frozen water temperature K. SFEVAP5B.185
&,TSTAR_GB(P_FIELD) ! INOUT mean land Surface temperature (K) SFEVAP5B.186
&,TSTAR_TILE(P_FIELD,N_TYPES) SFEVAP5B.187
! INOUT Tile surface temperature (K). SFEVAP5B.188
&,TI(P_FIELD) ! INOUT Sea-ice surface layer temp. (K). SFEVAP5B.189
SFEVAP5B.190
! OUTPUT SFEVAP5B.191
SFEVAP5B.192
REAL SFEVAP5B.193
& ECAN_GB(P_FIELD) ! OUT Gridbox mean evap. from canopy/ SFEVAP5B.194
! surface store (kg/m2/s). SFEVAP5B.195
! Zero over sea and sea-ice. SFEVAP5B.196
&,ES_GB(P_FIELD) ! OUT Surface evapotranspiration (through SFEVAP5B.197
! a resistance which is not entirely SFEVAP5B.198
! aerodynamic). Always non-negative. SFEVAP5B.199
! Kg per sq m per sec. SFEVAP5B.200
! Diagnostics defined on land and sea. SFEVAP5B.202
&,EI_GB(P_FIELD) ! OUT Sublimation from lying snow or sea- SFEVAP5B.204
! ice (kg per sq m per s). SFEVAP5B.205
REAL SFEVAP5B.206
& SICE_MLT_HTF(P_FIELD) ! OUT Heat flux due to melting of sea-ice SFEVAP5B.207
! (Watts per square metre). SFEVAP5B.208
&,SNOMLT_SURF_HTF(P_FIELD)!OUT Heat flux due to surface melting SFEVAP5B.209
! of snow (W/m2). SFEVAP5B.210
&,SNOWMELT_GB(P_FIELD) ! OUT Surface snowmelt (kg/m2/s). SFEVAP5B.211
&,Q1P5M(P_FIELD) ! OUT Specific humidity at screen height SFEVAP5B.212
! of 1.5 metres (kg water / kg air). SFEVAP5B.213
&,T1P5M(P_FIELD) ! OUT Temperature at 1.5 metres above the SFEVAP5B.214
! surface (K). SFEVAP5B.215
SFEVAP5B.216
SFEVAP5B.217
! External subprogram(s) required :- SFEVAP5B.218
EXTERNAL QSAT,SF_MELT SFEVAP5B.219
EXTERNAL TIMER SFEVAP5B.220
SFEVAP5B.221
SFEVAP5B.222
C*L Local and other symbolic constants used :- SFEVAP5B.223
*CALL C_0_DG_C 
SFEVAP5B.224
*CALL C_LHEAT SFEVAP5B.225
*CALL C_G SFEVAP5B.226
*CALL C_HT_M ! Contains Z1P5M SFEVAP5B.227
*CALL C_R_CP SFEVAP5B.228
*CALL C_KAPPAI SFEVAP5B.229
SFEVAP5B.230
REAL GRCP,LS,LCRCP,LSRCP SFEVAP5B.231
PARAMETER ( SFEVAP5B.232
& GRCP=G/CP ! Accn due to gravity / standard heat SFEVAP5B.233
! capacity of air at const pressure. SFEVAP5B.234
&,LS=LF+LC ! Latent heat of sublimation. SFEVAP5B.235
&,LCRCP=LC/CP ! Evaporation-to-dT conversion factor. SFEVAP5B.236
&,LSRCP=LS/CP ! Sublimation-to-dT conversion factor. SFEVAP5B.237
&) SFEVAP5B.238
SFEVAP5B.239
SFEVAP5B.240
!! Workspace SFEVAP5B.241
SFEVAP5B.242
REAL SFEVAP5B.243
& DFQW(P_FIELD,N_TYPES) ! Adjustment increment to the flux of SFEVAP5B.244
! total water for tile SFEVAP5B.245
&,DFQW_GB(P_FIELD) ! Adjustment increment to the flux of SFEVAP5B.246
! total water SFEVAP5B.247
&,DIFF_SENS_HTF(P_FIELD,N_TYPES) SFEVAP5B.248
! Adjustment increment to the sensible SFEVAP5B.249
! heat flux SFEVAP5B.250
&,DQW(P_FIELD) ! Increment to specific humidity for SFEVAP5B.251
! current tile SFEVAP5B.252
&,DTL(P_FIELD) ! Increment to temperature for current SFEVAP5B.253
! tile SFEVAP5B.254
&,DQW_GB(P_FIELD) ! Increment to specific humidity SFEVAP5B.255
&,DTL_GB(P_FIELD) ! Increment to temperature SFEVAP5B.256
&,D_S_H_GB(P_FIELD) ! Change in sens. heat flux over gridbox SFEVAP5B.257
&,DTRDZ_1(P_FIELD) ! -g.dt/dp for surface layer or rml if it SFEVAP5B.258
! exists from P244 ((kg/sq m/s)**-1). SFEVAP5B.259
&,ECAN(P_FIELD,N_TYPES) ! Tile evaporation from canopy/ SFEVAP5B.260
! surface store (kg per sq m per s). SFEVAP5B.261
! Zero over sea and sea-ice. SFEVAP5B.262
&,EOLD(P_FIELD,N_TYPES) ! Used to store initial value of evap. SFEVAP5B.263
! for current tile from P244 SFEVAP5B.264
&,EOLD_GB(P_FIELD) ! Used to store initial mean value of SFEVAP5B.265
! evap.for gridbox from P244 SFEVAP5B.266
&,EI(P_FIELD,N_TYPES) ! Sublimation from lying snow or sea- SFEVAP5B.267
! ice (kg per sq m per s). SFEVAP5B.268
&,ES(P_FIELD,N_TYPES) ! Surface evapotranspiration (through SFEVAP5B.269
! a resistance which is not entirely SFEVAP5B.270
! aerodynamic). Always non-negative. SFEVAP5B.271
! Kg per sq m per sec SFEVAP5B.272
&,EW(P_FIELD) ! Total surface flux of water, excluding SFEVAP5B.273
! sublimation/frost deposition, over land. SFEVAP5B.274
&,LEOLD(P_FIELD) ! Used to store initial value of latent SFEVAP5B.275
! heat flux from P244 SFEVAP5B.276
&,QS(P_FIELD) ! Used for saturated specific humidity SFEVAP5B.277
! at surface, in Q1P5M calculation. SFEVAP5B.278
&,QSTAR_GB(P_FIELD) ! Qstar in Q1P5M calculation. SFEVAP5B.279
&,RHOKH1_PRIME(P_FIELD,N_TYPES) SFEVAP5B.280
! Modified forward time-weighted transfer SFEVAP5B.281
! coefficient SFEVAP5B.282
&,SNOWMELT(P_FIELD,N_TYPES) SFEVAP5B.283
! Surface snowmelt (kg/m2/s). SFEVAP5B.284
SFEVAP5B.285
! Local scalars SFEVAP5B.286
REAL SFEVAP5B.287
& DIFF_LAT_HTF ! Increment to the latent heat flux. SFEVAP5B.288
&,DIFF_SURF_HTF ! Increment to the surface heat flux. SFEVAP5B.289
&,DTSTAR ! Increment for surface temperature. SFEVAP5B.290
&,EA ! Surface evaporation with only aero- SFEVAP5B.291
! dynamic resistance (+ve), or condens- SFEVAP5B.292
! ation (-ve), averaged over gridbox SFEVAP5B.293
! (kg/m2/s). SFEVAP5B.294
&,EADT ! EA (q.v.) integrated over timestep. SFEVAP5B.295
&,ECANDT ! ECAN (q.v.) integrated over timestep. SFEVAP5B.296
&,EDT ! E=FQW(,1) (q.v.) integrated over timestep. SFEVAP5B.297
&,EIDT ! EI (q.v.) integrated over timestep. SFEVAP5B.298
&,ESDT ! ES (q.v.) integrated over timestep. SFEVAP5B.299
&,ESL ! ES (q.v.) without fractional weighting SFEVAP5B.300
! factor FRACS ('L' is for 'local') SFEVAP5B.301
! (kg/m2/s). SFEVAP5B.302
&,ESLDT ! ESL (q.v.) integrated over timestep. SFEVAP5B.303
&,FRACS ! Fraction of gridbox at which moisture flux SFEVAP5B.304
! is additionally impeded by a surface and/or SFEVAP5B.305
! stomatal resistance. SFEVAP5B.306
&,QW_BLEND ! QW at blending height SFEVAP5B.307
&,TL_BLEND ! TL at blending height SFEVAP5B.308
SFEVAP5B.309
INTEGER SFEVAP5B.310
& I ! Loop counter - full horizontal field index. SFEVAP5B.311
&,ITILE ! Loop counter - land tile index. SFEVAP5B.312
&,L ! Loop counter - land field index. SFEVAP5B.313
&,K ! Loop counter in the vertical. SFEVAP5B.314
&,KM1 ! K - 1 SFEVAP5B.315
SFEVAP5B.316
IF (LTIMER) THEN SFEVAP5B.317
CALL TIMER('SFEVAP ',3) SFEVAP5B.318
ENDIF SFEVAP5B.319
SFEVAP5B.320
!----------------------------------------------------------------------- SFEVAP5B.321
!! 1. Initialise some output variables and flux increments to zero. SFEVAP5B.322
!----------------------------------------------------------------------- SFEVAP5B.323
SFEVAP5B.324
SFEVAP5B.325
DO I=P1,P1+POINTS-1 SFEVAP5B.326
ECAN_GB(I) = 0.0 SFEVAP5B.327
ES_GB(I) = 0.0 SFEVAP5B.328
EI_GB(I) = 0.0 SFEVAP5B.329
D_S_H_GB(I) = 0.0 SFEVAP5B.330
DFQW_GB(I) = 0.0 SFEVAP5B.331
SNOWMELT_GB(I) = 0.0 SFEVAP5B.332
ENDDO SFEVAP5B.333
SFEVAP5B.334
DO ITILE=1,N_TYPES SFEVAP5B.335
DO I=P1,P1+POINTS-1 SFEVAP5B.336
DIFF_SENS_HTF(I,ITILE) = 0.0 SFEVAP5B.337
DFQW(I,ITILE) = 0.0 SFEVAP5B.338
EI(I,ITILE) = 0.0 SFEVAP5B.339
SNOWMELT(I,ITILE) = 0.0 SFEVAP5B.340
ECAN(I,ITILE) = 0.0 SFEVAP5B.341
ENDDO SFEVAP5B.342
ENDDO SFEVAP5B.343
SFEVAP5B.344
!--------------------------------------------------------------------- SFEVAP5B.345
!! 2. Do calculations for land points. SFEVAP5B.346
!--------------------------------------------------------------------- SFEVAP5B.347
SFEVAP5B.348
CMIC$ DO ALL VECTOR SHARED(P_FIELD, LAND_FIELD, BL_LEVELS, LAND1, SFEVAP5B.349
CMIC$1 LAND_PTS, LAND_INDEX, ESL, TIMESTEP, ES, LYING_SNOW, ECAN, SFEVAP5B.350
CMIC$2 EA, CATCH, CANOPY, SMC, EI, TSTAR_TILE, FQW_TILE, EOLD, SFEVAP5B.351
CMIC$3 LEOLD, P1,POINTS,LC,LF,TM,LAND_MASK,EW,FRACA,RESFT,RESFS) SFEVAP5B.352
CMIC$4 PRIVATE(I, L, ESLDT, SFEVAP5B.353
CMIC$5 ESDT, EADT, EDT, ECANDT, FRACS, EIDT) SFEVAP5B.354
CDIR$ IVDEP SFEVAP5B.355
! Fujitsu vectorization directive GRB0F405.457
!OCL NOVREC GRB0F405.458
SFEVAP5B.356
DO ITILE=1,N_TYPES SFEVAP5B.357
SFEVAP5B.358
DO L=LAND1,LAND1+LAND_PTS-1 SFEVAP5B.364
I = LAND_INDEX(L) SFEVAP5B.365
SFEVAP5B.367
IF (FQW_TILE(I,ITILE).EQ.0.0) THEN SFEVAP5B.368
EA = 0.0 SFEVAP5B.369
ESL = 0.0 SFEVAP5B.370
ELSE SFEVAP5B.371
EA = FQW_TILE(I,ITILE) / RESFT(I,ITILE) * FRACA(I,ITILE) SFEVAP5B.372
ESL = FQW_TILE(I,ITILE) / RESFT(I,ITILE) * RESFS(I,ITILE) SFEVAP5B.373
END IF SFEVAP5B.374
ES(I,ITILE) = ESL * (1. - FRACA(I,ITILE)) SFEVAP5B.375
SFEVAP5B.376
!----------------------------------------------------------------------- SFEVAP5B.377
!! 2.1 Calculate fluxes integrated over timestep. SFEVAP5B.378
!----------------------------------------------------------------------- SFEVAP5B.379
SFEVAP5B.380
ESLDT = ESL * TIMESTEP SFEVAP5B.381
EADT = EA * TIMESTEP SFEVAP5B.382
ESDT = ES(I,ITILE) * TIMESTEP SFEVAP5B.383
EDT = EADT + ESDT SFEVAP5B.384
SFEVAP5B.385
!----------------------------------------------------------------------- SFEVAP5B.386
!! 2.2 Do calculations for snow-free land. Canopy processes operate. SFEVAP5B.387
!! LYING_SNOW is defined on sea and land points for snow on sea-ice SFEVAP5B.389
!! in coupled model runs. SFEVAP5B.390
!----------------------------------------------------------------------- SFEVAP5B.392
SFEVAP5B.393
IF (LYING_SNOW(I).LE.0.0) THEN SFEVAP5B.394
SFEVAP5B.395
!********************************************************************** SFEVAP5B.396
! Store initial value of evaporation and latent heat flux SFEVAP5B.397
!********************************************************************** SFEVAP5B.398
SFEVAP5B.399
EOLD(I,ITILE) = FQW_TILE(I,ITILE) SFEVAP5B.400
EOLD_GB(I) = FQW(I,1) SFEVAP5B.401
LEOLD(I) = FQW_TILE(I,ITILE) * LC SFEVAP5B.402
IF (EDT.GE.0.0) THEN SFEVAP5B.403
SFEVAP5B.404
!----------------------------------------------------------------------- SFEVAP5B.405
!! 2.2.1 Non-negative moisture flux over snow-free land. SFEVAP5B.406
!----------------------------------------------------------------------- SFEVAP5B.407
SFEVAP5B.408
!- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - SFEVAP5B.409
!! (a) Water in canopy and soil is assumed to be liquid, so all SFEVAP5B.410
!! positive moisture flux over snow-free land is evaporation SFEVAP5B.411
!! rather than sublimation, even if TSTAR_TILE is less than or SFEVAP5B.412
!! equal to TM. SFEVAP5B.413
!- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - SFEVAP5B.414
SFEVAP5B.415
ECAN(I,ITILE) = EA SFEVAP5B.416
ECANDT = EADT SFEVAP5B.417
SFEVAP5B.418
! If EDT is non-negative, then ECANDT must be non-negative. SFEVAP5B.419
SFEVAP5B.420
FRACA(I,ITILE) = 0.0 SFEVAP5B.421
IF (CATCH(L,ITILE).GT.0.0) SFEVAP5B.422
& FRACA(I,ITILE) = CANOPY(L) / CATCH(L,ITILE) SFEVAP5B.423
IF (CANOPY(L).LT.ECANDT) THEN SFEVAP5B.424
SFEVAP5B.425
!- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - SFEVAP5B.426
!! (b) It is assumed that any 'canopy' moisture flux in excess of the SFEVAP5B.427
!! current canopy water amount is in fact soil evaporation. SFEVAP5B.428
!- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - SFEVAP5B.429
SFEVAP5B.430
! This situation is highly improbable - it will occur at, at SFEVAP5B.431
! most, a few gridpoints in any given timestep. SFEVAP5B.432
SFEVAP5B.433
FRACS = 1.0 - FRACA(I,ITILE)*( CANOPY(L) / ECANDT ) SFEVAP5B.434
ESDT = ESLDT * FRACS SFEVAP5B.435
ECANDT = CANOPY(L) SFEVAP5B.436
ECAN(I,ITILE) = ECANDT / TIMESTEP SFEVAP5B.437
ES(I,ITILE) = ESDT / TIMESTEP SFEVAP5B.438
ENDIF SFEVAP5B.439
SFEVAP5B.440
! (The canopy store is depleted by evaporation in P252, and not here, SFEVAP5B.441
! according to the formula: CANOPY=CANOPY-ECANDT) SFEVAP5B.442
SFEVAP5B.443
!- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - SFEVAP5B.444
!! (c) Adjustments to evaporation from soil as calculated so far :- SFEVAP5B.445
!- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - SFEVAP5B.446
SFEVAP5B.447
IF (SMC(L,ITILE).LE.0.0) THEN SFEVAP5B.448
SFEVAP5B.449
!! (i) If there is currently no soil moisture, there must be no SFEVAP5B.450
!! evaporation of soil moisture, so this flux is set to zero. SFEVAP5B.451
SFEVAP5B.452
ESDT = 0.0 SFEVAP5B.453
ES(I,ITILE) = 0.0 SFEVAP5B.454
ELSEIF (SMC(L,ITILE).LT.ESDT) THEN SFEVAP5B.455
SFEVAP5B.456
SFEVAP5B.457
!! (ii) Ensure that the soil evaporation is not greater than the SFEVAP5B.458
!! current soil moisture store. SFEVAP5B.459
! This situation is extremely unlikely at any given gridpoint SFEVAP5B.460
! at any given timestep. SFEVAP5B.461
SFEVAP5B.462
ESDT = SMC(L,ITILE) SFEVAP5B.463
ES(I,ITILE) = ESDT / TIMESTEP SFEVAP5B.464
ENDIF SFEVAP5B.465
SFEVAP5B.466
! (The soil moisture store is depleted by evaporation in P253, and not SFEVAP5B.467
! here, using the formula: SMC=SMC-ESDT) SFEVAP5B.468
SFEVAP5B.469
EW(I) = ECAN(I,ITILE) + ES(I,ITILE) SFEVAP5B.470
EI(I,ITILE) = 0.0 SFEVAP5B.471
SFEVAP5B.472
!----------------------------------------------------------------------- SFEVAP5B.473
!! 2.2.2 Negative moisture flux onto snow-free land above freezing SFEVAP5B.474
!----------------------------------------------------------------------- SFEVAP5B.475
!! (i.e. condensation onto snow-free land). The whole flux is SFEVAP5B.476
!! into the surface/canopy store. SFEVAP5B.477
SFEVAP5B.478
ELSEIF (TSTAR_TILE(I,ITILE).GT.TM) THEN ! ELSE of SFEVAP5B.479
! ! evaporation/condensation block. SFEVAP5B.480
SFEVAP5B.481
! Condensation implies ES=0, so ECAN=EA=EW=E (=FQW(,1)) SFEVAP5B.482
SFEVAP5B.483
ECAN(I,ITILE) = FQW_TILE(I,ITILE) SFEVAP5B.484
ES(I,ITILE) = 0.0 SFEVAP5B.485
EW(I) = ECAN(I,ITILE) SFEVAP5B.486
EI(I,ITILE) = 0.0 SFEVAP5B.487
SFEVAP5B.488
! (The canopy store is augmented by interception of condensation at SFEVAP5B.489
! P252, and not here.) SFEVAP5B.490
SFEVAP5B.491
!----------------------------------------------------------------------- SFEVAP5B.492
!! 2.2.3 Negative moisture flux onto snow-free land below freezing SFEVAP5B.493
!! (i.e. deposition of frost). SFEVAP5B.494
!----------------------------------------------------------------------- SFEVAP5B.495
SFEVAP5B.496
ELSE ! ELSE of condensation / frost deposition block. SFEVAP5B.497
EI(I,ITILE) = FQW_TILE(I,ITILE) SFEVAP5B.498
ES(I,ITILE) = 0.0 SFEVAP5B.499
EW(I) = 0.0 SFEVAP5B.500
SFEVAP5B.501
! (Negative EI is used to increment the snowdepth store - there is SFEVAP5B.502
! no separate "frost" store. This incrementing is done in P251, SFEVAP5B.503
! according to: LYING_SNOW = LYING_SNOW - EI*TIMESTEP) SFEVAP5B.504
SFEVAP5B.505
ENDIF ! End of evaporation/condensation/deposition block. SFEVAP5B.506
SFEVAP5B.507
!----------------------------------------------------------------------- SFEVAP5B.508
!! 2.3 Do calculations for snow-covered land. SFEVAP5B.509
!----------------------------------------------------------------------- SFEVAP5B.510
SFEVAP5B.511
ELSEIF (LYING_SNOW(I).LE.EDT) THEN ! ELSEIF of no-snow. SFEVAP5B.512
SFEVAP5B.513
!********************************************************************** SFEVAP5B.514
! Store initial value of evaporation and latent heat flux SFEVAP5B.515
!********************************************************************** SFEVAP5B.516
SFEVAP5B.517
EOLD(I,ITILE) = FQW_TILE(I,ITILE) SFEVAP5B.518
EOLD_GB(I) = FQW(I,1) SFEVAP5B.519
LEOLD(I) = FQW(I,1) * ( LC + LF ) SFEVAP5B.520
SFEVAP5B.521
!----------------------------------------------------------------------- SFEVAP5B.522
!! 2.3.1 Shallow snow (lying snow or frost which is being exhausted SFEVAP5B.523
!! by evaporation). All the snow is sublimated, the remaining SFEVAP5B.524
!! moisture flux being taken from the canopy and soil, with all SFEVAP5B.525
!! the palaver of section 1.2.1 above. SFEVAP5B.526
!----------------------------------------------------------------------- SFEVAP5B.527
SFEVAP5B.528
! This is extremely unlikely at more than one or two gridpoints SFEVAP5B.529
! at any given timestep, yet the complicated logic probably SFEVAP5B.530
! slows down the routine considerably - this section is a SFEVAP5B.531
! suitable candidate for further consideration as regards SFEVAP5B.532
! making the model optimally efficient. SFEVAP5B.533
SFEVAP5B.534
EI(I,ITILE) = LYING_SNOW(I) / TIMESTEP SFEVAP5B.535
EIDT = LYING_SNOW(I) SFEVAP5B.536
SFEVAP5B.537
! Set EDT = ( E - SNOSUB ) * TIMESTEP. This is the moisture in kg per SFEVAP5B.538
! square metre left over to be evaporated from the canopy and soil. SFEVAP5B.539
! N.B. E=FQW(,1) SFEVAP5B.540
SFEVAP5B.541
EDT = EDT - EIDT SFEVAP5B.542
SFEVAP5B.543
! (Snowdepth is decreased using EI at P251, and not here. The formula SFEVAP5B.544
! used is simply: LYING_SNOW = LYING_SNOW - EI*TIMESTEP.) SFEVAP5B.545
SFEVAP5B.546
! Now that all the snow has sublimed, canopy processes come into SFEVAP5B.547
! operation (FRACA no longer necessarily equal to 1). SFEVAP5B.548
SFEVAP5B.549
FRACA(I,ITILE) = 0.0 SFEVAP5B.550
IF (CATCH(L,ITILE).GT.0.0) SFEVAP5B.551
& FRACA(I,ITILE) = CANOPY(L) / CATCH(L,ITILE) SFEVAP5B.552
ECANDT = EDT * FRACA(I,ITILE) SFEVAP5B.553
IF (CANOPY(L).LT.ECANDT) THEN SFEVAP5B.554
SFEVAP5B.555
! Dry out the canopy completely and assume the remaining moisture flux SFEVAP5B.556
! is soil evaporation. SFEVAP5B.557
SFEVAP5B.558
FRACS = 1.0 - FRACA(I,ITILE)*( CANOPY(L) / ECANDT ) SFEVAP5B.559
ESDT = EDT * FRACS SFEVAP5B.560
ECANDT = CANOPY(L) SFEVAP5B.561
ELSE SFEVAP5B.562
SFEVAP5B.563
! Calculate soil evaporation. SFEVAP5B.564
SFEVAP5B.565
FRACS = 1.0 - FRACA(I,ITILE) SFEVAP5B.566
ESDT = EDT * FRACS SFEVAP5B.567
ENDIF SFEVAP5B.568
ECAN(I,ITILE) = ECANDT / TIMESTEP SFEVAP5B.569
ES(I,ITILE) = ESDT / TIMESTEP SFEVAP5B.570
SFEVAP5B.571
! (ECAN is used to deplete the canopy store at P252, and not here. The SFEVAP5B.572
! formula used is simply: CANOPY = CANOPY - ECAN*TIMESTEP.) SFEVAP5B.573
SFEVAP5B.574
! Evaporation from soil. SFEVAP5B.575
SFEVAP5B.576
IF (SMC(L,ITILE).LE.0.0) THEN SFEVAP5B.577
SFEVAP5B.578
! No evaporation from soil possible when there is no soil moisture. SFEVAP5B.579
SFEVAP5B.580
ESDT = 0.0 SFEVAP5B.581
ES(I,ITILE) = 0.0 SFEVAP5B.582
ELSEIF (SMC(L,ITILE).LT.ESDT) THEN SFEVAP5B.583
SFEVAP5B.584
! Limit evaporation of soil moisture in the extremely unlikely event SFEVAP5B.585
! that soil moisture is exhausted by the evaporation left over from SFEVAP5B.586
! sublimation which exhausted the snow store. SFEVAP5B.587
SFEVAP5B.588
ESDT = SMC(L,ITILE) SFEVAP5B.589
ES(I,ITILE) = ESDT / TIMESTEP SFEVAP5B.590
ENDIF SFEVAP5B.591
SFEVAP5B.592
! (ES is used to deplete the soil moisture store at P253, and not here, SFEVAP5B.593
! according to the formula: SMC = SMC - ES*TIMESTEP.) SFEVAP5B.594
SFEVAP5B.595
EW(I) = ECAN(I,ITILE) + ES(I,ITILE) SFEVAP5B.596
SFEVAP5B.597
!----------------------------------------------------------------------- SFEVAP5B.598
!! 2.3.2 Deep snow (i.e. not being exhausted by evaporation). This SFEVAP5B.599
!! covers two cases: (a) sublimation from deep snow (if total SFEVAP5B.600
!! moisture flux over the timestep is non-negative but less than SFEVAP5B.601
!! the lying snow amount), and (b) deposition onto an already SFEVAP5B.602
!! snowy surface (if the total moisture flux is negative and SFEVAP5B.603
!! the lying snow amount is positive). SFEVAP5B.604
!----------------------------------------------------------------------- SFEVAP5B.605
SFEVAP5B.606
ELSE ! ELSE of shallow snow / deep snow block. SFEVAP5B.607
EI(I,ITILE) = FQW_TILE(I,ITILE) SFEVAP5B.608
EW(I) = 0.0 SFEVAP5B.609
SFEVAP5B.610
!********************************************************************** SFEVAP5B.611
! Store initial value of evaporation and latent heat flux SFEVAP5B.612
!********************************************************************** SFEVAP5B.613
SFEVAP5B.614
EOLD(I,ITILE) = FQW_TILE(I,ITILE) SFEVAP5B.615
EOLD_GB(I) = FQW(I,1) SFEVAP5B.616
LEOLD(I) = FQW_TILE(I,ITILE) * ( LC + LF ) SFEVAP5B.617
SFEVAP5B.618
! (EI is used to increase or decrease the snowdepth at P251, and not SFEVAP5B.619
! here, according to the formula: SFEVAP5B.620
! LYING_SNOW = LYING_SNOW - EI*TIMESTEP . ) SFEVAP5B.621
SFEVAP5B.622
ENDIF ! End of no snow/shallow snow/deep snow block. SFEVAP5B.623
FQW_TILE(I,ITILE) = EW(I) + EI(I,ITILE) SFEVAP5B.624
SFEVAP5B.625
ENDDO ! end of loop over land points SFEVAP5B.627
SFEVAP5B.628
! Split loop 2 here so that it will vectorise. SFEVAP5B.629
SFEVAP5B.630
CMIC$ DO ALL VECTOR SHARED(DTRDZ_1,DTRDZ,RHOKH_1,GAMMA, SFEVAP5B.631
CMIC$1 NRML,DTRDZ_RML,EI,EW,LEOLD,DIFF_LAT_HTF,FQW, SFEVAP5B.632
CMIC$2 EOLD,DFQW,ASHTF,DIFF_SENS_HTF,DIFF_SURF_HTF, SFEVAP5B.633
CMIC$3 ASURF,TIMESTEP,TSTAR_TILE,LAND_INDEX,RHOKH1_PRIME,SURF_HT_FLUX) SFEVAP5B.634
CMIC$4 PRIVATE(DTSTAR,I) SFEVAP5B.635
CDIR$ IVDEP SFEVAP5B.636
! Fujitsu vectorization directive GRB0F405.459
!OCL NOVREC GRB0F405.460
SFEVAP5B.637
DO L=LAND1,LAND1+LAND_PTS-1 SFEVAP5B.638
I = LAND_INDEX(L) SFEVAP5B.639
SFEVAP5B.641
!*********************************************************************** SFEVAP5B.642
! 2.4 Calculate increments to surface and subsurface temperatures, SFEVAP5B.643
! surface heat and moisture fluxes and soil heat flux. Apply SFEVAP5B.644
! increments to TSTAR_TILE to give interim values before any SFEVAP5B.645
! snowmelt. SFEVAP5B.646
!*********************************************************************** SFEVAP5B.647
IF (NRML(I).GE.2) THEN SFEVAP5B.648
DTRDZ_1(I) = DTRDZ_RML(I) SFEVAP5B.649
ELSE SFEVAP5B.650
DTRDZ_1(I) = DTRDZ(I,1) SFEVAP5B.651
ENDIF SFEVAP5B.652
RHOKH1_PRIME(I,ITILE) = 1.0 / SFEVAP5B.653
& ( 1.0 / RHOKH_1(I,ITILE) + GAMMA(1) * DTRDZ_1(I)) SFEVAP5B.654
SFEVAP5B.655
DIFF_LAT_HTF = (LC + LF) * EI(I,ITILE) + SFEVAP5B.656
& LC * EW(I) - LEOLD(I) SFEVAP5B.657
DFQW(I,ITILE) = FQW_TILE(I,ITILE) - EOLD(I,ITILE) SFEVAP5B.658
SFEVAP5B.659
DIFF_SENS_HTF(I,ITILE) = - DIFF_LAT_HTF / SFEVAP5B.660
& ( 1. + ASHTF(I) /(RHOKH1_PRIME(I,ITILE) * CP) ) SFEVAP5B.661
SFEVAP5B.662
DIFF_SURF_HTF = - DIFF_LAT_HTF / ( 1.0 + SFEVAP5B.663
& RHOKH1_PRIME(I,ITILE) * CP / ASHTF(I) ) SFEVAP5B.664
SFEVAP5B.665
SURF_HT_FLUX(I,ITILE) = SURF_HT_FLUX(I,ITILE) + SFEVAP5B.666
& DIFF_SURF_HTF SFEVAP5B.667
DTSTAR = DIFF_SURF_HTF / ASHTF(I) SFEVAP5B.668
TSTAR_TILE(I,ITILE) = TSTAR_TILE(I,ITILE) + DTSTAR SFEVAP5B.669
SFEVAP5B.670
ENDDO !End of loop over land points SFEVAP5B.674
ENDDO !End of tile loop SFEVAP5B.675
SFEVAP5B.676
!----------------------------------------------------------------------- SFEVAP5B.677
!! 2.5 Do calculations for sea points. SFEVAP5B.678
!----------------------------------------------------------------------- SFEVAP5B.679
SFEVAP5B.680
CMIC$ DO ALL VECTOR SHARED(P_FIELD, BL_LEVELS, P1, POINTS,NRML, SFEVAP5B.682
CMIC$1 LAND_MASK, ES, EI, EOLD, SFEVAP5B.683
CMIC$2 ICE_FRACT, FQW, E_SEA,DTRDZ_RML, SFEVAP5B.684
CMIC$3 TSTAR_TILE, TSTAR_GB, SMLT, SICE_MLT_HTF, KAPPAI, SFEVAP5B.685
CMIC$4 DTRDZ_1,DTRDZ,RHOKH_1,GAMMA,RHOKH1_PRIME, SFEVAP5B.686
CMIC$5 TIMESTEP,TM,TFS) PRIVATE(I, TSTARMAX) SFEVAP5B.687
CDIR$ IVDEP SFEVAP5B.688
! Fujitsu vectorization directive GRB0F405.461
!OCL NOVREC GRB0F405.462
SFEVAP5B.690
SFEVAP5B.691
DO I=P1,P1+POINTS-1 SFEVAP5B.692
IF (.NOT.LAND_MASK(I)) THEN SFEVAP5B.693
SFEVAP5B.694
!----------------------------------------------------------------------- SFEVAP5B.695
!! 2.5.1 Set soil and canopy evaporation amounts to zero, and set SFEVAP5B.696
!! sublimation to zero for liquid sea points. SFEVAP5B.697
!----------------------------------------------------------------------- SFEVAP5B.698
SFEVAP5B.699
ES(I,1) = 0.0 SFEVAP5B.700
EI(I,1) = 0.0 SFEVAP5B.701
!----------------------------------------------------------------------- SFEVAP5B.702
!! 2.5.3 For sea-ice points :- SFEVAP5B.703
!----------------------------------------------------------------------- SFEVAP5B.704
SFEVAP5B.705
IF (ICE_FRACT(I).GT.0.0) THEN SFEVAP5B.706
EOLD_GB(I) = FQW(I,1) SFEVAP5B.707
EI(I,1) = FQW(I,1) - E_SEA(I) SFEVAP5B.708
IF (NRML(I).GE.2) THEN SFEVAP5B.709
DTRDZ_1(I) = DTRDZ_RML(I) SFEVAP5B.710
ELSE SFEVAP5B.711
DTRDZ_1(I) = DTRDZ(I,1) SFEVAP5B.712
ENDIF SFEVAP5B.713
RHOKH1_PRIME(I,1) = 1.0 / ( 1.0 / RHOKH_1(I,1) SFEVAP5B.714
& + ICE_FRACT(I)*GAMMA(1)*DTRDZ_1(I) ) SFEVAP5B.715
ENDIF ! End of liquid sea/sea-ice block. SFEVAP5B.716
SFEVAP5B.717
ENDIF ! End of sea point calculations. SFEVAP5B.718
ENDDO !End of loop over points SFEVAP5B.719
SFEVAP5B.720
!----------------------------------------------------------------------- SFEVAP5B.721
! Calculate fluxes and increments associated with melting of snow SFEVAP5B.722
! or sea-ice. SFEVAP5B.723
!----------------------------------------------------------------------- SFEVAP5B.724
SFEVAP5B.725
SFEVAP5B.726
CALL SF_MELT(P_FIELD,P1,N_TYPES,LAND_FIELD,LAND1 SFEVAP5B.727
&,POINTS,LAND_MASK,LAND_PTS,LAND_INDEX SFEVAP5B.731
&,ALPHA1,ASHTF,ASURF,TILE_FRAC,ICE_FRACT SFEVAP5B.733
&,RHOKH1_PRIME,TIMESTEP,SIMLT,SMLT,DFQW,DIFF_SENS_HTF SFEVAP5B.734
&,EI,LYING_SNOW,SURF_HT_FLUX,TSTAR_TILE,TI SFEVAP5B.735
&,SICE_MLT_HTF,SNOMLT_SURF_HTF,SNOWMELT,LTIMER) SFEVAP5B.736
SFEVAP5B.737
!----------------------------------------------------------------------- SFEVAP5B.738
! 3. Update heat and moisture fluxes due to limited evaporation and snow SFEVAP5B.739
! or sea-ice melting. SFEVAP5B.740
!----------------------------------------------------------------------- SFEVAP5B.741
SFEVAP5B.742
DO I = P1,P1+POINTS-1 SFEVAP5B.743
SFEVAP5B.744
TSTAR_GB(I) = TSTAR_TILE(I,1) SFEVAP5B.745
EI_GB(I) = EI(I,1) SFEVAP5B.746
SNOWMELT_GB(I)=SNOWMELT(I,1) SFEVAP5B.747
SFEVAP5B.748
SFEVAP5B.749
IF ( ICE_FRACT(I).GT.0.0 ) THEN SFEVAP5B.750
DQW_GB(I) = DTRDZ_1(I) * DFQW(I,1) SFEVAP5B.751
DTL_GB(I) = DTRDZ_1(I) * DIFF_SENS_HTF(I,1) / CP SFEVAP5B.752
TL(I,1) = TL(I,1) + DTL_GB(I) SFEVAP5B.753
QW(I,1) = QW(I,1) + DQW_GB(I) SFEVAP5B.754
FTL(I,1) = FTL(I,1) + DIFF_SENS_HTF(I,1) SFEVAP5B.755
FQW(I,1) = EOLD_GB(I) + DFQW(I,1) SFEVAP5B.756
SFEVAP5B.757
do itile=1,n_types SFEVAP5B.758
ftl_tile(i,itile)=ftl_tile(i,itile) + DIFF_SENS_HTF(I,1) SFEVAP5B.759
fqw_tile(i,itile)=fqw_tile(i,itile) + DFQW(I,1) SFEVAP5B.760
enddo SFEVAP5B.761
SFEVAP5B.762
D_S_H_GB(I) = DIFF_SENS_HTF(I,1) SFEVAP5B.763
DFQW_GB(I) = DFQW(I,1) SFEVAP5B.764
SFEVAP5B.765
ENDIF ! ice_fract .gt. 0 SFEVAP5B.766
SFEVAP5B.767
IF ( LAND_MASK(I) ) THEN SFEVAP5B.768
SFEVAP5B.769
DQW_GB(I) = 0.0 SFEVAP5B.770
EI_GB(I) = 0.0 SFEVAP5B.771
DTL_GB(I) = 0.0 SFEVAP5B.772
D_S_H_GB(I) = 0.0 SFEVAP5B.773
DFQW_GB(I) = 0.0 SFEVAP5B.774
SNOWMELT_GB(I) = 0.0 SFEVAP5B.775
TSTAR_GB(I) = 0.0 SFEVAP5B.776
ENDIF ! land SFEVAP5B.777
ENDDO ! POINTS SFEVAP5B.778
SFEVAP5B.779
SFEVAP5B.780
DO ITILE=1,N_TYPES SFEVAP5B.781
CDIR$ IVDEP SFEVAP5B.786
! Fujitsu vectorization directive GRB0F405.463
!OCL NOVREC GRB0F405.464
DO L=LAND1,LAND1+LAND_PTS-1 SFEVAP5B.787
I = LAND_INDEX(L) SFEVAP5B.788
SFEVAP5B.790
DQW(I) = DTRDZ_1(I) * DFQW(I,ITILE) SFEVAP5B.791
DTL(I) = DTRDZ_1(I) * DIFF_SENS_HTF(I,ITILE) / CP SFEVAP5B.792
EI_GB(I) = EI_GB(I) + EI(I,ITILE) * TILE_FRAC(I,ITILE) SFEVAP5B.793
DQW_GB(I) = DQW_GB(I) + DQW(I) * TILE_FRAC(I,ITILE) SFEVAP5B.794
DTL_GB(I) = DTL_GB(I) + DTL(I) * TILE_FRAC(I,ITILE) SFEVAP5B.795
D_S_H_GB(I) = D_S_H_GB(I) + DIFF_SENS_HTF(I,ITILE) * SFEVAP5B.796
& TILE_FRAC(I,ITILE) SFEVAP5B.797
DFQW_GB(I) = DFQW_GB(I) + DFQW(I,ITILE) * SFEVAP5B.798
& TILE_FRAC(I,ITILE) SFEVAP5B.799
SFEVAP5B.800
TSTAR_GB(I) = TSTAR_GB(I) + TSTAR_TILE(I,ITILE) * SFEVAP5B.801
& TILE_FRAC(I,ITILE) SFEVAP5B.802
SFEVAP5B.803
ECAN_GB(I) = ECAN_GB(I) + ECAN(I,ITILE) * SFEVAP5B.804
& TILE_FRAC(I,ITILE) SFEVAP5B.805
SFEVAP5B.806
SNOWMELT_GB(I)=SNOWMELT_GB(I) + SNOWMELT(I,ITILE) * SFEVAP5B.807
& TILE_FRAC(I,ITILE) SFEVAP5B.808
SFEVAP5B.809
TL(I,1) = TL(I,1) + DTL(I) * TILE_FRAC(I,ITILE) SFEVAP5B.810
QW(I,1) = QW(I,1) + DQW(I) * TILE_FRAC(I,ITILE) SFEVAP5B.811
SFEVAP5B.812
FTL_TILE(I,ITILE) = FTL_TILE(I,ITILE) + SFEVAP5B.813
& DIFF_SENS_HTF(I,ITILE) SFEVAP5B.814
FQW_TILE(I,ITILE) = EOLD(I,ITILE) + DFQW(I,ITILE) SFEVAP5B.815
SFEVAP5B.816
ENDDO ! land points SFEVAP5B.820
ENDDO ! Tile loop SFEVAP5B.821
SFEVAP5B.822
SFEVAP5B.823
DO I=P1,P1+POINTS-1 SFEVAP5B.824
IF ( LAND_MASK(I)) THEN SFEVAP5B.825
FTL(I,1) = FTL(I,1) + D_S_H_GB(I) SFEVAP5B.826
FQW(I,1) = EOLD_GB(I) + DFQW_GB(I) SFEVAP5B.827
ENDIF ! Land block SFEVAP5B.828
ENDDO SFEVAP5B.829
SFEVAP5B.830
SFEVAP5B.831
!----------------------------------------------------------------------- SFEVAP5B.832
!! Apply increments to rapidly mixing layer. SFEVAP5B.833
!----------------------------------------------------------------------- SFEVAP5B.834
SFEVAP5B.835
DO K = 2,BL_LEVELS-1 SFEVAP5B.836
KM1 = K - 1 SFEVAP5B.837
DO I=P1,P1+POINTS-1 SFEVAP5B.838
SFEVAP5B.839
IF ( LAND_MASK(I) .OR. ICE_FRACT(I).GT.0.0 ) THEN SFEVAP5B.840
IF ( K .LE. NRML(I) ) THEN SFEVAP5B.841
TL(I,K) = TL(I,K) + DTL_GB(I) SFEVAP5B.842
QW(I,K) = QW(I,K) + DQW_GB(I) SFEVAP5B.843
D_S_H_GB(I) = D_S_H_GB(I) SFEVAP5B.844
& - CP * DTL_GB(I) / DTRDZ(I,KM1) SFEVAP5B.845
DFQW_GB(I) = DFQW_GB(I) - DQW_GB(I) / DTRDZ(I,KM1) SFEVAP5B.846
FTL(I,K) = FTL(I,K) + D_S_H_GB(I) SFEVAP5B.847
FQW(I,K) = FQW(I,K) + DFQW_GB(I) SFEVAP5B.848
ENDIF ! Rapidly mixing layer SFEVAP5B.849
ENDIF ! Land or sea-ice SFEVAP5B.850
ENDDO ! Loop over points SFEVAP5B.851
ENDDO ! Loop over levels SFEVAP5B.852
SFEVAP5B.853
!----------------------------------------------------------------------- SFEVAP5B.854
!! 4. Diagnose temperature and/or specific humidity at screen height SFEVAP5B.855
!! (1.5 metres), as requested via the STASH flags. SFEVAP5B.856
!----------------------------------------------------------------------- SFEVAP5B.857
SFEVAP5B.858
IF (SQ1P5 .OR. ST1P5) THEN SFEVAP5B.859
ITILE=1 ! when using more than 1 tile, use short grass SFEVAP5B.862
IF (SQ1P5) THEN ARN0F405.1808
CALL QSAT(QS(P1),TSTAR_TILE(P1,ITILE),PSTAR(P1),POINTS) SFEVAP5B.863
CALL QSAT(QSTAR_GB(P1),TSTAR_GB(P1),PSTAR(P1),POINTS) SFEVAP5B.864
ENDIF SFEVAP5B.865
DO I=P1,P1+POINTS-1 SFEVAP5B.866
SFEVAP5B.867
IF (ST1P5) THEN SFEVAP5B.868
SFEVAP5B.869
TL_BLEND = TSTAR_GB(I) - G/CP * (H_BLEND(I) - Z0H(I,ITILE)) ARN0F405.1809
& + (TL(I,1) ARN0F405.1810
& + G/CP * (Z1_TQ(I)+Z0M(I,ITILE)-Z0H(I,ITILE)) ARN0F405.1811
& - TSTAR_GB(I) ) * HEAT_BLEND_FACTOR(I) ARN0F405.1812
& + ( HEAT_BLEND_FACTOR(I) - 1.0 ) ARN0F405.1813
& * ( LCRCP*QCL_1(I) + LSRCP*QCF_1(I) ) ARN0F405.1814
SFEVAP5B.873
T1P5M(I) = TSTAR_TILE(I,ITILE) - GRCP*Z1P5M + CHR1P5M(I) * SFEVAP5B.874
& ( TL_BLEND - TSTAR_TILE(I,ITILE) ARN0F405.1815
& + GRCP * (H_BLEND(I) - Z0H(I,ITILE)) ) ARN0F405.1816
SFEVAP5B.877
! T1P5M(I) = TSTAR_TILE(I,1) - GRCP*Z1P5M + CHR1P5M(I) * SFEVAP5B.878
! & ( TL_BLEND - TSTAR_TILE(I,1) + SFEVAP5B.879
! & GRCP*(H_BLEND(I)+Z0M(I,1)-Z0H(I,1)) ) SFEVAP5B.880
SFEVAP5B.881
ENDIF ! st1p5 SFEVAP5B.882
IF (SQ1P5) THEN SFEVAP5B.883
QW_BLEND = HEAT_BLEND_FACTOR(I) * (QW(I,1) - QSTAR_GB(I)) + SFEVAP5B.884
& QSTAR_GB(I) - ( HEAT_BLEND_FACTOR(I) - 1.0 ) * SFEVAP5B.885
& ( QCL_1(I) + QCF_1(I) ) SFEVAP5B.886
SFEVAP5B.887
Q1P5M(I) = QW_BLEND + CER1P5M(I)*( QW_BLEND - QS(I) ) SFEVAP5B.888
ENDIF !sq1p5 SFEVAP5B.889
ENDDO ! POINTS SFEVAP5B.890
ENDIF ! sq1p5 or qt1p5 SFEVAP5B.891
SFEVAP5B.892
IF (LTIMER) THEN SFEVAP5B.893
CALL TIMER('SFEVAP ',4) SFEVAP5B.894
ENDIF SFEVAP5B.895
SFEVAP5B.896
RETURN SFEVAP5B.897
END SFEVAP5B.898
*ENDIF SFEVAP5B.899