/* transforms u^i to our ks from boyer-lindquist */ void kstobl(int ii, int jj, FTYPE*ucon) { FTYPE tmp[NDIM]; FTYPE trans[NDIM][NDIM]; FTYPE X[NDIM], r, th; int j,k; coord(ii,jj,CENT,X) ; bl_coord(X,&r,&th) ; // just inverse (no transpose) of above #define ks2bl_trans00 (1) #define ks2bl_trans01 (-2.*r/(r*r - 2.*r + a*a)) #define ks2bl_trans02 (0) #define ks2bl_trans03 (0) #define ks2bl_trans10 (0) #define ks2bl_trans11 (1) #define ks2bl_trans12 (0) #define ks2bl_trans13 (0) #define ks2bl_trans20 (0) #define ks2bl_trans21 (0) #define ks2bl_trans22 (1) #define ks2bl_trans23 (0) #define ks2bl_trans30 (0) #define ks2bl_trans31 (-a/(r*r - 2.*r + a*a)) #define ks2bl_trans32 (0) #define ks2bl_trans33 (1) /* make transform matrix */ // order for trans is [ourmetric][bl] // DLOOP trans[j][k] = 0. ; // DLOOPA trans[j][j] = 1. ; trans[0][0] = ks2bl_trans00; trans[0][1] = ks2bl_trans01; trans[0][2] = ks2bl_trans02; trans[0][3] = ks2bl_trans03; trans[1][0] = ks2bl_trans10; trans[1][1] = ks2bl_trans11; trans[1][2] = ks2bl_trans12; trans[1][3] = ks2bl_trans13; trans[2][0] = ks2bl_trans20; trans[2][1] = ks2bl_trans21; trans[2][2] = ks2bl_trans22; trans[2][3] = ks2bl_trans23; trans[3][0] = ks2bl_trans30; trans[3][1] = ks2bl_trans31; trans[3][2] = ks2bl_trans32; trans[3][3] = ks2bl_trans33; /* transform ucon; solve for v */ // this is u^j = T^j_k u^k DLOOPA tmp[j] = 0.; DLOOP tmp[j] += trans[j][k] * ucon[k]; DLOOPA ucon[j] = tmp[j]; /* done! */ }
/* * returns sqrt(-g) for the Kerr metric in the * modified Kerr Schild coordinates. * Does not assume if gcov has been set first or not. */ double gdet_func(const double X[NDIM], double gcov_local[NDIM][NDIM]) { #ifdef MINK return 1.0 ; #endif /* MINK */ #ifdef KS double sth,cth,s2,rho2 ; double r,th ; double tfac,rfac,hfac,pfac ; bl_coord(X,&r,&th) ; cth = cos(th) ; sth = fabs(sin(th)) ; if (sth<SMALL) sth=SMALL ; s2 = sth*sth ; rho2 = r*r + a*a*cth*cth ; tfac = 1. ; rfac = r - R0 ; hfac = M_PI + (1. - hslope)*M_PI*cos(2.*M_PI*X[2]) ; pfac = 1. ; return rho2*sth*tfac*rfac*hfac*pfac; #endif /* KS */ }
int avg2_content(int i, int j, int k, MPI_Datatype datatype,void *writebuf) { int pl = 0, l = 0, col = 0; struct of_geom geom; FTYPE X[NDIM],V[NDIM]; FTYPE ftemp; coord(i, j, k, CENT, X); bl_coord(X, V); get_geometry(i, j, k, CENT, &geom); // if you change # of outputted vars, remember to change numcolumns above if(!GAMMIEDUMP){ ftemp=(FTYPE)(i+startpos[1]); myset(datatype,&ftemp,0,1,writebuf); ftemp=(FTYPE)(j+startpos[2]); myset(datatype,&ftemp,0,1,writebuf); ftemp=(FTYPE)(k+startpos[3]); myset(datatype,&ftemp,0,1,writebuf); } myset(datatype,X,1,3,writebuf); myset(datatype,V,1,3,writebuf); myset(datatype,&geom.g,0,1,writebuf); // 10 myset(datatype,tudtavg[i][j][k],0,NUMSTRESSTERMS,writebuf); myset(datatype,atudtavg[i][j][k],0,NUMSTRESSTERMS,writebuf); // 112*2 // total=10+112*2=234 return(0); }
void gcon_func(const double X[NDIM], double gcov_local[NDIM][NDIM], double gcon_local[NDIM][NDIM]) { int j,k ; #ifdef MINK DLOOP { if(j==k) { if(j == 0) gcon_local[j][k] = -1. ; else gcon_local[j][k] = 1. ; } else gcon_local[j][k] = 0. ; } #endif /* MINK */ #ifdef KS double sth,cth,s2,rho2, rho2i; double r,th ; double tfaci,rfaci,hfaci,pfaci ; DLOOP gcon_local[j][k] = 0. ; bl_coord(X,&r,&th) ; cth = cos(th) ; sth = fabs(sin(th)) ; if (sth<SMALL) sth=SMALL ; s2 = sth*sth ; rho2 = r*r + a*a*cth*cth ; rho2i = 1./rho2 ; tfaci = 1. ; rfaci = 1./(r - R0) ; hfaci = 1./(M_PI + (1. - hslope)*M_PI*cos(2.*M_PI*X[2])) ; pfaci = 1. ; gcon_local[TT][TT] = -(r*(r+2.)+a*a*cth*cth) * rho2i * tfaci*tfaci ; gcon_local[TT][RR] = 2.*r * rho2i * tfaci*rfaci ; gcon_local[TT][TH] = 0. * rho2i * tfaci*hfaci ; gcon_local[TT][PH] = 0. * rho2i * tfaci*pfaci ; gcon_local[RR][TT] = gcon_local[TT][RR] ; gcon_local[RR][RR] = (r*(r-2.)+a*a) * rho2i * rfaci*rfaci ; gcon_local[RR][TH] = 0. * rho2i * rfaci*hfaci ; gcon_local[RR][PH] = a * rho2i * rfaci*pfaci ; gcon_local[TH][TT] = gcon_local[TT][TH] ; gcon_local[TH][RR] = gcon_local[RR][TH] ; gcon_local[TH][TH] = 1. * rho2i * hfaci*hfaci ; gcon_local[TH][PH] = 0. * rho2i * hfaci*pfaci ; gcon_local[PH][TT] = gcon_local[TT][PH] ; gcon_local[PH][RR] = gcon_local[RR][PH] ; gcon_local[PH][TH] = gcon_local[TH][PH] ; gcon_local[PH][PH] = (1./s2) * rho2i * pfaci*pfaci ; #endif /* KS */ }
int avg_content(int i, int j, int k, MPI_Datatype datatype,void *writebuf) { int pl = 0, l = 0, col = 0; struct of_geom geom; FTYPE X[NDIM],V[NDIM]; FTYPE ftemp; coord(i, j, k, CENT, X); bl_coord(X, V); get_geometry(i, j, k, CENT, &geom); if(!GAMMIEDUMP){ ftemp=(FTYPE)(i+startpos[1]); myset(datatype,&ftemp,0,1,writebuf); ftemp=(FTYPE)(j+startpos[2]); myset(datatype,&ftemp,0,1,writebuf); ftemp=(FTYPE)(k+startpos[3]); myset(datatype,&ftemp,0,1,writebuf); } myset(datatype,X,1,3,writebuf); myset(datatype,V,1,3,writebuf); myset(datatype,&geom.g,0,1,writebuf); // now do time average stuff myset(datatype,normalvarstavg[i][j],0,NUMNORMDUMP,writebuf); myset(datatype,anormalvarstavg[i][j],0,NUMNORMDUMP,writebuf); #if(CALCFARADAYANDCURRENTS) myset(datatype,jcontavg[i][j],0,NDIM,writebuf); myset(datatype,jcovtavg[i][j],0,NDIM,writebuf); myset(datatype,ajcontavg[i][j],0,NDIM,writebuf); myset(datatype,ajcovtavg[i][j],0,NDIM,writebuf); #endif myset(datatype,massfluxtavg[i][j],0,NDIM,writebuf); myset(datatype,amassfluxtavg[i][j],0,NDIM,writebuf); myset(datatype,othertavg[i][j],0,NUMOTHER,writebuf); myset(datatype,aothertavg[i][j],0,NUMOTHER,writebuf); #if(CALCFARADAYANDCURRENTS) myset(datatype,fcontavg[i][j],0,NUMFARADAY,writebuf); myset(datatype,fcovtavg[i][j],0,NUMFARADAY,writebuf); myset(datatype,afcontavg[i][j],0,NUMFARADAY,writebuf); myset(datatype,afcovtavg[i][j],0,NUMFARADAY,writebuf); #endif #if(DOAVG2==0) myset(datatype,tudtavg[i][j],0,NUMSTRESSTERMS,writebuf); myset(datatype,atudtavg[i][j],0,NUMSTRESSTERMS,writebuf); #endif return(0); }
/* transforms u^i to our ks from boyer-lindquist */ void bltoks(int ii, int jj, FTYPE*ucon) { FTYPE tmp[NDIM]; FTYPE trans[NDIM][NDIM]; FTYPE X[NDIM], r, th; int j,k; coord(ii,jj,CENT,X) ; bl_coord(X,&r,&th) ; // bl2ks for contravariant components #define bl2ks_trans00 (1) #define bl2ks_trans01 (2.*r/(r*r - 2.*r + a*a)) #define bl2ks_trans02 (0) #define bl2ks_trans03 (0) #define bl2ks_trans10 (0) #define bl2ks_trans11 (1) #define bl2ks_trans12 (0) #define bl2ks_trans13 (0) #define bl2ks_trans20 (0) #define bl2ks_trans21 (0) #define bl2ks_trans22 (1) #define bl2ks_trans23 (0) #define bl2ks_trans30 (0) #define bl2ks_trans31 (a/(r*r - 2.*r + a*a)) #define bl2ks_trans32 (0) #define bl2ks_trans33 (1) /* make transform matrix */ // order for trans is [ourmetric][bl] // DLOOP trans[j][k] = 0. ; // DLOOPA trans[j][j] = 1. ; trans[0][0] = bl2ks_trans00; trans[0][1] = bl2ks_trans01; trans[0][2] = bl2ks_trans02; trans[0][3] = bl2ks_trans03; trans[1][0] = bl2ks_trans10; trans[1][1] = bl2ks_trans11; trans[1][2] = bl2ks_trans12; trans[1][3] = bl2ks_trans13; trans[2][0] = bl2ks_trans20; trans[2][1] = bl2ks_trans21; trans[2][2] = bl2ks_trans22; trans[2][3] = bl2ks_trans23; trans[3][0] = bl2ks_trans30; trans[3][1] = bl2ks_trans31; trans[3][2] = bl2ks_trans32; trans[3][3] = bl2ks_trans33; /* transform ucon; solve for v */ // this is u^j = T^j_k u^k DLOOPA tmp[j] = 0.; DLOOP tmp[j] += trans[j][k] * ucon[k]; DLOOPA ucon[j] = tmp[j]; /* done! */ }
/* Boyer-Lindquist ("bl") metric functions */ void blgset(int i, int j, int k, struct of_geom *geom) { double r,th,phi,X[NDIM] ; coord(i,j,k,CENT,X) ; bl_coord(X,&r,&th,&phi) ; if(th < 0) th *= -1. ; if(th > M_PI) th = 2.*M_PI - th ; geom->g = bl_gdet_func(r,th,phi) ; bl_gcov_func(r,th,phi,geom->gcov) ; bl_gcon_func(r,th,phi,geom->gcon) ; }
void image(int image_cnt, int which, int scale, int limits) { int i = 0, j = 0, l = 0, col = 0; FILE *fp; char ifnam[MAXFILENAME]; // which : which primitive variable SFTYPE pr,iq, liq, aa, lmax, lmin; FTYPE X[NDIM],r,th; FTYPE min,max,sum; FTYPE minptr[NPR], maxptr[NPR], sumptr[NPR]; int jonhead; #if(USEMPI) void *jonio; int ndims, array_of_gsizes[4], array_of_distribs[4]; int order, len; int array_of_dargs[4], array_of_psizes[4]; int bufcount, array_size; #endif void *writebuf; unsigned char *realbuf; char truemyidtxt[MAXFILENAME]; FTYPE (*pimage)[N2+4][NPR]; //////////////////////////// // // Image output setup/definition // //////////////////////////// pimage=ph; if(limits==ZOOM){ ZLOOP{ if(which<=1){ coord(i,j,CENT,X); bl_coord(X,&r,&th); if(which==0) pimage[i][j][which]=p[i][j][which]/(RHOMIN*pow(r,-1.5)); if(which==1) pimage[i][j][which]=p[i][j][which]/(UUMIN*pow(r,-2.5)); } else{ if(scale==LINEAR) pimage[i][j][which]=p[i][j][which]; else if(scale==LOG) pimage[i][j][which]=fabs(p[i][j][which])+MINVECTOR; } } }
// prime MCOORD -> MCOORD void metptomet(int ii, int jj, FTYPE*ucon) { int j,k; FTYPE r, th, X[NDIM]; FTYPE dxdxp[NDIM][NDIM]; FTYPE tmp[NDIM]; coord(ii, jj, CENT, X); bl_coord(X, &r, &th); dxdxprim(X, r, th, dxdxp); /* transform ucon */ // this is u^j = T^j_k u^k, as in above DLOOPA tmp[j] = 0.; DLOOP tmp[j] += dxdxp[j][k] * ucon[k]; DLOOPA ucon[j] = tmp[j]; /* done! */ }
// MCOORD -> prime MCOORD void mettometp(int ii, int jj, FTYPE*ucon) { int j,k; FTYPE r, th, X[NDIM]; FTYPE dxdxp[NDIM][NDIM]; FTYPE idxdxp[NDIM][NDIM]; FTYPE tmp[NDIM]; coord(ii, jj, CENT, X); bl_coord(X, &r, &th); dxdxprim(X, r, th, dxdxp); // actually gcon_func() takes inverse of first arg and puts result into second arg. matrix_inverse(dxdxp,idxdxp); /* transform ucon */ // this is u^j = (iT)^j_k u^k, as in mettobl() above DLOOPA tmp[j] = 0.; DLOOP tmp[j] += idxdxp[j][k] * ucon[k]; DLOOPA ucon[j] = tmp[j]; // note that u_{k,BL} = u_{j,KSP} (iT)^j_k // note that u_{k,KSP} = u_{j,BL} T^j_k // note that u^{j,BL} = T^j_k u^{k,KSP} // (T) called ks2bl in grmhd-transforms.nb // note that u^{j,KSP} = (iT)^j_k u^{k,BL} // (iT) called bl2ks in grmhd-transforms.nb // So T=BL2KSP for covariant components and KSP2BL for contravariant components // and (iT)=BL2KSP for contra and KSP2BL for cov // where here T=dxdxp and (iT)=idxdxp (not transposed, just inverse) /* done! */ }
//returns negative value on error int avg2d_content(int i, int j, int k, FILE *outfp, FTYPE (*vars)[N1M][N2M][1], int numcols) { int pl = 0, l = 0, col = 0; struct of_geom geom; FTYPE X[NDIM],V[NDIM]; FTYPE ftemp; char fmt[] = "%21.15g "; int res; if( k != 0 ) { dualfprintf( fail_file, "avg2d_content: k = %d but should always be zero\n", k ); myexit(111); } coord(i, j, k, CENT, X); bl_coord(X, V); get_geometry(i, j, k, CENT, &geom); /////////////////////////////////// // // LINE HEADER // /////////////////////////////////// //absolute i, j res = fprintf( outfp, fmt, (FTYPE)(i+startpos[1]) ); if( res > 0 ) { res = fprintf( outfp, fmt, (FTYPE)(j+startpos[2]) ); } //x1, x2 for( l = 1; l < 3 && res > 0; l++ ) { res = fprintf( outfp, fmt, X[l] ); } //r, th for( l = 1; l < 3 && res > 0; l++ ) { res = fprintf( outfp, fmt, V[l]); } if( res > 0 ) { //sqrt(-g) res = fprintf( outfp, fmt, geom.g ); } /////////////////////////////////// // // DUMP CONTENT // /////////////////////////////////// //assume all array elements set for( col = 0; col < numcols && res > 0; col++ ) { res = fprintf( outfp, fmt, vars[col][i][j][0] ); } if( res > 0 ) { //finish off line res = fprintf( outfp, "\n" ); } return( res ); }
int dump_content(int i, int j, int k, MPI_Datatype datatype,void *writebuf) { int pl; FTYPE r, th, vmin[NDIM], vmax[NDIM]; int ignorecourant; struct of_geom geom; struct of_state q; FTYPE X[NDIM],V[NDIM]; FTYPE divb; FTYPE b[NDIM],ucon[NDIM]; FTYPE U[NPR]; FTYPE ftemp; FTYPE jcov[NDIM]; FTYPE fcov[NUMFARADAY]; FTYPE rho,u,pressure,cs2,Sden; int dir,l,m,n,o; ////////////// // // some calculations // coord(i, j, k, CENT, X); bl_coord(X, V); // if failed, then data output for below invalid, but columns still must exist get_geometry(i, j, k, CENT, &geom); if (!failed) { if (get_state(pdump[i][j][k], &geom, &q) >= 1) FAILSTATEMENT("dump.c:dump()", "get_state() dir=0", 1); if (vchar(pdump[i][j][k], &q, 1, &geom, &vmax[1], &vmin[1],&ignorecourant) >= 1) FAILSTATEMENT("dump.c:dump()", "vchar() dir=1or2", 1); if (vchar(pdump[i][j][k], &q, 2, &geom, &vmax[2], &vmin[2],&ignorecourant) >= 1) FAILSTATEMENT("dump.c:dump()", "vchar() dir=1or2", 2); if (vchar(pdump[i][j][k], &q, 3, &geom, &vmax[3], &vmin[3],&ignorecourant) >= 1) FAILSTATEMENT("dump.c:dump()", "vchar() dir=1or2", 3); } else {// do a per zone check, otherwise set to 0 whocalleducon=1; // force no failure mode, just return like failure, and don't return if failure, just set to 0 and continue if (get_state(pdump[i][j][k], &geom, &q) >= 1){ for (pl = 0; pl < NDIM; pl++) q.ucon[pl]=0; for (pl = 0; pl < NDIM; pl++) q.ucov[pl]=0; for (pl = 0; pl < NDIM; pl++) q.bcon[pl]=0; for (pl = 0; pl < NDIM; pl++) q.bcov[pl]=0; } if (vchar(pdump[i][j][k], &q, 1, &geom, &vmax[1], &vmin[1],&ignorecourant) >= 1){ vmax[1]=vmin[1]=0; } if (vchar(pdump[i][j][k], &q, 2, &geom, &vmax[2], &vmin[2],&ignorecourant) >= 1){ vmax[2]=vmin[2]=0; } if (vchar(pdump[i][j][k], &q, 3, &geom, &vmax[3], &vmin[3],&ignorecourant) >= 1){ vmax[3]=vmin[3]=0; } whocalleducon=0; // return to normal state } setfdivb(&divb, pdump, udump, i, j, k); // udump also set externally GODMARK ////////////////////////// // // do the assignments // // if you change # of outputted vars, remember to change numcolumns //static if(!GAMMIEDUMP){ ftemp=(FTYPE)(i+startpos[1]); myset(datatype,&ftemp,0,1,writebuf); ftemp=(FTYPE)(j+startpos[2]); myset(datatype,&ftemp,0,1,writebuf); ftemp=(FTYPE)(k+startpos[3]); myset(datatype,&ftemp,0,1,writebuf); } myset(datatype,X,1,3,writebuf); myset(datatype,V,1,3,writebuf); // 9 //////////////////////// // // rest dynamic // primitives // must use PDUMPLOOP() since may be any order unlike NPR loop PDUMPLOOP(pl) myset(datatype,&(pdump[i][j][k][pl]),0,1,writebuf); // NPRDUMP //////////// // // output some EOS stuff since in general not simple function of rho0,u rho = pdump[i][j][k][RHO]; u = pdump[i][j][k][UU]; pressure = pressure_rho0_u(rho,u); cs2 = cs2_compute(rho,u); Sden = compute_entropy(rho,u); // dUdtau = compute_qdot(rho,u); myset(datatype,&pressure,0,1,writebuf); // 1 myset(datatype,&cs2,0,1,writebuf); // 1 myset(datatype,&Sden,0,1,writebuf); // 1 // myset(datatype,&dUdtau,0,1,writebuf); // 1 ////////////////////// // // output the conserved quantities since not easily inverted and at higher order aren't invertable from point primitives PDUMPLOOP(pl) myset(datatype,&(udump[i][j][k][pl]),0,1,writebuf); // NPRDUMP myset(datatype,&divb,0,1,writebuf); // 1 for (pl = 0; pl < NDIM; pl++) myset(datatype,&(q.ucon[pl]),0,1,writebuf); for (pl = 0; pl < NDIM; pl++) myset(datatype,&(q.ucov[pl]),0,1,writebuf); for (pl = 0; pl < NDIM; pl++) myset(datatype,&(q.bcon[pl]),0,1,writebuf); for (pl = 0; pl < NDIM; pl++) myset(datatype,&(q.bcov[pl]),0,1,writebuf); // 4*4 myset(datatype,&vmin[1],0,1,writebuf); myset(datatype,&vmax[1],0,1,writebuf); myset(datatype,&vmin[2],0,1,writebuf); myset(datatype,&vmax[2],0,1,writebuf); myset(datatype,&vmin[3],0,1,writebuf); myset(datatype,&vmax[3],0,1,writebuf); // 6 // one static term myset(datatype,&geom.g,0,1,writebuf); // 1 #if(CALCFARADAYANDCURRENTS) // NIM*2+6*2 = 8+12=20 // updated 11/16/2003 // new 10/23/2003 // current density lower_vec(jcon[i][j][k],&geom,jcov); myset(datatype,jcon[i][j][k],0,NDIM,writebuf); // (NDIM) myset(datatype,jcov,0,NDIM,writebuf);// (NDIM) // faraday (2*6) lowerf(fcon[i][j][k],&geom,fcov); myset(datatype,fcon[i][j][k],0,NUMFARADAY,writebuf); // (6) myset(datatype,fcov,0,NUMFARADAY,writebuf); // (6) #endif if(FLUXB==FLUXCTSTAG && 0){ // DEBUG (change corresponding code in dump.c) // uses jrdp3dudebug in gtwod.m that assumes CALCFARADAYANDCURRENTS==0 for(l=1;l<=COMPDIM;l++) myset(datatype,gp_l[l][i][j][k],0,NPR2INTERP,writebuf); // 3*8 = 24 for(l=1;l<=COMPDIM;l++) myset(datatype,gp_r[l][i][j][k],0,NPR2INTERP,writebuf); // 3*8 = 24 myset(datatype,pstagscratch[i][j][k],0,NPR,writebuf); // 8 for(dir=1;dir<=COMPDIM;dir++) for(pl=B1;pl<=B3;pl++) for(n=0;n<=1;n++) myset(datatype,&pbcorninterp[dir][pl][n][i][j][k],0,1,writebuf); // 3*3*2 = 18 for(dir=1;dir<=COMPDIM;dir++) for(pl=U1;pl<=U3;pl++) for(n=0;n<=1;n++) for(o=0;o<=1;o++) myset(datatype,&pvcorninterp[dir][pl][n][o][i][j][k],0,1,writebuf); // 3*3*2*2 = 36 } return (0); }
// unnormalized density int init_dsandvels(int *whichvel, int*whichcoord, int i, int j, FTYPE *pr) { extern int EBtopr(FTYPE *E,FTYPE *B,struct of_geom *geom, FTYPE *pr); extern int EBtopr_2(FTYPE *E,FTYPE *B,struct of_geom *geom, FTYPE *pr); void vbtopr(FTYPE *vcon,FTYPE *bcon,struct of_geom *geom, FTYPE *pr); void computeKK(FTYPE *pr, struct of_geom *geom, FTYPE *KK); void EBvetatopr(FTYPE *Econ, FTYPE *Bcon, FTYPE *veta, struct of_geom *geom, FTYPE *pr); FTYPE X[NDIM],r,th; struct of_geom geom; int k; FTYPE E[NDIM],B[NDIM]; FTYPE x0,dx0; FTYPE bcon[NDIM],vcon[NDIM],econ[NDIM]; FTYPE phi0; FTYPE KK; FTYPE B0; FTYPE muf; coord(i, j, CENT, X); bl_coord(X, &r, &th); get_geometry(i, j, CENT, &geom); // true coordinate system pr[RHO]=pr[UU]=0; pr[U1]=pr[U2]=pr[U3]=0.0; pr[B2]=pr[B3]=0; pr[B1]=0; #if(TESTNUMBER==0) // Fast wave tf = 1; DTd=tf/10.0; // tf = 1; // DTd=1E-5; E[1]=0; E[2]=0; B[3]=0.0; B[1]=0.0; x0=0.0; dx0=0.1; if(r-x0<=-dx0) B[2]=1.0; else if((r-x0>-dx0)&&(r-x0<dx0)) B[2]=1.0-(0.3/(2.0*dx0))*((r-x0)+dx0); else if(r-x0>=dx0) B[2]=0.7; muf=1.0; E[3]=1.0-muf*B[2]; // for(k=1;k<=3;k++) E[k]=-E[k]; // switch for GRFFE formulation sign convention EBtopr(E,B,&geom,pr); //EBtopr_2(E,B,&geom,pr); // pr[U1]=0.9; //dualfprintf(fail_file,"pr[U1]=%21.15g pr[U2]=%21.15g\n",pr[U1],pr[U2]); computeKK(pr,&geom,&KK); dualfprintf(fail_file,"i=%d KK=%21.15g\n",i,KK); #endif #if(TESTNUMBER==1) // comoving Fast wave (NOT a Komissarov test) //tf = 1; // DTd=tf/10.0; tf = 1; DTd=1E-5; bcon[3]=0.0; bcon[1]=0.0; x0=0.0; dx0=0.1; if(r-x0<=-dx0) bcon[2]=1.0; else if((r-x0>-dx0)&&(r-x0<dx0)) bcon[2]=1.0-(0.3/(2.0*dx0))*((r-x0)+dx0); else if(r-x0>=dx0) bcon[2]=0.7; // for(k=1;k<=3;k++) E[k]=-E[k]; // switch for GRFFE formulation sign convention vcon[1]=0.9999; vcon[2]=vcon[3]=0; vbtopr(vcon,bcon,&geom,pr); computeKK(pr,&geom,&KK); dualfprintf(fail_file,"i=%d KK=%21.15g\n",i,KK); #endif #if(TESTNUMBER==2) // (nondegenerate) Alfven wave tf = 2; DTd=tf/10.0; bcon[1]=bcon[2]=1.0; x0=0.0; if(r-x0<=-0.1) bcon[3]=1.0; else if((r-x0>-0.1)&&(r-x0<0.1)) bcon[3]=1.0+3.0/2.0*((r-x0)+0.1); else if(r-x0>=0.1) bcon[3]=1.3; econ[2]=econ[3]=0.0; // can be + or - //#define CONSTECON1 1.3 // econ[1]=-sqrt(-CONSTECON1+bcon[1]*bcon[1]+bcon[2]*bcon[3]+bcon[3]*bcon[3]); // econ[1]=1-0.5*bcon[3]; #define CONSTECON1 1.0 econ[1]=sqrt(-CONSTECON1 + bcon[3]*bcon[3]); // econ[1]=0.0; // econ[1]=-bcon[3]; vcon[1]=-0.5; vcon[2]=vcon[3]=0; EBvetatopr(econ, bcon, vcon, &geom, pr); // vbtopr(vcon,bcon,&geom,pr); computeKK(pr,&geom,&KK); dualfprintf(fail_file,"i=%d KK=%21.15g\n",i,KK); #endif #if(TESTNUMBER==3) // Degenerate Alfven wave tf = 2; DTd=tf/10.0; bcon[1]=0.0; x0=0.0; if(r-x0<=-0.1) phi0=0.0; else if((r-x0>-0.1)&&(r-x0<0.1)) phi0=5.0/2.0*M_PI*((r-x0)+0.1); else if(r-x0>=0.1) phi0=M_PI*0.5; bcon[2]=2.0*cos(phi0); bcon[3]=2.0*sin(phi0); vcon[1]=0.5; vcon[2]=vcon[3]=0; vbtopr(vcon,bcon,&geom,pr); computeKK(pr,&geom,&KK); dualfprintf(fail_file,"i=%d KK=%21.15g\n",i,KK); #endif #if(TESTNUMBER==4) // Three-wave problem tf = .75; DTd=tf/10.0; x0=0.5; if(r<x0){ B[1]=1.0; B[2]=1.5; B[3]=3.5; E[1]=-1.0; E[2]=-0.5; E[3]=0.5; } else{ B[1]=1.0; B[2]=2.0; B[3]=2.3; E[1]=-1.5; E[2]=1.3; E[3]=-0.5; } // for(k=1;k<=3;k++) E[k]=-E[k]; // switch for GRFFE formulation sign convention EBtopr(E,B,&geom,pr); //EBtopr_2(E,B,&geom,pr); computeKK(pr,&geom,&KK); dualfprintf(fail_file,"i=%d KK=%21.15g\n",i,KK); #endif #if(TESTNUMBER==5) // B^2-E^2<0 problem tf = .02; DTd=tf/10.0; x0=0.5; if(r<x0){ B[0]=0.0; B[1]=1.0; B[2]=1.0; B[3]=1.0; E[0]=0.0; E[1]=0.0; E[2]=0.5; E[3]=-0.5; } else{ B[0]=0.0; B[1]=1.0; B[2]=-1.0; B[3]=-1.0; E[0]=0.0; E[1]=0.0; E[2]=0.5; E[3]=-0.5; } // for(k=1;k<=3;k++) E[k]=-E[k]; // switch for GRFFE formulation sign convention EBtopr(E,B,&geom,pr); //EBtopr_2(E,B,&geom,pr); computeKK(pr,&geom,&KK); dualfprintf(fail_file,"i=%d KK=%21.15g\n",i,KK); #endif #if(TESTNUMBER==6) // smoothed B^2-E^2<0 problem tf = .02; DTd=tf/10.0; x0=0.5; if(r-x0<-0.1){ B[1]=1.0; B[2]=1.0; B[3]=1.0; E[1]=0.0; E[2]=0.5; E[3]=-0.5; } else if(r-x0>0.1){ B[1]=1.0; B[2]=-1.0; B[3]=-1.0; E[1]=0.0; E[2]=0.5; E[3]=-0.5; } else if((r-x0>=-0.1)&&(r-x0<=0.1)){ B[1]=1.0; B[2]=1.0+(r-x0+0.1)*(-2.0/0.2); B[3]=1.0+(r-x0+0.1)*(-2.0/0.2); E[1]=0.0; E[2]=0.5; E[3]=-0.5; } // for(k=1;k<=3;k++) E[k]=-E[k]; // switch for GRFFE formulation sign convention EBtopr(E,B,&geom,pr); //EBtopr_2(E,B,&geom,pr); computeKK(pr,&geom,&KK); dualfprintf(fail_file,"i=%d KK=%21.15g\n",i,KK); #endif #if(TESTNUMBER==7) // Komissarov 2004 C3.1 Alfven wave // PARA generates crap on left side, but wave doesn't move // MC does very well // no obvious difference between HLL and LAXF // Athena1/2 ok tf = 2.0; DTd=tf/10.0; // B[1]=B[2]=E[3]=E[2]=0; B[1]=B[2]=E[3]=1.0; E[2]=0; if(r<=0.5){ B[3]=1.0; } else if(r>=0.2+0.5){ B[3]=1.3; } else{ B[3]=1.0+0.15*(1.0+sin(5.0*M_PI*(r-0.1-0.5))); } E[1]=-B[3]; // for(k=1;k<=3;k++) E[k]=-E[k]; // switch for GRFFE formulation sign convention EBtopr(E,B,&geom,pr); //EBtopr_2(E,B,&geom,pr); computeKK(pr,&geom,&KK); dualfprintf(fail_file,"i=%d KK=%21.15g\n",i,KK); #endif #if(TESTNUMBER==8) // Komissarov 2004 C3.2 Current Sheet tf = 1.0; DTd=tf/10.0; E[1]=E[2]=E[3]=0.0; B[3]=0.0; B[1]=1.0; //B0=0.5; // fine B0 = 2.0; if(r<=0.5){ B[2]=B0; } else{ B[2]=-B0; } EBtopr(E,B,&geom,pr); //EBtopr_2(E,B,&geom,pr); computeKK(pr,&geom,&KK); dualfprintf(fail_file,"i=%d KK=%21.15g\n",i,KK); #endif *whichvel=WHICHVEL; *whichcoord=PRIMECOORDS; return(0); }
/* insert metric here: */ void gcov_func(const double X[NDIM], double gcov_local[NDIM][NDIM]) { int j,k ; /* * chose metric/coordinates: Minkowski or Kerr-Schild */ #ifdef MINK DLOOP { if(j==k) { if(j == 0) gcov_local[j][k] = -1. ; else gcov_local[j][k] = 1. ; } else gcov_local[j][k] = 0. ; } #endif /* MINK */ #ifdef KS double sth,cth,s2,rho2 ; double r,th ; double tfac,rfac,hfac,pfac ; DLOOP gcov_local[j][k] = 0. ; bl_coord(X,&r,&th) ; cth = cos(th) ; sth = fabs(sin(th)) ; if (sth<SMALL) sth=SMALL ; s2 = sth*sth ; rho2 = r*r + a*a*cth*cth ; tfac = 1. ; rfac = r - R0 ; hfac = M_PI + (1. - hslope)*M_PI*cos(2.*M_PI*X[2]) ; pfac = 1. ; gcov_local[TT][TT] = (-1. + 2.*r/rho2) * tfac*tfac ; gcov_local[TT][RR] = (2.*r/rho2) * tfac*rfac ; gcov_local[TT][TH] = 0. * tfac*hfac ; gcov_local[TT][PH] = (-2.*a*r*s2/rho2) * tfac*pfac ; gcov_local[RR][TT] = gcov_local[TT][RR] ; gcov_local[RR][RR] = (1. + 2.*r/rho2) * rfac*rfac ; gcov_local[RR][TH] = 0. * rfac*hfac ; gcov_local[RR][PH] = (-a*s2*(1. + 2.*r/rho2)) * rfac*pfac ; gcov_local[TH][TT] = gcov_local[TT][TH] ; gcov_local[TH][RR] = gcov_local[RR][TH] ; gcov_local[TH][TH] = rho2 * hfac*hfac ; gcov_local[TH][PH] = 0. * hfac*pfac ; gcov_local[PH][TT] = gcov_local[TT][PH] ; gcov_local[PH][RR] = gcov_local[RR][PH] ; gcov_local[PH][TH] = gcov_local[TH][PH] ; gcov_local[PH][PH] = s2*(rho2 + a*a*s2*(1. + 2.*r/rho2)) * pfac*pfac ; #endif /* KS */ }
int mnewt(int ntrial, FTYPE x[], int n, FTYPE tolx, FTYPE tolf) { int i = 0, j = 0, k = 0; FTYPE errx=1E30, errf=1E30, d; FTYPE lasterrx,lasterrf; FTYPE dampfactor,dampfactorchange; static int firstc = 1; static int *indx; static FTYPE **fjac, *fvec, *pp,*xold; // debug stuff static long count = 0; static long lastnstep = 0; static long calls = 0; // debug stuff static FTYPE *startx,*startfvec; int usrfunreturn; struct of_geom geom; int lowtol[2]={0,0}; // 0=errx, 1=errf FTYPE X[NDIM],r,th; #if(DEBUG==2) FTYPE trialvalue[MAXTRIAL][NPR]; FTYPE trialerr[MAXTRIAL][2]; FILE * out; #endif int truetrialnum=0; int donesincechange; static int DODAMP; FTYPE abstol=(NUMEPSILON*50.0); // near machine precision int allownewdamp,numstabletot,countstable,numdampedtot,countdamped; int dampdeath; long int mnewtstepfail; int mnewtifail,mnewtjfail,mnewtpartialstepfail; FTYPE tolfallowed,tolxallowed,tolfreport,tolxreport; FTYPE normf; #if(DEBUG) calls++; #endif tolfallowed=tolxallowed=1E-4; tolfreport=tolxreport=tolf*1.E3; // for debug purposes mnewtstepfail=9198; mnewtifail=0; mnewtjfail=63; mnewtpartialstepfail=0; // settings DODAMP=2; dampfactor=1.0; dampfactorchange=0.5; donesincechange=0; dampdeath=0; // for DODAMP==2 allownewdamp=0; // start fresh numstabletot=5; numdampedtot=5; countstable=0; countdamped=0; #if(DEBUGPOINT) if((myid==2)&&(icurr+startpos[1]==mnewtifail)&&(jcurr+startpos[2]==mnewtjfail)&&(realnstep==mnewtstepfail)&&(partialstep==mnewtpartialstepfail)){ DODAMP=2; // testing, works well, turn on the if just inside the ntrial loop // DODAMP=1; } #endif if (firstc) { firstc = 0; indx = ivector(1, n); pp = dvector(1, n); xold = dvector(1, n); startx = dvector(1, n); startfvec = dvector(1, n); fvec = dvector(1, n); fjac = dmatrix(1, n, 1, n); } // save guess for debugging #if(DEBUG) for (i = 1; i <= n; i++){ startx[i]=x[i]; #if(DEBUG==2) trialvalue[truetrialnum][i-1]=x[i]; #endif } #endif // initially for (i = 1; i <= n; i++) xold[i]=x[i]; for (k = 1; k <= ntrial; k++) { truetrialnum++; nstroke++; // determine error in f, conserved quantities usrfunreturn=usrfun(x, n, fvec, fjac,&normf); #if(DEBUG) for(i=1;i<=n;i++){ startfvec[i]=fvec[i]; } #endif if (usrfunreturn>=1){ // fix up the damping if we get a psychotic solution errf=1.E30; errx=1.E30; failed=0; // force no failure condition } else{ // estimate error normally errf = 0.0; for (i = 1; i <= n; i++) errf += fabs(fvec[i]); errf/=normf; // renormalize since truly U (conserved quantity) has no better significance than this error if (errf <= abstol) lowtol[1]=2; else if (errf <= tolf) lowtol[1]=1; else lowtol[1]=0; } // now fix x (primitive variables) if(((DODAMP==1)||(DODAMP==2)&&(allownewdamp))&&(k>1)&&(lasterrf<errf)){ // only consider if damped failed when using damping odd/even trial // if we are here, the error actually increased // if increased, lower damp factor and back up countdamped++; // coming here counts as a general damped run if(countdamped>=numdampedtot){ allownewdamp=0; countdamped=0; countstable=0;} donesincechange=0; dampfactor*=dampfactorchange; dampdeath=0; // how hard do we want to make the code try for the highest precision (damping)? if((dampfactor<1E-5)&&(errf<tolf*100.0)){ // then we'll assume this is good enough and any smaller dampfactor won't get us much less error dampdeath=1; } else if(dampfactor<1E-7){ if(debugfail>=1){ dualfprintf(fail_file,"mnewt: ok, we really need something better\n: dampfactor: %g errf: %g\n",dampfactor,errf); } dampdeath=1; // let the bottom non-convergence criterea handle things } if(dampdeath==0){ for (i = 1; i <= n; i++) x[i]=xold[i]; k--; // want absolute number of trials to be fixed } } else{ // then error is decreasing or first trial, good! So let's continue changing x //if(donesincechange==5) dampfactor/=dampfactorchange; donesincechange++; if(allownewdamp==0) countstable++; if(allownewdamp) countdamped++; // coming here counts as a general damped run //else countstable++; // then counts as stable run if(countstable>=numstabletot){ allownewdamp=1; countdamped=0; countstable=0;} if(countdamped>=numdampedtot){ allownewdamp=0; countdamped=0; countstable=0;} lasterrf=errf; // save old x to go back to it for (i = 1; i <= n; i++) xold[i]=x[i]; for (i = 1; i <= n; i++) pp[i] = -fvec[i]; ludcmp(fjac, n, indx, &d); lubksb(fjac, n, indx, pp); // DAMP (faster to damp every other one) // if(DODAMP) for (i = 1; i <= n; i++) pp[i] = dampfactor*pp[i]; /////// // evaluate x error (already properly normalized since directly what we seek) /////// errx = 0.0; for (i = 1; i <= n; i++) { errx += fabs(pp[i]); x[i] += pp[i]; } if (errx <= abstol) lowtol[0]=2; else if (errx <= tolx) lowtol[0]=1; else lowtol[0]=0; }// else if error decreased #if(DEBUGPOINT) //if((myid==2)&&(icurr+startpos[1]==mnewtifail)&&(jcurr+startpos[2]==mnewtjfail)&&(realnstep==mnewtstepfail)&&(partialstep==mnewtpartialstepfail)){ // if (errf <=1E-20){ //for (i = 1; i <= n; i++) dualfprintf(fail_file,"wtf: true=%d k=%d errx=%21.15g pp[%d]=%25.17g\n",truetrialnum, k, errx,i,pp[i]); // } //} #endif #if(DEBUG==2) // some debug stuff, done every trial type for (i = 1; i <= n; i++) { trialvalue[truetrialnum][i-1]=x[i]; } if(truetrialnum>MAXTRIAL){ dualfprintf(fail_file,"oops! %d %d\n",truetrialnum,MAXTRIAL); fflush(fail_file); myexit(1);} trialerr[truetrialnum-1][0]=errf; trialerr[truetrialnum-1][1]=errx; #endif if(dampdeath) break; // problem with damping, too strong, etc. // tolerance conditions if((lowtol[0]==2)||(lowtol[1]==2)) break; // end immediately since we are unable to go further anyways below machine precision else if((lowtol[0]==1)&&(lowtol[1]==1)) break; // then exactly what we wanted // if 0 0 or 1 0 or 0 1, then continue to try to find better solution }// over trials /////////////////////////////// // // done with MNEWT, now debug stuff comes // /////////////////////////////// // see what's going on #if(DEBUGPOINT) if((myid==2)&&(icurr+startpos[1]==mnewtifail)&&(jcurr+startpos[2]==mnewtjfail)&&(realnstep==mnewtstepfail)&&(partialstep==mnewtpartialstepfail)){ dualfprintf(fail_file,"trueerrx=%25.17g trueerrf=%25.17g\n",errx,errf); errf=1E30; errx=1E30; lowtol[1]=0; lowtol[0]=0; // pretend } #endif // some counting on this run of mnewt, failed or not #if(DEBUG) if (lastnstep < nstep) { fprintf(log_file,"#1 count/zone: %g calls: %g\n", ((FTYPE) count) / ((FTYPE) (N1 * N2)), ((FTYPE)calls) / ((FTYPE)(N1 * N2))); fflush(log_file); fprintf(log_file,"count: %ld zones: %d calls: %d\n", count,N1 * N2,calls); fflush(log_file); mpildsum0(&count,0); mpildsum0(&calls,0); /* myfprintf(stderr,"count: %ld zones: %d calls: %d\n", count,totalzones,calls); fflush(log_file); */ myfprintf(logfull_file,"#1 count/zone: %g calls: %g\n", ((FTYPE) count) / ((FTYPE) (totalzones)),((FTYPE) calls) / ((FTYPE)(totalzones))); myfprintf(stderr,"#1 count/zone: %g calls: %g\n", ((FTYPE) count) / ((FTYPE) (totalzones)),((FTYPE) calls) / ((FTYPE)(totalzones))); count = (long)(k - 1); lastnstep = nstep; calls = 0; } else { count += (long)(k - 1); } #endif // determine if can leave or not if((lowtol[0]>=1)&&(lowtol[1]>=1)) return(0); // otherwise we didn't reach tolerances we wanted note that both // tolerances are asked for, not just one or the other, since one // variable may have low error but the other high error, and that's // not what we want. We want both to be low. //////////////////////////////////// // // rest of this is error analysis (i.e. failure, or acceptable failure) // // // if we got here, we never converged to desired tolerance in the specified maximum number of trials // only report if pseudo-bad convergence i.e. not near limits since that produces too much data if ((errf >= tolfreport)||(errx >= tolxreport)) { if(debugfail>=2){ dualfprintf(fail_file,"proc: %d, t=%25.17g realnstep=%ld\nmnewt didn't converge (k=%d true=%d): i=%d j=%d, errf: %g errx: %g dampfactor: %g\n",myid,t,realnstep, k, truetrialnum, startpos[1]+icurr,startpos[2]+jcurr,errf,errx,dampfactor); } } // assume won't fail if not too bad convergence if <=1E-4 if ((errf <= tolfallowed)&&(errx<=tolxallowed)) { return (0); // for now } else{ // if >1E-4, then something is wrong #if(DEBUG) if(debugfail>=1){ dualfprintf(fail_file, "mnewt: (k=%d truetrialnum=%d) failure\n", k,truetrialnum); } if(debugfail>=2){ // COMMENT // if failed, probably went outside allowed solution given constraints // placed on p. How can this occur when U and p are related? Is U somehow // more flexible? coord(icurr,jcurr,CENT,X); bl_coord(X,&r,&th); get_geometry(icurr,jcurr,CENT,&geom); dualfprintf(fail_file,"i=%d j=%d \nx1=%25.17g x2=%25.17g \nr=%25.17g th=%25.17g \ng=%25.17g\n",startpos[1]+icurr,startpos[2]+jcurr,X[1],X[2],r,th,geom.g); dualfprintf(fail_file,"x->%25.17g``20, y->%25.17g``20\n",X[1],X[2]); for(i=1;i<=n;i++) { dualfprintf(fail_file, "startfvec[%d]=%25.17g startx[%d]=%25.17g x[%d]=%25.17g\n",i,startfvec[i],i,startx[i],i,x[i]); } for(i=1;i<=n;i++){ for(j=1;j<=n;j++){ dualfprintf(fail_file, "fjac[%d][%d]=%25.17g ",i,j,fjac[i][j]); } dualfprintf(fail_file,"\n"); } #endif #if(DEBUG==2) #if(0) dualfprintf(fail_file,"mnewt={"); for(i=0;i<n;i++){ // seperately for each primitive variable dualfprintf(fail_file,"{"); for(j=0;j<truetrialnum+1;j++){ dualfprintf(fail_file,"%25.17g``20 ",trialvalue[j][i]); if(j<truetrialnum-1) dualfprintf(fail_file,","); } dualfprintf(fail_file,"}\n"); if(i<n-1) dualfprintf(fail_file,","); } dualfprintf(fail_file,"};\n"); dualfprintf(fail_file,"mnewterr={"); for(i=0;i<=1;i++){ // seperately for each primitive variable dualfprintf(fail_file,"{"); for(j=0;j<truetrialnum;j++){ dualfprintf(fail_file,"%25.17g``20 ",trialerr[j][i]); if(j<truetrialnum-1) dualfprintf(fail_file,","); } dualfprintf(fail_file,"}\n"); if(i<1) dualfprintf(fail_file,","); } dualfprintf(fail_file,"};\n"); #else out=fopen("mnewtvaluelist.txt","wt"); if(out==NULL){ fprintf(stderr,"cannot open mnewtvaluelist.txt\n"); exit(1);} for(j=0;j<truetrialnum+1;j++){ for(i=0;i<n;i++) { fprintf(out,"%25.17g ",trialvalue[j][i]); } fprintf(out,"\n"); } fclose(out); out=fopen("mnewterrlist.txt","wt"); if(out==NULL){ fprintf(stderr,"cannot open mnewterrlist.txt\n"); exit(1);} for(j=0;j<truetrialnum;j++){ for(i=0;i<2;i++) { fprintf(out,"%25.17g ",trialerr[j][i]); } fprintf(out,"\n"); } fclose(out); #endif #endif //failed = 3; // source of failure (nonconvergence) } FAILSTATEMENT("mnewt.c", "convergence", 1); } }
int imagedefs(int whichpl, int scale, int limits, int vartype) { int i = 0, j = 0, k = 0, l = 0, col = 0, floor; FILE *fp; // whichpl : whichpl primitive variable FTYPE pr,iq, liq, lmax; unsigned char liqb; FTYPE min,max,sum; FTYPE minptr[NPR], maxptr[NPR], sumptr[NPR]; char truemyidtxt[MAXFILENAME]; FTYPE U[NPR]; struct of_geom geom; struct of_state q; FTYPE X[NDIM],V[NDIM],r,th; FTYPE lmin,aa; int compute_vorticity(FTYPE (*p)[N2M][N3M][NPR],FTYPE (*pvort)[N2M][N3M][NPR],int whichpl); int pl; //////////////////////////// // // Image output setup/definition // // Purpose is to set pimage to correct variable type (primitive or conservative), limits, scale, and which k. // Then image() outputs that one thing to file // //////////////////////////// pimage=dUgeomarray; // assume dUgeomarray is only used within each substep and not across substeps if(limits==ZOOM){ // zoom in on dynamic range of values to see fine details DUMPGENLOOP{ // diagnostic loop if(vartype==0){ if(whichpl<=1){ coord(i,j,k,CENT,X); bl_coord(X,V); r=V[1]; th=V[2]; if(whichpl==0) pimage[i][j][k][whichpl]=p[i][j][k][whichpl]/(RHOMIN*pow(r,-1.5)); if(whichpl==1) pimage[i][j][k][whichpl]=p[i][j][k][whichpl]/(UUMIN*pow(r,-2.5)); } else{ if(scale==LINEAR) pimage[i][j][k][whichpl]=p[i][j][k][whichpl]; else if(scale==LOG) pimage[i][j][k][whichpl]=fabs(p[i][j][k][whichpl])+MINVECTOR; } } else if(vartype==1){// conserved quantity // computes too much (all conserved quantites every time) if(DOENOFLUX == NOENOFLUX){ get_geometry(i,j,k,CENT,&geom) ; if(!failed){ if(get_state(p[i][j][k],&geom,&q)>=1) return(1); if(primtoU(UDIAG,p[i][j][k],&q,&geom,U)>=1) return(1); } } else{ PALLLOOP(pl) U[pl]=udump[i][j][k][pl]; } if(scale==LINEAR) pimage[i][j][k][whichpl]=U[whichpl]; else if(scale==LOG) pimage[i][j][k][whichpl]=fabs(U[whichpl]/geom.g)+MINVECTOR; } else if(vartype==2){ // failure quantity (no diff from below right now -- could zoom in on single failure regions) if(whichpl<NUMFAILFLOORFLAGS){ floor=whichpl; if(scale==LINEAR) pimage[i][j][k][whichpl]=(FTYPE)failfloorcount[i][j][k][IMAGETS][floor]; else if(scale==LOG) pimage[i][j][k][whichpl]=fabs((FTYPE)failfloorcount[i][j][k][IMAGETS][floor]+1); } } } }
int gdump_content(int i, int j, int k, MPI_Datatype datatype, void *writebuf) { int pl = 0, l = 0, m = 0, n = 0, col = 0; FTYPE X[NDIM],V[NDIM]; FTYPE ftemp; FTYPE *ptrftemp; FTYPE dxdxp[NDIM][NDIM]; int myii,myjj,mykk; coord(i, j, k, CENT, X); bl_coord(X, V); dxdxprim(X, V, dxdxp); ftemp=(FTYPE)(i+startpos[1]); myset(datatype,&ftemp,0,1,writebuf); ftemp=(FTYPE)(j+startpos[2]); myset(datatype,&ftemp,0,1,writebuf); ftemp=(FTYPE)(k+startpos[3]); myset(datatype,&ftemp,0,1,writebuf); // 3 myset(datatype,X,1,3,writebuf); myset(datatype,V,1,3,writebuf); // 6 #if(MCOORD!=CARTMINKMETRIC) myii=i; myjj=j; mykk=k; #else myii=0; myjj=0; mykk=0; #endif ptrftemp=(FTYPE*)(&conn[myii][myjj][mykk][0][0][0]); myset(datatype,ptrftemp,0,NDIM*NDIM*NDIM,writebuf); ptrftemp=(FTYPE*)(&gcon[myii][myjj][mykk][CENT][0][0]); myset(datatype,ptrftemp,0,NDIM*NDIM,writebuf); ptrftemp=(FTYPE*)(&gcov[myii][myjj][mykk][CENT][0][0]); myset(datatype,ptrftemp,0,NDIM*NDIM,writebuf); ptrftemp=(FTYPE*)(&gdet[myii][myjj][mykk][CENT]); //ptrftemp=(FTYPE*)(&gdetvol[myii][myjj][mykk][CENT]); // can take a peek if GDETVOLDIFF==1 myset(datatype,ptrftemp,0,1,writebuf); ptrftemp=(FTYPE*)(&conn2[myii][myjj][mykk][0]); myset(datatype,ptrftemp,0,NDIM,writebuf); // 4*4 ptrftemp=(FTYPE*)(&dxdxp[0][0]); myset(datatype,ptrftemp,0,NDIM*NDIM,writebuf); return(0); }
void conn_func(const double X[NDIM], const struct of_geom *geom, double gamma[NDIM][NDIM][NDIM]) { #ifdef MINK int i,j,k ; for(i=0;i<NDIM;i++) for(j=0;j<NDIM;j++) for(k=0;k<NDIM;k++) gamma[i][j][k] = 0. ; #endif /* MINK */ #ifdef KS #define SQ(x) ((x)*(x)) #define CUBE(x) ((x)*(x)*(x)) #define FOURTH(x) ((x)*(x)*(x)*(x)) #define FIFTH(x) ((x)*(x)*(x)*(x)*(x)) #define SIXTH(x) ((x)*(x)*(x)*(x)*(x)*(x)) double sth,cth,s2,c2; double r,th ; double tfac,rfac,hfac,pfac ; double tfaci,rfaci,hfaci,pfaci ; double Pi, Delta ; double Sigma, Sigmai, Sigmai2, Sigmai3 ; double longcoefficient, longcoefficient2, longcoefficient3 ; double longcoefficient4, longcoefficient5, longcoefficient6 ; double a2,a3,a4,a5; double r2,r3,r4,r5; double rfacprime, hfacprime; bl_coord(X,&r,&th) ; a2=SQ(a); a3=CUBE(a); a4=FOURTH(a); a5=FIFTH(a); r2=SQ(r); r3=CUBE(r); r4=FOURTH(r); r5=FIFTH(r); cth = cos(th) ; sth = fabs(sin(th)) ; if (sth<SMALL) sth=SMALL ; s2 = SQ(sth) ; c2 = SQ(cth) ; Sigma = r2 + a2 * c2 ; Sigmai = 1./ Sigma ; Sigmai2 = SQ(Sigmai) ; Sigmai3 = CUBE(Sigmai) ; Pi = r2 - a2 * c2 ; Delta = r2 +a2 -2.*r ; longcoefficient = (r5+r*a4*FOURTH(cth)-a2*r2*s2+c2*(2.*a2*r3+a4*s2)) ; longcoefficient2 = (a4*c2*(2.*c2-1.) +a2*r2*s2-2.*r*Pi-r4) ; longcoefficient4 = (a2*c2*(2*r2+a2*c2) +2.*a2*r*s2+2.*r*Sigma+r4) ; longcoefficient3 = (r3+r4-a2*r*c2-FOURTH(a*cth)) ; longcoefficient5 = SIXTH(r)+SIXTH(a*cth) + a2*r3*(4.+r)*s2 + 2.*a4*r*FOURTH(sth)+ FOURTH(cth)*(3.*a4*r2+SIXTH(a)*s2)+ a2*r*c2*(3.*r3+2.*a2*(r+2.)*s2) ; longcoefficient6 = SQ(Sigma)/sth + a2*r*2.*sth ; tfac = 1. ; rfac = r - R0 ; hfac = M_PI + (1. - hslope)*M_PI*cos(2.*M_PI*X[2]) ; pfac = 1. ; tfaci = 1. ; rfaci = 1./ rfac ; hfaci = 1./ hfac ; pfaci = 1. ; rfacprime = 1. ; hfacprime = (2. * SQ(M_PI) * (hslope - 1.) * sin(2.*M_PI*X[2]) )/ hfac ; gamma[TT][TT][TT] = 2.*r*Pi*Sigmai3 *tfac ; gamma[TT][TT][RR] = Pi*(Sigma+2.*r)*Sigmai3 *rfac ; gamma[TT][TT][TH] = -2.*a2*r*cth*sth*Sigmai2 *hfac ; gamma[TT][TT][PH] = -2.*a*r*Pi*s2*Sigmai3 *pfac ; gamma[TT][RR][TT] = gamma[TT][TT][RR] ; gamma[TT][RR][RR] = 2.* longcoefficient3*Sigmai3 *tfaci*rfac*rfac ; gamma[TT][RR][TH] = -2.*a2*r*cth*sth*Sigmai2 *tfaci*rfac*hfac ; gamma[TT][RR][PH] = -a*Pi*(Sigma+2.*r)*s2*Sigmai3 *tfaci*rfac*pfac ; gamma[TT][TH][TT] = gamma[TT][TT][TH] ; gamma[TT][TH][RR] = gamma[TT][RR][TH] ; gamma[TT][TH][TH] = -2.*r2*Sigmai *tfaci*hfac*hfac ; gamma[TT][TH][PH] = 2.*CUBE(a*sth)*r*cth*Sigmai2 *tfaci*hfac*pfac ; gamma[TT][PH][TT] = gamma[TT][TT][PH] ; gamma[TT][PH][RR] = gamma[TT][RR][PH] ; gamma[TT][PH][TH] = gamma[TT][TH][PH] ; gamma[TT][PH][PH] = -2.*r*s2*longcoefficient*Sigmai3 *tfaci*pfac*pfac ; gamma[RR][TT][TT] = Delta*Pi*Sigmai3 *rfaci*tfac*tfac ; gamma[RR][TT][RR] = -Pi*(2.*r-a2*s2)*Sigmai3 *tfac ; gamma[RR][TT][TH] = 0. ; gamma[RR][TT][PH] = -a* Delta*Pi*s2 *Sigmai3 *rfaci*tfac*pfac ; gamma[RR][RR][TT] = gamma[RR][TT][RR] ; gamma[RR][RR][RR] = longcoefficient2 * Sigmai3*rfac + rfacprime ; gamma[RR][RR][TH] = -a2*sth*cth*Sigmai *hfac ; gamma[RR][RR][PH] = a*s2*(longcoefficient+2.*r*Pi)*Sigmai3 *pfac ; gamma[RR][TH][TT] = gamma[RR][TT][TH] ; gamma[RR][TH][RR] = gamma[RR][RR][TH] ; gamma[RR][TH][TH] = -r*Delta/Sigma *rfaci*hfac*hfac ; gamma[RR][TH][PH] = 0. ; gamma[RR][PH][TT] = gamma[RR][TT][PH] ; gamma[RR][PH][RR] = gamma[RR][RR][PH] ; gamma[RR][PH][TH] = gamma[RR][TH][PH] ; gamma[RR][PH][PH] = -longcoefficient*Delta*s2*Sigmai3 *rfaci*pfac*pfac ; gamma[TH][TT][TT] = -2.*a2*r*cth*sth*Sigmai3 *hfaci*tfac*tfac ; gamma[TH][TT][RR] = -2.*a2*r*cth*sth*Sigmai3 *hfaci*tfac*rfac ; gamma[TH][TT][TH] = 0. ; gamma[TH][TT][PH] = 2.*a*r*(a2+r2)*cth*sth*Sigmai3 *hfaci*tfac*pfac ; gamma[TH][RR][TT] = gamma[TH][TT][RR] ; gamma[TH][RR][RR] = -2.*a2*r*cth*sth*Sigmai3 *hfaci*rfac*rfac ; gamma[TH][RR][TH] = r*Sigmai *rfac ; gamma[TH][RR][PH] = a*cth*sth*longcoefficient4*Sigmai3 *hfaci*rfac*pfac ; gamma[TH][TH][TT] = gamma[TH][TT][TH] ; gamma[TH][TH][RR] = gamma[TH][RR][TH] ; gamma[TH][TH][TH] = -a2*cth*sth*Sigmai*hfac + hfacprime ; gamma[TH][TH][PH] = 0. ; gamma[TH][PH][TT] = gamma[TH][TT][PH] ; gamma[TH][PH][RR] = gamma[TH][RR][PH] ; gamma[TH][PH][TH] = gamma[TH][TH][PH] ; gamma[TH][PH][PH] = -cth*sth*longcoefficient5*Sigmai3 *hfaci*pfac*pfac ; gamma[PH][TT][TT] = a*Pi*Sigmai3 *pfaci*tfac*tfac ; gamma[PH][TT][RR] = a*Pi*Sigmai3 *pfaci*tfac*rfac ; gamma[PH][TT][TH] = -2.*a*r*cth*Sigmai2/sth *pfaci*tfac*hfac ; gamma[PH][TT][PH] = -a2*Pi*s2*Sigmai3 *tfac ; gamma[PH][RR][TT] = gamma[PH][TT][RR] ; gamma[PH][RR][RR] = a*Pi*Sigmai3 *pfaci*rfac*rfac ; gamma[PH][RR][TH] = -a*cth*(Sigma+2.*r)*Sigmai2/sth *pfaci*rfac*hfac ; gamma[PH][RR][PH] = longcoefficient*Sigmai3 *rfac ; gamma[PH][TH][TT] = gamma[PH][TT][TH] ; gamma[PH][TH][RR] = gamma[PH][RR][TH] ; gamma[PH][TH][TH] = -a*r*Sigmai *pfaci*hfac*hfac ; gamma[PH][TH][PH] = longcoefficient6 *cth*Sigmai2 *hfac ; gamma[PH][PH][TT] = gamma[PH][TT][PH] ; gamma[PH][PH][RR] = gamma[PH][RR][PH] ; gamma[PH][PH][TH] = gamma[PH][TH][PH] ; gamma[PH][PH][PH] = -longcoefficient*a*s2*Sigmai3 *pfac ; #undef SQ #undef CUBE #undef FOURTH #undef FIFTH #undef SIXTH #endif /* KS */ }