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 canopy_fluxes(long r, long c, double Tv, double Tg, double Ta, double Qgsat, 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 LW, double e,
double LSAI, double decaycoeff0, double *land, double Wcrn, double Wcrnmax, double Wcsn, double Wcsnmax,
double *Esubl, double *Etrans, double *LWv, double *LWg, double *H, double *LE, double *h, double *dhdT,
double *Ts, double *Qs, double *r_uc, double *froot, double *theta, DOUBLEVECTOR *soil_transp_layer, long chgsgn,
double *Lobukhov, PAR *par, long n, double *rh, double *rv, double *rc, double *rb, double *u_top, double *decay,
double *Locc, double *LWup_above_v, double psi, double **soil, double *alpha, double *beta, double *T,
DOUBLEVECTOR *soil_evap_layer){
double rm, ft=0.0, fw, fwliq, fwice;
double Qv, dQvdT, Hg, Lt, Lv, R, dLWvdT, dHdT, dEdT, dEsubldT, E;
double Loc=1.E50, Loc0, Ts0;
long cont, cont2, l;
//CANOPY FRACTION SET AT THE MAX OF SNOW AND LIQUID WATER FRACTION ON CANOPY
fwliq=pow(Wcrn/Wcrnmax,2./3.);
fwice=pow(Wcsn/Wcsnmax,2./3.);
fw=Fmax(fwliq, fwice);
if(fw<0) fw=0.0;
if(fw>1) fw=1.0;
//LONGWAVE
longwave_vegetation(LW, e, Tg, Tv, LSAI, LWv, LWg, &dLWvdT, LWup_above_v);
//FIND SPECIFIC HUMIDITY IN THE VEGETATION LAYER
sat_spec_humidity(&Qv, &dQvdT, 1.0, Tv, P);
//UNDERCANOPY TURBULENT FLUXES
//iteration for Ts
cont2=0;
do{
Ts0=*Ts;
if(chgsgn>10){ //neglects stability corrections, if the number of iterations in Tcanopy is larger than a threshold
aero_resistance2(zmu, zmT, z0, d0, z0r, hveg, v, Ta, Ts0, Qa, *Qs, P, LR, LSAI, &rm, rh, rv, u_top, Lobukhov,
par->state_turb, 4, par->maxiter_Businger);
}else{ //considers stability corrections
aero_resistance2(zmu, zmT, z0, d0, z0r, hveg, v, Ta, Ts0, Qa, *Qs, P, LR, LSAI, &rm, rh, rv, u_top, Lobukhov,
par->state_turb, par->monin_obukhov, par->maxiter_Businger);
}
cont2++;
//iteration for Loc (within canopy Obukhov length)
cont=0;
do{
Loc0=Loc;
//if(cont==par->maxiter_Loc) Loc=-1.E50;
veg_transmittance(r, c, rm, v, Ts0, Tg, z0s, LSAI, decaycoeff0, z0, d0, hveg, *u_top, *Lobukhov, rb, r_uc, rh,
decay, Loc, par->stabcorr_incanopy);
*rv = (*rh);
find_actual_evaporation_parameters(r,c,alpha, beta, soil_evap_layer, theta, soil, T, psi, P, *r_uc, Ta, Qa, Qgsat, n);
/*if(Qg>(*Qs) && n==0){
*rv_ic = (*r_uc) + exp(8.206-4.255*sat);
}else{
*rv_ic = *r_uc;
}*/
*rb = (*rb) / LSAI;
if(Qv<(*Qs)){ //condensation
R=1.0;
}else{
canopy_evapotranspiration(*rb, Tv, Qa, P, SW, theta, land, soil, froot, &ft, soil_transp_layer);
R=fw+(1.0-fw)*ft;
}
*rc = (*rb) / R;
*Ts = (Ta/(*rh) + Tg/(*r_uc) + Tv/(*rb)) / (1./(*rh) + 1./(*r_uc) + 1./(*rb));
*Qs = (Qa/(*rv) + (*alpha)*Qgsat*(*beta)/(*r_uc) + Qv/(*rc)) / (1./(*rv) + (*beta)/(*r_uc) + 1./(*rc));
Hg=air_cp((*Ts+Tg)/2.) * air_density((*Ts+Tg)/2., (*Qs+(*alpha)*Qgsat)/2., P) * (Tg-(*Ts))/(*r_uc);
// -u*^3
// Loc = ------------------ Below Canopy Monin-Obukhov length (Niu&Yang)
// k(g/T)(Hg/(rho*C))
Loc=-pow(v/rm,1.5)/( ka*(g/(*Ts+tk))*(Hg/(air_density(*Ts,*Qs,P)*air_cp(*Ts))) );
if(Hg==0.0 || Hg!=Hg) Loc=1.E+50;
cont++;
}while(fabs(Loc0-Loc)>0.01 && cont<=par->maxiter_Loc);
/*if(cont==maxiter){
printf("Loc not converging, set at neutrality %ld %ld\n",r,c);
}*/
}while(cont2<par->maxiter_Ts && fabs((*Ts)-Ts0)>0.01);
/*if(fabs((*Ts)-Ts0)>0.01){
printf("Ts not converging %f %f %ld %ld\n",*Ts,Ts0,r,c);
}*/
//CANOPY FLUXES
turbulent_fluxes(*rb, *rc, P, *Ts, Tv, *Qs, Qv, dQvdT, H, &dHdT, &E, &dEdT);
//Et from transpiration, E-Et condensation or evaporation/sublimation from water on the canopy
Lt=Levap(Tv);
if(E>0){ //evaporation or sublimation
*Esubl=E*fw/R;
dEsubldT=dEdT*fw/R;
if(fwliq+fwice>0){
Lv=Lt + Lf*fwice/(fwliq+fwice); //linear interpolation to decide if sublimation or condensation occurs
}else{
Lv=Lt;
}
}else{ //condensation
*Esubl=E;
dEsubldT=dEdT;
if(Tv>=0){
Lv=Lt;
}else{
Lv=Lt + Lf;
}
}
*Etrans=E-(*Esubl);
for(l=1;l<=soil_transp_layer->nh;l++){
soil_transp_layer->co[l] = soil_transp_layer->co[l] * (*Etrans);
}
*LE=Lt*(*Etrans) + Lv*(*Esubl);
*h=(*LWv) - (*H) - (*LE);
*dhdT=dLWvdT - dHdT - Lt*(dEdT-dEsubldT) - Lv*dEsubldT;
if(*h!=(*h)) printf("No value in canopy fluxes Loc:%e v:%f rm:%e Ts:%f Tv:%f Ta:%f Tg:%f Hg:%f %ld %ld\n",
Loc,v,rm,*Ts,Tv,Ta,Tg,Hg,r,c);
*Locc=Loc;
}
