PIHM.AnalysisR:

#' PIHM Analysis project.
#' Developed by Lele Shu( lele.shu at gmail.com  lzs157 at psu.edu ) 
#' Created by Wed Apr 15 20:25:45 EDT 2015
#'  Current version is for PIHM-MF or PIHM v2.4} ,
#'

cfun <- function (x,tab, type=1) {
#Source: http://www.pihm.psu.edu/EstimationofVegitationParameters.htm
dlai=rbind(c( 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0),
c(   8.76,  9.16,  9.827,  10.093,  10.36,  10.76,  10.493,  10.227,  10.093,  9.827,  9.16,  8.76),
c(   5.117,  5.117,  5.117,  5.117,  5.117,  5.117,  5.117,  5.117,  5.117,  5.117,  5.117,  5.117),
c(    8.76,  9.16,  9.827,  10.093,  10.36,  10.76,  10.493,  10.227,  10.093,  9.827,  9.16,  8.76),
c(    0.52,  0.52,  0.867,  2.107,  4.507,  6.773,  7.173,  6.507,  5.04,  2.173,  0.867,  0.52),
c(    4.64,  4.84,  5.347,  6.1,  7.4335,  8.7665,  8.833,  8.367,  7.5665,  6,  5.0135,  4.64),
c(    5.276088,  5.528588,  6.006132,  6.4425972,  7.2448806,  8.3639474,  8.540044,  8.126544,  7.2533006,  6.3291908,  5.6258086,  5.300508),
c(   2.3331824,  2.4821116,  2.7266101,  3.0330155,  3.8849492,  5.5212224,  6.2395131,  5.7733017,  4.1556703,  3.1274641,  2.6180116,  2.4039116 ),
c(   0.580555,  0.6290065,  0.628558,  0.628546,  0.919255,  1.7685454,  2.5506969,  2.5535975,  1.7286418,  0.9703975,  0.726358,  0.6290065 ),
c(    0.3999679,  0.4043968,  0.3138257,  0.2232945,  0.2498679,  0.3300675,  0.4323964,  0.7999234,  1.1668827,  0.7977234,  0.5038257,  0.4043968),
c(    0.782,  0.893,  1.004,  1.116,  1.782,  3.671,  4.782,  4.227,  2.004,  1.227,  1.004,  0.893),
c(    0.782,  0.893,  1.004,  1.116,  1.782,  3.671,  4.782,  4.227,  2.004,  1.227,  1.004,  0.893),
c(   0.001,  0.001,  0.001,  0.001,  0.001,  0.001,  0.001,  0.001,  0.001,  0.001,  0.001,  0.001 ),
c(    1.2867143,  1.3945997,  1.5506977,  1.7727263,  2.5190228,  4.1367678,  5.0212291,  4.5795799,  2.8484358,  1.8856229,  1.5178736,  1.3656797)
 );
drl=rbind(c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0),
c(	1.112, 1.103, 1.088, 1.082, 1.076, 1.068, 1.073, 1.079, 1.082, 1.088, 1.103, 1.112),
c(	2.653, 2.653, 2.653, 2.653, 2.653, 2.653, 2.653, 2.653, 2.653, 2.653, 2.653, 2.653),
c(	1.112, 1.103, 1.088, 1.082, 1.076, 1.068, 1.073, 1.079, 1.082, 1.088, 1.103, 1.112),
c(	0.52, 0.52, 0.666, 0.91, 1.031, 1.044, 1.042, 1.037, 1.036, 0.917, 0.666, 0.52),
c(	0.816, 0.8115, 0.877, 0.996, 1.0535, 1.056, 1.0575, 1.058, 1.059, 1.0025, 0.8845, 0.816),
c(	0.7602524, 0.7551426, 0.7772204, 0.8250124, 0.846955, 0.8449668, 0.8471342, 0.8496604, 0.8514252, 0.8299022, 0.7857734, 0.7602744),
c(	0.35090494, 0.34920916, 0.36891486, 0.40567288, 0.42336056, 0.42338372, 0.42328378, 0.42485112, 0.42631836, 0.40881268, 0.37218526, 0.35096866),
c(	0.05641527, 0.05645892, 0.05557872, 0.05430207, 0.05425842, 0.05399002, 0.05361482, 0.0572041, 0.05892068, 0.05821407, 0.05709462, 0.05645892),
c(	0.03699235, 0.03699634, 0.03528634, 0.03272533, 0.03272134, 0.03270066, 0.03268178, 0.03907616, 0.04149324, 0.04032533, 0.03823134, 0.03699634),
c(	0.0777, 0.0778, 0.0778, 0.0779, 0.0778, 0.0771, 0.0759, 0.0766, 0.0778, 0.0779, 0.0778, 0.0778),
c(	0.0777, 0.0778, 0.0778, 0.0779, 0.0778, 0.0771, 0.0759, 0.0766, 0.0778, 0.0779, 0.0778, 0.0778),
c(	0.0112, 0.0112, 0.0112, 0.0112, 0.0112, 0.0112, 0.0112, 0.0112, 0.0112, 0.0112, 0.0112, 0.0112),
c(	0.1947138, 0.19413424, 0.20831414, 0.23348558, 0.24574614, 0.24605016, 0.24538258, 0.24630454, 0.247455, 0.23527388, 0.20963734, 0.19478494)
	 );
