/* simpler dispersion relation for the case when Phi = 0 */
static void calc_dispersion2(struct param *p, double q, complex double e[])
{
double denom = 2. * p->eta * q * q * (p->km1 + p->mu) +
4. * p->eta * p->b +
q*q*q*q*q * SQR(p->d) * p->km1 * p->mu +
2. * q*q*q*q * SQR(p->d) * p->km1 * p->eta +
2. * q*q*q * SQR(p->d) * p->km1 * p->b +
4. * SQR(p->eta) * q;
double tkappa = p->kappa + 2. * SQR(p->d) * p->km;
double tmp1 = p->kappa * SQR(q) + p->gamma;
double tmp2 = tkappa * SQR(q) + p->gamma;
// printf("tkappa=%lg tmp1=%lg tmp2=%lg denom=%lg\n", tkappa, tmp1, tmp2, denom);
/* prefactor omega^0 */
double b = -.5 * q*q*q * p->km * tmp1 / denom;
/* prefactor omega^1 */
complex double a = -.5 * I * q * (
4. * p->eta * q * p->km +
2. * p->b * tmp2 +
2. * q * p->eta * tmp2 +
q*q * p->mu * tmp2 +
q*q * p->km1 * tmp1) / denom;
// printf("a=%lg%+lg b=%lg%+lg\n", creal(a), cimag(a), creal(b), cimag(b));
e[0] = -.5 * a + csqrt(.25 * a * a - b);
e[1] = -.5 * a - csqrt(.25 * a * a - b);
}
inline double complex T2(double complex x, double complex z) {
if (creal(x) >= -0.125 && cabs(f4(x,z)) < TOLERANCE2) {
double complex temp = cpow(( -1.0 - 6.0 * x + 15.0 * x*x - 8.0 * x*x*x), ONE_THIRD) / 3.0;
return c05 * (c1 - csqrt(f1(x) / 2.0 + temp) + csqrt( f1(x) - temp - c2 * x / csqrt(f1(x) / 2.0 + temp) ));
} else {
double complex temp = csqrt(f1(x) / 2.0 + f2(x,z) / (c3 * f4(x,z)) + f4(x,z) / c12);
return c05 * (c1 - temp + csqrt( f1(x) - f2(x,z) / (c3 * f4(x,z)) - f4(x,z) / c12 - c2 * x / temp ));
}
}
int main()
{
double complex z = csqrt(-1.0 + 0.0*I);
printf("%f%+fi\n", creal(z), cimag(z));
z = csqrt(1.0 + 2.0*I);
printf("%f%+fi\n", creal(z), cimag(z));
return 0;
}
double complex
cacosh(double complex z)
{
double complex w;
#if 0 /* does not give the principal value */
w = I * cacos(z);
#else
w = clog(z + csqrt(z + 1) * csqrt(z - 1));
#endif
return w;
}
static void findroots(complex double a, complex double b, complex double c,
complex double e[])
{
int i;
complex double p = (b - a * a / 3.) / 3.;
complex double q = (2. * a * a * a / 27. - a * b / 3. + c) / 2.;
complex double D = creal(p * p * p + q * q); /* MODEL SPECIFIC!!! */
double eps;
assert(abs(cimag(p)) < 1e-10);
assert(abs(creal(q)) < 1e-10);
assert(abs(cimag(p * p * p + q * q)) < 1e-10);
complex double upr = -q + csqrt(D);
double mod_upr = pow(cabs(upr), 1. / 3.);
double arg_upr = carg(upr);
complex double umr = -q - csqrt(D);
double mod_umr = pow(cabs(umr), 1. / 3.);
double arg_umr = carg(umr);
complex double rp = .5 * (-1. + I * sqrt(3.));
complex double rm = .5 * (-1. - I * sqrt(3.));
complex double up = mod_upr * cexp(I * arg_upr / 3.);
for (eps = 1e-30; eps < 1e-6; eps *= 10.) {
complex double um[3];
double sort[3];
for (i = 0; i < 3; i++) {
um[i] = mod_umr * cexp(I*(2. * M_PI * i + arg_umr) / 3.);
sort[i] = cabs((um[i] * up + p) / p);
}
qsort(sort, 3, sizeof(*sort), cmp);
for (i = 0; i < 3; i++) {
double test = cabs((um[i] * up + p) / p);
if (test == sort[0] && test < eps) {
e[0] = up + um[i] - a / 3.;
e[1] = rp * up + rm * um[i] - a / 3.;
e[2] = rm * up + rp * um[i] - a / 3.;
return;
}
}
}
fprintf(stderr, "This should never happen!\n");
fprintf(stderr, "up=%lg%+lg*I p=%lg%+lg*I q=%lg%+lg*I D=%lg\n",
creal(up), cimag(up), creal(p), cimag(p),
creal(q), cimag(q), creal(D));
}
int m2_solve_quartic_equation(double d4, double d3,
double d2, double d1, double d0,
double roots[4])
{
Complex a3 = d3 / d4;
Complex a2 = d2 / d4;
Complex a1 = d1 / d4;
Complex a0 = d0 / d4;
Complex W = 1./3;
Complex X = 12*a0 - 3*a1*a3 + a2*a2;
Complex P = -72*a0*a2 - 9*a1*a2*a3 + 27*a1*a1 + 27*a0*a3*a3 + 2*a2*a2*a2;
Complex Q = cpow(X,3);
Complex S = csqrt(-4*Q + cpow(P,2));
Complex T = -8*a1 + 4*a2*a3 - a3*a3*a3;
Complex B = cabs(P + S) < 1e-15 ? 0.0 : (cpow(2,W)*X)/(3.*cpow(P + S,W));
Complex U = (-2*a2)/3. + (a3*a3)/4. + B;
Complex C = csqrt(U + cpow(P + S,W)/(3.*cpow(2,W)))/2.;
Complex D = cpow(P + S,W)/(3.*cpow(2,W));
Complex E = T/(4.*csqrt(U + D));
Complex F = csqrt((-4*a2)/3. + (a3*a3)/2. - B - D - E)/2.;
Complex G = csqrt((-4*a2)/3. + (a3*a3)/2. - B - D + E)/2.;
Complex r0 = -a3/4. - C - F;
Complex r1 = -a3/4. - C + F;
Complex r2 = -a3/4. + C - G;
Complex r3 = -a3/4. + C + G;
roots[0] = creal(r0);
roots[1] = creal(r1);
roots[2] = creal(r2);
roots[3] = creal(r3);
if (roots[0] != roots[0] ||
roots[1] != roots[1] ||
roots[2] != roots[2] ||
roots[3] != roots[3]) {
/* set breakpoint */
return 0;
}
/* int nr = 0; */
/* if (fabs(cimag(r0)) < 1e-10) ++nr; */
/* if (fabs(cimag(r1)) < 1e-10) ++nr; */
/* if (fabs(cimag(r2)) < 1e-10) ++nr; */
/* if (fabs(cimag(r3)) < 1e-10) ++nr; */
/* the check for realness of roots is hard to make robust */
return 4;
}
/* Conformal map that takes the unit disc onto the disc minus a slit
* starting at cexp(I * u). Approximates the atomic maps for radial
* SLE, and the reciprocal of this approximates the atomic maps for
* full plane SLE. */
static complex sle_cmap_slit_disc(double t, double u, complex z)
{
complex rotation = cexp((I * u));
complex w = 4 * cexp(-t) * z;
complex v = z + 1;
return rotation * 1.0/w * (2 * v * v - w - 2 * v * csqrt(v * v - w));
}
/**
* \brief
* Returns the two roots of the quadratic equation.
*
* \details
* Returns the two roots of the quadratic equation;
*
* \f[a z^2 + b z + c = 0,\f]
*
* where \f$a, b, c\f$ are real coefficients.
*
* \param[in] a Real coefficient of the \f$z^2\f$ term.
* \param[in] b Real coefficient of the \f$z\f$ term.
* \param[in] c Real constant term.
* \param[out] z1 First (possibly complex) root.
* \param[out] z2 Second (possibly complex) root.
*
* \return The number of real roots
*
* \author Mike Henderson
* \date 2011
*
*/
int Lgm_QuadraticRoots( double a, double b, double c, double complex *z1, double complex *z2 ){
int nReal;
double x, D2 = b*b - 4.0*a*c;
double complex D;
if ( fabs(D2) < 1e-10 ) {
// roots are real and equal
nReal = 2;
x = -0.5*b/a;
*z1 = *z2 = x;
} else if ( D2 > 0.0 ) {
// roots are real and unequal
nReal = 2;
D = sqrt(D2);
x = (-b + D)/(2.0*a); *z1 = x;
x = (-b - D)/(2.0*a); *z2 = x;
} else {
// roots are imaginary and unequal
nReal = 0;
D = csqrt(D2);
*z1 = (-b + D)/(2.0*a);
*z2 = (-b - D)/(2.0*a);
}
return(nReal);
}
/*
* Function: PASTIX_potrf
*
* Factorization LLt BLAS2 3 terms
*
* > A = LL^T
*
* Parameters:
* A - Matrix to factorize
* n - Size of A
* stride - Stide between 2 columns of the matrix
* nbpivot - IN/OUT pivot number.
* critere - Pivoting threshold.
*
*/
void
PASTIX_potrf (PASTIX_FLOAT * A, PASTIX_INT n, PASTIX_INT stride, PASTIX_INT *nbpivot, double critere)
{
PASTIX_INT k;
PASTIX_FLOAT *tmp,*tmp1;
for (k=0;k<n;k++)
{
tmp=A+k* (stride+1);
#ifdef USE_CSC
if (ABS_FLOAT(*tmp)<critere)
{
(*tmp) = (PASTIX_FLOAT)critere;
(*nbpivot)++;
}
#endif
#ifdef TYPE_COMPLEX
*tmp = (PASTIX_FLOAT)csqrt(*tmp);
#else
*tmp = (PASTIX_FLOAT)sqrt(*tmp);
if (*tmp < 0)
{
errorPrint ("Negative diagonal term\n");
EXIT (MOD_SOPALIN, INTERNAL_ERR);
}
#endif
tmp1=tmp+1;
SOPALIN_SCAL (n-k-1,(fun/(*tmp)),tmp1,iun);
SOPALIN_SYR ("L",n-k-1,-fun,tmp1,iun,tmp1+stride,stride);
}
}
//## Complex Complex.csqrtf();
static KMETHOD Complex_csqrtf(KonohaContext *kctx, KonohaStack *sfp)
{
kComplex *kc = (kComplex *) sfp[0].asObject;
float _Complex zf = (float _Complex)kc->z;
float ret = csqrt(zf);
KReturnFloatValue(ret);
}
int main(int argc, char* argv[])
{
_Complex double x = -1.0;
_Complex double y;
FILE * file;
y = csqrt(x) + x;
/* we now test whether the real and imaginary parts can serve as lvalues */
printf("\n\n");
printf("C99 complex numbers seem to be supported, 1+sqrt(-1)=%f+%fi\n",
creal(y),cimag(y));
printf("\n\n");
file = fopen( argv[1], "a" );
if ( file == NULL ) {
printf("Problem opening file.\n");
return 1;
}
fprintf(file, "/* Does the compiler support C99 complex numbers? */\n");
fprintf(file, "#define TAUCS_C99_COMPLEX\n");
fclose( file );
return 0;
}
//## Complex Complex.csqrtl();
static KMETHOD Complex_csqrtl(KonohaContext *kctx, KonohaStack *sfp)
{
kComplex *kc = (kComplex *) sfp[0].asObject;
long double _Complex zl = (long double _Complex)kc->z;
long double ret = csqrt(zl);
KReturnFloatValue(ret);
}
/**
* Initialisation of a transform plan, guru.
*
* \arg ths The pointer to a fpt plan
* \arg N The number of source nodes
* \arg M The number of target nodes
* \arg sigma The parameter of the Gaussian
* \arg n The polynomial expansion degree
* \arg p the periodisation length, at least 1
* \arg m The spatial cut-off of the nfft
* \arg flags FGT flags to use
*
* \author Stefan Kunis
*/
void fgt_init_guru(fgt_plan *ths, int N, int M, double _Complex sigma, int n,
double p, int m, unsigned flags)
{
int j,n_fftw;
fftw_plan fplan;
ths->M = M;
ths->N = N;
ths->sigma = sigma;
ths->flags = flags;
ths->x = (double*)nfft_malloc(ths->N*sizeof(double));
ths->y = (double*)nfft_malloc(ths->M*sizeof(double));
ths->alpha = (double _Complex*)nfft_malloc(ths->N*sizeof(double _Complex));
ths->f = (double _Complex*)nfft_malloc(ths->M*sizeof(double _Complex));
ths->n = n;
ths->p = p;
ths->b = (double _Complex*)nfft_malloc(ths->n*sizeof(double _Complex));
ths->nplan1 = (nfft_plan*) nfft_malloc(sizeof(nfft_plan));
ths->nplan2 = (nfft_plan*) nfft_malloc(sizeof(nfft_plan));
n_fftw=X(next_power_of_2)(2*ths->n);
nfft_init_guru(ths->nplan1, 1, &(ths->n), ths->N, &n_fftw, m, PRE_PHI_HUT|
PRE_PSI| MALLOC_X| MALLOC_F_HAT| FFTW_INIT, FFTW_MEASURE);
nfft_init_guru(ths->nplan2, 1, &(ths->n), ths->M, &n_fftw, m, PRE_PHI_HUT|
PRE_PSI| MALLOC_X| FFTW_INIT, FFTW_MEASURE);
ths->nplan1->f = ths->alpha;
ths->nplan2->f_hat = ths->nplan1->f_hat;
ths->nplan2->f = ths->f;
if(ths->flags & FGT_APPROX_B)
{
fplan = fftw_plan_dft_1d(ths->n, ths->b, ths->b, FFTW_FORWARD,
FFTW_MEASURE);
for(j=0; j<ths->n; j++)
ths->b[j] = cexp(-ths->p*ths->p*ths->sigma*(j-ths->n/2)*(j-ths->n/2)/
((double)ths->n*ths->n)) / ths->n;
nfft_fftshift_complex(ths->b, 1, &ths->n);
fftw_execute(fplan);
nfft_fftshift_complex(ths->b, 1, &ths->n);
fftw_destroy_plan(fplan);
}
else
{
for(j=0; j<ths->n; j++)
ths->b[j] = 1.0/ths->p * csqrt(PI/ths->sigma)*
cexp(-PI*PI*(j-ths->n/2)*(j-ths->n/2)/
(ths->p*ths->p*ths->sigma));
}
}
int main(int argc, char **argv) {
if(argc < 3) {
print_usage();
exit(EXIT_FAILURE);
}
//json2list(argv[1]);
json_object *jobj = json_tokener_parse(argv[2]);
if(json_object_get_type(jobj)!=json_type_array) {
printf("Input error: second argument is not a JSON array.\n");
printf("%s\n", argv[2]);
printf("%s\n", argv[3]);
exit(EXIT_FAILURE);
}
struct layer *layerlist = layers2list(argv[1]);
int nf = json_object_array_length(jobj);
int i;
json_object *jvalue;
float omega;
float complex g, iwm, coth_gd;
struct layer *l;
float complex Z;
printf("freq Zreal Zimag rhoa\n");
for(i = 0; i < nf; ++i) {
jvalue = json_object_array_get_idx(jobj, i);
omega = json_object_get_double(jvalue);
l = layerlist;
Z = csqrt(I * omega * mu / l->sigma);
l = l->prev;
while(l) {
g = csqrt(I * omega * mu * l->sigma);
iwm = I * omega * mu;
coth_gd = 1 / ctanh(g * l->d);
Z *= g / iwm;
Z = (Z * coth_gd + 1) / (Z + coth_gd);
Z *= iwm / g;
l = l->prev;
}
printf("%f %f %f %f\n", omega, creal(Z), cimag(Z), pow(cabs(Z), 2) / (omega * mu));
}
cleanup(layerlist);
return 0;
}
double complex casin(double complex z) {
double complex w;
double x, y;
x = creal(z);
y = cimag(z);
w = CMPLX(1.0 - (x - y) * (x + y), -2.0 * x * y);
return clog(CMPLX(-y, x) + csqrt(w));
}
int main(void) {
float complex i = I;
double _Complex another_i = i;
put_complex(i);
put_complex(another_i + 5.);
put_complex(i * another_i);
put_complex(cpow(I, CMPLX(6., 0.)));
put_complex(csqrt(i));
}
/**
* \brief
* Returns the four roots of the quartic equation with real coefficients.
*
* \details
* Returns the four roots of the quartic equation;
*
* \f[z^4 + b z^3 + c z^2 + d z + e = 0,\f]
*
* where \f$b, c, d, e\f$ are real coefficients, and the coefficient on the
* \f$z^4\f$ term is assumed to be 1.
*
* This rotuine uses Ferrari's' method. The idea is to recast the quartic
* in terms of a quadratic. In the process of doing this, a real root of a
* cubic equation needs to be obtained (hence the reason for
* Lgm_RealCubicRoot()).
*
* \param[in] b Real coefficient of the \f$z^3\f$ term.
* \param[in] c Real coefficient of the \f$z^2\f$ term.
* \param[in] d Real coefficient of the \f$z\f$ term.
* \param[in] e Real constant term.
* \param[out] z1 First (possibly complex) root.
* \param[out] z2 First (possibly complex) root.
* \param[out] z3 First (possibly complex) root.
* \param[out] z4 First (possibly complex) root.
*
* \return The number of real roots found.
*
* \author Mike Henderson
* \date 2011
*
*/
int Lgm_QuarticRoots( double b, double c, double d, double e, double complex *z1, double complex *z2, double complex *z3, double complex *z4 ){
int nReal;
double p, q, r, y1, v, R2, b2, b3, f;
double complex D, E, g, R, s, t;
/*
* Obtain a real root from the "resolvent cubic".
* y^3 + p y^2 + q y + r = 0
*/
p = -c;
q = (b*d - 4.0*e);
r = 4.0*c*e - b*b*e - d*d;
y1 = Lgm_CubicRealRoot( p, q, r );
/*
* Construct the quadratic and solve. (Must use complex math of course.)
*/
b2 = b*b;
b3 = b*b2;
R2 = b2/4.0 - c + y1;
R = csqrt( R2 ); // R will in general be complex
/*
* If R is small do the first one. Its fairly sensitive here...
*/
if ( fabs(R2) < 1e-7 ) {
v = y1*y1 - 4.0*e;
f = 0.75*b2 - 2.0*c;
g = 2.0*csqrt( v );
D = csqrt( f + g );
E = csqrt( f - g );
s = t = -0.5*b;
} else {
f = 0.75*b2 - R2 - 2.0*c;
g = 0.25*(4.0*b*c - 8.0*d - b3)/R;
D = csqrt( f + g );
E = csqrt( f - g );
s = -0.5*b + R;
t = -0.5*b - R;
}
*z1 = 0.5*( s + D);
*z2 = 0.5*( s - D);
*z3 = 0.5*( t + E);
*z4 = 0.5*( t - E);
nReal = 0;
if ( fabs(cimag(*z1)) < 1e-10 ) ++nReal;
if ( fabs(cimag(*z2)) < 1e-10 ) ++nReal;
if ( fabs(cimag(*z3)) < 1e-10 ) ++nReal;
if ( fabs(cimag(*z4)) < 1e-10 ) ++nReal;
return( nReal );
}
int
Xtetra(struct place *place, double *x, double *y)
{
int i,j;
struct place pl;
register struct tproj *tpp;
double vr, vi;
double br, bi;
double zr,zi,z2r,z2i,z4r,z4i,sr,si,tr,ti;
twhichp(place,&i,&j);
copyplace(place,&pl);
norm(&pl,&tproj[i][j].projpl,&tproj[i][j].projtw);
Xstereographic(&pl,&vr,&vi);
zr = vr/2;
zi = vi/2;
if(zr<=TFUZZ)
zr = TFUZZ;
csq(zr,zi,&z2r,&z2i);
csq(z2r,z2i,&z4r,&z4i);
z2r *= two_rt3;
z2i *= two_rt3;
cdiv(z4r+z2r-1,z4i+z2i,z4r-z2r-1,z4i-z2i,&sr,&si);
csqrt(sr-1,si,&tr,&ti);
cdiv(tcon*tr,tcon*ti,root3+1-sr,-si,&br,&bi);
if(br<0) {
br = -br;
bi = -bi;
if(!elco2(br,bi,tk,1.,1.,&vr,&vi))
return 0;
vr = fpir - vr;
vi = fpii - vi;
} else
if(!elco2(br,bi,tk,1.,1.,&vr,&vi))
return 0;
if(si>=0) {
tr = f0r - vi;
ti = f0i + vr;
} else {
tr = f0r + vi;
ti = f0i - vr;
}
tpp = &tproj[i][j];
*x = tr*tpp->postrot.c +
ti*tpp->postrot.s + tx[i];
*y = ti*tpp->postrot.c -
tr*tpp->postrot.s + ty[i];
return(1);
}
static int
Xhex(struct place *place, double *x, double *y)
{
int ns;
int i;
double zr,zi;
double sr,si,tr,ti,ur,ui,vr,vi,yr,yi;
struct place p;
copyplace(place,&p);
ns = place->nlat.l >= 0;
if(!ns) {
p.nlat.l = -p.nlat.l;
p.nlat.s = -p.nlat.s;
}
if(p.nlat.l<HFUZZ) {
for(i=0;i<3;i++)
if(fabs(reduce(p.wlon.l-hcut[i]))<HFUZZ) {
if(i==2) {
*x = 2*cr[0] - cr[1];
*y = 0;
} else {
*x = cr[1];
*y = 2*ci[2*i];
}
return(1);
}
p.nlat.l = HFUZZ;
sincos(&p.nlat);
}
norm(&p,&hem,&twist);
Xstereographic(&p,&zr,&zi);
zr /= 2;
zi /= 2;
cdiv(1-zr,-zi,1+zr,zi,&sr,&si);
csq(sr,si,&tr,&ti);
ccubrt(1+3*tr,3*ti,&ur,&ui);
csqrt(ur-1,ui,&vr,&vi);
cdiv(rootroot3+vr,vi,rootroot3-vr,-vi,&yr,&yi);
yr /= rootk;
yi /= rootk;
elco2(fabs(yr),yi,hkc,1.,1.,x,y);
if(yr < 0)
*x = w2 - *x;
if(!ns) reflect(hcut[0]>place->wlon.l?0:
hcut[1]>=place->wlon.l?1:
2,*x,*y,x,y);
return(1);
}
/**********************************************************
getRefraction ()
This function retrieve the x-ray index of refraction and
Atomic scattering factors f1 and f2
***********************************************************/
int getRefraction (int mode)
{
int i, Z=0;
float energy_keV;
complex cosThetaIn, sinThetaIn, cosThetaOut, n, sAmpReflect, pAmpReflect;
if (verbose > 3) { fprintf(stdout, "getRefraction: targetFormula = %s\n", targetFormula); }
if (verbose > 2) {
if ( mode==1 ) {
fprintf(stdout, "\n Index PhotonEnergy delta beta");
} else if ( mode==6 ) {
fprintf(stdout, "\n Index PhotonEnergy delta beta Refelectivity");
} else { fprintf(stdout, "\n Index PhotonEnergy f1 f2");
}
fprintf(stdout, "\n (eV) ");
}
cosThetaIn = cos(thetaIn * degToRad);
sinThetaIn = sin(thetaIn * degToRad);
if (mode > 9 ) { Z = SymbolToAtomicNumber ( targetFormula ); }
for ( i = 0; i < npts; i++ ) {
energy_keV = 0.001 * energy[i];
if ( mode < 10 ) { /* Compound target */
RefracIndexRe[i] = Refractive_Index_Re ( targetFormula, energy_keV, targetDensity );
RefracIndexIm[i] = Refractive_Index_Im ( targetFormula, energy_keV, targetDensity );
delta[i] = 1.0 - RefracIndexRe[i];
beta[i] = RefracIndexIm[i];
if (verbose>2) { fprintf(stdout, "\n %4d %12.1f %12.4g %12.4g", i, energy[i], delta[i], beta[i]); }
if ( mode==6 ) { /* Mirror reflectivity */
n = RefracIndexRe[i] + RefracIndexIm[i] * _Complex_I;
cosThetaOut = csqrt(n * n - sinThetaIn * sinThetaIn) / n;
sAmpReflect = ( cosThetaIn - n * cosThetaOut ) / (cosThetaIn + n * cosThetaOut );
pAmpReflect = ( cosThetaOut - n * cosThetaIn ) / (cosThetaOut + n * cosThetaIn );
reflectivity[i] = 0.5 * (1.0 + polarization) * cabs(pAmpReflect * pAmpReflect) + 0.5 * (1.0 - polarization) * cabs(sAmpReflect * sAmpReflect);
// fprintf(stdout, "\n n = %f,%f, determ = %f, %f", n, determ);
// fprintf(stdout, "\n sAmpReflect = %f, %f, pAmpReflect = %f, %f, reflectivity = %f", sAmpReflect, pAmpReflect, reflectivity[i]);
if (verbose>2) { fprintf(stdout, "%12.4g", reflectivity[i]); }
}
} else { /* Atomic scattering factor */
ScattFactor1[i] = Z + Fi( Z, energy_keV );
ScattFactor2[i] = - Fii(Z, energy_keV );
if (verbose>2) { fprintf(stdout, "\n %4d %12.1f %12.4g %12.4g", i, energy[i], ScattFactor1[i], ScattFactor2[i]); }
}
}
fprintf(stdout, "\n");
return 0;
}
void
cmplx (double _Complex z)
{
cabs (z); /* { dg-warning "incompatible implicit" } */
/* { dg-message "include ..complex.h.." "" { target *-*-* } 129 } */
cacos (z); /* { dg-warning "incompatible implicit" } */
/* { dg-message "include ..complex.h.." "" { target *-*-* } 131 } */
cacosh (z); /* { dg-warning "incompatible implicit" } */
/* { dg-message "include ..complex.h.." "" { target *-*-* } 133 } */
carg (z); /* { dg-warning "incompatible implicit" } */
/* { dg-message "include ..complex.h.." "" { target *-*-* } 135 } */
casin (z); /* { dg-warning "incompatible implicit" } */
/* { dg-message "include ..complex.h.." "" { target *-*-* } 137 } */
casinh (z); /* { dg-warning "incompatible implicit" } */
/* { dg-message "include ..complex.h.." "" { target *-*-* } 139 } */
catan (z); /* { dg-warning "incompatible implicit" } */
/* { dg-message "include ..complex.h.." "" { target *-*-* } 141 } */
catanh (z); /* { dg-warning "incompatible implicit" } */
/* { dg-message "include ..complex.h.." "" { target *-*-* } 143 } */
ccos (z); /* { dg-warning "incompatible implicit" } */
/* { dg-message "include ..complex.h.." "" { target *-*-* } 145 } */
ccosh (z); /* { dg-warning "incompatible implicit" } */
/* { dg-message "include ..complex.h.." "" { target *-*-* } 147 } */
cexp (z); /* { dg-warning "incompatible implicit" } */
/* { dg-message "include ..complex.h.." "" { target *-*-* } 149 } */
cimag (z); /* { dg-warning "incompatible implicit" } */
/* { dg-message "include ..complex.h.." "" { target *-*-* } 151 } */
clog (z); /* { dg-warning "incompatible implicit" } */
/* { dg-message "include ..complex.h.." "" { target *-*-* } 153 } */
conj (z); /* { dg-warning "incompatible implicit" } */
/* { dg-message "include ..complex.h.." "" { target *-*-* } 155 } */
cpow (z, z); /* { dg-warning "incompatible implicit" } */
/* { dg-message "include ..complex.h.." "" { target *-*-* } 157 } */
cproj (z); /* { dg-warning "incompatible implicit" } */
/* { dg-message "include ..complex.h.." "" { target *-*-* } 159 } */
creal (z); /* { dg-warning "incompatible implicit" } */
/* { dg-message "include ..complex.h.." "" { target *-*-* } 161 } */
csin (z); /* { dg-warning "incompatible implicit" } */
/* { dg-message "include ..complex.h.." "" { target *-*-* } 163 } */
csinh (z); /* { dg-warning "incompatible implicit" } */
/* { dg-message "include ..complex.h.." "" { target *-*-* } 165 } */
csqrt (z); /* { dg-warning "incompatible implicit" } */
/* { dg-message "include ..complex.h.." "" { target *-*-* } 167 } */
ctan (z); /* { dg-warning "incompatible implicit" } */
/* { dg-message "include ..complex.h.." "" { target *-*-* } 169 } */
ctanh (z); /* { dg-warning "incompatible implicit" } */
/* { dg-message "include ..complex.h.." "" { target *-*-* } 171 } */
}
int main (void)
{
double a, b, c;
printf("This program finds the values of a quadric equation.\n");
printf("Please enter three coefficients of the polynomial: ");
scanf("%lf %lf %lf", &a, &b, &c);
double complex discriminant_sqrt = csqrt(b*b - 4*a*c);
double complex root1 = (-b + discriminant_sqrt) / (2*a);
double complex root2 = (-b - discriminant_sqrt) / (2*a);
printf("root1 = %g + %gi\n", creal(root1), cimag(root1));
printf("root2 = %g + %gi\n", creal(root2), cimag(root2));
return 0;
}
int laguer(double complex a[], const int m, double complex *x, int *its, const int maxit) {
int iter, i, j;
double abx, abp, abm, err;
double complex dx,x1,b,d,f,g,h,sq,gp,gm,g2;
static double frac[MR+1] = {0.0,0.5,0.25,0.75,0.13,0.38,0.62,0.88,1.0};
for (iter = 1; iter <= maxit; iter++) {
*its = iter;
b = a[m];
err = cabs(b);
d = 0.;
f = 0.;
abx = cabs(*x);
for (j = m-1; j >= 0; j--) {
f = (*x) * f + d;
d = (*x) * d + b;
b = (*x) * b + a[j];
err = cabs(b) + abx * err;
}
err *= epss;
if (cabs(b) <= err) return(0);
g = d / b;
g2 = g * g;
h = g2 - 2. * f / b;
sq = csqrt((double)(m-1) * ((double)(m)*h - g2));
gp = g + sq;
gm = g - sq;
abp = cabs(gp);
abm = cabs(gm);
if (abp < abm) gp = gm;
dx=((dmax(abp,abm) > 0. ?
((double complex)(m))/gp :
(1. + abx)*(cos((double)iter) + _Complex_I*sin((double)iter))));
x1 = (*x) - dx;
if (creal(*x) == creal(x1) && cimag(*x) == cimag(x1)) {
return(0);
}
if (iter % MT) {
*x=x1;
}
else {
*x = (*x) - frac[iter/MT]*dx;
}
}
fprintf(stderr, "Too many iterations in laguer\n");
return(-1);
}
inline void runFFT(fftwf_plan plan, GDALDataset *srcDS, complex float *img, int band, GDALDataset *dstDS)
{
const size_t px_count = srcDS->GetRasterXSize() * srcDS->GetRasterYSize();
/* Note: sizeof(complex float) * dstDS->GetRasterXSize() is the length of a scanline
* in the destination image's buffer. This is used in case the source is smaller
* than the destination (as we don't want to rescale... I think.
*/
srcDS->GetRasterBand(band)->RasterIO( GF_Read, 0, 0,
srcDS->GetRasterXSize(), srcDS->GetRasterYSize(),
img, srcDS->GetRasterXSize(), srcDS->GetRasterYSize(),
GDT_CFloat32, 0, sizeof(complex float) * dstDS->GetRasterXSize());
fftwf_execute(plan);
complex float norm = csqrt(px_count + 0I);
for(int i = 0; i < px_count; i++) {
img[i] = img[i] / norm;
}
}
int quad_roots(double complex* argv, double complex* roots)
{
/* Chan, Joey, JMCSC, ync12 */
double complex c2 = *(argv+0),
c1 = *(argv+1),
c0 = *(argv+2);
if (cabs(c2)< DBL_EPSILON)
c2 = 0. + 0*I;
if (cabs(c1)< DBL_EPSILON)
c1 = 0. + 0*I;
if (cabs(c0)< DBL_EPSILON)
c0 = 0. + 0*I;
//printf("c2 = %10.5g + %10.5gi\n", creal(c2), cimag(c2));
//printf("c1 = %10.5g + %10.5gi\n", creal(c1), cimag(c1));
//printf("c0 = %10.5g + %10.5gi\n", creal(c0), cimag(c0));
double complex* r1 = roots+1,
* r2 = roots+2;
double complex delta;
if (cabs(c2) == 0)
return lin_root(&c1, roots);
delta = c1 * c1 - 4. * c2 * c0;
//printf("delta = (%10.5g, %10.5g)\n", creal(delta), cimag(delta));
delta = csqrt(delta);
*r1 = (-c1 - delta)/(2*c2);
*r2 = (-c1 + delta)/(2*c2);
//printf("c2 = (%10.5g, %10.5g)\n", creal(c2), cimag(c2));
//printf("c1 = (%10.5g, %10.5g)\n", creal(c1), cimag(c1));
//printf("c0 = (%10.5g, %10.5g)\n", creal(c0), cimag(c0));
//printf("sqrt(delta) = (%10.5g, %10.5g)\n", creal(delta), cimag(delta));
//printf("*r1 = (%10.5g, %10.5g)\n", creal(*r1), cimag(*r1));
//printf("*r2 = (%10.5g, %10.5g)\n", creal(*r2), cimag(*r2));
return 0;
}
static inline void ntffOutput()
{
const double w_s = field_getOmega();
const double complex coef = csqrt( 2*M_PI*C_0_S/(I*w_s) );
const int maxTime = field_getMaxTime();
NTFFInfo nInfo = field_getNTFFInfo();
double complex *Eth = (double complex*)malloc(sizeof(double complex)*360*nInfo.arraySize);
double complex *Eph = (double complex*)malloc(sizeof(double complex)*360*nInfo.arraySize);
int ang;
double theta = 0;
for(ang=0; ang<360; ang++)
{
double phi = ang*M_PI/180.0;
int k= ang*nInfo.arraySize;
double sx = cos(theta)*cos(phi);
double sy = cos(theta)*sin(phi);
double sz = -cos(theta); //宇野先生の本では -sin(theta)になってる
double px = -sin(phi);
double py = cos(phi);
int i;
for(i=0; i < maxTime; i++)
{
double complex WTH = 0 + 0 + Wz[k+i]*sz;
double complex WPH = 0 + 0;
double complex UTH = Ux[k+i]*sx + Uy[k+i]*sy + 0;
double complex UPH = Ux[k+i]*px + Uy[k+i]*py;
double complex ETH = coef*(-Z_0_S*WTH-UPH);
double complex EPH = coef*(-Z_0_S*WPH+UTH);
Eth[k+i] = ETH;
Eph[k+i] = EPH;
}
}
ntffSaveData("Eph", Eph);
ntffSaveData("Eth", Eth);
free(Eph);
free(Eth);
//debug_ntffOutput();
}
void move_stars_LF_complex_kick(Star *s, int N, double complex dt){
/* XXX uses softening XXX */
int i, j, d;
double mi, *ri, *vi, *riI, *viI;
double mj, *rj, *vj, *rjI, *vjI;
double complex rij[3], rij2;
double complex apre, apostpre;
for (i=0; i<N; i++) {
mi = s[i].m;
ri = s[i].r;
riI = s[i].rI;
vi = s[i].v;
viI = s[i].vI;
for (j=i+1; j<N; j++) {
mj = s[j].m;
rj = s[j].r;
rjI = s[j].rI;
vj = s[j].v;
vjI = s[j].vI;
for (d=0; d<3; d++){
rij[d] = (ri[d] - rj[d])
+ I*(riI[d] - rjI[d]);
}
rij2 = rij[0]*rij[0] + rij[1]*rij[1] +
rij[2]*rij[2] + eps2;
apre = 1.0/(rij2*csqrt(rij2));
for (d=0; d<3; d++){
apostpre = apre * rij[d] * dt;
vi[d] -= mj * creal(apostpre);
viI[d] -= mj * cimag(apostpre);
vj[d] += mi * creal(apostpre);
vjI[d] += mi * cimag(apostpre);
}
}
}
}
int ChebyshevFilter::zplna()
{
cmplx r, cnum, cden, cwc, ca, cb, b4ac;
double C;
if( kind == 3 )
C = c;
else
C = wc;
for( i=0; i<ARRSIZ; i++ )
{
z[i].r = 0.0;
z[i].i = 0.0;
}
nc = np;
jt = -1;
ii = -1;
for( icnt=0; icnt<2; icnt++ )
{
/* The maps from s plane to z plane */
do
{
ir = ii + 1;
ii = ir + 1;
r.r = zs[ir];
r.i = zs[ii];
switch( type )
{
case 1:
case 3:
/* Substitute s - r = s/wc - r = (1/wc)(z-1)/(z+1) - r
*
* 1 1 - r wc ( 1 + r wc )
* = --- -------- ( z - -------- )
* z+1 wc ( 1 - r wc )
*
* giving the root in the z plane.
*/
cnum.r = 1 + C * r.r;
cnum.i = C * r.i;
cden.r = 1 - C * r.r;
cden.i = -C * r.i;
jt += 1;
cdiv( &cden, &cnum, &z[jt] );
if( r.i != 0.0 )
{
/* fill in complex conjugate root */
jt += 1;
z[jt].r = z[jt-1 ].r;
z[jt].i = -z[jt-1 ].i;
}
break;
case 2:
case 4:
/* Substitute s - r => s/wc - r
*
* z^2 - 2 z cgam + 1
* => ------------------ - r
* (z^2 + 1) wc
*
* 1
* = ------------ [ (1 - r wc) z^2 - 2 cgam z + 1 + r wc ]
* (z^2 + 1) wc
*
* and solve for the roots in the z plane.
*/
if( kind == 2 )
cwc.r = cbp;
else
cwc.r = c;
cwc.i = 0.0;
cmul( &r, &cwc, &cnum ); /* r wc */
csub( &cnum, &cone, &ca ); /* a = 1 - r wc */
cmul( &cnum, &cnum, &b4ac ); /* 1 - (r wc)^2 */
csub( &b4ac, &cone, &b4ac );
b4ac.r *= 4.0; /* 4ac */
b4ac.i *= 4.0;
cb.r = -2.0 * cgam; /* b */
cb.i = 0.0;
cmul( &cb, &cb, &cnum ); /* b^2 */
csub( &b4ac, &cnum, &b4ac ); /* b^2 - 4 ac */
csqrt( &b4ac, &b4ac );
cb.r = -cb.r; /* -b */
cb.i = -cb.i;
ca.r *= 2.0; /* 2a */
ca.i *= 2.0;
cadd( &b4ac, &cb, &cnum ); /* -b + sqrt( b^2 - 4ac) */
cdiv( &ca, &cnum, &cnum ); /* ... /2a */
jt += 1;
cmov( &cnum, &z[jt] );
if( cnum.i != 0.0 )
{
jt += 1;
z[jt].r = cnum.r;
z[jt].i = -cnum.i;
}
if( (r.i != 0.0) || (cnum.i == 0) )
{
csub( &b4ac, &cb, &cnum ); /* -b - sqrt( b^2 - 4ac) */
cdiv( &ca, &cnum, &cnum ); /* ... /2a */
jt += 1;
cmov( &cnum, &z[jt] );
if( cnum.i != 0.0 )
{
jt += 1;
z[jt].r = cnum.r;
z[jt].i = -cnum.i;
}
}
} /* end switch */
}
while( --nc > 0 );
if( icnt == 0 )
{
zord = jt+1;
if( nz <= 0 )
{
if( kind != 3 )
return(0);
else
break;
}
}
nc = nz;
} /* end for() loop */
return 0;
}
double complex
casin(double complex z)
{
double complex w;
static double complex ca, ct, zz, z2;
double x, y;
x = creal (z);
y = cimag (z);
if (y == 0.0) {
if (fabs(x) > 1.0) {
w = M_PI_2 + 0.0 * I;
/*mtherr ("casin", DOMAIN);*/
}
else {
w = asin (x) + 0.0 * I;
}
return (w);
}
/* Power series expansion */
/*
b = cabs(z);
if( b < 0.125 ) {
z2.r = (x - y) * (x + y);
z2.i = 2.0 * x * y;
cn = 1.0;
n = 1.0;
ca.r = x;
ca.i = y;
sum.r = x;
sum.i = y;
do {
ct.r = z2.r * ca.r - z2.i * ca.i;
ct.i = z2.r * ca.i + z2.i * ca.r;
ca.r = ct.r;
ca.i = ct.i;
cn *= n;
n += 1.0;
cn /= n;
n += 1.0;
b = cn/n;
ct.r *= b;
ct.i *= b;
sum.r += ct.r;
sum.i += ct.i;
b = fabs(ct.r) + fabs(ct.i);
}
while( b > MACHEP );
w->r = sum.r;
w->i = sum.i;
return;
}
*/
ca = x + y * I;
ct = ca * I;
/* sqrt( 1 - z*z) */
/* cmul( &ca, &ca, &zz ) */
/*x * x - y * y */
zz = (x - y) * (x + y) + (2.0 * x * y) * I;
zz = 1.0 - creal(zz) - cimag(zz) * I;
z2 = csqrt (zz);
zz = ct + z2;
zz = clog (zz);
/* multiply by 1/i = -i */
w = zz * (-1.0 * I);
return (w);
}
int main(int argc, char **argv)
{
/* -------Initialize and Get the parameters from command line ------*/
PetscInitialize(&argc, &argv, PETSC_NULL, PETSC_NULL);
PetscPrintf(PETSC_COMM_WORLD,"--------Initializing------ \n");
PetscErrorCode ierr;
PetscBool flg;
int myrank;
MPI_Comm_rank(MPI_COMM_WORLD,&myrank);
if(myrank==0)
mma_verbose=1;
/*-------------------------------------------------*/
int Mx,My,Mz,Mzslab, Npmlx,Npmly,Npmlz,DegFree, anisotropic;
PetscOptionsGetInt(PETSC_NULL,"-Nx",&Nx,&flg); MyCheckAndOutputInt(flg,Nx,"Nx","Nx");
PetscOptionsGetInt(PETSC_NULL,"-Ny",&Ny,&flg); MyCheckAndOutputInt(flg,Ny,"Ny","Nx");
PetscOptionsGetInt(PETSC_NULL,"-Nz",&Nz,&flg); MyCheckAndOutputInt(flg,Nz,"Nz","Nz");
PetscOptionsGetInt(PETSC_NULL,"-Mx",&Mx,&flg); MyCheckAndOutputInt(flg,Mx,"Mx","Mx");
PetscOptionsGetInt(PETSC_NULL,"-My",&My,&flg); MyCheckAndOutputInt(flg,My,"My","My");
PetscOptionsGetInt(PETSC_NULL,"-Mz",&Mz,&flg); MyCheckAndOutputInt(flg,Mz,"Mz","Mz");
PetscOptionsGetInt(PETSC_NULL,"-Mzslab",&Mzslab,&flg); MyCheckAndOutputInt(flg,Mzslab,"Mzslab","Mzslab");
PetscOptionsGetInt(PETSC_NULL,"-Npmlx",&Npmlx,&flg); MyCheckAndOutputInt(flg,Npmlx,"Npmlx","Npmlx");
PetscOptionsGetInt(PETSC_NULL,"-Npmly",&Npmly,&flg); MyCheckAndOutputInt(flg,Npmly,"Npmly","Npmly");
PetscOptionsGetInt(PETSC_NULL,"-Npmlz",&Npmlz,&flg); MyCheckAndOutputInt(flg,Npmlz,"Npmlz","Npmlz");
Nxyz = Nx*Ny*Nz;
// if anisotropic !=0, Degree of Freedom = 3*Mx*My*Mz; else DegFree = Mx*My*Mz;
PetscOptionsGetInt(PETSC_NULL,"-anisotropic",&anisotropic,&flg);
if(!flg) anisotropic = 0; // by default, it is isotropc.
DegFree = (anisotropic ? 3 : 1 )*Mx*My*((Mzslab==0)?Mz:1);
PetscPrintf(PETSC_COMM_WORLD," the Degree of Freedoms is %d \n ", DegFree);
int DegFreeAll=DegFree+1;
PetscPrintf(PETSC_COMM_WORLD," the Degree of Freedoms ALL is %d \n ", DegFreeAll);
int BCPeriod, Jdirection, Jdirectiontwo, LowerPML;
int bx[2], by[2], bz[2];
PetscOptionsGetInt(PETSC_NULL,"-BCPeriod",&BCPeriod,&flg); MyCheckAndOutputInt(flg,BCPeriod,"BCPeriod","BCPeriod given");
PetscOptionsGetInt(PETSC_NULL,"-Jdirection",&Jdirection,&flg); MyCheckAndOutputInt(flg,Jdirection,"Jdirection","Diapole current direction");
PetscOptionsGetInt(PETSC_NULL,"-Jdirectiontwo",&Jdirectiontwo,&flg); MyCheckAndOutputInt(flg,Jdirectiontwo,"Jdirectiontwo","Diapole current direction for source two");
PetscOptionsGetInt(PETSC_NULL,"-LowerPML",&LowerPML,&flg); MyCheckAndOutputInt(flg,LowerPML,"LowerPML","PML in the lower xyz boundary");
PetscOptionsGetInt(PETSC_NULL,"-bxl",bx,&flg); MyCheckAndOutputInt(flg,bx[0],"bxl","BC at x lower");
PetscOptionsGetInt(PETSC_NULL,"-bxu",bx+1,&flg); MyCheckAndOutputInt(flg,bx[1],"bxu","BC at x upper");
PetscOptionsGetInt(PETSC_NULL,"-byl",by,&flg); MyCheckAndOutputInt(flg,by[0],"byl","BC at y lower");
PetscOptionsGetInt(PETSC_NULL,"-byu",by+1,&flg); MyCheckAndOutputInt(flg,by[1],"byu","BC at y upper");
PetscOptionsGetInt(PETSC_NULL,"-bzl",bz,&flg); MyCheckAndOutputInt(flg,bz[0],"bzl","BC at z lower");
PetscOptionsGetInt(PETSC_NULL,"-bzu",bz+1,&flg); MyCheckAndOutputInt(flg,bz[1],"bzu","BC at z upper");
double epssub, RRT, sigmax, sigmay, sigmaz ;
PetscOptionsGetReal(PETSC_NULL,"-hx",&hx,&flg); MyCheckAndOutputDouble(flg,hx,"hx","hx");
hy = hx;
hz = hx;
hxyz = (Nz==1)*hx*hy + (Nz>1)*hx*hy*hz;
double omega, omegaone, omegatwo, wratio;
PetscOptionsGetReal(PETSC_NULL,"-omega",&omega,&flg); MyCheckAndOutputDouble(flg,omega,"omega","omega");
PetscOptionsGetReal(PETSC_NULL,"-wratio",&wratio,&flg); MyCheckAndOutputDouble(flg,wratio,"wratio","wratio");
omegaone=omega;
omegatwo=wratio*omega;
PetscPrintf(PETSC_COMM_WORLD,"---omegaone is %.16e and omegatwo is %.16e ---\n",omegaone, omegatwo);
PetscOptionsGetReal(PETSC_NULL,"-Qabs",&Qabs,&flg);
if (flg && Qabs>1e+15)
Qabs=1.0/0.0;
MyCheckAndOutputDouble(flg,Qabs,"Qabs","Qabs");
PetscOptionsGetReal(PETSC_NULL,"-epsair",&epsair,&flg); MyCheckAndOutputDouble(flg,epsair,"epsair","epsair");
PetscOptionsGetReal(PETSC_NULL,"-epssub",&epssub,&flg); MyCheckAndOutputDouble(flg,epssub,"epssub","epssub");
PetscOptionsGetReal(PETSC_NULL,"-RRT",&RRT,&flg); MyCheckAndOutputDouble(flg,RRT,"RRT","RRT given");
sigmax = pmlsigma(RRT,Npmlx*hx);
sigmay = pmlsigma(RRT,Npmly*hy);
sigmaz = pmlsigma(RRT,Npmlz*hz);
PetscPrintf(PETSC_COMM_WORLD,"----sigmax is %.12e \n",sigmax);
PetscPrintf(PETSC_COMM_WORLD,"----sigmay is %.12e \n",sigmay);
PetscPrintf(PETSC_COMM_WORLD,"----sigmaz is %.12e \n",sigmaz);
char initialdata[PETSC_MAX_PATH_LEN]; //filenameComm[PETSC_MAX_PATH_LEN];
PetscOptionsGetString(PETSC_NULL,"-initialdata",initialdata,PETSC_MAX_PATH_LEN,&flg); MyCheckAndOutputChar(flg,initialdata,"initialdata","Inputdata file");
PetscOptionsGetString(PETSC_NULL,"-filenameComm",filenameComm,PETSC_MAX_PATH_LEN,&flg); MyCheckAndOutputChar(flg,filenameComm,"filenameComm","Output filenameComm");
// add cx, cy, cz to indicate where the diapole current is;
int cx, cy, cz;
PetscOptionsGetInt(PETSC_NULL,"-cx",&cx,&flg);
if (!flg)
{cx=(LowerPML)*floor(Nx/2); PetscPrintf(PETSC_COMM_WORLD,"cx is %d by default \n",cx);}
else
{PetscPrintf(PETSC_COMM_WORLD,"the current poisiont cx is %d \n",cx);}
PetscOptionsGetInt(PETSC_NULL,"-cy",&cy,&flg);
if (!flg)
{cy=(LowerPML)*floor(Ny/2); PetscPrintf(PETSC_COMM_WORLD,"cy is %d by default \n",cy);}
else
{PetscPrintf(PETSC_COMM_WORLD,"the current poisiont cy is %d \n",cy);}
PetscOptionsGetInt(PETSC_NULL,"-cz",&cz,&flg);
if (!flg)
{cz=(LowerPML)*floor(Nz/2); PetscPrintf(PETSC_COMM_WORLD,"cz is %d by default \n",cz);}
else
{PetscPrintf(PETSC_COMM_WORLD,"the current poisiont cz is %d \n",cz);}
posj = (cx*Ny+ cy)*Nz + cz;
PetscPrintf(PETSC_COMM_WORLD,"the posj is %d \n. ", posj);
int fixpteps;
PetscOptionsGetInt(PETSC_NULL,"-fixpteps",&fixpteps,&flg); MyCheckAndOutputInt(flg,fixpteps,"fixpteps","fixpteps");
// Get minapproach;
PetscOptionsGetInt(PETSC_NULL,"-minapproach",&minapproach,&flg); MyCheckAndOutputInt(flg,minapproach,"minapproach","minapproach");
// Get withepsinldos;
PetscOptionsGetInt(PETSC_NULL,"-withepsinldos",&withepsinldos,&flg); MyCheckAndOutputInt(flg,withepsinldos,"withepsinldos","withepsinldos");
// Get outputbase;
PetscOptionsGetInt(PETSC_NULL,"-outputbase",&outputbase,&flg); MyCheckAndOutputInt(flg,outputbase,"outputbase","outputbase");
// Get cavityverbose;
PetscOptionsGetInt(PETSC_NULL,"-cavityverbose",&cavityverbose,&flg);
if(!flg) cavityverbose=0;
PetscPrintf(PETSC_COMM_WORLD,"the cavity verbose is set as %d \n", cavityverbose);
// Get refinedldos;
PetscOptionsGetInt(PETSC_NULL,"-refinedldos",&refinedldos,&flg);
if(!flg) refinedldos=0;
PetscPrintf(PETSC_COMM_WORLD,"the refinedldos is set as %d \n", refinedldos);
// Get cmpwrhs;
int cmpwrhs;
PetscOptionsGetInt(PETSC_NULL,"-cmpwrhs",&cmpwrhs,&flg);
if(!flg) cmpwrhs=0;
PetscPrintf(PETSC_COMM_WORLD,"the cmpwrhs is set as %d \n", cmpwrhs);
// Get lrzsqr;
PetscOptionsGetInt(PETSC_NULL,"-lrzsqr",&lrzsqr,&flg);
if(!flg) lrzsqr=0;
PetscPrintf(PETSC_COMM_WORLD,"the lrzsqr is set as %d \n", lrzsqr);
// Get newQdef;
PetscOptionsGetInt(PETSC_NULL,"-newQdef",&newQdef,&flg);
if(!flg) newQdef=0;
PetscPrintf(PETSC_COMM_WORLD,"the newQdef is set as %d \n", newQdef);
/*--------------------------------------------------------*/
/*--------------------------------------------------------*/
/*---------- Set the current source---------*/
//Mat D; //ImaginaryIMatrix;
ImagIMat(PETSC_COMM_WORLD, &D,6*Nxyz);
Vec J;
ierr = VecCreateMPI(PETSC_COMM_WORLD, PETSC_DECIDE, 6*Nxyz, &J);CHKERRQ(ierr);
ierr = PetscObjectSetName((PetscObject) J, "Source");CHKERRQ(ierr);
VecSet(J,0.0); //initialization;
if (Jdirection == 1)
SourceSingleSetX(PETSC_COMM_WORLD, J, Nx, Ny, Nz, cx, cy, cz,1.0/hxyz);
else if (Jdirection ==2)
SourceSingleSetY(PETSC_COMM_WORLD, J, Nx, Ny, Nz, cx, cy, cz,1.0/hxyz);
else if (Jdirection == 3)
SourceSingleSetZ(PETSC_COMM_WORLD, J, Nx, Ny, Nz, cx, cy, cz,1.0/hxyz);
else
PetscPrintf(PETSC_COMM_WORLD," Please specify correct direction of current: x (1) , y (2) or z (3)\n ");
Vec Jtwo;
ierr = VecDuplicate(J, &Jtwo);CHKERRQ(ierr);
ierr = PetscObjectSetName((PetscObject) Jtwo, "Sourcetwo");CHKERRQ(ierr);
VecSet(Jtwo,0.0); //initialization;
if (Jdirectiontwo == 1)
SourceSingleSetX(PETSC_COMM_WORLD, Jtwo, Nx, Ny, Nz, cx, cy, cz,1.0/hxyz);
else if (Jdirectiontwo ==2)
SourceSingleSetY(PETSC_COMM_WORLD, Jtwo, Nx, Ny, Nz, cx, cy, cz,1.0/hxyz);
else if (Jdirectiontwo == 3)
SourceSingleSetZ(PETSC_COMM_WORLD, Jtwo, Nx, Ny, Nz, cx, cy, cz,1.0/hxyz);
else
PetscPrintf(PETSC_COMM_WORLD," Please specify correct direction of current two: x (1) , y (2) or z (3)\n ");
//Vec b; // b= i*omega*J;
Vec bone, btwo;
ierr = VecDuplicate(J,&b);CHKERRQ(ierr);
ierr = PetscObjectSetName((PetscObject) b, "rhsone");CHKERRQ(ierr);
ierr = VecDuplicate(J,&bone);CHKERRQ(ierr);
ierr = PetscObjectSetName((PetscObject) bone, "rhsone");CHKERRQ(ierr);
ierr = VecDuplicate(Jtwo,&btwo);CHKERRQ(ierr);
ierr = PetscObjectSetName((PetscObject) btwo, "rhstwo");CHKERRQ(ierr);
if (cmpwrhs==0)
{
ierr = MatMult(D,J,b);CHKERRQ(ierr);
ierr = MatMult(D,Jtwo,btwo);CHKERRQ(ierr);
VecCopy(b,bone);
VecScale(bone,omegaone);
VecScale(btwo,omegatwo);
VecScale(b,omega);
}
else
{
double complex cmpiomega;
cmpiomega = cpow(1+I/Qabs,newQdef+1);
double sqrtiomegaR = -omega*cimag(csqrt(cmpiomega));
double sqrtiomegaI = omega*creal(csqrt(cmpiomega));
PetscPrintf(PETSC_COMM_WORLD,"the real part of sqrt cmpomega is %g and imag sqrt is % g ", sqrtiomegaR, sqrtiomegaI);
Vec tmpi;
ierr = VecDuplicate(J,&tmpi);
VecSet(b,0.0);
VecSet(tmpi,0.0);
CmpVecScale(J,b,sqrtiomegaR,sqrtiomegaI,D,tmpi);
VecDestroy(&tmpi);
}
/*-------Get the weight vector ------------------*/
//Vec weight;
ierr = VecDuplicate(J,&weight); CHKERRQ(ierr);
ierr = PetscObjectSetName((PetscObject) weight, "weight");CHKERRQ(ierr);
if(LowerPML==0)
GetWeightVec(weight, Nx, Ny,Nz); // new code handles both 3D and 2D;
else
VecSet(weight,1.0);
Vec weightedJ;
ierr = VecDuplicate(J,&weightedJ); CHKERRQ(ierr);
ierr = VecPointwiseMult(weightedJ,J,weight);
ierr = PetscObjectSetName((PetscObject) weightedJ, "weightedJ");CHKERRQ(ierr);
Vec weightedJtwo;
ierr = VecDuplicate(Jtwo,&weightedJtwo); CHKERRQ(ierr);
ierr = VecPointwiseMult(weightedJtwo,Jtwo,weight);
ierr = PetscObjectSetName((PetscObject) weightedJtwo, "weightedJtwo");CHKERRQ(ierr);
//Vec vR;
ierr = VecDuplicate(J,&vR); CHKERRQ(ierr);
GetRealPartVec(vR, 6*Nxyz);
// VecFReal;
if (lrzsqr)
{ ierr = VecDuplicate(J,&epsFReal); CHKERRQ(ierr);
ierr = PetscObjectSetName((PetscObject) epsFReal, "epsFReal");CHKERRQ(ierr);
if (newQdef==0)
{
sqrtomegaI = omega*cimag(csqrt(1+I/Qabs));
PetscPrintf(PETSC_COMM_WORLD,"the real part of sqrt cmpomega is %g and imag sqrt is % g ", omega*creal(csqrt(1+I/Qabs)), sqrtomegaI);
betar = 2*sqrtomegaI;
betai = betar/Qabs;
}
else
{
double gamma;
gamma = omega/Qabs;
betar = 2*gamma*(1-1.0/pow(Qabs,2));
betai = 2*gamma*(2.0/Qabs);
}
ierr = VecDuplicate(J,&nb); CHKERRQ(ierr);
ierr = PetscObjectSetName((PetscObject) nb, "nb"); CHKERRQ(ierr);
ierr = VecDuplicate(J,&y); CHKERRQ(ierr);
ierr = PetscObjectSetName((PetscObject) y, "y"); CHKERRQ(ierr);
ierr = VecDuplicate(J,&xsqr); CHKERRQ(ierr); // xsqr = x*x;
ierr = PetscObjectSetName((PetscObject) xsqr, "xsqr"); CHKERRQ(ierr);
CongMat(PETSC_COMM_WORLD, &C, 6*Nxyz);
}
/*----------- Define PML muinv vectors */
Vec muinvpml;
MuinvPMLFull(PETSC_COMM_SELF, &muinvpml,Nx,Ny,Nz,Npmlx,Npmly,Npmlz,sigmax,sigmay,sigmaz,omega, LowerPML);
//double *muinv;
muinv = (double *) malloc(sizeof(double)*6*Nxyz);
int add=0;
AddMuAbsorption(muinv,muinvpml,Qabs,add);
ierr = VecDestroy(&muinvpml); CHKERRQ(ierr);
/*---------- Define PML eps vectors: epspml---------- */
Vec epspml; //epspmlQ, epscoef;
ierr = VecDuplicate(J,&epspml);CHKERRQ(ierr);
ierr = PetscObjectSetName((PetscObject) epspml,"EpsPMLFull"); CHKERRQ(ierr);
EpsPMLFull(PETSC_COMM_WORLD, epspml,Nx,Ny,Nz,Npmlx,Npmly,Npmlz,sigmax,sigmay,sigmaz,omega, LowerPML);
ierr = VecDuplicate(J,&epspmlQ);CHKERRQ(ierr);
Vec epscoefone, epscoeftwo;
ierr = VecDuplicate(J,&epscoefone);CHKERRQ(ierr);
ierr = VecDuplicate(J,&epscoeftwo);CHKERRQ(ierr);
// compute epspmlQ,epscoef;
EpsCombine(D, weight, epspml, epspmlQ, epscoefone, Qabs, omegaone);
EpsCombine(D, weight, epspml, epspmlQ, epscoeftwo, Qabs, omegatwo);
/*--------- Setup the interp matrix ----------------------- */
/* for a samll eps block, interp it into yee-lattice. The interp matrix A and PML epspml only need to generated once;*/
//Mat A;
//new routine for myinterp;
myinterp(PETSC_COMM_WORLD, &A, Nx,Ny,Nz, LowerPML*floor((Nx-Mx)/2),LowerPML*floor((Ny-My)/2),LowerPML*floor((Nz-Mz)/2), Mx,My,Mz,Mzslab, anisotropic); // LoweerPML*Npmlx,..,.., specify where the interp starts;
//Vec epsSReal, epsgrad, vgrad; // create compatiable vectors with A.
ierr = MatGetVecs(A,&epsSReal, &epsgrad); CHKERRQ(ierr);
ierr = PetscObjectSetName((PetscObject) epsgrad, "epsgrad");CHKERRQ(ierr);
ierr = VecDuplicate(epsSReal, &vgrad); CHKERRQ(ierr);
ierr = PetscObjectSetName((PetscObject) epsSReal, "epsSReal");CHKERRQ(ierr);
ierr = PetscObjectSetName((PetscObject) vgrad, "vgrad");CHKERRQ(ierr);
/*---------Setup the epsmedium vector----------------*/
//Vec epsmedium;
ierr = VecDuplicate(J,&epsmedium); CHKERRQ(ierr);
GetMediumVec(epsmedium,Nz,Mz,epsair,epssub);
/*--------- Setup the finitie difference matrix-------------*/
//Mat M;
MoperatorGeneral(PETSC_COMM_WORLD, &M, Nx,Ny,Nz,hx,hy,hz, bx, by, bz,muinv,BCPeriod);
free(muinv);
/*--------Setup the KSP variables ---------------*/
KSP kspone;
PC pcone;
ierr = KSPCreate(PETSC_COMM_WORLD,&kspone);CHKERRQ(ierr);
//ierr = KSPSetType(ksp, KSPPREONLY);CHKERRQ(ierr);
ierr = KSPSetType(kspone, KSPGMRES);CHKERRQ(ierr);
ierr = KSPGetPC(kspone,&pcone);CHKERRQ(ierr);
ierr = PCSetType(pcone,PCLU);CHKERRQ(ierr);
ierr = PCFactorSetMatSolverPackage(pcone,MATSOLVERPASTIX);CHKERRQ(ierr);
ierr = PCSetFromOptions(pcone);
int maxkspit = 20;
ierr = KSPSetTolerances(kspone,1e-14,PETSC_DEFAULT,PETSC_DEFAULT,maxkspit);CHKERRQ(ierr);
ierr = KSPSetFromOptions(kspone);CHKERRQ(ierr);
KSP ksptwo;
PC pctwo;
ierr = KSPCreate(PETSC_COMM_WORLD,&ksptwo);CHKERRQ(ierr);
//ierr = KSPSetType(ksp, KSPPREONLY);CHKERRQ(ierr);
ierr = KSPSetType(ksptwo, KSPGMRES);CHKERRQ(ierr);
ierr = KSPGetPC(ksptwo,&pctwo);CHKERRQ(ierr);
ierr = PCSetType(pctwo,PCLU);CHKERRQ(ierr);
ierr = PCFactorSetMatSolverPackage(pctwo,MATSOLVERPASTIX);CHKERRQ(ierr);
ierr = PCSetFromOptions(pctwo);
ierr = KSPSetTolerances(ksptwo,1e-14,PETSC_DEFAULT,PETSC_DEFAULT,maxkspit);CHKERRQ(ierr);
ierr = KSPSetFromOptions(ksptwo);CHKERRQ(ierr);
/*--------- Create the space for solution vector -------------*/
//Vec x;
ierr = VecDuplicate(J,&x);CHKERRQ(ierr);
ierr = PetscObjectSetName((PetscObject) x, "Solution");CHKERRQ(ierr);
/*----------- Create the space for final eps -------------*/
//Vec epsC, epsCi, epsP;
ierr = VecDuplicate(J,&epsC);CHKERRQ(ierr);
ierr = PetscObjectSetName((PetscObject) epsC, "EpsC");CHKERRQ(ierr);
ierr = VecDuplicate(J,&epsCi);CHKERRQ(ierr);
ierr = VecDuplicate(J,&epsP);CHKERRQ(ierr);
ierr = VecSet(epsP,0.0); CHKERRQ(ierr);
ierr = VecAssemblyBegin(epsP); CHKERRQ(ierr);
ierr = VecAssemblyEnd(epsP); CHKERRQ(ierr);
/*------------ Create space used in the solver ------------*/
//Vec vgradlocal,tmp, tmpa,tmpb;
ierr = VecCreateSeq(PETSC_COMM_SELF, DegFree, &vgradlocal); CHKERRQ(ierr);
ierr = VecDuplicate(J,&tmp); CHKERRQ(ierr);
ierr = VecDuplicate(J,&tmpa); CHKERRQ(ierr);
ierr = VecDuplicate(J,&tmpb); CHKERRQ(ierr);
// Vec pickposvec; this vector is zero except that first entry is one;
if (withepsinldos)
{ ierr = VecDuplicate(J,&pickposvec); CHKERRQ(ierr);
ierr = VecSet(pickposvec,0.0); CHKERRQ(ierr);
ierr = VecSetValue(pickposvec,posj+Jdirection*Nxyz,1.0,INSERT_VALUES);
VecAssemblyBegin(pickposvec);
VecAssemblyEnd(pickposvec);
}
/*------------ Create scatter used in the solver -----------*/
//VecScatter scatter;
//IS from, to;
ierr =ISCreateStride(PETSC_COMM_SELF,DegFree,0,1,&from); CHKERRQ(ierr);
ierr =ISCreateStride(PETSC_COMM_SELF,DegFree,0,1,&to); CHKERRQ(ierr);
/*-------------Read the input file -------------------------*/
double *epsoptAll;
epsoptAll = (double *) malloc(DegFreeAll*sizeof(double));
FILE *ptf;
ptf = fopen(initialdata,"r");
PetscPrintf(PETSC_COMM_WORLD,"reading from input files \n");
int i;
// set the dielectric at the center is fixed, and alwyas high
//epsopt[0]=myub; is defined below near lb and ub;
for (i=0;i<DegFree;i++)
{ //PetscPrintf(PETSC_COMM_WORLD,"current eps reading is %lf \n",epsopt[i]);
fscanf(ptf,"%lf",&epsoptAll[i]);
}
epsoptAll[DegFreeAll-1]=0; //initialize auxiliary variable;
fclose(ptf);
/*----declare these data types, althought they may not be used for job 2 -----------------*/
double mylb,myub, *lb=NULL, *ub=NULL;
int maxeval, maxtime, mynloptalg;
double maxf;
nlopt_opt opt;
nlopt_result result;
/*--------------------------------------------------------------*/
/*----Now based on Command Line, Do the corresponding job----*/
/*----------------------------------------------------------------*/
//int Job; set Job to be gloabl variables;
PetscOptionsGetInt(PETSC_NULL,"-Job",&Job,&flg); MyCheckAndOutputInt(flg,Job,"Job","The Job indicator you set");
int numofvar=(Job==1)*DegFreeAll + (Job==3);
/*-------- convert the epsopt array to epsSReal (if job!=optmization) --------*/
if (Job==2 || Job ==3)
{
// copy epsilon from file to epsSReal; (different from FindOpt.c, because epsilon is not degree-of-freedoms in computeQ.
// i) create a array to read file (done above in epsopt); ii) convert the array to epsSReal;
int ns, ne;
ierr = VecGetOwnershipRange(epsSReal,&ns,&ne);
for(i=ns;i<ne;i++)
{ ierr=VecSetValue(epsSReal,i,epsoptAll[i],INSERT_VALUES);
CHKERRQ(ierr); }
if(withepsinldos)
{ epsatinterest = epsoptAll[cx*Ny*Nz + cy*Nz + cz] + epsair;
PetscPrintf(PETSC_COMM_WORLD, " the relative permitivity at the point of current is %.16e \n ",epsatinterest);}
ierr = VecAssemblyBegin(epsSReal); CHKERRQ(ierr);
ierr = VecAssemblyEnd(epsSReal); CHKERRQ(ierr);
}
if (Job==1 || Job==3) // optimization bounds setup;
{
PetscOptionsGetInt(PETSC_NULL,"-maxeval",&maxeval,&flg); MyCheckAndOutputInt(flg,maxeval,"maxeval","max number of evaluation");
PetscOptionsGetInt(PETSC_NULL,"-maxtime",&maxtime,&flg); MyCheckAndOutputInt(flg,maxtime,"maxtime","max time of evaluation");
PetscOptionsGetInt(PETSC_NULL,"-mynloptalg",&mynloptalg,&flg); MyCheckAndOutputInt(flg,mynloptalg,"mynloptalg","The algorithm used ");
PetscOptionsGetReal(PETSC_NULL,"-mylb",&mylb,&flg); MyCheckAndOutputDouble(flg,mylb,"mylb","optimization lb");
PetscOptionsGetReal(PETSC_NULL,"-myub",&myub,&flg); MyCheckAndOutputDouble(flg,myub,"myub","optimization ub");
lb = (double *) malloc(numofvar*sizeof(double));
ub = (double *) malloc(numofvar*sizeof(double));
// the dielectric constant at center is fixed!
for(i=0;i<numofvar;i++)
{
lb[i] = mylb;
ub[i] = myub;
} //initial guess, lower bounds, upper bounds;
// set lower and upper bounds for auxiliary variable;
lb[numofvar-1]=0;
ub[numofvar-1]=1.0/0.0;
//fix the dielectric at the center to be high for topology optimization;
if (Job==1 && fixpteps==1)
{
epsoptAll[0]=myub;
lb[0]=myub;
ub[0]=myub;
}
opt = nlopt_create(mynloptalg, numofvar);
myfundatatypeshg data[2] = {{omegaone, bone, weightedJ, epscoefone,kspone},{omegatwo, btwo, weightedJtwo, epscoeftwo,ksptwo}};
nlopt_add_inequality_constraint(opt,ldosconstraint, &data[0], 1e-8);
nlopt_add_inequality_constraint(opt,ldosconstraint, &data[1], 1e-8);
nlopt_set_lower_bounds(opt,lb);
nlopt_set_upper_bounds(opt,ub);
nlopt_set_maxeval(opt,maxeval);
nlopt_set_maxtime(opt,maxtime);
/*add functionality to choose local optimizer; */
int mynloptlocalalg;
nlopt_opt local_opt;
PetscOptionsGetInt(PETSC_NULL,"-mynloptlocalalg",&mynloptlocalalg,&flg); MyCheckAndOutputInt(flg,mynloptlocalalg,"mynloptlocalalg","The local optimization algorithm used ");
if (mynloptlocalalg)
{
local_opt=nlopt_create(mynloptlocalalg,numofvar);
nlopt_set_ftol_rel(local_opt, 1e-14);
nlopt_set_maxeval(local_opt,100000);
nlopt_set_local_optimizer(opt,local_opt);
}
}
switch (Job)
{
case 1:
{
if (minapproach)
nlopt_set_min_objective(opt,maxminobjfun,NULL);// NULL: no data to be passed because of global variables;
else
nlopt_set_max_objective(opt,maxminobjfun,NULL);
result = nlopt_optimize(opt,epsoptAll,&maxf);
}
break;
case 2 : //AnalyzeStructure
{
int Linear, Eig, maxeigit;
PetscOptionsGetInt(PETSC_NULL,"-Linear",&Linear,&flg); MyCheckAndOutputInt(flg,Linear,"Linear","Linear solver indicator");
PetscOptionsGetInt(PETSC_NULL,"-Eig",&Eig,&flg); MyCheckAndOutputInt(flg,Eig,"Eig","Eig solver indicator");
PetscOptionsGetInt(PETSC_NULL,"-maxeigit",&maxeigit,&flg); MyCheckAndOutputInt(flg,maxeigit,"maxeigit","maximum number of Eig solver iterations is");
/*----------------------------------*/
//EigenSolver(Linear, Eig, maxeigit);
/*----------------------------------*/
OutputVec(PETSC_COMM_WORLD, weight,filenameComm, "weight.m");
}
break;
default:
PetscPrintf(PETSC_COMM_WORLD,"--------Interesting! You're doing nothing!--------\n ");
}
if(Job==1 || Job==3)
{
/* print the optimization parameters */
#if 0
double xrel, frel, fabs;
// double *xabs;
frel=nlopt_get_ftol_rel(opt);
fabs=nlopt_get_ftol_abs(opt);
xrel=nlopt_get_xtol_rel(opt);
PetscPrintf(PETSC_COMM_WORLD,"nlopt frel is %g \n",frel);
PetscPrintf(PETSC_COMM_WORLD,"nlopt fabs is %g \n",fabs);
PetscPrintf(PETSC_COMM_WORLD,"nlopt xrel is %g \n",xrel);
//nlopt_result nlopt_get_xtol_abs(const nlopt_opt opt, double *tol);
#endif
/*--------------*/
if (result < 0) {
PetscPrintf(PETSC_COMM_WORLD,"nlopt failed! \n", result);
}
else {
PetscPrintf(PETSC_COMM_WORLD,"found extremum %0.16e\n", minapproach?1.0/maxf:maxf);
}
PetscPrintf(PETSC_COMM_WORLD,"nlopt returned value is %d \n", result);
if(Job==1)
{ //OutputVec(PETSC_COMM_WORLD, epsopt,filenameComm, "epsopt.m");
//OutputVec(PETSC_COMM_WORLD, epsgrad,filenameComm, "epsgrad.m");
//OutputVec(PETSC_COMM_WORLD, vgrad,filenameComm, "vgrad.m");
//OutputVec(PETSC_COMM_WORLD, x,filenameComm, "x.m");
int rankA;
MPI_Comm_rank(PETSC_COMM_WORLD, &rankA);
if(rankA==0)
{
ptf = fopen(strcat(filenameComm,"epsopt.txt"),"w");
for (i=0;i<DegFree;i++)
fprintf(ptf,"%0.16e \n",epsoptAll[i]);
fclose(ptf);
PetscPrintf(PETSC_COMM_WORLD,"the t parameter is %.8e \n",epsoptAll[DegFreeAll-1]);
}
}
nlopt_destroy(opt);
}
ierr = PetscPrintf(PETSC_COMM_WORLD,"--------Done!--------\n ");CHKERRQ(ierr);
/*------------------------------------*/
/* ----------------------Destroy Vecs and Mats----------------------------*/
free(epsoptAll);
free(lb);
free(ub);
ierr = VecDestroy(&J); CHKERRQ(ierr);
ierr = VecDestroy(&b); CHKERRQ(ierr);
ierr = VecDestroy(&weight); CHKERRQ(ierr);
ierr = VecDestroy(&weightedJ); CHKERRQ(ierr);
ierr = VecDestroy(&vR); CHKERRQ(ierr);
ierr = VecDestroy(&epspml); CHKERRQ(ierr);
ierr = VecDestroy(&epspmlQ); CHKERRQ(ierr);
ierr = VecDestroy(&epsSReal); CHKERRQ(ierr);
ierr = VecDestroy(&epsgrad); CHKERRQ(ierr);
ierr = VecDestroy(&vgrad); CHKERRQ(ierr);
ierr = VecDestroy(&epsmedium); CHKERRQ(ierr);
ierr = VecDestroy(&epsC); CHKERRQ(ierr);
ierr = VecDestroy(&epsCi); CHKERRQ(ierr);
ierr = VecDestroy(&epsP); CHKERRQ(ierr);
ierr = VecDestroy(&x); CHKERRQ(ierr);
ierr = VecDestroy(&vgradlocal);CHKERRQ(ierr);
ierr = VecDestroy(&tmp); CHKERRQ(ierr);
ierr = VecDestroy(&tmpa); CHKERRQ(ierr);
ierr = VecDestroy(&tmpb); CHKERRQ(ierr);
ierr = MatDestroy(&A); CHKERRQ(ierr);
ierr = MatDestroy(&D); CHKERRQ(ierr);
ierr = MatDestroy(&M); CHKERRQ(ierr);
ierr = VecDestroy(&epscoefone); CHKERRQ(ierr);
ierr = VecDestroy(&epscoeftwo); CHKERRQ(ierr);
ierr = KSPDestroy(&kspone);CHKERRQ(ierr);
ierr = KSPDestroy(&ksptwo);CHKERRQ(ierr);
ISDestroy(&from);
ISDestroy(&to);
if (withepsinldos)
{ierr=VecDestroy(&pickposvec); CHKERRQ(ierr);}
if (lrzsqr)
{
ierr=VecDestroy(&epsFReal); CHKERRQ(ierr);
ierr=VecDestroy(&xsqr); CHKERRQ(ierr);
ierr=VecDestroy(&y); CHKERRQ(ierr);
ierr=VecDestroy(&nb); CHKERRQ(ierr);
ierr=MatDestroy(&C); CHKERRQ(ierr);
}
ierr = VecDestroy(&bone); CHKERRQ(ierr);
ierr = VecDestroy(&btwo); CHKERRQ(ierr);
ierr = VecDestroy(&Jtwo); CHKERRQ(ierr);
/*------------ finalize the program -------------*/
{
int rank;
MPI_Comm_rank(PETSC_COMM_WORLD, &rank);
//if (rank == 0) fgetc(stdin);
MPI_Barrier(PETSC_COMM_WORLD);
}
ierr = PetscFinalize(); CHKERRQ(ierr);
return 0;
}