void solve_real_virt(double xr[2], double xv[NVIRT], double Trr[2][2], double *Trv[2], double *Tvr[2],
double *Tvv[3], double sr[2], double sv[NVIRT]){
double *Tvv_inv_Tvr[2];
double *Tvv_inv_sv;
double Trr_new[2][2];
double sr_new[2];
unsigned i, j, b;
double det;
unsigned NSUBDIFF;
NSUBDIFF = NSUBLYA - NDIFF/2; /* lowest bin of the diffusion region */
/** Allocate memory **/
for (i = 0; i < 2; i++) Tvv_inv_Tvr[i] = create_1D_array(NVIRT);
Tvv_inv_sv = create_1D_array(NVIRT);
/*** Computing Tvv^{-1}.Tvr ***/
for (i = 0; i < 2; i++) {
for (b = 0; b < NSUBDIFF; b++) Tvv_inv_Tvr[i][b] = Tvr[i][b]/Tvv[0][b];
for (b = NSUBLYA + NDIFF/2; b < NVIRT; b++) Tvv_inv_Tvr[i][b] = Tvr[i][b]/Tvv[0][b];
solveTXeqB(Tvv[0]+NSUBDIFF, Tvv[2]+NSUBDIFF, Tvv[1]+NSUBDIFF, Tvv_inv_Tvr[i]+NSUBDIFF, Tvr[i]+NSUBDIFF, NDIFF);
}
/*** Trr_new = Trr - Trv.Tvv^{-1}.Tvr ***/
for (i = 0; i < 2; i++) for (j = 0; j < 2; j++) {
Trr_new[i][j] = Trr[i][j];
for (b = 0; b < NVIRT; b++) Trr_new[i][j] -= Trv[i][b]*Tvv_inv_Tvr[j][b];
}
/*** Computing Tvv^{-1}.sv ***/
for (b = 0; b < NSUBDIFF; b++) Tvv_inv_sv[b] = sv[b]/Tvv[0][b];
for (b = NSUBLYA + NDIFF/2; b < NVIRT; b++) Tvv_inv_sv[b] = sv[b]/Tvv[0][b];
solveTXeqB(Tvv[0]+NSUBDIFF, Tvv[2]+NSUBDIFF, Tvv[1]+NSUBDIFF, Tvv_inv_sv+NSUBDIFF, sv+NSUBDIFF, NDIFF);
/*** sr_new = sr - Trv.Tvv^{-1}sv ***/
for (i = 0; i < 2; i++) {
sr_new[i] = sr[i];
for (b = 0; b < NVIRT; b++) sr_new[i] -= Trv[i][b]*Tvv_inv_sv[b];
}
/*** Solve 2 by 2 system Trr_new.xr = sr_new ***/
det = Trr_new[0][0] * Trr_new[1][1] - Trr_new[0][1] * Trr_new[1][0];
xr[0] = (Trr_new[1][1] * sr_new[0] - Trr_new[0][1] * sr_new[1])/det;
xr[1] = (Trr_new[0][0] * sr_new[1] - Trr_new[1][0] * sr_new[0])/det;
/*** xv = Tvv^{-1}(sv - Tvr.xr) ***/
for (b = 0; b < NVIRT; b++) xv[b] = Tvv_inv_sv[b] - Tvv_inv_Tvr[0][b]*xr[0] - Tvv_inv_Tvr[1][b]*xr[1];
/** Free memory **/
for (i = 0; i < 2; i++) free(Tvv_inv_Tvr[i]);
free(Tvv_inv_sv);
}
void solveTXeqB(double *diag, double *updiag, double *dndiag,
double *X, double *B, unsigned N){
int i;
double denom;
double *alpha = create_1D_array(N);
double *gamma = create_1D_array(N); /* X[i] = gamma[i] - alpha[i] * X[i+1] */
alpha[0] = updiag[0] / diag[0];
gamma[0] = B[0] / diag[0];
for (i = 1; i < N; i++) {
denom = diag[i] - dndiag[i] * alpha[i-1];
alpha[i] = updiag[i] / denom;
gamma[i] = (B[i] - dndiag[i] * gamma[i-1]) / denom;
}
X[N-1] = gamma[N-1];
for (i = N-2; i >= 0; i--) X[i] = gamma[i] - alpha[i] * X[i+1];
free(alpha);
free(gamma);
}
double rec_HMLA_2photon_dxedlna(double xe, double nH, double H, double TM, double TR,
HRATEEFF *rate_table, TWO_PHOTON_PARAMS *twog,
double zstart, double dlna, double **logfminus_hist, double *logfminus_Ly_hist[],
unsigned iz, double z, double energy_rate){
double xr[2];
double xv[NVIRT];
double xedot, Pib, feq;
double fplus[NVIRT], fplus_Ly[3];
unsigned b, i;
double Trr[2][2];
double matrix[2][2];
double *Trv[2];
double *Tvr[2];
double *Tvv[3];
double sr[2];
double sv[NVIRT];
double Dtau[NVIRT];
double Alpha[2], Beta[2];
double RLya;
double R2p2s;
double C_2p;
for (i = 0; i < 2; i++) Trv[i] = create_1D_array(NVIRT);
for (i = 0; i < 2; i++) Tvr[i] = create_1D_array(NVIRT);
for (i = 0; i < 3; i++) Tvv[i] = create_1D_array(NVIRT);
/* Redshift photon occupation number from previous times and higher energy bins */
fplus_from_fminus(fplus, fplus_Ly, logfminus_hist, logfminus_Ly_hist, TR,
zstart, dlna, iz, z, twog->Eb_tab);
/* Compute real-real, real-virtual and virtual-virtual transition rates */
populateTS_2photon(Trr, Trv, Tvr, Tvv, sr, sv, Dtau, xe, TM, TR, nH, H, rate_table,
twog, fplus, fplus_Ly, Alpha, Beta, z);
/* Solve for the population of the real and virtual states */
solve_real_virt(xr, xv, Trr, Trv, Tvr, Tvv, sr, sv);
/*************************************************************/
/* Dark matter annihilation*/
RLya = 4.662899067555897e15 *H /nH/(1.-xe); /*8 PI H/(3 nH x1s lambda_Lya^3) */
interpolate_rates(Alpha, Beta, &R2p2s, TR, TM / TR, rate_table);
matrix[0][0] = Beta[0] + 3.*R2p2s + L2s1s;
matrix[1][1] = Beta[1] + R2p2s + RLya;
C_2p=(RLya+R2p2s*L2s1s/matrix[0][0])/(matrix[1][1]-R2p2s*3.*R2p2s/matrix[0][0]);
/*************************************************************/
/* Obtain xe_dot */
xedot = -nH*xe*xe*(Alpha[0]+Alpha[1]) + xr[0]*Beta[0] + xr[1]*Beta[1]
+(1.-xe)/(3.*nH)*energy_rate*(1./EI+(1.-C_2p)/E21);
/* Update fminuses */
for (b = 0; b < NVIRT; b++) {
if (Dtau[b] != 0) {
Pib = (1.-exp(-Dtau[b]))/Dtau[b];
feq = -xr[0]*Tvr[0][b] - xr[1]*Tvr[1][b];
feq -= (b == 0 ? xv[1]*Tvv[2][0]:
b == NVIRT-1 ? xv[NVIRT-2]*Tvv[1][NVIRT-1]:
xv[b+1]*Tvv[2][b] + xv[b-1]*Tvv[1][b]);
feq /= (1.-xe)*(1.-Pib)*Tvv[0][b];
logfminus_hist[b][iz] = log(fplus[b] + (feq - fplus[b])*(1.-exp(-Dtau[b])));
}
else logfminus_hist[b][iz] = log(fplus[b]);
}
/* log(xnp/(3 x1s)) , n = 2, 3, 4, assuming 3p and 4p in Boltzmann eq. with 2s */
logfminus_Ly_hist[0][iz] = log(xr[1]/3./(1.-xe));
logfminus_Ly_hist[1][iz] = log(xr[0]/(1.-xe)) - E32/TR;
logfminus_Ly_hist[2][iz] = log(xr[0]/(1.-xe)) - E42/TR;
for (i = 0; i < 2; i++) free(Trv[i]);
for (i = 0; i < 2; i++) free(Tvr[i]);
for (i = 0; i < 3; i++) free(Tvv[i]);
return xedot/H;
}
void populateTS_2photon(double Trr[2][2], double *Trv[2], double *Tvr[2], double *Tvv[3],
double sr[2], double sv[NVIRT], double Dtau[NVIRT],
double xe, double TM, double TR, double nH, double H, HRATEEFF *rate_table,
TWO_PHOTON_PARAMS *twog, double fplus[NVIRT], double fplus_Ly[],
double Alpha[2], double Beta[2], double z) {
double R2p2s;
unsigned b;
double RLya, Gammab, Pib, dbfact;
double *Aup, *Adn;
double A2p_up, A2p_dn;
Aup = create_1D_array(NVIRT);
Adn = create_1D_array(NVIRT);
RLya = 4.662899067555897e15 *H /nH/(1.-xe); /*8 PI H/(3 nH x1s lambda_Lya^3) */
interpolate_rates(Alpha, Beta, &R2p2s, TR, TM / TR, rate_table);
/****** 2s row and column ******/
Trr[0][0] = Beta[0] + 3.*R2p2s
+ 3.* RLya * (1.664786871919931 *exp(-E32/TR) /* Ly-beta escape */
+ 1.953125 *exp(-E42/TR)); /* Ly-gamma escape */
Trr[0][1] = -R2p2s;
sr[0] = nH * Alpha[0] * xe*xe
+ 3.* RLya * (1.-xe) * (1.664786871919931 *fplus_Ly[1]
+ 1.953125 *exp(-E41/TR));
#if (EFFECT_A == 0)
/* Standard treatment of 2s-->1s two-photon decays */
Trr[0][0] += L2s1s;
sr[0] += L2s1s * (1.-xe) * exp(-E21/TR);
#endif
/****** 2p row and column ******/
Trr[1][1] = Beta[1] + R2p2s + RLya;
Trr[1][0] = -3.*R2p2s;
sr[1] = nH * Alpha[1] * xe*xe + 3.*RLya * (1.-xe) * fplus_Ly[0];
/***** Two-photon transitions: populating Trv, Tvr and updating Trr ******/
for (b = 0; b < NVIRT; b++) {
dbfact = exp((twog->Eb_tab[b] - E21)/TR);
Trr[0][0] -= Tvr[0][b] = -twog->A2s_tab[b]/fabs(exp((twog->Eb_tab[b] - E21)/TR)-1.);
Trv[0][b] = Tvr[0][b] *dbfact;
Trr[1][1] -= Tvr[1][b] = -exp(-E32/TR)/3. * twog->A3s3d_tab[b]/fabs(exp((twog->Eb_tab[b] - E31)/TR)-1.)
-exp(-E42/TR)/3. * twog->A4s4d_tab[b]/fabs(exp((twog->Eb_tab[b] - E41)/TR)-1.);
Trv[1][b] = Tvr[1][b] *3.*dbfact;
}
/****** Tvv and sv. Accounting for DIFFUSION ******/
populate_Diffusion(Aup, Adn, &A2p_up, &A2p_dn, TM, twog->Eb_tab, twog->A1s_tab);
/* Updating Tvr, Trv, Trr for diffusion between line center ("2p state") and two neighboring bins */
Trr[1][1] += (A2p_dn + A2p_up);
for (b = 0; b < NVIRT; b++) {
Gammab = -(Trv[0][b] + Trv[1][b]) + Aup[b] + Adn[b]; /* Inverse lifetime of virtual state b */
/*** Diffusion region ***/
if ( (b >= NSUBLYA - NDIFF/2 && b < NSUBLYA - 1)
||(b > NSUBLYA && b < NSUBLYA + NDIFF/2)) {
Tvv[1][b] = -Aup[b-1];
Tvv[2][b] = -Adn[b+1];
}
/* Bins neighboring Lyman alpha. */
if (b == NSUBLYA-1) {
Tvv[1][b] = -Aup[b-1];
Tvv[2][b] = 0.;
Tvr[1][b] -= A2p_dn;
Trv[1][b] -= Aup[b];
}
if (b == NSUBLYA) {
Tvv[1][b] = 0.;
Tvv[2][b] = -Adn[b+1];
Tvr[1][b] -= A2p_up;
Trv[1][b] -= Adn[b];
}
/*********************/
Dtau[b] = Gammab * (1.-xe) * cube(hPc/twog->Eb_tab[b]) * nH /8. /M_PI /H;
if (Dtau[b] > 1e-30) {
Pib = (1.-exp(-Dtau[b]))/Dtau[b];
Tvv[0][b] = Gammab/(1.-Pib);
sv[b] = Tvv[0][b] * (1.-xe) * fplus[b] * Pib;
}
else { /* Nearly vanishing optical depth: free streaming */
Tvv[0][b] = 1.;
Trv[0][b] = Trv[1][b] = Tvr[0][b] = Tvr[1][b] = 0;
sv[b] = (1.-xe) * fplus[b];
}
}
free(Aup);
free(Adn);
}
void rec_build_history(REC_COSMOPARAMS *param, HRATEEFF *rate_table, TWO_PHOTON_PARAMS *twog_params,
double *xe_output, double *Tm_output) {
long iz;
double **logfminus_hist;
double *logfminus_Ly_hist[3];
double H, z, z_prev, dxedlna_prev, z_prev2, dxedlna_prev2, dTmdlna_prev, dTmdlna_prev2;
double Delta_xe;
/* history of photon occupation numbers */
logfminus_hist = create_2D_array(NVIRT, param->nz);
logfminus_Ly_hist[0] = create_1D_array(param->nz); /* Ly-alpha */
logfminus_Ly_hist[1] = create_1D_array(param->nz); /* Ly-beta */
logfminus_Ly_hist[2] = create_1D_array(param->nz); /* Ly-gamma */
z = param->zstart;
/********* He II + III Saha phase *********/
Delta_xe = 1.; /* Delta_xe = xHeIII */
for(iz=0; iz<param->nz && Delta_xe > 1e-9; iz++) {
z = (1.+param->zstart)*exp(-param->dlna*iz) - 1.;
xe_output[iz] = rec_sahaHeII(param->nH0,param->T0,param->fHe,z, &Delta_xe);
Tm_output[iz] = param->T0 * (1.+z);
}
/******* He I + II post-Saha phase *********/
Delta_xe = 0.; /* Delta_xe = xe - xe(Saha) */
for (; iz<param->nz && Delta_xe < 5e-4; iz++) {
z = (1.+param->zstart)*exp(-param->dlna*iz) - 1.;
xe_output[iz] = xe_PostSahaHe(param->nH0,param->T0,param->fHe, rec_HubbleConstant(param,z), z, &Delta_xe);
Tm_output[iz] = param->T0 * (1.+z);
}
/****** Segment where we follow the helium recombination evolution, Tm fixed to steady state *******/
z_prev2 = (1.+param->zstart)*exp(-param->dlna*(iz-3)) - 1.;
dxedlna_prev2 = (xe_output[iz-2] - xe_output[iz-4])/2./param->dlna;
z_prev = (1.+param->zstart)*exp(-param->dlna*(iz-2)) - 1.;
dxedlna_prev = (xe_output[iz-1] - xe_output[iz-3])/2./param->dlna;
Delta_xe = 1.; /* Difference between xe and H-Saha value */
for(; iz<param->nz && (Delta_xe > 1e-4 || z > 1650.); iz++) {
rec_get_xe_next1(param, z, xe_output[iz-1], xe_output+iz, rate_table, FUNC_HEI, iz-1, twog_params,
logfminus_hist, logfminus_Ly_hist, &z_prev, &dxedlna_prev, &z_prev2, &dxedlna_prev2);
z = (1.+param->zstart)*exp(-param->dlna*iz) - 1.;
Tm_output[iz] = rec_Tmss(xe_output[iz], param->T0*(1.+z), rec_HubbleConstant(param, z), param->fHe, param->nH0*cube(1.+z), energy_injection_rate(param,z));
/* Starting to populate the photon occupation number with thermal values */
update_fminus_Saha(logfminus_hist, logfminus_Ly_hist, xe_output[iz], param->T0*(1.+z)*kBoltz,
param->nH0*cube(1.+z)*1e-6, twog_params, param->zstart, param->dlna, iz, z, 0);
Delta_xe = fabs(xe_output[iz]- rec_saha_xe_H(param->nH0, param->T0, z));
}
/******* Hydrogen post-Saha equilibrium phase *********/
Delta_xe = 0.; /*Difference between xe and Saha value */
for(; iz<param->nz && Delta_xe < 5e-5; iz++) {
z = (1.+param->zstart)*exp(-param->dlna*iz) - 1.;
H = rec_HubbleConstant(param,z);
xe_output[iz] = xe_PostSahaH(param->nH0*cube(1.+z)*1e-6, H, kBoltz*param->T0*(1.+z), rate_table, twog_params,
param->zstart, param->dlna, logfminus_hist, logfminus_Ly_hist, iz, z, &Delta_xe, MODEL, energy_injection_rate(param,z));
Tm_output[iz] = rec_Tmss(xe_output[iz], param->T0*(1.+z), H, param->fHe, param->nH0*cube(1.+z), energy_injection_rate(param,z));
}
/******* Segment where we follow the hydrogen recombination evolution with two-photon processes
Tm fixed to steady state ******/
z_prev2 = (1.+param->zstart)*exp(-param->dlna*(iz-3)) - 1.;
dxedlna_prev2 = (xe_output[iz-2] - xe_output[iz-4])/2./param->dlna;
z_prev = (1.+param->zstart)*exp(-param->dlna*(iz-2)) - 1.;
dxedlna_prev = (xe_output[iz-1] - xe_output[iz-3])/2./param->dlna;
for(; iz<param->nz && 1.-Tm_output[iz-1]/param->T0/(1.+z) < 5e-4 && z > 700.; iz++) {
rec_get_xe_next1(param, z, xe_output[iz-1], xe_output+iz, rate_table, FUNC_H2G, iz-1, twog_params,
logfminus_hist, logfminus_Ly_hist, &z_prev, &dxedlna_prev, &z_prev2, &dxedlna_prev2);
z = (1.+param->zstart)*exp(-param->dlna*iz) - 1.;
Tm_output[iz] = rec_Tmss(xe_output[iz], param->T0*(1.+z), rec_HubbleConstant(param, z), param->fHe, param->nH0*cube(1.+z)*1e-6, energy_injection_rate(param,z));
}
/******* Segment where we follow the hydrogen recombination evolution with two-photon processes
AND Tm evolution ******/
dTmdlna_prev2 = rec_dTmdlna(xe_output[iz-3], Tm_output[iz-3], param->T0*(1.+z_prev2),
rec_HubbleConstant(param, z_prev2), param->fHe, param->nH0*cube(1.+z_prev2), energy_injection_rate(param,z_prev2));
dTmdlna_prev = rec_dTmdlna(xe_output[iz-2], Tm_output[iz-2], param->T0*(1.+z_prev),
rec_HubbleConstant(param, z_prev), param->fHe, param->nH0*cube(1.+z_prev), energy_injection_rate(param,z_prev));
for(; iz<param->nz && z > 700.; iz++) {
rec_get_xe_next2(param, z, xe_output[iz-1], Tm_output[iz-1], xe_output+iz, Tm_output+iz, rate_table, FUNC_H2G,
iz-1, twog_params, logfminus_hist, logfminus_Ly_hist, &z_prev, &dxedlna_prev, &dTmdlna_prev,
&z_prev2, &dxedlna_prev2, &dTmdlna_prev2);
z = (1.+param->zstart)*exp(-param->dlna*iz) - 1.;
}
/***** Segment where we follow Tm as well as xe *****/
/* Radiative transfer effects switched off here */
for(; iz<param->nz && z>20.; iz++) {
rec_get_xe_next2(param, z, xe_output[iz-1], Tm_output[iz-1], xe_output+iz, Tm_output+iz, rate_table, FUNC_HMLA,
iz-1, twog_params, logfminus_hist, logfminus_Ly_hist, &z_prev, &dxedlna_prev, &dTmdlna_prev,
&z_prev2, &dxedlna_prev2, &dTmdlna_prev2);
z = (1.+param->zstart)*exp(-param->dlna*iz) - 1.;
}
/*** For z < 20 use Peeble's model. The precise model does not metter much here as
1) the free electron fraction is basically zero (~1e-4) in any case and
2) the universe is going to be reionized around that epoch
Tm is still evolved explicitly ***/
for(; iz<param->nz; iz++) {
rec_get_xe_next2(param, z, xe_output[iz-1], Tm_output[iz-1], xe_output+iz, Tm_output+iz, rate_table, FUNC_PEEBLES,
iz-1, twog_params, logfminus_hist, logfminus_Ly_hist, &z_prev, &dxedlna_prev, &dTmdlna_prev,
&z_prev2, &dxedlna_prev2, &dTmdlna_prev2);
z = (1.+param->zstart)*exp(-param->dlna*iz) - 1.;
}
/* Cleanup */
free_2D_array(logfminus_hist, NVIRT);
free(logfminus_Ly_hist[0]);
free(logfminus_Ly_hist[1]);
free(logfminus_Ly_hist[2]);
}
