BlrSpherical::BlrSpherical( scfgp* cfg, jetGeometry* r, electrons* ele, std::string id ) : externalRadiationSpherical( cfg, r, ele, id ) {
/* request parameters */
cfg -> request<double>( id+"q1", 1.0, &q1 );
cfg -> request<double>( id+"q2", 1.0, &q2 );
cfg -> request<double>( id+"r", 0.0, &rext ); //!!!
cfg -> request<double>("mBH",1.0,&mBH);
cfg -> request<double>("eDisk",0.1,&eDisk);
cfg -> request<double>("mDot",1.0,&mDot);
cfg -> request<double>("Gamma",10.0,&Gamma);
cfg -> updateRequests( );
if( rext == 0.0 ) { setRadius( ); }
else { bazinga::warning(id,"Overwritting rext value from config file!"); }
vpMin = 0.01*DSQR( ele -> getGammaMin() )*getvext( rext );
vpMax = 100.0*DSQR( ele -> getGammaMax() )*getvext( rext );
allocateUpe( );
allocateLpv( );
allocateLvPoint( );
allocateLvPointAvg( );
for( int i=0;i<N;i++ ) { set_vp( i, vpMin*pow( vpMax/vpMin,(double)i/((double)N-1)) ); }
}
double dpythag(double a, double b)
{
double absa,absb;
absa=fabs(a);
absb=fabs(b);
if (absa > absb) return absa*sqrt(1.0+DSQR(absb/absa));
else return (absb == 0.0 ? 0.0 : absb*sqrt(1.0+DSQR(absa/absb)));
}
void BlrSphericalGu::update( ) {
double Ledd = 1.3e47*mBH;
double Ldisk = eDisk*mDot*Ledd;
double temp_upe = 0.0;
double temp_cf = 0.0;
temp_cf = cf;
temp_cf *= pow(r->get()/rext,2)/(1.0+pow(r->get()/rext,k));
temp_upe = (temp_cf*Ldisk*DSQR(Gamma))/(3.0*M_PI*DSQR(r->get())*LIGHT_SPEED);
gsl_vector_set( upe_r, r->getIndex( ), temp_upe );
bazinga::print_info(id,"Upe",gsl_vector_get( upe_r, r->getIndex( ) ) );
set_upe_r( gsl_vector_get( upe_r, r->getIndex( ) ) );
flag_upe_r = false; }
double dvcomp( double *a, int a_els, double *b) /* compare two vectors */
{
int i;
double ma, mb, da, sa, ra;
#ifdef V_CHECK
if ( !valid_dvector_b( a ) )
nrerror("Null pointer to 1st vector: dvcomp");
if ( !valid_dvector_b( b ) )
nrerror("Null pointer to 2nd vector: dvcomp");
#endif
ma = dvmag( a, a_els );
mb = dvmag( b, a_els );
da = 0.0;
for (i=1; i<=a_els; i++) da += DSQR(a[i] - b[i]);
sa = sqrt( ma*mb );
da = sqrt( da );
if ( ma > mb ) ra = 1.0 - mb/ma;
else ra = 1.0 - ma/mb;
/* printf("Mag rat %lf ", ra); */
if ((da = da/sa) > ra ) ra = da;
/* printf("diff %lf ", da); */
return(ra);
}
BlrSphericalGu::BlrSphericalGu( scfgp* cfg, jetGeometry* r, electrons* ele, std::string id ) : externalRadiationGu( cfg, r, ele, id ) {
/* requested parameters */
cfg -> request<double>(id + "e", 10.0, &e );
cfg -> request<double>(id + "cf", 0.1, &cf );
cfg -> request<double>(id + "rext", 0.0, &rext );
cfg -> request<double>(id + "k", 3.0, &k );
cfg -> updateRequests( );
if( rext == 0.0 ) { setRadius( ); }
else { bazinga::warning(id,"Overwritting rext value from config file!"); }
vpMin = 0.01*DSQR( ele -> getGammaMin( ) )*getvext( r->getRMax() );
vpMax = 100.0*DSQR( ele -> getGammaMax( ) )*getvext( r->getR0() );
allocateUpeR( ); // this is for storing vector information about Upe(r)
allocateLpv( );
allocateLvPoint( );
allocateLvPointAvg( );
for( int i=0;i<N;i++ ) { set_vp( i, vpMin*pow( vpMax/vpMin,(double)i/((double)N-1)) ); }
}
double lin_alg::two_norm(double *x, int size)
{
// Compute the two norm of the vector x
double s1;
s1 = 0.0;
for(int i=1; i<=size; i++){
s1 += DSQR(x[i]);
}
return sqrt(s1);
}
void period( double x[], double y[], int n, double ofac, double hifac, double px[],
double py[], int np, int *nout, int *jmax, double *prob )
{
// - raèuna Lombov periodogram za nejednoliko razmaknute toèke
// x - niz apscisa u kojima imamo vrijednosti
// y - niz vrijednosti promatrane varijable u danim toèkama apscise
// n - broj toèaka
// ofac - oversampling faktor (tipièno 4 ili više )
// hifac - do koje frekvencije idemo ( do hifac * Nyquistova frekvencija )
// np = ofac * hifac / 2 * N
// px[1..np] - niz frekvencija za koje je izraèunat periodogram
// py[1..np] - vrijednosti periodograma
// jmax - py[jmax] je maksimalni element u py[]
// prob - procjena znaèenja tog maksimuma prema hipotetskom sluèajnm šumu
// ( mala vrijednost indicira da postoji znaèajan periodièki signal)
int i,j;
double ave, c, cc, cwtau, effm, expy, pnow, pymax, s, ss, sumc, sumcy, sums, sumsh,
sumsy, swtau, var, wtau, xave, xdif, xmax, xmin, yy;
double arg, wtemp, *wi, *wpi, *wpr, *wr;
wi = new double[n+1];
wpi = new double[n+1];
wpr = new double[n+1];
wr = new double[n+1];
*nout = (int) (0.5 * ofac * hifac * n);
if( *nout > np )
{
printf("output arrays too short in period ");
assert(0);
}
avevar(y,n, &ave, &var);
xmax = xmin = x[1];
for( j=1; j<=n; j++ )
{
if( x[j] > xmax )
xmax = x[j];
if( x[j] < xmin )
xmin = x[j];
}
xdif = xmax - xmin;
xave = 0.5 * (xmax + xmin);
pymax = 0.0;
pnow = 1.0 / (xdif * ofac);
for( j=1; j<=n; j++ )
{
arg = TWOPID * ((x[j] - xave)*pnow);
wpr[j] = -2.0 * DSQR(sin(0.5*arg));
wpi[j] = sin(arg);
wr[j] = cos(arg);
wi[j] = wpi[j];
}
for( i=1; i<=(*nout); i++ )
{
px[i] = pnow;
sumsh = sumc = 0.0;
for( j=1; j<=n; j++ )
{
c = wr[j];
s = wi[j];
sumsh += s * c;
sumc += (c-s)*(c+s);
}
wtau = 0.5 * atan2(2.0*sumsh, sumc);
swtau = sin(wtau);
cwtau = cos(wtau);
sums = sumc = sumsy = sumcy = 0.0;
for( j=1; j<=n; j++ )
{
s = wi[j];
c = wr[j];
ss = s * cwtau - c * swtau;
cc = c * cwtau + s * swtau;
sums += ss*ss;
sumc += cc*cc;
yy = y[j] - ave;
sumsy += yy*ss;
sumcy += yy*cc;
wr[j] = ((wtemp=wr[j])* wpr[j] - wi[j] * wpi[j]) + wr[j];
wi[j] = (wi[j] * wpr[j] + wtemp * wpi[j]) + wi[j];
}
py[i] = 0.5*(sumcy * sumcy/ sumc + sumsy*sumsy/sums) / var;
if( py[i] >= pymax )
pymax = py[(*jmax=i)];
pnow += 1.0 / (ofac * xdif);
}
expy = exp(-pymax);
effm = 2.0*(*nout) / ofac;
*prob = effm * expy;
if( *prob > 0.01 )
*prob = 1.0-pow(1.0-expy, effm);
delete []wr;
delete []wi;
delete []wpi;
delete []wpr;
}
/* Ouput: y=updated_conc, xx=end_time, hdid=achieved_stepsize , hnext= estimated_next_ss */
bool stifbs(double y[], double dydx[], int nv, double *xx, double htry, double eps,
double yscal[], double *hdid, double *hnext,
void (*derivs)(double, double [], double [], int, long, double), long node)
{
int i,iq,k,kk,km;
static int first=1,kmax,kopt,nvold = -1;
static double epsold = -1.0,xnew;
double eps1,errmax,fact,h,red,scale,work,wrkmin,xest;
double *dfdx,**dfdy,*err,*yerr,*ysav,*yseq;
static double a[IMAXX+1];
static double alf[KMAXX+1][KMAXX+1];
static int nseq[IMAXX+1]={0,2,6,10,14,22,34,50,70};
// static int nseq[IMAXX+1]={0,2,6,10,14,22,34,50,70,98,138,194,274,386};
// Num Recip S. 744
// Differenz zwischen zwei Werten muss ein Vielfaches von 4 sein
// So wählen, dass Verhältnis der Werte <= 5/7 ist
// z.B. 10, 14 -> 10/14 <= 5/7
// nächster wäre 18, aber 14/18 > 5/7, deshalb 22 mit 14/22 <= 5/7
int reduct,exitflag=0;
km=0; //SB avoid warnings
red = 0.0; //SB avoid warning
errmax = 0.0; // SB avoid warning
scale = 0.0; // SB avoid warning
bool success = true;
d=dmatrix(1,nv,1,KMAXX);
dfdx=dvector(1,nv);
dfdy=dmatrix(1,nv,1,nv);
err=dvector(1,KMAXX);
x=dvector(1,KMAXX);
yerr=dvector(1,nv);
ysav=dvector(1,nv);
yseq=dvector(1,nv);
// reinitialize as eps is a new tolerance
// or if nv have changed
if(eps != epsold || nv != nvold)
{
*hnext = xnew = -1.0e29; // impossible values
eps1=SAFE1*eps;
// compute work coefficients Ak
a[1]=nseq[1]+1;
for (k=1;k<=KMAXX;k++) a[k+1]=a[k]+nseq[k+1];
// compute alpha(k,q)
for (iq=2;iq<=KMAXX;iq++)
{
for (k=1;k<iq;k++)
alf[k][iq]=pow(eps1,((a[k+1]-a[iq+1])/
((a[iq+1]-a[1]+1.0)*(2*k+1))));
}
epsold=eps;
// save nv
nvold=nv;
// add cost of Jacobian evals to work coeffs a[]
a[1] += nv;
for (k=1;k<=KMAXX;k++) a[k+1]=a[k]+nseq[k+1];
// Determine opt. row no. for convergence
for (kopt=2;kopt<KMAXX;kopt++)
if (a[kopt+1] > a[kopt]*alf[kopt-1][kopt]) break;
kmax=kopt;
}
h=htry;
// save starting values
for (i=1;i<=nv;i++) ysav[i]=y[i];
// evaluate jacobian matrix, update dfdx, dfdy
jacobn(*xx,y,dfdx,dfdy,nv,node);
// new stepsize or new integration --> re-establish order window
if (*xx != xnew || h != (*hnext))
{
first=1;
kopt=kmax;
}
reduct=0;
// start stepping
for (;;)
{
// evaluate the sequence of modified midpoint integrations
for (k=1;k<=kmax;k++)
{
xnew=(*xx)+h;
if (xnew == (*xx)) //CB
{
std::cout << "step size underflow in stifbs" << "\n";
//nrerror("step size underflow in stifbs");
success = false;
free_dvector(yseq,1,nv);
free_dvector(ysav,1,nv);
free_dvector(yerr,1,nv);
free_dvector(x,1,KMAXX);
free_dvector(err,1,KMAXX);
free_dmatrix(dfdy,1,nv,1,nv);
free_dvector(dfdx,1,nv);
free_dmatrix(d,1,KMAXX,1,KMAXX);
return success;
}
// semi-implicite midpoint algorithm
success = simpr(ysav,dydx,dfdx,dfdy,nv,*xx,h,nseq[k],yseq,derivs,node);
if(success==0){
free_dvector(yseq,1,nv);
free_dvector(ysav,1,nv);
free_dvector(yerr,1,nv);
free_dvector(x,1,KMAXX);
free_dvector(err,1,KMAXX);
free_dmatrix(dfdy,1,nv,1,nv);
free_dvector(dfdx,1,nv);
free_dmatrix(d,1,KMAXX,1,KMAXX);
return success;
}
// squared since error is even
xest=DSQR(h/nseq[k]);
pzextr(k,xest,yseq,y,yerr,nv);
// compute normalized error estimate eps(k)
if (k != 1)
{
errmax=TINY;
for (i=1;i<=nv;i++) errmax=DMAX(errmax,fabs(yerr[i]/yscal[i]));
// scale error relative to tolerance
errmax /= eps;
km=k-1;
err[km]=pow(errmax/SAFE1,1.0/(double)(2*km+1));
}
if (k != 1 && (k >= kopt-1 || first))
{
if (errmax < 1.0)
{
exitflag=1;
break;
}
if (k == kmax || k == kopt+1)
{
red=SAFE2/err[km];
break;
}
else if (k == kopt && alf[kopt-1][kopt] < err[km])
{
red=1.0/err[km];
break;
}
else if (kopt == kmax && alf[km][kmax-1] < err[km])
{
red=alf[km][kmax-1]*SAFE2/err[km];
break;
}
else if (alf[km][kopt] < err[km])
{
red=alf[km][kopt-1]/err[km];
break;
}
}
}
// if (exitflag) std::cout << " Exitflag > 0 in stifbs of biodegradation" << "\n";
if (exitflag) break;
// reduce stepsize by at least REDMIN and at most by REDMAX
red=DMIN(red,REDMIN);
red=DMAX(red,REDMAX);
h *= red;
reduct=1;
} // try again
// successfull step was taken
*xx=xnew;
*hdid=h;
first=0;
wrkmin=1.0e35;
// compute optimal row for convergence and corresponding stepsize
for (kk=1;kk<=km;kk++)
{
fact=DMAX(err[kk],SCALMX);
work=fact*a[kk+1];
if (work < wrkmin)
{
scale=fact;
wrkmin=work;
kopt=kk+1;
}
}
*hnext=h/scale;
if (kopt >= k && kopt != kmax && !reduct)
{
// check for possible order increse but not if stepsize was just reduced
fact=DMAX(scale/alf[kopt-1][kopt],SCALMX);
if (a[kopt+1]*fact <= wrkmin)
{
*hnext=h/fact;
kopt++;
}
}
free_dvector(yseq,1,nv);
free_dvector(ysav,1,nv);
free_dvector(yerr,1,nv);
free_dvector(x,1,KMAXX);
free_dvector(err,1,KMAXX);
free_dmatrix(dfdy,1,nv,1,nv);
free_dvector(dfdx,1,nv);
free_dmatrix(d,1,KMAXX,1,KMAXX);
return success;
}
