void free_preconditioner(struct preconditioner *precon, int id) { if (id == 0) { free_3d_array(precon->inverse_mass); for (int i = 0; i < precon->nlevels; ++i) { free_3d_array(precon->poisson_diag[i]); free_3d_array(precon->helmholtz_diag[i]); free_3d_array(precon->stiffsum_scale[i]); free_3d_array(precon->dirichlet_mask[i]); } } for (int i = 1; i < precon->nlevels; ++i) { if (precon->geom[i]) free_geometry(precon->geom[i]); if (precon->sendcounts[i]) free_int_array(precon->sendcounts[i]); if (precon->senddispls[i]) free_int_array(precon->senddispls[i]); } for (int i = 1; i < (2 * precon->nlevels - 1); ++i) if (precon->basis[i]) free_basis(precon->basis[i]); free_ptr_array(precon->basis, 0, NULL); free_ptr_array(precon->geom, 0, NULL); free_ptr_array(precon->poisson_diag, 0, NULL); free_ptr_array(precon->helmholtz_diag, 0, NULL); free_ptr_array(precon->stiffsum_scale, 0, NULL); free_ptr_array(precon->dirichlet_mask, 0, NULL); free_ptr_array(precon->sendcounts, 0, NULL); free_ptr_array(precon->senddispls, 0, NULL); free_int_array(precon->nmg); free_1d_array(precon->poisson_eigen_max); free_1d_array(precon->helmholtz_eigen_max); free(precon); }
void out_ktab(MeshS *pM, OutputS *pOut) { GridS *pGrid=pM->Domain[0][0].Grid; int i,nx1; FILE *pFile; char fmt[80],*fname,*plev=NULL,*pdom=NULL; char levstr[8],domstr[8]; Real *data=NULL; Real dmin, dmax, xworld; /* Add a white space to the format, setup format for integer zone columns */ if(pOut->dat_fmt == NULL){ sprintf(fmt," %%12.8e"); /* Use a default format */ } else{ sprintf(fmt," %s",pOut->dat_fmt); } /* compute 1D array of data */ data = OutData1(pGrid,pOut,&nx1); if (data == NULL) return; /* slice not in range of Grid */ minmax1(data,nx1,&dmin,&dmax); if((fname = ath_fname(plev,pM->outfilename,0,0,0,0, pOut->id,"tab")) == NULL){ ath_error("[output_tab]: Error constructing filename\n"); } pFile = fopen(fname,"a"); /* open filename */ if (pFile == NULL) { ath_error("[output_tab]: Unable to open tab file %s\n",fname); } /* write data */ if (pOut->num == 0) { for (i=0; i<nx1; i++) { fprintf(pFile,"%12d\t",pGrid->Disp[0]+i); } fprintf(pFile,"\n"); } for (i=0; i<nx1; i++) { fprintf(pFile,fmt,data[i]); fprintf(pFile,"\t"); } fprintf(pFile,"\n"); /* Compute and store global min/max, for output at end of run */ pOut->gmin = MIN(dmin,pOut->gmin); pOut->gmax = MAX(dmax,pOut->gmax); fclose(pFile); free_1d_array(data); /* Free the memory we malloc'd */ }
/* 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 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; }