Example #1
0
int main(int argc, char *argv[])
{
  if (argc == 1) {
    printf("Usage: %s par-file [block-name par-name]\n",argv[0]);
    exit(0);
  }

  par_debug(0);
  par_open(argv[1]);
  par_cmdline(argc,argv);
  if (argc == 4) {
    char *cp = par_gets(argv[2],argv[3]);
    int ival;
    double dval;
    char *sval = "hello world";
    printf("PAR_GETS: %s.%s = \"%s\"\n",argv[2],argv[3],cp);
    printf("PAR_GETI: %s.%s = \"%d\" as integer\n",
      argv[2],argv[3],par_geti(argv[2],argv[3]));
    printf("PAR_GETD: %s.%s = \"%g\" as double\n",
      argv[2],argv[3],par_getd(argv[2],argv[3]));
    free(cp);
  }
  par_dump(0,stdout);
  par_close();
  return 0;
}
Example #2
0
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;
}
Example #3
0
void problem_read_restart(Grid *pG, Domain *pD, FILE *fp)
{
  Omega_0 = par_getd("problem","omega");
  qshear  = par_getd_def("problem","qshear",1.5);

  StaticGravPot = ShearingBoxPot;

  Ly = x2max - x2min;	/* for 3D problem */
  if (par_geti("grid","Nx3") == 1) {
    Ly = 0.0;
  }

  amp = par_getd("problem","amp");
  omg = sqrt(2.0*(2.0-qshear))*Omega_0;

  fread(name, sizeof(char),50,fp);
  return;
}
Example #4
0
void problem_read_restart(MeshS *pM, FILE *fp)
{
  DomainS *pD = (DomainS*)&(pM->Domain[0][0]);
  GridS *pG = pD->Grid;
  ShearingBoxPot = StratifiedDisk;

  Omega_0 = par_getd("problem","omega");
  qshear = par_getd_def("problem","qshear",1.5);
  ipert = par_geti_def("problem","ipert",1);

  x1min = pG->MinX[0];
  x1max = pG->MaxX[0];
  Lx = x1max - x1min;

  x2min = pG->MinX[1];
  x2max = pG->MaxX[1];
  Ly = x2max - x2min;

  x3min = pM->RootMinX[2];
  x3max = pM->RootMaxX[2];
  Lz = x3max - x3min;

  Lg = nghost*pG->dx3; /* size of the ghost zone */

  vsc1 = par_getd_def("problem","vsc1",0.05); /* in unit of iso_sound (N.B.!) */
  vsc2 = par_getd_def("problem","vsc2",0.0);

  vsc1 = vsc1 * Iso_csound;
  vsc2 = vsc2 * Iso_csound;

  Npar  = (int)(sqrt(par_geti("particle","parnumgrid")));
  nlis = par_geti_def("problem","nlis",pG->Nx[0]*pG->Nx[1]*pG->Nx[2]);
  ntrack = par_geti_def("problem","ntrack",2000);

  dump_history_enroll(hst_rho_Vx_dVy, "<rho Vx dVy>");

  return;
}
Example #5
0
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;
}
Example #6
0
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;
}
Example #7
0
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;
}
Example #8
0
File: kh.c Project: Ingwar/amuse
void problem(DomainS *pDomain)
{
  GridS *pGrid = pDomain->Grid;
  int i=0,j=0,k=0;
  int is,ie,js,je,ks,ke,iprob;
  Real amp,drat,vflow,b0,a,sigma,x1,x2,x3;
  long int iseed = -1;

  is = pGrid->is; ie = pGrid->ie;
  js = pGrid->js; je = pGrid->je;
  ks = pGrid->ks; ke = pGrid->ke;

/* Read problem parameters */

  iprob = par_geti("problem","iprob");
  vflow = par_getd("problem","vflow");
  drat = par_getd("problem","drat");
  amp = par_getd("problem","amp");
#ifdef MHD
  b0  = par_getd("problem","b0");
#endif

/* iprob=1.  Two uniform streams moving at +/- vflow, random perturbations */

  if (iprob == 1) {
    for (k=ks; k<=ke; k++) {
      for (j=js; j<=je; j++) {
        for (i=is; i<=ie; i++) {
          cc_pos(pGrid,i,j,k,&x1,&x2,&x3);
          pGrid->U[k][j][i].d = 1.0;
          pGrid->U[k][j][i].M1 = vflow + amp*(ran2(&iseed) - 0.5);
          pGrid->U[k][j][i].M2 = amp*(ran2(&iseed) - 0.5);
          pGrid->U[k][j][i].M3 = 0.0;
          if (fabs(x2) < 0.25) {
  	    pGrid->U[k][j][i].d = drat;
            pGrid->U[k][j][i].M1 = -drat*(vflow + amp*(ran2(&iseed) - 0.5));
            pGrid->U[k][j][i].M2 = drat*amp*(ran2(&iseed) - 0.5);
          }
/* Pressure scaled to give a sound speed of 1 with gamma=1.4 */
#ifndef BAROTROPIC
          pGrid->U[k][j][i].E = 2.5/Gamma_1
             + 0.5*(SQR(pGrid->U[k][j][i].M1) + SQR(pGrid->U[k][j][i].M2)
             + SQR(pGrid->U[k][j][i].M3))/pGrid->U[k][j][i].d;
#endif /* BAROTROPIC */
#ifdef MHD
          pGrid->B1i[k][j][i] = b0;
          pGrid->U[k][j][i].B1c = b0;
#ifndef BAROTROPIC
          pGrid->U[k][j][i].E += 0.5*b0*b0;
#endif /* BAROTROPIC */
#endif /* MHD */
        }
#ifdef MHD
      pGrid->B1i[k][j][ie+1] = b0;
#endif
      }
    }
  }

/* iprob=2.  Test suggested by E. Zweibel, based on Ryu & Jones.
 * Two uniform density flows with single mode perturbation
 */

  if (iprob == 2) {
    a = 0.05;
    sigma = 0.2;
    for (k=ks; k<=ke; k++) {
      for (j=js; j<=je; j++) {
        for (i=is; i<=ie; i++) {
          cc_pos(pGrid,i,j,k,&x1,&x2,&x3);
          pGrid->U[k][j][i].d = 1.0;
          pGrid->U[k][j][i].M1 = vflow*tanh(x2/a);
          pGrid->U[k][j][i].M2 = amp*sin(2.0*PI*x1)*exp(-(x2*x2)/(sigma*sigma));
          pGrid->U[k][j][i].M3 = 0.0;
#ifndef BAROTROPIC
          pGrid->U[k][j][i].E = 1.0/Gamma_1
             + 0.5*(SQR(pGrid->U[k][j][i].M1) + SQR(pGrid->U[k][j][i].M2)
             + SQR(pGrid->U[k][j][i].M3))/pGrid->U[k][j][i].d;
#endif /* BAROTROPIC */
#ifdef MHD
          pGrid->B1i[k][j][i] = b0;
          pGrid->U[k][j][i].B1c = b0;
#ifndef BAROTROPIC
          pGrid->U[k][j][i].E += 0.5*b0*b0;
#endif /* BAROTROPIC */
#endif /* MHD */
/* Use passive scalar to keep track of the fluids, since densities are same */
#if (NSCALARS > 0)
          pGrid->U[k][j][i].s[0] = 0.0;
          if (x2 > 0) pGrid->U[k][j][i].s[0] = 1.0;
#endif
        }
#ifdef MHD
      pGrid->B1i[k][j][ie+1] = b0;
#endif
      }
    }
  }

/* With viscosity and/or resistivity, read eta_R and nu_V */

#ifdef OHMIC
  eta_Ohm = par_getd("problem","eta");
#endif
#ifdef NAVIER_STOKES
  nu_V = par_getd("problem","nu");
#endif
#ifdef BRAGINSKII
  nu_V = par_getd("problem","nu");
#endif

}
Example #9
0
void problem(Grid *pGrid, Domain *pDomain)
{
  int in,i,j,k;
  Real x1,x2,x3;
  long p;
  Vector parpos, parvel;

  if (par_geti("grid","Nx2") == 1) {
    ath_error("[par_epicycle]: par_epicycle must work in 2D or 3D.\n");
  }

/* Initialize boxsize */
  x1min = par_getd("grid","x1min");
  x1max = par_getd("grid","x1max");
  Lx = x1max - x1min;

  x2min = par_getd("grid","x2min");
  x2max = par_getd("grid","x2max");
  Ly = x2max - x2min;	/* for 3D problem */
  if (par_geti("grid","Nx3") == 1) {
    Ly = 0.0;
  }

/* Read initial conditions */
  Omega_0 = par_getd("problem","omega");
  qshear  = par_getd_def("problem","qshear",1.5);
  amp = par_getd("problem","amp");
  omg = sqrt(2.0*(2.0-qshear))*Omega_0;

/* particle type */
  if (par_geti("particle","partypes") != 1)
    ath_error("[par_epicycle]: This test only allows ONE particle species!\n");

/* particle stopping time */
  tstop0[0] = par_getd_def("problem","tstop",1.0e20); /* in code unit */
  if (par_geti("particle","tsmode") != 3)
    ath_error("[par_epicycle]: This test only allows fixed stopping time!\n");

/* particle position */
  parpos = ParticlePosition(0.0);
  parvel = ParticleVelocity(parpos, 0.0);
  in = ParticleLocator(parpos);

  pGrid->nparticle         = in;
  pGrid->grproperty[0].num = in;

  if (pGrid->nparticle+2 > pGrid->arrsize)
    particle_realloc(pGrid, pGrid->nparticle+2);

/* Now set initial conditions for the gas */
  for (k=pGrid->ks; k<=pGrid->ke; k++) {
  for (j=pGrid->js; j<=pGrid->je; j++) {
  for (i=pGrid->is; i<=pGrid->ie; i++) {
    cc_pos(pGrid,i,j,k,&x1,&x2,&x3);
    pGrid->U[k][j][i].d = 1.0;
    pGrid->U[k][j][i].M1 = 0.0;
    pGrid->U[k][j][i].M2 = 0.0;
    pGrid->U[k][j][i].M3 = 0.0;
#ifndef FARGO
    if (Ly>0.0) /* 3D */
      pGrid->U[k][j][i].M2 -= qshear*Omega_0*x1;
    else /* 2D */
      pGrid->U[k][j][i].M3 -= qshear*Omega_0*x1;
#endif
  }}}

/* Now set initial conditions for the particles */
  for (p=0; p<in; p++)
  {
    pGrid->particle[p].property = 0;
    pGrid->particle[p].x1 = parpos.x1;
    pGrid->particle[p].x2 = parpos.x2;
    pGrid->particle[p].x3 = parpos.x3;
    pGrid->particle[p].v1 = parvel.x1;
    pGrid->particle[p].v2 = parvel.x2;
    pGrid->particle[p].v3 = parvel.x3;
    pGrid->particle[p].pos = 1; /* grid particle */
    pGrid->particle[p].my_id = p;
#ifdef MPI_PARALLEL
    pGrid->particle[p].init_id = pGrid->my_id;
#endif
  }

/* enroll gravitational potential function, shearing sheet BC functions */
  StaticGravPot = ShearingBoxPot;

  if (pGrid->my_id == 0) {
  /* flush output file */
    sprintf(name, "%s_Traj.dat", pGrid->outfilename);
    FILE *fid = fopen(name,"w");
    fclose(fid);
#ifdef MPI_PARALLEL
    sprintf(name, "../%s_Traj.dat", pGrid->outfilename);
#else
    sprintf(name, "%s_Traj.dat", pGrid->outfilename);
#endif
  }

#ifdef MPI_PARALLEL
  MPI_Bcast(name,50,MPI_CHAR,0,MPI_COMM_WORLD);
#endif

  return;
}
Example #10
0
void problem(DomainS *pDomain)
{
  GridS *pGrid = pDomain->Grid;
  int i,j,k,ks,pt,tsmode;
  long p,q;
  Real ScaleHg,tsmin,tsmax,tscrit,amin,amax,Hparmin,Hparmax;
  Real *ep,*ScaleHpar,epsum,mratio,pwind,rhoaconv,etavk;
  Real *epsilon,*uxNSH,*uyNSH,**wxNSH,**wyNSH;
  Real rhog,h,x1,x2,x3,t,x1p,x2p,x3p,zmin,zmax,dx3_1,b;
  long int iseed = myID_Comm_world; /* Initialize on the first call to ran2 */

  if (pDomain->Nx[2] == 1) {
    ath_error("[par_strat3d]: par_strat3d only works for 3D problem.\n");
  }
  
#ifdef MPI_PARALLEL
  if (pDomain->NGrid[2] > 2) {
    ath_error(   
  "[par_strat3d]: The z-domain can not be decomposed into more than 2 grids\n");
  }
#endif

/* Initialize boxsize */
  x1min = pGrid->MinX[0];
  x1max = pGrid->MaxX[0];
  Lx = x1max - x1min;

  x2min = pGrid->MinX[1];
  x2max = pGrid->MaxX[1];
  Ly = x2max - x2min;

  x3min = par_getd("domain1","x3min");
  x3max = par_getd("domain1","x3max");
  Lz = x3max - x3min;

  Lg = nghost*pGrid->dx3; /* size of the ghost zone */

  ks = pGrid->ks;

/* Read initial conditions */
  Omega_0 = par_getd("problem","omega");
  qshear = par_getd_def("problem","qshear",1.5);
  ipert = par_geti_def("problem","ipert",1);
  vsc1 = par_getd_def("problem","vsc1",0.05); /* in unit of iso_sound (N.B.!) */
  vsc2 = par_getd_def("problem","vsc2",0.0);

  vsc1 = vsc1 * Iso_csound;
  vsc2 = vsc2 * Iso_csound;

  ScaleHg = Iso_csound/Omega_0;

  /* particle number */
  Npar  = (long)(par_geti("particle","parnumgrid"));

  pGrid->nparticle = Npar*npartypes;
  for (i=0; i<npartypes; i++)
    grproperty[i].num = Npar;

  if (pGrid->nparticle+2 > pGrid->arrsize)
    particle_realloc(pGrid, pGrid->nparticle+2);

  ep = (Real*)calloc_1d_array(npartypes, sizeof(Real));
  ScaleHpar = (Real*)calloc_1d_array(npartypes, sizeof(Real));

  epsilon = (Real*)calloc_1d_array(npartypes, sizeof(Real));
  wxNSH   = (Real**)calloc_2d_array(pGrid->Nx[2]+1, npartypes,sizeof(Real));
  wyNSH   = (Real**)calloc_2d_array(pGrid->Nx[2]+1, npartypes,sizeof(Real));
  uxNSH   = (Real*)calloc_1d_array(pGrid->Nx[2]+1, sizeof(Real));
  uyNSH   = (Real*)calloc_1d_array(pGrid->Nx[2]+1, sizeof(Real));

  /* particle stopping time */
  tsmode = par_geti("particle","tsmode");
  if (tsmode == 3) {/* fixed stopping time */
    tsmin = par_getd("problem","tsmin"); /* in code unit */
    tsmax = par_getd("problem","tsmax");
    tscrit= par_getd("problem","tscrit");

    for (i=0; i<npartypes; i++) {
      tstop0[i] = tsmin*exp(i*log(tsmax/tsmin)/MAX(npartypes-1,1.0));
      grproperty[i].rad = tstop0[i];
      /* use fully implicit integrator for well coupled particles */
      if (tstop0[i] < tscrit) grproperty[i].integrator = 3;
    }
  }
  else { 
    amin = par_getd("problem","amin");
    amax = par_getd("problem","amax");

    for (i=0; i<npartypes; i++)
      grproperty[i].rad = amin*exp(i*log(amax/amin)/MAX(npartypes-1,1.0));

    if (tsmode <= 2) {/* Epstein/General regime */
      /* conversion factor for rhoa */
      rhoaconv = par_getd_def("problem","rhoaconv",1.0);

      for (i=0; i<npartypes; i++)
        grrhoa[i]=grproperty[i].rad*rhoaconv;
    }

    if (tsmode == 1)  /* General drag formula */
      alamcoeff = par_getd("problem","alamcoeff");
  }

  /* particle scale height */
  Hparmax = par_getd("problem","hparmax"); /* in unit of gas scale height */
  Hparmin = par_getd("problem","hparmin");
  for (i=0; i<npartypes; i++) 
    ScaleHpar[i] = Hparmax*
                   exp(-i*log(Hparmax/Hparmin)/MAX(npartypes-1,1.0));

#ifdef FEEDBACK
  mratio = par_getd_def("problem","mratio",0.0); /* total mass fraction */
  pwind = par_getd_def("problem","pwind",0.0);   /* power law index */
  if (mratio < 0.0)
    ath_error("[par_strat2d]: mratio must be positive!\n");

  epsum = 0.0;
  for (i=0; i<npartypes; i++)
  {
    ep[i] = pow(grproperty[i].rad,pwind);	epsum += ep[i];
  }

  for (i=0; i<npartypes; i++)
  {
    ep[i] = mratio*ep[i]/epsum;
    grproperty[i].m = sqrt(2.0*PI)*ScaleHg/Lz*ep[i]*
                                   pGrid->Nx[0]*pGrid->Nx[1]*pGrid->Nx[2]/Npar;
  }
#else
  mratio = 0.0;
  for (i=0; i<npartypes; i++)
    ep[i] = 0.0;
#endif

  /* NSH equilibrium */
  for (k=pGrid->ks; k<=pGrid->ke+1; k++) {

    h = pGrid->MinX[2] + (k-pGrid->ks)*pGrid->dx3;
    q = k - ks;
    etavk = fabs(vsc1+vsc2*SQR(h));

    for (i=0; i<npartypes; i++) {
      epsilon[i] = ep[i]/ScaleHpar[i]*exp(-0.5*SQR(h/ScaleHg)
         *(SQR(1.0/ScaleHpar[i])-1.0))/erf(Lz/(sqrt(8.0)*ScaleHpar[i]*ScaleHg));

      if (tsmode != 3)
        tstop0[i] = get_ts(pGrid,i,exp(-0.5*SQR(h/ScaleHg)),Iso_csound,etavk);
    }

    MultiNSH(npartypes, tstop0, epsilon, etavk,
                              &uxNSH[q], &uyNSH[q], wxNSH[q], wyNSH[q]);
  }

/* Now set initial conditions for the gas */
  for (k=pGrid->ks; k<=pGrid->ke; k++) {
  for (j=pGrid->js; j<=pGrid->je; j++) {
  for (i=pGrid->is; i<=pGrid->ie; i++) {
    cc_pos(pGrid,i,j,k,&x1,&x2,&x3);

    rhog = exp(-0.5*SQR(x3/ScaleHg));
    pGrid->U[k][j][i].d = rhog;

    if (ipert != 1) {/* NSH velocity */
      pGrid->U[k][j][i].M1 = 0.5*rhog*(uxNSH[k-ks]+uxNSH[k-ks+1]);
      pGrid->U[k][j][i].M2 = 0.5*rhog*(uyNSH[k-ks]+uyNSH[k-ks+1]);
    } else {
      pGrid->U[k][j][i].M1 = 0.0;
      pGrid->U[k][j][i].M2 = 0.0;
    }

    pGrid->U[k][j][i].M3 = 0.0;
#ifndef FARGO
    pGrid->U[k][j][i].M2 -= qshear*rhog*Omega_0*x1;
#endif

  }}}

/* Now set initial conditions for the particles */
  p = 0;
  dx3_1 = 1.0/pGrid->dx3;
  zmin = pGrid->MinX[2];
  zmax = pGrid->MaxX[2];

  for (q=0; q<Npar; q++) {

    for (pt=0; pt<npartypes; pt++) {

      x1p = x1min + Lx*ran2(&iseed);
      x2p = x2min + Ly*ran2(&iseed);
      x3p = ScaleHpar[pt]*ScaleHg*Normal(&iseed);
      while ((x3p >= zmax) || (x3p < zmin))
        x3p = ScaleHpar[pt]*ScaleHg*Normal(&iseed);

      pGrid->particle[p].property = pt;
      pGrid->particle[p].x1 = x1p;
      pGrid->particle[p].x2 = x2p;
      pGrid->particle[p].x3 = x3p;

      if (ipert != 1) {/* NSH velocity */

        cellk(pGrid, x3p, dx3_1, &k, &b);
        k = k-pGrid->ks;  b = b - pGrid->ks;

        pGrid->particle[p].v1 = (k+1-b)*wxNSH[k][pt]+(b-k)*wxNSH[k+1][pt];
        pGrid->particle[p].v2 = (k+1-b)*wyNSH[k][pt]+(b-k)*wyNSH[k+1][pt];

      } else {

        pGrid->particle[p].v1 = 0.0;
        pGrid->particle[p].v2 = vsc1+vsc2*SQR(x2p);

      }

      pGrid->particle[p].v3 = 0.0;
#ifndef FARGO
      pGrid->particle[p].v2 -= qshear*Omega_0*x1p;
#endif

      pGrid->particle[p].pos = 1; /* grid particle */
      pGrid->particle[p].my_id = p;
#ifdef MPI_PARALLEL
      pGrid->particle[p].init_id = myID_Comm_world;
#endif
      p++;
  }}

/* enroll gravitational potential function, shearing sheet BC functions */
  ShearingBoxPot = StratifiedDisk;

  dump_history_enroll(hst_rho_Vx_dVy, "<rho Vx dVy>");

  /* set the # of the particles in list output
   * (by default, output 1 particle per cell)
   */
  nlis = par_geti_def("problem","nlis",pGrid->Nx[0]*pGrid->Nx[1]*pGrid->Nx[2]);

  /* set the number of particles to keep track of */
  ntrack = par_geti_def("problem","ntrack",2000);

  /* set the threshold particle density */
  dpar_thresh = par_geti_def("problem","dpar_thresh",10.0);

  /* finalize */
  free(ep);  free(ScaleHpar);
  free(epsilon);
  free_2d_array(wxNSH);  free_2d_array(wyNSH);
  free(uxNSH);           free(uyNSH);

  return;
}
Example #11
0
void problem(Grid *pGrid, Domain *pDomain)
{
  int i,j,k;
  long p,in;


  if (par_geti("grid","Nx1") == 1 || par_geti("grid","Nx2") == 1) {
    ath_error("[par_fric]: this test only works with Nx1 & Nx2 > 1\n");
  }

/* Initialize boxsize */
  x1min = par_getd("grid","x1min");
  x1max = par_getd("grid","x1max");
  x2min = par_getd("grid","x2min");
  x2max = par_getd("grid","x2max");
  x3min = par_getd("grid","x3min");
  x3max = par_getd("grid","x3max");
  x1c = 0.5*(x1min+x1max);
  x2c = 0.5*(x2min+x2max);
  x3c = 0.5*(x3min+x3max);

/* Read initial conditions for the gas */
  v01 = par_getd("problem","v1");
  v02 = par_getd("problem","v2");
  v03 = par_getd("problem","v3");

/* particle type */
  if (par_geti("particle","partypes") != 1)
    ath_error("[par_fric]: number of particle types must be 1!\n");

/* particle stopping time */
  tstop0 = par_getd("problem","tstop"); /* in code unit */
  if (par_geti("particle","tsmode") != 3)
    ath_error("[par_fric]: This test works only for fixed stopping time!\n");

/* initial particle position */
  in = ParticleLocator(x1c, x2c, x3c);

  pGrid->nparticle         = in;
  pGrid->grproperty[0].num = in;

  if (pGrid->nparticle+2 > pGrid->arrsize)
    particle_realloc(pGrid, pGrid->nparticle+2);

/* Now set initial conditions for the gas */

  for (k=pGrid->ks; k<=pGrid->ke; k++) {
  for (j=pGrid->js; j<=pGrid->je; j++) {
  for (i=pGrid->is; i<=pGrid->ie; i++) {
    pGrid->U[k][j][i].d = 1.0;
    pGrid->U[k][j][i].M1 = 0.0;
    pGrid->U[k][j][i].M2 = 0.0;
    pGrid->U[k][j][i].M3 = 0.0;
  }}}

/* Now set initial conditions for the particles */
  for (p=0; p<in; p++)
  {
    pGrid->particle[p].property = 0;
    pGrid->particle[p].x1 = x1c;
    pGrid->particle[p].x2 = x2c;
    pGrid->particle[p].x3 = x3c;
    pGrid->particle[p].v1 = v01;
    pGrid->particle[p].v2 = v02;
    pGrid->particle[p].v3 = v03;
    pGrid->particle[p].pos = 1; /* grid particle */
    pGrid->particle[p].my_id = p;
#ifdef MPI_PARALLEL
    pGrid->particle[p].init_id = pGrid->my_id;
#endif
  }

  if (pGrid->my_id == 0) {
  /* flush output file */
    sprintf(name, "%s_Err.dat", pGrid->outfilename);
    FILE *fid = fopen(name,"w");
    fclose(fid);
#ifdef MPI_PARALLEL
    sprintf(name, "../%s_Err.dat", pGrid->outfilename);
#else
    sprintf(name, "%s_Err.dat", pGrid->outfilename);
#endif
  }

#ifdef MPI_PARALLEL
  MPI_Bcast(name,50,MPI_CHAR,0,MPI_COMM_WORLD);
#endif

  return;
}
Example #12
0
void problem(Grid *pGrid, Domain *pDomain)
{
  int i=0,j=0,k=0;
  int is,ie,js,je,ks,ke,n,wavedir,nwave,samp;
  Real x1,x2,x3,x1max,x1min,x2max,x2min,amp,vflow,kw;
#ifdef PARTICLES
  long p;
  int Npar,ip,jp;
  Real x1p,x2p,x3p,x1l,x1u,x2l,x2u;
  Real par_amp, factor2;
#endif

  if ((par_geti("grid","Nx2") == 1) || (par_geti("grid","Nx3") > 1)) {
    ath_error("[par_linearwave1d]: par_linearwave1d must work in 2D grid.\n");
  }

  is = pGrid->is; ie = pGrid->ie;
  js = pGrid->js; je = pGrid->je;
  ks = pGrid->ks; ke = pGrid->ke;

/* Read initial conditions  */
  amp = par_getd("problem","amp");
  wavedir = par_geti("problem","wavedir");
  vflow = par_getd("problem","vflow");
  nwave = par_geti("problem","nwave");
  samp = par_geti("problem","sample");
  x1min = par_getd("grid","x1min");
  x1max = par_getd("grid","x1max");
  x2min = par_getd("grid","x2min");
  x2max = par_getd("grid","x2max");

  if (wavedir == 1)
    kw = 2.0*(PI)*nwave/(x1max-x1min);
  else if (wavedir == 2)
    kw = 2.0*(PI)*nwave/(x2max-x2min);

/* Now set initial conditions to wave solution */ 

  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);

    switch(wavedir){
    case 1:
      pGrid->U[k][j][i].d = 1.0+amp*sin(kw*x1);
      pGrid->U[k][j][i].M1 = pGrid->U[k][j][i].d*
                             (vflow+amp*Iso_csound*sin(kw*x1));
      pGrid->U[k][j][i].M2 = 0.0;
      break;

    case 2:
      pGrid->U[k][j][i].d = 1.0+amp*sin(kw*x2);
      pGrid->U[k][j][i].M1 = 0.0;
      pGrid->U[k][j][i].M2 = pGrid->U[k][j][i].d*
                             (vflow+amp*Iso_csound*sin(kw*x2));
      break;

    default:
      ath_error("[par_linearwave1d]: wavedir must be either 1 or 2!\n");
    }

    pGrid->U[k][j][i].M3 = 0.0;
