SUBROUTINE VEG(P_FIELD,FIRST_POINT,LAST_POINT,LAND_FIELD 2,22VEG1A.23
&, LAND1,LAND_PTS,LAND_INDEX,P_ROWS,ROW_LENGTH ABX3F405.29
*IF DEF,MPP ABX3F405.30
&, EW_Halo,NS_Halo ABX3F405.31
*ENDIF ABX3F405.32
&, A_STEP,PHENOL_PERIOD,L_PHENOL VEG1A.25
&, ALB_SOIL,ATIMESTEP VEG1A.26
&, G_LEAF_AC,FRAC,LAI,HT VEG1A.27
&, ALBSNC,ALBSNF,CATCH_T,Z0_P,Z0_T ABX1F405.1337
&, G_LEAF_DAY,G_LEAF_PHEN,LAI_PHEN ABX1F405.1338
& ) ABX1F405.1339
VEG1A.29
VEG1A.30
IMPLICIT NONE VEG1A.31
! VEG1A.32
! Description: VEG1A.33
! Updates Leaf Area Index for Plant Functional Types (PFTs) and uses VEG1A.34
! this to derive new vegetation parameters for PFTs along with gridbox VEG1A.35
! mean values where appropriate. VEG1A.36
! VEG1A.37
! Method: VEG1A.38
! Calls PHENOL which models phenology and updates Leaf Area Index VEG1A.39
! (LAI), then passes new LAI into SPARM along with canopy height VEG1A.40
! and fractional cover of Plant Functional Types. SPARM uses this to VEG1A.41
! derive the vegetation parameters for each PFT, and also derives VEG1A.42
! gridbox means where this is required. VEG1A.43
! VEG1A.44
! Current Code Owner: Richard Betts VEG1A.45
! VEG1A.46
! History: VEG1A.47
! Version Date Comment VEG1A.48
! ------- ---- ------- VEG1A.49
! 4.4 8/10/97 Original code. Richard Betts VEG1A.50
! 4.5 16/09/98 Call SWAPB_LAND to update halo regions of input ABX3F405.33
! fields. Richard Betts ABX3F405.34
! 4.5 23/11/98 Output G_LEAF_DAY, G_LEAF_PHEN and LAI_PHEN as ABX1F405.1340
! diagnostics. Richard Betts ABX1F405.1341
! VEG1A.51
! Code Description: VEG1A.52
! Language: FORTRAN 77 + common extensions. VEG1A.53
! This code is written to UMDP3 v6 programming standards. VEG1A.54
VEG1A.55
VEG1A.56
INTEGER VEG1A.57
& P_FIELD ! IN Number of P-points in whole grid. VEG1A.58
&,FIRST_POINT ! IN First P-point to be processed. VEG1A.59
&,LAST_POINT ! IN Number of P-points to be processed. VEG1A.60
&,LAND_FIELD ! IN Number of land points. VEG1A.61
&,LAND1 ! IN First land point to be processed. VEG1A.62
&,LAND_PTS ! IN Number of land points to be processed. VEG1A.63
&,P_ROWS ! IN Number of rows on P grid. ABX3F405.35
&,ROW_LENGTH ! IN Number of P points in a row. ABX3F405.36
*IF DEF,MPP ABX3F405.37
&,EW_Halo ! IN Halo size in the EW direction. ABX3F405.38
&,NS_Halo ! IN Halo size in the NS direction. ABX3F405.39
*ENDIF ABX3F405.40
&,A_STEP ! IN Atmospheric timestep number. VEG1A.64
&,PHENOL_PERIOD ! IN Phenology period (days). VEG1A.65
VEG1A.66
*CALL NSTYPES 
VEG1A.67
VEG1A.68
INTEGER VEG1A.69
& LAND_INDEX(LAND_FIELD) ! IN I=LAND_INDEX(L) => the Ith VEG1A.70
! ! point in P_FIELD is the Lth VEG1A.71
! ! land point. VEG1A.72
VEG1A.73
INTEGER VEG1A.74
& I,J,L,N ! WORK loop counters. VEG1A.75
VEG1A.76
LOGICAL VEG1A.77
& L_PHENOL ! IN .T. for interactive leaf VEG1A.78
! ! phenology. VEG1A.79
REAL VEG1A.80
& ALB_SOIL(LAND_FIELD) ! IN snow-free albedo of soil. VEG1A.81
&,ATIMESTEP ! IN Atmospheric timestep (s). VEG1A.82
&,G_LEAF_AC(LAND_FIELD,NPFT) ! INOUT Accumulated leaf turnover VEG1A.83
! ! rate. VEG1A.84
&,FRAC(LAND_FIELD,NTYPE) ! INOUT Fractions of surface types. VEG1A.85
&,LAI(LAND_FIELD,NPFT) ! INOUT LAI of plant functional VEG1A.86
! ! types. VEG1A.87
&,HT(LAND_FIELD,NPFT) ! INOUT Height of plant functional VEG1A.88
! ! types (m). VEG1A.89
&,ALBSNC(LAND_FIELD) ! OUT Snow-covered albedo. VEG1A.90
&,ALBSNF(LAND_FIELD) ! OUT Snow-free albedo. VEG1A.91
&,CATCH_T(LAND_FIELD,NTYPE-1) ! OUT Canopy capacity for each type VEG1A.92
! ! aside from ice (kg/m2). VEG1A.93
&,LAI_PHEN(LAND_FIELD,NPFT) ! OUT LAI of PFTs after phenology. ABX1F405.1342
! ! Required as separate variable ABX1F405.1343
! ! for top-level argument list ABX1F405.1344
! ! matching with VEG_IC2A. ABX1F405.1345
&,Z0_P(P_FIELD) ! OUT Effective roughness length VEG1A.94
! ! on full grid (m). VEG1A.95
&,Z0_T(LAND_FIELD,NTYPE) ! OUT Roughness length for each type VEG1A.96
! ! (m). VEG1A.97
VEG1A.98
INTEGER VEG1A.99
& NSTEP_PHEN ! WORK Number of atmospheric VEG1A.100
! ! timesteps between calls to VEG1A.101
! ! PHENOL. VEG1A.102
&,TILE_PTS(NTYPE) ! WORK Number of land points which VEG1A.103
! ! include the nth surface type. VEG1A.104
&,TILE_INDEX(LAND_FIELD,NTYPE) ! WORK Indices of land points which VEG1A.105
! ! include the nth surface type. VEG1A.106
VEG1A.107
REAL VEG1A.108
& DTIME_PHEN ! WORK The phenology timestep (yr). VEG1A.109
&,G_LEAF_DAY(LAND_FIELD,NPFT) ! WORK Mean leaf turnover rate for VEG1A.110
! ! input to PHENOL (/360days). ABX1F405.1346
&,G_LEAF_PHEN(LAND_FIELD,NPFT) ! WORK Mean leaf turnover rate over VEG1A.112
! ! phenology period (/360days). ABX1F405.1347
&,Z0(LAND_FIELD) ! WORK Roughness length on VEG1A.114
! ! land points (m). VEG1A.115
VEG1A.116
!----------------------------------------------------------------------- VEG1A.117
! Initialisations VEG1A.118
!----------------------------------------------------------------------- VEG1A.119
DO L=1,LAND_FIELD ABX1F405.1348
ALBSNC(L)=0.0 VEG1A.121
ALBSNF(L)=0.0 VEG1A.122
Z0(L)=0.0 VEG1A.123
ENDDO VEG1A.124
VEG1A.125
DO N=1,NTYPE VEG1A.126
DO L=1,LAND_FIELD ABX1F405.1349
Z0_T(L,N)=0.0 VEG1A.128
ENDDO VEG1A.129
ENDDO VEG1A.130
VEG1A.131
DO N=1,NTYPE-1 VEG1A.132
DO L=1,LAND_FIELD ABX1F405.1350
CATCH_T(L,N)=0.0 VEG1A.134
ENDDO VEG1A.135
ENDDO VEG1A.136
VEG1A.137
DO N=1,NPFT VEG1A.138
DO L=1,LAND_FIELD ABX1F405.1351
G_LEAF_PHEN(L,N)=0.0 VEG1A.140
G_LEAF_DAY(L,N)=0.0 VEG1A.141
ENDDO VEG1A.142
ENDDO VEG1A.143
VEG1A.144
!----------------------------------------------------------------------- VEG1A.145
! Calculate the number of atmospheric timesteps between calls to PHENOL VEG1A.146
! and TRIFFID. VEG1A.147
!----------------------------------------------------------------------- VEG1A.148
NSTEP_PHEN=INT(86400.0*PHENOL_PERIOD/ATIMESTEP) VEG1A.149
VEG1A.150
*IF DEF,MPP ABX3F405.41
!----------------------------------------------------------------------- ABX3F405.42
! Update halos on input fields ABX3F405.43
!----------------------------------------------------------------------- ABX3F405.44
CALL SWAPB_LAND(LAI,LAND_FIELD,P_FIELD, ABX3F405.45
& ROW_LENGTH,P_ROWS,EW_Halo,NS_Halo, ABX3F405.46
& NPFT,LAND_INDEX) ABX3F405.47
ABX3F405.48
CALL SWAPB_LAND(HT,LAND_FIELD,P_FIELD, ABX3F405.49
& ROW_LENGTH,P_ROWS,EW_Halo,NS_Halo, ABX3F405.50
& NPFT,LAND_INDEX) ABX3F405.51
ABX3F405.52
CALL SWAPB_LAND(G_LEAF_AC,LAND_FIELD,P_FIELD, ABX3F405.53
& ROW_LENGTH,P_ROWS,EW_Halo,NS_Halo, ABX3F405.54
& NPFT,LAND_INDEX) ABX3F405.55
*ENDIF ABX3F405.56
ABX3F405.57
!----------------------------------------------------------------------- VEG1A.151
! Create the TILE_INDEX array of land points with each surface type VEG1A.152
!----------------------------------------------------------------------- VEG1A.153
CALL TILEPTS(P_FIELD,LAND_FIELD,LAND1,LAND_PTS, VEG1A.154
& FRAC,TILE_PTS,TILE_INDEX) VEG1A.155
VEG1A.156
IF (L_PHENOL .AND. MOD(A_STEP,NSTEP_PHEN).EQ.0) THEN VEG1A.157
VEG1A.158
!----------------------------------------------------------------------- VEG1A.159
! Calculate the phenology timestep in years. VEG1A.160
!----------------------------------------------------------------------- VEG1A.161
DTIME_PHEN=FLOAT(PHENOL_PERIOD)/360.0 VEG1A.162
VEG1A.163
VEG1A.164
DO N=1,NPFT VEG1A.165
VEG1A.166
!----------------------------------------------------------------------- VEG1A.167
! Calculate the mean turnover rate and update the leaf phenological VEG1A.168
! state. VEG1A.169
!----------------------------------------------------------------------- VEG1A.170
DO J=1,TILE_PTS(N) VEG1A.171
L=TILE_INDEX(J,N) VEG1A.172
G_LEAF_DAY(L,N)=G_LEAF_AC(L,N)/DTIME_PHEN VEG1A.173
ENDDO VEG1A.174
VEG1A.175
WRITE(6,*) 'Calling phenology' ABX1F405.1352
ABX1F405.1353
CALL PHENOL (LAND_FIELD,TILE_PTS(N),TILE_INDEX(1,N),N, VEG1A.176
& G_LEAF_DAY(1,N),HT(1,N),DTIME_PHEN, VEG1A.177
& G_LEAF_PHEN(1,N),LAI(1,N)) VEG1A.178
VEG1A.179
WRITE(6,*) 'Phenology completed normally' ABX1F405.1354
ABX1F405.1355
DO L=1,LAND_FIELD ABX1F405.1356
LAI_PHEN(L,N)=LAI(L,N) ABX1F405.1357
ENDDO ABX1F405.1358
ABX1F405.1359
!----------------------------------------------------------------------- VEG1A.180
! Reset the accumulation over atmospheric model timesteps to zero. VEG1A.181
!----------------------------------------------------------------------- VEG1A.182
DO L=1,LAND_FIELD ABX1F405.1360
G_LEAF_AC(L,N)=0.0 VEG1A.184
ENDDO VEG1A.185
ENDDO VEG1A.186
ENDIF VEG1A.187
VEG1A.188
!----------------------------------------------------------------------- VEG1A.189
! Calculate gridbox mean vegetation parameters from fractions of VEG1A.190
! surface functional types VEG1A.191
!----------------------------------------------------------------------- VEG1A.192
CALL SPARM (LAND_FIELD,LAND1,LAND_PTS,TILE_PTS,TILE_INDEX VEG1A.193
&, ALB_SOIL,FRAC,HT,LAI VEG1A.194
&, ALBSNC,ALBSNF,CATCH_T,Z0,Z0_T) VEG1A.195
VEG1A.196
!----------------------------------------------------------------------- VEG1A.197
! Copy Z0 from land field to full field VEG1A.198
!----------------------------------------------------------------------- VEG1A.199
DO L=LAND1,LAND1+LAND_PTS-1 VEG1A.200
I = LAND_INDEX(L) VEG1A.201
Z0_P(I)=Z0(L) VEG1A.202
ENDDO VEG1A.203
VEG1A.204
RETURN VEG1A.205
END VEG1A.206
*ENDIF VEG1A.207