*IF DEF,A19_2A VEG2A.2
C *****************************COPYRIGHT****************************** VEG2A.3
C (c) CROWN COPYRIGHT 1997, METEOROLOGICAL OFFICE, All Rights Reserved. VEG2A.4
C VEG2A.5
C Use, duplication or disclosure of this code is subject to the VEG2A.6
C restrictions as set forth in the contract. VEG2A.7
C VEG2A.8
C Meteorological Office VEG2A.9
C London Road VEG2A.10
C BRACKNELL VEG2A.11
C Berkshire UK VEG2A.12
C RG12 2SZ VEG2A.13
C VEG2A.14
C If no contract has been raised with this copy of the code, the use, VEG2A.15
C duplication or disclosure of it is strictly prohibited. Permission VEG2A.16
C to do so must first be obtained in writing from the Head of Numerical VEG2A.17
C Modelling at the above address. VEG2A.18
C ******************************COPYRIGHT****************************** VEG2A.19
! Version 2A of vegetation section: models leaf phenology and vegetation VEG2A.20
! competition VEG2A.21
! VEG2A.22
! Subroutine Interface: VEG2A.23
SUBROUTINE VEG(P_FIELD,FIRST_POINT,LAST_POINT,LAND_FIELD 2,22VEG2A.24
&, LAND1,LAND_PTS,LAND_INDEX,P_ROWS,ROW_LENGTH ABX3F405.74
*IF DEF,MPP ABX3F405.75
&, EW_Halo,NS_Halo ABX3F405.76
*ENDIF ABX3F405.77
&, A_STEP,ASTEPS_SINCE_TRIFFID VEG2A.26
&, PHENOL_PERIOD,TRIFFID_PERIOD VEG2A.27
&, L_PHENOL,L_TRIFFID,L_TRIF_EQ VEG2A.28
&, ALB_SOIL,ATIMESTEP,FRAC_DISTURB VEG2A.29
&, G_LEAF_AC,G_LEAF_PHEN_AC,NPP_AC VEG2A.30
&, RESP_S_AC,RESP_W_AC VEG2A.31
&, CS,FRAC,LAI,HT VEG2A.32
&, ALBSNC,ALBSNF,CATCH_T,Z0_P,Z0_T VEG2A.33
&, C_VEG,CV,LIT_C,LIT_C_MN,G_LEAF_DAY,G_LEAF_PHEN ABX1F405.1398
&, LAI_PHEN,G_LEAF_DR_OUT,NPP_DR_OUT,RESP_W_DR_OUT ABX1F405.1399
&, RESP_S_DR_OUT ABX1F405.1400
& ) ABX1F405.1401
VEG2A.35
VEG2A.36
IMPLICIT NONE VEG2A.37
! VEG2A.38
! Description: VEG2A.39
! Updates Leaf Area Index for Plant Functional Types (PFTs) and uses VEG2A.40
! this to derive new vegetation parameters for PFTs along with gridbox VEG2A.41
! mean values where appropriate. VEG2A.42
! VEG2A.43
! Method: ABX1F405.1402
! Calls PHENOL which models phenolgy and updates Leaf Area Index ABX1F405.1403
! (LAI), then calls TRIFFID to update vegetation and soil fractions, ABX1F405.1404
! LAI, canopy height, veg and soil carbon and carbon fluxes. Passes ABX1F405.1405
! fractions, LAI and canopy height to SPARM which derives the ABX1F405.1406
! vegetation parameters for each PFT and also the gridbox means where ABX1F405.1407
! this is required. ABX1F405.1408
! VEG2A.50
! Current Code Owner: Richard Betts VEG2A.51
! VEG2A.52
! History: VEG2A.53
! Version Date Comment VEG2A.54
! ------- ---- ------- VEG2A.55
! 4.4 8/10/97 Original code. Richard Betts VEG2A.56
! 4.5 12/05/98 Find total fraction of gridbox covered by ABX1F405.1409
! vegetation or soil, use this to derive indices of ABX1F405.1410
! land points on which TRIFFID may operate, and pass ABX1F405.1411
! both to TRIFFID. Initialise top and bottom rows ABX1F405.1412
! for all variables. Richard Betts ABX1F405.1413
! 4.5 30/06/98 Add second call to TILEPTS to update TILE_INDEX ABX1F405.1414
! after TRIFFID. Richard Betts ABX1F405.1415
! 4.5 6/08/98 Call SWAPB_LAND to update halo regions of input ABX1F405.1416
! fields. Richard Betts ABX1F405.1417
! 4.5 23/11/98 Output G_LEAF_DAY, G_LEAF_PHEN, LAI_PHEN, ABX1F405.1418
! G_LEAF_DR_OUT, NPP_DR_OUT, RESP_W_DR_OUT and ABX1F405.1419
! RESP_S_DR_OUT as diagnostics. Richard Betts ABX1F405.1420
! VEG2A.57
! Code Description: VEG2A.58
! Language: FORTRAN 77 + common extensions. VEG2A.59
! This code is written to UMDP3 v6 programming standards. VEG2A.60
VEG2A.61
VEG2A.62
INTEGER VEG2A.63
& P_FIELD ! IN Number of P-points in whole grid. VEG2A.64
&,FIRST_POINT ! IN First P-point to be processed. VEG2A.65
&,LAST_POINT ! IN Number of P-points to be processed. VEG2A.66
&,LAND_FIELD ! IN Number of land points. VEG2A.67
&,LAND1 ! IN First land point to be processed. VEG2A.68
&,LAND_PTS ! IN Number of land points. VEG2A.69
&,P_ROWS ! IN Number of rows on P grid. ABX3F405.78
&,ROW_LENGTH ! IN Number of P points in a row. ABX3F405.79
*IF DEF,MPP ABX3F405.80
&,EW_Halo ! IN Halo size in the EW direction. ABX3F405.81
&,NS_Halo ! IN Halo size in the NS direction. ABX3F405.82
*ENDIF ABX3F405.83
&,A_STEP ! IN Atmospheric timestep number. VEG2A.70
&,ASTEPS_SINCE_TRIFFID ! INOUT Number of atmosphere VEG2A.71
C timesteps since last call VEG2A.72
C to TRIFFID. VEG2A.73
&,PHENOL_PERIOD ! IN Phenology period (days). VEG2A.74
&,TRIFFID_PERIOD ! IN TRIFFID period (days). VEG2A.75
VEG2A.76
*CALL NSTYPES
VEG2A.77
VEG2A.78
INTEGER VEG2A.79
& LAND_INDEX(LAND_FIELD) ! IN I=LAND_INDEX(L) => the Ith VEG2A.80
C ! P-point is the Lth land VEG2A.81
C ! point. VEG2A.82
VEG2A.83
INTEGER VEG2A.84
& I,J,K,L,N ! WORK loop counters. ABX1F405.1421
&,KITER ! WORK Number of TRIFFID iterations. ABX1F405.1422
VEG2A.86
LOGICAL VEG2A.87
& L_PHENOL ! IN .T. for interactive leaf VEG2A.88
C ! phenology. VEG2A.89
&,L_TRIFFID ! IN .T. for interactive vegetation. VEG2A.90
&,L_TRIF_EQ ! IN .T. for vegetation equilibrium. VEG2A.91
VEG2A.92
REAL VEG2A.93
& ALB_SOIL(LAND_FIELD) ! IN snow-free albedo of soil. VEG2A.94
&,ATIMESTEP ! IN Atmospheric timestep (s). VEG2A.95
&,FRAC_DISTURB(LAND_FIELD) ! IN Fraction of gridbox in which VEG2A.96
C ! vegetation is disturbed. VEG2A.97
&,G_LEAF_AC(LAND_FIELD,NPFT) ! INOUT Accumulated leaf turnover VEG2A.98
C ! rate. VEG2A.99
&,G_LEAF_PHEN_AC(LAND_FIELD,NPFT)! INOUT Accumulated leaf turnover VEG2A.100
C ! rate including phenology. VEG2A.101
&,NPP_AC(LAND_FIELD,NPFT) ! INOUT Accumulated NPP (kg C/m2). VEG2A.102
&,RESP_W_AC(LAND_FIELD,NPFT) ! INOUT Accumulated wood respiration VEG2A.103
C ! (kg C/m2). VEG2A.104
&,RESP_S_AC(LAND_FIELD) ! INOUT Accumulated soil respiration VEG2A.105
C ! (kg C/m2). VEG2A.106
&,CS(LAND_FIELD) ! INOUT Soil carbon content VEG2A.107
C ! (kg C/m2). VEG2A.108
&,FRAC(LAND_FIELD,NTYPE) ! INOUT Fractions of surface types. VEG2A.109
&,LAI(LAND_FIELD,NPFT) ! INOUT LAI of plant functional VEG2A.110
C ! types. VEG2A.111
&,HT(LAND_FIELD,NPFT) ! INOUT Height of plant functional VEG2A.112
C ! types (m). VEG2A.113
&,ALBSNC(LAND_FIELD) ! OUT Snow-covered albedo. VEG2A.114
&,ALBSNF(LAND_FIELD) ! OUT Snow-free albedo. VEG2A.115
&,CATCH_T(LAND_FIELD,NTYPE-1) ! OUT Canopy capacity for each type VEG2A.116
C ! aside from ice (kg/m2). VEG2A.117
&,Z0_P(P_FIELD) ! OUT Effective roughness length VEG2A.118
C ! on full grid (m). VEG2A.119
&,Z0_T(LAND_FIELD,NTYPE) ! OUT Roughness length for each type VEG2A.120
C ! (m). VEG2A.121
&,C_VEG(LAND_FIELD,NPFT) ! OUT Total carbon content of VEG2A.122
C ! the vegetation (kg C/m2). VEG2A.123
&,CV(LAND_FIELD) ! OUT Gridbox mean vegetation VEG2A.124
C ! carbon (kg C/m2). VEG2A.125
&,G_LEAF_DAY(LAND_FIELD,NPFT) ! OUT Mean leaf turnover rate for ABX1F405.1423
! ! input to PHENOL (/360days). ABX1F405.1424
&,G_LEAF_DR_OUT(LAND_FIELD,NPFT) ! OUT Mean leaf turnover rate for ABX1F405.1425
! ! driving TRIFFID (/360days). ABX1F405.1426
&,LAI_PHEN(LAND_FIELD,NPFT) ! OUT LAI of PFTs after phenology. ABX1F405.1427
&,LIT_C(LAND_FIELD,NPFT) ! OUT Carbon Litter ABX1F405.1428
! ! (kg C/m2/360days). ABX1F405.1429
&,LIT_C_MN(LAND_FIELD) ! OUT Gridbox mean carbon litter VEG2A.127
! ! (kg C/m2/360days). ABX1F405.1430
&,NPP_DR_OUT(LAND_FIELD,NPFT) ! OUT Mean NPP for driving TRIFFID ABX1F405.1431
! ! (kg C/m2/360days). ABX1F405.1432
&,RESP_W_DR_OUT(LAND_FIELD,NPFT) ! OUT Mean wood respiration for ABX1F405.1433
! ! driving TRIFFID ABX1F405.1434
! ! (kg C/m2/360days). ABX1F405.1435
&,RESP_S_DR_OUT(LAND_FIELD) ! OUT Mean soil respiration for ABX1F405.1436
! ! driving TRIFFID ABX1F405.1437
! ! (kg C/m2/360days). ABX1F405.1438
VEG2A.129
INTEGER VEG2A.130
& NSTEP_PHEN ! WORK Number of atmospheric VEG2A.131
C ! timesteps between calls to VEG2A.132
C ! PHENOL. VEG2A.133
&,NSTEP_TRIF ! WORK Number of atmospheric VEG2A.134
C ! timesteps between calls to VEG2A.135
C ! TRIFFID. VEG2A.136
&,TILE_PTS(NTYPE) ! WORK Number of land points which VEG2A.137
C ! include the nth surface type. VEG2A.138
&,TILE_INDEX(LAND_FIELD,NTYPE) ! WORK Indices of land points which VEG2A.139
C ! include the nth surface type. VEG2A.140
&,TRIF_PTS ! WORK Number of points on which ABX1F405.1439
! ! TRIFFID may operate ABX1F405.1440
&,TRIF_INDEX(LAND_FIELD) ! WORK Indices of land points on ABX1F405.1441
! ! which TRIFFID may operate ABX1F405.1442
VEG2A.141
REAL VEG2A.142
& DTIME_PHEN ! WORK The phenology timestep (yr). VEG2A.143
&,FORW ! WORK Forward timestep weighting VEG2A.144
C ! for TRIFFID. VEG2A.145
&,GAMMA ! WORK Inverse TRIFFID timestep VEG2A.146
! ! (/360days). ABX1F405.1443
&,GAM_TRIF ! WORK Inverse TRIFFID coupling VEG2A.148
! ! timestep (/360days). ABX1F405.1444
&,G_ANTH(LAND_FIELD) ! WORK Anthropogenic disturbance VEG2A.150
! ! rate (/360days). ABX1F405.1445
&,G_LEAF_PHEN(LAND_FIELD,NPFT) ! WORK Mean leaf turnover rate over VEG2A.154
! ! phenology period (/360days). ABX1F405.1446
&,G_LEAF_DR(LAND_FIELD,NPFT) ! WORK Mean leaf turnover rate VEG2A.156
! ! for driving TRIFFID ABX1F405.1447
! ! (/360days). ABX1F405.1448
&,NPP_DR(LAND_FIELD,NPFT) ! WORK Mean NPP for driving VEG2A.158
! ! TRIFFID (kg C/m2/360days). ABX1F405.1449
&,RESP_W_DR(LAND_FIELD,NPFT) ! WORK Mean wood respiration for VEG2A.160
! ! driving TRIFFID ABX1F405.1450
! ! (kg C/m2/360days). ABX1F405.1451
&,RESP_S_DR(LAND_FIELD) ! WORK Mean soil respiration for VEG2A.162
! ! driving TRIFFID ABX1F405.1452
! ! (kg C/m2/360days). ABX1F405.1453
&,FRAC_VS(LAND_FIELD) ! WORK Total fraction of gridbox ABX1F405.1454
! ! covered by veg or soil. ABX1F405.1455
&,Z0(LAND_FIELD) ! WORK Roughness length on VEG2A.164
C ! land points (m). VEG2A.165
C----------------------------------------------------------------------- VEG2A.166
C Local parameters VEG2A.167
C----------------------------------------------------------------------- VEG2A.168
*CALL DESCENT
VEG2A.169
*CALL SEED
ABX1F405.1456
REAL VEG2A.170
& G_ANTH0 ! Anthropogenic disturbance rate VEG2A.171
! ! (/360days). ABX1F405.1457
PARAMETER (G_ANTH0=0.0) VEG2A.173
VEG2A.174
C----------------------------------------------------------------------- VEG2A.175
C Initialisations VEG2A.176
C----------------------------------------------------------------------- VEG2A.177
DO N=1,NPFT VEG2A.178
DO L=1,LAND_FIELD ABX1F405.1458
G_LEAF_PHEN(L,N)=0.0 VEG2A.180
G_LEAF_DAY(L,N)=0.0 VEG2A.181
G_LEAF_DR(L,N)=0.0 VEG2A.182
NPP_DR(L,N)=0.0 VEG2A.183
RESP_W_DR(L,N)=0.0 VEG2A.184
C_VEG(L,N)=0.0 VEG2A.185
LIT_C(L,N)=0.0 VEG2A.186
ENDDO VEG2A.187
ENDDO VEG2A.188
VEG2A.189
DO N=1,NTYPE VEG2A.190
DO L=1,LAND_FIELD ABX1F405.1459
Z0_T(L,N)=0.0 VEG2A.192
ENDDO VEG2A.193
ENDDO VEG2A.194
VEG2A.195
DO N=1,NTYPE-1 VEG2A.196
DO L=1,LAND_FIELD ABX1F405.1460
CATCH_T(L,N)=0.0 VEG2A.198
ENDDO VEG2A.199
ENDDO VEG2A.200
VEG2A.201
DO L=1,LAND_FIELD ABX1F405.1461
ALBSNC(L)=0.0 VEG2A.203
ALBSNF(L)=0.0 VEG2A.204
G_ANTH(L)=0.0 VEG2A.205
RESP_S_DR(L)=0.0 VEG2A.206
Z0(L)=0.0 VEG2A.207
CV(L)=0.0 VEG2A.208
LIT_C_MN(L)=0.0 VEG2A.209
FRAC_VS(L) = 0.0 ABX1F405.1462
ENDDO VEG2A.210
ABX3F405.84
C----------------------------------------------------------------------- ABX3F405.85
C Calculate the number of atmospheric timesteps between calls to PHENOL ABX3F405.86
C and TRIFFID. ABX3F405.87
C----------------------------------------------------------------------- ABX3F405.88
NSTEP_PHEN=INT(86400.0*PHENOL_PERIOD/ATIMESTEP) ABX3F405.89
NSTEP_TRIF=INT(86400.0*TRIFFID_PERIOD/ATIMESTEP) ABX3F405.90
ABX3F405.91
*IF DEF,MPP ABX3F405.92
!----------------------------------------------------------------------- ABX3F405.93
! Update halos on input fields ABX3F405.94
!----------------------------------------------------------------------- ABX3F405.95
CALL SWAPB_LAND
(ALB_SOIL,LAND_FIELD,P_FIELD, ABX3F405.96
& ROW_LENGTH,P_ROWS,EW_Halo,NS_Halo, ABX3F405.97
& 1,LAND_INDEX) ABX3F405.98
ABX3F405.99
CALL SWAPB_LAND
(LAI,LAND_FIELD,P_FIELD, ABX3F405.100
& ROW_LENGTH,P_ROWS,EW_Halo,NS_Halo, ABX3F405.101
& NPFT,LAND_INDEX) ABX3F405.102
ABX3F405.103
CALL SWAPB_LAND
(HT,LAND_FIELD,P_FIELD, ABX3F405.104
& ROW_LENGTH,P_ROWS,EW_Halo,NS_Halo, ABX3F405.105
& NPFT,LAND_INDEX) ABX3F405.106
ABX3F405.107
CALL SWAPB_LAND
(G_LEAF_AC,LAND_FIELD,P_FIELD, ABX3F405.108
& ROW_LENGTH,P_ROWS,EW_Halo,NS_Halo, ABX3F405.109
& NPFT,LAND_INDEX) ABX3F405.110
ABX3F405.111
ABX3F405.112
CALL SWAPB_LAND
(FRAC_DISTURB,LAND_FIELD,P_FIELD, ABX3F405.113
& ROW_LENGTH,P_ROWS,EW_Halo,NS_Halo, ABX3F405.114
& 1,LAND_INDEX) ABX3F405.115
ABX3F405.116
CALL SWAPB_LAND
(G_LEAF_PHEN_AC,LAND_FIELD,P_FIELD, ABX3F405.117
& ROW_LENGTH,P_ROWS,EW_Halo,NS_Halo, ABX3F405.118
& NPFT,LAND_INDEX) ABX3F405.119
ABX3F405.120
CALL SWAPB_LAND
(NPP_AC,LAND_FIELD,P_FIELD, ABX3F405.121
& ROW_LENGTH,P_ROWS,EW_Halo,NS_Halo, ABX3F405.122
& NPFT,LAND_INDEX) ABX3F405.123
ABX3F405.124
CALL SWAPB_LAND
(RESP_W_AC,LAND_FIELD,P_FIELD, ABX3F405.125
& ROW_LENGTH,P_ROWS,EW_Halo,NS_Halo, ABX3F405.126
& NPFT,LAND_INDEX) ABX3F405.127
ABX3F405.128
CALL SWAPB_LAND
(RESP_S_AC,LAND_FIELD,P_FIELD, ABX3F405.129
& ROW_LENGTH,P_ROWS,EW_Halo,NS_Halo, ABX3F405.130
& 1,LAND_INDEX) ABX3F405.131
ABX3F405.132
CALL SWAPB_LAND
(CS,LAND_FIELD,P_FIELD, ABX3F405.133
& ROW_LENGTH,P_ROWS,EW_Halo,NS_Halo, ABX3F405.134
& 1,LAND_INDEX) ABX3F405.135
ABX3F405.136
CALL SWAPB_LAND
(FRAC,LAND_FIELD,P_FIELD, ABX3F405.137
& ROW_LENGTH,P_ROWS,EW_Halo,NS_Halo, ABX3F405.138
& NTYPE,LAND_INDEX) ABX3F405.139
ABX3F405.140
*ENDIF ABX3F405.141
VEG2A.211
!----------------------------------------------------------------------- ABX1F405.1463
! Find total fraction of gridbox covered by vegetation and soil, and use ABX1F405.1464
! this to set indices of land points on which TRIFFID may operate ABX1F405.1465
!----------------------------------------------------------------------- ABX1F405.1466
TRIF_PTS = 0 ABX1F405.1467
DO L=LAND1,LAND1+LAND_PTS-1 ABX1F405.1468
DO N=1,NPFT ABX1F405.1469
FRAC_VS(L) = FRAC_VS(L) + FRAC(L,N) ABX1F405.1470
ENDDO ABX1F405.1471
N=SOIL ABX1F405.1472
FRAC_VS(L) = FRAC_VS(L) + FRAC(L,N) ABX1F405.1473
IF (FRAC_VS(L).GE.(NPFT*FRAC_MIN)) THEN ABX1F405.1474
TRIF_PTS = TRIF_PTS + 1 ABX1F405.1475
TRIF_INDEX(TRIF_PTS) = L ABX1F405.1476
ENDIF ABX1F405.1477
ENDDO ABX1F405.1478
ABX1F405.1479
C----------------------------------------------------------------------- VEG2A.219
C Create the TILE_INDEX array of land points with each surface type VEG2A.220
C----------------------------------------------------------------------- VEG2A.221
CALL TILEPTS
(P_FIELD,LAND_FIELD,LAND1,LAND_PTS, VEG2A.222
& FRAC,TILE_PTS,TILE_INDEX) VEG2A.223
VEG2A.224
IF (L_PHENOL .AND. MOD(A_STEP,NSTEP_PHEN).EQ.0) THEN VEG2A.225
VEG2A.226
C----------------------------------------------------------------------- VEG2A.227
C Calculate the phenology timestep in years. VEG2A.228
C----------------------------------------------------------------------- VEG2A.229
DTIME_PHEN=FLOAT(PHENOL_PERIOD)/360.0 VEG2A.230
VEG2A.232
DO N=1,NPFT VEG2A.233
VEG2A.234
C----------------------------------------------------------------------- VEG2A.235
C Calculate the mean turnover rate and update the leaf phenological VEG2A.236
! state, and take copy of updated LAI field for output as diagnostic. ABX1F405.1480
C----------------------------------------------------------------------- VEG2A.238
DO J=1,TILE_PTS(N) VEG2A.239
L=TILE_INDEX(J,N) VEG2A.240
G_LEAF_DAY(L,N)=G_LEAF_AC(L,N)/DTIME_PHEN VEG2A.241
ENDDO VEG2A.242
VEG2A.243
WRITE(6,*) 'Calling phenology' ABX1F405.1481
ABX1F405.1482
CALL PHENOL
(LAND_FIELD,TILE_PTS(N),TILE_INDEX(1,N),N, VEG2A.244
& G_LEAF_DAY(1,N),HT(1,N),DTIME_PHEN, VEG2A.245
& G_LEAF_PHEN(1,N),LAI(1,N)) VEG2A.246
VEG2A.247
WRITE(6,*) 'Phenology completed normally' ABX1F405.1483
ABX1F405.1484
DO L=1,LAND_FIELD ABX1F405.1485
LAI_PHEN(L,N)=LAI(L,N) ABX1F405.1486
ENDDO ABX1F405.1487
ABX1F405.1488
C----------------------------------------------------------------------- VEG2A.248
C Increment the leaf turnover rate for driving TRIFFID and reset the VEG2A.249
C accumulation over atmospheric model timesteps to zero. VEG2A.250
C----------------------------------------------------------------------- VEG2A.251
DO J=1,TILE_PTS(N) VEG2A.252
L=TILE_INDEX(J,N) VEG2A.253
G_LEAF_PHEN_AC(L,N)=G_LEAF_PHEN_AC(L,N) VEG2A.254
& +G_LEAF_PHEN(L,N)*DTIME_PHEN VEG2A.255
ENDDO VEG2A.256
VEG2A.257
DO L=1,LAND_FIELD ABX1F405.1489
G_LEAF_AC(L,N)=0.0 VEG2A.259
ENDDO VEG2A.260
VEG2A.261
ENDDO VEG2A.262
ENDIF VEG2A.263
VEG2A.264
C----------------------------------------------------------------------- VEG2A.265
C Call TRIFFID vegetation model to update vegetation and terrestrial VEG2A.266
C carbon storage. VEG2A.267
C----------------------------------------------------------------------- VEG2A.268
IF (L_TRIFFID .AND. VEG2A.269
& (ASTEPS_SINCE_TRIFFID.EQ.NSTEP_TRIF)) THEN VEG2A.270
VEG2A.271
C----------------------------------------------------------------------- VEG2A.272
C Calculate the TRIFFID inverse coupling timestep. VEG2A.273
C----------------------------------------------------------------------- VEG2A.274
GAM_TRIF=360.0/FLOAT(TRIFFID_PERIOD) VEG2A.275
VEG2A.276
C----------------------------------------------------------------------- VEG2A.277
C Diagnose the mean fluxes over the coupling period. VEG2A.278
C----------------------------------------------------------------------- VEG2A.279
DO L=LAND1,LAND1+LAND_PTS-1 VEG2A.280
RESP_S_DR(L)=RESP_S_AC(L)*GAM_TRIF VEG2A.281
ENDDO VEG2A.282
VEG2A.283
DO N=1,NPFT VEG2A.284
DO J=1,TILE_PTS(N) VEG2A.285
L=TILE_INDEX(J,N) VEG2A.286
G_LEAF_DR(L,N)=G_LEAF_PHEN_AC(L,N)*GAM_TRIF VEG2A.287
NPP_DR(L,N)=NPP_AC(L,N)*GAM_TRIF VEG2A.288
RESP_W_DR(L,N)=RESP_W_AC(L,N)*GAM_TRIF VEG2A.289
ENDDO VEG2A.290
ENDDO VEG2A.291
VEG2A.292
C----------------------------------------------------------------------- VEG2A.293
C Diagnose the mean leaf turnover rates over the coupling period. VEG2A.294
C----------------------------------------------------------------------- VEG2A.295
IF (L_PHENOL) THEN VEG2A.296
DO N=1,NPFT VEG2A.297
DO J=1,TILE_PTS(N) VEG2A.298
L=TILE_INDEX(J,N) VEG2A.299
G_LEAF_DR(L,N)=G_LEAF_PHEN_AC(L,N)*GAM_TRIF VEG2A.300
ENDDO VEG2A.301
ENDDO VEG2A.302
ELSE VEG2A.303
DO N=1,NPFT VEG2A.304
DO J=1,TILE_PTS(N) VEG2A.305
L=TILE_INDEX(J,N) VEG2A.306
G_LEAF_DR(L,N)=G_LEAF_AC(L,N)*GAM_TRIF VEG2A.307
ENDDO VEG2A.308
ENDDO VEG2A.309
ENDIF VEG2A.310
VEG2A.311
C----------------------------------------------------------------------- VEG2A.312
C Calculate the anthropogenic disturbance rate VEG2A.313
C----------------------------------------------------------------------- VEG2A.314
DO L=LAND1,LAND1+LAND_PTS-1 VEG2A.315
G_ANTH(L)=G_ANTH0*FRAC_DISTURB(L) VEG2A.316
ENDDO VEG2A.317
VEG2A.318
!----------------------------------------------------------------------- ABX1F405.1490
! Take copies of TRIFFID input variables for output as diagnostics. ABX1F405.1491
!----------------------------------------------------------------------- ABX1F405.1492
DO N=1,NPFT ABX1F405.1493
DO L=1,LAND_FIELD ABX1F405.1494
G_LEAF_DR_OUT(L,N)=G_LEAF_DR(L,N) ABX1F405.1495
NPP_DR_OUT(L,N)=NPP_DR(L,N) ABX1F405.1496
RESP_W_DR_OUT(L,N)=RESP_W_DR(L,N) ABX1F405.1497
ENDDO ABX1F405.1498
ENDDO ABX1F405.1499
DO L=1,LAND_FIELD ABX1F405.1500
RESP_S_DR_OUT(L)=RESP_S_DR(L) ABX1F405.1501
ENDDO ABX1F405.1502
ABX1F405.1503
C----------------------------------------------------------------------- VEG2A.319
C Select timestep and forward timestep weighting parameters for VEG2A.320
C equilibrium or dynamic vegetation and call TRIFFID. VEG2A.321
C----------------------------------------------------------------------- VEG2A.322
IF (L_TRIF_EQ) THEN VEG2A.323
FORW=1.0 VEG2A.324
GAMMA=GAMMA_EQ VEG2A.325
KITER=ITER_EQ ABX1F405.1504
ELSE VEG2A.326
FORW=0.5 VEG2A.327
GAMMA=GAM_TRIF VEG2A.328
KITER=1 ABX1F405.1505
ENDIF VEG2A.329
ABX1F405.1506
DO K=1,KITER ABX1F405.1507
VEG2A.330
WRITE(6,*) 'Calling TRIFFID' ABX1F405.1508
ABX1F405.1509
CALL TRIFFID
(LAND_FIELD,TRIF_PTS,TRIF_INDEX,FORW,GAMMA ABX1F405.1510
&, FRAC_VS,G_ANTH,G_LEAF_DR,NPP_DR,RESP_S_DR ABX1F405.1511
&, RESP_W_DR,CS,FRAC,HT,LAI ABX1F405.1512
&, C_VEG,CV,LIT_C,LIT_C_MN) VEG2A.334
ABX1F405.1513
WRITE(6,*) 'TRIFFID completed normally' ABX1F405.1514
ABX1F405.1515
ENDDO ABX1F405.1516
VEG2A.335
C----------------------------------------------------------------------- ABX1F405.1517
C Update TILE_INDEX for new surface type fractions. ABX1F405.1518
C----------------------------------------------------------------------- ABX1F405.1519
CALL TILEPTS
(P_FIELD,LAND_FIELD,LAND1,LAND_PTS, ABX1F405.1520
& FRAC,TILE_PTS,TILE_INDEX) ABX1F405.1521
ABX1F405.1522
C----------------------------------------------------------------------- VEG2A.336
C Reset the accumulations to zero. VEG2A.337
C----------------------------------------------------------------------- VEG2A.338
DO L=LAND1,LAND1+LAND_PTS-1 VEG2A.339
RESP_S_AC(L)=0.0 VEG2A.340
ENDDO VEG2A.341
VEG2A.342
DO N=1,NPFT VEG2A.343
DO L=LAND1,LAND1+LAND_PTS-1 VEG2A.344
NPP_AC(L,N)=0.0 VEG2A.345
RESP_W_AC=0.0 VEG2A.346
ENDDO VEG2A.347
ENDDO VEG2A.348
VEG2A.349
IF (L_PHENOL) THEN VEG2A.350
DO N=1,NPFT VEG2A.351
DO L=LAND1,LAND1+LAND_PTS-1 VEG2A.352
G_LEAF_PHEN_AC(L,N)=0.0 VEG2A.353
ENDDO VEG2A.354
ENDDO VEG2A.355
ELSE VEG2A.356
DO N=1,NPFT VEG2A.357
DO L=LAND1,LAND1+LAND_PTS-1 VEG2A.358
G_LEAF_AC(L,N)=0.0 VEG2A.359
ENDDO VEG2A.360
ENDDO VEG2A.361
ENDIF VEG2A.362
VEG2A.363
ASTEPS_SINCE_TRIFFID=0 VEG2A.364
VEG2A.365
ENDIF VEG2A.366
VEG2A.367
C----------------------------------------------------------------------- VEG2A.368
C Calculate gridbox mean vegetation parameters from fractions of VEG2A.369
C surface functional types VEG2A.370
C----------------------------------------------------------------------- VEG2A.371
CALL SPARM
(LAND_FIELD,LAND1,LAND_PTS,TILE_PTS,TILE_INDEX VEG2A.372
&, ALB_SOIL,FRAC,HT,LAI VEG2A.373
&, ALBSNC,ALBSNF,CATCH_T,Z0,Z0_T) VEG2A.374
VEG2A.375
C----------------------------------------------------------------------- VEG2A.376
C Copy Z0 from land field to full field VEG2A.377
C----------------------------------------------------------------------- VEG2A.378
DO L=LAND1,LAND1+LAND_PTS-1 VEG2A.379
I=LAND_INDEX(L) VEG2A.380
Z0_P(I)=Z0(L) VEG2A.381
ENDDO VEG2A.382
VEG2A.383
RETURN VEG2A.384
END VEG2A.385
*ENDIF VEG2A.386