if(missing('tab') ){     #undefined table, use the default table.
    tab=switch(type,'lai'=dlai, 'rl'=drl)
}
switch(as.character(x),
#0 ? Water    
    '11' = {       tmp=.9*tab[1,]+.1*tab[7,]	} ,	
    '12' = {       tmp=.8*tab[1,]+.2*tab[7,]} ,
		    
#2 ? Evergreen Broadleaf forest
    '42' = {       tmp=.8*tab[3,]+.4*tab[11,]} ,		
#4 ? Deciduous Broadleaf forest
    '41' = {       tmp=.6*tab[5,]+.4*tab[11,]} ,		
#5 ? Mixed Cover
    '43' = {       tmp=.6*tab[6,]+.4*tab[11,]} , 
#6 ? Woodland    
    '40' = {       tmp=0.65*tab[7,]} ,	#40 ? Forested Upland (0.65 x C6)	
    '91' = {	    tmp=0.6*tab[7,]} ,
    '93' = {	    tmp=0.6*tab[7,]} ,			
#7 ? Wooded Grassland 
    '92' = {	    tmp=0.6*tab[8,]} ,	
    '94' = {	    tmp=0.6*tab[8,]} ,			
#Closed shrub land  
    '50' = { tmp=tab[9,]} ,			
    '52' = { tmp=0.6*tab[9,]} ,			
    '90' = { tmp=0.6*tab[9,]+0.4*tab[13,]} ,			
#Open Shrub land    
    '51' = { tmp=0.6*tab[10,]} ,			
    '95' = { tmp=0.6*tab[10,]+0.4*tab[13,]} ,			
#Grassland    
    '70' = { tmp=0.85*tab[11,]} ,			
   '71' = { tmp=0.9*tab[11,]} ,			
   '73' = { tmp=0.9*tab[11,]} ,			
   '74' = { tmp=0.9*tab[11,]} ,			
   '80' = { tmp=0.9*tab[11,]} ,			
    '96' = { tmp=0.8*tab[11,]+0.2*tab[3,]} ,			
    '97' = { tmp=0.8*tab[11,]+0.2*tab[5,]} ,			
    '98' = { tmp=(0.2*tab[11,])} ,	
    '99' = { tmp=(0.2*tab[11,])} ,	
#crop land        
    '81' = { tmp=0.6*tab[12,]} ,			
    '82' = { tmp=0.6*tab[12,]} ,			
#Bare Ground
    '32' = { tmp=tab[13,]} ,			
    '30' = { tmp=tab[13,]} ,			
    '31' = { tmp=0.92*tab[13,]+0.08*tab[10,]} ,			
    '20' = { tmp=0.65*tab[14,]} ,		
#Urban & built up        
    '21' = { tmp=0.9*tab[14,]+0.1*tab[11,]} ,		
    '22' = { tmp=0.35*tab[14,]+0.65*tab[11,]} ,		
    '23' = { tmp=0.65*tab[14,]+0.35*tab[11,]} ,		
    '24' = { tmp=0.9*tab[14,]+0.1*tab[11,]} ,		
    'otherwise' = {
        warning('Warning: LC code is unknown') 
		    tmp=tab[1,]
    }
)	#end of Switch				 
return(tmp)
}