static Real hst_dE(const GridS *pG, const int i, const int j, const int k)
{
Real nJ,Q,cs,cs2,E0,dE=0.;
int ii=i-pG->Disp[0],jj=j-pG->Disp[1],kk=k-pG->Disp[2];
int ks = pG->ks, ke = pG->ke;
nJ = par_getd("problem","nJ");
Q = par_getd("problem","Q");
cs = sqrt(4.0-2.0*qshear)/(PI*nJ*Q);
cs2 = SQR(cs);
E0 = cs2/Gamma/Gamma_1;
if(ii == 58 && jj == 16 && kk == ks) {
dE = pG->U[kk][jj][ii].E
- 0.5*(SQR(pG->U[kk][jj][ii].M1) + SQR(pG->U[kk][jj][ii].M2)
+ SQR(pG->U[kk][jj][ii].M3))/pG->U[kk][jj][ii].d;
#ifdef MHD
dE -= 0.5*(SQR(pG->U[kk][jj][ii].B1c)
+ SQR(pG->U[kk][jj][ii].B2c) + SQR(pG->U[kk][jj][ii].B3c));
#endif
dE -= E0;
}
return dE*dVol;
}
static void pbc_ox1(Grid *pGrid)
{
int is = pGrid->is, ie = pGrid->ie;
int js = pGrid->js, je = pGrid->je;
int ks = pGrid->ks, ke = pGrid->ke;
int i,j,k;
#ifdef MHD
int ju, ku; /* j-upper, k-upper */
#endif
Real xmin,xmax,Lx;
xmin = par_getd("grid","x1min");
xmax = par_getd("grid","x1max");
Lx = xmax - xmin;
for (k=ks; k<=ke; k++) {
for (j=js; j<=je; j++) {
for (i=1; i<=nghost; i++) {
pGrid->U[k][j][ie+i] = pGrid->U[k][j][is+(i-1)];
pGrid->U[k][j][ie+i].M2 =
pGrid->U[k][j][ie+i].M2 - pGrid->U[k][j][ie+i].d*0.015*Lx;
#ifdef SPECIAL_RELATIVITY
pGrid->W[k][j][ie+i] = pGrid->W[k][j][is+(i-1)];
#endif
}
}
}
#ifdef MHD
/* Note that i=ie+1 is not a boundary condition for the interface field B1i */
for (k=ks; k<=ke; k++) {
for (j=js; j<=je; j++) {
for (i=2; i<=nghost; i++) {
pGrid->B1i[k][j][ie+i] = pGrid->B1i[k][j][is+(i-1)];
}
}
}
if (pGrid->Nx2 > 1) ju=je+1;
else ju=je;
for (k=ks; k<=ke; k++) {
for (j=js; j<=ju; j++) {
for (i=1; i<=nghost; i++) {
pGrid->B2i[k][j][ie+i] = pGrid->B2i[k][j][is+(i-1)];
}
}
}
if (pGrid->Nx3 > 1) ku=ke+1;
else ku=ke;
for (k=ks; k<=ku; k++) {
for (j=js; j<=je; j++) {
for (i=1; i<=nghost; i++) {
pGrid->B3i[k][j][ie+i] = pGrid->B3i[k][j][is+(i-1)];
}
}
}
#endif /* MHD */
return;
}
static Real hst_m2(const GridS *pG, const int i, const int j, const int k)
{
Real kx,kxt,ky;
Real x1,x2,x3;
int nwx,nwy;
Real nJ,Q,beta,cs,B0;
nJ = par_getd("problem","nJ");
Q = par_getd("problem","Q");
beta = par_getd("problem","beta");
cs = sqrt(4.0-2.0*qshear)/PI/nJ/Q;
B0 = cs/sqrt(beta);
cc_pos(pG,i,j,k,&x1,&x2,&x3);
nwx = par_geti_def("problem","nwx",-6);
nwy = par_geti_def("problem","nwy",1);
kx = nwx*2*PI;
ky = nwy*2*PI;
kxt = kx+qshear*ky*pG->time;
return -(pG->U[k][j][i].B2c-B0)/kxt/B0/cos(kxt*x1+ky*x2);
}
static Real hst_dPhi(const GridS *pG, const int i, const int j, const int k)
{
Real nJ,Q,cs,dPhi,Phi1;
Real kx,kxt,ky,k2,k20;
Real x1,x2,x3,zmax;
int nwx,nwy;
int ks = pG->ks, ke = pG->ke;
cc_pos(pG,i,j,k,&x1,&x2,&x3);
nJ = par_getd("problem","nJ");
Q = par_getd("problem","Q");
nwx = par_geti_def("problem","nwx",-6);
nwy = par_geti_def("problem","nwy",1);
zmax = par_getd("domain1","x3max");
kx = nwx*2*PI;
ky = nwy*2*PI;
kxt = kx+qshear*ky*pG->time;
k2 =kxt*kxt+ky*ky;
k20 =kx*kx+ky*ky;
cs = sqrt(4.0-2.0*qshear)/(PI*nJ*Q);
Phi1 = -4.0*PI*nJ*cs*cs/k20*(pG->U[k][j][i].d-1.0);
#ifdef SELF_GRAVITY_USING_FFT_DISK
Phi1 *= 1-0.5*(exp(-sqrt(k20)*(zmax-fabs(x3)))+exp(-sqrt(k20)*(zmax+fabs(x3))));
#endif
dPhi = (pG->Phi[k][j][i]-Phi1)/(pG->U[k][j][i].d-1)*k2;
dPhi /= 1-0.5*(exp(-sqrt(k2)*(zmax-fabs(x3)))+exp(-sqrt(k2)*(zmax+fabs(x3))));
return dPhi;
}
void problem(DomainS *pDomain)
{
GridS *pGrid = pDomain->Grid;
int i, is = pGrid->is, ie = pGrid->ie;
int j, js = pGrid->js, je = pGrid->je;
int k, ks = pGrid->ks, ke = pGrid->ke;
int ir,irefine,nx2;
Real d_in,p_in,d_out,p_out,Ly,rootdx2;
/* Set up the grid bounds for initializing the grid */
if (pGrid->Nx[0] <= 1 || pGrid->Nx[1] <= 1) {
ath_error("[problem]: This problem requires Nx1 > 1, Nx2 > 1\n");
}
d_in = par_getd("problem","d_in");
p_in = par_getd("problem","p_in");
d_out = par_getd("problem","d_out");
p_out = par_getd("problem","p_out");
/* Find number of Nx2 cells on root grid. At x=0, interface is at nx2/2 */
irefine = 1;
for (ir=1;ir<=pDomain->Level;ir++) irefine *= 2;
Ly = pDomain->RootMaxX[1] - pDomain->RootMinX[1];
rootdx2 = pGrid->dx2*((double)(irefine));
nx2 = (int)(Ly/rootdx2);
nx2 /= 2;
/* Initialize the grid */
for (k=ks; k<=ke; k++) {
for (j=js; j<=je; j++) {
for (i=is; i<=ie; i++) {
pGrid->U[k][j][i].M1 = 0.0;
pGrid->U[k][j][i].M2 = 0.0;
pGrid->U[k][j][i].M3 = 0.0;
if(((j-js + pDomain->Disp[1])+(i-is + pDomain->Disp[0])) > (nx2*irefine)) {
pGrid->U[k][j][i].d = d_out;
#ifndef ISOTHERMAL
pGrid->U[k][j][i].E = p_out/Gamma_1;
#endif
} else {
pGrid->U[k][j][i].d = d_in;
#ifndef ISOTHERMAL
pGrid->U[k][j][i].E = p_in/Gamma_1;
#endif
}
}
}
}
return;
}
void problem_read_restart(MeshS *pM, FILE *fp)
{
#ifdef OHMIC
eta_Ohm = par_getd("problem","eta");
#endif
#ifdef NAVIER_STOKES
nu_V = par_getd("problem","nu");
#endif
#ifdef BRAGINSKII
nu_V = par_getd("problem","nu");
#endif
return;
}
void problem(Grid *pGrid)
{
int i, is = pGrid->is, ie = pGrid->ie;
int j, js = pGrid->js, je = pGrid->je;
Real pressure,prat,rad,da,pa,ua,va,wa,x1,x2,x3;
Real bxa,bya,bza,b0=0.0;
Real rin;
double theta;
rin = par_getd("problem","radius");
pa = par_getd("problem","pamb");
prat = par_getd("problem","prat");
b0 = par_getd("problem","b0");
theta = (PI/180.0)*par_getd("problem","angle");
/* setup uniform ambient medium with spherical over-pressured region */
da = 1.0;
ua = 0.0;
va = 0.0;
wa = 0.0;
bxa = b0*cos(theta);
bya = b0*sin(theta);
bza = 0.0;
for (j=js; j<=je; j++) {
for (i=is; i<=ie; i++) {
pGrid->U[j][i].d = da;
pGrid->U[j][i].M1 = da*ua;
pGrid->U[j][i].M2 = da*va;
pGrid->U[j][i].M3 = da*wa;
pGrid->B1i[j][i] = bxa;
pGrid->B2i[j][i] = bya;
pGrid->B3i[j][i] = bza;
pGrid->U[j][i].B1c = bxa;
pGrid->U[j][i].B2c = bya;
pGrid->U[j][i].B3c = bza;
if (i == ie && ie > is) pGrid->B1i[j][i+1] = bxa;
if (j == je && je > js) pGrid->B2i[j+1][i] = bya;
cc_pos(pGrid,i,j,&x1,&x2);
rad = sqrt(x1*x1 + x2*x2);
pressure = pa;
if (rad < rin) pressure = prat*pa;
pGrid->U[j][i].E = pressure/Gamma_1
+ 0.5*(bxa*bxa + bya*bya + bza*bza)
+ 0.5*da*(ua*ua + va*va + wa*wa);
}
}
}
static Real hst_dBy(const GridS *pG, const int i, const int j, const int k)
{
Real nJ,Q,beta,cs,B0,dBy=0.;
int ii=i-pG->Disp[0],jj=j-pG->Disp[1],kk=k-pG->Disp[2];
int ks = pG->ks, ke = pG->ke;
nJ = par_getd("problem","nJ");
Q = par_getd("problem","Q");
beta = par_getd("problem","beta");
cs = sqrt(4.0-2.0*qshear)/PI/nJ/Q;
B0 = cs/sqrt(beta);
if(ii == 58 && jj == 16 && kk == ks) dBy = pG->U[kk][jj][ii].B2c - B0;
return dBy*dVol;
}
int main(int argc, char *argv[])
{
if (argc == 1) {
printf("Usage: %s par-file [block-name par-name]\n",argv[0]);
exit(0);
}
par_debug(0);
par_open(argv[1]);
par_cmdline(argc,argv);
if (argc == 4) {
char *cp = par_gets(argv[2],argv[3]);
int ival;
double dval;
char *sval = "hello world";
printf("PAR_GETS: %s.%s = \"%s\"\n",argv[2],argv[3],cp);
printf("PAR_GETI: %s.%s = \"%d\" as integer\n",
argv[2],argv[3],par_geti(argv[2],argv[3]));
printf("PAR_GETD: %s.%s = \"%g\" as double\n",
argv[2],argv[3],par_getd(argv[2],argv[3]));
free(cp);
}
par_dump(0,stdout);
par_close();
return 0;
}
void problem_read_restart(Grid *pG, Domain *pD, FILE *fp)
{
Omega_0 = par_getd("problem","omega");
qshear = par_getd_def("problem","qshear",1.5);
StaticGravPot = ShearingBoxPot;
Ly = x2max - x2min; /* for 3D problem */
if (par_geti("grid","Nx3") == 1) {
Ly = 0.0;
}
amp = par_getd("problem","amp");
omg = sqrt(2.0*(2.0-qshear))*Omega_0;
fread(name, sizeof(char),50,fp);
return;
}
int main(int argc, char *argv[])
{
int mytid;
/* int numprocs; */
int namelen;
char processor_name[MPI_MAX_PROCESSOR_NAME];
par_debug(0);
if(MPI_SUCCESS != MPI_Init(&argc,&argv))
ath_error("Error on calling MPI_Init\n");
/* Get the number of processes */
/* MPI_Comm_size(MPI_COMM_WORLD,&numprocs); */
/* Get my task id, or rank as it is called in MPI */
MPI_Comm_rank(MPI_COMM_WORLD,&mytid);
/* Get the name of the processor or machine name */
MPI_Get_processor_name(processor_name,&namelen);
printf("My task id / rank = %d on %s\n",mytid, processor_name);
/* Parent and child have different jobs */
if(mytid != 0)
printf("My Parent's task id / rank = 0\n");
else{
printf("I am the Parent\n");
if (argc == 1) {
printf("Usage: %s par-file [block-name par-name]\n",argv[0]);
exit(0);
}
par_open(argv[1]);
par_cmdline(argc,argv);
if (argc == 4) {
char *cp = par_gets(argv[2],argv[3]);
printf("PAR_GETS: %s.%s = \"%s\"\n",argv[2],argv[3],cp);
printf("PAR_GETI: %s.%s = \"%d\" as integer\n",
argv[2],argv[3],par_geti(argv[2],argv[3]));
printf("PAR_GETD: %s.%s = \"%g\" as double\n",
argv[2],argv[3],par_getd(argv[2],argv[3]));
free(cp);
}
}
par_dist_mpi(mytid,MPI_COMM_WORLD);
par_dump(0,stdout);
par_close();
MPI_Finalize();
return 0;
}
int commit_parameters(){
int out_level = par_geti_def("log","out_level",0);
int err_level = par_geti_def("log","err_level",0);
ath_log_set_level(out_level, err_level);
if(has_external_gravitational_potential) {
StaticGravPot = grav_pot;
}
CourNo = par_getd("time","cour_no");
#ifdef ISOTHERMAL
Iso_csound = par_getd("problem","iso_csound");
Iso_csound2 = Iso_csound*Iso_csound;
#else
Gamma = par_getd("problem","gamma");
Gamma_1 = Gamma - 1.0;
Gamma_2 = Gamma - 2.0;
#endif
init_domain(&level0_Grid, &level0_Domain);
init_grid(&level0_Grid, &level0_Domain);
if ((Potentials = (Real***)calloc_3d_array(
level0_Grid.Nx3 + 2 * nghost,
level0_Grid.Nx2 + 2 * nghost,
level0_Grid.Nx1 + 2 * nghost,
sizeof(Real))) == NULL)
{
return -1;
}
return 0;
}
void problem_read_restart(Grid *pG, Domain *pD, FILE *fp)
{
/* Initialize boxsize */
x1min = par_getd("grid","x1min");
x1max = par_getd("grid","x1max");
x2min = par_getd("grid","x2min");
x2max = par_getd("grid","x2max");
x3min = par_getd("grid","x3min");
x3max = par_getd("grid","x3max");
x1c = 0.5*(x1min+x1max);
x2c = 0.5*(x2min+x2max);
x3c = 0.5*(x3min+x3max);
/* Read initial conditions for the gas */
v01 = par_getd("problem","v1");
v02 = par_getd("problem","v2");
v03 = par_getd("problem","v3");
fread(name, sizeof(char),50,fp);
return;
}
void Userwork_after_loop(MeshS *pM)
{
GridS *pG=pM->Domain[0][0].Grid;
int i,j,k,is,ie,js,je,ks,ke,iprob;
Real divB,maxdivB=0.0,maxB1=0.0,maxB2=0.0,maxB3=0.0;
is = pG->is; ie = pG->ie;
js = pG->js; je = pG->je;
ks = pG->ks; ke = pG->ke;
iprob = par_getd("problem","iprob");
for (k=ks; k<=ke; k++) {
for (j=js; j<=je; j++) {
for (i=is; i<=ie; i++) {
divB = (pG->B1i[k][j][i+1] - pG->B1i[k][j][i])/pG->dx1;
if (je > js)
divB += (pG->B2i[k][j+1][i] - pG->B2i[k][j][i])/pG->dx2;
if (ke > ks)
divB += (pG->B3i[k+1][j][i] - pG->B3i[k][j][i])/pG->dx3;
maxdivB = MAX(maxdivB,fabs(divB));
maxB1 = MAX(maxB1,fabs(pG->U[k][j][i].B1c));
maxB2 = MAX(maxB2,fabs(pG->U[k][j][i].B2c));
maxB3 = MAX(maxB3,fabs(pG->U[k][j][i].B3c));
}
}
}
if (maxdivB > 1.0e-16)
printf("WARNING: maxdivB=%e exceeds 1e-16\n",maxdivB);
if (iprob == 1){
if (maxB3 > 1.0e-17)
printf("WARNING: maxB3=%e exceeds 1e-17\n",maxB3);
} else if (iprob == 2){
if (maxB1 > 1.0e-17)
printf("WARNING: maxB1=%e exceeds 1e-17\n",maxB1);
} else if (iprob == 3){
if (maxB2 > 1.0e-17)
printf("WARNING: maxB2=%e exceeds 1e-17\n",maxB2);
}
return;
}
void problem_read_restart(MeshS *pM, FILE *fp)
{
DomainS *pD = (DomainS*)&(pM->Domain[0][0]);
GridS *pG = pD->Grid;
ShearingBoxPot = StratifiedDisk;
Omega_0 = par_getd("problem","omega");
qshear = par_getd_def("problem","qshear",1.5);
ipert = par_geti_def("problem","ipert",1);
x1min = pG->MinX[0];
x1max = pG->MaxX[0];
Lx = x1max - x1min;
x2min = pG->MinX[1];
x2max = pG->MaxX[1];
Ly = x2max - x2min;
x3min = pM->RootMinX[2];
x3max = pM->RootMaxX[2];
Lz = x3max - x3min;
Lg = nghost*pG->dx3; /* size of the ghost zone */
vsc1 = par_getd_def("problem","vsc1",0.05); /* in unit of iso_sound (N.B.!) */
vsc2 = par_getd_def("problem","vsc2",0.0);
vsc1 = vsc1 * Iso_csound;
vsc2 = vsc2 * Iso_csound;
Npar = (int)(sqrt(par_geti("particle","parnumgrid")));
nlis = par_geti_def("problem","nlis",pG->Nx[0]*pG->Nx[1]*pG->Nx[2]);
ntrack = par_geti_def("problem","ntrack",2000);
dump_history_enroll(hst_rho_Vx_dVy, "<rho Vx dVy>");
return;
}
void problem(DomainS *pDomain)
{
GridS *pGrid=(pDomain->Grid);
int i, is = pGrid->is, ie = pGrid->ie;
int j, js = pGrid->js, je = pGrid->je;
int k, ks = pGrid->ks, ke = pGrid->ke;
Real x1,x2,x3;
Real rho, p, prat, density, pressure, pi, vel, n, amp, lx, ly;
dt_line_integral_output = par_getd("problem", "dt_line_integral");
/* size of the domain (in physical coordinates) */
lx = pDomain->RootMaxX[0] - pDomain->RootMinX[0];
ly = pDomain->RootMaxX[1] - pDomain->RootMinX[1];
p = 1.0;
/* if prat=0.8, vx = -1.8965 (t&e find other vals)*/
pi=3.14159;
n = 2; /*Oscillations of perturbation*/
amp = 0.05 ; /* Size of perturbation ~ 0.05 */
/* setup uniform ambient medium with spherical over-pressured region */
for (k=ks; k<=ke; k++) {
for (j=js; j<=je; j++) {
for (i=is; i<=ie; i++) {
cc_pos(pGrid,i,j,k,&x1,&x2,&x3);
if (x1 > amp*sin(n*pi*x2/ly)) {
pressure = 0.1175;
} else {
pressure = 1;
}
if (x1 > amp*sin(n*pi*x2/ly)) {
vel= -1.96071;
} else {
vel= -0.7;
}
if (x1 > amp*sin(n*pi*x2/ly)) {
density= 0.357013;
} else {
density= 1;
}
pGrid->U[0][j][i].d = density;
pGrid->U[0][j][i].M1 = density*vel;
pGrid->U[0][j][i].M2 = 0.0;
#ifndef ISOTHERMAL
pGrid->U[0][j][i].E = pressure/Gamma_1 + (SQR(pGrid->U[0][j][i].M1) + SQR(pGrid->U[0][j][i].M2))/(2.0*(pGrid->U[0][j][i].d));
#endif
}
}
}
/* Adding history dumps*/
void dump_history_enroll(const ConsFun_t pfun, const char *label);
dump_history_enroll(pleft, "<pbvals>");
dump_history_enroll(vyintegral, "<vyintegral>");
/* enroll special functions */
bvals_mhd_fun(pDomain,left_x1, bc_ix1);
return;
}
void problem(DomainS *pDomain)
{
GridS *pGrid=(pDomain->Grid);
int i,il,iu,j,jl,ju,k,kl,ku;
int is,ie,js,je,ks,ke,nx1,nx2,nx3;
int shk_dir; /* Shock direction: {1,2,3} -> {x1,x2,x3} */
Real ang_2, ang_3; /* Rotation angles about the y and z' axis */
Real sin_a2, cos_a2, sin_a3, cos_a3;
Real x1,x2,x3;
Prim1DS Wl, Wr;
Cons1DS U1d, Ul, Ur;
Real Bxl=0.0, Bxr=0.0, Bxb=0.0;
/* speeds of shock, contact, head and foot of rarefaction for Sod test */
/* speeds of slow/fast shocks, Alfven wave and contact in RJ2a test */
Real tlim;
int err_test;
Real r,xs,xc,xf,xh,vs,vc,vf,vh;
Real xfp,xrp,xsp,xsm,xrm,xfm,vfp,vrp,vsp,vsm,vrm,vfm;
Real d0,v0,Mx,My,Mz,E0,r0,Bx,By,Bz;
#if (NSCALARS > 0)
int n;
#endif
is = pGrid->is; ie = pGrid->ie;
js = pGrid->js; je = pGrid->je;
ks = pGrid->ks; ke = pGrid->ke;
nx1 = (ie-is)+1 + 2*nghost;
nx2 = (je-js)+1 + 2*nghost;
nx3 = (ke-ks)+1 + 2*nghost;
printf("here1\n");
if (pDomain->Level == 0){
if ((RootSoln = (ConsS***)calloc_3d_array(nx3,nx2,nx1,sizeof(ConsS)))
== NULL) ath_error("[problem]: Error alloc memory for RootSoln\n");
}
/* Parse left state read from input file: dl,pl,ul,vl,wl,bxl,byl,bzl */
Wl.d = par_getd("problem","dl");
#ifdef ADIABATIC
Wl.P = par_getd("problem","pl");
#endif
Wl.Vx = par_getd("problem","v1l");
Wl.Vy = par_getd("problem","v2l");
Wl.Vz = par_getd("problem","v3l");
#ifdef MHD
Bxl = par_getd("problem","b1l");
Wl.By = par_getd("problem","b2l");
Wl.Bz = par_getd("problem","b3l");
#endif
#if (NSCALARS > 0)
Wl.r[0] = par_getd("problem","r0l");
#endif
/* Parse right state read from input file: dr,pr,ur,vr,wr,bxr,byr,bzr */
Wr.d = par_getd("problem","dr");
#ifdef ADIABATIC
Wr.P = par_getd("problem","pr");
#endif
Wr.Vx = par_getd("problem","v1r");
Wr.Vy = par_getd("problem","v2r");
Wr.Vz = par_getd("problem","v3r");
#ifdef MHD
Bxr = par_getd("problem","b1r");
Wr.By = par_getd("problem","b2r");
Wr.Bz = par_getd("problem","b3r");
if (Bxr != Bxl) ath_error(0,"[shkset1d] L/R values of Bx not the same\n");
#endif
#if (NSCALARS > 0)
Wr.r[0] = par_getd("problem","r0r");
#endif
printf("here2\n");
#ifdef SAC_INTEGRATOR
Ul = Prim1D_to_Cons1D(&Wl, &Bxl,&Bxb);
Ur = Prim1D_to_Cons1D(&Wr, &Bxr,&Bxb);
#elif defined SMAUG_INTEGRATOR
Ul = Prim1D_to_Cons1D(&Wl, &Bxl,&Bxb);
Ur = Prim1D_to_Cons1D(&Wr, &Bxr,&Bxb);
#else
Ul = Prim1D_to_Cons1D(&Wl, &Bxl);
Ur = Prim1D_to_Cons1D(&Wr, &Bxr);
#endif
printf("here3\n");
/* Parse shock direction */
shk_dir = par_geti("problem","shk_dir");
if (shk_dir != 1 && shk_dir != 2 && shk_dir != 3) {
ath_error("[problem]: shk_dir = %d must be either 1,2 or 3\n",shk_dir);
}
/* Set up the index bounds for initializing the grid */
iu = pGrid->ie + nghost;
il = pGrid->is - nghost;
if (pGrid->Nx[1] > 1) {
ju = pGrid->je + nghost;
jl = pGrid->js - nghost;
}
else {
ju = pGrid->je;
jl = pGrid->js;
}
if (pGrid->Nx[2] > 1) {
ku = pGrid->ke + nghost;
kl = pGrid->ks - nghost;
}
else {
ku = pGrid->ke;
kl = pGrid->ks;
}
printf("here4\n");
/* Initialize the grid including the ghost cells. Discontinuity is always
* located at x=0, so xmin/xmax in input file must be set appropriately. */
switch(shk_dir) {
/*--- shock in 1-direction ---------------------------------------------------*/
case 1: /* shock in 1-direction */
ang_2 = 0.0;
ang_3 = 0.0;
for (k=kl; k<=ku; k++) {
for (j=jl; j<=ju; j++) {
for (i=il; i<=iu; i++) {
cc_pos(pGrid, i, j, k, &x1, &x2, &x3);
/* set primitive and conserved variables to be L or R state */
if (x1 <= 0.0) {
U1d = Ul;
} else {
U1d = Ur;
}
/* Initialize conserved (and with SR the primitive) variables in Grid */
pGrid->U[k][j][i].d = U1d.d;
pGrid->U[k][j][i].M1 = U1d.Mx;
pGrid->U[k][j][i].M2 = U1d.My;
pGrid->U[k][j][i].M3 = U1d.Mz;
#ifdef MHD
pGrid->B1i[k][j][i] = Bxl;
pGrid->B2i[k][j][i] = U1d.By;
pGrid->B3i[k][j][i] = U1d.Bz;
pGrid->U[k][j][i].B1c = Bxl;
pGrid->U[k][j][i].B2c = U1d.By;
pGrid->U[k][j][i].B3c = U1d.Bz;
#endif
#ifdef ADIABATIC
pGrid->U[k][j][i].E = U1d.E;
#endif
#if (NSCALARS > 0)
pGrid->U[k][j][i].s[0] = U1d.s[0];
#endif
}
}
}
break;
/*--- shock in 2-direction ---------------------------------------------------*/
case 2: /* shock in 2-direction */
ang_2 = 0.0;
ang_3 = PI/2.0;
for (k=kl; k<=ku; k++) {
for (j=jl; j<=ju; j++) {
for (i=il; i<=iu; i++) {
cc_pos(pGrid, i, j, k, &x1, &x2, &x3);
/* set primitive variables to be L or R state */
if (x2 <= 0.0) {
U1d = Ul;
} else {
U1d = Ur;
}
/* Initialize conserved (and with SR the primitive) variables in Grid */
pGrid->U[k][j][i].d = U1d.d;
pGrid->U[k][j][i].M1 = -U1d.My;
pGrid->U[k][j][i].M2 = U1d.Mx;
pGrid->U[k][j][i].M3 = U1d.Mz;
#ifdef MHD
pGrid->B1i[k][j][i] = -U1d.By;
pGrid->B2i[k][j][i] = Bxl;
pGrid->B3i[k][j][i] = U1d.Bz;
pGrid->U[k][j][i].B1c = -U1d.By;
pGrid->U[k][j][i].B2c = Bxl;
pGrid->U[k][j][i].B3c = U1d.Bz;
#endif
#ifdef ADIABATIC
pGrid->U[k][j][i].E = U1d.E;
#endif
#if (NSCALARS > 0)
pGrid->U[k][j][i].s[0] = U1d.s[0];
#endif
}
}
}
break;
/*--- shock in 3-direction ---------------------------------------------------*/
case 3: /* shock in 3-direction */
ang_2 = PI/2.0;
ang_3 = 0.0;
for (k=kl; k<=ku; k++) {
for (j=jl; j<=ju; j++) {
for (i=il; i<=iu; i++) {
cc_pos(pGrid, i, j, k, &x1, &x2, &x3);
/* set primitive variables to be L or R state */
if (x3 <= 0.0) {
U1d = Ul;
} else {
U1d = Ur;
}
/* Initialize conserved (and with SR the primitive) variables in Grid */
pGrid->U[k][j][i].d = U1d.d;
pGrid->U[k][j][i].M1 = -U1d.Mz;
pGrid->U[k][j][i].M2 = U1d.My;
pGrid->U[k][j][i].M3 = U1d.Mx;
#ifdef MHD
pGrid->B1i[k][j][i] = -U1d.Bz;
pGrid->B2i[k][j][i] = U1d.By;
pGrid->B3i[k][j][i] = Bxl;
pGrid->U[k][j][i].B1c = -U1d.Bz;
pGrid->U[k][j][i].B2c = U1d.By;
pGrid->U[k][j][i].B3c = Bxl;
#endif
#ifdef ADIABATIC
pGrid->U[k][j][i].E = U1d.E;
#endif
#if (NSCALARS > 0)
pGrid->U[k][j][i].s[0] = U1d.s[0];
#endif
}
}
}
break;
default:
ath_error("[shkset1d]: invalid shk_dir = %i\n",shk_dir);
}
/* Compute Analytic solution for Sod and RJ4a tests, if required */
tlim = par_getd("time","tlim");
err_test = par_getd_def("problem","error_test",0);
if (err_test == 1) {
sin_a3 = sin(ang_3);
cos_a3 = cos(ang_3);
sin_a2 = sin(ang_2);
cos_a2 = cos(ang_2);
/* wave speeds for Sod test */
#ifdef HYDRO
vs = 1.7522; xs = vs*tlim;
vc = 0.92745; xc = vc*tlim;
vf = -0.07027; xf = vf*tlim;
vh = -1.1832; xh = vh*tlim;
#endif /* HYDRO */
/* wave speeds for RJ2a test */
#ifdef MHD
vfp = 2.2638; xfp = vfp*tlim;
vrp = (0.53432 + 1.0/sqrt(PI*1.309)); xrp = vrp*tlim;
vsp = (0.53432 + 0.48144/1.309); xsp = vsp*tlim;
vc = 0.57538; xc = vc*tlim;
vsm = (0.60588 - 0.51594/1.4903); xsm = vsm*tlim;
vrm = (0.60588 - 1.0/sqrt(PI*1.4903)); xrm = vrm*tlim;
vfm = (1.2 - 2.3305/1.08); xfm = vfm*tlim;
#endif /* MHD */
for (k=ks; k<=ke; k++) {
for (j=js; j<=je; j++) {
for (i=is; i<=ie; i++) {
cc_pos(pGrid,i,j,k,&x1,&x2,&x3);
r = cos_a2*(x1*cos_a3 + x2*sin_a3) + x3*sin_a2;
/* Sod solution */
#ifdef HYDRO
My = Mz = 0.0;
if (r > xs) {
d0 = 0.125;
Mx = 0.0;
E0 = 0.25;
r0 = 0.0;
} else if (r > xc) {
d0 = 0.26557;
Mx = 0.92745*d0;
E0 = 0.87204;
r0 = 0.0;
} else if (r > xf) {
d0 = 0.42632;
Mx = 0.92745*d0;
E0 = 0.94118;
r0 = 1.0;
} else if (r > xh) {
v0 = 0.92745*(r-xh)/(xf-xh);
d0 = 0.42632*pow((1.0+0.20046*(0.92745-v0)),5);
E0 = (0.30313*pow((1.0+0.20046*(0.92745-v0)),7))/0.4 + 0.5*d0*v0*v0;
r0 = 1.0;
Mx = v0*d0;
} else {
d0 = 1.0;
Mx = 0.0;
E0 = 2.5;
r0 = 1.0;
}
#endif /* HYDRO */
/* RJ2a solution (Dai & Woodward 1994 Tables Ia and Ib) */
#ifdef MHD
Bx = 2.0/sqrt(4.0*PI);
if (r > xfp) {
d0 = 1.0;
Mx = 0.0;
My = 0.0;
Mz = 0.0;
By = 4.0/sqrt(4.0*PI);
Bz = 2.0/sqrt(4.0*PI);
E0 = 1.0/Gamma_1 + 0.5*((Mx*Mx+My*My+Mz*Mz)/d0 + (Bx*Bx+By*By+Bz*Bz));
r0 = 0.0;
} else if (r > xrp) {
d0 = 1.3090;
Mx = 0.53432*d0;
My = -0.094572*d0;
Mz = -0.047286*d0;
By = 5.3452/sqrt(4.0*PI);
Bz = 2.6726/sqrt(4.0*PI);
E0 = 1.5844/Gamma_1 + 0.5*((Mx*Mx+My*My+Mz*Mz)/d0 + (Bx*Bx+By*By+Bz*Bz));
r0 = 0.0;
} else if (r > xsp) {
d0 = 1.3090;
Mx = 0.53432*d0;
My = -0.18411*d0;
Mz = 0.17554*d0;
By = 5.7083/sqrt(4.0*PI);
Bz = 1.7689/sqrt(4.0*PI);
E0 = 1.5844/Gamma_1 + 0.5*((Mx*Mx+My*My+Mz*Mz)/d0 + (Bx*Bx+By*By+Bz*Bz));
r0 = 0.0;
} else if (r > xc) {
d0 = 1.4735;
Mx = 0.57538*d0;
My = 0.047601*d0;
Mz = 0.24734*d0;
By = 5.0074/sqrt(4.0*PI);
Bz = 1.5517/sqrt(4.0*PI);
E0 = 1.9317/Gamma_1 + 0.5*((Mx*Mx+My*My+Mz*Mz)/d0 + (Bx*Bx+By*By+Bz*Bz));
r0 = 0.0;
} else if (r > xsm) {
d0 = 1.6343;
Mx = 0.57538*d0;
My = 0.047601*d0;
Mz = 0.24734*d0;
By = 5.0074/sqrt(4.0*PI);
Bz = 1.5517/sqrt(4.0*PI);
E0 = 1.9317/Gamma_1 + 0.5*((Mx*Mx+My*My+Mz*Mz)/d0 + (Bx*Bx+By*By+Bz*Bz));
r0 = 1.0;
} else if (r > xrm) {
d0 = 1.4903;
Mx = 0.60588*d0;
My = 0.22157*d0;
Mz = 0.30125*d0;
By = 5.5713/sqrt(4.0*PI);
Bz = 1.7264/sqrt(4.0*PI);
E0 = 1.6558/Gamma_1 + 0.5*((Mx*Mx+My*My+Mz*Mz)/d0 + (Bx*Bx+By*By+Bz*Bz));
r0 = 1.0;
} else if (r > xfm) {
d0 = 1.4903;
Mx = 0.60588*d0;
My = 0.11235*d0;
Mz = 0.55686*d0;
By = 5.0987/sqrt(4.0*PI);
Bz = 2.8326/sqrt(4.0*PI);
E0 = 1.6558/Gamma_1 + 0.5*((Mx*Mx+My*My+Mz*Mz)/d0 + (Bx*Bx+By*By+Bz*Bz));
r0 = 1.0;
} else {
d0 = 1.08;
Mx = 1.2*d0;
My = 0.01*d0;
Mz = 0.5*d0;
By = 3.6/sqrt(4.0*PI);
Bz = 2.0/sqrt(4.0*PI);
E0 = 0.95/Gamma_1 + 0.5*((Mx*Mx+My*My+Mz*Mz)/d0 + (Bx*Bx+By*By+Bz*Bz));
r0 = 1.0;
}
#endif /* MHD */
RootSoln[k][j][i].d = d0;
RootSoln[k][j][i].M1 = Mx*cos_a2*cos_a3 - My*sin_a3 - Mz*sin_a2*cos_a3;
RootSoln[k][j][i].M2 = Mx*cos_a2*sin_a3 + My*cos_a3 - Mz*sin_a2*sin_a3;
RootSoln[k][j][i].M3 = Mx*sin_a2 + Mz*cos_a2;
#ifdef MHD
RootSoln[k][j][i].B1c = Bx*cos_a2*cos_a3 - By*sin_a3 - Bz*sin_a2*cos_a3;
RootSoln[k][j][i].B2c = Bx*cos_a2*sin_a3 + By*cos_a3 - Bz*sin_a2*sin_a3;
RootSoln[k][j][i].B3c = Bx*sin_a2 + Bz*cos_a2;
#endif /* MHD */
#ifndef ISOTHERMAL
RootSoln[k][j][i].E = E0;
#endif /* ISOTHERMAL */
#if (NSCALARS > 0)
for (n=0; n<NSCALARS; n++) RootSoln[k][j][i].s[n] = r0*d0;
#endif
}
}}
} /* end calculation of analytic (root) solution */
return;
}
void problem(DomainS *pDomain)
{
GridS *pGrid = pDomain->Grid;
int i=0,j=0,k=0;
int is,ie,js,je,ks,ke,iprob;
long int iseed = -1;
Real amp,x1,x2,x3,lx,ly,lz,rhoh,L_rot,fact;
#ifdef MHD
Real b0,angle;
#endif
int ixs, jxs, kxs;
is = pGrid->is; ie = pGrid->ie;
js = pGrid->js; je = pGrid->je;
ks = pGrid->ks; ke = pGrid->ke;
lx = pDomain->RootMaxX[0] - pDomain->RootMinX[0];
ly = pDomain->RootMaxX[1] - pDomain->RootMinX[1];
lz = pDomain->RootMaxX[2] - pDomain->RootMinX[2];
/* Ensure a different initial random seed for each process in an MPI calc. */
ixs = pGrid->Disp[0];
jxs = pGrid->Disp[1];
kxs = pGrid->Disp[2];
iseed = -1 - (ixs + pDomain->Nx[0]*(jxs + pDomain->Nx[1]*kxs));
/* Read perturbation amplitude, problem switch, background density */
amp = par_getd("problem","amp");
iprob = par_geti("problem","iprob");
rhoh = par_getd_def("problem","rhoh",3.0);
/* Distance over which field is rotated */
L_rot = par_getd_def("problem","L_rot",0.0);
/* Read magnetic field strength, angle [should be in degrees, 0 is along +ve
* X-axis (no rotation)] */
#ifdef MHD
b0 = par_getd("problem","b0");
angle = par_getd("problem","angle");
angle = (angle/180.)*PI;
#endif
/* 2D PROBLEM --------------------------------------------------------------- */
/* Initialize two fluids with interface at y=0.0. Pressure scaled to give a
* sound speed of 1 at the interface in the light (lower, d=1) fluid
* Perturb V2 using single (iprob=1) or multiple (iprob=2) mode
*/
if (pGrid->Nx[2] == 1) {
for (k=ks; k<=ke; k++) {
for (j=js; j<=je; j++) {
for (i=is; i<=ie; i++) {
cc_pos(pGrid,i,j,k,&x1,&x2,&x3);
pGrid->U[k][j][i].d = 1.0;
pGrid->U[k][j][i].E = (1.0/Gamma - 0.1*x2)/Gamma_1;
pGrid->U[k][j][i].M1 = 0.0;
if (iprob == 1) {
pGrid->U[k][j][i].M2 = amp/4.0*
(1.0+cos(2.0*PI*x1/lx))*(1.0+cos(2.0*PI*x2/ly));
}
else {
pGrid->U[k][j][i].M2 = amp*(ran2(&iseed) - 0.5)*
(1.0+cos(2.0*PI*x2/ly));
}
pGrid->U[k][j][i].M3 = 0.0;
if (x2 > 0.0) {
pGrid->U[k][j][i].d = 2.0;
pGrid->U[k][j][i].M2 *= 2.0;
pGrid->U[k][j][i].E = (1.0/Gamma - 0.2*x2)/Gamma_1;
}
pGrid->U[k][j][i].E+=0.5*SQR(pGrid->U[k][j][i].M2)/pGrid->U[k][j][i].d;
#ifdef MHD
pGrid->B1i[k][j][i] = b0;
pGrid->U[k][j][i].B1c = b0;
pGrid->U[k][j][i].E += 0.5*b0*b0;
#endif
}
#ifdef MHD
pGrid->B1i[k][j][ie+1] = b0;
#endif
}
}
/* Enroll gravitational potential to give acceleration in y-direction for 2D
* Use special boundary condition routines. In 2D, gravity is in the
* y-direction, so special boundary conditions needed for x2
*/
StaticGravPot = grav_pot2;
if (pDomain->Disp[1] == 0) bvals_mhd_fun(pDomain, left_x2, reflect_ix2);
if (pDomain->MaxX[1] == pDomain->RootMaxX[1])
bvals_mhd_fun(pDomain, right_x2, reflect_ox2);
} /* end of 2D initialization */
/* 3D PROBLEM ----------------------------------------------------------------*/
/* Initialize two fluids with interface at z=0.0
* Pressure scaled to give a sound speed of 1 at the interface
* in the light (lower, d=1) fluid
* iprob = 1 -- Perturb V3 using single mode
* iprob = 2 -- Perturb V3 using multiple mode
* iprob = 3 -- B in light fluid only, with multimode perturbation
* iprob = 4 -- B rotated by "angle" at interface, multimode perturbation
*/
if (pGrid->Nx[2] > 1) {
for (k=ks; k<=ke; k++) {
for (j=js; j<=je; j++) {
for (i=is; i<=ie; i++) {
cc_pos(pGrid,i,j,k,&x1,&x2,&x3);
pGrid->U[k][j][i].d = 1.0;
pGrid->U[k][j][i].E = (1.0/Gamma - 0.1*x3)/Gamma_1;
pGrid->U[k][j][i].M1 = 0.0;
pGrid->U[k][j][i].M2 = 0.0;
if (iprob == 1) {
pGrid->U[k][j][i].M3 = amp/8.0*(1.0+cos(2.0*PI*x1/lx))*
(1.0+cos(2.0*PI*x2/ly))*(1.0+cos(2.0*PI*x3/lz));
}
else {
pGrid->U[k][j][i].M3 = amp*(ran2(&iseed) - 0.5)*
(1.0+cos(2.0*PI*x3/lz));
}
if (x3 > 0.0) {
pGrid->U[k][j][i].d = rhoh;
pGrid->U[k][j][i].M3 *= rhoh;
pGrid->U[k][j][i].E = (1.0/Gamma - 0.1*rhoh*x3)/Gamma_1;
}
pGrid->U[k][j][i].E+=0.5*SQR(pGrid->U[k][j][i].M3)/pGrid->U[k][j][i].d;
#ifdef MHD
switch(iprob){
case 3: /* B only in light fluid, do not add B^2 to E, total P const */
if (x3 <= 0.0) {
pGrid->B1i[k][j][i] = b0;
if (i == ie) pGrid->B1i[k][j][ie+1] = b0;
pGrid->U[k][j][i].B1c = b0;
}
break;
case 4: /* discontinuous rotation of B by angle at interface */
if (x3 <= 0.0) {
pGrid->B1i[k][j][i] = b0;
if (i == ie) pGrid->B1i[k][j][ie+1] = b0;
pGrid->U[k][j][i].B1c = b0;
pGrid->U[k][j][i].E += 0.5*b0*b0;
}
else {
pGrid->B1i[k][j][i] = b0*cos(angle);
pGrid->B2i[k][j][i] = b0*sin(angle);
if (i == ie) pGrid->B1i[k][j][ie+1] = b0*cos(angle);
if (j == je) pGrid->B2i[k][je+1][i] = b0*sin(angle);
pGrid->U[k][j][i].B1c = b0*cos(angle);
pGrid->U[k][j][i].B2c = b0*sin(angle);
pGrid->U[k][j][i].E += 0.5*b0*b0;
}
break;
case 5: /* rotation of B by angle over distance L_rot at interface */
if (x3 <= (-L_rot/2.0)) {
pGrid->B1i[k][j][i] = b0;
if (i == ie) pGrid->B1i[k][j][ie+1] = b0;
pGrid->U[k][j][i].B1c = b0;
pGrid->U[k][j][i].E += 0.5*b0*b0;
}
else if (x3 >= (L_rot/2.0)) {
pGrid->B1i[k][j][i] = b0*cos(angle);
pGrid->B2i[k][j][i] = b0*sin(angle);
if (i == ie) pGrid->B1i[k][j][ie+1] = b0*cos(angle);
if (j == je) pGrid->B2i[k][je+1][i] = b0*sin(angle);
pGrid->U[k][j][i].B1c = b0*cos(angle);
pGrid->U[k][j][i].B2c = b0*sin(angle);
pGrid->U[k][j][i].E += 0.5*b0*b0;
}
else {
fact = ((L_rot/2.0)+x3)/L_rot;
pGrid->B1i[k][j][i] = b0*cos(fact*angle);
pGrid->B2i[k][j][i] = b0*sin(fact*angle);
if (i == ie) pGrid->B1i[k][j][ie+1] = b0*cos(fact*angle);
if (j == je) pGrid->B2i[k][je+1][i] = b0*sin(fact*angle);
pGrid->U[k][j][i].B1c = b0*cos(fact*angle);
pGrid->U[k][j][i].B2c = b0*sin(fact*angle);
pGrid->U[k][j][i].E += 0.5*b0*b0;
}
break;
default:
pGrid->B1i[k][j][i] = b0;
if (i == ie) pGrid->B1i[k][j][ie+1] = b0;
pGrid->U[k][j][i].B1c = b0;
pGrid->U[k][j][i].E += 0.5*b0*b0;
}
#endif
}
}
}
/* Enroll gravitational potential to give accn in z-direction for 3D
* Use special boundary condition routines. In 3D, gravity is in the
* z-direction, so special boundary conditions needed for x3
*/
StaticGravPot = grav_pot3;
//if (pDomain->Disp[2] == 0) bvals_mhd_fun(pDomain, left_x3, reflect_ix3);
//if (pDomain->MaxX[2] == pDomain->RootMaxX[2])
// bvals_mhd_fun(pDomain, right_x3, reflect_ox3);
} /* end of 3D initialization */
return;
}
/* problem: */
void problem(DomainS *pDomain)
{
GridS *pG = pDomain->Grid;
int i,j,k,n,converged;
int is,ie,il,iu,js,je,jl,ju,ks,ke,kl,ku;
int nx1, nx2, nx3;
Real x1, x2, x3;
Real a,b,c,d,xmin,xmax,ymin,ymax;
Real x,y,xslow,yslow,xfast,yfast;
Real R0,R1,R2,rho,Mdot,K,Omega,Pgas,beta,vR,BR,vphi,Bphi;
ConsS *Wind=NULL;
Real *pU=NULL,*pUl=NULL,*pUr=NULL;
Real lsf,rsf;
is = pG->is; ie = pG->ie; nx1 = ie-is+1;
js = pG->js; je = pG->je; nx2 = je-js+1;
ks = pG->ks; ke = pG->ke; nx3 = ke-ks+1;
il = is-nghost*(nx1>1); iu = ie+nghost*(nx1>1); nx1 = iu-il+1;
jl = js-nghost*(nx2>1); ju = je+nghost*(nx2>1); nx2 = ju-jl+1;
kl = ks-nghost*(nx3>1); ku = ke+nghost*(nx3>1); nx3 = ku-kl+1;
#ifndef CYLINDRICAL
ath_error("[cylwindrotb]: This problem only works in cylindrical!\n");
#endif
#ifndef MHD
ath_error("[cylwindrotb]: This problem only works in MHD!\n");
#endif
if (nx1==1) {
ath_error("[cylwindrotb]: Only R can be used in 1D!\n");
}
else if (nx2==1 && nx3>1) {
ath_error("[cylwindrotb]: Only (R,phi) can be used in 2D!\n");
}
/* Allocate memory for wind solution */
if ((Wind = (ConsS*)calloc_1d_array(nx1+1,sizeof(ConsS))) == NULL)
ath_error("[cylwindrotb]: Error allocating memory\n");
/* Allocate memory for grid solution */
if ((RootSoln = (ConsS***)calloc_3d_array(nx3,nx2,nx1,sizeof(ConsS))) == NULL)
ath_error("[cylwindrotb]: Error allocating memory\n");
theta = par_getd("problem","theta");
omega = par_getd("problem","omega");
vz = par_getd("problem","vz");
/* This numerical solution was obtained from MATLAB.
* Ideally, we replace this with a nonlinear solver... */
xslow = 0.5243264128;
yslow = 2.4985859152;
xfast = 1.6383327831;
yfast = 0.5373957134;
E = 7.8744739104;
eta = 2.3608500383;
xmin = par_getd("domain1","x1min")/R_A;
xmax = par_getd("domain1","x1max")/R_A;
ymin = 0.45/rho_A;
ymax = 2.6/rho_A;
printf("theta = %f,\t omega = %f,\t eta = %f,\t E = %f\n", theta,omega,eta,E);
printf("xslow = %f,\t yslow = %f,\t xfast = %f,\t yfast = %f\n", xslow,yslow,xfast,yfast);
printf("xmin = %f,\t ymin = %f,\t xmax = %f,\t ymax = %f\n", xmin,ymin,xmax,ymax);
/* Calculate the 1D wind solution at cell-interfaces */
for (i=il; i<=iu+1; i++) {
memset(&(Wind[i]),0.0,sizeof(ConsS));
cc_pos(pG,i,js,ks,&x1,&x2,&x3);
/* Want the solution at R-interfaces */
R0 = x1 - 0.5*pG->dx1;
x = R0/R_A;
/* Look for a sign change interval */
if (x < xslow) {
sign_change(myfunc,yslow,10.0*ymax,x,&a,&b);
sign_change(myfunc,b,10.0*ymax,x,&a,&b);
} else if (x < 1.0) {
sign_change(myfunc,1.0+TINY_NUMBER,yslow,x,&a,&b);
} else if (x < xfast) {
sign_change(myfunc,yfast,1.0-TINY_NUMBER,x,&a,&b);
if (!sign_change(myfunc,b,1.0-TINY_NUMBER,x,&a,&b)) {
a = yfast;
b = 1.0-TINY_NUMBER;
}
} else {
sign_change(myfunc,0.5*ymin,yfast,x,&a,&b);
}
/* Use bisection to find the root */
converged = bisection(myfunc,a,b,x,&y);
if(!converged) {
ath_error("[cylwindrotb]: Bisection did not converge!\n");
}
/* Construct the solution */
rho = rho_A*y;
Mdot = sqrt(R_A*SQR(rho_A)*GM*eta);
Omega = sqrt((GM*omega)/pow(R_A,3));
K = (GM*theta)/(Gamma*pow(rho_A,Gamma_1)*R_A);
Pgas = K*pow(rho,Gamma);
vR = Mdot/(R0*rho);
beta = sqrt(1.0/rho_A);
BR = beta*rho*vR;
vphi = R0*Omega*(1.0/SQR(x)-y)/(1.0-y);
Bphi = beta*rho*(vphi-R0*Omega);
Wind[i].d = rho;
Wind[i].M1 = rho*vR;
Wind[i].M2 = rho*vphi;
Wind[i].M3 = rho*vz;
Wind[i].B1c = BR;
Wind[i].B2c = Bphi;
Wind[i].B3c = 0.0;
Wind[i].E = Pgas/Gamma_1
+ 0.5*(SQR(Wind[i].B1c) + SQR(Wind[i].B2c) + SQR(Wind[i].B3c))
+ 0.5*(SQR(Wind[i].M1 ) + SQR(Wind[i].M2 ) + SQR(Wind[i].M3 ))/Wind[i].d;
}
/* Average the wind solution across the zone for cc variables */
for (i=il; i<=iu; i++) {
memset(&(pG->U[ks][js][i]),0.0,sizeof(ConsS));
cc_pos(pG,i,js,ks,&x1,&x2,&x3);
lsf = (x1 - 0.5*pG->dx1)/x1;
rsf = (x1 + 0.5*pG->dx1)/x1;
pU = (Real*)&(pG->U[ks][js][i]);
pUl = (Real*)&(Wind[i]);
pUr = (Real*)&(Wind[i+1]);
for (n=0; n<NWAVE; n++) {
pU[n] = 0.5*(lsf*pUl[n] + rsf*pUr[n]);
}
pG->B1i[ks][js][i] = Wind[i].B1c;
pG->B2i[ks][js][i] = 0.5*(lsf*Wind[i].B2c + rsf*Wind[i+1].B2c);
pG->B3i[ks][js][i] = 0.5*(lsf*Wind[i].B3c + rsf*Wind[i+1].B3c);
}
/* Copy 1D solution across the grid and save */
for (k=kl; k<=ku; k++) {
for (j=jl; j<=ju; j++) {
for (i=il; i<=iu; i++) {
pG->U[k][j][i] = pG->U[ks][js][i];
pG->B1i[k][j][i] = pG->B1i[ks][js][i];
pG->B2i[k][j][i] = pG->B2i[ks][js][i];
pG->B3i[k][j][i] = pG->B3i[ks][js][i];
RootSoln[k][j][i] = pG->U[ks][js][i];
}
}
}
StaticGravPot = grav_pot;
bvals_mhd_fun(pDomain,left_x1,do_nothing_bc);
bvals_mhd_fun(pDomain,right_x1,do_nothing_bc);
free_1d_array((void *)Wind);
return;
}
void problem(DomainS *pDomain)
{
GridS *pGrid=(pDomain->Grid);
int i,il,iu,j,jl,ju,k,kl,ku;
int shk_dir; /* Shock direction: {1,2,3} -> {x1,x2,x3} */
Real x1,x2,x3;
Prim1DS Wl, Wr;
Cons1DS U1d, Ul, Ur;
Real Bxl=0.0, Bxr=0.0;
/* Parse left state read from input file: dl,pl,ul,vl,wl,bxl,byl,bzl */
Wl.d = par_getd("problem","dl");
#ifdef ADIABATIC
Wl.P = par_getd("problem","pl");
#endif
Wl.Vx = par_getd("problem","v1l");
Wl.Vy = par_getd("problem","v2l");
Wl.Vz = par_getd("problem","v3l");
#ifdef MHD
Bxl = par_getd("problem","b1l");
Wl.By = par_getd("problem","b2l");
Wl.Bz = par_getd("problem","b3l");
#endif
#if (NSCALARS > 0)
Wl.r[0] = par_getd("problem","r[0]l");
#endif
/* Parse right state read from input file: dr,pr,ur,vr,wr,bxr,byr,bzr */
Wr.d = par_getd("problem","dr");
#ifdef ADIABATIC
Wr.P = par_getd("problem","pr");
#endif
Wr.Vx = par_getd("problem","v1r");
Wr.Vy = par_getd("problem","v2r");
Wr.Vz = par_getd("problem","v3r");
#ifdef MHD
Bxr = par_getd("problem","b1r");
Wr.By = par_getd("problem","b2r");
Wr.Bz = par_getd("problem","b3r");
if (Bxr != Bxl) ath_error(0,"[shkset1d] L/R values of Bx not the same\n");
#endif
#if (NSCALARS > 0)
Wr.r[0] = par_getd("problem","r[0]r");
#endif
Ul = Prim1D_to_Cons1D(&Wl, &Bxl);
Ur = Prim1D_to_Cons1D(&Wr, &Bxr);
/* Parse shock direction */
shk_dir = par_geti("problem","shk_dir");
if (shk_dir != 1 && shk_dir != 2 && shk_dir != 3) {
ath_error("[problem]: shk_dir = %d must be either 1,2 or 3\n",shk_dir);
}
/* Set up the index bounds for initializing the grid */
iu = pGrid->ie + nghost;
il = pGrid->is - nghost;
if (pGrid->Nx[1] > 1) {
ju = pGrid->je + nghost;
jl = pGrid->js - nghost;
}
else {
ju = pGrid->je;
jl = pGrid->js;
}
if (pGrid->Nx[2] > 1) {
ku = pGrid->ke + nghost;
kl = pGrid->ks - nghost;
}
else {
ku = pGrid->ke;
kl = pGrid->ks;
}
/* Initialize the grid including the ghost cells. Discontinuity is always
* located at x=0, so xmin/xmax in input file must be set appropriately. */
switch(shk_dir) {
/*--- shock in 1-direction ---------------------------------------------------*/
case 1: /* shock in 1-direction */
for (k=kl; k<=ku; k++) {
for (j=jl; j<=ju; j++) {
for (i=il; i<=iu; i++) {
cc_pos(pGrid, i, j, k, &x1, &x2, &x3);
/* set primitive and conserved variables to be L or R state */
if (x1 <= 0.0) {
U1d = Ul;
} else {
U1d = Ur;
}
/* Initialize conserved (and with SR the primitive) variables in Grid */
pGrid->U[k][j][i].d = U1d.d;
pGrid->U[k][j][i].M1 = U1d.Mx;
pGrid->U[k][j][i].M2 = U1d.My;
pGrid->U[k][j][i].M3 = U1d.Mz;
#ifdef MHD
pGrid->B1i[k][j][i] = Bxl;
pGrid->B2i[k][j][i] = U1d.By;
pGrid->B3i[k][j][i] = U1d.Bz;
pGrid->U[k][j][i].B1c = Bxl;
pGrid->U[k][j][i].B2c = U1d.By;
pGrid->U[k][j][i].B3c = U1d.Bz;
#endif
#ifdef ADIABATIC
pGrid->U[k][j][i].E = U1d.E;
#endif
#if (NSCALARS > 0)
pGrid->U[k][j][i].s[0] = U1d.s[0];
#endif
}
}
}
break;
/*--- shock in 2-direction ---------------------------------------------------*/
case 2: /* shock in 2-direction */
for (k=kl; k<=ku; k++) {
for (j=jl; j<=ju; j++) {
for (i=il; i<=iu; i++) {
cc_pos(pGrid, i, j, k, &x1, &x2, &x3);
/* set primitive variables to be L or R state */
if (x2 <= 0.0) {
U1d = Ul;
} else {
U1d = Ur;
}
/* Initialize conserved (and with SR the primitive) variables in Grid */
pGrid->U[k][j][i].d = U1d.d;
pGrid->U[k][j][i].M1 = U1d.Mz;
pGrid->U[k][j][i].M2 = U1d.Mx;
pGrid->U[k][j][i].M3 = U1d.My;
#ifdef MHD
pGrid->B1i[k][j][i] = U1d.Bz;
pGrid->B2i[k][j][i] = Bxl;
pGrid->B3i[k][j][i] = U1d.By;
pGrid->U[k][j][i].B1c = U1d.Bz;
pGrid->U[k][j][i].B2c = Bxl;
pGrid->U[k][j][i].B3c = U1d.By;
#endif
#ifdef ADIABATIC
pGrid->U[k][j][i].E = U1d.E;
#endif
#if (NSCALARS > 0)
pGrid->U[k][j][i].s[0] = U1d.s[0];
#endif
}
}
}
break;
/*--- shock in 3-direction ---------------------------------------------------*/
case 3: /* shock in 3-direction */
for (k=kl; k<=ku; k++) {
for (j=jl; j<=ju; j++) {
for (i=il; i<=iu; i++) {
cc_pos(pGrid, i, j, k, &x1, &x2, &x3);
/* set primitive variables to be L or R state */
if (x3 <= 0.0) {
U1d = Ul;
} else {
U1d = Ur;
}
/* Initialize conserved (and with SR the primitive) variables in Grid */
pGrid->U[k][j][i].d = U1d.d;
pGrid->U[k][j][i].M1 = U1d.My;
pGrid->U[k][j][i].M2 = U1d.Mz;
pGrid->U[k][j][i].M3 = U1d.Mx;
#ifdef MHD
pGrid->B1i[k][j][i] = U1d.By;
pGrid->B2i[k][j][i] = U1d.Bz;
pGrid->B3i[k][j][i] = Bxl;
pGrid->U[k][j][i].B1c = U1d.By;
pGrid->U[k][j][i].B2c = U1d.Bz;
pGrid->U[k][j][i].B3c = Bxl;
#endif
#ifdef ADIABATIC
pGrid->U[k][j][i].E = U1d.E;
#endif
#if (NSCALARS > 0)
pGrid->U[k][j][i].s[0] = U1d.s[0];
#endif
}
}
}
break;
default:
ath_error("[shkset1d]: invalid shk_dir = %i\n",shk_dir);
}
return;
}
static void initialize(Grid *pGrid, Domain *pD)
{
int i, is=pGrid->is, ie = pGrid->ie;
int j, js=pGrid->js, je = pGrid->je;
int k, ks=pGrid->ks, ke = pGrid->ke;
int nbuf, mpierr, nx1gh, nx2gh, nx3gh;
float kwv, kpara, kperp;
char donedrive = 0;
/* -----------------------------------------------------------
* Variables within this block are stored globally, and used
* within preprocessor macros. Don't create variables with
* these names within your function if you are going to use
* OFST(), KCOMP(), or KWVM() within the function! */
/* Get local grid size */
nx1 = (ie-is+1);
nx2 = (je-js+1);
nx3 = (ke-ks+1);
/* Get global grid size */
gnx1 = pD->ide - pD->ids + 1;
gnx2 = pD->jde - pD->jds + 1;
gnx3 = pD->kde - pD->kds + 1;
/* Get extents of local FFT grid in global coordinates */
gis=is+pGrid->idisp; gie=ie+pGrid->idisp;
gjs=js+pGrid->jdisp; gje=je+pGrid->jdisp;
gks=ks+pGrid->kdisp; gke=ke+pGrid->kdisp;
/* ----------------------------------------------------------- */
/* Get size of arrays with ghost cells */
nx1gh = nx1 + 2*nghost;
nx2gh = nx2 + 2*nghost;
nx3gh = nx3 + 2*nghost;
/* Get input parameters */
/* interval for generating new driving spectrum; also interval for
* driving when IMPULSIVE_DRIVING is used */
dtdrive = par_getd("problem","dtdrive");
#ifdef MHD
/* magnetic field strength */
beta = par_getd("problem","beta");
/* beta = isothermal pressure/magnetic pressure */
B0 = sqrt(2.0*Iso_csound2*rhobar/beta);
#endif /* MHD */
/* energy injection rate */
dedt = par_getd("problem","dedt");
/* parameters for spectrum */
ispect = par_geti("problem","ispect");
if (ispect == 1) {
expo = par_getd("problem","expo");
} else if (ispect == 2) {
kpeak = par_getd("problem","kpeak")*2.0*PI;
} else {
ath_error("Invalid value for ispect\n");
}
/* Cutoff wavenumbers of spectrum */
klow = par_getd("problem","klow"); /* in integer units */
khigh = par_getd("problem","khigh"); /* in integer units */
dkx = 2.0*PI/(pGrid->dx1*gnx1); /* convert k from integer */
/* Driven or decaying */
idrive = par_geti("problem","idrive");
if ((idrive < 0) || (idrive > 1)) ath_error("Invalid value for idrive\n");
/* If restarting with decaying turbulence, no driving necessary. */
if ((idrive == 1) && (pGrid->nstep > 0)) {
donedrive = 1;
}
if (donedrive == 0) {
/* Allocate memory for components of velocity perturbation */
if ((dv1=(Real***)calloc_3d_array(nx3gh,nx2gh,nx1gh,sizeof(Real)))==NULL) {
ath_error("[problem]: Error allocating memory for vel pert\n");
}
if ((dv2=(Real***)calloc_3d_array(nx3gh,nx2gh,nx1gh,sizeof(Real)))==NULL) {
ath_error("[problem]: Error allocating memory for vel pert\n");
}
if ((dv3=(Real***)calloc_3d_array(nx3gh,nx2gh,nx1gh,sizeof(Real)))==NULL) {
ath_error("[problem]: Error allocating memory for vel pert\n");
}
}
/* Initialize the FFT plan */
plan = ath_3d_fft_quick_plan(pGrid, pD, NULL, ATH_FFT_BACKWARD);
/* Allocate memory for FFTs */
if (donedrive == 0) {
fv1 = ath_3d_fft_malloc(plan);
fv2 = ath_3d_fft_malloc(plan);
fv3 = ath_3d_fft_malloc(plan);
}
/* Enroll outputs */
dump_history_enroll(hst_dEk,"<dE_K>");
dump_history_enroll(hst_dEb,"<dE_B>");
return;
}
void problem(DomainS *pDomain)
{
GridS *pG = pDomain->Grid;
int is = pG->is, ie = pG->ie;
int js = pG->js, je = pG->je;
int ks = pG->ks, ke = pG->ke;
int ixs,jxs,kxs,i,j,k;
long int iseed = -1; /* Initialize on the first call to ran2 */
Real x1,x2,x3,xmin,xmax,Lx,Ly,Lz;
Real rd, rp, rvx, rvy, rvz, rbx, rby, rbz;
Real beta,B0,P0,kx,ky,kz,amp,press;
Real Q,nJ,cs,cs2;
Real time0,kxt;
#ifdef SELF_GRAVITY
Real Gcons;
#endif
int nwx,nwy,nwz; /* input number of waves per Lx,Ly,Lz [default=1] */
double rval;
if(pG->Nx[2] == 1) ShBoxCoord = xy; /* 2D xy-plane */
/* Read problem parameters. */
Omega_0 = par_getd("problem","omega");
qshear = par_getd("problem","qshear");
amp = par_getd("problem","amp");
/* Read parameters for magnetic field */
beta = par_getd("problem","beta");
/* Read parameters for self gravity */
Q=par_getd("problem","Q");
nJ= par_getd("problem","nJ");
time0=par_getd_def("problem","time0",0.0);
cs=sqrt(4.0-2.0*qshear)/PI/nJ/Q;
cs2=SQR(cs);
#ifdef SELF_GRAVITY
Gcons = nJ*cs2;
grav_mean_rho = 1.0;
#ifndef SELF_GRAVITY_USING_FFT_DISK
if(pG->Nx[2] >1) grav_mean_rho = 1.0;
#endif
/* Set gravity constant*/
four_pi_G = 4.0*PI*Gcons;
#endif /* SELF_GRAVITY */
B0 = cs/sqrt(beta);
#ifndef BAROTROPIC
P0 = cs2/Gamma;
#endif
/* Ensure a different initial random seed for each process in an MPI calc. */
ixs = pG->Disp[0];
jxs = pG->Disp[1];
kxs = pG->Disp[2];
iseed = -1 - (ixs + pDomain->Nx[0]*(jxs + pDomain->Nx[1]*kxs));
Lx = pDomain->RootMaxX[0] - pDomain->RootMinX[0];
/* initialize wavenumbers, given input number of waves per L */
nwx = par_geti_def("problem","nwx",-6);
nwy = par_geti_def("problem","nwy",1);
ky = nwy*2.0*PI;
kx = nwx*2.0*PI;
kxt = kx+qshear*Omega_0*ky*time0;
pG->time=time0;
for (k=ks; k<=ke; k++) {
for (j=js; j<=je; j++) {
for (i=is; i<=ie; i++) {
cc_pos(pG,i,j,k,&x1,&x2,&x3);
if (((i-pG->Disp[0]) == 58) && ((j-pG->Disp[1]) == 16))
printf("i=%d j=%d k=%d x1=%e x2=%e\n",i,j,k,x1,x2);
rd = 1.0+amp*cos(kxt*x1+ky*x2);
rvx = amp*kx/ky*sin(kxt*x1+ky*x2);
rvy = amp*sin(kxt*x1+ky*x2);
rvz = 0.0;
rp = cs2*(rd-1.0);
rbx = amp*nwy*cos(kxt*(x1-0.5*pG->dx1)+ky*x2);
rby = -amp*nwx*cos(kxt*x1+ky*(x2-0.5*pG->dx2));
rbz = 0.0;
pG->U[k][j][i].d = rd;
pG->U[k][j][i].M1 = rd*rvx;
pG->U[k][j][i].M2 = rd*rvy;
#ifndef FARGO
pG->U[k][j][i].M2 -= rd*(qshear*Omega_0*x1);
#endif
pG->U[k][j][i].M3 = rd*rvz;
#ifdef ADIABATIC
pG->U[k][j][i].E = (P0+rp)/Gamma_1
+ 0.5*(SQR(pG->U[k][j][i].M1) + SQR(pG->U[k][j][i].M2)
+ SQR(pG->U[k][j][i].M3))/rd;
#endif
#ifdef MHD
pG->B1i[k][j][i] = rbx;
pG->B2i[k][j][i] = B0+rby;
pG->B3i[k][j][i] = 0.0;
if (i==ie) cc_pos(pG,ie+1,j,k,&x1,&x2,&x3);
rbx = amp*nwy*cos(kx*(x1-0.5*pG->dx1)+ky*x2);
if (j==je) cc_pos(pG,i,je+1,k,&x1,&x2,&x3);
rby = -amp*nwx*cos(kx*x1+ky*(x2-0.5*pG->dx2));
if (i==ie) pG->B1i[k][j][ie+1] = rbx;
if (j==je) pG->B2i[k][je+1][i] = B0+rby;
if (pG->Nx[2] > 1 && k==ke) pG->B3i[ke+1][j][i] = 0.0;
#endif /* MHD */
}
}
}
#ifdef MHD
for (k=ks; k<=ke; k++) {
for (j=js; j<=je; j++) {
for (i=is; i<=ie; i++) {
pG->U[k][j][i].B1c = 0.5*(pG->B1i[k][j][i]+pG->B1i[k][j][i+1]);
pG->U[k][j][i].B2c = 0.5*(pG->B2i[k][j][i]+pG->B2i[k][j+1][i]);
if (pG->Nx[2] >1) pG->U[k][j][i].B3c = 0.5*(pG->B3i[k][j][i]+pG->B3i[k+1][j][i]);
else pG->U[k][j][i].B3c =pG->B3i[k][j][i];
#ifdef ADIABATIC
pG->U[k][j][i].E += 0.5*(SQR(pG->U[k][j][i].B1c)
+ SQR(pG->U[k][j][i].B2c) + SQR(pG->U[k][j][i].B3c));
#endif
}
}
}
#endif /* MHD */
/* enroll gravitational potential function */
ShearingBoxPot = UnstratifiedDisk;
/* enroll new history variables, only once with SMR */
dVol = pDomain->Nx[0]*pDomain->Nx[1]*pDomain->Nx[2];
/* history dump for linear perturbation amplitude. See Kim & Ostriker 2001 */
dump_history_enroll(hst_sigma, "<sigma>");
dump_history_enroll(hst_ux, "<ux>");
dump_history_enroll(hst_uy, "<uy>");
#ifdef MHD
dump_history_enroll(hst_m1, "<m1>");
dump_history_enroll(hst_m2, "<m2>");
#endif
/* history dump for peturbed quantities at a specific grid point */
dump_history_enroll(hst_dSigma, "<dSigma>");
dump_history_enroll(hst_Vx, "<Vx>");
dump_history_enroll(hst_dVy, "<dVy>");
#ifdef MHD
dump_history_enroll(hst_Bx, "<Bx>");
dump_history_enroll(hst_dBy, "<dBy>");
#endif /* MHD */
#ifdef SELF_GRAVITY
dump_history_enroll(hst_Phi, "<Phi>");
dump_history_enroll(hst_dPhi, "<dPhi>");
#endif
#ifdef ADIABATIC
dump_history_enroll(hst_dE, "<dE>");
#endif
printf("=== end of problem setting ===\n");
return;
}
void init_mesh(MeshS *pM)
{
int nblock,num_domains,nd,nl,level,maxlevel=0,nd_this_level;
int nDim,nDim_test,dim;
int *next_domainid;
char block[80];
int ncd,ir,irefine,l,m,n,roffset;
int i,Nx[3],izones;
div_t xdiv[3]; /* divisor with quot and rem members */
Real root_xmin[3], root_xmax[3]; /* min/max of x in each dir on root grid */
int Nproc_Comm_world=1,nproc=0,next_procID;
SideS D1,D2;
DomainS *pD, *pCD;
#ifdef MPI_PARALLEL
int ierr,child_found,groupn,Nranks,Nranks0,max_rank,irank,*ranks;
MPI_Group world_group;
/* Get total # of processes, in MPI_COMM_WORLD */
ierr = MPI_Comm_size(MPI_COMM_WORLD, &Nproc_Comm_world);
#endif
/* Start by initializing some quantaties in Mesh structure */
pM->time = 0.0;
pM->nstep = 0;
pM->outfilename = par_gets("job","problem_id");
/*--- Step 1: Figure out how many levels and domains there are. --------------*/
/* read levels of each domain block in input file and calculate max level */
num_domains = par_geti("job","num_domains");
#ifndef STATIC_MESH_REFINEMENT
if (num_domains > 1)
ath_error("[init_mesh]: num_domains=%d; for num_domains > 1 configure with --enable-smr\n",num_domains);
#endif
for (nblock=1; nblock<=num_domains; nblock++){
sprintf(block,"domain%d",nblock);
if (par_exist(block,"level") == 0)
ath_error("[init_mesh]: level does not exist in block %s\n",block);
level = par_geti(block,"level");
maxlevel = MAX(maxlevel,level);
}
/* set number of levels in Mesh, and allocate DomainsPerLevel array */
pM->NLevels = maxlevel + 1; /* level counting starts at 0 */
pM->DomainsPerLevel = (int*)calloc_1d_array(pM->NLevels,sizeof(int));
if (pM->DomainsPerLevel == NULL)
ath_error("[init_mesh]: malloc returned a NULL pointer\n");
/* Now figure out how many domains there are at each level */
for (nl=0; nl<=maxlevel; nl++){
nd_this_level=0;
for (nblock=1; nblock<=num_domains; nblock++){
sprintf(block,"domain%d",nblock);
if (par_geti(block,"level") == nl) nd_this_level++;
}
/* Error if there are any levels with no domains. Else set DomainsPerLevel */
if (nd_this_level == 0) {
ath_error("[init_mesh]: Level %d has zero domains\n",nl);
} else {
pM->DomainsPerLevel[nl] = nd_this_level;
}
}
/*--- Step 2: Set up root level. --------------------------------------------*/
/* Find the <domain> block in the input file corresponding to the root level,
* and set root level properties in Mesh structure */
if (pM->DomainsPerLevel[0] != 1)
ath_error("[init_mesh]: Level 0 has %d domains\n",pM->DomainsPerLevel[0]);
for (nblock=1; nblock<=num_domains; nblock++){
sprintf(block,"domain%d",nblock);
level = par_geti(block,"level");
if (level == 0){
root_xmin[0] = par_getd(block,"x1min");
root_xmax[0] = par_getd(block,"x1max");
root_xmin[1] = par_getd(block,"x2min");
root_xmax[1] = par_getd(block,"x2max");
root_xmin[2] = par_getd(block,"x3min");
root_xmax[2] = par_getd(block,"x3max");
Nx[0] = par_geti(block,"Nx1");
Nx[1] = par_geti(block,"Nx2");
Nx[2] = par_geti(block,"Nx3");
/* number of dimensions of root level, to test against all other inputs */
nDim=0;
for (i=0; i<3; i++) if (Nx[i]>1) nDim++;
if (nDim==0) ath_error("[init_mesh] None of Nx1,Nx2,Nx3 > 1\n");
/* some error tests of root grid */
for (i=0; i<3; i++) {
if (Nx[i] < 1) {
ath_error("[init_mesh]: Nx%d in %s must be >= 1\n",(i+1),block);
}
if(root_xmax[i] < root_xmin[i]) {
ath_error("[init_mesh]: x%dmax < x%dmin in %s\n",(i+1),block);
}
}
if (nDim==1 && Nx[0]==1) {
ath_error("[init_mesh]:1D requires Nx1>1: in %s Nx1=1,Nx2=%d,Nx3=%d\n",
block,Nx[1],Nx[2]);
}
if (nDim==2 && Nx[2]>1) {ath_error(
"[init_mesh]:2D requires Nx1,Nx2>1: in %s Nx1=%d,Nx2=%d,Nx3=%d\n",
block,Nx[0],Nx[1],Nx[2]);
}
/* Now that everything is OK, set root grid properties in Mesh structure */
for (i=0; i<3; i++) {
pM->Nx[i] = Nx[i];
pM->RootMinX[i] = root_xmin[i];
pM->RootMaxX[i] = root_xmax[i];
pM->dx[i] = (root_xmax[i] - root_xmin[i])/(Real)(Nx[i]);
}
/* Set BC flags on root domain */
pM->BCFlag_ix1 = par_geti_def(block,"bc_ix1",0);
pM->BCFlag_ix2 = par_geti_def(block,"bc_ix2",0);
pM->BCFlag_ix3 = par_geti_def(block,"bc_ix3",0);
pM->BCFlag_ox1 = par_geti_def(block,"bc_ox1",0);
pM->BCFlag_ox2 = par_geti_def(block,"bc_ox2",0);
pM->BCFlag_ox3 = par_geti_def(block,"bc_ox3",0);
}
}
/*--- Step 3: Allocate and initialize domain array. --------------------------*/
/* Allocate memory and set pointers for Domain array in Mesh. Since the
* number of domains nd depends on the level nl, this is a strange array
* because it is not [nl]x[nd]. Rather it is nl pointers to nd[nl] Domains.
* Compare to the calloc_2d_array() function in ath_array.c
*/
if((pM->Domain = (DomainS**)calloc((maxlevel+1),sizeof(DomainS*))) == NULL){
ath_error("[init_mesh] failed to allocate memory for %d Domain pointers\n",
(maxlevel+1));
}
if((pM->Domain[0]=(DomainS*)calloc(num_domains,sizeof(DomainS))) == NULL){
ath_error("[init_mesh] failed to allocate memory for Domains\n");
}
for(nl=1; nl<=maxlevel; nl++)
pM->Domain[nl] = (DomainS*)((unsigned char *)pM->Domain[nl-1] +
pM->DomainsPerLevel[nl-1]*sizeof(DomainS));
/* Loop over every <domain> block in the input file, and initialize each Domain
* in the mesh hierarchy (the Domain array), including the root level Domain */
next_domainid = (int*)calloc_1d_array(pM->NLevels,sizeof(int));
for(nl=0; nl<=maxlevel; nl++) next_domainid[nl] = 0;
for (nblock=1; nblock<=num_domains; nblock++){
sprintf(block,"domain%d",nblock);
/* choose nd coordinate in Domain array for this <domain> block according
* to the order it appears in input */
nl = par_geti(block,"level");
if (next_domainid[nl] > (pM->DomainsPerLevel[nl])-1)
ath_error("[init_mesh]: Exceeded available domain ids on level %d\n",nl);
nd = next_domainid[nl];
next_domainid[nl]++;
irefine = 1;
for (ir=1;ir<=nl;ir++) irefine *= 2; /* C pow fn only takes doubles !! */
/* Initialize level, number, input <domain> block number, and total number of
* cells in this Domain */
pM->Domain[nl][nd].Level = nl;
pM->Domain[nl][nd].DomNumber = nd;
pM->Domain[nl][nd].InputBlock = nblock;
pM->Domain[nl][nd].Nx[0] = par_geti(block,"Nx1");
pM->Domain[nl][nd].Nx[1] = par_geti(block,"Nx2");
pM->Domain[nl][nd].Nx[2] = par_geti(block,"Nx3");
/* error tests: dimensions of domain */
nDim_test=0;
for (i=0; i<3; i++) if (pM->Domain[nl][nd].Nx[i]>1) nDim_test++;
if (nDim_test != nDim) {
ath_error("[init_mesh]: in %s grid is %dD, but in root level it is %dD\n",
block,nDim_test,nDim);
}
for (i=0; i<3; i++) {
if (pM->Domain[nl][nd].Nx[i] < 1) {
ath_error("[init_mesh]: %s/Nx%d = %d must be >= 1\n",
block,(i+1),pM->Domain[nl][nd].Nx[i]);
}
}
if (nDim==1 && pM->Domain[nl][nd].Nx[0]==1) {ath_error(
"[init_mesh]: 1D requires Nx1>1 but in %s Nx1=1,Nx2=%d,Nx3=%d\n",
block,pM->Domain[nl][nd].Nx[1],pM->Domain[nl][nd].Nx[2]);
}
if (nDim==2 && pM->Domain[nl][nd].Nx[2]>1) {ath_error(
"[init_mesh]:2D requires Nx1,Nx2 > 1 but in %s Nx1=%d,Nx2=%d,Nx3=%d\n",
block,pM->Domain[nl][nd].Nx[0],pM->Domain[nl][nd].Nx[1],
pM->Domain[nl][nd].Nx[2]);
}
for (i=0; i<nDim; i++) {
xdiv[i] = div(pM->Domain[nl][nd].Nx[i], irefine);
if (xdiv[i].rem != 0){
ath_error("[init_mesh]: %s/Nx%d = %d must be divisible by %d\n",
block,(i+1),pM->Domain[nl][nd].Nx[i],irefine);
}
}
/* Set cell size based on level of domain, but only if Ncell > 1 */
for (i=0; i<3; i++) {
if (pM->Domain[nl][nd].Nx[i] > 1) {
pM->Domain[nl][nd].dx[i] = pM->dx[i]/(Real)(irefine);
} else {
pM->Domain[nl][nd].dx[i] = pM->dx[i];
}
}
/* Set displacement of Domain from origin. By definition, root level has 0
* displacement, so only read for levels other than root */
for (i=0; i<3; i++) pM->Domain[nl][nd].Disp[i] = 0;
if (nl != 0) {
if (par_exist(block,"iDisp") == 0)
ath_error("[init_mesh]: iDisp does not exist in block %s\n",block);
pM->Domain[nl][nd].Disp[0] = par_geti(block,"iDisp");
/* jDisp=0 if problem is only 1D */
if (pM->Nx[1] > 1) {
if (par_exist(block,"jDisp") == 0)
ath_error("[init_mesh]: jDisp does not exist in block %s\n",block);
pM->Domain[nl][nd].Disp[1] = par_geti(block,"jDisp");
}
/* kDisp=0 if problem is only 2D */
if (pM->Nx[2] > 1) {
if (par_exist(block,"kDisp") == 0)
ath_error("[init_mesh]: kDisp does not exist in block %s\n",block);
pM->Domain[nl][nd].Disp[2] = par_geti(block,"kDisp");
}
}
for (i=0; i<nDim; i++) {
xdiv[i] = div(pM->Domain[nl][nd].Disp[i], irefine);
if (xdiv[i].rem != 0){
ath_error("[init_mesh]: %s/Disp%d = %d must be divisible by %d\n",
block,(i+1),pM->Domain[nl][nd].Disp[i],irefine);
}
}
/* Use cell size and displacement from origin to compute min/max of x1/x2/x3 on
* this domain. Ensure that if Domain touches root grid boundary, the min/max
* of this Domain are set IDENTICAL to values in root grid */
for (i=0; i<3; i++){
if (pM->Domain[nl][nd].Disp[i] == 0) {
pM->Domain[nl][nd].MinX[i] = root_xmin[i];
} else {
pM->Domain[nl][nd].MinX[i] = root_xmin[i]
+ ((Real)(pM->Domain[nl][nd].Disp[i]))*pM->Domain[nl][nd].dx[i];
}
izones= (pM->Domain[nl][nd].Disp[i] + pM->Domain[nl][nd].Nx[i])/irefine;
if(izones == pM->Nx[i]){
pM->Domain[nl][nd].MaxX[i] = root_xmax[i];
} else {
pM->Domain[nl][nd].MaxX[i] = pM->Domain[nl][nd].MinX[i]
+ ((Real)(pM->Domain[nl][nd].Nx[i]))*pM->Domain[nl][nd].dx[i];
}
pM->Domain[nl][nd].RootMinX[i] = root_xmin[i];
pM->Domain[nl][nd].RootMaxX[i] = root_xmax[i];
}
} /*---------- end loop over domain blocks in input file ------------------*/
/*--- Step 4: Check that domains on the same level are non-overlapping. ------*/
/* Compare the integer coordinates of the sides of Domains at the same level.
* Print error if Domains overlap or touch. */
for (nl=maxlevel; nl>0; nl--){ /* start at highest level, and skip root */
for (nd=0; nd<(pM->DomainsPerLevel[nl])-1; nd++){
for (i=0; i<3; i++) {
D1.ijkl[i] = pM->Domain[nl][nd].Disp[i];
D1.ijkr[i] = pM->Domain[nl][nd].Disp[i] + pM->Domain[nl][nd].Nx[i];
}
for (ncd=nd+1; ncd<(pM->DomainsPerLevel[nl]); ncd++) {
for (i=0; i<3; i++) {
D2.ijkl[i] = pM->Domain[nl][ncd].Disp[i];
D2.ijkr[i] = pM->Domain[nl][ncd].Disp[i] + pM->Domain[nl][ncd].Nx[i];
}
if (D1.ijkl[0] <= D2.ijkr[0] && D1.ijkr[0] >= D2.ijkl[0] &&
D1.ijkl[1] <= D2.ijkr[1] && D1.ijkr[1] >= D2.ijkl[1] &&
D1.ijkl[2] <= D2.ijkr[2] && D1.ijkr[2] >= D2.ijkl[2]){
ath_error("Domains %d and %d at same level overlap or touch\n",
pM->Domain[nl][nd].InputBlock,pM->Domain[nl][ncd].InputBlock);
}
}
}}
/*--- Step 5: Check for illegal geometry of child/parent Domains -------------*/
for (nl=0; nl<maxlevel; nl++){
for (nd=0; nd<pM->DomainsPerLevel[nl]; nd++){
pD = (DomainS*)&(pM->Domain[nl][nd]); /* set ptr to this Domain */
for (i=0; i<3; i++) {
D1.ijkl[i] = pD->Disp[i];
D1.ijkr[i] = pD->Disp[i] + pD->Nx[i];
}
for (ncd=0; ncd<pM->DomainsPerLevel[nl+1]; ncd++){
pCD = (DomainS*)&(pM->Domain[nl+1][ncd]); /* set ptr to potential child*/
for (i=0; i<3; i++) {
D2.ijkl[i] = pCD->Disp[i]/2;
D2.ijkr[i] = 1;
if (pCD->Nx[i] > 1) D2.ijkr[i] = (pCD->Disp[i] + pCD->Nx[i])/2;
}
if (D1.ijkl[0] <= D2.ijkr[0] && D1.ijkr[0] >= D2.ijkl[0] &&
D1.ijkl[1] <= D2.ijkr[1] && D1.ijkr[1] >= D2.ijkl[1] &&
D1.ijkl[2] <= D2.ijkr[2] && D1.ijkr[2] >= D2.ijkl[2]){
/* check for child Domains that touch edge of parent (and are not at edges of
* root), extends past edge of parent, or are < nghost/2 from edge of parent */
for (dim=0; dim<nDim; dim++){
irefine = 1;
for (i=1;i<=nl;i++) irefine *= 2; /* parent refinement lev */
roffset = (pCD->Disp[dim] + pCD->Nx[dim])/(2*irefine) - pM->Nx[dim];
if (((D2.ijkl[dim] == D1.ijkl[dim]) && (pD->Disp[dim] != 0)) ||
((D2.ijkr[dim] == D1.ijkr[dim]) && (roffset != 0))) {
for (i=0; i<nDim; i++) {
D1.ijkl[i] /= irefine; /* report indices scaled to root */
D1.ijkr[i] /= irefine;
D2.ijkl[i] /= irefine;
D2.ijkr[i] /= irefine;
}
ath_error("[init_mesh] child Domain D%d[is,ie,js,je,ks,ke]=[%d %d %d %d %d %d] touches parent D%d[is,ie,js,je,ks,ke]=[%d %d %d %d %d %d]\n",
pCD->InputBlock,D2.ijkl[0],D2.ijkr[0],D2.ijkl[1],D2.ijkr[1],
D2.ijkl[2],D2.ijkr[2],pD->InputBlock,D1.ijkl[0],D1.ijkr[0],
D1.ijkl[1],D1.ijkr[1],D1.ijkl[2],D1.ijkr[2]);
}
if ((D2.ijkl[dim] < D1.ijkl[dim]) ||
(D2.ijkr[dim] > D1.ijkr[dim])) {
for (i=0; i<nDim; i++) {
D1.ijkl[i] /= irefine; /* report indices scaled to root */
D1.ijkr[i] /= irefine;
D2.ijkl[i] /= irefine;
D2.ijkr[i] /= irefine;
}
ath_error("[init_mesh] child Domain D%d[is,ie,js,je,ks,ke]=[%d %d %d %d %d %d] extends past parent D%d[is,ie,js,je,ks,ke]=[%d %d %d %d %d %d]\n",
pCD->InputBlock,D2.ijkl[0],D2.ijkr[0],D2.ijkl[1],D2.ijkr[1],
D2.ijkl[2],D2.ijkr[2],pD->InputBlock,D1.ijkl[0],D1.ijkr[0],
D1.ijkl[1],D1.ijkr[1],D1.ijkl[2],D1.ijkr[2]);
}
if (((2*(D2.ijkl[dim]-D1.ijkl[dim]) < nghost) &&
(2*(D2.ijkl[dim]-D1.ijkl[dim]) > 0 )) ||
((2*(D1.ijkr[dim]-D2.ijkr[dim]) < nghost) &&
(2*(D1.ijkr[dim]-D2.ijkr[dim]) > 0 ))) {
for (i=0; i<nDim; i++) {
D1.ijkl[i] /= irefine; /* report indices scaled to root */
D1.ijkr[i] /= irefine;
D2.ijkl[i] /= irefine;
D2.ijkr[i] /= irefine;
}
ath_error("[init_mesh] child Domain D%d[is,ie,js,je,ks,ke]=[%d %d %d %d %d %d] closer than nghost/2 to parent D%d[is,ie,js,je,ks,ke]=[%d %d %d %d %d %d]\n",
pCD->InputBlock,D2.ijkl[0],D2.ijkr[0],D2.ijkl[1],D2.ijkr[1],
D2.ijkl[2],D2.ijkr[2],pD->InputBlock,D1.ijkl[0],D1.ijkr[0],
D1.ijkl[1],D1.ijkr[1],D1.ijkl[2],D1.ijkr[2]);
}
}
}
}
}}
/*--- Step 6: Divide each Domain into Grids, and allocate to processor(s) ---*/
/* Get the number of Grids in each direction. These are given either in the
* <domain?> block in the input file, or by automatic decomposition given the
* number of processor desired for this domain. */
next_procID = 0; /* start assigning processors to Grids at ID=0 */
for (nl=0; nl<=maxlevel; nl++){
for (nd=0; nd<(pM->DomainsPerLevel[nl]); nd++){
pD = (DomainS*)&(pM->Domain[nl][nd]); /* set ptr to this Domain */
sprintf(block,"domain%d",pD->InputBlock);
#ifndef MPI_PARALLEL
for (i=0; i<3; i++) pD->NGrid[i] = 1;
#else
nproc = par_geti_def(block,"AutoWithNProc",0);
/* Read layout of Grids from input file */
if (nproc == 0){
pD->NGrid[0] = par_geti_def(block,"NGrid_x1",1);
pD->NGrid[1] = par_geti_def(block,"NGrid_x2",1);
pD->NGrid[2] = par_geti_def(block,"NGrid_x3",1);
if (pD->NGrid[0] == 0)
ath_error("[init_mesh] Cannot enter NGrid_x1=0 in %s\n",block);
if (pD->NGrid[1] == 0)
ath_error("[init_mesh] Cannot enter NGrid_x2=0 in %s\n",block);
if (pD->NGrid[2] == 0)
ath_error("[init_mesh] Cannot enter NGrid_x3=0 in %s\n",block);
}
/* Auto decompose Domain into Grids. To use this option, set "AutoWithNProc"
* to number of processors desired for this Domain */
else if (nproc > 0){
if(dom_decomp(pD->Nx[0],pD->Nx[1],pD->Nx[2],nproc,
&(pD->NGrid[0]),&(pD->NGrid[1]),&(pD->NGrid[2])))
ath_error("[init_mesh]: Error in automatic Domain decomposition\n");
/* Store the domain decomposition in the par database */
par_seti(block,"NGrid_x1","%d",pD->NGrid[0],"x1 decomp");
par_seti(block,"NGrid_x2","%d",pD->NGrid[1],"x2 decomp");
par_seti(block,"NGrid_x3","%d",pD->NGrid[2],"x3 decomp");
} else {
ath_error("[init_mesh] invalid AutoWithNProc=%d in %s\n",nproc,block);
}
#endif /* MPI_PARALLEL */
/* test for conflicts between number of grids and dimensionality */
for (i=0; i<3; i++){
if(pD->NGrid[i] > 1 && pD->Nx[i] <= 1)
ath_error("[init_mesh]: %s/NGrid_x%d = %d and Nx%d = %d\n",block,
(i+1),pD->NGrid[i],(i+1),pD->Nx[i]);
}
/* check there are more processors than Grids needed by this Domain. */
nproc = (pD->NGrid[0])*(pD->NGrid[1])*(pD->NGrid[2]);
if(nproc > Nproc_Comm_world) ath_error(
"[init_mesh]: %d Grids requested by block %s and only %d procs\n"
,nproc,block,Nproc_Comm_world);
/* Build 3D array to store data on Grids in this Domain */
if ((pD->GData = (GridsDataS***)calloc_3d_array(pD->NGrid[2],pD->NGrid[1],
pD->NGrid[0],sizeof(GridsDataS))) == NULL) ath_error(
"[init_mesh]: GData calloc returned a NULL pointer\n");
/* Divide the domain into blocks */
for (i=0; i<3; i++) {
xdiv[i] = div(pD->Nx[i], pD->NGrid[i]);
}
/* Distribute cells in Domain to Grids. Assign each Grid to a processor ID in
* the MPI_COMM_WORLD communicator. For single-processor jobs, there is only
* one ID=0, and the GData array will have only one element. */
for(n=0; n<(pD->NGrid[2]); n++){
for(m=0; m<(pD->NGrid[1]); m++){
for(l=0; l<(pD->NGrid[0]); l++){
for (i=0; i<3; i++) pD->GData[n][m][l].Nx[i] = xdiv[i].quot;
pD->GData[n][m][l].ID_Comm_world = next_procID++;
if (next_procID > ((Nproc_Comm_world)-1)) next_procID=0;
}}}
/* If the Domain is not evenly divisible put the extra cells on the first
* Grids in each direction, maintaining the load balance as much as possible */
for(n=0; n<(pD->NGrid[2]); n++){
for(m=0; m<(pD->NGrid[1]); m++){
for(l=0; l<xdiv[0].rem; l++){
pD->GData[n][m][l].Nx[0]++;
}
}
}
xdiv[0].rem=0;
for(n=0; n<(pD->NGrid[2]); n++){
for(m=0; m<xdiv[1].rem; m++) {
for(l=0; l<(pD->NGrid[0]); l++){
pD->GData[n][m][l].Nx[1]++;
}
}
}
xdiv[1].rem=0;
for(n=0; n<xdiv[2].rem; n++){
for(m=0; m<(pD->NGrid[1]); m++){
for(l=0; l<(pD->NGrid[0]); l++){
pD->GData[n][m][l].Nx[2]++;
}
}
}
xdiv[2].rem=0;
/* Initialize displacements from origin for each Grid */
for(n=0; n<(pD->NGrid[2]); n++){
for(m=0; m<(pD->NGrid[1]); m++){
pD->GData[n][m][0].Disp[0] = pD->Disp[0];
for(l=1; l<(pD->NGrid[0]); l++){
pD->GData[n][m][l].Disp[0] = pD->GData[n][m][l-1].Disp[0] +
pD->GData[n][m][l-1].Nx[0];
}
}
}
for(n=0; n<(pD->NGrid[2]); n++){
for(l=0; l<(pD->NGrid[0]); l++){
pD->GData[n][0][l].Disp[1] = pD->Disp[1];
for(m=1; m<(pD->NGrid[1]); m++){
pD->GData[n][m][l].Disp[1] = pD->GData[n][m-1][l].Disp[1] +
pD->GData[n][m-1][l].Nx[1];
}
}
}
for(m=0; m<(pD->NGrid[1]); m++){
for(l=0; l<(pD->NGrid[0]); l++){
pD->GData[0][m][l].Disp[2] = pD->Disp[2];
for(n=1; n<(pD->NGrid[2]); n++){
pD->GData[n][m][l].Disp[2] = pD->GData[n-1][m][l].Disp[2] +
pD->GData[n-1][m][l].Nx[2];
}
}
}
} /* end loop over ndomains */
} /* end loop over nlevels */
/* check that total number of Grids was partitioned evenly over total number of
* MPI processes available (equal to one for single processor jobs) */
if (next_procID != 0)
ath_error("[init_mesh]:total # of Grids != total # of MPI procs\n");
/*--- Step 7: Allocate a Grid for each Domain on this processor --------------*/
for (nl=0; nl<=maxlevel; nl++){
for (nd=0; nd<(pM->DomainsPerLevel[nl]); nd++){
pD = (DomainS*)&(pM->Domain[nl][nd]); /* set ptr to this Domain */
sprintf(block,"domain%d",pD->InputBlock);
pD->Grid = NULL;
/* Loop over GData array, and if there is a Grid assigned to this proc,
* allocate it */
for(n=0; n<(pD->NGrid[2]); n++){
for(m=0; m<(pD->NGrid[1]); m++){
for(l=0; l<(pD->NGrid[0]); l++){
if (pD->GData[n][m][l].ID_Comm_world == myID_Comm_world) {
if ((pD->Grid = (GridS*)malloc(sizeof(GridS))) == NULL)
ath_error("[init_mesh]: Failed to malloc a Grid for %s\n",block);
}
}}}
}
}
/*--- Step 8: Create an MPI Communicator for each Domain ---------------------*/
#ifdef MPI_PARALLEL
/* Allocate memory for ranks[] array */
max_rank = 0;
for (nl=0; nl<=maxlevel; nl++){
for (nd=0; nd<(pM->DomainsPerLevel[nl]); nd++){
pD = (DomainS*)&(pM->Domain[nl][nd]); /* set ptr to this Domain */
Nranks = (pD->NGrid[0])*(pD->NGrid[1])*(pD->NGrid[2]);
max_rank = MAX(max_rank, Nranks);
}}
ranks = (int*)calloc_1d_array(max_rank,sizeof(int));
/* Extract handle of group defined by MPI_COMM_WORLD communicator */
ierr = MPI_Comm_group(MPI_COMM_WORLD, &world_group);
for (nl=0; nl<=maxlevel; nl++){
for (nd=0; nd<(pM->DomainsPerLevel[nl]); nd++){
pD = (DomainS*)&(pM->Domain[nl][nd]); /* set ptr to this Domain */
/* Load integer array with ranks of processes in MPI_COMM_WORLD updating Grids
* on this Domain. The ranks of these processes in the new Comm_Domain
* communicator created below are equal to the indices of this array */
Nranks = (pD->NGrid[0])*(pD->NGrid[1])*(pD->NGrid[2]);
groupn = 0;
for(n=0; n<(pD->NGrid[2]); n++){
for(m=0; m<(pD->NGrid[1]); m++){
for(l=0; l<(pD->NGrid[0]); l++){
ranks[groupn] = pD->GData[n][m][l].ID_Comm_world;
pD->GData[n][m][l].ID_Comm_Domain = groupn;
groupn++;
}}}
/* Create a new group for this Domain; use it to create a new communicator */
ierr = MPI_Group_incl(world_group,Nranks,ranks,&(pD->Group_Domain));
ierr = MPI_Comm_create(MPI_COMM_WORLD,pD->Group_Domain,&(pD->Comm_Domain));
}}
free_1d_array(ranks);
#endif /* MPI_PARALLEL */
/*--- Step 9: Create MPI Communicators for Child and Parent Domains ----------*/
#if defined(MPI_PARALLEL) && defined(STATIC_MESH_REFINEMENT)
/* Initialize communicators to NULL, since not all Domains use them, and
* allocate memory for ranks[] array */
for (nl=0; nl<=maxlevel; nl++){
for (nd=0; nd<(pM->DomainsPerLevel[nl]); nd++){
pM->Domain[nl][nd].Comm_Parent = MPI_COMM_NULL;
pM->Domain[nl][nd].Comm_Children = MPI_COMM_NULL;
}
}
if (maxlevel > 0) {
ranks = (int*)calloc_1d_array(Nproc_Comm_world,sizeof(int));
}
/* For each Domain up to (maxlevel-1), initialize communicator with children */
for (nl=0; nl<maxlevel; nl++){
for (nd=0; nd<pM->DomainsPerLevel[nl]; nd++){
pD = (DomainS*)&(pM->Domain[nl][nd]); /* set ptr to this Domain */
child_found = 0;
/* Load integer array with ranks of processes in MPI_COMM_WORLD updating Grids
* on this Domain, in case a child Domain is found. Set IDs in Comm_Children
* communicator based on index in rank array, in case child found. If no
* child is found these ranks will never be used. */
Nranks = (pD->NGrid[0])*(pD->NGrid[1])*(pD->NGrid[2]);
groupn = 0;
for(n=0; n<(pD->NGrid[2]); n++){
for(m=0; m<(pD->NGrid[1]); m++){
for(l=0; l<(pD->NGrid[0]); l++){
ranks[groupn] = pD->GData[n][m][l].ID_Comm_world;
pD->GData[n][m][l].ID_Comm_Children = groupn;
groupn++;
}}}
/* edges of this Domain */
for (i=0; i<3; i++) {
D1.ijkl[i] = pD->Disp[i];
D1.ijkr[i] = pD->Disp[i] + pD->Nx[i];
}
/* Loop over all Domains at next level, looking for children of this Domain */
for (ncd=0; ncd<pM->DomainsPerLevel[nl+1]; ncd++){
pCD = (DomainS*)&(pM->Domain[nl+1][ncd]); /* set ptr to potential child*/
/* edges of potential child Domain */
for (i=0; i<3; i++) {
D2.ijkl[i] = pCD->Disp[i]/2;
D2.ijkr[i] = 1;
if (pCD->Nx[i] > 1) D2.ijkr[i] = (pCD->Disp[i] + pCD->Nx[i])/2;
}
if (D1.ijkl[0] < D2.ijkr[0] && D1.ijkr[0] > D2.ijkl[0] &&
D1.ijkl[1] < D2.ijkr[1] && D1.ijkr[1] > D2.ijkl[1] &&
D1.ijkl[2] < D2.ijkr[2] && D1.ijkr[2] > D2.ijkl[2]){
child_found = 1;
/* Child found. Add child processors to ranks array, but only if they are
* different from processes currently there (including parent and any previously
* found children). Set IDs associated with Comm_Parent communicator, since on
* the child Domain this is the same as the Comm_Children communicator on the
* parent Domain */
for(n=0; n<(pCD->NGrid[2]); n++){
for(m=0; m<(pCD->NGrid[1]); m++){
for(l=0; l<(pCD->NGrid[0]); l++){
irank = -1;
for (i=0; i<Nranks; i++) {
if(pCD->GData[n][m][l].ID_Comm_world == ranks[i]) irank = i;
}
if (irank == -1) {
ranks[groupn] = pCD->GData[n][m][l].ID_Comm_world;
pCD->GData[n][m][l].ID_Comm_Parent = groupn;
groupn++;
Nranks++;
} else {
pCD->GData[n][m][l].ID_Comm_Parent = ranks[irank];
}
}}}
}
}
/* After looping over all potential child Domains, create a new communicator if
* a child was found */
if (child_found == 1) {
ierr = MPI_Group_incl(world_group, Nranks, ranks, &(pD->Group_Children));
ierr = MPI_Comm_create(MPI_COMM_WORLD,pD->Group_Children,
&pD->Comm_Children);
/* Loop over children to set Comm_Parent communicators */
for (ncd=0; ncd<pM->DomainsPerLevel[nl+1]; ncd++){
pCD = (DomainS*)&(pM->Domain[nl+1][ncd]);
for (i=0; i<3; i++) {
D2.ijkl[i] = pCD->Disp[i]/2;
D2.ijkr[i] = 1;
if (pCD->Nx[i] > 1) D2.ijkr[i] = (pCD->Disp[i] + pCD->Nx[i])/2;
}
if (D1.ijkl[0] < D2.ijkr[0] && D1.ijkr[0] > D2.ijkl[0] &&
D1.ijkl[1] < D2.ijkr[1] && D1.ijkr[1] > D2.ijkl[1] &&
D1.ijkl[2] < D2.ijkr[2] && D1.ijkr[2] > D2.ijkl[2]){
pCD->Comm_Parent = pD->Comm_Children;
}
}
}
}}
#endif /* MPI_PARALLEL & STATIC_MESH_REFINEMENT */
free(next_domainid);
return;
}
void new_dt(MeshS *pM)
{
GridS *pGrid;
#ifndef SPECIAL_RELATIVITY
int i,j,k;
Real di,v1,v2,v3,qsq,asq,cf1sq,cf2sq,cf3sq;
#ifdef ADIABATIC
Real p;
#endif
#ifdef MHD
Real b1,b2,b3,bsq,tsum,tdif;
#endif /* MHD */
#ifdef PARTICLES
long q;
#endif /* PARTICLES */
#endif /* SPECIAL RELATIVITY */
#ifdef MPI_PARALLEL
double dt, my_dt;
int ierr;
#endif
int nl,nd;
Real tlim,max_v1=0.0,max_v2=0.0,max_v3=0.0,max_dti = 0.0;
Real x1,x2,x3;
/* Loop over all Domains with a Grid on this processor -----------------------*/
for (nl=0; nl<(pM->NLevels); nl++){
for (nd=0; nd<(pM->DomainsPerLevel[nl]); nd++){
if (pM->Domain[nl][nd].Grid != NULL) {
pGrid=(pM->Domain[nl][nd].Grid);
/* Maximum velocity is always c with special relativity */
#ifdef SPECIAL_RELATIVITY
max_v1 = max_v2 = max_v3 = 1.0;
#else
for (k=pGrid->ks; k<=pGrid->ke; k++) {
for (j=pGrid->js; j<=pGrid->je; j++) {
for (i=pGrid->is; i<=pGrid->ie; i++) {
di = 1.0/(pGrid->U[k][j][i].d);
v1 = pGrid->U[k][j][i].M1*di;
v2 = pGrid->U[k][j][i].M2*di;
v3 = pGrid->U[k][j][i].M3*di;
qsq = v1*v1 + v2*v2 + v3*v3;
/* if (isnan(di) || isnan(v1)) { */
/* newvar = -999; */
/* fprintf(stderr, "Level: %d, Domain: %d, k:%d, j:%d, i:%d, d = %f, m1 = %f, s=%f \n", nl, nd, k-nghost, j-nghost, i-nghost, pGrid->U[k][j][i].d, pGrid->U[k][j][i].M1, pGrid->U[k][j][i].s[0]); */
/* } */
#ifdef MHD
/* Use maximum of face-centered fields (always larger than cell-centered B) */
b1 = pGrid->U[k][j][i].B1c
+ fabs((double)(pGrid->B1i[k][j][i] - pGrid->U[k][j][i].B1c));
b2 = pGrid->U[k][j][i].B2c
+ fabs((double)(pGrid->B2i[k][j][i] - pGrid->U[k][j][i].B2c));
b3 = pGrid->U[k][j][i].B3c
+ fabs((double)(pGrid->B3i[k][j][i] - pGrid->U[k][j][i].B3c));
bsq = b1*b1 + b2*b2 + b3*b3;
/* compute sound speed squared */
#ifdef ADIABATIC
p = MAX(Gamma_1*(pGrid->U[k][j][i].E - 0.5*pGrid->U[k][j][i].d*qsq
- 0.5*bsq), TINY_NUMBER);
asq = Gamma*p*di;
#elif defined ISOTHERMAL
asq = Iso_csound2;
#endif /* EOS */
/* compute fast magnetosonic speed squared in each direction */
tsum = bsq*di + asq;
tdif = bsq*di - asq;
cf1sq = 0.5*(tsum + sqrt(tdif*tdif + 4.0*asq*(b2*b2+b3*b3)*di));
cf2sq = 0.5*(tsum + sqrt(tdif*tdif + 4.0*asq*(b1*b1+b3*b3)*di));
cf3sq = 0.5*(tsum + sqrt(tdif*tdif + 4.0*asq*(b1*b1+b2*b2)*di));
#else /* MHD */
/* compute sound speed squared */
#ifdef ADIABATIC
p = MAX(Gamma_1*(pGrid->U[k][j][i].E - 0.5*pGrid->U[k][j][i].d*qsq),
TINY_NUMBER);
asq = Gamma*p*di;
#elif defined ISOTHERMAL
asq = Iso_csound2;
#endif /* EOS */
/* compute fast magnetosonic speed squared in each direction */
cf1sq = asq;
cf2sq = asq;
cf3sq = asq;
#endif /* MHD */
/* compute maximum cfl velocity (corresponding to minimum dt) */
if (pGrid->Nx[0] > 1)
max_v1 = MAX(max_v1,fabs(v1)+sqrt((double)cf1sq));
if (pGrid->Nx[1] > 1)
#ifdef CYLINDRICAL
cc_pos(pGrid,i,j,k,&x1,&x2,&x3);
max_v2 = MAX(max_v2,(fabs(v2)+sqrt((double)cf2sq))/x1);
#else
max_v2 = MAX(max_v2,fabs(v2)+sqrt((double)cf2sq));
#endif
if (pGrid->Nx[2] > 1)
max_v3 = MAX(max_v3,fabs(v3)+sqrt((double)cf3sq));
}
}}
#endif /* SPECIAL_RELATIVITY */
/* compute maximum velocity with particles */
#ifdef PARTICLES
for (q=0; q<pGrid->nparticle; q++) {
if (pGrid->Nx[0] > 1)
max_v1 = MAX(max_v1, pGrid->particle[q].v1);
if (pGrid->Nx[1] > 1)
max_v2 = MAX(max_v2, pGrid->particle[q].v2);
if (pGrid->Nx[2] > 1)
max_v3 = MAX(max_v3, pGrid->particle[q].v3);
}
#endif /* PARTICLES */
/* compute maximum inverse of dt (corresponding to minimum dt) */
if (pGrid->Nx[0] > 1)
max_dti = MAX(max_dti, max_v1/pGrid->dx1);
if (pGrid->Nx[1] > 1)
max_dti = MAX(max_dti, max_v2/pGrid->dx2);
if (pGrid->Nx[2] > 1)
max_dti = MAX(max_dti, max_v3/pGrid->dx3);
}}} /*--- End loop over Domains --------------------------------------------*/
/* new timestep. Limit increase to 2x old value */
if (pM->nstep == 0) {
pM->dt = CourNo/max_dti;
} else {
pM->dt = MIN(2.0*pM->dt, CourNo/max_dti);
}
/* Find minimum timestep over all processors */
#ifdef MPI_PARALLEL
my_dt = pM->dt;
ierr = MPI_Allreduce(&my_dt, &dt, 1, MPI_DOUBLE, MPI_MIN, MPI_COMM_WORLD);
pM->dt = dt;
#endif /* MPI_PARALLEL */
/* modify timestep so loop finishes at t=tlim exactly */
tlim = par_getd("time","tlim");
if ((pM->time < tlim) && ((tlim - pM->time) < pM->dt))
pM->dt = tlim - pM->time;
/* Spread timestep across all Grid structures in all Domains */
for (nl=0; nl<=(pM->NLevels)-1; nl++){
for (nd=0; nd<=(pM->DomainsPerLevel[nl])-1; nd++){
if (pM->Domain[nl][nd].Grid != NULL) {
pM->Domain[nl][nd].Grid->dt = pM->dt;
}
}
}
return;
}
void problem(DomainS *pDomain)
{
GridS *pGrid = pDomain->Grid;
ConsS **Soln;
int i, is = pGrid->is, ie = pGrid->ie;
int j, js = pGrid->js, je = pGrid->je;
int k, ks = pGrid->ks, ke = pGrid->ke;
int nx1, nx2;
int dir;
Real angle; /* Angle the wave direction makes with the x1-direction */
Real x1size,x2size,x1,x2,x3,cs,sn;
Real v_par, v_perp, den, pres;
Real lambda; /* Wavelength */
#ifdef RESISTIVITY
Real v_A, kva, omega_h, omega_l, omega_r;
#endif
nx1 = (ie - is + 1) + 2*nghost;
nx2 = (je - js + 1) + 2*nghost;
if (pGrid->Nx[1] == 1) {
ath_error("[problem] Grid must be 2D");
}
if ((Soln = (ConsS**)calloc_2d_array(nx2,nx1,sizeof(ConsS))) == NULL)
ath_error("[problem]: Error allocating memory for Soln\n");
if (pDomain->Level == 0){
if ((RootSoln =(ConsS**)calloc_2d_array(nx2,nx1,sizeof(ConsS)))==NULL)
ath_error("[problem]: Error allocating memory for RootSoln\n");
}
/* An angle = 0.0 is a wave aligned with the x1-direction. */
/* An angle = 90.0 is a wave aligned with the x2-direction. */
angle = par_getd("problem","angle");
x1size = pDomain->RootMaxX[0] - pDomain->RootMinX[0];
x2size = pDomain->RootMaxX[1] - pDomain->RootMinX[1];
/* Compute the sin and cos of the angle and the wavelength. */
/* Put one wavelength in the grid */
if (angle == 0.0) {
sin_a = 0.0;
cos_a = 1.0;
lambda = x1size;
}
else if (angle == 90.0) {
sin_a = 1.0;
cos_a = 0.0;
lambda = x2size;
}
else {
/* We put 1 wavelength in each direction. Hence the wavelength
* lambda = (pDomain->RootMaxX[0] - pDomain->RootMinX[0])*cos_a
* AND lambda = (pDomain->RootMaxX[1] - pDomain->RootMinX[1])*sin_a;
* are both satisfied. */
if(x1size == x2size){
cos_a = sin_a = sqrt(0.5);
}
else{
angle = atan((double)(x1size/x2size));
sin_a = sin(angle);
cos_a = cos(angle);
}
/* Use the larger angle to determine the wavelength */
if (cos_a >= sin_a) {
lambda = x1size*cos_a;
} else {
lambda = x2size*sin_a;
}
}
/* Initialize k_parallel */
k_par = 2.0*PI/lambda;
b_par = par_getd("problem","b_par");
den = 1.0;
ath_pout(0,"va_parallel = %g\nlambda = %g\n",b_par/sqrt(den),lambda);
b_perp = par_getd("problem","b_perp");
v_perp = b_perp/sqrt((double)den);
dir = par_geti_def("problem","dir",1); /* right(1)/left(2) polarization */
if (dir == 1) /* right polarization */
fac = 1.0;
else /* left polarization */
fac = -1.0;
#ifdef RESISTIVITY
Q_Hall = par_getd("problem","Q_H");
d_ind = 0.0;
v_A = b_par/sqrt((double)den);
if (Q_Hall > 0.0)
{
kva = k_par*v_A;
omega_h = 1.0/Q_Hall;
omega_r = 0.5*SQR(kva)/omega_h*(sqrt(1.0+SQR(2.0*omega_h/kva)) + 1.0);
omega_l = 0.5*SQR(kva)/omega_h*(sqrt(1.0+SQR(2.0*omega_h/kva)) - 1.0);
if (dir == 1) /* right polarization (whistler wave) */
v_perp = v_perp * kva / omega_r;
else /* left polarization */
v_perp = v_perp * kva / omega_l;
}
#endif
/* The gas pressure and parallel velocity are free parameters. */
pres = par_getd("problem","pres");
v_par = par_getd("problem","v_par");
/* Use the vector potential to initialize the interface magnetic fields
* The iterface fields are located at the left grid cell face normal */
for (k=ks; k<=ke; k++) {
for (j=js; j<=je+1; j++) {
for (i=is; i<=ie+1; i++) {
cc_pos(pGrid,i,j,k,&x1,&x2,&x3);
cs = cos(k_par*(x1*cos_a + x2*sin_a));
x1 -= 0.5*pGrid->dx1;
x2 -= 0.5*pGrid->dx2;
pGrid->B1i[k][j][i] = -(A3(x1,(x2+pGrid->dx2)) - A3(x1,x2))/pGrid->dx2;
pGrid->B2i[k][j][i] = (A3((x1+pGrid->dx1),x2) - A3(x1,x2))/pGrid->dx1;
pGrid->B3i[k][j][i] = b_perp*cs;
}
}
}
if (pGrid->Nx[2] > 1) {
for (j=js; j<=je+1; j++) {
for (i=is; i<=ie+1; i++) {
cc_pos(pGrid,i,j,k,&x1,&x2,&x3);
cs = cos(k_par*(x1*cos_a + x2*sin_a));
pGrid->B3i[ke+1][j][i] = b_perp*cs;
}
}
}
/* Now initialize the cell centered quantities */
for (k=ks; k<=ke; k++) {
for (j=js; j<=je; j++) {
for (i=is; i<=ie; i++) {
cc_pos(pGrid,i,j,k,&x1,&x2,&x3);
sn = sin(k_par*(x1*cos_a + x2*sin_a)) * fac;
cs = cos(k_par*(x1*cos_a + x2*sin_a));
Soln[j][i].d = den;
Soln[j][i].M1 = den*(v_par*cos_a + v_perp*sn*sin_a);
Soln[j][i].M2 = den*(v_par*sin_a - v_perp*sn*cos_a);
Soln[j][i].M3 = -den*v_perp*cs;
pGrid->U[k][j][i].d = Soln[j][i].d;
pGrid->U[k][j][i].M1 = Soln[j][i].M1;
pGrid->U[k][j][i].M2 = Soln[j][i].M2;
pGrid->U[k][j][i].M3 = Soln[j][i].M3;
Soln[j][i].B1c = 0.5*(pGrid->B1i[k][j][i] + pGrid->B1i[k][j][i+1]);
Soln[j][i].B2c = 0.5*(pGrid->B2i[k][j][i] + pGrid->B2i[k][j+1][i]);
Soln[j][i].B3c = b_perp*cs;
pGrid->U[k][j][i].B1c = Soln[j][i].B1c;
pGrid->U[k][j][i].B2c = Soln[j][i].B2c;
pGrid->U[k][j][i].B3c = Soln[j][i].B3c;
#ifndef ISOTHERMAL
Soln[j][i].E = pres/Gamma_1 + 0.5*(SQR(pGrid->U[k][j][i].B1c) +
SQR(pGrid->U[k][j][i].B2c) + SQR(pGrid->U[k][j][i].B3c) )
+ 0.5*(SQR(pGrid->U[k][j][i].M1) + SQR(pGrid->U[k][j][i].M2) +
SQR(pGrid->U[k][j][i].M3) )/den;
pGrid->U[k][j][i].E = Soln[j][i].E;
#endif
}
}
}
/* save solution on root grid */
if (pDomain->Level == 0) {
for (j=js; j<=je; j++) {
for (i=is; i<=ie; i++) {
RootSoln[j][i].d = Soln[j][i].d ;
RootSoln[j][i].M1 = Soln[j][i].M1;
RootSoln[j][i].M2 = Soln[j][i].M2;
RootSoln[j][i].M3 = Soln[j][i].M3;
#ifndef ISOTHERMAL
RootSoln[j][i].E = Soln[j][i].E ;
#endif /* ISOTHERMAL */
#ifdef MHD
RootSoln[j][i].B1c = Soln[j][i].B1c;
RootSoln[j][i].B2c = Soln[j][i].B2c;
RootSoln[j][i].B3c = Soln[j][i].B3c;
#endif
#if (NSCALARS > 0)
for (n=0; n<NSCALARS; n++)
RootSoln[j][i].s[n] = Soln[j][i].s[n];
#endif
}}
}
return;
}
void problem(DomainS *pDomain)
{
GridS *pGrid = pDomain->Grid;
int i=0,j=0,k=0;
int is,ie,js,je,ks,ke,iprob;
Real amp,drat,vflow,b0,a,sigma,x1,x2,x3;
long int iseed = -1;
is = pGrid->is; ie = pGrid->ie;
js = pGrid->js; je = pGrid->je;
ks = pGrid->ks; ke = pGrid->ke;
/* Read problem parameters */
iprob = par_geti("problem","iprob");
vflow = par_getd("problem","vflow");
drat = par_getd("problem","drat");
amp = par_getd("problem","amp");
#ifdef MHD
b0 = par_getd("problem","b0");
#endif
/* iprob=1. Two uniform streams moving at +/- vflow, random perturbations */
if (iprob == 1) {
for (k=ks; k<=ke; k++) {
for (j=js; j<=je; j++) {
for (i=is; i<=ie; i++) {
cc_pos(pGrid,i,j,k,&x1,&x2,&x3);
pGrid->U[k][j][i].d = 1.0;
pGrid->U[k][j][i].M1 = vflow + amp*(ran2(&iseed) - 0.5);
pGrid->U[k][j][i].M2 = amp*(ran2(&iseed) - 0.5);
pGrid->U[k][j][i].M3 = 0.0;
if (fabs(x2) < 0.25) {
pGrid->U[k][j][i].d = drat;
pGrid->U[k][j][i].M1 = -drat*(vflow + amp*(ran2(&iseed) - 0.5));
pGrid->U[k][j][i].M2 = drat*amp*(ran2(&iseed) - 0.5);
}
/* Pressure scaled to give a sound speed of 1 with gamma=1.4 */
#ifndef BAROTROPIC
pGrid->U[k][j][i].E = 2.5/Gamma_1
+ 0.5*(SQR(pGrid->U[k][j][i].M1) + SQR(pGrid->U[k][j][i].M2)
+ SQR(pGrid->U[k][j][i].M3))/pGrid->U[k][j][i].d;
#endif /* BAROTROPIC */
#ifdef MHD
pGrid->B1i[k][j][i] = b0;
pGrid->U[k][j][i].B1c = b0;
#ifndef BAROTROPIC
pGrid->U[k][j][i].E += 0.5*b0*b0;
#endif /* BAROTROPIC */
#endif /* MHD */
}
#ifdef MHD
pGrid->B1i[k][j][ie+1] = b0;
#endif
}
}
}
/* iprob=2. Test suggested by E. Zweibel, based on Ryu & Jones.
* Two uniform density flows with single mode perturbation
*/
if (iprob == 2) {
a = 0.05;
sigma = 0.2;
for (k=ks; k<=ke; k++) {
for (j=js; j<=je; j++) {
for (i=is; i<=ie; i++) {
cc_pos(pGrid,i,j,k,&x1,&x2,&x3);
pGrid->U[k][j][i].d = 1.0;
pGrid->U[k][j][i].M1 = vflow*tanh(x2/a);
pGrid->U[k][j][i].M2 = amp*sin(2.0*PI*x1)*exp(-(x2*x2)/(sigma*sigma));
pGrid->U[k][j][i].M3 = 0.0;
#ifndef BAROTROPIC
pGrid->U[k][j][i].E = 1.0/Gamma_1
+ 0.5*(SQR(pGrid->U[k][j][i].M1) + SQR(pGrid->U[k][j][i].M2)
+ SQR(pGrid->U[k][j][i].M3))/pGrid->U[k][j][i].d;
#endif /* BAROTROPIC */
#ifdef MHD
pGrid->B1i[k][j][i] = b0;
pGrid->U[k][j][i].B1c = b0;
#ifndef BAROTROPIC
pGrid->U[k][j][i].E += 0.5*b0*b0;
#endif /* BAROTROPIC */
#endif /* MHD */
/* Use passive scalar to keep track of the fluids, since densities are same */
#if (NSCALARS > 0)
pGrid->U[k][j][i].s[0] = 0.0;
if (x2 > 0) pGrid->U[k][j][i].s[0] = 1.0;
#endif
}
#ifdef MHD
pGrid->B1i[k][j][ie+1] = b0;
#endif
}
}
}
/* With viscosity and/or resistivity, read eta_R and nu_V */
#ifdef OHMIC
eta_Ohm = par_getd("problem","eta");
#endif
#ifdef NAVIER_STOKES
nu_V = par_getd("problem","nu");
#endif
#ifdef BRAGINSKII
nu_V = par_getd("problem","nu");
#endif
}
void init_output(MeshS *pM)
{
int i,j,outn,maxout;
char block[80], *fmt, defid[10];
OutputS new_out;
int usr_expr_flag;
maxout = par_geti_def("job","maxout",MAXOUT_DEFAULT);
/* allocate output array */
if((OutArray = (OutputS *)malloc(maxout*sizeof(OutputS))) == NULL){
ath_error("[init_output]: Error allocating output array\n");
}
/*--- loop over maxout output blocks, reading parameters into a temporary -----*
*--- OutputS called new_out --------------------------------------------------*/
for (outn=1; outn<=maxout; outn++) {
sprintf(block,"output%d",outn);
/* An output format or output name is required.
* If neither is present we write an error message and move on. */
if((par_exist(block,"out_fmt") == 0) && (par_exist(block,"name") == 0)){
ath_perr(-1,"[init_output]: neither %s/out_fmt, nor %s/name exist\n",
block, block);
continue;
}
/* Zero (NULL) all members of the temporary OutputS structure "new_out" */
memset(&new_out,0,sizeof(OutputS));
/* The next output time and number */
new_out.t = par_getd_def(block,"time",pM->time);
new_out.num = par_geti_def(block,"num",0);
new_out.dt = par_getd(block,"dt");
new_out.n = outn;
/* level and domain number can be specified with SMR */
new_out.nlevel = par_geti_def(block,"level",-1);
new_out.ndomain = par_geti_def(block,"domain",-1);
if (par_exist(block,"dat_fmt")) new_out.dat_fmt = par_gets(block,"dat_fmt");
/* set id in output filename to input string if present, otherwise use "outN"
* as default, where N is output number */
sprintf(defid,"out%d",outn);
new_out.id = par_gets_def(block,"id",defid);
if(par_exist(block,"out_fmt"))
fmt = new_out.out_fmt = par_gets(block,"out_fmt");
/* out: controls what variable can be output (all, prim, or any of expr_*)
* out_fmt: controls format of output (single variable) or dump (all cons/prim)
* if "out" doesn't exist, we assume 'cons' variables are meant to be dumped */
new_out.out = par_gets_def(block,"out","cons");
#ifdef PARTICLES
/* check input for particle binning (=1, default) or not (=0) */
new_out.out_pargrid = par_geti_def(block,"pargrid",
check_particle_binning(new_out.out));
if ((new_out.out_pargrid < 0) || (new_out.out_pargrid >1)) {
ath_perr(-1,"[init_output]: %s/pargrid must be 0 or 1\n", block);
continue;
}
/* set particle property selection function. By default, will select all the
* particles. Used only when particle output is called, otherwise useless. */
if(par_exist(block,"par_prop")) {
new_out.par_prop = get_usr_par_prop(par_gets(block,"par_prop"));
if (new_out.par_prop == NULL) {
ath_pout(0,"[init_output]: Particle selection function not found! \
Now use the default one.\n");
new_out.par_prop = property_all;
}
}
void problem(Grid *pGrid, Domain *pDomain)
{
int in,i,j,k;
Real x1,x2,x3;
long p;
Vector parpos, parvel;
if (par_geti("grid","Nx2") == 1) {
ath_error("[par_epicycle]: par_epicycle must work in 2D or 3D.\n");
}
/* Initialize boxsize */
x1min = par_getd("grid","x1min");
x1max = par_getd("grid","x1max");
Lx = x1max - x1min;
x2min = par_getd("grid","x2min");
x2max = par_getd("grid","x2max");
Ly = x2max - x2min; /* for 3D problem */
if (par_geti("grid","Nx3") == 1) {
Ly = 0.0;
}
/* Read initial conditions */
Omega_0 = par_getd("problem","omega");
qshear = par_getd_def("problem","qshear",1.5);
amp = par_getd("problem","amp");
omg = sqrt(2.0*(2.0-qshear))*Omega_0;
/* particle type */
if (par_geti("particle","partypes") != 1)
ath_error("[par_epicycle]: This test only allows ONE particle species!\n");
/* particle stopping time */
tstop0[0] = par_getd_def("problem","tstop",1.0e20); /* in code unit */
if (par_geti("particle","tsmode") != 3)
ath_error("[par_epicycle]: This test only allows fixed stopping time!\n");
/* particle position */
parpos = ParticlePosition(0.0);
parvel = ParticleVelocity(parpos, 0.0);
in = ParticleLocator(parpos);
pGrid->nparticle = in;
pGrid->grproperty[0].num = in;
if (pGrid->nparticle+2 > pGrid->arrsize)
particle_realloc(pGrid, pGrid->nparticle+2);
/* Now set initial conditions for the gas */
for (k=pGrid->ks; k<=pGrid->ke; k++) {
for (j=pGrid->js; j<=pGrid->je; j++) {
for (i=pGrid->is; i<=pGrid->ie; i++) {
cc_pos(pGrid,i,j,k,&x1,&x2,&x3);
pGrid->U[k][j][i].d = 1.0;
pGrid->U[k][j][i].M1 = 0.0;
pGrid->U[k][j][i].M2 = 0.0;
pGrid->U[k][j][i].M3 = 0.0;
#ifndef FARGO
if (Ly>0.0) /* 3D */
pGrid->U[k][j][i].M2 -= qshear*Omega_0*x1;
else /* 2D */
pGrid->U[k][j][i].M3 -= qshear*Omega_0*x1;
#endif
}}}
/* Now set initial conditions for the particles */
for (p=0; p<in; p++)
{
pGrid->particle[p].property = 0;
pGrid->particle[p].x1 = parpos.x1;
pGrid->particle[p].x2 = parpos.x2;
pGrid->particle[p].x3 = parpos.x3;
pGrid->particle[p].v1 = parvel.x1;
pGrid->particle[p].v2 = parvel.x2;
pGrid->particle[p].v3 = parvel.x3;
pGrid->particle[p].pos = 1; /* grid particle */
pGrid->particle[p].my_id = p;
#ifdef MPI_PARALLEL
pGrid->particle[p].init_id = pGrid->my_id;
#endif
}
/* enroll gravitational potential function, shearing sheet BC functions */
StaticGravPot = ShearingBoxPot;
if (pGrid->my_id == 0) {
/* flush output file */
sprintf(name, "%s_Traj.dat", pGrid->outfilename);
FILE *fid = fopen(name,"w");
fclose(fid);
#ifdef MPI_PARALLEL
sprintf(name, "../%s_Traj.dat", pGrid->outfilename);
#else
sprintf(name, "%s_Traj.dat", pGrid->outfilename);
#endif
}
#ifdef MPI_PARALLEL
MPI_Bcast(name,50,MPI_CHAR,0,MPI_COMM_WORLD);
#endif
return;
}
void problem(Grid *pGrid, Domain *pDomain)
{
int i,is,ie,j,js,je,ks,nx1,nx2,iprob;
long int iseed = -1; /* Initialize on the first call to ran2 */
Real d0,p0,B0,v0,x1,x2,x3,x1min,x1max,Lx,k0,press,amp,kp;
is = pGrid->is;
ie = pGrid->ie;
js = pGrid->js;
je = pGrid->je;
ks = pGrid->ks;
nx1 = (ie-is)+1;
nx2 = (je-js)+1;
if ((nx1 == 1) || (nx2 == 1)) {
ath_error("[firehose]: This problem can only be run in 2D\n");
}
d0 = 1.0;
p0 = 1.0;
B0 = par_getd("problem","B0");
v0 = par_getd("problem","v0");
#ifdef VISCOSITY
nu_iso = par_getd_def("problem","nu_iso",0.0);
nu_aniso = par_getd_def("problem","nu_aniso",0.0);
#endif
amp = par_getd("problem","amp");
kp = par_getd("problem","kp");
iprob = par_getd("problem","iprob");
/* Initialize wavenumber */
x1min = par_getd("grid","x1min");
x1max = par_getd("grid","x1max");
Lx = x1max - x1min;
k0 = 2.0*PI/Lx;
/* iprob=1: Cowley/Hammett vortex test ---------------------------------------*/
/* Initialize density, momentum, face-centered fields */
if (iprob == 1) {
for (j=js; j<=je; j++) {
for (i=is; i<=ie; i++) {
/* Calculate the cell center positions */
cc_pos(pGrid,i,j,ks,&x1,&x2,&x3);
pGrid->U[ks][j][i].d = d0;
pGrid->U[ks][j][i].M1 = -d0*v0*cos(k0*x2)*sin(k0*x1);
pGrid->U[ks][j][i].M2 = d0*v0*sin(k0*x2)*cos(k0*x1)+amp*cos(kp*x1);
pGrid->U[ks][j][i].M3 = 0.0;
#ifdef MHD
pGrid->B1i[ks][j][i] = B0;
pGrid->B2i[ks][j][i] = 0.0;
pGrid->B3i[ks][j][i] = 0.0;
pGrid->U[ks][j][i].B1c = B0;
pGrid->U[ks][j][i].B2c = 0.0;
pGrid->U[ks][j][i].B3c = 0.0;
#endif /* MHD */
press = p0 + 0.5*d0*v0*v0*(cos(k0*x1)*cos(k0*x1) + cos(k0*x2)*cos(k0*x2));
pGrid->U[ks][j][i].E = press/Gamma_1
#ifdef MHD
+ 0.5*(SQR(pGrid->U[ks][j][i].B1c) + SQR(pGrid->U[ks][j][i].B2c)
+ SQR(pGrid->U[ks][j][i].B3c))
#endif /* MHD */
+ 0.5*(SQR(pGrid->U[ks][j][i].M1) + SQR(pGrid->U[ks][j][i].M2)
+ SQR(pGrid->U[ks][j][i].M3))/pGrid->U[ks][j][i].d;
}
}
#ifdef MHD
/* boundary conditions on interface B */
for (j=js; j<=je; j++) {
pGrid->B1i[ks][j][ie+1] = B0;
}
for (i=is; i<=ie; i++) {
pGrid->B2i[ks][je+1][i] = 0.0;
}
#endif /* MHD */
}
/* iprob=2: Sharma shear test ----------------------------------------------- */
/* Initialize density, momentum, face-centered fields */
if (iprob == 2) {
for (j=js; j<=je; j++) {
for (i=is; i<=ie; i++) {
/* Calculate the cell center positions */
cc_pos(pGrid,i,j,ks,&x1,&x2,&x3);
pGrid->U[ks][j][i].d = d0;
pGrid->U[ks][j][i].M1 = d0*amp*(ran2(&iseed) - 0.5);
pGrid->U[ks][j][i].M2 = d0*(amp*(ran2(&iseed) - 0.5) - 0.015*x1);
pGrid->U[ks][j][i].M3 = 0.0;
#ifdef MHD
pGrid->B1i[ks][j][i] = B0;
pGrid->B2i[ks][j][i] = B0;
pGrid->B3i[ks][j][i] = 0.0;
pGrid->U[ks][j][i].B1c = B0;
pGrid->U[ks][j][i].B2c = B0;
pGrid->U[ks][j][i].B3c = 0.0;
#endif /* MHD */
pGrid->U[ks][j][i].E = 0.1/Gamma_1
#ifdef MHD
+ 0.5*(SQR(pGrid->U[ks][j][i].B1c) + SQR(pGrid->U[ks][j][i].B2c)
+ SQR(pGrid->U[ks][j][i].B3c))
#endif /* MHD */
+ 0.5*(SQR(pGrid->U[ks][j][i].M1) + SQR(pGrid->U[ks][j][i].M2)
+ SQR(pGrid->U[ks][j][i].M3))/pGrid->U[ks][j][i].d;
}
}
#ifdef MHD
/* boundary conditions on interface B */
for (j=js; j<=je; j++) {
pGrid->B1i[ks][j][ie+1] = B0;
}
for (i=is; i<=ie; i++) {
pGrid->B2i[ks][je+1][i] = B0;
}
#endif /* MHD */
/* Enroll special BCs for shearing sheet */
set_bvals_mhd_fun(left_x1, pbc_ix1);
set_bvals_mhd_fun(right_x1, pbc_ox1);
}
return;
}
void problem(DomainS *pDomain)
{
GridS *pGrid = pDomain->Grid;
int i=0,j=0,k=0;
int is,ie,js,je,ks,ke,nx1,nx2,nx3,iprob;
Real x1c,x2c,x3c,x1f,x2f,x3f; /* cell- and face-centered coordinates */
Real x1size,x2size,x3size,lambda=0.0,ang_2=0.0,sin_a2=0.0,cos_a2=1.0,x,y;
Real rad,amp,vflow,drat,diag;
Real ***az,***ay,***ax;
#ifdef MHD
int ku;
#endif
#if (NSCALARS > 0)
int n;
#endif
is = pGrid->is; ie = pGrid->ie;
js = pGrid->js; je = pGrid->je;
ks = pGrid->ks; ke = pGrid->ke;
nx1 = (ie-is)+1 + 2*nghost;
nx2 = (je-js)+1 + 2*nghost;
nx3 = (ke-ks)+1 + 2*nghost;
if (((je-js) == 0)) {
ath_error("[field_loop]: This problem can only be run in 2D or 3D\n");
}
if ((ay = (Real***)calloc_3d_array(nx3, nx2, nx1, sizeof(Real))) == NULL) {
ath_error("[field_loop]: Error allocating memory for vector pot\n");
}
if ((az = (Real***)calloc_3d_array(nx3, nx2, nx1, sizeof(Real))) == NULL) {
ath_error("[field_loop]: Error allocating memory for vector pot\n");
}
if ((ax = (Real***)calloc_3d_array(nx3, nx2, nx1, sizeof(Real))) == NULL) {
ath_error("[field_loop]: Error allocating memory for vector pot\n");
}
/* Read initial conditions, diffusion coefficients (if needed) */
rad = par_getd("problem","rad");
amp = par_getd("problem","amp");
vflow = par_getd("problem","vflow");
drat = par_getd_def("problem","drat",1.0);
iprob = par_getd("problem","iprob");
#ifdef RESISTIVITY
eta_Ohm = par_getd_def("problem","eta_O",0.0);
Q_Hall = par_getd_def("problem","Q_H",0.0);
Q_AD = par_getd_def("problem","Q_AD",0.0);
#endif
#ifdef THERMAL_CONDUCTION
kappa_iso = par_getd_def("problem","kappa_iso",0.0);
kappa_aniso = par_getd_def("problem","kappa_aniso",0.0);
#endif
/* For (iprob=4) -- rotated cylinder in 3D -- set up rotation angle and
* wavelength of cylinder */
if(iprob == 4){
x1size = pDomain->RootMaxX[0] - pDomain->RootMinX[0];
x3size = pDomain->RootMaxX[2] - pDomain->RootMinX[2];
/* We put 1 wavelength in each direction. Hence the wavelength
* lambda = x1size*cos_a;
* AND lambda = x3size*sin_a;
* are both satisfied. */
if(x1size == x3size){
ang_2 = PI/4.0;
cos_a2 = sin_a2 = sqrt(0.5);
}
else{
ang_2 = atan(x1size/x3size);
sin_a2 = sin(ang_2);
cos_a2 = cos(ang_2);
}
/* Use the larger angle to determine the wavelength */
if (cos_a2 >= sin_a2) {
lambda = x1size*cos_a2;
} else {
lambda = x3size*sin_a2;
}
}
/* Use vector potential to initialize field loop */
for (k=ks; k<=ke+1; k++) {
for (j=js; j<=je+1; j++) {
for (i=is; i<=ie+1; i++) {
cc_pos(pGrid,i,j,k,&x1c,&x2c,&x3c);
x1f = x1c - 0.5*pGrid->dx1;
x2f = x2c - 0.5*pGrid->dx2;
x3f = x3c - 0.5*pGrid->dx3;
/* (iprob=1): field loop in x1-x2 plane (cylinder in 3D) */
if(iprob==1) {
ax[k][j][i] = 0.0;
ay[k][j][i] = 0.0;
if ((x1f*x1f + x2f*x2f) < rad*rad) {
az[k][j][i] = amp*(rad - sqrt(x1f*x1f + x2f*x2f));
} else {
az[k][j][i] = 0.0;
}
}
/* (iprob=2): field loop in x2-x3 plane (cylinder in 3D) */
if(iprob==2) {
if ((x2f*x2f + x3f*x3f) < rad*rad) {
ax[k][j][i] = amp*(rad - sqrt(x2f*x2f + x3f*x3f));
} else {
ax[k][j][i] = 0.0;
}
ay[k][j][i] = 0.0;
az[k][j][i] = 0.0;
}
/* (iprob=3): field loop in x3-x1 plane (cylinder in 3D) */
if(iprob==3) {
if ((x1f*x1f + x3f*x3f) < rad*rad) {
ay[k][j][i] = amp*(rad - sqrt(x1f*x1f + x3f*x3f));
} else {
ay[k][j][i] = 0.0;
}
ax[k][j][i] = 0.0;
az[k][j][i] = 0.0;
}
/* (iprob=4): rotated cylindrical field loop in 3D. Similar to iprob=1
* with a rotation about the x2-axis. Define coordinate systems (x1,x2,x3)
* and (x,y,z) with the following transformation rules:
* x = x1*cos(ang_2) + x3*sin(ang_2)
* y = x2
* z = -x1*sin(ang_2) + x3*cos(ang_2)
* This inverts to:
* x1 = x*cos(ang_2) - z*sin(ang_2)
* x2 = y
* x3 = x*sin(ang_2) + z*cos(ang_2)
*/
if(iprob==4) {
x = x1c*cos_a2 + x3f*sin_a2;
y = x2f;
/* shift x back to the domain -0.5*lambda <= x <= 0.5*lambda */
while(x > 0.5*lambda) x -= lambda;
while(x < -0.5*lambda) x += lambda;
if ((x*x + y*y) < rad*rad) {
ax[k][j][i] = amp*(rad - sqrt(x*x + y*y))*(-sin_a2);
} else {
ax[k][j][i] = 0.0;
}
ay[k][j][i] = 0.0;
x = x1f*cos_a2 + x3c*sin_a2;
y = x2f;
/* shift x back to the domain -0.5*lambda <= x <= 0.5*lambda */
while(x > 0.5*lambda) x -= lambda;
while(x < -0.5*lambda) x += lambda;
if ((x*x + y*y) < rad*rad) {
az[k][j][i] = amp*(rad - sqrt(x*x + y*y))*(cos_a2);
} else {
az[k][j][i] = 0.0;
}
}
/* (iprob=5): spherical field loop in rotated plane */
if(iprob==5) {
ax[k][j][i] = 0.0;
if ((x1f*x1f + x2c*x2c + x3f*x3f) < rad*rad) {
ay[k][j][i] = amp*(rad - sqrt(x1f*x1f + x2c*x2c + x3f*x3f));
} else {
ay[k][j][i] = 0.0;
}
if ((x1f*x1f + x2f*x2f + x3c*x3c) < rad*rad) {
az[k][j][i] = amp*(rad - sqrt(x1f*x1f + x2f*x2f + x3c*x3c));
} else {
az[k][j][i] = 0.0;
}
}
}}}
/* Initialize density and momenta. If drat != 1, then density and temperature
* will be different inside loop than background values
*/
x1size = pDomain->RootMaxX[0] - pDomain->RootMinX[0];
x2size = pDomain->RootMaxX[1] - pDomain->RootMinX[1];
x3size = pDomain->RootMaxX[2] - pDomain->RootMinX[2];
diag = sqrt(x1size*x1size + x2size*x2size + x3size*x3size);
for (k=ks; k<=ke; k++) {
for (j=js; j<=je; j++) {
for (i=is; i<=ie; i++) {
pGrid->U[k][j][i].d = 1.0;
pGrid->U[k][j][i].M1 = pGrid->U[k][j][i].d*vflow*x1size/diag;
pGrid->U[k][j][i].M2 = pGrid->U[k][j][i].d*vflow*x2size/diag;
pGrid->U[k][j][i].M3 = pGrid->U[k][j][i].d*vflow*x3size/diag;
cc_pos(pGrid,i,j,k,&x1c,&x2c,&x3c);
if ((x1c*x1c + x2c*x2c + x3c*x3c) < rad*rad) {
pGrid->U[k][j][i].d = drat;
pGrid->U[k][j][i].M1 = pGrid->U[k][j][i].d*vflow*x1size/diag;
pGrid->U[k][j][i].M2 = pGrid->U[k][j][i].d*vflow*x2size/diag;
pGrid->U[k][j][i].M3 = pGrid->U[k][j][i].d*vflow*x3size/diag;
}
#if (NSCALARS > 0)
for (n=0; n<NSCALARS; n++) pGrid->U[k][j][i].s[n] = 0.0;
if ((x1c*x1c + x2c*x2c + x3c*x3c) < rad*rad) {
for (n=0; n<NSCALARS; n++) pGrid->U[k][j][i].s[n] = 1.0;
}
#endif
}}}
/* boundary conditions on interface B */
#ifdef MHD
for (k=ks; k<=ke; k++) {
for (j=js; j<=je; j++) {
for (i=is; i<=ie+1; i++) {
pGrid->B1i[k][j][i] = (az[k][j+1][i] - az[k][j][i])/pGrid->dx2 -
(ay[k+1][j][i] - ay[k][j][i])/pGrid->dx3;
}}}
for (k=ks; k<=ke; k++) {
for (j=js; j<=je+1; j++) {
for (i=is; i<=ie; i++) {
pGrid->B2i[k][j][i] = (ax[k+1][j][i] - ax[k][j][i])/pGrid->dx3 -
(az[k][j][i+1] - az[k][j][i])/pGrid->dx1;
}}}
if (ke > ks) {
ku = ke+1;
} else {
ku = ke;
}
for (k=ks; k<=ku; k++) {
for (j=js; j<=je; j++) {
for (i=is; i<=ie; i++) {
pGrid->B3i[k][j][i] = (ay[k][j][i+1] - ay[k][j][i])/pGrid->dx1 -
(ax[k][j+1][i] - ax[k][j][i])/pGrid->dx2;
}}}
#endif
/* initialize total energy and cell-centered B */
#if defined MHD || !defined ISOTHERMAL
for (k=ks; k<=ke; k++) {
for (j=js; j<=je; j++) {
for (i=is; i<=ie; i++) {
#ifdef MHD
pGrid->U[k][j][i].B1c = 0.5*(pGrid->B1i[k][j][i ] +
pGrid->B1i[k][j][i+1]);
pGrid->U[k][j][i].B2c = 0.5*(pGrid->B2i[k][j ][i] +
pGrid->B2i[k][j+1][i]);
if (ke > ks)
pGrid->U[k][j][i].B3c = 0.5*(pGrid->B3i[k ][j][i] +
pGrid->B3i[k+1][j][i]);
else
pGrid->U[k][j][i].B3c = pGrid->B3i[k][j][i];
#endif
#ifndef ISOTHERMAL
pGrid->U[k][j][i].E = 1.0/Gamma_1
#ifdef MHD
+ 0.5*(SQR(pGrid->U[k][j][i].B1c) + SQR(pGrid->U[k][j][i].B2c)
+ SQR(pGrid->U[k][j][i].B3c))
#endif
+ 0.5*(SQR(pGrid->U[k][j][i].M1) + SQR(pGrid->U[k][j][i].M2)
+ SQR(pGrid->U[k][j][i].M3))/pGrid->U[k][j][i].d;
#endif /* ISOTHERMAL */
}
}
}
#endif
free_3d_array((void***)az);
free_3d_array((void***)ay);
free_3d_array((void***)ax);
}