Exemple #1
0
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");
}
Exemple #2
0
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);
	}
    }
}
Exemple #3
0
/**
  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;
}
Exemple #4
0
/**
   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;
}
Exemple #5
0
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);
    }
}
Exemple #6
0
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;
}
Exemple #7
0
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");
}
Exemple #8
0
/*
  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");
}
Exemple #9
0
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");
    }
}
Exemple #10
0
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);
		}
	}
}
Exemple #11
0
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");
}
Exemple #12
0
/**
   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;
}
Exemple #13
0
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);
		}
	}
}
Exemple #14
0
/**
   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);
	    }
	}
    }
}