void star2dR::solve_definitions(solver *op) {
star2d::solve_definitions(op);
matrix rho0,xi0,eps0;
double rhoc0,Xc0;
rho0=rho;xi0=opa.xi;eps0=nuc.eps;rhoc0=rhoc;Xc0=Xc;
double dXc=1e-8;
Xc+=dXc;
init_comp();
nuclear();
opacity();
eq_state();
matrix drho_dXc,dxi_dXc,deps_dXc,dlnrhoc_dXc;
dlnrhoc_dXc=(rhoc-rhoc0)/rhoc0/dXc*ones(1,1);
drho_dXc=(rho-rho0)/dXc+rho0*dlnrhoc_dXc;
dxi_dXc=(opa.xi-xi0)/dXc;
deps_dXc=(nuc.eps-eps0)/dXc;
Xc=Xc0;
fill();
for(int n=0;n<ndomains;n++) op->add_d(n,"log_rhoc","Xc",dlnrhoc_dXc);
op->add_d("rho","Xc",drho_dXc);
op->add_d("opa.xi","Xc",dxi_dXc);
op->add_d("nuc.eps","Xc",deps_dXc);
}
void hap_transmit(int *n, int *ped, int *id, int *father, int *mother,
int *sex, int *aff, int *if_qt, double *qt,
int *m, int *markers,
int *multiple_cases, int *impute_using_affected,
char **ofname) {
Family *first, *f, *prev;
FILE *outfile;
int nn, mm, hr, iqt;
char *tmp;
nn = *n;
mm = *m;
iqt = *if_qt;
if (!*if_qt) qt = (double *) 0;
first = nuclear(nn, ped, id, father, mother, sex, aff, qt, mm, markers);
/* Multiple case treatment */
if (*multiple_cases) {
for (f=first; f; f=f->next) {
if (*multiple_cases == 1) {
prev = f;
f = expand_family(f, mm);
if (!f) goto overflow;
}
else if (*multiple_cases == 2) {
use_only_first(f);
}
}
}
/* Do remaining computations on families */
prev = (Family *) 0;
for (f=first; f; f=f->next) {
/* Impute missing parental genotypes */
impute_parent(f, mm, (int) *impute_using_affected);
/* Compute inheritance vectors */
inheritance(f, mm);
/* Resolve haplotype phase and transmission */
hr = haplotype(f, mm, 1);
/* If recombination, write error message */
if (hr<0) {
REprintf("*** Recombination/expaternity at locus %d *** ", -hr);
show_family(f);
}
/* If no information or recombination, omit family */
if (hr!=0) {
if (prev)
prev->next = f->next;
else
first = f->next;
}
else {
prev = f;
}
}
/* Write haplotypes to disk */
tmp = *ofname;
/* If no file name supplied, generate one */
if (!*tmp) {
tmp = tmpnam((char *) 0);
*ofname = tmp;
}
outfile = fopen(tmp, "wb");
if (outfile) {
*n = hap_write(first, mm, iqt, outfile);
fclose(outfile);
}
else {
REprintf("*** Couldn't open temporary file %s\n", tmp);
*n = 0;
}
/* Now return memory to system */
while (first) {
f = first;
first = first->next;
del_family(f);
}
return;
/* Memory overflow */
overflow:
warn("Memory overflow while or after expanding family", f);
}
int main(int argc,char *argv[])
{
static double scoef[ROWS][COLS];
double m1,m2,E,rho,x,min,max,step,S,sunit,xunit;
int z1,z2;
unsigned int flag;
int i;
readscoef(scoef);
readparms(argc,argv,&z1,&z2,&m1,&m2,&rho,&min,&max,&step,&flag,scoef);
sunit = NA*rho/(m2*1.0e25);
xunit = 1.0;
switch(flag & ZBL_SUNIT){
case ZBL_EV_A:
sunit = 100.0*NA*rho/(m2*1.0e25);
break;
case ZBL_KEV_NM:
sunit = NA*rho/(m2*1.0e25);
break;
case ZBL_KEV_UM:
sunit = 1000.0*NA*rho/(m2*1.0e25);
break;
case ZBL_MEV_MM:
sunit = 1000.0*NA*rho/(m2*1.0e25);
break;
case ZBL_KEV_UG_CM2:
sunit = NA/(m2*1e24);
break;
case ZBL_MEV_MG_CM2:
sunit = NA/(m2*1e24);
break;
case ZBL_KEV_MG_CM2:
sunit = 1000.0*NA/(m2*1e24);
break;
case ZBL_EV_1E15ATOMS_CM2:
sunit = 1.0;
break;
case ZBL_EFFCHARGE:
sunit = 1.0;
break;
}
switch(flag & ZBL_XUNIT){
case ZBL_EV:
xunit = 1000.0;
break;
case ZBL_KEV:
xunit = 1.0;
break;
case ZBL_MEV:
xunit = 0.001;
break;
case ZBL_V0:
xunit = 1.0;
break;
case ZBL_BETA:
xunit = 0.0072974;
break;
case ZBL_M_S:
xunit = 2187673.0;
break;
case ZBL_CM_S:
xunit = 218767300.0;
break;
}
if(flag & ZBL_DSA){
for(x=min,i=0;x<=max;x+=step,i++);
printf(" %i %10.2f\n",i,rho);
}
for(x=min;x<=max;x+=step){
switch(flag & ZBL_ENERGY){
case FALSE:
E = 25.0*x*x/(xunit*xunit);
break;
default:
E = x/(xunit*m1);
break;
}
if(sqrt(E)/(5.0*137.035) > 1.0)
fatal_error(8);
switch(z1){
case 1:
if((flag & ZBL_SUNIT) == ZBL_EFFCHARGE)
S = 1.0;
else
S = pstop(z2,E,scoef);
break;
case 2:
if((flag & ZBL_SUNIT) == ZBL_EFFCHARGE)
S = heeff(z2,E);
else
S = hestop(z2,E,scoef);
break;
default:
if((flag & ZBL_SUNIT) == ZBL_EFFCHARGE)
S = hieff(z1,z2,E,scoef);
else
S = histop(z1,z2,E,scoef);
break;
}
switch(flag & ZBL_NUCLEAR){
case ZBL_N_ONLY:
S = nuclear(z1,z2,m1,m2,E*m1);
break;
case ZBL_N_BOTH:
S += nuclear(z1,z2,m1,m2,E*m1);
break;
case ZBL_N_NO:
break;
}
printf("%12.4e %12.4e\n",x,S*sunit);
}
exit(0);
}
