static void ob_j2(const CMpara* par,
const Gaussian* G1, const Gaussian* G2,
const GaussianAux* X, complex double* j2)
{
double* Xcm = par->Xcm;
double* Vcm = par->Vcm;
complex double l2, s2, ls;
complex double beta;
complex double rho2cm = 0.0, pi2cm = 0.0, rhopicm = 0.0;
complex double rhoxpicm[3];
int i;
for (i=0; i<3; i++)
rho2cm += csqr(X->rho[i]-Xcm[i]);
for (i=0; i<3; i++)
pi2cm += csqr(X->pi[i]-mass(G1->xi)*Vcm[i]);
for (i=0; i<3; i++)
rhopicm += (X->rho[i]-Xcm[i])*(X->pi[i]-mass(G1->xi)*Vcm[i]);
for (i=0; i<3; i++)
rhoxpicm[i] =
(X->rho[(i+1)%3]-Xcm[(i+1)%3])*(X->pi[(i+2)%3]-mass(G1->xi)*Vcm[(i+2)%3]) -
(X->rho[(i+2)%3]-Xcm[(i+2)%3])*(X->pi[(i+1)%3]-mass(G1->xi)*Vcm[(i+1)%3]);
beta = I*X->lambda*(conj(G1->a)-G2->a);
l2 = (2*X->lambda*rho2cm + 2*X->alpha*pi2cm - 2*beta*rhopicm +
rho2cm* pi2cm - csqr(rhopicm))* X->Q;
s2 = 0.75*X->Q;
ls = 0.5*cvec3mult(rhoxpicm, X->sig)* X->T* X->R;
*j2 += l2 + s2 + 2*ls;
}
void ColumnDerivative(Mode m, Mode mj, Geometry geo, Vec dfR, Vec dfI, Vec vIpsi, Vec vpsisq, int ih){
// vIpsi is for m, vpsisq is for mj
// use pointers so can check whether ih = jh
// purposely don't set df = 0 here to allow multiple ih's
double mjc = get_c(mj);
dcomp mw = get_w(m), yw = gamma_w(m, geo);
Complexfun psi, eps;
CreateComplexfun(&psi,m->vpsi, vIpsi);
CreateComplexfun(&eps,geo->veps, geo->vIeps);
Vecfun f,H, psisq;
CreateVecfun(&f, geo->vf);
CreateVecfun(&H, geo->vH);
CreateVecfun(&psisq, vpsisq);
int i;
for(i=psi.ns; i<psi.ne; i++){
dcomp dfdk = 0.0, dfdc = 0.0,
DfywHpsi = geo->D * valr(&f, i) * yw * valr(&H, i) * valc(&psi, i);
if(m == mj)
dfdk += ( -csqr(mw)*yw / geo->y +2.0*mw ) * DfywHpsi + 2.0*mw* valc(&eps, i)*valc(&psi, i);
// note: adding dcomp to a double ignores the imaginary part
if(m->lasing && valr(&f, i) != 0.0){
// dHdk removed; field simply rescaled -DL 6/15/14
dfdc = csqr(mw) * DfywHpsi * valr(&H, i);
dfdc *= (-2.0*mjc)*valr(&psisq, i);
}
if( !m->lasing)
VecSetComplex(dfR, dfI, i+offset(geo, ih), ir(geo, i), dfdk, INSERT_VALUES);
else{
VecSetValue(dfR, i+offset(geo, ih), ir(geo, i)? cimag(dfdk) : creal(dfdk), INSERT_VALUES );
VecSetValue(dfI, i+offset(geo, ih), ir(geo, i)? cimag(dfdc) : creal(dfdc), INSERT_VALUES );
// df is assembled in SetJacobian
}
}
DestroyComplexfun(&eps);
DestroyComplexfun(&psi);
DestroyVecfun(&f);
DestroyVecfun(&H);
DestroyVecfun(&psisq);
}
void TensorDerivative(Mode m, Mode mj, Geometry geo, Vec df, Vec vpsibra, Vec vIpsi, int ih){
double mjc = get_c(mj);
dcomp mw = get_w(m), yw = gamma_w(m, geo) ;
Vecfun f, H, psibra;
CreateVecfun(&f, geo->vf);
CreateVecfun(&H, geo->vH);
CreateVecfun(&psibra, vpsibra);
Complexfun psi;
CreateComplexfun(&psi, m->vpsi, vIpsi);
int i;
for(i=f.ns; i<f.ne; i++){
if( valr(&f, i) == 0.0) continue;
dcomp ket_term = -csqr(mw ) * sqr(mjc) * 2.0
* sqr(valr(&H, i) ) * geo->D * valr(&f, i) * yw * valc(&psi, i);
double val = valr(&psibra, i) * (ir(geo, i)? cimag(ket_term) : creal(ket_term) );
VecSetValue(df, i+offset(geo, ih), val, INSERT_VALUES);
// df is assembled in SetJacobian
}
DestroyVecfun(&f);
DestroyVecfun(&H);
DestroyVecfun(&psibra);
DestroyComplexfun(&psi);
}
static void gob_nquadrupole(quadrupolepara* q2par,
const Gaussian* G1, const Gaussian* G2,
const GaussianAux* X, const gradGaussianAux* dX,
complex double* q2, gradGaussian* dq2)
{
double* Xcm = q2par->Xcm;
double* q=q2par->q;
int i,j, k;
complex double merr;
complex double rho2cm = 0.0;
gradGaussian drho2cm;
if (G1->xi == -1) {
for (i=0; i<3; i++)
rho2cm += csqr(X->rho[i]-Xcm[i]);
drho2cm.a = 0.0;
for (i=0; i<3; i++)
drho2cm.a += 2*(X->rho[i]-Xcm[i])*dX->drho.a[i];
for (i=0; i<3; i++)
drho2cm.b[i] = 2*(X->rho[i]-Xcm[i])*dX->drho.b;
for (j=0; j<3; j++) {
for (i=0; i<3; i++) {
merr = 3*(X->rho[i]-Xcm[i])*(X->rho[j]-Xcm[j]);
*q2 += q[i+j*3]* merr *X->Q;
for (k=0; k<2; k++)
dq2->chi[k] += q[i+j*3]* merr* dX->dQ.chi[k];
dq2->a += q[i+j*3]*
(3*(dX->drho.a[i]*(X->rho[j]-Xcm[j])+(X->rho[i]-Xcm[i])*dX->drho.a[j])*X->Q+
merr* dX->dQ.a);
dq2->b[i] += q[i+j*3]*
3*dX->drho.b*(X->rho[j]-Xcm[j])*X->Q;
dq2->b[j] += q[i+j*3]*
3*(X->rho[i]-Xcm[i])*dX->drho.b*X->Q;
for (k=0; k<3; k++)
dq2->b[k] += q[i+j*3]* merr* dX->dQ.b[k];
}
merr = rho2cm;
*q2 += - q[j+j*3]* merr* X->Q;
for (k=0; k<2; k++)
dq2->chi[k] += - q[j+j*3]* merr* dX->dQ.chi[k];
dq2->a += - q[j+j*3]* (drho2cm.a* X->Q + merr* dX->dQ.a);
for (k=0; k<3; k++)
dq2->b[k] += - q[j+j*3]*
(drho2cm.b[k]*X->Q + merr* dX->dQ.b[k]);
}
}
}
static void ob_densx(densparameters* par,
const Gaussian* G1, const Gaussian* G2,
const GaussianAux* X, complex double* dens)
{
int n = par->npoints;
double xmax = par->range;
int i,j,k;
double x,y,z;
for (k=0; k<n; k++)
for (j=0; j<n; j++)
for (i=0; i<n; i++) {
x = -xmax+2*xmax*i/(n-1);
y = -xmax+2*xmax*j/(n-1);
z = -xmax+2*xmax*k/(n-1);
dens[i+j*n+k*n*n] +=
cexp(-0.5*(csqr(x - conj(G1->b[0]))+csqr(y - conj(G1->b[1]))+
csqr(z - conj(G1->b[2])))/conj(G1->a)
-0.5*(csqr(x - G2->b[0])+csqr(y - G2->b[1])+
csqr(z - G2->b[2]))/G2->a)*
X->T*X->S;
}
}
// calculate x^2 and p^2 matrix elements
static void ob_nosci(void* par,
const Gaussian*G1, const Gaussian* G2,
const GaussianAux* X,
complex double nosci[2])
{
// assume Slater determinants are in origin
double Xcm[3] = {0, 0, 0};
double Vcm[3] = {0, 0, 0};
int i;
complex double rho2cm, pi2cm;
rho2cm = 3*X->alpha;
for (i=0; i<3; i++)
rho2cm += csqr(X->rho[i]-Xcm[i]);
pi2cm = 3*X->lambda;
for (i=0; i<3; i++)
pi2cm += csqr(X->pi[i]-mass(G1->xi)*Vcm[i]);
nosci[0] = rho2cm* X->Q;
nosci[1] = pi2cm* X->Q;
}
static cmpl
mult_layer_refl_ni_jacob_th(int nb, const cmpl ns[], const double ds[],
double lambda, cmpl *jacth)
{
const double omega = 2 * M_PI / lambda;
const int nblyr = nb - 2;
cmpl R;
cmpl nt, nc;
int j;
nt = ns[nb-2];
nc = ns[nb-1];
R = refl_coeff_ni(nt, nc);
for(j = nb - 3; j >= 0; j--) {
cmpl r, rho, beta, drhodth;
cmpl dfdR, dfdrho;
cmpl den, isqden;
double th = ds[j];
int k;
nc = nt;
nt = ns[j];
beta = - 2.0 * I * omega * nc;
rho = cexp(beta * THICKNESS_TO_NM(th));
drhodth = rho * beta * THICKNESS_TO_NM(1.0);
r = refl_coeff_ni(nt, nc);
den = 1 + r * R * rho;
isqden = 1 / csqr(den);
dfdR = rho * (1 - r*r) * isqden;
for(k = nblyr; k > j+1; k--) {
jacth[k-1] *= dfdR;
}
dfdrho = R * (1 - r*r) * isqden;
jacth[j] = dfdrho * drhodth;
R = (r + R * rho) / den;
}
return R;
}
static void ob_inertia(const double* Xcm,
const Gaussian* G1, const Gaussian* G2,
const GaussianAux* X, complex double T[9])
{
complex double rho2cm = 0.0;
int i,j;
for (i=0; i<3; i++)
rho2cm += csqr(X->rho[i]-Xcm[i]);
for (j=0; j<3; j++)
for (i=0; i<3; i++) {
T[i+j*3] -= (X->rho[i]-Xcm[i])*(X->rho[j]-Xcm[j])*X->Q;
if (i==j) T[i+j*3] += (2*X->alpha + rho2cm)*X->Q;
}
}
static void ob_quadrupole(const double* Xcm,
const Gaussian*G1, const Gaussian* G2,
const GaussianAux* X,
complex double q[9])
{
int i,j;
complex double rho2cm = 0.0;
for (i=0; i<3; i++)
rho2cm += csqr(X->rho[i]-Xcm[i]);
for (j=0; j<3; j++) {
for (i=0; i<3; i++)
q[i+j*3] += 3*(X->rho[i]-Xcm[i])*(X->rho[j]-Xcm[j])*X->Q;
q[j+j*3] += - rho2cm* X->Q;
}
}
static void ob_octupole(const double* Xcm,
const Gaussian*G1, const Gaussian* G2,
const GaussianAux* X,
complex double o[27])
{
complex double rho2cm = 0.0;
int i,j,k;
for (i=0; i<3; i++)
rho2cm += csqr(X->rho[i] - Xcm[i]);
for (k=0; k<3; k++)
for (j=0; j<3; j++)
for (i=0; i<3; i++) {
o[i+j*3+k*9] +=
5*(X->rho[i]-Xcm[i])*(X->rho[j]-Xcm[j])*(X->rho[k]-Xcm[k])*X->Q;
if (i==j) o[i+j*3+k*9] += - rho2cm* (X->rho[k]-Xcm[k])* X->Q;
if (j==k) o[i+j*3+k*9] += - rho2cm* (X->rho[i]-Xcm[i])* X->Q;
if (k==i) o[i+j*3+k*9] += - rho2cm* (X->rho[j]-Xcm[j])* X->Q;
}
}
void LinearDerivative(Mode m, Geometry geo, Vec dfR, Vec dfI, int ih){
Complexfun eps;
CreateComplexfun(&eps, geo->veps, geo->vIeps);
Vecfun f, H;
CreateVecfun(&f, geo->vf);
CreateVecfun(&H, geo->vH);
dcomp mw = get_w(m), yw = gamma_w(m, geo);
int i;
for(i=eps.ns; i<eps.ne; i++){
dcomp val = csqr(mw) * (valc(&eps, i) + geo->D * yw * valr(&f, i) * valr(&H, i) );
VecSetComplex(dfR, dfI, i+offset(geo, ih), ir(geo, i), val, INSERT_VALUES);
// df is assembled in SetJacobian
}
DestroyVecfun(&f);
DestroyVecfun(&H);
DestroyComplexfun(&eps);
}
static void gob_j2(const CMpara* par,
const Gaussian* G1, const Gaussian* G2,
const GaussianAux* X, const gradGaussianAux* dX,
complex double* j2, gradGaussian* dj2)
{
double* Xcm = par->Xcm;
double* Vcm = par->Vcm;
complex double l2m, s2m, lsm;
complex double beta, dbeta;
complex double rhocm[3], picm[3];
complex double rhocm2, picm2, rhopicm;
complex double rhoxpicm[3];
gradScalar dl2m, drhocm2, dpicm2, drhopicm;
gradGaussian dlsm;
int i;
beta = I*X->lambda*(conj(G1->a)-G2->a);
dbeta = I*dX->dlambda*(conj(G1->a)-G2->a) + I*X->lambda;
for (i=0; i<3; i++)
rhocm[i] = X->rho[i]-Xcm[i];
rhocm2 = cvec3mult(rhocm, rhocm);
for (i=0; i<3; i++)
picm[i] = X->pi[i]-mass(G1->xi)*Vcm[i];
picm2 = cvec3mult(picm, picm);
rhopicm = cvec3mult(rhocm, picm);
cvec3cross(rhocm, picm, rhoxpicm);
l2m = 2*X->lambda*rhocm2 + 2*X->alpha*picm2 - 2*beta*rhopicm
+ rhocm2*picm2 - csqr(rhopicm);
s2m = 0.75*X->S;
lsm = 0.5*cvec3mult(rhoxpicm, X->sig);
*j2 += X->T*(l2m*X->S + 2*lsm + s2m)*X->R;
drhocm2.a = 2*cvec3mult(rhocm, dX->drho.a);
for (i=0; i<3; i++)
drhocm2.b[i] = 2*rhocm[i]*dX->drho.b;
dpicm2.a = 2*cvec3mult(picm, dX->dpi.a);
for (i=0; i<3; i++)
dpicm2.b[i] = 2*picm[i]*dX->dpi.b;
drhopicm.a = cvec3mult(dX->drho.a, picm) + cvec3mult(rhocm, dX->dpi.a);
for (i=0; i<3; i++)
drhopicm.b[i] = dX->drho.b*picm[i] + rhocm[i]*dX->dpi.b;
dl2m.a = 2*dX->dlambda*rhocm2 + 2*X->lambda*drhocm2.a +
2*dX->dalpha*picm2 + 2*X->alpha*dpicm2.a -
2*dbeta*rhopicm - 2*beta*drhopicm.a +
drhocm2.a*picm2 + rhocm2*dpicm2.a -
2*rhopicm*drhopicm.a;
for (i=0; i<3; i++)
dl2m.b[i] = 2*X->lambda*drhocm2.b[i] + 2*X->alpha*dpicm2.b[i] -
2*beta*drhopicm.b[i] +
drhocm2.b[i]*picm2 + rhocm2*dpicm2.b[i] - 2*rhopicm*drhopicm.b[i];
for (i=0; i<2; i++)
dlsm.chi[i] = 0.5*cvec3mult(rhoxpicm, dX->dsig.chi[i]);
dlsm.a = 0.5*(cvec3spat(dX->drho.a, picm, X->sig)+
cvec3spat(rhocm, dX->dpi.a, X->sig));
dlsm.b[0] = 0.5*((dX->drho.b*picm[1]-rhocm[1]*dX->dpi.b)*X->sig[2] -
(dX->drho.b*picm[2]-rhocm[2]*dX->dpi.b)*X->sig[1]);
dlsm.b[1] = 0.5*((dX->drho.b*picm[2]-rhocm[2]*dX->dpi.b)*X->sig[0] -
(dX->drho.b*picm[0]-rhocm[0]*dX->dpi.b)*X->sig[2]);
dlsm.b[2] = 0.5*((dX->drho.b*picm[0]-rhocm[0]*dX->dpi.b)*X->sig[1] -
(dX->drho.b*picm[1]-rhocm[1]*dX->dpi.b)*X->sig[0]);
for (i=0; i<2; i++)
dj2->chi[i] += X->T* (l2m*dX->dS.chi[i]+2*dlsm.chi[i]+0.75*dX->dS.chi[i])* X->R;
dj2->a += X->T* (dl2m.a* X->S*X->R +
2*dlsm.a* X->R +
(l2m*X->S + 2*lsm + s2m)*dX->dR.a);
for (i=0; i<3; i++)
dj2->b[i] += X->T* (dl2m.b[i]* X->S*X->R +
2*dlsm.b[i]* X->R +
(l2m*X->S + 2*lsm + s2m)*dX->dR.b[i]);
}
int
elco2(double x, double y, double kc, double a, double b, double *u, double *v)
{
double c,d,dn1,dn2,e,e1,e2,f,f1,f2,h,k,m,m1,m2,sy;
double d1[13],d2[13];
int i,l;
if(kc==0||x<0)
return(0);
sy = y>0? 1: y==0? 0: -1;
y = fabs(y);
csq(x,y,&c,&e2);
d = kc*kc;
k = 1-d;
e1 = 1+c;
cdiv2(1+d*c,d*e2,e1,e2,&f1,&f2);
f2 = -k*x*y*2/f2;
csqr(f1,f2,&dn1,&dn2);
if(f1<0) {
f1 = dn1;
dn1 = -dn2;
dn2 = -f1;
}
if(k<0) {
dn1 = fabs(dn1);
dn2 = fabs(dn2);
}
c = 1+dn1;
cmul(e1,e2,c,dn2,&f1,&f2);
cdiv(x,y,f1,f2,&d1[0],&d2[0]);
h = a-b;
d = f = m = 1;
kc = fabs(kc);
e = a;
a += b;
l = 4;
for(i=1;;i++) {
m1 = (kc+m)/2;
m2 = m1*m1;
k *= f/(m2*4);
b += e*kc;
e = a;
cdiv2(kc+m*dn1,m*dn2,c,dn2,&f1,&f2);
csqr(f1/m1,k*dn2*2/f2,&dn1,&dn2);
cmul(dn1,dn2,x,y,&f1,&f2);
x = fabs(f1);
y = fabs(f2);
a += b/m1;
l *= 2;
c = 1 +dn1;
d *= k/2;
cmul(x,y,x,y,&e1,&e2);
k *= k;
cmul(c,dn2,1+e1*m2,e2*m2,&f1,&f2);
cdiv(d*x,d*y,f1,f2,&d1[i],&d2[i]);
if(k<=CC)
break;
kc = sqrt(m*kc);
f = m2;
m = m1;
}
f1 = f2 = 0;
for(;i>=0;i--) {
f1 += d1[i];
f2 += d2[i];
}
x *= m1;
y *= m1;
cdiv2(1-y,x,1+y,-x,&e1,&e2);
e2 = x*2/e2;
d = a/(m1*l);
*u = atan2(e2,e1);
if(*u<0)
*u += PI;
a = d*sy/2;
*u = d*(*u) + f1*h;
*v = (-1-log(e1*e1+e2*e2))*a + f2*h*sy + a;
return(1);
}