/* Obtain the molecular extinction by interpolating the opacity grid at
the specified atmospheric layer: */
int
interpolmolext(struct transit *tr, /* transit struct */
PREC_NREC r, /* Radius index */
PREC_RES **kiso){ /* Extinction coefficient array */
struct opacity *op=tr->ds.op; /* Opacity struct */
struct molecules *mol=tr->ds.mol;
long Nmol, Ntemp, Nwave;
PREC_RES *gtemp;
int *gmol;
int itemp, imol,
i, m; /* for-loop indices */
double ext; /* Interpolated extinction coefficient */
/* Layer temperature: */
PREC_ATM temp = tr->atm.t[r] * tr->atm.tfct;
/* Gridded temperatures: */
gtemp = op->temp;
Ntemp = op->Ntemp;
/* Gridded molecules list: */
gmol = op->molID;
Nmol = op->Nmol;
/* Wavenumber array size: */
Nwave = op->Nwave;
/* Interpolate: */
/* Find index of grid-temperature immediately lower than temp: */
itemp = binsearchapprox(gtemp, temp, 0, Ntemp);
if (temp < gtemp[itemp])
itemp--;
tr_output(TOUT_DEBUG, "Temperature: T[%i]=%.0f < %.2f < T[%.i]=%.0f\n",
itemp, gtemp[itemp], temp, itemp+1, gtemp[itemp+1]);
for (i=0; i < Nwave; i++){
/* Add contribution from each molecule: */
for (m=0; m < Nmol; m++){
/* Linear interpolation of the extinction coefficient: */
ext = (op->o[r][itemp ][m][i] * (gtemp[itemp+1]-temp) +
op->o[r][itemp+1][m][i] * (temp - gtemp[itemp]) ) /
(gtemp[itemp+1]-gtemp[itemp]);
imol = valueinarray(mol->ID, gmol[m], mol->nmol);
kiso[r][i] += mol->molec[imol].d[r] * ext;
}
}
return 0;
}
/* DEF */
static PREC_RES
eclipsetau(struct transit *tr,
PREC_RES height, /* Altitude down to where calculate tau */
PREC_RES *ex){ /* Extinction per layer [rad] */
/* Incident angle: */
//PREC_RES angle = tr->angles[tr->angleIndex];
//PREC_RES angle_rad = angle * DEGREES;
/* Layers radius array: */
prop_samp *rads = &tr->rads; /* Radius sampling */
PREC_RES *rad = rads->v; /* Radius array */
/* Get the index rs, of the sampled radius immediately below or equal
to height (i.e. rad[rs] <= height < rad[rs+1]): */
int rs = binsearchapprox(rad, height, 0, tr->rads.n-1);
/* Returns 0 if this is the top layer (no distance travelled): */
if (rs == tr->rads.n-1)
return 0.0;
/* Move pointers to the location of height: */
rad += rs;
ex += rs;
/* Number of layers beween height and the top layer: */
int nrad = tr->rads.n - rs;
PREC_RES res; /* Optical depth divided by units of radius */
PREC_RES x3[3], r3[3]; /* Interpolation variables */
/* Conversion to radian: */
//PREC_RES angle_rad = angle * DEGREES;
/* Distance along the path: */
PREC_RES s[nrad];
/* Providing three necessary points for spline integration: */
const PREC_RES tmpex = *ex;
const PREC_RES tmprad = *rad;
if(nrad==2) *ex = interp_parab(rad-1, ex-1, rad[0]);
else *ex = interp_parab(rad, ex, rad[0]);
if(nrad==2){
x3[0] = ex[0];
x3[2] = ex[1];
x3[1] = (ex[1]+ex[0])/2.0;
r3[0] = rad[0];
r3[2] = rad[1];
r3[1] = (rad[0]+rad[1])/2.0;
*rad = tmprad;
*ex = tmpex;
rad = r3;
ex = x3;
nrad++;
}
/* Distance along the path: */
s[0] = 0.0;
for(int i=1; i < nrad; i++){
s[i] = s[i-1] + (rad[i] - rad[i-1]); // /cos(angle_rad);
}
/* Integrate extinction along the path: */
/* Use spline if GSL is available along with at least 3 points: */
//#ifdef _USE_GSL
// gsl_interp_accel *acc = gsl_interp_accel_alloc();
// gsl_interp *spl = gsl_interp_alloc(gsl_interp_cspline, nrad);
// gsl_interp_init(spl, s, ex, nrad);
// res = gsl_interp_eval_integ(spl, s, ex, 0, s[nrad-1], acc);
// gsl_interp_free(spl);
// gsl_interp_accel_free(acc);
//#else
//#error non equispaced integration is not implemented without GSL
//#endif /* _USE_GSL */
/* Safety mode: GSL is acting up sometimes */
res = integ_trapz(s, ex, nrad);
/* Optical depth divided by units of radius: */
return res;
}
/* FUNCTION: Compute the molecular extinction.
Store results in kiso. If permol is true, calculate extinction per
molecule separately; else, collapse all extinction into kiso[0]. */
int
computemolext(struct transit *tr, /* transit struct */
PREC_RES **kiso, /* Extinction coefficient array [mol][wn] */
PREC_ATM temp, /* Temperature */
PREC_ATM *density, /* Density per species */
double *Z, /* Partition Function per isotope */
int permol){ /* Calculate the extinction per molecule */
/* Transit structures: */
struct opacity *op =tr->ds.op;
struct isotopes *iso=tr->ds.iso;
struct molecules *mol=tr->ds.mol;
struct line_transition *lt=&(tr->ds.li->lt);
PREC_NREC ln;
int i, m=0, mm,
*idop, *ilor;
long j, maxj, minj, offset;
/* Voigt profile variables: */
PREC_VOIGT ***profile=op->profile; /* Voigt profile */
PREC_NREC **profsize=op->profsize; /* Voigt-profile half-size */
double *aDop=op->aDop, /* Doppler-width sample */
*aLor=op->aLor; /* Lorentz-width sample */
int nDop=op->nDop, /* Number of Doppler samples */
nLor=op->nLor; /* Number of Lorentz samples */
PREC_NREC subw,
nlines=tr->ds.li->n_l; /* Number of line transitions */
PREC_RES wavn, next_wn;
double fdoppler, florentz, /* Doppler and Lorentz-broadening factors */
csdiameter; /* Collision diameter */
double propto_k;
double *kmax, *kmin; /* Maximum and minimum values of propto_k */
PREC_VOIGTP *alphal, *alphad;
int niso = iso->n_i, /* Number of isotopes in atmosphere */
nmol = mol->nmol, /* Number of species in atmosphere */
Nmol; /* Number of species with line-transitions */
int iown, idwn; /* Line-center indices */
double maxwidth=0, /* Maximum width between Lorentz and Doppler */
minwidth=1e5; /* Minimum width among isotopes in a Layer */
int ofactor=tr->owns.o; /* Dynamic oversampling factor */
long nadd = 0, /* Number of co-added lines */
nskip = 0, /* Number of skipped lines */
neval = 0; /* Number of evaluated profiles */
/* Wavenumber array variables: */
PREC_RES *wn = tr->wns.v;
PREC_NREC nwn = tr->wns.n,
onwn = tr->owns.n;
/* Wavenumber sampling intervals: */
PREC_RES dwn = tr->wns.d /tr->wns.o, /* Output array */
odwn = tr->owns.d/tr->owns.o; /* Oversampling array */
/* Allocate alpha Lorentz and Doppler arrays: */
alphal = (PREC_VOIGTP *)calloc(niso, sizeof(PREC_VOIGTP));
alphad = (PREC_VOIGTP *)calloc(niso, sizeof(PREC_VOIGTP));
/* Allocate width indices array: */
idop = (int *)calloc(niso, sizeof(int));
ilor = (int *)calloc(niso, sizeof(int));
kmax = (double *)calloc(op->Nmol, sizeof(double));
kmin = (double *)calloc(op->Nmol, sizeof(double));
/* Number of species in output array: */
if (permol)
Nmol = op->Nmol;
else
Nmol = 1;
/* Zero the extinction array: */
for (mm=0; mm < Nmol; mm++)
for (i=0; i < nwn; i++)
kiso[mm][i] = 0.0;
/* Constant factors for line widths: */
fdoppler = sqrt(2*KB*temp/AMU) * SQRTLN2 / LS;
florentz = sqrt(2*KB*temp/PI/AMU) / (AMU*LS);
/* Calculate the isotope's widths for this layer: */
for(i=0; i<niso; i++){
/* Lorentz profile width: */
alphal[i] = 0.0;
for(j=0; j<nmol; j++){
/* Isotope's collision diameter: */
csdiameter = (mol->radius[j] + mol->radius[iso->imol[i]]);
/* Line width: */
alphal[i] += density[j]/mol->mass[j] * csdiameter * csdiameter *
sqrt(1/iso->isof[i].m + 1/mol->mass[j]);
}
alphal[i] *= florentz;
/* Doppler profile width (divided by central wavenumber): */
alphad[i] = fdoppler / sqrt(iso->isof[i].m);
/* Print Lorentz and Doppler broadening widths: */
if(i <= 0)
tr_output(TOUT_RESULT, "Broadening (cm-1): Lorentz: %.5e, Doppler: "
"%.5e (T=%.2f).\n", alphal[i], alphad[i]*wn[0], temp);
maxwidth = fmax(alphal[i], alphad[i]*wn[0]); /* Max between Dop and Lor */
minwidth = fmin(minwidth, maxwidth);
/* Search for aDop and aLor indices for alphal[i] and alphad[i]: */
idop[i] = binsearchapprox(aDop, alphad[i]*wn[0], 0, nDop);
ilor[i] = binsearchapprox(aLor, alphal[i], 0, nLor);
}
tr_output(TOUT_DEBUG, "Minimum width in layer: %.9f\n", minwidth);
/* Determine the maximum and minimum line-strength per isotope: */
for(ln=0; ln<nlines; ln++){
/* Wavenumber of line transition: */
wavn = 1.0 / (lt->wl[ln] * lt->wfct);
/* Isotope ID of line: */
i = lt->isoid[ln];
/* Species index in output array: */
if (permol)
m = valueinarray(op->molID, mol->ID[iso->imol[i]], op->Nmol);
/* If it is beyond the lower limit, skip to next line transition: */
if ((wavn < tr->wns.i) || (wavn > tr->owns.v[onwn-1]))
continue;
/* Calculate the extinction coefficient except the broadening factor: */
propto_k = iso->isoratio[i] * /* Density */
SIGCTE * lt->gf[ln] * /* Constant * gf */
exp(-EXPCTE*lt->efct*lt->elow[ln]/temp) * /* Level population */
(1-exp(-EXPCTE*wavn/temp)) / /* Induced emission */
iso->isof[i].m / /* Isotope mass */
Z[i]; /* Partition function */
/* Maximum line strength among all transitions for each species: */
if (kmax[m] == 0){
kmax[m] = kmin[m] = propto_k;
} else{
kmax[m] = fmax(kmax[m], propto_k);
kmin[m] = fmin(kmin[m], propto_k);
}
}
/* Compute the spectra, proceed for every line: */
for (ln=0; ln<nlines; ln++){
wavn = 1.0/(lt->wl[ln]*lt->wfct);
i = lt->isoid[ln];
if (permol)
m = valueinarray(op->molID, mol->ID[iso->imol[i]], op->Nmol);
if ((wavn < tr->wns.i) || (wavn > tr->owns.v[onwn-1]))
continue;
/* Extinction coefficient (factors depending on the line transition): */
propto_k = lt->gf[ln] *
exp(-EXPCTE*lt->efct*lt->elow[ln]/temp) *
(1-exp(-EXPCTE*wavn/temp));
/* Index of closest oversampled wavenumber: */
iown = (wavn - tr->wns.i)/odwn;
if (fabs(wavn - tr->owns.v[iown+1]) < fabs(wavn - tr->owns.v[iown]))
iown++;
/* Check if the next line falls on the same sampling index: */
while (ln != nlines-1 && lt->isoid[ln+1] == i){
next_wn = 1.0/(lt->wl[ln+1]*lt->wfct);
if (fabs(next_wn - tr->owns.v[iown]) < odwn){
nadd++;
ln++;
/* Add the contribution from this line into the opacity: */
propto_k += lt->gf[ln] *
exp(-EXPCTE * lt->efct * lt->elow[ln] / temp) *
(1-exp(-EXPCTE*next_wn/temp));
}
else
break;
}
/* The rest of the factors: */
propto_k *= SIGCTE*iso->isoratio[i] / (iso->isof[i].m * Z[i]);
/* If line is too weak, skip it: */
if (propto_k < tr->ds.th->ethresh * kmax[m]){
nskip++;
continue;
}
/* Multiply by the species density: */
if (permol == 0)
propto_k *= density[iso->imol[i]];
/* Index of closest (but not larger than) coarse-sampling wavenumber: */
idwn = (wavn - tr->wns.i)/dwn;
/* FINDME: de-hard code this threshold */
/* Update Doppler width according to the current wavenumber: */
if (alphad[i]*wavn/alphal[i] >= 1e-1){
/* Recalculate index for Doppler width: */
idop[i] = binsearchapprox(aDop, alphad[i]*wavn, 0, nDop);
}
/* Sub-sampling offset between center of line and dyn-sampled wn: */
subw = iown - idwn*ofactor;
/* Offset between the profile and the wavenumber-array indices: */
offset = iown - profsize[idop[i]][ilor[i]];
/* Range that contributes to the opacity: */
/* Set the lower and upper indices of the profile to be used: */
minj = idwn - (profsize[idop[i]][ilor[i]] - subw) / ofactor;
maxj = idwn + (profsize[idop[i]][ilor[i]] + subw) / ofactor;
if (minj < 0)
minj = 0;
if (maxj >= nwn)
maxj = nwn-1;
/* Add the contribution from this line to the opacity spectrum: */
/* Adding in more complex but faster array indexing based on simpler
* pointer arrithmatic */
PREC_VOIGT * tmp_point = profile[idop[i]][ilor[i]];
int beg_j = ofactor*minj - offset;
for(j=minj; j<=maxj; ++j){
if (beg_j > 2*profsize[idop[i]][ilor[i]])
break;
if (beg_j >= 0)
kiso[m][j] += propto_k * tmp_point[beg_j];
beg_j += ofactor;
}
neval++;
}
tr_output(TOUT_DEBUG, "Number of co-added lines: %8li (%5.2f%%)\n",
nadd, nadd*100.0/nlines);
tr_output(TOUT_DEBUG, "Number of skipped profiles: %8li (%5.2f%%)\n",
nskip, nskip*100.0/nlines);
tr_output(TOUT_DEBUG, "Number of evaluated profiles: %8li (%5.2f%%)\n",
neval, neval*100.0/nlines);
/* Free allocated memory: */
free(alphal);
free(alphad);
free(idop);
free(ilor);
free(kmax);
free(kmin);
return 0;
}
