R/LaiRL.R
In happynotes/PIHM.AnalysisR:
#' PIHM Analysis project.
#' Developed by Lele Shu( lele.shu at gmail.com lzs157 at psu.edu )
#' Created by Thu Apr 16 10:53:00 EDT 2015
#' <- ============================================
#' Current version is for PIHM 2.0 and above;
fun.lairl <- function(lc, years=2000){
rltbl =matrix(c(
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
1.112, 1.103, 1.088, 1.082, 1.076, 1.068, 1.073, 1.079, 1.082, 1.088, 1.103, 1.112,
2.653, 2.653, 2.653, 2.653, 2.653, 2.653, 2.653, 2.653, 2.653, 2.653, 2.653, 2.653,
1.112, 1.103, 1.088, 1.082, 1.076, 1.068, 1.073, 1.079, 1.082, 1.088, 1.103, 1.112,
0.52, 0.52, 0.666, 0.91, 1.031, 1.044, 1.042, 1.037, 1.036, 0.917, 0.666, 0.52,
0.816, 0.8115, 0.877, 0.996, 1.0535, 1.056, 1.0575, 1.058, 1.059, 1.0025, 0.8845, 0.816,
0.7602524, 0.7551426, 0.7772204, 0.8250124, 0.846955, 0.8449668, 0.8471342, 0.8496604, 0.8514252, 0.8299022, 0.7857734, 0.7602744,
0.35090494, 0.34920916, 0.36891486, 0.40567288, 0.42336056, 0.42338372, 0.42328378, 0.42485112, 0.42631836, 0.40881268, 0.37218526, 0.35096866,
0.05641527, 0.05645892, 0.05557872, 0.05430207, 0.05425842, 0.05399002, 0.05361482, 0.0572041, 0.05892068, 0.05821407, 0.05709462, 0.05645892,
0.03699235, 0.03699634, 0.03528634, 0.03272533, 0.03272134, 0.03270066, 0.03268178, 0.03907616, 0.04149324, 0.04032533, 0.03823134, 0.03699634,
0.0777, 0.0778, 0.0778, 0.0779, 0.0778, 0.0771, 0.0759, 0.0766, 0.0778, 0.0779, 0.0778, 0.0778,
0.0777, 0.0778, 0.0778, 0.0779, 0.0778, 0.0771, 0.0759, 0.0766, 0.0778, 0.0779, 0.0778, 0.0778,
0.0112, 0.0112, 0.0112, 0.0112, 0.0112, 0.0112, 0.0112, 0.0112, 0.0112, 0.0112, 0.0112, 0.0112,
0.1947138, 0.19413424, 0.20831414, 0.23348558, 0.24574614, 0.24605016, 0.24538258, 0.24630454, 0.247455, 0.23527388, 0.20963734, 0.19478494
), ncol =14, nrow=12)
laitbl = matrix(c(
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
8.76, 9.16, 9.827, 10.093, 10.36, 10.76, 10.493, 10.227, 10.093, 9.827, 9.16, 8.76,
5.117, 5.117, 5.117, 5.117, 5.117, 5.117, 5.117, 5.117, 5.117, 5.117, 5.117, 5.117,
8.76, 9.16, 9.827, 10.093, 10.36, 10.76, 10.493, 10.227, 10.093, 9.827, 9.16, 8.76,
0.52, 0.52, 0.867, 2.107, 4.507, 6.773, 7.173, 6.507, 5.04, 2.173, 0.867, 0.52,
4.64, 4.84, 5.347, 6.1, 7.4335, 8.7665, 8.833, 8.367, 7.5665, 6, 5.0135, 4.64,
5.276088, 5.528588, 6.006132, 6.4425972, 7.2448806, 8.3639474, 8.540044, 8.126544, 7.2533006, 6.3291908, 5.6258086, 5.300508,
2.3331824, 2.4821116, 2.7266101, 3.0330155, 3.8849492, 5.5212224, 6.2395131, 5.7733017, 4.1556703, 3.1274641, 2.6180116, 2.4039116 ,
0.580555, 0.6290065, 0.628558, 0.628546, 0.919255, 1.7685454, 2.5506969, 2.5535975, 1.7286418, 0.9703975, 0.726358, 0.6290065 ,
0.3999679, 0.4043968, 0.3138257, 0.2232945, 0.2498679, 0.3300675, 0.4323964, 0.7999234, 1.1668827, 0.7977234, 0.5038257, 0.4043968,
0.782, 0.893, 1.004, 1.116, 1.782, 3.671, 4.782, 4.227, 2.004, 1.227, 1.004, 0.893,
0.782, 0.893, 1.004, 1.116, 1.782, 3.671, 4.782, 4.227, 2.004, 1.227, 1.004, 0.893,
0.001, 0.001, 0.001, 0.001, 0.001, 0.001, 0.001, 0.001, 0.001, 0.001, 0.001, 0.001 ,
1.2867143, 1.3945997, 1.5506977, 1.7727263, 2.5190228, 4.1367678, 5.0212291, 4.5795799, 2.8484358, 1.8856229, 1.5178736, 1.3656797
),
ncol =14, nrow=12)
nlc = length(lc)
ny = length(years)
t=seq(as.Date(paste0(years[1]-1, '-12-31')),
as.Date(paste0(years[ny], '-12-31')), by=1)
t1=apply.monthly( t, FUN=first)
time = time(t1) + 1;
for (i in 1:nlc){
ilc= lc[i]
lai = lc_EQ(laitbl, ilc)
rl = lc_EQ (rltbl, ilc)
if (i ==1){
mlai = lai;
mrl = rl;
}else{
mlai = cbind(mlai, lai)
mrl = cbind(mrl, rl)
}
}
ts.lai = as.xts(rbind(rep.row(mlai, ny), mlai[1,]), order.by =time)
ts.rl = as.xts(rbind(rep.row(mrl, ny), mrl[1,]), order.by =time)
colnames(ts.lai) = paste(lc)
colnames(ts.rl) = paste(lc)
ret = list(LAI = ts.lai, RL=ts.rl, nLAI=nlc)
return(ret)
}
fun.vegtable <- function (lc){
dveg=matrix(c(
#SHDFAC,DROOT,RS,RGL,HS,SNUP,LAIMIN,LAIMAX,EMISMIN,EMISMAX,ALBMIN,ALBMAX,Z0MIN,Z0MAX,ROUGH,DegrdationRate,
0.00000 ,0.60000 ,100.00000 ,30.00000 ,51.75000 ,0.01000 ,0.01000 ,0.00000 ,0.98000 ,0.98000 ,0.08000 ,0.13500 ,0.00010 ,0.00010 ,0.10000 ,0.00000 ,#Water ,
0.80000 ,0.60000 ,125.00000 ,30.00000 ,47.35000 ,0.08000 ,5.00000 ,10.76000 ,0.95000 ,0.95000 ,0.12000 ,0.18200 ,0.50000 ,0.50000 ,0.32000 ,0.00000 ,#Evergreen Needleleaf ,
0.90000 ,0.60000 ,150.00000 ,96.07728 ,41.69000 ,0.08000 ,3.08000 ,5.11700 ,0.95000 ,0.95000 ,0.12000 ,0.21300 ,0.50000 ,0.50000 ,0.32000 ,0.00000 ,#Evergreen Broadleaf ,
0.80000 ,0.60000 ,150.00000 ,30.00000 ,47.35000 ,0.08000 ,1.00000 ,10.76000 ,0.93000 ,0.94000 ,0.14000 ,0.18200 ,0.50000 ,0.50000 ,0.36000 ,0.00000 ,#Deciduous Needleleaf ,
0.80000 ,0.60000 ,100.00000 ,72.00234 ,54.53000 ,0.08000 ,1.85000 ,7.17300 ,0.93000 ,0.93000 ,0.16000 ,0.23600 ,0.50000 ,0.50000 ,0.36000 ,0.00000 ,#Deciduous Broadleaf ,
0.79500 ,0.60000 ,125.00000 ,52.56440 ,51.93000 ,0.08000 ,2.80000 ,8.83300 ,0.93000 ,0.97000 ,0.17000 ,0.20250 ,0.20000 ,0.50000 ,0.40000 ,0.00000 ,#Mixed Forest ,
0.79986 ,0.60000 ,173.51021 ,55.99480 ,999.00000 ,999.00000 ,999.00000 ,8.54004 ,999.00000 ,999.00000 ,0.00000 ,0.21129 ,999.00000 ,999.00000 ,0.35000 ,0.00000 ,#Woodland ,
0.80184 ,0.40000 ,300.00000 ,82.93310 ,42.00000 ,0.03000 ,0.50000 ,3.66000 ,0.93000 ,0.93000 ,0.25000 ,0.25245 ,0.01000 ,0.05000 ,0.40000 ,0.00000 ,#Wooded Grassland ,
0.62501 ,0.40000 ,300.00000 ,126.09371 ,42.00000 ,0.03000 ,0.50000 ,3.66000 ,0.93000 ,0.93000 ,0.25000 ,0.24959 ,0.01000 ,0.05000 ,0.30000 ,0.00000 ,#Closed Shrubland ,
0.21818 ,0.40000 ,170.00000 ,142.33158 ,39.18000 ,0.03500 ,0.60000 ,2.60000 ,0.93000 ,0.95000 ,0.22000 ,0.26652 ,0.01000 ,0.06000 ,0.25000 ,0.00000 ,#Open Shrubland ,
0.72552 ,0.40000 ,40.00000 ,100.00000 ,36.35000 ,0.04000 ,0.52000 ,2.90000 ,0.92000 ,0.96000 ,0.19000 ,0.28802 ,0.10000 ,0.12000 ,0.10000 ,0.05000 ,#Grassland ,
0.83537 ,0.40000 ,40.00000 ,100.00000 ,36.25000 ,0.04000 ,1.56000 ,4.78200 ,0.92000 ,0.98500 ,0.17000 ,0.24992 ,0.05000 ,0.15000 ,0.20000 ,0.50000 ,#Cropland ,
0.07489 ,0.05000 ,174.99974 ,155.98361 ,999.00000 ,0.02000 ,0.00100 ,0.00100 ,0.90000 ,0.90000 ,0.38000 ,0.38000 ,0.01000 ,0.01000 ,0.02000 ,0.30000 ,#Bare Ground ,
0.10000 ,0.05000 ,200.00000 ,97.19872 ,999.00000 ,0.04000 ,0.00100 ,0.00100 ,0.88000 ,0.88000 ,0.15000 ,0.24650 ,0.50000 ,0.50000 ,0.02000 ,0.90000 #Urban and Build ,
), ncol=14, nrow= 16)
nlc = length(lc)
for (i in 1:nlc){
ilc= lc[i]
iveg = lc_EQ(dveg, ilc)
if (i ==1){
mveg = matrix(iveg, ncol=1);
}else{
mveg = cbind(mveg, iveg)
}
}
imp = rep(0,nlc)
imp[which(lc == 20) ]= 0.10 #
imp[which(lc == 21) ]= 0.15#
imp[which(lc == 22) ]= 0.35#
imp[which(lc == 23) ]= 0.65#
imp[which(lc == 24) ]= 0.95#
rnames = c('INDEX','SHDFAC','DROOT','RS','RGL','HS',
'SNUP','LAIMIN','LAIMAX','EMISMIN','EMISMAX',
'ALBMIN','ALBMAX','Z0MIN','Z0MAX','ROUGH',
'DgRate', 'ImpA')
mveg=rbind(rbind(1:nlc, mveg), imp)
rownames(mveg) = rnames
colnames(mveg) = paste(lc)
m= matrix(c( 298.0, 0.5, 5000.0, 16.0, 14.0), ncol=1, nrow= 5)
rownames(m) =c( 'TOPT_DATA','CFACTR_DATA','RSMAX_DATA','BARE','NATURAL')
ret = list(TBL = t(mveg), Misc = m)
return(ret)
}
lc_EQ <-function(dtab, lc){
tab = matrix(c( #0, 0.00, 0, 0.00, #00
0 , 0 , 0 , 0 , # 1 0
0 , 0 , 0 , 0 , # 2 0
0 , 0 , 0 , 0 , # 3 0
0 , 0 , 0 , 0 , # 4 0
0 , 0 , 0 , 0 , # 5 0
0 , 0 , 0 , 0 , # 6 0
0 , 0 , 0 , 0 , # 7 0
0 , 0 , 0 , 0 , # 8 0
0 , 0 , 0 , 0 , # 9 0
0 , 1 , 0 , 0 , # 10 1
0 , 0.9 , 6 , 0.1 , # 11 1 Open Water
0 , 0.9 , 6 , 0.1 , # 12 1 Perennial Ice/Snow
0 , 0 , 0 , 0 , # 13 0
0 , 0 , 0 , 0 , # 14 0
0 , 0 , 0 , 0 , # 15 0
0 , 0 , 0 , 0 , # 16 0
0 , 0 , 0 , 0 , # 17 0
0 , 0 , 0 , 0 , # 18 0
0 , 0 , 0 , 0 , # 19 0
13 , 0.65 , 0 , 0 , # 20 1
13 , 0.2 , 10 , 0.8 , # 21 1 Developed, Open Space
13 , 0.35 , 10 , 0.65 , # 22 1 Developed, Low Intensity
13 , 0.65 , 10 , 0.35 , # 23 1 Developed, Medium Intensity
13 , 0.9 , 10 , 0.1 , # 24 1 Developed High Intensity
0 , 0 , 0 , 0 , # 25 0
0 , 0 , 0 , 0 , # 26 0
0 , 0 , 0 , 0 , # 27 0
0 , 0 , 0 , 0 , # 28 0
0 , 0 , 0 , 0 , # 29 0
12 , 1 , 0 , 0 , # 30 1
12 , 0.92 , 9 , 0.08 , # 31 1 Barren Land (Rock/Sand/Clay)
12 , 1 , 9 , 0 , # 32 1
0 , 0 , 0 , 0 , # 33 0
0 , 0 , 0 , 0 , # 34 0
0 , 0 , 0 , 0 , # 35 0
0 , 0 , 0 , 0 , # 36 0
0 , 0 , 0 , 0 , # 37 0
0 , 0 , 0 , 0 , # 38 0
0 , 0 , 0 , 0 , # 39 0
6 , 0.65 , 0 , 0 , # 40 1
4 , 0.6 , 10 , 0.4 , # 41 1 Deciduous Forest
2 , 0.6 , 10 , 0.4 , # 42 1 Evergreen Forest
5 , 0.6 , 10 , 0.4 , # 43 1 Mixed Forest
0 , 0 , 0 , 0 , # 44 0
0 , 0 , 0 , 0 , # 45 0
0 , 0 , 0 , 0 , # 46 0
0 , 0 , 0 , 0 , # 47 0
0 , 0 , 0 , 0 , # 48 0
0 , 0 , 0 , 0 , # 49 0
8 , 1 , 0 , 0 , # 50 1
9 , 0.4 , 10 , 0.6 , # 51 1 Dwarf Scrub
8 , 0.6 , 10 , 0.4 , # 52 1 Shrub/Scrub
0 , 0 , 0 , 0 , # 53 0
0 , 0 , 0 , 0 , # 54 0
0 , 0 , 0 , 0 , # 55 0
0 , 0 , 0 , 0 , # 56 0
0 , 0 , 0 , 0 , # 57 0
0 , 0 , 0 , 0 , # 58 0
0 , 0 , 0 , 0 , # 59 0
0 , 0 , 0 , 0 , # 60 0
0 , 0 , 0 , 0 , # 61 0
0 , 0 , 0 , 0 , # 62 0
0 , 0 , 0 , 0 , # 63 0
0 , 0 , 0 , 0 , # 64 0
0 , 0 , 0 , 0 , # 65 0
0 , 0 , 0 , 0 , # 66 0
0 , 0 , 0 , 0 , # 67 0
0 , 0 , 0 , 0 , # 68 0
0 , 0 , 0 , 0 , # 69 0
10 , 0.85 , 0 , 0 , # 70 1
10 , 0.9 , 12 , 0.1 , # 71 1 Grassland/Herbaceous
10 , 0.9 , 12 , 0.1 , # 72 1 Sedge/Herbaceous
10 , 0.9 , 12 , 0.1 , # 73 1 Lichens
10 , 0.9 , 12 , 0.1 , # 74 1 Moss
0 , 0 , 0 , 0 , # 75 0
0 , 0 , 0 , 0 , # 76 0
0 , 0 , 0 , 0 , # 77 0
0 , 0 , 0 , 0 , # 78 0
0 , 0 , 0 , 0 , # 79 0
10 , 0.9 , 0 , 0 , # 80 1
11 , 0.6 , 10 , 0.4 , # 81 1 Pasture/Hay
11 , 0.9 , 12 , 0.1 , # 82 1 Cultivated Crops
0 , 0 , 0 , 0 , # 83 0
0 , 0 , 0 , 0 , # 84 0
0 , 0 , 0 , 0 , # 85 0
0 , 0 , 0 , 0 , # 86 0
0 , 0 , 0 , 0 , # 87 0
0 , 0 , 0 , 0 , # 88 0
0 , 0 , 0 , 0 , # 89 0
8 , 0.6 , 0 , 0.4 , # 90 1 Woody Wetlands
6 , 0.6 , 0 , 0 , # 91 1
7 , 0.6 , 0 , 0 , # 92 1
6 , 0.6 , 0 , 0 , # 93 1
7 , 0.6 , 0 , 0 , # 94 1
10 , 0.8 , 0 , 0.2 , # 95 1 Emergent Herbaceous Wetlands
10 , 0.8 , 2 , 0.2 , # 96 1
10 , 0.8 , 4 , 0.2 , # 97 1
10 , 0.2 , 0 , 0.8 , # 98 1
10 , 0.2 , 0 , 0.8 ) # 99 1
, ncol=99, nrow=4)
c1= tab[2, lc]
v1 = dtab[, tab[1, lc]+1 ]
c2 = tab[4, lc]
v2 = dtab[, tab[3,lc]+1 ]
ret = c1 * v1 + c2 * v2;
return(ret)
}
happynotes/PIHM.AnalysisR documentation built on June 20, 2019, 4:04 p.m.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
#' PIHM Analysis project.
#' Developed by Lele Shu( lele.shu at gmail.com lzs157 at psu.edu )
#' Created by Thu Apr 16 10:53:00 EDT 2015
#' <- ============================================
#' Current version is for PIHM 2.0 and above;
fun.lairl <- function(lc, years=2000){
rltbl =matrix(c(
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
1.112, 1.103, 1.088, 1.082, 1.076, 1.068, 1.073, 1.079, 1.082, 1.088, 1.103, 1.112,
2.653, 2.653, 2.653, 2.653, 2.653, 2.653, 2.653, 2.653, 2.653, 2.653, 2.653, 2.653,
1.112, 1.103, 1.088, 1.082, 1.076, 1.068, 1.073, 1.079, 1.082, 1.088, 1.103, 1.112,
0.52, 0.52, 0.666, 0.91, 1.031, 1.044, 1.042, 1.037, 1.036, 0.917, 0.666, 0.52,
0.816, 0.8115, 0.877, 0.996, 1.0535, 1.056, 1.0575, 1.058, 1.059, 1.0025, 0.8845, 0.816,
0.7602524, 0.7551426, 0.7772204, 0.8250124, 0.846955, 0.8449668, 0.8471342, 0.8496604, 0.8514252, 0.8299022, 0.7857734, 0.7602744,
0.35090494, 0.34920916, 0.36891486, 0.40567288, 0.42336056, 0.42338372, 0.42328378, 0.42485112, 0.42631836, 0.40881268, 0.37218526, 0.35096866,
0.05641527, 0.05645892, 0.05557872, 0.05430207, 0.05425842, 0.05399002, 0.05361482, 0.0572041, 0.05892068, 0.05821407, 0.05709462, 0.05645892,
0.03699235, 0.03699634, 0.03528634, 0.03272533, 0.03272134, 0.03270066, 0.03268178, 0.03907616, 0.04149324, 0.04032533, 0.03823134, 0.03699634,
0.0777, 0.0778, 0.0778, 0.0779, 0.0778, 0.0771, 0.0759, 0.0766, 0.0778, 0.0779, 0.0778, 0.0778,
0.0777, 0.0778, 0.0778, 0.0779, 0.0778, 0.0771, 0.0759, 0.0766, 0.0778, 0.0779, 0.0778, 0.0778,
0.0112, 0.0112, 0.0112, 0.0112, 0.0112, 0.0112, 0.0112, 0.0112, 0.0112, 0.0112, 0.0112, 0.0112,
0.1947138, 0.19413424, 0.20831414, 0.23348558, 0.24574614, 0.24605016, 0.24538258, 0.24630454, 0.247455, 0.23527388, 0.20963734, 0.19478494
), ncol =14, nrow=12)
laitbl = matrix(c(
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
8.76, 9.16, 9.827, 10.093, 10.36, 10.76, 10.493, 10.227, 10.093, 9.827, 9.16, 8.76,
5.117, 5.117, 5.117, 5.117, 5.117, 5.117, 5.117, 5.117, 5.117, 5.117, 5.117, 5.117,
8.76, 9.16, 9.827, 10.093, 10.36, 10.76, 10.493, 10.227, 10.093, 9.827, 9.16, 8.76,
0.52, 0.52, 0.867, 2.107, 4.507, 6.773, 7.173, 6.507, 5.04, 2.173, 0.867, 0.52,
4.64, 4.84, 5.347, 6.1, 7.4335, 8.7665, 8.833, 8.367, 7.5665, 6, 5.0135, 4.64,
5.276088, 5.528588, 6.006132, 6.4425972, 7.2448806, 8.3639474, 8.540044, 8.126544, 7.2533006, 6.3291908, 5.6258086, 5.300508,
2.3331824, 2.4821116, 2.7266101, 3.0330155, 3.8849492, 5.5212224, 6.2395131, 5.7733017, 4.1556703, 3.1274641, 2.6180116, 2.4039116 ,
0.580555, 0.6290065, 0.628558, 0.628546, 0.919255, 1.7685454, 2.5506969, 2.5535975, 1.7286418, 0.9703975, 0.726358, 0.6290065 ,
0.3999679, 0.4043968, 0.3138257, 0.2232945, 0.2498679, 0.3300675, 0.4323964, 0.7999234, 1.1668827, 0.7977234, 0.5038257, 0.4043968,
0.782, 0.893, 1.004, 1.116, 1.782, 3.671, 4.782, 4.227, 2.004, 1.227, 1.004, 0.893,
0.782, 0.893, 1.004, 1.116, 1.782, 3.671, 4.782, 4.227, 2.004, 1.227, 1.004, 0.893,
0.001, 0.001, 0.001, 0.001, 0.001, 0.001, 0.001, 0.001, 0.001, 0.001, 0.001, 0.001 ,
1.2867143, 1.3945997, 1.5506977, 1.7727263, 2.5190228, 4.1367678, 5.0212291, 4.5795799, 2.8484358, 1.8856229, 1.5178736, 1.3656797
),
ncol =14, nrow=12)
nlc = length(lc)
ny = length(years)
t=seq(as.Date(paste0(years[1]-1, '-12-31')),
as.Date(paste0(years[ny], '-12-31')), by=1)
t1=apply.monthly( t, FUN=first)
time = time(t1) + 1;
for (i in 1:nlc){
ilc= lc[i]
lai = lc_EQ(laitbl, ilc)
rl = lc_EQ (rltbl, ilc)
if (i ==1){
mlai = lai;
mrl = rl;
}else{
mlai = cbind(mlai, lai)
mrl = cbind(mrl, rl)
}
}
ts.lai = as.xts(rbind(rep.row(mlai, ny), mlai[1,]), order.by =time)
ts.rl = as.xts(rbind(rep.row(mrl, ny), mrl[1,]), order.by =time)
colnames(ts.lai) = paste(lc)
colnames(ts.rl) = paste(lc)
ret = list(LAI = ts.lai, RL=ts.rl, nLAI=nlc)
return(ret)
}
fun.vegtable <- function (lc){
dveg=matrix(c(
#SHDFAC,DROOT,RS,RGL,HS,SNUP,LAIMIN,LAIMAX,EMISMIN,EMISMAX,ALBMIN,ALBMAX,Z0MIN,Z0MAX,ROUGH,DegrdationRate,
0.00000 ,0.60000 ,100.00000 ,30.00000 ,51.75000 ,0.01000 ,0.01000 ,0.00000 ,0.98000 ,0.98000 ,0.08000 ,0.13500 ,0.00010 ,0.00010 ,0.10000 ,0.00000 ,#Water ,
0.80000 ,0.60000 ,125.00000 ,30.00000 ,47.35000 ,0.08000 ,5.00000 ,10.76000 ,0.95000 ,0.95000 ,0.12000 ,0.18200 ,0.50000 ,0.50000 ,0.32000 ,0.00000 ,#Evergreen Needleleaf ,
0.90000 ,0.60000 ,150.00000 ,96.07728 ,41.69000 ,0.08000 ,3.08000 ,5.11700 ,0.95000 ,0.95000 ,0.12000 ,0.21300 ,0.50000 ,0.50000 ,0.32000 ,0.00000 ,#Evergreen Broadleaf ,
0.80000 ,0.60000 ,150.00000 ,30.00000 ,47.35000 ,0.08000 ,1.00000 ,10.76000 ,0.93000 ,0.94000 ,0.14000 ,0.18200 ,0.50000 ,0.50000 ,0.36000 ,0.00000 ,#Deciduous Needleleaf ,
0.80000 ,0.60000 ,100.00000 ,72.00234 ,54.53000 ,0.08000 ,1.85000 ,7.17300 ,0.93000 ,0.93000 ,0.16000 ,0.23600 ,0.50000 ,0.50000 ,0.36000 ,0.00000 ,#Deciduous Broadleaf ,
0.79500 ,0.60000 ,125.00000 ,52.56440 ,51.93000 ,0.08000 ,2.80000 ,8.83300 ,0.93000 ,0.97000 ,0.17000 ,0.20250 ,0.20000 ,0.50000 ,0.40000 ,0.00000 ,#Mixed Forest ,
0.79986 ,0.60000 ,173.51021 ,55.99480 ,999.00000 ,999.00000 ,999.00000 ,8.54004 ,999.00000 ,999.00000 ,0.00000 ,0.21129 ,999.00000 ,999.00000 ,0.35000 ,0.00000 ,#Woodland ,
0.80184 ,0.40000 ,300.00000 ,82.93310 ,42.00000 ,0.03000 ,0.50000 ,3.66000 ,0.93000 ,0.93000 ,0.25000 ,0.25245 ,0.01000 ,0.05000 ,0.40000 ,0.00000 ,#Wooded Grassland ,
0.62501 ,0.40000 ,300.00000 ,126.09371 ,42.00000 ,0.03000 ,0.50000 ,3.66000 ,0.93000 ,0.93000 ,0.25000 ,0.24959 ,0.01000 ,0.05000 ,0.30000 ,0.00000 ,#Closed Shrubland ,
0.21818 ,0.40000 ,170.00000 ,142.33158 ,39.18000 ,0.03500 ,0.60000 ,2.60000 ,0.93000 ,0.95000 ,0.22000 ,0.26652 ,0.01000 ,0.06000 ,0.25000 ,0.00000 ,#Open Shrubland ,
0.72552 ,0.40000 ,40.00000 ,100.00000 ,36.35000 ,0.04000 ,0.52000 ,2.90000 ,0.92000 ,0.96000 ,0.19000 ,0.28802 ,0.10000 ,0.12000 ,0.10000 ,0.05000 ,#Grassland ,
0.83537 ,0.40000 ,40.00000 ,100.00000 ,36.25000 ,0.04000 ,1.56000 ,4.78200 ,0.92000 ,0.98500 ,0.17000 ,0.24992 ,0.05000 ,0.15000 ,0.20000 ,0.50000 ,#Cropland ,
0.07489 ,0.05000 ,174.99974 ,155.98361 ,999.00000 ,0.02000 ,0.00100 ,0.00100 ,0.90000 ,0.90000 ,0.38000 ,0.38000 ,0.01000 ,0.01000 ,0.02000 ,0.30000 ,#Bare Ground ,
0.10000 ,0.05000 ,200.00000 ,97.19872 ,999.00000 ,0.04000 ,0.00100 ,0.00100 ,0.88000 ,0.88000 ,0.15000 ,0.24650 ,0.50000 ,0.50000 ,0.02000 ,0.90000 #Urban and Build ,
), ncol=14, nrow= 16)
nlc = length(lc)
for (i in 1:nlc){
ilc= lc[i]
iveg = lc_EQ(dveg, ilc)
if (i ==1){
mveg = matrix(iveg, ncol=1);
}else{
mveg = cbind(mveg, iveg)
}
}
imp = rep(0,nlc)
imp[which(lc == 20) ]= 0.10 #
imp[which(lc == 21) ]= 0.15#
imp[which(lc == 22) ]= 0.35#
imp[which(lc == 23) ]= 0.65#
imp[which(lc == 24) ]= 0.95#
rnames = c('INDEX','SHDFAC','DROOT','RS','RGL','HS',
'SNUP','LAIMIN','LAIMAX','EMISMIN','EMISMAX',
'ALBMIN','ALBMAX','Z0MIN','Z0MAX','ROUGH',
'DgRate', 'ImpA')
mveg=rbind(rbind(1:nlc, mveg), imp)
rownames(mveg) = rnames
colnames(mveg) = paste(lc)
m= matrix(c( 298.0, 0.5, 5000.0, 16.0, 14.0), ncol=1, nrow= 5)
rownames(m) =c( 'TOPT_DATA','CFACTR_DATA','RSMAX_DATA','BARE','NATURAL')
ret = list(TBL = t(mveg), Misc = m)
return(ret)
}
lc_EQ <-function(dtab, lc){
tab = matrix(c( #0, 0.00, 0, 0.00, #00
0 , 0 , 0 , 0 , # 1 0
0 , 0 , 0 , 0 , # 2 0
0 , 0 , 0 , 0 , # 3 0
0 , 0 , 0 , 0 , # 4 0
0 , 0 , 0 , 0 , # 5 0
0 , 0 , 0 , 0 , # 6 0
0 , 0 , 0 , 0 , # 7 0
0 , 0 , 0 , 0 , # 8 0
0 , 0 , 0 , 0 , # 9 0
0 , 1 , 0 , 0 , # 10 1
0 , 0.9 , 6 , 0.1 , # 11 1 Open Water
0 , 0.9 , 6 , 0.1 , # 12 1 Perennial Ice/Snow
0 , 0 , 0 , 0 , # 13 0
0 , 0 , 0 , 0 , # 14 0
0 , 0 , 0 , 0 , # 15 0
0 , 0 , 0 , 0 , # 16 0
0 , 0 , 0 , 0 , # 17 0
0 , 0 , 0 , 0 , # 18 0
0 , 0 , 0 , 0 , # 19 0
13 , 0.65 , 0 , 0 , # 20 1
13 , 0.2 , 10 , 0.8 , # 21 1 Developed, Open Space
13 , 0.35 , 10 , 0.65 , # 22 1 Developed, Low Intensity
13 , 0.65 , 10 , 0.35 , # 23 1 Developed, Medium Intensity
13 , 0.9 , 10 , 0.1 , # 24 1 Developed High Intensity
0 , 0 , 0 , 0 , # 25 0
0 , 0 , 0 , 0 , # 26 0
0 , 0 , 0 , 0 , # 27 0
0 , 0 , 0 , 0 , # 28 0
0 , 0 , 0 , 0 , # 29 0
12 , 1 , 0 , 0 , # 30 1
12 , 0.92 , 9 , 0.08 , # 31 1 Barren Land (Rock/Sand/Clay)
12 , 1 , 9 , 0 , # 32 1
0 , 0 , 0 , 0 , # 33 0
0 , 0 , 0 , 0 , # 34 0
0 , 0 , 0 , 0 , # 35 0
0 , 0 , 0 , 0 , # 36 0
0 , 0 , 0 , 0 , # 37 0
0 , 0 , 0 , 0 , # 38 0
0 , 0 , 0 , 0 , # 39 0
6 , 0.65 , 0 , 0 , # 40 1
4 , 0.6 , 10 , 0.4 , # 41 1 Deciduous Forest
2 , 0.6 , 10 , 0.4 , # 42 1 Evergreen Forest
5 , 0.6 , 10 , 0.4 , # 43 1 Mixed Forest
0 , 0 , 0 , 0 , # 44 0
0 , 0 , 0 , 0 , # 45 0
0 , 0 , 0 , 0 , # 46 0
0 , 0 , 0 , 0 , # 47 0
0 , 0 , 0 , 0 , # 48 0
0 , 0 , 0 , 0 , # 49 0
8 , 1 , 0 , 0 , # 50 1
9 , 0.4 , 10 , 0.6 , # 51 1 Dwarf Scrub
8 , 0.6 , 10 , 0.4 , # 52 1 Shrub/Scrub
0 , 0 , 0 , 0 , # 53 0
0 , 0 , 0 , 0 , # 54 0
0 , 0 , 0 , 0 , # 55 0
0 , 0 , 0 , 0 , # 56 0
0 , 0 , 0 , 0 , # 57 0
0 , 0 , 0 , 0 , # 58 0
0 , 0 , 0 , 0 , # 59 0
0 , 0 , 0 , 0 , # 60 0
0 , 0 , 0 , 0 , # 61 0
0 , 0 , 0 , 0 , # 62 0
0 , 0 , 0 , 0 , # 63 0
0 , 0 , 0 , 0 , # 64 0
0 , 0 , 0 , 0 , # 65 0
0 , 0 , 0 , 0 , # 66 0
0 , 0 , 0 , 0 , # 67 0
0 , 0 , 0 , 0 , # 68 0
0 , 0 , 0 , 0 , # 69 0
10 , 0.85 , 0 , 0 , # 70 1
10 , 0.9 , 12 , 0.1 , # 71 1 Grassland/Herbaceous
10 , 0.9 , 12 , 0.1 , # 72 1 Sedge/Herbaceous
10 , 0.9 , 12 , 0.1 , # 73 1 Lichens
10 , 0.9 , 12 , 0.1 , # 74 1 Moss
0 , 0 , 0 , 0 , # 75 0
0 , 0 , 0 , 0 , # 76 0
0 , 0 , 0 , 0 , # 77 0
0 , 0 , 0 , 0 , # 78 0
0 , 0 , 0 , 0 , # 79 0
10 , 0.9 , 0 , 0 , # 80 1
11 , 0.6 , 10 , 0.4 , # 81 1 Pasture/Hay
11 , 0.9 , 12 , 0.1 , # 82 1 Cultivated Crops
0 , 0 , 0 , 0 , # 83 0
0 , 0 , 0 , 0 , # 84 0
0 , 0 , 0 , 0 , # 85 0
0 , 0 , 0 , 0 , # 86 0
0 , 0 , 0 , 0 , # 87 0
0 , 0 , 0 , 0 , # 88 0
0 , 0 , 0 , 0 , # 89 0
8 , 0.6 , 0 , 0.4 , # 90 1 Woody Wetlands
6 , 0.6 , 0 , 0 , # 91 1
7 , 0.6 , 0 , 0 , # 92 1
6 , 0.6 , 0 , 0 , # 93 1
7 , 0.6 , 0 , 0 , # 94 1
10 , 0.8 , 0 , 0.2 , # 95 1 Emergent Herbaceous Wetlands
10 , 0.8 , 2 , 0.2 , # 96 1
10 , 0.8 , 4 , 0.2 , # 97 1
10 , 0.2 , 0 , 0.8 , # 98 1
10 , 0.2 , 0 , 0.8 ) # 99 1
, ncol=99, nrow=4)
c1= tab[2, lc]
v1 = dtab[, tab[1, lc]+1 ]
c2 = tab[4, lc]
v2 = dtab[, tab[3,lc]+1 ]
ret = c1 * v1 + c2 * v2;
return(ret)
}
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Embedding an R snippet on your website
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.