#if (NSCALARS > 0)
    if (samp == 1)
      for (n=0; n<NSCALARS; n++)
        pGrid->U[k][j][i].s[n] = pGrid->U[k][j][i].d;
    else
      for (n=0; n<NSCALARS; n++)
        pGrid->U[k][j][i].s[n] = 1.0;
#endif
  }}}

/* Read initial conditions for the particles */
#ifdef PARTICLES

  /* basic parameters */
  if (par_geti("particle","partypes") != 1)
    ath_error("[par_linwave1d]: This test only allows ONE particle species!\n");

  Npar = (int)(sqrt(par_geti("particle","parnumcell")));
  pGrid->nparticle = Npar*Npar*pGrid->Nx1*pGrid->Nx2;
  pGrid->grproperty[0].num = pGrid->nparticle;
  if (pGrid->nparticle+2 > pGrid->arrsize)
    particle_realloc(pGrid, pGrid->nparticle+2);

  /* particle stopping time */
  tstop0[0] = par_getd_def("problem","tstop",0.0); /* in code unit */
  if (par_geti("particle","tsmode") != 3)
    ath_error("[par_linwave1d]: This test only allows fixed stopping time!\n");

  /* particle perturbation amplitude */
  switch(wavedir){
  case 1:
    par_amp = amp*kw*pGrid->dx1/sin(kw*pGrid->dx1);
    factor2 = 0.5*tan(kw*pGrid->dx1)/(kw*pGrid->dx1);
    break;
  case 2:
    par_amp = amp*kw*pGrid->dx2/sin(kw*pGrid->dx2);
    factor2 = 0.5*tan(kw*pGrid->dx2)/(kw*pGrid->dx2);
    break;
  default:
   ath_error("[par_linearwave1d]: wavedir must be either 1 or 2!\n");
  }

