void Psi<EvalT, Traits>::
evaluateFields(typename Traits::EvalData workset)
{
//grab old phi value
Albany::MDArray phi_old = (*workset.stateArrayPtr)[phi_Name_];
//grab old psi value
Albany::MDArray psi_old = (*workset.stateArrayPtr)[psi_Name_];
// current time
const RealType t = workset.current_time;
// // do this only at the beginning
if (t == 0.0)
{
// // initializing psi_ values:
for (std::size_t cell = 0; cell < workset.numCells; ++cell)
{
for (std::size_t qp = 0; qp < num_qps_; ++qp)
{
psi_(cell, qp) = constant_value_;
}
}
}
else
{
// defining psi_
for (std::size_t cell = 0; cell < workset.numCells; ++cell)
{
for (std::size_t qp = 0; qp < num_qps_; ++qp)
{
ScalarT phi_bar = std::max(phi_old(cell, qp), phi_(cell, qp));
psi_(cell, qp) = std::max(psi_old(cell, qp), phi_bar);
}
}
}
}
/*< real function G_f (Theta) >*/
doublereal g_f__(doublereal *theta)
{
/* System generated locals */
integer i__1;
doublereal ret_val;
/* Local variables */
integer j;
extern doublereal gl_(doublereal *);
doublereal xt;
extern doublereal psi_(doublereal *, doublereal *);
doublereal xmm, xrm;
/*< parameter (Pi=3.141592653589793) >*/
/*< common /p/xLt,Rl,Tl,Rs,c,ild >*/
/*< real xLt,Rl,Tl,Rs,c,psi,gl >*/
/*< integer ild >*/
/*< common /gauss_m/xgm (20),wgm (20),n >*/
/*< real xgm,wgm >*/
/*< integer n >*/
/*< real Theta >*/
/*< real xmm,xrm,xt >*/
/*< integer j >*/
/*< xmm=0.5*(Pi/2.+0.) >*/
xmm = .78539816339744828;
/*< xrm=0.5*(Pi/2.-0.) >*/
xrm = .78539816339744828;
/*< G_f = 0. >*/
ret_val = 0.;
/*< do j=1,n >*/
i__1 = gauss_m__1.n;
for (j = 1; j <= i__1; ++j) {
/*< xt=xmm+xrm*xgm (j) >*/
xt = xmm + xrm * gauss_m__1.xgm[j - 1];
/*< G_f=G_f+wgm (j)*xrm*Psi (Theta,xt)*gl (xt) >*/
ret_val += gauss_m__1.wgm[j - 1] * xrm * psi_(theta, &xt) * gl_(&xt);
/*< enddo >*/
}
/*< return >*/
return ret_val;
/*< end >*/
} /* g_f__ */
void read_sf(float *x, int nx, int ny, int nz, float scale, float temp, CREFL *refl, int nrefl, int usepsi)
{
int count, p, q, r, used;
float dsq, fh, fk, fl, s, t;
fcomplex f, /*ww,*/ fsym;
int nsymop = 0;
char buf[100];
int i, k; /* k = 3, quadratic splines */
double psi;
int /*n_i[3],*/ N[4];
k = usepsi + 2;
N[1] = 2*nx;
N[2] = ny;
N[3] = nz;
/* nextf is a logical function used to read structure factors.
* If nextf is true, the arguments have returned the indices and
* value of the next structure factor in the input list.
* If nextf is false, there are no more structure factors.
*
* xpnd is a logical function used to apply symmetry relations
* to structure factors. If xpnd is true, a symmetry operator
* has been applied and the indices and value of the related
* structure factor have been returned. If xpnd is false, there
* are no more symmetry operators to apply for this hkl.
*/
s = (float)scale;
t = (float)(temp/4.0);
used = count = 0;
while (nextf(hin, &f, count, refl, nrefl))
{
count++;
fh = (float)hin[0];
fk = (float)hin[1];
fl = (float)hin[2];
dsq = fh*(fh*g11+fk*g12+fl*g13) + fk*(fk*g22+fl*g23) + g33*fl*fl;
if ((dsq <= dsqmax) && (dsq >= dsqmin))
{
used++;
f.re = (float)(s*exp(-t*dsq)*f.re);
f.im = (float)(s*exp(-t*dsq)*f.im);
if (usepsi)
{
psi = 1.;
for (i = 0; i < 3; ++i)
{
psi *= psi_(hin[i], N[i + 1], k);
}
f.re /= (float)psi;
f.im /= (float)psi;
}
/*
* the following is a complex exponent
* it is different from the above which is correct
* summer-1990
* cexp (&ww, -t*dsq);
* c_mul(f,ww,f);
* f.re *= s;
* f.im *= s;
*/
nsymop = 0;
while (xpnd(hin, hout, &f, &fsym, nsymop))
{
p = hout[0];
if (p < 0)
{
sprintf(buf, "Error in symmetry expansion\n");
Logger::log(buf);
sprintf(buf, "position %d hin= %d %d %d hout= %d %d %d\n",
nsymop+1, hin[0], hin[1], hin[2], hout[0], hout[1], hout[2]);
Logger::log(buf);
return;
}
q = hout[1];
r = hout[2];
if (p >= nx)
{
if (nx != 1)
{
expansion_error(nsymop);
}
return;
}
else
if (abs(q) >= ny)
{
if (ny != 1)
{
expansion_error(nsymop);
}
return;
}
else
if (abs(r) >= nz)
{
if (nz != 1)
{
expansion_error(nsymop);
}
return;
}
else
{
if (q < 0)
{
q += ny;
}
if (r < 0)
{
r += nz;
}
x[2*(r*nx*ny + q*nx + p)] = fsym.re;
x[2*(r*nx*ny + q*nx + p)+1] = fsym.im;
if (p <= 0)
{
/* Fill in the 0,-k,-l reflections by conjugate symmetry */
q = -hout[1];
r = -hout[2];
if (q < 0)
{
q += ny;
}
if (r < 0)
{
r += nz;
}
x[2*(r*nx*ny + q*nx)] = fsym.re;
x[2*(r*nx*ny + q*nx)+1] = -fsym.im;
}
}
nsymop++;
}
}
}
sprintf(buf, " %d structure factors used out of %d in input.\n\n", used, count);
Logger::log(buf);
}
