From fa080de7afc95aa1c19a6e6fc0e0708ced2eadc4 Mon Sep 17 00:00:00 2001 From: Joseph Hunkeler Date: Wed, 8 Jul 2015 20:46:52 -0400 Subject: Initial commit --- noao/obsutil/src/Revisions | 139 ++ noao/obsutil/src/bitcount.par | 4 + noao/obsutil/src/ccdtime/Revisions | 79 + noao/obsutil/src/ccdtime/ccddb.x | 222 +++ noao/obsutil/src/ccdtime/ccdtime.par | 15 + noao/obsutil/src/ccdtime/mkpkg | 17 + noao/obsutil/src/ccdtime/t_ccdtime.x | 307 ++++ noao/obsutil/src/ccdtime/x_ccdtime.x | 1 + noao/obsutil/src/doc/bitcount.hlp | 80 + noao/obsutil/src/doc/ccdtime.hlp | 364 ++++ noao/obsutil/src/doc/cgiparse.hlp | 166 ++ noao/obsutil/src/doc/findgain.hlp | 168 ++ noao/obsutil/src/doc/kpnofocus.hlp | 214 +++ noao/obsutil/src/doc/pairmass.hlp | 132 ++ noao/obsutil/src/doc/psfmeasure.hlp | 633 +++++++ noao/obsutil/src/doc/shutcor.hlp | 93 + noao/obsutil/src/doc/specfocus.hlp | 375 ++++ noao/obsutil/src/doc/sptime.hlp | 1218 +++++++++++++ noao/obsutil/src/doc/starfocus.hlp | 820 +++++++++ noao/obsutil/src/findgain.cl | 119 ++ noao/obsutil/src/mkpkg | 31 + noao/obsutil/src/pairmass/airmass.x | 23 + noao/obsutil/src/pairmass/drawvector.x | 121 ++ noao/obsutil/src/pairmass/initmarker.x | 39 + noao/obsutil/src/pairmass/mkpkg | 19 + noao/obsutil/src/pairmass/pairmass.par | 40 + noao/obsutil/src/pairmass/t_pairmass.x | 112 ++ noao/obsutil/src/pairmass/x_pairmass.x | 1 + noao/obsutil/src/shutcor.cl | 120 ++ noao/obsutil/src/specfocus/Revisions | 9 + noao/obsutil/src/specfocus/mkpkg | 19 + noao/obsutil/src/specfocus/specfocus.h | 33 + noao/obsutil/src/specfocus/specfocus.par | 13 + noao/obsutil/src/specfocus/spfgraph.x | 1637 ++++++++++++++++++ noao/obsutil/src/specfocus/t_specfocus.x | 762 ++++++++ noao/obsutil/src/specfocus/x_specfocus.f | 146 ++ noao/obsutil/src/specfocus/x_specfocus.x | 1 + noao/obsutil/src/sptime/Revisions | 81 + noao/obsutil/src/sptime/abzero.cl | 10 + noao/obsutil/src/sptime/blazeang.cl | 24 + noao/obsutil/src/sptime/blazefunc.cl | 76 + noao/obsutil/src/sptime/grating.x | 1107 ++++++++++++ noao/obsutil/src/sptime/lib/abjohnson | 17 + noao/obsutil/src/sptime/lib/circle | 21 + noao/obsutil/src/sptime/lib/slit | 103 ++ noao/obsutil/src/sptime/mkcircle.cl | 16 + noao/obsutil/src/sptime/mkpkg | 20 + noao/obsutil/src/sptime/mkslit.cl | 37 + noao/obsutil/src/sptime/rates.cl | 74 + noao/obsutil/src/sptime/specpars.par | 85 + noao/obsutil/src/sptime/sptime.h | 132 ++ noao/obsutil/src/sptime/sptime.par | 53 + noao/obsutil/src/sptime/stdisperser.x | 455 +++++ noao/obsutil/src/sptime/t_cgiparse.x | 110 ++ noao/obsutil/src/sptime/t_sptime.x | 2530 +++++++++++++++++++++++++++ noao/obsutil/src/sptime/tabinterp.x | 698 ++++++++ noao/obsutil/src/sptime/x_spectime.x | 2 + noao/obsutil/src/starfocus/Revisions | 162 ++ noao/obsutil/src/starfocus/mkpkg | 22 + noao/obsutil/src/starfocus/psfhelp.key | 60 + noao/obsutil/src/starfocus/psfmeasure.par | 24 + noao/obsutil/src/starfocus/starfocus.h | 140 ++ noao/obsutil/src/starfocus/starfocus.key | 15 + noao/obsutil/src/starfocus/starfocus.par | 32 + noao/obsutil/src/starfocus/stfgraph.x | 2682 +++++++++++++++++++++++++++++ noao/obsutil/src/starfocus/stfhelp.key | 63 + noao/obsutil/src/starfocus/stfmeasure.x | 134 ++ noao/obsutil/src/starfocus/stfprofile.x | 1189 +++++++++++++ noao/obsutil/src/starfocus/t_starfocus.x | 1240 +++++++++++++ noao/obsutil/src/starfocus/x_starfocus.x | 2 + noao/obsutil/src/t_bitcount.x | 202 +++ noao/obsutil/src/x_obsutil.x | 8 + 72 files changed, 19918 insertions(+) create mode 100644 noao/obsutil/src/Revisions create mode 100644 noao/obsutil/src/bitcount.par create mode 100644 noao/obsutil/src/ccdtime/Revisions create mode 100644 noao/obsutil/src/ccdtime/ccddb.x create mode 100644 noao/obsutil/src/ccdtime/ccdtime.par create mode 100644 noao/obsutil/src/ccdtime/mkpkg create mode 100644 noao/obsutil/src/ccdtime/t_ccdtime.x create mode 100644 noao/obsutil/src/ccdtime/x_ccdtime.x create mode 100644 noao/obsutil/src/doc/bitcount.hlp create mode 100644 noao/obsutil/src/doc/ccdtime.hlp create mode 100644 noao/obsutil/src/doc/cgiparse.hlp create mode 100644 noao/obsutil/src/doc/findgain.hlp create mode 100644 noao/obsutil/src/doc/kpnofocus.hlp create mode 100644 noao/obsutil/src/doc/pairmass.hlp create mode 100644 noao/obsutil/src/doc/psfmeasure.hlp create mode 100644 noao/obsutil/src/doc/shutcor.hlp create mode 100644 noao/obsutil/src/doc/specfocus.hlp create mode 100644 noao/obsutil/src/doc/sptime.hlp create mode 100644 noao/obsutil/src/doc/starfocus.hlp create mode 100644 noao/obsutil/src/findgain.cl create mode 100644 noao/obsutil/src/mkpkg create mode 100644 noao/obsutil/src/pairmass/airmass.x create mode 100644 noao/obsutil/src/pairmass/drawvector.x create mode 100644 noao/obsutil/src/pairmass/initmarker.x create mode 100644 noao/obsutil/src/pairmass/mkpkg create mode 100644 noao/obsutil/src/pairmass/pairmass.par create mode 100644 noao/obsutil/src/pairmass/t_pairmass.x create mode 100644 noao/obsutil/src/pairmass/x_pairmass.x create mode 100644 noao/obsutil/src/shutcor.cl create mode 100644 noao/obsutil/src/specfocus/Revisions create mode 100644 noao/obsutil/src/specfocus/mkpkg create mode 100644 noao/obsutil/src/specfocus/specfocus.h create mode 100644 noao/obsutil/src/specfocus/specfocus.par create mode 100644 noao/obsutil/src/specfocus/spfgraph.x create mode 100644 noao/obsutil/src/specfocus/t_specfocus.x create mode 100644 noao/obsutil/src/specfocus/x_specfocus.f create mode 100644 noao/obsutil/src/specfocus/x_specfocus.x create mode 100644 noao/obsutil/src/sptime/Revisions create mode 100644 noao/obsutil/src/sptime/abzero.cl create mode 100644 noao/obsutil/src/sptime/blazeang.cl create mode 100644 noao/obsutil/src/sptime/blazefunc.cl create mode 100644 noao/obsutil/src/sptime/grating.x create mode 100644 noao/obsutil/src/sptime/lib/abjohnson create mode 100644 noao/obsutil/src/sptime/lib/circle create mode 100644 noao/obsutil/src/sptime/lib/slit create mode 100644 noao/obsutil/src/sptime/mkcircle.cl create mode 100644 noao/obsutil/src/sptime/mkpkg create mode 100644 noao/obsutil/src/sptime/mkslit.cl create mode 100644 noao/obsutil/src/sptime/rates.cl create mode 100644 noao/obsutil/src/sptime/specpars.par create mode 100644 noao/obsutil/src/sptime/sptime.h create mode 100644 noao/obsutil/src/sptime/sptime.par create mode 100644 noao/obsutil/src/sptime/stdisperser.x create mode 100644 noao/obsutil/src/sptime/t_cgiparse.x create mode 100644 noao/obsutil/src/sptime/t_sptime.x create mode 100644 noao/obsutil/src/sptime/tabinterp.x create mode 100644 noao/obsutil/src/sptime/x_spectime.x create mode 100644 noao/obsutil/src/starfocus/Revisions create mode 100644 noao/obsutil/src/starfocus/mkpkg create mode 100644 noao/obsutil/src/starfocus/psfhelp.key create mode 100644 noao/obsutil/src/starfocus/psfmeasure.par create mode 100644 noao/obsutil/src/starfocus/starfocus.h create mode 100644 noao/obsutil/src/starfocus/starfocus.key create mode 100644 noao/obsutil/src/starfocus/starfocus.par create mode 100644 noao/obsutil/src/starfocus/stfgraph.x create mode 100644 noao/obsutil/src/starfocus/stfhelp.key create mode 100644 noao/obsutil/src/starfocus/stfmeasure.x create mode 100644 noao/obsutil/src/starfocus/stfprofile.x create mode 100644 noao/obsutil/src/starfocus/t_starfocus.x create mode 100644 noao/obsutil/src/starfocus/x_starfocus.x create mode 100644 noao/obsutil/src/t_bitcount.x create mode 100644 noao/obsutil/src/x_obsutil.x (limited to 'noao/obsutil/src') diff --git a/noao/obsutil/src/Revisions b/noao/obsutil/src/Revisions new file mode 100644 index 00000000..44497e52 --- /dev/null +++ b/noao/obsutil/src/Revisions @@ -0,0 +1,139 @@ +.help Revisions Nov01 obsutuil + +sptime/t_sptime.x + Made the graphs all auto-scale. (11/14/08, Valdes) + +sptime/t_sptime.x +sptime/stdisperser.x +sptime/grating.x +sptime/specpars.par +sptime/sptime.h +doc/sptime.hlp + Added a "generic" disperser type to force using the desired wavelength + and dispersion without defining a grating whose mapping between + position on the detector and wavelength might be wrong. Also fixed + a couple of typos. (11/13/08, Valdes) + +======= +V2.14.1 +======= + +======= +V2.13 +======= + +doc/ccdtime.hlp +ccdtime/t_ccdtime.x + In order to get more than five filters while not changing the parameters + the f1-f5 input parameters may not be a comma delimited list of + desired filters. Note that whitespace is not stripped and the + filter must match the string in the database so "U, V" will match + "U" but not "V". Instead use "U,V". (9/21/06, Valdes) + + +======= +V2.12.3 +======= + +t_sptime.x + 1. For fibers or circular aperture the area of the aperture applied to + the sky flux was wrong because the size was treated as a radius instead + of a diameter. + 2. In computing the sky flux reported the way seeing throughput was + applied was wrong. (1/5/05, Valdes) + + +======== +V2.12.2a +======== + +grating.x +t_sptime.x + Added some checks against unphysical parameters. + (7/7/04, Valdes) + +mkpkg + Did not follow the standard convention of building xx_obsutil.e. + (7/7/04, Valdes) + +======= +V2.12.2 +======= + +sptime/t_sptime.x +sptime/sptime.par +sptime/sptime.h + 1. Improved algorithm for handling saturation. + 2. Added a minimum exposure parameter. + (5/15/03, Valdes) + +starfocus/stfprofile.x + Limits on centroided image raster at the boundary have been removed. + Instead boundary reflection allows a somewhat unbiased centroid estimation + for sources near the edge. (5/6/03, Valdes) + +starfocus/t_starfocus.x +starfocus/starfocus.h +starfocus/mkpkg + 1. Added 100 pixels of boundary reflection to allow some attempt at + measuring PSFs near the image edges. + 2. Now starting coordinates closer that a radius distance from the + image edge are allowed. (5/6/03, Valdes) + +starfocus/stfprofile.x + The selection of a point to get a first estimation of the FWHM in + stf_fit did not check for the case of a zero value. This could cause + a floating divide by zero. (5/5/03, Valdes) + +starfocus/stfprofile.x + The subpixel evaluation involves fitting an image interpolator to a + subraster. To avoid attempting to evaluate a point outside the center + of the edge pixels, which is a requirement of the image interpolators, + the interpolator is fit to the full data raster and the evaluations + exclude the boundary pixels. (5/5/03, Valdes) + +ccdtime.par +t_ccdtime.x + 1. The minimum seeing is now 0.001. + 2. The formating of the seeing was changed in case the seeing is set + less than 0.1. + (4/24/03, Valdes) + +t_sptime.x + The thermal background calculation was wrong. (3/17/03, Valdes) + +../doc/cgiparse.hlp + +../../obsutil.hd + Added CGIPARSE task help. (3/3/03, Valdes) + +sptime/t_cgiparse.x + +sptime/x_spectime.x +sptime/mkpkg.x +x_obsutil.x +../obsutil.cl +../obsutil.men + Added CGIPARSE task. (3/3/03, Valdes) + +sptime/t_sptime.x +sptime/specpars.par +sptime/sptime.par +sptime/sptime.h + See sptime/Revisions. (3/3/03, Valdes) + +======= +V2.12.1 +======= + +===== +V2.12 +===== + +New obsutil package installed. + 1. STARFOCUS, PSFMEASURE, SPECFOCUS extracted from NMISC. + 2. CCDTIME copied from ASTUTIL + 3. SPTIME, SPECPARS extracted from SPECTIME. + 4. FINDGAIN copied and modified from MSCFINDGAIN. + 5. BITCOUNT, PAIRMASS copied from NLOCAL. + (11/14/01, Valdes) + +.endhelp diff --git a/noao/obsutil/src/bitcount.par b/noao/obsutil/src/bitcount.par new file mode 100644 index 00000000..be93f6c2 --- /dev/null +++ b/noao/obsutil/src/bitcount.par @@ -0,0 +1,4 @@ +images,s,a,,,,Input image names +grandtotal,b,h,no,,,Accumulate a grand total over all the images? +leftzeroes,b,h,yes,,,Count the leftmost zeroes? +verbose,b,h,yes,,,Verbose output? diff --git a/noao/obsutil/src/ccdtime/Revisions b/noao/obsutil/src/ccdtime/Revisions new file mode 100644 index 00000000..44405b23 --- /dev/null +++ b/noao/obsutil/src/ccdtime/Revisions @@ -0,0 +1,79 @@ +.help revisions Jun88 noao.obsutil +.nf + +======= +V2.12.2 +======= + +ccdtime.par +t_ccdtime.x + 1. The minimum seeing is now 0.001. + 2. The formating of the seeing was changed in case the seeing is set + less than 0.1. + (4/24/03, Valdes) + +======= +V2.12.1 +======= + +===== +V2.12 +===== + +t_ccdtime.x +../doc/ccdtime.hlp + It is now an error if time<0, time>10-000, abs(mag)>40, snr<0 or + snr>100000. (8/24/00, Valdes) + +../doc/ccdtime.hlp + In the formula for r(sky) was pixel area term was in the wrong place. + (3/9/99, Valdes) + +t_ccdtime.x + For the case where SNR is very large and a time is specified the + iteration on the magnitude might not complete. The iteration is now + capped at 100 and the test for convergence is now normalized. + (11/6/98, Valdes) + +t_ccdtime.x +../doc/ccdtime.hlp + 1. The calculation of exposure time given a SNR was changed from an + interative solution to an analytic solution. + 2. The times are printed to 0.01s. + 3. The photometry aperture is now the rounded-up integer with a minimum + of 9 pixels. + (9/8/98, Valdes) + +t_ccdtime.x +ccddb.x +../doc/ccdtime.hlp + 1. The database keywords can now be index by reference to the telescope, + filter, and/or telescope. + 2. A new filter keyword, "extinction", was added to specify the + extinction. + 3. The extinction is now used to fixe the previous incorrect behavior + that used 1 mag/airmass extinction. The old results are preserved + by making the default extinction be 1 if missing. However the + database files should be updated to have correct extinctions. + (8/19/98, Valdes) + +ccddb.x +../doc/ccdtime.hlp + 1. The code would not work with database entries containing whitespace. + 2. The help was not correct in describing how the number of pixels used + in the photometry is calculated from the seeing FWHM. + (4/5/94, Valdes) + +t_ccdtime.x + Modified CCDTIME to use a plate scale instead of the f/ratio and to + include an airmass term. (10/23/93, Valdes) + +t_ccdtime.x + +ccddb.x + +ccdtime.x - +ccdtime.par +doc/ccdtime.hlp + Revised CCDTIME to use a telescope/filter/detector database and to + compute and print additional information. (8/16/93, Valdes) + +.endhelp diff --git a/noao/obsutil/src/ccdtime/ccddb.x b/noao/obsutil/src/ccdtime/ccddb.x new file mode 100644 index 00000000..e0f4dd1d --- /dev/null +++ b/noao/obsutil/src/ccdtime/ccddb.x @@ -0,0 +1,222 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# General text database routines. + +# Symbol table definitions. +define LEN_INDEX 10 # Length of symtab index +define LEN_STAB 512 # Length of symtab +define SZ_SBUF 512 # Size of symtab string buffer +define SYMLEN 40 # Length of symbol structure +define SZ_DBVAL 79 # Size of database value string + +# Symbol table structure +define DBVAL Memc[P2C($1)] # Database value string + + +# DBOPEN -- Open database and store the requested information in symbol table. + +pointer procedure dbopen (dname, fname, kname, ename) + +char dname[ARB] #I Directory name +char fname[ARB] #I File name +char kname[ARB] #I Key name +char ename[ARB] #I Entry name +pointer db #O Database symbol table pointer + +int fd, found, open(), fscan(), nscan() +pointer sp, pname, name, key, str, sym +pointer stopen(), stenter() +bool streq(), strne() +errchk open, stopen, stenter, fscan, dberror + +begin + call smark (sp) + call salloc (pname, SZ_FNAME, TY_CHAR) + call salloc (name, SZ_LINE, TY_CHAR) + call salloc (key, SZ_FNAME, TY_CHAR) + call salloc (str, SZ_LINE, TY_CHAR) + + # Open database. + call sprintf (Memc[pname], SZ_FNAME, "%s%s") + call pargstr (dname) + call pargstr (fname) + fd = open (Memc[pname], READ_ONLY, TEXT_FILE) + + # Strip entry name whitespace and convert to lower case. + call strcpy (ename, Memc[name], SZ_LINE) + call xt_stripwhite (Memc[name]) + call strlwr (Memc[name]) + + # List entries in database. + if (Memc[name] == '?') { + Call printf ("Entries for %s in database %s:\n") + call pargstr (kname) + call pargstr (Memc[pname]) + while (fscan (fd) != EOF) { + call gargwrd (Memc[key], SZ_FNAME) + call gargwrd (Memc[str], SZ_LINE) + call gargwrd (Memc[str], SZ_LINE) + if (nscan()<3 || Memc[key]=='#' || strne (Memc[key], kname)) + next + call printf ("\t%s\n") + call pargstr (Memc[str]) + } + call close (fd) + call sfree (sp) + return (NULL) + } + + # Find entry. + found = 0 + while (fscan (fd) != EOF) { + call gargwrd (Memc[key], SZ_FNAME) + call gargwrd (Memc[str], SZ_LINE) + call gargwrd (Memc[str], SZ_LINE) + if (nscan()<3 || Memc[key]=='#' || strne (Memc[key], kname)) + next + found = 1 + call strlwr (Memc[str]) + if (streq (Memc[str], Memc[name])) { + found = 2 + break + } + } + + # Check if entry was found. + if (found != 2) { + call close (fd) + if (found != 1) + call dberror ("DBOPEN: Database entry not found", kname) + else + call dberror ("DBOPEN: Database entry not found", ename) + } + + # Create symbol table. + db = stopen (ename, LEN_INDEX, LEN_STAB, SZ_SBUF) + + # Read the file and enter the parameters in the symbol table. + sym = stenter (db, Memc[key], SYMLEN) + call strcpy (ename, DBVAL(sym), SZ_DBVAL) + while (fscan(fd) != EOF) { + call gargwrd (Memc[key], SZ_FNAME) + call gargwrd (Memc[str], SZ_LINE) + call gargwrd (Memc[str], SZ_LINE) + if (nscan()>0 && (streq(Memc[key],"end") || streq(Memc[key],kname))) + break + if (nscan() < 3 || Memc[key] == '#') + next + sym = stenter (db, Memc[key], SYMLEN) + call strcpy (Memc[str], DBVAL(sym), SZ_DBVAL) + } + + call close (fd) + call sfree (sp) + + return (db) +end + + +# DBCLOSE -- Close the database symbol table pointer. + +procedure dbclose (db) + +pointer db # Database symbol table pointer + +begin + if (db != NULL) + call stclose (db) +end + + +# DBGETD -- Get double database parameter. + +double procedure dbgetd (db, param, arg1, arg2) + +pointer db # Database symbol table pointer +char param[ARB] # Database parameter +char arg1[ARB], arg2[ARB] # Optional arguments + +char str[SZ_LINE] +int ip, ctod() +double dval +errchk dbgstr + +begin + call dbgstr (db, param, arg1, arg2, str, SZ_LINE) + + ip = 1 + if (ctod (str, ip, dval) <= 0) + call dberror ("DBGETD: Database parameter not double", param) + return (dval) +end + + +# DBGSTR -- Get string valued parameter. + +procedure dbgstr (db, param, arg1, arg2, str, maxchar) + +pointer db # Database symbol table pointer +char param[ARB] # Database parameter +char arg1[ARB], arg2[ARB] # Optional arguments +char str[maxchar] # Database parameter value +int maxchar # Maximum characters for string + +pointer sp, param1, sym, stfind() +errchk dberror + +begin + call smark (sp) + call salloc (param1, SZ_LINE, TY_CHAR) + + sym = NULL + if (arg1[1] != EOS && arg2[1] != EOS) { + call sprintf (Memc[param1], SZ_LINE, "%s(%s,%s)") + call pargstr (param) + call pargstr (arg1) + call pargstr (arg2) + sym = stfind (db, Memc[param1]) + if (sym == NULL) { + call sprintf (Memc[param1], SZ_LINE, "%s(%s,%s)") + call pargstr (param) + call pargstr (arg2) + call pargstr (arg1) + sym = stfind (db, Memc[param1]) + } + } + if (sym == NULL && arg1[1] != EOS) { + call sprintf (Memc[param1], SZ_LINE, "%s(%s)") + call pargstr (param) + call pargstr (arg1) + sym = stfind (db, Memc[param1]) + } + if (sym == NULL && arg2[1] != EOS) { + call sprintf (Memc[param1], SZ_LINE, "%s(%s)") + call pargstr (param) + call pargstr (arg2) + sym = stfind (db, Memc[param1]) + } + if (sym == NULL) + sym = stfind (db, param) + + call sfree (sp) + + if (sym == NULL) + call dberror ("DBGSTR: Database parameter not found", param) + call strcpy (DBVAL(sym), str, maxchar) +end + + +# DBERROR -- Print database error. + +procedure dberror (errstr, param) + +char errstr[ARB] # Error string +char param[ARB] # Parameter +char errmsg[SZ_LINE] # Error message + +begin + call sprintf (errmsg, SZ_LINE, "%s (%s)") + call pargstr (errstr) + call pargstr (param) + call error (1, errmsg) +end diff --git a/noao/obsutil/src/ccdtime/ccdtime.par b/noao/obsutil/src/ccdtime/ccdtime.par new file mode 100644 index 00000000..d7a36c24 --- /dev/null +++ b/noao/obsutil/src/ccdtime/ccdtime.par @@ -0,0 +1,15 @@ +time,r,h,INDEF,,,Time (seconds) +magnitude,r,h,20.,,,Magnitude +snr,r,h,10.,0.1,,Signal-to-noise ratio +database,s,h,"ccdtime$kpno.dat",,,Database file +telescope,s,h,,,,Telescope name (? for list) +detector,s,h,,,,Detector name (? for list) +sum,i,h,1,,,CCD summing factor +seeing,r,h,1.5,0.001,10.0,Seeing (arcsec) +airmass,r,h,1.2,1.,,Airmass +phase,r,h,0.,0.,28.,Moon phase (0-28) +f1,s,h,U,,,Filter 1 +f2,s,h,B,,,Filter 2 +f3,s,h,V,,,Filter 3 +f4,s,h,R,,,Filter 4 +f5,s,h,I,,,Filter 5 diff --git a/noao/obsutil/src/ccdtime/mkpkg b/noao/obsutil/src/ccdtime/mkpkg new file mode 100644 index 00000000..d468ef93 --- /dev/null +++ b/noao/obsutil/src/ccdtime/mkpkg @@ -0,0 +1,17 @@ +# Make the CCDTIME task. + +$checkout libpkg.a ../ +$update libpkg.a +$checkin libpkg.a ../ +$exit + +standalone: + $update libpkg.a + $omake x_ccdtime.x + $link x_ccdtime.o libpkg.a -lxtools -o xx_ccdtime.e + ; + +libpkg.a: + ccddb.x + t_ccdtime.x + ; diff --git a/noao/obsutil/src/ccdtime/t_ccdtime.x b/noao/obsutil/src/ccdtime/t_ccdtime.x new file mode 100644 index 00000000..0c0e8822 --- /dev/null +++ b/noao/obsutil/src/ccdtime/t_ccdtime.x @@ -0,0 +1,307 @@ +define NF 25 # Maximum number of filters +define SZ_FILTER 7 # Maximum length of filter name +define TOL 0.0001 # Convergence tolerance + + +# T_CCDTIME -- Compute the time, magnitude, and signal-to-noise for CCD +# exposures for a given telescope, detector, and filters. The telescope +# detector, and filter data come from a text database. The computed +# quantities fix two parameters and compute the third. + +procedure t_ccdtime() + +pointer database # Telescope, detector, filter database +pointer telescope # Telescope +pointer detector # Detector +pointer fltr[5] # Filters +real time # Target time (sec) +real mag # Target magnitude +real snr # Target SNR +int sum # CCD summing +real seeing # Seeing (arcsec) +real phase # Moon phase (0-28) +real airmass # Airmass + +int i, j, k, nf, n +real a, b, c +real aper, scale, trans, nread, dark, pixsize, lum, p +real star[NF], sky[NF], t, m, s, nstar, nsky, ndark, noise, npix +real dqe, ext, starmag, counts, sky0, sky1, sky2 +pointer sp, tdb, ddb, filter[NF], fdb[NF] + +int clgeti() +real clgetr() +double dbgetd() +pointer dbopen() +errchk dbopen + +define done_ 10 + +begin + call smark (sp) + call salloc (database, SZ_FNAME, TY_CHAR) + call salloc (telescope, SZ_FNAME, TY_CHAR) + call salloc (detector, SZ_FNAME, TY_CHAR) + do i = 1, 5 + call salloc (fltr[i], SZ_LINE, TY_CHAR) + do i = 1, NF + call salloc (filter[i], SZ_FILTER, TY_CHAR) + + # Get task parameters. + call clgstr ("database", Memc[database], SZ_FNAME) + call clgstr ("telescope", Memc[telescope], SZ_FNAME) + call clgstr ("detector", Memc[detector], SZ_FNAME) + call clgstr ("f1", Memc[fltr[1]], SZ_LINE) + call clgstr ("f2", Memc[fltr[2]], SZ_LINE) + call clgstr ("f3", Memc[fltr[3]], SZ_LINE) + call clgstr ("f4", Memc[fltr[4]], SZ_LINE) + call clgstr ("f5", Memc[fltr[5]], SZ_LINE) + + time = clgetr ("time") + mag = clgetr ("magnitude") + snr = clgetr ("snr") + sum = clgeti ("sum") + seeing = clgetr ("seeing") + phase = clgetr ("phase") + airmass = clgetr ("airmass") + + # The input filter strings may be lists of filters and here + # we expand them into all filters. + + nf = 1; k = 0 + do i = 1, 5 { + for (j = fltr[i]; Memc[j] != EOS; j = j + 1) { + Memc[filter[nf]+k] = Memc[j] + if (Memc[j] == ',') { + Memc[filter[nf]+k] = EOS + if (k > 0) { + nf = nf + 1; k = 0 + } + } else + k = k + 1 + } + Memc[filter[nf]+k] = EOS + if (k > 0) { + nf = nf + 1; k = 0 + } + } + nf = nf - 1 + + i = 0 + if (IS_INDEFR(time)) + i = i + 1 + else if (time <= 0.) + call error (1, "Requested time must be greater than zero") + else if (time > 100000.) + call error (1, "Requested time must be less than 100,000") + + if (IS_INDEFR(mag)) + i = i + 1 + else if (mag > 40.) + call error (1, "Requested magnitude must be less than 40") + else if (mag < -40.) + call error (1, "Requested magnitude must be greater than -40") + + if (IS_INDEFR(snr)) + i = i + 1 + else if (snr <= 0.) + call error (1, "Requested SNR must be greater than zero") + else if (snr > 100000.) + call error (1, "Requested SNR must be less than 100,000") + + if (i > 1) { + call sfree (sp) + call error (1, + "At least two of time, magnitude, and snr must be specified") + } + + if (phase < 14) + p = phase + else + p = 28 - phase + + # Open database entries. + # If '?' this will print list and then the task will exit. + # If an error occurs in the telescope or detector abort. + # If an error occurs in the filter ignore the filter. + + tdb = dbopen ("", Memc[database], "telescope", Memc[telescope]) + ddb = dbopen ("", Memc[database], "detector", Memc[detector]) + + n = 0 + do i = 1, nf { + iferr (fdb[n+1]=dbopen("",Memc[database],"filter",Memc[filter[i]])) + next + if (fdb[n+1] == NULL) + goto done_ + n = n + 1 + filter[n] = filter[i] + } + if (tdb == NULL || ddb == NULL || n == 0) + goto done_ + + # Get star and sky rates for telescope/detector/filter combination. + # Convert to a standard rate at 20th magnitude at the given airmass. + + do i = 1, n { + # Get telescope parameters. + aper = dbgetd (tdb, "aperture", Memc[filter[i]], Memc[detector]) + scale = dbgetd (tdb, "scale", Memc[filter[i]], Memc[detector]) + trans = dbgetd (tdb, "transmission", Memc[filter[i]], + Memc[detector]) + + # Get detector parameters. + dqe = dbgetd (ddb, Memc[filter[i]], Memc[filter[i]], + Memc[telescope]) + nread = dbgetd (ddb, "rdnoise", Memc[filter[i]], Memc[telescope]) + dark = dbgetd (ddb, "dark", Memc[filter[i]], Memc[telescope]) + pixsize = dbgetd (ddb,"pixsize",Memc[filter[i]],Memc[telescope]) * + (scale / 1000) * sum + npix = max (9, nint (1.4 * (seeing / pixsize)**2+0.5)) + + # Get filter parameters. + iferr (ext = dbgetd (fdb[i], "extinction", Memc[telescope], + Memc[detector])) + ext = 1 + starmag = dbgetd (fdb[i], "mag", Memc[telescope], Memc[detector]) + counts = dbgetd (fdb[i], "star", Memc[telescope], Memc[detector]) + sky0 = dbgetd (fdb[i], "sky0", Memc[telescope], Memc[detector]) + sky1 = dbgetd (fdb[i], "sky1", Memc[telescope], Memc[detector]) + sky2 = dbgetd (fdb[i], "sky2", Memc[telescope], Memc[detector]) + + lum = 10. ** (0.4 * (starmag - 20.)) + star[i] = counts * lum * aper ** 2 * trans * + 10 ** (0.4 * (1 - airmass) * ext) + star[i] = star[i] * dqe + sky[i] = sky0 + sky1 * p + sky2 * p * p + sky[i] = star[i] * pixsize ** 2 * 10. ** ((20. - sky[i]) / 2.5) + } + if (!IS_INDEFR(mag)) + lum = 10. ** (0.4 * (20. - mag)) + + # Print header and column labels. + call printf ("Database: %-20s Telescope: %-10s Detector: %-10s\n") + call pargstr (Memc[database]) + call pargstr (Memc[telescope]) + call pargstr (Memc[detector]) + call printf (" Sum: %-2d Arcsec/pixel: %-4.2f Pixels/star: %-4.1f\n") + call pargi (sum) + call pargr (pixsize) + call pargr (npix) + call printf (" Seeing: %-.3g Airmass: %-4.2f Phase: %-4.1f\n") + call pargr (seeing) + call pargr (airmass) + call pargr (phase) + call printf ("\n%7s %7s %7s %7s %7s %7s %s\n") + call pargstr ("Filter") + call pargstr ("Time") + call pargstr ("Mag") + call pargstr ("SNR") + call pargstr ("Star") + call pargstr ("Sky/pix") + call pargstr (" Noise contributions") + call printf ("%47w %7s %7s %7s\n") + call pargstr ("Star") + call pargstr ("Sky") + call pargstr ("CCD") + + # Compute exposure time through each filter. + + if (!IS_INDEFR(mag) && !IS_INDEFR(snr)) { + call printf ("\n") + do i = 1, n { + a = ((star[i] * lum) / snr) ** 2 + b = -(star[i] * lum + npix * (sky[i] + dark)) + c = -npix * nread ** 2 + t = (-b + sqrt (b**2 - 4 * a * c)) / (2 * a) + + nstar = star[i] * lum * t + nsky = sky[i] * t + ndark = dark * t + noise = sqrt(nstar + npix * (nsky + ndark + nread**2)) + s = nstar / noise + m = mag + + call printf ( + "%7s %7.2f %7.1f %7.1f %7.1f %7.1f %7.2f %7.2f %7.2f\n") + call pargstr (Memc[filter[i]]) + call pargr (t) + call pargr (m) + call pargr (s) + call pargr (nstar) + call pargr (nsky) + call pargr (sqrt (nstar)) + call pargr (sqrt (npix * nsky)) + call pargr (sqrt (npix * (ndark + nread**2))) + } + } + + # Compute magnitude through each filter. + # Use resubstitution to iterate for SNR. + + if (!IS_INDEFR(time) && !IS_INDEFR(snr)) { + call printf ("\n") + do i = 1, n { + m = 20 + s = 0 + do j = 1, 100 { + t = time + nstar = star[i] * 10**(0.4*(20.0-m)) * t + nsky = sky[i] * t + ndark = dark * t + noise = sqrt(nstar + npix * (nsky + ndark + nread**2)) + m = 20 - 2.5 * log10 (snr * noise / (t * star[i])) + s = nstar / noise + if (abs(1-s/snr) <= TOL) + break + } + + call printf ( + "%7s %7.2f %7.1f %7.1f %7.1f %7.1f %7.2f %7.2f %7.2f\n") + call pargstr (Memc[filter[i]]) + call pargr (t) + call pargr (m) + call pargr (s) + call pargr (nstar) + call pargr (nsky) + call pargr (sqrt (nstar)) + call pargr (sqrt (npix * nsky)) + call pargr (sqrt (npix * (ndark + nread**2))) + } + } + + # Compute SNR through each filter. + + if (!IS_INDEFR(time) && !IS_INDEFR(mag)) { + call printf ("\n") + do i = 1, n { + t = time + m = mag + nstar = star[i] * lum * t + nsky = sky[i] * t + ndark = dark * t + noise = sqrt(nstar + npix * (nsky + ndark + nread**2)) + s = nstar / noise + + call printf ( + "%7s %7.2f %7.1f %7.1f %7.1f %7.1f %7.2f %7.2f %7.2f\n") + call pargstr (Memc[filter[i]]) + call pargr (t) + call pargr (m) + call pargr (s) + call pargr (nstar) + call pargr (nsky) + call pargr (sqrt (nstar)) + call pargr (sqrt (npix * nsky)) + call pargr (sqrt (npix * (ndark + nread**2))) + } + } + call printf ("\n") + +done_ + call dbclose (tdb) + call dbclose (ddb) + do i = 1, n + call dbclose (fdb[i]) + call sfree (sp) +end diff --git a/noao/obsutil/src/ccdtime/x_ccdtime.x b/noao/obsutil/src/ccdtime/x_ccdtime.x new file mode 100644 index 00000000..cccfa908 --- /dev/null +++ b/noao/obsutil/src/ccdtime/x_ccdtime.x @@ -0,0 +1 @@ +task ccdtime = t_ccdtime diff --git a/noao/obsutil/src/doc/bitcount.hlp b/noao/obsutil/src/doc/bitcount.hlp new file mode 100644 index 00000000..22744f83 --- /dev/null +++ b/noao/obsutil/src/doc/bitcount.hlp @@ -0,0 +1,80 @@ +.help bitcount Mar93 noao.obsutil +.ih +NAME +bitcount - accumulate the bit statistics for a list of images +.ih +USAGE +bitcount images +.ih +PARAMETERS +.ls images +A list of image names whose bit statistics will be counted. The +statistics can either be reported for each individual image (the +default) or as a grand total over all the images. +.le +.ls grandtotal = no +If \fIgrandtotal\fR = yes, accumulate a grand total over all the +images. If \fIgrandtotal\fR = no (the default), report the statistics +individually for each image in turn. +.le +.ls leftzeroes = yes +If \fIleftzeroes\fR = yes, leftmost zeroes are counted into the +statistics (the default). If \fIleftzeroes\fR = no, leftmost zeroes +(those past the most significant digit for each individual pixel) +are omitted from the statistics. +.le +.ls verbose = yes +If \fIverbose\fR = no, only the raw bit counts will be reported. +.le +.ih +DESCRIPTION +\fIBitcount\fR will report the absolute and relative proportions +of zeroes and ones populating each bit plane of a list of images. +This is useful for diagnosing problems with a CCD's A/D converter, +especially when an input image is supplied that contains a linear +ramp in exposure across the range of the A/D. + +The statistics for the list of images can be accumulated either +individually for each image, or as a grand total over all of the +images depending on the value of the \fIgrandtotal\fR parameter. +A single linear exposure ramp can be mimiced by a grand total +over a list of progressively more exposed images. Care should +be taken to arrange that the exposures sample all parts of the +A/D's range. + +The \fIleftzeroes\fR parameter is used to correct a problem seen +with the ctio.bitstat task. Bitstat under-reports zeroes for the +more significant bits since only pixels with values greater than +the bit being currently counted participate in that count. The +severity and precise nature of this problem depends on the exposure +level of a particular test image. \fILeftzeroes\fR may be set to +"no" if there is some reason to restore this behavior. + +The \fIverbose\fR parameter may be set to "no" in order to pass +the raw bit counts on to some other task. +.ih +EXAMPLES +To report the bit statistics for a test exposure ramp: + +.nf + nl> bitcount testramp +.fi + +To accumulate a grand total over a list of images: + +.nf + nl> bitcount a001*.imh grandtotal+ +.fi +.ih +BUGS +A warning will be issued when accumulating a grand total over a list +of images whose datatypes vary. In this case, the totals for each bit +will be correct - to the extent that some images may not populate some +bits - but the datatype of the final image in the list will control the +range of bitplanes included in the output report. The interpretation +of the most significant bit as a sign bit will also depend on the +datatype of this final image. +.ih +SEE ALSO +imstatistics, ctio.bitstat +.endhelp diff --git a/noao/obsutil/src/doc/ccdtime.hlp b/noao/obsutil/src/doc/ccdtime.hlp new file mode 100644 index 00000000..0dee4ed1 --- /dev/null +++ b/noao/obsutil/src/doc/ccdtime.hlp @@ -0,0 +1,364 @@ +.help ccdtime Nov01 noao.obsutil +.ih +NAME +ccdtime -- compute time, magnitude, and signal-to-noise for CCDs +.ih +USAGE +ccdtime +.ih +PARAMETERS +.ls time = INDEF +Time in seconds for output of magnitude at the specified signal-to-noise and +signal-to-noise at the specified magnitude. This time applies to all +filters. If specified as INDEF then no output at fixed exposure time will +be produced. If the value is not greater than zero or less than 100000 +an error is reported. +.le +.ls magnitude = 20. +Magnitude for output of time at the specified signal-to-noise and +signal-to-noise at the specified time. This magnitude applies to all +filters. If specified as INDEF then no output at fixed magnitude will +be produced. If the absolute value of the magnitude is greater than 40 +an error will be reported. +.le +.ls snr = 20. +Signal-to-noise ratio for output of time at the specified magnitude and +magnitude at the specified time. This signal-to-noise ratio applies to all +filters. If specified as INDEF then no output at fixed signal-to-noise +ratio will be produced. If the value is not greater than zero or less than +100000 an error is reported. +.le + +.ls database = "ccdtime$kpno.dat" +Database file for telescope, filter, and detector information. The format +of this file is described elsewhere. This file is typically a standard +file from the logical directory "ccdtime$" or a personal copy in a +user's directory. +.le +.ls telescope = "?" +Telescope entry from the database. If "?" a list of telescopes in the +database is produced. The name must match the entry name in the database +but ignoring case. If the same telescope has multiple focal ratios then +there must be multiple entries in the database. +.le +.ls detector = "" +Detector entry from the database. If "?" a list of detectors in the +database is produced. The name must match the entry name in the database +but ignoring case. +.le +.ls sum = 1 +CCD on-chip summing or binning factor. +.le +.ls seeing = 1.5 +Expected seeing (FWHM) in arc seconds. The number of pixels used for computing +the total star counts and the signal-to-noise is given by 1.4 times the square +of the seeing converted to pixels and rounded up. +.le +.ls airmass = 1.2 +Airmass for observation. +.le +.ls phase = 0. +Moon phase in days (0-28) for the estimation of sky brightness. A +phase of zero is new moon or dark sky conditions and a phase of 14 +is full moon. +.le + +.ls f1 = "U", f2 = "B", f3 = "V", f4 = "R", f5 = "I" +Filters for which to compute the CCD information. If given as "?" +a list of filters in the database is produced. If the name (ignoring +case) is not found then it is ignored. A null name, that is "", is used +to eliminate listing of a filter. If more than five filters is desired +each of the parameters may be a comma delimited list of desired filters. +Note that whitespace is preserved so "U, V" will expand to "U" and " V" +and so will not match "V" in the database. Use "U,V" instead. +.le +.ih +DESCRIPTION +A telescope, CCD detector, and list of filters is selected from a database +to define the expected photon/electron count rates. These rates along with +a specified seeing and airmass are used to estimate the signal-to-noise +ratio (SNR) for a stellar observation in each filter. The output provides +three results per filter; the exposure time to achieve a desired SNR for a +given magnitude, the magnitude to achieve a desired SNR in a given time, and +the SNR at a specified magnitude and exposure time. With each of these, +the number of star photons (or CCD electrons) in an area 1.4 times the +square of the seeing, the number of sky photons per pixel, and the RMS noise +contributions from photon noise in the star, the sky, and the detector +noise from dark current and read out noise are given. Note that least two +of the time, magnitude, and signal-to-noise ratio must be specified but if +one is INDEF then output with that quantity fixed will be skipped or, in +other words, only the output where the quantity is computed is produced. + +The calibration information needed to define the count rates are +taken from a database file. This file may be standard ones given in +the logical directory "ccdtime$" or the user may create their own. +The database contains entries organized by telescope name (which may +include a focal ratio if there are multiple ones), detector name, +and filter name. One of the standard files may be used as a template. + +The file is actually in free format with whitespace and comments ignored. +However, following the template formatting makes it easy to see the logical +structure. All lines, except the "end" line which separates the different +catagories of entries, consist of a keyword an equal sign, and a value +separated by whitespace. An entry begins with one of the keywords +"telescope", "detector", or "filter" and ends with the beginning of +a new entry or the "end" separator. + +A keyword is one of the words shown in the example below. These keywords +can also be indexed by the name of a telescope, filter, and/or detector +entry. This allows having different transmissions in different filters +due to correctors, different scales for different detectors which may +have fore-optics, etc. + +Specifically a keyword in the telescope section may have arguments +from the filter or detector entries, a keyword in the filter section may +have arguments from the telescope and detector entries, and a keyword +in the detector section may have arguments from the telescope and filter +entries. The formats are keyword, keyword(arg), and keyword(arg,arg). +The arg fields must match an entry name exactly (without the quotes) +and there can be no whitespace between the keyword and (, between ( +and the argument, between the arguments and the comma, and between the +last argument and the closing ). The software will first look for +keywords with both arguments in either order, then for keywords with +one argument, and then for keywords with no arguments. + +Below is an example of each type of entry: + +.nf + telescope = "0.9m" + aperture = 0.91 + scale = 30.2 + transmission = 1.0 + transmission(U) = 0.8 + transmission(U,T1KA) = 0.7 + + filter = "U" + mag = 20 + star = 18.0 + extinction = 0.2 + sky0 = 22.0 + sky1 = -0.2666 + sky2 = -.00760 + + detector = "T1KA" + rdnoise = 3.5 + dark = 0.001 + pixsize = 24 + U = 0.36 + B = 0.61 + V = 0.71 + R = 0.78 + I = 0.60 +.fi + +In the example, a transmission of 0.7 will be used if the filter is U +and the detector is T1KA, a value of 0.8 if the filter is U and the +detector is not T1KA, and a value of 1 for all other cases. + +The telescope entry contains the aperture diameter in meters, the +scale in arcsec/mm, and a transmission factor. The transmission factor is +mostly a fudge factor but may be useful if a telescope has various +configurations with additional mirrors and optics. + +The filter entry contains a fiducial magnitude and the total photon count +rate for a star of that magnitude. The units are photons per second +per square meter of aperture. An effective extinction in magnitudes/airmass is +given here. The sky is defined by a quadratic +function of lunar phase in days: + +.nf + if (phase < 14) + sky = sky0 + sky1 * phase + sky2 * phase**2 + else + sky = sky0 + sky1 * (14 - phase) + sky2 * (14 - phase)**2 +.fi + +One may set the higher order terms to zero if the moon contribution +is to be ignored. The units are magnitudes per square arc second. + +The detector entry contains the read out noise in electrons, the +dark current rate in electrons per second, the pixel size in +microns, and the detective quantum efficiency (DQE); the fraction of +detected photons converted to electrons. Note that the actual +values used are the DQE times the rates given by the filter entries. +Thus, one may set the DQE values to 1 and adjust the filter values +or set the star count rates to 1 in the filter and set the actual +count rates in the DQE values. + +The computed quantities are formally given as follows. The +star count rates for the specified telescope/detector/filter are: + +.nf + r(star) = star * aperture**2 * transmission * + 10**(0.4*(1-airmass)*extinction) * dqe +.fi + +where the "star", "aperture", "transmission", "extinction", are those +in the database and the "dqe" is the appropriate filter value. The sky +rate per pixel is: + +.nf + r(sky) = r(star) * 10 ** (0.4 * (mag - sky)) * pixel**2 + pixel = pixsize * scale * sum +.fi + +where mag is the fiducial magnitude, sky is the value computed using +the quadratic formula for the specified moon phase and the database +coefficients, the "pixel" size is computed using the CCD pixel size and +the telescope scale from the database, and sum is the +specified CCD binning factor. + +The number of pixels per star is computed from the seeing as: + +.nf + npix = 1.4 * (seeing / pixel) ** 2 +.fi + +where the number is rounded up to the next integer and a minimum of 9 +pixels is enforced. This number is a compromise between a large aperture +for high SNR stars and a smaller aperture for fainter stars. + +The number of star photons/electrons per star of magnitude m, +the number of sky photons per pixel, and the number of dark current +electrons, all in exposure time t, are given by: + +.nf + nstar = r(star) * 10 ** (0.4 * (mag - m)) * t + nsky = r(sky) * t + ndark = dark * t +.fi + +where dark is taken from the detector database entry. + +Finally the noise contributions, total noise, and signal-to-noise are +given by: + +.nf + noise star = nstar ** 1/2 + noise sky = (npix * nsky) ** 1/2 + noise ccd = (npix * (ndark + rdnoise**2)) ** 1/2 + noise total = (nstar+npix*(nsky+ndark+rdnoise**2)) ** 1/2 + SNR = nstar / noise total +.fi +.ih +EXAMPLES +1. To get a list of the telescopes, filters, and detectors in a database: + +.nf + cl> ccdtime telescope=? detector=? f1=? + Entries for telescope in database ccdtime$kpno.dat: + 0.9m + ... + 4m + Entries for detector in database ccdtime$kpno.dat: + T1KA + T2KA + T2KB + TI2 + TI3 + T5HA + S2KA + Entries for filter in database ccdtime$kpno.dat: + U + B + V + R + I +.fi + +2. The following is for the default magnitude and SNR and with +a 1 second exposure time specified. The output has some +whitespace removed to fit on this page. + +.nf + cl> ccdtime time=1 + Telescope: 0.9m + Detector: t1ka + Database: ccdtime$kpno.dat Telescope: 0.9m Detector: t1ka + Sum: 1 Arcsec/pixel: 0.72 Pixels/star: 6.0 + Seeing: 1.5 Airmass: 1.20 Phase: 0.0 + + + Filter Time Mag SNR Star Sky/pix Noise contributions + Star Sky CCD + + U 70.2 20.0 10.0 196.6 8.8 14.02 8.90 10.53 + B 13.0 20.0 10.0 208.8 13.0 14.45 10.82 10.51 + V 13.2 20.0 10.0 250.7 29.8 15.83 16.37 10.51 + R 17.3 20.0 10.0 365.8 95.9 19.13 29.38 10.51 + I 126.4 20.0 10.0 1259.2 1609.8 35.49 120.37 10.55 + + U 1.0 15.6 10.0 166.6 0.1 12.91 1.06 10.50 + B 1.0 17.4 10.0 170.0 1.0 13.04 3.00 10.50 + V 1.0 17.6 10.0 174.6 2.3 13.21 4.50 10.50 + R 1.0 17.6 10.0 186.0 5.5 13.64 7.06 10.50 + I 1.0 16.7 10.0 207.9 12.7 14.42 10.71 10.50 + + U 1.0 20.0 0.3 2.8 0.1 1.67 1.06 10.50 + B 1.0 20.0 1.4 16.0 1.0 4.00 3.00 10.50 + V 1.0 20.0 1.6 19.0 2.3 4.36 4.50 10.50 + R 1.0 20.0 1.6 21.1 5.5 4.59 7.06 10.50 + I 1.0 20.0 0.7 10.0 12.7 3.16 10.71 10.50 + +.fi + +Note that the default of 1 second in the last section +gives the count rates per second for star and sky. + +3. Sometimes one may want to vary one parameter easily on the command +line or query. This can be done by changing the parameter to query +mode. In the following example we want to change the magnitude. + +.nf + cl> ccdtime.magnitude.p_mode=query + cl> ccdtime.telescope="0.9m" + cl> ccdtime.detector="t1ka" + cl> ccdtime.f1=""; ccdtime.f5="" + cl> ccdtime + Magnitude (20.): + Database: ccdtime$kpno.dat Telescope: 0.9m Detector: t1ka + Sum: 1 Arcsec/pixel: 0.72 Pixels/star: 6.0 + Seeing: 1.5 Airmass: 1.20 Phase: 0.0 + + Filter Time Mag SNR Star Sky/pix Noise contributions + Star Sky CCD + + B 13.0 20.0 10.0 208.8 13.0 14.45 10.82 10.51 + V 13.2 20.0 10.0 250.7 29.8 15.83 16.37 10.51 + R 17.3 20.0 10.0 365.8 95.9 19.13 29.38 10.51 + + cl> ccdtime 21 + ... + cl> ccdtime 22 + ... +.fi +.ih +REVISIONS +.ls CCDTIME V2.13 +The f1 to f5 parameters were modified to allow lists of filters so +that more than five filters can be output without changing the parameter +interface. +.le +.ls CCDTIME V2.12 +Task added to OBSUTIL package. +.le +.ls CCDTIME V2.11.4 +A error will be reported if the requested time or SNR is not greater +than zero and less than 100000., or if the absolute value +of the magnitude is greater than 40. +.le +.ls CCDTIME V2.11.2 +The incorrect usage of a 1 mag/airmass extinction was fixed by adding an +expected "extinction" entry in the filter entries. Note that old files +will still give the same result by using an extinction of 1 if the keyword +is not found. + +The database keywords can not be indexed by telescope, filter, and/or +detector. + +The number of pixels per aperture now has a minimum of 9 pixels. +.le +.ih +SEE ALSO +sptime +.endhelp diff --git a/noao/obsutil/src/doc/cgiparse.hlp b/noao/obsutil/src/doc/cgiparse.hlp new file mode 100644 index 00000000..f054ca4e --- /dev/null +++ b/noao/obsutil/src/doc/cgiparse.hlp @@ -0,0 +1,166 @@ +.help cgiparse Mar03 noao.obsutil +.ih +NAME +cgiparse -- parse STRING_QUERY environment var. into parameters +.ih +SYNOPSIS +CGIPARSE parses the STRING_QUERY environment varabile and sets parameters. +The string format is a list of task.param=value pairs which includes the +standard QUERY string special characters '&', '+', and '%'. This is +intended to parse a query from a CGI script. +.ih +USAGE +cgiparse +.ih +PARAMETERS +There are no parameters. The input is the value of the QUERY_STRING +environment variable. +.ih +DESCRIPTION +CGIPARSE parses the STRING_QUERY environment varabile and sets parameters. +The string format is a list of task.param=value pairs which includes the +standard QUERY string special characters '&', '+', and '%'. This is +intended to parse a query from a CGI script. + +The only input is the STRING_QUERY variable. If it is undefined the +task simply does nothing. The string will normally use the standard +parameters for this type of string. The data fields are task.param=value +strings. As each is parsed the values will be set for the task. This +assumes the tasks are defined. Theere is no error checking for +undefined tasks or parameters. +.ih +EXAMPLES +1. A CGI script calls a CL script with the STRING_QUERY string set. +The string has "imheader.longheader=yes". CGIPARSE is called and +when it completes the parameter value is set. + +.nf + cl> lpar imhead + cl> lpar imheader + images = image names + (imlist = "*.imh,*.fits,*.pl,*.qp,*.hhh") default image ... + (longheader = no) print header in multi-line format + (userfields = yes) print the user fields ... + (mode = "ql") + cl> cgiparse + cl> lpar imheader + images = image names + (imlist = "*.imh,*.fits,*.pl,*.qp,*.hhh") default image ... + (longheader = yes) print header in multi-line format + (userfields = yes) print the user fields ... + (mode = "ql") +.fi + +Note that when running this in a "#!cl" script where the "login.cl" is +not used that you must be careful to have all tasks referenced by the +query string defined. + +2. Below is a "#!cl" type script that uses CGIPARSE. It is used for +a spectral exposure time calculator based on OBSUTIL.SPTIME though many +aspects are fairly generic for this type of application. + +.nf +#!/iraf/iraf/bin.freebsd/cl.e -f + +file urldir + +# The following must be set for different hosts. +# The home directory and the urldir are the same but in different syntax. +# The home directory must have a world writable tmp subdirectory. + +set arch = ".freebsd" +set (home = osfn ("/www/htdocs/noao/staff/brooke/gsmt/")) +urldir = "/noao/staff/brooke/gsmt/" + +# The uparm is a unique temporary directory. +s1 = mktemp ("uparm") // "/" +set (uparm = "home$/tmp/" // s1) +mkdir uparm$ +cd uparm +printf ("!/bin/chmod a+rw %s\n", osfn("uparm$")) | cl + +# The URL directory is the same as uparm. +urldir = urldir // "tmp/" // s1 + +# A private graphcap is required to give an path for sgidispatch. +set graphcap = home$graphcap + +# Load packages. +dataio +proto +noao +onedspec +spectime +gsmt + +# Parse the CGI string and set parameters. +cgiparse + +# Create the output. + +# Start HTML. +printf ("Content-Type: text/html\n\n") +printf ("Test\n") +printf ("\n") +if (cl.line == "...") + printf ("

SPECTIME

\n", cl.line) +else + printf ("

%s

\n", cl.line) +printf ("
\n")
+
+# Execute task(s).
+#show QUERY_STRING
+
+setup interactive=no mode=h
+printf ("
\n") +printf ("Back to form") +printf ("
\n")
+
+sptime output="counts,snr" graphics="g-gif" interactive=no mode=h
+
+printf ("
\n") +printf ("Back to form\n") + +printf ("
\n")
+
+# Add any gifs created.  We have to wait for them to be created.
+
+gflush
+
+i = 0; j = 1
+while (i != j) {
+    sleep 2
+    j = i
+    files *.gif | count STDIN | scan (i)
+}
+
+
+if (i > 0) {
+    printf ("
Note: DN and S/N are per-pixel
\n")
+	
+    files *.gif > gifs
+    list = "gifs"
+    while (fscan (list, s1) != EOF) {
+	if (access (s1))
+		printf ("\n", urldir, s1)
+    }
+    list = ""
+    ## delete ("uparm$gifs", verify-)
+}
+
+printf ("
\n") + +# Finish HTML. + +printf ("Back to form") + +printf ("\n") + +# Clean up. +## delete ("*[^g][^i][^f]", verify-) + +logout +.fi +.ih +SEE ALSO +.endhelp diff --git a/noao/obsutil/src/doc/findgain.hlp b/noao/obsutil/src/doc/findgain.hlp new file mode 100644 index 00000000..91bf7eaf --- /dev/null +++ b/noao/obsutil/src/doc/findgain.hlp @@ -0,0 +1,168 @@ +.help findgain Nov01 noao.obsutil +.ih +NAME +findgain -- calculate the gain and readout noise of a CCD +.ih +SYNOPSIS +FINDGAIN uses Janesick's method for determining the gain and read noise +in a CCD from a pair of dome flat exposures and a pair of zero frame +exposures (zero length dark exposures). +.ih +USAGE +findgain flat1 flat2 zero1 zero2 +.ih +PARAMETERS +.ls flat1, flat2 +First and second dome flats. +.le +.ls zero1, zero2 +First and second zero frames (zero length dark exposures). +.le +.ls section = "" +The selected image section for the statistics. This should be chosen +to exclude bad columns or rows, cosmic rays and other blemishes, and +the overscan region. The flat field iillumination should be constant +over this section. +.le +.ls center = "mean" +The statistical measure of central tendency that is used to estimate +the data level of each image. This can have the values: \fBmean\fR, +\fBmidpt\fR, or \fBmode\fR. These are calculated using the same +algorithm as the IMSTATISTICS task. +.le +.ls nclip = 3 +Number of sigma clipping iterations. If the value is zero then no clipping +is performed. +.le +.ls lsigma = 4, usigma = 4 +Lower and upper sigma clipping factors used with the mean value and +standard deviation to eliminate cosmic rays. +Since \fBfindgain\fR is sensitive to the statistics of the data the +clipping factors should be symmetric (the same both above and below the +mean) and should not bias the standard deviation. Thus the values should +not be made smaller than around 4 sigma otherwise the gain and readnoise +estimates will be affected. +.le +.ls binwidth = 0.1 +The bin width of the histogram (in sigma) that is used to estimate the +\fBmidpt\fR or \fBmode\fR of the data section in each image. +The default case of center=\fBmean\fR does not use this parameter. +.le +.ls verbose = yes +Verbose output? +.le +.ih +DESCRIPTION +FINDGAIN uses Janesick's method for determining the gain and read noise +in a CCD from a pair of dome flat exposures and a pair of zero frame +exposures (zero length dark exposures). +The task requires that the flats and zeros be unprocessed and uncoadded so +that the noise characteristics of the data are preserved. Note, however, +that the frames may be bias subtracted if the average of many zero frames +is used, and that the overscan region may be removed prior to using this +task. + +Bad pixels should be eliminated to avoid affecting the statistics. +This can be done with sigma clipping and/or an image section. +The sigma clipping should not significantly affect the assumed gaussian +distribution while eliminating outlyers due to cosmic rays and +unmasked bad pixels. This means that clipping factors should be +symmetric and should have values four or more sigma from the mean. +.ih +ALGORITHM +The formulae used by the task are: + +.nf + flatdif = flat1 - flat2 + + zerodif = zero1 - zero2 + + gain = ((mean(flat1) + mean(flat2)) - (mean(zero1) + mean(zero2))) / + ((sigma(flatdif))**2 - (sigma(zerodif))**2 ) + + readnoise = gain * sigma(zerodif) / sqrt(2) +.fi + +where the gain is given in electrons per ADU and the readnoise in +electrons. Pairs of each type of comparison frame are used to reduce +the effects of gain variations from pixel to pixel. The derivation +follows from the definition of the gain (N(e) = gain * N(ADU)) and from +simple error propagation. Also note that the measured variance +(sigma**2) is related to the exposure level and read-noise variance +(sigma(readout)**2) as follows: + +.nf + variance(e) = N(e) + variance(readout) +.fi + +Where N(e) is the number of electrons (above the zero level) in a +given duration exposure. + +In our implementation, the \fBmean\fR used in the formula for the gain +may actually be any of the \fBmean\fR, \fBmidpt\fR (an estimate of the +median), or \fBmode\fR as determined by the \fBcenter\fR parameter. +For the \fBmidpt\fR or \fBmode\fR choices only, the value of the +\fBbinwidth\fR parameter determines the bin width (in sigma) of the +histogram that is used in the calculation. \fBFindgain\fR uses the +\fBimstatistics\fR task to compute the statistics. +.ih +EXAMPLES +To calculate the gain and readnoise within a 100x100 section: + +.nf + ms> findgain flat1 flat2 zero1 zero2 section="[271:370,361:460]" +.fi + +To calculate the gain and readnoise using the mode to estimate the data +level for each image section: + +.nf + ms> findgain.section="[271:370,361:460]" + ms> findgain flat1 flat2 zero1 zero2 center=mode +.fi + +The effects of cosmic rays can be seen in the following example using +artificial noise created with the \fBartdata.mknoise\fR package. The +images have a gain of 5 and a readnoise of 10 with 100 cosmic rays added +over the 512x512 images. The zero level images have means of zero and the +flat field images have means of 1000. The first execution uses the default +clipping and the second turns off the clipping. + +.nf + cl> findgain flat1 flat2 zero1 zero2 + FINDGAIN: + center = mean, binwidth = 0.1 + nclip = 3, lclip = 4., uclip = 4. + + Flats = flat1 & flat2 + Zeros = zero1 & zero2 + Gain = 5.01 electrons per ADU + Read noise = 10.00 electrons + cl> findgain flat1 flat2 zero1 zero2 nclip=0 + FINDGAIN: + center = mean, binwidth = 0.1 + nclip = 0, lclip = 4., uclip = 4. + + Flats = flat1 & flat2 + Zeros = zero1 & zero2 + Gain = 2.86 electrons per ADU + Read noise = 189.5 electrons +.fi + +.ih +BUGS +The image headers are not checked to see if the frames have been +processed. + +There is no provision for finding the "best" values and their errors +from several flats and zeros. +.ih +REVISIONS +.ls FINDGAIN - V2.12 +New task derived from MSCFINDGAIN. This makes use of the new clipping +feature in IMSTATISTICS. +.le +.ih +SEE ALSO +imstatistics +.endhelp diff --git a/noao/obsutil/src/doc/kpnofocus.hlp b/noao/obsutil/src/doc/kpnofocus.hlp new file mode 100644 index 00000000..176a8fe7 --- /dev/null +++ b/noao/obsutil/src/doc/kpnofocus.hlp @@ -0,0 +1,214 @@ +.help kpnofocus Mar96 noao.obsutil +.ih +NAME +kpnofocus -- Determine the best focus from KPNO focus images +.ih +USAGE +kpnofocus images +.ih +PARAMETERS +.ls images +List of focus images. +.le +.ls frame = 1 +The image display is checked to see if the image is already in one of +the display frames. If it is not the \fBdisplay\fR task is called to +display the image in the frame specified by the \fBframe\fR parameter. All +other display parameters are taken from the current settings of the task. +This option requires that the image display be active. +.le + +.ls level = 0.5 +The parameter used to quantify an object image size is the radius from the +image center enclosing the fraction of the total flux given by this +parameter. If the value is greater than 1 it is treated as a percentage. +.le +.ls size = "FWHM" (Radius|FWHM|GFWHM|MFWHM) +There are four ways the PSF size may be shown in graphs and given in +the output. These are: + +.nf + Radius - the radius enclosing the specified fraction of the flux + FWHM - a direct FWHM from the measured radial profile + GFWHM - the FWHM of the best fit Gaussian profile + MFWHM - the FWHM of the best fit Moffat profile +.fi + +The labels in the graphs and output will be the value of this parameter +to distinguish the different types of size measurements. +.le +.ls beta = INDEF +For the Moffat profile fit (size = MFWHM) the exponent parameter may +be fixed at a specified value or left free to be determined from the +fit. The exponent parameter is determined by the fit if \fIbeta\fR +task parameter is INDEF. +.le +.ls scale = 1. +Pixel scale in user units per pixel. Usually the value is 1 to measure +sizes in pixels or the image pixel scale in arc seconds per pixel. +.le +.ls radius = 5., iterations = 2 +Measurement radius in pixels and number of iterations on the radius. The +enclosed flux profile is measured out to this radius. This radius may be +adjusted if the \fIiteration\fR parameter is greater than 1. In that case +after each iteration a new radius is computed from the previous FWHM +estimate to be the radius the equivalent gaussian enclosing 99.5% of the +light. The purpose of this is so that if the initial PSF size of the image +need not be known. However, the radius should then be larger than true +image size since the iterations best converge to smaller values. +.le +.ls sbuffer = 5., swidth = 5. +Sky buffer and sky width in pixels. The buffer is added to the specified +measurement \fIradius\fR to define the inner radius for a circular sky +aperture. The sky width is the width of the circular sky aperture. +.le +.ls saturation=INDEF, ignore_sat=no +Data values (prior to sky subtraction) to be considered saturated within +measurement radius. A value of INDEF treats all pixels as unsaturated. If +a measurement has saturated pixels there are two actions. If +\fIignore_sat\fR=no then a warning is given but the measurement is saved +for use. The object will also be indicated as saturated in the output +log. If \fIignore_sat\fR=yes then a warning is given and the object is +discarded as if it was not measured. In a focus sequence only the +saturated objects are discarded and not the whole sequence. +.le +.ls logfile = "logfile" +File in which to record the final results. If no log file is desired a +null string may be specified. +.le +.ih +CURSOR COMMANDS +When selecting objects with the image cursor the following commands are +available. + +.nf +? Page cursor command summary +g Measure object and graph the results. +m Measure object. +q Quit object marking and go to next image. + At the end of all images go to analysis of all measurements. + +:show Show current results. +.fi + +When in the interactive graphics the following cursor commands are available. +All plots may not be available depending on the number of focus values and +the number of stars. + +.nf +? Page cursor command summary +a Spatial plot at a single focus +b Spatial plot of best focus values +d Delete star nearest to cursor +e Enclosed flux for stars at one focus and one star at all focus +f Size and ellipticity vs focus for all data +i Information about point nearest the cursor +m Size and ellipticity vs relative magnitude at one focus +n Normalize enclosed flux at x cursor position +o Offset enclosed flux to by adjusting background +p Radial profiles for stars at one focus and one star at all focus +q Quit +r Redraw +s Toggle magnitude symbols in spatial plots +t Size and ellipticity vs radius from field center at one focus +u Undelete all deleted points +x Delete nearest point, star, or focus (selected by query) +z Zoom to a single measurement + Step through different focus or stars in current plot type + + +:beta Beta parameter for Moffat fits +:level Level at which the size parameter is evaluated +:overplot Overplot the profiles from the narrowest profile? +:radius Change profile radius +:show Page all information for the current set of objects +:size Size type (Radius|FWHM) +:scale Pixel scale for size values +:xcenter X field center for radius from field center plots +:ycenter Y field center for radius from field center plots + +The profile radius may not exceed the initial value set by the task +parameter. +.fi +.ih +DESCRIPTION +This task is a script based on the task \fBstarfocus\fR. The details +of the algorithms and display modes are given in the help for that +task. The purpose of \fBkpnofocus\fR is to provide a simpler task +with fewer parameters because the format of the multiple exposure +images is given by header keywords. + +As a summary of the algorithm, the center of each star image is +found using centroids, a background is determined from the mode +of a sky annulus, and the enclosed flux profile is measured. The +PSF width is then the radius enclose a specified fraction of the +flux. Alternatively a direct FWHM from the radial intensity profile, +a FWHM for a Moffat profile fit to the enclosed flux profile, or +a FWHM for a Gaussian profile fit to the enclosed flux profile may be +used. + +If a saturation value is specified then all pixels within the specified +measurement radius are checked for saturation. If any saturated pixels are +found a warning is given and \fIignore_sat\fR parameter may be used ot +ignore the measurement. If not ignored the object will still be indicated +as saturated in the output log. In a focus sequence only the saturated +objects are discarded and not the whole sequence. + +To use this task consists of specifying a focus image name. Multiple +images could be analyzed together but this is uncommon. The task +will then display the image, using the current parameters of the +\fBdisplay\fR task, if the image is not already in the display. +The user then marks the first exposure (the top one) by pointing +the image cursor and typing 'm'. This may be done for more than +one star if desired. After all stars to be used are marked type +'q' to go to the graphical analysis. + +A plot showing the variation of the PSF width and ellipticity with +focus is shown along with a magnitude weighted, parabolic +interpolated estimate for the best focus. One may delete bad points +with the cursor 'd' key. To exit and record the results to +a logfile use the 'q' key. There are many graphical display +options for more sophisticated analysis such as variations with +position. The best thing to do is to try the various keystroke +commands given in the CURSOR section. For details about +the various plots see the \fBstarfocus\fR help. + +The other task parameters allow setting the enclosed flux level, +the object and sky apertures, and the type and scale of the +reported PSF size. The log filename may also be specified. +.ih +EXAMPLES +1. A multiple exposure frame is taken with 7 exposures of a bright +star, each exposure shifted by 30 pixels using the version of the +ICE software which records the focus information in the keywords +FOCSTART, FOCSTEP, FOCNEXPO, and FOCSHIFT. + +.nf +cl> kpnofocus focus1 + + + + + +NOAO/IRAF IRAFV2.10.3 valdes@puppis Fri 15:48:01 12-Nov-93 + + Image Column Line Mag Focus FWHM Ellip PA SAT + 36inch1 536.63 804.03 0.07 4660. 13.878 0.06 -11 + 535.94 753.28 -0.12 4680. 8.569 0.09 89 + 535.38 703.96 -0.08 4700. 5.164 0.11 -88 + 537.12 655.36 -0.02 4720. 3.050 0.08 -77 + 534.20 604.59 0.00 4740. 4.336 0.11 74 + 534.41 554.99 -0.00 4760. 9.769 0.09 -35 + 534.83 456.08 0.16 4780. 12.569 0.13 -10 + + Best focus of 4722.44 with FWHM (at 50% level) of 3.02 +.fi + +The estimated best focus is between the 4th and 5th focus setting +at a value of 4722.4 and the best focus FWHM is 3.02 pixels. +.ih +SEE ALSO +.nf +imexamine, implot, pprofile, pradprof, psfmeasure, radlist, +radplt, radprof, ranges, specfocus, splot, starfocus +.endhelp diff --git a/noao/obsutil/src/doc/pairmass.hlp b/noao/obsutil/src/doc/pairmass.hlp new file mode 100644 index 00000000..d271b42b --- /dev/null +++ b/noao/obsutil/src/doc/pairmass.hlp @@ -0,0 +1,132 @@ +.help pairmass Nov01 noao.obsutil +.ih +NAME +pairmass -- plot the airmass for a given object +.ih +USAGE +pairmass +.ih +PARAMETERS +.ls ra +The right ascension of the object in hours. +.le +.ls dec +The declination of the object in degrees. +.le +.ls epoch=INDEF +The epoch of the coordinates in years. +.le +.ls year +The year of the observation. +.le +.ls month +The month of the observation (a number from 1 to 12). +.le +.ls day +The day of the month of the observation. +.le +.ls observatory = "observatory" +The observatory identifier in the observatory database. See the +help for \fBobservatory\fR task for more information. +.le +.ls timesys = "Standard" (Universal|Standard|Siderial) +Time system for the plot or output list. The choices are +"Universal" for universal time, "Standard" for standard time (where +the time zone is determined from the observatory database), and "Siderial" +for the siderial time. +.le + +.ls resolution=4 +The number of UT points per hour for which to calculate the airmass. +.le +.ls listout=no +List, rather than plot, the airmass versus time? Only airmasses +below that given by the \fIwy2\fR parameters are listed. +.le +.ih +PLOT PARAMETERS +.ls wx1=-7., wx2=7., wy1=0., wy2=5. +The range of window (user) coordinates to be included in the plot. +If the range of values in x or y = 0, the plot is automatically +scaled from the minimum to maximum data values along that axis. +The times are available from -24 hours to 48 hours so one can use +negative numbers to plot hours from midnight or in actual hours. +.le +.ls pointmode = no +Plot individual points instead of a continuous line? +.le +.ls marker="box" +If \fBpointmode\fR = yes, the marker drawn at each point is set with this +parameter. The acceptable choices are "point", "box", "plus", "cross", +"circle", "hebar", "vebar", "hline", "vline", and "diamond". +.le +.ls szmarker = 0.005 +The size of the marker drawn when \fBpointmode\fR = yes. A value of 0 +(zero) indicates that the task should read the size from the input list. +.le +.ls logx = no, logy = no +Draw the x or y axis in log units, versus linear? +.le +.ls xlabel="default" +Label for the X-axis. The value "default" uses the specified time system. +.le +.ls ylabel="Airmass" +Labels for the Y-axis. +.le +.ls title="default" +Title for plot. If not changed from "default", a title string consisting +of the date, observatory, and object position is used. +.le +.ls vx1=0., vx2=0., vy1=0., vy2=0. +NDC coordinates (0-1) of the plotting device viewport. If not set +by the user, a suitable viewport which allows sufficient room for all +labels is used. +.le +.ls majrx=5, minrx=5, majry=5, minry=5 +The number of major and minor divisions along the x or y axis. +.le +.ls round = no +Round axes up to nice values? +.le +.ls fill = yes +Fill the plotting viewport regardless of the device aspect ratio? +.le +.bp +.ls append = no +Append to an existing plot? +.le +.ls device="stdgraph" +Output device. +.le +.ih +DESCRIPTION +The airmass is plotted over a specified set of hours for a given +observatory. The observatory is specified by an identifier as given +in the observatory database. See the help for "observatory" for more +information about the database and identifiers. + +The results can be shown in universal, standard, or siderial time. +The standard time simply adds the time zone from the observatory +database tothe universal time and so there is no explicit facility +for daylight savings time. The times are computed in the range +-24 hours to +48 hours. By setting the \fIwx1\fR and \fIwx2\fR +parameters one can plot either in hours relative to 0 in the specified +time system or as positive hours. This simple task does not support +axis labeling which wraps around. + +The list output prints date, observatory, object coordinates, and +the time system. This is followed by the time sorted between 0 and 24 +and the airmasses. The list only includes airmasses below the +value specified by \fIwy2\fR. +.ih +EXAMPLES +To plot the airmass for M82 from Kitt Peak for Groundhog's Day in 1992: + +.nf + pairmass ra=9:51:42 dec=69:56 epoch=1950 year=1992 month=2 day=2 +.fi + +.ih +SEE ALSO +observatory, airmass, setairmass, graph +.endhelp diff --git a/noao/obsutil/src/doc/psfmeasure.hlp b/noao/obsutil/src/doc/psfmeasure.hlp new file mode 100644 index 00000000..479268b1 --- /dev/null +++ b/noao/obsutil/src/doc/psfmeasure.hlp @@ -0,0 +1,633 @@ +.help psfmeasure Nov01 noao.obsutil +.ih +NAME +psfmeasure -- Measure PSF widths in stellar images +.ih +USAGE +psfmeasure images +.ih +PARAMETERS +.ls images +List of images. +.le +.ls coords = "mark1" (center|mark1|markall) +Method by which the coordinates of objects to be measured are specified. +If "center" then a single object at the center of each image is measured. +If "mark1" then the \fIimagecur\fR parameter, typically the interactive +image display cursor, defines the coordinates of one or more objects in the +first image ending with a 'q' key value and then the same coordinates are +automatically used in subsequent images. If "markall" then the +\fIimagecur\fR parameter defines the coordinates for objects in each image +ending with a 'q' key value. +.le +.ls wcs = "logical" (logical|physical|world) +Coordinate system for input coordinates. When using image cursor input +this will always be "logical". When using cursor input from a file this +could be "physical" or "world". +.le +.ls display = yes, frame = 1 +Display the image or images as needed? If yes the image display is checked +to see if the image is already in one of the display frames. If it is not +the \fBdisplay\fR task is called to display the image in the frame +specified by the \fBframe\fR parameter. All other display parameters are +taken from the current settings of the task. This option requires that the +image display be active. A value of no is typically used when an input +cursor file is used instead of the image display cursor. An image display +need not be active in that case. +.le + +.ls level = 0.5 +The parameter used to quantify an object image size is the radius from the +image center enclosing the fraction of the total flux given by this +parameter. If the value is greater than 1 it is treated as a percentage. +.le +.ls size = "FWHM" (Radius|FWHM|GFWHM|MFWHM) +There are four ways the PSF size may be shown in graphs and given in +the output. These are: + +.nf + Radius - the radius enclosing the specified fraction of the flux + FWHM - a direct FWHM from the measured radial profile + GFWHM - the FWHM of the best fit Gaussian profile + MFWHM - the FWHM of the best fit Moffat profile +.fi + +The labels in the graphs and output will be the value of this parameter +to distinguish the different types of size measurements. +.le +.ls beta = INDEF +For the Moffat profile fit (size = MFWHM) the exponent parameter may +be fixed at a specified value or left free to be determined from the +fit. The exponent parameter is determined by the fit if \fIbeta\fR +task parameter is INDEF. +.le +.ls scale = 1. +Pixel scale in user units per pixel. Usually the value is 1 to measure +sizes in pixels or the image pixel scale in arc seconds per pixel. +.le +.ls radius = 5., iterations = 3 +Measurement radius in pixels and number of iterations on the radius. The +enclosed flux profile is measured out to this radius. This radius may be +adjusted if the \fIiteration\fR parameter is greater than 1. In that case +after each iteration a new radius is computed from the previous direct FWHM +estimate. The new radius is three times direct FWHM (six times the +half-maximum radius). The purpose of this is so that if the initial PSF +size of the image need not be known. However, the radius should then be +larger than true image size since the iterations best converge to smaller +values. +.le +.ls sbuffer = 5, swidth = 5. +Sky buffer and sky width in pixels. The buffer is added to the specified +measurement \fIradius\fR to define the inner radius for a circular sky +aperture. The sky width is the width of the circular sky aperture. +.le +.ls saturation=INDEF, ignore_sat=no +Data values (prior to sky subtraction) to be considered saturated within +measurement radius. A value of INDEF treats all pixels as unsaturated. If +a measurement has saturated pixels there are two actions. If +\fIignore_sat\fR=no then a warning is given but the measurement is saved +for use. The object will also be indicated as saturated in the output +log. If \fIignore_sat\fR=yes then a warning is given and the object is +discarded as if it was not measured. +.le +.ls xcenter = INDEF, ycenter = INDEF +The optical field center of the image given in image pixel coordinates. +These values need not lie in the image. If INDEF the center of the image +is used. These values are used to make plots of size verse distance from +the field center for studies of radial variations. +.le +.ls logfile = "logfile" +File in which to record the final results. If no log file is desired a +null string may be specified. +.le + +.ls imagecur = "" +Image cursor input for the "mark1" and "markall" options. If null then the +image dispaly cursor is used interactively. If a file name is specified +then the coordinates come from this file. The format of the file are lines +of x, y, id, and key. Values of x an y alone may be used to select objects +and the single character 'q' (or the end of the file) may be used to end +the list. +.le +.ls graphcur = "" +Graphics cursor input. If null then the standard graphics cursor +is used otherwise a standard cursor format file may be specified. +.le +.ih +CURSOR COMMANDS +When selecting objects with the image cursor the following commands are +available. + +.nf +? Page cursor command summary +g Measure object and graph the results. +m Measure object. +q Quit object marking and go to next image. + At the end of all images go to analysis of all measurements. + +:show Show current results. +.fi + +When in the interactive graphics the following cursor commands are available. +All plots may not be available depending on the number of stars. + +.nf +? Page cursor command summary +a Spatial plot +d Delete star nearest to cursor +e Enclosed flux for all stars +i Information about star nearest the cursor +m Size and ellipticity vs relative magnitude +n Normalize enclosed flux at x cursor position +o Offset enclosed flux by adjusting background +p Radial profiles for all stars +q Quit +r Redraw +s Toggle magnitude symbols in spatial plot +t Size and ellipticity vs radius from field center +u Undelete all deleted points +x Delete nearest point or star (selected by query) +z Zoom to a single measurement + Step through different stars in some plots + +:beta Set the beta parameter for the Moffat profile fit +:level Level at which the size parameter is evaluated +:overplot Overplot the profiles from the narrowest profile? +:radius Change profile radius +:show Page all information for the current set of objects +:size Size type (Radius|FWHM) +:scale Pixel scale for size values +:xcenter X field center for radius from field center plots +:ycenter Y field center for radius from field center plots +.fi +.ih +DESCRIPTION +This task measures the point-spread function (PSF) width of stars or other +unresolved objects in digital images. The width is measured from the +enclosed flux verses radius profile. The details of this are described in +the ALGORITHMS section. Measurements of multiple stars in multiple images +may be made. When there are multiple stars, variations in the PSF with +position may be examined. The task has three stages; selecting objects and +measuring the PSF width and other parameters, an interactive graphical +analysis, and a final output of the results to the terminal and to a +logfile. + +If a saturation value is specified then all pixels within the specified +measurement radius are checked for saturation. If any saturated pixels are +found a warning is given and \fIignore_sat\fR parameter may be used ot +ignore the measurement. If not ignored the object will still be indicated +as saturated in the output log. In a focus sequence only the saturated +objects are discarded and not the whole sequence. + +The input images are specified by an image template list. The list may +consist of explicit image names, wildcard templates, and @ files. +Identifying the object or objects to be measured may be accomplished in +several ways. If a single object near the center of the image is to be +measured then the \fIcoords\fR parameter takes the value "center". When +the "center" option is used the \fIdisplay\fR and \fIimagecur\fR parameters +are ignored. + +If there are multiple objects or the desired object is not at the center of +the frame the object coordinates are entered with the \fIimagecur\fR +parameter. This type of coordinate input is selected by specifying either +"mark1" or "markall" for the \fIcoords\fR parameter. If the value is +"mark1" then the coordinates are entered for the first image and the same +values are automatically used for subsequent images. If "markall" is +specified then the objects in each image are marked. + +Normally the \fIimagecur\fR parameter would select the interactive image +display cursor though a standard cursor file could be used to make this +part noninteractive. When the image display cursor is used either the +image must be displayed previously by the user, or the task may be allowed +to load the image display using the \fBdisplay\fR task by setting the +parameter \fIdisplay\fR to yes and \fIframe\fR to a display frame. If yes +the image display must be active. The task will look at the image names as +stored in the image display and only load the display if needed. + +If one wants to enter a coordinate list rather than use the interactive +image cursor the list can consist of just the column and line coordinates +since the key will default to 'm'. To finish the list either the end +of file may be encountered or a single 'q' may be given since the +coordinates are irrelevant. For the "markall" option with multiple +images there would need to be a 'q' at the end of each object except +possibly the last. + +When objects are marked interactively with the image cursor there +are a four keys which may be used as shown in the CURSOR COMMAND section. +The important distinction is between 'm' to mark and measure an +object and 'g' to mark, measure, and graph the results. The former +accumulates the results until the end while the latter can give an +immediate result to be examined. Unless only one object is marked +the 'g' key also accumulates the results for later graphical analysis. +It is important to note that the measurements are done as each +object is marked so there can be a significant delay before the +next object may be marked. + +The quantities measured and the algorithms used are described in the +ALGORITHMS section. Once all the objects have been measured an +interactive (unless only one object is measured) graphical presentation +of the measurements is entered. + +When the task exits it prints the results to the terminal (STDOUT) and also +to the \fIlogfile\fR if one is specified. The results may also be +previewed during the execution of the task with the ":show" command. The +results begin with a banner and the overall estimate of the PSF size. +Following this the individual measurements are given. The columns give the +image name, the column and line position, the relative magnitude, the PSF +size as either the enclosed flux radius or the various FWHM, the +ellipticity, and the position angle. +.ih +ALGORITHMS +The PSF of an object is characterized using a radially symmetric +enclosed flux profile. First the center of the object is determined from +an initial rough coordinate. The center is computed from marginal profiles +which are sums of lines or columns centered at the initial coordinate and +with a width given by the sum of the \fIradius\fR, \fIsbuffer\fR, and +\fIswidth\fR parameters. The mean of the marginal profile is determined +and then the centroid of the profile above this is computed. The centroids +from the two marginal profiles define a new object center. These steps of +forming the marginal profiles centered at the estimated object position and +then computing the centroids are repeated until the centroids converge or +three iterations have been completed. + +Next a background is determined from the mode of the pixel values in the +sky annulus defined by the object center and \fIradius\fR, \fIsbuffer\fR, +and \fIswidth\fR parameters. The pixel values in the annulus are sorted +and the mode is estimated as the point of minimum slope in this sorted +array using a width of 5% of the number of points. If there are multiple +regions with the same minimum slope the lowest pixel value is used. + +The background subtracted enclosed flux profile is determined next. +To obtain subpixel precision and to give accurate estimates for small +widths relative to the pixel sampling, several things are done. +First interpolation between pixels is done using a cubic spline surface. +The radii measured are in subpixel steps. To accommodate small and +large PSF widths (and \fIradius\fR parameters) the steps are nonuniform +with very fine steps at small radii (steps of 0.05 pixels in the +central pixel) and coarser steps at larger radii (beyond 9 pixels +the steps are one pixel) out to the specified \fIradius\fR. Similarly each +pixel is subsampled finely near the center and more coarsely at larger +distances from the object center. Each subpixel value, as obtained by +interpolation, is background subtracted and added into the enclosed flux +profile. Even with subpixel sampling there is still a point where a +subpixel straddles a particular radius. At those points the fraction of +the subpixel dimension in radius falling within the radius being measured +is used as the fraction of the pixel value accumulated. + +Because of errors in the background determination due to noise and +contaminating objects it is sometimes the case that the enclosed flux +is not completely monotonic with radius. The enclosed flux +normalization, and the magnitude used in plots and reported in +results, is the maximum of the enclosed flux profile even if it +occurs at a radius less than the maximum radius. It is possible +to change the normalization and subtract or add a background correction +interactively. + +Because a very narrow PSF will produce significant errors in the cubic +spline interpolation due to the steepness and rapid variation in the pixel +values near the peak, the Gaussian profile with FWHM that encloses the same +80% of the flux is computed as: + + FWHM(80%) = 2 * r(80%) * sqrt (ln(2) / (ln (1/.2))) + +If this is less than five pixels the Gaussian model is subtracted from the +data. The Gaussian normalization is chosed to perfectly subtract the +central pixel. The resulting subtraction will not be perfect but the +residual data will have much lower amplitudes and variations. A spline +interpolation is fit to this residual data and the enclosed flux profile is +recomputed in exactly the same manner as previously except the subpixel +intensity is evaluated as the sum of the analytic Gaussian and the +interpolation to the residual data. + +The Gaussian normalization is chosed to perfectly subtract the central +pixel. The resulting subtraction will not be perfect but the residual data +will have much lower amplitudes and variations. A spline interpolation is +fit to this residual data and the enclosed flux profile is recomputed in +exactly the same manner as previously except the subpixel intensity is +evaluated as the sum of the analytic Gaussian and the interpolation to the +residual data. This technique yields accurate FWHM for simulated Gaussian +PSFs down to at least a FWHM of 1 pixel. + +In addition to the enclosed flux profile, an estimate of the radially +symmetric intensity profile is computed from the enclosed flux profile. +This is based on the equation + +.nf + F(R) = integral from 0 to R { P(r) r dr } +.fi + +where F(R) is the enclosed flux at radius R and P(r) is the intensity per +unit area profile. Thus the derivative of F(R) divided by R gives an +estimate of P(R). + +Cubic spline interpolation functions are fit to the normalized enclosed +flux profile and the intensity profile. These are used to find the radius +enclosing any specified fraction of the flux and to find the direct FWHM of +the intensity profile. These are output when \fIsize\fR is "Radius" or +"FWHM" respectively. + +In addition to enclosed flux radius and direct FWHM size measurements +there are also two size measurements based on fitting analytic profiles. +A Gaussian profile and a Moffat profile are fit to the final enclosed flux +profile to the points with enclosed flux less than 80%. The limit is +included to minimize the effects of poor background values and to make the +profile fit be representative of the core of the PSF profile. These profiles +are fit whether or not the selected \fIsize\fR requires it. This is done +for simplicity and to allow quickly changing the size estimate with the +":size" command. + +The intensity profile functions (with unit peak) are: + +.nf + I(r) = exp (-0.5 * (r/sigma)**2) Gaussian + I(r) = (1 + (r/alpha)**2)) ** (-beta) Moffat +.fi + +with parameters sigma, alpha, and beta. The normalized enclosed flux +profiles, which is what is actually fit, are then: + +.nf + F(r) = 1 - exp (-0.5 * (r/sigma)**2) Gaussian + F(r) = 1 - (1 + (r/alpha)**2)) ** (1-beta) Moffat +.fi + +The fits determine the parameters sigma or alpha and beta (if a +beta value is not specified by the users). The reported FWHM values +are given by: + +.nf + GFWHM = 2 * sigma * sqrt (2 * ln (2)) Gaussian + MFWHM = 2 * alpha * sqrt (2 ** (1/beta) - 1) Moffat +.fi + +were the units are adjusted by the pixel scale factor. + +In addition to the four size measurements there are several additional +quantities which are determined. +Other quantities which are computed are the relative magnitude, +ellipticity, and position angle. The magnitude of an individual +measurement is obtained from the maximum flux attained in the enclosed +flux profile computation. Though the normalization and background may be +adjusted interactively later, the magnitude is not changed from the +initial determination. The relative magnitude of an object is then +computed as + +.nf + rel. mag. = -2.5 * log (object flux / maximum star flux) +.fi + +The maximum star magnitude over all stars is used as the zero point for the +relative magnitudes (hence it is possible for an individual object relative +magnitude to be less than zero). + +The ellipticity and positional angle of an object are derived from the +second central intensity weighted moments. The moments are: + +.nf + Mxx = sum { (I - B) * x * x } / sum { I - B } + Myy = sum { (I - B) * y * y } / sum { I - B } + Mxy = sum { (I - B) * x * y } / sum { I - B } +.fi + +where x and y are the distances from the object center, I is +the pixel intensity and B is the background intensity. The sum is +over the same subpixels used in the enclosed flux evaluation with +intensities above an isophote which is slightly above the background. +The ellipticity and position angles are derived from the moments +by the equations: + +.nf + M1 = (Mxx - Myy) / (Mxx + Myy) + M2 = 2 * Mxy / (Mxx + Myy) + ellip = (M1**2 + M2**2) ** 1/2 + pa = atan (M2 / M1) / 2 +.fi + +where ** is the exponentiation operator and atan is the arc tangent +operator. The ellipticity is essentially (a - b) / (a + b) where a +is a major axis scale length and b is a minor axis scale length. A +value of zero corresponds to a circular image. The position angle is +given in degrees counterclockwise from the x or column axis. + +The overall size when there are multiple stars is estimated by averaging +the individual sizes weighted by the flux of the star as described above. +Thus, when there are multiple stars, the brighter stars are given greater +weight in the average size. This average size is what is given in the +banner for the graphs and in the printed output. + +One of the quantities computed for the graphical analysis is the +FWHM of a Gaussian or Moffat profile that encloses the same flux +as the measured object as a function of the level. The equation are: + +.nf + FWHM = 2 * r(level) * sqrt (ln(2.) / ln (1/(1-level))) Gaussian + + FWHM = 2 * r(level) * sqrt (2**(1/beta)-1) / + sqrt ((1-level)**(1/(1-beta))-1) Moffat +.fi + +where r(level) is the radius that encloses "level" fraction of the total +flux. ln is the natural logarithm and sqrt is the square root. The beta +value is either the user specified value or the value determined by fitting +the enclosed flux profile. + +This function of level will be a constant if the object profile matches +the Gaussian or Moffat profile. Deviations from a constant show +the departures from the profile model. The Moffat profile used in making +the graphs except for the case where the \fIsize\fR is GFWHM. +.ih +INTERACTIVE GRAPHICS MODE +The graphics part of \fBpsfmeasure\fR consists of a number of different +plots selected by cursor keys. The available plots depend on the number of +stars. The various plots and the keys which select them are summarized +below. + +.nf +a Spatial plot +e Enclosed flux for all stars +m Size and ellipticity vs relative magnitude +p Radial profiles for all stars +t Size and ellipticity vs radius from field center +z Zoom to a single measurement +.fi + +If there is only one object the only available plot is +the 'z' or zoom plot. This has three graphs; a graph of the normalized +enclosed flux verses scaled radius, a graph of the intensity profile verses +scaled radius, and equivalent Moffat/Gaussian full width at half maximum verses +enclosed flux fraction. The latter two graphs are derived from the +normalized enclosed flux profile as described in the ALGORITHMS section. +In the graphs the measured points are shown with symbols, a smooth curve is +drawn through the symbols and dashed lines indicate the measurement level +and enclosed flux radius at that level. + +Overplotted on these graphs are the Moffat profile fit or the +Gaussian profile fit when \fIsize\fR is GFWHM. + +The zoom plot is always available from any other plot. The cursor position +when the 'z' key is typed selects a particular object measurement. +This plot is also the one presented with the 'g' key when marking objects for +single exposure images. In that case the graphs are drawn followed by +a return to image cursor mode. + +There are two types of symbol plots showing the measured PSF size (either +enclosed flux radius or FWHM) and ellipticity. These plot the measurements +verses relative magnitude ('m' key) and radius from the field center ('t' +key). These plots are only available when there are multiple stars +measured. The magnitude plot is the initial plot in this case. The field +center for the field radius graph may be changed interactively using the +":xcenter" and ":ycenter" commands. + +Grids of enclosed flux vs. radius, intensity profile vs. radius, and +FWHM vs. enclosed flux fraction are shown with the 'e', 'p', and +'g' keys respectively when there is more than one star. The grid shows +a profile for each star. The profiles in the grid have no axis labels or +ticks. Within each box are the coordinates of the object +and the PSF size. Below the grid is shown a graph of a single objects +including axis labels and ticks. + +In the grid there is one profile which is highlighted (by a second box or +by a color border). This is the profile shown in the lower graph. To +change the star in the lower graph on can type the space bar to advance to +the next star or use the cursor and the 'e', 'p', or 'g' key again. Other +keys will select another plot using the star nearest the cursor to select a +measurement. + +Any of the graphs with enclosed flux or intensity profiles vs radius may +have the profiles of the object with the smallest size overplotted. The +overplot has a dashed line, a different color on color graphics devices, +and no symbols marking the measurement points. The overplots may be +enabled or disabled with the ":overplot" command. Initially it is +disabled. + +The final plot, the 'a' key, gives a spatial representation. This requires +more than one star. This plot has a central graph of column and line +coordinates with symbols indicating the position of an object. The objects +are marked with a circle (when plotted at unit aspect ratio) whose size is +proportional to the measured PSF size. In addition an optional asterisk +symbol with size proportional to the relative brightness of the object may +be plotted. This symbol is toggled with the 's' key. On color displays +the circles may have two colors, one if object size is above the average +best size and the other if the size is below the best size. The purpose of +this is to look for a spatial pattern in the PSF sizes. + +Adjacent to the central graph are graphs with column or line as one +coordinate and radius or ellipticity as the other. The symbols +are the same as described previously. These plots can show spatial +gradients in the PSF size and shape across the image. + +In addition to the keys which select plots there are other keys which +do various things. These are summarized below. + +.nf +? Page cursor command summary +d Delete star nearest to cursor +i Information about point nearest the cursor +n Normalize enclosed flux at x cursor position +o Offset enclosed flux by adjusting background +q Quit +r Redraw +s Toggle magnitude symbols in spatial plots +u Undelete all deleted points +x Delete nearest point or star (selected by query) + Step through different stars in current plot type +.fi + +The help, redraw, and quit keys are provide the standard functions. +The 's' and space keys were described previously. The 'i' key +locates the nearest object to the cursor in whatever plot is shown and +prints one line of information about the object on the graphics device +status area. + +The 'd' key deletes the star nearest the cursor in whatever plot is +currently displayed. To delete all objects from an image, all +values for one star (the same as 'd'), or a +single measurement, the 'x' key is used. Typing this key produces a query +for which type of deletion and the user responds with 'i', 's', or +'p'. Deleted measurements do not appear in any subsequent +graphics, are excluded from all computations, and are not output in the +results. The 'u' key allows one to recover deleted measurements. This +undeletes all previously deleted data. + +Due to various sources of error the sky value may be wrong causing +the enclosed flux profile to not converge properly but instead +decreases beyond some point (overestimated sky) or linearly +increases with radius (underestimated sky). This affects the size +measurement by raising or lowering the normalization and altering +the shape of the enclosed flux profile. The 'n' and 'o' keys allow +fudging the enclosed flux profiles. These keys apply only in +the zoom plot or 'e' key plot of the enclosed flux profile. + +The 'n' key normalizes the enclosed flux profile at the point +set by the x position of the cursor. The 'o' key increases or +decreases the background estimate to bring curve up or down to +the point specified by the cursor. The effect of this is to +add or subtract a quadratic function since the number of pixels +at a particular radius varies as the square of the radius. +To restore the original profile, type 'n' or 'o' at a radius +less than zero. + +The colon commands, shown below, allow checking or changing parameters +initially set by the task parameters, toggling the overplotting of the +smallest PSF profiles, and showing the current results. The overplotting +option and the contents of the results displayed by :show were described +previously. + +.nf +:beta Beta value for Moffat profile fits +:level Level at which the size parameter is evaluated +:overplot Overplot the profiles from the narrowest profile? +:radius Change profile radius +:show Page all information for the current set of objects +:size Size type (Radius|FWHM) +:scale Pixel scale for size values +:xcenter X field center for radius from field center plots +:ycenter Y field center for radius from field center plots +.fi + +The important values which one might want to change interactively are +the measurement level and the profile radius. The measurement level +directly affects the results reported. When it is changed the sizes +of all object PSFs are recomputed and the displayed plots and title +information are updated. The profile radius is the +maximum radius shown in plots and used to set the enclosed flux normalization. +It does not affect the object centering or sky region definition and +evaluation which are done when the image data is accessed. Because +the objects are not remeasured from the image data the radius may +not be made larger than the radius defined by the task parameter though +it may be decreased and then increased again. +.ih +EXAMPLES +1. An image of a star field is studied with default values. + +.nf +cl> psfmeasure field1 + + + + + + +NOAO/IRAF IRAFV2.10.3 valdes@puppis Tue 18:22:36 06-Jul-93 + Average full width at half maximum of 4.5722 + + Image Column Line Mag FWHM Ellip PA SAT + field1 68.96 37.87 0.75 5.636 0.03 15 + 488.41 116.78 1.61 5.376 0.03 -68 + 72.17 156.35 1.47 4.728 0.06 -14 + 33.72 211.86 2.74 4.840 0.05 -52 + 212.80 260.73 2.99 3.888 0.11 83 + 250.51 277.37 1.92 3.914 0.02 -14 + 411.81 292.83 1.93 5.032 0.04 34 + 131.85 301.12 2.67 4.028 0.06 4 + 168.37 413.70 2.20 4.408 0.05 75 + 256.02 255.99 0.00 3.940 0.00 -70 + +The estimated average FWHM is 4.5722. The variation in size is real +in this artificial image having a radial variation in PSF. +.ih +SEE ALSO +.nf +imexamine, implot, pprofile, pradprof, radlist, radplt, radprof, +specfocus, starfocus, splot +.endhelp diff --git a/noao/obsutil/src/doc/shutcor.hlp b/noao/obsutil/src/doc/shutcor.hlp new file mode 100644 index 00000000..6968bdff --- /dev/null +++ b/noao/obsutil/src/doc/shutcor.hlp @@ -0,0 +1,93 @@ +.help shutcor Nov01 noao.obsutil +.ih +NAME +shutcor -- shutter correction from images of varying exposure +.ih +SYNOPSIS +SHUTCOR calculate the shutter correction for a detector given a +sequence of overscan corrected images of varying durations. Typically +these would be flat field exposures. The shutter correction is the +intercept on a plot of exposure duration versus exposure level. +.ih +USAGE +shutcor images +.ih +PARAMETERS +.ls images +List of overscan corrected images. These would usually be flat +field exposures. +.le +.ls section = "" +The selected image section for the statistics. This should be chosen +to exclude bad columns or rows, cosmic rays, and other non-linear +features. +.le +.ls center = "mode" +The statistical measure of central tendency that is used to estimate +the data level of each image. This can have the values: \fBmean\fR, +\fBmidpt\fR, or \fBmode\fR. These are calculated using the same +algorithm as the IMSTATISTICS task. +.le +.ls nclip = 3 +Number of sigma clipping iterations. If the value is zero then no clipping +is performed. +.le +.ls lsigma = 4, usigma = 4 +Lower and upper sigma clipping factors used with the mean value and +standard deviation to eliminate cosmic rays. +Since \fBfindgain\fR is sensitive to the statistics of the data the +clipping factors should be symmetric (the same both above and below the +mean). +.le +.ls exposure = "exptime" +Keyword giving the exposure time. +.le +.ls verbose = yes +Verbose output? +.le +.ih +DESCRIPTION +SHUTCOR calculate the shutter correction for a detector given a +sequence of overscan corrected images of varying durations. Typically +these would be flat field exposures. The shutter correction is the +intercept on a plot of exposure duration versus exposure level. + +The images must contain the keyword OVERSCAN otherwise and error will +be given. + +Bad pixels should be eliminated to avoid affecting the statistics. +This can be done with sigma clipping and/or an image section. +The sigma clipping should not significantly affect the assumed gaussian +distribution while eliminating outlyers due to cosmic rays and +unmasked bad pixels. This means that clipping factors should be +symmetric. +.ih +EXAMPLES +A sequence of flat fields with varying exposure times are taken and +processed to subtract the overscan. + +.nf + cl> shutcor flat* + + Shutter correction = 0.538 +/- 0.043 seconds + + Information about the mode versus exptime fit: + + intercept slope (and errors) + 5.347105 9.933618 + 0.4288701 0.01519613 + + chi sqr: 0.2681 ftest: 419428. correlation: 1. + nr pts: 4. std dev res: 0.422769 + + x(data) y(calc) y(data) sigy(data) + 3. 35.148 34.6725 0. + 12. 124.551 125.015 0. + 27. 273.555 273.778 0. + 48. 482.161 481.949 0. +.fi +.le +.ih +SEE ALSO +imstatistics +.endhelp diff --git a/noao/obsutil/src/doc/specfocus.hlp b/noao/obsutil/src/doc/specfocus.hlp new file mode 100644 index 00000000..137eca23 --- /dev/null +++ b/noao/obsutil/src/doc/specfocus.hlp @@ -0,0 +1,375 @@ +.help specfocus Nov01 noao.obsutil +.ih +NAME +specfocus -- Determine spectral focus and alignment variations +.ih +USAGE +specfocus images +.ih +PARAMETERS +.ls images +List of 1D or 2D focus images. Typically the input is a list of raw +2D CCD images of arc slit spectra. The 1D image input is provided to +allow use of extraction techniques beyond those provided by this task. +.le +.ls focus = "" +List of focus identification values to be associated with each input image +or an image header keyword containing the values. The list may be an +explicit list of values, a range specification, an @ file containing the +values, or an image header keyword. If none of these is given the +identification values are simple index values in the order of the input +images. A range specification has the forms A, AxC, A-BxC where A is a +starting value, B is an ending value, and C is an increment. +.le +.ls corwidth = 20. +Correlation width in pixels. +.le +.ls level = 0.5 +Percent or fraction of the correlation peak at which to measure focus +widths. The default is 50% or full width at half maximum. +.le +.ls shifts = yes +Compute dispersion shifts across the dispersion when there are multiple +samples? If yes and there are multiple samples across the dispersion +(\fIndisp\fR > 1), pixel shifts relative to the central sample are +determine by crosscorrelation. +.le + +.ls dispaxis = 2 +Dispersion axis for 2D images. The image header keyword DISPAXIS has +precedence over this value. +.le +.ls nspectra = 1, ndisp = 1 +The number of spectral samples across the dispersion +and the number of subpieces along the dispersion to divide the spectra +into. If \fInspectra\fR is greater than one then information about +variations across the dispersion will be determined and if \fIndisp\fR is +greater than 1 information about variations along the dispersion will be +determined. \fINspectra\fR applies only to 2D images. For 1D spectra in +multispec format each line is used as a separate sample. +.le +.ls slit1 = INDEF, slit2 = INDEF +The lower and upper edges of the slit (or data region) in pixel +coordinates (lines or columns) across the dispersion axis. A value +of INDEF specifies the image edges. +.le + +.ls logfile = "logfile" +File in which to record the results. If no file is specified no log +output is produced. +.le +.ih +CURSOR COMMANDS +All keys select an image and a sample (one of the \fIndisp\fR samples along +the dispersion and one of the \fInspectra\fR samples across the dispersion) +which is then generally highlighted. + +.nf + ? Help summary + b Best focus at each sample summary graphs + d Delete image, sample, or point + p Profiles at one sample for all images and all samples for one image + q Quit + r Redraw + s Spectra at one sample for all images and all samples for one image + u Undelete spectrum, sample, or point + w Profile widths verses focus and distribution of widths + z Zoom on a single sample showing correlation profile and spectrum + Status line output for selected image and sample +.fi + +.ih +DESCRIPTION +This task estimates the dispersion width of spectral lines in sequences of +arc spectra taken at different focus settings (or with some other parameter +varied). The widths can be measured at different spatial and dispersion +positions, called "samples", on the detector. The width estimates are +recorded and displayed graphically to investigate dependencies and +determine appropriate settings for the spectrograph setup. The task may +also measure dispersion shifts when multiple spectral samples are +specified. This task does not measure the focus point-spread-function +width across the dispersion. + +The input images are specified with an image template list. The list may +consist of explicit image names, wildcard templates, and @ files. A +"focus" value is associated with each image. This may be any numeric +quantity (integer or floating point). The focus values may be specified in +several ways. If no value is given then index numbers are assigned to +the images in the order in which they appear in the image list. A range +list may be specified as described in the help topic \fBranges\fR. This +consists of individual values, ranges of values, a starting value and a +step, and a range with a step. The elements of the list are separated by +commas, ranges are separated by hyphens, and a step is indicated by the +character 'x'. Long range lists, such as a list of individual focus +values, may be placed in a file and specified with the @ +convention. Finally, a parameter in the image header may be used for the +focus values by simply specifying the parameter name. + +Two dimensional long slit images are summed into one or more one +dimensional spectra across the dispersion. The dispersion axis is defined +either by the image header parameter DISPAXIS or the \fIdispaxis\fR task +parameter with the image header parameter having precedence. The range of +lines or columns across the dispersion to be used is specified by the +parameters \fIslit1\fR and \fIslit2\fR. If specified as INDEF then the +image limits are used. This range is then divided into the number of +spectra given by the parameter \fInspectra\fR. Use of more than one +spectrum across the dispersion allows investigation of variations along the +slit. In addition, if the parameter \fIshifts\fR is set the spectrum +nearest the center is used as a reference against which shifts in the +dispersion positions of the features in the other spectra are determined by +crosscorrelation. + +The conversion of two dimensional spectra to one dimensional spectra may +also be performed separately using the tasks in the \fBapextract\fR +package. This would be done typically for multifiber or echelle format +spectra. If the two dimensional spectra have been extracted to one +dimensional spectra in this way the task ignores the dispersion axis and +number of spectra parameters. The data limits (\fIslit1\fR and +\fIslit2\fR) are still used to select a range of lines in "multispec" +format images. The \fIshifts\fR parameter also applies when there are +multiple spectra per image. However, it does not make sense in the case of +echelle spectra and so it should be set to no in that case. + +In addition to dividing the spatial axis into a number of spectra the +dispersion axis may also be divided into a set of subspectra. The number +of divisions is specified by the \fIndisp\fR parameter which applies to +both long slit and 1D extracted spectra. When the dispersion axis is +divided into more than one sample, the dependence of the dispersion widths +and shifts along the dispersion may be investigated. + +Each spectral sample has a low order continuum subtracted using a +noninteractive iterative rejection algorithm to exclude the spectral +lines. This technique is described further under the topic +\fIcontinuum\fR. The continuum subtracted spectrum is then tapered with a +cosine bell function and autocorrelated. The length of the taper and the +range of shifts for the correlation is set by the \fIcorwidth\fR +parameter. This parameter should be only slightly bigger than the expected +feature widths to prevent correlations between different spectral lines. +The correlation profile is offset to zero at the edges of the profile and +normalized to unity at the profile center. The profiles may be viewed as +described below. + +If there is more than one spatial sample the central spectrum is also +crosscorrelated against the other spectra at the same dispersion +sample. The crosscorrelation is computed in exactly the same way as +the autocorrelation. The crosscorrelation profiles are only used for +determining shifts between the two samples and are not used in the +width determinations. + +A cubic spline interpolator is fit to the profiles and this interpolation +function is used to determined the profile width and center. The width is +measured at a point given by the \fIlevel\fR parameter relative to the +profile peak. It may be specified as a fraction of the peak if it is less +than one or a percentage of the peak if it is greater than one. The +default value of 0.5 selects the full width at half maximum. The +autocorrelation width is divided by the square root of two to yield an +estimate of the width of the spectral features in the spectrum in units of +pixels. + +Having computed the width and shift for each input image at each sample, +the "best focus" values (focus, width, and shift) are estimated for each +sample. As discussed later, it is possible to exclude some samples +from this calculation by deleting them graphically. +First the images with the smallest measured width at each distinct +focus are selected since it is possible to input more than one image at the +same focus. The selected images are sorted by focus value and the image +with the smallest width is found. If that image has the lowest or highest +focus (which will always be the case if there are only one or two images) +then the best focus, width, and shift are those measured for that image. +If there are three or more focus values and the minimum width focus image +is not an endpoint then parabolic interpolation is used to find the minimum +width. The focus at this minimum width is the "best focus". +The dispersion shift is the parabolic interpolation of the shifts at +the best focus. The "average best focus" values are then the average of +the "best focus" values over all samples. + +After computing the correlation profiles, the profile widths and shifts, +and the best focus values, an interactive graphics mode is entered. This +is described in detail below. The graphics mode is exited with the 'q' +key. At this point the results are written to the standard output (usually +the terminal) and to a logfile if one is specified. The output begins with +a banner identifying the task, version of IRAF, the user, and the date and +time. The next line gives the best average focus and width. This banner +also appears in all plots. Then each image is listed with the focus value +and average width (over all samples). Finally the image with the smallest +average width is identified and tables showing the width and shifts (if +computed) at each sample position are printed. If there is only one sample +then the tables are not output. + +INTERACTIVE GRAPHICS MODE + +There are five types of plot formats which are selected with the 'b', 'p', +'s', 'w', and 'z' keys. The available formats and their content are +modified depending on the number of images and the number of samples. If +there is only one image or one sample per image some of the plot formats +are not available. If there are a large number of images or a large number +of samples the content of the plot formats may be abbreviated for +legibility. + +In all plots there is a concept of the current image and the current +sample. In general there is an indication, usually a box, of which image +and sample is the current one. The current image and sample are +changed by pointing at a particular point, box, circle, or symbol for that +image and sample and typing a key. + +The 'b' key produces summary graphs of the best focus values (as described +above) at each sample position. There must be more than one image and more +than one sample (either along or across the dispersion or both). This is +the initial plot shown when this condition is satisfied. The central graph, +which is always drawn, represents the best focus (smallest) width at each +sample by circles of size proportional to the width. The position of the +circle indicates the central line and column of the sample. If there are +multiple samples across the dispersion and the \fIshifts\fR parameter is +set then little vectors are also drawn from the center of the circle in the +direction of the shift and with length proportional to the shift. If there +are 5 or fewer samples in each dimension the values of the best focus and +the width and shift (if computed and nonzero) at that focus, are printed on +the graph next to the circles. If there are more samples this information +may be obtained by pointing at the sample and typing the space key. + +In addition to the spatial graph there may be graphs along the line or column +axes. These graphs again show the widths as circles but one axis is either +the line or column and the other axis is either the best focus value or the +shift. The focus graph marks the best average focus (over all samples) by +a dashed line and a solid line connects the mean focus at each column or +line. The focus graphs will only appear if there is more than one sample +along a particular image axis. The shift graphs will only appear if the +shifts are computed (\fIshifts\fR parameter is yes) and there is more than +one sample along a particular dimension. Lines are drawn at zero shift and +connecting the mean shift at each point along the spatial axis. Note that +there is always a point at zero shift which is the reference sample. + +The best focus graphs are the exception in showing a current image and +sample. When changing to one of the other plots based on a current image +and sample the circle from the central spatial graph nearest the cursor is +used (note that the other focus and shift graphs are ignored). The sample +is defined by it's spatial position and the image is the one with +focus closest to the best focus value of that sample. + +The 'w' key produces a graph showing the sample widths as a function of +focus value. There must be more than one image and more than one sample +for this type of graph. The top graph is a symbol plot of width verses +focus. The symbols are crosses except for the current image which is shown +with pluses. The current sample is highlighted with a box. Also shown is +a long dashed line connecting the widths for the current sample at each +focus value and short dashed lines showing the best average focus and +width. + +The lower portion of the 'w' key are graphs showing the +widths as circles with size proportional to the width and position +corresponding to the spatial position of the sample in the image. If there +are more than 5 samples in either dimension the graph is for the current +image. Otherwise there is a box for each image with the focus value +(provided there are not too many images) indicated. The circles are +arranged as they would be spatially in columns and rows. The samples +closest to the best focus are indicated by pluses. This allows seeing +where the best focus values cluster. The current image and sample are +indicated by highlighting boxes. + +The 'p' key produces graphs of the autocorrelation profiles. This also +requires more than one image and more than one sample. The top graph shows +the profiles of all images at a particular sample and the bottom graph shows +the profiles of all samples at a particular image. The bottom sample boxes +are arranged in columns and rows in the same way the samples are +distributed in the image. The current image and current sample are +highlighted by a box. + +The profiles are drawn with a solid line using the interpolator function +and the actual pixel lags are indicated with pluses. The profiles are +drawn shifted by the amount computed from the crosscorrelation. +Note that the shift is added to the autocorrelation profile +and the crosscorrelation profile is not what is plotted. The zero shift +position is indicated by a vertical line. If there are less than 25 boxes +the boxes are labeled by the width, shift (if nonzero), and focus. + +The 's' key plot is similar to the 'p' key plot but shows the spectra +rather than the profiles. The top graphs are the spectra of each image at +a particular sample and the bottom graphs are the spectra of each sample +for a particular image. The current image and sample are highlighted by a +box. + +The 'z' key graphs the autocorrelation profile and the spectrum +of a single sample. This graph provides scales which are not +provided with the 'p' and 's' graphs. If there is only one image +and one sample then this is the only plot available. + +It is possible to exclude some of the samples from the calculation +of the best focus and best average focus values. This is done by +deleting them using the 'd' key. When using the 'd' key you must +specify the sample to be deleted in one of the graphs. You are +then asked if only that sample (point) is to be deleted, if all +samples from that image are to be deleted, or if the same sample +from all images is to be deleted. The deleted data is no longer +shown explicitly but the space occupied by the data is still present +so that the data may be included again by typing the 'u' undelete +key. When the task is exited with the 'q' key the printed and +logged results will have the deleted data excluded. + +The remaining cursor keys do the following. The '?' key gives a +summary of the cursor keys. The 'r' key redraws the current plot. +The space key prints information about the current sample. This +is mostly used when there are too many images or samples to annotate +the graphs with the focus, width, and shift. Finally the 'q' +key quits the task. +.ih +EXAMPLES +1. A series of 2D focus images is obtained with focus values +starting at 400 in steps of -50. The slit is between columns 50 +and 130. There are 3 samples across the dispersion and 3 along +the dispersion. + +.nf + cl> lpar specfocus + images = "@imlist" List of images + (focus = "400x-50") Focus values + (corwidth = 20) Correlation width + (level = 0.5) Percent or fraction of peak + (shifts = yes) Compute shifts across the disp?\n + (dispaxis = 2) Dispersion axis (long slit only) + (nspectra = 3) Number of spec samples (ls only) + (ndisp = 3) Number of dispersion samples + (slit1 = 50) Lower slit edge + (slit2 = 130) Upper slit edge\n + (logfile = "logfile") Logfile + (mode = "ql") + cl> specfocus @imlist + + SPECFOCUS: NOAO/IRAF V2.10EXPORT valdes Thu 19:41:41 17-Sep-92 + Best avg focus at 206.6584 with avg width of 2.91 at 50% of peak + + -- Average Over All Samples + + Image Focus Width + jdv011.imh 100. 3.78 + jdv010.imh 150. 3.28 + jdv009.imh 200. 2.95 + jdv008.imh 250. 3.17 + jdv007.imh 300. 3.41 + jdv006.imh 350. 3.74 + jdv005.imh 400. 4.16 + + -- Image jdv009.imh at Focus 200. -- + + + Width at 50% of Peak: + + Columns + 50-76 77-103 104-130 + Lines +--------------------------------- + 2-267 | 2.93 2.58 2.74 + 268-533 | 3.17 2.76 2.89 + 534-799 | 3.77 2.23 3.50 + + Position Shifts Relative To Central Sample: + + Columns + 50-76 77-103 104-130 + Lines +--------------------------------- + 2-267 | 0.68 0.00 0.18 + 268-533 | 0.64 0.00 0.13 + 534-799 | 0.92 0.00 0.16 +.fi +.ih +SEE ALSO +imexamine, implot, ranges, splot +.endhelp diff --git a/noao/obsutil/src/doc/sptime.hlp b/noao/obsutil/src/doc/sptime.hlp new file mode 100644 index 00000000..a2c0f242 --- /dev/null +++ b/noao/obsutil/src/doc/sptime.hlp @@ -0,0 +1,1218 @@ +.help sptime Nov01 noao.obsutil +.ih +NAME +sptime -- spectroscopic exposure time calculator +.ih +USAGE +sptime +.ih +PARAMETERS +The parameters in this task have certain common features. +.ls (1) +All parameters, except \fIspectrograph\fR and \fIsearch\fR, may be +specified as spectrograph table parameters of the same name. Some +parameters may also be specified in other tables. The tables in which the +paramters may be specified are shown in brackets. Table values are used +only if a string parameter is "" or a numeric parameter is INDEF. +Therefore parameter set values override values in the tables. To override +a table specified in the spectrograph file by no file the special value +"none" is used. This task also uses default values, shown below in +parenthesis, for parameters that have no value specified either in the +parameter set or in a table. +.le +.ls (2) +Parameters that specify a table take the value of a file or a numeric +constant. A constant is like a table with the same values for all value +of the independent variable(s). +.le +.ls (3) +Tables which are specified as filenames are sought first in the current +working directory, then in one of the directories given by the +\fIsearch\fR parameter, and finally in the package library directory +sptimelib$. +.le + + +.ls time = INDEF (INDEF) [spectrograph] +Total exposure time in seconds. This time may be divided into shorter +individual exposure times as defined by the \fImaxexp\fR parameter. If +the value is INDEF then the exposure time needed to achieve the +signal-to-noise per pixel specified by the \fIsn\fR parameter is computed. +.le +.ls sn = 25. (25.) [spectrograph] +Desired signal-to-noise per pixel at the central wavelength if the +exposure \fItime\fR parameter is not specified. +.le + + +The following parameters define the source and sky/atmosphere background +spectra. +.ls spectrum = "blackbody" +Source spectrum. This may be a table or one of the following special words: +.ls blackbody +Blackbody spectrum with temperature given by the \fItemperature\fR +parameter. +.le +.ls flambda_power +Power law in f(lambda) with index given by the \fIindex\fR parameter; +f(lambda) proportional to lambda^(index). +.le +.ls fnu_power +Power law in f(nu) with index given by the \fIindex\fR parameter; +f(nu) proportional to nu^(index). +.le + +The table is a two column text file of wavelength in Angstroms and flux in +ergs/s/cm^2/A. +.le +.ls spectitle = "" [spectrum|spectrograph] +Spectrum title. +.le +.ls E = 0. (0.) [spectrum|spectrograph] +The E(B-V) color excess to apply a reddening to the source spectrum. The +reddening maintains the same table or reference flux at the reference +wavelength. A value of zero corresponds to no reddening. +.le +.ls R = 3.1 (3.1) [spectrum|spectrograph] +The R(V) = A(V)/E(B-V) for the extinction law. The extinction law is that +of Cardelli, Clayton, and Mathis, \fBApJ 345:245\fR, 1989. The default +R(V) is typical of the interstellar medium. +.le +.ls sky = "" ("none") [spectrograph] +Sky or background table. The table is a two or three column text file +consisting of wavelength in Angstroms, optional moon phase between 0 (new +moon) and 14 (full moon), and flux in ergs/s/cm^2/A/arcsec^2. +.le +.ls skytitle = "" [sky|spectrograph] +Sky title. +.le +.ls extinction = "" ("none") [spectrograph] +Extinction table. The table is a two column text file consisting of +wavelength in Angstroms and extinction in magnitudes per airmass. +.le +.ls exttitle = "" [spectrograph] +Extinction title. +.le + + +The following parameters are used with the source spectrum is specified +by the special functions. +.ls refwave = INDEF (INDEF) [spectrum|spectrograph] +Reference wavelength, in units given by the \fIunits\fR parameter, defining +the flux of the source. This is also used as the wavelength where +reddening does not change the spectrum flux. A value of INDEF uses the +observation central wavelength. +.le +.ls refflux = 10. (10.) [spectrograph] +Reference source flux or magnitude at the reference wavelength for the +model spectral distributions. The units are specified by the funits parameter. +.le +.ls funits = "AB" ("AB") [spectrograph] +Flux units for the reference flux. The values are "AB" for monochromatic +magnitude, "F_lambda" for ergs/s/cm^2/A, "F_nu" for ergs/s/cm^2/Hz, +and standard bandpasses of U, B, V, R, I, J, H, Ks, K, L, L' and M. +.le +.ls temperature = 6000. (6000.) [spectrograph] +Blackbody temperature for a blackbody source spectrum in degrees Kelvin. +.le +.ls index = 0. (0.) [spectrograph] +Power law index for the power law source spectrum. +.le + + +The following parameters are observational parameters describing either +the observing conditions or spectrograph setup. +.ls seeing = 1. (1.) [spectrograph] +The full width at half maximum (FWHM) of a point source in arc seconds. +.le +.ls airmass = 1. (1.) [spectrograph] +The airmass of the observation. This is only used if an extinction table +is specified. +.le +.ls phase = 0. (0.) [spectrograph] +The moon phase running from 0 for new moon to 14 for full moon. This is +used if the sky spectrum is given as a function of the moon phase. +.le +.ls thermal = 0. (0.) [telescope|spectrograph] +Temperature in degress Kelvin for the thermal background of the telescope +and spectrograph. If greater than zero a blackbody surface brightness +background is computed and multiplied by an emissivity specified by +the \fIemissivity\fR table. +.le +.ls wave = INDEF (INDEF) [spectrograph] +Central wavelength of observation in units given by the \fIunits\fR +parameter. If the value is INDEF it is determined from the efficiency peak +of the disperser. +.le +.ls order = INDEF (INDEF) [spectrograph] +Order for grating or grism dispersers. If the value is INDEF it is +determined from the order nearest the desired central wavelength. If both +the order and central wavelength are undefined the first order is used. +.le +.ls xorder = INDEF (INDEF) [spectrograph] +Order for grating or grism cross dispersers. If the value is INDEF it +is determined from the order nearest the desired central wavelength. If +both the order and central wavelength are undefined the first order is +used. +.le +.ls width = INDEF (-2.) [aperture|spectrograph] +The aperture width (dispersion direction) for rectangular apertures +such as slits. Values may be positive to specify in arc seconds or +negative to specify in projected pixels on the detector. +.le +.ls length = INDEF (-100.) [aperture|spectrograph] +The aperture length (cross dispersion direction) for rectangular +apertures such as slits. Values may be positive to specify in arc seconds +or negative to specify in projected pixels on the detector. +.le +.ls diameter = INDEF (-2.) [fiber|aperture|spectrograph] +The aperture diameter for circular apertures. Values +may be positive to specify in arc seconds or negative to specify in +projected pixels on the detector. If it is found in the fiber table, +positive values are treated as mm at the focal plane instead of arc seconds. +.le +.ls xbin = 1 (1) [detector|spectrograph] +Detector binning along the dispersion direction. +.le +.ls ybin = 1 (1) [detector|spectrograph] +Detector binning along the spatial direction. +.le + + +The following parameters a miscellaneous parameters for the task. +.ls search = "spectimedb$" +List of directories to search for the various table files. The current +direction is always searched first and the directory sptimelib$ is searched +last so it is not necessary to include these directories. The list may be +a comma delimited list of directories, an @file, or a template. +.le +.ls minexp = 0.01 (0.01) [spectrograph] +Minimumm time in seconds per individual exposure time. This only applies +when \fItime\fR is INDEF. Adjustment of the exposure time for saturation +will not allow the exposure time to fall below this value. +.le +.ls maxexp = 3600. (3600.) [spectrograph] +Maximum time in seconds per individual exposure. The minimum exposure time +has precedence over this value. If the total exposure time exceeds this +amount by more than 1% then the total exposure time will be divided up into +the fewest individual exposures with equal exposure time that are less than +this amount. Note that by making the minimum and maximum times the same a +fixed integration time can be defined. +.le +.ls units = "Angstroms" ("Angstroms") [spectrograph] +Dispersion units for input and output dispersion coordinates. The +units syntax is described in the UNITS section. The most common units +are "Angstroms", "nm", "micron", and "wn". Note that this does not +apply to the dispersion units in the tables which are always in Angstroms. +.le +.ls skysub = "" (default based on context) [spectrograph] +Type of sky and background subtraction. The values are "none" for no +background subtraction, "longslit" for subtraction using pixels in the +aperture, "multiap" for background determined from a number of other +apertures, and "shuffle" for shuffled observations. The multiap case is +typical for fiber spectrographs. For shuffle the duty cycle is 50% and the +exposure times are the sum of both sky and object. If no sky or thermal +background is specified then the default is "none". If a fiber table or +circular aperture is specified the default is "multiap" otherwise the +default is "longslit". +.le +.ls nskyaps = 10 (10) [spectrograph] +Number of sky apertures when using "multiap" sky subtraction. +.le +.ls subpixels = 1 (1) [spectrograph] +Number of subpixels within each computed pixel. +The dispersion pixel width is divided into this number of equal +width subpixels. The flux at the dispersions represented by the subpixels +are computed and then summed to form the full pixel flux. This option is used +when there is structure in the tables, such as the sky and filter tables to +simulate instrumental masking of sky lines, which is finer than a pixel +dispersion width. +.le +.ls sensfunc = "" [spectrograph] +Sensitivity function table. This is a two column text file consisting +of wavelength in Angstroms and sensitivity defined as +2.5*(log(countrate)-log(flambda)), +where countrate is the count rate (without extinction) in counts/s/A +and flambda is the source flux in ergs/s/cm^2/A. This table is used +to compute an efficiency correction given a measurement of the +sensitivity function from standard stars for the instrument. +.le + + +The following parameters control the output of the task. The task +always prints a result page at the central wavelength but additional +graphical and text output may be produced at a set of equally spaced +points across the size of the detector. +.ls output = "object" ("") [spectrograph] +List of quantities to output as graphs and/or in a text file. These are +given as a function of dispersion (as specified by units parameters) +sampled across the dispersion coverage of the detector. The choices are: +.ls counts +Object and background counts per individual exposure. +.le +.ls snr +Signal-to-noise ratio per pixel per individual exposure. +.le +.ls object +Object counts per individual exposure. This includes contribution +from other orders if there is no cross dispersion and the blocking +filters do not completely exclude other orders. +.le +.ls rate +Photons/second/A per individual exposure for the object and background. +.le +.ls atmosphere +Percent transmission of the atmosphere. +.le +.ls telescope +Percent transmission of the telescope. +.le +.ls adc +Percent transmission of the ADC if one is used. +.le +.ls aperture +Percent transmission of the aperture. +.le +.ls fiber +Percent transmission of the fiber if one is used. +.le +.ls filter +Percent transmission of the first filter if one is used. +.le +.ls filter2 +Percent transmission of the second filter if one is used. +.le +.ls collimator +Percent transmission of the collimator. +.le +.ls disperser +Percent efficiency of the disperser. +.le +.ls xdisperser +Percent efficiency of the cross disperser if one is used. +.le +.ls corrector +Percent transmission of the corrector if one is used. +.le +.ls camera +Percent transmission of the camera. +.le +.ls detector +Percent DQE of the detector. +.le +.ls spectrograph +Percent transmission of the spectrograph if a transmission +function is defined. +.le +.ls emissivity +Emissivity of the telescope/spectrograph if an emissivity function +is defined. +.le +.ls thruput +Percent system thruput from telescope to detected photons. +.le +.ls sensfunc +Sensitivity function values given as 2.5*(log(countrate)-log(flambda)), +where countrate is the count rate (without extinction) in counts/s/A +and flambda is the source flux in ergs/s/cm^2/A. +.le +.ls correction +Multiplicative correction factor needed to convert the computed +count rate to that given by an input sensitivity function. +.le +.ls ALL +All of the above. +.le +.le +.ls nw = 101 (101) [spectrograph] +Number of dispersion points to use in the output graphs and text +file. Note that this is generally less than the number of pixels in +the detector for execution speed. +.le +.ls list = "" [spectrograph] +Filename for list output of the selected quantities. The output +will be appended if the file already exists. +.le +.ls graphics = "stdgraph" ("stdgraph") [spectrograph] +Graphics output device for graphs of the output quantities. +.le +.ls interactive = "yes" ("yes") [spectrograph] +Interactive pause after each graph? If "yes" then cursor input is +enabled after each graph otherwise all the graphs will be drawn without +pause. When viewing the graphs interactively this should be "yes" otherwise +the graphs will flash by rapidly leaving the last graph on the screen. +When outputing only one graph or when redirecting the graphs to a +printer or file then setting this parameter to "no" is suggested. +.le + +The last parameter is a "parameter set" ("pset") containing all the +spectrograph parameters. +.ls specpars = "" +Spectrograph parameter set. If "" then the default pset \fBspecpars\fR +is used otherwise the named pset is used. +.le + + + +SPECPARS PARAMETERS +.ls spectrograph = "" +Spectrograph efficiency table. This text file may contain parameters and an +efficiency table. The table consists of two columns containing +wavelengths and efficiencies. The efficiencies are for all elements +which are not accounted for by other tables. +.le +.ls title = "" [spectrograph] +Title for the spectrograph. +.le +.ls apmagdisp = INDEF (1.), apmagxdisp = INDEF (1.) [spectrograph] +Magnification between the entrance aperture and the detector along and +across the dispersion direction. This describes any magnification (or +demagnification) in the spectrograph other than that produced by the ratio +of the collimator and camera focal lengths and anamorphic magnification +from the disperser. The may consist of actual magnification optics or +projection effects such as tilted aperture plates (when the aperture size +is specified in the untilted plate). +.le +.ls inoutangle = INDEF (INDEF) [spectrograph] +Incident to diffracted grating angle in degrees for grating dispersers. +For typical spectrographs which are not cross dispersed this is the +collimator to camera angle. If the value is INDEF derived from the grating +parameters. +.le +.ls xinoutangle = INDEF (INDEF) [spectrograph] +Incident to diffracted grating angle in degrees for grating cross +dispersers. If the value is INDEF it is derived from the grating +parameters. +.le + + +.ls telescope = "" [spectrograph] +Telescope efficiency table as a function of wavelength. +.le +.ls teltitle = "" [telescope|spectrograph] +Telescope title. +.le +.ls area = INDEF (1.) [telescope|spectrograph] +Effective collecting area of the telescope in m^2. The effective area +includes reductions in the primary area due to obstructions. +.le +.ls scale = INDEF (10.) [telescope|spectrograph] +Telescope plate scale, in arcsec/mm, at the entrance aperture of the +spectrograph. +.le +.ls emissivity = "" [telescope|spectrograph] +Emissivity table. The emissivity is for all elements in the telescope +and spectrograph. If an emissivity is specified and an the \fIthermal\fR +temperature parameter is greater than zero then a thermal background +is added to the calculation. +.le +.ls emistitle = "" [emissivity|spectrograph] +Title for the emissivity table used. +.le + + +.ls corrector = "" [spectrograph] +Efficiency table for one or more correctors. +.le +.ls cortitle = "" [corrector|spectrograph] +Title for corrector table used. +.le +.ls adc = "" [spectrograph] +Efficiency table for atmospheric dispersion compensator. +.le +.ls adctitle = "" [adc|spectrograph] +Title for ADC table used. +.le + + +.ls disperser = "" [spectrograph] +Disperser table. If this file contains an efficiency table it applies +only to first order. An alternate first order table and tables for +other orders are given by table parameters "effN", where N is the order. +.le +.ls disptitle = "" [disperser|spectrograph] +Title for disperser. +.le +.ls disptype = "" ("grating") [disperser|spectrograph] +Type of disperser element. The chocies are "grating", "grism", or "generic". +The generic setting will simply use the desired central wavelength and +dispersion without a grating or grism model. One effect of this is that +the mapping between detector pixel and wavelength is linear; i.e. a constant +dispersion per pixel. +.le +.ls gmm = INDEF (300.) [disperser|spectrograph] +Ruling in lines per mm. If not specified it will be derived from the +other disperser parameters. If there is not enough information to +derive the ruling then an ultimate default of 300 lines/mm is used. +.le +.ls blaze = INDEF (6.) [disperser|spectrograph] +Blaze (grating) or prism (grism) angle in degrees. If not specified it +will be derived from the other disperser parameters. If there is not +enough information to derive the angle then an ultimate default of 6 +degrees is used. +.le +.ls oref = INDEF (1) [disperser|spectrograph] +When a central (blaze) wavelength is specified this parameter indicates +which order it is for. +.le +.ls wavelength = INDEF (INDEF) [disperser|spectrograph] +Central (blaze) wavelength in Angstroms for the reference order. This +parameter only applies to gratings. If it is not specified it will +be derived from the other disperser parameters. +.le +.ls dispersion = INDEF (INDEF) [disperser|spectrograph] +Central dispersion in A/mm for the reference order. This parameter only +applies to gratings. If it is not specified it will be derived from the +other disperser parameters. +.le +.ls indexref = INDEF (INDEF) [disperser|spectrograph] +Grism index of refraction for the reference order. This parameter only +applies to grisms. If it is not specified it will be derived from +the other disperser parameters. +.le +.ls eff = INDEF (1.) [disperser|spectrograph] +Peak efficiency for the theoretical disperser efficiency function. +When an efficiency table is not specified then a theoretical efficiency +is computed for the disperser. This theoretical efficiency is scaled +to peak efficiency given by this parameter. +.le + + +.ls xdisperser = "" [spectrograph] +Crossdisperser table. If this file contains an efficiency table it applies +only to first order. An alternate first order table and tables for +other orders are given by table parameters "xeffN", where N is the order. +.le +.ls xdisptitle = "" [xdisperser|spectrograph] +Title for crossdisperser. +.le +.ls disptype = "" ("grating") [xdisperser|spectrograph] +Type of crossdisperser element. The chocies are "", "grating", "grism", +or "generic". The empty string eliminates use of a cross disperser. +The generic setting will simply use the desired central wavelength and +dispersion without a grating or grism model. One effect of this is that +the mapping between detector pixel and wavelength is linear; i.e. a constant +dispersion per pixel. +.le +.ls gmm = INDEF (INDEF) [xdisperser|spectrograph] +Ruling in lines per mm. If not specified it will be derived from the +other crossdisperser parameters. +.le +.ls xblaze = INDEF (6.) [xdisperser|spectrograph] +Blaze (grating) or prism (grism) angle in degrees. If not specified it +will be derived from the other crossdisperser parameters. +.le +.ls xoref = INDEF (1) [xdisperser|spectrograph] +When a central (blaze) wavelength is specified this parameter indicates +which order it is for. +.le +.ls xwavelength = INDEF (INDEF) [xdisperser|spectrograph] +Central (blaze) wavelength in Angstroms for the reference order. This +parameter only applies to gratings. If it is not specified it will +be derived from the other crossdisperser parameters. +.le +.ls xdispersion = INDEF (INDEF) [xdisperser|spectrograph] +Central dispersion in A/mm for the reference order. This parameter only +applies to gratings. If it is not specified it will be derived from the +other crossdisperser parameters. +.le +.ls xindexref = INDEF (INDEF) [xdisperser|spectrograph] +Grism index of refraction for the reference order. This parameter only +applies to grisms. If it is not specified it will be derived from +the other crossdisperser parameters. +.le +.ls xeff = INDEF (1.) [xdisperser|spectrograph] +Peak efficiency for the theoretical crossdisperser efficiency function. +When an efficiency table is not specified then a theoretical efficiency +is computed for the crossdisperser. This theoretical efficiency is scaled +to peak efficiency given by this parameter. +.le + + +.ls aperture = "" (default based on context) [spectrograph] +Aperture table. The text file gives aperture thruput as a function of the +aperture size in units of seeing FWHM. For rectangular apertures there are +two independent variables corresponding to the width and length while for +circular apertures there is one independent variable corresponding to the +diameter. If not specified a default table is supplied. If a fiber table +or a diameter is specified then the table "circle" is used otherwise the +table "slit" is used. Because "sptimelib$" is the last directory searched +there are default files with these names in this directory for Gaussian +seeing profiles passing through a circular or slit aperture. +.le +.ls aptitle = "" [aperture|spectrograph] +Title for aperture used. +.le +.ls aptype = "" (default based on context) [aperture|spectrograph] +The aperture types are "rectangular" or "circular". If the +parameter is not specified then if the aperture table has two columns the +type is "circular" otherwise it is "rectangular". +.le + + +.ls fiber = "" [spectrograph] +Fiber transmission table. The transmission is a function of wavelength +in Angstroms. If no fiber transmission is specified then no fiber +component is included. +.le +.ls fibtitle = "" [fiber|spectrograph] +Title for fiber transmission used. +.le + + +.ls filter = "" [spectrograph] +Filter transmission table. The transmission is a function of wavelength +in Angstroms. If no filter transmission is specified then no filter +component is included. +.le +.ls ftitle = "" [filter|spectrograph] +Title for filter transmission used. +.le +.ls filter2 = "" [spectrograph] +Filter transmission table. The transmission is a function of wavelength +in Angstroms. If no filter transmission is specified then no filter +component is included. +.le +.ls f2title = "" [filter|spectrograph] +Title for filter transmission used. +.le +.ls block = "" ("no") [filter|spectrograph] +If "yes" then no check will be made for other orders. +.le + + +.ls collimator = "" (1.) [spectrograph] +Collimator transmission table. The transmission is a function of +wavelength in Angstroms. If no collimator is specified then a unit +transmission is used. +.le +.ls coltitle = "" [collimator|spectrograph] +Title for collimator. +.le +.ls colfl = INDEF (1.) [collimator|spectrograph] +Collimator focal length in meters. The ratio of the collimator to camera +focal lengths determines the magnification between the aperture and the +detector. +.le + +.ls camera = "" (1.) [spectrograph] +Camera transmission table. The transmission is a function of wavelength +in Angstroms. If no camera is specified then a unit transmission +is used. +.le +.ls camtitle = "" [camera|spectrograph] +Title for camera. +.le +.ls camfl = "" (1.) [camera|spectrograph] +Camera focal length in meters. The ratio of the collimator to +camera focal lengths determines the magnification between the aperture +and the detector. The camera focal length also determines the dispersion +scale at the detector. +.le +.ls resolution = "" (2 pixels) [camera|spectrograph] +Camera resolution on the detector in mm. +.le +.ls vignetting = "" (1.) [camera|spectrograph] +Vignetting table. The independent variable is distance from the center +of the detector in mm. The value is the fraction the light transmitted. +If no vignetting table is specified then no vignetting effect is applied. +.le + + +.ls detector = "" (1.) [spectrograph] +Detector DQE table. The DQE is a function of wavelength in Angstroms. +.le +.ls dettitle = "" [detector|spectrograph] +Title for detector. +.le +.ls ndisp = INDEF (2048) [detector|spectrograph] +Number of pixels along the dispersion. +.le +.ls pixsize = INDEF (0.02) [detector|spectrograph] +Pixel size (assumed square) in mm. +.le +.ls gain = INDEF (1.) [detector|spectrograph] +The conversion between photons and detector data numbers or counts. +This is given as photons/ADU where ADU is analog-to-digital unit. +.le +.ls rdnoise = INDEF (0.) [detector|spectrograph] +Readout noise in photons. +.le +.ls dark = INDEF (0.) [detector|spectrograph] +Dark count rate in photons/s. +.le +.ls saturation = INDEF [detector|spectrograph] +Number of detected photons in a pixel resulting in saturation. +The default is no saturation. The time per exposure will be reduced, +but no lower than the minimum time per exposure, +and the number of exposures increased to try and avoid saturation. +.le +.ls dnmax = INDEF [detector|spectrograph] +Maximum data number or ADU allowed. The default is no maximum. +The time per exposure will be reduced, +but no lower than the minimum time per exposure, +and the number of exposures increased to try and avoid overflow. +.le +.ls xbin = 1 (1) [detector|spectrograph] +Detector binning along the dispersion direction. +.le +.ls ybin = 1 (1) [detector|spectrograph] +Detector binning along the spatial direction. +.le +.ih +DISCUSSION + + +OVERVIEW + +The spectroscopic exposure time package, \fBSPECTIME\fR, consists of a +general calculation engine, \fBSPTIME\fR, and a collection of user or +database defined IRAF scripts. The scripts are one type of user interface +for \fBSPTIME\fR. Other user interfaces are Web-based forms and IRAF +graphics/window applications. The user interfaces customize the general +engine to specific spectrographs by hiding components and parameters not +applicable to that spectrograph and guiding the user, through menus or +other facilities, in the choice of filters, gratings, etc. However, +\fBSPTIME\fR is a standard IRAF task that can be executed directly. + +\fBSPTIME\fR takes an input source spectrum (either a reference blackbody, +a power law, or a user spectrum), a background "sky" spectrum and a +instrumental thermal background, reddening to apply to the spectrum, +observing parameters such as exposure time, central wavelength, seeing, +airmass, and moon phase, instrument parameters such as aperture sizes and +detector binning, a description of the spectrograph, and produces +information about the expected signal and signal-to-noise ratio in the +extracted one-dimensional spectrum. The output consists of a description +of the observation, signal-to-noise statistics, and optional graphs and +tables of various quantities as a function of wavelength over the +spectrograph wavelength coverage. + +\fBSPTIME\fR models a spectroscopic system as a flow of photons from a +source to the detector through various optical components. Background +photons from the sky, atmosphere, and the thermal emission from the +telescope and spectrograph are added. It then computes signal-to-noise +ratios from the detected photons of the source and background and the +instrumental noise characteristics. The spectroscopic system components +are defined at a moderate level of detail. It is not so detailed that +every optical element has to be described and modeled and not so coarse +that a single throughput function is used (though one is free to put all +the thruput information into one component). Not all components modeled by +the task occur in all spectroscopic systems. Therefore many of the +components can be left out of the calculation. + +The components currently included in \fBSPTIME\fR are: + +.nf + - the atmosphere (extinction and IR transmission) + - the telescope (all elements considered as a unit) + - an optional atmospheric dispersion compensator + - the entrance aperture (slits, fibers, masks, etc.) + - an optional fiber feed + - a spectrograph (for components not represented elsewhere) + - filters + - a collimator + - a disperser (grating, grism, prism, etc) + - a optional cross disperser (grating, grism, prism, etc) + - a corrector (either in the telescope of spectrograph) + - a camera + - a detector +.fi + +Each of these components represent a transmission function specifying the +fraction of incident light transmitted or detected as a function of some +parameter or parameters. Except for the aperture, which is a function of +the incident source profile (typically the seeing profile) relative to the +aperture size, the transmissions of the components listed above are all +functions of wavelength. + +All the component transmission functions may be specified as either numeric +values or as tables. A numeric value is considered to be a special type of +table which has the same value at all values of the independent parameters. +By specifying only numeric values the task may be run without any table +files. To obtain information at a single wavelength this is all that is +needed. + +To specify a dependence on wavelength or other parameter a text file table +with two or more columns may be specified. The tables are interpolated in +the parameter columns to find the desired value in the last column. The +tables are searched for in the current directory and then in a list of user +specified directories. Thus, users may place files in their work area to +override system supplied files and observatories can organize the data +files in a database directory tree. + +In addition to transmission or DQE functions the spectrograph is described +by various parameters. All the parameters are described in the PARAMETERS +section. For flexibility parameters may be defined either in the +parameter set or in one or more table files. In all cases the parameter +set values have precedence. But if the values are "" for string parameters +or INDEF for numeric parameters the values are found either in the +spectrograph table or in a table that is associated with the parameter. + +Therefore table files provide for interchangeable components, each with +their own transmission curves, and for organizing parameters for different +instruments. Note that a table file may contain only parameters, only +a table, or both. + +There is also another way to maintain a separate file for different +instruments. The \fIspecpars\fR parameter is a "parameter set" or "pset". +The default value of "" corresponds to the pset task \fBspecpars\fR. +However, using \fBeparam\fR one can edit this pset and then save the +parameters to a named parameter file with ":e .par". This +pset can be edited with \fBeparam\fR and specified in the +\fIspecpars\fR parameter. One other point about pset parameters is that +they can also be included as command line arguments just as any other +parameter in the main task parameters. + +Many spectrographs provide a wide variety of wavelength regions and +dispersions. For gratings (and to some extent for grisms) this means use +of different gratings, orders, tilts, and possibly camera angles in the +spectrograph. The transmission as a function of wavelength (the grating +efficiency) changes with these different setups. If the transmission +function is given as an interpolation table this would require data files +for each setup of each disperser. The structure of \fBSPTIME\fR allows +for this. + +However, it is also possible to specify the grating and spectrograph +parameters and have the task predict the grating efficiency in any +particular setup. In many cases it may be easier to use the calculated +efficiencies rather than measure them. Depending on the level of accuracy +desired this may be adequate or deviations from the analytic blaze function +can be accounted for in another component. + + +TABLES + +\fBSPTIME\fR uses text files to provide parameters and interpolation +tables. The files may contain comments, parameters, and tables. + +Comment lines begin with '#' and may contain any text. They can occur +anywhere in the file, though normally they are at the beginning of the file. + +Parameters are comment lines of the form + +.nf + # [parameter] = [value] +.fi + +where whitespace is required between each field, [parameter] is a single +word parameter name, and [value] is a single word value. A quoted string +is a single word so if the value field contains whitespace, such as in +titles, it must be quoted. Any text following the value is ignored and may +be used for units (not read or used by the program) or comments. + +The parameters are those described in the PARAMETERS section. The tables +in which the parameters may be included are identified in that section +in the square brackets. Note that it is generally true that any parameter +may appear in the spectrograph table. + +The table data is a multicolumn list of numeric values. The list must be +in increasing order in the independent columns. Only 1D (two columns) and +2D (three columns) tables are currently supported. 2D tables must form a +regular grid. This means that any particular value from column one must +occur for all values of column 2 and vice versa. The table is +interpolated as needed. The interpolation is linear or bi-linear. +Extrapolation outside of the table consists of the taking the nearest +value; thus, a single line may be used to define a constant value for all +values of the independent variable(s). + +Normally the table values, the dependent variable in the last column, are +in fractional transmission or DQE. There is a special parameter, +"tablescale", which may be specified to multiply the dependent variable +column. This would mainly be used to provide tables in percent rather +than fraction. + +The independent variable columns depend on the type of table. Most tables +are a function of wavelength. Currently wavelengths must be in Angstroms. + +The types of tables and the units of the columns are listed below. + +.nf + spectrum - Angstroms ergs/s/cm^2/A + sky - Angstroms ergs/s/cm^2/A/arcsec^2 + extinction - Angstroms mag/airmass + spectrograph - Angstroms transmission + telescope - Angstroms transmission + emissivity - Angstroms emissivity + adc - Angstroms transmission + fiber - Angstroms transmission + collimator - Angstroms transmission + filter - Angstroms transmission + disperser - Angstroms transmission + xdisperser - Angstroms transmission + corrector - Angstroms transmission + camera - Angstroms transmission + detector - Angstroms transmission + sensitivity - Angstroms 2.5*(log(countrate)-log(flambda)), + + sky - Angstroms moonphase ergs/s/cm^2/A/arcsec^2 + aperture - diameter/FWHM transmission + aperture - width/FWHM length/FWHM transmission + vignetting - mm transmission +.fi + +The disperser and crossdisperser files have an additional feature to allow +for efficiency curves at different orders. The parameter "effN" (or "xeffN +for crossdispersers), where N is the order, may be specified whose value is +a separate table (or constant). If there is no "eff1/xeff1" (efficiency in +first order) then any efficiency table in the disperser table is used. In +other words, any table in the disperser file applies only to first order +and only if there is no "eff1/xeff1" parameter defining a separate first +order efficiency file. + +DISPERSION UNITS + +The output results, text file, and graphs are presented in dispersion +units defined by the \fIunits\fR parameter. In addition the \fIwave\fR +and \fIrefwave\fR input parameters are specified in the selected units. +All other dispersion values must currently be specified in Angstroms. + +The dispersion units are specified by strings having a unit type from the +list below along with the possible preceding modifiers, "inverse", to +select the inverse of the unit and "log" to select logarithmic units. For +example "log angstroms" to select the logarithm of wavelength in Angstroms +and "inv microns" to select inverse microns. The various identifiers may +be abbreviated as words but the syntax is not sophisticated enough to +recognize standard scientific abbreviations except for those given +explicitly below. + +.nf + angstroms - Wavelength in Angstroms + nanometers - Wavelength in nanometers + millimicrons - Wavelength in millimicrons + microns - Wavelength in microns + millimeters - Wavelength in millimeters + centimeter - Wavelength in centimeters + meters - Wavelength in meters + hertz - Frequency in hertz (cycles per second) + kilohertz - Frequency in kilohertz + megahertz - Frequency in megahertz + gigahertz - Frequency in gigahertz + m/s - Velocity in meters per second + km/s - Velocity in kilometers per second + ev - Energy in electron volts + kev - Energy in kilo electron volts + mev - Energy in mega electron volts + + nm - Wavelength in nanometers + mm - Wavelength in millimeters + cm - Wavelength in centimeters + m - Wavelength in meters + Hz - Frequency in hertz (cycles per second) + KHz - Frequency in kilohertz + MHz - Frequency in megahertz + GHz - Frequency in gigahertz + wn - Wave number (inverse centimeters) +.fi + +The velocity units require a trailing value and unit defining the +velocity zero point. For example to transform to velocity relative to +a wavelength of 1 micron the unit string would be: + +.nf + km/s 1 micron +.fi + + +CALCULATIONS + +This section describes the calculations, and assumptions behind the +calculations, performed by \fBSPTIME\fR. These include the dispersion and +efficiencies of gratings and grisms, the dispersion resolution, the spatial +resolution and how it applies to the number of object and sky pixels in the +apertures, the object and sky detected photons/counts, the signal-to-noise +ratio , and the exposure time for a given S/N. + + +Gratings + +Gratings are assumed to tilted only around the axis parallel to the +groves and with the incident angle greater than the blaze angle. The +grating equation is then + +.nf + g * m * w = sin(tilt+phi/2) + sin(beta) +.fi + +where g is the number of groves per wavelength unit, m is the order, w is +the wavelength, tilt is the grating tilt measured from the grating normal, +phi is the angle between the incident and diffracted rays, and beta is the +diffracted angle. Phi is a spectrograph parameter and g is a grating +parameter. At the desired central wavelength beta is tilt-phi/2 and at the +blaze peak it is 2*blaze-tilt-phi/2 where blaze is the blaze angle. + +The tilt is computed from the desired central wavelength. It is +also used to compute the grating magnification + +.nf + magnification = cos(tilt-phi/2) / cos(tilt+phi/2) +.fi + +which is used in calculating the projected slit size at the detector. +This number is less than zero so the aperture is actually demagnified. + +The dispersion, treated as constant over the spectrum for the sake of +simplicity, is given by the derivative of the grating equation at +the blaze peak, + +.nf + dispersion = cos(blaze-phi/2) / (g * m * f) +.fi + +where f is the camera focal length. + +The grating efficiency or blaze function is computed as described by +Schroeder and Hilliard (Applied Optics, vol 19, 1980, p. 2833). The +requirements on the grating noted previously correspond to their case A. +As they show, use of incident angles less than the blaze angle, their case +B, significantly degrades the efficiency due to back reflection which is +why this case is not included. The efficiency formulation includes +variation in the peak efficiency due light diffracted into other orders, +shadowing of the groves, and a reflectance parameter. The reflectance +parameter is basically the blaze peak normalization and does not currently +include a wavelength dependence. Thus the peak efficiency is near the +reflectance value but somewhat lower and is order dependent due to the other +effects. + + +Grisms + +Grisms are assumed to have a prism angle equal to the blaze angle of +the inscribed grating. The index of refraction is treated as constant +over the wavelength range of an order, though different index of refraction +values can be specified for each order. + +The grism formula used is a variation on the grating equation. + +.nf + g * m * w = n * sin (theta+prism) - sin (beta+prism) +.fi + +where n is the index of refraction, prism is the prism or blaze angle, +theta is the incident angle relative to the prism face, and beta is the +refracted angle relative to the prism face. Theta and beta are defined so +that at the undeviated wavelength they are zero. In other words at the +undeviated wavelength the light path is a straight through transmission. + +The efficiency is also computed in an analogous manner to the +reflection grating except that shadowing is not included (a consequence of +the blaze face being parallel to the prism face and theta being near +zero). Instead of a reflectance value normalizing the blaze function a +transmission value is used. + + +Scales and Sizes + +The scale between arc seconds on the sky and millimeters at the +aperture(s) of the spectrograph is specified by the \fIscale\fR parameter. +This parameter is used to convert aperture sizes between arc seconds and +millimeters. + +The aperture sizes are magnified or demagnified by three possible factors. +The basic magnification is given by the ratio of the collimator focal +length to the camera focal length. This magnification applies both along +and across the dispersion. + +The camera focal length also determines the dispersion scale on the detector. +It converts radians of dispersion to mm at the detector. + +For grating dispersers there is a demagnification along the dispersion +due to the tilt of the grating(s). The demagnification is computed (as +given previously) from the grating parameters and the spectrograph +parameter giving the angle between the incident and diffracted rays at the +detector center. + +The last magnification factor is given by the spectrograph parameters +"apmagdisp" and apxmagdisp". These define magnifications of the aperture +along and across the dispersion apart from the other two magnifications. +These parameters are often missing which means no additional +magnifications. + +One use for the last magnification parameters is to correct aperture +sizes given as millimeters or arc seconds on a plane tilted with respect to +the focal plane. Such tilted apertures occur with aperture mechanisms +(usually slits) that reflect light for acquisition and guiding. Note that +one only needs to use these terms if users are expected to define the +apertures sizes on the tilted plane. If instead the projection factors are +handled by the spectrograph system and users specify aperture size as +millimeters or arc seconds on the sky then these terms are not needed. + +The above scale factors map arc seconds on the sky and aperture sizes +in millimeter to arc seconds and millimeters projected on the detector. To +convert to pixels on the detector requires the pixel size. +One option in \fBSPTIME\fR is to specify aperture +sizes as projected pixels on the detector (either in the user parameters or +in the aperture description file). Using the detector pixel size and the +scale factors allows conversion of aperture sizes specified in this way +back to the actual aperture size. + + +Resolution + +A camera resolution parameter may be set in the camera description. If +a resolution value is not given it is taken to be 2 pixels. This parameter +is used to define the dispersion resolution element and the number of +pixels across the dispersion imaged by the detector for the aperture and +the object. The latter usage is discussed in the next section. + +The dispersion resolution element, in pixels, is given by + +.nf + | 2 pixels + disp resolution = maximum of | camera resolution + | 1 + min (seeing, apsize) +.fi + +where seeing is the FWHM seeing diameter in pixels and apsize is the +aperture size in pixels. For circular apertures the aperture size is +the diameter and for rectangular apertures it is the width. The first term +comes from sampling considerations, the second from the camera resolution, +and the third from the finite resolution of a pixel (the factor of 1) and +the spread of wavelengths across the aperture or seeing disk. The +dispersion resolution is printed for information and the S/N per dispersion +resolution element is given in addition to the per pixel value. + + +Object and Sky Pixels Across the Dispersion + +The number of pixels across the dispersion in the object and the sky +are required to compute the S/N statistics. The number of pixels +in the projected aperture image is taken to be + +.nf + | diameter + resolution (circular apertures) + aperture pixels = | + | length + resolution (rectangular apertures) +.fi + +where resolution is the camera resolution discussed previously. The value +is rounded up to an integer. + +Objects are assumed to fill circular (fiber) apertures. Therefore the +number of object pixels is the same as the number of pixels in the +aperture. In rectangular (slit) apertures the number of object pixels is +taken to be + +.nf + | 3*seeing + resolution + object pixels = minimum of | + | number of aperture pixels +.fi + +where seeing is the FWHM seeing diameter converted to pixels. The values +are rounded up to an integer. + +The number of sky pixels depends on the type of sky subtraction. +For "longslit" sky subtraction the number of sky pixels is given +by the difference of the number of aperture pixels and the number of +object pixels. For circular apertures this always comes out to zero so +it does not make sense to use longslit sky subtraction. For rectangular +apertures the number of sky pixels in the aperture depends on the +aperture size and the seeing. If the number of sky pixels comes out to +zero a warning is printed. + +For "multiap" sky subtraction the number of sky pixels is the +number of sky apertures times the number of pixels per aperture. + + +Source Counts + +The source spectrum flux at each wavelength, either given in a spectrum +table or as a model distribution, is in units of +photons per second per Angstrom per square centimeter. This is multiplied +by the telescope effective area, the exposure time, and the pixel size in +Angstroms to give the source photons per dispersion pixel per exposure. +This is then multiplied by any of the following terms that apply to arrive +at the number of source photons detected over all spatial pixels. The +spatial integration is implicit in the aperture function. + +.nf + - the extinction using the specified airmass + - the telescope transmission + - the ADC transmission + - the aperture transmission based on the aperture size relative + to the seeing + - the fiber transmission + - the filter transmission (one or two filters) + - the collimator transmission + - the disperser efficiency (one or two dispersers) + - the corrector transmission + - the camera transmission + - the detector DQE +.fi + + +Background Counts + +The sky or atmospheric background spectrum, if one is given, defines a +photon flux per square arc second. When it is given as a function of the +moon phase it is interpolated to the specified moon phase. In addition +if a thermal temperature and an emissivity are given then a thermal +background is computed and added to the sky/atmospheric background. + +The surface brightness of the background is multiplied by the area of the +aperture occupied by the object (in arc seconds) and divided by the +aperture transmission of the source. This is the quantity reported in the +output for the sky photon flux. It is comparable to the source photon +flux. + +Next this flux is multiplied by the telescope effective area, the +exposure time, and the pixel size in Angstroms. Finally it is multiplied +by the same transmission terms as the object except for the extinction. +Note that this removes the aperture transmission term included earlier +giving the background photons as the number passing through the aperture per +object profile. The final value is the number of background photons from the +object. To get the background photons per spatial pixel the value is divided by +the number of spatial pixels occupied by the source. + +If no background subtraction is specified then the background counts are added +to the source counts to define the final source counts and the background +counts are set to zero. + + +Signal-to-Noise Ratio + +The noise attributed to the source and background is based on Poisson +statistics; namely the noise is the square root of the number of photons. +The detector noise is given by a dark count component and a readout noise +component. The noise from the dark counts is obtain by multiplying the +dark count rate by the exposure time and the number of spatial pixels used +in extracting the source and taking the square root. The readout noise is +the detector readout noise parameter multiplied by the square root of the +number of spatial source pixels. + +If background subtraction is selected and the number of available +background pixels is greater than zero then the uncertainty in the +background estimation is computed. The uncertainty in a single pixel is +the square root of the background photons per pixel, the dark counts per +pixel, and the readout noise per pixel. This is divided by the square root +of the number of background pixels to get the uncertainty in the background +estimation for subtraction from the source. + +The total noise is the combination of the source, background, dark count, +and readout noise values and the background subtraction uncertainty added +in quadrature. + +The signal-to-noise ratio per pixel per exposure is the source counts +divided by total noise. This value is multiplied by the square root of +number of pixels per resolution element to get the S/N per resolution +element. If multiple exposures are used to make up the total exposure time +then the single exposure S/N is multiplied by the square root of the number +of exposures. + + +Exposure Time From Signal-to-Noise Ratio + +If no exposure time is specified, that is a value of INDEF, then +the exposure time required to reach a desired signal-to-noise ratio +per pixel is determined. The computation is done at the specified central +wavelength. The task iterates, starting with the specified maximum time per +exposure, by computing the S/N and adjusting the exposure time +(possibly breaking the total exposure up into subexposures) until +the computed S/N matches the desired S/N to 0.1%. + +In addition to breaking the exposure time into individual exposure less +than the maximum per exposure, the task will break single exposures that +exceed the specified saturation and maximum data number values at the +reference wavelength. If other wavelengths are then saturated or exceed +the data maximum a warning is printed. +.endhelp diff --git a/noao/obsutil/src/doc/starfocus.hlp b/noao/obsutil/src/doc/starfocus.hlp new file mode 100644 index 00000000..351bf14c --- /dev/null +++ b/noao/obsutil/src/doc/starfocus.hlp @@ -0,0 +1,820 @@ +.help starfocus Nov01 noao.obsutil +.ih +NAME +starfocus -- Measure focus variations using stellar images +.ih +USAGE +starfocus images +.ih +PARAMETERS +.ls images +List of images. The images may be either taken at a sequence +of focus values or be multiple shifted exposures at a sequence of +focus settings. +.le +.ls focus = "1x1" +If the parameter \fIfstep\fR is not set (a "" null string) then this +parameter is interpreted as either a list of focus values or an +image header keyword to one focus value per image. A list may be an explicit +list of values, a range specification, or an @ file containing the values. +If there is only a single exposure per image then the focus list gives one +value per image while if there are multiple exposures per image the list +applies to the multiple exposures with the same values reused for other +images. If the parameter \fIfstep\fR is given then this parameter is +interpreted as a single starting focus value and the focus step +defines the increment between subsequent single exposure images or +for the various exposures in a multiple exposure image. +.le +.ls fstep = "" +A focus increment value or an image header keyword to the focus increment. +.le + +.ls nexposures = "1" +The number of exposures per image specified either as a value or as +an image header keyword. A double step gap in a multiple +exposure sequence does not count as an exposure. +.le +.ls step = "30." +The step in pixels between exposures specified either as a value or +as an image header keyword. +.le +.ls direction = "-line" (-line|+line|-column|+column) +The direction of the exposure sequence in the image. The values are +"-line" for successive object images appearing at smaller line numbers, +"+line" for objects appearing at larger line numbers, "-column" for +objects appearing at smaller column numbers, and "+column" for objects +appearing at larger column numbers. +.le +.ls gap = "end" (none|beginning|end) +Location of a double step gap in a sequence with the specified direction. +The available cases are "none" for an even sequence with no gap, +"beginning" where a double step is taken between the first and +the second exposure, and "end" where a double step is taken before +the last exposure. Note that "beginning" and "end" are defined in +terms of the \fIdirection\fR parameter. +.le + +.ls coords = "mark1" (center|mark1|markall) +Method by which the coordinates of objects to be measured are specified. +If "center" then a single object at the center of each image is measured. +If "mark1" then the \fIimagecur\fR parameter, typically the interactive +image display cursor, defines the coordinates of one or more objects in the +first image ending with a 'q' key value and then the same coordinates are +automatically used in subsequent images. If "markall" then the +\fIimagecur\fR parameter defines the coordinates for objects in each image +ending with a 'q' key value. +.le +.ls wcs = "logical" (logical|physical|world) +Coordinate system for input coordinates. When using image cursor input +this will always be "logical". When using cursor input from a file this +could be "physical" or "world". +.le +.ls display = yes, frame = 1 +Display the image or images as needed? If yes the image display is checked +to see if the image is already in one of the display frames. If it is not +the \fBdisplay\fR task is called to display the image in the frame +specified by the \fBframe\fR parameter. All other display parameters are +taken from the current settings of the task. This option requires that the +image display be active. A value of no is typically used when an input +cursor file is used instead of the image display cursor. An image display +need not be active in that case. +.le + +.ls level = 0.5 +The parameter used to quantify an object image size is the radius from the +image center enclosing the fraction of the total flux given by this +parameter. If the value is greater than 1 it is treated as a percentage. +.le +.ls size = "FWHM" (Radius|FWHM|GFWHM|MFWHM) +There are four ways the PSF size may be shown in graphs and given in +the output. These are: + +.nf + Radius - the radius enclosing the specified fraction of the flux + FWHM - a direct FWHM from the measured radial profile + GFWHM - the FWHM of the best fit Gaussian profile + MFWHM - the FWHM of the best fit Moffat profile +.fi + +The labels in the graphs and output will be the value of this parameter +to distinguish the different types of size measurements. +.le +.ls beta = INDEF +For the Moffat profile fit (size = MFWHM) the exponent parameter may +be fixed at a specified value or left free to be determined from the +fit. The exponent parameter is determined by the fit if \fIbeta\fR +task parameter is INDEF. +.le +.ls scale = 1. +Pixel scale in user units per pixel. Usually the value is 1 to measure +sizes in pixels or the image pixel scale in arc seconds per pixel. +.le +.ls radius = 5., iterations = 2 +Measurement radius in pixels and number of iterations on the radius. The +enclosed flux profile is measured out to this radius. This radius may be +adjusted if the \fIiteration\fR parameter is greater than 1. In that case +after each iteration a new radius is computed from the previous FWHM +estimate to be the radius the equivalent gaussian enclosing 99.5% of the +light. The purpose of this is so that if the initial PSF size of the image +need not be known. However, the radius should then be larger than true +image size since the iterations best converge to smaller values. +.le +.ls sbuffer = 5, swidth = 5. +Sky buffer and sky width in pixels. The buffer is added to the specified +measurement \fIradius\fR to define the inner radius for a circular sky +aperture. The sky width is the width of the circular sky aperture. +.le +.ls saturation=INDEF, ignore_sat=no +Data values (prior to sky subtraction) to be considered saturated within +measurement radius. A value of INDEF treats all pixels as unsaturated. If +a measurement has saturated pixels there are two actions. If +\fIignore_sat\fR=no then a warning is given but the measurement is saved +for use. The object will also be indicated as saturated in the output +log. If \fIignore_sat\fR=yes then a warning is given and the object is +discarded as if it was not measured. In a focus sequence only the +saturated objects are discarded and not the whole sequence. +.le +.ls xcenter = INDEF, ycenter = INDEF +The optical field center of the image given in image pixel coordinates. +These values need not lie in the image. If INDEF the center of the image +is used. These values are used to make plots of size verse distance from +the field center for studies of radial variations. +.le +.ls logfile = "logfile" +File in which to record the final results. If no log file is desired a +null string may be specified. +.le + +.ls imagecur = "" +Image cursor input for the "mark1" and "markall" options. If null then the +image dispaly cursor is used interactively. If a file name is specified +then the coordinates come from this file. The format of the file are lines +of x, y, id, and key. Values of x an y alone may be used to select objects +and the single character 'q' (or the end of the file) may be used to end +the list. +.le +.ls graphcur = "" +Graphics cursor input. If null then the standard graphics cursor +is used otherwise a standard cursor format file may be specified. +.le +.ih +CURSOR COMMANDS +When selecting objects with the image cursor the following commands are +available. + +.nf +? Page cursor command summary +g Measure object and graph the results. +m Measure object. +q Quit object marking and go to next image. + At the end of all images go to analysis of all measurements. + +:show Show current results. +.fi + +When in the interactive graphics the following cursor commands are available. +All plots may not be available depending on the number of focus values and +the number of stars. + +.nf +? Page cursor command summary +a Spatial plot at a single focus +b Spatial plot of best focus values +d Delete star nearest to cursor +e Enclosed flux for stars at one focus and one star at all focus +f Size and ellipticity vs focus for all data +i Information about point nearest the cursor +m Size and ellipticity vs relative magnitude at one focus +n Normalize enclosed flux at x cursor position +o Offset enclosed flux to by adjusting background +p Radial profiles for stars at one focus and one star at all focus +q Quit +r Redraw +s Toggle magnitude symbols in spatial plots +t Size and ellipticity vs radius from field center at one focus +u Undelete all deleted points +x Delete nearest point, star, or focus (selected by query) +z Zoom to a single measurement + Step through different focus or stars in current plot type + + +:beta Beta parameter for Moffat fit +:level Level at which the size parameter is evaluated +:overplot Overplot the profiles from the narrowest profile? +:radius Change profile radius +:show Page all information for the current set of objects +:size Size type (Radius|FWHM) +:scale Pixel scale for size values +:xcenter X field center for radius from field center plots +:ycenter Y field center for radius from field center plots + +The profile radius may not exceed the initial value set by the task +parameter. +.fi +.ih +DESCRIPTION +This task measures the point-spread function (PSF) width of stars or other +unresolved objects in digital images. The width is measured based on the +circular radius which encloses a specified fraction of the background +subtracted flux. The details of this are described in the ALGORITHMS +section. When a sequence of images or multiple exposures in a single image +are made with the focus varied the program provides an estimate of the best +focus and various views of how the PSF width varies with focus and position +in the image. A single star may be measured at each focus or measurements +of multiple stars may be made and combined. The task has three stages; +selecting objects and measuring the PSF width and other parameters, an +interactive graphical analysis, and a final output of the results to the +terminal and to a logfile. + +If a saturation value is specified then all pixels within the specified +measurement radius are checked for saturation. If any saturated pixels are +found a warning is given and \fIignore_sat\fR parameter may be used ot +ignore the measurement. If not ignored the object will still be indicated +as saturated in the output log. In a focus sequence only the saturated +objects are discarded and not the whole sequence. + +The input images are specified by an image template list. The list may +consist of explicit image names, wildcard templates, and @ files. A +"focus" value or values is associated with each image; though this may be +any numeric quantity (integer or floating point) and not just a focus. The +focus values may be specified in several ways. If each image has a focus +value recorded in the image header, the keyword name may be specified. If +the images consists of multiple exposures the \fIfstep\fR parameter would +specify a second image header keyword (or constant value) giving the +focus increment per exposure. + +The focus values may also be specified as a range list +as described in the help topic \fBranges\fR. This consists of +individual values, ranges of values, a starting value and a step, and a +range with a step. The elements of the list are separated by commas, +ranges are separated by hyphens, and a step is indicated by the character +'x'. Long range lists, such as a list of individual focus values, may be +placed in a file and specified with the @ convention. The +assignment of a focus value from a list depends on whether the images +are single or multiple exposure as specified by the \fInexposure\fR +parameter. Single exposure images are assigned focus values from the +list in the order in which the images and focus values are given. If +the images are multiple exposure focus frames in which each offset exposure +has a different focus, the focus values from the list are assigned in +order to the multiple exposures and if there are multiple images the +assignments are repeated. + +For a simple sequence of a starting focus value and focus increment, +either for multiple single exposure images or multiple exposure +images the \fIfocus\fR and \fIfstep\fR parameters by be used +togther as single values or image header keywords. Note that if +\fIfstep\fR is specified then the focus parameter is NOT interpreted +as a list. + +There are two common ways of doing focus sequences. One is to take an +exposure at each focus value. In this case the parameter \fInexposure\fR +is given the value 1. The second is to take an image with multiple +exposures where the objects in the image are shifted between exposures and +the focus is changed. In this case \fInexposure\fR is greater than 1 and +other parameters are used to specify the shift size and direction. The +\fInexposure\fR parameter may be a number of an image header keyword. + +Currently the task allows only multiple exposure shifts along either the +column or line dimension and the shifts must be the same between each +exposure except that there may be a double shift at either end of the +sequence. The shift magnitude, in pixels, is specified as either a number +or image header keyword. The shift direction is given by the +\fIdirection\fR parameter. It is specified relative to the image; i.e. it +need not be the same as the physical shifts of the telescope or detector +but depends on how the image was created. Steps in which the object +positions decrease in column or line are specified with a leading minus and +those which increase with a leading plus. The step is specified as a +positive number of pixels between exposures. Often a double shift is made +at the beginning or end of the sequence. If this is done the \fIgap\fR +parameter is used to identify which end the gap is on. Note that one may +change the sense of the exposure sequence from that used to make the focus +frame by properly adjust the direction, the gap, the focus list, and which +object is marked as the start of the sequence. + +Identifying the object or objects to be measured may be accomplished in +several ways. If a single object near the center of the image is to be +measured then the \fIcoords\fR parameter takes the value "center". This +may be used with multiple exposure focus frames if the first exposure of +the object sequence is at the center. When the "center" option is used +the \fIdisplay\fR and \fIimagecur\fR parameters are ignored. + +If there are multiple objects or the desired object is not at the center of +the frame the object coordinates are entered with the \fIimagecur\fR +parameter. This type of coordinate input is selected by specifying either +"mark1" or "markall" for the \fIcoords\fR parameter. If the value is +"mark1" then the coordinates are entered for the first image and the same +values are automatically used for subsequent images. If "markall" is +specified then the objects in each image are marked. + +Normally the \fIimagecur\fR parameter would select the interactive image +display cursor though a standard cursor file could be used to make this +part noninteractive. When the image display cursor is used either the +image must be displayed previously by the user, or the task may be allowed +to load the image display using the \fBdisplay\fR task by setting the +parameter \fIdisplay\fR to yes and \fIframe\fR to a display frame. If yes +the image display must be active. The task will look at the image names as +stored in the image display and only load the display if needed. + +If one wants to enter a coordinate list rather than use the interactive +image cursor the list can consist of just the column and line coordinates +since the key will default to 'm'. To finish the list either the end +of file may be encountered or a single 'q' may be given since the +coordinates are irrelevant. For the "markall" option with multiple +images there would need to be a 'q' at the end of each object except +possibly the last. + +When objects are marked interactively with the image cursor there +are a four keys which may be used as shown in the CURSOR COMMAND section. +The important distinction is between 'm' to mark and measure an +object and 'g' to mark, measure, and graph the results. The former +accumulates the results until the end while the latter can give an +immediate result to be examined. Unless only one object is marked +the 'g' key also accumulates the results for later graphical analysis. +It is important to note that the measurements are done as each +object is marked so there can be a significant delay before the +next object may be marked. + +The quantities measured and the algorithms used are described in the +ALGORITHMS section. Once all the objects have been measured an +interactive (unless only one object is measured) graphical presentation +of the measurements is entered. + +When the task exits it prints the results to the terminal (STDOUT) +and also to the \fIlogfile\fR if one is specified. The results may +also be previewed during the execution of the task with the +":show" command. The results begin with a banner and the overall +estimate of the best focus and PSF size. If there are multiple +stars measured at multiple focus values the best focus estimate +for each star is printed. The star is identified by it's position +(the starting position for multiple exposure images). The average +size, relative magnitude, and best focus estimate are then given. +If there are multiple focus values the average of the +PSF size over all objects at each focus are listed next. +Finally, the individual measurements are given. The columns +give the image name, the column and line position, the relative +magnitude, the focus value, the PSF size as either the enclosed +flux radius or the FWHM, the ellipticity, the position angle, and +an indication of saturation. +.ih +ALGORITHMS +The PSF of an object is characterized using a radially symmetric +enclosed flux profile. First the center of the object is determined from +an initial rough coordinate. The center is computed from marginal profiles +which are sums of lines or columns centered at the initial coordinate and +with a width given by the sum of the \fIradius\fR, \fIsbuffer\fR, and +\fIswidth\fR parameters. The mean of the marginal profile is determined +and then the centroid of the profile above this is computed. The centroids +from the two marginal profiles define a new object center. These steps of +forming the marginal profiles centered at the estimated object position and +then computing the centroids are repeated until the centroids converge or +three iterations have been completed. + +Next a background is determined from the mode of the pixel values in the +sky annulus defined by the object center and \fIradius\fR, \fIsbuffer\fR, +and \fIswidth\fR parameters. The pixel values in the annulus are sorted +and the mode is estimated as the point of minimum slope in this sorted +array using a width of 5% of the number of points. If there are multiple +regions with the same minimum slope the lowest pixel value is used. + +The background subtracted enclosed flux profile is determined next. +To obtain subpixel precision and to give accurate estimates for small +widths relative to the pixel sampling, several things are done. +First interpolation between pixels is done using a cubic spline surface. +The radii measured are in subpixel steps. To accommodate small and +large PSF widths (and \fIradius\fR parameters) the steps are nonuniform +with very fine steps at small radii (steps of 0.05 pixels in the +central pixel) and coarser steps at larger radii (beyond 9 pixels +the steps are one pixel) out to the specified \fIradius\fR. Similarly each +pixel is subsampled finely near the center and more coarsely at larger +distances from the object center. Each subpixel value, as obtained by +interpolation, is background subtracted and added into the enclosed flux +profile. Even with subpixel sampling there is still a point where a +subpixel straddles a particular radius. At those points the fraction of +the subpixel dimension in radius falling within the radius being measured +is used as the fraction of the pixel value accumulated. + +Because of errors in the background determination due to noise and +contaminating objects it is sometimes the case that the enclosed flux +is not completely monotonic with radius. The enclosed flux +normalization, and the magnitude used in plots and reported in +results, is the maximum of the enclosed flux profile even if it +occurs at a radius less than the maximum radius. It is possible +to change the normalization and subtract or add a background correction +interactively. + +Because a very narrow PSF will produce significant errors in the cubic +spline interpolation due to the steepness and rapid variation in the pixel +values near the peak, the Gaussian profile with FWHM that encloses the same +80% of the flux is computed as: + + FWHM(80%) = 2 * r(80%) * sqrt (ln(2) / (ln (1/.2))) + +If this is less than five pixels the Gaussian model is subtracted from the +data. The Gaussian normalization is chosed to perfectly subtract the +central pixel. The resulting subtraction will not be perfect but the +residual data will have much lower amplitudes and variations. A spline +interpolation is fit to this residual data and the enclosed flux profile is +recomputed in exactly the same manner as previously except the subpixel +intensity is evaluated as the sum of the analytic Gaussian and the +interpolation to the residual data. + +The Gaussian normalization is chosed to perfectly subtract the central +pixel. The resulting subtraction will not be perfect but the residual data +will have much lower amplitudes and variations. A spline interpolation is +fit to this residual data and the enclosed flux profile is recomputed in +exactly the same manner as previously except the subpixel intensity is +evaluated as the sum of the analytic Gaussian and the interpolation to the +residual data. This technique yields accurate FWHM for simulated Gaussian +PSFs down to at least a FWHM of 1 pixel. + +In addition to the enclosed flux profile, an estimate of the radially +symmetric intensity profile is computed from the enclosed flux profile. +This is based on the equation + +.nf + F(R) = integral from 0 to R { P(r) r dr } +.fi + +where F(R) is the enclosed flux at radius R and P(r) is the intensity per +unit area profile. Thus the derivative of F(R) divided by R gives an +estimate of P(R). + +Cubic spline interpolation functions are fit to the normalized enclosed +flux profile and the intensity profile. These are used to find the radius +enclosing any specified fraction of the flux and to find the direct FWHM of +the intensity profile. These are output when \fIsize\fR is "Radius" or +"FWHM" respectively. + +In addition to enclosed flux radius and direct FWHM size measurements +there are also two size measurements based on fitting analytic profiles. +A Gaussian profile and a Moffat profile are fit to the final enclosed flux +profile to the points with enclosed flux less than 80%. The limit is +included to minimize the effects of poor background values and to make the +profile fit be representative of the core of the PSF profile. These profiles +are fit whether or not the selected \fIsize\fR requires it. This is done +for simplicity and to allow quickly changing the size estimate with the +":size" command. + +The intensity profile functions (with unit peak) are: + +.nf + I(r) = exp (-0.5 * (r/sigma)**2) Gaussian + I(r) = (1 + (r/alpha)**2)) ** (-beta) Moffat +.fi + +with parameters sigma, alpha, and beta. The normalized enclosed flux +profiles, which is what is actually fit, are then: + +.nf + F(r) = 1 - exp (-0.5 * (r/sigma)**2) Gaussian + F(r) = 1 - (1 + (r/alpha)**2)) ** (1-beta) Moffat +.fi + +The fits determine the parameters sigma or alpha and beta (if a +beta value is not specified by the users). The reported FWHM values +are given by: + +.nf + GFWHM = 2 * sigma * sqrt (2 * ln (2)) Gaussian + MFWHM = 2 * alpha * sqrt (2 ** (1/beta) - 1) Moffat +.fi + +were the units are adjusted by the pixel scale factor. + +In addition to the four size measurements there are several additional +quantities which are determined. +Other quantities which are computed are the relative magnitude, +ellipticity, and position angle. The magnitude of an individual +measurement is obtained from the maximum flux attained in the enclosed +flux profile computation. Though the normalization and background may be +adjusted interactively later, the magnitude is not changed from the +initial determination. The relative magnitude of an object is then +computed as + +.nf + rel. mag. = -2.5 * log (object flux / maximum star flux) +.fi + +The maximum star magnitude over all stars is used as the zero point for the +relative magnitudes (hence it is possible for an individual object relative +magnitude to be less than zero). + +The ellipticity and positional angle of an object are derived from the +second central intensity weighted moments. The moments are: + +.nf + Mxx = sum { (I - B) * x * x } / sum { I - B } + Myy = sum { (I - B) * y * y } / sum { I - B } + Mxy = sum { (I - B) * x * y } / sum { I - B } +.fi + +where x and y are the distances from the object center, I is +the pixel intensity and B is the background intensity. The sum is +over the same subpixels used in the enclosed flux evaluation with +intensities above an isophote which is slightly above the background. +The ellipticity and position angles are derived from the moments +by the equations: + +.nf + M1 = (Mxx - Myy) / (Mxx + Myy) + M2 = 2 * Mxy / (Mxx + Myy) + ellip = (M1**2 + M2**2) ** 1/2 + pa = atan (M2 / M1) / 2 +.fi + +where ** is the exponentiation operator and atan is the arc tangent +operator. The ellipticity is essentially (a - b) / (a + b) where a +is a major axis scale length and b is a minor axis scale length. A +value of zero corresponds to a circular image. The position angle is +given in degrees counterclockwise from the x or column axis. + +The overall size when there are multiple stars is estimated by averaging +the individual sizes weighted by the flux of the star as described above. +Thus, when there are multiple stars, the brighter stars are given greater +weight in the average size. This average size is what is given in the +banner for the graphs and in the printed output. + +One of the quantities computed for the graphical analysis is the +FWHM of a Gaussian or Moffat profile that encloses the same flux +as the measured object as a function of the level. The equation are: + +.nf + FWHM = 2 * r(level) * sqrt (ln(2.) / ln (1/(1-level))) Gaussian + + FWHM = 2 * r(level) * sqrt (2**(1/beta)-1) / + sqrt ((1-level)**(1/(1-beta))-1) Moffat +.fi + +where r(level) is the radius that encloses "level" fraction of the total +flux. ln is the natural logarithm and sqrt is the square root. The beta +value is either the user specified value or the value determined by fitting +the enclosed flux profile. + +This function of level will be a constant if the object profile matches +the Gaussian or Moffat profile. Deviations from a constant show +the departures from the profile model. The Moffat profile used in making +the graphs except for the case where the \fIsize\fR is GFWHM. + +The task estimates a value for the best focus and PSF size at that focus +for each star. This is done by finding the minimum size at each focus +value (in case there are multiple measurements of the same star at the same +focus), sorting them by focus value, finding the focus value with the +minimum size, and parabolically interpolating using the nearest focus +values on each side. When the minimum size occurs at either extreme of the +focus range the best focus is at that extreme focus; in other words there +is no extrapolation outside the range of focus values. + +The overall best focus and size when there are multiple stars are estimated +by averaging the best focus values for each star weighted by the +average flux of the star as described above. Thus, when there are +multiple stars, the brighter stars are given greater weight in the +overall best average focus and size. This best average focus and +size are what are given in the banner for the graphs and in the +printed output. + +The log output also includes an average PSF size for all measurements +at a single focus value. This average is also weighted by the +average flux of each star at that focus. +.ih +INTERACTIVE GRAPHICS MODE +The graphics part of \fBstarfocus\fR consists of a number of different +plots selected by cursor keys. The available plots depend on the +number of stars and the number of focus values. The various plots +and the keys which select them are summarized below. + +.nf +a Spatial plot at a single focus +b Spatial plot of best focus values +e Enclosed flux for stars at one focus and one star at all focus +f Size and ellipticity vs focus for all data +m Size and ellipticity vs relative magnitude at one focus +p Radial profiles for stars at one focus and one star at all focus +t Size and ellipticity vs radius from field center at one focus +z Zoom to a single measurement +.fi + +If there is only one object at a single focus the only available plot is +the 'z' or zoom plot. This has three graphs; a graph of the normalized +enclosed flux verses scaled radius, a graph of the intensity profile verses +scaled radius, and equivalent Moffat/Gaussian full width at half maximum verses +enclosed flux fraction. The latter two graphs are derived from the +normalized enclosed flux profile as described in the ALGORITHMS section. +In the graphs the measured points are shown with symbols, a smooth curve is +drawn through the symbols and dashed lines indicate the measurement level +and enclosed flux radius at that level. + +Overplotted on these graphs are the Moffat profile fit or the +Gaussian profile fit when \fIsize\fR is GFWHM. + +The zoom plot is always available from any other plot. The cursor position +when the 'z' key is typed selects a particular object measurement. +This plot is also the one presented with the 'g' key when marking objects for +single exposure images. In that case the graphs are drawn followed by +a return to image cursor mode. + +There are three types of symbol plots showing the measured PSF size (either +enclosed flux radius or FWHM) and ellipticity. These plot the measurements +verses focus ('f' key), relative magnitude ('m' key), and radius from the +field center ('t' key). The focus plot includes all measurements and shows +dashed lines at the estimated best focus and size. This plot is only +available when there are multiple focus values. It is the initial plot in +this case for both the 'g' key when there are multiple exposures and when +the graphical analysis stage is entered after defining the objects. + +The magnitude and field radius plots are only available when there are +multiple objects measured. The relative magnitude used for a particular +measurement is the average magnitude of the star over all focus values and +not the individual object magnitude. The data shown is for a single focus +value. The focus value is selected when typing 'm' or 't' by the focus of +the nearest object to the cursor in the preceding plot. When in one of +these plots, other focus values may be shown by typing , the space +bar. This scrolls through the focus values. The field center for the +field radius graph may be changed interactively using the ":xcenter" and +":ycenter" commands. + +Grids of enclosed flux vs. radius, intensity profile vs. radius, and +FWHM vs. enclosed flux fraction are shown with the 'e', 'p', and +'g' keys respectively. If there are multiple objects at multiple focus +values there are two grids. One grid is all objects at one focus and the +other is one object at all focuses. The titles identify the object (by +location) and focus. The profiles in the grids have no axis labels or +ticks. Within each box are the coordinates of the object or the focus +value, and the PSF size are given. When there is only one object at +multiple focus values or multiple objects at only one focus value then +there is only one grid and a graph of a one object. The single object +graph does have axis labels and ticks. + +In the grids there is one profile which is highlighted (by a second +box or by a color border). The highlighted profile is the current +object. To change the current object, and thus change either +the contents of the other grid or the single object graphed, one +can type the space bar to advance to the next object or +use the cursor and the 'e', 'p', or 'g' key again. Other keys +will select another plot using the object nearest the cursor to select +a focus or object. + +Any of the graphs with enclosed flux or intensity profiles vs radius may +have the profiles of the object with the smallest size overplotted. The +overplot has a dashed line, a different color on color graphics devices, +and no symbols marking the measurement points. The overplots may be +enabled or disabled with the ":overplot" command. Initially it is +disabled. + +The final plots give a spatial representation. These require more than one +object. The 'a' key gives a spatial plot at a single focus. The space bar +can be used to advance to another focus. This plot has a central graph of +column and line coordinates with symbols indicating the position of an +object. The objects are marked with a circle (when plotted at unit aspect +ratio) whose size is proportional to the measured PSF size. In addition an +optional asterisk symbol with size proportional to the relative +brightness of the object may be plotted. This symbol is toggled with the +'s' key. On color displays the circles may have two colors, one if object +size is above the average best size and the other if the size is below the +best size. The purpose of this is to look for a spatial pattern in the +smallest PSF sizes. + +Adjacent to the central graph are graphs with column or line as one +coordinate and radius or ellipticity as the other. The symbols +are the same as described previously. These plots can show spatial +gradients in the PSF size and shape across the image. + +The 'b' key gives a spatial plot of the best focus estimates for each +object. This requires multiple objects and multiple focus values. +As discussed previously, given more than one focus a best focus +value and size at the best focus is computed by parabolic interpolation. +This plot type shows the object positions in the same way as the 'a' +plot except that the radius is the estimated best radius. Instead +of adjacent ellipticity plots there are plots of best focus verses +columns and lines. Also the two colors in the symbol plots are +selected depending on whether the object's best focus estimate is +above or below the overall best focus estimate. This allows seeing +spatial trends in the best focus. + +In addition to the keys which select plots there are other keys which +do various things. These are summarized below. + +.nf +? Page cursor command summary +d Delete star nearest to cursor +i Information about point nearest the cursor +n Normalize enclosed flux at x cursor position +o Offset enclosed flux by adjusting background +q Quit +r Redraw +s Toggle magnitude symbols in spatial plots +u Undelete all deleted points +x Delete nearest point, star, or focus (selected by query) + Step through different focus or stars in current plot type +.fi + +The help, redraw, and quit keys are provide the standard functions. +The 's' and space keys were described previously. The 'i' key +locates the nearest object to the cursor in whatever plot is shown and +prints one line of information about the object on the graphics device +status area. + +The 'd' key deletes the star nearest the cursor in whatever plot is +currently displayed. Deleting a star deletes all measurements of an object +at different focus values. To delete all objects from an image, all focus +values for one star (the same as 'd'), all objects at one focus, or a +single measurement, the 'x' key is used. Typing this key produces a query +for which type of deletion and the user responds with 'i', 's', 'f', or +'p'. The most common use of this is to delete all objects at the extreme +focus values. Deleted measurements do not appear in any subsequent +graphics, are excluded from all computations, and are not output in the +results. The 'u' key allows one to recover deleted measurements. This +undeletes all previously deleted data. + +Due to various sources of error the sky value may be wrong causing +the enclosed flux profile to not converge properly but instead +decreases beyond some point (overestimated sky) or linearly +increases with radius (underestimated sky). This affects the size +measurement by raising or lowering the normalization and altering +the shape of the enclosed flux profile. The 'n' and 'o' keys allow +fudging the enclosed flux profiles. These keys apply only in +the zoom plot of the enclosed flux profile or the case where +a single enclosed flux profile is shown with the 'e' key; in other +words plots of the enclosed flux which have axes labels. + +The 'n' key normalizes the enclosed flux profile at the point +set by the x position of the cursor. The 'o' key increases or +decreases the background estimate to bring curve up or down to +the point specified by the cursor. The effect of this is to +add or subtract a quadratic function since the number of pixels +at a particular radius varies as the square of the radius. +To restore the original profile, type 'n' or 'o' at a radius +less than zero. + +The colon commands, shown below, allow checking or changing parameters +initially set by the task parameters, toggling the overplotting of the +smallest PSF profiles, and showing the current results. The overplotting +option and the contents of the results displayed by :show were described +previously. + +.nf +:beta Beta parameter for Moffat fits +:level Level at which the size parameter is evaluated +:overplot Overplot the profiles from the narrowest profile? +:radius Change profile radius +:show Page all information for the current set of objects +:size Size type (Radius|FWHM) +:scale Pixel scale for size values +:xcenter X field center for radius from field center plots +:ycenter Y field center for radius from field center plots +.fi + +The important values which one might want to change interactively are +the measurement level and the profile radius. The measurement level +directly affects the results reported. When it is changed the sizes +of all object PSFs are recomputed and the displayed plots and title +information are updated. The profile radius is the +maximum radius shown in plots and used to set the enclosed flux normalization. +It does not affect the object centering or sky region definition and +evaluation which are done when the image data is accessed. Because +the objects are not remeasured from the image data the radius may +not be made larger than the radius defined by the task parameter though +it may be decreased and then increased again. +.ih +EXAMPLES +1. A multiple exposure frame is taken with 7 exposures of a bright +star, each exposure shifted by 50 pixels to lower line positions, with a +double gap at the end. The exposure pattern is typical of Kitt Peak and +the default values for the direction and gap position are applicable. The +default focus value numbering and measurements in pixels are also used. + +.nf +cl> starfocus focus1 nexp=7 step=50 + + + + + +NOAO/IRAF IRAFV2.10.3 valdes@puppis Wed 16:09:39 30-Jun-93 + Best focus of 4.12073 with FWHM (at 50% level) of 3.04 + + Image Column Line Mag Focus FWHM Ellip PA SAT + focus1 536.63 804.03 0.07 1. 13.878 0.06 -11 + 535.94 753.28 -0.11 2. 8.579 0.09 89 + 535.38 703.96 -0.08 3. 5.184 0.11 -87 + 537.12 655.36 -0.02 4. 3.066 0.07 -77 + 534.20 604.59 0.00 5. 4.360 0.10 74 + 534.41 554.99 -0.00 6. 9.799 0.09 -35 + 534.83 456.08 0.16 7. 12.579 0.13 -10 +.fi + +The estimated best focus is between the 4th and 5th focus setting +and the best focus FWHM is 3.04 pixels. + +Note that in more recent Kitt Peak multiple exposure focus images the +starting focus value, the focus step, the number of exposures, and +the shift are recorded in the image header with the keywords +FOCSTART, FOCSTEP, FOCNEXPO, and FOCSHIFT. Thus the task parameters +\fIfocus\fR, \fIfstep\fR, \fInexposures\fR, and \fIstep\fR may be +set to those names. However, rather than use \fBstarfocus\fR +one would use the more convenient \fBkpnofocus\fR. +.ih +SEE ALSO +.nf +imexamine, implot, kpnofocus, pprofile, pradprof, psfmeasure, radlist, +radplt, radprof, ranges, specfocus, splot +.endhelp diff --git a/noao/obsutil/src/findgain.cl b/noao/obsutil/src/findgain.cl new file mode 100644 index 00000000..0236627d --- /dev/null +++ b/noao/obsutil/src/findgain.cl @@ -0,0 +1,119 @@ +# FINDGAIN - calculate the gain and readnoise given two flats and two +# bias frames. Algorithm (method of Janesick) courtesy Phil Massey. +# +# flatdif = flat1 - flat2 +# biasdif = bias1 - bias2 +# +# e_per_adu = ((mean(flat1)+mean(flat2)) - (mean(bias1)+mean(bias2))) / +# ((rms(flatdif))**2 - (rms(biasdif))**2) +# +# readnoise = e_per_adu * rms(biasdif) / sqrt(2) +# +# In our implementation, `mean' may actually be any of `mean', +# `midpt', or `mode' as in the IMSTATISTICS task. + +procedure findgain (flat1, flat2, zero1, zero2) + +string flat1 {prompt="First flat frame"} +string flat2 {prompt="Second flat frame"} +string zero1 {prompt="First zero frame"} +string zero2 {prompt="Second zero frame"} + +string section = "" {prompt="Selected image section"} +string center = "mean" {prompt="Central statistical measure", + enum="mean|midpt|mode"} +int nclip = 3 {prompt="Number of clipping iterations"} +real lsigma = 4 {prompt="Lower clipping sigma factor"} +real usigma = 4 {prompt="Upper clipping sigma factor"} +real binwidth = 0.1 {prompt="Bin width of histogram in sigma"} +bool verbose = yes {prompt="Verbose output?"} + +string *fd + +begin + bool err + file f1, f2, z1, z2, lf1, lf2, lz1, lz2 + file flatdiff, zerodiff, statsfile + real e_per_adu, readnoise, m_f1, m_f2, m_b1, m_b2, s_fd, s_bd, junk + struct images + + # Temporary files. + flatdif = mktemp ("tmp$iraf") + zerodif = mktemp ("tmp$iraf") + statsfile = mktemp ("tmp$iraf") + + # Query parameters. + f1 = flat1 + f2 = flat2 + z1 = zero1 + z2 = zero2 + + lf1 = f1 // section + lf2 = f2 // section + lz1 = z1 // section + lz2 = z2 // section + + imarith (lf1, "-", lf2, flatdif) + imarith (lz1, "-", lz2, zerodif) + + printf ("%s,%s,%s,%s,%s,%s\n", + lf1, lf2, lz1, lz2, flatdif, zerodif) | scan (images) + imstat (images, fields=center//",stddev", lower=INDEF, upper=INDEF, + nclip=nclip, lsigma=lsigma, usigma=usigma, binwidth=binwidth, + format-, > statsfile) + imdelete (flatdif, verify-) + imdelete (zerodif, verify-) + + fd = statsfile + err = NO + if (fscan (fd, m_f1, junk) != 2) { + printf ("WARNING: Failed to compute statisics for %s\n", lf1) + err = YES + } + if (fscan (fd, m_f2, junk) != 2) { + printf ("WARNING: Failed to compute statisics for %s\n", lf2) + err = YES + } + if (fscan (fd, m_b1, junk) != 2) { + printf ("WARNING: Failed to compute statisics for %s\n", lz1) + err = YES + } + if (fscan (fd, m_b2, junk) != 2) { + printf ("WARNING: Failed to compute statisics for %s\n", lz1) + err = YES + } + if (fscan (fd, junk, s_fd) != 2) { + printf ("WARNING: Failed to compute statisics for %s - %s\n", + lf1, lf2) + err = YES + } + if (fscan (fd, junk, s_bd) != 2) { + printf ("WARNING: Failed to compute statisics for %s - %s\n", + lz1, lz2) + err = YES + } + fd = ""; delete (statsfile, verify-) + + if (err == YES) + error (1, "Can't compute gain and readout noise") + + e_per_adu = ((m_f1 + m_f2) - (m_b1 + m_b2)) / (s_fd**2 - s_bd**2) + readnoise = e_per_adu * s_bd / sqrt(2) + + # round to three decimal places + e_per_adu = real (nint (e_per_adu * 1000.)) / 1000. + readnoise = real (nint (readnoise * 1000.)) / 1000. + + # print results + if (verbose) { + printf ("FINDGAIN:\n") + printf (" center = %s, binwidth = %g\n", center, binwidth) + printf (" nclip = %d, lsigma = %g, usigma = %g\n", + nclip, lsigma, usigma) + printf ("\n Flats = %s & %s\n", lf1, lf2) + printf (" Zeros = %s & %s\n", lz1, lz2) + printf (" Gain = %5.2f electrons per ADU\n", e_per_adu) + printf (" Read noise = %5.2f electrons\n", readnoise) + } else + printf ("%5.2f\t%5.2f\n", e_per_adu, readnoise) +end diff --git a/noao/obsutil/src/mkpkg b/noao/obsutil/src/mkpkg new file mode 100644 index 00000000..d13fabbc --- /dev/null +++ b/noao/obsutil/src/mkpkg @@ -0,0 +1,31 @@ +# Make the OBSUTIL package + +$call relink +$exit + +update: + $call relink + $call install + ; + +relink: + $update libpkg.a + $omake x_obsutil.x + $link x_obsutil.o libpkg.a -lxtools -lcurfit -liminterp\ + -lsmw -lnlfit -lgsurfit -lds -lasttools -o xx_obsutil.e + ; + +install: + $move xx_obsutil.e noaobin$x_obsutil.e + ; + + +libpkg.a: + @ccdtime + @pairmass + @specfocus + @sptime + @starfocus + + t_bitcount.x + ; diff --git a/noao/obsutil/src/pairmass/airmass.x b/noao/obsutil/src/pairmass/airmass.x new file mode 100644 index 00000000..8e9c585d --- /dev/null +++ b/noao/obsutil/src/pairmass/airmass.x @@ -0,0 +1,23 @@ +include + +# AIRMASS -- Compute airmass from DEC, LATITUDE and HA + +# Airmass formulation from Allen "Astrophysical Quantities" 1973 p.125,133. +# and John Ball's book on Algorithms for the HP-45 + +double procedure airmass (ha, dec, lat) + +double ha, dec, lat, cos_zd, x + +define SCALE 750.0d0 # Atmospheric scale height + +begin + if (IS_INDEFD (ha) || IS_INDEFD (dec) || IS_INDEFD (lat)) + call error (1, "Can't determine airmass") + + cos_zd = sin(DEGTORAD(lat)) * sin(DEGTORAD(dec)) + + cos(DEGTORAD(lat)) * cos(DEGTORAD(dec)) * cos(DEGTORAD(ha*15.)) + x = SCALE * cos_zd + + return (sqrt (x**2 + 2*SCALE + 1) - x) +end diff --git a/noao/obsutil/src/pairmass/drawvector.x b/noao/obsutil/src/pairmass/drawvector.x new file mode 100644 index 00000000..770689d3 --- /dev/null +++ b/noao/obsutil/src/pairmass/drawvector.x @@ -0,0 +1,121 @@ +# DRAW_VECTOR -- Draw the projected vector to the screen. + +include +include + +procedure draw_vector (def_title, timesys, xvec, yvec, n, + xmin, xmax, ymin, ymax) + +char def_title[ARB] #I default plot title +char timesys[ARB] #I time system +real xvec[n], yvec[n] #I vectors to plot +int n #I npts in vectors +real xmin, xmax #I x vector min & max +real ymin, ymax #I y vector min & max + +pointer sp, gp +pointer device, marker, xlabel, ylabel, title, suffix +real wx1, wx2, wy1, wy2, vx1, vx2, vy1, vy2, szm, tol +int mode, imark +bool pointmode + +pointer gopen() +real clgetr() +bool clgetb(), streq() +int btoi(), clgeti() + +begin + call smark (sp) + call salloc (device, SZ_FNAME, TY_CHAR) + call salloc (marker, SZ_FNAME, TY_CHAR) + call salloc (xlabel, SZ_LINE, TY_CHAR) + call salloc (ylabel, SZ_LINE, TY_CHAR) + call salloc (title, SZ_LINE, TY_CHAR) + call salloc (suffix, SZ_FNAME, TY_CHAR) + + call clgstr ("device", Memc[device], SZ_FNAME) + mode = NEW_FILE + if (clgetb ("append")) + mode = APPEND + + gp = gopen (Memc[device], mode, STDGRAPH) + tol = 10. * EPSILONR + + if (mode != APPEND) { + # Establish window. + wx1 = clgetr ("wx1") + wx2 = clgetr ("wx2") + wy1 = clgetr ("wy1") + wy2 = clgetr ("wy2") + + # Set window limits to defaults if not specified by user. + if ((wx2 - wx1) < tol) { + wx1 = xmin + wx2 = xmax + } + + if ((wy2 - wy1) < tol) { + wy1 = ymin + wy2 = ymax + } + + call gswind (gp, wx1, wx2, wy1, wy2) + + # Establish viewport. + vx1 = clgetr ("vx1") + vx2 = clgetr ("vx2") + vy1 = clgetr ("vy1") + vy2 = clgetr ("vy2") + + # Set viewport only if specified by user. + if ((vx2 - vx1) > tol && (vy2 - vy1) > tol) + call gsview (gp, vx1, vx2, vy1, vy2) + else { + if (!clgetb ("fill")) + call gseti (gp, G_ASPECT, 1) + } + + call clgstr ("xlabel", Memc[xlabel], SZ_LINE) + call clgstr ("ylabel", Memc[ylabel], SZ_LINE) + call clgstr ("title", Memc[title], SZ_LINE) + + if (streq (Memc[title], "default")) + call strcpy (def_title, Memc[title], SZ_LINE) + if (streq (Memc[xlabel], "default")) { + call sprintf (Memc[xlabel], SZ_LINE, "%s Time") + call pargstr (timesys) + } + + call gseti (gp, G_XNMAJOR, clgeti ("majrx")) + call gseti (gp, G_XNMINOR, clgeti ("minrx")) + call gseti (gp, G_YNMAJOR, clgeti ("majry")) + call gseti (gp, G_YNMINOR, clgeti ("minry")) + + call gseti (gp, G_ROUND, btoi (clgetb ("round"))) + + if (clgetb ("logx")) + call gseti (gp, G_XTRAN, GW_LOG) + if (clgetb ("logy")) + call gseti (gp, G_YTRAN, GW_LOG) + + # Draw axes using all this information. + call glabax (gp, Memc[title], Memc[xlabel], Memc[ylabel]) + } + + pointmode = clgetb ("pointmode") + if (pointmode) { + call clgstr ("marker", Memc[marker], SZ_FNAME) + szm = clgetr ("szmarker") + call init_marker (Memc[marker], imark) + } + + # Now to actually draw the plot. + if (pointmode) + call gpmark (gp, xvec, yvec, n, imark, szm, szm) + else + call gpline (gp, xvec, yvec, n) + + call gflush (gp) + call gclose (gp) + call sfree (sp) +end diff --git a/noao/obsutil/src/pairmass/initmarker.x b/noao/obsutil/src/pairmass/initmarker.x new file mode 100644 index 00000000..c506ecbb --- /dev/null +++ b/noao/obsutil/src/pairmass/initmarker.x @@ -0,0 +1,39 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include + +# INIT_MARKER -- Returns integers code for marker type string. + +procedure init_marker (marker, imark) + +char marker[SZ_FNAME] # Marker type as a string +int imark # Integer code for marker - returned + +bool streq() + +begin + if (streq (marker, "point")) + imark = GM_POINT + else if (streq (marker, "box")) + imark = GM_BOX + else if (streq (marker, "plus")) + imark = GM_PLUS + else if (streq (marker, "cross")) + imark = GM_CROSS + else if (streq (marker, "circle")) + imark = GM_CIRCLE + else if (streq (marker, "hebar")) + imark = GM_HEBAR + else if (streq (marker, "vebar")) + imark = GM_VEBAR + else if (streq (marker, "hline")) + imark = GM_HLINE + else if (streq (marker, "vline")) + imark = GM_VLINE + else if (streq (marker, "diamond")) + imark = GM_DIAMOND + else { + call eprintf ("Unrecognized marker type, using 'box'\n") + imark = GM_BOX + } +end diff --git a/noao/obsutil/src/pairmass/mkpkg b/noao/obsutil/src/pairmass/mkpkg new file mode 100644 index 00000000..bfc564e5 --- /dev/null +++ b/noao/obsutil/src/pairmass/mkpkg @@ -0,0 +1,19 @@ +# Make the PAIRMASS task. + +$checkout libpkg.a ../ +$update libpkg.a +$checkin libpkg.a ../ +$exit + +standalone: + $update libpkg.a + $omake x_pairmass.x + $link x_pairmass.o libpkg.a -lxtools -lasttools -o xx_pairmass.e + ; + +libpkg.a: + airmass.x + drawvector.x + initmarker.x + t_pairmass.x + ; diff --git a/noao/obsutil/src/pairmass/pairmass.par b/noao/obsutil/src/pairmass/pairmass.par new file mode 100644 index 00000000..1b0f28d6 --- /dev/null +++ b/noao/obsutil/src/pairmass/pairmass.par @@ -0,0 +1,40 @@ +ra,r,h,,0.,24.,Right Ascension of the object +dec,r,h,,-90.,90.,Declination of the object +epoch,r,h,INDEF,,,Epoch of the coordinates + +year,i,h,,,,Year of the observation +month,i,h,,1,12,Numerical month specification +day,i,h,,1,31,Day of the month + +observatory,s,h,"observatory",,,Observatory + +timesys,s,h,"Standard","|Universal|Standard|Siderial|",,Time system +resolution,r,h,4,0.25,,Number of UT points per hour +listout,b,h,no,,,"List, rather than plot, the airmass vs. UT" + +wx1,r,h,-7.,,,left user x-coord if not autoscaling +wx2,r,h,7.,,,right user x-coord if not autoscaling +wy1,r,h,0.,,,lower user y-coord if not autoscaling +wy2,r,h,5.,,,upper user y-coord if not autoscaling +pointmode,b,h,no,,,plot points instead of lines +marker,s,h,"box",\ + "point|box|plus|cross|circle|hebar|vebar|hline|vline|diamond",\ + ,point marker character +szmarker,r,h,5E-3,,,marker size (0 for list input) +logx,b,h,no,,,log scale x-axis +logy,b,h,no,,,log scale y-axis +xlabel,s,h,"default",,,x-axis label +ylabel,s,h,"Airmass",,,y-axis label +title,s,h,"default",,,title for plot +vx1,r,h,0.,,,left limit of device window (ndc coords) +vx2,r,h,0.,,,right limit of device window (ndc coords) +vy1,r,h,0.,,,bottom limit of device window (ndc coords) +vy2,r,h,0.,,,upper limit of device window (ndc coords) +majrx,i,h,5,,,number of major divisions along x grid +minrx,i,h,5,,,number of minor divisions along x grid +majry,i,h,5,,,number of major divisions along y grid +minry,i,h,5,,,number of minor divisions along y grid +round,b,h,no,,,round axes to nice values +fill,b,h,yes,,,fill device viewport regardless of aspect ratio? +append,b,h,no,,,append to existing plot +device,s,h,"stdgraph",,,output device diff --git a/noao/obsutil/src/pairmass/t_pairmass.x b/noao/obsutil/src/pairmass/t_pairmass.x new file mode 100644 index 00000000..7b9294a1 --- /dev/null +++ b/noao/obsutil/src/pairmass/t_pairmass.x @@ -0,0 +1,112 @@ +# PAIRMASS -- plot the airmass for a given RA & Dec on a given date. + +procedure t_pairmass() + +pointer sp, observat, timesys, ut, air, title +pointer obs +double ra, dec, epoch, ra0, dec0, epoch0 +double longitude, latitude, zone, st, ha, utd, resolution +int day, month, year, nsteps, i, tsys +real amin, amax + +pointer obsopen() +double clgetd(), obsgetd(), ast_mst(), airmass() +bool clgetb() +int clgeti(), clgwrd() + +begin + call smark (sp) + call salloc (observat, SZ_FNAME, TY_CHAR) + call salloc (timesys, SZ_FNAME, TY_CHAR) + + ra0 = clgetd ("ra") + dec0 = clgetd ("dec") + epoch0 = clgetd ("epoch") + + year = clgeti ("year") + month = clgeti ("month") + day = clgeti ("day") + + # Set time to plot. + tsys = clgwrd ("timesys", Memc[timesys], SZ_FNAME, + "|Universal|Standard|Siderial|") + + # Get observatory information. + call clgstr ("observatory", Memc[observat], SZ_FNAME) + obs = obsopen (Memc[observat]) + #call obslog (obs, "PAIRMASS", "latitude longitude timezone", STDOUT) + call obsgstr (obs, "name", Memc[observat], SZ_FNAME) + longitude = obsgetd (obs, "longitude") + latitude = obsgetd (obs, "latitude") + zone = obsgetd (obs, "timezone") + call obsclose (obs) + + resolution = clgetd ("resolution") + nsteps = nint (24 * resolution) + 1 + + call salloc (ut, 3*nsteps, TY_REAL) + call salloc (air, 3*nsteps, TY_REAL) + call salloc (title, SZ_LINE, TY_CHAR) + + call ast_date_to_epoch (year, month, day, 12.d0, epoch) + call ast_precess (ra0, dec0, epoch0, ra, dec, epoch) + + do i = 1, nsteps { + utd = (i-1) / resolution + call ast_date_to_epoch (year, month, day, utd, epoch) + st = ast_mst (epoch, longitude) + ha = st - ra + + switch (tsys) { + case 1: + Memr[ut+i-1] = utd + case 2: + if (utd < zone) + Memr[ut+i-1] = utd - zone + 24 + else + Memr[ut+i-1] = utd - zone + case 3: + Memr[ut+i-1] = st + } + Memr[air+i-1] = real (airmass (ha, dec, latitude)) + + Memr[ut+i-1+nsteps] = Memr[ut+i-1] - 24 + Memr[ut+i-1+2*nsteps] = Memr[ut+i-1] + 24 + Memr[air+i-1+nsteps] = Memr[air+i-1] + Memr[air+i-1+2*nsteps] = Memr[air+i-1] + } + call xt_sort2 (Memr[ut], Memr[air], 3*nsteps) + call alimr (Memr[air], 3*nsteps, amin, amax) + + call sprintf (Memc[title], SZ_LINE, + "Airmass for %d/%d/%d\n%s\nRA=%h, Dec=%h (%g)") + call pargi (month) + call pargi (day) + call pargi (year) + call pargstr (Memc[observat]) + call pargd (ra0) + call pargd (dec0) + call pargd (epoch0) + + if (clgetb ("listout")) { + call printf ("%s\nTime System=%s\n\n") + call pargstr (Memc[title]) + call pargstr (Memc[timesys]) + amax = clgetd ("wy2") + if (amax < 1) + amax = 5 + do i = 1, 3*nsteps { + if (Memr[ut+i-1] < 0. || Memr[ut+i-1] >= 24.) + next + if (Memr[air+i-1] > amax) + next + call printf ("%6.0m\t%8.4f\n") + call pargr (Memr[ut+i-1]) + call pargr (Memr[air+i-1]) + } + } else + call draw_vector (Memc[title], Memc[timesys], Memr[ut], Memr[air], + 3*nsteps, 0., 24., amin, amax) + + call sfree (sp) +end diff --git a/noao/obsutil/src/pairmass/x_pairmass.x b/noao/obsutil/src/pairmass/x_pairmass.x new file mode 100644 index 00000000..82f80509 --- /dev/null +++ b/noao/obsutil/src/pairmass/x_pairmass.x @@ -0,0 +1 @@ +task pairmass = t_pairmass diff --git a/noao/obsutil/src/shutcor.cl b/noao/obsutil/src/shutcor.cl new file mode 100644 index 00000000..473615fb --- /dev/null +++ b/noao/obsutil/src/shutcor.cl @@ -0,0 +1,120 @@ +# SHUTCOR - calculate the shutter correction for a detector given +# a sequence of overscan corrected flats of varying durations. The +# shutter correction is the intercept on a plot of exposure duration +# versus exposure level. Notion courtesy Phil Massey. + +procedure shutcor (images) + +string images {prompt="Overscan corrected images"} +string section = "[*,*]" {prompt="Image section for statistics"} +string center = "mode" {prompt="Central statistical measure", + enum="mean|midpt|mode"} +int nclip = 3 {prompt="Number of clipping iterations"} +real lsigma = 4 {prompt="Lower clipping sigma factor"} +real usigma = 4 {prompt="Upper clipping sigma factor"} +string exposure = "exptime" {prompt="Header keyword for the exposure time"} +bool verbose = yes {prompt="Verbose output?"} + +string *list + +begin + string limages, img, imglist, statlist, explist, tmplist + real exp, shutcorr, shutcorr_err + real slope, slope_err, intercept, intercept_err + int nstat, nexp, junk + struct tmp + + cache sections + + limages = images + + imglist = mktemp ("tmp$tmp") + statlist = mktemp ("tmp$tmp") + explist = mktemp ("tmp$tmp") + tmplist = mktemp ("tmp$tmp") + + sections (limages, option="fullname", > imglist) + if (sections.nimages < 4) { + printf ("You need a minimum of four images!\n") + delete (imglist, ver-, >& "dev$null") + return + } + + hselect ("@"//imglist, "$I,"//exposure//",overscan", yes, > tmplist) + list = tmplist + while (fscan (list, img, exp, tmp) != EOF) { + if (strlen (tmp) == 0) { + printf ("%s is not overscan corrected! (Check with ccdlist)\n", + img) + delete (imglist, ver-, >& "dev$null") + delete (tmplist, ver-, >& "dev$null") + return + } + if (exp <= 0) { + printf ("%s has zero exposure time!\n", + img) + delete (imglist, ver-, >& "dev$null") + delete (tmplist, ver-, >& "dev$null") + return + } + } + + list = ""; delete (tmplist, ver-, >& "dev$null") + + hselect ("@"//imglist, "$I,flatcor", yes, > tmplist) + list = tmplist + while (fscan (list, img, tmp) != EOF) + if (strlen (tmp) != 0) + printf ("%s is flat fielded\n", img) + + list = ""; delete (tmplist, ver-, >& "dev$null") + + imstatistics ("@"//imglist, fields=center, + lower=INDEF, upper=INDEF, nclip=nclip, lsigma=lsigma, + usigma=usigma, binwidth=0.1, format-, > statlist) + + hselect ("@"//imglist, exposure, yes, > explist) + delete (imglist, ver-, >& "dev$null") + + count (statlist) | scan (nstat) + count (explist) | scan (nexp) + + if (nstat != nexp) { + printf ("Problem matching statistics with exposure times!\n") + delete (statlist, ver-, >& "dev$null") + delete (explist, ver-, >& "dev$null") + return + } + + join (explist, statlist, output="STDOUT", delim=" ", missing="INDEF", + shortest+, verbose-) | polyfit ("STDIN", 1, weighting="uniform", + verbose=verbose, listdata-, > tmplist) + + delete (explist, ver-, >& "dev$null") + delete (statlist, ver-, >& "dev$null") + + list = tmplist + junk = fscan (list, intercept, slope) + junk = fscan (list, intercept_err, slope_err) + list = "" + + shutcorr = intercept / slope + shutcorr_err = abs (shutcorr) * + sqrt ((intercept_err/intercept)**2 + (slope_err/slope)**2) + + if (verbose) + printf ("\n") + + printf ("Shutter correction = %.3f +/- %.3f seconds\n", + shutcorr, shutcorr_err) + + if (verbose) { + printf ("\nInformation about the %s versus %s fit:\n\n", + center, exposure) + printf (" intercept slope (and errors)\n") + printf ("!sed 's+^+ +' %s\n", osfn(tmplist)) | cl + printf ("\n") + } + + delete (tmplist, ver-, >& "dev$null") +end diff --git a/noao/obsutil/src/specfocus/Revisions b/noao/obsutil/src/specfocus/Revisions new file mode 100644 index 00000000..3104b9f7 --- /dev/null +++ b/noao/obsutil/src/specfocus/Revisions @@ -0,0 +1,9 @@ +.help revisions Nov01 obsutil +.nf +spfgraph.x + Fixed case where if the average of the minimum and maximum focus values + is zero then a floating divide by zero would occur. (2/14/97, Valdes) + +t_specfocus.x + Fixed bug in interpreting the focus parameter. (6/26/95, Valdes) +.endhelp diff --git a/noao/obsutil/src/specfocus/mkpkg b/noao/obsutil/src/specfocus/mkpkg new file mode 100644 index 00000000..c41d9a34 --- /dev/null +++ b/noao/obsutil/src/specfocus/mkpkg @@ -0,0 +1,19 @@ +# Make the SPECFOCUS task. + +$checkout libpkg.a ../ +$update libpkg.a +$checkin libpkg.a ../ +$exit + +standalone: + $update libpkg.a + $omake x_specfocus.x + $link x_specfocus.o libpkg.a -lxtools -lcurfit -liminterp\ + -o xx_specfocus.e + ; + +libpkg.a: + spfgraph.x specfocus.h + t_specfocus.x specfocus.h \ + + ; diff --git a/noao/obsutil/src/specfocus/specfocus.h b/noao/obsutil/src/specfocus/specfocus.h new file mode 100644 index 00000000..d79f7c6e --- /dev/null +++ b/noao/obsutil/src/specfocus/specfocus.h @@ -0,0 +1,33 @@ +# Data structures for SPECFOCUS + +define SZ_SFFNAME 79 # Length of file names +define LEN_SF 54 # Length of image data structure + +define SF_IMAGE Memc[P2C($1)] # Image name +define SF_FOCUS Memr[P2R($1+40)] # Focus +define SF_WIDTH Memr[P2R($1+41)] # Width +define SF_LEVEL Memr[P2R($1+42)] # Level of width +define SF_AXIS Memi[$1+43] # Dispersion axis +define SF_X1 Memi[$1+44] # Start of dispersion sampling +define SF_DX Memi[$1+45] # Dispersion sampling step +define SF_NX Memi[$1+46] # Number of dispersion samples +define SF_Y1 Memi[$1+47] # Start of cross-dispersion sampling +define SF_DY Memi[$1+48] # Cross-dispersion sampling step +define SF_NY Memi[$1+49] # Number of cross-dispersion samples +define SF_SFD Memi[$1+50] # Pointer to data structures +define SF_NSFD Memi[$1+51] # Number of data structures +define SF_DATA Memi[$1+52] # Pointer to spectrum data +define SF_NPIX Memi[$1+53] # Number of pixels per spectrum + +define LEN_SFD 8 # Length of spectrum data structure + +define SF_X Memr[P2R($1)] # Dispersion axis coordinate +define SF_Y Memr[P2R($1+1)] # Spatial axis coordinate +define SF_SPEC Memi[$1+2] # Pointer to spectrum +define SF_ASI Memi[$1+3] # Pointer to correlation profile +define SF_FOC Memr[P2R($1+4)] # Focus +define SF_WID Memr[P2R($1+5)] # Width +define SF_POS Memr[P2R($1+6)] # Position +define SF_DEL Memi[$1+7] # Deleted? + +define SFD Memi[SF_SFD($1)+($3-1)*SF_NX($1)+$2-1] diff --git a/noao/obsutil/src/specfocus/specfocus.par b/noao/obsutil/src/specfocus/specfocus.par new file mode 100644 index 00000000..bf21416c --- /dev/null +++ b/noao/obsutil/src/specfocus/specfocus.par @@ -0,0 +1,13 @@ +images,s,a,,,,List of images +focus,s,h,"",,,Focus values +corwidth,i,h,20,,,Correlation width +level,r,h,0.5,,,Percent or fraction of peak for width measurement +shifts,b,h,yes,,,"Compute shifts across the dispersion? +" +dispaxis,i,h,2,1,2,Dispersion axis (long slit only) +nspectra,i,h,1,1,,Number of spectral samples (long slit only) +ndisp,i,h,1,1,,Number of dispersion samples +slit1,i,h,INDEF,,,Lower slit edge +slit2,i,h,INDEF,,,"Upper slit edge +" +logfile,s,h,"logfile",,,"Logfile" diff --git a/noao/obsutil/src/specfocus/spfgraph.x b/noao/obsutil/src/specfocus/spfgraph.x new file mode 100644 index 00000000..0430d494 --- /dev/null +++ b/noao/obsutil/src/specfocus/spfgraph.x @@ -0,0 +1,1637 @@ +include +include +include "specfocus.h" + +define HELP "specfocus$specfocus.key" +define PROMPT "specfocus options" + +define VX1 .15 # Minimum X viewport +define VX2 .95 # Maximum X viewport +define VY1 .10 # Minimum Y viewport for bottom graph +define VY2 .44 # Minimum Y viewport for bottom graph +define VY3 .54 # Minimum Y viewport for top graph +define VY4 .88 # Maximum Y viewport for top graph + +define NMAX 5 # Maximum number of samples +define HLCOLOR 2 # Highlight color +define HLWIDTH 4. # Highlight width + + +# SPF_GRAPH -- Interactive graphing of results + +procedure spf_graph (sfavg, sfbest, sfs, nimages, lag) + +pointer sfavg # Average image +pointer sfbest # Best image +pointer sfs[nimages] # Images +int nimages # Number of images +int lag # Maximum lag + +char cmd[10] +real wx, wy, f, w, r2, r2min, fa[8] +int i, j, k, l, i1, j1, nx, ny, nxgrid, nygrid, nsfd +int wcs, key, pkey, del, clgcur() +pointer sp, sysidstr, title, gp, gopen() +pointer sf, sfd, sfcur + +data fa/0.,1.,1.,0.,0.,0.,1.,1./ + +begin + call smark (sp) + call salloc (sysidstr, SZ_LINE, TY_CHAR) + call salloc (title, SZ_LINE, TY_CHAR) + + # Set system id label + call sysid (Memc[sysidstr], SZ_LINE) + + # Set current image and sample + nsfd = SF_NSFD(sfavg) + nx = SF_NX(sfavg) + ny = SF_NY(sfavg) + i = (nx + 1) / 2 + j = (ny + 1) / 2 + for (k=1; k= mod (nimages, nxgrid)) + nxgrid = nxgrid + 1 + nygrid = (nimages-1) / nxgrid + 1 + } + + # Open graphics and enter interactive graphics loop + gp = gopen ("stdgraph", NEW_FILE, STDGRAPH) + key = 'b' + wcs = 0 + repeat { + # Verify keys, check for '?', and 'q', set redraw. + switch (key) { + case '?': + call gpagefile (gp, HELP, PROMPT) + next + case 'b', 'p', 's', 'w', 'z': + pkey = key + del = NO + case 'q': + break + case 'r': + key = pkey + del = NO + case ' ', 'd': + del = NO + case 'u': + del = YES + default: + call printf ("\007") + next + } + + # Map the cursor position to an image and sample. + switch (wcs) { + case 1: + k = 1 + call spf_sample (sfavg, 1, del, wx, wy, i, j, k) + f = SF_FOC(SFD(sfavg,i,j)) + r2min = MAX_REAL + do l = 1, nimages { + sf = sfs[l] + sfd = SFD(sf,i,j) + if (SF_DEL(sfd) == del) { + r2 = abs (f - SF_FOC(sfd)) + if (r2 < r2min) { + r2min = r2 + k = l + } + } + } + call spf_sample (sfs, nimages, del, wx, wy, i, j, k) + case 2, 6: + call spf_sample (sfs, nimages, del, wx, wy, i, j, k) + case 3: + r2min = MAX_REAL + call gctran (gp, wx, wy, wx, wy, wcs, 0) + do l = 1, nimages { + sf = sfs[l] + do j1 = 1, ny { + do i1 = 1, nx { + sfd = SFD(sf,i1,j1) + if (SF_DEL(sfd) == del) { + f = SF_FOC(sfd) + w = SF_WID(sfd) + call gctran (gp, f, w, f, w, wcs, 0) + r2 = (f-wx)**2 + (w-wy)**2 + if (r2 < r2min) { + r2min = r2 + i = i1 + j = j1 + k = l + } + } + } + } + } + case 4, 5, 8: + i1 = max (1, min (nxgrid, nint(wx))) + j1 = max (1, min (nygrid, nint(wy))) + k = max (1, min (nimages, (j1-1) * nxgrid + i1)) + call spf_sample (sfs, nimages, del, real(i), real(j), i, j, k) + if (wcs == 8) { + wx = nx * (wx - nint (wx) + 0.5) + 0.5 + wy = -(ny+1) * (wy - nint (wy) + 0.5) + (ny+1.5) + call spf_sample (sfs, nimages, del, wx, wy, i, j, k) + } + } + + # Switch on action key + switch (key) { + case ' ': + if (wcs == 1) + sf = sfavg + else + sf = sfs[k] + sfd = SFD(sf,i,j) + call printf ( + "Image %s at (%d, %d), Focus = %.3g, Width = %.2f") + call pargstr (SF_IMAGE(sf)) + call pargr (SF_X(sfd)) + call pargr (SF_Y(sfd)) + call pargr (SF_FOC(sfd)) + call pargr (SF_WID(sfd)) + if (abs (SF_POS(sfd)) > .01) { + call printf (", Shift = %.2f") + call pargr (SF_POS(sfd)) + } + call printf ("\n") + next + case 'd': + repeat { + switch (key) { + case 'i': + do j1 = 1, ny + do i1 = 1, nx + SF_DEL(SFD(sfs[k],i1,j1)) = YES + call spf_sample (sfs, nimages, del, real(i), real(j), + i, j, k) + case 's': + do l = 1, nimages { + sfd = SFD(sfs[l],i,j) + SF_DEL(sfd) = YES + } + call spf_sample (sfs, nimages, del, real(i), real(j), + i, j, k) + case 'p': + sfd = SFD(sfs[k],i,j) + SF_DEL(sfd) = YES + call spf_sample (sfs, nimages, del, real(i), real(j), + i, j, k) + default: + call printf ("Delete image, sample, or point?") + next + } + call spf_fitfocus (sfs, nimages, sfavg, sfbest) + key = pkey + break + } until (clgcur ("gcur", wx, wy, wcs, key, cmd, 10) == EOF) + case 'u': + repeat { + switch (key) { + case 'i': + call spf_sample (sfs, nimages, del, real(i), real(j), + i, j, k) + do j1 = 1, ny + do i1 = 1, nx + SF_DEL(SFD(sfs[k],i1,j1)) = NO + case 's': + call spf_sample (sfs, nimages, del, real(i), real(j), + i, j, k) + do l = 1, nimages { + sfd = SFD(sfs[l],i,j) + SF_DEL(sfd) = NO + } + case 'p': + call spf_sample (sfs, nimages, del, real(i), real(j), + i, j, k) + sfd = SFD(sfs[k],i,j) + SF_DEL(sfd) = NO + default: + call printf ("Undelete image, sample or point?") + next + } + call spf_fitfocus (sfs, nimages, sfavg, sfbest) + key = pkey + break + } until (clgcur ("gcur", wx, wy, wcs, key, cmd, 10) == EOF) + } + sfcur = sfs[k] + sfd = SFD(sfcur,i,j) + + # Make the graphs. + call gclear (gp) + call gseti (gp, G_FACOLOR, 0) + + if (nimages > 1 && nsfd > 1) { + switch (key) { + case 'p': + call gseti (gp, G_WCS, 4) + call gsview (gp, VX1, VX2, VY3, VY4) + call spf_g4 (gp, sfavg, sfbest, sfcur, sfs, nimages, i, j, + nxgrid, nygrid, lag) + if (nx > NMAX || ny > NMAX) { + call gseti (gp, G_WCS, 1) + call gsview (gp, VX1, VX2, VY1, VY2) + call gfill (gp, fa, fa[5], 4, GF_SOLID) + call spf_g1 (gp, sfcur, i, j, NO, NO) + } else { + call gseti (gp, G_WCS, 2) + call gsview (gp, VX1, VX2, VY1, VY2) + call gfill (gp, fa, fa[5], 4, GF_SOLID) + call spf_g2 (gp, sfavg, sfbest, sfcur, i, j, lag) + } + case 's': + call gseti (gp, G_WCS, 5) + call gsview (gp, VX1, VX2, VY3, VY4) + call spf_g5 (gp, sfcur, sfs, nimages, i, j, nxgrid, nygrid) + if (nx > NMAX || ny > NMAX) { + call gseti (gp, G_WCS, 1) + call gsview (gp, VX1, VX2, VY1, VY2) + call gfill (gp, fa, fa[5], 4, GF_SOLID) + call spf_g1 (gp, sfcur, i, j, NO, NO) + } else { + call gseti (gp, G_WCS, 6) + call gsview (gp, VX1, VX2, VY1, VY2) + call gfill (gp, fa, fa[5], 4, GF_SOLID) + call spf_g6 (gp, sfcur, i, j) + } + case 'w': + call gseti (gp, G_WCS, 3) + call gsview (gp, VX1, VX2, VY3, VY4) + call spf_g3 (gp, sfavg, sfcur, sfs, nimages, i, j) + if (nx > NMAX || ny > NMAX) { + call gseti (gp, G_WCS, 1) + call gsview (gp, VX1, VX2, VY1, VY2) + call gfill (gp, fa, fa[5], 4, GF_SOLID) + call spf_g1 (gp, sfcur, i, j, NO, NO) + } else { + call gseti (gp, G_WCS, 8) + call gsview (gp, VX1, VX2, VY1, VY2) + call gfill (gp, fa, fa[5], 4, GF_SOLID) + call spf_g8 (gp, sfavg, sfcur, sfd, sfs, nimages, + nxgrid, nygrid) + } + case 'z': + call gseti (gp, G_WCS, 7) + call gsview (gp, VX1, VX2, VY3, VY4) + call spf_g7 (gp, sfbest, sfcur, i, j, lag) + call gseti (gp, G_WCS, 9) + call gsview (gp, VX1, VX2, VY1, VY2) + call gfill (gp, fa, fa[5], 4, GF_SOLID) + call spf_g9 (gp, sfcur, i, j) + default: + call gseti (gp, G_WCS, 1) + call gsview (gp, VX1, VX2, VY1, VY4) + call spf_g1 (gp, sfavg, i, j, YES, YES) + } + } else if (nimages > 1) { + switch (key) { + case 'z': + call gseti (gp, G_WCS, 7) + call gsview (gp, VX1, VX2, VY3, VY4) + call spf_g7 (gp, sfbest, sfcur, i, j, lag) + call gseti (gp, G_WCS, 9) + call gsview (gp, VX1, VX2, VY1, VY2) + call gfill (gp, fa, fa[5], 4, GF_SOLID) + call spf_g9 (gp, sfcur, i, j) + case 's': + call gseti (gp, G_WCS, 3) + call gsview (gp, VX1, VX2, VY3, VY4) + call spf_g3 (gp, sfavg, sfcur, sfs, nimages, i, j) + call gseti (gp, G_WCS, 5) + call gsview (gp, VX1, VX2, VY1, VY2) + call gfill (gp, fa, fa[5], 4, GF_SOLID) + call spf_g5 (gp, sfcur, sfs, nimages, i, j, nxgrid, nygrid) + default: + call gseti (gp, G_WCS, 3) + call gsview (gp, VX1, VX2, VY3, VY4) + call spf_g3 (gp, sfavg, sfcur, sfs, nimages, i, j) + call gseti (gp, G_WCS, 4) + call gsview (gp, VX1, VX2, VY1, VY2) + call spf_g4 (gp, sfavg, sfbest, sfcur, sfs, nimages, i, j, + nxgrid, nygrid, lag) + } + } else if (nsfd > 1) { + switch (key) { + case 'z': + call gseti (gp, G_WCS, 7) + call gsview (gp, VX1, VX2, VY3, VY4) + call spf_g7 (gp, sfbest, sfcur, i, j, lag) + call gseti (gp, G_WCS, 9) + call gsview (gp, VX1, VX2, VY1, VY2) + call gfill (gp, fa, fa[5], 4, GF_SOLID) + call spf_g9 (gp, sfcur, i, j) + default: + call gseti (gp, G_WCS, 2) + call gsview (gp, VX1, VX2, VY3, VY4) + call spf_g2 (gp, sfavg, sfbest, sfcur, i, j, lag) + call gseti (gp, G_WCS, 6) + call gsview (gp, VX1, VX2, VY1, VY2) + call gfill (gp, fa, fa[5], 4, GF_SOLID) + call spf_g6 (gp, sfcur, i, j) + } + } else { + call gseti (gp, G_WCS, 7) + call gsview (gp, VX1, VX2, VY3, VY4) + call spf_g7 (gp, sfbest, sfcur, i, j, lag) + call gseti (gp, G_WCS, 9) + call gsview (gp, VX1, VX2, VY1, VY2) + call gfill (gp, fa, fa[5], 4, GF_SOLID) + call spf_g9 (gp, sfcur, i, j) + } + + call sprintf (Memc[title], SZ_LINE, + "Best Average Focus at %.3g with Width of %.3g at %d%% of Peak") + call pargr (SF_FOCUS(sfavg)) + call pargr (SF_WIDTH(sfavg)) + call pargr (100 * SF_LEVEL(sfavg)) + call gseti (gp, G_WCS, 0) + call gsetr (gp, G_PLWIDTH, 2.0) + call gline (gp, 0., 0., 0., 0.) + call gtext (gp, 0.5, 0.99, Memc[sysidstr], "h=c,v=t") + call gtext (gp, 0.5, 0.96, Memc[title], "h=c,v=t") + + pkey = key + } until (clgcur ("gcur", wx, wy, wcs, key, cmd, 10) == EOF) + + call gclose (gp) + call sfree (sp) +end + + +# SPF_G1 -- Best Focus at each sample + +procedure spf_g1 (gp, sf, ix, iy, focplot, posplot) + +pointer gp # GIO pointer +pointer sf # SF pointer +int ix, iy # Sample +int focplot # Focus plot? +int posplot # Position plot? + +int i, j, n, nx, ny +real wx1, wx2, wy1, wy2, ww1, ww2, wf1, wf2, wp1, wp2 +real vx[3,2], vy[3,2], dvx, dvy, fa[8] +real x, y, z, last +pointer sp, str, sfd + +data fa/0.,1.,1.,0.,0.,0.,1.,1./ + +begin + call smark (sp) + call salloc (str, SZ_LINE, TY_CHAR) + + nx = SF_NX(sf) + ny = SF_NY(sf) + wx1 = SF_X1(sf) + wy1 = SF_Y1(sf) + wx2 = wx1 + (nx + .3) * SF_DX(sf) + wy2 = wy1 + ny * SF_DY(sf) + + # Determine the range of WID, FOC, and POS. + ww1 = MAX_REAL + wf1 = MAX_REAL + wp1 = MAX_REAL + ww2 = -MAX_REAL + wf2 = -MAX_REAL + wp2 = -MAX_REAL + do j = 1, ny { + do i = 1, nx { + sfd = SFD(sf,i,j) + if (SF_DEL(sfd) == NO) { + ww1 = min (ww1, SF_WID(sfd)) + wf1 = min (wf1, SF_FOC(sfd)) + wp1 = min (wp1, SF_POS(sfd)) + ww2 = max (ww2, SF_WID(sfd)) + wf2 = max (wf2, SF_FOC(sfd)) + wp2 = max (wp2, SF_POS(sfd)) + } + } + } + ww2 = max (2., ww2 - ww1) + + # Set view ports + call ggview (gp, vx[1,1], vx[3,2], vy[1,1], vy[3,2]) + dvx = vx[3,2] - vx[1,1] + dvy = vy[3,2] - vy[1,1] + vx[1,2] = vx[1,1] + 0.20 * dvx + vx[2,1] = vx[1,1] + 0.25 * dvx + vx[2,2] = vx[1,1] + 0.75 * dvx + vx[3,1] = vx[1,1] + 0.80 * dvx + vy[1,2] = vy[1,1] + 0.20 * dvy + vy[2,1] = vy[1,1] + 0.25 * dvy + vy[2,2] = vy[1,1] + 0.75 * dvy + vy[3,1] = vy[1,1] + 0.80 * dvy + + z = abs ((wf1 + wf2) / 2.) + if (z == 0.) + z = max (abs(wf1), abs(wf2)) + if (z == 0.) + z = 1. + if (focplot == NO || abs (wf2 - wf1) / z <= 0.01) { + vx[2,1] = vx[1,1] + vy[2,1] = vy[1,1] + } + if (posplot == NO || abs (wp2 - wp1) <= .05) { + vx[2,2] = vx[3,2] + vy[2,2] = vy[3,2] + } + if (nx == 1) { + vy[2,1] = vy[1,1] + vy[2,2] = vy[3,2] + } + if (ny == 1) { + vx[2,1] = vx[1,1] + vx[2,2] = vx[3,2] + } + + call gseti (gp, G_DRAWAXES, 3) + call gseti (gp, G_DRAWTICKS, YES) + + # FOC plot + if (focplot == YES && abs (wf2 - wf1) / z > 0.01) { + z = wf2 - wf1 + wf1 = wf1 - 0.05 * z + wf2 = wf2 + 0.05 * z + + if (nx > 1) { + call gseti (gp, G_LABELTICKS, YES) + call gseti (gp, G_NMAJOR, 6) + call gseti (gp, G_NMINOR, 4) + call gseti (gp, G_YNMAJOR, 4) + call gseti (gp, G_YNMINOR, 0) + call gsview (gp, vx[2,1], vx[2,2], vy[1,1], vy[1,2]) + call gswind (gp, 0., 1., 0., 1.) + call gfill (gp, fa, fa[5], 4, GF_SOLID) + call gswind (gp, wx1, wx2, wf1, wf2) + if (SF_AXIS(sf) == 1) + call glabax (gp, "", "Column (Dispersion)", "Focus") + else + call glabax (gp, "", "Column (Slit)", "Focus") + + call gswind (gp, 0.5, 0.8+nx, wf1, wf2) + last = INDEF + do i = 1, nx { + x = i + do j = 1, ny { + sfd = SFD(sf,i,j) + if (SF_DEL(sfd) == NO) { + z = SF_WID(sfd) + z = 0.008 * (1 + (z - ww1) / ww2 * 3) + call gmark (gp, x, SF_FOC(sfd), GM_CIRCLE, z, z) + } + } + + n = 0 + z = 0. + do j = 1, ny { + sfd = SFD(sf,i,j) + if (SF_DEL(sfd) == NO) { + z = z + SF_FOC(SFD(sf,i,j)) + n = n + 1 + } + } + if (n > 0) { + if (!IS_INDEF(last)) + call gline (gp, last, y, x, z/n) + y = z / n + last = x + } + } + + call gseti (gp, G_PLTYPE, 2) + call gline (gp, 0.5, SF_FOCUS(sf), 0.8+nx, SF_FOCUS(sf)) + call gseti (gp, G_PLTYPE, 1) + } + + if (ny > 1) { + call gseti (gp, G_LABELTICKS, YES) + call gseti (gp, G_NMAJOR, 6) + call gseti (gp, G_NMINOR, 4) + call gseti (gp, G_XNMAJOR, 4) + call gseti (gp, G_XNMINOR, 0) + call gsview (gp, vx[1,1], vx[1,2], vy[2,1], vy[2,2]) + call gswind (gp, 0., 1., 0., 1.) + call gfill (gp, fa, fa[5], 4, GF_SOLID) + call gswind (gp, wf1, wf2, wy1, wy2) + if (SF_AXIS(sf) == 1) + call glabax (gp, "", "Focus", "Line (Slit)") + else + call glabax (gp, "", "Focus", "Line (Dispersion)") + + call gswind (gp, wf1, wf2, 0.5, 0.5+ny) + last = INDEF + do j = 1, ny { + y = j + do i = 1, nx { + sfd = SFD(sf,i,j) + if (SF_DEL(sfd) == NO) { + z = SF_WID(sfd) + z = 0.008 * (1 + (z - ww1) / ww2 * 3) + call gmark (gp, SF_FOC(sfd), y, GM_CIRCLE, z, z) + } + } + + n = 0 + z = 0. + do i = 1, nx { + sfd = SFD(sf,i,j) + if (SF_DEL(sfd) == NO) { + z = z + SF_FOC(SFD(sf,i,j)) + n = n + 1 + } + } + if (n > 0) { + if (!IS_INDEF(last)) + call gline (gp, x, last, z/n, y) + x = z / n + last = y + } + } + + call gseti (gp, G_PLTYPE, 2) + call gline (gp, SF_FOCUS(sf), 0.5, SF_FOCUS(sf), 0.5+ny) + call gseti (gp, G_PLTYPE, 1) + } + } + + # POS plot + if (posplot == YES && abs (wp2 - wp1) > .05) { + z = wp2 - wp1 + wp1 = wp1 - 0.05 * z + wp2 = wp2 + 0.05 * z + + if (nx > 1) { + call gseti (gp, G_XLABELTICKS, NO) + call gseti (gp, G_YLABELTICKS, YES) + call gseti (gp, G_NMAJOR, 6) + call gseti (gp, G_NMINOR, 4) + call gseti (gp, G_YNMAJOR, 4) + call gseti (gp, G_YNMINOR, 0) + call gsview (gp, vx[2,1], vx[2,2], vy[3,1], vy[3,2]) + call gswind (gp, 0., 1., 0., 1.) + call gfill (gp, fa, fa[5], 4, GF_SOLID) + call gswind (gp, wx1, wx2, wp1, wp2) + call glabax (gp, "", "", "Shift") + + call gswind (gp, 0.5, 0.8+nx, wp1, wp2) + last = INDEF + do i = 1, nx { + x = i + do j = 1, ny { + sfd = SFD(sf,i,j) + if (SF_DEL(sfd) == NO) { + z = SF_WID(sfd) + z = 0.008 * (1 + (z - ww1) / ww2 * 3) + call gmark (gp, x, SF_POS(sfd), GM_CIRCLE, z, z) + } + } + + n = 0 + z = 0. + do j = 1, ny { + sfd = SFD(sf,i,j) + if (SF_DEL(sfd) == NO) { + z = z + SF_POS(SFD(sf,i,j)) + n = n + 1 + } + } + if (n > 0) { + if (!IS_INDEF(last)) + call gline (gp, last, y, x, z/n) + y = z / n + last = x + } + } + + call gseti (gp, G_PLTYPE, 2) + call gline (gp, 0.5, 0., 0.8+nx, 0.) + call gseti (gp, G_PLTYPE, 1) + } + + if (ny > 1) { + call gseti (gp, G_XLABELTICKS, YES) + call gseti (gp, G_YLABELTICKS, NO) + call gseti (gp, G_NMAJOR, 6) + call gseti (gp, G_NMINOR, 4) + call gseti (gp, G_XNMAJOR, 4) + call gseti (gp, G_XNMINOR, 0) + call gsview (gp, vx[3,1], vx[3,2], vy[2,1], vy[2,2]) + call gswind (gp, 0., 1., 0., 1.) + call gfill (gp, fa, fa[5], 4, GF_SOLID) + call gswind (gp, wp1, wp2, wy1, wy2) + call glabax (gp, "", "Shift", "") + + call gswind (gp, wp1, wp2, 0.5, 0.5+ny) + last = INDEF + do j = 1, ny { + y = j + do i = 1, nx { + sfd = SFD(sf,i,j) + if (SF_DEL(sfd) == NO) { + z = SF_WID(sfd) + z = 0.008 * (1 + (z - ww1) / ww2 * 3) + call gmark (gp, SF_POS(sfd), y, GM_CIRCLE, z, z) + } + } + + n = 0 + z = 0. + do i = 1, nx { + sfd = SFD(sf,i,j) + if (SF_DEL(sfd) == NO) { + z = z + SF_POS(sfd) + n = n + 1 + } + } + if (n > 0) { + if (!IS_INDEF(last)) + call gline (gp, x, last, z/n, y) + x = z / n + last = y + } + } + + call gseti (gp, G_PLTYPE, 2) + call gline (gp, 0., 0.5, 0., 0.5+ny) + call gseti (gp, G_PLTYPE, 1) + } + } + + # Spatial plot + call gsview (gp, vx[2,1], vx[2,2], vy[2,1], vy[2,2]) + call gswind (gp, 0., 1., 0., 1.) + call gfill (gp, fa, fa[5], 4, GF_SOLID) + call gswind (gp, wx1, wx2, wy1, wy2) + call gseti (gp, G_NMAJOR, 6) + call gseti (gp, G_NMINOR, 4) + if (vx[2,1] == vx[1,1] && vy[2,1] == vy[1,1]) { + call gseti (gp, G_LABELTICKS, YES) + if (SF_AXIS(sf) == 1) + call glabax (gp, "", "Column (Dispersion)", "Line (Slit)") + else + call glabax (gp, "", "Column (Slit)", "Line (Dispersion)") + } else if (vx[2,1] == vx[1,1]) { + call gseti (gp, G_XLABELTICKS, NO) + call gseti (gp, G_YLABELTICKS, YES) + if (SF_AXIS(sf) == 1) + call glabax (gp, "", "", "Line (Slit)") + else + call glabax (gp, "", "", "Line (Dispersion)") + } else if (vy[2,1] == vy[1,1]) { + call gseti (gp, G_XLABELTICKS, YES) + call gseti (gp, G_YLABELTICKS, NO) + if (SF_AXIS(sf) == 1) + call glabax (gp, "", "Column (Dispersion)", "") + else + call glabax (gp, "", "Column (Slit)", "") + } else { + call gseti (gp, G_LABELTICKS, NO) + call glabax (gp, "", "", "") + } + + call gswind (gp, 0.5, 0.8+nx, 0.5, 0.5+ny) + + do j = 1, ny { + do i = 1, nx { + sfd = SFD(sf,i,j) + if (SF_DEL(sfd) == NO) { + x = i + y = j + z = SF_WID(sfd) + z = 0.008 * (1 + (z - ww1) / ww2 * 3) + call gmark (gp, x, y, GM_CIRCLE, z, z) + if (i == ix && j == iy) { + call gseti (gp, G_PLCOLOR, HLCOLOR) + call gmark (gp, x, y, GM_BOX, -.8, -.8) + call gseti (gp, G_PLCOLOR, 1) + } + if (abs (wp2 - wp1) > .05) { + if (SF_AXIS(sf) == 1) { + z = 0.25 * SF_POS(sfd) / max (abs(wp1), abs(wp2)) + call gadraw (gp, x+z, y) + } else { + z = 0.25 * SF_POS(sfd) / max (abs(wp1), abs(wp2)) + call gadraw (gp, x, y+z) + } + } + } + } + } + + if (nx <= 3 && ny <= 3) { + call gsetr (gp, G_PLWIDTH, 2.) + call gline (gp, wx1, wy1, wx1, wy1) + do j = 1, ny { + do i = 1, nx { + sfd = SFD(sf,i,j) + if (SF_DEL(sfd) == NO) { + x = i + y = j + + call sprintf (Memc[str], SZ_LINE, "%.3g") + call pargr (SF_FOC(sfd)) + call gtext (gp, x+0.2, y+0.2, Memc[str], "h=l;v=c") + call sprintf (Memc[str], SZ_LINE, "%.2f") + call pargr (SF_WID(sfd)) + call gtext (gp, x+0.2, y-0.2, Memc[str], "h=l;v=c") + if (abs (SF_POS(sfd)) >= .01) { + call sprintf (Memc[str], SZ_LINE, "%.2f") + call pargr (SF_POS(sfd)) + call gtext (gp, x+0.2, y, Memc[str], "h=l;v=c") + } + } + } + } + call gsetr (gp, G_PLWIDTH, 1.) + } + + if (SF_DATA(sf) == NULL) { + call strcpy ("Best Focus at Each Sample", Memc[str], SZ_LINE) + } else { + call sprintf (Memc[str], SZ_LINE, "Image %s with Focus %.3g") + call pargstr (SF_IMAGE(sf)) + call pargr (SF_FOCUS(sf)) + } + call gseti (gp, G_DRAWAXES, 0) + call gsview (gp, vx[1,1], vx[3,2], vy[1,1], vy[3,2]) + call glabax (gp, Memc[str], "", "") + + call sfree (sp) +end + + +# SPF_G2 -- Profiles at each sample for a given image + +procedure spf_g2 (gp, sfavg, sfbest, sfcur, ix, iy, lag) + +pointer gp # GIO pointer +pointer sfavg # Average image +pointer sfbest # Best image +pointer sfcur # Current image +int ix, iy # Sample +int lag # Maximum lag + +int i, j, nx, ny +real x1, x2, y1, y2, z1, z2, dz, vx, dvx, vy, dvy, p, x, fa[10], asieval() +pointer sp, str, sfd, asi + +begin + call smark (sp) + call salloc (str, SZ_LINE, TY_CHAR) + + # Set range and draw axes + i = min (lag, nint (3 * SF_WIDTH(sfavg))) + x1 = -i + x2 = i + y1 = -0.05 + y2 = 1.55 + fa[1] = x1; fa[6] = y1 + fa[2] = x2; fa[7] = y1 + fa[3] = x2; fa[8] = y2 + fa[4] = x1; fa[9] = y2 + fa[5] = x1; fa[10] = y1 + call gswind (gp, x1, x2, y1, y2) + + call gseti (gp, G_DRAWTICKS, NO) + call sprintf (Memc[str], SZ_LINE, "Image %s with Focus %.3g") + call pargstr (SF_IMAGE(sfcur)) + call pargr (SF_FOCUS(sfcur)) + call glabax (gp, Memc[str], "", "") + + # Set subviewport + nx = SF_NX(sfcur) + ny = SF_NY(sfcur) + call ggview (gp, vx, dvx, vy, dvy) + dvx = (dvx - vx) / nx + dvy = (dvy - vy) / ny + + # Draw correlation profiles + do j = 1, ny { + do i = 1, nx { + call gsview (gp, vx+(i-1)*dvx, vx+i*dvx, vy+(j-1)*dvy, vy+j*dvy) + call glabax (gp, "", "", "") + + if (i == ix && j == iy) { + call gsview (gp, vx+(i-1)*dvx+.005, vx+i*dvx-.005, + vy+(j-1)*dvy+.005, vy+j*dvy-.005) + call gsetr (gp, G_PLWIDTH, HLWIDTH) + call gseti (gp, G_PLCOLOR, HLCOLOR) + call gpline (gp, fa, fa[6], 5) + call gsetr (gp, G_PLWIDTH, 1.) + call gseti (gp, G_PLCOLOR, 1) + } + + sfd = SFD(sfcur,i,j) + if (SF_DEL(sfd) == NO) { + asi = SF_ASI(sfd) + p = sqrt (2.) * SF_POS(sfd) + z1 = max (x1, x1-p) + z2 = min (x2, x2-p) + dz = 1 + for (x=nint(z1); x<=nint(z2); x=x+dz) + call gmark (gp, x+p, asieval (asi, x+lag+1), + GM_PLUS, 2., 2.) + call gamove (gp, z1+p, asieval (asi, z1+lag+1)) + dz = .1 + for (x=z1+dz; x<=z2; x=x+dz) + call gadraw (gp, x+p, asieval (asi, x+lag+1)) + if (sfcur != sfbest) { + asi = SF_ASI(SFD(sfbest,i,j)) + call gamove (gp, z1+p, asieval (asi, z1+lag+1)) + for (x=z1+dz; x<=z2; x=x+dz) + call gadraw (gp, x+p, asieval (asi, x+lag+1)) + } + + call gseti (gp, G_PLTYPE, 3) + call gline (gp, 0., 0., 0., 1.) + call gseti (gp, G_PLTYPE, 1) + + if (nx <= NMAX && ny <= NMAX) + call spf_label (gp, sfd, 21, 2) + } + } + } + + call gswind (gp, 0.5, 0.5+nx, 0.5, 0.5+ny) + call gsview (gp, vx, vx+nx*dvx, vy, vy+ny*dvy) + call gamove (gp, 1., 1.) + + call sfree (sp) +end + + +# SPF_G3 -- Width vs. Focus + +procedure spf_g3 (gp, sfavg, sfcur, sfs, nimages, ix, iy) + +pointer gp # GIO pointer +pointer sfavg # Average image +pointer sfcur # Current image +pointer sfs[nimages] # Images +int nimages # Number of images +int ix, iy # Current sample + +int i, j, k, mark +real x, x1, x2, dx, y, y1, y2, dy, size +pointer sf, sfd + +begin + # Determine data range + x1 = MAX_REAL + y1 = MAX_REAL + x2 = -MAX_REAL + y2 = -MAX_REAL + do i = 1, nimages { + sf = sfs[i] + do j = 1, SF_NSFD(sf) { + sfd = SFD(sf,j,1) + if (SF_DEL(sfd) == NO) { + x = SF_FOC(sfd) + y = SF_WID(sfd) + x1 = min (x1, x) + x2 = max (x2, x) + y1 = min (y1, y) + y2 = max (y2, y) + } + } + } + + dx = (x2 - x1) + dy = (y2 - y1) + x1 = x1 - dx * 0.05 + x2 = x2 + dx * 0.05 + y1 = y1 - dy * 0.05 + y2 = y2 + dy * 0.05 + call gswind (gp, x1, x2, y1, y2) + call glabax (gp, "Profile Width vs. Focus", "", "") + + do k = 1, nimages { + sf = sfs[k] + do j = 1, SF_NY(sf) { + do i = 1, SF_NX(sf) { + call gseti (gp, G_PLCOLOR, 1) + if (sf == sfcur) + mark = GM_PLUS + else + mark = GM_CROSS + size = 2. + if (sf == sfcur && i == ix && j == iy) { + call gseti (gp, G_PLCOLOR, HLCOLOR) + mark = mark + GM_BOX + size = 3. + } + sfd = SFD(sf,i,j) + if (SF_DEL(sfd) == NO) { + x = SF_FOC(sfd) + y = SF_WID(sfd) + call gmark (gp, x, y, mark, size, size) + } + } + } + } + + call gseti (gp, G_PLTYPE, 3) + x = INDEF + do k = 1, nimages { + sf = sfs[k] + sfd = SFD(sf,ix,iy) + if (SF_DEL(sfd) == NO) { + if (!IS_INDEF(x)) + call gline (gp, x, y, SF_FOC(sfd), SF_WID(sfd)) + x = SF_FOC(sfd) + y = SF_WID(sfd) + } + } + + call gseti (gp, G_PLTYPE, 2) + call gline (gp, SF_FOCUS(sfavg), y1, SF_FOCUS(sfavg), y2) + call gline (gp, x1, SF_WIDTH(sfavg), x2, SF_WIDTH(sfavg)) + call gseti (gp, G_PLTYPE, 1) +end + + +# SPF_G4 -- Profiles at a given sample + +procedure spf_g4 (gp, sfavg, sfbest, sfcur, sfs, nimages, ix, iy, nx, ny, lag) + +pointer gp # GIO pointer +pointer sfavg # Average image +pointer sfbest # Best image +pointer sfcur # Current image +pointer sfs[nimages] # Images +int nimages # Number of images +int ix, iy # Sample +int nx, ny # Grid layout +int lag # Maximum lag + +int i, j, k +real x1, x2, y1, y2, z1, z2, dz, p, x, fa[10], asieval() +real vx, dvx, vy, dvy +pointer sp, str, sf, sfd, asi + +begin + call smark (sp) + call salloc (str, SZ_LINE, TY_CHAR) + + if (SF_NSFD(sfcur) > 1) { + call sprintf (Memc[str], SZ_LINE, + "All Images at Sample [%d:%d,%d:%d]") + call pargi (SF_X1(sfcur)+(ix-1)*SF_DX(sfcur)) + call pargi (SF_X1(sfcur)+ix*SF_DX(sfcur)-1) + call pargi (SF_Y1(sfcur)+(iy-1)*SF_DY(sfcur)) + call pargi (SF_Y1(sfcur)+iy*SF_DY(sfcur)-1) + } else + Memc[str] = EOS + + # Set windows + i = min (lag, nint (3 * SF_WIDTH(sfavg))) + x1 = -i + x2 = i + y1 = -0.05 + y2 = 1.55 + call gswind (gp, x1, x2, y1, y2) + fa[1] = x1; fa[6] = y1 + fa[2] = x2; fa[7] = y1 + fa[3] = x2; fa[8] = y2 + fa[4] = x1; fa[9] = y2 + fa[5] = x1; fa[10] = y1 + + # Set subview port + call ggview (gp, vx, dvx, vy, dvy) + dvx = (dvx - vx) / nx + dvy = (dvy - vy) / ny + + # Draw correlation profiles + k = 0 + do i = 1, ny { + do j = 1, nx { + k = k + 1 + if (k > nimages) + break + sf = sfs[k] + sfd = SFD(sf,ix,iy) + + call gsview (gp, vx+(j-1)*dvx, vx+j*dvx, + vy+(ny-i)*dvy, vy+(ny-i+1)*dvy) + call gfill (gp, fa, fa[6], 4, GF_SOLID) + if (sf == sfcur) { + call gsview (gp, vx+(j-1)*dvx+.005, vx+j*dvx-.005, + vy+(ny-i)*dvy+.005, vy+(ny-i+1)*dvy-.005) + call gsetr (gp, G_PLWIDTH, HLWIDTH) + call gseti (gp, G_PLCOLOR, HLCOLOR) + call gpline (gp, fa, fa[6], 5) + call gsetr (gp, G_PLWIDTH, 1.) + call gseti (gp, G_PLCOLOR, 1) + call gsview (gp, vx+(j-1)*dvx, vx+j*dvx, + vy+(ny-i)*dvy, vy+(ny-i+1)*dvy) + } + call gseti (gp, G_DRAWAXES, 3) + call gseti (gp, G_DRAWTICKS, NO) + call glabax (gp, "", "", "") + + + if (SF_DEL(sfd) == NO) { + asi = SF_ASI(sfd) + p = sqrt (2.) * SF_POS(sfd) + z1 = max (x1, x1-p) + z2 = min (x2, x2-p) + dz = 1 + for (x=nint(z1); x<=nint(z2); x=x+dz) + call gmark (gp, x+p, asieval (asi, x+lag+1), + GM_PLUS, 2., 2.) + call gamove (gp, z1+p, asieval (asi, z1+lag+1)) + dz = .1 + for (x=z1+dz; x<=z2; x=x+dz) + call gadraw (gp, x+p, asieval (asi, x+lag+1)) + if (sf != sfbest) { + asi = SF_ASI(SFD(sfbest,ix,iy)) + call gamove (gp, z1+p, asieval (asi, z1+lag+1)) + for (x=z1+dz; x<=z2; x=x+dz) + call gadraw (gp, x+p, asieval (asi, x+lag+1)) + } + + call gseti (gp, G_PLTYPE, 3) + call gline (gp, 0., 0., 0., 1.) + call gseti (gp, G_PLTYPE, 1) + + if (nx <= NMAX && ny <= NMAX) + call spf_label (gp, sfd, 31, 2) + } + } + } + + call gsview (gp, vx, vx+nx*dvx, vy, vy+ny*dvy) + call gswind (gp, 0.5, 0.5+nx, 0.5+ny, 0.5) + call gamove (gp, 1., 1.) + + # Draw label + call gseti (gp, G_DRAWAXES, 0) + call glabax (gp, Memc[str], "", "") + + call sfree (sp) +end + + +# SPF_G5 -- Spectra at a given sample + +procedure spf_g5 (gp, sfcur, sfs, nimages, ix, iy, nx, ny) + +pointer gp # GIO pointer +pointer sfcur # Current image +pointer sfs[nimages] # Images +int nimages # Number of images +int ix, iy # Sample +int nx, ny # Grid layout + +int i, j, k, npts +real x1, x2, y1, y2, vx, dvx, vy, dvy, fa[10] +pointer sp, str, sf, sfd, spec + +begin + call smark (sp) + call salloc (str, SZ_LINE, TY_CHAR) + + # Set subviewport parameters + call ggview (gp, vx, dvx, vy, dvy) + dvx = (dvx - vx) / nx + dvy = (dvy - vy) / ny + + # Draw bounding box and label + if (SF_NSFD(sfcur) > 1) { + call sprintf (Memc[str], SZ_LINE, + "All Images at Sample [%d:%d,%d:%d]") + call pargi (SF_X1(sfcur)+(ix-1)*SF_DX(sfcur)) + call pargi (SF_X1(sfcur)+ix*SF_DX(sfcur)-1) + call pargi (SF_Y1(sfcur)+(iy-1)*SF_DY(sfcur)) + call pargi (SF_Y1(sfcur)+iy*SF_DY(sfcur)-1) + } else + Memc[str] = EOS + + call gseti (gp, G_DRAWAXES, 0) + call gseti (gp, G_DRAWTICKS, NO) + call glabax (gp, Memc[str], "", "") + call gseti (gp, G_DRAWAXES, 3) + + # Draw spectra + k = 0 + do j = 1, ny { + do i = 1, nx { + k = k + 1 + if (k > nimages) + break + + sf = sfs[k] + sfd = SFD(sf, ix, iy) + spec = SF_SPEC(sfd) + if (SF_AXIS(sf) == 1) + npts = SF_DX(sf) + else + npts = SF_DY(sf) + + x1 = 0.; x2 = 1. + call alimr (Memr[spec], npts, y1, y2) + y2 = y1 + (y2 - y1) * 1.5 + fa[1] = x1; fa[6] = y1 + fa[2] = x2; fa[7] = y1 + fa[3] = x2; fa[8] = y2 + fa[4] = x1; fa[9] = y2 + fa[5] = x1; fa[10] = y1 + call gswind (gp, x1, x2, y1, y2) + + if (sf == sfcur) { + call gsview (gp, vx+(i-1)*dvx+.005, vx+i*dvx-.005, + vy+(ny-j)*dvy+.005, vy+(ny-j+1)*dvy-.005) + call gsetr (gp, G_PLWIDTH, HLWIDTH) + call gseti (gp, G_PLCOLOR, HLCOLOR) + call gpline (gp, fa, fa[6], 5) + call gsetr (gp, G_PLWIDTH, 1.) + call gseti (gp, G_PLCOLOR, 1) + } + + call gsview (gp, vx+(i-1)*dvx, vx+i*dvx, + vy+(ny-j)*dvy, vy+(ny-j+1)*dvy) + call glabax (gp, "", "", "") + + if (SF_DEL(sfd) == NO) { + call gvline (gp, Memr[spec], npts, x1, x2) + + if (nx <= NMAX && ny <= NMAX) + call spf_label (gp, sfd, 31, 2) + } + } + } + + call gsview (gp, vx, vx+nx*dvx, vy, vy+ny*dvy) + call gswind (gp, 0.5, 0.5+nx, 0.5+ny, 0.5) + call gamove (gp, 1., 1.) + + call sfree (sp) +end + + +# SPF_G6 -- Spectra at a given image + +procedure spf_g6 (gp, sfcur, ix, iy) + +pointer gp # GIO pointer +pointer sfcur # Current image +int ix, iy # Sample + +int i, j, nx, ny, npts +real x1, x2, y1, y2, vx, dvx, vy, dvy, fa[10] +pointer sp, str, sfd, spec + +begin + call smark (sp) + call salloc (str, SZ_LINE, TY_CHAR) + + nx = SF_NX(sfcur) + ny = SF_NY(sfcur) + if (SF_AXIS(sfcur) == 1) + npts = SF_DX(sfcur) + else + npts = SF_DY(sfcur) + + # Set subviewport parameters + call ggview (gp, vx, dvx, vy, dvy) + dvx = (dvx - vx) / nx + dvy = (dvy - vy) / ny + + # Draw bounding box and label + call sprintf (Memc[str], SZ_LINE, "Image %s with Focus %.3g") + call pargstr (SF_IMAGE(sfcur)) + call pargr (SF_FOCUS(sfcur)) + + call gseti (gp, G_DRAWTICKS, NO) + call glabax (gp, Memc[str], "", "") + + # Draw spectra + do j = 1, ny { + do i = 1, nx { + sfd = SFD(sfcur,i,j) + spec = SF_SPEC(sfd) + + x1 = 0.; x2 = 1. + call alimr (Memr[spec], npts, y1, y2) + y2 = y1 + (y2 - y1) * 1.5 + fa[1] = x1; fa[6] = y1 + fa[2] = x2; fa[7] = y1 + fa[3] = x2; fa[8] = y2 + fa[4] = x1; fa[9] = y2 + fa[5] = x1; fa[10] = y1 + call gswind (gp, x1, x2, y1, y2) + + if (i == ix && j == iy) { + call gsview (gp, vx+(i-1)*dvx+.005, vx+i*dvx-.005, + vy+(j-1)*dvy+.005, vy+j*dvy-.005) + call gsetr (gp, G_PLWIDTH, HLWIDTH) + call gseti (gp, G_PLCOLOR, HLCOLOR) + call gpline (gp, fa, fa[6], 5) + call gsetr (gp, G_PLWIDTH, 1.) + call gseti (gp, G_PLCOLOR, 1) + } + + call gsview (gp, vx+(i-1)*dvx, vx+i*dvx, vy+(j-1)*dvy, vy+j*dvy) + call glabax (gp, "", "", "") + + if (SF_DEL(sfd) == NO) { + call gvline (gp, Memr[spec], npts, x1, x2) + + if (nx <= NMAX && ny <= NMAX) + call spf_label (gp, sfd, 21, 2) + } + } + } + + call gsview (gp, vx, vx+nx*dvx, vy, vy+ny*dvy) + call gswind (gp, 0.5, 0.5+nx, 0.5, 0.5+ny) + call gamove (gp, 1., 1.) + + call sfree (sp) +end + + +# SPF_G7 -- Profile at a given image and sample + +procedure spf_g7 (gp, sfbest, sfcur, ix, iy, lag) + +pointer gp # GIO pointer +pointer sfbest # Best image +pointer sfcur # Current image +int ix, iy # Sample +int lag # Maximum lag + +real x1, x2, y1, y2, z1, z2, dz, x, p, s, asieval() +pointer sp, str, sf, sfd, asi + +begin + call smark (sp) + call salloc (str, SZ_LINE, TY_CHAR) + + sf = sfcur + sfd = SFD(sf,ix,iy) + asi = SF_ASI(sfd) + + s = 1 / sqrt (2.) + x2 = s * min (lag, nint (3 * SF_WIDTH(sf))) + x1 = -x2 + y1 = -0.05 + y2 = 1.05 + call gswind (gp, x1, x2, y1, y2) + + if (abs (SF_POS(sfd)) > .01) { + call sprintf (Memc[str], SZ_LINE, + "%s at (%d, %d), Focus %.3g, Width %.2f, Shift %.2f") + call pargstr (SF_IMAGE(sf)) + call pargr (SF_X(sfd)) + call pargr (SF_Y(sfd)) + call pargr (SF_FOC(sfd)) + call pargr (SF_WID(sfd)) + call pargr (SF_POS(sfd)) + } else { + call sprintf (Memc[str], SZ_LINE, + "%s at (%d, %d), Focus %.3g, Width %.2f") + call pargstr (SF_IMAGE(sf)) + call pargr (SF_X(sfd)) + call pargr (SF_Y(sfd)) + call pargr (SF_FOC(sfd)) + call pargr (SF_WID(sfd)) + } + call glabax (gp, Memc[str], "Pixel", "Correlation") + + # Draw correlation profiles + if (SF_DEL(sfd) == NO) { + p = SF_POS(sfd) + z1 = max (x1, x1-p) + z2 = min (x2, x2-p) + dz = s + for (x=s*nint(z1/s); x<=s*nint(z2/s); x=x+dz) + call gmark (gp, x+p, asieval (asi, x/s+lag+1), GM_PLUS, 2., 2.) + call gamove (gp, z1+p, asieval (asi, z1/s+lag+1)) + dz = .1 * s + for (x=z1+dz; x<=z2; x=x+dz) + call gadraw (gp, x+p, asieval (asi, x/s+lag+1)) + if (sf != sfbest) { + asi = SF_ASI(SFD(sfbest,ix,iy)) + call gamove (gp, z1+p, asieval (asi, z1/s+lag+1)) + for (x=z1+dz; x<=z2; x=x+dz) + call gadraw (gp, x+p, asieval (asi, x/s+lag+1)) + } + + call gseti (gp, G_PLTYPE, 3) + call gline (gp, 0., y1, 0., y2) + call gseti (gp, G_PLTYPE, 1) + } + + call sfree (sp) +end + + +# SPF_G8 -- Spatial distribution of widths + +procedure spf_g8 (gp, sfavg, sfcur, sfdcur, sfs, nimages, nxgrid, nygrid) + +pointer gp # GIO pointer +pointer sfavg # Average image +pointer sfcur # Current image +pointer sfdcur # Current sample +pointer sfs[nimages] # Images +int nimages # Number of images +int nxgrid, nygrid # Grid layout + +int nx, ny +int i, j, k, l, m +real x, y, z, x1, x2, y1, y2, z1, z2, fa[10] +pointer sp, str, sf, sfd, kmin, kptr + +begin + call smark (sp) + call salloc (str, SZ_LINE, TY_CHAR) + + # Set subviewport parameters + nx = SF_NX(sfavg) + ny = SF_NY(sfavg) + call ggview (gp, x1, x2, y1, y2) + x2 = (x2 - x1) / nxgrid + y2 = (y2 - y1) / nygrid + fa[1] = 0.; fa[6] = 0. + fa[2] = 1.; fa[7] = 0. + fa[3] = 1.; fa[8] = 1. + fa[4] = 0.; fa[9] = 1. + fa[5] = 0.; fa[10] = 0. + + call gseti (gp, G_DRAWTICKS, NO) + + # Find best focus at each sample and range of WID + call salloc (kmin, nx*ny, TY_INT) + kptr = kmin + z1 = MAX_REAL + z2 = -MAX_REAL + do j = 1, ny { + do i = 1, nx { + l = 0 + sfd = SFD(sfavg,i,j) + if (SF_DEL(sfd) == NO) { + x = SF_FOC(sfd) + y = MAX_REAL + do k = 1, nimages { + sfd = SFD(sfs[k],i,j) + if (SF_DEL(sfd) == NO) { + z1 = min (z1, SF_WID(sfd)) + z2 = max (z2, SF_WID(sfd)) + z = abs (SF_FOC(sfd) - x) + if (z < y) { + l = k + y = z + } + } + } + } + Memi[kptr] = l + kptr = kptr + 1 + } + } + z2 = max (2., z2 - z1) + + # Make graphs + k = 0 + do j = 1, nygrid { + do i = 1, nxgrid { + k = k + 1 + if (k > nimages) + break + + sf = sfs[k] + nx = SF_NX(sfs[1]) + ny = SF_NY(sfs[1]) + + if (sf == sfcur) { + call gsview (gp, x1+(i-1)*x2+.005, x1+i*x2-.005, + y1+(nygrid-j)*y2+.005, y1+(nygrid-j+1)*y2-.005) + call gswind (gp, 0., 1., 0., 1.) + call gsetr (gp, G_PLWIDTH, HLWIDTH) + call gseti (gp, G_PLCOLOR, HLCOLOR) + call gpline (gp, fa, fa[6], 5) + call gsetr (gp, G_PLWIDTH, 1.) + call gseti (gp, G_PLCOLOR, 1) + } + + call gsview (gp, x1+(i-1)*x2, x1+i*x2, + y1+(nygrid-j)*y2, y1+(nygrid-j+1)*y2) + call gswind (gp, 0.5, 0.5+nx, 0.5, 1.5+ny) + call glabax (gp, "", "", "") + + kptr = kmin + do m = 1, ny { + do l = 1, nx { + sfd = SFD(sf,l,m) + if (SF_DEL(sfd) == NO) { + x = l + y = m + z = SF_WID(sfd) + z = 0.008 * (1 + (z - z1) / z2 * 3) + call gmark (gp, x, y, GM_CIRCLE, z, z) + if (Memi[kptr] == k) + call gmark (gp, x, y, GM_PLUS, z, z) + if (sfd == sfdcur) { + call gseti (gp, G_PLCOLOR, HLCOLOR) + call gmark (gp, x, y, GM_BOX, -.8, -.8) + call gseti (gp, G_PLCOLOR, 1) + } + } + kptr = kptr + 1 + } + } + + if (nxgrid <= NMAX && nygrid <= NMAX) + call spf_label (gp, sfd, 11, 2) + } + } + + call gsview (gp, x1, x1+nxgrid*x2, y1, y1+nygrid*y2) + call gswind (gp, 0.5, 0.5+nxgrid, 0.5+nygrid, 0.5) + call gamove (gp, 1., 1.) + + call sfree (sp) +end + + +# SPF_G9 -- Spectrum at a given image and sample + +procedure spf_g9 (gp, sfcur, ix, iy) + +pointer gp # GIO pointer +pointer sfcur # Current image +int ix, iy # Sample + +int npts +real x1, x2 +pointer sf, sfd, spec + +begin + sf = sfcur + sfd = SFD(sf,ix,iy) + spec = SF_SPEC(sfd) + if (SF_AXIS(sf) == 1) { + npts = SF_DX(sf) + x1 = SF_X1(sf) + (ix - 1) * npts + } else { + npts = SF_DY(sf) + x1 = SF_Y1(sf) + (iy - 1) * npts + } + x2 = x1 + npts - 1 + call gswind (gp, x1, x2, INDEF, INDEF) + call gascale (gp, Memr[spec], npts, 2) + + if (SF_AXIS(sf) == 1) + call glabax (gp, "", "Column", "") + else + call glabax (gp, "", "Line", "") + if (SF_DEL(sfd) == NO) + call gvline (gp, Memr[spec], npts, x1, x2) +end + + +# SPF_LABEL -- Label + +procedure spf_label (gp, sfd, type, width) + +pointer gp # GIO pointer +pointer sfd # Sample pointer +int type # Label type +int width # Line width + +int bkup, gstati() +real x1, x2, y1, y2, xs, ys, x, y +pointer sp, str + +begin + call smark (sp) + call salloc (str, SZ_LINE, TY_CHAR) + + bkup = gstati (gp, G_PLWIDTH) + call gseti (gp, G_PLWIDTH, width) + call ggwind (gp, x1, x2, y1, y2) + call ggscale (gp, x1, y1, xs, ys) + call gline (gp, x1, y1, x1, y1) + + switch (type) { + case 11: # 1 across the top + x = x2 - 0.01 * xs; y = y2 - 0.01 * ys + call sprintf (Memc[str], SZ_LINE, "%.3g") + call pargr (SF_FOC(sfd)) + call gtext (gp, x, y, Memc[str], "h=r;v=t") + case 21: # 2 across the top + x = x1 + 0.01 * xs; y = y2 - 0.01 * ys + call sprintf (Memc[str], SZ_LINE, "%.2f") + call pargr (SF_WID(sfd)) + call gtext (gp, x, y, Memc[str], "h=l;v=t") + if (abs (SF_POS(sfd)) >= .01) { + x = x2 - 0.01 * xs; y = y2 - 0.01 * ys + call sprintf (Memc[str], SZ_LINE, "%.2f") + call pargr (SF_POS(sfd)) + call gtext (gp, x, y, Memc[str], "h=r;v=t") + } + case 31: # 3 across the top + x = x1 + 0.01 * xs; y = y2 - 0.01 * ys + call sprintf (Memc[str], SZ_LINE, "%.2f") + call pargr (SF_WID(sfd)) + call gtext (gp, x, y, Memc[str], "h=l;v=t") + x = x2 - 0.01 * xs; y = y2 - 0.01 * ys + call sprintf (Memc[str], SZ_LINE, "%.3g") + call pargr (SF_FOC(sfd)) + call gtext (gp, x, y, Memc[str], "h=r;v=t") + if (abs (SF_POS(sfd)) >= .01) { + x = (x1 + x2) / 2; y = y2 - 0.01 * ys + call sprintf (Memc[str], SZ_LINE, "%.2f") + call pargr (SF_POS(sfd)) + call gtext (gp, x, y, Memc[str], "h=c;v=t") + } + case 12: # 2 along the left + x = x1 + 0.02 * xs; y = y2 - 0.02 * ys + call sprintf (Memc[str], SZ_LINE, "%.2f") + call pargr (SF_WID(sfd)) + call gtext (gp, x, y, Memc[str], "h=l;v=t") + if (abs (SF_POS(sfd)) >= .01) { + x = x1 + 0.02 * xs; y = y2 - 0.06 * ys + call sprintf (Memc[str], SZ_LINE, "%.2f") + call pargr (SF_POS(sfd)) + call gtext (gp, x, y, Memc[str], "h=l;v=t") + } + case 13: # 3 along the left + x = x1 + 0.02 * xs; y = y2 - 0.02 * ys + call sprintf (Memc[str], SZ_LINE, "%.2f") + call pargr (SF_WID(sfd)) + call gtext (gp, x, y, Memc[str], "h=l;v=t") + x = x1 + 0.02 * xs; y = y2 - 0.10 * ys + call sprintf (Memc[str], SZ_LINE, "%.3g") + call pargr (SF_FOC(sfd)) + call gtext (gp, x, y, Memc[str], "h=l;v=t") + if (abs (SF_POS(sfd)) >= .01) { + x = x1 + 0.02 * xs; y = y2 - 0.06 * ys + call sprintf (Memc[str], SZ_LINE, "%.2f") + call pargr (SF_POS(sfd)) + call gtext (gp, x, y, Memc[str], "h=l;v=t") + } + } + + call gseti (gp, G_PLWIDTH, bkup) + + call sfree (sp) +end + + +# SPF_SAMPLE -- Find the nearest sample to the cursor position + +procedure spf_sample (sfs, nimages, del, wx, wy, i, j, k) + +pointer sfs[nimages] #I Images +int nimages #I Number of images +int del #I Deletion flag +real wx, wy #I Cursor coordinate +int i, j, k #O Nearest sample and image + +int i1, j1, k1, k2 +real r, rmin + +begin + rmin = MAX_REAL + k1 = k + do k2 = 0, 2 * nimages { + if (mod (k2, 2) == 0) + k1 = k1 + k2 + else + k1 = k1 - k2 + if (k1 < 1 || k1 > nimages) + next + do j1 = 1, SF_NY(sfs[k1]) { + do i1 = 1, SF_NX(sfs[k1]) { + if (SF_DEL(SFD(sfs[k1],i1,j1)) == del) { + r = (i1 - wx) ** 2 + (j1 - wy) ** 2 + if (r < rmin) { + i = i1 + j = j1 + k = k1 + rmin = r + } + } + } + } + + if (rmin < MAX_REAL) + break + } +end diff --git a/noao/obsutil/src/specfocus/t_specfocus.x b/noao/obsutil/src/specfocus/t_specfocus.x new file mode 100644 index 00000000..7f176de5 --- /dev/null +++ b/noao/obsutil/src/specfocus/t_specfocus.x @@ -0,0 +1,762 @@ +include +include +include +include +include +include +include "specfocus.h" + + +# T_SPECFOCUS -- Spectral focusing task + +procedure t_specfocus () + +int list # List of images +pointer fvals # List of focus values +int dispaxis # Default dispersion axis +int amin # Lower edge of data along slit +int amax # Upper edge of data along slit +int nspec # Number of spectra to subdivide width +int ndisp # Number of dispersion samples +int lag # Maximum lag +real level # Level for width +bool shifts # Measure shifts? +int log # Log file descriptor + +int i, j, k, l, nimages, npix, nprep +int aaxis, a1, da, na +int baxis, b1, db, nb +int c1, dc, nc +int l1, dl, nl +pointer sp, image, sys +pointer rg, sfs, sf, sfd, sfavg, sfbest, im, mw, data, buf1, buf2 +pointer rng_open(), immap(), imgl2r(), mw_openim() +int clgeti(), imgeti(), imtopenp(), imtlen(), imtgetim(), nowhite() +int rng_index(), open() +real rval, clgetr(), imgetr(), asumr() +bool ms, clgetb(), streq() +errchk immap, spf_width + +int spf_compare() +extern spf_compare + +begin + call smark (sp) + call salloc (fvals, SZ_LINE, TY_CHAR) + call salloc (image, SZ_FNAME, TY_CHAR) + call salloc (sys, SZ_FNAME, TY_CHAR) + + # Get task parameters (except log file) + list = imtopenp ("images") + call clgstr ("focus", Memc[fvals], SZ_LINE) + dispaxis = clgeti ("dispaxis") + amin = clgeti ("slit1") + amax = clgeti ("slit2") + nspec = clgeti ("nspectra") + ndisp = clgeti ("ndisp") + lag = (clgeti ("corwidth") + 1) / 2 + level = clgetr ("level") + shifts = clgetb ("shifts") + + if (level > 1.) + level = level / 100. + level = max (0.05, min (0.95, level)) + + # Initialize focus values + if (nowhite (Memc[fvals], Memc[fvals], SZ_LINE) == 0) + call strcpy ("1x1", Memc[fvals], SZ_LINE) + iferr (rg = rng_open (Memc[fvals], -MAX_REAL, MAX_REAL, 1.)) + rg = NULL + + # Allocate array for the image focus data structure pointers + nimages = imtlen (list) + call malloc (sfs, nimages, TY_POINTER) + + # Accumulate the focus data + nimages = 0 + while (imtgetim (list, Memc[image], SZ_FNAME) != EOF) { + im = immap (Memc[image], READ_ONLY, 0) + mw = mw_openim (im) + call mw_gsystem (mw, Memc[sys], SZ_FNAME) + ms = streq (Memc[sys], "multispec") + call mw_close (mw) + + # Set the focus value + if (rg != NULL) { + if (rng_index (rg, nimages+1, rval) == EOF) + call error (1, "Focus list ended prematurely") + } else + rval = imgetr (im, Memc[fvals]) + + # Set dispersion and cross dispersion axes + if (ms) { + baxis = 1 + aaxis = 2 + + # Set sampling across the dispersion axis + if (IS_INDEFI (amin)) + i = 1 + else + i = amin + if (IS_INDEFI (amax)) + j = IM_LEN(im,aaxis) + else + j = amax + a1 = max (1, min (i, j)) + da = min (IM_LEN(im,aaxis), max (i, j)) - a1 + 1 + if (da < 1) + call error (1, "Error in slit limits") + na = da + da = da / na + + # Set sampling along the dispersion axis + npix = IM_LEN(im,baxis) + nb = min (ndisp, npix / 100) + db = npix / nb + b1 = 1 + (npix - nb * db) / 2 + + # Set sampling along the columns and lines + c1 = b1; dc = db; nc = nb + l1 = a1; dl = da; nl = na + } else { + iferr (baxis = imgeti (im, "dispaxis")) + baxis = dispaxis + aaxis = 3 - baxis + + # Set sampling across the dispersion axis + if (IS_INDEFI (amin)) + i = 1 + else + i = amin + if (IS_INDEFI (amax)) + j = IM_LEN(im,aaxis) + else + j = amax + a1 = max (1, min (i, j)) + da = min (IM_LEN(im,aaxis), max (i, j)) - a1 + 1 + if (da < 1) + call error (1, "Error in slit limits") + na = min (nspec, da) + da = da / na + + # Set sampling along the dispersion axis + npix = IM_LEN(im,baxis) + nb = min (ndisp, npix / 100) + db = npix / nb + b1 = 1 + (npix - nb * db) / 2 + + # Set sampling along the columns and lines + if (baxis == 1) { + c1 = b1; dc = db; nc = nb + l1 = a1; dl = da; nl = na + } else { + c1 = a1; dc = da; nc = na + l1 = b1; dl = db; nl = nb + } + } + + # Check for consistency + if (nimages > 0) { + if (baxis!=SF_AXIS(sf) || + c1!=SF_X1(sf) || dc!=SF_DX(sf) || nc!=SF_NX(sf) || + l1!=SF_Y1(sf) || dl!=SF_DY(sf) || nl!=SF_NY(sf)) + call error (1, "Input images have different formats") + } + + # Allocate the focus data structure for the image + call spf_alloc (sf, Memc[image], rval, level, baxis, npix, na, + c1, dc, nc, l1, dl, nl) + + # Get the spectrum samples + if (baxis == 1) { + do i = 1, na { + k = a1 + (i - 1) * da + l = k + da - 1 + data = SF_DATA(sf) + (i - 1) * npix + do j = k, l + call aaddr (Memr[imgl2r(im,j)], Memr[data], Memr[data], + npix) + } + } else { + do j = 1, npix { + buf1 = imgl2r (im, j) + data = SF_DATA(sf) + j - 1 + do i = 1, na { + k = a1 + (i - 1) * da + Memr[data] = asumr (Memr[buf1+k-1], da) + data = data + npix + } + } + } + Memi[sfs+nimages] = sf + nimages = nimages + 1 + + call imunmap (im) + } + + if (nimages == 0) + call error (1, "No input data") + + # Sort the structures + call qsort (Memi[sfs], nimages, spf_compare) + + # Allocate structure for the best focus + call spf_alloc (sfavg, "Best", INDEF, level, baxis, 0, 0, c1, dc, nc, + l1, dl, nl) + + # Compute the correlations and profile width and position + nprep = db + 2 * lag + call malloc (buf1, nprep, TY_REAL) + call malloc (buf2, nprep, TY_REAL) + l = (na + 1) / 2 + do k = 1, nimages { + sf = Memi[sfs+k-1] + do i = 1, nb { + if (baxis == 1) + sfd = SFD(sf,i,l) + else + sfd = SFD(sf,l,i) + call spf_prep (Memr[SF_SPEC(sfd)], db, Memr[buf1], nprep) + call spf_corr (Memr[buf1], Memr[buf1], nprep, lag, + SF_ASI(sfd), SF_POS(sfd), SF_WID(sfd), SF_LEVEL(sf)) + do j = 1, na { + if (j != l) { + if (baxis == 1) + sfd = SFD(sf,i,j) + else + sfd = SFD(sf,j,i) + call spf_prep (Memr[SF_SPEC(sfd)], db, Memr[buf2], + nprep) + call spf_corr (Memr[buf2], Memr[buf2], nprep, lag, + SF_ASI(sfd), SF_POS(sfd), SF_WID(sfd), SF_LEVEL(sf)) + if (shifts) + call spf_corr (Memr[buf2], Memr[buf1], nprep, + lag, SF_ASI(sfd), SF_POS(sfd), rval, + SF_LEVEL(sf)) + } + } + } + } + call mfree (buf1, TY_REAL) + call mfree (buf2, TY_REAL) + + # Set the averages + call spf_fitfocus (Memi[sfs], nimages, sfavg, sfbest) + + # Graph the results + call spf_graph (sfavg, sfbest, Memi[sfs], nimages, lag) + + # Log the results + call spf_log (sfavg, sfbest, Memi[sfs], nimages, shifts, STDOUT) + call clgstr ("logfile", Memc[image], SZ_FNAME) + ifnoerr (log = open (Memc[image], APPEND, TEXT_FILE)) { + call spf_log (sfavg, sfbest, Memi[sfs], nimages, shifts, log) + call close (log) + } + + # Finish up + do i = 1, nimages + call spf_free (Memi[sfs+i-1]) + call spf_free (sfavg) + call mfree (sfs, TY_POINTER) + call rng_close (rg) + call imtclose (list) + call sfree (sp) +end + + +# SPF_ALLOC -- Allocate a focus data structure for an image + +procedure spf_alloc (sf, image, focus, level, axis, ndisp, nspec, + x1, dx, nx, y1, dy, ny) + +pointer sf # Image focus data structure +char image[ARB] # Image name +real focus # Focus value +real level # Level for width +int axis # Dispersion axis +int ndisp # Number of pixels (along dispersion) +int nspec # Number of spectra (across dispersion) +int x1, dx, nx # X sampling +int y1, dy, ny # Y sampling + +int i, j +pointer data, sfd + +begin + call calloc (sf, LEN_SF, TY_STRUCT) + + call strcpy (image, SF_IMAGE(sf), SZ_SFFNAME) + SF_FOCUS(sf) = focus + SF_WIDTH(sf) = INDEF + SF_LEVEL(sf) = level + SF_AXIS(sf) = axis + SF_X1(sf) = x1 + SF_DX(sf) = dx + SF_NX(sf) = nx + SF_Y1(sf) = y1 + SF_DY(sf) = dy + SF_NY(sf) = ny + call malloc (SF_SFD(sf), nx*ny, TY_POINTER) + SF_NSFD(sf) = nx*ny + SF_NPIX(sf) = ndisp + if (ndisp > 0) + call calloc (SF_DATA(sf), ndisp * nspec, TY_REAL) + + data = SF_DATA(sf) + do j = 1, ny { + do i = 1, nx { + call calloc (sfd, LEN_SFD, TY_STRUCT) + SFD(sf,i,j) = sfd + SF_X(sfd) = x1 + (i - 0.5) * dx + SF_Y(sfd) = y1 + (j - 0.5) * dy + if (ndisp > 0) { + if (axis == 1) + SF_SPEC(sfd) = data + (j-1)*ndisp + (i-1)*dx + x1-1 + else + SF_SPEC(sfd) = data + (i-1)*ndisp + (j-1)*dy + y1-1 + } + call asiinit (SF_ASI(sfd), II_SPLINE3) + SF_FOC(sfd) = focus + SF_WID(sfd) = INDEF + SF_POS(sfd) = INDEF + SF_DEL(sfd) = NO + } + } +end + + +# SPF_FREE -- Free a focus image data structure + +procedure spf_free (sf) + +pointer sf # Image focus data structure + +int i +pointer sfd + +begin + do i = 1, SF_NSFD(sf) { + sfd = SFD(sf,i,1) + call asifree (SF_ASI(sfd)) + call mfree (sfd, TY_STRUCT) + } + call mfree (SF_DATA(sf), TY_REAL) + call mfree (SF_SFD(sf), TY_POINTER) + call mfree (sf, TY_STRUCT) +end + + +# SPF_PREP -- Prepare spectra for correlation: fit continuum, subtract, taper + +procedure spf_prep (in, nin, out, nout) + +real in[nin] # Input spectrum +int nin # Number of pixels in input spectrum +real out[nout] # Output spectrum +int nout # Number of pixels output spectrum (nin+2*lag) + +int i, lag +real cveval() +pointer sp, x, w, ic, cv + +begin + call smark (sp) + call salloc (x, nin, TY_REAL) + call salloc (w, nin, TY_REAL) + + call ic_open (ic) + call ic_pstr (ic, "function", "chebyshev") + call ic_puti (ic, "order", 3) + call ic_putr (ic, "low", 3.) + call ic_putr (ic, "high", 1.) + call ic_puti (ic, "niterate", 5) + call ic_putr (ic, "grow", 1.) + call ic_putr (ic, "xmin", 1.) + call ic_putr (ic, "xmax", real(nin)) + + do i = 1, nin { + Memr[x+i-1] = i + Memr[w+i-1] = 1 + } + call ic_fit (ic, cv, Memr[x], in, Memr[w], nin, YES, YES, YES, YES) + + lag = (nout - nin) / 2 + do i = 1-lag, 0 + out[i+lag] = 0. + do i = 1, lag-1 + out[i+lag] = (1-cos (PI*i/lag))/2 * (in[i] - cveval (cv, real(i))) + do i = lag, nin-lag+1 + out[i+lag] = (in[i] - cveval (cv, real(i))) + do i = nin-lag+2, nin + out[i+lag] = (1-cos (PI*(nin+1-i)/lag))/2 * + (in[i] - cveval (cv, real(i))) + do i = nin+1, nin+lag + out[i+lag] = 0. + + call cvfree (cv) + call ic_closer (ic) + call sfree (sp) +end + + +# SPF_CORR -- Correlate spectra, fit profile, and measure center/width + +procedure spf_corr (spec1, spec2, npix, lag, asi, center, width, level) + +real spec1[npix] # First spectrum +real spec2[npix] # Second spectrum +int npix # Number of pixels in spectra +int lag # Maximum correlation lag +pointer asi # Pointer to correlation profile interpolator +real center # Center of profile +real width # Width of profile +real level # Level at which width is determined + +int i, j, nprof +real x, p, pmin, pmax, asieval() +pointer sp, prof + +begin + nprof = 2 * lag + 1 + + call smark (sp) + call salloc (prof, nprof, TY_REAL) + + do j = -lag, lag { + p = 0. + do i = 1+lag, npix-lag + p = p + spec1[i] * spec2[i-j] + Memr[prof+j+lag] = p + } + + # Fit interpolator + call asifit (asi, Memr[prof], nprof) + + # Find the minimum and maximum + center = 1. + pmin = asieval (asi, 1.) + pmax = pmin + for (x=1; x<=nprof; x=x+.01) { + p = asieval (asi, x) + if (p < pmin) + pmin = p + if (p > pmax) { + pmax = p + center = x + } + } + + # Normalize + pmax = pmax - pmin + do i = 0, nprof-1 + Memr[prof+i] = (Memr[prof+i] - pmin) / pmax + + call asifit (asi, Memr[prof], nprof) + + # Find the equal flux points + for (x=center; x>=1 && asieval (asi,x)>level; x=x-0.01) + ; + width = x + for (x=center; x<=nprof && asieval (asi,x)>level; x=x+0.01) + ; + width = (x - width - 0.01) / sqrt (2.) + center = center - lag - 1 + + call sfree (sp) +end + + +# SPF_FITFOCUS -- Find the best focus at each sample and the average over all +# samples. + +procedure spf_fitfocus (sfs, nimages, sfavg, sfbest) + +pointer sfs[nimages] #I Images +int nimages #I Number of images +pointer sfavg #U Average image +pointer sfbest #U Best focus image + +int i, j, n, jmin, nims +pointer sp, x, y, z, sfd +real focus, fwhm, pos, foc +bool fp_equalr() + +define avg_ 10 + +begin + call smark (sp) + call salloc (x, nimages, TY_REAL) + call salloc (y, nimages, TY_REAL) + call salloc (z, nimages, TY_REAL) + + do i = 1, SF_NSFD(sfavg) { + # Collect the focus values + nims = 0 + do j = 1, nimages { + sfd = SFD(sfs[j],i,1) + if (SF_DEL(sfd) == NO) { + Memr[x+nims] = SF_FOC(sfd) + Memr[y+nims] = SF_WID(sfd) + Memr[z+nims] = SF_POS(sfd) + nims = nims + 1 + } + } + sfd = SFD(sfavg,i,1) + + # Take the smallest width at each unique focus. + if (nims > 0) { + call xt_sort3 (Memr[x], Memr[y], Memr[z], nims) + n = 0 + do j = 1, nims-1 { + if (fp_equalr (Memr[x+n], Memr[x+j])) { + if (Memr[y+n] > Memr[y+j]) { + Memr[y+n] = Memr[y+j] + Memr[z+n] = Memr[z+j] + } + } else { + n = n + 1 + Memr[x+n] = Memr[x+j] + Memr[y+n] = Memr[y+j] + Memr[z+n] = Memr[z+j] + } + } + + # Find the minimum width + jmin = 0 + do j = 1, n + if (Memr[y+j] < Memr[y+jmin]) + jmin = j + + # Use parabolic interpolation to find the best focus + if (jmin == 0 || jmin == n) { + focus = Memr[x+jmin] + fwhm = Memr[y+jmin] + pos = Memr[z+jmin] + } else + call spf_parab (Memr[x+jmin-1], Memr[y+jmin-1], + Memr[z+jmin-1], focus, fwhm, pos) + + SF_FOC(sfd) = focus + SF_WID(sfd) = fwhm + SF_POS(sfd) = pos + SF_DEL(sfd) = NO + } else { + SF_FOC(sfd) = INDEF + SF_WID(sfd) = INDEF + SF_POS(sfd) = INDEF + SF_DEL(sfd) = YES + } + } + + call sfree (sp) + +avg_ + # Set the averages over all samples + n = 0 + focus = 0. + fwhm = 0. + do i = 1, SF_NSFD(sfavg) { + sfd = SFD(sfavg,i,1) + if (SF_DEL(sfd) == NO) { + focus = focus + SF_FOC(sfd) + fwhm = fwhm + SF_WID(sfd) + n = n + 1 + } + } + + if (n > 0) { + SF_FOCUS(sfavg) = focus / n + SF_WIDTH(sfavg) = fwhm / n + } else { + SF_FOCUS(sfavg) = INDEF + SF_WIDTH(sfavg) = INDEF + } + + do j = 1, nimages { + n = 0 + focus = 0. + fwhm = 0. + do i = 1, SF_NSFD(sfs[j]) { + sfd = SFD(sfs[j],i,1) + if (SF_DEL(sfd) == NO) { + fwhm = fwhm + SF_WID(sfd) + n = n + 1 + } + } + + if (n > 0) + SF_WIDTH(sfs[j]) = fwhm / n + else + SF_WIDTH(sfs[j]) = INDEF + } + + # Set the best focus image + sfbest = NULL + focus = SF_FOCUS(sfavg) + if (!IS_INDEF(focus)) { + pos = MAX_REAL + do j = 1, nimages { + foc = SF_FOCUS(sfs[j]) + if (!IS_INDEF(foc)) { + fwhm = abs (focus - foc) + if (fwhm < pos) { + pos = fwhm + sfbest = sfs[j] + } + } + } + } +end + + +# SPF_PARAB -- Find the minimum of a parabolic fit to three points. + +procedure spf_parab (x, y, z, xmin, ymin, zmin) + +real x[3] +real y[3] +real z[3] +real xmin +real ymin +real zmin + +real x12, x13, x23, x212, x213, x223, y12, y13, y23, a, b, c + +begin + x12 = x[1] - x[2] + x13 = x[1] - x[3] + x23 = x[2] - x[3] + x212 = x[1] * x[1] - x[2] * x[2] + x213 = x[1] * x[1] - x[3] * x[3] + x223 = x[2] * x[2] - x[3] * x[3] + y12 = y[1] - y[2] + y13 = y[1] - y[3] + y23 = y[2] - y[3] + c = (y13 - y23 * x13 / x23) / (x213 - x223 * x13 / x23) + b = (y23 - c * x223) / x23 + a = y[3] - b * x[3] - c * x[3] * x[3] + xmin = -b / (2 * c) + ymin = a + b * xmin + c * xmin * xmin + + if (xmin < x[2]) + zmin = z[2] + (z[1] - z[2]) / (x[1] - x[2]) * (xmin - x[2]) + else + zmin = z[2] + (z[3] - z[2]) / (x[3] - x[2]) * (xmin - x[2]) +end + + +# SPF_COMPARE -- Compare two structures by focus values + +int procedure spf_compare (sf1, sf2) + +pointer sf1, sf2 # Structures to be compared. + +begin + if (SF_FOCUS[sf1] < SF_FOCUS[sf2]) + return (-1) + else if (SF_FOCUS[sf1] > SF_FOCUS[sf2]) + return (1) + else + return (0) +end + + +# SPF_LOG -- Print log of results + +procedure spf_log (sfavg, sfbest, sfs, nimages, shifts, log) + +pointer sfavg # Average image +pointer sfbest # Best focus image +pointer sfs[nimages] # Images +int nimages # Number of images +bool shifts # Measure shifts? +int log # Log file descriptor + +int i, j +pointer sp, str, sfd + +begin + call smark (sp) + call salloc (str, SZ_LINE, TY_CHAR) + + call sysid (Memc[str], SZ_LINE) + call fprintf (log, "SPECFOCUS: %s\n") + call pargstr (Memc[str]) + + call fprintf (log, + " Best average focus at %g with average width of %.2f at %d%% of peak\n\n") + call pargr (SF_FOCUS(sfavg)) + call pargr (SF_WIDTH(sfavg)) + call pargr (100 * SF_LEVEL(sfavg)) + + call fprintf (log, " -- Average Over All Samples\n\n") + call fprintf (log, "\t%25wImage Focus Width\n") + do i = 1, nimages { + call fprintf (log, "\t%30s %5.3g %5.2f\n") + call pargstr (SF_IMAGE(sfs[i])) + call pargr (SF_FOCUS(sfs[i])) + call pargr (SF_WIDTH(sfs[i])) + } + call fprintf (log, "\n") + + call fprintf (log, " -- Image %s at Focus %g --\n") + call pargstr (SF_IMAGE(sfbest)) + call pargr (SF_FOCUS(sfbest)) + + if (SF_NSFD(sfbest) > 1) { + call fprintf (log, "\n\n\tWidth at %d%% of Peak:\n") + call pargr (100 * SF_LEVEL(sfavg)) + call fprintf (log, "\n\t%9w Columns\n\t%9w ") + do i = 1, SF_NX(sfbest) { + call fprintf (log, " %4d-%-4d") + call pargi (SF_X1(sfbest)+(i-1)*SF_DX(sfbest)) + call pargi (SF_X1(sfbest)+i*SF_DX(sfbest)-1) + } + call fprintf (log, "\n\t Lines +") + do i = 1, SF_NX(sfbest) + call fprintf (log, "-----------") + do j = 1, SF_NY(sfbest) { + if (SF_DY(sfbest) > 1.) { + call fprintf (log, "\n\t%4d-%-4d |") + call pargi (SF_Y1(sfbest)+(j-1)*SF_DY(sfbest)) + call pargi (SF_Y1(sfbest)+j*SF_DY(sfbest)-1) + } else { + call fprintf (log, "\n\t%9d |") + call pargi (SF_Y1(sfbest)+(j-1)*SF_DY(sfbest)) + call pargi (SF_Y1(sfbest)+j*SF_DY(sfbest)-1) + } + do i = 1, SF_NX(sfbest) { + sfd = SFD(sfbest,i,j) + call fprintf (log, " %5.2f ") + call pargr (SF_WID(sfd)) + } + } + if (shifts) { + call fprintf (log, + "\n\n\tPosition Shifts Relative To Central Sample:\n") + call fprintf (log, "\n\t%9w Columns\n\t%9w ") + do i = 1, SF_NX(sfbest) { + call fprintf (log, " %4d-%-4d") + call pargi (SF_X1(sfbest)+(i-1)*SF_DX(sfbest)) + call pargi (SF_X1(sfbest)+i*SF_DX(sfbest)-1) + } + call fprintf (log, "\n\t Lines +") + do i = 1, SF_NX(sfbest) + call fprintf (log, "-----------") + do j = 1, SF_NY(sfbest) { + call fprintf (log, "\n\t%4d-%-4d |") + call pargi (SF_Y1(sfbest)+(j-1)*SF_DY(sfbest)) + call pargi (SF_Y1(sfbest)+j*SF_DY(sfbest)-1) + do i = 1, SF_NX(sfbest) { + sfd = SFD(sfbest,i,j) + call fprintf (log, " %5.2f ") + call pargr (SF_POS(sfd)) + } + } + } + } + call fprintf (log, "\n\n") + + call sfree (sp) +end diff --git a/noao/obsutil/src/specfocus/x_specfocus.f b/noao/obsutil/src/specfocus/x_specfocus.f new file mode 100644 index 00000000..12500041 --- /dev/null +++ b/noao/obsutil/src/specfocus/x_specfocus.f @@ -0,0 +1,146 @@ + integer function sysruk (task, cmd, rukarf, rukint) + integer rukarf + integer rukint + integer*2 task(*) + integer*2 cmd(*) + integer i + integer ntasks + integer lmarg + integer rmarg + integer maxch + integer ncol + integer rukean + integer envgei + integer envscn + logical streq + logical xerpop + logical xerflg + common /xercom/ xerflg + integer iyy + integer dp(2) + integer*2 dict(10) + integer*2 st0001(9) + integer*2 st0002(6) + integer*2 st0003(3) + integer*2 st0004(6) + integer*2 st0005(6) + integer*2 st0006(4) + integer*2 st0007(6) + integer*2 st0008(2) + integer*2 st0009(29) + integer*2 st0010(25) + save + data (dict(iyy),iyy= 1, 8) /115,112,101, 99,102,111, 99,117/ + data (dict(iyy),iyy= 9,10) /115, 0/ + data (st0001(iyy),iyy= 1, 8) /116,116,121,110, 99,111,108,115/ + data (st0001(iyy),iyy= 9, 9) / 0/ + data st0002 / 99,104,100,105,114, 0/ + data st0003 / 99,100, 0/ + data st0004 /104,111,109,101, 36, 0/ + data st0005 / 72, 79, 77, 69, 36, 0/ + data st0006 /115,101,116, 0/ + data st0007 /114,101,115,101,116, 0/ + data st0008 / 9, 0/ + data (st0009(iyy),iyy= 1, 8) /105,110,118, 97,108,105,100, 32/ + data (st0009(iyy),iyy= 9,16) /115,101,116, 32,115,116, 97,116/ + data (st0009(iyy),iyy=17,24) /101,109,101,110,116, 58, 32, 39/ + data (st0009(iyy),iyy=25,29) / 37,115, 39, 10, 0/ + data (st0010(iyy),iyy= 1, 8) /105,110,118, 97,108,105,100, 32/ + data (st0010(iyy),iyy= 9,16) / 83, 69, 84, 32,105,110, 32, 73/ + data (st0010(iyy),iyy=17,24) / 82, 65, 70, 32, 77, 97,105,110/ + data (st0010(iyy),iyy=25,25) / 0/ + data (dp(iyy),iyy= 1, 2) / 1, 0/ + data lmarg /5/, maxch /0/, ncol /0/, rukean /3/ + data ntasks /0/ + if (.not.(ntasks .eq. 0)) goto 110 + i=1 +120 if (.not.(dp(i) .ne. 0)) goto 122 +121 i=i+1 + goto 120 +122 continue + ntasks = i - 1 +110 continue + if (.not.(task(1) .eq. 63)) goto 130 + call xerpsh + rmarg = envgei (st0001) + if (.not.xerpop()) goto 140 + rmarg = 80 +140 continue + call strtbl (4, dict, dp, ntasks, lmarg, rmarg, maxch, ncol) + sysruk = (0) + goto 100 +130 continue + if (.not.(streq(task,st0002) .or. streq(task,st0003))) goto 150 + call xerpsh + if (.not.(cmd(rukarf) .eq. 0)) goto 170 + call xerpsh + call xfchdr(st0004) + if (.not.xerpop()) goto 180 + call xfchdr(st0005) +180 continue + goto 171 +170 continue + call xfchdr(cmd(rukarf)) +171 continue +162 if (.not.xerpop()) goto 160 + if (.not.(rukint .eq. 1)) goto 190 + call erract (rukean) + if (xerflg) goto 100 + goto 191 +190 continue +191 continue +160 continue + sysruk = (0) + goto 100 +150 continue + if (.not.(streq(task,st0006) .or. streq(task,st0007))) goto 200 + call xerpsh + if (.not.(cmd(rukarf) .eq. 0)) goto 220 + call envlit (4, st0008, 1) + call xffluh(4) + goto 221 +220 continue + if (.not.(envscn (cmd) .le. 0)) goto 230 + if (.not.(rukint .eq. 1)) goto 240 + call eprinf (st0009) + call pargsr (cmd) + goto 241 +240 continue + goto 91 +241 continue +230 continue +221 continue +212 if (.not.xerpop()) goto 210 + if (.not.(rukint .eq. 1)) goto 250 + call erract (rukean) + if (xerflg) goto 100 + goto 251 +250 continue +91 call syspac (0, st0010) +251 continue +210 continue + sysruk = (0) + goto 100 +200 continue +151 continue +131 continue + if (.not.(streq (task, dict(dp(1))))) goto 260 + call tspecs + sysruk = (0) + goto 100 +260 continue + sysruk = (-1) + goto 100 +100 return + end +c rukint ruk_interact +c sysruk sys_runtask +c envscn envscan +c tspecs t_specfocus +c envgei envgeti +c syspac sys_panic +c eprinf eprintf +c rukarf ruk_argoff +c rukean ruk_eawarn +c pargsr pargstr +c envlit envlist diff --git a/noao/obsutil/src/specfocus/x_specfocus.x b/noao/obsutil/src/specfocus/x_specfocus.x new file mode 100644 index 00000000..063f2ce6 --- /dev/null +++ b/noao/obsutil/src/specfocus/x_specfocus.x @@ -0,0 +1 @@ +task specfocus = t_specfocus diff --git a/noao/obsutil/src/sptime/Revisions b/noao/obsutil/src/sptime/Revisions new file mode 100644 index 00000000..67cc787b --- /dev/null +++ b/noao/obsutil/src/sptime/Revisions @@ -0,0 +1,81 @@ +.help revisions Jun01 spectime +.nf + +t_sptime.x + 1. The use of the fiber diameter to set the aperture was not working. + 2. The listing of the fiber information was not working because it was + looking for a table "fibers" instead of "fiber". + 3. Fixed typo in label "indivdual" -> "individual". + (8/13/04, Valdes) + +============================ +SPECTIME V2.2: May 15, 2003 +============================ + +t_sptime.x +sptime.par +sptime.h + 1. Improved algorithm for handling saturation. + 2. Added a minimum exposure parameter. + (5/15/03, Valdes) + +t_sptime.x + The thermal background calculation was wrong. (3/17/03, Valdes) + +============================ +SPECTIME V2.1: March 3, 2003 +============================ + +sptime.h +t_sptime.x +sptime.par +../doc/sptime.hlp + Added a "shuffle" option for the sky subtraction. This assumes half + the cycle is object and half is sky and the same number of pixels are + used for both. The times in the calculator are the total time + (object+sky). (2/10/03) + +specpars.par + The choices for aperture type listed "cicle" instead of the correct + "circular". (2/10/03, Valdes) + +t_cgiparse.x + +mkpkg +x_spectime.x +../../obsutil.cl + Task to parse the CGI QUERY_STRING and set task parameters. + (4/19/02, Valdes) + +============================ +SPECTIME V2.0: August 15, 2001 +============================ + +Greatly revised version. + +t_sptime.x + Fixed a type mismatch in a max() function. (6/13/02, Valdes) + +============================ +SPECTIME V1.2: June 13, 2001 +============================ + +mkpkg + Added missing dependencies for t_sptime.x and tabinterp.x (12/13/01, MJF) + +t_sptime.x +sptime.par +sptime.h +mkpkg + 1. Added "units" parameter to allow different dispersion units. + This requires linking with libsmw.a from the noao package. + 2. Added IR bands. + 3. Changed so that transmisions of 1 are not reported. + 4. Added a parameter to the filter to override order overlap message. + The idea is that a single filter function can be used without requiring + the user to chose the filter. + (6/13/01, Valdes) + +================================ +SPECTIME V1.1: February 11, 2000 +================================ +.endhelp diff --git a/noao/obsutil/src/sptime/abzero.cl b/noao/obsutil/src/sptime/abzero.cl new file mode 100644 index 00000000..c8b3e76b --- /dev/null +++ b/noao/obsutil/src/sptime/abzero.cl @@ -0,0 +1,10 @@ +procedure abzero (w, logf) + +real w {prompt="Wavelength (microns)"} +real logf {prompt="Log f_lambda (W/cm^2/micron)"} + +begin + x = 10000 * w + y = -2.5 * (logf + 3) - 5 * log10 (x) - 2.4 + printf ("%d %.3f\n", x, y) +end diff --git a/noao/obsutil/src/sptime/blazeang.cl b/noao/obsutil/src/sptime/blazeang.cl new file mode 100644 index 00000000..2c55b3a2 --- /dev/null +++ b/noao/obsutil/src/sptime/blazeang.cl @@ -0,0 +1,24 @@ +procedure blazeang (g, w) + +real g = 316 {prompt="l/mm"} +real w = 7500 {prompt="Blaze wavelength (A)"} +real phi = 46. {prompt="Camera-collimator angle (deg)"} +real m = 1 {prompt="Order"} +real n = 1. {prompt="Index of refraction"} +real prism = 22 {prompt="Prism angle (deg)"} + +begin + real dtor, val + + dtor = 3.14159 / 180. + + if (n <= 1.) { + val = g * w * m / cos (phi/2*dtor) / 2e7 + val = atan2 (val, sqrt (1 - val**2)) / dtor + } else { +# val = g * w * m / 1e7 / (n - 1.) +# val = atan2 (val, sqrt (1 - val**2)) / dtor + val = g * w * m / 1e7 / sin (dtor * prism) + 1 + } + printf ("%.4g\n", val) +end diff --git a/noao/obsutil/src/sptime/blazefunc.cl b/noao/obsutil/src/sptime/blazefunc.cl new file mode 100644 index 00000000..31416fc7 --- /dev/null +++ b/noao/obsutil/src/sptime/blazefunc.cl @@ -0,0 +1,76 @@ +procedure blazefunc (grating, order) + +file grating {prompt="Grating"} +int order = INDEF {prompt="Order"} +real camcolangle = 45. {prompt="Camera-grating-collimator angle (deg)"} +string search = "spectimedb$KPNO/Gratings" {prompt="Directory search list\n"} + +string title = "" {prompt="Title"} +real w1 = 3000. {prompt="Lower wavelength to plot"} +real w2 = 12000. {prompt="Upper wavelength to plot\n"} + +real x1 = 3000. {prompt="Left graph wavelength"} +real x2 = 12000. {prompt="Right graph wavelength"} +real y1 = -5. {prompt="Bottom graph efficiency"} +real y2 = 105. {prompt="Top graph efficiency"} +string ltype = "1" {prompt="Line type"} +string color = "1" {prompt="Color"} +bool append = no {prompt="Append?"} + +struct *fd + +begin + file tmp1, tmp2 + real x, y + + tmp1 = mktemp ("tmp$iraf") + tmp2 = mktemp ("tmp$iraf") + + # Spectrograph. + print ("# area = 1", >> tmp1) + print ("# scale = 1", >> tmp1) + print ("# fl = 1", >> tmp1) + print ("# ndisp = 2000", >> tmp1) + print ("# pixsize = 1", >> tmp1) + + sptime (time=1., maxexp=3600., sn=25., spectrum="blackbody", + sky="", sensfunc="none", airmass=1., seeing=1., phase=0., + temperature=6000., index=0., refwave=INDEF, refflux=10., + funits="AB", abjohnson="none", wave=INDEF, order=order, + xorder=INDEF, width=1., length=1., diameter=1., + inoutangle=camcolangle, xinoutangle=INDEF, xbin=1, ybin=1, + search=search, spectrograph=tmp1, filter="none", + filter2="none", disperser=grating, xdisperser="none", + fiber="none", telescope=tmp1, adc="none", collimator=tmp1, + corrector="none", camera=tmp1, detector=tmp1, aperture=tmp1, + extinction="", gain=1., rdnoise=0., dark=0., skysub="none", + nskyaps=10, output="disperser", list=tmp2, graphics="", + interactive=no, nw=1000, > "dev$null") + + delete (tmp1, verify-) + + fd = tmp2 + while (fscan (fd, x, y) != EOF) { + if (nscan() != 2) + next + if (x < w1 || x > w2) + next + print (x, y, >> tmp1) + } + fd = "" + + if (title == "") + title = grating + + graph (tmp1, wx1=x1, wx2=x2, wy1=y1, wy2=y2, wcs="logical", axis=1, + transpose=no, pointmode=no, marker="box", szmarker=0.005, + ltypes=ltype, colors=color, logx=no, logy=no, box=yes, + ticklabels=yes, xlabel="Wavelength (A)", ylabel="Efficiency (%)", + xformat="wcsformat", yformat="", title=title, + lintran=no, p1=0., p2=0., q1=0., q2=1., vx1=0., vx2=0., vy1=0., + vy2=0., majrx=5, minrx=5, majry=7, minry=5, overplot=no, + append=append, device="stdgraph", round=no, fill=yes) + + delete (tmp1, verify-) + delete (tmp2, verify-) +end diff --git a/noao/obsutil/src/sptime/grating.x b/noao/obsutil/src/sptime/grating.x new file mode 100644 index 00000000..373b335d --- /dev/null +++ b/noao/obsutil/src/sptime/grating.x @@ -0,0 +1,1107 @@ +include +include + +define GR_LEN 24 +define GR_W Memr[P2R($1)] # Wavelength +define GR_O Memi[$1+1] # Order +define GR_P Memr[P2R($1+2)] # Blaze peak scale factor +define GR_WB Memr[P2R($1+3)] # First order wavelength at blaze (A) +define GR_DB Memr[P2R($1+4)] # First order dispersion at blaze (A/mm) +define GR_OREF Memi[$1+5] # Reference order +define GR_F Memr[P2R($1+6)] # Focal length (mm) +define GR_G Memr[P2R($1+7)] # Ruling (groves/A) +define GR_BLAZE Memr[P2R($1+8)] # Blaze angle (rad) +define GR_N Memr[P2R($1+9)] # Index of refraction +define GR_PHI Memr[P2R($1+10)] # Alpha - beta (rad) +define GR_ALPHA Memr[P2R($1+11)] # Incident angle (rad) +define GR_BETA Memr[P2R($1+12)] # Diffraction angle (rad) +define GR_TYPE Memr[P2R($1+13)] # 1=Reflection, -1=Transmission +define GR_FULL Memi[$1+14] # Full solution? + +define GR_PIS Memr[P2R($1+15)] # PI/G*S +define GR_CA Memr[P2R($1+16)] # cos (ALPHA) +define GR_SA Memr[P2R($1+17)] # sin (ALPHA) +define GR_CB Memr[P2R($1+18)] # cos (BETA) +define GR_TB Memr[P2R($1+19)] # tan (BETA) +define GR_SE Memr[P2R($1+20)] # sin (ALPHA - BLAZE) +define GR_CE Memr[P2R($1+21)] # cos (ALPHA - BLAZE) +define GR_CBLZ Memr[P2R($1+22)] # cos (BLAZE) +define GR_T2BLZ Memr[P2R($1+23)] # tan (2 * BLAZE) + + +# Definitions of INDEF parameter flags. +define F 1B # Focal length +define G 2B # Groves +define T 4B # Blaze angle +define A 10B # Incident angle +define B 20B # Diffracted angle +define P 40B # Incident - diffracted +define W 100B # Wavelength +define D 200B # Dispersions +define N 400B # Index of refraction + +# Combinations +define FG 3B +define FT 5B +define FA 11B +define FW 101B +define GT 6B +define GA 12B +define GW 102B +define GD 202B +define TA 14B +define TAW 114B +define TAD 214B +define TB 24B +define TP 44B +define TW 104B +define TD 204B +define AB 30B +define AP 50B +define AW 110B +define AD 210B +define BP 140B +define WD 300B +define ABP 70B +define GTA 16B + + +# GRATING_OPEN -- Open grating structure. +# Check and derive grating parameters. +# +# This procedure hasn't yet been fixed up for grisms (index of refraction +# is not accounted for) so all input parameters should be defined with +# alpha=beta=blaze=prism angle. + +pointer procedure gr_open (w, o, p, wb, db, oref, f, gmm, blaze, n, phi, + alpha, beta, mode, full) + +real w #I Wavelength (A) +int o #I Order +real p #I Blaze peak scale factor +real f #I Focal length (mm) +real wb #I Blaze wavelength (A) +real db #I Blaze dispersion (A/mm) +int oref #I Reference order +real gmm #I Groves (groves/mm) +real blaze #I Blaze angle (deg) +real n #I Index of refraction for grism +real phi #I Incident - diffracted (deg) +real alpha #I Incident angle (deg) +real beta #I Diffracted angle (deg) +int mode #I 1 = incident > diffracted +int full #I Do full solution? +pointer gr #O Grating pointer + +int flags +real x +define err_ 10 + +begin + call malloc (gr, GR_LEN, TY_STRUCT) + + GR_W(gr) = w + GR_O(gr) = o + GR_P(gr) = p + + GR_F(gr) = f + GR_G(gr) = gmm + GR_BLAZE(gr) = blaze + GR_N(gr) = n + GR_PHI(gr) = phi + GR_ALPHA(gr) = alpha + GR_BETA(gr) = beta + + GR_OREF(gr) = oref + GR_WB(gr) = wb + GR_DB(gr) = db + + # The grating is reflection unless the index of refraction is not + # 1, the blaze dispersion is negative, beta is greater than + # 180 degrees, or the incident and diffraction angles are the same. + + if (GR_N(gr) == 1.) + GR_TYPE(gr) = 1 + else if (!IS_INDEF(GR_N(gr))) + GR_TYPE(gr) = -1 + else { + if (!IS_INDEF(GR_BETA(gr)) + && (GR_BETA(gr) > 180. || GR_BETA(gr) < -180)) + GR_TYPE(gr) = -1 + else if (!IS_INDEF(GR_DB(gr)) && GR_DB(gr) < 0.) + GR_TYPE(gr) = -1 + else if (!IS_INDEF(GR_ALPHA(gr)) && !IS_INDEF(GR_BETA(gr)) && + GR_ALPHA(gr) == GR_BETA(gr)) + GR_TYPE(gr) = -1 + else if (GR_PHI(gr) == 0.) + GR_TYPE(gr) = -1 + else + GR_TYPE(gr) = 1 + } + + # Set INDEF values to reasonable defaults. Convert degrees to radians. + if (IS_INDEF(GR_P(gr))) + GR_P(gr) = 1 + if (!IS_INDEF(GR_WB(gr))) { + if (GR_WB(gr) <= 0.) + GR_WB(gr) = INDEF + else + GR_WB(gr) = GR_WB(gr) * GR_OREF(gr) + } + if (!IS_INDEF(GR_DB(gr))) + GR_DB(gr) = GR_TYPE(gr) * GR_OREF(gr) * abs (GR_DB(gr)) + if (!IS_INDEF(GR_F(gr))) { + if (GR_F(gr) <= 0.) + GR_F(gr) = INDEF + } + if (!IS_INDEF(GR_G(gr))) { + if (GR_G(gr) <= 0.) + GR_G(gr) = INDEF + else + GR_G(gr) = GR_G(gr) / 1e7 + } + if (!IS_INDEF(GR_PHI(gr))) + GR_PHI(gr) = DEGTORAD (GR_PHI(gr)) + if (!IS_INDEF(GR_ALPHA(gr))) + GR_ALPHA(gr) = DEGTORAD (GR_ALPHA(gr)) + if (!IS_INDEF(GR_BETA(gr))) { + GR_BETA(gr) = DEGTORAD (GR_BETA(gr)) + if (GR_BETA(gr) > HALFPI) + GR_BETA(gr) = GR_BETA(gr) - PI + else if (GR_BETA(gr) < -HALFPI) + GR_BETA(gr) = GR_BETA(gr) + PI + } + if (!IS_INDEF(GR_BLAZE(gr))) + GR_BLAZE(gr) = DEGTORAD (GR_BLAZE(gr)) + + # Compute missing angles, if possible, based on the other angles. + # This assumes the given values are for the blaze peak. + + flags = 0 + if (IS_INDEF(GR_BLAZE(gr))) + flags = flags + T + if (IS_INDEF(GR_ALPHA(gr))) + flags = flags + A + if (IS_INDEF(GR_BETA(gr))) + flags = flags + B + if (IS_INDEF(GR_PHI(gr))) + flags = flags + P + + switch (flags) { + case T, P, TP: + GR_PHI(gr) = GR_ALPHA(gr) - GR_BETA(gr) + GR_BLAZE(gr) = (GR_ALPHA(gr) + GR_BETA(gr)) / 2. + case A, TA: + GR_ALPHA(gr) = GR_BETA(gr) + GR_PHI(gr) + GR_BLAZE(gr) = (GR_ALPHA(gr) + GR_BETA(gr)) / 2. + case AB: + if (mode == 1) { + GR_ALPHA(gr) = GR_BLAZE(gr) + GR_PHI(gr)/2. + GR_BETA(gr) = GR_BLAZE(gr) - GR_PHI(gr)/2. + } else { + GR_ALPHA(gr) = GR_BLAZE(gr) - GR_PHI(gr)/2. + GR_BETA(gr) = GR_BLAZE(gr) + GR_PHI(gr)/2. + } + case AP: + GR_ALPHA(gr) = 2 * GR_BLAZE(gr) - GR_BETA(gr) + GR_PHI(gr) = GR_ALPHA(gr) - GR_BETA(gr) + case B, TB: + GR_BETA(gr) = GR_ALPHA(gr) - GR_PHI(gr) + GR_BLAZE(gr) = (GR_ALPHA(gr) + GR_BETA(gr)) / 2. + case BP: + GR_BETA(gr) = 2 * GR_BLAZE(gr) - GR_ALPHA(gr) + GR_PHI(gr) = GR_ALPHA(gr) - GR_BETA(gr) + case ABP: + GR_ALPHA(gr) = GR_BLAZE(gr) + GR_BETA(gr) = GR_BLAZE(gr) + GR_PHI(gr) = 0. + } + + # Compute index of refraction if possible. + if (IS_INDEF(GR_N(gr))) { + if (GR_TYPE(gr) == 1) + GR_N(gr) = 1 + else if (!IS_INDEF(GR_WB(gr)) && !IS_INDEF(GR_G(gr)) && + !IS_INDEF(GR_BLAZE(gr))) + GR_N(gr) = (GR_G(gr) * GR_WB(gr)) / sin (GR_BLAZE(gr)) + 1 + } + + # Compute other parameters if possible. + flags = 0 + if (IS_INDEF(GR_F(gr))) + flags = flags + F + if (IS_INDEF(GR_G(gr))) + flags = flags + G + if (IS_INDEF(GR_BLAZE(gr))) + flags = flags + T + if (IS_INDEF(GR_ALPHA(gr))) + flags = flags + A + if (IS_INDEF(GR_WB(gr))) + flags = flags + W + if (IS_INDEF(GR_DB(gr))) + flags = flags + D + if (IS_INDEF(GR_N(gr))) + flags = flags + N + + switch (flags) { + case 0, F, G, T, A, N, W, D: + switch (flags) { + case F: + GR_F(gr) = GR_TYPE(gr) * cos (GR_BETA(gr)) / + (GR_G(gr) * GR_DB(gr)) + case G: + GR_G(gr) = (GR_N(gr) * sin (GR_ALPHA(gr)) + + GR_TYPE(gr) * sin (GR_BETA(gr))) / GR_WB(gr) + if (GR_G(gr) == 0.) + GR_G(gr) = INDEF + case T: + if (GR_ALPHA(gr) > PI) { + x = GR_G(gr) * GR_WB(gr) / (2 * cos (GR_ALPHA(gr))) + if (abs (x) > 1.) + goto err_ + GR_BLAZE(gr) = asin (x) + GR_ALPHA(gr) = GR_ALPHA(gr) - TWOPI + GR_BLAZE(gr) + } else { + x = GR_G(gr) * GR_WB(gr) - GR_N(gr) * sin (GR_ALPHA(gr)) + if (abs (x) > 1.) + goto err_ + GR_BLAZE(gr) = (GR_ALPHA(gr) + asin (x)) / 2 + } + GR_BETA(gr) = 2 * GR_BLAZE(gr) - GR_ALPHA(gr) + GR_PHI(gr) = GR_ALPHA(gr) - GR_BETA(gr) + case A: + x = GR_TYPE(gr) * GR_G(gr) * GR_WB(gr) / (2 * sin(GR_BLAZE(gr))) + if (abs (x) > 1.) + goto err_ + if (mode == 1) { + GR_ALPHA(gr) = GR_BLAZE(gr) + acos (x) + GR_BETA(gr) = 2 * GR_BLAZE(gr) - GR_ALPHA(gr) + } else { + GR_BETA(gr) = GR_BLAZE(gr) + acos (x) + GR_ALPHA(gr) = 2 * GR_BLAZE(gr) - GR_BETA(gr) + } + GR_PHI(gr) = GR_ALPHA(gr) - GR_BETA(gr) + case N: + GR_N(gr) = (GR_G(gr) * GR_WB(gr)) / sin (GR_BLAZE(gr)) + 1 + } + GR_WB(gr) = (GR_N(gr) * sin (GR_ALPHA(gr)) + + GR_TYPE(gr) * sin (GR_BETA(gr))) / GR_G(gr) + GR_DB(gr) = GR_TYPE(gr) * cos (GR_BETA(gr)) / (GR_F(gr)*GR_G(gr)) + case FG: + x = (GR_N(gr) * sin (GR_ALPHA(gr)) + + GR_TYPE(gr) * sin (GR_BETA(gr))) / GR_WB(gr) + if (x == 0.) + goto err_ + GR_G(gr) = x + GR_F(gr) = GR_TYPE(gr) * cos (GR_BETA(gr)) / (GR_G(gr) * GR_DB(gr)) + case FT: + if (GR_ALPHA(gr) > PI) { + x = GR_TYPE(gr) * GR_G(gr) * GR_WB(gr) / + (2 * cos (GR_ALPHA(gr))) + if (abs (x) > 1.) + goto err_ + GR_BLAZE(gr) = asin (x) + GR_ALPHA(gr) = GR_ALPHA(gr) - TWOPI + GR_BLAZE(gr) + } else { + x = GR_TYPE(gr) * GR_G(gr) * GR_WB(gr) - + GR_N(gr) * sin (GR_ALPHA(gr)) + if (abs (x) > 1.) + goto err_ + GR_BLAZE(gr) = (GR_ALPHA(gr) + asin (x)) / 2 + } + GR_BETA(gr) = 2 * GR_BLAZE(gr) - GR_ALPHA(gr) + GR_PHI(gr) = GR_ALPHA(gr) - GR_BETA(gr) + GR_F(gr) = GR_TYPE(gr) * cos (GR_BETA(gr)) / (GR_G(gr) * GR_DB(gr)) + case FA: + x = GR_TYPE(gr) * GR_G(gr) * GR_WB(gr) / (2 * sin (GR_BLAZE(gr))) + if (abs (x) > 1.) + goto err_ + if (mode == 1) { + GR_ALPHA(gr) = GR_BLAZE(gr) + acos (x) + GR_BETA(gr) = 2 * GR_BLAZE(gr) - GR_ALPHA(gr) + } else { + GR_BETA(gr) = GR_BLAZE(gr) + acos (x) + GR_ALPHA(gr) = 2 * GR_BLAZE(gr) - GR_BETA(gr) + } + GR_PHI(gr) = GR_ALPHA(gr) - GR_BETA(gr) + GR_F(gr) = GR_TYPE(gr) * cos (GR_BETA(gr)) / (GR_G(gr) * GR_DB(gr)) + case FW: + GR_WB(gr) = (GR_N(gr) * sin (GR_ALPHA(gr)) + + GR_TYPE(gr) * sin (GR_BETA(gr))) / GR_G(gr) + GR_F(gr) = GR_TYPE(gr) * cos (GR_BETA(gr)) / (GR_G(gr) * GR_DB(gr)) + case GT: + x = GR_TYPE(gr) * GR_F(gr) * GR_DB(gr) / GR_WB(gr) + if (GR_ALPHA(gr) > PI) { + GR_BLAZE(gr) = atan (1 / (2 * x - tan (GR_ALPHA(gr)))) + GR_ALPHA(gr) = GR_ALPHA(gr) - TWOPI + GR_BLAZE(gr) + } else { + x = (tan (GR_ALPHA(gr)) - x) / (1 + 2 * x * tan (GR_ALPHA(gr))) + GR_BLAZE(gr) = atan (x + sqrt (1 + x * x)) + } + GR_BETA(gr) = 2 * GR_BLAZE(gr) - GR_ALPHA(gr) + GR_PHI(gr) = GR_ALPHA(gr) - GR_BETA(gr) + GR_G(gr) = (GR_N(gr) * sin (GR_ALPHA(gr)) + + GR_TYPE(gr) * sin (GR_BETA(gr))) / GR_WB(gr) + case GA: + GR_ALPHA(gr) = GR_BLAZE(gr) + + atan (2 * GR_TYPE(gr) * GR_F(gr) * GR_DB(gr) / + GR_WB(gr) - 1 / tan (GR_BLAZE(gr))) + GR_BETA(gr) = 2 * GR_BLAZE(gr) - GR_ALPHA(gr) + GR_PHI(gr) = GR_ALPHA(gr) - GR_BETA(gr) + GR_G(gr) = (GR_N(gr) * sin (GR_ALPHA(gr)) + + GR_TYPE(gr) * sin (GR_BETA(gr))) / GR_WB(gr) + case GW: + GR_G(gr) = GR_TYPE(gr) * cos (GR_BETA(gr)) / (GR_F(gr) * GR_DB(gr)) + if (GR_G(gr) == 0.) + GR_G(gr) = INDEF + else + GR_WB(gr) = (GR_N(gr) * sin (GR_ALPHA(gr)) + + GR_TYPE(gr) * sin (GR_BETA(gr))) / GR_G(gr) + case GD: + x = (GR_N(gr) * sin (GR_ALPHA(gr)) + + GR_TYPE(gr) * sin (GR_BETA(gr))) / GR_WB(gr) + if (x == 0.) + goto err_ + GR_G(gr) = x + GR_DB(gr) = GR_TYPE(gr) * cos (GR_BETA(gr)) / (GR_F(gr) * GR_G(gr)) + case TAD: + if (IS_INDEF(GR_PHI(gr))) + GR_PHI(gr) = 0. + x = GR_G(gr) * GR_WB(gr) / (2 * cos (GR_PHI(gr)/2)) + if (mode == 1) { + GR_ALPHA(gr) = GR_PHI(gr)/2 + asin (x) + GR_BETA(gr) = GR_ALPHA(gr) - GR_PHI(gr) + } else { + GR_BETA(gr) = GR_PHI(gr)/2 + asin (x) + GR_ALPHA(gr) = GR_BETA(gr) - GR_PHI(gr) + } + GR_BLAZE(gr) = (GR_ALPHA(gr) + GR_BETA(gr)) / 2 + GR_DB(gr) = GR_TYPE(gr) * cos (GR_BETA(gr)) / + (GR_F(gr) * GR_G(gr)) + case TAW: + if (!IS_INDEF(GR_PHI(gr))) { + x = GR_TYPE(gr) * GR_F(gr) * GR_G(gr) * GR_DB(gr) + if (abs (x) > 1.) { + if (abs (x) > 1.1) + goto err_ + else { + x = 1. + GR_DB(gr) = x / (GR_F(gr) * GR_G(gr)) + } + } + if (mode == 1) { + GR_BETA(gr) = acos (x) + GR_ALPHA(gr) = GR_BETA(gr) + GR_PHI(gr) + } else { + GR_ALPHA(gr) = acos (x) + GR_BETA(gr) = GR_ALPHA(gr) + GR_PHI(gr) + } + GR_BLAZE(gr) = (GR_ALPHA(gr) + GR_BETA(gr)) / 2 + GR_WB(gr) = (GR_N(gr) * sin (GR_ALPHA(gr)) + + GR_TYPE(gr) * sin (GR_BETA(gr))) / GR_G(gr) + } + case TA: + if (!IS_INDEF(GR_PHI(gr))) { + x = GR_G(gr) * GR_WB(gr) / (2 * cos (GR_PHI(gr)/2)) + if (mode == 1) { + GR_ALPHA(gr) = GR_PHI(gr)/2 + asin (x) + GR_BETA(gr) = GR_ALPHA(gr) - GR_PHI(gr) + } else { + GR_BETA(gr) = GR_PHI(gr)/2 + asin (x) + GR_ALPHA(gr) = GR_BETA(gr) - GR_PHI(gr) + } + GR_BLAZE(gr) = (GR_ALPHA(gr) + GR_BETA(gr)) / 2 + GR_DB(gr) = GR_TYPE(gr) * cos (GR_BETA(gr)) / + (GR_F(gr) * GR_G(gr)) + } else { + x = GR_TYPE(gr) * GR_F(gr) * GR_G(gr) * GR_DB(gr) + if (abs (x) > 1.) { + if (abs (x) > 1.1) + goto err_ + else { + x = 1. + GR_DB(gr) = x / (GR_F(gr) * GR_G(gr)) + } + } + GR_BETA(gr) = acos (x) + x = GR_G(gr) * GR_WB(gr) - GR_TYPE(gr) * sin (GR_BETA(gr)) + if (abs (x) > 1.) + goto err_ + GR_ALPHA(gr) = asin (x) + GR_BLAZE(gr) = (acos (GR_TYPE(gr) * GR_F(gr) * GR_G(gr) * + GR_DB(gr)) + GR_ALPHA(gr)) / 2 + GR_BETA(gr) = 2 * GR_BLAZE(gr) - GR_ALPHA(gr) + GR_PHI(gr) = GR_ALPHA(gr) - GR_BETA(gr) + } + case TW: + GR_BLAZE(gr) = (GR_ALPHA(gr) + + acos (GR_TYPE(gr) * GR_F(gr) * GR_G(gr) * GR_DB(gr))) / 2 + GR_BETA(gr) = 2 * GR_BLAZE(gr) - GR_ALPHA(gr) + GR_PHI(gr) = GR_ALPHA(gr) - GR_BETA(gr) + GR_WB(gr) = (GR_N(gr) * sin (GR_ALPHA(gr)) + + GR_TYPE(gr) * sin (GR_BETA(gr))) / GR_G(gr) + case TD: + if (GR_ALPHA(gr) > PI) { + x = GR_G(gr) * GR_WB(gr) / (2 * cos (GR_ALPHA(gr))) + if (abs (x) > 1.) + goto err_ + GR_BLAZE(gr) = asin (x) + GR_ALPHA(gr) = GR_ALPHA(gr) - TWOPI + GR_BLAZE(gr) + } else { + x = GR_G(gr) * GR_WB(gr) - GR_N(gr) * sin (GR_ALPHA(gr)) + if (abs (x) > 1.) + goto err_ + GR_BLAZE(gr) = (GR_ALPHA(gr) + asin (x)) / 2 + } + GR_BETA(gr) = 2 * GR_BLAZE(gr) - GR_ALPHA(gr) + GR_PHI(gr) = GR_ALPHA(gr) - GR_BETA(gr) + GR_DB(gr) = GR_TYPE(gr) * cos (GR_BETA(gr)) / (GR_F(gr) * GR_G(gr)) + case AW: + x = GR_TYPE(gr) * GR_F(gr) * GR_G(gr) * GR_DB(gr) + if (abs (x) > 1.) + goto err_ + GR_ALPHA(gr) = 2 * GR_BLAZE(gr) - acos (x) + GR_BETA(gr) = 2 * GR_BLAZE(gr) - GR_ALPHA(gr) + GR_PHI(gr) = GR_ALPHA(gr) - GR_BETA(gr) + GR_WB(gr) = (GR_N(gr) * sin (GR_ALPHA(gr)) + sin (GR_BETA(gr))) / + GR_G(gr) + case AD: + x = GR_G(gr) * GR_WB(gr) / (2 * sin (GR_BLAZE(gr))) + if (abs (x) > 1.) + goto err_ + if (mode == 1) { + GR_ALPHA(gr) = GR_BLAZE(gr) + acos (x) + GR_BETA(gr) = 2 * GR_BLAZE(gr) - GR_ALPHA(gr) + } else { + GR_BETA(gr) = GR_BLAZE(gr) + acos (x) + GR_ALPHA(gr) = 2 * GR_BLAZE(gr) - GR_BETA(gr) + } + GR_PHI(gr) = GR_ALPHA(gr) - GR_BETA(gr) + GR_DB(gr) = GR_TYPE(gr) * cos (GR_BETA(gr)) / (GR_F(gr) * GR_G(gr)) + case WD: + GR_WB(gr) = (GR_N(gr) * sin (GR_ALPHA(gr)) + + GR_TYPE(gr) * sin (GR_BETA(gr))) / GR_G(gr) + GR_DB(gr) = GR_TYPE(gr) * cos (GR_BETA(gr)) / (GR_F(gr) * GR_G(gr)) + case GTA: + # Assume beta=alpha=blaze. + x = (GR_TYPE(gr) * GR_WB(gr)) / + ((GR_N(gr) + GR_TYPE(gr)) * GR_F(gr) * GR_DB(gr)) + GR_BETA(gr) = atan (x) + GR_ALPHA(gr) = GR_BETA(gr) + GR_BLAZE(gr) = GR_BETA(gr) + GR_PHI(gr) = 0 + GR_G(gr) = (GR_N(gr) * sin (GR_ALPHA(gr)) + + GR_TYPE(gr) * sin (GR_BETA(gr))) / GR_WB(gr) + } + + # The result should give the blaze wavelength and dispersion. + # If this cannot be computed then it is an error. + + if (IS_INDEF(GR_WB(gr)) || IS_INDEF(GR_DB(gr))) { + call gr_close (gr) + call mfree (gr, TY_STRUCT) + call error (1, + "Insufficient information to to resolve grating parameters") + } + + # If all the other parameters cannot be computed then use linear. + if (full==NO || IS_INDEF(GR_F(gr)) || IS_INDEF(GR_G(gr)) || + IS_INDEF(GR_BETA(gr)) || IS_INDEF(GR_PHI(gr)) || + IS_INDEF(GR_N(gr))) { + GR_FULL(gr) = NO + if (IS_INDEF(GR_F(gr))) + GR_F(gr) = 1 + GR_W(gr) = GR_WB(gr) + GR_O(gr) = GR_OREF(gr) + GR_CE(gr) = PI * GR_DB(gr) + GR_CA(gr) = 1. + GR_CB(gr) = 1. + + # A full grating solution is possible. + } else { + GR_FULL(gr) = YES + + # Set the order and wavelength to the blaze values if not given. + if (IS_INDEF(GR_W(gr))) { + if (!IS_INDEFI(GR_O(gr))) + GR_W(gr) = GR_WB(gr) / GR_O(gr) + else + GR_W(gr) = GR_WB(gr) / GR_OREF(gr) + } + if (IS_INDEFI(GR_O(gr))) + GR_O(gr) = max (1, nint (GR_WB(gr) / GR_W(gr))) + + # Convert to incident angle at desired wavelength. + if (GR_PHI(gr) != 0.) { + x = GR_G(gr) * GR_O(gr) * GR_W(gr) / + (2 * cos (GR_PHI(gr)/2)) + if (abs (x) > 1.) + goto err_ + if (mode == 1) { + GR_ALPHA(gr) = asin (x) + GR_PHI(gr) / 2 + GR_BETA(gr) = asin (x) - GR_PHI(gr) / 2 + } else { + GR_ALPHA(gr) = asin (x) - GR_PHI(gr) / 2 + GR_BETA(gr) = asin (x) + GR_PHI(gr) / 2 + } + } else { + x = (GR_G(gr) * GR_O(gr) * GR_W(gr) - + GR_TYPE(gr) * sin (GR_BETA(gr))) / GR_N(gr) + if (abs (x) > 1.) + goto err_ + GR_ALPHA(gr) = asin (x) + } + + # The following parameters are for efficiency. Beta terms are + # for the blaze peak diffraction. + + x = 2 * GR_BLAZE(gr) - GR_ALPHA(gr) + GR_CA(gr) = cos (GR_ALPHA(gr)) + GR_SA(gr) = sin (GR_ALPHA(gr)) + GR_CB(gr) = GR_TYPE(gr) * cos (x) + GR_TB(gr) = tan (x) + GR_SE(gr) = sin (GR_ALPHA(gr) - GR_BLAZE(gr)) + GR_CE(gr) = cos (GR_ALPHA(gr) - GR_BLAZE(gr)) + GR_CBLZ(gr) = cos (GR_BLAZE(gr)) + GR_T2BLZ(gr) = tan (2 * GR_BLAZE(gr)) + if (GR_ALPHA(gr) > x) + GR_PIS(gr) = PI / GR_G(gr) * GR_CA(gr) + else + GR_PIS(gr) = PI / GR_G(gr) * GR_CBLZ(gr) + } + + return (gr) + +err_ call error (2, "Impossible combination of grating parameters") +end + + +# GR_CLOSE -- Free grating structure. + +procedure gr_close (gr) + +pointer gr #I Grating pointer + +begin + call mfree (gr, TY_STRUCT) +end + +# GR_GETR -- Get grating parameter. + +real procedure gr_getr (gr, param) + +pointer gr #I Grating pointer +char param[ARB] #I Parameter name + +bool streq() + +begin + if (gr == NULL) + return (INDEF) + + switch (param[1]) { + case 'a': + if (streq (param, "alpha")) { + if (IS_INDEFR(GR_ALPHA(gr))) + return (GR_ALPHA(gr)) + else + return (RADTODEG(GR_ALPHA(gr))) + } + case 'b': + if (streq (param, "blaze")) { + if (IS_INDEFR(GR_BLAZE(gr))) + return (GR_BLAZE(gr)) + else + return (RADTODEG(GR_BLAZE(gr))) + } else if (streq (param, "beta")) { + if (IS_INDEFR(GR_BETA(gr))) + return (GR_BETA(gr)) + else + return (RADTODEG(GR_BETA(gr))) + } + case 'd': + if (streq (param, "dblaze")) + return (GR_DB(gr) / GR_OREF(gr)) + if (streq (param, "dispersion")) { + if (GR_FULL(gr) == NO) + return (GR_DB(gr) / GR_O(gr)) + else + return (GR_CB(gr) / (GR_G(gr) * GR_O(gr) *GR_F(gr))) + } + case 'f': + if (streq (param, "full")) + return (real (GR_FULL(gr))) + else if (streq (param, "f")) + return (GR_F(gr)) + case 'g': + if (streq (param, "g")) { + if (IS_INDEFR(GR_G(gr))) + return (GR_G(gr)) + else + return (GR_G(gr) * 1E7) + } + case 'm': + if (streq (param, "mag")) + return (GR_CA(gr) / GR_CB(gr)) + case 'n': + if (streq (param, "n")) + return (GR_N(gr)) + case 'o': + if (streq (param, "order")) + return (real (GR_O(gr))) + if (streq (param, "oref")) + return (real (GR_OREF(gr))) + case 'p': + if (streq (param, "phi")) { + if (IS_INDEFR(GR_PHI(gr))) + return (GR_PHI(gr)) + else + return (RADTODEG(GR_PHI(gr))) + } + case 't': + if (streq (param, "tilt")) { + if (GR_FULL(gr) == NO) + return (INDEFR) + else + return (RADTODEG((GR_ALPHA(gr)+GR_TYPE(gr)*GR_BETA(gr))/2)) + } + case 'w': + if (streq (param, "wavelength")) + return (GR_W(gr)) + if (streq (param, "wblaze")) + return (GR_WB(gr) / GR_OREF(gr)) + } + call error (1, "gr_getr: unknown parameter") +end + + +# GR_LIST -- List grating parameters. + +procedure gr_list (gr, order, col) + +pointer gr #I Grating pointer +int order #I Order +int col #I Column to indent + +begin + if (gr == NULL) + return + + if (GR_FULL(gr) == NO) { + call printf ("%*tReference order = %d\n") + call pargi (col) + call pargi (order) + call printf ( + "%*tBlaze wavelength of reference order = %.6g Angstroms\n") + call pargi (col) + call pargr (GR_WB(gr) / order) + call printf ( + "%*tBlaze dispersion of reference order = %.4g Angstroms/mm\n") + call pargi (col) + call pargr (GR_DB(gr) / order) + } else { + call printf ("%*tFocal length = %d mm\n") + call pargi (col) + call pargr (GR_F(gr)) + call printf ("%*tGrating = %.1f grooves/mm\n") + call pargi (col) + call pargr (GR_G(gr) * 1e7) + call printf ("%*tBlaze angle = %.1f degrees\n") + call pargi (col) + call pargr (RADTODEG(GR_BLAZE(gr))) + call printf ("%*tIncident to diffracted angle = %.1f degrees\n") + call pargi (col) + call pargr (RADTODEG(GR_PHI(gr))) + call printf ("%*tReference order = %d\n") + call pargi (col) + call pargi (order) + call printf ( + "%*tBlaze wavelength = %.6g Angstroms\n") + call pargi (col) + call pargr (GR_WB(gr) / order) + call printf ( + "%*tBlaze dispersion = %.4g Angstroms/mm\n") + call pargi (col) + call pargr (GR_DB(gr) / order) + + call printf ("\n%*tCentral wavelength = %.6g Angstroms\n") + call pargi (col) + call pargr (GR_W(gr)) + call printf ("%*tCentral dispersion = %.4g Angstroms/mm\n") + call pargi (col) + call pargr (GR_TYPE(gr) * cos (GR_BETA(gr)) / + (GR_G(gr) * order *GR_F(gr))) + call printf ("%*tOrder = %d\n") + call pargi (col) + call pargi (GR_O(gr)) + call printf ("%*tTilt = %.1f degrees\n") + call pargi (col) + call pargr (RADTODEG(GR_ALPHA(gr) - GR_PHI(gr) / 2)) + call printf ("%*tGrating magnification = %.2f\n") + call pargi (col) + call pargr (GR_CA(gr)/GR_CB(gr)) + call printf ("%*tIncidence angle = %.1f degrees\n") + call pargi (col) + call pargr (RADTODEG(GR_ALPHA(gr))) + call printf ("%*tDiffracted angle = %.1f degrees\n") + call pargi (col) + call pargr (RADTODEG(GR_BETA(gr))) + } +end + + +# GR_W2PSI -- Given wavelength return tan(psi). + +real procedure gr_w2psi (gr, w, m) + +pointer gr #I Grating pointer +real w #I Wavelength +int m #I Order +real x #O Pixel position + +real gr_sinbeta() + +begin + if (GR_FULL(gr) == NO) + return ((m*w - GR_WB(gr)) / GR_DB(gr) * GR_F(gr)) + + x = gr_sinbeta (gr, w, m) + if (!IS_INDEF(x)) { + x = x / sqrt (1 - x * x) + x = (x - GR_TB(gr)) / (1 + x * GR_TB(gr)) + } + return (x) + +end + + +# GR_W2PSIR -- Given wavelength return tan(psi) of reflected component. + +real procedure gr_w2psir (gr, w, m) + +pointer gr #I Grating pointer +real w #I Wavelength +int m #I Order +real x #O Pixel position + +real gr_sinbeta() + +begin + x = gr_sinbeta (gr, w, m) + if (!IS_INDEF(x)) { + #x = x / sqrt (1 - x * x) + #x = (x - GR_TB(gr)) / (1 + x * GR_TB(gr)) + #x = (x + GR_T2BLZ(gr)) / (1 - x * GR_T2BLZ(gr)) + x = PI - asin(x) + x = 2 * GR_BLAZE(gr) - x - GR_BETA(gr) + x = tan (x) + } + return (x) +end + + +# GR_DELTA -- Given pixel position and wavelength return blaze function +# phase angle. + +real procedure gr_delta (gr, w, m) + +pointer gr #I Grating pointer +real w #I Wavelength +int m #I Order +real d #O Delta + +real tanpsi, cospsi, sinpsi, gr_w2psi() + +begin + tanpsi = gr_w2psi (gr, w, m) + if (IS_INDEF(tanpsi)) + return (INDEF) + + if (GR_FULL(gr) == NO) + d = PI * GR_DB(gr) / w * tanpsi + else { + cospsi = 1 / sqrt (1 + tanpsi * tanpsi) + sinpsi = tanpsi * cospsi + d = GR_PIS(gr) / w * (GR_CE(gr) * sinpsi + GR_SE(gr) * (1 - cospsi)) + } + if (abs(d) < 0.01) { + if (d < 0) + d = -0.01 + else + d = 0.01 + } + return (d) +end + + +# GR_DELTAR -- Blaze function phase angle for reflected component. + +real procedure gr_deltar (gr, w, m) + +pointer gr #I Grating pointer +real w #I Wavelength +int m #I Order +real d #O Delta + +real tanpsi, cospsi, sinpsi, gr_w2psir() + +begin + tanpsi = gr_w2psir (gr, w, m) + if (IS_INDEF(tanpsi)) + return (INDEF) + + if (GR_FULL(gr) == NO) + d = PI * GR_DB(gr) / w * tanpsi + else { + cospsi = 1 / sqrt (1 + tanpsi * tanpsi) + sinpsi = tanpsi * cospsi + d = GR_PIS(gr) / w * (GR_CE(gr) * sinpsi + GR_SE(gr) * (1 - cospsi)) + } + if (abs(d) < 0.01) { + if (d < 0) + d = -0.01 + else + d = 0.01 + } + return (d) +end + + +# GR_BLAZE -- Blaze pattern at given wavelength. + +real procedure gr_blaze (gr, w, m) + +pointer gr #I Grating pointer +real w #I Wavelength +int m #I Order +real val #O Blaze pattern + +real d, gr_delta() + +begin + d = gr_delta (gr, w, m) + if (IS_INDEF(d)) + val = 0. + else + val = (sin (d) / d) ** 2 + return (val) +end + + +# GR_PEAK -- Blaze peak corrected for light defracted into other orders. + +real procedure gr_peak (gr, w, m) + +pointer gr #I Grating pointer +real w #I Wavelength (A) +int m #I Order +real val #O Blaze peak + +int i, j +real frac, p +real gr_delta(), gr_deltar() + +begin + # Find the absolute response of the gratings at the reference + # blaze peak. + + p = gr_delta (gr, w, m) + if (IS_INDEF(p)) + return (INDEF) + val = (sin (p) / p) ** 2 + frac = 0. + do i = m - 1, 1, -1 { + p = gr_delta (gr, w, i) + if (IS_INDEF(p)) + break + frac = frac + (sin (p) / p) ** 2 + if (abs (p) > 1000.) + break + } + do i = m + 1, ARB { + p = gr_delta (gr, w, i) + if (IS_INDEF(p)) + break + frac = frac + (sin (p) / p) ** 2 + if (abs (p) > 1000.) + break + } + + if (GR_FULL(gr) == YES && GR_TYPE(gr) > 0) { + j = (GR_N(gr) * GR_SA(gr) + GR_TYPE(gr)) / GR_G(gr) / w + do i = j+1, ARB, 1 { + p = gr_deltar (gr, w, i) + if (IS_INDEF(p)) + break + frac = frac + (sin (p) / p) ** 2 + if (abs (p) > 1000.) + break + } + } + + val = val / (val + frac) + + # Shadowing + if (GR_ALPHA(gr) < GR_BETA(gr) && GR_TYPE(gr) > 0) + val = val * abs (GR_CA(gr) / GR_CB(gr)) + + return (val) +end + + +# GR_EFF -- Efficiency at specified wavelength and order. + +real procedure gr_eff (gr, w, m) + +pointer gr #I Grating pointer +real w #I Wavelength +int m #I Order +real eff #O Efficiency + +real gr_blaze(), gr_peak() + +begin + if (gr == NULL) + return (INDEF) + + if (GR_FULL(gr) == NO) + return (GR_P(gr)) + + eff = gr_blaze (gr, w, m) + if (eff > 0.) + eff = eff * GR_P(gr) * gr_peak (gr, GR_WB(gr)/m, m) + + return (eff) +end + + +# GR_W2DW -- Grating dispersion = cos (beta(w,m)) / (g * m * f) +# This is corrected to a detector plane. + +real procedure gr_w2dw (gr, w, m) + +pointer gr #I Grating pointer +real w #I Wavelength +int m #I Order +real disp #O Dispersion (A/mm) + +real gr_sinbeta(), gr_w2x() + +begin + if (GR_FULL(gr) == NO) + return (GR_DB(gr) / m) + + disp = gr_sinbeta (gr, w, m) + if (!IS_INDEF(disp)) { + disp = sqrt (1 - disp * disp) / (GR_G(gr) * m * GR_F(gr)) + disp = disp / (1 + (gr_w2x (gr, w, m) / GR_F(gr))**2) + } + return (disp) +end + + +# GR_X2W -- Wavelength at given position relative to center. + +real procedure gr_x2w (gr, x, m) + +pointer gr #I Grating pointer +real x #I Pixel position (mm from center) +int m #I Order +real w #O Wavelength (Angstroms) + +begin + if (GR_FULL(gr) == NO) { + w = GR_WB(gr) + GR_DB(gr) / m * x + return (w) + } + + w = x / GR_F(gr) + w = atan (w) + GR_BETA(gr) + w = (GR_N(gr) * GR_SA(gr) + GR_TYPE(gr) * sin (w)) / + (GR_G(gr) * m) + return (w) +end + + +# GR_W2X -- Position at given wavelength. + +real procedure gr_w2x (gr, w, m) + +pointer gr #I Grating pointer +real w #I Wavelength (Angstroms) +int m #I Order +real x #I Pixel position (mm from center) + +begin + if (GR_FULL(gr) == NO) { + x = (w - GR_WB(gr)) * m / GR_DB(gr) + return (x) + } + + x = (w * m * GR_G(gr) - GR_N(gr) * GR_SA(gr)) / GR_TYPE(gr) + x = asin (x) - GR_BETA(gr) + x = x * GR_F(gr) + return (x) +end + + +# GR_MAG -- Grating magnification = cos (alpha) / cos (beta(w,m)) + +real procedure gr_mag (gr, w, m) + +pointer gr #I Grating pointer +real w #I Wavelength +int m #I Order +real mag #O mag + +real gr_sinbeta() + +begin + mag = gr_sinbeta (gr, w, m) + if (!IS_INDEF(mag)) + mag = GR_CA(gr) / sqrt (1 - mag * mag) + return (mag) +end + + +# GR_TILT -- Grating tilt = (alpha + beta) / 2 + +real procedure gr_tilt (gr, w, m) + +pointer gr #I Grating pointer +real w #I Wavelength +int m #I Order +real tilt #O tilt + +real gr_sinbeta() + +begin + tilt = gr_sinbeta (gr, w, m) + if (!IS_INDEF(tilt)) + tilt = (GR_ALPHA(gr) + GR_TYPE(gr)*asin(tilt)) / 2 + return (tilt) +end + + +# GR_SINBETA -- sin(beta(w,m)) = g * m * w - n * sin(alpha) +# n is index of refraction which is different from 1 for a grism. + +real procedure gr_sinbeta (gr, w, m) + +pointer gr #I Grating pointer +real w #I Wavelength +int m #I Order +real sb #O sin(beta) + +begin + if (gr == NULL) + return (INDEF) + if (GR_FULL(gr) == NO) + return (INDEF) + + sb = (GR_G(gr) * m * w - GR_N(gr) * GR_SA(gr)) / GR_TYPE(gr) + if (abs(sb) >= 1.) + sb = INDEF + + return (sb) +end diff --git a/noao/obsutil/src/sptime/lib/abjohnson b/noao/obsutil/src/sptime/lib/abjohnson new file mode 100644 index 00000000..b2bd6d2a --- /dev/null +++ b/noao/obsutil/src/sptime/lib/abjohnson @@ -0,0 +1,17 @@ +# AB zeropoints. +# Values are from Astrophysical Quantities converted from +# log f (in W/cm^2/micron) to AB = -2.5 * log (F_lambda) - 5 log (lambda) - 2.4 +# where lambda is in Angstroms and F_lambda is in ergs/s/cm^2/A. The +# values are for U, B, V, R, I, J, H, Ks, K, L, L', M. + + 3650 0.714 + 4400 -0.167 + 5500 -0.052 + 7000 0.275 + 9000 0.529 +12150 0.878 +16540 1.356 +21570 1.857 +35470 2.803 +37610 2.921 +47690 3.397 diff --git a/noao/obsutil/src/sptime/lib/circle b/noao/obsutil/src/sptime/lib/circle new file mode 100644 index 00000000..ff3ca32e --- /dev/null +++ b/noao/obsutil/src/sptime/lib/circle @@ -0,0 +1,21 @@ +# title = "Circular aperture" +# type = "circular" + +0.00 0.000 +0.10 0.007 +0.13 0.011 +0.16 0.017 +0.20 0.027 +0.25 0.043 +0.32 0.067 +0.40 0.104 +0.50 0.160 +0.63 0.241 +0.79 0.354 +1.00 0.500 +1.26 0.667 +1.58 0.825 +2.00 0.937 +2.51 0.987 +3.16 0.999 +3.98 1.000 diff --git a/noao/obsutil/src/sptime/lib/slit b/noao/obsutil/src/sptime/lib/slit new file mode 100644 index 00000000..2c39234a --- /dev/null +++ b/noao/obsutil/src/sptime/lib/slit @@ -0,0 +1,103 @@ +# title = "Slit with Gaussian profile" +# type = "rectangular" + +0.00 0.00 0.000 +0.13 0.00 0.000 +0.21 0.00 0.000 +0.32 0.00 0.000 +0.52 0.00 0.000 +0.82 0.00 0.000 +1.30 0.00 0.000 +2.05 0.00 0.000 +3.26 0.00 0.000 +5.17 0.00 0.000 +0.00 0.13 0.000 +0.13 0.13 0.009 +0.21 0.13 0.014 +0.32 0.13 0.022 +0.52 0.13 0.034 +0.82 0.13 0.051 +1.30 0.13 0.071 +2.05 0.13 0.088 +3.26 0.13 0.093 +5.17 0.13 0.094 +0.00 0.21 0.000 +0.13 0.21 0.014 +0.21 0.21 0.022 +0.32 0.21 0.034 +0.52 0.21 0.053 +0.82 0.21 0.080 +1.30 0.21 0.113 +2.05 0.21 0.139 +3.26 0.21 0.148 +5.17 0.21 0.148 +0.00 0.32 0.000 +0.13 0.32 0.022 +0.21 0.32 0.034 +0.32 0.32 0.054 +0.52 0.32 0.084 +0.82 0.32 0.126 +1.30 0.32 0.177 +2.05 0.32 0.218 +3.26 0.32 0.232 +5.17 0.32 0.233 +0.00 0.52 0.000 +0.13 0.52 0.034 +0.21 0.52 0.053 +0.32 0.52 0.084 +0.52 0.52 0.130 +0.82 0.52 0.196 +1.30 0.52 0.275 +2.05 0.52 0.338 +3.26 0.52 0.360 +5.17 0.52 0.361 +0.00 0.82 0.000 +0.13 0.82 0.051 +0.21 0.82 0.080 +0.32 0.82 0.126 +0.52 0.82 0.196 +0.82 0.82 0.294 +1.30 0.82 0.413 +2.05 0.82 0.509 +3.26 0.82 0.541 +5.17 0.82 0.542 +0.00 1.30 0.000 +0.13 1.30 0.071 +0.21 1.30 0.113 +0.32 1.30 0.177 +0.52 1.30 0.275 +0.82 1.30 0.413 +1.30 1.30 0.579 +2.05 1.30 0.714 +3.26 1.30 0.759 +5.17 1.30 0.761 +0.00 2.05 0.000 +0.13 2.05 0.088 +0.21 2.05 0.139 +0.32 2.05 0.218 +0.52 2.05 0.338 +0.82 2.05 0.509 +1.30 2.05 0.714 +2.05 2.05 0.880 +3.26 2.05 0.935 +5.17 2.05 0.938 +0.00 3.26 0.000 +0.13 3.26 0.093 +0.21 3.26 0.148 +0.32 3.26 0.232 +0.52 3.26 0.360 +0.82 3.26 0.541 +1.30 3.26 0.759 +2.05 3.26 0.935 +3.26 3.26 0.994 +5.17 3.26 0.997 +0.00 5.17 0.000 +0.13 5.17 0.094 +0.21 5.17 0.148 +0.32 5.17 0.233 +0.52 5.17 0.361 +0.82 5.17 0.542 +1.30 5.17 0.761 +2.05 5.17 0.938 +3.26 5.17 0.997 +5.17 5.17 1.000 diff --git a/noao/obsutil/src/sptime/mkcircle.cl b/noao/obsutil/src/sptime/mkcircle.cl new file mode 100644 index 00000000..2fc61210 --- /dev/null +++ b/noao/obsutil/src/sptime/mkcircle.cl @@ -0,0 +1,16 @@ +# MKCIRCLE -- Fraction of Gaussian profile going through a circular aperture +# of specified diameter in units of the profile FWHM. + +real d, logd + +printf ("## CIRCLE -- Fraction of Gaussian profile going through a") +printf (" cicular\n## aperture as a function of the diameter in units") +printf (" of FWHM.\n\n") + +printf ("%4.2f %5.3f\n", 0, 0) +for (logd=-1; logd<=0.6; logd=logd+0.1) { + d = 10.**logd + z = d * 0.8325546111577 + z = 1 - exp (-(z * z)) + printf ("%4.2f %5.3f\n", d, z) +} diff --git a/noao/obsutil/src/sptime/mkpkg b/noao/obsutil/src/sptime/mkpkg new file mode 100644 index 00000000..21f5845d --- /dev/null +++ b/noao/obsutil/src/sptime/mkpkg @@ -0,0 +1,20 @@ +# Make SPECTIME. + +$checkout libpkg.a ../ +$update libpkg.a +$checkin libpkg.a ../ +$exit + +standalone: + $update libpkg.a + $omake x_spectime.x + $link x_spectime.o libpkg.a -lsmw -liminterp -o xx_spectime.e + ; + +libpkg.a: + grating.x + stdisperser.x sptime.h + t_cgiparse.x + t_sptime.x sptime.h + tabinterp.x + ; diff --git a/noao/obsutil/src/sptime/mkslit.cl b/noao/obsutil/src/sptime/mkslit.cl new file mode 100644 index 00000000..240f851e --- /dev/null +++ b/noao/obsutil/src/sptime/mkslit.cl @@ -0,0 +1,37 @@ +# MKSLIT -- Fraction of Gaussian profile going through a slit aperture +# of specified width and height in units of the profile FWHM. + +real logx, logy, t, erfcc, xval, yval + +printf ("## SLIT -- Fraction of Gaussian profile going through a") +printf (" slit\n## aperture as a function of the width and height") +printf (" in units of FWHM.\n\n") + +printf ("%4.2f %4.2f %5.3f\n", 0, 0, 0) +for (logx=-1; logx<=0.6; logx=logx+0.2) { + x = 10.**logx + printf ("%4.2f %4.2f %5.3f\n", x, 0, 0) +} +for (logy=-1; logy<=0.6; logy=logy+0.2) { + y = 10.**logy + z = y * 0.8325546111577 + t = 1. / (1. + 0.5 * z) + erfcc = t * exp (-z * z - 1.26551223 + t * (1.00002368 + + t * (0.37409196 + t * (0.09678418 + t * (-0.18628806 + + t * (0.27886807 + t * (-1.13520398 + t * (1.48851587 + + t * (-0.82215223 + t * 0.17087277))))))))) + yval = (1 - erfcc) + printf ("%4.2f %4.2f %5.3f\n", 0, y, 0) + for (logx=-1; logx<=0.6; logx=logx+0.2) { + x = 10.**logx + z = x * 0.8325546111577 + t = 1. / (1. + 0.5 * z) + erfcc = t * exp (-z * z - 1.26551223 + t * (1.00002368 + + t * (0.37409196 + t * (0.09678418 + t * (-0.18628806 + + t * (0.27886807 + t * (-1.13520398 + t * (1.48851587 + + t * (-0.82215223 + t * 0.17087277))))))))) + xval = (1 - erfcc) + z = xval * yval + printf ("%4.2f %4.2f %5.3f\n", x, y, z) + } +} diff --git a/noao/obsutil/src/sptime/rates.cl b/noao/obsutil/src/sptime/rates.cl new file mode 100644 index 00000000..f664b097 --- /dev/null +++ b/noao/obsutil/src/sptime/rates.cl @@ -0,0 +1,74 @@ +procedure rates (grating, filter, order) + +file grating {prompt="Grating"} +file filter {prompt="Filter"} +int order = INDEF {prompt="Order"} +real wave = INDEF {prompt="Central wavelength"} +file spectrograph = "rcspec" {prompt="Spectrograph"} +real width = 10. {prompt="Slit width"} + +string title = "" {prompt="Title"} +real w1 = 3000. {prompt="Lower wavelength to plot"} +real w2 = 12000. {prompt="Upper wavelength to plot\n"} + +real x1 = 3000. {prompt="Left graph wavelength"} +real x2 = 12000. {prompt="Right graph wavelength"} +real y1 = -5. {prompt="Bottom graph efficiency"} +real y2 = 105. {prompt="Top graph efficiency"} +string ltype = "1" {prompt="Line type"} +string color = "1" {prompt="Color"} +bool append = no {prompt="Append?"} + +struct *fd + +begin + string search + file tmp1, tmp2 + real x, y + + tmp1 = mktemp ("tmp$iraf") + tmp2 = mktemp ("tmp$iraf") + + search = "spectimedb$,sptimeKPNO$" + search = search // ",sptimeKPNO$Spectrographs" + search = search // ",sptimeKPNO$Gratings" + search = search // ",sptimeKPNO$Grisms" + search = search // ",sptimeKPNO$Filters/RCCRYO" + search = search // ",sptimeKPNO$Filters/GCAM" + + sptime (time=1., maxexp=3600., sn=25., spectrum="fnu_power", + sky="none", sensfunc="none", airmass=1., seeing=1.5, phase=0., + temperature=6000., index=0., refwave=INDEF, refflux=10., + funits="AB", abjohnson="none", wave=wave, order=order, + xorder=INDEF, width=width, length=INDEF, diameter=INDEF, + inoutangle=INDEF, xinoutangle=INDEF, xbin=1, ybin=1, + search=search, spectrograph=spectrograph, filter=filter, + filter2="none", disperser=grating, xdisperser="none", + fiber="none", telescope="", adc="", collimator="", + corrector="", camera="", detector="", aperture="", + extinction="", gain=INDEF, rdnoise=INDEF, dark=INDEF, skysub="none", + nskyaps=10, output="rate", list=tmp2, graphics="", + interactive=no, nw=1000, > "dev$null") + + fd = tmp2 + while (fscan (fd, x, y) != EOF) { + if (nscan() != 2) + next + if (x < w1 || x > w2) + next + print (x, y, >> tmp1) + } + fd = "" + + graph (tmp1, wx1=x1, wx2=x2, wy1=y1, wy2=y2, wcs="logical", axis=1, + transpose=no, pointmode=no, marker="box", szmarker=0.005, + ltypes=ltype, colors=color, logx=no, logy=no, box=yes, + ticklabels=yes, xlabel="Wavelength (A)", ylabel="Rate", + xformat="wcsformat", yformat="", title=title, + lintran=no, p1=0., p2=0., q1=0., q2=1., vx1=0., vx2=0., vy1=0., + vy2=0., majrx=7, minrx=3, majry=7, minry=3, overplot=no, + append=append, device="stdgraph", round=no, fill=yes) + + delete (tmp1, verify-) + delete (tmp2, verify-) +end diff --git a/noao/obsutil/src/sptime/specpars.par b/noao/obsutil/src/sptime/specpars.par new file mode 100644 index 00000000..79c6c7f0 --- /dev/null +++ b/noao/obsutil/src/sptime/specpars.par @@ -0,0 +1,85 @@ +spectrograph,s,h,"",,,Spectrograph transmission or table +title,s,h,"",,,Spectrograph title +apmagdisp,r,h,INDEF,,,Aperture magnification along dispersion +apmagxdisp,r,h,INDEF,,,Aperture magnification across dispersion +inoutangle,r,h,INDEF,,,Incident to diffracted angle (deg) +xinoutangle,r,h,INDEF,,,"Incident to diffracted cross disperser angle (deg) + +# Telescope" +telescope,s,h,"",,,Telescope transmission or table +teltitle,s,h,"",,,Telescope title +area,r,h,INDEF,,,Telescope effective area (m^2) +scale,r,h,INDEF,,,Telescope scale at entrance aperture (arcsec/mm) +emissivity,s,h,"",,,Emissivity value or table +emistitle,s,h,"",,,"Emissivity title + +# Correctors" +corrector,s,h,"",,,Corrector transmission or table +cortitle,s,h,"",,,Corrector title +adc,s,h,"",,,ADC transmission or table +adctitle,s,h,"",,,"ADC title + +# Disperser" +disperser,s,h,"",,,Disperser efficiency or table +disptitle,s,h,"",,,Disperser title +disptype,s,h,"",,,Disperser type (grating|grism|generic) +gmm,r,h,INDEF,,,Grating (grooves/mm) +blaze,r,h,INDEF,,,Blaze or prism angle (deg) +oref,r,h,INDEF,,,Reference order +wavelength,r,h,INDEF,,,Central wavelength in ref order (A) +dispersion,r,h,INDEF,,,Dispersion at central wavelength in ref order (A/mm) +indexref,r,h,INDEF,,,Index of refraction at first order +eff,r,h,INDEF,,,"Peak efficiency + +# Crossdisperser" +xdisperser,s,h,"",,,Crossdisperser efficiency or table +xdisptitle,s,h,"",,,Crossdisperser title +xdisptype,s,h,"",,,Disperser type (grating|grism|generic) +xgmm,r,h,INDEF,,,Grating (grooves/mm) +xblaze,r,h,INDEF,,,Blaze or prism angle (deg) +xoref,r,h,INDEF,,,Reference order +xwavelength,r,h,INDEF,,,Central wavelength in ref order (A) +xindexref,r,h,INDEF,,,Index of refraction at first order +xdispersion,r,h,INDEF,,,Dispersion at central wavelength in ref order (A/mm) +xeff,r,h,INDEF,,,"Peak efficiency + +# Aperture" +aperture,s,h,"",,,Aperture transmission or table +aptitle,s,h,"",,,Aperture title +aptype,s,h,"",,,"Aperture type (rectanglular|circular) + +# Fiber" +fiber,s,h,"",,,Fiber transmission or table +fibtitle,s,h,"",,,"Fiber title + +# Filters" +filter,s,h,"",,,Filter transmission or table +ftitle,s,h,"",,,Filter title +filter2,s,h,"",,,Filter transmission or table +f2title,s,h,"",,,Filter title +block,s,h,"",,,"Assume other orders are blocked (yes|no) + +# Collimator" +collimator,s,h,"",,,Collimator transmission or table +coltitle,s,h,"",,,Collimator title +colfl,r,h,INDEF,,,"Collimator focal length (m) + +# Camera" +camera,s,h,"",,,Camera transmission or table +camtitle,s,h,"",,,Camera title +camfl,r,h,INDEF,,,Camera focal length (m) +resolution,r,h,INDEF,,,Camera resolution (mm) +vignetting,s,h,"",,,"Vignetting table + +# Detector" +detector,s,h,"",,,Detector DQE or table +dettitle,s,h,"",,,Detector title +ndisp,r,h,INDEF,,,Detector pixels along dispersion +pixsize,r,h,INDEF,,,Detector pixel size (mm) +gain,r,h,INDEF,,,Detector gain (photons/ADU) +rdnoise,r,h,INDEF,,,Detector read noise (photons) +dark,r,h,INDEF,,,Detector dark count rate (photons/s) +saturation,r,h,INDEF,,,Detector saturation (photons) +dnmax,r,h,INDEF,,,Detector maximum counts (ADU) +xbin,i,h,1,1,,Detector binning (dispersion) +ybin,i,h,1,1,,Detector binning (spatial) diff --git a/noao/obsutil/src/sptime/sptime.h b/noao/obsutil/src/sptime/sptime.h new file mode 100644 index 00000000..c17b377a --- /dev/null +++ b/noao/obsutil/src/sptime/sptime.h @@ -0,0 +1,132 @@ +# Definitions for SPTIME. + +# Spectral distribution types. +define SPECTYPES "|blackbody|flambda_power|fnu_power|" +define SPEC_TAB 0 +define SPEC_BB 1 +define SPEC_FL 2 +define SPEC_FN 3 + +# Flux units. +define FUNITS "|AB|F_lambda|F_nu|U|B|V|R|I|J|H|Ks|K|L|L'|M|" +define AB 1 +define FLAMBDA 2 +define FNU 3 +define UMAG 4 +define BMAG 5 +define VMAG 6 +define RMAG 7 +define IMAG 8 +define JMAG 9 +define HMAG 10 +define KSMAG 11 +define KMAG 12 +define LMAG 13 +define LPMAG 14 +define MMAG 15 + +# Sky subtraction options. +define SKYSUB "|none|longslit|multiap|shuffle|" +define SKY_NONE 1 +define SKY_LONGSLIT 2 +define SKY_MULTIAP 3 +define SKY_SHUFFLE 4 + +# Aperture types. +define APTYPES "|circular|rectangular|" +define CIRCULAR 1 +define RECTANGULAR 2 + +# Output types. +define OUTTYPES "|counts|snr|object|rate|atmosphere|telescope|adc|\ + |aperture|fiber|filter|filter2|collimator|disperser|\ + |xdisperser|corrector|camera|detector|spectrograph|\ + |emissivity|thruput|sensfunc|correction|" +define OUT_COUNTS 1 +define OUT_SNR 2 +define OUT_OBJ 3 +define OUT_RATE 4 +define OUT_ATM 5 +define OUT_TEL 6 +define OUT_ADC 7 +define OUT_AP 9 +define OUT_FIB 10 +define OUT_FILT 11 +define OUT_FILT2 12 +define OUT_COL 13 +define OUT_DISP 14 +define OUT_XDISP 16 +define OUT_COR 17 +define OUT_CAM 18 +define OUT_DET 19 +define OUT_SPEC 20 +define OUT_EMIS 22 +define OUT_THRU 23 +define OUT_SENS 24 +define OUT_CORRECT 25 + +# Grating types. +define DISPTYPES "|grating|grism|generic" +define GRATING 1 +define GRISM 2 +define GENERIC 3 + +# Macros. +define MINEXP 0.01 # Minimum exposure time. +define MAXNEXP 10000 # Maximum number of exposures. +define MAXITER 50 +define H 6.626E-27 +define C 2.99792456E18 + +# Data structure. +define ST_SZSTRING 99 # Length of strings +define ST_LEN 154 # Structure length + +define ST_TAB Memi[$1] # Tables pointer +define ST_SEARCH Memi[$1+1] # Search list +define ST_SPEC Memi[$1+2] # Spectrum type +define ST_PARAM Memr[P2R($1+3)] # Spectrum parameter +define ST_THERMAL Memr[P2R($1+4)] # Thermal background temperature +define ST_AV Memr[P2R($1+5)] # A(V) +define ST_RV Memr[P2R($1+6)] # A(V)/E(B-V) +define ST_TIME Memr[P2R($1+7)] # Exposure time +define ST_NEXP Memi[$1+8] # Number of exposures +define ST_MINEXP Memr[P2R($1+9)] # Minimum time per integration +define ST_MAXEXP Memr[P2R($1+10)] # Maximum time per integration +define ST_AIRMASS Memr[P2R($1+11)] # Airmass +define ST_SEEING Memr[P2R($1+12)] # Seeing (FWHM in arcsec) +define ST_PHASE Memr[P2R($1+13)] # Moon phase +define ST_REFW Memr[P2R($1+14)] # Reference wavelength +define ST_REFF Memr[P2R($1+15)] # Reference flux +define ST_REFFL Memr[P2R($1+16)] # Reference flambda +define ST_CW Memr[P2R($1+17)] # Central wavelength +define ST_ORDER Memi[$1+17+$2] # Grating orders (2) +define ST_APSIZE Memr[P2R($1+19+$2)] # Aperture sizes (2) +define ST_BIN Memi[$1+21+$2] # Binning (2) +define ST_GAIN Memr[P2R($1+24)] # Detector gain +define ST_RDNOISE Memr[P2R($1+25)] # Detector read noise +define ST_DARK Memr[P2R($1+26)] # Detector dark counts +define ST_INOUTA Memr[P2R($1+26+$2)] # Incident-diffracted angle(deg) +define ST_SKYSUB Memi[$1+29] # Sky subtraction type +define ST_NSKYAPS Memi[$1+30] # Number of sky apertures + +define ST_DISPTYPE Memi[$1+30+$2] # Disperser type +define ST_GR Memi[$1+32+$2] # Grating pointer (2) +define ST_DISP Memr[P2R($1+34+$2)] # Dispersion (2) +define ST_SCALE Memr[P2R($1+36+$2)] # Scale at detector (2) +define ST_RES Memr[P2R($1+38+$2)] # Resolution at detector (2) +define ST_AREA Memr[P2R($1+41)] # Effective collecting area +define ST_TELSCALE Memr[P2R($1+42)] # Telescope scale at aperture +define ST_NOBJPIX Memi[$1+43] # Number of object pixels +define ST_NSKYPIX Memi[$1+44] # Number of sky pixels +define ST_APLIM Memi[$1+45] # Aperture limited? +define ST_APTYPE Memi[$1+46] # Aperture type +define ST_PIXSIZE Memr[P2R($1+47)] # Pixel weighted disp. size +define ST_FILTBLK Memi[$1+48] # Block filter flag +define ST_DUNANG Memi[$1+49] # Angstrom units pointer +define ST_DUN Memi[$1+50] # User units pointer +define ST_SUBPIXELS Memi[$1+51] # Number of subpixels +define ST_COLFL Memr[P2R($1+52)] # Collimator focal length +define ST_CAMFL Memr[P2R($1+53)] # Collimator focal length +define ST_DUNITS Memc[P2C($1+54)] # Dispersion units +define ST_FUNITS Memc[P2C($1+104)] # Flux units diff --git a/noao/obsutil/src/sptime/sptime.par b/noao/obsutil/src/sptime/sptime.par new file mode 100644 index 00000000..0342e4f2 --- /dev/null +++ b/noao/obsutil/src/sptime/sptime.par @@ -0,0 +1,53 @@ +time,r,h,INDEF,,,Total exposure time (sec) +sn,r,h,25.,,,"S/N per pixel if time is INDEF + +# Source and background parameters" +spectrum,s,h,"blackbody",,,Source spectrum +spectitle,s,h,"",,,Spectrum title +E,r,h,0.,,,E(B-V) +R,r,h,3.1,,,A(V)/E(B-V) +sky,s,h,"",,,Sky spectrum +skytitle,s,h,"",,,Sky title +extinction,s,h,"",,,Extinction value or table +exttitle,s,h,"",,,"Extinction title + +# Spectral distribution parameters" +refwave,r,h,INDEF,,,Reference wavelength +refflux,r,h,10,,,Source flux at reference wavelength +funits,s,h,"AB","AB|F_lambda|F_nu|U|B|V|R|I|J|H|Ks|K|L|L'|M|",,Reference flux units +temperature,r,h,6000.,,,Blackbody temperature (K) +index,r,h,0.,,,"Power law index + +# Observation parameters" +seeing,r,h,1.,,,Seeing (arcsec) +airmass,r,h,1.,0.,,Airmass +phase,r,h,0.,0.,14.,Moon phase (0-14) +thermal,r,h,0.,,,Thermal background temperature (K) +wave,r,h,INDEF,,,Central wavelength +order,i,h,INDEF,,,Order for grating +xorder,i,h,INDEF,,,Order for crossdisperser grating +width,r,h,INDEF,,,Slit width (-=pixels +=arcsec) +length,r,h,INDEF,,,Slit length (-=pixels +=arcsec) +diameter,r,h,INDEF,,,Circular/fiber aperture diameter (-=pixels +=arcsec) +xbin,i,h,1,1,,Detector binning (dispersion) +ybin,i,h,1,1,,"Detector binning (spatial) + +# Calculation parameters" +search,s,h,"spectimedb$",,,List of directories to search for tables +minexp,r,h,0.01,,,Minimum time per exposure (sec) +maxexp,r,h,3600.,,,Maximum time per exposure (sec) +units,s,h,"Angstroms",,,Wavelength units +skysub,s,h,"",,,Type of sky subtaction (none|longslit|multiap|shuffle) +nskyaps,i,h,10,0,,Number of multiap sky apertures +subpixels,i,h,INDEF,,,Number of subpixels in calculation +sensfunc,s,h,"",,,"Sensitivity function value or table + +# Output parameters" +output,s,h,"",,,List of output quantities +nw,i,h,101,,,Number of output dispersion points +list,s,h,"",,,Output list file +graphics,s,h,"stdgraph",,,Graphics device +interactive,b,h,yes,,,"Interactive pause after graphs? + +# Spectrograph parameters" +specpars,pset,h,"",,,Spectrograph parameters diff --git a/noao/obsutil/src/sptime/stdisperser.x b/noao/obsutil/src/sptime/stdisperser.x new file mode 100644 index 00000000..090cf010 --- /dev/null +++ b/noao/obsutil/src/sptime/stdisperser.x @@ -0,0 +1,455 @@ +include "sptime.h" + +# These routines interface between any type of disperser and the +# disperser type specific routines (such as those for gratings). + + +# ST_DISPERSER -- Initialize disperser data. + +procedure st_disperser (st, name, index) + +pointer st #I SPECTIME pointer +char name[ARB] #I Table name +int index #I Grating index + +int order, oref, stgeti(), tabgeti(), strdic() +real f, phi, g, blaze, wb, db, ref, stgetr(), tabgetr(), gr_getr() +pointer sp, str, fname, gr, gr_open() +bool streq() +errchk gr_open, tab_getr, gr_getr, st_gtable1 + +begin + call smark (sp) + call salloc (str, SZ_LINE, TY_CHAR) + call salloc (fname, SZ_LINE, TY_CHAR) + + ST_GR(st,index) = NULL + ST_DISPTYPE(st,index) = 0 + + # Get disperser type. + if (streq (name, "disperser")) { + call stgstr (st, "disptype", "disperser", "", Memc[str], SZ_LINE) + if (Memc[str] == EOS) { + iferr (call tabgstr (ST_TAB(st), "disperser", "spectrograph", + "type", Memc[str], SZ_LINE)) + call strcpy ("generic", Memc[str], SZ_LINE) + } + } else if (streq (name, "xdisperser")) { + call stgstr (st, "xdisptype", "xdisperser", "", Memc[str], SZ_LINE) + if (Memc[str] == EOS) { + iferr (call tabgstr (ST_TAB(st), "xdisperser", "spectrograph", + "type", Memc[str], SZ_LINE)) + Memc[str] = EOS + } + } else + Memc[str] = EOS + ST_DISPTYPE(st,index) = strdic (Memc[str],Memc[str],SZ_LINE,DISPTYPES) + + switch (ST_DISPTYPE(st,index)) { + case GRATING: + f = ST_CAMFL(st) * 1000 + switch (index) { + case 1: + g = stgetr (st, "gmm", name, INDEFR) + blaze = stgetr (st, "blaze", name, INDEFR) + oref = stgeti (st, "oref", name, 1) + wb = stgetr (st, "wavelength", name, INDEFR) + db = stgetr (st, "dispersion", name, INDEFR) + ref = stgetr (st, "eff", name, INDEFR) + case 2: + g = stgetr (st, "xgmm", name, INDEFR) + blaze = stgetr (st, "xblaze", name, INDEFR) + oref = stgeti (st, "xoref", name, 1) + wb = stgetr (st, "xwavelength", name, INDEFR) + db = stgetr (st, "xdispersion", name, INDEFR) + ref = stgetr (st, "xeff", name, INDEFR) + + # Check old names. + if (IS_INDEFR(g)) { + iferr (g = tabgetr (ST_TAB(st), name, "spectrograph", + "gmm")) + g = INDEFR + } + } + + # Old names. + if (IS_INDEFR(g)) { + iferr (g = tabgetr (ST_TAB(st), name, "spectrograph", + "gmm")) + g = INDEFR + } + if (IS_INDEFR(blaze)) { + iferr (blaze = tabgetr (ST_TAB(st), name, "spectrograph", + "blaze")) + blaze = INDEFR + } + if (IS_INDEFI(oref)) { + iferr (oref = tabgeti (ST_TAB(st), name, "spectrograph", + "oref")) + oref = 1 + } + if (IS_INDEFR(wb)) { + iferr (wb = tabgetr (ST_TAB(st), name, "spectrograph", + "wavelength")) + wb = INDEFR + } + if (IS_INDEFR(db)) { + iferr (db = tabgetr (ST_TAB(st), name, "spectrograph", + "dispersion")) + db = INDEFR + } + if (IS_INDEFR(ref)) { + iferr (ref = tabgetr (ST_TAB(st), name, "spectrograph", + "reflectance")) + ref = 1. + } + + phi = ST_INOUTA(st,index) +# if (!IS_INDEFR(db)) +# db = db / f + + iferr (gr = gr_open (ST_CW(st), ST_ORDER(st,index), ref, wb, db, + oref, f, g, blaze, 1., phi, INDEF, INDEF, 1, YES)) { + g = 300. + blaze = 6 + gr = gr_open (ST_CW(st), ST_ORDER(st,index), ref, wb, db, + oref, f, g, blaze, 1., phi, INDEF, INDEF, 1, YES) + } + ST_GR(st,index) = gr + + if (IS_INDEF(ST_CW(st))) + ST_CW(st,index) = gr_getr (gr, "wavelength") + if (IS_INDEFI(ST_ORDER(st,index))) + ST_ORDER(st,index) = nint (gr_getr (gr, "order")) + ST_DISP(st,index) = gr_getr (gr, "dblaze") * oref * f + + # Look for explicit blaze functions. + do order = ST_ORDER(st,index)-1, ST_ORDER(st,index)+1 { + call sprintf (Memc[str], SZ_LINE, "eff%d") + call pargi (order) + ifnoerr (call tabgstr (ST_TAB(st), name, "spectrograph", + Memc[str], Memc[fname], SZ_LINE)) { + if (streq (name, "disperser")) + call st_gtable1 (st, Memc[str], Memc[fname]) + else if (streq (name, "xdisperser")) { + call sprintf (Memc[str], SZ_LINE, "xeff%d") + call pargi (order) + call st_gtable1 (st, Memc[str], Memc[fname]) + } + } + } + case GRISM: + f = ST_CAMFL(st) * 1000 + switch (index) { + case 1: + g = stgetr (st, "gmm", name, INDEFR) + blaze = stgetr (st, "blaze", name, INDEFR) + ref = stgetr (st, "eff", name, 1.) + db = stgetr (st, "indexref", name, INDEFR) + if (!IS_INDEFI(ST_ORDER(st,index)) && ST_ORDER(st,index)!=1) { + call sprintf (Memc[str], SZ_LINE, "index%d") + call pargi (ST_ORDER(st,index)) + iferr (wb = tabgetr (ST_TAB(st), name, "spectrograph", + Memc[str])) + wb = db + db = wb + } + case 2: + g = stgetr (st, "xgmm", name, INDEFR) + blaze = stgetr (st, "xblaze", name, INDEFR) + ref = stgetr (st, "xeff", name, 1.) + db = stgetr (st, "xindexref", name, INDEFR) + if (!IS_INDEFI(ST_ORDER(st,index)) && ST_ORDER(st,index)!=1) { + call sprintf (Memc[str], SZ_LINE, "index%d") + call pargi (ST_ORDER(st,index)) + iferr (wb = tabgetr (ST_TAB(st), name, "spectrograph", + Memc[str])) + wb = db + db = wb + } + } + + # Old names. + if (IS_INDEFR(g)) { + iferr (g = tabgetr (ST_TAB(st), name, "spectrograph", + "gmm")) + g = INDEFR + } + if (IS_INDEFR(blaze)) { + iferr (blaze = tabgetr (ST_TAB(st), name, "spectrograph", + "prism")) + blaze = INDEFR + } + if (IS_INDEFR(ref)) { + iferr (ref = tabgetr (ST_TAB(st), name, "spectrograph", + "transmission")) + ref = 1 + } + if (IS_INDEFR(db)) { + if (!IS_INDEFI(ST_ORDER(st,index))) { + call sprintf (Memc[str], SZ_LINE, "index%d") + call pargi (ST_ORDER(st,index)) + iferr (db = tabgetr (ST_TAB(st), name, "spectrograph", + Memc[str])) + db = tabgetr (ST_TAB(st), name, "spectrograph", + "index1") + } else + db = tabgetr (ST_TAB(st), name, "spectrograph", "index1") + } + oref = 1 + + iferr (gr = gr_open (ST_CW(st), ST_ORDER(st,index), ref, INDEF, + INDEF, oref, f, g, blaze, db, 0., blaze, blaze, 1, YES)) { + g = 300. + blaze = 6. + gr = gr_open (ST_CW(st), ST_ORDER(st,index), ref, INDEF, + INDEF, oref, f, g, blaze, db, 0., blaze, blaze, 1, YES) + } + + ST_GR(st,index) = gr + + if (IS_INDEF(ST_CW(st))) + ST_CW(st,index) = gr_getr (gr, "wavelength") + if (IS_INDEFI(ST_ORDER(st,index))) + ST_ORDER(st,index) = nint (gr_getr (gr, "order")) + ST_DISP(st,index) = gr_getr (gr, "dblaze") * oref * f + + # Look for explicit blaze functions. + do order = ST_ORDER(st,index)-1, ST_ORDER(st,index)+1 { + call sprintf (Memc[str], SZ_LINE, "eff%d") + call pargi (order) + ifnoerr (call tabgstr (ST_TAB(st), name, "spectrograph", + Memc[str], Memc[fname], SZ_LINE)) { + if (streq (name, "disperser")) + call st_gtable1 (st, Memc[str], Memc[fname]) + else if (streq (name, "xdisperser")) { + call sprintf (Memc[str], SZ_LINE, "xeff%d") + call pargi (order) + call st_gtable1 (st, Memc[str], Memc[fname]) + } + } + } + case GENERIC: + f = ST_CAMFL(st) * 1000 + g = INDEFR + blaze = INDEFR + oref = 1 + + switch (index) { + case 1: + g = INDEFR + blaze = INDEFR + oref = 1 + wb = stgetr (st, "wavelength", name, INDEFR) + db = stgetr (st, "dispersion", name, INDEFR) + ref = stgetr (st, "eff", name, INDEFR) + case 2: + g = INDEFR + blaze = INDEFR + oref = 1 + wb = stgetr (st, "xwavelength", name, INDEFR) + db = stgetr (st, "xdispersion", name, INDEFR) + ref = stgetr (st, "xeff", name, INDEFR) + } + + if (IS_INDEFR(wb)) { + iferr (wb = tabgetr (ST_TAB(st), name, "spectrograph", + "wavelength")) + wb = INDEFR + } + if (IS_INDEFR(db)) { + iferr (db = tabgetr (ST_TAB(st), name, "spectrograph", + "dispersion")) + db = INDEFR + } + if (IS_INDEFR(ref)) { + iferr (ref = tabgetr (ST_TAB(st), name, "spectrograph", + "reflectance")) + ref = 1. + } + + phi = ST_INOUTA(st,index) + + gr = gr_open (ST_CW(st), ST_ORDER(st,index), ref, wb, db, + oref, f, g, blaze, 1., phi, INDEF, INDEF, 1, NO) + ST_GR(st,index) = gr + + if (IS_INDEF(ST_CW(st))) + ST_CW(st,index) = gr_getr (gr, "wavelength") + if (IS_INDEFI(ST_ORDER(st,index))) + ST_ORDER(st,index) = nint (gr_getr (gr, "order")) + ST_DISP(st,index) = gr_getr (gr, "dblaze") * oref * f + + # Look for explicit blaze functions. + do order = ST_ORDER(st,index)-1, ST_ORDER(st,index)+1 { + call sprintf (Memc[str], SZ_LINE, "eff%d") + call pargi (order) + ifnoerr (call tabgstr (ST_TAB(st), name, "spectrograph", + Memc[str], Memc[fname], SZ_LINE)) { + if (streq (name, "disperser")) + call st_gtable1 (st, Memc[str], Memc[fname]) + else if (streq (name, "xdisperser")) { + call sprintf (Memc[str], SZ_LINE, "xeff%d") + call pargi (order) + call st_gtable1 (st, Memc[str], Memc[fname]) + } + } + } + } + + call sfree (sp) +end + + +# ST_DISPEFF -- Return disperser efficiency. + +real procedure st_dispeff (st, name, wave, order) + +pointer st #I SPECTIME pointer +char name[ARB] #I Table name +real wave #I Wavelength +int order #I Order +real eff #O Efficiency + +real w +pointer sp, tab, str + +int tabgeti() +real tabinterp1(), tabgetr(), gr_eff() +bool tabexists(), streq() +errchk tabinterp1, gr_eff + +begin + tab = ST_TAB(st) + eff = INDEF + + if (streq (name, "disperser") && ST_DISPTYPE(st,1) == 0) + return (eff) + if (streq (name, "xdisperser") && ST_DISPTYPE(st,2) == 0) + return (eff) + + call smark (sp) + call salloc (str, SZ_FNAME, TY_CHAR) + if (streq (name, "disperser")) { + call sprintf (Memc[str], SZ_FNAME, "eff%d") + call pargi (order) + if (!tabexists (tab, Memc[str])) { + if (order == 1 && tabexists (tab, name)) { + if (tabgeti (tab, name, "", "table.ndim") != 0) + call strcpy (name, Memc[str], SZ_FNAME) + } + } + if (tabexists (tab, Memc[str])) { + eff = tabinterp1 (tab, Memc[str], wave) + w = max (tabgetr (tab, Memc[str], "", "table.xmin"), wave) + w = min (tabgetr (tab, Memc[str], "", "table.xmax"), w) + if (w != wave) { + eff = tabinterp1 (tab, Memc[str], w) / + gr_eff (ST_GR(st,1), w, order) + eff = eff * gr_eff (ST_GR(st,1), wave, order) + } + } else + eff = gr_eff (ST_GR(st,1), wave, order) + } else if (streq (name, "xdisperser")) { + call sprintf (Memc[str], SZ_FNAME, "xeff%d") + call pargi (order) + if (!tabexists (tab, Memc[str])) { + if (order == 1 && tabexists (tab, name)) { + if (tabgeti (tab, name, "", "table.ndim") != 0) + call strcpy (name, Memc[str], SZ_FNAME) + } + } + if (tabexists (tab, Memc[str])) { + eff = tabinterp1 (tab, Memc[str], wave) + w = max (tabgetr (tab, Memc[str], "", "table.xmin"), wave) + w = min (tabgetr (tab, Memc[str], "", "table.xmax"), w) + if (w != wave) { + eff = tabinterp1 (tab, Memc[str], w) / + gr_eff (ST_GR(st,2), w, order) + eff = eff * gr_eff (ST_GR(st,2), wave, order) + } + } else + eff = gr_eff (ST_GR(st,2), wave, order) + } + + if (IS_INDEF(eff)) + eff = 0. + + call sfree (sp) + return (eff) +end + + +# ST_X2W -- Return wavelength at given position on detector. + +real procedure st_x2w (st, index, x) + +pointer st #I SPECTIME pointer +int index #I Grating index +real x #I Detector position (mm from center) +real w #O Wavelength (Angstroms) + +real gr_x2w() + +begin + switch (ST_DISPTYPE(st,index)) { + case GRATING: + w = gr_x2w (ST_GR(st,index), x, ST_ORDER(st,index)) + case GRISM: + w = gr_x2w (ST_GR(st,index), x, ST_ORDER(st,index)) + case GENERIC: + w = gr_x2w (ST_GR(st,index), x, ST_ORDER(st,index)) + } + + return (w) +end + + +# ST_W2X -- Return wavelength at given position on detector. + +real procedure st_w2x (st, index, w) + +pointer st #I SPECTIME pointer +int index #I Grating index +real w #I Wavelength (Angstroms) +real x #O Detector position (mm from center) + +real gr_w2x() + +begin + switch (ST_DISPTYPE(st,index)) { + case GRATING: + x = gr_w2x (ST_GR(st,index), w, ST_ORDER(st,index)) + case GRISM: + x = gr_w2x (ST_GR(st,index), w, ST_ORDER(st,index)) + case GENERIC: + x = gr_w2x (ST_GR(st,index), w, ST_ORDER(st,index)) + } + + return (x) +end + + +# ST_W2DW -- Return dispersion on detector at given wavelength. + +real procedure st_w2dw (st, index, w) + +pointer st #I SPECTIME pointer +int index #I Grating index +real w #I Wavelength (Angstroms) +real d #I Dispersion (Angstroms/mm) + +real gr_w2dw() + +begin + switch (ST_DISPTYPE(st,index)) { + case GRATING: + d = gr_w2dw (ST_GR(st,index), w, ST_ORDER(st,index)) + case GRISM: + d = gr_w2dw (ST_GR(st,index), w, ST_ORDER(st,index)) + case GENERIC: + d = gr_w2dw (ST_GR(st,index), w, ST_ORDER(st,index)) + } + + return (d) +end diff --git a/noao/obsutil/src/sptime/t_cgiparse.x b/noao/obsutil/src/sptime/t_cgiparse.x new file mode 100644 index 00000000..8985a8f0 --- /dev/null +++ b/noao/obsutil/src/sptime/t_cgiparse.x @@ -0,0 +1,110 @@ +define SZ_QUERY 2048 + + +# T_CGIPARSE -- Parse the CGI QUERY_STRING environment variable. +# The string is expected to be a set of task.param=value pairs. +# The task parameter values are set. + +procedure t_cgiparse () + +char c, hex[2] +int i +long hexval +pointer sp, str, par, val +pointer ip, op + +int envfind(), gctol() + +begin + call smark (sp) + call salloc (str, SZ_QUERY, TY_CHAR) + call salloc (par, SZ_LINE, TY_CHAR) + call salloc (val, SZ_LINE, TY_CHAR) + + # Get the query string. If there isn't one then do nothing. + if (envfind ("QUERY_STRING", Memc[str], SZ_QUERY) <= 0) + return + + # Parse the query string into parameters and values. + # For each pair set the task parameter. + + op = par + for (ip=str;; ip=ip+1) { + c = Memc[ip] + switch (c) { + case '&', EOS: # End of parameter=value + Memc[op] = EOS + call cgi_setpar (Memc[par], Memc[val]) + if (c == EOS) + break + Memc[par] = EOS + Memc[val] = EOS + op = par + next + case '=': # Separator between parameters and value + Memc[op] = EOS + op = val + next + case '+': # Space character + c = ' ' + case '%': # Special characters in hex + call strcpy (Memc[ip+1], hex, 2) + i = 1 + if (gctol (hex, i, hexval, 16) > 0) { + c = hexval + ip = ip + 2 + } + } + + Memc[op] = c + op = op + 1 + } + + call sfree (sp) +end + + +# CGI_SETPAR -- Set parameter value. +# There is no error check for undefined tasks or parameters. +# Values of the wrong type are ignored. + +procedure cgi_setpar (param, val) + +char param[ARB] #I Task parameter +char val[ARB] #I Value string + +bool bval, streq() +int ival, ip, ctoi(), ctod() +double dval +pointer sp, str, type + +begin + call smark (sp) + call salloc (str, SZ_LINE, TY_CHAR) + call salloc (type, 10, TY_CHAR) + + # Determine if parameter type. + call sprintf (Memc[str], SZ_LINE, "%s.p_type") + call pargstr (param) + call clgstr (Memc[str], Memc[type], 10) + + # Set parameter in the approriate type. + ip = 1 + switch (Memc[type]) { + case 'i': + if (ctoi (val, ip, ival) > 0) + call clputi (param, ival) + case 'r': + if (ctod (val, ip, dval) > 0) + call clputd (param, dval) + case 'b': + if (streq (val, "no") || streq (val, "yes")) { + bval = streq (val, "yes") + call clputb (param, bval) + } + default: + call clpstr (param, val) + } + + call sfree (sp) +end diff --git a/noao/obsutil/src/sptime/t_sptime.x b/noao/obsutil/src/sptime/t_sptime.x new file mode 100644 index 00000000..6d052acf --- /dev/null +++ b/noao/obsutil/src/sptime/t_sptime.x @@ -0,0 +1,2530 @@ +include +include +include +include +include +include "sptime.h" + + +# T_SPTIME -- Spectroscopic exposure time calculator. + +procedure t_sptime () + +bool interactive +int i, j, nexp, niter, npix, nw, fd, outlist +real nobj[4], nsky[4], time, minexp, maxexp, snr, sngoal +real wave, x, x1, dx, thruput, sat, dnmax +pointer sp, str, err, st, tab, waves, counts, snrs, gp + +bool streq(), tabexists(), fp_equalr() +int stgeti(), strdic() +int clpopnu(), fntopnb(), fntgfnb(), nowhite(), open(), tabgeti() +real stgetr(), tabgetr(), tabinterp1(), gr_mag(), gr_getr() +real st_x2w() +pointer tabopen(), gopen(), un_open() +errchk tabopen, tabgeti, tabgetr, tabinterp1 +errchk st_gtable, st_gtable1, stgeti, stgetr, st_snr, st_disperser +errchk open, gopen + +begin + call smark (sp) + call salloc (st, ST_LEN, TY_STRUCT) + call salloc (str, SZ_LINE, TY_CHAR) + call salloc (err, SZ_FNAME, TY_CHAR) + + # Load tables. + ST_SEARCH(st) = clpopnu ("search") + ST_TAB(st) = tabopen () + tab = ST_TAB(st) + call st_gtable (st, "spectrograph", "") + call st_gtable (st, "spectrum", "spectrograph") + call st_gtable (st, "sky", "spectrograph") + call st_gtable (st, "extinction", "spectrograph") + call st_gtable (st, "telescope", "spectrograph") + call st_gtable (st, "emissivity", "spectrograph") + call st_gtable (st, "adc", "spectrograph") + call st_gtable (st, "filter", "spectrograph") + call st_gtable (st, "filter2", "spectrograph") + call st_gtable (st, "aperture", "spectrograph") + call st_gtable (st, "fiber", "spectrograph") + call st_gtable (st, "aperture", "fiber") + call st_gtable (st, "collimator", "spectrograph") + call st_gtable (st, "disperser", "spectrograph") + call st_gtable (st, "xdisperser", "spectrograph") + call st_gtable (st, "corrector", "spectrograph") + call st_gtable (st, "camera", "spectrograph") + call st_gtable (st, "vignetting", "spectrograph") + call st_gtable (st, "vignetting", "camera") + call st_gtable (st, "detector", "spectrograph") + call st_gtable (st, "sensfunc", "spectrograph") + + call st_gtable1 (st, "abjohnson", "abjohnson") + + # Set dispersion units. + call stgstr (st, "units", "spectrograph", "Angstroms", + Memc[str], SZ_LINE) + call strcpy (Memc[str], ST_DUNITS(st), ST_SZSTRING) + ST_DUNANG(st) = un_open ("angstroms") + ST_DUN(st) = un_open (ST_DUNITS(st)) + + # Set spectrum. + ST_REFW(st) = stgetr (st, "refwave", "spectrum", INDEFR) + if (!IS_INDEFR(ST_REFW(st))) + call un_ctranr (ST_DUN(st), ST_DUNANG(st), ST_REFW(st), + ST_REFW(st), 1) + ST_REFF(st) = stgetr (st, "refflux", "spectrograph", 10.) + call stgstr (st, "funits", "spectrograph", "AB", Memc[str], SZ_LINE) + ST_FUNITS(st) = strdic (Memc[str], Memc[str], SZ_LINE, FUNITS) + switch (ST_SPEC(st)) { + case SPEC_BB: + ST_PARAM(st) = stgetr (st, "temperature", "spectrograph", 6000.) + case SPEC_FL, SPEC_FN: + ST_PARAM(st) = stgetr (st, "index", "spectrograph", 0.) + } + ST_RV(st) = stgetr (st, "R", "spectrum", 3.1) + ST_AV(st) = ST_RV(st) * stgetr (st, "E", "spectrum", 0.) + + # Set observing conditions. + ST_SEEING(st) = stgetr (st, "seeing", "spectrograph", 1.) + ST_AIRMASS(st) = stgetr (st, "airmass", "spectrograph", 1.) + ST_PHASE(st) = stgetr (st, "phase", "spectrograph", 0.) + + # Set thermal background. + ST_THERMAL(st) = stgetr (st, "thermal", "telescope", 0.) + + # Set instrument. + ST_CW(st) = stgetr (st, "wave", "spectrograph", INDEFR) + if (!IS_INDEFR(ST_CW(st))) + call un_ctranr (ST_DUN(st), ST_DUNANG(st), ST_CW(st), ST_CW(st), 1) + ST_ORDER(st,1) = stgeti (st, "order", "spectrograph", INDEFI) + ST_ORDER(st,2) = stgeti (st, "xorder", "spectrograph", INDEFI) + + # Aperture. + if (!tabexists (tab, "aperture")) { + if (tabexists (tab, "fiber")) + call st_gtable1 (st, "aperture", "circle") + else if (!IS_INDEFR(stgetr(st, "diameter", "spectrograph", INDEFR))) + call st_gtable1 (st, "aperture", "circle") + else + call st_gtable1 (st, "aperture", "slit") + } + call stgstr (st, "aptype", "aperture", "", Memc[str], SZ_LINE) + if (Memc[str] == EOS) { + iferr (call tabgstr (tab, "aperture", "", "type", + Memc[str], SZ_LINE)) { + if (tabgeti (tab, "aperture", "", "table.ndim") == 2) + call strcpy ("circular", Memc[str], SZ_LINE) + else + call strcpy ("rectangular", Memc[str], SZ_LINE) + } + } + ST_APTYPE(st) = strdic (Memc[str], Memc[str], SZ_LINE, APTYPES) + switch (ST_APTYPE(st)) { + case CIRCULAR: + if (tabexists (tab, "fiber")) { + ST_APSIZE(st,1) = stgetr (st, "diameter", "fiber", INDEFR) + if (!IS_INDEFR(ST_APSIZE(st,1)) && ST_APSIZE(st,1) > 0.) { + ST_TELSCALE(st) = stgetr (st, "scale", "telescope", 10.) + ST_APSIZE(st,1) = ST_APSIZE(st,1) * ST_TELSCALE(st) + } + } + if (IS_INDEFR(ST_APSIZE(st,1))) + ST_APSIZE(st,1) = stgetr (st, "diameter", "aperture", -2.) + ST_APSIZE(st,2) = ST_APSIZE(st,1) + case RECTANGULAR: + ST_APSIZE(st,1) = stgetr (st, "width", "aperture", -2.) + ST_APSIZE(st,2) = stgetr (st, "length", "aperture", -100.) + default: + call sprintf (Memc[err], SZ_FNAME, + "Unknown aperture type (%s)") + call pargstr (Memc[str]) + call error (1, Memc[err]) + } + + ST_INOUTA(st,1) = stgetr (st, "inoutangle", "spectrograph", INDEFR) + ST_INOUTA(st,2) = stgetr (st, "xinoutangle", "spectrograph", INDEFR) + ST_BIN(st,1) = stgeti (st, "xbin", "detector", 1) + ST_BIN(st,2) = stgeti (st, "ybin", "detector", 1) + ST_GAIN(st) = stgetr (st, "gain", "detector", 1.) + ST_RDNOISE(st) = stgetr (st, "rdnoise", "detector", 0.) + ST_DARK(st) = stgetr (st, "dark", "detector", 0.) + + # Set filter flag. + ST_FILTBLK(st) = NO + call stgstr (st, "block", "filter", "no", Memc[str], SZ_LINE) + if (streq (Memc[str], "yes")) + ST_FILTBLK (st) = YES + + # Set sky subtraction parameters. + if (tabexists (tab, "sky") || + (tabexists (tab, "emissivity") && ST_THERMAL(st) > 0.)) { + switch (ST_APTYPE(st)) { + case CIRCULAR: + call stgstr (st, "skysub", "spectrograph", "multiap", + Memc[str], SZ_LINE) + ST_NSKYAPS(st) = stgeti (st, "nskyaps", "spectrograph", 10) + case RECTANGULAR: + call stgstr (st, "skysub", "spectrograph", "longslit", + Memc[str], SZ_LINE) + } + } else + call stgstr (st, "skysub", "spectrograph", "none", Memc[str], + SZ_LINE) + + ST_SKYSUB(st) = strdic (Memc[str], Memc[str], SZ_LINE, SKYSUB) + + # Set calculation parameters. + ST_MINEXP(st) = stgetr (st, "minexp", "spectrograph", MINEXP) + ST_MAXEXP(st) = stgetr (st, "maxexp", "spectrograph", 3600.) + if (ST_MINEXP(st) <= 0.) + ST_MINEXP(st) = MINEXP + if (ST_MAXEXP(st) <= ST_MINEXP(st)) + ST_MAXEXP(st) = ST_MINEXP(st) + time = stgetr (st, "time", "spectrograph", INDEFR) + sngoal = stgetr (st, "sn", "spectrograph", 25.) + if (IS_INDEF(time) && IS_INDEF(sngoal)) + call error (1, + "Either an exposure time or a desired S/N must be specified") + ST_SUBPIXELS(st) = stgeti (st, "subpixels", "spectrograph", 1) + + # Set output parameters. + gp = NULL; fd = NULL + call stgstr (st, "output", "spectrograph", "", Memc[str], SZ_LINE) + outlist = fntopnb (Memc[str], NO) + if (fntgfnb (outlist, Memc[str], SZ_LINE) != EOF) { + if (streq (Memc[str], "ALL")) { + call strcpy (OUTTYPES, Memc[str], SZ_LINE) + j = str+1 + for (i=j; Memc[i] != EOS; i=i+1) { + if (IS_WHITE(Memc[i]) || Memc[i] == '\n') + next + if (Memc[i] == Memc[str]) + Memc[j] = ',' + else + Memc[j] = Memc[i] + j = j + 1 + } + Memc[j] = EOS + call fntclsb (outlist) + outlist = fntopnb (Memc[str+1], NO) + } else + call fntrewb (outlist) + nw = stgeti (st, "nw", "spectrograph", 101) + call stgstr (st, "graphics", "spectrograph", "stdgraph", + Memc[str], SZ_LINE) + if (nowhite (Memc[str], Memc[str], SZ_LINE) > 0) { + gp = gopen (Memc[str], NEW_FILE+AW_DEFER, STDGRAPH) + call stgstr (st, "interactive", "spectrograph", "yes", + Memc[str], SZ_LINE) + interactive = streq (Memc[str], "yes") + } + call stgstr (st, "list", "spectrograph", "", Memc[str], SZ_LINE) + if (nowhite (Memc[str], Memc[str], SZ_LINE) > 0) + fd = open (Memc[str], APPEND, TEXT_FILE) + } + + # Focal lengths. + ST_COLFL(st) = stgetr (st, "colfl", "collimator", INDEFR) + if (IS_INDEFR(ST_COLFL(st))) { + iferr (ST_COLFL(st) = tabgetr (tab, "collimator", "", "fl")) + ST_COLFL(st) = 1. + } + ST_CAMFL(st) = stgetr (st, "camfl", "camera", INDEFR) + if (IS_INDEFR(ST_CAMFL(st))) { + iferr (ST_CAMFL(st) = tabgetr (tab, "camera", "", "fl")) + ST_CAMFL(st) = 1. + } + + call st_disperser (st, "disperser", 1) + if (ST_DISPTYPE(st,1) == 0) + call error (1, "No disperser specified") + call st_disperser (st, "xdisperser", 2) + + ST_AREA(st) = 10000 * stgetr (st, "area", "telescope", 1.) + + # Scales. + ST_TELSCALE(st) = stgetr (st, "scale", "telescope", 10.) + ST_SCALE(st,1) = ST_TELSCALE(st) + ST_SCALE(st,2) = ST_TELSCALE(st) + x = gr_mag (ST_GR(st,1), ST_CW(st), ST_ORDER(st,1)) + if (!IS_INDEF(x)) + ST_SCALE(st,1) = ST_SCALE(st,1) / x + x = gr_mag (ST_GR(st,2), ST_CW(st), ST_ORDER(st,2)) + if (!IS_INDEF(x)) + ST_SCALE(st,2) = ST_SCALE(st,2) / x + x = ST_COLFL(st) / ST_CAMFL(st) + ST_SCALE(st,1) = ST_SCALE(st,1) * x + ST_SCALE(st,2) = ST_SCALE(st,2) * x + ST_SCALE(st,1) = ST_SCALE(st,1) * + stgetr (st, "apmagdisp", "spectrograph", 1.) + ST_SCALE(st,2) = ST_SCALE(st,2) * + stgetr (st, "apmagxdisp", "spectrograph", 1.) + ST_PIXSIZE(st) = stgetr (st, "pixsize", "detector", 0.02) + ST_SCALE(st,1) = ST_SCALE(st,1) * ST_PIXSIZE(st) * ST_BIN(st,1) + ST_SCALE(st,2) = ST_SCALE(st,2) * ST_PIXSIZE(st) * ST_BIN(st,2) + + # Convert aperture sizes to arcsec. + if (ST_APSIZE(st,1) < 0.) + ST_APSIZE(st,1) = -ST_APSIZE(st,1) * ST_SCALE(st,1) + else + ST_APSIZE(st,1) = ST_APSIZE(st,1) + if (ST_APSIZE(st,2) < 0.) + ST_APSIZE(st,2) = -ST_APSIZE(st,2) * ST_SCALE(st,2) + else + ST_APSIZE(st,2) = ST_APSIZE(st,2) + + # Set dispersion per pixel and per resolution element. + ST_RES(st,1) = stgetr (st, "resolution", "camera", INDEFR) + if (IS_INDEFR(ST_RES(st,1))) + ST_RES(st,1) = 2 + else + ST_RES(st,1) = ST_RES(st,1) / ST_PIXSIZE(st) + ST_RES(st,2) = ST_RES(st,1) + ST_DISP(st,1) = abs (gr_getr (ST_GR(st,1), "dispersion")) + ST_DISP(st,1) = ST_DISP(st,1) * ST_PIXSIZE(st) * ST_BIN(st,1) + x = 1 + min (ST_SEEING(st), ST_APSIZE(st,1)) / ST_SCALE(st,1) + ST_DISP(st,2) = ST_DISP(st,1) * max (2., ST_RES(st,1), x) + + # Set number of pixels in object. + switch (ST_APTYPE(st)) { + case CIRCULAR: + x = ST_APSIZE(st,2) / ST_SCALE(st,2) + ST_RES(st,2) + npix = max (1, int (x + 0.999)) + ST_NOBJPIX(st) = npix + ST_APLIM(st) = YES + case RECTANGULAR: + x = ST_APSIZE(st,2) / ST_SCALE(st,2) + ST_RES(st,2) + npix = max (1, int (x + 0.999)) + x = min (ST_APSIZE(st,2), 3*ST_SEEING(st)) / ST_SCALE(st,2) + + ST_RES(st,2) + ST_NOBJPIX(st) = min (npix, int (x + 0.999)) + if (ST_NOBJPIX(st) > npix) + ST_APLIM(st) = NO + else + ST_APLIM(st) = YES + } + + # Set number of pixels in sky. + switch (ST_SKYSUB(st)) { + case SKY_NONE: + ST_NSKYPIX(st) = 0 + case SKY_LONGSLIT: + ST_NSKYPIX(st) = max (0, npix - ST_NOBJPIX(st)) + case SKY_MULTIAP: + ST_NSKYPIX(st) = npix * ST_NSKYAPS(st) + case SKY_SHUFFLE: + ST_NSKYPIX(st) = npix + } + + # Compute exposure time and S/N. + if (!tabexists (tab, "spectrum")) { + if (IS_INDEF(ST_REFW(st))) + ST_REFW(st) = ST_CW(st) + switch (ST_FUNITS(st)) { + case AB: + ST_REFFL(st) = 10. ** (-0.4 * + (ST_REFF(st) + 5*log10(ST_REFW(st)) + 2.40)) + case FLAMBDA: + if (ST_REFF(st) < 0.) + call error (1, + "Monochromatic flux (F-lambda) must be greater than 0") + ST_REFFL(st) = ST_REFF(st) + case FNU: + if (ST_REFF(st) < 0.) + call error (1, + "Monochromatic flux (F-nu) must be greater than 0") + ST_REFFL(st) = ST_REFF(st) * C / (ST_REFW(st) * ST_REFW(st)) + case UMAG,BMAG,VMAG,RMAG,IMAG,JMAG,HMAG,KSMAG,KMAG,LMAG,LPMAG,MMAG: + switch (ST_FUNITS(st)) { + case UMAG: + ST_REFW(st) = 3650. + case BMAG: + ST_REFW(st) = 4400. + case VMAG: + ST_REFW(st) = 5500. + case RMAG: + ST_REFW(st) = 7000. + case IMAG: + ST_REFW(st) = 9000. + case JMAG: + ST_REFW(st) = 12150. + case HMAG: + ST_REFW(st) = 16540. + case KSMAG: + ST_REFW(st) = 21570. + case KMAG: + ST_REFW(st) = 21790. + case LMAG: + ST_REFW(st) = 35470. + case LPMAG: + ST_REFW(st) = 37610. + case MMAG: + ST_REFW(st) = 47690. + } + + ST_REFFL(st) = ST_REFF(st) + + tabinterp1 (tab, "abjohnson", ST_REFW(st)) + ST_REFFL(st) = 10. ** (-0.4 * + (ST_REFFL(st) + 5*log10(ST_REFW(st)) + 2.40)) + } + } + + # Check saturation. + sat = stgetr (st, "saturation", "detector", MAX_REAL) + dnmax = stgetr (st, "dnmax", "detector", MAX_REAL) + + wave = ST_CW(st) + if (!IS_INDEF(time)) { + if (time <= 0.) { + call eprintf ("Total Exposure Time must be greater than 0.\n") + return + } + + if (ST_MAXEXP(st) > 0.) { + nexp = max (1, int (time / ST_MAXEXP(st) + 0.99)) + time = time / nexp + } else + nexp = 1 + + } else { + if (sngoal <= 0.) { + call printf ("Desired S/N must be greater than 0.\n") + return + } + + nexp = 1 + minexp = ST_MINEXP(st) + maxexp = ST_MAXEXP(st) + time = maxexp + snr = 0. + + # Iterate to try and achieve the requested SNR. + do niter = 1, MAXITER { + + if (snr > 0.) { + x = time + i = nexp + + # After the first pass we use the last calculated SNR to + # estimate a new time per exposure and number of exposures. + time = time*sngoal*sngoal/(nexp*snr*snr) + + # Divide into multiple exposures if the time per exposure + # exceeds a maximum. Note the maximum may be reset by + # saturation criteria. + if (time > maxexp) { + nexp = nexp * max (1, int (time / maxexp + 0.99)) + time = x*sngoal*sngoal/(nexp*snr*snr) + } + + # Apply a minimum time per exposure if possible. + if (time < minexp && nexp > 1) { + nexp = max (1, nexp * time / minexp) + time = x*sngoal*sngoal/(nexp*snr*snr) + } + + # New time per exposure to try. + time = max (minexp, min (maxexp, time)) + if (fp_equalr (time, x) && nexp == i) + break + } + + # Compute SNR. + call st_snr (st, NULL, wave, nexp, time, nobj, nsky, + snr, thruput) + + # Reset maximum time per exposure to avoid saturation. + if (nobj[1]+nsky[1] > sat && time > minexp && snr < sngoal) { + time = time * nexp + snr = snr * snr * nexp + nexp = nexp * (1 + (nobj[1] + nsky[1]) / sat) + time = time / nexp + snr = sqrt (snr / nexp) + maxexp = max (minexp, time) + next + } + if ((nobj[1]+nsky[1])/ST_GAIN(st) > dnmax && time > minexp && + snr < sngoal) { + time = time * nexp + snr = snr * snr * nexp + nexp = nexp * (1 + (nobj[1] + nsky[1]) / + (ST_GAIN(st) * dnmax)) + time = time / nexp + snr = sqrt (snr / nexp) + maxexp = max (minexp, time) + next + } + + if (abs ((sngoal-sqrt(real(nexp))*snr)/sngoal) < 0.001) + break + } + } + ST_NEXP(st) = nexp + ST_TIME(st) = time + + # Output. + npix = stgetr (st, "ndisp", "detector", 2048.) + nw = max (1, min (nw, npix)) + x1 = npix * ST_PIXSIZE(st) + + call salloc (waves, nw, TY_REAL) + call salloc (counts, nw, TY_REAL) + call salloc (snrs, nw, TY_REAL) + + if (nw > 1) { + dx = x1 / (nw - 1) + x1 = -x1 / 2 + do i = 0, nw-1 { + x = x1 + dx * i + Memr[waves+i] = st_x2w (st, 1, x) + } + } else + Memr[waves] = wave + + # Output result summary. + call st_results (st, STDOUT) + call st_check (st, STDOUT, Memr[waves], nw) + call st_snr (st, STDOUT, wave, nexp, time, nobj, nsky, snr, thruput) + + while (fntgfnb (outlist, Memc[str], SZ_LINE) != EOF) + call st_output (st, gp, fd, interactive, Memc[str], Memr[waves], nw) + + # Finish up. + call un_close (ST_DUN(st)) + call un_close (ST_DUNANG(st)) + call clpcls (ST_SEARCH(st)) + call tabclose (ST_TAB(st)) + call gr_close (ST_GR(st,1)) + call gr_close (ST_GR(st,2)) + if (gp != NULL) + call gclose (gp) + if (fd != NULL) + call close (fd) + call fntclsb (outlist) + call sfree (sp) +end + + +# ST_RESULTS -- Print result summary. + +procedure st_results (st, fd) + +pointer st #I SPECTIME structure +int fd #I Output file descriptor + +char eff[SZ_FNAME] +real x, y +int npix, order, tabgeti(), stgeti() +pointer tab +real gr_getr() +bool tabexists() + +begin + tab = ST_TAB(st) + + call fprintf (fd, "\n") + if (tabexists (tab, "spectrum")) + call st_description (st, fd, "Object spectrum: ", "spectitle", + "spectrum") + else { + call fprintf (fd, "Object spectrum: ") + switch (ST_SPEC(st)) { + case SPEC_BB: + call fprintf (fd, "Blackbody spectrum of temperature %g K\n") + call pargr (ST_PARAM(st)) + case SPEC_FL: + call fprintf (fd, "F(lambda) power law of index %g\n") + call pargr (ST_PARAM(st)) + case SPEC_FN: + call fprintf (fd, "F(nu) power law of index %g\n") + call pargr (ST_PARAM(st)) + } + if (ST_AV(st) > 0.) { + call fprintf (fd, + "Reddening: E(B-V) of %g with A(V)/E(B-V) of %g\n") + call pargr (ST_AV(st) / ST_RV(st)) + call pargr (ST_RV(st)) + } + call un_ctranr (ST_DUNANG(st), ST_DUN(st), ST_REFW(st), x, 1) + call fprintf (fd, "Reference wavelength: %.4g %s\n") + call pargr (x) + call pargstr (ST_DUNITS(st)) + call fprintf (fd, "Reference flux: ") + switch (ST_FUNITS(st)) { + case AB: + call fprintf (fd, "AB = %.3g (%.3g ergs/s/cm^2/A)\n") + call pargr (ST_REFF(st)) + call pargr (ST_REFFL(st)) + case FLAMBDA: + call fprintf (fd, "%.3g ergs/s/cm^2/A\n") + call pargr (ST_REFF(st)) + case FNU: + call fprintf (fd, "%.3g ergs/s/cm^2/Hz\n") + call pargr (ST_REFF(st)) + case UMAG, BMAG, VMAG, RMAG, IMAG, JMAG: + switch (ST_FUNITS(st)) { + case UMAG: + call fprintf (fd, "U = %.3g ") + call pargr (ST_REFF(st)) + case BMAG: + call fprintf (fd, "B = %.3g ") + call pargr (ST_REFF(st)) + case VMAG: + call fprintf (fd, "V = %.3g ") + call pargr (ST_REFF(st)) + case RMAG: + call fprintf (fd, "R = %.3g ") + call pargr (ST_REFF(st)) + case IMAG: + call fprintf (fd, "I = %.3g ") + call pargr (ST_REFF(st)) + case JMAG: + call fprintf (fd, "J = %.3g ") + call pargr (ST_REFF(st)) + } + call fprintf (fd, "(%.3g ergs/s/cm^2/A)\n") + call pargr (ST_REFFL(st)) + } + } + if (tabexists (tab, "sky")) { + call st_description (st, fd, "Sky spectrum: ", "skytitle", "sky") + if (tabgeti (tab, "sky", "", "table.ndim") == 2) { + call fprintf (fd, "\tMoon phase: %d\n") + call pargr (ST_PHASE(st)) + } + } + if (ST_AIRMASS(st) > 0) { + call st_description (st, fd, "Extinction: ", "exttitle", + "extinction") + call fprintf (fd, "\tAirmass: %.3g\n") + call pargr (ST_AIRMASS(st)) + } + call fprintf (fd, "Seeing: %.2g\" (FWHM)\n") + call pargr (ST_SEEING(st)) + if (tabexists (tab, "emissivity") && ST_THERMAL(st) > 0.) { + call fprintf (fd, "Thermal Background:\n") + call st_description (st, fd, "\tEmissivity: ", + "emistitle", "emissivity") + call fprintf (fd, "\tTemperature: %.1g K\n") + call pargr (ST_THERMAL(st)) + } + + call fprintf (fd, "\n") + call st_description (st, fd, "Telescope: ", "teltitle", "telescope") + call fprintf (fd, "\tArea: %.1f m^2, Scale: %.4g arcsec/mm\n") + call pargr (ST_AREA(st) / 10000.) + call pargr (ST_TELSCALE(st)) + if (tabexists (tab, "adc")) + call st_description (st, fd, "ADC: ", "adctitle", "adc") + if (tabexists (tab, "spectrograph")) + call st_description (st, fd, "Spectrograph: ", "title", + "spectrograph") + call st_description (st, fd, "Collimator: ", "coltitle", "collimator") + call fprintf (fd, "\tFocal length = %.4g m\n") + call pargr (ST_COLFL(st)) + if (tabexists (tab, "aperture")) { + call st_description (st, fd, "Apertures: ", "aptitle", "aperture") + switch (ST_APTYPE(st)) { + case CIRCULAR: + call fprintf (fd, "\tSize: %.2f\", %.3g mm, %.1f pixels\n") + call pargr (ST_APSIZE(st,1)) + call pargr (ST_APSIZE(st,1) / ST_TELSCALE(st)) + call pargr (ST_APSIZE(st,1) / ST_SCALE(st,1)) + case RECTANGULAR: + call fprintf (fd, + "\tSize: %.2f\" x %.2f\", %.3g x %.3g mm, %.1f x %.1f pixels\n") + call pargr (ST_APSIZE(st,1)) + call pargr (ST_APSIZE(st,2)) + call pargr (ST_APSIZE(st,1) / ST_TELSCALE(st)) + call pargr (ST_APSIZE(st,2) / ST_TELSCALE(st)) + call pargr (ST_APSIZE(st,1) / ST_SCALE(st,1)) + call pargr (ST_APSIZE(st,2) / ST_SCALE(st,2)) + } + } + if (tabexists (tab, "fiber")) + call st_description (st, fd, "Fibers: ", "fibtitle", "fiber") + if (tabexists (tab, "filter")) + call st_description (st, fd, "Filter: ", "ftitle", "filter") + if (tabexists (tab, "filter2")) + call st_description (st, fd, "Filter: ", "f2title", "filter2") + if (ST_DISPTYPE(st,1) != 0) { + call st_description (st, fd, "Disperser: ", "disptitle", + "disperser") + order = nint (gr_getr (ST_GR(st,1), "order")) + call fprintf (fd, "\tCentral order = %d\n") + call pargi (order) + x = gr_getr (ST_GR(st,1), "wavelength") + call un_ctranr (ST_DUNANG(st), ST_DUN(st), x, x, 1) + call fprintf (fd, "\tCentral wavelength = %.6g %s\n") + call pargr (x) + call pargstr (ST_DUNITS(st)) + x = abs(gr_getr(ST_GR(st,1), "dispersion")) + call un_ctranr (ST_DUNANG(st), ST_DUN(st), x, x, 1) + call un_ctranr (ST_DUNANG(st), ST_DUN(st), ST_DISP(st,1), y, 1) + call fprintf (fd, + "\tCentral dispersion = %.3g %s/mm, %.3g %s/pixel\n") + call pargr (x) + call pargstr (ST_DUNITS(st)) + call pargr (y) + call pargstr (ST_DUNITS(st)) + if (ST_DISPTYPE(st,1) == GRATING && + int(gr_getr(ST_GR(st,1),"full"))==YES) { + call fprintf (fd, "\tRuling = %d lines/mm\n") + call pargr (gr_getr (ST_GR(st,1), "g")) + call fprintf (fd, "\tBlaze = %.1f deg\n") + call pargr (gr_getr (ST_GR(st,1), "blaze")) + x = gr_getr (ST_GR(st,1), "tilt") + if (abs(x) > 0.1) { + call fprintf (fd, "\tGrating tilt = %.1f degrees\n") + call pargr (gr_getr (ST_GR(st,1), "tilt")) + x = gr_getr (ST_GR(st,1), "mag") + if (abs(x) < 0.99) { + call fprintf (fd, "\tGrating magnification = %.2f\n") + call pargr (x) + } + } + call sprintf (eff, SZ_FNAME, "eff%d") + call pargi (order) + if (!tabexists (tab, eff)) { + if (order == 1 && tabexists (tab, "disperser")) { + if (tabgeti (tab, "disperser", "", "table.ndim") != 0) + call strcpy ("disperser", eff, SZ_FNAME) + } + } + if (tabexists (tab, eff)) + call fprintf (fd, "\tUsing tabulated efficiencies\n") + else + call fprintf (fd, "\tUsing predicted efficiencies\n") + } + } + if (ST_DISPTYPE(st,2) != 0) { + call st_description (st, fd, "Crossdisperser: ", "xdisptitle", + "xdisperser") + order = nint (gr_getr (ST_GR(st,2), "order")) + call fprintf (fd, "\tCentral order = %d\n") + call pargi (order) + x = gr_getr (ST_GR(st,2), "wavelength") + call un_ctranr (ST_DUNANG(st), ST_DUN(st), x, x, 1) + call fprintf (fd, "\tCentral wavelength = %.6g %s\n") + call pargr (x) + call pargstr (ST_DUNITS(st)) + x = abs(gr_getr(ST_GR(st,1), "dispersion")) + call un_ctranr (ST_DUNANG(st), ST_DUN(st), x, x, 1) + call fprintf (fd, "\tCentral dispersion = %.3g %s/mm\n") + call pargr (x) + call pargstr (ST_DUNITS(st)) + if (ST_DISPTYPE(st,2) == GRATING && + int(gr_getr(ST_GR(st,2),"full"))==YES) { + call fprintf (fd, "\tRuling = %d lines/mm\n") + call pargr (gr_getr (ST_GR(st,2), "g")) + call fprintf (fd, "\tBlaze = %d deg\n") + call pargr (gr_getr (ST_GR(st,2), "blaze")) + x = gr_getr (ST_GR(st,2), "tilt") + if (abs(x) > 0.1) { + call fprintf (fd, "\tGrating tilt = %.1f degrees\n") + call pargr (gr_getr (ST_GR(st,2), "tilt")) + x = gr_getr (ST_GR(st,2), "mag") + if (abs(x) < 0.99) { + call fprintf (fd, "\tGrating magnification = %.2f\n") + call pargr (x) + } + } + call sprintf (eff, 10, "xeff%d") + call pargi (order) + if (!tabexists (tab, eff)) { + if (order == 1 && tabexists (tab, "xdisperser")) { + if (tabgeti (tab, "xdisperser", "", "table.ndim") != 0) + call strcpy ("xdisperser", eff, SZ_FNAME) + } + } + if (tabexists (tab, eff)) + call fprintf (fd, "\tUsing tabulated efficiencies\n") + else + call fprintf (fd, "\tUsing predicted efficiencies\n") + } + } + if (tabexists (tab, "corrector")) + call st_description (st, fd, "Corrector: ", "cortitle", "corrector") + call st_description (st, fd, "Camera: ", "camtitle", "camera") + call fprintf (fd, "\tFocal length = %.4g m, Resolution = %.1g pixels\n") + call pargr (ST_CAMFL(st)) + call pargr (ST_RES(st,1)) + call st_description (st, fd, "Detector: ", "dettitle", "detector") + call fprintf (fd, "\tPixel size: %d microns, %.2f\"\n") + call pargr (1000 * ST_PIXSIZE(st)) + call pargr (ST_SCALE(st,1)) + if (ST_BIN(st,1) != 1 || ST_BIN(st,2) != 1) { + call fprintf (fd, "\tBinning: %dx%d (XxY)\n") + call pargi (ST_BIN(st,1)) + call pargi (ST_BIN(st,2)) + } + npix = stgeti (st, "ndisp", "detector", 2048) / ST_BIN(st,1) + call fprintf (fd, "\tNumber of pixels = %d\n") + call pargi (npix) + call fprintf (fd, + "\tRead noise = %.1f e-, Gain = %.1f e-/DN, Dark = %.3g e-/s\n") + call pargr (ST_RDNOISE(st)) + call pargr (ST_GAIN(st)) + call pargr (ST_DARK(st)) + + call fprintf (fd, "\n") + call fprintf (fd, + "Source pixels: %d pixels") + call pargi (ST_NOBJPIX(st)) + if (ST_APLIM(st) == YES) + call fprintf (fd, " (aperture & camera resolution limited)\n") + else + call fprintf (fd, " (3xFWHM seeing disk & camera resolution)\n") + switch (ST_SKYSUB(st)) { + case SKY_NONE: + call fprintf (fd, + "Background pixels: no background subtraction done\n") + case SKY_LONGSLIT: + call fprintf (fd, "Background pixels: %3d pixels\n") + call pargi (ST_NSKYPIX(st)) + case SKY_MULTIAP: + call fprintf (fd, + "Background pixels: %d apertures each with %d pixels\n") + call pargi (ST_NSKYAPS(st)) + call pargi (ST_NSKYPIX(st) / ST_NSKYAPS(st)) + case SKY_SHUFFLE: + call fprintf (fd, + "Background pixels: shuffle with %d pixels (same as source)\n") + call pargi (ST_NSKYPIX(st)) + } + call fprintf (fd, "\n") +end + + +# ST_DESCRIPTION -- Print description of table. + +procedure st_description (st, fd, label, title, table) + +pointer st #I SPECTIME structure +int fd #I Output file descriptor +char label[ARB] #I Label +char title[ARB] #I Title parameter name +char table[ARB] #I Table name + +pointer sp, str + +begin + call smark (sp) + call salloc (str, SZ_LINE, TY_CHAR) + + # Print label and title. + call st_gtitle (st, title, table, Memc[str], SZ_LINE) + call fprintf (fd, "%s%s\n") + call pargstr (label) + call pargstr (Memc[str]) + + # Print description if available. + ifnoerr (call tabgstr (ST_TAB(st), table, "", "description", Memc[str], + SZ_LINE)) { + call fprintf (fd, "%s\n") + call pargstr (Memc[str]) + } + + call sfree (sp) +end + + +# ST_GTITLE -- Get title. + +procedure st_gtitle (st, param, table, title, maxchar) + +pointer st #I SPECTIME structure +char param[ARB] #I Title parameter name +char table[ARB] #I Table name +char title[ARB] #O Title +int maxchar #I Maximum string length + +char dummy[1] +int nowhite() + +begin + call clgstr (param, title, maxchar) + if (nowhite (title, dummy, 1) > 0) + return + + iferr (call tabgstr (ST_TAB(st), table, "spectrograph", param, title, + maxchar)) { + iferr (call tabgstr (ST_TAB(st), table, "", "title", + title, maxchar)) { + iferr (call tabgstr (ST_TAB(st), table, "", + "table.filename", title, maxchar)) + title[1] = EOS + } + } +end + + +# ST_SNR -- Source, sky, SNR, and thruput including all orders. + +procedure st_snr (st, fd, wave, nexp, time, nobj, nsky, snr, thruput) + +pointer st #I SPECTIME structure +int fd #I Output descriptor +real wave #I Wavelengths +int nexp #I Number of exposures +real time #I Exposure time +real nobj[4] #O Number of object photons (1=total) +real nsky[4] #O Number of sky photons (1=total) +real snr #O S/N per pixel for total +real thruput #O System thruput at primary wavelength + +int i, j, order +real w, f, st_spectrum() +errchk st_spectrum, st_snr1 + +begin + # Initialize. + do i = 1, 4 { + nobj[i] = 0 + nsky[i] = 0 + } + + # If not x-dispersed and disperser is a grating do overlapping orders. + if (ST_DISPTYPE(st,2) == 0 && ST_FILTBLK(st) == NO && + (ST_DISPTYPE(st,1) == GRATING || ST_DISPTYPE(st,1) == GRISM)) { + order = ST_ORDER(st,1) + do j = 2, 4 { + i = order + j - 3 + if (i < 1) + next + w = wave * order / i + f = st_spectrum (st, w) + ST_ORDER(st,1) = i + call st_snr1 (st, NULL, w, f, nexp, time, nobj[j], nsky[j], + snr, thruput) + if (i != order) { + nobj[1] = nobj[1] + nobj[j] + nsky[1] = nsky[1] + nsky[j] + } + } + ST_ORDER(st,1) = order + + w = wave + f = st_spectrum (st, w) + call st_snr1 (st, fd, w, f, nexp, time, nobj, nsky, snr, thruput) + } else { + w = wave + f = st_spectrum (st, w) + call st_snr1 (st, fd, w, f, nexp, time, nobj, nsky, snr, thruput) + nobj[3] = nobj[1] + nsky[3] = nsky[1] + } +end + + +# ST_SNR1 -- Compute and print photons and S/N for given exposure time. + +procedure st_snr1 (st, fd, wave, flux, nexp, time, nobj, nbkg, snr, thruput) + +pointer st #I SPECTIME structure +int fd #I Output descriptor +real wave #I Wavelength +real flux #I Flux +int nexp #I Number of exposures +real time #I Exposure time +real nobj #U Number of object photons +real nbkg #U Number of bkg photons +real snr #O S/N per pixel +real thruput #O System thruput + +int i, ncols +real tobs, n, ndark +real w, w1, nmag, sky, thermal, bkg, dobj, dbkg, ddark, dreadout, tnoise +real ext, tel, adc, ap, fib, inst, fltr1, fltr2, col, eff1, eff2, disp +real cor, cam, vig, dqe, cum, sqnexp + +real tabinterp1(), tabinterp2(), st_dispeff(), st_w2dw(), st_w2x() +errchk tabinterp1, tabinterp2, st_dispeff + +begin + # Check for reasonable wavlength and source flux. + if (wave < 0. || flux < 0.) { + nobj = 0. + nbkg = 0. + snr = 0. + thruput = 0. + return + } + + # Set observation time. + switch (ST_SKYSUB(st)) { + case SKY_SHUFFLE: + tobs = time / 2 + default: + tobs = time + } + + # Compute pixel counts over subsampled pixels. + disp = st_w2dw (st, 1, wave) * ST_PIXSIZE(st) * ST_BIN(st,1) / + ST_SUBPIXELS(st) + w1 = wave - disp * (ST_SUBPIXELS(st) + 1) / 2. + do i = 1, ST_SUBPIXELS(st) { + w = w1 + disp * i + + # Atmospheric transmission. + iferr { + ext = tabinterp1 (ST_TAB(st), "extinction", w) + ext = 10 ** (-0.4 * ext * ST_AIRMASS(st)) + } then + ext = INDEF + + # Telescope transmission. + iferr (tel = tabinterp1 (ST_TAB(st), "telescope", w)) + tel = 1 + + # ADC transmission. + iferr (adc = tabinterp1 (ST_TAB(st), "adc", w)) + adc = INDEF + + # Aperture thruput. + iferr { + switch (ST_APTYPE(st)) { + case CIRCULAR: + ap = tabinterp1 (ST_TAB(st), "aperture", + ST_APSIZE(st,1) / ST_SEEING(st)) + case RECTANGULAR: + ap = tabinterp2 (ST_TAB(st), "aperture", + ST_APSIZE(st,1) / ST_SEEING(st), + ST_APSIZE(st,2) / ST_SEEING(st)) + } + } then + ap = 1 + + # Fiber transmission. + iferr (fib = tabinterp1 (ST_TAB(st), "fiber", w)) + fib = INDEF + + # Spectrograph transmission. + iferr (inst = tabinterp1 (ST_TAB(st), "spectrograph", w)) + inst = INDEF + + # Filter transmission. + iferr (fltr1 = tabinterp1 (ST_TAB(st), "filter", w)) + fltr1 = INDEF + iferr (fltr2 = tabinterp1 (ST_TAB(st), "filter2", w)) + fltr2 = INDEF + + # Collimator transmission. + iferr (col = tabinterp1 (ST_TAB(st), "collimator", w)) + col = 1 + + # Disperser efficiency. + eff1 = st_dispeff (st, "disperser", w, ST_ORDER(st,1)) + eff2 = st_dispeff (st, "xdisperser", w, ST_ORDER(st,2)) + + # Corrector transmission. + iferr (cor = tabinterp1 (ST_TAB(st), "corrector", w)) + cor = INDEF + + # Camera transmission. + iferr (cam = tabinterp1 (ST_TAB(st), "camera", w)) + cam = 1 + + # Vignetting. + iferr (vig = tabinterp1 (ST_TAB(st), "vignetting", + st_w2x (st, 1, w))) + vig = INDEF + + # Detector DQE. + iferr (dqe = tabinterp1 (ST_TAB(st), "detector", w)) + dqe = 1 + + # Cumulative transmission. + thruput = 1 + if (!IS_INDEF(tel)) { + tel = max (0., tel) + thruput = thruput * tel + } + if (!IS_INDEF(adc)) { + adc = max (0., adc) + thruput = thruput * adc + } + if (!IS_INDEF(ap)) { + ap = max (0., ap) + thruput = thruput * ap + } + if (!IS_INDEF(fib)) { + fib = max (0., fib) + thruput = thruput * fib + } + if (!IS_INDEF(inst)) { + inst = max (0., inst) + thruput = thruput * inst + } + if (!IS_INDEF(fltr1)) { + fltr1 = max (0., fltr1) + thruput = thruput * fltr1 + } + if (!IS_INDEF(fltr2)) { + fltr2 = max (0., fltr2) + thruput = thruput * fltr2 + } + if (!IS_INDEF(eff1)) { + eff1 = max (0., eff1) + thruput = thruput * eff1 + } + if (!IS_INDEF(eff2)) { + eff2 = max (0., eff2) + thruput = thruput * eff2 + } + if (!IS_INDEF(cor)) { + cor = max (0., cor) + thruput = thruput * cor + } + if (!IS_INDEF(col)) { + col = max (0., col) + thruput = thruput * col + } + if (!IS_INDEF(cam)) { + cam = max (0., cam) + thruput = thruput * cam + } + if (!IS_INDEF(vig)) { + vig = max (0., vig) + thruput = thruput * vig + } + if (!IS_INDEF(dqe)) { + dqe = max (0., dqe) + thruput = thruput * dqe + } + + # Source photons detected. + nmag = flux / (C * H / w) + n = nmag * ST_AREA(st) * thruput * tobs * disp + if (!IS_INDEF(ext)) + n = n * ext + n = max (0., n) + if (n < 100000.) + n = int (n) + nobj = nobj + n + + # Sky photon flux. + iferr (sky = tabinterp2 (ST_TAB(st), "sky", w, ST_PHASE(st))) + iferr (sky = tabinterp1 (ST_TAB(st), "sky", w)) + sky = 0 + sky = sky / (C * H / w) + + # Thermal photon flux. + thermal = 0. + if (!IS_INDEF(ST_THERMAL(st))) { + iferr { + thermal = tabinterp1 (ST_TAB(st), "emissivity", w) + # 1.41e24 = 2 * c * (arcsec/rad)^2 * (A/cm) * (A/cm)^-4 + thermal = thermal * 1.41e24 / (w ** 4) / + (exp (min (30., 1.43877e8 / (w * ST_THERMAL(st)))) - 1) + } then + thermal = 0. + } + + # Total background. + bkg = sky + thermal + + switch (ST_APTYPE(st)) { + case CIRCULAR: + bkg = bkg * PI * (ST_APSIZE(st,1) / 2) ** 2 + case RECTANGULAR: + bkg = bkg * ST_APSIZE(st,1) * ST_SCALE(st,1) * ST_NOBJPIX(st) + } + n = bkg * ST_AREA(st) * thruput / ap * tobs * disp + n = max (0., n) + if (n < 100000.) + n = int (n) + nbkg = nbkg + n + } + + # Dark counts. + ndark = ST_NOBJPIX(st) * ST_DARK(st) * time + ndark = max (0., ndark) + if (ndark <100000.) + ndark = int (ndark) + + # Noise. + dobj = sqrt (nobj) + dbkg = sqrt (nbkg) + ddark = sqrt (ndark) + dreadout = sqrt (ST_NOBJPIX(st) * ST_RDNOISE(st)**2) + tnoise = nobj + nbkg + ndark + dreadout**2 + + # Background subtraction statistics. + switch (ST_SKYSUB(st)) { + case SKY_NONE: + nobj = nobj + nbkg + nbkg = 0. + default: + if (ST_NSKYPIX(st) > 0) + tnoise = tnoise + ((nbkg + ndark) / ST_NOBJPIX(st) + + ST_RDNOISE(st)**2) / ST_NSKYPIX(st) + } + + # Final S/N. + snr = nobj + tnoise = sqrt (tnoise) + if (tnoise > 0.) + snr = snr / tnoise + + if (fd == NULL) + return + + # Print results. + sqnexp = sqrt (real(nexp)) + ncols = nint (ST_DISP(st,2) / ST_DISP(st,1)) + + call un_ctranr (ST_DUNANG(st), ST_DUN(st), wave, w, 1) + if (nexp > 1) { + call fprintf (fd, + "---- Results for %d exposures of %.2fs at %.4g %s ----\n") + call pargi (nexp) + call pargr (time) + call pargr (w) + call pargstr (ST_DUNITS(st)) + } else { + call fprintf (fd, + "---- Results for %.2fs exposure at %.4g %s ----\n") + call pargr (time) + call pargr (w) + call pargstr (ST_DUNITS(st)) + } + + call fprintf (fd, "\nSource flux: %.3g photons/s/cm^2/A (AB=%.3g)\n") + call pargr (nmag) + call pargr (-2.5*log10(flux) - 5*log10(wave) - 2.40) + call fprintf (fd, "Background flux: %.3g photons/s/cm^2/A (over source pixels)\n") + call pargr (bkg) + + call fprintf (fd, "\nTransmision/Efficiencies:%40t%10s %10s\n") + call pargstr ("individual") + call pargstr ("cumulative") + cum = 1 + if (!IS_INDEF(ext) && ext < 1) { + cum = cum * ext + call fprintf (fd, + " Atmosphere (%.2g mag/airmass)%40t%9.1f%% %9.1f%%\n") + call pargr (-2.5 * log10 (ext) / ST_AIRMASS(st)) + call pargr (100 * ext) + call pargr (100 * cum) + } + if (!IS_INDEF(tel) && tel < 1) { + cum = cum * tel + call fprintf (fd, " Telescope%40t%9.1f%% %9.1f%%\n") + call pargr (100 * tel) + call pargr (100 * cum) + } + if (!IS_INDEF(adc) && adc < 1) { + cum = cum * adc + call fprintf (fd, " ADC%40t%9.1f%% %9.1f%%\n") + call pargr (100 * adc) + call pargr (100 * cum) + } + if (!IS_INDEF(ap) && ap < 1) { + cum = cum * ap + call fprintf (fd, + " Aperture (seeing=%.2g\")%40t%9.1f%% %9.1f%%\n") + call pargr (ST_SEEING(st)) + call pargr (100 * ap) + call pargr (100 * cum) + } + if (!IS_INDEF(fib) && fib < 1) { + cum = cum * fib + call fprintf (fd, " Fiber%40t%9.1f%% %9.1f%%\n") + call pargr (100 * fib) + call pargr (100 * cum) + } + if (!IS_INDEF(fltr1) && fltr1 < 1) { + cum = cum * fltr1 + call fprintf (fd, " Filter%40t%9.1f%% %9.1f%%\n") + call pargr (100 * fltr1) + call pargr (100 * cum) + } + if (!IS_INDEF(fltr2) && fltr2 < 1) { + cum = cum * fltr2 + call fprintf (fd, " Filter%40t%9.1f%% %9.1f%%\n") + call pargr (100 * fltr2) + call pargr (100 * cum) + } + if (!IS_INDEF(inst) && inst < 1) { + cum = cum * inst + call fprintf (fd, " Spectrograph%40t%9.1f%% %9.1f%%\n") + call pargr (100 * inst) + call pargr (100 * cum) + } + if (!IS_INDEF(col) && col < 1) { + cum = cum * col + call fprintf (fd, " Collimator%40t%9.1f%% %9.1f%%\n") + call pargr (100 * col) + call pargr (100 * cum) + } + if (!IS_INDEF(eff1) && eff1 < 1) { + cum = cum * eff1 + call fprintf (fd, " Disperser%40t%9.1f%% %9.1f%%\n") + call pargr (100 * eff1) + call pargr (100 * cum) + } + if (!IS_INDEF(eff2) && eff2 < 1) { + cum = cum * eff2 + call fprintf (fd, " Cross disperser%40t%9.1f%% %9.1f%%\n") + call pargr (100 * eff2) + call pargr (100 * cum) + } + if (!IS_INDEF(cor) && cor < 1) { + cum = cum * cor + call fprintf (fd, " Corrector%40t%9.1f%% %9.1f%%\n") + call pargr (100 * cor) + call pargr (100 * cum) + } + if (!IS_INDEF(cam) && cam < 1) { + cum = cum * cam + call fprintf (fd, " Camera%40t%9.1f%% %9.1f%%\n") + call pargr (100 * cam) + call pargr (100 * cum) + } + if (!IS_INDEF(vig) && vig < 0.999) { + cum = cum * vig + call fprintf (fd, " Vignetting%40t%9.1f%% %9.1f%%\n") + call pargr (100 * vig) + call pargr (100 * vig) + } + if (!IS_INDEF(dqe) && dqe < 1) { + cum = cum * dqe + call fprintf (fd, " Detector DQE%40t%9.1f%% %9.1f%%\n") + call pargr (100 * dqe) + call pargr (100 * cum) + } + + call fprintf (fd, "\nStatistics per exposure per pixel:%40t%10s %10s\n") + call pargstr ("e-") + call pargstr ("sigma") + call fprintf (fd, " Source%40t%10d %10.1f\n") + call pargr (nobj) + call pargr (dobj) + if (nbkg > 0.) { + call fprintf (fd, " Background%40t%10d %10.1f\n") + call pargr (nbkg) + call pargr (dbkg) + } + call fprintf (fd, " Dark%40t%10d %10.1f\n") + call pargr (ndark) + call pargr (ddark) + call fprintf (fd, " Readout%40t%10w %10.1f\n") + call pargr (dreadout) + call fprintf (fd, " Net%40t%10d %10.1f\n") + call pargr (nobj + nbkg + ndark) + call pargr (tnoise) + + call fprintf (fd, "\nSignal-to-Noise Statistics:\n") + call fprintf (fd, " %3d%7tper exposure per pixel\n") + call pargr (snr) + call pargr (ST_DISP(st,1)) + call un_ctranr (ST_DUNANG(st), ST_DUN(st), ST_DISP(st,2), w, 1) + call fprintf (fd, + " %3d%7tper exposure per %.3g %s (%d pixel) resolution element\n") + call pargr (snr * sqrt (real (ncols))) + call pargr (w) + call pargstr (ST_DUNITS(st)) + call pargi (ncols) + if (nexp > 1.) { + call fprintf (fd, + " %3d%10tper %d exposures per pixel\n") + call pargr (snr * sqnexp) + call pargi (nexp) + call pargr (ST_DISP(st,1)) + call un_ctranr (ST_DUNANG(st), ST_DUN(st), ST_DISP(st,2), w, 1) + call fprintf (fd, + " %3d%10tper %d exposures per %.3g %s (%d pixel) resolution element\n") + call pargr (snr * sqrt (real (ncols)) * sqnexp) + call pargi (nexp) + call pargr (w) + call pargstr (ST_DUNITS(st)) + call pargi (ncols) + } + + if (nexp > 1) { + call fprintf (fd, + "\nExposure time: %d exposures of %.2fs") + call pargi (nexp) + call pargr (time) + if (nexp * time > 60.) { + call fprintf (fd, " (%.1h)") + call pargr (nexp * time / 3600.) + } else { + call fprintf (fd, " (%.1f)") + call pargr (nexp * time) + } + } else { + call fprintf (fd, "\nExposure time: %.2fs") + call pargr (time) + if (time > 60.) { + call fprintf (fd, " (%.1h)") + call pargr (time / 3600.) + } + } + if (ST_SKYSUB(st) == SKY_SHUFFLE) + call fprintf (fd, " (shuffled)\n") + else + call fprintf (fd, "\n") + call fprintf (fd, "\n") +end + + +# ST_CHECK -- Check for possible errors such as lack of proper order blocking. + +procedure st_check (st, fd, waves, npix) + +pointer st #I SPECTIME structure +int fd #I Output file descriptor +real waves[ARB] #I Wavelengths +int npix #I Number of pixels + +int i, n, step +real nobj[4], nsky[4] +real w1, w2, w, dw, snr, thruput, sat, dnmax, maxcount, maxfrac +pointer tab +real stgetr(), tabgetr(), gr_getr() + +begin + tab = ST_TAB(st) + + # Check for extrapolations. This has to be done before the order + # overlap because that may reference wavelength which are extrapolated. + + ifnoerr (w1 = tabgetr (tab, "spectrum", "", "table.xmin")) { + w2 = tabgetr (tab, "spectrum", "", "table.xmax") + if (w1 > waves[1] || w2 < waves[npix]) + call fprintf (fd, + "WARNING: Spectrum table extrapolated in wavelength\n") + } + ifnoerr (w1 = tabgetr (tab, "sky", "", "table.xmin")) { + w2 = tabgetr (tab, "sky", "", "table.xmax") + if (w1 > waves[1] || w2 < waves[npix]) + call fprintf (fd, + "WARNING: Sky table extrapolated in wavelength\n") + ifnoerr (w1 = tabgetr (tab, "sky", "", "table.ymin")) { + w2 = tabgetr (tab, "sky", "", "table.ymax") + if (w1 > ST_PHASE(st) || w2 < ST_PHASE(st)) + call fprintf (fd, + "WARNING: Sky table extrapolated in lunar phase\n") + } + } + ifnoerr (w1 = tabgetr (tab, "sensfunc", "", "table.xmin")) { + w2 = tabgetr (tab, "sensfunc", "", "table.xmax") + if (w1 > waves[1] || w2 < waves[npix]) + call fprintf (fd, + "WARNING: Sensitivity table extrapolated in wavelength\n") + } + ifnoerr (w1 = tabgetr (tab, "extinction", "", "table.xmin")) { + w2 = tabgetr (tab, "extinction", "", "table.xmax") + if (w1 > waves[1] || w2 < waves[npix]) + call fprintf (fd, + "WARNING: Extinction table extrapolated in wavelength\n") + } + ifnoerr (w1 = tabgetr (tab, "telescope", "", "table.xmin")) { + w2 = tabgetr (tab, "telescope", "", "table.xmax") + if (w1 > waves[1] || w2 < waves[npix]) + call fprintf (fd, + "WARNING: Telescope table extrapolated in wavelength\n") + } + ifnoerr (w1 = tabgetr (tab, "adc", "", "table.xmin")) { + w2 = tabgetr (tab, "adc", "", "table.xmax") + if (w1 > waves[1] || w2 < waves[npix]) + call fprintf (fd, + "WARNING: ADC table extrapolated in wavelength\n") + } + ifnoerr (w1 = tabgetr (tab, "filter", "", "table.xmin")) { + w2 = tabgetr (tab, "filter", "", "table.xmax") + if (w1 > waves[1] || w2 < waves[npix]) + call fprintf (fd, + "WARNING: Filter table extrapolated in wavelength\n") + } + ifnoerr (w1 = tabgetr (tab, "filter2", "", "table.xmin")) { + w2 = tabgetr (tab, "filter2", "", "table.xmax") + if (w1 > waves[1] || w2 < waves[npix]) + call fprintf (fd, + "WARNING: Second filter table extrapolated in wavelength\n") + } + ifnoerr (w1 = tabgetr (tab, "fiber", "", "table.xmin")) { + w2 = tabgetr (tab, "fiber", "", "table.xmax") + if (w1 > waves[1] || w2 < waves[npix]) + call fprintf (fd, + "WARNING: Fiber table extrapolated in wavelength\n") + } + ifnoerr (w1 = tabgetr (tab, "collimator", "", "table.xmin")) { + w2 = tabgetr (tab, "collimator", "", "table.xmax") + if (w1 > waves[1] || w2 < waves[npix]) + call fprintf (fd, + "WARNING: Collimator table extrapolated in wavelength\n") + } + ifnoerr (w1 = tabgetr (tab,"disperser","","table.xmin")/ST_ORDER(st,1)) { + w2 = tabgetr (tab, "disperser", "", "table.xmax") / ST_ORDER(st,1) + if (w1 > waves[1] || w2 < waves[npix]) + call fprintf (fd, + "WARNING: Disperser table extrapolated in wavelength\n") + ifnoerr (w1 = tabgetr (tab, "disperser", "", "table.ymin")) { + w2 = tabgetr (tab, "disperser", "", "table.ymax") + if (w1 > ST_ORDER(st,1) || w2 < ST_ORDER(st,1)) + call fprintf (fd, + "WARNING: Disperser table extrapolated in order\n") + } + } + ifnoerr (w1 = tabgetr (tab,"xdisperser", "","table.xmin")/ST_ORDER(st,2)) { + w2 = tabgetr (tab, "xdisperser", "", "table.xmax") / ST_ORDER(st,2) + if (w1 > waves[1] || w2 < waves[npix]) + call fprintf (fd, + "WARNING: Cross disperser table extrapolated in wavelength\n") + ifnoerr (w1 = tabgetr (tab, "xdisperser", "", "table.ymin")) { + w2 = tabgetr (tab, "xdisperser", "", "table.ymax") + if (w1 > ST_ORDER(st,2) || w2 < ST_ORDER(st,2)) + call fprintf (fd, + "WARNING: Cross disperser table extrapolated in order\n") + } + } + ifnoerr (w1 = tabgetr (tab, "corrector", "", "table.xmin")) { + w2 = tabgetr (tab, "corrector", "", "table.xmax") + if (w1 > waves[1] || w2 < waves[npix]) + call fprintf (fd, + "WARNING: Corrector table extrapolated in wavelength\n") + } + ifnoerr (w1 = tabgetr (tab, "camera", "", "table.xmin")) { + w2 = tabgetr (tab, "camera", "", "table.xmax") + if (w1 > waves[1] || w2 < waves[npix]) + call fprintf (fd, + "WARNING: Camera table extrapolated in wavelength\n") + } + ifnoerr (w1 = tabgetr (tab, "detector", "", "table.xmin")) { + w2 = tabgetr (tab, "detector", "", "table.xmax") + if (w1 > waves[1] || w2 < waves[npix]) + call fprintf (fd, + "WARNING: Detector table extrapolated in wavelength\n") + } + + # Check for saturation and DN limits. + sat = stgetr (st, "saturation", "detector", MAX_REAL) + dnmax = stgetr (st, "dnmax", "detector", MAX_REAL) + + # Check for insufficient sky pixels. + switch (ST_SKYSUB(st)) { + case SKY_LONGSLIT: + if (ST_NSKYPIX(st) <= 0) + call fprintf (fd, + "WARNING: Slit is too short for sky subtraction\n") + } + + # Check for order overlaps and saturation. + if (npix > 3) { + step = max (1, npix / 21) + maxfrac = 0. + maxcount = 0 + do i = 3*step, npix-3*step, step { + w = waves[i] + call st_snr (st, NULL, w, ST_NEXP(st), ST_TIME(st), nobj, nsky, + snr, thruput) + maxcount = max (nobj[1]+nsky[3], maxcount) + if (nobj[1] > 0.) { + maxfrac = max (nobj[2]/nobj[1], maxfrac) + maxfrac = max (nobj[4]/nobj[1], maxfrac) + } + } + } else { + w = waves[1] + call st_snr (st, NULL, w, ST_NEXP(st), ST_TIME(st), nobj, nsky, + snr, thruput) + maxcount = max (nobj[1]+nsky[3], maxcount) + if (nobj[1] > 0.) { + maxfrac = max (nobj[2]/nobj[1], maxfrac) + maxfrac = max (nobj[4]/nobj[1], maxfrac) + } + } + + if (maxcount > sat) + call fprintf (fd, "WARNING: Exposure may saturate.\n") + if (maxcount / ST_GAIN(st) > dnmax) + call fprintf (fd, "WARNING: Exposure may overflow DN maximum.\n") + if (maxfrac > 0.1) + call fprintf (fd, + "WARNING: More than 10%% contribution from other orders.\n") + + if (ST_DISPTYPE(st,2) != 0 && !IS_INDEFI(ST_ORDER(st,1))) { + w = ST_CW(st) + i = ST_ORDER(st,1) + dw = abs (gr_getr (ST_GR(st,2), "dispersion")) + dw = dw * ST_PIXSIZE(st) * ST_BIN(st,2) + n = w * (1 - real (i) / real (i + 1)) / dw + if (n < ST_APSIZE(st,2) / ST_SCALE(st,2)) + call fprintf (fd, "WARNING: Orders overlap\n") + } + + call fprintf (fd, "\n") +end + + +# ST_GTABLE -- Get table name from CL and load if a name is given. +# Otherwise get table name from another table, if specified, and load if +# a name is found. + +procedure st_gtable (st, name, table) + +pointer st #I SPECTIME structure +char name[ARB] #I Table to load (CL parameter name and table name) +char table[ARB] #I Table to use if not defined by CL parameter + +pointer sp, dir, path, fname +int i, nowhite(), strdic() +bool streq() +errchk st_gtable1 + +define done_ 10 + +begin + call smark (sp) + call salloc (dir, SZ_FNAME, TY_CHAR) + call salloc (path, SZ_FNAME, TY_CHAR) + call salloc (fname, SZ_FNAME, TY_CHAR) + + # Determine table name from CL parameter or table. + call stgstr (st, name, table, "", Memc[fname], SZ_FNAME) + i = nowhite (Memc[fname], Memc[fname], SZ_FNAME) + + # Special cases. + if (streq (Memc[fname], "none")) + goto done_ + if (streq (name, "spectrum")) { + ST_SPEC(st) = strdic (Memc[fname], Memc[path], SZ_FNAME, SPECTYPES) + if (ST_SPEC(st) != SPEC_TAB && streq (Memc[fname], Memc[path])) + goto done_ + ST_SPEC(st) = SPEC_TAB + } + + # If a filename is given find it and load it. + if (Memc[fname] != EOS) + call st_gtable1 (st, name, Memc[fname]) + +done_ call sfree (sp) +end + + +# ST_GTABLE1 -- Load table with search path. +# Otherwise get table name from another table, if specified, and load if +# a name is found. + +procedure st_gtable1 (st, name, fname) + +pointer st #I SPECTIME structure +char name[ARB] #I Table name +char fname[ARB] #I File + +pointer sp, dir, path +real value +int i, ctor(), strlen(), clgfil(), access() +errchk tabload + +define done_ 10 + +begin + call smark (sp) + call salloc (dir, SZ_FNAME, TY_CHAR) + call salloc (path, SZ_FNAME, TY_CHAR) + + # Check for constant value. + i = 1 + if (ctor (fname, i, value) == strlen (fname)) { + call tabload (ST_TAB(st), name, fname) + goto done_ + } + + # Absolute path or current directory. + if (access (fname, READ_ONLY, 0) == YES) { + call tabload (ST_TAB(st), name, fname) + goto done_ + } + + # Search directories. + call clprew (ST_SEARCH(st)) + while (clgfil (ST_SEARCH(st), Memc[dir], SZ_FNAME) != EOF) { + call sprintf (Memc[path], SZ_FNAME, "%s/%s") + call pargstr (Memc[dir]) + call pargstr (fname) + if (access (Memc[path], READ_ONLY, 0) == NO) + next + call tabload (ST_TAB(st), name, Memc[path]) + goto done_ + } + + # Search sptimelib$. + call sprintf (Memc[path], SZ_FNAME, "%s/%s") + call pargstr ("sptimelib$") + call pargstr (fname) + if (access (Memc[path], READ_ONLY, 0) == YES) { + call tabload (ST_TAB(st), name, Memc[path]) + goto done_ + } + + call sprintf (Memc[path], SZ_FNAME, "Table `%s' not found") + call pargstr (fname) + call error (1, Memc[path]) + +done_ call sfree (sp) +end + + +# ST_SPECTRUM -- Return spectrum flux. + +real procedure st_spectrum (st, wave) + +pointer st #I SPECTIME pointer +real wave #I Wavelength +real flux #O Flux + +real tabinterp1(), ccm() +errchk tabinterp1, ccm + +begin + switch (ST_SPEC(st)) { + case SPEC_TAB: + flux = tabinterp1 (ST_TAB(st), "spectrum", wave) + case SPEC_BB: + flux = (exp (min (30., 1.4338e8/(ST_REFW(st)*ST_PARAM(st)))) - 1) / + (exp (min (30., 1.4338e8/(wave*ST_PARAM(st)))) - 1) + flux = ST_REFFL(st) * (ST_REFW(st) / wave) ** 5 * flux + case SPEC_FL: + flux = ST_REFFL(st) * (wave/ST_REFW(st)) ** ST_PARAM(st) + case SPEC_FN: + flux = ST_REFFL(st) * (wave/ST_REFW(st)) ** (-2.-ST_PARAM(st)) + } + flux = flux * 10. ** (0.4 * ST_AV(st) * + (ccm (ST_REFW(st), ST_RV(st)) - ccm (wave, ST_RV(st)))) + + return (flux) +end + + +# ST_OUTPUT -- Output graphs and/or lists. + +procedure st_output (st, gp, fd, interactive, output, w, npts) + +pointer st #I SPECTIME structure +pointer gp #U GIO pointer +int fd #I FIO pointer +bool interactive #I Interactive? +char output[ARB] #I Output type +real w[npts] #I Wavelengths +int npts #I Number of points + +int i, j, ndata, type +real nobj[4], nsky[4] +real wx1, wx2, wy1, wy2, wmin, wmax, a, b, buf, f, snr, thruput, airmass +pointer sp, spec, name +pointer title, xlabel, ylabel, id[4], xdata, ydata, str, tab + +bool tabexists() +int strdic(), clgcur() +real st_dispeff(), tabinterp1(), tabinterp2(), st_spectrum(), tabgetr() +errchk st_snr, st_dispeff, tabinterp1, tabinterp2, st_spectrum + +begin + if (gp == NULL && fd == NULL) + return + + call smark (sp) + call salloc (spec, SZ_LINE, TY_CHAR) + call salloc (name, SZ_LINE, TY_CHAR) + call salloc (title, SZ_LINE, TY_CHAR) + call salloc (xlabel, SZ_LINE, TY_CHAR) + call salloc (ylabel, SZ_LINE, TY_CHAR) + call salloc (id[1], SZ_LINE, TY_CHAR) + call salloc (id[2], SZ_LINE, TY_CHAR) + call salloc (id[3], SZ_LINE, TY_CHAR) + call salloc (id[4], SZ_LINE, TY_CHAR) + call salloc (xdata, npts, TY_REAL) + call salloc (ydata, 4*npts, TY_REAL) + call salloc (str, SZ_LINE, TY_CHAR) + + tab = ST_TAB(st) + + # Set title, data, and data limits. + call st_gtitle (st, "title", "spectrograph", Memc[title], SZ_LINE) + call st_gtitle (st, "spectitle", "spectrum", Memc[spec], SZ_LINE) + if (Memc[spec] == EOS) { + switch (ST_SPEC(st)) { + case SPEC_BB: + call sprintf (Memc[spec], SZ_LINE, + "Blackbody spectrum of temperature %g K") + call pargr (ST_PARAM(st)) + case SPEC_FL: + call sprintf (Memc[spec], SZ_LINE, + "F(lambda) power law spectrum of index %g") + call pargr (ST_PARAM(st)) + case SPEC_FN: + call sprintf (Memc[spec], SZ_LINE, + "F(nu) power law spectrum of index %g") + call pargr (ST_PARAM(st)) + } + } + + call sprintf (Memc[xlabel], SZ_LINE, "Dispersion (%s)") + call pargstr (ST_DUNITS(st)) + + ndata = npts + #call amovr (w, Memr[xdata], ndata) + call un_ctranr (ST_DUNANG(st), ST_DUN(st), w, Memr[xdata], ndata) + Memr[ydata] = INDEF + Memr[ydata+npts] = INDEF + Memr[ydata+2*npts] = INDEF + Memr[ydata+3*npts] = INDEF + #wx1 = INDEF; wx2 = INDEF; wy1 = -4.; wy2 = 104. + wx1 = INDEF; wx2 = INDEF; wy1 = INDEF; wy2 = INDEF + + type = strdic (output, Memc[name], SZ_LINE, OUTTYPES) + switch (type) { + case OUT_RATE: + if (Memc[title] != EOS) + call strcat ("\n", Memc[title], SZ_LINE) + call strcat (Memc[spec], Memc[title], SZ_LINE) + call strcpy ("Photons/s/A", Memc[ylabel], SZ_LINE) + call strcpy ("Object (ph/s/A)", Memc[id[1]], SZ_LINE) + call strcpy ("Background (ph/s/A)", Memc[id[2]], SZ_LINE) + call strcpy ("Total (ph/s/A)", Memc[id[3]], SZ_LINE) + + do i = 1, npts { + call st_snr (st, NULL, w[i], ST_NEXP(st), ST_TIME(st), + nobj, nsky, snr, thruput) + Memr[ydata+i-1] = nobj[1] / ST_TIME(st) / ST_DISP(st,1) + Memr[ydata+npts+i-1] = nsky[1] / ST_TIME(st) / ST_DISP(st,1) + Memr[ydata+2*npts+i-1] = (nobj[1]+nsky[1]) / + ST_TIME(st) / ST_DISP(st,1) + } + call alimr (Memr[ydata+npts], npts, a, b) + if (b <= 0.) { + Memr[ydata+npts] = INDEF + Memr[ydata+2*npts] = INDEF + if (Memc[title] != EOS) + call strcat ("\n", Memc[title], SZ_LINE) + call sprintf (Memc[str], SZ_LINE, "Object photon rates\n") + call strcat (Memc[str], Memc[title], SZ_LINE) + } else { + if (Memc[title] != EOS) + call strcat ("\n", Memc[title], SZ_LINE) + call sprintf (Memc[str], SZ_LINE, + "Object, background, and total photon rates\n") + call strcat (Memc[str], Memc[title], SZ_LINE) + } + + wy1 = INDEF; wy2 = INDEF + case OUT_OBJ: + if (Memc[title] != EOS) + call strcat ("\n", Memc[title], SZ_LINE) + call strcat (Memc[spec], Memc[title], SZ_LINE) + call sprintf (Memc[str], SZ_LINE, "\nExposure time = %d seconds") + call pargr (ST_NEXP(st) * max (ST_TIME(st),1.)) + call strcat (Memc[str], Memc[title], SZ_LINE) + if (ST_NEXP(st) > 1) { + call sprintf (Memc[str], SZ_LINE, "(%d exposures)") + call pargi (ST_NEXP(st)) + call strcat (Memc[str], Memc[title], SZ_LINE) + } + call strcpy ("Object DN", Memc[ylabel], SZ_LINE) + call strcpy ("Total Object (counts)", Memc[id[1]], SZ_LINE) + call sprintf (Memc[id[2]], SZ_LINE, "Order %d (counts)") + call pargi (ST_ORDER(st,1)-1) + call sprintf (Memc[id[3]], SZ_LINE, "Order %d (counts)") + call pargi (ST_ORDER(st,1)) + call sprintf (Memc[id[4]], SZ_LINE, "Order %d (counts)") + call pargi (ST_ORDER(st,1)+1) + + do i = 1, npts { + call st_snr (st, NULL, w[i], 1, ST_NEXP(st) * ST_TIME(st), + nobj, nsky, snr, thruput) + Memr[ydata+i-1] = nobj[1] / ST_GAIN(st) + Memr[ydata+npts+i-1] = nobj[2] / ST_GAIN(st) + Memr[ydata+2*npts+i-1] = nobj[3] / ST_GAIN(st) + Memr[ydata+3*npts+i-1] = nobj[4] / ST_GAIN(st) + } + call alimr (Memr[ydata+npts], npts, a, b) + if (b <= 0.) + Memr[ydata+npts] = INDEF + call alimr (Memr[ydata+3*npts], npts, a, b) + if (b <= 0.) + Memr[ydata+3*npts] = INDEF + if (IS_INDEF(Memr[ydata+npts]) && IS_INDEF(Memr[ydata+3*npts])) { + Memr[ydata+2*npts] = INDEF + if (Memc[title] != EOS) + call strcat ("\n", Memc[title], SZ_LINE) + call sprintf (Memc[str], SZ_LINE, + "Object DN at gain of %.2g\n") + call pargr (ST_GAIN(st)) + call strcat (Memc[str], Memc[title], SZ_LINE) + } else { + if (Memc[title] != EOS) + call strcat ("\n", Memc[title], SZ_LINE) + call sprintf (Memc[str], SZ_LINE, + "Object DN at gain of %.2g with order contributions\n") + call pargr (ST_GAIN(st)) + call strcat (Memc[str], Memc[title], SZ_LINE) + } + + wy1 = INDEF; wy2 = INDEF + case OUT_SNR: + if (Memc[title] != EOS) + call strcat ("\n", Memc[title], SZ_LINE) + call strcat (Memc[spec], Memc[title], SZ_LINE) + call sprintf (Memc[str], SZ_LINE, "\nExposure time = %d seconds") + call pargr (ST_NEXP(st) * max(ST_TIME(st),1.)) + call strcat (Memc[str], Memc[title], SZ_LINE) + if (ST_NEXP(st) > 1) { + call sprintf (Memc[str], SZ_LINE, "(%d exposures)") + call pargi (ST_NEXP(st)) + call strcat (Memc[str], Memc[title], SZ_LINE) + } + call strcpy ("S/N", Memc[ylabel], SZ_LINE) + call strcpy ("S/N", Memc[id[1]], SZ_LINE) + + a = sqrt (real(ST_NEXP(st))) + do i = 1, npts { + call st_snr (st, NULL, w[i], ST_NEXP(st), ST_TIME(st), + nobj, nsky, snr, thruput) + Memr[ydata+i-1] = a * snr + } + wy1 = INDEF; wy2 = INDEF + case OUT_ATM: + call st_gtitle (st, "exttitle", "extinction", Memc[str], SZ_LINE) + if (Memc[str] == EOS) + call strcpy ("Extinction", Memc[str], SZ_LINE) + if (Memc[title] != EOS) + call strcat ("\n", Memc[title], SZ_LINE) + call strcat (Memc[str], Memc[title], SZ_LINE) + call sprintf (Memc[str], SZ_LINE, "\nAirmass of %g") + call pargr (ST_AIRMASS(st)) + call strcat (Memc[str], Memc[title], SZ_LINE) + call strcpy ("Transmission (%)", Memc[ylabel], SZ_LINE) + call strcpy ("ATM Transmission (%)", Memc[id[1]], SZ_LINE) + + iferr { + do i = 1, npts { + f = tabinterp1 (tab, "extinction", w[i]) + Memr[ydata+i-1] = 100 * 10 ** (-0.4 * f * ST_AIRMASS(st)) + } + } then + call amovkr (100., Memr[ydata], npts) + case OUT_TEL: + call st_gtitle (st, "teltitle", "telescope", Memc[str], SZ_LINE) + if (Memc[str] == EOS) + call strcpy ("Telescope", Memc[str], SZ_LINE) + if (Memc[title] != EOS) + call strcat ("\n", Memc[title], SZ_LINE) + call strcat (Memc[str], Memc[title], SZ_LINE) + call strcpy ("Transmission (%)", Memc[ylabel], SZ_LINE) + call strcpy ("Telescope Transmission (%)", Memc[id[1]], SZ_LINE) + + iferr { + do i = 1, npts + Memr[ydata+i-1] = 100 * + tabinterp1 (tab, Memc[name], w[i]) + } then + call amovkr (100., Memr[ydata], npts) + case OUT_AP: + call st_gtitle (st, "aptitle", "aperture", Memc[str], SZ_LINE) + if (Memc[str] == EOS) + call strcpy ("Aperture", Memc[str], SZ_LINE) + if (Memc[title] != EOS) + call strcat ("\n", Memc[title], SZ_LINE) + call strcat (Memc[str], Memc[title], SZ_LINE) + call sprintf (Memc[str], SZ_LINE, "\nSeeing of %.2f\"") + call pargr (ST_SEEING(st)) + call strcat (Memc[str], Memc[title], SZ_LINE) + call strcpy ("Transmission (%)", Memc[ylabel], SZ_LINE) + call strcpy ("Aperture (%)", Memc[id[1]], SZ_LINE) + + iferr { + switch (ST_APTYPE(st)) { + case CIRCULAR: + f = 100 * tabinterp1 (tab, Memc[name], + ST_APSIZE(st,1) / ST_SEEING(st)) + case RECTANGULAR: + f = 100 * tabinterp2 (tab, Memc[name], + ST_APSIZE(st,1) / ST_SEEING(st), + ST_APSIZE(st,2) / ST_SEEING(st)) + } + } then + f = 100 + call amovkr (f, Memr[ydata], npts) + case OUT_FIB: + if (tabexists (tab, Memc[name])) { + call st_gtitle (st, "fibtitle", "fiber", Memc[str], SZ_LINE) + if (Memc[str] == EOS) + call strcpy ("Fiber", Memc[str], SZ_FNAME) + if (Memc[title] != EOS) + call strcat ("\n", Memc[title], SZ_LINE) + call strcat (Memc[str], Memc[title], SZ_LINE) + call strcpy ("Transmission (%)", Memc[ylabel], SZ_LINE) + + iferr { + do i = 1, npts + Memr[ydata+i-1] = 100 * + tabinterp1 (tab, Memc[name], w[i]) + } then + call amovkr (100., Memr[ydata], npts) + } + case OUT_FILT, OUT_FILT2: + if (tabexists (tab, Memc[name])) { + if (type == OUT_FILT) + call st_gtitle (st, "ftitle", "filter", Memc[str], SZ_LINE) + else + call st_gtitle (st, "f2title", "filter2", Memc[str],SZ_LINE) + if (Memc[str] == EOS) + call strcpy ("Filter", Memc[str], SZ_LINE) + if (Memc[title] != EOS) + call strcat ("\n", Memc[title], SZ_LINE) + call strcat (Memc[str], Memc[title], SZ_LINE) + call strcpy ("Transmission (%)", Memc[ylabel], SZ_LINE) + call strcpy ("Fiber (%)", Memc[id[1]], SZ_LINE) + + iferr { + do i = 1, npts + Memr[ydata+i-1] = 100 * + tabinterp1 (tab, Memc[name], w[i]) + } then + call amovkr (100., Memr[ydata], npts) + } + case OUT_COL: + call st_gtitle (st, "coltitle", "collimator", Memc[str], SZ_LINE) + if (Memc[str] == EOS) + call strcpy ("Collimator", Memc[str], SZ_LINE) + if (Memc[title] != EOS) + call strcat ("\n", Memc[title], SZ_LINE) + call strcat (Memc[str], Memc[title], SZ_LINE) + call strcpy ("Transmission (%)", Memc[ylabel], SZ_LINE) + call strcpy ("Collimator (%)", Memc[id[1]], SZ_LINE) + + iferr { + do i = 1, npts + Memr[ydata+i-1] = 100 * + tabinterp1 (tab, Memc[name], w[i]) + } then + call amovkr (100., Memr[ydata], npts) + case OUT_DISP: + if (ST_DISPTYPE(st,1) != 0) { + call st_gtitle (st, "disptitle", "disperser", Memc[str],SZ_LINE) + if (Memc[str] == EOS) + call strcpy ("Disperser", Memc[str], SZ_LINE) + if (Memc[title] != EOS) + call strcat ("\n", Memc[title], SZ_LINE) + call strcat (Memc[str], Memc[title], SZ_LINE) + call strcpy ("Efficiency (%)", Memc[ylabel], SZ_LINE) + call strcpy ("Disperser (%)", Memc[id[1]], SZ_LINE) + + do i = 1, npts + Memr[ydata+i-1] = 100 * st_dispeff (st, Memc[name], w[i], + ST_ORDER(st,1)) + } + case OUT_XDISP: + if (ST_DISPTYPE(st,2) != 0) { + call st_gtitle (st, "xdisptitle","xdisperser",Memc[str],SZ_LINE) + if (Memc[str] == EOS) + call strcpy ("Crossdisperser", Memc[str], SZ_LINE) + if (Memc[title] != EOS) + call strcat ("\n", Memc[title], SZ_LINE) + call strcat (Memc[str], Memc[title], SZ_LINE) + call strcpy ("Efficiency (%)", Memc[ylabel], SZ_LINE) + call strcpy ("Cross-disperser (%)", Memc[id[1]], SZ_LINE) + + do i = 1, npts + Memr[ydata+i-1] = 100 * st_dispeff (st, Memc[name], w[i], + ST_ORDER(st,2)) + } + case OUT_COR: + if (tabexists (tab, Memc[name])) { + call st_gtitle (st, "cortitle", "corrector", Memc[str], SZ_LINE) + if (Memc[str] == EOS) + call strcpy ("Corrector", Memc[str], SZ_LINE) + if (Memc[title] != EOS) + call strcat ("\n", Memc[title], SZ_LINE) + call strcat (Memc[str], Memc[title], SZ_LINE) + call strcpy ("Transmission (%)", Memc[ylabel], SZ_LINE) + call strcpy ("Corrector (%)", Memc[id[1]], SZ_LINE) + + iferr { + do i = 1, npts + Memr[ydata+i-1] = 100 * + tabinterp1 (tab, Memc[name], w[i]) + } then + call amovkr (100., Memr[ydata], npts) + } + case OUT_CAM: + call st_gtitle (st, "camtitle", "camera", Memc[str], SZ_LINE) + if (Memc[str] == EOS) + call strcpy ("Camera", Memc[str], SZ_LINE) + if (Memc[title] != EOS) + call strcat ("\n", Memc[title], SZ_LINE) + call strcat (Memc[str], Memc[title], SZ_LINE) + call strcpy ("Transmission (%)", Memc[ylabel], SZ_LINE) + call strcpy ("Camera (%)", Memc[id[1]], SZ_LINE) + + iferr { + do i = 1, npts + Memr[ydata+i-1] = 100 * + tabinterp1 (tab, Memc[name], w[i]) + } then + call amovkr (100., Memr[ydata], npts) + case OUT_DET: + call st_gtitle (st, "dettitle", "detector", Memc[str], SZ_LINE) + if (Memc[str] == EOS) + call strcpy ("Detector", Memc[str], SZ_LINE) + if (Memc[title] != EOS) + call strcat ("\n", Memc[title], SZ_LINE) + call strcat (Memc[str], Memc[title], SZ_LINE) + call strcpy ("DQE (%)", Memc[ylabel], SZ_LINE) + call strcpy ("DQE (%)", Memc[id[1]], SZ_LINE) + + iferr { + do i = 1, npts + Memr[ydata+i-1] = 100 * + tabinterp1 (tab, Memc[name], w[i]) + } then + call amovkr (100., Memr[ydata], npts) + case OUT_SPEC: + call strcpy ("Spectrograph Other", Memc[str], SZ_LINE) + if (Memc[title] != EOS) + call strcat ("\n", Memc[title], SZ_LINE) + call strcat (Memc[str], Memc[title], SZ_LINE) + call strcpy ("Transmission (%)", Memc[ylabel], SZ_LINE) + call strcpy ("Spectrograph Other (%s)", Memc[id[1]], SZ_LINE) + + iferr { + do i = 1, npts + Memr[ydata+i-1] = 100 * + tabinterp1 (tab, Memc[name], w[i]) + } then + Memr[ydata] = INDEF + case OUT_ADC: + if (tabexists (tab, Memc[name])) { + call st_gtitle (st, "adctitle", "adc", Memc[str], SZ_LINE) + if (Memc[str] == EOS) + call strcpy ("ADC", Memc[str], SZ_LINE) + if (Memc[title] != EOS) + call strcat ("\n", Memc[title], SZ_LINE) + call strcat (Memc[str], Memc[title], SZ_LINE) + call strcpy ("Transmission (%)", Memc[ylabel], SZ_LINE) + call strcpy ("ADC (%)", Memc[id[1]], SZ_LINE) + + iferr { + do i = 1, npts + Memr[ydata+i-1] = 100 * + tabinterp1 (tab, Memc[name], w[i]) + } then + call amovkr (100., Memr[ydata], npts) + } + case OUT_EMIS: + if (tabexists (tab, Memc[name]) && ST_THERMAL(st) > 0.) { + if (Memc[title] != EOS) + call strcat ("\n", Memc[title], SZ_LINE) + call st_gtitle (st, "emistitle", "emissivity",Memc[str],SZ_LINE) + if (Memc[str] == EOS) + call strcpy ("Emissivity", Memc[str], SZ_LINE) + call strcat (Memc[str], Memc[title], SZ_LINE) + call sprintf (Memc[str], SZ_LINE, "\nTemperature = %.1f K") + call pargr (ST_THERMAL(st)) + call strcat (Memc[str], Memc[title], SZ_LINE) + call strcpy ("Emissivity (%)", Memc[ylabel], SZ_LINE) + call strcpy ("Emissivity (%)", Memc[id[1]], SZ_LINE) + + iferr { + do i = 1, npts + Memr[ydata+i-1] = 100 * + tabinterp1 (tab, Memc[name], w[i]) + } then + call amovkr (100., Memr[ydata], npts) + } + case OUT_THRU: + if (Memc[title] != EOS) + call strcat ("\n", Memc[title], SZ_LINE) + call strcat ("System Thruput (Telescope to Detected Photons)", + Memc[title], SZ_LINE) + call strcpy ("Thruput (%)", Memc[ylabel], SZ_LINE) + call strcpy ("Thruput (%)", Memc[id[1]], SZ_LINE) + + do i = 1, npts { + call st_snr (st, NULL, w[i], ST_NEXP(st), ST_TIME(st), + nobj, nsky, snr, thruput) + Memr[ydata+i-1] = 100 * thruput + } + case OUT_COUNTS: + if (Memc[title] != EOS) + call strcat ("\n", Memc[title], SZ_LINE) + call strcat (Memc[spec], Memc[title], SZ_LINE) + call sprintf (Memc[str], SZ_LINE, "\nExposure time = %d seconds") + call pargr (ST_NEXP(st) * max(ST_TIME(st),1.)) + call strcat (Memc[str], Memc[title], SZ_LINE) + if (ST_NEXP(st) > 1) { + call sprintf (Memc[str], SZ_LINE, "(%d exposures)") + call pargi (ST_NEXP(st)) + call strcat (Memc[str], Memc[title], SZ_LINE) + } + call strcpy ("DN", Memc[ylabel], SZ_LINE) + call strcpy ("Object (counts)", Memc[id[1]], SZ_LINE) + call strcpy ("Background (counts)", Memc[id[2]], SZ_LINE) + call strcpy ("Total (counts)", Memc[id[3]], SZ_LINE) + + do i = 1, npts { + call st_snr (st, NULL, w[i], 1, ST_NEXP(st) * ST_TIME(st), + nobj, nsky, snr, thruput) + Memr[ydata+i-1] = nobj[1] / ST_GAIN(st) + Memr[ydata+npts+i-1] = nsky[1] / ST_GAIN(st) + Memr[ydata+2*npts+i-1] = (nobj[1]+nsky[1]) / ST_GAIN(st) + } + call alimr (Memr[ydata+npts], npts, a, b) + if (b <= 0.) { + Memr[ydata+npts] = INDEF + Memr[ydata+2*npts] = INDEF + if (Memc[title] != EOS) + call strcat ("\n", Memc[title], SZ_LINE) + call sprintf (Memc[str], SZ_LINE, + "Object DN at gain of %.2g\n") + call pargr (ST_GAIN(st)) + call strcat (Memc[str], Memc[title], SZ_LINE) + } else { + if (Memc[title] != EOS) + call strcat ("\n", Memc[title], SZ_LINE) + call sprintf (Memc[str], SZ_LINE, + "Object, background, and total DN at gain of %.2g\n") + call pargr (ST_GAIN(st)) + call strcat (Memc[str], Memc[title], SZ_LINE) + } + + wy1 = INDEF; wy2 = INDEF + case OUT_SENS: + airmass = ST_AIRMASS(st) + ST_AIRMASS(st) = 0. + + if (Memc[title] != EOS) + call strcat ("\n", Memc[title], SZ_LINE) + call strcat ("Sensitivity Function", Memc[title], SZ_LINE) + call strcpy ("Magnitudes", Memc[ylabel], SZ_LINE) + call strcpy ("Sensitivity (mag)", Memc[id[1]], SZ_LINE) + + wy1 = MAX_REAL + wy2 = -MAX_REAL + do i = 1, npts { + call st_snr (st, NULL, w[i], ST_NEXP(st), ST_TIME(st), + nobj, nsky, snr, thruput) + a = nobj[1] / ST_GAIN(st) / ST_TIME(st) / ST_DISP(st,1) + b = st_spectrum (st, w[i]) + if (a > 0. && b > 0.) { + a = 2.5 * (log10 (a) - log10 (b)) + wy1 = min (wy1, a) + wy2 = max (wy2, a) + } else + a = 0 + Memr[ydata+i-1] = a + } + if (wy1 < wy2) { + buf = 0.1 * (wy2 - wy1) + wy1 = wy1 - buf + wy2 = wy2 + buf + } else { + wy1 = INDEF + wy2 = INDEF + } + + ST_AIRMASS(st) = airmass + case OUT_CORRECT: + if (tabexists (tab, "sensfunc")) { + airmass = ST_AIRMASS(st) + ST_AIRMASS(st) = 0. + + iferr (call tabgstr (tab, "sensfunc", "", + "title", Memc[str], SZ_LINE)) { + call tabgstr (tab, "sensfunc", "", "table.filename", + Memc[str], SZ_LINE) + } + if (Memc[title] != EOS) + call strcat ("\n", Memc[title], SZ_LINE) + call strcat ("Correction from: ", Memc[title], SZ_LINE) + call strcat (Memc[str], Memc[title], SZ_LINE) + call strcpy ("Correction factor", Memc[ylabel], SZ_LINE) + call strcpy ("Correction factor", Memc[id[1]], SZ_LINE) + + wmin = tabgetr (tab, "sensfunc", "", "table.xmin") + wmax = tabgetr (tab, "sensfunc", "", "table.xmax") + + wy1 = MAX_REAL + wy2 = -MAX_REAL + ndata = 0 + do i = 1, npts { + if (w[i] < wmin || w[i] > wmax) + next + call st_snr (st, NULL, w[i], ST_NEXP(st), ST_TIME(st), + nobj, nsky, snr, thruput) + a = nobj[1] / ST_GAIN(st) / ST_TIME(st) / ST_DISP(st,1) + b = st_spectrum (st, w[i]) + if (a <= 0. || b <= 0.) + next + a = 2.5 * (log10 (a) - log10 (b)) + b = tabinterp1 (tab, "sensfunc", w[i]) + a = 10. ** (0.4 * (b - a)) + wy1 = min (wy1, a) + wy2 = max (wy2, a) + Memr[xdata+ndata] = w[i] + Memr[ydata+ndata] = a + ndata = ndata + 1 + } + if (wy1 < wy2) { + buf = 0.1 * max (0.1, wy2 - wy1) + wy1 = wy1 - buf + wy2 = wy2 + buf + } else { + wy1 = INDEF + wy2 = INDEF + } + + ST_AIRMASS(st) = airmass + } + } + + # Draw graph. + if (gp != NULL && !IS_INDEF(Memr[ydata])) { + call greactivate (gp, 0) + if (IS_INDEF(wx1) || IS_INDEF(wx2)) { + call alimr (Memr[xdata], ndata, wx1, wx2) + buf = 0.1 * (wx2 - wx1) + wx1 = wx1 - buf + wx2 = wx2 + buf + } + if (IS_INDEF(wy1) || IS_INDEF(wy2)) { + call alimr (Memr[ydata], ndata, wy1, wy2) + do i = 1, 3 { + if (!IS_INDEF(Memr[ydata+i*npts])) { + call alimr (Memr[ydata+i*npts], ndata, a, b) + wy1 = min (wy1, a) + wy2 = max (wy2, b) + } + } + buf = 0.1 * (wy2 - wy1) + wy1 = wy1 - buf + wy2 = wy2 + buf + } + + call gclear (gp) + call gsview (gp, 0.15, 0.95, 0.15, 0.85) + call gswind (gp, wx1, wx2, wy1, wy2) + call glabax (gp, Memc[title], Memc[xlabel], Memc[ylabel]) + do i = 1, 4 { + if (!IS_INDEF(Memr[ydata+(i-1)*npts])) { + call gseti (gp, G_PLTYPE, i) + call gseti (gp, G_PLCOLOR, i) + call gpline (gp, Memr[xdata], Memr[ydata+(i-1)*npts], ndata) + } + } + + if (interactive) { + call printf ( + "Type 'q' to quit graphs or any other key to continue") + i = clgcur ("gcur", a, b, i, j, Memc[str], SZ_LINE) + if (j == 'q') + call gclose (gp) + } + if (gp != NULL) + call gdeactivate (gp, 0) + } + + # Output list. + if (fd != NULL && !IS_INDEF(Memr[ydata])) { + j = 0 + do i = 0, ARB { + if (Memc[title+i] == EOS || Memc[title+i] == '\n') { + if (j != 0) { + Memc[str+j] = EOS + call fprintf (fd, "# %s\n") + call pargstr (Memc[str]) + } + if (Memc[title+i] == EOS) + break + j = 0 + } else { + Memc[str+j] = Memc[title+i] + j = j + 1 + } + } + call fprintf (fd, "# Column 1: %s\n") + call pargstr (Memc[xlabel]) + do j = 1, 4 { + if (IS_INDEF(Memr[ydata+(j-1)*npts])) + next + call fprintf (fd, "# Column %d: %s\n") + call pargi (j+1) + call pargstr (Memc[id[j]]) + } + do i = 1, ndata { + call fprintf (fd, "%12.8g") + call pargr (Memr[xdata+i-1]) + do j = 1, 4 { + if (IS_INDEF(Memr[ydata+(j-1)*npts])) + next + call fprintf (fd, " %12.8g") + call pargr (Memr[ydata+(j-1)*npts+i-1]) + } + call fprintf (fd, "\n") + } + call fprintf (fd, "\n") + } + + call sfree (sp) +end + + +# CCM -- Compute CCM Extinction Law + +real procedure ccm (wavelength, rv) + +real wavelength # Wavelength in Angstroms +real rv # A(V) / E(B-V) + +real x, y, a, b + +begin + # Convert to inverse microns + x = 10000. / wavelength + x = max (0.3, min (10., x)) + + # Compute a(x) and b(x) + if (x < 0.3) { + call error (1, "Wavelength out of range of extinction function") + + } else if (x < 1.1) { + y = x ** 1.61 + a = 0.574 * y + b = -0.527 * y + + } else if (x < 3.3) { + y = x - 1.82 + a = 1 + y * (0.17699 + y * (-0.50447 + y * (-0.02427 + + y * (0.72085 + y * (0.01979 + y * (-0.77530 + y * 0.32999)))))) + b = y * (1.41338 + y * (2.28305 + y * (1.07233 + y * (-5.38434 + + y * (-0.62251 + y * (5.30260 + y * (-2.09002))))))) + + } else if (x < 5.9) { + y = (x - 4.67) ** 2 + a = 1.752 - 0.316 * x - 0.104 / (y + 0.341) + b = -3.090 + 1.825 * x + 1.206 / (y + 0.263) + + } else if (x < 8.0) { + y = (x - 4.67) ** 2 + a = 1.752 - 0.316 * x - 0.104 / (y + 0.341) + b = -3.090 + 1.825 * x + 1.206 / (y + 0.263) + + y = x - 5.9 + a = a - 0.04473 * y**2 - 0.009779 * y**3 + b = b + 0.2130 * y**2 + 0.1207 * y**3 + + } else if (x <= 10.0) { + y = x - 8 + a = -1.072 - 0.628 * y + 0.137 * y**2 - 0.070 * y**3 + b = 13.670 + 4.257 * y - 0.420 * y**2 + 0.374 * y**3 + + } else { + call error (1, "Wavelength out of range of extinction function") + + } + + # Compute A(lambda)/A(V) + y = a + b / rv + return (y) +end + + +# STGETR -- Get real parameter. +# Returns INDEFR if parameter is not defined. + +real procedure stgetr (st, param, table, default) + +pointer st #I SPECTIME structure +char param[ARB] #I Parameter name +char table[ARB] #I Name of table +real default #I Default value +real val #O Returned value + +real clgetr(), tabgetr() +errchk tabgetr + +begin + # Get parameter from CL. + val = clgetr (param) + + # If the value is INDEF get the value from the table. + if (IS_INDEFR(val)) { + iferr (val = tabgetr (ST_TAB(st), table, "spectrograph", param)) + val = INDEFR + } + + # If the value is INDEF set default. + if (IS_INDEFR(val)) + val = default + + return (val) +end + + +# STGETI -- Get integer parameter. +# Returns INDEFI if parameter is not defined. + +int procedure stgeti (st, param, table, default) + +pointer st #I SPECTIME structure +char param[ARB] #I Parameter name +char table[ARB] #I Name of table +int default #I Default value +int val #O Returned value + +int clgeti(), tabgeti() +errchk tabgeti + +begin + # Get parameter from CL. + val = clgeti (param) + + # If the value is INDEF get the value from the table. + if (IS_INDEFI(val)) { + iferr (val = tabgeti (ST_TAB(st), table, "spectrograph", param)) + val = INDEFI + } + + # If the value is INDEF set the default. + if (IS_INDEFI(val)) + val = default + + return (val) +end + + +# STGSTR -- Get string parameter. +# Returns null string if parameter is not defined. + +procedure stgstr (st, param, table, default, val, maxchar) + +pointer st #I SPECTIME structure +char param[ARB] #I Parameter name +char table[ARB] #I Name of table +char default[ARB] #I Default value +char val[ARB] #O Returned value +int maxchar #I Maximum string length + +char tmp[10] +int nowhite() +errchk tabgste + +begin + # Get parameter from CL. + call clgstr (param, val, maxchar) + + # If the value is a null string get the value from a table. + if (nowhite (val, tmp, 10) == 0) { + iferr (call tabgstr (ST_TAB(st), table, "spectrograph", param, + val, maxchar)) + val[1] = EOS + } + + # If the value is null set the default value. + if (val[1] == EOS) + call strcpy (default, val, maxchar) +end diff --git a/noao/obsutil/src/sptime/tabinterp.x b/noao/obsutil/src/sptime/tabinterp.x new file mode 100644 index 00000000..518f7b20 --- /dev/null +++ b/noao/obsutil/src/sptime/tabinterp.x @@ -0,0 +1,698 @@ +include +include +include + +# Table structure. +define TAB_DIM 2 # Maximum dimension of table +define TAB_SZFNAME 99 # Size of file name +define TAB_SZPARAMS (10*SZ_LINE) # Size of parameter string +define TAB_SIZE (55+2*TAB_DIM) # Size of table structure + +define TAB_FNAME Memc[P2C($1)] # File name +define TAB_VALUE Memr[P2R($1+50)] # Constant table value +define TAB_PARAMS Memi[$1+51] # Pointer to parameters +define TAB_NDIM Memi[$1+52] # Dimension of table +define TAB_INTERP Memi[$1+53] # Interpolation pointer +define TAB_NEXTRAP Memi[$1+54] # Number of extrapolations +define TAB_LEN Memi[$1+54+$2] # Length of axes in table +define TAB_COORD Memi[$1+54+$2+TAB_DIM] # Pointer to axes coordinates + + +procedure tabtest () + +char table[SZ_FNAME], param[SZ_FNAME], str[SZ_FNAME] +int clglpr() +real x, y, z, tabinterp1(), tabinterp2(), tabgetr() +pointer tab, tabopen() +errchk tabopen, tabinterp1, tabinterp2, tabgetr, tabgstr + +begin + tab = tabopen () + + call clgstr ("table", table, SZ_FNAME) + + call clgstr ("param", param, SZ_FNAME) + z = tabgetr (tab, table, "", param) + call tabgstr (tab, table, "", param, str, SZ_FNAME) + call printf ("%s = %g = %s\n") + call pargstr (param) + call pargr (z) + call pargstr (str) + + while (clglpr ("x", x) != EOF) { + iferr { + z = tabinterp1 (tab, table, x) + call printf ("%g %g\n") + call pargr (x) + call pargr (z) + } then { + if (clglpr ("y", y) == EOF) + break + z = tabinterp2 (tab, table, x, y) + call printf ("%g %g %g\n") + call pargr (x) + call pargr (y) + call pargr (z) + } + } + + call tabclose (tab) +end + + +# TABOPEN -- Open table interpolation package. + +pointer procedure tabopen () + +pointer stp, stopen() + +begin + stp = stopen ("tables", 10, 1000, 1000) + return (stp) +end + + +# TABCLOSE -- Close table interpolation package. + +procedure tabclose (stp) + +pointer stp #I Symbol table pointer + +pointer sym, sthead(), stnext() + +begin + for (sym = sthead(stp); sym != NULL; sym = stnext(stp, sym)) + call tabfree (sym) + call stclose (stp) +end + + +procedure tabfree (sym) + +pointer sym #I Table structure + +int i + +begin + call mfree (TAB_PARAMS(sym), TY_CHAR) + if (TAB_INTERP(sym) != NULL) { + if (TAB_LEN(sym,1) > 1 && TAB_LEN(sym,2) > 1) + call msifree (TAB_INTERP(sym)) + else + call asifree (TAB_INTERP(sym)) + do i = 1, TAB_NDIM(sym) + call mfree (TAB_COORD(sym,i), TY_REAL) + } +end + + + +# TABLOAD -- Load a table in the symbol table. + +procedure tabload (stp, name, fname) + +pointer stp # Symbol table pointer +char name[ARB] # Name of table +char fname[ARB] # File name of table + +int i, fd, ndim, npts, len[2], open(), errget(), nowhite(), ctor(), strlen() +real value +pointer sp, str, sym, params, data, coords[2], stfind(), stenter() +bool streq() +errchk open, tabread + +begin + call smark (sp) + call salloc (str, SZ_LINE, TY_CHAR) + + # If no value is specified then don't enter into symbol table. + if (nowhite (fname, Memc[str], SZ_LINE) == 0) { + call sfree (sp) + return + } + + # The special string "none" is equivalent to no table. + if (streq (Memc[str], "none")) { + call sfree (sp) + return + } + + # Check if table has already been loaded. + sym = stfind (stp, name) + if (sym != NULL) { + if (streq (fname, TAB_FNAME(sym))) + return + } + + # Check if constant is specified. + i = 1 + if (ctor (Memc[str], i, value) == strlen (Memc[str])) { + sym = stenter (stp, name, TAB_SIZE) + call strcpy (fname, TAB_FNAME(sym), TAB_SZFNAME) + TAB_VALUE(sym) = value + TAB_NDIM(sym) = -1 + TAB_PARAMS(sym) = NULL + TAB_INTERP(sym) = NULL + + call sfree (sp) + return + } + + # Read the table. + fd = open (Memc[str], READ_ONLY, TEXT_FILE) + iferr (call tabread (fd, params, data, npts, len, coords, ndim)) { + ndim = errget (Memc[str], SZ_LINE) + call strcat (" (", Memc[str], SZ_LINE) + call strcat (name, Memc[str], SZ_LINE) + call strcat (")", Memc[str], SZ_LINE) + call error (1, Memc[str]) + } + call close (fd) + + if (sym == NULL) + sym = stenter (stp, name, TAB_SIZE) + else + call tabfree (sym) + + if (data != NULL) { + if (len[1] > 1 && len[2] > 1) { + call msiinit (TAB_INTERP(sym), II_BILINEAR) + call msifit (TAB_INTERP(sym), Memr[data], len[1], len[2], + len[1]) + } else if (len[2] == 1) { + if (len[1] == 1) + call asiinit (TAB_INTERP(sym), II_NEAREST) + else + call asiinit (TAB_INTERP(sym), II_LINEAR) + call asifit (TAB_INTERP(sym), Memr[data], len[1]) + } else { + call asiinit (TAB_INTERP(sym), II_LINEAR) + call asifit (TAB_INTERP(sym), Memr[data], len[2]) + } + } else + TAB_INTERP(sym) = NULL + + call strcpy (fname, TAB_FNAME(sym), TAB_SZFNAME) + TAB_PARAMS(sym) = params + TAB_NDIM(sym) = ndim + TAB_NEXTRAP(sym) = 0 + call amovi (len, TAB_LEN(sym,1), 2) + call amovi (coords, TAB_COORD(sym,1), 2) + call mfree (data, TY_REAL) + call sfree (sp) +end + + +# TABREAD -- Read data from a table. + +procedure tabread (fd, params, data, npts, len, coords, ndim) + +int fd #I File descriptor +pointer params #O Pointer to parameters +pointer data #O Pointer to data +int npts #O Number of data points +int len[ARB] #O Number of points along each dimension +pointer coords[ARB] #O Pointers to coordinates along each dimension +int ndim #O Dimension of table + +int i, j, nread, fdparams, fscan(), nscan(), stropen(), ctor() +real coord[4], scale +pointer sp, cmt, key, eq, val +bool streq() +errchk stropen() + +begin + iferr { + call smark (sp) + call salloc (cmt, 2, TY_CHAR) + call salloc (key, SZ_FNAME, TY_CHAR) + call salloc (eq, 1, TY_CHAR) + call salloc (val, SZ_LINE, TY_CHAR) + + npts = 0 + ndim = 0 + params = NULL + data = NULL + scale = INDEF + call aclri (len, 2) + call aclri (coords, 2) + while (fscan (fd) != EOF) { + call gargr (coord[1]) + call gargr (coord[2]) + call gargr (coord[3]) + call gargr (coord[4]) + nread = nscan() + + if (nread == 0) { # Check for parameters. + call reset_scan() + call gargwrd (Memc[cmt], 2) + call gargwrd (Memc[key], SZ_LINE) + call gargwrd (Memc[eq], 1) + call gargwrd (Memc[val], SZ_LINE) + if (nscan() != 4 || Memc[cmt] != '#' || Memc[eq] != '=' || + Memc[cmt+1] != EOS) + next + if (streq (Memc[key], "tablescale")) { + i = 1 + if (ctor (Memc[val], i, scale) == 0) + call error (1, "Syntax error in table scale factor") + } + if (params == NULL) { + call malloc (params, TAB_SZPARAMS, TY_CHAR) + fdparams = stropen (Memc[params], TAB_SZPARAMS, + WRITE_ONLY) + } + call fprintf (fdparams, "%s %s\n") + call pargstr (Memc[key]) + call pargstr (Memc[val]) + next + } else if (nread == 1) + next + + if (ndim == 0) { + ndim = nread - 1 + if (ndim > 2) + call error (1, "Table dimension is too high") + do i = ndim+1, 2 + len[i] = 1 + } + if (nread-1 != ndim) + call error (2, "Table has variable number of columns") + + do i = 1, ndim { + if (len[i] == 0) { + call malloc (coords[i], 100, TY_REAL) + Memr[coords[i]] = coord[i] + len[i] = len[i] + 1 + } else { + do j = 0, len[i] - 1 + if (coord[i] == Memr[coords[i]+j]) + break + if (j >= len[i]) { + if (mod (len[i], 100) == 0) + call realloc (coords[i], len[i]+100, TY_REAL) + Memr[coords[i]+len[i]] = coord[i] + len[i] = len[i] + 1 + } + } + } + + if (npts == 0) + call malloc (data, 100, TY_REAL) + else if (mod (npts, 100) == 0) + call realloc (data, npts+100, TY_REAL) + + Memr[data+npts] = coord[nread] + npts = npts + 1 + } + + if (npts > 0) { + j = 1 + do i = 1, ndim + j = j * len[i] + if (j != npts) + call error (4, "Table is not regular") + } + + if (!IS_INDEF(scale)) + call amulkr (Memr[data], scale, Memr[data], npts) + + call close (fdparams) + call sfree (sp) + } then { + if (params != NULL) { + call close (fdparams) + call mfree (params, TY_CHAR) + } + do i = 1, 2 + call mfree (coords[i], TY_REAL) + call mfree (data, TY_REAL) + call sfree (sp) + call erract (EA_ERROR) + } +end + + +# TABEXISTS -- Determine if table exists. + +bool procedure tabexists (stp, name) + +pointer stp #I Symbol table pointer +char name[ARB] #I Name of table + +pointer stfind() + +begin + return (stfind (stp, name) != NULL) +end + + +# TABGETR -- Get real parameter from table. + +real procedure tabgetr (stp, name, alt, param) + +pointer stp #I Symbol table pointer +char name[ARB] #I Name of table +char alt[ARB] #I Name of alternate table +char param[ARB] #I Parameter name +real val #O Returned value + +real rval +int i, fd, strncmp(), strdic(), stropen(), fscan(), nscan() +bool streq() +pointer sp, key, sym[2], stfind() +errchk stfind, stropen + +begin + # Return if no table. + if (name[1] == EOS && alt[1] == EOS) + return (INDEFR) + + call smark (sp) + call salloc (key, SZ_FNAME, TY_CHAR) + + # Find tables. + sym[1] = stfind (stp, name) + if (alt[1] != EOS) + sym[2] = stfind (stp, alt) + else + sym[2] = NULL + + # Return an error if there is no table. + if (sym[1] == NULL && sym[2] == NULL) { + call sprintf (Memc[key], SZ_FNAME, "Table `%s' not found") + call pargstr (name) + call error (1, Memc[key]) + } + + # Get the parameter value. + val = INDEFR + do i = 1, 2 { + if (sym[i] == NULL) + next + if (strncmp (param, "table.", 6) == 0) { + switch (strdic (param[7], Memc[key], SZ_FNAME, + "|ndim|xmin|xmax|ymin|ymax|nextrap|")) { + case 1: + val = TAB_NDIM(sym[i]) + case 2: + if (TAB_NDIM(sym[i]) >= 1) + val = Memr[TAB_COORD(sym[i],1)] + else if (TAB_NDIM(sym[i]) == -1) + val = -MAX_REAL + case 3: + if (TAB_NDIM(sym[i]) >= 1) + val = Memr[TAB_COORD(sym[i],1)+TAB_LEN(sym[i],1)-1] + else if (TAB_NDIM(sym[i]) == -1) + val = MAX_REAL + case 4: + if (TAB_NDIM(sym[i]) >= 2) + val = Memr[TAB_COORD(sym[i],2)] + else if (TAB_NDIM(sym[i]) == -1) + val = -MAX_REAL + case 5: + if (TAB_NDIM(sym[i]) >= 2) + val = Memr[TAB_COORD(sym[i],2)+TAB_LEN(sym[i],1)-1] + else if (TAB_NDIM(sym[i]) == -1) + val = MAX_REAL + case 6: + val = TAB_NEXTRAP(sym[i]) + } + break + + } else if (TAB_PARAMS(sym[i]) != NULL) { + fd = stropen (Memc[TAB_PARAMS(sym[i])], TAB_SZPARAMS, READ_ONLY) + while (fscan (fd) != EOF) { + call gargwrd (Memc[key], SZ_FNAME) + call gargr (rval) + if (nscan() != 2) + next + if (streq (Memc[key], param)) { + val = rval + break + } + } + call close (fd) + } + + if (!IS_INDEF(val)) + break + } + + # Return error if no value was found. + if (IS_INDEF(val)) { + call sprintf (Memc[key], SZ_FNAME, + "Table parameter `%s' not found (%s)") + call pargstr (param) + call pargstr (name) + call error (1, Memc[key]) + } + + call sfree (sp) + return (val) + +end + + +# TABGETI -- Get integer paraemter from table. + +int procedure tabgeti (stp, name, alt, param) + +pointer stp #I Symbol table pointer +char name[ARB] #I Name of table +char alt[ARB] #I Name of alternate table +char param[ARB] #I Parameter name + +real val, tabgetr() +errchk tabgetr + +begin + val = tabgetr (stp, name, alt, param) + if (IS_INDEFR(val)) + return (INDEFI) + + return (nint(val)) +end + + +# TABGSTR -- Get string parameter from table. + +procedure tabgstr (stp, name, alt, param, val, maxchar) + +pointer stp #I Symbol table pointer +char name[ARB] #I Name of table +char alt[ARB] #I Name of alternate table +char param[ARB] #I Parameter name +char val[ARB] #O Returned value +int maxchar #I Maximum string length + +int i, fd, strncmp(), strdic(), stropen(), fscan(), nscan() +bool streq() +pointer sp, key, str, sym[2], stfind() +errchk stfind, stropen() + +begin + # Return if no table. + if (name[1] == EOS && alt[1] == EOS) { + val[1] = EOS + return + } + + call smark (sp) + call salloc (key, SZ_FNAME, TY_CHAR) + call salloc (str, maxchar, TY_CHAR) + + # Find tables. + sym[1] = stfind (stp, name) + if (alt[1] != EOS) + sym[2] = stfind (stp, alt) + else + sym[2] = NULL + + # Return an error if there is no table. + if (sym[1] == NULL && sym[2] == NULL) { + call sprintf (Memc[key], SZ_FNAME, "Table `%s' not found") + call pargstr (name) + call error (1, Memc[key]) + } + + # Get the parameter value. + val[1] = EOS + do i = 1, 2 { + if (sym[i] == NULL) + next + if (strncmp (param, "table.", 6) == 0) { + switch (strdic (param[7], Memc[key], SZ_FNAME, "|filename|")) { + case 1: + call strcpy (TAB_FNAME(sym[i]), val, maxchar) + } + break + + } else if (TAB_PARAMS(sym[i]) != NULL) { + fd = stropen (Memc[TAB_PARAMS(sym[i])], TAB_SZPARAMS, READ_ONLY) + while (fscan (fd) != EOF) { + call gargwrd (Memc[key], SZ_FNAME) + call gargstr (Memc[str], SZ_LINE) + if (nscan() != 2) + next + if (streq (Memc[key], param)) { + if (val[1] == EOS) + call strcpy (Memc[str+1], val, maxchar) + else { + call strcat ("\n", val, maxchar) + call strcat (Memc[str+1], val, maxchar) + } + } + } + call close (fd) + + if (val[1] != EOS) + break + } + } + + # Return error if no value was found. + if (val[1] == EOS) { + call sprintf (Memc[key], SZ_FNAME, + "Table parameter `%s' not found (%s)") + call pargstr (param) + call pargstr (name) + call error (1, Memc[key]) + } + + call sfree (sp) +end + + +# TABINTERP1 -- Interpolate a named 1D table. + +real procedure tabinterp1 (stp, name, x) + +pointer stp # Symbol table pointer +char name[ARB] # Name of table +real x # Interpolation coordinate + +char err[SZ_FNAME] +int i, nx +real xi, y, asieval() +pointer sym, xp, stfind() +errchk stfind + +begin + # Find the table. + sym = stfind (stp, name) + if (sym == NULL) { + call sprintf (err, SZ_FNAME, "Table `%s' not found") + call pargstr (name) + call error (1, err) + } + + # If a constant table return the value. + if (TAB_NDIM(sym) == -1) + return (TAB_VALUE(sym)) + + # Check if the table is of the proper dimensionality. + if (TAB_NDIM(sym) != 1) { + call sprintf (err, SZ_FNAME, "Table is not one dimensional (%s)") + call pargstr (name) + call error (1, err) + } + + nx = TAB_LEN(sym,1) + xp = TAB_COORD(sym,1) + if (x < Memr[xp] || x > Memr[xp+nx-1]) + TAB_NEXTRAP(sym) = TAB_NEXTRAP(sym) + 1 + + if (nx == 1) + xi = 1 + else { + do i = 1, nx-2 + if (x < Memr[xp+i]) + break + + xi = i + (x - Memr[xp+i-1]) / (Memr[xp+i] - Memr[xp+i-1]) + } + xi = max (1., min (real(nx), xi)) + y = asieval (TAB_INTERP(sym), xi) + + + return (y) +end + + +# TABINTERP2 -- Interpolate a named 2D table. + +real procedure tabinterp2 (stp, name, x, y) + +pointer stp # Symbol table pointer +char name[ARB] # Name of table +real x, y # Interpolation coordinate + +char err[SZ_FNAME] +int i, nx, ny +real xi, yi, z, asieval(), msieval() +pointer sym, xp, yp, stfind() +errchk stfind + +begin + # Find the table. + sym = stfind (stp, name) + if (sym == NULL) { + call sprintf (err, SZ_FNAME, "Table `%s' not found") + call pargstr (name) + call error (1, err) + } + + # If a constant table return the value. + if (TAB_NDIM(sym) == -1) + return (TAB_VALUE(sym)) + + # Check if the table is of the proper dimensionality. + if (TAB_NDIM(sym) != 2) { + call sprintf (err, SZ_FNAME, "Table is not two dimensional (%s)") + call pargstr (name) + call error (1, err) + } + + nx = TAB_LEN(sym,1) + ny = TAB_LEN(sym,2) + if (nx > 1 && ny > 1) { # 2D interpolation + xp = TAB_COORD(sym,1) + do i = 1, nx-2 + if (x < Memr[xp+i]) + break + xi = i + (x - Memr[xp+i-1]) / (Memr[xp+i] - Memr[xp+i-1]) + xi = max (1., min (real(nx), xi)) + yp = TAB_COORD(sym,2) + do i = 1, ny-2 + if (y < Memr[yp+i]) + break + yi = i + (y - Memr[yp+i-1]) / (Memr[yp+i] - Memr[yp+i-1]) + yi = max (1., min (real(nx), yi)) + z = msieval (TAB_INTERP(sym), xi, yi) + } else if (ny == 1) { # 1D interpolation in x + if (nx == 1) + xi = 1 + else { + xp = TAB_COORD(sym,1) + do i = 1, nx-2 + if (x < Memr[xp+i]) + break + + xi = i + (x - Memr[xp+i-1]) / (Memr[xp+i] - Memr[xp+i-1]) + } + xi = max (1., min (real(nx), xi)) + z = asieval (TAB_INTERP(sym), xi) + } else { # 1D interpolation in y + yp = TAB_COORD(sym,2) + do i = 1, ny-2 + if (y < Memr[yp+i]) + break + + yi = i + (y - Memr[yp+i-1]) / (Memr[yp+i] - Memr[yp+i-1]) + yi = max (1., min (real(ny), yi)) + z = asieval (TAB_INTERP(sym), yi) + } + + return (z) +end diff --git a/noao/obsutil/src/sptime/x_spectime.x b/noao/obsutil/src/sptime/x_spectime.x new file mode 100644 index 00000000..216aaa66 --- /dev/null +++ b/noao/obsutil/src/sptime/x_spectime.x @@ -0,0 +1,2 @@ +task sptime = t_sptime, + cgiparse = t_cgiparse diff --git a/noao/obsutil/src/starfocus/Revisions b/noao/obsutil/src/starfocus/Revisions new file mode 100644 index 00000000..d3f93e90 --- /dev/null +++ b/noao/obsutil/src/starfocus/Revisions @@ -0,0 +1,162 @@ +.help revisions Nov01 obsutil +.nf +t_starfocus.x +starfocus.par +psfmeasure.par +starfocus.hlp +psfmeasure.hlp + Added a "wcs" parameter to allow specifying the coordinate system type + for cursor input. (10/7/98, Valdes) + +stfprofile.x + The logic in STF_FIT for determining the points to fit and the point + to use for the initial width estimate was faulty allowing some bad + cases to get through. (7/31/98, Valdes) + +t_starfocus.x + There was an error in the changes to allow focus sequences to go + up or down such that simple PSF measurement failed. + (6/11/97, Valdes) + +stfmeasure.x +stfprofile.x + Changes were need to better deal with error conditions. + (6/11/97, Valdes) + +stfmeasure.x + Changes to deal with error conditions. + (6/11/97, Valdes) + +t_starfocus.x + Fixed a typo error in an earlier change which left out the pointer + variable in a macro. (5/8/97, Valdes) + +t_starfocus.x + 1. Added a minimum radius of 3 to the input and to interative setting. + 2. The estimate for the next focus position is not based on the previous + center plus the step. + 3. Added commented out code to allow setting the selected star to always + be the top or bottom, etc. + (2/7/97, Valdes) + +stfprofile.x + 1. Added a minimum radius of 3 to stf_find. + 2. Added a error return if sum2 <= 0 in stf_find + 3. Added errchks in stf_widths for called procedures. + 4. Added error returns in stf_fit for bad profile or parameters. + (2/6/97, Valdes) + +t_starfocus.x + The parabola fitting routine would fail if the independent variable + (the focus values) became too large because a) use of real and b) + unscaled variables. The routine was revised for both these problems. + (10/24/96, Valdes) + +stfprofile.x +stfmeasure.x + Fixed bug in evaluation of enclosed flux profile in which the scaled + radius was used for the gaussian subtraction stage instead of pixels. + This does not currently affect IMEXAM because the scale is fixed + at 1. (8/29/96, Valdes) + +stfmeasure.x +stfprofile.x + Fixed incorrect datatype declaration "real np" -> "int np" in various + related places. (4/9/96, Valdes) + +stfmeasure.x - + 1. Restricted the peak pixel to be within the specified radius. + 2. Renamed file and procedures to avoid library conflict. + (3/14/96, Valdes) + +stfprofile.x + Minor bug fix that does not affect anything. (3/14/96, Valdes) + +kpnofocus.cl +starfocus.par +psfmeasure.par + Changed the defaults for radius=5, sbuffer=5, swidth=5 to try and make + IMEXAMINE and the PSF tasks measure the same thing by default. + (3/13/96, Valdes) + +stfprofile.x + Changed the centering routine to only use the data in the specified + radius rather than the extended region including the sky. (11/7/95, Valdes) + +stfmeasure.x +mkpkg + Added a routine which can be called separately to compute the + enclosed flux width or radius and the direct FWHM. (11/6/95, Valdes) + +stfprofile.x +starfocus.h + Added a computation of the direct FWHM. (11/6/95, Valdes) + +t_starfocus.x + Make a change to avoid reloading the image display when the specified + image name and the image name in the display are same apart from + the image extension. (6/26/95, Valdes) + +stfprofile.h +t_starfocus.x +stfprofile.x +starfocus.par +psfmeasure.par +kpnofocus.cl +starfocus.par +psfmeasure.par +kpnofocus.cl + Added saturation and ignore_sat parameters to allow flagging measurements + with saturated pixels and either ignoring them or including them but + showing them in the output log. (10/28/94, Valdes) + +t_starfocus.x + Fixed bug in interpreting the focus parameter. (9/15/94, Valdes) + +starfocus.h +t_starfocus.x +stfprofile.x +stfgraph.x +psfmeasure.par +starfocus.par +kpnofocus.cl +psfmeasure.hlp +starfocus.hlp +kpnofocus.hlp + Added an "iteration" parameter that, if greater than 1, uses the + previous FWHM estimate to adjust the "radius" parameter. (8/5/94, Valdes) + +psfmeasure.hlp +starfocus.hlp + Clarified the description of the imagecur parameter. (2/1/94, Valdes) + +t_starfocus.x +starfocus.h +starfocus.par +psfmeasure.par +kpnofocus.cl + +starfocus.hlp +psfmeasure.hlp +kpnofocus.hlp + 1. A new parameter, fstep, was added to STARFOCUS to allow specifying + the focus sequence as a starting value, by the focus parameters, + and a step. + 2. STARFOCUS was modified to allow specification of header keywords + for the focus (this was true previously), the focus step, + the number of exposures, and the multiple exposure shift. + This allows multiple exposure images to be completely header + drivien if the appropriate keywords are present. + 3. A new task KPNOFOCUS was added. This is a script calling + STARFOCUS with parameters set specifically for Kitt Peak + headers containing the focus parameters in the header. + Many of the parameters are fixed in the script and the task + parameters are then simpler. + 4. STARFOCUS/PSFMEASURE were modified to search all display frames + for the requested image rather than just frame 1. + 5. A new parameters, frame, was added to STARFOCUS/PSFMEASURE + to specify the display frame to load if necessary. Previously + it was always frame 1. + 7. In STARFOCUS the default number of steps was changed to 7 and + the default step size to 30. + (11/13/93, Valdes) +.endhelp diff --git a/noao/obsutil/src/starfocus/mkpkg b/noao/obsutil/src/starfocus/mkpkg new file mode 100644 index 00000000..3feffc76 --- /dev/null +++ b/noao/obsutil/src/starfocus/mkpkg @@ -0,0 +1,22 @@ +# Make the STARFOCUS tasks. + +$checkout libpkg.a ../ +$update libpkg.a +$checkin libpkg.a ../ +$exit + +standalone: + $update libpkg.a + $omake x_starfocus.x + $link x_starfocus.o libpkg.a -lxtools -lnlfit -liminterp -lgsurfit\ + -lds -o xx_starfocus.e + ; + +libpkg.a: + stfgraph.x starfocus.h + stfmeasure.x starfocus.h \ + + stfprofile.x starfocus.h \ + + t_starfocus.x starfocus.h + ; diff --git a/noao/obsutil/src/starfocus/psfhelp.key b/noao/obsutil/src/starfocus/psfhelp.key new file mode 100644 index 00000000..9e617a62 --- /dev/null +++ b/noao/obsutil/src/starfocus/psfhelp.key @@ -0,0 +1,60 @@ + PSFMEASURE COMMAND OPTIONS + + SUMMARY + +? Help m Magnitude r Redraw z Zoom +a Spatial n Normalize s Mag symbols Next +d Delete o Offset t Field radius +e Enclosed flux p Radial profile u Undelete +i Info q Quit x Delete + +:level :radius :show :xcenter +:overplot :scale :size :ycenter + + + CURSOR COMMANDS + +All plots may not be available depending on the number of stars. + +? Page this help information +a Spatial plot +d Delete star nearest to cursor +e Enclosed flux for all stars +i Information about star nearest the cursor +m Size and ellipticity vs relative magnitude +n Normalize enclosed flux at x cursor position +o Offset enclosed flux to x,y cursor position by adjusting background +p Radial profiles for all stars + Profiles are determined from the derivatives of the enclosed flux +q Quit +r Redraw +s Toggle magnitude symbols in spatial plot +t Size and ellipticity vs radius from field center +u Undelete all deleted points +x Delete nearest point or star (selected by query) +z Zoom to a single measurement showing enclosed flux and radial profile + Step through different stars in some plots + + + COLON COMMANDS + +A command without a value generally shows the current value of the +parameter while with a value it sets the value of the parameter. + +:level Level at which the size parameter is evaluated +:overplot Overplot the profiles from the narrowest profile? +:radius Change profile radius(*) +:show Page all information for the current set of objects +:size Size type (Radius|FWHM|GFWHM|MFWHM) (**) +:scale Pixel scale for size values +:xcenter X field center for radius from field center plots +:ycenter Y field center for radius from field center plots + +(*) The profile radius may not exceed the initial value set by the task + parameter. + +(**) +Radius = radius enclosing the fraction of the flux specified by "level" +FWHM = Full-width at half-maximum based on the radially smoothed profile +GFWHM = Full-width at half-maximum of Gaussian function fit to enclosed flux +MFWHM = Full-width at half-maximum of Moffat function fit to enclosed flux diff --git a/noao/obsutil/src/starfocus/psfmeasure.par b/noao/obsutil/src/starfocus/psfmeasure.par new file mode 100644 index 00000000..16dea3e9 --- /dev/null +++ b/noao/obsutil/src/starfocus/psfmeasure.par @@ -0,0 +1,24 @@ +# PSFMEASURE -- Measure PSF. + +images,s,a,,,,"List of images" +coords,s,h,"markall","center|mark1|markall",,"Object coordinates" +wcs,s,h,"logical","logical|physical|world",,"Coordinate system" +display,b,h,yes,,,"Display images?" +frame,i,h,1,1,,"Display frame to use +" +level,r,h,0.5,,,"Measurement level (fraction or percent)" +size,s,h,"FWHM","Radius|FWHM|GFWHM|MFWHM",,"Size to display" +beta,r,h,INDEF,2.1,,Moffat beta parameter +scale,r,h,1.,,,"Pixel scale" +radius,r,h,5.,,,"Measurement radius (pixels)" +sbuffer,r,h,5.,,,"Sky buffer (pixels)" +swidth,r,h,5.,,,"Sky width (pixels)" +saturation,r,h,INDEF,,,"Saturation level" +ignore_sat,b,h,no,,,"Ignore objects with saturated pixels?" +iterations,i,h,2,1,,"Number of radius adjustment iterations" +xcenter,r,h,INDEF,,,X field center (pixels) +ycenter,r,h,INDEF,,,X field center (pixels) +logfile,s,h,"logfile",,,"Logfile +" +imagecur,*imcur,h,"",,,"Image cursor input" +graphcur,*gcur,h,"",,,"Graphics cursor input" diff --git a/noao/obsutil/src/starfocus/starfocus.h b/noao/obsutil/src/starfocus/starfocus.h new file mode 100644 index 00000000..871e8c98 --- /dev/null +++ b/noao/obsutil/src/starfocus/starfocus.h @@ -0,0 +1,140 @@ +# STARFOCUS + +# Types of coordinates +define SF_TYPES "|center|mark1|markall|" +define SF_CENTER 1 # Star at center of image +define SF_MARK1 2 # Mark stars in first image +define SF_MARKALL 3 # Mark stars in all images + +# Task type +define STARFOCUS 1 +define PSFMEASURE 2 + +# Radius types +define SF_WTYPES "|Radius|FWHM|GFWHM|MFWHM|" + +define SF_RMIN 16 # Minimum centering search radius +define MAX_FRAMES 8 # Maximum number of display frames + +# Data structures for STARFOCUS + +define NBNDRYPIX 100 # Number of boundary pixels +define TYBNDRY BT_REFLECT # Type of boundary extension +define SAMPLE .2 # Subpixel sampling size +define SF_SZFNAME 79 # Length of file names +define SF_SZWTYPE 7 # Length of width type string + +# Main data structure +define SF 40 +define SF_TASK Memi[$1] # Task type +define SF_WTYPE Memc[P2C($1+1)] # Width type string +define SF_WCODE Memi[$1+5] # Width code +define SF_BETA Memr[P2R($1+6)] # Moffat beta +define SF_SCALE Memr[P2R($1+7)] # Pixel scale +define SF_LEVEL Memr[P2R($1+8)] # Profile measurement level +define SF_RADIUS Memr[P2R($1+9)] # Profile radius +define SF_SBUF Memr[P2R($1+10)]# Sky region buffer +define SF_SWIDTH Memr[P2R($1+11)]# Sky region width +define SF_SAT Memr[P2R($1+12)]# Saturation +define SF_NIT Memi[$1+13] # Number of iterations for radius +define SF_OVRPLT Memi[$1+14] # Overplot the best profile? +define SF_NCOLS Memi[$1+15] # Number of image columns +define SF_NLINES Memi[$1+16] # Number of image lines +define SF_XF Memr[P2R($1+17)]# X field center +define SF_YF Memr[P2R($1+18)]# Y field center +define SF_GP Memi[$1+19] # GIO pointer +define SF_F Memr[P2R($1+20)]# Best focus +define SF_W Memr[P2R($1+21)]# Width at best focus +define SF_M Memr[P2R($1+22)]# Brightest star magnitude +define SF_XP1 Memr[P2R($1+23)]# First derivative point to plot +define SF_XP2 Memr[P2R($1+24)]# Last derivative point to plot +define SF_YP1 Memr[P2R($1+25)]# Minimum of derivative profile +define SF_YP2 Memr[P2R($1+26)]# Maximum of derivative profile +define SF_N Memi[$1+27] # Number of points not deleted +define SF_NSFD Memi[$1+28] # Number of data points +define SF_SFDS Memi[$1+29] # Pointer to data structures +define SF_NS Memi[$1+30] # Number of stars not deleted +define SF_NSTARS Memi[$1+31] # Number of stars +define SF_STARS Memi[$1+32] # Pointer to star groups +define SF_NF Memi[$1+33] # Number of focuses not deleted +define SF_NFOCUS Memi[$1+34] # Number of different focus values +define SF_FOCUS Memi[$1+35] # Pointer to focus groups +define SF_NI Memi[$1+36] # Number of images not deleted +define SF_NIMAGES Memi[$1+37] # Number of images +define SF_IMAGES Memi[$1+38] # Pointer to image groups +define SF_BEST Memi[$1+39] # Pointer to best focus star + +define SF_SFD Memi[SF_SFDS($1)+$2-1] +define SF_SFS Memi[SF_STARS($1)+$2-1] +define SF_SFF Memi[SF_FOCUS($1)+$2-1] +define SF_SFI Memi[SF_IMAGES($1)+$2-1] + +# Basic data structure. +define SFD 94 +define SFD_IMAGE Memc[P2C($1)] # Image name +define SFD_DATA Memi[$1+40] # Pointer to real image raster +define SFD_RADIUS Memr[P2R($1+41)]# Profile radius +define SFD_NP Memi[$1+42] # Number of profile points +define SFD_NPMAX Memi[$1+43] # Maximum number of profile points +define SFD_X1 Memi[$1+44] # Image raster limits +define SFD_X2 Memi[$1+45] +define SFD_Y1 Memi[$1+46] +define SFD_Y2 Memi[$1+47] +define SFD_ID Memi[$1+48] # Star ID +define SFD_X Memr[P2R($1+49)]# Star X position +define SFD_Y Memr[P2R($1+50)]# Star Y position +define SFD_F Memr[P2R($1+51)]# Focus +define SFD_W Memr[P2R($1+52)]# Width to use +define SFD_M Memr[P2R($1+53)]# Magnitude +define SFD_E Memr[P2R($1+54)]# Ellipticity +define SFD_PA Memr[P2R($1+55)]# Position angle +define SFD_R Memr[P2R($1+56)]# Radius at given level +define SFD_DFWHM Memr[P2R($1+57)]# Direct FWHM +define SFD_GFWHM Memr[P2R($1+58)]# Gaussian FWHM +define SFD_MFWHM Memr[P2R($1+59)]# Moffat FWHM +define SFD_ASI1 Memi[$1+60] # Pointer to enclosed flux profile +define SFD_ASI2 Memi[$1+61] # Pointer to derivative profile +define SFD_YP1 Memr[P2R($1+62)]# Minimum of derivative profile +define SFD_YP2 Memr[P2R($1+63)]# Maximum of derivative profile +define SFD_FWHM Memr[P2R($1+$2+63)] # FWHM vs level=0.5*i (i=1-19) +define SFD_BKGD Memr[P2R($1+83)]# Background value +define SFD_BKGD1 Memr[P2R($1+84)]# Original background value +define SFD_MISO Memr[P2R($1+85)]# Moment isophote +define SFD_SIGMA Memr[P2R($1+86)]# Moffat alpha +define SFD_ALPHA Memr[P2R($1+87)]# Moffat alpha +define SFD_BETA Memr[P2R($1+88)]# Moffat beta +define SFD_STATUS Memi[$1+89] # Status +define SFD_NSAT Memi[$1+90] # Number of saturated pixels +define SFD_SFS Memi[$1+91] # Pointer to star group +define SFD_SFF Memi[$1+92] # Pointer to focus group +define SFD_SFI Memi[$1+93] # Pointer to image group + + +# Structure grouping data by star. +define SFS ($1+7) +define SFS_ID Memi[$1] # Star ID +define SFS_F Memr[P2R($1+1)] # Best focus +define SFS_W Memr[P2R($1+2)] # Best width +define SFS_M Memr[P2R($1+3)] # Average magnitude +define SFS_N Memi[$1+4] # Number of points used +define SFS_NF Memi[$1+5] # Number of focuses +define SFS_NSFD Memi[$1+6] # Number of data points +define SFS_SFD Memi[$1+$2+6] # Array of data structures + + +# Structure grouping stars by focus values. +define SFF ($1+5) +define SFF_F Memr[P2R($1)] # Focus +define SFF_W Memr[P2R($1+1)] # Average width +define SFF_N Memi[$1+2] # Number in average +define SFF_NI Memi[$1+3] # Number of images +define SFF_NSFD Memi[$1+4] # Number of data points +define SFF_SFD Memi[$1+$2+4] # Array of data structures + + +# Structure grouping stars by image. +define SFI ($1+42) +define SFI_IMAGE Memc[P2C($1)] # Image +define SFI_N Memi[$1+40] # Number in imagE +define SFI_NSFD Memi[$1+41] # Number of data points +define SFI_SFD Memi[$1+$2+41] # Array of data structures diff --git a/noao/obsutil/src/starfocus/starfocus.key b/noao/obsutil/src/starfocus/starfocus.key new file mode 100644 index 00000000..119e74a6 --- /dev/null +++ b/noao/obsutil/src/starfocus/starfocus.key @@ -0,0 +1,15 @@ + COMMAND OPTIONS + +? Page this help information. +g Measure object and graph the results. +m Measure object. +q Quit object marking and go to next image. + At the end of all images go to analysis of all measurements. + +:show Show the current results. + +When an object is measured the center and enclosed flux profile is determined. +When using the "mark1" option typing 'q' will measure all remaining images +at the same cursor positions while the "markall" option goes to the +next image until the image list is finished. If measuring only one +object with the 'g' key then a 'q' will exit the program. diff --git a/noao/obsutil/src/starfocus/starfocus.par b/noao/obsutil/src/starfocus/starfocus.par new file mode 100644 index 00000000..b1b1d5b0 --- /dev/null +++ b/noao/obsutil/src/starfocus/starfocus.par @@ -0,0 +1,32 @@ +# STARFOCUS -- Determine best star focus. + +images,s,a,,,,"List of images" +focus,s,h,"1x1",,,"Focus values" +fstep,s,h,"",,,"Focus step +" +nexposures,s,h,"1",,,"Number of exposures" +step,s,h,"30",,,"Step in pixels" +direction,s,h,"-line","-line|+line|-column|+column",,"Step direction" +gap,s,h,"end","none|beginning|end",,"Double step gap +" +coords,s,h,"mark1","center|mark1|markall",,"Object coordinates" +wcs,s,h,"logical","logical|physical|world",,"Coordinate system" +display,b,h,yes,,,"Display images?" +frame,i,h,1,1,,"Display frame to use +" +level,r,h,0.5,,,"Measurement level (fraction or percent)" +size,s,h,"FWHM","Radius|FWHM|GFWHM|MFWHM",,"Size to display" +beta,r,h,INDEF,2.1,,Moffat beta parameter +scale,r,h,1.,,,"Pixel scale" +radius,r,h,5.,,,"Measurement radius (pixels)" +sbuffer,r,h,5,,,"Sky buffer (pixels)" +swidth,r,h,5.,,,"Sky width (pixels)" +saturation,r,h,INDEF,,,"Saturation level" +ignore_sat,b,h,no,,,"Ignore objects with saturated pixels?" +iterations,i,h,2,1,,"Number of radius adjustment iterations" +xcenter,r,h,INDEF,,,X field center (pixels) +ycenter,r,h,INDEF,,,Y field center (pixels) +logfile,s,h,"logfile",,,"Logfile +" +imagecur,*imcur,h,"",,,"Image cursor input" +graphcur,*gcur,h,"",,,"Graphics cursor input" diff --git a/noao/obsutil/src/starfocus/stfgraph.x b/noao/obsutil/src/starfocus/stfgraph.x new file mode 100644 index 00000000..890dfc81 --- /dev/null +++ b/noao/obsutil/src/starfocus/stfgraph.x @@ -0,0 +1,2682 @@ +include +include +include +include "starfocus.h" + +# Interactive help files. There is one for STARFOCUS and one for PSFMEASUE. +define STFHELP "starfocus$stfhelp.key" +define PSFHELP "starfocus$psfhelp.key" +define PROMPT "Options" + +# View ports for all plots. +define VX1 .15 # Minimum X viewport for left graph +define VX2 .47 # Maximum X viewport for left graph +define VX3 .63 # Minimum X viewport for right graph +define VX4 .95 # Maximum X viewport for right graph +define VY1 .10 # Minimum Y viewport for bottom graph +define VY2 .44 # Minimum Y viewport for bottom graph +define VY3 .54 # Minimum Y viewport for top graph +define VY4 .88 # Maximum Y viewport for top graph + +# Miscellaneous graphics parameters. +define NMAX 5 # Maximum number of samples for labeling +define HLCOLOR 2 # Highlight color +define HLWIDTH 4. # Highlight width +define GM_MARK GM_CROSS # Point marker +define GM_MAG GM_PLUS+GM_CROSS # Magnitude marker + + +# STF_GRAPH -- Interactive graphing of results. + +procedure stf_graph (sf) + +pointer sf #I Starfocus structure + +real wx, wy, x, y, r2, r2min, fa[8] +int i, j, ix, iy, nx, ny, wcs, key, pkey, skey, redraw, clgcur() +pointer sp, sysidstr, title, cmd, gp, gopen() +pointer sfd, sfs, sff, current, nearest + +data fa/0.,1.,1.,0.,0.,0.,1.,1./ + +begin + call smark (sp) + call salloc (sysidstr, SZ_LINE, TY_CHAR) + call salloc (title, SZ_LINE, TY_CHAR) + call salloc (cmd, SZ_LINE, TY_CHAR) + + # Set system id label + call sysid (Memc[sysidstr], SZ_LINE) + + # Open graphics and enter interactive graphics loop + SF_GP(sf) = gopen ("stdgraph", NEW_FILE, STDGRAPH) + gp = SF_GP(sf) + wcs = 0 + if (SF_NF(sf) > 1) + key = 'f' + else if (SF_NS(sf) > 1) + key = 'a' + else + key = 'z' + pkey = 0 + skey = 1 + current = SF_BEST(sf) + repeat { + switch (key) { + case 'q': # Quit + break + case '?': # Help + if (SF_TASK(sf) == PSFMEASURE) + call gpagefile (gp, PSFHELP, PROMPT) + else + call gpagefile (gp, STFHELP, PROMPT) + next + case ':': # Colon commands + iferr (call stf_colon (sf, Memc[cmd], redraw)) + redraw = NO + if (redraw == NO) + next + case 'a', 'b', 'e', 'f', 'g', 'm', 'p', 't', 'z': # Plots + # When there is not enough data for the requested plot + # map the key to another one. This is done mostly to + # avoid redrawing the same graph when different keys + # map to the same pkey. The 'e', 'g', and 'p' key may + # select a different object so the check for the same + # plot is deferred. + + if (SF_NS(sf) > 1 && SF_NF(sf) > 1) { + ; + } else if (SF_NS(sf) > 1) { + if (key == 'b') + key = 'a' + if (key == 'f') + key = 'm' + } else if (SF_NF(sf) > 1) { + if (key == 'a' || key == 'b' || key == 'm' || key == 't') + key = 'f' + } else { + key = 'z' + } + + switch (key) { + case 'e', 'g', 'p': + ; + default: + if (key == pkey) + next + } + case 's': # Toggle plotting of magnitude symbols + if (pkey != 'a' && pkey != 'b') + next + skey = mod (skey+1, 2) + case 'u': # Undelete all + j = 0 + do i = 1, SF_NSFD(sf) { + sfd = SF_SFD(sf,i) + if (SFD_STATUS(sfd) != 0) { + SFD_STATUS(sfd) = 0 + j = j + 1 + } + } + if (j == 0) + next + call stf_fitfocus (sf) + case 'd', 'n', 'o', 'r', 'x', 'i', ' ': # Misc + ; + default: # Unknown + call printf ("\007") + next + } + + # Find the nearest or next object if needed. + switch (key) { + case 'r', 's', 'u', ':': # Redraw last graph + pkey = pkey + nearest = current + case 'n', 'o': # Renormalize enclosed flux profile + if (wcs != 7 || pkey == 'p') + next + pkey = pkey + nearest = current + if (key == 'n') + call stf_norm (sf, nearest, wx, INDEF) + else + call stf_norm (sf, nearest, wx, wy) + call stf_widths (sf, nearest) + call stf_fwhms (sf, nearest) + call stf_fitfocus (sf) + case ' ': # Select next focus or star + switch (pkey) { + case 'a', 'm', 't': + sff = SFD_SFF(current) + for (i=1; SF_SFF(sf,i)!=sff; i=i+1) + ; + j = SF_NFOCUS(sf) + i = mod (i, j) + 1 + for (; SFF_N(SF_SFF(sf,i))==0; i=mod(i,j)+1) + ; + if (SF_SFF(sf,i) == sff) + next + sff = SF_SFF(sf,i) + do i = 1, SFF_NSFD(sff) { + nearest = SFF_SFD(sff,i) + if (SFD_STATUS(nearest) == 0) + break + } + case 'e', 'g', 'p', 'z': + switch (wcs) { + case 7, 8, 11: + for (i=1; SF_SFD(sf,i)!=current; i=i+1) + ; + j = SF_NSFD(sf) + i = mod (i, j) + 1 + for (; SFD_STATUS(SF_SFD(sf,i))!=0; i=mod(i,j)+1) + ; + nearest = SF_SFD(sf,i) + case 9: + sfs = SFD_SFS(current) + for (i=1; SFS_SFD(sfs,i)!=current; i=i+1) + ; + j = SFS_NSFD(sfs) + i = mod (i, j) + 1 + for (; SFD_STATUS(SFS_SFD(sfs,i))!=0; i=mod(i,j)+1) + ; + nearest = SFS_SFD(sfs,i) + if (nearest == current) + next + case 10: + sff = SFD_SFF(current) + for (i=1; SFF_SFD(sff,i)!=current; i=i+1) + ; + j = SFF_NSFD(sff) + i = mod (i, j) + 1 + for (; SFD_STATUS(SFF_SFD(sff,i))!=0; i=mod(i,j)+1) + ; + nearest = SFF_SFD(sff,i) + if (nearest == current) + next + } + default: + next + } + default: # Select nearest to cursor + switch (pkey) { + case 'a': + r2min = MAX_REAL + call gctran (gp, wx, wy, wx, wy, wcs, 0) + sff = SFD_SFF(current) + do i = 1, SFF_NSFD(sff) { + sfd = SFF_SFD(sff,i) + if (SFD_STATUS(sfd) != 0) + next + switch (wcs) { + case 1: + x = SFD_X(sfd) + y = SFD_Y(sfd) + case 2: + x = SFD_X(sfd) + y = SFD_W(sfd) + case 3: + x = SFD_W(sfd) + y = SFD_Y(sfd) + case 4: + x = SFD_X(sfd) + y = SFD_E(sfd) + case 5: + x = SFD_E(sfd) + y = SFD_Y(sfd) + } + call gctran (gp, x, y, x, y, wcs, 0) + r2 = (x-wx)**2 + (y-wy)**2 + if (r2 < r2min) { + r2min = r2 + nearest = sfd + } + } + case 'b': + r2min = MAX_REAL + call gctran (gp, wx, wy, wx, wy, wcs, 0) + do i = 1, SF_NSTARS(sf) { + sfs = SF_SFS(sf,i) + if (SFS_N(sfs) == 0) + next + switch (wcs) { + case 1: + x = SFD_X(SFS_SFD(sfs,1)) + y = SFD_Y(SFS_SFD(sfs,1)) + case 2: + x = SFD_X(SFS_SFD(sfs,1)) + y = SFS_W(sfs) + case 3: + x = SFS_W(sfs) + y = SFD_Y(SFS_SFD(sfs,1)) + case 4: + x = SFD_X(SFS_SFD(sfs,1)) + y = SFS_F(sfs) + case 5: + x = SFS_F(sfs) + y = SFD_Y(SFS_SFD(sfs,1)) + } + call gctran (gp, x, y, x, y, wcs, 0) + r2 = (x-wx)**2 + (y-wy)**2 + if (r2 < r2min) { + r2min = r2 + nearest = sfs + } + } + sfs = nearest + r2min = MAX_REAL + do i = 1, SFS_NSFD(sfs) { + sfd = SFS_SFD(sfs,i) + if (SFD_STATUS(sfd) != 0) + next + r2 = SFD_W(sfd) + if (r2 < r2min) { + r2min = r2 + nearest = sfd + } + } + case 'e', 'g', 'p': + switch (wcs) { + case 9: + sfs = SFD_SFS(current) + i = SFS_N(sfs) + if (i < 4) { + nx = i + ny = 1 + } else { + nx = nint (sqrt (real (i))) + if (mod (i-1, nx+1) >= mod (i-1, nx)) + nx = nx + 1 + ny = (i - 1) / nx + 1 + } + ix = max (1, min (nx, nint(wx))) + iy = max (1, min (ny, nint(wy))) + + j = 0 + do i = 1, SFS_NSFD(sfs) { + sfd = SFS_SFD(sfs, i) + if (SFD_STATUS(sfd) != 0) + next + if (ix == 1 + mod (j, nx) && iy == 1 + j / nx) { + nearest = sfd + break + } + j = j + 1 + } + case 10: + sff = SFD_SFF(current) + i = SFF_N(sff) + if (i < 4) { + nx = i + ny = 1 + } else { + nx = nint (sqrt (real (i))) + if (mod (i-1, nx+1) >= mod (i-1, nx)) + nx = nx + 1 + ny = (i - 1) / nx + 1 + } + ix = max (1, min (nx, nint(wx))) + iy = max (1, min (ny, nint(wy))) + + j = 0 + do i = 1, SFF_NSFD(sff) { + sfd = SFF_SFD(sff, i) + if (SFD_STATUS(sfd) != 0) + next + if (ix == 1 + mod (j, nx) && iy == 1 + j / nx) { + nearest = sfd + break + } + j = j + 1 + } + } + if (key == pkey && nearest == current) + next + default: + switch (wcs) { + case 1, 2: + r2min = MAX_REAL + call gctran (gp, wx, wy, wx, wy, wcs, 0) + do i = 1, SF_NSFD(sf) { + sfd = SF_SFD(sf,i) + if (SFD_STATUS(sfd) != 0) + next + switch (wcs) { + case 1: + x = SFD_F(sfd) + y = SFD_W(sfd) + case 2: + x = SFD_F(sfd) + y = SFD_E(sfd) + } + call gctran (gp, x, y, x, y, wcs, 0) + r2 = (x-wx)**2 + (y-wy)**2 + if (r2 < r2min) { + r2min = r2 + nearest = sfd + } + } + case 3, 4, 5, 6: + r2min = MAX_REAL + call gctran (gp, wx, wy, wx, wy, wcs, 0) + sff = SFD_SFF(current) + do i = 1, SFF_NSFD(sff) { + sfd = SFF_SFD(sff,i) + if (SFD_STATUS(sfd) != 0) + next + switch (wcs) { + case 3: + x = -2.5 * log10 (SFS_M(SFD_SFS(sfd))/SF_M(sf)) + y = SFD_W(sfd) + case 4: + x = -2.5 * log10 (SFS_M(SFD_SFS(sfd))/SF_M(sf)) + y = SFD_E(sfd) + case 5: + x = sqrt ((SFD_X(sfd) - SF_XF(sf)) ** 2 + + (SFD_Y(sfd) - SF_YF(sf)) ** 2) + y = SFD_W(sfd) + case 6: + x = sqrt ((SFD_X(sfd) - SF_XF(sf)) ** 2 + + (SFD_Y(sfd) - SF_YF(sf)) ** 2) + y = SFD_E(sfd) + } + call gctran (gp, x, y, x, y, wcs, 0) + r2 = (x-wx)**2 + (y-wy)**2 + if (r2 < r2min) { + r2min = r2 + nearest = sfd + } + } + default: + nearest = current + } + } + + # Act on selection for delete or info. + switch (key) { + case 'd': + if (SF_NS(sf) > 1) { + sfs = SFD_SFS(nearest) + do i = 1, SFS_NSFD(sfs) + SFD_STATUS(SFS_SFD(sfs,i)) = 1 + } else + SFD_STATUS(nearest) = 1 + call stf_fitfocus (sf) + case 'x': + repeat { + switch (key) { + case 'f': + sff = SFD_SFF(nearest) + do i = 1, SFF_NSFD(sff) + SFD_STATUS(SFF_SFD(sff,i)) = 1 + case 'i': + sfd = SFD_SFI(nearest) + do i = 1, SFI_NSFD(sfd) + SFD_STATUS(SFI_SFD(sfd,i)) = 1 + case 'p': + SFD_STATUS(nearest) = 1 + case 's': + sfs = SFD_SFS(nearest) + do i = 1, SFS_NSFD(sfs) + SFD_STATUS(SFS_SFD(sfs,i)) = 1 + default: + call printf ( + "Delete image, star, focus, or point? (i|s|f|p)") + next + } + call stf_fitfocus (sf) + break + } until (clgcur ("graphcur", + wx, wy, wcs, key, Memc[cmd], SZ_LINE) == EOF) + case 'i': + switch (pkey) { + case 'b': + sfs = SFD_SFS(nearest) + call stf_title (sf, NULL, sfs, NULL, + Memc[title], SZ_LINE) + default: + call stf_title (sf, nearest, NULL, NULL, + Memc[title], SZ_LINE) + } + call printf ("%s\n") + call pargstr (Memc[title]) + next + default: + pkey = key + } + } + + # If current object has been deleted select another. + if (SFD_STATUS(nearest) == 0) + current = nearest + else + current = SF_BEST(sf) + + # Make the graphs. The graph depends on the number of stars + # and number of focus values. Note that the pkey has already + # been mapped but all the keys are shown for clarity. + + call gclear (gp) + call gseti (gp, G_FACOLOR, 0) + + if (SF_NS(sf) > 1 && SF_NF(sf) > 1) { + switch (pkey) { + case 'a': + sff = SFD_SFF(current) + call stf_title (sf, NULL, NULL, sff, Memc[title], SZ_LINE) + call gseti (gp, G_WCS, 1) + call gsview (gp, VX1, VX4, VY1, VY4) + call stf_g11 (sf, current, skey, Memc[title]) + case 'b': + call sprintf (Memc[title], SZ_LINE, + "Best focus estimates for each star") + call gseti (gp, G_WCS, 1) + call gsview (gp, VX1, VX4, VY1, VY4) + call stf_g12 (sf, current, skey, Memc[title]) + case 'e': + sfs = SFD_SFS(current) + call sprintf (Memc[title], SZ_LINE, + "Star: x=%.2f, y=%.2f, m=%.2f") + call pargr (SFD_X(current)) + call pargr (SFD_Y(current)) + call pargr (-2.5 * log10 (SFS_M(sfs) / SF_M(sf))) + call gseti (gp, G_WCS, 9) + call gsview (gp, VX1, VX4, VY3, VY4) + call stf_g2 (sf, current, Memc[title]) + sff = SFD_SFF(current) + call stf_title (sf, NULL, NULL, sff, Memc[title], SZ_LINE) + call gseti (gp, G_WCS, 10) + call gsview (gp, VX1, VX4, VY1, VY2) + call stf_g3 (sf, current, Memc[title]) + case 'f': + call gseti (gp, G_WCS, 1) + call gsview (gp, VX1, VX4, VY3, VY4) + call stf_g1 (sf, current, 'f', 'r', "", "", SF_WTYPE(sf)) + call gseti (gp, G_WCS, 2) + call gsview (gp, VX1, VX4, VY1, VY2) + call gfill (gp, fa, fa[5], 4, GF_SOLID) + call stf_g1 (sf, current, 'f', 'e', "", "Focus", + "Ellipticity") + case 'g': + sfs = SFD_SFS(current) + call sprintf (Memc[title], SZ_LINE, + "Star: x=%.2f, y=%.2f, m=%.2f") + call pargr (SFD_X(current)) + call pargr (SFD_Y(current)) + call pargr (-2.5 * log10 (SFS_M(sfs) / SF_M(sf))) + call gseti (gp, G_WCS, 9) + call gsview (gp, VX1, VX4, VY3, VY4) + call stf_g9 (sf, current, Memc[title]) + sff = SFD_SFF(current) + call stf_title (sf, NULL, NULL, sff, Memc[title], SZ_LINE) + call gseti (gp, G_WCS, 10) + call gsview (gp, VX1, VX4, VY1, VY2) + call stf_g10 (sf, current, Memc[title]) + case 'm': + sff = SFD_SFF(current) + call stf_title (sf, NULL, NULL, sff, Memc[title], SZ_LINE) + call gseti (gp, G_WCS, 3) + call gsview (gp, VX1, VX4, VY3, VY4) + call stf_g1 (sf, current, 'm', 'r', Memc[title], + "", SF_WTYPE(sf)) + call gseti (gp, G_WCS, 4) + call gsview (gp, VX1, VX4, VY1, VY2) + call gfill (gp, fa, fa[5], 4, GF_SOLID) + call stf_g1 (sf, current, 'm', 'e', "", "Magnitude", + "Ellipticity") + case 'p': + sfs = SFD_SFS(current) + call sprintf (Memc[title], SZ_LINE, + "Star: x=%.2f, y=%.2f, m=%.2f") + call pargr (SFD_X(current)) + call pargr (SFD_Y(current)) + call pargr (-2.5 * log10 (SFS_M(sfs) / SF_M(sf))) + call gseti (gp, G_WCS, 9) + call gsview (gp, VX1, VX4, VY3, VY4) + call stf_g4 (sf, current, Memc[title]) + sff = SFD_SFF(current) + call stf_title (sf, NULL, NULL, sff, Memc[title], SZ_LINE) + call gseti (gp, G_WCS, 10) + call gsview (gp, VX1, VX4, VY1, VY2) + call stf_g5 (sf, current, Memc[title]) + case 't': + sff = SFD_SFF(current) + call stf_title (sf, NULL, NULL, sff, Memc[title], SZ_LINE) + call gseti (gp, G_WCS, 5) + call gsview (gp, VX1, VX4, VY3, VY4) + call stf_g1 (sf, current, 't', 'r', Memc[title], + "", SF_WTYPE(sf)) + call gseti (gp, G_WCS, 6) + call gsview (gp, VX1, VX4, VY1, VY2) + call gfill (gp, fa, fa[5], 4, GF_SOLID) + call stf_g1 (sf, current, 't', 'e', "", "Field radius", + "Ellipticity") + case 'z': + call gseti (gp, G_WCS, 7) + call gsview (gp, VX1, VX2, VY3, VY4) + call stf_g6 (sf, current, "", "", "Enclosed flux") + call gseti (gp, G_WCS, 8) + call gsview (gp, VX1, VX2, VY1, VY2) + call gfill (gp, fa, fa[5], 4, GF_SOLID) + call stf_g7 (sf, current, "", "Radius", "Profile") + call gseti (gp, G_WCS, 11) + call gsview (gp, VX3, VX4, VY3, VY4) + call gfill (gp, fa, fa[5], 4, GF_SOLID) + call stf_g8 (sf, current, "", "Enclosed flux", "FWHM") + + call stf_title (sf, current, NULL, NULL, Memc[title], + SZ_LINE) + call gseti (gp, G_WCS, 0) + call gsetr (gp, G_PLWIDTH, 2.0) + call gline (gp, 0., 0., 0., 0.) + call gtext (gp, 0.5, 0.93, Memc[title], "h=c,v=t") + } + } else if (SF_NS(sf) > 1) { + switch (pkey) { + case 'a', 'b': + sff = SFD_SFF(current) + call stf_title (sf, NULL, NULL, sff, Memc[title], SZ_LINE) + call gseti (gp, G_WCS, 1) + call gsview (gp, VX1, VX4, VY1, VY4) + call stf_g11 (sf, current, skey, Memc[title]) + case 'e': + sff = SFD_SFF(current) + call stf_title (sf, NULL, NULL, sff, Memc[title], SZ_LINE) + call gseti (gp, G_WCS, 10) + call gsview (gp, VX1, VX4, VY3, VY4) + call stf_g3 (sf, current, Memc[title]) + call stf_title (sf, current, NULL, NULL, Memc[title], + SZ_LINE) + call gseti (gp, G_WCS, 7) + call gsview (gp, VX1, VX4, VY1, VY2) + call gfill (gp, fa, fa[5], 4, GF_SOLID) + call stf_g6 (sf, current, Memc[title], "Radius", + "Enclosed flux") + case 'f', 'm': + sff = SFD_SFF(current) + call stf_title (sf, NULL, NULL, sff, Memc[title], SZ_LINE) + call gseti (gp, G_WCS, 3) + call gsview (gp, VX1, VX4, VY3, VY4) + call stf_g1 (sf, current, 'm', 'r', Memc[title], "", + SF_WTYPE(sf)) + call gseti (gp, G_WCS, 4) + call gsview (gp, VX1, VX4, VY1, VY2) + call gfill (gp, fa, fa[5], 4, GF_SOLID) + call stf_g1 (sf, current, 'm', 'e', "", "Magnitude", + "Ellipticity") + case 'g': + sff = SFD_SFF(current) + call stf_title (sf, NULL, NULL, sff, Memc[title], SZ_LINE) + call gseti (gp, G_WCS, 10) + call gsview (gp, VX1, VX4, VY3, VY4) + call stf_g10 (sf, current, Memc[title]) + call stf_title (sf, current, NULL, NULL, Memc[title], + SZ_LINE) + call gseti (gp, G_WCS, 11) + call gsview (gp, VX1, VX4, VY1, VY2) + call gfill (gp, fa, fa[5], 4, GF_SOLID) + call stf_g8 (sf, current, Memc[title], "Enclosed flux", + "FWHM") + case 'p': + sff = SFD_SFF(current) + call stf_title (sf, NULL, NULL, sff, Memc[title], SZ_LINE) + call gseti (gp, G_WCS, 10) + call gsview (gp, VX1, VX4, VY3, VY4) + call stf_g5 (sf, current, Memc[title]) + call stf_title (sf, current, NULL, NULL, Memc[title], + SZ_LINE) + call gseti (gp, G_WCS, 7) + call gsview (gp, VX1, VX4, VY1, VY2) + call gfill (gp, fa, fa[5], 4, GF_SOLID) + call stf_g7 (sf, current, Memc[title], "Radius", "Profile") + case 't': + sff = SFD_SFF(current) + call stf_title (sf, NULL, NULL, sff, Memc[title], SZ_LINE) + call gseti (gp, G_WCS, 5) + call gsview (gp, VX1, VX4, VY3, VY4) + call stf_g1 (sf, current, 't', 'r', Memc[title], "", + SF_WTYPE(sf)) + call gseti (gp, G_WCS, 6) + call gsview (gp, VX1, VX4, VY1, VY2) + call gfill (gp, fa, fa[5], 4, GF_SOLID) + call stf_g1 (sf, current, 't', 'e', "", "Field radius", + "Ellipticity") + case 'z': + call gseti (gp, G_WCS, 7) + call gsview (gp, VX1, VX2, VY3, VY4) + call stf_g6 (sf, current, "", "", "Enclosed flux") + call gseti (gp, G_WCS, 8) + call gsview (gp, VX1, VX2, VY1, VY2) + call gfill (gp, fa, fa[5], 4, GF_SOLID) + call stf_g7 (sf, current, "", "Radius", "Profile") + call gseti (gp, G_WCS, 11) + call gsview (gp, VX3, VX4, VY3, VY4) + call gfill (gp, fa, fa[5], 4, GF_SOLID) + call stf_g8 (sf, current, "", "Enclosed flux", "FWHM") + + call stf_title (sf, current, NULL, NULL, Memc[title], + SZ_LINE) + call gseti (gp, G_WCS, 0) + call gsetr (gp, G_PLWIDTH, 2.0) + call gline (gp, 0., 0., 0., 0.) + call gtext (gp, 0.5, 0.93, Memc[title], "h=c,v=t") + } + } else if (SF_NF(sf) > 1) { + switch (pkey) { + case 'a', 'b', 'f', 'm', 't': + call gseti (gp, G_WCS, 1) + call gsview (gp, VX1, VX4, VY3, VY4) + call stf_g1 (sf, current, 'f', 'r', "", "", SF_WTYPE(sf)) + call gseti (gp, G_WCS, 2) + call gsview (gp, VX1, VX4, VY1, VY2) + call gfill (gp, fa, fa[5], 4, GF_SOLID) + call stf_g1 (sf, current, 'f', 'e', "", "Focus", + "Ellipticity") + case 'e': + sfs = SFD_SFS(current) + call sprintf (Memc[title], SZ_LINE, + "Star: x=%.2f, y=%.2f, m=%.2f") + call pargr (SFD_X(current)) + call pargr (SFD_Y(current)) + call pargr (-2.5 * log10 (SFS_M(sfs) / SF_M(sf))) + call gseti (gp, G_WCS, 9) + call gsview (gp, VX1, VX4, VY3, VY4) + call stf_g2 (sf, current, Memc[title]) + call stf_title (sf, current, NULL, NULL, Memc[title], + SZ_LINE) + call gseti (gp, G_WCS, 7) + call gsview (gp, VX1, VX4, VY1, VY2) + call gfill (gp, fa, fa[5], 4, GF_SOLID) + call stf_g6 (sf, current, Memc[title], "Radius", + "Enclosed flux") + case 'g': + sfs = SFD_SFS(current) + call sprintf (Memc[title], SZ_LINE, + "Star: x=%.2f, y=%.2f, m=%.2f") + call pargr (SFD_X(current)) + call pargr (SFD_Y(current)) + call pargr (-2.5 * log10 (SFS_M(sfs) / SF_M(sf))) + call gseti (gp, G_WCS, 9) + call gsview (gp, VX1, VX4, VY3, VY4) + call stf_g9 (sf, current, Memc[title]) + call stf_title (sf, current, NULL, NULL, Memc[title], + SZ_LINE) + call gseti (gp, G_WCS, 11) + call gsview (gp, VX1, VX4, VY1, VY2) + call gfill (gp, fa, fa[5], 4, GF_SOLID) + call stf_g8 (sf, current, Memc[title], "Enclosed flux", + "FWHM") + case 'p': + sfs = SFD_SFS(current) + call sprintf (Memc[title], SZ_LINE, + "Star: x=%.2f, y=%.2f, m=%.2f") + call pargr (SFD_X(current)) + call pargr (SFD_Y(current)) + call pargr (-2.5 * log10 (SFS_M(sfs) / SF_M(sf))) + call gseti (gp, G_WCS, 9) + call gsview (gp, VX1, VX4, VY3, VY4) + call stf_g4 (sf, current, Memc[title]) + call stf_title (sf, current, NULL, NULL, Memc[title], + SZ_LINE) + call gseti (gp, G_WCS, 7) + call gsview (gp, VX1, VX4, VY1, VY2) + call gfill (gp, fa, fa[5], 4, GF_SOLID) + call stf_g7 (sf, current, Memc[title], "Radius", + "profile") + case 'z': + call gseti (gp, G_WCS, 7) + call gsview (gp, VX1, VX2, VY3, VY4) + call stf_g6 (sf, current, "", "", "Enclosed flux") + call gseti (gp, G_WCS, 8) + call gsview (gp, VX1, VX2, VY1, VY2) + call gfill (gp, fa, fa[5], 4, GF_SOLID) + call stf_g7 (sf, current, "", "Radius", "Profile") + call gseti (gp, G_WCS, 11) + call gsview (gp, VX3, VX4, VY3, VY4) + call gfill (gp, fa, fa[5], 4, GF_SOLID) + call stf_g8 (sf, current, "", "Enclosed flux", "FWHM") + + call stf_title (sf, current, NULL, NULL, Memc[title], + SZ_LINE) + call gseti (gp, G_WCS, 0) + call gsetr (gp, G_PLWIDTH, 2.0) + call gline (gp, 0., 0., 0., 0.) + call gtext (gp, 0.5, 0.93, Memc[title], "h=c,v=t") + } + } else { + switch (pkey) { + case 'a', 'b', 'f', 'm', 'p', 'z', 'e', 't': + call gseti (gp, G_WCS, 7) + call gsview (gp, VX1, VX2, VY3, VY4) + call stf_g6 (sf, current, "", "", "Enclosed flux") + call gseti (gp, G_WCS, 8) + call gsview (gp, VX1, VX2, VY1, VY2) + call gfill (gp, fa, fa[5], 4, GF_SOLID) + call stf_g7 (sf, current, "", "Radius", "Profile") + call gseti (gp, G_WCS, 11) + call gsview (gp, VX3, VX4, VY3, VY4) + call gfill (gp, fa, fa[5], 4, GF_SOLID) + call stf_g8 (sf, current, "", "Enclosed flux", "FWHM") + + call stf_title (sf, current, NULL, NULL, Memc[title], + SZ_LINE) + call gseti (gp, G_WCS, 0) + call gsetr (gp, G_PLWIDTH, 2.0) + call gline (gp, 0., 0., 0., 0.) + call gtext (gp, 0.5, 0.93, Memc[title], "h=c,v=t") + } + } + + # Add banner title. + call stf_title (sf, NULL, NULL, NULL, Memc[title], SZ_LINE) + call gseti (gp, G_WCS, 0) + call gsetr (gp, G_PLWIDTH, 2.0) + call gline (gp, 0., 0., 0., 0.) + call gtext (gp, 0.5, 0.99, Memc[sysidstr], "h=c,v=t") + call gtext (gp, 0.5, 0.96, Memc[title], "h=c,v=t") + + if (SF_NSFD(sf) == 1) + break + + } until (clgcur ("graphcur", wx, wy, wcs, key, Memc[cmd], SZ_LINE)==EOF) + + call gclose (gp) + call sfree (sp) +end + + +# List of colon commands. +define CMDS "|show|level|size|scale|radius|xcenter|ycenter\ + |overplot|beta|" +define SHOW 1 # Show current results +define LEVEL 2 # Measurement level +define SIZE 3 # Size type +define SCALE 4 # Pixel scale +define RADIUS 5 # Maximum radius +define XCENTER 6 # X field center +define YCENTER 7 # Y field center +define OVERPLOT 8 # Overplot best profile +define BETA 9 # Beta value for Moffat function + +# STF_COLON -- Respond to colon command. + +procedure stf_colon (sf, cmd, redraw) + +pointer sf #I Starfocus pointer +char cmd[ARB] #I Colon command +int redraw #O Redraw? + +bool bval +real rval, stf_r2i() +int i, j, ncmd, nscan(), strdic(), open(), btoi() +pointer sp, str, sfd +errchk open, delete, stf_log, stf_norm, stf_radius, stf_fitfocus + +begin + call smark (sp) + call salloc (str, SZ_FNAME, TY_CHAR) + + # Scan the command string and get the first word. + call sscan (cmd) + call gargwrd (Memc[str], SZ_FNAME) + ncmd = strdic (Memc[str], Memc[str], SZ_FNAME, CMDS) + + switch (ncmd) { + case SHOW: + call gargwrd (Memc[str], SZ_FNAME) + iferr { + if (nscan() == 1) { + call mktemp ("tmp$iraf", Memc[str], SZ_FNAME) + i = open (Memc[str], APPEND, TEXT_FILE) + call stf_log (sf, i) + call close (i) + call gpagefile (SF_GP(sf), Memc[str], "starfocus") + call delete (Memc[str]) + } else { + i = open (Memc[str], APPEND, TEXT_FILE) + call stf_log (sf, i) + call close (i) + } + } then + call erract (EA_WARN) + redraw = NO + case LEVEL: + call gargr (rval) + if (nscan() == 2) { + if (rval > 1.) + rval = rval / 100. + SF_LEVEL(sf) = max (0.05, min (0.95, rval)) + do i = 1, SF_NSFD(sf) { + sfd = SF_SFD(sf,i) + call stf_radius (sf, sfd, SF_LEVEL(sf), SFD_R(sfd)) + } + if (SF_WCODE(sf) == 1) + call stf_fitfocus (sf) + redraw = YES + } else { + call printf ("level %g\n") + call pargr (SF_LEVEL(sf)) + redraw = NO + } + case SIZE: + call gargwrd (Memc[str], SZ_FNAME) + if (nscan() == 2) { + ncmd = strdic (Memc[str], Memc[str], SZ_FNAME, SF_WTYPES) + if (ncmd == 0) { + call eprintf ("Invalid size type\n") + redraw = NO + } else { + call strcpy (Memc[str], SF_WTYPE(sf), SF_SZWTYPE) + SF_WCODE(sf) = ncmd + do i = 1, SF_NSFD(sf) { + sfd = SF_SFD(sf,i) + switch (SF_WCODE(sf)) { + case 1: + SFD_W(sfd) = SFD_R(sfd) + case 2: + SFD_W(sfd) = SFD_DFWHM(sfd) + case 3: + SFD_W(sfd) = SFD_GFWHM(sfd) + case 4: + SFD_W(sfd) = SFD_MFWHM(sfd) + } + call stf_fwhms (sf, sfd) + } + call stf_fitfocus (sf) + redraw = YES + } + } else { + call printf ("size %s\n") + call pargstr (SF_WTYPE(sf)) + redraw = NO + } + case SCALE: + call gargr (rval) + if (nscan() == 2) { + rval = rval / SF_SCALE(sf) + SF_SCALE(sf) = SF_SCALE(sf) * rval + do i = 1, SF_NSFD(sf) { + sfd = SF_SFD(sf,i) + switch (SF_WCODE(sf)) { + case 1: + SFD_R(sfd) = SFD_R(sfd) * rval + SFD_W(sfd) = SFD_R(sfd) + case 2: + SFD_DFWHM(sfd) = SFD_DFWHM(sfd) * rval + SFD_W(sfd) = SFD_DFWHM(sfd) + case 3: + SFD_SIGMA(sfd) = SFD_SIGMA(sfd) * rval + SFD_GFWHM(sfd) = SFD_GFWHM(sfd) * rval + SFD_W(sfd) = SFD_GFWHM(sfd) + case 4: + SFD_ALPHA(sfd) = SFD_ALPHA(sfd) * rval + SFD_MFWHM(sfd) = SFD_MFWHM(sfd) * rval + SFD_W(sfd) = SFD_MFWHM(sfd) + } + do j = 1, 19 + SFD_FWHM(sfd,j) = SFD_FWHM(sfd,j) * rval + } + do i = 1, SF_NSTARS(sf) { + sfd = SF_SFS(sf,i) + SFS_W(sfd) = SFS_W(sfd) * rval + } + do i = 1, SF_NFOCUS(sf) { + sfd = SF_SFF(sf,i) + SFF_W(sfd) = SFF_W(sfd) * rval + } + SF_W(sf) = SF_W(sf) * rval + redraw = YES + } else { + call printf ("scale %g\n") + call pargr (SF_SCALE(sf)) + redraw = NO + } + case RADIUS: + call gargr (rval) + if (nscan() == 2) { + j = stf_r2i (rval) + 1 + SF_RADIUS(sf) = rval + do i = 1, SF_NSFD(sf) { + sfd = SF_SFD(sf,i) + if (j > SFD_NPMAX(sfd)) + next + SFD_NP(sfd) = j + SFD_RADIUS(sf) = SF_RADIUS(sf) + call stf_norm (sf, sfd, INDEF, INDEF) + call stf_widths (sf, sfd) + call stf_fwhms (sf, sfd) + } + call stf_fitfocus (sf) + redraw = YES + } else { + call printf ("radius %g\n") + call pargr (SF_RADIUS(sf)) + redraw = NO + } + case XCENTER: + call gargr (rval) + if (nscan() == 2) { + if (IS_INDEF(rval)) + SF_XF(sf) = (SF_NCOLS(sf) + 1) / 2. + else + SF_XF(sf) = rval + redraw = NO + } else { + call printf ("xcenter %g\n") + call pargr (SF_XF(sf)) + redraw = NO + } + case YCENTER: + call gargr (rval) + if (nscan() == 2) { + if (IS_INDEF(rval)) + SF_YF(sf) = (SF_NLINES(sf) + 1) / 2. + else + SF_YF(sf) = rval + redraw = NO + } else { + call printf ("ycenter %g\n") + call pargr (SF_YF(sf)) + redraw = NO + } + case OVERPLOT: + call gargb (bval) + if (nscan() == 2) { + SF_OVRPLT(sf) = btoi (bval) + redraw = YES + } else { + call printf ("overplot %b\n") + call pargi (SF_OVRPLT(sf)) + redraw = NO + } + case BETA: + call gargr (rval) + if (nscan() == 2) { + SF_BETA(sf) = rval + do i = 1, SF_NSFD(sf) { + sfd = SF_SFD(sf,i) + call stf_widths (sf, sfd) + switch (SF_WCODE(sf)) { + case 1: + SFD_W(sfd) = SFD_R(sfd) + case 2: + SFD_W(sfd) = SFD_DFWHM(sfd) + case 3: + SFD_W(sfd) = SFD_GFWHM(sfd) + case 4: + SFD_W(sfd) = SFD_MFWHM(sfd) + } + call stf_fwhms (sf, sfd) + } + call stf_fitfocus (sf) + redraw = YES + } else { + call printf ("beta %g\n") + call pargr (SF_BETA(sf)) + redraw = NO + } + default: + call printf ("Unrecognized or ambiguous command\007") + redraw = NO + } + + call sfree (sp) +end + + +# STF_G1 -- Plot of size/ellip vs. focus/mag/radius. + +procedure stf_g1 (sf, current, xkey, ykey, title, xlabel, ylabel) + +pointer sf #I Starfocus pointer +pointer current #I Current sfd pointer +int xkey #I X axis key +int ykey #I Y axis key +char title[ARB] #I Title +char xlabel[ARB] #I X label +char ylabel[ARB] #I Y label + +int i, j +bool hl +real x, x1, x2, dx, y, y1, y2, dy +pointer gp, sff, sfd + +begin + # Determine data range + x1 = MAX_REAL + x2 = -MAX_REAL + switch (ykey) { + case 'r': + y1 = SF_W(sf) + y2 = 1.5 * SF_W(sf) + case 'e': + y1 = 0 + y2 = 1 + } + do j = 1, SF_NFOCUS(sf) { + sff = SF_SFF(sf,j) + if (xkey != 'f' && sff != SFD_SFF(current)) + next + do i = 1, SFF_NSFD(sff) { + sfd = SFF_SFD(sff,i) + if (SFD_STATUS(sfd) == 0) { + switch (xkey) { + case 'f': + x = SFD_F(sfd) + case 'm': + x = -2.5 * log10 (SFS_M(SFD_SFS(sfd)) / SF_M(sf)) + case 't': + x = sqrt ((SFD_X(sfd) - SF_XF(sf)) ** 2 + + (SFD_Y(sfd) - SF_YF(sf)) ** 2) + } + switch (ykey) { + case 'r': + y = SFD_W(sfd) + case 'e': + y = SFD_E(sfd) + } + x1 = min (x1, x) + x2 = max (x2, x) + y1 = min (y1, y) + y2 = max (y2, y) + } + } + } + + dx = (x2 - x1) + dy = (y2 - y1) + x1 = x1 - dx * 0.05 + x2 = x2 + dx * 0.05 + y1 = y1 - dy * 0.05 + y2 = y2 + dy * 0.05 + gp = SF_GP (sf) + call gswind (gp, x1, x2, y1, y2) + call glabax (gp, title, xlabel, ylabel) + + do j = 1, SF_NFOCUS(sf) { + sff = SF_SFF(sf,j) + if (xkey != 'f' && sff != SFD_SFF(current)) + next + do i = 1, SFF_NSFD(sff) { + sfd = SFF_SFD(sff,i) + if (SFD_STATUS(sfd) == 0) { + hl = false + switch (xkey) { + case 'f': + x = SFD_F(sfd) + #hl = (SFD_SFS(sfd) == SFD_SFS(current)) + case 'm': + x = -2.5 * log10 (SFS_M(SFD_SFS(sfd)) / SF_M(sf)) + #hl = (SFD_SFF(sfd) != SFD_SFF(current)) + case 't': + x = sqrt ((SFD_X(sfd) - SF_XF(sf)) ** 2 + + (SFD_Y(sfd) - SF_YF(sf)) ** 2) + #hl = (SFD_SFF(sfd) != SFD_SFF(current)) + } + switch (ykey) { + case 'r': + y = SFD_W(sfd) + case 'e': + y = SFD_E(sfd) + } + if (hl) { + call gseti (gp, G_PLCOLOR, HLCOLOR) + if (sfd == current) + call gmark (gp, x, y, GM_BOX, 3., 3.) + call gmark (gp, x, y, GM_PLUS, 3., 3.) + call gseti (gp, G_PLCOLOR, 1) + } else + call gmark (gp, x, y, GM_MARK, 2., 2.) + } + } + } + + call gseti (gp, G_PLTYPE, 2) + if (xkey == 'f') + call gline (gp, SF_F(sf), y1, SF_F(sf), y2) + if (ykey == 'r') + call gline (gp, x1, SF_W(sf), x2, SF_W(sf)) + call gseti (gp, G_PLTYPE, 1) +end + + +# STF_G2 -- Enclosed flux profiles for a given star. + +procedure stf_g2 (sf, current, title) + +pointer sf #I Starfocus pointer +pointer current #I Current sfd pointer +char title[ARB] #I Title + +int i, j, np, np1, nx, ny, ix, iy +real vx, dvx, vy, dvy, x1, x2, y1, y2, z, z1, r, r1, r2, dr, fa[10] +pointer sp, str, gp, sfs, sfd, asi +real stf_i2r(), stf_r2i(), asieval() + +begin + call smark (sp) + call salloc (str, SZ_LINE, TY_CHAR) + + gp = SF_GP(sf) + sfs = SFD_SFS(current) + np = SFD_NP(current) + + # Set grid layout + i = SFS_N(sfs) + if (i < 4) { + nx = i + ny = 1 + } else { + nx = nint (sqrt (real (i))) + if (mod (i-1, nx+1) >= mod (i-1, nx)) + nx = nx + 1 + ny = (i - 1) / nx + 1 + } + + # Set subview port parameters + call ggview (gp, vx, dvx, vy, dvy) + dvx = (dvx - vx) / nx + dvy = (dvy - vy) / ny + + # Set data window parameters + x1 = -0.05 + x2 = 1.05 + y1 = -0.15 + y2 = 1.05 + call gswind (gp, x1, x2, y1, y2) + + # Set fill area + fa[1] = x1; fa[6] = y1 + fa[2] = x2; fa[7] = y1 + fa[3] = x2; fa[8] = y2 + fa[4] = x1; fa[9] = y2 + fa[5] = x1; fa[10] = y1 + + # Draw profiles. + j = 0 + do i = 1, SFS_NSFD(sfs) { + sfd = SFS_SFD(sfs, i) + if (SFD_STATUS(sfd) != 0) + next + np1 = SFD_NP(sfd) + ix = 1 + mod (j, nx) + iy = 1 + j / nx + j = j + 1 + call gsview (gp, vx+dvx*(ix-1), vx+dvx*ix, + vy+dvy*(ny-iy), vy+(ny-iy+1)*dvy) + call gfill (gp, fa, fa[6], 4, GF_SOLID) + call gseti (gp, G_DRAWTICKS, NO) + call glabax (gp, "", "", "") + if (sfd == current) { + call gsview (gp, vx+dvx*(ix-1)+.005, vx+dvx*ix-.005, + vy+dvy*(ny-iy)+.005, vy+(ny-iy+1)*dvy-.005) + call gsetr (gp, G_PLWIDTH, HLWIDTH) + call gseti (gp, G_PLCOLOR, HLCOLOR) + call gpline (gp, fa, fa[6], 5) + call gsetr (gp, G_PLWIDTH, 1.) + call gseti (gp, G_PLCOLOR, 1) + call gsview (gp, vx+dvx*(ix-1), vx+dvx*ix, + vy+dvy*(ny-iy), vy+(ny-iy+1)*dvy) + } + + asi = SFD_ASI1(sfd) + r2 = stf_i2r (real(np)) + call gamove (gp, 0., 0.) + for (z = 1.; z <= np1; z = z + 0.1) + call gadraw (gp, stf_i2r(z)/r2, asieval(asi,z)) + if (SF_OVRPLT(sf) == YES && sfd != SF_BEST(sf)) { + call gseti (gp, G_PLCOLOR, HLCOLOR) + np1 = SFD_NP(SF_BEST(sf)) + asi = SFD_ASI1(SF_BEST(sf)) + r1 = stf_i2r (1.) + r2 = stf_i2r (real(np)) + dr = 0.05 * (r2 - r1) + for (r = r1; r <= r2; r = r + dr) { + z = stf_r2i (r) + z1 = stf_r2i (r+0.7*dr) + if (z > 1. && z1 <= np1) + call gline (gp, r/r2, asieval(asi,z), + (r+0.7*dr)/r2, asieval(asi,z1)) + } + call gseti (gp, G_PLCOLOR, 1) + } + + call sprintf (Memc[str], SZ_LINE, "%.3g") + call pargr (SFD_W(sfd)) + call gtext (gp, 0.95, -0.1, Memc[str], "h=r;v=b") + if (nx < NMAX && ny < NMAX) { + call sprintf (Memc[str], SZ_LINE, "%.4g") + call pargr (SFD_F(sfd)) + call gtext (gp, 0.05, -0.1, Memc[str], "h=l;v=b") + } + } + + call gsview (gp, vx, vx+nx*dvx, vy, vy+ny*dvy) + call gswind (gp, 0.5, 0.5+nx, 0.5+ny, 0.5) + call gamove (gp, 1., 1.) + + # Draw label + call gseti (gp, G_DRAWAXES, 0) + call glabax (gp, title, "", "") + call gseti (gp, G_DRAWAXES, 3) + + call sfree (sp) +end + + +# STF_G3 -- Enclosed flux profiles for a given focus. + +procedure stf_g3 (sf, current, title) + +pointer sf #I Starfocus pointer +pointer current #I Current sfd pointer +char title[ARB] #I Title + +int i, j, np, np1, nx, ny, ix, iy +real vx, dvx, vy, dvy, x1, x2, y1, y2, z, z1, r, r1, r2, dr, fa[10] +pointer sp, str, gp, sff, sfd, asi +real stf_i2r(), stf_r2i(), asieval() + +begin + call smark (sp) + call salloc (str, SZ_LINE, TY_CHAR) + + gp = SF_GP(sf) + sff = SFD_SFF(current) + np = SFD_NP(current) + + # Set grid layout + i = SFF_N(sff) + if (i < 4) { + nx = i + ny = 1 + } else { + nx = nint (sqrt (real (i))) + if (mod (i-1, nx+1) >= mod (i-1, nx)) + nx = nx + 1 + ny = (i - 1) / nx + 1 + } + + # Set subview port parameters + call ggview (gp, vx, dvx, vy, dvy) + dvx = (dvx - vx) / nx + dvy = (dvy - vy) / ny + + # Set data window parameters + x1 = -0.05 + x2 = 1.05 + y1 = -0.2 + y2 = 1.05 + call gswind (gp, x1, x2, y1, y2) + + # Set fill area + fa[1] = x1; fa[6] = y1 + fa[2] = x2; fa[7] = y1 + fa[3] = x2; fa[8] = y2 + fa[4] = x1; fa[9] = y2 + fa[5] = x1; fa[10] = y1 + + # Draw profiles. + j = 0 + do i = 1, SFF_NSFD(sff) { + sfd = SFF_SFD(sff, i) + if (SFD_STATUS(sfd) != 0) + next + np1 = SFD_NP(sfd) + ix = 1 + mod (j, nx) + iy = 1 + j / nx + j = j + 1 + call gsview (gp, vx+dvx*(ix-1), vx+dvx*ix, + vy+dvy*(ny-iy), vy+(ny-iy+1)*dvy) + call gfill (gp, fa, fa[6], 4, GF_SOLID) + call gseti (gp, G_DRAWTICKS, NO) + call glabax (gp, "", "", "") + if (sfd == current) { + call gsview (gp, vx+dvx*(ix-1)+.005, vx+dvx*ix-.005, + vy+dvy*(ny-iy)+.005, vy+(ny-iy+1)*dvy-.005) + call gsetr (gp, G_PLWIDTH, HLWIDTH) + call gseti (gp, G_PLCOLOR, HLCOLOR) + call gpline (gp, fa, fa[6], 5) + call gsetr (gp, G_PLWIDTH, 1.) + call gseti (gp, G_PLCOLOR, 1) + call gsview (gp, vx+dvx*(ix-1), vx+dvx*ix, + vy+dvy*(ny-iy), vy+(ny-iy+1)*dvy) + } + + asi = SFD_ASI1(sfd) + r2 = stf_i2r (real(np)) + call gamove (gp, 0., 0.) + for (z = 1.; z <= np1; z = z + 0.1) + call gadraw (gp, stf_i2r(z)/r2, asieval(asi,z)) + if (SF_OVRPLT(sf) == YES && sfd != SF_BEST(sf)) { + call gseti (gp, G_PLCOLOR, HLCOLOR) + np1 = SFD_NP(SF_BEST(sf)) + asi = SFD_ASI1(SF_BEST(sf)) + r1 = stf_i2r (1.) + r2 = stf_i2r (real(np)) + dr = 0.05 * (r2 - r1) + for (r = r1; r <= r2; r = r + dr) { + z = stf_r2i (r) + z1 = stf_r2i (r+0.7*dr) + if (z > 1. && z1 <= np1) + call gline (gp, r/r2, asieval(asi,z), + (r+0.7*dr)/r2, asieval(asi,z1)) + } + call gseti (gp, G_PLCOLOR, 1) + } + + call sprintf (Memc[str], SZ_LINE, "%.3g") + call pargr (SFD_W(sfd)) + call gtext (gp, 0.95, -.1, Memc[str], "h=r;v=b") + if (nx < NMAX && ny < NMAX) { + call sprintf (Memc[str], SZ_LINE, "%d %d") + call pargr (SFD_X(sfd)) + call pargr (SFD_Y(sfd)) + call gtext (gp, 0.05, -.1, Memc[str], "h=l;v=b") + } + } + + call gsview (gp, vx, vx+nx*dvx, vy, vy+ny*dvy) + call gswind (gp, 0.5, 0.5+nx, 0.5+ny, 0.5) + call gamove (gp, 1., 1.) + + # Draw label + call gseti (gp, G_DRAWAXES, 0) + call glabax (gp, title, "", "") + call gseti (gp, G_DRAWAXES, 3) + + call sfree (sp) +end + + +# STF_G4 -- Radial profiles (derivative of enclosed flux) for a given star. + +procedure stf_g4 (sf, current, title) + +pointer sf #I Starfocus pointer +pointer current #I Current sfd pointer +char title[ARB] #I Title + +int i, j, np, np1, nx, ny, ix, iy +real vx, dvx, vy, dvy, x1, x2, y1, y2, z, z1, r, r1, r2, dr, rmax, fa[10] +pointer sp, str, gp, sfs, sfd, asi +real stf_i2r(), stf_r2i(), asieval() + +begin + call smark (sp) + call salloc (str, SZ_LINE, TY_CHAR) + + gp = SF_GP(sf) + sfs = SFD_SFS(current) + np = SFD_NP(current) + + # Set grid layout + i = SFS_N(sfs) + if (i < 4) { + nx = i + ny = 1 + } else { + nx = nint (sqrt (real (i))) + if (mod (i-1, nx+1) >= mod (i-1, nx)) + nx = nx + 1 + ny = (i - 1) / nx + 1 + } + + # Set subview port parameters + call ggview (gp, vx, dvx, vy, dvy) + dvx = (dvx - vx) / nx + dvy = (dvy - vy) / ny + + # Set data window parameters + x1 = -0.05 + x2 = 1.05 + z = SF_YP2(sf) - SF_YP1(sf) + y1 = SF_YP1(sf) - 0.05 * z + y2 = SF_YP2(sf) + 0.15 * z + + # Set fill area + fa[1] = x1; fa[6] = y1 + fa[2] = x2; fa[7] = y1 + fa[3] = x2; fa[8] = y2 + fa[4] = x1; fa[9] = y2 + fa[5] = x1; fa[10] = y1 + + # Draw profiles. + j = 0 + do i = 1, SFS_NSFD(sfs) { + sfd = SFS_SFD(sfs, i) + if (SFD_STATUS(sfd) != 0) + next + np1 = SFD_NP(sfd) + ix = 1 + mod (j, nx) + iy = 1 + j / nx + j = j + 1 + call gsview (gp, vx+dvx*(ix-1), vx+dvx*ix, + vy+dvy*(ny-iy), vy+(ny-iy+1)*dvy) + call gswind (gp, x1, x2, y1, y2) + call gfill (gp, fa, fa[6], 4, GF_SOLID) + call gseti (gp, G_DRAWTICKS, NO) + call glabax (gp, "", "", "") + if (sfd == current) { + call gsview (gp, vx+dvx*(ix-1)+.005, vx+dvx*ix-.005, + vy+dvy*(ny-iy)+.005, vy+(ny-iy+1)*dvy-.005) + call gsetr (gp, G_PLWIDTH, HLWIDTH) + call gseti (gp, G_PLCOLOR, HLCOLOR) + call gpline (gp, fa, fa[6], 5) + call gsetr (gp, G_PLWIDTH, 1.) + call gseti (gp, G_PLCOLOR, 1) + call gsview (gp, vx+dvx*(ix-1), vx+dvx*ix, + vy+dvy*(ny-iy), vy+(ny-iy+1)*dvy) + } + + asi = SFD_ASI2(sfd) + rmax = stf_i2r (real(np)) + z = SF_XP1(sf) + call gamove (gp, stf_i2r(z)/rmax, asieval(asi,z)) + for (; z <= SF_XP2(sf); z = z + 0.1) + call gadraw (gp, stf_i2r(z)/rmax, asieval(asi,z)) + if (SF_OVRPLT(sf) == YES && sfd != SF_BEST(sf)) { + call gseti (gp, G_PLCOLOR, HLCOLOR) + np1 = SFD_NP(SF_BEST(sf)) + asi = SFD_ASI2(SF_BEST(sf)) + rmax = stf_i2r (real(np)) + r1 = stf_i2r (SF_XP1(sf)) + r2 = stf_i2r (SF_XP2(sf)) + dr = 0.05 * (rmax - stf_i2r(1.)) + for (r = r1; r <= r2; r = r + dr) { + z = stf_r2i (r) + z1 = stf_r2i (r+0.7*dr) + if (z > 1. && z1 <= np1) + call gline (gp, r/rmax, asieval(asi,z), + (r+0.7*dr)/rmax, asieval(asi,z1)) + } + call gseti (gp, G_PLCOLOR, 1) + } + + call gswind (gp, 0., 1., 0., 1.) + call sprintf (Memc[str], SZ_LINE, "%.3g") + call pargr (SFD_W(sfd)) + call gtext (gp, 0.95, 0.98, Memc[str], "h=r;v=t") + if (nx < NMAX && ny < NMAX) { + call sprintf (Memc[str], SZ_LINE, "%.4g") + call pargr (SFD_F(sfd)) + call gtext (gp, 0.05, 0.98, Memc[str], "h=l;v=t") + } + } + + call gsview (gp, vx, vx+nx*dvx, vy, vy+ny*dvy) + call gswind (gp, 0.5, 0.5+nx, 0.5+ny, 0.5) + call gamove (gp, 1., 1.) + + # Draw label + call gseti (gp, G_DRAWAXES, 0) + call glabax (gp, title, "", "") + call gseti (gp, G_DRAWAXES, 3) + + call sfree (sp) +end + + +# STF_G5 -- Radial profiles (derivative of enclosed flux) for a given focus. + +procedure stf_g5 (sf, current, title) + +pointer sf #I Starfocus pointer +pointer current #I Current sfd pointer +char title[ARB] #I Title + +int i, j, np, np1, nx, ny, ix, iy +real vx, dvx, vy, dvy, x1, x2, y1, y2, z, z1, r, r1, r2, dr, rmax, fa[10] +pointer sp, str, gp, sff, sfd, asi +real stf_i2r(), stf_r2i(), asieval() + +begin + call smark (sp) + call salloc (str, SZ_LINE, TY_CHAR) + + gp = SF_GP(sf) + sff = SFD_SFF(current) + np = SFD_NP(current) + + # Set grid layout + i = SFF_N(sff) + if (i < 4) { + nx = i + ny = 1 + } else { + nx = nint (sqrt (real (i))) + if (mod (i-1, nx+1) >= mod (i-1, nx)) + nx = nx + 1 + ny = (i - 1) / nx + 1 + } + + # Set subview port parameters + call ggview (gp, vx, dvx, vy, dvy) + dvx = (dvx - vx) / nx + dvy = (dvy - vy) / ny + + # Set data window parameters + x1 = -0.05 + x2 = 1.05 + z = SF_YP2(sf) - SF_YP1(sf) + y1 = SF_YP1(sf) - 0.05 * z + y2 = SF_YP2(sf) + 0.15 * z + + # Set fill area + fa[1] = x1; fa[6] = y1 + fa[2] = x2; fa[7] = y1 + fa[3] = x2; fa[8] = y2 + fa[4] = x1; fa[9] = y2 + fa[5] = x1; fa[10] = y1 + + # Draw profiles. + j = 0 + do i = 1, SFF_NSFD(sff) { + sfd = SFF_SFD(sff, i) + if (SFD_STATUS(sfd) != 0) + next + np1 = SFD_NP(sfd) + ix = 1 + mod (j, nx) + iy = 1 + j / nx + j = j + 1 + call gsview (gp, vx+dvx*(ix-1), vx+dvx*ix, + vy+dvy*(ny-iy), vy+(ny-iy+1)*dvy) + call gswind (gp, x1, x2, y1, y2) + call gfill (gp, fa, fa[6], 4, GF_SOLID) + call gseti (gp, G_DRAWTICKS, NO) + call glabax (gp, "", "", "") + if (sfd == current) { + call gsview (gp, vx+dvx*(ix-1)+.005, vx+dvx*ix-.005, + vy+dvy*(ny-iy)+.005, vy+(ny-iy+1)*dvy-.005) + call gsetr (gp, G_PLWIDTH, HLWIDTH) + call gseti (gp, G_PLCOLOR, HLCOLOR) + call gpline (gp, fa, fa[6], 5) + call gsetr (gp, G_PLWIDTH, 1.) + call gseti (gp, G_PLCOLOR, 1) + call gsview (gp, vx+dvx*(ix-1), vx+dvx*ix, + vy+dvy*(ny-iy), vy+(ny-iy+1)*dvy) + } + + asi = SFD_ASI2(sfd) + rmax = stf_i2r (real(np)) + z = SF_XP1(sf) + call gamove (gp, stf_i2r(z)/rmax, asieval(asi,z)) + for (; z <= SF_XP2(sf); z = z + 0.1) + call gadraw (gp, stf_i2r(z)/rmax, asieval(asi,z)) + if (SF_OVRPLT(sf) == YES && sfd != SF_BEST(sf)) { + call gseti (gp, G_PLCOLOR, HLCOLOR) + np1 = SFD_NP(SF_BEST(sf)) + asi = SFD_ASI2(SF_BEST(sf)) + rmax = stf_i2r (real(np)) + r1 = stf_i2r (SF_XP1(sf)) + r2 = stf_i2r (SF_XP2(sf)) + dr = 0.05 * (rmax - stf_i2r (1.)) + for (r = r1; r <= r2; r = r + dr) { + z = stf_r2i (r) + z1 = stf_r2i (r+0.7*dr) + if (z > 1. && z1 <= np1) + call gline (gp, r/rmax, asieval(asi,z), + (r+0.7*dr)/rmax, asieval(asi,z1)) + } + call gseti (gp, G_PLCOLOR, 1) + } + + call gswind (gp, 0., 1., 0., 1.) + call sprintf (Memc[str], SZ_LINE, "%.3g") + call pargr (SFD_W(sfd)) + call gtext (gp, 0.95, 0.98, Memc[str], "h=r;v=t") + if (nx < NMAX && ny < NMAX) { + call sprintf (Memc[str], SZ_LINE, "%d %d") + call pargr (SFD_X(sfd)) + call pargr (SFD_Y(sfd)) + call gtext (gp, 0.05, 0.98, Memc[str], "h=l;v=t") + } + } + + call gsview (gp, vx, vx+nx*dvx, vy, vy+ny*dvy) + call gswind (gp, 0.5, 0.5+nx, 0.5+ny, 0.5) + call gamove (gp, 1., 1.) + + # Draw label + call gseti (gp, G_DRAWAXES, 0) + call glabax (gp, title, "", "") + call gseti (gp, G_DRAWAXES, 3) + + call sfree (sp) +end + + +# STF_G6 -- Enclosed flux profile of a star. + +procedure stf_g6 (sf, current, title, xlabel, ylabel) + +pointer sf #I Starfocus pointer +pointer current #I Star pointer +char title[ARB] #I Title +char xlabel[ARB] #I X label +char ylabel[ARB] #I Y label + +int np, np1 +real scale, level, radius, flux, profile +pointer gp, asi + +real x1, x2, y1, y2, z, z1, r, r1, r2, dr +real stf_i2r(), stf_r2i(), asieval() + +begin + gp = SF_GP(sf) + level = SF_LEVEL(sf) + scale = SF_SCALE(sf) + np = SFD_NP(current) + asi = SFD_ASI1(current) + + x1 = -0.5 * scale + x2 = (stf_i2r (real(np)) + 0.5) * scale + y1 = -0.05 + y2 = 1.05 + call gswind (gp, x1, x2, y1, y2) + + call gseti (gp, G_DRAWTICKS, YES) + call gseti (gp, G_XNMAJOR, 6) + call gseti (gp, G_XNMINOR, 4) + call gseti (gp, G_YNMAJOR, 6) + call gseti (gp, G_YNMINOR, 4) + call glabax (gp, title, xlabel, ylabel) + + # Draw profiles. + if (SFD_STATUS(current) == 0) { + call gseti (gp, G_PLCOLOR, 1) + for (z = 1.; z <= np; z = z + 1) + call gmark (gp, stf_i2r(z)*scale, asieval(asi,z), + GM_PLUS, 2., 2.) + call gamove (gp, 0., 0.) + for (z = 1.; z <= np; z = z + 0.1) + call gadraw (gp, stf_i2r(z)*scale, asieval(asi,z)) + switch (SF_WCODE(sf)) { + case 1: + radius = SFD_W(current) + call gseti (gp, G_PLTYPE, 2) + call gline (gp, x1, level, radius, level) + call gline (gp, radius, level, radius, y1) + call gseti (gp, G_PLTYPE, 1) + default: + radius = SFD_W(current) / 2. + call gseti (gp, G_PLTYPE, 2) + call gline (gp, radius, y1, radius, y2) + call gseti (gp, G_PLTYPE, 1) + } + + call gseti (gp, G_PLCOLOR, HLCOLOR) + call stf_model (sf, current, 0., profile, flux) + call gamove (gp, 0., flux) + for (z = 1.; z <= np; z = z + 0.1) { + r = stf_i2r(z) * scale + call stf_model (sf, current, r, profile, flux) + call gadraw (gp, r, flux) + } + call gseti (gp, G_PLCOLOR, 1) + if (SF_OVRPLT(sf) == YES && current != SF_BEST(sf)) { + call gseti (gp, G_PLCOLOR, HLCOLOR) + np1 = SFD_NP(SF_BEST(sf)) + asi = SFD_ASI1(SF_BEST(sf)) + r1 = stf_i2r(1.) + r2 = stf_i2r (real(np)) + dr = 0.05 * (r2 - r1) + for (r = r1; r <= r2; r = r + dr) { + z = stf_r2i (r) + z1 = stf_r2i (r+0.7*dr) + if (z > 1. && z1 <= np1) + call gline (gp, r*scale, asieval(asi,z), + (r+0.7*dr)*scale, asieval(asi,z1)) + } + call gseti (gp, G_PLCOLOR, 1) + } + } +end + + +# STF_G7 -- Radial profile (derivative of enclosed flux) for a star. + +procedure stf_g7 (sf, current, title, xlabel, ylabel) + +pointer sf #I Starfocus pointer +pointer current #I Star pointer +char title[ARB] #I Title +char xlabel[ARB] #I X label +char ylabel[ARB] #I Y label + +int np, np1 +real scale, level, radius, profile, flux +pointer gp, asi + +real x1, x2, y1, y2, z, z1, r, r1, r2, dr +real stf_i2r(), stf_r2i(), asieval() + +begin + gp = SF_GP(sf) + level = SF_LEVEL(sf) + scale = SF_SCALE(sf) + np = SFD_NP(current) + asi = SFD_ASI2(current) + + x1 = -0.5 * scale + x2 = (stf_i2r (real(np)) + 0.5) * scale + z = SFD_YP2(current) - SFD_YP1(current) + y1 = SFD_YP1(current) - 0.05 * z + y2 = SFD_YP2(current) + 0.05 * z + call gswind (gp, x1, x2, y1, y2) + + call gseti (gp, G_XDRAWTICKS, YES) + call gseti (gp, G_YDRAWTICKS, NO) + call gseti (gp, G_XNMAJOR, 6) + call gseti (gp, G_XNMINOR, 4) + call gseti (gp, G_YNMAJOR, 6) + call gseti (gp, G_YNMINOR, 4) + call glabax (gp, title, xlabel, ylabel) + + # Draw profile + call gseti (gp, G_PLCOLOR, 1) + for (z = SF_XP1(sf); z <= SF_XP2(sf); z = z + 1) + call gmark (gp, stf_i2r(z)*scale, asieval(asi,z), + GM_PLUS, 2., 2.) + z = SF_XP1(sf) + call gamove (gp, stf_i2r(z)*scale, asieval(asi,z)) + for (; z <= SF_XP2(sf); z = z + 0.1) + call gadraw (gp, stf_i2r (z)*scale, asieval(asi,z)) + + switch (SF_WCODE(sf)) { + case 1: + radius = SFD_W(current) + default: + radius = SFD_W(current) / 2. + } + call gseti (gp, G_PLTYPE, 2) + call gline (gp, radius, y1, radius, y2) + call gseti (gp, G_PLTYPE, 1) + + call gseti (gp, G_PLCOLOR, HLCOLOR) + z = SF_XP1(sf) + r = stf_i2r(z) * scale + call stf_model (sf, current, r, profile, flux) + call gamove (gp, r, profile) + for (; z <= np; z = z + 0.1) { + r = stf_i2r(z) * scale + call stf_model (sf, current, r, profile, flux) + call gadraw (gp, r, profile) + } + call gseti (gp, G_PLCOLOR, 1) + if (SF_OVRPLT(sf) == YES && current != SF_BEST(sf)) { + call gseti (gp, G_PLCOLOR, HLCOLOR) + np1 = SFD_NP(SF_BEST(sf)) + asi = SFD_ASI2(SF_BEST(sf)) + r1 = stf_i2r (SF_XP1(sf)) + r2 = stf_i2r (SF_XP2(sf)) + dr = 0.05 * (r2 - r1) + for (r = r1; r <= r2; r = r + dr) { + z = stf_r2i (r) + z1 = stf_r2i (r+0.7*dr) + if (z > 1. && z1 <= np1) + call gline (gp, r*scale, asieval(asi,z), + (r+0.7*dr)*scale, asieval(asi,z1)) + } + call gseti (gp, G_PLCOLOR, 1) + } +end + + +# STF_G8 -- FWHM vs level. + +procedure stf_g8 (sf, current, title, xlabel, ylabel) + +pointer sf #I Starfocus pointer +pointer current #I Star pointer +char title[ARB] #I Title +char xlabel[ARB] #I X label +char ylabel[ARB] #I Y label + +real y1, y2, level, fwhm +pointer gp + +begin + level = SF_LEVEL(sf) + if (SF_WCODE(sf) == 1) + fwhm = SFD_MFWHM(current) + else + fwhm = SFD_W(current) + + call alimr (SFD_FWHM(current,2), 17, y1, y2) + y2 = y2 - y1 + y1 = y1 - 0.05 * y2 + y2 = y1 + 1.10 * y2 + y1 = min (y1, 0.9 * fwhm) + y2 = max (y2, 1.1 * fwhm) + + gp = SF_GP(sf) + call gseti (gp, G_DRAWTICKS, YES) + call gseti (gp, G_XNMAJOR, 6) + call gseti (gp, G_XNMINOR, 4) + call gseti (gp, G_YNMAJOR, 6) + call gseti (gp, G_YNMINOR, 4) + call gswind (gp, 0., 1., y1, y2) + call glabax (gp, title, xlabel, ylabel) + call gvline (gp, SFD_FWHM(current,2), 17, 0.1, 0.9) + call gvmark (gp, SFD_FWHM(current,2), 17, 0.1, 0.9, GM_PLUS, 2., 2.) + + switch (SF_WCODE(sf)) { + case 1: + call gseti (gp, G_PLTYPE, 2) + call gline (gp, 0., fwhm, level, fwhm) + call gline (gp, level, y1, level, fwhm) + call gseti (gp, G_PLTYPE, 1) + default: + call gseti (gp, G_PLTYPE, 2) + call gline (gp, 0., fwhm, 1., fwhm) + call gseti (gp, G_PLTYPE, 1) + } +end + + +# STF_G9 -- FWHM vs level for a given star. + +procedure stf_g9 (sf, current, title) + +pointer sf #I Starfocus pointer +pointer current #I Current sfd pointer +char title[ARB] #I Title + +int i, j, nx, ny, ix, iy +real level, fwhm, vx, dvx, vy, dvy, x1, x2, y1, y2, fa[10] +pointer sp, str, gp, sfs, sfd + +begin + call smark (sp) + call salloc (str, SZ_LINE, TY_CHAR) + + gp = SF_GP(sf) + sfs = SFD_SFS(current) + level = SF_LEVEL(sf) + if (SF_WCODE(sf) == 1) + fwhm = SFD_MFWHM(current) + else + fwhm = SFD_W(current) + + # Set grid layout + i = SFS_N(sfs) + if (i < 4) { + nx = i + ny = 1 + } else { + nx = nint (sqrt (real (i))) + if (mod (i-1, nx+1) >= mod (i-1, nx)) + nx = nx + 1 + ny = (i - 1) / nx + 1 + } + + # Set subview port parameters + call ggview (gp, vx, dvx, vy, dvy) + dvx = (dvx - vx) / nx + dvy = (dvy - vy) / ny + + # Set data window parameters + y1 = 0.9 * fwhm + y2 = 1.1 * fwhm + do i = 1, SFS_NSFD(sfs) { + sfd = SFS_SFD(sfs,i) + if (SFD_STATUS(sfd) != 0) + next + call alimr (SFD_FWHM(sfd,2), 17, x1, x2) + x2 = x2 - x1 + x1 = x1 - 0.05 * x2 + x2 = x1 + 1.10 * x2 + y1 = min (x1, y1) + y2 = max (x2, y2) + } + x2 = y2 - y1 + y1 = min (y1, fwhm - 0.2 * x2) + y2 = max (y2, fwhm + 0.2 * x2) + x1 = 0. + x2 = 1. + call gswind (gp, x1, x2, y1, y2) + + # Set fill area + fa[1] = x1; fa[6] = y1 + fa[2] = x2; fa[7] = y1 + fa[3] = x2; fa[8] = y2 + fa[4] = x1; fa[9] = y2 + fa[5] = x1; fa[10] = y1 + + # Draw profiles. + j = 0 + do i = 1, SFS_NSFD(sfs) { + sfd = SFS_SFD(sfs, i) + if (SFD_STATUS(sfd) != 0) + next + ix = 1 + mod (j, nx) + iy = 1 + j / nx + j = j + 1 + call gsview (gp, vx+dvx*(ix-1), vx+dvx*ix, + vy+dvy*(ny-iy), vy+(ny-iy+1)*dvy) + call gfill (gp, fa, fa[6], 4, GF_SOLID) + call gseti (gp, G_DRAWTICKS, NO) + call glabax (gp, "", "", "") + if (sfd == current) { + call gsview (gp, vx+dvx*(ix-1)+.005, vx+dvx*ix-.005, + vy+dvy*(ny-iy)+.005, vy+(ny-iy+1)*dvy-.005) + call gsetr (gp, G_PLWIDTH, HLWIDTH) + call gseti (gp, G_PLCOLOR, HLCOLOR) + call gpline (gp, fa, fa[6], 5) + call gsetr (gp, G_PLWIDTH, 1.) + call gseti (gp, G_PLCOLOR, 1) + call gsview (gp, vx+dvx*(ix-1), vx+dvx*ix, + vy+dvy*(ny-iy), vy+(ny-iy+1)*dvy) + } + + call gvline (gp, SFD_FWHM(sfd,2), 17, 0.1, 0.9) + #call gseti (gp, G_PLTYPE, 2) + #call gline (gp, x1, fwhm, x2, fwhm) + #call gseti (gp, G_PLTYPE, 1) + + call sprintf (Memc[str], SZ_LINE, "%.3g") + call pargr (SFD_W(sfd)) + call gtext (gp, 0.95, 0.95*y2+0.05*y1, Memc[str], "h=r;v=t") + if (nx < NMAX && ny < NMAX) { + call sprintf (Memc[str], SZ_LINE, "%.4g") + call pargr (SFD_F(sfd)) + call gtext (gp, 0.05, 0.95*y2+0.05*y1, Memc[str], "h=l;v=t") + } + } + + call gsview (gp, vx, vx+nx*dvx, vy, vy+ny*dvy) + call gswind (gp, 0.5, 0.5+nx, 0.5+ny, 0.5) + call gamove (gp, 1., 1.) + + # Draw label + call gseti (gp, G_DRAWAXES, 0) + call glabax (gp, title, "", "") + call gseti (gp, G_DRAWAXES, 3) + + call sfree (sp) +end + + +# STF_G10 -- FWHM vs level for a given focus. + +procedure stf_g10 (sf, current, title) + +pointer sf #I Starfocus pointer +pointer current #I Current sfd pointer +char title[ARB] #I Title + +int i, j, nx, ny, ix, iy +real level, fwhm, vx, dvx, vy, dvy, x1, x2, y1, y2, fa[10] +pointer sp, str, gp, sff, sfd + +begin + call smark (sp) + call salloc (str, SZ_LINE, TY_CHAR) + + gp = SF_GP(sf) + sff = SFD_SFF(current) + level = SF_LEVEL(sf) + if (SF_WCODE(sf) == 1) + fwhm = SFD_MFWHM(current) + else + fwhm = SFD_W(current) + + # Set grid layout + i = SFF_N(sff) + if (i < 4) { + nx = i + ny = 1 + } else { + nx = nint (sqrt (real (i))) + if (mod (i-1, nx+1) >= mod (i-1, nx)) + nx = nx + 1 + ny = (i - 1) / nx + 1 + } + + # Set subview port parameters + call ggview (gp, vx, dvx, vy, dvy) + dvx = (dvx - vx) / nx + dvy = (dvy - vy) / ny + + # Set data window parameters + y1 = 0.9 * fwhm + y2 = 1.1 * fwhm + do i = 1, SFF_NSFD(sff) { + sfd = SFF_SFD(sff,i) + if (SFD_STATUS(sfd) != 0) + next + call alimr (SFD_FWHM(sfd,2), 17, x1, x2) + x2 = x2 - x1 + x1 = x1 - 0.05 * x2 + x2 = x1 + 1.10 * x2 + y1 = min (x1, y1) + y2 = max (x2, y2) + } + x2 = y2 - y1 + y1 = min (y1, fwhm - 0.2 * x2) + y2 = max (y2, fwhm + 0.2 * x2) + x1 = 0. + x2 = 1. + call gswind (gp, x1, x2, y1, y2) + + # Set fill area + fa[1] = x1; fa[6] = y1 + fa[2] = x2; fa[7] = y1 + fa[3] = x2; fa[8] = y2 + fa[4] = x1; fa[9] = y2 + fa[5] = x1; fa[10] = y1 + + # Draw plots. + j = 0 + do i = 1, SFF_NSFD(sff) { + sfd = SFF_SFD(sff, i) + if (SFD_STATUS(sfd) != 0) + next + ix = 1 + mod (j, nx) + iy = 1 + j / nx + j = j + 1 + call gsview (gp, vx+dvx*(ix-1), vx+dvx*ix, + vy+dvy*(ny-iy), vy+(ny-iy+1)*dvy) + call gfill (gp, fa, fa[6], 4, GF_SOLID) + call gseti (gp, G_DRAWTICKS, NO) + call glabax (gp, "", "", "") + if (sfd == current) { + call gsview (gp, vx+dvx*(ix-1)+.005, vx+dvx*ix-.005, + vy+dvy*(ny-iy)+.005, vy+(ny-iy+1)*dvy-.005) + call gsetr (gp, G_PLWIDTH, HLWIDTH) + call gseti (gp, G_PLCOLOR, HLCOLOR) + call gpline (gp, fa, fa[6], 5) + call gsetr (gp, G_PLWIDTH, 1.) + call gseti (gp, G_PLCOLOR, 1) + call gsview (gp, vx+dvx*(ix-1), vx+dvx*ix, + vy+dvy*(ny-iy), vy+(ny-iy+1)*dvy) + } + + call gvline (gp, SFD_FWHM(sfd,2), 17, 0.1, 0.9) + #call gseti (gp, G_PLTYPE, 2) + #call gline (gp, x1, fwhm, x2, fwhm) + #call gseti (gp, G_PLTYPE, 1) + + call sprintf (Memc[str], SZ_LINE, "%.3g") + call pargr (SFD_W(sfd)) + call gtext (gp, 0.95, 0.95*y2+0.05*y1, Memc[str], "h=r;v=t") + if (nx < NMAX && ny < NMAX) { + call sprintf (Memc[str], SZ_LINE, "%d %d") + call pargr (SFD_X(sfd)) + call pargr (SFD_Y(sfd)) + call gtext (gp, 0.05, 0.95*y2+0.05*y1, Memc[str], "h=l;v=t") + } + } + + call gsview (gp, vx, vx+nx*dvx, vy, vy+ny*dvy) + call gswind (gp, 0.5, 0.5+nx, 0.5+ny, 0.5) + call gamove (gp, 1., 1.) + + # Draw label + call gseti (gp, G_DRAWAXES, 0) + call glabax (gp, title, "", "") + call gseti (gp, G_DRAWAXES, 3) + + call sfree (sp) +end + + +# STF_G11 -- Spatial plot at one focus. + +procedure stf_g11 (sf, current, key, title) + +pointer sf #I Starfocus pointer +pointer current #I Current sfd pointer +int key #I Plot magnitude symbol? +char title[ARB] #I Title + +int i +real x, y, z, x1, x2, y1, y2, rbest, rmin, rmax, emin, emax +real vx[3,2], vy[3,2], dvx, dvy, fa[8] +pointer gp, sfd, sff + +data fa/0.,1.,1.,0.,0.,0.,1.,1./ + +begin + gp = SF_GP(sf) + sff = SFD_SFF(current) + + # Range of X, Y, R, E. + x1 = 1. + y1 = 1. + x2 = SF_NCOLS(sf) + y2 = SF_NLINES(sf) + + rbest = SFD_W(SF_BEST(sf)) + rmin = SF_W(sf) + rmax = 1.5 * SF_W(sf) + emin = 0 + emax = 1 + do i = 1, SFF_NSFD(sff) { + sfd = SFF_SFD(sff,i) + if (SFD_STATUS(sfd) != 0) + next + rmin = min (rmin, SFD_W(sfd)) + rmax = max (rmax, SFD_W(sfd)) + emin = min (emin, SFD_E(sfd)) + emax = max (emax, SFD_E(sfd)) + } + z = rmax - rmin + rmin = rmin - 0.1 * z + rmax = rmax + 0.1 * z + + # Set view ports + call ggview (gp, vx[1,1], vx[3,2], vy[1,1], vy[3,2]) + dvx = vx[3,2] - vx[1,1] + dvy = vy[3,2] - vy[1,1] + vx[1,1] = vx[1,1] + 0.00 * dvx + vx[1,2] = vx[1,1] + 0.20 * dvx + vx[2,1] = vx[1,1] + 0.25 * dvx + vx[2,2] = vx[1,1] + 0.75 * dvx + vx[3,1] = vx[1,1] + 0.80 * dvx + vx[3,2] = vx[1,1] + 1.00 * dvx + vy[1,1] = vy[1,1] + 0.00 * dvy + vy[1,2] = vy[1,1] + 0.20 * dvy + vy[2,1] = vy[1,1] + 0.25 * dvy + vy[2,2] = vy[1,1] + 0.75 * dvy + vy[3,1] = vy[1,1] + 0.80 * dvy + vy[3,2] = vy[1,1] + 1.00 * dvy + + # (X,R) + call gseti (gp, G_WCS, 2) + call gseti (gp, G_DRAWAXES, 3) + call gseti (gp, G_XLABELTICKS, YES) + call gseti (gp, G_YLABELTICKS, YES) + call gseti (gp, G_XNMAJOR, 6) + call gseti (gp, G_XNMINOR, 4) + call gseti (gp, G_YNMAJOR, 4) + call gseti (gp, G_YNMINOR, 0) + call gsview (gp, vx[2,1], vx[2,2], vy[1,1], vy[1,2]) + call gswind (gp, 0., 1., 0., 1.) + call gfill (gp, fa, fa[5], 4, GF_SOLID) + + call gswind (gp, x1, x2, rmin, rmax) + call glabax (gp, "", "Column", "") + + do i = 1, SFF_NSFD(sff) { + sfd = SFF_SFD(sff,i) + if (SFD_STATUS(sfd) != 0) + next + x = SFD_X(sfd) + y = SFD_W(sfd) + if (key == 1) { + z = sqrt (SFS_M(SFD_SFS(sfd)) / SF_M(sf)) + z = max (0.005, 0.03 * z) + call gmark (gp, x, y, GM_MAG, z, z) + } + if (SFD_W(sfd) < SF_W(sf)) + call gseti (gp, G_PLCOLOR, 2) + else + call gseti (gp, G_PLCOLOR, 3) + z = min (2., SFD_W(sfd) / rbest) + z = 0.010 * (1 + (z - 1) * 5) + call gmark (gp, x, y, GM_CIRCLE, z, z) + call gseti (gp, G_PLCOLOR, 1) + } + + call gseti (gp, G_PLTYPE, 2) + call gline (gp, x1, SF_W(sf), x2, SF_W(sf)) + call gseti (gp, G_PLTYPE, 1) + + # (R,Y) + call gseti (gp, G_WCS, 3) + call gseti (gp, G_XLABELTICKS, YES) + call gseti (gp, G_YLABELTICKS, YES) + call gseti (gp, G_XNMAJOR, 4) + call gseti (gp, G_XNMINOR, 0) + call gseti (gp, G_YNMAJOR, 6) + call gseti (gp, G_YNMINOR, 4) + call gsview (gp, vx[1,1], vx[1,2], vy[2,1], vy[2,2]) + call gswind (gp, 0., 1., 0., 1.) + call gfill (gp, fa, fa[5], 4, GF_SOLID) + + call gswind (gp, rmin, rmax, y1, y2) + call glabax (gp, "", SF_WTYPE(sf), "Line") + + do i = 1, SFF_NSFD(sff) { + sfd = SFF_SFD(sff,i) + if (SFD_STATUS(sfd) != 0) + next + x = SFD_W(sfd) + y = SFD_Y(sfd) + if (key == 1) { + z = sqrt (SFS_M(SFD_SFS(sfd)) / SF_M(sf)) + z = max (0.005, 0.03 * z) + call gmark (gp, x, y, GM_MAG, z, z) + } + if (SFD_W(sfd) < SF_W(sf)) + call gseti (gp, G_PLCOLOR, 2) + else + call gseti (gp, G_PLCOLOR, 3) + z = min (2., SFD_W(sfd) / rbest) + z = 0.010 * (1 + (z - 1) * 5) + call gmark (gp, x, y, GM_CIRCLE, z, z) + call gseti (gp, G_PLCOLOR, 1) + } + + call gseti (gp, G_PLTYPE, 2) + call gline (gp, SF_W(sf), y1, SF_W(sf), y2) + call gseti (gp, G_PLTYPE, 1) + + # (E,R) + call gseti (gp, G_WCS, 4) + call gseti (gp, G_DRAWAXES, 3) + call gseti (gp, G_XLABELTICKS, NO) + call gseti (gp, G_YLABELTICKS, YES) + call gseti (gp, G_XNMAJOR, 6) + call gseti (gp, G_XNMINOR, 4) + call gseti (gp, G_YNMAJOR, 4) + call gseti (gp, G_YNMINOR, 0) + call gsview (gp, vx[2,1], vx[2,2], vy[3,1], vy[3,2]) + call gswind (gp, 0., 1., 0., 1.) + call gfill (gp, fa, fa[5], 4, GF_SOLID) + + call gswind (gp, x1, x2, emin, emax) + call glabax (gp, "", "", "Ellip") + + do i = 1, SFF_NSFD(sff) { + sfd = SFF_SFD(sff,i) + if (SFD_STATUS(sfd) != 0) + next + x = SFD_X(sfd) + y = SFD_E(sfd) + if (key == 1) { + z = sqrt (SFS_M(SFD_SFS(sfd)) / SF_M(sf)) + z = max (0.005, 0.03 * z) + call gmark (gp, x, y, GM_MAG, z, z) + } + if (SFD_W(sfd) < SF_W(sf)) + call gseti (gp, G_PLCOLOR, 2) + else + call gseti (gp, G_PLCOLOR, 3) + z = min (2., SFD_W(sfd) / rbest) + z = 0.010 * (1 + (z - 1) * 5) + call gmark (gp, x, y, GM_CIRCLE, z, z) + call gseti (gp, G_PLCOLOR, 1) + } + + # (E,Y) + call gseti (gp, G_WCS, 5) + call gseti (gp, G_XLABELTICKS, YES) + call gseti (gp, G_YLABELTICKS, NO) + call gseti (gp, G_XNMAJOR, 4) + call gseti (gp, G_XNMINOR, 0) + call gseti (gp, G_YNMAJOR, 6) + call gseti (gp, G_YNMINOR, 4) + call gsview (gp, vx[3,1], vx[3,2], vy[2,1], vy[2,2]) + call gswind (gp, 0., 1., 0., 1.) + call gfill (gp, fa, fa[5], 4, GF_SOLID) + + call gswind (gp, emin, emax, y1, y2) + call glabax (gp, "", "Ellip", "") + + do i = 1, SFF_NSFD(sff) { + sfd = SFF_SFD(sff,i) + if (SFD_STATUS(sfd) != 0) + next + x = SFD_E(sfd) + y = SFD_Y(sfd) + if (key == 1) { + z = sqrt (SFS_M(SFD_SFS(sfd)) / SF_M(sf)) + z = max (0.005, 0.03 * z) + call gmark (gp, x, y, GM_MAG, z, z) + } + if (SFD_W(sfd) < SF_W(sf)) + call gseti (gp, G_PLCOLOR, 2) + else + call gseti (gp, G_PLCOLOR, 3) + z = min (2., SFD_W(sfd) / rbest) + z = 0.010 * (1 + (z - 1) * 5) + call gmark (gp, x, y, GM_CIRCLE, z, z) + call gseti (gp, G_PLCOLOR, 1) + } + + # Label window. + call gseti (gp, G_WCS, 1) + call gseti (gp, G_DRAWAXES, 0) + call gsview (gp, vx[1,1], vx[3,2], vy[1,1], vy[3,2]) + call glabax (gp, title, "", "") + + # (X,Y) + call gseti (gp, G_DRAWAXES, 3) + call gseti (gp, G_LABELTICKS, NO) + call gseti (gp, G_XNMAJOR, 6) + call gseti (gp, G_XNMINOR, 4) + call gseti (gp, G_YNMAJOR, 6) + call gseti (gp, G_YNMINOR, 4) + call gsview (gp, vx[2,1], vx[2,2], vy[2,1], vy[2,2]) + call gswind (gp, 0., 1., 0., 1.) + call gfill (gp, fa, fa[5], 4, GF_SOLID) + + call gswind (gp, x1, x2, y1, y2) + call glabax (gp, "", "", "") + + do i = 1, SFF_NSFD(sff) { + sfd = SFF_SFD(sff,i) + if (SFD_STATUS(sfd) != 0) + next + x = SFD_X(sfd) + y = SFD_Y(sfd) + if (key == 1) { + z = sqrt (SFS_M(SFD_SFS(sfd)) / SF_M(sf)) + z = max (0.005, 0.03 * z) + call gmark (gp, x, y, GM_MAG, z, z) + } + if (SFD_W(sfd) < SF_W(sf)) + call gseti (gp, G_PLCOLOR, 2) + else + call gseti (gp, G_PLCOLOR, 3) + z = min (2., SFD_W(sfd) / rbest) + z = 0.010 * (1 + (z - 1) * 5) + call gmark (gp, x, y, GM_CIRCLE, z, z) + call gseti (gp, G_PLCOLOR, 1) + } +end + + +# STF_G9 -- Spatial plots at best focus. + +procedure stf_g12 (sf, current, key, title) + +pointer sf #I Starfocus pointer +pointer current #I Current sfd pointer +int key #I Plot magnitude symbol? +char title[ARB] #I Title + +int i +real x, y, z, x1, x2, y1, y2, fmin, fmax, rbest, rmin, rmax +real vx[3,2], vy[3,2], dvx, dvy, fa[8] +pointer gp, sfs, sfd + +data fa/0.,1.,1.,0.,0.,0.,1.,1./ + +begin + gp = SF_GP(sf) + + # Range of X, Y, R, F. + x1 = 1. + y1 = 1. + x2 = SF_NCOLS(sf) + y2 = SF_NLINES(sf) + + rbest = SFD_W(SF_BEST(sf)) + fmin = MAX_REAL + fmax = -MAX_REAL + rmin = SF_W(sf) + rmax = 1.5 * SF_W(sf) + do i = 1, SF_NSTARS(sf) { + sfs = SF_SFS(sf,i) + if (SFS_N(sfs) == 0) + next + fmin = min (fmin, SFS_F(sfs)) + fmax = max (fmax, SFS_F(sfs)) + rmin = min (rmin, SFS_W(sfs)) + rmax = max (rmax, SFS_W(sfs)) + } + z = fmax - fmin + fmin = fmin - 0.1 * z + fmax = fmax + 0.1 * z + z = rmax - rmin + rmin = rmin - 0.1 * z + rmax = rmax + 0.1 * z + + # Set view ports + call ggview (gp, vx[1,1], vx[3,2], vy[1,1], vy[3,2]) + dvx = vx[3,2] - vx[1,1] + dvy = vy[3,2] - vy[1,1] + vx[1,1] = vx[1,1] + 0.00 * dvx + vx[1,2] = vx[1,1] + 0.20 * dvx + vx[2,1] = vx[1,1] + 0.25 * dvx + if (SF_NF(sf) > 1) { + vx[2,2] = vx[1,1] + 0.75 * dvx + vx[3,1] = vx[1,1] + 0.80 * dvx + vx[3,2] = vx[1,1] + 1.00 * dvx + } else { + vx[2,2] = vx[1,1] + 1.00 * dvx + vx[3,1] = vx[1,1] + 1.00 * dvx + vx[3,2] = vx[1,1] + 1.00 * dvx + } + vy[1,1] = vy[1,1] + 0.00 * dvy + vy[1,2] = vy[1,1] + 0.20 * dvy + vy[2,1] = vy[1,1] + 0.25 * dvy + if (SF_NF(sf) > 1) { + vy[2,2] = vy[1,1] + 0.75 * dvy + vy[3,1] = vy[1,1] + 0.80 * dvy + vy[3,2] = vy[1,1] + 1.00 * dvy + } else { + vy[2,2] = vy[1,1] + 1.00 * dvy + vy[3,1] = vy[1,1] + 1.00 * dvy + vy[3,2] = vy[1,1] + 1.00 * dvy + } + + dvx = vx[2,1] - vx[2,2] + dvy = vy[1,1] - vy[1,2] + if (abs (dvx) > 0.01 && abs (dvy) > 0.01) { + # (X,R) + call gseti (gp, G_WCS, 2) + call gseti (gp, G_DRAWAXES, 3) + call gseti (gp, G_XLABELTICKS, YES) + call gseti (gp, G_YLABELTICKS, YES) + call gseti (gp, G_XNMAJOR, 6) + call gseti (gp, G_XNMINOR, 4) + call gseti (gp, G_YNMAJOR, 4) + call gseti (gp, G_YNMINOR, 0) + call gsview (gp, vx[2,1], vx[2,2], vy[1,1], vy[1,2]) + call gswind (gp, 0., 1., 0., 1.) + call gfill (gp, fa, fa[5], 4, GF_SOLID) + + call gswind (gp, x1, x2, rmin, rmax) + call glabax (gp, "", "Column", "") + + do i = 1, SF_NSTARS(sf) { + sfs = SF_SFS(sf,i) + if (SFS_N(sfs) == 0) + next + x = SFD_X(SFS_SFD(sfs,1)) + y = SFS_W(sfs) + if (key == 1) { + z = sqrt (SFS_M(sfs) / SF_M(sf)) + z = max (0.005, 0.03 * z) + call gmark (gp, x, y, GM_MAG, z, z) + } + if (SFS_F(sfs) < SF_F(sf)) + call gseti (gp, G_PLCOLOR, 2) + else + call gseti (gp, G_PLCOLOR, 3) + z = min (2., SFS_W(sfs) / rbest) + z = 0.010 * (1 + (z - 1) * 5) + call gmark (gp, x, y, GM_CIRCLE, z, z) + call gseti (gp, G_PLCOLOR, 1) + } + + call gseti (gp, G_PLTYPE, 2) + call gline (gp, x1, SF_W(sf), x2, SF_W(sf)) + call gseti (gp, G_PLTYPE, 1) + } + + dvx = vx[1,1] - vx[1,2] + dvy = vy[2,1] - vy[2,2] + if (abs (dvx) > 0.01 && abs (dvy) > 0.01) { + # (R,Y) + call gseti (gp, G_WCS, 3) + call gseti (gp, G_XLABELTICKS, YES) + call gseti (gp, G_YLABELTICKS, YES) + call gseti (gp, G_XNMAJOR, 4) + call gseti (gp, G_XNMINOR, 0) + call gseti (gp, G_YNMAJOR, 6) + call gseti (gp, G_YNMINOR, 4) + call gsview (gp, vx[1,1], vx[1,2], vy[2,1], vy[2,2]) + call gswind (gp, 0., 1., 0., 1.) + call gfill (gp, fa, fa[5], 4, GF_SOLID) + + call gswind (gp, rmin, rmax, y1, y2) + call glabax (gp, "", SF_WTYPE(sf), "Line") + + do i = 1, SF_NSTARS(sf) { + sfs = SF_SFS(sf,i) + if (SFS_N(sfs) == 0) + next + x = SFS_W(sfs) + y = SFD_Y(SFS_SFD(sfs,1)) + if (key == 1) { + z = sqrt (SFS_M(sfs) / SF_M(sf)) + z = max (0.005, 0.03 * z) + call gmark (gp, x, y, GM_MAG, z, z) + } + if (SFS_F(sfs) < SF_F(sf)) + call gseti (gp, G_PLCOLOR, 2) + else + call gseti (gp, G_PLCOLOR, 3) + z = min (2., SFS_W(sfs) / rbest) + z = 0.010 * (1 + (z - 1) * 5) + call gmark (gp, x, y, GM_CIRCLE, z, z) + call gseti (gp, G_PLCOLOR, 1) + } + + call gseti (gp, G_PLTYPE, 2) + call gline (gp, SF_W(sf), y1, SF_W(sf), y2) + call gseti (gp, G_PLTYPE, 1) + } + + dvx = vx[2,1] - vx[2,2] + dvy = vy[3,1] - vy[3,2] + if (abs (dvx) > 0.01 && abs (dvy) > 0.01) { + # (X,F) + call gseti (gp, G_WCS, 4) + call gseti (gp, G_XLABELTICKS, NO) + call gseti (gp, G_YLABELTICKS, YES) + call gseti (gp, G_XNMAJOR, 6) + call gseti (gp, G_XNMINOR, 4) + call gseti (gp, G_YNMAJOR, 4) + call gseti (gp, G_YNMINOR, 0) + call gsview (gp, vx[2,1], vx[2,2], vy[3,1], vy[3,2]) + call gswind (gp, 0., 1., 0., 1.) + call gfill (gp, fa, fa[5], 4, GF_SOLID) + + call gswind (gp, x1, x2, fmin, fmax) + call glabax (gp, "", "", "Focus") + + do i = 1, SF_NSTARS(sf) { + sfs = SF_SFS(sf,i) + if (SFS_N(sfs) == 0) + next + x = SFD_X(SFS_SFD(sfs,1)) + y = SFS_F(sfs) + if (key == 1) { + z = sqrt (SFS_M(sfs) / SF_M(sf)) + z = max (0.005, 0.03 * z) + call gmark (gp, x, y, GM_MAG, z, z) + } + if (SFS_F(sfs) < SF_F(sf)) + call gseti (gp, G_PLCOLOR, 2) + else + call gseti (gp, G_PLCOLOR, 3) + z = min (2., SFS_W(sfs) / rbest) + z = 0.010 * (1 + (z - 1) * 5) + call gmark (gp, x, y, GM_CIRCLE, z, z) + call gseti (gp, G_PLCOLOR, 1) + } + + call gseti (gp, G_PLTYPE, 2) + call gline (gp, x1, SF_F(sf), x2, SF_F(sf)) + call gseti (gp, G_PLTYPE, 1) + } + + dvx = vx[3,1] - vx[3,2] + dvy = vy[2,1] - vy[2,2] + if (abs (dvx) > 0.01 && abs (dvy) > 0.01) { + # (F,Y) + call gseti (gp, G_WCS, 5) + call gseti (gp, G_XLABELTICKS, YES) + call gseti (gp, G_YLABELTICKS, NO) + call gseti (gp, G_XNMAJOR, 4) + call gseti (gp, G_XNMINOR, 0) + call gseti (gp, G_YNMAJOR, 6) + call gseti (gp, G_YNMINOR, 4) + call gsview (gp, vx[3,1], vx[3,2], vy[2,1], vy[2,2]) + call gswind (gp, 0., 1., 0., 1.) + call gfill (gp, fa, fa[5], 4, GF_SOLID) + + call gswind (gp, fmin, fmax, y1, y2) + call glabax (gp, "", "Focus", "") + + do i = 1, SF_NSTARS(sf) { + sfs = SF_SFS(sf,i) + if (SFS_N(sfs) == 0) + next + x = SFS_F(sfs) + y = SFD_Y(SFS_SFD(sfs,1)) + if (key == 1) { + z = sqrt (SFS_M(sfs) / SF_M(sf)) + z = max (0.005, 0.03 * z) + call gmark (gp, x, y, GM_MAG, z, z) + } + if (SFS_F(sfs) < SF_F(sf)) + call gseti (gp, G_PLCOLOR, 2) + else + call gseti (gp, G_PLCOLOR, 3) + z = min (2., SFS_W(sfs) / rbest) + z = 0.010 * (1 + (z - 1) * 5) + call gmark (gp, x, y, GM_CIRCLE, z, z) + call gseti (gp, G_PLCOLOR, 1) + } + + call gseti (gp, G_PLTYPE, 2) + call gline (gp, SF_F(sf), y1, SF_F(sf), y2) + call gseti (gp, G_PLTYPE, 1) + } + + # Label window. + call gseti (gp, G_WCS, 1) + call gseti (gp, G_DRAWAXES, 0) + call gsview (gp, vx[1,1], vx[3,2], vy[1,1], vy[3,2]) + call glabax (gp, title, "", "") + + dvx = vx[2,1] - vx[2,2] + dvy = vy[2,1] - vy[2,2] + if (abs (dvx) > 0.01 && abs (dvy) > 0.01) { + # (X,Y) + call gseti (gp, G_DRAWAXES, 3) + call gseti (gp, G_LABELTICKS, NO) + call gseti (gp, G_XNMAJOR, 6) + call gseti (gp, G_XNMINOR, 4) + call gseti (gp, G_YNMAJOR, 6) + call gseti (gp, G_YNMINOR, 4) + call gsview (gp, vx[2,1], vx[2,2], vy[2,1], vy[2,2]) + call gswind (gp, 0., 1., 0., 1.) + call gfill (gp, fa, fa[5], 4, GF_SOLID) + + call gswind (gp, x1, x2, y1, y2) + call glabax (gp, "", "", "") + + do i = 1, SF_NSTARS(sf) { + sfs = SF_SFS(sf,i) + if (SFS_N(sfs) == 0) + next + sfd = SFS_SFD(sfs,1) + x = SFD_X(sfd) + y = SFD_Y(sfd) + if (key == 1) { + z = sqrt (SFS_M(sfs) / SF_M(sf)) + z = max (0.005, 0.03 * z) + call gmark (gp, x, y, GM_MAG, z, z) + } + if (SFS_F(sfs) < SF_F(sf)) + call gseti (gp, G_PLCOLOR, 2) + else + call gseti (gp, G_PLCOLOR, 3) + z = min (2., SFS_W(sfs) / rbest) + z = 0.010 * (1 + (z - 1) * 5) + call gmark (gp, x, y, GM_CIRCLE, z, z) + call gseti (gp, G_PLCOLOR, 1) + } + } +end diff --git a/noao/obsutil/src/starfocus/stfhelp.key b/noao/obsutil/src/starfocus/stfhelp.key new file mode 100644 index 00000000..948bb9b7 --- /dev/null +++ b/noao/obsutil/src/starfocus/stfhelp.key @@ -0,0 +1,63 @@ + STARFOCUS COMMAND OPTIONS + + SUMMARY + +? Help f Focus p Radial profile u Undelete +a Spatial i Info q Quit x Delete +b Best m Magnitude r Redraw z Zoom +d Delete n Normalize s Mag symbols Next +e Enclosed flux o Offset t Field radius + +:level :radius :show :xcenter +:overplot :scale :size :ycenter + + + CURSOR COMMANDS + +All plots may not be available depending on the number of focus values and +the number of stars. + +? Page this help information +a Spatial plot at a single focus +b Spatial plot of best focus values +d Delete star nearest to cursor +e Enclosed flux for all stars at one focus and all focus for one star +f Size and ellipticity vs focus for all data +i Information about point nearest the cursor +m Size and ellipticity vs relative magnitude at one focus +n Normalize enclosed flux at x cursor position +o Offset enclosed flux to x,y cursor position by adjusting background +p Radial profiles for all stars at one focus and all focus for one star + The profiles are determined from the derivatives of the enclosed flux +q Quit +r Redraw +s Toggle magnitude symbols in spatial plots +t Size and ellipticity vs radius from field center at one focus +u Undelete all deleted points +x Delete nearest point, star, or focus (selected by query) +z Zoom to a single measurement showing enclosed flux and radial profile + Step through different focus or stars in current plot type + + + COLON COMMANDS + +A command without a value generally shows the current value of the +parameter while with a value it sets the value of the parameter. + +:level Level at which the size parameter is evaluated +:overplot Overplot the profiles from the narrowest profile? +:radius Change profile radius(*) +:show Page all information for the current set of objects +:size Size type (Radius|FWHM|GFWHM|MFWHM) (**) +:scale Pixel scale for size values +:xcenter X field center for radius from field center plots +:ycenter Y field center for radius from field center plots + +(*) The profile radius may not exceed the initial value set by the task + parameter. + +(**) +Radius = radius enclosing the fraction of the flux specified by "level" +FWHM = Full-width at half-maximum based on the radially smoothed profile +GFWHM = Full-width at half-maximum of Gaussian function fit to enclosed flux +MFWHM = Full-width at half-maximum of Moffat function fit to enclosed flux diff --git a/noao/obsutil/src/starfocus/stfmeasure.x b/noao/obsutil/src/starfocus/stfmeasure.x new file mode 100644 index 00000000..808b6058 --- /dev/null +++ b/noao/obsutil/src/starfocus/stfmeasure.x @@ -0,0 +1,134 @@ +include +include +include +include +include "starfocus.h" + + +# STF_MEASURE -- PSF measuring routine. +# This is a stand-alone routine that can be called to return the FWHM. +# It is a greatly abbreviated version of starfocus. + +procedure stf_measure (im, xc, yc, beta, level, radius, nit, + sbuffer, swidth, saturation, gp, logfd, + bkg, renclosed, dfwhm, gfwhm, mfwhm) + +pointer im #I Image pointer +real xc #I Initial X center +real yc #I Initial Y center +real beta #I Moffat beta +real level #I Measurement level +real radius #U Profile radius +int nit #I Number of iterations on radius +real sbuffer #I Sky buffer (pixels) +real swidth #I Sky width (pixels) +real saturation #I Saturation +pointer gp #I Graphics output if not NULL +int logfd #I Log output if not NULL +real bkg #O Background used +real renclosed #O Enclosed flux radius +real dfwhm #O Direct FWHM +real gfwhm #O Gaussian FWHM +real mfwhm #O Moffat FWHM + +int i +bool ignore_sat +pointer sp, str, sf, sfd, sfds + +int strdic() +real stf_r2i() +errchk stf_find, stf_bkgd, stf_profile, stf_widths, stf_fwhms, stf_organize + +begin + call smark (sp) + call salloc (str, SZ_FNAME, TY_CHAR) + call salloc (sf, SF, TY_STRUCT) + call salloc (sfd, SFD, TY_STRUCT) + call salloc (sfds, 1, TY_POINTER) + call aclri (Memi[sf], SF) + call aclri (Memi[sfd], SFD) + Memi[sfds] = sfd + + # Initialize parameters. + SF_TASK(sf) = PSFMEASURE + SF_WCODE(sf) = strdic ("FWHM", SF_WTYPE(sf), SF_SZWTYPE, SF_WTYPES) + SF_SCALE(sf) = 1. + SF_LEVEL(sf) = level + SF_BETA(sf) = beta + SF_RADIUS(sf) = radius + SF_SBUF(sf) = sbuffer + SF_SWIDTH(sf) = swidth + SF_SAT(sf) = saturation + SF_NIT(sf) = nit + SF_OVRPLT(sf) = NO + SF_NCOLS(sf) = IM_LEN(im,1) + SF_NLINES(sf) = IM_LEN(im,2) + SF_XF(sf) = (IM_LEN(im,1) + 1) / 2. + SF_YF(sf) = (IM_LEN(im,2) + 1) / 2. + ignore_sat = false + + call imstats (im, IM_IMAGENAME, SFD_IMAGE(sfd), SF_SZFNAME) + SFD_ID(sfd) = 1 + SFD_X(sfd) = xc + SFD_Y(sfd) = yc + SFD_F(sfd) = INDEF + SFD_STATUS(sfd) = 0 + SFD_SFS(sfd) = NULL + SFD_SFF(sfd) = NULL + SFD_SFI(sfd) = NULL + + if (SF_LEVEL(sf) > 1.) + SF_LEVEL(sf) = SF_LEVEL(sf) / 100. + SF_LEVEL(sf) = max (0.05, min (0.95, SF_LEVEL(sf))) + + # Evaluate PSF data. + iferr { + do i = 1, SF_NIT(sf) { + if (i == 1) + SFD_RADIUS(sfd) = SF_RADIUS(sf) + else + SFD_RADIUS(sfd) = 3. * SFD_DFWHM(sfd) + SFD_NPMAX(sfd) = stf_r2i (SFD_RADIUS(sfd)) + 1 + SFD_NP(sfd) = SFD_NPMAX(sfd) + call stf_find (sf, sfd, im) + call stf_bkgd (sf, sfd) + if (SFD_NSAT(sfd) > 0 && i == 1) { + if (ignore_sat) + call error (0, + "Saturated pixels found - ignoring object") + else + call eprintf ( + "WARNING: Saturated pixels found.\n") + } + call stf_profile (sf, sfd) + call stf_widths (sf, sfd) + call stf_fwhms (sf, sfd) + } + + # Set output results. + radius = SFD_RADIUS(sfd) + bkg = SFD_BKGD(sfd) + renclosed = SFD_R(sfd) + dfwhm = SFD_DFWHM(sfd) + mfwhm = SFD_MFWHM(sfd) + gfwhm = SFD_GFWHM(sfd) + + # Optional graph and log output. Note that the gp pointer is only + # used to indicate whether to make a graph. The stf_graph + # procedure opens its own graphics stream. + + call stf_organize (sf, sfds, 1) + if (gp != NULL) + call stf_graph (sf) + if (logfd != NULL) + call stf_log (sf, logfd) + + call asifree (SFD_ASI1(sfd)) + call asifree (SFD_ASI2(sfd)) + } then + call erract (EA_WARN) + + # Finish up + call stf_free (sf) + call sfree (sp) +end diff --git a/noao/obsutil/src/starfocus/stfprofile.x b/noao/obsutil/src/starfocus/stfprofile.x new file mode 100644 index 00000000..d26c085d --- /dev/null +++ b/noao/obsutil/src/starfocus/stfprofile.x @@ -0,0 +1,1189 @@ +include +include +include +include +include +include "starfocus.h" + + +# STF_FIND -- Find the object and return the data raster and object center. +# STF_BKGD -- Compute the background. +# STF_PROFILE -- Compute enclosed flux profile, derivative, and moments. +# STF_NORM -- Renormalized enclosed flux profile +# STF_WIDTHS -- Set widths. +# STF_I2R -- Radius from sample index. +# STF_R2I -- Sample index from radius. +# STF_R2N -- Number of subsamples from radius. +# STF_MODEL -- Return model values. +# STF_DFWHM -- Direct FWHM from profile. +# STF_FWHMS -- Measure FWHM vs level. +# STF_RADIUS -- Measure the radius at the specified level. +# STF_FIT -- Fit model. +# STF_GAUSS1 -- Gaussian function used in NLFIT. +# STF_GAUSS2 -- Gaussian function and derivatives used in NLFIT. +# STF_MOFFAT1 -- Moffat function used in NLFIT. +# STF_MOFFAT2 -- Moffat function and derivatives used in NLFIT. + + +# STF_FIND -- Find the object and return the data raster and object center. +# Centering uses centroid of marginal distributions of data above the mean. + +procedure stf_find (sf, sfd, im) + +pointer sf #I Starfocus pointer +pointer sfd #I Object pointer +pointer im #I Image pointer + +long lseed +int i, j, k, x1, x2, y1, y2, nx, ny, npts +real radius, buffer, width, xc, yc, xlast, ylast, r1, r2 +real mean, sum, sum1, sum2, sum3, asumr(), urand() +pointer data, ptr, imgs2r() +errchk imgs2r + +begin + radius = max (3., SFD_RADIUS(sfd)) + buffer = SF_SBUF(sf) + width = SF_SWIDTH(sf) + + xc = SFD_X(sfd) + yc = SFD_Y(sfd) + r1 = radius + buffer + width + r2 = radius + + # Iterate on the center finding. + do k = 1, 3 { + + # Extract region around current center. + xlast = xc + ylast = yc + + x1 = max (1-NBNDRYPIX, nint (xc - r2)) + x2 = min (IM_LEN(im,1)+NBNDRYPIX, nint (xc + r2)) + nx = x2 - x1 + 1 + y1 = max (1-NBNDRYPIX, nint (yc - r2)) + y2 = min (IM_LEN(im,2)+NBNDRYPIX, nint (yc + r2)) + ny = y2 - y1 + 1 + npts = nx * ny + data = imgs2r (im, x1, x2, y1, y2) + + # Find center of gravity of marginal distributions above mean. + npts = nx * ny + sum = asumr (Memr[data], npts) + mean = sum / nx + sum1 = 0. + sum2 = 0. + + do i = x1, x2 { + ptr = data + i - x1 + sum3 = 0. + do j = y1, y2 { + sum3 = sum3 + Memr[ptr] + ptr = ptr + nx + } + sum3 = sum3 - mean + if (sum3 > 0.) { + sum1 = sum1 + i * sum3 + sum2 = sum2 + sum3 + } + } + if (sum2 <= 0) + call error (1, "Centering failed to converge") + xc = sum1 / sum2 + if (xlast - xc > 0.2 * nx) + xc = xlast - 0.2 * nx + if (xc - xlast > 0.2 * nx) + xc = xlast + 0.2 * nx + + ptr = data + mean = sum / ny + sum1 = 0. + sum2 = 0. + do j = y1, y2 { + sum3 = 0. + do i = x1, x2 { + sum3 = sum3 + Memr[ptr] + ptr = ptr + 1 + } + sum3 = sum3 - mean + if (sum3 > 0.) { + sum1 = sum1 + j * sum3 + sum2 = sum2 + sum3 + } + } + if (sum2 <= 0) + call error (1, "Centering failed to converge") + yc = sum1 / sum2 + if (ylast - yc > 0.2 * ny) + yc = ylast - 0.2 * ny + if (yc - ylast > 0.2 * ny) + yc = ylast + 0.2 * ny + + if (nint(xc) == nint(xlast) && nint(yc) == nint(ylast)) + break + } + + # Get a new centered raster if necessary. + if (nint(xc) != nint(xlast) || nint(yc) != nint(ylast) || r2 < r1) { + x1 = max (1-NBNDRYPIX, nint (xc - r1)) + x2 = min (IM_LEN(im,1)+NBNDRYPIX, nint (xc + r1)) + nx = x2 - x1 + 1 + y1 = max (1-NBNDRYPIX, nint (yc - r1)) + y2 = min (IM_LEN(im,2)+NBNDRYPIX, nint (yc + r1)) + ny = y2 - y1 + 1 + npts = nx * ny + data = imgs2r (im, x1, x2, y1, y2) + } + + # Add a dither for integer data. The random numbers are always + # the same to provide reproducibility. + + i = IM_PIXTYPE(im) + if (i == TY_SHORT || i == TY_INT || i == TY_LONG) { + lseed = 1 + do i = 0, npts-1 + Memr[data+i] = Memr[data+i] + urand(lseed) - 0.5 + } + + SFD_DATA(sfd) = data + SFD_X1(sfd) = x1 + SFD_X2(sfd) = x2 + SFD_Y1(sfd) = y1 + SFD_Y2(sfd) = y2 + SFD_X(sfd) = xc + SFD_Y(sfd) = yc +end + + +# STF_BKGD -- Compute the background. +# A mode is estimated from the minimum slope in the sorted background pixels +# with a bin width of 5%. + +procedure stf_bkgd (sf, sfd) + +pointer sf #I Parameter structure +pointer sfd #I Star structure + +int i, j, x1, x2, y1, y2, xc, yc, nx, ny, npts, ns, nsat +real sat, bkgd, miso +real r, r1, r2, r3, dx, dy, dz +pointer sp, data, bdata, ptr + +begin + data = SFD_DATA(sfd) + x1 = SFD_X1(sfd) + x2 = SFD_X2(sfd) + y1 = SFD_Y1(sfd) + y2 = SFD_Y2(sfd) + xc = SFD_X(sfd) + yc = SFD_Y(sfd) + + nx = x2 - x1 + 1 + ny = y2 - y1 + 1 + npts = nx * ny + + ns = 0 + nsat = 0 + r1 = SFD_RADIUS(sfd) ** 2 + r2 = (SFD_RADIUS(sfd) + SF_SBUF(sf)) ** 2 + r3 = (SFD_RADIUS(sfd) + SF_SBUF(sf) + SF_SWIDTH(sf)) ** 2 + sat = SF_SAT(sf) + if (IS_INDEF(sat)) + sat = MAX_REAL + + call smark (sp) + call salloc (bdata, npts, TY_REAL) + + ptr = data + do j = y1, y2 { + dy = (yc - j) ** 2 + do i = x1, x2 { + dx = (xc - i) ** 2 + r = dx + dy + if (r <= r1) { + if (Memr[ptr] >= sat) + nsat = nsat + 1 + } else if (r >= r2 && r <= r3) { + Memr[bdata+ns] = Memr[ptr] + ns = ns + 1 + } + ptr = ptr + 1 + } + } + + if (ns > 9) { + call asrtr (Memr[bdata], Memr[bdata], ns) + r = Memr[bdata+ns-1] - Memr[bdata] + bkgd = Memr[bdata] + r / 2 + miso = r / 2 + + j = 1 + 0.50 * ns + do i = 0, ns - j { + dz = Memr[bdata+i+j-1] - Memr[bdata+i] + if (dz < r) { + r = dz + bkgd = Memr[bdata+i] + dz / 2 + miso = dz / 2 + } + } + } else { + bkgd = 0. + miso = 0. + } + + SFD_BKGD1(sfd) = bkgd + SFD_BKGD(sfd) = bkgd + SFD_MISO(sfd) = miso + SFD_NSAT(sfd) = nsat + + call sfree (sp) +end + + +# STF_PROFILE -- Compute enclosed flux profile, derivative, direct FWHM, and +# profile moments.. +# 1. The flux profile is normalized at the maximum value. +# 2. The radial profile is computed from the numerical derivative of the +# enclose flux profile. + +procedure stf_profile (sf, sfd) + +pointer sf #I Parameter structure +pointer sfd #I Star structure + +int np +real radius, xc, yc + +int i, j, k, l, m, ns, nx, ny, x1, x2, y1, y2 +real bkgd, miso, sigma, peak +real r, r1, r2, r3, dx, dy, dx1, dx2, dy1, dy2, dz, xx, yy, xy, ds, da +pointer sp, data, profile, ptr, asi, msi, gs +int stf_r2n() +real asieval(), msieval(), gseval(), stf_i2r(), stf_r2i() +errchk asiinit, asifit, msiinit, msifit, gsrestore + +real gsdata[24] +data gsdata/ 1., 4., 4., 1., 0., 0.6726812, 1., 2., 1.630641, 0.088787, + 0.00389378, -0.001457133, 0.3932125, -0.1267456, -0.004864541, + 0.00249941, 0.03078612, 0.02731274, -4.875850E-4, 2.307464E-4, + -0.002134843, 0.007603908, -0.002552385, -8.010564E-4/ + +begin + data = SFD_DATA(sfd) + x1 = SFD_X1(sfd) + x2 = SFD_X2(sfd) + y1 = SFD_Y1(sfd) + y2 = SFD_Y2(sfd) + xc = SFD_X(sfd) + yc = SFD_Y(sfd) + bkgd = SFD_BKGD(sfd) + miso = SFD_MISO(sfd) + radius = SFD_RADIUS(sfd) + np = SFD_NP(sfd) + + nx = x2 - x1 + 1 + ny = y2 - y1 + 1 + + # Use an image interpolator fit to the data. + call msiinit (msi, II_BISPLINE3) + call msifit (msi, Memr[data], nx, ny, nx) + + # To avoid trying to interpolate outside the center of the + # edge pixels, a requirement of the interpolator functions, + # we reset the data limits. + x1 = x1 + 1 + x2 = x2 - 1 + y1 = y1 + 1 + y2 = y2 - 1 + + # Compute the enclosed flux profile, its derivative, and moments. + call smark (sp) + call salloc (profile, np, TY_REAL) + call aclrr (Memr[profile], np) + + xx = 0. + yy = 0. + xy = 0. + do j = y1, y2 { + ptr = data + (j-y1+1)*nx + 1 + dy = j - yc + do i = x1, x2 { + dx = i - xc + + # Set the subpixel sampling which may be a function of radius. + r = sqrt (dx * dx + dy * dy) + ns = stf_r2n (r) + ds = 1. / ns + da = ds * ds + dz = 0.5 + 0.5 * ds + + # Sum the interpolator values over the subpixels and compute + # an offset to give the correct total for the pixel. + + r2 = 0. + dy1 = dy - dz + do l = 1, ns { + dy1 = dy1 + ds + dy2 = dy1 * dy1 + dx1 = dx - dz + do k = 1, ns { + dx1 = dx1 + ds + dx2 = dx1 * dx1 + r1 = msieval (msi, dx1+xc-x1+2, dy1+yc-y1+2) + r2 = r2 + r1 + } + } + + r1 = Memr[ptr] - bkgd + ptr = ptr + 1 + r2 = r1 - r2 * da + + # Accumulate the enclosed flux over the sub pixels. + dy1 = dy - dz + do l = 1, ns { + dy1 = dy1 + ds + dy2 = dy1 * dy1 + dx1 = dx - dz + do k = 1, ns { + dx1 = dx1 + ds + dx2 = dx1 * dx1 + r = max (0., sqrt (dx2 + dy2) - ds / 2) + if (r < radius) { + r1 = da * (msieval (msi, dx1+xc-x1+2, dy1+yc-y1+2) + + r2) + + # Use approximation for fractions of a subpixel. + for (m=stf_r2i(r)+1; m<=np; m=m+1) { + r3 = (stf_i2r (real(m)) - r) / ds + if (r3 >= 1.) + break + Memr[profile+m-1] = Memr[profile+m-1] + r3 * r1 + } + + # The subpixel is completely within these radii. + for (; m<=np; m=m+1) + Memr[profile+m-1] = Memr[profile+m-1] + r1 + + # Accumulate the moments above an isophote. + if (r1 > miso) { + xx = xx + dx2 * r1 + yy = yy + dy2 * r1 + xy = xy + dx1 * dy1 * r1 + } + } + } + } + } + } + + call msifree (msi) + + # Compute the ellipticity and position angle from the moments. + r = (xx + yy) + if (r > 0.) { + r1 = (xx - yy) / r + r2 = 2 * xy / r + SFD_E(sfd) = sqrt (r1**2 + r2**2) + SFD_PA(sfd) = RADTODEG (atan2 (r2, r1) / 2.) + } else { + SFD_E(sfd) = 0. + SFD_PA(sfd) = 0. + } + + # The magnitude and profile normalization is from the max enclosed flux. + call alimr (Memr[profile], np, r, SFD_M(sfd)) + if (SFD_M(sfd) <= 0.) + call error (1, "Invalid flux profile") + call adivkr (Memr[profile], SFD_M(sfd), Memr[profile], np) + + # Fit interpolator to the enclosed flux profile. + call asiinit (asi, II_SPLINE3) + call asifit (asi, Memr[profile], np) + SFD_ASI1(sfd) = asi + + # Estimate a gaussian sigma (actually sqrt(2)*sigma) and if it is + # it is small subtract the gaussian so that the image interpolator + # can more accurately estimate subpixel values. + + #call stf_radius (sf, sfd, SF_LEVEL(sf), r) + #sigma = r / sqrt (log (1/(1-SF_LEVEL(sf)))) + call stf_radius (sf, sfd, 0.8, r) + r = r / SF_SCALE(sf) + sigma = 2 * r * sqrt (log(2.) / log (1/(1-0.8))) + if (sigma < 5.) { + if (sigma <= 2.) { + call gsrestore (gs, gsdata) + dx = xc - nint (xc) + dy = yc - nint (yc) + r = sqrt (dx * dx + dy * dy) + dx = 1. + ds = abs (sigma - gseval (gs, r, dx)) + for (da = 1.; da <= 2.; da = da + .01) { + dz = abs (sigma - gseval (gs, r, da)) + if (dz < ds) { + ds = dz + dx = da + } + } + sigma = dx + call gsfree (gs) + } + + sigma = sigma / (2 * sqrt (log(2.))) + sigma = sigma * sigma + + # Compute the peak that gives the correct central pixel value. + i = nint (xc) + j = nint (yc) + dx = i - xc + dy = j - yc + r = sqrt (dx * dx + dy * dy) + ns = stf_r2n (r) + ds = 1. / ns + da = ds * ds + dz = 0.5 + 0.5 * ds + + r1 = 0. + dy1 = dy - dz + do l = 1, ns { + dy1 = dy1 + ds + dy2 = dy1 * dy1 + dx1 = dx - dz + do k = 1, ns { + dx1 = dx1 + ds + dx2 = dx1 * dx1 + r2 = (dx2 + dy2) / sigma + if (r2 < 25.) + r1 = r1 + exp (-r2) + } + } + ptr = data + (j - y1 + 1) * nx + (i - x1 + 1) + peak = (Memr[ptr] - bkgd) / (r1 * da) + + # Subtract the gaussian from the data. + do j = y1, y2 { + ptr = data + (j - y1 + 1) * nx + 1 + dy = j - yc + do i = x1, x2 { + dx = i - xc + r = sqrt (dx * dx + dy * dy) + ns = stf_r2n (r) + ds = 1. / ns + da = ds * ds + dz = 0.5 + 0.5 * ds + + r1 = 0. + dy1 = dy - dz + do l = 1, ns { + dy1 = dy1 + ds + dy2 = dy1 * dy1 + dx1 = dx - dz + do k = 1, ns { + dx1 = dx1 + ds + dx2 = dx1 * dx1 + r2 = (dx2 + dy2) / sigma + if (r2 < 25.) + r1 = r1 + peak * exp (-r2) + } + } + Memr[ptr] = Memr[ptr] - r1 * da + ptr = ptr + 1 + } + } + + # Fit the image interpolator to the residual data. + call msiinit (msi, II_BISPLINE3) + call msifit (msi, Memr[data], nx, ny, nx) + + # Recompute the enclosed flux profile and moments + # using the gaussian plus image interpolator fit to the residuals. + + call aclrr (Memr[profile], np) + + xx = 0. + yy = 0. + xy = 0. + do j = y1, y2 { + ptr = data + (j - y1 + 1) * nx + 1 + dy = j - yc + do i = x1, x2 { + dx = i - xc + r = sqrt (dx * dx + dy * dy) + ns = stf_r2n (r) + ds = 1. / ns + da = ds * ds + dz = 0.5 + 0.5 * ds + + # Compute interpolator correction. + r2 = 0. + dy1 = dy - dz + do l = 1, ns { + dy1 = dy1 + ds + dx1 = dx - dz + do k = 1, ns { + dx1 = dx1 + ds + r1 = msieval (msi, dx1+xc-x1+2, dy1+yc-y1+2) + r2 = r2 + r1 + } + } + + r1 = Memr[ptr] - bkgd + ptr = ptr + 1 + r2 = r1 - r2 * da + + # Accumulate the enclosed flux and moments. + dy1 = dy - dz + do l = 1, ns { + dy1 = dy1 + ds + dy2 = dy1 * dy1 + dx1 = dx - dz + do k = 1, ns { + dx1 = dx1 + ds + dx2 = dx1 * dx1 + r3 = (dx2 + dy2) / sigma + if (r3 < 25.) + r3 = peak * exp (-r3) + else + r3 = 0. + r = max (0., sqrt (dx2 + dy2) - ds / 2) + if (r < radius) { + r1 = msieval (msi, dx1+xc-x1+2, dy1+yc-y1+2) + r1 = da * (r1 + r2 + r3) + + for (m=stf_r2i(r)+1; m<=np; m=m+1) { + r3 = (stf_i2r (real(m)) - r) / ds + if (r3 >= 1.) + break + Memr[profile+m-1] = Memr[profile+m-1] + + r3 * r1 + } + for (; m<=np; m=m+1) + Memr[profile+m-1] = Memr[profile+m-1] + r1 + + if (r1 > miso) { + xx = xx + dx2 * r1 + yy = yy + dy2 * r1 + xy = xy + dx1 * dy1 * r1 + } + } + } + } + } + } + + call msifree (msi) + + # Recompute the moments, magnitude, normalized flux, and interp. + r = (xx + yy) + if (r > 0.) { + r1 = (xx - yy) / r + r2 = 2 * xy / r + SFD_E(sfd) = sqrt (r1**2 + r2**2) + SFD_PA(sfd) = RADTODEG (atan2 (r2, r1) / 2.) + } else { + SFD_E(sfd) = 0. + SFD_PA(sfd) = 0. + } + + call alimr (Memr[profile], np, r, SFD_M(sfd)) + if (SFD_M(sfd) <= 0.) + call error (1, "Invalid flux profile") + call adivkr (Memr[profile], SFD_M(sfd), Memr[profile], np) + + call asifit (asi, Memr[profile], np) + SFD_ASI1(sfd) = asi + } + + # Compute derivative of enclosed flux profile and fit an image + # interpolator. + + dx = 0.25 + Memr[profile] = 0. + ns = 0 + do i = 1, np { + r = stf_i2r (real(i)) + r2 = stf_r2i (r + dx) + if (r2 > np) { + k = i + break + } + r1 = stf_r2i (r - dx) + if (r1 < 1) { + if (i > 1) { + dy = asieval (asi, real(i)) / r**2 + Memr[profile] = (ns * Memr[profile] + dy) / (ns + 1) + ns = ns + 1 + } + j = i + } else { + dy = (asieval (asi, r2) - asieval (asi, r1)) / + (4 * r * dx) + Memr[profile+i-1] = dy + } + } + do i = 2, j + Memr[profile+i-1] = (Memr[profile+j] - Memr[profile]) / j * + (i - 1) + Memr[profile] + do i = k, np + Memr[profile+i-1] = Memr[profile+k-2] + + call adivkr (Memr[profile], SF_SCALE(sf)**2, Memr[profile], np) + call alimr (Memr[profile], np, SFD_YP1(sfd), SFD_YP2(sfd)) + call asiinit (asi, II_SPLINE3) + call asifit (asi, Memr[profile], np) + SFD_ASI2(sfd) = asi + #SF_XP1(sf) = j+1 + SF_XP1(sf) = 1 + SF_XP2(sf) = k-1 + + call sfree (sp) +end + + +# STF_NORM -- Renormalize the enclosed flux profile. + +procedure stf_norm (sf, sfd, x, y) + +pointer sf #I Parameter structure +pointer sfd #I Star structure +real x #I Radius +real y #I Flux + +int npmax, np +pointer asi + +int i, j, k +real r, r1, r2, dx, dy +pointer sp, profile +real asieval(), stf_i2r(), stf_r2i() +errchk asifit + +begin + npmax = SFD_NPMAX(sfd) + np = SFD_NP(sfd) + asi = SFD_ASI1(sfd) + + call smark (sp) + call salloc (profile, npmax, TY_REAL) + + # Renormalize the enclosed flux profile. + if (IS_INDEF(x) || x <= 0.) { + dy = SFD_BKGD(sfd) - SFD_BKGD1(sfd) + SFD_BKGD(sfd) = SFD_BKGD(sfd) - dy + do i = 1, npmax + Memr[profile+i-1] = asieval (asi, real(i)) + + dy * stf_i2r(real(i)) ** 2 + call alimr (Memr[profile], np, r1, r2) + call adivkr (Memr[profile], r2, Memr[profile], npmax) + } else if (IS_INDEF(y)) { + r = max (1., min (real(np), stf_r2i (x))) + r2 = asieval (asi, r) + if (r2 <= 0.) + return + do i = 1, npmax + Memr[profile+i-1] = asieval (asi, real(i)) + call adivkr (Memr[profile], r2, Memr[profile], npmax) + } else { + r = max (1., min (real(np), stf_r2i (x))) + r1 = asieval (asi, r) + dy = (y - r1) / x ** 2 + SFD_BKGD(sfd) = SFD_BKGD(sfd) - dy + do i = 1, npmax + Memr[profile+i-1] = asieval (asi, real(i)) + + dy * stf_i2r(real(i)) ** 2 + } + + call asifit (asi, Memr[profile], npmax) + SFD_ASI1(sfd) = asi + + # Compute derivative of enclosed flux profile and fit an image + # interpolator. + + dx = 0.25 + do i = 1, npmax { + r = stf_i2r (real(i)) + r2 = stf_r2i (r + dx) + if (r2 > np) { + k = i + break + } + r1 = stf_r2i (r - dx) + if (r1 < 1) { + if (i > 1) { + dy = asieval (asi, real(i)) / r**2 + Memr[profile] = dy + } + j = i + } else { + dy = (asieval (asi, r2) - asieval (asi, r1)) / + (4 * r * dx) + Memr[profile+i-1] = dy + } + } + do i = 2, j + Memr[profile+i-1] = (Memr[profile+j] - Memr[profile]) / j * + (i - 1) + Memr[profile] + do i = k, npmax + Memr[profile+i-1] = Memr[profile+k-2] + + call adivkr (Memr[profile], SF_SCALE(sf)**2, Memr[profile], np) + call alimr (Memr[profile], np, SFD_YP1(sfd), SFD_YP2(sfd)) + asi = SFD_ASI2(sfd) + call asifit (asi, Memr[profile], np) + SFD_ASI2(sfd) = asi + #SF_XP1(sf) = min (j+1, np) + SF_XP1(sf) = 1 + SF_XP2(sf) = min (k-1, np) + + call sfree (sp) +end + + +# STF_WIDTHS -- Set the widhts. + +procedure stf_widths (sf, sfd) + +pointer sf #I Main data structure +pointer sfd #I Star data structure + +errchk stf_radius, stf_dfwhm, stf_fit + +begin + call stf_radius (sf, sfd, SF_LEVEL(sf), SFD_R(sfd)) + call stf_dfwhm (sf, sfd) + call stf_fit (sf, sfd) + + switch (SF_WCODE(sf)) { + case 1: + SFD_W(sfd) = SFD_R(sfd) + case 2: + SFD_W(sfd) = SFD_DFWHM(sfd) + case 3: + SFD_W(sfd) = SFD_GFWHM(sfd) + case 4: + SFD_W(sfd) = SFD_MFWHM(sfd) + } +end + + +# STF_I2R -- Compute radius from sample index. + +real procedure stf_i2r (i) + +real i #I Index +real r #O Radius + +begin + if (i < 20) + r = 0.05 * i + else if (i < 30) + r = 0.1 * i - 1 + else if (i < 40) + r = 0.2 * i - 4 + else if (i < 50) + r = 0.5 * i - 16 + else + r = i - 41 + return (r) +end + + +# STF_R2I -- Compute sample index from radius. + +real procedure stf_r2i (r) + +real r #I Radius +real i #O Index + +begin + if (r < 1) + i = 20 * r + else if (r < 2) + i = 10 * (r + 1) + else if (r < 4) + i = 5 * (r + 4) + else if (r < 9) + i = 2 * (r + 16) + else + i = r + 41 + return (i) +end + + +# STF_R2N -- Compute number of subsamples from radius. + +int procedure stf_r2n (r) + +real r #I Radius +int n #O Number of subsamples + +begin + if (r < 1) + n = 20 + else if (r < 2) + n = 10 + else if (r < 4) + n = 5 + else if (r < 9) + n = 2 + else + n = 1 + return (n) +end + + +# STF_MODEL -- Return model value. + +procedure stf_model (sf, sfd, r, profile, flux) + +pointer sf #I Main data structure +pointer sfd #I Star data structure +real r #I Radius at level +real profile #I Profile value +real flux #I Enclosed flux value + +real x, x1, x2, r1, r2, dr + +begin + dr = 0.25 * SF_SCALE(sf) + r1 = r - dr + r2 = r + dr + if (r1 < 0.) { + r1 = dr + r2 = r1 + dr + } + + switch (SF_WCODE(sf)) { + case 3: + x = r**2 / (2. * SFD_SIGMA(sfd)**2) + if (x < 20.) + flux = 1 - exp (-x) + else + flux = 0. + + x1 = r1**2 / (2. * SFD_SIGMA(sfd)**2) + x2 = r2**2 / (2. * SFD_SIGMA(sfd)**2) + if (x2 < 20.) { + x1 = 1 - exp (-x1) + x2 = 1 - exp (-x2) + } else { + x1 = 1. + x2 = 1. + } + if (r <= dr) { + x1 = x1 / dr ** 2 + x2 = x2 / (4 * dr ** 2) + profile = (x2 - x1) / dr * r + x1 + } else { + profile = (x2 - x1) / (4 * r * dr) + } + default: + x = 1 + (r / SFD_ALPHA(sfd)) ** 2 + flux = 1 - x ** (1 - SFD_BETA(sfd)) + + x1 = 1 + (r1 / SFD_ALPHA(sfd)) ** 2 + x2 = 1 + (r2 / SFD_ALPHA(sfd)) ** 2 + x1 = 1 - x1 ** (1 - SFD_BETA(sfd)) + x2 = 1 - x2 ** (1 - SFD_BETA(sfd)) + if (r <= dr) { + x1 = x1 / dr ** 2 + x2 = x2 / (4 * dr ** 2) + profile = (x2 - x1) / dr * r + x1 + } else { + profile = (x2 - x1) / (4 * r * dr) + } + } +end + + +# STF_DFWHM -- Direct FWHM from profile. + +procedure stf_dfwhm (sf, sfd) + +pointer sf #I Main data structure +pointer sfd #I Star data structure + +int np +real r, rpeak, profile, peak, asieval(), stf_i2r() +pointer asi + +begin + asi = SFD_ASI2(sfd) + np = SFD_NP(sfd) + + rpeak = 1. + peak = 0. + for (r=1.; r <= np; r = r + 0.01) { + profile = asieval (asi, r) + if (profile > peak) { + rpeak = r + peak = profile + } + } + + peak = peak / 2. + for (r=rpeak; r <= np && asieval (asi, r) > peak; r = r + 0.01) + ; + + SFD_DFWHM(sfd) = 2 * stf_i2r (r) * SF_SCALE(sf) +end + + +# STF_FWHMS -- Measure FWHM vs level. + +procedure stf_fwhms (sf, sfd) + +pointer sf #I Main data structure +pointer sfd #I Star data structure + +int i +real level, r + +begin + do i = 1, 19 { + level = i * 0.05 + call stf_radius (sf, sfd, level, r) + switch (SF_WCODE(sf)) { + case 3: + SFD_FWHM(sfd,i) = 2 * r * sqrt (log (2.) / log (1/(1-level))) + default: + r = r / sqrt ((1.-level)**(1./(1.-SFD_BETA(sfd))) - 1.) + SFD_FWHM(sfd,i) = 2 * r * sqrt (2.**(1./SFD_BETA(sfd))-1.) + } + } +end + + +# STF_RADIUS -- Measure the radius at the specified level. + +procedure stf_radius (sf, sfd, level, r) + +pointer sf #I Main data structure +pointer sfd #I Star data structure +real level #I Level to measure +real r #O Radius + +int np +pointer asi +real f, fmax, rmax, asieval(), stf_i2r() + +begin + np = SFD_NP(sfd) + asi = SFD_ASI1(sfd) + + for (r=1; r <= np && asieval (asi, r) < level; r = r + 0.01) + ; + if (r > np) { + fmax = 0. + rmax = 0. + for (r=1; r <= np; r = r + 0.01) { + f = asieval (asi, r) + if (f > fmax) { + fmax = f + rmax = r + } + } + r = rmax + } + r = stf_i2r (r) * SF_SCALE(sf) +end + + +# STF_FIT -- Fit models to enclosed flux. + +procedure stf_fit (sf, sfd) + +pointer sf #I Main data structure +pointer sfd #I Star data structure + +int i, j, n, np, pfit[2] +real beta, z, params[3] +pointer asi, nl +pointer sp, x, y, w + +int locpr() +real asieval(), stf_i2r() +extern stf_gauss1(), stf_gauss2(), stf_moffat1(), stf_moffat2() +errchk nlinitr, nlfitr + +data pfit/2,3/ + +begin + np = SFD_NP(sfd) + asi = SFD_ASI1(sfd) + + call smark (sp) + call salloc (x, np, TY_REAL) + call salloc (y, np, TY_REAL) + call salloc (w, np, TY_REAL) + + n = 0 + j = 0 + do i = 1, np { + z = 1. - max (0., asieval (asi, real(i))) + if (n > np/3 && z < 0.5) + break + if ((n < np/3 && z > 0.01) || z > 0.5) + j = n + + Memr[x+n] = stf_i2r (real(i)) * SF_SCALE(sf) + Memr[y+n] = z + Memr[w+n] = 1. + n = n + 1 + } + + # Gaussian. + np = 1 + params[2] = Memr[x+j] / sqrt (2. * log (1./min(0.99,Memr[y+j]))) + params[1] = 1 + call nlinitr (nl, locpr (stf_gauss1), locpr (stf_gauss2), + params, params, 2, pfit, np, .001, 100) + call nlfitr (nl, Memr[x], Memr[y], Memr[w], n, 1, WTS_USER, i) + if (i != SINGULAR && i != NO_DEG_FREEDOM) { + call nlpgetr (nl, params, i) + if (params[2] < 0.) + params[2] = Memr[x+j] / sqrt (2. * log (1./min(0.99,Memr[y+j]))) + } + SFD_SIGMA(sfd) = params[2] + SFD_GFWHM(sfd) = 2 * SFD_SIGMA(sfd) * sqrt (2. * log (2.)) + + # Moffat. + if (SF_BETA(sf) < 1.1) { + call nlfreer (nl) + call sfree (sp) + call error (1, "Cannot measure FWHM - Moffat beta too small") + } + + beta = SF_BETA(sf) + if (IS_INDEFR(beta)) { + beta = 2.5 + np = 2 + } else { + np = 1 + } + params[3] = 1 - beta + params[2] = Memr[x+j] / sqrt (min(0.99,Memr[y+j])**(1./params[3]) - 1.) + params[1] = 1 + call nlinitr (nl, locpr (stf_moffat1), locpr (stf_moffat2), + params, params, 3, pfit, np, .001, 100) + call nlfitr (nl, Memr[x], Memr[y], Memr[w], n, 1, WTS_USER, i) + if (i != SINGULAR && i != NO_DEG_FREEDOM) { + call nlpgetr (nl, params, i) + if (params[2] < 0.) { + params[3] = 1. - beta + params[2] = Memr[x+j] / + sqrt (min(0.99,Memr[y+j])**(1./params[3]) - 1.) + } + } + SFD_ALPHA(sfd) = params[2] + SFD_BETA(sfd) = 1 - params[3] + SFD_MFWHM(sfd) = 2 * SFD_ALPHA(sfd) * sqrt (2.**(1./SFD_BETA(sfd))-1.) + + call nlfreer (nl) + call sfree (sp) +end + + +# STF_GAUSS1 -- Gaussian function used in NLFIT. The parameters are the +# amplitude and sigma and the input variable is the radius. + +procedure stf_gauss1 (x, nvars, p, np, z) + +real x[nvars] #I Input variables +int nvars #I Number of variables +real p[np] #I Parameter vector +int np #I Number of parameters +real z #O Function return + +real r2 + +begin + r2 = x[1]**2 / (2 * p[2]**2) + if (abs (r2) > 20.) + z = 0. + else + z = p[1] * exp (-r2) +end + + +# STF_GAUSS2 -- Gaussian function and derivatives used in NLFIT. The parameters +# are the amplitude and sigma and the input variable is the radius. + +procedure stf_gauss2 (x, nvars, p, dp, np, z, der) + +real x[nvars] #I Input variables +int nvars #I Number of variables +real p[np] #I Parameter vector +real dp[np] #I Dummy array of parameters increments +int np #I Number of parameters +real z #O Function return +real der[np] #O Derivatives + +real r2 + +begin + r2 = x[1]**2 / (2 * p[2]**2) + if (abs (r2) > 20.) { + z = 0. + der[1] = 0. + der[2] = 0. + } else { + der[1] = exp (-r2) + z = p[1] * der[1] + der[2] = z * 2 * r2 / p[2] + } +end + + +# STF_MOFFAT1 -- Moffat function used in NLFIT. The parameters are the +# amplitude, alpha squared, and beta and the input variable is the radius. + +procedure stf_moffat1 (x, nvars, p, np, z) + +real x[nvars] #I Input variables +int nvars #I Number of variables +real p[np] #I Parameter vector +int np #I Number of parameters +real z #O Function return + +real y + +begin + y = 1 + (x[1] / p[2]) ** 2 + if (abs (y) > 20.) + z = 0. + else + z = p[1] * y ** p[3] +end + + +# STF_MOFFAT2 -- Moffat function and derivatives used in NLFIT. The +# parameters are the amplitude, alpha squared, and beta and the input +# variable is the radius. + +procedure stf_moffat2 (x, nvars, p, dp, np, z, der) + +real x[nvars] #I Input variables +int nvars #I Number of variables +real p[np] #I Parameter vector +real dp[np] #I Dummy array of parameters increments +int np #I Number of parameters +real z #O Function return +real der[np] #O Derivatives + +real y + +begin + y = 1 + (x[1] / p[2]) ** 2 + if (abs (y) > 20.) { + z = 0. + der[1] = 0. + der[2] = 0. + der[3] = 0. + } else { + der[1] = y ** p[3] + z = p[1] * der[1] + der[2] = -2 * z / y * p[3] / p[2] * (x[1] / p[2]) ** 2 + der[3] = z * log (y) + } +end diff --git a/noao/obsutil/src/starfocus/t_starfocus.x b/noao/obsutil/src/starfocus/t_starfocus.x new file mode 100644 index 00000000..2c3213e9 --- /dev/null +++ b/noao/obsutil/src/starfocus/t_starfocus.x @@ -0,0 +1,1240 @@ +include +include +include +include +include "starfocus.h" + +define HELP "nmisc$src/starfocus.key" +define PROMPT "Options" + + +# T_STARFOCUS -- Stellar focusing task. + +procedure t_starfocus () + +begin + call starfocus (STARFOCUS) +end + + +# T_PSFMEASURE -- PSF measuring task. + +procedure t_psfmeasure () + +begin + call starfocus (PSFMEASURE) +end + + +# STARFOCUS -- Stellar focusing and PSF measuring main routine. + +procedure starfocus (type) + +int type #I Task type + +int list # List of images +pointer fvals # Focus values +pointer fstep # Focus step +pointer nexposures # Number of exposures +pointer step # step in pixels +int direction # Step direction +int gap # Double step gap +int coords # Type of image data +bool display # Display images? +int frame # Display frame +int logfd # Log file descriptor +bool ignore_sat # Ignore saturation? + +real wx, wy, f, df, xstep, ystep +int i, i1, i2, i3, j, k, l, ip, wcs, key, id, ncols, nlines +int nexp, nsfd, nimages, nstars, ngraph, nmark +pointer sp, sf, image, system, cmd, rg, mark, im, mw, ct +pointer sfds, sfd + +bool clgetb(), streq() +real clgetr(), imgetr(), stf_r2i() +int clgeti(), clgwrd(), clgcur(), imtopenp(), imtgetim(), imgeti() +int nowhite(), open(), rng_index(), strdic(), ctoi(), ctor() +pointer rng_open(), immap(), mw_openim(), mw_sctran() +errchk immap, open, imgetr, imgeti, mw_openim, mw_sctran +errchk stf_find, stf_bkgd, stf_profile, stf_widths, stf_fwhms, stf_radius +errchk stf_organize, stf_graph, stf_display + +begin + call smark (sp) + call salloc (sf, SF, TY_STRUCT) + call salloc (image, SZ_FNAME, TY_CHAR) + call salloc (fvals, SZ_LINE, TY_CHAR) + call salloc (fstep, SZ_LINE, TY_CHAR) + call salloc (nexposures, SZ_LINE, TY_CHAR) + call salloc (step, SZ_LINE, TY_CHAR) + call salloc (system, SZ_LINE, TY_CHAR) + call salloc (cmd, SZ_LINE, TY_CHAR) + + call aclri (Memi[sf], SF) + SF_TASK(sf) = type + + # Set task parameters. + switch (type) { + case STARFOCUS: + call clgstr ("focus", Memc[fvals], SZ_LINE) + call clgstr ("fstep", Memc[fstep], SZ_LINE) + call clgstr ("nexposures", Memc[nexposures], SZ_LINE) + call clgstr ("step", Memc[step], SZ_LINE) + + direction = clgwrd ("direction", Memc[cmd], SZ_LINE, + "|-line|+line+|-column|+column|") + gap = clgwrd ("gap", Memc[cmd], SZ_LINE, "|none|beginning|end|") + + if (nowhite (Memc[fvals], Memc[fvals], SZ_LINE) != 0) { + iferr (rg = rng_open (Memc[fvals], -MAX_REAL, MAX_REAL, 1.)) + rg = NULL + } else + rg = NULL + case PSFMEASURE: + Memc[fvals] = EOS + rg = NULL + nexp = 1 + } + + list = imtopenp ("images") + display = clgetb ("display") + frame = clgeti ("frame") + coords = clgwrd ("coords", Memc[cmd], SZ_LINE, SF_TYPES) + call clgstr ("wcs", Memc[system], SZ_LINE) + + SF_XF(sf) = clgetr ("xcenter") + SF_YF(sf) = clgetr ("ycenter") + SF_LEVEL(sf) = clgetr ("level") + SF_WCODE(sf) = clgwrd ("size", SF_WTYPE(sf), SF_SZWTYPE, SF_WTYPES) + SF_BETA(sf) = clgetr ("beta") + SF_SCALE(sf) = clgetr ("scale") + SF_RADIUS(sf) = max (3., clgetr ("radius")) + SF_NIT(sf) = clgeti ("iterations") + SF_SBUF(sf) = clgetr ("sbuffer") + SF_SWIDTH(sf) = clgetr ("swidth") + SF_SAT(sf) = clgetr ("saturation") + ignore_sat = clgetb ("ignore_sat") + SF_OVRPLT(sf) = NO + + if (SF_LEVEL(sf) > 1.) + SF_LEVEL(sf) = SF_LEVEL(sf) / 100. + SF_LEVEL(sf) = max (0.05, min (0.95, SF_LEVEL(sf))) + + # Accumulate the psf/focus data. + key = 'm' + mark = NULL + nstars = 0 + nmark = 0 + ngraph = 0 + nimages = 0 + nsfd = 0 + while (imtgetim (list, Memc[image], SZ_FNAME) != EOF) { + im = immap (Memc[image], READ_ONLY, 0) + call imseti (im, IM_TYBNDRY, TYBNDRY) + call imseti (im, IM_NBNDRYPIX, NBNDRYPIX) + if (streq (Memc[system], "logical")) { + mw = NULL + ct = NULL + } else { + mw = mw_openim (im) + ct = mw_sctran (mw, Memc[system], "logical", 03) + } + ncols = IM_LEN(im,1) + nlines = IM_LEN(im,2) + nimages = nimages + 1 + if (nimages == 1) { + SF_NCOLS(sf) = ncols + SF_NLINES(sf) = nlines + if (IS_INDEF(SF_XF(sf))) + SF_XF(sf) = (SF_NCOLS(sf) + 1) / 2. + if (IS_INDEF(SF_YF(sf))) + SF_YF(sf) = (SF_NLINES(sf) + 1) / 2. + } else if (ncols!=SF_NCOLS(sf)||nlines!=SF_NLINES(sf)) + call eprintf ("WARNING: Images have different sizes\n") + + # Display the image if needed. + if (display) { + switch (coords) { + case SF_MARK1: + if (nimages == 1) + call stf_display (Memc[image], frame) + case SF_MARKALL: + call stf_display (Memc[image], frame) + } + if (nimages == 1) { + call printf ( + "** Select stars to measure with 'm' and finish with 'q'.\n") + call printf ( + "** Additional options are '?', 'g', and :show.\n") + call flush (STDOUT) + } + } + + # Accumulate objects. + repeat { + switch (coords) { + case SF_CENTER: + if (nstars == nimages) + break + if (rg == NULL && Memc[fvals] == EOS) + id = nstars + else + id = 0 + wx = 1 + (ncols - 1) / 2. + wy = 1 + (nlines - 1) / 2. + key = 0 + case SF_MARK1: + if (nimages == 1) { + if (clgcur ("imagecur", wx, wy, wcs, key, + Memc[cmd], SZ_LINE) == EOF) + break + switch (key) { + case '?': + call pagefile (HELP, PROMPT) + next + case ':': + if (strdic (Memc[cmd], Memc[cmd], SZ_LINE, + "|show|") == 1) { + if (nsfd > 0) { + call stf_organize (sf, sfds, nsfd) + call mktemp ("tmp$iraf", Memc[cmd], SZ_LINE) + logfd = open (Memc[cmd], APPEND, TEXT_FILE) + call stf_log (sf, logfd) + call close (logfd) + call pagefile (Memc[cmd], "starfocus") + call delete (Memc[cmd]) + } + } + next + case 'q': + break + } + id = nstars + if (mark == NULL) + call malloc (mark, 3*10, TY_REAL) + else if (mod (nmark, 10) == 0) + call realloc (mark, 3*(nmark+10), TY_REAL) + Memr[mark+3*nmark] = id + Memr[mark+3*nmark+1] = wx + Memr[mark+3*nmark+2] = wy + nmark = nmark+1 + } else { + if (nmark == 0) + break + if (nstars / nmark == nimages) + break + i = mod (nstars, nmark) + id = Memr[mark+3*i] + wx = Memr[mark+3*i+1] + wy = Memr[mark+3*i+2] + key = 0 + } + if (ct != NULL) + call mw_c2tranr (ct, wx, wy, wx, wy) + case SF_MARKALL: + if (clgcur ("imagecur", wx, wy, wcs, key, + Memc[cmd], SZ_LINE) == EOF) + break + switch (key) { + case '?': + call pagefile (HELP, PROMPT) + next + case ':': + if (strdic(Memc[cmd],Memc[cmd],SZ_LINE,"|show|")==1) { + if (nsfd > 0) { + call stf_organize (sf, sfds, nsfd) + call mktemp ("tmp$iraf", Memc[cmd], SZ_LINE) + logfd = open (Memc[cmd], APPEND, TEXT_FILE) + call stf_log (sf, logfd) + call close (logfd) + call pagefile (Memc[cmd], "starfocus") + call delete (Memc[cmd]) + } + } + next + case 'q': + break + } + id = nstars + if (ct != NULL) + call mw_c2tranr (ct, wx, wy, wx, wy) + } + + if (type == STARFOCUS) { + ip = 1 + if (ctoi (Memc[nexposures], ip, nexp) == 0) + nexp = imgeti (im, Memc[nexposures]) + ip = 1 + if (ctor (Memc[step], ip, f) == 0) + f = imgetr (im, Memc[step]) + + xstep = 0. + ystep = 0. + switch (direction) { + case 1: + ystep = -f + case 2: + ystep = f + case 3: + xstep = -f + case 4: + xstep = f + } + + # Set the steps and order of evaluation. + # This depends on which star in the sequence is marked. + # Below we assume the minimum x or maximum y is marked. + + i1 = 1; i2 = nexp; i3 = 1 +# if (xstep < 0.) { +# i1 = nexp; i2 = 1; i3 = -1; xstep = -xstep +# } +# if (ystep > 0.) { +# i1 = nexp; i2 = 1; i3 = -1; ystep = -ystep +# } + } else { + i1 = 1; i2 = 1; i3 = 1 + } + + k = nsfd + do i = i1, i2, i3 { + if (i > 1) { + wx = wx + xstep + wy = wy + ystep + switch (gap) { + case 2: + if ((i==2 && i3==1) || (i==1 && i3==-1)) { + wx = wx + xstep + wy = wy + ystep + } + case 3: + if ((i==nexp && i3==1) || (i==nexp-1 && i3==-1)) { + wx = wx + xstep + wy = wy + ystep + } + } + } + + if (wx < SF_RADIUS(sf)-NBNDRYPIX || + wx > IM_LEN(im,1)-SF_RADIUS(sf)+NBNDRYPIX || + wy < SF_RADIUS(sf)-NBNDRYPIX || + wy > IM_LEN(im,2)-SF_RADIUS(sf)+NBNDRYPIX) + next + if (nexp == 1) + j = nimages + else + j = i + if (nsfd == 0) + call malloc (sfds, 10, TY_POINTER) + else if (mod (nsfd, 10) == 0) + call realloc (sfds, nsfd+10, TY_POINTER) + call malloc (sfd, SFD, TY_STRUCT) + call strcpy (Memc[image], SFD_IMAGE(sfd), SF_SZFNAME) + SFD_ID(sfd) = id + SFD_X(sfd) = wx + SFD_Y(sfd) = wy + if (Memc[fvals] == EOS) + f = INDEF + else if (Memc[fstep] != EOS) { + ip = 1 + if (ctor (Memc[fvals], ip, f) == 0) + f = imgetr (im, Memc[fvals]) + ip = 1 + if (ctor (Memc[fstep], ip, df) == 0) + df = imgetr (im, Memc[fstep]) + f = f + (i - 1) * df + } else if (rg != NULL) { + if (rng_index (rg, j, f) == EOF) + call error (1, "Focus list ended prematurely") + } else + f = imgetr (im, Memc[fvals]) + SFD_F(sfd) = f + SFD_STATUS(sfd) = 0 + SFD_SFS(sfd) = NULL + SFD_SFF(sfd) = NULL + SFD_SFI(sfd) = NULL + + iferr { + do l = 1, SF_NIT(sf) { + if (l == 1) + SFD_RADIUS(sfd) = max (3., SF_RADIUS(sf)) + else + SFD_RADIUS(sfd) = max (3., 3. * SFD_DFWHM(sfd)) + SFD_NPMAX(sfd) = stf_r2i (SFD_RADIUS(sfd)) + 1 + SFD_NP(sfd) = SFD_NPMAX(sfd) + call stf_find (sf, sfd, im) + call stf_bkgd (sf, sfd) + if (SFD_NSAT(sfd) > 0 && l == 1) { + if (ignore_sat) + call error (0, + "Saturated pixels found - ignoring object") + else + call eprintf ( + "WARNING: Saturated pixels found.\n") + } + call stf_profile (sf, sfd) + call stf_widths (sf, sfd) + call stf_fwhms (sf, sfd) + } + Memi[sfds+nsfd] = sfd + nsfd = nsfd + 1 + wx = SFD_X(sfd) + wy = SFD_Y(sfd) + } then { + call erract (EA_WARN) + call mfree (sfd, TY_STRUCT) + } + } + if (nsfd > k) { + nstars = nstars + 1 + if (key == 'g') { + if (nsfd - k > 0) { + call stf_organize (sf, sfds+k, nsfd-k) + call stf_graph (sf) + ngraph = ngraph + 1 + } + } + } + } + if (mw != NULL) + call mw_close (mw) + call imunmap (im) + } + + if (nsfd == 0) + call error (1, "No input data") + + # Organize the objects, graph the data, and log the results. + if (nstars > 1 || ngraph != nstars) { + call stf_organize (sf, sfds, nsfd) + call stf_graph (sf) + } + call stf_log (sf, STDOUT) + call clgstr ("logfile", Memc[image], SZ_FNAME) + ifnoerr (logfd = open (Memc[image], APPEND, TEXT_FILE)) { + call stf_log (sf, logfd) + call close (logfd) + } + + # Finish up + call rng_close (rg) + call imtclose (list) + call stf_free (sf) + do i = 1, SF_NSFD(sf) { + sfd = SF_SFD(sf,i) + call asifree (SFD_ASI1(sfd)) + call asifree (SFD_ASI2(sfd)) + call mfree (sfd, TY_STRUCT) + } + call mfree (SF_SFDS(sf), TY_POINTER) + call mfree (mark, TY_REAL) + call sfree (sp) +end + + +# STF_FREE -- Free the starfocus data structures. + +procedure stf_free (sf) + +pointer sf #I Starfocus structure +int i + +begin + do i = 1, SF_NSTARS(sf) + call mfree (SF_SFS(sf,i), TY_STRUCT) + do i = 1, SF_NFOCUS(sf) + call mfree (SF_SFF(sf,i), TY_STRUCT) + do i = 1, SF_NIMAGES(sf) + call mfree (SF_SFI(sf,i), TY_STRUCT) + call mfree (SF_STARS(sf), TY_POINTER) + call mfree (SF_FOCUS(sf), TY_POINTER) + call mfree (SF_IMAGES(sf), TY_POINTER) + SF_NSTARS(sf) = 0 + SF_NFOCUS(sf) = 0 + SF_NIMAGES(sf) = 0 +end + + +# STF_ORGANIZE -- Organize the individual object structures by star, focus, +# and image. Compute focus, radius, and magnitude by group and over all +# data. + +procedure stf_organize (sf, sfds, nsfd) + +pointer sf #I Starfocus structure +pointer sfds #I Pointer to array of object structures +int nsfd #I Number of object structures + +int i, j, k, nstars, nfocus, nimages, key +real f +pointer stars, focus, images, sfd, sfs, sff, sfi +pointer sp, image +bool streq() +errchk malloc + +int stf_focsort(), stf_magsort() +extern stf_focsort, stf_magsort + +begin + call smark (sp) + call salloc (image, SZ_FNAME, TY_CHAR) + + # Free previous structures. + call stf_free (sf) + + # Organize sfds by star. + nstars = 0 + for (i = 0; i < nsfd; i = i + 1) { + key = SFD_ID(Memi[sfds+i]) + for (j = 0; SFD_ID(Memi[sfds+j]) != key; j = j + 1) + ; + if (j == i) + nstars = nstars + 1 + } + call malloc (stars, nstars, TY_POINTER) + + nstars = 0 + for (i = 0; i < nsfd; i = i + 1) { + key = SFD_ID(Memi[sfds+i]) + for (j = 0; j < nstars; j = j + 1) + if (SFS_ID(Memi[stars+j]) == key) + break + if (j == nstars) { + k = 0 + for (j = i; j < nsfd; j = j + 1) + if (SFD_ID(Memi[sfds+j]) == key) + k = k + 1 + call malloc (sfs, SFS(k), TY_STRUCT) + SFS_ID(sfs) = key + SFS_NSFD(sfs) = k + k = 0 + for (j = i; j < nsfd; j = j + 1) { + sfd = Memi[sfds+j] + if (SFD_ID(sfd) == key) { + k = k + 1 + SFD_SFS(sfd) = sfs + SFS_SFD(sfs,k) = sfd + } + } + Memi[stars+nstars] = sfs + nstars = nstars + 1 + } + } + + # Organize sfds by focus values. Sort by magnitude. + nfocus = 0 + for (i = 0; i < nsfd; i = i + 1) { + f = SFD_F(Memi[sfds+i]) + for (j = 0; SFD_F(Memi[sfds+j]) != f; j = j + 1) + ; + if (j == i) + nfocus = nfocus + 1 + } + call malloc (focus, nfocus, TY_POINTER) + + nfocus = 0 + for (i = 0; i < nsfd; i = i + 1) { + f = SFD_F(Memi[sfds+i]) + for (j = 0; j < nfocus; j = j + 1) + if (SFF_F(Memi[focus+j]) == f) + break + if (j == nfocus) { + k = 0 + for (j = i; j < nsfd; j = j + 1) + if (SFD_F(Memi[sfds+j]) == f) + k = k + 1 + call malloc (sff, SFF(k), TY_STRUCT) + SFF_F(sff) = f + SFF_NSFD(sff) = k + k = 0 + for (j = i; j < nsfd; j = j + 1) { + sfd = Memi[sfds+j] + if (SFD_F(sfd) == f) { + k = k + 1 + SFD_SFF(sfd) = sff + SFF_SFD(sff,k) = sfd + } + } + Memi[focus+nfocus] = sff + nfocus = nfocus + 1 + } + } + + # Organize sfds by image. + nimages = 0 + for (i = 0; i < nsfd; i = i + 1) { + call strcpy (SFD_IMAGE(Memi[sfds+i]), Memc[image], SZ_FNAME) + for (j = 0; !streq (SFD_IMAGE(Memi[sfds+j]), Memc[image]); j = j+1) + ; + if (j == i) + nimages = nimages + 1 + } + call malloc (images, nimages, TY_POINTER) + + nimages = 0 + for (i = 0; i < nsfd; i = i + 1) { + call strcpy (SFD_IMAGE(Memi[sfds+i]), Memc[image], SZ_FNAME) + for (j = 0; j < nimages; j = j + 1) + if (streq (SFI_IMAGE(Memi[images+j]), Memc[image])) + break + if (j == nimages) { + k = 0 + for (j = i; j < nsfd; j = j + 1) + if (streq (SFD_IMAGE(Memi[sfds+j]), Memc[image])) + k = k + 1 + call malloc (sfi, SFI(k), TY_STRUCT) + call strcpy (Memc[image], SFI_IMAGE(sfi), SF_SZFNAME) + SFI_NSFD(sfi) = k + k = 0 + for (j = i; j < nsfd; j = j + 1) { + sfd = Memi[sfds+j] + if (streq (SFD_IMAGE(sfd), Memc[image])) { + k = k + 1 + SFD_SFI(sfd) = sfi + SFI_SFD(sfi,k) = sfd + } + } + Memi[images+nimages] = sfi + nimages = nimages + 1 + } + } + + SF_NSFD(sf) = nsfd + SF_SFDS(sf) = sfds + SF_NSTARS(sf) = nstars + SF_STARS(sf) = stars + SF_NFOCUS(sf) = nfocus + SF_FOCUS(sf) = focus + SF_NIMAGES(sf) = nimages + SF_IMAGES(sf) = images + + # Find the average and best focus values. Sort the focus groups + # by magnitude and the star groups by focus. + + call stf_fitfocus (sf) + do i = 1, SF_NFOCUS(sf) { + sff = SF_SFF(sf,i) + call qsort (SFF_SFD(sff,1), SFF_NSFD(sff), stf_magsort) + } + do i = 1, SF_NSTARS(sf) { + sfs = SF_SFS(sf,i) + call qsort (SFS_SFD(sfs,1), SFS_NSFD(sfs), stf_focsort) + } + + call sfree (sp) +end + + +# STF_LOG -- Print log of results + +procedure stf_log (sf, fd) + +pointer sf #I Main data structure +int fd #I File descriptor + +int i, j, n +pointer sp, str, sfd, sfs, sff, sfi + +begin + call smark (sp) + call salloc (str, SZ_LINE, TY_CHAR) + + # Print banner and overall result. + call sysid (Memc[str], SZ_LINE) + call fprintf (fd, "%s\n\n") + call pargstr (Memc[str]) + + # Print each individual object organized by image. + call fprintf (fd, "%15.15s %7s %7s %7s") + call pargstr ("Image") + call pargstr ("Column") + call pargstr ("Line") + call pargstr ("Mag") + if (IS_INDEF(SF_F(sf))) { + call fprintf (fd, " %7s") + call pargstr (SF_WTYPE(sf)) + } else { + call fprintf (fd, " %7s %7s") + call pargstr ("Focus") + call pargstr (SF_WTYPE(sf)) + } + if (SF_WCODE(sf) == 4) { + call fprintf (fd, " %4s") + call pargstr ("Beta") + } + call fprintf (fd, " %7s %7s %3s\n") + call pargstr ("Ellip") + call pargstr ("PA") + call pargstr ("SAT") + + do i = 1, SF_NIMAGES(sf) { + sfi = SF_SFI(sf,i) + n = 0 + do j = 1, SFI_NSFD(sfi) { + sfd = SFI_SFD(sfi,j) + if (SFD_STATUS(sfd) != 0) + next + if (n == 0) { + call fprintf (fd, "%15.15s") + call pargstr (SFD_IMAGE(sfd)) + } else + call fprintf (fd, "%15w") + call fprintf (fd, " %7.2f %7.2f %7.2f") + call pargr (SFD_X(sfd)) + call pargr (SFD_Y(sfd)) + call pargr (-2.5*log10 (SFD_M(sfd) / SF_M(sf))) + if (IS_INDEF(SFD_F(sfd))) { + call fprintf (fd, + " %7.3f") + call pargr (SFD_W(sfd)) + } else { + call fprintf (fd, " %7.6g %7.3f") + call pargr (SFD_F(sfd)) + call pargr (SFD_W(sfd)) + } + if (SF_WCODE(sf) == 4) { + call fprintf (fd, " %4.1f") + call pargr (SFD_BETA(sfd)) + } + call fprintf (fd, " %7.2f %7d") + call pargr (SFD_E(sfd)) + call pargr (SFD_PA(sfd)) + if (SFD_NSAT(sfd) == 0) + call fprintf (fd, "\n") + else + call fprintf (fd, " *\n") + n = n + 1 + } + } + if (n > 0) + call fprintf (fd, "\n") + + # Print best values by star. + if (SF_NS(sf) > 1) { + n = 0 + do i = 1, SF_NSTARS(sf) { + sfs = SF_SFS(sf,i) + if (SFS_NF(sfs) > 1 || SFS_N(sfs) > 1) { + call stf_title (sf, NULL, sfs, NULL, Memc[str], SZ_LINE) + call fprintf (fd, " %s\n") + call pargstr (Memc[str]) + n = n + 1 + } + } + if (n > 0) + call fprintf (fd, "\n") + } + + # Print averages at each focus. + if (SF_NF(sf) > 1) { + n = 0 + do i = 1, SF_NFOCUS(sf) { + sff = SF_SFF(sf,i) + if (SFF_N(sff) > 1) { + call stf_title (sf, NULL, NULL, sff, Memc[str], SZ_LINE) + call fprintf (fd, " %s\n") + call pargstr (Memc[str]) + n = n + 1 + } + } + if (n > 0) + call fprintf (fd, "\n") + } + + call stf_title (sf, NULL, NULL, NULL, Memc[str], SZ_LINE) + call fprintf (fd, "%s\n") + call pargstr (Memc[str]) +end + + +# STF_TITLE -- Return result title string. +# The title is dependent on whether an overall title, a title for a star +# group, for a focus group, or for an indivdual object is desired. +# The title also is adjusted for the select size type and the number +# of objects in a group. + +procedure stf_title (sf, sfd, sfs, sff, title, sz_title) + +pointer sf #I Starfocus pointer +pointer sfd #I Data pointer +pointer sfs #I Star pointer +pointer sff #I Focus pointer +char title[sz_title] #O Title string +int sz_title #I Size of title string + +pointer ptr +int i, fd, stropen() +errchk stropen + +begin + fd = stropen (title, sz_title, WRITE_ONLY) + + if (sfd != NULL) { + call fprintf (fd, "%s @ (%.2f, %.2f):") + call pargstr (SFD_IMAGE(sfd)) + call pargr (SFD_X(sfd)) + call pargr (SFD_Y(sfd)) + switch (SF_WCODE(sf)) { + case 4: + call fprintf (fd, " %s=%.2f (%3.1f), e=%.2f, pa=%d") + call pargstr (SF_WTYPE(sf)) + call pargr (SFD_W(sfd)) + call pargr (SFD_BETA(sfd)) + call pargr (SFD_E(sfd)) + call pargr (SFD_PA(sfd)) + default: + call fprintf (fd, " %s=%.2f, e=%.2f, pa=%d") + call pargstr (SF_WTYPE(sf)) + call pargr (SFD_W(sfd)) + call pargr (SFD_E(sfd)) + call pargr (SFD_PA(sfd)) + } + if (SFD_SFS(sfd) != NULL) { + if (SFS_M(SFD_SFS(sfd)) != SF_M(sf)) { + call fprintf (fd, " , m=%.2f") + call pargr (-2.5*log10 (SFS_M(SFD_SFS(sfd)) / SF_M(sf))) + } + } + if (!IS_INDEF(SFD_F(sfd))) { + call fprintf (fd, ", f=%.4g") + call pargr (SFD_F(sfd)) + } + } else if (sfs != NULL) { + ptr = SFS_SFD(sfs,1) + call fprintf (fd, "%s") + if (SFS_NF(sfs) > 1) + call pargstr ("Best focus estimate") + else if (SFS_N(sfs) > 1) + call pargstr ("Average star") + else { + for (i=1; SFD_STATUS(SFS_SFD(sfs,i))!=0; i=i+1) + ; + call pargstr (SFD_IMAGE(SFS_SFD(sfs,i))) + } + call fprintf (fd, " @ (%.2f, %.2f): %s=%.2f") + call pargr (SFD_X(ptr)) + call pargr (SFD_Y(ptr)) + call pargstr (SF_WTYPE(sf)) + call pargr (SFS_W(sfs)) + #if (SFS_M(sfs) != SF_M(sf)) { + call fprintf (fd, ", m=%.2f") + call pargr (-2.5 * log10 (SFS_M(sfs) / SF_M(sf))) + #} + if (!IS_INDEF(SFS_F(sfs))) { + call fprintf (fd, ", f=%.4g") + call pargr (SFS_F(sfs)) + } + } else if (sff != NULL) { + if (SFF_NI(sff) == 1) { + for (i=1; SFD_STATUS(SFF_SFD(sff,i))!=0; i=i+1) + ; + call fprintf (fd, "%s") + call pargstr (SFD_IMAGE(SFF_SFD(sff,i))) + if (!IS_INDEF(SFF_F(sff))) { + call fprintf (fd, " at focus %.4g") + call pargr (SFF_F(sff)) + } + call fprintf (fd, " with average") + } else { + if (IS_INDEF(SFF_F(sff))) + call fprintf (fd, "Average") + else { + call fprintf (fd, "Focus %.4g with average") + call pargr (SFF_F(sff)) + } + } + call fprintf (fd, " %s of %.2f") + call pargstr (SF_WTYPE(sf)) + call pargr (SFF_W(sff)) + } else { + if (IS_INDEF(SF_F(sf))) { + if (SF_WCODE(sf) == 1) { + call fprintf (fd, " %s%d%% enclosed flux radius of ") + if (SF_N(sf) > 1) + call pargstr ("Average ") + else + call pargstr ("") + call pargr (100 * SF_LEVEL(sf)) + } else { + if (SF_N(sf) > 1) + call fprintf (fd, + " Average full width at half maximum (%s) of ") + else + call fprintf (fd, + " Full width at half maximum (%s) of ") + call pargstr (SF_WTYPE(sf)) + } + call fprintf (fd, "%.4f") + call pargr (SF_W(sf)) + } else { + call fprintf (fd, " %s of %.6g with ") + if (SF_NS(sf) > 1) { + if (SF_NF(sf) > 1) + call pargstr ("Average best focus") + else + call pargstr ("Average focus") + } else { + if (SF_NF(sf) > 1) + call pargstr ("Best focus") + else + call pargstr ("Focus") + } + call pargr (SF_F(sf)) + if (SF_WCODE(sf) == 1) { + call fprintf (fd, "%d%% enclosed flux radius of ") + call pargr (100 * SF_LEVEL(sf)) + } else { + call fprintf (fd, "%s of ") + call pargstr (SF_WTYPE(sf)) + } + call fprintf (fd, "%.2f") + call pargr (SF_W(sf)) + } + } + + call strclose (fd) +end + + +# STF_FITFOCUS -- Find the best focus. + +procedure stf_fitfocus (sf) + +pointer sf #I Starfocus pointer + +int i, j, k, n, jmin +pointer x, y, sfd, sfs, sff, sfi +real f, r, m, wr, wf +bool fp_equalr() + +begin + # Set number of valid points, stars, focuses, images. + SF_N(sf) = 0 + SF_YP1(sf) = 0 + SF_YP2(sf) = 0 + do i = 1, SF_NSFD(sf) { + sfd = SF_SFD(sf,i) + if (SFD_STATUS(sfd) == 0) { + SF_N(sf) = SF_N(sf) + 1 + SF_YP1(sf) = min (SF_YP1(sf), SFD_YP1(sfd)) + SF_YP2(sf) = max (SF_YP2(sf), SFD_YP2(sfd)) + } + } + SF_NS(sf) = 0 + do i = 1, SF_NSTARS(sf) { + sfs = SF_SFS(sf,i) + SFS_N(sfs) = 0 + SFS_M(sfs) = 0. + SFS_NF(sfs) = 0 + do j = 1, SFS_NSFD(sfs) { + sfd = SFS_SFD(sfs,j) + if (SFD_STATUS(SFS_SFD(sfs,j)) != 0) + next + SFS_N(sfs) = SFS_N(sfs) + 1 + SFS_M(sfs) = SFS_M(sfs) + SFD_M(sfd) + sff = SFD_SFF(sfd) + for (k = 1; SFD_SFF(SFS_SFD(sfs,k)) != sff; k = k + 1) + ; + if (k == j) + SFS_NF(sfs) = SFS_NF(sfs) + 1 + } + if (SFS_N(sfs) > 0) { + SFS_M(sfs) = SFS_M(sfs) / SFS_N(sfs) + SF_NS(sf) = SF_NS(sf) + 1 + } + } + SF_NF(sf) = 0 + do i = 1, SF_NFOCUS(sf) { + sff = SF_SFF(sf,i) + SFF_W(sff) = 0. + SFF_N(sff) = 0 + SFF_NI(sff) = 0 + wr = 0 + do j = 1, SFF_NSFD(sff) { + sfd = SFF_SFD(sff,j) + if (SFD_STATUS(sfd) != 0) + next + m = SFS_M(SFD_SFS(sfd)) + wr = wr + m + SFF_W(sff) = SFF_W(sff) + m * SFD_W(sfd) + SFF_N(sff) = SFF_N(sff) + 1 + sfi = SFD_SFI(sfd) + for (k = 1; SFD_SFI(SFF_SFD(sff,k)) != sfi; k = k + 1) + ; + if (k == j) + SFF_NI(sff) = SFF_NI(sff) + 1 + } + if (SFF_N(sff) > 0) { + SFF_W(sff) = SFF_W(sff) / wr + SF_NF(sf) = SF_NF(sf) + 1 + } + } + SF_NI(sf) = 0 + do i = 1, SF_NIMAGES(sf) { + sfi = SF_SFI(sf,i) + SFI_N(sfi) = 0 + do j = 1, SFI_NSFD(sfi) + if (SFD_STATUS(SFI_SFD(sfi,j)) == 0) + SFI_N(sfi) = SFI_N(sfi) + 1 + if (SFI_N(sfi) > 0) + SF_NI(sf) = SF_NI(sf) + 1 + } + + # Find the average magnitude, best focus, and radius for each star. + # Find the brightest magnitude and average best focus and radius + # over all stars. + + SF_BEST(sf) = SF_SFD(sf,1) + SF_F(sf) = 0. + SF_W(sf) = 0. + SF_M(sf) = 0. + SF_NS(sf) = 0 + wr = 0. + wf = 0. + do i = 1, SF_NSTARS(sf) { + sfs = SF_SFS(sf,i) + call malloc (x, SFS_NSFD(sfs), TY_REAL) + call malloc (y, SFS_NSFD(sfs), TY_REAL) + k = 0 + n = 0 + do j = 1, SFS_NSFD(sfs) { + sfd = SFS_SFD(sfs,j) + if (SFD_STATUS(sfd) != 0) + next + r = SFD_W(sfd) + f = SFD_F(sfd) + if (!IS_INDEF(f)) + k = k + 1 + Memr[x+n] = f + Memr[y+n] = r + n = n + 1 + if (r < SFD_W(SF_BEST(sf))) + SF_BEST(sf) = sfd + } + + # Find the best focus and radius. + if (n == 0) { + SFS_F(sfs) = INDEF + SFS_W(sfs) = INDEF + SFS_M(sfs) = INDEF + SFS_N(sfs) = 0 + } else if (k == 0) { + call alimr (Memr[y], n, f, r) + f = INDEF + m = SFS_M(sfs) + wr = wr + m + SFS_F(sfs) = f + SFS_W(sfs) = r + SFS_M(sfs) = m + SFS_N(sfs) = n + SF_W(sf) = SF_W(sf) + m * r + SF_M(sf) = max (SF_M(sf), m) + SF_NS(sf) = SF_NS(sf) + 1 + } else { + SFS_N(sfs) = n + if (k < n) { + k = 0 + do j = 0, n-1 { + if (!IS_INDEF(Memr[x+j])) { + Memr[x+k] = Memr[x+j] + Memr[y+k] = Memr[y+j] + k = k + 1 + } + } + } + call xt_sort2 (Memr[x], Memr[y], k) + n = 0 + do j = 1, k-1 { + if (fp_equalr (Memr[x+j], Memr[x+n])) { + if (Memr[y+j] < Memr[y+n]) + Memr[y+n] = Memr[y+j] + } else { + n = n + 1 + Memr[x+n] = Memr[x+j] + Memr[y+n] = Memr[y+j] + } + } + n = n + 1 + + # Find the minimum radius + jmin = 0 + do j = 0, n-1 + if (Memr[y+j] < Memr[y+jmin]) + jmin = j + + # Use parabolic interpolation to find the best focus + if (jmin == 0 || jmin == n-1) { + f = Memr[x+jmin] + r = Memr[y+jmin] + } else + call stf_parab (Memr[x+jmin-1], Memr[y+jmin-1], f, r) + + m = SFS_M(sfs) + wr = wr + m + wf = wf + m + SFS_F(sfs) = f + SFS_W(sfs) = r + SFS_M(sfs) = m + SF_F(sf) = SF_F(sf) + m * f + SF_W(sf) = SF_W(sf) + m * r + SF_M(sf) = max (SF_M(sf), m) + SF_NS(sf) = SF_NS(sf) + 1 + } + call mfree (x, TY_REAL) + call mfree (y, TY_REAL) + } + + if (wr > 0.) + SF_W(sf) = SF_W(sf) / wr + else { + SF_W(sf) = INDEF + SF_M(sf) = INDEF + } + if (wf > 0.) + SF_F(sf) = SF_F(sf) / wf + else + SF_F(sf) = INDEF +end + + +# STF_PARAB -- Find the minimum of a parabolic fit to three points. + +procedure stf_parab (x, y, xmin, ymin) + +real x[3] +real y[3] +real xmin +real ymin + +double x12, x13, x23, x213, x223, y13, y23, a, b, c + +begin + x12 = x[1] - x[2] + x13 = x[1] - x[3] + x23 = x[2] - x[3] + x213 = x13 * x13 + x223 = x23 * x23 + y13 = y[1] - y[3] + y23 = y[2] - y[3] + c = (y13 - y23 * x13 / x23) / (x213 - x223 * x13 / x23) + b = (y23 - c * x223) / x23 + a = y[3] + xmin = -b / (2 * c) + ymin = a + b * xmin + c * xmin * xmin + xmin = xmin + x[3] +end + + +# STF_MAGSORT -- Compare two star structures by average magnitude. + +int procedure stf_magsort (sfd1, sfd2) + +pointer sfd1, sfd2 # Structures to compare +pointer sfs1, sfs2 # Star structures for magnitudes + +begin + sfs1 = SFD_SFS(sfd1) + sfs2 = SFD_SFS(sfd2) + if (SFS_M(sfs1) > SFS_M(sfs2)) + return (-1) + else if (SFS_M(sfs1) < SFS_M(sfs2)) + return (1) + else + return (0) +end + + +# STF_FOCSORT -- Compare two star structures by focus. + +int procedure stf_focsort (sfd1, sfd2) + +pointer sfd1, sfd2 # Structures to compare + +begin + if (SFD_F(sfd1) < SFD_F(sfd2)) + return (-1) + else if (SFD_F(sfd1) > SFD_F(sfd2)) + return (1) + else + return (0) +end + + +# STF_DISPLAY -- Display image if necessary. +# The user is required to display the first image separately. + +procedure stf_display (image, frame) + +char image[ARB] #I Image to display +int frame #I Display frame to use + +int i, status +pointer sp, dname, ds, iw, imd_mapframe(), iw_open() +bool xt_imnameeq() +errchk clcmdw + +begin + call smark (sp) + call salloc (dname, SZ_LINE, TY_CHAR) + + ds = imd_mapframe (1, READ_WRITE, NO) + do i = 1, MAX_FRAMES { + iferr (iw = iw_open (ds, i, Memc[dname], SZ_LINE, status)) + next + call iw_close (iw) + if (xt_imnameeq (image, Memc[dname])) + break + } + call imunmap (ds) + + if (!xt_imnameeq (image, Memc[dname])) { + call sprintf (Memc[dname], SZ_LINE, "display %s frame=%d fill=yes") + call pargstr (image) + call pargi (frame) + call clcmdw (Memc[dname]) + } + + call sfree (sp) +end + + +# STFCUR -- Debugging routine. +# Replace calls to clgcur with stfcur so that an text file containing the +# cursor coordinates may be specified when running standalone (such as +# under a debugger). + +int procedure stfcur (cur, wx, wy, wcs, key, cmd, sz_cmd) + +char cur[ARB] # Cursor name +real wx, wy # Cursor coordinate +int wcs # WCS +int key # Key +char cmd[sz_cmd] # Command +int sz_cmd # Size of command + +int fd, stat, open(), fscan() +pointer fname +errchk open + +begin + if (fd == NULL) { + call malloc (fname, SZ_FNAME, TY_CHAR) + call clgstr (cur, Memc[fname], SZ_FNAME) + fd = open (Memc[fname], READ_ONLY, TEXT_FILE) + call mfree (fname, TY_CHAR) + } + + stat = fscan (fd) + if (stat == EOF) { + call close (fd) + return (stat) + } + + call gargr (wx) + call gargr (wy) + call gargi (wcs) + call gargi (key) + + return (stat) +end diff --git a/noao/obsutil/src/starfocus/x_starfocus.x b/noao/obsutil/src/starfocus/x_starfocus.x new file mode 100644 index 00000000..a3642bae --- /dev/null +++ b/noao/obsutil/src/starfocus/x_starfocus.x @@ -0,0 +1,2 @@ +task psfmeasure = t_psfmeasure, + starfocus = t_starfocus diff --git a/noao/obsutil/src/t_bitcount.x b/noao/obsutil/src/t_bitcount.x new file mode 100644 index 00000000..30fa21a8 --- /dev/null +++ b/noao/obsutil/src/t_bitcount.x @@ -0,0 +1,202 @@ +include +include +include + +# T_BITCOUNT -- The pixel bits for each image are counted and reported. + +procedure t_bitcount () + +pointer imname, imlist, im, typename, sp +bool grand, leftzeroes, verbose, clear_counters, first_time, pixtype_err +int zeroes[NBITS_INT], ones[NBITS_INT], zeroes_tot, ones_tot, ntotal +int nimages, npixels, maxbit, bit, nim, pixtype + +pointer imtopenp(), immap() +int imtgetim(), imtlen(), bitcount() +bool clgetb() + +errchk immap + +begin + call smark (sp) + call salloc (imname, SZ_FNAME, TY_CHAR) + call salloc (typename, SZ_FNAME, TY_CHAR) + + imlist = imtopenp ("images") + nimages = imtlen (imlist) + if (nimages <= 0) { + call sfree (sp) + call error (0, "no images in list") + } + + grand = clgetb ("grandtotal") + leftzeroes = clgetb ("leftzeroes") + verbose = clgetb ("verbose") + + if (grand && verbose) + call printf ("\nGrand totals for:\n\n") + + clear_counters = true + pixtype_err = false + first_time = true + + for (nim=1; imtgetim (imlist, Memc[imname], SZ_FNAME) != EOF; nim=nim+1) + iferr (im = immap (Memc[imname], READ_ONLY, 0)) { + call erract (EA_WARN) + } else { + if (first_time) { + pixtype = IM_PIXTYPE(im) + first_time = false + } else if (IM_PIXTYPE(im) != pixtype) { + pixtype_err = true + } + + if (clear_counters) { + call aclri (zeroes, NBITS_INT) + call aclri (ones, NBITS_INT) + zeroes_tot = 0 + ones_tot = 0 + ntotal = 0 + clear_counters = ! grand + } + + npixels = bitcount (im, leftzeroes, zeroes, ones, maxbit) + + ntotal = ntotal + npixels + + if (verbose) { + call dtstring (IM_PIXTYPE(im), Memc[typename], SZ_FNAME) + + call printf ("%s[%d,%d][%s], npix=%d:\n") + call pargstr (Memc[imname]) + call pargi (IM_LEN(im,1)) + call pargi (IM_LEN(im,2)) + call pargstr (Memc[typename]) + call pargi (npixels) + } + + if (grand && nim != nimages) + next + + if (verbose) + call printf ("\n") + + if (grand && pixtype_err) { + call eprintf ("Warning: image data types vary!\n\n") + call flush (STDOUT) + call flush (STDERR) + } + + if (verbose) { + do bit = 1, maxbit { + zeroes_tot = zeroes_tot + zeroes[bit] + ones_tot = ones_tot + ones[bit] + } + + call printf (" bit 0's 1's %%0's %%1's\n") + call printf (" --- --- --- ---- ----\n") + + do bit = 1, maxbit { + call printf (" %2d %8d %8d %5.1f %5.1f") + call pargi (bit-1) + call pargi (zeroes[bit]) + call pargi (ones[bit]) + call pargr (100.*zeroes[bit]/ntotal) + call pargr (100.*ones[bit]/ntotal) + + if (bit==maxbit && IM_PIXTYPE(im)!=TY_USHORT) + call printf (" (sign bit)\n") + else + call printf ("\n") + } + + call printf (" ------- ------- ---- ----\n") + call printf (" %10d%10d %5.1f %5.1f\n\n\n") + call pargi (zeroes_tot) + call pargi (ones_tot) + call pargr (100.*zeroes_tot/(ntotal*maxbit)) + call pargr (100.*ones_tot/(ntotal*maxbit)) + + } else + do bit = 1, maxbit { + call printf ("%d\t%d\n") + call pargi (zeroes[bit]) + call pargi (ones[bit]) + } + + call imunmap (im) + call flush (STDOUT) + } + + call imtclose (imlist) + call sfree (sp) +end + + +# BITCOUNT -- Accumulate the bit statistics for an image and return +# the number of pixels. The calling routine is responsible for +# zeroing the arrays. + +int procedure bitcount (im, leftzeroes, zeroes, ones, maxbit) + +pointer im #I image descriptor +bool leftzeroes #I are leftmost zeroes significant? +int zeroes[ARB] #O array to count zeroes / bit +int ones[ARB] #O array to count ones / bit +int maxbit #O number of bits/pixel + +int bit, npixels, nrows, ncols, ival, i +long v[IM_MAXDIM] +pointer buf + +int imgnli() + +errchk imgnli + +begin + ncols = IM_LEN(im,1) + nrows = IM_LEN(im,2) + npixels = nrows * ncols + + # this will break on machines with 64 bit integers + switch (IM_PIXTYPE(im)) { + case TY_SHORT, TY_USHORT: + maxbit = NBITS_SHORT + case TY_INT, TY_LONG: + maxbit = NBITS_INT + default: + call error (0, "image pixels aren't integers") + } + + call amovkl (long(1), v, IM_MAXDIM) + + while (imgnli (im, buf, v) != EOF) + do i = 1, ncols { + ival = Memi[buf+i-1] + + # special handling for the high order bit + if (ival < 0) { + # convert to 2's complement and tally the sign bit + ival = 2**maxbit - abs(ival) + ones[maxbit] = ones[maxbit] + 1 + } else if ((IM_PIXTYPE(im) == TY_USHORT) && (ival > 32767)) + ones[maxbit] = ones[maxbit] + 1 + else if (leftzeroes) + zeroes[maxbit] = zeroes[maxbit] + 1 + + for (bit=1; bit