bool_t getBarklemcross(Barklemstruct *bs, RLK_Line *rlk)
{
const char routineName[] = "getBarklemcross";
int index;
double Z, neff1, neff2, findex1, findex2, reducedmass, meanvelocity,
crossmean, E_Rydberg, deltaEi, deltaEj;
Element *element;
element = &atmos.elements[rlk->pt_index - 1];
/* --- Note: ABO tabulations are valid only for neutral atoms -- -- */
if (rlk->stage > 0)
return FALSE;
if ((deltaEi = element->ionpot[rlk->stage] - rlk->Ei) <= 0.0)
return FALSE;
if ((deltaEj = element->ionpot[rlk->stage] - rlk->Ej) <= 0.0)
return FALSE;
Z = (double) (rlk->stage + 1);
E_Rydberg = E_RYDBERG / (1.0 + M_ELECTRON / (element->weight * AMU));
neff1 = Z * sqrt(E_Rydberg / deltaEi);
neff2 = Z * sqrt(E_Rydberg / deltaEj);
if (rlk->Li > rlk->Lj) SWAPDOUBLE(neff1, neff2);
if (neff1 < bs->neff1[0] || neff1 > bs->neff1[bs->N1-1])
return FALSE;
Locate(bs->N1, bs->neff1, neff1, &index);
findex1 =
(double) index + (neff1 - bs->neff1[index]) / BARKLEM_DELTA_NEFF;
if (neff2 < bs->neff2[0] || neff2 > bs->neff2[bs->N2-1])
return FALSE;
Locate(bs->N2, bs->neff2, neff2, &index);
findex2 =
(double) index + (neff2 - bs->neff2[index]) / BARKLEM_DELTA_NEFF;
/* --- Find interpolation in table -- -------------- */
rlk->cross = cubeconvol(bs->N2, bs->N1,
bs->cross[0], findex2, findex1);
rlk->alpha = cubeconvol(bs->N2, bs->N1,
bs->alpha[0], findex2, findex1);
reducedmass = AMU / (1.0/atmos.H->weight + 1.0/element->weight);
meanvelocity = sqrt(8.0 * KBOLTZMANN / (PI * reducedmass));
crossmean = SQ(RBOHR) * pow(meanvelocity / 1.0E4, -rlk->alpha);
rlk->cross *= 2.0 * pow(4.0/PI, rlk->alpha/2.0) *
exp(gammln((4.0 - rlk->alpha)/2.0)) * meanvelocity * crossmean;
rlk->vdwaals = BARKLEM;
return TRUE;
}
void Functions::sortElementsDouble(RefArrayXd array1, RefArrayXd array2)
{
assert(array1.size() == array2.size());
for (int i = 0; i < array1.size(); i++)
{
for (int j = 1; j < (array1.size()-i); j++)
{
if (array1(j-1) > array1(j))
{
SWAPDOUBLE(array1(j-1),array1(j)); // SWAP array1 elements in increasing order
SWAPDOUBLE(array2(j-1),array2(j)); // SWAP array2 elements accordingly
}
else
if (array1(j-1) == array1(j))
continue;
}
}
}
void Functions::sortElementsInt(vector<int> &array1, RefArrayXd array2)
{
for (int i = 0; i < array1.size(); i++)
{
for (int j = 1; j < (array1.size()-i); j++)
{
if (array1[j-1] > array1[j])
{
SWAPINT(array1[j-1], array1[j]); // SWAP array1 elements in increasing order
SWAPDOUBLE(array2(j-1), array2(j)); // SWAP array2 elements accordingly
}
else
if (array1[j-1] == array1[j])
continue;
}
}
}
void *rr_fread(char *ptr, int elsize, int n_elem, FILE *fp,
char *header, int not_more)
{
int n_read, i;
char dummychar;
if (n_elem > 0) {
n_read = fread(ptr,elsize,n_elem,fp);
if (n_read != n_elem) quit(-1,
"rr_fread: problems reading %s. Only %d of %d elements were read\n",
header, n_read, n_elem);
if (elsize == sizeof(int)) {
for (i=0; i<n_elem; i++) {
SWAPWORD(ptr+(elsize*i));
}
}
else if (elsize == sizeof(short)) {
for (i=0; i<n_elem; i++) {
SWAPHALF(ptr+(elsize*i));
}
}
else if (elsize == sizeof(double)) {
for (i=0; i<n_elem; i++) {
SWAPDOUBLE(ptr+(elsize*i));
}
}
}
if (not_more) {
if (fread(&dummychar,1,1,fp) != 0)
quit(-1,"rr_fread: more data after %s - should not be there\n",header);
}
return(0); /* Not relevant, but stops compilation warnings. */
}
bool_t getBarklemactivecross(AtomicLine *line)
{
bool_t determined = TRUE, useBarklem = FALSE;
int index, Ll, Lu, nq, i, j, ic;
double Sl, Su, Jl, Ju;
double Z, neff1, neff2, findex1, findex2, reducedmass, meanvelocity,
crossmean, E_Rydberg, deltaEi, deltaEj;
Atom *atom;
Barklemstruct bs;
atom = line->atom;
j = line->j;
i = line->i;
/* ---
JdlCR: Interpolate the tables only if sigma is smaller than 20
otherwise assume that we are already giving Barklem cross-sections
--- */
if(line->cvdWaals[0] < 20.0){
/* --- ABO tabulations are only valid for neutral atoms -- -------- */
if (atom->stage[i] > 0) return FALSE;
/* --- Get the quantum numbers for orbital angular momentum -- ---- */
determined &= determinate(atom->label[i], atom->g[i],
&nq, &Sl, &Ll, &Jl);
determined &= determinate(atom->label[j], atom->g[j],
&nq, &Su, &Lu, &Ju);
/* --- See if one of the Barklem cases applies -- -------------- */
if (determined) {
if ((Ll == S_ORBIT && Lu == P_ORBIT) ||
(Ll == P_ORBIT && Lu == S_ORBIT)) {
useBarklem = readBarklemTable(SP, &bs);
} else if ((Ll == P_ORBIT && Lu == D_ORBIT) ||
(Ll == D_ORBIT && Lu == P_ORBIT)) {
useBarklem = readBarklemTable(PD, &bs);
} else if ((Ll == D_ORBIT && Lu == F_ORBIT) ||
(Ll == F_ORBIT && Lu == D_ORBIT)) {
useBarklem = readBarklemTable(DF, &bs);
}
}
if (!determined || !useBarklem) return FALSE;
/* --- Determine the index of the appropriate continuum level -- -- */
Z = atom->stage[j] + 1;
for (ic = j + 1; atom->stage[ic] < atom->stage[j]+1; ic++);
deltaEi = atom->E[ic] - atom->E[i];
deltaEj = atom->E[ic] - atom->E[j];
E_Rydberg = E_RYDBERG / (1.0 + M_ELECTRON / (atom->weight * AMU));
neff1 = Z * sqrt(E_Rydberg / deltaEi);
neff2 = Z * sqrt(E_Rydberg / deltaEj);
if (Ll > Lu) SWAPDOUBLE(neff1, neff2);
/* --- Interpolate according to effective principal quantum number */
if (neff1 < bs.neff1[0] || neff1 > bs.neff1[bs.N1-1])
return FALSE;
Locate(bs.N1, bs.neff1, neff1, &index);
findex1 =
(double) index + (neff1 - bs.neff1[index]) / BARKLEM_DELTA_NEFF;
if (neff2 < bs.neff2[0] || neff2 > bs.neff2[bs.N2-1])
return FALSE;
Locate(bs.N2, bs.neff2, neff2, &index);
findex2 =
(double) index + (neff2 - bs.neff2[index]) / BARKLEM_DELTA_NEFF;
/* --- Find interpolation in table -- -------------- */
line->cvdWaals[0] = cubeconvol(bs.N2, bs.N1,
bs.cross[0], findex2, findex1);
line->cvdWaals[1] = cubeconvol(bs.N2, bs.N1,
bs.alpha[0], findex2, findex1);
}
reducedmass = AMU / (1.0/atmos.atoms[0].weight + 1.0/atom->weight);
meanvelocity = sqrt(8.0 * KBOLTZMANN / (PI * reducedmass));
crossmean = SQ(RBOHR) * pow(meanvelocity / 1.0E4, -line->cvdWaals[1]);
line->cvdWaals[0] *= 2.0 * pow(4.0/PI, line->cvdWaals[1]/2.0) *
exp(gammln((4.0 - line->cvdWaals[1])/2.0)) * meanvelocity * crossmean;
/* --- Use UNSOLD for the contribution of Helium atoms -- ---------- */
line->cvdWaals[2] = 1.0;
line->cvdWaals[3] = 0.0;
return TRUE;
}
void readKuruczLines(char *inputFile)
{
const char routineName[] = "readKuruczLines";
const double C = 2.0*PI * (Q_ELECTRON/EPSILON_0) *
(Q_ELECTRON/M_ELECTRON) / CLIGHT;
char inputLine[RLK_RECORD_LENGTH+1], listName[MAX_LINE_SIZE],
filename[MAX_LINE_SIZE], Gvalues[18+1], elem_code[7],
labeli[RLK_LABEL_LENGTH+1], labelj[RLK_LABEL_LENGTH+1],
*commentChar = COMMENT_CHAR;
bool_t swap_levels, determined, useBarklem;
int Nline, Nread, Nrequired, checkPoint, hfs_i, hfs_j, gL_i, gL_j,
iso_dl;
double lambda0, Ji, Jj, Grad, GStark, GvdWaals, pti,
Ei, Ej, gf, lambda_air;
RLK_Line *rlk;
Barklemstruct bs_SP, bs_PD, bs_DF;
FILE *fp_Kurucz, *fp_linelist;
if (!strcmp(inputFile, "none")) return;
/* --- Read in the data files for Barklem collisional broadening -- */
readBarklemTable(SP, &bs_SP);
readBarklemTable(PD, &bs_PD);
readBarklemTable(DF, &bs_DF);
labeli[RLK_LABEL_LENGTH] = '\0';
labelj[RLK_LABEL_LENGTH] = '\0';
if ((fp_Kurucz = fopen(inputFile, "r")) == NULL) {
sprintf(messageStr, "Unable to open input file %s", inputFile);
Error(ERROR_LEVEL_1, routineName, messageStr);
return;
}
/* --- Go through each of the linelist files listed in input file - */
while (getLine(fp_Kurucz, commentChar, listName, FALSE) != EOF) {
Nread = sscanf(listName, "%s", filename);
if ((fp_linelist = fopen(filename, "r")) == NULL) {
sprintf(messageStr, "Unable to open input file %s", filename);
Error(ERROR_LEVEL_1, routineName, messageStr);
}
/* --- Count the number of lines in this file -- -------------- */
Nline = 0;
while (fgets(inputLine, RLK_RECORD_LENGTH+1, fp_linelist) != NULL)
if (*inputLine != *commentChar) Nline++;
rewind(fp_linelist);
if (atmos.Nrlk == 0) atmos.rlk_lines = NULL;
atmos.rlk_lines = (RLK_Line *)
realloc(atmos.rlk_lines, (Nline + atmos.Nrlk) * sizeof(RLK_Line));
/* --- Read lines from file -- -------------- */
rlk = atmos.rlk_lines + atmos.Nrlk;
while (fgets(inputLine, RLK_RECORD_LENGTH+1, fp_linelist) != NULL) {
if (*inputLine != *commentChar) {
initRLK(rlk);
Nread = sscanf(inputLine, "%lf %lf %s %lf",
&lambda_air, &gf, (char *) &elem_code, &Ei);
/* --- Ionization stage and periodic table index -- --------- */
sscanf(elem_code, "%d.%d", &rlk->pt_index, &rlk->stage);
Nread += sscanf(inputLine+53, "%lf", &Ej);
Ei = fabs(Ei) * (HPLANCK * CLIGHT) / CM_TO_M;
Ej = fabs(Ej) * (HPLANCK * CLIGHT) / CM_TO_M;
/* --- Beware: the Kurucz linelist has upper and lower levels
of a transition in random order. Therefore, we have to
check for the lowest energy of the two and use that as
lower level -- -------------- */
if (Ej < Ei) {
swap_levels = TRUE;
rlk->Ei = Ej;
rlk->Ej = Ei;
strncpy(labeli, inputLine+69, RLK_LABEL_LENGTH);
strncpy(labelj, inputLine+41, RLK_LABEL_LENGTH);
} else {
swap_levels = FALSE;
rlk->Ei = Ei;
rlk->Ej = Ej;
strncpy(labeli, inputLine+41, RLK_LABEL_LENGTH);
strncpy(labelj, inputLine+69, RLK_LABEL_LENGTH);
}
Nread += sscanf(inputLine+35, "%lf", &Ji);
Nread += sscanf(inputLine+63, "%lf", &Jj);
if (swap_levels) SWAPDOUBLE(Ji, Jj);
rlk->gi = 2*Ji + 1;
rlk->gj = 2*Jj + 1;
lambda0 = (HPLANCK * CLIGHT) / (rlk->Ej - rlk->Ei);
rlk->Aji = C / SQ(lambda0) * POW10(gf) / rlk->gj;
rlk->Bji = CUBE(lambda0) / (2.0 * HPLANCK * CLIGHT) * rlk->Aji;
rlk->Bij = (rlk->gj / rlk->gi) * rlk->Bji;
/* --- Store in nm -- -------------- */
rlk->lambda0 = lambda0 / NM_TO_M;
/* --- Get quantum numbers for angular momentum and spin -- - */
determined = RLKdeterminate(labeli, labelj, rlk);
rlk->polarizable = (atmos.Stokes && determined);
/* --- Line broadening -- -------------- */
strncpy(Gvalues, inputLine+79, 18);
Nread += sscanf(Gvalues, "%lf %lf %lf", &Grad, &GStark, &GvdWaals);
if (GStark != 0.0)
rlk->GStark = POW10(GStark) * CUBE(CM_TO_M);
else
rlk->GStark = 0.0;
if (GvdWaals != 0.0)
rlk->GvdWaals = POW10(GvdWaals) * CUBE(CM_TO_M);
else
rlk->GvdWaals = 0.0;
/* --- If possible use Barklem formalism -- -------------- */
useBarklem = FALSE;
if (determined) {
if ((rlk->Li == S_ORBIT && rlk->Lj == P_ORBIT) ||
(rlk->Li == P_ORBIT && rlk->Lj == S_ORBIT)) {
useBarklem = getBarklemcross(&bs_SP, rlk);
} else if ((rlk->Li == P_ORBIT && rlk->Lj == D_ORBIT) ||
(rlk->Li == D_ORBIT && rlk->Lj == P_ORBIT)) {
useBarklem = getBarklemcross(&bs_PD, rlk);
} else if ((rlk->Li == D_ORBIT && rlk->Lj == F_ORBIT) ||
(rlk->Li == F_ORBIT && rlk->Lj == D_ORBIT)) {
useBarklem = getBarklemcross(&bs_DF, rlk);
}
}
/* --- Else use good old Unsoeld -- -------------- */
if (!useBarklem) {
getUnsoldcross(rlk);
}
/* --- Radiative broadening -- -------------- */
if (Grad != 0.0) {
rlk->Grad = POW10(Grad);
} else {
/* --- Just take the Einstein Aji value, but only if either
Stark or vd Waals broadening is in effect -- ------- */
if (GStark != 0.0 || GvdWaals != 0.0)
rlk->Grad = rlk->Aji;
else {
rlk->Grad = 0.0;
/* --- In this case the line is not polarizable because
there is no way to determine its damping -- ------ */
rlk->polarizable = FALSE;
}
}
/* --- Isotope and hyperfine fractions and slpittings -- ---- */
Nread += sscanf(inputLine+106, "%d", &rlk->isotope);
Nread += sscanf(inputLine+108, "%lf", &rlk->isotope_frac);
rlk->isotope_frac = POW10(rlk->isotope_frac);
Nread += sscanf(inputLine+117, "%lf", &rlk->hyperfine_frac);
rlk->hyperfine_frac = POW10(rlk->hyperfine_frac);
Nread += sscanf(inputLine+123, "%5d%5d", &hfs_i, &hfs_j);
rlk->hfs_i = ((double) hfs_i) * MILLI * KBOLTZMANN;
rlk->hfs_j = ((double) hfs_j) * MILLI * KBOLTZMANN;
/* --- Effective Lande factors -- -------------- */
Nread += sscanf(inputLine+143, "%5d%5d", &gL_i, &gL_j);
rlk->gL_i = gL_i * MILLI;
rlk->gL_j = gL_j * MILLI;
if (swap_levels) {
SWAPDOUBLE(rlk->hfs_i, rlk->hfs_j);
SWAPDOUBLE(rlk->gL_i, rlk->gL_j);
}
/* Nread += sscanf(inputLine+154, "%d", &iso_dl); */
iso_dl = 0;
rlk->iso_dl = iso_dl * MILLI * ANGSTROM_TO_NM;
checkNread(Nread, Nrequired=17, routineName, checkPoint=1);
/*
printf(" Line: %f (vacuum), %f (air)\n"
" gi, gj: %f, %f\n"
" Ei, Ej: %e, %e\n"
" Aji: %e\n"
" Grad, GStark, GvdWaals: %e, %e, %e\n"
" VdWaals: %d\n"
" hyperfine_frac, isotope_frac: %f, %f\n"
" cross, alpha: %e, %e\n\n",
rlk->lambda0, lambda_air,
rlk->gi, rlk->gj, rlk->Ei, rlk->Ej, rlk->Aji,
rlk->Grad, rlk->GStark, rlk->GvdWaals,
rlk->vdwaals,
rlk->hyperfine_frac, rlk->isotope_frac,
rlk->cross, rlk->alpha);
*/
rlk++;
}
}
fclose(fp_linelist);
sprintf(messageStr, "Read %d Kurucz lines from file %s\n",
Nline, listName);
Error(MESSAGE, routineName, messageStr);
atmos.Nrlk += Nline;
}
fclose(fp_Kurucz);
free_BS(&bs_SP);
free_BS(&bs_PD);
free_BS(&bs_DF);
}
