Example #1
0
// assumes normalized density
int user1_init_atmosphere(int *whichvel, int*whichcoord,int i, int j, int k, FTYPE *pr)
{
  int pl,pliter;
  struct of_geom realgeomdontuse;
  struct of_geom *ptrrealgeom=&realgeomdontuse;
  FTYPE pratm[NPR];




  get_geometry(i, j, k, CENT, ptrrealgeom); // true coordinate system
  set_atmosphere(-1,WHICHVEL,ptrrealgeom,pratm); // set velocity in chosen WHICHVEL frame in any coordinate system

  if(pr[RHO]<pratm[RHO]){
    PLOOP(pliter,pl) pr[pl]=pratm[pl];
  }
  

  *whichvel=WHICHVEL;
  *whichcoord=PRIMECOORDS;
  return(0);


}
Example #2
0
/* put out other arrays, copy the parsers */
static void
others()
{
	extern int gen_lines;
	int c, i, j;
	int tmpline;

	finput = fopen(parser, "r");
	if (finput == NULL)
/*
 * TRANSLATION_NOTE  -- This is a message from yacc.
 *	This message is passed to error() function.
 *	This error message is issued when yacc can not find
 *	the parser to be copied.
 */
		error(gettext(
		"cannot find parser %s"),
		    parser);

	warray(L"yyr1", levprd, nprod);

	aryfil(temp1, nprod, 0);
					/* had_act[i] is either 1 or 0 */
	PLOOP(1, i)
		temp1[i] = ((prdptr[i+1] - prdptr[i]-2) << 1) | had_act[i];
	warray(L"yyr2", temp1, nprod);

	aryfil(temp1, nstate, -10000000);
	TLOOP(i)
		for (j = tstates[i]; j != 0; j = mstates[j])
			temp1[j] = tokset[i].value;
	NTLOOP(i)
		for (j = ntstates[i]; j != 0; j = mstates[j])
			temp1[j] = -i;
	warray(L"yychk", temp1, nstate);

	warray(L"yydef", defact, nstate);

	if ((fdebug = fopen(DEBUGNAME, "r")) == NULL)
		error("cannot open yacc.debug");
	while ((c = getwc(fdebug)) != EOF)
		(void) putwc(c, ftable);
	(void) fclose(fdebug);
	ZAPFILE(DEBUGNAME);

	if (gen_lines)
		(void) fprintf(ftable, "# line\t1 \"%s\"\n", parser);
	tmpline = 1;
	/* copy parser text */
	while ((c = getwc(finput)) != EOF) {
		if (c == '\n')
			tmpline++;
		if (c == L'$') {
			if ((c = getwc(finput)) != L'A')
				(void) putwc(L'$', ftable);
			else { /* copy actions */
				tmpline++;
				faction = fopen(ACTNAME, "r");
				if (faction == NULL)
/*
 * TRANSLATION_NOTE  -- This is a message from yacc.
 *	This message is passed to error() function.
 *	This error is issued when yacc can not open a
 *	temporary file to be used. You do not need to
 *	use the word 'tempfile'. You can translate it to
 *	mean 'temporary file'.
 */
					error(gettext(
					"cannot open action tempfile"));
				while ((c = getwc(faction)) != EOF)
					(void) putwc(c, ftable);
				(void) fclose(faction);
				if (gen_lines)
					(void) fprintf(ftable,
					    "\n# line\t%d \"%s\"",
					    tmpline,
					    parser);
				ZAPFILE(ACTNAME);
				c = getwc(finput);
			}
		}
		(void) putwc(c, ftable);
	}
	(void) fclose(ftable);
}
Example #3
0
/* auxiliary function required by mnewt */
int usrfun(FTYPE *U_target,FTYPE *pr0,int numnormterms,int whichcons, int primtoUcons, struct of_geom *ptrgeom, FTYPE *prguess, int n, FTYPE *beta, FTYPE **alpha,FTYPE*norm)
{
  static FTYPE **alpha5;
  FTYPE prstart[NPR];
  FTYPE *pr;
  static FTYPE U[NPR],U_curr[NPR];
  struct of_state q;
  int i, j, k;
  int pl,pliter;
  int failreturn=0;
  void removerow(int row, FTYPE **alpha5,FTYPE**alpha);
  static int firstc=1;

  if (firstc) {
    firstc = 0;
    alpha5 = dmatrix(1, 5, 1, 5);
  }


  pr=prguess+1;

  // Doing this constrained iteration may lead to non-convergence, but then we adjust U if that happens until we converge.

  // store old pr
  PLOOP(pliter,pl) prstart[pl]=pr[pl];

  // these checks seem to cause problems with convergence of any kind // GODMARK
  // we need to make sure densities are ok while iterating.
#if(WHICHVEL==VEL3)
  if(0&&jonchecks) fixup1zone(pr,ptrgeom,0);

  // once pr lead to imaginary u^t, state is invalid and U cannot be found.
  // Thus, need to adjust pr while iterating to keep pr in line
  // essentially we are doing a constrained damped Newton's method.
  if(0&&jonchecks) failreturn=check_pr(pr,pr0,ptrgeom,-100);
  if(0&&jonchecks) if(failreturn>=1)
                     FAILSTATEMENT("utoprim.c:usrfun()", "mnewt check:check_pr()", 2);

  // just check
  if(jonchecks) failreturn=check_pr(pr,pr0,ptrgeom,-2);
#endif



  if(!failreturn){

    // if didn't fail, we are guarenteed a good state and U.
    
    // problem here is that now pr is different and doesn't help
    // converge to Utarget, maybe kills possibility of convergence which
    // would later be just fixed at the end
    // so should probably adjust Utarget somehow to compensate for adjustment in pr.  Use dudp to fix U_target along the way
    
    /* normalize error = beta to \rho u^t */
    failreturn=get_state(pr, ptrgeom, &q);
    if(failreturn>=1)
      FAILSTATEMENT("utoprim.c:usrfun()", "get_state()", 1);

    failreturn=primtoU(primtoUcons,pr, &q, ptrgeom, U);

    // DEBUG:
    //    dualfprintf(fail_file,"nprlist: %d %d %d %d\n",nprstart,nprend,nprlist[nprstart],nprlist[nprend]);
    //    dualfprintf(fail_file,"1primtoUcons=%d ptrgeom.g=%21.15g\n",primtoUcons,ptrgeom->g);
    //    for (pl = 0; pl < INVERTNPR ; pl++)
    //      dualfprintf(fail_file,"pr[%d]=%21.15g U[%d]=%21.15g\n",pl,pr[pl],pl,U[pl]);


    if(failreturn>=1)
      FAILSTATEMENT("utoprim.c:usrfun()", "primtoU()", 1);

#if(EOMTYPE==EOMGRMHD||EOMTYPE==EOMENTROPYGRMHD)
    PLOOP(pliter,pl) U_curr[pl]=U[pl];
#elif(EOMTYPE==EOMFFDE)
    // convert from normal U to iterative U
    fixUtarget(WHICHFFDEINVERSION,U,U_curr);
#endif


    failreturn=dudp_calc(WHICHEOS, whichcons,GLOBALMAC(EOSextraglobal,ptrgeom->i,ptrgeom->j,ptrgeom->k),pr, &q, ptrgeom, alpha5);
    if(failreturn>=1)
      FAILSTATEMENT("utoprim.c:usrfun()", "dudp_calc()", 1);


    // convert from normal alpha to iterative alpha
#if(EOMTYPE==EOMGRMHD||EOMTYPE==EOMENTROPYGRMHD)
    for (j = 0; j < INVERTNPR ; j++){
      for (k = 0; k < INVERTNPR ; k++){
        alpha[j+1][k+1]=alpha5[j+1][k+1];
      }
    }    
#elif(EOMTYPE==EOMFFDE)

#if(WHICHFFDEINVERSION==0)
    removerow(U2,alpha5,alpha);
#elif(WHICHFFDEINVERSION==1)
    removerow(U1,alpha5,alpha);
#elif(WHICHFFDEINVERSION==2)
    removerow(UU,alpha5,alpha);
#endif

#endif

    /////////////////////
    //
    // normalize matrix
    //
    ////////////////////
#if(NORMMETHOD==-1)
    *norm=1.0;
#elif(NORMMETHOD==0)
    *norm=1.0/U_target[RHO];
#elif(NORMMETHOD==1)
    // more general normalization
    *norm=0.0;
    numnormterms=0;
    for (j = 0; j < INVERTNPR ; j++){
      for (k = 0; k < INVERTNPR ; k++){
        // GODMARK: correction:
        if(fabs(alpha[j + 1][k + 1])>NUMEPSILON){
          // old version (bug)
          //    if(alpha[j + 1][k + 1]>NUMEPSILON){
          *norm+=fabs(alpha[j + 1][k + 1]);
          numnormterms++;
        }
      }
    }
    *norm=(FTYPE)(numnormterms)/(*norm); // (i.e. inverse of average)

#endif
    
    for (j = 0; j < INVERTNPR ; j++)
      for (k = 0; k < INVERTNPR ; k++)
        alpha[j + 1][k + 1] *= (*norm);

    
    // below assumes alpha at U_curr isn't too different from at U_target
    // doesn't seem to work
    /*
      for (j = 0; j < INVERTNPR ; j++){
      for (k = 0; k < INVERTNPR ; k++){
      // should really use average alpha from initial pr and new pr, but try just new pr's dudp
      U_target[j]+=U_target[RHO]*alpha[j+1][k+1]*(pr[k]-prstart[k]);
      }
      }
    */   

    // determine normalized error
    for (k = 0; k < INVERTNPR ; k++)
      beta[k + 1] = (U_curr[k] - U_target[k]) *(*norm);


    // DEBUG:
    //    dualfprintf(fail_file,"primtoUcons=%d\n",primtoUcons);
    //    for (k = 0; k < INVERTNPR ; k++)
    //      dualfprintf(fail_file,"pr[%d]=%21.15g U_curr[%d]=%21.15g U_target[%d]=%21.15g\n",k,pr[k],k,U_curr[k],k,U_target[k]);
    

  }
  else{
    // error is huge if failed, a marker for failure
    for (k = 0; k < INVERTNPR ; k++)
      beta[k + 1] = 1.E30;
    
  }
  
  return (0);
}
Example #4
0
/* pr *MUST* contain initial guess */
int Utoprim(int whichcons, FTYPE *U, struct of_geom *ptrgeom, PFTYPE *lpflag, FTYPE *pr, FTYPE *pressure, struct of_newtonstats *newtonstats)
{
  FTYPE U_target[NPR];
  FTYPE pr0[NPR];
  int numnormterms;
  int primtoUcons;
  //
  FTYPE priter[NPR];
  FTYPE prguess[NPR];
  FTYPE tolx, tolf,tolxallowed, tolfallowed, tolxreport, tolfreport;
  int ntrial, mnewtfailed,mintrial;
  int pl,pliter;
  FTYPE Ustart[NPR];
  FTYPE dU[NPR];
  struct of_state q;
  int i,j,k,loc;
  int nutoprims,countutoprims;
  FTYPE frac,SUPERFRAC;
  int faildebug1(int numnormterms, int whichcons, FTYPE *U_target, FTYPE *EOSextra, FTYPE *pr0, struct of_geom *ptrgeom);
  int faildebug2(int numnormterms, int whichcons, FTYPE *U_target, FTYPE *EOSextra, FTYPE *pr0, struct of_geom *ptrgeom);
  void fixUtarget(int which,FTYPE *Ui,FTYPE *Uf);
  extern int mnewt(FTYPE *U_target,FTYPE *pr0,int numnormterms,int whichcons, int primtoUcons, struct of_geom *ptrgeom, int whethertoreport,int ntrial, int mintrial, FTYPE x[], int n, int startp, FTYPE tolx, FTYPE tolf, FTYPE tolxallowed, FTYPE tolfallowed, FTYPE tolxreport, FTYPE tolfreport, struct of_newtonstats *newtonstats);
  int usrfun(FTYPE *U_target,FTYPE *pr0,int numnormterms,int whichcons, int primtoUcons, struct of_geom *ptrgeom, FTYPE *prguess, int n, FTYPE *beta, FTYPE **alpha,FTYPE*norm);
  int Utoprim_nonrel(FTYPE *U, struct of_geom *ptrgeom, FTYPE *pr);
  FTYPE prnonrel[NPR];
  FTYPE prrel[NPR];
  int flagifnonrel;
  int whethertoreport;
  FTYPE bsq;
  int entropyversion;


  i=ptrgeom->i;
  j=ptrgeom->j;
  k=ptrgeom->k;
  loc=ptrgeom->p;


#if(EOMTYPE==EOMGRMHD||EOMTYPE==EOMENTROPYGRMHD)
#define INVERTNPR (5) // always same
#define STARTPINVERT (RHO) // where to start in primitive space
#elif(EOMTYPE==EOMCOLDGRMHD)
#define INVERTNPR (4) // always same
#define STARTPINVERT (RHO) // where to start in primitive space
  // need to skip UU if using this (SUPERGODMARK -- not done yet)
#elif(EOMTYPE==EOMFFDE)
#define INVERTNPR (3) // always same
#define STARTPINVERT (U1) // where to start in primitive space
#endif



  *lpflag= UTOPRIMNOFAIL; // set as no failure at first
  // assume normally do not want special messages
  whethertoreport=0;


  /////////////
  //
  // check (disabled since should allow negative density so RK can recover)
  //
  ////////////
  if(0&&( (EOMTYPE==EOMGRMHD||EOMTYPE==EOMENTROPYGRMHD)||(EOMTYPE==EOMCOLDGRMHD) )){ // don't check for now, just fail later
    if (U[RHO] < 0.) {
      if (fail(i,j,k,loc,FAIL_UTOPRIM_NEG) >= 1)
        return (1);
    }
  }
  
  ////////////////
  //
  // evolve B before (also better than initial guess)
  /* solution is known for B, so best guess is solution (from point of view of other variables) */
  //
  ///////////////
  for (pl = B1; pl <= B3; pl++) pr[pl] = U[pl];




  //////////////////////
  //
  // rest determines rho,u,u^i for GRMHD or u^i for FFDE
  //


#if(PRECISEINVERSION)
  ntrial = 200;
  mintrial = 3;
  tolx = tolf = 1.e-11; // 1E-11 is best mnewt() can do with DODAMP=2
  tolxallowed = tolfallowed = 1.e-8 ;
  tolxreport=1.e4*tolx;
  tolfreport=1.e4*tolf;
  
#else
  // choice
  ntrial = 20;
  mintrial=2;
  tolx = 1.e-10;
  tolf = 1.e-10;
  tolxallowed=tolfallowed=1.e-4;
  tolxreport=1.e3*tolx;
  tolfreport=1.e3*tolf;
#endif



  /////////////
  //
  // Setup inversion
  //
  ////////////


  // store initial guess and U as target
  PLOOP(pliter,pl) pr0[pl]=priter[pl]=pr[pl];


  entropyversion=0;

#if(EOMTYPE==EOMGRMHD||EOMTYPE==EOMENTROPYGRMHD)
  PLOOP(pliter,pl) U_target[pl] = U[pl];

  //#define NORMMETHOD (-1)
#define NORMMETHOD (1)
  // -1: no normalization
  // 0=use Utarget[RHO]
  // 1=use generaleralized mean so matrix stays well conditioned

  // assume normally want special messages
  whethertoreport=1;
  entropyversion=0;

  if((whichcons==EVOLVENOENTROPY)||(whichcons==EVOLVESIMPLEENTROPY)){
    primtoUcons=UNOTHING;
    // normal total energy inversion
    // if evolvesimpleentropy, then just invert in utoprim() after mnewt succeeds
  }
  else if(whichcons==EVOLVEFULLENTROPY){
    entropyversion=1;
    primtoUcons=UENTROPY; // implicit UNOTHING with entropy cons. quant. assigned to UU cons. quant.
    // overwrite total energy EOM with entropy EOM
    U_target[UU]=U_target[ENTROPY];
    // assumes dudp_calc replaces total energy equation with entropy equation

#if(ENTROPY==-100)
    dualfprintf(fail_file,"Should not be here in utoprim() ENTROPY variable defined\n");
    myexit(2486726);
#endif

  }


#if(1)
  // No, now further assume if not getting inversion within short trials, not going to happen and reduces to other method for "inversion"
  // No, now assuming want accurate dissipation tracking and avoidance of problems in strong shocks
  // assume don't want special messages if just using entropy evolution for comparison and not primary evolution
  if(whichcons==EVOLVEFULLENTROPY){
    whethertoreport=0;
    // then simplify inversion a bit
    ntrial = 20;
    mintrial=2;
    tolx = 1.e-6;
    tolf = 1.e-6;
    tolxallowed=tolfallowed=1.e-4;
    tolxreport=1.e3*tolx;
    tolfreport=1.e3*tolf;
  }
#endif


#elif(EOMTYPE==EOMCOLDGRMHD)

  // SUPERGODMARK: Not done yet

#define NORMMETHOD (1)  // no choice
#define WHICHFFDEINVERSION 0 // choice (see below)

  primtoUcons=UNOTHING;

  fixUtarget(WHICHFFDEINVERSION,U,U_target);

  // zero internal energy density so can use standard dU/dp
  priter[UU]=0;

#elif(EOMTYPE==EOMFFDE)

#define NORMMETHOD (1)  // no choice
#define WHICHFFDEINVERSION 0 // choice (see below)

  primtoUcons=UNOTHING;

  fixUtarget(WHICHFFDEINVERSION,U,U_target);

  // zero densities so can use standard dU/dp
  priter[RHO]=priter[UU]=0;

#endif










  /////////////
  //
  // checks if initial pr gives good u^t and determines U(pr)
  //
  ////////////

  if (get_state(pr, ptrgeom, &q) >= 1){
    //    dualfprintf(fail_file,"bad guess: i=%d j=%d k=%d\n",ptrgeom->i,ptrgeom->j,ptrgeom->k);
    //    PLOOP(pliter,pl) dualfprintf(fail_file,"bad guess: pr=%21.15g\n",pr[pl]);
    // then guess bad, adjust guess
    set_atmosphere(0,WHICHVEL,ptrgeom,prguess);
    for(pl=U1;pl<=U3;pl++) pr[pl]=prguess[pl]; // only reset velocities
    // try again
    if (get_state(pr, ptrgeom, &q) >= 1)
      FAILSTATEMENT("utoprim.c:utoprim()", "get_state()", 1);
    //    PLOOP(pliter,pl) dualfprintf(fail_file,"good guess: pr=%21.15g\n",pr[pl]);
  }
  if (primtoU(primtoUcons,pr, &q, ptrgeom, Ustart) >= 1)
    FAILSTATEMENT("utoprim.c:utoprim()", "primtoU()", 1);
  // now we have U(pr)



  // only try non-rel inversion if normal inversion (not entropy-based since not setup)
  ////////////////////
  //
  // if u^t=1, then can do non-relativistic inversion
  //
  ////////////////////

  flagifnonrel=0;

#define DONONRELINV 1

  if(entropyversion==0){


#if(DONONRELINV&&( (EOMTYPE==EOMGRMHD||EOMTYPE==EOMENTROPYGRMHD)||(EOMTYPE==EOMCOLDGRMHD) ) )

    // get b^2 to check if b^2/rho_0<<1
    bsq = dot(q.bcon, q.bcov);

    flagifnonrel=0;
    if(
       (fabs(q.ucon[TT]-1.0)*fabs(q.ucon[TT]-1.0)<NUMEPSILON*5.0)
       ||(fabs(bsq/(SMALL+fabs(pr[RHO])))<NUMEPSILON*5.0)
       ||(fabs(fabs(pr[UU])/(SMALL+fabs(pr[RHO])))<NUMEPSILON*5.0)
       ){
      flagifnonrel=1;

      if(Utoprim_nonrel(U_target,ptrgeom,pr)>0){
        *lpflag= UTOPRIMFAILRHONEG;
        flagifnonrel=0; //then can't trust non-rel inversion
      }
      else{
    
        // report if failure.  Only negative densities can occur with non-relativistic inversion
        if((pr[RHO]<=0.)&&(pr[UU]>=0.)) *lpflag= UTOPRIMFAILRHONEG;
        if((pr[RHO]>=0.)&&(pr[UU]<=0.)) *lpflag= UTOPRIMFAILUNEG;
        if((pr[RHO]<=0.)&&(pr[UU]<=0.)) *lpflag= UTOPRIMFAILRHOUNEG;

        if(IFUTOPRIMNOFAILORFIXED(*lpflag)){
          //    PLOOP(pliter,pl) dualfprintf(fail_file,"U[%d]=%21.15g pr0[%d]=%21.15g pr[%d]=%21.15g\n",pl,U_target[pl],pl,pr0[pl],pl,pr[pl]);
        }
        PLOOP(pliter,pl) prnonrel[pl]=pr[pl];
      
        /////////////
        //
        // checks if initial pr gives good u^t and determines U(pr)
        //
        ////////////
        if (get_state(pr, ptrgeom, &q) >= 1)
          FAILSTATEMENT("utoprim.c:utoprim()", "get_state()", 1);
        if(fabs(q.ucon[TT]-1.0)>NUMEPSILON*5.0) flagifnonrel=0;
      }
    }
    else{
      flagifnonrel=0;
      PLOOP(pliter,pl) prnonrel[pl]=-1.0;
    }
#else
    flagifnonrel=0;
    PLOOP(pliter,pl) prnonrel[pl]=-1.0;
#endif

    //  dualfprintf(fail_file,"uu0diff1=%21.15g flagifnonrel=%d\n",fabs(q.ucon[TT]-1.0),flagifnonrel);
  } // end if not doing entropy inversion
  else{
    flagifnonrel=0;
    PLOOP(pliter,pl) prnonrel[pl]=-1.0;
  }












  if(flagifnonrel==0){
    //////////////////
    //
    // setup mnewt
    //
    //////////////////
    mnewtfailed=1; // assume failed
    nutoprims=1; // >1 usually, but 1 means directly to static if failed (with one chance for SUPERFRAC)
    countutoprims=nutoprims;
    frac=1.0/((FTYPE)nutoprims); // so that by nutoprims adjustments we are back at U_target=Ustart
    SUPERFRAC=0.0001;
    PLOOP(pliter,pl) dU[pl]=U_target[pl]-Ustart[pl];


    //  PLOOP(pliter,pl) dualfprintf(fail_file,"IN: i=%d j=%d k=%d :: pr0[%d]=%21.15g U[%d]=%21.15g\n",ptrgeom->i,ptrgeom->j,ptrgeom->k,pl,pr0[pl],pl,U_target[pl]);
    //////////////////
    //
    // mnewt (loop)
    //
    //////////////////
    while(mnewtfailed){
      if(mnewtfailed){
        if(countutoprims==-1){
          // forced to use static solution. Probably better ways than a
          // linear approx, but better than nothing.  Must improve flux,
          // or lower courant factor to otherwise improve this situation
          break;
        }
        if(countutoprims==0){
          // force to be nearly identical instead of exactly identical, last hope!
          PLOOP(pliter,pl) U_target[pl]=Ustart[pl]+dU[pl]*SUPERFRAC;
        }
        else{
          // Only failed because U_target is trying to send u^t to imaginary values, or densities to negative values
          // try backup up towards original solution in conservative variable space
          PLOOP(pliter,pl) U_target[pl]=Ustart[pl]+dU[pl]*(FTYPE)countutoprims*frac;
        }
      }

      // mnewt is set to only take 5 entries and deal with pl=0-4 in the inversion.
      //
      // notice that priter is used.  Assumes setup Utarget to be consistent with priter and INVERTNPR
      //
      mnewtfailed = mnewt(U_target, pr0, numnormterms, whichcons, primtoUcons, ptrgeom, whethertoreport,ntrial, mintrial, priter - 1, INVERTNPR , STARTPINVERT, tolx, tolf, tolxallowed, tolfallowed, tolxreport, tolfreport,newtonstats);



      if(mnewtfailed) countutoprims--;
      if(nutoprims==1){
        break; // if failed, static immediately if failure since apparently goes that way anyways
        // if good, then break cause we are done
      }

    }

    /////////////////////
    //
    // convert the priter->pr
    //
    /////////////////////
    PLOOP(pliter,pl) prrel[pl]=priter[pl];


  }
  else{
    mnewtfailed=0; // don't trigger debug stuff for mnewt if not using it
    PLOOP(pliter,pl) prrel[pl]=-1;
  }



  /////////////////////
  //
  // ASSIGN ANSWER from mnewt or non-rel inversion
  //
  /////////////////////

#if(EOMTYPE==EOMGRMHD||EOMTYPE==EOMENTROPYGRMHD || EOMTYPE==EOMCOLDGRMHD)



#if(0)
  //  PLOOP(pliter,pl)  dualfprintf(fail_file,"%ld %d %d inversions prnonrel[%d]=%21.15g prrel[%d]=%21.15g\n",nstep,steppart,ptrgeom->i,pl,prnonrel[pl],pl,prrel[pl]);
  //  if(flagifnonrel)  PLOOP(pliter,pl)  if(fabs(prnonrel[pl]-prrel[pl])>0.0) dualfprintf(fail_file,"%ld %d %d inversions prnonrel[%d]=%21.15g prrel[%d]=%21.15g diff=%21.15g\n",nstep,steppart,ptrgeom->i,pl,prnonrel[pl],pl,prrel[pl],prnonrel[pl]-prrel[pl]);
  if(flagifnonrel)  PLOOP(pliter,pl)  if(fabs(prnonrel[pl]-prrel[pl])/fabs(fabs(prnonrel[pl])+fabs(prrel[pl])+SMALL)>0.0) dualfprintf(fail_file,"%ld %d %d inversions prnonrel[%d]=%21.15g prrel[%d]=%21.15g diff=%21.15g\n",nstep,steppart,ptrgeom->i,pl,prnonrel[pl],pl,prrel[pl],prnonrel[pl]-prrel[pl]);
#endif

  // default is to use nonrel if was good solution
  if(flagifnonrel)  PLOOP(pliter,pl) pr[pl]=prnonrel[pl];
  else PLOOP(pliter,pl) pr[pl]=prrel[pl];

#elif(EOMTYPE==EOMFFDE)
  // v^i
  // don't overwrite rest
  pr[U1]=prrel[U1];
  pr[U2]=prrel[U2];
  pr[U3]=prrel[U3];
#endif


  if(whichcons==EVOLVEFULLENTROPY){
    // in case user wants internal energy from entropy evolution in pr[ENTROPY]
    pr[ENTROPY]=pr[UU];
  }



  //////////////////
  //
  // check if mnewt failed or got negative densities
  //
  //////////////////
  if(mnewtfailed){



    //    PLOOP(pliter,pl) dualfprintf(fail_file,"U_target[%d]=%21.15g\n",pl,U_target[pl]);



    // reset to initial pr since new pr is bad
    PLOOP(pliter,pl) pr[pl]=pr0[pl];

    // report failure
    *lpflag= UTOPRIMFAILCONV;

    // then old p should be new p, do nothing since initial guess must be final solution
    if(whethertoreport && debugfail>=1) dualfprintf(fail_file,"static solution at t=%21.15g step=%ld i=%d j=%d k=%d wtf=%d\n",t,realnstep,ptrgeom->i,ptrgeom->j,ptrgeom->k,debugfail);

    // no need to continue unless want debug info, then pflag is messed up
    return(0); 
    // remove above return if want to get debug below
  }// otherwise got good solution
  else{
    // check densities for positivity
    if( ( (EOMTYPE==EOMGRMHD||EOMTYPE==EOMENTROPYGRMHD)||(EOMTYPE==EOMCOLDGRMHD))&&((pr[RHO]<0.0)||(pr[UU]<0.0))){
      // it doesn't seem reasonable to just "fix" negative densities since they could be arbitrarily negative and the other primitive variables depend on the negativity of the density which is unphysical.  So we fail if negative.  Could fail for a lower threshold on density than the floor to avoid those numbers as well.
      if((pr[RHO]<=0.)&&(pr[UU]>=0.)) *lpflag= UTOPRIMFAILRHONEG;
      if((pr[RHO]>=0.)&&(pr[UU]<=0.)) *lpflag= UTOPRIMFAILUNEG;
      if((pr[RHO]<=0.)&&(pr[UU]<=0.)) *lpflag= UTOPRIMFAILRHOUNEG;

      // mostly we hit pr[UU]<0, or maybe never pr[RHO]<0 and pr[UU]<0 alot
      if(debugfail>=2) dualfprintf(fail_file,"utoprim found negative density: t=%21.15g step=%ld i=%d j=%d k=%d %21.15g %21.15g\n",t,realnstep,ptrgeom->i,ptrgeom->j,ptrgeom->k,pr[RHO],pr[UU]);
      return(0);
    }
  }



  ////////////////////
  //
  // make sure solution is valid
  //
  ////////////////////
#if(WHICHVEL==VEL3)
  // this is just a check, fixup() will soon do both in step_ch.c

  // currently need to check this since last iteration may lead to bad pr
  if(jonchecks) fixup1zone(pr,ptrgeom,0); // actually this is done in a general fixup call soon after this point in step_ch.c
  // check and see if u^t is actually a good solution now we think we have the solution? or fix it if u^t is bad
  if(jonchecks) if(check_pr(pr,pr0,ptrgeom,0)>=1)
                  FAILSTATEMENT("utoprim.c:Utoprim()", "mnewt check:check_pr()", 1);
#endif



  ////////////////////
  //
  // determine entropy inversion if not doing full entropy evolution
  //
  ///////////////////

  if(whichcons==EVOLVESIMPLEENTROPY){
    // if evolvesimpleentropy, then just invert in utoprim() after mnewt succeeds
    if (get_state(pr, ptrgeom, &q) >= 1) FAILSTATEMENT("utoprim.c:utoprim()", "get_state()", 2);
    invertentropyflux_calc(ptrgeom,U_target[ENTROPY],0,&q,pr);// doesn't use pr[UU], but uses rest of updated primitives
    
  }// otherwise no entropy evolution or direct full entropy evolution




  /////////////////////////////
  //
  // debug stuff
  // don't fail anymore even if failed-static solution
  //
  /////////////////////////////
  if ((debugfail>=2)&&(mnewtfailed >= 1)) {

    //    faildebug1(numnormterms,whichcons,U_target,GLOBALMAC(EOSextraglobal,i,j,k),pr0,ptrgeom);
    faildebug2(numnormterms,whichcons,U_target,GLOBALMAC(EOSextraglobal,i,j,k),pr0,ptrgeom);

    if (fail(i,j,k,loc,FAIL_UTOPRIM_TEST) >= 1)
      return (1);

    
    if(!jonchecks){
      if (fail(i,j,k,loc,FAIL_UTOPRIM_TEST) >= 1)
        return (1);
    }
  }



  *pressure=pressure_rho0_u(WHICHEOS,GLOBALMAC(EOSextraglobal,i,j,k),pr[RHO],pr[UU]);



  ////////////////////
  //
  // otherwise just safely fail or succeed
  //
  ////////////////////
  *lpflag = UTOPRIMNOFAIL;
  return (0);


}
Example #5
0
int init_star(int *whichvel, int*whichcoord, int i, int j, int k, FTYPE *pr, FTYPE *pstag)
{
  int set_zamo_velocity(int whichvel, struct of_geom *ptrgeom, FTYPE *pr);
  int set_phi_velocity_grb2(FTYPE *V, FTYPE *prstellar, FTYPE *pr);
  FTYPE X[NDIM],V[NDIM];
  FTYPE dxdxp[NDIM][NDIM];
  FTYPE r,th;
  void set_stellar_solution(int ii, int jj, int kk,FTYPE *pr, FTYPE *hcmsingle, FTYPE *ynu0single, FTYPE *ynusingle);
  FTYPE prstellar[NPR];
  FTYPE przamobl[NPR];
  FTYPE przamo[NPR];
  FTYPE pratm[NPR];
  struct of_geom geom;
  struct of_geom *ptrgeom;
  struct of_geom geombl;
  int pl,pliter;
  FTYPE hcmsingle,ynu0single,ynusingle;
  FTYPE parlist[MAXPARLIST];
  int numparms;








  //////////////////////////////////
  //
  // set free parameters
  //
  beta=1E6;
  Rbeta=1000.0*2.0*G*Mcgs/(C*C)/Lunit; // 1000R_S where Mcgs is the mass

  // DEBUG
  beta=1E30; // DEBUG
  // DEBUG


  //////////////////////////////////
  //
  // Interpolate read-in data to computational grid
  set_stellar_solution(i,j,k,prstellar,&hcmsingle,&ynu0single,&ynusingle);
  // prstellar has 3-velocity in prstellar[U1], need to convert


  /////////////////////////////
  //
  // Go ahead and set quantities that need no conversion of any kind
  //
  /////////////////////////////
  if(!isfinite(hcmsingle)){
    dualfprintf(fail_file,"read-in or interpolated bad hcmsingle: %d %d %d\n",i,j,k);
  }

  if(!isfinite(ynu0single)){
    dualfprintf(fail_file,"read-in or interpolated bad ynu0single: %d %d %d\n",i,j,k);
  }

  if(!isfinite(ynusingle)){
    dualfprintf(fail_file,"read-in or interpolated bad ynusingle: %d %d %d\n",i,j,k);
  }

#if(DOYL!=DONOYL)
  pr[YL] = prstellar[YL];
  if(!isfinite(pr[YL])){
    dualfprintf(fail_file,"read-in or interpolated bad YL: %d %d %d\n",i,j,k);
  }
#endif
#if(DOYNU!=DONOYNU)
  // already accounted for WHICHEVOLVEYNU
  pr[YNU] = prstellar[YNU];
  if(!isfinite(pr[YNU])){
    dualfprintf(fail_file,"read-in or interpolated bad YNU: %d %d %d\n",i,j,k);
  }
#endif

  //  dualfprintf(fail_file,"YLYNU: i=%d yl=%21.15g ynu=%21.15g\n",i,pr[YL],pr[YNU]);


  ////////////////////////////////////
  //
  // Setup EOSextra for kazfulleos.c
  // parlist starts its index at 0 with EOSextra["TDYNORYEGLOBAL"]
  //
  // why not just call to compute EOSglobal things? (only because of H)
  // only matters for Kaz EOS and should be in correct order and type of quantity
  parlist[TDYNORYEGLOBAL-FIRSTEOSGLOBAL]=pr[YE]; // now using YE as primitive and YL as conserved   ///pr[YL]-ynusingle; // Y_e for any WHICHEVOLVEYNU
  parlist[YNU0OLDGLOBAL-FIRSTEOSGLOBAL]=parlist[YNU0GLOBAL-FIRSTEOSGLOBAL]=ynu0single; // Y^0_\nu
  parlist[YNUOLDGLOBAL-FIRSTEOSGLOBAL]=ynusingle; // for WHICHEVOLVEYNU, no older yet, so indicate that by using same value


  int hi;
  for(hi=0;hi<NUMHDIRECTIONS;hi++){
    parlist[HGLOBAL-FIRSTEOSGLOBAL+hi]=hcmsingle; // H
  }
  // first guess is neutrinos have U=P=S=0
  parlist[UNUGLOBAL-FIRSTEOSGLOBAL]=0.0;
  parlist[PNUGLOBAL-FIRSTEOSGLOBAL]=0.0;
  parlist[SNUGLOBAL-FIRSTEOSGLOBAL]=0.0;

  parlist[IGLOBAL-FIRSTEOSGLOBAL]=i;
  parlist[JGLOBAL-FIRSTEOSGLOBAL]=j;
  parlist[KGLOBAL-FIRSTEOSGLOBAL]=k;

  store_EOS_parms(WHICHEOS,NUMEOSGLOBALS,GLOBALMAC(EOSextraglobal,i,j,k),parlist);



  //////////////////////////////////
  //
  // Set other aspects of stellar model, such as rotational velocity
  //
  ///////////////////////////////////
  ptrgeom=&geom;
  get_geometry(i,j,k,CENT,ptrgeom);
  coord_ijk(i, j, k, CENT, X);
  bl_coord_ijk(i, j, k, CENT,V);
  dxdxprim_ijk(i, j, k, CENT,dxdxp);
  r=V[1];
  th=V[2];



  //  if(i==1 && j==0 && k==0) dualfprintf(fail_file,"BANG1\n");
  // PLOOP(pliter,pl) dualfprintf(fail_file,"i=%d j=%d k=%d prstellar[%d]=%21.15g\n",i,j,k,pl,prstellar[pl]);




  ////////////////////////////
  // assume in BL-coords
  // also adds up stellar 3-velocity to my additional atmosphere 3-velocity
  PLOOP(pliter,pl) pratm[pl]=prstellar[pl]; // default value (this copies densities and fields)
  set_phi_velocity_grb2(V,prstellar,pratm);


  //  dualfprintf(fail_file,"prstellar[UU]=%21.15g pratm[UU]=%21.15g\n",prstellar[UU],pratm[UU]);


  //  dualfprintf(fail_file,"%d %d :: star_rho=%g star_u=%g star_v1=%g star_v3=%g\n",i,j,pratm[RHO],pratm[UU],pratm[U1],pratm[U3]);




  ////////////////////////////////////////////////////////////
  //
  // Set primitives for different radial regions
  //
  ////////////////////////////////////////////////////////////


  // MBH is in length units
  if(fabs(r)<4.0*MBH){
    // fabs(r) is because r can be less than 0 and if far from BH in negative sense, then don't want to still use this
    // chose 4MBH since then smoothly matches onto freely-falling frame from stellar model
    // if this close to BH, then set velocity in PRIMECOORDS since can't use BL coords inside horizon and dubiously set inside ergosphere
    // even if using VEL4 we can't use BL-coords inside horizon
    PLOOP(pliter,pl) przamo[pl]=0.0;
    set_zamo_velocity(WHICHVEL,ptrgeom, przamo); // in PRIMECOORDS/WHICHVEL

    pr[RHO]=pratm[RHO];
    pr[UU]=pratm[UU];
    for(pl=U1;pl<=U3;pl++) pr[pl]=przamo[pl];
    for(pl=B1;pl<=B3;pl++) pr[pl]=pratm[pl]; // although really need vector potential+B3 or just B3 for 2D

  }
  else{

    // GODMARK: at the moment the initial-value problem is setup only with 1 step iteration (essentially ignore star initially)
    // GODMARK: velocity can be quite bad if arbitrarily chosen and put in black hole that requires certain velocity near it.
    // so add in ZAMO observer in BL-coords here instead of afterwards

    // this gets BL-geometry in native BL spc coordinates (not PRIMECOORDS)
    gset(0,BLCOORDS,i,j,k,&geombl);
  
    przamobl[U1] = (geombl.gcon[GIND(0,1)])/(geombl.gcon[GIND(0,0)]) ;
    przamobl[U2] = (geombl.gcon[GIND(0,2)])/(geombl.gcon[GIND(0,0)]) ;
    przamobl[U3] = (geombl.gcon[GIND(0,3)])/(geombl.gcon[GIND(0,0)]) ;

    // can avoid doing below if using VEL4
    //    if(pratm[U1]<-0.1) pratm[U1]=-0.1; // near horizon time slows down so that 3-velocity actually goes to 0
    for(pl=U1;pl<=U3;pl++)  pratm[pl] += przamobl[pl];

    //    if(i==1 && j==0 && k==0) dualfprintf(fail_file,"BANG\n");
    //PLOOP(pliter,pl) dualfprintf(fail_file,"i=%d j=%d k=%d prstellar[%d]=%21.15g pratm[%d]=%21.15g przamobl[%d]=%21.15g\n",i,j,k,pl,prstellar[pl],pl,pratm[pl],pl,przamobl[pl]);


    // convert BL-coordinate velocity to PRIMECOORDS
    // now conversion should be safe since have at least ZAMO + some small modification due to the star
    // GODMARK: converting to KSCOORDS since don't at the moment have TOV solution since haven't yet setup fluid!
    //    *whichvel=VEL3;
    *whichvel=VEL4; // use 4-velocity so near BH velocity can be like in KS-coords and be -0.5 as in stellar model
    *whichcoord=BLCOORDS;
    if (bl2met2metp2v_gen(*whichvel,*whichcoord, WHICHVEL, KSCOORDS, pratm, i,j,k) >= 1)
      FAILSTATEMENT("init.readdata.c:get_data()", "bl2ks2ksp2v()", 1);

    
    ///////////////////////
    //
    // add up velocities in PRIMECOORDS
    // zamo is used in case near black hole so solution still good, where other term is not expected to account for black hole
    // zamo will be small if black hole starts off with small mass compared to self-gravity mass
    pr[RHO]=pratm[RHO];
    pr[UU]=pratm[UU];
    //for(pl=U1;pl<=U3;pl++) pr[pl]=przamo[pl]+pratm[pl]; // already accounted for ZAMO term in BL-coords above
    for(pl=U1;pl<=U3;pl++) pr[pl]=pratm[pl];

    // These field components are overwritten by vector potential solution
    // If want B3, should provide A_r or A_\theta in init.c
    for(pl=B1;pl<=B3;pl++) pr[pl]=pratm[pl]; // although really need vector potential+B3 or just B3 for 2D
    
    // DEBUG
    pr[U3]=0.0;// DEBUG
    // DEBUG
  }






  //  if(i==256 && j==0 && k==0) dualfprintf(fail_file,"BANG\n");
  //  PLOOP(pliter,pl) dualfprintf(fail_file,"i=%d j=%d k=%d prstellar[%d]=%21.15g przamo=%21.15g pratmpost=%21.15g\n",i,j,k,pl,prstellar[pl],przamo[pl],pratm[pl]);


  //  dualfprintf(fail_file,"prstellar[UU]=%21.15g pratm[UU]=%21.15g pr[UU]=%21.15g\n",prstellar[UU],pratm[UU],pr[UU]);



  // assume same for now GODMARK (only non-field set so far anyways)
  PLOOP(pliter,pl){
    pstag[pl]=pr[pl];
  }


  //////////////////////////////////
  //
  // Choose conversion of velocity
  //

  // assume already converted everything to PRIMECOORDS/WHICHVEL

  // use if setting in PRIMECOORDS
  *whichvel=WHICHVEL;
  *whichcoord=PRIMECOORDS;
  return(0);


}
Example #6
0
File: y1.c Project: pkgw/iraf
/* put out other arrays, copy the parsers */
static void
others ()
{
    extern int gen_lines;
    int c, i, j;
    int tmpline;

    finput = fopen (parser, "r");
    if (finput == NULL)
/*
 * TRANSLATION_NOTE  -- This is a message from yacc.
 *	This message is passed to error() function.
 *	This error message is issued when yacc can not find
 *	the parser to be copied.
 */
	error ("cannot find parser %s", parser);

    warray ("yyr1", levprd, nprod);

    aryfil (temp1, nprod, 0);
    /* had_act[i] is either 1 or 0 */
/* original
	PLOOP(1, i)
		temp1[i] = ((prdptr[i+1] - prdptr[i]-2) << 1) | had_act[i];
*/
    PLOOP (1, i) temp1[i] = prdptr[i + 1] - prdptr[i] - 2;

    warray ("yyr2", temp1, nprod);

    aryfil (temp1, nstate, -1000);
    TLOOP (i) for (j = tstates[i]; j != 0; j = mstates[j])
	temp1[j] = tokset[i].value;
    NTLOOP (i) for (j = ntstates[i]; j != 0; j = mstates[j])
	temp1[j] = -i;
    warray ("yychk", temp1, nstate);
    warray ("yydef", defact, nstate);

    fclose (ftable);
    fclose (fudecl);

    if ((fdebug = fopen (DEBUGNAME, "r")) == NULL)
	error ("cannot open yacc.debug");
    while ((c = getc (fdebug)) != EOF)
	(void) putc (c, fsppout);
    (void) fclose (fdebug);
    ZAPFILE (DEBUGNAME);

    if (gen_lines)
	(void) fprintf (fsppout, "# line\t1 \"%s\"\n", parser);
    tmpline = 1;
    /* copy parser text */
    while ((c = getc (finput)) != EOF) {
	if (c == '\n')
	    tmpline++;
	if (c == '$') {
	    if ((c = getc (finput)) == 'A') {
		/* Replace $A macro by the user declarations.
		 */
		fudecl = fopen (UDFILE, "r");
		if (fudecl == NULL)
		    error ("cannot reopen user declarations tempfile");
		while ((c = getc (fudecl)) != EOF)
		    putc (c, fsppout);
		fclose (fudecl);
		ZAPFILE (UDFILE);
		/* Skip remainder of line following macro.
		 */
		while ((c = getc (finput)) != '\n' && c != EOF);

	    } else if (c == 'B') {
		/* Replace $B macro by the parser tables.
		 */
		ftable = fopen (TABFILE, "r");
		if (ftable == NULL)
		    error ("cannot reopen parser tables tempfile");
		while ((c = getc (ftable)) != EOF)
		    putc (c, fsppout);
		fclose (ftable);
		ZAPFILE (TABFILE);
		/* Skip remainder of line following macro.
		 */
		while ((c = getc (finput)) != '\n' && c != EOF);

	    } else if (c == 'C') {
		/* Replace $C macro by user-supplied actions.
		 */
		faction = fopen (ACTNAME, "r");
		if (faction == NULL)
		    error ("cannot reopen action tempfile");
		while ((c = getc (faction)) != EOF)
		    putc (c, fsppout);
		fclose (faction);
		ZAPFILE (ACTNAME);
		/* Skip remainder of line following macro.
		 */
		while ((c = getc (finput)) != '\n' && c != EOF);

	    } else {
		putc ('$', fsppout);
		putc (c, fsppout);
	    }

	} else
	    putc (c, fsppout);
    }

    fclose (fsppout);
}