/* PUT_LOGFILE -- Put a command into the logfile, if logging is enabled.
* Otherwise check if the logfile is open and close it, in case user has
* just turned logging off. If the "share_logfile" switch is set the logfile
* is opened and closed each time a record is appended to the file, allowing
* other processes to access the same file.
*/
void
put_logfile (char *command)
{
FILE *fp;
if (keeplog()) {
if (logfp == NULL)
if (open_logfile (logfile()) == ERR)
/* Do not abort by calling cl_error(). We could be a
* background job accessing a shared logfile. Also, we
* want to avoid error recursion when logging an error.
*/
return;
if (share_logfile) {
if ((fp = fopen (logfile(), "a"))) {
print_command (fp, command, "", "");
fclose (fp);
}
} else
print_command (logfp, command, "", "");
} else if (logfp != NULL)
close_logfile (logfile());
}
/* BKG_CLOSE -- Close a bkg job. Called after determining that the job has
* terminated.
*/
static void
bkg_close (
int job, /* job ordinal */
int pmsg /* print termination message */
)
{
register struct _bkgjob *bk = &jobtable[job-1];
bk->b_clock = c_clktime (bk->b_clock);
bk->b_exitcode = c_prcldpr (bk->b_jobno);
bk->b_flags &= ~(J_RUNNING|J_SERVICE);
if (bk->b_verbose && (pmsg > 1 || (pmsg == 1 && !notify()))) {
if (bk->b_exitcode != OK)
eprintf ("[%d] exit %d\n", job, bk->b_exitcode);
else
eprintf ("[%d] done\n", job);
}
/* Make a logfile entry, saying the background job ended.
*/
if (keeplog() && log_background()) {
char buf[SZ_LINE];
sprintf (buf, "Stop [%d]", job);
putlog (0, buf);
}
}
/* PUTLOG -- Format and write a message to the logfile. This is called by
* the putlog builtin (clputlog() in builtin.c) and in some places in the
* CL (e.g., exec.c).
*/
void
putlog (
struct task *tp, /* pointer to task or NULL */
char *usermsg
)
{
register char *ip, *op, *otop;
register int n;
char msg[SZ_LOGBUF], job[5];
char *pkg, *tname, *today();
extern int bkgno; /* job number if bkg job */
if (!keeplog())
return;
/* If background job, format job number, but only if background
* logging is enabled.
*/
if (firstask->t_flags & T_BATCH) {
if (log_background())
sprintf (job, "[%d] ", bkgno);
else
return;
} else
job[0] = EOS;
/* If a valid task pointer is given, get the package and task name.
* Otherwise, assume it's an internal (cl) logging message.
*/
if (tp) {
pkg = tp->t_ltp->lt_pkp->pk_name;
tname = tp->t_ltp->lt_lname;
} else {
pkg = "cl";
tname = "";
}
/* Format the message. Only use time, no day and date. Break long
* messages into several lines.
*/
sprintf (msg, "# %8.8s %s%s%s %s- ",
(today() + 4), pkg, (tp ? "." : ""), tname, job);
otop = &msg[SZ_LOGBUF];
for (op=msg, n=0; *op && op < otop; op++)
n++;
for (ip=usermsg; (*op++ = *ip++) && op < otop; n++)
if (n + 2 >= MAXCOL) {
*op++ = '\\';
*op++ = '\n';
n = 0;
}
*(op-1) = '\n';
*op = EOS;
put_logfile (msg);
}
int main(int argc, char **argv)
{
FILE *fp;
attach_SHM();
resolve_boards();
if(argc != 5) {
printf("usage: %s <board name> <title> <owner> <file>\n", argv[0]);
return 0;
}
if(strcmp(argv[4], "-") == 0)
fp = stdin;
else {
fp = fopen(argv[4], "r");
if(!fp) {
perror(argv[4]);
return 1;
}
}
keeplog(fp, argv[1], argv[2], argv[3]);
return 0;
}
/* BKG_SPAWN -- Spawn a new background job. Called by main() when we have
* seen an '&'.
*/
void
bkg_spawn (
char *cmd /* command entered by user to spawn job */
)
{
register struct _bkgjob *bk;
register int jobno, stat;
char clprocess[SZ_PATHNAME];
char *wbkgfile();
char *bkgfile;
/* Find first unused slot in a circular search.
*/
bkg_update (1);
jobno = (lastjobno == NBKG) ? 1 : lastjobno + 1;
while (jobno != lastjobno) {
if (!busy (jobno))
break;
if (jobno++ >= NBKG)
jobno = 1;
}
if (jobno == lastjobno)
cl_error (E_UERR, "no more background job slots");
/* Write bkgfile. Delete any dreg bkg communication files.
*/
bkg_delfiles (jobno);
bkgfile = wbkgfile (jobno, cmd, NULL);
/* Spawn bkg job.
*/
sprintf (clprocess, "%s%s", CLDIR, CLPROCESS);
intr_disable();
jobtable[jobno-1].b_jobno = stat =
c_propdpr (findexe (firstask->t_curpack, clprocess),
bkgfile, bkgmsg);
if (stat == NULL) {
c_delete (bkgfile);
intr_enable();
cl_error (E_IERR, "cannot spawn background CL");
} else {
bk = &jobtable[jobno-1];
bk->b_flags = J_RUNNING;
bk->b_clock = c_clktime (0L);
bk->b_verbose = 2;
strncpy (bk->b_cmd, cmd, SZ_CMD);
*(bk->b_cmd+SZ_CMD) = EOS;
intr_enable();
}
eprintf ("[%d]\n", lastjobno = jobno);
/* Make a logfile entry, saying we started the background job.
*/
if (keeplog() && log_background()) {
char buf[SZ_LINE];
sprintf (buf, "Start [%d]", jobno);
putlog (0, buf);
}
}
void
cl_error (int errtype, char *diagstr, ...)
{
va_list args;
register struct task *tp;
static int nfatal = 0;
static int break_locks = 1;
va_start (args, diagstr);
/* (Re)-initialize the error action.
*/
erract_init();
/* Safety measure, in the event of error recursion.
*/
if (err_abort) {
if (nfatal)
clexit();
if (errlev++ > 2) {
nfatal++;
eprintf ("Error recursion. Cl dies.\n");
clexit();
}
}
/* The first setjmp(errenv) is not done until we start the main loop.
* Set validerrenv when start the first interactive cl to indicate that
* we may safely longjmp back to main's loop on an error. ERRENV is
* not set for bkg jobs since error restart is not permitted.
*/
if (!validerrenv && !(firstask->t_flags & T_BATCH)) {
nfatal++;
u_doprnt (diagstr, &args, currentask->t_stderr);
if (errtype & E_P)
perror ("\nOS errmsg");
else
eprintf ("\n");
eprintf ("Fatal startup error. CL dies.\n");
clexit();
}
/* Any error occurring during logout is fatal.
*/
if (loggingout || gologout) {
nfatal++;
u_doprnt (diagstr, &args, currentask->t_stderr);
if (errtype & E_P)
perror ("\nOS errmsg");
else
eprintf ("\n");
eprintf ("Fatal logout error. CL dies.\n");
clexit();
}
/* Perform any ONERROR error recovery in the vos first. Initialize
* the error recovery mechanism (necessary since the iraf main is not
* being allowed to do error recovery).
*/
c_xonerr (1);
XER_RESET(); /* TODO: move into LIBC interface */
/* Clear terminal raw mode if still set. */
c_fseti ((XINT)STDIN, F_RAW, NO);
if (firstask->t_flags & T_BATCH)
eprintf ("\n[%d] ", bkgno);
if (errtype & E_IERR)
eprintf ("INTERNAL ");
if (errtype & E_FERR)
eprintf ("FATAL ");
/* Disable error tracing if requested.
*/
if (err_trace == YES || (errtype & E_UERR)) {
if (currentask->t_flags & T_SCRIPT &&
currentask->t_flags & T_INTERACTIVE)
eprintf ("ERROR on line %d: ", errorline);
else
eprintf ("ERROR: ");
u_doprnt (diagstr, &args, currentask->t_stderr);
if (errtype & E_P)
perror ("\nOS errmsg");
else
eprintf ("\n");
}
/* Log the error message if from a script or an executable.
*/
if (!errlog && keeplog() && log_errors()) {
if (currentask->t_flags & T_SCRIPT || currentask->t_pid != -1) {
PKCHAR buf[SZ_LINE+1];
FILE *fp;
int fd;
fd = c_stropen (buf, SZ_LINE, NEW_FILE);
fp = fdopen (fd, "w");
fprintf (fp, "ERROR on line %d: ", errorline);
u_doprnt (diagstr, &args, fp);
fclose (fp);
c_close (fd);
putlog (currentask, c_strpak (buf, (char *)buf, SZ_LINE));
}
}
errlog = 0;
/* Initialize the current command block but do not log the command
* which aborted. If we're only trapping errors and not fully
* recovering, don't reset the command block so we have the option
* to continue execution.
*/
if ((err_abort == YES && do_error == NO) ||
(do_error == YES || (errtype & E_UERR)))
yy_startblock (NOLOG);
/* Delete all pipefiles. Call iofinish() first as some OS's may
* require that the files be closed before they can be deleted.
*/
for (tp=currentask; !(tp->t_flags & T_INTERACTIVE); tp=next_task(tp)) {
iofinish (tp);
if (tp == firstask)
break;
}
delpipes (0);
/* Do not go on if this is a fatal error or we are unattended.
*/
if (errtype & E_FERR) {
nfatal++;
pr_dumpcache (0, break_locks);
clexit();
} else if (firstask->t_flags & T_BATCH)
clshutdown();
/* Reset state variables. */
/* Most of these probably needn't be reset, but we'll play
* it safe.
*/
nestlevel = 0; /* set nesting to 0 */
offsetmode (0); /* offset mode to index */
ncaseval = 0; /* number of case values */
n_indexes = 0;
imloopset = 0; /* in an implicit loop */
n_oarr = 0; /* implicit loop indicators */
i_oarr = 0;
maybeindex = 0; /* sexagesimal/index range */
parse_state = PARSE_FREE;
if (last_parm) { /* have we tried to add a param */
last_parm->p_np = NULL;
currentask->t_pfp->pf_lastpp = last_parm;
last_parm = NULL;
}
/* Set the error flag. */
errcom.errflag++;
errcom.nhandlers++;
/* Get back to an interactive state. We simply return if we're
* trapping errors except when processing a E_UERR. These type
* messages come from the CL itself and require user attention to
* correct (e.g. task not found, parameter type/syntax errors, etc).
* The calling procedure is not expecting us to return, so we cannot
* properly trap without rewriting the calling code.
*/
if (cltrace) {
eprintf ("cl_error: abort=%d beep=%d trace=%d flpr=%d\n",
err_abort, err_beep, err_trace, err_flpr);
eprintf ("cl_error: code=%d do_err=%d errtype=%d/%d task='%s'\n",
errcom.errcode, do_error, errtype, errtype&E_UERR,
currentask->t_ltp->lt_lname);
}
if ((err_abort == YES && do_error == NO) ||
(do_error == YES || (errtype & E_UERR))) {
extern ErrCom errcom;
register struct param *pp;
if (!errcom.errcode && (errtype & E_UERR)) {
errcom.errcode = errtype;
strcpy (errcom.errmsg, diagstr);
strcpy (errcom.task, currentask->t_ltp->lt_lname);
pp = paramfind (firstask->t_pfp, "$errno", 0, YES);
pp->p_val.v_i = errcom.errcode;
pp = paramfind (firstask->t_pfp, "$errmsg", 0, YES);
pp->p_val.v_s = errcom.errmsg;
pp = paramfind (firstask->t_pfp, "$errtask", 0, YES);
pp->p_val.v_s = errcom.task;
}
taskunwind();
/* If an abort occurs while interrupts are disabled they will
* never get reenabled unless we do so here.
*/
intr_reset();
/* Go back to main loop in main().
*/
va_end (args);
longjmp (errenv, 1);
} else {
va_end (args);
return;
}
}
void rdcircsum(float *outpsf, osm_ds *head, int bin,
float distance, float size, int tandem)
{
int Nxy,Nz,Nr;
int ovrsmp;
int symmetric;
FILE *logfp,*infofp;
float *pupil; /* Pupil function and its Fourier transform */
fcomplex *Cpupil;
float *psfobj; /* One (xy) plane of the objective's PSF */
float *psfbin1; /* One plane (xy) of the intermediate PSF */
float *psfbin; /* One plane (xy) of the final PSF */
float *psfcond; /* One plane of the condenser PSF */
fcomplex *otfcond;
float peak; /* Max. value of arrays (normalization) */
float illum; /* One sample of the illumination patern */
float tmp;
float alpha;
float *radpsf; /* PSF intensity image XY crossection */
float *psfxz;
float Vxx, Vyx, /* Elements of the sampling matrix */
Vxy, Vyy;
int iz, ir, ix, /* indices for depth, radial distance, */
iy, jx, jy; /* and the two lateral coordinates */
int n1, n2; /* indices for periodic sampling in the PSF */
int Maxn1, Maxn2,
Minn1, Minn2;
int Maxir;
/* __Stuff to calculte min and max index values */
float Sxmin, Sxmax, xmax, Maxxprime;
float Symin, Symax, ymax, Maxyprime;
float Maxrprime;
int sMinn1, lMaxn1;
float mytemp;
/* Number of samples in (x, y), in z and radially (= Nxy*sqrt(2))*/
int HalfNxy, Zup;
/* Number of samples radially on the convolution of psfcond and pupil */
int NetNr;
/* Number of samples in (x,y) before binning */
int Lxy;
/* Number of samples in (x,y) before binning and after
oversampling for the summation*/
int Mxy, Halfway;
/* Pupil function region of support */
int Pxy;
/* normalized radial or lateral sampling rate */
float nrm_deltar, nrm_deltaxy=1.0;
/* new lateral sampling rate based on oversampling */
float deltaxy1;
/* oversampling rate for the xy plane */
int osamp;
/* Floating point version of the above */
float ratio;
/* Weigth factors for apodization */
float weight, appod;
/* Distances in the detector plane (mm) */
float rd, x, y, ysq;
/* Shifted coordinates */
float xprime, yprime, rprime;
/* Shifting of coodrinates */
float dx, dy;
/* Shifted radial coordinate normalized by deltar */
float normRprime;
/* ..To prompt for things */
char temp_string[255];
char answer[255];
/* --------------------- BEGIN EXECUTABLE CODE -------------------- */
/* __Initialize whatever paremeters here */
/* ..Periodicity matrix */
Vxx = 1.0;
Vyx = 0.0;
Vxy = -0.5;
Vyy = (float)sqrt(3.0)*0.5;
/* ..Prompt for all data */
Nr = head->nx;
Nz = head->ny;
psfxz = (float*)head->data;
ovrsmp = head->xstart;
Nxy = head->ystart;
symmetric = head->zstart;
/* leave at 1.0
nrm_deltar = head->xlength;
nrm_deltaxy = head->ylength;
*/
HalfNxy = Nxy/2;
Lxy = Nxy*bin; /* Number of pixels before binning */
Halfway = (HalfNxy+1)*bin;
NetNr = Nr; /* Number of pixels in convolution of psfcond and pupil */
nrm_deltar = nrm_deltaxy/((float)ovrsmp);
/* oversampling rate */
/* make it beat nyquist */
osamp = (int)(deltaxy/deltaxy_nyq) + 1;
if(osamp < 5) osamp = 5;
/* make odd */
if(!(osamp & 1)) osamp++;
/* New deltaxy for oversampling */
deltaxy1 = deltaxy/((float)osamp);
ratio = (float) deltaxy1 / deltar;
printf("DXY: %.4f DXY_NYQ: %.4f SAMP = %d NEW_DXY: %.4f\n",
deltaxy,deltaxy_nyq,osamp,deltaxy1);
Mxy = Lxy * osamp; /* number of pixels after oversampling */
Halfway = (HalfNxy+1)*bin*osamp;
printf("ratio = %f Mxy = %d \n", ratio,Mxy);
/* check for single aperture */
if(distance <= 0.0) distance = 1E20;
distance = distance*nrm_deltaxy; /* Scale by pre-binning pixel size */
Zup = Nz; /* Limit for z index */
if (symmetric) Zup = (Nz/2) + 1;
/* ..Maximum values for row sampling index
(NOTE: Assumes Vyy != 0 <--) */
Minn2 = ((float)-Mxy)/(Vyy*distance);
Maxn2 = ((float)(2*Mxy))/(Vyy*distance);
/* __Calculate a conservative extimate of the maximum value if the 'ir'
index that is expected to be used. The estimate is calculated
with the following assumptions:
Vxx > 0, Vyy > 0 (strictly greater)
Vxy < 0 (Striclty less than)
Vyx = 0 (exactly)
..Most negative value of n1 expected */
sMinn1 = ((float)-Mxy)/distance - (float)Minn2*Vxy/Vxx;
/* ..Most positive value of n1 expected */
lMaxn1 = (((float)(2*Mxy))/distance - (float)Maxn2*Vxy)/Vxx;
/* ..most negative value of term subtracted from xprime */
Sxmin = Vxx*(float)sMinn1 + Vyx*(float)Maxn2;
/* ..Most positive value of term subtracted from xprime */
Sxmax = Vxx*(float)lMaxn1 + Vyx*(float)Minn2;
/* ..Largest value of x */
xmax = (float)(Halfway-1) * nrm_deltaxy;
/* ..Largest absolute value of xprime */
Maxxprime = amax1(Sxmax*distance, xmax - Sxmin*distance);
/* ..Most negative value of the term subtracted
from yprime (with Vyx=0,Vyy>0) */
Symin = Vyy*(float)Minn2;
/* ..Most positive value of the term subtracted
from yprime (with Vyx=0,Vyy>0) */
/* In the original fortran code, Maxn1 is used in the next line
without being initialized first. I suspect it's a bug, and should
really be Maxn2. */
Symax = Vyy*(float)Maxn2;
/* ..largest value of y */
ymax = (float)(Halfway-1) * nrm_deltaxy;
/* ..Largest absolute value of yprime */
Maxyprime=amax1(Vyy*(float)Maxn2*distance,ymax-Vyy*(float)Minn2*distance);
/* ..Largest value of rprime we can conservativelly expect */
Maxrprime = (float) sqrt (Maxxprime*Maxxprime + Maxyprime*Maxyprime);
/* ..Largetst index ir expected */
Maxir = (int) ((Maxrprime + 1.0)/nrm_deltar);
/* ..Factor to be used in linear interpolation used as apodization */
appod = 1.0;
if (Maxir > Nr) appod = 1.0/(float)(Maxir - Nr) ;
/* ..Calculate size of pupil function array at the higher resolution*/
Pxy = Nxy*ovrsmp*bin;
/* ..Calculate the least power of 2 that will fit */
Pxy = intlog2(Pxy-1);
Pxy = (int) pow(2.0 , Pxy+1);
/* ..Make sure that the log file exists */
if((logfp=fopen(lognm,"a"))==(FILE *)NULL) {
fprintf(stderr,"WARNING: (rotdiskcirc) can't open logfile `%s' for write.\n",lognm);
logfp = stderr;
}
fprintf(logfp," Number of slices or planes: %d\n", Nz);
fprintf(logfp," Number of xy-samples after binning: %d\n", Nxy);
fprintf(logfp," Number of radial samples available: %d\n", Nr);
fprintf(logfp," Oversampling (before binning) by: %d\n", ovrsmp);
fprintf(logfp," binning factor: %d\n", bin);
fprintf(logfp," distance between apertures: %E\n", distance);
fprintf(logfp," aperture size(prebin,oversmpled): %f\n", size);
fprintf(logfp," pupil support(prebin,oversmpled): %d\n", Pxy);
fprintf(logfp," sample matrix:\n");
fprintf(logfp," Vxx: %f\n",Vxx);
fprintf(logfp," Vxy: %f\n",Vxy);
fprintf(logfp," Vyx: %f\n",Vyx);
fprintf(logfp," Vyy: %f\n",Vyy);
fprintf(logfp,"even symmetry in z is %s assumed.\n", symmetric ? "":"NOT");
sprintf(temp_string,"%s.info",psfnm);
if((infofp=fopen(temp_string,"a"))==(FILE *)NULL)
fprintf(stderr,"WARNING: can't open info file %s for write.\n",temp_string);
else {
fprintf(infofp," binning factor: %d\n", bin);
fprintf(infofp," Distance between apertures: %E\n", distance);
fprintf(infofp,"aperture diameter(prebin,oversamp): %f\n", size);
fprintf(infofp," sample matrix:\n");
fprintf(infofp," Vxx: %f\n",Vxx);
fprintf(infofp," Vxy: %f\n",Vxy);
fprintf(infofp," Vyx: %f\n",Vyx);
fprintf(infofp," Vyy: %f\n",Vyy);
fclose(infofp);
}
fprintf(stderr,"check file %s for progress report.\n",lognm);
if (size >= 1.0) {
keeplog (logfp, "sampling pupil function ");
/* first allocate memory for array pupil */
if((pupil=(float *)calloc(sizeof(float),((Pxy+2)*Pxy)))==
(float *)NULL) {
fprintf(stderr,"out of memory in %s\n",prognm);
exit(1);
}
ZeroOut(pupil,(Pxy+2)*Pxy);
/* Get pupil function */
getpupil(pupil, size, Pxy, Pxy);
add2columns(pupil,Pxy,Pxy);
/* Fourier transform pupil function */
real_fft3d(pupil,Pxy,Pxy,1,Pxy+2,Pxy,FORWARD);
Cpupil=(fcomplex *)pupil;
/* If tandem scanning, the equivalent pinhole function is the
convolution of the pinhole with itself */
if (tandem) mult3dcm (Cpupil, Cpupil, (Pxy+2)*Pxy/2);
/* Normalize Cpupil array to avoid handling very small numbers */
peak = 0.0;
norm3dcm (Cpupil, &peak, Pxy*(Pxy+2)/2);
}
/* allocate memory for psfobj. Notice size of array */
if((psfobj=(float *)calloc(sizeof(float),Mxy*Mxy))==(float *)NULL) {
fprintf(stderr,"out of memory in %s\n",prognm);
exit(1);
}
ZeroOut(psfobj,Mxy*Mxy);
printf("Mxy = %d and Pxy=%d\n",Mxy,Pxy);
fflush(stdout);
/* allocate memory for psfcond. Notice size of array */
if (Mxy > Pxy){ /* when ovrsmp < 5 then this is true */
printf("Mxy >Pxy\n");
if((psfcond=(float *)calloc(sizeof(float),(Mxy+2)*Mxy))==(float *)NULL) {
fprintf(stderr,"out of memory in %s\n",prognm);
exit(1);
}
}
else
if((psfcond=(float *)calloc(sizeof(float),(Pxy+2)*Pxy))==(float *)NULL) {
fprintf(stderr,"out of memory in %s\n",prognm);
exit(1);
}
ZeroOut(psfcond,(Pxy+2)*Pxy);
otfcond=(fcomplex *)psfcond;
/* allocate memory for psfbin. Notice size of array */
if((psfbin=(float *)calloc(sizeof(float),Nxy*Nxy))==(float *)NULL) {
fprintf(stderr,"out of memory in %s\n",prognm);
exit(1);
}
ZeroOut(psfbin,Nxy*Nxy);
/* allocate memory for psfbi1. Notice size of array */
if((psfbin1=(float *)calloc(sizeof(float),Lxy*Lxy))==(float *)NULL) {
fprintf(stderr,"out of memory in %s\n",prognm);
exit(1);
}
ZeroOut(psfbin1,Lxy*Lxy);
for(iz=1;iz<=Zup;iz++){
if ( (iz-1)%1 == 0) {
sprintf(temp_string,"iz = %d",iz);
keeplog(logfp, temp_string);
}
/* ..Read on row of the rz or xz cross-section */
/* first have to go to the right place in file */
radpsf = (psfxz + (iz-1)*Nr);
/* Calculate the objective PSF (iterpolate rz section into xyz sect)*/
r2xy(psfobj, radpsf, Mxy, Mxy, Nr, ratio);
if (size >= 1.0) {
/* Convolve condenser PSF and aperture */
/* interpolate w/o subsampling */
r2xy(psfcond, radpsf, Pxy, Pxy, Nr, 1.0);
add2columns(psfcond,Pxy,Pxy);
/* Fourier transform, multiply, inverse Fourier transform */
real_fft3d(psfcond,Pxy,Pxy,1,Pxy+2,Pxy,FORWARD);
mult3dcm(otfcond, Cpupil, (Pxy+2)*Pxy/2);
real_fft3d(psfcond,Pxy,Pxy,1,Pxy+2,Pxy,REVERSE);
/* Copy first line of convolution to radpsf to use for illumination */
NetNr = Pxy/2+1;
cp3dr(radpsf, psfcond, NetNr);
}
/* The following loops are based on the PSF's even symmetry
in x and y */
/* Calculate the illumination distribution */
for(iy=1;iy<=Halfway;iy++){
y = (float)(iy-1)*nrm_deltaxy;
for(ix=1;ix<=Halfway;ix++){
x = (float)(ix-1)*nrm_deltaxy;
/*Initialize to use as accumulator */
illum = 0.0;
/* ..Index n2 is for columns */
for(n2=Minn2;n2<=Maxn2;n2++){
dx = Vxy*n2;
dy = Vyy*n2;
/* ..These two lines assume Vxx is not zero */
Minn1=(int)(((float)-Mxy/distance-dx)/Vxx);
Maxn1=(int)((2.0*(float)Mxy/distance-dx)/Vxx);
/* ..Index n1 involves rows and columns */
for(n1=Minn1;n1<=Maxn1;n1++){
xprime = x - distance*(Vxx*(float)n1+dx);
yprime = y - distance*(Vyx*(float)n1+dy);
/* Rectangular sampling to check what's going on here */
/*
xprime = x - distance*float(n2)
yprime = y - distance*float(n1)
*/
rprime = (float)sqrt((double)(xprime*xprime) + (double)(yprime*yprime));
/* ..Normalize to the subsampled grid */
normRprime = rprime*ratio;
ir = (int)normRprime + 1;
/* ..Interpolate and accumulate */
if (ir < NetNr) {
/* ..Interpolate between adjacent samples */
alpha = ir - normRprime;
/*tmp = radpsf(ir)*alpha + radpsf(ir+1)*(1.0-alpha)*/
tmp = *(radpsf+ir-1) * ((float)ir-normRprime)
+ *(radpsf+ir+1-1) * (normRprime+1.0-(float)ir);
}
else {
/*This should disapear when we become confident
that the conservative guess for Maxir is OK */
if (ir > Maxir) {
Maxir = ir;
fprintf(stderr,"Found an ir > Maxir. \n");
fprintf(stderr,"Maxir set to %d\n",ir);
fprintf(stderr,"check the code that guesses Maxir again.\n");
appod = 1.0/(Maxir-Nr);
}
/*..Apodize from last available sample to zero
to avoid sharp edges in the PSF */
/* ..Apodize by linear interpolation to zero at ir = Maxir */
weight = (Maxir-(float)ir)*appod;
tmp = *(radpsf+NetNr-1) * weight;
}
illum = illum + tmp;
} /* end loop for n1 */
} /* end loop for n2 */
/* IMPORTANT
The dimension of the array psfcond is now Mxy by Mxy,
instead of (Pxy+2) by Pxy. */
/* psfcond(ix,iy) = illum */
*(psfcond+(ix-1)+(iy-1)*Mxy) = illum;
} /* end loop for ix */
} /* end loop for iy */
/* ..Even symmetric replication into the other three quadrants */
/* IMPORTANT
The dimension of the array psfcond is now Mxy by Mxy,
instead of (Pxy+2) by Pxy.
*/
evenrepr(psfcond, Mxy, Mxy);
/* ..Multiply illumination and objective psf (into psfobj) */
mult3drm(psfobj, psfcond, Mxy*Mxy);
/* sum neighboring pixels to downsample the BIG PSF */
/* note dimension goes from Mxy to Lxy = Nxy*bin */
Sum4N4NToNN(psfobj,psfbin1,Lxy,osamp); /* routine is in rotsum.c */
/* Bin here */
/* If binning by 1 copy psf to psfbin */
if (bin == 1) /* Lxy = Nxy */
cp3dr (psfbin, psfbin1, Nxy*Nxy);
else {
/* Add pixels together */
/* Clean psfbin array to use as accumulator */
init3dr(psfbin, 0.0, Nxy*Nxy);
/* binning */
for(ix=1;ix<=Lxy;ix++){
jx = ((ix-1)/bin) + 1;
for(iy=1;iy<=Lxy;iy++){
jy = ((iy-1)/bin) + 1;
*(psfbin+(jx-1)+(jy-1)*Nxy) += *(psfbin1+(ix-1)+(iy-1)*Lxy);
}
}
}
WritePlane(iz-1,outpsf,psfbin,Nxy,Nxy,Nxy,Nxy);
if(symmetric && (iz > 1))
WritePlane(Nz-iz+1,outpsf,psfbin,Nxy,Nxy,Nxy,Nxy);
} /* end of "for(iz=1;iz<=Zup;iz++)" */
keeplog (logfp, "DONE");
if(logfp != stderr) fclose(logfp);
printf("don't free up the memory\n");
/*free(radpsf);
free(psfbin);
free(psfobj);
free(psfcond);
free(pupil);*/
}
/* IOFINISH -- Flush out and wrap up all pending io for given task.
* Called when the task is dying and it wants to close all files it opened.
* This includes a pipe if it used one, a file if it was a script and io
* redirections as indicated by the T_MYXXX flags. The T_MYXXX flags are
* set only when the redirections were done for this task, ie, they were
* not simply inherited.
* Just as a fail-safe measure, always check that a real stdio file is
* not being closed.
* Don't call error() because in trying to restor to an interactive task
* it might call us again and cause an inf. loop.
*/
void
iofinish (
register struct task *tp
)
{
register FILE *fp;
int flags;
flags = tp->t_flags;
/* Make sure we do not close files more than once.
*/
if (flags & T_RUNNING)
tp->t_flags &= ~T_RUNNING;
else
return;
if (cldebug)
eprintf ("flushing io for task `%s'\n", tp->t_ltp->lt_lname);
if (flags & T_MYIN) {
fp = tp->t_stdin;
if (fp != stdin)
fclose (fp);
}
if (flags & T_MYOUT) {
fflush (fp = tp->t_stdout);
if (fp != stdout)
fclose (fp);
}
if (flags & T_MYERR) {
fflush (fp = tp->t_stderr);
if (fp != stderr)
fclose (fp);
}
/* Close any redirected graphics output streams.
*/
if (flags & (T_MYSTDGRAPH|T_MYSTDIMAGE|T_MYSTDPLOT)) {
if (flags & T_MYSTDGRAPH)
if (tp->t_stdgraph != tp->t_stdimage &&
tp->t_stdgraph != tp->t_stdplot)
fclose (tp->t_stdgraph);
if (flags & T_MYSTDIMAGE)
if (tp->t_stdimage != tp->t_stdplot)
fclose (tp->t_stdimage);
if (flags & T_MYSTDPLOT)
fclose (tp->t_stdplot);
}
/* If task i/o is redirected to a subprocess send the done message.
*/
if (flags & T_IPCIO)
fputs (IPCDONEMSG, tp->t_out);
fflush (tp->t_out);
/* Close files only for script task, not for a cl, a builtin, or
* a process. Do call disconnect if the task lives in a process.
*/
if (flags & T_SCRIPT) {
fp = tp->t_in;
if (fp != stdin)
fclose (fp);
} else if (flags & (T_CL|T_BUILTIN)) {
;
} else if (tp->t_pid != -1)
pr_disconnect (tp->t_pid);
/* Log a stop message for script and executable tasks.
*/
if (keeplog() && log_trace())
if (tp->t_flags & T_SCRIPT || tp->t_pid != -1)
putlog (tp, "Stop");
}
/* EXECNEWTASK -- Called from the EXEC instruction after all param and stdio
* processing for the new task is complete. Here we actually run the new task,
* either directly in the case of a builtin function, or as a new case for
* main()'s loop. Do not set newtask to NULL so that run() can tell what it
* exec'd.
*/
void
execnewtask (void)
{
/* VMS C V2.1 cannot handle this (see below).
* register struct pfile *pfp;
*/
static struct pfile *pfp;
struct param *pp;
FILE *fopen();
if (newtask == NULL)
/* if this ever happens, i don't want to know about it. */
return;
currentask->t_pc = pc; /* instruction after EXEC */
if (cldebug)
eprintf ("execnewtask: pc = %d\n", pc);
if (newtask->t_flags & T_BUILTIN) {
/* set yyin in case a builtin reads someday; none do now.
* unlink newtask's fake param file and reset top of dictionary
* to what it was before the fake param file was added; it is
* still there, however, for the builtin to use. this is done
* since some builtins (eg task) want to add things that are
* to stay on the dictionary and the tools all start at topd.
* the return is back to run(); it will continue since it will
* see that newtask was just a builtin.
* note that we do not reset pf_n, as with other fake pfiles,
* as this is the way builtins get their number of arguments
* (it's faster than building them a $nargs).
*/
yyin = newtask->t_in = currentask->t_in; /* inherit pipe */
newtask->t_out = currentask->t_out;
newtask->t_modep = currentask->t_modep; /* inherit mode */
/* VMS C 2.1 Optimizer cannot handle this.
* parhead = dereference (reference (pfile, parhead)->pf_npf);
*/
pfp = reference (pfile, parhead);
parhead = dereference (pfp->pf_npf);
topd = currentask->t_topd;
currentask = newtask;
newtask->t_flags |= T_RUNNING;
if (cldebug)
eprintf ("execnewtask: calling new task@%x\n", newtask);
if (cltrace)
eprintf ("\t----- exec %s %s -----\n",
(newtask->t_flags & T_FOREIGN) ? "foreign" : "builtin",
newtask->t_ltp->lt_lname);
(*newtask->t_ltp->lt_f)();
oneof(); /* proceed as though this task saw eof */
return;
}
pfp = newtask->t_pfp;
/* If the new task is a cl, we are not running in background and
* its t_in is stdin, it is interactive. Note that when a package
* is loaded by a script task rather than interactively by the user,
* the t_in of the cl() in the package script task will be reading
* from the calling script task rather than from the original stdin
* (the user terminal), hence is not interactive. If this task is
* flagged interactive, taskunwind() may elect to restart it on an
* error so save present state for restor().
*/
if (newtask->t_flags & T_CL) {
if (cldebug)
eprintf ("execnewtask: new task is the CL\n");
if (cltrace)
eprintf ("\t----- exec cl -----\n");
/* Call set_clio to set the command input and output streams
* t_in and t_out for a cl() or package_name() command.
*/
set_clio (newtask);
/* This code is a temporary patch to allow packages to be
* loaded from within scripts regardless of whether there
* are enclosing brackets. If a CL statement is executed
* within a script which is itself called within another
* script, then we will do an implicit keep before the CL.
*/
if (topcs + 2*TASKSIZ <= STACKSIZ)
if ((strcmp (newtask->t_ltp->lt_lname, "cl") == 0) ||
(strcmp (newtask->t_ltp->lt_lname, "clbye") == 0))
if ((currentask->t_flags & T_SCRIPT) &&
(prevtask->t_flags & T_SCRIPT))
keep(prevtask);
/* If newtask is cleof(), close the input stream of the current
* task (the task whose input contained the cleof), and reopen
* as the null file.
*/
if (newtask->t_flags & T_CLEOF) {
if (currentask->t_in != stdin)
fclose (currentask->t_in);
if (currentask != firstask)
currentask->t_in = fopen ("dev$null", "r");
}
if (!(firstask->t_flags & T_BATCH) &&
(newtask->t_in == stdin) && (newtask->t_out == stdout)) {
newtask->t_flags |= T_INTERACTIVE;
newtask->t_topd = topd;
newtask->t_topos = topos;
newtask->t_topcs = topcs;
newtask->t_curpack = curpack;
}
}
/* Standardize the pfile.
* Set (or create if necessary) `$nargs', number of command line args,
* based on pf_n which is set for each command line argument by
* posargset, et al.
* If this ltask had no paramfile and we built one up from the
* command line, then we need to add a `mode' param. If it did have
* a paramfile, then pfileload has already added it for us.
* Point t_modep to the mode param for newtask.
*/
pp = paramfind (pfp, "$nargs", 0, YES);
if (pp == NULL || (XINT)pp == ERR) {
char nabuf[FAKEPARAMLEN];
sprintf (nabuf, "$nargs,i,h,%d\n", pfp->pf_n);
pp = addparam (pfp, nabuf, NULL);
pp->p_mode |= M_FAKE; /* never flush out $nargs */
} else
pp->p_val.v_i = pfp->pf_n;
if (pfp->pf_flags & PF_FAKE) {
newtask->t_modep = addparam (pfp, "mode,s,h,q\n", NULL);
/* pf_n will be used by paramsrch() to count positional arg
* matches; see it and param.h.
*/
pfp->pf_n = 0;
} else {
newtask->t_modep = paramfind (pfp, "mode", 0, YES);
}
if (newtask->t_modep == NULL)
cl_error (E_IERR, "no mode param for task `%s'",
newtask->t_ltp->lt_lname);
/* If task is being run in menu mode, call up eparam so that the user
* can edit/inspect the parameters. If eparam is exited with ctrl/c
* do not run the task or update the pfile. The parameter editor
* will make a copy of the task's pfile(s), edit it, and if necessary
* update the incore version created earlier by callnewtask().
*/
if ((taskmode(newtask) & M_MENU) || (newtask->t_flags & T_PSET)) {
if (epset (newtask->t_ltp->lt_lname) == ERR) {
if (newtask->t_flags & T_PSET)
cl_error (E_UERR, "parameter file not updated");
else
cl_error (E_UERR, "menu mode task execution aborted");
}
}
/* Set up bascode so new task has a good place to start building
* code. See how the pc is set up before each call to the parser in
* main() loop.
*/
newtask->t_bascode = topos + 1;
/* Set up io paths. If the new task is cl(), it's command input
* and output streams are connected to those of the task which
* called currentask. If the currentask is the firstask, there
* was no caller (no prevtask), so we must watch out for that.
* In the case of a script, commands are read from the script.
* In the case of a process, commands are read from the process.
*/
if (newtask->t_flags & T_PSET) {
newtask->t_in = fopen ("dev$null", "r");
newtask->t_out = newtask->t_stdout;
} else if (newtask->t_flags & T_SCRIPT) {
if (cltrace)
eprintf ("\t----- exec script %s (%s) -----\n",
newtask->t_ltp->lt_lname, newtask->t_ltp->lt_pname);
newtask->t_in = fopen (newtask->t_ltp->lt_pname, "r");
if (newtask->t_in == NULL)
cl_error (E_UERR|E_P, "can not open script file `%s'",
newtask->t_ltp->lt_pname);
newtask->t_out = newtask->t_stdout;
} else if (newtask->t_flags & T_CL) {
/* The command streams t_in and t_out have already been
* set up above by set_clio() in the test for T_INTERACTIVE.
*/
/* Do nothing */
} else {
char startup_msg[SZ_STARTUPMSG+1];
int timeit;
/* Connect to an executable process.
*/
mk_startupmsg (newtask, startup_msg, SZ_STARTUPMSG);
timeit = (newtask->t_flags & T_TIMEIT) != 0;
if (cltrace)
eprintf ("\t----- exec external task %s -----\n",
newtask->t_ltp->lt_lname);
newtask->t_pid = pr_connect (
findexe (newtask->t_ltp->lt_pkp, newtask->t_ltp->lt_pname),
startup_msg,
&newtask->t_in, &newtask->t_out,
newtask->t_stdin, newtask->t_stdout, newtask->t_stderr,
newtask->t_stdgraph, newtask->t_stdimage, newtask->t_stdplot,
timeit);
}
yyin = newtask->t_in; /* set the input for the parser */
/* Tell parser what to expect.
*/
parse_state = PARSE_FREE;
if (newtask->t_flags & T_SCRIPT) {
proc_script = (newtask->t_flags & T_PSET) ? NO : procscript(yyin);
if (proc_script) {
parse_state = PARSE_BODY;
/* Skip to the BEGIN statement */
newtask->t_scriptln = skip_to (yyin, "begin");
if (newtask->t_scriptln == ERR)
cl_error (E_UERR, "No BEGIN statement in procedure script");
/* Reset pointer here.
*/
proc_script = NO;
}
}
/* Log a start message for script and executable tasks.
*/
if (keeplog() && log_trace())
if (newtask->t_flags & T_SCRIPT || newtask->t_pid != -1) {
char logmsg[SZ_LINE];
sprintf (logmsg, "Start (%s)", newtask->t_ltp->lt_pname);
putlog (newtask, logmsg);
}
newtask->t_flags |= T_RUNNING;
currentask = newtask; /* continue as new the new task; at last. */
if (cldebug)
eprintf ("Returning from execnewtask.yyin, ct_in, nt_in:%d %d %d\n",
yyin, currentask->t_in, newtask->t_in);
}