//par_amp=amp;
//factor2 = 0.5;

/* Now set initial conditions for the particles */
  p = 0;
  x3p = pGrid->x3_0 + (pGrid->ks+pGrid->kdisp)*pGrid->dx3;


  for (j=pGrid->js; j<=pGrid->je; j++)
  {
    x2l = pGrid->x2_0 + (j+pGrid->jdisp)*pGrid->dx2;
    x2u = pGrid->x2_0 + ((j+pGrid->jdisp)+1.0)*pGrid->dx2;

    for (i=pGrid->is; i<=pGrid->ie; i++)
    {
      x1l = pGrid->x1_0 + (i + pGrid->idisp)*pGrid->dx1;
      x1u = pGrid->x1_0 + ((i + pGrid->idisp) + 1.0)*pGrid->dx1;

        for (ip=0;ip<Npar;ip++)
        {
          x1p = x1l+(x1u-x1l)/Npar*(ip+0.5);

          for (jp=0;jp<Npar;jp++)
          {
            x2p = x2l+(x2u-x2l)/Npar*(jp+0.5);

            pGrid->particle[p].property = 0;

            switch(wavedir){
            case 1:
              pGrid->particle[p].x1 = x1p;
              if (samp == 1) {
                pGrid->particle[p].x1 += par_amp*cos(kw*x1p)/kw
                                      - factor2*SQR(par_amp)*sin(2.0*kw*x1p)/kw;
              }
              pGrid->particle[p].x2 = x2p;
              pGrid->particle[p].v1 = vflow+amp*Iso_csound*sin(kw*x1p);
              pGrid->particle[p].v2 = 0.0;
              break;

            case 2:
              pGrid->particle[p].x1 = x1p;
              pGrid->particle[p].x2 = x2p;
              if (samp == 1) {
                pGrid->particle[p].x2 += par_amp*cos(kw*x2p)/kw
                                      - factor2*SQR(par_amp)*sin(2.0*kw*x2p)/kw;
              }
              pGrid->particle[p].v1 = 0.0;
              pGrid->particle[p].v2 = vflow+amp*Iso_csound*sin(kw*x2p);
              break;

            default:
              ath_error("[par_linearwave1d]: wavedir must be either 1 or 2!\n");
            }

            pGrid->particle[p].x3 = x3p;
            pGrid->particle[p].v3 = 0.0;

            pGrid->particle[p].pos = GetPosition(&pGrid->particle[p]);
            pGrid->particle[p].my_id = p;
#ifdef MPI_PARALLEL
            pGrid->particle[p].init_id = pGrid->my_id;
#endif
            p += 1;
          }
        }
    }
  }

