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 */