void fermi_dirac_init(void)
{
int i;
for(i = 0; i < LENGTH_FERMI_DIRAC_TABLE; i++)
{
fermi_dirac_vel[i] = MAX_FERMI_DIRAC * i / (LENGTH_FERMI_DIRAC_TABLE - 1.0);
fermi_dirac_cumprob[i] = qromb(fermi_dirac_kernel, 0, fermi_dirac_vel[i]);
}
for(i = 0; i < LENGTH_FERMI_DIRAC_TABLE; i++)
fermi_dirac_cumprob[i] /= fermi_dirac_cumprob[LENGTH_FERMI_DIRAC_TABLE - 1];
WDM_V0 = 0.012 * (1 + Redshift) * pow((Omega - OmegaBaryon) / 0.3, 1.0 / 3) * pow(HubbleParam / 0.65,
2.0 / 3) * pow(1.0 /
WDM_PartMass_in_kev,
4.0 / 3);
if(ThisTask == 0)
printf("\nWarm dark matter rms velocity dispersion at starting redshift = %g km/sec\n\n",
3.59714 * WDM_V0);
WDM_V0 *= 1.0e5 / UnitVelocity_in_cm_per_s;
/* convert from peculiar velocity to gadget's cosmological velocity */
WDM_V0 *= sqrt(1 + Redshift);
}
double TopHatSigma2(double R)
{
r_tophat = R;
return qromb(sigma2_int, 0, 500.0 * 1 / R); /* note: 500/R is here chosen as
integration boundary (infinity) */
}
double growth(double a)
{
double hubble_a;
hubble_a = sqrt(Omega / (a * a * a) + (1 - Omega - OmegaLambda) / (a * a) + OmegaLambda);
return hubble_a * qromb(growth_int, 0, a);
}
double f(double E2)
{
double ans;
E = E2;
ans = qromb(drho2,0.0,2.0*sqrt(E))*CONST;
return ans;
}
int main(void)
{
float a=0.0,b=PIO2,s;
printf("Integral of func computed with QROMB\n\n");
printf("Actual value of integral is %12.6f\n",fint(b)-fint(a));
s=qromb(func,a,b);
printf("Result from routine QROMB is %11.6f\n",s);
return 0;
}
void CMesh::wnNormalize() {
meshMemFunc mf = &CMesh::wnRhoIntegrand;
wnRho0 *= wnA/(4.*JPI*qromb(mf,0.,15.));
}
double CMesh::wnT(double x,double y) {
wnTx=x;
wnTy=y;
meshMemFunc mf = &CMesh::wnTIntegrand;
return 2.*qromb(mf,0.,15.);
}
compute_velocity_dispersions_bulge()
{
int i,j;
double z,R;
double rho;
if(N_BULGE==0) return;
printf("bulge velocity dispersion field...\n"); fflush(stdout);
for(i=0;i<=RSIZE;i++)
{
printf("bulge A, %d\n",i);
for(j=0;j<=ZSIZE;j++)
{
xl[j+1]=list_z[j];
yl[j+1]=Dphi_z[i][j] * comp_rho_bulge(list_R[i],list_z[j]);
}
spline(xl,yl,ZSIZE+1,1e40,1e40,D2yl);
for(j=ZSIZE - 1, VelDispRz_bulge[i][ZSIZE]=0 ;j>=0;j--)
{
VelDispRz_bulge[i][j] = VelDispRz_bulge[i][j+1];
if(fabs(yl[j+2])>1e-100 && fabs(yl[j+1])>1e-100)
VelDispRz_bulge[i][j]+=
qromb(splint_xl_yl_D2yl,list_z[j],list_z[j+1]);
}
}
for(i=0;i<=RSIZE;i++)
{
printf("bulge B, %d\n",i);
for(j=0;j<=ZSIZE;j++)
{
xl[j+1]=list_z[j];
yl[j+1]=Dphi_z_dR[i][j] * comp_rho_bulge(list_RplusdR[i],list_z[j]);
}
spline(xl,yl,ZSIZE+1,1e40,1e40,D2yl);
for(j=ZSIZE - 1, VelDispRz_dR_bulge[i][ZSIZE]=0 ;j>=0;j--)
{
VelDispRz_dR_bulge[i][j] = VelDispRz_dR_bulge[i][j+1];
if(fabs(yl[j+2])>1e-100 && fabs(yl[j+1])>1e-100)
VelDispRz_dR_bulge[i][j]+=
qromb(splint_xl_yl_D2yl,list_z[j],list_z[j+1]);
}
}
for(i=0;i<=RSIZE;i++)
{
for(j=0;j<=ZSIZE;j++)
{
R=list_R[i];
z=list_z[j];
rho = comp_rho_bulge(R,z);
if(rho>0)
{
if(i>0)
VelDispPhi_bulge[i][j]=R/rho * (VelDispRz_dR_bulge[i][j]-VelDispRz_bulge[i][j])/(list_RplusdR[i]-list_R[i]);
else
VelDispPhi_bulge[i][j]=0;
VelDispRz_bulge[i][j]/=rho;
}
else
VelDispRz_bulge[i][j]=VelDispPhi_bulge[i][j]=0;
VelVc2_bulge[i][j]=R*Dphi_R[i][j];
VelDispPhi_bulge[i][j]+=VelVc2_bulge[i][j]+VelDispRz_bulge[i][j];
VelStreamPhi_bulge[i][j]= 0 ;
VelDispPhi_bulge[i][j]-=VelStreamPhi_bulge[i][j]*VelStreamPhi_bulge[i][j];
if(VelDispRz_bulge[i][j]<0)
VelDispRz_bulge[i][j]=0;
if(VelDispPhi_bulge[i][j]<0)
VelDispPhi_bulge[i][j]=0;
}
}
printf("done.\n"); fflush(stdout);
}
/******************************************************************************
* @brief Calculate the sublimation flux.
*****************************************************************************/
double
CalcSubFlux(double EactAir,
double es,
double Zrh,
double AirDens,
double utshear,
double ushear,
double fe,
double Tsnow,
double Tair,
double U10,
double Zo_salt,
double F,
double *Transport)
{
extern parameters_struct param;
extern option_struct options;
double b, undersat_2;
double SubFlux;
double Qsalt, hsalt;
double phi_s, psi_s;
double T, ztop;
double particle;
double saltation_transport;
double suspension_transport;
SubFlux = 0.0;
particle = utshear * 2.8;
// SBSM:
if (options.BLOWING_SIMPLE) {
b = .25;
if (EactAir >= es) {
undersat_2 = 0.0;
}
else {
undersat_2 =
((EactAir / es) - 1.) * (1. - .027 * log(Zrh) + 0.027 * log(2));
}
SubFlux = b * undersat_2 * pow(U10, 5.) / F;
}
else {
// Sublimation flux (kg/m2*s) = mass-concentration * sublimation rate * height
// for both the saltation layer and the suspension layer
// Saltation layer is assumed constant with height
// Maximum saltation transport rate (kg/m*s)
// Liston and Sturm 1998, eq. 6
Qsalt = (param.BLOWING_CSALT * AirDens / CONST_G) *
(utshear / ushear) * (ushear * ushear - utshear * utshear);
if (options.BLOWING_FETCH) {
Qsalt *= (1. + (500. / (3. * fe)) * (exp(-3. * fe / 500.) - 1.));
}
// Pomeroy and Male (1992)
hsalt = 0.08436 * pow(ushear, 1.27);
// Saltation layer mass concentration (kg/m3)
phi_s = Qsalt / (hsalt * particle);
T = 0.5 * (ushear * ushear) / (U10 * param.BLOWING_SETTLING);
ztop = hsalt *
pow(T / (T + 1.),
(CONST_KARMAN * ushear) / (-1. * param.BLOWING_SETTLING));
if (EactAir >= es) {
SubFlux = 0.0;
}
else {
// Sublimation loss-rate for the saltation layer (s-1)
psi_s = sub_with_height(hsalt / 2., es, U10, AirDens, Zo_salt,
EactAir, F, hsalt,
phi_s, ushear, Zrh);
// Sublimation from the saltation layer in kg/m2*s
SubFlux = phi_s * psi_s * hsalt;
// Suspension layer must be integrated
SubFlux += qromb(sub_with_height, es, U10, AirDens, Zo_salt,
EactAir, F, hsalt,
phi_s, ushear, Zrh, hsalt, ztop);
}
// Transport out of the domain by saltation Qs(fe) (kg/m*s), eq 10 Liston and Sturm
saltation_transport = Qsalt * (1 - exp(-3. * fe / 500.));
// Transport in the suspension layer
suspension_transport = qromb(transport_with_height, es, U10, AirDens,
Zo_salt,
EactAir, F, hsalt, phi_s, ushear, Zrh,
hsalt, ztop);
// Transport at the downstream edge of the fetch in kg/m*s
*Transport = (suspension_transport + saltation_transport);
if (options.BLOWING_FETCH) {
*Transport /= fe;
}
}
return SubFlux;
}