#endif /* PARTICLES */

  return;
}
Example #13
0
void Userwork_after_loop(Grid *pGrid, Domain *pDomain)
{
  int i=0,j=0,k=0;
  int is,ie,js,je,ks,ke,n,wavedir,nwave,samp;
  Real x1,x2,x3,x1max,x1min,x2max,x2min,amp,vflow,kw;
  Real time,omega,SolGasd,SolLagd;
  char *fname;

  is = pGrid->is; ie = pGrid->ie;
  js = pGrid->js; je = pGrid->je;
  ks = pGrid->ks; ke = pGrid->ke;

  /* Read initial conditions  */
  amp = par_getd("problem","amp");
  wavedir = par_geti("problem","wavedir");
  vflow = par_getd("problem","vflow");
  nwave = par_geti("problem","nwave");
  samp = par_geti("problem","sample");
  x1min = par_getd("grid","x1min");
  x1max = par_getd("grid","x1max");
  x2min = par_getd("grid","x2min");
  x2max = par_getd("grid","x2max");

  /* calculate dispersion relation */
  if (wavedir == 1)
    kw = 2.0*(PI)*nwave/(x1max-x1min);
  else if (wavedir == 2)
    kw = 2.0*(PI)*nwave/(x2max-x2min);

  time = pGrid->time;
  omega = kw*Iso_csound;

  /* Bin particles to grid */
  particle_to_grid(pGrid, pDomain, property_all);

  /* Print error to file "Par_LinWave-errors.#.dat", where #=wavedir  */
  fname = ath_fname(NULL,"Par_LinWave1d-errors",1,wavedir,NULL,"dat");

  /* Open output file in write mode */
  FILE *fid = fopen(fname,"w");

  /* Calculate the error and output */
  switch(wavedir){
  case 1:
    fprintf(fid, "%f	%d\n", time, ie-is+1);
    for (i=is; i<=ie; i++) {
      /* calculate analytic solution */
      cc_pos(pGrid,i,js,ks,&x1,&x2,&x3);
      SolGasd = 1.0+amp*sin(kw*(x1-vflow*time)-omega*time);
      if (samp == 1)
        SolLagd = SolGasd;
      else
        SolLagd = SolGasd-amp*sin(kw*(x1-vflow*time));

      /* output */
      fprintf(fid,"%f	",x1);
      fprintf(fid,"%e	%e	%e	",pGrid->U[ks][js][i].d-1.0,
                                SolGasd-1.0,pGrid->U[ks][js][i].d-SolGasd);
      fprintf(fid,"%e	%e	%e	",pG->Coup[ks][js][i].grid_d-1.0,
                                SolLagd-1.0,pG->Coup[ks][js][i].grid_d-SolLagd);
#if (NSCALARS > 0)
      for (n=0; n<NSCALARS; n++)
        fprintf(fid,"%e	%e	",pGrid->U[ks][js][i].s[n]-1.0,
                                  pGrid->U[ks][js][i].s[n]-SolLagd);
#endif
      fprintf(fid,"\n");
    }
    break;

  case 2:
    fprintf(fid, "%f	%d\n", time, je-js+1);
    for (j=js; j<=je; j++) {
      /* calculate analytic solution */
      cc_pos(pGrid,is,j,ks,&x1,&x2,&x3);
      SolGasd = 1.0+amp*sin(kw*(x2-vflow*time)-omega*time);
      if (samp == 1)
        SolLagd = SolGasd;
      else
        SolLagd = SolGasd-amp*sin(kw*(x2-vflow*time));

      /* output */
      fprintf(fid,"%f   ",x2);
      fprintf(fid,"%e   %e      %e      ",pGrid->U[ks][j][is].d-1.0,
                                SolGasd-1.0,pGrid->U[ks][j][is].d-SolGasd);
      fprintf(fid,"%e   %e      %e      ",pG->Coup[ks][j][is].grid_d-1.0,
                                SolLagd-1.0,pG->Coup[ks][j][is].grid_d-SolLagd);
#if (NSCALARS > 0)
      for (n=0; n<NSCALARS; n++)
        fprintf(fid,"%e %e      ",pGrid->U[ks][j][is].s[n]-1.0,
                        pGrid->U[ks][j][is].s[n]-SolLagd); 
#endif
      fprintf(fid,"\n");
    }
    break; 

  }

  fclose(fid);

  return;
}
Example #14
0
/* problem:  */
void problem(DomainS *pDomain)
{
  GridS *pG = pDomain->Grid;
  int i,j,k;
  int is,ie,il,iu,js,je,jl,ju,ks,ke,kl,ku;
  int nx1,nx2,nx3;
  Real x1,x2,x3;
  Real xs,vs,v,pgas0,pgas,alpha,beta,a,b,converged;

  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;

#ifdef MHD
  ath_error("[cylwindrot]: This problem only works in hydro!\n");
#endif

#ifndef CYLINDRICAL
  ath_error("[cylwindrot]: This problem only works in cylindrical!\n");
#endif

  if (nx1==1) {
    ath_error("[cylwindrot]: This problem can only be run in 2D or 3D!\n");
  }
  else if (nx2==1 && nx3>1) {
    ath_error("[cylwindrot]: Only (R,phi) can be used in 2D!\n");
  }

  /* Allocate memory for solution */
  if ((RootSoln = (ConsS***)calloc_3d_array(nx3,nx2,nx1,sizeof(ConsS))) == NULL)
    ath_error("[cylwindrot]: Error allocating memory for solution\n");

  ang_mom = par_getd("problem","ang_mom");
  c_infty = par_getd("problem","c_infty");
  vz0     = par_getd("problem","vz0");
  iprob   = par_geti("problem","iprob");
  printf("gamma = %f,\t ang_mom = %f,\t c_infty = %f\n", Gamma, ang_mom, c_infty);

  beta = 2.0*Gamma_1/(Gamma+1.0);
  xs = (3.0-Gamma+sqrt(SQR(Gamma-3.0)-16.0*SQR(ang_mom)))/4.0;
  lambda_s = 1.0/Gamma_1*pow(xs,beta)+pow(xs,beta-1.0)-0.5*SQR(ang_mom)*pow(xs,beta-2.0);
  lambda_s = pow(lambda_s/(0.5+1.0/Gamma_1),1.0/beta);
  vs = c_infty*pow(lambda_s/xs,0.5*beta);
  printf("xs = %13.10f,\t lambda_s = %13.10f,\t vs = %13.10f\n", xs, lambda_s, vs);

  // Compute 1D wind/accretion solution
  for (i=il; i<=iu; i++) {
    cc_pos(pG,i,j,k,&x1,&x2,&x3);
    memset(&(pG->U[ks][js][i]),0.0,sizeof(ConsS));
    vs = pow(lambda_s/x1,0.5*beta);

    switch(iprob) {
      case 1: /* Wind */
              if (x1 < xs) {
                a = TINY_NUMBER;  b = vs;
              }
              else {
                a = vs;           b = HUGE_NUMBER;
              }
              break;
      case 2: /* Accretion */
              if (x1 < xs) {
                a = vs;           b = HUGE_NUMBER;
              }
              else {
                a = TINY_NUMBER;  b = vs;
              }
              break;
      default:  ath_error("[cylwindrot]:  Not an accepted problem number!\n");
    }

    converged = bisection(myfunc,a,b,x1,&v);
    if (!converged) ath_error("[cylwindrot]:  Bisection did not converge!\n");

    pG->U[ks][js][i].d   = lambda_s/(x1*v);
    pG->U[ks][js][i].M1  = lambda_s/x1;
    if (iprob==2)
      pG->U[ks][js][i].M1  *= -1.0;
    pG->U[ks][js][i].M2  = pG->U[ks][js][i].d*ang_mom/x1;
    pG->U[ks][js][i].M3  = pG->U[ks][js][i].d*vz0;

        /* Initialize total energy */
#ifndef ISOTHERMAL
        pgas0 = 1.0/Gamma;
        pgas = pgas0*pow(pG->U[ks][js][i].d,Gamma);
        pG->U[ks][js][i].E = pgas/Gamma_1
          + 0.5*(SQR(pG->U[ks][js][i].M1) + SQR(pG->U[ks][js][i].M2) + SQR(pG->U[ks][js][i].M3))/pG->U[ks][js][i].d;
#endif /* ISOTHERMAL */
  }

  /* Copy 1D solution 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];
        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);

  return;
}
Example #15
0
void problem(DomainS *pDomain)
{
  GridS *pGrid = pDomain->Grid;
  int i=0,j=0,k=0;
  int is,ie,js,je,ks,ke,iprob;
  long int iseed = -1;
  Real amp,x1,x2,x3,lx,ly,lz,rhoh,L_rot,fact;
#ifdef MHD
  Real b0,angle;
#endif
  int ixs, jxs, kxs;

  is = pGrid->is;  ie = pGrid->ie;
  js = pGrid->js;  je = pGrid->je;
  ks = pGrid->ks;  ke = pGrid->ke;

  lx = pDomain->RootMaxX[0] - pDomain->RootMinX[0];
  ly = pDomain->RootMaxX[1] - pDomain->RootMinX[1];
  lz = pDomain->RootMaxX[2] - pDomain->RootMinX[2];

/* Ensure a different initial random seed for each process in an MPI calc. */
  ixs = pGrid->Disp[0];
  jxs = pGrid->Disp[1];
  kxs = pGrid->Disp[2];
  iseed = -1 - (ixs + pDomain->Nx[0]*(jxs + pDomain->Nx[1]*kxs));

/* Read perturbation amplitude, problem switch, background density */
  amp = par_getd("problem","amp");
  iprob = par_geti("problem","iprob");
  rhoh  = par_getd_def("problem","rhoh",3.0);
/* Distance over which field is rotated */
  L_rot  = par_getd_def("problem","L_rot",0.0);

/* Read magnetic field strength, angle [should be in degrees, 0 is along +ve
 * X-axis (no rotation)] */
#ifdef MHD
  b0 = par_getd("problem","b0");
  angle = par_getd("problem","angle");
  angle = (angle/180.)*PI;
#endif

/* 2D PROBLEM --------------------------------------------------------------- */
/* Initialize two fluids with interface at y=0.0.  Pressure scaled to give a
 * sound speed of 1 at the interface in the light (lower, d=1) fluid 
 * Perturb V2 using single (iprob=1) or multiple (iprob=2) mode 
 */

  if (pGrid->Nx[2] == 1) {
  for (k=ks; k<=ke; k++) {
    for (j=js; j<=je; j++) {
      for (i=is; i<=ie; i++) {
        cc_pos(pGrid,i,j,k,&x1,&x2,&x3);
	pGrid->U[k][j][i].d = 1.0;
        pGrid->U[k][j][i].E = (1.0/Gamma - 0.1*x2)/Gamma_1;
	pGrid->U[k][j][i].M1 = 0.0;
        if (iprob == 1) {
          pGrid->U[k][j][i].M2 = amp/4.0*
            (1.0+cos(2.0*PI*x1/lx))*(1.0+cos(2.0*PI*x2/ly));
        }
        else {
          pGrid->U[k][j][i].M2 = amp*(ran2(&iseed) - 0.5)*
            (1.0+cos(2.0*PI*x2/ly));
	}
        pGrid->U[k][j][i].M3 = 0.0;
        if (x2 > 0.0) {
	  pGrid->U[k][j][i].d = 2.0;
          pGrid->U[k][j][i].M2 *= 2.0;
          pGrid->U[k][j][i].E = (1.0/Gamma - 0.2*x2)/Gamma_1;
	}
	pGrid->U[k][j][i].E+=0.5*SQR(pGrid->U[k][j][i].M2)/pGrid->U[k][j][i].d;
#ifdef MHD
	pGrid->B1i[k][j][i] = b0;
	pGrid->U[k][j][i].B1c = b0;
        pGrid->U[k][j][i].E += 0.5*b0*b0;
#endif
      }
#ifdef MHD
    pGrid->B1i[k][j][ie+1] = b0;
#endif
    }
  }

/* Enroll gravitational potential to give acceleration in y-direction for 2D
 * Use special boundary condition routines.  In 2D, gravity is in the
 * y-direction, so special boundary conditions needed for x2
*/

  StaticGravPot = grav_pot2;
  if (pDomain->Disp[1] == 0) bvals_mhd_fun(pDomain, left_x2,  reflect_ix2);
  if (pDomain->MaxX[1] == pDomain->RootMaxX[1])
    bvals_mhd_fun(pDomain, right_x2, reflect_ox2);

  } /* end of 2D initialization  */

/* 3D PROBLEM ----------------------------------------------------------------*/
/* Initialize two fluids with interface at z=0.0
 * Pressure scaled to give a sound speed of 1 at the interface
 * in the light (lower, d=1) fluid
 * iprob = 1 -- Perturb V3 using single mode
 * iprob = 2 -- Perturb V3 using multiple mode
 * iprob = 3 -- B in light fluid only, with multimode perturbation
 * iprob = 4 -- B rotated by "angle" at interface, multimode perturbation
 */

  if (pGrid->Nx[2] > 1) {
  for (k=ks; k<=ke; k++) {
    for (j=js; j<=je; j++) {
      for (i=is; i<=ie; i++) {
        cc_pos(pGrid,i,j,k,&x1,&x2,&x3);
	pGrid->U[k][j][i].d = 1.0;
        pGrid->U[k][j][i].E = (1.0/Gamma - 0.1*x3)/Gamma_1;
	pGrid->U[k][j][i].M1 = 0.0;
	pGrid->U[k][j][i].M2 = 0.0;
        if (iprob == 1) {
          pGrid->U[k][j][i].M3 = amp/8.0*(1.0+cos(2.0*PI*x1/lx))*
            (1.0+cos(2.0*PI*x2/ly))*(1.0+cos(2.0*PI*x3/lz));
        }
        else {
          pGrid->U[k][j][i].M3 = amp*(ran2(&iseed) - 0.5)*
            (1.0+cos(2.0*PI*x3/lz));
	}
        if (x3 > 0.0) {
	  pGrid->U[k][j][i].d = rhoh;
          pGrid->U[k][j][i].M3 *= rhoh;
          pGrid->U[k][j][i].E = (1.0/Gamma - 0.1*rhoh*x3)/Gamma_1;
	}
	pGrid->U[k][j][i].E+=0.5*SQR(pGrid->U[k][j][i].M3)/pGrid->U[k][j][i].d;
#ifdef MHD
        switch(iprob){
        case 3: /* B only in light fluid, do not add B^2 to E, total P const */
          if (x3 <= 0.0) {
            pGrid->B1i[k][j][i] = b0;
            if (i == ie) pGrid->B1i[k][j][ie+1] = b0;
            pGrid->U[k][j][i].B1c = b0;
          }
          break;
        case 4: /* discontinuous rotation of B by angle at interface */
          if (x3 <= 0.0) {
            pGrid->B1i[k][j][i] = b0;
            if (i == ie) pGrid->B1i[k][j][ie+1] = b0;
            pGrid->U[k][j][i].B1c = b0;
            pGrid->U[k][j][i].E += 0.5*b0*b0;
          }
          else {
            pGrid->B1i[k][j][i] = b0*cos(angle);
            pGrid->B2i[k][j][i] = b0*sin(angle);
            if (i == ie) pGrid->B1i[k][j][ie+1] = b0*cos(angle);
            if (j == je) pGrid->B2i[k][je+1][i] = b0*sin(angle);
            pGrid->U[k][j][i].B1c = b0*cos(angle);
            pGrid->U[k][j][i].B2c = b0*sin(angle);
            pGrid->U[k][j][i].E += 0.5*b0*b0;
          }
          break;
        case 5: /* rotation of B by angle over distance L_rot at interface */
          if (x3 <= (-L_rot/2.0)) {
            pGrid->B1i[k][j][i] = b0;
            if (i == ie) pGrid->B1i[k][j][ie+1] = b0;
            pGrid->U[k][j][i].B1c = b0;
            pGrid->U[k][j][i].E += 0.5*b0*b0;
          }
          else if (x3 >= (L_rot/2.0)) {
            pGrid->B1i[k][j][i] = b0*cos(angle);
            pGrid->B2i[k][j][i] = b0*sin(angle);
            if (i == ie) pGrid->B1i[k][j][ie+1] = b0*cos(angle);
            if (j == je) pGrid->B2i[k][je+1][i] = b0*sin(angle);
            pGrid->U[k][j][i].B1c = b0*cos(angle);
            pGrid->U[k][j][i].B2c = b0*sin(angle);
            pGrid->U[k][j][i].E += 0.5*b0*b0;
          }
          else {
            fact = ((L_rot/2.0)+x3)/L_rot;
            pGrid->B1i[k][j][i] = b0*cos(fact*angle);
            pGrid->B2i[k][j][i] = b0*sin(fact*angle);
            if (i == ie) pGrid->B1i[k][j][ie+1] = b0*cos(fact*angle);
            if (j == je) pGrid->B2i[k][je+1][i] = b0*sin(fact*angle);
            pGrid->U[k][j][i].B1c = b0*cos(fact*angle);
            pGrid->U[k][j][i].B2c = b0*sin(fact*angle);
            pGrid->U[k][j][i].E += 0.5*b0*b0;
          }

          break;
        default:
          pGrid->B1i[k][j][i] = b0;
          if (i == ie) pGrid->B1i[k][j][ie+1] = b0;
          pGrid->U[k][j][i].B1c = b0;
          pGrid->U[k][j][i].E += 0.5*b0*b0;
        }
#endif
      }
    }
  }

/* Enroll gravitational potential to give accn in z-direction for 3D
 * Use special boundary condition routines.  In 3D, gravity is in the
 * z-direction, so special boundary conditions needed for x3
 */

  StaticGravPot = grav_pot3;

  //if (pDomain->Disp[2] == 0) bvals_mhd_fun(pDomain, left_x3,  reflect_ix3);
  //if (pDomain->MaxX[2] == pDomain->RootMaxX[2])
  //  bvals_mhd_fun(pDomain, right_x3, reflect_ox3);

  } /* end of 3D initialization */

  return;
}
Example #16
0
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;
}
Example #17
0
void problem(DomainS *pDomain)
{
  GridS *pGrid = pDomain->Grid;
  int i=0,j=0,k=0;
  int is,ie,js,je,ks,ke,iprob;
  Real amp,drat,vflow,b0,a,sigma,x1,x2,x3;
  long int iseed = -1;
  static int frst=1;  /* flag so new history variables enrolled only once */

  is = pGrid->is; ie = pGrid->ie;
  js = pGrid->js; je = pGrid->je;
  ks = pGrid->ks; ke = pGrid->ke;

/* Read problem parameters */

  iprob = par_geti("problem","iprob");
  vflow = par_getd("problem","vflow");
  drat = par_getd("problem","drat");
  amp = par_getd("problem","amp");
#ifdef MHD
  b0  = par_getd("problem","b0");
#endif

/* iprob=1.  Two uniform streams moving at +/- vflow, random perturbations */

  if (iprob == 1) {
    for (k=ks; k<=ke; k++) {
      for (j=js; j<=je; j++) {
        for (i=is; i<=ie; i++) {
          cc_pos(pGrid,i,j,k,&x1,&x2,&x3);
          pGrid->U[k][j][i].d = 1.0;
          pGrid->U[k][j][i].M1 = vflow + amp*(ran2(&iseed) - 0.5);
          pGrid->U[k][j][i].M2 = amp*(ran2(&iseed) - 0.5);
          pGrid->U[k][j][i].M3 = 0.0;
          if (fabs(x2) < 0.25) {
  	    pGrid->U[k][j][i].d = drat;
            pGrid->U[k][j][i].M1 = -drat*(vflow + amp*(ran2(&iseed) - 0.5));
            pGrid->U[k][j][i].M2 = drat*amp*(ran2(&iseed) - 0.5);
          }
/* Pressure scaled to give a sound speed of 1 with gamma=1.4 */
#ifndef BAROTROPIC
          pGrid->U[k][j][i].E = 2.5/Gamma_1
             + 0.5*(SQR(pGrid->U[k][j][i].M1) + SQR(pGrid->U[k][j][i].M2)
             + SQR(pGrid->U[k][j][i].M3))/pGrid->U[k][j][i].d;
#endif /* BAROTROPIC */
#ifdef MHD
          pGrid->B1i[k][j][i] = b0;
          pGrid->U[k][j][i].B1c = b0;
#ifndef BAROTROPIC
          pGrid->U[k][j][i].E += 0.5*b0*b0;
#endif /* BAROTROPIC */
#endif /* MHD */
        }
#ifdef MHD
      pGrid->B1i[k][j][ie+1] = b0;
#endif
      }
    }
  }

/* iprob=2.  Test suggested by E. Zweibel, based on Ryu & Jones.
 * Two uniform density flows with single mode perturbation
 */

  if (iprob == 2) {
    a = 0.05;
    sigma = 0.2;
    for (k=ks; k<=ke; k++) {
      for (j=js; j<=je; j++) {
        for (i=is; i<=ie; i++) {
          cc_pos(pGrid,i,j,k,&x1,&x2,&x3);
          pGrid->U[k][j][i].d = 1.0;
          pGrid->U[k][j][i].M1 = vflow*tanh(x2/a);
          pGrid->U[k][j][i].M2 = amp*sin(2.0*PI*x1)*exp(-(x2*x2)/(sigma*sigma));
          pGrid->U[k][j][i].M3 = 0.0;
#ifndef BAROTROPIC
          pGrid->U[k][j][i].E = 1.0/Gamma_1
             + 0.5*(SQR(pGrid->U[k][j][i].M1) + SQR(pGrid->U[k][j][i].M2)
             + SQR(pGrid->U[k][j][i].M3))/pGrid->U[k][j][i].d;
#endif /* BAROTROPIC */
#ifdef MHD
          pGrid->B1i[k][j][i] = b0;
          pGrid->U[k][j][i].B1c = b0;
#ifndef BAROTROPIC
          pGrid->U[k][j][i].E += 0.5*b0*b0;
#endif /* BAROTROPIC */
#endif /* MHD */
/* Use passive scalar to keep track of the fluids, since densities are same */
#if (NSCALARS > 0)
          pGrid->U[k][j][i].s[0] = 0.0;
          if (x2 > 0) pGrid->U[k][j][i].s[0] = 1.0;
#endif
        }
#ifdef MHD
      pGrid->B1i[k][j][ie+1] = b0;
#endif
      }
    }
  }

/* iprob=3.  Test in SR paper, based on iprob=2
 */

  if (iprob == 3) {
    a = 0.01;
    sigma = 0.1;
    for (k=ks; k<=ke; k++) {
      for (j=js; j<=je; j++) {
        for (i=is; i<=ie; i++) {
          cc_pos(pGrid,i,j,k,&x1,&x2,&x3);
          pGrid->U[k][j][i].d = 0.505 + 0.495*tanh((fabs(x2)-0.5)/a);
          pGrid->U[k][j][i].M1 = vflow*tanh((fabs(x2)-0.5)/a);
          pGrid->U[k][j][i].M2 = amp*vflow*sin(2.0*PI*x1)
               *exp(-((fabs(x2)-0.5)*(fabs(x2)-0.5))/(sigma*sigma));
          if (x2 < 0.0) pGrid->U[k][j][i].M2 *= -1.0;
          pGrid->U[k][j][i].M1 *= pGrid->U[k][j][i].d;
          pGrid->U[k][j][i].M2 *= pGrid->U[k][j][i].d;
          pGrid->U[k][j][i].M3 = 0.0;
#ifndef BAROTROPIC
          pGrid->U[k][j][i].E = 1.0/Gamma_1
             + 0.5*(SQR(pGrid->U[k][j][i].M1) + SQR(pGrid->U[k][j][i].M2)
             + SQR(pGrid->U[k][j][i].M3))/pGrid->U[k][j][i].d;
#endif /* BAROTROPIC */
#ifdef MHD
          pGrid->B1i[k][j][i] = b0;
          pGrid->U[k][j][i].B1c = b0;
#ifndef BAROTROPIC
          pGrid->U[k][j][i].E += 0.5*b0*b0;
#endif /* BAROTROPIC */
#endif /* MHD */
        }
#ifdef MHD
      pGrid->B1i[k][j][ie+1] = b0;
#endif
      }
    }
  }

/* With viscosity and/or resistivity, read diffusion coeffs */

#ifdef RESISTIVITY
  eta_Ohm = par_getd_def("problem","eta_O",0.0);
  Q_Hall  = par_getd_def("problem","Q_H",0.0);
  Q_AD    = par_getd_def("problem","Q_AD",0.0);
#endif
#ifdef VISCOSITY
  nu_iso = par_getd_def("problem","nu_iso",0.0);
  nu_aniso = par_getd_def("problem","nu_aniso",0.0);
#endif

/* enroll new history variables, only once  */

  if (frst == 1) {
#ifdef MHD
    dump_history_enroll(hst_Bx, "<Bx>");
    dump_history_enroll(hst_By, "<By>");
    dump_history_enroll(hst_Bz, "<Bz>");
#endif /* MHD */
    frst = 0;
  }

}