/**==============================================================================
* Copy whole structure from device memory to host memory
*/
void copy_gpu_mem_to_gpu(Grid_gpu *pG_host, Grid_gpu *pG_gpu_dev) {
cudaError_t code;
code = cudaMemcpy(pG_host, pG_gpu_dev, sizeof(Grid_gpu), cudaMemcpyDeviceToHost);
if(code != cudaSuccess) {
ath_error("[copy_gpu_to_gpu_mem] error: %s\n", cudaGetErrorString(code));
}
}
void update_starparticles(GridS *pG, Cons1DS ***x1Flux, Cons1DS ***x2Flux,
Cons1DS ***x3Flux)
{
StarParListS *pList=NULL;
StarParS *pStar=NULL;
int ip,jp,kp;
Real minv,dm,dM1,dM2,dM3;
pList = pG->Lstars;
while (pList) {
pStar = &(pList->starpar);
cc_ijk(pG,pStar->x1,pStar->x2,pStar->x3,&ip,&jp,&kp);
mass_inflow(pG,pStar,x1Flux,x2Flux,x3Flux,&dm,&dM1,&dM2,&dM3);
if (dm > 0.0) {
minv = 1.0/(pStar->m+dm);
pStar->v1 = (pStar->m*pStar->v1+dM1)*minv;
pStar->v2 = (pStar->m*pStar->v2+dM2)*minv;
pStar->v3 = (pStar->m*pStar->v3+dM3)*minv;
pStar->m += dm;
pStar->mdot = dm/pG->dt;
}
if(pStar->m < 0) ath_error("[update_SP] mass cannot be negative!\n");
pList = pList->next;
}
return;
}
static void add_par_line(Block *bp, char *line)
{
char *cp;
char *name, *equal=NULL, *value=NULL, *hash=NULL, *comment=NULL, *nul;
if(bp == NULL)
ath_error("[add_par_line]: (no block name) while parsing line \n%s\n",line);
name = skipwhite(line); /* name */
for(cp = name; *cp != '\0'; cp++){/* Find the first '=' and '#' */
if(*cp == '='){
if(equal == NULL){
equal = cp; /* store the equals sign location */
value = skipwhite(cp + 1); /* value */
}
}
if(*cp == '#'){
hash = cp; /* store the hash sign location */
comment = skipwhite(cp + 1); /* comment */
break;
}
}
while(*cp != '\0') cp++; /* Find the NUL terminator */
nul = cp;
if(equal == NULL)
ath_error("No '=' found in line \"%s\"\n",line);
str_term(equal); /* Terminate the name string */
if(hash == NULL){
str_term(nul); /* Terminate the value string */
}
else{
str_term(hash); /* Terminate the value string */
if(*comment == '\0')
comment = NULL; /* Comment field is empty */
else
str_term(nul); /* Terminate the comment string */
}
add_par(bp,name,value,comment);
}
void dump_history_enroll(const ConsFun_t pfun, const char *label){
if(usr_hst_cnt >= MAX_USR_H_COUNT)
ath_error("[dump_history_enroll]: MAX_USR_H_COUNT = %d exceeded\n",
MAX_USR_H_COUNT);
/* Copy the label string */
if((usr_label[usr_hst_cnt] = ath_strdup(label)) == NULL)
ath_error("[dump_history_enroll]: Error on sim_strdup(\"%s\")\n",label);
/* Store the function pointer */
phst_fun[usr_hst_cnt] = pfun;
usr_hst_cnt++;
return;
}
/*! \fn void ludcmp(Real **a, int n, int *indx, Real *d)
* \brief LU decomposition from Numerical Recipes
*
* Using Crout's method with partial pivoting
* a is the input matrix, and is returned with LU decomposition readily made,
* n is the matrix size, indx records the history of row permutation,
* whereas d =1(-1) for even(odd) number of permutations.
*/
void ludcmp(Real **a, int n, int *indx, Real *d)
{
int i,imax,j,k;
Real big,dum,sum,temp;
Real *rowscale; /* the implicit scaling of each row */
rowscale = (Real*)calloc_1d_array(n, sizeof(Real));
*d=1.0; /* No row interchanges yet */
for (i=0;i<n;i++)
{ /* Loop over rows to get the implicit scaling information */
big=0.0;
for (j=0;j<n;j++)
if ((temp=fabs(a[i][j])) > big) big=temp;
if (big == 0.0) ath_error("[LUdecomp]:Input matrix is singular!");
rowscale[i]=1.0/big; /* Save the scaling */
}
for (j=0;j<n;j++) { /* Loop over columns of Crout's method */
/* Calculate the upper block */
for (i=0;i<j;i++) {
sum=a[i][j];
for (k=0;k<i;k++) sum -= a[i][k]*a[k][j];
a[i][j]=sum;
}
/* Calculate the lower block (first step) */
big=0.0;
for (i=j;i<n;i++) {
sum=a[i][j];
for (k=0;k<j;k++)
sum -= a[i][k]*a[k][j];
a[i][j]=sum;
/* search for the largest pivot element */
if ( (dum=rowscale[i]*fabs(sum)) >= big) {
big=dum;
imax=i;
}
}
/* row interchange */
if (j != imax) {
for (k=0;k<n;k++) {
dum=a[imax][k];
a[imax][k]=a[j][k];
a[j][k]=dum;
}
*d = -(*d);
rowscale[imax]=rowscale[j];
}
indx[j]=imax; /* record row interchange history */
/* Calculate the lower block (second step) */
if (a[j][j] == 0.0) a[j][j]=TINY_NUMBER;
dum=1.0/(a[j][j]);
for (i=j+1;i<n;i++) a[i][j] *= dum;
}
free(rowscale);
}
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;
}
static void *calloc_1d_array(size_t nc, size_t size)
{
void *array;
if ((array = (void *)calloc(nc,size)) == NULL) {
ath_error("[calloc_1d] failed to allocate memory (%d of size %d)\n",
(int)nc,(int)size);
return NULL;
}
return array;
}
int initialize_code(){
#ifdef MPI_PARALLEL
/* Get my task id (rank in MPI) */
if(MPI_SUCCESS != MPI_Comm_rank(MPI_COMM_WORLD,&(level0_Grid.my_id)))
ath_error("Error on calling MPI_Comm_rank\n");
/* Get the number of processes */
if(MPI_SUCCESS != MPI_Comm_size(MPI_COMM_WORLD,&(level0_Grid.nproc)))
ath_error("Error on calling MPI_Comm_size\n");
#else
level0_Grid.my_id = 0;
level0_Grid.nproc = 1;
#endif
par_open("/dev/null"); /* to trick athena into thinking it has opened a parameter file, will not work on windows */
is_restart = 0;
show_config_par(); /* Add the configure block to the parameter database */
return 0;
}
void par_cmdline(int argc, char *argv[])
{
int i;
char *sp, *ep;
char *block, *name, *value;
Block *bp;
Par *pp;
int len;
if (debug) printf("PAR_CMDLINE: \n");
for (i=1; i<argc; i++) {
block = argv[i];
sp = strchr(block,'/');
if ((sp = strchr(block,'/')) == NULL) continue;
*sp = '\0';
name = sp + 1;
if((ep = strchr(name,'=')) == NULL){
*sp = '/'; /* Repair argv[i] */
continue;
}
*ep = '\0';
value = ep + 1;
if (debug) printf("PAR_CMDLINE: %s/%s=%s\n",block,name,value);
bp = find_block(block);
if (bp == NULL) ath_error("par_cmdline: Block \"%s\" not found\n",block);
pp = find_par(bp,name);
if (pp == NULL) ath_error("par_cmdline: Par \"%s\" not found\n",name);
free(pp->value);
pp->value = my_strdup(value);
len = (int)strlen(value); /* Update the maximum Par value length */
bp->max_value_len = len > bp->max_value_len ? len : bp->max_value_len;
/* Repair argv[i] */
*sp = '/';
*ep = '=';
}
}
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;
}
/**==============================================================================
* Copy back grid structures from GPU device memory to
* grid structure in host memory
*/
void copy_to_host_mem(Grid *pG, Grid_gpu *pG_gpu) {
cudaError_t code;
int i, Nx2T, Nx1T;
if (pG->Nx2 > 1)
Nx2T = pG->Nx2 + 2*nghost;
else
Nx2T = 1;
if (pG->Nx1 > 1)
Nx1T = pG->Nx1 + 2*nghost;
else
Nx1T = 1;
/* Copy row by row */
for(i=0; i<Nx2T; i++) {
/* U */
code = cudaMemcpy(pG->U[i], pG_gpu->U+i*Nx1T, sizeof(Gas)*Nx1T, cudaMemcpyDeviceToHost);
if(code != cudaSuccess) {
ath_error("[copy_to_host_mem U] error: %s\n", cudaGetErrorString(code));
}
/* B1i */
code = cudaMemcpy(pG->B1i[i], pG_gpu->B1i+i*Nx1T, sizeof(Real)*Nx1T, cudaMemcpyDeviceToHost);
if(code != cudaSuccess) {
ath_error("[copy_to_host_mem B1i] error: %s\n", cudaGetErrorString(code));
}
/* B2i */
code = cudaMemcpy(pG->B2i[i], pG_gpu->B2i+i*Nx1T, sizeof(Real)*Nx1T, cudaMemcpyDeviceToHost);
if(code != cudaSuccess) {
ath_error("[copy_to_host_mem B2i] error: %s\n", cudaGetErrorString(code));
}
/* B3i */
code = cudaMemcpy(pG->B3i[i], pG_gpu->B3i+i*Nx1T, sizeof(Real)*Nx1T, cudaMemcpyDeviceToHost);
if(code != cudaSuccess) {
ath_error("[copy_to_host_mem B3i] error: %s\n", cudaGetErrorString(code));
}
}
}
static char *line_block_name(char *line)
{
char *sp, *cp;
/* We assume that (*line == '<') is true */
/* Skip leading white space and remember the start of block name */
sp = cp = skipwhite(line+1);
while (*cp != '\0' && *cp != '>')
cp++;
if (*cp != '>') ath_error("Blockname %s does not appear terminated\n",sp);
str_term(cp); /* patch the line and remove any trailing white space */
return sp; /* return pointer into the now patched input string */
}
void Userwork_in_loop(MeshS *pM)
{
GridS *pGrid;
int nl,nd;
Real newtime;
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;
if (isnan(pGrid->dt)) ath_error("Time step is NaN!");
if (idrive == 0) { /* driven turbulence */
/* Integration has already been done, but time not yet updated */
newtime = pGrid->time + pGrid->dt;
#ifndef IMPULSIVE_DRIVING
/* Drive on every time step */
perturb(pGrid, pGrid->dt);
#endif /* IMPULSIVE_DRIVING */
if (newtime >= (tdrive+dtdrive)) {
/* If we start with large time steps so that tdrive would get way
* behind newtime, this makes sure we don't keep generating after
* dropping down to smaller time steps */
while ((tdrive+dtdrive) <= newtime) tdrive += dtdrive;
#ifdef IMPULSIVE_DRIVING
/* Only drive at intervals of dtdrive */
perturb(pGrid, dtdrive);
#endif /* IMPULSIVE_DRIVING */
/* Compute new spectrum after dtdrive. Putting this after perturb()
* means we won't be applying perturbations from a new power spectrum
* just before writing outputs. At the very beginning, we'll go a
* little longer before regenerating, but the energy injection rate
* was off on the very first timestep anyway. When studying driven
* turbulence, all we care about is the saturated state. */
generate();
}
}
}
}
}
return;
}
/**==============================================================================
* Copy grid from CPU host memory to prepared GPU grid (also host memory).
* It will copy U, and B1i, B2i, B3i from host memeory to device
*/
void copy_to_gpu_mem(Grid_gpu *pG_gpu, Grid *pG) {
cudaError_t code;
int i, Nx2T, Nx1T;
/* Calculate physical size of grid */
if (pG->Nx2 > 1)
Nx2T = pG->Nx2 + 2*nghost;
else
Nx2T = 1;
if (pG->Nx1 > 1)
Nx1T = pG->Nx1 + 2*nghost;
else
Nx1T = 1;
/* Start copying rows of gas variables from host to device memory */
for(i=0; i<Nx2T; i++) {
code = cudaMemcpy(pG_gpu->U+i*Nx1T+nghost, pG->U[i], sizeof(Gas)*(Nx1T-nghost), cudaMemcpyHostToDevice);
if(code != cudaSuccess) {
ath_error("[copy_to_gpu_mem U] error: %s\n", cudaGetErrorString(code));
}
code = cudaMemcpy(pG_gpu->B1i+i*Nx1T+nghost, pG->B1i[i], sizeof(Real)*(Nx1T-nghost), cudaMemcpyHostToDevice);
if(code != cudaSuccess) {
ath_error("[copy_to_gpu_mem B1i] error: %s\n", cudaGetErrorString(code));
}
code = cudaMemcpy(pG_gpu->B2i+i*Nx1T+nghost, pG->B2i[i], sizeof(Real)*(Nx1T-nghost), cudaMemcpyHostToDevice);
if(code != cudaSuccess) {
ath_error("[copy_to_gpu_mem B2i] error: %s\n", cudaGetErrorString(code));
}
code = cudaMemcpy(pG_gpu->B3i+i*Nx1T+nghost, pG->B3i[i], sizeof(Real)*(Nx1T-nghost), cudaMemcpyHostToDevice);
if(code != cudaSuccess) {
ath_error("[copy_to_gpu_mem B3i] error: %s\n", cudaGetErrorString(code));
}
}
}
/*! \fn void integrate_init_2d(MeshS *pM)
* \brief Allocate temporary integration arrays
*/
void integrate_init_2d(MeshS *pM)
{
int nmax,size1=0,size2=0,size3=0,nl,nd;
/* Cycle over all Grids on this processor to find maximum Nx1, Nx2, Nx3 */
for (nl=0; nl<(pM->NLevels); nl++){
for (nd=0; nd<(pM->DomainsPerLevel[nl]); nd++){
if (pM->Domain[nl][nd].Grid != NULL) {
if (pM->Domain[nl][nd].Grid->Nx[0] > size1){
size1 = pM->Domain[nl][nd].Grid->Nx[0];
}
if (pM->Domain[nl][nd].Grid->Nx[1] > size2){
size2 = pM->Domain[nl][nd].Grid->Nx[1];
}
if (pM->Domain[nl][nd].Grid->Nx[2] > size3){
size3 = pM->Domain[nl][nd].Grid->Nx[2];
}
}
}
}
size1 = size1 + 2*nghost;
size2 = size2 + 2*nghost;
size3 = size3 + 2*nghost;
nmax = MAX((MAX(size1,size2)),size3);
/*refer to material integrate_2d_ctu.c*/
if ((Bxc = (Real*)malloc(nmax*sizeof(Real))) == NULL) goto on_error;
if ((Bxi = (Real*)malloc(nmax*sizeof(Real))) == NULL) goto on_error;
if ((U1d= (Cons1DS*)malloc(nmax*sizeof(Cons1DS))) == NULL) goto on_error;
if ((W = (Prim1DS*)malloc(nmax*sizeof(Prim1DS))) == NULL) goto on_error;
if ((x1Flux =(Cons1DS**)calloc_2d_array(size2,size1,sizeof(Cons1DS)))==NULL)
goto on_error;
if ((x2Flux =(Cons1DS**)calloc_2d_array(size2,size1,sizeof(Cons1DS)))==NULL)
goto on_error;
return;
on_error:
integrate_destruct();
ath_error("[integrate_init]: malloc returned a NULL pointer\n");
}
void get_myGridIndex(DomainS *pD, const int myID,
int *pi, int *pj, int *pk)
{
int i, j, k;
for (k=0; k<(pD->NGrid[2]); k++){
for (j=0; j<(pD->NGrid[1]); j++){
for (i=0; i<(pD->NGrid[0]); i++){
if (pD->GData[k][j][i].ID_Comm_world == myID) {
*pi = i; *pj = j; *pk = k;
return;
}
}
}
}
ath_error("[get_myGridIndex]: Can't find ID=%i in GData\n", myID);
}
Real qsimp(Real (*func)(Real), const Real a, const Real b)
{
int j;
Real s,st,ost,os;
ost = os = -1.0e30;
for (j=1; j<=JMAX; j++) {
st = trapzd(func,a,b,j,ost);
s = (4.0*st-ost)/3.0; /* EQUIVALENT TO SIMPSON'S RULE */
if (j > 5) /* AVOID SPURIOUS EARLY CONVERGENCE. */
if (fabs(s-os) < EPS*fabs(os) || (s == 0.0 && os == 0.0)) return s;
os=s;
ost=st;
}
ath_error("[qsimp]: Too many steps!\n");
return 0.0;
}
/*! \fn void integrate_init_1d(MeshS *pM)
* \brief Allocate temporary integration arrays */
void integrate_init_1d(MeshS *pM)
{
int size1=0,nl,nd;
/* Cycle over all Grids on this processor to find maximum Nx1 */
for (nl=0; nl<(pM->NLevels); nl++){
for (nd=0; nd<(pM->DomainsPerLevel[nl]); nd++){
if (pM->Domain[nl][nd].Grid != NULL) {
if (pM->Domain[nl][nd].Grid->Nx[0] > size1){
size1 = pM->Domain[nl][nd].Grid->Nx[0];
}
}
}
}
size1 = size1 + 2*nghost;
if ((Wl_x1Face=(Prim1DS*)malloc(size1*sizeof(Prim1DS))) ==NULL) goto on_error;
if ((Wr_x1Face=(Prim1DS*)malloc(size1*sizeof(Prim1DS))) ==NULL) goto on_error;
if ((x1Flux =(Cons1DS*)malloc(size1*sizeof(Cons1DS))) ==NULL) goto on_error;
if ((Bxc = (Real*)malloc(size1*sizeof(Real))) == NULL) goto on_error;
if ((Bxi = (Real*)malloc(size1*sizeof(Real))) == NULL) goto on_error;
if ((U1d= (Cons1DS*)malloc(size1*sizeof(Cons1DS))) == NULL) goto on_error;
if ((Ul = (Cons1DS*)malloc(size1*sizeof(Cons1DS))) == NULL) goto on_error;
if ((Ur = (Cons1DS*)malloc(size1*sizeof(Cons1DS))) == NULL) goto on_error;
if ((W = (Prim1DS*)malloc(size1*sizeof(Prim1DS))) == NULL) goto on_error;
if ((Wl = (Prim1DS*)malloc(size1*sizeof(Prim1DS))) == NULL) goto on_error;
if ((Wr = (Prim1DS*)malloc(size1*sizeof(Prim1DS))) == NULL) goto on_error;
if ((Uhalf = (ConsS*)malloc(size1*sizeof(ConsS)))==NULL) goto on_error;
return;
on_error:
integrate_destruct();
ath_error("[integrate_init]: malloc returned a NULL pointer\n");
}
struct ath_2d_fft_plan *ath_2d_fft_quick_plan(DomainS *pD,
ath_fft_data *data, ath_fft_direction dir)
{
GridS *pGrid=(pD->Grid);
if (pGrid->Nx[2] != 1) {
ath_error("ath_2d_fft_quick_plan only works for Nx3=1.\n");
}
/* Get size of global FFT grid */
int gnx1 = pD->Nx[0];
int gnx2 = pD->Nx[1];
/* Get extents of local FFT grid in global coordinates */
/* These should be calculate from the origin of its Domain not root Domain */
int gis = pGrid->Disp[0]-pD->Disp[0];
int gie = pGrid->Disp[0]-pD->Disp[0] + pGrid->Nx[0] - 1;
int gjs = pGrid->Disp[1]-pD->Disp[1];
int gje = pGrid->Disp[1]-pD->Disp[1] + pGrid->Nx[1] - 1;
/* Create the plan using a more generic function
* If the data hasn't already been allocated, it will now */
return ath_2d_fft_create_plan(pD, gnx2, gnx1, gjs, gje, gis, gie, data, 0, dir);
}
void fluxes(const Cons1DS Ul, const Cons1DS Ur,
const Prim1DS Wl, const Prim1DS Wr,
const Real Bxi, Cons1DS *pF)
{
Real pc, fr, fl;
Real dc, dcl, dcr, Vxc;
Real sl, sr; /* Left and right going shock velocity */
Real hdl, hdr; /* Left and right going rarefaction head velocity */
Real tll, tlr; /* Left and right going rarefaction tail velocity */
Real al = sqrt((double) Gamma*Wl.P/Wl.d); /* left sound speed */
Real ar = sqrt((double) Gamma*Wr.P/Wr.d); /* right sound speed */
Real tmp1, tmp2;
Real e, V, E;
if(!(Ul.d > 0.0)||!(Ur.d > 0.0))
ath_error("[exact flux]: Non-positive densities: dl = %e dr = %e\n",
Ul.d, Ur.d);
pc = getPC(Wl, Wr);
/*----------------------------------------------------------------*/
/* calculate Vxc */
fr = PFunc(Wr, pc);
fl = PFunc(Wl, pc);
Vxc = 0.5*(Wl.Vx + Wr.Vx) + 0.5*(fr - fl);
/*-----------------------------------------------------------------*/
/* calucate density to left of contact (dcl) */
if (pc > Wl.P) {
/* left shock wave */
Real tmp = (Gamma - 1.0) / (Gamma + 1.0);
dcl = Wl.d*(pc/Wl.P + tmp)/(tmp*pc/Wl.P + 1);
}
else {
/* left rarefaction wave */
dcl = Wl.d*pow((double) (pc/Wl.P), (double) (1/Gamma));
}
if (dcl < 0.0)
ath_error("[exact flux]: Solver finds negative density %5.4e\n", dcl);
/*-----------------------------------------------------------------*/
/* calculate density to the right of contact (dcr) */
if (pc > Wr.P) {
/* right shock wave */
Real tmp = (Gamma - 1)/(Gamma + 1);
dcr = Wr.d*(pc/Wr.P + tmp)/(tmp*pc/Wr.P + 1);
}
else {
/* right rarefaction wave */
dcr = Wr.d*pow((double) (pc/Wr.P), (double) (1/Gamma));
}
if (dcr < 0.0)
ath_error("[exact flux]: Solver finds negative density %5.4e\n", dcr);
/*-----------------------------------------------------------------
* Calculate the Interface Flux if the wave speeds are such that we aren't
* actually in the intermediate state */
if (pc > Wl.P) {
/* left shock wave */
/* left shock speed */
sl = Wl.Vx - al*sqrt((double)(pc*(Gamma+1)/(2*Gamma*Wl.P) +
(Gamma-1)/(2*Gamma)));
if (sl >= 0.0) {
/* to left of shock */
e = Wl.P/(Wl.d*(Gamma-1));
V = Wl.Vx*Wl.Vx + Wl.Vy*Wl.Vy + Wl.Vz*Wl.Vz;
E = Wl.d*(0.5*V + e);
pF->E = Wl.Vx*(E + Wl.P);
pF->d = Ul.Mx;
pF->Mx = Ul.Mx*(Wl.Vx) + Wl.P;
pF->My = Ul.My*(Wl.Vx);
pF->Mz = Ul.Mz*(Wl.Vx);
return;
}
}
else {
/* left rarefaction */
Real alc = al*pow((double)(pc/Wl.P), (double)(Gamma-1)/(2*Gamma));
hdl = Wl.Vx - al;
tll = Vxc - alc;
if (hdl >= 0.0) {
/* To left of rarefaction */
e = Wl.P/(Wl.d*(Gamma-1));
V = Wl.Vx*Wl.Vx + Wl.Vy*Wl.Vy + Wl.Vz*Wl.Vz;
E = Wl.d*(0.5*V + e);
pF->E = Wl.Vx*(E + Wl.P);
pF->d = Ul.Mx;
pF->Mx = Ul.Mx*(Wl.Vx) + Wl.P;
pF->My = Ul.My*(Wl.Vx);
pF->Mz = Ul.Mz*(Wl.Vx);
return;
}
else if (tll >= 0.0) {
/* Inside rarefaction fan */
tmp1 = 2/(Gamma + 1);
tmp2 = (Gamma - 1)/(al*(Gamma+1));
dc = Wl.d*pow((double)(tmp1 + tmp2*Wl.Vx), (double)(2/(Gamma-1)));
Vxc = tmp1*(al + Wl.Vx*(Gamma-1)/2);
pc = Wl.P*pow((double)(tmp1+tmp2*Wl.Vx),(double)(2*Gamma/(Gamma-1)));
e = pc/(dc*(Gamma-1));
V = Vxc*Vxc + Wl.Vy*Wl.Vy + Wl.Vz*Wl.Vz;
E = dc*(0.5*V + e);
pF->E = Vxc*(E + pc);
pF->d = dc*Vxc;
pF->Mx = dc*Vxc*Vxc + pc;
pF->My = dc*Vxc*Wl.Vy;
pF->Mz = dc*Vxc*Wl.Vz;
return;
}
}
if (pc > Wr.P) {
/* right shock wave */
/* right shock speed */
sr = Wr.Vx + ar*sqrt((double)(pc*(Gamma+1)/(2*Gamma*Wr.P) +
(Gamma-1)/(2*Gamma)));
if (sr <= 0.0) {
/* to right of shock */
e = Wr.P/(Wr.d*(Gamma-1));
V = Wr.Vx*Wr.Vx + Wr.Vy*Wr.Vy + Wr.Vz*Wr.Vz;
E = Wr.d*(0.5*V + e);
pF->E = Wr.Vx*(E + Wr.P);
pF->d = Ur.Mx;
pF->Mx = Ur.Mx*(Wr.Vx) + Wr.P;
pF->My = Ur.My*(Wr.Vx);
pF->Mz = Ur.Mz*(Wr.Vx);
return;
}
}
else {
/* right rarefaction */
Real arc = ar*pow((double)(pc/Wr.P), (double)(Gamma-1)/(2*Gamma));
hdr = Wr.Vx + ar;
tlr = Vxc + arc;
if (hdr <= 0.0) {
/* To right of rarefaction */
e = Wr.P/(Wr.d*(Gamma-1));
V = Wr.Vx*Wr.Vx + Wr.Vy*Wr.Vy + Wr.Vz*Wr.Vz;
E = Wr.d*(0.5*V + e);
pF->E = Wr.Vx*(E + Wr.P);
pF->d = Ur.Mx;
pF->Mx = Ur.Mx*(Wr.Vx) + Wr.P;
pF->My = Ur.My*(Wr.Vx);
pF->Mz = Ur.Mz*(Wr.Vx);
return;
} else if (tlr <= 0.0) {
/* Inside rarefaction fan */
tmp1 = 2/(Gamma + 1);
tmp2 = (Gamma - 1)/(ar*(Gamma+1));
dc = Wr.d*pow((double)(tmp1 - tmp2*Wr.Vx), (double)(2/(Gamma-1)));
Vxc = tmp1*(-ar + Wr.Vx*(Gamma-1)/2);
pc = Wr.P*pow((double)(tmp1-tmp2*Wr.Vx), (double)(2*Gamma/(Gamma-1)));
e = pc/(dc*(Gamma-1));
V = Vxc*Vxc + Wr.Vy*Wr.Vy + Wr.Vz*Wr.Vz;
E = dc*(0.5*V + e);
pF->E = Vxc*(E + pc);
pF->d = dc*Vxc;
pF->Mx = dc*Vxc*Vxc + pc;
pF->My = dc*Vxc*Wr.Vy;
pF->Mz = dc*Vxc*Wr.Vz;
return;
}
}
/* We are in the intermediate state */
/*---------------------------------------------------------------------
* Calculate the Interface Flux */
if (Vxc >= 0.0) {
e = pc/(dcl*(Gamma-1));
V = Vxc*Vxc + Wl.Vy*Wl.Vy + Wl.Vz*Wl.Vz;
E = dcl*(0.5*V + e);
pF->E = Vxc*(E + pc);
pF->d = dcl*Vxc;
pF->Mx = dcl*Vxc*Vxc + pc;
pF->My = dcl*Vxc*Wl.Vy;
pF->Mz = dcl*Vxc*Wl.Vz;
}
else {
e = pc/(dcr*(Gamma-1));
V = Vxc*Vxc + Wr.Vy*Wr.Vy + Wr.Vz*Wr.Vz;
E = dcr*(0.5*V + e);
pF->E = Vxc*(E + pc);
pF->d = dcr*Vxc;
pF->Mx = dcr*Vxc*Vxc + pc;
pF->My = dcr*Vxc*Wr.Vy;
pF->Mz = dcr*Vxc*Wr.Vz;
}
return;
}
/*! \fn static void flux_output_func(MeshS *pM, OutputS *pOut)
* \brief New output format which outputs y-integrated angular momentum fluxes
* Currently can only be used with 1 proc and 1 domain.
*/
static void flux_output_func(MeshS *pM, OutputS *pOut)
{
GridS *pG=pM->Domain[0][0].Grid;
int nx1,nx2,nx3, ind, i,j,k, ind_i,ind_k;
Real lx1, lx2, lx3;
PrimS W[7],Ws[7],We[7];
Real x1[7],x2[7],x3[7],xs1[7],xs2[7],xs3[7],xe1[7],xe2[7],xe3[7];
Real dmin, dmax;
Real **Fluxx=NULL;
Real **FluxH=NULL;
Real **FluxNu=NULL;
Real **Th=NULL;
Real **outCoordsx1=NULL;
Real **outCoordsx3=NULL;
Real **vx=NULL;
Real **vy=NULL;
Real **sigvx=NULL;
Real **osigx=NULL;
Real **davg=NULL;
FILE *pfile;
char *fname;
nx1 = pG->Nx[0]; nx3 = pG->Nx[2]; nx2 = pG->Nx[1];
lx1 = pG->MaxX[0] - pG->MinX[0];
lx2 = pG->MaxX[1] - pG->MinX[1];
lx3 = pG->MaxX[2] - pG->MinX[2];
printf("%d, %d, %d, %g, %g, %g\n",nx1,nx2,nx3,lx1,lx2,lx3);
#ifdef MPI_PARALLEL
printf("%d, %d, %d, %g, %g, %g \n", myID_Comm_world,nx1,nx3,lx1,lx2,lx3);
printf("IND %d: (%d,%d), (%d,%d)\n",myID_Comm_world,pG->is,pG->js,pG->ie,pG->je);
#endif
Fluxx=(Real **)calloc_2d_array(nx3,nx1,sizeof(Real));
if (Fluxx == NULL) return;
FluxH=(Real **)calloc_2d_array(nx3,nx1,sizeof(Real));
if (FluxH == NULL) return;
FluxNu=(Real **)calloc_2d_array(nx3,nx1,sizeof(Real));
if (FluxNu == NULL) return;
Th=(Real **)calloc_2d_array(nx3,nx1,sizeof(Real));
if (Th == NULL) return;
outCoordsx1=(Real **)calloc_2d_array(nx3,nx1,sizeof(Real));
if (outCoordsx1 == NULL) return;
outCoordsx3=(Real **)calloc_2d_array(nx3,nx1,sizeof(Real));
if (outCoordsx3 == NULL) return;
vx=(Real **)calloc_2d_array(nx3,nx1,sizeof(Real));
if (vx == NULL) return;
vy=(Real **)calloc_2d_array(nx3,nx1,sizeof(Real));
if (vy == NULL) return;
sigvx=(Real **)calloc_2d_array(nx3,nx1,sizeof(Real));
if (sigvx == NULL) return;
osigx=(Real **)calloc_2d_array(nx3,nx1,sizeof(Real));
if (osigx == NULL) return;
davg=(Real **)calloc_2d_array(nx3,nx1,sizeof(Real));
if (davg == NULL) return;
/* Open file and write header */
if((fname = ath_fname(NULL,pM->outfilename,NULL,NULL,num_digit,
pOut->num,pOut->id,"tab")) == NULL){
ath_error("[dump_tab]: Error constructing filename\n");
}
if((pfile = fopen(fname,"w")) == NULL){
ath_error("[dump_tab]: Unable to open ppm file %s\n",fname);
}
free(fname);
#ifdef MPI_PARALLEL
if(myID_Comm_world == 0)
#endif
fprintf(pfile,"#t=%12.8e x,FH,Fx,Fnu,Th,vx,vy,davg,sigvx,omsigx \n", pOut->t);
/* Compute y-integrated fluxes explicitly.
* For the derivatives use a central difference method.
* For the integration use a composite trapezoid method.
* Both of these make use of the ghost cells for the boundary values.
* 1 FluxH = < d * vx1 *vx2 >
* 2 Fluxx = < 0.5 * omega * d * x1 * vx1 >
* 3 FluxNu = - < nu_iso * d/dx vx2 >
* 4 Th = - < d * d/dy phi >
* 5 vx = < vx1 >
* 6 vy = < vx2 >
* 7 davg = < d >
* 8 sigvx = < d * vx1 >
* 9 osigx = < 0.5 * sig * omega * x1 >
*
*
* x 4 x
* 1 0 2
* x 3 x
*
* The variables are stored up as arrays of primitives W[7].
* W = ( W[k][j][i], W[k][j][i-1], W[k][j][i+1], W[k][j-1][i],
* W[k][j+1][i], W[k-1][j][i], W[k+1][j][i] )
* This is needed for the integration and differentiation.
*
* The background shear is taken out of vy when doing computations.
*/
for(k=pG->ks; k <=pG->ke; k++) {
for(i=pG->is; i<= pG->ie; i++) {
ind_i=i-pG->is; ind_k=k-pG->ks;
for(ind=0; ind < 7; ind++) {
if (ind==0) {
cc_pos(pG,i,pG->js,k,&xs1[ind],&xs2[ind],&xs3[ind]);
cc_pos(pG,i,pG->je,k,&xe1[ind],&xe2[ind],&xe3[ind]);
Ws[ind] = Cons_to_Prim(&(pG->U[k][pG->js][i]));
We[ind] = Cons_to_Prim(&(pG->U[k][pG->je][i]));
}
if (ind > 0 && ind < 3) {
cc_pos(pG,i+2*ind-3,pG->js,k,&xs1[ind],&xs2[ind],&xs3[ind]);
cc_pos(pG,i+2*ind-3,pG->je,k,&xe1[ind],&xe2[ind],&xe3[ind]);
Ws[ind] = Cons_to_Prim(&(pG->U[k][pG->js][i+2*ind-3]));
We[ind] = Cons_to_Prim(&(pG->U[k][pG->je][i+2*ind-3]));
}
if (ind > 2 && ind < 5) {
cc_pos(pG,i,pG->js+2*ind-7,k,&xs1[ind],&xs2[ind],&xs3[ind]);
cc_pos(pG,i,pG->je+2*ind-7,k,&xe1[ind],&xe2[ind],&xe3[ind]);
Ws[ind] = Cons_to_Prim(&(pG->U[k][pG->js+2*ind-7][i]));
We[ind] = Cons_to_Prim(&(pG->U[k][pG->je+2*ind-7][i]));
}
if (ind > 4 && ind < 7) {
if (pG->MinX[2] == pG->MaxX[2]) {
cc_pos(pG,i,pG->js,k,&xs1[ind],&xs2[ind],&xs3[ind]);
cc_pos(pG,i,pG->je,k,&xe1[ind],&xe2[ind],&xe3[ind]);
Ws[ind] = Cons_to_Prim(&(pG->U[k][pG->js][i]));
We[ind] = Cons_to_Prim(&(pG->U[k][pG->je][i]));
}
else {
cc_pos(pG,i,pG->js,k+2*ind-11,&xs1[ind],&xs2[ind],&xs3[ind]);
cc_pos(pG,i,pG->je,k+2*ind-11,&xe1[ind],&xe2[ind],&xe3[ind]);
Ws[ind] = Cons_to_Prim(&(pG->U[k+2*ind-11][pG->js][i]));
We[ind] = Cons_to_Prim(&(pG->U[k+2*ind-11][pG->je][i]));
}
}
Ws[ind].V2 = Ws[ind].V2 + qshear*Omega_0*xs1[ind];
We[ind].V2 = We[ind].V2 + qshear*Omega_0*xe1[ind];
/* If using d' instead of d then put in
* W[ind] = W[ind]->d - d0;
*/
}
/* Set initial values for the integration */
FluxH[ind_k][ind_i] = 0.5*( Ws[0].d * Ws[0].V1 * Ws[0].V2 +
We[0].d * We[0].V1 * We[0].V2 );
Fluxx[ind_k][ind_i] = 0.5*( Ws[0].d * Ws[0].V1 * xs1[0] +
We[0].d * We[0].V1 * xe1[0] );
#ifdef VISCOSITY
FluxNu[ind_k][ind_i] = 0.5*( Ws[2].V2 - Ws[1].V2 +
We[2].V2 - We[1].V2 );
#else
FluxNu[ind_k][ind_i] = 0;
#endif
Th[ind_k][ind_i] = 0.5*( Ws[0].d * dx2PlanetPot(xs1[0],xs2[0],xs3[0]) +
We[0].d * dx2PlanetPot(xe1[0],xe2[0],xe3[0]) );
vx[ind_k][ind_i] = 0.5*( Ws[0].V1 + We[0].V1 );
vy[ind_k][ind_i] = 0.5*( Ws[0].V2 + We[0].V2 );
sigvx[ind_k][ind_i] = 0.5*( Ws[0].d * Ws[0].V1 + We[0].d * We[0].V1 );
osigx[ind_k][ind_i] = 0.5*( Ws[0].d * xs1[0] + We[0].d * xe1[0] );
davg[ind_k][ind_i] = 0.5*(Ws[0].d + We[0].d);
for(j=(pG->js)+1; j < pG->je; j++) {
for(ind=0; ind < 7; ind++) {
if (ind==0) {
cc_pos(pG,i,j,k,&x1[ind],&x2[ind],&x3[ind]);
W[ind] = Cons_to_Prim(&(pG->U[k][j][i]));
}
if (ind > 0 && ind < 3) {
cc_pos(pG,i+2*ind-3,j,k,&x1[ind],&x2[ind],&x3[ind]);
W[ind] = Cons_to_Prim(&(pG->U[k][j][i+2*ind-3]));
}
if (ind > 2 && ind < 5) {
cc_pos(pG,i,j+2*ind-7,k,&x1[ind],&x2[ind],&x3[ind]);
W[ind] = Cons_to_Prim(&(pG->U[k][j+2*ind-7][i]));
}
if (ind > 4 && ind < 7) {
if (pG->MinX[2] == pG->MaxX[2]) {
cc_pos(pG,i,j,k,&x1[ind],&x2[ind],&x3[ind]);
W[ind] = Cons_to_Prim(&(pG->U[k][j][i]));
}
else {
cc_pos(pG,i,j,k+2*ind-11,&x1[ind],&x2[ind],&x3[ind]);
W[ind] = Cons_to_Prim(&(pG->U[k+2*ind-11][j][i]));
}
}
W[ind].V2 = W[ind].V2 + qshear*Omega_0*x1[ind];
}
FluxH[ind_k][ind_i] += W[0].d * W[0].V1 * W[0].V2;
Fluxx[ind_k][ind_i] += W[0].d * W[0].V1 * x1[0];
#ifdef VISCOSITY
FluxNu[ind_k][ind_i] += W[0].d * (W[2].V2 - W[1].V1);
#endif
Th[ind_k][ind_i] += W[0].d * dx2PlanetPot(x1[0],x2[0],x3[0]);
vx[ind_k][ind_i] += W[0].V1;
vy[ind_k][ind_i] += W[0].V2;
sigvx[ind_k][ind_i] += W[0].d * W[0].V1;
osigx[ind_k][ind_i] += W[0].d * x1[0];
davg[ind_k][ind_i] += W[0].d;
}
FluxH[ind_k][ind_i] *= (pG->dx2)/lx2;
Fluxx[ind_k][ind_i] *= .5*Omega_0*(pG->dx2)/lx2;
#ifdef VISCOSITY
FluxNu[ind_k][ind_i] *= -nu_iso*(pG->dx2)/(2*lx2*(pG->dx1));
#endif
Th[ind_k][ind_i] *= -1.0*(pG->dx2)/lx2;
vx[ind_k][ind_i] *= (pG->dx2)/lx2;
vy[ind_k][ind_i] *= (pG->dx2)/lx2;
sigvx[ind_k][ind_i] *= (pG->dx2)/lx2;
osigx[ind_k][ind_i] *= (0.5*Omega_0*(pG->dx2))/lx2;
davg[ind_k][ind_i] *= (pG->dx2)/lx2;
outCoordsx1[ind_k][ind_i]=x1[0]; outCoordsx3[ind_k][ind_i]=x3[0];
}
}
/* Quantities are ready to be written to output file
* Format (Not outputting x3 at the moment:
* x1 (x3) FluxH Fluxx Fluxnu Th vx vy davg sigvx osigx
*/
for(k=pG->ks; k<=pG->ke; k++) {
for(i=pG->is; i<=pG->ie; i++) {
ind_k=k-pG->ks; ind_i=i-pG->is;
if (lx3==0) {
fprintf(pfile,"%12.8e %12.8e %12.8e %12.8e %12.8e %12.8e %12.8e %12.8e %12.8e %12.8e\n",
outCoordsx1[ind_k][ind_i],FluxH[ind_k][ind_i],
Fluxx[ind_k][ind_i],FluxNu[ind_k][ind_i],Th[ind_k][ind_i],
vx[ind_k][ind_i],vy[ind_k][ind_i],davg[ind_k][ind_i],sigvx[ind_k][ind_i],
osigx[ind_k][ind_i]);
}
else {
fprintf(pfile,"%12.8e %12.8e %12.8e %12.8e %12.8e %12.8e %12.8e %12.8e %12.8e %12.8e %12.8e\n",
outCoordsx1[ind_k][ind_i],outCoordsx3[ind_k][ind_i],FluxH[ind_k][ind_i],
Fluxx[ind_k][ind_i],FluxNu[ind_k][ind_i],Th[ind_k][ind_i],
vx[ind_k][ind_i],vy[ind_k][ind_i],davg[ind_k][ind_i],sigvx[ind_k][ind_i],
osigx[ind_k][ind_i]);
}
}
}
fclose(pfile);
free_2d_array(Fluxx);
free_2d_array(FluxH);
free_2d_array(FluxNu);
free_2d_array(Th);
free_2d_array(outCoordsx1);
free_2d_array(outCoordsx3);
free_2d_array(vx);
free_2d_array(vy);
free_2d_array(sigvx);
free_2d_array(osigx);
free_2d_array(davg);
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 fluxes(const Cons1DS Ul, const Cons1DS Ur,
const Prim1DS Wl, const Prim1DS Wr,
const Real Bxi, Cons1DS *pF)
{
Real zl, zr, zm, dm, Vxm, Mxm, tmp, dmin, dmax;
Real sl, sr; /* Left and right going shock velocity */
Real hdl, hdr; /* Left and right going rarefaction head velocity */
Real tll, tlr; /* Left and right going rarefaction tail velocity */
char soln; /* two bits: 0=shock, 1=raref */
if(!(Ul.d > 0.0)||!(Ur.d > 0.0))
ath_error("[exact flux]: Non-positive densities: dl = %e dr = %e\n",
Ul.d, Ur.d);
/*--- Step 1. ------------------------------------------------------------------
* Compute the density and momentum of the intermediate state
*/
zl = sqrt((double)Wl.d);
zr = sqrt((double)Wr.d);
/* --- 1-shock and 2-shock --- */
soln = 0;
/* Start by finding density if shocks on both left and right.
* This will only be the case if dm > Wl.d and dm > Wr.d */
tmp = zl*zr*(Wl.Vx - Wr.Vx)/(2.0*Iso_csound*(zl + zr));
zm = tmp + sqrt((double)(tmp*tmp + zl*zr));
dm = zm*zm;
/* Get velocity from 1-shock formula */
Vxm = Wl.Vx - Iso_csound*(dm-Wl.d)/(zm*zl);
/* If left or right density is greater than intermediate density,
* then at least one side has rarefaction instead of shock */
dmin = MIN(Wl.d, Wr.d);
dmax = MAX(Wl.d, Wr.d);
if (dm < dmax) {
/* --- 1-rarefaction and 2-rarefaction --- */
soln = 3;
/* Try rarefactions on both left and right, since it's a quicker
* calculation than 1-shock+2-raref or 1-raref+2-shock */
dm = zl*zr*exp((Wl.Vx-Wr.Vx)/(2.0*Iso_csound));
/* Get velocity from 1-rarefaction formula */
Vxm = Wl.Vx - Iso_csound*log(dm/Wl.d);
/* If left or right density is smaller than intermediate density,
* then we must instead have a combination of shock and rarefaction */
if (dm > dmin) {
/* --- EITHER 1-rarefaction and 2-shock ---
* --- OR 1-shock and 2-rarefaction --- */
/* Solve iteratively equation for shock and rarefaction
* If Wl.d > Wr.d ==> 1-rarefaction and 2-shock
* If Wr.d > Wl.d ==> 1-shock and 2-rarefaction */
if (Wl.d > Wr.d) soln = 2; else soln = 1;
dm = rtsafe(&srder,dmin,dmax, 2.0*DBL_EPSILON, Wl.Vx, Wr.Vx, dmin, dmax);
/* Don't be foolish enough to take ln of zero */
if ((dm > dmin) && (dm <= dmax)) {
if (Wl.d > Wr.d) {
/* Get velocity from 1-rarefaction formula */
Vxm = Wl.Vx - Iso_csound*log(dm/Wl.d);
} else {
/* Get velocity from 2-rarefaction formula */
Vxm = Wr.Vx + Iso_csound*log(dm/Wr.d);
}
} else {
/* --- DEFAULT 1-rarefaction and 2-rarefaction --- */
soln = 3;
/* In the event that the intermediate density fails to fall between
* the left and right densities (should only happen when left and
* right densities differ only slightly and intermediate density
* calculated in any step has significant truncation and/or roundoff
* errors), default to rarefactions on both left and right */
dm = zl*zr*exp((Wl.Vx-Wr.Vx)/(2.0*Iso_csound));
/* Get velocity from 1-rarefaction formula */
Vxm = Wl.Vx - Iso_csound*log(dm/Wl.d);
}
}
}
if (dm < 0.0)
ath_error("[exact flux]: Solver finds negative density %5.4e\n", dm);
/*--- Step 2. ------------------------------------------------------------------
* Calculate the Interface Flux if the wave speeds are such that we aren't
* actually in the intermediate state
*/
if (soln & 2) { /* left rarefaction */
/* The L-going rarefaction head/tail velocity */
hdl = Wl.Vx - Iso_csound;
tll = Vxm - Iso_csound;
if (hdl >= 0.0) {
/* To left of rarefaction */
pF->d = Ul.Mx;
pF->Mx = Ul.Mx*(Wl.Vx) + Wl.d*Iso_csound2;
pF->My = Ul.My*(Wl.Vx);
pF->Mz = Ul.Mz*(Wl.Vx);
return;
} else if (tll >= 0.0) {
/* Inside rarefaction fan */
dm = Ul.d*exp(hdl/Iso_csound);
Mxm = Ul.d*Iso_csound*exp(hdl/Iso_csound);
Vxm = (dm == 0.0 ? 0.0 : Mxm / dm);
pF->d = Mxm;
pF->Mx = Mxm*Vxm + dm*Iso_csound2;
pF->My = Mxm*Wl.Vy;
pF->Mz = Mxm*Wl.Vz;
return;
}
} else { /* left shock */
/* The L-going shock velocity */
sl = Wl.Vx - Iso_csound*sqrt(dm)/zl;
if(sl >= 0.0) {
/* To left of shock */
pF->d = Ul.Mx;
pF->Mx = Ul.Mx*(Wl.Vx) + Wl.d*Iso_csound2;
pF->My = Ul.My*(Wl.Vx);
pF->Mz = Ul.Mz*(Wl.Vx);
return;
}
}
if (soln & 1) { /* right rarefaction */
/* The R-going rarefaction head/tail velocity */
hdr = Wr.Vx + Iso_csound;
tlr = Vxm + Iso_csound;
if (hdr <= 0.0) {
/* To right of rarefaction */
pF->d = Ur.Mx;
pF->Mx = Ur.Mx*(Wr.Vx) + Wr.d*Iso_csound2;
pF->My = Ur.My*(Wr.Vx);
pF->Mz = Ur.Mz*(Wr.Vx);
return;
} else if (tlr <= 0.0) {
/* Inside rarefaction fan */
tmp = dm;
dm = tmp*exp(-tlr/Iso_csound);
Mxm = -tmp*Iso_csound*exp(-tlr/Iso_csound);
Vxm = (dm == 0.0 ? 0.0 : Mxm / dm);
pF->d = Mxm;
pF->Mx = Mxm*Vxm + dm*Iso_csound2;
pF->My = Mxm*Wr.Vy;
pF->Mz = Mxm*Wr.Vz;
return;
}
} else { /* right shock */
/* The R-going shock velocity */
sr = Wr.Vx + Iso_csound*sqrt(dm)/zr;
if(sr <= 0.0) {
/* To right of shock */
pF->d = Ur.Mx;
pF->Mx = Ur.Mx*(Wr.Vx) + Wr.d*Iso_csound2;
pF->My = Ur.My*(Wr.Vx);
pF->Mz = Ur.Mz*(Wr.Vx);
return;
}
}
/* If we make it this far, then we're in the intermediate state */
/*--- Step 3. ------------------------------------------------------------------
* Calculate the Interface Flux */
if(Vxm >= 0.0){
pF->d = dm*Vxm;
pF->Mx = dm*Vxm*Vxm + dm*Iso_csound2;
pF->My = dm*Vxm*Wl.Vy;
pF->Mz = dm*Vxm*Wl.Vz;
}
else{
pF->d = dm*Vxm;
pF->Mx = dm*Vxm*Vxm + dm*Iso_csound2;
pF->My = dm*Vxm*Wr.Vy;
pF->Mz = dm*Vxm*Wr.Vz;
}
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;
}
static void perturb(Grid *pGrid, Real dt)
{
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 ind, mpierr;
Real dvol, aa, b, c, s, de, qa, v1, v2, v3;
Real t0, t0ij, t0i, t1, t1ij, t1i;
Real t2, t2ij, t2i, t3, t3ij, t3i;
Real m[4], gm[4];
/* Set the velocities in real space */
dvol = 1.0/((Real)(gnx1*gnx2*gnx3));
for (k=ks; k<=ke; k++) {
for (j=js; j<=je; j++) {
for (i=is; i<=ie; i++) {
ind = OFST(i-is,j-js,k-ks);
dv1[k][j][i] = fv1[ind][0]*dvol;
dv2[k][j][i] = fv2[ind][0]*dvol;
dv3[k][j][i] = fv3[ind][0]*dvol;
}
}
}
/* Calculate net momentum pertubation components t1, t2, t3 */
t0 = 0.0; t1 = 0.0; t2 = 0.0; t3 = 0.0;
for (k=ks; k<=ke; k++) {
t0ij = 0.0; t1ij = 0.0; t2ij = 0.0; t3ij = 0.0;
for (j=js; j<=je; j++) {
t0i = 0.0; t1i = 0.0; t2i = 0.0; t3i = 0.0;
for (i=is; i<=ie; i++) {
t0i += pGrid->U[k][j][i].d;
/* The net momentum perturbation */
t1i += pGrid->U[k][j][i].d * dv1[k][j][i];
t2i += pGrid->U[k][j][i].d * dv2[k][j][i];
t3i += pGrid->U[k][j][i].d * dv3[k][j][i];
}
t0ij += t0i; t1ij += t1i; t2ij += t2i; t3ij += t3i;
}
t0 += t0ij; t1 += t1ij; t2 += t2ij; t3 += t3ij;
}
#ifdef MPI_PARALLEL
/* Sum the perturbations over all processors */
m[0] = t0; m[1] = t1; m[2] = t2; m[3] = t3;
mpierr = MPI_Allreduce(m, gm, 4, MPI_RL, MPI_SUM, MPI_COMM_WORLD);
if (mpierr) ath_error("[normalize]: MPI_Allreduce error = %d\n", mpierr);
t0 = gm[0]; t1 = gm[1]; t2 = gm[2]; t3 = gm[3];
#endif /* MPI_PARALLEL */
/* Subtract the mean velocity perturbation so that the net momentum
* perturbation is zero. */
for (k=ks; k<=ke; k++) {
for (j=js; j<=je; j++) {
for (i=is; i<=ie; i++) {
dv1[k][j][i] -= t1/t0;
dv2[k][j][i] -= t2/t0;
dv3[k][j][i] -= t3/t0;
}
}
}
/* Calculate unscaled energy of perturbations */
t1 = 0.0; t2 = 0.0;
for (k=ks; k<=ke; k++) {
t1ij = 0.0; t2ij = 0.0;
for (j=js; j<=je; j++) {
t1i = 0.0; t2i = 0.0;
for (i=is; i<=ie; i++) {
/* Calculate velocity pertubation at cell center from
* perturbations at cell faces */
v1 = dv1[k][j][i];
v2 = dv2[k][j][i];
v3 = dv3[k][j][i];
t1i += (pGrid->U[k][j][i].d)*(SQR(v1) + SQR(v2) + SQR(v3));
t2i += (pGrid->U[k][j][i].M1)*v1 + (pGrid->U[k][j][i].M2)*v2 +
(pGrid->U[k][j][i].M3)*v3;
}
t1ij += t1i; t2ij += t2i;
}
t1 += t1ij; t2 += t2ij;
}
#ifdef MPI_PARALLEL
/* Sum the perturbations over all processors */
m[0] = t1; m[1] = t2;
mpierr = MPI_Allreduce(m, gm, 2, MPI_RL, MPI_SUM, MPI_COMM_WORLD);
if (mpierr) ath_error("[normalize]: MPI_Allreduce error = %d\n", mpierr);
t1 = gm[0]; t2 = gm[1];
#endif /* MPI_PARALLEL */
/* Rescale to give the correct energy injection rate */
dvol = pGrid->dx1*pGrid->dx2*pGrid->dx3;
if (idrive == 0) {
/* driven turbulence */
de = dedt*dt;
} else {
/* decaying turbulence (all in one shot) */
de = dedt;
}
aa = 0.5*t1;
aa = MAX(aa,1.0e-20);
b = t2;
c = -de/dvol;
if(b >= 0.0)
s = (-2.0*c)/(b + sqrt(b*b - 4.0*aa*c));
else
s = (-b + sqrt(b*b - 4.0*aa*c))/(2.0*aa);
if (isnan(s)) ath_error("[perturb]: s is NaN!\n");
/* Apply momentum pertubations */
for (k=ks; k<=ke; k++) {
for (j=js; j<=je; j++) {
for (i=is; i<=ie; i++) {
qa = s*pGrid->U[k][j][i].d;
pGrid->U[k][j][i].M1 += qa*dv1[k][j][i];
pGrid->U[k][j][i].M2 += qa*dv2[k][j][i];
pGrid->U[k][j][i].M3 += qa*dv3[k][j][i];
}
}
}
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;
}
void Userwork_in_loop(MeshS *pM)
{
DomainS *pDomain = (DomainS*)&(pM->Domain[0][0]);
GridS *pGrid = pM->Domain[0][0].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 newtime;
Real qt,tdep,s_period,AA;
Real delta_x, delta_z, xxmax, yymax, xxmin, yymin;
Real exp_x,exp_y,exp_z,exp_xyz;
Real r1,r2,xp, yp,zp;
Real vvz;
Real x1,x2,x3;
Real xcz,xcx;
int n1,n2;
n1=0;
n2=0;
s_period=30.0; //Driver period
AA=350.0; //Driver amplitude
//AA=1;
xcz=0.5e6;
xcx=2.0e6;
delta_z=0.004e6;
delta_x=0.016e6;
if (isnan(pGrid->dt)) ath_error("Time step is NaN!");
qt=pGrid->time;
tdep=sin(qt*2.0*PI/s_period);
if (pM->Nx[2] == 1)
{
cc_pos(pGrid,ie,je,ke,&x1,&x2,&x3);
xxmax=x1;
yymax=x3;
cc_pos(pGrid,is,js,ks,&x1,&x2,&x3);
xxmax=xxmax-x1;
yymax=yymax-x3;
xxmin=x1;
yymin=x3;
}
/*printf("%d %d %d \n",is,js,ks);
printf("%d %d %d \n",ie,je,ke);
printf("%d %d %d \n", pGrid->Nx[0],pGrid->Nx[1], pGrid->Nx[2]);*/
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);
xp=x1-xxmin;
yp=x3-yymin;
zp=x2;
r2=(zp-xcz)*(zp-xcz);
r1=(xp-xcx)*(xp-xcx);
exp_y=exp(-r1/(delta_x*delta_x));
exp_z=exp(-r2/(delta_z*delta_z));
exp_xyz=sin(PI*xp*(n1+1)/xxmax)*exp_z;
//exp_xyz=exp_y*exp_z;
vvz=100*AA*exp_xyz*tdep;
vvz=0;
//if(j==12)
// printf("%d %d %d %f %f %f %f %f %f\n",i,j,k,xp,yp,zp,xcz,exp_y,exp_z);
//if(i>60 && i<68)
//if(i>is && i<ie)
//{
//if(j==12)
// printf("%d %d %d %g %g %g \n",i,j,k,vvz,(pGrid->dt),(pGrid->dt)*vvz*(pGrid->U[k][j][i].d));
pGrid->U[k][j][i].M2 += (pGrid->dt)*vvz*(pGrid->U[k][j][i].d);
pGrid->U[k][j][i].E += (pGrid->dt)*vvz*vvz*(pGrid->U[k][j][i].d)/2.0;
//}
}
//printf("\n");
}
}
}
//for 3D model
if (pM->Nx[2] > 1)
{
cc_pos(pGrid,ie,je,ke,&x1,&x2,&x3);
xxmax=x1;
yymax=x2;
cc_pos(pGrid,is,js,ks,&x1,&x2,&x3);
xxmax=xxmax-x1;
yymax=yymax-x2;
xxmin=x1;
yymin=x2;
}
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);
xp=x1-xxmin;
yp=x2-yymin;
zp=x3;
r2=(x3-xcz)*(x3-xcz);
exp_z=exp(-r2/(delta_z*delta_z));
exp_xyz=sin(PI*xp*(n1+1)/xxmax)*sin(PI*yp*(n2+1)/yymax)*exp_z;
vvz=AA*exp_xyz*tdep;
vvz=0;
pGrid->U[k][j][i].M3 += (pGrid->dt)*vvz*(pGrid->U[k][j][i].d);
pGrid->U[k][j][i].E += (pGrid->dt)*vvz*vvz*(pGrid->U[k][j][i].d)/2.0;
}
}
}
}
//newtime = pGrid->time + pGrid->dt;
return;
}
/* --------------------------------------------------------------
* Routine to compute photoionization rate from a plane radiation
* source.
* --------------------------------------------------------------
*/
void get_ph_rate_plane(Real initflux, int dir, Real ***ph_rate, DomainS *pDomain) {
GridS *pGrid = pDomain->Grid;
int lr, fixed;
Real tau, n_H, kph, etau, cell_len;
Real flux, flux_frac;
int i, j, k, ii;
int s, e;
#ifdef MPI_PARALLEL
int NGrid_x1, NGrid_x2, NGrid_x3;
int n, nGrid=0;
int myrank, nextproc, prevproc, err;
int planesize;
Real *planeflux = NULL;
Real max_flux_frac, max_flux_frac_glob;
MPI_Status stat;
int npg, ncg, arrsize;
MPI_Comm Comm_Domain = pDomain->Comm_Domain;
#endif
#ifdef STATIC_MESH_REFINEMENT
GridOvrlpS *pCO, *pPO;
#endif
MeshS *pMesh = pGrid->Mesh;
flux = 0;
/* Set lr based on whether radiation is left or right
propagating. lr = 1 is for radiation going left to right. Also
set up the start and end indices based on the direction, and
store the cell length. */
lr = (dir < 0) ? 1 : -1;
switch(dir) {
case -1: case 1: {
if (lr > 0) {
s=pGrid->is; e=pGrid->ie;
} else {
s=pGrid->ie; e=pGrid->is;
}
cell_len = pGrid->dx1;
break;
}
case -2: case 2: {
if (lr > 0) {
s=pGrid->js; e=pGrid->je;
} else {
s=pGrid->je; e=pGrid->js;
}
cell_len = pGrid->dx2;
break;
}
case -3: case 3: {
if (lr > 0) {
s=pGrid->ks; e=pGrid->ke;
} else {
s=pGrid->ke; e=pGrid->ks;
cell_len = pGrid->dx3;
}
break;
}
}
fixed = (lr > 0) ? 0 : e - nghost;
#ifdef MPI_PARALLEL
/* Figure out processor geometry: where am I, where are my neighbors
upstream and downstream, how many processors are there in the
direction of radiation propagation, how big is the interface with
my neighbor? */
NGrid_x1 = pDomain->NGrid[0];
NGrid_x2 = pDomain->NGrid[1];
NGrid_x3 = pDomain->NGrid[2];
for (k=0; k<NGrid_x3; k++) {
for (j=0; j<NGrid_x2; j++) {
for (i=0; i<NGrid_x1; i++) {
if (pDomain->GData[k][j][i].ID_Comm_world == myID_Comm_world) {
switch(dir) {
case -1: case 1: {
nGrid=NGrid_x1;
myrank = lr > 0 ? i : nGrid - i - 1;
planesize=pGrid->Nx[1]*pGrid->Nx[2];
if ((i-lr >= 0) && (i-lr <= NGrid_x1-1))
prevproc = pDomain->GData[k][j][i-lr].ID_Comm_world;
else
prevproc = -1;
if ((i+lr >= 0) && (i+lr <= NGrid_x1-1))
nextproc = pDomain->GData[k][j][i+lr].ID_Comm_world;
else
nextproc = -1;
break;
}
case -2: case 2: {
nGrid=NGrid_x2;
myrank = lr > 0 ? j : nGrid - j - 1;
planesize=pGrid->Nx[0]*pGrid->Nx[1];
if ((j-lr >= 0) && (j-lr <= NGrid_x2-1))
prevproc = pDomain->GData[k][j-lr][i].ID_Comm_world;
else
prevproc = -1;
if ((j+lr >= 0) && (j+lr <= NGrid_x2-1))
nextproc = pDomain->GData[k][j+lr][i].ID_Comm_world;
else
nextproc = -1;
break;
}
case -3: case 3: {
nGrid=NGrid_x3;
myrank = lr > 0 ? k : nGrid - k - 1;
planesize=pGrid->Nx[0]*pGrid->Nx[1];
if ((k-lr >= 0) && (k-lr <= NGrid_x3-1))
prevproc = pDomain->GData[k-lr][j][i].ID_Comm_world;
else
prevproc = -1;
if ((k+lr >= 0) && (k+lr <= NGrid_x2-1))
nextproc = pDomain->GData[k+lr][j][i].ID_Comm_world;
else
nextproc = -1;
break;
}
default:
ath_error("[get_ph_rate_plane]: dir must be +-1, 2, or 3\n");
}
}
}
if (nGrid != 0) break;
}
if (nGrid != 0) break;
}
/* AT 9/26/12: Make sure that the grids at the upsetram edge have received their data from the coarse grid. */
/* Also ADD IN a non-MPI receive for SMR only - A.t. 9/14/12*/
/* Allocate memory for flux at interface on first pass */
if (!(planeflux=calloc(planesize, sizeof(Real))))
ath_error("[get_ph_rate_plane]: calloc returned a null pointer!\n");
/* Loop over processors in the direction of propagation */
for (n=0; n<nGrid; n++) {
/* Set to 0 flux fraction remaining to start */
max_flux_frac = 0.0;
/* Am I the rank before the current one? If so, pass the flux on
to the next processor. */
if (myrank == n-1) {
err = MPI_Send(planeflux, planesize, MP_RL, nextproc, n,
MPI_COMM_WORLD);
if (err) ath_error("[get_ph_rate_plane]: MPI_Send error = %d\n", err);
}
/* Is it my turn to compute the transfer now? */
if (myrank == n) {
/* If I am not the first processor, get the flux from the
previous one */
if (prevproc != -1) {
err = MPI_Recv(planeflux, planesize, MP_RL, prevproc, n,
MPI_COMM_WORLD, &stat);
if (err) ath_error("[get_ph_rate_plane]: MPI_Send error = %d\n", err);
}
#endif /* MPI_PARALLEL */
/* Propagate the radiation */
switch(dir) {
case -1: case 1: {
for (k=pGrid->ks; k<=pGrid->ke; k++) {
for (j=pGrid->js; j<=pGrid->je; j++) {
#ifdef MPI_PARALLEL
/* Get initial flux from passed information or boundary
conditions */
if (prevproc != -1)
flux = planeflux[(k-pGrid->ks)*pGrid->Nx[1]+j-pGrid->js];
else
#endif /* MPI_PARALLEL */
if (pDomain->Level == 0){
/* if (pMesh->time <= 9e4) { */
flux = (pMesh->radplanelist)->flux_i*(5.*(erf((pMesh->time - 1.2e5)/8e4)+1)+0.1);
/* log1p(pMesh->time) / log1p(9e4); */
/* } else { */
/* flux = (pMesh->radplanelist)->flux_i; */
/* } */
} else {
flux = pGrid->EdgeFlux[k-pGrid->ks][j-pGrid->js][fixed];
}
/* if (pDomain->Level >0 && flux > 1) */
/* fprintf(stderr,"Level: %d Input: k: %d j: %d, i:%d Here: %e Mesh: %e\n",pDomain->Level, k-pGrid->ks, j-pGrid->js, fixed, flux, (pMesh->radplanelist)->flux_i); */
/* fprintf(stderr,"Input: k: %d j: %d, i:0 Here: %e Mesh: %e\n",k-pGrid->ks, j-pGrid->js, flux, (pMesh->radplanelist)->flux_i); */
for (i=s; i<=e; i+=lr) {
pGrid->EdgeFlux[k-pGrid->ks][j-pGrid->js][i-s] = flux;
/* fprintf(stderr,"Setting pGrid->EdgeFlux[%d][%d][%d - %d] to %f \n", k-pGrid->ks, j-pGrid->js, i, s, flux); */
n_H = pGrid->U[k][j][i].s[0] / m_H;
/* fprintf(stderr, "I am %d My flux at k: %d j: %d i: %d is %f \n", myID_Comm_world, k-pGrid->ks, j-pGrid->js, i-pGrid->is, pGrid->EdgeFlux[k-pGrid->ks][j-pGrid->js][i-s]); */
/* if (pGrid->Nx[0] != 64){ */
/* if ((j<pGrid->js+1) && (k<pGrid->ks+1) && (i<s+2)) { */
/* /\* fprintf(stderr, "Fine - Time: %e .... i: %d, j:%d, k:%d ..... nh: %e, flux:%e \n", pMesh->time, i-s, j-pGrid->js,k-pGrid->ks, n_H ,pGrid->EdgeFlux[k-pGrid->ks][j-pGrid->js][i-s]); *\/ */
/* } */
/* } else{ */
/* if ((j<pGrid->js+1) && (k<pGrid->ks+1) && (i<s+2)) { */
/* /\* fprintf(stderr, "Coarse - Time: %e .... i: %d, j:%d, k:%d ..... nh: %e, Flux: %e \n", pMesh->time, i-s, j-pGrid->js,k-pGrid->ks, n_H,pGrid->EdgeFlux[k-pGrid->ks][j-pGrid->js][i-s]); *\/ */
/* } */
/* } */
tau = sigma_ph * n_H * pGrid->dx1;
etau = exp(-tau);
kph = flux * (1.0-etau) / (n_H*cell_len);
ph_rate[k][j][i] += kph;
flux *= etau;
flux_frac = flux / (pGrid->EdgeFlux[k-pGrid->ks][j-pGrid->js][fixed] +1e-12); /*Check if this should still be 0 or not*/
if (flux_frac < MINFLUXFRAC){
/*AT 1/15/13: Should this really not be here??*/
for (ii=i; ii<=e; ii+=lr) {
pGrid->EdgeFlux[k-pGrid->ks][j-pGrid->js][ii-s+1] = 0.0;
}
break;
}
}
pGrid->EdgeFlux[k-pGrid->ks][j-pGrid->js][e-s+1] = flux_frac < MINFLUXFRAC ? 0.0 : flux; /*Account for flux at rightmost edge*/
#ifdef MPI_PARALLEL
/* Store final flux to pass to next processor, or 0 if we
ended the loop early because we were below the minimum
fraction. */
planeflux[(k-pGrid->ks)*pGrid->Nx[1]+j-pGrid->js] = flux_frac < MINFLUXFRAC ? 0.0 : flux;
/* fprintf("j:%d, k:%d, Planeflux %f \n", j, k, planeflux[(k-pGrid->ks)*pGrid->Nx[1]+j-pGrid->js]);
*/
max_flux_frac = (flux_frac > max_flux_frac) ? flux_frac : max_flux_frac;
#endif /* MPI_PARALLEL */
}
}
break;
}
case -2: case 2: {
for (k=pGrid->ks; k<=pGrid->ke; k++) {
for (i=pGrid->is; i<=pGrid->ie; i++) {
#ifdef MPI_PARALLEL
/* Get initial flux from passed information or boundary
conditions */
if (prevproc != -1)
flux = planeflux[(k-pGrid->ks)*pGrid->Nx[0]+i-pGrid->is];
else
#endif /* MPI_PARALLEL */
flux = initflux;
for (j=s; j<=e; j+=lr) {
pGrid->EdgeFlux[k-pGrid->ks][j-s][i-pGrid->is] = flux;
n_H = pGrid->U[k][j][i].s[0] / m_H;
tau = sigma_ph * n_H * pGrid->dx1;
etau = exp(-tau);
kph = flux * (1.0-etau) / (n_H*cell_len);
ph_rate[k][j][i] += kph;
flux *= etau;
flux_frac = flux / initflux;
if (flux_frac < MINFLUXFRAC) break;
}
#ifdef MPI_PARALLEL
/* Store final flux to pass to next processor */
planeflux[(k-pGrid->ks)*pGrid->Nx[0]+i-pGrid->is] =
flux_frac < MINFLUXFRAC ? 0.0 : flux;
max_flux_frac = (flux_frac > max_flux_frac) ?
flux_frac : max_flux_frac;
#endif /* MPI_PARALLEL */
}
}
break;
}
case -3: case 3: {
for (j=pGrid->js; j<=pGrid->je; j++) {
for (i=pGrid->is; i<=pGrid->ie; i++) {
#ifdef MPI_PARALLEL
/* Get initial flux from passed information or boundary
conditions */
if (prevproc != -1)
flux = planeflux[(j-pGrid->js)*pGrid->Nx[0]+i-pGrid->is];
else
#endif /* MPI_PARALLEL */
flux = initflux;
for (k=s; k<=e; k+=lr) {
pGrid->EdgeFlux[k-s][j-pGrid->js][i-pGrid->is] = flux;
n_H = pGrid->U[k][j][i].s[0] / m_H;
tau = sigma_ph * n_H * pGrid->dx1;
etau = exp(-tau);
kph = flux * (1.0-etau) / (n_H*cell_len);
ph_rate[k][j][i] += kph;
flux *= etau;
flux_frac = flux / initflux;
if (flux_frac < MINFLUXFRAC) break;
}
#ifdef MPI_PARALLEL
/* Store final flux to pass to next processor */
planeflux[(j-pGrid->js)*pGrid->Nx[0]+i-pGrid->is] =
flux_frac < MINFLUXFRAC ? 0.0 : flux;
max_flux_frac = (flux_frac > max_flux_frac) ?
flux_frac : max_flux_frac;
#endif /* MPI_PARALLEL */
}
}
break;
}
}
#ifdef MPI_PARALLEL
}
/* If we're parallel, get the maximum flux fraction left and see
if we should continue to the next set of processors. */
err = MPI_Allreduce(&max_flux_frac, &max_flux_frac_glob, 1, MP_RL,
MPI_MAX, Comm_Domain);
if (err) ath_error("[get_ph_rate_plane]: MPI_Allreduce error = %d\n", err);
if (max_flux_frac_glob < MINFLUXFRAC) break;
}
free(planeflux);
#endif /* MPI_PARALLEL */
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 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;
}