SUBROUTINE VEG_CTL(P_FIELDDA,LAND_FIELDDA,A_STEP,INT3, 1,29ABX1F405.976
*CALL ARGSIZE 
VEG_CTL1.24
*CALL ARGD1 VEG_CTL1.25
*CALL ARGDUMA VEG_CTL1.26
*CALL ARGDUMO VEG_CTL1.27
*CALL ARGDUMW VEG_CTL1.28
*CALL ARGSTS VEG_CTL1.29
*CALL ARGPTRA VEG_CTL1.30
*CALL ARGPTRO VEG_CTL1.31
*CALL ARGCONA VEG_CTL1.32
*CALL ARGPPX VEG_CTL1.33
*CALL ARGFLDPT VEG_CTL1.34
& ICODE,CMESSAGE) VEG_CTL1.35
VEG_CTL1.36
IMPLICIT NONE VEG_CTL1.37
! VEG_CTL1.38
! Description: Calls interim control routine VEG_INTCTL VEG_CTL1.39
! VEG_CTL1.40
! Current Code Owner: Richard Betts VEG_CTL1.41
! VEG_CTL1.42
! History: VEG_CTL1.43
! Version Date Comment VEG_CTL1.44
! ------- ---- ------- VEG_CTL1.45
! 4.4 6/10/97 Original code. Richard Betts VEG_CTL1.46
! 4.5 5/8/98 Pass info on grid and halo dimensions into VEG_IC. ABX3F405.6
! Richard Betts ABX3F405.7
! 4.5 23/11/98 Write diagnostics 19001-19016 to STASH. ABX1F405.977
! Richard Betts ABX1F405.978
! VEG_CTL1.47
! Code Description: VEG_CTL1.48
! Language: FORTRAN 77 + common extensions. VEG_CTL1.49
! This code is written to UMDP3 v6 programming standards. VEG_CTL1.50
! VEG_CTL1.51
*CALL CMAXSIZE VEG_CTL1.52
*CALL CSUBMODL VEG_CTL1.53
*CALL TYPSIZE VEG_CTL1.54
*CALL TYPD1 VEG_CTL1.55
*CALL TYPDUMA VEG_CTL1.56
*CALL TYPDUMO VEG_CTL1.57
*CALL TYPDUMW VEG_CTL1.58
*CALL TYPSTS VEG_CTL1.59
*CALL TYPPTRA VEG_CTL1.60
*CALL TYPPTRO VEG_CTL1.61
*CALL TYPCONA VEG_CTL1.62
*CALL PPXLOOK VEG_CTL1.63
! All TYPFLDPT arguments are intent IN VEG_CTL1.64
*CALL TYPFLDPT VEG_CTL1.65
VEG_CTL1.66
INTEGER VEG_CTL1.67
& ICODE ! Return code : 0 Normal Exit VEG_CTL1.68
! ! : >0 Error VEG_CTL1.69
&,INT3 ABX1F405.979
&,P_FIELDDA ! Extra copy of P_FIELD for dynamic allocation VEG_CTL1.70
&,LAND_FIELDDA! Extra copy of LAND_FIELD for dynamic allocation VEG_CTL1.71
&,A_STEP ! timestep in atmosphere model VEG_CTL1.72
&,FIRST_POINT ! IN First P-point to be processed. VEG_CTL1.73
&,LAST_POINT ! IN Last P-point to be processed. VEG_CTL1.74
&,PSLEVEL ! loop counter for pseudolevels ABX1F405.980
&,PSLEVEL_OUT ! index for pseudolevels sent to STASH ABX1F405.981
&,im_ident ! Internal model identifier ABX1F405.982
&,im_index ! Internal model index for stash arrays ABX1F405.983
VEG_CTL1.75
*CALL NSTYPES VEG_CTL1.76
VEG_CTL1.77
REAL VEG_CTL1.78
& C_VEG(LAND_FIELDDA,NPFT) ! Total carbon content of vegetation VEG_CTL1.79
! ! (kg C/m2). VEG_CTL1.80
&,CV(LAND_FIELDDA) ! Gridbox mean veg carbon (kg C/m2). VEG_CTL1.81
&,LIT_C(LAND_FIELDDA,NPFT) ! Carbon Litter (kg C/m2/360days). ABX1F405.984
&,LIT_C_MN(LAND_FIELDDA) ! Gridbox mean carbon litter ABX1F405.985
! ! (kg C/m2/360days) ABX1F405.986
&,G_LEAF_DAY(LAND_FIELD,NPFT) ! Mean leaf turnover rate for ABX1F405.987
! ! input to PHENOL (/360days). ABX1F405.988
&,G_LEAF_PHEN(LAND_FIELD,NPFT) ! Mean leaf turnover rate over ABX1F405.989
! ! phenology period (/360days). ABX1F405.990
&,G_LEAF_DR_OUT(LAND_FIELD,NPFT) ! Mean leaf turnover rate for ABX1F405.991
! ! driving TRIFFID (/360days). ABX1F405.992
&,LAI_PHEN(LAND_FIELD,NPFT) ! LAI of PFTs after phenology. ABX1F405.993
&,NPP_DR_OUT(LAND_FIELD,NPFT) ! Mean NPP for driving TRIFFID ABX1F405.994
! ! (kg C/m2/360days). ABX1F405.995
&,RESP_W_DR_OUT(LAND_FIELD,NPFT) ! Mean wood respiration for ABX1F405.996
! ! driving TRIFFID ABX1F405.997
! ! (kg C/m2/360days). ABX1F405.998
&,RESP_S_DR_OUT(LAND_FIELD) ! Mean soil respiration for ABX1F405.999
! ! driving TRIFFID ABX1F405.1000
! ! (kg C/m2/360days). ABX1F405.1001
&,STASHWORK(INT3) ! STASH workspace ABX1F405.1002
VEG_CTL1.84
CHARACTER*80 VEG_CTL1.85
& CMESSAGE ! Error message if return code >0 VEG_CTL1.86
VEG_CTL1.87
INTEGER VEG_CTL1.88
& LAND1 ! LOCAL First land point to be processed. VEG_CTL1.89
&,LAND_PTS ! LOCAL Number of land point to be processed. VEG_CTL1.90
VEG_CTL1.91
INTEGER VEG_CTL1.92
& L ! Loop counter for land points VEG_CTL1.93
VEG_CTL1.94
LOGICAL ABX1F405.1003
& PLLTYPE(NTYPE) ! pseudolevel list for surface types ABX1F405.1004
&,PLLPFT(NPFT) ! pseudolevel list for PFTs ABX1F405.1005
&,PLLNIT(NTYPE-1) ! pseudolevel list for non-ice types ABX1F405.1006
ABX1F405.1007
*IF DEF,MPP VEG_CTL1.95
! Parameters and Common blocks VEG_CTL1.96
*CALL PARVARS VEG_CTL1.97
*ENDIF VEG_CTL1.98
*CALL C_MDI VEG_CTL1.99
*CALL CHSUNITS VEG_CTL1.100
*CALL CCONTROL VEG_CTL1.101
*CALL C_R_CP VEG_CTL1.102
*CALL C_LHEAT VEG_CTL1.103
*CALL CHISTORY VEG_CTL1.104
*CALL CTRACERA VEG_CTL1.105
*CALL CRUNTIMC VEG_CTL1.106
*CALL CTIME VEG_CTL1.107
*CALL C_PI VEG_CTL1.108
VEG_CTL1.109
EXTERNAL VEG_CTL1.110
& VEG_IC VEG_CTL1.111
VEG_CTL1.112
im_ident = atmos_im ABX1F405.1008
im_index = internal_model_index(im_ident) ABX1F405.1009
ABX1F405.1010
FIRST_POINT=START_POINT_NO_HALO VEG_CTL1.113
LAST_POINT=END_P_POINT_INC_HALO VEG_CTL1.114
LAND1 = 1 VEG_CTL1.115
LAND_PTS = 0 VEG_CTL1.116
DO L=1,LAND_FIELD VEG_CTL1.117
IF ( LAND_LIST(L) .LT. FIRST_POINT ) THEN VEG_CTL1.118
LAND1 = LAND1 + 1 VEG_CTL1.119
ELSEIF ( LAND_LIST(L) .LE. LAST_POINT ) THEN VEG_CTL1.120
LAND_PTS = LAND_PTS + 1 VEG_CTL1.121
ENDIF VEG_CTL1.122
ENDDO VEG_CTL1.123
VEG_CTL1.124
! Call intermediate control routine VEG_CTL1.125
CALL VEG_IC(P_FIELD,FIRST_POINT,LAST_POINT,LAND_FIELD,LAND1, VEG_CTL1.126
& LAND_PTS,LAND_LIST,P_ROWS,ROW_LENGTH, ABX3F405.8
*IF DEF,MPP ABX3F405.9
& EW_Halo,NS_Halo, ABX3F405.10
*ENDIF ABX3F405.11
& A_STEP,A_INTHD(23),PHENOL_PERIOD,A_INTHD(22), ABX3F405.12
& L_PHENOL,L_TRIFFID,L_TRIF_EQ, VEG_CTL1.129
& D1(JSOIL_ALB),SECS_PER_STEPim(atmos_im),D1(JDISTURB), VEG_CTL1.130
& D1(JG_LF_PFT_ACC),D1(JG_PHLF_PFT_ACC), VEG_CTL1.131
& D1(JNPP_PFT_ACC),D1(JRSP_S_ACC),D1(JRSP_W_PFT_ACC), VEG_CTL1.132
& D1(JSOIL_CARB),D1(JFRAC_TYP),D1(JLAI_PFT), VEG_CTL1.133
& D1(JCANHT_PFT),D1(JMDSA),D1(JSFA),D1(JCATCH_NIT), VEG_CTL1.134
& D1(JZ0),D1(JZ0_TYP), VEG_CTL1.135
& C_VEG,CV,LIT_C,LIT_C_MN,G_LEAF_DAY,G_LEAF_PHEN, ABX1F405.1011
& LAI_PHEN,G_LEAF_DR_OUT,NPP_DR_OUT,RESP_W_DR_OUT, ABX1F405.1012
& RESP_S_DR_OUT ABX1F405.1013
& ) VEG_CTL1.137
VEG_CTL1.138
!----------------------------------------------------------------------- ABX1F405.1014
! Write diagnostics to STASH ABX1F405.1015
!----------------------------------------------------------------------- ABX1F405.1016
ABX1F405.1017
CL ITEM 1: VEGETATION CARBON ON PLANT FUNCTIONAL TYPES ABX1F405.1018
ABX1F405.1019
IF (SF(1,19)) THEN ABX1F405.1020
CALL SET_PSEUDO_LIST(NPFT,LEN_STLIST, ABX1F405.1021
& STLIST(1,STINDEX(1,1,19,im_index)), ABX1F405.1022
& PLLPFT,STASH_PSEUDO_LEVELS,NUM_STASH_PSEUDO, ABX1F405.1023
& ICODE,CMESSAGE) ABX1F405.1024
IF (ICODE.GT.0) THEN ABX1F405.1025
RETURN ABX1F405.1026
END IF ABX1F405.1027
PSLEVEL_OUT=0 ABX1F405.1028
DO PSLEVEL=1,NPFT ABX1F405.1029
IF (PLLPFT(PSLEVEL)) THEN ABX1F405.1030
PSLEVEL_OUT=PSLEVEL_OUT+1 ABX1F405.1031
CALL FROM_LAND_POINTS ( ABX1F405.1032
& STASHWORK(SI(1,19,im_index)+(PSLEVEL_OUT-1) ABX1F405.1033
& *P_FIELD),C_VEG(1,PSLEVEL), ABX1F405.1034
& D1(JLAND),P_FIELD,LAND_FIELD) ABX1F405.1035
END IF ABX1F405.1036
END DO ABX1F405.1037
END IF ABX1F405.1038
ABX1F405.1039
CL ITEM 2: GRIDBOX MEAN VEGETATION CARBON ABX1F405.1040
ABX1F405.1041
IF (SF(2,19)) THEN ABX1F405.1042
CALL FROM_LAND_POINTS ( ABX1F405.1043
& STASHWORK(SI(2,19,im_index)),CV, ABX1F405.1044
& D1(JLAND),P_FIELD,LAND_FIELD) ABX1F405.1045
END IF ABX1F405.1046
ABX1F405.1047
CL ITEM 3: PHENOLOGICAL LEAF TURNOVER RATE PFTS ABX1F405.1048
ABX1F405.1049
IF (SF(3,19)) THEN ABX1F405.1050
CALL SET_PSEUDO_LIST(NPFT,LEN_STLIST, ABX1F405.1051
& STLIST(1,STINDEX(1,3,19,im_index)), ABX1F405.1052
& PLLPFT,STASH_PSEUDO_LEVELS,NUM_STASH_PSEUDO, ABX1F405.1053
& ICODE,CMESSAGE) ABX1F405.1054
IF (ICODE.GT.0) THEN ABX1F405.1055
RETURN ABX1F405.1056
END IF ABX1F405.1057
PSLEVEL_OUT=0 ABX1F405.1058
DO PSLEVEL=1,NPFT ABX1F405.1059
IF (PLLPFT(PSLEVEL)) THEN ABX1F405.1060
PSLEVEL_OUT=PSLEVEL_OUT+1 ABX1F405.1061
CALL FROM_LAND_POINTS ( ABX1F405.1062
& STASHWORK(SI(3,19,im_index)+(PSLEVEL_OUT-1) ABX1F405.1063
& *P_FIELD),G_LEAF_PHEN(1,PSLEVEL), ABX1F405.1064
& D1(JLAND),P_FIELD,LAND_FIELD) ABX1F405.1065
END IF ABX1F405.1066
END DO ABX1F405.1067
END IF ABX1F405.1068
ABX1F405.1069
CL ITEM 4: LITTER CARBON ON PLANT FUNCTIONAL TYPES ABX1F405.1070
ABX1F405.1071
IF (SF(4,19)) THEN ABX1F405.1072
CALL SET_PSEUDO_LIST(NPFT,LEN_STLIST, ABX1F405.1073
& STLIST(1,STINDEX(1,4,19,im_index)), ABX1F405.1074
& PLLPFT,STASH_PSEUDO_LEVELS,NUM_STASH_PSEUDO, ABX1F405.1075
& ICODE,CMESSAGE) ABX1F405.1076
IF (ICODE.GT.0) THEN ABX1F405.1077
RETURN ABX1F405.1078
END IF ABX1F405.1079
PSLEVEL_OUT=0 ABX1F405.1080
DO PSLEVEL=1,NPFT ABX1F405.1081
IF (PLLPFT(PSLEVEL)) THEN ABX1F405.1082
PSLEVEL_OUT=PSLEVEL_OUT+1 ABX1F405.1083
CALL FROM_LAND_POINTS ( ABX1F405.1084
& STASHWORK(SI(4,19,im_index)+(PSLEVEL_OUT-1) ABX1F405.1085
& *P_FIELD),LIT_C(1,PSLEVEL), ABX1F405.1086
& D1(JLAND),P_FIELD,LAND_FIELD) ABX1F405.1087
END IF ABX1F405.1088
END DO ABX1F405.1089
END IF ABX1F405.1090
ABX1F405.1091
CL ITEM 5: GRIDBOX MEAN LITTER CARBON ABX1F405.1092
ABX1F405.1093
IF (SF(5,19)) THEN ABX1F405.1094
CALL FROM_LAND_POINTS ( ABX1F405.1095
& STASHWORK(SI(5,19,im_index)),LIT_C_MN, ABX1F405.1096
& D1(JLAND),P_FIELD,LAND_FIELD) ABX1F405.1097
END IF ABX1F405.1098
ABX1F405.1099
CL ITEM 6: MEAN LEAF TURNOVER RATE ON PFTS FOR PHENOLOGY ABX1F405.1100
ABX1F405.1101
IF (SF(6,19)) THEN ABX1F405.1102
CALL SET_PSEUDO_LIST(NPFT,LEN_STLIST, ABX1F405.1103
& STLIST(1,STINDEX(1,6,19,im_index)), ABX1F405.1104
& PLLPFT,STASH_PSEUDO_LEVELS,NUM_STASH_PSEUDO, ABX1F405.1105
& ICODE,CMESSAGE) ABX1F405.1106
IF (ICODE.GT.0) THEN ABX1F405.1107
RETURN ABX1F405.1108
END IF ABX1F405.1109
PSLEVEL_OUT=0 ABX1F405.1110
DO PSLEVEL=1,NPFT ABX1F405.1111
IF (PLLPFT(PSLEVEL)) THEN ABX1F405.1112
PSLEVEL_OUT=PSLEVEL_OUT+1 ABX1F405.1113
CALL FROM_LAND_POINTS ( ABX1F405.1114
& STASHWORK(SI(6,19,im_index)+(PSLEVEL_OUT-1) ABX1F405.1115
& *P_FIELD),G_LEAF_DAY(1,PSLEVEL), ABX1F405.1116
& D1(JLAND),P_FIELD,LAND_FIELD) ABX1F405.1117
END IF ABX1F405.1118
END DO ABX1F405.1119
END IF ABX1F405.1120
ABX1F405.1121
CL ITEM 7: LEAF AREA INDEX ON PLANT FUNCTIONAL TYPES AFTER PHENOLOGY ABX1F405.1122
ABX1F405.1123
IF (SF(7,19)) THEN ABX1F405.1124
CALL SET_PSEUDO_LIST(NPFT,LEN_STLIST, ABX1F405.1125
& STLIST(1,STINDEX(1,7,19,im_index)), ABX1F405.1126
& PLLPFT,STASH_PSEUDO_LEVELS,NUM_STASH_PSEUDO, ABX1F405.1127
& ICODE,CMESSAGE) ABX1F405.1128
IF (ICODE.GT.0) THEN ABX1F405.1129
RETURN ABX1F405.1130
END IF ABX1F405.1131
PSLEVEL_OUT=0 ABX1F405.1132
DO PSLEVEL=1,NPFT ABX1F405.1133
IF (PLLPFT(PSLEVEL)) THEN ABX1F405.1134
PSLEVEL_OUT=PSLEVEL_OUT+1 ABX1F405.1135
CALL FROM_LAND_POINTS ( ABX1F405.1136
& STASHWORK(SI(7,19,im_index)+(PSLEVEL_OUT-1) ABX1F405.1137
& *P_FIELD),LAI_PHEN(1,PSLEVEL), ABX1F405.1138
& D1(JLAND),P_FIELD,LAND_FIELD) ABX1F405.1139
END IF ABX1F405.1140
END DO ABX1F405.1141
END IF ABX1F405.1142
ABX1F405.1143
CL ITEM 8: MEAN LEAF TURNOVER RATE ON PFTS FOR TRIFFID ABX1F405.1144
ABX1F405.1145
IF (SF(8,19)) THEN ABX1F405.1146
CALL SET_PSEUDO_LIST(NPFT,LEN_STLIST, ABX1F405.1147
& STLIST(1,STINDEX(1,8,19,im_index)), ABX1F405.1148
& PLLPFT,STASH_PSEUDO_LEVELS,NUM_STASH_PSEUDO, ABX1F405.1149
& ICODE,CMESSAGE) ABX1F405.1150
IF (ICODE.GT.0) THEN ABX1F405.1151
RETURN ABX1F405.1152
END IF ABX1F405.1153
PSLEVEL_OUT=0 ABX1F405.1154
DO PSLEVEL=1,NPFT ABX1F405.1155
IF (PLLPFT(PSLEVEL)) THEN ABX1F405.1156
PSLEVEL_OUT=PSLEVEL_OUT+1 ABX1F405.1157
CALL FROM_LAND_POINTS ( ABX1F405.1158
& STASHWORK(SI(8,19,im_index)+(PSLEVEL_OUT-1) ABX1F405.1159
& *P_FIELD),G_LEAF_DR_OUT(1,PSLEVEL), ABX1F405.1160
& D1(JLAND),P_FIELD,LAND_FIELD) ABX1F405.1161
END IF ABX1F405.1162
END DO ABX1F405.1163
END IF ABX1F405.1164
ABX1F405.1165
CL ITEM 9: MEAN NPP ON PFTS FOR TRIFFID ABX1F405.1166
ABX1F405.1167
IF (SF(9,19)) THEN ABX1F405.1168
CALL SET_PSEUDO_LIST(NPFT,LEN_STLIST, ABX1F405.1169
& STLIST(1,STINDEX(1,9,19,im_index)), ABX1F405.1170
& PLLPFT,STASH_PSEUDO_LEVELS,NUM_STASH_PSEUDO, ABX1F405.1171
& ICODE,CMESSAGE) ABX1F405.1172
IF (ICODE.GT.0) THEN ABX1F405.1173
RETURN ABX1F405.1174
END IF ABX1F405.1175
PSLEVEL_OUT=0 ABX1F405.1176
DO PSLEVEL=1,NPFT ABX1F405.1177
IF (PLLPFT(PSLEVEL)) THEN ABX1F405.1178
PSLEVEL_OUT=PSLEVEL_OUT+1 ABX1F405.1179
CALL FROM_LAND_POINTS ( ABX1F405.1180
& STASHWORK(SI(9,19,im_index)+(PSLEVEL_OUT-1) ABX1F405.1181
& *P_FIELD),NPP_DR_OUT(1,PSLEVEL), ABX1F405.1182
& D1(JLAND),P_FIELD,LAND_FIELD) ABX1F405.1183
END IF ABX1F405.1184
END DO ABX1F405.1185
END IF ABX1F405.1186
ABX1F405.1187
CL ITEM 10: MEAN WOOD RESPIRATION ON PFTS FOR TRIFFID ABX1F405.1188
ABX1F405.1189
IF (SF(10,19)) THEN ABX1F405.1190
CALL SET_PSEUDO_LIST(NPFT,LEN_STLIST, ABX1F405.1191
& STLIST(1,STINDEX(1,10,19,im_index)), ABX1F405.1192
& PLLPFT,STASH_PSEUDO_LEVELS,NUM_STASH_PSEUDO, ABX1F405.1193
& ICODE,CMESSAGE) ABX1F405.1194
IF (ICODE.GT.0) THEN ABX1F405.1195
RETURN ABX1F405.1196
END IF ABX1F405.1197
PSLEVEL_OUT=0 ABX1F405.1198
DO PSLEVEL=1,NPFT ABX1F405.1199
IF (PLLPFT(PSLEVEL)) THEN ABX1F405.1200
PSLEVEL_OUT=PSLEVEL_OUT+1 ABX1F405.1201
CALL FROM_LAND_POINTS ( ABX1F405.1202
& STASHWORK(SI(10,19,im_index)+(PSLEVEL_OUT-1) ABX1F405.1203
& *P_FIELD),RESP_W_DR_OUT(1,PSLEVEL), ABX1F405.1204
& D1(JLAND),P_FIELD,LAND_FIELD) ABX1F405.1205
END IF ABX1F405.1206
END DO ABX1F405.1207
END IF ABX1F405.1208
ABX1F405.1209
CL ITEM 11: MEAN SOIL RESPIRATION FOR TRIFFID ABX1F405.1210
ABX1F405.1211
IF (SF(11,19)) THEN ABX1F405.1212
CALL FROM_LAND_POINTS ( ABX1F405.1213
& STASHWORK(SI(11,19,im_index)),RESP_S_DR_OUT, ABX1F405.1214
& D1(JLAND),P_FIELD,LAND_FIELD) ABX1F405.1215
END IF ABX1F405.1216
ABX1F405.1217
CL ITEM 12: DISTURBED FRACTION OF VEGETATION ABX1F405.1218
ABX1F405.1219
IF (SF(12,19)) THEN ABX1F405.1220
CALL FROM_LAND_POINTS ( ABX1F405.1221
& STASHWORK(SI(12,19,im_index)), ABX1F405.1222
& D1(JDISTURB+((PSLEVEL-1)*LAND_FIELD)), ABX1F405.1223
& D1(JLAND),P_FIELD,LAND_FIELD) ABX1F405.1224
END IF ABX1F405.1225
ABX1F405.1226
CL ITEM 13: SURFACE TYPE FRACTIONS AFTER TRIFFID ABX1F405.1227
ABX1F405.1228
IF (SF(13,19)) THEN ABX1F405.1229
CALL SET_PSEUDO_LIST(NTYPE,LEN_STLIST, ABX1F405.1230
& STLIST(1,STINDEX(1,13,19,im_index)), ABX1F405.1231
& PLLTYPE,STASH_PSEUDO_LEVELS,NUM_STASH_PSEUDO, ABX1F405.1232
& ICODE,CMESSAGE) ABX1F405.1233
IF (ICODE.GT.0) THEN ABX1F405.1234
RETURN ABX1F405.1235
END IF ABX1F405.1236
PSLEVEL_OUT=0 ABX1F405.1237
DO PSLEVEL=1,NTYPE ABX1F405.1238
IF (PLLTYPE(PSLEVEL)) THEN ABX1F405.1239
PSLEVEL_OUT=PSLEVEL_OUT+1 ABX1F405.1240
CALL FROM_LAND_POINTS ( ABX1F405.1241
& STASHWORK(SI(13,19,im_index)+(PSLEVEL_OUT-1) ABX1F405.1242
& *P_FIELD),D1(JFRAC_TYP+((PSLEVEL-1)*LAND_FIELD)), ABX1F405.1243
& D1(JLAND),P_FIELD,LAND_FIELD) ABX1F405.1244
END IF ABX1F405.1245
END DO ABX1F405.1246
END IF ABX1F405.1247
ABX1F405.1248
CL ITEM 14: LEAF AREA INDEX ON PLANT FUNCTIONAL TYPES AFTER TRIFFID ABX1F405.1249
ABX1F405.1250
IF (SF(14,19)) THEN ABX1F405.1251
CALL SET_PSEUDO_LIST(NPFT,LEN_STLIST, ABX1F405.1252
& STLIST(1,STINDEX(1,14,19,im_index)), ABX1F405.1253
& PLLPFT,STASH_PSEUDO_LEVELS,NUM_STASH_PSEUDO, ABX1F405.1254
& ICODE,CMESSAGE) ABX1F405.1255
IF (ICODE.GT.0) THEN ABX1F405.1256
RETURN ABX1F405.1257
END IF ABX1F405.1258
PSLEVEL_OUT=0 ABX1F405.1259
DO PSLEVEL=1,NPFT ABX1F405.1260
IF (PLLPFT(PSLEVEL)) THEN ABX1F405.1261
PSLEVEL_OUT=PSLEVEL_OUT+1 ABX1F405.1262
CALL FROM_LAND_POINTS ( ABX1F405.1263
& STASHWORK(SI(14,19,im_index)+(PSLEVEL_OUT-1) ABX1F405.1264
& *P_FIELD),D1(JLAI_PFT+((PSLEVEL-1)*LAND_FIELD)), ABX1F405.1265
& D1(JLAND),P_FIELD,LAND_FIELD) ABX1F405.1266
END IF ABX1F405.1267
END DO ABX1F405.1268
END IF ABX1F405.1269
ABX1F405.1270
CL ITEM 15: CANOPY HEIGHT ON PLANT FUNCTIONAL TYPES AFTER TRIFFID ABX1F405.1271
ABX1F405.1272
IF (SF(15,19)) THEN ABX1F405.1273
CALL SET_PSEUDO_LIST(NPFT,LEN_STLIST, ABX1F405.1274
& STLIST(1,STINDEX(1,15,19,im_index)), ABX1F405.1275
& PLLPFT,STASH_PSEUDO_LEVELS,NUM_STASH_PSEUDO, ABX1F405.1276
& ICODE,CMESSAGE) ABX1F405.1277
IF (ICODE.GT.0) THEN ABX1F405.1278
RETURN ABX1F405.1279
END IF ABX1F405.1280
PSLEVEL_OUT=0 ABX1F405.1281
DO PSLEVEL=1,NPFT ABX1F405.1282
IF (PLLPFT(PSLEVEL)) THEN ABX1F405.1283
PSLEVEL_OUT=PSLEVEL_OUT+1 ABX1F405.1284
CALL FROM_LAND_POINTS ( ABX1F405.1285
& STASHWORK(SI(15,19,im_index)+(PSLEVEL_OUT-1) ABX1F405.1286
& *P_FIELD),D1(JCANHT_PFT+((PSLEVEL-1)*LAND_FIELD)), ABX1F405.1287
& D1(JLAND),P_FIELD,LAND_FIELD) ABX1F405.1288
END IF ABX1F405.1289
END DO ABX1F405.1290
END IF ABX1F405.1291
ABX1F405.1292
CL ITEM 16: SOIL CARBON CONTENT AFTER TRIFFID ABX1F405.1293
ABX1F405.1294
IF (SF(16,19)) THEN ABX1F405.1295
CALL FROM_LAND_POINTS ( ABX1F405.1296
& STASHWORK(SI(16,19,im_index)),D1(JSOIL_CARB), ABX1F405.1297
& D1(JLAND),P_FIELD,LAND_FIELD) ABX1F405.1298
END IF ABX1F405.1299
ABX1F405.1300
ABX1F405.1301
CALL STASH(a_sm,a_im,3,STASHWORK, ABX1F405.1302
*CALL ARGSIZE ABX1F405.1303
*CALL ARGD1 ABX1F405.1304
*CALL ARGDUMA ABX1F405.1305
*CALL ARGDUMO ABX1F405.1306
*CALL ARGDUMW ABX1F405.1307
*CALL ARGSTS ABX1F405.1308
*CALL ARGPPX ABX1F405.1309
& ICODE,CMESSAGE) ABX1F405.1310
RETURN VEG_CTL1.139
END VEG_CTL1.140
*ENDIF VEG_CTL1.141