diff --git a/filenames.m b/filenames.m new file mode 100644 index 00000000..a7a1b1fd --- /dev/null +++ b/filenames.m @@ -0,0 +1,36 @@ +%The following three are always required, + +X = { +'Simulation_Name' , 'verification_run'; +'soil_file' , 'soilnew.txt'; +'leaf_file' , 'Optipar2017_ProspectD.mat'; +'atmos_file' , 'FLEX-S3_std.atm'; + +%The following are only for the time series option! +'Dataset_dir' , 'for_verification'; +'t_file' , 't_.dat'; +'year_file' , 'year_.dat'; +'Rin_file' , 'Rin_.dat'; +'Rli_file' , 'Rli_.dat'; +'p_file' , 'p_.dat'; +'Ta_file' , 'Ta_.dat'; +'ea_file' , 'ea_.dat'; +'u_file' , 'u_.dat'; + +%optional (leave empty for constant values From inputdata.TXT) +'CO2_file' , ''; +'SMC_file' , ''; + +% optional (leave empty for calculations based on t_file year timezn) +'tts_file' , ''; + +%optional two column tables (first column DOY second column value) +'z_file' , ''; +'LAI_file' , ''; +'hc_file' , ''; +'Vcmax_file' , ''; +'Cab_file' , ''; + +%optional leaf inclination distribution file with 3 headerlines (see +%example). It MUST be located in ../data/leafangles/ +'LIDF_file' , ''}; \ No newline at end of file diff --git a/set_parameter_filenames.m b/set_parameter_filenames.m new file mode 100644 index 00000000..0047c2f0 --- /dev/null +++ b/set_parameter_filenames.m @@ -0,0 +1,2 @@ +% parameter_file = { 'setoptions.m', 'filenames.m', 'inputdata.txt'}; +parameter_file = {'input_data.xlsx'}; \ No newline at end of file diff --git a/setoptions.m b/setoptions.m new file mode 100644 index 00000000..831ece79 --- /dev/null +++ b/setoptions.m @@ -0,0 +1,21 @@ +N=[ +1; %calc_ebal calculate the complete energy balance +0; %calc_vert_profiles calculate vertical profiles of fluxes and temperatures +1; %calc_fluor calculate chlorophyll fluorescence +0; %calc_planck calculate spectrum of thermal radiation with spectral emissivity instead of broadband +0; %calc_directional calculate BRDF and directional temperature for many angles specified in a file. Be patient, this takes some time +1; %calc_xanthophyllabs calculate dynamic xanthopyll absorption (zeaxanthin) +0; %calc_PSI 0 (recommended): treat the whole fluorescence spectrum as one spectrum (new calibrated optipar), 1: differentiate PSI and PSII with Franck et al. spectra (of SCOPE 1.62 and older) +0; %rt_thermal 0: provide emissivity values as input. 1: use values from fluspect and soil at 2400 nm for the TIR range +0; %calc_zo 0: use the zo and d values provided in the inputdata, 1: calculate zo and d from the LAI, canopy height, CD1, CR, CSSOIL (recommended if LAI changes in time series) +0; %0: use soil spectrum from a file, 1: simulate soil spectrum with the BSM model +0; %SoilHeatMethod 0: standard calculation of thermal inertia from soil characteristics, 1: empiricaly calibrated formula (make function), 2: as constant fraction of soil net radiation +1; %Fluorescence_model 0: empirical, with sustained NPQ (fit to Flexas' data); 1: empirical, with sigmoid for Kn; 2: Magnani 2012 model +0; %calc_rss_rbs 0: use resistance rss and rbs as provided in inputdata. 1: calculate rss from soil moisture content and correct rbs for LAI (calc_rssrbs.m) +1; %applTcorr correct Vcmax and rate constants for temperature in biochemical.m +1; %verify verifiy the results (compare to saved 'standard' output) to test the code for the firstt ime +1; %saveheaders write header lines in output files +0; %makeplots plot the results +1]; %simulation 0: individual runs. Specify one value for constant input, and an equal number (>1) of values for all input that varies between the runs. + % 1: time series (uses text files with meteo input as time series) + % 2: Lookup-Table (specify the values to be included. All possible combinations of inputs will be used) diff --git a/src/+equations/Planck.m b/src/+equations/Planck.m new file mode 100644 index 00000000..0584f4ff --- /dev/null +++ b/src/+equations/Planck.m @@ -0,0 +1,11 @@ +function Lb = Planck(wl,Tb,em) + + c1 = 1.191066e-22; + c2 = 14388.33; + if nargin<3 + em = ones(size(Tb)); + end + + Lb = em.* c1*(wl*1e-9).^(-5)./(exp(c2./(wl*1e-3*Tb))-1); + +end \ No newline at end of file diff --git a/src/+equations/Soil_Inertia0.m b/src/+equations/Soil_Inertia0.m new file mode 100644 index 00000000..6681903e --- /dev/null +++ b/src/+equations/Soil_Inertia0.m @@ -0,0 +1,3 @@ +function [GAM] = Soil_Inertia0(cs,rhos,lambdas) +% soil thermal inertia +GAM = sqrt(cs*rhos*lambdas); % soil thermal intertia \ No newline at end of file diff --git a/src/+equations/Soil_Inertia1.m b/src/+equations/Soil_Inertia1.m new file mode 100644 index 00000000..35af2e76 --- /dev/null +++ b/src/+equations/Soil_Inertia1.m @@ -0,0 +1,35 @@ +function [GAM] = Soil_Inertia1(SMC) + +%soil inertia method by Murray and Verhoef ( + +%% parameters + +theta_s = 0.42; %(saturated water content, m3/m3) +Sr = SMC/theta_s; + +%fss = 0.58; %(sand fraction) +gamma_s = 0.27; %(soil texture dependent parameter) +dels = 1.33; %(shape parameter) + + +ke = exp(gamma_s*(1- power(Sr,(gamma_s - dels)))); + +phis = 0.5; %(phis == theta_s) +lambda_d = -0.56*phis + 0.51; + +QC = 0.20; %(quartz content) +lambda_qc = 7.7; %(thermal conductivity of quartz, constant) + +lambda_s = (lambda_qc^(QC))*lambda_d^(1-QC); +lambda_wtr = 0.57; %(thermal conductivity of water, W/m.K, constant) + +lambda_w = (lambda_s^(1-phis))*lambda_wtr^(phis); + +lambdas = ke*(lambda_w - lambda_d) + lambda_d; + +Hcs = 2.0*10^6; +Hcw = 4.2*10^6; + +Hc = (Hcw * SMC)+ (1-theta_s)*Hcs; + +GAM = sqrt(lambdas.*Hc); diff --git a/src/+equations/calc_rssrbs.m b/src/+equations/calc_rssrbs.m new file mode 100644 index 00000000..288d070f --- /dev/null +++ b/src/+equations/calc_rssrbs.m @@ -0,0 +1,14 @@ +function [rss,rbs] = calc_rssrbs(SMC,LAI,rbs) + +%rss = 10*exp(35.63*(0.25-SMC)); +%if rss>1000, + %rss=1000; +%elseif rss<30, + %rss=30; +%end +rss =11.2*exp(0.3563*100.0*(0.38-SMC)); +%rss = exp(7.9-1.6*(SMC-0.0008)/(0.38-0.0008)); +%if rss<70, + % rss=70; +%end +rbs = rbs*LAI/4.3; \ No newline at end of file diff --git a/src/+equations/calczenithangle.m b/src/+equations/calczenithangle.m new file mode 100644 index 00000000..c72e064a --- /dev/null +++ b/src/+equations/calczenithangle.m @@ -0,0 +1,64 @@ +function [Fi_s,Fi_gs,Fi_g,Omega_s] = calczenithangle(Doy,t,Omega_g,Fi_gm,Long,Lat) +% +% author: Christiaan van der Tol (c.vandertol@utwente.nl) +% date: Jan 2003 +% update: Oct 2008 by Joris Timmermans (j_timmermans@itc.nl): +% - corrected equation of time +% Oct 2012 (CvdT) comment: input time is GMT, not local time! +% +% function [Fi_s,Fi_gs,Fi_g]= calczenithangle(Doy,t,Omega_g,Fi_gm,Long,Lat) +% +% calculates pi/2-the angle of the sun with the slope of the surface. +% +% input: +% Doy day of the year +% t time of the day (hours, GMT) +% Omega_g slope azimuth angle (deg) +% Fi_gm slope of the surface (deg) +% Long Longitude (decimal) +% Lat Latitude (decimal) +% +% output: +% Fi_s 'classic' zenith angle: perpendicular to horizontal plane +% Fi_gs solar angle perpendicular to surface slope +% Fi_g projected slope of the surface in the plane through the solar beam and the vertical +% + +%parameters (if not already supplied) +if nargin<6 + Long = 13.75; % longitude + Lat = 45.5; % latitude + if (nargin<4) + Omega_g = 210; % aspect + Fi_gm = 30; % slope angle + end +end + +%convert angles into radials +G = (Doy-1)/365*2*pi; % converts day of year to radials +Omega_g = Omega_g/180*pi; % converts direction of slope to radials +Fi_gm = Fi_gm/180*pi; % converts maximum slope to radials +Lat = Lat/180*pi; % converts latitude to radials + +%computes the declination of the sun +d = 0.006918-0.399912*cos(G )+ 0.070247*sin(G )- ... + 0.006758*cos(2*G)+ 0.000907*sin(2*G)- ... + 0.002697*cos(3*G)+ 0.00148*sin(3*G); + +%Equation of time +Et = 0.017 + .4281 * cos(G) - 7.351 * sin(G) - 3.349 * cos(2*G) - 9.731 * sin(2*G); + +%computes the time of the day when the sun reaches its highest angle +tm = 12+(4*(-Long)-Et)/60; % de Pury and Farquhar (1997), Iqbal (1983) + +%computes the hour angle of the sun +Omega_s = (t-tm)/12*pi; + +%computes the zenithangle (equation 3.28 in De Bruin) +Fi_s = acos(sin(d)*sin(Lat)+cos(d)*cos(Lat).*cos(Omega_s)); + +%computes the slope of the surface Fi_g in the same plane as the solar beam +Fi_g = atan(tan(Fi_gm).*cos(Omega_s-Omega_g)); + +%computes the angle of the sun with the vector perpendicular to the surface +Fi_gs = Fi_s + Fi_g; \ No newline at end of file diff --git a/src/+equations/fixedp_brent_ari.m b/src/+equations/fixedp_brent_ari.m new file mode 100644 index 00000000..8f7891bb --- /dev/null +++ b/src/+equations/fixedp_brent_ari.m @@ -0,0 +1,437 @@ +function [b, err2, fcounter] = fixedp_brent_ari(func, x0, corner, tolFn, verbose) +% Find a fixed point of func(x) using Brent's method, as described by Brent 1971 +% func is a single-argument function, f(x) that returns a value the same size as x: +% The goal is to find f(x) = x (or for Brent, f(x) - x = 0). +% x0 is the initial guess (or 2 x n matrix if we want to generalize) +% tol is the tolerance in x (or if two-valued, x, f(x)? ) +% corner (optional) is a known "edge" in the function that could slow down the algorithm +% if specified and the first two points include the corner, the corner will be substituted as a starting point. +% +% Written by: Ari Kornfeld, 2016-10 + +tolx_1 = 0; % we don't want to converge in x +subsetLimit = 0; % never use subsets of x +accelBisection = false; % should we divide the interval by ever-increasing fractions (1/2, 1/3, 1/4) when consecutive calls make no improvement? +accelLimit = 3; % but reset if more than accelLimit bisections don't help. +rotatePrev = true; % do we use Brent's original method of wiping out "xprev" in certain instances (forcing secant) or alway preserve a third value (allowing more inverse-quad). +iter_limit = 100; + +if nargin < 5 + verbose = false; +end + +if nargin < 4 + tolFn = eps; % default to FP precision: 2^-52 = 2.2204e-16 +end +if nargin < 3 + corner = []; % default, no corners +end +track_fcount = (nargout > 2) || verbose; + +recompute_b = false; % ensure that we return after a call on func(s); this allows us to skip the re-call in the main body (since func sets globals) + +% We keep track of the best value of x (b), the past two iterations (c, d), +% and one contrapoint (a), i.e. a point that stradles the fixed point (i.e. err1 has the opposite sign of err2) +% err1, err2, ... are the corresponding "y" values for y = f(x) - x (i.e. distance from the fixed point) +% We start by finding bracketing points a, b +a = x0; +[err1, b] = func(a); % guess the second point by computing x_1 = f(x_0) + +% special case: func may return a vector even though 'a' was scalar (because other variables not visible here were nonscalar). +% If so, expand a: +if length(a) == 1 && length(b) > 1 % anything else is an error + a = repmat(a, size(b)); % or a * ones(size(b))? +end + +err2 = func(b); +err2(isnan(err2)) = 0; % if isnan, we're done, i.e. we shouldn't try +if track_fcount + % count each item separately: count only the "necessary" iterations + fcounter = 2*ones(size(b)); +end + +err_outside_tol = abs(err2) > tolFn; +if ~any(err_outside_tol) + return % we're done! +end +% ELSE +recompute_b = true; % we'll be messing with it + +% Now confirm that the two first guesses bracket zero. +% NOTE: the algorithm may still succeed w/o bracketting, though it's not guaranteed. +not_bracketting_zero = (sign(err1) == sign(err2)) & err_outside_tol; +if any(not_bracketting_zero) + %warning( 'Not all initial guesses bracket zero. Will fix it now.' ); + + % first try a simple secant extrapolation + x1 = b - err2.*(b - a)./(err2 - err1); + err_x1 = func(x1); + if track_fcount + fcounter = fcounter + not_bracketting_zero; % count only the ones that needed this fcall + end + + % since sign(err1) == sign(err2), compare the new value to either of those + use_x1 = (sign(err_x1) ~= sign(err1)) & not_bracketting_zero; + if any(use_x1) + % save the better of the two original points into 'a' + swap_to_a = (abs(err2) < abs(err1) & use_x1); + a(swap_to_a) = b(swap_to_a); err1(swap_to_a) = err2(swap_to_a); + % then put the new contrapoint into 'b' + b(use_x1) = x1(use_x1); err2(use_x1) = err_x1(use_x1); + end + + % recompute a_too_high and iterate if necessary + err_outside_tol = min(abs(err1), abs(err2)) > tolFn; + not_bracketting_zero = (sign(err1) == sign(err2)) & err_outside_tol; + % make 'a' the lower value, to make the rest simpler + if any(not_bracketting_zero) + swap_to_a = (err2 < err1 & not_bracketting_zero); + [a(swap_to_a), b(swap_to_a)] = deal(b(swap_to_a), a(swap_to_a)); + [err1(swap_to_a), err2(swap_to_a)] = deal( err2(swap_to_a), err1(swap_to_a) ); + end + % if both values > 0, need to find a negative value: + both_positive = err1 > 0 & not_bracketting_zero; + ntries=1; % up to 10 tries + while any(both_positive) + % err1 < err2, so assuming a monotonic fn, we can decrease err1 by increasing distance from 'b' + diffab = b(both_positive) - a(both_positive); + a(both_positive) = a(both_positive) - diffab; % walk out in steps that double with each iteration + % recompute the new a values (note, it might be smarter to shift a[n-1] into b when we're done + err1 = func(a); + if track_fcount + fcounter = fcounter + both_positive; + end + + % for a severely ill-behaved function err1 can go in the wrong direction as we move apart, so fix it now + swap_to_a = (err2 < err1 & not_bracketting_zero); + [a(swap_to_a), b(swap_to_a)] = deal(b(swap_to_a), a(swap_to_a)); + [err1(swap_to_a), err2(swap_to_a)] = deal( err2(swap_to_a), err1(swap_to_a) ); + err_outside_tol = min(abs(err1), abs(err2)) > tolFn; + not_bracketting_zero = (sign(err1) == sign(err2) & err_outside_tol); + both_positive = not_bracketting_zero; + if any(both_positive) && ntries > 10 + error('Couldn''t find contrapoint in 10 tries!') + end + ntries = ntries + 1; + end + +% ntries=1; % if using while loop for b + both_negative = err2 < 0 & not_bracketting_zero; + if any(both_negative) + % for Ci, A(0) -> Ci >= 0 so f(0) - 0 >= 0 + b(both_negative) = 0; % just go to zero and be done NOT GENERAL!!!! + err2 = func(b); % for now don't calculate on subsets + if track_fcount + fcounter = fcounter + both_negative; + end + end + + recompute_b = true; % we can no longer be certain that s (b) is the best) +end + +if ~isempty(corner) + % special case: guesses that bracket a "corner" may result in very slow convergence + % if we replace an endpoint with corner, the remaining iterations should be much simplified + bracket_corner = sign(corner - a) ~= sign(corner - b); %( a < corner & b > corner) | ( a > corner & b < corner); + if any(bracket_corner) + % replace one endpoint with corner: + x1 = b; % initialize it for the function call; we'll only use the bracket_corner elements + if length(corner) == 1 % as above, make sure value is same size as x + corner = repmat(corner, size(b)); + end + x1(bracket_corner) = corner(bracket_corner); + + errCorner = func(x1); + if track_fcount + fcounter = fcounter + bracket_corner; + end + + % sort the result into a b so that the sign is preserved + save_into_b = bracket_corner & (sign(errCorner) == sign(err2)); % error on corner and b have same sign + save_into_a = bracket_corner & ~save_into_b; + [a(save_into_a),b(save_into_b)] = deal(x1(save_into_a), x1(save_into_b)); + [err1(save_into_a),err2(save_into_b)] = deal(errCorner(save_into_a), errCorner(save_into_b)); + + recompute_b = true; % we can no longer be certain that s (i.e. matches the last call to computeA) + end +end + + +% Brent tolerance: +% BRENT: 2 * eps * abs(b)+ toler %NUMERICAL RECIPES: 2 * eps * abs(b)+ 0.5*toler +tolx = 2* max(1, abs(b)).*tolx_1; % MATLAB's criterea (and also Wilkins 2013, except for the factor of 4) +err_outside_tol = 0.5 .* abs(a - b) > tolx & min(abs(err1), abs(err2)) > tolFn ; + + +% make sure that 'b' is the best +err1_is_best = abs(err2) > abs(err1); % and therefore needs to be swapped +if any(err1_is_best) + [a(err1_is_best), b(err1_is_best)] = deal(b(err1_is_best), a(err1_is_best)); + [err1(err1_is_best), err2(err1_is_best)] = deal(err2(err1_is_best), err1(err1_is_best)); + recompute_b = true; +end + +% initialize the search array with the current best guess +%[s, err_s] = deal(b, err2); +ab_gap = (a - b); % do this only after we've sorted a and b + +% since b is the current best guess, 'a' therefore stands in as the "previous best" +[c, err3] = deal(a, err1); % the "previous" value of b +best_is_unchanged = abs(err2) == abs(err1); + +% initialize additional vectors to nan +%[p, q] = deal(nan(size(b))); % components of the new increment +[xstep, xstep1] = deal(3*ab_gap); % the step_size of one- or two-steps ago; initialize to prevent triggering on the first round +q = ones(size(b)); % needed for first iteration; don't use nan: we need p/q to be a valid number +p = 0 .* q; +%-------------------------------------------------------- +% MAIN LOOP +% note: Stage 2013 says we should add abs(a - b)<= 0.5(a+b)*eps as a stopping condition +% to avoid machine accuracy issues when abs(x_root) >> 1. +% fzero.m uses: 0.5*abs(a-b) <= 2.0*tol*max(abs(b),1.0) [adjusting for the fact that c in fzero is our a] +%used_bisection = true(size(b)); % 'mflag': did we use bisection on the previous round (starts true) +counter = 0; +accel_bi = zeros(size(b)); +if verbose + fprintf('init''l ') + fprintf('%d: a: %9.5g (%9.3g), b: %9.5g (%9.3g),c: %9.5g (%9.3g), s: %9.3g\n', fcounter, a, err1, b, err2, c, err3, err2); % a, b, c, s); +end +while any( err_outside_tol ) + % 0. Setup + %*** NOTE: See 2013 Wilkins about an objection to the magnitude of tol in these tests + xstep2 = xstep1; % Advance the record of previous step-sizes; Brent calls this "e" + xstep1 = xstep; + + %ab_gap = (a - b); % done at end of loop since it's needed for the exit test + p = 0.*p; % clear p, xstep (this is a bit faster than zeros() or even p(:)=0 in R2015b ) + xstep = 0.*xstep; +% [p, xstep] = deal(zeros(size(b))); % don't use nan, so p/q is a valid number + %q = ones(size(b)); % don't worry about q: if not used, p/q = 0 + + %use_bisection = (abs(xstep2) < tol) | (abs_err_s >= abs_err_s1); % if the latest err is larger than the previous iteration give up on interpolation + %abs_err_s1 = abs_err_s; + use_bisection = (abs(xstep2) < tolx) | best_is_unchanged ; % if the latest err is larger than the previous iteration give up on interpolation + + r2 = err2 ./ err1; % f(b)/f(c) in Brent - see my comments in secant + + % the new guess will be stored in 's' using either secant, inverse quadratic, or bisection: + try_interp = ~use_bisection & err_outside_tol; + %err3_close_enough = abs(ab_gap)*20 >= abs(err3 - err1); % if 3rd best is too far, just use two + quad_is_safe = (err1 ~= err3 & err2 ~= err3); % (note err1 never equals err2 -- since they have opp. signs -- unless they're zero, in which case try_interp is false) + + %----- + % 1. Inverse quadratic Method + % when three values are available, use inverse quadratic method (note: fzero has a more clever algorithm?) + use_quad = try_interp & quad_is_safe; % see prev note about (err1 ~= err2) + if any(use_quad) + % this way is 3x faster than with subsetting! + % (defining intermediate difference variables doesn't make much if any speed difference.) +% s1 = a .* err2 .* err3 ./ ((err1 - err2).*(err1 - err3)) ... +% + b .* err1 .* err3 ./ ((err2 - err1).*(err2 - err3)) ... +% + c .* err1 .* err2 ./ ((err3 - err1).*(err3 - err2)); +% s(use_quad) = s1(use_quad); + r1 = err3 ./ err1; % Brent Section 4, not ALGOL, notation, swapping a/c from Brent's notation + r3 = err2 ./ err3; + p = r3 .* ( ab_gap .* r1 .* (r1 - r2) - (b - c).*(r2 - 1) ); + q = (r1 - 1) .* (r2 - 1) .* (r3 - 1); +% p(~use_quad) = 0; % so xstep = 0 +% q(~use_quad) = 1; % so xstep is not nan +% p(use_quad) = p1(use_quad); % don't bother; we'll overwrite what needs overwriting +% q(use_quad) = q1(use_quad); + if verbose, fprintf('**quad '), end + end + + %----- + % 2. Secant method + % I've found no case in which doing secant helps when inv. quad failed (it actually makes things worse) + %s_test = (quad_is_safe & abs(pq1) >= abs(ab_gap) ) ; % if inverse-quad went too far + use_secant = try_interp & ~quad_is_safe; + % secant: b - f(b) * (b - a) / ( f(b) - (fa) ): derivation: using point-slope of a line solve for y=0: + % (y - y1) = m(x - x1): m = (y2-y1)/(x2-x1); b = y1 - m x1 = y2 - m x2; + % y = 0 => -y1 = m x - m x1 => -mx = y1 - m x1 => x = -y1/m + x1 + % 0 = mx + b => x = -b/m = -(y1 - m x1)/m = -y1/m + x1 OR -(y2 - m x2)/m = x2 - y2/m + % x = x1 - y1 (x2 - x1)/(y2 - y1); OR x2 - y2 (x2 - x1)/(y2 - y1) + %s(use_secant) = b(use_secant) - err2(use_secant) .* (b(use_secant) - a(use_secant)) ./ (err2(use_secant) - err1(use_secant)); + if any(use_secant) + % NOTE: We only take a secant when a = c, + % so it doesn't matter whether we use err2/err1 or err2/err3 + % p /q = ((a - b) * err2/err1) / ((err1 - err2)/err1) + % = err2 (a - b) / (err1 - err2) -- compare to secant formula + p1 = ab_gap .* r2; + p(use_secant) = p1(use_secant); + q(use_secant) = 1 - r2(use_secant); + if verbose, fprintf('secant '), end + end + + if any(try_interp) + %pq1 = p ./ q; % divide now (before subsetting, since it's faster); + %xstep(try_interp) = pq1(try_interp); % though only for the interpolated points, so far. + % note: this does not need subsetting because all(p(~try_interp)) = 0; + % (it should be impossible for q=0 since that would imply err1 = err2, but then err isn't out of tolerance + xstep = p ./ q; % divide now (before subsetting, since it's faster); + xstep(~try_interp) = 0; % to clear nan's + end + + %----- + % 3. Override any of the above with bisection , depending on values of s + % 3a: s is NOT between (3 * a + b)/4 and b + % Brent says: new point should be up to 3/4 way between b and a + %bi_test1a = sign(s - a) == sign(s - b); % s is outside (a ... b); i.e. just a safety-check (and Dekker's test) + bi_test1 = ( abs(p) >= 0.75 .* abs(ab_gap .* q) - 0.5*abs(tolx.*q) ) ; % i.e, toler + + % second test done previously + % third test: |the current xstep| > 1/2 |xstep[n-2]|, i.e. we're moving too far away from the best. but here it's different + %bi_test3 = abs(xstep) >= 0.5 * abs(xstep2); % or the "safer": + bi_test3 = abs(p) >= 0.5 * abs(xstep2 .* q); % need to think about p and q here + + % update the use_bisection flag with the (p/q)-dependent criteria + use_bisection = ( use_bisection | bi_test1 | bi_test3) & err_outside_tol; % + + % now accept any qualifying interpolated point: + + if any(use_bisection) % it's a pretty rare event + % s(use_bisection) = (a(use_bisection) + b(use_bisection))*0.5; + m = -ab_gap./(2 + accel_bi); %(1+ 2.^conseqs); + %s(use_bisection) = b(use_bisection) - m; % b + (a-b)/2 = (b + a)/2 + % set xstep1 so it makes its way into xstep2 (as per Brent 1971) + [xstep(use_bisection), xstep1(use_bisection)] = deal(m(use_bisection)); + if verbose, fprintf('bisect '), end + end + + % xstep (d in Brent) is fully updated, now compute the new guess (note xstep=0 if err is within tol) + s = b - xstep; + xstep_too_small = abs(xstep) < tolx & err_outside_tol; % prevent underflow, but it converges faster if we test against tol rather than eps + if any(xstep_too_small) + s2 = b + sign(ab_gap) .* tolx; + s(xstep_too_small) = s2(xstep_too_small); + end + %s(err_outside_tol) = s1(err_outside_tol); % preserve values that have already converged + + % Quick sanity check + if ~all(use_secant | use_quad | use_bisection | ~err_outside_tol) + error('Somehow, we didn''t update idx: %d\n', find(~(use_secant | use_quad | use_bisection | ~err_outside_tol))); + end + + %----- + % compute error-value for s (how far from the fixed point) + % this values should always be "better" than either a or b (but not necessarily better than both) + if subsetLimit <= 0 || mean(err_outside_tol(:)) > subsetLimit + err_s = func(s); + else + err_s(err_outside_tol) = func(s(err_outside_tol)); + end + if track_fcount + fcounter = fcounter + err_outside_tol; + end + + + %fprintf('Laggards: %d\n', sum(err_outside_tol)); + counter = counter + 1; + if (counter > iter_limit) + error('iteration limit exceeded'); + end + %----------------- + % Now reorganize a, b, c so b is in best + % Also: set conseqs, err_increased, ab_gap for next round + if all(abs(err_s) < tolFn) + % converged in y; s hold the full answer; no need to sort, etc. + b = s; + err2 = err_s; + err_outside_tol=false; % we're done! + recompute_b = false; + else + % first, test that our new guess was an improvement + % if the new guess is larger than the old guess then most likely b is close to zero + % and we're just whittling away at a. (Alternatively, the function is not monotonic on [a b]) + % Either way, we will try bisecting on the next round. + best_is_unchanged = abs(err_s) > abs(err2); % strictly-greater performs what we really mean and in one extreme case (Heaviside) saves us from incorrect behavior + if accelBisection + % Furthermore, if we're just chipping away at the far side, let "bisection" divide by increasing integers. + accel_bi = accel_bi + best_is_unchanged; + accel_bi(~best_is_unchanged | (accel_bi >= accelLimit)) = 0; % reset anything that behaved properly; or after 3 tries + % limit the number of consecutive forced-bisections (3 may be best for well-behaved fns (but may prevent convergence in singularities); + % Inf is probably safest, though with the current method, it's never needed) + best_is_unchanged = accel_bi > 0; %best_is_unchanged & ; + end + + % update previous states: (Brent's, a, fa) + % first store prev. round's best in c: (prev round's result is in s right now) +% d= c; err4 = err3; + c = b; err3 = err2; + + %swap a,b as needed so that all b matches the sign of s +% s_a_sign_match = (sign(err_s) == sign(err1) ) & err_outside_tol; +% if any(s_a_sign_match) +% % s belong in a, so move b into its place. but if we moved b in, b is now in a and c, +% % so lets swap 'a' into 'c' to retain three points +% c(s_a_sign_match) = a(s_a_sign_match); err3(s_a_sign_match)= err1(s_a_sign_match); +% a(s_a_sign_match) = b(s_a_sign_match); err1(s_a_sign_match)= err2(s_a_sign_match); +% xstep1(s_a_sign_match) = xstep(s_a_sign_match); % makes a very tiny improvement in some cases +% end +% +% % and now we can just copy all of s into b +% b = s; err2 = err_s; +% +% % finally swap a, b if necessary, so that b is the best answer +% err1_is_best = (abs(err2) > abs(err1)) & err_outside_tol; +% if any(err1_is_best) +% [a(err1_is_best), b(err1_is_best)] = deal(b(err1_is_best), a(err1_is_best)); +% [err1(err1_is_best), err2(err1_is_best)] = deal(err2(err1_is_best), err1(err1_is_best)); +% % Adding this makes it much closer to Brent's (i.e. erasing the improvement) +% % err_increased = ( abs(err2) >= abs(err1) ); +% end +% +% % very slight improvement, though makes Stage's hyperbolic case (singularity at 0) worse +% d_closer_than_c = abs(c - b) > abs(d - b) & err_outside_tol; +% if (d_closer_than_c) +% c(d_closer_than_c) = d(d_closer_than_c); err3(d_closer_than_c)= err4(d_closer_than_c); +% end + + s_b_sign_match = (sign(err_s) == sign(err2) ); + err_s_is_best = ( abs(err_s) <= abs(err2) ) & err_outside_tol; + a_into_b = (s_b_sign_match & ~err_s_is_best) & err_outside_tol; + if any(a_into_b) + % move a into b, because we're going to move s into a (note, b has already been moved into c + b(a_into_b) = a(a_into_b); err2(a_into_b)= err1(a_into_b); + end + + b_into_a = (~s_b_sign_match & err_s_is_best); % & err_outside_tol is redundant + if any(b_into_a) + % move b into a because we're going to move s into b; we need to save a into c (since prev-b isn't being lost, but a will) + c(b_into_a) = a(b_into_a); err3(b_into_a)= err1(b_into_a); + a(b_into_a) = b(b_into_a); err1(b_into_a)= err2(b_into_a); + end + % now copy s into a or b + if any(err_s_is_best) + b(err_s_is_best) = s(err_s_is_best); err2(err_s_is_best)= err_s(err_s_is_best); + end + err_s_not_best = ~err_s_is_best & err_outside_tol; + if any(err_s_not_best) + a(err_s_not_best) = s(err_s_not_best); err1(err_s_not_best)= err_s(err_s_not_best); + xstep1(err_s_not_best) = xstep(err_s_not_best); % As per Brent; makes a very tiny improvement in some cases (& a bit worse in others?) + end + + %----- + % 0. Test if it's time to exit + ab_gap = (a - b); % i.e. 2 * m in Brent ( m = 0.5*(a - b) translating his paralance ) + %clear xstep so it can be partially filled w/o carryover of previous step + + %tol = eps(b) + 0.5*toler; % BRENT: 2 * eps * abs(b)+ toler + tolx = 2*max(1,abs(b)).*tolx_1; % w/o max(abs(b),1.0) it fails on test f2_2 + err_outside_tol = (0.5 .* abs(ab_gap) > tolx & abs(err2) > tolFn) ; + recompute_b = true; + end + + if verbose + fprintf('%d: a: %9.5g (%9.3g), b: %9.5g (%9.3g),c: %9.5g (%9.3g), s: %9.3g\n', fcounter, a, err1, b, err2, c, err3, err_s); % a, b, c, s); + end +end +if recompute_b + % should never be needed if TolX = 0 and TolFn > 0 (and at least one iter) + err2 = func(b); + if track_fcount + fcounter = fcounter + 1; + end +end +if verbose, fprintf('Brent p/q preserving C. iterations: %d; fcalls: %d; xval: %0.5g\n', counter, fcounter, b), end + diff --git a/src/+equations/leafangles.m b/src/+equations/leafangles.m new file mode 100644 index 00000000..2b2658c0 --- /dev/null +++ b/src/+equations/leafangles.m @@ -0,0 +1,59 @@ +function [lidf]= leafangles(a,b) +% Subroutine FluorSail_dladgen +% Version 2.3 +% For more information look to page 128 of "theory of radiative transfer models applied in optical remote sensing of +% vegetation canopies" +% +% FluorSail for Matlab +% FluorSail is created by Wout Verhoef, +% National Aerospace Laboratory (NLR) +% Present e-mail: w.verhoef@utwente.nl +% +% This code was created by Joris Timmermans, +% International institute for Geo-Information Science and Earth Observation. (ITC) +% Email: j.timmermans@utwente.nl +% +%% main function +F = zeros(1,13); +for i=1:8 + theta = i*10; % theta_l = 10:80 + F(i) = dcum(a,b,theta); % F(theta) +end + +for i=9:12 + theta = 80 + (i-8)*2; % theta_l = 82:88 + F(i) = dcum(a,b,theta); % F(theta) +end + +for i=13:13 % theta_l = 90:90 + F(i) = 1; % F(theta) +end + +lidf = zeros(13,1); +for i=13:-1:2 + lidf(i) = F(i) - F(i-1); % lidf = dF/dtheta; +end +lidf(1) = F(1); % Boundary condition + +%% SubRoutines +function [F] = dcum(a,b,theta) +rd = pi/180; % Geometrical constant +if a>1 + F = 1 - cos(theta*rd); +else + eps = 1e-8; + delx = 1; + + x = 2*rd *theta; + theta2 = x; + % + while max(delx > eps) + y = a*sin(x) + 0.5*b*sin(2*x); + dx = 0.5*(y - x + theta2); + x = x + dx; + delx= abs(dx); + end + F = (2*y + theta2)/pi; % Cumulative leaf inclination density function + %pag 139 thesis says: F = 2*(y+p)/pi. + %Since theta2=theta*2 (in rad), this makes F=(2*y + 2*theta)/pi +end \ No newline at end of file diff --git a/src/+equations/meanleaf.m b/src/+equations/meanleaf.m new file mode 100644 index 00000000..cbbb290b --- /dev/null +++ b/src/+equations/meanleaf.m @@ -0,0 +1,52 @@ +function Fout = meanleaf(canopy,F,choice,Ps) + +nl = canopy.nlayers; +nli = canopy.nlincl; +nlazi = canopy.nlazi; +lidf = canopy.lidf; + +% author: Dr. ir. Christiaan van der Tol (tol@itc.nl) +% date: 7 December 2007 +% update: 11 February 2008 made modular (Joris Timmermans) + +% update: 25 Feb 2013 Wout Verhoef : Propose name change, remove globals +% and use canopy-structure for input +% +% function [F2,F3] = F1tot(F,choice,Ps) +% calculates the layer average and the canopy average of leaf properties +% per layer, per leaf angle and per leaf azimuth (36) +% +% Input: +% F input matrix (3D) [nli, nlazi,nl] +% choice integration method 'angles' : integration over leaf angles +% 'angles_and_layers' : integration over leaf layers and leaf angles +% Ps fraction sunlit per layer [nl] +% +% Output: +% Fout in case of choice = 'angles': [nl] +% in case of choice = 'angles_and_layers': [1] +Fout = zeros(nli, nlazi,nl); +switch choice +%% integration over leaf angles + case 'angles' + + for j = 1:nli + Fout(j,:,:) = F(j,:,:)*lidf(j); % [nli, nlazi,nl] + end + Fout = sum(sum(Fout))/nlazi; % [1,1,nl] + Fout = permute(Fout,[3 1 2]); % [nl] + +%% integration over layers only + case 'layers' + %not implemented +%% integration over both leaf angles and layers + case 'angles_and_layers' + for j = 1:nli + Fout(j,:,:) = F(j,:,:)*lidf(j); + end + + for j = 1:nl + Fout(:,:,j) = Fout(:,:,j)*Ps(j); + end + Fout = sum(sum(sum(Fout)))/nlazi/nl; +end \ No newline at end of file diff --git a/src/+equations/satvap.m b/src/+equations/satvap.m new file mode 100644 index 00000000..7a8c8a7e --- /dev/null +++ b/src/+equations/satvap.m @@ -0,0 +1,21 @@ +function [es,s] = satvap(T) + +%% function [es,s]= satvap(T) +% Author: Dr. ir. Christiaan van der Tol +% Date: 2003 +% +% calculates the saturated vapour pressure at +% temperature T (degrees C) +% and the derivative of es to temperature s (kPa/C) +% the output is in mbar or hPa. The approximation formula that is used is: +% es(T) = es(0)*10^(aT/(b+T)); +% where es(0) = 6.107 mb, a = 7.5 and b = 237.3 degrees C +% and s(T) = es(T)*ln(10)*a*b/(b+T)^2 + +%% constants +a = 7.5; +b = 237.3; %degrees C + +%% calculations +es = 6.107*10.^(7.5.*T./(b+T)); +s = es*log(10)*a*b./(b+T).^2; \ No newline at end of file diff --git a/src/+equations/soil_respiration.m b/src/+equations/soil_respiration.m new file mode 100644 index 00000000..4dc759cc --- /dev/null +++ b/src/+equations/soil_respiration.m @@ -0,0 +1,2 @@ +function [R] = soil_respiration(Ts) +R = 0.5+0.14375*Ts; %umol m-2 s-1 \ No newline at end of file diff --git a/src/+equations/tav.m b/src/+equations/tav.m new file mode 100644 index 00000000..c2c26760 --- /dev/null +++ b/src/+equations/tav.m @@ -0,0 +1,44 @@ +function Tav = tav(alfa,nr) +n2 = nr.^2; +np = n2 + 1; +nm = n2 - 1; + +% Stern's formula in Lekner & Dorf (1988) gives reflectance for alfa = 90 degrees + +% y1 = (3*n2+2*nr+1)./(3*(nr+1).^2); +% y2 = 2*nr.^3.*(nr.^2+2*nr-1)./(np.^2.*nm); +% y3 = n2.*np.*log(nr)./nm.^2; +% y4 = n2.*nm.^2./np.^3.*log((nr.*(nr+1)./(nr-1))); + +% st = y1-y2+y3-y4; + +a = +((nr+1).^2)/2; +k = -((n2-1).^2)/4; +sin_a = sind(alfa); +% +if alfa~=0 + B2 = sin_a^2 - np/2; + B1 = (alfa~=90) * sqrt( B2.^2 + k ); + + b = B1 - B2; + b3 = b.^3; + a3 = a.^3; + + ts = (k.^2./(6*b3) + k./b - b./2) - ... + (k.^2./(6*a3) + k./a - a./2); + + tp1 = -2*n2.* ( b - a ) ./ (np.^2); + tp2 = -2*n2.*np.*( log(b./a) ) ./ (nm.^2); + tp3 = n2.* ( 1./b - 1./a ) ./ 2; + +% tp4 = 16*n2.^2.* (n2.^2+1) .* ( log(2*np.*b - nm.^2) - log(2*np.*a - nm.^2) ) ./ (np.^3.*nm.^2); +% tp5 = 16*n2.^2.* (n2 ) .* ( 1./(2*np.*b - nm.^2) - 1./(2*np.*a - nm.^2)) ./ (np.^3 ); + + tp4 = 16*n2.^2.* (n2.^2+1) .* ( log((2*np.*b - nm.^2)./(2*np.*a - nm.^2)) ) ./(np.^3.*nm.^2); + tp5 = 16*n2.^2.* (n2 ) .* ( 1./(2*np.*b - nm.^2) - 1./(2*np.*a - nm.^2)) ./(np.^3); + tp = tp1 + tp2 + tp3 + tp4 + tp5; + Tav = (ts + tp) ./ (2*sin_a.^2); +else + Tav = 4 *nr/((nr+1)*(nr+1)); +end +return \ No newline at end of file diff --git a/src/+equations/zo_and_d.m b/src/+equations/zo_and_d.m new file mode 100644 index 00000000..3a2b99ea --- /dev/null +++ b/src/+equations/zo_and_d.m @@ -0,0 +1,52 @@ +function [zom,d] = zo_and_d(soil,canopy) + +% function zom_and_d calculates roughness length for momentum and zero +% plane displacement from vegetation height and LAI +% +% Date: 17 November 2008 +% 17 April 2013 (structures) +% +% Author: A. Verhoef +% implemented into Matlab by C. van der Tol (c.vandertol@utwente.nl) +% +% Source: Verhoef, McNaughton & Jacobs (1997), HESS 1, 81-91 +% +% usage: +% zo_and_d (soil,canopy) +% +% canopy fields used as inpuyt: +% LAI one sided leaf area index +% hc vegetation height (m) +% +% soil fields used: +% Cd Averaged drag coefficient for the vegetation +% CR Drag coefficient for isolated tree +% CSSOIL Drag coefficient for soil +% CD1 Fitting parameter +% Psicor Roughness layer correction +% +% constants used (as global) +% kappa Von Karman's constant +% +% output: +% zom roughness lenght for momentum (m) +% d zero plane displacement (m) +% + +%% constants +global constants +kappa = constants.kappa; + +%% parameters +CR = canopy.CR; +CSSOIL = soil.CSSOIL; +CD1 = canopy.CD1; +Psicor = canopy.Psicor; +LAI = canopy.LAI; +h = canopy.hc; + +%% calculations +sq = sqrt(CD1*LAI/2); +G1 = max(3.3, (CSSOIL + CR*LAI/2).^(-0.5)); +d = (LAI>1E-7 & h>1E-7).*h.*(1-(1-exp(-sq))./sq); % Eq 12 in Verhoef et al (1997) +zom = (h-d).*exp(-kappa*G1 + Psicor); \ No newline at end of file diff --git a/src/+helpers/Sint.m b/src/+helpers/Sint.m new file mode 100644 index 00000000..4a6db3a0 --- /dev/null +++ b/src/+helpers/Sint.m @@ -0,0 +1,19 @@ +function int = Sint(y,x) + + % Simpson integration + % x and y must be any vectors (rows, columns), but of the same length + % x must be a monotonically increasing series + + % WV Jan. 2013, for SCOPE 1.40 + + nx = length(x); + if size(x,1) == 1 + x = x'; + end + if size(y,1) ~= 1 + y = y'; + end + step = x(2:nx) - x(1:nx-1); + mean = .5 * (y(1:nx-1) + y(2:nx)); + int = mean * step; +end \ No newline at end of file diff --git a/src/+helpers/aggreg.m b/src/+helpers/aggreg.m new file mode 100644 index 00000000..825ebaad --- /dev/null +++ b/src/+helpers/aggreg.m @@ -0,0 +1,63 @@ +function [M] = aggreg(atmfile,SCOPEspec) + +% Aggregate MODTRAN data over SCOPE bands by averaging (over rectangular band +% passes) + +% Read .atm file with MODTRAN data +s = importdata(atmfile); +wlM = s.data(:,2); +T = s.data(:,3:20); + +% Extract 6 relevant columns from T + +% 1: +% 3: +% 4: +% 5: +% 12: +% 16: + +U = [T(:,1) T(:,3) T(:,4) T(:,5) T(:,12) T(:,16)]; + +nwM = length(wlM); + +nreg = SCOPEspec.nreg; +streg = SCOPEspec.start; +enreg = SCOPEspec.end; +width = SCOPEspec.res; + +% Nr. of bands in each region + +nwreg = int32((enreg-streg)./width)+1; + +off = int32(zeros(nreg,1)); + +for i=2:nreg + off(i) = off(i-1)+nwreg(i-1); +end + +nwS = sum(nwreg); +n = zeros(nwS,1); % Count of MODTRAN data contributing to a band +S = zeros(nwS,6); % Intialize sums + +%k = int32(0); +j = int32(zeros(nreg,1)); % Band index within regions + +for iwl = 1:nwM + w = wlM(iwl); % MODTRAN wavelength + for r = 1:nreg + j(r) = int32(round(w-streg(r))./(width(r)))+1; + if j(r)>0 && j(r)<=nwreg(r) % test if index is in valid range + k = j(r)+off(r); % SCOPE band index + S(k,:) = S(k,:)+U(iwl,:); % Accumulate from contributing MODTRAN data + n(k) = n(k)+1; % Increment count + end + end +end + +M = zeros(size(S,1),6); +for i = 1:6 + M(:,i) = S(:,i)./n; % Calculate averages per SCOPE band +end + +end diff --git a/src/+helpers/count.m b/src/+helpers/count.m new file mode 100644 index 00000000..6fa9606b --- /dev/null +++ b/src/+helpers/count.m @@ -0,0 +1,20 @@ +function [vnew]=count(nvars,v,vmax,id) + +% nvars = number of digits +% v = current vector of digits +% vmax = maximum values of digits +% id = starting digit +% vnew = new vector of digits + +i=id; + +% starting at id, set digits which are at its maximum equal to 1 +% first digit that is not at its maximum is incremented + +while v(i)==vmax(i) + v(i)=1; + i=rem(i,nvars)+1; +end +v(i)=rem(v(i),vmax(i))+1; +vnew=v; +end \ No newline at end of file diff --git a/src/+io/assignvarnames.m b/src/+io/assignvarnames.m new file mode 100644 index 00000000..dcf7b0b8 --- /dev/null +++ b/src/+io/assignvarnames.m @@ -0,0 +1,67 @@ +function V = assignvarnames() +V = struct('Name','','Val', zeros(64,1)); +V(1).Name = 'Cab'; +V(2).Name = 'Cca'; +V(3).Name = 'Cdm'; +V(4).Name = 'Cw'; +V(5).Name = 'Cs'; +V(6).Name = 'N'; +V(7).Name = 'rho_thermal'; +V(8).Name = 'tau_thermal'; +V(9).Name = 'Vcmo'; +V(10).Name = 'm'; % see # 64, below for intercept: 'BallBerry0' +V(11).Name = 'Type'; +V(12).Name = 'kV'; +V(13).Name = 'Rdparam'; +V(14).Name = 'Tparam'; +V(15).Name = 'fqe'; +V(16).Name = 'spectrum'; +V(17).Name = 'rss'; +V(18).Name = 'rs_thermal'; +V(19).Name = 'cs'; +V(20).Name = 'rhos'; +V(21).Name = 'lambdas'; +V(22).Name = 'LAI'; +V(23).Name = 'hc'; +V(24).Name = 'zo'; +V(25).Name = 'd'; +V(26).Name = 'LIDFa'; +V(27).Name = 'LIDFb'; +V(28).Name = 'leafwidth'; +V(29).Name = 'z'; +V(30).Name = 'Rin'; +V(31).Name = 'Ta'; +V(32).Name = 'Rli'; +V(33).Name = 'p'; +V(34).Name = 'ea'; +V(35).Name = 'u'; +V(36).Name = 'Ca'; +V(37).Name = 'Oa'; +V(38).Name = 'rb'; +V(39).Name = 'Cd'; +V(40).Name = 'CR'; +V(41).Name = 'CD1'; +V(42).Name = 'Psicor'; +V(43).Name = 'CSSOIL'; +V(44).Name = 'rbs'; +V(45).Name = 'rwc'; +V(46).Name = 'startDOY'; +V(47).Name = 'endDOY'; +V(48).Name = 'LAT'; +V(49).Name = 'LON'; +V(50).Name = 'timezn'; +V(51).Name = 'tts'; +V(52).Name = 'tto'; +V(53).Name = 'psi'; +V(54).Name = 'SMC'; +V(55).Name = 'Tyear'; +V(56).Name = 'beta'; +V(57).Name = 'kNPQs'; +V(58).Name = 'qLs'; +V(59).Name = 'stressfactor'; +V(60).Name = 'Cant'; %Added March 2017 +V(61).Name = 'BSMBrightness'; +V(62).Name = 'BSMlat'; +V(63).Name = 'BSMlon'; +V(64).Name = 'BallBerry0'; % acccidentally left out of v1.7 +end diff --git a/src/+io/create_output_files.m b/src/+io/create_output_files.m new file mode 100644 index 00000000..f0b3b004 --- /dev/null +++ b/src/+io/create_output_files.m @@ -0,0 +1,231 @@ +function Output_dir = create_output_files(parameter_file, F, path_of_code, options, V, vmax, spectral) +%% Create DATA files +% author J.timmermans +% last modified 4 Aug 2008: Added the creation of log file (file with input parameters) +% 4 Aug 2008: j.timmermans: included variable output directories +% 31 Jul 2008: (CvdT) added layer_pn.dat +% 19 Sep 2008: (CvdT) added spectrum.dat +% 16 Apr 2009: (CvdT) added layer_rn.dat +% 18 Nov 2013: (CvdT) several updates. + +%% Create Output dir + +% a=mfilename('fullpath'); +% c=strfind(a,filesep); +% pathsalida=a(1:c(end-1)-1); +% string = datestr(now,30); +% +% Outdir_Name = char(F(1).FileName); +% Output_dir = fullfile(pathsalida,'output',string); + +string = clock; + +Outdir_Name = char(F(1).FileName); +Output_dir = sprintf(['../output/',Outdir_Name,'_%4.0f-%02.0f-%02.0f-%02.0f%02.0f/'],[string(1) string(2) string(3) string(4) string(5)]); +warning('off','MATLAB:DELETE:FileNotFound') +if any(~exist(Output_dir,'dir')) + mkdir(Output_dir) + mkdir([Output_dir,'Parameters/']) + mkdir([Output_dir,'Directional/']) + mkdir([Output_dir,'figures/']) +end + + +%% Log File +for i = 1:length(parameter_file) + copyfile(['../' parameter_file{i}],[Output_dir,'Parameters/', parameter_file{i}],'f') +end +fidpath = fopen([Output_dir,'Parameters/SCOPEversion.txt'],'w'); % complete path of the SCOPE code +fprintf(fidpath,'%s', path_of_code); +%copyfile(['../' parameter_file],[Output_dir,'Parameters/', parameter_file ],'f') + +%% Normal Output +fidf = fopen([Output_dir,'fluxes.dat'],'w'); % fluxes +fidt = fopen([Output_dir,'surftemp.dat'],'w'); % surftemp +fidra = fopen([Output_dir,'aerodyn.dat'],'w'); % aerodyn +fidr = fopen([Output_dir,'radiation.dat'],'w'); % radiation +fidwl = fopen([Output_dir,'wl.dat'],'w'); % wavelength +fidsi = fopen([Output_dir,'irradiance_spectra.dat'],'w'); % Fluorescence +fidfho = fopen([Output_dir,'spectrum_hemis_optical.dat'],'w'); % spectrum hemispherical +fidfoo = fopen([Output_dir,'spectrum_obsdir_optical.dat'],'w'); % spectrum observation direction +fidref = fopen([Output_dir,'reflectance.dat'],'w'); % reflectance spectrum +fidp = fopen([Output_dir,'BOC_irradiance.dat'],'w'); + +if options.calc_ebal + fidto = fopen([Output_dir,'spectrum_obsdir_BlackBody.dat'],'w'); % spectrum observation direction +end + +%if ~(options.simulation==1) +fidv = fopen([Output_dir,'pars_and_input.dat'],'w'); % wavelength +for j = 1:length(V) + fprintf(fidv,'%s\t',V(j).Name); +end +fprintf(fidv,'\r'); +%end + +%if ~(options.simulation==1) +fidvs = fopen([Output_dir,'pars_and_input_short.dat'],'a'); +for j = find(vmax>1) + fprintf(fidvs,'%s\t',V(vmax>1).Name); +end +fprintf(fidvs,' \r'); +% +%% Optional Output +if options.calc_vert_profiles + fidgp = fopen([Output_dir,'gap.dat'],'w'); % gap + fidtc = fopen([Output_dir,'leaftemp.dat'],'w'); % leaftemp + fidhl = fopen([Output_dir,'layer_H.dat'],'w'); % vertical profile + fidlel = fopen([Output_dir,'layer_lE.dat'],'w'); % latent heat + fidal = fopen([Output_dir,'layer_A.dat'],'w'); % + fidpl = fopen([Output_dir,'layer_aPAR.dat'],'w'); % + fidplC = fopen([Output_dir,'layer_aPAR_Cab.dat'],'w'); % + fidrn = fopen([Output_dir,'layer_Rn.dat'],'w'); % + if options.calc_fluor + fidfll = fopen([Output_dir,'layer_fluorescence.dat'],'w'); + fidfllem = fopen([Output_dir,'layer_fluorescenceEm.dat'],'w'); + fidNPQ = fopen([Output_dir,'layer_NPQ.dat'],'w'); + end + +else + delete([Output_dir,'../output/leaftemp.dat']) + delete([Output_dir,'../output/layer_H.dat']) + delete([Output_dir,'../output/layer_lE.dat']) + delete([Output_dir,'../output/layer_A.dat']) + delete([Output_dir,'../output/layer_aPAR.dat']) + delete([Output_dir,'../output/layer_Rn.dat']) +end + +if options.calc_fluor + fidfl = fopen([Output_dir,'fluorescence.dat'],'w'); % Fluorescence + if options.calc_PSI + fidfl1 = fopen([Output_dir,'fluorescencePSI.dat'],'w'); % Fluorescence + fidfl2 = fopen([Output_dir,'fluorescencePSII.dat'],'w'); % Fluorescence + end + fidflh = fopen([Output_dir,'fluorescence_hemis.dat'],'w'); % Fluorescence + fidfle = fopen([Output_dir,'fluorescence_emitted_by_all_leaves.dat'],'w'); + fidfrc = fopen([Output_dir,'fluorescence_emitted_by_all_photosystems.dat'],'w'); + fidflsu = fopen([Output_dir,'fluorescence_sunlit.dat'],'w'); % Fluorescence + fidflsh = fopen([Output_dir,'fluorescence_shaded.dat'],'w'); % Fluorescence + fidflsc = fopen([Output_dir,'fluorescence_scattered.dat'],'w'); % Fluorescence +else + delete([Output_dir,'fluorescence.dat']) +end + +if options.calc_directional + delete([Output_dir,'BRDF/*.dat']) +end + +if options.calc_planck && options.calc_ebal + fidplancko = fopen([Output_dir,'spectrum_obsdir_thermal.dat'],'w'); % spectrum observation direction + fidplanckh = fopen([Output_dir,'spectrum_hemis_thermal.dat'],'w'); % spectrum hemispherically integrated +end + +%% write headers +if options.save_headers + fprintf(fidf,'timestep counter year t Rntot lEtot Htot Rnctot lEctot Hctot Actot Rnstot lEstot Hstot Gtot Resp aPAR aPAR_Cab faPAR aPAR_energyunits iPAR'); + if options.calc_fluor + fprintf(fidf,' fluortot fluor_yield'); + end + fprintf(fidf,'\r'); + fprintf(fidf,'"" "" "" JulianDay Wm-2 Wm-2 Wm-2 Wm-2 Wm-2 Wm-2 umolm-2s-1 Wm-2 Wm-2 Wm-2 Wm-2 umolm-2s-1 umolm-2s-1 umolumol-1 Wm-2 umolm-2s-1'); + if options.calc_fluor + fprintf(fidf,' W m-2 WW^{-1}'); + end + fprintf(fidf,'\r'); + + fprintf(fidt,'timestep year t Ta Tss(1) Tss(2) Tcave Tsave \r'); + fprintf(fidt,'"" "" JulianDay ^oC ^oC ^oC ^oC ^oC \r'); + + fprintf(fidra, 'raa rawc raws ustar \r'); + fprintf(fidra, 'sm-1 sm-1 sm-1 ms-1 \r'); + + fprintf(fidr, 'timestep year t ShortIn LongIn HemisOutShort HemisOutLong HemisOutTot Net \r'); + fprintf(fidr, '"" "" JulianDay Wm-2 Wm-2 Wm-2 Wm-2 Wm-2 Wm-2\r'); + + fprintf(fidfho, 'hemispherically integrated radiation spectrum \r'); + fprintf(fidfho, 'W m-2 um-1 \r'); + + fprintf(fidfoo, 'radiance spectrum in observation direction \r'); + fprintf(fidfoo, 'W m-2 sr-1 um-1 \r'); + + if options.calc_ebal + fprintf(fidto, 'thermal BlackBody emission spectrum in observation direction \r'); + fprintf(fidto, 'W m-2 sr-1 um-1 \r'); + if options.calc_planck + fprintf(fidplancko, 'thermal emission spectrum in observation direction \r'); + fprintf(fidplancko, 'W m-2 sr-1 um-1 \r'); + + fprintf(fidplanckh, 'thermal emission spectrum in hemispherical direction \r'); + fprintf(fidplanckh, 'W m-2 sr-1 um-1 \r'); + end + end + + fprintf(fidwl, 'wavelengths of the spectral output files \r'); + fprintf(fidwl, 'um \r'); + + fprintf(fidsi, 'irradiance \r'); + fprintf(fidsi, 'W m-2 um-1\r'); + + fprintf(fidref, 'reflectance \r'); + fprintf(fidref, 'fraction of radiation in observation direction *pi / irradiance \r'); + + fprintf(fidp, 'Bottom of canopy irradiance in the shaded fraction, and average BOC irradiance \r'); + fprintf(fidp, 'First 2162 columns: shaded fraction. Last 2162 columns: average BOC irradiance. Unit: Wm-2 um-1 \r'); + + % fprintf(fidref2, 'reflectance including dynamic Xanthophyll effects \r'); + % fprintf(fidref2, 'fraction of radiation in observation direction *pi / irradiance \r'); + + if options.calc_fluor + fprintf(fidfl, 'fluorescence per simulation for wavelengths of 640 to 850 nm, with 1 nm resolution \r'); + fprintf(fidfl, 'W m-2 um-1 sr-1\r'); + if options.calc_PSI + fprintf(fidfl1, 'fluorescence per simulation for wavelengths of 640 to 850 nm, with 1 nm resolution, for PSI only \r'); + fprintf(fidfl1, 'W m-2 um-1 sr-1\r'); + fprintf(fidfl2, 'fluorescence per simulation for wavelengths of 640 to 850 nm, with 1 nm resolution, for PSII only \r'); + fprintf(fidfl2, 'W m-2 um-1 sr-1\r'); + end + fprintf(fidflh, 'hemispherically integrated fluorescence per simulation for wavelengths of 640 to 850 nm, with 1 nm resolution \r'); + fprintf(fidflh, 'W m-2 um-1 \r'); + fprintf(fidfle, 'total emitted fluorescence by all leaves for wavelengths of 640 to 850 nm, with 1 nm resolution \r'); + fprintf(fidfle, 'W m-2 um-1 \r'); + fprintf(fidfrc, 'total emitted fluorescence by all photosystems for wavelengths of 640 to 850 nm, with 1 nm resolution \r'); + fprintf(fidfrc, 'W m-2 um-1 \r'); + fprintf(fidflsu, 'TOC fluorescence contribution from sunlit leaves for wavelengths of 640 to 850 nm, with 1 nm resolution \r'); + fprintf(fidflsu, 'W m-2 um-1 sr^{-1} \r'); + fprintf(fidflsh, 'TOC fluorescence contribution from shaded leaves for wavelengths of 640 to 850 nm, with 1 nm resolution \r'); + fprintf(fidflsh, 'W m-2 um-1 sr^{-1} \r'); + fprintf(fidflsc, 'TOC fluorescence contribution from from leaves and soil after scattering for wavelenghts of 640 to 850 nm, with 1 nm resolution \r'); + fprintf(fidflsc, 'W m-2 um-1 sr^{-1} \r'); + + end + if options.calc_vert_profiles + fprintf(fidgp, 'Fraction leaves in the sun, fraction of observed, fraction of observed&visible per layer \r'); + fprintf(fidgp, ' rows: simulations or time steps, columns: layer numbers \r'); + fprintf(fidtc, 'leaf temperature of sunlit leaves, shaded leaves, and weighted average leaf temperature per layer \r'); + fprintf(fidtc, '^oC ^oC ^oC \r'); + fprintf(fidhl, 'sensible heat flux per layer \r'); + fprintf(fidhl, 'Wm-2\r'); + fprintf(fidlel, 'latent heat flux per layer \r'); + fprintf(fidlel, 'Wm-2\r'); + fprintf(fidal, 'photosynthesis per layer\r'); + fprintf(fidal, 'umol-2s-1\r'); + fprintf(fidpl, 'aPAR per leaf layer \r'); + fprintf(fidpl, 'umol-2s-1 \r'); + fprintf(fidplC, 'aPAR by Cab per leaf layer \r'); + fprintf(fidplC, 'umol-2s-1 \r'); + fprintf(fidrn,'net radiation per leaf layer \r'); + fprintf(fidrn,'Wm-2\r'); + if options.calc_fluor + fprintf(fidfll, 'upward fluorescence per layer\r'); + fprintf(fidfll, 'W m^{-2}\r'); + + fprintf(fidNPQ, 'average NPQ = 1-(fm-fo)/(fm0-fo0), per layer \r'); + fprintf(fidNPQ, '\r'); + end + end +end +%% +fprintf(fidwl,'%9.5f ',spectral.wlS); +warning('on','MATLAB:DELETE:FileNotFound') +fclose all; +end \ No newline at end of file diff --git a/src/+io/define_bands.m b/src/+io/define_bands.m new file mode 100644 index 00000000..d4c77e38 --- /dev/null +++ b/src/+io/define_bands.m @@ -0,0 +1,33 @@ +function [spectral] = define_bands() + + % Define spectral regions for SCOPE v_1.40 + % All spectral regions are defined here as row vectors + % WV Jan. 2013 + + % 3 spectral regions for SCOPE + + reg1 = 400 : 1 : 2400; + reg2 = 2500 : 100 : 15000; + reg3 = 16000 : 1000 : 50000; + + spectral.wlS = [reg1 reg2 reg3]; + + % Other spectral (sub)regions + + spectral.wlP = reg1; % PROSPECT data range + spectral.wlE = 400:1:750; % excitation in E-F matrix + spectral.wlF = 640:1:850; % chlorophyll fluorescence in E-F matrix + spectral.wlO = reg1; % optical part + spectral.wlT = [reg2 reg3]; % thermal part + spectral.wlZ = 500:1:600; % xanthophyll region + wlS = spectral.wlS; + spectral.wlPAR = wlS(wlS>=400 & wlS<=700); % PAR range + + % Data used by aggreg routine to read in MODTRAN data + + spectral.SCOPEspec.nreg = 3; + spectral.SCOPEspec.start = [ 400 2500 16000]; + spectral.SCOPEspec.end = [2400 15000 50000]; + spectral.SCOPEspec.res = [ 1 100 1000]; + +end diff --git a/src/+io/define_constants.m b/src/+io/define_constants.m new file mode 100644 index 00000000..db3d475f --- /dev/null +++ b/src/+io/define_constants.m @@ -0,0 +1,18 @@ +function [const]=define_constants() + + const.A = 6.02214E23; % [mol-1] Constant of Avogadro + const.h = 6.6262E-34; % [J s] Planck's constant + const.c = 299792458; % [m s-1] Speed of light + const.cp = 1004; % [J kg-1 K-1] Specific heat of dry air + const.R = 8.314; % [J mol-1K-1] Molar gas constant + const.rhoa = 1.2047; % [kg m-3] Specific mass of air + const.g = 9.81; % [m s-2] Gravity acceleration + const.kappa = 0.4; % [] Von Karman constant + const.MH2O = 18; % [g mol-1] Molecular mass of water + const.Mair = 28.96; % [g mol-1] Molecular mass of dry air + const.MCO2 = 44; % [g mol-1] Molecular mass of carbon dioxide + const.sigmaSB = 5.67E-8; % [W m-2 K-4] Stefan Boltzman constant + const.deg2rad = pi/180; % [rad] Conversion from deg to rad + const.C2K = 273.15; % [K] Melting point of water + +end \ No newline at end of file diff --git a/src/+io/initialize_output_structures.m b/src/+io/initialize_output_structures.m new file mode 100644 index 00000000..6b0c495c --- /dev/null +++ b/src/+io/initialize_output_structures.m @@ -0,0 +1,18 @@ +function [rad,thermal,fluxes] = initialize_output_structures(spectral) + +[iter.counter ,... + fluxes.Rntot, fluxes.lEtot, fluxes.Htot, fluxes.Atot ,... + fluxes.Rnctot, fluxes.lEctot, fluxes.Hctot, fluxes.Actot ,... + fluxes.Rnstot, fluxes.lEstot, fluxes.Hstot, fluxes.Gtot, fluxes.Resp ,... + thermal.Tcave, thermal.Tsave ,... + thermal.raa, thermal.rawc, thermal.raws, thermal.ustar ,... + rad.Lout, rad.Loutt , rad.Eoutte, rad.PAR ] = deal(NaN); +thermal.Ts = NaN(2,1); +%Fc = deal(NaN(nl,1)); + +[rad.LoF_ ,... + rad.Fhem_] = deal(NaN(size(spectral.wlF,1),1)); + +[rad.Eouto, rad.Eout ] = deal(NaN); +[rad.Lout_,rad.Lo_] = deal(NaN(size(spectral.wlS,1)),1); +thermal.Ta = NaN; \ No newline at end of file diff --git a/src/+io/load_timeseries.m b/src/+io/load_timeseries.m new file mode 100644 index 00000000..a9251d94 --- /dev/null +++ b/src/+io/load_timeseries.m @@ -0,0 +1,132 @@ +function [V,xyt,canopy] = load_timeseries(V,leafbio,soil,canopy,meteo,constants,F,xyt,path_input,options) + +Dataset_dir = ['dataset ' char(F(5).FileName)]; +t_file = char(F(6).FileName); +year_file = char(F(7).FileName); +Rin_file = char(F(8).FileName); +Rli_file = char(F(9).FileName); +p_file = char(F(10).FileName); +Ta_file = char(F(11).FileName); +ea_file = char(F(12).FileName); +u_file = char(F(13).FileName); +CO2_file = char(F(14).FileName); +z_file = char(F(15).FileName); +tts_file = char(F(16).FileName); +LAI_file = char(F(17).FileName); +hc_file = char(F(18).FileName); +SMC_file = char(F(19).FileName); +Vcmax_file = char(F(20).FileName); +Cab_file = char(F(21).FileName); + +%% 1. Time and zenith angle +xyt.t = load([path_input,Dataset_dir,'/' ,t_file] ); +xyt.year = load([path_input,Dataset_dir,'/',year_file]); +t_ = xyt.t; + +DOY_ = floor(t_); +time_ = 24*(t_-DOY_); + +if ~isempty(tts_file) + V(51).Val = load([path_input,Dataset_dir,'/',tts_file]); +else + ttsR = equations.calczenithangle(DOY_,time_ - xyt.timezn ,0,0,xyt.LON,xyt.LAT); %sun zenith angle in rad + V(51).Val = min(85,ttsR/constants.deg2rad); %sun zenith angle in deg +end +%% 2. Radiation +if ~isempty(Rin_file) + V(30).Val = load([path_input,Dataset_dir,'/',Rin_file]); +else + V(30).Val = V(30).Val*ones(size(t_)); +end +if ~isempty(Rli_file) + V(32).Val = load([path_input,Dataset_dir,'/',Rli_file]); +else + V(32).Val = V(32).Val*ones(size(t_)); +end + +%% 3. Windspeed, air temperature, humidity and air pressure +if ~isempty(u_file)% wind speed + V(35).Val = load([path_input,Dataset_dir,'/',u_file]); +else + V(35).Val = V(35).Val*ones(size(t_)); +end + +if ~isempty(Ta_file)%air temperature + V(31).Val = load([path_input,Dataset_dir,'/',Ta_file]); +else + V(31).Val = V(31).Val*ones(size(t_)); +end + +if ~isempty(ea_file)%air temperature + V(34).Val = load([path_input,Dataset_dir,'/',ea_file]); +else + V(34).Val = V(34).Val*ones(size(t_)); +end + +if ~isempty(p_file) + V(33).Val = load([path_input,Dataset_dir,'/',p_file]); +else + V(33).Val = V(33).Val*ones(size(t_)); +end + +%% 4. Vegetation structure (measurement height, vegetation height and LAI) +if ~isempty(z_file) + ztable = load([path_input,Dataset_dir,'/',z_file]); + V(29).Val = interp1(ztable(:,1),ztable(:,2),t_); +else + V(29).Val = meteo.z*ones(size(t_)); +end +if ~isempty(LAI_file) + LAItable = load([path_input,Dataset_dir,'/',LAI_file]); + V(22).Val = interp1(LAItable(:,1),LAItable(:,2),t_); +else + V(22).Val = canopy.LAI*ones(size(time_)); +end +if ~isempty(hc_file) + hctable = load([path_input,Dataset_dir,'/',hc_file]); + V(23).Val = interp1(hctable(:,1),hctable(:,2),t_); + canopy.hc = V(23).Val; + if options.calc_zo + [V(24).Val ,V(25).Val ] = equations.zo_and_d(soil,canopy); + else + V(24).Val = ones(size(t_))*V(24).Val; + V(25).Val = ones(size(t_))*V(25).Val; + end + +else + V(23).Val = canopy.hc*ones(size(t_)); + V(24).Val = canopy.zo*ones(size(t_)); + V(25).Val = canopy.d*ones(size(t_)); +end + + +%% 5. Gas concentrations +if ~isempty(CO2_file) + Ca_ = load([path_input,Dataset_dir,'/',CO2_file])*constants.Mair/constants.MCO2/constants.rhoa; % conversion from mg m-3 to ppm + % mg(CO2)/m-3 * g(air)/mol(air) * mol(CO2)/g(CO2) * m3(air)/kg(air) * 10^-3 g(CO2)/mg(CO2) * 10^-3 kg(air)/g(air) * 10^6 ppm + jj = isnan(Ca_); %find data with good quality Ca data + Ca_(jj) = 380; +else + Ca_ = ones(length(t_),1)* 380; +end +V(36).Val = Ca_; + +%% 6. Soil Moisture Content +if ~isempty(SMC_file) + V(54).Val = load([path_input,Dataset_dir,'/',SMC_file]); +end + +%% 7. Leaf biochemical parameters +if ~isempty(Vcmax_file) + Vcmaxtable = load([path_input,Dataset_dir,'/',Vcmax_file]); + V(9).Val = interp1(Vcmaxtable(:,1),Vcmaxtable(:,2),t_); +else + V(9).Val = leafbio.Vcmo*ones(size(t_)); +end + +if ~isempty(Cab_file) + Cabtable = load([path_input,Dataset_dir,'/',Cab_file]); + V(1).Val = interp1(Cabtable(:,1),Cabtable(:,2),t_); +else + V(1).Val = leafbio.Cab*ones(size(t_)); +end diff --git a/src/+io/output_data.m b/src/+io/output_data.m new file mode 100644 index 00000000..003cdf5f --- /dev/null +++ b/src/+io/output_data.m @@ -0,0 +1,223 @@ +function output_data(Output_dir, options, k, iter, xyt, fluxes, rad, thermal, gap, meteo, spectral, V, vi, vmax, profiles, directional, angles) +%% OUTPUT DATA +% author C. Van der Tol +% modified: 31 Jun 2008: (CvdT) included Pntot in output fluxes.dat +% last modified: 04 Aug 2008: (JT) included variable output directories +% 31 Jul 2008: (CvdT) added layer_pn.dat +% 19 Sep 2008: (CvdT) spectrum of outgoing radiation +% 19 Sep 2008: (CvdT) Pntot added to fluxes.dat +% 15 Apr 2009: (CvdT) Rn added to vertical profiles +% 03 Oct 2012: (CvdT) included boolean variabel calcebal +% 04 Oct 2012: (CvdT) included reflectance and fPAR +% 10 Mar 2013: (CvdT) major revision: introduced structures +% 22 Nov 2013: (CvdT) added additional outputs +%% Standard output + +% fluxes +fidf = fopen([Output_dir,'fluxes.dat'],'a'); +fprintf(fidf,'%9.0f %9.0f %9.0f %9.4f %9.2f %9.2f %9.2f %9.2f %9.2f %9.2f %9.2f %9.2f %9.2f %9.2f %9.2f %9.2f %9.2f %9.2f %9.2f %9.2f %9.2f',... + [k iter.counter xyt.year(k) xyt.t(k) fluxes.Rntot fluxes.lEtot fluxes.Htot fluxes.Rnctot fluxes.lEctot, ... + fluxes.Hctot fluxes.Actot fluxes.Rnstot fluxes.lEstot fluxes.Hstot fluxes.Gtot fluxes.Resp 1E6*fluxes.aPAR 1E6*fluxes.aPAR_Cab fluxes.aPAR/rad.PAR fluxes.aPAR_Wm2 1E6*rad.PAR]); +if options.calc_fluor + fprintf(fidf,'%9.4f %9.6f', rad.Eoutf, rad.Eoutf./fluxes.aPAR_Wm2); +end +fprintf(fidf,'\r'); + +% surftemp +fidt = fopen([Output_dir,'surftemp.dat'],'a'); +fprintf(fidt,'%9.0f %9.0f %9.4f % 9.2f %9.2f %9.2f %9.2f %9.2f',... + [k xyt.year(k) xyt.t(k) thermal.Ta thermal.Ts(1) thermal.Ts(2) thermal.Tcave thermal.Tsave]); +fprintf(fidt,'\r'); + +% aerodyn +fidra = fopen([Output_dir,'aerodyn.dat'],'a'); +fprintf(fidra,'%15.4f %15.4f %15.4f %15.4f',[thermal.raa, thermal.rawc, thermal.raws, thermal.ustar]); +fprintf(fidra,'\r'); + +% radiation +fidr = fopen([Output_dir,'radiation.dat'],'a'); +fprintf(fidr,'%9.0f %9.0f %9.4f %9.2f %9.2f %9.2f %9.2f %9.2f %9.2f',[k xyt.year(k) xyt.t(k) meteo.Rin meteo.Rli rad.Eouto rad.Eoutt + rad.Eoutte rad.Eouto+rad.Eoutt + rad.Eoutte fluxes.Rntot]); +fprintf(fidr,'\r'); + +% spectrum (added on 19 September 2008) +fidfho = fopen([Output_dir,'spectrum_hemis_optical.dat'],'a'); +fprintf(fidfho,'%9.5f ',rad.Eout_'); +fprintf(fidfho,'\r'); + +fidfoo = fopen([Output_dir,'spectrum_obsdir_optical.dat'],'a'); +fprintf(fidfoo,'%9.5f ',rad.Lo_'); +fprintf(fidfoo,'\r'); + +if options.calc_ebal + fidto = fopen([Output_dir,'spectrum_obsdir_BlackBody.dat'],'a'); + fprintf(fidto,'%9.2f', rad.LotBB_'); + fprintf(fidto,'\r'); + + if options.calc_planck + fidplanckh = fopen([Output_dir,'spectrum_hemis_thermal.dat'],'a'); + fprintf(fidplanckh,'%9.2f', rad.Eoutte_'); + fprintf(fidplanckh,'\r'); + + fidplancko = fopen([Output_dir,'spectrum_obsdir_thermal.dat'],'a'); + fprintf(fidplancko,'%9.2f', rad.Lot_'); + fprintf(fidplancko,'\r'); + end +end + +fidsi = fopen([Output_dir,'irradiance_spectra.dat'],'a'); +fprintf(fidsi,'%10.2f',meteo.Rin*(rad.fEsuno+rad.fEskyo)'); +fprintf(fidsi,'\r'); + +fidref = fopen([Output_dir,'reflectance.dat'],'a'); +reflectance = pi*rad.Lo_./(rad.Esun_+rad.Esky_); +reflectance(spectral.wlS>3000) = NaN; +fprintf(fidref,'%9.5f',reflectance'); +fprintf(fidref,'\r'); + +% input and parameter values (added June 2012) +fidv = fopen([Output_dir,'pars_and_input.dat'],'a'); +for i = 1:length(V) + fprintf(fidv,'%12.3f',V(i).Val(vi(i))); +end +fprintf(fidv,'\r'); + +fidvs = fopen([Output_dir,'pars_and_input_short.dat'],'a'); +k2 = find(vmax>1); +for i = 1:length(k2) + fprintf(fidvs,'%9.5f ',V(k2(i)).Val(vi(k2(i)))); +end +fprintf(fidvs,' \r'); + +%% Optional Output + +if options.calc_vert_profiles + + % gap + fidgp = fopen([Output_dir,'gap.dat'],'a'); + fprintf(fidgp,'%9.2f %9.2f %9.2f',[gap.Ps gap.Po gap.Pso]); + fprintf(fidgp,'\r'); + + fidpl = fopen([Output_dir,'layer_aPAR.dat'],'a'); + fprintf(fidpl,'%9.2f',[1E6*profiles.Pn1d' 0]); + fprintf(fidpl,'\r'); + + fidplC = fopen([Output_dir,'layer_aPAR_Cab.dat'],'a'); + fprintf(fidplC,'%9.2f',[1E6*profiles.Pn1d_Cab' 0]); + fprintf(fidplC,'\r'); + + if options.calc_ebal + + % leaftemp + fidtc = fopen([Output_dir,'leaftemp.dat'],'a'); + fprintf(fidtc,'%9.2f',[profiles.Tcu1d' profiles.Tch' profiles.Tc1d']); + fprintf(fidtc,'\r'); + + fidhl = fopen([Output_dir,'layer_h.dat'],'a'); + fprintf(fidhl,'%9.2f',[profiles.Hc1d' fluxes.Hstot]); + fprintf(fidhl,'\r'); + + fidlel = fopen([Output_dir,'layer_le.dat'],'a'); + fprintf(fidlel,'%9.2f',[profiles.lEc1d' fluxes.lEstot]); + fprintf(fidlel,'\r'); + + fidal = fopen([Output_dir,'layer_a.dat'],'a'); + fprintf(fidal,'%9.2f',[profiles.A1d' fluxes.Resp]); + fprintf(fidal,'\r'); + + fidNPQ = fopen([Output_dir,'layer_NPQ.dat'],'a'); + fprintf(fidNPQ,'%9.2f',[profiles.qE' 0]); + fprintf(fidNPQ,'\r'); + + fidrn = fopen([Output_dir,'layer_rn.dat'],'a'); + fprintf(fidrn,'%9.2f',[profiles.Rn1d' fluxes.Rnstot]); + fprintf(fidrn,'\r'); + end + if options.calc_fluor + fidfll = fopen([Output_dir,'layer_fluorescence.dat'],'a'); + fprintf(fidfll,'%9.2f',profiles.fluorescence'); + fprintf(fidfll,'\r'); + end +end + +if options.calc_fluor% && options.calc_ebal + fidfl = fopen([Output_dir,'fluorescence.dat'],'a'); + if options.calc_PSI + fidfl1 = fopen([Output_dir,'fluorescencePSI.dat'],'a'); + fidfl2 = fopen([Output_dir,'fluorescencePSII.dat'],'a'); + end + fidflh = fopen([Output_dir,'fluorescence_hemis.dat'],'a'); + fidfle = fopen([Output_dir,'fluorescence_emitted_by_all_leaves.dat'],'a'); + fidfrc = fopen([Output_dir,'fluorescence_emitted_by_all_photosystems.dat'],'a'); + fidflsu = fopen([Output_dir,'fluorescence_sunlit.dat'],'a'); + fidflsh = fopen([Output_dir,'fluorescence_shaded.dat'],'a'); + fidflsc = fopen([Output_dir,'fluorescence_scattered.dat'],'a'); + + for j=1:size(spectral.wlF,1) + fprintf(fidfl,'%10.4f ',rad.LoF_); + if options.calc_PSI + fprintf(fidfl1,'%10.4f ',rad.LoF1_); + fprintf(fidfl2,'%10.4f ',rad.LoF2_); + end + fprintf(fidflh,'%10.4f ',rad.Fhem_); + fprintf(fidfle,'%10.4f ',rad.Fem_); + fprintf(fidfrc,'%10.4f ',rad.Femtot); + fprintf(fidflsu,'%10.4f ',sum(rad.LoF_sunlit,2)); + fprintf(fidflsh,'%10.4f ',sum(rad.LoF_shaded,2)); + fprintf(fidflsc,'%10.4f ',sum(rad.LoF_scattered,2)+sum(rad.LoF_soil,2)); + end + fprintf(fidfl,' \r'); + if options.calc_PSI + fprintf(fidfl1,' \r'); + fprintf(fidfl2,' \r'); + end + fprintf(fidflh,' \r'); + fprintf(fidfle,' \r'); + fprintf(fidfrc,' \r'); + fprintf(fidflsu,' \r'); + fprintf(fidflsh,' \r'); + fprintf(fidflsc,' \r'); +end + +fidp = fopen([Output_dir,'BOC_irradiance.dat'],'a'); +fprintf(fidp,'%9.0f %9.0f', rad.Emin_(61,:),rad.Emin_(61,:)+(rad.Esun_*gap.Ps(61)')'); +fprintf(fidp,'\r'); + +%% +if options.calc_directional && options.calc_ebal + Output_angle = [directional.tto'; directional.psi'; angles.tts*ones(size(directional.psi'))]; + Output_brdf = [spectral.wlS' directional.brdf_]; + if options.calc_planck + Output_temp = [spectral.wlT' directional.Lot_]; + else + Output_temp = [directional.BrightnessT]; + end + if options.calc_fluor + Output_fluor = [spectral.wlF' directional.LoF_]; + end + + save([Output_dir,'Directional/',sprintf('BRDF (SunAngle %2.2f degrees).dat',angles.tts)],'Output_brdf' ,'-ASCII','-TABS') + save([Output_dir,'Directional/',sprintf('Angles (SunAngle %2.2f degrees).dat',angles.tts)],'Output_angle','-ASCII','-TABS') + save([Output_dir,'Directional/',sprintf('Temperatures (SunAngle %2.2f degrees).dat',angles.tts)],'Output_temp','-ASCII','-TABS') + + if options.calc_fluor + save([Output_dir,'Directional/',sprintf('Fluorescence (SunAngle %2.2f degrees).dat',angles.tts)],'Output_fluor','-ASCII','-TABS') + end + + fiddirtir = fopen([Output_dir,'Directional/','read me.txt'],'w'); + fprintf(fiddirtir,'The Directional data is written in three files: \r\n'); + fprintf(fiddirtir,'\r\n- Angles: contains the directions. \r\n'); + fprintf(fiddirtir,' * The 1st row gives the observation zenith angles\r\n'); + fprintf(fiddirtir,' * The 2nd row gives the observation azimuth angles\r\n'); + fprintf(fiddirtir,' * The 3rd row gives the solar zenith angles\r\n'); + fprintf(fiddirtir,'\r\n- Temperatures: contains the directional brightness temperature. \r\n'); + fprintf(fiddirtir,' * The 1st column gives the wl values corresponding to the brightness temperature values (except for broadband)\r\n'); + fprintf(fiddirtir,' * The 2nd column gives the Tb values corresponding to the directions given by first column in the Angles file\r\n'); + fprintf(fiddirtir,'\r\n- BRDF: contains the bidirectional distribution functions values. \r\n'); + fprintf(fiddirtir,' * The 1st column gives the wl values corresponding to the BRDF values\r\n'); + fprintf(fiddirtir,' * The 2nd column gives the BRDF values corresponding to the directions given by first column in the Angles file\r\n'); + fclose(fiddirtir); +end + +%% +fclose all; +end \ No newline at end of file diff --git a/src/+io/output_verification.m b/src/+io/output_verification.m new file mode 100644 index 00000000..4359accc --- /dev/null +++ b/src/+io/output_verification.m @@ -0,0 +1,98 @@ +function output_verification(Output_dir) +% Date: 07 August 2012 +% Author: Christiaan van der Tol (tol@itc.nl) +% output_verification.m (script) checks if the output of the latest run +% with SCOPE_v1.51 matches with a 'standard' output located in a directory +% called 'verificationdata'. If it does not, warnings will appear in the +% Matlab command window. +% The following is tested: +% - does the number of output files match? +% - does the size of the files match (number of bytes)? +% - are all files that are in the verification dataset present with the +% same file names? +% - is the content of the files exactly the same? +% If the output is different, for example because different parameter +% values have been used in the simulations, then the variables that are +% different will be plotted: the verification data in blue, and the latest +% run in red. In this way the differences can be visually inspected. + +% clc, close all +% +% directories = dir(['..' filesep 'output' filesep '*']); +% [time_value_s,I] = sort([directories(3:end).datenum]); +% Directory = directories(2+I(end)).name; +% +% Directory = Output_dir + +%% load verification data +path0_ = ['..' filesep 'output' filesep 'verificationdata' filesep]; +path1_ = ['..' filesep 'output' filesep Output_dir filesep]; + +info0 = dir([path0_ filesep '*.dat']); %'standard' validation data (to compare with) +info1 = dir([path1_ filesep '*.dat']); %the most recent output + +[differentsize,differentcontent,differentnumberoffiles] = deal(0); + +if ~(length(info0)==length(info1)) + fprintf(['\nWarning: in the output file, ' num2str(length(info1)) ' files were stored, \r']) + fprintf(['whereas there should be ' num2str(length(info0)) ' files in this directory \r ']) + fprintf('check the simulation options that are specified the options tab of the input spreadsheet \r') + differentnumberoffiles = 1; +end + +L = length(info0); +for i = 1:L + s0 = info0(i).bytes; + n0 = info0(i).name; + for j = 1:length(info1) + k = strcmp(info1(j).name,n0); + if k, break, end + end + if k + s1 = info1(j).bytes; + if ~(s0==s1) + fprintf(['\n Warning: the file size of ' info0(i).name ' is different from the verification output \r']) + fprintf(['(' num2str(s1) ' instead of ' num2str(s0) ' bytes) \r']) + differentsize = 1; + else + if (~strcmp(info0(i).name,'pars_and_input.dat') && ~strcmp(info0(i).name,'pars_and_input_short.dat')) + D0 = dlmread([path0_ info0(i).name],'',2,0); + D1 = dlmread([path1_ info1(j).name],'',2,0); + else + D0 = dlmread([path0_ info0(i).name],'',1,0); + D1 = dlmread([path1_ info1(j).name],'',1,0); + end + if (nansum(nansum(D0-D1).^2))>1E-9 + fprintf(['\nWarning: data in the output file ' info0(i).name ' are different from the verification output \r ']) + h0 = textread([path0_ info0(i).name],'%s'); + spn = ceil(sqrt(size(D0,2))); + figure(i) + if spn>7 + nl = length(D0); + for z = 1:min(47,nl) + plot(D0(z,:)'), hold on, plot(D1(z,:)','r') + end + title(info0(i).name) + else + for m = 1:size(D0,2) + subplot(spn,spn,m) + plot(D0(:,m)), hold on, plot(D1(:,m),'r') + title([info0(i).name h0(m)]) + end + end + differentcontent = 1; + end + end + else + fprintf(['\nWarning: the file ' info0(i).name ' was not found in the output\r']) + end +end +if differentsize + fprintf('\nWarning The size of some of the output files is different from the verification data \r') + fprintf('Check if the startdate and enddate in the spreadsheet\r') + fprintf('and the verification data in are specified in "Dataset_Dir" in the Filenames tab of the input data spreadsheet \r') +end +if ~(differentsize || differentcontent || differentnumberoffiles) + fprintf('All right, the output is the same as in the verification data set \r') +end +end \ No newline at end of file diff --git a/src/+io/readStructFromExcel.m b/src/+io/readStructFromExcel.m new file mode 100644 index 00000000..30e0ff2a --- /dev/null +++ b/src/+io/readStructFromExcel.m @@ -0,0 +1,52 @@ +function data = readStructFromExcel(filename, sheetName, headerIdx, dataIdx, data_is_char, data_in_rows) +% Read data into a struct with names matching those found in the first column/row +% default is for data to be in columns (A and B); if data_in_rows = true, data are in rows 1 & 2 +% example: +% readStructFromExcel('../input_data.xlsx', 'options', 3, 1) +% readStructFromExcel('../input_data.xlsx', 'filenames', 1, 2, true) + +% default values: +if nargin < 3 + headerIdx = 1; +end +if nargin < 4 + dataIdx = 2; +end +if nargin < 5 + data_is_char = false; +end +if nargin < 6 + data_in_rows = false; +end + +% read in the spreadsheet +% general note: work with all_as_cell to keep rows & columns in sync; MATLAB does NOT keep data and texts aligned +% (readtable only slightly better - it works but will convert mixed columns to string) +if data_in_rows + %NOTE: 'basic' is compatible with Mac but MATLAB (2013b) complains it can't read Unicode '.xls' in basic mode + % Solution: save as xlsx ?! + [~, ~, allCells] = xlsread(filename, sheetName, ''); % = [data, texts, allCells] +else + [~, ~, allCells] = xlsread(filename, sheetName, ''); % = [data, texts, allCells] + allCells = allCells'; % transpose so data are in the same column as headers +end +% data are now in columns + +% delete empty columns + % define two "helper functions" for eliminating null entries +isNotNumeric = @(x) cellfun(@(y) ischar(y) | any(isnan(y)), x); % any is needed because matlab treats string as char array +isCharCell = @(x) cellfun(@(y) ischar(y), x); + +validHeaders = arrayfun(isCharCell, allCells(headerIdx, :)); +if data_is_char + validData = arrayfun(isCharCell, allCells(dataIdx, :)); % , 'UniformOutput', true +else % numeric data: + validData = ~arrayfun(isNotNumeric, allCells(dataIdx, :)); % , 'UniformOutput', true +end + +dataCells = allCells([headerIdx, dataIdx], validHeaders & validData); + +for idx = 1:size(dataCells,2) + varName = strrep(dataCells{1, idx}, ' ', ''); + data.(varName) = dataCells{2, idx}; +end \ No newline at end of file diff --git a/src/+io/select_input.m b/src/+io/select_input.m new file mode 100644 index 00000000..689ce7f6 --- /dev/null +++ b/src/+io/select_input.m @@ -0,0 +1,104 @@ +function [soil,leafbio,canopy,meteo,angles,xyt] = select_input(V,vi,canopy,options,xyt,soil) +global Theta_LL +soil.spectrum = V(16).Val(vi(16)); +soil.rss = V(17).Val(vi(17)); +soil.rs_thermal = V(18).Val(vi(18)); +soil.cs = V(19).Val(vi(19)); +soil.rhos = V(20).Val(vi(20)); +soil.CSSOIL = V(43).Val(vi(43)); +soil.lambdas = V(21).Val(vi(21)); +soil.rbs = V(44).Val(vi(44)); +soil.SMC = Theta_LL(45,1); %%%%%%% soil.SMC = flip£¨Theta_LL£©£¨:,1£© +soil.BSMBrightness = V(61).Val(vi(61)); +soil.BSMlat = V(62).Val(vi(62)); +soil.BSMlon = V(63).Val(vi(63)); + +leafbio.Cab = V(1).Val(vi(1)); +leafbio.Cca = V(2).Val(vi(2)); +if options.Cca_function_of_Cab + leafbio.Cca = 0.25*V(1).Val(vi(1)); +end +leafbio.Cdm = V(3).Val(vi(3)); +leafbio.Cw = V(4).Val(vi(4)); +leafbio.Cs = V(5).Val(vi(5)); +leafbio.Cant = V(60).Val(vi(60)); +leafbio.N = V(6).Val(vi(6)); +leafbio.Vcmo = V(9).Val(vi(9)); +leafbio.m = V(10).Val(vi(10)); +leafbio.BallBerry0 = V(64).Val(vi(64)); % JAK 2016-10. Accidentally left out of v1.70 +leafbio.Type = V(11).Val(vi(11)); +leafbio.Tparam = V(14).Val(:); % this is correct (: instead of 14) +fqe = V(15).Val(vi(15)); +leafbio.Rdparam = V(13).Val(vi(13)); + +leafbio.rho_thermal = V(7).Val(vi(7)); +leafbio.tau_thermal = V(8).Val(vi(8)); + +leafbio.Tyear = V(55).Val(vi(55)); +leafbio.beta = V(56).Val(vi(56)); +leafbio.kNPQs = V(57).Val(vi(57)); +leafbio.qLs = V(58).Val(vi(58)); +leafbio.stressfactor = V(59).Val(vi(59)); + +canopy.LAI = V(22).Val(vi(22)); +canopy.hc = V(23).Val(vi(23)); +canopy.LIDFa = V(26).Val(vi(26)); +canopy.LIDFb = V(27).Val(vi(26)); % this is correct (26 instead of 27) +canopy.leafwidth = V(28).Val(vi(28)); +canopy.rb = V(38).Val(vi(38)); +canopy.Cd = V(39).Val(vi(39)); +canopy.CR = V(40).Val(vi(40)); +canopy.CD1 = V(41).Val(vi(41)); +canopy.Psicor = V(42).Val(vi(42)); +canopy.rwc = V(45).Val(vi(45)); +canopy.kV = V(12).Val(vi(12)); +canopy.zo = V(24).Val(vi(24)); +canopy.d = V(25).Val(vi(25)); + +meteo.z = V(29).Val(vi(29)); +meteo.Rin = V(30).Val(vi(30)); +meteo.Ta = V(31).Val(vi(31)); +meteo.Rli = V(32).Val(vi(32)); +meteo.p = V(33).Val(vi(33)); +meteo.ea = V(34).Val(vi(34)); +meteo.u = V(35).Val(vi(35)); +meteo.Ca = V(36).Val(vi(36)); +meteo.Oa = V(37).Val(vi(37)); + +xyt.startDOY = V(46).Val(vi(46)); +xyt.endDOY = V(47).Val(vi(47)); +xyt.LAT = V(48).Val(vi(48)); +xyt.LON = V(49).Val(vi(49)); +xyt.timezn = V(50).Val(vi(50)); + +angles.tts = V(51).Val(vi(51)); +angles.tto = V(52).Val(vi(52)); +angles.psi = V(53).Val(vi(53)); + +%% derived input +if options.soil_heat_method ==1 + soil.GAM = equations.Soil_Inertia1(soil.SMC); +else + soil.GAM = equations.Soil_Inertia0(soil.cs,soil.rhos,soil.lambdas); +end +if options.calc_rss_rbs + [soil.rss,soil.rbs] = equations.calc_rssrbs(soil.SMC,canopy.LAI,soil.rbs); +end + +if leafbio.Type + leafbio.Type = 'C4'; +else + leafbio.Type = 'C3'; +end +canopy.hot = canopy.leafwidth/canopy.hc; +if options.calc_zo + [canopy.zo,canopy.d ] = equations.zo_and_d(soil,canopy); +end + +if options.calc_PSI == 1 + leafbio.fqe(1) = fqe/5; + leafbio.fqe(2) = fqe; +else + leafbio.fqe = fqe; +end + diff --git a/src/+plot/plots.m b/src/+plot/plots.m new file mode 100644 index 00000000..a2b564e8 --- /dev/null +++ b/src/+plot/plots.m @@ -0,0 +1,51 @@ +function plots(Output_dir) +% plots.m (script) makes plots the output of SCOPE_v1.51 of the latest run. + +% clc, clear all, close all +% +% directories = dir('..\output\*'); +% [time_value_s,I] = sort([directories(3:end).datenum]); +% Directory = directories(2+I(end)).name; + +%% load verification data +path1_ = ['..\output\' Output_dir ,'\']; +info1 = dir([path1_ '\*.dat']); %the most recent output + +L = length(info1); +wl = dlmread([path1_ 'wl.dat'],'',2,0); + +for i = 1:L-1 + s1 = info1(1).bytes; + n1 = info1(1).name; + if (strcmp(info1(i).name,'pars_and_input.dat') || ... + strcmp(info1(i).name,'pars_and_input_short.dat')) + differentcontent = 1; + continue + end + D1 = dlmread([path1_ info1(i).name],'',2,0); + + spn = ceil(sqrt(size(D1,2))); + h1 = textread([path1_ info1(i).name],'%s'); + figure(i) + if spn>7 + nl = length(D1); + for z = 1:min(47,nl) + if size(D1,1)-1==length(wl) + plot(wl,D1(z,1:end-1)'), hold on + set(gca,'xlim',[.4 2.5]) + else + if z. +%% +% try % for Compiler .exe +% clc +% clear all + +%% 0. globals +global constants +global RWU +global HR U Precip G Rn LAI Ta1 Ts1 h_v rl_min HR_a Ts Ta Tss Taa Tcc bbx RWUtot Rls frac Tsss sfactortot sfactor +run Constants +Mdata=xlsread('E:\grassland\SCOPE-master\SCOPE_v1.73\src\Meterology data','sheet1','B5:AD17572'); +Ta1=Mdata(:,1); % air temperature +HR=Mdata(:,2)./100; % relative humidity +U=Mdata(:,3); % wind speed at 2m +Precip=Mdata(:,4)./10; % precipitation +Ts1=Mdata(:,5); % soil temperature at 20cm +Ts2=Mdata(:,6); % soil temperature at 40cm +Ts3=Mdata(:,7); % soil temperature at 60cm +SMC1=Mdata(:,8); % soil moisture content at 20cm +SMC2=Mdata(:,9); % soil moisture content at 40cm +SMC3=Mdata(:,10); % soil moisture content at 60cm +G1=Mdata(:,11:13); % soil heat flux +Rn=Mdata(:,14); % net rediation +LAI=Mdata(:,26); % leaf area index +h_v=Mdata(:,27); % canopy height +rl_min=Mdata(:,28); % minimum soil resistance +%Precip=Precipi./18000; +G=ones(17568,1); +G=nanmean(G1')'; +Tsss=Mdata(:,29); +HR_a=HR; +Ta=Ta1; +Ts=Ts1; +%P_Va(KT)=0.611*exp(17.27*Ta(KT)/(Ta(KT)+237.3))*HR_a(KT); +%% 1. define constants +[constants] = io.define_constants(); + +%% 2. simulation options +path_of_code = cd; +run ../set_parameter_filenames; +% parameter_file = {'input_data.xlsx'}; % for Compiler .exe + +if length(parameter_file)>1, useXLSX = 0; else useXLSX = 1; end + +if ~useXLSX + run(['../' parameter_file{1}]) + + options.calc_ebal = N(1); % calculate the energy balance (default). If 0, then only SAIL is executed! + options.calc_vert_profiles = N(2); % calculate vertical profiles of fluxes + options.calc_fluor = N(3); % calculate chlorophyll fluorescence in observation direction + options.calc_planck = N(4); % calculate spectrum of thermal radiation + options.calc_directional = N(5); % calculate BRDF and directional temperature + options.calc_xanthophyllabs = N(6); % include simulation of reflectance dependence on de-epoxydation state + options.calc_PSI = N(7); % 0: optipar 2017 file with only one fluorescence spectrum vs 1: Franck et al spectra for PSI and PSII + options.rt_thermal = N(8); % 1: use given values under 10 (default). 2: use values from fluspect and soil at 2400 nm for the TIR range + options.calc_zo = N(9); + options.soilspectrum = N(10); %0: use soil spectrum from a file, 1: simulate soil spectrum with the BSM model + options.soil_heat_method = N(11); % 0: calculated from specific heat and conductivity (default), 1: empiricaly calibrated, 2: G as constant fraction of soil net radiation + options.Fluorescence_model = N(12); %0: empirical, with sustained NPQ (fit to Flexas' data); 1: empirical, with sigmoid for Kn; 2: Magnani 2012 model + options.calc_rss_rbs = N(13); % 0: calculated from specific heat and conductivity (default), 1: empiricaly calibrated, 2: G as constant fraction of soil net radiation + options.apply_T_corr = N(14); % correct Vcmax and rate constants for temperature in biochemical.m + options.verify = N(15); + options.save_headers = N(16); % write headers in output files + options.makeplots = N(17); + options.simulation = N(18); % 0: individual runs (specify all input in a this file) + % 1: time series (uses text files with meteo input as time series) + % 2: Lookup-Table (specify the values to be included) + % 3: Lookup-Table with random input (specify the ranges of values) +else + options = io.readStructFromExcel(['../' char(parameter_file)], 'options', 3, 1); +end + +if options.simulation>2 || options.simulation<0, fprintf('\n simulation option should be between 0 and 2 \r'); return, end + +%% 3. file names +if ~useXLSX + run(['../' parameter_file{2}]) +else + [dummy,X] = xlsread(['../' char(parameter_file)],'filenames'); + j = find(~strcmp(X(:,2),{''})); + X = X(j,(1:end)); +end + +F = struct('FileID',{'Simulation_Name','soil_file','leaf_file','atmos_file'... + 'Dataset_dir','t_file','year_file','Rin_file','Rli_file'... + ,'p_file','Ta_file','ea_file','u_file','CO2_file','z_file','tts_file'... + ,'LAI_file','hc_file','SMC_file','Vcmax_file','Cab_file','LIDF_file'}); +for i = 1:length(F) + k = find(strcmp(F(i).FileID,strtok(X(:,1)))); + if ~isempty(k) + F(i).FileName = strtok(X(k,2)); + %if i==4, F(i).FileName = strtok(X(k,2:end)); end + end +end + +%% 4. input data + +if ~useXLSX + X = textread(['../' parameter_file{3}],'%s'); %#ok + N = str2double(X); +else + [N,X] = xlsread(['../' char(parameter_file)],'inputdata', ''); + X = X(9:end,1); +end +V = io.assignvarnames(); +options.Cca_function_of_Cab = 0; + +for i = 1:length(V) + j = find(strcmp(strtok(X(:,1)),V(i).Name)); + if ~useXLSX, cond = isnan(N(j+1)); else cond = sum(~isnan(N(j,:)))<1; end + if isempty(j) || cond + if i==2 + fprintf(1,'%s %s %s \n','warning: input "', V(i).Name, '" not provided in input spreadsheet...'); + fprintf(1,'%s %s %s\n', 'I will use 0.25*Cab instead'); + options.Cca_function_of_Cab = 1; + else + + if ~(options.simulation==1) && (i==30 || i==32) + fprintf(1,'%s %s %s \n','warning: input "', V(i).Name, '" not provided in input spreadsheet...'); + fprintf(1,'%s %s %s\n', 'I will use the MODTRAN spectrum as it is'); + else + if (options.simulation == 1 || (options.simulation~=1 && (i<46 || i>50))) + fprintf(1,'%s %s %s \n','warning: input "', V(i).Name, '" not provided in input spreadsheet'); + if (options.simulation ==1 && (i==1 ||i==9||i==22||i==23||i==54 || (i>29 && i<37))) + fprintf(1,'%s %s %s\n', 'I will look for the values in Dataset Directory "',char(F(5).FileName),'"'); + else + if (i== 24 || i==25) + fprintf(1,'%s %s %s\n', 'will estimate it from LAI, CR, CD1, Psicor, and CSSOIL'); + options.calc_zo = 1; + else + if (i>38 && i<44) + fprintf(1,'%s %s %s\n', 'will use the provided zo and d'); + options.calc_zo = 0; + else + if ~(options.simulation ==1 && (i==30 ||i==32)) + fprintf(1,'%s \n', 'this input is required: SCOPE ends'); + return + else + fprintf(1,'%s %s %s\n', '... no problem, I will find it in Dataset Directory "',char(F(5).FileName), '"'); + end + end + end + end + end + end + end + end + + if ~useXLSX + j2 = []; j1 = j+1; + while 1 + if isnan(N(j1)), break, end + j2 = [j2; j1]; %#ok + j1 = j1+1; + end + if isempty(j2) + V(i).Val = -999; + else + V(i).Val = N(j2); + end + + + else + if sum(~isnan(N(j,:)))<1 + V(i).Val = -999; + else + V(i).Val = N(j,~isnan(N(j,:))); + end + end +end + +%% 5. Declare paths +path_input = '../../data/input/'; % path of all inputs + +%% 6. Numerical parameters (iteration stops etc) +iter.maxit = 600; % maximum number of iterations +iter.maxEBer = 1; %[W m-2] maximum accepted error in energy bal. +iter.Wc = 1; % Weight coefficient for iterative calculation of Tc + +%% 7. Load spectral data for leaf and soil +%opticoef = xlsread([path_input,'fluspect_parameters/',char(F(3).FileName)]); % file with leaf spectral parameters +%xlsread([path_input,'fluspect_parameters/',char(F(3).FileName)]); % file with leaf spectral parameters +load([path_input,'fluspect_parameters/',char(F(3).FileName)]); +rsfile = load([path_input,'soil_spectrum/',char(F(2).FileName)]); % file with soil reflectance spectra +% Optical coefficient data used by fluspect +% optipar.nr = opticoef(:,2); +% optipar.Kab = opticoef(:,3); +% optipar.Kca = opticoef(:,4); +% optipar.Ks = opticoef(:,5); +% optipar.Kw = opticoef(:,6); +% optipar.Kdm = opticoef(:,7); +% optipar.nw = opticoef(:,8); +% optipar.phiI = opticoef(:,9); +% optipar.phiII = opticoef(:,10); +% optipar.GSV1 = opticoef(:,11); +% optipar.GSV2 = opticoef(:,12); +% optipar.GSV3 = opticoef(:,13); +% optipar.KcaV = opticoef(:,14); +% optipar.KcaZ = opticoef(:,15); + +%% 8. Load directional data from a file +directional = struct; +if options.calc_directional + anglesfile = load([path_input,'directional/brdf_angles2.dat']); % Multiple observation angles in case of BRDF calculation + directional.tto = anglesfile(:,1); % [deg] Observation zenith Angles for calcbrdf + directional.psi = anglesfile(:,2); % [deg] Observation zenith Angles for calcbrdf + directional.noa = length(directional.tto); % Number of Observation Angles +end + +%% 9. Define canopy structure +canopy.nlayers = 60; +nl = canopy.nlayers; +canopy.x = (-1/nl : -1/nl : -1)'; % a column vector +canopy.xl = [0; canopy.x]; % add top level +canopy.nlincl = 13; +canopy.nlazi = 36; +canopy.litab = [ 5:10:75 81:2:89 ]'; % a column, never change the angles unless 'ladgen' is also adapted +canopy.lazitab = ( 5:10:355 ); % a row + +%% 10. Define spectral regions +[spectral] = io.define_bands(); + +wlS = spectral.wlS; % SCOPE 1.40 definition +wlP = spectral.wlP; % PROSPECT (fluspect) range +wlT = spectral.wlT; % Thermal range +wlF = spectral.wlF; % Fluorescence range + +I01 = find(wlSmax(wlF)); +N01 = length(I01); +N02 = length(I02); + +nwlP = length(wlP); +nwlT = length(wlT); + +nwlS = length(wlS); + +spectral.IwlP = 1 : nwlP; +spectral.IwlT = nwlP+1 : nwlP+nwlT; +spectral.IwlF = (640:850)-399; + +[rho,tau,rs] = deal(zeros(nwlP + nwlT,1)); + +%% 11. load time series data +if options.simulation == 1 + vi = ones(length(V),1); + [soil,leafbio,canopy,meteo,angles,xyt] = io.select_input(V,vi,canopy,options); + [V,xyt,canopy] = io.load_timeseries(V,leafbio,soil,canopy,meteo,constants,F,xyt,path_input,options); +else + soil = struct; +end + +%% 12. preparations +if options.simulation==1 + diff_tmin = abs(xyt.t-xyt.startDOY); + diff_tmax = abs(xyt.t-xyt.endDOY); + I_tmin = find(min(diff_tmin)==diff_tmin); + I_tmax = find(min(diff_tmax)==diff_tmax); + if options.soil_heat_method<2 + if (isempty(meteo.Ta) || meteo.Ta<-273), meteo.Ta = 20; end + soil.Tsold = meteo.Ta*ones(12,2); + end +end + +nvars = length(V); +vmax = ones(nvars,1); +for i = 1:nvars + vmax(i) = length(V(i).Val); +end +vmax([14,27],1) = 1; % these are Tparam and LIDFb +vi = ones(nvars,1); +switch options.simulation + case 0, telmax = max(vmax); [xyt.t,xyt.year]= deal(zeros(telmax,1)); + case 1, telmax = size(xyt.t,1); + case 2, telmax = prod(double(vmax)); [xyt.t,xyt.year]= deal(zeros(telmax,1)); +end +[rad,thermal,fluxes] = io.initialize_output_structures(spectral); +atmfile = [path_input 'radiationdata/' char(F(4).FileName(1))]; +atmo.M = helpers.aggreg(atmfile,spectral.SCOPEspec); + +%% 13. create output files +Output_dir = io.create_output_files(parameter_file, F, path_of_code, options, V, vmax, spectral); +%15 function MainLoop +global KT Delt_t TEND TIME MN NN NL ML ND hOLD TOLD h hh T TT P_gOLD P_g P_gg Delt_t0 +global KIT NIT TimeStep Processing +global SUMTIME hhh TTT P_ggg Theta_LLL DSTOR Thmrlefc CHK Theta_LL Theta_L +global NBCh AVAIL Evap DSTOR0 EXCESS QMT RS BCh hN hSAVE NBChh DSTMAX Soilairefc Trap sumTRAP_dir sumEVAP_dir +global TSAVE IRPT1 IRPT2 AVAIL0 TIMEOLD TIMELAST SRT ALPHA BX alpha_h bx Srt L +global QL QL_h QL_T QV Qa KL_h Chh ChT Khh KhT +global D_Vg Theta_g Sa V_A k_g MU_a DeltZ Alpha_Lg +global J Beta_g KaT_Switch Theta_s +global D_V D_A fc Eta nD POR Se +global ThmrlCondCap ZETA XK DVT_Switch +global m g MU_W Ks RHOL +global Lambda1 Lambda2 Lambda3 c_unsat Lambda_eff RHO_bulk +global RHODA RHOV c_a c_V c_L +global ETCON EHCAP +global Xaa XaT Xah RDA Rv KL_T +global DRHOVT DRHOVh DRHODAt DRHODAz +global hThmrl Tr COR IS Hystrs XWRE +global Theta_V DTheta_LLh IH +global W WW D_Ta SSUR +global W_Chg +global KLT_Switch Theta_r Alpha n CKTN trap Evapo SMC lEstot lEctot Ztot Rl +%%%%%%%%%%%%%%%%%%%%%%% Main Processing part %%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +run StartInit; % Initialize Temperature, Matric potential and soil air pressure. + + +%% 14. Run the model +fprintf('\n The calculations start now \r') +calculate = 1; + +for k = 1:telmax + %SMC=Theta_LL(:,1); + TIMEOLD=0; + TIMELAST=0; + KT=KT+1 % Counting Number of timesteps + if KT>1 && Delt_t>(TEND-TIME) + Delt_t=TEND-TIME; % If Delt_t is changed due to excessive change of state variables, the judgement of the last time step is excuted. + end + TIME=TIME+Delt_t; % The time elapsed since start of simulation + TimeStep(KT,1)=Delt_t; + SUMTIME(KT,1)=TIME; + Processing=TIME/TEND + %%i%%%% Updating the state variables. %%%%%%%%%%%%%%%%%%%%%%%%%%%% + if Precip(KT)>0.0005 + %7-13 9-10 p=52mm + NBChh=1; + else + NBChh=2; + end + if IRPT1==0 && IRPT2==0 + for MN=1:NN + hOLD(MN)=h(MN); + h(MN)=hh(MN); + hhh(MN,KT)=hh(MN); +% KL_h(MN,KT)=KL_h(MN,2); +% Chh(MN,KT)=Chh(MN,2); +% ChT(MN,KT)=ChT(MN,2); +% Khh(MN,KT)=Khh(MN,2); +% KhT(MN,KT)=KhT(MN,2); + + if Thmrlefc==1 + TOLD(MN)=T(MN); + T(MN)=TT(MN); + TTT(MN,KT)=TT(MN); + end + if Soilairefc==1 + P_gOLD(MN)=P_g(MN); + P_g(MN)=P_gg(MN); + P_ggg(MN,KT)=P_gg(MN); + end + if rwuef==1 + SRT(MN,KT)=Srt(MN,1); + ALPHA(MN,KT)=alpha_h(MN,1); + BX(MN,KT)=bx(MN,1); + end + end + DSTOR0=DSTOR; + if KT>1 + run SOIL1 + end + end + if options.simulation == 1, vi(vmax>1) = k; end + if options.simulation == 0, vi(vmax==telmax) = k; end + [soil,leafbio,canopy,meteo,angles,xyt] = io.select_input(V,vi,canopy,options,xyt,soil); + if options.simulation ~=1 + fprintf('simulation %i ', k ); + fprintf('of %i \n', telmax); + else + calculate = 0; + if k>=I_tmin && k<=I_tmax + quality_is_ok = ~isnan(meteo.p*meteo.Ta*meteo.ea*meteo.u.*meteo.Rin.*meteo.Rli); + fprintf('time = %4.2f \n', xyt.t(k)); + if quality_is_ok + calculate = 1; + end + end + end + + if calculate + + iter.counter = 0; + + LIDF_file = char(F(22).FileName); + if ~isempty(LIDF_file) + canopy.lidf = dlmread([path_input,'leafangles/',LIDF_file],'',3,0); + else + canopy.lidf = equations.leafangles(canopy.LIDFa,canopy.LIDFb); % This is 'ladgen' in the original SAIL model, + end + + if options.calc_PSI + fversion = @fluspect_B_CX; + else + fversion = @fluspect_B_CX_PSI_PSII_combined; + end + leafbio.V2Z = 0; + leafopt = fversion(spectral,leafbio,optipar); + leafbio.V2Z = 1; + leafoptZ = fversion(spectral,leafbio,optipar); + + IwlP = spectral.IwlP; + IwlT = spectral.IwlT; + + rho(IwlP) = leafopt.refl; + tau(IwlP) = leafopt.tran; + rlast = rho(nwlP); + tlast = tau(nwlP); + + if options.soilspectrum == 0 + rs(IwlP) = rsfile(:,soil.spectrum+1); + else + soilemp.SMC = 25; % empirical parameter (fixed) + soilemp.film = 0.015; % empirical parameter (fixed) + rs(IwlP) = BSM(soil,optipar,soilemp); + end + rslast = rs(nwlP); + + switch options.rt_thermal + case 0 + rho(IwlT) = ones(nwlT,1) * leafbio.rho_thermal; + tau(IwlT) = ones(nwlT,1) * leafbio.tau_thermal; + rs(IwlT) = ones(nwlT,1) * soil.rs_thermal; + case 1 + rho(IwlT) = ones(nwlT,1) * rlast; + tau(IwlT) = ones(nwlT,1) * tlast; + rs(IwlT) = ones(nwlT,1) * rslast; + end + leafopt.refl = rho; % extended wavelength ranges are stored in structures + leafopt.tran = tau; + + reflZ = leafopt.refl; + tranZ = leafopt.tran; + reflZ(1:300) = leafoptZ.refl(1:300); + tranZ(1:300) = leafoptZ.tran(1:300); + leafopt.reflZ = reflZ; + leafopt.tranZ = tranZ; + + soil.refl = rs; + + soil.Ts = meteo.Ta * ones(2,1); % initial soil surface temperature + + if length(F(4).FileName)>1 && options.simulation==0 + atmfile = [path_input 'radiationdata/' char(F(4).FileName(k))]; + atmo.M = helpers.aggreg(atmfile,spectral.SCOPEspec); + end + atmo.Ta = meteo.Ta; + + [rad,gap,profiles] = RTMo(spectral,atmo,soil,leafopt,canopy,angles,meteo,rad,options); + + switch options.calc_ebal + case 1 + [iter,fluxes,rad,thermal,profiles,soil,RWU,frac] ... + = ebal(iter,options,spectral,rad,gap, ... + leafopt,angles,meteo,soil,canopy,leafbio,xyt,k,profiles,LR); + + if options.calc_fluor + if options.calc_vert_profiles + [rad,profiles] = RTMf(spectral,rad,soil,leafopt,canopy,gap,angles,profiles); + else + [rad] = RTMf(spectral,rad,soil,leafopt,canopy,gap,angles,profiles); + end + end + if options.calc_xanthophyllabs + [rad] = RTMz(spectral,rad,soil,leafopt,canopy,gap,angles,profiles); + end + + if options.calc_planck + rad = RTMt_planck(spectral,rad,soil,leafopt,canopy,gap,angles,thermal.Tcu,thermal.Tch,thermal.Ts(2),thermal.Ts(1),1); + end + + if options.calc_directional + directional = calc_brdf(options,directional,spectral,angles,rad,atmo,soil,leafopt,canopy,meteo,profiles,thermal); + end + + otherwise + Fc = (1-gap.Ps(1:end-1))'/nl; % Matrix containing values for Ps of canopy + fluxes.aPAR = canopy.LAI*(Fc*rad.Pnh + equations.meanleaf(canopy,rad.Pnu , 'angles_and_layers',gap.Ps));% net PAR leaves + fluxes.aPAR_Cab = canopy.LAI*(Fc*rad.Pnh_Cab + equations.meanleaf(canopy,rad.Pnu_Cab, 'angles_and_layers',gap.Ps));% net PAR leaves + [fluxes.aPAR_Wm2,fluxes.aPAR_Cab_eta] = deal(canopy.LAI*(Fc*rad.Rnh_PAR + equations.meanleaf(canopy,rad.Rnu_PAR, 'angles_and_layers',gap.Ps)));% net PAR leaves + if options.calc_fluor + profiles.etah = ones(60,1); + profiles.etau = ones(13,36,60); + if options.calc_vert_profiles + [rad,profiles] = RTMf(spectral,rad,soil,leafopt,canopy,gap,angles,profiles); + else + [rad] = RTMf(spectral,rad,soil,leafopt,canopy,gap,angles,profiles); + end + end + end + if options.calc_fluor % total emitted fluorescence irradiance (excluding leaf and canopy re-absorption and scattering) + if options.calc_PSI + rad.Femtot = 1E3*(leafbio.fqe(2)* optipar.phiII(spectral.IwlF) * fluxes.aPAR_Cab_eta +leafbio.fqe(1)* optipar.phiI(spectral.IwlF) * fluxes.aPAR_Cab); + else + rad.Femtot = 1E3*leafbio.fqe* optipar.phi(spectral.IwlF) * fluxes.aPAR_Cab_eta; + end + end + io.output_data(Output_dir, options, k, iter, xyt, fluxes, rad, thermal, gap, meteo, spectral, V, vi, vmax, profiles, directional, angles) + end + if options.simulation==2 && telmax>1, vi = helpers.count(nvars,vi,vmax,1); end + Ac=fluxes.Actot; + lEstot =fluxes.lEstot; + lEctot =fluxes.lEctot; + % if KT>=1933 && KT<=1991 + % Taa=20; + % Tss=20; + % else + Tss=thermal.Tsave; + Tcc=thermal.Ts(1); + Taa=thermal.Ta; + % end + + %if KT<2880 + [Rl]=Root_properties(Rl,Ac,rroot,frac,bbx,KT); + % else + %Rl=Rl; + %end + Ts(KT)=Ta1(KT); + if Delt_t~=Delt_t0 + for MN=1:NN + hh(MN)=h(MN)+(h(MN)-hOLD(MN))*Delt_t/Delt_t0; + TT(MN)=T(MN)+(T(MN)-TOLD(MN))*Delt_t/Delt_t0; + end + end + hSAVE=hh(NN); + TSAVE=TT(NN); + if NBCh==1 + hN=BCh; + hh(NN)=hN; + hSAVE=hN; + elseif NBCh==2 + if NBChh~=2 + if BCh<0 + hN=DSTOR0; + hh(NN)=hN; + hSAVE=hN; + else + hN=-1e6; + hh(NN)=hN; + hSAVE=hN; + end + end + else + if NBChh~=2 + hN=DSTOR0; + hh(NN)=hN; + hSAVE=hN; + end + end + % run Forcing_PARM +%Ts(KT)=Ts1(KT); + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + for KIT=1:NIT % Start the iteration procedure in a time step. + [hh,COR,J,Theta_V,Theta_g,Se,KL_h,Theta_LL,DTheta_LLh]=SOIL2(hh,COR,hThmrl,NN,NL,TT,Tr,IS,Hystrs,XWRE,Theta_s,IH,KIT,Theta_r,Alpha,n,m,Ks,Theta_L,h,Thmrlefc,CKTN,POR,J); + [KL_T]=CondL_T(NL); + [RHOV,DRHOVh,DRHOVT]=Density_V(TT,hh,g,Rv,NN); + [W,WW,MU_W,D_Ta]=CondL_Tdisp(POR,Theta_LL,Theta_L,SSUR,RHO_bulk,RHOL,TT,Theta_s,h,hh,W_Chg,NL,nD,J,Delt_t,Theta_g,KLT_Switch); + [L]=Latent(TT,NN); + [Xaa,XaT,Xah,DRHODAt,DRHODAz,RHODA]=Density_DA(T,RDA,P_g,Rv,DeltZ,h,hh,TT,P_gg,Delt_t,NL,NN,DRHOVT,DRHOVh,RHOV); + [c_unsat,Lambda_eff]=CondT_coeff(Theta_LL,Lambda1,Lambda2,Lambda3,RHO_bulk,Theta_g,RHODA,RHOV,c_a,c_V,c_L,NL,nD,ThmrlCondCap,ETCON,EHCAP); + [k_g]=Condg_k_g(POR,NL,J,m,Theta_g,g,MU_W,Ks,RHOL); + [D_V,Eta,D_A]=CondV_DE(Theta_LL,TT,fc,Theta_s,NL,nD,J,Theta_g,POR,ThmrlCondCap,ZETA,XK,DVT_Switch); + [D_Vg,V_A,Beta_g]=CondV_DVg(P_gg,Theta_g,Sa,V_A,k_g,MU_a,DeltZ,Alpha_Lg,KaT_Switch,Theta_s,Se,NL,J); + run h_sub; + + if NBCh==1 + DSTOR=0; + RS=0; + elseif NBCh==2 + AVAIL=-BCh; + EXCESS=(AVAIL+QMT(KT))*Delt_t; + if abs(EXCESS/Delt_t)<=1e-10,EXCESS=0;end + DSTOR=min(EXCESS,DSTMAX); + RS=(EXCESS-DSTOR)/Delt_t; + else + AVAIL=AVAIL0-Evap(KT); + EXCESS=(AVAIL+QMT(KT))*Delt_t; + if abs(EXCESS/Delt_t)<=1e-10,EXCESS=0;end + DSTOR=0; + RS=0; + end + + if Soilairefc==1 + run Air_sub; + end + + if Thmrlefc==1 + run Enrgy_sub; + end + + if max(CHK)<0.001 + break + end + hSAVE=hh(NN); + TSAVE=TT(NN); + %max(CHK) + end + TIMEOLD=KT; + %sum(sum(CHK)) + KIT + KIT=0; + [hh,COR,J,Theta_V,Theta_g,Se,KL_h,Theta_LL,DTheta_LLh]=SOIL2(hh,COR,hThmrl,NN,NL,TT,Tr,IS,Hystrs,XWRE,Theta_s,IH,KIT,Theta_r,Alpha,n,m,Ks,Theta_L,h,Thmrlefc,CKTN,POR,J); + + if IRPT1==0 && IRPT2==0 + if KT % In case last time step is not convergent and needs to be repeated. + MN=0; + + for ML=1:NL + for ND=1:2 + MN=ML+ND-1; + Theta_LLL(ML,ND,KT)=Theta_LL(ML,ND); + Theta_L(ML,ND)=Theta_LL(ML,ND); + + end + end + + %SMC = Theta_LL(:,1); + run ObservationPoints + end + if (TEND-TIME)<1E-3 + for MN=1:NN + hOLD(MN)=h(MN); + h(MN)=hh(MN); + hhh(MN,KT)=hh(MN); + if Thmrlefc==1 + TOLD(MN)=T(MN); + T(MN)=TT(MN); + TTT(MN,KT)=TT(MN); + end + if Soilairefc==1 + P_gOLD(MN)=P_g(MN); + P_g(MN)=P_gg(MN); + P_ggg(MN,KT)=P_gg(MN); + end + end + break + end + end + for MN=1:NN + QL(MN,KT)=QL(MN); + QL_h(MN,KT)=QL_h(MN); + QL_T(MN,KT)=QL_T(MN); + Qa(MN,KT)=Qa(MN); + QV(MN,KT)=QV(MN); + end + RWUtot(:,KT)=RWU; + Rls(:,KT)=Rl; + sfactortot(KT)=sfactor; + +end +% run PlotResults +%%%%%%%%%%%%%%%%%%%% postprocessing part %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%%%% plot the figures of simulation output soil moisture/temperature, +%%%% soil evaporation, plant transpiration simulated with two different +%%%% ET method (indirect ET method & direct ET method) +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +if Evaptranp_Cal==1 % save the variables for ETind scenario + Sim_Theta_ind=Sim_Theta; + Sim_Temp_ind=Sim_Temp; + TRAP=36000.*trap; + TRAP_ind=TRAP'; + EVAP=36000.*Evapo; + EVAP_ind=EVAP'; + disp ('Convergence Achieved for ETind scenario. Please switch to ETdir scenario and run again.') +else + TRAP=18000.*trap; + TRAP_dir=TRAP'; + EVAP=18000.*Evapo; + EVAP_dir=EVAP'; + for i=1:KT/48 + sumTRAP_ind(i)=0; %#ok<*SAGROW> + sumEVAP_ind(i)=0; + sumTRAP_dir(i)=0; + sumEVAP_dir(i)=0; + for j=(i-1)*48+1:i*48 + sumTRAP_ind(i)=TRAP_ind(j)+sumTRAP_ind(i); + sumEVAP_ind(i)=EVAP_ind(j)+sumEVAP_ind(i); + sumTRAP_dir(i)=TRAP(j)+sumTRAP_dir(i); + sumEVAP_dir(i)=EVAP(j)+sumEVAP_dir(i); + end + end +end +if options.verify + io.output_verification(Output_dir) +end + +if options.makeplots + plot.plots(Output_dir) +end + +%% for Compiler +% catch ME +% disp(['ERROR: ' ME.message]) +% end +% fprintf('\nThe run is finished. Press any key to close the window') +% fprintf('\nIf no error message was produced navigate to ./SCOPE_v1.70/output to see the results') +% pause diff --git a/src/AirPARM.m b/src/AirPARM.m new file mode 100644 index 00000000..ed5b8109 --- /dev/null +++ b/src/AirPARM.m @@ -0,0 +1,43 @@ +function [Cah,CaT,Caa,Kah,KaT,Kaa,Vah,VaT,Vaa,Cag,QL,QL_h,QL_T,KLhBAR,KLTBAR,DhDZ,DTDZ,DPgDZ,DTDBAR]=AirPARM(NL,hh,TT,Theta_LL,DeltZ,DTheta_LLh,DTheta_LLT,POR,RHOL,V_A,KL_h,D_Ta,KL_T,D_V,D_Vg,P_gg,Beta_g,J,Gamma_w,KLa_Switch,Xah,XaT,Xaa,RHODA,Hc,KLhBAR,KLTBAR,DhDZ,DTDZ,DPgDZ,DTDBAR) + +for ML=1:NL + KLhBAR(ML)=(KL_h(ML,1)+KL_h(ML,2))/2; + KLTBAR(ML)=(KL_T(ML,1)+KL_T(ML,2))/2; + DhDZ(ML)=(hh(ML+1)-hh(ML))/DeltZ(ML); + DTDZ(ML)=(TT(ML+1)-TT(ML))/DeltZ(ML); + DPgDZ(ML)=(P_gg(ML+1)-P_gg(ML))/DeltZ(ML); + DTDBAR(ML)=(D_Ta(ML,1)+D_Ta(ML,2))/2; +end + +MN=0; +for ML=1:NL + for ND=1:2 + MN=ML+ND-1; + + if KLa_Switch==1 + QL(ML)=-(KLhBAR(ML)*(DhDZ(ML)+DPgDZ(ML)/Gamma_w)+(KLTBAR(ML)+DTDBAR(ML))*DTDZ(ML)+KLhBAR(ML)); + QL_h(ML)=-(KLhBAR(ML)*(DhDZ(ML)+DPgDZ(ML)/Gamma_w)+KLhBAR(ML)); + QL_T(ML)=-((KLTBAR(ML)+DTDBAR(ML))*DTDZ(ML)); + else + QL(ML)=-(KLhBAR(ML)*DhDZ(ML)+(KLTBAR(ML)+DTDBAR(ML))*DTDZ(ML)+KLhBAR(ML)); + QL_h(ML)=-(KLhBAR(ML)*DhDZ(ML)+KLhBAR(ML)); + QL_T(ML)=-((KLTBAR(ML)+DTDBAR(ML))*DTDZ(ML)); + + end + + Cah(ML,ND)=Xah(MN)*(POR(J)+(Hc-1)*Theta_LL(ML,ND))+(Hc-1)*RHODA(MN)*DTheta_LLh(ML,ND); + CaT(ML,ND)=XaT(MN)*(POR(J)+(Hc-1)*Theta_LL(ML,ND))+(Hc-1)*RHODA(MN)*DTheta_LLT(ML,ND); + Caa(ML,ND)=Xaa(MN)*(POR(J)+(Hc-1)*Theta_LL(ML,ND)); + + Kah(ML,ND)=Xah(MN)*(D_V(ML,ND)+D_Vg(ML))+Hc*RHODA(MN)*KL_h(ML,ND); + KaT(ML,ND)=XaT(MN)*(D_V(ML,ND)+D_Vg(ML))+Hc*RHODA(MN)*(KL_T(ML,ND)+D_Ta(ML,ND)); + Kaa(ML,ND)=Xaa(MN)*(D_V(ML,ND)+D_Vg(ML))+RHODA(MN)*(Beta_g(ML,ND)+Hc*KL_h(ML,ND)/Gamma_w);% + + Cag(ML,ND)=Hc*RHODA(MN)*KL_h(ML,ND); + + Vah(ML,ND)=-(V_A(ML)+Hc*QL(ML)/RHOL)*Xah(MN); %0;% + VaT(ML,ND)=-(V_A(ML)+Hc*QL(ML)/RHOL)*XaT(MN); %0;% + Vaa(ML,ND)=-(V_A(ML)+Hc*QL(ML)/RHOL)*Xaa(MN); %0;% + end +end + diff --git a/src/Air_BC.m b/src/Air_BC.m new file mode 100644 index 00000000..4b04fdb9 --- /dev/null +++ b/src/Air_BC.m @@ -0,0 +1,34 @@ +function [RHS,C6,C6_a]=Air_BC(RHS,KT,NN,BtmPg,TopPg,NBCPB,BCPB,NBCP,BCP,C6,C6_a) +%%%%%%%%% Apply the bottom boundary condition called for by NBCPB %%%%%%%%% +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +if NBCPB==1 %---------------------> Bounded bottom with the water table; + RHS(1)=BtmPg; + C6(1,1)=1; + RHS(2)=RHS(2)-C6(1,2)*RHS(1); + C6(1,2)=0; + C6_a(1)=0; +elseif NBCPB==2 %------------------> The soil air is allowed to escape from the bottom; + RHS(1)=RHS(1)+BCPB; +end + +%%%%%%%%%% Apply the surface boundary condition called by NBCP %%%%%%%%%%%% +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +if NBCP==1 %----------> Ponded infiltration with Bonded bottom, + RHS(NN)=BtmPg; + C6(NN,1)=1; + RHS(NN-1)=RHS(NN-1)-C6(NN-1,2)*RHS(NN); + C6(NN-1,2)=0; + C6_a(NN-1)=0; +elseif NBCP==2 %----------> Specified flux on the surface; + RHS(NN)=RHS(NN)-BCP; +else + RHS(NN)=TopPg(KT); + C6(NN,1)=1; + RHS(NN-1)=RHS(NN-1)-C6(NN-1,2)*RHS(NN); + C6(NN-1,2)=0; + C6_a(NN-1)=0; +end + + + + diff --git a/src/Air_EQ.m b/src/Air_EQ.m new file mode 100644 index 00000000..1143ce9f --- /dev/null +++ b/src/Air_EQ.m @@ -0,0 +1,61 @@ +function [RHS,C6,SAVE]=Air_EQ(C1,C2,C3,C4,C4_a,C5,C5_a,C6,C7,NL,NN,Delt_t,T,TT,h,hh,P_g,Thmrlefc) + +if Thmrlefc + RHS(1)=-C7(1)+(C3(1,1)*P_g(1)+C3(1,2)*P_g(2))/Delt_t ... + -(C2(1,1)/Delt_t+C5(1,1))*TT(1)-(C2(1,2)/Delt_t+C5(1,2))*TT(2) ... + -(C1(1,1)/Delt_t+C4(1,1))*hh(1)-(C1(1,2)/Delt_t+C4(1,2))*hh(2) ... + +(C2(1,1)/Delt_t)*T(1)+(C2(1,2)/Delt_t)*T(2) ... + +(C1(1,1)/Delt_t)*h(1)+(C1(1,2)/Delt_t)*h(2); + + for ML=2:NL + ARG1=C2(ML-1,2)/Delt_t; + ARG2=C2(ML,1)/Delt_t; + ARG3=C2(ML,2)/Delt_t; + + ARG4=C1(ML-1,2)/Delt_t; + ARG5=C1(ML,1)/Delt_t; + ARG6=C1(ML,2)/Delt_t; + + RHS(ML)=-C7(ML)+(C3(ML-1,2)*P_g(ML-1)+C3(ML,1)*P_g(ML)+C3(ML,2)*P_g(ML+1))/Delt_t ... + -(ARG1+C5_a(ML-1))*TT(ML-1)-(ARG2+C5(ML,1))*TT(ML)-(ARG3+C5(ML,2))*TT(ML+1) ... + -(ARG4+C4_a(ML-1))*hh(ML-1)-(ARG5+C4(ML,1))*hh(ML)-(ARG6+C4(ML,2))*hh(ML+1) ... + +ARG1*T(ML-1)+ARG2*T(ML)+ARG3*T(ML+1) ... + +ARG4*h(ML-1)+ARG5*h(ML)+ARG6*h(ML+1); + end + + RHS(NN)=-C7(NN)+(C3(NN-1,2)*P_g(NN-1)+C3(NN,1)*P_g(NN))/Delt_t ... + -(C2(NN-1,2)/Delt_t+C5_a(NN-1))*TT(NN-1)-(C2(NN,1)/Delt_t+C5(NN,1))*TT(NN) ... + -(C1(NN-1,2)/Delt_t+C4_a(NN-1))*hh(NN-1)-(C1(NN,1)/Delt_t+C4(NN,1))*hh(NN) ... + +(C2(NN-1,2)/Delt_t)*T(NN-1)+(C2(NN,1)/Delt_t)*T(NN) ... + +(C1(NN-1,2)/Delt_t)*h(NN-1)+(C1(NN,1)/Delt_t)*h(NN); +else + ARG4=C1(ML-1,2)/Delt_t; + ARG5=C1(ML,1)/Delt_t; + ARG6=C1(ML,2)/Delt_t; + + RHS(1)=-C7(1)+(C3(1,1)*P_g(1)+C3(1,2)*P_g(2))/Delt_t ... + -(C1(1,1)/Delt_t+C4(1,1))*hh(1)-(C1(1,2)/Delt_t+C4(1,2))*hh(2) ... + +(C1(1,1)/Delt_t)*h(1)+(C1(1,2)/Delt_t)*h(2); + for ML=2:NL + RHS(ML)=-C7(ML)+(C3(ML-1,2)*P_g(ML-1)+C3(ML,1)*P_g(ML)+C3(ML,2)*P_g(ML+1))/Delt_t... + -(ARG4+C4(ML-1,2))*hh(ML-1)-(ARG5+C4(ML,1))*hh(ML)-(ARG6+C4(ML,2))*hh(ML+1) ... + +ARG4*h(ML-1)+ARG5*h(ML)+ARG6*h(ML+1); + end + RHS(NN)=-C7(NN)+(C3(NN-1,2)*P_g(NN-1)+C3(NN,1)*P_g(NN))/Delt_t... + -(C1(NN-1,2)/Delt_t+C4(NN-1,2))*hh(NN-1)-(C1(NN,1)/Delt_t+C4(NN,1))*hh(NN) ... + +(C1(NN-1,2)/Delt_t)*h(NN-1)+(C1(NN,1)/Delt_t)*h(NN); +end + +for MN=1:NN + for ND=1:2 + C6(MN,ND)=C3(MN,ND)/Delt_t+C6(MN,ND); + end +end + +SAVE(1,1,3)=RHS(1); +SAVE(1,2,3)=C6(1,1); +SAVE(1,3,3)=C6(1,2); +SAVE(2,1,3)=RHS(NN); +SAVE(2,2,3)=C6(NN-1,2); +SAVE(2,3,3)=C6(NN,1); + diff --git a/src/Air_MAT.m b/src/Air_MAT.m new file mode 100644 index 00000000..83462997 --- /dev/null +++ b/src/Air_MAT.m @@ -0,0 +1,55 @@ +function [C1,C2,C3,C4,C4_a,C5,C5_a,C6,C6_a,C7]=Air_MAT(Cah,CaT,Caa,Kah,KaT,Kaa,Vah,VaT,Vaa,Cag,DeltZ,NL,NN) + +for MN=1:NN % Clean the space in C1-7 every iteration,otherwise, in *.PARM files, + for ND=1:2 % C1-7 will be mixed up with pre-storaged data, which will cause extremly crazy for computation, which exactly results in NAN. + C1(MN,ND)=0; + C7(MN)=0; + C4(MN,ND)=0; + C4_a(MN)=0; + C5_a(MN)=0; + C6_a(MN)=0; + C2(MN,ND)=0; + C3(MN,ND)=0; + C5(MN,ND)=0; + C6(MN,ND)=0; + end +end + +for ML=1:NL + C1(ML,1)=C1(ML,1)+Cah(ML,1)*DeltZ(ML)/2; + C1(ML+1,1)=C1(ML+1,1)+Cah(ML,2)*DeltZ(ML)/2; + + C2(ML,1)=C2(ML,1)+CaT(ML,1)*DeltZ(ML)/2; + C2(ML+1,1)=C2(ML+1,1)+CaT(ML,2)*DeltZ(ML)/2; + + C3(ML,1)=C3(ML,1)+Caa(ML,1)*DeltZ(ML)/2; + C3(ML+1,1)=C3(ML+1,1)+Caa(ML,2)*DeltZ(ML)/2; + + C4ARG1=(Kah(ML,1)+Kah(ML,2))/(2*DeltZ(ML)); + C4ARG2_1=Vah(ML,1)/3+Vah(ML,2)/6; + C4ARG2_2=Vah(ML,1)/6+Vah(ML,2)/3; + C4(ML,1)=C4(ML,1)+C4ARG1-C4ARG2_1; + C4(ML,2)=C4(ML,2)-C4ARG1-C4ARG2_2; + C4(ML+1,1)=C4(ML+1,1)+C4ARG1+C4ARG2_2; + C4_a(ML)=-C4ARG1+C4ARG2_1; + + C5ARG1=(KaT(ML,1)+KaT(ML,2))/(2*DeltZ(ML)); + C5ARG2_1=VaT(ML,1)/3+VaT(ML,2)/6; + C5ARG2_2=VaT(ML,1)/6+VaT(ML,2)/3; + C5(ML,1)=C5(ML,1)+C5ARG1-C5ARG2_1; + C5(ML,2)=C5(ML,2)-C5ARG1-C5ARG2_2; + C5(ML+1,1)=C5(ML+1,1)+C5ARG1+C5ARG2_2; + C5_a(ML)=-C5ARG1+C5ARG2_1; + + C6ARG1=(Kaa(ML,1)+Kaa(ML,2))/(2*DeltZ(ML)); + C6ARG2_1=Vaa(ML,1)/3+Vaa(ML,2)/6; + C6ARG2_2=Vaa(ML,1)/6+Vaa(ML,2)/3; + C6(ML,1)=C6(ML,1)+C6ARG1-C6ARG2_1; + C6(ML,2)=C6(ML,2)-C6ARG1-C6ARG2_2; + C6(ML+1,1)=C6(ML+1,1)+C6ARG1+C6ARG2_2; + C6_a(ML)=-C6ARG1+C6ARG2_1; + + C7ARG=(Cag(ML,1)+Cag(ML,2))/2; + C7(ML)=C7(ML)-C7ARG; + C7(ML+1)=C7(ML+1)+C7ARG; +end \ No newline at end of file diff --git a/src/Air_Solve.m b/src/Air_Solve.m new file mode 100644 index 00000000..a6ce4c9e --- /dev/null +++ b/src/Air_Solve.m @@ -0,0 +1,17 @@ +function [C6,P_gg,RHS]=Air_Solve(C6,NN,NL,C6_a,RHS) + + +RHS(1)=RHS(1)/C6(1,1); + +for ML=2:NN + C6(ML,1)=C6(ML,1)-C6_a(ML-1)*C6(ML-1,2)/C6(ML-1,1); + RHS(ML)=(RHS(ML)-C6_a(ML-1)*RHS(ML-1))/C6(ML,1); +end + +for ML=NL:-1:1 + RHS(ML)=RHS(ML)-C6(ML,2)*RHS(ML+1)/C6(ML,1); +end + +for MN=1:NN + P_gg(MN)=RHS(MN); +end \ No newline at end of file diff --git a/src/Air_sub.m b/src/Air_sub.m new file mode 100644 index 00000000..79b01f32 --- /dev/null +++ b/src/Air_sub.m @@ -0,0 +1,21 @@ +function Air_sub +global Cah CaT Caa Kah KaT Kaa Vah VaT Vaa Cag Xah XaT Xaa RHODA Hc +global POR D_V D_Ta D_Vg KL_T KL_h Gamma_w V_A RHOL +global QL Theta_LL hh TT DeltZ DTheta_LLT QL_h QL_T +global NL DTheta_LLh P_gg Beta_g J +global KLhBAR KLTBAR DhDZ DTDZ DPgDZ DTDBAR KLa_Switch +global C1 C2 C3 C4 C5 C6 C7 C4_a C5_a C6_a NN +global Delt_t RHS T h P_g SAVE Thmrlefc +global BtmPg TopPg KT +global NBCPB BCPB NBCP BCP + + +[Cah,CaT,Caa,Kah,KaT,Kaa,Vah,VaT,Vaa,Cag,QL,QL_h,QL_T,KLhBAR,KLTBAR,DhDZ,DTDZ,DPgDZ,DTDBAR]=AirPARM(NL,hh,TT,Theta_LL,DeltZ,DTheta_LLh,DTheta_LLT,POR,RHOL,V_A,KL_h,D_Ta,KL_T,D_V,D_Vg,P_gg,Beta_g,J,Gamma_w,KLa_Switch,Xah,XaT,Xaa,RHODA,Hc,KLhBAR,KLTBAR,DhDZ,DTDZ,DPgDZ,DTDBAR); + +[C1,C2,C3,C4,C4_a,C5,C5_a,C6,C6_a,C7]=Air_MAT(Cah,CaT,Caa,Kah,KaT,Kaa,Vah,VaT,Vaa,Cag,DeltZ,NL,NN); + +[RHS,C6,SAVE]=Air_EQ(C1,C2,C3,C4,C4_a,C5,C5_a,C6,C7,NL,NN,Delt_t,T,TT,h,hh,P_g,Thmrlefc); + +[RHS,C6,C6_a]=Air_BC(RHS,KT,NN,BtmPg,TopPg,NBCPB,BCPB,NBCP,BCP,C6,C6_a); + +[C6,P_gg,RHS]=Air_Solve(C6,NN,NL,C6_a,RHS); \ No newline at end of file diff --git a/src/BSM.m b/src/BSM.m new file mode 100644 index 00000000..452a26b8 --- /dev/null +++ b/src/BSM.m @@ -0,0 +1,117 @@ +function rwet = BSM(soilpar,spec,emp) + +% Spectral parameters + +%wl = spec.wl; % wavelengths +GSV = spec.GSV; % Global Soil Vectors spectra (nwl * 3) +kw = spec.Kw; % water absorption spectrum +nw = spec.nw; % water refraction index spectrum + +% Soil parameters + +B = soilpar.BSMBrightness; % soil brightness (range = 0 - 0.9) +lat = soilpar.BSMlat; % spectral shape latitude (range = 20 - 40 deg) +lon = soilpar.BSMlon; % spectral shape longitude (range = 45 - 65 deg) +SMp = soilpar.SMC * 100; % soil moisture volume percentage (5 - 55) + +% Empirical parameters + +SMC = emp.SMC; % soil moisture capacity parameter +film = emp.film; % single water film optical thickness + +f1 = B * sind(lat); +f2 = B * cosd(lat) * sind(lon); +f3 = B * cosd(lat) * cosd(lon); + +rdry = f1 * GSV(:,1) + f2 * GSV(:,2) + f3 * GSV(:,3); + +% Soil moisture effect + +rwet = soilwat(rdry,nw,kw,SMp,SMC,film); + + +function rwet = soilwat(rdry,nw,kw,SMp,SMC,deleff) + + % In this model it is assumed that the water film area is built up + % according to a Poisson process. The fractional areas are as follows: + + % P(0) = dry soil area + % P(1) = single water film area + % P(2) = double water film area + % ... + % et cetera + + % The fractional areas are given by P(k) = mu^k * exp(-mu) / k! + + % For water films of multiple thickness only the transmission loss due + % to water absorption is modified, since surface reflectance effects + % are not influenced by the thickness of the film + + % Input parameters: + + % rdry = dry soil reflectance [NW,1] + % nw = refraction index of water [NW,1] + % kw = absorption coefficient of water [NW,1] + % SMp = soil moisture volume percentage [1,NS] + % SMC = soil moisture capacity (recommended 0.25) [1,1] + % deleff = effective optical thickness of single water film [1,1] + % (recommended 0.015) + + % Output + + % rwet = wet soil spectra [NW,NS] + + % If SMp is given as a row-vector and rdry, nw, kw as column vectors + % of the same size (NW, # of wavelengths), then the output is a matrix + % of spectra for the different SMp, where each column is a spectrum + + % Wout Verhoef + % Version 1.0 + % September 2012 + + %---------------------------------------------------------------------% + + % two-way transmittance of elementary water film + + tw = exp(-kw * deleff); + + % Lekner & Dorf (1988) modified soil background reflectance + % for soil refraction index = 2.0; uses the tav-function of PROSPECT + + rbac = 1 - (1-rdry) .* (rdry .* equations.tav(90,2.0./nw) / equations.tav(90,2.0) + 1-rdry); + + % total reflectance at bottom of water film surface + + p = 1 - equations.tav(90,nw) ./ nw.^2; + + % reflectance of water film top surface, use 40 degrees incidence angle, + % like in PROSPECT + + Rw = 1 - equations.tav(40,nw); + + % additional reflectance of single water film (Lekner & Dorf, 1988) + % two-way transmission loss by water absorption is not included here + % yet + + Radd = (1-Rw) .* (1-p) .* rbac ./(1 - p .* rbac); + + % Mu-parameter of Poisson distribution + + mu = (SMp - 5)/ SMC; + + % fraction of dry soil area + + fdry = exp(-mu); + + % contribution due to total water film area of single or + % multiple thickness + + fmul = (exp(tw * mu) - 1) * diag(fdry); + + % reflectance spectra of wet soil + + rwet = rdry * fdry + Rw * (1 - fdry) + Radd * ones(size(mu)) .* fmul; + +return + + diff --git a/src/CnvrgnCHK.m b/src/CnvrgnCHK.m new file mode 100644 index 00000000..483a9f65 --- /dev/null +++ b/src/CnvrgnCHK.m @@ -0,0 +1,82 @@ +function [KT,TIME,Delt_t,IRPT1,IRPT2,tS]=CnvrgnCHK(xERR,hERR,TERR,Theta_LL,Theta_L,hh,h,TT,T,KT,TIME,Delt_t,NL,NN,Thmrlefc,NBCh,NBChB,NBCT,NBCTB,tS) + +global Delt_t0 +IRPT1=0; +DxMAX=0; +for ML=1:NL + for ND=1:2 + if NBCh==1 && ML==NL && ND==2 + continue + elseif NBChB==1 && ML==1 && ND==1 + continue + else + DxMAX=max(abs(Theta_LL(ML,ND)-Theta_L(ML,ND)),DxMAX); + end + end +end + +DhMAX=0; +for MN=1:NN + if NBCh==1 && ML==NL && ND==2 + continue + elseif NBChB==1 && ML==1 && ND==1 + continue + else + DhMAX=max(abs(hh(MN)-h(MN)),DhMAX); + end +end + +if Thmrlefc==1 + DTMAX=0; + for MN=1:NN + if NBCT==1 && MN==NN + continue + elseif NBCTB==1 && MN==1 + continue + else + DTMAX=max(abs(TT(MN)-T(MN)),DTMAX); + end + end +end + +IRPT2=0; + +FAC1=min(xERR/DxMAX,hERR/DhMAX); +if Thmrlefc==1 + FAC=min(FAC1, TERR/DTMAX);% +else + FAC=FAC1; +end + +if FAC>6 + FAC=6; + Delt_t0=Delt_t; + Delt_t=Delt_t*FAC; + if Delt_t>1800 %original 1800s + Delt_t=1800; + end + return +elseif FAC<0.25 + IRPT2=1; % IRPT2=2, means the time step will be decreased; + % The time step number. Repeat last time step due to excessive change of state. + TIME=TIME-Delt_t; % Time released since the start of simulation. + KT=KT-1; + Delt_t=Delt_t*FAC; + tS=tS+1; + + if Delt_t<1.0e-5 + warning ('Delt_t is getting extremly small.') + end + +else + Delt_t0=Delt_t; + Delt_t=Delt_t*FAC; + if Delt_t>1800 + Delt_t=1800; + end + return +end + + + + diff --git a/src/CondL_T.m b/src/CondL_T.m new file mode 100644 index 00000000..467d31ba --- /dev/null +++ b/src/CondL_T.m @@ -0,0 +1,16 @@ +function [KL_T]=CondL_T(NL) + +MN=0; +for ML=1:NL + for ND=1:2 + MN=ML+ND-1; +% if KLT_Switch==1 + KL_T(ML,ND)=0; %KL_h(ML,ND)*((hh(MN)*GWT)/Gamma0)*(-0.1425-4.76*10^(-4)*TT(MN)); %(50+2.75*TT(MN))/((50+2.75*20));% +% else +% KL_T(ML,ND)=0; +% end + end +end + +%%%%%%%% Unit of KL_T is determined by KL_h, which is subsequently %%%%%%%% +%%%%%%%% determined by Ks set at the beginning. %%%%%%%%%%%%%%%%%%%%%%%%%%% \ No newline at end of file diff --git a/src/CondL_Tdisp.m b/src/CondL_Tdisp.m new file mode 100644 index 00000000..a574340f --- /dev/null +++ b/src/CondL_Tdisp.m @@ -0,0 +1,40 @@ +function [W,WW,MU_W,D_Ta]=CondL_Tdisp(POR,Theta_LL,Theta_L,SSUR,RHO_bulk,RHOL,TT,Theta_s,h,hh,W_Chg,NL,nD,J,Delt_t,Theta_g,KLT_Switch) + +MU_W0=2.4152*10^(-4); %(g.cm^-1.s^-1) +MU1=4742.8; %(J.mol^-1) +b=4*10^(-6); %(cm) +W0=10^3; %(J.g^-1) + +MN=0; +for ML=1:NL + for ND=1:nD + MN=ML+ND-1; + if W_Chg==0 + W(ML,ND)=0; + WW(ML,ND)=0; + WARG=Theta_LL(ML,ND)*10^7/SSUR; + if WARG<80 + W(ML,ND)=W0*exp(-WARG); + WW(ML,ND)=W0*exp(-WARG); + end + else + W(ML,ND)=-0.2932*h(MN)/1000;%0;% %%% J.g^-1---Original J.Kg^-1, now is divided by 1000. + WW(ML,ND)=-0.2932*hh(MN)/1000;%0;% + end + f0(ML,ND)=Theta_g(ML,ND)^(7/3)/Theta_s(J)^2; %Theta_g(ML,ND)^0.67; + H_W(ML,ND)=RHOL*WW(ML,ND)*(Theta_LL(ML,ND)-Theta_L(ML,ND))/((SSUR/RHO_bulk)*Delt_t); %1e3; % 1e-4J cm-2---> g s-2 ; SSUR and RHO_bulk could also be set as an array to consider more than one soil type; + MU_W(ML,ND)=MU_W0*exp(MU1/(8.31441*(TT(MN)+133.3))); + L_WT(ML,ND)=f0(ML,ND)*1e7*1.5550e-13*POR(J)*H_W(ML,ND)/(b*MU_W(ML,ND)); % kg¡¤m^-1¡¤s^-1 --> 10 g.cm^-1.s^-1; J.cm^-2---> kg.m^2.s^-2.cm^-2--> 1e7g.cm^2.s^-2.cm^-2 + if KLT_Switch==1 + D_Ta(ML,ND)=L_WT(ML,ND)/(RHOL*(TT(MN)+273.15));%0; %0;%0; % + else + D_Ta(ML,ND)=0; + end + end +end +%% Tortuosity Factor is a reverse of the tortuosity. In "L_WT", tortuosity should be used. That is why "f0" is in the numerator.%%% +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% NOTICE: f0 in L_WT has been changed as 1.5 %%%%%%%%%%% +%%%%%% kg.m^2.s^-2.cm^-2.kg.m^-3 --> 1e7g.cm^2.s^-2.cm^-2.g.cm^-3 +%%%%%% Unit of L_WT IS (kg¡¤m^-1¡¤s^-1)=-------------------------- cm^2=;(1.5548e-013 cm^2); Converting meter to centimeter here by multipling UnitC +%%%%%% m. kg.m^-1.s^-1 --> cm. g.cm^-1.s^-1 +%%%%%% Please note that the Rv in MU_W should be 8.31441 J/mol.K. %%%%%%%% \ No newline at end of file diff --git a/src/CondL_h.m b/src/CondL_h.m new file mode 100644 index 00000000..b56e6948 --- /dev/null +++ b/src/CondL_h.m @@ -0,0 +1,52 @@ +function [Theta_LL,Se,KL_h,DTheta_LLh,J,hh]=CondL_h(Theta_r,Theta_s,Alpha,hh,n,m,Ks,NL,Theta_L,h,IS,KIT,TT,Thmrlefc,CKTN,POR,J) + +% PRN The lowest suction head (The maximum value of matric head,considering +% the negative sign before them. The absolute value of which is smallest) at which soil remains saturated. + +% PRN=-1e-6; + + MN=0; + for ML=1:NL + J=IS(ML); + for ND=1:2 + MN=ML+ND-1; + + if hh(MN)>=-1e-6 + Theta_LL(ML,ND)=Theta_s(J); + hh(MN)=-1e-6; + DTheta_LLh(ML,ND)=0; + Se(ML,ND)=1; + elseif hh(MN)<=-1e5 + Theta_LL(ML,ND)=Theta_r(J); + hh(MN)=-1e5; + DTheta_LLh(ML,ND)=0; + Se(ML,ND)=0; + else + Theta_LL(ML,ND)=Theta_r(J)+(Theta_s(J)-Theta_r(J))/(1+abs(Alpha(J)*hh(MN))^n(J))^m(J); + + if Thmrlefc + DTheta_LLh(ML,ND)=(Theta_s(J)-Theta_r(J))*Alpha(J)*n(J)*abs(Alpha(J)*hh(MN))^(n(J)-1)*(-m(J))*(1+abs(Alpha(J)*hh(MN))^n(J))^(-m(J)-1); + else + if abs(hh(MN)-h(MN))<1e-3 + DThehta_LL(ML,ND)=(Theta_s(J)-Theta_r(J))*Alpha(J)*n(J)*abs(Alpha(J)*hh(MN))^(n(J)-1)*(-m(J))*(1+abs(Alpha(J)*hh(MN))^n(J))^(-m(J)-1); + else + DTheta_LLh(ML,ND)=(Theta_LL(ML,ND)-Theta_L(ML,ND))/(hh(MN)-h(MN)); + end + end + + Se(ML,ND)=Theta_LL(ML,ND)/POR(J); + end + +% if KIT + CKT(MN)=CKTN/(50+2.575*TT(MN)); + KL_h(ML,ND)=CKT(MN)*Ks(J)*(Se(ML,ND)^(0.5))*(1-(1-Se(ML,ND)^(1/m(J)))^m(J))^2; +% else +% KL_h(ML,ND)=0; +% end + + end + end + +%%%%%%%%% Unit of KL_h is determined by Ks, which would be given at the%%%% +%%%%%%%%% beginning.Import thing is to keep the unit of matric head hh(MN) +%%%%%%%%% as 'cm'.%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \ No newline at end of file diff --git a/src/CondT_coeff.m b/src/CondT_coeff.m new file mode 100644 index 00000000..60987bfe --- /dev/null +++ b/src/CondT_coeff.m @@ -0,0 +1,32 @@ +function [c_unsat,Lambda_eff]=CondT_coeff(Theta_LL,Lambda1,Lambda2,Lambda3,RHO_bulk,Theta_g,RHODA,RHOV,c_a,c_V,c_L,NL,nD,ThmrlCondCap,~,~) + +global HCAP TCON SF TCA GA1 GA2 GB1 GB2 HCD +global ZETA0 CON0 PS1 PS2 ETCON EHCAP ZETA XWILT XK TT +global MN ML ND IS J POR DRHOVT L D_A Theta_V + +if ThmrlCondCap==1 + + [ETCON,EHCAP,ZETA,J]=EfeCapCond(HCAP,TCON,SF,TCA,GA1,GA2,GB1,GB2,HCD,ZETA0,CON0,PS1,PS2,XWILT,XK,TT,NL,IS,J,POR,Theta_LL,DRHOVT,L,D_A,RHOV,Theta_V); + for ML=1:NL + for ND=1:nD + Lambda_eff(ML,ND)=ETCON(ML,ND); + c_unsat(ML,ND)=EHCAP(ML,ND); + end + end +else + MN=0; + for ML=1:NL + for ND=1:nD + MN=ML+ND-1; + Lambda_eff(ML,ND)=Lambda1+Lambda2*Theta_LL(ML,ND)+Lambda3*Theta_LL(ML,ND)^0.5; %3.6*0.001*4.182; % It is possible to add the dispersion effect here to consider the heat dispersion. + + c_unsat(ML,ND)= 837*RHO_bulk/1000+Theta_LL(ML,ND)*c_L+Theta_g(ML,ND)*(RHODA(MN)*c_a+RHOV(MN)*c_V);%9.79*0.1*4.182;% + end + end +end + + +%%%%% Unit of Lambda_eff is (J.m^-1.s^-1.Cels^-1), While c_unsat is (J.m^-3.Cels^-1) +%%%%% UnitC needs to be used here to convert 'm' to 'cm' . 837 in J.kg^-1.Cels^-1. RHO_bulk in kg.m^-3 %%%%% +%%%%% c_a, c_v,would be in J.g^-1.Cels^-1 as showed in +%%%%% globalization. RHOV and RHODA would be in g.cm^-3 \ No newline at end of file diff --git a/src/CondV_DE.m b/src/CondV_DE.m new file mode 100644 index 00000000..5d17c30c --- /dev/null +++ b/src/CondV_DE.m @@ -0,0 +1,33 @@ +function [D_V,Eta,D_A]=CondV_DE(Theta_LL,TT,fc,Theta_s,NL,nD,J,Theta_g,POR,ThmrlCondCap,ZETA,XK,DVT_Switch) + +MN=0; +for ML=1:NL + for ND=1:nD + MN=ML+ND-1; + + if ThmrlCondCap + if Theta_LL(ML,ND) 1e4*cm2/s + Eta(ML,ND)=8+3*Theta_LL(ML,ND)/Theta_s(J)-7*exp(-((1+2.6/sqrt(fc))*Theta_LL(ML,ND)/Theta_s(J))^3); + end + + D_V(ML,ND)=f0(ML,ND)*Theta_g(ML,ND)*D_A(MN); + + end +end + +%%%%%%%%%%%%% With UnitC^2, m^2.s^-1 would be converted as cm^2.s^-1 %%%%%%%%%%%%% diff --git a/src/CondV_DVg.m b/src/CondV_DVg.m new file mode 100644 index 00000000..ffc9cb4f --- /dev/null +++ b/src/CondV_DVg.m @@ -0,0 +1,32 @@ +function [D_Vg,V_A,Beta_g,DPgDZ,Beta_gBAR,Alpha_LgBAR]=CondV_DVg(P_gg,Theta_g,Sa,V_A,k_g,MU_a,DeltZ,Alpha_Lg,KaT_Switch,Theta_s,Se,NL,J,DPgDZ,Beta_gBAR,Alpha_LgBAR,Beta_g) + +MN=0; +for ML=1:NL + for ND=1:2 + MN=ML+ND-1; + Sa(ML,ND)=1-Se(ML,ND); + f0(ML,ND)=Theta_g(ML,ND)^(7/3)/Theta_s(J)^2; %Theta_g(ML,ND)^0.67; + Beta_g(ML,ND)=(k_g(ML,ND)/MU_a); + Alpha_Lg(ML,ND)=0.078*(13.6-16*Sa(ML,ND)+3.4*Sa(ML,ND)^5)*100; % + end +end + +for ML=1:NL + Beta_gBAR(ML)=(Beta_g(ML,1)+Beta_g(ML,2))/2; + DPgDZ(ML)=(P_gg(ML+1)-P_gg(ML))/DeltZ(ML); + Alpha_LgBAR(ML)=(Alpha_Lg(ML,1)+Alpha_Lg(ML,2))/2; +end + +for ML=1:NL + V_A(ML)=-Beta_gBAR(ML)*DPgDZ(ML); %0; % + if KaT_Switch==1 + D_Vg(ML)=Alpha_LgBAR(ML)*abs(V_A(ML)); %0; %0; % + else + D_Vg(ML)=0; + end +end + +%%%%%%%%%%%% Unit of kg is cm^2, MU_a is g.cm^-1.s^-1,V_A is cm.s^-1, D_Vg +%%%%%%%%%%%% is cm^2.s^-1, The unit of soil air pressure should be Pa=kg.m^-1.s^-2=10g.cm^-1.s^-2 %%%%%%%%%%%%% +%%%%%%%%%%%% Notice that '10'in V_A is because Pa needs to be converted as10g.cm^-1.s^-2; has been done in the StarInit subroutine %%%%%%%%%%%%% +%%%%%%%%%%%% MU_a's unit has been changed %%%%%%%%% \ No newline at end of file diff --git a/src/Condg_k_g.m b/src/Condg_k_g.m new file mode 100644 index 00000000..3b735a92 --- /dev/null +++ b/src/Condg_k_g.m @@ -0,0 +1,12 @@ +function [k_g]=Condg_k_g(POR,NL,J,m,Theta_g,g,MU_W,Ks,RHOL) + +for ML=1:NL + for ND=1:2 + Sa(ML,ND)=Theta_g(ML,ND)/POR(J); + k_g(ML,ND)=Ks(J)*MU_W(ML,ND)*(1-Sa(ML,ND)^0.5)*(1-(1-(1-Sa(ML,ND)^(1/m(J))))^m(J))^2/(g*RHOL); + end +end + + +%%%%%% Unit of k_g is m^2 , with UnitC^2, unit has been converted as cm^2 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%%%%%% 10^(-12)is used to convert the micrometer(¦Ìm) to meter(m)%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% diff --git a/src/Constants.m b/src/Constants.m new file mode 100644 index 00000000..eef5e88f --- /dev/null +++ b/src/Constants.m @@ -0,0 +1,419 @@ +% function Constants +global DeltZ Delt_t ML NS mL mN nD NL NN SAVE Tot_Depth +global xERR hERR TERR PERR tS +global KT TIME Delt_t0 DURTN TEND NIT KIT Nmsrmn Eqlspace h_SUR Msrmn_Fitting +global Msr_Mois Msr_Temp Msr_Time +global Ksoil Rl SMC Ztot DeltZ_R Theta_o rroot frac bbx wfrac RWUtot Rls Tatot LR PSItot sfactortot + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +%%%%%%% The time and domain information setting. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +KIT=0; % KIT is used to count the number of iteration in a time step; +NIT=60; % Desirable number of iterations in a time step; +Nmsrmn=17568; %Nmsrmn=2568*100; Here, it is made as big as possible, in case a long simulation period containing many time step is defined. + +DURTN=60*30*17568; % Duration of simulation period; +KT=0; % Number of time steps; +TIME=0; % Time of simulation released; + + +TEND=TIME+DURTN; % Time to be reached at the end of simulation period; +Delt_t=1800; % Duration of time step [Unit of second] +Delt_t0=Delt_t; % Duration of last time step; +tS=DURTN/Delt_t; % Is the tS(time step) needed to be added with 1? + % Cause the start of simulation period is from 0mins, while the input data start from 30mins. + +xERR=0.02; % Maximum desirable change of moisture content; +hERR=0.1e08; % Maximum desirable change of matric potential; +TERR=2; % Maximum desirable change of temperature; +PERR=5000; % Maximum desirable change of soil air pressure (Pa,kg.m^-1.s^-1); + +Tot_Depth=500; % Unit is cm. it should be usually bigger than 0.5m. Otherwise, + % the DeltZ would be reset in 50cm by hand; +NL=100; +Eqlspace=0; % Indicator for deciding is the space step equal or not; + +if ~Eqlspace + run Dtrmn_Z % Determination of NL, the number of elments; +else + for ML=1:NL + DeltZ(ML)=Tot_Depth/NL; + end +end + +NN=NL+1; % Number of nodes; +mN=NN+1; +mL=NL+1; % Number of elements. Prevending the exceeds of size of arraies; +nD=2; +NS=1; % Number of soil types; +SAVE=zeros(3,3,3); % Arraies for calculating boundary flux; +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +global h_TE +global W_Chg +global l CKTN +global RHOL SSUR RHO_bulk Rv g RDA +global KL_h KL_T D_Ta +global Theta_L Theta_LL Se h hh T TT Theta_V DTheta_LLh +global W WW MU_W f0 L_WT +global DhT +global GWT Gamma0 MU_W0 MU1 b W0 Gamma_w +global Chh ChT Khh KhT Kha Vvh VvT Chg +global C1 C2 C3 C4 C5 C6 C7 C9 +global QL QL_D QL_disp RHS +global HR RHOV_s RHOV DRHOV_sT DRHOVh DRHOVT +global RHODA DRHODAt DRHODAz Xaa XaT Xah +global D_Vg D_V D_A +global k_g Sa V_A Alpha_Lg POR_C Eta +global P_g P_gg Theta_g P_g0 Beta_g +global MU_a fc Unit_C Hc UnitC +global Cah CaT Caa Kah KaT Kaa Vah VaT Vaa Cag +global Lambda1 Lambda2 Lambda3 c_L c_a c_V L0 +global Lambda_eff c_unsat L LL Tr +global CTh CTT CTa KTh KTT KTa VTT VTh VTa CTg +global Kcvh KcvT Kcva Ccvh CcvT Kcah KcaT Kcaa Ccah CcaT Ccaa + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% Meteorological Forcing Information Variables +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +global MO Ta U Ts Zeta_MO % U_wind is the mean wind speed at height z_ref (m¡¤s^-1), U is the wind speed at each time step. +global Precip SH HR_a UseTs_msrmn % Notice that Evap and Precip have only one value for each time step. Precip needs to be measured in advance as the input. +global Gsc Sigma_E +global Rns Rnl +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% Variables information for soil air pressure propagation +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +global TopPg + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% Fluxes information with different mechanisms +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +global QL_Dts QL_dispts QLts QV_Dts QV_Ats QV_dispts QVts QA_Dts QA_Ats QA_dispts QAts +global QV_D QV_A QV_disp QA_D QA_A QA_disp QL_T QL_h + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% Variable information for updating the state variables +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +global hOLD TOLD P_gOLD J +global porosity SaturatedMC ResidualMC SaturatedK Coefficient_n Coefficient_Alpha +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% Variables information for initialization subroutine +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +global InitND1 InitND2 InitND3 InitND4 InitND5 BtmT BtmX %Preset the measured depth to get the initial T, h by interpolation method. +global InitT0 InitT1 InitT2 InitT3 InitT4 InitT5 +global InitX0 InitX1 InitX2 InitX3 InitX4 InitX5 +global Thmrlefc hThmrl Hystrs Soilairefc + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% Effective Thermal conductivity and capacity variables +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +global EHCAP ThmrlCondCap Evaptranp_Cal +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% Variables information for boundary condition settings +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +global DVhSUM DVTSUM DVaSUM KahSUM KaTSUM KaaSUM KLhhSUM KLTTSUM +DVhSUM=zeros(Nmsrmn/2,1);DVTSUM=zeros(Nmsrmn/2,1); DVaSUM=zeros(Nmsrmn/2,1); +KahSUM=zeros(Nmsrmn/2,1); KaTSUM=zeros(Nmsrmn/2,1); KaaSUM=zeros(Nmsrmn/2,1); +KLhhSUM=zeros(Nmsrmn/2,1); KLTTSUM=zeros(Nmsrmn/2,1); + +%> NBCh Indicator for type of surface boundary condition on mass euqation to be applied; +%> "1"--Specified matric head; +%> "2"--Specified potential moisture flux (potential evaporation rate of precipitation rate); +%> "3"--Specified atmospheric forcing; +%> NBCT Indicator for type of surface boundary condtion on energy equation to be applied; +%> "1"--Specified temperature; +%> "2"--Specified heat flux; +% "3"--Specified atmospheric forcing; +%> NBCP Indicator for type of surface boundary condition on dry air equation to be applied; +%> "1"--Specified atmospheric pressure; +%> "2"--Specified atmospheric forcing (Measured atmospheric pressure data); +%> BCh Value of specified matric head (if NBCh=1) or specified potential moisture flux (if NBCh=2) at surface; +%> BChB The same as BCh but at the bottom of column; +%> BCT Value of specified temperature (if NBCT=1) or specified head flux (if NBCT=2) at surface; +%> BCTB The same as BCT but at the bottom of column; +%> BCPB Value of specified atmospheric pressure; +%> BCP The same as BCP but at the bottom of column; +%> hN Specified value of matric head when a fist-type BC is used; +%> NBChB Type of boundary condition on matric head at bottom of column; +%> "1"--Specified head of BChB at bottom; +%> "2"--Specified moisture flux of BChB; +%> "3"--Zero matric head gradient at bottom(Gravity drainage); +%> NBCTB Type of boundary condition on temperature at bottom of column; +%> "1"--Specified temperature BCTB at bottom; +%> "2"--Specified heat flux BCTB at bottom; +%> "3"--Zero temperature gradient at bottom (advection only); +%> NBCPB Type of boundary condition on soil air pressure; +%> "1"--Specified dry air flux BCPB at bottom; +%> "2"--Zero soil air pressure gradient at bottom; +%> NBChh Type of surface BC actually applied on a particular trial of a time step when NBCh euqals 2 or 3; +%> "1"--Specified matric head; +%> "2"--Specified actual flux; +%> DSTOR Depth of depression storage at end of current time step; +%> DSTOR0 Depth of depression storage at start of current time step; +%> DSTMAX Depression storage capacity; +%> EXCESS Excess of available water over infiltration rate for current time step,expressed as a rate; +%> AVAIL Maximum rate at which water can be supplied to the soil from above during the current time step; +%> +%> +global alpha_h bx Srt rwuef Ts_msr + +alpha_h=zeros(mL,nD); %root water uptake +bx=zeros(NL,1); +bbx=zeros(NL,1); +Srt=zeros(mL,nD); + +DTheta_LLh=zeros(mL,nD); +KL_h=zeros(mL,nD); % The hydraulic conductivity(m¡¤s^-1); +KL_T=zeros(mL,nD); % The conductivity controlled by thermal gradient(m^2¡¤Cels^-1¡¤s^-1); +D_Ta=zeros(mL,nD); % The thermal dispersivity for soil water (m^2¡¤Cels^-1¡¤s^-1); +Theta_L=zeros(mL,nD); % The soil moisture at the start of current time step; +Theta_LL=zeros(mL,nD); % The soil moisture at the end of current time step; +Se=zeros(mL,nD); % The saturation degree of soil moisture; +h=zeros(mN,1); % The matric head at the start of current time step; +hh=zeros(mN,1); % The matric head at the end of current time step; +T=zeros(mN,1); % The soil temperature at the start of current time step; +TT=zeros(mN,1); % The soil temperature at the end of current time step; +Theta_V=zeros(mL,nD); % Volumetric gas content; +W=zeros(mL,nD); % Differential heat of wetting at the start of current time step(J¡¤kg^-1); +WW=zeros(mL,nD); % Differential heat of wetting at the end of current time step(J¡¤kg^-1); + % Integral heat of wetting in individual time step(J¡¤m^-2); %%%%%%%%%%%%%%% Notice: the formulation of this in 'CondL_Tdisp' is not a sure. %%%%%%%%%%%%%% +MU_W=zeros(mL,nD); % Visocity of water(kg¡¤m^?6?1¡¤s^?6?1); +f0=zeros(mL,nD); % Tortusity factor [Millington and Quirk (1961)]; kg.m^2.s^-2.m^-2.kg.m^-3 +L_WT=zeros(mL,nD); % Liquid dispersion factor in Thermal dispersivity(kg¡¤m^-1¡¤s^-1)=-------------------------- m^2 (1.5548e-013 m^2); +DhT=zeros(mN,1); % Difference of matric head with respect to temperature; m. kg.m^-1.s^-1 +RHS=zeros(mN,1); % The right hand side part of equations in '*_EQ' subroutine; +EHCAP=zeros(mL,nD); % Effective heat capacity; +Chh=zeros(mL,nD); % Storage coefficients in moisture mass conservation equation related to matric head; +ChT=zeros(mL,nD); % Storage coefficients in moisture mass conservation equation related to temperature; +Khh=zeros(mL,nD); % Conduction coefficients in moisture mass conservation equation related to matric head; +KhT=zeros(mL,nD); % Conduction coefficients in moisture mass conservation equation related to temperature; +Kha=zeros(mL,nD); % Conduction coefficients in moisture mass conservation equation related to soil air pressure; +Vvh=zeros(mL,nD); % Conduction coefficients in moisture mass conservation equation related to matric head; +VvT=zeros(mL,nD); % Conduction coefficients in moisture mass conservation equation related tempearture; +Chg=zeros(mL,nD); % Gravity coefficients in moisture mass conservation equation; +C1=zeros(mL,nD); % The coefficients for storage term related to matric head; +C2=zeros(mL,nD); % The coefficients for storage term related to tempearture; +C3=zeros(mL,nD); % Storage term coefficients related to soil air pressure; +C4=zeros(mL,nD); % Conductivity term coefficients related to matric head; +C5=zeros(mL,nD); % Conductivity term coefficients related to temperature; +C6=zeros(mL,nD); % Conductivity term coefficients related to soil air pressure; +C7=zeros(mN,1); % Gravity term coefficients; +C9=zeros(mN,1); % root water uptake coefficients; +QL=zeros(mL,nD); % Soil moisture mass flux (kg¡¤m^-2¡¤s^-1); +QL_D=zeros(mL,nD); % Convective moisturemass flux (kg¡¤m^-2¡¤s^-1); +QL_disp=zeros(mL,nD); % Dispersive moisture mass flux (kg¡¤m^-2¡¤s^-1); +QL_h=zeros(mL,nD); % potential driven moisture mass flux (kg¡¤m^-2¡¤s^-1); +QL_T=zeros(mL,nD); % temperature driven moisture mass flux (kg¡¤m^-2¡¤s^-1); +HR=zeros(mN,1); % The relative humidity in soil pores, used for calculatin the vapor density; +RHOV_s=zeros(mN,1); % Saturated vapor density in soil pores (kg¡¤m^-3); +RHOV=zeros(mN,1); % Vapor density in soil pores (kg¡¤m^-3); +DRHOV_sT=zeros(mN,1); % Derivative of saturated vapor density with respect to temperature; +DRHOVh=zeros(mN,1); % Derivative of vapor density with respect to matric head; +DRHOVT=zeros(mN,1); % Derivative of vapor density with respect to temperature; +RHODA=zeros(mN,1); % Dry air density in soil pores(kg¡¤m^-3); +DRHODAz=zeros(mN,1); % Derivative of dry air density with respect to distance; +DRHODAt=zeros(mN,1); % Derivative of dry air density with respect to time; +Xaa=zeros(mN,1); % Coefficients of derivative of dry air density with respect to temperature and matric head; +XaT=zeros(mN,1); % Coefficients of derivative of dry air density with respect to temperature and matric head; +Xah=zeros(mN,1); % Coefficients of derivative of dry air density with respect to temperature and matric head; +D_Vg=zeros(mL,1); % Gas phase longitudinal dispersion coefficient (m^2¡¤s^-1); +D_V=zeros(mL,nD); % Molecular diffusivity of water vapor in soil(m^2¡¤s^-1); +D_A=zeros(mN,1); % Diffusivity of water vapor in air (m^2¡¤s^-1); +k_g=zeros(mL,nD); % Intrinsic air permeability (m^2); +Sa=zeros(mL,nD); % Saturation degree of gas in soil pores; +V_A=zeros(mL,nD); % Soil air velocity (m¡¤s^-1); +Alpha_Lg=zeros(mL,nD); % Longitudinal dispersivity in gas phase (m); +POR_C=zeros(mL,nD); % The threshold air-filled porosity; +Eta=zeros(mL,nD); % Enhancement factor for thermal vapor transport in soil. +P_g=zeros(mN,1); % Soil air pressure at the start of current time step; +P_gg=zeros(mN,1); % Soil air pressure at the end of current time step; +Theta_g=zeros(mL,nD); % Volumetric gas content; +Beta_g=zeros(mL,nD); % The simplified coefficient for the soil air pressure linearization equation; +Cah=zeros(mL,nD); % Storage coefficients in dry air mass conservation equation related to matric head; +CaT=zeros(mL,nD); % Storage coefficients in dry air mass conservation equation related to temperature; +Caa=zeros(mL,nD); % Storage coefficients in dry air mass conservation equation related to soil air pressure; +Kah=zeros(mL,nD); % Conduction coefficients in dry air mass conservation equation related to matric head; +KaT=zeros(mL,nD); % Conduction coefficients in dry air mass conservation equation related to temperature; +Kaa=zeros(mL,nD); % Conduction coefficients in dry air mass conservation equation related to soil air pressure; +Vah=zeros(mL,nD); % Conduction coefficients in dry air mass conservation equation related to matric head; +VaT=zeros(mL,nD); % Conduction coefficients in dry air mass conservation equation related to temperature; +Vaa=zeros(mL,nD); % Conduction coefficients in dry air mass conservation equation related to soil air pressure; +Cag=zeros(mL,nD); % Gravity coefficients in dry air mass conservation equation; +Lambda_eff=zeros(mL,nD); % Effective heat conductivity; +c_unsat=zeros(mL,nD); % Effective heat capacity; +L=zeros(mN,1); % The latent heat of vaporization at the beginning of the time step; +LL=zeros(mN,1); % The latent heat of vaporization at the end of the time step; +CTh=zeros(mL,nD); % Storage coefficient in energy conservation equation related to matric head; +CTT=zeros(mL,nD); % Storage coefficient in energy conservation equation related to temperature; +CTa=zeros(mL,nD); % Storage coefficient in energy conservation equation related to soil air pressure; +KTh=zeros(mL,nD); % Conduction coefficient in energy conservation equation related to matric head; +KTT=zeros(mL,nD); % Conduction coefficient in energy conservation equation related to temperature; +KTa=zeros(mL,nD); % Conduction coefficient in energy conservation equation related to soil air pressure; +VTT=zeros(mL,nD); % Conduction coefficient in energy conservation equation related to matric head; +VTh=zeros(mL,nD); % Conduction coefficient in energy conservation equation related to temperature; +VTa=zeros(mL,nD); % Conduction coefficient in energy conservation equation related to soil air pressure; +CTg=zeros(mL,nD); % Gravity coefficient in energy conservation equation; +Kcvh=zeros(mL,nD); % Conduction coefficient of vapor transport in energy conservation equation related to matric head; +KcvT=zeros(mL,nD); % Conduction coefficient of vapor transport in energy conservation equation related to temperature; +Kcva=zeros(mL,nD); % Conduction coefficient of vapor transport in energy conservation equation related to soil air pressure; +Ccvh=zeros(mL,nD); % Storage coefficient of vapor transport in energy conservation equation related to matric head; +CcvT=zeros(mL,nD); % Storage coefficient of vapor transport in energy conservation equation related to temperature; +Kcah=zeros(mL,nD); % Conduction coefficient of dry air transport in energy conservation equation related to matric head; +KcaT=zeros(mL,nD); % Conduction coefficient of dry air transport in energy conservation equation related to temperature; +Kcaa=zeros(mL,nD); % Conduction coefficient of dry air transport in energy conservation equation related to soil air pressure; +Ccah=zeros(mL,nD); % Storage coefficient of dry air transport in energy conservation equation related to matric head; +CcaT=zeros(mL,nD); % Storage coefficient of dry air transport in energy conservation equation related to temperature; +Ccaa=zeros(mL,nD); % Storage coefficient of dry air transport in energy conservation equation related to soil air pressure; +Precip=zeros(Nmsrmn,1); % Precipitation(m.s^-1); +Ta=zeros(Nmsrmn,1); % Air temperature; +Ts=zeros(Nmsrmn,1); % Surface temperature; +U=zeros(Nmsrmn,1); % Wind speed (m.s^-1); +HR_a=zeros(Nmsrmn,1); % Air relative humidity; +Rns=zeros(Nmsrmn,1); % Net shortwave radiation(W¡¤m^-2); +Rnl=zeros(Nmsrmn,1); % Net longwave radiation(W¡¤m^-2); +Rn=zeros(Nmsrmn,1); +h_SUR=zeros(Nmsrmn,1); % Observed matric potential at surface; +SH=zeros(Nmsrmn,1); % Sensible heat (W¡¤m^-2); +MO=zeros(Nmsrmn,1); % Monin-Obukhov's stability parameter (MO Length); +Zeta_MO=zeros(Nmsrmn,1); % Atmospheric stability parameter; +TopPg=zeros(Nmsrmn,1); % Atmospheric pressure above the surface as the boundary condition (Pa); +QL_Dts=zeros(mL,1); % Convective moisture mass flux in one time step; +QL_dispts=zeros(mL,1); % Dispersive moisture mass flux in one time step; +QLts=zeros(mL,1); % Total moisture mass flux in one time step; +QV_Dts=zeros(mL,1); % Diffusive vapor mass flux in one time step; +QV_Ats=zeros(mL,1); % Convective vapor mass flux in one time step; +QV_dispts=zeros(mL,1); % Dispersive vapor mass flux in one time step; +QVts=zeros(mL,1); % Total vapor mass flux in one time step; +QA_Dts=zeros(mL,1); % Diffusive dry air mass flux in one time step; +QA_Ats=zeros(mL,1); % Convective dry air mass flux in one time step; +QA_dispts=zeros(mL,1); % Dispersive dry air mass flux in one time step; +QAts=zeros(mL,1); % Total dry air mass flux in one time step; +QV_D=zeros(mL,1); % Diffusive vapor mass flux; +QV_A=zeros(mL,1); % Convective vapor mass flux; +QV_disp=zeros(mL,1); % Dispersive vapor mass flux; +QA_D=zeros(mL,1); % Diffusive dry air mass flux; +QA_A=zeros(mL,1); % Convective dry air mass flux; +QA_disp=zeros(mL,1); % Dispersive dry air mass flux; +hOLD=zeros(mN,1); % Array used to get the matric head at the end of last time step and extraplot the matric head at the start of current time step; +TOLD=zeros(mN,1); % The same meanings of hOLD,but for temperature; +P_gOLD=zeros(mN,1); % The same meanins of TOLD,but for soil air pressure; +Ksoil=zeros(ML,1); +Rl=ones(ML,1)*150; +SMC=zeros(ML,1); +DeltZ_R=zeros(ML,1); +Theta_o=ones(ML,1); +frac=zeros(ML,1); +wfrac=zeros(ML,1); +RWUtot=zeros(ML,17568); +Rls=zeros(ML,17568); +Tatot=zeros(17568,1); +LR=0; +PSItot=zeros(17568,1); +sfactortot=zeros(17568,1); +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%%%%%%% The indicators needs to be set before the running of this program %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +J=1; % Indicator denotes the index of soil type for choosing soil physical parameters; % +rwuef=0; +Evaptranp_Cal=2; % Indicator denotes the method of estimating evapotranspiration; + % Value of 1 means the ETind method, otherwise, ETdir method; +UseTs_msrmn=1; % Value of 1 means the measurement Ts would be used; Otherwise, 0; % +Msrmn_Fitting=1; % Value of 1 means the measurement data is used to fit the simulations; +Hystrs=1; % If the value of Hystrs is 1, then the hysteresis is considered, otherwise 0; % +Thmrlefc=1; % Consider the isothermal water flow if the value is 0, otherwise 1; % +Soilairefc=1; % The dry air transport is considered with the value of 1,otherwise 0; % +hThmrl=1; % Value of 1, the special calculation of water capacity is used, otherwise 0; % +h_TE=0; % Value of 1 means that the temperature dependence % + % of matric head would be considered.Otherwise,0; % +W_Chg=1; % Value of 0 means that the heat of wetting would % + % be calculated by Milly's method£¬Otherwise,1. The % + % method of Lyle Prunty would be used; % +ThmrlCondCap=1; %1; % The indicator for choosing Milly's effective thermal capacity and conductivity % + % formulation to verify the vapor and heat transport in extremly dry soil. % +%%%%% 172 27%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +SaturatedK=[12/(3600*24) 68/(3600*24)]; % Saturation hydraulic conductivity (cm.s^-1); +SaturatedMC=[0.38 0.43]; % Saturated water content; +ResidualMC=[0.0008 0.045]; % The residual water content of soil; +Coefficient_n=[1.5 2.68]; % Coefficient in VG model; +Coefficient_Alpha=[0.00166 0.145]; % Coefficient in VG model; +porosity=[0.50 0.45]; % Soil porosity; +CKTN=(50+2.575*20); % Constant used in calculating viscosity factor for hydraulic conductivity +l=0.5; % Coefficient in VG model; +g=981; % Gravity acceleration (cm.s^-2); +RHOL=1; % Water density (g.cm^-3); +SSUR=10^5; % Surface area for loam,for sand 10^2 (cm^-1); +Rv=461.5*1e4; % (cm^2.s^-2.Cels^-1)Gas constant for vapor (original J.kg^-1.Cels^-1); +RDA=287.1*1e4; % (cm^2.s^-2.Cels^-1)Gas constant for dry air (original J.kg^-1.Cels^-1); +RHO_bulk=1.4; % Bulk density of sand (g.cm^-3); +fc=0.036; % The fraction of clay,for loam,0.036; for sand,0.02; +Unit_C=1; % Change the mH2O into (kg.m^-1.s^-2) %101325/10.3; +UnitC=100; % Change of meter into centimeter; +Hc=0.02; % Henry's constant; +GWT=7; % The gain factor(dimensionless),which assesses the temperature +rroot=1.5*1e-3; % dependence of the soil water retention curve is set as 7 for + % sand (Noborio et al, 1996); +MU_a=1.846*10^(-4); % (g.cm^-1.s^-1)Viscosity of air (original 1.846*10^(-5)kg.m^-1.s^-1); +Gamma0=71.89; % The surface tension of soil water at 25 Cels degree. (g.s^-2); +Gamma_w=RHOL*g; % Specific weight of water(g.cm^-2.s^-2); +Lambda1=0.228/UnitC;%-0.197/UnitC;% 0.243/UnitC; % Coefficients in thermal conductivity; +Lambda2=-2.406/UnitC;%-0.962/UnitC;% 0.393/UnitC; % W.m^-1.Cels^-1 (1 W.s=J); From HYDRUS1D heat transport parameter.(Chung Hortan 1987 WRR) +Lambda3=4.909/UnitC;%2.521/UnitC;% 1.534/UnitC; %%%%%%%%%%%%%%%%%%%%%% UnitC is used to convert m^-1 as cm^-1 %%%%%%%%%%%%%%%%%%% +MU_W0=2.4152*10^(-4); % Viscosity of water (g.cm^-1.s^-1) at reference temperature(original 2.4152*10^(-5)kg.m^-1.s^-1); +MU1=4742.8; % Coefficient for calculating viscosity of water (J.mol^-1); +b=4*10^(-6); % Coefficient for calculating viscosity of water (cm); +W0=1.001*10^3; % Coefficient for calculating differential heat of wetting by Milly's method +L0=597.3*4.182; +Tr=20; % Reference temperature +c_L=4.186; % Specific heat capacity of liquid water (J¡¤g^-1¡¤Cels^-1) %%%%%%%%% Notice the original unit is 4186kg^-1 +c_V=1.870; % Specific heat capacity of vapor (J¡¤g^-1¡¤Cels^-1) +c_a=1.255e-3; +%c_a=1.005; % 0.0003*4.186; %Specific heat capacity of dry air (J¡¤g^-1¡¤Cels^-1) +Gsc=1360; % The solar constant (1360 W¡¤m^-2) +Sigma_E=4.90*10^(-9); % The stefan-Boltzman constant.(=4.90*10^(-9) MJ¡¤m^-2¡¤Cels^-4¡¤d^-1) +P_g0=951978.50; % The mean atmospheric pressure (Should be given in new simulation period subroutine.) + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% Input for producing initial soil moisture and soil temperature profile +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +InitND1=20; % Unit of it is cm. These variables are used to indicated the depth corresponding to the measurement. +InitND2=40; +InitND3=60; +InitND4=200; +InitND5=300; +% Measured temperature at InitND1 depth at the start of simulation period +InitT0= 9.89; +InitT1= 10.76714; +InitT2= 11.82195; +InitT3= 11.9841; +InitT4= 12.0; +InitT5= 12.6841; +BtmT=16.6; +InitX0= 0.2181060; +InitX1= 0.2227298; % Measured soil moisture content +InitX2= 0.2131723; +InitX3= 0.1987298; +InitX4= 0.1727298; +InitX5= 0.16; +BtmX=0.16;%0.05; % The initial moisture content at the bottom of the column. +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% The measured soil moisture and tempeature data here +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +if Msrmn_Fitting +%20, 40, 60, 80, 100cm +Xdata=xlsread('E:\grassland\SCOPE-master\SCOPE_v1.73\src\INPUT_2013_YM_HOUR','sheet1','a3:s2450'); +Xdata=Xdata'; +Msr_Mois=0.01.*[Xdata(13,:);Xdata(14,:);Xdata(15,:);Xdata(16,:);Xdata(17,:)]; +%20, 40, 60, 80, 100cm +Msr_Temp=[Xdata(4,:);Xdata(5,:);Xdata(6,:);Xdata(7,:);Xdata(8,:)]; +Msr_Time=3600.*Xdata(1,:); +Ts_msr=Xdata(3,:); +ETdata=xlsread('E:\grassland\SCOPE-master\SCOPE_v1.73\src\ET','sheet1','A2:E2449'); +ET_H=ETdata(:,1)'; +ET_D=ETdata(:,3)'; +E_D=ETdata(:,4)'; +end + + diff --git a/src/Density_DA.m b/src/Density_DA.m new file mode 100644 index 00000000..09107334 --- /dev/null +++ b/src/Density_DA.m @@ -0,0 +1,19 @@ +function [Xaa,XaT,Xah,DRHODAt,DRHODAz,RHODA]=Density_DA(T,RDA,P_g,Rv,DeltZ,h,hh,TT,P_gg,Delt_t,NL,NN,DRHOVT,DRHOVh,RHOV) + +for MN=1:NN + Xaa(MN)=1/(RDA*(TT(MN)+273.15)); + XaT(MN)=-(P_gg(MN)/(RDA*(TT(MN)+273.15)^2)+Rv*DRHOVT(MN)/RDA); + Xah(MN)=-Rv*DRHOVh(MN)/RDA; + + DRHODAt(MN)=Xaa(MN)*(P_gg(MN)-P_g(MN))/Delt_t+XaT(MN)*(TT(MN)-T(MN))/Delt_t+Xah(MN)*(hh(MN)-h(MN))/Delt_t; + + RHODA(MN)=P_gg(MN)/(RDA*(TT(MN)+273.15))-RHOV(MN)*Rv/RDA; +end +%%%%%%% Pa=kg.m^-1.s^-2=10g.cm^-1.s^-2 %%%%%%%% + +for ML=1:NL + XaaBAR(ML)=(Xaa(ML+1)+Xaa(ML))/2; + XahBAR(ML)=(Xah(ML+1)+Xah(ML))/2; + XaTBAR(ML)=(XaT(ML+1)+XaT(ML))/2; + DRHODAz(ML)=XaaBAR(ML)*(P_gg(ML+1)-P_gg(ML))/DeltZ(ML)+XaTBAR(ML)*(TT(ML+1)-TT(ML))/DeltZ(ML)+XahBAR(ML)*(hh(ML+1)-hh(ML))/DeltZ(ML); +end diff --git a/src/Density_V.m b/src/Density_V.m new file mode 100644 index 00000000..43f8ec09 --- /dev/null +++ b/src/Density_V.m @@ -0,0 +1,17 @@ +function [RHOV,DRHOVh,DRHOVT]=Density_V(TT,hh,g,Rv,NN) + +for MN=1:NN + HR(MN)=exp(hh(MN)*g/(Rv*(TT(MN)+273.15))); + + RHOV_s(MN)=1e-6*exp(31.3716-6014.79/(TT(MN)+273.15)-7.92495*0.001*(TT(MN)+273.15))/(TT(MN)+273.15); + + DRHOV_sT(MN)=RHOV_s(MN)*(6014.79/(TT(MN)+273.15)^2-7.92495*0.001)-RHOV_s(MN)/(TT(MN)+273.15); + + RHOV(MN)=RHOV_s(MN)*HR(MN); + + DRHOVh(MN)=RHOV_s(MN)*HR(MN)*g/(Rv*(TT(MN)+273.15)); + + DRHOVT(MN)=RHOV_s(MN)*HR(MN)*(-hh(MN)*g/(Rv*(TT(MN)+273.15)^2))+HR(MN)*DRHOV_sT(MN); + +end + diff --git a/src/Dtrmn_Z.m b/src/Dtrmn_Z.m new file mode 100644 index 00000000..16d4feb1 --- /dev/null +++ b/src/Dtrmn_Z.m @@ -0,0 +1,90 @@ +function Dtrmn_Z +% The determination of the element length +global Elmn_Lnth ML DeltZ NL Tot_Depth DeltZ_R MML Ztot + +Elmn_Lnth=0; + +for ML=1:2 + DeltZ_R(ML)=0.25; +end + DeltZ_R(3)=0.5; + +for ML=4:12 + DeltZ_R(ML)=1; +end + +for ML=13:17 + DeltZ_R(ML)=2; +end + +for ML=18:23 + DeltZ_R(ML)=5; +end +% Sum of element lengths and compared to the total lenght, so that judge +% can be made to determine the length of rest elements. + +for ML=1:23 + Elmn_Lnth=Elmn_Lnth+DeltZ_R(ML); +end + +% If the total sum of element lenth is over the predefined depth, stop the +% for loop, make the ML, at which the element lenth sumtion is over defined +% depth, to be new NL. +for ML=24:28 + DeltZ_R(ML)=10; + Elmn_Lnth=Elmn_Lnth+DeltZ_R(ML); + if Elmn_Lnth>Tot_Depth + DeltZ_R(ML)=Tot_Depth-Elmn_Lnth+DeltZ_R(ML); + NL=ML; + + for ML=1:NL + MML=NL-ML+1; + DeltZ(ML)=DeltZ_R(MML); + end + return + elseif Elmn_LnthTot_Depth + DeltZ_R(ML)=Tot_Depth-Elmn_Lnth+DeltZ_R(ML); + NL=ML; + + for ML=1:NL + MML=NL-ML+1; + DeltZ(ML)=DeltZ_R(MML); + end + return + elseif Elmn_Lnth=Tot_Depth + DeltZ_R(ML)=Tot_Depth-Elmn_Lnth+DeltZ_R(ML); + NL=ML; + + for ML=1:NL + MML=NL-ML+1; + DeltZ(ML)=DeltZ_R(MML); + end + return + end + Ztot=DeltZ'; + Ztot=flip(Ztot); + Ztot=cumsum(Ztot,1); + Ztot=flip(Ztot); +end + + + + + + \ No newline at end of file diff --git a/src/EfeCapCond.m b/src/EfeCapCond.m new file mode 100644 index 00000000..8d19edc8 --- /dev/null +++ b/src/EfeCapCond.m @@ -0,0 +1,43 @@ +function [ETCON,EHCAP,ZETA,J]=EfeCapCond(HCAP,TCON,SF,TCA,GA1,GA2,GB1,GB2,HCD,ZETA0,CON0,PS1,PS2,XWILT,XK,TT,NL,IS,J,POR,Theta_LL,DRHOVT,L,D_A,RHOV,Theta_V) + +MN=0; +for ML=1:NL + for ND=1:2 + MN=ML+ND-1; + J=IS(ML); + XXX=Theta_LL(ML,ND); + if Theta_LL(ML,ND) < XK(J) + XXX=XK(J); + end + + if XXX < XWILT(J) + SF(2)=GA2+GB2(J)*XXX; + else + SF(2)=GA1+GB1(J)*XXX; + end + D_A(MN)=0.229*(1+TT(MN)/273)^1.75; + TCON(2)=TCA+D_A(MN)*L(MN)*DRHOVT(MN); %TCA+D_A(MN)*L(MN)*DRHOVT(MN); % Revised from ""(D_V(ML,ND)*Eta(ML,ND)+D_Vg(ML))*L(MN)*DRHOVT(MN) + + TARG=TCON(2)/TCON(1)-1; + GRAT=0.667/(1+TARG*SF(2))+0.333/(1+TARG*(1-2*SF(2))); + ETCON(ML,ND)=(PS1(J)+XXX*TCON(1)+(POR(J)-XXX)*GRAT*TCON(2))/(PS2(J)+XXX+(POR(J)-XXX)*GRAT); + ZETA(ML,ND)=GRAT/(GRAT*(POR(J)-XXX)+XXX+PS2(J)); + + if Theta_LL(ML,ND)==XXX + EHCAP(ML,ND)=HCD(J)+HCAP(1)*Theta_LL(ML,ND); + EHCAP(ML,ND)=EHCAP(ML,ND)+(0.448*RHOV(MN)*4.182+HCAP(2))*Theta_V(ML,ND); % The Calorie should be converted as J + else + ZETA(ML,ND)=ZETA0(J)+(ZETA(ML,ND)-ZETA0(J))*Theta_LL(ML,ND)/XXX; + ETCON(ML,ND)=CON0(J)+(ETCON(ML,ND)-CON0(J))*Theta_LL(ML,ND)/XXX; + EHCAP(ML,ND)=HCD(J)+HCAP(1)*Theta_LL(ML,ND); + EHCAP(ML,ND)=EHCAP(ML,ND)+(0.448*RHOV(MN)*4.182+HCAP(2))*Theta_V(ML,ND); % The Calorie should be converted as J + end + end +end + + + + + + + \ No newline at end of file diff --git a/src/EnrgyPARM.m b/src/EnrgyPARM.m new file mode 100644 index 00000000..f27bfbdf --- /dev/null +++ b/src/EnrgyPARM.m @@ -0,0 +1,74 @@ +function [CTh,CTT,CTa,KTh,KTT,KTa,VTT,VTh,VTa,CTg,QL,QV,Qa,KLhBAR,KLTBAR,DTDBAR,DhDZ,DTDZ,DPgDZ,Beta_g,DEhBAR,DETBAR,RHOVBAR,EtaBAR]=EnrgyPARM(NL,hh,TT,DeltZ,P_gg,Kaa,Vvh,VvT,Vaa,c_a,c_L,DTheta_LLh,RHOV,Hc,RHODA,DRHODAz,L,WW,RHOL,Theta_V,DRHOVh,DRHOVT,KL_h,D_Ta,KL_T,D_V,D_Vg,DVa_Switch,Theta_g,QL,V_A,Lambda_eff,c_unsat,Eta,Xah,XaT,Xaa,DTheta_LLT,Soilairefc,Khh,KhT,Kha,KLhBAR,KLTBAR,DTDBAR,DhDZ,DTDZ,DPgDZ,Beta_g,DEhBAR,DETBAR,QV,Qa,RHOVBAR,EtaBAR) + +for ML=1:NL + if ~Soilairefc + KLhBAR(ML)=(KL_h(ML,1)+KL_h(ML,2))/2; + KLTBAR(ML)=(KL_T(ML,1)+KL_T(ML,2))/2; + DETBAR(ML)=(D_V(ML,1)*Eta(ML,1)+D_V(ML,2)*Eta(ML,2))/2; + DhDZ(ML)=(hh(ML+1)-hh(ML))/DeltZ(ML); + DTDZ(ML)=(TT(ML+1)-TT(ML))/DeltZ(ML); + DPgDZ(ML)=(P_gg(ML+1)-P_gg(ML))/DeltZ(ML); + end + DTDBAR(ML)=(D_Ta(ML,1)+D_Ta(ML,2))/2; + DEhBAR(ML)=(D_V(ML,1)+D_V(ML,2))/2; + DRHOVhDz(ML)=(DRHOVh(ML+1)+DRHOVh(ML))/2; + DRHOVTDz(ML)=(DRHOVT(ML+1)+DRHOVT(ML))/2; + RHOVBAR(ML)=(RHOV(ML+1)+RHOV(ML))/2; + EtaBAR(ML)=(Eta(ML,1)+Eta(ML,2))/2; +end + +%%%%%% NOTE: The soil air gas in soil-pore is considered with Xah and XaT terms.(0.0003,volumetric heat capacity)%%%%%% +MN=0; +for ML=1:NL + for ND=1:2 + MN=ML+ND-1; + if ~Soilairefc + QL(ML)=-(KLhBAR(ML)*DhDZ(ML)+(KLTBAR(ML)+DTDBAR(ML))*DTDZ(ML)+KLhBAR(ML)); + Qa(ML)=0; + else + Qa(ML)=-((DEhBAR(ML)+D_Vg(ML))*DRHODAz(ML)-RHODA(ML)*(V_A(ML)+Hc*QL(ML)/RHOL)); + end + + if DVa_Switch==1 + QV(ML)=-(DEhBAR(ML)+D_Vg(ML))*DRHOVhDz(ML)*DhDZ(ML)-(DEhBAR(ML)*EtaBAR(ML)+D_Vg(ML))*DRHOVTDz(ML)*DTDZ(ML)+RHOVBAR(ML)*V_A(ML); + else + QV(ML)=-(DEhBAR(ML)+D_Vg(ML))*DRHOVhDz(ML)*DhDZ(ML)-(DEhBAR(ML)*EtaBAR(ML)+D_Vg(ML))*DRHOVTDz(ML)*DTDZ(ML); + end + + if Soilairefc==1 + Kcah(ML,ND)=c_a*TT(MN)*((D_V(ML,ND)+D_Vg(ML))*Xah(MN)+Hc*RHODA(MN)*KL_h(ML,ND)); + KcaT(ML,ND)=c_a*TT(MN)*((D_V(ML,ND)+D_Vg(ML))*XaT(MN)+Hc*RHODA(MN)*(KL_T(ML,ND)+D_Ta(ML,ND))); % + Kcaa(ML,ND)=c_a*TT(MN)*Kaa(ML,ND); %((D_V(ML,ND)+D_Vg(ML))*Xaa(MN)+RHODA(MN)*(Beta_g(ML,ND)+Hc*KL_h(ML,ND)/Gamma_w)); % + if DVa_Switch==1 + Kcva(ML,ND)=L(MN)*RHOV(MN)*Beta_g(ML,ND); %(c_V*TT(MN)+L(MN))--->(c_L*TT(MN)+L(MN)) + else + Kcva(ML,ND)=0; + end + Ccah(ML,ND)=c_a*TT(MN)*(-V_A(ML)-Hc*QL(ML)/RHOL)*Xah(MN); + CcaT(ML,ND)=c_a*TT(MN)*(-V_A(ML)-Hc*QL(ML)/RHOL)*XaT(MN); + Ccaa(ML,ND)=c_a*TT(MN)*Vaa(ML,ND); %*(-V_A(ML)-Hc*QL(ML)/RHOL)*Xaa(MN); % + end + % Main coefficients for energy transport is here: + CTh(ML,ND)=((c_L*TT(MN)-WW(ML,ND))*RHOL-(c_L*TT(MN)+L(MN))*RHOV(MN)-c_a*RHODA(MN)*TT(MN))*DTheta_LLh(ML,ND) ... + +(c_L*TT(MN)+L(MN))*Theta_g(ML,ND)*DRHOVh(MN)+c_a*TT(MN)*Theta_g(ML,ND)*Xah(MN);%;%+c_a*TT(MN)*Theta_g(ML,ND)*Xah(MN) + CTT(ML,ND)=c_unsat(ML,ND)+(c_L*TT(MN)+L(MN))*Theta_g(ML,ND)*DRHOVT(MN)+c_a*TT(MN)*Theta_g(ML,ND)*XaT(MN) ... + +((c_L*TT(MN)-WW(ML,ND))*RHOL-(c_L*TT(MN)+L(MN))*RHOV(MN)-c_a*RHODA(MN)*TT(MN))*DTheta_LLT(ML,ND); % %+c_a*TT(MN)*Theta_g(ML,ND)*XaT(MN)"+" + CTa(ML,ND)=TT(MN)*Theta_V(ML,ND)*c_a*Xaa(MN);% There is not this term in Milly's work. + + KTh(ML,ND)=L(MN)*(D_V(ML,ND)+D_Vg(ML))*DRHOVh(MN)+c_L*TT(MN)*RHOL*Khh(ML,ND)+Kcah(ML,ND); %; %+Kcah(ML,ND) + KTT(ML,ND)=Lambda_eff(ML,ND)+c_L*TT(MN)*RHOL*KhT(ML,ND)+KcaT(ML,ND)+L(MN)*(D_V(ML,ND)*Eta(ML,ND)+D_Vg(ML))*DRHOVT(MN); %;%; % Revised from: "Lambda_eff(ML,ND)+c_L*TT(MN)*RHOL*KhT(ML,ND);" + KTa(ML,ND)=Kcva(ML,ND)+Kcaa(ML,ND)+c_L*TT(MN)*RHOL*Kha(ML,ND); % There is not this term in Milly's work. + + if DVa_Switch==1 + VTh(ML,ND)=c_L*TT(MN)*RHOL*Vvh(ML,ND)+Ccah(ML,ND)-L(MN)*V_A(ML)*DRHOVh(MN); + VTT(ML,ND)=c_L*TT(MN)*RHOL*VvT(ML,ND)+CcaT(ML,ND)-L(MN)*V_A(ML)*DRHOVT(MN)-(c_L*(QL(ML)+QV(ML))+c_a*Qa(ML)-2.369*QV(ML)); + else + VTh(ML,ND)=c_L*TT(MN)*RHOL*Vvh(ML,ND)+Ccah(ML,ND); + VTT(ML,ND)=c_L*TT(MN)*RHOL*VvT(ML,ND)+CcaT(ML,ND)-(c_L*(QL(ML)+QV(ML))+c_a*Qa(ML)-2.369*QV(ML)); + end + + VTa(ML,ND)=Ccaa(ML,ND); %c_a*TT(MN)*Vaa(ML,ND); + + CTg(ML,ND)=(c_L*RHOL+c_a*Hc*RHODA(MN))*KL_h(ML,ND)*TT(MN); %;;% % Revised from "c_L*T(MN)*KL_h(ML,ND)" + end +end diff --git a/src/Enrgy_BC.m b/src/Enrgy_BC.m new file mode 100644 index 00000000..adec41a8 --- /dev/null +++ b/src/Enrgy_BC.m @@ -0,0 +1,39 @@ +function [RHS,C5,C5_a]=Enrgy_BC(RHS,KT,NN,c_L,RHOL,QMB,SH,Precip,L,L_ts,NBCTB,NBCT,BCT,BCTB,DSTOR0,Delt_t,T,Ts,Ta,EVAP,Rn,C5,C5_a) +global Tss Ts1 Taa Tcc Tsss +%%%%%%%%% Apply the bottom boundary condition called for by NBCTB %%%%%%%%% +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +if NBCTB==1 + RHS(1)=BCTB; + C5(1,1)=1; + RHS(2)=RHS(2)-C5(1,2)*RHS(1); + C5(1,2)=0; + C5_a(1)=0; +elseif NBCTB==2 + RHS(1)=RHS(1)+BCTB; +else + C5(1,1)=C5(1,1)-c_L*RHOL*QMB(KT); +end + +%%%%%%%%%% Apply the surface boundary condition called by NBCT %%%%%%%%%%%% +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +if NBCT==1 + if ~isnan(Tss) + RHS(NN)=Tss;%BCT;%30; + elseif ~isnan(Tcc) + RHS(NN)=Tcc; + elseif ~isnan(Taa) + RHS(NN)=Taa; + else + RHS(NN)=Tsss(KT); + end + C5(NN,1)=1; + RHS(NN-1)=RHS(NN-1)-C5(NN-1,2)*RHS(NN); + C5(NN-1,2)=0; + C5_a(NN-1)=0; +elseif NBCT==2 + RHS(NN)=RHS(NN)-BCT; +else + L_ts(KT)=L(NN); + RHS(NN)=RHS(NN)+Rn(KT)-RHOL*L_ts(KT)*EVAP(KT)-SH(KT)+RHOL*c_L*(Ta(KT)*Precip(KT)+DSTOR0*T(NN)/Delt_t); +end + diff --git a/src/Enrgy_Bndry_Flux.m b/src/Enrgy_Bndry_Flux.m new file mode 100644 index 00000000..9f5388b9 --- /dev/null +++ b/src/Enrgy_Bndry_Flux.m @@ -0,0 +1,4 @@ +function [QET,QEB]=Enrgy_Bndry_Flux(SAVE,TT,NN) + +QET=SAVE(2,1,2)-SAVE(2,2,2)*TT(NN-1)-SAVE(2,3,2)*TT(NN); +QEB=-SAVE(1,1,2)+SAVE(1,2,2)*TT(1)+SAVE(1,3,2)*TT(2); \ No newline at end of file diff --git a/src/Enrgy_EQ.m b/src/Enrgy_EQ.m new file mode 100644 index 00000000..0658cb67 --- /dev/null +++ b/src/Enrgy_EQ.m @@ -0,0 +1,67 @@ +function [RHS,C5,SAVE]=Enrgy_EQ(C1,C2,C3,C4,C4_a,C5,C6_a,C6,C7,NL,NN,Delt_t,T,h,hh,P_g,P_gg,Thmrlefc,Soilairefc) + +if Soilairefc && Thmrlefc + RHS(1)=-C7(1)+(C2(1,1)*T(1)+C2(1,2)*T(2))/Delt_t ... + -(C1(1,1)/Delt_t+C4(1,1))*hh(1)-(C1(1,2)/Delt_t+C4(1,2))*hh(2) ... + -(C3(1,1)/Delt_t+C6(1,1))*P_gg(1)-(C3(1,2)/Delt_t+C6(1,2))*P_gg(2) ... + +(C3(1,1)/Delt_t)*P_g(1)+(C3(1,2)/Delt_t)*P_g(2) ... + +(C1(1,1)/Delt_t)*h(1)+(C1(1,2)/Delt_t)*h(2); + + for ML=2:NL + ARG1=C3(ML-1,2)/Delt_t; + ARG2=C3(ML,1)/Delt_t; + ARG3=C3(ML,2)/Delt_t; + + ARG4=C1(ML-1,2)/Delt_t; + ARG5=C1(ML,1)/Delt_t; + ARG6=C1(ML,2)/Delt_t; + + RHS(ML)=-C7(ML)+(C2(ML-1,2)*T(ML-1)+C2(ML,1)*T(ML)+C2(ML,2)*T(ML+1))/Delt_t ... + -(ARG1+C6_a(ML-1))*P_gg(ML-1)-(ARG2+C6(ML,1))*P_gg(ML)-(ARG3+C6(ML,2))*P_gg(ML+1) ... + -(ARG4+C4_a(ML-1))*hh(ML-1)-(ARG5+C4(ML,1))*hh(ML)-(ARG6+C4(ML,2))*hh(ML+1) ... + +ARG1*P_g(ML-1)+ARG2*P_g(ML)+ARG3*P_g(ML+1) ... + +ARG4*h(ML-1)+ARG5*h(ML)+ARG6*h(ML+1); + end + + RHS(NN)=-C7(NN)+(C2(NN-1,2)*T(NN-1)+C2(NN,1)*T(NN))/Delt_t ... + -(C3(NN-1,2)/Delt_t+C6_a(NN-1))*P_gg(NN-1)-(C3(NN,1)/Delt_t+C6(NN,1))*P_gg(NN) ... + -(C1(NN-1,2)/Delt_t+C4_a(NN-1))*hh(NN-1)-(C1(NN,1)/Delt_t+C4(NN,1))*hh(NN) ... + +(C3(NN-1,2)/Delt_t)*P_g(NN-1)+(C3(NN,1)/Delt_t)*P_g(NN) ... + +(C1(NN-1,2)/Delt_t)*h(NN-1)+(C1(NN,1)/Delt_t)*h(NN); +elseif ~Soilairefc && Thmrlefc + RHS(1)=-C7(1)+(C2(1,1)*T(1)+C2(1,2)*T(2))/Delt_t ... + -(C1(1,1)/Delt_t+C4(1,1))*hh(1)-(C1(1,2)/Delt_t+C4(1,2))*hh(2) ... + +(C1(1,1)/Delt_t)*h(1)+(C1(1,2)/Delt_t)*h(2); + for ML=2:NL + ARG4=C1(ML-1,2)/Delt_t; + ARG5=C1(ML,1)/Delt_t; + ARG6=C1(ML,2)/Delt_t; + + RHS(ML)=-C7(ML)+(C2(ML-1,2)*T(ML-1)+C2(ML,1)*T(ML)+C2(ML,2)*T(ML+1))/Delt_t ... + -(ARG4+C4(ML-1,2))*hh(ML-1)-(ARG5+C4(ML,1))*hh(ML)-(ARG6+C4(ML,2))*hh(ML+1) ... + +ARG4*h(ML-1)+ARG5*h(ML)+ARG6*h(ML+1); + end + + RHS(NN)=-C7(NN)+(C2(NN-1,2)*T(NN-1)+C2(NN,1)*T(NN))/Delt_t ... + -(C1(NN-1,2)/Delt_t+C4(NN-1,2))*hh(NN-1)-(C1(NN,1)/Delt_t+C4(NN,1))*hh(NN) ... + +(C1(NN-1,2)/Delt_t)*h(NN-1)+(C1(NN,1)/Delt_t)*h(NN); +else + RHS(1)=-C7(1)+(C2(1,1)*T(1)+C2(1,2)*T(2))/Delt_t; + for ML=2:NL + RHS(ML)=-C7(ML)+(C2(ML-1,2)*T(ML-1)+C2(ML,1)*T(ML)+C2(ML,2)*T(ML+1))/Delt_t; + end + RHS(NN)=-C7(NN)+(C2(NN-1,2)*T(NN-1)+C2(NN,1)*T(NN))/Delt_t; +end + +for MN=1:NN + for ND=1:2 + C5(MN,ND)=C2(MN,ND)/Delt_t+C5(MN,ND); + end +end + +SAVE(1,1,2)=RHS(1); +SAVE(1,2,2)=C5(1,1); +SAVE(1,3,2)=C5(1,2); +SAVE(2,1,2)=RHS(NN); +SAVE(2,2,2)=C5(NN-1,2); +SAVE(2,3,2)=C5(NN,1); \ No newline at end of file diff --git a/src/Enrgy_MAT.m b/src/Enrgy_MAT.m new file mode 100644 index 00000000..39a6d091 --- /dev/null +++ b/src/Enrgy_MAT.m @@ -0,0 +1,57 @@ +function [C1,C2,C3,C4,C4_a,C5,C5_a,C6,C6_a,C7]=Enrgy_MAT(CTh,CTT,CTa,KTh,KTT,KTa,CTg,VTT,VTh,VTa,DeltZ,NL,NN,Soilairefc) + +for MN=1:NN % Clean the space in C1-7 every iteration,otherwise, in *.PARM files, + for ND=1:2 % C1-7 will be mixed up with pre-storaged data, which will cause extremly crazy for computation, which exactly results in NAN. + C1(MN,ND)=0; + C2(MN,ND)=0; + C3(MN,ND)=0; + C4_a(MN)=0; + C5_a(MN)=0; + C6_a(MN)=0; + C4(MN,ND)=0; + C5(MN,ND)=0; + C6(MN,ND)=0; + C7(MN)=0; + end +end + +for ML=1:NL + C1(ML,1)=C1(ML,1)+CTh(ML,1)*DeltZ(ML)/2; + C1(ML+1,1)=C1(ML+1,1)+CTh(ML,2)*DeltZ(ML)/2; + + C2(ML,1)=C2(ML,1)+CTT(ML,1)*DeltZ(ML)/2; + C2(ML+1,1)=C2(ML+1,1)+CTT(ML,2)*DeltZ(ML)/2;% + + C4ARG1=(KTh(ML,1)+KTh(ML,2))/(2*DeltZ(ML)); %sqrt(KTh(ML,1)*KTh(ML,2))/(DeltZ(ML));% + C4ARG2_1=VTh(ML,1)/3+VTh(ML,2)/6; + C4ARG2_2=VTh(ML,1)/6+VTh(ML,2)/3; + C4(ML,1)=C4(ML,1)+C4ARG1-C4ARG2_1; + C4(ML,2)=C4(ML,2)-C4ARG1-C4ARG2_2; + C4(ML+1,1)=C4(ML+1,1)+C4ARG1+C4ARG2_2; + C4_a(ML)=-C4ARG1+C4ARG2_1; + + C5ARG1=(KTT(ML,1)+KTT(ML,2))/(2*DeltZ(ML)); %sqrt(KTT(ML,1)*KTT(ML,2))/(DeltZ(ML));% + C5ARG2_1=VTT(ML,1)/3+VTT(ML,2)/6; + C5ARG2_2=VTT(ML,1)/6+VTT(ML,2)/3; + C5(ML,1)=C5(ML,1)+C5ARG1-C5ARG2_1; + C5(ML,2)=C5(ML,2)-C5ARG1-C5ARG2_2; + C5(ML+1,1)=C5(ML+1,1)+C5ARG1+C5ARG2_2; + C5_a(ML)=-C5ARG1+C5ARG2_1; + + if Soilairefc==1 + C3(ML,1)=C3(ML,1)+CTa(ML,1)*DeltZ(ML)/2; + C3(ML+1,1)=C3(ML+1,1)+CTa(ML,2)*DeltZ(ML)/2; + + C6ARG1=(KTa(ML,1)+KTa(ML,2))/(2*DeltZ(ML));%sqrt(KTa(ML,1)*KTa(ML,2))/(DeltZ(ML)); % + C6ARG2_1=VTa(ML,1)/3+VTa(ML,2)/6; + C6ARG2_2=VTa(ML,1)/6+VTa(ML,2)/3; + C6(ML,1)=C6(ML,1)+C6ARG1-C6ARG2_1; + C6(ML,2)=C6(ML,2)-C6ARG1-C6ARG2_2; + C6(ML+1,1)=C6(ML+1,1)+C6ARG1+C6ARG2_2; + C6_a(ML)=-C6ARG1+C6ARG2_1; + end + + C7ARG=(CTg(ML,1)+CTg(ML,2))/2; %sqrt(CTg(ML,1)*CTg(ML,2));% + C7(ML)=C7(ML)-C7ARG; + C7(ML+1)=C7(ML+1)+C7ARG; +end \ No newline at end of file diff --git a/src/Enrgy_Solve.m b/src/Enrgy_Solve.m new file mode 100644 index 00000000..cd198fa9 --- /dev/null +++ b/src/Enrgy_Solve.m @@ -0,0 +1,18 @@ +function [TT,CHK,RHS,C5]= Enrgy_Solve(C5,C5_a,TT,NN,NL,RHS) + +RHS(1)=RHS(1)/C5(1,1); + +for ML=2:NN + C5(ML,1)=C5(ML,1)-C5_a(ML-1)*C5(ML-1,2)/C5(ML-1,1); + RHS(ML)=(RHS(ML)-C5_a(ML-1)*RHS(ML-1))/C5(ML,1); +end + +for ML=NL:-1:1 + RHS(ML)=RHS(ML)-C5(ML,2)*RHS(ML+1)/C5(ML,1); +end + +for MN=1:NN + CHK(MN)=abs(RHS(MN)-TT(MN)); + %CHK(MN)=abs((RHS(MN)-TT(MN))/TT(MN)); % + TT(MN)=RHS(MN); +end \ No newline at end of file diff --git a/src/Enrgy_sub.m b/src/Enrgy_sub.m new file mode 100644 index 00000000..bb78759d --- /dev/null +++ b/src/Enrgy_sub.m @@ -0,0 +1,39 @@ +function Enrgy_sub +global TT MN NN BCTB +global NL hh DeltZ P_gg +global CTh CTT CTa KTh KTT KTa CTg Vvh VvT Vaa Kaa +global c_a c_L RHOL DRHOVT DRHOVh RHOV Hc RHODA DRHODAz L WW +global Theta_V Theta_g QL V_A +global KL_h KL_T D_Ta Lambda_eff c_unsat D_V Eta D_Vg Xah XaT Xaa DTheta_LLT Soilairefc +global DTheta_LLh DVa_Switch +global Khh KhT Kha KLhBAR KLTBAR DTDBAR DhDZ DTDZ DPgDZ Beta_g DEhBAR DETBAR QV Qa RHOVBAR EtaBAR +global C1 C2 C3 C4 C5 C6 C7 C4_a C5_a C6_a VTT VTh VTa +global Delt_t RHS T h P_g SAVE Thmrlefc +global QMB SH Precip KT +global NBCTB NBCT BCT DSTOR0 Ts Ta L_ts +global EVAP Rn CHK QET QEB + +for MN=1:NN + %if isreal(TT(MN))==0 + TT(MN)=real(TT(MN)); + % end +end + +% EnrgyPARM; +[CTh,CTT,CTa,KTh,KTT,KTa,VTT,VTh,VTa,CTg,QL,QV,Qa,KLhBAR,KLTBAR,DTDBAR,DhDZ,DTDZ,DPgDZ,Beta_g,DEhBAR,DETBAR,RHOVBAR,EtaBAR]=EnrgyPARM(NL,hh,TT,DeltZ,P_gg,Kaa,Vvh,VvT,Vaa,c_a,c_L,DTheta_LLh,RHOV,Hc,RHODA,DRHODAz,L,WW,RHOL,Theta_V,DRHOVh,DRHOVT,KL_h,D_Ta,KL_T,D_V,D_Vg,DVa_Switch,Theta_g,QL,V_A,Lambda_eff,c_unsat,Eta,Xah,XaT,Xaa,DTheta_LLT,Soilairefc,Khh,KhT,Kha,KLhBAR,KLTBAR,DTDBAR,DhDZ,DTDZ,DPgDZ,Beta_g,DEhBAR,DETBAR,QV,Qa,RHOVBAR,EtaBAR); +% Enrgy_MAT; +[C1,C2,C3,C4,C4_a,C5,C5_a,C6,C6_a,C7]=Enrgy_MAT(CTh,CTT,CTa,KTh,KTT,KTa,CTg,VTT,VTh,VTa,DeltZ,NL,NN,Soilairefc); +% Enrgy_EQ; +[RHS,C5,SAVE]=Enrgy_EQ(C1,C2,C3,C4,C4_a,C5,C6_a,C6,C7,NL,NN,Delt_t,T,h,hh,P_g,P_gg,Thmrlefc,Soilairefc); +% Enrgy_BC; +[RHS,C5,C5_a]=Enrgy_BC(RHS,KT,NN,c_L,RHOL,QMB,SH,Precip,L,L_ts,NBCTB,NBCT,BCT,BCTB,DSTOR0,Delt_t,T,Ts,Ta,EVAP,Rn,C5,C5_a); +% Enrgy_Solve; +[TT,CHK,RHS,C5]= Enrgy_Solve(C5,C5_a,TT,NN,NL,RHS); +for MN=1:NN + % if isreal(TT(MN))==0 + TT(MN)=real(TT(MN)); + % end +end + +% Enrgy_Bndry_Flux; +[QET,QEB]=Enrgy_Bndry_Flux(SAVE,TT,NN); \ No newline at end of file diff --git a/src/EvapTransp_Cal.m b/src/EvapTransp_Cal.m new file mode 100644 index 00000000..b6315827 --- /dev/null +++ b/src/EvapTransp_Cal.m @@ -0,0 +1,135 @@ +function EvapTransp_Cal +global PT_PM_0 PT_PM_VEG T_act PME +% Set constants +sigma = 4.903e-9; % Stefan Boltzmann constant MJ.m-2.day-1 FAO56 pag 74 +lambdav = 2.45; % latent heat of evaporation [MJ.kg-1] FAO56 pag 31 +% Gieske 2003 pag 74 Eq33/Dingman 2002 +% lambda=2.501-2.361E-3*t, with t temperature evaporative surface (?C) +% see script Lambda_function_t.py +Gsc = 0.082; % solar constant [MJ.m-2.min-1] FAO56 pag 47 Eq28 +eps = 0.622; % ratio molecular weigth of vapour/dry air FAO56 p26 BOX6 +R = 0.287; % specific gas [kJ.kg-1.K-1] FAO56 p26 box6 +Cp = 1.013E-3; % specific heat at cte pressure [MJ.kg-1.?C-1] FAO56 p26 box6 +k = 0.41; % karman's cte [] FAO 56 Eq4 +Z=521; % altitute of the location(m) +as=0.25; % regression constant, expressing the fraction of extraterrestrial radiation FAO56 pag50 +bs=0.5; +alfa=0.23; % albeo of vegetation set as 0.23 +z_m=10; % observation height of wind speed; 10m +% input meterology data +Mdata=xlsread('C:\Users\ÍõÔÆö­\Desktop\STEMMUS EXERCISE -I_O Optimize\Meterology data','sheet1','B5:AA5860'); +Ta=Mdata(:,1); % air temperature +RH=Mdata(:,2); % relative humidity +Ws=Mdata(:,3); % wind speed at 2m +Precip=Mdata(:,4)./18000; % precipitation +Ts1=Mdata(:,5); % soil temperature at 20cm +Ts2=Mdata(:,6); % soil temperature at 40cm +Ts3=Mdata(:,7); % soil temperature at 60cm +SMC1=Mdata(:,8); % soil moisture content at 20cm +SMC2=Mdata(:,9); % soil moisture content at 40cm +SMC3=Mdata(:,10); % soil moisture content at 60cm +G1=Mdata(:,11); % soil heat flux 1 +G2=Mdata(:,12); % heat heat flux 2 +G3=Mdata(:,13); % soil heat flux 3 +Rn=Mdata(:,14); % net rediation +LAI=Mdata(:,26); % leaf area index +% Calculation procedure +for iN=1:tS+1 + %% AIR PARAMETERS CALCULATION + % compute DELTA - SLOPE OF SATURATION VAPOUR PRESSURE CURVE + % [kPa.?C-1] + % FAO56 pag 37 Eq13 + DELTA(iN) = 4098*(0.6108*exp(17.27*Ta(iN)/(Ta(iN)+237.3)))/(Ta(iN)+237.3)^2; + % ro_a - MEAN AIR DENSITY AT CTE PRESSURE + % [kg.m-3] + % FAO56 pag26 box6 + Pa=101.3*((293-0.0065*Z)/293)^5.26; + ro_a(iN) = Pa/(R*1.01*(Tm(iN)+273.16)); + % compute e0_Ta - saturation vapour pressure at actual air temperature + % [kPa] + % FAO56 pag36 Eq11 + e0_Tm(iN) = 0.6108*exp(17.27*Tm(iN)/(Tm(iN)+237.3)); + + % compute e_a - ACTUAL VAPOUR PRESSURE + % [kPa] + % FAO56 pag74 Eq54 + e_a(iN) = e0_Tm(iN)*RHa(iN)/100; + % gama - PSYCHROMETRIC CONSTANT + % [kPa.?C-1] + % FAO56 pag31 eq8 + gama = 0.664742*1e-3*Pa; + + %% RADIATION PARAMETERS CALCULATION + % compute dr - inverse distance to the sun + % [rad] + % FAO56 pag47 Eq23 + dr(iN) = 1+0.033*cos(2*pi()*JN(iN)/365); + + % compute delta - solar declination + % [rad] + % FAO56 pag47 Eq24 + delta(iN) = 0.409*sin(2*pi()*JN(iN)/365-1.39); + + % compute compute ws - sunset hour angle + % [rad] + % FAO56 pag48 Eq31 + Ws(iN)=acos((-1)*tan(0.599)*tan(delta(iN))); + + % compute Ra - extraterrestrial radiation + % [MJ.m-2.day-1] + % FAO56 pag47 Eq28 + Ra(iN)=24*60/pi()*Gsc*dr(iN)*(Ws(iN)*sin(0.599)*sin(delta(iN))+cos(0.599)*cos(delta(iN))*sin(Ws(iN))); + %Ra_Watts.append(Ra[j]*24/0.08864) + % compute Rs0 - clear-sky solar (shortwave) radiation + % [MJ.m-2.day-1] + % FAO56 pag51 Eq37 + Rs0(iN) = (0.75+2E-5*Z)*Ra(iN); + + % compute Rs - SHORTWAVE RADIATION + % [MJ.m-2.day-1] + % FAO56 pag51 Eq37 + Rs(iN)=(as+bs*n(iN)/N(iN))*Ra(iN); + + % compute Rns - NET SHORTWAVE RADIATION + % [MJ.m-2.day-1] + % FAO56 pag51 Eq37 + % for each type of vegetation, crop and soil (albedo dependent) + Rns(iN)= (1-alfa)*Rs(iN); + % compute Rnl - NET LONGWAVE RADIATION + % [MJ.m-2.day-1] + % FAO56 pag51 Eq37 and pag74 of hourly computing + Rnl(iN)=(sigma*(Tm(iN) + 273.16)^4*(0.34-0.14*sqrt(e_a(iN)))*(1.35*Rs(iN)/Rs0(iN)-0.35)); + Rn(iN) = Rns(iN) - Rnl(iN); + %% SURFACE RESISTANCE PARAMETERS CALCULATION + + % r_s - SURFACE RESISTANCE + % [s.m-1] + % VEG: Dingman pag 208 (canopy conductance) (equivalent to FAO56 pag21 Eq5) + r_s_VEG(iN) = rl(iN)/LAI_act(iN); + + % SOIL: equation 20 of van de Griend and Owe, 1994 + %Theta_LL_sur(KT)=Theta_LL(NL,2); + % [m.s-1] + % FAO56 pag56 eq47 + + u_2(iN) = u_z_m(iN)*4.87/log(67.8*z_m-5.42); + + % r_a - AERODYNAMIC RESISTANCE + % [s.m-1] + % FAO56 pag20 eq4- (d - zero displacement plane, z_0m - roughness length momentum transfer, z_0h - roughness length heat and vapour transfer, [m], FAO56 pag21 BOX4 + r_a_VEG(iN) = log((2-(2*h_v(iN)/3))/(0.123*h_v(iN)))*log((2-(2*h_v(iN)/3))/(0.0123*h_v(iN)))/((k^2)*u_2(iN)); + % r_a of SOIL + % Liu www.hydrol-earth-syst-sci.net/11/769/2007/ + % equation for neutral conditions (eq. 9) + % only function of ws, it is assumed that roughness are the same for any type of soil + % r_a_SOIL(iN) = log((2.0)/0.0058)*log(2.0/0.0058)/((k^2)*u_2(iN)); + + % PT/PE - Penman-Montheith + % mm.day-1 + % FAO56 pag19 eq3 + PT_PM_VEG(iN) = (DELTA(iN)*Rn(iN)+86400*ro_a(iN)*Cp*(e0_Tm(iN)-e_a(iN))/r_a_VEG(iN))/(lambdav*(DELTA(iN) + gama*(1+r_s_VEG(iN)/r_a_VEG(iN)))); + % reference et ET0 + PT_PM_0(iN) = (0.408*DELTA(iN)*Rn(iN)+gama*900/(Tm(iN)+273)*(e0_Tm(iN)-e_a(iN))*u_2(iN))/(DELTA(iN) + gama*(1+0.34*u_2(iN))); + T_act(iN)=PT_PM_0(iN)*Kcb(iN); + PME(iN)=DELTA(iN)*Rn(iN)/(lambdav*(DELTA(iN) + gama)); +end diff --git a/src/Evap_Cal.m b/src/Evap_Cal.m new file mode 100644 index 00000000..e67b5309 --- /dev/null +++ b/src/Evap_Cal.m @@ -0,0 +1,276 @@ +%function [Evap,EVAP,Trap,bx,Srt]= Evap_Cal(KT,lEstot,lEctot,PSIs,PSI,rsss,rrr,rxx,rwuef) +function [Evap,EVAP,Trap,bx,Srt]= Evap_Cal(bx,Srt,DeltZ,TIME,RHOV,Ta,HR_a,U,Theta_LL,Ts,Rv,g,NL,NN,KT,Evaptranp_Cal,Coefficient_n,Coefficient_Alpha,Theta_r,Theta_s,DURTN,PME,PT_PM_0,hh,rwuef,J,lEstot,lEctot) +global LAI Rn G Ta1 Ts1 h_v rl_min RWU +if (isnan(lEstot) || isnan(lEctot)||lEstot>800) +%HR_a(KT)=HR(KT); +Ta(KT)=Ta1(KT); +Ts(KT)=Ts1(KT); +if LAI(KT)<=2 + LAI_act(KT)=LAI(KT); +elseif LAI(KT)<=4 + LAI_act(KT)=2; +else + LAI_act(KT)=0.5*LAI(KT); +end +Tao=0.56; %light attenual coefficient + % Set constants + sigma = 4.903e-9; % Stefan Boltzmann constant MJ.m-2.day-1 FAO56 pag 74 + lambdav = 2.45; % latent heat of evaporation [MJ.kg-1] FAO56 pag 31 + % Gieske 2003 pag 74 Eq33/DKTgman 2002 + % lambda=2.501-2.361E-3*t, with t temperature evaporative surface (?C) + % see script Lambda_function_t.py + Gsc = 0.082; % solar constant [MJ.m-2.mKT-1] FAO56 pag 47 Eq28 + eps = 0.622; % ratio molecular weigth of vapour/dry air FAO56 p26 BOX6 + R = 0.287; % specific gas [kJ.kg-1.K-1] FAO56 p26 box6 + Cp = 1.013E-3; % specific heat at cte pressure [MJ.kg-1.?C-1] FAO56 p26 box6 + k = 0.41; % karman's cte [] FAO 56 Eq4 + Z=521; % altitute of the location(m) + as=0.25; % regression constant, expressKTg the fraction of extraterrestrial radiation FAO56 pag50 + bs=0.5; + alfa=0.23; % albeo of vegetation set as 0.23 + z_m=2; % observation height of wKTd speed; 10m + Lz=240*pi()/180; % latitude of Beijing time zone west of Greenwich + Lm=252*pi()/180; % latitude of Local time, west of Greenwich + % albedo of soil calculation; + Theta_LL_sur(KT)=Theta_LL(NL,2); + if Theta_LL_sur(KT)<0.1 + alfa_s(KT)=0.25; + elseif Theta_LL_sur(KT)<0.25 + alfa_s(KT)=0.35-Theta_LL_sur(KT); + else + alfa_s(KT)=0.1; + end + %JN(KT)=fix(TIME/3600/24)+174; % day number + % n=[4.8 0 10.6 2.9 13 12.3 9.3 10.9 2.6 0 4.1 0 11.9 11.4 8.1 0 0 0 4.7 5.4 10.2 0 0 12.1 0 0 5.4 11.1 0 1.5 0.7 0 2.5 8.7 6 3.9 0 1.2 10.5 8.6 7.3 8.8 9.8 10.8 8.6 0 4.6 8.9 3.2 3 9 7.9 4 7.2 6.3 5.1 9.2 8.9 9.7 8.2 4.5 3.1 0 4.9 8.1 0 0 11.6 11.2 7.7 7.2 0 2.9 0 3 9 0 0 8 9.1 4.5 4.7 11 11.2 9.7 8.8 7.3 0 0 0 4.4 0 0 3.6 0 0 8.6 0.8 8.6 0 7.4 3.1]; + % h_v=[0.047333333 0.071 0.094666667 0.118333333 0.142 0.165666667 0.189333333 0.213 0.236666667 0.260333333 0.284 0.307666667 0.331333333 0.355 0.390909091 0.426818182 0.462727273 0.498636364 0.534545455 0.570454545 0.606363636 0.642272727 0.678181818 0.714090909 0.75 0.807142857 0.864285714 0.921428571 0.978571429 1.035714286 1.092857143 1.15 1.21625 1.2825 1.34875 1.415 1.48125 1.5475 1.61375 1.68 1.715 1.75 1.785 1.82 1.855 1.89 1.925 1.96 1.995 2.03 2.065 2.1 2.135 2.135 2.135 2.135 2.135 2.135 2.135 2.135 2.135 2.135 2.135 2.135 2.135 2.135 2.135 2.135 2.135 2.135 2.135 2.135 2.135 2.135 2.135 2.135 2.135 2.135 2.135 2.135 2.135 2.135 2.135 2.135 2.135 2.135 2.135 2.135 2.135 2.135 2.135 2.135 2.135 2.135 2.135 2.135 2.135 2.135 2.135 2.135 2.135 2.135]; + % rl_min=[139 139 139 139 139 139 139 139 139 139 139 139 139 139 139 139 139 139 139 139 139 139 139 139 139 139 139 139 139 139 139 139 139 139 139 139 139 139 139 121 121 121 121 121 121 121 121 121 121 121 121 121 121 139 139 139 139 139 139 139 139 139 139 139 139 139 139 139 139 139 139 139 139 139 139 139 139 139 139 139 139 139 139 139 139 139 139 139 139 139 139 139 139 139 139 139 239 239 239 239 239 239]; + %DayNum=fix(TIME/3600/24)+1; + % n(KT)=n(DayNum); + % h_v(KT)=h_v(DayNum); + % rl_min(KT)=rl_min(DayNum); + % 6-23 TO 7-31 + % Calculation procedure + %% AIR PARAMETERS CALCULATION + % compute DELTA - SLOPE OF SATURATION VAPOUR PRESSURE CURVE + % [kPa.?C-1] + % FAO56 pag 37 Eq13 + DELTA(KT) = 4098*(0.6108*exp(17.27*Ta1(KT)/(Ta1(KT)+237.3)))/(Ta1(KT)+237.3)^2; + % ro_a - MEAN AIR DENSITY AT CTE PRESSURE + % [kg.m-3] + % FAO56 pag26 box6 + Pa=101.3*((293-0.0065*Z)/293)^5.26; + ro_a(KT) = Pa/(R*1.01*(Ta1(KT)+273.16)); + % compute e0_Ta - saturation vapour pressure at actual air temperature + % [kPa] + % FAO56 pag36 Eq11 + e0_Ta(KT) = 0.6108*exp(17.27*Ta1(KT)/(Ta1(KT)+237.3)); + e0_Ts(KT) = 0.6108*exp(17.27*Ts1(KT)/(Ts1(KT)+237.3)); + % compute e_a - ACTUAL VAPOUR PRESSURE + % [kPa] + % FAO56 pag74 Eq54 + e_a(KT) = e0_Ta(KT)*HR_a(KT); + e_a_Ts(KT) = e0_Ts(KT)*HR_a(KT); + + % gama - PSYCHROMETRIC CONSTANT + % [kPa.?C-1] + % FAO56 pag31 eq8 + gama = 0.664742*1e-3*Pa; + +% Calculation of net radiation + % Rn_SOIL(KT) = Rns_SOIL(KT) - RnL(KT); % net radiation for vegetation + Rn_SOIL(KT) =Rn(KT)*exp(-1*(Tao*LAI(KT))); % net radiation for soil + Rn_vege(KT) =Rn(KT)-Rn_SOIL(KT); % net radiation for vegetation + + %% SURFACE RESISTANCE PARAMETERS CALCULATION + R_a=0.81;R_b=0.004*24*11.6;R_c=0.05; + % R_fun(KT)=((R_b*Rns(KT)+R_c)/(R_a*(R_b*Rns(KT)+1))); + rl(KT)=rl_min(KT)/((R_b*Rn(KT)+R_c)/(R_a*(R_b*Rn(KT)+1))); + + % r_s - SURFACE RESISTANCE + % [s.m-1] + % VEG: Dingman pag 208 (canopy conductance) (equivalent to FAO56 pag21 Eq5) + r_s_VEG(KT) = rl(KT)/LAI_act(KT); + + % SOIL: equation 20 of van de Griend and Owe, 1994 + %Theta_LL_sur(KT)=Theta_LL(NL,2); + + r_s_SOIL(KT)=10.0*exp(0.3563*100.0*(0.25-Theta_LL_sur(KT))); % 0.25 set as minmum soil moisture for potential evaporation + %r_s_SOIL(i)=10.0*exp(0.3563*100.0*(fc(i)-por(i))); + % correction wKTdspeed measurement and scalKTg at h+2m + % [m.s-1] + % FAO56 pag56 eq47 + + % r_a - AERODYNAMIC RESISTANCE + % [s.m-1] + % FAO56 pag20 eq4- (d - zero displacement plane, z_0m - roughness length momentum transfer, z_0h - roughness length heat and vapour transfer, [m], FAO56 pag21 BOX4 + r_a_VEG(KT) = log((2-(2*h_v(KT)/3))/(0.123*h_v(KT)))*log((2-(2*h_v(KT)/3))/(0.0123*h_v(KT)))/((k^2)*U(KT))*100; + % r_a of SOIL + % Liu www.hydrol-earth-syst-sci.net/11/769/2007/ + % equation for neutral conditions (eq. 9) + % only function of ws, it is assumed that roughness are the same for any type of soil + RHOV_sur(KT)=RHOV(NN); + Theta_LL_sur(KT)=Theta_LL(NL,2); + + P_Va(KT)=0.611*exp(17.27*Ta1(KT)/(Ta1(KT)+237.3))*HR_a(KT); %The aTaospheric vapor pressure (KPa) (1000Pa=1000.1000.g.100^-1.cm^-1.s^-2) + + RHOV_A(KT)=P_Va(KT)*1e4/(Rv*(Ta1(KT)+273.15)); % g.cm^-3; Rv-cm^2.s^-2.Cels^-1 + + z_ref=200; % cm The reference height of tempearature measurement (usually 2 m) + d0_disp=0; % cm The zero-plane displacement (=0 m) + z_srT=0.1; % cm The surface roughness for the heat flux (=0.001m) + VK_Const=0.41; % The von Karman constant (=0.41) + z_srm=0.1; % cm The surface roughness for momentum flux (=0.001m) + U_wind=198.4597; % The mean wKTd speed at reference height.(cm.s^-1) + + MO(KT)=((Ta1(KT)+273.15)*U(KT)^2)/(g*(Ta1(KT)-Ts1(KT))*log(z_ref/z_srm)); % Wind speed should be KT cm.s^-1, MO-cm; + + Zeta_MO(KT)=z_ref/MO(KT); + + if abs(Ta1(KT)-Ts1(KT))<=0.01 + Stab_m(KT)=0; + Stab_T(KT)=0; + elseif Ta1(KT)1 + Stab_T(KT)=5; + Stab_m(KT)=5; + else + Stab_T(KT)=5*Zeta_MO(KT); + Stab_m(KT)=5*Zeta_MO(KT); + end + end + + Velo_fric(KT)=U(KT)*VK_Const/(log((z_ref-d0_disp+z_srm)/z_srm)+Stab_m(KT)); + + Resis_a(KT)=((log((z_ref-d0_disp+z_srT)/z_srT)+Stab_T(KT))/(VK_Const*Velo_fric(KT)))*100; %(s.cm^-1) + r_a_SOIL(KT) = log((2.0)/0.0058)*log(2.0/0.0058)/((k^2)*U(KT))*100; %(s.m^-1) + + % PT/PE - Penman-Montheith + % mm.day-1 + % FAO56 pag19 eq3 + % VEG + PT_PM_VEG(KT) = (DELTA(KT)*(Rn_vege(KT))+ro_a(KT)*Cp*(e0_Ta(KT)-e_a(KT))/r_a_VEG(KT))/((DELTA(KT) + gama*(1+r_s_VEG(KT)/r_a_VEG(KT))))/1000000/lambdav; % mm s-1 + % reference et ET0 + %PT_PM_0(KT) = (0.408*DELTA(KT)*Rn(KT)+gama*900/(Ta(KT)+273)*(e0_Ta(KT)-e_a(KT))*u_2(KT))/(DELTA(KT) + gama*(1+0.34*u_2(KT))); + %T_act(KT)=PT_PM_0(KT)*Kcb(KT); + % for SOIL + PE_PM_SOIL(KT) = (DELTA(KT)*(Rn_SOIL(KT)-G(KT))+ro_a(KT)*Cp*(e0_Ta(KT)-e_a(KT))/r_a_SOIL(KT))/((DELTA(KT) + gama*(1+r_s_SOIL(KT)/r_a_SOIL(KT))))/1000000/lambdav; % mm s-1 + Evap(KT)=0.1*PE_PM_SOIL(KT); % transfer to second value + EVAP(KT,1)=Evap(KT); + Tp_t(KT)=0.1*PT_PM_VEG(KT); % transfer to second value + TP_t(KT,1)=Tp_t(KT); + % water stress function parameters + H1=-15;H2=-50;H4=-9000;H3L=-900;H3H=-500; + if Tp_t(KT)<0.02/3600 + H3=H3L; + elseif Tp_t(KT)>0.05/3600 + H3=H3H; + else + H3=H3H+(H3L-H3H)/(0.03/3600)*(0.05/3600-Tp_t(KT)); + end + + % piecewise linear reduction function + MN=0; + for ML=1:NL + for ND=1:2 + MN=ML+ND-1; + if hh(MN) >=H1, + alpha_h(ML,ND) = 0; + elseif hh(MN) >=H2, + alpha_h(ML,ND) = (H1-hh(MN))/(H1-H2); + elseif hh(MN) >=H3, + alpha_h(ML,ND) = 1; + elseif hh(MN) >=H4, + alpha_h(ML,ND) = (hh(MN)-H4)/(H3-H4); + else + alpha_h(ML,ND) = 0; + end + end + end + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + %%%%%%%%%%%%%%%%%%%%%% Root lenth distribution %%%%%%%%%%%%%%%%%%%%%%%%% + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + Lm=50; + RL0=1; + r=9.48915E-07; % root growth rate cm/s + fr(KT)=RL0/(RL0+(Lm-RL0)*exp((-1)*(50))); + LR(KT)=Lm*fr(KT); + RL=300; + Elmn_Lnth=0; + + if LR(KT)<=1 + for ML=1:NL-1 % ignore the surface root water uptake 1cm + for ND=1:2 + MN=ML+ND-1; + bx(ML,ND)=0; + end + end + else + for ML=1:NL + Elmn_Lnth=Elmn_Lnth+DeltZ(ML); + if Elmn_Lnth=RL-LR(KT) && Elmn_Lnthlength(LAI_msr) + DayNum=length(LAI_msr); + end + DayHour=TIME/3600/24-DayNum+1; + if DayNum-1==0 + LAI(KT)=LAI_msr(DayNum); + else + LAI(KT)=(LAI_msr(DayNum)-LAI_msr(DayNum-1))*DayHour+LAI_msr(DayNum); + end + +% if AFTP_TIME<14 +% LAI(KT)=0; % emergance daynumber is 8 +% elseif AFTP_TIME<22 +% LAI(KT)=(AFTP_TIME-14)*0.45/8; % emergance daynumber is 8 +% else +% LAI(KT)=-0.0021*AFTP_TIME^2+0.299*AFTP_TIME-5.1074; +% end +% if LAI(KT)<0 +% LAI(KT)=0; +% end +LAI(KT)=LAI(KT); +if LAI(KT)<=2 + LAI_act(KT)=LAI(KT); +elseif LAI(KT)<=4 + LAI_act(KT)=2; +else + LAI_act(KT)=0.5*LAI(KT); +end +if TIME>=912*3600 && TIME<=3239*3600 +LAI_act(KT)=0.1*LAI_act(KT); +end +Tao=0.6; %light attenual coefficient + +if Evaptranp_Cal==1 + + % input data + n(J)=Coefficient_n(J); + Alpha(J)=Coefficient_Alpha(J); + m(J)=1-1/n(J); + AFTP_TIME=TIME/86400+27; %27 is the daynumber initial; + Theta_LL_sur1(KT)=Theta_LL(NL,2); + Theta_LL_sur2(KT)=Theta_LL(NL-14,2); + Theta_LL_sat(KT)=Theta_r(J)+(Theta_s(J)-Theta_r(J))/(1+abs(Alpha(J)*200)^n(J))^m(J); + coef_e=0.9; % 0.8-1.0 Johns 1982, Kemp 1997 + coef_p=2.15; %2-2.3 + Kcbmax=1.20; %for maize 1.10, for wheat 1.07 (allen 2009;duchemin 2006) + coef_kd=-0.7; %-0.84 for wheat + Kcb(KT)=Kcbmax*(1-exp(coef_kd*LAI(KT))); + if TIME-1e5 + if (Theta_LL_sur1(KT)/Theta_LL_sat(KT))>((Ep(KT)/coef_e)^0.5) + Es(KT)=Ep(KT); + else + Es(KT)=coef_e*(Theta_LL_sur1(KT)/Theta_LL_sat(KT))^coef_p; + end + else + Es(KT)=coef_e*((Theta_LL_sur1(KT)+Theta_LL_sur2(KT))/2/Theta_LL_sat(KT))^coef_p; + end + % generate E and T function with time + if t>0.264*24*3600 && t<0.736*24*3600 + + Tp(KT)=Kcb(KT)*ET(DayNum); % Tao LAI set as constant + Evap(KT)=(2.75*sin(2*pi()*t/3600/24-pi()/2)/86400)*Es(KT); % transfer to second value + EVAP(KT,1)=Evap(KT); + Tp_t(KT)=(2.75*sin(2*pi()*t/3600/24-pi()/2)/86400)*Tp(KT); % transfer to second value + TP_t(KT,1)=Tp_t(KT); + else + Tp(KT)=Kcb(KT)*ET(DayNum); % Tao LAI set as constant + % Tp(KT)=(1-exp(-1*(Tao*LAI(KT))))*ET(DayNum); % Tao LAI set as constant + Evap(KT)=(0.24/86400)*Es(KT); % transfer to second value + EVAP(KT,1)=Evap(KT); + Tp_t(KT)=(0.24/86400)*Tp(KT); % transfer to second value + TP_t(KT,1)=Tp_t(KT); + end + else + DayNum=fix(TIME/3600/24); + t=TIME-(DayNum-1)*86400; + ETp=0.1.*PME(14:115); + ET=0.1.*PT_PM_0(14:115); + Ep(KT)=(exp(-1*(Tao*LAI(KT))))*ETp(DayNum); + % Kcb(KT)=Kcbmax*(1-exp(coef_kd*LAI_act(KT))); + if hh(NN)>-1e5 + if (Theta_LL_sur1(KT)/Theta_LL_sat(KT))>((Ep(KT)/coef_e)^0.5) + Es(KT)=Ep(KT); + else + Es(KT)=coef_e*(Theta_LL_sur1(KT)/Theta_LL_sat(KT))^coef_p; + end + else + Es(KT)=coef_e*((Theta_LL_sur1(KT)+Theta_LL_sur2(KT))/2/Theta_LL_sat(KT))^coef_p; + end + % generate E and T function with time + if t>0.264*24*3600 && t<0.736*24*3600 + + Tp(KT)=Kcb(KT)*ET(DayNum); % Tao LAI set as constant + Evap(KT)=(2.75*sin(2*pi()*t/3600/24-pi()/2)/86400)*Es(KT); % transfer to second value + EVAP(KT,1)=Evap(KT); + Tp_t(KT)=(2.75*sin(2*pi()*t/3600/24-pi()/2)/86400)*Tp(KT); % transfer to second value + TP_t(KT,1)=Tp_t(KT); + else + Tp(KT)=Kcb(KT)*ET(DayNum); % Tao LAI set as constant + % Tp(KT)=(1-exp(-1*(Tao*LAI(KT))))*ET(DayNum); % Tao LAI set as constant + Evap(KT)=(0.24/86400)*Es(KT); % transfer to second value + EVAP(KT,1)=Evap(KT); + Tp_t(KT)=(0.24/86400)*Tp(KT); % transfer to second value + TP_t(KT,1)=Tp_t(KT); + end + end +else + % Set constants + sigma = 4.903e-9; % Stefan Boltzmann constant MJ.m-2.day-1 FAO56 pag 74 + lambdav = 2.45; % latent heat of evaporation [MJ.kg-1] FAO56 pag 31 + % Gieske 2003 pag 74 Eq33/DKTgman 2002 + % lambda=2.501-2.361E-3*t, with t temperature evaporative surface (?C) + % see script Lambda_function_t.py + Gsc = 0.082; % solar constant [MJ.m-2.mKT-1] FAO56 pag 47 Eq28 + eps = 0.622; % ratio molecular weigth of vapour/dry air FAO56 p26 BOX6 + R = 0.287; % specific gas [kJ.kg-1.K-1] FAO56 p26 box6 + Cp = 1.013E-3; % specific heat at cte pressure [MJ.kg-1.?C-1] FAO56 p26 box6 + k = 0.41; % karman's cte [] FAO 56 Eq4 + Z=521; % altitute of the location(m) + as=0.25; % regression constant, expressKTg the fraction of extraterrestrial radiation FAO56 pag50 + bs=0.5; + alfa=0.23; % albeo of vegetation set as 0.23 + z_m=10; % observation height of wKTd speed; 10m + Lz=240*pi()/180; % latitude of Beijing time zone west of Greenwich + Lm=252*pi()/180; % latitude of Local time, west of Greenwich + % albedo of soil calculation; + Theta_LL_sur(KT)=Theta_LL(NL,2); + if Theta_LL_sur(KT)<0.1 + alfa_s(KT)=0.25; + elseif Theta_LL_sur(KT)<0.25 + alfa_s(KT)=0.35-Theta_LL_sur(KT); + else + alfa_s(KT)=0.1; + end + JN(KT)=fix(TIME/3600/24)+293; % day number + if JN(KT)>366 + JN(KT)=JN(KT)-366; + end + n=[8.1 8.6 0 8.8 0 9 7 9.2 5.6 0 2.5 8.8 9.6 7.8 7.3 7.7 9.2 9 7.4 0 8.5 0 5 9.1 5.9 8.7 3.3 0 8.3 8.4 7.9 4.6 0 0 0 8.4 6.2 2.9 8.5 6.8 3.2 0 0 0 2.7 8.4 7.7 8.2 7.7 8.2 8.3 7.2 7.1 4 0 0 2.2 0 0 0 6.8 0 0 5.8 3.9 8.3 8 4.7 0 0 0 6.5 8.6 8.2 8.1 3.4 5.5 6.1 4.5 0 7.6 1.9 7.6 7.1 8.6 8.2 7.8 5.6 8.6 7.7 8.1 7 0 0 7.7 7.6 8 9.2 8.3 8.6 8.3 6.6 7.1 5 5.6 0 0 0 0 4.4 0 0 0 3.6 0 0 8.5 4 2 8.6 0 0 0 0 4 4.3 8.7 3 3.9 0 2.4 3.7 1.2 0 8.1 9 9.1 9.1 7.9 9.2 10 0 0 5.8 0 4.6 3.4 5.2 0 8.7 8 7.8 9.6 4.5 8.6 8.5 8.8 0 8.9 10.4 10.3 4.4 9.5 3.2 7.8 0 8.7 0 1.9 9.9 9.5 4.8 10.6 10.4 10.9 10.8 7.8 11 7.8 11 10.3 0 0 0 0 0 3.2 9.8 9 10.6 10.3 0 0 9.2 6.1 11.5 10 0 0 0 0 0 5.5 12 12.4 12.4 11.6 2.2 0 0 0 9.2 9.9 12.1 11 3.5 4.5 2 0 5.3 6.5 0 7.7 0 2.4 11.5 11.2 9 11.5 3.4 8.7 11.2 0 1.5]; + N=[10.93701633 10.9034753 10.87016469 10.83709407 10.80427316 10.77171186 10.73942023 10.70740848 10.675687 10.64426632 10.61315713 10.58237029 10.55191677 10.52180771 10.49205435 10.46266811 10.43366048 10.40504308 10.37682764 10.34902597 10.32164997 10.2947116 10.26822291 10.24219596 10.21664286 10.19157573 10.16700671 10.14294792 10.11941145 10.09640934 10.0739536 10.05205613 10.03072873 10.00998311 9.989830838 9.970283311 9.951351769 9.933047254 9.915380594 9.898362384 9.882002964 9.866312401 9.851300468 9.836976625 9.823349998 9.81042936 9.798223113 9.786739272 9.775985443 9.765968807 9.756696108 9.748173632 9.740407195 9.733402131 9.727163276 9.721694959 9.717000992 9.713084659 9.709948706 9.707595342 9.706026226 9.705242465 9.705244613 9.70603267 9.707606078 9.709963725 9.71310395 9.717024544 9.721722754 9.727195294 9.73343835 9.74044759 9.748218175 9.756744769 9.756744825 9.766021613 9.776042303 9.786800148 9.798287964 9.810498142 9.823422668 9.837053135 9.85138077 9.866396443 9.882090693 9.898453747 9.915475535 9.933145715 9.951453692 9.970388636 9.989939503 10.01009506 10.03084389 10.05217444 10.074075 10.09653377 10.11953883 10.14307819 10.16713981 10.19171159 10.21678141 10.24233713 10.26836665 10.29485784 10.32179862 10.34917699 10.37698095 10.40519863 10.43381819 10.46282793 10.49221622 10.52197155 10.55208253 10.5825379 10.61332654 10.64443746 10.67585981 10.70758291 10.73959622 10.77188935 10.8044521 10.8372744 10.87034637 10.90365826 10.93720053 10.97096377 11.00493875 11.0391164 11.07348782 11.10804425 11.14277709 11.17767792 11.21273844 11.24795051 11.28330613 11.31879743 11.3544167 11.39015633 11.42600884 11.46196687 11.49802317 11.5341706 11.57040211 11.60671076 11.64308967 11.67953206 11.71603121 11.75258048 11.78917327 11.82580304 11.8624633 11.89914757 11.93584944 11.97256248 12.0092803 12.04599651 12.0827047 12.11939848 12.15607142 12.19271707 12.22932896 12.26590057 12.30242534 12.33889663 12.37530778 12.41165203 12.44792255 12.48411243 12.52021469 12.55622222 12.59212782 12.6279242 12.66360393 12.69915947 12.73458317 12.76986722 12.80500369 12.83998451 12.87480148 12.90944621 12.9439102 12.97818478 13.01226111 13.0461302 13.07978291 13.11320992 13.14640174 13.17934873 13.21204108 13.24446881 13.27662179 13.30848971 13.34006212 13.37132839 13.40227777 13.43289933 13.46318202 13.49311465 13.52268587 13.55188426 13.58069823 13.60911612 13.63712616 13.66471648 13.69187516 13.7185902 13.74484953 13.77064107 13.7959527 13.82077229 13.84508771 13.86888685 13.89215763 13.91488805 13.93706614 13.95868004 13.979718 14.00016838 14.0200197 14.03926062 14.05788001 14.07586694 14.09321068 14.10990077 14.125927 14.14127945 14.1559485 14.16992485 14.18319955 14.19576402 14.20761004 14.2187298 14.2291159 14.23876138]; + h_v=[0 0 0 0 0 0 0 0 0.003 0.006 0.009 0.012 0.015 0.018 0.021 0.024 0.027 0.030 0.033 0.036 0.040 0.043 0.046 0.049 0.052 0.055 0.058 0.061 0.064 0.067 0.070 0.073 0.076 0.079 0.079 0.080 0.080 0.080 0.080 0.081 0.081 0.081 0.081 0.082 0.082 0.082 0.083 0.083 0.083 0.083 0.084 0.084 0.084 0.084 0.085 0.085 0.085 0.086 0.086 0.086 0.086 0.087 0.087 0.087 0.087 0.088 0.088 0.088 0.088 0.089 0.089 0.089 0.090 0.090 0.090 0.090 0.091 0.091 0.091 0.091 0.092 0.092 0.092 0.093 0.093 0.093 0.093 0.094 0.094 0.094 0.094 0.095 0.095 0.095 0.095 0.095 0.095 0.095 0.095 0.095 0.095 0.095 0.095 0.095 0.095 0.095 0.095 0.095 0.095 0.095 0.095 0.095 0.095 0.095 0.095 0.095 0.095 0.095 0.095 0.095 0.095 0.095 0.095 0.095 0.095 0.095 0.095 0.100 0.104 0.109 0.113 0.118 0.122 0.127 0.131 0.136 0.148 0.160 0.171 0.183 0.195 0.207 0.219 0.230 0.242 0.254 0.262 0.270 0.279 0.287 0.295 0.303 0.311 0.320 0.328 0.336 0.356 0.375 0.395 0.414 0.434 0.453 0.473 0.492 0.502 0.512 0.523 0.533 0.543 0.553 0.564 0.574 0.584 0.605 0.626 0.647 0.667 0.688 0.709 0.730 0.731 0.732 0.732 0.733 0.734 0.735 0.735 0.736 0.737 0.739 0.740 0.741 0.742 0.744 0.745 0.747 0.750 0.752 0.755 0.757 0.760 0.762 0.765 0.767 0.770 0.772 0.773 0.774 0.775 0.776 0.777 0.778 0.780 0.781 0.782 0.783 0.784 0.785 0.786 0.787 0.788 0.789 0.790 0.791 0.792 0.793 0.795 0.796 0.797 0.798 0.799 0.799 0.799 0.799]; + rl_min=[540 540 540 540 540 540 540 540 540 540 540 540 540 540 540 540 540 540 540 540 540 540 540 540 540 540 540 540 540 540 540 540 540 540 540 540 540 540 2000 2000 2000 2000 2000 2000 2000 2000 2000 2000 2000 2000 2000 2000 2000 2000 2000 2000 2000 2000 2000 2000 2000 2000 2000 2000 2000 2000 2000 2000 2000 2000 2000 2000 2000 2000 2000 2000 2000 2000 2000 2000 2000 2000 2000 2000 2000 2000 2000 2000 2000 2000 2000 2000 2000 2000 2000 2000 2000 2000 2000 2000 2000 2000 2000 2000 2000 2000 2000 2000 2000 2000 2000 2000 2000 2000 2000 2000 2000 2000 2000 2000 2000 2000 1858.736059 1736.111111 1628.664495 1533.742331 1449.275362 1373.626374 1305.483029 1243.781095 1187.648456 1136.363636 1089.324619 1046.025105 1006.036217 968.9922481 934.5794393 902.5270758 872.600349 844.5945946 818.3306056 793.6507937 107.8582435 104.7904192 101.8922853 99.15014164 96.55172414 94.08602151 91.74311927 89.5140665 87.39076155 85.36585366 83.43265793 81.58508159 79.81755986 78.125 76.50273224 74.94646681 73.45225603 72.01646091 70.63572149 69.30693069 68.02721088 66.79389313 65.60449859 64.45672192 63.34841629 62.27758007 61.24234471 60.24096386 59.27180356 58.33333333 58.33333333 58.33333333 58.33333333 58.33333333 58.33333333 58.33333333 58.33333333 58.33333333 58.33333333 58.33333333 58.33333333 58.33333333 58.33333333 58.33333333 58.33333333 58.33333333 58.33333333 58.33333333 58.33333333 58.33333333 58.33333333 58.33333333 58.33333333 58.33333333 58.33333333 58.33333333 58.33333333 58.33333333 58.33333333 58.33333333 58.33333333 58.33333333 58.33333333 58.33333333 58.33333333 58.33333333 58.33333333 58.33333333 58.33333333 58.33333333 58.33333333 58.33333333 58.33333333 58.33333333 58.33333333 61.53846154 65.11627907 69.13580247 315.7894737 338.028169 363.6363636 393.442623 714.2857143 1098.039216 1565.217391 2146.341463 2888.888889 3870.967742 5230.769231 7238.095238 10500 16727.27273]; +% DayNum=fix(TIME/3600/24)+1; + n(KT)=n(DayNum); + N(KT)=N(DayNum); + % h_v(KT)=h_v(DayNum); + %rl_min(KT)=139; + + DayHour=TIME/3600/24-DayNum+1; + if DayNum-1==0 + hh_v(KT)=h_v(DayNum); + else + hh_v(KT)=(h_v(DayNum)-h_v(DayNum-1))*DayHour+h_v(DayNum); + end + rl_min(KT)=rl_min(DayNum); + % 6-23 TO 7-31 + %Kcb=Mdata(:,15); + + % Calculation procedure + %% AIR PARAMETERS CALCULATION + % compute DELTA - SLOPE OF SATURATION VAPOUR PRESSURE CURVE + % [kPa.?C-1] + % FAO56 pag 37 Eq13 + DELTA(KT) = 4098*(0.6108*exp(17.27*Ta(KT)/(Ta(KT)+237.3)))/(Ta(KT)+237.3)^2; + % ro_a - MEAN AIR DENSITY AT CTE PRESSURE + % [kg.m-3] + % FAO56 pag26 box6 + Pa=101.3*((293-0.0065*Z)/293)^5.26; + ro_a(KT) = Pa/(R*1.01*(Ta(KT)+273.16)); + % compute e0_Ta - saturation vapour pressure at actual air temperature + % [kPa] + % FAO56 pag36 Eq11 + e0_Ta(KT) = 0.6108*exp(17.27*Ta(KT)/(Ta(KT)+237.3)); + e0_Ts(KT) = 0.6108*exp(17.27*Ts(KT)/(Ts(KT)+237.3)); + % compute e_a - ACTUAL VAPOUR PRESSURE + % [kPa] + % FAO56 pag74 Eq54 + e_a(KT) = e0_Ta(KT)*HR_a(KT); + e_a_Ts(KT) = e0_Ts(KT)*HR_a(KT); + + % gama - PSYCHROMETRIC CONSTANT + % [kPa.?C-1] + % FAO56 pag31 eq8 + gama = 0.664742*1e-3*Pa; + + %% RADIATION PARAMETERS CALCULATION + % compute dr - KTverse distance to the sun + % [rad] + % FAO56 pag47 Eq23 + dr(KT) = 1+0.033*cos(2*pi()*JN(KT)/365); + + % compute delta - solar declKTation + % [rad] + % FAO56 pag47 Eq24 + delta(KT) = 0.409*sin(2*pi()*JN(KT)/365-1.39); + + % compute Sc - seasonnal correction of solar time + % [hour] + % FAO56 pag47 Eq32 + Sc = []; + b(KT) = 2.0*pi()*(JN(KT)-81.0)/364.0; % Eq 34 + Sc(KT) = 0.1645*sin(2*b(KT)) - 0.1255*cos(b(KT)) - 0.025*sin(b(KT)); + + % compute w - solar time angle at the midpoKTt of the period (time) + % [rad] + % FAO56 pag48 Eq31 + w(KT)=pi()/12*((TIME/3600-fix(TIME/3600/24-0.001)*24-0.5+0.06667*(Lz-Lm)+Sc(KT))-12); + % compute w1 - solar time angle at the beginning of the period (time) + % [rad] + % FAO56 pag47 Eq29 + tl = 1; % hourly data + w1(KT) = (w(KT) - pi()*tl/24.0); + + % compute w2 - solar time angle at the end of the period (time + 1h) + % [rad] + % FAO56 pag47 Eq30 + w2(KT) = w(KT) + pi()*tl/24.0; + + % compute ws - sunset hour angle + % [rad] + % FAO56 pag47 Eq25 + ws(KT)=acos((-1)*tan(0.599)*tan(delta(KT))); %for daily duration + + % compute Ra - extraterrestrial radiation + % [MJ.m-2.hour-1] + % FAO56 pag47 Eq28 + if w(KT)> -ws(KT) && w(KT) < ws(KT) + Ra(KT)=12*60/pi()*Gsc*dr(KT)*((w2(KT)-w1(KT))*sin(0.599)*sin(delta(KT)) + cos(0.599)*cos(delta(KT))*(sin(w2(KT))-sin(w1(KT)))); + else + Ra(KT)=0; + end + if Ra(KT)<0 + Ra(KT)=0; + end + % compute Rs0 - clear-sky solar (shortwave) radiation + % [MJ.m-2.hour-1] + % FAO56 pag51 Eq37 + Rs0(KT) = (0.75+2E-5*Z)*Ra(KT); + % Rs0_Watts = Rs0*24.0/0.08864 + % daylight hours N +% N(KT)=24*ws(KT)/pi(); + + % compute Rs - SHORTWAVE RADIATION + % [MJ.m-2.hour-1] + % FAO56 pag51 Eq37 + Rs(KT)=(as+bs*n(KT)/N(KT))*Ra(KT); + + % compute Rns - NET SHORTWAVE RADIATION + % [MJ.m-2.day-1] + % FAO56 pag51 Eq37 + % for each type of vegetation, crop and soil (albedo dependent) + Rns(KT)= (1-alfa)*Rs(KT); + Rns_SOIL(KT) = (1 - alfa_s(KT))*Rs(KT); + % compute Rnl - NET LONGWAVE RADIATION + % [MJ.m-2.hour-1] + % FAO56 pag51 Eq37 and pag74 of hourly computKTg + r_sunset=[]; + r_angle=[]; + R_i=[]; + if (ws(KT) - 0.52) <= w(KT) && w(KT)<= (ws(KT) - 0.10) %FAO56: (ws(KT) - 0.79) <= w(KT) <= (ws(KT) - 0.52) + R_i = 1; + if Rs0(KT) > 0 + if Rs(KT)/Rs0(KT) > 0.3 + r_sunset = Rs(KT)/Rs0(KT); + else + r_sunset = 0.3; + end + else + r_sunset = 0.75; % see FAO56 pag75 + end + end + if (ws(KT) - 0.10) < w(KT) || w(KT) <= (-ws(KT)+ 0.10) + if R_i>0 + r_angle(KT)=r_sunset; + else + r_angle(KT)=0.75; %see FAO56 pag75 + end + else + r_angle(KT)=Rs(KT)/Rs0(KT); + end + RnL(KT)=(sigma/24*((Ta(KT) + 273.16)^4)*(0.34-0.14*sqrt(e_a(KT)))*(1.35*r_angle(KT)-0.35)); + + if RnL(KT)<0 + r_angle(KT)=0.8; + RnL(KT)=(sigma/24*((Ta(KT) + 273.16)^4)*(0.34-0.14*sqrt(e_a(KT)))*(1.35*r_angle(KT)-0.35)); + end + + Rn(KT) = Rns(KT) - RnL(KT); % net radiation for vegetation + % Rn_SOIL(KT) = Rns_SOIL(KT) - RnL(KT); % net radiation for vegetation + Rn_SOIL(KT) =(1 - alfa_s(KT))*Rn(KT)*exp(-1*(Tao*LAI(KT))); % net radiation for soil + % soil heat flux +% Rn_SOIL(KT) =Rn(KT); % net radiation for soil + + t=TIME-(fix(TIME/3600/24))*86400; + if t>0.264*24*3600 && t<0.736*24*3600 + G(KT)=0.1*Rn(KT); + G_SOIL(KT)=0.1*Rn_SOIL(KT); +% Rn_SOIL(KT) =Rn_SOIL(KT) ; + else +% Rn_SOIL(KT) =Rn_SOIL(KT)-0.2 ; + G(KT)=0.5*Rn(KT); + G_SOIL(KT)=0.5*Rn_SOIL(KT); + end + + %% SURFACE RESISTANCE PARAMETERS CALCULATION + R_a=0.81;R_b=0.004*24*11.6;R_c=0.05; + % R_fun(KT)=((R_b*Rns(KT)+R_c)/(R_a*(R_b*Rns(KT)+1))); + rl(KT)=rl_min(KT)/((R_b*Rns(KT)+R_c)/(R_a*(R_b*Rns(KT)+1))); + + % r_s - SURFACE RESISTANCE + % [s.m-1] + % VEG: Dingman pag 208 (canopy conductance) (equivalent to FAO56 pag21 Eq5) + r_s_VEG(KT) = rl(KT)/LAI_act(KT); + + % SOIL: equation 20 of van de Griend and Owe, 1994 + %Theta_LL_sur(KT)=Theta_LL(NL,2); + + r_s_SOIL(KT)=10.0*exp(0.3563*100.0*(0.28-Theta_LL_sur(KT))); % 0.25 set as minmum soil moisture for potential evaporation + %r_s_SOIL(i)=10.0*exp(0.3563*100.0*(fc(i)-por(i))); + % correction wKTdspeed measurement and scalKTg at h+2m + % [m.s-1] + % FAO56 pag56 eq47 + + % r_a - AERODYNAMIC RESISTANCE + % [s.m-1] + % FAO56 pag20 eq4- (d - zero displacement plane, z_0m - roughness length momentum transfer, z_0h - roughness length heat and vapour transfer, [m], FAO56 pag21 BOX4 + r_a_VEG(KT) = log((2-(2*hh_v(KT)/3))/(0.123*hh_v(KT)))*log((2-(2*hh_v(KT)/3))/(0.0123*hh_v(KT)))/((k^2)*U(KT))*100; + % r_a of SOIL + % Liu www.hydrol-earth-syst-sci.net/11/769/2007/ + % equation for neutral conditions (eq. 9) + % only function of ws, it is assumed that roughness are the same for any type of soil + + RHOV_sur(KT)=RHOV(NN); + Theta_LL_sur(KT)=Theta_LL(NL,2); + + P_Va(KT)=0.611*exp(17.27*Ta(KT)/(Ta(KT)+237.3))*HR_a(KT); %The atmospheric vapor pressure (KPa) (1000Pa=1000.1000.g.100^-1.cm^-1.s^-2) + + RHOV_A(KT)=P_Va(KT)*1e4/(Rv*(Ta(KT)+273.15)); % g.cm^-3; Rv-cm^2.s^-2.Cels^-1 + + z_ref=200; % cm The reference height of tempearature measurement (usually 2 m) + d0_disp=0; % cm The zero-plane displacement (=0 m) + z_srT=0.1; % cm The surface roughness for the heat flux (=0.001m) + VK_Const=0.41; % The von Karman constant (=0.41) + z_srm=0.1; % cm The surface roughness for momentum flux (=0.001m) + U_wind=198.4597; % The mean wind speed at reference height.(cm.s^-1) + + MO(KT)=(Ta(KT)*U(KT)^2)/(g*(Ta(KT)-Ts(KT))*log(z_ref/z_srm)); % Wind speed should be in cm.s^-1, MO-cm; + + Zeta_MO(KT)=z_ref/MO(KT); + + if abs(Ta(KT)-Ts(KT))<=0.01 + Stab_m(KT)=0; + Stab_T(KT)=0; + elseif Ta(KT)1 + Stab_T(KT)=5; + Stab_m(KT)=5; + else + Stab_T(KT)=5*Zeta_MO(KT); + Stab_m(KT)=5*Zeta_MO(KT); + end + end + + Velo_fric(KT)=U(KT)*VK_Const/(log((z_ref-d0_disp+z_srm)/z_srm)+Stab_m(KT)); + + % Resis_a(KT)=(log((z_ref-d0_disp+z_srT)/z_srT)+Stab_T(KT))/(VK_Const*Velo_fric(KT)); %(s.cm^-1) + % + % Resis_s(KT)=10*exp(35.63*(0.25-Theta_LL_sur(KT)))/100; %(-805+4140*(Theta_s(J)-Theta_LL_sur(KT)))/100; % s.m^-1----->0.001s.cm^-1 + % % + % % Evap(KT)=(RHOV_sur(KT)-RHOV_A(KT))/(Resis_s(KT)+Resis_a(KT)); + % % EVAP(KT,1)=Evap(KT); + + Resis_a(KT)=((log((z_ref-d0_disp+z_srT)/z_srT)+Stab_T(KT))/(VK_Const*Velo_fric(KT)))*100; %(s.cm^-1) + r_a_SOIL(KT) = log((2.0)/0.0058)*log(2.0/0.0058)/((k^2)*U(KT))*100; %(s.m^-1) + + % PT/PE - Penman-Montheith + % mm.day-1 + % FAO56 pag19 eq3 + % VEG + + PT_PM_VEG(KT) = (DELTA(KT)*(Rn(KT)-G(KT))+3600*ro_a(KT)*Cp*(e0_Ta(KT)-e_a(KT))/r_a_VEG(KT))/(lambdav*(DELTA(KT) + gama*(1+r_s_VEG(KT)/r_a_VEG(KT))))/3600; + % reference et ET0 + %PT_PM_0(KT) = (0.408*DELTA(KT)*Rn(KT)+gama*900/(Ta(KT)+273)*(e0_Ta(KT)-e_a(KT))*u_2(KT))/(DELTA(KT) + gama*(1+0.34*u_2(KT))); + %T_act(KT)=PT_PM_0(KT)*Kcb(KT); + % for SOIL + if LAI(KT)==0 || hh_v(KT)==0 + PT_PM_VEG(KT)=0; + end + PE_PM_SOIL(KT) = (DELTA(KT)*(Rn_SOIL(KT)-G_SOIL(KT))+3600*ro_a(KT)*Cp*(e0_Ta(KT)-e_a(KT))/r_a_SOIL(KT))/(lambdav*(DELTA(KT) + gama*(1+r_s_SOIL(KT)/r_a_SOIL(KT))))/3600; + Evap(KT)=0.1*PE_PM_SOIL(KT); % transfer to second value + EVAP(KT,1)=Evap(KT); + Tp_t(KT)=0.1*PT_PM_VEG(KT); % transfer to second value + TP_t(KT,1)=Tp_t(KT); + +end +if rwuef==1 + % water stress function parameters +% H1=-15;H2=-50;H4=-9000;H3L=-900;H3H=-500; %% for maize +% H1=-1;H2=-5;H4=-16000;H3L=-900;H3H=-500; %% for winter wheat +% if Tp_t(KT)<0.02/3600 +% H3=H3L; +% elseif Tp_t(KT)>0.05/3600 +% H3=H3H; +% else +% H3=H3H+(H3L-H3H)/(0.03/3600)*(0.05/3600-Tp_t(KT)); +% end + if KT<=3288+1103 + H1=0;H2=-31;H4=-8000;H3L=-600;H3H=-300; + if Tp_t(KT)<0.02/3600 + H3=H3L; + elseif Tp_t(KT)>0.05/3600 + H3=H3H; + else + H3=H3H+(H3L-H3H)/(0.03/3600)*(0.05/3600-Tp_t(KT)); + end + else + H1=-1;H2=-5;H4=-16000;H3L=-600;H3H=-300; + if Tp_t(KT)<0.02/3600 + H3=H3L; + elseif Tp_t(KT)>0.05/3600 + H3=H3H; + else + H3=H3H+(H3L-H3H)/(0.03/3600)*(0.05/3600-Tp_t(KT)); + end + end + % piecewise linear reduction function + MN=0; + for ML=1:NL + for ND=1:2 + MN=ML+ND-1; + if hh(MN) >=H1, + alpha_h(ML,ND) = 0; + elseif hh(MN) >=H2, + alpha_h(ML,ND) = (H1-hh(MN))/(H1-H2); + elseif hh(MN) >=H3, + alpha_h(ML,ND) = 1; + elseif hh(MN) >=H4, + alpha_h(ML,ND) = (hh(MN)-H4)/(H3-H4); + else + alpha_h(ML,ND) = 0; + end + end + end + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + %%%%%%%%%%%%%%%%%%%%%% Root lenth distribution %%%%%%%%%%%%%%%%%%%%%%%%% + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% Lm=150; +% RL0=2; + %%%%%%%%%%%%%%%%%%% crop stage specific root growth rate %%%%%%%%%%%%%%% +% if TIME<=24*50*3600 +% r=1.78E-06; % root growth rate cm/s +% Lm=47; +% RL0=2; +% fr(KT)=RL0/(RL0+(Lm-RL0)*exp((-1)*(r*TIME))); +% LR(KT)=Lm*fr(KT); +% elseif TIME<=3095*3600 +% % r=2.96E-08; +% % Lm=47; +% % RL0=2; +% % fr(KT)=RL0/(RL0+(Lm-RL0)*exp((-1)*(r*TIME))); +% LR(KT)=47; +% else +% r=1.69E-07; +% Lm=150; +% RL0=47; +% fr(KT)=RL0/(RL0+(Lm-RL0)*exp((-1)*(r*TIME))); +% LR(KT)=Lm*fr(KT); +% end + + + if TIME<=3095*3600 + r=1.78E-06; % root growth rate cm/s + Lm=47; + RL0=2; + fr(KT)=RL0/(RL0+(Lm-RL0)*exp((-1)*(r*TIME))); + LR(KT)=Lm*fr(KT); + else + r=6.69E-07; + Lm=150; + RL0=47; + fr(KT)=RL0/(RL0+(Lm-RL0)*exp((-1)*(r*(TIME-3095*3600)))); + LR(KT)=Lm*fr(KT); + end + +% fr(KT)=RL0/(RL0+(Lm-RL0)*exp((-1)*(r*TIME))); +% LR(KT)=Lm*fr(KT); + RL=300; + Elmn_Lnth=0; + + if LR(KT)<=1 + for ML=1:NL-1 % ignore the surface root water uptake 1cm + for ND=1:2 + MN=ML+ND-1; + bx(ML,ND)=0; + end + end + else + for ML=1:NL + Elmn_Lnth=Elmn_Lnth+DeltZ(ML); + if Elmn_Lnth=RL-LR(KT) && Elmn_Lnth1 && Delt_t>(TEND-TIME) + Delt_t=TEND-TIME; % If Delt_t is changed due to excessive change of state variables, the judgement of the last time step is excuted. + end + TIME=TIME+Delt_t; % The time elapsed since start of simulation + TimeStep(KT,1)=Delt_t; + SUMTIME(KT,1)=TIME; + Processing=TIME/TEND + %%%%%% Updating the state variables. %%%%%%%%%%%%%%%%%%%%%%%%%%%% + if TIME>=322*1800 && TIME<=341*1800 %7-13 9-10 p=52mm + NBChh=1; + elseif TIME>=1217*1800 && TIME<=1218*1800 %8-1 16-18 p=60mm + NBChh=1; + elseif TIME>=1933*1800 && TIME<=1960*1800 %8-1 16-18 p=60mm + NBChh=1; + elseif TIME>=2032*1800 && TIME<=2034*1800 %8-15 16-17 p=67mm + NBChh=1; + elseif TIME>=2058*1800 && TIME<=2061*1800 %8-15 16-17 p=67mm + NBChh=1; + elseif TIME>=2127*2131 && TIME<=2135*1800 %8-15 16-17 p=67mm + NBChh=1; + elseif TIME>=2248*1800 && TIME<=2248*1800 %8-15 16-17 p=67mm + NBChh=1; + elseif TIME>=2251*1800 && TIME<=2251*1800 %8-15 16-17 p=67mm + NBChh=1; + elseif TIME>=2316*1800 && TIME<=2322*1800 %8-15 16-17 p=67mm + NBChh=1; + elseif TIME>=2751*1800 && TIME<=2775*1800 %9-8 14-18 p=93.11mm + NBChh=1; + elseif TIME>=3057*1800 && TIME<=3059*1800 %9-8 14-18 p=93.11mm + NBChh=1; + elseif TIME>=4345*1800 && TIME<=4352*1800 %9-8 14-18 p=93.11mm + NBChh=1; + else + NBChh=2; + end + if IRPT1==0 && IRPT2==0 + for MN=1:NN + hOLD(MN)=h(MN); + h(MN)=hh(MN); + hhh(MN,KT)=hh(MN); +% KL_h(MN,KT)=KL_h(MN,2); +% Chh(MN,KT)=Chh(MN,2); +% ChT(MN,KT)=ChT(MN,2); +% Khh(MN,KT)=Khh(MN,2); +% KhT(MN,KT)=KhT(MN,2); + + if Thmrlefc==1 + TOLD(MN)=T(MN); + T(MN)=TT(MN); + TTT(MN,KT)=TT(MN); + end + if Soilairefc==1 + P_gOLD(MN)=P_g(MN); + P_g(MN)=P_gg(MN); + P_ggg(MN,KT)=P_gg(MN); + end + if rwuef==1 + SRT(MN,KT)=Srt(MN,1); + ALPHA(MN,KT)=alpha_h(MN,1); + BX(MN,KT)=bx(MN,1); + end + end + DSTOR0=DSTOR; + if KT>1 + run SOIL1 + end + end + + if Delt_t~=Delt_t0 + for MN=1:NN + hh(MN)=h(MN)+(h(MN)-hOLD(MN))*Delt_t/Delt_t0; + TT(MN)=T(MN)+(T(MN)-TOLD(MN))*Delt_t/Delt_t0; + end + end + hSAVE=hh(NN); + TSAVE=TT(NN); + if NBCh==1 + hN=BCh; + hh(NN)=hN; + hSAVE=hN; + elseif NBCh==2 + if NBChh~=2 + if BCh<0 + hN=DSTOR0; + hh(NN)=hN; + hSAVE=hN; + else + hN=-1e6; + hh(NN)=hN; + hSAVE=hN; + end + end + else + if NBChh~=2 + hN=DSTOR0; + hh(NN)=hN; + hSAVE=hN; + end + end + % run Forcing_PARM +%Ts(KT)=Ts1(KT); + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + for KIT=1:NIT % Start the iteration procedure in a time step. + [hh,COR,J,Theta_V,Theta_g,Se,KL_h,Theta_LL,DTheta_LLh]=SOIL2(hh,COR,hThmrl,NN,NL,TT,Tr,IS,Hystrs,XWRE,Theta_s,IH,KIT,Theta_r,Alpha,n,m,Ks,Theta_L,h,Thmrlefc,CKTN,POR,J); + [KL_T]=CondL_T(NL); + [RHOV,DRHOVh,DRHOVT]=Density_V(TT,hh,g,Rv,NN); + [W,WW,MU_W,D_Ta]=CondL_Tdisp(POR,Theta_LL,Theta_L,SSUR,RHO_bulk,RHOL,TT,Theta_s,h,hh,W_Chg,NL,nD,J,Delt_t,Theta_g,KLT_Switch); + [L]=Latent(TT,NN); + [Xaa,XaT,Xah,DRHODAt,DRHODAz,RHODA]=Density_DA(T,RDA,P_g,Rv,DeltZ,h,hh,TT,P_gg,Delt_t,NL,NN,DRHOVT,DRHOVh,RHOV); + [c_unsat,Lambda_eff]=CondT_coeff(Theta_LL,Lambda1,Lambda2,Lambda3,RHO_bulk,Theta_g,RHODA,RHOV,c_a,c_V,c_L,NL,nD,ThmrlCondCap,ETCON,EHCAP); + [k_g]=Condg_k_g(POR,NL,J,m,Theta_g,g,MU_W,Ks,RHOL); + [D_V,Eta,D_A]=CondV_DE(Theta_LL,TT,fc,Theta_s,NL,nD,J,Theta_g,POR,ThmrlCondCap,ZETA,XK,DVT_Switch); + [D_Vg,V_A,Beta_g]=CondV_DVg(P_gg,Theta_g,Sa,V_A,k_g,MU_a,DeltZ,Alpha_Lg,KaT_Switch,Theta_s,Se,NL,J); + run h_sub; + + if NBCh==1 + DSTOR=0; + RS=0; + elseif NBCh==2 + AVAIL=-BCh; + EXCESS=(AVAIL+QMT(KT))*Delt_t; + if abs(EXCESS/Delt_t)<=1e-10,EXCESS=0;end + DSTOR=min(EXCESS,DSTMAX); + RS=(EXCESS-DSTOR)/Delt_t; + else + AVAIL=AVAIL0-Evap(KT); + EXCESS=(AVAIL+QMT(KT))*Delt_t; + if abs(EXCESS/Delt_t)<=1e-10,EXCESS=0;end + DSTOR=0; + RS=0; + end + + if Soilairefc==1 + run Air_sub; + end + + if Thmrlefc==1 + run Enrgy_sub; + end + + if max(CHK)<0.001 + break + end + hSAVE=hh(NN); + TSAVE=TT(NN); + end + TIMEOLD=KT; + KIT + KIT=0; + [hh,COR,J,Theta_V,Theta_g,Se,KL_h,Theta_LL,DTheta_LLh]=SOIL2(hh,COR,hThmrl,NN,NL,TT,Tr,IS,Hystrs,XWRE,Theta_s,IH,KIT,Theta_r,Alpha,n,m,Ks,Theta_L,h,Thmrlefc,CKTN,POR,J); + + if IRPT1==0 && IRPT2==0 + if KT % In case last time step is not convergent and needs to be repeated. + MN=0; + for ML=1:NL + for ND=1:2 + MN=ML+ND-1; + Theta_LLL(ML,ND,KT)=Theta_LL(ML,ND); + Theta_L(ML,ND)=Theta_LL(ML,ND); + + end + end + run ObservationPoints + end + if (TEND-TIME)<1E-3 + for MN=1:NN + hOLD(MN)=h(MN); + h(MN)=hh(MN); + hhh(MN,KT)=hh(MN); + if Thmrlefc==1 + TOLD(MN)=T(MN); + T(MN)=TT(MN); + TTT(MN,KT)=TT(MN); + end + if Soilairefc==1 + P_gOLD(MN)=P_g(MN); + P_g(MN)=P_gg(MN); + P_ggg(MN,KT)=P_gg(MN); + end + end + break + end + end + for MN=1:NN + QL(MN,KT)=QL(MN); + QL_h(MN,KT)=QL_h(MN); + QL_T(MN,KT)=QL_T(MN); + Qa(MN,KT)=Qa(MN); + QV(MN,KT)=QV(MN); + end +end +% run PlotResults +%%%%%%%%%%%%%%%%%%%% postprocessing part %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%%%% plot the figures of simulation output soil moisture/temperature, +%%%% soil evaporation, plant transpiration simulated with two different +%%%% ET method (indirect ET method & direct ET method) +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +if Evaptranp_Cal==1 % save the variables for ETind scenario + Sim_Theta_ind=Sim_Theta; + Sim_Temp_ind=Sim_Temp; + TRAP=36000.*trap; + TRAP_ind=TRAP'; + EVAP=36000.*Evapo; + EVAP_ind=EVAP'; + disp ('Convergence Achieved for ETind scenario. Please switch to ETdir scenario and run again.') +else + TRAP=18000.*trap; + TRAP_dir=TRAP'; + EVAP=18000.*Evapo; + EVAP_dir=EVAP'; + for i=1:KT/48 + sumTRAP_ind(i)=0; %#ok<*SAGROW> + sumEVAP_ind(i)=0; + sumTRAP_dir(i)=0; + sumEVAP_dir(i)=0; + for j=(i-1)*48+1:i*48 + sumTRAP_ind(i)=TRAP_ind(j)+sumTRAP_ind(i); + sumEVAP_ind(i)=EVAP_ind(j)+sumEVAP_ind(i); + sumTRAP_dir(i)=TRAP(j)+sumTRAP_dir(i); + sumEVAP_dir(i)=EVAP(j)+sumEVAP_dir(i); + end + end + run PlotResults1 +end diff --git a/src/Max_Rootdepth.m b/src/Max_Rootdepth.m new file mode 100644 index 00000000..2d49f838 --- /dev/null +++ b/src/Max_Rootdepth.m @@ -0,0 +1,46 @@ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% Subfunction - Root - Depth % +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%%REFERENCES +function[bbx]=Max_Rootdepth(bbx,NL,KT,Ta) +%%% INPUTS +global DeltZ LR +% BR = 10:1:650; %% [gC /m^2 PFT] +% rroot = 0.5*1e-3 ; % 3.3*1e-4 ;%% [0.5-6 *10^-3] [m] root radius +%%% OUTPUTS + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + %%%%%%%%%%%%%%%%%%%%%% Root lenth distribution %%%%%%%%%%%%%%%%%%%%%%%%% + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + if Ta>40 + Ta=40; + end + if Ta<10 + Ta=10; + end + % Lm=123; + % RL0=20; + %r=9.48915E-07; % root growth rate cm/s + % fr(KT)=RL0/(RL0+(Lm-RL0)*exp((-1)*(r*TIME))); + % LR(KT)=Lm*fr(KT); + if KT<=1 + LR=35; + else + LR=LR+(Ta-10)*0.0015; + if LR>55 + LR=55; + end + end + RL=500; + Elmn_Lnth=0; + for ML=1:NL + Elmn_Lnth=Elmn_Lnth+DeltZ(ML); + if Elmn_Lnth=RL-LR && Elmn_Lnth<=RL-0.1*LR + bbx(ML)=1; + else + bbx(ML)=0; + end + end +end \ No newline at end of file diff --git a/src/ObservationPoints.m b/src/ObservationPoints.m new file mode 100644 index 00000000..0d5f3bd4 --- /dev/null +++ b/src/ObservationPoints.m @@ -0,0 +1,23 @@ + + %% With 37 node-500cm Length KT=681 with 0.35/3600 Prep., while KT=708 with 0.4/3600 +% 2cm 5cm 10cm 20cm 30cm 40cm 50cm +% 34 31 26 21 19 17 15 +%% +% Moni_Depth=[34 31 26 21 19 17 15]; +% Moni_Depth_SM=[26 21 19 17 15]; + +% Sim_Theta(KT,1:5)=Theta_LLL(Moni_Depth_SM,1,KT); +% Sim_Temp(KT,1:7)=TTT(Moni_Depth,KT); + + + Moni_Depth=45:-1:1; + Moni_Depth_SM=45:-1:1; + Moni_Depth_RT=45:-1:1; + + + Sim_Theta(KT,1:length(Moni_Depth_SM))=Theta_LLL(Moni_Depth_SM,1,KT); + Sim_Temp(KT,1:length(Moni_Depth))=TTT(Moni_Depth,KT); + if rwuef==1 + Sim_SRT(KT,1:length(Moni_Depth))=SRT(Moni_Depth,KT); + end + diff --git a/src/PHENOLOGY_STATE.m b/src/PHENOLOGY_STATE.m new file mode 100644 index 00000000..c4e52181 --- /dev/null +++ b/src/PHENOLOGY_STATE.m @@ -0,0 +1,112 @@ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% Subfunction PHENOLOGY_STATE % +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +function[PHE_S,dflo,AgeL,AgeDL]= PHENOLOGY_STATE(NLeaf,AgeLtm1,dtd,... + LAIdead,NLeafdead,AgeDLtm1,... + PHE_Stm1,LAI,aSE,age_cr,jDay,Tsmm,Bfac,NPPm,PAR_Im,L_day,Bfac_lo,Bfac_ls,Tlo,Tls,mjDay,LDay_min,LDay_cr,dflotm1,dmg,PAR_th,LAI_min,jDay_dist) +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%%%%%%% INPUT +%%% NLeaf [] New Leaf [LAI] +%%% LAI [] Leaf Area Index +%%% AgeLtm1 [day] Age(t-1) +%%% dtd daily time step +%%% PHE_Stm1 [#] Phenology State(t-1) +%%%%% DORMANT 1 - MAX GROWTH 2 - NORMAL GROWTH 3 - SENESCENCE 4 +%%%% Tsmm last 30 days mean Soil Temperature +%%%% Omm last 7 day mean Soil Moisture +%%%% NPPm last 7 days mean NPP +%%% L_day length of the day [h] +%%% Bfac_lo [0-1] Critical Value Relative Moisture Leaf Onset +%%% Bfac_ls [0-1] Critical Value Relative Moisture Leaf shed +%%% Tlo [°C] Critical Temperature Value Leaf Onset +%%% Tls [°C] Critical Temperature Value Leaf Shed +%%% dmg [day] Length Period Days of maximum Growth +%%% LDay_cr length of the day critical for senescence passage [h] +%%% Minimum LAI to pass in Dormant Phenology +%%% aSE %%% PHENOLOGY KIND +%%% -- 1 Seasonal Plant -- 0 Evergreen -- 2 Grass species -- 3 Crops +%%% mjDay maximum julian day +%%%%%% OUTPUT +%%% dflo [day] from Leaf onset +%%% AgeL [day] Average Age of Leaf +%%% PHE_S [#] Phenology State +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +if (aSE == 0) || (aSE == 1) || (aSE == 2) + PAR_th = -Inf; +end +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%Bfac = %% Moisture Stress +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%%%% ALL THE CASES Decidous - Grass - Crop - Evergreen %%%%%%% +%%%%% DORMANT 1 - MAX GROWTH 2 - NORMAL GROWTH 3 - SENESCENCE 4 +switch PHE_Stm1 + case 1 + if mjDay > 0 + if (Tsmm >= Tlo) && (Bfac >= Bfac_lo) && (jDay <= mjDay) && (L_day >= LDay_min ) && (PAR_Im>PAR_th) %% Criteria Leaf onset + PHE_S = 2; + dflo = 1; + else + PHE_S = 1; + if (aSE == 3) + dflo = dflotm1 - 365/(365-age_cr); dflo(dflo<0)=0; + else + dflo = 0; + end + end + else + if (Tsmm >= Tlo) && (Bfac >= Bfac_lo) && (jDay >= -mjDay) && (L_day >= LDay_min ) && (PAR_Im>PAR_th) %% Criteria Leaf onset + PHE_S = 2; + dflo = 1; + else + PHE_S = 1; + if (aSE == 3) + dflo = dflotm1 - 365/(365-age_cr); dflo(dflo<0)=0; + else + dflo = 0; + end + end + end + case 2 + dflo = dflotm1 +1; + if dflo <= dmg + PHE_S= 2; + else + PHE_S= 3; + end + if (LAI <= LAI_min) && isempty(intersect(jDay,jDay_dist)) && (dflo>=5) + PHE_S=1; + end + case 3 + dflo = dflotm1 + 1; + if (L_day <= LDay_cr ) %% || (Tsmm < Tls) || (Bfac < Bfac_ls) %% || (NPPm < 0) %% Criteria Leaf senescense begin + PHE_S = 4; + else + PHE_S = 3; + end + if (aSE == 3) && (dflo >= age_cr) %%%% (AgeLtm1 >= age_cr) (PAR_Im<-PAR_th) + PHE_S = 4; + end + if (LAI <= LAI_min) && isempty(intersect(jDay,jDay_dist)) %% + PHE_S=1; + end + case 4 + dflo = dflotm1 + 1; + if LAI <= LAI_min || (aSE == 0) || (aSE == 2) || (aSE == 3) + PHE_S = 1; + else + PHE_S = 4; + end +end +%%%%%%%% LEAF AGE UPDATE %%%%%%%%%%%%%%%% +if LAI > LAI_min + AgeL = ((LAI-NLeaf)*(AgeLtm1+dtd) + NLeaf*(0+dtd))/(LAI); +else + AgeL = 0; +end +if LAIdead > LAI_min + AgeDL = ((LAIdead-NLeafdead)*(AgeDLtm1+dtd) + NLeafdead*(0+dtd))/(LAIdead); +else + AgeDL = 0; +end +end +%%%%%%%%%%%%%%%%%%%%%%%% diff --git a/src/PlotResults1.m b/src/PlotResults1.m new file mode 100644 index 00000000..24bec32b --- /dev/null +++ b/src/PlotResults1.m @@ -0,0 +1,48 @@ +global RHOV_A Msrmn_Fitting Msr_Mois Msr_Temp Msr_Time QMTT%Trap EVAP_ind TRAP_ind Sim_Theta_ind Sim_Theta EVAP_dir TRAP_dir ET_H E_D ET_D sumTRAP_dir sumEVAP_dir + +disp ('Convergence Achieved.') +figure; +subplot(3,3,1); plot (hhh, 'DisplayName','hhh', 'YDataSource', 'hhh'); +subplot(3,3,2); plot(TTT, 'DisplayName','TTT', 'YDataSource', 'TTT'); +subplot(3,3,3); plot(SUMTIME,QMTT); +subplot(3,3,4); plot(SUMTIME,Evapo); +subplot(3,3,5); plot(SUMTIME,trap); +subplot(3,3,6); plot(SUMTIME,Ta(1:KT)); +subplot(3,3,7); plot(SUMTIME,U(1:KT)); +subplot(3,3,8); plot(SUMTIME,HR_a(1:KT)); +subplot(3,3,9); plot(SUMTIME,RHOV_A(1:KT)); + +if Msrmn_Fitting + fig1=figure; + subplot(5,1,1);plot (SUMTIME/3600, Sim_Theta_ind(:,17), 'r-',SUMTIME/3600,Sim_Theta(:,17), 'g-',Msr_Time/3600, Msr_Mois(1,:),'b.','LineWidth',2);title('20cm'); + subplot(5,1,2);plot (SUMTIME/3600, Sim_Theta_ind(:,21), 'r-',SUMTIME/3600,Sim_Theta(:,21), 'g-',Msr_Time/3600, Msr_Mois(2,:),'b.','LineWidth',2);title('40cm'); + subplot(5,1,3);plot (SUMTIME/3600, Sim_Theta_ind(:,24), 'r-',SUMTIME/3600,Sim_Theta(:,24), 'g-',Msr_Time/3600, Msr_Mois(3,:),'b.','LineWidth',2);title('60cm'); + ylabel('Soil moisture \theta','Rotation',90) + subplot(5,1,4);plot (SUMTIME/3600, Sim_Theta_ind(:,26), 'r-',SUMTIME/3600,Sim_Theta(:,26), 'g-',Msr_Time/3600, Msr_Mois(4,:),'b.','LineWidth',2);title('80cm'); + subplot(5,1,5);plot (SUMTIME/3600, Sim_Theta_ind(:,28), 'r-',SUMTIME/3600,Sim_Theta(:,28), 'g-',Msr_Time/3600, Msr_Mois(5,:),'b.','LineWidth',2);title('100cm'); + xlabel('Time(h)'); + legend('\thetaind','\thetadir','\thetaobs') + fig2=figure; + subplot(5,1,1);plot (SUMTIME/3600, Sim_Temp_ind(:,17), 'r-' ,SUMTIME/3600, Sim_Temp(:,17), 'g-' ,Msr_Time/3600, Msr_Temp(1,:),'b.','LineWidth',2);title('20cm'); + subplot(5,1,2);plot (SUMTIME/3600, Sim_Temp_ind(:,21), 'r-' ,SUMTIME/3600, Sim_Temp(:,21), 'g-' ,Msr_Time/3600, Msr_Temp(2,:),'b.','LineWidth',2);title('40cm'); + subplot(5,1,3);plot (SUMTIME/3600, Sim_Temp_ind(:,24), 'r-' ,SUMTIME/3600, Sim_Temp(:,24), 'g-' ,Msr_Time/3600, Msr_Temp(3,:),'b.','LineWidth',2);title('60cm'); + ylabel('Soil temperature T','Rotation',90) + subplot(5,1,4);plot (SUMTIME/3600, Sim_Temp_ind(:,26), 'r-' ,SUMTIME/3600, Sim_Temp(:,26), 'g-' ,Msr_Time/3600, Msr_Temp(4,:),'b.','LineWidth',2);title('80cm'); + subplot(5,1,5);plot (SUMTIME/3600, Sim_Temp_ind(:,28), 'r-' ,SUMTIME/3600, Sim_Temp(:,28), 'g-' ,Msr_Time/3600, Msr_Temp(5,:),'b.','LineWidth',2);title('100cm'); + xlabel('Time(h)'); + legend('Tind','Tdir','Tobs') + fig3=figure; + plot (SUMTIME/3600, EVAP_ind+TRAP_ind, 'b-' ,SUMTIME/3600, EVAP_dir+TRAP_dir, 'r-' ,Msr_Time/3600,ET_H,'ko','LineWidth',2,'MarkerSize',5); + xlabel('Time(h)'); + ylabel('EvapoTranspiration ET(mm)','Rotation',90); + legend('ETind','ETdir','ETobs','Location','best') + fig4=figure; + subplot(2,1,1);plot (175:275, sumEVAP_ind+sumTRAP_ind, 'b-' ,175:275, sumEVAP_dir+sumTRAP_dir, 'r-' ,175:275,ET_D(1:101),'ko','LineWidth',2,'MarkerSize',5); + xlabel('DOY'); + ylabel('EvapoTranspiration ET(mm)','Rotation',90); + legend('ETind','ETdir','ETobs','Location','best') + subplot(2,1,2);plot (175:275, sumEVAP_ind, 'b-' ,175:275, sumEVAP_dir, 'r-' ,175:275,E_D(1:101),'ko','LineWidth',2,'MarkerSize',5); + xlabel('DOY'); + ylabel('Evaporation E(mm)','Rotation',90); + legend('Eind','Edir','Eobs','Location','best') +end \ No newline at end of file diff --git a/src/RTMf.m b/src/RTMf.m new file mode 100644 index 00000000..73f06abf --- /dev/null +++ b/src/RTMf.m @@ -0,0 +1,301 @@ +function [rad,profiles] = RTMf(spectral,rad,soil,leafopt,canopy,gap,angles,profiles) + +% function 'RTMf' calculates the spectrum of fluorescent radiance in the +% observer's direction in addition to the total TOC spectral hemispherical upward Fs flux +% +% Authors: Wout Verhoef and Christiaan van der Tol (c.vandertol@utwente.nl) +% Date: 12 Dec 2007 +% Update: 26 Aug 2008 CvdT Small correction to matrices +% 07 Nov 2008 CvdT Changed layout +% Update: 19 Mar 2009 CvdT Major corrections: lines 95-96, +% 101-107, and 119-120. +% Update: 7 Apr 2009 WV & CvdT Major correction: lines 89-90, azimuth +% dependence was not there in previous verions (implicit assumption of +% azimuth(solar-viewing) = 0). This has been corrected +% Update: May-June 2012 WV & CvdT Add calculation of hemispherical Fs +% fluxes +% Update: Jan-Feb 2013 WV Inputs and outputs via structures for +% SCOPE Version 1.40 +% Update: Jan 2015 CvdT Added two contributions to SIF radiance cuased by rescattering of hemispherical SIF fluxes +% Update: Jan 2015 JAK (from SCOPE 1.53): Improved speed by factor of 9+! (by vectorizing the summation over the 60 layers) +% Update: Jan 2015 WV Rearranged some arrays to smoothen the vectorizations; adjusted some internal names +% +% The inputs and outputs are structures. These structures are further +% specified in a readme file. +% +% Input: +% spectral information about wavelengths and resolutions +% rad a large number of radiative fluxes: spectrally distributed +% and integrated, and canopy radiative transfer coefficients. +% soil soil properties +% leafopt leaf optical properties +% canopy canopy properties (such as LAI and height) +% gap probabilities of direct light penetration and viewing +% angles viewing and observation angles +% profiles vertical profiles of fluxes +% +% Output: +% rad a large number of radiative fluxes: spectrally distributed +% and integrated, and canopy radiative transfer coefficients. +% Here, fluorescence fluxes are added +%% 0.0 globals +global constants + +%% initialisations +wlS = spectral.wlS'; % SCOPE wavelengths, make column vectors +wlF = spectral.wlF'; % Fluorescence wavelengths +wlE = spectral.wlE'; % Excitation wavelengths +[dummy,iwlfi] = intersect(wlS,wlE); %#ok +[dummy,iwlfo] = intersect(wlS,wlF); %#ok +nf = length(iwlfo); +ne = length(iwlfi); +nl = canopy.nlayers; +LAI = canopy.LAI; +litab = canopy.litab; +lazitab = canopy.lazitab; +lidf = canopy.lidf; +nlinc = length(litab); +nlazi = length(lazitab); +nlori = nlinc * nlazi; % total number of leaf orientations +layers = 1:nl; + +vb = rad.vb(iwlfo); % added for rescattering of SIF fluxes +vf = rad.vf(iwlfo); + +Ps = gap.Ps; % [nl+1] +Po = gap.Po; +Pso = gap.Pso; + +Qso = (Pso(layers) + Pso(layers+1))/2; +Qs = (Ps(layers) + Ps(layers+1))/2; +Qo = (Po(layers) + Po(layers+1))/2; +Qsho = Qo - Qso; + +etah = zeros(nl,1); +etau = zeros(nl,nlori); % modified dimensions to facilitate vectorization + +[Mb,Mf] = deal(zeros(nf,ne)); +LoF_ = zeros(nf,2); +Fhem_ = zeros(nf,2); +Fiprofile = zeros(nl+1,2); +[LoF_1,LoF_2,LoF_3,LoF_4] = deal(zeros(nf,2)); + +% for speed-up the calculation only uses wavelength i and wavelength o part of the spectrum + +Esunf_ = rad.Esun_(iwlfi); +Eminf_ = rad.Emin_(:,iwlfi)'; % transpose into [nf,nl+1] matrix +Epluf_ = rad.Eplu_(:,iwlfi)'; +iLAI = LAI/nl; % LAI of a layer + +%% optical quantities + +rho = leafopt.refl(iwlfo); % [nf] leaf/needle reflectance +tau = leafopt.tran(iwlfo); % [nf] leaf/needle transmittance + +if isfield(leafopt,'MbI') + MbI = leafopt.MbI; + MbII = leafopt.MbII; + MfI = leafopt.MfI; + MfII = leafopt.MfII; +else + MbII = leafopt.Mb; + MfII = leafopt.Mf; +end + +rs = soil.refl(spectral.IwlF); % [nf] soil reflectance + +% geometric factors + +deg2rad = constants.deg2rad; +tto = angles.tto; +tts = angles.tts; +psi = angles.psi; + +cos_tto = cos(tto*deg2rad); % cos observation zenith angle +sin_tto = sin(tto*deg2rad); % sin observation zenith angle + +cos_tts = cos(tts*deg2rad); % cos solar angle +sin_tts = sin(tts*deg2rad); % sin solar angle + +cos_ttli = cos(litab*deg2rad); % cos leaf inclinaation angles +sin_ttli = sin(litab*deg2rad); % sin leaf inclinaation angles +cos_phils = cos(lazitab*deg2rad); % cos leaf azimuth angles rel. to sun azi +cos_philo = cos((lazitab-psi)*deg2rad); % cos leaf azimuth angles rel. to viewing azi + +%% geometric factors for all leaf angle/azumith classes +cds = cos_ttli*cos_tts*ones(1,nlazi) + sin_ttli*sin_tts*cos_phils; % [nlinc,nlazi] +cdo = cos_ttli*cos_tto*ones(1,nlazi) + sin_ttli*sin_tto*cos_philo; % [nlinc,nlazi] +fs = cds/cos_tts; % [nlinc,nlazi] +absfs = abs(fs); % [nlinc,nlazi] +fo = cdo/cos_tto; % [nlinc,nlazi] +absfo = abs(fo); % [nlinc,nlazi] +fsfo = fs.*fo; % [nlinc,nlazi] +absfsfo = abs(fsfo); % [nlinc,nlazi] +foctl = fo.*(cos_ttli*ones(1,nlazi)); % [nlinc,nlazi] +fsctl = fs.*(cos_ttli*ones(1,nlazi)); % [nlinc,nlazi] +ctl2 = cos_ttli.^2*ones(1,nlazi); % [nlinc,nlazi] + +%% calculation of fluorescence in observation direction + +% fluorescence efficiencies from ebal, after default fqe has been applied + +etahi = profiles.etah; +etaur = permute(profiles.etau,[3 1 2]); % make dimensions [nl,nlinc,nlazi] +etaui = reshape(etaur,nl,nlori); % expand orientations in a vector >> [nl,nlori] + +% fluorescence matrices and efficiencies for PSI and PSII + +[Emin_,Eplu_] = deal(zeros(nl+1,nf)); +[Fmin_,Fplu_] = deal(zeros(nf,nl+1,2)); +Fem = zeros(nf,2); + +for PS = 2:-1:2-isfield(leafopt,'MbI') % Do for both photosystems II and I (or alternatively for only one PS, in this case PSII) + + switch PS + case 1, Mb = MbI; Mf = MfI; etah(:) = 1; etau(:) = 1; + case 2, Mb = MbII; Mf = MfII; etah(:) = etahi(:); etau(:) = etaui(:); + end + + Mplu = 0.5 * (Mb+Mf); % [nf,ne] + Mmin = 0.5 * (Mb-Mf); + + % in-products: we convert incoming radiation to a fluorescence spectrum using the matrices. + % resolution assumed is 1 nm + + MpluEmin = Mplu * Eminf_; % [nf,nl+1] = (nf,ne) * (ne,nl+1) + MpluEplu = Mplu * Epluf_; + MminEmin = Mmin * Eminf_; + MminEplu = Mmin * Epluf_; + + MpluEsun = Mplu * Esunf_; % integration by inproduct + MminEsun = Mmin * Esunf_; + + xdd2 = mean(ctl2' * lidf); % lidf-weighted cosine squared of leaf inclination + mn_etau = mean(reshape(etau,nl,nlinc,nlazi),3) * lidf; % lidf-weighted mean of etau per layer [nl] + + % we calculate the spectrum for all individual leaves, sunlit and + % shaded + + [Fmin,Fplu] = deal(zeros(nf,nl+1)); + [G1,G2] = deal(zeros(nl+1,1)); + + for i = 1 : nf + + Qso_wfEs = Qso * reshape(absfsfo * MpluEsun(i) + fsfo * MminEsun(i),1,nlori); % [1,nlori] + Qs_sfEs = Qs *reshape(absfs * MpluEsun(i) - fsctl * MminEsun(i),1,nlori); + Qs_sbEs = Qs * reshape(absfs * MpluEsun(i) + fsctl * MminEsun(i),1,nlori); + + + + Mplu_i(layers) = MpluEmin(i,layers) + MpluEplu(i,layers+1); % [1,nl] + Mmin_i(layers) = MminEmin(i,layers) - MminEplu(i,layers+1); + + sigfEmini_sigbEplui = Mplu_i' - xdd2 * Mmin_i'; % [nl] + sigbEmini_sigfEplui = Mplu_i' + xdd2 * Mmin_i'; + + Qso_Mplu = Qso .* Mplu_i'; % [nl] + Qso_Mmin = Qso .* Mmin_i'; + Qsho_Mplu = Qsho .* Mplu_i'; + Qsho_Mmin = Qsho .* Mmin_i'; + + Qso_vEd = Qso_Mplu * reshape(absfo,1,nlori) + Qso_Mmin * reshape(foctl,1,nlori); + Qsh_vEd = Qsho_Mplu * reshape(absfo,1,nlori) + Qsho_Mmin * reshape(foctl,1,nlori); + + % Directly observed fluorescence contributions from sunlit and + % shaded leaves + + piLs = mean(reshape(etau .*(Qso_wfEs + Qso_vEd),nl,nlinc,nlazi),3) * lidf; + piLd = etah .* (mean(reshape(Qsh_vEd,nl,nlinc,nlazi),3) * lidf); + + piLo1 = iLAI * sum(piLs) ; + piLo2 = iLAI * sum(piLd); + + Qs_Fsmin = mean(reshape(etau .* Qs_sfEs,nl,nlinc,nlazi),3) * lidf ... + + Qs .* mn_etau .* sigfEmini_sigbEplui; + Qs_Fsplu = mean(reshape(etau .* Qs_sbEs,nl,nlinc,nlazi),3) * lidf ... + + Qs .* mn_etau .* sigbEmini_sigfEplui; + + Qd_Fdmin = (1-Qs) .* etah .* sigfEmini_sigbEplui; + Qd_Fdplu = (1-Qs) .* etah .* sigbEmini_sigfEplui; + + Fmin(i,layers+1) = Qs_Fsmin + Qd_Fdmin; + Fplu(i,layers) = Qs_Fsplu + Qd_Fdplu; + + t2 = xdd2 * (rho(i)-tau(i))/2; + att = 1-(rho(i)+tau(i))/2+t2; + sig = (rho(i)+tau(i))/2+t2; + m = sqrt(att^2-sig^2); + rinf = (att - m)/sig; + fac = 1 - m * iLAI; + facs = (rs(i)-rinf)/(1-rs(i)*rinf); + + + % Transformed SIF fluxes calculated numerically + + G1(1) = 2; Gnew = 0; % (to ensure we will enter the loop the first time) + + dF1 = (Fmin(i,layers+1) + rinf * Fplu(i,layers)) * iLAI; % Thanks to JAK + dF2 = (rinf * Fmin(i,layers+1) + Fplu(i,layers)) * iLAI; % These are the source functions + + while abs(Gnew-G1(1)) > 1e-3 + G1(1) = Gnew; + for j=2:nl+1 + G1(j) = fac * G1(j-1) + dF1(j-1); + end + G2(nl+1) = G1(nl+1) * facs; + for j=nl:-1:1 + G2(j) = fac * G2(j+1) + dF2(j); + end + Gnew = -rinf * G2(1); + end + + % Inverse transformation to get back the hemispherical fluxes + + Fplu_(i,:,PS) = (rinf*G1+G2)/(1-rinf^2); + Fmin_(i,:,PS) = (rinf*G2+G1)/(1-rinf^2); + + Fhem_(i,PS) = Fplu_(i,1,PS); + + % The following contributions are coming from: + + % 3) Rescattered SIF at observed leaves + % 4) SIF flux reflected by observed soil + + piLo3 = iLAI * ((vb(i)*Fmin_(i,layers,PS) + vf(i)*Fplu_(i,layers+1,PS)) * Qo); + piLo4 = rs(i) * Fmin_(i,nl+1,PS) * Po(nl+1); + + piLtoti = piLo1 + piLo2 + piLo3 + piLo4; + LoF_(i,PS) = piLtoti/pi; + + LoF_1(i,PS) = piLo1/pi; + LoF_2(i,PS) = piLo2/pi; + LoF_3(i,PS) = piLo3/pi; + LoF_4(i,PS) = piLo4/pi; + end + + Fem(:,PS) = iLAI*sum(Fplu+Fmin,2); + + for ilayer = 1:nl+1 + Fiprofile(ilayer,PS) = 0.001 * helpers.Sint(Fplu(:,ilayer),spectral.wlF); + end +end +rad.Fem_ = Fem(:,1) + Fem(:,2); +rad.Fhem_ = Fem(:,1) + Fem(:,2); +rad.LoF_ = LoF_(:,1) + LoF_(:,2); +if isfield(leafopt,'MbI') + rad.LoF1_ = LoF_(:,1); + rad.LoF2_ = LoF_(:,2); +end +rad.Fhem_ = Fhem_(:,1) + Fhem_(:,2); +rad.Fmin = sum(Fmin_,3); +rad.Fplu = sum(Fplu_,3); +rad.LoF_sunlit = LoF_1; +rad.LoF_shaded = LoF_2; +rad.LoF_scattered = LoF_3; +rad.LoF_soil = LoF_4; + +profiles.fluorescence = Fiprofile(:,1) + Fiprofile(:,2); + +rad.Eoutf = 0.001 * helpers.Sint(sum(Fhem_,2),spectral.wlF); +rad.Eminf_ = Emin_; +rad.Epluf_ = Eplu_; diff --git a/src/RTMo.m b/src/RTMo.m new file mode 100644 index 00000000..d0ade6bb --- /dev/null +++ b/src/RTMo.m @@ -0,0 +1,603 @@ +function [rad,gap,profiles] = RTMo(spectral,atmo,soil,leafopt,canopy,angles,meteo,rad,options) + +%% function RTMo +% +% calculates the spectra of hemisperical and directional observed visible +% and thermal radiation (fluxes E and radiances L), as well as the single +% and bi-directional gap probabilities +% +% the function does not require any non-standard Matlab functions. No +% changes to the code have to be made to operate the function for a +% particular canopy. All necessary parameters and variables are input or +% global and need to be specified elsewhere. +% +% Authors: Wout Verhoef (verhoef@nlr.nl) +% Christiaan van der Tol (tol@itc.nl) +% Joris Timmermans (j_timmermans@itc.nl) +% +% updates: 10 Sep 2007 (CvdT) - calculation of Rn +% 5 Nov 2007 - included observation direction +% 12 Nov 2007 - included abs. PAR spectrum output +% - improved calculation efficiency +% 13 Nov 2007 - written readme lines +% 11 Feb 2008 (WV&JT) - changed Volscat +% (JT) - small change in calculation Po,Ps,Pso +% - introduced parameter 'lazitab' +% - changed nomenclature +% - Appendix IV: cosine rule +% 04 Aug 2008 (JT) - Corrections for Hotspot effect in the probabilities +% 05 Nov 2008 (CvdT) - Changed layout +% 04 Jan 2011 (JT & CvdT) - Included Pso function (Appendix IV) +% - removed the analytical function (for checking) +% 02 Oct 2012 (CvdT) - included incident PAR in output +% +% Jan/Feb 2013 (WV) - Major revision towards SCOPE version 1.40: +% - Parameters passed using structures +% - Improved interface with MODTRAN atmospheric data +% - Now also calculates 4-stream +% reflectances rso, rdo, rsd and rdd +% analytically +% Apri 2013 (CvT) - improvements in variable names +% and descriptions +% +% Table of contents of the function +% +% 0. Preparations +% 0.1 parameters +% 0.2 initialisations +% 1. Geometric quantities +% 1.1 general geometric quantities +% 1.2 geometric factors associated with extinction and scattering +% 1.3 geometric factors to be used later with rho and tau +% 1.4 solar irradiance factor for all leaf orientations +% 1.5 probabilities Ps, Po, Pso +% 2. Calculation of upward and downward fluxes +% 3. Outgoing fluxes, hemispherical and in viewing direction, spectrum +% 4. Net fluxes, spectral and total, and incoming fluxes +% A1 functions J1 and J2 (introduced for stable solutions) +% A2 function volscat +% A3 function e2phot +% A4 function Pso +% +% references: +%{1} Verhoef (1998), 'Theory of radiative transfer models applied in +% optical remote sensing of vegetation canopies'. PhD Thesis Univ. Wageninegn +%{2} Verhoef, W., Jia, L., Xiao, Q. and Su, Z. (2007) Unified optical - +% thermal four - stream radiative transfer theory for homogeneous +% vegetation canopies. IEEE Transactions on geoscience and remote +% sensing, 45,6. +%{3} Verhoef (1985), 'Earth Observation Modeling based on Layer Scattering +% Matrices', Remote sensing of Environment, 17:167-175 +% +% Usage: +% function [rad,gap,profiles] = RTMo(spectral,atmo,soil,leafopt,canopy,angles,meteo,rad,options) +% +% The input and output are structures. These structures are further +% specified in a readme file. +% +% Input: +% spectral information about wavelengths and resolutions +% atmo MODTRAN atmospheric parameters +% soil soil properties +% leafopt leaf optical properties +% canopy canopy properties (such as LAI and height) +% angles viewing and observation angles +% meteo has the meteorological variables. Is only used to correct +% the total irradiance if a specific value is provided +% instead of the usual Modtran output. +% rad initialization of the structure of the output 'rad' +% options simulation options. Here, the option +% 'calc_vert_profiles' is used, a boolean that tells whether +% or not to output data of 60 layers separately. +% +% Output: +% gap probabilities of direct light penetration and viewing +% rad a large number of radiative fluxes: spectrally distributed +% and integrated, and canopy radiative transfer coefficients. +% profiles vertical profiles of radiation variables such as absorbed +% PAR. + +%% 0. Preparations +deg2rad = pi/180; +wl = spectral.wlS'; % SCOPE wavelengths as a column-vector +nwl = length(wl); + +wlP = spectral.wlP; +wlT = spectral.wlT; +wlPAR = spectral.wlPAR'; % PAR wavelength range +minPAR = min(wlPAR); +maxPAR = max(wlPAR); +Ipar = find(wl>=minPAR & wl<=maxPAR); % Indices for PAR wavelenghts within wl + +tts = angles.tts; % solar zenith angle +tto = angles.tto; % observer zenith angle +psi = angles.psi; % relative azimuth anglee + +nl = canopy.nlayers; % number of canopy layers (60) +litab = canopy.litab; % SAIL leaf inclibation angles +lazitab = canopy.lazitab; % leaf azimuth angles relative to the sun +nli = canopy.nlincl; % numler of leaf inclinations (13) +nlazi = canopy.nlazi; % number of azimuth angles (36) +LAI = canopy.LAI; % leaf area index +lidf = canopy.lidf; % leaf inclination distribution function +x = canopy.x; % all levels except for the top +dx = 1/nl; + +kChlrel = leafopt.kChlrel; +rho = leafopt.refl; % [nwl] leaf/needle reflection +tau = leafopt.tran; % [nwl] leaf/needle transmission +rs = soil.refl; % [nwl,nsoils] soil reflectance spectra +epsc = 1-rho-tau; % [nwl] emissivity of leaves +epss = 1-rs; % [nwl] emissivity of soil +iLAI = LAI/nl; % [1] LAI of elementary layer +xl = [0; x]; % [nl+1] all levels + soil + +% 0.2 initialisations (allocation of memory) +Rndif = zeros(nl,1); % [nl+1] abs. diffuse rad soil+veg +[Pdif,Pndif,Pndif_Cab,Rndif_PAR] = deal(zeros(nl,1)); % [nl] incident and net PAR veg +[Emin_,Eplu_] = deal(zeros(nl+1,nwl)); % [nl+1,nwl] up and down diff. rad. +[Rndif_] = zeros(nl,nwl); % [nl,nwl] abs diff and PAR veg. +[Pndif_,Pndif_Cab_,Rndif_PAR_] = deal(zeros(nl,length(Ipar))); +[Puc,Rnuc,Pnuc,Pnuc_Cab,Rnuc_PAR] = deal(zeros(nli,nlazi,nl)); % [nli,nlazi,nl] inc and net rad and PAR sunlit + +%% 1.0 Geometric quantities +% 1.1 general geometric quantities +% these variables are scalars +cos_tts = cos(tts*deg2rad); % cos solar angle +tan_tto = tan(tto*deg2rad); % tan observation angle + +cos_tto = cos(tto*deg2rad); % cos observation angle +sin_tts = sin(tts*deg2rad); % sin solar angle +tan_tts = tan(tts*deg2rad); % tan observation angle + +psi = abs(psi-360*round(psi/360)); % (to ensure that volscatt is symmetric for psi=90 and psi=270) +dso = sqrt(tan_tts.^2 + tan_tto.^2 - 2*tan_tts.*tan_tto.*cos(psi*deg2rad)); + +% 1.2 geometric factors associated with extinction and scattering +[chi_s,chi_o,frho,ftau]=volscat(tts,tto,psi,litab); % volume scattering + +cos_ttlo = cos(lazitab*deg2rad); % [1,36] cos leaf azimuth angles + +cos_ttli = cos(litab*deg2rad); % [13] cos leaf angles +sin_ttli = sin(litab*deg2rad); % [13] sinus leaf angles + +ksli = chi_s./cos_tts; % [13] p306{1} extinction coefficient in direction of sun per leaf angle +koli = chi_o./cos_tto; % [13] p307{1} extinction coefficient in direction of observer per leaf angle + +sobli = frho*pi/(cos_tts*cos_tto); % [13] pag 309{1} area scattering coefficient fractions +sofli = ftau*pi/(cos_tts*cos_tto); % [13] pag 309{1} +bfli = cos_ttli.^2; % [13] + +%integration over angles (using a vector inproduct) -> scalars +k = ksli'*lidf; % pag 306{1} extinction coefficient in direction of sun. +K = koli'*lidf; % pag 307{1} extinction coefficient in direction of observer +bf = bfli'*lidf; % +sob = sobli'*lidf; % weight of specular2directional back scatter coefficient +sof = sofli'*lidf; % weight of specular2directional forward scatter coefficient +% 1.3 geometric factors to be used later with rho and tau, f1 f2 of pag 304: +% these variables are scalars +sdb = 0.5*(k+bf); % fs*f1 +sdf = 0.5*(k-bf); % fs*f2 weight of specular2diffuse foward scatter coefficient +ddb = 0.5*(1+bf); % f1^2+f2^2 weight of diffuse2diffuse back scatter coefficient +ddf = 0.5*(1-bf); % 2*f1*f2 weight of diffuse2diffuse forward scatter coefficient +dob = 0.5*(K+bf); % fo*f1 weight of diffuse2directional back scatter coefficient +dof = 0.5*(K-bf); % fo*f2 weight of diffuse2directional forward scatter coefficient + +% 1.4 solar irradiance factor for all leaf orientations +Cs = cos_ttli*cos_tts; % [nli] pag 305 modified by Joris +Ss = sin_ttli*sin_tts; % [nli] pag 305 modified by Joris + +cos_deltas = Cs*ones(1,nlazi) + Ss*cos_ttlo; % [nli,nlazi] +fs = abs(cos_deltas/cos_tts); % [nli,nlazi] pag 305 + +% 1.5 probabilities Ps, Po, Pso +Ps = exp(k*xl*LAI); % [nl+1] p154{1} probability of viewing a leaf in solar dir +Po = exp(K*xl*LAI); % [nl+1] p154{1} probability of viewing a leaf in observation dir + +Ps(1:nl) = Ps(1:nl) *(1-exp(-k*LAI*dx))/(k*LAI*dx); % Correct Ps/Po for finite dx +Po(1:nl) = Po(1:nl) *(1-exp(-K*LAI*dx))/(K*LAI*dx); % Correct Ps/Po for finite dx + + +q = canopy.hot; +Pso = zeros(size(Po)); +for j=1:length(xl) + Pso(j,:)= quad(@(y)Psofunction(K,k,LAI,q,dso,y),xl(j)-dx,xl(j))/dx; %#ok +end + +Pso(Pso>Po)= min([Po(Pso>Po),Ps(Pso>Po)],[],2); %takes care of rounding error +Pso(Pso>Ps)= min([Po(Pso>Ps),Ps(Pso>Ps)],[],2); %takes care of rounding error + +gap.Pso = Pso; + +%% 2. Calculation of upward and downward fluxes + +% the following are vectors with lenght nwl +sigb = ddb*rho + ddf*tau; % [nwl] sigmab, p305{1} diffuse backscatter scattering coefficient for diffuse incidence +sigf = ddf*rho + ddb*tau; % [nwl] sigmaf, p305{1} diffuse forward scattering coefficient for forward incidence +sb = sdb*rho + sdf*tau; % [nwl] sb, p305{1} diffuse backscatter scattering coefficient for specular incidence +sf = sdf*rho + sdb*tau; % [nwl] sf, p305{1} diffuse forward scattering coefficient for specular incidence +vb = dob*rho + dof*tau; % [nwl] vb, p305{1} directional backscatter scattering coefficient for diffuse incidence +vf = dof*rho + dob*tau; % [nwl] vf, p305{1} directional forward scattering coefficient for diffuse incidence +w = sob*rho + sof*tau; % [nwl] w, p309{1} bidirectional scattering coefficent (directional-directional) +a = 1-sigf; % [nwl] attenuation +m = sqrt(a.^2-sigb.^2); % [nwl] +rinf = (a-m)./sigb; % [nwl] +rinf2 = rinf.*rinf; % [nwl] + +% direct solar radiation +J1k = calcJ1(-1, m,k,LAI); % [nwl] +J2k = calcJ2( 0, m,k,LAI); % [nwl] +J1K = calcJ1(-1, m,K,LAI); % [nwl] % added for calculation of rdo +J2K = calcJ2( 0, m,K,LAI); % [nwl] % added for calculation of rdo + +e1 = exp(-m*LAI); % [nwl] +e2 = e1.^2; % [nwl] +re = rinf.*e1; % [nwl] + +denom = 1-rinf2.*e2; % [nwl] + +s1 = sf+rinf.*sb; +s2 = sf.*rinf+sb; +v1 = vf+rinf.*vb; +v2 = vf.*rinf+vb; + +Pss = s1.*J1k; % [nwl] +Qss = s2.*J2k; % [nwl] + +Poo = v1.*J1K; % (nwl) % added for calculation of rdo +Qoo = v2.*J2K; % [nwl] % added for calculation of rdo + +tau_ss = exp(-k*LAI); % [1] +tau_oo = exp(-K*LAI); % [1] + +Z = (1 - tau_ss * tau_oo)/(K + k); % needed for analytic rso + +tau_dd = (1-rinf2).*e1 ./denom; % [nwl] +rho_dd = rinf.*(1-e2) ./denom; % [nwl] +tau_sd = (Pss-re.*Qss) ./denom; % [nwl] +tau_do = (Poo-re.*Qoo) ./denom; % [nwl] +rho_sd = (Qss-re.*Pss) ./denom; % [nwl] +rho_do = (Qoo-re.*Poo) ./denom; % (nwl) + +T1 = v2.*s1.*(Z-J1k*tau_oo)./(K+m)+v1.*s2.*(Z-J1K*tau_ss)./(k+m); +T2 = -(Qoo.*rho_sd+Poo.*tau_sd).*rinf; +rho_sod = (T1+T2)./(1-rinf2); + +rho_sos = w * sum(Pso(1:nl))*iLAI; +rho_so = rho_sod + rho_sos; + +Pso2w = Pso(nl+1); + +% Analytical rso following SAIL + +rso = rho_so + rs * Pso2w ... + + ((tau_sd+tau_ss*rs.*rho_dd)*tau_oo+(tau_sd+tau_ss).*tau_do) ... + .*rs./denom; + +% Extract MODTRAN atmosphere parameters at the SCOPE wavelengths + t1 = atmo.M(:,1); + t3 = atmo.M(:,2); + t4 = atmo.M(:,3); + t5 = atmo.M(:,4); + t12 = atmo.M(:,5); + t16 = atmo.M(:,6); + +% radiation fluxes, downward and upward (these all have dimenstion [nwl] +% first calculate hemispherical reflectances rsd and rdd according to SAIL +% these are assumed for the reflectance of the surroundings +% rdo is computed with SAIL as well + +denom = 1-rs.*rho_dd; + +% SAIL analytical reflectances + +rsd = rho_sd + (tau_ss + tau_sd).*rs.*tau_dd./denom; +rdd = rho_dd + tau_dd.*rs.*tau_dd./denom; + +rdo = rho_do + (tau_oo + tau_do).*rs.*tau_dd./denom; + + + +% assume Fd of surroundings = 0 for the momemnt +% initial guess of temperature of surroundings from Ta; + +Fd = zeros(nwl,1); +Ls = equations.Planck(wl,atmo.Ta+273.15); + +% Solar and sky irradiance using 6 atmosperic functions +%keyboard +Esun_ = pi*t1.*t4; +Esky_ = pi./(1-t3.*rdd).*(t1.*(t5+t12.*rsd)+Fd+(1-rdd).*Ls.*t3+t16); + +% fractional contributions of Esun and Esky to total incident radiation in +% optical and thermal parts of the spectrum +[fEsuno,fEskyo,fEsunt,fEskyt] = deal(0*Esun_); %initialization + +J_o = wl<3000; %find optical spectrum +Esunto = 0.001 * helpers.Sint(Esun_(J_o),wl(J_o)); %Calculate optical sun fluxes (by Integration), including conversion mW >> W +Eskyto = 0.001 * helpers.Sint(Esky_(J_o),wl(J_o)); %Calculate optical sun fluxes (by Integration) +Etoto = Esunto + Eskyto; %Calculate total fluxes +fEsuno(J_o) = Esun_(J_o)/Etoto; %fraction of contribution of Sun fluxes to total light +fEskyo(J_o) = Esky_(J_o)/Etoto; %fraction of contribution of Sky fluxes to total light + +J_t = wl>=3000; %find thermal spectrum +Esuntt = 0.001 * helpers.Sint(Esun_(J_t),wl(J_t)); %Themal solar fluxes +Eskytt = 0.001 * helpers.Sint(Esky_(J_t),wl(J_t)); %Thermal Sky fluxes +Etott = Eskytt + Esuntt; %Total +fEsunt(J_t) = Esun_(J_t)/Etott; %fraction from Esun +fEskyt(J_t) = Esky_(J_t)/Etott; %fraction from Esky + +if meteo.Rin ~= -999 + Esun_(J_o) = fEsuno(J_o)*meteo.Rin; + Esky_(J_o) = fEskyo(J_o)*meteo.Rin; + Esun_(J_t) = fEsunt(J_t)*meteo.Rli; + Esky_(J_t) = fEskyt(J_t)*meteo.Rli; +end + +Eplu_1 = rs.*((tau_ss+tau_sd).*Esun_+tau_dd.*Esky_)./denom; +Eplu0 = rho_sd.*Esun_ + rho_dd.*Esky_ + tau_dd.*Eplu_1; +Emin_1 = tau_sd.*Esun_ + tau_dd.*Esky_ + rho_dd.*Eplu_1; +delta1 = Esky_ - rinf.*Eplu0; +delta2 = Eplu_1 - rinf.*Emin_1; + +% calculation of the fluxes in the canopy +for i = 1:nwl + J1kx = calcJ1(xl,m(i),k,LAI); % [nl] + J2kx = calcJ2(xl,m(i),k,LAI); % [nl] + F1 = Esun_(i)*J1kx*(sf(i)+rinf(i)*sb(i)) + delta1(i)*exp( m(i)*LAI*xl); %[nl] + F2 = Esun_(i)*J2kx*(sb(i)+rinf(i)*sf(i)) + delta2(i)*exp(-m(i)*LAI*(xl+1)); %[nl] + Emin_(:,i) = (F1+rinf(i)*F2)/(1-rinf2(i));% [nl,nwl] + Eplu_(:,i) = (F2+rinf(i)*F1)/(1-rinf2(i));% [nl,nwl] +end + +% Incident and absorbed solar radiation +Psun = 0.001 * helpers.Sint(e2phot(wlPAR*1E-9,Esun_(Ipar)),wlPAR); % Incident solar PAR in PAR units +%Psky = 0.001 * helpers.Sint(e2phot(wlPAR*1E-9,Esky_(Ipar)),wlPAR); +Asun = 0.001 * helpers.Sint(Esun_.*epsc,wl); % Total absorbed solar radiation +Pnsun = 0.001 * helpers.Sint(e2phot(wlPAR*1E-9,Esun_(Ipar).*epsc(Ipar)),wlPAR); % Absorbed solar radiation in PAR range in moles m-2 s-1 +Rnsun_PAR = 0.001 * helpers.Sint(Esun_(Ipar).*epsc(Ipar),wlPAR); +Pnsun_Cab = 0.001 * helpers.Sint(e2phot(wlPAR*1E-9,kChlrel(Ipar).*Esun_(Ipar).*epsc(Ipar)),wlPAR); + % Absorbed solar radiation by Cab in PAR range in moles m-2 s-1 + +%% 3. outgoing fluxes, hemispherical and in viewing direction, spectrum +% (CvdT 071105: compared with analytical solution: is OK) +% hemispherical, spectral +Eout_ = Eplu_(1,:)'; % [nwl] + +% in viewing direction, spectral +piLoc_ = (vb.*(Emin_(1:nl,:)'*Po(1:nl)) +... + vf.*(Eplu_(1:nl,:)'*Po(1:nl)) +... + w.*Esun_*sum(Pso(1:nl)))*iLAI; +piLos_ = rs.*Emin_(nl+1,:)'*Po(nl+1) + rs.*Esun_*Pso(nl+1); +piLo_ = piLoc_ + piLos_; % [nwl] +Lo_ = piLo_/pi; + +% up and down and hemispherical out, cumulative over wavelenght +IwlP = spectral.IwlP; +IwlT = spectral.IwlT; +Eouto = 0.001 * helpers.Sint(Eout_(IwlP),wlP); % [1] hemispherical out, in optical range (W m-2) +Eoutt = 0.001 * helpers.Sint(Eout_(IwlT),wlT); % [1] hemispherical out, in thermal range (W m-2) + +%% 4. net fluxes, spectral and total, and incoming fluxes +% incident PAR at the top of canopy, spectral and spectrally integrated +P_ = e2phot(wl(Ipar)*1E-9,(Esun_(Ipar)+Esky_(Ipar))); +P = .001 * helpers.Sint(P_,wlPAR); + +% total direct radiation (incident and net) per leaf area (W m-2 leaf) +Pdir = fs * Psun; % [13 x 36] incident +Rndir = fs * Asun; % [13 x 36] net +Pndir = fs * Pnsun; % [13 x 36] net PAR +Pndir_Cab = fs * Pnsun_Cab; % [13 x 36] net PAR Cab +Rndir_PAR = fs * Rnsun_PAR; % [13 x 36] net PAR energy units + + +% canopy layers, diffuse radiation +for j = 1:nl + % diffuse incident radiation for the present layer 'j' (mW m-2 um-1) + E_ = .5*(Emin_(j,:) + Emin_(j+1,:)+ Eplu_(j,:)+ Eplu_(j+1,:)); + + % incident PAR flux, integrated over all wavelengths (moles m-2 s-1) + Pdif(j) = .001 * helpers.Sint(e2phot(wlPAR*1E-9,E_(Ipar)'),wlPAR); % [nl] , including conversion mW >> W + + % net radiation (mW m-2 um-1) and net PAR (moles m-2 s-1 um-1), per wavelength + Rndif_(j,:) = E_.*epsc'; % [nl,nwl] Net (absorbed) radiation by leaves + Pndif_(j,:) = .001 *(e2phot(wlPAR*1E-9, Rndif_(j,Ipar)'))'; % [nl,nwl] Net (absorbed) as PAR photons + Pndif_Cab_(j,:) = .001 *(e2phot(wlPAR*1E-9, kChlrel(Ipar).*Rndif_(j,Ipar)'))'; % [nl,nwl] Net (absorbed) as PAR photons by Cab + Rndif_PAR_(j,:) = Rndif_(j,Ipar); % [nl,nwlPAR] Net (absorbed) as PAR energy + + % net radiation (W m-2) and net PAR (moles m-2 s-1), integrated over all wavelengths + Rndif(j) = .001 * helpers.Sint(Rndif_(j,:),wl); % [nl] Full spectrum net diffuse flux + Pndif(j) = helpers.Sint(Pndif_(j,Ipar),wlPAR); % [nl] Absorbed PAR + Pndif_Cab(j) = helpers.Sint(Pndif_Cab_(j,Ipar),wlPAR); % [nl] Absorbed PAR by Cab integrated + Rndif_PAR(j) = .001 * helpers.Sint(Rndif_PAR_(j,Ipar),wlPAR); % [nl] Absorbed PAR by Cab integrated +end + +% soil layer, direct and diffuse radiation +Rndirsoil = .001 * helpers.Sint(Esun_.*epss,wl); % [1] Absorbed solar flux by the soil +Rndifsoil = .001 * helpers.Sint(Emin_(nl+1,:).*epss',wl); % [1] Absorbed diffuse downward flux by the soil (W m-2) + +% net (n) radiation R and net PAR P per component: sunlit (u), shaded (h) soil(s) and canopy (c), +% [W m-2 leaf or soil surface um-1] +Rnhc = Rndif; % [nl] shaded leaves or needles +Pnhc = Pndif; % [nl] shaded leaves or needles +Pnhc_Cab = Pndif_Cab; % [nl] shaded leaves or needles +Rnhc_PAR = Rndif_PAR; % [nl] shaded leaves or needles + +for j = 1:nl + Puc(:,:,j) = Pdir + Pdif(j); % [13,36,nl] Total fluxes on sunlit leaves or needles + Rnuc(:,:,j) = Rndir + Rndif(j); % [13,36,nl] Total fluxes on sunlit leaves or needles + Pnuc(:,:,j) = Pndir + Pndif(j); % [13,36,nl] Total fluxes on sunlit leaves or needles + Pnuc_Cab(:,:,j) = Pndir_Cab + Pndif_Cab(j);% [13,36,nl] Total fluxes on sunlit leaves or needles + Rnuc_PAR(:,:,j) = Rndir_PAR + Rndif_PAR(j);% [13,36,nl] Total fluxes on sunlit leaves or needles +end +Rnhs = Rndifsoil; % [1] shaded soil +Rnus = Rndifsoil + Rndirsoil; % [1] sunlit soil + +%% +if options.calc_vert_profiles + [Pnu1d ] = equations.meanleaf(canopy,Pnuc, 'angles'); % [nli,nlo,nl] mean net radiation sunlit leaves + [Pnu1d_Cab ] = equations.meanleaf(canopy,Pnuc_Cab, 'angles'); % [nli,nlo,nl] mean net radiation sunlit leaves + + profiles.Pn1d = ((1-Ps(1:nl)).*Pnhc + Ps(1:nl).*(Pnu1d)); %[nl] mean photos leaves, per layer + profiles.Pn1d_Cab = ((1-Ps(1:nl)).*Pnhc_Cab + Ps(1:nl).*(Pnu1d_Cab)); %[nl] mean photos leaves, per layer +else + profiles = struct; +end + +%% place output in structure rad +gap.k = k; +gap.K = K; +gap.Ps = Ps; +gap.Po = Po; + +rad.rsd = rsd; +rad.rdd = rdd; +rad.rdo = rdo; +rad.rso = rso; + +rad.vb = vb; +rad.vf = vf; + +rad.Esun_ = Esun_; % [2162x1 double] incident solar spectrum (mW m-2 um-1) +rad.Esky_ = Esky_; % [2162x1 double] incident sky spectrum (mW m-2 um-1) +rad.PAR = P; % [1 double] incident spectrally integrated PAR (moles m-2 s-1) + +rad.fEsuno = fEsuno; % [2162x1 double] normalized spectrum of direct light (optical) +rad.fEskyo = fEskyo; % [2162x1 double] normalized spectrum of diffuse light (optical) +rad.fEsunt = fEsunt; % [2162x1 double] normalized spectrum of direct light (thermal) +rad.fEskyt = fEskyt; % [2162x1 double] normalized spectrum of diffuse light (thermal) + +rad.Eplu_ = Eplu_; % [61x2162 double] upward diffuse radiation in the canopy (mW m-2 um-1) +rad.Emin_ = Emin_; % [61x2162 double] downward diffuse radiation in the canopy (mW m-2 um-1) + +rad.Lo_ = Lo_; % [2162x1 double] TOC radiance in observation direction (mW m-2 um-1 sr-1) +rad.Eout_ = Eout_; % [2162x1 double] TOC upward radiation (mW m-2 um-1) +rad.Eouto = Eouto; % [1 double] TOC spectrally integrated upward optical ratiation (W m-2) +rad.Eoutt = Eoutt; % [1 double] TOC spectrally integrated upward thermal ratiation (W m-2) + +rad.Rnhs = Rnhs; % [1 double] net radiation (W m-2) of shaded soil +rad.Rnus = Rnus; % [1 double] net radiation (W m-2) of sunlit soil +rad.Rnhc = Rnhc; % [60x1 double] net radiation (W m-2) of shaded leaves +rad.Rnuc = Rnuc; % [13x36x60 double] net radiation (W m-2) of sunlit leaves +rad.Pnh = Pnhc; % [60x1 double] net PAR (moles m-2 s-1) of shaded leaves +rad.Pnu = Pnuc; % [13x36x60 double] net PAR (moles m-2 s-1) of sunlit leaves +rad.Pnh_Cab = Pnhc_Cab; % [60x1 double] net PAR absorbed by Cab (moles m-2 s-1) of shaded leaves +rad.Pnu_Cab = Pnuc_Cab; % [13x36x60 double] net PAR absorbed by Cab (moles m-2 s-1) of sunlit leaves +rad.Rnh_PAR = Rnhc_PAR; % [60x1 double] net PAR absorbed by Cab (moles m-2 s-1) of shaded leaves +rad.Rnu_PAR = Rnuc_PAR; % [13x36x60 double] net PAR absorbed (W m-2) of sunlit +rad.Etoto = Etoto; + +%% APPENDIX I functions J1 and J2 (introduced for numerically stable solutions) + +function J1 = calcJ1(x,m,k,LAI) +if abs(m-k)>1E-3; + J1 = (exp(m*LAI*x)-exp(k*LAI*x))./(k-m); +else + J1 = -.5*(exp(m*LAI*x)+exp(k*LAI*x))*LAI.*x.*(1-1/12*(k-m).^2*LAI^2.*x.^2); +end +return + +function J2 = calcJ2(x,m,k,LAI) +J2 = (exp(k*LAI*x)-exp(-k*LAI)*exp(-m*LAI*(1+x)))./(k+m); +return; + +%% APPENDIX II function volscat + +function [chi_s,chi_o,frho,ftau] = volscat(tts,tto,psi,ttli) + +%Volscatt version 2. +%created by W. Verhoef +%edited by Joris Timmermans to matlab nomenclature. +% date: 11 February 2008 +%tts [1] Sun zenith angle in degrees +%tto [1] Observation zenith angle in degrees +%psi [1] Difference of azimuth angle between solar and viewing position +%ttli [ttli] leaf inclination array + +deg2rad = pi/180; +nli = length(ttli); + +psi_rad = psi*deg2rad*ones(nli,1); + +cos_psi = cos(psi*deg2rad); % cosine of relative azimuth angle + +cos_ttli = cos(ttli*deg2rad); % cosine of normal of upperside of leaf +sin_ttli = sin(ttli*deg2rad); % sine of normal of upperside of leaf + +cos_tts = cos(tts*deg2rad); % cosine of sun zenith angle +sin_tts = sin(tts*deg2rad); % sine of sun zenith angle + +cos_tto = cos(tto*deg2rad); % cosine of observer zenith angle +sin_tto = sin(tto*deg2rad); % sine of observer zenith angle + +Cs = cos_ttli*cos_tts; % p305{1} +Ss = sin_ttli*sin_tts; % p305{1} + +Co = cos_ttli*cos_tto; % p305{1} +So = sin_ttli*sin_tto; % p305{1} + +As = max([Ss,Cs],[],2); +Ao = max([So,Co],[],2); + +bts = acos(-Cs./As); % p305{1} +bto = acos(-Co./Ao); % p305{2} + +chi_o = 2/pi*((bto-pi/2).*Co + sin(bto).*So); +chi_s = 2/pi*((bts-pi/2).*Cs + sin(bts).*Ss); + +delta1 = abs(bts-bto); % p308{1} +delta2 = pi-abs(bts + bto - pi); % p308{1} + +Tot = psi_rad + delta1 + delta2; % pag 130{1} + +bt1 = min([psi_rad,delta1],[],2); +bt3 = max([psi_rad,delta2],[],2); +bt2 = Tot - bt1 - bt3; + +T1 = 2.*Cs.*Co + Ss.*So.*cos_psi; +T2 = sin(bt2).*(2*As.*Ao + Ss.*So.*cos(bt1).*cos(bt3)); + +Jmin = ( bt2).*T1 - T2; +Jplus = (pi-bt2).*T1 + T2; + +frho = Jplus/(2*pi^2); +ftau = -Jmin /(2*pi^2); + +% pag.309 wl-> pag 135{1} +frho = max([zeros(nli,1),frho],[],2); +ftau = max([zeros(nli,1),ftau],[],2); +return + +%% APPENDIX III function e2phot + +function molphotons = e2phot(lambda,E) +%molphotons = e2phot(lambda,E) calculates the number of moles of photons +%corresponding to E Joules of energy of wavelength lambda (m) + +global constants; +A = constants.A; + +e = ephoton(lambda); +photons = E./e; +molphotons = photons./A; +return; + +function E = ephoton(lambda) +%E = phot2e(lambda) calculates the energy content (J) of 1 photon of +%wavelength lambda (m) + +global constants; +h = constants.h; % [J s] Planck's constant +c = constants.c; % [m s-1] speed of light +E = h*c./lambda; % [J] energy of 1 photon +return; + +%% APPENDIX IV function Pso + +function pso = Psofunction(K,k,LAI,q,dso,xl) +if dso~=0 + alf = (dso/q) *2/(k+K); + pso = exp((K+k)*LAI*xl + sqrt(K*k)*LAI/(alf )*(1-exp(xl*(alf ))));% [nl+1] factor for correlation of Ps and Po +else + pso = exp((K+k)*LAI*xl - sqrt(K*k)*LAI*xl);% [nl+1] factor for correlation of Ps and Po +end \ No newline at end of file diff --git a/src/RTMt_planck.m b/src/RTMt_planck.m new file mode 100644 index 00000000..f78b2eb5 --- /dev/null +++ b/src/RTMt_planck.m @@ -0,0 +1,211 @@ +function rad = RTMt_planck(spectral,rad,soil,leafopt,canopy,gap,angles,Tcu,Tch,Tsu,Tsh,obsdir) +% function 'RTMt_planck' calculates the spectrum of outgoing thermal +% radiation in hemispherical and viewing direction +% +% Authors: Wout Verhoef and Christiaan van der Tol (tol@itc.nl) +% Date: 5 November 2007 +% Update: 14 Nov 2007 +% 16 Nov 2007 CvdT improved calculation of net radiation +% 17 Dec 2007 JT simplified, removed net radiation +% 07 Nov 2008 CvdT changed layout +% 16 Mar 2009 CvdT removed calculation of Tbright +% 12 Apr 2013 CvdT introduced structures +% +% Table of contents of the function: +% 0. preparations +% 0.0 globals +% 0.1 initialisations +% 0.2 parameters +% 0.3 geometric factors of Observer +% 0.4 geometric factors associated with extinction and scattering +% 0.5 geometric factors to be used later with rho and tau +% 0.6 fo for all leaf angle/azumith classes +% 1 calculation of upward and downward fluxes +% 2 outgoing fluxes, hemispherical and in viewing direction +% A1 function planck (external function is now used) +% +% Usage: +% function rad = RTMt_planck(spectral,rad,soil,leafopt,canopy,gap,angles,Tcu,Tch,Tsu,Tsh,obsdir) +% +% Input: +% Symbol Description Unit Dimension +% ------ ----------- ---- --------- +% Tcu temperature sunlit leaves C [13,36,nl] +% Tch temperature shaded leaves C [nl] +% Tsu temperature sunlit soil C [1] +% Tsu temperature shaded soil C [1] +% rad a structure containing +% soil a structure containing soil reflectance +% canopy a structure containing LAI and leaf inclination + +% Ps probability of sunlit leaves [nl+1] +% Po probability of viewing a leaf or soil [nl+1] +% Pso probability of viewing a sunlit leaf/soil [nl+1] +% K extinction coefficient in viewing dir [1] +% tto viewing angle (degrees) [1] +% psi azimuth angle difference between solar and viewing position +% +% Output +% Symbol Description Unit Dimension +% ------ ----------- ---- --------- +% Loutt_ Spectrum of outgoing hemispherical rad (W m-2 um-1)[nwl] +% Lot_ Spectrum of outgoing rad in viewing dir (W m-2 um-1)[nwl] +% Eplu Total downward diffuse radiation (W m-2) [nl+1] +% Emin Total downward diffuse radiation (W m-2) [nl+1] +% +% Notes: +% nl number of layers +% nwl number of wavelengths of input (net PAR) +% '_'means: a flux at different wavelengths (a vertically oriented vector) + +%% 0.0 globals +global constants + +%% 0.1 parameters + +%for speed-up the calculation only uses thermal part of the spectrum +IT = spectral.IwlT; % +wlt = spectral.wlT; + +deg2rad = constants.deg2rad; +nl = canopy.nlayers; +lidf = canopy.lidf; +litab = canopy.litab; +lazitab = canopy.lazitab; +nlazi = length(lazitab); +tto = angles.tto; +psi = angles.psi; +Ps = gap.Ps; +Po = gap.Po; +Pso = gap.Pso; +K = gap.K; + +rho = leafopt.refl(IT); % [nwl] Leaf/needle reflection +tau = leafopt.tran(IT); % [nwl] Leaf/needle transmission +rs = soil.refl(IT); % [nwl] Soil reflectance +epsc = 1-rho-tau; % [nwl] Emissivity vegetation +epss = 1-rs; % [nwl] Emissivity soil +crit = max(1E-2); % [1] Desired minimum accuracy +LAI = canopy.LAI; +dx = 1/nl; +iLAI = LAI*dx; + +%% 0.2 initialization of output variables +Hcsui = zeros(nl,1); % [nl] +piLot_ = zeros(1,length(IT)); % [1,nwlt] +[Emin_,Eplu_] = deal(zeros(nl+1,length(IT))); % [nl+1,nwlt] + +%% 0.3 geometric factors of Observer +if obsdir + cos_tto = cos(tto*deg2rad);% [1] cos observation angle + sin_tto = sin(tto*deg2rad);% [1] sin observation angle +end + +%% 0.4 geometric factors associated with extinction and scattering +cos_ttl = cos(litab*deg2rad); % [nli] cos leaf inclination angles +if obsdir + sin_ttl = sin(litab*deg2rad); % [nli] sin leaf inclination angles + cos_ttlo = cos((lazitab-psi)*deg2rad); % [nlazi] sin leaf orientation angles +end +bfli = cos_ttl.^2; % [nli] +bf = bfli'*lidf; % [1] + +%% 0.5 geometric factors to be used later with rho and tau, f1 f2 of pag 304: +ddb = 0.5*(1+bf); % [1] W of dif2dif back (f1^2 + f2^2) +ddf = 0.5*(1-bf); % [1] W of dif2dif forward (2*f1*f2 ) +if obsdir + dob = 0.5*(K+bf); % [1] W of dif2dir back (fo*f1 ) + dof = 0.5*(K-bf); % [1] W of dif2dir back (fo*f1 ) +end + +%% 0.6 fo for all leaf angle/azumith classes +if obsdir + Co = cos_ttl*cos_tto; % [nli] pag 305 modified by Joris + So = sin_ttl*sin_tto; % [nli] pag 305 modified by Joris + + cos_deltao = Co*ones(1,nlazi) + So*cos_ttlo; % [nli,nlazi] projection of leaves in in direction of sun %(pag 125/126) + fo = cos_deltao/abs(cos_tto); % [nli,nlazi] +end + +%% 1. calculation of upward and downward fluxes +sigb = ddb*rho + ddf*tau; % [nwlt] diffuse backscatter scattering coefficient for diffuse incidence pag 305 +sigf = ddf*rho + ddb*tau; % [nwlt] diffuse forward scattering coefficient for forward incidence +if obsdir + vb = dob*rho + dof*tau; % [nwlt] directional backscatter scattering coefficient for diffuse incidence + vf = dof*rho + dob*tau; % [nwlt] directional forward scattering coefficient for diffuse incidence +end +a = 1-sigf; % [nwlt] attenuation +m = sqrt(a.^2-sigb.^2); % [nwlt] +rinf = (a-m)./sigb; % [nwlt] reflection coefficient for infinite thick canopy +rinf2 = rinf.*rinf; % [nwlt] + +fHs = (1-rinf2).*(1-rs)./(1-rinf.*rs); +fHc = iLAI*m.*(1-rinf); +fbottom = (rs-rinf)./(1-rinf.*rs); + +for i = 1:length(IT) + % 1.1 radiance by components + Hcsui3 = pi*equations.Planck(wlt(i),Tcu+273.15,epsc(i)); + Hcshi = pi*equations.Planck(wlt(i),Tch+273.15,epsc(i)); + Hssui = pi*equations.Planck(wlt(i),Tsu+273.15,epss(i)); + Hsshi = pi*equations.Planck(wlt(i),Tsh+273.15,epss(i)); + % 1.2 radiance by leaf layers Hc and by soil Hs + for j = 1:nl + Hcsui2 = Hcsui3(:,:,j); % [nli,nlazi] sunlit leaves + Hcsui(j) = mean(Hcsui2'*lidf); % [nl] sunlit vegetation radiance per layer + end + Hci = Hcsui.*Ps(1:nl) + Hcshi.*(1-Ps(1:nl)); %[nl] emitted vegetation radiance per layer + Hsi = Hssui.*Ps(nl+1) + Hsshi.*(1-Ps(nl+1)); %[1] emitted soil radiance per layer + + % 1.3 Diffuse radiation + cont = 1; % [1] continue iteration (1:yes, 0:no) + counter = 0; % [1] iteration counter + F1 = zeros(nl+1,1); % [nl+1] + F2 = zeros(nl+1,1); % [nl+1] + F1top = 0; % [1] + while cont + F1topn = -rinf(i)*F2(1); + F1(1) = F1topn; + for j = 1:nl + F1(j+1) = F1(j)*(1-m(i)*iLAI)+ fHc(i)*Hci(j); + end + F2(nl+1) = fbottom(i)*F1(nl+1) + fHs(i)*Hsi; + for j = nl:-1:1 + F2(j) = F2(j+1)*(1-m(i)*iLAI) + fHc(i)*Hci(j); + end + cont = abs(F1topn-F1top)>crit; % [1] check to continue + F1top = F1topn; % [1] Reset F1topn + counter = counter + 1; % [1] + end + Emini = (F1+rinf(i)*F2)/(1-rinf2(i)); % [nl+1] + Eplui = (F2+rinf(i)*F1)/(1-rinf2(i)); % [nl+1] + + Emin_(:,i) = Emini; % downwelling diffuse radiance per layer + Eplu_(:,i) = Eplui; % upwelling diffuse radiance + + % 1.4 Directional radiation + if obsdir + for j = 1:nl + Hcsui2 = Hcsui3(:,:,j).*abs(fo); + Hcsui(j) = mean(Hcsui2'*lidf); + end + + piLo1 = iLAI*K*sum(Hcshi.*(Po(1:nl)-Pso(1:nl))); % directional emitted radiation by shaded leaves + piLo2 = iLAI*sum(Hcsui.*(Pso(1:nl ))); % directional emitted radiation by sunlit leaves + piLo3 = iLAI*((vb(i)*Emini(1:nl) + vf(i)*Eplui(1:nl))'*Po(1:nl));% directional scattered radiation by vegetation for diffuse incidence + piLo4 = Hsshi*(Po(nl+1)-Pso(nl+1)); + piLo5 = Hssui* Pso(nl+1); % directional emitted radiation by sunlit/shaded Soil + piLo6 = rs(i)*Emini(nl+1)*Po(nl+1); % directional scattered radiation by soil for diffuse incidence + + piLot_(i) = piLo1 + sum(piLo2) + piLo3 + piLo4 + piLo5 + piLo6; % directional total radiation + Lot_ = piLot_/pi; + end +end + +%% 2. Write the output to structure rad +[rad.Lot_,rad.Eoutte_] = deal(zeros(length(spectral.wlS),1)); +rad.Lot_(IT) = Lot_; +rad.Eoutte_(IT) = Eplu_(1,:); % emitted diffuse radiance at top +rad.Eplut_ = Eplu_; +rad.Emint_ = Emin_; +return diff --git a/src/RTMt_sb.m b/src/RTMt_sb.m new file mode 100644 index 00000000..a8f325d3 --- /dev/null +++ b/src/RTMt_sb.m @@ -0,0 +1,229 @@ +function [rad] = RTMt_sb(spectral,rad,soil,leafopt,canopy,gap,angles,Tcu,Tch,Tsu,Tsh,obsdir) + +% function 'RTMt_sb' calculates total outgoing radiation in hemispherical +% direction and total absorbed radiation per leaf and soil component. +% Radiation is integrated over the whole thermal spectrum with +% Stefan-Boltzman's equation. This function is a simplified version of +% 'RTMt_planck', and is less time consuming since it does not do the +% calculation for each wavelength separately. +% +% Authors: Wout Verhoef and Christiaan van der Tol (tol@itc.nl) +% date: 5 Nov 2007 +% update: 13 Nov 2007 +% 16 Nov 2007 CvdT improved calculation of net radiation +% 27 Mar 2008 JT added directional calculation of radiation +% 24 Apr 2008 JT Introduced dx as thickness of layer (see parameters) +% 31 Oct 2008 JT introduced optional directional calculation +% 31 Oct 2008 JT changed initialisation of F1 and F2 -> zeros +% 07 Nov 2008 CvdT changed layout +% 16 Mar 2009 CvdT removed Tbright calculation +% Feb 2013 WV introduces structures for version 1.40 +% +% Table of contents of the function +% 0 preparations +% 0.0 globals +% 0.1 initialisations +% 0.2 parameters +% 0.3 geometric factors of Observer +% 0.4 geometric factors associated with extinction and scattering +% 0.5 geometric factors to be used later with rho and tau +% 0.6 fo for all leaf angle/azumith classes +% 1 calculation of upward and downward fluxes +% 2 total net fluxes +% Appendix A. Stefan-Boltzmann +% +% usage: +% [rad] = RTMt_sb(options,spectral,rad,soil,leafopt,canopy,gap,angles,Tcu,Tch,Tsu,Tsh) +% +% Most input and output are structures. These structures are further +% specified in a readme file. The temperatures Tcu, Tch, Tsu and Tsh are +% variables. +% +% Input: +% options calculation options +% spectral information about wavelengths and resolutions +% rad a large number of radiative fluxes: spectrally distributed +% and integrated, and canopy radiative transfer coefficients +% soil soil properties +% leafopt leaf optical properties +% canopy canopy properties (such as LAI and height) +% gap probabilities of direct light penetration and viewing +% angles viewing and observation angles +% Tcu Temperature of sunlit leaves (oC), [13x36x60] +% Tch Temperature of shaded leaves (oC), [13x36x60] +% Tsu Temperature of sunlit soil (oC), [1] +% Tsh Temperature of shaded soil (oC), [1] +% +% Output: +% rad a large number of radiative fluxes: spectrally distributed +% and integrated, and canopy radiative transfer coefficients. +% Here, thermal fluxes are added +%% 0.0 globals +global constants + +%% 0.1 parameters + +IT = find(spectral.wlS == 10000); % Take 10 microns as representative wavelength for the thermal + +deg2rad = constants.deg2rad; +nl = canopy.nlayers; +lidf = canopy.lidf; +litab = canopy.litab; +lazitab = canopy.lazitab; +nlazi = length(lazitab); +tto = angles.tto; +psi = angles.psi; +Ps = gap.Ps; +K = gap.K; + +rho = leafopt.refl(IT); % [nwl] Leaf/needle reflection +tau = leafopt.tran(IT); % [nwl] Leaf/needle transmission +rs = soil.refl(IT); % [nwl] Soil reflectance +epsc = 1-rho-tau; % [nwl] Emissivity vegetation +epss = 1-rs; % [nwl] Emissivity soil +crit = max(1E-2); % [1] Desired minimum accuracy +LAI = canopy.LAI; +dx = 1/nl; +iLAI = LAI*dx; + +%% 0.2 initialiations +Rnhc = zeros(nl,1); % [nl] +Rnuc = zeros(size(Tcu)); % [13,36,nl] + +%% 0.3 geometric factors of observer +if obsdir + cos_tto = cos(tto*deg2rad); % [1] cos observation angle + sin_tto = sin(tto*deg2rad); % [1] sin observation angle +end + +%% 0.4 geometric factors associated with extinction and scattering +cos_ttl = cos(litab*deg2rad); +if obsdir + sin_ttl = sin(litab*deg2rad); + cos_ttlo= cos((lazitab-psi)*deg2rad); +end +bfli = cos_ttl.^2; +bf = bfli'*lidf; + +%% 0.5 geometric factors to be used later with rho and tau, f1 f2 of pag 304: +ddb = 0.5*(1+bf); % f1^2 + f2^2 +ddf = 0.5*(1-bf); % 2*f1*f2 +if obsdir + dob = 0.5*(K+bf); % fo*f1 + dof = 0.5*(K-bf); % fo*f1 +end + +%% 0.6 fo for all leaf angle/azumith classes +if obsdir + Co = cos_ttl*cos_tto; % [nli] pag 305 + So = sin_ttl*sin_tto; % [nli] pag 305 + cos_deltao = Co*ones(1,nlazi) + So*cos_ttlo;% [nli, nlazi] projection of leaves in in direction of sun (pag 125-126) + fo = cos_deltao/abs(cos_tto);% [nli, nlazi] leaf area projection factors in direction of observation +end + +%% 1. calculation of upward and downward fluxes pag 305 +sigb = ddb*rho + ddf*tau; % [nwlt] Diffuse backscatter scattering coefficient +sigf = ddf*rho + ddb*tau; % [nwlt] Diffuse forward scattering coefficient +if obsdir + vb = dob*rho + dof*tau; % [nwlt] Directional backscatter scattering coefficient for diffuse incidence + vf = dof*rho + dob*tau; % [nwlt] Directional forward scattering coefficient for diffuse incidence +end +a = 1-sigf; % [nwlt] Attenuation +m = sqrt(a*a-sigb*sigb);% [nwlt] +rinf = (a-m)/sigb; % [nwlt] Reflection coefficient for infinite thick canopy +rinf2 = rinf*rinf; % [nwlt] + +fHs = (1-rinf2)*(1-rs)/(1-rinf*rs); +fHc = iLAI*m*(1-rinf); +fbottom = (rs-rinf)/(1-rs*rinf); + +%1.1 radiance by components +Hcsu3 = Stefan_Boltzmann(Tcu);% Radiance by sunlit leaves +Hcsh = Stefan_Boltzmann(Tch);% Radiance by shaded leaves +Hssu = Stefan_Boltzmann(Tsu);% Radiance by sunlit soil +Hssh = Stefan_Boltzmann(Tsh);% Radiance by shaded soil + +% 1.2 radiance by leaf layers Hv and by soil Hs (modified by JAK 2015-01) +v1 = repmat( 1/size(Hcsu3, 2), 1, size(Hcsu3, 2)); % vector for computing the mean +Hcsu2 = reshape(Hcsu3, size(Hcsu3, 1), []); % create a block matrix from the 3D array +Hcsu = (v1 * reshape(Hcsu2'*lidf, size(Hcsu3, 2), []))'; % compute column means for each level + +Hc = Hcsu.*Ps(1:nl) + Hcsh.*(1-Ps(1:nl)); % hemispherical emittance by leaf layers +Hs = Hssu.*Ps(nl+1) + Hssh.*(1-Ps(nl+1)); % hemispherical emittance by soil surface + +% 1.3 Diffuse radiation +cont = 1; % continue iteration (1:yes, 0:no) +counter = 0; % number of iterations +F1 = zeros(nl+1,1); +F2 = zeros(nl+1,1); +F1top = 0; +while cont + F1topn = -rinf*F2(1); + F1(1) = F1topn; + for j = 1:nl + F1(j+1) = F1(j)*(1-m*iLAI)+ fHc*Hc(j); + end + F2(nl+1) = fbottom*F1(nl+1) + fHs*Hs; + for j = nl:-1:1 + F2(j) = F2(j+1)*(1-m*iLAI) + fHc*Hc(j); + end + cont = abs(F1topn-F1top)>crit; + F1top = F1topn; + counter = counter + 1; +end + +Emin = (F1+rinf*F2)/(1-rinf2); +Eplu = (F2+rinf*F1)/(1-rinf2); + +% 1.4 Directional radiation +if obsdir + piLo1 = iLAI*epsc*K*Hcsh'*(gap.Po(1:nl)-gap.Pso(1:nl)); % directional emitted radation by shaded leaves + % JAK 2015-01: replaced earlier loop by this: all-at-once with more efficient mean + absfo_rep = repmat(abs(fo), 1, nl); + piLo2 = iLAI*epsc*(v1 * reshape( (Hcsu2.*absfo_rep)'*lidf, size(Hcsu3, 2), []))'.*gap.Pso(1:nl); % compute column means for each level + + piLo3 = iLAI*((vb*Emin(1:nl) + vf*Eplu(1:nl))'*gap.Po(1:nl)); % directional scattered radiation by vegetation for diffuse incidence + piLo4 = epss*Hssh*(gap.Po(nl+1)-gap.Pso(nl+1)); % directional emitted radiation by shaded soil + piLo5 = epss*Hssu*gap.Pso(nl+1); % directional emitted radiation by sunlit soil + piLo6 = rs*Emin(nl+1)*gap.Po(nl+1); % directional scattered radiation by soil for diffuse incidence [1] + + piLot = piLo1 + sum(piLo2) + piLo3 + piLo4 + piLo5 + piLo6; +else + piLot = NaN; +end +Lot = piLot/pi; + +%% 2. total net fluxes +% net radiation per component, in W m-2 (leaf or soil surface) +for j = 1:nl + Rnuc(:,:,j) = (Emin(j) + Eplu(j+1) - 2*Hcsu3(:,:,j))*epsc; % sunlit leaf + Rnhc(j) = (Emin(j) + Eplu(j+1) - 2*Hcsh(j))*epsc; % shaded leaf +end +Rnus = (Emin(nl+1) - Hssu)*epss; % sunlit soil +Rnhs = (Emin(nl+1) - Hssh)*epss; % shaded soil + +%% 3. Write the output to the rad structure + +rad.Emint = Emin; +rad.Eplut = Eplu; +rad.Eoutte = Eplu(1)-Emin(1); % 1) +rad.Lot = Lot; +rad.Rnuct = Rnuc; +rad.Rnhct = Rnhc; +rad.Rnust = Rnus; +rad.Rnhst = Rnhs; +return + +% 1) CvdT, 11 December 2015. +% We subtract Emin(1), because ALL incident (thermal) radiation from Modtran +% has been taken care of in RTMo. Not ideal but otherwise radiation budget will not close! + +%% Appendix A. Stefan-Boltzmann +function H = Stefan_Boltzmann(T_C) + +global constants; +C2K = constants.C2K; +sigmaSB = constants.sigmaSB; + +H = sigmaSB*(T_C + C2K).^4; +return \ No newline at end of file diff --git a/src/RTMz.m b/src/RTMz.m new file mode 100644 index 00000000..16664505 --- /dev/null +++ b/src/RTMz.m @@ -0,0 +1,231 @@ +function [rad,profiles] = RTMz(spectral,rad,soil,leafopt,canopy,gap,angles,profiles) + +% function 'RTMz' calculates the small modification of TOC outgoing +% radiance due to the conversion of Violaxanthin into Zeaxanthin in leaves +% +% Author: Christiaan van der Tol (c.vandertol@utwente.nl) +% Date: 08 Dec 2016 +% +% The inputs and outputs are structures. These structures are further +% specified in a readme file. +% +% Input: +% spectral information about wavelengths and resolutions +% rad a large number of radiative fluxes: spectrally distributed +% and integrated, and canopy radiative transfer coefficients. +% soil soil properties +% leafopt leaf optical properties +% canopy canopy properties (such as LAI and height) +% gap probabilities of direct light penetration and viewing +% angles viewing and observation angles +% profiles vertical profiles of fluxes +% +% Output: +% rad a large number of radiative fluxes: spectrally distributed +% and integrated, and canopy radiative transfer coefficients. +% Here, fluorescence fluxes are added +%% 0.0 globals +global constants + +%% initialisations +wlS = spectral.wlS'; % SCOPE wavelengths, make column vectors +wlZ = spectral.wlZ'; % Excitation wavelengths +[dummy,iwlfi] = intersect(wlS,wlZ); %#ok +nf = length(iwlfi); +nl = canopy.nlayers; +LAI = canopy.LAI; +litab = canopy.litab; +lazitab = canopy.lazitab; +lidf = canopy.lidf; +nlinc = length(litab); +nlazi = length(lazitab); +nlori = nlinc * nlazi; % total number of leaf orientations +layers = 1:nl; + +RZ = leafopt.reflZ(iwlfi)-leafopt.refl(iwlfi); +TZ = leafopt.tranZ(iwlfi)-leafopt.tran(iwlfi); + +vb = rad.vb(iwlfi); % added for rescattering of SIF fluxes +vf = rad.vf(iwlfi); + +Ps = gap.Ps; % [nl+1] +Po = gap.Po; +Pso = gap.Pso; + +Qso = (Pso(layers) + Pso(layers+1))/2; +Qs = (Ps(layers) + Ps(layers+1))/2; +Qo = (Po(layers) + Po(layers+1))/2; +Qsho = Qo - Qso; + +etah = zeros(nl,1); +etau = zeros(nl,nlori); % modified dimensions to facilitate vectorization + +LoZ_ = zeros(nf,1); +Zhem_ = zeros(nf,1); + +% for speed-up the calculation only uses wavelength i and wavelength o part of the spectrum + +Esunf_ = rad.Esun_(iwlfi); +Eminf_ = rad.Emin_(:,iwlfi)'; % transpose into [nf,nl+1] matrix +Epluf_ = rad.Eplu_(:,iwlfi)'; +iLAI = LAI/nl; % LAI of a layer + +%% optical quantities + +rho = leafopt.refl(iwlfi); % [nf] leaf/needle reflectance +tau = leafopt.tran(iwlfi); % [nf] leaf/needle transmittance +rs = soil.refl(iwlfi); % [nf] soil reflectance + +% geometric factors + +deg2rad = constants.deg2rad; +tto = angles.tto; +tts = angles.tts; +psi = angles.psi; + +cos_tto = cos(tto*deg2rad); % cos observation zenith angle +sin_tto = sin(tto*deg2rad); % sin observation zenith angle + +cos_tts = cos(tts*deg2rad); % cos solar angle +sin_tts = sin(tts*deg2rad); % sin solar angle + +cos_ttli = cos(litab*deg2rad); % cos leaf inclinaation angles +sin_ttli = sin(litab*deg2rad); % sin leaf inclinaation angles +cos_phils = cos(lazitab*deg2rad); % cos leaf azimuth angles rel. to sun azi +cos_philo = cos((lazitab-psi)*deg2rad); % cos leaf azimuth angles rel. to viewing azi + +%% geometric factors for all leaf angle/azumith classes +cds = cos_ttli*cos_tts*ones(1,nlazi) + sin_ttli*sin_tts*cos_phils; % [nlinc,nlazi] +cdo = cos_ttli*cos_tto*ones(1,nlazi) + sin_ttli*sin_tto*cos_philo; % [nlinc,nlazi] +fs = cds/cos_tts; % [nlinc,nlazi] +absfs = abs(fs); % [nlinc,nlazi] +fo = cdo/cos_tto; % [nlinc,nlazi] +absfo = abs(fo); % [nlinc,nlazi] +fsfo = fs.*fo; % [nlinc,nlazi] +absfsfo = abs(fsfo); % [nlinc,nlazi] +foctl = fo.*(cos_ttli*ones(1,nlazi)); % [nlinc,nlazi] +fsctl = fs.*(cos_ttli*ones(1,nlazi)); % [nlinc,nlazi] +ctl2 = cos_ttli.^2*ones(1,nlazi); % [nlinc,nlazi] + +%% calculation of le in observation direction + +% Cx as a function of Kn + +etahi = Kn2Cx(profiles.Knh); +etaur = permute(Kn2Cx(profiles.Knu),[3 1 2]); % make dimensions [nl,nlinc,nlazi] +etaui = reshape(etaur,nl,nlori); % expand orientations in a vector >> [nl,nlori] + +[Fmin_,Fplu_] = deal(zeros(nf,nl+1)); +etah(:) = etahi(:); etau(:) = etaui(:); + +MpluEmin = (RZ*ones(1,nl+1)) .* Eminf_; % [nf,nl+1] = (nf,ne) * (ne,nl+1) +MpluEplu = (RZ*ones(1,nl+1)) .* Epluf_; +MminEmin = (TZ*ones(1,nl+1)) .* Eminf_; +MminEplu = (TZ*ones(1,nl+1)) .* Epluf_; + +MpluEsun = RZ .* Esunf_; % +MminEsun = TZ .* Esunf_; + +xdd2 = mean(ctl2' * lidf); % lidf-weighted cosine squared of leaf inclination +mn_etau = mean(reshape(etau,nl,nlinc,nlazi),3) * lidf; % lidf-weighted mean of etau per layer [nl] + +% we calculate the spectrum for all individual leaves, sunlit and +% shaded + +[Fmin,Fplu] = deal(zeros(nf,nl+1)); +[G1,G2] = deal(zeros(nl+1,1)); +[Mplu_i,Mmin_i] = deal(zeros(nl,1)); + +for i = 1 : nf + + Qso_wfEs = Qso * reshape(absfsfo * MpluEsun(i) + fsfo * MminEsun(i),1,nlori); % [1,nlori] + Qs_sfEs = Qs *reshape(absfs * MpluEsun(i) - fsctl * MminEsun(i),1,nlori); + Qs_sbEs = Qs * reshape(absfs * MpluEsun(i) + fsctl * MminEsun(i),1,nlori); + + Mplu_i(layers) = MpluEmin(i,layers) + MpluEplu(i,layers+1); % [1,nl] + Mmin_i(layers) = MminEmin(i,layers) - MminEplu(i,layers+1); + + sigfEmini_sigbEplui = Mplu_i - xdd2 * Mmin_i; % [nl] + sigbEmini_sigfEplui = Mplu_i + xdd2 * Mmin_i; + + Qso_Mplu = Qso .* Mplu_i; % [nl] + Qso_Mmin = Qso .* Mmin_i; + Qsho_Mplu = Qsho .* Mplu_i; + Qsho_Mmin = Qsho .* Mmin_i; + + Qso_vEd = Qso_Mplu * reshape(absfo,1,nlori) + Qso_Mmin * reshape(foctl,1,nlori); + Qsh_vEd = Qsho_Mplu * reshape(absfo,1,nlori) + Qsho_Mmin * reshape(foctl,1,nlori); + + % Directly observed radiation contributions from sunlit and + % shaded leaves + + piLs = mean(reshape(etau .*(Qso_wfEs + Qso_vEd),nl,nlinc,nlazi),3) * lidf; + piLd = etah .* (mean(reshape(Qsh_vEd,nl,nlinc,nlazi),3) * lidf); + + piLo1 = iLAI * sum(piLs) ; + piLo2 = iLAI * sum(piLd); + + Qs_Fsmin = mean(reshape(etau .* Qs_sfEs,nl,nlinc,nlazi),3) * lidf ... + + Qs .* mn_etau .* sigfEmini_sigbEplui; + Qs_Fsplu = mean(reshape(etau .* Qs_sbEs,nl,nlinc,nlazi),3) * lidf ... + + Qs .* mn_etau .* sigbEmini_sigfEplui; + + Qd_Fdmin = (1-Qs) .* etah .* sigfEmini_sigbEplui; + Qd_Fdplu = (1-Qs) .* etah .* sigbEmini_sigfEplui; + + Fmin(i,layers+1) = Qs_Fsmin + Qd_Fdmin; + Fplu(i,layers) = Qs_Fsplu + Qd_Fdplu; + + t2 = xdd2 * (rho(i)-tau(i))/2; + att = 1-(rho(i)+tau(i))/2+t2; + sig = (rho(i)+tau(i))/2+t2; + m = sqrt(att^2-sig^2); + rinf = (att - m)/sig; + fac = 1 - m * iLAI; + facs = (rs(i)-rinf)/(1-rs(i)*rinf); + + % Transformed radiance calculated numerically + + G1(1) = 2; Gnew = 0; % (to ensure we will enter the loop the first time) + + dF1 = (Fmin(i,layers+1) + rinf * Fplu(i,layers)) * iLAI; % Thanks to JAK + dF2 = (rinf * Fmin(i,layers+1) + Fplu(i,layers)) * iLAI; % These are the source functions + + while abs(Gnew-G1(1)) > 1e-3 + G1(1) = Gnew; + for j=2:nl+1 + G1(j) = fac * G1(j-1) + dF1(j-1); + end + G2(nl+1) = G1(nl+1) * facs; + for j=nl:-1:1 + G2(j) = fac * G2(j+1) + dF2(j); + end + Gnew = -rinf * G2(1); + end + + % Inverse transformation to get back the hemispherical fluxes + + Fplu_(i,:) = (rinf*G1+G2)/(1-rinf^2); + Fmin_(i,:) = (rinf*G2+G1)/(1-rinf^2); + + Zhem_(i) = Fplu_(i,1); + + % The following contributions are coming from: + + % 3) Rescattered radiation of observed leaves + % 4) radiation reflected by observed soil + + piLo3 = iLAI * ((vb(i)*Fmin_(i,layers) + vf(i)*Fplu_(i,layers+1)) * Qo); + piLo4 = rs(i) * Fmin_(i,nl+1) * Po(nl+1); + + piLtoti = piLo1 + piLo2 + piLo3 + piLo4; + LoZ_(i) = piLtoti/pi; + +end + +rad.Lo_(iwlfi) = rad.Lo_(iwlfi)+LoZ_; +rad.Eout_(iwlfi) = rad.Eout_(iwlfi) + Zhem_; + +function Cx = Kn2Cx(Kn) +Cx = 0.70*Kn; % empirical fit by N Vilfan +return \ No newline at end of file diff --git a/src/Root_Fraction_General.m b/src/Root_Fraction_General.m new file mode 100644 index 00000000..7a10142a --- /dev/null +++ b/src/Root_Fraction_General.m @@ -0,0 +1,190 @@ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% Subfunction Root_Fraction %%%%%%%%%%%%%%%%%%% +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +function[RfH_Zs,RfL_Zs]=Root_Fraction_General(Zs,CASE_ROOT,ZR95_H,ZR50_H,ZR95_L,ZR50_L,ZRmax_H,ZRmax_L) +%%% OUTPUT +%%% ---> Root Distribution ZR_H -ZR_L --- Root Fraction in a given soil layer +%RfH_Zs, [%] Root Fraction for High Vegetation [1...m] +%RfL_Zs [%] Root Fraction for Low Vegetation [1...m] + +%%%% INPUT +%ZR95_H, Root Depth (95 percentile) High Vegetation [mm] +%ZR95_L, Root Depth (95 percentile) Low Vegetation [mm] +%ZR50_H, Root Depth (95 percentile) High Vegetation [mm] +%ZR50_L, Root Depth (95 percentile) Low Vegetation [mm] +%Zs, [mm] Depth Layers [1....m] +%CASE_ROOT [#] Type of desired root profile +%%%%%%%%%%%%%%%%%%%%%% +n=length(Zs)-1; +cc=length(ZR95_H); +RfH_Zs= zeros(cc,n); RfL_Zs= zeros(cc,n); +%%%%%%%%%%%%%%%%%%%%%% +for j=1:cc + if ZR95_H(j) > Zs(n+1) || ZR95_L(j) > Zs(n+1) || ZRmax_H(j) > Zs(n+1) || ZRmax_L(j) > Zs(n+1) + disp('ERROR: LAST LAYER TOO SHALLOW FOR ACCOMODATING ROOTS') + return + end +end +switch CASE_ROOT + case 1 %%%% Exponential Profile + %%%%%%%%%%%%%%%%%%%%%% Arora and Boer 2005 + eta_H=3./ZR95_H; %%[1/mm] Shape of Root Distribution + eta_L=3./ZR95_L; %%[1/mm] + %%%%%%%%%%%%%%%%%%%%% + for j=1:cc + i=1; + if not(ZR95_H(j)==0) + while i <= n + if ZR95_H(j) > Zs(i+1) + RfH_Zs(j,i) = exp(-eta_H(j)*Zs(i)) - exp(-eta_H(j)*Zs(i+1)); + else + RfH_Zs(j,i) = exp(-eta_H(j)*Zs(i)) - exp(-eta_H(j)*ZR95_H(j)); + i=n; + end + i=i+1; + end + end + %%%%%%%%%% + i=1; + if not(ZR95_L(j)==0) + while i <= n + if ZR95_L(j) > Zs(i+1) + RfL_Zs(j,i) = exp(-eta_L(j)*Zs(i)) - exp(-eta_L(j)*Zs(i+1)); + else + RfL_Zs(j,i) = exp(-eta_L(j)*Zs(i)) - exp(-eta_L(j)*ZR95_L(j)); + i=n; + end + i=i+1; + end + end + %%%%%%% Water Content for the Root + Rto1 = 0.9502; + %%%%%%%%% Root Proportion in the Layer + RfH_Zs(j,:)=RfH_Zs(j,:)/Rto1; RfL_Zs(j,:)= RfL_Zs(j,:)/Rto1; + %%%%%%%%%%%%%%% + end + case 2 %%%%% Linear Dose Response + %%% Schenk and Jackson 2002, Collins and Bras 2007 + c_H = 2.94./log(ZR50_H./ZR95_H); + c_L = 2.94./log(ZR50_L./ZR95_L); + %%%%%%%%%%%%%%%%%%%%% + for j=1:cc + i=1; + if not(ZR95_H(j)==0) + while i <= n + if ZR95_H(j) > Zs(i+1) + RfH_Zs(j,i) = 1./(1 + (Zs(i+1)/ZR50_H(j)).^c_H(j) ) - 1./(1 + (Zs(i)/ZR50_H(j)).^c_H(j) ) ; + else + RfH_Zs(j,i) = 1./(1 + (ZR95_H(j)/ZR50_H(j)).^c_H(j) ) - 1./(1 + (Zs(i)/ZR50_H(j)).^c_H(j) ) ; + i=n; + end + i=i+1; + end + end + i=1; + if not(ZR95_L(j)==0) + while i <= n + if ZR95_L(j) > Zs(i+1) + RfL_Zs(j,i) = 1./(1 + (Zs(i+1)/ZR50_L(j)).^c_L(j) ) - 1./(1 + (Zs(i)/ZR50_L(j)).^c_L(j) ) ; + else + RfL_Zs(j,i) = 1./(1 + (ZR95_L(j)/ZR50_L(j)).^c_L(j) ) - 1./(1 + (Zs(i)/ZR50_L(j)).^c_L(j) ) ; + i=n; + end + i=i+1; + end + end + end + Rto1 = 0.9498; + %%%%%%%%% Root Proportion in the Layer + RfH_Zs(j,:)=RfH_Zs(j,:)/Rto1; RfL_Zs(j,:)= RfL_Zs(j,:)/Rto1; + case 3 %%% Constant Profile + for j=1:cc + i=1; + if not(ZR95_H(j)==0) + while i <= n + if ZR95_H(j) > Zs(i+1) + RfH_Zs(j,i) = (Zs(i+1)-Zs(i))/ZR95_H(j) ; + else + RfH_Zs(j,i) = (ZR95_H(j)-Zs(i))/ZR95_H(j); + i=n; + end + i=i+1; + end + end + i=1; + if not(ZR95_L(j)==0) + while i <= n + if ZR95_L(j) > Zs(i+1) + RfL_Zs(j,i) = (Zs(i+1)-Zs(i))/ZR95_L(j) ; + else + RfL_Zs(j,i) = (ZR95_L(j)-Zs(i))/ZR95_L(j); + i=n; + end + i=i+1; + end + end + end + case 4 %%% Deep (Tap) Root Profile + c_H = 2.94./log(ZR50_H./ZR95_H); + c_L = 2.94./log(ZR50_L./ZR95_L); + for j=1:cc + i=1; + if not(ZR95_H(j)==0) + while i <= n + if ZR95_H(j) > Zs(i+1) + RfH_Zs(j,i) = 1./(1 + (Zs(i+1)/ZR50_H(j)).^c_H(j) ) - 1./(1 + (Zs(i)/ZR50_H(j)).^c_H(j) ) ; + elseif ZR95_H(j) <= Zs(i+1) && ZR95_H(j) > Zs(i) + RfH_Zs(j,i) = 1./(1 + (ZR95_H(j)/ZR50_H(j)).^c_H(j) ) - 1./(1 + (Zs(i)/ZR50_H(j)).^c_H(j) ) ; + if ZRmax_H(j) <= Zs(i+1) + RfH_Zs(j,i) = RfH_Zs(j,i) + 0.0502*(ZRmax_H(j)-ZR95_H(j))/(ZRmax_H(j)-ZR95_H(j)); + i=n; + else + RfH_Zs(j,i) = RfH_Zs(j,i) + 0.0502*(Zs(i+1)-ZR95_H(j))/(ZRmax_H(j)-ZR95_H(j)); + end + elseif ZRmax_H(j) > Zs(i+1) + RfH_Zs(j,i) = 0.0502*(Zs(i+1)-Zs(i))/(ZRmax_H(j)-ZR95_H(j)); + else + RfH_Zs(j,i) = 0.0502*(ZRmax_H(j)-Zs(i))/(ZRmax_H(j)-ZR95_H(j)); + i=n; + end + i=i+1; + end + end + i=1; + if not(ZR95_L(j)==0) + while i <= n + if ZR95_L(j) > Zs(i+1) + RfL_Zs(j,i) = 1./(1 + (Zs(i+1)/ZR50_L(j)).^c_L(j) ) - 1./(1 + (Zs(i)/ZR50_L(j)).^c_L(j) ) ; + elseif ZR95_L(j) <= Zs(i+1) && ZR95_L(j) > Zs(i) + RfL_Zs(j,i) = 1./(1 + (ZR95_L(j)/ZR50_L(j)).^c_L(j) ) - 1./(1 + (Zs(i)/ZR50_L(j)).^c_L(j) ) ; + if ZRmax_L(j) <= Zs(i+1) + RfL_Zs(j,i) = RfL_Zs(j,i) + 0.0502*(ZRmax_L(j)-ZR95_L(j))/(ZRmax_L(j)-ZR95_L(j)); + i=n; + else + RfL_Zs(j,i) = RfL_Zs(j,i) + 0.0502*(Zs(i+1)-ZR95_L(j))/(ZRmax_L(j)-ZR95_L(j)); + end + elseif ZRmax_L(j) > Zs(i+1) + RfL_Zs(j,i) = 0.0502*(Zs(i+1)-Zs(i))/(ZRmax_L(j)-ZR95_L(j)); + else + RfL_Zs(j,i) = 0.0502*(ZRmax_L(j)-Zs(i))/(ZRmax_L(j)-ZR95_L(j)); + i=n; + end + i=i+1; + end + end + end +end +%%%%%%%%%%% Cleaning +%for j=1:cc +% if not(ZR95_H(j)==0) +% Rto1 =sum(RfH_Zs(j,:)); +% RfH_Zs(j,:)=RfH_Zs(j,:)/Rto1; +% end +% if not(ZR95_L(j)==0) +% Rto1 =sum(RfL_Zs(j,:)); +% RfL_Zs(j,:)= RfL_Zs(j,:)/Rto1; +% end +%end +return + + diff --git a/src/Root_properties.m b/src/Root_properties.m new file mode 100644 index 00000000..578b15d1 --- /dev/null +++ b/src/Root_properties.m @@ -0,0 +1,47 @@ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% Subfunction - Root - Properties % +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%%REFERENCES +function[Rl]=Root_properties(Rl,Ac,rroot,frac,bbx,KT) +%%% INPUTS +global DeltZ LAI +% BR = 10:1:650; %% [gC /m^2 PFT] +% rroot = 0.5*1e-3 ; % 3.3*1e-4 ;%% [0.5-6 *10^-3] [m] root radius +%%% OUTPUTS + % if KT<3800 + fr=-0.0296*LAI(KT)+0.30; + % else + % fr=0.001; + % end +%elseif KT<3200 + % fr=0.05; +%else + % fr=0.02; +%end +DeltZ0=DeltZ'/100; +BR = Ac*fr*1800*12/1000000; +root_den = 250*1000; %% [gDM / m^3] Root density Jackson et al., 1997 +R_C = 0.488; %% [gC/gDM] Ratio Carbon-Dry Matter in root Jackson et al., 1997 +nn=numel(Rl); +if (~isnan(Ac))||(Ac>0) +Rl=Rl.*DeltZ0; +Delta_Rltot = BR/R_C/root_den/(pi*(rroot^2)); %% %% root length index [m root / m^2 PFT] +for i=1:nn + if Rl(i)>2000 + frac(i)=0; + end +end +frac=frac/sum(sum(frac)); +Delta_Rl=Delta_Rltot*frac.*bbx; +Rl=Rl+Delta_Rl; +Rl=Rl./DeltZ0; +else +Rl=Rl; +end +for i=1:nn + if Rl(i)>2000 + Rl(i)=2000; + end +end +end \ No newline at end of file diff --git a/src/SCOPE.exe b/src/SCOPE.exe new file mode 100644 index 00000000..b3a6cbe2 Binary files /dev/null and b/src/SCOPE.exe differ diff --git a/src/SOIL1.m b/src/SOIL1.m new file mode 100644 index 00000000..a9a13b32 --- /dev/null +++ b/src/SOIL1.m @@ -0,0 +1,49 @@ +function SOIL1 +% This subroutine is caled after one time step to update the wetting history.If the change in average moisture content +% of the element during the last time step was in the opposite direction of that during the previous time step, the history +% is updated. As an approximation, only primary scanning curves are used, subject to the constraint that matric +% head and moisture content be continuous in time. +global EX ML NL ND Theta_L XOLD IS J Theta_LL XWRE IH Theta_s XK + +for ML=1:NL + % Soil type index; + J=IS(ML); + % The average moisture content of an element; + EX=0.5*(Theta_L(ML,1)+Theta_L(ML,2)); +% Has average trend of wetting in the element changed? If the trend is +% still in drying, keep running like this. Otherwise, change trend from +% drying to wetting. Then, IH value needs to be changed as 2, and XWRE +% needs to be re-evaluated. However, if the trend is still in wetting, +% keep running like that. Otherwise, change trend from wetting to drying. + if IH(ML)==1 && XOLD(ML)<=(EX+1e-12) % IH=1 means wetting. + XOLD(ML)=EX; + return + elseif IH(ML)==2 % IH=2 means drying. + if XOLD(ML)>=(EX-1e-12) + XOLD(ML)=EX; + return + else + IH(ML)=1; + for ND=1:2 + if (Theta_s(J)-Theta_LL(ML,ND))<1e-3 + XWRE(ML,ND)=Theta_s(J); + else + XWRE(ML,ND)=Theta_s(J)*(Theta_L(ML,ND)-Theta_LL(ML,ND))/(Theta_s(J)-Theta_LL(ML,ND)); + end + end + XOLD(ML)=EX; + return + end + else + IH(ML)=2; + for ND=1:2 + if (Theta_LL(J)-XK(J))<1e-3 + XWRE(ML,ND)=XK(J); + else + XWRE(ML,ND)=Theta_LL(ML,ND)+Theta_s(J)*(Theta_L(ML,ND)/Theta_LL(ML,ND)-1); + end + end + XOLD(ML)=EX; + return + end +end \ No newline at end of file diff --git a/src/SOIL2.m b/src/SOIL2.m new file mode 100644 index 00000000..6f515119 --- /dev/null +++ b/src/SOIL2.m @@ -0,0 +1,78 @@ +function [hh,COR,J,Theta_V,Theta_g,Se,KL_h,Theta_LL,DTheta_LLh]=SOIL2(hh,COR,hThmrl,NN,NL,TT,Tr,IS,Hystrs,XWRE,Theta_s,IH,KIT,Theta_r,Alpha,n,m,Ks,Theta_L,h,Thmrlefc,CKTN,POR,J) + +if hThmrl==1 + for MN=1:NN + COR(MN)=exp(0.0068*(TT(MN)-Tr)); + if COR(MN)==0 + COR(MN)=1; + end + end +else + for MN=1:NN + COR(MN)=1; + end +end + +for MN=1:NN + hhU(MN)=COR(MN)*hh(MN); + hh(MN)=hhU(MN); +end + +[Theta_LL,Se,KL_h,DTheta_LLh,J,hh]=CondL_h(Theta_r,Theta_s,Alpha,hh,n,m,Ks,NL,Theta_L,h,IS,KIT,TT,Thmrlefc,CKTN,POR,J); +for MN=1:NN + hhU(MN)=hh(MN); + hh(MN)=hhU(MN)/COR(MN); +end + +if Hystrs==0 + for ML=1:NL + J=IS(ML); + for ND=1:2 + Theta_V(ML,ND)=POR(J)-Theta_LL(ML,ND); + if Theta_V(ML,ND)<=1e-14 + Theta_V(ML,ND)=1e-14; + end + Theta_g(ML,ND)=Theta_V(ML,ND); + end + end +else + for ML=1:NL + J=IS(ML); + for ND=1:2 + if IH(ML)==2 + if XWRE(ML,ND)0 + DTheta_LLh(ML,ND)=DTheta_LLh(ML,ND)*(Theta_LL(ML,ND)/XSAVE-XSAVE/Theta_s(J)); + end + Theta_V(ML,ND)=POR(J)-Theta_LL(ML,ND); + end + end + if IH(ML)==1 + if XWRE(ML,ND)>Theta_LL(ML,ND) + XSAVE=Theta_LL(ML,ND); + Theta_LL(ML,ND)=(2-XSAVE/Theta_s(J))*XSAVE; + if KIT>0 + DTheta_LLh(ML,ND)=2*DTheta_LLh(ML,ND)*(1-XSAVE/Theta_s(J)); + end + Theta_V(ML,ND)=POR(J)-Theta_LL(ML,ND); + else + Theta_LL(ML,ND)=Theta_LL(ML,ND)+XWRE(ML,ND)*(1-Theta_LL(ML,ND)/Theta_s(J)); + if KIT>0 + DTheta_LLh(ML,ND)=DTheta_LLh(ML,ND)*(1-XWRE(ML,ND)/Theta_s(J)); + end + Theta_V(ML,ND)=POR(J)-Theta_LL(ML,ND); + end + end + Theta_g(ML,ND)=Theta_V(ML,ND); + end + end +end + + + + + diff --git a/src/STEMMUS_SCOPE.m b/src/STEMMUS_SCOPE.m new file mode 100644 index 00000000..cdb9f6bc --- /dev/null +++ b/src/STEMMUS_SCOPE.m @@ -0,0 +1,695 @@ +%% STEMMUS-SCOPE.m (script) + +% STEMMUS-SCOPE is a model for Integrated modeling of canopy photosynthesis, fluorescence, +% and the transfer of energy, mass, and momentum in the soil–plant–atmosphere continuum (STEMMUS–SCOPE v1.0.0) +% Copyright (C) 2021 Yunfei Wang, Lianyu Yu, Yijian Zeng, Christiaan Van der Tol, Bob Su +Contact: y.zeng@utwente.nl +% +% This program is free software: you can redistribute it and/or modify +% it under the terms of the GNU General Public License as published by +% the Free Software Foundation, either version 3 of the License, or +% any later version. +% +% This program is distributed in the hope that it will be useful, +% but WITHOUT ANY WARRANTY; without even the implied warranty of +% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +% GNU General Public License for more details. +% +% You should have received a copy of the GNU General Public License +% along with this program. If not, see . +%% + +%% 0. globals +global constants +global RWU +global HR U Precip G Rn LAI Ta1 Ts1 h_v rl_min HR_a Ts Ta Tss Taa Tcc bbx RWUtot Rls frac Tsss sfactortot sfactor +run Constants +Mdata=xlsread('E:\grassland\SCOPE-master\SCOPE_v1.73\src\Meterology data','sheet1','B5:AD17572'); +Ta1=Mdata(:,1); % air temperature +HR=Mdata(:,2)./100; % relative humidity +U=Mdata(:,3); % wind speed at 2m +Precip=Mdata(:,4)./10; % precipitation +Ts1=Mdata(:,5); % soil temperature at 20cm +Ts2=Mdata(:,6); % soil temperature at 40cm +Ts3=Mdata(:,7); % soil temperature at 60cm +SMC1=Mdata(:,8); % soil moisture content at 20cm +SMC2=Mdata(:,9); % soil moisture content at 40cm +SMC3=Mdata(:,10); % soil moisture content at 60cm +G1=Mdata(:,11:13); % soil heat flux +Rn=Mdata(:,14); % net rediation +LAI=Mdata(:,26); % leaf area index +h_v=Mdata(:,27); % canopy height +rl_min=Mdata(:,28); % minimum soil resistance +G=ones(17568,1); +G=nanmean(G1')'; +Tsss=Mdata(:,29); +HR_a=HR; +Ta=Ta1; +Ts=Ts1; +%% 1. define constants +[constants] = io.define_constants(); + +%% 2. simulation options +path_of_code = cd; +run ../set_parameter_filenames; + +if length(parameter_file)>1, useXLSX = 0; else useXLSX = 1; end + +if ~useXLSX + run(['../' parameter_file{1}]) + + options.calc_ebal = N(1); % calculate the energy balance (default). If 0, then only SAIL is executed! + options.calc_vert_profiles = N(2); % calculate vertical profiles of fluxes + options.calc_fluor = N(3); % calculate chlorophyll fluorescence in observation direction + options.calc_planck = N(4); % calculate spectrum of thermal radiation + options.calc_directional = N(5); % calculate BRDF and directional temperature + options.calc_xanthophyllabs = N(6); % include simulation of reflectance dependence on de-epoxydation state + options.calc_PSI = N(7); % 0: optipar 2017 file with only one fluorescence spectrum vs 1: Franck et al spectra for PSI and PSII + options.rt_thermal = N(8); % 1: use given values under 10 (default). 2: use values from fluspect and soil at 2400 nm for the TIR range + options.calc_zo = N(9); + options.soilspectrum = N(10); %0: use soil spectrum from a file, 1: simulate soil spectrum with the BSM model + options.soil_heat_method = N(11); % 0: calculated from specific heat and conductivity (default), 1: empiricaly calibrated, 2: G as constant fraction of soil net radiation + options.Fluorescence_model = N(12); %0: empirical, with sustained NPQ (fit to Flexas' data); 1: empirical, with sigmoid for Kn; 2: Magnani 2012 model + options.calc_rss_rbs = N(13); % 0: calculated from specific heat and conductivity (default), 1: empiricaly calibrated, 2: G as constant fraction of soil net radiation + options.apply_T_corr = N(14); % correct Vcmax and rate constants for temperature in biochemical.m + options.verify = N(15); + options.save_headers = N(16); % write headers in output files + options.makeplots = N(17); + options.simulation = N(18); % 0: individual runs (specify all input in a this file) + % 1: time series (uses text files with meteo input as time series) + % 2: Lookup-Table (specify the values to be included) + % 3: Lookup-Table with random input (specify the ranges of values) +else + options = io.readStructFromExcel(['../' char(parameter_file)], 'options', 3, 1); +end + +if options.simulation>2 || options.simulation<0, fprintf('\n simulation option should be between 0 and 2 \r'); return, end + +%% 3. file names +if ~useXLSX + run(['../' parameter_file{2}]) +else + [dummy,X] = xlsread(['../' char(parameter_file)],'filenames'); + j = find(~strcmp(X(:,2),{''})); + X = X(j,(1:end)); +end + +F = struct('FileID',{'Simulation_Name','soil_file','leaf_file','atmos_file'... + 'Dataset_dir','t_file','year_file','Rin_file','Rli_file'... + ,'p_file','Ta_file','ea_file','u_file','CO2_file','z_file','tts_file'... + ,'LAI_file','hc_file','SMC_file','Vcmax_file','Cab_file','LIDF_file'}); +for i = 1:length(F) + k = find(strcmp(F(i).FileID,strtok(X(:,1)))); + if ~isempty(k) + F(i).FileName = strtok(X(k,2)); + end +end + +%% 4. input data + +if ~useXLSX + X = textread(['../' parameter_file{3}],'%s'); %#ok + N = str2double(X); +else + [N,X] = xlsread(['../' char(parameter_file)],'inputdata', ''); + X = X(9:end,1); +end +V = io.assignvarnames(); +options.Cca_function_of_Cab = 0; + +for i = 1:length(V) + j = find(strcmp(strtok(X(:,1)),V(i).Name)); + if ~useXLSX, cond = isnan(N(j+1)); else cond = sum(~isnan(N(j,:)))<1; end + if isempty(j) || cond + if i==2 + fprintf(1,'%s %s %s \n','warning: input "', V(i).Name, '" not provided in input spreadsheet...'); + fprintf(1,'%s %s %s\n', 'I will use 0.25*Cab instead'); + options.Cca_function_of_Cab = 1; + else + + if ~(options.simulation==1) && (i==30 || i==32) + fprintf(1,'%s %s %s \n','warning: input "', V(i).Name, '" not provided in input spreadsheet...'); + fprintf(1,'%s %s %s\n', 'I will use the MODTRAN spectrum as it is'); + else + if (options.simulation == 1 || (options.simulation~=1 && (i<46 || i>50))) + fprintf(1,'%s %s %s \n','warning: input "', V(i).Name, '" not provided in input spreadsheet'); + if (options.simulation ==1 && (i==1 ||i==9||i==22||i==23||i==54 || (i>29 && i<37))) + fprintf(1,'%s %s %s\n', 'I will look for the values in Dataset Directory "',char(F(5).FileName),'"'); + else + if (i== 24 || i==25) + fprintf(1,'%s %s %s\n', 'will estimate it from LAI, CR, CD1, Psicor, and CSSOIL'); + options.calc_zo = 1; + else + if (i>38 && i<44) + fprintf(1,'%s %s %s\n', 'will use the provided zo and d'); + options.calc_zo = 0; + else + if ~(options.simulation ==1 && (i==30 ||i==32)) + fprintf(1,'%s \n', 'this input is required: SCOPE ends'); + return + else + fprintf(1,'%s %s %s\n', '... no problem, I will find it in Dataset Directory "',char(F(5).FileName), '"'); + end + end + end + end + end + end + end + end + + if ~useXLSX + j2 = []; j1 = j+1; + while 1 + if isnan(N(j1)), break, end + j2 = [j2; j1]; %#ok + j1 = j1+1; + end + if isempty(j2) + V(i).Val = -999; + else + V(i).Val = N(j2); + end + + + else + if sum(~isnan(N(j,:)))<1 + V(i).Val = -999; + else + V(i).Val = N(j,~isnan(N(j,:))); + end + end +end + +%% 5. Declare paths +path_input = '../../data/input/'; % path of all inputs + +%% 6. Numerical parameters (iteration stops etc) +iter.maxit = 600; % maximum number of iterations +iter.maxEBer = 1; %[W m-2] maximum accepted error in energy bal. +iter.Wc = 1; % Weight coefficient for iterative calculation of Tc + +%% 7. Load spectral data for leaf and soil +%opticoef = xlsread([path_input,'fluspect_parameters/',char(F(3).FileName)]); % file with leaf spectral parameters +%xlsread([path_input,'fluspect_parameters/',char(F(3).FileName)]); % file with leaf spectral parameters +load([path_input,'fluspect_parameters/',char(F(3).FileName)]); +rsfile = load([path_input,'soil_spectrum/',char(F(2).FileName)]); % file with soil reflectance spectra +% Optical coefficient data used by fluspect +% optipar.nr = opticoef(:,2); +% optipar.Kab = opticoef(:,3); +% optipar.Kca = opticoef(:,4); +% optipar.Ks = opticoef(:,5); +% optipar.Kw = opticoef(:,6); +% optipar.Kdm = opticoef(:,7); +% optipar.nw = opticoef(:,8); +% optipar.phiI = opticoef(:,9); +% optipar.phiII = opticoef(:,10); +% optipar.GSV1 = opticoef(:,11); +% optipar.GSV2 = opticoef(:,12); +% optipar.GSV3 = opticoef(:,13); +% optipar.KcaV = opticoef(:,14); +% optipar.KcaZ = opticoef(:,15); + +%% 8. Load directional data from a file +directional = struct; +if options.calc_directional + anglesfile = load([path_input,'directional/brdf_angles2.dat']); % Multiple observation angles in case of BRDF calculation + directional.tto = anglesfile(:,1); % [deg] Observation zenith Angles for calcbrdf + directional.psi = anglesfile(:,2); % [deg] Observation zenith Angles for calcbrdf + directional.noa = length(directional.tto); % Number of Observation Angles +end + +%% 9. Define canopy structure +canopy.nlayers = 60; +nl = canopy.nlayers; +canopy.x = (-1/nl : -1/nl : -1)'; % a column vector +canopy.xl = [0; canopy.x]; % add top level +canopy.nlincl = 13; +canopy.nlazi = 36; +canopy.litab = [ 5:10:75 81:2:89 ]'; % a column, never change the angles unless 'ladgen' is also adapted +canopy.lazitab = ( 5:10:355 ); % a row + +%% 10. Define spectral regions +[spectral] = io.define_bands(); + +wlS = spectral.wlS; % SCOPE 1.40 definition +wlP = spectral.wlP; % PROSPECT (fluspect) range +wlT = spectral.wlT; % Thermal range +wlF = spectral.wlF; % Fluorescence range + +I01 = find(wlSmax(wlF)); +N01 = length(I01); +N02 = length(I02); + +nwlP = length(wlP); +nwlT = length(wlT); + +nwlS = length(wlS); + +spectral.IwlP = 1 : nwlP; +spectral.IwlT = nwlP+1 : nwlP+nwlT; +spectral.IwlF = (640:850)-399; + +[rho,tau,rs] = deal(zeros(nwlP + nwlT,1)); + +%% 11. load time series data +if options.simulation == 1 + vi = ones(length(V),1); + [soil,leafbio,canopy,meteo,angles,xyt] = io.select_input(V,vi,canopy,options); + [V,xyt,canopy] = io.load_timeseries(V,leafbio,soil,canopy,meteo,constants,F,xyt,path_input,options); +else + soil = struct; +end + +%% 12. preparations +if options.simulation==1 + diff_tmin = abs(xyt.t-xyt.startDOY); + diff_tmax = abs(xyt.t-xyt.endDOY); + I_tmin = find(min(diff_tmin)==diff_tmin); + I_tmax = find(min(diff_tmax)==diff_tmax); + if options.soil_heat_method<2 + if (isempty(meteo.Ta) || meteo.Ta<-273), meteo.Ta = 20; end + soil.Tsold = meteo.Ta*ones(12,2); + end +end + +nvars = length(V); +vmax = ones(nvars,1); +for i = 1:nvars + vmax(i) = length(V(i).Val); +end +vmax([14,27],1) = 1; % these are Tparam and LIDFb +vi = ones(nvars,1); +switch options.simulation + case 0, telmax = max(vmax); [xyt.t,xyt.year]= deal(zeros(telmax,1)); + case 1, telmax = size(xyt.t,1); + case 2, telmax = prod(double(vmax)); [xyt.t,xyt.year]= deal(zeros(telmax,1)); +end +[rad,thermal,fluxes] = io.initialize_output_structures(spectral); +atmfile = [path_input 'radiationdata/' char(F(4).FileName(1))]; +atmo.M = helpers.aggreg(atmfile,spectral.SCOPEspec); + +%% 13. create output files +Output_dir = io.create_output_files(parameter_file, F, path_of_code, options, V, vmax, spectral); +%15 function MainLoop +global KT Delt_t TEND TIME MN NN NL ML ND hOLD TOLD h hh T TT P_gOLD P_g P_gg Delt_t0 +global KIT NIT TimeStep Processing +global SUMTIME hhh TTT P_ggg Theta_LLL DSTOR Thmrlefc CHK Theta_LL Theta_L +global NBCh AVAIL Evap DSTOR0 EXCESS QMT RS BCh hN hSAVE NBChh DSTMAX Soilairefc Trap sumTRAP_dir sumEVAP_dir +global TSAVE IRPT1 IRPT2 AVAIL0 TIMEOLD TIMELAST SRT ALPHA BX alpha_h bx Srt L +global QL QL_h QL_T QV Qa KL_h Chh ChT Khh KhT +global D_Vg Theta_g Sa V_A k_g MU_a DeltZ Alpha_Lg +global J Beta_g KaT_Switch Theta_s +global D_V D_A fc Eta nD POR Se +global ThmrlCondCap ZETA XK DVT_Switch +global m g MU_W Ks RHOL +global Lambda1 Lambda2 Lambda3 c_unsat Lambda_eff RHO_bulk +global RHODA RHOV c_a c_V c_L +global ETCON EHCAP +global Xaa XaT Xah RDA Rv KL_T +global DRHOVT DRHOVh DRHODAt DRHODAz +global hThmrl Tr COR IS Hystrs XWRE +global Theta_V DTheta_LLh IH +global W WW D_Ta SSUR +global W_Chg +global KLT_Switch Theta_r Alpha n CKTN trap Evapo SMC lEstot lEctot Ztot Rl +%%%%%%%%%%%%%%%%%%%%%%% Main Processing part %%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +run StartInit; % Initialize Temperature, Matric potential and soil air pressure. + + +%% 14. Run the model +fprintf('\n The calculations start now \r') +calculate = 1; + +for k = 1:telmax + %SMC=Theta_LL(:,1); + TIMEOLD=0; + TIMELAST=0; + KT=KT+1 % Counting Number of timesteps + if KT>1 && Delt_t>(TEND-TIME) + Delt_t=TEND-TIME; % If Delt_t is changed due to excessive change of state variables, the judgement of the last time step is excuted. + end + TIME=TIME+Delt_t; % The time elapsed since start of simulation + TimeStep(KT,1)=Delt_t; + SUMTIME(KT,1)=TIME; + Processing=TIME/TEND + %%i%%%% Updating the state variables. %%%%%%%%%%%%%%%%%%%%%%%%%%%% + if Precip(KT)>0.0005 + NBChh=1; + else + NBChh=2; + end + if IRPT1==0 && IRPT2==0 + for MN=1:NN + hOLD(MN)=h(MN); + h(MN)=hh(MN); + hhh(MN,KT)=hh(MN); + + if Thmrlefc==1 + TOLD(MN)=T(MN); + T(MN)=TT(MN); + TTT(MN,KT)=TT(MN); + end + if Soilairefc==1 + P_gOLD(MN)=P_g(MN); + P_g(MN)=P_gg(MN); + P_ggg(MN,KT)=P_gg(MN); + end + if rwuef==1 + SRT(MN,KT)=Srt(MN,1); + ALPHA(MN,KT)=alpha_h(MN,1); + BX(MN,KT)=bx(MN,1); + end + end + DSTOR0=DSTOR; + if KT>1 + run SOIL1 + end + end + if options.simulation == 1, vi(vmax>1) = k; end + if options.simulation == 0, vi(vmax==telmax) = k; end + [soil,leafbio,canopy,meteo,angles,xyt] = io.select_input(V,vi,canopy,options,xyt,soil); + if options.simulation ~=1 + fprintf('simulation %i ', k ); + fprintf('of %i \n', telmax); + else + calculate = 0; + if k>=I_tmin && k<=I_tmax + quality_is_ok = ~isnan(meteo.p*meteo.Ta*meteo.ea*meteo.u.*meteo.Rin.*meteo.Rli); + fprintf('time = %4.2f \n', xyt.t(k)); + if quality_is_ok + calculate = 1; + end + end + end + + if calculate + + iter.counter = 0; + + LIDF_file = char(F(22).FileName); + if ~isempty(LIDF_file) + canopy.lidf = dlmread([path_input,'leafangles/',LIDF_file],'',3,0); + else + canopy.lidf = equations.leafangles(canopy.LIDFa,canopy.LIDFb); % This is 'ladgen' in the original SAIL model, + end + + if options.calc_PSI + fversion = @fluspect_B_CX; + else + fversion = @fluspect_B_CX_PSI_PSII_combined; + end + leafbio.V2Z = 0; + leafopt = fversion(spectral,leafbio,optipar); + leafbio.V2Z = 1; + leafoptZ = fversion(spectral,leafbio,optipar); + + IwlP = spectral.IwlP; + IwlT = spectral.IwlT; + + rho(IwlP) = leafopt.refl; + tau(IwlP) = leafopt.tran; + rlast = rho(nwlP); + tlast = tau(nwlP); + + if options.soilspectrum == 0 + rs(IwlP) = rsfile(:,soil.spectrum+1); + else + soilemp.SMC = 25; % empirical parameter (fixed) + soilemp.film = 0.015; % empirical parameter (fixed) + rs(IwlP) = BSM(soil,optipar,soilemp); + end + rslast = rs(nwlP); + + switch options.rt_thermal + case 0 + rho(IwlT) = ones(nwlT,1) * leafbio.rho_thermal; + tau(IwlT) = ones(nwlT,1) * leafbio.tau_thermal; + rs(IwlT) = ones(nwlT,1) * soil.rs_thermal; + case 1 + rho(IwlT) = ones(nwlT,1) * rlast; + tau(IwlT) = ones(nwlT,1) * tlast; + rs(IwlT) = ones(nwlT,1) * rslast; + end + leafopt.refl = rho; % extended wavelength ranges are stored in structures + leafopt.tran = tau; + + reflZ = leafopt.refl; + tranZ = leafopt.tran; + reflZ(1:300) = leafoptZ.refl(1:300); + tranZ(1:300) = leafoptZ.tran(1:300); + leafopt.reflZ = reflZ; + leafopt.tranZ = tranZ; + + soil.refl = rs; + + soil.Ts = meteo.Ta * ones(2,1); % initial soil surface temperature + + if length(F(4).FileName)>1 && options.simulation==0 + atmfile = [path_input 'radiationdata/' char(F(4).FileName(k))]; + atmo.M = helpers.aggreg(atmfile,spectral.SCOPEspec); + end + atmo.Ta = meteo.Ta; + + [rad,gap,profiles] = RTMo(spectral,atmo,soil,leafopt,canopy,angles,meteo,rad,options); + + switch options.calc_ebal + case 1 + [iter,fluxes,rad,thermal,profiles,soil,RWU,frac] ... + = ebal(iter,options,spectral,rad,gap, ... + leafopt,angles,meteo,soil,canopy,leafbio,xyt,k,profiles,LR); + + if options.calc_fluor + if options.calc_vert_profiles + [rad,profiles] = RTMf(spectral,rad,soil,leafopt,canopy,gap,angles,profiles); + else + [rad] = RTMf(spectral,rad,soil,leafopt,canopy,gap,angles,profiles); + end + end + if options.calc_xanthophyllabs + [rad] = RTMz(spectral,rad,soil,leafopt,canopy,gap,angles,profiles); + end + + if options.calc_planck + rad = RTMt_planck(spectral,rad,soil,leafopt,canopy,gap,angles,thermal.Tcu,thermal.Tch,thermal.Ts(2),thermal.Ts(1),1); + end + + if options.calc_directional + directional = calc_brdf(options,directional,spectral,angles,rad,atmo,soil,leafopt,canopy,meteo,profiles,thermal); + end + + otherwise + Fc = (1-gap.Ps(1:end-1))'/nl; % Matrix containing values for Ps of canopy + fluxes.aPAR = canopy.LAI*(Fc*rad.Pnh + equations.meanleaf(canopy,rad.Pnu , 'angles_and_layers',gap.Ps));% net PAR leaves + fluxes.aPAR_Cab = canopy.LAI*(Fc*rad.Pnh_Cab + equations.meanleaf(canopy,rad.Pnu_Cab, 'angles_and_layers',gap.Ps));% net PAR leaves + [fluxes.aPAR_Wm2,fluxes.aPAR_Cab_eta] = deal(canopy.LAI*(Fc*rad.Rnh_PAR + equations.meanleaf(canopy,rad.Rnu_PAR, 'angles_and_layers',gap.Ps)));% net PAR leaves + if options.calc_fluor + profiles.etah = ones(60,1); + profiles.etau = ones(13,36,60); + if options.calc_vert_profiles + [rad,profiles] = RTMf(spectral,rad,soil,leafopt,canopy,gap,angles,profiles); + else + [rad] = RTMf(spectral,rad,soil,leafopt,canopy,gap,angles,profiles); + end + end + end + if options.calc_fluor % total emitted fluorescence irradiance (excluding leaf and canopy re-absorption and scattering) + if options.calc_PSI + rad.Femtot = 1E3*(leafbio.fqe(2)* optipar.phiII(spectral.IwlF) * fluxes.aPAR_Cab_eta +leafbio.fqe(1)* optipar.phiI(spectral.IwlF) * fluxes.aPAR_Cab); + else + rad.Femtot = 1E3*leafbio.fqe* optipar.phi(spectral.IwlF) * fluxes.aPAR_Cab_eta; + end + end + io.output_data(Output_dir, options, k, iter, xyt, fluxes, rad, thermal, gap, meteo, spectral, V, vi, vmax, profiles, directional, angles) + end + if options.simulation==2 && telmax>1, vi = helpers.count(nvars,vi,vmax,1); end + Ac=fluxes.Actot; + lEstot =fluxes.lEstot; + lEctot =fluxes.lEctot; + + Tss=thermal.Tsave; + Tcc=thermal.Ts(1); + Taa=thermal.Ta; + + [Rl]=Root_properties(Rl,Ac,rroot,frac,bbx,KT); + + Ts(KT)=Ta1(KT); + if Delt_t~=Delt_t0 + for MN=1:NN + hh(MN)=h(MN)+(h(MN)-hOLD(MN))*Delt_t/Delt_t0; + TT(MN)=T(MN)+(T(MN)-TOLD(MN))*Delt_t/Delt_t0; + end + end + hSAVE=hh(NN); + TSAVE=TT(NN); + if NBCh==1 + hN=BCh; + hh(NN)=hN; + hSAVE=hN; + elseif NBCh==2 + if NBChh~=2 + if BCh<0 + hN=DSTOR0; + hh(NN)=hN; + hSAVE=hN; + else + hN=-1e6; + hh(NN)=hN; + hSAVE=hN; + end + end + else + if NBChh~=2 + hN=DSTOR0; + hh(NN)=hN; + hSAVE=hN; + end + end + + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + for KIT=1:NIT % Start the iteration procedure in a time step. + [hh,COR,J,Theta_V,Theta_g,Se,KL_h,Theta_LL,DTheta_LLh]=SOIL2(hh,COR,hThmrl,NN,NL,TT,Tr,IS,Hystrs,XWRE,Theta_s,IH,KIT,Theta_r,Alpha,n,m,Ks,Theta_L,h,Thmrlefc,CKTN,POR,J); + [KL_T]=CondL_T(NL); + [RHOV,DRHOVh,DRHOVT]=Density_V(TT,hh,g,Rv,NN); + [W,WW,MU_W,D_Ta]=CondL_Tdisp(POR,Theta_LL,Theta_L,SSUR,RHO_bulk,RHOL,TT,Theta_s,h,hh,W_Chg,NL,nD,J,Delt_t,Theta_g,KLT_Switch); + [L]=Latent(TT,NN); + [Xaa,XaT,Xah,DRHODAt,DRHODAz,RHODA]=Density_DA(T,RDA,P_g,Rv,DeltZ,h,hh,TT,P_gg,Delt_t,NL,NN,DRHOVT,DRHOVh,RHOV); + [c_unsat,Lambda_eff]=CondT_coeff(Theta_LL,Lambda1,Lambda2,Lambda3,RHO_bulk,Theta_g,RHODA,RHOV,c_a,c_V,c_L,NL,nD,ThmrlCondCap,ETCON,EHCAP); + [k_g]=Condg_k_g(POR,NL,J,m,Theta_g,g,MU_W,Ks,RHOL); + [D_V,Eta,D_A]=CondV_DE(Theta_LL,TT,fc,Theta_s,NL,nD,J,Theta_g,POR,ThmrlCondCap,ZETA,XK,DVT_Switch); + [D_Vg,V_A,Beta_g]=CondV_DVg(P_gg,Theta_g,Sa,V_A,k_g,MU_a,DeltZ,Alpha_Lg,KaT_Switch,Theta_s,Se,NL,J); + run h_sub; + + if NBCh==1 + DSTOR=0; + RS=0; + elseif NBCh==2 + AVAIL=-BCh; + EXCESS=(AVAIL+QMT(KT))*Delt_t; + if abs(EXCESS/Delt_t)<=1e-10,EXCESS=0;end + DSTOR=min(EXCESS,DSTMAX); + RS=(EXCESS-DSTOR)/Delt_t; + else + AVAIL=AVAIL0-Evap(KT); + EXCESS=(AVAIL+QMT(KT))*Delt_t; + if abs(EXCESS/Delt_t)<=1e-10,EXCESS=0;end + DSTOR=0; + RS=0; + end + + if Soilairefc==1 + run Air_sub; + end + + if Thmrlefc==1 + run Enrgy_sub; + end + + if max(CHK)<0.001 + break + end + hSAVE=hh(NN); + TSAVE=TT(NN); + + end + TIMEOLD=KT; + + KIT + KIT=0; + [hh,COR,J,Theta_V,Theta_g,Se,KL_h,Theta_LL,DTheta_LLh]=SOIL2(hh,COR,hThmrl,NN,NL,TT,Tr,IS,Hystrs,XWRE,Theta_s,IH,KIT,Theta_r,Alpha,n,m,Ks,Theta_L,h,Thmrlefc,CKTN,POR,J); + + if IRPT1==0 && IRPT2==0 + if KT % In case last time step is not convergent and needs to be repeated. + MN=0; + + for ML=1:NL + for ND=1:2 + MN=ML+ND-1; + Theta_LLL(ML,ND,KT)=Theta_LL(ML,ND); + Theta_L(ML,ND)=Theta_LL(ML,ND); + + end + end + + + run ObservationPoints + end + if (TEND-TIME)<1E-3 + for MN=1:NN + hOLD(MN)=h(MN); + h(MN)=hh(MN); + hhh(MN,KT)=hh(MN); + if Thmrlefc==1 + TOLD(MN)=T(MN); + T(MN)=TT(MN); + TTT(MN,KT)=TT(MN); + end + if Soilairefc==1 + P_gOLD(MN)=P_g(MN); + P_g(MN)=P_gg(MN); + P_ggg(MN,KT)=P_gg(MN); + end + end + break + end + end + for MN=1:NN + QL(MN,KT)=QL(MN); + QL_h(MN,KT)=QL_h(MN); + QL_T(MN,KT)=QL_T(MN); + Qa(MN,KT)=Qa(MN); + QV(MN,KT)=QV(MN); + end + RWUtot(:,KT)=RWU; + Rls(:,KT)=Rl; + sfactortot(KT)=sfactor; + +end + +%%%%%%%%%%%%%%%%%%%% postprocessing part %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%%%% plot the figures of simulation output soil moisture/temperature, +%%%% soil evaporation, plant transpiration simulated with two different +%%%% ET method (indirect ET method & direct ET method) +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +if Evaptranp_Cal==1 % save the variables for ETind scenario + Sim_Theta_ind=Sim_Theta; + Sim_Temp_ind=Sim_Temp; + TRAP=36000.*trap; + TRAP_ind=TRAP'; + EVAP=36000.*Evapo; + EVAP_ind=EVAP'; + disp ('Convergence Achieved for ETind scenario. Please switch to ETdir scenario and run again.') +else + TRAP=18000.*trap; + TRAP_dir=TRAP'; + EVAP=18000.*Evapo; + EVAP_dir=EVAP'; + for i=1:KT/48 + sumTRAP_ind(i)=0; %#ok<*SAGROW> + sumEVAP_ind(i)=0; + sumTRAP_dir(i)=0; + sumEVAP_dir(i)=0; + for j=(i-1)*48+1:i*48 + sumTRAP_ind(i)=TRAP_ind(j)+sumTRAP_ind(i); + sumEVAP_ind(i)=EVAP_ind(j)+sumEVAP_ind(i); + sumTRAP_dir(i)=TRAP(j)+sumTRAP_dir(i); + sumEVAP_dir(i)=EVAP(j)+sumEVAP_dir(i); + end + end +end +if options.verify + io.output_verification(Output_dir) +end + +if options.makeplots + plot.plots(Output_dir) +end + +%% for Compiler +% catch ME +% disp(['ERROR: ' ME.message]) +% end +% fprintf('\nThe run is finished. Press any key to close the window') +% fprintf('\nIf no error message was produced navigate to ./SCOPE_v1.70/output to see the results') +% pause diff --git a/src/StartInit.m b/src/StartInit.m new file mode 100644 index 00000000..7482381c --- /dev/null +++ b/src/StartInit.m @@ -0,0 +1,219 @@ +function StartInit + +global InitND1 InitND2 InitND3 InitND4 InitND5 BtmT BtmX Btmh% Preset the measured depth to get the initial T, h by interpolation method. +global InitT0 InitT1 InitT2 InitT3 InitT4 InitT5 Dmark +global T MN ML NL NN DeltZ Elmn_Lnth Tot_Depth InitLnth +global InitX0 InitX1 InitX2 InitX3 InitX4 InitX5 Inith0 Inith1 Inith2 Inith3 Inith4 Inith5 +global h Theta_s Theta_r m n Alpha Theta_L Theta_LL hh TT P_g P_gg Ks +global XOLD XWRE NS J POR Thmrlefc IH IS Eqlspace FACc +global porosity SaturatedMC ResidualMC SaturatedK Coefficient_n Coefficient_Alpha +global NBCh NBCT NBCP NBChB NBCTB NBCPB BChB BCTB BCPB BCh BCT BCP BtmPg +global DSTOR DSTOR0 RS NBChh DSTMAX IRPT1 IRPT2 Soilairefc XK XWILT +global HCAP TCON SF TCA GA1 GA2 GB1 GB2 S1 S2 HCD TARG1 TARG2 GRAT VPER +global TERM ZETA0 CON0 PS1 PS2 i KLT_Switch DVT_Switch KaT_Switch +global Kaa_Switch DVa_Switch KLa_Switch +global hThmrl Tr COR Hystrs +global Theta_V DTheta_LLh Theta_g KIT Se KL_h CKTN + +Elmn_Lnth=0; +Dmark=0; + +for J=1:NS + POR(J)=porosity(J); + Theta_s(J)=SaturatedMC(J); + Theta_r(J)=ResidualMC(J); + n(J)=Coefficient_n(J); + Ks(J)=SaturatedK(J); + Alpha(J)=Coefficient_Alpha(J); + m(J)=1-1/n(J); + XK(J)=0.075; %0.11 This is for silt loam; For sand XK=0.025 + XWILT(J)=Theta_r(J)+(Theta_s(J)-Theta_r(J))/(1+abs(Alpha(J)*(-1.5e4))^n(J))^m(J); +end + if ~Eqlspace + Inith0=-(((Theta_s(J)-Theta_r(J))/(InitX0-Theta_r(J)))^(1/m(J))-1)^(1/n(J))/Alpha(J); + Inith1=-(((Theta_s(J)-Theta_r(J))/(InitX1-Theta_r(J)))^(1/m(J))-1)^(1/n(J))/Alpha(J); + Inith2=-(((Theta_s(J)-Theta_r(J))/(InitX2-Theta_r(J)))^(1/m(J))-1)^(1/n(J))/Alpha(J); + Inith3=-(((Theta_s(J)-Theta_r(J))/(InitX3-Theta_r(J)))^(1/m(J))-1)^(1/n(J))/Alpha(J); + Inith4=-(((Theta_s(J)-Theta_r(J))/(InitX4-Theta_r(J)))^(1/m(J))-1)^(1/n(J))/Alpha(J); + Inith5=-(((Theta_s(J)-Theta_r(J))/(InitX5-Theta_r(J)))^(1/m(J))-1)^(1/n(J))/Alpha(J); + Btmh=-(((Theta_s(J)-Theta_r(J))/(BtmX-Theta_r(J)))^(1/m(J))-1)^(1/n(J))/Alpha(J); + + if Btmh==-inf + Btmh=-1e6; + end + + for ML=1:NL + Elmn_Lnth=Elmn_Lnth+DeltZ(ML); + InitLnth(ML)=Tot_Depth-Elmn_Lnth; + if abs(InitLnth(ML)-InitND5)<1e-10 + for MN=1:(ML+1) + T(MN)=BtmT+(MN-1)*(InitT5-BtmT)/ML; + h(MN)=(Btmh+(MN-1)*(Inith5-Btmh)/ML); + IS(MN)=1; %%%%%% Index of soil type %%%%%%% + IH(MN)=2; %%%%%% Index of wetting history of soil which would be assumed as dry at the first with the value of 1 %%%%%%% + end + Dmark=ML+2; + end + if abs(InitLnth(ML)-InitND4)<1e-10 + for MN=Dmark:(ML+1) + T(MN)=InitT5+(MN-Dmark+1)*(InitT4-InitT5)/(ML+2-Dmark); + h(MN)=(Inith5+(MN-Dmark+1)*(Inith4-Inith5)/(ML+2-Dmark)); + IS(MN-1)=1; + IH(MN-1)=2; + end + Dmark=ML+2; + end + if abs(InitLnth(ML)-InitND3)<1e-10 + for MN=Dmark:(ML+1) + T(MN)=InitT4+(MN-Dmark+1)*(InitT3-InitT4)/(ML+2-Dmark); + h(MN)=(Inith4+(MN-Dmark+1)*(Inith3-Inith4)/(ML+2-Dmark)); + IS(MN-1)=1; + IH(MN-1)=2; + end + Dmark=ML+2; + end + if abs(InitLnth(ML)-InitND2)<1e-10 + for MN=Dmark:(ML+1) + T(MN)=InitT3+(MN-Dmark+1)*(InitT2-InitT3)/(ML+2-Dmark); + h(MN)=(Inith3+(MN-Dmark+1)*(Inith2-Inith3)/(ML+2-Dmark)); + IS(MN-1)=1; + IH(MN-1)=2; + end + Dmark=ML+2; + end + if abs(InitLnth(ML)-InitND1)<1e-10 + for MN=Dmark:(ML+1) + T(MN)=InitT2+(MN-Dmark+1)*(InitT1-InitT2)/(ML+2-Dmark); + h(MN)=(Inith2+(MN-Dmark+1)*(Inith1-Inith2)/(ML+2-Dmark)); + IS(MN-1)=1; + IH(MN-1)=2; + end + Dmark=ML+2; + end + if abs(InitLnth(ML))<1e-10 + for MN=Dmark:(NL+1) + T(MN)=InitT1+(MN-Dmark+1)*(InitT0-InitT1)/(NL+2-Dmark); + h(MN)=(Inith1+(MN-Dmark+1)*(Inith0-Inith1)/(ML+2-Dmark)); + IS(MN-1)=1; + IH(MN-1)=2; + end + end + end + else + for MN=1:NN + h(MN)=-95; + T(MN)=22; + TT(MN)=T(MN); + IS(MN)=1; + IH(MN)=2; + end + end + +for MN=1:NN + hh(MN)=h(MN); + if Thmrlefc==1 + TT(MN)=T(MN); + end + if Soilairefc==1 + P_g(MN)=94197.850*10; + P_gg(MN)=P_g(MN); + end + if MN J g-1 Cels-1; % +TCON(1)=1.37e-3*4.182;TCON(2)=6e-5*4.182;TCON(3)=8.8e-2;TCON(4)=2.9e-2;TCON(5)=2.5e-3;% ZENG origial TCON(3)=2.1e-2*4.182;TCON(4)=7e-3*4.182;TCON(5)=6e-4*4.182; % J cm^-1 s^-1 Cels^-1; % +SF(1)=0;SF(2)=0;SF(3)=0.125;SF(4)=0.125;SF(5)=0.5; % +TCA=6e-5*4.182;GA1=0.035;GA2=0.013; % +VPER(1)=0.41;VPER(2)=0.05;VPER(3)=0.05;% for sand VPER(1)=0.65;VPER(2)=0;VPER(3)=0; % For Silt Loam; % VPER(1)=0.16;VPER(2)=0.33;VPER(3)=0.05; % + % +%%%%% Perform initial thermal calculations for each soil type. %%%% % +for J=1:NS %--------------> Sum over all phases of dry porous media to find the dry heat capacity % + S1=POR(J)*TCA; %-------> and the sums in the dry thermal conductivity; % + S2=POR(J); % + HCD(J)=0; % + for i=3:5 % + TARG1=TCON(i)/TCA-1; % + GRAT=0.667/(1+TARG1*SF(i))+0.333/(1+TARG1*(1-2*SF(i))); % + S1=S1+GRAT*TCON(i)*VPER(i-2); % + S2=S2+GRAT*VPER(i-2); % + HCD(J)=HCD(J)+HCAP(i)*VPER(i-2); % + end % + ZETA0(J)=1/S2; % + CON0(J)=1.25*S1/S2; % + PS1(J)=0; % + PS2(J)=0; % + for i=3:5 % + TARG2=TCON(i)/TCON(1)-1; % + GRAT=0.667/(1+TARG2*SF(i))+0.333/(1+TARG2*(1-2*SF(i))); % + TERM=GRAT*VPER(i-2); % + PS1(J)=PS1(J)+TERM*TCON(i); % + PS2(J)=PS2(J)+TERM; % + end % + GB1(J)=0.298/POR(J); % + GB2(J)=(GA1-GA2)/XWILT(J)+GB1(J); % +end % +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +% According to hh value get the Theta_LL +% run SOIL2; % For calculating Theta_LL,used in first Balance calculation. +[hh,COR,J,Theta_V,Theta_g,Se,KL_h,Theta_LL,DTheta_LLh]=SOIL2(hh,COR,hThmrl,NN,NL,TT,Tr,IS,Hystrs,XWRE,Theta_s,IH,KIT,Theta_r,Alpha,n,m,Ks,Theta_L,h,Thmrlefc,CKTN,POR,J); + +for ML=1:NL + Theta_L(ML,1)=Theta_LL(ML,1); + Theta_L(ML,2)=Theta_LL(ML,2); + XOLD(ML)=(Theta_L(ML,1)+Theta_L(ML,2))/2; +end +% Using the initial condition to get the initial balance +% information---Initial heat storage and initial moisture storage. +KLT_Switch=1; +DVT_Switch=1; +if Soilairefc + KaT_Switch=1; + Kaa_Switch=1; + DVa_Switch=1; + KLa_Switch=1; +end +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%%%%%% The boundary condition information settings.%%%%%%%%%%%%%%%%%%%%%%%% +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +IRPT1=0; +IRPT2=0; +NBCh=3; % Moisture Surface B.C.: 1 --> Specified matric head(BCh); 2 --> Specified flux(BCh); 3 --> Atmospheric forcing; +BCh=-20/1800; +NBChB=2; % Moisture Bottom B.C.: 1 --> Specified matric head (BChB); 2 --> Specified flux(BChB); 3 --> Zero matric head gradient (Gravitiy drainage); +BChB=0; +if Thmrlefc==1 + NBCT=1; % Energy Surface B.C.: 1 --> Specified temperature (BCT); 2 --> Specified heat flux (BCT); 3 --> Atmospheric forcing; + BCT=9.89; % surface temperature + NBCTB=1;% Energy Bottom B.C.: 1 --> Specified temperature (BCTB); 2 --> Specified heat flux (BCTB); 3 --> Zero temperature gradient; + BCTB=16.6; +end +if Soilairefc==1 + NBCP=2; % Soil air pressure B.C.: 1 --> Ponded infiltration caused a specified pressure value; + % 2 --> The soil air pressure is allowed to escape after beyond the threshold value; + % 3 --> The atmospheric forcing; + BCP=0; + NBCPB=2; % Soil air Bottom B.C.: 1 --> Bounded bottom with specified air pressure; 2 --> Soil air is allowed to escape from bottom; + BCPB=0; +end + +if NBCh~=1 + NBChh=2; % Assume the NBChh=2 firstly; +end + +FACc=0; % Used in MeteoDataCHG for check is FAC changed? +BtmPg=94197.850*10; % Atmospheric pressure at the bottom (Pa), set fixed + % with the value of mean atmospheric pressure; +DSTOR=0; % Depth of depression storage at end of current time step; +DSTOR0=DSTOR; % Dept of depression storage at start of current time step; +RS=0; % Rate of surface runoff; +DSTMAX=0; % Depression storage capacity; +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + + + diff --git a/src/TimestepCHK.m b/src/TimestepCHK.m new file mode 100644 index 00000000..dad37ec1 --- /dev/null +++ b/src/TimestepCHK.m @@ -0,0 +1,105 @@ +function [KT,TIME,Delt_t,tS,NBChh,IRPT1,IRPT2]=TimestepCHK(NBCh,BCh,NBChh,DSTOR,DSTOR0,EXCESS,QMT,Precip,Evap,hh,KT,TIME,Delt_t,tS,IRPT1,NN) + +global xERR hERR TERR +global Theta_LL Theta_L h TT T +global NL +global Thmrlefc NBChB NBCT NBCTB + +if NBCh==1 + [KT,TIME,Delt_t,IRPT1,IRPT2,tS]=CnvrgnCHK(xERR,hERR,TERR,Theta_LL,Theta_L,hh,h,TT,T,KT,TIME,Delt_t,NL,NN,Thmrlefc,NBCh,NBChB,NBCT,NBCTB,tS); + +elseif NBCh==3 + if NBChh==2 %------------------------> NBCh is equal to 3. Which type of BC was used on last time step? + if hh(NN)<= DSTOR %------------------------> NBChh is equal to 2. Check that calculated surface matric head is not unrealistic. + CnvrgnCHK % If it is not, proceed to check the convergence condition.If it is, switch over to NBChh=1. + else + NBChh=1; + if IRPT1==1 %------------------------> Since IRPT1=1, we know that simply switching the value of NBChh and re-running the time step + IRPT1=0;IRPT2=1; % will not work, since both values of NBChh have been tried. We therefore decrease the length of + KT=KT-1;TIME=TIME-Delt_t; % the time step. If the step is sufficiently small, we can always find a value of NBChh that gives + Delt_t=Delt_t*0.25; % consistent results. + tS=tS+1; %-----------------------> tS has passed one, then, whenever it is necessary to repeat a time step, tS should be plused one + return % to keep consistant with the number of records of meteorological forcing data. + else %-----------------------> Control is transfered here whenever it is found necessary to switch the value of NBChh as a + IRPT1=1;IRPT2=0; % result of inconsistencies between actual and assumed surface BC on moisture. As long as the + KT=KT-1; + TIME=TIME-Delt_t; + tS=tS+1; + return % current value of IRPT1 is 0, this is the first time the switch has been made this time step + % with this value of Delt_t. In that case, IRPT1 is set equal to 1 to indicate that a switch is + end % being made, and control returns to the main program in order to repeat the time step. IRPT2=0 + end % means that Delt_t has not been decreased. + elseif EXCESS>=0 %-----------------------> NBChh is equal to 1. As long as a non-negative value for EXCESS was found, the result is OK. +% CnvrgnCHK + [KT,TIME,Delt_t,IRPT1,IRPT2,tS]=CnvrgnCHK(xERR,hERR,TERR,Theta_LL,Theta_L,hh,h,TT,T,KT,TIME,Delt_t,NL,NN,Thmrlefc,NBCh,NBChB,NBCT,NBCTB,tS); + else + if DSTOR0 <= 1e-8 || (-QMT-Precip(KT)+Evap(KT))<=0 + NBChh=2; + if IRPT1==1 + IRPT1=0;IRPT2=1; + KT=KT-1;TIME=TIME-Delt_t; + Delt_t=Delt_t*0.25; + tS=tS+1; + return + else + IRPT1=1;IRPT2=0; + KT=KT-1; + TIME=TIME-Delt_t; + tS=tS+1; + return + end + else %-----------------------> Two situations are considered when excess comes out negative. If there was depression storage at + IRPT1=0;IRPT2=1; % the start of the step and the infiltration rate was greater than the effective precipitation rate, + KT=KT-1;TIME=TIME-Delt_t; % then the time step is decreased so as to make the depression storage just disappear at the end of the step. + Delt_t=DSTOR0/(-QMT-Precip(KT)+Evap(KT)); + tS=tS+1; + return + end + end +else + if NBChh==2 %-----------------------> NBChh is equal to 2. This means that the soil was thought to be capable of supporting the sepcified flux, + if hh(NN)>=-1e6 && hh(NN)<=DSTOR % BCh. Check to be sure that the resulting matric head does not have a physically unrealistic value. If it +% CnvrgnCHK % does not, proceed to find the new Delt_t. If it does, then repeat the time step with NBChh equal to 1. + [KT,TIME,Delt_t,IRPT1,IRPT2,tS]=CnvrgnCHK(xERR,hERR,TERR,Theta_LL,Theta_L,hh,h,TT,T,KT,TIME,Delt_t,NL,NN,Thmrlefc,NBCh,NBChB,NBCT,NBCTB,tS); + else + NBChh=1; + if IRPT1==1 + IRPT1=0; IRPT2=1; + KT=KT-1; TIME=TIME-Delt_t; + Delt_t=Delt_T*0.25; + tS=tS+1; + return + else + IRPT1=1; IRPT2=0; + KT=KT-1; + TIME=TIME-Delt_t; + tS=tS+1; + return + end + end + else + if abs(QMT)<=abs(BCh) %-------------------> NBChh is equal to 1. This means that the potential flux was thought to be excessive, and a specified head +% CnvrgnCHK % (saturation or dryness) was applied. Check to be sure that the resulting flux did not exceed the potential value + % in magnitude. If it did not, proceed to find new Delt_T. If it did, repeat the step with NBChh equal to 2; + [KT,TIME,Delt_t,IRPT1,IRPT2,tS]=CnvrgnCHK(xERR,hERR,TERR,Theta_LL,Theta_L,hh,h,TT,T,KT,TIME,Delt_t,NL,NN,Thmrlefc,NBCh,NBChB,NBCT,NBCTB,tS); + else + NBChh=2; + if IRPT1==1 + IRPT1=0; IRPT2=1; + KT=KT-1; TIME=TIME-Delt_t; + Delt_t=Delt_t*0.25; + tS=tS+1; + return + else + IRPT1=1; IRPT2=0; + KT=KT-1; + TIME=TIME-Delt_t; + tS=tS+1; + return + end + end + end +end + + + diff --git a/src/VEGETATION_DYNAMIC.m b/src/VEGETATION_DYNAMIC.m new file mode 100644 index 00000000..ed432983 --- /dev/null +++ b/src/VEGETATION_DYNAMIC.m @@ -0,0 +1,369 @@ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% Subfunction VEGETATION_DYNAMIC %%% +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%%% References [Cox 2001] Bonan et al., 2003 Krinner et al., 2005 Ivanov +%%% et al., 2008 Sitch et al 2003 White et al 2000 Knorr 2000 Arora and +%%% Boer 2003 +function[dB]= VEGETATION_DYNAMIC(t,B,Tam,Tsm,An,Rdark,Bfac,Bfac_alloc,FNC,Se_bio,Tdp_bio,dtd,GF,... + Sl,mSl,St,r,rNc,gR,aSE,Trr,dd_max,dc_C,Tcold,drn,dsn,age_cr,PHE_S,AgeL,AgeDL,LtR,eps_ac,... + Mf,Wm,fab,fbe,Klf,ff_r,Rexmy,NBLeaf,dflo,Nreserve,Preserve,Kreserve,TBio,OPT_EnvLimitGrowth) +%%%% INPUT +%%% OUTPUT +%%% dB [gC/m^2 d] +%%% B = [gC/m^2] +%Nreserve = Actually this is Nitrogen Available [gN/m^2] +%Preserve = Actually this is Phosporus Available [gN/m^2] +%Kreserve = Actually this is Potassium Available [gN/m^2] +%%%%%%%%%%%%%%%%%%%%%%%%% +% Tam [°C] Mean Daily Temperature +% Tsm [°C] Soil Daily Temperature +% An [umolCO2/ s m^2] Net Assimilation Rate +% Rdark % [umolCO2/ s m^2] Leaf Maintenace Respiration / Dark Respiration +% Om [] Daily Water Content in the Root Zone +% Osm [] Daily Water Content in the Surface Layer +% ke Light extinction Coefficient +%%%% PARAMETERS +%%%%%%% CARBON POOL %%%%%%%%%%% +%%% B1 Leaves - Grass +%%% B2 Sapwood +%%% B3 Fine Root +%%% B4 Carbohydrate Reserve +%%% B5 Fruit and Flower +%%% B6 Heartwood - Dead Sapwood +%%% B7 Leaves - Grass -- Standing Dead +%%% B8 Idling Respiration +%%%%%%%%%%%%%%%% +%%%%%%%%%%%%%% Stochiometry - Concentration - +Nl = St.Nl; %%% [gC/gN] +Ns = St.Ns; %%% [gC/gN] +Nr = St.Nr ; %%% [gC/gN] +Nc= Ns; %%% [gC/gN] Carbohydrate Reserve Carbon Nitrogen +Nf = St.Nf; %%% [gC/gN] +Nh = St.Nh; %%% [gC/gN] +%%% +Phol = St.Phol; %%% [gC/gP] +Phos = St.Phos; %%% [gC/gP] +Phor = St.Phor ; %%% [gC/gP] +Phoc= Phos; %%% [gC/gP] Carbohydrate Reserve Carbon Phosophorus +Phof = St.Phof; %%% [gC/gP] +Phoh = St.Phoh; %%% [gC/gP] +%%% +Kpotl = St.Kpotl; %%% [gC/gK] +Kpots = St.Kpots; %%% [gC/gK] +Kpotr = St.Kpotr ; %%% [gC/gK] +Kpotc= Kpots; %%% [gC/gK] Carbohydrate Reserve Carbon Potassium +Kpotf = St.Kpotf; %%% [gC/gK] +Kpoth = St.Kpoth; %%% [gC/gK] +ftransL = St.ftransL; +ftransR = St.ftransR; +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%%%%%% No Negative Pool +B(B<0)=0; +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%Sl specific leaf area of biomass [m^2 / gC] +if mSl==0 + LAI = Sl*B(1); %% Leaf area index for green biomass +else + LAI = Sl*((exp(mSl*B(1))-1)/mSl); +end +%%%%%%%%%%%%%% Maintenance and Growth Respiration +GPP = 1.0368*(An + Rdark); %% [gC / m^2 d] Gross Primary Productivty --> A +% gR growth respiration [] -- [Rg/(GPP-Rm)] +% r respiration rate at 10° [gC/gN d ] +% Ns [gC/gN] Sapwood +% Nr [gC/gN] Fine root +%%%%Ref-- Sitch 2003 Ivanov 2008 Ruimy 1996 Ryan 1991 +gTam = exp(308.56*(1/56.02 - 1/(Tam+46.02))); +gTsm = exp(308.56*(1/56.02 - 1/(Tsm+46.02))); +Rms = fab*r*B(2)*gTam/Ns + fbe*r*B(2)*gTsm/Ns; %%% [gC / m^2 d] +Rmr = rNc*r*B(3)*gTsm/Nr; %%% [gC / m^2 d] +if aSE == 2 + Rmc = rNc*r*B(4)*gTsm/Nc; %%% [gC / m^2 d] +else + Rmc = fab*rNc*r*B(4)*gTam/Nc + fbe*rNc*r*B(4)*gTsm/Nc; %%% [gC / m^2 d] +end +Rm = Rms + Rmr + Rmc + 1.0368*Rdark; %%% [gC / m^2 d] Maintenance Respiration +%Rg = max(0,gR*GPP); %%% Growth Respiration [gC / m^2 d] only for GPP>0 +Rg = max(0,gR*(GPP-Rm)); %%% Growth Respiration [gC / m^2 d] only for GPP>0 +RA = Rg + Rm; %% Autotrphic Respiration [gC / m^2 d] +NPP = GPP-RA; %% Net Primary Productivity [gC / m^2 d] NPP = An - Rg -Rmr -Rms -Rmc +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%%%%%% Preliminsary fractions +%%%% ALLOCATION %%% Friedlingstein et al 1998 +%%% Krinner et al., 2005 +%%% fr allocation to root +%%% fs allocation to sapwood +%%% fl allocation to leaf +%%% fc allocation to carbohydrate reserve +%%% ff allocation to flower and fruit to reproduction +[fs1,fr1,fl1]= Allocation_Coefficients(TBio,LAI,Bfac_alloc,Se_bio,Tdp_bio,FNC,aSE,age_cr,dflo); +%%%%%%%%%%%%%%%%%%%%%%%%%% +%%%%%%%%%%%%%%%%%%%%%%%%%% +%%%%% Maximum Growth %%%%% +if (PHE_S == 2) + fl1 = fr1 + fs1 + fl1; %%% Partial Allocation to Leaves + fs1=0; fr1=0; +end +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%%%% PHE_S --> DORMANT 1 - MAX GROWTH 2 - NORMAL GROWTH 3 - SENESCENCE 4 - +%%% aSE %%% PHENOLOGY KIND -- 1 Seasonal Plant -- 0 Evergreen -- 2 Grass species +if (aSE == 1 || aSE == 2 ) && ((PHE_S == 4) || (PHE_S == 1)) %% Decidous dormant or senescente + %%%%%%%%%% Constrain Reserve + if (B(4)< 0.67*B(2)) %%% [2/3 of Sapwood for reserve Friend et al., 1997] + fc = 1; + fs = 0; fl = 0; fr = 0; ff = 0; + else + fl = 0; ff = 0; + if aSE == 2 + if (B(4)< 0.67*B(3)) % [2/3 of Root for reserve in Grasses Species] + fc = 1; fr = 0; fs = 0; + else + fr= 1; fs=0; fc = 0; + end + else + fr=0; fs=1; fc = 0; + end + end + %%% +else + %%% + if ((aSE == 0) || (aSE == 3)) && ((PHE_S == 4) || (PHE_S == 1)) + if (aSE == 0) + ff = 0; C = 1/(1+eps_ac*(fl1+fr1)); + end + if (aSE == 3) + ff = ff_r; C = 1/(1+eps_ac*(fl1+fr1)); + end + else + ff = ff_r; + if (PHE_S == 3) %% During normal growth + C = 1/(1+eps_ac*(fl1+fr1)); + else + C=1; + end + end + %%%%%%%%%% Constrain Reserve + if (B(4) >= 0.67*B(2)) && (aSE == 0 || aSE == 1 || aSE ==3) %%% [2/3 of Sapwood for reserve Friend et al., 1997] + C = 1; + end + if (B(4) >= 0.67*B(3)) && (aSE == 2)%%% [2/3 of Root for reserve in Grasses) + C = 1; + end + %%%%%%%%%%%%%%%%%%%%% + fc = (1-C)*(1-ff); + %%%%%%%%%%%%%%%%%%%%%%% + fl = fl1*(1- ff)*C; + fr = fr1*(1- ff)*C; + fs = fs1*(1- ff)*C; +end +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%%% Constrain Allocation +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +if B(1) >= LtR*B(3) %%% Leaf-Root ratio + if (aSE == 1) || (aSE == 0) || (aSE == 3) %% Woody Species + if (fr + fs) == 0 + fls = 0.5*fl; + else + fls = fl*(fs/(fr+fs)); + end + fs = fs + fls; + fr = fr + (fl-fls); + fl=0; + else + fr = fr+ fl; + fl = 0; + end +end +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%%%%% Constrain sapwood - leaf area --- +%%%%%%%%%%%%%%% Check !! %%%%%%%%%%%% +if (fl+fr+fs+ff+fc > 1.001) || (fl+fr+fs+ff+fc < 0.999) + disp('ERROR IN ALLOCATION') + return +end +%%%%%%%%%%%%%%%%%%%%%%%% +%%% Traslocation to carbohydrate to leaf in the growing season +if (PHE_S == 2) && (B(1) < LtR*B(3)) + Tr = min(B(4),Trr); %%% [gC /m^2 d] + Tr_r = Tr*B(1)/(B(3)+B(1)+0.001); %% Translocation to root [gC /m^2 d] + Tr_l = Tr - Tr_r; %% Translocation to leaf [gC /m^2 d] +else + Tr = 0; + Tr_r = 0; + Tr_l = 0; +end +%%% Mf = Fruit and Flower Maturation +%%% Wm = Dead wood mortality +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%%%%%%%%%%%%% +%%%%%%%%%%%%%%%%%%%%%%%%%%% +%%% Leaf Phenology +% dl normal death rate of aboveground biomass Leaf Grass [1/d] +% dc cold death rate [1/d] +% dd draught death rate +% ds death rate of sapwood [1/d] +% dr death rate of fine root biomass [1/d] +%%%%%%%%%%%%%%%%%%%%%%%%%%% +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%%%%%%%%%%%%%% Leaf Shed whit Age +switch aSE + case 0 + dla= AgeL/((age_cr)^2); %% [1/d] Mortality for normal leaf age + case 1 + dla= min(0.99,(1/age_cr)*(AgeL/age_cr).^4); %% [1/d] Mortality for normal leaf age + case 2 + dla= min(1/age_cr,AgeL/((age_cr)^2)); %% [1/d] Mortality for normal grass age + case 3 + if NPP > 0 + dlaK=(NBLeaf)/B(1)*age_cr; %% [-] + else + dlaK=1; + end + %%%% + dla= dlaK*AgeL/((age_cr)^2); %% [1/d] Mortality for normal leaf age +end +%%%%%% +%%% Leaf Mortality to Cold Stress Linear [Cox 2001] +dc= (dc_C*(Tcold - Tam))*(Tam GF ; %% [gC /m^2 d] + f_red = (GF/NPP); %%% [-] + Add_AR=(1-f_red)*NPP;% Additional Allocation to Reserve -- [gC /m^2 d] + NPP=f_red*NPP; + else + Add_AR = 0; + end +else + Add_AR = 0; +end +%%%%%%%%%%%%%%%%% STOICHIOMETRIC Constraints Growth +if NPP > 0 + %%%% NITROGEN + Ncons= fl*(NPP)/Nl+ ff*(NPP)/Nf + fc*(NPP)/Nc + fr*(NPP)/Nr + fs*(NPP)/Ns + Tr_l/Nl + Tr_r/Nr + Ss/Nh ... + - Sll*ftransL/Nl - Sr*ftransR/Nr - Tr./Nc -Ss./Ns -Rexmy/Nc + Add_AR/Nc; %% [gN /m^2 d] + %%%% + if (Ncons) > Nreserve/dtd + f_red = (Nreserve/dtd)/Ncons; %%% [-] + else + f_red = 1; + end + AddRA=(1-f_red)*NPP;% Additional Respiration/Allocation [gC /m^2 d] + NPP=f_red*NPP; + %%%%% + WResp = AddRA; %% [gC /m^2 d] + %%%%%% + %%%% PHOSPHORUS + Pcons= fl*(NPP)/Phol+ ff*(NPP)/Phof + fc*(NPP)/Phoc + fr*(NPP)/Phor + fs*(NPP)/Phos + Tr_l/Phol + Tr_r/Phor + Ss/Phoh ... + - Sll*ftransL/Phol - Sr*ftransR/Phor - Tr./Phoc -Ss./Phos -Rexmy/Phoc + Add_AR/Phoc ; %% [gP/m^2 d] + %%%% + if (Pcons) > Preserve/dtd + f_red = (Preserve/dtd)/Pcons; %%% [-] + else + f_red = 1; + end + AddRA=(1-f_red)*NPP;% Additional Respiration [gC /m^2 d] + NPP=f_red*NPP; + WResp = WResp + AddRA; %% [gC /m^2 d] + %%%%% + %%%% POTASSIUM + Kcons= fl*(NPP)/Kpotl+ ff*(NPP)/Kpotf + fc*(NPP)/Kpotc + fr*(NPP)/Kpotr + fs*(NPP)/Kpots + Tr_l/Kpotl + Tr_r/Kpotr - Tr./Kpotc ... + - Sll*ftransL/Kpotl - Sr*ftransR/Kpotr -Rexmy/Kpotc + Add_AR/Kpotc + Ss/Kpoth -Ss./Kpots ; %% [gK/m^2 d] + %%%% + if (Kcons) > Kreserve/dtd + f_red = (Kreserve/dtd)/Kcons; %%% [-] + else + f_red = 1; + end + AddRA=(1-f_red)*NPP;% Additional Respiration [gC /m^2 d] + NPP=f_red*NPP; + WResp = WResp + AddRA; %% [gC /m^2 d] + %%%%% +else + WResp = 0; %% [gC /m^2 d] +end +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%%% Stop translocation if completely nutrient deprived +if Nreserve == 0 || Preserve ==0 || Kreserve == 0 +Tr = 0; Tr_r = 0; Tr_l = 0; +end +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +if NPP > 0 + dB(1)= fl*(NPP) - Sll + Tr_l; %%% Bl Green aboveground -- Leaves / Grass + dB(2)= fs*(NPP) - Ss; %%% Bs Living - Stem -Sapwood + dB(3)= fr*(NPP) - Sr + Tr_r; %% Br Living Root - Fine Root + dB(4)= fc*(NPP) + Add_AR - Tr - Rexmy; %% Bc Carobhydrate Reserve + dB(5) = ff*(NPP)- Mf*B(5) ; %% Fruit and Flower + dB(6) = Ss - Wm*B(6) ;%; Heartwood + dB(7) = Sll - Slf; %%Leaves - Grass -- Standing Dead + dB(8)= WResp; + %%%%%%%%%%%%%%%%%%%%%%%%% +else + %%% dB [gC/m^2 d] + if (fl*(GPP-Rg) < 1.0368*Rdark) && ((PHE_S == 2) || (PHE_S == 3)) + fl = 1 ; + fs = 0; fr = 0; fc = 0; ff = 0; + %%%%%%%%% + Tr_l = 1.0368*Rdark - fl*(GPP-Rg); + Tr_l = min(Tr_l,B(4)); + Tr = Tr_l ; + end + %if fr*(GPP-Rg) < Rmr && ((PHE_S == 2) || (PHE_S == 3)) + % Tr_r = Rmr - fr*(GPP-Rg); + % Tr_r = max(0,min(Tr_r,B(4)-Tr_l)); + % Tr = Tr+Tr_r; + %end + %%%%%%%%%%%%%%% + %%%%%%%%%%%%%%% + dB(1)= fl*(GPP-Rg-WResp) - 1.0368*Rdark - Sll + Tr_l; %%% Bl Green aboveground -- Leaves / Grass + dB(2)= fs*(GPP-Rg-WResp) -Rms -Ss ; %%% Bs Living - Stem -Sapwood + dB(3)= fr*(GPP-Rg-WResp) -Rmr -Sr + Tr_r; %% Br Living Root - Fine Root + dB(4)= fc*(GPP-Rg-WResp) -Rmc -Tr -Rexmy ; %% Bc Carobhydrate Reserve + dB(5) = ff*(GPP-Rg-WResp)- Mf*B(5) ; %% Fruit and Flower + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + dB(6) = Ss - Wm*B(6) ;%+ Rms +Rmc + Rmr; Heartwood + dB(7) = Sll - Slf; %%Leaves - Grass -- Standing Dead + dB(8) = WResp; +end +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +dB=dB'; +end \ No newline at end of file diff --git a/src/biochemical.m b/src/biochemical.m new file mode 100644 index 00000000..18b3e3cd --- /dev/null +++ b/src/biochemical.m @@ -0,0 +1,609 @@ +function biochem_out = biochemical(biochem_in,Ci_input) +% +global sfactor +if isnan(sfactor) + sfactor=1; +end +% Date: 21 Sep 2012 +% Update: 20 Feb 2013 +% Update: Aug 2013: correction of L171: Ci = Ci*1e6 ./ p .* 1E3; +% Update: 2016-10 - (JAK) major rewrite to accomodate an iterative solution to the Ball-Berry equation +% - also allows for g_m to be specified for C3 plants, but only if Ci_input is provided. +% Authors: Joe Berry and Christiaan van der Tol, Ari Kornfeld, contributions of others. +% Sources: +% Farquhar et al. 1980, Collatz et al (1991, 1992). +% +% This function calculates: +% - stomatal resistance of a leaf or needle (s m-1) +% - photosynthesis of a leaf or needle (umol m-2 s-1) +% - fluorescence of a leaf or needle (fraction of fluor. in the dark) +% +% Usage: +% biochem_out = biochemical(biochem_in) +% the function was tested for Matlab R2013b +% +% Calculates net assimilation rate A, fluorescence F using biochemical model +% +% Input (units are important): +% structure 'biochem_in' with the following elements: +% Knparams % [], [], [] parameters for empirical Kn (NPQ) model: Kn = Kno * (1+beta).*x.^alpha./(beta + x.^alpha); +% [Kno, Kn_alpha, Kn_beta] +% or, better, as individual fields: +% Kno Kno - the maximum Kn value ("high light") +% Kn_alpha, Kn_beta alpha, beta: curvature parameters +% +% Cs % [ppmV or umol mol] initial estimate of conc. of CO2 in the +% ...bounary layer of the leaf +% Q % [umol photons m-2 s-1]net radiation, PAR +% fPAR % [0-1] fraction of incident light that is absorbed by the leaf (default = 1, for compatibility) +% T % [oC or K] leaf temperature +% eb % [hPa = mbar] intial estimate of the vapour pressure in leaf boundary layer +% O % [mmol/mol] concentration of O2 (in the boundary +% ...layer, but no problem to use ambient) +% p % [hPa] air pressure +% Vcmax25 (Vcmo) % [umol/m2/s] maximum carboxylation capacity @ 25 degC +% BallBerrySlope (m) % [] Ball-Berry coefficient 'm' for stomatal regulation +% BallBerry0 % [] (OPTIONAL) Ball-Berry intercept term 'b' (if present, an iterative solution is used) +% setting this to zeo disables iteration. Default = 0.01 +% +% Type % ['C3', 'C4'] text parameter, either 'C3' for C3 or any +% ...other text for C4 +% tempcor % [0, 1] boolean (0 or 1) whether or not +% ...temperature correction to Vcmax has to be applied. +% Tparams % [],[],[K],[K],[K] vector of 5 temperature correction parameters, look in spreadsheet of PFTs. +% Only if tempcor=1, otherwise use dummy values +% ...Or replace w/ individual values: +% slti [] slope of cold temperature decline (C4 only) +% shti [] slope of high temperature decline in photosynthesis +% Thl [K] T below which C4 photosynthesis is <= half that predicted by Q10 +% Thh [K] T above which photosynthesis is <= half that predicted by Q10 +% Trdm [K] T at which respiration is <= half that predicted by Q10 + +% effcon [mol CO2/mol e-] number of CO2 per electrons - typically 1/5 for C3 and 1/6 for C4 + +% RdPerVcmax25 (Rdparam) % [] respiration as fraction of Vcmax25 +% stressfactor [0-1] stress factor to reduce Vcmax (for +% example soil moisture, leaf age). Use 1 to "disable" (1 = no stress) +% OPTIONAL +% Kpep25 (kp) % [umol/m2/s] PEPcase activity at 25 deg C (defaults to Vcmax/56 +% atheta % [0-1] smoothing parameter for transition between Vc and Ve (light- and carboxylation-limited photosynthesis) +% useTLforC3 % boolean whether to enable low-temperature attenuation of Vcmax in C3 plants (its always on for C4 plants) +% po0 % double Kp,0 (Kp,max) = Fv/Fm (for curve fitting) +% g_m % mol/m2/s/bar Mesophyll conductance (default: Infinity, i.e. no effect of g_m) + +% Note: always use the prescribed units. Temperature can be either oC or K +% Note: input can be single numbers, vectors, or n-dimensional +% matrices +% +% Output: +% structure 'biochem_out' with the following elements: +% A % [umol/m2/s] net assimilation rate of the leaves +% Cs % [umol/m3] CO2 concentration in the boundary layer +% eta0 % [] fluorescence as fraction of dark +% ...adapted (fs/fo) +% rcw % [s m-1] stomatal resistance +% qE % [] non photochemical quenching +% fs % [] fluorescence as fraction of PAR +% Ci % [umol/m3] internal CO2 concentration +% Kn % [] rate constant for excess heat +% fo % [] dark adapted fluorescence (fraction of aPAR) +% fm % [] light saturated fluorescence (fraction of aPAR) +% qQ % [] photochemical quenching +% Vcmax % [umol/m2/s] carboxylation capacity after +% ... temperature correction + +if nargin < 2 + Ci_input = []; +end +%% input + % environmental +if isfield(biochem_in, 'Cs') +% assert(all(biochem_in.Cs(:) >=0), 'Negative CO2 (Cs) is not allowed!'); + Cs = max(0, biochem_in.Cs); % just make sure we don't deal with illegal values +else + % if Cs is missing, Ci must have been supplied. Forcing Cs = NaN invalidates rcw & gs. + Cs = NaN; %biochem_in.Ci; +end +Q = biochem_in.Q; +assert(all(Q(:) >=0), 'Negative light is not allowed!'); +assert(all(isreal(Q(:))), 'Complex-values are not allowed for PAR!'); + +assert(all(Cs(:) >=0), 'Negative CO2 concentration is not allowed!'); +assert(all(isreal(Cs(:))), 'Complex-values are not allowed for CO2 concentration!'); + +T = biochem_in.T + 273.15*(biochem_in.T<200); % convert temperatures to K if not already +eb = biochem_in.eb; +O = biochem_in.O; +p = biochem_in.p; + + % physiological +Type = biochem_in.Type; +if isfield(biochem_in, 'Vcmax25') + % new field names + Vcmax25 = biochem_in.Vcmax25; + BallBerrySlope = 9; + if isfield(biochem_in, 'BallBerrySlope') % with g_m and Ci specified, we don't pass BBslope + BallBerrySlope = biochem_in.BallBerrySlope; + end + RdPerVcmax25 = biochem_in.RdPerVcmax25; +else + % old field names: Vcmo, m, Rdparam + Vcmax25 = biochem_in.Vcmo; + BallBerrySlope = biochem_in.m; + RdPerVcmax25 = biochem_in.Rdparam; +end +BallBerry0 = 0.01; % default value +if isfield(biochem_in, 'BallBerry0') + BallBerry0 = biochem_in.BallBerry0; +end +if isfield(biochem_in, 'effcon') + effcon = biochem_in.effcon; +elseif strcmpi('C3', Type) + effcon = 1/5; +else + effcon = 1/6; % C4 +end + +% Mesophyll conductance: by default we ignore its effect +% so Cc = Ci - A/gm = Ci +g_m = Inf; +if isfield(biochem_in, 'g_m') + g_m = biochem_in.g_m * 1e6; % convert from mol to umol +end + +% SCOPE provides PAR as APAR, so default (for SCOPE) = 1 +% The curve-fitting GUI may not be providing APAR and should therefore explicitly set fPAR +fPAR = 1; % fraction of incident light that is absorbed by the leaf +if isfield(biochem_in, 'fPAR') + fPAR = biochem_in.fPAR; +end + + % physiological options +tempcor = biochem_in.tempcor; +stressfactor = biochem_in.stressfactor; +%model_choice = biochem_in.Fluorescence_model; +if isfield(biochem_in, 'useTLforC3') + useTLforC3 = biochem_in.useTLforC3; +else + useTLforC3 = false; +end + + % fluoeresence +if isfield(biochem_in, 'Knparams') + Knparams = biochem_in.Knparams; +elseif isfield( biochem_in, 'Kn0') + Knparams = [biochem_in.Kn0, biochem_in.Kn_alpha, biochem_in.Kn_beta]; +elseif isfield(biochem_in, 'Fluorescence_model') && biochem_in.Fluorescence_model==0 + % default drought values: + Knparams = [5.01, 1.93, 10]; +else + % default general values (cotton dataset) + Knparams = [2.48, 2.83, 0.114]; +end + +if isfield(biochem_in, 'po0') + po0 = biochem_in.po0; +else + po0 = []; +end + +% physiological temperature parameters: temperature sensitivities of Vcmax, etc +if isfield(biochem_in, 'Tparams') + Tparams = biochem_in.Tparams; + slti = Tparams(1); + shti = Tparams(2); + Thl = Tparams(3); + Thh = Tparams(4); + Trdm = Tparams(5); +else + slti = biochem_in.slti; + shti = biochem_in.shti; + Thl = biochem_in.Thl; + Thh = biochem_in.Thh; + Trdm = biochem_in.Trdm; +end + +% NOTE: kpep (kp), atheta parameters in next section + +%% parameters (at optimum temperature) +Tref = 25+273.15; % [K] absolute temperature at 25 oC + +Kc25 = 350; % [ubar] kinetic coefficient (Km) for CO2 (Von Caemmerer and Furbank, 1999) +Ko25 = 450; % [mbar] kinetic coeeficient (Km) for O2 (Von Caemmerer and Furbank, 1999) +spfy25 = 2600; % specificity (tau in Collatz e.a. 1991) + % This is, in theory, Vcmax/Vomax.*Ko./Kc, but used as a separate parameter + +Kpep25 = (Vcmax25/56)*1E6; % [] (C4) PEPcase rate constant for CO2, used here: Collatz et al: Vcmax25 = 39 umol m-1 s-1; kp = 0.7 mol m-1 s-1. +if isfield(biochem_in,'Kpep25') + Kpep25 = biochem_in.kpep; +elseif isfield(biochem_in,'kp') + Kpep25 = biochem_in.kp; +end +if isfield(biochem_in,'atheta') + atheta = biochem_in.atheta; +else + atheta = 0.8; +end + + % electron transport and fluorescence +Kf = 0.05; % [] rate constant for fluorescence +%Kd = 0.95; % [] rate constant for thermal deactivation at Fm +Kd = max(0.8738, 0.0301*(T-273.15)+ 0.0773); +Kp = 4.0; % [] rate constant for photochemisty + +% note: rhoa/Mair = L/mol (with the current units) = 24.039 L/mol +% and V/n = RT/P ==> T = 292.95 K @ 1 atm (using R_hPa = 83.144621; 1 atm = 1013.25 hPa) +% ??!! These values are used only for rcw, however. +rhoa = 1.2047; % [kg m-3] specific mass of air +Mair = 28.96; % [g mol-1] molecular mass of dry air + + +%% convert all to bar: CO2 was supplied in ppm, O2 in permil, and pressure in mBar +ppm2bar = 1e-6 .* (p .*1E-3); +Cs = Cs .* ppm2bar; +O = (O * 1e-3) .* (p .*1E-3) .* strcmp('C3',Type); % force O to be zero for C4 vegetation (this is a trick to prevent oxygenase) +Kc25 = Kc25 * 1e-6; +Ko25 = Ko25 * 1e-3; + +%% temperature corrections +qt = 0.1 * (T-Tref) * tempcor; % tempcorr = 0 or 1: this line dis/enables all Q10 operations +TH = 1 + tempcor* exp(shti .* (T -Thh)); +%TH = 1 + tempcor* exp((-220E3+703*T)./(8.314*T)); +TL = 1 + tempcor* exp(slti .* (Thl -T)); + +QTVc = 2.1; % Q10 base for Vcmax and Kc +Kc = Kc25 * exp(log(2.1).*qt); +Ko = Ko25 * exp(log(1.2).*qt); +kpepcase = Kpep25.* exp(log(1.8).*qt); % "pseudo first order rate constant for PEP carboxylase WRT pi (Collatz e.a. 1992) + + +% jak 2014-12-04: Add TL for C3 as well, works much better with our cotton temperature dataset (A-T) +if strcmpi(Type, 'C3') && ~useTLforC3 + Vcmax = Vcmax25 .* exp(log(QTVc).*qt) ./TH * sfactor; +else + Vcmax = Vcmax25 .* exp(log(QTVc).*qt) ./(TL.*TH) * sfactor; +end + +% specificity (tau in Collatz e.a. 1991) +spfy = spfy25 * exp(log(0.75).*qt); + +% "Dark" Respiration +Rd = RdPerVcmax25 * Vcmax25 .* exp(log(1.8).*qt) ./(1+exp(1.3*(T-Trdm))); + +%% calculation of potential electron transport rate +if isempty(po0) % JAK 2015-12: User can specify po0 from measured data + po0 = Kp./(Kf+Kd+Kp); % maximum dark photochemistry fraction, i.e. Kn = 0 (Genty et al., 1989) +end +Je = 0.5*po0 .* Q .* fPAR; % potential electron transport rate (JAK: add fPAR) + +%% calculation of the intersection of enzyme and light limited curves +% this is the original Farquhar model +Gamma_star = 0.5 .*O ./spfy; %[bar] compensation point in absence of Rd (i.e. gamma*) [bar] + +% Don't bother with... +% Gamma: CO2 compensation point including Rd: solve Ci for 0 = An = Vc - Rd, +% assuming Vc dominates at CO2 compensation point according to Farquar 1980. (from Leuning 1990) +% This gives a realistic value for C4 as well (in which O and Gamma_star = 0) +%Gamma = (Gamma_star .* Vcmax + Rd .* MM_consts) ./ (Vcmax - Rd); % C3 +if strcmp(Type, 'C3') + MM_consts = (Kc .* (1+O./Ko)); % Michaelis-Menten constants + Vs_C3 = (Vcmax25/2) .* exp(log(1.8).*qt); + % minimum Ci (as fraction of Cs) for BallBerry Ci. (If Ci_input is present we need this only as a placeholder for the function call) + minCi = 0.3; +else + % C4 + MM_consts = 0; % just for formality, so MM_consts is initialized + Vs_C3 = 0; % the same + minCi = 0.1; % C4 +end + + +%% calculation of Ci (internal CO2 concentration) +RH = min(1, eb./equations.satvap(T-273.15) ); % jak: don't allow "supersaturated" air! (esp. on T curves) +warnings = []; + +fcount = 0; % the number of times we called computeA() +if ~isempty(Ci_input) + Ci = Ci_input; % in units of bar. + if any(Ci_input > 1) + % assume Ci_input is in units of ppm. Convert to bar + Ci = Ci_input .* ppm2bar; + end + A = computeA(Ci); + +elseif all(BallBerry0 == 0) + % b = 0: no need to iterate: + Ci = BallBerry(Cs, RH, [], BallBerrySlope, BallBerry0, minCi); + A = computeA(Ci); + +else + % compute Ci using iteration (JAK) + % it would be nice to use a built-in root-seeking function but fzero requires scalar inputs and outputs, + % Here I use a fully vectorized method based on Brent's method (like fzero) with some optimizations. + tol = 1e-7; % 0.1 ppm more-or-less + % Setting the "corner" argument to Gamma may be useful for low Ci cases, but not very useful for atmospheric CO2, so it's ignored. + % (fn, x0, corner, tolerance) + Ci = equations.fixedp_brent_ari(@(x) Ci_next(x, Cs, RH, minCi), Cs, [], tol); % [] in place of Gamma: it didn't make much difference + %NOTE: A is computed in Ci_next on the final returned Ci. fixedp_brent_ari() guarantees that it was done on the returned values. + %A = computeA(Ci); +end + +%% Test-function for iteration +% (note that it assigns A in the function's context.) +% As with the next section, this code can be read as if the function body executed at this point. +% (if iteration was used). In other words, A is assigned at this point in the file (when iterating). + function [err, Ci_out] = Ci_next(Ci_in, Cs, RH, minCi) + % compute the difference between "guessed" Ci (Ci_in) and Ci computed using BB after computing A + A = computeA(Ci_in); + A_bar = A .* ppm2bar; + Ci_out = BallBerry(Cs, RH, A_bar, BallBerrySlope, BallBerry0, minCi); %[Ci_out, gs] + + err = Ci_out - Ci_in; % f(x) - x + end + +%% Compute Assimilation. +% Note: even though computeA() is written as a separate function, +% the code is, in fact, executed exactly this point in the file (i.e. between the previous if clause and the next section + function [A, biochem_out] = computeA(Ci) + % global: Type, Vcmax, Gamma_star, MM_consts, Vs_C3, effcon, Je, atheta, Rd %Kc, O, Ko, Vcmax25, qt + + if strcmpi('C3', Type) + %[Ci, gs] = BallBerry(Cs, RH, A_bar, BallBerrySlope, BallBerry0, 0.3, Ci_input); + %effcon = 0.2; + % without g_m: + Vs = Vs_C3; % = (Vcmax25/2) .* exp(log(1.8).*qt); % doesn't change on iteration. + if any(g_m < Inf) + % with g_m: + Vc = sel_root( 1./g_m, -(MM_consts + Ci +(Rd + Vcmax)./g_m), Vcmax.*(Ci - Gamma_star + Rd./g_m), -1); + Ve = sel_root( 1./g_m, -(Ci + 2*Gamma_star +(Rd + Je .* effcon)./g_m), Je .* effcon.*(Ci - Gamma_star + Rd./g_m), -1); + CO2_per_electron = Ve ./ Je; + else + Vc = Vcmax.*(Ci-Gamma_star)./(MM_consts + Ci); % MM_consts = (Kc .* (1+O./Ko)) % doesn't change on iteration. + CO2_per_electron = (Ci-Gamma_star)./(Ci+2*Gamma_star) .* effcon; + Ve = Je .* CO2_per_electron; + end + else %C4 + %[Ci, gs] = BallBerry(Cs, RH, A_bar, BallBerrySlope, BallBerry0, 0.1, Ci_input); + Vc = Vcmax; + Vs = kpepcase.*Ci; + %effcon = 0.17; % Berry and Farquhar (1978): 1/0.167 = 6 + CO2_per_electron = effcon; % note: (Ci-Gamma_star)./(Ci+2*Gamma_star) = 1 for C4 (since O = 0); this line avoids 0/0 when Ci = 0 + Ve = Je .* CO2_per_electron; + end + + % find the smoothed minimum of Ve, Vc = V, then V, Vs +% [a1,a2] = abc(atheta,-(Vc+Ve),Vc.*Ve); +% % select the min or max depending on the side of the CO2 compensation point +% % note that Vc, Ve < 0 when Ci < Gamma_star (as long as Q > 0; Q = 0 is also ok), +% % so the original construction selects the value closest to zero. +% V = min(a1,a2).*(Ci>Gamma_star) + max(a1,a2).*(Ci<=Gamma_star); +% [a1,a2] = abc(0.98,-(V+Vs),V.*Vs); +% Ag = min(a1,a2); + V = sel_root(atheta,-(Vc+Ve),Vc.*Ve, sign(-Vc) ); % i.e. sign(Gamma_star - Ci) + Ag = sel_root(0.98,-(V+Vs),V.*Vs, -1); + A = Ag - Rd; + + if nargout > 1 + biochem_out.A = A; + biochem_out.Ag = Ag; + biochem_out.Vc = Vc; + biochem_out.Vs = Vs; + biochem_out.Ve = Ve; + biochem_out.CO2_per_electron = CO2_per_electron; + end + fcount = fcount + 1; % # of times we called computeA + + end + +% (ppm2bar), A_bar +%tic; +%toc +%fprintf('Ball-Berry converged in %d steps (largest_diff = %.4g)\n', counter, largest_diff/ mean(ppm2bar)); +%% Compute A, etc. + +% note: the following sets a bunch of "global" values in the nested function. Prob better to use [A biochem_out] = .... +%A = computeA(Ci); % done above + % % For debugging: + % if any(A ~= computeA(Ci) & ~isnan(A)) + % error('My algorithm didn''t work!'); + % end +%[~, gs1] = BallBerry(Cs, RH, A .* ppm2bar, BallBerrySlope, BallBerry0, minCi, Ci); +gs = 1.6 * A .* ppm2bar ./ (Cs-Ci); + +Ja = Ag ./ CO2_per_electron; % actual electron transport rate + + % stomatal resistance +%old: rcw = 0.625*(Cs-Ci)./A *rhoa/Mair*1E3 ./ ppm2bar; % * 1e6 ./ p .* 1E3; +% if BallBerry0 == 0 %if B-B intercept was specified, then we computed gs "correctly" above and don't need this. +% rcw(A<=0 & rcw~=0) = 0.625*1E6; +% end +%rcw = (1./gs) *rhoa/Mair*1E3 ./ ppm2bar; % * 1e6 ./ p .* 1E3; +rcw = (rhoa./(Mair*1E-3))./gs; + +%% fluorescence (Replace this part by Magnani or other model if needed) +ps = po0.*Ja./Je; % this is the photochemical yield +nanPs = isnan(ps); +if any(nanPs) + if numel(po0) == 1 + ps(nanPs) = po0; + else + ps(nanPs) = po0(nanPs); % happens when Q = 0, so ps = po0 (other cases of NaN have been resolved) + end +end +ps_rel = max(0, 1-ps./po0); % degree of light saturation: 'x' (van der Tol e.a. 2014) + +[eta,qE,qQ,fs,fo,fm,fo0,fm0,Kn] = Fluorescencemodel(ps, ps_rel, Kp,Kf,Kd,Knparams); +Kpa = ps./fs*Kf; + +%% convert back to ppm +Cc = []; +if ~isempty(g_m) + Cc = (Ci - A/g_m) ./ ppm2bar; +end +Ci = Ci ./ ppm2bar; +%Cs = Cs ./ ppm2bar; + +%% Collect outputs + +biochem_out.A = A; +biochem_out.Ag = Ag; +biochem_out.Ci = Ci; +if ~isempty(Cc) + biochem_out.Cc = Cc; +end +biochem_out.rcw = rcw; +biochem_out.gs = gs; +% this would be the same if we apply the rcw(A<=0) cutoff: +%biochem_out.gs = BallBerrySlope.*A.*RH./Cs; % mol/m2/s no intercept term. +biochem_out.RH = RH; +biochem_out.warnings = warnings; +biochem_out.fcount = fcount; % the number of times we called computeA() +%fprintf('fcount = %d\n', fcount); + +biochem_out.Vcmax = Vcmax; +biochem_out.Vc = Vc; % export the components of A for diagnostic charts +biochem_out.Ve = Ve; +biochem_out.Vs = Vs; +biochem_out.Rd = Rd; + +biochem_out.Ja = Ja; +biochem_out.ps = ps; % photochemical yield +biochem_out.ps_rel = ps_rel; % degree of ETR saturation 'x' (van der Tol e.a. 2014) + + % fluoresence outputs: +% note on Kn: technically, NPQ = (Fm - Fm')/Fm' = Kn/(Kf + Kd); +% In this model Kf + Kd is close to but NOT equal to 1 @ 25C Kf + Kd = 0.8798 +% vdT 2013 fitted Kn assuming NPQ = Kn, but maybe we shouldn't? +biochem_out.Kd = Kd; % K_dark(T) +biochem_out.Kn = Kn; % K_n(x); x = 1 - ps/p00 == 1 - Ja/Je +biochem_out.NPQ = Kn ./ (Kf + Kd); % why not be honest! +biochem_out.Kf = Kf; % Kf = 0.05 (const) +biochem_out.Kp0 = Kp; % Kp = 4.0 (const): Kp, max +biochem_out.Kp = Kpa; % Kp,actual +biochem_out.eta = eta; +biochem_out.qE = qE; +biochem_out.fs = fs; % keep this for compatibility with SCOPE +biochem_out.ft = fs; % keep this for the GUI ft is a synonym for what we're calling fs +biochem_out.SIF = fs .* Q; +biochem_out.fo0 = fo0; +biochem_out.fm0 = fm0; +biochem_out.fo = fo; +biochem_out.fm = fm; +biochem_out.Fm_Fo = fm ./ fo; % parameters used for curve fitting +biochem_out.Ft_Fo = fs ./ fo; % parameters used for curve fitting +biochem_out.qQ = qQ; +return; + +end % end of function biochemical + + +%% quadratic formula, root of least magnitude +function x = sel_root(a,b,c, dsign) +% sel_root - select a root based on the fourth arg (dsign = discriminant sign) +% for the eqn ax^2 + bx + c, +% if dsign is: +% -1, 0: choose the smaller root +% +1: choose the larger root +% NOTE: technically, we should check a, but in biochemical, a is always > 0 + if a == 0 % note: this works because 'a' is a scalar parameter! + x = -c./b; + else + if any(dsign == 0) + dsign(dsign == 0) = -1; % technically, dsign==0 iff b = c = 0, so this isn't strictly necessary except, possibly for ill-formed cases) + end + %disc_root = sqrt(b.^2 - 4.*a.*c); % square root of the discriminant (doesn't need a separate line anymore) + % in MATLAB (2013b) assigning the intermediate variable actually slows down the code! (~25%) + x = (-b + dsign.* sqrt(b.^2 - 4.*a.*c))./(2.*a); + end +end %of min_root of quadratic formula + + +%% Ball Berry Model +function [Ci, gs] = BallBerry(Cs, RH, A, BallBerrySlope, BallBerry0, minCi, Ci_input) +% Cs : CO2 at leaf surface +% RH : relative humidity +% A : Net assimilation in 'same units of CO2 as Cs'/m2/s +% BallBerrySlope, BallBerry0, +% minCi : minimum Ci as a fraction of Cs (in case RH is very low?) +% Ci_input : will calculate gs if A is specified. +if nargin > 6 && ~isempty(Ci_input) + % Ci is given: try and compute gs + Ci = Ci_input; + gs = []; + if ~isempty(A) && nargout > 1 + gs = gsFun(Cs, RH, A, BallBerrySlope, BallBerry0); + end +elseif all(BallBerry0 == 0) || isempty(A) + % EXPLANATION: *at equilibrium* CO2_in = CO2_out => A = gs(Cs - Ci) [1] + % so Ci = Cs - A/gs (at equilibrium) [2] + % Ball-Berry suggest: gs = m (A RH)/Cs + b (also at equilib., see Leuning 1990) + % if b = 0 we can rearrange B-B for the second term in [2]: A/gs = Cs/(m RH) + % Substituting into [2] + % Ci = Cs - Cs/(m RH) = Cs ( 1- 1/(m RH) [ the 1.6 converts from CO2- to H2O-diffusion ] + Ci = max(minCi .* Cs, Cs.*(1-1.6./(BallBerrySlope .* RH))); + gs = []; +else + % if b > 0 Ci = Cs( 1 - 1/(m RH + b Cs/A) ) + % if we use Leuning 1990, Ci = Cs - (Cs - Gamma)/(m RH + b(Cs - Gamma)/A) [see def of Gamma, above] + % note: the original B-B units are A: umol/m2/s, ci ppm (umol/mol), RH (unitless) + % Cs input was ppm but was multiplied by ppm2bar above, so multiply A by ppm2bar to put them on the same scale. + % don't let gs go below its minimum value (i.e. when A goes negative) + gs = gsFun(Cs, RH, A, BallBerrySlope, BallBerry0); + Ci = max(minCi .* Cs, Cs - 1.6 * A./gs) ; +end + +end % function + +function gs = gsFun(Cs, RH, A, BallBerrySlope, BallBerry0) +% add in a bit just to avoid div zero. 1 ppm = 1e-6 (note since A < 0 if Cs ==0, it gives a small gs rather than maximal gs +gs = max(BallBerry0, BallBerrySlope.* A .* RH ./ (Cs+1e-9) + BallBerry0); +% clean it up: +%gs( Cs == 0 ) = would need to be max gs here; % eliminate infinities +gs( isnan(Cs) ) = NaN; % max(NaN, X) = X (MATLAB 2013b) so fix it here +end + + +%% Fluorescence model +function [eta,qE,qQ,fs,fo,fm,fo0,fm0,Kn] = Fluorescencemodel(ps,x, Kp,Kf,Kd,Knparams) + % note: x isn't strictly needed as an input parameter but it avoids code-duplication (of po0) and it's inherent risks. + + Kno = Knparams(1); + alpha = Knparams(2); + beta = Knparams(3); + + % switch model_choice + % case 0, % drought + % Kno = 5.01; + % alpha = 1.93; + % beta = 10; + % %Kn = (6.2473 * x - 0.5944).*x; % empirical fit to Flexas' data + % %Kn = (3.9867 * x - 1.0589).*x; % empirical fit to Flexas, Daumard, Rascher, Berry data + % case 1, healthy (cotton) + % Kno = 2.48; + % alpha = 2.83; + % beta = 0.114; + % %p = [4.5531;8.5595;1.8510]; + % %Kn = p(1)./(p(3)+exp(-p(2)*(x-.5))); + % end + + % using exp(-beta) expands the interesting region between 0-1 + %beta = exp(-beta); + x_alpha = exp(log(x).*alpha); % this is the most expensive operation in this fn; doing it twice almost doubles the time spent here (MATLAB 2013b doesn't optimize the duplicate code) + Kn = Kno * (1+beta).* x_alpha./(beta + x_alpha); + + %Kn = Kn .* Kd/0.8738; % temperature correction of Kn similar to that of Kd + + fo0 = Kf./(Kf+Kp+Kd); % dark-adapted fluorescence yield Fo,0 + fo = Kf./(Kf+Kp+Kd+Kn); % light-adapted fluorescence yield in the dark Fo + fm = Kf./(Kf +Kd+Kn); % light-adapted fluorescence yield Fm + fm0 = Kf./(Kf +Kd); % dark-adapted fluorescence yield Fm + fs = fm.*(1-ps); % steady-state (light-adapted) yield Ft (aka Fs) + eta = fs./fo0; + qQ = 1-(fs-fo)./(fm-fo); % photochemical quenching + qE = 1-(fm-fo)./(fm0-fo0); % non-photochemical quenching + + %eta = eta*(1+5)/5 - 1/5; % this corrects for 29% PSI contribution in PAM data, but it is quick and dirty correction that needs to be improved in the next + +end + + diff --git a/src/biochemical_MD12.m b/src/biochemical_MD12.m new file mode 100644 index 00000000..5f6c785d --- /dev/null +++ b/src/biochemical_MD12.m @@ -0,0 +1,355 @@ +function biochem_out = biochemical_MD12(biochem_in) +global sfactor +if isnan(sfactor) + sfactor=1; +end +%[A,Ci,eta] = biochemical_VCM(Cs,Q,T,eb,O,p,Vcmo,m,Type,Rdparam,stress,Tyear,beta,qLs,NPQs) +% Date: 21 Sep 2012 +% Update: 28 Jun 2013 Adaptation for use of Farquhar model of C3 photosynthesis (Farquhar et al 1980) +% 18 Jul 2013 Inclusion of von Caemmerer model of C4 photosynthesis (von Caemmerer 2000, 2013) +% 15 Aug 2013 Modified computation of CO2-limited electron transport in C4 species for consistency with light-limited value +% 22 Oct 2013 Included effect of qLs on Jmax and electron transport; value of kNPQs re-scaled in input as NPQs +% +% Authors: Federico Magnani, with contributions from Christiaan van der Tol +% +% This function calculates: +% - CO2 concentration in intercellular spaces (umol/mol == ppmv) +% - leaf net photosynthesis (umol/m2/s) of C3 or C4 species +% - fluorescence yield of a leaf (fraction of reference fluorescence yield in dark-adapted and un-stressed leaf) +% +% Usage: +% function [A,Cs,eb,f,rcw] = biochemical(C,Cs,Q,T,ea,eb,O,p,Vcmo,gcparam,Type,tempcor,ra,Tparams,Rdparam,stressfactor,Tyear,beta,qLs,NPQs) +% the function was tested for Matlab 7.2.0.232 (R2006a) +% +% Input (units are important; when not otherwise specified, mol refers to mol C): +% Cs % [umol/mol] CO2 concentration at leaf surface +% Q % [uE/m2/s] photochemically active radiation absorbed by the leaf +% T % [oC or K] leaf temperature +% eb % [hPa] vapour pressure in leaf boundary layer +% O % [mmol/mol] ambient O2 concentration +% p % [Pa] air pressure +% Vcmo % [umol/m2/s] maximum carboxylation capacity +% m % [mol/mol] Ball-Berry coefficient 'm' for stomatal regulation +% Type % [] text parameter, either 'C3' for C3 or any other text for C4 +% Rdparam % [mol/mol] respiration at reference temperature as fraction of Vcmax +% stress % [] optional input: stress factor to reduce Vcmax (for example soil moisture, leaf age). Default value = 1 (no stress). +% Tyear % [oC] mean annual temperature +% beta % [] fraction of photons partitioned to PSII (0.507 for C3, 0.4 for C4; Yin et al. 2006; Yin and Struik 2012) +% qLs % [] fraction of functional reaction centres (Porcar-Castell 2011) +% NPQs % [s-1] rate constant of sustained thermal dissipation, normalized to (kf+kD) (=kNPQs'; Porcar-Castell 2011) +% +% Note: always use the prescribed units. Temperature can be either oC or K +% Note: input can be single numbers, vectors, or n-dimensional matrices +% Note: For consistency reasons, in C4 photosynthesis electron transport rates under CO2-limited conditions are computed by inverting the equation +% applied for light-limited conditions(Ubierna et al 2013). A discontinuity would result when computing J from ATP requirements of Vp and Vco, as a +% fixed electron transport partitioning is assumed for light-limited conditions + +% +% Output: +% A % [umol/m2/s] net assimilation rate of the leaves +% Ci % [umol/mol] CO2 concentration in intercellular spaces (assumed to be the same as at carboxylation sites in C3 species) +% eta % [] amplification factor to be applied to PSII fluorescence yield spectrum +% relative to the dark-adapted, un-stressed yield calculated with either Fluspect or FluorMODleaf + +%--------------------------------------------------------------------------------------------------------- +%% Start +p=biochem_in.p.*1e2; +m=biochem_in.m; +O=biochem_in.O; +Type=biochem_in.Type; +Tyear=biochem_in.Tyear; +beta=biochem_in.beta; +qLs=biochem_in.qLs; +NPQs=biochem_in.NPQs; +stress=sfactor; +Cs=biochem_in.Cs; +Q=biochem_in.Q; +T=biochem_in.T; +eb=biochem_in.eb; +Vcmo=biochem_in.Vcmo; +Rdparam=biochem_in.Rdparam; +%% Global and site-specific constants +R = 8.31; % [J/K/mol] universal gas constant + +%--------------------------------------------------------------------------------------------------------- +%% Unit conversion and computation of environmental variables +T = T+273.15*(T<100); % [K] convert temperatures to K if not already +RH = eb./equations.satvap(T-273.15); % [] relative humidity (decimal) +Cs = Cs .* p .*1E-11; % [bar] 1E-6 to convert from ppm to fraction, 1E-5 to convert from Pa to bar +O = O .* p .*1E-08; % [bar] 1E-3 to convert from mmol/mol to fraction, 1E-5 to convert from Pa to bar + +%--------------------------------------------------------------------------------------------------------- +%% Define photosynthetic parameters (at reference temperature) +SCOOP = 2862.; % [mol/mol] Relative Rubisco specificity for CO2 vs O2 at ref temp (Cousins et al. 2010) +Rdopt = Rdparam * Vcmo; % [umol/m2/s] dark respiration at ref temperature from correlation with Vcmo +switch Type + case 'C3' % C3 species + Jmo = Vcmo * 2.68; % [umol/m2/s] potential e-transport at ref temp from correlation with Vcmo (Leuning 1997) + otherwise % C4 species + Jmo = Vcmo * 40/6; % [umole-/m2/s] maximum electron transport rate (ratio as in von Caemmerer 2000) + Vpmo = Vcmo * 2.33; % [umol/m2/s] maximum PEP carboxylase activity (Yin et al. 2011) + Vpr = 80; % [umol/m2/s] PEP regeneration rate, constant (von Caemmerer 2000) + gbs = (0.0207*Vcmo+0.4806)*1000.; % [umol/m2/s] bundle sheath conductance to CO2 (Yin et al. 2011) + x = 0.4; % [] partitioning of electron transport to mesophyll (von Caemmerer 2013) + alpha = 0; % [] bundle sheath PSII activity (=0 in maize/sorghum; >=0.5 in other cases; von Caemmerer 2000) +end + +%--------------------------------------------------------------------------------------------------------- +%% Parameters for temperature corrections +TREF = 25+273.15; % [K] reference temperature for photosynthetic processes + +HARD = 46.39; % [kJ/mol] activation energy of Rd +CRD = 1000.*HARD/(R*TREF); % [] scaling factor in RD response to temperature + +HAGSTAR = 37.83; % [kJ/mol] activation energy of Gamma_star +CGSTAR = 1000.*HAGSTAR/(R*TREF); % [] scaling factor in GSTAR response to temperature + +switch Type + case 'C3' % C3 species + HAJ = 49.88; % [kJ/mol] activation energy of Jm (Kattge & Knorr 2007) + HDJ = 200; % [kJ/mol] deactivation energy of Jm (Kattge & Knorr 2007) + DELTASJ = (-0.75*Tyear+660)/1000; % [kJ/mol/K] entropy term for J (Kattge and Knorr 2007) + + HAVCM = 71.51; % [kJ/mol] activation energy of Vcm (Kattge and Knorr 2007) + HDVC = 200; % [kJ/mol] deactivation energy of Vcm (Kattge & Knorr 2007) + DELTASVC= (-1.07*Tyear+668)/1000; % [kJ/mol/K] entropy term for Vcmax (Kattge and Knorr 2007) + + KCOP = 404.9; % [umol/mol] Michaelis-Menten constant for CO2 at ref temp (Bernacchi et al 2001) + HAKC = 79.43; % [kJ/mol] activation energy of Kc (Bernacchi et al 2001) + + KOOP = 278.4; % [mmol/mol] Michaelis-Menten constant for O2 at ref temp (Bernacchi et al 2001) + HAKO = 36.38; % [kJ/mol] activation energy of Ko (Bernacchi et al 2001) + + otherwise % C4 species (values can be different as noted by von Caemmerer 2000) + HAJ = 77.9; % [kJ/mol] activation energy of Jm (Massad et al 2007) + HDJ = 191.9; % [kJ/mol] deactivation energy of Jm (Massad et al 2007) + DELTASJ = 0.627; % [kJ/mol/K] entropy term for Jm (Massad et al 2007). No data available on acclimation to temperature. + + HAVCM = 67.29; % [kJ/mol] activation energy of Vcm (Massad et al 2007) + HDVC = 144.57; % [kJ/mol] deactivation energy of Vcm (Massad et al 2007) + DELTASVC= 0.472; % [kJ/mol/K] entropy term for Vcm (Massad et al 2007). No data available on acclimation to temperature. + + HAVPM = 70.37; % [kJ/mol] activation energy of Vpm (Massad et al 2007) + HDVP = 117.93; % [kJ/mol] deactivation energy of Vpm (Massad et al 2007) + DELTASVP= 0.376; % [kJ/mol/K] entropy term for Vpm (Massad et al 2007). No data available on acclimation to temperature. + + KCOP = 944.; % [umol/mol] Michaelis-Menten constant for CO2 at ref temp (Chen et al 1994; Massad et al 2007) + Q10KC = 2.1; % [] Q10 for temperature response of Kc (Chen et al 1994; Massad et al 2007) + + KOOP = 633.; % [mmol/mol] Michaelis-Menten constant for O2 at ref temp (Chen et al 1994; Massad et al 2007) + Q10KO = 1.2; % [] Q10 for temperature response of Ko (Chen et al 1994; Massad et al 2007) + + KPOP = 82.; % [umol/mol] Michaelis-Menten constant of PEP carboxylase at ref temp (Chen et al 1994; Massad et al 2007) + Q10KP = 2.1; % [] Q10 for temperature response of Kp (Chen et al 1994; Massad et al 2007) + +end + + +%--------------------------------------------------------------------------------------------------------- +%% Corrections for effects of temperature and non-stomatal limitations +dum1 = R./1000.*T; % [kJ/mol] +dum2 = R./1000.*TREF; % [kJ/mol] + +Rd = Rdopt.*exp(CRD-HARD./dum1); % [umol/m2/s] mitochondrial respiration rates adjusted for temperature (Bernacchi et al. 2001) +SCO = SCOOP./exp(CGSTAR-HAGSTAR./dum1); % [] Rubisco specificity for CO2 adjusted for temperature (Bernacchi et al. 2001) + +Jmax = Jmo .* exp(HAJ.*(T-TREF)./(TREF*dum1)); +Jmax = Jmax.*(1.+exp((TREF*DELTASJ-HDJ)./dum2)); +Jmax = Jmax./(1.+exp((T.*DELTASJ-HDJ)./dum1)); % [umol e-/m2/s] max electron transport rate at leaf temperature (Kattge and Knorr 2007; Massad et al. 2007) + +Vcmax = Vcmo .* exp(HAVCM.*(T-TREF)./(TREF*dum1)); +Vcmax = Vcmax.*(1+exp((TREF*DELTASVC-HDVC)/dum2)); +Vcmax = Vcmax./(1+exp((T.*DELTASVC-HDVC)./dum1)); % [umol/m2/s] max carboxylation rate at leaf temperature (Kattge and Knorr 2007; Massad et al. 2007) + +switch Type + case 'C3' % C3 species + CKC = 1000.*HAKC/(R*TREF); % [] scaling factor in KC response to temperature + Kc = KCOP.*exp(CKC-HAKC./dum1).*1e-11.*p; % [bar] Michaelis constant of carboxylation adjusted for temperature (Bernacchi et al. 2001) + + CKO = 1000.*HAKO/(R*TREF); % [] scaling factor in KO response to temperature + Ko = KOOP.*exp(CKO-HAKO./dum1).*1e-8.*p; % [bar] Michaelis constant of oxygenation adjusted for temperature (Bernacchi et al. 2001) + + otherwise % C4 species + Vpmax = Vpmo .* exp(HAVPM.*(T-TREF)./(TREF*dum1)); + Vpmax = Vpmax.*(1+exp((TREF*DELTASVP-HDVP)/dum2)); + Vpmax = Vpmax./(1+exp((T.*DELTASVP-HDVP)./dum1));% [umol/m2/s] max carboxylation rate at leaf temperature (Massad et al. 2007) + + Kc = KCOP.*Q10KC .^ ((T-TREF)/10.)*1e-11*p; % [bar] Michaelis constant of carboxylation temperature corrected (Chen et al 1994; Massad et al 2007) + + Ko = KOOP.*Q10KO .^ ((T-TREF)/10.)*1e-8*p; % [bar] Michaelis constant of oxygenation temperature corrected (Chen et al 1994; Massad et al 2007) + + Kp = KPOP.*Q10KP .^ ((T-TREF)/10.)*1e-11*p; % [bar] Michaelis constant of PEP carboxyl temperature corrected (Chen et al 1994; Massad et al 2007) + +end + +%--------------------------------------------------------------------------------------------------------- +%% Define electron transport and fluorescence parameters +kf = 3.E7; % [s-1] rate constant for fluorescence +kD = 1.E8; % [s-1] rate constant for thermal deactivation at Fm +kd = 1.95E8; % [s-1] rate constant of energy dissipation in closed RCs (for theta=0.7 under un-stressed conditions) +po0max = 0.88; % [mol e-/E] maximum PSII quantum yield, dark-acclimated in the absence of stress (Pfundel 1998) +kPSII = (kD+kf) * po0max/(1.-po0max); % [s-1] rate constant for photochemisty (Genty et al. 1989) +fo0 = kf./(kf+kPSII+kD); % [E/E] reference dark-adapted PSII fluorescence yield under un-stressed conditions + +kps = kPSII * qLs; % [s-1] rate constant for photochemisty under stressed conditions (Porcar-Castell 2011) +kNPQs = NPQs * (kf+kD); % [s-1] rate constant of sustained thermal dissipation (Porcar-Castell 2011) +kds = kd * qLs; +kDs = kD + kNPQs; +Jms = Jmax * qLs; % [umol e-/m2/s] potential e-transport rate reduced for PSII photodamage +po0 = kps ./(kps+kf+kDs); % [mol e-/E] maximum PSII quantum yield, dark-acclimated in the presence of stress +THETA = (kps-kds)./(kps+kf+kDs); % [] convexity factor in J response to PAR + +%--------------------------------------------------------------------------------------------------------- +%% Calculation of electron transport rate +Q2 = beta * Q * po0; +J = (Q2+Jms-sqrt((Q2+Jms).^2-4*THETA.*Q2.*Jms))./(2*THETA); % [umol e-/m2/s] electron transport rate under light-limiting conditions + +%--------------------------------------------------------------------------------------------------------- +%% Calculation of net photosynthesis +switch Type + case 'C3' % C3 species, based on Farquhar model (Farquhar et al. 1980) + GSTAR = 0.5*O./SCO; % [bar] CO2 compensation point in the absence of mitochondrial respiration + Ci = max(GSTAR,Cs.*(1-1.6./(m.*RH*stress))); + % [bar] intercellular CO2 concentration from Ball-Berry model (Ball et al. 1987) + Cc = Ci; % [bar] CO2 concentration at carboxylation sites (neglecting mesophyll resistance) + + Wc = Vcmax .* Cc ./ (Cc + Kc .* (1+O./Ko)); % [umol/m2/s] RuBP-limited carboxylation + Wj = J.*Cc ./ (4.5*Cc + 10.5*GSTAR); % [umol/m2/s] electr transp-limited carboxyl + + W = min(Wc,Wj); % [umol/m2/s] carboxylation rate + Ag = (1 - GSTAR./Cc) .*W; % [umol/m2/s] gross photosynthesis rate + A = Ag - Rd; % [umol/m2/s] net photosynthesis rate + Ja = J.*W ./Wj; % [umole-/m2/s] actual linear electron transport rate + + otherwise % C4 species, based on von Caemmerer model (von Caemmerer 2000) + Ci = max(9.9e-6*(p*1e-5),Cs.*(1-1.6./(m.*RH*stress))); + % [bar] intercellular CO2 concentration from Ball-Berry model (Ball et al. 1987) + Cm = Ci; % [bar] mesophyll CO2 concentration (neglecting mesophyll resistance) + Rs = 0.5 .* Rd; % [umol/m2/s] bundle sheath mitochondrial respiration (von Caemmerer 2000) + Rm = Rs; % [umol/m2/s] mesophyll mitochondrial respiration + gam = 0.5./SCO; % [] half the reciprocal of Rubisco specificity for CO2 + + Vpc = Vpmax .* Cm./(Cm+Kp); % [umol/m2/s] PEP carboxylation rate under limiting CO2 (saturating PEP) + Vp = min(Vpc,Vpr); % [umol/m2/s] PEP carboxylation rate + + % Complete model proposed by von Caemmerer (2000) + dum1 = alpha/0.047; % dummy variables, to reduce computation time + dum2 = Kc./Ko; + dum3 = Vp-Rm+gbs.*Cm; + dum4 = Vcmax-Rd; + dum5 = gbs.*Kc.*(1+O./Ko); + dum6 = gam.*Vcmax; + dum7 = x*J./2. - Rm + gbs.*Cm; + dum8 = (1.-x).*J./3.; + dum9 = dum8 - Rd; + dum10 = dum8 + Rd * 7/3; + + a = 1. - dum1 .* dum2; + b = -(dum3+dum4+dum5+dum1.*(dum6+Rd.*dum2)); + c = dum4.*dum3-dum6.*gbs*O+Rd.*dum5; + Ac = (-b - sqrt(b.^2-4.*a.*c))./(2.*a); % [umol/m2/s] CO2-limited net photosynthesis + + a = 1.- 7./3.*gam.*dum1; + b = -(dum7+dum9 + gbs.*gam.*O.*7./3. + dum1.*gam.*dum10); + c = dum7.*dum9 - gbs.*gam.*O.*dum10; + Aj = (-b - sqrt(b.^2-4.*a.*c))./(2.*a); % [umol/m2/s] light-limited net photosynthesis (assuming that an obligatory Q cycle operates) + + A = min(Ac,Aj); % [umol/m2/s] net photosynthesis + + Ja = J; % [umole-/m2/s] actual electron transport rate, CO2-limited + + + if any(A==Ac) %IPL 03/09/2013 + ind=A==Ac; + a(ind) = x.*(1-x)./6./A(ind); + b(ind) = (1-x)/3.*(gbs(ind)./A(ind).*(Cm(ind)-Rm(ind)./gbs(ind)-gam(ind).*O)-1-alpha.*gam(ind)./0.047)-x./2.*(1.+Rd(ind)./A(ind)); + c(ind) = (1+Rd(ind)./A(ind)).*(Rm(ind)-gbs(ind).*Cm(ind)-7.*gbs(ind).*gam(ind).*O./3)+(Rd(ind)+A(ind)).*(1-7.*alpha.*gam(ind)./3./0.047); + Ja(ind) = (-b(ind) + sqrt(b(ind).^2-4.*a(ind).*c(ind)))./(2.*a(ind)); % [umole-/m2/s] actual electron transport rate, CO2-limited + + end + + % Simplified model (von Caemmerer 2000), should be chosen ONLY if computation times are excessive +% dum3 = Vp-Rm+gbs*Cm; +% dum4 = Vcmax-Rd; +% dum7 = x*J./2. - Rm + gbs*Cm; +% dum8 = (1.-x)*J./3.; +% dum9 = dum8 - Rd; +% +% Ac = min(dum3,dum4); % [umol/m2/s] light saturated CO2 assimilation rate +% Aj = min(dum7,dum9); % [umol/m2/s] light-limited CO2 assimilation rate +% +% A = min(Ac,Aj); % [umol/m2/s] net photosynthesis rate +% Ja = J .* A./ Aj; % [umole-/m2/s] actual electron transport rate (simple empirical formulation based on results) + +end + +%--------------------------------------------------------------------------------------------------------- +%% Calculation of PSII quantum yield and fluorescence +ps = Ja ./(beta.*Q); % [mol e-/E] PSII photochemical quantum yield +[fs] = MD12(ps,Ja,Jms,kps,kf,kds,kDs); % [E/E] PSII fluorescence yield +eta = fs./fo0; % [] scaled PSII fluorescence yield + +%% JP add +rhoa = 1.2047; % [kg m-3] specific mass of air +Mair = 28.96; % [g mol-1] molecular mass of dry air + +rcw = 0.625*(Cs-Ci)./A *rhoa/Mair*1E3 * 1e6 ./ p .* 1E5; +rcw(A<=0) = 0.625*1E6; + +%% convert back to ppm +Ci = Ci*1e6 ./ p .* 1E5; + +%% +biochem_out.A = A; +biochem_out.Ag = Ag; +biochem_out.Ci = Ci; +biochem_out.ps = ps; +biochem_out.eta = eta; +biochem_out.fs = fs; +biochem_out.rcw = rcw; +biochem_out.qE = rcw*NaN; % dummy output, to be consistent with SCOPE +return; +%%% end of function biochemical + + +%--------------------------------------------------------------------------------------------------------- +%% MD12 algorithm for the computation of fluorescence yield + +function [fs] = MD12(ps,Ja,Jms,kps,kf,kds,kDs) + +fs1 = ps .* (kf./kps) ./ (1. - Ja./Jms); % [E/E] PSII fluorescence yield under CO2-limited conditions + +par1 = kps./(kps-kds); % [E/E] empirical parameter in the relationship under light-limited conditions +par2 = par1.* (kf+kDs+kds)./kf; % [E/E] empirical parameter in the relationship under light-limited conditions +fs2 = (par1-ps)./par2; % [E/E] PSII fluorescence yield under light-limited conditions + +fs = min(fs1,fs2); % [E/E] PSII fluorescence yield + +% Sources: +% Ball J. T., I. E. Woodrow and J. A. Berry. (1987) A model predicting stomatal conductance and its contribution to the control of photosynthesis +% under different environmental conditions. In: Progress in Photosynthesis Research (Ed. J. Biggens), p. 221-224, The Netherlands:Martinus Nijhoff. +% Bernacchi C.J., E.L. Singsaas, C. Pimentel, A.R. Portis and S.P. Long (2001) Improved temperature response functions for models of Rubisco-limited +% photosynthesis. Plant Cell Envir 24:253-259. +% Bernacchi C.J., C. Pimentel and S.P. Long (2003) In vivo temperature response functions of parameters required to model RuBP-limited photosynthesis. +% Plant Cell Envir 26 (9):1419-1430. +% Chen D.X., M.B. Coughenour, A.K. Knapp, and C.E. Owensby (1994) Mathematical simulation of C4 grass photosynthesis in ambient and elevated CO2. +% Ecol.Model. 73:63-80, 1994. +% Cousins A.B., O. Ghannoum, S. von Caemmerer, and M.R. Badger (2010) Simultaneous determination of Rubisco carboxylase and oxygenase kinetic parameters +% in Triticum aestivum and Zea mays using membrane inlet mass spectrometry. Plant Cell Envir 33:444-452. +% Farquhar G.D., S. von Caemmerer and J.A. Berry (1980) A biochemical model of photosynthetic CO2 assimilation in leaves of C3 species. Planta 149:78-90. +% Genty B., J.-M. Briantais and N. R. Baker (1989) The relationship between quantum yield of photosynthetic electron transport and quenching of +% chlorophyll fluorescence. Biochimica et Biophysica Acta 990:87-92. +% Kattge J. and W. Knorr (2007) Temperature acclimation in a biochemical model of photosynthesis: a reanalysis of data from 36 species. +% Plant Cell Envir 30:1176-1190. +% Leuning R. (1997) Scaling to a common temperature improves the correlation between the photosynthesis parameters Jmax and Vcmax. +% J.Exp.Bot. 48 (307):345-347. +% Massad R.S., A. Tuzet and O. Bethenod (2007) The effect of temperature on C4-type leaf photosynthesis parameters. Plant Cell Envir 30:1191-1204. +% Pfundel E. (1998) Estimating the contribution of Photosystem I to total leaf chlorophyll fluorescence. Photosynthesis Research 56:185-195. +% Porcar-Castell A. (2011) A high-resolution portrait of the annual dynamics of photochemical and non-photochemical quenching in needles of Pinus sylvestris. +% Physiol.Plant. 143:139-153. +% von Caemmerer S. (2000) Biochemical Models of Leaf Photosynthesis, Canberra:CSIRO Publishing. +% von Caemmerer S. (2013) Steady-state models of photosynthesis. Plant Cell Envir, in press. +% Yin X., Z. Sun, P.C. Struik, P.E.L. van der Putten, W. van Ieperen and J. Harbinson (2011) Using a biochemical C4 photosynthesis model and combined +% gas exchange and chlorophyll fluorescence measurements to estimate bundle-sheath conductance of maize leaves differing in age and nitrogen content. +% Plant Cell Envir 34:2183-2199. +% diff --git a/src/calc_brdf.m b/src/calc_brdf.m new file mode 100644 index 00000000..3027669a --- /dev/null +++ b/src/calc_brdf.m @@ -0,0 +1,63 @@ +function directional = calc_brdf(options,directional,spectral,angles,rad,atmo,soil,leafopt,canopy,meteo,profiles,thermal) + +global constants + +%% input +tts = angles.tts; +noa = directional.noa; + +psi_hoversampling = [0 ; 0 ;0 ;0 ;0 ;2 ;358]; % [noa_o] angles for hotspot oversampling +tto_hoversampling = [tts ; tts+02;tts+04;tts-02;tts-4;tts;tts]; % [noa_o] angles for hotspot oversampling + +noah_o = size(tto_hoversampling,1); % [1] number of oversampling angles + +psi_poversampling = [000*ones(6,1);180*ones(6,1);090*ones(6,1);270*ones(6,1)];% angles for plane oversampling +tto_poversampling = [10:10:60 , 10:10:60 , 10:10:60 , 10:10:60]'; % angles for plane oversampling + +noap_o = size(tto_poversampling,1); % [1] number of oversampling angles + +directional.psi = [directional.psi;psi_hoversampling;psi_poversampling]; % [..] observer azimuth angle +directional.tto = [directional.tto;tto_hoversampling;tto_poversampling]; % [..] observer zenith angle + +%% allocate memory +directional.brdf_ = zeros(length(spectral.wlS),noa + noah_o+noap_o); % [nwlS, noa+noa_o+noap_o] +directional.Eoutte = zeros(1,noa + noah_o+noap_o); % [1, noa+noa_o+noap_o] +directional.BrightnessT = zeros(1,noa + noah_o+noap_o); % [1, noa+noa_o+noap_o] +directional.LoF_ = zeros(length(spectral.wlF),noa + noah_o+noap_o); % [nwlF, noa+noa_o+noap_o] +directional.Lot_ = zeros(length(spectral.wlT),noa + noah_o+noap_o); % [nwlF, noa+noa_o+noap_o] + +%% other preparations +directional_angles = angles; + +%% loop over the angles +for j=1:(noa+noah_o+noap_o) + + %optical BRDF + directional_angles.tto = directional.tto(j); + directional_angles.psi = directional.psi(j); + [directional_rad,directional_gap] = RTMo(spectral,atmo,soil,leafopt,canopy,directional_angles,meteo,rad,options); + directional.brdf_(:,j) = directional_rad.rso;%Lo_./E_tot; % [nwl] BRDF (spectral) (nm-1) + + % thermal directional brightness temperatures (Planck) + if options.calc_planck + directional_rad = RTMt_planck(spectral,directional_rad,... + soil,leafopt,canopy,directional_gap,directional_angles,... + thermal.Tcu,thermal.Tch,thermal.Ts(1),thermal.Ts(1),1); + directional.Lot_(:,j) = directional_rad.Lot_(spectral.IwlT); % [nwlt] emitted diffuse radiance at top + + else %thermal directional brightness temperatures (Stefan-Boltzmann) + directional_rad = RTMt_sb(spectral,directional_rad,... + soil,leafopt,canopy,directional_gap,directional_angles,thermal.Tcu,thermal.Tch,thermal.Ts(1),thermal.Ts(1),1); + directional.Lot(j) = directional_rad.Eoutte; + directional.BrightnessT(j) = (pi*rad.Lot/constants.sigmaSB)^0.25; + end + + if options.calc_fluor + directional_rad = RTMf(spectral,directional_rad,soil,leafopt,canopy,directional_gap,directional_angles,profiles); + directional.LoF_(:,j) = directional_rad.LoF_; + end % {if calcfluor} + if options.calc_xanthophyllabs + [directional_rad] = RTMz(spectral,directional_rad,soil,leafopt,canopy,directional_gap,directional_angles,profiles); + end + +end % {for wavelengths} diff --git a/src/calc_root_growth.m b/src/calc_root_growth.m new file mode 100644 index 00000000..032414ef --- /dev/null +++ b/src/calc_root_growth.m @@ -0,0 +1,16 @@ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% Subfunction - Root - growth % +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%%REFERENCES +function[GRL]=Root_growth(Actot) +%%% INPUTS +% BR = 10:1:650; %% [gC /m^2 PFT] +% rroot = 0.5*1e-3 ; % 3.3*1e-4 ;%% [0.5-6 *10^-3] [m] root radius +%%% OUTPUTS +root_den = 250*1000; %% [gDM / m^3] Root density Jackson et al., 1997 +R_C = 0.488; %% [gC/gDM] Ratio Carbon-Dry Matter in root Jackson et al., 1997 +GRLtot = Actot*0.3/R_C/root_den/(pi*(rroot^2)); %% %% root length index [m root / m^2 PFT] +end +% GRL=GRL*froot; froot is the allocate coefficience for each layer; +% RLD=RLD+GRL \ No newline at end of file diff --git a/src/calc_rsoil.m b/src/calc_rsoil.m new file mode 100644 index 00000000..824055c9 --- /dev/null +++ b/src/calc_rsoil.m @@ -0,0 +1,36 @@ +function [PSIs,rsss,rrr,rxx] = calc_rsoil(Rl,DeltZ,Ztot,Ks,Theta_s,Theta_r,Theta_LL,Theta_o,bbx) +DeltZ=DeltZ'; +n=1.5; +m=1-1/n; +l=0.5; +a=1.66; +SMC=Theta_LL(:,1); +Se = (SMC-Theta_r*Theta_o)./(Theta_s-Theta_r); +Ksoil=Ks*Se.^l.*(1-(1-Se.^(1./m).^m)).^2; +PSIs=-(Se.^(-1./m)-1).^(1/n)/a.*bbx; +rsss = 1./Ksoil./Rl./DeltZ/2/pi.*log((pi*Rl).^(-0.5)/(0.5*1e-3)).*bbx; % KL_h is the hydraulic conductivity, m s-1;VR is the root length density, m m-3;Ks is saturation conductivty; +rxx = 2*1e12*Ztot/0.5/0.22./Rl/100.*bbx; % Delta_z*j is the depth of the layer +rrr = 1.2*1e11*(Theta_s./SMC)./Rl./(DeltZ/100).*bbx; +%%% RADIAL --> Flow --> Krad*dP*row = [kg/m2 root s] or Krad*dP*row*RAI [kg/m2 ground s] +%Krad = 5*10^-8; %% % [1/s] %% radial conductivity root Amenu and Kumar 2008 +%Krad = 15*1e-8 ;%% [m /Pa s] radial conductivity root -- North, G.B., Peterson, C.A. (2005) in Vascular transport in plants, Water +%%% Krad = 10^-9 - 7*10^-7 ;%% [m /MPa s] radial conductivity root Mendel et a 2002 WRR, Huang and Nobel, 1994 +%Krad = 0.3 - 20 *10^-8 ;%% [m /MPa s] radial conductivity root Steudle and Peterson 1998 +%Krad = 5 - 13 *10^-8 ;%% [m /MPa s] radial conductivity root Bramley et al 2009 +%Krad = 2*10^-11 - 10^-9; %% % [1/s] %% radial conductivity Schneider et al 2010 +%Krad = 2*10^-9; %% % [1/s] %% Javaux et al 2010 +%Krad = 2*10^-7 -- 2*10^-5 [m /Mpa s] %% Draye et al 2010 +%Krad= 0.5--2*10^-7 [m /Mpa s] %% Doussan et al 2006 +%Krad= 10^-9--10^-7 [m /Mpa s] %% Doussan et al 1998 + +%%% AXIAL --> Flow = Kax/dL*dP*row ;; [kg / s] +% Kax/dL*dP*row/(rroot*dL) ;; [kg/m^2 root /s] +% Kax/dL*dP*row/(rroot*dL)*RAI ;; [kg/m^2 ground /s] +%%% Kax = 0.2 ; % mm2/s Root Axial % Amenu and Kumar 2008 +%%% Kax = 5*10^-11 - 4.2*10^-10 ;%% [m4 /MPa s] axial conductivity root Mendel et a 2002 WRR, +%%% Kax = 2-6*10^-9 ;%% [m3 /MPa s] Bramley et al 2009 +%%% Kax = 2*10^-12 - 5*10^-9 ;%% [m4 /MPa s] Pierret et al 2006 +%%% Kax = 1*10^-12 - 1*10^-9 ;%% [m3 / s] Schneider et al 2010 +%%%% Kax =5^10^-13-5*10^-12; %% % [m3 /s] %% Javaux et al 2010 +%Kax= 5*10^-11 -- 5*10^-9 [m4 /Mpa s] %% Draye et al 2010 +%Kax= 5*10^-11 -- 1*10^-8 [m4 /Mpa s] %% Doussan et al 2006 \ No newline at end of file diff --git a/src/calc_sfactor.m b/src/calc_sfactor.m new file mode 100644 index 00000000..1797fd46 --- /dev/null +++ b/src/calc_sfactor.m @@ -0,0 +1,13 @@ +function [sfactor] = calc_sfactor(Rl,Theta_s,Theta_r,Theta_LL,bbx,wfrac) +SMC=Theta_LL(:,1); % soil surface moisture +nn=numel(SMC); +for i=1:nn + wfrac(i)=1/(1+exp((-100*Theta_s)*(SMC(i)-(0.24+Theta_r)/2))); + end +wfrac=wfrac.*bbx; + +RL=Rl.*bbx; +RLfrac=RL./(sum(sum(RL))); +sfactor=sum(sum(RLfrac.*wfrac)); +end + diff --git a/src/ebal.m b/src/ebal.m new file mode 100644 index 00000000..0cbcdb42 --- /dev/null +++ b/src/ebal.m @@ -0,0 +1,525 @@ +function [iter,fluxes,rad,thermal,profiles,soil,RWU,frac] ... + = ebal(iter,options,spectral,rad,gap,leafopt, ... + angles,meteo,soil,canopy,leafbio,xyt,k,profiles,LR) + global Rl DeltZ Ztot Ks Theta_s Theta_r Theta_LL Theta_o bbx NL KT sfactor wfrac PSItot +% function ebal.m calculates the energy balance of a vegetated surface +% +% authors: Christiaan van der Tol (tol@itc.nl) +% Joris Timmermans (j_timmermans@itc.nl) +% date 26 Nov 2007 (CvdT) +% updates 29 Jan 2008 (JT & CvdT) converted into a function +% 11 Feb 2008 (JT & CvdT) improved soil heat flux and temperature calculation +% 14 Feb 2008 (JT) changed h in to hc (as h=Avogadro`s constant) +% 31 Jul 2008 (CvdT) Included Pntot in output +% 19 Sep 2008 (CvdT) Converted F0 and F1 from units per aPAR into units per iPAR +% 07 Nov 2008 (CvdT) Changed layout +% 18 Sep 2012 (CvdT) Changed Oc, Cc, ec +% Feb 2012 (WV) introduced structures for variables +% Sep 2013 (JV, CvT) introduced additional biochemical model +% +% parent: master.m (script) +% uses: +% RTMt_sb.m, RTMt_planck.m (optional), RTMf.m (optional) +% resistances.m +% heatfluxes.m +% biochemical.m +% soil_respiration.m +% +% Table of contents of the function +% +% 1. Initialisations for the iteration loop +% intial values are attributed to variables +% 2. Energy balance iteration loop +% iteration between thermal RTM and surface fluxes +% 3. Write warnings whenever the energy balance did not close +% 4. Calculate vertical profiles (optional) +% 5. Calculate spectrally integrated energy, water and CO2 fluxes +% +% The energy balance iteration loop works as follows: +% +% RTMo More or less the classic SAIL model for Radiative +% Transfer of sun and sky light (no emission by the vegetation) +% While continue Here an iteration loop starts to close the energy +% balance, i.e. to match the micro-meteorological model +% and the radiative transfer model +% RTMt_sb A numerical Radiative Transfer Model for thermal +% radiation emitted by the vegetation +% resistances Calculates aerodynamic and boundary layer resistances +% of vegetation and soil (the micro-meteorological model) +% biochemical Calculates photosynthesis, fluorescence and stomatal +% resistance of leaves (or biochemical_MD12: alternative) +% heatfluxes Calculates sensible and latent heat flux of soil and +% vegetation +% Next soil heat flux is calculated, the energy balance +% is evaluated, and soil and leaf temperatures adjusted +% to force energy balance closure +% end {while continue} +% +% meanleaf Integrates the fluxes over all leaf inclinations +% azimuth angles and layers, integrates over the spectrum +% +% usage: +%[iter,fluxes,rad,profiles,thermal] ... +% = ebal(iter,options,spectral,rad,gap,leafopt, ... +% angles,meteo,soil,canopy,leafbio) +% +% The input and output are structures. These structures are further +% specified in a readme file. +% +% Input: +% +% iter numerical parameters used in the iteration for energy balance closure +% options calculation options +% spectral spectral resolutions and wavelengths +% rad incident radiation +% gap probabilities of direct light penetration and viewing +% leafopt leaf optical properties +% angles viewing and observation angles +% soil soil properties +% canopy canopy properties +% leafbio leaf biochemical parameters +% +% Output: +% +% iter numerical parameters used in the iteration for energy balance closure +% fluxes energy balance, turbulent, and CO2 fluxes +% rad radiation spectra +% profiles vertical profiles of fluxes +% thermal temperatures, aerodynamic resistances and friction velocity + +%% 1. initialisations and other preparations for the iteration loop +% initialisations +global constants + +counter = 0; % Iteration counter of ebal +maxit = iter.maxit; +maxEBer = iter.maxEBer; +Wc = iter.Wc; + +CONT = 1; % is 0 when the calculation has finished + +t = xyt.t(k); +Ta = meteo.Ta; +ea = meteo.ea; +Ca = meteo.Ca; +Ts = soil.Ts; +p = meteo.p; +if options.soil_heat_method < 2 && options.simulation ==1 + if k>1 + Deltat = (t-xyt.t(k-1))*86400; % Duration of the time interval (s) + else + Deltat = 1/48*86400; + end + x = [1:12;1:12]'*Deltat; + Tsold = soil.Tsold; +end + +nl = canopy.nlayers; + +Rnuc = rad.Rnuc; +GAM = soil.GAM; +Tch = (Ta+.1)*ones(nl,1); % Leaf temperature (shaded leaves) +Tcu = (Ta+.3)*ones(size(Rnuc)); % Leaf tempeFrature (sunlit leaves) +ech = ea*ones(nl,1); % Leaf H2O (shaded leaves) +ecu = ea*ones(size(Rnuc)); % Leaf H2O (sunlit leaves) +Cch = Ca*ones(nl,1); % Leaf CO2 (shaded leaves) +Ccu = Ca*ones(size(Rnuc)); % Leaf CO2 (sunlit leaves) +%Tsold = Ts; % Soil temperature of the previous time step +L = -1; % Monin-Obukhov length + + +MH2O = constants.MH2O; +Mair = constants.Mair; +rhoa = constants.rhoa; +cp = constants.cp; +g = constants.g; +kappa = constants.kappa; +sigmaSB = constants.sigmaSB; +Ps = gap.Ps; +nl = canopy.nlayers; + +SoilHeatMethod = options.soil_heat_method; +if ~(options.simulation==1), SoilHeatMethod = 2; end + +kV = canopy.kV; +xl = canopy.xl; + +% other preparations +e_to_q = MH2O/Mair./p; % Conversion of vapour pressure [Pa] to absolute humidity [kg kg-1] +Fs = [1-Ps(end),Ps(end)]; % Matrix containing values for 1-Ps and Ps of soil +Fc = (1-Ps(1:end-1))'/nl; % Matrix containing values for Ps of canopy + +if ~exist('SMCsf','var'), SMCsf = 1; end % HERE COULD BE A STRESS FACTOR FOR VCMAX AS A FUNCTION OF SMC DEFINED +% but this is at present not +% incorporated + +fVh = exp(kV*xl(1:end-1)); +fVu = ones(13,36,60); + +for i = 1:60 + fVu(:,:,i) = fVh(i); +end + +LAI = canopy.LAI; +PSI=0; +%[bbx]=Max_Rootdepth(bbx,TIME,NL,KT); +[bbx]=Max_Rootdepth(bbx,NL,KT,Ta); +[PSIs,rsss,rrr,rxx] = calc_rsoil(Rl,DeltZ,Ztot,Ks,Theta_s,Theta_r,Theta_LL,Theta_o,bbx); +[sfactor] = calc_sfactor(Rl,Theta_s,Theta_r,Theta_LL,bbx,wfrac); +PSIss=PSIs(45,1); +%% 2. Energy balance iteration loop + +%'Energy balance loop (Energy balance and radiative transfer) + +while CONT % while energy balance does not close + + % 2.1. Net radiation of the components + % Thermal radiative transfer model for vegetation emission (with Stefan-Boltzman's equation) + rad = RTMt_sb(spectral,rad,soil,leafopt,canopy,gap,angles,Tcu,Tch,Ts(2),Ts(1),1); + % Add net radiation of (1) solar and sky and (2) thermal emission model + + Rnhct = rad.Rnhct; + Rnuct = rad.Rnuct; + Rnhst = rad.Rnhst; + Rnust = rad.Rnust; + + Rnhc = rad.Rnhc; + Rnuc = rad.Rnuc; + Rnhs = rad.Rnhs; + Rnus = rad.Rnus; + + Rnch = Rnhc + Rnhct; % Canopy (shaded) net radiation + Rncu = Rnuc + Rnuct; % Canopy (sunlit) net radiation + Rnsh = Rnhs + Rnhst; % Soil (shaded) net radiation + Rnsu = Rnus + Rnust; % Soil (sunlit) net radiation + Rns = [Rnsh Rnsu]'; % Soil (sun+sh) net radiation + + % 2.2. Aerodynamic roughness + % calculate friction velocity [m s-1] and aerodynamic resistances [s m-1] + + resist_in.u = max(meteo.u,.2); + resist_in.L = L; + resist_in.LAI = canopy.LAI; + resist_in.rbs = soil.rbs; + resist_in.rss = soil.rss; + resist_in.rwc = canopy.rwc; + resist_in.zo = canopy.zo; + resist_in.d = canopy.d; + resist_in.z = meteo.z; + resist_in.hc = canopy.hc; + resist_in.w = canopy.leafwidth; + resist_in.Cd = canopy.Cd; + + [resist_out] = resistances(resist_in); + + ustar = resist_out.ustar; + raa = resist_out.raa; + rawc = resist_out.rawc; + raws = resist_out.raws; + + % 2.3. Biochemical processes + + % photosynthesis (A), fluorescence factor (F), and stomatal resistance (rcw), for shaded (1) and sunlit (h) leaves + biochem_in.Fluorescence_model = options.Fluorescence_model; + biochem_in.Type = leafbio.Type; + biochem_in.p = p; + biochem_in.m = leafbio.m; + biochem_in.BallBerry0 = leafbio.BallBerry0; + biochem_in.O = meteo.Oa; + biochem_in.Rdparam = leafbio.Rdparam; + + if options.Fluorescence_model==2 % specific for the v.Caemmerer-Magnani model + b = @biochemical_MD12; + biochem_in.Tyear = leafbio.Tyear; + biochem_in.beta = leafbio.beta; + biochem_in.qLs = leafbio.qLs; + biochem_in.NPQs = leafbio.kNPQs; + biochem_in.stressfactor = leafbio.stressfactor; + else + b = @biochemical; % specific for Berry-v.d.Tol model + biochem_in.tempcor = options.apply_T_corr; + biochem_in.Tparams = leafbio.Tparam; + biochem_in.stressfactor = SMCsf; + end + + % for shaded leaves + biochem_in.T = Tch; + biochem_in.eb = ech; + biochem_in.Vcmo = fVh.*leafbio.Vcmo; + biochem_in.Cs = Cch; + biochem_in.Q = rad.Pnh_Cab*1E6; + + biochem_out = b(biochem_in); + Ah = biochem_out.A; + Ahh = biochem_out.Ag; + Cih = biochem_out.Ci; + Fh = biochem_out.eta; + rcwh = biochem_out.rcw; + qEh = biochem_out.qE; % vCaemmerer- Magnani does not generate this parameter (dummy value) + Knh = biochem_out.Kn; + + % for sunlit leaves + biochem_in.T = Tcu; + biochem_in.eb = ecu; + biochem_in.Vcmo = fVu.*leafbio.Vcmo; + biochem_in.Cs = Ccu; + biochem_in.Q = rad.Pnu_Cab*1E6; + + biochem_out = b(biochem_in); + + Au = biochem_out.A; + Auu = biochem_out.Ag; + Ciu = biochem_out.Ci; + Fu = biochem_out.eta; + rcwu = biochem_out.rcw; + qEu = biochem_out.qE; + Knu = biochem_out.Kn; + + Pinh = rad.Pnh; + Pinu = rad.Pnu; + Pinh_Cab = rad.Pnh_Cab; + Pinu_Cab = rad.Pnu_Cab; + Rnh_PAR = rad.Rnh_PAR; + Rnu_PAR = rad.Rnu_PAR; + + % 2.4. Fluxes (latent heat flux (lE), sensible heat flux (H) and soil heat flux G + % in analogy to Ohm's law, for canopy (c) and soil (s). All in units of [W m-2] + + %soil.PSIs; + rss = soil.rss; + for i=1:30 + [lEch,Hch,ech,Cch] = heatfluxes((LAI+1)*(raa+rawc),rcwh,Tch,ea,Ta,e_to_q,PSI,Ca,Cih); + [lEcu,Hcu,ecu,Ccu] = heatfluxes((LAI+1)*(raa+rawc),rcwu,Tcu,ea,Ta,e_to_q,PSI,Ca,Ciu); + [lEs,Hs] = heatfluxes((LAI+1)*(raa+raws),rss ,Ts ,ea,Ta,e_to_q,PSIss,Ca,Ca); + + if any( ~isreal( Cch )) || any( ~isreal( Ccu(:) )) + error('Heatfluxes produced complex values for CO2 concentration!') + end + + % if any( Cch < 0 ) || any( Ccu(:) < 0 ) + % error('Heatfluxes produced negative values for CO2 concentration!') + % end + + % integration over the layers and sunlit and shaded fractions + Hstot = Fs*Hs; + Hctot = LAI*(Fc*Hch + equations.meanleaf(canopy,Hcu,'angles_and_layers',Ps)); + Htot = Hstot + Hctot; + %%%%%% Leaf water potential calculate + + lEctot = LAI*(Fc*lEch + equations.meanleaf(canopy,lEcu,'angles_and_layers',Ps)); % latent heat leaves + + Trans = lEctot/2454000/1000; %unit: m s-1 + AA1=PSIs./(rsss+rrr+rxx); + AA2=1./(rsss+rrr+rxx); + BB1=AA1(~isnan(AA1)); + BB2=AA2(~isinf(AA2)); + PSI1 = (sum(BB1)-Trans)/sum(BB2); + % µ¥Î»ÒªÍ³Ò»£¬ÊÇÃ뻹ÊÇ°ëСʱ£¬ÍÁ²ãºñ¶ÈÊÇ·ñÒª¿¼ÂÇ + if isnan(PSI1) + PSI1 = -1; + end + if PSI/PSI1>0.99 + break + end + PSI = (PSI + PSI1)/2; + end + PSItot(KT)=PSI; + %%%%%%% + if SoilHeatMethod==2 + G = 0.30*Rns; + else + G = GAM/sqrt(pi)*2*sum(([Ts'; Tsold(1:end-1,:)] - Tsold)/Deltat .* (sqrt(x) - sqrt(x-Deltat))); + G = G'; + end + % 2.5. Monin-Obukhov length L + L = -rhoa*cp*ustar.^3.*(Ta+273.15)./(kappa*g*Htot); % [1] + L(L<-1E3) = -1E3; % [1] + L(L>1E2) = 1E2; % [1] + L(isnan(L)) = -1; % [1] + + % 2.6. energy balance errors, continue criterion and iteration counter + EBerch = Rnch -lEch -Hch; + EBercu = Rncu -lEcu -Hcu; + EBers = Rns -lEs -Hs - G; + + counter = counter+1; % Number of iterations + maxEBercu = max(max(max(abs(EBercu)))); + maxEBerch = max(abs(EBerch)); + maxEBers = max(abs(EBers)); + + CONT = ( maxEBercu > maxEBer |... + maxEBerch > maxEBer |... + maxEBers > maxEBer) &... + counter < maxit+1;% Continue iteration? + + % 2.7. New estimates of soil (s) and leaf (c) temperatures, shaded (h) and sunlit (1) + %Tch = Ta + update(Tch-Ta,Wc,(raa + rawc)/(rhoa*cp).*(Rnch - lEch)); + Tch = Tch + Wc*(Rnch-lEch-Hch)./((rhoa*cp)./((LAI+1)*(raa + rawc)) + 4*sigmaSB*(Tch+273.15).^3); + %Tcu = Ta + update(Tcu-Ta,Wc,(raa + rawc)/(rhoa*cp).*(Rncu - lEcu)); + Tcu = Tcu + Wc*(Rncu-lEcu-Hcu)./((rhoa*cp)./((LAI+1)*(raa + rawc)) + 4*sigmaSB*(Tcu+273.15).^3); + + if (any(isnan(Tch)) || any(isnan(Tcu(:)))), warning('Canopy temperature gives NaNs'), end + if any(isnan(Ts)), warning('Soil temperature gives NaNs'), end + + %Ts(abs(Ts)>100 ) = Ta; + %Ts = Ta + update(Ts-Ta,Wc, (raa + raws)/(rhoa*cp).*(Rns - lEs - G)); + Ts = Ts + Wc*(Rns-lEs-Hs-G)./((rhoa*cp)./(raa + rawc) + 4*sigmaSB*(Ts+273.15).^3); + +% if mean(abs(Hs))>1E4, +% Ts(:) = Ta-1; Tcu(:) = Ta-1; Tch(:) = Ta-1; +% end + + + % if t==0 || SoilHeatMethod == 2, +% Ts = Ta + update(Ts-Ta,Wc, (raa + raws)/(rhoa*cp).*(Rns - lEs - G)); +% else +% Ts = Tsold + G/GAM*sqrt(Deltat/pi); +% end + % 2.8. error check + if (any(isnan(Tch)) || any(isnan(Tcu(:)))), warning('Canopy temperature gives NaNs'), end + if any(isnan(Ts)), warning('Soil temperature gives NaNs'), end + if counter>50, Wc = 0.2; end + +end + +iter.counter = counter; +profiles.etah = Fh; +profiles.etau = Fu; + +if SoilHeatMethod<2 + Tsold(2:end,:) = soil.Tsold(1:end-1,:); + Tsold(1,:) = Ts(:); + if isnan(Ts), Tsold(1,:) = Tsold(2,:); end + soil.Tsold = Tsold; +end + +Tbr = (rad.Eoutte/constants.sigmaSB)^0.25; +Lot_ = equations.Planck(spectral.wlS',Tbr); +rad.LotBB_ = Lot_; % Note that this is the blackbody radiance! + +%% 3. Print warnings whenever the energy balance could not be solved +if counter>=maxit + fprintf(1,'%s \n','warning: maximum number of iteratations exceeded'); + fprintf(1,'%s ',['Energy balance error sunlit vegetation = ',sprintf('%4.2f',maxEBercu),'W m-2 ']); + fprintf(1,'%s ',['Energy balance error shaded vegetation = ',sprintf('%4.2f',maxEBerch),'W m-2 ']); + fprintf(1,'%s ',['Energy balance error soil = ',sprintf('%4.2f',maxEBers ),'W m-2 ']); + fprintf(1,'\r'); +end + +%% 4. Calculate the output per layer +if options.calc_vert_profiles + [Hcu1d ] = equations.meanleaf(canopy,Hcu, 'angles'); % [nli,nlo,nl] mean sens heat sunlit leaves + [lEcu1d ] = equations.meanleaf(canopy,lEcu, 'angles'); % [nli,nlo,nl] mean latent sunlit leaves + [Au1d ] = equations.meanleaf(canopy,Au, 'angles'); % [nli,nlo,nl] mean phots sunlit leaves + [Fu_Pn1d] = equations.meanleaf(canopy,Fu.*Pinu_Cab, 'angles'); % [nli,nlo,nl] mean fluor sunlit leaves + [qEuL ] = equations.meanleaf(canopy,qEu, 'angles'); % [nli,nlo,nl] mean fluor sunlit leaves + %[Pnu1d ] = equations.meanleaf(canopy,Pinu, 'angles'); % [nli,nlo,nl] mean net radiation sunlit leaves + %[Pnu1d_Cab ] = equations.meanleaf(canopy,Pinu_Cab, 'angles'); % [nli,nlo,nl] mean net radiation sunlit leaves + [Rnu1d ] = equations.meanleaf(canopy,Rncu, 'angles'); % [nli,nlo,nl] mean net PAR sunlit leaves + [Tcu1d ] = equations.meanleaf(canopy,Tcu, 'angles'); % [nli,nlo,nl] mean temp sunlit leaves + + profiles.Tchave = mean(Tch); % [1] mean temp shaded leaves + profiles.Tch = Tch; % [nl] + profiles.Tcu1d = Tcu1d; % [nl] + profiles.Tc1d = (1-Ps(1:nl)).*Tch + Ps(1:nl).*(Tcu1d); % [nl] mean temp leaves, per layer + profiles.Hc1d = (1-Ps(1:nl)).*Hch + Ps(1:nl).*(Hcu1d); % [nl] mean sens heat leaves, per layer + profiles.lEc1d = (1-Ps(1:nl)).*lEch + Ps(1:nl).*(lEcu1d); % [nl] mean latent heat leaves, per layer + profiles.A1d = (1-Ps(1:nl)).*Ah + Ps(1:nl).*(Au1d); % [nl] mean photos leaves, per layer + profiles.F_Pn1d = ((1-Ps(1:nl)).*Fh.*Pinh_Cab + Ps(1:nl).*(Fu_Pn1d)); %[nl] mean fluor leaves, per layer + profiles.qE = ((1-Ps(1:nl)).*qEh + Ps(1:nl).*(qEuL)); %[nl] mean fluor leaves, per layer + %profiles.Pn1d = ((1-Ps(1:nl)).*Pinh + Ps(1:nl).*(Pnu1d)); %[nl] mean photos leaves, per layer + %profiles.Pn1d_Cab = ((1-Ps(1:nl)).*Pinh_Cab + Ps(1:nl).*(Pnu1d_Cab)); %[nl] mean photos leaves, per layer + profiles.Rn1d = ((1-Ps(1:nl)).*Rnch + Ps(1:nl).*(Rnu1d)); %[nl] +end + + +%% 5. Calculate spectrally integrated energy, water and CO2 fluxes +% sum of all leaves, and average leaf temperature +% (note that averaging temperature is physically not correct...) + +Rnctot = LAI*(Fc*Rnch + equations.meanleaf(canopy,Rncu,'angles_and_layers',Ps)); % net radiation leaves +lEctot = LAI*(Fc*lEch + equations.meanleaf(canopy,lEcu,'angles_and_layers',Ps)); % latent heat leaves +Hctot = LAI*(Fc*Hch + equations.meanleaf(canopy,Hcu ,'angles_and_layers',Ps)); % sensible heat leaves +Actot = LAI*(Fc*Ahh + equations.meanleaf(canopy,Auu ,'angles_and_layers',Ps)); % photosynthesis leaves +Tcave = (Fc*Tch + equations.meanleaf(canopy,Tcu ,'angles_and_layers',Ps)); % mean leaf temperature +Pntot = LAI*(Fc*Pinh + equations.meanleaf(canopy,Pinu,'angles_and_layers',Ps)); % net PAR leaves +Pntot_Cab = LAI*(Fc*Pinh_Cab + equations.meanleaf(canopy,Pinu_Cab,'angles_and_layers',Ps)); % net PAR leaves +Rntot_PAR = LAI*(Fc*Rnh_PAR + equations.meanleaf(canopy,Rnu_PAR, 'angles_and_layers',Ps));% net PAR leaves +aPAR_Cab_eta = LAI*(Fc*(profiles.etah .* Rnh_PAR) + equations.meanleaf(canopy,(profiles.etau .* Rnu_PAR), 'angles_and_layers',Ps)); +% ... green ePAR * relative fluorescence emission efficiency +%%%%%%%%%%%%%%%%%%% [Delta_Rltot] = Root_properties(Actot,rroot); +%%%%%%%%%%%%%%%%%%% Delta_Rl = fc*Delta_Rltot; +%%%%%%%%%%%%%%%%%%% Rl = Rl + Delta_Rl; +%%%%%%%%%%%%%%%%%%% Rltot = sum(sum(Rl)); +%%%%%%%%%%%%%%%%%%% fc = Rl./Rltot; +% sum of soil fluxes and average temperature +% (note that averaging temperature is physically not correct...) +Rnstot = Fs*Rns; % Net radiation soil +lEstot = Fs*lEs; % Latent heat soil +%Hstot = Fs*Hs; % Sensible heat soil +Gtot = Fs*G; % Soil heat flux +Tsave = Fs*Ts; % Soil temperature +Resp = Fs*equations.soil_respiration(Ts);% Soil respiration + +% total fluxes (except sensible heat), all leaves and soil +Atot = Actot; % GPP +Rntot = Rnctot + Rnstot; % Net radiation +lEtot = lEctot + lEstot; % Latent heat +%Htot = Hctot + Hstot; % Sensible heat + +fluxes.Rntot = Rntot; % [W m-2] total net radiation (canopy + soil) +fluxes.lEtot = lEtot; % [W m-2] total latent heat flux (canopy + soil) +fluxes.Htot = Htot; % [W m-2] total sensible heat flux (canopy + soil) +fluxes.Atot = Atot; % [umol m-2 s-1] total net CO2 uptake (canopy + soil) +fluxes.Rnctot = Rnctot; % [W m-2] canopy net radiation +fluxes.lEctot = lEctot; % [W m-2] canopy latent heat flux +fluxes.Hctot = Hctot; % [W m-2] canopy sensible heat flux +fluxes.Actot = Actot; % [umol m-2 s-1] canopy net CO2 uptake +fluxes.Rnstot = Rnstot; % [W m-2] soil net radiation +fluxes.lEstot = lEstot; % [W m-2] soil latent heat flux +fluxes.Hstot = Hstot; % [W m-2] soil sensible heat flux +fluxes.Gtot = Gtot; % [W m-2] soil heat flux +fluxes.Resp = Resp; % [umol m-2 s-1] soil respiration +fluxes.aPAR = Pntot; % [umol m-2 s-1] absorbed PAR +fluxes.aPAR_Cab = Pntot_Cab;% [umol m-2 s-1] absorbed PAR +fluxes.aPAR_Wm2 = Rntot_PAR;% [W m-2] absorbed PAR +fluxes.aPAR_Cab_eta = aPAR_Cab_eta; + +thermal.Ta = Ta; % [oC] air temperature (as in input) +thermal.Ts = Ts; % [oC] soil temperature, sunlit and shaded [2x1] +thermal.Tcave = Tcave; % [oC] weighted average canopy temperature +thermal.Tsave = Tsave; % [oC] weighted average soil temperature +thermal.raa = raa; % [s m-1] total aerodynamic resistance above canopy +thermal.rawc = rawc; % [s m-1] aerodynamic resistance below canopy for canopy +thermal.raws = raws; % [s m-1] aerodynamic resistance below canopy for soil +thermal.ustar = ustar; % [m s-1] friction velocity +thermal.Tcu = Tcu; +thermal.Tch = Tch; + +fluxes.Au = Au; +fluxes.Ah = Ah; +RWU =( PSIs - PSI)./(rsss+rrr+rxx).*bbx; +nn=numel(RWU); +for i=1:nn + if isnan(RWU(i)) + RWU(i)=0; + end +end +for i=1:nn + if RWU(i)<0 + RWU(i)=1*1e-20; + end +end +frac = RWU./abs(sum(sum(RWU))); +RWU =( PSIs - PSI)./(rsss+rrr+rxx).*bbx; +for i=1:nn + if isnan(RWU(i)) + RWU(i)=0; + end +end + +profiles.Knu = Knu; +profiles.Knh = Knh; +% function Tnew = update(Told, Wc, innovation) +% Tnew = Wc.*innovation + (1-Wc).*Told; +% return diff --git a/src/fluspect_B_CX.m b/src/fluspect_B_CX.m new file mode 100644 index 00000000..fb690898 --- /dev/null +++ b/src/fluspect_B_CX.m @@ -0,0 +1,297 @@ +function [leafopt] = fluspect_B_CX(spectral,leafbio,optipar) +% +% function [leafopt] = fluspect(spectral,leafbio,optipar) +% calculates reflectance and transmittance spectra of a leaf using FLUSPECT, +% plus four excitation-fluorescence matrices +% +% Authors: Wout Verhoef, Christiaan van der Tol (tol@itc.nl), Joris Timmermans, +% Date: 2007 +% Update from PROSPECT to FLUSPECT: January 2011 (CvdT) +% +% Nov 2012 (CvdT) Output EF-matrices separately for PSI and PSII +% 31 Jan 2013 (WV) Adapt to SCOPE v_1.40, using structures for I/O +% 30 May 2013 (WV) Repair bug in s for non-conservative scattering +% 24 Nov 2013 (WV) Simplified doubling routine +% 25 Nov 2013 (WV) Restored piece of code that takes final refl and +% tran outputs as a basis for the doubling routine +% 03 Dec 2013 (WV) Major upgrade. Border interfaces are removed before +% the fluorescence calculation and later added again +% 23 Dec 2013 (WV) Correct a problem with N = 1 when calculating k +% and s; a test on a = Inf was included +% 01 Apr 2014 (WV) Add carotenoid concentration (Cca and Kca) +% 19 Jan 2015 (WV) First beta version for simulation of PRI effect +% 17 Mar 2017 (CT) Added Anthocyanins (following Prospect-D) +% +% usage: +% [leafopt] = fluspect_b(spectral,leafbio,optipar) +% +% inputs: +% Cab = leafbio.Cab; +% Cca = leafbio.Cca; +% V2Z = leafbio.V2Z; % Violaxanthin - Zeaxanthin transition status +% [0-1] +% Cw = leafbio.Cw; +% Cdm = leafbio.Cdm; +% Cs = leafbio.Cs; +% Cant = leafbio.Cant; +% N = leafbio.N; +% fqe = leafbio.fqe; +% +% nr = optipar.nr; +% Kdm = optipar.Kdm; +% Kab = optipar.Kab; +% Kca = optipar.Kca; +% KcaV = optipar.KcaV; +% KcaZ = optipar.KcaZ; +% Kw = optipar.Kw; +% Ks = optipar.Ks; +% phiI = optipar.phiI; +% phiII = optipar.phiII; +% +% outputs: +% refl reflectance +% tran transmittance +% Mb backward scattering fluorescence matrix, I for PSI and II for PSII +% Mf forward scattering fluorescence matrix, I for PSI and II for PSII + +%% parameters +% fixed parameters for the fluorescence module +ndub = 15; % number of doublings applied + +% Fluspect parameters +Cab = leafbio.Cab; +Cca = leafbio.Cca; +V2Z = leafbio.V2Z; +Cw = leafbio.Cw; +Cdm = leafbio.Cdm; +Cs = leafbio.Cs; +Cant = leafbio.Cant; +N = leafbio.N; +fqe = leafbio.fqe; + +nr = optipar.nr; +Kdm = optipar.Kdm; +Kab = optipar.Kab; + +if V2Z == -999 + % Use old Kca spectrum if this is given as input + Kca = optipar.Kca; +else + % Otherwise make linear combination based on V2Z + % For V2Z going from 0 to 1 we go from Viola to Zea + Kca = (1-V2Z) * optipar.KcaV + V2Z * optipar.KcaZ; +end + +Kw = optipar.Kw; +Ks = optipar.Ks; +Kant = optipar.Kant; +phiI = optipar.phiI; +phiII = optipar.phiII; + +%% PROSPECT calculations +Kall = (Cab*Kab + Cca*Kca + Cdm*Kdm + Cw*Kw + Cs*Ks + Cant*Kant)/N; % Compact leaf layer + +j = find(Kall>0); % Non-conservative scattering (normal case) +t1 = (1-Kall).*exp(-Kall); +t2 = Kall.^2.*expint(Kall); +tau = ones(size(t1)); +tau(j) = t1(j)+t2(j); +kChlrel = zeros(size(t1)); +kChlrel(j) = Cab*Kab(j)./(Kall(j)*N); + +talf = calctav(59,nr); +ralf = 1-talf; +t12 = calctav(90,nr); +r12 = 1-t12; +t21 = t12./(nr.^2); +r21 = 1-t21; + +% top surface side +denom = 1-r21.*r21.*tau.^2; +Ta = talf.*tau.*t21./denom; +Ra = ralf+r21.*tau.*Ta; + +% bottom surface side +t = t12.*tau.*t21./denom; +r = r12+r21.*tau.*t; + +% Stokes equations to compute properties of next N-1 layers (N real) +% Normal case + +D = sqrt((1+r+t).*(1+r-t).*(1-r+t).*(1-r-t)); +rq = r.^2; +tq = t.^2; +a = (1+rq-tq+D)./(2*r); +b = (1-rq+tq+D)./(2*t); + +bNm1 = b.^(N-1); % +bN2 = bNm1.^2; +a2 = a.^2; +denom = a2.*bN2-1; +Rsub = a.*(bN2-1)./denom; +Tsub = bNm1.*(a2-1)./denom; + +% Case of zero absorption +j = find(r+t >= 1); +Tsub(j) = t(j)./(t(j)+(1-t(j))*(N-1)); +Rsub(j) = 1-Tsub(j); + +% Reflectance and transmittance of the leaf: combine top layer with next N-1 layers +denom = 1-Rsub.*r; +tran = Ta.*Tsub./denom; +refl = Ra+Ta.*Rsub.*t./denom; + +leafopt.refl = refl; +leafopt.tran = tran; +leafopt.kChlrel = kChlrel; + +% From here a new path is taken: The doubling method used to calculate +% fluoresence is now only applied to the part of the leaf where absorption +% takes place, that is, the part exclusive of the leaf-air interfaces. The +% reflectance (rho) and transmittance (tau) of this part of the leaf are +% now determined by "subtracting" the interfaces + +Rb = (refl-ralf)./(talf.*t21+(refl-ralf).*r21); % Remove the top interface +Z = tran.*(1-Rb.*r21)./(talf.*t21); % Derive Z from the transmittance + +rho = (Rb-r21.*Z.^2)./(1-(r21.*Z).^2); % Reflectance and transmittance +tau = (1-Rb.*r21)./(1-(r21.*Z).^2).*Z; % of the leaf mesophyll layer +t = tau; +r = max(rho,0); % Avoid negative r + +% Derive Kubelka-Munk s and k + +I_rt = (r+t)<1; +D(I_rt) = sqrt((1 + r(I_rt) + t(I_rt)) .* ... + (1 + r(I_rt) - t(I_rt)) .* ... + (1 - r(I_rt) + t(I_rt)) .* ... + (1 - r(I_rt) - t(I_rt))); +a(I_rt) = (1 + r(I_rt).^2 - t(I_rt).^2 + D(I_rt)) ./ (2*r(I_rt)); +b(I_rt) = (1 - r(I_rt).^2 + t(I_rt).^2 + D(I_rt)) ./ (2*t(I_rt)); +a(~I_rt) = 1; +b(~I_rt) = 1; + +s = r./t; +I_a = (a>1 & a~=Inf); +s(I_a) = 2.*a(I_a) ./ (a(I_a).^2 - 1) .* log(b(I_a)); + +k = log(b); +k(I_a) = (a(I_a)-1) ./ (a(I_a)+1) .* log(b(I_a)); +kChl = kChlrel .* k; + +%% Fluorescence of the leaf mesophyll layer +% Fluorescence part is skipped for fqe = 0 + +if fqe > 0 + + wle = spectral.wlE'; % excitation wavelengths, transpose to column + wlf = spectral.wlF'; % fluorescence wavelengths, transpose to column + wlp = spectral.wlP; % PROSPECT wavelengths, kept as a row vector + + minwle = min(wle); + maxwle = max(wle); + minwlf = min(wlf); + maxwlf = max(wlf); + + % indices of wle and wlf within wlp + + Iwle = find(wlp>=minwle & wlp<=maxwle); + Iwlf = find(wlp>=minwlf & wlp<=maxwlf); + + eps = 2^(-ndub); + + % initialisations + te = 1-(k(Iwle)+s(Iwle)) * eps; + tf = 1-(k(Iwlf)+s(Iwlf)) * eps; + re = s(Iwle) * eps; + rf = s(Iwlf) * eps; + + sigmoid = 1./(1+exp(-wlf/10)*exp(wle'/10)); % matrix computed as an outproduct + + % Other factor .5 deleted, since these are the complete efficiencies + % for either PSI or PSII, not a linear combination + + [MfI, MbI] = deal(fqe(1) * ((.5*phiI( Iwlf))*eps) * kChl(Iwle)'.*sigmoid); + [MfII, MbII] = deal(fqe(2) * ((.5*phiII(Iwlf))*eps) * kChl(Iwle)'.*sigmoid); + + Ih = ones(1,length(te)); % row of ones + Iv = ones(length(tf),1); % column of ones + + % Doubling routine + + for i = 1:ndub + + xe = te./(1-re.*re); ten = te.*xe; ren = re.*(1+ten); + xf = tf./(1-rf.*rf); tfn = tf.*xf; rfn = rf.*(1+tfn); + + A11 = xf*Ih + Iv*xe'; A12 = (xf*xe').*(rf*Ih + Iv*re'); + A21 = 1+(xf*xe').*(1+rf*re'); A22 = (xf.*rf)*Ih+Iv*(xe.*re)'; + + MfnI = MfI .* A11 + MbI .* A12; + MbnI = MbI .* A21 + MfI .* A22; + MfnII = MfII .* A11 + MbII .* A12; + MbnII = MbII .* A21 + MfII .* A22; + + te = ten; re = ren; tf = tfn; rf = rfn; + MfI = MfnI; MbI = MbnI; MfII = MfnII; MbII = MbnII; + + end + + % Here we add the leaf-air interfaces again for obtaining the final + % leaf level fluorescences. + + g1 = MbI; g2 = MbII; f1 = MfI; f2 = MfII; + + Rb = rho + tau.^2.*r21./(1-rho.*r21); + + Xe = Iv * (talf(Iwle)./(1-r21(Iwle).*Rb(Iwle)))'; + Xf = t21(Iwlf)./(1-r21(Iwlf).*Rb(Iwlf)) * Ih; + Ye = Iv * (tau(Iwle).*r21(Iwle)./(1-rho(Iwle).*r21(Iwle)))'; + Yf = tau(Iwlf).*r21(Iwlf)./(1-rho(Iwlf).*r21(Iwlf)) * Ih; + + A = Xe .* (1 + Ye.*Yf) .* Xf; + B = Xe .* (Ye + Yf) .* Xf; + + g1n = A .* g1 + B .* f1; + f1n = A .* f1 + B .* g1; + g2n = A .* g2 + B .* f2; + f2n = A .* f2 + B .* g2; + + leafopt.MbI = g1n; + leafopt.MbII = g2n; + leafopt.MfI = f1n; + leafopt.MfII = f2n; + +% [leafopt.MbI_rc,leafopt.MfI_rc] = deal(0.5*fqe(1) * ((phiI(Iwlf))) * kChlrel(Iwle)'.*sigmoid); % fluxes without reabsorption +% [leafopt.MbII_rc,leafopt.MfII_rc] = deal(0.5*fqe(2) * ((phiII(Iwlf))) * kChlrel(Iwle)'.*sigmoid);% fluxes without reabsorption + +end + +return; + +function tav = calctav(alfa,nr) + + rd = pi/180; + n2 = nr.^2; + np = n2+1; + nm = n2-1; + a = (nr+1).*(nr+1)/2; + k = -(n2-1).*(n2-1)/4; + sa = sin(alfa.*rd); + + b1 = (alfa~=90)*sqrt((sa.^2-np/2).*(sa.^2-np/2)+k); + b2 = sa.^2-np/2; + b = b1-b2; + b3 = b.^3; + a3 = a.^3; + ts = (k.^2./(6*b3)+k./b-b/2)-(k.^2./(6*a3)+k./a-a/2); + + tp1 = -2*n2.*(b-a)./(np.^2); + tp2 = -2*n2.*np.*log(b./a)./(nm.^2); + tp3 = n2.*(1./b-1./a)/2; + tp4 = 16*n2.^2.*(n2.^2+1).*log((2*np.*b-nm.^2)./(2*np.*a-nm.^2))./(np.^3.*nm.^2); + tp5 = 16*n2.^3.*(1./(2*np.*b-nm.^2)-1./(2*np.*a-nm.^2))./(np.^3); + tp = tp1+tp2+tp3+tp4+tp5; + tav = (ts+tp)./(2*sa.^2); + +return; \ No newline at end of file diff --git a/src/fluspect_B_CX_PSI_PSII_combined.m b/src/fluspect_B_CX_PSI_PSII_combined.m new file mode 100644 index 00000000..08284509 --- /dev/null +++ b/src/fluspect_B_CX_PSI_PSII_combined.m @@ -0,0 +1,282 @@ +function leafopt = fluspect_B_CX_PSI_PSII_combined(spectral,leafbio,optipar) +% +% function [leafopt] = fluspect(spectral,leafbio,optipar) +% calculates reflectance and transmittance spectra of a leaf using FLUSPECT, +% plus four excitation-fluorescence matrices +% +% Authors: Wout Verhoef, Christiaan van der Tol (tol@itc.nl), Joris Timmermans, +% Date: 2007 +% Update from PROSPECT to FLUSPECT: January 2011 (CvdT) +% +% Nov 2012 (CvdT) Output EF-matrices separately for PSI and PSII +% 31 Jan 2013 (WV) Adapt to SCOPE v_1.40, using structures for I/O +% 30 May 2013 (WV) Repair bug in s for non-conservative scattering +% 24 Nov 2013 (WV) Simplified doubling routine +% 25 Nov 2013 (WV) Restored piece of code that takes final refl and +% tran outputs as a basis for the doubling routine +% 03 Dec 2013 (WV) Major upgrade. Border interfaces are removed before +% the fluorescence calculation and later added again +% 23 Dec 2013 (WV) Correct a problem with N = 1 when calculating k +% and s; a test on a = Inf was included +% 01 Apr 2014 (WV) Add carotenoid concentration (Cca and Kca) +% 19 Jan 2015 (WV) First beta version for simulation of PRI effect +% 17 Mar 2017 (CT) Added Anthocyanins according to Prospect-D +% +% usage: +% [leafopt] = fluspect_b(spectral,leafbio,optipar) +% +% inputs: +% Cab = leafbio.Cab; +% Cca = leafbio.Cca; +% V2Z = leafbio.V2Z; % Violaxanthin - Zeaxanthin transition status +% [0-1] +% Cw = leafbio.Cw; +% Cdm = leafbio.Cdm; +% Cs = leafbio.Cs; +% Cant = leafbio.Cant; +% N = leafbio.N; +% fqe = leafbio.fqe; +% +% nr = optipar.nr; +% Kdm = optipar.Kdm; +% Kab = optipar.Kab; +% Kca = optipar.Kca; +% KcaV = optipar.KcaV; +% KcaZ = optipar.KcaZ; +% Kw = optipar.Kw; +% Ks = optipar.Ks; +% phi = optipar.phi; +% outputs: +% refl reflectance +% tran transmittance +% Mb backward scattering fluorescence matrix, I for PSI and II for PSII +% Mf forward scattering fluorescence matrix, I for PSI and II for PSII + +%% parameters +% fixed parameters for the fluorescence module +ndub = 15; % number of doublings applied + +% Fluspect parameters +Cab = leafbio.Cab; +Cca = leafbio.Cca; +V2Z = leafbio.V2Z; +Cw = leafbio.Cw; +Cdm = leafbio.Cdm; +Cs = leafbio.Cs; +Cant = leafbio.Cant; +N = leafbio.N; +fqe = leafbio.fqe; + +nr = optipar.nr; +Kdm = optipar.Kdm; +Kab = optipar.Kab; + +if V2Z == -999 + % Use old Kca spectrum if this is given as input + Kca = optipar.Kca; +else + % Otherwise make linear combination based on V2Z + % For V2Z going from 0 to 1 we go from Viola to Zea + Kca = (1-V2Z) * optipar.KcaV + V2Z * optipar.KcaZ; +end + +Kw = optipar.Kw; +Ks = optipar.Ks; +Kant = optipar.Kant; +phi = optipar.phi; + +%% PROSPECT calculations +Kall = (Cab*Kab + Cca*Kca + Cdm*Kdm + Cw*Kw + Cs*Ks + Cant*Kant)/N; % Compact leaf layer + +j = find(Kall>0); % Non-conservative scattering (normal case) +t1 = (1-Kall).*exp(-Kall); +t2 = Kall.^2.*expint(Kall); +tau = ones(size(t1)); +tau(j) = t1(j)+t2(j); +kChlrel = zeros(size(t1)); +kChlrel(j) = Cab*Kab(j)./(Kall(j)*N); + +talf = calctav(59,nr); +ralf = 1-talf; +t12 = calctav(90,nr); +r12 = 1-t12; +t21 = t12./(nr.^2); +r21 = 1-t21; + +% top surface side +denom = 1-r21.*r21.*tau.^2; +Ta = talf.*tau.*t21./denom; +Ra = ralf+r21.*tau.*Ta; + +% bottom surface side +t = t12.*tau.*t21./denom; +r = r12+r21.*tau.*t; + +% Stokes equations to compute properties of next N-1 layers (N real) +% Normal case + +D = sqrt((1+r+t).*(1+r-t).*(1-r+t).*(1-r-t)); +rq = r.^2; +tq = t.^2; +a = (1+rq-tq+D)./(2*r); +b = (1-rq+tq+D)./(2*t); + +bNm1 = b.^(N-1); % +bN2 = bNm1.^2; +a2 = a.^2; +denom = a2.*bN2-1; +Rsub = a.*(bN2-1)./denom; +Tsub = bNm1.*(a2-1)./denom; + +% Case of zero absorption +j = find(r+t >= 1); +Tsub(j) = t(j)./(t(j)+(1-t(j))*(N-1)); +Rsub(j) = 1-Tsub(j); + +% Reflectance and transmittance of the leaf: combine top layer with next N-1 layers +denom = 1-Rsub.*r; +tran = Ta.*Tsub./denom; +refl = Ra+Ta.*Rsub.*t./denom; + +leafopt.refl = refl; +leafopt.tran = tran; +leafopt.kChlrel = kChlrel; + +% From here a new path is taken: The doubling method used to calculate +% fluoresence is now only applied to the part of the leaf where absorption +% takes place, that is, the part exclusive of the leaf-air interfaces. The +% reflectance (rho) and transmittance (tau) of this part of the leaf are +% now determined by "subtracting" the interfaces + +Rb = (refl-ralf)./(talf.*t21+(refl-ralf).*r21); % Remove the top interface +Z = tran.*(1-Rb.*r21)./(talf.*t21); % Derive Z from the transmittance + +rho = (Rb-r21.*Z.^2)./(1-(r21.*Z).^2); % Reflectance and transmittance +tau = (1-Rb.*r21)./(1-(r21.*Z).^2).*Z; % of the leaf mesophyll layer +t = tau; +r = max(rho,0); % Avoid negative r + +% Derive Kubelka-Munk s and k + +I_rt = (r+t)<1; +D(I_rt) = sqrt((1 + r(I_rt) + t(I_rt)) .* ... + (1 + r(I_rt) - t(I_rt)) .* ... + (1 - r(I_rt) + t(I_rt)) .* ... + (1 - r(I_rt) - t(I_rt))); +a(I_rt) = (1 + r(I_rt).^2 - t(I_rt).^2 + D(I_rt)) ./ (2*r(I_rt)); +b(I_rt) = (1 - r(I_rt).^2 + t(I_rt).^2 + D(I_rt)) ./ (2*t(I_rt)); +a(~I_rt) = 1; +b(~I_rt) = 1; + +s = r./t; +I_a = (a>1 & a~=Inf); +s(I_a) = 2.*a(I_a) ./ (a(I_a).^2 - 1) .* log(b(I_a)); + +k = log(b); +k(I_a) = (a(I_a)-1) ./ (a(I_a)+1) .* log(b(I_a)); +kChl = kChlrel .* k; + +%% Fluorescence of the leaf mesophyll layer +% Fluorescence part is skipped for fqe = 0 + +if fqe > 0 + + wle = spectral.wlE'; % excitation wavelengths, transpose to column + wlf = spectral.wlF'; % fluorescence wavelengths, transpose to column + wlp = spectral.wlP; % PROSPECT wavelengths, kept as a row vector + + minwle = min(wle); + maxwle = max(wle); + minwlf = min(wlf); + maxwlf = max(wlf); + + % indices of wle and wlf within wlp + + Iwle = find(wlp>=minwle & wlp<=maxwle); + Iwlf = find(wlp>=minwlf & wlp<=maxwlf); + + eps = 2^(-ndub); + + % initialisations + te = 1-(k(Iwle)+s(Iwle)) * eps; + tf = 1-(k(Iwlf)+s(Iwlf)) * eps; + re = s(Iwle) * eps; + rf = s(Iwlf) * eps; + + sigmoid = 1./(1+exp(-wlf/10)*exp(wle'/10)); % matrix computed as an outproduct + + [Mf, Mb] = deal(fqe(1) * ((.5*phi(Iwlf))*eps) * kChl(Iwle)'.*sigmoid); + + Ih = ones(1,length(te)); % row of ones + Iv = ones(length(tf),1); % column of ones + + % Doubling routine + + for i = 1:ndub + + xe = te./(1-re.*re); ten = te.*xe; ren = re.*(1+ten); + xf = tf./(1-rf.*rf); tfn = tf.*xf; rfn = rf.*(1+tfn); + + A11 = xf*Ih + Iv*xe'; A12 = (xf*xe').*(rf*Ih + Iv*re'); + A21 = 1+(xf*xe').*(1+rf*re'); A22 = (xf.*rf)*Ih+Iv*(xe.*re)'; + + Mfn = Mf .* A11 + Mb .* A12; + Mbn = Mb .* A21 + Mf .* A22; + + te = ten; re = ren; tf = tfn; rf = rfn; + Mf = Mfn; Mb = Mbn; + end + + % Here we add the leaf-air interfaces again for obtaining the final + % leaf level fluorescences. + + g = Mb; f = Mf; + + Rb = rho + tau.^2.*r21./(1-rho.*r21); + + Xe = Iv * (talf(Iwle)./(1-r21(Iwle).*Rb(Iwle)))'; + Xf = t21(Iwlf)./(1-r21(Iwlf).*Rb(Iwlf)) * Ih; + Ye = Iv * (tau(Iwle).*r21(Iwle)./(1-rho(Iwle).*r21(Iwle)))'; + Yf = tau(Iwlf).*r21(Iwlf)./(1-rho(Iwlf).*r21(Iwlf)) * Ih; + + A = Xe .* (1 + Ye.*Yf) .* Xf; + B = Xe .* (Ye + Yf) .* Xf; + + gn = A .* g + B .* f; + fn = A .* f + B .* g; + + leafopt.Mb = gn; + leafopt.Mf = fn; + + [leafopt.MbI_rc,leafopt.MfI_rc] = deal(0.5*fqe(1) * ((phi(Iwlf))) * kChlrel(Iwle)'.*sigmoid); + +end + +return; + +function tav = calctav(alfa,nr) + + rd = pi/180; + n2 = nr.^2; + np = n2+1; + nm = n2-1; + a = (nr+1).*(nr+1)/2; + k = -(n2-1).*(n2-1)/4; + sa = sin(alfa.*rd); + + b1 = (alfa~=90)*sqrt((sa.^2-np/2).*(sa.^2-np/2)+k); + b2 = sa.^2-np/2; + b = b1-b2; + b3 = b.^3; + a3 = a.^3; + ts = (k.^2./(6*b3)+k./b-b/2)-(k.^2./(6*a3)+k./a-a/2); + + tp1 = -2*n2.*(b-a)./(np.^2); + tp2 = -2*n2.*np.*log(b./a)./(nm.^2); + tp3 = n2.*(1./b-1./a)/2; + tp4 = 16*n2.^2.*(n2.^2+1).*log((2*np.*b-nm.^2)./(2*np.*a-nm.^2))./(np.^3.*nm.^2); + tp5 = 16*n2.^3.*(1./(2*np.*b-nm.^2)-1./(2*np.*a-nm.^2))./(np.^3); + tp = tp1+tp2+tp3+tp4+tp5; + tav = (ts+tp)./(2*sa.^2); + +return; \ No newline at end of file diff --git a/src/hPARM.m b/src/hPARM.m new file mode 100644 index 00000000..1d6aed2a --- /dev/null +++ b/src/hPARM.m @@ -0,0 +1,57 @@ +function [Chh,ChT,Khh,KhT,Kha,Vvh,VvT,Chg,DTheta_LLh,DTheta_LLT]=hPARM(NL,hh,... +h,TT,T,Theta_LL,Theta_L,DTheta_LLh,DTheta_LLT,RHOV,RHOL,Theta_V,V_A,Eta,DRHOVh,... +DRHOVT,KL_h,D_Ta,KL_T,D_V,D_Vg,COR,Beta_g,Gamma0,Gamma_w,KLa_Switch,DVa_Switch,hThmrl,Thmrlefc,nD) + +% piecewise linear reduction function parameters of h;(Wesseling +% 1991,Veenhof and McBride 1994) + +MN=0; +for ML=1:NL + for ND=1:2 + MN=ML+ND-1; + if hThmrl + DhU=COR(MN)*(hh(MN)-h(MN)+hh(MN)*0.0068*(TT(MN)-T(MN))); + if DhU~=0 && abs(Theta_LL(ML,ND)-Theta_L(ML,ND))>1e-6 + DTheta_LLh(ML,ND)=(Theta_LL(ML,ND)-Theta_L(ML,ND))*COR(MN)/DhU; + end + DTheta_LLT(ML,ND)=DTheta_LLh(ML,ND)*hh(MN)*0.0068; + else + if abs(TT(MN)-T(MN))<1e-6 + DTheta_LLT(ML,ND)=DTheta_LLh(ML,ND)*(hh(MN)/Gamma0)*(-0.1425-4.76*10^(-4)*TT(MN)); + else + DTheta_LLT(ML,ND)=(Theta_LL(ML,ND)-Theta_L(ML,ND))/(TT(MN)-T(MN)); + end + end + end +end + +MN=0; +for ML=1:NL + for ND=1:nD + MN=ML+ND-1; + Chh(ML,ND)=(1-RHOV(MN)/RHOL)*DTheta_LLh(ML,ND)+Theta_V(ML,ND)*DRHOVh(MN)/RHOL; + Khh(ML,ND)=(D_V(ML,ND)+D_Vg(ML))*DRHOVh(MN)/RHOL+KL_h(ML,ND); % + Chg(ML,ND)=KL_h(ML,ND); + %root zone water uptake + + + if Thmrlefc==1 + ChT(ML,ND)=(1-RHOV(MN)/RHOL)*DTheta_LLT(ML,ND)+Theta_V(ML,ND)*DRHOVT(MN)/RHOL; + KhT(ML,ND)=(D_V(ML,ND)*Eta(ML,ND)+D_Vg(ML))*DRHOVT(MN)/RHOL+KL_T(ML,ND)+D_Ta(ML,ND);%();% + end + + if KLa_Switch==1 + Kha(ML,ND)=RHOV(MN)*Beta_g(ML,ND)/RHOL+KL_h(ML,ND)/Gamma_w; + else + Kha(ML,ND)=0; + end + + if DVa_Switch==1 + Vvh(ML,ND)=-V_A(ML)*DRHOVh(MN)/RHOL; + VvT(ML,ND)=-V_A(ML)*DRHOVT(MN)/RHOL; + else + Vvh(ML,ND)=0; + VvT(ML,ND)=0; + end + end +end diff --git a/src/h_BC.m b/src/h_BC.m new file mode 100644 index 00000000..f0184766 --- /dev/null +++ b/src/h_BC.m @@ -0,0 +1,49 @@ +%function [AVAIL0,RHS,C4,C4_a,Evap,EVAP,Trap,Precip,Srt]=h_BC(lEstot,lEctot,PSIs,PSI,rsss,rrr,rxx,Srt,RHS,NBCh,NBChB,BCh,BChB,hN,KT,Delt_t,DSTOR0,NBChh,h_SUR,C4,KL_h,Precip,NN,AVAIL0,C4_a,Evap,rwuef) +function [AVAIL0,RHS,C4,C4_a,Evap,EVAP,Trap,Precip,bx,Srt]=h_BC(DeltZ,bx,Srt,RHS,NBCh,NBChB,BCh,BChB,hN,KT,Delt_t,DSTOR0,NBChh,TIME,h_SUR,C4,KL_h,Precip,NN,AVAIL0,C4_a,Evap,RHOV,Ta,HR_a,U,Ts,Theta_LL,Rv,g,NL,Evaptranp_Cal,Coefficient_n,Coefficient_Alpha,Theta_r,Theta_s,DURTN,PME,PT_PM_0,hh,rwuef,J,lEstot,lEctot) +%global Precip +%%%%%%%%%% Apply the bottom boundary condition called for by NBChB %%%%%%% +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +if NBChB==1 %-----> Specify matric head at bottom to be ---BChB; + RHS(1)=BChB; + C4(1,1)=1; + RHS(2)=RHS(2)-C4(1,2)*RHS(1); + C4(1,2)=0; + C4_a(1)=0; +elseif NBChB==2 %-----> Specify flux at bottom to be ---BChB (Positive upwards); + RHS(1)=RHS(1)+BChB; +elseif NBChB==3 %-----> NBChB=3,Gravity drainage at bottom--specify flux= hydraulic conductivity; + RHS(1)=RHS(1)-KL_h(1,1); +end + +%%%%%%%%%% Apply the surface boundary condition called for by NBCh %%%%%%% +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +if NBCh==1 %-----> Specified matric head at surface---equal to hN; + RHS(NN)=h_SUR(KT); + C4(NN,1)=1; + RHS(NN-1)=RHS(NN-1)-C4(NN-1,2)*RHS(NN); + C4(NN-1,2)=0; + C4_a(NN-1)=0; +elseif NBCh==2 + if NBChh==1 + RHS(NN)=hN; + C4(NN,1)=1; + RHS(NN-1)=RHS(NN-1)-C4(NN-1,2)*RHS(NN); + C4(NN-1,2)=0; + else + RHS(NN)=RHS(NN)-BCh; %> and a specified matric head (saturation or dryness)was applied; + end +else +%[Evap,EVAP,Trap,Srt]= Evap_Cal(KT,lEstot,lEctot,PSIs,PSI,rsss,rrr,rxx,rwuef); + [Evap,EVAP,Trap,bx,Srt]= Evap_Cal(bx,Srt,DeltZ,TIME,RHOV,Ta,HR_a,U,Theta_LL,Ts,Rv,g,NL,NN,KT,Evaptranp_Cal,Coefficient_n,Coefficient_Alpha,Theta_r,Theta_s,DURTN,PME,PT_PM_0,hh,rwuef,J,lEstot,lEctot); + AVAIL0=Precip(KT)+DSTOR0/Delt_t; + if NBChh==1 + RHS(NN)=hN; + C4(NN,1)=1; + RHS(NN-1)=RHS(NN-1)-C4(NN-1,2)*RHS(NN); + C4(NN-1,2)=0; + C4_a(NN-1)=0; + else + RHS(NN)=RHS(NN)+AVAIL0-Evap(KT); + end +end + diff --git a/src/h_Bndry_Flux.m b/src/h_Bndry_Flux.m new file mode 100644 index 00000000..e428df13 --- /dev/null +++ b/src/h_Bndry_Flux.m @@ -0,0 +1,5 @@ +function [QMT,QMB]=h_Bndry_Flux(SAVE,hh,NN,KT) + +QMT(KT)=SAVE(2,1,1)-SAVE(2,2,1)*hh(NN-1)-SAVE(2,3,1)*hh(NN); +QMB(KT)=-SAVE(1,1,1)+SAVE(1,2,1)*hh(1)+SAVE(1,3,1)*hh(2); + diff --git a/src/h_EQ.m b/src/h_EQ.m new file mode 100644 index 00000000..293586e4 --- /dev/null +++ b/src/h_EQ.m @@ -0,0 +1,67 @@ +function [RHS,C4,SAVE]=h_EQ(C1,C2,C4,C5,C6,C7,C5_a,C9,NL,NN,Delt_t,T,TT,h,P_gg,Thmrlefc,Soilairefc) + +if Thmrlefc && ~Soilairefc + RHS(1)=-C9(1)-C7(1)+(C1(1,1)*h(1)+C1(1,2)*h(2))/Delt_t ... + -(C2(1,1)/Delt_t+C5(1,1))*TT(1)-(C2(1,2)/Delt_t+C5(1,2))*TT(2) ... + +(C2(1,1)/Delt_t)*T(1)+(C2(1,2)/Delt_t)*T(2); + for ML=2:NL + ARG1=C2(ML-1,2)/Delt_t; + ARG2=C2(ML,1)/Delt_t; + ARG3=C2(ML,2)/Delt_t; + + RHS(ML)=-C9(ML)-C7(ML)+(C1(ML-1,2)*h(ML-1)+C1(ML,1)*h(ML)+C1(ML,2)*h(ML+1))/Delt_t ... + -(ARG1+C5(ML-1,2))*TT(ML-1)-(ARG2+C5(ML,1))*TT(ML)-(ARG3+C5(ML,2))*TT(ML+1) ... + +ARG1*T(ML-1)+ARG2*T(ML)+ARG3*T(ML+1); + end + RHS(NN)=-C9(NN)-C7(NN)+(C1(NN-1,2)*h(NN-1)+C1(NN,1)*h(NN))/Delt_t ... + -(C2(NN-1,2)/Delt_t+C5(NN-1,2))*TT(NN-1)-(C2(NN,1)/Delt_t+C5(NN,1))*TT(NN) ... + +(C2(NN-1,2)/Delt_t)*T(NN-1)+(C2(NN,1)/Delt_t)*T(NN); +elseif ~Thmrlefc && Soilairefc + RHS(1)=-C9(1)-C7(1)+(C1(1,1)*h(1)+C1(1,2)*h(2))/Delt_t ... + -C6(1,1)*P_gg(1)-C6(1,2)*P_gg(2); + for ML=2:NL + RHS(ML)=-C9(ML)-C7(ML)+(C1(ML-1,2)*h(ML-1)+C1(ML,1)*h(ML)+C1(ML,2)*h(ML+1))/Delt_t ... + -C6(ML-1,2)*P_gg(ML-1)-C6(ML,1)*P_gg(ML)-C6(ML,2)*P_gg(ML+1); + end + RHS(NN)=-C9(NN)-C7(NN)+(C1(NN-1,2)*h(NN-1)+C1(NN,1)*h(NN))/Delt_t ... + -C6(NN-1,2)*P_gg(NN-1)-C6(NN,1)*P_gg(NN); +elseif Thmrlefc && Soilairefc + RHS(1)=-C9(1)-C7(1)+(C1(1,1)*h(1)+C1(1,2)*h(2))/Delt_t ... + -(C2(1,1)/Delt_t+C5(1,1))*TT(1)-(C2(1,2)/Delt_t+C5(1,2))*TT(2) ... + -C6(1,1)*P_gg(1)-C6(1,2)*P_gg(2) ... + +(C2(1,1)/Delt_t)*T(1)+(C2(1,2)/Delt_t)*T(2); + for ML=2:NL + ARG1=C2(ML-1,2)/Delt_t; + ARG2=C2(ML,1)/Delt_t; + ARG3=C2(ML,2)/Delt_t; + + RHS(ML)=-C9(ML)-C7(ML)+(C1(ML-1,2)*h(ML-1)+C1(ML,1)*h(ML)+C1(ML,2)*h(ML+1))/Delt_t ... + -(ARG1+C5_a(ML-1))*TT(ML-1)-(ARG2+C5(ML,1))*TT(ML)-(ARG3+C5(ML,2))*TT(ML+1) ... + -C6(ML-1,2)*P_gg(ML-1)-C6(ML,1)*P_gg(ML)-C6(ML,2)*P_gg(ML+1) ... + +ARG1*T(ML-1)+ARG2*T(ML)+ARG3*T(ML+1); + end + + RHS(NN)=-C9(NN)-C7(NN)+(C1(NN-1,2)*h(NN-1)+C1(NN,1)*h(NN))/Delt_t ... + -(C2(NN-1,2)/Delt_t+C5_a(NN-1))*TT(NN-1)-(C2(NN,1)/Delt_t+C5(NN,1))*TT(NN) ... + -C6(NN-1,2)*P_gg(NN-1)-C6(NN,1)*P_gg(NN) ... + +(C2(NN-1,2)/Delt_t)*T(NN-1)+(C2(NN,1)/Delt_t)*T(NN); +else + RHS(1)=-C9(1)-C7(1)+(C1(1,1)*h(1)+C1(1,2)*h(2))/Delt_t; + for ML=2:NL + RHS(ML)=-C9(ML)-C7(ML)+(C1(ML-1,2)*h(ML-1)+C1(ML,1)*h(ML)+C1(ML,2)*h(ML+1))/Delt_t; + end + RHS(NN)=-C9(NN)-C7(NN)+(C1(NN-1,2)*h(NN-1)+C1(NN,1)*h(NN))/Delt_t; +end + +for MN=1:NN + for ND=1:2 + C4(MN,ND)=C1(MN,ND)/Delt_t+C4(MN,ND); + end +end + +SAVE(1,1,1)=RHS(1); +SAVE(1,2,1)=C4(1,1); +SAVE(1,3,1)=C4(1,2); +SAVE(2,1,1)=RHS(NN); +SAVE(2,2,1)=C4(NN-1,2); +SAVE(2,3,1)=C4(NN,1); diff --git a/src/h_MAT.m b/src/h_MAT.m new file mode 100644 index 00000000..b46d0fa5 --- /dev/null +++ b/src/h_MAT.m @@ -0,0 +1,54 @@ +function [C1,C2,C4,C3,C4_a,C5,C6,C7,C5_a,C9]=h_MAT(Chh,ChT,Khh,KhT,Kha,Vvh,VvT,Chg,DeltZ,NL,NN,Srt) + +for MN=1:NN % Clean the space in C1-7 every iteration,otherwise, in *.PARM files, + for ND=1:2 % C1-7 will be mixed up with pre-storaged data, which will cause extremly crazy for computation, which exactly results in NAN. + C1(MN,ND)=0; + C7(MN)=0; + C9(MN)=0; % C9 is the matrix coefficient of root water uptake; + C4(MN,ND)=0; + C4_a(MN)=0; + C5_a(MN)=0; + C2(MN,ND)=0; + C3(MN,ND)=0; + C5(MN,ND)=0; + C6(MN,ND)=0; + end +end +for ML=1:NL + C1(ML,1)=C1(ML,1)+Chh(ML,1)*DeltZ(ML)/2; + C1(ML+1,1)=C1(ML+1,1)+Chh(ML,2)*DeltZ(ML)/2;% + + C2(ML,1)=C2(ML,1)+ChT(ML,1)*DeltZ(ML)/2; + C2(ML+1,1)=C2(ML+1,1)+ChT(ML,2)*DeltZ(ML)/2; % + + C4ARG1=(Khh(ML,1)+Khh(ML,2))/(2*DeltZ(ML));%sqrt(Khh(ML,1)*Khh(ML,2))/(DeltZ(ML));% + C4ARG2_1=Vvh(ML,1)/3+Vvh(ML,2)/6; + C4ARG2_2=Vvh(ML,1)/6+Vvh(ML,2)/3; + C4(ML,1)=C4(ML,1)+C4ARG1-C4ARG2_1; + C4(ML,2)=C4(ML,2)-C4ARG1-C4ARG2_2; + C4(ML+1,1)=C4(ML+1,1)+C4ARG1+C4ARG2_2; + C4_a(ML)=-C4ARG1+C4ARG2_1; + + C5ARG1=(KhT(ML,1)+KhT(ML,2))/(2*DeltZ(ML));%sqrt(KhT(ML,1)*KhT(ML,2))/(DeltZ(ML));% + C5ARG2_1=VvT(ML,1)/3+VvT(ML,2)/6; + C5ARG2_2=VvT(ML,1)/6+VvT(ML,2)/3; + C5(ML,1)=C5(ML,1)+C5ARG1-C5ARG2_1; + C5(ML,2)=C5(ML,2)-C5ARG1-C5ARG2_2; + C5(ML+1,1)=C5(ML+1,1)+C5ARG1+C5ARG2_2; + C5_a(ML)=-C5ARG1+C5ARG2_1; + + C6ARG=(Kha(ML,1)+Kha(ML,2))/(2*DeltZ(ML));%sqrt(Kha(ML,1)*Kha(ML,2))/(DeltZ(ML));% + C6(ML,1)=C6(ML,1)+C6ARG; + C6(ML,2)=C6(ML,2)-C6ARG; + C6(ML+1,1)=C6(ML+1,1)+C6ARG; + + C7ARG=(Chg(ML,1)+Chg(ML,2))/2;%sqrt(Chg(ML,1)*Chg(ML,2));% + C7(ML)=C7(ML)-C7ARG; + C7(ML+1)=C7(ML+1)+C7ARG; + + %Srt, root water uptake; + C9ARG1=(2*Srt(ML,1)+Srt(ML,2))*DeltZ(ML)/6;%sqrt(Chg(ML,1)*Chg(ML,2));% + C9ARG2=(Srt(ML,1)+2*Srt(ML,2))*DeltZ(ML)/6; + C9(ML)=C9(ML)+C9ARG1; + C9(ML+1)=C9(ML+1)+C9ARG2; +end \ No newline at end of file diff --git a/src/h_sub.m b/src/h_sub.m new file mode 100644 index 00000000..369e24f8 --- /dev/null +++ b/src/h_sub.m @@ -0,0 +1,36 @@ +function h_sub +global hh MN NN +global C1 C2 C4 C3 C4_a C5 C6 C7 +global Chh ChT Khh KhT Kha Vvh VvT Chg DeltZ C5_a +global NL nD bx +global Delt_t RHS T TT h P_gg SAVE Thmrlefc Soilairefc +global RHOL Gamma_w DTheta_LLh DTheta_LLT +global Theta_L Theta_LL Theta_V Eta V_A +global RHOV DRHOVh DRHOVT KL_h D_Ta KL_T D_V D_Vg +global COR hThmrl Beta_g Gamma0 KLa_Switch DVa_Switch +global Precip Evap CHK Evapo EVAP +global NBCh NBChB BCh BChB hN KT DSTOR0 NBChh TIME h_SUR AVAIL0 +global QMT QMB QMTT QMBB +global Ta U Ts Rv g HR_a Srt C9 % U_wind is the mean wind speed at height z_ref (m¡¤s^-1), U is the wind speed at each time step. +global Evaptranp_Cal Coefficient_n Coefficient_Alpha Theta_r Theta_s DURTN PME PT_PM_0 rwuef J trap Trap lEstot lEctot +%global trap Trap lEstot lEctot PSIs PSI rsss rrr rxx rwuef + +[Chh,ChT,Khh,KhT,Kha,Vvh,VvT,Chg,DTheta_LLh,DTheta_LLT]=hPARM(NL,hh,... +h,TT,T,Theta_LL,Theta_L,DTheta_LLh,DTheta_LLT,RHOV,RHOL,Theta_V,V_A,Eta,DRHOVh,... +DRHOVT,KL_h,D_Ta,KL_T,D_V,D_Vg,COR,Beta_g,Gamma0,Gamma_w,KLa_Switch,DVa_Switch,hThmrl,Thmrlefc,nD); +[C1,C2,C4,C3,C4_a,C5,C6,C7,C5_a,C9]=h_MAT(Chh,ChT,Khh,KhT,Kha,Vvh,VvT,Chg,DeltZ,NL,NN,Srt); +[RHS,C4,SAVE]=h_EQ(C1,C2,C4,C5,C6,C7,C5_a,C9,NL,NN,Delt_t,T,TT,h,P_gg,Thmrlefc,Soilairefc); +[AVAIL0,RHS,C4,C4_a,Evap,EVAP,Trap,Precip,bx,Srt]=h_BC(DeltZ,bx,Srt,RHS,NBCh,NBChB,BCh,BChB,hN,KT,Delt_t,DSTOR0,NBChh,TIME,h_SUR,C4,KL_h,Precip,NN,AVAIL0,C4_a,Evap,RHOV,Ta,HR_a,U,Ts,Theta_LL,Rv,g,NL,Evaptranp_Cal,Coefficient_n,Coefficient_Alpha,Theta_r,Theta_s,DURTN,PME,PT_PM_0,hh,rwuef,J,lEstot,lEctot); +[CHK,hh,C4]=hh_Solve(C4,hh,NN,NL,C4_a,RHS); +for MN=1:NN + if hh(MN)<=-10^(5) + hh(MN)=-10^(5); + elseif hh(MN)>=-1e-6 + hh(MN)=-1e-6; + end +end +[QMT,QMB]=h_Bndry_Flux(SAVE,hh,NN,KT); +QMTT(KT)=QMT(KT); +QMBB(KT)=QMB(KT); +Evapo(KT)=Evap(KT); +trap(KT)=Trap(KT); \ No newline at end of file diff --git a/src/heatfluxes.m b/src/heatfluxes.m new file mode 100644 index 00000000..f8f0fb92 --- /dev/null +++ b/src/heatfluxes.m @@ -0,0 +1,47 @@ +function [lE, H, ec, Cc] = heatfluxes(ra,rs,Tc,ea,Ta,e_to_q,PSI,Ca,Ci) + +global constants + +rhoa = constants.rhoa; +cp = constants.cp; +MH2O = constants.MH2O; +R = constants.R; + +% author: Dr. ir. Christiaan van der Tol (tol@itc.nl) +% date: 7 Dec 2007 +% updated: 15 Apr 2009 CvdT changed layout +% updated: 14 Sep 2012 CvdT added ec and Cc to output +% +% parent: ebal.m +% +% usage: +% function [lE, H] = heatfluxes(ra,rs,Tc,ea,Ta,e_to_q,PSI) +% +% this function calculates latent and sensible heat flux +% +% input: +% ra aerodynamic resistance for heat s m-1 +% rs stomatal resistance s m-1 +% Tc leaf temperature oC +% ea vapour pressure above canopy hPa +% Ta air temperature above canopy oC +% e_to_q conv. from vapour pressure to abs hum hPa-1 +% PSI leaf water potential J kg-1 +% Ca ambient CO2 concentration umol m-3 +% Ci intercellular CO2 concentration umol m-3 +% +% output: +% lEc latent heat flux of a leaf W m-2 +% Hc sensible heat flux of a leaf W m-2 +% ec vapour pressure at the leaf surface hPa +% Cc CO2 concentration at the leaf surface umol m-3 + +lambda = (2.501-0.002361*Tc)*1E6; % [J kg-1] Evapor. heat (J kg-1) +ei = equations.satvap(Tc).*exp(1E-3*PSI*MH2O/R./(Tc+273.15)); +qi = ei .* e_to_q; +qa = ea .* e_to_q; + +lE = rhoa./(ra+rs).*lambda.*(qi-qa); % [W m-2] Latent heat flux +H = (rhoa*cp)./ra.*(Tc-Ta); % [W m-2] Sensible heat flux +ec = ea + (ei-ea)*ra./(ra+rs); % [W m-2] vapour pressure at the leaf surface +Cc = Ca - (Ca-Ci).*ra./(ra+rs); % [umol m-2 s-1] CO2 concentration at the leaf surface diff --git a/src/hh_Solve.m b/src/hh_Solve.m new file mode 100644 index 00000000..0abaa1f8 --- /dev/null +++ b/src/hh_Solve.m @@ -0,0 +1,17 @@ +function [CHK,hh,C4]=hh_Solve(C4,hh,NN,NL,C4_a,RHS) + +RHS(1)=RHS(1)/C4(1,1); + +for ML=2:NN + C4(ML,1)=C4(ML,1)-C4_a(ML-1)*C4(ML-1,2)/C4(ML-1,1); + RHS(ML)=(RHS(ML)-C4_a(ML-1)*RHS(ML-1))/C4(ML,1); +end + +for ML=NL:-1:1 + RHS(ML)=RHS(ML)-C4(ML,2)*RHS(ML+1)/C4(ML,1); +end + +for MN=1:NN + CHK(MN)=abs(RHS(MN)-hh(MN)); + hh(MN)=RHS(MN); +end diff --git a/src/not_used/Brightness_T.m b/src/not_used/Brightness_T.m new file mode 100644 index 00000000..524e8637 --- /dev/null +++ b/src/not_used/Brightness_T.m @@ -0,0 +1,8 @@ +function [T_C] = Brightness_T(H) + +global constants +sigmaSB = constants.sigmaSB; +C2K = constants.C2K; + +T_C = (H/sigmaSB).^(1/4)-C2K; +end \ No newline at end of file diff --git a/src/not_used/calculate_vert_profiles.m b/src/not_used/calculate_vert_profiles.m new file mode 100644 index 00000000..17123bf0 --- /dev/null +++ b/src/not_used/calculate_vert_profiles.m @@ -0,0 +1,29 @@ +function profiles = calculate_vert_profiles(profiles, canopy) +% this function is incomplete and apparently never called + +profiles.etah = Fh; +profiles.etau = Fu; + +[Hcu1d ] = equations.meanleaf(canopy,Hcu, 'angles'); % [nli,nlo,nl] mean sens heat sunlit leaves +[lEcu1d ] = equations.meanleaf(canopy,lEcu, 'angles'); % [nli,nlo,nl] mean latent sunlit leaves +[Au1d ] = equations.meanleaf(canopy,Au, 'angles'); % [nli,nlo,nl] mean phots sunlit leaves +[Fu_Pn1d] = equations.meanleaf(canopy,Fu.*Pinu_Cab, 'angles'); % [nli,nlo,nl] mean fluor sunlit leaves +[qEuL ] = equations.meanleaf(canopy,qEu, 'angles'); % [nli,nlo,nl] mean fluor sunlit leaves +[Pnu1d ] = equations.meanleaf(canopy,Pinu, 'angles'); % [nli,nlo,nl] mean net radiation sunlit leaves +[Pnu1d_Cab ] = equations.meanleaf(canopy,Pinu_Cab, 'angles'); % [nli,nlo,nl] mean net radiation sunlit leaves +[Rnu1d ] = equations.meanleaf(canopy,Rncu, 'angles'); % [nli,nlo,nl] mean net PAR sunlit leaves +[Tcu1d ] = equations.meanleaf(canopy,Tcu, 'angles'); % [nli,nlo,nl] mean temp sunlit leaves + +profiles.Tchave = mean(Tch); % [1] mean temp shaded leaves +profiles.Tch = Tch; % [nl] +profiles.Tcu1d = Tcu1d; % [nl] +profiles.Tc1d = (1-Ps(1:nl)).*Tch + Ps(1:nl).*(Tcu1d); % [nl] mean temp leaves, per layer +profiles.Hc1d = (1-Ps(1:nl)).*Hch + Ps(1:nl).*(Hcu1d); % [nl] mean sens heat leaves, per layer +profiles.lEc1d = (1-Ps(1:nl)).*lEch + Ps(1:nl).*(lEcu1d); % [nl] mean latent heat leaves, per layer +profiles.A1d = (1-Ps(1:nl)).*Ah + Ps(1:nl).*(Au1d); % [nl] mean photos leaves, per layer +profiles.F_Pn1d = ((1-Ps(1:nl)).*Fh.*Pinh_Cab + Ps(1:nl).*(Fu_Pn1d)); % [nl] mean fluor leaves, per layer +profiles.qE = ((1-Ps(1:nl)).*qEh + Ps(1:nl).*(qEuL)); % [nl] mean fluor leaves, per layer +profiles.Pn1d = ((1-Ps(1:nl)).*Pinh + Ps(1:nl).*(Pnu1d)); % [nl] mean aPAR leaves, per layer +profiles.Pn1d_Cab = ((1-Ps(1:nl)).*Pinh_Cab + Ps(1:nl).*(Pnu1d_Cab)); % [nl] mean aPAR_byCab leaves, per layer +profiles.Rn1d = ((1-Ps(1:nl)).*Rnch + Ps(1:nl).*(Rnu1d)); % [nl] mean net radiation leaves, per layer +end \ No newline at end of file diff --git a/src/not_used/e2phot.m b/src/not_used/e2phot.m new file mode 100644 index 00000000..a93465c7 --- /dev/null +++ b/src/not_used/e2phot.m @@ -0,0 +1,9 @@ +function molphotons = e2phot(lambda,E) +%molphotons = e2phot(lambda,E) calculates the number of moles of photons +%corresponding to E Joules of energy of wavelength lambda (m) + +A = 6.02214E23; % [mol-1] Constant of Avogadro +e = ephoton(lambda); +photons = E./e; +molphotons = photons./A; +return; \ No newline at end of file diff --git a/src/not_used/ephoton.m b/src/not_used/ephoton.m new file mode 100644 index 00000000..3291e8c2 --- /dev/null +++ b/src/not_used/ephoton.m @@ -0,0 +1,8 @@ +function E = ephoton(lambda) +%E = phot2e(lambda) calculates the energy content (J) of 1 photon of +%wavelength lambda (m) + +h = 6.6262E-34; % [J s] Planck's constant +c = 299792458; % [m s-1] Speed of light +E = h*c./lambda; % [J] energy of 1 photon +return; diff --git a/src/not_used/plot_directional_figure4_function.m b/src/not_used/plot_directional_figure4_function.m new file mode 100644 index 00000000..482f42bb --- /dev/null +++ b/src/not_used/plot_directional_figure4_function.m @@ -0,0 +1,144 @@ +function plot_directional_figure4_function(directory) +% Use: plot_directional_figure4(directory) makes BRDF, BFDF and +% bidirectional temperature polar plots from a SCOPE output directory +% (string 'directory') of directional data. + +% directory = 'D:\projects Python\SCOPE\SCOPE_v1.70\output\example_directional_run\Directional\'; + +files = dir(directory); + +spfig3 = zeros(4,1); +h = zeros(3,1); +for m = 1:3 + subplot(3,1,m) + for k = 1:4 + plot(20*k/180*pi.*cos((-1:.01:1)*pi),20*k/180*pi.*sin((-1:.01:1)*pi),'Color',m~=6*[1 1 1]) + text(20*k/180*pi-.2,0,num2str(20*k),'FontSize',14,'Color',m~=6*[1 1 1]); + end + if m<4 + + end + axis off +end + + +Anglesfile = files(3).name; +ValuesTfile = files(6).name; +ValuesBRDFfile = files(4).name; +ValuesFluorfile = files(5).name; + +Angles = load([directory Anglesfile]); +% ValuesT = load([directory ValuesTfile]); +ValuesBRDF = load([directory ValuesBRDFfile]); +ValuesFluor = load([directory ValuesFluorfile]); + +obs_zenith = Angles(1,:); +obs_azimuth = Angles(2,:); +sol_zenith = Angles(3,1); + +wl = ValuesBRDF(:,1 )*1E-3; +wlF = ValuesFluor(:,1 )*1E-3; +%Tb = ValuesT(:,1:end); +BRDF = ValuesBRDF(:,2:end); +Fluor = ValuesFluor(:,2:end); + +obs_azimuth = obs_azimuth-360*(obs_azimuth>180); +obs_zenith_i = 0:90; +obs_azimuth_i = -180:1:180; +[Obs_Zenith_i,Obs_Azimuth_i]= meshgrid(obs_zenith_i,obs_azimuth_i); + +wl_i = 0.4; +[v,i_wl] = min(abs(wl-.8)); + + +[v,j_wl] = min(abs(wlF-.685)); +[v,j_wl2] = min(abs(wlF-.740)); +[v,j_wl3] = min(abs(wlF-.755)); + + +%obs_elevation = 90-obs_zenith; +%obs_r = ones(size(obs_elevation)); +%Obs_Elevation_i = 90-Obs_Zenith_i; +%Obs_R_i = ones(size(Obs_Zenith_i)); +% [x ,y ,z ] = sph2cart(obs_azimuth*pi/180,obs_elevation*pi/180,obs_r); +% [X_i,Y_i] = sph2cart(Obs_Azimuth_i*pi/180,Obs_Elevation_i*pi/180,Obs_R_i); +x = obs_zenith *pi/180 .* cos(obs_azimuth *pi/180+pi/2); +y = obs_zenith *pi/180 .* sin(obs_azimuth *pi/180+pi/2); + +X_i = Obs_Zenith_i*pi/180 .* cos(Obs_Azimuth_i*pi/180+pi/2); +Y_i = Obs_Zenith_i*pi/180 .* sin(Obs_Azimuth_i*pi/180+pi/2); + +BRDF_i = griddata(x,y,BRDF(i_wl,:),X_i,Y_i,'v4'); +%Tb_i = griddata(x,y,Tb,X_i,Y_i,'v4'); +Fluor_i = griddata(x,y,Fluor(j_wl,:),X_i,Y_i,'v4'); +Fluor_i2 = griddata(x,y,Fluor(j_wl2,:),X_i,Y_i,'v4'); +Fluor_i3 = griddata(x,y,Fluor(j_wl3,:),X_i,Y_i,'v4'); + +%% +F3 = figure(3); + + + +xli = .5*pi*[0 -1.15 -.1 1]; +yli = .5*pi*[1 0 -1.05 0]; + +spfig3(1) = subplot(1,3,1); +z = pcolor(X_i,Y_i,BRDF_i); hold on +set(z,'LineStyle','none') +for k = 1:4 + plot(20*k/180*pi.*cos((-1:.01:1)*pi),20*k/180*pi.*sin((-1:.01:1)*pi),'Color',j~=1*[1 1 1]) + text(20*k/180*pi-.2,.2,num2str(20*k),'FontSize',14,'Color',j~=1*[1 1 1]); + text(xli(k),yli(k),num2str(90*(k-1)),'FontSize',14,'Color','k','FontAngle','italic'); +end +%if j == 1 + text(-1.7,1.8,'BRDF','FontSize',14) + h(3) = colorbar; +%end +axis off + +spfig3(2) = subplot(1,3,2); +z = pcolor(X_i,Y_i,Fluor_i); hold on +set(z,'LineStyle','none') +for k = 1:4 + plot(20*k/180*pi.*cos((-1:.01:1)*pi),20*k/180*pi.*sin((-1:.01:1)*pi),'Color',[1 1 1]) + text(20*k/180*pi-.2,.2,num2str(20*k),'FontSize',14,'Color',[1 1 1]); + text(xli(k),yli(k),num2str(90*(k-1)),'FontSize',14,'Color','k','FontAngle','italic'); +end +%if j == 1 + text(-1.7,1.8,'Fluor @ 685 nm (W m^{-2}\mum^{-1}sr^{-1})','FontSize',14) + h(3) = colorbar; +%end +axis off + +spfig3(3) = subplot(1,3,3); +z = pcolor(X_i,Y_i,Fluor_i2); hold on +set(z,'LineStyle','none') +% set(gca,'clim',[830 900]) +for k = 1:4 + plot(20*k/180*pi.*cos((-1:.01:1)*pi),20*k/180*pi.*sin((-1:.01:1)*pi),'Color',[1 1 1]) + text(20*k/180*pi-.2,.2,num2str(20*k),'FontSize',14,'Color',[1 1 1]); + text(xli(k),yli(k),num2str(90*(k-1)),'FontSize',14,'Color','k','FontAngle','italic'); +end +%if j == 1 + text(-1.7,1.8,'Fluor @ 740 nm (W m^{-2}\mum^{-1}sr^{-1})','FontSize',14) + h(3) = colorbar; +%end +axis off +% +% spfig3(4) = subplot(1,4,4); +% z = pcolor(X_i,Y_i,Fluor_i3); hold on +% set(z,'LineStyle','none') +% % set(gca,'clim',[520 555]) +% for k = 1:4 +% plot(20*k/180*pi.*cos((-1:.01:1)*pi),20*k/180*pi.*sin((-1:.01:1)*pi),'Color',[1 1 1]) +% text(20*k/180*pi-.2,.2,num2str(20*k),'FontSize',14,'Color',[1 1 1]); +% text(xli(k),yli(k),num2str(90*(k-1)),'FontSize',14,'Color','k','FontAngle','italic'); +% end +% %if j == 1 +% text(-1.7,1.8,'Fluor @ 755 nm (W m^{-2}\mum^{-1}sr^{-1})','FontSize',14) +% h(3) = colorbar; +% %end +axis off +%% +%set(h(:,:),'location','southoutside','FontSize',14) +resizefigure(spfig3,3,1,.07,.1,.1,.12, .9, .88) \ No newline at end of file diff --git a/src/not_used/progressbar.m b/src/not_used/progressbar.m new file mode 100644 index 00000000..a66bc39c --- /dev/null +++ b/src/not_used/progressbar.m @@ -0,0 +1,359 @@ +function progressbar(varargin) +% Description: +% progressbar() provides an indication of the progress of some task using +% graphics and text. Calling progressbar repeatedly will update the figure and +% automatically estimate the amount of time remaining. +% This implementation of progressbar is intended to be extremely simple to use +% while providing a high quality user experience. +% +% Features: +% - Can add progressbar to existing m-files with a single line of code. +% - Supports multiple bars in one figure to show progress of nested loops. +% - Optional labels on bars. +% - Figure closes automatically when task is complete. +% - Only one figure can exist so old figures don't clutter the desktop. +% - Remaining time estimate is accurate even if the figure gets closed. +% - Minimal execution time. Won't slow down code. +% - Randomized color. When a programmer gets bored... +% +% Example Function Calls For Single Bar Usage: +% progressbar % Initialize/reset +% progressbar(0) % Initialize/reset +% progressbar('Label') % Initialize/reset and label the bar +% progressbar(0.5) % Update +% progressbar(1) % Close +% +% Example Function Calls For Multi Bar Usage: +% progressbar(0, 0) % Initialize/reset two bars +% progressbar('A', '') % Initialize/reset two bars with one label +% progressbar('', 'B') % Initialize/reset two bars with one label +% progressbar('A', 'B') % Initialize/reset two bars with two labels +% progressbar(0.3) % Update 1st bar +% progressbar(0.3, []) % Update 1st bar +% progressbar([], 0.3) % Update 2nd bar +% progressbar(0.7, 0.9) % Update both bars +% progressbar(1) % Close +% progressbar(1, []) % Close +% progressbar(1, 0.4) % Close +% +% Notes: +% For best results, call progressbar with all zero (or all string) inputs +% before any processing. This sets the proper starting time reference to +% calculate time remaining. +% Bar color is choosen randomly when the figure is created or reset. Clicking +% the bar will cause a random color change. +% +% Demos: +% % Single bar +% m = 500; +% progressbar % Init single bar +% for i = 1:m +% pause(0.01) % Do something important +% progressbar(i/m) % Update progress bar +% end +% +% % Simple multi bar (update one bar at a time) +% m = 4; +% n = 3; +% p = 100; +% progressbar(0,0,0) % Init 3 bars +% for i = 1:m +% progressbar([],0) % Reset 2nd bar +% for j = 1:n +% progressbar([],[],0) % Reset 3rd bar +% for k = 1:p +% pause(0.01) % Do something important +% progressbar([],[],k/p) % Update 3rd bar +% end +% progressbar([],j/n) % Update 2nd bar +% end +% progressbar(i/m) % Update 1st bar +% end +% +% % Fancy multi bar (use labels and update all bars at once) +% m = 4; +% n = 3; +% p = 100; +% progressbar('Monte Carlo Trials','Simulation','Component') % Init 3 bars +% for i = 1:m +% for j = 1:n +% for k = 1:p +% pause(0.01) % Do something important +% % Update all bars +% frac3 = k/p; +% frac2 = ((j-1) + frac3) / n; +% frac1 = ((i-1) + frac2) / m; +% progressbar(frac1, frac2, frac3) +% end +% end +% end +% +% Author: +% Steve Hoelzer +% +% Revisions: +% 2002-Feb-27 Created function +% 2002-Mar-19 Updated title text order +% 2002-Apr-11 Use floor instead of round for percentdone +% 2002-Jun-06 Updated for speed using patch (Thanks to waitbar.m) +% 2002-Jun-19 Choose random patch color when a new figure is created +% 2002-Jun-24 Click on bar or axes to choose new random color +% 2002-Jun-27 Calc time left, reset progress bar when fractiondone == 0 +% 2002-Jun-28 Remove extraText var, add position var +% 2002-Jul-18 fractiondone input is optional +% 2002-Jul-19 Allow position to specify screen coordinates +% 2002-Jul-22 Clear vars used in color change callback routine +% 2002-Jul-29 Position input is always specified in pixels +% 2002-Sep-09 Change order of title bar text +% 2003-Jun-13 Change 'min' to 'm' because of built in function 'min' +% 2003-Sep-08 Use callback for changing color instead of string +% 2003-Sep-10 Use persistent vars for speed, modify titlebarstr +% 2003-Sep-25 Correct titlebarstr for 0% case +% 2003-Nov-25 Clear all persistent vars when percentdone = 100 +% 2004-Jan-22 Cleaner reset process, don't create figure if percentdone = 100 +% 2004-Jan-27 Handle incorrect position input +% 2004-Feb-16 Minimum time interval between updates +% 2004-Apr-01 Cleaner process of enforcing minimum time interval +% 2004-Oct-08 Seperate function for timeleftstr, expand to include days +% 2004-Oct-20 Efficient if-else structure for sec2timestr +% 2006-Sep-11 Width is a multiple of height (don't stretch on widescreens) +% 2010-Sep-21 Major overhaul to support multiple bars and add labels +% + +persistent progfig progdata lastupdate + +% Get inputs +if nargin > 0 + input = varargin; + ninput = nargin; +else + % If no inputs, init with a single bar + input = {0}; + ninput = 1; +end + +% If task completed, close figure and clear vars, then exit +if input{1} == 1 + if ishandle(progfig) + delete(progfig) % Close progress bar + end + clear progfig progdata lastupdate % Clear persistent vars + drawnow + return +end + +% Init reset flag +resetflag = false; + +% Set reset flag if first input is a string +if ischar(input{1}) + resetflag = true; +end + +% Set reset flag if all inputs are zero +if input{1} == 0 + % If the quick check above passes, need to check all inputs + if all([input{:}] == 0) && (length([input{:}]) == ninput) + resetflag = true; + end +end + +% Set reset flag if more inputs than bars +if ninput > length(progdata) + resetflag = true; +end + +% If reset needed, close figure and forget old data +if resetflag + if ishandle(progfig) + delete(progfig) % Close progress bar + end + progfig = []; + progdata = []; % Forget obsolete data +end + +% Create new progress bar if needed +if ishandle(progfig) +else % This strange if-else works when progfig is empty (~ishandle() does not) + + % Define figure size and axes padding for the single bar case + height = 0.03; + width = height * 8; + hpad = 0.02; + vpad = 0.25; + + % Figure out how many bars to draw + nbars = max(ninput, length(progdata)); + + % Adjust figure size and axes padding for number of bars + heightfactor = (1 - vpad) * nbars + vpad; + height = height * heightfactor; + vpad = vpad / heightfactor; + + % Initialize progress bar figure + left = (1 - width) / 2; + bottom = (1 - height) / 2; + progfig = figure(... + 'Units', 'normalized',... + 'Position', [left bottom width height],... + 'NumberTitle', 'off',... + 'Resize', 'off',... + 'MenuBar', 'none' ); + + % Initialize axes, patch, and text for each bar + left = hpad; + width = 1 - 2*hpad; + vpadtotal = vpad * (nbars + 1); + height = (1 - vpadtotal) / nbars; + for ndx = 1:nbars + % Create axes, patch, and text + bottom = vpad + (vpad + height) * (nbars - ndx); + progdata(ndx).progaxes = axes( ... + 'Position', [left bottom width height], ... + 'XLim', [0 1], ... + 'YLim', [0 1], ... + 'Box', 'on', ... + 'ytick', [], ... + 'xtick', [] ); + progdata(ndx).progpatch = patch( ... + 'XData', [0 0 0 0], ... + 'YData', [0 0 1 1] ); + progdata(ndx).progtext = text(0.99, 0.5, '', ... + 'HorizontalAlignment', 'Right', ... + 'FontUnits', 'Normalized', ... + 'FontSize', 0.7 ); + progdata(ndx).proglabel = text(0.01, 0.5, '', ... + 'HorizontalAlignment', 'Left', ... + 'FontUnits', 'Normalized', ... + 'FontSize', 0.7 ); + if ischar(input{ndx}) + set(progdata(ndx).proglabel, 'String', input{ndx}) + input{ndx} = 0; + end + + % Set callbacks to change color on mouse click + set(progdata(ndx).progaxes, 'ButtonDownFcn', {@changecolor, progdata(ndx).progpatch}) + set(progdata(ndx).progpatch, 'ButtonDownFcn', {@changecolor, progdata(ndx).progpatch}) + set(progdata(ndx).progtext, 'ButtonDownFcn', {@changecolor, progdata(ndx).progpatch}) + set(progdata(ndx).proglabel, 'ButtonDownFcn', {@changecolor, progdata(ndx).progpatch}) + + % Pick a random color for this patch + changecolor([], [], progdata(ndx).progpatch) + + % Set starting time reference + if ~isfield(progdata(ndx), 'starttime') || isempty(progdata(ndx).starttime) + progdata(ndx).starttime = clock; + end + end + + % Set time of last update to ensure a redraw + lastupdate = clock - 1; + +end + +% Process inputs and update state of progdata +for ndx = 1:ninput + if ~isempty(input{ndx}) + progdata(ndx).fractiondone = input{ndx}; + progdata(ndx).clock = clock; + end +end + +% Enforce a minimum time interval between graphics updates +myclock = clock; +if abs(myclock(6) - lastupdate(6)) < 0.01 % Could use etime() but this is faster + return +end + +% Update progress patch +for ndx = 1:length(progdata) + set(progdata(ndx).progpatch, 'XData', ... + [0, progdata(ndx).fractiondone, progdata(ndx).fractiondone, 0]) +end + +% Update progress text if there is more than one bar +if length(progdata) > 1 + for ndx = 1:length(progdata) + set(progdata(ndx).progtext, 'String', ... + sprintf('%1d%%', floor(100*progdata(ndx).fractiondone))) + end +end + +% Update progress figure title bar +if progdata(1).fractiondone > 0 + runtime = etime(progdata(1).clock, progdata(1).starttime); + timeleft = runtime / progdata(1).fractiondone - runtime; + timeleftstr = sec2timestr(timeleft); + titlebarstr = sprintf('%2d%% %s remaining', ... + floor(100*progdata(1).fractiondone), timeleftstr); +else + titlebarstr = ' 0%'; +end +set(progfig, 'Name', titlebarstr) + +% Force redraw to show changes +drawnow + +% Record time of this update +lastupdate = clock; + + +% ------------------------------------------------------------------------------ +function changecolor(h, e, progpatch) %#ok +% Change the color of the progress bar patch + +% Prevent color from being too dark or too light +colormin = 1.5; +colormax = 2.8; + +thiscolor = rand(1, 3); +while (sum(thiscolor) < colormin) || (sum(thiscolor) > colormax) + thiscolor = rand(1, 3); +end + +set(progpatch, 'FaceColor', thiscolor) + + +% ------------------------------------------------------------------------------ +function timestr = sec2timestr(sec) +% Convert a time measurement from seconds into a human readable string. + +% Convert seconds to other units +w = floor(sec/604800); % Weeks +sec = sec - w*604800; +d = floor(sec/86400); % Days +sec = sec - d*86400; +h = floor(sec/3600); % Hours +sec = sec - h*3600; +m = floor(sec/60); % Minutes +sec = sec - m*60; +s = floor(sec); % Seconds + +% Create time string +if w > 0 + if w > 9 + timestr = sprintf('%d week', w); + else + timestr = sprintf('%d week, %d day', w, d); + end +elseif d > 0 + if d > 9 + timestr = sprintf('%d day', d); + else + timestr = sprintf('%d day, %d hr', d, h); + end +elseif h > 0 + if h > 9 + timestr = sprintf('%d hr', h); + else + timestr = sprintf('%d hr, %d min', h, m); + end +elseif m > 0 + if m > 9 + timestr = sprintf('%d min', m); + else + timestr = sprintf('%d min, %d sec', m, s); + end +else + timestr = sprintf('%d sec', s); +end diff --git a/src/not_used/resizefigure.m b/src/not_used/resizefigure.m new file mode 100644 index 00000000..58161ae5 --- /dev/null +++ b/src/not_used/resizefigure.m @@ -0,0 +1,19 @@ +function resizefigure(spfig,nx,ny,xo,yo,xi,yi, xend, yend) + +if (nargin<9) + xend = .97; + yend = .97; +end + +dx = (xend - xo - (nx-1) * xi)/nx; +dy = (yend - yo - (ny-1) * yi)/ny; +NoPlots = nx*ny; + +for iy = ny:-1:1 + y = yo + (ny-iy) * (dy+yi); + for ix = 1:nx + plotno = ix + (iy-1)*nx; + x = xo + (ix-1) * (dx+xi); + set(spfig(plotno),'Position',[x y dx dy]) + end % for ix +end % for iy \ No newline at end of file diff --git a/src/not_used/vangenuchten.m b/src/not_used/vangenuchten.m new file mode 100644 index 00000000..52d1b398 --- /dev/null +++ b/src/not_used/vangenuchten.m @@ -0,0 +1,18 @@ +function out = vangenuchten(input,thetares, thetasat, alpha,n,option) +%h = vangenuchten(input,thetares, thetasat, alpha,n,option); +%if option not specified, or option <>1, h = input, and theta is calculated, otherwise theta = input, and h is calculated + + +m = 1-1/n; +%m = 1; + +if nargin>5 + if option ==1 + theta = input; + Se = (theta - thetares)/(thetasat - thetares); + out = -1/alpha*(Se.^(-1/m)-1).^(1/n); + end +else + h = input; + out = thetares + (thetasat-thetares)./(1+abs(alpha*h).^n).^m; +end \ No newline at end of file diff --git a/src/resistances.m b/src/resistances.m new file mode 100644 index 00000000..3a3b2dd0 --- /dev/null +++ b/src/resistances.m @@ -0,0 +1,175 @@ +function [resist_out] = resistances(resist_in) +% +% function resistances calculates aerodynamic and boundary resistances +% for soil and vegetation +% +% Date: 01 Feb 2008 +% Authors: Anne Verhoef (a.verhoef@reading.ac.uk) +% Christiaan van der Tol (tol@itc.nl) +% Joris Timmermans (j_timmermans@itc.nl) +% Source: Wallace and Verhoef (2000) 'Modelling interactions in +% mixed-plant communities: light, water and carbon dioxide', in: Bruce +% Marshall, Jeremy A. Roberts (ed), 'Leaf Development and Canopy Growth', +% Sheffield Academic Press, UK. ISBN 0849397693 +% +% ustar: Tennekes, H. (1973) 'The logaritmic wind profile', J. +% Atmospheric Science, 30, 234-238 +% Psih: Paulson, C.A. (1970), The mathematical +% representation of wind speed and temperature in the +% unstable atmospheric surface layer. J. Applied Meteorol. 9, +% 857-861 +% +% Note: Equation numbers refer to equation numbers in Wallace and Verhoef (2000) +% +% Usage: +% [resist_out] = resistances(resist_in) +% +% The input and output are structures. These structures are further +% specified in a readme file. +% +% Input: +% resist_in aerodynamic resistance parameters and wind speed +% +% The strucutre resist_in contains the following elements: +% u = windspeed +% L = stability +% LAI = Leaf Area Index + +% rbs = Boundary Resistance of soil [s m-1] +% rss = Surface resistance of soil for vapour transport [s m-1] +% rwc = Within canopy Aerodynamic Resistance canopy [s m-1] + +% z0m = Roughness lenght for momentum for the vegetation [m] +% d = Displacement height (Zero plane) [m] +% z = Measurement height [m] +% h = Vegetation height [m] + +% +% Output: +% resist_out aeorodynamic resistances +% +% The strucutre resist_out contains the following elements: +% ustar = Friction velocity [m s-1] +% raa = Aerodynamic resistance above the canopy [s m-1] +% rawc = Total resistance within the canopy (canopy) [s m-1] +% raws = Total resistance within the canopy (soil) [s m-1] + +% rai = Aerodynamic resistance in inertial sublayer [s m-1] +% rar = Aerodynamic resistance in roughness sublayer [s m-1] +% rac = Aerodynamic resistance in canopy layer (above z0+d) [s m-1] + +% rbc = Boundary layer resistance (canopy) [s m-1] +% rwc = Aerodynamic Resistance within canopy(canopy)(Update)[s m-1] + +% rbs = Boundary layer resistance (soil) (Update) [s m-1] +% rws = Aerodynamic resistance within canopy(soil) [s m-1] + +% rss = Surface resistance vapour transport(soil)(Update) [s m-1] + +% uz0 = windspeed at z0 [m s-1] +% Kh = Diffusivity for heat [m2s-1] + +%% parameters +global constants +kappa = constants. kappa; + +Cd = resist_in.Cd; + +u = resist_in.u; +L = resist_in.L; +LAI = resist_in.LAI; + +rbs = resist_in.rbs; +%rss = resist_in.rss; +rwc = resist_in.rwc; + +z0m = resist_in.zo; +d = resist_in.d; +z = resist_in.z; +h = resist_in.hc; +w = resist_in.w; + +% derived parameters +%zr: top of roughness sublayer, bottom of intertial sublayer +zr = 2.5*h; % [m] +%n: dimensionless wind extinction coefficient W&V Eq 33 +n = Cd*LAI/(2*kappa^2); % [] + +%% stability correction for non-neutral conditions +%neu = find(L >= -.001 & L <= .001); +unst = find(L < -4); +st = find(L > 4E3); + +% stability correction functions, friction velocity and Kh=Km=Kv +pm_z = psim(z -d,L,unst,st); +ph_z = psih(z -d,L,unst,st); +pm_h = psim(h -d,L,unst,st); +%ph_h = psih(h -d,L,unst,st); +ph_zr = psih(zr-d,L,unst,st).*(z>=zr) + ph_z.*(zzr).*(1./(kappa*ustar).*(log((z-d) /(zr-d)) - ph_z + ph_zr));% W&V Eq 41 +rar = 1./(kappa*ustar).*((zr-h)/(zr-d)) - phs_zr + phs_h;% W&V Eq 39 +rac = h*sinh(n)./(n*Kh)*(log((exp(n)-1)/(exp(n)+1)) - log((exp(n*(z0m+ d )/h)-1)/(exp(n*(z0m +d )/h)+1))); % W&V Eq 42 +rws = h*sinh(n)./(n*Kh)*(log((exp(n*(z0m+d)/h)-1)/(exp(n*(z0m+d)/h)+1)) - log((exp(n*(.01 )/h)-1)/(exp(n*(.01 )/h)+1))); % W&V Eq 43 +rbc = 70/LAI * sqrt(w./uz0); % W&V Eq 31, but slightly different + +resist_out.rai = rai; +resist_out.rar = rar; +resist_out.rac = rac; +resist_out.rws = rws; +resist_out.rbc = rbc; + +raa = rai + rar + rac; +rawc = rwc + rbc; +raws = rws + rbs; + +resist_out.raa = raa; % aerodynamic resistance above the canopy W&V Figure 8.6 +resist_out.rawc = rawc; % aerodynamic resistance within the canopy (canopy) +resist_out.raws = raws; % aerodynamic resistance within the canopy (soil) + +resist_out.raa = min(4E2,raa); % to prevent unrealistically high resistances +resist_out.rawc = min(4E2,rawc); % to prevent unrealistically high resistances +resist_out.raws = min(4E2,raws); % to prevent unrealistically high resistances + +return + + +%% subfunction pm for stability correction (eg. Paulson, 1970) +function pm = psim(z,L,unst,st) +x = (1-16*z./L(unst)).^(1/4); +pm = zeros(size(L)); +pm(unst) = 2*log((1+x)/2)+log((1+x.^2)/2) -2*atan(x)+pi/2; % unstable +pm(st) = -5*z./L(st); % stable +return + +%% subfunction ph for stability correction (eg. Paulson, 1970) +function ph = psih(z,L,unst,st) +x = (1-16*z./L(unst)).^(1/4); +ph = zeros(size(L)); +ph(unst) = 2*log((1+x.^2)/2); % unstable +ph(st) = -5*z./L(st); % stable +return + +%% subfunction ph for stability correction (eg. Paulson, 1970) +function phs = phstar(z,zR,d,L,st,unst) +x = (1-16*z./L(unst)).^0.25; +phs = zeros(size(L)); +phs(unst) = (z-d)/(zR-d)*(x.^2-1)./(x.^2+1); +phs(st) = -5*z./L(st); +return \ No newline at end of file