void nzmg_geod( double e, double n, double *ln, double *lt )
{
complex z0, z1, zn, zd, tmp1, tmp2;
double sum,tmp;
int i, it;
z0.real = (n-n0)/a; z0.imag = (e-e0)/a;
z1.real = cfb2[5].real; z1.imag = cfb2[5].imag;
for (i=5; i--; ) cadd(&z1, cmult(&z1, &z1, &z0), cfb2+i );
cmult(&z1,&z1,&z0);
for(it=2; it--; )
{
cscale( &zn, cfb1+5, 5.0);
cscale( &zd, cfb1+5, 6.0);
for (i=4; i; i--)
{
cadd( &zn, cmult(&tmp1, &zn, &z1), cscale(&tmp2, cfb1+i, (double) i));
cadd( &zd, cmult(&tmp1, &zd, &z1), cscale(&tmp2, cfb1+i, (double) (i+1)));
}
cadd( &zn, &z0, cmult( &zn, cmult( &zn, &zn, &z1), &z1));
cadd( &zd, cfb1, cmult( &zd, &zd, &z1 ));
cdiv( &z1, &zn, &zd );
}
*ln = ln0/rad2deg + z1.imag;
tmp = z1.real;
sum = cfl[8];
for (i=8; i--;) sum = sum*tmp + cfl[i];
sum *= tmp/3600.0e-5;
*lt = (lt0+sum)/rad2deg;
}
void mexFunction(int nlhs, mxArray *plhs[],
int nrhs, const mxArray *prhs[])
{
REAL scale; /* scale factor */
REAL dt; /* time step */
REAL dz; /* propagation stepsize */
int nz; /* number of z steps to take */
int nalpha; /* number of beta coefs */
double* alphap; /* alpha(w) array, if applicable */
int nbeta; /* number of beta coefs */
double* beta; /* dispersion polynomial coefs */
REAL gamma; /* nonlinearity coefficient */
REAL traman = 0; /* Raman response time */
REAL toptical = 0; /* Optical cycle time = lambda/c */
int maxiter = 4; /* max number of iterations */
REAL tol = 1e-5; /* convergence tolerance */
REAL* w; /* vector of angular frequencies */
int iz,ii,jj; /* loop counters */
REAL phase, alpha,
wii, fii; /* temporary variables */
COMPLEX
nlp, /* nonlinear phase */
*ua, *ub, *uc; /* samples of u at three adjacent times */
char argstr[100]; /* string argument */
if (nrhs == 1) {
if (mxGetString(prhs[0],argstr,100))
mexErrMsgTxt("Unrecognized option.");
if (!strcmp(argstr,"-savewisdom")) {
sspropc_save_wisdom();
}
else if (!strcmp(argstr,"-forgetwisdom")) {
FORGET_WISDOM();
}
else if (!strcmp(argstr,"-loadwisdom")) {
sspropc_load_wisdom();
}
else if (!strcmp(argstr,"-patient")) {
method = FFTW_PATIENT;
}
else if (!strcmp(argstr,"-exhaustive")) {
method = FFTW_EXHAUSTIVE;
}
else if (!strcmp(argstr,"-measure")) {
method = FFTW_MEASURE;
}
else if (!strcmp(argstr,"-estimate")) {
method = FFTW_ESTIMATE;
}
else
mexErrMsgTxt("Unrecognized option.");
return;
}
if (nrhs < 7)
mexErrMsgTxt("Not enough input arguments provided.");
if (nlhs > 1)
mexErrMsgTxt("Too many output arguments.");
sspropc_initialize_data(mxGetNumberOfElements(prhs[0]));
/* parse input arguments */
dt = (REAL) mxGetScalar(prhs[1]);
dz = (REAL) mxGetScalar(prhs[2]);
nz = round(mxGetScalar(prhs[3]));
nalpha = mxGetNumberOfElements(prhs[4]);
alphap = mxGetPr(prhs[4]);
beta = mxGetPr(prhs[5]);
nbeta = mxGetNumberOfElements(prhs[5]);
gamma = (REAL) mxGetScalar(prhs[6]);
if (nrhs > 7)
traman = (mxIsEmpty(prhs[7])) ? 0 : (REAL) mxGetScalar(prhs[7]);
if (nrhs > 8)
toptical = (mxIsEmpty(prhs[8])) ? 0 : (REAL) mxGetScalar(prhs[8]);
if (nrhs > 9)
maxiter = (mxIsEmpty(prhs[9])) ? 4 : round(mxGetScalar(prhs[9]));
if (nrhs > 10)
tol = (mxIsEmpty(prhs[10])) ? 1e-5 : (REAL) mxGetScalar(prhs[10]);
if ((nalpha != 1) && (nalpha != nt))
mexErrMsgTxt("Invalid vector length (alpha).");
/* compute vector of angular frequency components */
/* MATLAB equivalent: w = wspace(tv); */
w = (REAL*)mxMalloc(sizeof(REAL)*nt);
for (ii = 0; ii <= (nt-1)/2; ii++) {
w[ii] = 2*pi*ii/(dt*nt);
}
for (; ii < nt; ii++) {
w[ii] = 2*pi*ii/(dt*nt) - 2*pi/dt;
}
/* compute halfstep and initialize u0 and u1 */
for (jj = 0; jj < nt; jj++) {
if (nbeta != nt)
for (ii = 0, phase = 0, fii = 1, wii = 1;
ii < nbeta;
ii++, fii*=ii, wii*=w[jj])
phase += wii*((REAL)beta[ii])/fii;
else
phase = (REAL)beta[jj];
alpha = (nalpha == nt) ? (REAL)alphap[jj] : (REAL)alphap[0];
halfstep[jj][0] = +exp(-alpha*dz/4)*cos(phase*dz/2);
halfstep[jj][1] = -exp(-alpha*dz/4)*sin(phase*dz/2);
u0[jj][0] = (REAL) mxGetPr(prhs[0])[jj];
u0[jj][1] = mxIsComplex(prhs[0]) ? (REAL)(mxGetPi(prhs[0])[jj]) : 0.0;
u1[jj][0] = u0[jj][0];
u1[jj][1] = u0[jj][1];
}
mxFree(w); /* free w vector */
mexPrintf("Performing split-step iterations ... ");
EXECUTE(p1); /* ufft = fft(u0) */
for (iz = 0; iz < nz; iz++) {
cmult(uhalf,halfstep,ufft); /* uhalf = halfstep.*ufft */
EXECUTE(ip1); /* uhalf = nt*ifft(uhalf) */
for (ii = 0; ii < maxiter; ii++) {
if ((traman == 0.0) && (toptical == 0)) {
for (jj = 0; jj < nt; jj++) {
phase = gamma*(u0[jj][0]*u0[jj][0] +
u0[jj][1]*u0[jj][1] +
u1[jj][0]*u1[jj][0] +
u1[jj][1]*u1[jj][1])*dz/2;
uv[jj][0] = (uhalf[jj][0]*cos(phase) +
uhalf[jj][1]*sin(phase))/nt;
uv[jj][1] = (-uhalf[jj][0]*sin(phase) +
uhalf[jj][1]*cos(phase))/nt;
}
} else {
jj = 0;
ua = &u0[nt-1]; ub = &u0[jj]; uc = &u0[jj+1];
nlp[1] = -toptical*(abs2(uc) - abs2(ua) +
prodr(ub,uc) - prodr(ub,ua))/(4*pi*dt);
nlp[0] = abs2(ub) - traman*(abs2(uc) - abs2(ua))/(2*dt)
+ toptical*(prodi(ub,uc) - prodi(ub,ua))/(4*pi*dt);
ua = &u1[nt-1]; ub = &u1[jj]; uc = &u1[jj+1];
nlp[1] += -toptical*(abs2(uc) - abs2(ua) +
prodr(ub,uc) - prodr(ub,ua))/(4*pi*dt);
nlp[0] += abs2(ub) - traman*(abs2(uc) - abs2(ua))/(2*dt)
+ toptical*(prodi(ub,uc) - prodi(ub,ua))/(4*pi*dt);
nlp[0] *= gamma*dz/2;
nlp[1] *= gamma*dz/2;
uv[jj][0] = (uhalf[jj][0]*cos(nlp[0])*exp(+nlp[1]) +
uhalf[jj][1]*sin(nlp[0])*exp(+nlp[1]))/nt;
uv[jj][1] = (-uhalf[jj][0]*sin(nlp[0])*exp(+nlp[1]) +
uhalf[jj][1]*cos(nlp[0])*exp(+nlp[1]))/nt;
for (jj = 1; jj < nt-1; jj++) {
ua = &u0[jj-1]; ub = &u0[jj]; uc = &u0[jj+1];
nlp[1] = -toptical*(abs2(uc) - abs2(ua) +
prodr(ub,uc) - prodr(ub,ua))/(4*pi*dt);
nlp[0] = abs2(ub) - traman*(abs2(uc) - abs2(ua))/(2*dt)
+ toptical*(prodi(ub,uc) - prodi(ub,ua))/(4*pi*dt);
ua = &u1[jj-1]; ub = &u1[jj]; uc = &u1[jj+1];
nlp[1] += -toptical*(abs2(uc) - abs2(ua) +
prodr(ub,uc) - prodr(ub,ua))/(4*pi*dt);
nlp[0] += abs2(ub) - traman*(abs2(uc) - abs2(ua))/(2*dt)
+ toptical*(prodi(ub,uc) - prodi(ub,ua))/(4*pi*dt);
nlp[0] *= gamma*dz/2;
nlp[1] *= gamma*dz/2;
uv[jj][0] = (uhalf[jj][0]*cos(nlp[0])*exp(+nlp[1]) +
uhalf[jj][1]*sin(nlp[0])*exp(+nlp[1]))/nt;
uv[jj][1] = (-uhalf[jj][0]*sin(nlp[0])*exp(+nlp[1]) +
uhalf[jj][1]*cos(nlp[0])*exp(+nlp[1]))/nt;
}
/* we now handle the endpoint where jj = nt-1 */
ua = &u0[jj-1]; ub = &u0[jj]; uc = &u0[0];
nlp[1] = -toptical*(abs2(uc) - abs2(ua) +
prodr(ub,uc) - prodr(ub,ua))/(4*pi*dt);
nlp[0] = abs2(ub) - traman*(abs2(uc) - abs2(ua))/(2*dt)
+ toptical*(prodi(ub,uc) - prodi(ub,ua))/(4*pi*dt);
ua = &u1[jj-1]; ub = &u1[jj]; uc = &u1[0];
nlp[1] += -toptical*(abs2(uc) - abs2(ua) +
prodr(ub,uc) - prodr(ub,ua))/(4*pi*dt);
nlp[0] += abs2(ub) - traman*(abs2(uc) - abs2(ua))/(2*dt)
+ toptical*(prodi(ub,uc) - prodi(ub,ua))/(4*pi*dt);
nlp[0] *= gamma*dz/2;
nlp[1] *= gamma*dz/2;
uv[jj][0] = (uhalf[jj][0]*cos(nlp[0])*exp(+nlp[1]) +
uhalf[jj][1]*sin(nlp[0])*exp(+nlp[1]))/nt;
uv[jj][1] = (-uhalf[jj][0]*sin(nlp[0])*exp(+nlp[1]) +
uhalf[jj][1]*cos(nlp[0])*exp(+nlp[1]))/nt;
}
EXECUTE(p2); /* uv = fft(uv) */
cmult(ufft,uv,halfstep); /* ufft = uv.*halfstep */
EXECUTE(ip2); /* uv = nt*ifft(ufft) */
if (ssconverged(uv,u1,tol)) { /* test for convergence */
cscale(u1,uv,1.0/nt); /* u1 = uv/nt; */
break; /* exit from ii loop */
} else {
cscale(u1,uv,1.0/nt); /* u1 = uv/nt; */
}
}
if (ii == maxiter)
mexWarnMsgTxt("Failed to converge.");
cscale(u0,u1,1); /* u0 = u1 */
}
mexPrintf("done.\n");
/* allocate space for returned vector */
plhs[0] = mxCreateDoubleMatrix(nt,1,mxCOMPLEX);
for (jj = 0; jj < nt; jj++) {
mxGetPr(plhs[0])[jj] = (double) u1[jj][0]; /* fill return vector */
mxGetPi(plhs[0])[jj] = (double) u1[jj][1]; /* with u1 */
}
sspropc_destroy_data();
}
/* This is the gateway function between MATLAB and SSPROPVC. It
* serves as the main(). */
void mexFunction(int nlhs, mxArray *plhs[],
int nrhs, const mxArray *prhs[])
{
COMPLEX *u0a, *u0b, *uafft, *ubfft, *uahalf, *ubhalf,
*uva, *uvb, *u1a, *u1b;
COMPLEX *ha, *hb; /* exp{ (-Alpha(w)/2-jBeta(w)) z} */
COMPLEX *h11, *h12,/* linear propgation coefficients */
*h21, *h22;
REAL dt; /* time step */
REAL dz; /* propagation stepsize */
int nz; /* number of z steps to take */
REAL gamma; /* nonlinearity coefficient */
REAL chi = 0.0; /* degree of ellipticity */
REAL psi = 0.0; /* angular orientation to x-axis */
int maxiter = 4; /* max number of iterations */
REAL tol = 1e-5; /* convergence tolerance */
int nt; /* number of fft points */
REAL* w; /* vector of angular frequencies */
PLAN p1a,p1b,ip1a,ip1b; /* fft plans for 1st linear half */
PLAN p2a,p2b,ip2a,ip2b; /* fft plans for 2nd linear half */
int converged; /* holds the return of is_converged */
char methodstr[11]; /* method name: 'circular or 'elliptical' */
int elliptical = 1; /* if elliptical method, then != 0 */
char argstr[100]; /* string argument */
int iz,ii,jj; /* loop counters */
if (nrhs == 1) {
if (mxGetString(prhs[0],argstr,100))
mexErrMsgTxt("Unrecognized option.");
if (!strcmp(argstr,"-savewisdom")) {
sspropvc_save_wisdom();
}
else if (!strcmp(argstr,"-forgetwisdom")) {
FORGET_WISDOM();
}
else if (!strcmp(argstr,"-loadwisdom")) {
sspropvc_load_wisdom();
}
else if (!strcmp(argstr,"-patient")) {
method = FFTW_PATIENT;
}
else if (!strcmp(argstr,"-exhaustive")) {
method = FFTW_EXHAUSTIVE;
}
else if (!strcmp(argstr,"-measure")) {
method = FFTW_MEASURE;
}
else if (!strcmp(argstr,"-estimate")) {
method = FFTW_ESTIMATE;
}
else
mexErrMsgTxt("Unrecognized option.");
return;
}
if (nrhs < 10)
mexErrMsgTxt("Not enough input arguments provided.");
if (nlhs > 2)
mexErrMsgTxt("Too many output arguments.");
if (firstcall) { /* attempt to load wisdom file on first call */
sspropvc_load_wisdom();
firstcall = 0;
}
/* parse input arguments */
dt = (REAL) mxGetScalar(prhs[2]);
dz = (REAL) mxGetScalar(prhs[3]);
nz = round(mxGetScalar(prhs[4]));
gamma = (REAL) mxGetScalar(prhs[9]);
if (nrhs > 10) { /* default is chi = psi = 0.0 */
psi = (REAL) mxGetScalar(prhs[10]);
if (mxGetNumberOfElements(prhs[10]) > 1)
chi = (REAL) (mxGetPr(prhs[10])[1]);
}
if (nrhs > 11) { /* default method is elliptical */
if (mxGetString(prhs[11],methodstr,11)) /* fail */
mexErrMsgTxt("incorrect method: elliptical or ciruclar only");
else { /* success */
if (!strcmp(methodstr,"circular"))
elliptical = 0;
else if(!strcmp(methodstr,"elliptical"))
elliptical = 1;
else
mexErrMsgTxt("incorrect method: elliptical or ciruclar only");
}
}
if (nrhs > 12) /* default = 4 */
maxiter = round(mxGetScalar(prhs[12]));
if (nrhs > 13) /* default = 1e-5 */
tol = (REAL) mxGetScalar(prhs[13]);
nt = mxGetNumberOfElements(prhs[0]); /* # of points in vectors */
/* allocate memory */
u0a = (COMPLEX*) mxMalloc(sizeof(COMPLEX)*nt);
u0b = (COMPLEX*) mxMalloc(sizeof(COMPLEX)*nt);
uafft = (COMPLEX*) mxMalloc(sizeof(COMPLEX)*nt);
ubfft = (COMPLEX*) mxMalloc(sizeof(COMPLEX)*nt);
uahalf = (COMPLEX*) mxMalloc(sizeof(COMPLEX)*nt);
ubhalf = (COMPLEX*) mxMalloc(sizeof(COMPLEX)*nt);
uva = (COMPLEX*) mxMalloc(sizeof(COMPLEX)*nt);
uvb = (COMPLEX*) mxMalloc(sizeof(COMPLEX)*nt);
u1a = (COMPLEX*) mxMalloc(sizeof(COMPLEX)*nt);
u1b = (COMPLEX*) mxMalloc(sizeof(COMPLEX)*nt);
ha = (COMPLEX*) mxMalloc(sizeof(COMPLEX)*nt);
hb = (COMPLEX*) mxMalloc(sizeof(COMPLEX)*nt);
h11 = (COMPLEX*) mxMalloc(sizeof(COMPLEX)*nt);
h12 = (COMPLEX*) mxMalloc(sizeof(COMPLEX)*nt);
h21 = (COMPLEX*) mxMalloc(sizeof(COMPLEX)*nt);
h22 = (COMPLEX*) mxMalloc(sizeof(COMPLEX)*nt);
w = (REAL*)mxMalloc(sizeof(REAL)*nt);
plhs[0] = mxCreateDoubleMatrix(nt,1,mxCOMPLEX);
plhs[1] = mxCreateDoubleMatrix(nt,1,mxCOMPLEX);
/* fftw3 plans */
p1a = MAKE_PLAN(nt, u0a, uafft, FFTW_FORWARD, method);
p1b = MAKE_PLAN(nt, u0b, ubfft, FFTW_FORWARD, method);
ip1a = MAKE_PLAN(nt, uahalf, uahalf, FFTW_BACKWARD, method);
ip1b = MAKE_PLAN(nt, ubhalf, ubhalf, FFTW_BACKWARD, method);
p2a = MAKE_PLAN(nt, uva, uva, FFTW_FORWARD, method);
p2b = MAKE_PLAN(nt, uvb, uvb, FFTW_FORWARD, method);
ip2a = MAKE_PLAN(nt, uafft, uva, FFTW_BACKWARD, method);
ip2b = MAKE_PLAN(nt, ubfft, uvb, FFTW_BACKWARD, method);
allocated = 1;
/* Compute vector of angular frequency components
* MATLAB equivalent: w = wspace(tv); */
compute_w(w,dt,nt);
/* Compute ha & hb vectors
* ha = exp[(-alphaa(w)/2 - j*betaa(w))*dz/2])
* hb = exp[(-alphab(w)/2 - j*betab(w))*dz/2])
* prhs[5]=alphaa prhs[6]=alphab prhs[7]=betaa prhs[8]=betab */
compute_hahb(ha,hb,prhs[5],prhs[6],prhs[7],prhs[8],w,dz,nt);
mexPrintf("Performing split-step iterations ... ");
if (elliptical) { /* Elliptical Method */
/* Rotate to eignestates of fiber
* u0a = ( cos(psi)*cos(chi) - j*sin(psi)*sin(chi))*u0x + ...
* ( sin(psi)*cos(chi) + j*cos(psi)*sin(chi))*u0y;
* u0b = (-sin(psi)*cos(chi) + j*cos(psi)*sin(chi))*u0x + ...
* ( cos(psi)*cos(chi) + j*sin(psi)*sin(chi))*u0y;
*/
rotate_coord(u0a,u0b,prhs[0],prhs[1],chi,psi,nt);
cscale(u1a,u0a,u1b,u0b,1.0,nt); /* u1a=u0a u1b=u0b */
EXECUTE(p1a); /* uafft = fft(u0a) */
EXECUTE(p1b); /* ubfft = fft(u0b) */
for(iz=1; iz <= nz; iz++)
{
/* Linear propagation (1st half):
* uahalf = ha .* uafft
* ubhalf = hb .* ubfft */
prop_linear_ellipt(uahalf,ubhalf,ha,hb,uafft,ubfft,nt);
EXECUTE(ip1a); /* uahalf = ifft(uahalf) */
EXECUTE(ip1b); /* ubhalf = ifft(ubhalf) */
/* uahalf=uahalf/nt ubhalf=ubhalf/nt */
cscale(uahalf,uahalf,ubhalf,ubhalf,1.0/nt,nt);
ii = 0;
do
{
/* Calculate nonlinear section: output=uva,uvb */
nonlinear_propagate(uva,uvb,uahalf,ubhalf,u0a,u0b,u1a,u1b,
gamma,dz,chi,nt);
EXECUTE(p2a); /* uva = fft(uva) */
EXECUTE(p2b); /* uvb = fft(uvb) */
/* Linear propagation (2nd half):
* uafft = ha .* uva
* ubfft = hb .* uvb */
prop_linear_ellipt(uafft,ubfft,ha,hb,uva,uvb,nt);
EXECUTE(ip2a); /* uva = ifft(uafft) */
EXECUTE(ip2b); /* uvb = ifft(ubfft) */
/* Check if uva & u1a and uvb & u1b converged
* converged = ( ( sqrt(norm(uva-u1a,2).^2+norm(uvb-u1b,2).^2) /...
* sqrt(norm(u1a,2).^2+norm(u1b,2).^2) ) < tol )
*/
converged = is_converged(uva,u1a,uvb,u1b,tol,nt);
/* u1a=uva/nt u1b=uvb/nt */
cscale(u1a,uva,u1b,uvb,1.0/nt,nt);
ii++;
} while(!converged && ii < maxiter); /* end convergence loop */
if(ii == maxiter)
mexPrintf("Warning: Failed to converge to %f in %d iterations\n",
tol,maxiter);
/* u0a=u1a u0b=u1b */
cscale(u0a,u1a,u0b,u1b,1.0,nt);
} /* end step loop */
/* Rotate back to original x-y basis
* u1x = ( cos(psi)*cos(chi) + j*sin(psi)*sin(chi))*u1a + ...
* (-sin(psi)*cos(chi) - j*cos(psi)*sin(chi))*u1b;
* u1y = ( sin(psi)*cos(chi) - j*cos(psi)*sin(chi))*u1a + ...
* ( cos(psi)*cos(chi) - j*sin(psi)*sin(chi))*u1b;
*/
inv_rotate_coord(plhs[0],plhs[1],u1a,u1b,chi,psi,nt);
}
else { /* Circular method */
/* Compute H matrix = [ h11 h12
* h21 h22 ] for linear propagation
* h11 = ( (1+sin(2*chi))*ha + (1-sin(2*chi))*hb )/2;
* h12 = -j*exp(+j*2*psi)*cos(2*chi)*(ha-hb)/2;
* h21 = +j*exp(-j*2*psi)*cos(2*chi)*(ha-hb)/2;
* h22 = ( (1-sin(2*chi))*ha + (1+sin(2*chi))*hb )/2;
*/
compute_H(h11,h12,h21,h22,ha,hb,chi,psi,nt);
/* Rotate to circular coordinate system
* u0a = (1/sqrt(2)).*(u0x + j*u0y);
* u0b = (1/sqrt(2)).*(j*u0x + u0y); */
rotate_coord(u0a,u0b,prhs[0],prhs[1],pi/4,0,nt);
cscale(u1a,u0a,u1b,u0b,1.0,nt); /* u1a=u0a u1b=u0b */
EXECUTE(p1a); /* uafft = fft(u0a) */
EXECUTE(p1b); /* ubfft = fft(u0b) */
for(iz=1; iz <= nz; iz++)
{
/* Linear propagation (1st half):
* uahalf = h11 .* uafft + h12 .* ubfft
* ubhalf = h21 .* uafft + h22 .* ubfft */
prop_linear_circ(uahalf,ubhalf,h11,h12,h21,h22,uafft,ubfft,nt);
EXECUTE(ip1a); /* uahalf = ifft(uahalf) */
EXECUTE(ip1b); /* ubhalf = ifft(ubhalf) */
/* uahalf=uahalf/nt ubhalf=ubhalf/nt */
cscale(uahalf,uahalf,ubhalf,ubhalf,1.0/nt,nt);
ii = 0;
do
{
/* Calculate nonlinear section: output=uva,uvb */
nonlinear_propagate(uva,uvb,uahalf,ubhalf,u0a,u0b,u1a,u1b,
gamma,dz,pi/4,nt);
EXECUTE(p2a); /* uva = fft(uva) */
EXECUTE(p2b); /* uvb = fft(uvb) */
/* Linear propagation (2nd half):
* uafft = h11 .* uva + h12 .* uvb
* ubfft = h21 .* uva + h22 .* uvb */
prop_linear_circ(uafft,ubfft,h11,h12,h21,h22,uva,uvb,nt);
EXECUTE(ip2a); /* uva = ifft(uafft) */
EXECUTE(ip2b); /* uvb = ifft(ubfft) */
/* Check if uva & u1a and uvb & u1b converged
* ( sqrt(norm(uva-u1a,2).^2+norm(uvb-u1b,2).^2) /...
* sqrt(norm(u1a,2).^2+norm(u1b,2).^2) ) < tol
*/
converged = is_converged(uva,u1a,uvb,u1b,tol,nt);
/* u1a=uva/nt u1b=uvb/nt */
cscale(u1a,uva,u1b,uvb,1.0/nt,nt);
ii++;
} while(!converged && ii < maxiter); /* end convergence loop */
if(ii == maxiter)
mexPrintf("Warning: Failed to converge to %f in %d iterations\n",
tol,maxiter);
/* u0a=u1a u0b=u1b */
cscale(u0a,u1a,u0b,u1b,1.0,nt);
} /* end step loop */
/* Rotate back to orignal x-y basis
* u1x = (1/sqrt(2)).*(u1a-j*u1b) ;
* u1y = (1/sqrt(2)).*(-j*u1a+u1b) ; */
inv_rotate_coord(plhs[0],plhs[1],u1a,u1b,pi/4,0,nt);
} /* end circular method */
mexPrintf("done.\n");
if (allocated) {
/* destroy fftw3 plans */
DESTROY_PLAN(p1a);
DESTROY_PLAN(p1b);
DESTROY_PLAN(ip1a);
DESTROY_PLAN(ip1b);
DESTROY_PLAN(p2a);
DESTROY_PLAN(p2b);
DESTROY_PLAN(ip2a);
DESTROY_PLAN(ip2b);
/* de-allocate memory */
mxFree(u0a);
mxFree(u0b);
mxFree(uafft);
mxFree(ubfft);
mxFree(uahalf);
mxFree(ubhalf);
mxFree(uva);
mxFree(uvb);
mxFree(u1a);
mxFree(u1b);
mxFree(ha);
mxFree(hb);
mxFree(h11);
mxFree(h12);
mxFree(h21);
mxFree(h22);
mxFree(w);
allocated = 0;
}
} /* end mexFunction */
/*
* initialise global object
*/
int initials(char *sname,
int type, int ident, int dim, int more,
TAG_SYMBOL * tag, char zfar)
{
int size, desize = 0;
int olddim = dim;
if (cmatch('=')) {
/* initialiser present */
defstatic = 1; /* So no 2nd redefine djm */
gltptr = 0;
glblab = getlabel();
if (dim == 0)
dim = -1;
switch (type) {
case CCHAR:
size = 1;
break;
case LONG:
size = 4;
break;
case CINT:
default:
size = 2;
}
output_section("data_compiler"); // output_section("text");
prefix();
outname(sname, YES);
col();
nl();
if (cmatch('{')) {
/* aggregate initialiser */
if ((ident == POINTER || ident == VARIABLE) && type == STRUCT) {
/* aggregate is structure or pointer to structure */
dim = 0; olddim = 1;
if (ident == POINTER)
point();
str_init(tag);
} else {
/* aggregate is not struct or struct pointer */
agg_init(size, type, ident, &dim, more, tag);
}
needchar('}');
} else {
/* single initialiser */
init(size, ident, &dim, more, 0, 0);
}
/* dump literal queue and fill tail of array with zeros */
if ((ident == ARRAY && more == CCHAR) || type == STRUCT) {
if (type == STRUCT) {
dumpzero(tag->size, dim);
desize = dim < 0 ? abs(dim+1)*tag->size : olddim * tag->size;
} else { /* Handles unsized arrays of chars */
dumpzero(size, dim);
dim = dim < 0 ? abs(dim+1) : olddim;
cscale(type,tag,&dim);
desize = dim;
}
dumplits(0, YES, gltptr, glblab, glbq);
} else {
if (!(ident == POINTER && type == CCHAR)) {
dumplits(((size == 1) ? 0 : size), NO, gltptr, glblab,glbq);
if ( type != CCHAR ) /* Already dumped by init? */
desize = dumpzero(size, dim);
dim = dim < 0 ? abs(dim+1) : olddim;
cscale(type,tag,&dim);
desize = dim;
}
}
output_section("code_compiler"); // output_section("code");
} else {
char *dosign, *typ;
dosign = "";
if (ident == ARRAY && (dim == 0)) {
typ = ExpandType(more, &dosign, (tag - tagtab));
warning(W_NULLARRAY, dosign, typ);
}
/* no initialiser present, let loader insert zero */
if (ident == POINTER)
type = (zfar ? CPTR : CINT);
cscale(type, tag, &dim);
desize = dim;
}
return (desize);
}
/**
Read in asterism WFS wvf.*/
long setup_star_read_wvf(STAR_S *star, int nstar, const PARMS_S *parms, int seed){
const double ngsgrid=parms->maos.ngsgrid;
const int nwvl=parms->maos.nwvl;
long nstep=0;
TIC;tic;
for(int istar=0; istar<nstar; istar++){
STAR_S *stari=&star[istar];
int npowfs=parms->maos.npowfs;
stari->wvfout=mycalloc(npowfs,ccell**);
const double thetax=stari->thetax*206265;/*in as */
const double thetay=stari->thetay*206265;
double thxnorm=thetax/ngsgrid;
double thynorm=thetay/ngsgrid;
long thxl=(long)floor(thxnorm);/*Used to be double, but -0 appears. */
long thyl=(long)floor(thynorm);
double wtx=thxnorm-thxl;
double wty=thynorm-thyl;
for(int ipowfs=0; ipowfs<npowfs; ipowfs++){
const int msa=parms->maos.msa[ipowfs];
const int nsa=parms->maos.nsa[ipowfs];
if(stari->use[ipowfs]==0){
continue;
}
char *fnwvf[2][2]={{NULL,NULL},{NULL,NULL}};
PISTAT_S *pistati=&stari->pistat[ipowfs];
/*info2("Reading PSF for (%5.1f, %5.1f), ipowfs=%d\n",thetax,thetay,ipowfs); */
double wtsum=0;
for(int ix=0; ix<2; ix++){
double thx=(thxl+ix)*ngsgrid;
for(int iy=0; iy<2; iy++){
double thy=(thyl+iy)*ngsgrid;
double wtxi=fabs(((1-ix)-wtx)*((1-iy)-wty));
if(wtxi<0.01){
/*info("skipping ix=%d,iy=%d because wt=%g\n",ix,iy,wtxi); */
continue;
}
fnwvf[iy][ix]=myalloca(PATH_MAX, char);
snprintf(fnwvf[iy][ix],PATH_MAX,"%s/wvfout/wvfout_seed%d_sa%d_x%g_y%g",
dirstart,seed,msa,thx,thy);
if(!zfexist(fnwvf[iy][ix])){
//warning("%s doesnot exist\n",fnwvf[iy][ix]);
fnwvf[iy][ix]=0;
}else{
wtsum+=wtxi;
}
}
}
if(wtsum<0.01){
error("PSF is not available for (%g,%g). wtsum=%g\n",thetax,thetay, wtsum);
}
/*Now do the actual reading */
for(int ix=0; ix<2; ix++){
for(int iy=0; iy<2; iy++){
double wtxi=fabs(((1-ix)-wtx)*((1-iy)-wty))/wtsum;
if(fnwvf[iy][ix]){
/*info("Loading %.4f x %s\n", wtxi, fnwvf[iy][ix]); */
file_t *fp_wvf=zfopen(fnwvf[iy][ix],"rb");
header_t header={0,0,0,0};
read_header(&header, fp_wvf);
if(!iscell(&header.magic)){
error("expected data type: %u, got %u\n",(uint32_t)MCC_ANY, header.magic);
}
nstep=header.nx;
free(header.str);
if(parms->skyc.limitnstep >0 && nstep>parms->skyc.limitnstep){
nstep=parms->skyc.limitnstep;
warning("Only read %ld steps\n",nstep);
}
if(stari->nstep==0){
stari->nstep=nstep;
}else{
if(stari->nstep!=nstep){
error("Different type has different steps\n");
}
}
if(!stari->wvfout[ipowfs]){
stari->wvfout[ipowfs]=mycalloc(nstep,ccell*);
}
ccell **pwvfout=stari->wvfout[ipowfs];
for(long istep=0; istep<nstep; istep++){
ccell *wvfi=ccellreaddata(fp_wvf, 0);
ccelladd(&(pwvfout[istep]), 1, wvfi, wtxi);
ccellfree(wvfi);
}
/*zfeof(fp_wvf); */
zfclose(fp_wvf);
}
}/*iy */
}/*ix */
/*Don't bother to scale ztiltout since it does not participate in physical optics simulations. */
if(parms->skyc.bspstrehl){
dmat* scale=pistati->scale;
ccell **pwvfout=stari->wvfout[ipowfs];
for(int iwvl=0; iwvl<nwvl; iwvl++){
for(int isa=0; isa<nsa; isa++){
/*info("Scaling WVF isa %d iwvl %d with %g\n", isa, iwvl, IND(scale,isa,iwvl)); */
for(long istep=0; istep<stari->nstep; istep++){
cscale(pwvfout[istep]->p[isa+nsa*iwvl], IND(scale,isa,iwvl));
}/*istep */
}/*isa */
}/*iwvl */
}/* */
}/*ipowfs */
}/*istar */
