/* 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 */
}
