package MpmasDemography;

use strict;
use warnings;
use Exporter;
use Storable qw(dclone);
use Data::Dumper;
use CtUtilities qw(queryhash extqueryhash);
use MpmasInputfile;
use MpmasInputBlock;
our @ISA = qw(MpmasInputfile);

	my %desc_switching = (
	 0 => "Career of descendants",
	 1 => "New career after marriage",
	 2 => "Career of partner",
	 3 => "New career after becoming household head",
	 4 => "New career after partner became household head",
	 5 => "New career after retiring" ,
	 6 => "New career after giving birth" 
	);

	my @desc_career_info = (
		"leavingWithPartner", #"formNewHouseholdWhenLeaving", 
		"switchHeadToPartnerIfMarried",
		"marryReqBoth", "leaveReqBoth", "retireReqBoth",
		"giveBirthReqBoth", "switchReqBoth", "dieReqBoth"
	);

sub filename {
	my $self = shift;
	return "Pop".$self->file_suffix;
}

sub required {
	my $self = shift;
	return 1;
}
sub prepare_shared {
	

}
sub prepare_special {
	my $self = shift;
	#my $demohash = shift;
	#my $LBGcount = shift;
	#my $refHHNutrients = shift;
	#my @HHNutrients = @$refHHNutrients;
	my $curPop = $self->argument;
	my $demography = $self->config_entry("CONVERTED_DEMOTAB");
	# Columns of HOUSEHOLD DYNAMICS (== CONVERTED_DEMOTAB):
	# Both demography models:
	# pop career upperyear labgrp labprov mortality fertility 
	# Demography model 1 : p_marriage p_leave p_retire priority_hh mincons
	# Advanced consumption model: energy, other nutrients, ...

	# pop orig_career cause new_career probability
	my $household_switching = $self->config_entry("CONVERTED_HOUSEHOLD_SWITCHING");
	
	my $household_switching2;
	my $career_info_tab;
	if ($self->config_entry("DEMOGRAPHY_MODEL") >= 2 ) {
		$household_switching2 = $self->config_entry("CONVERTED_HOUSEHOLD_SWITCHING_UDEF");
		$career_info_tab = $self->config_entry("CONVERTED_HOUSEHOLD_CAREER_INFO");
	}

	my $succession_control = $self->config_entry("CONVERTED_SUCCESSION_CONTROL");
	# pop control_variable value
	my $invhorizon = $self->config_entry("CONVERTED_INVESTMENT_HORIZON");

	my $invhorizonconstraints = $self->config_entry("CONVERTED_INVESTMENT_HORIZON_CONSTRAINTS");
	# [popID, lowerbound], constraint identifier, rhsvalue
	my $extraIncBalance = $self->config_entry("CONVERTED_SUC_INCOME_BALANCE");
	my $migrationInfo = $self->config_entry("CONVERTED_MIGRATION");



	my $LBGcount = $self->config_entry("LBGcount");
	my @HHNutrients = ();
	if  ($self->config_entry("CONSTYPE") == 1) {
		@HHNutrients = $self->get_cfg_list("HHNUTRIENTS");
	}
	my @ExtraChars = $self->get_cfg_list_empty_ok("EXTRA_HHMEMBER_CHARACTERISTICS");

	
	my $demotabs = MpmasInputBlock->new(2,30);	
	my $CareerCount = 0;			
	
	my @sorted_careers = sort { $self->config_entry("CAREERS")->{$a}<=>$self->config_entry("CAREERS")->{$b} } $demography->query([$curPop],0);
	for my $curCareer (@sorted_careers) {
		$CareerCount++;
		my @ctabs;
		my @ylist = sort { $a<=>$b } $demography->query([$curPop, $curCareer],0);
		#for my $i (0..$#ylist) {
		#	$ylist[$i] =~ s/^x//;
		#}
		#@ylist = sort{$a  <=> $b } @ylist;
		my $L = $#ylist;
		my $lasty = $ylist[$L];
		
		my $curE = 0;
		$demotabs->add_row("$curCareer");
		$demotabs->add_row("","Career ID",$self->config_entry("CAREERS")->{$curCareer});
		$demotabs->add_row("","Number of different ages", $lasty+1, $self->delim("#END_CAREERHEAD"));
		my @temp;
		$temp[1] = "Age";
		for my $y (0..$lasty){
			$temp[2+$y] = $y;
		}
		$demotabs->add_comment_row(@temp);
		$ctabs[0][1] = "Labour span";
		$ctabs[1][1] = "Labour provision per year";
		$ctabs[2][1] = "Mortality";
		$ctabs[3][1] = "Fertility";
		my $firstnutrient = 4;
		if ($self->config_entry("DEMOGRAPHY_MODEL") >= 1 ) {
			$ctabs[4][1] = "Prob. of marriage / finding a partner";
			$ctabs[5][1] = "Prob. of leaving household";
			$ctabs[6][1] = "Prob. of (attempting to) retire";
			$ctabs[7][1] = "Priority in succession if household head";
			$ctabs[8][1] = "Minimum consumption";
			$ctabs[9][1] = "Opportunity wage";
			$firstnutrient = 10; 
			if ($self->config_entry("DEMOGRAPHY_MODEL") >= 2 ) {
				$ctabs[10][1] = "Prob. leaving with mother";	
				$ctabs[11][1] = "Prob. leaving with father";	
				$firstnutrient = 12; 
			}
		}
		if ($self->config_entry("CONSTYPE") == 1 ) {
			for my $nut (0.. $#HHNutrients) {
				  $ctabs[$firstnutrient + $nut][1] = $HHNutrients[$nut]." requirement";
			}	
		}
		for my $u (0.. $#ExtraChars) {
			 $ctabs[$firstnutrient +   (scalar @HHNutrients) + $u][1] = $ExtraChars[$u];
			my $ur = $firstnutrient + $u + 4 +  (scalar@HHNutrients) ;
			my $urname = $demography->get_name_of_column($ur );

			unless($demography->exists_columnname($ExtraChars[$u])) {
				print STDERR "Warning: Column name '". $ExtraChars[$u]."' not found in HOUSEHOLD_DYNAMICS. Column $ur is named $urname. Ignoring inconsistent". 
				" naming and proceeding.\nCheck consistency of HOUSEHOLD_DYNAMICS and EXTRA_HHMEMBER_CHARACTERISTICS\n" ;
			}
			else {
				my $cn = $demography->column_by_name($ExtraChars[$u]);
				print STDERR "Error: Column $ur of table HOUSEHOLD_DYNAMICS is named $urname not ". $ExtraChars[$u] .   
					" as expected, but column $cn is!\nCheck consistency of HOUSEHOLD_DYNAMICS and EXTRA_HHMEMBER_CHARACTERISTICS\n" and exit(1) unless($cn == $ur);
			}
		}	
		for my $y (0..$lasty){
			my $curY = $ylist[$curE];
			my $h = $demography->query([$curPop,$curCareer, $curY],4);
			my $lg = $self->config_entry("LABGRPS")->{$h}->{lid};
			print STDERR "Error in demography table: Career $curCareer provides labour of labour group $h,\n but no endowment constraint for such a group has been defined!\nCheck the labgrp fields of your labour endowment constraints.\n" and exit(1) unless (defined $lg);
			$ctabs[0]->[$y+2] = $lg; 
			for my $f (1.. ($firstnutrient - 1) ) {
				$ctabs[$f]->[$y+2] = $demography->query([$curPop,$curCareer, $curY],4 + $f) || 0;
			}
			if ($self->config_entry("CONSTYPE") == 1 ) {
				for my $f ($firstnutrient..$firstnutrient + $#HHNutrients) {
					my $nr = $demography->query([$curPop,$curCareer, $curY],4 + $f); 
					$nr = 0 unless (defined $nr);
					$ctabs[$f]->[$y+2] = $nr;
				}
			}
			
			for my $u ( 0 .. $#ExtraChars  ) {
				my $ur = $firstnutrient + (scalar @HHNutrients) + $u ;
				

				my $nr = $demography->query([$curPop,$curCareer, $curY], $ur + 4); 
				$nr = 0 unless (defined $nr);
				$ctabs[$ur]->[$y+2] = $nr;
			}
			if (defined $demography->query([$curPop,$curCareer, $y],4)){
				$curE += 1;
			}
		}

		$ctabs[0][$lasty+3] = $self->delim("#END_LABGROUP");
		$ctabs[1][$lasty+3] = $self->delim("#END_LABHOURS");
		$ctabs[2][$lasty+3] = $self->delim("#END_MORTALITY");
		$ctabs[3][$lasty+3] = $self->delim("#END_FERTILITY");

		if ($self->config_entry("DEMOGRAPHY_MODEL") >= 1 ) {
			$ctabs[4][$lasty+3] = $self->delim("#END_PROBMARRY");
			$ctabs[5][$lasty+3] = $self->delim("#END_PROBLEAVE");
			$ctabs[6][$lasty+3] = $self->delim("#END_PROBRETIRE");
			$ctabs[7][$lasty+3] = $self->delim("#END_PRIORITY");
			$ctabs[8][$lasty+3] = $self->delim("#END_MINCONS");
			$ctabs[9][$lasty+3] = $self->delim("#END_OPPWAGE");
			
			if ($self->config_entry("DEMOGRAPHY_MODEL") >= 2 ) {
				$ctabs[11][$lasty+3] = $self->delim("#END_LEAVING_WITH_PARENTS");	
			}
		}
		if ($self->config_entry("CONSTYPE") == 1 ) {
				  $ctabs[$firstnutrient + $#HHNutrients][$lasty+3] = $self->delim("#END_NUTRIENT");
		}
		$ctabs[$firstnutrient +  (scalar @HHNutrients) +  $#ExtraChars ][$lasty+3] = $self->delim("#END_USERDEF") if (scalar @ExtraChars);
		
		push @ctabs, [()];
		push @ctabs, [()];
		$demotabs->add_table(\@ctabs);

		if ($self->config_entry("DEMOGRAPHY_MODEL") >= 1 ) {
			$demotabs->add_comment_row("","Spawning and switching probabilities", @sorted_careers);

		#Switching/descendant probabilities
			for my $c (sort {$a <=> $b} keys %desc_switching) {
				last if ($c >= 6 and $self->config_entry("DEMOGRAPHY_MODEL") == 1 ) ;#only for first version of advanced demography model
				my %temp;
				my @row = ("", $desc_switching{$c});
				my $rsum = 0;
				for my $s (@sorted_careers) {
					my $p = $household_switching->query([$curPop, $curCareer, $c, $s], 5);
					$p = 0 unless (defined $p);
					$temp{$s} = $p;
					$rsum += $p unless ($s eq $curCareer); #Remaining in career is calculated as remainder of switching probabilities, any given entry is ignored!!!
				}
				print STDERR "Error in HOUSEHOLD_SWITCHING [MPMAS TABLES]: Sum of probabilities for " . $desc_switching{$c} . " for career $curCareer is larger than 1\n" and exit(1) if ($rsum > 1);
				print STDERR "Error in HOUSEHOLD_SWITCHING [MPMAS TABLES]: Sum of probabilities for " . $desc_switching{$c} . " for career $curCareer is smaller than 0\n" and exit(1) if ($rsum < 0);
				$temp{$curCareer} = 1 - $rsum;#Remaining in career is calculated as remainder of switching probabilities to other careers
				for my $s (@sorted_careers) {
				    push @row, $temp{$s};
				}
				$demotabs->add_row(@row);
			}
			$demotabs->add_row("","",$self->delim("#END_SWITCHING"));
		}
		$demotabs->add_empty_rows(3);
		if ($self->config_entry("DEMOGRAPHY_MODEL") >= 2 ) {
			$demotabs->add_comment_row("","User-defined spawning and switching probabilities");
			if (defined $household_switching2 and  $household_switching2->query([$curPop, $curCareer], 0)  )  {
				
				my  @newCareers	 = sort { $a cmp $b } $household_switching2->query([$curPop, $curCareer], 0);
				$demotabs->add_row("","Number of careers that can be switched to", scalar @newCareers);
				$demotabs->add_row("","Careers:", map {$self->config_entry("CAREERS")->{$_}} @newCareers);
				for my $nc ( @newCareers) {
					my @row = ("", "Probability of switching to career $nc");
					my $yInfoCol = 0;
					for my $y (0..$lasty){
						++$yInfoCol if ($y > $yInfoCol);
						while( not defined  $household_switching2->query([$curPop, $curCareer, $nc, $yInfoCol], 5) and $yInfoCol <= $lasty) {
							++$yInfoCol;
						}
						if ($yInfoCol > $lasty) {
							push @row, 0;
						}
						else {
							push @row, $household_switching2->query([$curPop, $curCareer, $nc, $yInfoCol], 5);
						}
						 
					}
					$demotabs->add_row(@row);	
				}
			}
			else {
				$demotabs->add_row("","Number of careers that can be switched to",0);
			}
			$demotabs->add_row("","",$self->delim("#END_SWITCHING_UDEF"));
		}
		$demotabs->add_empty_rows(3);
		if ($self->config_entry("DEMOGRAPHY_MODEL") >= 2 ) {
			for my $item (@desc_career_info) {
					my $value = 0;
					if (defined $career_info_tab) {
						$value = $career_info_tab->query([$curPop, $curCareer, $item], 4);
					}
					$value = 0 unless (defined $value);
					$demotabs->add_row("",$item, $value );
			}
			$demotabs->add_row("","",$self->delim("#END_CAREER_INFO_2"));
			$demotabs->add_empty_rows(3);
		}
	}
	
	$self->add_block($demotabs);
	
	my $demohead = MpmasInputBlock->new(2,10);
	$demohead->add_row("THE DEMOGRAPHY FILE");
	$demohead->add_row("1","HOUSEHOLD MEMBER COURSE OF LIFE");
	$demohead->add_row("1.1","Number of different member categories", $CareerCount);
	$demohead->add_row("1.2","Number of different labor groups", $LBGcount );
	$demohead->add_row("1.3","Number of extra household member characteristics", scalar @ExtraChars  ) if (scalar(@ExtraChars) > 0);
	$demohead->add_row("1.4","School Age", $self->config_entry("SCHOOLAGE") || 0 );
	$demohead->add_row("1.5","Adult Age", $self->config_entry("ADULTAGE") || 0);
	$demohead->add_row("","",$self->delim("#END_HEAD"));
	$demohead->add_empty_rows(2);
	$self->add_block($demohead);
	

	my $migration = MpmasInputBlock->new(2,40);
	# first initialize hash with general settings from MPMAS PARAMETERS section
	my %financial;
	for my $c (qw(MIGRATIONPULL OPPWAGE RESELL)) {
	  $financial{$c} = $self->config_entry($c);
	}
	# then overwrite with population specific settings if they exist
	if (defined $migrationInfo) {
		for my $c ($migrationInfo->query([$curPop],0)) {
		  $financial{$c} = $migrationInfo->query([$curPop, $c]) if (defined $migrationInfo->query([$curPop, $c]));  
		}
	}
	
	$migration->add_row("2","Migration");
	$migration->add_row("","Migration pull factor",$financial{MIGRATIONPULL});
	$migration->add_row("","Opportunity wage of the household head", $financial{OPPWAGE});
	$migration->add_row("","Proportion of the capital (of investment goods) that can be recovered when exiting[0-1]", $financial{RESELL});
	$migration->add_row("","",$self->delim("#END_MIGRATION"));
	$migration->add_empty_rows(1);
	$self->add_block($migration);

	if ($self->config_entry("DEMOGRAPHY_MODEL") >= 1 ) {
		#hash containing settings for succesion control
		my %suc;
		# first initialize hash with general settings from MPMAS PARAMETERS section
		for my $c (qw(SUCCESSION_AD_MINCONS_FACTOR SUCCESSION_AD_MINIMUM_PROFIT SUCCESSION_AD_DECISION_ACTIVITY SUCCESSION_VR_MINCONS_FACTOR SUCCESSION_VR_MINIMUM_PROFIT SUCCESSION_VR_DECISION_ACTIVITY SUCCESSION_VR_MINIMUM_RENTAL SUCCESSION_OR_MINCONS_FACTOR SUCCESSION_OR_MINIMUM_PROFIT SUCCESSION_OR_DECISION_ACTIVITY INVESTMENT_HORIZON_MODEL INVESTMENT_HORIZON_PTHRESHOLD INVESTMENT_HORIZON_WHO INVESTMENT_HORIZON_AFFECT_LIFETIME INCOME_BALANCE_ROW RHS_MIN_CONS RHS_FIX_COST)) {
		  $suc{$c} = $self->config_entry($c);
		}
		# then overwrite with population specific settings if they exist
		if (defined $succession_control) {
		    for my $c ($succession_control->query([$curPop],0)) {
			  $suc{$c} = $succession_control->query([$curPop, $c]) if (defined $succession_control->query([$curPop, $c]));  
		    }
		}
		if (defined $invhorizon) {
		    for my $c ($invhorizon->query([$curPop],0)) {
			  $suc{$c} = $invhorizon->query([$curPop, $c]) if (defined $invhorizon->query([$curPop, $c]));  
		    }
		}
		if (defined $extraIncBalance) {
		    for my $c ($extraIncBalance->query([$curPop],0)) {
			  $suc{$c} = $extraIncBalance->query([$curPop, $c]) if (defined $extraIncBalance->query([$curPop, $c]));  
		    }
		}

		my $succession = MpmasInputBlock->new(2,50);
		$succession->add_empty_rows(2);
		$succession->add_row("3", "SUCCESSION OF HOUSEHOLD HEAD");
		$succession->add_empty_rows(1);		
		$succession->add_row("3.1","Succession if household head dies");
		$succession->add_empty_rows(1);		
		$succession->add_row("","Successors are identified and ranked according to their priority of becoming household head");
		$succession->add_row("","The  person with highest priority (i.e. lowest priority value) is the potential successor");
		$succession->add_row("","This person becomes the new household head if");
		$succession->add_empty_rows(1);		
		$succession->add_row("","-- the farm profit was higher than the combined minimum consumption of the household multiplied by the");
		$succession->add_row("3.1.1","rel. factor for minimum consumption for succession at death", $suc{SUCCESSION_AD_MINCONS_FACTOR});
		$succession->add_empty_rows(1);		
		$succession->add_row("","-- AND the farm income is higher than");
		$succession->add_row("3.1.2","the minimum profit for succession at death", $suc{SUCCESSION_AD_MINIMUM_PROFIT});
		$succession->add_empty_rows(1);		
		$succession->add_row("","-- AND there was a positive value in the LP solution for");
	  
		my $da = -1;

		if (defined $suc{SUCCESSION_AD_DECISION_ACTIVITY} and $suc{SUCCESSION_AD_DECISION_ACTIVITY} ne "-1" and $suc{SUCCESSION_AD_DECISION_ACTIVITY} ne "0" ) {
		    my $dao = $self->activity($suc{SUCCESSION_AD_DECISION_ACTIVITY});
		    if (defined $dao) {
			$da = $dao->lp_column ;
		    }
		    else {
			print STDERR "Error for SUCCESSION_AD_DECISION_ACTIVITY: Activity ". $suc{SUCCESSION_AD_DECISION_ACTIVITY} ."  has not been defined in the model\n" and exit(1);
		    }
		}
		$succession->add_row("3.1.3","the activity indicating potential succession at death", $da);
		$succession->add_row("","Otherwise the farm is shut down.");
		$succession->add_empty_rows(1);		
		$succession->add_row("3.2","Succession if household head attempts to retire");
		$succession->add_empty_rows(1);		
		$succession->add_row("","Successors are identified and ranked according to their priority of becoming household head");
		$succession->add_row("","The  person with highest priority (i.e. lowest priority value) is the potential successor");
		$succession->add_row("","This person becomes the new household head if");
		$succession->add_empty_rows(1);		
		$succession->add_row("","-- the farm profit was higher than the combined minimum consumption of the household multiplied by the");
		$succession->add_row("3.2.1","rel. factor for minimum consumption for succession at voluntary retirement", $suc{SUCCESSION_VR_MINCONS_FACTOR});
		$succession->add_empty_rows(1);		
		$succession->add_row("","-- AND the farm income is higher than");
		$succession->add_row("3.2.2","the minimum profit for succession at voluntary retirement", $suc{SUCCESSION_VR_MINIMUM_PROFIT});
		$succession->add_empty_rows(1);		
		$da = -1;
		if (defined $suc{SUCCESSION_VR_DECISION_ACTIVITY} and $suc{SUCCESSION_VR_DECISION_ACTIVITY} ne "-1" and $suc{SUCCESSION_VR_DECISION_ACTIVITY} ne "0" ) {
		    my $dao = $self->activity($suc{SUCCESSION_VR_DECISION_ACTIVITY});
		    if (defined $dao) {
			$da = $dao->lp_column ;
		    }
		    else {
			print STDERR "Error for SUCCESSION_VR_DECISION_ACTIVITY: Activity ". $suc{SUCCESSION_VR_DECISION_ACTIVITY} ."  has not been defined in the model\n" and exit(1);
		    }
		}
		$succession->add_row("","-- AND there was a positive value in the LP solution for");
		$succession->add_row("3.2.3","the activity indicating potential succession at voluntary retirement", $da);
		$succession->add_empty_rows(1);		
		$succession->add_row("","If no potential successor is available, the farmer checks the expected payments for hiring out his land and selling his assets.");
		$succession->add_row("","He will rent out all his land and shut down the farm,"); 
		$succession->add_row("","if the sum of rental payments and resale revenue annualized of the rest of his lifetime is higher than");
		$succession->add_row("3.2.4","the minimum rental earnings for voluntary shutdown", $suc{SUCCESSION_VR_MINIMUM_RENTAL});
		$succession->add_empty_rows(1);		
		$succession->add_row("","Otherwise he will not retire.");
		$succession->add_empty_rows(2);		
		$succession->add_row("3.3","Succession if household head is required to retire");
		$succession->add_empty_rows(1);		
		$succession->add_row("","Successors are identified and ranked according to their priority of becoming household head");
		$succession->add_row("","The  person with highest priority (i.e. lowest priority value) is the potential successor");
		$succession->add_row("","This person becomes the new household head if");
		$succession->add_empty_rows(1);		
		$succession->add_row("","-- the farm profit was higher than the combined minimum consumption of the household multiplied by the");
		$succession->add_row("3.3.1","rel. factor for minimum consumption for succession at voluntary retirement", $suc{SUCCESSION_OR_MINCONS_FACTOR});
		$succession->add_empty_rows(1);		
		$succession->add_row("","-- AND the farm income is higher than");
		$succession->add_row("3.3.2","the minimum profit for succession at voluntary retirement", $suc{SUCCESSION_OR_MINIMUM_PROFIT});
		$succession->add_empty_rows(1);		
		$da = -1;
		if (defined $suc{SUCCESSION_OR_DECISION_ACTIVITY} and $suc{SUCCESSION_OR_DECISION_ACTIVITY} ne "-1" and $suc{SUCCESSION_OR_DECISION_ACTIVITY} ne "0" ) {
		    my $dao = $self->activity($suc{SUCCESSION_OR_DECISION_ACTIVITY});
		    if (defined $dao) {
			$da = $dao->lp_column ;
		    }
		    else {
			print STDERR "Error for SUCCESSION_OR_DECISION_ACTIVITY: Activity ". $suc{SUCCESSION_OR_DECISION_ACTIVITY} ."  has not been defined in the model\n" and exit(1);
		    }
		}
		$succession->add_row("","-- AND there was a positive value in the LP solution for");
		$succession->add_row("3.3.3","the activity indicating potential succession at voluntary retirement", $da);
			
		$succession->add_empty_rows(1);
		$succession->add_row("","Otherwise the farm is shut down.");
		$succession->add_empty_rows(2);
		$succession->add_row("3.4", "Voluntary exit decision");
		
		my $vact = $self->find_special_activity("MASexit");
		$vact = -1 unless (defined $vact);
		$succession->add_row("3.4.1","Activity indicating voluntary exit/ farm shut down", $vact);
		$succession->add_row("","",$self->delim("#END_SUCCESSION"));
		$succession->add_empty_rows(2);

		$self->add_block($succession);

		
		my $invbeh = MpmasInputBlock->new(2,70);
		$invbeh->add_empty_rows(2);
		$invbeh->add_row("4", "INVESTMENT HORIZON");
		$invbeh->add_empty_rows(1);		
		$invbeh->add_row("4.1", "Influence of household head age on investment behavior", $suc{INVESTMENT_HORIZON_MODEL});
		$invbeh->add_empty_rows(1);		
		if ($suc{INVESTMENT_HORIZON_MODEL} == 1) {
			$invbeh->add_comment_row("4.2","Calculation of remaining lifetime of household");
			$invbeh->add_row("4.2.1", "Retirement probability indicating possible end of household lifetime", $suc{INVESTMENT_HORIZON_PTHRESHOLD});
			$invbeh->add_row("4.2.2", "Whom to consider?", $suc{INVESTMENT_HORIZON_WHO});
			$invbeh->add_empty_rows(1);
			$invbeh->add_row("4.3", "Constraints reflecting remaining lifetime" );
			$invbeh->add_empty_rows(1);		

			my @cons = ();
			@cons =  $invhorizonconstraints->query([$curPop],0) if (defined $invhorizonconstraints);
			$invbeh->add_row("", "Number of constraints", scalar (@cons) );
			if (scalar @cons > 0) {
			    $invbeh->add_comment_row("", "Constraint identifier", "LP Row", "Min. remaining lifetime", "RHS value if HH falls into this range" );
			    for my $lb (sort {$a <=> $b } @cons) {
			      my $cID = $invhorizonconstraints->query([$curPop, $lb],3);
			      my $k = $self->constraint($cID);		  
			      print STDERR "Error in INVESTMENT_HORIZON_CONSTRAINTS [MPMAS TABLES]: Constraint '$cID' has not been defined in the .cll file\n" and exit(1) unless (defined $k);
			      $invbeh->add_row("", $cID, $k->lp_row, $lb, $invhorizonconstraints->query([$curPop, $lb],4));
			    }
			}
			$invbeh->add_empty_rows(1);
			$invbeh->add_row("4.4", "Consider household lifetime max. lifespan in investment decision", $suc{INVESTMENT_HORIZON_AFFECT_LIFETIME});
			$invbeh->add_comment_row("","Note: Does not work yet for perennial crops and livestock.");
		}
		$invbeh->add_row("","",$self->delim("#END_HORIZON"));
		$self->add_block($invbeh);

	    my $extraIncRow = MpmasInputBlock->new(2,80);
		$extraIncRow->add_empty_rows(2);
		$extraIncRow->add_row("5", "INCOME CHECK IN LP");
		$extraIncRow->add_empty_rows(1);	
		$extraIncRow->add_row("", "Control variables for the income row to check minimum consumption within the LP");
		$extraIncRow->add_row("", "(Note: A minus one indicates, the corresponding value(s) is (are) not entered into the LP)");
		$extraIncRow->add_empty_rows(1);

		$da = -1;
		if (defined $suc{INCOME_BALANCE_ROW} and $suc{INCOME_BALANCE_ROW} ne "-1" and $suc{INCOME_BALANCE_ROW} ne "0" ) {
		    my $dao = $self->constraint($suc{INCOME_BALANCE_ROW});
		    if (defined $dao) {
			$da = $dao->lp_row ;
		    }
		    else {
			print STDERR "Error for INCOME_BALANCE_ROW: Constraint ". $suc{INCOME_BALANCE_ROW} ."  has not been defined in the model\n" and exit(1);
		    }
		}
		$extraIncRow->add_row("", "LP index of income balance row", $da);

		$da = -1;
		if (defined $suc{RHS_FIX_COST} and $suc{RHS_FIX_COST} ne "-1" and $suc{RHS_FIX_COST} ne "0" ) {
		    my $dao = $self->constraint($suc{RHS_FIX_COST});
		    if (defined $dao) {
			$da = $dao->lp_row ;
		    }
		    else {
			print STDERR "Error for RHS_FIX_COST: Constraint ". $suc{RHS_FIX_COST} ."  has not been defined in the model\n" and exit(1);
		    }
		}
		$extraIncRow->add_row("", "LP index of RHS for fix costs",$da);

		$da = -1;
		if (defined $suc{RHS_MIN_CONS} and $suc{RHS_MIN_CONS} ne "-1" and $suc{RHS_MIN_CONS} ne "0" ) {
		    my $dao = $self->constraint($suc{RHS_MIN_CONS});
		    if (defined $dao) {
			$da = $dao->lp_row ;
		    }
		    else {
				print STDERR "Error for RHS_MIN_CONS: Constraint ". $suc{RHS_MIN_CONS} ."  has not been defined in the model\n" and exit(1);
		    }
		}
		$extraIncRow->add_row("", "LP index of RHS for minimum consumption",$da);
		
		$da = -1;
		$da = $self->find_special_constraint("MASownsoil");
		$da = -1 unless (defined $da);
		$extraIncRow->add_row("", "LP index of RHS for owned plots", $da); 
		
		$da = -1;
		$da = $self->find_special_activity("MASrentout");
		$da = -1 unless (defined $da);		
		$extraIncRow->add_row("", "LP index of activity to rent out owned plots", $da); 
		$extraIncRow->add_row("","",$self->delim("#END_INCCHECK"));
		$extraIncRow->add_empty_rows(3);

		$self->add_block($extraIncRow);
		
	#	if ($self->config_entry("COUNTRY") == 5 ) {
			my $userMarks = MpmasInputBlock->new(2,90);
			$userMarks->add_comment_row("6", "User marks of household members");
			my @marksFound;
			
			my %hhmemberCodes = (
				household_head => 0,
				successor => 1
			);
			for my $k (@{$self->sorted_activity_objects}) {

				if ($k->has_subelement("hhmember_mark")) {
					for my $f ($k->subelement_fields("hhmember_mark")) {
						if (exists $hhmemberCodes{$f} ) {
							my $op = $k->subelement_field("hhmember_mark", $f);
							if ($op eq "add") {
								push @marksFound, [("","$f", $hhmemberCodes{$f}, $k->lp_column(), -1)];
							}
							elsif ($op eq "subtract") {
								push @marksFound, [("","$f", $hhmemberCodes{$f}, -1, $k->lp_column())];
							}
							else {
								print STDERR "Error in #hhmember_mark> $f of activity ",$k->id,": Invalid operation '$op' (only 'add' or 'subtract' allowed). \n" and exit(1);
							}
						}
						else {
							print STDERR "Error in #hhmember_mark> of activity ",$k->id,": Invalid household member '$f' \n" and exit(1);
						}
					}
				}
			}
			$userMarks->add_row("","Number of entries", scalar @marksFound);		
			$userMarks->add_empty_rows(1);
			$userMarks->add_comment_row("","Comment", "WhomToMark", "LPCol Mark", "LPCol Unmark");
			$userMarks->add_table(\@marksFound);
			$userMarks->add_row("","",$self->delim("#END_HHMARK"));
			$userMarks->add_empty_rows(3);
			$self->add_block($userMarks);
		#}
	}
	if ($self->config_entry("DEMOGRAPHY_MODEL") >= 2 ) {
		my $newFarms = MpmasInputBlock->new(2,100);
		$newFarms->add_empty_rows(2);
		$newFarms->add_row("7", "NEW FARMS");
		$newFarms->add_row("", "Shifter for new FarmsteadID", $self->config_entry("NEW_FARMSTEAD_ID_SHIFTER"));
		$newFarms->add_row("", "Multiplier for new FarmsteadID", $self->config_entry("NEW_FARMSTEAD_ID_MULTIPLIER"));
		$newFarms->add_row("","",$self->delim("#END_NEWFARMS"));

		$self->add_block($newFarms);

	}
}
