void veg_transmittance(long r, long c, double rm, double v, double Ts, double Tg, double z0soil, double LSAI, double decaycoeff0,
double z0veg, double d0veg, double Hveg, double u_top, double Lo, double *rb, double *rh, double *ra, double *decay, double Loc,
short stabcorr_incanopy){
//double Cs, Cs_bare, Cs_dense = 0.004;
double Lc = 0.4; //characteristic dimension of vegetation [m]
double u_star = pow(v/rm,0.5);
double u_veg;
double zm = d0veg + z0veg;
//double W = 1.0-exp(-LSAI);
double phi=1.0, philog;
//double W = 1.0;
double n = decaycoeff0;
//stability
//over canopy
if(Lo<0){
phi=pow(1.0-16.0*Hveg/Lo,-0.5);
}else{
phi=1.0+5.0*Hveg/Lo;
}
//phi=1.0;
//under canopy
if(Loc<0){
philog=pow(1.0-15.0*zm/Loc,-0.25);
}else{
philog=1.0+4.7*zm/Loc;
}
if(stabcorr_incanopy==1) n=Fmin(1.E+5, n*pow(philog,0.5));
*decay=n;
//update aerodynamic resistance
//*ra=*ra + (Hveg/(n*ka*u_star*(Hveg-d0veg)/phi))*(exp(n*(1.0-zm/Hveg))-1.0);
//Zeng
//u_veg=u_star;
//Huntingford
u_veg=Fmax(0.001,u_top*exp(n*(zm/Hveg-1.0)));
//canopy resistance
*rb=Fmin(1.E20, 70.0*pow(Lc/u_veg,0.5));
//ground resistance
//Zeng
//Cs_bare=(pow(z0soil*u_star/1.5E-5,-0.45)*ka/0.13);
//*rh=1.0/( (W*Cs_dense + (1.0-W)*Cs_bare) * u_star);
//Huntingford
*rh=Fmin(1.E20,(Hveg*exp(n)/(n*ka*u_star*(Hveg-d0veg)/phi))*(exp(-n*z0soil/Hveg)-exp(-n*zm/Hveg)));
if(n<10) *rh=*rh+pow((exp(n)-exp(n*(1.-d0veg/Hveg)))*Hveg/(n*d0veg),0.45)*(u_star*2./ka);
}
void canopy_snow_interception(double snow_max_loading, double LSAI, double Psnow, double Tc, double v, double Dt,
double *max_storage, double *storage, double *drip){
double load, unload;
double CT=1.87E5, CV=1.56E5;
*max_storage = snow_max_loading*LSAI;
load = ( (*max_storage) - (*storage) ) * (1. - exp(-Psnow/(*max_storage))); //Niu & Yang, 2004
*storage = (*storage) + load;
*drip = Psnow - load;
if((*storage)>(*max_storage)){
*drip = *drip - ( (*max_storage) - (*storage) );
*storage = (*max_storage);
}
unload = Fmin(*storage, (*storage)*(Fmax(0.0, Tc+3.0)/CT + v/CV)*Dt);
if(unload<0.1) unload=0.0; //prevents very low snowfalls
*drip = *drip + unload;
*storage = (*storage) - unload;
}
void turbulent_fluxes(double rh, double rv, double P, double Ta, double T, double Qa, double Q, double dQdT,
double *H, double *dHdT, double *E, double *dEdT){
double rho, cp, pot;
rho=air_density(0.5*(Ta+T), Qa, P);
cp=air_cp(0.5*(Ta+T));
//pot=pow((1000.0/P),(0.286*(1-0.23*Qa)));
pot=1.0;
//sensible heat flux [W/m2]
/*a maximum value of the resistance for the sensible heat flux was introduced according to Jordan et el., 1999
(HEAT BUDGET OF SNOW-COVERED SEA ICE AT NORTH POLE 4) as Cwindless=0.5 W m^2 K^-1, rh=rho*cp/C=1300/0.5=2600*/
*H=cp*rho*pot*(T-Ta)/Fmin(rh,2.6E3);
*dHdT=cp*rho*pot/Fmin(rh,2.6E3);
//*H=cp*rho*pot*(T-Ta)/rh;
//*dHdT=cp*rho*pot/rh;
//evaporation [kg/(s*m2)]
*E=rho*(Q-Qa)/rv;
*dEdT=rho*dQdT/rv;
}
void MatterStable::TwoPhaseBoundary::FindMinMax(
VecCl &V,
int CentInd,
double &ResV,
double &ResP,
int Min) {
IntegralFunc_Add = 0;
if(Min)
IntegralFunc_Negative = 0;
else
IntegralFunc_Negative = 1;
ResV = Fmin(
IntegralFunc_PV_Int_Static,
V[min(CentInd + 2, NumPnt)],
V[max(1, CentInd - 2)],
V[CentInd],
Mis * 0.1,
ResP);
if(!Min)
ResP = -ResP;
}
void PGCicrcleTaskPt::Optimize(const ProjPt& prev, const ProjPt& next, double Alt) {
if(m_Radius == 0.0){
return;
}
if (!m_Optimized) {
// first run : init m_Optimized with center ...
m_Optimized = m_Center;
}
if (!CrossPoint(prev, next ? next : m_Center, m_Optimized)) {
OptimizedDistance Fmin(prev, m_Center, next, m_Radius);
double x0 = 0;
double d1 = min_newuoa<double, OptimizedDistance > (1, &x0, Fmin, PI, 0.01 / m_Radius);
if (m_bExit) {
double x1 = x0 + PI;
double d2 = min_newuoa<double, OptimizedDistance > (1, &x1, Fmin, PI, 0.01 / m_Radius);
x0 = (std::min(d1, d2) == d1) ? x0 : x1;
}
m_Optimized = ProjPt(m_Center.m_X + m_Radius * cos(x0), m_Center.m_Y + m_Radius * sin(x0));
}
}
static ut64 getFunctionSize(Sdb *db) {
#if 1
ut64 min = sdb_num_get (db, Fmin (addr), NULL);
ut64 max = sdb_num_get (db, Fmax (addr), NULL);
#else
ut64 min, max;
char *c, *bbs = sdb_get (db, "bbs", NULL);
int first = 1;
sdb_aforeach (c, bbs) {
ut64 addr = sdb_atoi (c);
ut64 addr_end = sdb_num_get (db, Fbb(addr), NULL);
if (first) {
min = addr;
max = addr_end;
first = 0;
} else {
if (addr<min)
min = addr;
if (addr_end>max)
max = addr_end;
}
sdb_aforeach_next (c);
}
bool Neuron::SetData(const std::string &strDataType, const std::string &strValue, bool bThrowError)
{
std::string strType = Std_CheckString(strDataType);
if(Node::SetData(strDataType, strValue, false))
return true;
if(strType == "CM")
{
Cn(atof(strValue.c_str()));
return true;
}
if(strType == "GM")
{
Gn(atof(strValue.c_str()));
return true;
}
if(strType == "VTH")
{
Vth(atof(strValue.c_str()));
return true;
}
if(strType == "VREST")
{
Vrest(atof(strValue.c_str()));
return true;
}
if(strType == "RELATIVEACCOMMODATION")
{
RelativeAccommodation(atof(strValue.c_str()));
return true;
}
if(strType == "ACCOMMODATIONTIMECONSTANT")
{
AccommodationTimeConstant(atof(strValue.c_str()));
return true;
}
if(strType == "VNOISEMAX")
{
VNoiseMax(atof(strValue.c_str()));
return true;
}
if(strType == "FMIN")
{
Fmin(atof(strValue.c_str()));
return true;
}
if(strType == "GAIN")
{
Gain(atof(strValue.c_str()));
return true;
}
if(strType == "GAINTYPE")
{
GainType(Std_ToBool(strValue));
return true;
}
if(strType == "ADDEXTERNALCURRENT")
{
AddExternalI(atof(strValue.c_str()));
return true;
}
if(strType == "IINIT")
{
Iinit(atof(strValue.c_str()));
return true;
}
if(strType == "INITTIME")
{
InitTime(atof(strValue.c_str()));
return true;
}
//If it was not one of those above then we have a problem.
if(bThrowError)
THROW_PARAM_ERROR(Al_Err_lInvalidDataType, Al_Err_strInvalidDataType, "Data Type", strDataType);
return false;
}
void Neuron::Load(CStdXml &oXml)
{
int iCount, iIndex;
Node::Load(oXml);
oXml.IntoElem(); //Into Neuron Element
m_arySynapses.RemoveAll();
Enabled(oXml.GetChildBool("Enabled", true));
Cn(oXml.GetChildFloat("Cn"));
Gn(oXml.GetChildFloat("Gn"));
Vrest(oXml.GetChildFloat("Vrest", 0));
Vth(oXml.GetChildFloat("Vth"));
Fmin(oXml.GetChildFloat("Fmin"));
Gain(oXml.GetChildFloat("Gain"));
ExternalI(oXml.GetChildFloat("ExternalI"));
VNoiseMax(fabs(oXml.GetChildFloat("VNoiseMax", m_fltVNoiseMax)));
Iinit(oXml.GetChildFloat("Iinit", m_fltIinit));
InitTime(oXml.GetChildFloat("InitTime", m_fltInitTime));
m_fltVndisp = m_fltVrest;
m_fltVthdisp = m_fltVrest + m_fltVth;
GainType(oXml.GetChildBool("GainType", true));
m_aryVth[0] = m_aryVth[1] = m_fltVth;
if(m_fltVNoiseMax != 0)
UseNoise(true);
else
UseNoise(false);
RelativeAccommodation(fabs(oXml.GetChildFloat("RelativeAccom", m_fltRelativeAccom)));
AccommodationTimeConstant(fabs(oXml.GetChildFloat("AccomTimeConst", m_fltAccomTimeConst)));
if(m_fltRelativeAccom != 0)
UseAccom(true);
else
UseAccom(false);
//*** Begin Loading Synapses. *****
if(oXml.FindChildElement("Synapses", false))
{
oXml.IntoElem(); //Into Synapses Element
iCount = oXml.NumberOfChildren();
for(iIndex=0; iIndex<iCount; iIndex++)
{
oXml.FindChildByIndex(iIndex);
LoadSynapse(oXml);
}
oXml.OutOfElem();
}
//*** End Loading Synapses. *****
oXml.OutOfElem(); //OutOf Neuron Element
}
long BiCGSTAB_upper(double tol_rel, double tol_min, double tol_max, DOUBLEVECTOR *x, DOUBLEVECTOR *b,
LONGVECTOR *Ai, LONGVECTOR *Ap, DOUBLEVECTOR *Ax){
DOUBLEVECTOR *r0, *r, *p, *v, *s, *t, *diag, *udiag, *y, *z;
double rho, rho1, alpha, omeg, beta, norm_r0;
long i=0, j;
r0 = new_doublevector(x->nh);
r = new_doublevector(x->nh);
p = new_doublevector(x->nh);
v = new_doublevector(x->nh);
s = new_doublevector(x->nh);
t = new_doublevector(x->nh);
diag = new_doublevector(x->nh);
udiag = new_doublevector(x->nh-1);
y = new_doublevector(x->nh);
z = new_doublevector(x->nh);
get_diag_upper_matrix(diag, udiag, Ai, Ap, Ax);
product_using_only_upper_diagonal_part(r, x, Ai, Ap, Ax);
for (j=x->nl;j<=x->nh;j++ ) {
r->co[j] = b->co[j] - r->co[j];
r0->co[j] = r->co[j];
p->co[j] = 0.;
v->co[j] = 0.;
}
norm_r0 = norm_2(r0,r0->nh);
rho = 1.;
alpha = 1.;
omeg = 1.;
while ( i<=x->nh && norm_2(r,r->nh) > Fmax( tol_min , Fmin( tol_max , tol_rel*norm_r0) ) ) {
rho1 = product(r0, r);
beta = (rho1/rho)*(alpha/omeg);
rho = rho1;
for (j=x->nl;j<=x->nh;j++ ) {
p->co[j] = r->co[j] + beta*(p->co[j] - omeg*v->co[j]);
}
tridiag(0, 0, 0, x->nh, udiag, diag, udiag, p, y);
product_using_only_upper_diagonal_part(v, y, Ai, Ap, Ax);
alpha = rho/product(r0, v);
for (j=x->nl;j<=x->nh;j++ ) {
s->co[j] = r->co[j] - alpha*v->co[j];
}
tridiag(0, 0, 0, x->nh, udiag, diag, udiag, s, z);
product_using_only_upper_diagonal_part(t, z, Ai, Ap, Ax);
omeg = product(t, s)/product(t, t);
for (j=x->nl;j<=x->nh;j++ ) {
x->co[j] += (alpha*y->co[j] + omeg*z->co[j]);
r->co[j] = s->co[j] - omeg*t->co[j];
}
i++;
//printf("i:%ld normr0:%e normr:%e\n",i,norm_r0,norm_2(r,r->nh));
}
free_doublevector(r0);
free_doublevector(r);
free_doublevector(p);
free_doublevector(v);
free_doublevector(s);
free_doublevector(t);
free_doublevector(diag);
free_doublevector(udiag);
free_doublevector(y);
free_doublevector(z);
return i;
}
long BiCGSTAB_diag(double tol_rel, double tol_min, double tol_max, DOUBLEVECTOR *x, DOUBLEVECTOR *b,
LONGVECTOR *Li, LONGVECTOR *Lp, DOUBLEVECTOR *Lx){
DOUBLEVECTOR *r0, *r, *p, *v, *s, *t, *y, *z, *d;
//DOUBLEVECTOR *ss, *tt;
double rho, rho1, alpha, omeg, beta, norm_r0;
long i=0, j, jlim;
r0 = new_doublevector(x->nh);
r = new_doublevector(x->nh);
p = new_doublevector(x->nh);
v = new_doublevector(x->nh);
s = new_doublevector(x->nh);
t = new_doublevector(x->nh);
y = new_doublevector(x->nh);
z = new_doublevector(x->nh);
d = new_doublevector(x->nh);
//ss = new_doublevector(x->nh);
//tt = new_doublevector(x->nh);
for(j=1;j<=x->nh;j++){
if(j>1){
jlim = Lp->co[j-1]+1;
}else{
jlim = 1;
}
d->co[j] = Lx->co[jlim];
}
product_using_only_lower_diagonal_part(r, x, Li, Lp, Lx);
for (j=x->nl;j<=x->nh;j++ ) {
r->co[j] = b->co[j] - r->co[j];
r0->co[j] = r->co[j];
p->co[j] = 0.;
v->co[j] = 0.;
}
norm_r0 = norm_2(r0,r0->nh);
rho = 1.;
alpha = 1.;
omeg = 1.;
while ( i<=x->nh && norm_2(r,r->nh) > Fmax( tol_min , Fmin( tol_max , tol_rel*norm_r0) ) ) {
rho1 = product(r0, r);
beta = (rho1/rho)*(alpha/omeg);
rho = rho1;
for (j=x->nl;j<=x->nh;j++ ) {
p->co[j] = r->co[j] + beta*(p->co[j] - omeg*v->co[j]);
y->co[j] = p->co[j]/d->co[j];
}
product_using_only_lower_diagonal_part(v, y, Li, Lp, Lx);
alpha = rho/product(r0, v);
for (j=x->nl;j<=x->nh;j++ ) {
s->co[j] = r->co[j] - alpha*v->co[j];
z->co[j] = s->co[j]/d->co[j];
}
product_using_only_lower_diagonal_part(t, z, Li, Lp, Lx);
omeg = product(t, s)/product(t, t);
for (j=x->nl;j<=x->nh;j++ ) {
x->co[j] += (alpha*y->co[j] + omeg*z->co[j]);
r->co[j] = s->co[j] - omeg*t->co[j];
}
i++;
printf("i:%ld normr0:%e normr:%e\n",i,norm_r0,norm_2(r,r->nh));
}
free_doublevector(r0);
free_doublevector(r);
free_doublevector(p);
free_doublevector(v);
free_doublevector(s);
free_doublevector(t);
free_doublevector(y);
free_doublevector(z);
free_doublevector(d);
//free_doublevector(ss);
//free_doublevector(tt);
return i;
}
long BiCGSTAB_unpreconditioned(double tol_rel, double tol_min, double tol_max, DOUBLEVECTOR *x, DOUBLEVECTOR *b,
LONGVECTOR *Li, LONGVECTOR *Lp, DOUBLEVECTOR *Lx){
DOUBLEVECTOR *r0, *r, *p, *v, *s, *t;
double rho, rho1, alpha, omeg, beta, norm_r0;
long i=0, j;
r0 = new_doublevector(x->nh);
r = new_doublevector(x->nh);
p = new_doublevector(x->nh);
v = new_doublevector(x->nh);
s = new_doublevector(x->nh);
t = new_doublevector(x->nh);
product_using_only_lower_diagonal_part(r, x, Li, Lp, Lx);
for (j=x->nl;j<=x->nh;j++ ) {
r->co[j] = b->co[j] - r->co[j];
r0->co[j] = r->co[j];
p->co[j] = 0.;
v->co[j] = 0.;
}
norm_r0 = norm_2(r0,r0->nh);
rho = 1.;
alpha = 1.;
omeg = 1.;
while ( i<=x->nh && norm_2(r,r->nh) > Fmax( tol_min , Fmin( tol_max , tol_rel*norm_r0) ) ) {
rho1 = product(r0, r);
beta = (rho1/rho)*(alpha/omeg);
rho = rho1;
for (j=x->nl;j<=x->nh;j++ ) {
p->co[j] = r->co[j] + beta*(p->co[j] - omeg*v->co[j]);
}
product_using_only_lower_diagonal_part(v, p, Li, Lp, Lx);
alpha = rho/product(r0, v);
for (j=x->nl;j<=x->nh;j++ ) {
s->co[j] = r->co[j] - alpha*v->co[j];
}
product_using_only_lower_diagonal_part(t, s, Li, Lp, Lx);
omeg = product(t, s)/product(t, t);
for (j=x->nl;j<=x->nh;j++ ) {
x->co[j] += (alpha*p->co[j] + omeg*s->co[j]);
r->co[j] = s->co[j] - omeg*t->co[j];
}
i++;
printf("i:%ld normr0:%e normr:%e\n",i,norm_r0,norm_2(r,r->nh));
}
free_doublevector(r0);
free_doublevector(r);
free_doublevector(p);
free_doublevector(v);
free_doublevector(s);
free_doublevector(t);
return i;
}
long BiCGSTAB(double tol_rel, double tol_min, double tol_max, DOUBLEVECTOR *x, DOUBLEVECTOR *x0,
double dt, DOUBLEVECTOR *b, t_Matrix_element_with_voidp function, void *data){
/* \author Stefano Endrizzi
\date March 2010
from BI-CGSTAB: A FAST AND SMOOTHLY CONVERGING VARIANT OF BI-CG FOR THE SOLUTION OF NONSYMMETRIC LINEAR SYSTEMS
by H. A. VAN DER VORST - SIAM J. ScI. STAT. COMPUT. Vol. 13, No. 2, pp. 631-644, March 1992
*/
DOUBLEVECTOR *r0, *r, *p, *v, *s, *t, *diag, *udiag, *y, *z;
//DOUBLEVECTOR *tt, *ss;
double rho, rho1, alpha, omeg, beta, norm_r0;
long i=0, j;
r0 = new_doublevector(x->nh);
r = new_doublevector(x->nh);
p = new_doublevector(x->nh);
v = new_doublevector(x->nh);
s = new_doublevector(x->nh);
t = new_doublevector(x->nh);
diag = new_doublevector(x->nh);
udiag = new_doublevector(x->nh-1);
y = new_doublevector(x->nh);
z = new_doublevector(x->nh);
//tt = new_doublevector(x->nh);
//ss = new_doublevector(x->nh);
get_diagonal(diag,x0,dt,function,data);
get_upper_diagonal(udiag,x0,dt,function,data);
for (j=x->nl;j<=x->nh;j++ ) {
r0->co[j] = b->co[j] - (*function)(j,x,x0,dt,data);
r->co[j] = r0->co[j];
p->co[j] = 0.;
v->co[j] = 0.;
}
norm_r0 = norm_2(r0,r0->nh);
rho = 1.;
alpha = 1.;
omeg = 1.;
while ( i<=x->nh && norm_2(r,r->nh) > Fmax( tol_min , Fmin( tol_max , tol_rel*norm_r0) ) ) {
rho1 = product(r0, r);
beta = (rho1/rho)*(alpha/omeg);
rho = rho1;
for (j=x->nl;j<=x->nh;j++ ) {
p->co[j] = r->co[j] + beta*(p->co[j] - omeg*v->co[j]);
}
tridiag(0, 0, 0, x->nh, udiag, diag, udiag, p, y);
for (j=x->nl;j<=x->nh;j++ ) {
v->co[j] = (*function)(j,y,x0,dt,data);
}
alpha = rho/product(r0, v);
for (j=x->nl;j<=x->nh;j++ ) {
s->co[j] = r->co[j] - alpha*v->co[j];
}
tridiag(0, 0, 0, x->nh, udiag, diag, udiag, s, z);
for (j=x->nl;j<=x->nh;j++ ) {
t->co[j] = (*function)(j,z,x0,dt,data);
}
/*tridiag(0, 0, 0, x->nh, udiag, diag, udiag, t, tt);
tridiag(0, 0, 0, x->nh, udiag, diag, udiag, s, ss);
omeg = product(tt, ss)/product(tt, tt);*/
omeg = product(t, s)/product(t, t);
for (j=x->nl;j<=x->nh;j++ ) {
x->co[j] += (alpha*y->co[j] + omeg*z->co[j]);
r->co[j] = s->co[j] - omeg*t->co[j];
}
i++;
//printf("i:%ld normr0:%e normr:%e\n",i,norm_r0,norm_2(r,r->nh));
}
free_doublevector(r0);
free_doublevector(r);
free_doublevector(p);
free_doublevector(v);
free_doublevector(s);
free_doublevector(t);
free_doublevector(diag);
free_doublevector(udiag);
free_doublevector(y);
free_doublevector(z);
//free_doublevector(tt);
//free_doublevector(ss);
return i;
}
long BiCGSTAB_strict_lower_matrix_plus_identity_by_vector(double tol_rel, double tol_min, double tol_max, DOUBLEVECTOR *x,
DOUBLEVECTOR *b, DOUBLEVECTOR *y, LONGVECTOR *Li, LONGVECTOR *Lp, DOUBLEVECTOR *Lx){
//solve sistem (A+Iy)*x = B, find x
//A M-matrix described by its lower diagonal part
DOUBLEVECTOR *r0, *r, *p, *v, *s, *t, *diag, *udiag, *yy, *z;
double rho, rho1, alpha, omeg, beta, norm_r0;
long i=0, j;
r0 = new_doublevector(x->nh);
r = new_doublevector(x->nh);
p = new_doublevector(x->nh);
v = new_doublevector(x->nh);
s = new_doublevector(x->nh);
t = new_doublevector(x->nh);
diag = new_doublevector(x->nh);
udiag = new_doublevector(x->nh-1);
yy = new_doublevector(x->nh);
z = new_doublevector(x->nh);
get_diag_strict_lower_matrix_plus_identity_by_vector(diag, udiag, y, Li, Lp, Lx);
//product_using_only_strict_lower_diagonal_part_plus_identity_by_vector(r, x, y, Li, Lp, Lx);
for (j=x->nl;j<=x->nh;j++ ) {
//r->co[j] = b->co[j] - r->co[j];
r->co[j] = b->co[j];
r0->co[j] = r->co[j];
p->co[j] = 0.;
v->co[j] = 0.;
}
norm_r0 = norm_2(r0,r0->nh);
rho = 1.;
alpha = 1.;
omeg = 1.;
while ( i<=x->nh && norm_2(r,r->nh) > Fmax( tol_min , Fmin( tol_max , tol_rel*norm_r0) ) ) {
rho1 = product(r0, r);
beta = (rho1/rho)*(alpha/omeg);
rho = rho1;
for (j=x->nl;j<=x->nh;j++ ) {
p->co[j] = r->co[j] + beta*(p->co[j] - omeg*v->co[j]);
}
tridiag(0, 0, 0, x->nh, udiag, diag, udiag, p, yy);
product_using_only_strict_lower_diagonal_part_plus_identity_by_vector(v, yy, y, Li, Lp, Lx);
alpha = rho/product(r0, v);
for (j=x->nl;j<=x->nh;j++ ) {
s->co[j] = r->co[j] - alpha*v->co[j];
}
if(norm_2(s,s->nh)>1.E-10){
tridiag(0, 0, 0, x->nh, udiag, diag, udiag, s, z);
product_using_only_strict_lower_diagonal_part_plus_identity_by_vector(t, z, y, Li, Lp, Lx);
omeg = product(t, s)/product(t, t);
for (j=x->nl;j<=x->nh;j++ ) {
x->co[j] += (alpha*yy->co[j] + omeg*z->co[j]);
r->co[j] = s->co[j] - omeg*t->co[j];
}
}else{
for (j=x->nl;j<=x->nh;j++ ) {
x->co[j] += alpha*yy->co[j];
r->co[j] = s->co[j];
}
}
i++;
//printf("i:%ld normr0:%e normr:%e\n",i,norm_r0,norm_2(r,r->nh));
}
free_doublevector(r0);
free_doublevector(r);
free_doublevector(p);
free_doublevector(v);
free_doublevector(s);
free_doublevector(t);
free_doublevector(diag);
free_doublevector(udiag);
free_doublevector(yy);
free_doublevector(z);
return i;
}
long CG(double tol_rel, double tol_min, double tol_max, DOUBLEVECTOR *x, DOUBLEVECTOR *x0, double dt,
DOUBLEVECTOR *b, t_Matrix_element_with_voidp function, void *data){
/*!
*\param icnt - (long) number of reiterations
*\param epsilon - (double) required tollerance (2-order norm of the residuals)
*\param x - (DOUBLEVECTOR *) vector of the unknowns x in Ax=b
*\param b - (DOUBLEVECTOR *) vector of b in Ax=b
*\param funz - (t_Matrix_element_with_voidp) - (int) pointer to the application A (x and y doublevector y=A(param)x ) it return 0 in case of success, -1 otherwise.
*\param data - (void *) data and parameters related to the argurment t_Matrix_element_with_voidp funz
*
*
*\brief algorithm proposed by Jonathan Richard Shewckuck in http://www.cs.cmu.edu/~jrs/jrspapers.html#cg and http://www.cs.cmu.edu/~quake-papers/painless-conjugate-gradient.pdf
*
* \author Emanuele Cordano
* \date June 2009
*
*\return the number of reitarations
*/
double delta,alpha,beta,delta_new;
DOUBLEVECTOR *r, *d,*q,*y,*sr,*diag,*udiag;
int sl;
long icnt_max;
long icnt;
long j;
double p;
double norm_r0;
r=new_doublevector(x->nh);
d=new_doublevector(x->nh);
q=new_doublevector(x->nh);
y=new_doublevector(x->nh);
sr=new_doublevector(x->nh);
diag=new_doublevector(x->nh);
udiag=new_doublevector(x->nh-1);
icnt=0;
icnt_max=x->nh;
//icnt_max=(long)(sqrt((double)x->nh));
for (j=x->nl;j<=x->nh;j++){
y->co[j]=(*function)(j,x,x0,dt,data);
}
get_diagonal(diag,x0,dt,function,data);
get_upper_diagonal(udiag,x0,dt,function,data);
delta_new=0.0;
for (j=y->nl;j<=y->nh;j++) {
r->co[j]=b->co[j]-y->co[j];
if (diag->co[j]<0.0) {
diag->co[j]=1.0;
printf("\n Error in jacobi_preconditioned_conjugate_gradient_search function: diagonal of the matrix (%lf) is negative at %ld \n",diag->co[j],j);
stop_execution();
}
}
tridiag(0,0,0,x->nh,udiag,diag,udiag,r,d);
for (j=y->nl;j<=y->nh;j++) {
//d->co[j]=r->co[j]/diag->co[j];
delta_new+=r->co[j]*d->co[j];
}
norm_r0 = norm_2(r, r->nh);
while ( icnt<=icnt_max && norm_2(r, r->nh) > Fmax( tol_min , Fmin( tol_max , tol_rel*norm_r0) ) ) {
delta=delta_new;
p=0.0;
for(j=q->nl;j<=q->nh;j++) {
q->co[j]=(*function)(j,d,x0,dt,data);
p+=q->co[j]*d->co[j];
}
alpha=delta_new/p;
for(j=x->nl;j<=x->nh;j++) {
x->co[j]=x->co[j]+alpha*d->co[j];
}
delta_new=0.0;
sl=0;
for (j=y->nl;j<=y->nh;j++) {
if (icnt%MAX_ITERATIONS==0) {
y->co[j]=(*function)(j,x,x0,dt,data);
r->co[j]=b->co[j]-y->co[j];
} else {
r->co[j]=r->co[j]-alpha*q->co[j];
}
}
tridiag(0,0,0,x->nh,udiag,diag,udiag,r,sr);
for (j=y->nl;j<=y->nh;j++) {
delta_new+=sr->co[j]*r->co[j];
}
beta=delta_new/delta;
for (j=d->nl;j<=d->nh;j++) {
d->co[j]=sr->co[j]+beta*d->co[j];
}
icnt++;
//printf("i:%ld normr0:%e normr:%e\n",icnt,norm_r0,norm_2(r,r->nh));
}
//printf("norm_r:%e\n",norm_2(r,r->nh));
free_doublevector(udiag);
free_doublevector(diag);
free_doublevector(sr);
free_doublevector(r);
free_doublevector(d);
free_doublevector(q);
free_doublevector(y);
return icnt;
}
long BiCGSTAB_LU_SSOR(double w, double tol_rel, double tol_min, double tol_max, DOUBLEVECTOR *x, DOUBLEVECTOR *b,
LONGVECTOR *Li, LONGVECTOR *Lp, DOUBLEVECTOR *Lx, LONGVECTOR *Ui, LONGVECTOR *Up, DOUBLEVECTOR *Ux){
DOUBLEVECTOR *r0, *r, *p, *v, *s, *t, *y, *z, *ss, *tt;
double rho, rho1, alpha, omeg, beta, norm_r0;
long i=0, j;
r0 = new_doublevector(x->nh);
r = new_doublevector(x->nh);
p = new_doublevector(x->nh);
v = new_doublevector(x->nh);
s = new_doublevector(x->nh);
t = new_doublevector(x->nh);
y = new_doublevector(x->nh);
z = new_doublevector(x->nh);
ss = new_doublevector(x->nh);
tt = new_doublevector(x->nh);
product_using_only_upper_diagonal_part(r, x, Ui, Up, Ux);
for (j=x->nl;j<=x->nh;j++ ) {
r->co[j] = b->co[j] - r->co[j];
r0->co[j] = r->co[j];
p->co[j] = 0.;
v->co[j] = 0.;
}
norm_r0 = norm_2(r0,r0->nh);
rho = 1.;
alpha = 1.;
omeg = 1.;
while ( i<=x->nh && norm_2(r,r->nh) > Fmax( tol_min , Fmin( tol_max , tol_rel*norm_r0) ) ) {
rho1 = product(r0, r);
beta = (rho1/rho)*(alpha/omeg);
rho = rho1;
for (j=x->nl;j<=x->nh;j++ ) {
p->co[j] = r->co[j] + beta*(p->co[j] - omeg*v->co[j]);
}
solve_SSOR_preconditioning(w, y, p, Li, Lp, Lx, Ui, Up, Ux);
product_using_only_upper_diagonal_part(v, y, Ui, Up, Ux);
alpha = rho/product(r0, v);
for (j=x->nl;j<=x->nh;j++ ) {
s->co[j] = r->co[j] - alpha*v->co[j];
}
solve_SSOR_preconditioning(w, z, s, Li, Lp, Lx, Ui, Up, Ux);
product_using_only_upper_diagonal_part(t, z, Ui, Up, Ux);
solve_lower_diagonal_system(tt, t, Ui, Up, Ux);
solve_lower_diagonal_system(ss, s, Ui, Up, Ux);
omeg = product(tt, ss)/product(tt, tt);
for (j=x->nl;j<=x->nh;j++ ) {
x->co[j] += (alpha*y->co[j] + omeg*z->co[j]);
r->co[j] = s->co[j] - omeg*t->co[j];
}
i++;
printf("i:%ld normr0:%e normr:%e\n",i,norm_r0,norm_2(r,r->nh));
}
free_doublevector(r0);
free_doublevector(r);
free_doublevector(p);
free_doublevector(v);
free_doublevector(s);
free_doublevector(t);
free_doublevector(y);
free_doublevector(z);
free_doublevector(ss);
free_doublevector(tt);
return i;
}
void Tcanopy(long r, long c, double Tv0, double Tg, double Qg, double dQgdT, double Tg0, double Qg0, double Ta, double Qa,
double zmu, double zmT, double z0, double z0s, double d0, double z0r, double hveg, double v, double LR, double P,
double SW, double SWv, double LW, double e, double LSAI, double decaycoeff0, double *land, double Wcrn0, double Wcrnmax,
double Wcsn0, double Wcsnmax, double *dWcrn, double *dWcsn, double *LWv, double *LWg, double *Hv, double *Hg,
double *dHgdT, double *LEv, double *Eg, double *dEgdT, double *Ts, double *Qs, double *froot, double *theta,
DOUBLEVECTOR *soil_transp_layer, double *Lobukhov, PAR *par, long n, double *rh, double *rv, double *rc, double *rb,
double *r_uc, double *u_top, double *Etrans, double *Tv, double *Qv, double *decay, double *Locc,
double *LWup_above_v, double psi, double **soil, double *T, DOUBLEVECTOR *soil_evap_layer){
double C, C0;
double A=1.0;
double T00=Tv0, T10, T11=Tv0, T11p=Tv0, DT, Wcrn=Wcrn0, Wcsn=Wcsn0;
double err0, err1=1.E+99, nw;
double Lobukhov0, h0=0.0, h1, dhdT, dQ;
double subl_can, melt_can, fwliq, fwice;
double alpha, beta;
long cont, cont2, chgsgn=0;
short a=0;
//vegetation thermal capacity
//C0=0.02*LSAI*c_liq + c_ice*Wcsn + c_liq*Wcrn;
C0=land[jcd]*LSAI*c_can + c_ice*Wcsn + c_liq*Wcrn;
C=C0;
fwliq=pow(Wcrn/Wcrnmax,2./3.);
fwice=pow(Wcsn/Wcsnmax,2./3.);
//calculates values at the instant t0 -> h0
if(A<1){
*Ts=0.5*Tg0+0.5*Ta;
*Qs=0.5*Qg0+0.5*Qa;
canopy_fluxes(r, c, T00, Tg0, Ta, Qg0, Qa, zmu, zmT, z0, z0s, d0, z0r, hveg, v, LR, P, SW, LW, e, LSAI, decaycoeff0, land,
Wcrn0, Wcrnmax, Wcsn0, Wcsnmax, &subl_can, Etrans, LWv, LWg, Hv, LEv, &h0, &dhdT, Ts, Qs, r_uc,
froot, theta, soil_transp_layer, chgsgn, Lobukhov, par, n, rh, rv, rc, rb, u_top, decay, Locc, LWup_above_v,
psi, soil, &alpha, &beta, T, soil_evap_layer);
}
//calculates values at the instant t1 -> h1, through iterations
cont=0;
chgsgn=0;
*Ts=0.5*Tg+0.5*Ta;
*Qs=0.5*Qg+0.5*Qa;
canopy_fluxes(r, c, T11, Tg, Ta, Qg, Qa, zmu, zmT, z0, z0s, d0, z0r, hveg, v, LR, P, SW, LW, e, LSAI, decaycoeff0, land, Wcrn0,
Wcrnmax, Wcsn0, Wcsnmax, &subl_can, Etrans, LWv, LWg, Hv, LEv, &h1, &dhdT, Ts, Qs, r_uc, froot, theta, soil_transp_layer, chgsgn,
Lobukhov, par, n, rh, rv, rc, rb, u_top, decay, Locc, LWup_above_v, psi, soil, &alpha, &beta, T, soil_evap_layer);
melt_can = 0.0;
do{
T10=T11;
//Generalized Newton-Raphson
cont2=0;
nw=1.0;
err0=fabs( C*(T11-T00)/par->Dt - SWv - A*h1 - (1.-A)*h0 );
//eq. C*(T11-T00)/Dt = cost + h(T10) + dh(T10)/dT * (T11-T10)
//eq. C*(T11-T10)/Dt + C*(T10-T00)/Dt = cost + h(T10) + dh(T10)/dT * (T11-T10)
//eq. T11-T10 = ( cost + h(T10) - C*(T10-T00)/Dt ) / ( C/Dt - dh/dT )
DT=( -C*(T10-T00)/par->Dt + SWv + A*h1 + (1.0-A)*h0 ) / ( C/par->Dt - A*dhdT );
if(DT!=DT) printf("ERROR NwRph Tcanopy T00:%f T10:%f SWv:%f h0:%f h1:%f dhdT:%f C:%f Wcsn:%f Wcrn:%f %ld %ld\n",
T00,T10,SWv,h0,h1,dhdT,C,Wcsn,Wcrn,r,c);
Lobukhov0=(*Lobukhov);
do{
T11 = T10 + nw*DT;
if(subl_can<0 && T11<0){ //condensation as frost
Wcsn=Wcsn0-subl_can*par->Dt;
Wcrn=Wcrn0;
}else if(subl_can<0 && T11>=0){ //condensation as dew
Wcrn=Wcrn0-subl_can*par->Dt;
Wcsn=Wcsn0;
}else{ //partly evaporation, partly sublimation
if(fwliq+fwice>0){
Wcsn=Wcsn0-(fwice/(fwliq+fwice))*subl_can*par->Dt;
Wcrn=Wcrn0-(fwliq/(fwliq+fwice))*subl_can*par->Dt;
}else{
Wcsn=Wcsn0;
Wcrn=Wcrn0;
}
}
if(Wcrn>Wcrnmax) Wcrn=Wcrnmax;
if(Wcrn<0) Wcrn=0.0;
if(Wcsn>Wcsnmax) Wcsn=Wcsnmax;
if(Wcsn<0) Wcsn=0.0;
if(T11>0 && Wcsn>0){ //melting
melt_can=Fmin(Wcsn, c_ice*Wcsn*(T11-0.0)/Lf);
T11p=T11 - Lf*melt_can/C;
Wcsn-=melt_can;
Wcrn+=melt_can;
}else if(T11<0 && Wcrn>0){ //freezing
melt_can=-Fmin(Wcrn, c_liq*Wcrn*(0.0-T11)/Lf);
T11p=T11 - Lf*melt_can/C;
Wcsn-=melt_can;
Wcrn+=melt_can;
}else{
melt_can=0.0;
T11p=T11;
}
C=land[jcd]*LSAI*c_can + c_ice*Wcsn + c_liq*Wcrn;
C=(C+C0)/2.;
canopy_fluxes(r, c, T11p, Tg, Ta, Qg, Qa, zmu, zmT, z0, z0s, d0, z0r, hveg, v, LR, P, SW, LW, e, LSAI, decaycoeff0,
land, Wcrn, Wcrnmax, Wcsn, Wcsnmax, &subl_can, Etrans, LWv, LWg, Hv, LEv, &h1, &dhdT, Ts, Qs, r_uc,
froot, theta, soil_transp_layer, chgsgn, Lobukhov, par, n, rh, rv, rc, rb, u_top, decay, Locc,
LWup_above_v, psi, soil, &alpha, &beta, T, soil_evap_layer);
err1=fabs(C*(T11-T00)/par->Dt - SWv - A*h1 - (1.0-A)*h0 );
nw/=3.0;
cont2++;
}while(err1>err0 && cont2<5);
if(Lobukhov0*(*Lobukhov)<0) chgsgn++;
cont++;
if(fabs(T11-T10)<0.01 && err1<0.1) a=1;
}while(a==0 && cont<par->maxiter_canopy);
/*if(fabs(T11-T10)>0.5){
printf("Tcanopy not converging %f %f %ld %ld \n",T10,T11,r,c);
}*/
*Tv=T11p;
*dWcrn=Wcrn-Wcrn0;
*dWcsn=Wcsn-Wcsn0;
sat_spec_humidity(Qv, &dQ, 1.0, *Tv, P);
turbulent_fluxes(*r_uc, *r_uc/beta, P, *Ts , Tg, *Qs, alpha*Qg, alpha*dQgdT, Hg, dHgdT, Eg, dEgdT);
if(*Tv!=(*Tv)) printf("Tv no value %ld %ld\n",r,c);
}
