static void test_part(){/**Compute the covariance of 4 points with various separation.*/
rand_t rstat;
int seed=4;
double r0=0.2;
double dx=1./64.;
long N=1+2;
long ofx=0;
long ofy=0;
long nx=N;
long ny=N;
long nframe=1000000;
seed_rand(&rstat, seed);
map_t *atm=mapnew(nx, ny, dx,dx, NULL);
dmat *vec=dnew(4,1);
dmat *cov=NULL;
dmat* pp=(dmat*)atm;
for(long i=0; i<nframe; i++){
info("%ld of %ld\n", i, nframe);
for(long j=0; j<nx*ny; j++){
atm->p[j]=randn(&rstat);
}
fractal_do((dmat*)atm, dx, r0,L0,ninit);
vec->p[0]=IND(pp,ofx+0,ofy+0);
vec->p[1]=IND(pp,ofx+1,ofy+0);
vec->p[2]=IND(pp,ofx+0,ofy+1);
vec->p[3]=IND(pp,ofx+1,ofy+1);
dmm(&cov, 1, vec, vec, "nt", 1);
}
dscale(cov, 1./nframe);
writebin(cov,"cov.bin");
}
static void test_cov(){/*not good */
rand_t rstat;
int seed=4;
double r0=0.2;
double dx=1./64;
long N=1+1024;
long nx=N;
long ny=N;
long nframe=1;
seed_rand(&rstat, seed);
map_t *atm=mapnew(nx, ny, dx,dx, NULL);
cmat *atmhat=cnew((N+1)*3,(N+1)*3);
dmat *atmhattot=dnew((N+1)*3,(N+1)*3);
//cfft2plan(atmhat,-1);
//cfft2plan(atmhat, 1);
dset((dmat*)atm,1);
cembedd(atmhat, (dmat*)atm, 0);
cfft2(atmhat, -1);
cabs22d(&atmhattot, 1, atmhat, 1);
ccpd(&atmhat, atmhattot);
cfft2i(atmhat, 1);
cfftshift(atmhat);
dmat *denom=dnew((N+1)*3,(N+1)*3);
dmat *cov=dnew((N+1)*3,(N+1)*3);
creal2d(&denom, 0, atmhat, 1);
writebin(denom, "denom.bin");
dzero(atmhattot);
for(long i=0; i<nframe; i++){
info("%ld of %ld\n", i, nframe);
for(long j=0; j<nx*ny; j++){
atm->p[j]=randn(&rstat);
}
fractal_do((dmat*)atm, dx, r0,L0,ninit);
/*mapwrite(atm, "atm_%ld.bin", i); */
cembedd(atmhat, (dmat*)atm, 0);
cfft2(atmhat, -1);
cabs22d(&atmhattot, 1, atmhat, 1);
if(i==0 || (i+1)%10==0){
dscale(atmhattot, 1./(i+1));
ccpd(&atmhat, atmhattot);
writebin(atmhattot, "atm_psf_%ld.bin",i+1);
cfft2i(atmhat, 1);
cfftshift(atmhat);
creal2d(&cov, 0, atmhat, 1);
for(long k=0; k<cov->nx*cov->ny; k++){
cov->p[k]/=denom->p[k];
}
writebin(cov, "atm_cov_%ld.bin",i+1);
}
}
}
/**
Wrap of psd1d to put the frequency along the first column.
*/
dmat *psd1dt(const dmat *v, long nseg, double dt){
dmat *psd=psd1d(v, nseg);
dmat *psd2=dnew(psd->nx, psd->ny+1);
int N=(psd->nx-1)*2;
double df=1./(N*dt);
for(int i=0; i<psd->nx; i++){
psd2->p[i]=df*i;
}
dscale(psd, 1./df);//divide so the value is point, not integrated in a bin.
memcpy(psd2->p+psd2->nx, psd->p, psd->nx*psd->ny*sizeof(double));
dfree(psd);
return psd2;
}
/**
test type I/II filter with ideal measurement to make sure it is implemented correctly.
*/
dmat* servo_test(dmat *input, double dt, int dtrat, dmat *sigma2n, dmat *gain){
if(input->ny==1){/*single mode. each column is for a mode.*/
input->ny=input->nx;
input->nx=1;
}
int nmod=input->nx;
PDMAT(input,pinput);
dmat *merr=dnew(nmod,1);
dcell *mreal=cellnew(1,1);
dmat *mres=dnew(nmod,input->ny);
dmat *sigman=NULL;
if(dnorm(sigma2n)>0){
sigman=dchol(sigma2n);
}
dcell *meas=cellnew(1,1);
dmat *noise=dnew(nmod, 1);
SERVO_T *st2t=servo_new(NULL, NULL, 0, dt*dtrat, gain);
rand_t rstat;
seed_rand(&rstat, 1);
PDMAT(mres,pmres);
/*two step delay is ensured with the order of using, copy, acc*/
for(int istep=0; istep<input->ny; istep++){
memcpy(merr->p, pinput[istep], nmod*sizeof(double));
dadd(&merr, 1, mreal->p[0], -1);
memcpy(pmres[istep],merr->p,sizeof(double)*nmod);
if(istep % dtrat == 0){
dzero(meas->p[0]);
}
dadd(&meas->p[0], 1, merr, 1);/*average the error. */
dcellcp(&mreal, st2t->mint->p[0]);
if((istep+1) % dtrat == 0){
if(dtrat!=1) dscale(meas->p[0], 1./dtrat);
if(sigman){
drandn(noise, 1, &rstat);
if(sigman->nx>0){
dmm(&meas->p[0], 1, sigman, noise, "nn", 1);
}else{
dadd(&meas->p[0], 1, noise, sigman->p[0]);
}
}
servo_filter(st2t, meas);
}
}
dfree(sigman);
dfree(merr);
dcellfree(mreal);
dcellfree(meas);
servo_free(st2t);
return mres;
}
static void test_ints(){
rand_t init;
seed_rand(&init,1);
const int nwfs=6;
lrand(&init);/*atm */
rand_t wfs_rand[nwfs];
for(int iwfs=0; iwfs<nwfs; iwfs++){
seed_rand(wfs_rand+iwfs,lrand(&init));
}
dcell *mtche=dcellread("powfs0_mtche.bin");
int nsim=500;
int nsa=2582;
dmat *nea=dnew(nsim,nsa*2);
double(*pnea)[nsim]=(void*)nea->p;
double rne=3;
double bkgrnd=0;
double siglev=1000;
for(int iwfs=0; iwfs<nwfs; iwfs++){
for(int isim=0; isim<nsim; isim++){
dbg("iwfs %d isim=%d\n",iwfs,isim);
/*dcell *ints=dcellread("ints_%d_wfs%d.bin",isim,iwfs); */
dcell *ints=dcellread("ints_%d_wfs%d.bin",isim,iwfs);
/*dcell *i0=dcellread("powfs0_i0.bin"); */
dmat *im=NULL, *imy=NULL;
double gnf[2], gny[2];
for(int isa=0; isa<nsa; isa++){
dcp(&im,ints->p[isa]);
dscale(im,siglev);
gnf[0]=0; gnf[1]=0;
dmulvec(gnf, mtche->p[isa], im->p,1.);
gny[0]=0; gny[1]=0;
dcp(&imy, im);
addnoise(imy, &wfs_rand[iwfs], bkgrnd, bkgrnd, 0,0,rne);
dmulvec(gny, mtche->p[isa], imy->p,1.);
P(pnea,isim,isa)=gny[0]-gnf[0];
P(pnea,isim,isa+nsa)=gny[1]-gnf[1];
}
}
writebin(nea,"test_sanea_wfs%d.bin",iwfs);
}
}
dmat *psd1d(const dmat *v, /**<[in] The data sequence*/
long nseg /**<[in] Number of overlapping segments*/
){
long nx;
long ncol;
if(v->nx==1){
nx=v->ny;
ncol=1;
}else{
nx=v->nx;
ncol=v->ny;
}
if(nseg<=1) nseg=1;
const int lseg2=nx/(nseg+1);
const int lseg=lseg2*2;
dmat *psd=dnew(lseg2+1, ncol);
cmat *hat=cnew(lseg, 1);
//cfft2plan(hat, -1);
for(long icol=0; icol<ncol; icol++){
double *ppsd=psd->p+icol*(lseg2+1);
for(int iseg=0; iseg<nseg; iseg++){
double* p=v->p+icol*nx+iseg*lseg2;
for(int ix=0; ix<lseg; ix++){
hat->p[ix]=p[ix]*W_J(ix, lseg2);
}
cfft2(hat, -1);
ppsd[0]+=cabs2(hat->p[0]);
for(int ix=1; ix<lseg2; ix++){
ppsd[ix]+=cabs2(hat->p[ix])+cabs2(hat->p[lseg-ix]);
}
ppsd[lseg2]+=cabs2(hat->p[lseg2]);
}
}
double sumwt=0;
for(int ix=0; ix<lseg; ix++){
sumwt+=pow(W_J(ix, lseg2), 2);
}
sumwt*=lseg*nseg;
dscale(psd, 1./sumwt);
cfree(hat);
return psd;
}
static void test_corner(){/*Compute the covariance of 4 corner points*/
rand_t rstat;
int seed=4;
double r0=0.2;
double dx=32;
long N=1+1;
long nx=N;
long ny=N;
long nframe=1000000;
seed_rand(&rstat, seed);
map_t *atm=mapnew(nx, ny, dx, dx,NULL);
dmat *vec=dref_reshape((dmat*)atm, N*N, 1);
dmat *cov=NULL;
for(long i=0; i<nframe; i++){
info("%ld of %ld\n", i, nframe);
for(long j=0; j<nx*ny; j++){
atm->p[j]=randn(&rstat);
}
fractal_do((dmat*)atm, dx, r0,L0,ninit);
dmm(&cov, 1, vec, vec, "nt", 1);
}
dscale(cov, 1./nframe);
writebin(cov,"cov.bin");
}
/*
Compute cxx on atm to compare against L2, invpsd, fractal.
*/
static void test_cxx(){
rand_t rstat;
int seed=4;
double r0=0.2;
double dx=1./4;
long N=16;
long nx=N;
long ny=N;
long nframe=40960;
seed_rand(&rstat, seed);
{
dmat *cxx=dnew(N*N,N*N);
map_t *atm=mapnew(nx+1, ny+1, dx, dx,NULL);
for(long i=0; i<nframe; i++){
info("%ld of %ld\n", i, nframe);
for(long j=0; j<(nx+1)*(ny+1); j++){
atm->p[j]=randn(&rstat);
}
fractal_do((dmat*)atm, dx, r0, L0, ninit);
dmat *sec=dsub((dmat*)atm, 0, nx, 0, ny);
dmat *atmvec=dref_reshape(sec, nx*ny, 1);
dmm(&cxx,1, atmvec,atmvec,"nt",1);
dfree(atmvec);
dfree(sec);
}
dscale(cxx, 1./nframe);
writebin(cxx, "cxx_fractal");
dfree(cxx);
mapfree(atm);
}
{
dmat *cxx=dnew(N*N,N*N);
dmat *spect=turbpsd(nx, ny, dx, r0, 100, 0, 0.5);
spect->p[0]=spect->p[1];
cmat *atm=cnew(nx, ny);
//cfft2plan(atm, -1);
dmat *atmr=dnew(nx*ny,1);
dmat *atmi=dnew(nx*ny,1);
for(long ii=0; ii<nframe; ii+=2){
info("%ld of %ld\n", ii, nframe);
for(long i=0; i<atm->nx*atm->ny; i++){
atm->p[i]=COMPLEX(randn(&rstat), randn(&rstat))*spect->p[i];
}
cfft2(atm, -1);
for(long i=0; i<atm->nx*atm->ny; i++){
atmr->p[i]=creal(atm->p[i]);
atmi->p[i]=cimag(atm->p[i]);
}
dmm(&cxx,1, atmr,atmr,"nt",1);
dmm(&cxx,1, atmi,atmi,"nt",1);
}
dscale(cxx, 1./nframe);
writebin(cxx, "cxx_fft");
dfree(cxx);
dfree(atmr);
dfree(atmi);
cfree(atm);
}
loc_t *loc=mksqloc_auto(16,16,1./4,1./4);
locwrite(loc,"loc");
dmat *B=stfun_kolmogorov(loc, r0);
writebin(B, "B_theory");
}
static void test_psd(){
rand_t rstat;
int seed=4;
double r0=0.2;
double dx=1./64;
long N=1024;
long nx=N;
long ny=N;
long ratio=1;
long xskip=nx*(ratio-1)/2;
long yskip=ny*(ratio-1)/2;
long nframe=512;
seed_rand(&rstat, seed);
if(1){
map_t *atm=mapnew(nx+1, ny+1, dx,dx, NULL);
cmat *hat=cnew(nx*ratio, ny*ratio);
//cfft2plan(hat, -1);
dmat *hattot=dnew(nx*ratio, ny*ratio);
for(long i=0; i<nframe; i++){
info2("%ld of %ld\n", i, nframe);
for(long j=0; j<(nx+1)*(ny+1); j++){
atm->p[j]=randn(&rstat);
}
fractal_do((dmat*)atm, dx, r0,L0,ninit);
czero(hat);
for(long iy=0; iy<ny; iy++){
for(long ix=0; ix<nx; ix++){
IND(hat,ix+xskip,iy+yskip)=IND(atm,ix,iy);
}
}
cfftshift(hat);
cfft2i(hat, -1);
cabs22d(&hattot, 1, hat, 1);
}
dscale(hattot, 1./nframe);
dfftshift(hattot);
writebin(hattot, "PSD_fractal");
}
{
dmat *spect=turbpsd(nx, ny, dx, r0, 100, 0, 0.5);
writebin(spect, "spect");
cmat *hat=cnew(nx*ratio, ny*ratio);
//cfft2plan(hat, -1);
dmat *hattot=dnew(nx*ratio, ny*ratio);
cmat *atm=cnew(nx, ny);
//cfft2plan(atm, -1);
dmat *atmr=dnew(atm->nx, atm->ny);
dmat *atmi=dnew(atm->nx, atm->ny);
cmat* phat=hat;
dmat* patmr=atmr;
dmat* patmi=atmi;
for(long ii=0; ii<nframe; ii+=2){
info2("%ld of %ld\n", ii, nframe);
for(long i=0; i<atm->nx*atm->ny; i++){
atm->p[i]=COMPLEX(randn(&rstat), randn(&rstat))*spect->p[i];
}
cfft2(atm, -1);
for(long i=0; i<atm->nx*atm->ny; i++){
atmr->p[i]=creal(atm->p[i]);
atmi->p[i]=cimag(atm->p[i]);
}
czero(hat);
for(long iy=0; iy<ny; iy++){
for(long ix=0; ix<nx; ix++){
IND(phat,ix+xskip,iy+yskip)=IND(patmr,ix,iy);
}
}
cfftshift(hat);
cfft2i(hat, -1);
cabs22d(&hattot, 1, hat, 1);
czero(hat);
for(long iy=0; iy<ny; iy++){
for(long ix=0; ix<nx; ix++){
IND(phat,ix+xskip,iy+yskip)=IND(patmi,ix,iy);
}
}
cfftshift(hat);
cfft2i(hat, -1);
cabs22d(&hattot, 1, hat, 1);
}
dscale(hattot, 1./nframe);
dfftshift(hattot);
writebin(hattot, "PSD_fft");
}
}
void
commnds(void)
{
Blk *p, *q, **ptr, *s, *t;
long l;
Sym *sp;
int sk, sk1, sk2, c, sign, n, d;
while(1) {
Bflush(&bout);
if(((c = readc())>='0' && c <= '9') ||
(c>='A' && c <='F') || c == '.') {
unreadc(c);
p = readin();
pushp(p);
continue;
}
switch(c) {
case ' ':
case '\t':
case '\n':
case -1:
continue;
case 'Y':
sdump("stk",*stkptr);
Bprint(&bout, "all %ld rel %ld headmor %ld\n",all,rel,headmor);
Bprint(&bout, "nbytes %ld\n",nbytes);
Bprint(&bout, "longest %ld active %ld maxsize %ld\n", longest,
active, maxsize);
Bprint(&bout, "new all %d rel %d copy %d more %d lbytes %d\n",
lall, lrel, lcopy, lmore, lbytes);
lall = lrel = lcopy = lmore = lbytes = 0;
continue;
case '_':
p = readin();
savk = sunputc(p);
chsign(p);
sputc(p,savk);
pushp(p);
continue;
case '-':
subt();
continue;
case '+':
if(eqk() != 0)
continue;
binop('+');
continue;
case '*':
arg1 = pop();
EMPTY;
arg2 = pop();
EMPTYR(arg1);
sk1 = sunputc(arg1);
sk2 = sunputc(arg2);
savk = sk1+sk2;
binop('*');
p = pop();
if(savk>k && savk>sk1 && savk>sk2) {
sclobber(p);
sk = sk1;
if(sk<sk2)
sk = sk2;
if(sk<k)
sk = k;
p = removc(p,savk-sk);
savk = sk;
sputc(p,savk);
}
pushp(p);
continue;
case '/':
casediv:
if(dscale() != 0)
continue;
binop('/');
if(irem != 0)
release(irem);
release(rem);
continue;
case '%':
if(dscale() != 0)
continue;
binop('/');
p = pop();
release(p);
if(irem == 0) {
sputc(rem,skr+k);
pushp(rem);
continue;
}
p = add0(rem,skd-(skr+k));
q = add(p,irem);
release(p);
release(irem);
sputc(q,skd);
pushp(q);
continue;
case 'v':
p = pop();
EMPTY;
savk = sunputc(p);
if(length(p) == 0) {
sputc(p,savk);
pushp(p);
continue;
}
if(sbackc(p)<0) {
error("sqrt of neg number\n");
}
if(k<savk)
n = savk;
else {
n = k*2-savk;
savk = k;
}
arg1 = add0(p,n);
arg2 = dcsqrt(arg1);
sputc(arg2,savk);
pushp(arg2);
continue;
case '^':
neg = 0;
arg1 = pop();
EMPTY;
if(sunputc(arg1) != 0)
error("exp not an integer\n");
arg2 = pop();
EMPTYR(arg1);
if(sfbeg(arg1) == 0 && sbackc(arg1)<0) {
neg++;
chsign(arg1);
}
if(length(arg1)>=3) {
error("exp too big\n");
}
savk = sunputc(arg2);
p = dcexp(arg2,arg1);
release(arg2);
rewind(arg1);
c = sgetc(arg1);
if(c == -1)
c = 0;
else
if(sfeof(arg1) == 0)
c = sgetc(arg1)*100 + c;
d = c*savk;
release(arg1);
/* if(neg == 0) { removed to fix -exp bug*/
if(k>=savk)
n = k;
else
n = savk;
if(n<d) {
q = removc(p,d-n);
sputc(q,n);
pushp(q);
} else {
sputc(p,d);
pushp(p);
}
/* } else { this is disaster for exp <-127 */
/* sputc(p,d); */
/* pushp(p); */
/* } */
if(neg == 0)
continue;
p = pop();
q = salloc(2);
sputc(q,1);
sputc(q,0);
pushp(q);
pushp(p);
goto casediv;
case 'z':
p = salloc(2);
n = stkptr - stkbeg;
if(n >= 100) {
sputc(p,n/100);
n %= 100;
}
sputc(p,n);
sputc(p,0);
pushp(p);
continue;
case 'Z':
p = pop();
EMPTY;
n = (length(p)-1)<<1;
fsfile(p);
backc(p);
if(sfbeg(p) == 0) {
if((c = sbackc(p))<0) {
n -= 2;
if(sfbeg(p) == 1)
n++;
else {
if((c = sbackc(p)) == 0)
n++;
else
if(c > 90)
n--;
}
} else
if(c < 10)
n--;
}
release(p);
q = salloc(1);
if(n >= 100) {
sputc(q,n%100);
n /= 100;
}
sputc(q,n);
sputc(q,0);
pushp(q);
continue;
case 'i':
p = pop();
EMPTY;
p = scalint(p);
release(inbas);
inbas = p;
continue;
case 'I':
p = copy(inbas,length(inbas)+1);
sputc(p,0);
pushp(p);
continue;
case 'o':
p = pop();
EMPTY;
p = scalint(p);
sign = 0;
n = length(p);
q = copy(p,n);
fsfile(q);
l = c = sbackc(q);
if(n != 1) {
if(c<0) {
sign = 1;
chsign(q);
n = length(q);
fsfile(q);
l = c = sbackc(q);
}
if(n != 1) {
while(sfbeg(q) == 0)
l = l*100+sbackc(q);
}
}
logo = log2(l);
obase = l;
release(basptr);
if(sign == 1)
obase = -l;
basptr = p;
outdit = bigot;
if(n == 1 && sign == 0) {
if(c <= 16) {
outdit = hexot;
fw = 1;
fw1 = 0;
ll = 70;
release(q);
continue;
}
}
n = 0;
if(sign == 1)
n++;
p = salloc(1);
sputc(p,-1);
t = add(p,q);
n += length(t)*2;
fsfile(t);
if(sbackc(t)>9)
n++;
release(t);
release(q);
release(p);
fw = n;
fw1 = n-1;
ll = 70;
if(fw>=ll)
continue;
ll = (70/fw)*fw;
continue;
case 'O':
p = copy(basptr,length(basptr)+1);
sputc(p,0);
pushp(p);
continue;
case '[':
n = 0;
p = salloc(0);
for(;;) {
if((c = readc()) == ']') {
if(n == 0)
break;
n--;
}
sputc(p,c);
if(c == '[')
n++;
}
pushp(p);
continue;
case 'k':
p = pop();
EMPTY;
p = scalint(p);
if(length(p)>1) {
error("scale too big\n");
}
rewind(p);
k = 0;
if(!sfeof(p))
k = sgetc(p);
release(scalptr);
scalptr = p;
continue;
case 'K':
p = copy(scalptr,length(scalptr)+1);
sputc(p,0);
pushp(p);
continue;
case 'X':
p = pop();
EMPTY;
fsfile(p);
n = sbackc(p);
release(p);
p = salloc(2);
sputc(p,n);
sputc(p,0);
pushp(p);
continue;
case 'Q':
p = pop();
EMPTY;
if(length(p)>2) {
error("Q?\n");
}
rewind(p);
if((c = sgetc(p))<0) {
error("neg Q\n");
}
release(p);
while(c-- > 0) {
if(readptr == &readstk[0]) {
error("readstk?\n");
}
if(*readptr != 0)
release(*readptr);
readptr--;
}
continue;
case 'q':
if(readptr <= &readstk[1])
exits(0);
if(*readptr != 0)
release(*readptr);
readptr--;
if(*readptr != 0)
release(*readptr);
readptr--;
continue;
case 'f':
if(stkptr == &stack[0])
Bprint(&bout,"empty stack\n");
else {
for(ptr = stkptr; ptr > &stack[0];) {
dcprint(*ptr--);
}
}
continue;
case 'p':
if(stkptr == &stack[0])
Bprint(&bout,"empty stack\n");
else {
dcprint(*stkptr);
}
continue;
case 'P':
p = pop();
EMPTY;
sputc(p,0);
Bprint(&bout,"%s",p->beg);
release(p);
continue;
case 'd':
if(stkptr == &stack[0]) {
Bprint(&bout,"empty stack\n");
continue;
}
q = *stkptr;
n = length(q);
p = copy(*stkptr,n);
pushp(p);
continue;
case 'c':
while(stkerr == 0) {
p = pop();
if(stkerr == 0)
release(p);
}
continue;
case 'S':
if(stkptr == &stack[0]) {
error("save: args\n");
}
c = getstk() & 0377;
sptr = stable[c];
sp = stable[c] = sfree;
sfree = sfree->next;
if(sfree == 0)
goto sempty;
sp->next = sptr;
p = pop();
EMPTY;
if(c >= ARRAYST) {
q = copy(p,length(p)+PTRSZ);
for(n = 0;n < PTRSZ;n++) {
sputc(q,0);
}
release(p);
p = q;
}
sp->val = p;
continue;
sempty:
error("symbol table overflow\n");
case 's':
if(stkptr == &stack[0]) {
error("save:args\n");
}
c = getstk() & 0377;
sptr = stable[c];
if(sptr != 0) {
p = sptr->val;
if(c >= ARRAYST) {
rewind(p);
while(sfeof(p) == 0)
release(dcgetwd(p));
}
release(p);
} else {
sptr = stable[c] = sfree;
sfree = sfree->next;
if(sfree == 0)
goto sempty;
sptr->next = 0;
}
p = pop();
sptr->val = p;
continue;
case 'l':
load();
continue;
case 'L':
c = getstk() & 0377;
sptr = stable[c];
if(sptr == 0) {
error("L?\n");
}
stable[c] = sptr->next;
sptr->next = sfree;
sfree = sptr;
p = sptr->val;
if(c >= ARRAYST) {
rewind(p);
while(sfeof(p) == 0) {
q = dcgetwd(p);
if(q != 0)
release(q);
}
}
pushp(p);
continue;
case ':':
p = pop();
EMPTY;
q = scalint(p);
fsfile(q);
c = 0;
if((sfbeg(q) == 0) && ((c = sbackc(q))<0)) {
error("neg index\n");
}
if(length(q)>2) {
error("index too big\n");
}
if(sfbeg(q) == 0)
c = c*100+sbackc(q);
if(c >= MAXIND) {
error("index too big\n");
}
release(q);
n = getstk() & 0377;
sptr = stable[n];
if(sptr == 0) {
sptr = stable[n] = sfree;
sfree = sfree->next;
if(sfree == 0)
goto sempty;
sptr->next = 0;
p = salloc((c+PTRSZ)*PTRSZ);
zero(p);
} else {
p = sptr->val;
if(length(p)-PTRSZ < c*PTRSZ) {
q = copy(p,(c+PTRSZ)*PTRSZ);
release(p);
p = q;
}
}
seekc(p,c*PTRSZ);
q = lookwd(p);
if(q!=0)
release(q);
s = pop();
EMPTY;
salterwd(p, s);
sptr->val = p;
continue;
case ';':
p = pop();
EMPTY;
q = scalint(p);
fsfile(q);
c = 0;
if((sfbeg(q) == 0) && ((c = sbackc(q))<0)) {
error("neg index\n");
}
if(length(q)>2) {
error("index too big\n");
}
if(sfbeg(q) == 0)
c = c*100+sbackc(q);
if(c >= MAXIND) {
error("index too big\n");
}
release(q);
n = getstk() & 0377;
sptr = stable[n];
if(sptr != 0){
p = sptr->val;
if(length(p)-PTRSZ >= c*PTRSZ) {
seekc(p,c*PTRSZ);
s = dcgetwd(p);
if(s != 0) {
q = copy(s,length(s));
pushp(q);
continue;
}
}
}
q = salloc(1); /*so uninitialized array elt prints as 0*/
sputc(q, 0);
pushp(q);
continue;
case 'x':
execute:
p = pop();
EMPTY;
if((readptr != &readstk[0]) && (*readptr != 0)) {
if((*readptr)->rd == (*readptr)->wt)
release(*readptr);
else {
if(readptr++ == &readstk[RDSKSZ]) {
error("nesting depth\n");
}
}
} else
readptr++;
*readptr = p;
if(p != 0)
rewind(p);
else {
if((c = readc()) != '\n')
unreadc(c);
}
continue;
case '?':
if(++readptr == &readstk[RDSKSZ]) {
error("nesting depth\n");
}
*readptr = 0;
fsave = curfile;
curfile = &bin;
while((c = readc()) == '!')
command();
p = salloc(0);
sputc(p,c);
while((c = readc()) != '\n') {
sputc(p,c);
if(c == '\\')
sputc(p,readc());
}
curfile = fsave;
*readptr = p;
continue;
case '!':
if(command() == 1)
goto execute;
continue;
case '<':
case '>':
case '=':
if(cond(c) == 1)
goto execute;
continue;
default:
Bprint(&bout,"%o is unimplemented\n",c);
}
}
}
void
dcprint(Blk *hptr)
{
Blk *p, *q, *dec;
int dig, dout, ct, sc;
rewind(hptr);
while(sfeof(hptr) == 0) {
if(sgetc(hptr)>99) {
rewind(hptr);
while(sfeof(hptr) == 0) {
Bprint(&bout,"%c",sgetc(hptr));
}
Bprint(&bout,"\n");
return;
}
}
fsfile(hptr);
sc = sbackc(hptr);
if(sfbeg(hptr) != 0) {
Bprint(&bout,"0\n");
return;
}
count = ll;
p = copy(hptr,length(hptr));
sclobber(p);
fsfile(p);
if(sbackc(p)<0) {
chsign(p);
OUTC('-');
}
if((obase == 0) || (obase == -1)) {
oneot(p,sc,'d');
return;
}
if(obase == 1) {
oneot(p,sc,'1');
return;
}
if(obase == 10) {
tenot(p,sc);
return;
}
/* sleazy hack to scale top of stack - divide by 1 */
pushp(p);
sputc(p, sc);
p=salloc(0);
create(p);
sputc(p, 1);
sputc(p, 0);
pushp(p);
if(dscale() != 0)
return;
p = div(arg1, arg2);
release(arg1);
release(arg2);
sc = savk;
create(strptr);
dig = logten*sc;
dout = ((dig/10) + dig) / logo;
dec = getdec(p,sc);
p = removc(p,sc);
while(length(p) != 0) {
q = div(p,basptr);
release(p);
p = q;
(*outdit)(rem,0);
}
release(p);
fsfile(strptr);
while(sfbeg(strptr) == 0)
OUTC(sbackc(strptr));
if(sc == 0) {
release(dec);
Bprint(&bout,"\n");
return;
}
create(strptr);
OUTC('.');
ct=0;
do {
q = mult(basptr,dec);
release(dec);
dec = getdec(q,sc);
p = removc(q,sc);
(*outdit)(p,1);
} while(++ct < dout);
release(dec);
rewind(strptr);
while(sfeof(strptr) == 0)
OUTC(sgetc(strptr));
Bprint(&bout,"\n");
}
/**
Time domain physical simulation.
noisy:
- 0: no noise at all;
- 1: poisson and read out noise.
- 2: only poisson noise.
*/
dmat *skysim_sim(dmat **mresout, const dmat *mideal, const dmat *mideal_oa, double ngsol,
ASTER_S *aster, const POWFS_S *powfs,
const PARMS_S *parms, int idtratc, int noisy, int phystart){
int dtratc=0;
if(!parms->skyc.multirate){
dtratc=parms->skyc.dtrats->p[idtratc];
}
int hasphy;
if(phystart>-1 && phystart<aster->nstep){
hasphy=1;
}else{
hasphy=0;
}
const int nmod=mideal->nx;
dmat *res=dnew(6,1);/*Results. 1-2: NGS and TT modes.,
3-4:On axis NGS and TT modes,
4-6: On axis NGS and TT wihtout considering un-orthogonality.*/
dmat *mreal=NULL;/*modal correction at this step. */
dmat *merr=dnew(nmod,1);/*modal error */
dcell *merrm=dcellnew(1,1);dcell *pmerrm=NULL;
const int nstep=aster->nstep?aster->nstep:parms->maos.nstep;
dmat *mres=dnew(nmod,nstep);
dmat* rnefs=parms->skyc.rnefs;
dcell *zgradc=dcellnew3(aster->nwfs, 1, aster->ngs, 0);
dcell *gradout=dcellnew3(aster->nwfs, 1, aster->ngs, 0);
dmat *gradsave=0;
if(parms->skyc.dbg){
gradsave=dnew(aster->tsa*2,nstep);
}
SERVO_T *st2t=0;
kalman_t *kalman=0;
dcell *mpsol=0;
dmat *pgm=0;
dmat *dtrats=0;
int multirate=parms->skyc.multirate;
if(multirate){
kalman=aster->kalman[0];
dtrats=aster->dtrats;
}else{
if(parms->skyc.servo>0){
const double dtngs=parms->maos.dt*dtratc;
st2t=servo_new(merrm, NULL, 0, dtngs, aster->gain->p[idtratc]);
pgm=aster->pgm->p[idtratc];
}else{
kalman=aster->kalman[idtratc];
}
}
if(kalman){
kalman_init(kalman);
mpsol=dcellnew(aster->nwfs, 1); //for psol grad.
}
const long nwvl=parms->maos.nwvl;
dcell **psf=0, **mtche=0, **ints=0;
ccell *wvf=0,*wvfc=0, *otf=0;
if(hasphy){
psf=mycalloc(aster->nwfs,dcell*);
wvf=ccellnew(aster->nwfs,1);
wvfc=ccellnew(aster->nwfs,1);
mtche=mycalloc(aster->nwfs,dcell*);
ints=mycalloc(aster->nwfs,dcell*);
otf=ccellnew(aster->nwfs,1);
for(long iwfs=0; iwfs<aster->nwfs; iwfs++){
const int ipowfs=aster->wfs[iwfs].ipowfs;
const long ncomp=parms->maos.ncomp[ipowfs];
const long nsa=parms->maos.nsa[ipowfs];
wvf->p[iwfs]=cnew(ncomp,ncomp);
wvfc->p[iwfs]=NULL;
psf[iwfs]=dcellnew(nsa,nwvl);
//cfft2plan(wvf->p[iwfs], -1);
if(parms->skyc.multirate){
mtche[iwfs]=aster->wfs[iwfs].pistat->mtche[(int)aster->idtrats->p[iwfs]];
}else{
mtche[iwfs]=aster->wfs[iwfs].pistat->mtche[idtratc];
}
otf->p[iwfs]=cnew(ncomp,ncomp);
//cfft2plan(otf->p[iwfs],-1);
//cfft2plan(otf->p[iwfs],1);
ints[iwfs]=dcellnew(nsa,1);
int pixpsa=parms->skyc.pixpsa[ipowfs];
for(long isa=0; isa<nsa; isa++){
ints[iwfs]->p[isa]=dnew(pixpsa,pixpsa);
}
}
}
for(int irep=0; irep<parms->skyc.navg; irep++){
if(kalman){
kalman_init(kalman);
}else{
servo_reset(st2t);
}
dcellzero(zgradc);
dcellzero(gradout);
if(ints){
for(int iwfs=0; iwfs<aster->nwfs; iwfs++){
dcellzero(ints[iwfs]);
}
}
for(int istep=0; istep<nstep; istep++){
memcpy(merr->p, PCOL(mideal,istep), nmod*sizeof(double));
dadd(&merr, 1, mreal, -1);/*form NGS mode error; */
memcpy(PCOL(mres,istep),merr->p,sizeof(double)*nmod);
if(mpsol){//collect averaged modes for PSOL.
for(long iwfs=0; iwfs<aster->nwfs; iwfs++){
dadd(&mpsol->p[iwfs], 1, mreal, 1);
}
}
pmerrm=0;
if(istep>=parms->skyc.evlstart){/*performance evaluation*/
double res_ngs=dwdot(merr->p,parms->maos.mcc,merr->p);
if(res_ngs>ngsol*100){
dfree(res); res=NULL;
break;
}
{
res->p[0]+=res_ngs;
res->p[1]+=dwdot2(merr->p,parms->maos.mcc_tt,merr->p);
double dot_oa=dwdot(merr->p, parms->maos.mcc_oa, merr->p);
double dot_res_ideal=dwdot(merr->p, parms->maos.mcc_oa, PCOL(mideal,istep));
double dot_res_oa=0;
for(int imod=0; imod<nmod; imod++){
dot_res_oa+=merr->p[imod]*IND(mideal_oa,imod,istep);
}
res->p[2]+=dot_oa-2*dot_res_ideal+2*dot_res_oa;
res->p[4]+=dot_oa;
}
{
double dot_oa_tt=dwdot2(merr->p, parms->maos.mcc_oa_tt, merr->p);
/*Notice that mcc_oa_tt2 is 2x5 marix. */
double dot_res_ideal_tt=dwdot(merr->p, parms->maos.mcc_oa_tt2, PCOL(mideal,istep));
double dot_res_oa_tt=0;
for(int imod=0; imod<2; imod++){
dot_res_oa_tt+=merr->p[imod]*IND(mideal_oa,imod,istep);
}
res->p[3]+=dot_oa_tt-2*dot_res_ideal_tt+2*dot_res_oa_tt;
res->p[5]+=dot_oa_tt;
}
}//if evl
if(istep<phystart || phystart<0){
/*Ztilt, noise free simulation for acquisition. */
dmm(&zgradc->m, 1, aster->gm, merr, "nn", 1);/*grad due to residual NGS mode. */
for(int iwfs=0; iwfs<aster->nwfs; iwfs++){
const int ipowfs=aster->wfs[iwfs].ipowfs;
const long ng=parms->maos.nsa[ipowfs]*2;
for(long ig=0; ig<ng; ig++){
zgradc->p[iwfs]->p[ig]+=aster->wfs[iwfs].ztiltout->p[istep*ng+ig];
}
}
for(int iwfs=0; iwfs<aster->nwfs; iwfs++){
int dtrati=(multirate?(int)dtrats->p[iwfs]:dtratc);
if((istep+1) % dtrati==0){
dadd(&gradout->p[iwfs], 0, zgradc->p[iwfs], 1./dtrati);
dzero(zgradc->p[iwfs]);
if(noisy){
int idtrati=(multirate?(int)aster->idtrats->p[iwfs]:idtratc);
dmat *nea=aster->wfs[iwfs].pistat->sanea->p[idtrati];
for(int i=0; i<nea->nx; i++){
gradout->p[iwfs]->p[i]+=nea->p[i]*randn(&aster->rand);
}
}
pmerrm=merrm;//record output.
}
}
}else{
/*Accumulate PSF intensities*/
for(long iwfs=0; iwfs<aster->nwfs; iwfs++){
const double thetax=aster->wfs[iwfs].thetax;
const double thetay=aster->wfs[iwfs].thetay;
const int ipowfs=aster->wfs[iwfs].ipowfs;
const long nsa=parms->maos.nsa[ipowfs];
ccell* wvfout=aster->wfs[iwfs].wvfout[istep];
for(long iwvl=0; iwvl<nwvl; iwvl++){
double wvl=parms->maos.wvl[iwvl];
for(long isa=0; isa<nsa; isa++){
ccp(&wvfc->p[iwfs], IND(wvfout,isa,iwvl));
/*Apply NGS mode error to PSF. */
ngsmod2wvf(wvfc->p[iwfs], wvl, merr, powfs+ipowfs, isa,
thetax, thetay, parms);
cembedc(wvf->p[iwfs],wvfc->p[iwfs],0,C_FULL);
cfft2(wvf->p[iwfs],-1);
/*peak in corner. */
cabs22d(&psf[iwfs]->p[isa+nsa*iwvl], 1., wvf->p[iwfs], 1.);
}/*isa */
}/*iwvl */
}/*iwfs */
/*Form detector image from accumulated PSFs*/
double igrad[2];
for(long iwfs=0; iwfs<aster->nwfs; iwfs++){
int dtrati=dtratc, idtrat=idtratc;
if(multirate){//multirate
idtrat=aster->idtrats->p[iwfs];
dtrati=dtrats->p[iwfs];
}
if((istep+1) % dtrati == 0){/*has output */
dcellzero(ints[iwfs]);
const int ipowfs=aster->wfs[iwfs].ipowfs;
const long nsa=parms->maos.nsa[ipowfs];
for(long isa=0; isa<nsa; isa++){
for(long iwvl=0; iwvl<nwvl; iwvl++){
double siglev=aster->wfs[iwfs].siglev->p[iwvl];
ccpd(&otf->p[iwfs],psf[iwfs]->p[isa+nsa*iwvl]);
cfft2i(otf->p[iwfs], 1); /*turn to OTF, peak in corner */
ccwm(otf->p[iwfs], powfs[ipowfs].dtf[iwvl].nominal);
cfft2(otf->p[iwfs], -1);
dspmulcreal(ints[iwfs]->p[isa]->p, powfs[ipowfs].dtf[iwvl].si,
otf->p[iwfs]->p, siglev);
}
/*Add noise and apply matched filter. */
#if _OPENMP >= 200805
#pragma omp critical
#endif
switch(noisy){
case 0:/*no noise at all. */
break;
case 1:/*both poisson and read out noise. */
{
double bkgrnd=aster->wfs[iwfs].bkgrnd*dtrati;
addnoise(ints[iwfs]->p[isa], &aster->rand, bkgrnd, bkgrnd, 0,0,IND(rnefs,idtrat,ipowfs));
}
break;
case 2:/*there is still poisson noise. */
addnoise(ints[iwfs]->p[isa], &aster->rand, 0, 0, 0,0,0);
break;
default:
error("Invalid noisy\n");
}
igrad[0]=0;
igrad[1]=0;
double pixtheta=parms->skyc.pixtheta[ipowfs];
if(parms->skyc.mtch){
dmulvec(igrad, mtche[iwfs]->p[isa], ints[iwfs]->p[isa]->p, 1);
}
if(!parms->skyc.mtch || fabs(igrad[0])>pixtheta || fabs(igrad[1])>pixtheta){
if(!parms->skyc.mtch){
warning2("fall back to cog\n");
}else{
warning_once("mtch is out of range\n");
}
dcog(igrad, ints[iwfs]->p[isa], 0, 0, 0, 3*IND(rnefs,idtrat,ipowfs), 0);
igrad[0]*=pixtheta;
igrad[1]*=pixtheta;
}
gradout->p[iwfs]->p[isa]=igrad[0];
gradout->p[iwfs]->p[isa+nsa]=igrad[1];
}/*isa */
pmerrm=merrm;
dcellzero(psf[iwfs]);/*reset accumulation.*/
}/*if iwfs has output*/
}/*for wfs*/
}/*if phystart */
//output to mreal after using it to ensure two cycle delay.
if(st2t){//Type I or II control.
if(st2t->mint->p[0]){//has output.
dcp(&mreal, st2t->mint->p[0]->p[0]);
}
}else{//LQG control
kalman_output(kalman, &mreal, 0, 1);
}
if(kalman){//LQG control
int indk=0;
//Form PSOL grads and obtain index to LQG M
for(int iwfs=0; iwfs<aster->nwfs; iwfs++){
int dtrati=(multirate?(int)dtrats->p[iwfs]:dtratc);
if((istep+1) % dtrati==0){
indk|=1<<iwfs;
dmm(&gradout->p[iwfs], 1, aster->g->p[iwfs], mpsol->p[iwfs], "nn", 1./dtrati);
dzero(mpsol->p[iwfs]);
}
}
if(indk){
kalman_update(kalman, gradout->m, indk-1);
}
}else if(st2t){
if(pmerrm){
dmm(&merrm->p[0], 0, pgm, gradout->m, "nn", 1);
}
servo_filter(st2t, pmerrm);//do even if merrm is zero. to simulate additional latency
}
if(parms->skyc.dbg){
memcpy(PCOL(gradsave, istep), gradout->m->p, sizeof(double)*gradsave->nx);
}
}/*istep; */
}
if(parms->skyc.dbg){
int dtrati=(multirate?(int)dtrats->p[0]:dtratc);
writebin(gradsave,"%s/skysim_grads_aster%d_dtrat%d",dirsetup, aster->iaster,dtrati);
writebin(mres,"%s/skysim_sim_mres_aster%d_dtrat%d",dirsetup,aster->iaster,dtrati);
}
dfree(mreal);
dcellfree(mpsol);
dfree(merr);
dcellfree(merrm);
dcellfree(zgradc);
dcellfree(gradout);
dfree(gradsave);
if(hasphy){
dcellfreearr(psf, aster->nwfs);
dcellfreearr(ints, aster->nwfs);
ccellfree(wvf);
ccellfree(wvfc);
ccellfree(otf);
free(mtche);
}
servo_free(st2t);
/*dfree(mres); */
if(mresout) {
*mresout=mres;
}else{
dfree(mres);
}
dscale(res, 1./((nstep-parms->skyc.evlstart)*parms->skyc.navg));
return res;
}
void
commnds(void){
register int c;
register struct blk *p,*q;
long l;
int sign;
struct blk **ptr,*s,*t;
struct sym *sp;
int sk,sk1,sk2;
int n,d;
while(1){
if(((c = readc())>='0' && c <= '9')|| (c>='A' && c <='F') || c == '.'){
unreadc(c);
p = readin();
pushp(p);
continue;
}
switch(c){
case ' ':
case '\n':
case 0377:
case EOF:
continue;
case 'Y':
sdump("stk",*stkptr);
printf("all %ld rel %ld headmor %ld\n",all,rel,headmor);
printf("nbytes %ld\n",nbytes);
continue;
case '_':
p = readin();
savk = sunputc(p);
chsign(p);
sputc(p,savk);
pushp(p);
continue;
case '-':
subt();
continue;
case '+':
if(eqk() != 0)continue;
binop('+');
continue;
case '*':
arg1 = pop();
EMPTY;
arg2 = pop();
EMPTYR(arg1);
sk1 = sunputc(arg1);
sk2 = sunputc(arg2);
binop('*');
p = pop();
sunputc(p);
savk = n = sk1+sk2;
if(n>k && n>sk1 && n>sk2){
sk = sk1;
if(sk<sk2)sk = sk2;
if(sk<k)sk = k;
p = removc(p,n-sk);
savk = sk;
}
sputc(p,savk);
pushp(p);
continue;
case '/':
casediv:
if(dscale() != 0)continue;
binop('/');
if(irem != 0)release(irem);
release(rem);
continue;
case '%':
if(dscale() != 0)continue;
binop('/');
p = pop();
release(p);
if(irem == 0){
sputc(rem,skr+k);
pushp(rem);
continue;
}
p = add0(rem,skd-(skr+k));
q = add(p,irem);
release(p);
release(irem);
sputc(q,skd);
pushp(q);
continue;
case 'v':
p = pop();
EMPTY;
savk = sunputc(p);
if(length(p) == 0){
sputc(p,savk);
pushp(p);
continue;
}
if((c = sbackc(p))<0){
error("sqrt of neg number\n");
}
if(k<savk)n = savk;
else{
n = k*2-savk;
savk = k;
}
arg1 = add0(p,n);
arg2 = dcsqrt(arg1);
sputc(arg2,savk);
pushp(arg2);
continue;
case '^':
neg = 0;
arg1 = pop();
EMPTY;
if(sunputc(arg1) != 0)error("exp not an integer\n");
arg2 = pop();
EMPTYR(arg1);
if(sfbeg(arg1) == 0 && sbackc(arg1)<0){
neg++;
chsign(arg1);
}
if(length(arg1)>=3){
error("exp too big\n");
}
savk = sunputc(arg2);
p = dcexp(arg2,arg1);
release(arg2);
rewind(arg1);
c = sgetc(arg1);
if(sfeof(arg1) == 0)
c = sgetc(arg1)*100 + c;
d = c*savk;
release(arg1);
if(neg == 0){
if(k>=savk)n = k;
else n = savk;
if(n<d){
q = removc(p,d-n);
sputc(q,n);
pushp(q);
}
else {
sputc(p,d);
pushp(p);
}
}
else {
sputc(p,d);
pushp(p);
}
if(neg == 0)continue;
p = pop();
q = salloc(2);
sputc(q,1);
sputc(q,0);
pushp(q);
pushp(p);
goto casediv;
case 'z':
p = salloc(2);
n = stkptr - stkbeg;
if(n >= 100){
sputc(p,n/100);
n %= 100;
}
sputc(p,n);
sputc(p,0);
pushp(p);
continue;
case 'Z':
p = pop();
EMPTY;
n = (length(p)-1)<<1;
fsfile(p);
sbackc(p);
if(sfbeg(p) == 0){
if((c = sbackc(p))<0){
n -= 2;
if(sfbeg(p) == 1)n += 1;
else {
if((c = sbackc(p)) == 0)n += 1;
else if(c > 90)n -= 1;
}
}
else if(c < 10) n -= 1;
}
release(p);
q = salloc(1);
if(n >= 100){
sputc(q,n%100);
n /= 100;
}
sputc(q,n);
sputc(q,0);
pushp(q);
continue;
case 'i':
p = pop();
EMPTY;
p = scalint(p);
release(inbas);
inbas = p;
continue;
case 'I':
p = copy(inbas,length(inbas)+1);
sputc(p,0);
pushp(p);
continue;
case 'o':
p = pop();
EMPTY;
p = scalint(p);
sign = 0;
n = length(p);
q = copy(p,n);
fsfile(q);
l = c = sbackc(q);
if(n != 1){
if(c<0){
sign = 1;
chsign(q);
n = length(q);
fsfile(q);
l = c = sbackc(q);
}
if(n != 1){
while(sfbeg(q) == 0)l = l*100+sbackc(q);
}
}
if (l > BC_BASE_MAX)
error("output base is too large\n");
logo = log_2(l);
obase = l;
release(basptr);
if(sign == 1)obase = (long)-l;
basptr = p;
outdit = (int (*)(struct blk *, int, int))bigot;
if(n == 1 && sign == 0){
if(c <= 16){
outdit = (int (*)(struct blk *, int, int))hexot;
fw = 1;
fw1 = 0;
ll = 68;
release(q);
continue;
}
}
n = 0;
if(sign == 1)n++;
p = salloc(1);
sputc(p,-1);
t = add(p,q);
n += length(t)*2;
fsfile(t);
if((c = sbackc(t))>9)n++;
release(t);
release(q);
release(p);
fw = n;
fw1 = n-1;
ll = 68;
if(fw>=ll)continue;
ll = (68/fw)*fw;
continue;
case 'O':
p = copy(basptr,length(basptr)+1);
sputc(p,0);
pushp(p);
continue;
case '[':
n = 0;
p = salloc(0);
while(1){
if((c = readc()) == ']'){
if(n == 0)break;
n--;
}
sputc(p,c);
if(c == '[')n++;
}
pushp(p);
continue;
case 'k':
p = pop();
EMPTY;
p = scalint(p);
if(length(p)>1){
error("scale too big\n");
}
rewind(p);
k = sfeof(p)?0:sgetc(p);
release(scalptr);
scalptr = p;
continue;
case 'K':
p = copy(scalptr,length(scalptr)+1);
sputc(p,0);
pushp(p);
continue;
case 'X':
p = pop();
EMPTY;
fsfile(p);
n = sbackc(p);
release(p);
p = salloc(2);
sputc(p,n);
sputc(p,0);
pushp(p);
continue;
case 'Q':
p = pop();
EMPTY;
if(length(p)>2){
error("Q?\n");
}
rewind(p);
if((c = sgetc(p))<0){
error("neg Q\n");
}
release(p);
while(c-- > 0){
if(readptr == &readstk[0]){
error("readstk?\n");
}
if(*readptr != 0)release(*readptr);
readptr--;
}
continue;
case 'q':
if(readptr <= &readstk[1])exit(0);
if(*readptr != 0)release(*readptr);
readptr--;
if(*readptr != 0)release(*readptr);
readptr--;
continue;
case 'f':
if(stkptr == &stack[0])printf("empty stack\n");
else {
for(ptr = stkptr; ptr > &stack[0];){
print(*ptr--);
}
}
continue;
case 'p':
if(stkptr == &stack[0])printf("empty stack\n");
else{
print(*stkptr);
}
continue;
case 'P':
p = pop();
EMPTY;
sputc(p,0);
printf("%s",p->beg);
release(p);
continue;
case 'd':
if(stkptr == &stack[0]){
printf("empty stack\n");
continue;
}
q = *stkptr;
n = length(q);
p = copy(*stkptr,n);
pushp(p);
continue;
case 'c':
while(stkerr == 0){
p = pop();
if(stkerr == 0)release(p);
}
continue;
case 'S':
if(stkptr == &stack[0]){
error("save: args\n");
}
c = readc() & 0377;
sptr = stable[c];
sp = stable[c] = sfree;
sfree = sfree->next;
if(sfree == 0)goto sempty;
sp->next = sptr;
p = pop();
EMPTY;
if(c >= ARRAYST){
q = copy(p,length(p));
for(n = 0;n < PTRSZ;n++)sputc(q,0);
release(p);
p = q;
}
sp->val = p;
continue;
sempty:
error("symbol table overflow\n");
case 's':
if(stkptr == &stack[0]){
error("save:args\n");
}
c = readc() & 0377;
sptr = stable[c];
if(sptr != 0){
p = sptr->val;
if(c >= ARRAYST){
rewind(p);
while(sfeof(p) == 0)release(dcgetwd(p));
}
release(p);
}
else{
sptr = stable[c] = sfree;
sfree = sfree->next;
if(sfree == 0)goto sempty;
sptr->next = 0;
}
p = pop();
sptr->val = p;
continue;
case 'l':
load();
continue;
case 'L':
c = readc() & 0377;
sptr = stable[c];
if(sptr == 0){
error("L?\n");
}
stable[c] = sptr->next;
sptr->next = sfree;
sfree = sptr;
p = sptr->val;
if(c >= ARRAYST){
rewind(p);
while(sfeof(p) == 0){
q = dcgetwd(p);
if(q != 0)release(q);
}
}
pushp(p);
continue;
case ':':
p = pop();
EMPTY;
q = scalint(p);
fsfile(q);
c = 0;
if((sfbeg(q) == 0) && ((c = sbackc(q))<0)){
error("neg index\n");
}
if(length(q)>2){
error("index too big\n");
}
if(sfbeg(q) == 0)c = c*100+sbackc(q);
if(c >= BC_DIM_MAX){
error("index too big\n");
}
release(q);
n = readc() & 0377;
sptr = stable[n];
if(sptr == 0){
sptr = stable[n] = sfree;
sfree = sfree->next;
if(sfree == 0)goto sempty;
sptr->next = 0;
p = salloc((c+PTRSZ)*PTRSZ);
zero(p);
}
else{
p = sptr->val;
if(length(p)-PTRSZ < c*PTRSZ){
q = copy(p,(c+PTRSZ)*PTRSZ);
release(p);
p = q;
}
}
seekc(p,c*PTRSZ);
q = lookwd(p);
if (q!=NULL) release(q);
s = pop();
EMPTY;
salterwd((struct wblk *)p,s);
sptr->val = p;
continue;
case ';':
p = pop();
EMPTY;
q = scalint(p);
fsfile(q);
c = 0;
if((sfbeg(q) == 0) && ((c = sbackc(q))<0)){
error("neg index\n");
}
if(length(q)>2){
error("index too big\n");
}
if(sfbeg(q) == 0)c = c*100+sbackc(q);
if(c >= BC_DIM_MAX){
error("index too big\n");
}
release(q);
n = readc() & 0377;
sptr = stable[n];
if(sptr != 0){
p = sptr->val;
if(length(p)-PTRSZ >= c*PTRSZ){
seekc(p,c*PTRSZ);
s = dcgetwd(p);
if(s != 0){
q = copy(s,length(s));
pushp(q);
continue;
}
}
}
q = salloc(1);
sputc(q, 0);
pushp(q);
continue;
case 'x':
execute:
p = pop();
EMPTY;
if((readptr != &readstk[0]) && (*readptr != 0)){
if((*readptr)->rd == (*readptr)->wt)
release(*readptr);
else{
if(readptr++ == &readstk[RDSKSZ]){
error("nesting depth\n");
}
}
}
else readptr++;
*readptr = p;
if(p != 0)rewind(p);
else{
if((c = readc()) != '\n')unreadc(c);
}
continue;
case '?':
if(++readptr == &readstk[RDSKSZ]){
error("nesting depth\n");
}
*readptr = 0;
fsave = curfile;
curfile = stdin;
while((c = readc()) == '!')command();
p = salloc(0);
sputc(p,c);
while((c = readc()) != '\n'){
sputc(p,c);
if(c == '\\')sputc(p,readc());
}
curfile = fsave;
*readptr = p;
continue;
case '!':
if(command() == 1)goto execute;
continue;
case '<':
case '>':
case '=':
if(cond(c) == 1)goto execute;
continue;
default:
printf("%o is unimplemented\n",c);
}
}
}
/**
Read in pistat information, used to compute matched filter, and SANEA.
*/
static void setup_star_read_pistat(SIM_S *simu, STAR_S *star, int nstar, int seed){
const PARMS_S *parms=simu->parms;
const int npowfs=parms->maos.npowfs;
const int nwvl=parms->maos.nwvl;
const double ngsgrid=parms->maos.ngsgrid;
for(int istar=0; istar<nstar; istar++){
STAR_S *stari=&star[istar];
stari->pistat=mycalloc(npowfs,PISTAT_S);
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);
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];
dcell *avgpsf=NULL;
dcell *neaspec=NULL;
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;
}
char fn[PATH_MAX];
snprintf(fn,PATH_MAX,"%s/pistat/pistat_seed%d_sa%d_x%g_y%g",
dirstart, seed,msa,thx,thy);
if(!zfexist(fn)){
/*warning("%s doesn't exist\n",fn); */
}else{
dcell *avgpsfi=dcellread("%s",fn);
dcelladd(&avgpsf, 1, avgpsfi, wtxi);
dcellfree(avgpsfi);
wtsum+=wtxi;
snprintf(fn,PATH_MAX,"%s/neaspec/neaspec_seed%d_sa%d_x%g_y%g",
dirstart, seed, msa, thx, thy);
dcell *neaspeci=dcellread("%s",fn);
dcelladd(&neaspec, 1, neaspeci, wtxi);
dcellfree(neaspeci);
}
}
}
if(wtsum<0.01){
warning("PISTAT is not available for (%g,%g) msa=%d\n",thetax,thetay,msa);
}
dcellscale(neaspec, 1./wtsum);
dcellscale(avgpsf, 1./wtsum);
dmat *scale=NULL;
if(parms->skyc.bspstrehl){
scale=dnew(nsa,nwvl);
dmat *gx=dnew(1,1); gx->p[0]=thxnorm;
dmat *gy=dnew(1,1); gy->p[0]=thynorm;
if(nsa!=avgpsf->nx || nwvl!=avgpsf->ny){
error("Mismatch: nsa=%d, nwvl=%d, avgpsf->nx=%ld, avgpsf->ny=%ld\n",
nsa, nwvl, avgpsf->nx, avgpsf->ny);
}
for(int ic=0; ic<nsa*nwvl; ic++){
dmat *val=dbspline_eval(simu->bspstrehl[ipowfs][ic],
simu->bspstrehlxy,simu->bspstrehlxy,
gx, gy);
double ratio=val->p[0]/avgpsf->p[ic]->p[0];
/*info("strehl: bilinear: %g, cubic: %g\n", avgpsf->p[ic]->p[0],val->p[0]); */
if(ratio<0){
warning("Ratio=%g is less than zero.\n", ratio);
scale->p[ic]=1;
}else{
dscale(avgpsf->p[ic], ratio);
scale->p[ic]=ratio;
}
dfree(val);
}
dfree(gx);
dfree(gy);
}
stari->pistat[ipowfs].psf=avgpsf;/*PSF is in corner. */
stari->pistat[ipowfs].neaspec=dcellnew(nsa*2, 1);
for(int ig=0; ig<nsa*2; ig++){
dmat *tmp=0;
for(int iwvl=0; iwvl<nwvl; iwvl++){
dadd(&tmp, 0, neaspec->p[ig+nsa*2*iwvl], parms->skyc.wvlwt->p[iwvl]);
}
stari->pistat[ipowfs].neaspec->p[ig]=dinterp1(simu->neaspec_dtrats, tmp, parms->skyc.dtrats, 0);
dfree(tmp);
}
dcellfree(neaspec);
stari->pistat[ipowfs].scale=scale;
{/* skip stars with large PSF.*/
int size=INT_MAX;
for(int ic=0; ic<avgpsf->nx*avgpsf->ny; ic++){
int size0=dfwhm(avgpsf->p[ic]);
if(size0<size) size=size0;
}
if(size>6){
stari->use[ipowfs]=-1;
}
}
if(parms->skyc.dbg){
writebin(avgpsf, "%s/avgpsf_star%d_ipowfs%d_psf",dirsetup,istar,ipowfs);
writebin(stari->pistat[ipowfs].neaspec, "%s/pistat_star%d_ipowfs%d_neaspec",dirsetup,istar,ipowfs);
}
}
}
}