diff options
| author | Joseph Hunkeler <jhunkeler@gmail.com> | 2015-07-08 20:46:52 -0400 |
|---|---|---|
| committer | Joseph Hunkeler <jhunkeler@gmail.com> | 2015-07-08 20:46:52 -0400 |
| commit | fa080de7afc95aa1c19a6e6fc0e0708ced2eadc4 (patch) | |
| tree | bdda434976bc09c864f2e4fa6f16ba1952b1e555 /noao/astutil | |
| download | iraf-linux-fa080de7afc95aa1c19a6e6fc0e0708ced2eadc4.tar.gz | |
Initial commit
Diffstat (limited to 'noao/astutil')
103 files changed, 12696 insertions, 0 deletions
diff --git a/noao/astutil/README b/noao/astutil/README new file mode 100644 index 00000000..b44deb98 --- /dev/null +++ b/noao/astutil/README @@ -0,0 +1,3 @@ +The ASTUTIL package is for general astronomical utility tasks. See also the +system UTILITIES package for general utilities which are not astronomically +oriented. diff --git a/noao/astutil/Revisions b/noao/astutil/Revisions new file mode 100644 index 00000000..82c1c9b3 --- /dev/null +++ b/noao/astutil/Revisions @@ -0,0 +1,631 @@ +.help revisions Jun88 noao.astutil +.nf + +t_astcalc.x +doc/astcalc.hlp + The $D variable was changed from the old MM/DD/YY format to the post-Y2K + YYYY-MM-DD format. (4/6/10, MJF) + +asttools/refrac.x + A development routine for refraction correction from apparent to + observed place. As noted in the comments, this seems to be correct + to first order but I don't have complete confidence that I've done + this correctly. It would be useful to have an independent test. + (7/2/08, Valdes) + +t_rvcorrect.x + If a UT time is part of the date keyword it is used in preference to + the UT keyword. This makes use of UTMIDDLE, with the previous change, + consistent. (12/10/07, Valdes) + +t_setairmass.x + The UTMIDDLE keyword will now always be in date format. This fixes + a problem with changes of the date and insures other tasks which + use UTMIDDLE in place of DATE-OBS will used the correct time. + (12/10/07, Valdes) + +===== +V2.14 +===== + +======= +V2.12.2 +======= + +astutil.cl +t_ccdtime.x - +ccdb.x - +ccdtime.par - +mkpkg + CCDTIME was moved to the OBSUTIL package in V2.12. But the version in + ASTUTIL was retained. The change here was to have the ASTUTIL version + point to the OBSUTIL version so that there is only one source, + parameter file, and executable. (4/28/03, Valdes) + +===== +V2.12 +===== + +t_rvcorrect.x + If imupdate=no then the image is now opened READ_ONLY. Previously + the image was always opened READ_WRITE requiring the user to have + write permission on the image. (12/14/01, Valdes) + +t_setairmass.x + Previously if DATE-OBS included the UT then that time was used and + it was not possible to specify an alternate UT. Now the UT keyword + has precedence over DATE-OBS. To allow the keyword for UT to point + to DATE-OBS for the time the UT keyword may be specified in either + data/time format or as hours. + + The UTMIDDLE output option will now be written in the same format as + the keyword used for the input UT. + (9/20/01, Valdes) + +t_rvcorrect.x + Previously if DATE-OBS included the UT then that time was used and + it was not possible to specify an alternate UT. Now the UT keyword + has precedence over DATE-OBS. To allow the keyword for UT to point + to DATE-OBS for the time the UT keyword may be specified in either + data/time format or as hours. + (9/20/01, Valdes) + +pdm/pdmtheta.x + The procedure that bins the data would compute negative bins leading + to memory corruption when the input x values are not sorted. I made + a fix to this which solves the immediate problem. I didn't figure + out the code enough to know if there is any other assumption about the + input data being sorted. (2/22/01, Valdes) + +t_rvcorrect.x + Task now checks if a file specified in the "files" parameter is actually + and image and prints a warning. See buglog 477. (1/31/01, Valdes) + +pdm/TODO + + Added a TODO file for suggestions for further work. + (12/11/00, Valdes) + +setairmass.par +setairmass.hlp +t_setairmass.x +airmass.x +mkpkg + The image header keyword parameters ra, dec, equinox, st, ut, + and the scale height parameter were added to the setairmass task. In + the previous version of the task ra, dec, equinox, st and ut were + hardwired to "RA", "DEC", "EPOCH", "ST", and "UT", and the scale + parameter was hardwired to 750.0. (10/31/00, Davis) + +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) + +astfunc.x + There was a typo in the opcode for CLPUT. It was 10 instead of 20. + This resulted in not branching to the I/O function evaluator and + giving a "requires 1 argument" error. + (6/29/00, Valdes) + +doc/setairmass.hlp + Made it clear that DATE-OBS means UT date. (6/21/00, Valdes) + +======== +V2.11.3p1 +======== + +t_setairmass.x + Moved erract call before imunmap to avoid an incorrect error string + (about isodate) being printed. (10/21/99, Valdes) + +astfunc.x +t_rvcorrect.x + Added missing time.h dependencies. (10/11/99, Valdes) + +asttools/mkpkg + Added missing dependency for astgalactic.x. (10/11/99, Valdes) + +t_astcalc.x + There was an extra READ_ONLY immap when processing a list of images. + Therefore when using a long list of STF format images where a file + descriptor is opened and not closed until imunmap it was possible to + run out of file descriptors. This was not a problem with imh + or fits formats. (8/31/99, Valdes) + +t_rvcorrect.x +astfunc.x + The dates in old FITS format incorrectly are adding 1900 to the year + where the 1900 is already added by the parsing routine. + (8/30/99, Valdes) + +======= +V2.11.2 +======= + +t_asthedit.x +t_astcalc.x +astfunc.x +doc/asthedit.hlp +doc/astcalc.hlp + The epoch, julday, and mst functions now take either the old or new + FITS style date strings. The time argument is optional and if it is + not specified the time from the date string is used and if neither time + is present a value of 0h is used. New internal variables $GMD, $GMT, + and $GMDT for the current time Greenwich time are defined. + (5/19/99, Valdes) + +t_rvcorrect.x +t_setairmss.x +t_setjd.x +doc/rvcorrect.hlp +doc/setairmass.hlp +doc/setjd.hlp +doc/keywpars.hlp + Converted to use dtm_decode. Documentation updated. + (5/19/99, Valdes) + +astcalc.par +asthedit.par +asttimes.par +doc/asttimes.hlp +galactic.par +galactic.x +keywpars.par +precess.par +precess.x +rvcorrect.par +setairmass.par +setjd.par + These files were checked for Y2K correctness. No changes were required. + (5/19/99, Valdes) + +asttools/* + All routines checked for Y2K correctness. No changes were required. + The README file had the following statement added: + + Y2K: + Most routines work in Julian days or epochs. If they have an input + year it is converted to one of these forms by calling + ast_date_to_julday. This is the only routine that has a Y2K + connection. It assumes two digit years are 20th century. These + routines are Y2K correct. + + (5/19/99, Valdes) + +doc/pdm.hlp + Added a journal reference to the algorithm. (4/26/99, Valdes) + +astfunc.x + The imdel function name was incorrectly set as imde. (4/22/99, Valdes) + +doc/galactic.hlp +doc/asthedit.hlp + Fixed minor formating problem. (4/22/99, Valdes) + +doc/ccdtime.hlp + In the formula for r(sky) was pixel area term was in the wrong place. + (3/9/99, Valdes) + +t_rvcorrect.x + Improved error catching. (3/5/99, Valdes) + +t_rvcorrect.x + Added code the catch a bad DATE-OBS keyword and print an informative + error (2/21/99 MJF) + +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) + +rvcorrect.par + Removed the KEYPARS pset from the parameter file. The pset is + still available to the task, but it's presence interferes with + the task when used in CL mode since the 'ut' parameter is no + longer queried and the pset value is used, resulting in an + illegal number error when getting the value (4/22/98 MJF) + +t_setjd.x + The ctod function was incorrectly declared double. (3/10/98, Valdes) + +======= +V2.11.1 +======= + +pdm/pdmdelete.x + The statement "r2min = MAX_DOUBLE" was changed to "r2min=MAX_REAL" + since r2min is declared and used as real. (10/6/97, Valdes) + +===== +V2.11 +===== + +pdm/pdmtheta.x +pdm/pdmthetaran.x +pdm/t_pdm.x +doc/pdm.hlp +pdm.par + 1. The theta calculation was incorrect when there is less than 100 input + data points. In that case overlapping bins are used and the + calculation failed to account for this. + 2. Removed the debug option. + 3. Updated help including documentation of the "pluspoint" parameter. + (10/1/96, Valdes) + +t_setjd.x +setjd.hlp + Improved error checking and interpretation of the epoch keyword. + If an epoch keyword is specified and the keyword is not found + or can't be interpreted it is an error. If the epoch is an unlikely + value a warning is printed. If the epoch begins with B or J (case + insensitive) that is ok. (8/30/96, Valdes) + +rvcorrect.par +doc/rvcorrect.par + Forgot to add the keywpars pset declaration. (8/26/96 MJF) + +astfunc.x + Added btoi function "iresult = btoi (O_VALC(args[1])=='y'..." + (6/3/96, Tody) + +astradius.cl + +astradius.dat + +doc/astradius.hlp + +astutil.cl +astutil.men +astutil.hd + A new script task, ASTRADIUS, was written that is based on ASTCALC. + It finds and prints all images from an image list that have coordinates + within a specified radius of a specified coordinate. (1/24/96, Valdes) + +t_astcalc.x + +astcalc.par + +x_astutil.x +astutil.cl +astutil.men +astutil.hd +mkpkg +doc/astcalc.hlp + + A new task, ASTCALC, was written that uses a greatly enhanced syntax + from that of the original t_asthedit. It includes assignment statements, + simple conditional statements, and expressions without assignment. + Variables are implemented with a symbol table. Image, text file, + and CL parameter I/O is done with function calls in the + expression evaluator. + (1/24/96, Valdes) + +t_asthedit.x +asthedit.par +mkpkg +doc/asthedit.hlp + The task ASTHEDIT was revised to use a greatly enhanced syntax. + Internally it is significantly different but functionally it + is similar. A new parameter, update, was added to allow images + to be used which are read-only or not to be modified. The + task allows a null image list so that it can be used as a calculator. + (1/24/96, Valdes) + +astfunc.x + +astfunc.h + + The function evaluator from t_asthedit.x was extracted to a separate + file. The set of functions was increased, primarily with the + addition of I/O functions for printing, imio, fio, clio, fmtio, + and errors. These functions are organized in a subfunction + procedure. (1/24/96, Valdes) + +airmass.x +t_setairmass.x + Moved the airmass procedure from t_setairmass.x to airmass.x. + (1/23/96, Valdes) + +astutil$t_obs.x +astutil$t_asttimes.x +astutil$observatory.par + Modified to allow non-integer timezones. (12/29/94, Valdes) + +astutil$t_setjd.x + Added an extra digit to the printed output to give times to a second. + (6/4/94, Valdes) + +astutil$t_asthedit.x + Modified this to use the evvexpr package rather than the evexpr package + since the former includes double precision datatypes necessary to + maintain precision on some astronomical quantities. (4/22/94, Valdes) + +astutil$ccddb.x +astutil$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) + +astutil$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) + +astutil$mkpkg +astutil$asttools/mkpkg + The ASTTOOLS routines are now an NOAO package library which can be + referenced as -lasttools. (8/19/93, Valdes) + +astutil$t_ccdtime.x + +astutil$ccddb.x + +astutil$ccdtime.x - +astutil$ccdtime.par +astutil$doc/ccdtime.hlp +astutil$astutil.men +astutil$mkpkg + Revised CCDTIME to use a telescope/filter/detector database and to + compute and print additional information. (8/16/93, Valdes) + +astutil$t_asttimes.x + 1. The times are now always printed in the proper 24 hour interval. + 2. Also the fix to asttimes.x fixes incorrect values produced around + the new year. + 3. The header parameter also suppress printing the observatory info. + (5/27/93, Valdes) + +astutil$asttools/asttimes.x + The epoch was changed from day of the year divided by 365.25 to the + precise J2000 Julian epoch definition. This also has the effect + of fixing incorrect values of JD and LMST around the new year. + (5/27/93, Valdes) + +astutil$t_rvcorrect.x +astutil$keywpars.par + +astutil$doc/keywpars.hlp + + Added a pset KEYWPARS which is a duplicate of the RV package version, + updated the RVCORRECT task to make use of this instead of using hard- + wired image header keywords. Previously it was possible that the astutil + version of RVCORRECT would compute a heliocentric correction different + from what was found by the RV package when working from image headers. + Eventually other tasks should be modified to make use of this pset. + (5/12/93, MJF) + +astutil$t_asthedit.x +astutil$asthedit.par +astutil$doc/asthedit.hlp +astutil$x_astutil.x +astutil$astutil.cl +astutil$astutil.men +astutil$astutil.hd + ASTHEDIT is a new task which edits image headers of astronomical images. + In includes functions for airmass, astronomical times, precession, etc. + (3/30/93, Valdes) + +astutil$t_rvcorrect.x + A typo in the clgstr call in the rvc_images procedure resulted in the + input observatory name being truncated at 2 characters. Instead + of TY_CHAR for the lenght of the string it needs to be SZ_FNAME. + (2/1/93, Valdes) + +======= +V2.10.2 +======= + +astutil$astutil.par +astutil$asttimes.par +astutil$rvcorrect.par +astutil$setairmass.par +astutil$setjd.par +astutil$doc/asttimes.hlp +astutil$doc/rvcorrect.hlp +astutil$doc/setairmass.hlp +astutil$doc/setjd.hlp + Observatory parameter redirected to package parameter. + (2/6/92, Valdes) + +astutil$t_rvcorrect.x +astutil$t_setairmass.x +astutil$t_setjd.x + Modified to use obsimopen. (2/4/92, Valdes) + +astutil$t_obs.x +astutil$observatory.par +astutil$doc/obs.hlp + New version of this task. (2/4/92, Valdes) + +astutil$t_setjd.x + +astutil$setjd.par + +astutil$doc/setjd.hlp + +astutil$mkpkg +astutil$astutil.cl +astutil$astutil.men +astutil$astutil.hd + Added task to set Julian dates in image headers. + (1/29/92, Valdes) + +asttools$asttimes.x +asttools$asthjd.x + 1. Added additional conversions from date to JD and back from + Numerical Receipes without having to go through the epoch. + 2. Added HJD from JD without needing to go through the epoch. + (1/29/92, Valdes) + +astutil$t_setairmass.x +astutil$setairmass.par +astutil$doc/setairmass.hlp + 1. Changed the default action to update the image headers. + 2. Added an update field to the show listing. + 3. A warning is printed if show=no and update=no since this is a noop. + (11/5/91, Valdes) + +astutil$t_setairmass.x + The hour angle was slightly incorrect because universal time, from + the exposure time, was used instead of siderial time in computing the + midpoint. (8/26/91, Seaman) + +astutil$asttools/*.x + Coerced all constants with many significant digits to double precision. + (6/24/91, Valdes) + +astutil$asttools/asthjd.x + The dummy argument t was changed to lt as declared. (6/24/91, Valdes) + +astutil$t_gratings.x +astutil$gratings.par +astutil$doc/gratings.hlp +astutil$mkpkg +astutil$astutil.cl +astutil$astutil.men +astutil$astutil.hd + Added a new task to compute grating parameters. (3/13/91, Valdes) + +astutil$t_setairmass.x +astutil$t_rvcorrect.x +astutil$t_asttimes.x +astutil$setairmass.par +astutil$rvcorrect.par +astutil$astttimes.par +astutil$doc/setairmass.hlp +astutil$doc/rvcorrect.hlp +astutil$doc/astttimes.hlp + Updated to use observatory parameter. (11/19/90, Valdes) + +astutil$t_obs.x + +astutil$x_astutil.x +astutil$mkpkg +astutil$astutil.cl +astutil$astutil.men +astutil$astutil.hd + 1. A new version of the observatory task based on an observatory database + using the new interface obsdb.x in xtools was added to the astutil + executable. + 2. The observatory help was revised and moved to astutil. + 3. The observatory task itself is defined in noao and was removed + from the astutil package definitions. + (11/6/90, Valdes) + +astutil$t_asttimes.x + Added a modulus operations to convert any zone to the range -12 to 12. + (9/28/90, Valdes) + +astutil$t_asttimes.x + Changed the procedure times to ast_times to avoid a name conflict in the + HPUX port. This is a better name anyway. (9/8/90, Valdes) + +astutil$asttimes.par + Removed the range limits on the zone. Zones east of Greenwich need to + be negative to obtain the correct dates. (6/15/90, Valdes) + +astutil$doc/galactic.hlp + Corrected comment about epoch of galactic coordinates. Added an example + showing how to get galactic coordinates for images containing + equitorial coordinates. (5/23/90, Valdes) + +==== +V2.9 +==== + +astutil$setairmass.par +astutil$t_setairmass.x + The task now precesses the coordinates to the epoch of the + observation. (2/2/90, Seaman) + +astutil$astutil.hd + The path to the sources to PDM was not defined correctly. + Changed src=pdm/t_pdm.x to src=pdm$t_pdm.x. (1/28/90 Lytle) + +astutil$t_setairmass.x + +astutil$setairmass.par + +astutil$doc/setairmass.hlp + +astutil$x_astutil.x +astutil$mkpkg +astutil$astutil.cl +astutil$astutil.men +astutil$astutil.hd + Added a new task to compute and update airmass and universal time + in image headers based on the exposure. (5/19/89, Valdes) + +astutil$asttools/asttimes.x + The leap year was not handled correctly for the centuries in + ast_day_of_year. (5/11/89, Valdes) + +astutil$rvcorrect.par +astutil$t_rvcorrect.x +astutil$doc/rvcorrect.hlp + Added 'imupdate' parameter to make updating image headers with + computed corrections an option. (5/5/89, Fitzpatrick) + +astutil$galactic.x +astutil$galactic.par +astutil$doc/galactic.hlp +astutil$asttools/astgaltoeq.x + + GALACTIC now can transform in either direction. (2/14/89, Valdes) + +noao$astutil/t_rvcorrect.x +noao$astutil/doc/rvcorrect.hlp + Changed the keywords and output when using images. The observed + velocity must now be VOBS. The output is HJD, VHELIO, VLSR, and + VSUN (a record of the Sun's velocity used for VLSR). (12/14/88 Valdes) + +noao$astutil/asttools/ast_galactic.x + The galactic task was not precessing the input coordinates before + computing the galactic coordinates. + + I changed the single precision defined constants to double precision + and the in line constant 15 to 15.0d0. + (9/15/88 Davis) + +noao$astutil/astvorbit.x +noao$astutil/astvbary.x +noao$astutil/asthjd.x + The calls to AST_COORD needed double precision arguments. (7/26/88 Valdes) + +noao$astutil/astutil.cl + Added OBSERVATORY task to this package. (4/12/88 Valdes) + +noao$astutil/galactic.x + The double precision variables lii and bii where being printed with + PARGR which gives wrong results on the SUNS. (11/6/87 Valdes) + +noao$astutil/* +noao$astutil/t_asttimes.x + +noao$astutil/asttimes.par + +noao$astutil/doc/asttimes.help + +noao$astutil/t_rvcorrect.x + +noao$astutil/rvcorrect.par + +noao$astutil/doc/rvcorrect.help + +noao$astutil/asttools/* + + The package was reorganized to put algorithm procedures in the subdirectory + asttools. A README file describes the contents of this directory. + + New tasks ASTTIMES and RVCORRECT have been added for computing astronomical + dates and times and radial velocity corrections. Tools used by these + tasks were added to the asttools library. + (10/29/87) + +noao$astutil/precess.x + Replaced use of preces.f with new ast_precess.x. This also involved + changing years to double precession internally. (10/28/87 Valdes) + +noao$astutil/Revisions + Valdes, May 26, 1987 + 1. Revisions file started. + + Lytle, May 28, 1987 + 2. Installed PDM in astutil. +.endhelp diff --git a/noao/astutil/airmass.par b/noao/astutil/airmass.par new file mode 100644 index 00000000..3ca578bc --- /dev/null +++ b/noao/astutil/airmass.par @@ -0,0 +1,4 @@ +elevation,r,a,90,0,90,elevation above horizon in degrees +scale,r,h,750.0,,,scale factor of Earth's atmosphere +radians,b,h,no,,,input elevation in radians instead of degrees +airmass,r,h diff --git a/noao/astutil/airmass.x b/noao/astutil/airmass.x new file mode 100644 index 00000000..042b3561 --- /dev/null +++ b/noao/astutil/airmass.x @@ -0,0 +1,88 @@ +include <math.h> + + +# T_AIRMASS -- Compute the airmass at a given elevation above the horizon. +# Airmass formulation from Allen "Astrophysical Quantities" 1973 p.125,133. + +procedure t_airmass() + +real elevation, airmass, scale +real x, radians_per_degree +bool clgetb() +real clgetr() +data radians_per_degree /57.29577951D0/ + +begin + # Get elevation in either degrees or radians and the scale factor + # for the Earth's atmosphere. + elevation = clgetr ("elevation") + if (!clgetb ("radians")) + elevation = elevation / radians_per_degree + scale = clgetr ("scale") + + x = scale * sin (elevation) + airmass = sqrt (x**2 + 2*scale + 1) - x + + call printf ("airmass %.5g at an elevation of ") + call pargr (airmass) + call printf ("%.5g degrees (%.5g radians) above horizon\n") + call pargr (elevation * radians_per_degree) + call pargr (elevation) + + # Store airmass back in a parameter so that it can be accessed from + # the CL. + call clputr ("airmass", airmass) +end + + +# 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 + + +# AIRMASSX -- Compute airmass from DEC, LATITUDE, HA, and SCALE + +# Airmass formulation from Allen "Astrophysical Quantities" 1973 p.125,133. +# and John Ball's book on Algorithms for the HP-45 + +double procedure airmassx (ha, dec, lat, scale) + +double ha #I the input hour angle in hours +double dec #I the input declination in degrees +double lat #I the input latitude in degrees +double scale #I the atmospheric scale height + +double 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.0d0 * scale + 1.0d0) - x) +end diff --git a/noao/astutil/astcalc.par b/noao/astutil/astcalc.par new file mode 100644 index 00000000..1a89121c --- /dev/null +++ b/noao/astutil/astcalc.par @@ -0,0 +1,5 @@ +commands,f,h,"",,,Commands +images,s,h,"",,,List of images +table,f,h,"",,,Table of values +prompt,s,h,"astcalc> ",,,Prompt for STDIN commands +verbose,b,h,no,,,Verbose output? diff --git a/noao/astutil/astfunc.h b/noao/astutil/astfunc.h new file mode 100644 index 00000000..f7eef3a8 --- /dev/null +++ b/noao/astutil/astfunc.h @@ -0,0 +1,7 @@ +# Common for AST_FUNC data. + +define LEN_AST 4 +define AST_STP Memi[$1] # Symbol table +define AST_TFD Memi[$1+1] # Text file descriptor +define AST_TBL Memi[$1+2] # Table descriptor +define AST_IM Memi[$1+3] # IMIO pointer diff --git a/noao/astutil/astfunc.x b/noao/astutil/astfunc.x new file mode 100644 index 00000000..8c463f3e --- /dev/null +++ b/noao/astutil/astfunc.x @@ -0,0 +1,604 @@ +include <evvexpr.h> +include <lexnum.h> +include <time.h> +include <mach.h> +include <imset.h> +include "astfunc.h" + +define KEYWORDS "|sexstr|epoch|julday|mst|precess|ra_precess|dec_precess|\ + |airmass|eairmass|obsdb|arcsep|\ + |if|format|print|printf|error|clget|clput|scan|fscan|\ + |imget|imput|imdel|" + +define F_SEXSTR 1 # sexstr (value) +define F_EPOCH 2 # epoch (date[, ut]) +define F_JULDAY 3 # julday (date[, ut]) +define F_MST 4 # mst (date[, ut], longitude) +define F_PRECESS 5 # precess (ra, dec, epoch1, epoch2) +define F_RAPRECESS 6 # ra_precess (ra, dec, epoch1, epoch2) +define F_DECPRECESS 7 # dec_precess (ra, dec, epoch1, epoch2) +define F_AIRMASS 9 # airmass (ra, dec, st, latitude) +define F_EAIRMASS 10 # eairmass (ra, dec, st, exptime, lat) +define F_OBSDB 11 # obsdb (observatory, parameter) +define F_ARCSEP 12 # arcsep (ra1, dec1, ra2, dec2) + +define F_IOFUNC 13 # Misc && I/O functions after here. +define F_IF 14 # if (arg) +define F_FORMAT 15 # format (fmt, arg, ...) +define F_PRINT 16 # print (arg, ...) +define F_PRINTF 17 # printf (fmt, arg, ...) +define F_ERROR 18 # error (message) +define F_CLGET 19 # clget (name) +define F_CLPUT 20 # clput (name, value) +define F_SCAN 21 # scan (params) +define F_FSCAN 22 # fscan (params) +define F_IMGET 24 # imget (keyword) +define F_IMPUT 25 # imput (keyword, value) +define F_IMDEL 26 # imdelete (keyword) + +define SOLTOSID (($1)*1.00273790935d0) + +# AST_FUNC -- Special astronomical functions. + +procedure ast_func (ast, func, args, nargs, out) + +pointer ast #I client data +char func[ARB] #I function to be called +pointer args[ARB] #I pointer to arglist descriptor +int nargs #I number of arguments +pointer out #O output operand (function value) + +int yr, mo, day +double time, epoch, ra, dec, longitude, latitude +double ast_julday(), ast_mst(), airmass() + +double dresult +int iresult, optype, oplen, opcode, v_nargs, i, ip, flags +pointer sp, buf, dval, obs + +bool strne() +pointer obsopen() +double ast_arcsep() +int strdic(), ctod(), btoi(), dtm_decode() +errchk malloc, obsopen, obsgstr + +begin + call smark (sp) + call salloc (buf, SZ_LINE, TY_CHAR) + call salloc (dval, nargs, TY_DOUBLE) + + # Lookup the function name in the dictionary. An exact match is + # required (strdic permits abbreviations). Abort if the function + # is not known. + + opcode = strdic (func, Memc[buf], SZ_LINE, KEYWORDS) + if (opcode == 0 || strne (func, Memc[buf])) + call xvv_error1 ("unknown function `%s' called", func) + + if (opcode > F_IOFUNC) { + call sfree (sp) + call ast_iofunc (ast, func, args, nargs, out) + return + } + + # Verify correct number of arguments. + switch (opcode) { + case F_SEXSTR: + v_nargs = -1 + case F_EPOCH, F_JULDAY: + v_nargs = -1 + case F_MST: + v_nargs = -2 + case F_PRECESS, F_RAPRECESS, F_DECPRECESS: + v_nargs = 4 + case F_AIRMASS: + v_nargs = 4 + case F_EAIRMASS: + v_nargs = 5 + case F_OBSDB: + v_nargs = 2 + case F_ARCSEP: + v_nargs = 4 + default: + v_nargs = 1 + } + + if (v_nargs > 0 && nargs != v_nargs) + call xvv_error2 ("function `%s' requires %d arguments", + func, v_nargs) + else if (v_nargs < 0 && nargs < abs(v_nargs)) + call xvv_error2 ("function `%s' requires at least %d arguments", + func, abs(v_nargs)) + + # Convert datatypes to double. + do i = 1, nargs { + switch (O_TYPE(args[i])) { + case TY_CHAR: + ip = 1 + if (ctod (O_VALC(args[i]), ip, Memd[dval+i-1]) == 0) + Memd[dval+i-1] = 0. + case TY_INT: + Memd[dval+i-1] = O_VALI(args[i]) + case TY_REAL: + Memd[dval+i-1] = O_VALR(args[i]) + case TY_DOUBLE: + Memd[dval+i-1] = O_VALD(args[i]) + } + } + + + # Expand date and time. + switch (opcode) { + case F_EPOCH, F_JULDAY, F_MST: + if (dtm_decode (O_VALC(args[1]), yr, mo, day, time, flags) == ERR) + call xvv_error ("unrecognized date format") + switch (opcode) { + case F_EPOCH, F_JULDAY: + if (nargs > 1) + time = Memd[dval+1] + case F_MST: + if (nargs > 2) + time = Memd[dval+1] + } + if (IS_INDEFD(time)) + time = 0. + call ast_date_to_epoch (yr, mo, day, time, epoch) + } + + # Evaluate the function. + oplen = 0 + optype = TY_DOUBLE + switch (opcode) { + case F_SEXSTR: + optype = TY_CHAR + oplen = MAX_DIGITS + call malloc (iresult, oplen, TY_CHAR) + call sprintf (Memc[iresult], oplen, "%.*h") + if (nargs > 1) + call pargi (max (0, nint (Memd[dval+1]))) + else + call pargi (0) + call pargd (Memd[dval]+1E-7) + + case F_EPOCH: + dresult = epoch + + case F_JULDAY: + dresult = ast_julday (epoch) + + case F_MST: + longitude = Memd[dval+nargs-1] + dresult = ast_mst (epoch, longitude) + + case F_PRECESS: + call ast_precess (Memd[dval], Memd[dval+1], Memd[dval+2], + ra, dec, Memd[dval+3]) + + optype = TY_CHAR + oplen = SZ_LINE + call malloc (iresult, oplen, TY_CHAR) + call sprintf (Memc[iresult], oplen, "%11.2h %11.1h %7g") + call pargd (ra) + call pargd (dec) + call pargd (Memd[dval+3]) + + case F_RAPRECESS: + call ast_precess (Memd[dval], Memd[dval+1], Memd[dval+2], + ra, dec, Memd[dval+3]) + dresult = ra + + case F_DECPRECESS: + call ast_precess (Memd[dval], Memd[dval+1], Memd[dval+2], + ra, dec, Memd[dval+3]) + dresult = dec + + case F_AIRMASS: + ra = Memd[dval] + dec = Memd[dval+1] + time = Memd[dval+2] + latitude = Memd[dval+3] + dresult = airmass (time-ra, dec, latitude) + + case F_EAIRMASS: + ra = Memd[dval] + dec = Memd[dval+1] + time = Memd[dval+2] + Memd[dval+3] = Memd[dval+3] / 3600. + latitude = Memd[dval+4] + dresult = airmass (time-ra, dec, latitude) + time = time + SOLTOSID(Memd[dval+3]) / 2. + dresult = dresult + 4 * airmass (time-ra, dec, latitude) + time = time + SOLTOSID(Memd[dval+3]) / 2. + dresult = dresult + airmass (time-ra, dec, latitude) + dresult = dresult / 6. + + case F_OBSDB: + optype = TY_CHAR + oplen = SZ_LINE + call malloc (iresult, oplen, TY_CHAR) + obs = obsopen (O_VALC(args[1])) + call obsgstr (obs, O_VALC(args[2]), Memc[iresult], oplen) + call obsclose (obs) + + case F_ARCSEP: + dresult = ast_arcsep (Memd[dval], Memd[dval+1], Memd[dval+2], + Memd[dval+3]) + + default: + call xvv_error ("bad switch in user function") + } + + # Format sexigesimal strings. + switch (opcode) { + case F_MST, F_RAPRECESS, F_DECPRECESS: + optype = TY_CHAR + oplen = MAX_DIGITS + call malloc (iresult, oplen, TY_CHAR) + call sprintf (Memc[iresult], oplen, "%.2h") + call pargd (dresult) + } + + # Write the result to the output operand. Bool results are stored in + # iresult as an integer value, string results are stored in iresult as + # a pointer to the output string, and integer and real/double results + # are stored in iresult and dresult without any tricks. + + call xvv_initop (out, oplen, optype) + switch (optype) { + case TY_BOOL: + O_VALI(out) = btoi (iresult != 0) + case TY_CHAR: + O_VALP(out) = iresult + case TY_INT: + O_VALI(out) = iresult + case TY_REAL: + O_VALR(out) = dresult + case TY_DOUBLE: + O_VALD(out) = dresult + } + + # Free any storage used by the argument list operands. + do i = 1, nargs + call xvv_freeop (args[i]) + + call sfree (sp) + return +end + + +# AST_IOFUNC -- I/O and miscellaneous functions. + +procedure ast_iofunc (ast, func, args, nargs, out) + +pointer ast #I client data +char func[ARB] #I function to be called +pointer args[ARB] #I pointer to arglist descriptor +int nargs #I number of arguments +pointer out #O output operand (function value) + +double dresult +int iresult, optype, oplen, opcode, v_nargs, i, j, k, l, ip +pointer sp, buf, sym, im + +double imgetd() +bool strne() +pointer stfind(), stenter() +int strdic(), ctoi(), ctod(), btoi() +int fscan(), nscan(), lexnum() +int imaccf(), imgftype(), imgeti() +errchk malloc + +begin + call smark (sp) + call salloc (buf, SZ_LINE, TY_CHAR) + + # Lookup the function name in the dictionary. An exact match is + # required (strdic permits abbreviations). Abort if the function + # is not known. + + opcode = strdic (func, Memc[buf], SZ_LINE, KEYWORDS) + if (opcode == 0 || strne (func, Memc[buf])) + call xvv_error1 ("unknown function `%s' called", func) + + # Verify correct number of arguments. + switch (opcode) { + case F_IF: + v_nargs = 1 + case F_FORMAT, F_PRINTF: + v_nargs = -1 + case F_PRINT: + v_nargs = 0 + case F_ERROR: + v_nargs = 1 + case F_CLGET: + v_nargs = 1 + case F_CLPUT: + v_nargs = 2 + case F_SCAN: + v_nargs = -1 + case F_FSCAN: + v_nargs = 0 + case F_IMGET, F_IMDEL: + v_nargs = 1 + case F_IMPUT: + v_nargs = 2 + default: + v_nargs = 1 + } + + if (v_nargs > 0 && nargs != v_nargs) + call xvv_error2 ("function `%s' requires %d arguments", + func, v_nargs) + else if (v_nargs < 0 && nargs < abs(v_nargs)) + call xvv_error2 ("function `%s' requires at least %d arguments", + func, abs(v_nargs)) + + # Evaluate the function. + oplen = 0 + optype = TY_INT + iresult = 0 + switch (opcode) { + case F_IF: + optype = TY_BOOL + switch (O_TYPE(args[1])) { + case TY_BOOL: + iresult = O_VALI(args[1]) + case TY_INT: + iresult = btoi (O_VALI(args[1]) != 0) + case TY_REAL: + iresult = btoi (O_VALR(args[1]) != 0.) + case TY_DOUBLE: + iresult = btoi (O_VALD(args[1]) != 0D0) + case TY_CHAR: + iresult = btoi (O_VALC(args[1])=='y' || O_VALC(args[1])=='Y') + } + + case F_FORMAT: + optype = TY_CHAR + oplen = SZ_LINE + call malloc (iresult, oplen, TY_CHAR) + call sprintf (Memc[iresult], oplen, O_VALC(args[1])) + do i = 2, nargs { + switch (O_TYPE(args[i])) { + case TY_CHAR: + call pargstr (O_VALC(args[i])) + case TY_INT: + call pargi (O_VALI(args[i])) + case TY_REAL: + call pargr (O_VALR(args[i])) + case TY_DOUBLE: + call pargd (O_VALD(args[i])) + } + } + + case F_PRINT: + do i = 1, nargs { + switch (O_TYPE(args[i])) { + case TY_CHAR: + call printf ("%s") + call pargstr (O_VALC(args[i])) + case TY_INT: + call printf ("%d") + call pargi (O_VALI(args[i])) + case TY_REAL: + call printf ("%g") + call pargr (O_VALR(args[i])) + case TY_DOUBLE: + call printf ("%g") + call pargd (O_VALD(args[i])) + } + if (i < nargs) + call printf (" ") + } + call printf ("\n") + + case F_PRINTF: + if (O_TYPE(args[1]) != TY_CHAR) + call xvv_error ("invalid print format") + call printf (O_VALC(args[1])) + do i = 2, nargs { + switch (O_TYPE(args[i])) { + case TY_CHAR: + call pargstr (O_VALC(args[i])) + case TY_INT: + call pargi (O_VALI(args[i])) + case TY_REAL: + call pargr (O_VALR(args[i])) + case TY_DOUBLE: + call pargd (O_VALD(args[i])) + } + } + + case F_ERROR: + if (O_TYPE(args[1]) != TY_CHAR) + call xvv_error ("error function requires string argument") + call xvv_error (O_VALC(args[1])) + + case F_CLGET: + if (O_TYPE(args[1]) != TY_CHAR) + call xvv_error ("clget function requires a string argument") + call clgstr (O_VALC(args[1]), Memc[buf], SZ_LINE) + ip = 1 + i = lexnum (Memc[buf], ip, j) + if (Memc[buf+j] != EOS) + i = LEX_NONNUM + switch (i) { + case LEX_OCTAL, LEX_DECIMAL, LEX_HEX: + ip = 1 + optype = TY_INT + k = ctoi (Memc[buf], ip, iresult) + case LEX_REAL: + ip = 1 + optype = TY_DOUBLE + k = ctod (Memc[buf], ip, dresult) + default: + optype = TY_CHAR + oplen = SZ_LINE + call malloc (iresult, oplen, TY_CHAR) + call strcpy (Memc[buf], Memc[iresult], oplen) + } + + case F_CLPUT: + switch (O_TYPE(args[2])) { + case TY_BOOL: + call clputb (O_VALC(args[1]), (O_VALI(args[2]) == YES)) + case TY_CHAR: + call clpstr (O_VALC(args[1]), O_VALC(args[2])) + case TY_INT: + call clputi (O_VALC(args[1]), O_VALI(args[2])) + case TY_REAL: + call clputr (O_VALC(args[1]), O_VALR(args[2])) + case TY_DOUBLE: + call clputd (O_VALC(args[1]), O_VALD(args[2])) + } + + case F_SCAN, F_FSCAN: + if (opcode == F_FSCAN) { + if (AST_TFD(ast) == NULL) + call xvv_error ("no text file for fscan") + if (fscan (AST_TFD(ast)) == EOF) + call xvv_error ("end of text file in fscan") + l = 1 + } else { + if (O_TYPE(args[1]) != TY_CHAR) + call xvv_error ("scan function requires string argument") + call sscan (O_VALC(args[1])) + l = 2 + } + do i = l, nargs { + call gargwrd (Memc[buf], SZ_LINE) + if (nscan() != i-l+1) + break + sym = stfind (AST_STP(ast), O_VALC(args[i])) + if (sym == NULL) + sym = stenter (AST_STP(ast), O_VALC(args[i]), SZ_LINE) + + ip = 1 + j = lexnum (Memc[buf], ip, k) + if (Memc[buf+k] != EOS) + j = LEX_NONNUM + switch (j) { + case LEX_OCTAL, LEX_DECIMAL, LEX_HEX: + ip = 1 + Memi[sym] = TY_INT + k = ctoi (Memc[buf], ip, Memi[sym+2]) + case LEX_REAL: + ip = 1 + Memi[sym] = TY_DOUBLE + k = ctod (Memc[buf], ip, Memd[P2D(sym+2)]) + default: + Memi[sym] = TY_CHAR + call strcpy (Memc[buf], Memc[P2C(sym+2)], SZ_LINE) + } + } + + optype = TY_INT + iresult = nscan() + + case F_IMGET: + im = AST_IM(ast) + if (im == NULL) + call xvv_error ("no image for imget") + if (imaccf (im, O_VALC(args[1])) == YES) { + switch (imgftype (im, O_VALC(args[1]))) { + case TY_BOOL, TY_SHORT, TY_INT, TY_LONG: + optype = TY_INT + iresult = imgeti (im, O_VALC(args[1])) + case TY_REAL, TY_DOUBLE, TY_COMPLEX: + optype = TY_DOUBLE + dresult = imgetd (im, O_VALC(args[1])) + default: + optype = TY_CHAR + oplen = SZ_LINE + call malloc (iresult, oplen, TY_CHAR) + call imgstr (im, O_VALC(args[1]), Memc[iresult], oplen) + } + } else { + optype = TY_CHAR + oplen = 1 + call calloc (iresult, oplen, TY_CHAR) + } + + case F_IMPUT: + im = AST_IM(ast) + if (im == NULL) + call xvv_error ("no image for imput") + + optype = TY_CHAR + oplen = SZ_LINE + call malloc (iresult, oplen, TY_CHAR) + iferr (call imgstr (im, O_VALC(args[1]), Memc[buf], SZ_LINE)) { + call sprintf (Memc[iresult], oplen, "imput: %s = ") + call pargstr (O_VALC(args[1])) + } else { + call sprintf (Memc[iresult], oplen, "imput: %s = %s -> ") + call pargstr (O_VALC(args[1])) + call pargstr (Memc[buf]) + } + + iferr (call imdelf (im, O_VALC(args[1]))) + ; + switch (O_TYPE(args[2])) { + case TY_BOOL: + call imaddb (im, O_VALC(args[1]), (O_VALI(args[2]) == YES)) + case TY_CHAR: + call imastr (im, O_VALC(args[1]), O_VALC(args[2])) + case TY_INT: + call imaddi (im, O_VALC(args[1]), O_VALI(args[2])) + case TY_REAL: + call imaddr (im, O_VALC(args[1]), O_VALR(args[2])) + case TY_DOUBLE: + call imaddd (im, O_VALC(args[1]), O_VALD(args[2])) + } + + call imgstr (im, O_VALC(args[1]), Memc[buf], SZ_LINE) + call strcat (Memc[buf], Memc[iresult], oplen) + + case F_IMDEL: + im = AST_IM(ast) + if (im == NULL) + call xvv_error ("no image for imdelete") + + optype = TY_CHAR + oplen = SZ_LINE + call malloc (iresult, oplen, TY_CHAR) + iferr (call imgstr (im, O_VALC(args[1]), Memc[buf], SZ_LINE)) { + call sprintf (Memc[iresult], oplen, "imdel: %s not found") + call pargstr (O_VALC(args[1])) + } else { + call sprintf (Memc[iresult], oplen, "imdel: %s = %s (DELETED)") + call pargstr (O_VALC(args[1])) + call pargstr (Memc[buf]) + call imdelf (im, O_VALC(args[1])) + } + + default: + call xvv_error ("bad switch in user function") + } + + # Write the result to the output operand. Bool results are stored in + # iresult as an integer value, string results are stored in iresult as + # a pointer to the output string, and integer and real/double results + # are stored in iresult and dresult without any tricks. + + call xvv_initop (out, oplen, optype) + switch (optype) { + case TY_BOOL: + O_VALI(out) = btoi (iresult != 0) + case TY_CHAR: + O_VALP(out) = iresult + case TY_INT: + O_VALI(out) = iresult + case TY_REAL: + O_VALR(out) = dresult + case TY_DOUBLE: + O_VALD(out) = dresult + } + + # Free any storage used by the argument list operands. + do i = 1, nargs + call xvv_freeop (args[i]) + + call sfree (sp) + return +end diff --git a/noao/astutil/asthedit.par b/noao/astutil/asthedit.par new file mode 100644 index 00000000..33b21223 --- /dev/null +++ b/noao/astutil/asthedit.par @@ -0,0 +1,8 @@ +images,s,a,,,,Images to be operated upon +commands,f,a,,,,File of commands +table,f,h,"",,,File of values +colnames,s,h,"",,,Column names in table file +prompt,s,h,"asthedit> ",,,Prompt for STDIN commands +update,b,h,yes,,,Update image header? +verbose,b,h,no,,,Verbose output? +oldstyle,b,h,no,,,Use old style format? diff --git a/noao/astutil/astradius.cl b/noao/astutil/astradius.cl new file mode 100644 index 00000000..ac0c6bc1 --- /dev/null +++ b/noao/astutil/astradius.cl @@ -0,0 +1,16 @@ +# ASTRADIUS -- Find images within a radius. + +procedure astradius (images, racenter, deccenter, epcenter, radius) + +string images = "" {prompt="List of images"} +string racenter = "" {prompt="RA center (hours)"} +string deccenter = "" {prompt="DEC center (degrees)"} +real epcenter = 2000. {prompt="Epoch of center"} +real radius = 60. {prompt="Radius in arc seconds"} +pset keywpars = "" {prompt="Keywords for RA, DEC, EPOCH\n"} + +file commands = "astutil$astradius.dat" {prompt="ASTCALC file"} + +begin + astcalc (commands=commands, images=images, table="", verbose=no) +end diff --git a/noao/astutil/astradius.dat b/noao/astutil/astradius.dat new file mode 100644 index 00000000..62b9c6a5 --- /dev/null +++ b/noao/astutil/astradius.dat @@ -0,0 +1,27 @@ +# Print images which are within a given radius in the sky. + +# Get parameters. +racenter = clget ("astradius.racenter") +deccenter = clget ("astradius.deccenter") +epcenter = clget ("astradius.epcenter") +radius = clget ("astradius.radius") +ra = imget(clget("keywpars.ra")) +dec = imget(clget("keywpars.dec")) + +epoch = imget(clget("keywpars.epoch")) +if (str(epoch) == "" || real(epoch) == 0.) + date = imget(clget("keywpars.date_obs")) + ut = imget(clget("keywpars.ut")) + epoch = epoch (date, ut) +endif + +# Precess image coordinates to center epoch and compute separation. +radec = precess (ra, dec, epoch, epcenter) +ra1 = ra_precess (ra, dec, epoch, epcenter) +dec1 = dec_precess (ra, dec, epoch, epcenter) +sep = arcsep (racenter, deccenter, ra1, dec1) + +# Print result if within radius. +if (sep < real (radius)) + printf ("%-15s %s\n", $I, imget ("title")) +endif diff --git a/noao/astutil/asttimes.par b/noao/astutil/asttimes.par new file mode 100644 index 00000000..abe5458f --- /dev/null +++ b/noao/astutil/asttimes.par @@ -0,0 +1,15 @@ +files,s,h,"",,,List of files containing dates and times +header,b,h,yes,,,Print header? +observatory,s,h,)_.observatory,,,"Observatory +" + +year,i,h,,,,Year +month,i,h,,1,12,Month +day,i,h,,1,31,Day +time,r,h,,0.,24.,"Local zone time +" + +ut,r,h,,,,Universal time (output) +epoch,r,h,,,,Epoch (output) +jd,r,h,,,,Julian date (output) +lmst,r,h,,,,Local mean siderial time (output) diff --git a/noao/astutil/asttools/PRECESS b/noao/astutil/asttools/PRECESS new file mode 100644 index 00000000..48ca311a --- /dev/null +++ b/noao/astutil/asttools/PRECESS @@ -0,0 +1,33 @@ +INPUT[1] OUTPUT[2] DEL[3] DEL[4] DEL[5] + 1950.0 2000.0 SEC SEC SEC +-------- ------------------------- ---------- ---------- ------------ +RA DEC RA DEC RA DEC RA DEC RA DEC + 0 0 0:02:33.73 0:16:42.24 0.04 0.24 0.04 0.24 1.09 7.04 + 6 0 6:02:33.72 -0:00:05.60 0.03 0.00 0.03 0.00 -0.45 0.89 +12 0 12:02:33.72 -0:16:42.24 0.03 -0.24 0.03 -0.24 0.71 -4.64 +18 0 18:02:33.72 0:00:05.60 0.03 0.00 0.03 0.00 2.25 1.51 + 0 30 0:02:33.94 30:16:42.24 0.04 0.24 0.04 0.24 1.13 -3.24 + 6 30 6:03:12.30 29:59:52.99 0.05 -0.01 0.05 -0.01 -0.43 -2.06 +12 0 12:02:33.72 -0:16:42.24 0.03 -0.24 0.03 -0.24 0.71 -4.64 +18 0 18:02:33.72 0:00:05.60 0.03 0.00 0.03 0.00 2.25 1.51 + 0 60 0:02:34.38 60:16:42.24 0.04 0.24 0.04 0.24 1.32 -11.1 + 6 60 6:04:29.44 59:59:50.18 0.06 -0.01 0.06 -0.01 -1.14 -6.33 +12 60 12:02:33.08 59:43:17.76 0.03 -0.24 0.03 -0.24 0.50 12.29 +18 60 18:00:37.99 60:00:01.38 0.01 0.00 0.01 0.00 2.92 -0.91 + 0 90 12:01:16.87 89:43:17.75 0.02 -0.23 43200 -2004 -512529 -2019 + 0 -30 0:02:33.51 -29:43:17.76 0.04 0.24 0.04 0.24 1.10 17.01 + 6 -30 6:01:55.15 -30:00:04.20 0.03 -0.01 0.03 -0.01 -0.89 3.52 +12 -30 12:02:33.94 -30:16:42.24 0.04 -0.24 0.04 -0.24 0.70 -14.92 +18 -30 18:03:12.30 -29:59:52.99 0.05 0.01 0.05 0.01 2.68 1.37 + 0 -60 0:02:33.08 -59:43:17.76 0.03 0.24 0.03 0.24 1.24 23.98 + 6 -60 6:00:37.99 -60:00:01.38 0.01 0.00 0.01 0.00 -2.48 6.92 +12 -60 12:02:34.38 -60:16:42.24 0.04 -0.24 0.04 -0.24 0.58 -22.77 +18 -60 18:04:29.44 -59:59:50.18 0.06 0.01 0.06 0.01 4.26 2.73 + 0 -90 0:01:16.87 -89:43:17.74 0.02 0.24 0.02 0.25 -733455 26.11 + + [1] Epoch 1950.0 + [2] Epoch 2000.0 using ASTPRECESS.X based on 1984 Ephemeris + [3] Difference using PRECESSGJ.X (first IRAF procedure by G. Jacoby) + [4] Difference using routine originally for the Cyber by D. Wells + [5] Difference using PRECESSMGB.X (from DOPSET by Manchester, Gorder, and Ball) + It includes aberation and nutation. diff --git a/noao/astutil/asttools/README b/noao/astutil/asttools/README new file mode 100644 index 00000000..dbdb7d67 --- /dev/null +++ b/noao/astutil/asttools/README @@ -0,0 +1,137 @@ +Astronomical Tools: + +Precession: These routines probably have some history even before the + authors quoted as original sources. They have been collected and + some rewritten into SPP by F. Valdes (NOAO), March 1986. PRECES.F + was used originally in V2.3-V2.5 IRAF by George Jacoby. It has + been replaced by ASTPRECESS.X which is the only procedure in the + library. + + astprecess.x -- Precession written by F. Valdes based on Astronomical + Almanac using new IAU system. + precessmgb.x -- Precession + aberration + nutation based on the work of + Manchester, Gordon, and Ball + precessgj.x -- Originally written by G. Jacoby in Fortran and distributed + with V2.3-V2.5 IRAF. Transcribed to SPP by F. Valdes + + Notes: + 1. The differences between ASTPRECESS.X and PRECESSGJ.X ( + and a routine written by D. Wells for the Cyber and later + used in other NOAO software) are on the order of a few + tenths of a second of arc. I believe the differences are + due to using 1984 almanac methods in the former and much + earlier methods for the latter. + 3. PRECESSMGB.X differs considerably from the others to the order + of many seconds of arc. It does include other effects not + present in the other routines. It totally fails at DEC=+-90. + It is based on roughly 1970 almanac methods. + 4. See PRECESS.DOC for comparison. + +Radial Velocity: These formulas for these routines were partly obtained + by inspection of the code for the subroutine DOP in the program DOPSET + written by R. N. Manchester and M. A. Gordon of NRAO dated January 1970. + They have been restructured, revised, and coded in SPP by F. Valdes. + + astvr.x -- Project a velocity vector in radial velocity along line of sight. + astvbary.x -- Radial velocity component of center of the Earth relative to + to the barycenter of the Earth-Moon system. + astvrotate.x -- Radial velocity component of the observer relative to + the center of the Earth due to the Earth's rotation. + astvorbit.x -- Radial velocity component of the observer relative to + the center of the Earth due to the Earth's rotation. + astvsun.x -- Projection of the sun's velocity along the given direction. + +Coordinates: + + astarcsep.x -- Arc distance (arcsec) between two spherical coordinates + (hours, degrees). + astcoord.x -- This procedure converts the longitude-latitude coordinates + (a1, b1) of a point on a sphere into corresponding coordinates + (a2, b2) in a different coordinate system that is specified by + the coordinates of its origin (ao, bo) and its north pole (ap, + bp) in the original coordinate system. The range of a2 will be + from -pi to pi. + astgalactic.x -- Convert equatorial coordinates (1950) to galactic + coordinates. + astgaltoeq.x -- Convert galactic coordinates to equitorial (1950). + +Dates and times: + + asttimes.x: + AST_DATE_TO_EPOCH -- Convert Gregorian date and solar mean time to + a Julian epoch. A Julian epoch has 365.25 days per year and 24 + hours per day. + AST_EPOCH_TO_DATE -- Convert a Julian epoch to year, month, day, and + time. + AST_DAY_OF_YEAR -- The day number for the given year is returned. + AST_DAY_OF_WEEK -- Return the day of the week for the given Julian day. + The integer day of the week is 0=Sunday - 6=Saturday. The + character string is the three character abbreviation for the day + of the week. Note that the day of the week is for Greenwich + if the standard UT is used. + AST_JULDAY -- Convert epoch to Julian day. + AST_DATE_TO_JULDAY -- Convert date to Julian day. + AST_JULDAY_TO_DATE -- Convert Julian day to date. + AST_MST -- Mean sidereal time of the epoch at the given longitude. + This procedure may be used to optain Greenwich Mean Sidereal Time + (GMST) by setting the longitude to 0. + asthjd.x: + AST_HJD -- Helocentic Julian Day for a direction of observation. + AST_JD_TO_HJD -- Helocentic Julian Day for a direction of observation. + +Helocentric Parameters: + + astdsun.x: + AST_DSUN - Distance to Sun in AU. + +Misc: + + astlvac.x: + AST_LVAC - Convert air wavelengths to vacuum wavelengths (Angstroms) + +Y2K: + Most routines work in Julian days or epochs. If they have an input + year it is converted to one of these forms by calling + ast_date_to_julday. This is the only routine that has a Y2K + connection. It assumes two digit years are 20th century. These + routines are Y2K correct. + + +The following are the comments and references from the DOPSET program +noted above. The HJD routine was also derived from this code. + +C MODIFIED FOR IBM 360 BY R.N.MANCHESTER AND M.A.GORDON +C JANUARY 1970 +C +C +C DOP CALCULATES THE VELOCITY COMPONENT OF THE OBSERVER WITH RESPECT +C TO THE LOCAL STANDARD OF REST AS PROJECTED ONTO A LINE SPECIFIED BY T +C ASCENSION AND DECLINATION (RAHRS, RAMIN, RASEC, DDEG, DMIN, DSEC) EPO +C DATE, FOR A TIME SPECIFIED AS FOLLOWS: NYR = LAST TWO DIGITS OF THE +C (FOR 19XX A.D.), NDAY = DAY NUMBER (GMT), NHUT, NMUT, NSUT = HRS, MIN +C (GMT). THE LOCATION OF THE OBSERVER IS SPECIFIED BY THE LATITUDE (AL +C LONGITUDE (OLONG) (GEODETIC) (IN DEGREES) AND ELEVATION (ELEV) (IN ME +C ABOVE MEAN SEA LEVEL. THE SUBROUTINE OUTPUTS THE LOCAL MEAN SIDEREAL +C (XLST IN DAYS), THE COMPONENT OF THE SUN*S MOTION WITH RESPECT TO THE +C STANDARD OF REST AS PROJECTED ONTO THE LINE OF SIGHT TO THE SOURCE (V +C KM/SEC) AS WELL AS THE TOTAL VELOCITY COMPONENT V1 (KM/SEC). POSITIV +C VELOCITY CORRESPONDS TO INCREASING DISTANCE BETWEEN SOURCE AND OBSERV +C +C THIS VERSION OF DOP TAKES INTO ACCOUNT COMPONENTS OF THE OBSERVER*S +C MOTION DUE TO THE ROTATION OF THE EARTH, THE REVOLUTION OF THE EARTH- +C BARYCENTER ABOUT THE SUN, AND THE MOTION OF THE EARTH*S CENTER ABOUT +C EARTH-MOON BARYCENTER. THE PERTURBATIONS OF THE EARTH*S ORBIT DUE TO +C PLANETS ARE NEGLECTED. THE ABSOLUTE PRECISION OF THIS VERSION OF DOP +C ABOUT 0.004 KM/SEC, BUT SINCE THE DOMINANT ERROR TERM IS SLOWLY VARYI +C RELATIVE ERROR WILL BE CONSIDERABLY LESS FOR TIMES UP TO A WEEK OR SO +C +C REFERENCES: MCRAE, D. A., WESTERHOUT, G., TABLE FOR THE REDUCTION OF +C VELOCITIES TO THE LOCAL STANDARD OF REST, THE OBSERVAY=2. +C LUND, SWEDEN, 1956. +C SMART, W. M., TEXT-BOOK ON SPHERICAL ASTRONOMY, CAMBRIDG +C UNIV. PRESS, 1962. +C THE AMERICAN EPHEMERIS AND NAUTICAL ALMANAC +C THE SUPPLEMENT TO THE ABOVE +C +C VERSION OF JUNE 1969 + diff --git a/noao/astutil/asttools/astarcsep.x b/noao/astutil/asttools/astarcsep.x new file mode 100644 index 00000000..023fd20f --- /dev/null +++ b/noao/astutil/asttools/astarcsep.x @@ -0,0 +1,33 @@ +include <math.h> + +# AST_ARCSEP -- Arc distance (arcsec) between two spherical coordinates +# (hours,deg). + +double procedure ast_arcsep (ra1, dec1, ra2, dec2) + +double ra1 # Right ascension (hours) +double dec1 # Declination (degrees) +double ra2 # Right ascension (hours) +double dec2 # Declination (degrees) + +double a1, b1, c1, a2, b2, c2 + +begin + # Direction cosines + a1 = cos (DEGTORAD (15D0 * ra1)) * cos (DEGTORAD (dec1)) + b1 = sin (DEGTORAD (15D0 * ra1)) * cos (DEGTORAD (dec1)) + c1 = sin (DEGTORAD (dec1)) + + a2 = cos (DEGTORAD (15D0 * ra2)) * cos (DEGTORAD (dec2)) + b2 = sin (DEGTORAD (15D0 * ra2)) * cos (DEGTORAD (dec2)) + c2 = sin (DEGTORAD (dec2)) + + # Modulus squared of half the difference vector. + a1 = ((a1-a2)**2 + (b1-b2)**2 + (c1-c2)**2) / 4 + + # Angle + a1 = 2D0 * atan2 (sqrt (a1), sqrt (max (0D0, 1D0-a1))) + a1 = RADTODEG (a1) * 3600D0 + + return (a1) +end diff --git a/noao/astutil/asttools/astcoord.x b/noao/astutil/asttools/astcoord.x new file mode 100644 index 00000000..07a01ee3 --- /dev/null +++ b/noao/astutil/asttools/astcoord.x @@ -0,0 +1,56 @@ +# AST_COORD -- Convert spherical coordinates to new system. +# +# This procedure converts the longitude-latitude coordinates (a1, b1) +# of a point on a sphere into corresponding coordinates (a2, b2) in a +# different coordinate system that is specified by the coordinates of its +# origin (ao, bo). The range of a2 will be from -pi to pi. + +procedure ast_coord (ao, bo, ap, bp, a1, b1, a2, b2) + +double ao, bo # Origin of new coordinates (radians) +double ap, bp # Pole of new coordinates (radians) +double a1, b1 # Coordinates to be converted (radians) +double a2, b2 # Converted coordinates (radians) + +double sao, cao, sbo, cbo, sbp, cbp +double x, y, z, xp, yp, zp, temp + +begin + x = cos (a1) * cos (b1) + y = sin (a1) * cos (b1) + z = sin (b1) + xp = cos (ap) * cos (bp) + yp = sin (ap) * cos (bp) + zp = sin (bp) + + # Rotate the origin about z. + sao = sin (ao) + cao = cos (ao) + sbo = sin (bo) + cbo = cos (bo) + temp = -xp * sao + yp * cao + xp = xp * cao + yp * sao + yp = temp + temp = -x * sao + y * cao + x = x * cao + y * sao + y = temp + + # Rotate the origin about y. + temp = -xp * sbo + zp * cbo + xp = xp * cbo + zp * sbo + zp = temp + temp = -x * sbo + z * cbo + x = x * cbo + z * sbo + z = temp + + # Rotate pole around x. + sbp = zp + cbp = yp + temp = y * cbp + z * sbp + y = y * sbp - z * cbp + z = temp + + # Final angular coordinates. + a2 = atan2 (y, x) + b2 = asin (z) +end diff --git a/noao/astutil/asttools/astdsun.x b/noao/astutil/asttools/astdsun.x new file mode 100644 index 00000000..89af95f7 --- /dev/null +++ b/noao/astutil/asttools/astdsun.x @@ -0,0 +1,19 @@ +include <math.h> + +# AST_DSUN -- Distance to Sun in AU +# Taken from Astronomical Almanac 1984, page C24. + +double procedure ast_dsun (epoch) + +double epoch # Epoch desired + +double n, g, r +double ast_julday() + +begin + n = ast_julday (epoch) - 2451545d0 + g = DEGTORAD (357.528d0 + 0.9856003d0 * n) + r = 1.00014d0 - 0.01671d0 * cos (g) - 0.00014d0 * cos (2 * g) + + return (r) +end diff --git a/noao/astutil/asttools/astgalactic.x b/noao/astutil/asttools/astgalactic.x new file mode 100644 index 00000000..ab51a918 --- /dev/null +++ b/noao/astutil/asttools/astgalactic.x @@ -0,0 +1,52 @@ +include <mach.h> +include <math.h> + +# Definition of system +define LONGNCP 123.00d0 # Longtitude of NCP +define RAGPOLE 192.25d0 # RA Galactic Pole (12:49) +define DECGPOLE 27.4d0 # DEC Galactic Pole (27:24) +define GEPOCH 1950.0d0 # Epoch of definition + +# AST_GALACTIC -- Convert equatorial coordinates to galactic coordinates. +# Input coordinates and epoch are changed to epoch of galactic coordinates. + +procedure ast_galactic (ra, dec, epoch, lii, bii) + +double ra # Right ascension (hours) +double dec # Declination (degrees) +double epoch # Epoch of coordinates +double lii # Galactic longitude (degrees) +double bii # Galactic latitude (degrees) + +double rar, decr, drar, cosdecg, sindecg, cosdecr, x, y, z, r, temp + +begin + # Precess the coordinates to 1950.0 + call ast_precess (ra, dec, epoch, rar, decr, double (GEPOCH)) + + # Precompute the necessary constants. + drar = DEGTORAD (15.0d0 * rar - RAGPOLE) + cosdecg = cos (DEGTORAD (DECGPOLE)) + sindecg = sin (DEGTORAD(DECGPOLE)) + cosdecr = cos (DEGTORAD (decr)) + + # Compute the tansformation equations + x = cosdecr * cos (drar) + y = cosdecr * sin (drar) + z = sin (DEGTORAD (decr)) + temp = z * cosdecg - x * sindecg + z = z * sindecg + x * cosdecg + x = temp + r = sqrt (x * x + y * y) + + # Compute lii and bii and convert to degrees. + if (r < EPSILOND) + lii = 0.0d0 + else + lii = DEGTORAD (LONGNCP) + atan2 (-y, x) + if (lii < 0.0d0) + lii = lii + TWOPI + bii = atan2 (z, r) + lii = RADTODEG (lii) + bii = RADTODEG (bii) +end diff --git a/noao/astutil/asttools/astgaltoeq.x b/noao/astutil/asttools/astgaltoeq.x new file mode 100644 index 00000000..94f7861d --- /dev/null +++ b/noao/astutil/asttools/astgaltoeq.x @@ -0,0 +1,37 @@ +include <math.h> + +# Definition of system +define LP 123.00d0 # Longtitude of pole +define BP 27.40d0 # Latitude of pole +define LO 97.7422d0 # Longitude of origin +define BO -60.1810d0 # Latitude of origin +define GEPOCH 1950.0d0 # Epoch of definition + +# AST_GALTOEQ -- Convert galactic coordinates (1950) to equatorial coordinates. + +procedure ast_galtoeq (lii, bii, ra, dec, epoch) + +double lii # Galactic longitude (degrees) +double bii # Galactic latitude (degrees) +double ra # Right ascension (hours) +double dec # Declination (degrees) +double epoch # Epoch of coordinates + +double ao, bo, ap, bp, a1, b1, a2, b2 + +begin + ao = DEGTORAD (LO) + bo = DEGTORAD (BO) + ap = DEGTORAD (LP) + bp = DEGTORAD (BP) + a1 = DEGTORAD (lii) + b1 = DEGTORAD (bii) + + call ast_coord (ao, bo, ap, bp, a1, b1, a2, b2) + + a2 = mod (24.0d0 + RADTODEG(a2) / 15.0d0, 24.0d0) + b2 = RADTODEG (b2) + + # Precess the coordinates + call ast_precess (a2, b2, GEPOCH, ra, dec, epoch) +end diff --git a/noao/astutil/asttools/asthjd.x b/noao/astutil/asttools/asthjd.x new file mode 100644 index 00000000..29efd0b5 --- /dev/null +++ b/noao/astutil/asttools/asthjd.x @@ -0,0 +1,82 @@ +include <math.h> + +# AST_HJD -- Helocentric Julian Day from Epoch + +procedure ast_hjd (ra, dec, epoch, lt, hjd) + +double ra # Right ascension of observation (hours) +double dec # Declination of observation (degrees) +double epoch # Julian epoch of observation +double lt # Light travel time in seconds +double hjd # Helocentric Julian Day + +double ast_julday() + +begin + call ast_jd_to_hjd (ra, dec, ast_julday(epoch), lt, hjd) +end + + +# AST_JD_TO_HJD -- Helocentric Julian Day from UT Julian date + +procedure ast_jd_to_hjd (ra, dec, jd, lt, hjd) + +double ra # Right ascension of observation (hours) +double dec # Declination of observation (degrees) +double jd # Geocentric Julian date of observation +double lt # Light travel time in seconds +double hjd # Helocentric Julian Day + +double t, manom, lperi, oblq, eccen, tanom, slong, r, d, l, b, rsun + +begin + # JD is the geocentric Julian date. + # T is the number of Julian centuries since J1900. + + t = (jd - 2415020d0) / 36525d0 + + # MANOM is the mean anomaly of the Earth's orbit (degrees) + # LPERI is the mean longitude of perihelion (degrees) + # OBLQ is the mean obliquity of the ecliptic (degrees) + # ECCEN is the eccentricity of the Earth's orbit (dimensionless) + + manom = 358.47583d0 + + t * (35999.04975d0 - t * (0.000150d0 + t * 0.000003d0)) + lperi = 101.22083d0 + + t * (1.7191733d0 + t * (0.000453d0 + t * 0.000003d0)) + oblq = 23.452294d0 - + t * (0.0130125d0 + t * (0.00000164d0 - t * 0.000000503d0)) + eccen = 0.01675104d0 - t * (0.00004180d0 + t * 0.000000126d0) + + # Convert to principle angles + manom = mod (manom, 360.0D0) + lperi = mod (lperi, 360.0D0) + + # Convert to radians + r = DEGTORAD(ra * 15) + d = DEGTORAD(dec) + manom = DEGTORAD(manom) + lperi = DEGTORAD(lperi) + oblq = DEGTORAD(oblq) + + # TANOM is the true anomaly (approximate formula) (radians) + tanom = manom + (2 * eccen - 0.25 * eccen**3) * sin (manom) + + 1.25 * eccen**2 * sin (2 * manom) + + 13./12. * eccen**3 * sin (3 * manom) + + # SLONG is the true longitude of the Sun seen from the Earth (radians) + slong = lperi + tanom + PI + + # L and B are the longitude and latitude of the star in the orbital + # plane of the Earth (radians) + + call ast_coord (double (0.), double (0.), double (-HALFPI), + HALFPI - oblq, r, d, l, b) + + # R is the distance to the Sun. + rsun = (1. - eccen**2) / (1. + eccen * cos (tanom)) + + # LT is the light travel difference to the Sun. + lt = -0.005770d0 * rsun * cos (b) * cos (l - slong) + hjd = jd + lt +end diff --git a/noao/astutil/asttools/astlvac.x b/noao/astutil/asttools/astlvac.x new file mode 100644 index 00000000..3ef4d895 --- /dev/null +++ b/noao/astutil/asttools/astlvac.x @@ -0,0 +1,29 @@ +# AST_LVAC -- Convert air wavelength to vacuum wavelength. +# +# Convert LAMBDA(air) to LAMBDA(vacuum) using the formulae +# +# (n-1)*1e8 = 8342.13 + 2406030/(130-s**2) + 15997/(38.9-s**2) +# +# where s = 1/lambda(air) (for lambda in MICRONS) +# +# lambda(vac) = n * lambda(air) +# +# NOTE: lambda is given in ANGSTROMS for this program. +# + +procedure ast_lvac (lair, lvac, npts) + +double lair[npts] #I Air wavelength (Angstroms) +double lvac[npts] #O Vacuum wavelength (Angstroms) +int npts #I Number of points + +int i +double s2, n + +begin + do i = 1, npts { + s2 = 1D8 * (1. / lair[i]) ** 2 + n = 1 + ((8342.13 + 2406030 / (130-s2) + 15997 / (38.9-s2)) / 1D8) + lvac[i] = n * lair[i] + } +end diff --git a/noao/astutil/asttools/astprecess.x b/noao/astutil/asttools/astprecess.x new file mode 100644 index 00000000..6c69d792 --- /dev/null +++ b/noao/astutil/asttools/astprecess.x @@ -0,0 +1,117 @@ +include <math.h> + +# AST_PRECESS -- Precess coordinates from epoch1 to epoch2. +# +# The method used here is based on the new IAU system described in the +# supplement to the 1984 Astronomical Almanac. The precession is +# done in two steps; precess epoch1 to the standard epoch J2000.0 and then +# precess from the standard epoch to epoch2. The precession between +# any two dates is done this way because the rotation matrix coefficients +# are given relative to the standard epoch. + +procedure ast_precess (ra1, dec1, epoch1, ra2, dec2, epoch2) + +double ra1, dec1, epoch1 # First coordinates +double ra2, dec2, epoch2 # Second coordinates + +double r0[3], r1[3], p[3, 3] +bool fp_equald() + +begin + # If the input epoch is 0 or undefined then assume the input epoch + # is the same as the output epoch. If the two epochs are the same + # then return the coordinates from epoch1. + + if ((epoch1 == 0.) || IS_INDEFD (epoch1) || fp_equald(epoch1, epoch2)) { + ra2 = ra1 + dec2 = dec1 + return + } + + # Rectangular equitorial coordinates (direction cosines). + ra2 = DEGTORAD (ra1 * 15.) + dec2 = DEGTORAD (dec1) + + r0[1] = cos (ra2) * cos (dec2) + r0[2] = sin (ra2) * cos (dec2) + r0[3] = sin (dec2) + + # If epoch1 is not the standard epoch then precess to the standard + # epoch. + + if (epoch1 != 2000.) { + call ast_rotmatrix (epoch1, p) + + # Note that we multiply by the inverse of p which is the + # transpose of p. + + r1[1] = p[1, 1] * r0[1] + p[1, 2] * r0[2] + p[1, 3] * r0[3] + r1[2] = p[2, 1] * r0[1] + p[2, 2] * r0[2] + p[2, 3] * r0[3] + r1[3] = p[3, 1] * r0[1] + p[3, 2] * r0[2] + p[3, 3] * r0[3] + r0[1] = r1[1] + r0[2] = r1[2] + r0[3] = r1[3] + } + + # If epoch2 is not the standard epoch then precess from the standard + # epoch to the desired epoch. + + if (epoch2 != 2000.) { + call ast_rotmatrix (epoch2, p) + r1[1] = p[1, 1] * r0[1] + p[2, 1] * r0[2] + p[3, 1] * r0[3] + r1[2] = p[1, 2] * r0[1] + p[2, 2] * r0[2] + p[3, 2] * r0[3] + r1[3] = p[1, 3] * r0[1] + p[2, 3] * r0[2] + p[3, 3] * r0[3] + r0[1] = r1[1] + r0[2] = r1[2] + r0[3] = r1[3] + } + + # Convert from radians to hours and degrees. + ra2 = RADTODEG (atan2 (r0[2], r0[1]) / 15.) + dec2 = RADTODEG (asin (r0[3])) + if (ra2 < 0.) + ra2 = ra2 + 24 +end + + +# ROTMATRIX -- Compute the precession rotation matrix from the standard epoch +# J2000.0 to the specified epoch. + +procedure ast_rotmatrix (epoch, p) + +double epoch # Epoch of date +double p[3, 3] # Rotation matrix + +double t, a, b, c, ca, cb, cc, sa, sb, sc +double ast_julday() + +begin + # The rotation matrix coefficients are polynomials in time measured + # in Julian centuries from the standard epoch. The coefficients are + # in degrees. + + t = (ast_julday (epoch) - 2451545.0d0) / 36525d0 + + a = t * (0.6406161d0 + t * (0.0000839d0 + t * 0.0000050d0)) + b = t * (0.6406161d0 + t * (0.0003041d0 + t * 0.0000051d0)) + c = t * (0.5567530d0 - t * (0.0001185d0 + t * 0.0000116d0)) + + # Compute the cosines and sines once for efficiency. + ca = cos (DEGTORAD (a)) + sa = sin (DEGTORAD (a)) + cb = cos (DEGTORAD (b)) + sb = sin (DEGTORAD (b)) + cc = cos (DEGTORAD (c)) + sc = sin (DEGTORAD (c)) + + # Compute the rotation matrix from the sines and cosines. + p[1, 1] = ca * cb * cc - sa * sb + p[2, 1] = -sa * cb * cc - ca * sb + p[3, 1] = -cb * sc + p[1, 2] = ca * sb * cc + sa * cb + p[2, 2] = -sa * sb * cc + ca * cb + p[3, 2] = -sb * sc + p[1, 3] = ca * sc + p[2, 3] = -sa * sc + p[3, 3] = cc +end diff --git a/noao/astutil/asttools/asttimes.x b/noao/astutil/asttools/asttimes.x new file mode 100644 index 00000000..f1a3674a --- /dev/null +++ b/noao/astutil/asttools/asttimes.x @@ -0,0 +1,217 @@ +define J2000 2000.0D0 # J2000 +define JD2000 2451545.0D0 # J2000 Julian Date +define JYEAR 365.25D0 # Julian year + + +# AST_DATE_TO_EPOCH -- Convert Gregorian date and solar mean time to +# a Julian epoch. A Julian epoch has 365.25 days per year and 24 +# hours per day. + +procedure ast_date_to_epoch (year, month, day, ut, epoch) + +int year # Year +int month # Month (1-12) +int day # Day of month +double ut # Universal time for date (mean solar day) +double epoch # Julian epoch + +double jd, ast_date_to_julday() + +begin + jd = ast_date_to_julday (year, month, day, ut) + epoch = J2000 + (jd - JD2000) / JYEAR +end + + +# AST_EPOCH_TO_DATE -- Convert a Julian epoch to year, month, day, and time. + +procedure ast_epoch_to_date (epoch, year, month, day, ut) + +double epoch # Julian epoch +int year # Year +int month # Month (1-12) +int day # Day of month +double ut # Universal time for date + +double jd + +begin + jd = JD2000 + (epoch - J2000) * JYEAR + call ast_julday_to_date (jd, year, month, day, ut) +end + + +# AST_DAY_OF_YEAR -- The day number for the given year is returned. + +int procedure ast_day_of_year (year, month, day) + +int year # Year +int month # Month (1-12) +int day # Day of month + +int d +int bom[13] # Beginning of month +data bom/1,32,60,91,121,152,182,213,244,274,305,335,366/ + +begin + d = bom[month] + day - 1 + if (month > 2 && mod (year, 4) == 0 && + (mod (year, 100) != 0 || mod (year, 400) == 0)) + d = d + 1 + return (d) +end + + +# AST_DAY_OF_WEEK -- Return the day of the week for the given Julian day. +# The integer day of the week is 0=Sunday - 6=Saturday. The character string +# is the three character abbreviation for the day of the week. Note that +# the day of the week is for Greenwich if the standard UT is used. + +procedure ast_day_of_week (jd, d, name, sz_name) + +double jd # Julian date +int d # Day of the week (0=SUN) +char name[sz_name] # Name for day of the week +int sz_name # Size of name string + +begin + d = mod (int (jd - 0.5) + 2, 7) + switch (d) { + case 0: + call strcpy ("SUN", name, sz_name) + case 1: + call strcpy ("MON", name, sz_name) + case 2: + call strcpy ("TUE", name, sz_name) + case 3: + call strcpy ("WED", name, sz_name) + case 4: + call strcpy ("THU", name, sz_name) + case 5: + call strcpy ("FRI", name, sz_name) + case 6: + call strcpy ("SAT", name, sz_name) + } +end + + +# AST_JULDAY -- Convert epoch to Julian day. + +double procedure ast_julday (epoch) + +double epoch # Epoch + +double jd + +begin + jd = JD2000 + (epoch - J2000) * JYEAR + return (jd) +end + + +# AST_DATE_TO_JULDAY -- Convert date to Julian day. +# This assumes dates after year 99. + +double procedure ast_date_to_julday (year, month, day, t) + +int year # Year +int month # Month (1-12) +int day # Day of month +double t # Time for date (mean solar day) + +double jd +int y, m, d + +begin + if (year < 100) + y = 1900 + year + else + y = year + + if (month > 2) + m = month + 1 + else { + m = month + 13 + y = y - 1 + } + + jd = int (JYEAR * y) + int (30.6001 * m) + day + 1720995 + if (day + 31 * (m + 12 * y) >= 588829) { + d = int (y / 100) + m = int (y / 400) + jd = jd + 2 - d + m + } + jd = jd - 0.5 + int (t * 360000. + 0.5) / 360000. / 24. + return (jd) +end + + +# AST_JULDAY_TO_DATE -- Convert Julian date to calendar date. +# This is taken from Numerical Receipes by Press, Flannery, Teukolsy, and +# Vetterling. + +procedure ast_julday_to_date (j, year, month, day, t) + +double j # Julian day +int year # Year +int month # Month (1-12) +int day # Day of month +double t # Time for date (mean solar day) + +int ja, jb, jc, jd, je + +begin + ja = nint (j) + t = 24. * (j - ja + 0.5) + + if (ja >= 2299161) { + jb = int (((ja - 1867216) - 0.25) / 36524.25) + ja = ja + 1 + jb - int (jb / 4) + } + + jb = ja + 1524 + jc = int (6680. + ((jb - 2439870) - 122.1) / JYEAR) + jd = 365 * jc + int (jc / 4) + je = int ((jb - jd) / 30.6001) + day = jb - jd - int (30.6001 * je) + month = je - 1 + if (month > 12) + month = month - 12 + year = jc - 4715 + if (month > 2) + year = year - 1 + if (year < 0) + year = year - 1 +end + + +# AST_MST -- Mean sidereal time of the epoch at the given longitude. +# This procedure may be used to optain Greenwich Mean Sidereal Time (GMST) +# by setting the longitude to 0. + +double procedure ast_mst (epoch, longitude) + +double epoch # Epoch +double longitude # Longitude in degrees + +double jd, ut, t, st +double ast_julday() + +begin + # Determine JD and UT, and T (JD in centuries from J2000.0). + jd = ast_julday (epoch) + ut = (jd - int (jd) - 0.5) * 24. + t = (jd - 2451545.d0) / 36525.d0 + + # The GMST at 0 UT in seconds is a power series in T. + st = 24110.54841d0 + + t * (8640184.812866d0 + t * (0.093104d0 - t * 6.2d-6)) + + # Correct for longitude and convert to standard hours. + st = mod (st / 3600. + ut - longitude / 15., 24.0D0) + + if (st < 0) + st = st + 24 + + return (st) +end diff --git a/noao/astutil/asttools/astvbary.x b/noao/astutil/asttools/astvbary.x new file mode 100644 index 00000000..826ed38d --- /dev/null +++ b/noao/astutil/asttools/astvbary.x @@ -0,0 +1,76 @@ +include <math.h> + +# AST_VBARY -- Radial velocity component of center of the Earth relative to +# to the barycenter of the Earth-Moon system. + +procedure ast_vbary (ra, dec, epoch, v) + +double ra # Right ascension of observation (hours) +double dec # Declination of observation (degrees) +double epoch # Julian epoch of observation +double v # Component of orbital velocity (km/s) + +double t, oblq, omega, llong, lperi, inclin, em, anom, vmoon +double r, d, l, b, lm, bm, ast_julday() + +begin + # T is the number of Julian centuries since J1900. + t = (ast_julday (epoch) - 2415020) / 36525. + + # OBLQ is the mean obliquity of the ecliptic + # OMEGA is the longitude of the mean ascending node + # LLONG is the mean lunar longitude (should be 13.1763965268) + # LPERI is the mean lunar longitude of perigee + # INCLIN is the inclination of the lunar orbit to the ecliptic + # EM is the eccentricity of the lunar orbit (dimensionless) + # All quantities except the eccentricity are in degrees. + + oblq = 23.452294d0 - + t * (0.0130125d0 + t * (0.00000164d0 - t * 0.000000503d0)) + omega = 259.183275d0 - + t * (1934.142008d0 + t * (0.002078d0 + t * 0.000002d0)) + llong = 270.434164d0 + + t * (481267.88315d0 + t * (-0.001133d0 + t * 0.0000019d0)) - omega + lperi = 334.329556d0 + + t * (4069.034029d0 - t * (0.010325d0 + t * 0.000012d0)) - omega + em = 0.054900489d0 + inclin = 5.1453964d0 + + # Determine true longitude. Compute mean anomaly, convert to true + # anomaly (approximate formula), and convert back to longitude. + # The mean anomaly is only approximate because LPERI should + # be the true rather than the mean longitude of lunar perigee. + + lperi = DEGTORAD (lperi) + llong = DEGTORAD (llong) + anom = llong - lperi + anom = anom + (2. * em - 0.25 * em**3) * sin (anom) + 1.25 * em**2 * + sin (2. * anom) + 13./12. * em**3 * sin (3. * anom) + llong = anom + lperi + + # L and B are the ecliptic longitude and latitude of the observation. + # LM and BM are the lunar longitude and latitude of the observation + # in the lunar orbital plane relative to the ascending node. + + r = DEGTORAD (ra * 15) + d = DEGTORAD (dec) + omega = DEGTORAD (omega) + oblq = DEGTORAD (oblq) + inclin = DEGTORAD (inclin) + + call ast_coord (double (0.), double (0.), double (-HALFPI), + HALFPI - oblq, r, d, l, b) + call ast_coord (omega, double (0.), omega-HALFPI, HALFPI-inclin, + l, b, lm, bm) + + # VMOON is the component of the lunar velocity perpendicular to the + # radius vector. V is the projection onto the line of sight to the + # observation of the velocity of the Earth's center with respect to + # the Earth-Moon barycenter. The 81.53 is the ratio of the Earth's + # mass to the Moon's mass. + + vmoon = (TWOPI / 27.321661d0) * + 384403.12040d0 / sqrt (1. - em**2) / 86400. + v = vmoon * cos (bm) * (sin (llong - lm) - em * sin (lperi - lm)) + v = v / 81.53 +end diff --git a/noao/astutil/asttools/astvorbit.x b/noao/astutil/asttools/astvorbit.x new file mode 100644 index 00000000..61c5f0c5 --- /dev/null +++ b/noao/astutil/asttools/astvorbit.x @@ -0,0 +1,70 @@ +include <math.h> + +# AST_VORBIT -- Radial velocity component of the Earth-Moon barycenter +# relative to the Sun. + +procedure ast_vorbit (ra, dec, epoch, v) + +double ra # Right ascension of observation (hours) +double dec # Declination of observation (degrees) +double epoch # Julian epoch of observation +double v # Component of orbital velocity (km/s) + +double t, manom, lperi, oblq, eccen, tanom, slong, r, d, l, b, vorb +double ast_julday() + +begin + # T is the number of Julian centuries since J1900. + t = (ast_julday (epoch) - 2415020d0) / 36525. + + # MANOM is the mean anomaly of the Earth's orbit (degrees) + # LPERI is the mean longitude of perihelion (degrees) + # OBLQ is the mean obliquity of the ecliptic (degrees) + # ECCEN is the eccentricity of the Earth's orbit (dimensionless) + + manom = 358.47583d0 + + t * (35999.04975d0 - t * (0.000150d0 + t * 0.000003d0)) + lperi = 101.22083d0 + + t * (1.7191733d0 + t * (0.000453d0 + t * 0.000003d0)) + oblq = 23.452294d0 - + t * (0.0130125d0 + t * (0.00000164d0 - t * 0.000000503d0)) + eccen = 0.01675104d0 - t * (0.00004180d0 + t * 0.000000126d0) + + # Convert to principle angles + manom = mod (manom, 360.0D0) + lperi = mod (lperi, 360.0D0) + + # Convert to radians + r = DEGTORAD (ra * 15) + d = DEGTORAD (dec) + manom = DEGTORAD (manom) + lperi = DEGTORAD (lperi) + oblq = DEGTORAD (oblq) + + # TANOM is the true anomaly (approximate formula) (radians) + tanom = manom + (2 * eccen - 0.25 * eccen**3) * sin (manom) + + 1.25 * eccen**2 * sin (2 * manom) + + 13./12. * eccen**3 * sin (3 * manom) + + # SLONG is the true longitude of the Sun seen from the Earth (radians) + slong = lperi + tanom + PI + + # L and B are the longitude and latitude of the star in the orbital + # plane of the Earth (radians) + + call ast_coord (double (0.), double (0.), double (-HALFPI), + HALFPI - oblq, r, d, l, b) + + # VORB is the component of the Earth's orbital velocity perpendicular + # to the radius vector (km/s) where the Earth's semi-major axis is + # 149598500 km and the year is 365.2564 days. + + vorb = ((TWOPI / 365.2564d0) * + 149598500.d0 / sqrt (1. - eccen**2)) / 86400.d0 + + # V is the projection onto the line of sight to the observation of + # the velocity of the Earth-Moon barycenter with respect to the + # Sun (km/s). + + v = vorb * cos (b) * (sin (slong - l) - eccen * sin (lperi - l)) +end diff --git a/noao/astutil/asttools/astvr.x b/noao/astutil/asttools/astvr.x new file mode 100644 index 00000000..f2139b59 --- /dev/null +++ b/noao/astutil/asttools/astvr.x @@ -0,0 +1,29 @@ +include <math.h> + +# AST_VR -- Project a velocity vector in radial velocity along line of sight. + +procedure ast_vr (ra1, dec1, v1, ra2, dec2, v2) + +double ra1 # Right ascension of velocity vector (hours) +double dec1 # Declination of velocity vector (degrees) +double v1 # Magnitude of velocity vector +double ra2 # Right ascension of observation (hours) +double dec2 # Declination of observation (degrees) +double v2 # Radial velocity along direction of observation + +double vx, vy, vz, cc, cs, s + +begin + # Cartisian velocity components of the velocity vector. + vx = v1 * cos (DEGTORAD (15. * ra1)) * cos (DEGTORAD (dec1)) + vy = v1 * sin (DEGTORAD (15. * ra1)) * cos (DEGTORAD (dec1)) + vz = v1 * sin (DEGTORAD (dec1)) + + # Direction cosines along the direction of observation. + cc = cos (DEGTORAD (dec2)) * cos (DEGTORAD (15. * ra2)) + cs = cos (DEGTORAD (dec2)) * sin (DEGTORAD (15. * ra2)) + s = sin (DEGTORAD (dec2)) + + # Project velocity vector along the direction of observation. + v2 = (vx * cc + vy * cs + vz * s) +end diff --git a/noao/astutil/asttools/astvrotate.x b/noao/astutil/asttools/astvrotate.x new file mode 100644 index 00000000..df5b9b1c --- /dev/null +++ b/noao/astutil/asttools/astvrotate.x @@ -0,0 +1,43 @@ +include <math.h> + +# AST_VROTATE -- Radial velocity component of the observer relative to +# the center of the Earth due to the Earth's rotation. + +procedure ast_vrotate (ra, dec, epoch, latitude, longitude, altitude, v) + +double ra # Right Ascension of observation (hours) +double dec # Declination of observation (degrees) +double epoch # Epoch of observation (Julian epoch) +double latitude # Latitude (degrees) +double longitude # Latitude (degrees) +double altitude # Altitude (meters) +double v # Velocity (km / s) + +double lat, dlat, r, vc, lmst, ast_mst() + +begin + # LAT is the latitude in radians. + lat = DEGTORAD (latitude) + + # Reduction of geodetic latitude to geocentric latitude (radians). + # Dlat is in arcseconds. + + dlat = -(11. * 60. + 32.743000d0) * sin (2 * lat) + + 1.163300d0 * sin (4 * lat) -0.002600d0 * sin (6 * lat) + lat = lat + DEGTORAD (dlat / 3600.) + + # R is the radius vector from the Earth's center to the observer + # (meters). Vc is the corresponding circular velocity + # (meters/sidereal day converted to km / sec). + # (sidereal day = 23.934469591229 hours (1986)) + + r = 6378160.0d0 * (0.998327073d0 + 0.00167643800d0 * cos (2 * lat) - + 0.00000351d0 * cos (4 * lat) + 0.000000008d0 * cos (6 * lat)) + + altitude + vc = TWOPI * (r / 1000.) / (23.934469591229d0 * 3600.) + + # Project the velocity onto the line of sight to the star. + lmst = ast_mst (epoch, longitude) + v = vc * cos (lat) * cos (DEGTORAD (dec)) * + sin (DEGTORAD ((ra - lmst) * 15.)) +end diff --git a/noao/astutil/asttools/astvsun.x b/noao/astutil/asttools/astvsun.x new file mode 100644 index 00000000..c466ab89 --- /dev/null +++ b/noao/astutil/asttools/astvsun.x @@ -0,0 +1,38 @@ +include <math.h> + +# The sun's velocity with respect to the local standard of rest is: + +define RAVSUN 18. # RA of sun's velocity +define DECVSUN 30. # DEC of sun's velocity +define VSUN 20. # VLSR of sun +define EPOCH 1900. # Epoch of sun's velocity + +# AST_VSUN -- Projection of the sun's velocity along the given direction. + +procedure ast_vsun (ra, dec, epoch, v) + +double ra # Reference right ascension (hours) +double dec # Reference declination (degrees) +double epoch # Epoch (years) +double v # VLSR of sun along reference direction + +double ravsun, decvsun, vx, vy, vz, cc, cs, s + +begin + # Precess VLSR direction to current date. + call ast_precess (double (RAVSUN), double (DECVSUN), double (EPOCH), + ravsun, decvsun, epoch) + + # Cartisian velocity components of the sun's velocity. + vx = VSUN * cos (DEGTORAD (15. * ravsun)) * cos (DEGTORAD (decvsun)) + vy = VSUN * sin (DEGTORAD (15. * ravsun)) * cos (DEGTORAD (decvsun)) + vz = VSUN * sin (DEGTORAD (decvsun)) + + # Direction cosines along the reference direction. + cc = cos (DEGTORAD (dec)) * cos (DEGTORAD (15. * ra)) + cs = cos (DEGTORAD (dec)) * sin (DEGTORAD (15. * ra)) + s = sin (DEGTORAD (dec)) + + # Project sun's motion along the reference direction. + v = -(vx * cc + vy * cs + vz * s) +end diff --git a/noao/astutil/asttools/mkpkg b/noao/astutil/asttools/mkpkg new file mode 100644 index 00000000..4c59582c --- /dev/null +++ b/noao/astutil/asttools/mkpkg @@ -0,0 +1,23 @@ +# NOAO astronomical toolslibasttools.a + +update: + $checkout libasttools.a noaolib$ + $update libasttools.a + $checkin libasttools.a noaolib$ + ; + +libasttools.a: + astarcsep.x <math.h> + astcoord.x + astgalactic.x <math.h> <mach.h> + astgaltoeq.x <math.h> + asthjd.x <math.h> + astlvac.x + astprecess.x <math.h> + asttimes.x + astvbary.x <math.h> + astvorbit.x <math.h> + astvr.x <math.h> + astvrotate.x <math.h> + astvsun.x <math.h> + ; diff --git a/noao/astutil/asttools/precessgj.x b/noao/astutil/asttools/precessgj.x new file mode 100644 index 00000000..4b836c35 --- /dev/null +++ b/noao/astutil/asttools/precessgj.x @@ -0,0 +1,48 @@ +include <math.h> + +# PRECESSGJ -- Precess astronomical coordinates from epoch1 to epoch2. +# Original IRAF/FORTRAN by G. Jacoby (NOAO). +# Modified by by F. Valdes for IRAF/SPP (NOAO), March 1986 + +procedure precessgj (ra1, dec1, epoch1, ra2, dec2, epoch2) + +double ra1, dec1, epoch1 # Input coordinates +double ra2, dec2, epoch2 # Output coordinates + +double t, tau, theta, zeta, z, ra, dec, a, ap, test +bool fp_equald() + +begin + if (fp_equald (epoch1, epoch2)) { + ra2 = ra1 + dec2 = dec1 + return + } + + t = (epoch2 - epoch1) / 100. + tau = (epoch1 - 1850.) / 100. + + theta = t * ((2005.11d0 - 0.85 * tau) - t * (0.43 + t * 0.041)) / 3600. + zeta = t * ((2303.55d0 + 1.40 * tau) + t * (0.30 + t * 0.017)) / 3600. + z = zeta + t * t * 0.79 / 3600. + + ra = DEGTORAD (ra1 * 15.0) + dec = DEGTORAD (dec1) + theta = DEGTORAD (theta) + zeta = DEGTORAD (zeta) + z = DEGTORAD (z) + + a = ra + zeta + dec2 = asin (cos(dec) * cos(a) * sin(theta) + sin(dec) * cos(theta)) + ap = asin (cos(dec) * sin(a) / cos(dec2)) + test = (cos(dec)*cos(a)*cos(theta) - sin(dec)*sin(theta)) / cos(dec2) + + if (test < 0.) + ap = PI - ap + ra2 = ap + z + if (ra2 < 0.) + ra2 = ra2 + TWOPI + + ra2 = RADTODEG (ra2) / 15.0 + dec2 = RADTODEG (dec2) +end diff --git a/noao/astutil/asttools/precessmgb.x b/noao/astutil/asttools/precessmgb.x new file mode 100644 index 00000000..6a61f9f5 --- /dev/null +++ b/noao/astutil/asttools/precessmgb.x @@ -0,0 +1,154 @@ +include <math.h> + +# PRECESSMGB -- Calculate the apparent change in right ascension and +# declination between two epochs. Corrections are made for precession, +# aberration, and some terms of nutation. +# +# Based on the work of R. N. Manchester, M. A. Gordon, J. A. Ball (NRAO) +# January 1970 (DOPSET, IBM360) +# Modified by E. Anderson (NOAO) April 1985 (DOPSET, VMS/VAX) +# Converted to IRAF by F. Valdes (NOAO) March 1986. + +procedure precessmgb (ra1, dec1, epoch1, ra2, dec2, epoch2) + +double ra1, dec1, epoch1 # First epoch coordinates +double ra2, dec2, epoch2 # Second epoch coordinates + +double ra, dec, epoch, epoch3, dc +bool fp_equald() + +begin + # Return if the epochs are the same. + + if (fp_equald (epoch1, epoch2)) { + ra2 = ra1 + dec2 = dec1 + return + } + + ra = ra1 + dec = dec1 + epoch = epoch1 + + # Check if epoch1 is the beginning of a year. If not make correction + # to the beginning of the year. + + if (epoch - int (epoch) > 1E-6) { + epoch3 = epoch + epoch = int (epoch) + call mgb_precess (ra, dec, epoch, ra2, dec2, epoch3, dc) + ra = ra - (ra2 - ra) + dec = dec - (dec2 - dec) + } + + # Precess to epoch2. + + call mgb_precess (ra, dec, epoch, ra2, dec2, epoch2, dc) +end + + +# MGB_PRECESS -- Calculate the apparent change in right ascension and +# declination between two epochs. The first epoch is assumed to be the +# beginning of a year (eg 1950.0). Also calculate the equation of the +# equinoxes (in minutes of time) which may be added to the mean siderial +# time to give the apparent siderial time (AENA-469). Corrections are +# made for precession, aberration, and some terms of nutation. +# AENA - The American Ephemeris and Nautical Almanac (the blue book) +# ESE - The explanatory suplement to AENA (the green book) + +procedure mgb_precess (ra1, dec1, epoch1, ra2, dec2, epoch2, dc) + +double ra1, dec1, epoch1 # First epoch coordinates +double ra2, dec2, epoch2 # Second epoch coordinates +double dc # Siderial time correction + +double ra, dec, delr, deld +double t1, t2, nday2 +double theta, zeta, z, am, an, al +double csr, snr, csd, snd, tnd, csl, snl +double omega, dlong, doblq +bool fp_equald() + +begin + # Check if epochs are the same. + + if (fp_equald (epoch1, epoch2)) { + ra2 = ra1 + dec2 = dec1 + return + } + + # Convert input coordinates to radians. + + ra = DEGTORAD (ra1 * 15.) + dec = DEGTORAD (dec1) + + # Compute sines, cosines, and tangents. + + csr = cos (ra) + snr = sin (ra) + csd = cos (dec) + snd = sin (dec) + tnd = snd / csd + + # T1 is the time from 1900 to epoch1 (centuries), + # t2 is the time from epoch1 to epoch2 (centuries), and + # nday2 is the number of days since the beginning of the year + # for epoch2. The number of ephemeris days in a tropical + # year is 365.2421988. + + t1 = (epoch1 - 1900.) / 100. + t2 = (epoch2 - epoch1) / 100. + nday2 = (epoch2 - int (epoch2)) * 365.2421988 + + # Theta, zeta, and z are precessional angles from ESE-29 (arcseconds). + + theta = t2 * ((2004.682 - 0.853 * t1) - t2 * (0.426 + t2 * 0.042)) + zeta = t2 * ((2304.250 + 1.396 * t1) + t2 * (0.302 + t2 * 0.018)) + z = zeta + 0.791 * t2 ** 2 + + # am and an are the M and N precessional numbers (see AENA-50, 474) + # (radians) and alam is an approximate mean longitude for the sun + # (AENA-50) (radians) + + am = DEGTORAD ((zeta + z) / 3600.) + an = DEGTORAD (theta / 3600.) + al = DEGTORAD (0.985647 * nday2 + 278.5) + + snl = sin (al) + csl = cos (al) + + # Delr and deld are the annual aberation term in ra and dec (radians) + # (ESE-47,48) (0.91745051 cos (obliquity of ecliptic)) + # (0.39784993 sin (obliquity of ecliptic)) + # (-9.92413605E-5 K 20.47 ARCSECONDS constant of aberration) + # (ESE) plus precession terms (see AENA-50 and ESE-39). + + delr = -9.92413605e-5 * (snl * snr + 0.91745051 * csl * csr) / csd + + am + an * snr * tnd + deld = -9.92413605e-5 * (snl * csr * snd - 0.91745051 * csl * snr * + snd + 0.39784993 * csl * csd) + an * csr + + # The following calculates the nutation (approximately) (ESE-41,45) + # Omega is the angle of the first term of nutation (ESE-44) + # (approximate formula) (radians). + # Dlong is the nutation in longitude (delta-psi) (radians) + # Doblq is the nutation in obliquity (delta-epsilon) (radians) + + omega = DEGTORAD (259.183275 - 1934.142 * (t1 + t2)) + dlong = -8.3597e-5 * sin (omega) + doblq = 4.4678e-5 * cos (omega) + + # Add nutation into delr and deld (ESE-43). + + delr = delr + dlong * (0.91745051 + 0.39784993 * snr * tnd) - + csr * tnd * doblq + deld = deld + 0.39784993 * csr * dlong + snr * doblq + + # Compute new position and the equation of the equinoxes + # (dc in minutes of tim, ESE-43) + + ra2 = ra1 + RADTODEG (delr / 15.) + dec2 = dec1 + RADTODEG (deld) + dc = dlong * 210.264169 +end diff --git a/noao/astutil/asttools/refrac.x b/noao/astutil/asttools/refrac.x new file mode 100644 index 00000000..2834ff5f --- /dev/null +++ b/noao/astutil/asttools/refrac.x @@ -0,0 +1,51 @@ +include <math.h> + + +# REFRAC -- Compute observed place from apparent place. +# +# This is a placeholder routine. I am not completely sure this is +# done correctly though the SLALIB routines are accurate. +# This uses the quick (less precise) SLALIB routines for the +# calculation. + +procedure refrac (ara, adec, aha, lat, w, t, p, h, ora, odec) + +double ara, adec # Apparent ra (hr) and dec (deg) +double aha # Apparent hour angle (hr) +double lat # Latitude (deg) +double w # Effective wavelength (A) +double t # Temperature (C) +double p # Pressure (mbar) +double h # Humidity (frac 0-1) +double ora, odec # Observed ra (hr) and dec (deg) + +double oha, refa, refb, az, el, vu[3], vr[3] + +begin + # Determine refraction coefficients. + call slRFCQ (t+273.15D0, p, h, w/10000D0, refa, refb) + + # Convert (aha,adec) to (az,el). + call slDE2H (DEGTORAD(aha*15D0), DEGTORAD(adec), DEGTORAD(lat), az, el) + + # Convert (az,el) to (x,y,z). + call slDS2C (az, el, vu) + + # Apply refraction correction. + call slREFV (vu, refa, refb, vr) + + # Convert (x,y,z) to (az,el) + call slDC2S (vr, az, el) + + # Convert (az,el) to (ha,dec). + call slDH2E (az, el, DEGTORAD(lat), oha, odec) + + # Convert (oha,odec) to (ora,odec). + oha = RADTODEG(oha) / 15D0 + odec = RADTODEG(odec) + ora = ara + aha - oha + if (ara - ora < -12) + ora = ora + 24 + else if (ara - ora > 12) + ora = ora - 24 +end diff --git a/noao/astutil/astutil.cl b/noao/astutil/astutil.cl new file mode 100644 index 00000000..9f018e3e --- /dev/null +++ b/noao/astutil/astutil.cl @@ -0,0 +1,26 @@ +#{ Package script task for the ASTUTIL package. + +package astutil + +# Compiled tasks. +task airmass, + astcalc, + asthedit, + precess, + galactic, + gratings, + pdm, + asttimes, + rvcorrect, + setairmass, + setjd = "astutil$x_astutil.e" + +task ccdtime = "obsutil$src/ccdtime/x_obsutil.e" + +# Script tasks. +task astradius = "astutil$astradius.cl" + +# PSET tasks. +task keywpars = "astutil$keywpars.par" + +clbye diff --git a/noao/astutil/astutil.hd b/noao/astutil/astutil.hd new file mode 100644 index 00000000..fd2aa24e --- /dev/null +++ b/noao/astutil/astutil.hd @@ -0,0 +1,23 @@ +# Help directory for the ASTUTIL package. + +$defdir = "noao$astutil/" +$doc = "noao$astutil/doc/" +$pdm = "noao$astutil/pdm/" + +airmass hlp=doc$airmass.hlp, src=airmass.x +asttimes hlp=doc$asttimes.hlp, src=t_asttimes.x +ccdtime hlp=doc$ccdtime.hlp, src=ccdtime.x +galactic hlp=doc$galactic.hlp, src=galactic.x +gratings hlp=doc$gratings.hlp, src=t_gratings.x +keywpars hlp=doc$keywpars.hlp, src=keywpars.par +astcalc hlp=doc$astcalc.hlp, src=t_astcalc.x +asthedit hlp=doc$asthedit.hlp, src=t_asthedit.x +observatory hlp=doc$obs.hlp, src=t_obs.x +pdm hlp=doc$pdm.hlp, src=pdm$t_pdm.x +precess hlp=doc$precess.hlp, src=precess.x +rvcorrect hlp=doc$rvcorrect.hlp, src=t_rvcorrect.x +setairmass hlp=doc$setairmass.hlp, src=t_setairmass.x +setjd hlp=doc$setjd.hlp, src=t_setjd.x +astradius hlp=doc$astradius.hlp, src=astradius.cl + +revisions sys=Revisions diff --git a/noao/astutil/astutil.men b/noao/astutil/astutil.men new file mode 100644 index 00000000..73b7979a --- /dev/null +++ b/noao/astutil/astutil.men @@ -0,0 +1,14 @@ + airmass - Compute the airmass at a given elevation above the horizon + astcalc - Astronomical calculator + asthedit - Astronomical header editor + astradius - Find images within a circle on the sky + asttimes - Compute UT, Julian day, epoch, and sidereal time + ccdtime - Compute time, magnitude, and signal-to-noise for CCDs + galactic - Convert ra, dec to galactic coordinates + gratings - Compute and print grating parameters + keywpars - Translate the image header keywords used in ASTUTIL package + pdm - Find periods in light curves by Phase Dispersion Minimization + precess - Precess a list of astronomical coordinates + rvcorrect - Compute radial velocity corrections + setairmass - Compute effective airmass and middle UT for an exposure + setjd - Compute and set Julian dates in images diff --git a/noao/astutil/astutil.par b/noao/astutil/astutil.par new file mode 100644 index 00000000..3fbee471 --- /dev/null +++ b/noao/astutil/astutil.par @@ -0,0 +1,4 @@ +# Package parameter file for the ASTUTIL package. + +observatory,s,h,"observatory",,,Observatory +version,s,h,"January 1992" diff --git a/noao/astutil/doc/airmass.hlp b/noao/astutil/doc/airmass.hlp new file mode 100644 index 00000000..b35c461e --- /dev/null +++ b/noao/astutil/doc/airmass.hlp @@ -0,0 +1,31 @@ +.help airmass Mar84 noao.astutil +.ih +NAME +airmass -- compute the airmass at a given elevation above horizon +.ih +USAGE +airmass elevation +.ih +PARAMETERS +.ls elevation +Elevation above horizon in either degrees or radians. +.le +.ls scale = 750.0 +Scale factor of the Earth's atmosphere. +.le +.ls radians = no +Input elevation in radians instead of degrees. +.le +.ls airmass +On output, contains the computed airmass. +.le +.ih +EXAMPLE +Compute the airmass at an elevation of 30 degrees above the horizon + +.nf + cl> airmass 30 + airmass 1.996 at an elevation of 30. degrees (0.5236 radians) + above horizon +.fi +.endhelp diff --git a/noao/astutil/doc/astcalc.hlp b/noao/astutil/doc/astcalc.hlp new file mode 100644 index 00000000..f138e8ea --- /dev/null +++ b/noao/astutil/doc/astcalc.hlp @@ -0,0 +1,654 @@ +.help astcalc Jan96 astutil +.ih +NAME +astcalc -- astronomical calculator +.ih +USAGE +astcalc +.ih +PARAMETERS +.ls commands +A file of commands using the simple syntax given in the DESCRIPTION. If no +file name is given then the commands are read interactively from the +standard input with a prompt given by the \fIprompt\fR parameter. The +command input ends with either EOF or "quit". If a list of images and/or a +table is specified the commands are repeated for each image or until the +end of the table is reached. Comments beginning with '#', blank lines, and +escaped newlines are allowed. +.le +.ls images = "" +Optional list of images. The command input is repeated for each image. +Image header keyword values may be read and used as variables and +keywords may be created, modified, or deleted provided the image has +read-write permissions. +.le +.ls table = "" +Optional text file containing columns of values. The table consists of +one or more lines of whitespace separated columns of values. Note that a +string with whitespace needs to be quoted. The lines may be scanned and +the values assigned to variables for use in expressions. If the command +input includes reading from the table then the commands will be repeated +until all the lines in the table have been read. +.le +.ls prompt = "astcalc> " +When no command file is specified the input commands are read from the +standard input (the terminal) and the value of the \fIprompt\fR string is +printed as a prompt. Note that if the input command file is specified as +"STDIN" there will be no prompt even though commands will also be read from +the standard input. +.le +.ls verbose = no +Print each variable assignment? This is useful for debugging command +files. +.le +.ih +DESCRIPTION +\fBAstcalc\fR evaluates statements using variables, constants, and +functions. Of special interest are many astronomical functions and the +ability to read and write image header keywords (\fIimages\fR), read +from a text file (\fItable\fR), and read and write CL parameters. + +This task may be used interactively or with input from a command file +(\fIcommands\fR). If no command file is specified a prompt (\fIprompt\fR) +is printed and commands are entered interactively. The input is terminated +with either the end-of-file character (EOF) or the command "quit". Input +command files simply contain the same input in a file and end with the end +of the file or "quit". The input commands, either those entered +interactively or from a file, are repeated for each image in the image list +and until the end of the input text table is reached, whichever comes +first. The image list and the table are optional and if neither is +specified the commands are executed just once. + +The command input consists of statements with each statement on a +line by itself. However long statements may be broken up with +escaped newlines using the back-slash as the escape character; +i.e. \<newline>. Comments beginning with '#', blank lines, +and whitespace are ignored. + +There are three types of statements: assignment, expressions, and +conditional. Each statement is on a line by itself though long statements +may be broken up with escaped newlines (\<newline>). Assignment statements +have a variable name, an equal sign, and an expression. Expression +statements consist of only the expression with the value of the expression +being ignored. Expression statements are generally used with certain +functions. Conditional statements are blocks of if-endif and if-else-endif +with assignment and expression statements between the if-else-endif +statements. These may not be nested. + +A variable is an arbitrary identifier which must begin with an alphabetic +character or '$' followed by an alphabetic character and may use alphabetic +characters, digits, or the characters '_', '$', or '.'. Other special +characters may be used but they must be set and referenced with the +special '@' operator described below. Lower and upper +case characters may be used and are considered different characters; i.e. +identifiers are case sensitive (as are function names). + +There are a few special predefined variables: "$D" contains the current +local date (in new FITS YYYY-MM-DD), "$T" contains the current local +time, "$GMD" contains the current Greenwich meridian date (in FITS +YYYY-MM-DD format), "$GMT" contains the current Greenwich meridian time, +and "$GMDT" contains the current date and time in FITS YYYY-MM-DDTHH:MM:SS +format. + +The expression syntax is described below. Expressions may use previously +define variable names, constants (both quoted strings and numeric values), +and functions. The functions are given below. Input from image headers, +and text files, and CL parameters, and output to image headers is performed +by I/O functions. + +In \fBastcalc\fR variables are maintained internally and input and output +are performed explicitly by functions. A related task is \fBasthedit\fR. +In that task variables are image header keywords and references to keywords +(assignments, use in expressions, and by themselves with no expression) +read and write to the image headers. Updating of the image headers, +however, can be suppressed. Also a line of a text table is read +automatically at the beginning of the command input so that column values +can be referenced directly. + +STATEMENTS + +The following gives a more formal description of the statement syntax +and the special words "if", "else", "endif", and "quit". + +.nf + <variable> = <expression> + <expression> + if (<expression>) + <statements> + endif + if (<expression>) + <statements> + else + <statements> + endif + quit +.fi + +The result of the expression in the "if" statement is normally a logical +value. However, a numeric value of 0 is false while any other value is +true and any string beginning with either "y" or "Y" is true with +any other value being false; i.e. string values of yes and no may be used. + +VARIABLES + +Variables may formally be defined as: + +.nf + [$]{a-zA-Z}[{a-zA-Z0-9._$}]* +.fi + +where [] indicate optional, {} indicates a class, - indicates an +ASCII range of characters, and * indicates zero or more occurrences. +Stated in words, a variable must begin with an alphabetic character (ignoring +an option leading $) and may be followed by any combinations of +alphabetic, digit, or '.', '_', and '$' characters. + +There are a few predefined variables which may be referenced in +expressions. + +.nf + $I The name of the current image (if used) + $D The current date in the YYYY-MM-DD format + $T The current (local) time as a sexagesimal string +.fi + +The date and time are set once at the beginning of execution. + +Though not recommended it is possible to use any set of characters +for a variable provided the variable is referenced as @"<name>". +For example one could use @"date-obs" to include the character '-'. + +EXPRESSIONS + +Expressions consist of operands and operators. The operands may be any +PREVIOUSLY DEFINED variables, quoted string constants, numeric constants, +and functions. Values given as sexagesimal strings are automatically +converted to decimal numbers. The operators are arithmetic, logical, and +string. The expression syntax is equivalent to that used in the CL and SPP +languages. + +Additional information may be found in the help for \fBhedit\fR except that +all unquoted nonnumeric strings are considered to be variables and so the +'(', ')' operators are not used. The "field" references are not needed so +the references "." and "$" are not used and are not legal variable +names in this task. + +operators: + +The following operators are recognized in expressions. With the exception +of the operators "?" and "?=", the operator set is equivalent to that +available in the CL and SPP languages. + + +.nf + + - * / arithmetic operators + ** exponentiation + // string concatenation + ! - boolean not, unary negation + < <= > >= order comparison (works for strings) + == != && || equals, not equals, and, or + ?= string equals pattern + ? : conditional expression + @ reference a variable +.fi + + +The operators "==", "&&", and "||" may be abbreviated as "=", "&", and "|" +if desired. The ?= operator performs pattern matching upon strings. + +A point to be aware of is that in the ?: conditional expression both +possible result values are evaluated though the result of the expression +is only one of them. This means that one should not use this to +call I/O functions that one wants to be executed only if a certain +condition holds. + +intrinsic functions: + +A number of standard intrinsic functions are recognized within expressions. +The set of functions currently supported is shown below. + + +.nf + abs atan2 deg log min real sqrt + acos bool double log10 mod short str + asin cos exp long nint sin tan + atan cosh int max rad sinh tanh +.fi + + +The trigonometric functions operate in units of radians. +The \fImin\fR and \fImax\fR functions may have any number of arguments up +to a maximum of sixteen or so (configurable). The arguments need not all +be of the same datatype. + +A function call may take either of the following forms: + +.nf + <identifier> '(' arglist ')' +or + <string_expr> '(' arglist ')' +.fi + +The first form is the conventional form found in all programming languages. +The second permits the generation of function names by string valued +expressions and might be useful on rare occasions. + +astronomical functions: + +In addition to the above intrinsic functions there are a number of +astronomical functions. More will be added in time. These are: + +.nf + sexstr - convert a number to a sexagesimal string (xx:mm:ss.ss) + epoch - compute an epoch given a date and time + julday - compute a Julian day given a date and time + mst - compute a mean sidereal time w/ date, time, and longitude + ra_precess - precess ra from one epoch to another +dec_precess - precess dec from one epoch to another + airmass - compute airmass w/ ra, dec, sidereal time, and latitude + eairmass - compute effective airmass given + ra, dec, sidereal time, exposure time, and latitude + obsdb - get parameters from the observatory database +.fi + +.ls sexstr (number), sexstr (number, digits) +Convert a number to a sexagesimal string in the format X:MM:SS.SS. There +is an optional second argument (the default is 0) which is the number of +decimal digits in the seconds field. +.le +.ls epoch (date[, ut]) +Compute an epoch given a date and time. The date is a string in the +format DD/MM/YY, YYYY-MM-DD, or YYYY-MM-DDTHH:MM:SS. +Typically this argument will be the standard FITS +keyword DATE-OBS. Because of possible confusion of the hyphen with +subtraction this keyword would be specified as @"date-obs". The time +argument is optional. If it is not given the time from the date +string will be used and if absent a time of 0h is used. +.le +.ls julday (date[, ut]) +Compute a Julian day given a date and time. The date and time are +specified as described previously. +.le +.ls mst (date[, ut], longitude) +Compute a mean sidereal time given a date, time, and longitude in degrees. The +date and (optional) time are specified as described previously. The longitude +may be given as a constant or using the observatory database function +as shown in the examples. The returned value is a sexagesimal +string with two decimals in the seconds. +.le +.ls precess (ra, dec, epoch1, epoch2) +Precess coordinates from one epoch to another. The ra is the +right ascension in hours, the dec in the declination in degrees, +and the epochs are in years. This function returns a formatted string with +the precessed right ascension, declination, and epoch. Numerical +values for the right ascension and declination are obtained with the +functions ra_precess and dec_precess. +.le +.ls ra_precess (ra, dec, epoch1, epoch2) +Precess a right ascension from one epoch to another. The ra is the +input right ascension in hours, the dec is the declination in degrees, +and the epochs are in years. Because a function can return only one +value there is a second function to return the precessed declination. +The returned value is a sexagesimal string with two decimals in the seconds. +.le +.ls dec_precess (ra1, dec1, epoch1, epoch2) +Precess a declination from one epoch to another. The ra is the +input right ascension in hours, the dec is the declination in degrees, +and the epochs are in years. Because a function can return only one +value there is a second function to return the precessed right ascension. +The returned value is a sexagesimal string with two decimals in the seconds. +.le +.ls arcsep (ra1, dec1, ra2, dec2) +Compute the separation between two spherical coordinates. The parameters +ra1 and ra2 are coordinates in hours (right ascension, longitude, etc.) +and the dec1 and dec2 parameters are coordinates in degrees (declination, +latitude, etc.). The computed value is returned in seconds of arc. +.le +.ls airmass (ra, dec, st, latitude) +Compute an airmass given right ascension in hours, declination in +degrees, sidereal time in hours, and latitude in degrees. The latitude +is often specified using the observatory database function as shown +in the examples. +.le +.ls eairmass (ra, dec, st, exptime, latitude) +Compute an "effective" airmass given right ascension in hours, declination +in degrees, beginning sidereal time in hours, exposure time in seconds, and +latitude in degrees. The The latitude is often specified using the +observatory database function as shown in the examples. The effective +airmass is based on a Simpson's rule weighting of the beginning, middle, +and ending airmass (with no provision for paused exposure). The weights +are: + +.nf + effective = beginning + 4 * middle + ending +.fi +.le +.ls obsdb (observatory, parameter) +Return a value from the observatory database. The observatory parameter is +a observatory identification string as defined in the database. Another +special value is "observatory" which then follows a name resolution +scheme. The observatory database mechanism is described by the help topic +\fBobservatory\fR. The parameter is a string given the quantity desired. +Typically this would be "longitude" or "latitude" but there are other +possible parameters. +.le + +input/output functions: + +There are special functions for formatting, printing, error aborts, +reading, writing, and deleting image header keywords, reading a text file, +and reading and writing CL parameters. + +.nf + print - print a set of arguments with default format + printf - print a set arguments with specified format + format - format a string + error - print an error message and abort + clget - get a value from a CL parameter + clput - put a value to a CL parameter + scan - scan a string and parse into variables + fscan - scan a line of a text file + imget - get the value of an image header keyword + imput - put (add or modify) the value of an image header keyword + imdel - delete an image header keyword +.fi + +.ls print ([argument, ...]) +Print the arguments with default formats based on the type of value ending +with a newline. There may be zero or more arguments. With zero arguments +only a newline will be printed. +.le +.ls printf (fmt [, argument, ...]) +Print a list of arguments using the formatting syntax described later. +Parameters to be formatted are given by the % fields and the values are +passed as further arguments in the order in which they are referenced. +There is no automatic newline so the format must include "\n" to +produce newlines. +.le +.ls error (message) +Print the "message", which can be any string variable such as might +be produced by "format", and abort the task. This is useful in +conjunction with the conditional operator to abort if a variable +takes an inappropriate value. +.le +.ls clget (parameter) +Get the value of a CL parameter. The argument must be a string. The +function value is the value of the parameter. +.le +.ls clput (parameter, value) +Put a value into a CL parameter. The parameter argument must be a +string and the value can be anything. The function returns a string +of the form "clput: parameter = value" where parameter and value are +the actual values. +.le +.ls scan (string, var, ...) +Parse a string of whitespace separated words into a list of +variables. The number of variables assigned is +the returned value of the function. +.le +.ls fscan (var, ...) +Scan a line of a text file into a list of variables. The arguments +are zero or more variable names to which to assign the values of +the whitespace separated fields. The number of variables assigned +is the returned value of the function. +.le +.ls imget (parameter) +Get the value of an image header keyword from the current image. The +argument must be a string. The function value is the value of the keyword. +.le +.ls imput (parameter, value) +Put a value into an image header keyword for the current image. The +parameter argument must be a string and the value can be anything. If the +keyword exists it will be modified and if it does not exist it will be +added. The function returns a string of the form "imput: parameter = +value" for new keywords or "imput: parameter = old_value -> value" for +modified keywords where parameter and value are the actual values. +.le +.ls imdel (parameter) +Delete an image header keyword. The parameter argument must be a string. +The returned values are the strings "imdel: parameter not found" +or "imdel: parameter = value (DELETED)" where parameter is the parameter +name and value is the old value. +.le + +.ih +FORMATS +A format specification has the form "%w.dCn", where w is the field +width, d is the number of decimal places or the number of digits of +precision, C is the format code, and n is radix character for +format code "r" only. The w and d fields are optional. The format +codes C are as follows: + +.nf +b boolean (YES or NO) +c single character (c or '\c' or '\0nnn') +d decimal integer +e exponential format (D specifies the precision) +f fixed format (D specifies the number of decimal places) +g general format (D specifies the precision) +h hms format (hh:mm:ss.ss, D = no. decimal places) +m minutes, seconds (or hours, minutes) (mm:ss.ss) +o octal integer +rN convert integer in any radix N +s string (D field specifies max chars to print) +t advance To column given as field W +u unsigned decimal integer +w output the number of spaces given by field W +x hexadecimal integer +z complex format (r,r) (D = precision) + + +Conventions for w (field width) specification: + + W = n right justify in field of N characters, blank fill + -n left justify in field of N characters, blank fill + 0n zero fill at left (only if right justified) +absent, 0 use as much space as needed (D field sets precision) + + +Escape sequences (e.g. "\n" for newline): + +\b backspace (not implemented) +\f formfeed +\n newline (crlf) +\r carriage return +\t tab +\" string delimiter character +\' character constant delimiter character +\\ backslash character +\nnn octal value of character + +Examples + +%s format a string using as much space as required +%-10s left justify a string in a field of 10 characters +%-10.10s left justify and truncate a string in a field of 10 characters +%10s right justify a string in a field of 10 characters +%10.10s right justify and truncate a string in a field of 10 characters + +%7.3f print a real number right justified in floating point format +%-7.3f same as above but left justified +%15.7e print a real number right justified in exponential format +%-15.7e same as above but left justified +%12.5g print a real number right justified in general format +%-12.5g same as above but left justified + +%h format as nn:nn:nn.n +%15h right justify nn:nn:nn.n in field of 15 characters +%-15h left justify nn:nn:nn.n in a field of 15 characters +%12.2h right justify nn:nn:nn.nn +%-12.2h left justify nn:nn:nn.nn + +%H / by 15 and format as nn:nn:nn.n +%15H / by 15 and right justify nn:nn:nn.n in field of 15 characters +%-15H / by 15 and left justify nn:nn:nn.n in field of 15 characters +%12.2H / by 15 and right justify nn:nn:nn.nn +%-12.2H / by 15 and left justify nn:nn:nn.nn + +\n insert a newline +.fi + +.ih +EXAMPLES +1. This example shows interactive use. + +.nf + cl> astcalc + astcalc> print ((1 + 2 + 3) / 2 - 2 * 2) + -1 + astcalc> observatory = "kpno" + astcalc> date = "05/04/87" + astcalc> ut = 9:27:27 + astcalc> ra = 13:29:24 + astcalc> dec = 47:15:34 + astcalc> epoch = epoch (date, ut) + astcalc> mst = mst (date, ut, obsdb (observatory, "longitude")) + astcalc> print (epoch) + 1987.257752395672 + astcalc> print (mst) + 14:53:39.81 + astcalc> print (julday (date, ut)) + 2446890.894062519 + astcalc> print (ra_precess (ra, dec, epoch, 1950)) + 13:27:49.84 + astcalc> print (dec_precess (ra, dec, epoch, 1950)) + 47:27:05.72 + astcalc> print (airmass (ra, dec, mst, obsdb (observatory, "latitude"))) + 1.07968417231416 + astcalc> printf ("Hello World: %s\n", precess (ra, dec, epoch, 1950)) + Hello World: 13:27:49.84 47:27:05.7 1950. + astcalc> quit +.fi + +2. This example shows the same commands as in the previous example +read from a file. + +.nf + cl> type example2.dat + # Define variables. + observatory = "kpno" + date = "05/04/87" + ut = 9:27:27 + ra = 13:29:24 + dec = 47:15:34 + epoch = epoch (date, ut) + mst = mst (date, ut, obsdb (observatory, "longitude")) + + # Print results of some expressions. + print ((1 + 2 + 3) / 2 - 2 * 2) # Calculation with constants + print (epoch) # Print variable + print (mst) # Print variable + print (julday (date, ut)) # Print result of function + print (ra_precess (ra, dec, epoch, 1950)) + print (dec_precess (ra, dec, epoch, 1950)) + print (airmass (ra, dec, mst, obsdb (observatory, "latitude"))) + + # Formatted print with arguments. Note newline. + printf ("Hello World: %s\n", precess (ra, dec, epoch, 1950)) + cl> astcalc commands=example2.dat + -1 + 1987.257752395672 + 14:53:39.81 + 2446890.894062519 + 13:27:49.84 + 47:27:05.72 + 1.07968417231416 + Hello World: 13:27:49.84 47:27:05.7 1950. +.fi + +3. This example precesses coordinates given in a text file. + +.nf + cl> type example3.dat,table.dat + ===> example3.dat <=== + # Read table of RA, DEC, and optional EPOCH and precess to 2000. + + epoch = 1900 # Default input epoch + epoch1 = 2000 # Precession epoch + + # Scan table and precess coordinates. + if (fscan ("ra", "dec", "epoch") >= 2) + ra1 = ra_precess (ra, dec, epoch, epoch1) + dec1 = dec_precess (ra, dec, epoch, epoch1) + printf ("%h %h %d -> %h %h %d\n", ra, dec, epoch, ra1, dec1, epoch1) + else + printf ("Missing coordinates\n") + endif + + ===> table.dat <=== + 12:22:31 31:10:15 1950 + 13:52:44 10:21:32 1996.1 + 14:52:44 11:21:32 + 10:20:30 + + cl> astcalc commands=example3.dat table=table.dat + 12:22:31.0 31:10:15.0 1950 -> 12:25:00.56 30:53:38.13 2000 + 13:52:44.0 10:21:32.0 1996 -> 13:52:55.54 10:20:23.11 2000 + 14:52:44.0 11:21:32.0 1900 -> 14:57:33.16 10:57:24.74 2000 + Missing coordinates +.fi + +4. This complex example illustrates reading from CL parameters and +image header keywords. It precesses coordinates to a standard epoch +and computes the arc separation between the coordinates and a center +coordinate. If the separation is less than a specified amount it +prints the image name and additional information. This is the +data file for the \fBastradius\fR script task. + +.nf + cl> type astutil$astradius.dat + # Print images which are within a given radius in the sky. + + # Get parameters. + racenter = clget ("astradius.racenter") + deccenter = clget ("astradius.deccenter") + epcenter = clget ("astradius.epcenter") + radius = clget ("astradius.radius") + ra = imget(clget("keywpars.ra")) + dec = imget(clget("keywpars.dec")) + + epoch = imget(clget("keywpars.epoch")) + if (str(epoch) == "" || real(epoch) == 0.) + date = imget(clget("keywpars.date_obs")) + ut = imget(clget("keywpars.ut")) + epoch = epoch (date, ut) + endif + + # Precess image coordinates to center epoch and compute separation. + radec = precess (ra, dec, epoch, epcenter) + ra1 = ra_precess (ra, dec, epoch, epcenter) + dec1 = dec_precess (ra, dec, epoch, epcenter) + sep = arcsep (racenter, deccenter, ra1, dec1) + + # Print result if within radius. + if (sep < real (radius)) + printf ("%-15s %s %4d %s\n", $I, radec, sep, imget ("title")) + endif + cl> astcalc commands=astutil$astradius.dat images=dev$pix + RA center (hours) (13:31): + DEC center (degrees) (47:00): + Epoch of center (2000.): + Radius in arc seconds (3600.): + dev$pix 13:29:56.16 47:11:37.9 2000. 955 m51 B 600s +.fi + +.ih +REVISIONS +.ls ASTCALC V2.15 +The $D variable was changed from the old MM/DD/YY format to the post-Y2K +YYYY-MM-DD format. +.le +.ls ASTCALC V2.11.2 +Y2K update: The epoch, julday, and mst functions now take either the old +or new FITS style date strings. The time argument is optional and if +it is not specified the time from the date string is used and if neither +time is present a value of 0h is used. New internal variables $GMD, +$GMT, and $GMDT for the current time Greenwich time are defined. +.le +.ls ASTCALC V2.11 +This task is new in this release. +.le +.ih +SEE ALSO +astradius, asthedit, setairmass, setjd, asttimes, precess, observatory, hedit +.endhelp diff --git a/noao/astutil/doc/asthedit.hlp b/noao/astutil/doc/asthedit.hlp new file mode 100644 index 00000000..2806cf58 --- /dev/null +++ b/noao/astutil/doc/asthedit.hlp @@ -0,0 +1,789 @@ +.help asthedit Jan96 astutil +.ih +NAME +asthedit -- astronomical header editor +.ih +USAGE +asthedit images commands +.ih +PARAMETERS +.ls images +List of images to be used. The image header keywords are used in this task +as variables which are read, modified, created, or deleted. If the images +do not have write permission or the \fIupdate\fR parameter is "no" then the +image headers will not be modified. If no images are specified then this +task can be used as a calculator (though see \fBastcalc\fR). +.le +.ls commands +A file of commands using the simple syntax given in the DESCRIPTION. If no +file name is given then the commands are read interactively from the +standard input with a prompt given by the \fIprompt\fR parameter. The +command input ends with either EOF or "quit". If a list of images and/or a +table is specified the commands are repeated for each image or until the +end of the table is reached. Comments beginning with '#', blank lines, and +escaped newlines are allowed. +.le +.ls table = "" +Optional text file containing columns of values. The table consists of +one or more lines of whitespace separated columns of values. Note that a +string with whitespace needs to be quoted. One line of the table is +scanned for each image. There must be at lest as many fields as are +defined by the column names. +.le +.ls colnames = "" +List of whitespace separated column names. These are the names referenced +in the command file by $<name>. The leading '$' is not included in the +column name specification. There may be fewer columns than the number of +columns in the table. Dummy names must be used if some columns occur +before a column to be referenced. +.le +.ls prompt = "asthedit> " +When no command file is specified the input commands are read from the +standard input (the terminal) and the value of the \fIprompt\fR string is +printed as a prompt. Note that if the input command file is specified as +"STDIN" there will be no prompt even though commands will also be read from +the standard input. +.le +.ls update = yes +Update the image headers? If no then any new, modified, or deleted +keywords will not be recorded in the image headers. This allows using the +task only for computing and printing quantities. Also this allows +accessing read-only images. +.le +.ls verbose = no +Print each keyword added or modified? +.le +.ls oldstyle = no +Use the old style syntax of this task from versions prior to V2.11. This +parameter allows backward compatibility for command files previously +developed. Some aspects of the new syntax are still available. +.le +.ih +DESCRIPTION +\fBAsthedit\fR evaluates expressions using image header keywords, column +names from a text table, CL parameters, internal variables, constants, and +functions to create or modify image header keywords. This task is +particularly useful for adding keywords from a table and deriving keywords +used by IRAF tasks which are not present in the images. It differs from +\fBhedit\fR in that it includes astronomical functions, operates from a +command file which may perform many edits, and references columns from a +text table. The command file may be omitted in which case commands may be +entered interactively for the first image and then the same commands will +be repeated for any subsequent images. + +This task may be used interactively or with input from a command file +(\fIcommands\fR). If no command file is specified a prompt (\fIprompt\fR) +is printed and commands are entered interactively. The input is terminated +with either the end-of-file character (EOF) or the command "quit". Input +command files simply contain the same input in a file and end with the end +of the file or "quit". The input commands, either those entered +interactively or from a file, are repeated for each image in the image list +and until the end of the input text table is reached, whichever comes +first. Generally this task is used on one or more images but if no +image is specified the commands are executed just once and task behaves +like an calculator. + +The command input consists of statements with each statement on a +line by itself. However long statements may be broken up with +escaped newlines using the back-slash as the escape character; +i.e. \<newline>. Comments beginning with '#', blank lines, +and whitespace are ignored. + +There are three types of statements: assignment, expressions, and +conditional. Each statement is on a line by itself though long statements +may be broken up with escaped newlines (\<newline>). Assignment statements +have an image header keyword name (or variable name beginning with $), an +equal sign (but see the \fIoldstyle\fR parameter), and an expression. +Expression statements consist of only the expression with the value of the +expression being ignored. Expression statements are generally used with +certain functions. Conditional statements are blocks of if-endif and +if-else-endif with assignment and expression statements between the +if-else-endif statements. These may not be nested. + +In earlier versions of this task there were only assignment statements +and these did not use an equal sign; i.e. all statements consisted +of an image header keyword and an expression separated by whitespace +except that a keyword name by itself indicates deletion of a keyword. +In order to interpret old command files the \fIoldstyle\fR parameter +may be set to yes. This will insert an equal sign internally. It +also only allows a subset of statements to not begin with a keyword +or variable. These are if, else, endif, print, printf, and quit. +Note that with the old style syntax one may still include an equal +sign. It is recommended that the old style syntax not be used because +of the greater flexibility in the new syntax. + +An image header keyword name is an arbitrary identifier which must begin +with an alphabetic character or '$' followed by an alphabetic character and +may use alphabetic characters, digits, or the characters '_', '$', or '.'. +Keyword names are case insensitive. Because some additional characters are +allowed in the FITS definition of keyword names, such names may be +referenced with the special '@' operator described below. + +One may also use internal variables which have the same identifier rules +but begin with '$'. Note that these variables are case sensitive (as are +function names). There are a few special predefined variables: "$I" +contains the current image name, "$D" contains the current local date (in +old FITS DD/MM/YY format), "$T" contains the current local time, "$GMD" +contains the current Greenwich meridian date (in FITS YYYY-MM-DD format), +"$GMT" contains the current Greenwich meridian time, and "$GMDT" contains +the current date and time in FITS YYYY-MM-DDTHH:MM:SS format. + +Before the commands are interpreted for each image a line of a text +file may be read. This occurs when a file is specified by the +\fItable\fR parameter. The line is scanned and the values of each +column are stored in the variable names specified by the \fIcolnames\fR +parameter. The values may be referenced in expressions by the +specified column name preceded with '$'. Note that additional lines +may be scanned with the "fscan" function. The user is then responsible +for the table containing the correct sequence of lines when there +are multiple images. + +In \fBasthedit\fR identifiers are image header keywords and lines +for the table file are read automatically. A related task is \fBastcalc\fR. +In this task all variables are maintained internally and input and output +are performed explicitly by functions. There are functions to read, +write, and delete image header keywords from a list of images. + +STATEMENTS + +The following gives a more formal description of the statement syntax +and the special words "if", "else", "endif", and "quit". + +.nf + <keyword> + <keyword> = <expression> + $<variable> = <expression> + <expression> + if (<expression>) + <statements> + endif + if (<expression>) + <statements> + else + <statements> + endif + quit +.fi + +The result of the expression in the "if" statement is normally a logical +value. However, a numeric value of 0 is false while any other value is +true and any string beginning with either "y" or "Y" is true with +any other value being false; i.e. string values of yes and no may be used. + +The old style syntax allows the following statements. + +.nf + <keyword> + <keyword> <expression> + $<variable> <expression> + <keyword> = <expression> + $<variable> = <expression> + print (...) + printf (...) + if (<expression>) + <statements> + endif + if (<expression>) + <statements> + else + <statements> + endif + quit +.fi + +Old style command files would only use the first two statements. + +KEYWORD NAMES AND VARIABLES + +Keyword names and variables may formally be defined as: + +.nf + [$]{a-zA-Z}[{a-zA-Z0-9._$}]* +.fi + +where [] indicate optional, {} indicates a class, - indicates an ASCII +range of characters, and * indicates zero or more occurrences. In words, a +keyword must begin with an alphabetic character, a variable or text file +column name begins with '$' and an alphabetic character, and both may be +followed by any combinations of alphabetic, digit, or '.', '_', and '$' +characters. + +There are a few predefined variables which may be referenced in +expressions. + +.nf + $I The name of the current image (if used) + $D The current date in the DD/MM/YY format + $T The current (local) time as a sexagesimal string +.fi + +The date and time are set once at the beginning of execution. + +Though not recommended it is possible to use any set of characters +for a variable provided the variable is referenced as @"<name>". +For example one could use @"date-obs" to include the character '-'. +This option is primarily used for FITS keywords that use '-' as +a hyphen character and must be escaped from interpretation as the +an arithmetic subtraction operator. + +EXPRESSIONS + +Expressions consist of operands and operators. The operands may be any +image header keyword, previously defined variable, column name, quoted +string constants, numeric constants, and functions. Values given as +sexagesimal strings are automatically converted to decimal numbers. The +operators are arithmetic, logical, and string. The expression syntax is +equivalent to that used in the CL and SPP languages. + +Additional information may be found in the help for \fBhedit\fR except that +all unquoted nonnumeric strings are considered to be keywords or variables + and so the '(', ')' operators are not used. The "field" references are +not needed so the references "." and "$" are not used and are not legal +variable names in this task. + +operators: + +The following operators are recognized in expressions. With the exception +of the operators "?", "?=", and "@", the operator set is equivalent to that +available in the CL and SPP languages. + + +.nf + + - * / arithmetic operators + ** exponentiation + // string concatenation + ! - boolean not, unary negation + < <= > >= order comparison (works for strings) + == != && || equals, not equals, and, or + ?= string equals pattern + ? : conditional expression + @ reference a variable +.fi + + +The operators "==", "&&", and "||" may be abbreviated as "=", "&", and "|" +if desired. The ?= operator performs pattern matching upon strings. +The @ operator is required to reference keywords with +one of the operator characters. This is most like to be used as: + + @"date-obs" + +A point to be aware of is that in the ?: conditional expression both +possible result values are evaluated though the result of the expression +is only one of them. This means that one should not use this to +call I/O functions that one wants to be executed only if a certain +condition holds. + +intrinsic functions: + +A number of standard intrinsic functions are recognized within expressions. +The set of functions currently supported is shown below. + + +.nf + abs atan2 deg log min real sqrt + acos bool double log10 mod short str + asin cos exp long nint sin tan + atan cosh int max rad sinh tanh +.fi + + +The trigonometric functions operate in units of radians. +The \fImin\fR and \fImax\fR functions may have any number of arguments up +to a maximum of sixteen or so (configurable). The arguments need not all +be of the same datatype. + +A function call may take either of the following forms: + +.nf + <identifier> '(' arglist ')' +or + <string_expr> '(' arglist ')' +.fi + +The first form is the conventional form found in all programming languages. +The second permits the generation of function names by string valued +expressions and might be useful on rare occasions. + +special functions: + +In addition to the above intrinsic functions there are a number of +astronomical functions. More will be added in time. These are: + +.nf + sexstr - convert a number to a sexagesimal string (xx:mm:ss.ss) + epoch - compute an epoch given a date and time + julday - compute a Julian day given a date and time + mst - compute a mean sidereal time given a date, time, and longitude + ra_precess - precess ra from one epoch to another +dec_precess - precess dec from one epoch to another + airmass - compute airmass given ra, dec, sidereal time, and latitude + eairmass - compute effective airmass given + ra, dec, sidereal time, exposure time, and latitude + obsdb - get parameters from the observatory database +.fi + +.ls sexstr (number), sexstr (number, digits) +Convert a number to a sexagesimal string in the format X:MM:SS.SS. There +is an optional second argument (the default is 0) which is the number of +decimal digits in the seconds field. +.le +.ls epoch (date[, ut]) +Compute an epoch given a date and time. The date is a string in the +format DD/MM/YY, YYYY-MM-DD, or YYYY-MM-DDTHH:MM:SS. +Typically this argument will be the standard FITS +keyword DATE-OBS. Because of possible confusion of the hyphen with +subtraction this keyword would be specified as @"date-obs". The time +argument is optional. If it is not given the time from the date +string will be used and if absent a time of 0h is used. +.le +.ls julday (date[, ut]) +Compute a Julian day given a date and time. The date and time are +specified as described previously. +.le +.ls mst (date[, ut], longitude) +Compute a mean sidereal time given a date, time, and longitude in degrees. The +date and (optional) time are specified as described previously. The longitude +may be given as a constant or using the observatory database function +as shown in the examples. The returned value is a sexagesimal +string with two decimals in the seconds. +.le +.ls precess (ra, dec, epoch1, epoch2) +Precess coordinates from one epoch to another. The ra is the +right ascension in hours, the dec in the declination in degrees, +and the epochs are in years. This function returns a formatted string with +the precessed right ascension, declination, and epoch. Numerical +values for the right ascension and declination are obtained with the +functions ra_precess and dec_precess. +.le +.ls ra_precess (ra, dec, epoch1, epoch2) +Precess a right ascension from one epoch to another. The ra is the +input right ascension in hours, the dec is the declination in degrees, +and the epochs are in years. Because a function can return only one +value there is a second function to return the precessed declination. +The returned value is a sexagesimal string with two decimals in the seconds. +.le +.ls dec_precess (ra1, dec1, epoch1, epoch2) +Precess a declination from one epoch to another. The ra is the +input right ascension in hours, the dec is the declination in degrees, +and the epochs are in years. Because a function can return only one +value there is a second function to return the precessed right ascension. +The returned value is a sexagesimal string with two decimals in the seconds. +.le +.ls arcsep (ra1, dec1, ra2, dec2) +Compute the separation between two spherical coordinates. The parameters +ra1 and ra2 are coordinates in hours (right ascension, longitude, etc.) +and the dec1 and dec2 parameters are coordinates in degrees (declination, +latitude, etc.). The computed value is returned in seconds of arc. +.le +.ls airmass (ra, dec, st, latitude) +Compute an airmass given right ascension in hours, declination in +degrees, sidereal time in hours, and latitude in degrees. The latitude +is often specified using the observatory database function as shown +in the examples. +.le +.ls eairmass (ra, dec, st, exptime, latitude) +Compute an "effective" airmass given right ascension in hours, declination +in degrees, beginning sidereal time in hours, exposure time in seconds, and +latitude in degrees. The The latitude is often specified using the +observatory database function as shown in the examples. The effective +airmass is based on a Simpson's rule weighting of the beginning, middle, +and ending airmass (with no provision for paused exposure). The weights +are: + +.nf + effective = beginning + 4 * middle + ending +.fi +.le +.ls obsdb (observatory, parameter) +Return a value from the observatory database. The observatory parameter is +a observatory identification string as defined in the database. Often this +is the value stored in the OBSERVAT keyword. Another special value is +"observatory" which then follows a name resolution scheme. The observatory +database mechanism is described by the help topic \fBobservatory\fR. The +parameter is a string given the quantity desired. Typically this would be +"longitude" or "latitude" but there are other possible parameters. +.le + +input/output functions: + +There are special functions for formatting, printing, error aborts, +reading, writing, and deleting image header keywords, reading a text file, +and reading and writing CL parameters. Note that in \fBasthedit\fR +one would not normally use the image input/output functions or +the text file scanning function since any keyword reference reads or +writes to the image header and one line of the text file is scanned +automatically for each image. + +.nf + print - print a set of arguments with default format + printf - print a set arguments with specified format + format - format a string + error - print an error message and abort + clget - get a value from a CL parameter + clput - put a value to a CL parameter + scan - scan a string and parse into keywords or variables + fscan - scan a line of a text file + imget - get the value of an image header keyword + imput - put (add or modify) the value of an image header keyword + imdel - delete an image header keyword +.fi + +.ls print ([argument, ...]) +Print the arguments with default formats based on the type of value ending +with a newline. There may be zero or more arguments. With zero arguments +only a newline will be printed. +.le +.ls printf (fmt [, argument, ...]) +Print a list of arguments using the formatting syntax described later. +Parameters to be formatted are given by the % fields and the values are +passed as further arguments in the order in which they are referenced. +There is no automatic newline so the format must include "\n" to +produce newlines. +.le +.ls error (message) +Print the "message", which can be any string variable such as might +be produced by "format", and abort the task. This is useful in +conjunction with the conditional operator to abort if a variable +takes an inappropriate value. +.le +.ls clget (parameter) +Get the value of a CL parameter. The argument must be a string. The +function value is the value of the parameter. +.le +.ls clput (parameter, value) +Put a value into a CL parameter. The parameter argument must be a +string and the value can be anything. The function returns a string +of the form "clput: parameter = value" where parameter and value are +the actual values. +.le +.ls scan (string, var, ...) +Parse a string of whitespace separated words into a list of +keywords or variables. The number of variables assigned is +the returned value of the function. +.le +.ls fscan (var, ...) +Scan a line of a text file into a list of keywords or variables. The arguments +are zero or more variable names to which to assign the values of +the whitespace separated fields. The number of variables assigned +is the returned value of the function. +.le +.ls imget (parameter) +Get the value of an image header keyword from the current image. The +argument must be a string. The function value is the value of the keyword. +.le +.ls imput (parameter, value) +Put a value into an image header keyword for the current image. The +parameter argument must be a string and the value can be anything. If the +keyword exists it will be modified and if it does not exist it will be +added. The function returns a string of the form "imput: parameter = +value" for new keywords or "imput: parameter = old_value -> value" for +modified keywords where parameter and value are the actual values. +.le +.ls imdel (parameter) +Delete an image header keyword. The parameter argument must be a string. +The returned values are the strings "imdel: parameter not found" +or "imdel: parameter = value (DELETED)" where parameter is the parameter +name and value is the old value. +.le + +.ih +FORMATS +A format specification has the form "%w.dCn", where w is the field +width, d is the number of decimal places or the number of digits of +precision, C is the format code, and n is radix character for +format code "r" only. The w and d fields are optional. The format +codes C are as follows: + +.nf +b boolean (YES or NO) +c single character (c or '\c' or '\0nnn') +d decimal integer +e exponential format (D specifies the precision) +f fixed format (D specifies the number of decimal places) +g general format (D specifies the precision) +h hms format (hh:mm:ss.ss, D = no. decimal places) +m minutes, seconds (or hours, minutes) (mm:ss.ss) +o octal integer +rN convert integer in any radix N +s string (D field specifies max chars to print) +t advance To column given as field W +u unsigned decimal integer +w output the number of spaces given by field W +x hexadecimal integer +z complex format (r,r) (D = precision) + + +Conventions for w (field width) specification: + + W = n right justify in field of N characters, blank fill + -n left justify in field of N characters, blank fill + 0n zero fill at left (only if right justified) +absent, 0 use as much space as needed (D field sets precision) + + +Escape sequences (e.g. "\n" for newline): + +\b backspace (not implemented) +\f formfeed +\n newline (crlf) +\r carriage return +\t tab +\" string delimiter character +\' character constant delimiter character +\\ backslash character +\nnn octal value of character + +Examples + +%s format a string using as much space as required +%-10s left justify a string in a field of 10 characters +%-10.10s left justify and truncate a string in a field of 10 characters +%10s right justify a string in a field of 10 characters +%10.10s right justify and truncate a string in a field of 10 characters + +%7.3f print a real number right justified in floating point format +%-7.3f same as above but left justified +%15.7e print a real number right justified in exponential format +%-15.7e same as above but left justified +%12.5g print a real number right justified in general format +%-12.5g same as above but left justified + +%h format as nn:nn:nn.n +%15h right justify nn:nn:nn.n in field of 15 characters +%-15h left justify nn:nn:nn.n in a field of 15 characters +%12.2h right justify nn:nn:nn.nn +%-12.2h left justify nn:nn:nn.nn + +%H / by 15 and format as nn:nn:nn.n +%15H / by 15 and right justify nn:nn:nn.n in field of 15 characters +%-15H / by 15 and left justify nn:nn:nn.n in field of 15 characters +%12.2H / by 15 and right justify nn:nn:nn.nn +%-12.2H / by 15 and left justify nn:nn:nn.nn + +\n insert a newline +.fi + +.ih +EXAMPLES +1. The following command file exercises the astronomical functions: + +.nf + cl> type cmds + observat = "kpno" + time = sexstr (1.2345) + epoch = epoch (@'date-obs', ut) + jd = julday (@'date-obs', ut) + mst = mst (@'date-obs', ut, obsdb (observat, "longitude")) + rap = ra_precess (ra, dec, epoch, 1950) + dap = dec_precess (ra, dec, epoch, 1950) + airmass = airmass (ra, dec, mst, obsdb (observat, "latitude")) + airmass + airmass = " " + airmass = eairmass (ra, dec, mst, itime, obsdb (observat, "latitude")) + cl> imhead obj001 l+ + ... + DATE-OBS= '05/04/87' / DATE DD/MM/YY + RA = '13:29:24.00' / RIGHT ASCENSION + DEC = '47:15:34.00' / DECLINATION + UT = ' 9:27:27.00' / UNIVERSAL TIME + ITIME = 600 / REQUESTED INTEGRATION TIME (SECS) + ... + cl> asthedit obj001 cmds table="" verbose+ + obj001: + $I = pix + $D = 22/01/96 + $T = 19:14:41 + observat = kpno + time = 1:14:04 + epoch = 1987.257752395672 + jd = 2446890.894062519 + mst = 14:53:39.81 + rap = 13:27:49.84 + dap = 47:27:05.72 + airmass = 1.079684154511483 + airmass = 1.07968415451148 -> DELETED + airmass = + airmass = -> 1.08519059292424 +.fi + +Note the use of the keyword deletion and syntax for adding an empty +value. + +2. The following command file shows computing a mid-ut and using a table +of values. + +.nf + cl> type cmds + midut = sexstr ($ut + $itime/3600./2.) + imagetyp = $imagetyp + cl> type table + object 9:27:27 600 + comp 9:48:00 10 + object 9:49:00 600 + flat 12:00:00 2 + cl> asthedit obj* cmds table=table colnames="imagetyp ut itime" verbose+ + obj001.imh: + $I = obj001.imh + $D = 22/01/96 + $T = 20:38:39 + midut = 9:32:27 + imagetyp = object + obj002.imh: + $I = obj002.imh + midut = 9:48:05 + imagetyp = comp + ... +.fi + +3. The following example computes quantities used by some NOAO tasks from +a minimal ESO/IHAP header. + +.nf + cl> type eso.dat + observat = "eso" + ut = sexstr ((@'tm-start'+0.1) / 3600.) + utend = sexstr ((@'tm-end'+0.1) / 3600.) + epoch = epoch (@'date-obs', ut) + st = mst (@'date-obs', ut, obsdb (observat, "longitude")) + exptime = (utend>ut)?(utend-ut)*3600.:(utend+24-ut)*3600. + ra = sexstr (@'postn-ra' / 15) + dec = sexstr (@'postn-dec') + airmass = airmass (ra, dec, st, obsdb (observat, "latitude")) + imagetyp = $imagetyp + filter = $filter + cl> type table.dat + object V + as> imhead eso + .... + DATE-OBS= '12/12/92' / Date this data created dd/mm/yy + TM-START= 84854. / '23:34:14' measurement start time + TM-END = 84974. / '23:36:14' measurement end time (U + TIME-SID= 1. / '00:00:01' sidereal start time + POSTN-RA= 354.0709 / '23:36:17' tel. position right-asc + POSTN-DE= 6.556945 /'+06:33:25' tel. position declinati + .... + as> asthedit eso eso.dat table=table.dat col="imagetyp filter" verbose+ + eso: + $I = eso + $D = 23/01/96 + $T = 09:02:55 + observat = eso + ut = 23:34:14 + utend = 23:36:14 + epoch = 1992.948616307863 + st = 0:18:56.76 + exptime = 120.000000000006 + ra = 23:36:17 + dec = 6:33:25 + airmass = 1.255875187126549 + imagetyp = object + filter = V + as> imhead eso + ... + DATE-OBS= '12/12/92' / Date this data created dd/mm/yy + TM-START= 84854. / '23:34:14' measurement start time + TM-END = 84974. / '23:36:14' measurement end time (U + TIME-SID= 1. / '00:00:01' sidereal start time + POSTN-RA= 354.0709 / '23:36:17' tel. position right-asc + POSTN-DE= 6.556945 /'+06:33:25' tel. position declinati + OBSERVAT= 'eso ' + UT = '23:34:14' + UTEND = '23:36:14' + EPOCH = 1992.94861630786 + ST = '0:18:56.76' + EXPTIME = 120.000000000006 + RA = '23:36:17' + DEC = '6:33:25 ' + AIRMASS = 1.25587518712655 + IMAGETYP= 'object ' + FILTER = 'V ' + ... +.fi + +The 0.1 in the UT calculation are to account for round-off. +Note the use of the conditional expression for the exposure time. + +4. The following example is for a case where there was no telescope +information but there is date and time information. This example is +relevant to data from the Kitt Peak Schmidt telescope circa 1993. +A table is prepared with the RA, Dec, and Epoch of each observation +and all other information is derived from the date, ut, and observatory +database. + +.nf + cl> type table.dat + 12:45:32 +49:34:12 1950 + 13:12:02 -01:12:05 1950 + cl> type cmds.hast + epoch = epoch (@'date-obs', ut) + ra = ra_precess ($ra, $dec, $epoch, epoch) + dec = dec_precess ($ra, $dec, $epoch, epoch) + st = mst (@'date-obs', ut, obsdb (observat, "longitude")) + airmass = eairmass (ra, dec, st, exptime, obsdb (observat, "latitude")) + midut = sexstr (ut + exptime/3600./2.) + cl> asthedit *.imh cmds.hast table=table.dat colnames="ra dec epoch" ver+ + sbs0119.imh: + $I = sbs0119.imh + $D = 23/01/96 + $T = 10:38:32 + epoch = 1987.257752395672 + ra = 12:47:14.84 + dec = 49:22:00.39 + st = 14:53:39.81 + airmass = 1.154765212092646 + midut = 9:32:27 + sbs0120.imh: + $I = sbs0120.imh + epoch = 1987.257752395672 + ra = 13:13:56.90 + dec = -1:23:54.30 + st = 14:53:39.81 + airmass = 1.336016291162518 + midut = 9:32:27 +.fi + +Note the use of the table and image header epochs in the precession. + +5. The following example shows the use of the printf function, +and a null image name, and interactive command input. + +.nf + cl> asthedit "" "" + astcalc> ra = 12:20:30 + astcalc> dec = 45:00:10 + astcalc> ep1 = 1950 + astcalc> ep2 = 2000 + astcalc> ra1 = ra_precess (ra, dec, ep1, ep2) + astcalc> printf ("ra=%h dec=%h\n", ra1, dec_precess (ra, dec, ep1, ep2)) + ra=12:22:57.4 dec=44:43:32.25 +.fi + +.ih +REVISIONS +.ls ASTHEDIT V2.11.2 +Y2K update: The epoch, julday, and mst functions now take either the old +or new FITS style date strings. The time argument is optional and if +it is not specified the time from the date string is used and if neither +time is present a value of 0h is used. New internal variables $GMD, +$GMT, and $GMDT for the current time Greenwich time are defined. +.le +.ls ASTHEDIT V2.11 +There are new astronomical functions and input/output functions. + +The command syntax may now use "=" as a delimiter as well as the whitespace. + +A new parameter "update" allows protecting images and accessing read-only +images for the purpose of calculating and printing quantities. + +The special variable name "$I" has the value of the image name, $D +the current date, and $T the current time. + +The case of no image name creates and deletes a temporary image so the +task can be used purely as a calculator (but see \fBastcalc\fR). +.le +.ih +SEE ALSO +astcalc, hedit, hfix, mkheader, setairmass, setjd, asttimes, precess, +observatory +.endhelp diff --git a/noao/astutil/doc/astradius.hlp b/noao/astutil/doc/astradius.hlp new file mode 100644 index 00000000..f19a47ec --- /dev/null +++ b/noao/astutil/doc/astradius.hlp @@ -0,0 +1,138 @@ +.help astradius Jan96 astutil +.ih +NAME +astradius -- find images within a circle on the sky +.ih +USAGE +astradius images racenter deccenter epcenter radius +.ih +PARAMETERS +.ls images +List of images for which the radius to a point on the sky is to be +determined. +.le +.ls racenter, deccenter, epcenter +Right ascension in hours, declination in degrees, and epoch of a position +on the sky to use as the center of a circle. +.le +.ls radius +Search radius in arc seconds about the center position. +.le +.ls keywpars = "" (pset) +Parameter set defining the image header keywords. This task requires +keywords for the right ascension, declination, and epoch. If +there is no epoch in the image header keywords for the date of observation +and the universal time are used for the epoch. The default parameter +set (specified by the empty string) is \fBkeywpars\fR. +.le +.ls commands = "astutil$astradius.dat" +Command file used to compute the distance from the coordinate center +and print a result if the distance is less than the specified radius. +The command file uses the syntax described for \fBastcalc\fR. +Users may copy and modify this file if desired. +.le +.ih +DESCRIPTION +\fBAstradius\fR computes the spherical distance from a specified point on +the sky for each image in a list of images (\fIimages\fR). The point on +the sky is specified by the parameters \fIracenter\fR, \fIdeccenter\fR, and +\fIepcenter\fR which give a right ascension in hours, a declination in +degrees, and an epoch. Each image is required to have keywords for the +right ascension (hours), declination (degrees), and epoch. However, if no +epoch is defined in the image header then an epoch is computed from the +observation date and universal time. The spherical distance is compared to +a specified radius (\fIradius\fR) in arc seconds. If the distance is less +than the radius the image name and title are printed. + +The image header keywords giving the observation coordinates are defined +by the parameter set selected with the \fIkeywpars\fR parameter. +If no value is given then the parameters from the \fBkeywpars\fR +parameter set task are used. The keywords required are those +select by the \fIkeywpars.ra\fR, \fIkeywpars.dec\fR, and +\fIkeywpars.epoch\fR. If the epoch is absent or zero then the +keywords selected by \fIkeywpars.date_obs\fR and \fIkeywpars.ut\fR +are used to compute an epoch. + +\fBAstradius\fR is a simple script which calls \fBastcalc\fR. The +command file is specified by the parameter \fIcommands\fR. The +default file precesses the observation coordinates to the epoch +of the search center coordinates and then computes the spherical +distance between the search center and the observation. Finally +it tests the distance against the specified radius and prints +the image name and title if the observation is within the radius. +Users may copy the default command file and modify it. The +command syntax is described in the help for \fBastcalc\fR. +.ih +EXAMPLES +1. Page the script task and the command file. + +.nf + cl> page astutil$astradius.cl,astutil$astradius.dat + # ASTRADIUS -- Find images within a radius. + + procedure astradius (images, racenter, deccenter, epcenter, radius) + + string images = "" {prompt="List of images"} + string racenter = "" {prompt="RA center (hours)"} + string deccenter = "" {prompt="DEC center (degrees)"} + real epcenter = 2000. {prompt="Epoch of center"} + real radius = 60. {prompt="Radius in arc seconds"} + pset keywpars = "" {prompt="Keywords for RA, DEC, EPOCH\n"} + + file commands = "astutil$astradius.dat" {prompt="ASTCALC file"} + + begin + astcalc (commands=commands, images=images, table="", verbose=no) + end + + Print images which are within a given radius in the sky. + + # Get parameters. + racenter = clget ("astradius.racenter") + deccenter = clget ("astradius.deccenter") + epcenter = clget ("astradius.epcenter") + radius = clget ("astradius.radius") + ra = imget(clget("keywpars.ra")) + dec = imget(clget("keywpars.dec")) + + epoch = imget(clget("keywpars.epoch")) + if (str(epoch) == "" || real(epoch) == 0.) + date = imget(clget("keywpars.date_obs")) + ut = imget(clget("keywpars.ut")) + epoch = epoch (date, ut) + endif + + # Precess image coordinates to center epoch and compute separation. + radec = precess (ra, dec, epoch, epcenter) + ra1 = ra_precess (ra, dec, epoch, epcenter) + dec1 = dec_precess (ra, dec, epoch, epcenter) + sep = arcsep (racenter, deccenter, ra1, dec1) + + # Print result if within radius. + if (sep < real (radius)) + printf ("%-15s %s\n", $I, imget ("title")) + endif +.fi + +2. Find images within an arc minute of a particular position. + +.nf +cl> astradius +List of images: *.imh +RA center (hours): 13:31 +DEC center (degrees): 47:00 +Epoch of center (2000.): +Radius in arc seconds (60.): +obj0020.imh m51 B 600s +obj0021.imh m51 V 600s +obj0022.imh m51 R 600s +.fi +.ih +REVISIONS +.ls ASTRADIUS V2.11 +This task is new in this release. +.le +.ih +SEE ALSO +astcalc, hselect +.endhelp diff --git a/noao/astutil/doc/asttimes.hlp b/noao/astutil/doc/asttimes.hlp new file mode 100644 index 00000000..eefc17df --- /dev/null +++ b/noao/astutil/doc/asttimes.hlp @@ -0,0 +1,128 @@ +.help asttimes May93 astutil +.ih +NAME +asttimes -- Compute UT, Julian day, epoch, and sidereal time +.ih +USAGE +asttimes +.ih +PARAMETERS +.ls files = "" +List of files containing local dates and times for which the astronomical +dates and times are desired. If no input files are specified then task +parameters are used. +.le +.ls header = yes +Print header and observatory information to output? +.le +.ls observatory = ")_.observatory" +Observatory for which times are to be computed. The default is a +redirection to look in the parameters for the parent package for a value. +The final value of this parameter may be one of the +observatories in the observatory database, "observatory" to select the +observatory defined by the environment variable "observatory" or the +parameter \fBobservatory.observatory\fR, or "obspars" to select the +current parameters set in the \fBobservatory\fR task. See help for +\fBobservatory\fR for additional information. +.le +.ls year, month, day, time +If no input files are specified then the date and time for which the +astronomical date and time is computed are given by these parameters. +If the year is less than 100 then the century is assumed to be 1900. +The month is specified as an integer between 1 and 12, and the local +time for the specified time zone is in hours (sexagesimal format is +acceptable). +.le +.ls ut, epoch, jd, lmst +If no input files are specified then the universal time, J2000 Julian epoch, +Julian day, and local mean sidereal time (at the specified longitude) +are recorded in these parameters for possible reference as CL +variables. This is in addition to the usual printed output. +.le +.ih +DESCRIPTION +The astronomical quantities of universal time, J2000 Julian epoch, Julian day, +and local mean sidereal time at the specified observatory are computed and +printed for the given dates and times. To compute parameters for a +location not specified in the observatory database use the observatory name +"obspars" which will use the values defined by the parameters +\fIobservatory.longitude\fR and \fIobservatory.timezone\fR. The input +dates and times may be taken from files containing the year, month (as an +integer between 1 and 12), day, and local time (sexagesimal notation is +acceptable) in the specified time zone. If no files are specified then task +parameters are used. The output consists of a printed table with optional +header and the input data and derived astronomical data. In addition, if +the input date and time is from the task parameters then the astronomical +times are recorded in the user's parameter file (provided the task is not +run as a background job). These parameters may then be used as CL +parameters. +.ih +EXAMPLES +1. For use directly without data files set the date and time using +the parameter editor, with explicit assignments, or on the command line: + +.nf + cl> asttimes year=1987 month=10 day=28 time=15:30 obs=kpno + # ASTTIMES: Observatory parameters for Kitt Peak National Observatory + # timezone = 7 + # longitude = 111:36.0 + ##YR MON DAY ZT UT EPOCH JD LMST + 1987 10 28 WED 15:30:00.0 22:30:00.0 1987.82324 2447097.4375 17:30:31.8 + cl> =asttimes.lmst + 17.508823973881 +.fi + +2. To make a table using a CL loop: + +.nf + cl> asttimes.observatory="kpno" + cl> asttimes.year=1987 + cl> asttimes.month=10 + cl> asttimes.time=0 + cl> for (i=10; i<16; i+=1) { + >>> asttimes (day=i, header=no) + >>> } + 1987 10 10 SAT 0:00:00.0 7:00:00.0 1987.77219 2447078.7917 0:47:01.0 + 1987 10 11 SUN 0:00:00.0 7:00:00.0 1987.77493 2447079.7917 0:50:57.5 + 1987 10 12 MON 0:00:00.0 7:00:00.0 1987.77766 2447080.7917 0:54:54.1 + 1987 10 13 TUE 0:00:00.0 7:00:00.0 1987.78040 2447081.7917 0:58:50.7 + 1987 10 14 WED 0:00:00.0 7:00:00.0 1987.78314 2447082.7917 1:02:47.2 + 1987 10 15 THU 0:00:00.0 7:00:00.0 1987.78588 2447083.7917 1:06:43.8 +.fi + +In practice the output would be directed to a file: + + >>> asttimes (day=i, header=no, >>"table") + +3. To use an input file: + +.nf + cl> asttimes f=dates > table + cl> type table + # ASTTIMES: Observatory parameters for Kitt Peak National Observatory + # timezone = 7 + # longitude = 111:36.0 + ##YR MON DAY ZT UT EPOCH JD LMST + 1987 10 28 WED 22:00:00.0 5:00:00.0 1987.82398 2447097.7083 0:01:35.8 + 1987 10 28 WED 23:00:00.0 6:00:00.0 1987.82409 2447097.7500 1:01:45.7 + 1987 10 29 THU 0:00:00.0 7:00:00.0 1987.82421 2447097.7917 2:01:55.5 + 1987 10 29 THU 1:00:00.0 8:00:00.0 1987.82432 2447097.8333 3:02:05.4 +.fi +.ih +REVISIONS +.ls ASTTIMES V2.10.3 +The epoch was changed from day of the year divided by 365.25 to the +precise J2000 Julian epoch definition. In addition to changing +the output value this fixes incorrect values JD and LMST around the +new year. + +The times are now always printed in the proper 24 hour interval instead +of using negative or values greater than 24 to indicate the day difference +with Greenwich. + +The header parameter now suppress printing the observatory information. +.le +.ih +SEE ALSO +observatory +.endhelp diff --git a/noao/astutil/doc/ccdtime.hlp b/noao/astutil/doc/ccdtime.hlp new file mode 100644 index 00000000..318c89b6 --- /dev/null +++ b/noao/astutil/doc/ccdtime.hlp @@ -0,0 +1,354 @@ +.help ccdtime Aug98 noao.astutil +.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. There may be many filters +in the database but the task is currently limited to displaying no +more than five. +.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 +categories 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.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 +.endhelp diff --git a/noao/astutil/doc/galactic.hlp b/noao/astutil/doc/galactic.hlp new file mode 100644 index 00000000..f6beedc9 --- /dev/null +++ b/noao/astutil/doc/galactic.hlp @@ -0,0 +1,68 @@ +.help galactic Oct87 noao.astutil +.ih +NAME +galactic -- convert between equatorial and galactic coordinates +.ih +USAGE +galactic files +.ih +PARAMETERS +.ls files +The name of a file (or a file list or template) containing the coordinates +to be converted. +.le +.ls in_coords = "equatorial" +Type of input coordinates. May be either "equatorial" (RA and DEC) or +"galactic" (l and b). +.le +.ls print_coords = yes +If \fBprint_coords\fR = yes, the RA, DEC and epoch (as well as lII and bII) +will be listed on the output file. +.le +.ih +DESCRIPTION +Program \fBgalactic\fR is used to convert between equatorial and +galactic coordinates. It converts in either direction based on the +specified input coordinates. Coordinates are read from the input file +as RA and DEC or galactic longitude and latitude pairs, one pair per +input line. Each coordinate pair may optionally be followed by the +epoch of the equatorial coordinates, in which case the coordinates are +precessed to 1950.0 (the epoch of definition for the galactic center) +before conversion for equatorial to galactic or to the specified epoch +for galactic to equatorial. Coordinates may be entered in either +decimal or sexagesimal notation. +.ih +EXAMPLES +1. Convert the given RA and DEC coordinates to galactic coordinates. When +the epoch is specified as other than 1950.0, precess before converting. +The lines input by the user are marked: + +.nf + cl> galactic STDIN [input] + 12:30:10.12 10:18:27.5 1930. [input] + 12:30:10.12 10:18:27.5 1930.00 288.4695 72.2884 + 12:30 10:18 [input] + 12:30:00.00 10:18:00.0 1950.00 287.4598 72.3202 + 12.5 10:18 [input] + 12:30:00.00 10:18:00.0 1950.00 287.4598 72.3202 + (eof=<ctrl/z>) [input] +.fi + +2. The following is equivalent, except that coordinate input is taken from +the file "coords", rather than from the terminal: + +.nf + cl> galactic coords [input] + 12:30:10.12 10:18:27.5 1930.00 288.4695 72.2884 + 12:30:00.00 10:18:00.0 1950.00 287.4598 72.3202 + 12:30:00.00 10:18:00.0 1950.00 287.4598 72.3202 +.fi + +3. If image headers contain the coordinates, in this case RA, DEC, and EPOCH, +then one can get the galactic coordinates for the image by: + + cl> hselect *.imh ra,dec,epoch yes | galactic STDIN + +(Consult the help for the task \fBhselect\fR for information about selecting +fields from image headers.) +.endhelp diff --git a/noao/astutil/doc/gratings.hlp b/noao/astutil/doc/gratings.hlp new file mode 100644 index 00000000..593ddd62 --- /dev/null +++ b/noao/astutil/doc/gratings.hlp @@ -0,0 +1,252 @@ +.help gratings Mar91 noao.astutil +.ih +NAME +gratings -- Compute and print grating parameters +.ih +USAGE +gratings +.ih +PARAMETERS +.ls echelle = no +Is the grating an echelle grating? This selects whether the angle of +incidence is greater or less than blaze angle when the angle of incidence +or blaze angle are not specified. For an echelle the angle of incidence +is generally greater than the blaze angle. +.le +.ls f = 590. +Focal length in millimeters. Technically it is defined by the equation x = +f * tan (theta) where x is distance from the optical axis on the detector +and theta is the diffraction angle; i.e. it converts angular measures to +millimeters on the detector. If the focal length is specified as INDEF it +is computed from the dispersion, which is required in this case, and the +other parameters. +.le +.ls gmm = 226. +Grating grooves per millimeter. If specified as INDEF it is computed +from the order, which is required in this case, and the other parameters. +.le +.ls blaze = 4.5 +Blaze angle in degrees. It is always specified or printed as a positive +angle relative to the grating normal. If specified as INDEF it is +computed from the other parameters. +.le +.ls theta = -10.5 +Angle of incidence in degrees. The angle of incidence must be in the plane +perpendicular to face of the grating. The angle of incidence may be +specified relative to the grating normal or the blaze angle though it is +always printed relative to the grating normal. To specify it relative to +the blaze angle add 360 degrees; for example to have an angle of 15 degrees +less than the blaze angle specify 360 - 15 = 345. If the angle of +incidence is specified as INDEF it is computed from the other parameters. +.le +.ls order = 1 +Order for which the wavelength and dispersion are specified. If specified +as INDEF it will be computed from the grooves per mm, which is required in +this case, and the other parameters. +.le +.ls wavelength = INDEF +Blaze wavelength in Angstroms. If specified as INDEF it will be computed +from the other parameters. +.le +.ls dispersion = INDEF +Blaze dispersion in Angstroms per millimeter. If specified as INDEF it +will be computed from the focal length, which is required in this case, +and the other parameters. +.le +.ih +DESCRIPTION +This task computes the grating parameters specified as INDEF from the other +grating parameters and prints the final set of self-consistent parameters. +The parameters are the focal length to the detector, the grooves per +millimeter of the grating, the blaze angle of the grating, the angle of +incidence of the incoming light to the grating (which is required to be in +the plane perpendicular to the face of the grating), the diffraction order, +and the blaze wavelength and dispersion at the blaze wavelength on the +detector for that order. There must be five of these parameters specified +to compute the remaining two with the exceptions that the combinations +of the grooves per millimeter and the order or the focal length and +dispersion must not be simultaneously unspecified. There are two cases in +which the computation will not succeed, if not enough parameters are +specified or when the combination of parameters is not possible. In these +cases a warning is printed and the input parameters, including INDEF +values, are printed. + +If more than the minimum number of parameters are specified then some of +the specified parameters will be adjusted to give a self-consistent set. +In particular, if all parameters are specified the input wavelength and +dispersion are ignored and new values are calculated. If only one +parameter is not specified then the dispersion is adjusted if it is not the +dispersion the wavelength is adjusted if it is the dispersion. + +When the order is not specified, the nearest integer order is computed from +the other non-integer parameters and then the wavelength and dispersion are +recomputed based on the integer order. + +The basic grating equation used is + +.nf +(1) m * lambda = (sin(theta) + sin(beta)) / g +.fi + +where m is the order, lambda the wavelength, g the grooves per wavelength unit, +theta the angle of incidence to the grating normal, and beta the angle of +diffraction to the normal. The diffraction angle relative to that +of the blaze maximum, psi, is given by + +.nf +(2) beta = psi + 2 * blaze - theta +.fi + +where blaze is the blaze angle. The diffraction angle psi is related to +position on the detector, again measured from the blaze peak, by + +.nf +(3) x = f * tan(psi) +.fi + +where f is the effective focal length (as defined by this equation). +At the blaze maximum psi = x = 0 and the wavelength and dispersion +per millimeter on the detector are given by (1) and the derivative of (1) +with respect to x: + +.nf +(4) wavelength = 1E7*(sin(theta)+sin(2*blaze-theta))/(gmm*order) +(5) dispersion = 1E7*cos(2*blaze-theta)/(gmm*order*f) +.fi + +where the variable names are the same as the program parameters and +the factor of 1E7 is the conversion between millimeters and Angstroms. + +Equations (4) and (5) are the ones solved by this task. There are a some +interesting points to note about the angle of incidence. There are two +solutions of these equations one with the angle of incidence less than the +blaze angle and one greater than the blaze angle. For an echelle the angle +of incidence is generally set greater than the blaze angle to avoid light +lost by reflections back along the angle of incidence. The \fIechelle\fR +parameter is used to determine which side of the blaze angle the angle of +incidence will be computed in the cases in which it is not specified; +greater than the blaze angle when yes and less than the blaze angle when +no. + +In spectrographs it is often the case that the angle between the +incoming beam and center of the diffracted beam, delta, is fixed where + +.nf +(6) delta = 2 * |theta - blaze| +.fi + +This fixes the angle between the blaze angle and the angle of incidence +needed to center the blaze function on the detector. If one wants to +solve (4) and (5) for the blaze angle with this difference fixed the +angle of incidence may be specified relative to the blaze angle by +adding 360 degrees to the difference. An example best describes this. +The Kitt Peak 4m Echelle Spectrograph has a 12 degree angle +between the incoming beam to the echelle grating and the beam to the +crossdisperser. Then |theta - blaze| = 6 degrees. For an echelle the +angle of incidence is greater than the blaze angle (relative to the +grating normal) so if we set the angle of incidence to 6 + 360 +and the blaze angle to INDEF the resulting computation will +determine blaze and theta with a fixed 6 degree angle. +.ih +EXAMPLES +1. The default values are for a grating of 226 grooves per millimeter +in a 590 mm focal length camera. For a blaze angle of 4.5 degrees +and an angle of incidence of -10.5 degrees (the angle is on the +other side of the grating normal relative to the blaze angle) the +first order wavelength and dispersion at the blaze peak is: + +.nf + cl> gratings + Grating parameters: + Focal length = 590. mm + Grating = 226. grooves/mm + Blaze angle = 4.5 degrees + Incidence angle = -10.5 degrees + Order = 1 + Blaze wavelength = 6706.696 Angstroms + Blaze dispersion = 70.69458 Angstroms/mm +.fi + +2. To find nearest order and the dispersion for a wavelength of 3400 +Angstroms: + +.nf + cl> gratings order=INDEF wave=3400 + Grating parameters: + Focal length = 590. mm + Grating = 226. grooves/mm + Blaze angle = 4.5 degrees + Incidence angle = -10.5 degrees + Order = 2 + Blaze wavelength = 3353.348 Angstroms + Blaze dispersion = 35.34729 Angstroms/mm +.fi + +3. To find the grating parameters need to center 8000 Angstroms with +a dispersion of 90 Angstroms per millimeter: + +.nf + cl> gratings gmm=INDEF blaze=INDEF theta=345 wave=8000 disp=90 + Grating parameters: + Focal length = 590. mm + Grating = 177.8237 grooves/mm + Blaze angle = 4.223008 degrees + Incidence angle = -10.77702 degrees + Order = 1 + Blaze wavelength = 8000. Angstroms + Blaze dispersion = 90. Angstroms/mm +.fi + +4. What focal length should be used to get a dispersion of 20 Angstroms/mm +at 6700 Angstroms: + +.nf + cl> gratings f=INDEF wave=6700 disp=20 + Grating parameters: + Focal length = 2085.49 mm + Grating = 226. grooves/mm + Blaze angle = 4.5 degrees + Incidence angle = -10.5 degrees + Order = 1 + Blaze wavelength = 6706.696 Angstroms + Blaze dispersion = 20. Angstroms/mm +.fi + +5. What are the first order wavelength parameters for an echelle of +31.6 grooves per millimeter with a 63 degree blaze, and a 6 degree +angle of incidence relative to the blaze angle. Then what are +the wavelength parameters in 80th order and what order is 6563 in. + +.nf + cl> gratings gmm=31.6 blaze=63 theta=69 + Grating parameters: + Focal length = 590. mm + Grating = 31.6 grooves/mm + Blaze angle = 63. degrees + Incidence angle = 69. degrees + Order = 1 + Blaze wavelength = 560838.9 Angstroms + Blaze dispersion = 292.1256 Angstroms/mm + cl> gratings gmm=31.6 blaze=63 theta=69 order=80 + Grating parameters: + Focal length = 590. mm + Grating = 31.6 grooves/mm + Blaze angle = 63. degrees + Incidence angle = 69. degrees + Order = 80 + Blaze wavelength = 7010.487 Angstroms + Blaze dispersion = 3.651571 Angstroms/mm + cl> gratings gmm=31.6 blaze=63 theta=69 order=INDEF wave=6563 + Grating parameters: + Focal length = 590. mm + Grating = 31.6 grooves/mm + Blaze angle = 63. degrees + Incidence angle = 69. degrees + Order = 85 + Blaze wavelength = 6598.105 Angstroms + Blaze dispersion = 3.436772 Angstroms/mm +.fi +.ih +SEE ALSO +artdata.mkechelle +.endhelp diff --git a/noao/astutil/doc/keywpars.hlp b/noao/astutil/doc/keywpars.hlp new file mode 100644 index 00000000..e5b50d4a --- /dev/null +++ b/noao/astutil/doc/keywpars.hlp @@ -0,0 +1,94 @@ +.help keywpars May93 noao.astutil +.ih +NAME +keywpars -- edit the image header keywords used by the package +.ih +USAGE +keywpars +.ih +PARAMETERS +.ls ra = "RA" +Right Ascension keyword. (Value in HMS format). +.le +.ls dec = "DEC" +Declination keyword. (Value in HMS format). +.le +.ls ut = "UT" +UT of observation keyword. This field is the UT start of the observation. +(Value in HMS Format). +.le +.ls utmiddle = "UTMIDDLE" +UT mid-point of observation keyword. This field is the UT mid-point of +the observation. (Value in HMS Format). +.le +.ls exptime = "EXPTIME" +Exposure time keyword. (Value in Seconds). +.le +.ls epoch = "EPOCH" +Epoch of coordinates keyword. (Value in Years). +.le +.ls date_obs = "DATE-OBS" +Date of observation keyword. Format for this field should be +dd/mm/yy (old FITS format), yyyy-mm-dd (new FITS format), or +yyyy-mm-ddThh:mm:ss.sss (new FITS format with time). +.le + +.ce +OUTPUT KEYWORDS +.ls hjd = "HJD" +Heliocentric Julian date keyword. (Value in Days). +.le +.ls mjd_obs = "MJD-OBS" +Modified Julian Data keyword. The MJD is defined as the Julian date of +the mid-point of the observation - 2440000.5. (Value in Days). +.le +.ls vobs = "VOBS" +Observed radial velocity keyword. (Value in Km/sec). +.le +.ls vrel = "VREL" +Observed radial velocity keyword. (Value in Km/sec). +.le +.ls vhelio = "VHELIO" +Corrected heliocentric radial velocity keyword. (Value in Km/sec). +.le +.ls vlsr = "VLSR" +Local Standard of Rest velocity keyword. (Value in Km/sec). +.le +.ls vsun = "VSUN" +Epoch of solar motion. (Character string with four real valued fields +describing the solar velocity (km/sec), the RA of the solar velocity (hours), +the declination of the solar velocity (degrees), and the epoch of solar +coordinates (years)). +.le +.ih +DESCRIPTION +The image header keywords used by the \fIfxcor\fR task can be +edited if they differ +from the NOAO standard keywords. For example, if the image header keyword +giving the exposure time for the image is written out as "EXP-TIME" instead +of the standard "OTIME" at a given site, the keyword accessed for +that information +may be changed based on the value of the \fIexptime\fR parameter. + +.ih +EXAMPLES +1. List the image header keywords. + +.nf + as> lpar keywpars +.fi + +2. Edit the image header keywords + +.nf + as> keywpars +.fi +.ih +REVISIONS +.ls KEYPARS V2.10.3 +First version. Currently only used by the \fIRVCORRECT\fR task. +.le +.ih +SEE ALSO +fxcor, rvcorrect +.endhelp diff --git a/noao/astutil/doc/obs.hlp b/noao/astutil/doc/obs.hlp new file mode 100644 index 00000000..4b5a8a88 --- /dev/null +++ b/noao/astutil/doc/obs.hlp @@ -0,0 +1,390 @@ +.help observatory Jan92 noao +.ih +NAME +observatory -- Examine and set observatory parameters +.ih +USAGE +observatory command obsid [images] +.ih +PARAMETERS +.ls command = "list" (set|list|images) +Command option which is one of "set", "list", or "images". The set command +sets the default observatory task parameters for the specified +observatory. The list command lists the observatory parameters for the +specified observatory but does not modify the task parameters. The images +command lists the observatory parameters for a list of images. The list +and images commands examine and verify the observatory parameters applied +by other tasks using the observatory database facility. +.le +.ls obsid = "?" +Observatory identification to be set, listed, or used as the default for +images without the OBSERVAT keyword. The observatory ID is one of those in +the database (case ignored), the special string "observatory" to default to +the environment variable "observatory" or the \fIobservatory.observatory\fR +parameter, "obspars" to select the parameters in the \fBobservatory\fR +task, or "?" to list the observatories defined in the database. +.le +.ls images +List of images to be examined with the "images" command. The images are +checked for the OBSERVAT keyword to determine the observatory parameters +to be listed, otherwise the observatory given by \fIobsid\fR is used. +.le +.ls verbose = no +Verbose output? Because there are a number of different ways in which +observatory information is determine this option prints detailed +information on how the observatory database and parameters are +ultimately selected. +.le + +.ls observatory +The default observatory used by tasks which use the special +observatory identification "observatory". The value is one of the +observatory names in the observatory database (case ignored) +or the special value "obspars" to select the parameters defined in this +task. There is no default to force users to set it at least once. +.le +.ls name +Observatory name. +.le +.ls longitude +Observatory longitude given in degrees west. +.le +.ls latitude +Observatory latitude in degrees. Positive latitudes are north and negative +latitudes are south. +.le +.ls altitude +Observatory altitude in meters above sea level. +.le +.ls timezone +Observatory time zone. The time zone is the number of hours west of +Greenwich or the number of hours to be added to local time to obtain +Greenwich time. +.le +.ih +ENVIRONMENT VARIABLES +.ls obsdb +This variable selects the observatory database. If not defined it defaults +to noao$lib/obsdb.dat. +.le +.ls observatory +This variable selects the observatory entry whenever a task uses the +observatory name "observatory". If not defined the value of the task +parameter \fIobservatory.observatory\fR is used. +.le +.ih +IMAGE HEADER KEYWORDS +The observatory identification for images is first sought under the +image header keyword OBSERVAT. This always takes precedence over any +other means of defining the observatory. +.ih +DESCRIPTION + +OBSERVATORY PARAMETERS IN THE NOAO PACKAGE + +Some astronomical data reduction and analysis tasks perform +computations requiring information about where the data was observed. +For example a number of \fBnoao\fR tasks make corrections for the +airmass. Generally they look for an airmass in the image header and +if it is not present they attempt to compute it from other image header +parameters. The information about time and telescope coordinates +of the observation are often in the image header but the observatory +latitude is not. The task must get this information somehow. + +Prior to IRAF V2.10 tasks generally had explicit parameters, such as +latitude, with default values pointing (using parameter redirection) to +the parameter of the same name in the \fBobservatory\fR task. The +user was required to know the values of the observatory parameters and +manually change them for data from different observatories. In V2.10 +an observatory database has been implemented. Observatory parameters +are stored in a simple text file and tasks obtain observatory related +parameters by specifying an observatory identification. + +In general the information about the observatory should be directly +associated with the image data. Unless stated otherwise in the +description of a task, tasks which require observatory information +will first look for the image header keyword OBSERVAT. The value of +this keyword is the observatory identification used to index the +observatory database. The task will then look up any observatory +parameters it needs in the observatory database. Data from +observatories that support this keyword will, therefore, always use the +correct observatory parameters without user intervention. All +observatories which export FITS image data are urged to adopt the +OBSERVAT keyword (a keyword recommended by the FITS standard). + +For image data which do not identify the observatory in this way +and in tasks which do not operate on images (such as astronomical +calculator tools), the observatory must be specified by the user. +Most tasks provide an "observatory" parameter which either directly +selects the observatory or use special values for defining the +observatory with an environment variable or the parameters +from the \fBobservatory\fR task. + +An observatory is specified by the identification name used in the +observatory database. The names in the database may be listed using +the \fBobservatory\fR task as described below. If the desired observatory +is not in the database a user may copy/create their own database and +select it with the environment variable "obsdb", modify the standard +database if allowed (any changes to the distributed version should +be forwarded to iraf$noao.edu), or use the special observatory name +"obspars". The last option directly uses the parameters in the +\fBobservatory\fR task which can be set to any values using the normal +parameter editing mechanism. + +The default value for the observatory parameter in a task is generally +"observatory". This special name directs the task to look first +for the environment variable of the same name and then at the +\fIobservatory\fR parameter of the \fBobservatory\fR task. The environment +variable allows users or sites to set the default observatory in their +login files and site defaults. Also it is simple to change the +default observatory either with a \fBreset\fR command or the +\fBobservatory\fR command. + +The observatory database is selected by the environment variable +"obsdb". The default when the variable is not defined is the +\fBnoao\fR package library database file "noao$lib/obsdb.dat". The use +of an environment variable allows users to permanently change the +default database in the OS environment (when IRAF has access to it such +as in UNIX systems) or in the startup IRAF environment as set in the +"login.cl" or "loginuser.cl" files. One can, of course, change it +during a session with the set or reset commands. For sites which want +to customize the observatory mechanism the environment variables can +also be set and changed in the files "hlib$zzsetenv.def", +"noao$lib/zzsetenv.def", and the template login file "hlib$login.cl". + +An observatory database file consist of a simple list of keyword=value +pairs with arbitrary whitespace allowed. An observatory entry begins +with the observatory keyword and extends to the next observatory +keyword or the end of the file. The observatory identification should +be the same as the string used in the OBSERVAT image header parameter +for data from that observatory. The default file noao$lib/obsdb.dat +begins as follows: + +.nf +# Observatory Parameters. Taken from the Almanac. +# +# Observatories wishing to be added or make changes in the default +# distributed database should send information to iraf@noao.edu. + +observatory = "kpno" + name = "Kitt Peak National Observatory" + longitude = 111:36.0 + latitude = 31:58.8 + altitude = 2120. + timezone = 7 + +observatory = "ctio" + <etc> +.fi + +In summary, access to observatory parameters is now done by referencing +the image header keyword OBSERVAT and, if not defined, determine the +observatory name from a task parameter. The environment variables +"observatory" and "obsdb" can be set by the user to select alternate +observatories and observatory database files. For data without an +observatory entry the observatory can be set to "obspars" or the user +may make their own observatory database. + +THE OBSERVATORY TASK + +The \fBobservatory\fR task serves a number of functions. It may be used to +examine the observatory database, verify the observatory parameters which +will be used by other tasks, particularly those operating on images, set +the default observatory if not defined by other means, set observatory +parameters explicitly, especially when there is no observatory database +entry, and as a parameter set for tasks which explicitly reference +observatory parameters. The \fBverbose\fR parameter also provides a +detailed check of the steps used to determine the observatory database, +observatory identification, and observatory parameters. + +The \fIcommand\fR parameter takes the values "set", "list", or "images". +The \fIobsid\fR parameter supplies the observatory identification and the +\fIimages\fR parameter is used to specify a list of images for the "images" +command. The parameters are query parameters and so may be either queried +or simply typed on the command line. + +The "set" command prints the observatory parameters for the specified +observatory and sets many of these in the \fBobservatory\fR task +parameters. This command is used to set the default observatory parameters +for tasks where images are not used, the images do not contain the +observatory id, or direct references to specific parameters with parameter +redirection (for example ")observatory.latitude") are used. + +The "list" command is similar to the "set" command except the task parameters +are not modified. It is used to list observatory parameters. It is also +use with the special observatory identifications to list the entries in +an observatory database and verify the observatory to be used by +tasks which do not operate on images. The special value "?" lists +the entries in the database. The special value "observatory" lists +the observatory defined by the "observatory" environment variable or +that given by the \fIobservatory.observatory\fR parameter. The special +value "obspars" simply lists the observatory task parameters. + +The "images" command lists the observatory information applicable to +one or more images. In particular, the observatory identification is +first sought in OBSERVAT image header keyword and, if not found, the +\fIobsid\fR parameter is used. Often the default observatory is +"observatory" to follow the same search path used by other tasks. + +The \fIverbose\fR parameter prints additional detailed information. It +prints the database used and whether it is selected by default +(noao$lib/obsdb.dat) or by the "obsdb" environment variable. When the +observatory is defined as "observatory" it indicates whether the +observatory is defined by the environment variable "observatory" or by the +observatory task. When listing images it prints the OBSERVAT keyword or +the default observatory assigned. + +For observatories not in a database the name, latitude, longitude, +altitude, and time zone parameters may be set using \fBeparam\fR. +The observatory id must be set to "obspars" in this case. +These parameters will then be referenced by other tasks in which +the observatory is specified as "obspars". This allows arbitrary +observatory parameters to be set without creating or modifying +an observatory database. However, it is advisable to create a +local database and also send the observatory information to the +IRAF group at NOAO for inclusion in the default database. +.ih +EXAMPLES +1. List the observatory entries in the database: + +.nf + cl> observatory list ? v+ + Using default observatory database: noao$lib/obsdb.dat + + default: Kitt Peak National Observatory + kpno: Kitt Peak National Observatory + ctio: Cerro Tololo Interamerican Observatory + eso: European Southern Observatory + lick: Lick Observatory + mmt: Whipple Observatory + cfht: Canada-France-Hawaii Telescope + lapalma: Roque de los Mucachos, La Palma +.fi + +2. Set the observatory parameters for Cerro Tololo: + +.nf + cl> observatory set ctio + Observatory parameters for Cerro Tololo... + observatory = ctio + timezone = 5 + altitude = 2215. + latitude = -30:09.9 + longitude = 70:48.9 + name = 'Cerro Tololo Interamerican Observatory' + cl> lpar observatory + command = "set" Command (set|list|images) + argument = ctio Observatory or images + (observatory = "ctio") Observatory identification + (name = "Cerro Tololo...") Observatory name + (longitude = 70.815) Observatory longitude (degrees) + (latitude = -30.165) Observatory latitude (degrees) + (altitude = 2215.) Observatory altitude (meters) + (timezone = 4) Observatory time zone + (verbose = no) Verbose output? + (mode = "q") +.fi + +3. Set the observatory parameters to use the environment variable +"observatory" and verify it. + +.nf + cl> set observatory=cfht + cl> observatory list observatory + Observatory parameters for Canada-France-Hawaii Telescope + observatory = cfht + timezone = 10 + altitude = 4215 + latitude = 19:49.6 + longitude = 155:28.3 + name = 'Canada-France-Hawaii Telescope' +.fi + +4. Change the default observatory database and verify verbosely: + +.nf + cl> set observatory="sco" + cl> set obsdb="/local/iraf/obsdb.dat" + cl> type obsdb$ + # Local Observatory Parameters. + + observatory = "sco" + name = "Small College Observatory" + longitude = 100:20.0 + latitude = 35:58.8 + altitude = 212. + timezone = 6 + cl> observ set observatory v+ + Using database defined by 'obsdb' environment variable: + /tmp/test/obsdb.dat + Using obs... defined by 'obs...' environment variable: sco + Using observatory parameters for database entry: sco + Observatory parameters for Small College Observatory + observatory = sco + timezone = 6 + altitude = 212. + latitude = 35:58.8 + longitude = 100:20.0 + name = 'Small College Observatory' +.fi + +5. List the observatory assigned to some images with a default observatory +determined either by the "observatory" environment variable or that set +in the observatory task. + +.nf + cl> observ images observatory dev$pix,demoobj1 + Observatory parameters for Small College Observatory + observatory = sco + timezone = 6 + altitude = 212. + latitude = 35:58.8 + longitude = 100:20.0 + name = 'Small College Observatory' + Images: dev$pix (default observatory) + Observatory parameters for Kitt Peak National Observatory + observatory = kpno + timezone = 7 + altitude = 2120. + latitude = 31:58.8 + longitude = 111:36.0 + name = 'Kitt Peak National Observatory' + Images: demoobj1 (OBSERVAT keyword) + +.fi + +6. Set explicit observatory parameters: + +.nf + cl> epar observatory + <set observatory parameters> + cl> observ list obspars + Observatory parameters for North Pole + observatory = obspars + timezone = 0 + altitude = 0. + latitude = 90. + longitude = 0. + name = 'North Pole' +.fi + +7. Use observatory parameters in expressions: + +.nf + cl> observ set kpno + Observatory parameters for Kitt Peak National Observatory + observatory = kpno + timezone = 7 + altitude = 2120. + latitude = 31:58.8 + longitude = 111:36.0 + name = 'Kitt Peak National Observatory' + cl> = observ.lat + 31.98 + cl> = sin (3.14159/180 * observ.lat) + 0.52962280742153 +.fi +.ih +SEE ALSO +Tasks in astutil, imred, onedspec, and twodspec. +.endhelp diff --git a/noao/astutil/doc/pdm.hlp b/noao/astutil/doc/pdm.hlp new file mode 100644 index 00000000..51b24d5f --- /dev/null +++ b/noao/astutil/doc/pdm.hlp @@ -0,0 +1,372 @@ +.help pdm May87 noao.astutil +.ih +NAME +pdm -- Find periods in lightcurve data. +.ih +USAGE +pdm infile +.ih +PARAMETERS + +.ls infiles +Input file template. If more than one file matches the template, data +from all the files will be concatenated to produce the working data set. +.le +.ls metafile = "pdmmeta" +File in which to store metacode when running in batch mode. All of the +plots saved will be put here with formfeeds between them. +.le +.ls batchfile = "pdmbatch" +File in which to store information about the period, amplitude, epoch +and fit function when running in batch mode. +.le +.ls device = "stdgraph" +The output device for interactive graphics. +.le +.ls interactive = yes +Interactive flag. If set to no, the analysis is done in batch mode with output +to a file and no interactive graphics. Metacode will be saved for the data +plot, the theta plot, and the phase plot. If set to yes, various types of +plots can be made on the user's terminal and cursor commands are available. +.le +.ls flip = no +Flag to tell the program to flip the y-axis. This is useful when the y-scale +is in magnitudes (decreasing numbers mean increasing brightness). +.le +.ls minp = 0 +Minimum period to be searched. This parameter, if set, tells the program +the bottom end of the period window to be searched. If not set, the +program uses as a value the smallest chronological distance between +any two adjacent data points. When the program is run, it writes a value +into this parameter as stored in the uparm directory. This means the +next time the program is run, the default minp will be the value assigned +or calculated the last time the program was run by this user. We say the +program 'remembers' the last value used. +.le +.ls maxp = 0 +Maximum period to be searched. This parameter, if set, tells the program +the top end of the period window to be searched. If not set, the program +uses as a value 4 times the distance between the first and last data +point. This parameter is remembered as minp is. +.le +.ls ntheta = 200 +Resolution of the theta plot. This parameter tells how many points in +the period window should have their theta statistic calculated. The points +are spaced equidistant from one another in frequency space. +.le +.ls pluspoint = 50 +Maximum number of data points for which to use plus symbols. If there +are more data points then points are plotted. +.le +.ls autoranges = no +This flag, when set, instructs the program to look for gaps in +the data and, if large gaps are found, divide the data up into ranges +discarding the gaps and doing the analysis only on the ranges. This +helps remove side lobes from the spectra. +.le +.ls nsigma = 3 +Number of standard deviations for autorange break. If ranges are to +be automatically calculated, this parameter tells how large a gap in +the data should constitute a division between ranges. The mean +and standard deviation of the distribution of chronological spacing +of input points are calculated. Then the points are scanned in +increasing order and if an inter-data gap bigger than nsigma +standard deviations is found, a new range is started. +.le +.ls cursor = "stdgcur" +The source of graphics cursor input. +.le +.ih +DESCRIPTION +Pdm applies a phase dispersion minimization algorithm (R. F. Stellingwerf, +"Period Determination by Phase Dispersion Minimization", ApJ 224, 1978, +953) to lightcurve data to determine periodicities in the data. It also +calculates amplitude and epoch information. + +Pdm can be used in batch or interactive mode. In batch +mode the +output is period, amplitude, and epoch for the minimum found within +the period window. Metacode will be produced for the data plot, +the theta statistic plot, and the phasecurve plot. +The metacode will be saved in the metafile. In interactive mode the user +can plot the data at different stages in the analysis, fit and remove +curves from the data, reject points, set data ranges, plot and fit +phasecurves, etc. + +Pdm guesses at the period/frequency window to be searched unless +the minimum +and maximum period for the window are specified using minp and maxp. The +minimum period is taken as twice the chronological distance between the closest +two points in the data. The maximum period is taken as 4 times the distance +between the first and last data points. + +Pdm will work on one object at a time and the input data may +be contained in multiple input files if desired. The program will +concatenate data in all the files which match the input template. +The input files are text files containing one (x,y) pair per line or +just a (y) value per line. If only one value per line is found the +program will number x sequentially (1,2,3,4,...). If a third value +is included on each line it will be read as the error in that +measurement. (The 'e' key is used to toggle error bars on the phase +plot.) + +At startup, if the interactive flag is set, the user will be presented +with a plot of the data and the cursor will be turned on. + +When the user plots a phasecurve, points that are deleted or undeleted from +the phasecurve plot will be deleted or undeleted from the working data set. + +The ICFIT keystrokes are described elsewhere. (see help for icfit) + + +Phase Dispersion Minimization User Interface (keystrokes) + +When the program starts up it reads the data file(s) and displays +the data on the screen as a standard mark plot. The user is +then placed in a graphics cursor loop with the following options +available in addition to the standard graphics commands: + +Note: +The remembered period is for the last minimum found. This +minimum calculation is done whenever a new theta plot is graphed +and whenever the "m" key is used. + +.ls ? -- list options + +Print out the menu. +.le +.ls h -- graph data + +Make a plot on the screen, using marks, of observation time vs observed +value. If there are more than 50 points, use dots, else use pluses. If +points have been deleted, draw an x through them on the plot. If ranges +are in effect, draw range bars along the abscissa of the plot marking +the ranges. +.le +.ls e -- toggle error bars on or off + +When the phase plot is on the screen and error data has been supplied, +this key will toggle the drawing of error bars on the phase plot so that +the user can determine how well the period found works with the data +including this error information. +.le +.ls i,k -- graph frequency or period respectively versus theta + +Calculate the theta statistic in the period/frequency range specified +previously. If no period/frequency range has been specified, +pdm guesses one. The minimum period is taken as twice the chronological +distance between the closest two points in the data. The maximum +period is taken as 4 times the distance between the first and last +data points. The number of theta points in this range is also a +parameter which can be specified. + +Next, plot theta on the screen using line drawing mode. Plot +either period vs theta or frequency vs theta. Calculate the minimum +value of theta displayed, turn the cursor back on (clgcur) and put +the cursor x position at that minimum. +.le +.ls p -- graph phase curve for period/frequency at cursor position + +Calculate the phase curve for the period/frequency under the +cursor. This assumes the user has a theta plot on the screen and +an error message will be given otherwise. + +The phase curve will be plotted in mark mode with two copies displayed +and placed end to end to clarify the plot by providing continuity at +all phases. The amplitude and epoch values for this period are calculated +and the phases are plotted relative to this epoch. +.le +.ls d,u -- delete/undelete respectively point nearest the cursor + +Points deleted will have an x drawn through them. The x will be +erased when the point is undeleted. +.le +.ls f -- call ICFIT on displayed data + +ICFIT is used for interactive curve fitting. +It is called with either the data values or the phase values, +depending on which type of plot is on the screen at the time. +Any point deleted in ICFIT will be removed from consideration in +all subsequent calculations until restored. + +The fit curve is retained by PDM after the return from ICFIT and +may be subsequently subtracted from the data using the j command. + +Note: The user must exit ICFIT using the q key before he is placed +back into PDM. +.le +.ls j -- subtract fit from data, use residuals + +Just as it says. The original data is retained and can be reinstated +with the :origdata command. This command only applies to the data. +The user cannot subtract a fit from the phase plot. +.le +.ls s -- set sample range for calculations + +This command is used to set ranges of data to be used. The cursor is +first positioned to the beginning of the range of interest, an s is +struck, the program prints the prompt again:, the cursor is +repositioned to the end of the range and a second s is struck +completing the command. Multiple ranges may be set and all the data +inside the union of the ranges will be used. Data points outside the +ranges will be ignored until the data is reset with an :alldata +or an :origdata command. + +This also forces the boolean flag segments to be set true. +.le +.ls ,, -- Set minp or minf to cursor x position + +When the theta plot is on the screen, this keystroke can be used +to set the minimum period (frequency) to the current cursor position. +.le +.ls . -- Set maxp or maxf to cursor x position + +When the theta plot is on the screen, this keystroke can be used +to set the maximum period (frequency) to the current cursor position. +.le +.ls g -- significance of theta at cursor x position + +The statistical significance of the period/frequency under the +cursor is calculated by Fisher's method of randomization. +This value is printed at the bottom of the screen. + +This assumes that a theta plot is on the screen. +.le +.ls a -- amplitude and epoch at cursor x position + +For the period/frequency under the cursor or of the plot, the amplitude +and epoch are calculated and returned to the user. + +This assumes that a theta plot is on the screen. +.le +.ls m -- mark range and find minimum in this range + +This command is used exactly like the s command but has a different +effect. After the user has positioned the cursor and struck the m +key twice, defining the range, the minimum value of theta is found +in this range and its associated period/frequency is returned. +.le +.ls r -- replot + +Redraw the plot on the screen. +.le +.ls x -- remove a trend from the data by removing a bestfit line + +This command calls the curfit package to fit a straight line to the +data and then subtracts it point by point from the data. +.le +.ls z -- flip the y-axis scale + +This command toggles a y-axis flip for the plots. This is useful when +the user is plotting magnitudes where the smaller the ordinate value the +larger the intensity. +.le +.ls q -- quit + +Exit PDM. + +.le +The following commands may be abbreviated. If entered without an +argument; :minp, :maxp, :minf, :maxf, and :ntheta will display the named +parameter; :show, :vshow will print to STDOUT; :signif, :ampep, and :phase, +will do the calculation at the remembered period. + +.ls :show [file] show parameter settings + +Print on the screen the min/max period, the remembered minimum, +the range if it is in effect, the start and end of the ranges +if they are defined, the mean and variance of the data in each +range. If file is specified, the output will go there. +.le +.ls :vshow [file] show verbose information + +This command will display all the information displayed by the :show +command plus curfit information if the any curves have been fit. Also, +the residual data will be shown if residuals have been calculated. If +file is specified, the output will go there. +.le +.nf + +:minp :maxp [period] set min/max search period +:minf :maxf [frequency] set min/max search frequency +.fi +.ls +These commands are self explanatory. Whichever value is set, +period or frequency, the corresponding frequency or period is +automatically calculated and remembered. +.le +.ls :ntheta [num] set number of points for theta + +Set the number of equally spaced points in the period window for +which theta should be calculated. This is really a setting of +the resolution of the theta plot and defaults to 200 since +the calculation time for 200 points is only a few seconds. Very +large numbers entered here will cause the program to warn the user +that the theta calculation may take some time. +.le +.ls :sample [value] set/show the sample ranges + +The start and end values for the ranges will be printed on the screen. +If value is present, it has the form begin:end where begin +and end are real numbers specifying a new range. +.le +.ls :signif [period] find theta significance + +Same as the g key. The colon command allows the user to +set the period exactly, instead of using the cursor. If no period +is entered, the calculation will be done using the remembered period. +.le +.ls :ampep [period] amplitude and epoch + +Same as the e key. Without an argument, use remembered minima. +.le +.ls :phase [period] graph phase curve + +Same as the h key. Without an argument, use remembered minima. +.le +.ls :unreject unreject all points + +This tells the program to use all of the data points. If a fit +has been subtracted from a subset of the data points then this command +causes the original data set to be restored since, otherwise, we would +restore a mixture of data and residuals. +.le +.ls :alldata reset range to entire dataset + +The effect of this command is to turn off the range settings. All +of the data will be used if the ranges settings are off. Rejected +points remain rejected though. Again, if these data are residuals, +the original data are restored. +.le +.ls :origdata reset data to original dataset + +Copy the original data vector into the working data vector. +.le +.ih +EXAMPLES +1. To find the main period in the data contained in the file 'vstar645', +whose period is within the bounds (200., 800.) interactively +the command might be: + + cl> pdm vstar645 minp=200. maxp=800. + +2. To do the same thing in batch mode, allowing the program to guess the +period window, with no lightcurve analysis, and saving the metacode +in vstar645.m, the command might be: + + cl> pdm vstar645 inter=no meta="vstar645.m" + +.ih +BUGS +Pdm has some problems with data sets containing a small number (<20) +points. Generally, it will do fairly well but the theta curve may look +strange. + +The amplitude and epoch calculation might be improved by fitting a parabola +to the phase curve near the minimum and near the maximum and using points +on these parabolas for the min and max points instead of actual data points. + +.ih +SEE ALSO +icfit +.endhelp diff --git a/noao/astutil/doc/precess.hlp b/noao/astutil/doc/precess.hlp new file mode 100644 index 00000000..64475c56 --- /dev/null +++ b/noao/astutil/doc/precess.hlp @@ -0,0 +1,63 @@ +.help precess Oct87 noao.astutil +.ih +NAME +precess -- general astronomical coordinate precession +.ih +USAGE +precess files startyear endyear +.ih +PARAMETERS +.ls files +The name of a file (or a file list or template) containing the coordinates +to be precessed. +.le +.ls startyear +The default equinox of the input coordinates. +.le +.ls endyear +The default target year to which the coordinates will be precessed. +.le +.ls stdepoch = 0 +If nonzero, coordinates will be output precessed to both \fBendyear\fR +and the specified standard epoch. +.le +.ih +DESCRIPTION +Coordinates are read from the input file as RA and DEC pairs, +one pair per input line. Each coordinate pair may optionally be followed +by the equinox of the input coordinates (if different from the default) +and the epoch of the output coordinates. +Coordinates may be entered in either decimal or sexagesimal notation. +The given coordinates are rotated according to the +precession rates to the requested year and printed on the standard output. +Basic data is taken from the Explanation to the American Ephemeris. +.ih +EXAMPLES +Precess coordinate entered interactively from 1950 to 1990, except where +the dates are specified otherwise on the command line (lines input by the +user are marked: + +.nf + cl> precess STDIN 1950 1990 [input] + 12:30:10.12 10:18:27.5 [input] + 12:32:11.79 10:05:13.09 1990.0 + 12:30 10:18 [input] + 12:32:01.68 10:04:45.51 1990.0 + 12:30 -20 1900 [input] + 12:34:42.89 -20:29:46.29 1990.0 + 12:30 -20 1900 2000 [input] + 12:35:14.40 -20:33:04.40 2000.0 + (eof=<ctrl/z>) [input] +.fi + +The following is equivalent, except that coordinate input is taken from +the file "coords", rather than from the terminal: + +.nf + cl> precess coords 1950 1990 [input] + 12:32:11.79 10:05:13.09 1990.0 + 12:32:01.68 10:04:45.51 1990.0 + 12:34:42.89 -20:29:46.29 1990.0 + 12:35:14.40 -20:33:04.40 2000.0 +.fi +.endhelp diff --git a/noao/astutil/doc/rvcorrect.hlp b/noao/astutil/doc/rvcorrect.hlp new file mode 100644 index 00000000..0609e725 --- /dev/null +++ b/noao/astutil/doc/rvcorrect.hlp @@ -0,0 +1,373 @@ +.help rvcorrect Nov90 astutil +.ih +NAME +rvcorrect -- Compute radial velocity corrections +.ih +USAGE +rvcorrect +.ih +PARAMETERS +.ls files = "" +List of files containing date, time, coordinates of observation, and possibly +an observed radial velocity. +.le +.ls images = "" +List of images containing date, time, coordinates of observation, and possibly +an observed radial velocity. +.le +.ls header = yes +Print header for output? +.le +.ls input = no +Print input data in output? +.le +.ls imupdate = no +Update the image header with the computed values of heliocentric correction +(in the \fIVHELIO\fR keyword), Heliocentric Julian Date (in the \fIHJD\fR +keyword), Local Standard of Rest velocity (in the \fIVLSR\fR keyword), and +information describing the solar motion with respect to the desired standard +of rest (in the \fIVSUN\fR keyword). +.le + +.ls epoch = INDEF +Epoch of observation coordinates in Julian years. If zero or INDEF then the +epoch is assumed to be the same as the date of observation. +.le +.ls observatory = ")_.observatory" +Observatory for which corrections are to be computed. The default is a +redirection to look in the parameters for the parent package for a value. +This may be one of the observatories in the observatory database, +"observatory" to select the observatory defined by the environment variable +"observatory" or the parameter \fBobservatory.observatory\fR, or "obspars" +to select the current parameters set in the \fBobservatory\fR task. See +help for \fBobservatory\fR for additional information. If the input +consists of images then the observatory is defined by the OBSERVAT keyword +if present. +.le +.ls vsun = 20. +Velocity in km/s of the sun relative to the desired standard of rest. The +default is for the Local Standard of Rest (LSR). +.le +.ls ra_vsun = 18:00:00 +Right ascension in hours of the solar motion relative to the desired standard +of rest. The default is for the Local Standard of Rest (LSR). +.le +.ls dec_vsun = 30:00:00 +Declination in degrees of the solar motion relative to the desired standard +of rest. The default is for the Local Standard of Rest (LSR). +.le +.ls epoch_vsun = 1900. +Epoch in years for the solar motion components. +.le + +If no input files or images are specified then the following parameters +are used for input. +.ls year, month, day, ut +Date and time of observation. If the year is less than 100 then the century is +assumed to be 1900. The month is specified as an integer between 1 and 12. +The date of observation is the Greenwich date; i.e. the new day begins at +0 hours universal time. Universal time of observation in hours. +.le +.ls ra , dec +Right ascension (hours) and declination (degrees) of observation. +.le +.ls vobs = 0. +Observed velocity (km/s) to be corrected. +.le +.ls keywpars = "" +The image header keyword translation table as described in +the \fIkeywpars\fR named pset. +.le + +If no input files or images are specified the following parameters are +set by the task. +.ls hjd +Heliocentric Julian date. The date of observation is corrected for +light travel difference to the sun. +.le +.ls vhelio +Heliocentric radial velocity in km/s. The observed velocity is corrected +for the rotation of the Earth, the motion of the Earth about the Earth-Moon +barycenter, and the orbit of the barycenter about the Sun. +.le +.ls vlsr +Local standard of rest radial velocity in km/s. +The heliocentric radial velocity is corrected for the motion of the Sun +relative to the specified standard of rest. +.le +.ih +DESCRIPTION +The observed radial velocity is corrected for the motion of the +observer in the direction of the observation. The components of the +observer's motion corrected are those due to the Earth's rotation +(diurnal velocity), the motion of the Earth's center about the +Earth-Moon barycenter (lunar velocity), the motion of the Earth-Moon +barycenter about the center of the Sun (annual velocity), and the +motion of the Sun (solar velocity) relative to some specified standard +of rest. + +The input parameters consist of the date and time of the observation, the +direction of observation, the location of the observation, the direction +and magnitude of the solar motion relative to some standard of rest, and +the observed radial velocity. In all cases years between 0 and 99 are +treated as 20th century years. The observatory for the observations +defaults to that specified by the environment variable "observatory" if +defined or that set for the task \fBobservatory\fR. If the input consists +of images the observatory is defined by the OBSERVAT image header parameter +if present. See \fBovservatory\fR for additional information. The solar +motion defaults to that relative to the galactic local standard of rest +(LSR). Note that one can make the local standard of rest velocity be +equivalent to the heliocentric velocity by setting the velocity of the +solar motion to zero. + +The observed velocity, date, time, and direction of observation may be +specified in three ways; from files, images, or the task parameters. If a +list of files is given then the files are read for the observation +parameters. The format of the files is lines containing the year, month +(as an integer), day, universal time, right ascension, declination, +(optional) coordinate epoch, and (optional) observed radial velocity. If +no file list is specified but a list of images is given then the +observation parameters are determined from the image header parameters +specified through the keywpars parameters. If the observation date +includes the time then it is used in preference to universal time keyword. +Finally, if no list of files or images is given then the task parameters +are used. If no observed radial velocity is given in the file list or +found in the image header then a value of zero is assumed. In this case +the corrected velocities are interpreted as the corrections to be added to +a measured velocity to correct to the desired standard of rest. + +The results of the radial velocity calculations are output in three +ways. The velocities are always printed on the standard output with an +optional header. If the observation parameters are set with the task +parameters (no file or image list) then the results are also stored in +the parameter file. This mechanism allows the task to be used easily +in a script and to obtain greater precision. If the observation +parameters are taken from the image headers and the \fIimupdate\fR +parameter is set, then the heliocentric +Julian day is recorded as HJD, the heliocentric velocity as VHELIO, +the LSR velocity as VLSR, and the velocity, ra and dec, and epoch +of the solar motion used in VLSR is recorded as VSUN. + +The printed output may include the input data if desired. This produces two +lines per observation, one for the input data and one for the output +velocities. The calculated data consists of the heliocentric Julian +date, the observed velocity, the observed heliocentric velocity, and +the observed local standard of rest velocity. Following this are +component corrections for the diurnal, lunar, annual, and solar +velocities. +.ih +DIURNAL VELOCITY +The geodetic latitude to geocentric latitude correction is given by + +.nf + dlat = -(11. * 60. + 32.743000) * sin (2*lat) + + 1.163300 * sin (4*lat) - 0.002600 * sin (6*lat) +.fi + +where lat is the geodetic latitude and dlat is the additive correction. +The distance, r, of the observer from the Earth's center in meters is given by + +.nf + r = 6378160.0 * (0.998327073 + 0.00167643800 * cos(2*lat) - + 0.00000351 * cos(4*lat) + 0.000000008 * cos(6*lat)) + + altitude +.fi + +where lat is the corrected latitude and altitude is the altitude above +sea level. The rotational velocity (perpendicular to the radius vector) +in km/s is given by + + v = TWOPI * (r / 1000.) / (23.934469591229 * 3600.) + +where 23.934469591229 is the sidereal day in hours for 1986 and TWOPI is the +ratio of the circumference to the radius of a circle. The projection of +this velocity along the line of sight is + + vdiurnal = v * cos (lat) * cos (dec) * sin (ra-lmst) + +where lmst is the local mean sidereal time. +.ih +BARYCENTRIC VELOCITY +The orbital elements of the lunar orbit are computed from the following +interpolation formulas + +.nf + t = (JD - 2415020) / 36525. + + oblq = 23.452294-t*(0.0130125+t*(0.00000164-t*0.000000503)) + omega = 259.183275-t*(1934.142008+t*(0.002078+t*0.000002)) + mlong = 270.434164+t*(481267.88315+t*(-0.001133+t*0.0000019))- + omega + lperi = 334.329556+t*(4069.034029-t*(0.010325+t*0.000012))- + omega + em = 0.054900489 + inclin = 5.1453964 +.fi + +where t is the time from the Julian day 2415020 (~J1900) in Julian centuries, +oblq is the mean obliquity of the ecliptic, omega is the longitude of the mean +ascending node, mlong is the mean lunar longitude, lperi is the mean lunar +longitude of perigee, em is the eccentricity of the lunar orbit, and inclin +is the inclination of the orbit to the ecliptic. The true lunar longitude, +tlong, is computed from the mean longitude using the correction for the mean +anomaly to the true anomaly (radians) + +.nf + manom = mlong - lperi + tanom = manom + (2 * em - 0.25 * em**3) * sin (manom) + + 1.25 * em**2 * sin (2 * manom) + 13/12 * em**3 * + sin (3 * manom) + tlong = tanom + lperi +.fi + +The velocity of the Moon around the Earth's center in the plane of the orbit +in km/s is + +.nf + vmoon = (TWOPI * 384403.12040) / (27.321661 * 86400) / + sqrt (1. - em**2) +.fi + +where 384403.12040 is the mean lunar distance (km) and 27.321661 is the mean +lunar month (days). The component along the line to the observation is + + v = vmoon * cos (bm) * (sin (tlong-lm) - em*sin (lperi-lm)) + +where lm and bm are the longitude and latitude of the observation +along the lunar orbital plane relative to the ascending node using a standard +coordinate transformation. The barycentric velocity is that reduced by +the ratio of the Earth's mass to the Moon's mass. + + vlunar = v / 81.53 +.ih +ANNUAL VELOCITY +The orbital elements of the Earth's orbit are computed from the following +interpolation formulas + +.nf + t = (ast_julday (epoch) - 2415020) / 36525. + + manom = 358.47583+t*(35999.04975-t*(0.000150+t*0.000003)) + oblq = 23.452294-t*(0.0130125+t*(0.00000164-t*0.000000503)) + lperi = 101.22083+t*(1.7191733+t*(0.000453+t*0.000003)) + eccen = 0.01675104-t*(0.00004180+t*0.000000126) +.fi + +where t is the time from the Julian day 2415020 (~J1900) in Julian centuries, +manom is the mean anomaly (degrees), oblq is the mean obliquity of the ecliptic +(degrees), lperi is the mean longitude of perihelion (degrees), and +eccen is the eccentricity of the orbit. The true anomaly (radians) is +obtained from the mean anomaly (radians) by + +.nf + tanom = manom + (2 * eccen - 0.25 * eccen**3) * sin (manom) + + 1.25 * eccen**2 * sin (2 * manom) + + 13./12. * eccen**3 * sin (3 * manom) +.fi + +The orbital velocity of the Earth-Moon barycenter perpendicular to +the radius vector is given by + +.nf + v = ((TWOPI * 149598500.) / (365.2564 * 86400.)) / + sqrt (1. - eccen**2) +.fi + +where the semi-major axis is 149598500 km and the year is 365.2564 days. +To compute the projection of this velocity along the line of observation +the direction of observation (precessed to the epoch of observation) +is converted into ecliptic latitude and +longitude, l and b, measured from the point of the ascending node using +a standard spherical coordinate transformation. The component is then + + vannual = v * cos(b) * (sin(slong-l) - eccen*sin(lperi-l)) + +where the longitude of the Sun as seen from the Earth, slong, is given by + + slong = lperi + tanom + 180 +.ih +SOLAR MOTION +The solar motion is computed by precessing the coordinates of the solar +motion to the observation epoch and taking the appropriate component +along the line of sight. +.ih +ACCURACY +The calculations are done using IRAF double precision. +No correction is made for the perturbation of the other planets. The +precession does not include nutation. The interpolation formulas are +only approximations. The accuracy of the heliocentric +velocity are better than a 0.005 of a kilometer per second. +Relative velocities over short intervals are even better. +.ih +EXAMPLES +1. For use directly without data files or images there are two common modes. +Because of the large number of parameters the parameter values are often +set using the task \fBeparam\fR. Then simply execute the command + + cl> rvcorrect + +2. To set some of the parameters on the command line + + cl> rvcorrect ra=12:22:1.116 dec=15:55:16.244 ut=5:30 + +3. To use a text file generate a file containing the year, month, day, ut, +ra, and dec with one observation per line. + +.nf +cl> type rv.obs +1987 10 21 11:00:24 3:36:15 0:22:04 +1987 10 21 11:08:00 8:19:35 -0:51:35 +1987 10 21 11:15:47 8:35:12 6:40:29 +1987 10 21 12:12:10 9:13:20 61:28:49 +1987 10 21 12:16:03 9:27:48 9:07:08 +1987 10 21 12:20:43 9:50:45 -6:06:58 +1979 3 25 11:22:59 16:07:28 -23:37:49 0 -67.5 +cl> rvcorrect f=rv.obs > rv.dat +cl> type rv.dat +## HJD VOBS VHELIO VLSR VDIURNAL VLUNAR VANNUAL VSOLAR +2447089.96358 0.00 11.07 -2.74 -0.189 0.008 11.246 -13.808 +2447089.96296 0.00 28.05 13.56 0.253 0.010 27.790 -14.498 +2447089.96813 0.00 29.04 16.64 0.262 0.011 28.770 -12.401 +2447090.00834 0.00 22.06 25.26 0.114 0.010 21.940 3.200 +2447090.00884 0.00 27.70 18.55 0.250 0.009 27.438 -9.152 +2447090.01129 0.00 23.99 13.50 0.275 0.007 23.704 -10.484 +2443957.97716 -67.50 -41.37 -31.48 0.002 0.012 26.117 9.884 +.fi + +4. To use observation parameters from a set of images the command is + + cl> rvcorrect images=hz44.001,aboo.001 > rv.dat + +5. A CL loop can be used to compute a table in which one parameter varies. + +.nf + cl> for (x=0.; x<=12.; x=x+1) + >>> rvcorrect (ut=x, header=no) +.fi + +6. To get the total velocity correction in a script the following may be done. + +.nf + rvcorrect (vobs=12.3, ra=12:33, dec=30:22, ut=5:30, > "dev$null") + vlsr = rvcorrect.vlsr +.fi + +Note that this does not work when the task is run as a background job! +.ih +REVISIONS +.ls RVCORRECT V2.11.4 +The ut keyword can be in either date plus time or hours. +.le +.ls RVCORRECT V2.11 +Y2K update: The date keyword can be in the full format with full +year and time. The time takes precedence over a time keyword. +.le +.ih +ACKNOWLEDGMENTS +Some of the formulas used were obtained by inspection of the code +for the subroutine DOP in the program DOPSET written by R. N. Manchester +and M. A. Gordon of NRAO dated January 1970. +.ih +SEE ALSO +observatory, asttimes +.endhelp diff --git a/noao/astutil/doc/setairmass.hlp b/noao/astutil/doc/setairmass.hlp new file mode 100644 index 00000000..bbb1cbb8 --- /dev/null +++ b/noao/astutil/doc/setairmass.hlp @@ -0,0 +1,243 @@ +.help setairmass Nov00 astutil +.ih +NAME +setairmass -- update image headers with the effective airmass +.ih +USAGE +setairmass images +.ih +PARAMETERS +.ls images +The list of images for which to calculate the airmass. The image headers may +optionally be updated with the airmass and the mid-UT of the exposure. +.le +.ls observatory = ")_.observatory" +Observatory for which airmasses are to be computed if the observatory is not +specified in the image header by the keyword OBSERVAT. The default is a +redirection to look in the parameters for the parent package for a value. The +observatory may be one of the observatories in the observatory database, +"observatory" to select the observatory defined by the environment variable +"observatory" or the parameter \fBobservatory.observatory\fR, or "obspars" to +select the current parameters set in the \fBobservatory\fR task. See help for +\fBobservatory\fR for additional information. If the input consists of images +then the observatory is defined by the OBSERVAT keyword if present. +.le +.ls intype = "beginning" +The time stamp of the observation as recorded at the telescope for the time +dependent header keywords. The choices are the "beginning", "middle" or "end" +of the observation. +.le +.ls outtype = "effective" +The output time stamp desired for the airmass. The choices are the "effective" +airmass, or the airmass at the "beginning", "middle" or "end" of the +observation. +.le +.ls ra = "ra" +The name of the keyword that contains the right ascension. The right ascension +is assumed to be in hours unless ra is one of the standard CRVALn keywords in +which case it is assumed to be in degrees. +.le +.ls dec = "dec" +The name of the keyword that contains the declination in degrees. +.le +.ls equinox = "epoch" +The name of the keyword that contains the equinox of the right ascension and +declination coordinates in years. +.le +.ls st = "st" +The name of the keyword containing the sidereal time in hours. +.le +.ls ut = "ut" +The name of the keyword containing the ut time. This keyword can either +be in date plus time format or in hours. Note that this allows setting +both the "date-obs" and "ut". If no time is found then +a time of 0hrs is used. +.le +.ls date = "date-obs" +The name of the keyword that contains the UT date of the observation. The +format should be `DD/MM/YY' (old FITS format), YYYY-MM-DD (new FITS format), +or YYYY-MM-DDTHH:MM:SS (new FITS format with time). If there is a time +and no time is found in the ut keyword then it is used for the ut. +.le +.ls exposure = "exptime" +The name of the keyword that contains the exposure time (in seconds) of the +image. +.le +.ls airmass = "airmass" +The name of the output keyword that will receive the computed airmass. +.le +.ls utmiddle = "utmiddle" +The name of the output keyword that will receive the universal time for +the middle of the observation. The format of the keyword will be the same +as that specifying the universal time. +.le +.ls scale = 750.0 +The atmospheric scale height. +.le +.ls show = yes +Print the airmasses and mid-UT's for each image? +.le +.ls update = yes +Update the image headers with the airmasses and the mid-UT's? +.le +.ls override = yes +If updating the image headers, override values that were previously recorded ? +.le + +.ih +DESCRIPTION + +SETAIRMASS will calculate the effective airmass of an astronomical image, as +described below under "ALGORITHMS". The task requires the instantaneous +zenith distance at the beginning, middle and end of the exposure. These are +calculated using the right ascension, declination, and equinox as well as the +sidereal time, exposure time, UT date, and observatory from the image header. +If the observatory is not available in the image header under the keyword +OBSERVAT, the observatory is defined by the \fIobservatory\fR parameter. See +help for \fIobservatory\fR for further information. + +The right ascension and declination will be precessed from the given equinox to +the date of observation. The name of the right ascension, declination, equinox, +sidereal time, ut time, exposure time, and date keywords can be specified as +parameters. These keywords should express the right ascension in hours, +the declination in degrees, the equinox in years, the sidereal time in hours, +the universal time in hours, the exposure time in seconds, and the date in +FITS format. If any of the required keywords are missing from the image +headers, they can be added using the hedit or asthedit tasks. Note that +the universal time keyword may be in either a date plus time format or +in hours and any output middle universal time will be in the same format. + +Before using this task, you will need to know the "time stamp" of the time +varying header quantities (e.g. sidereal time). Do the recorded values +represent the beginning, the middle or the end of the exposure ? This should +be set in the \fBintype\fR parameter. + +If for some reason the effective airmass is not desired, the value of the +airmass at the beginning, middle or end of the exposure can be recorded in the +header keyword specified by the \fIairmass\fR parameter. The \fBshow\fR +parameter can be used to control the output to the terminal. The \fBupdate\fR +and \fBoverride\fR parameters control the header keyword output. + +SETAIRMASS will also calculate the universal time of the middle of the exposure +and place the value in the header keyword specified by the \fIutmiddle\fR +parameter. This assumes that the value for the UT is in the date keyword +or ut keyword, with the same time stamp as the sidereal time. The +mid-observation UT is useful for interpolating calibration arc dispersion +solutions using REFSPECTRA, especially when the exposure time is +long. + +.ih +ALGORITHMS +The mean airmass is calculated uses the formula described in "Some +Factors Affecting the Accuracy of Stellar Photometry with CCDs" by P. +Stetson, DAO preprint, September 1988. This simple formula is: + +.nf + AM (eff) = [AM (beginning) + 4*AM (middle) + AM (end)] / 6 +.fi + +and is derived by using Simpson's 1/3 rule to approximate the integral +that represents the mean airmass. + +The beginning, middle and end airmasses are calculated using the +relation between airmass and elevation (or zenith distance) in John +Ball's book on Algorithms for the HP-45: + +.nf + AM = sqrt (x**2 + 2*scale + 1) - x, where + + x = scale * sin(elevation) = scale * cos(ZD) +.fi + +The atmospheric scaling parameter is \fIscale\fR (see "Astrophysical +Quantities" by Allen, 1973 p.125,133). + +.ih +KEYWORDS +The input keywords are: +.ls OBSERVAT +Observatory at which the data was taken. If absent the observatory is +determined using the \fIobservatory\fR parameter. +.le +.ls \fIra\fR +Right ascension in hours at the beginning, middle, or end of the observation. +If ra is one of the CRVALn keywords it is assumed to be in degrees. +.le +.ls \fIdec\fR +Declination in degrees at the beginning, middle, or end of the observation. +.le +.ls \fIequinox\fR +The equinox of the coordinates. The right ascension and declination will +be precessed from this epoch to the date of the observation before being +used. +.le +.ls \fIst\fR +Sidereal time in hours at the beginning, middle, or end of the observation. +.le +.ls \fIut\fR +Universal time in hours at the beginning, middle, or end of the observation. +This may be in either date plus time format or just in hours. +.le +.ls \fIdate\fR +The value of the date parameter is the keyword name to be used for the date of +the observation. The date must be in either the old or new FITS format. +.le +.ls \fIexposure\fR +The value of the exposure parameter is the keyword name to be used for the +exposure time in seconds. +.le + +The output keywords are: +.ls \fIairmass\fR +The value of the airmass parameter is the keyword name to be used for +the computed airmass at either the beginning, middle, or end of the +exposure, or for the weighted effective value over the exposure. +.le +.ls \fIutmiddle\fR +The value of the utmiddle parameter is the keyword name to be used for +the universal time at the middle of the exposure. +.le + +.ih +EXAMPLES + +1. Calculate the effective airmass of the IRAF test picture, dev$pix. + +.nf + cl> setairmass dev$pix exposure=itime update- +.fi + +Note that the test picture does not have the correct coordinate epoch +listed in its header, so no precession will be performed. + +2. Calculate the effective airmass of the IRAF test picture dev$ypix in two +ways. + +.nf + cl> setairmass dev$ypix exposure=itime update- + + cl> setairmass dev$ypix ra=crval1 dec=crval2 equinox=equinox \ + exposure=itime update- +.fi + +Note the first way gives the same results as example 1. The second way +uses the J2000 equatorial system rather then the ra and dec at the time +of observation. + +.ih +REVISIONS +.ls SETAIRMASS V2.11.4 +The ut keyword now has precedence over any time in the date keyword +and it can be either date plus time or hours. +.le +.ls SETAIRMASS V2.11.3 +The right ascension, declination, equinox, st, and ut keywords were made +parameters rather than being hard wired. +.le +.ls SETAIRMASS V2.11.2 +Y2K update: This task was updated to use the new FITS date format. +.le +.ih +SEE ALSO +airmass, hedit, refspectra, observatory +.endhelp diff --git a/noao/astutil/doc/setjd.hlp b/noao/astutil/doc/setjd.hlp new file mode 100644 index 00000000..c010d533 --- /dev/null +++ b/noao/astutil/doc/setjd.hlp @@ -0,0 +1,222 @@ +.help setjd Jan92 astutil +.ih +NAME +setjd -- set various Julian dates in image headers +.ih +USAGE +setjd images +.ih +PARAMETERS +.ls images +The list of images for which to compute Julian dates. If the \fIlistonly\fR +parameter is not set the image headers will be modified to add or update +the calculated Julian date values. +.le +.ls observatory = ")_.observatory" +Observatory of observation, used to define the time zone relative to +Greenwich, if not specified in the image header by the keyword OBSERVAT. +The default is a redirection to look in the parameters for the parent +package for a value. The observatory may be one of the observatories in +the observatory database, "observatory" to select the observatory defined +by the environment variable "observatory" or the parameter +\fBobservatory.observatory\fR, or "obspars" to select the current +parameters set in the \fBobservatory\fR task. See \fBobservatory\fR for +additional information. +.le +.ls date = "date-obs" +Date of observation keyword. The value must be in FITS format. +This is one of DD/MM/YY (old FITS format), YYYY-MM-DD (new FITS format), +or YYYY-MM-DDTHH:MM:SS (new FITS format with time). The date should be +in universal time though the \fIutdate\fR parameter can be used if +this is not the case. If a time is included it is used in preference +to the \fItime\fR value. +.le +.ls time = "ut" +Time of observation keyword with value given in decimal hours or HH:MM:SS.S +format. The date may be a local time or universal time as selected by the +\fIuttime\fR parameter. The time is used as is +unless an exposure time keyword is specified, in which case +the time will be corrected to the midpoint of the exposure from the +beginning or end of the exposure. This time is not used if a time +is given in the date keyword. +.le +.ls exposure = "exptime" +Exposure time keyword with value in seconds. If specified the time +is corrected to the midpoint of the exposure. The time is assumed +to be the beginning of the exposure unless +the exposure time keyword name begins with a minus sign, for example +"-exptime", in which case the time is used as the end of the exposure. +.le +.ls ra = "ra", dec = "dec", epoch = "epoch" +If the heliocentric Julian date is requested the right ascension (in hours) +and declination (in degrees) of the observation is determined from these +keywords. The values may be in either decimal or sexagesimal notation. +An epoch keyword is optional and if given is used to precess +the coordinates from the specified epoch to the observation epoch. +If an epoch keyword is given but is not found in the header or can't +be interpreted then it is an error. The epoch keyword value may begin +with 'B' or 'J'. If the value is before 1800 or after 2100 a warning +will be printed though the task will still compute the values. +.le + +.ls jd = "jd" +If specified compute the geocentric Julian day (Greenwich) at the +midpoint of the exposure and record the value in the specified +header keyword. +.le +.ls hjd = "hjd" +If specified compute the heliocentric Julian day (Greenwich) at the +midpoint of the exposure and record the value in the specified +header keyword. +.le +.ls ljd = "ljd" +If specified compute the local Julian day number. This is an integer +number which is constant for all observations made during the same night. +It may be used to group observations by night in such tasks as +\fBrefspectra\fR. +.le + +.ls utdate = yes, uttime = yes +Define whether the date and time of observation are in local standard +time or in universal time. +.le +.ls listonly = no +List the computed values only and do not modify the image headers. +When simply listing the images need not have write permission. +.le +.ih +DESCRIPTION +\fBSetjd\fR computes the geocentric, heliocentric, and integer +local Julian dates from information given in the headers of +the input list of images. This information may simply be listed or +the values may be added or modified in the image headers. Only +those values which have a keyword specified are computed, printed, +and entered in the images. Thus, one need not compute all values +and the dependent image header parameters required for computing them +need not be present. For example, if the coordinates of the +observation are not available one should set the \fIhjd\fR parameter +to an empty string. + +Often the date and time of observation are recorded either at the +beginning or the end of an exposure. To compute the Julian dates +at the midpoint of the exposure the exposure keyword is specified. +A negative sign preceding the keyword name defines correcting from +the end of the exposure otherwise the correction is from the +beginning of the exposure. The exposure time must be in seconds and +there is no allowance made for exposures which are interrupted. +See also the task \fBsetairmass\fR which may be used to compute a +universal time midexposure value. + +The date and time of observations should be given either in universal +time. However, if they are given in local standard time (there is no +provisions for daylight savings times) the \fIutdate\fR and \fIuttime\fR +parameters may be used. Conversion between local and universal times, as +well as the computation of the local integer date, requires the time zone +in (positive) hours behind Greenwich or (negative) hours ahead of +Greenwich. This information is determined from the observatory at which +the observations were made. If the observatory is specified in the image +header under the keyword OBSERVAT with a value which has an entry in the +NOAO, local, or user observatory database then the value from the database +is used. This is the safest way since the observatory is tied to the +actual image. Otherwise, the \fIobservatory\fR parameter defines the +observatory. The special value "observatory" allows defining a default +observatory with an environment variable or the \fBobservatory\fR task. +Explicitly use the parameter \fIobservatory.timezone\fR use the value +"obspars". For more information see help under \fBobservatory\fR. + +The heliocentric Julian date is computed by defining a keyword for +this value and also defining the keywords for the right ascension (in hours) +and declination (in degrees). An optional epoch keyword may be +used if the RA and DEC are not for the observation epoch. + +The local integer Julian day number is the Julian date which begins at +local noon. Thus, all observations made during a night will have the +same day number. This day number may be useful in grouping +observations by nights. Note that in some time zones the UT +date of observation may also be constant over a night. + +Among the uses for this task is to define keywords to be used by the task +\fBrefspectra\fR. In particular, the exposure midpoint geocentric Julian +date makes a good sort parameter and the local Julian day number makes a +good group parameter. +.ih +EXAMPLES +1. Compute all the Julian date quantities for 4 arc exposures with +header parameters given below. + +.nf + demoarc1: + OBSERVAT= 'KPNO ' / observatory + EXPTIME = 60. / actual integration time + DATE-OBS= '26/11/91 ' / date (dd/mm/yy) of obs. + UT = '12:11:30.00 ' / universal time + RA = '06:37:02.00 ' / right ascension + DEC = '06:09:03.00 ' / declination + EPOCH = 1991.9 / epoch of ra and dec + + demoarc2: + OBSERVAT= 'KPNO ' / observatory + EXPTIME = 60. / actual integration time + DATE-OBS= '26/11/91 ' / date (dd/mm/yy) of obs. + UT = '12:41:30.00 ' / universal time + RA = '06:37:02.00 ' / right ascension + DEC = '06:09:03.00 ' / declination + EPOCH = 1991.9 / epoch of ra and dec + + demoarc3: + OBSERVAT= 'CTIO ' / observatory + EXPTIME = 60. / actual integration time + DATE-OBS= '27/11/91 ' / date (dd/mm/yy) of obs. + UT = '11:11:30.00 ' / universal time + RA = '06:37:02.00 ' / right ascension + DEC = '06:09:03.00 ' / declination + EPOCH = 1991.9 / epoch of ra and dec + + demoarc4: + OBSERVAT= 'CTIO ' / observatory + EXPTIME = 60. / actual integration time + DATE-OBS= '27/11/91 ' / date (dd/mm/yy) of obs. + UT = '12:21:30.00 ' / universal time + RA = '06:37:02.00 ' / right ascension + DEC = '06:09:03.00 ' / declination + EPOCH = 1991.9 / epoch of ra and dec + + cl> setjd demoarc?.imh + # SETJD: Observatory parameters for Kitt Peak ... + # Image JD HJD LOCALJD + demoarc1.imh 2448587.0083 2448587.0127 2448586 + demoarc2.imh 2448587.0292 2448587.0336 2448586 + # SETJD: Observatory parameters for Cerro Tololo ... + demoarc3.imh 2448587.9667 2448587.9711 2448587 + demoarc4.imh 2448588.0153 2448588.0197 2448587 +.fi + +Note the use of the observatory parameter to switch observatories and +the local Julian day number which is constant over a night even though +the Julian date may change during the observations. + +2. To compute only the geocentric Julian date from the "DATE" and +"TIME" keywords in an image, + +.nf + cl> setjd obs1 date=date time=time exp="" hjd="" ljd="" +.fi +.ih +REVISIONS +.ls SETJD V2.11.2 +Y2K update: Updated to use the new FITS format for the date. If the +time is given in the date keyword it is used in preference to the +time keyword. +.le +.ls SETJD V2.11 +The checking of the epoch keyword value was improved. Previously if +there was a problem with the keyword value (missing or malformed) the +task would use the epoch of the observation. Now it is an error +if an epoch keyword is specified but the epoch value can't be determined. +Also a leading 'B' or 'J' is allowed and a warning will be given if +the epoch value is unlikely. +.le +.ih +SEE ALSO +setairmass, hedit, refspectra, observatory +.endhelp diff --git a/noao/astutil/galactic.par b/noao/astutil/galactic.par new file mode 100644 index 00000000..8e4bbbcc --- /dev/null +++ b/noao/astutil/galactic.par @@ -0,0 +1,3 @@ +input,f,a,STDIN,,,input files +in_coords,s,h,"equatorial","equatorial|galactic",,Input coordinates +print_coords,b,h,yes,,,Print input coords on output? diff --git a/noao/astutil/galactic.x b/noao/astutil/galactic.x new file mode 100644 index 00000000..e6b2f758 --- /dev/null +++ b/noao/astutil/galactic.x @@ -0,0 +1,165 @@ +include <fset.h> + +# T_GALACTIC -- convert between equatorial and galactic coordinates. + +procedure t_galactic () + +char fname[SZ_FNAME] +int filelist, prt_coords, in_coords +bool streq(), clgetb() +int clpopni(), clgfil(), btoi(), clgwrd() + +begin + # Input can come from the standard input, a file, or a list of files. + # The following procedure makes both cases look like a list of files. + + filelist = clpopni ("input") + + # Get output option + + in_coords = clgwrd ("in_coords", fname, SZ_FNAME, + "|equatorial|galactic|") + prt_coords = btoi (clgetb ("print_coords")) + + # Process each coordinate list. If reading from the standard input, + # set up the standard output to flush after every output line, so that + # converted coords come back immediately when working interactively. + + while (clgfil (filelist, fname, SZ_FNAME) != EOF) { + if (streq (fname, "STDIN")) + call fseti (STDOUT, F_FLUSHNL, YES) + else + call fseti (STDOUT, F_FLUSHNL, NO) + switch (in_coords) { + case 1: + call in_equatorial (STDOUT, fname, prt_coords) + case 2: + call in_galactic (STDOUT, fname, prt_coords) + } + } + + call clpcls (filelist) +end + + +# IN_EQUITORIAL -- convert a list of equatorial coordinates read from the +# named file to galactic coordinates, writing the results on the output file. + +procedure in_equatorial (out, listfile, prt_coords) + +int out # output stream +char listfile[SZ_FNAME] # input file +int prt_coords # print coordinates in output file? + +int in +double ra, dec, year, lii, bii +int fscan(), nscan(), open() +errchk open, fscan, printf + +begin + in = open (listfile, READ_ONLY, TEXT_FILE) + + # Read successive RA,DEC coordinate pairs from the standard input, + # converting and printing the result on the standard output. + + while (fscan (in) != EOF) { + call gargd (ra) + call gargd (dec) + call gargd (year) + + # If there is something wrong with the input coords, print warning + # and skip the conversion. If year is not given with entry + # assume 1950.0. + + switch (nscan()) { + case 2: + year = 1950.0 + case 3: + default: + call eprintf ("Bad entry in coordinate list\n") + next + } + + # Call routine to perform conversion and write lII, bII to + # the standard output. + + call ast_galactic (ra, dec, year, lii, bii) + + if (prt_coords == YES ) { + call fprintf (out, "%13.2h %12.1h %8.2f") + call pargd (ra) + call pargd (dec) + call pargd (year) + } + + call fprintf (out, "%13.4f %9.4f" ) + call pargd (lii) + call pargd (bii) + + call fprintf (out, "\n") + } + + call close (in) +end + + +# IN_GALACTIC -- convert a list of galactic coordinates read from the +# named file to equatorial coordinates, writing the results on the output +# file. + +procedure in_galactic (out, listfile, prt_coords) + +int out # output stream +char listfile[SZ_FNAME] # input file +int prt_coords # print coordinates in output file? + +int in +double ra, dec, year, lii, bii +int fscan(), nscan(), open() +errchk open, fscan, printf + +begin + in = open (listfile, READ_ONLY, TEXT_FILE) + + # Read successive RA,DEC coordinate pairs from the standard input, + # converting and printing the result on the standard output. + + while (fscan (in) != EOF) { + call gargd (lii) + call gargd (bii) + call gargd (year) + + # If there is something wrong with the input coords, print warning + # and skip the conversion. If year is not given with entry + # assume 1950.0. + + switch (nscan()) { + case 2: + year = 1950.0 + case 3: + default: + call eprintf ("Bad entry in coordinate list\n") + next + } + + # Call routine to perform conversion and write lII, bII to + # the standard output. + + call ast_galtoeq (lii, bii, ra, dec, year) + + if (prt_coords == YES ) { + call fprintf (out, "%13.4f %9.4f" ) + call pargd (lii) + call pargd (bii) + } + + call fprintf (out, "%13.2h %12.1h %8.2f") + call pargd (ra) + call pargd (dec) + call pargd (year) + + call fprintf (out, "\n") + } + + call close (in) +end diff --git a/noao/astutil/gratings.par b/noao/astutil/gratings.par new file mode 100644 index 00000000..ef6db521 --- /dev/null +++ b/noao/astutil/gratings.par @@ -0,0 +1,8 @@ +echelle,b,h,no,,,"Echelle grating?" +f,r,h,590.,,,"Focal length (mm)" +gmm,r,h,226.,,,"Grating grooves per mm" +blaze,r,h,4.5,,,"Blaze angle (degrees)" +theta,r,h,-10.5,,,"Incidence angle (degrees)" +order,i,h,1,,,"Reference order" +wavelength,r,h,INDEF,,,"Blaze wavelength (Angstroms)" +dispersion,r,h,INDEF,,,"Blaze dispersion (Angstroms/mm)" diff --git a/noao/astutil/keywpars.par b/noao/astutil/keywpars.par new file mode 100644 index 00000000..e18342ed --- /dev/null +++ b/noao/astutil/keywpars.par @@ -0,0 +1,19 @@ +# PSET file for image header keywords used by RV package + +ra,s,h,"RA",,,"Right Ascension keyword" +dec,s,h,"DEC",,,"Declination keyword" +ut,s,h,"UT",,,"UT of observation keyword" +utmiddle,s,h,"UTMIDDLE",,,"UT of mid-point of observation keyword" +exptime,s,h,"EXPTIME",,,"Exposure time keyword" +epoch,s,h,"EPOCH",,,"Epoch of observation keyword" +date_obs,s,h,"DATE-OBS",,,"Date of observation keyword +" +# Output Image Header Keywords +hjd,s,h,"HJD",,,"Heliocentric Julian date keyword" +mjd_obs,s,h,"MJD-OBS",,,"Modified Julian Date of observation keyword" +vobs,s,h,"VOBS",,,"Observed velocity keyword" +vrel,s,h,"VREL",,,"Relative velocity keyword" +vhelio,s,h,"VHELIO",,,"Heliocentric velocity keyword" +vlsr,s,h,"VLSR",,,"LSR velocity keyword" +vsun,s,h,"VSUN",,,"Epoch of solar motion keyword" +mode,s,h,"ql" diff --git a/noao/astutil/mkpkg b/noao/astutil/mkpkg new file mode 100644 index 00000000..c95f0653 --- /dev/null +++ b/noao/astutil/mkpkg @@ -0,0 +1,52 @@ +# Make the ASTUTIL package. + +$call asttools +$call relink +$exit + +update: + $call relink + $call install + ; + +relink: + $set LIBS = "-lasttools -lxtools -lcurfit -lbev" + + $update libpkg.a + $omake x_astutil.x + $link x_astutil.o libpkg.a $(LIBS) -o xx_astutil.e + ; + +install: + $move xx_astutil.e noaobin$x_astutil.e + ; + +asttools: + $checkout libasttools.a noaolib$ + $update libasttools.a + $checkin libasttools.a noaolib$ + ; + +libasttools.a: + @asttools + ; + +libpkg.a: + @pdm + + airmass.x <math.h> + astfunc.x astfunc.h <evvexpr.h> <imset.h> <lexnum.h> <mach.h>\ + <time.h> + galactic.x <fset.h> + precess.x <fset.h> + t_astcalc.x astfunc.h <ctotok.h> <ctype.h> <error.h> <evvexpr.h>\ + <fset.h> <lexnum.h> <time.h> + t_asthedit.x astfunc.h <ctotok.h> <ctype.h> <error.h> <evvexpr.h>\ + <fset.h> <imset.h> <lexnum.h> <time.h> + t_asttimes.x <error.h> + t_gratings.x <error.h> <math.h> + t_obs.x <error.h> + t_rvcorrect.x rvcorrect.com <error.h> <time.h> + t_setairmass.x <error.h> <ctype.h> <imhdr.h> + t_setjd.x <error.h> <ctype.h> <imhdr.h> + ; diff --git a/noao/astutil/observatory.par b/noao/astutil/observatory.par new file mode 100644 index 00000000..d79abdd7 --- /dev/null +++ b/noao/astutil/observatory.par @@ -0,0 +1,14 @@ +command,s,a,"list","set|list|images",,"Command (set|list|images)" +obsid,s,a,"?",,,"Observatory to set, list, or image default" +images,s,a,,,,"List of images" +verbose,b,h,no,,,"Verbose output? +" +observatory,s,h,,,,"Observatory identification" +name,s,h,,,,"Observatory name" +longitude,r,h,,,,"Observatory longitude (degrees)" +latitude,r,h,,,,"Observatory latitude (degrees)" +altitude,r,h,,,,"Observatory altitude (meters)" +timezone,r,h,,,,"Observatory time zone" +mode,s,h,"ql",,," +" +override,s,q,,,,"Observatory identification" diff --git a/noao/astutil/pdm.par b/noao/astutil/pdm.par new file mode 100644 index 00000000..cdf78212 --- /dev/null +++ b/noao/astutil/pdm.par @@ -0,0 +1,13 @@ +infiles,s,a,,,,Input file template +metafile,s,h,"pdmmeta",,,Metacode file +batchfile,s,h,"pdmbatch",,,Batch text file +device,s,h,"stdgraph",,,Graphics device +interactive,b,h,yes,,,Use interactive graphics? +flip,b,h,no,,,Flip the y-axis scale? +minp,r,h,0.0,,,Minimum period to search +maxp,r,h,0.0,,,Maximum period to search +ntheta,i,h,200,,,Number of theta points in period window (resolution) +pluspoint,i,h,50,,,Threshold number of data points after which to use plus +autoranges,b,h,no,,,Set ranges automatically +nsigma,r,h,3.0,,,Number of standard deviations for autoranges +cursor,*gcur,h,,,,graphics cursor input diff --git a/noao/astutil/pdm/README b/noao/astutil/pdm/README new file mode 100644 index 00000000..b6102f37 --- /dev/null +++ b/noao/astutil/pdm/README @@ -0,0 +1,9 @@ +ASTUTIL.PDM -- This directory contains the sources for the PDM program. + +PDM finds periods in light curve data by a method called +Phase Dispersion Minimization. + +Reference: + +Stellingwerf, R. F., 1978, "Period Determination by Phase Dispersion + Minimization", The Astrophysical Journal, 224, pp. 953-960. diff --git a/noao/astutil/pdm/TODO b/noao/astutil/pdm/TODO new file mode 100644 index 00000000..4e668a13 --- /dev/null +++ b/noao/astutil/pdm/TODO @@ -0,0 +1,4 @@ +The following are things which would be nice to add. + +- Compute RMS in theta plots +- Text output of data points for all plots diff --git a/noao/astutil/pdm/mkpkg b/noao/astutil/pdm/mkpkg new file mode 100644 index 00000000..aeb97b97 --- /dev/null +++ b/noao/astutil/pdm/mkpkg @@ -0,0 +1,40 @@ +# PDM -- Make the Phase Dispersion Minimization package. + +update: + $checkout libpkg.a ../ + $update libpkg.a + $checkin libpkg.a ../ + ; + + +libpkg.a: + pdmalltheta.x pdm.h <ctype.h> <error.h> <mach.h> + pdmampep.x pdm.h <ctype.h> <error.h> <mach.h> + pdmautorang.x pdm.h <ctype.h> <error.h> <mach.h> <pkg/rg.h> + pdmbatch.x pdm.h <ctype.h> <error.h> <mach.h> + pdmclose.x pdm.h <mach.h> + pdmcolon.x pdm.h <ctype.h> <error.h> <gset.h> <mach.h> + pdmcompare.x pdm.h <mach.h> + pdmcursor.x <fset.h> <gset.h> <math/curfit.h> pdm.h <ctype.h>\ + <error.h> <mach.h> + pdmdelete.x pdm.h <ctype.h> <error.h> <gset.h> <mach.h> + pdmdplot.x pdm.h <ctype.h> <error.h> <gset.h> <mach.h> + pdmfindmin.x pdm.h <ctype.h> <error.h> <mach.h> + pdmfitphase.x pdm.h <ctype.h> <error.h> <gset.h> <mach.h> + pdmgdata.x pdm.h <ctype.h> <error.h> <mach.h> + pdmminmaxp.x pdm.h <ctype.h> <error.h> <mach.h> + pdmopen.x pdm.h <mach.h> + pdmphase.x pdm.h <ctype.h> <error.h> <gset.h> <mach.h> + pdmpplot.x pdm.h <ctype.h> <error.h> <gset.h> <mach.h> + pdmranperm.x <gset.h> pdm.h <ctype.h> <error.h> <mach.h> <pkg/rg.h> + pdmshow.x pdm.h <ctype.h> <error.h> <mach.h> + pdmsignif.x <gset.h> pdm.h <ctype.h> <error.h> <mach.h> <pkg/rg.h> + pdmsort.x pdm.h <mach.h> + pdmstats.x pdm.h <ctype.h> <error.h> <mach.h> + pdmtheta.x pdm.h <ctype.h> <error.h> <mach.h> <pkg/rg.h> + pdmthetaran.x pdm.h <ctype.h> <error.h> <mach.h> <pkg/rg.h> + pdmtplot.x pdm.h <ctype.h> <error.h> <gset.h> <mach.h> + pdmundelete.x pdm.h <ctype.h> <error.h> <gset.h> <mach.h> + t_pdm.x pdm.h <ctype.h> <error.h> <mach.h> + ; + diff --git a/noao/astutil/pdm/pdm.h b/noao/astutil/pdm/pdm.h new file mode 100644 index 00000000..7ad38d1e --- /dev/null +++ b/noao/astutil/pdm/pdm.h @@ -0,0 +1,77 @@ +# The PDM data structure and other definitions + +define PDM_LENSTRUCT 49 # Length of PDM structure + +# Double precision. +define PDM_PMIN Memd[P2D($1)] # Minimum period to search +define PDM_PMAX Memd[P2D($1+2)] # Maximum period to search +define PDM_FMIN Memd[P2D($1+4)] # Minimum frequency to search +define PDM_FMAX Memd[P2D($1+6)] # Maximum frequency to search +define PDM_MINR Memd[P2D($1+8)] # Period to remember (min) +define PDM_NSIGMA Memd[P2D($1+10)] # num std dev. for range break +define PDM_SUMSQ Memd[P2D($1+12)] # Sum of squares of the data +define PDM_DVAR Memd[P2D($1+14)] # Variance (s ** 2) of the data +define PDM_AMPL Memd[P2D($1+16)] # Amplitude of light curve +define PDM_EPOCH Memd[P2D($1+18)] # Epoch of first maxima in data + +# Pointers +define PDM_ICD Memi[$1+20] # ICFIT pointer for data fit +define PDM_ICP Memi[$1+21] # ICFIT pointer for phasecurve fit +define PDM_CVD Memi[$1+22] # CURFIT pointer for data fit +define PDM_CVP Memi[$1+23] # CURFIT pointer for phasecurve fit +define PDM_GP Memi[$1+24] # PDM graphics GIO pointer +define PDM_LFD Memi[$1+25] # Log file descriptor +define PDM_PFD Memi[$1+26] # Plot file descriptor +define PDM_GT Memi[$1+27] # PDM gtools pointer +define PDM_XP Memi[$1+28] # Pointer to data ordinates +define PDM_ODYP Memi[$1+29] # Pointer to original data abscissas +define PDM_DYP Memi[$1+30] # Pointer to working data abscissas +define PDM_INUSEP Memi[$1+31] # Pointer to in-use array +define PDM_ERRP Memi[$1+32] # Pointer to error bar array +define PDM_XTHP Memi[$1+33] # Pointer to theta plot ordinates +define PDM_YTHP Memi[$1+34] # Pointer to theta plot abscissas +define PDM_XPHP Memi[$1+35] # Pointer to phasecurve plot ordinates +define PDM_YPHP Memi[$1+36] # Pointer to phasecurve plot abscissas +define PDM_PHERRP Memi[$1+37] # Pointer to phasecurve plot errors +define PDM_SORTP Memi[$1+38] # Pointer to array defining sort +define PDM_SAMPLEP Memi[$1+39] # Pointer to sample (range) string +define PDM_RG Memi[$1+40] # Pointer to range (sample) structure + +# Constants +define PDM_NPT Memi[$1+41] # Number of data points +define PDM_NTHPT Memi[$1+42] # Number of theta points +define PDM_NRANGE Memi[$1+43] # Number of ranges. + +# Other +define PDM_RESID Memi[$1+44] # Using residuals? flag +define PDM_RANGE Memi[$1+45] # Using ranges? flag +define PDM_DEBUG Memb[$1+46] # Debug? flag +define PDM_PLUSPOINT Memi[$1+47] # Threshold data number to use plus +define PDM_EB Memi[$1+48] # Use error bars? flag + +# Macro definitions +define PDM_X Memd[PDM_XP($1)+$2-1] # data ordinates +define PDM_ODY Memd[PDM_ODYP($1)+$2-1] # orig data abscissas +define PDM_DY Memd[PDM_DYP($1)+$2-1] # working data abscissas +define PDM_ERR Memr[PDM_ERRP($1)+$2-1] # error bars +define PDM_INUSE Memi[PDM_INUSEP($1)+$2-1] # in-use array +define PDM_XTH Memd[PDM_XTHP($1)+$2-1] # theta plot ordinates +define PDM_YTH Memd[PDM_YTHP($1)+$2-1] # theta plot abscissas +define PDM_XPH Memd[PDM_XPHP($1)+$2-1] # phase plot ordinates +define PDM_YPH Memd[PDM_YPHP($1)+$2-1] # phase plot abscissas +define PDM_PHERR Memr[PDM_PHERRP($1)+$2-1] # phase plot errors +define PDM_SORT Memi[PDM_SORTP($1)+$2-1] # array defining sort +define PDM_SAMPLE Memc[PDM_SAMPLEP($1)] # sample (range) string + + +# Plot types. (ptype) +define DATAPLOT 0 # data plot +define THETAPPLOT 1 # theta period plot +define THETAFPLOT 2 # theta frequency plot +define PHASEPLOT 3 # phase plot + +define MAX_RANGES 20 # maximum number of range segments +define PDM_SZ_TITLE (4*SZ_LINE) # size of pdm plot title buffer +define BIN10 100 # numpts for bin 5/10 split + # otherwise, plot pluses +define HELP "noao$lib/scr/pdm.key" # where help file is diff --git a/noao/astutil/pdm/pdmalltheta.x b/noao/astutil/pdm/pdmalltheta.x new file mode 100644 index 00000000..b7a48889 --- /dev/null +++ b/noao/astutil/pdm/pdmalltheta.x @@ -0,0 +1,104 @@ +include <mach.h> +include <ctype.h> +include <error.h> +include "pdm.h" + +# PDM_ALLTHETA -- Calculate the theta statistic for the period window. + +procedure pdm_alltheta (pdmp, porf) + +pointer pdmp # structure pointer +int porf # period or frequency flag + +int i +double factor, period, pdm_theta(), mmean, mmin, mmax, scale +pointer rg, rg_xrangesd() +errchk calloc, realloc, rg_xrangesd + +begin + # Check to see that maxp > minp. + if (PDM_PMAX(pdmp) <= PDM_PMIN(pdmp)) + call error (0,"maxp smaller or equal minp in alltheta") + + # Calculate the mean of the Y data, remove it. + mmean = 0.0d+0 + do i = 1, PDM_NPT(pdmp) { + mmean = mmean + PDM_DY(pdmp,i) + } + mmean = mmean/PDM_NPT(pdmp) + do i = 1, PDM_NPT(pdmp) { + PDM_DY(pdmp,i) = PDM_DY(pdmp,i) - mmean + } + + # Find the min and max of the data, scale the data 0 to 1. + mmin = PDM_DY(pdmp,1) + mmax = PDM_DY(pdmp,1) + do i = 1, PDM_NPT(pdmp) { + if (PDM_DY(pdmp,i) > mmax) + mmax = PDM_DY(pdmp,i) + if (PDM_DY(pdmp,i) < mmin) + mmin = PDM_DY(pdmp,i) + } + scale = mmax - mmin + do i = 1, PDM_NPT(pdmp) { + PDM_DY(pdmp,i) = (PDM_DY(pdmp,i) - mmin)/scale + } + + # Bring the statistics up to date. + iferr (call pdm_statistics (pdmp)) + call error (0, "alltheta: error in statistics") + + # Allocate space for the ordinate and abscissa vectors for theta + # in the pdm data structure. + + if (PDM_XTHP(pdmp) == NULL) { + call calloc (PDM_XTHP(pdmp), PDM_NTHPT(pdmp), TY_DOUBLE) + call calloc (PDM_YTHP(pdmp), PDM_NTHPT(pdmp), TY_DOUBLE) + } else { + call realloc (PDM_XTHP(pdmp), PDM_NTHPT(pdmp), TY_DOUBLE) + call realloc (PDM_YTHP(pdmp), PDM_NTHPT(pdmp), TY_DOUBLE) + } + + # Calculate constant for incrementing the period. Give equally + # spaced frequencies. + + if (PDM_PMIN(pdmp) <= EPSILOND) + if (PDM_NTHPT(pdmp) >= 1) + PDM_PMIN(pdmp) = PDM_PMAX(PDMP)/PDM_NTHPT(pdmp) + else + call error (1, "alltheta: num thpts < 1") + + if (PDM_PMIN(pdmp) >= EPSILONR && PDM_NTHPT(pdmp) != 1) + factor = (PDM_PMAX(pdmp)/PDM_PMIN(pdmp))** + (1.0/(PDM_NTHPT(pdmp)-1)) + + # Calculate the ranges information from the sample string. + rg = rg_xrangesd (PDM_SAMPLE(pdmp), PDM_X(pdmp,1), PDM_NPT(pdmp)) + + # Call pdm_theta for each period and store the thetas and periods + # in the pdm data structure, calculate frequencies (1/p) as we go. + + period = PDM_PMIN(pdmp) + do i = 1, PDM_NTHPT(pdmp) { + PDM_YTH(pdmp,i) = pdm_theta (pdmp, rg, period) + if (porf == THETAPPLOT) + PDM_XTH(pdmp,i) = period + else { + if (period > EPSILOND) + PDM_XTH(pdmp,i) = 1.0d+0/period + else + call error (0, "alltheta: period very close to zero") + } + period = period * factor + } + + # Remove the scaling. + do i = 1, PDM_NPT(pdmp) { + PDM_DY(pdmp,i) = (PDM_DY(pdmp,i) * scale) + mmin + } + + # Put the mean back in. + do i = 1, PDM_NPT(pdmp) { + PDM_DY(pdmp,i) = PDM_DY(pdmp,i) + mmean + } +end diff --git a/noao/astutil/pdm/pdmampep.x b/noao/astutil/pdm/pdmampep.x new file mode 100644 index 00000000..08c2c4e1 --- /dev/null +++ b/noao/astutil/pdm/pdmampep.x @@ -0,0 +1,38 @@ +include <mach.h> +include <ctype.h> +include <error.h> +include "pdm.h" + +# PDM_AMPEP -- Calculate the amplitude and epoch for this data. + +procedure pdm_ampep (pdmp, period) + +pointer pdmp # PDM structure pointer +double period # period for which to calculate + +int i, isave +double npt, ymin, ymax +errchk pdm_phase + +begin + npt = PDM_NPT(pdmp) + + # Find the maximum and minimum values in the data. + # The difference is the amplitude. + + ymax = -MAX_DOUBLE + ymin = MAX_DOUBLE + do i = 1, npt { + if (PDM_INUSE(pdmp,i) == 0) + next + if (PDM_DY(pdmp,i) < ymin) + ymin = PDM_DY(pdmp,i) + if (PDM_DY(pdmp,i) > ymax) { + ymax = PDM_DY(pdmp,i) + isave = i + } + } + + PDM_AMPL(pdmp) = ymax - ymin + PDM_EPOCH(pdmp) = PDM_X(pdmp, isave) +end diff --git a/noao/astutil/pdm/pdmautorang.x b/noao/astutil/pdm/pdmautorang.x new file mode 100644 index 00000000..ba27d628 --- /dev/null +++ b/noao/astutil/pdm/pdmautorang.x @@ -0,0 +1,101 @@ +include <mach.h> +include <ctype.h> +include <error.h> +include <pkg/rg.h> +include "pdm.h" + +# PDM_AUTORANG -- Calculate the ranges division of the data automatically. + +int procedure pdm_autorang (pdmp) + +pointer pdmp # PDM structure pointer + +int npt, i, nrng +double sumsq, sum, var, sd, maxdif, meansep, rbegin, rend +int rngstrt +pointer sep, command, sp + +begin + call smark (sp) + call salloc (command, SZ_LINE, TY_CHAR) + + npt = PDM_NPT(pdmp) + + # Calculate the mean and standard deviation of the x-axis + # separation of the data points. (time intervals) + # Allocate an array of separations and fill it. + + call salloc (sep, npt-1, TY_DOUBLE) + do i = 1, npt-1 { + Memd[sep+i-1] = PDM_X(pdmp,i+1) - PDM_X(pdmp,i) + } + + sumsq = 0.0 + sum = 0.0 + for (i=1; i<=(npt-1); i=i+1) { + sumsq = sumsq + Memd[sep+i-1]**2 # Sum of squares. + sum = sum + Memd[sep+i-1] + } + if (npt != 1) { + var = (sumsq - sum**2/npt)/(npt - 1) # Variance. + sd = var**.5 # Standard Deviation. + } + + # Mean separation, maximum time diff. + if (npt != 1) { + meansep = (PDM_X(pdmp,npt) - PDM_X(pdmp,1)) / double(npt-1) + maxdif = meansep + sd * PDM_NSIGMA(pdmp) + } + + # Look through the separations and if we find one that is more + # than nsigma away from the mean on the plus side, divide the + # data at this point into another range. + + nrng = 0 + rngstrt = 1 + PDM_SAMPLE(pdmp) = EOS + do i = 1, npt - 1 { + if (Memd[sep+i-1] > maxdif) { + nrng = nrng + 1 + if (nrng > MAX_RANGES) { + call sfree (sp) + call error (0,"Max num ranges exceeded in autorange") + break + } + + # End of last range = x(i) + # If (i+1 != npts) beginning of next range = x(i+1) + # Remember where the next range starts. + + rbegin = PDM_X(pdmp,rngstrt) + rend = PDM_X(pdmp,i) + if ((i+1) < npt) + rngstrt = i+1 + + # Sprintf range info at end of string. + call sprintf (Memc[command], SZ_LINE, " %g:%g") + call pargd (rbegin) + call pargd (rend) + call strcat (Memc[command], PDM_SAMPLE(pdmp), SZ_LINE) + } + } + + # Finish up last range if needed. + If (rngstrt <= npt && rngstrt > 1) { + rbegin = PDM_X(pdmp,rngstrt) + rend = PDM_X(pdmp,i) + + # Sprintf range info at end of string. + call sprintf (Memc[command], SZ_LINE, " %g:%g") + call pargd (rbegin) + call pargd (rend) + call strcat (Memc[command], PDM_SAMPLE(pdmp), SZ_LINE) + } + + # If no ranges found, set the sample string to '*', all data. + if (nrng == 0) + call sprintf (PDM_SAMPLE(pdmp), SZ_LINE, "*") + + call sfree (sp) + return (nrng) +end diff --git a/noao/astutil/pdm/pdmbatch.x b/noao/astutil/pdm/pdmbatch.x new file mode 100644 index 00000000..6828b783 --- /dev/null +++ b/noao/astutil/pdm/pdmbatch.x @@ -0,0 +1,49 @@ +include <mach.h> +include <ctype.h> +include <error.h> +include "pdm.h" + +# PDM_BATCH -- Batch mode calculation. + +procedure pdm_batch (pdmp, file, infile, flip) + +pointer pdmp # PDM structure pointer +char file[SZ_FNAME] # file to store information +char infile[SZ_FNAME] # input data file name +bool flip # flip y-axis scale + +int fd +double pdm_signif(), signif +bool verbose +errchk pdm_alltheta, pdm_signif, pdm_ampep, pdm_phase + +begin + # Plot the data. + call pdm_dplot (pdmp, infile, flip) + + # Call pdm_alltheta to get the theta array; plot to metafile. + call pdm_alltheta (pdmp, THETAPPLOT) + call pdm_tplot (pdmp, THETAPPLOT, infile) + + # Call pdm_signif to calculate the significance of the theta minimum. + signif = pdm_signif (pdmp, PDM_MINR(pdmp)) + + # Write this significance out to the file. + fd = PDM_LFD(pdmp) + call fprintf (fd, "significance at this minimum = %g\n") + call pargd (signif) + call close (fd) + + # Call pdm_amplitudeepoch to get the amplitude and epoch. + call pdm_ampep (pdmp, PDM_MINR(pdmp)) + + # Call pdm_phase to get the phase curve. + # Plot to metafile. + + call pdm_phase(pdmp, PDM_MINR(pdmp), PDM_EPOCH(pdmp)) + call pdm_pplot (pdmp, PDM_MINR(pdmp), infile, flip) + + # Call pdm_show to print the parameter information to a file. + verbose = TRUE + call pdm_show (pdmp, file, verbose) +end diff --git a/noao/astutil/pdm/pdmclose.x b/noao/astutil/pdm/pdmclose.x new file mode 100644 index 00000000..b7e4541e --- /dev/null +++ b/noao/astutil/pdm/pdmclose.x @@ -0,0 +1,63 @@ +include <mach.h> +include "pdm.h" + +# PDM_CLOSE -- Close a PDM data structure. + +procedure pdm_close (pdmp, interactive) + +pointer pdmp # PDM structure pointer +bool interactive # interactive flag + +begin + # Close icfit pointers, curfit pointers, and graphics pointers, + # and the ranges pointer. + + if (PDM_ICD(pdmp) != NULL) + call ic_closed (PDM_ICD(pdmp)) + if (PDM_ICP(pdmp) != NULL) + call ic_closed (PDM_ICP(pdmp)) + if (PDM_CVD(pdmp) != NULL) + call dcvfree (PDM_CVD(pdmp)) + if (PDM_CVP(pdmp) != NULL) + call dcvfree (PDM_CVP(pdmp)) + if (PDM_GT(pdmp) != NULL) + call gt_free (PDM_GT(pdmp)) + if (PDM_GP(pdmp) != NULL) + call gclose (PDM_GP(pdmp)) + if (PDM_RG(pdmp) != NULL) + call rg_free (PDM_RG(pdmp)) + if (PDM_LFD(pdmp) != NULL) + call close (PDM_LFD(pdmp)) + if (!interactive) + if (PDM_PFD(pdmp) != NULL) + call close (PDM_PFD(pdmp)) + + # Free the data vectors. + if (PDM_XP(pdmp) != NULL) + call mfree (PDM_XP(pdmp), TY_DOUBLE) + if (PDM_ODYP(pdmp) != NULL) + call mfree (PDM_ODYP(pdmp), TY_DOUBLE) + if (PDM_DYP(pdmp) != NULL) + call mfree (PDM_DYP(pdmp), TY_DOUBLE) + if (PDM_ERRP(pdmp) != NULL) + call mfree (PDM_ERRP(pdmp), TY_REAL) + if (PDM_INUSEP(pdmp) != NULL) + call mfree (PDM_INUSEP(pdmp), TY_INT) + if (PDM_XTHP(pdmp) != NULL) + call mfree (PDM_XTHP(pdmp), TY_DOUBLE) + if (PDM_YTHP(pdmp) != NULL) + call mfree (PDM_YTHP(pdmp), TY_DOUBLE) + if (PDM_XPHP(pdmp) != NULL) + call mfree (PDM_XPHP(pdmp), TY_DOUBLE) + if (PDM_YPHP(pdmp) != NULL) + call mfree (PDM_YPHP(pdmp), TY_DOUBLE) + if (PDM_PHERRP(pdmp) != NULL) + call mfree (PDM_PHERRP(pdmp), TY_REAL) + if (PDM_SORTP(pdmp) != NULL) + call mfree (PDM_SORTP(pdmp), TY_INT) + if (PDM_SAMPLEP(pdmp) != NULL) + call mfree (PDM_SAMPLEP(pdmp), TY_CHAR) + + # Free the pdm data structure. + call mfree (pdmp, TY_STRUCT) +end diff --git a/noao/astutil/pdm/pdmcolon.x b/noao/astutil/pdm/pdmcolon.x new file mode 100644 index 00000000..6d438515 --- /dev/null +++ b/noao/astutil/pdm/pdmcolon.x @@ -0,0 +1,292 @@ +include <mach.h> +include <ctype.h> +include <error.h> +include <gset.h> +include "pdm.h" + +define PDM_KEYWORDS "|show|vshow|minp|maxp|minf|maxf|ntheta|sample|signif\ + |ampep|phase|unreject|alldata|origdata|" + +define SHOW 1 # Show parameter settings +define VSHOW 2 # Show verbose information +define PMIN 3 # Set min search period +define PMAX 4 # Set max search period +define FMIN 5 # Set min search frequency +define FMAX 6 # Set max search frequency +define NTHETA 7 # Set number of points for theta +define SAMPLE 8 # Set/show the sample ranges +define SIGNIF 9 # Find theta significance +define AMPEP 10 # Amplitude and Epoch +define PHASE 11 # Graph phase curve +define UNREJECT 12 # Unreject all the rejected data points +define ALLDATA 13 # Reset range to entire dataset +define ORIGDATA 14 # Reset data to origional dataset + +define SLOWTHRESH 500 # Threshold above which theta calc gets slow + +# PDM_COLON -- Decode colon commands. + +procedure pdm_colon (pdmp, cmdstr, ptype, infile, period, flip) + +pointer pdmp # PDM structure pointer +char cmdstr[ARB] # Command string +int ptype # plot type +char infile[SZ_FNAME] # input file name +double period # current working period +bool flip # flip the y-axis scale + +int nscan(), strdic() +int itemp, i +double temp, p1, signif, pdm_signif() +bool verbose +pointer cmd, sp +errchk pdm_signif, pdm_ampep, pdm_phase + +string keywords PDM_KEYWORDS + +begin + call smark (sp) + call salloc (cmd, SZ_LINE, TY_CHAR) + + call sscan (cmdstr) + call gargwrd (Memc[cmd], SZ_LINE) + + # Unpack keyword from string, look up command in dictionary. + # Switch on command. Call the appropriate subroutines. + + switch (strdic (Memc[cmd], Memc[cmd], SZ_FNAME, keywords)) { + case SHOW: + # Show parameter settings. + call gargstr (Memc[cmd], SZ_LINE) + verbose = false + if (Memc[cmd] == EOS) { + call gdeactivate (PDM_GP(pdmp), AW_CLEAR) + iferr (call pdm_show (pdmp, "STDOUT", verbose)) + call erract (EA_WARN) + call greactivate (PDM_GP(pdmp), AW_PAUSE) + } else { + iferr (call pdm_show (pdmp, Memc[cmd], verbose)) + call erract (EA_WARN) + } + case VSHOW: + # Show verbose information. + call gargstr (Memc[cmd], SZ_LINE) + verbose = true + if (Memc[cmd] == EOS) { + call gdeactivate (PDM_GP(pdmp), AW_CLEAR) + iferr (call pdm_show (pdmp, "STDOUT", verbose)) + call erract (EA_WARN) + call greactivate (PDM_GP(pdmp), AW_PAUSE) + } else { + iferr (call pdm_show (pdmp, Memc[cmd], verbose)) + call erract (EA_WARN) + } + case PMIN: + # List or set minimum period. + call gargd (temp) + if (nscan() == 2) { + # Set the period minimum in structure. + PDM_PMIN(pdmp) = temp + if (temp >= EPSILOND) + PDM_FMAX(pdmp) = 1.0d+0/temp + # Save this minp out to the parameter. + call clputd ("minp", temp) + } else { + # Print out the period minimum from the structure. + call printf ("Current minimum period = %g\n") + call pargd (PDM_PMIN(pdmp)) + call flush (STDOUT) + } + case PMAX: + # List or set maximum period. + call gargd (temp) + if (nscan() == 2) { + # Set the period maximum in structure. + PDM_PMAX(pdmp) = temp + if (temp >= EPSILOND) + PDM_FMIN(pdmp) = 1.0d+0/temp + # Save this minp out to the parameter. + call clputd ("maxp", temp) + } else { + # Print out the period maximum from the structure. + call printf ("Current maximum period = %g\n") + call pargd (PDM_PMAX(pdmp)) + call flush (STDOUT) + } + case FMIN: + # List or set minimum frequency. + call gargd (temp) + if (nscan() == 2) { + # Set the frequency minimum in structure. + PDM_FMIN(pdmp) = temp + if (temp >= EPSILOND) + PDM_PMAX(pdmp) = 1.0d+0/temp + # Save this minp out to the parameter. + if (temp >= EPSILOND) + call clputd ("maxp", 1.0d+0/temp) + } else { + # Print out the frequency minimum from the structure. + call printf ("Current minimum frequency = %g\n") + call pargd (PDM_FMIN(pdmp)) + call flush (STDOUT) + } + case FMAX: + # List or set maximum frequency. + call gargd (temp) + if (nscan() == 2) { + # Set the frequency maximum in structure. + PDM_FMAX(pdmp) = temp + if (temp >= EPSILOND) + PDM_PMIN(pdmp) = 1.0d+0/temp + # Save this minp out to the parameter. + if (temp >= EPSILOND) + call clputd ("minp", 1.0d+0/temp) + } else { + # Print out the frequency maximum from the structure. + call printf ("Current maximum frequency = %g\n") + call pargd (PDM_FMAX(pdmp)) + call flush (STDOUT) + } + case NTHETA: + # Set/show number of theta points + call gargi (itemp) + if (nscan() == 2) { + # Set ntheta in structure. + PDM_NTHPT(pdmp) = itemp + if (itemp > SLOWTHRESH) + # Give message saying that with this ntheta, the + # theta calculation will take quite a while. + call printf ("Large ntheta => long calculation time \007\n") + } else { + # Print out the value of ntheta from the structure. + call printf ("Number of theta points = %g\n") + call pargi (PDM_NTHPT(pdmp)) + call flush (STDOUT) + } + case SAMPLE: + # List or set the sample points. + call gargstr (Memc[cmd], SZ_LINE) + if (Memc[cmd] == EOS) { + call printf ("sample = %s\n") + call pargstr (PDM_SAMPLE(pdmp)) + } else { + if (ptype == DATAPLOT) { + call rg_gxmarkd (PDM_GP(pdmp), PDM_SAMPLE(pdmp), + PDM_X(pdmp,1), PDM_NPT(pdmp), 0) + } + call strcpy (Memc[cmd], PDM_SAMPLE(pdmp), SZ_LINE) + if (ptype == DATAPLOT) { + call rg_gxmarkd (PDM_GP(pdmp), PDM_SAMPLE(pdmp), + PDM_X(pdmp,1), PDM_NPT(pdmp), 1) + } + } + case SIGNIF: + # Calculate the significance of theta at period. + p1 = 0.0 + call gargd (temp) + if (nscan() == 2) # User entered a period. + p1 = temp + else { + # Use remembered period. + if (PDM_MINR(pdmp) >= EPSILOND) + p1 = PDM_MINR(pdmp) + else { + call printf ("No remembered minimum period. \007\n") + call flush (STDOUT) + } + } + # Calculate significance at cursor x position (per). + if (p1 >= EPSILOND) { + signif = pdm_signif (pdmp, p1) + # Print at bottom of screen. + call printf ("Significance at period %g = %g\n") + call pargd (p1) + call pargd (signif) + call flush (STDOUT) + } + case AMPEP: + # Calculate the amplitude and epoch for the data. + p1 = 0.0 + call gargd (temp) + if (nscan() == 2) # User entered a period. + p1 = temp + else { + # Use remembered period. + if (PDM_MINR(pdmp) >= EPSILOND) + p1 = PDM_MINR(pdmp) + else { + call printf ("No remembered minimum period. \007\n") + call flush (STDOUT) + } + } + # Calculate ampl & epoch at p1. + if (p1 >= EPSILOND) { + call pdm_ampep (pdmp, p1) + # Print at bottom of screen. + call printf("amplitude of data at period %g = %g, epoch = %g\n") + call pargd (p1) + call pargd (PDM_AMPL(pdmp)) + call pargd (PDM_EPOCH(pdmp)) + call flush (STDOUT) + } + case PHASE: + # Phase curve plot. + call gargd (temp) + if (nscan() == 2) { + # Calculate the phase curve, then make the plot. + call pdm_ampep (pdmp, temp) + call pdm_phase(pdmp, temp, PDM_EPOCH(pdmp)) + call pdm_pplot (pdmp, temp, infile, flip) + period = temp + } else { + # Use remembered period. + if (PDM_MINR(pdmp) >= EPSILOND) { + call pdm_ampep (pdmp, PDM_MINR(pdmp)) + call pdm_phase(pdmp, PDM_MINR(pdmp), PDM_EPOCH(pdmp)) + call pdm_pplot (pdmp, PDM_MINR(pdmp), infile, flip) + } else { + call printf ("No remembered minimum period. \007\n") + call flush (STDOUT) + } + } + ptype = PHASEPLOT + case UNREJECT: + # Copy original data vector into working data vector and + # set inuse array to all ones. + + do i = 1, PDM_NPT(pdmp) { + PDM_INUSE(pdmp,i) = 1 + PDM_DY(pdmp,i) = PDM_ODY(pdmp,i) + } + PDM_RESID(pdmp) = NO + + # Check type of plot and replot. + if (ptype == DATAPLOT) + call pdm_dplot (pdmp, infile, flip) + if (ptype == PHASEPLOT) + call pdm_pplot (pdmp, period, infile, flip) + case ALLDATA: + # Initialize the sample string and erase from the graph. + if (ptype == DATAPLOT) { + call rg_gxmarkd (PDM_GP(pdmp), PDM_SAMPLE(pdmp), + PDM_X(pdmp,1), PDM_NPT(pdmp), 0) + } + call strcpy ("*", PDM_SAMPLE(pdmp), SZ_LINE) + case ORIGDATA: + # Copy the original data vector into the working data vector. + do i = 1, PDM_NPT(pdmp) + PDM_DY(pdmp,i) = PDM_ODY(pdmp,i) + PDM_RESID(pdmp) = NO + + # Replot data. + call pdm_dplot (pdmp, infile, flip) + ptype = DATAPLOT + default: + # Error, unknown colon command; ring bell. + call printf ("\007") + call printf ("v/show minp/f maxp/f ntheta sample ") + call printf ("signif ampep phase unreject all/origdata\n") + } + + call sfree (sp) +end diff --git a/noao/astutil/pdm/pdmcompare.x b/noao/astutil/pdm/pdmcompare.x new file mode 100644 index 00000000..b2d60978 --- /dev/null +++ b/noao/astutil/pdm/pdmcompare.x @@ -0,0 +1,25 @@ +include <mach.h> +include "pdm.h" + +# Compare procedure for qsort. + +int procedure pdm_compare (item1, item2) + +int item1 # index of first phase +int item2 # index of second phase + +pointer comarray +common /sortcom/ comarray +double p1, p2 + +begin + p1 = Memd[comarray+item1-1] + p2 = Memd[comarray+item2-1] + + if (p1 > p2) + return (1) + if (p1 == p2) + return (0) + if (p1 < p2) + return (-1) +end diff --git a/noao/astutil/pdm/pdmcursor.x b/noao/astutil/pdm/pdmcursor.x new file mode 100644 index 00000000..067ce966 --- /dev/null +++ b/noao/astutil/pdm/pdmcursor.x @@ -0,0 +1,383 @@ +include <mach.h> +include <ctype.h> +include <error.h> +include <gset.h> +include <fset.h> +include <math/curfit.h> +include "pdm.h" + +define PROMPT "pdm options" + +# PDM_CURSOR -- Get the next command from the user in a graphics cursor loop. +# Perform the requested function. + +procedure pdm_cursor (pdmp, ptype, infile, flip) + +pointer pdmp # pointer to PDM data structure +int ptype # type of plot on the screen +char infile[SZ_FNAME] # input file name +bool flip # flip the y-axis scale + +real xx, yy +double x, y # cursor coordinates +double xmax, xmin +double period +int wcs # wcs to which coordinates belong +int key # keystroke value of cursor event +int stridxs(), gqverify(), ier +int clgcur(), i +int pdm_delete(), index +int pdm_undelete(), pdm_findmin() +double rx1, rx2 +double dcveval() +double pdm_signif(), signif +pointer weights # pointer to temporary weights array for icfit +pointer command # string value, if any +pointer sp, sptemp +errchk pdm_colon, icg_fit, pdm_fitphase, pdm_alltheta +errchk pdm_phase, pdm_signif, pdm_ampep, pdm_findmin + +begin + call smark (sp) + call salloc (command, SZ_LINE, TY_CHAR) + + while (clgcur ("cursor", xx, yy, wcs, key, Memc[command], + SZ_LINE) != EOF) { + + x = double(xx) + y = double(yy) + + # Switch on command, take appropriate action. + switch (key) { + case '?': + # List options. + call gpagefile (PDM_GP(pdmp), HELP, PROMPT) + case ':': + # Colon command. + call pdm_colon (pdmp, Memc[command], ptype, infile, + period, flip) + case 'h': + # Graph the data. + call pdm_dplot (pdmp, infile, flip) + ptype = DATAPLOT + case 'f': + # Call icfit on the data. + if (ptype == DATAPLOT) { + # Set the min/max ordinate values for icfit. + call alimd (PDM_X(pdmp,1), PDM_NPT(pdmp), xmin, xmax) + call ic_putr (PDM_ICD(pdmp), "xmin", real(xmin)) + call ic_putr (PDM_ICD(pdmp), "xmax", real(xmax)) + + # Allocate a temporary weights array and fill it with the + # in-use array values. + + call smark (sptemp) + call salloc (weights, PDM_NPT(pdmp), TY_DOUBLE) + do i = 1, PDM_NPT(pdmp) + Memd[weights+i-1] = double(PDM_INUSE(pdmp,i)) + + # Call icfit. + if (PDM_NPT(pdmp) >= 2) + call icg_fitd (PDM_ICD(pdmp), PDM_GP(pdmp), "cursor", + PDM_GT(pdmp), PDM_CVD(pdmp), PDM_X(pdmp,1), + PDM_DY(pdmp,1), Memd[weights], PDM_NPT(pdmp)) + + # Recover the weights array back into the in-use array. + do i = 1, PDM_NPT(pdmp) + PDM_INUSE(pdmp,i) = int(Memd[weights+i-1]) + + call sfree (sptemp) + + # Replot. + call pdm_dplot (pdmp, infile, flip) + call sfree (sptemp) + } else if (ptype == PHASEPLOT) { + # Call icfit on the phases. + call pdm_fitphase (pdmp) + + # Replot. + call pdm_pplot (pdmp, period, infile, flip) + } else + call printf ("Can't fit a THETA plot \007\n") + case 'i': + # Theta vs. frequency plot. + if (PDM_PMIN(pdmp) < EPSILOND && PDM_PMAX(pdmp) < EPSILOND) + call pdm_minmaxp(pdmp) + + # Calculate theta. + call pdm_alltheta (pdmp, THETAFPLOT) + + # Graph theta vs frequency. + call pdm_tplot (pdmp, THETAFPLOT, infile) + ptype = THETAFPLOT + case 'k': + # Theta vs. period plot. + if (PDM_PMIN(pdmp) < EPSILOND && PDM_PMAX(pdmp) < EPSILOND) + call pdm_minmaxp(pdmp) + + # Calculate theta. + call pdm_alltheta (pdmp, THETAPPLOT) + + # Graph theta vs frequency. + call pdm_tplot (pdmp, THETAPPLOT, infile) + ptype = THETAPPLOT + case 'p': + # Phase curve plot. + if (ptype == THETAPPLOT) { + # Find the epoch, calculate the phases w.r.t. this epoch. + call pdm_ampep (pdmp, x) + call pdm_phase(pdmp, x, PDM_EPOCH(pdmp)) + call pdm_pplot (pdmp, x, infile, flip) + ptype = PHASEPLOT + period = x + } else if (ptype == THETAFPLOT) { + # Find the epoch, calculate the phases w.r.t. this epoch. + call pdm_ampep (pdmp, 1.0d+0/x) + call pdm_phase(pdmp, 1.0d+0/x, PDM_EPOCH(pdmp)) + call pdm_pplot (pdmp, 1.0d+0/x, infile, flip) + ptype = PHASEPLOT + period = 1.0d+0/x + } else + call printf ("Wrong type of plot on screen for p key\007\n") + case 'd': + # Delete the point nearest the cursor. + index = pdm_delete (pdmp, x, y, ptype) + case 'u': + # Undelete the point nearest the cursor. + index = pdm_undelete (pdmp, x, y, ptype) + case 'j': + # Subtract the fit from the data and use residuals. + if (PDM_CVD(pdmp) == NULL) + call printf ("Fit has not been done. \007\n") + else if (PDM_RESID(pdmp) == YES) + call printf ("Already using residuals. \007\n") + else { + # For each point, calculate the fit function and subtract + # it from the data. + + do i = 1, PDM_NPT(pdmp) { + PDM_DY(pdmp,i) = PDM_DY(pdmp,i) - + dcveval (PDM_CVD(pdmp), PDM_X(pdmp,i)) + } + PDM_RESID(pdmp) = YES + if (ptype == DATAPLOT) + call pdm_dplot (pdmp, infile, flip) + } + case 's': + # Set sample regions with the cursor. + if (ptype == DATAPLOT) { + if (stridxs ("*", PDM_SAMPLE(pdmp)) > 0) + PDM_SAMPLE(pdmp) = EOS + + rx1 = x + call printf ("again:\n") + if (clgcur ("cursor", xx, yy, wcs, key, Memc[command], + SZ_LINE) == EOF) + break + rx2 = double(xx) + + call sprintf (Memc[command], SZ_LINE, " %g:%g") + call pargd (rx1) + call pargd (rx2) + + call strcat (Memc[command], PDM_SAMPLE(pdmp), SZ_LINE) + call rg_gxmarkd (PDM_GP(pdmp), PDM_SAMPLE(pdmp), + PDM_X(pdmp,1), PDM_NPT(pdmp), 1) + call printf (" \n") + call gflush (PDM_GP(pdmp)) + } else + call printf ("Wrong type of plot for s key \007\n") + case 't': + # Initialize the sample string and erase from the graph. + if (ptype == DATAPLOT) { + call rg_gxmarkd (PDM_GP(pdmp), PDM_SAMPLE(pdmp), + PDM_X(pdmp,1), PDM_NPT(pdmp), 0) + } + call gflush (PDM_GP(pdmp)) + call strcpy ("*", PDM_SAMPLE(pdmp), SZ_LINE) + call gflush (PDM_GP(pdmp)) + case 'g': + # Significance of theta at cursor x position. + if (ptype == THETAPPLOT) { + # Calculate significance at cursor x position (per). + signif = pdm_signif (pdmp, x) + # Print at bottom of screen. + call printf ("Significance at cursor = %g\n") + call pargd (signif) + } else if (ptype == THETAFPLOT) { + # Calculate significance at cursor x position (per). + signif = pdm_signif (pdmp, 1.0d+0/x) + # Print at bottom of screen. + call printf ("Significance at cursor = %g\n") + call pargd (signif) + } else if (ptype == PHASEPLOT) { + # Calculate significance at current period/frequency + signif = pdm_signif (pdmp, period) + # Print at bottom of screen + call printf ("Significance of this period = %g\n") + call pargd (signif) + } else { + # Data plot. + call printf ("Wrong type of plot for g key \007\n") + } + case 'a': + # Amplitude and epoch at cursor x position. + if (ptype == THETAPPLOT) { + # Calculate ampl & epoch at cursor x position. + call pdm_ampep (pdmp, x) + # Print at bottom of screen. + call printf ("amplitude of data = %g, epoch = %g\n") + call pargd (PDM_AMPL(pdmp)) + call pargd (PDM_EPOCH(pdmp)) + } else if (ptype == THETAFPLOT) { + # Calculate ampl & epoch at cursor x position. + call pdm_ampep (pdmp, 1.0d+0/x) + # Print at bottom of screen. + call printf ("amplitude of data = %g, epoch = %g\n") + call pargd (PDM_AMPL(pdmp)) + call pargd (PDM_EPOCH(pdmp)) + } else if (ptype == PHASEPLOT) { + # Calculate ampl & epoch at current period/frequency + call pdm_ampep (pdmp, period) + # Print at bottom of screen. + call printf ("amplitude of data = %g, epoch = %g\n") + call pargd (PDM_AMPL(pdmp)) + call pargd (PDM_EPOCH(pdmp)) + } else { + # Data plot. + call printf ("Wrong type of plot for a key \007\n") + } + case ',': + # Set minp or minf to cursor x position. + if (ptype == THETAPPLOT) { + PDM_PMIN(pdmp) = x + PDM_FMIN(pdmp) = 1.0d+0/x + # Print at bottom of screen. + call printf ("minp now %g\n") + call pargd (PDM_PMIN(pdmp)) + } else if (ptype == THETAFPLOT) { + PDM_FMAX(pdmp) = x + PDM_PMAX(pdmp) = 1.0d+0/x + # Print at bottom of screen. + call printf ("minf now %g\n") + call pargd (PDM_FMAX(pdmp)) + } else { + # Data plot or phase plot. + call printf ("Wrong type of plot for , key \007\n") + } + case '.': + # Set maxp or maxf to cursor x position. + if (ptype == THETAPPLOT) { + PDM_PMAX(pdmp) = x + PDM_FMAX(pdmp) = 1.0d+0/x + # Print at bottom of screen. + call printf ("maxp now %g\n") + call pargd (PDM_PMAX(pdmp)) + } else if (ptype == THETAFPLOT) { + PDM_FMIN(pdmp) = x + PDM_PMIN(pdmp) = 1.0d+0/x + # Print at bottom of screen. + call printf ("maxf now %g\n") + call pargd (PDM_FMIN(pdmp)) + } else { + # Data plot or phase plot. + call printf ("Wrong type of plot for . key \007\n") + } + case 'm': + # Mark range and find minimum in this range. + if (ptype == THETAFPLOT || ptype == THETAPPLOT) { + rx1 = x + call printf ("again:\n") + if (clgcur ("cursor", xx, yy, wcs, key, Memc[command], + SZ_LINE) == EOF) + break + rx2 = double(xx) + index = pdm_findmin(pdmp, ptype, rx1, rx2, 1, + PDM_NTHPT(pdmp)) + PDM_MINR(pdmp) = PDM_XTH(pdmp,index) + call printf ("period at minimum = %g, frequency = %g\n") + call pargd (PDM_XTH(pdmp,index)) + call pargd (1.0d+0/PDM_XTH(pdmp,index)) + + } else + call printf ("Wrong type of plot for m key. \007\n") + case 'r': + # Check type of plot and replot. + if (ptype == DATAPLOT) + call pdm_dplot (pdmp, infile, flip) + if (ptype == THETAPPLOT) + call pdm_tplot (pdmp, THETAPPLOT, infile) + if (ptype == THETAFPLOT) + call pdm_tplot (pdmp, THETAFPLOT, infile) + if (ptype == PHASEPLOT) + call pdm_pplot (pdmp, period, infile, flip) + case 'e': + # Toggle error bars. + if (PDM_EB(pdmp) == NO) + PDM_EB(pdmp) = YES + else + PDM_EB(pdmp) = NO + + # Check type of plot and replot. + if (ptype == PHASEPLOT) + call pdm_pplot (pdmp, period, infile, flip) + case 'x': + # Remove a trend from the data by fitting a straight line to + # the data and removing it. + + # Set the min/max ordinate values for icfit. + call alimd (PDM_X(pdmp,1), PDM_NPT(pdmp), xmin, xmax) + call dcvinit (PDM_CVD(pdmp), SPLINE1, 1, xmin, xmax) + + # Allocate a weights array and fill it. + call smark (sptemp) + call salloc (weights, PDM_NPT(pdmp), TY_DOUBLE) + do i = 1, PDM_NPT(pdmp) + Memd[weights+i-1] = PDM_INUSE(pdmp,i) + + call dcvfit (PDM_CVD(pdmp), PDM_X(pdmp,1), PDM_DY(pdmp,1), + Memd[weights], PDM_NPT(pdmp), WTS_USER, ier) + if (ier != 0) { + call eprintf ("error in dcvfit\n") + call erract (EA_WARN) + } + + # Subtract the fit from the data. + if (PDM_RESID(pdmp) == YES) { + call printf ("Already using residuals. \007\n") + next + } else { + # For each point, calculate the fit function and subtract + # it from the data. + + do i = 1, PDM_NPT(pdmp) { + PDM_DY(pdmp,i) = PDM_DY(pdmp,i) - + dcveval (PDM_CVD(pdmp), PDM_X(pdmp,i)) + } + PDM_RESID(pdmp) = YES + } + + call dcvfree (PDM_CVD(pdmp)) + call sfree (sptemp) + + # Replot. + call pdm_dplot (pdmp, infile, flip) + ptype = DATAPLOT + case 'z': + # Flip the y-axis scale. + flip = !flip + case 'q': + # Quit. Exit PDM. + if (gqverify() == YES) + break + default: + # Error: unknown command: ring bell. + call printf ("\007\n") + call printf ("? for help or (h,f,i,k,p") + call printf (",d,u,j,s,t,g,a,m,r,x,q,:)\n") + } + } + + call flush (STDOUT) + call sfree (sp) +end diff --git a/noao/astutil/pdm/pdmdelete.x b/noao/astutil/pdm/pdmdelete.x new file mode 100644 index 00000000..5052a2e7 --- /dev/null +++ b/noao/astutil/pdm/pdmdelete.x @@ -0,0 +1,103 @@ +include <mach.h> +include <ctype.h> +include <error.h> +include <gset.h> +include "pdm.h" + +define MSIZE 2.0 # Mark size + +# PDM_DELETE -- Delete the point from the plot and set it's inuse array +# entry to zero. + +int procedure pdm_delete (pdmp, cx, cy, ptype) + +pointer pdmp # pointer to PDM data structure +double cx, cy # device cursor coordinates +int ptype # plot type + +pointer gp +real x, y +int npts, i, j, index +real x0, y0, r2, r2min + +begin + gp = PDM_GP(pdmp) + npts = PDM_NPT(pdmp) + + if (ptype == DATAPLOT) { + # Transform world cursor coordinates to NDC. + call gctran (gp, real(cx), real(cy), x, y, 1, 0) + + # Search for nearest point in-use. + j = 0 + r2min = MAX_REAL + do i = 1, npts { + if (PDM_INUSE(pdmp,i) == 0) + next + + call gctran (gp, real(PDM_X(pdmp,i)), real(PDM_DY(pdmp,i)), + x0, y0, 1, 0) + + r2 = (x0 - x) ** 2 + (y0 - y) ** 2 + if (r2 < r2min) { + r2min = r2 + j = i + } + } + + # Mark the deleted point with a cross and set the weight to zero. + if (j != 0) { + call gscur (gp, real(PDM_X(pdmp,j)), real(PDM_DY(pdmp,j))) + call gmark (gp, real(PDM_X(pdmp,j)), real(PDM_DY(pdmp,j)), + GM_CROSS, MSIZE, MSIZE) + PDM_INUSE(pdmp,j) = 0 + call gflush(gp) + } + + return (j) + + } else if (ptype == PHASEPLOT) { + # Transform world cursor coordinates to NDC. + call gctran (gp, real(cx), real(cy), x, y, 1, 0) + + # Search for nearest point in-use. + j = 0 + r2min = MAX_REAL + do i = 1, npts { + index = PDM_SORT(pdmp,i) + if (PDM_INUSE(pdmp,index) == 0) + next + + call gctran (gp, real(PDM_XPH(pdmp,i)), real(PDM_YPH(pdmp,i)), + x0, y0, 1, 0) + + r2 = (x0 - x) ** 2 + (y0 - y) ** 2 + if (r2 < r2min) { + r2min = r2 + j = i + } + } + + # Mark the deleted point with a cross and set the weight to zero. + # We mark two points since all of the points are displayed twice + # on the phase plot. + + if (j != 0) { + call gscur (gp, real(PDM_XPH(pdmp,j))+1.0, + real(PDM_YPH(pdmp,j))) + call gmark (gp, real(PDM_XPH(pdmp,j))+1.0, + real(PDM_YPH(pdmp,j)), GM_CROSS, MSIZE, MSIZE) + call gscur (gp, real(PDM_XPH(pdmp,j)), real(PDM_YPH(pdmp,j))) + call gmark (gp, real(PDM_XPH(pdmp,j)), real(PDM_YPH(pdmp,j)), + GM_CROSS, MSIZE, MSIZE) + + # Calculate which point this corresponds to. + index = PDM_SORT(pdmp,j) + PDM_INUSE(pdmp,index) = 0 + call gflush (gp) + } + + return (index) + } else + return (0) +end diff --git a/noao/astutil/pdm/pdmdplot.x b/noao/astutil/pdm/pdmdplot.x new file mode 100644 index 00000000..c0b53d19 --- /dev/null +++ b/noao/astutil/pdm/pdmdplot.x @@ -0,0 +1,101 @@ +include <mach.h> +include <ctype.h> +include <error.h> +include <gset.h> +include "pdm.h" + +define MSIZE 2.0 # Mark size +define EDGESCL 5.0 # Percent extra space around plot data + +# PDM_DPLOT -- Plot the data on the screen. + +procedure pdm_dplot (pdmp, filename, flip) + +pointer pdmp # pointer to PDM data structure +char filename[SZ_FNAME] # name of the input data file +bool flip # flip the y-axis scale + +int npt, i +real x1, x2, y1, y2, scldif, sclspc +pointer gp, xtemp, ytemp +pointer title +pointer system_id, sp + +begin + call smark (sp) + call salloc (system_id, SZ_LINE, TY_CHAR) + call salloc (title, 4*SZ_LINE, TY_CHAR) + call salloc (xtemp, PDM_NPT(pdmp), TY_REAL) + call salloc (ytemp, PDM_NPT(pdmp), TY_REAL) + + npt = PDM_NPT(pdmp) + gp = PDM_GP(pdmp) + call gclear (gp) + + # Scale the wcs. + do i = 1, PDM_NPT(pdmp) { + Memr[xtemp+i-1] = real(PDM_X(pdmp,i)) + Memr[ytemp+i-1] = real(PDM_DY(pdmp,i)) + } + call gascale (gp, Memr[xtemp], npt, 1) + call gascale (gp, Memr[ytemp], npt, 2) + + # Get the X and Y boundaries. + call ggwind (gp, x1, x2, y1, y2) + + # Add boundry space. + scldif = x2 - x1 + sclspc = scldif * (EDGESCL / 100.) + x1 = x1 - sclspc + x2 = x2 + sclspc + scldif = y2 - y1 + sclspc = scldif * (EDGESCL / 100.) + y1 = y1 - sclspc + y2 = y2 + sclspc + + # Flip the y-axis scale if flip = TRUE. + if (flip) + call gswind (gp, x1, x2, y2, y1) + else + call gswind (gp, x1, x2, y1, y2) + + # Multiline title, save in an array and sprintf to it. + # Get the system identification. + + call sysid (Memc[system_id], SZ_LINE) + call sprintf (Memc[title], 4*SZ_LINE, + "%s\nFile = %s\n%s\nnumpts = %d") + call pargstr (Memc[system_id]) + call pargstr (filename) + if (PDM_RESID(pdmp) == YES) + call pargstr ("Data with fit removed") + else + call pargstr ("Data") + call pargi (npt) + + # Draw the axes. + call glabax (gp, Memc[title], "obs time", "magnitude") + + # Make the plot. + if (npt <= PDM_PLUSPOINT(pdmp)) { + call gpmark (gp, Memr[xtemp], Memr[ytemp], npt, + GM_PLUS, MSIZE, MSIZE) + } else { + call gpmark (gp, Memr[xtemp], Memr[ytemp], npt, + GM_POINT, 1.0, 1.0) + } + + # Call the routine to mark the ranges if they are in effect. + call rg_gxmarkd (gp, PDM_SAMPLE(pdmp), PDM_X(pdmp,1), npt, 1) + + # Draw an x over any deleted points. + do i = 1, npt { + if (PDM_INUSE(pdmp,i) == 0) { + call gscur (gp, Memr[xtemp+i-1], Memr[ytemp+i-1]) + call gmark (gp, Memr[xtemp+i-1], Memr[ytemp+i-1], GM_CROSS, + MSIZE, MSIZE) + } + } + + call sfree (sp) +end diff --git a/noao/astutil/pdm/pdmfindmin.x b/noao/astutil/pdm/pdmfindmin.x new file mode 100644 index 00000000..4053bf43 --- /dev/null +++ b/noao/astutil/pdm/pdmfindmin.x @@ -0,0 +1,57 @@ +include <mach.h> +include <ctype.h> +include <error.h> +include "pdm.h" + +# PDM_FINDMIN -- Find the minimum value of the abscissa. + +int procedure pdm_findmin (pdmp, ptype, startint, endint, is, ie) + +pointer pdmp # pointer to PDM data structure +int ptype # plot type +double startint, endint # start and end ordinates +int is, ie # start and end indexs + +double miny, dy, dx +int i, isave, npt +pointer xpt, ypt + +begin + # Dereference npt. + npt = PDM_NPT(pdmp) + + # Dereference the appropriate abcissa and ordinate. + switch (ptype) { + case DATAPLOT: + xpt = PDM_XP(pdmp) + ypt = PDM_DYP(pdmp) + case THETAPPLOT: + xpt = PDM_XTHP(pdmp) + ypt = PDM_YTHP(pdmp) + case THETAFPLOT: + ypt = PDM_YTHP(pdmp) + xpt = PDM_XTHP(pdmp) + case PHASEPLOT: + ypt = PDM_YPHP(pdmp) + xpt = PDM_XPHP(pdmp) + } + + # Search the abscissas between startint and endint + # for the minimum value. + + isave = 1 + miny = MAX_DOUBLE + do i = is, ie { + dx = Memd[xpt+i-1] + dy = Memd[ypt+i-1] + if (dx > startint && dx < endint) { + if (dy < miny) { + miny = dy + isave = i + } + } + } + + # Return the corresponding index value. + return (isave) +end diff --git a/noao/astutil/pdm/pdmfitphase.x b/noao/astutil/pdm/pdmfitphase.x new file mode 100644 index 00000000..6d9aa901 --- /dev/null +++ b/noao/astutil/pdm/pdmfitphase.x @@ -0,0 +1,43 @@ +include <mach.h> +include <ctype.h> +include <error.h> +include <gset.h> +include "pdm.h" + +# PDM_FITPHASE -- Call ICFIT on the Phase Curve. + +procedure pdm_fitphase (pdmp) + +pointer pdmp # pointer to PDM data structure + +double xmin, xmax +pointer weights +int i, npt +errchk calloc, icg_fit + +begin + # Dereference some pointers. + npt = PDM_NPT(pdmp) + + # Calloc a phase in-use array. + call alimd (PDM_XPH(pdmp,1), npt, xmin, xmax) + call ic_putr (PDM_ICP(pdmp), "xmin", real(xmin)) + call ic_putr (PDM_ICP(pdmp), "xmax", real(xmax)) + call calloc (weights, npt, TY_DOUBLE) + + # Permute the data in-use array and save it in the phase weights array. + do i = 1, npt + Memd[weights+i-1] = double(PDM_INUSE(pdmp,PDM_SORT(pdmp,i))) + + # Call icfit on the phase curve (pass the phase x, y, wts) + if (npt >= 2) + call icg_fitd (PDM_ICP(pdmp), PDM_GP(pdmp), "cursor", + PDM_GT(pdmp), PDM_CVP(pdmp), PDM_XPH(pdmp,1), + PDM_YPH(pdmp,1), Memd[weights], npt) + + # Update the data in-use array appropriately. + do i = 1, npt + PDM_INUSE(pdmp,PDM_SORT(pdmp,i)) = int(Memd[weights+i-1]) + + call mfree (weights, TY_DOUBLE) +end diff --git a/noao/astutil/pdm/pdmgdata.x b/noao/astutil/pdm/pdmgdata.x new file mode 100644 index 00000000..79e8d49f --- /dev/null +++ b/noao/astutil/pdm/pdmgdata.x @@ -0,0 +1,136 @@ +include <mach.h> +include <ctype.h> +include <error.h> +include "pdm.h" + +define SZ_BUF 100 + +# PDM_GDATA -- Get Data from the input files. + +int procedure pdm_gdata (pdmp, infile) + +pointer pdmp # pointer to PDM data structure +char infile[SZ_LINE] # input data file name + +int fntopnb(), list, clgfil() +int n, ncols, lineno, buflen +int open(), getline(), nscan() +int fd +pointer nextfile +pointer lbuf, ip, sp +errchk realloc, fntopnb, open + +begin + # Get a line buffer. + call smark (sp) + call salloc (lbuf, SZ_LINE, TY_CHAR) + call salloc (nextfile, SZ_LINE, TY_CHAR) + + # Open the input file as a list of files. + list = fntopnb (infile, 0) + + # Initialize some variables. + n = 0 + ncols = 0 + lineno = 0 + + # For each input file in the list, read the data. + while (clgfil (list, Memc[nextfile], SZ_FNAME) != EOF) { + + # Open this input file. + fd = open (Memc[nextfile], READ_ONLY, TEXT_FILE) + + # Read in the data from this file. + while (getline (fd, Memc[lbuf]) != EOF) { + # Skip white space and blank lines. + lineno = lineno + 1 + for (ip = lbuf; IS_WHITE(Memc[ip]); ip = ip + 1) + ; + if (Memc[ip] == '\n' || Memc[ip] == EOS) + next + + if (n == 0) { + buflen = SZ_BUF + iferr { + call calloc (PDM_XP(pdmp), buflen, TY_DOUBLE) + call calloc (PDM_DYP(pdmp), buflen, TY_DOUBLE) + call calloc (PDM_ODYP(pdmp), buflen, TY_DOUBLE) + call calloc (PDM_INUSEP(pdmp), buflen, TY_INT) + call calloc (PDM_ERRP(pdmp), buflen, TY_REAL) + } then + call erract (EA_FATAL) + } else if (n + 1 > buflen) { + buflen = buflen + SZ_BUF + call realloc (PDM_XP(pdmp), buflen, TY_DOUBLE) + call realloc (PDM_DYP(pdmp), buflen, TY_DOUBLE) + call realloc (PDM_ODYP(pdmp), buflen, TY_DOUBLE) + call realloc (PDM_INUSEP(pdmp), buflen, TY_INT) + call realloc (PDM_ERRP(pdmp), buflen, TY_REAL) + } + + # Read data from the file, put it in the data structure. + call sscan (Memc[ip]) + call gargd (PDM_X(pdmp,n+1)) + call gargd (PDM_ODY(pdmp,n+1)) + call gargr (PDM_ERR(pdmp,n+1)) + PDM_INUSE(pdmp,n+1) = 1 + PDM_DY(pdmp,n+1) = PDM_ODY(pdmp,n+1) + + # If this is line one, then determine the number of columns. + if (ncols == 0 && nscan() > 0) + ncols = nscan() + + # Check this line against the number of columns and do the + # appropriate thing. + + switch (nscan()) { + case 0: + call printf ("no args; %s, line %d: %s\n") + call pargstr (Memc[nextfile]) + call pargi (lineno) + call pargstr (Memc[lbuf]) + next + case 1: + if (ncols >= 2) { + call eprintf ("only one arg; %s, line %d: %s\n") + call pargstr (Memc[nextfile]) + call pargi (lineno) + call pargstr (Memc[lbuf]) + next + } else { + PDM_ODY(pdmp,n+1) = PDM_X(pdmp,n+1) + PDM_DY(pdmp,n+1) = PDM_X(pdmp,n+1) + PDM_X(pdmp,n+1) = n + 1.0d+0 + PDM_ERR(pdmp,n+1) = 0.0 + } + case 2: + if (ncols == 3) { + call eprintf ("only two args; %s, line %d: %s\n") + call pargstr (Memc[nextfile]) + call pargi (lineno) + call pargstr (Memc[lbuf]) + next + } else { + PDM_ODY(pdmp,n+1) = PDM_ODY(pdmp,n+1) + PDM_DY(pdmp,n+1) = PDM_ODY(pdmp,n+1) + PDM_X(pdmp,n+1) = PDM_X(pdmp,n+1) + PDM_ERR(pdmp,n+1) = 0.0 + } + + } + + n = n + 1 + } + call close (fd) + } + + call realloc (PDM_XP(pdmp), n, TY_DOUBLE) + call realloc (PDM_DYP(pdmp), n, TY_DOUBLE) + call realloc (PDM_ODYP(pdmp), n, TY_DOUBLE) + call realloc (PDM_INUSEP(pdmp), n, TY_INT) + call realloc (PDM_ERRP(pdmp), n, TY_REAL) + + call fntclsb (list) + call sfree (sp) + return (n) +end diff --git a/noao/astutil/pdm/pdmminmaxp.x b/noao/astutil/pdm/pdmminmaxp.x new file mode 100644 index 00000000..01cdcd2c --- /dev/null +++ b/noao/astutil/pdm/pdmminmaxp.x @@ -0,0 +1,43 @@ +include <mach.h> +include <ctype.h> +include <error.h> +include "pdm.h" + +# PDM_MINMAXP -- Calculate the minimum and maximum periods automatically. + +procedure pdm_minmaxp (pdmp) + +pointer pdmp # pointer to PDM data structure + +int npt, i +double minp, maxp +pointer sep, sp + +begin + call smark (sp) + npt = PDM_NPT(pdmp) + + # Allocate an array of separations and fill it. Find the minimum + # separation as we go. + + call salloc (sep, npt-1, TY_DOUBLE) + maxp = PDM_X(pdmp,npt) - PDM_X(pdmp,1) + minp = maxp + do i = 1, npt-1 { + Memd[sep+i-1] = PDM_X(pdmp,i+1) - PDM_X(pdmp,i) + if (Memd[sep+i-1] < minp) + minp = Memd[sep+i-1] + } + + # Set minp equal to twice this minimum (Nyquist criterion). Set fmax. + PDM_PMIN(pdmp) = 2.0d+0 * minp + if (PDM_PMIN(pdmp) != 0.0d+0) + PDM_FMAX(pdmp) = 1.0d+0/PDM_PMIN(pdmp) + + # Set maxp equal to 4 times maxp. Set fmin. + PDM_PMAX(pdmp) = 4.0d+0 * maxp + if (PDM_PMAX(pdmp) != 0.0d+0) + PDM_FMIN(pdmp) = 1.0d+0/PDM_PMAX(pdmp) + + call sfree (sp) +end diff --git a/noao/astutil/pdm/pdmopen.x b/noao/astutil/pdm/pdmopen.x new file mode 100644 index 00000000..aa58ad5f --- /dev/null +++ b/noao/astutil/pdm/pdmopen.x @@ -0,0 +1,47 @@ +include <mach.h> +include "pdm.h" + +# PDM_OPEN -- Open a new PDM data structure. + +int procedure pdm_open (device, batchfile, metafile, interactive) + +char device[SZ_FNAME] # graphics device +char batchfile[SZ_FNAME] # file to store batch information +char metafile[SZ_FNAME] # file to store plots +bool interactive # interactive flag + +pointer pdmp +pointer gt_init(), gopen() +int open() +errchk ic_open, gopen, open, calloc, malloc + +begin + # Allocate a pdm data structure. + call calloc (pdmp, PDM_LENSTRUCT, TY_STRUCT) + + # Set up icfit structure pointers for data and phase curve fits. + call ic_open (PDM_ICD(pdmp)) + call ic_open (PDM_ICP(pdmp)) + + # Set up gtools and the gio structure pointers. + PDM_GT(pdmp) = gt_init () + if (interactive) { + PDM_GP(pdmp) = gopen (device, NEW_FILE, STDGRAPH) + PDM_LFD(pdmp) = open ("STDOUT", APPEND, TEXT_FILE) + } else { + PDM_LFD(pdmp) = open (batchfile, APPEND, TEXT_FILE) + PDM_PFD(pdmp) = open (metafile, APPEND, BINARY_FILE) + PDM_GP(pdmp) = gopen ("stdvdm", NEW_FILE, PDM_PFD(pdmp)) + } + + # Allocate space for the sample string and put a '*' in it. + call malloc (PDM_SAMPLEP(pdmp), SZ_LINE, TY_CHAR) + call strcpy ("*", PDM_SAMPLE(pdmp), SZ_LINE) + + # Booleans. + PDM_RESID(pdmp) = NO + PDM_RANGE(pdmp) = YES + PDM_EB(pdmp) = NO + + return (pdmp) +end diff --git a/noao/astutil/pdm/pdmphase.x b/noao/astutil/pdm/pdmphase.x new file mode 100644 index 00000000..76b3e0d2 --- /dev/null +++ b/noao/astutil/pdm/pdmphase.x @@ -0,0 +1,72 @@ +include <mach.h> +include <ctype.h> +include <error.h> +include <gset.h> +include "pdm.h" + +# PDM_PHASE -- Calculate Phase Curve for period (compressed light curve). + +procedure pdm_phase (pdmp, period, epoch) + +pointer pdmp # pointer to PDM data structure +double period # period to calculate the phase for +double epoch # epoch of this data + +int j, offset, temp +double p +pointer npt, phaseint, sp +errchk calloc, realloc + +begin + call smark (sp) + npt = PDM_NPT(pdmp) + call salloc (phaseint, npt, TY_DOUBLE) + + + # Allocate space for the output phase data (ordinate and abscissa) + # in the pdm data structure. + + if (PDM_XPHP(pdmp) == NULL) { + call calloc (PDM_XPHP(pdmp), 2*npt, TY_DOUBLE) + call calloc (PDM_YPHP(pdmp), 2*npt, TY_DOUBLE) + call calloc (PDM_PHERRP(pdmp), 2*npt, TY_REAL) + } else { + call realloc (PDM_XPHP(pdmp), 2*npt, TY_DOUBLE) + call realloc (PDM_YPHP(pdmp), 2*npt, TY_DOUBLE) + call realloc (PDM_PHERRP(pdmp), 2*npt, TY_REAL) + } + + # Set up the sort array and a temporary array for the phases. + if (PDM_SORTP(pdmp) == NULL) + call calloc (PDM_SORTP(pdmp), npt, TY_INT) + else + call realloc (PDM_SORTP(pdmp), npt, TY_INT) + + # Calculate the phases for all the points. + for (j=1; j<=npt; j=j+1) { + PDM_SORT(pdmp,j) = j + if (period > EPSILONR) { + temp = (int(epoch/period)+1)*period + p = (PDM_X(pdmp,j) - epoch + temp)/period + } + Memd[phaseint+j-1] = double(p - int(p)) + } + + # Sort the phase array into ascending order and permute + # the index array (sort). + + call pdm_sort (phaseint, PDM_SORTP(pdmp), npt) + + # Store the data in the pdm data structure. + do j = 1, npt { + offset = PDM_SORT(pdmp,j) + PDM_YPH(pdmp,j) = PDM_DY(pdmp,offset) + PDM_XPH(pdmp,j) = Memd[phaseint+offset-1] + PDM_PHERR(pdmp,j) = PDM_ERR(pdmp,offset) + PDM_YPH(pdmp,j+npt) = PDM_DY(pdmp,offset) + PDM_XPH(pdmp,j+npt) = Memd[phaseint+offset-1] + 1.0 + PDM_PHERR(pdmp,j+npt) = PDM_ERR(pdmp,offset) + } + + call sfree (sp) +end diff --git a/noao/astutil/pdm/pdmpplot.x b/noao/astutil/pdm/pdmpplot.x new file mode 100644 index 00000000..78d0ee04 --- /dev/null +++ b/noao/astutil/pdm/pdmpplot.x @@ -0,0 +1,120 @@ +include <mach.h> +include <ctype.h> +include <error.h> +include <gset.h> +include "pdm.h" + +define MSIZE 2.0 # Mark size +define EDGESCL 5.0 # Percent extra space around plot data + +# PDM_PPLOT -- Plot the Phase curve. + +procedure pdm_pplot (pdmp, period, filename, flip) + +pointer pdmp # pointer to PDM data structure +double period # period for which to plot the phase curve +char filename[SZ_FNAME] # name of the input data file +bool flip # flip the y-axis scale + +int npt, i, index +double frequency +real x1, x2, y1, y2, scldif, sclspc +pointer gp, xtemp, ytemp, etemp +pointer title, system_id, sp + +begin + npt = PDM_NPT(pdmp) + gp = PDM_GP(pdmp) + call gclear (PDM_GP(pdmp)) + + call smark (sp) + call salloc (system_id, SZ_LINE, TY_CHAR) + call salloc (title, PDM_SZ_TITLE, TY_CHAR) + call salloc (xtemp, 2*npt, TY_REAL) + call salloc (ytemp, 2*npt, TY_REAL) + call salloc (etemp, 2*npt, TY_REAL) + + do i = 1, 2*npt { + Memr[xtemp+i-1] = PDM_XPH(pdmp,i) + Memr[ytemp+i-1] = PDM_YPH(pdmp,i) + Memr[etemp+i-1] = PDM_PHERR(pdmp,i) + } + + # Scale the wcs. + call gascale (gp, Memr[xtemp], 2*npt, 1) + call gascale (gp, Memr[ytemp], 2*npt, 2) + + # Get the boundaries in X and Y. + call ggwind (gp, x1, x2, y1, y2) + + # Add boundry space. + scldif = x2 - x1 + sclspc = scldif * (EDGESCL / 100.) + x1 = x1 - sclspc + x2 = x2 + sclspc + scldif = y2 - y1 + sclspc = scldif * (EDGESCL / 100.) + y1 = y1 - sclspc + y2 = y2 + sclspc + + # Flip the y-axis scale if flip = TRUE. + if (flip) + call gswind (gp, x1, x2, y2, y1) + else + call gswind (gp, x1, x2, y1, y2) + + # Multiline title, save in an array and sprintf to it. + # Get the system identification. + + call sysid (Memc[system_id], SZ_LINE) + + # Calculate the frequency. + if (period != 0.0) + frequency = 1.0d+0/period + + call sprintf (Memc[title], PDM_SZ_TITLE, +"%s\nPhase curve at period %12.12g, frequency %12.12g\nFile = %s, numpts = %d") + call pargstr (Memc[system_id]) + call pargd (period) + call pargd (frequency) + call pargstr (filename) + call pargi (npt) + + # Draw the axes. + call glabax (gp, Memc[title], "phase", "magnitude") + + # Make the plot. If error bars are turned on, draw them. + if (PDM_EB(pdmp) == YES && Memr[etemp] > EPSILONR) { + call gpmark (gp, Memr[xtemp], Memr[ytemp], + 2*npt, GM_CIRCLE, 1.0, 1.0) + call gpmark (gp, Memr[xtemp], Memr[ytemp], + 2*npt, GM_CIRCLE+GM_FILL, 1.0, 1.0) + do i = 1, 2*npt + call gpmark (gp, Memr[xtemp+i-1], Memr[ytemp+i-1], + 1, GM_VEBAR, MSIZE, -(2.0*Memr[etemp+i-1])) + } else { + + if (npt <= PDM_PLUSPOINT(pdmp)) { + call gpmark (gp, Memr[xtemp], Memr[ytemp], + 2*npt, GM_PLUS, MSIZE, MSIZE) + } else { + call gpmark (gp, Memr[xtemp], Memr[ytemp], + 2*npt, GM_POINT, 1.0, 1.0) + } + } + + # Draw an x over any deleted points. + do i = 1, npt { + index = PDM_SORT(pdmp,i) + if (PDM_INUSE(pdmp,index) == 0) { + call gscur (gp, Memr[xtemp+i-1]+1, Memr[ytemp+i-1]) + call gmark (gp, Memr[xtemp+i-1]+1, Memr[ytemp+i-1], GM_CROSS, + MSIZE, MSIZE) + call gscur (gp, Memr[xtemp+i-1], Memr[ytemp+i-1]) + call gmark (gp, Memr[xtemp+i-1], Memr[ytemp+i-1], GM_CROSS, + MSIZE, MSIZE) + } + } + + call sfree (sp) +end diff --git a/noao/astutil/pdm/pdmranperm.x b/noao/astutil/pdm/pdmranperm.x new file mode 100644 index 00000000..1d80264e --- /dev/null +++ b/noao/astutil/pdm/pdmranperm.x @@ -0,0 +1,56 @@ +include <mach.h> +include <ctype.h> +include <error.h> +include <gset.h> +include <pkg/rg.h> +include "pdm.h" + +# PDM_RANPERM -- Make a random permutation of the data vector. +# This is the algorithm: +# Starting at the beginning of the input array, +# Do this numdatapoints times { +# Find the next random position. +# Call urand for a random number between one and numdatapoints(hash). +# Move forward in the input array this number of places (mod numpts). +# While (marker array for this position has a zero) { +# Move to the next position (linear rehash). +# } +# Put the input array value found at this position into the +# output array, set the marker array value corresponding +# to this position to zero. +# } + + +procedure pdm_ranperm (inarray, inuse, outarray, outinuse, numpts, seed) + +int numpts # number of points in the data +double inarray[numpts] # data to be permuted +double outarray[numpts] # output permuted data to this array +int inuse[numpts] # the PDM in-use array +int outinuse[numpts] # output scrambled in-use array +long seed # a seed for the random number generator + +int count, pos +real urand() +pointer p, sp # array to keep track of which have been used + +begin + # Allocate the output array and the marker array. + # Fill the marker array with ones (amovki) + + call smark (sp) + call salloc (p, numpts, TY_INT) + call amovki (1, Memi[p], numpts) # Set this array to all ones. + + pos = 0 + do count = 1, numpts { + pos = mod(pos+int(urand(seed)*numpts)+1, numpts) # Hash. + while (Memi[p+pos] == 0) # Linear rehash. + pos = mod(pos+1, numpts) + outarray[count] = inarray[pos+1] + outinuse[count] = inuse[pos+1] + Memi[p+pos] = 0 + } + + call sfree (sp) +end diff --git a/noao/astutil/pdm/pdmshow.x b/noao/astutil/pdm/pdmshow.x new file mode 100644 index 00000000..6f8af37a --- /dev/null +++ b/noao/astutil/pdm/pdmshow.x @@ -0,0 +1,56 @@ +include <mach.h> +include <ctype.h> +include <error.h> +include "pdm.h" + +# PDM_SHOW -- Print information to file. + +procedure pdm_show (pdmp, file, verbose) + +pointer pdmp # pointer to PDM data structure +char file[ARB] # file to put the show information in +bool verbose # verbose output flag + +int fd, open(), i +errchk open() + +begin + # Open the output file. + fd = open (file, APPEND, TEXT_FILE) + + # Print information from the data structure. + call fprintf (fd, + "minimum period searched = %12.12g, maximum = %g12.12\n") + call pargd (PDM_PMIN(pdmp)) + call pargd (PDM_PMAX(pdmp)) + call fprintf (fd, + "period = %12.12g, amplitude = %12.12g, epoch = %12.12g\n") + call pargd (PDM_MINR(pdmp)) + call pargd (PDM_AMPL(pdmp)) + call pargd (PDM_EPOCH(pdmp)) + + if (verbose) { + # Print the working data set out as x,y,in-use triplets. + call fprintf (fd, "The working data vector is as follows: \n") + do i = 1, PDM_NPT(pdmp) { + call fprintf ( fd, "index = %d, x = %12.12g, y = %12.12g\n") + call pargi (i) + call pargd (PDM_X(pdmp,i)) + call pargd (PDM_DY(pdmp,i)) + } + + if (PDM_XPHP(pdmp) != NULL) { + # Print the phasecurve out as x,y pairs + call fprintf (fd, "\nThe phase curve vector is as follows: \n") + do i = 1, PDM_NPT(pdmp) { + call fprintf ( fd, "index = %d, x = %12.12g, y = %12.12g\n") + call pargi (i) + call pargd (PDM_XPH(pdmp,i)) + call pargd (PDM_YPH(pdmp,i)) + } + } + } + + # Close the output file. + call close (fd) +end diff --git a/noao/astutil/pdm/pdmsignif.x b/noao/astutil/pdm/pdmsignif.x new file mode 100644 index 00000000..13a17acc --- /dev/null +++ b/noao/astutil/pdm/pdmsignif.x @@ -0,0 +1,61 @@ +include <mach.h> +include <ctype.h> +include <error.h> +include <gset.h> +include <pkg/rg.h> +include "pdm.h" + +define NUMTRIES 100 + +# PDM_SIGNIF -- Calculate the significance of the theta statistic for +# a certain period. Use the "Method of Randomization". + +double procedure pdm_signif (pdmp, period) + +pointer pdmp # pointer to PDM data structure +double period # period at which to find significance + +int lesscount, i, npt +double otheta, theta, pdm_theta(), pdm_thetaran() +long seed +pointer rg, pt, inuse, oinuse, rg_xrangesd(), sp +errchk pdm_statistics, pdm_theta(), pdm_ranperm, pdm_thetaran() + +begin + # Do NUMTRIES random permutations on the data, calculate the theta + # statistic on the scrambled data for this period. Return the + # fraction of these permutaions which yield thetas less than + # the unmixed data. + + call smark (sp) + npt = PDM_NPT(pdmp) + + # Make sure the statistics are up to date. + call pdm_statistics (pdmp) + + # Allocate a temporary array for the scrambled data, allocate a + # temporary copy of the inuse array and copy the real inuse array + # into it. + + call salloc (pt, npt, TY_DOUBLE) + call salloc (inuse, npt, TY_INT) + call salloc (oinuse, npt, TY_INT) + call amovi (PDM_INUSE(pdmp,1), Memi[inuse], npt) + lesscount = 0 + + # Calculate the ranges information from the sample string. + rg = rg_xrangesd (PDM_SAMPLE(pdmp), PDM_X(pdmp,1), npt) + otheta = pdm_theta (pdmp, rg, period) + seed = 1.0 + + do i = 1, NUMTRIES { + call pdm_ranperm (PDM_DY(pdmp,1), Memi[inuse], Memd[pt], + Memi[oinuse], npt, seed) + theta = pdm_thetaran (pdmp, pt, oinuse, rg, period) + if (theta < otheta) + lesscount = lesscount + 1 + } + + call sfree (sp) + return (1.0d+0 - (double(lesscount)/double(NUMTRIES))) +end diff --git a/noao/astutil/pdm/pdmsort.x b/noao/astutil/pdm/pdmsort.x new file mode 100644 index 00000000..93c59aec --- /dev/null +++ b/noao/astutil/pdm/pdmsort.x @@ -0,0 +1,20 @@ +include <mach.h> +include "pdm.h" + +# PDM_SORT -- Sort the phases into ascending order. + +procedure pdm_sort (array, sort, numpts) + +pointer array # array to sort +pointer sort # array to contain the sort indexes +int numpts # number of points to sort + +pointer comarray +common /sortcom/ comarray +extern pdm_compare() + +begin + comarray = array + if (numpts > 1) + call qsort (Memi[sort], numpts, pdm_compare) +end diff --git a/noao/astutil/pdm/pdmstats.x b/noao/astutil/pdm/pdmstats.x new file mode 100644 index 00000000..aeabacaa --- /dev/null +++ b/noao/astutil/pdm/pdmstats.x @@ -0,0 +1,37 @@ +include <mach.h> +include <ctype.h> +include <error.h> +include "pdm.h" + +# PDM_STATISTICS -- Calculate the sum of squares and the variance of the data. + +procedure pdm_statistics (pdmp) + +pointer pdmp # pointer to PDM data structure + +int npt, i, j +double var, sumx2, sum + +begin + npt = PDM_NPT(pdmp) + + # Calculate the sum of squares and the variance of the data. + sumx2 = 0.0 + sum = 0.0 + j = 0 + + do i = 1, npt { + if (PDM_INUSE(pdmp,i) == 1) { + sumx2 = sumx2 + PDM_DY(pdmp,i)**2 # Sum of squares. + sum = sum + PDM_DY(pdmp,i) + j = j + 1 + } + } + + if (j != 1) + var = (sumx2 - sum**2/double(j))/double(j - 1) # Variance. + + # Put these two values in the data structure. + PDM_SUMSQ(pdmp) = sumx2 + PDM_DVAR(pdmp) = var +end diff --git a/noao/astutil/pdm/pdmtheta.x b/noao/astutil/pdm/pdmtheta.x new file mode 100644 index 00000000..b2b295bc --- /dev/null +++ b/noao/astutil/pdm/pdmtheta.x @@ -0,0 +1,120 @@ +include <mach.h> +include <ctype.h> +include <error.h> +include <pkg/rg.h> +include "pdm.h" + +# PDM_THETA -- Calculate the theta statistic for this period. +# Theta is a measure of the dispersion of data phases about a mean +# light curve. + +double procedure pdm_theta (pdmp, rg, period) + +pointer pdmp # pointer to PDM data structure +pointer rg # segments structure pointer +double period # period at which to find theta + +int i, j, k, l, m +double s2 +int ndof, segst, segend +bool bin10 +double theta +pointer sumbin, sum2bin, numbin, sp +errchk binem + +begin + # Allocate bin storage. + call smark (sp) + call salloc (sumbin, 10, TY_DOUBLE) + call salloc (sum2bin, 10, TY_DOUBLE) + call salloc (numbin, 10, TY_INT) + + ndof = 0 + s2 = 0 + + # Do loop on the segments. + do i = 1, RG_NRGS(rg) { + + # Calculate segst, segend, bin10. + segst = min(RG_X2(rg,i),RG_X1(rg,i)) + segend = max(RG_X2(rg,i),RG_X1(rg,i)) + bin10 = ((segend - segst) >= BIN10) + + # Calculate the number of points in each bin and the sum of + # the bins. + + call binem (period, bin10, PDM_XP(pdmp), PDM_DYP(pdmp), + segst, segend, PDM_INUSEP(pdmp), sumbin, sum2bin, numbin) + + # Calculate sigma**2 for this period. + for (j=0; j<=9; j=j+1) { + k = numbin+j + l = sumbin+j + m = sum2bin+j + if (Memi[k] > 1) { + ndof = ndof + Memi[k] - 1 + s2 = s2 + (Memd[m] - Memd[l]**2 / Memi[k]) + } + } + } + + # Calculate theta. + theta = (s2 / double(ndof)) / PDM_DVAR(pdmp) + + call sfree (sp) + + return (theta) + +end + + +# BINEM -- Put the data points into the appropriate bins. + +procedure binem(incper, bin10, x, y, segst, segend, inuse, sumbin, sum2bin, + numbin) + +double incper # period increment +bool bin10 # use 5 or 10 bins flag +pointer x # ordinates +pointer y # abcissas +pointer inuse # PDM in-use array +int segst, segend # segment start and segment end +pointer sumbin, sum2bin, numbin # pointers to bins of sum, sum2, and number + +int bin1, bin2, j, k, l, m +double p, phase, p0 + +begin + do j = 1, 10 { + Memi[numbin+j-1] = 0 + Memd[sumbin+j-1] = 0.0 + Memd[sum2bin+j-1] = 0.0 + } + + #p0 = Memd[x] + call alimd (Memd[x+segst-1], segend-segst+1, p0, p) + do j = segst, segend { + if (Memi[inuse+j-1] == 0) + next + p = (Memd[x+j-1] - p0)/incper + phase = double(p - int(p)) + if (bin10) { + bin1 = mod(int(10.*phase+0.5), 10) + } else { + bin1 = 2 * int(5. * phase) + 1 + bin2 = 2 * (mod(int(5. * phase + 0.5), 5)) + k = numbin+bin2 + l = sumbin+bin2 + m = sum2bin+bin2 + Memi[k] = Memi[k] + 1 + Memd[l] = Memd[l] + Memd[y+j-1] + Memd[m] = Memd[m] + Memd[y+j-1] ** 2 + } + k = numbin+bin1 + l = sumbin+bin1 + m = sum2bin+bin1 + Memi[k] = Memi[k] + 1 + Memd[l] = Memd[l] + Memd[y+j-1] + Memd[m] = Memd[m] + Memd[y+j-1] ** 2 + } +end diff --git a/noao/astutil/pdm/pdmthetaran.x b/noao/astutil/pdm/pdmthetaran.x new file mode 100644 index 00000000..28e63b34 --- /dev/null +++ b/noao/astutil/pdm/pdmthetaran.x @@ -0,0 +1,118 @@ +include <mach.h> +include <ctype.h> +include <error.h> +include <pkg/rg.h> +include "pdm.h" + +# PDMTHETARAN -- This program is a copy of pdmtheta but can be used on +# scrambled data. + +double procedure pdm_thetaran (pdmp, y, inuse, rg, period) + +pointer pdmp # pointer to PDM data structure +pointer y # pointer to abcissas +pointer inuse # pointer to PDM in-use array +pointer rg # pointer to ranges structure +double period # period to calculate theta for + +int i, j, k, l, m +double s2 +int ndof, segst, segend +bool bin10 +double theta +pointer sumbin, sum2bin, numbin, sp +errchk binemran + +begin + # Allocate bin storage. + call smark (sp) + call salloc (sumbin, 10, TY_DOUBLE) + call salloc (sum2bin, 10, TY_DOUBLE) + call salloc (numbin, 10, TY_INT) + + s2 = 0 + ndof = 0 + + # Do loop on the segments. + do i = 1, RG_NRGS(rg) { + + # Calculate segst, segend, bin10. + segst = min(RG_X2(rg,i),RG_X1(rg,i)) + segend = max(RG_X2(rg,i),RG_X1(rg,i)) + bin10 = ((segend - segst) >= BIN10) + + # Calculate the number of points in each bin and the sum of + # the bins. + + call binemran (period, bin10, PDM_XP(pdmp), y, segst, + segend, inuse, sumbin, sum2bin, numbin) + + # Calculate sigma**2 for this period. + for (j=0; j<=9; j=j+1) { + k = numbin+j + l = sumbin+j + m = sum2bin+j + if (Memi[k] > 1) { + ndof = ndof + Memi[k] - 1 + s2 = s2 + (Memd[m] - Memd[l]**2 / Memi[k]) + } + } + } + + # Calculate theta. + theta = (s2 / double(ndof)) / PDM_DVAR(pdmp) + + call sfree (sp) + return (theta) +end + + +# BINEMRAN -- Put the data points into the appropriate bins (scrambled data). + +procedure binemran (incper, bin10, x, y, segst, segend, inuse, sumbin, sum2bin, + numbin) + +double incper +bool bin10 +pointer x +pointer y +pointer inuse +int segst, segend +pointer sumbin, sum2bin, numbin + +int bin1, bin2, j, k, l, m +double p, phase, p0 + +begin + do j = 1, 10 { + Memi[numbin+j-1] = 0 + Memd[sumbin+j-1] = 0.0 + Memd[sum2bin+j-1] = 0.0 + } + + p0 = Memd[x] + do j = segst, segend { + if (Memi[inuse+j-1] == 0) + next + p = (Memd[x+j-1] - p0)/incper + phase = double(p - int(p)) + if (bin10) { + bin1 = mod(int(10.*phase+0.5d+0), 10) + } else { + bin1 = 2 * int(5.0d+0 * phase) + 1 + bin2 = 2 * (mod(int(5.0d+0 * phase + 0.5d+0), 5)) + k = numbin+bin2 + l = sumbin+bin2 + m = sum2bin+bin2 + Memi[k] = Memi[k] + 1 + Memd[l] = Memd[l] + Memd[y+j-1] + Memd[m] = Memd[m] + Memd[y+j-1] ** 2 + } + k = numbin+bin1 + l = sumbin+bin1 + m = sum2bin+bin1 + Memi[k] = Memi[k] + 1 + Memd[l] = Memd[l] + Memd[y+j-1] + Memd[m] = Memd[m] + Memd[y+j-1] ** 2 + } +end diff --git a/noao/astutil/pdm/pdmtplot.x b/noao/astutil/pdm/pdmtplot.x new file mode 100644 index 00000000..e8c3ce8a --- /dev/null +++ b/noao/astutil/pdm/pdmtplot.x @@ -0,0 +1,139 @@ +include <mach.h> +include <ctype.h> +include <error.h> +include <gset.h> +include "pdm.h" + +define EDGESCL 5.0 # Percent extra space around plot data + +# PDM_TPLOT -- Plot the data on the screen. + +procedure pdm_tplot (pdmp, porf, filename) + +pointer pdmp # pointer to PDM data structure +int porf # period or frequency flag +char filename[SZ_FNAME] # name of the input data file + +int nthpt +real x1, x2, y1, y2, scldif, sclspc +pointer gp, xtemp, ytemp +pointer title +char system_id[SZ_LINE] +int indx, pdm_findmin() +errchk malloc, pdm_findmin() + +begin + # Dereference some structure stuff. + nthpt = PDM_NTHPT(pdmp) + gp = PDM_GP(pdmp) + + call malloc (title, PDM_SZ_TITLE, TY_CHAR) + call malloc (xtemp, nthpt, TY_REAL) + call malloc (ytemp, nthpt, TY_REAL) + call gclear (gp) + + do indx = 1, nthpt { + Memr[xtemp+indx-1] = real(PDM_XTH(pdmp,indx)) + Memr[ytemp+indx-1] = real(PDM_YTH(pdmp,indx)) + } + + if (porf == THETAPPLOT) { + # Scale the wcs. + call gascale (gp, Memr[xtemp], nthpt, 1) + call gascale (gp, Memr[ytemp], nthpt, 2) + + # Get the X and Y boundary values. + call ggwind (gp, x1, x2, y1, y2) + + # Add boundry space. + scldif = x2 - x1 + sclspc = scldif * (EDGESCL / 100.) + x1 = x1 - sclspc + x2 = x2 + sclspc + scldif = y2 - y1 + sclspc = scldif * (EDGESCL / 100.) + y1 = y1 - sclspc + y2 = y2 + sclspc + + call gswind (gp, x1, x2, y1, y2) + + # Find the minimum value and save it in the remembered minimum. + indx = pdm_findmin (pdmp, THETAPPLOT, PDM_PMIN(pdmp), + PDM_PMAX(pdmp), 1, nthpt) + PDM_MINR(pdmp) = PDM_XTH(pdmp,indx) + + # Multiline title, save in an array and sprintf to it. + # Get the system identification. + + call sysid (system_id, SZ_LINE) + call sprintf (Memc[title], PDM_SZ_TITLE, + "%s\nFile = %s, minimum = %12.12g\n%s\nnumpts = %d") + call pargstr (system_id) + call pargstr (filename) + call pargd (PDM_MINR(pdmp)) + call pargstr ("Theta vs Period") + call pargi (nthpt) + + # Draw the axes. + call glabax (gp, Memc[title], "period", "theta") + + # Make the plot. + call gpline (gp, Memr[xtemp], Memr[ytemp], nthpt) + + # Put the cursor at the minimum. + call gscur (gp, Memr[xtemp+indx-1], Memr[ytemp+indx-1]) + } else { + # Scale the wcs. + call gascale (gp, Memr[xtemp], nthpt, 1) + call gascale (gp, Memr[ytemp], nthpt, 2) + + # Get the X and Y boundary values. + call ggwind (gp, x1, x2, y1, y2) + + # Add boundry space. + scldif = x2 - x1 + sclspc = scldif * (EDGESCL / 100.) + x1 = x1 - sclspc + x2 = x2 + sclspc + scldif = y2 - y1 + sclspc = scldif * (EDGESCL / 100.) + y1 = y1 - sclspc + y2 = y2 + sclspc + + call gswind (gp, x1, x2, y1, y2) + + # Find the minimum value and save it in the remembered minimum. + indx = pdm_findmin (pdmp, THETAFPLOT, PDM_FMIN(pdmp), + PDM_FMAX(pdmp), 1, nthpt) + if (PDM_XTH(pdmp,indx) > EPSILOND) + PDM_MINR(pdmp) = 1./PDM_XTH(pdmp,indx) + + # Multiline title, save in an array and sprintf to it. + # Get the system identification. + + call sysid (system_id, SZ_LINE) + call sprintf (Memc[title], PDM_SZ_TITLE, + "%s\nFile = %s, minimum = %12.12g\n%s\nnumpts = %d") + call pargstr (system_id) + call pargstr (filename) + if (PDM_MINR(pdmp) > EPSILOND) + call pargd (1.0d+0/PDM_MINR(pdmp)) + else + call pargd (0.0d+0) + call pargstr ("Theta vs Frequency") + call pargi (nthpt) + + # Draw the axes. + call glabax (gp, Memc[title], "frequency", "theta") + + # Make the plot. + call gpline (gp, Memr[xtemp], Memr[ytemp], nthpt) + + # Put the cursor at the minimum. + call gscur (gp, Memr[xtemp+indx-1], Memr[ytemp+indx-1]) + } + + call mfree (title, TY_CHAR) + call mfree (xtemp, TY_REAL) + call mfree (ytemp, TY_REAL) +end diff --git a/noao/astutil/pdm/pdmundelete.x b/noao/astutil/pdm/pdmundelete.x new file mode 100644 index 00000000..2f5f0e31 --- /dev/null +++ b/noao/astutil/pdm/pdmundelete.x @@ -0,0 +1,124 @@ +include <mach.h> +include <ctype.h> +include <error.h> +include <gset.h> +include "pdm.h" + +define MSIZE 2.0 # Mark size + +# PDM_UNDELETE -- Undelete the nearest deleted point from the plot +# and set it's inuse array entry to one (in-use). + +int procedure pdm_undelete (pdmp, cx, cy, ptype) + +pointer pdmp # pointer to PDM data structure +double cx, cy # device coordinates of point to undelete +int ptype # plot type flag + +pointer gp +real x, y +int npt, i, j, index +real x0, y0, r2, r2min + +begin + gp = PDM_GP(pdmp) + npt = PDM_NPT(pdmp) + + if (ptype == DATAPLOT) { + # Transform world cursor coordinates to NDC. + call gctran (gp, real(cx), real(cy), x, y, 1, 0) + + # Search for nearest point not in-use. + j = 0 + r2min = MAX_REAL + do i = 1, npt { + if (PDM_INUSE(pdmp,i) == 1) + next + + call gctran (gp, real(PDM_X(pdmp,i)), real(PDM_DY(pdmp,i)), + x0, y0, 1, 0) + + r2 = (x0 - x) ** 2 + (y0 - y) ** 2 + if (r2 < r2min) { + r2min = r2 + j = i + } + } + + # Unmark the deleted point and reset the weight. + if (j != 0) { + call gscur (gp, real(PDM_X(pdmp,j)), real(PDM_DY(pdmp,j))) + call gseti (gp, G_PMLTYPE, GL_CLEAR) + call gmark (gp, real(PDM_X(pdmp,j)), real(PDM_DY(pdmp,j)), + GM_CROSS, MSIZE, MSIZE) + call gseti (gp, G_PMLTYPE, GL_SOLID) + if (PDM_NPT(pdmp) <= PDM_PLUSPOINT(pdmp)) + call gpmark (gp, real(PDM_X(pdmp,j)), real(PDM_DY(pdmp,j)), + 1, GM_PLUS, MSIZE, MSIZE) + else + call gpmark (gp, real(PDM_X(pdmp,j)), real(PDM_DY(pdmp,j)), + 1, GM_POINT, 1.0, 1.0) + PDM_INUSE(pdmp,j) = 1 + call gflush (gp) + } + + return (j) + } else if (ptype == PHASEPLOT) { + # Transform world cursor coordinates to NDC. + call gctran (gp, real(cx), real(cy), x, y, 1, 0) + + # Search for nearest point not in-use. + j = 0 + r2min = MAX_REAL + do i = 1, npt { + index = PDM_SORT(pdmp,i) + if (PDM_INUSE(pdmp,index) == 1) + next + + call gctran (gp, real(PDM_XPH(pdmp,i)), real(PDM_YPH(pdmp,i)), + x0, y0, 1, 0) + + r2 = (x0 - x) ** 2 + (y0 - y) ** 2 + if (r2 < r2min) { + r2min = r2 + j = i + } + } + + # Unmark the deleted point and reset the weight. + if (j != 0) { + call gscur (gp, real(PDM_XPH(pdmp,j))+1.0, + real(PDM_YPH(pdmp,j))) + call gseti (gp, G_PMLTYPE, GL_CLEAR) + call gmark (gp, real(PDM_XPH(pdmp,j))+1.0, + real(PDM_YPH(pdmp,j)), GM_CROSS, MSIZE, MSIZE) + call gseti (gp, G_PMLTYPE, GL_SOLID) + if (PDM_NPT(pdmp) <= PDM_PLUSPOINT(pdmp)) + call gpmark (gp, real(PDM_XPH(pdmp,j))+1.0, + real(PDM_YPH(pdmp,j)), 1, GM_PLUS, MSIZE, MSIZE) + else + call gpmark (gp, real(PDM_XPH(pdmp,j))+1.0, + real(PDM_YPH(pdmp,j)), 1, GM_POINT, 1.0, 1.0) + + call gscur (gp, real(PDM_XPH(pdmp,j)), real(PDM_YPH(pdmp,j))) + call gseti (gp, G_PMLTYPE, GL_CLEAR) + call gmark (gp, real(PDM_XPH(pdmp,j)), real(PDM_YPH(pdmp,j)), + GM_CROSS, MSIZE, MSIZE) + call gseti (gp, G_PMLTYPE, GL_SOLID) + if (PDM_NPT(pdmp) <= PDM_PLUSPOINT(pdmp)) + call gpmark (gp, real(PDM_XPH(pdmp,j)), + real(PDM_YPH(pdmp,j)), 1, GM_PLUS, MSIZE, MSIZE) + else + call gpmark (gp, real(PDM_XPH(pdmp,j)), + real(PDM_YPH(pdmp,j)), 1, GM_POINT, 1.0, 1.0) + + # Calculate which point this corresponds to. + index = PDM_SORT(pdmp,j) + PDM_INUSE(pdmp,index) = 1 + call gflush (gp) + } + + return (index) + } else + return (0) +end diff --git a/noao/astutil/pdm/t_pdm.x b/noao/astutil/pdm/t_pdm.x new file mode 100644 index 00000000..7498804a --- /dev/null +++ b/noao/astutil/pdm/t_pdm.x @@ -0,0 +1,72 @@ + +include <ctype.h> +include <error.h> +include <mach.h> +include "pdm.h" + +# PDM -- Phase Dispersion Minimization. Find periodicities in light +# curve data. Root program. + +procedure t_pdm() + +char infile[SZ_FNAME] # input data file +char metafile[SZ_FNAME] # batch metafile +char batchfile[SZ_FNAME] # batch log file +char device[SZ_FNAME] # plot device +bool interactive # interactive or batch flag +bool autoranges # autoranges flag + +int ptype # plot type +pointer pdmp, pdm_open() # structure stuff +bool flip, clgetb() +real clgetr() +int clgeti(), pdm_gdata(), pdm_autorang() +errchk pdm_open, pdm_autorang, pdm_batch, pdm_cursor + +begin + # Get some of the CL parameters and open the pdm data structure. + call clgstr ("infiles", infile, SZ_FNAME) + call clgstr ("metafile", metafile, SZ_FNAME) + call clgstr ("batchfile", batchfile, SZ_FNAME) + call clgstr ("device", device, SZ_FNAME) + interactive = clgetb ("interactive") + flip = clgetb ("flip") + pdmp = pdm_open (device, batchfile, metafile, interactive) + + # Clio to get more parameters. + PDM_PMIN(pdmp) = double(clgetr ("minp")) + call clputr ("minp", real(PDM_PMIN(pdmp))) + if (PDM_PMIN(pdmp) > EPSILOND) + PDM_FMAX(pdmp) = 1.0d+0/PDM_PMIN(pdmp) + else + PDM_FMAX(pdmp) = 0.0d+0 + PDM_PMAX(pdmp) = double(clgetr ("maxp")) + call clputr ("maxp", real(PDM_PMAX(pdmp))) + if (PDM_PMAX(pdmp) > EPSILOND) + PDM_FMIN(pdmp) = 1.0d+0/PDM_PMAX(pdmp) + else + PDM_FMIN(pdmp) = 0.0d+0 + PDM_NTHPT(pdmp) = clgeti ("ntheta") + autoranges = clgetb ("autoranges") + PDM_NSIGMA(pdmp) = double(clgetr ("nsigma")) + PDM_PLUSPOINT(pdmp) = clgeti ("pluspoint") + + # Read in the data. + PDM_NPT(pdmp) = pdm_gdata (pdmp, infile) + + # If the autoranges flag is set, call the autorange subroutine. + if (autoranges) + PDM_NRANGE(pdmp) = pdm_autorang (pdmp) + + if (!interactive) + call pdm_batch (pdmp, batchfile, infile, flip) + else { + # Plot the data on the screen and call the cursor loop. + call pdm_dplot (pdmp, infile, flip) + ptype = DATAPLOT + call pdm_cursor(pdmp, ptype, infile, flip) + } + + # Close the pdm data structure. + call pdm_close (pdmp, interactive) +end diff --git a/noao/astutil/precess.par b/noao/astutil/precess.par new file mode 100644 index 00000000..c6151f39 --- /dev/null +++ b/noao/astutil/precess.par @@ -0,0 +1,4 @@ +input,f,a,STDIN,,,input files +startyear,r,a,1950,,,precess from year +endyear,r,a,1984,,,precess to year +stdepoch,r,h,0,,,standard epoch for second set of output coords (0 to skip) diff --git a/noao/astutil/precess.x b/noao/astutil/precess.x new file mode 100644 index 00000000..fe52e8fa --- /dev/null +++ b/noao/astutil/precess.x @@ -0,0 +1,112 @@ +include <fset.h> + +# PRECESS -- Precess a list of coordinates read from the standard input +# from startyear to endyear. + +procedure t_precess() + +char fname[SZ_FNAME] +int filelist +double default_year1, default_year2, stdepoch +bool streq() +double clgetd() +int clpopni(), clgfil() + +begin + # Input can come from the standard input, a file, or a list of files. + # The following procedure makes both cases look like a list of files. + + filelist = clpopni ("input") + + # Fetch default startyear and endyear parameters from the CL. + default_year1 = clgetd ("startyear") + default_year2 = clgetd ("endyear") + + # Output coords for a standard epoch as well as for year2? + stdepoch = clgetd ("stdepoch") + + # Process each coordinate list. If reading from the standard input, + # set up the standard output to flush after every output line, so that + # precessed coords come back immediately when working interactively. + + while (clgfil (filelist, fname, SZ_FNAME) != EOF) { + if (streq (fname, "STDIN")) + call fseti (STDOUT, F_FLUSHNL, YES) + else + call fseti (STDOUT, F_FLUSHNL, NO) + call precess_coordinate_list (STDOUT, fname, + default_year1, default_year2, stdepoch) + } + + call clpcls (filelist) +end + + +# PRECESS_COORDINATE_LIST -- Precess a list of coordinates read from the +# named file, writing the results on the output file. If stdepoch is not +# zero, print the coords precessed to the given standard epoch as well. + +procedure precess_coordinate_list (out, listfile, defyear1, defyear2, stdepoch) + +int out # output stream +char listfile[SZ_FNAME] # input file +double defyear1, defyear2 # default years +double stdepoch # standard epoch + +int in +double year1, year2 +double ra1, dec1, ra2, dec2 +int fscan(), nscan(), open() +errchk open, fscan, printf + +begin + in = open (listfile, READ_ONLY, TEXT_FILE) + + # Read successive RA,DEC coordinate pairs from the standard input, + # precessing and printing the result on the standard output. + + while (fscan (in) != EOF) { + call gargd (ra1) + call gargd (dec1) + call gargd (year1) + call gargd (year2) + + # If there is something wrong with the input coords, print warning + # and skip the precession. If years are not given with entry, + # use defaults (nscan returns the number of items successfully + # decoded from the input line) + + if (nscan() < 2) { + call eprintf ("Bad entry in coordinate list\n") + next + } else if (nscan() == 2) { + year1 = defyear1 + year2 = defyear2 + } else if (nscan() == 3) + year2 = defyear2 + + # Call precession routine to perform the precession, and write + # precessed coords to the standard output. + + call ast_precess (ra1, dec1, year1, ra2, dec2, year2) + call fprintf (out, "%13.2h %13.2h %7.1f") + call pargd (ra2) + call pargd (dec2) + call pargd (year2) + + # Add output for the input coords precessed to the standard + # epoch, if desired. + + if (stdepoch != 0) { + call ast_precess (ra1, dec1, year1, ra2, dec2, stdepoch) + call fprintf (out, "%18.2h %12.2h %7.1f") + call pargd (ra2) + call pargd (dec2) + call pargd (stdepoch) + } + + call fprintf (out, "\n") + } + + call close (in) +end diff --git a/noao/astutil/rvcorrect.com b/noao/astutil/rvcorrect.com new file mode 100644 index 00000000..4ab7873e --- /dev/null +++ b/noao/astutil/rvcorrect.com @@ -0,0 +1,5 @@ +double latitude, longitude, altitude # Location of observation +double vs # Solar velocity +double ras, decs, eps # Coordinate of solar velocity + +common /rvc_com/ latitude, longitude, altitude, vs, ras, decs, eps diff --git a/noao/astutil/rvcorrect.par b/noao/astutil/rvcorrect.par new file mode 100644 index 00000000..94ad9816 --- /dev/null +++ b/noao/astutil/rvcorrect.par @@ -0,0 +1,26 @@ +files,s,h,"",,,List of files containing observation data +images,s,h,"",,,List of images containing observation data +header,b,h,yes,,,Print header? +input,b,h,no,,,Print input data? +imupdate,b,h,no,,,"Update image header with corrections? +" + +epoch,r,h,INDEF,,,Epoch of observation coordinates (years) +observatory,s,h,)_.observatory,,,Observatory +vsun,r,h,20.,,,Solar velocity (km/s) +ra_vsun,r,h,18.,0.,24.,Right ascension of solar velocity (hours) +dec_vsun,r,h,30.,-90.,90.,Declination of solar velocity (degrees) +epoch_vsun,r,h,1900.,,,"Epoch of solar coordinates (years) +" + +year,i,h,,,,Year of observation +month,i,h,,1,12,Month of observation (1-12) +day,i,h,,1,31,Day of observation +ut,r,h,,0.,24.,UT of observation (hours) +ra,r,h,,0.,24.,Right ascension of observation (hours) +dec,r,h,,-90.,90.,Declination of observation (degrees) +vobs,r,h,0.,,,"Observed radial velocity" + +hjd,r,h,,,,Helocentric Julian Day (output) +vhelio,r,h,,,,Helocentric radial velocity (km/s) (output) +vlsr,r,h,,,,Local standard or rest radial velocity (km/s) (output) diff --git a/noao/astutil/setairmass.par b/noao/astutil/setairmass.par new file mode 100644 index 00000000..230c82e7 --- /dev/null +++ b/noao/astutil/setairmass.par @@ -0,0 +1,19 @@ +# SETAIRMASS parameter file + +images,s,a,,,,"Input images" +observatory,s,h,)_.observatory,,,"Observatory for images" +intype,s,h,"beginning","beginning|middle|end",,"Input keyword time stamp" +outtype,s,h,"effective","beginning|middle|end|effective",,"Output airmass time stamp\n" +ra,s,h,"ra",,,"Right acsension keyword (hours)" +dec,s,h,"dec",,,"Declination keyword (degrees)" +equinox,s,h,"epoch",,,"Equinox keyword (years)" +st,s,h,"st",,,"Local siderial time keyword (hours)" +ut,s,h,"ut",,,"Universal time keyword (hours)" +date,s,h,"date-obs",,,"Observation date keyword" +exposure,s,h,"exptime",,,"Exposure time keyword (seconds)" +airmass,s,h,"airmass",,,"Airmass keyword (output)" +utmiddle,s,h,"utmiddle",,,"Mid-observation UT keyword (output)" +scale,r,h,750.0,,,"The atmospheric scale height\n" +show,b,h,yes,,,"Print the airmasses and mid-UT?" +update,b,h,yes,,,"Update the image header?" +override,b,h,yes,,,"Override previous assignments?" diff --git a/noao/astutil/setjd.par b/noao/astutil/setjd.par new file mode 100644 index 00000000..01ba5744 --- /dev/null +++ b/noao/astutil/setjd.par @@ -0,0 +1,16 @@ +images,s,a,,,,"Images" +observatory,s,h,)_.observatory,,,"Observatory of observation" +date,s,h,"date-obs",,,"Date of observation keyword" +time,s,h,"ut",,,"Time of observation keyword" +exposure,s,h,"exptime",,,"Exposure time keyword" +ra,s,h,"ra",,,"Right ascension (hours) keyword" +dec,s,h,"dec",,,"Declination (degrees) keyword" +epoch,s,h,"epoch",,,"Epoch (years) keyword +" +jd,s,h,"jd",,,"Output Julian date keyword" +hjd,s,h,"hjd",,,"Output Helocentric Julian date keyword" +ljd,s,h,"ljd",,,"Output local Julian date keyword +" +utdate,b,h,yes,,,"Is observation date UT?" +uttime,b,h,yes,,,"Is observation time UT?" +listonly,b,h,no,,,"List only without modifying images?" diff --git a/noao/astutil/t_astcalc.x b/noao/astutil/t_astcalc.x new file mode 100644 index 00000000..65f649f6 --- /dev/null +++ b/noao/astutil/t_astcalc.x @@ -0,0 +1,393 @@ +include <error.h> +include <fset.h> +include <evvexpr.h> +include <ctype.h> +include <ctotok.h> +include <lexnum.h> +include <time.h> +include "astfunc.h" + +define SZ_KEY 32 + + +# T_ASTCALC -- Calculator including astronomical routines. + +procedure t_astcalc() + +pointer cmd # command file +pointer imlist # image list +pointer table # data table +pointer col # column names +pointer prompt # prompt for STDIN +bool verbose # verbose output? + +bool eval +int i, ip, sz_cmd, fdcmd, ncmds, nim, tm[LEN_TMSTRUCT] +long pos +pointer sp, image, key, expr, keys, exprs, ast +pointer stopen(), immap() +int open(), fscan(), fstati(), nowhite(), ctotok() +int imtopenp(), imtlen(), imtgetim() +int strlen(), stridxs() +long note(), clktime(), lsttogmt() +bool clgetb(), streq() +errchk open, stopen, immap + +begin + call smark (sp) + call salloc (image, SZ_FNAME, TY_CHAR) + call salloc (table, SZ_FNAME, TY_CHAR) + call salloc (prompt, SZ_FNAME, TY_CHAR) + call salloc (col, SZ_LINE, TY_CHAR) + call salloc (key, SZ_KEY, TY_CHAR) + + sz_cmd = SZ_LINE + call malloc (cmd, sz_cmd, TY_CHAR) + call malloc (expr, sz_cmd, TY_CHAR) + + # Create ast_func data structure. + call calloc (ast, LEN_AST, TY_STRUCT) + + # Open symbol table for storing results. + AST_STP(ast) = stopen ("astcalc", 20, 1024, 20*SZ_KEY) + + # Open the command file and initialize + ncmds = 0 + call clgstr ("commands", Memc[cmd], sz_cmd) + if (nowhite (Memc[cmd], Memc[cmd], sz_cmd) > 0) { + fdcmd = open (Memc[cmd], READ_ONLY, TEXT_FILE) + Memc[prompt] = EOS + } else { + fdcmd = STDIN + call clgstr ("prompt", Memc[prompt], SZ_FNAME) + } + eval = TRUE + verbose = clgetb ("verbose") + call fseti (STDOUT, F_FLUSHNL, YES) + + # Open the image list and first image. + imlist = imtopenp ("images") + nim = imtlen (imlist) + if (nim > 0) { + i = imtgetim (imlist, Memc[image], SZ_FNAME) + iferr (AST_IM(ast) = immap (Memc[image], READ_WRITE, 0)) + AST_IM(ast) = immap (Memc[image], READ_ONLY, 0) + call sprintf (Memc[expr], sz_cmd, "\"%s\"") + call pargstr (Memc[image]) + call ac_evaluate (ast, "$I", Memc[expr], eval, verbose) + } + + # Open the table file. + call clgstr ("table", Memc[table], SZ_FNAME) + if (nowhite (Memc[table], Memc[table], SZ_FNAME) > 0) { + AST_TFD(ast) = open (Memc[table], READ_ONLY, TEXT_FILE) + pos = note (AST_TFD(ast)) + } + + # Set special operands. + pos = clktime(0) + call brktime (pos, tm) + call sprintf (Memc[expr], sz_cmd, "\"%04d-%02d-%02d\"") + call pargi (TM_YEAR(tm)) + call pargi (TM_MDAY(tm)) + call pargi (TM_MONTH(tm)) + call ac_evaluate (ast, "$D", Memc[expr], eval, verbose) + call sprintf (Memc[expr], sz_cmd, "\"%02d:%02d:%02d\"") + call pargi (TM_HOUR(tm)) + call pargi (TM_MIN(tm)) + call pargi (TM_SEC(tm)) + call ac_evaluate (ast, "$T", Memc[expr], eval, verbose) + call brktime (lsttogmt(pos), tm) + call sprintf (Memc[expr], sz_cmd, "\"%04d-%02d-%02d\"") + call pargi (TM_YEAR(tm)) + call pargi (TM_MONTH(tm)) + call pargi (TM_MDAY(tm)) + call ac_evaluate (ast, "$GMD", Memc[expr], eval, verbose) + call sprintf (Memc[expr], sz_cmd, "\"%02d:%02d:%02d\"") + call pargi (TM_HOUR(tm)) + call pargi (TM_MIN(tm)) + call pargi (TM_SEC(tm)) + call ac_evaluate (ast, "$GMT", Memc[expr], eval, verbose) + call sprintf (Memc[expr], sz_cmd, "\"%04d-%02d-%02dT%02d:%02d:%02d\"") + call pargi (TM_YEAR(tm)) + call pargi (TM_MONTH(tm)) + call pargi (TM_MDAY(tm)) + call pargi (TM_HOUR(tm)) + call pargi (TM_MIN(tm)) + call pargi (TM_SEC(tm)) + call ac_evaluate (ast, "$GMDT", Memc[expr], eval, verbose) + + # Read and evaluate commands. + repeat { + if (Memc[prompt] != EOS) { + call printf (Memc[prompt]) + call flush (STDOUT) + } + + # Get next command. Allow for continuation lines. + if (fscan (fdcmd) == EOF) + break + ip = 1 + repeat { + call gargstr (Memc[cmd+ip-1], sz_cmd) + ip = strlen (Memc[cmd]) + if (Memc[cmd+ip-1] != '\\') + break + if (fscan (fdcmd) == EOF) + break + if (ip + SZ_LINE >= sz_cmd) { + sz_cmd = sz_cmd + SZ_LINE + call realloc (cmd, sz_cmd, TY_CHAR) + call realloc (expr, sz_cmd, TY_CHAR) + } + } + + # Eliminate comments, leading/trailing whitespace, and blank lines. + ip = stridxs ("#", Memc[cmd]) + if (ip > 0) + Memc[cmd+ip-1] = EOS + ip = strlen (Memc[cmd]) + while (IS_WHITE(Memc[cmd+ip-1])) + ip = ip - 1 + Memc[cmd+ip] = EOS + ip = 1 + while (IS_WHITE(Memc[cmd+ip-1])) + ip = ip + 1 + call strcpy (Memc[cmd+ip-1], Memc[cmd], sz_cmd) + if (Memc[cmd] == EOS) + next + + # Parse variable. + ip = 1 + if (Memc[cmd+ip-1] == '$') { + ip = ip + 1 + Memc[key] = '$' + i = ctotok (Memc[cmd], ip, Memc[key+1], SZ_KEY) + } else if (Memc[cmd+ip-1] == '@') { + ip = ip + 2 + i = 0 + while (Memc[cmd+ip-1]!=Memc[cmd+1] && Memc[cmd+ip-1]!=EOS) { + Memc[key+i] = Memc[cmd+ip-1] + i = i + 1 + ip = ip + 1 + } + Memc[key+i] = EOS + if (Memc[cmd+ip-1] != Memc[cmd+1]) { + call sprintf (Memc[expr], sz_cmd, + "Syntax error `%s'") + call pargstr (Memc[cmd]) + call error (1, Memc[cmd]) + } + ip = ip + 1 + i = TOK_IDENTIFIER + } else + i = ctotok (Memc[cmd], ip, Memc[key], SZ_KEY) + + switch (i) { + case TOK_IDENTIFIER: + while (IS_WHITE(Memc[cmd+ip-1])) + ip = ip + 1 + if (Memc[cmd+ip-1] == '=') + ip = ip + 1 + else { + ip = 1 + Memc[key] = EOS + } + default: + ip = 1 + Memc[key] = EOS + } + + # Parse expression. + while (IS_WHITE(Memc[cmd+ip-1]) || Memc[cmd+ip-1] == '=') + ip = ip + 1 + call strcpy (Memc[cmd+ip-1], Memc[expr], sz_cmd) + + if (streq (Memc[expr], "quit")) + break + + # Save command. + if (ncmds == 0) { + call malloc (keys, 100, TY_POINTER) + call malloc (exprs, 100, TY_POINTER) + } else if (mod (ncmds, 100) == 0) { + call realloc (keys, ncmds+100, TY_POINTER) + call realloc (exprs, ncmds+100, TY_POINTER) + } + + call salloc (Memi[keys+ncmds], SZ_KEY, TY_CHAR) + call strcpy (Memc[key], Memc[Memi[keys+ncmds]], SZ_KEY) + ip = strlen (Memc[expr]) + call salloc (Memi[exprs+ncmds], ip, TY_CHAR) + call strcpy (Memc[expr], Memc[Memi[exprs+ncmds]], ip) + + # Evaluate expression. + call ac_evaluate (ast, Memc[key], Memc[expr], eval, verbose) + + ncmds = ncmds + 1 + } + if (AST_IM(ast) != NULL) + call imunmap (AST_IM(ast)) + call close (fdcmd) + + # Repeat commands for other lines in the table and other images. + # Note must be called in order to check for EOF in table. + + if (ncmds > 0 && (nim > 1 || AST_TFD(ast) != NULL)) { + repeat { + eval = TRUE + if (AST_TFD(ast) != NULL) { + if (pos == note (AST_TFD(ast))) + break + if (fstati (AST_TFD(ast), F_EOF) == YES) + break + } + if (nim > 0) { + if (imtgetim (imlist, Memc[image], SZ_FNAME) == EOF) + break + iferr (AST_IM(ast) = immap (Memc[image], READ_WRITE, 0)) + AST_IM(ast) = immap (Memc[image], READ_ONLY, 0) + call sprintf (Memc[expr], sz_cmd, "\"%s\"") + call pargstr (Memc[image]) + call ac_evaluate (ast, "$I", Memc[expr], eval, verbose) + } + + do i = 1, ncmds + call ac_evaluate (ast, Memc[Memi[keys+i-1]], + Memc[Memi[exprs+i-1]], eval, verbose) + + if (AST_IM(ast) != NULL) + call imunmap (AST_IM(ast)) + } + } + + if (AST_TFD(ast) != NULL) + call close (AST_TFD(ast)) + if (AST_STP(ast) != NULL) + call stclose (AST_STP(ast)) + call mfree (cmd, TY_CHAR) + call mfree (expr, TY_CHAR) + call sfree (sp) +end + + +# AC_EVALUATE -- Evaluate the value of the key and add it to symbol table. + +procedure ac_evaluate (ast, key, expr, eval, verbose) + +pointer ast #I Data structure +char key[ARB] #I name of key to be edited +char expr[ARB] #I value expression +bool eval #U Conditional flag +bool verbose #I verbose output? + +bool streq() +pointer o, sym, evvexpr(), stfind(), stenter() +int locpr(), strncmp() +extern ac_getop(), ast_func() +errchk evvexpr + +begin + # Check conditional evaluation. + if (streq (expr, "endif")) { + eval = TRUE + return + } else if (streq (expr, "else")) { + eval = (!eval) + return + } + if (!eval) + return + + # Evaluate the expression. + o = NULL + if (expr[1] != EOS) + o = evvexpr (expr, locpr (ac_getop), ast, locpr (ast_func), ast, 0) + if (o == NULL) + return + + # Set conditional evalution. + if (key[1] == EOS) { + if (strncmp (expr, "if ", 3) == 0 || strncmp (expr, "if(", 3) == 0) + eval = (O_VALI(o) != 0) + + } else { + # Print the verbose output. + if (verbose) { + switch (O_TYPE(o)) { + case TY_BOOL: + call printf (" %s = %b\n") + call pargstr (key) + call pargi (O_VALI(o)) + case TY_CHAR: + call printf (" %s = %s\n") + call pargstr (key) + call pargstr (O_VALC(o)) + case TY_INT: + call printf (" %s = %d\n") + call pargstr (key) + call pargi (O_VALI(o)) + case TY_REAL: + call printf (" %s = %g\n") + call pargstr (key) + call pargr (O_VALR(o)) + case TY_DOUBLE: + call printf (" %s = %g\n") + call pargstr (key) + call pargd (O_VALD(o)) + } + } + + sym = stfind (AST_STP(ast), key) + if (sym == NULL) + sym = stenter (AST_STP(ast), key, SZ_LINE) + Memi[sym] = O_TYPE(o) + switch (O_TYPE(o)) { + case TY_BOOL: + Memi[sym+2] = O_VALI(o) + case TY_CHAR: + call strcpy (O_VALC(o), Memc[P2C(sym+2)], SZ_LINE) + case TY_INT: + Memi[sym+2] = O_VALI(o) + case TY_REAL: + Memd[P2D(sym+2)] = O_VALR(o) + case TY_DOUBLE: + Memd[P2D(sym+2)] = O_VALD(o) + } + } + + call mfree (o, TY_STRUCT) +end + + +# AC_GETOP -- Satisfy an operand request from EVEXPR. In this context, +# operand names refer to entries in the symbol table. + +procedure ac_getop (ast, operand, o) + +pointer ast #I Data structure +char operand[ARB] #I name of operand to be returned +pointer o #O pointer to output operand + +pointer sym, stfind() + +begin + # Get operand value from symbol table. + sym = stfind (AST_STP(ast), operand) + if (sym == NULL) + call xvv_error1 ("variable `%s' not found", operand[1]) + + switch (Memi[sym]) { + case TY_BOOL, TY_SHORT, TY_INT, TY_LONG: + call xvv_initop (o, 0, TY_INT) + O_VALI(o) = Memi[sym+2] + + case TY_REAL, TY_DOUBLE, TY_COMPLEX: + call xvv_initop (o, 0, TY_DOUBLE) + O_VALD(o) = Memd[P2D(sym+2)] + + default: + call xvv_initop (o, SZ_LINE, TY_CHAR) + call strcpy (Memc[P2C(sym+2)], O_VALC(o), SZ_LINE) + } +end diff --git a/noao/astutil/t_asthedit.x b/noao/astutil/t_asthedit.x new file mode 100644 index 00000000..51cf2796 --- /dev/null +++ b/noao/astutil/t_asthedit.x @@ -0,0 +1,561 @@ +include <error.h> +include <fset.h> +include <evvexpr.h> +include <ctype.h> +include <ctotok.h> +include <lexnum.h> +include <imset.h> +include <time.h> +include "astfunc.h" + +define SZ_KEY 8 +define SPECIAL "|if|else|endif|print|printf|quit|" + + +# T_ASTHEDIT -- Edit/calculator keywords in an image header including +# astronomical routines. + +procedure t_asthedit() + +int imlist # list of images +pointer cmd # command file +pointer table # data table +pointer col # column names +pointer prompt # prompt for STDIN +bool update # update image header? +bool verbose # verbose output? +bool oldstyle # use old style without equals sign? + +bool eval +int i, ip, sz_cmd, fdcmd, ncmds, acmode, nim, tm[LEN_TMSTRUCT] +long pos +pointer sp, image, key, expr, keys, exprs, ast +pointer stopen() +int imtopenp(), imtlen(), imtgetim(), immap() +int open(), fscan(), fstati(), nowhite(), ctowrd(), ctotok() +int strlen(), stridxs(), strdic() +bool clgetb(), streq() +long note(), clktime(), lsttogmt() +errchk open, stopen, immap + +begin + call smark (sp) + call salloc (image, SZ_FNAME, TY_CHAR) + call salloc (table, SZ_FNAME, TY_CHAR) + call salloc (prompt, SZ_FNAME, TY_CHAR) + call salloc (col, SZ_LINE, TY_CHAR) + call salloc (key, SZ_KEY, TY_CHAR) + + sz_cmd = SZ_LINE + call malloc (cmd, sz_cmd, TY_CHAR) + call malloc (expr, sz_cmd, TY_CHAR) + + # Create ast_func data structure. + call calloc (ast, LEN_AST, TY_STRUCT) + + # Open symbol table for storing results. + AST_STP(ast) = stopen ("astcalc", 20, 1024, 20*SZ_KEY) + + # Open the image list and first image. + imlist = imtopenp ("images") + nim = imtlen (imlist) + if (imtgetim (imlist, Memc[image], SZ_FNAME) == EOF) { + call mktemp ("tmp$iraf", Memc[image], SZ_FNAME) + AST_IM(ast) = immap (Memc[image], NEW_IMAGE, 0) + } else { + update = clgetb ("update") + if (update) + acmode = READ_WRITE + else + acmode = READ_ONLY + repeat { + ifnoerr (AST_IM(ast) = immap (Memc[image], acmode, 0)) + break + call erract (EA_WARN) + if (imtgetim (imlist, Memc[image], SZ_FNAME) == EOF) { + call sfree (sp) + return + } + } + } + + # Open the command file. + ncmds = 0 + call clgstr ("commands", Memc[cmd], SZ_LINE) + if (nowhite (Memc[cmd], Memc[cmd], SZ_FNAME) > 0) { + fdcmd = open (Memc[cmd], READ_ONLY, TEXT_FILE) + Memc[prompt] = EOS + } else { + fdcmd = STDIN + call clgstr ("prompt", Memc[prompt], SZ_FNAME) + } + oldstyle = clgetb ("oldstyle") + + # Set conditional flag and verbose and print output. + eval = TRUE + call fseti (STDOUT, F_FLUSHNL, YES) + verbose = clgetb ("verbose") + if (verbose) { + call printf ("%s:\n") + call pargstr (Memc[image]) + } + + # Set special operands. + call sprintf (Memc[expr], sz_cmd, "\"%s\"") + call pargstr (Memc[image]) + call ah_evaluate (ast, "$I", Memc[expr], eval, verbose) + pos = clktime(0) + call brktime (pos, tm) + call sprintf (Memc[expr], sz_cmd, "\"%02d/%02d/%02d\"") + call pargi (TM_MDAY(tm)) + call pargi (TM_MONTH(tm)) + call pargi (mod (TM_YEAR(tm), 100)) + call ah_evaluate (ast, "$D", Memc[expr], eval, verbose) + call sprintf (Memc[expr], sz_cmd, "\"%02d:%02d:%02d\"") + call pargi (TM_HOUR(tm)) + call pargi (TM_MIN(tm)) + call pargi (TM_SEC(tm)) + call ah_evaluate (ast, "$T", Memc[expr], eval, verbose) + call brktime (lsttogmt(pos), tm) + call sprintf (Memc[expr], sz_cmd, "\"%04d-%02d-%02d\"") + call pargi (TM_YEAR(tm)) + call pargi (TM_MONTH(tm)) + call pargi (TM_MDAY(tm)) + call ah_evaluate (ast, "$GMD", Memc[expr], eval, verbose) + call sprintf (Memc[expr], sz_cmd, "\"%02d:%02d:%02d\"") + call pargi (TM_HOUR(tm)) + call pargi (TM_MIN(tm)) + call pargi (TM_SEC(tm)) + call ah_evaluate (ast, "$GMT", Memc[expr], eval, verbose) + call sprintf (Memc[expr], sz_cmd, "\"%04d-%02d-%02dT%02d:%02d:%02d\"") + call pargi (TM_YEAR(tm)) + call pargi (TM_MONTH(tm)) + call pargi (TM_MDAY(tm)) + call pargi (TM_HOUR(tm)) + call pargi (TM_MIN(tm)) + call pargi (TM_SEC(tm)) + call ah_evaluate (ast, "$GMDT", Memc[expr], eval, verbose) + + # Open the table file, get the column names, and insert + # fscan in commands. + + Memc[col] = EOS + call clgstr ("table", Memc[table], SZ_FNAME) + if (nowhite (Memc[table], Memc[table], SZ_FNAME) > 0) { + AST_TFD(ast) = open (Memc[table], READ_ONLY, TEXT_FILE) + pos = note (AST_TFD(ast)) + call clgstr ("colnames", Memc[col], SZ_LINE) + i = 0 + ip = 1 + while (ctowrd (Memc[col], ip, Memc[key], SZ_KEY) > 0) { + if (i == 0) + call strcpy ("fscan (\"$", Memc[expr], sz_cmd) + else + call strcat ("\", \"$", Memc[expr], sz_cmd) + call strcat (Memc[key], Memc[expr], sz_cmd) + i = i + 1 + } + if (i > 0) { + call strcat ("\")", Memc[expr], sz_cmd) + Memc[key] = EOS + if (ncmds == 0) { + call malloc (keys, 100, TY_POINTER) + call malloc (exprs, 100, TY_POINTER) + } else if (mod (ncmds, 100) == 0) { + call realloc (keys, ncmds+100, TY_POINTER) + call realloc (exprs, ncmds+100, TY_POINTER) + } + + call salloc (Memi[keys+ncmds], SZ_KEY, TY_CHAR) + call strcpy (Memc[key], Memc[Memi[keys+ncmds]], SZ_KEY) + ip = strlen (Memc[expr]) + call salloc (Memi[exprs+ncmds], ip, TY_CHAR) + call strcpy (Memc[expr], Memc[Memi[exprs+ncmds]], ip) + ncmds = ncmds + 1 + + call ah_evaluate (ast, Memc[key], Memc[expr], eval, verbose) + } + } + + # Read and evaluate commands. + repeat { + if (Memc[prompt] != EOS) { + call printf (Memc[prompt]) + call flush (STDOUT) + } + + # Get next command. Allow for continuation lines. + if (fscan (fdcmd) == EOF) + break + ip = 1 + repeat { + call gargstr (Memc[cmd+ip-1], sz_cmd) + ip = strlen (Memc[cmd]) + if (Memc[cmd+ip-1] != '\\') + break + if (fscan (fdcmd) == EOF) + break + if (ip + SZ_LINE >= sz_cmd) { + sz_cmd = sz_cmd + SZ_LINE + call realloc (cmd, sz_cmd, TY_CHAR) + call realloc (expr, sz_cmd, TY_CHAR) + } + } + + # Eliminate comments, leading/trailing whitespace, and blank lines. + ip = stridxs ("#", Memc[cmd]) + if (ip > 0) + Memc[cmd+ip-1] = EOS + ip = strlen (Memc[cmd]) + while (IS_WHITE(Memc[cmd+ip-1])) + ip = ip - 1 + Memc[cmd+ip] = EOS + ip = 1 + while (IS_WHITE(Memc[cmd+ip-1])) + ip = ip + 1 + call strcpy (Memc[cmd+ip-1], Memc[cmd], sz_cmd) + if (Memc[cmd] == EOS) + next + + # Parse variable. + ip = 1 + if (Memc[cmd+ip-1] == '$') { + ip = ip + 1 + Memc[key] = '$' + i = ctotok (Memc[cmd], ip, Memc[key+1], SZ_KEY) + } else if (Memc[cmd+ip-1] == '@') { + ip = ip + 2 + i = 0 + while (Memc[cmd+ip-1]!=Memc[cmd+1] && Memc[cmd+ip-1]!=EOS) { + Memc[key+i] = Memc[cmd+ip-1] + i = i + 1 + ip = ip + 1 + } + Memc[key+i] = EOS + if (Memc[cmd+ip-1] != Memc[cmd+1]) { + call sprintf (Memc[expr], sz_cmd, + "Syntax error `%s'") + call pargstr (Memc[cmd]) + call error (1, Memc[cmd]) + } + ip = ip + 1 + i = TOK_IDENTIFIER + } else + i = ctotok (Memc[cmd], ip, Memc[key], SZ_KEY) + + switch (i) { + case TOK_IDENTIFIER: + while (IS_WHITE(Memc[cmd+ip-1])) + ip = ip + 1 + if (Memc[cmd+ip-1] == EOS) + ; + else if (Memc[cmd+ip-1] == '=') + ip = ip + 1 + else { + if (oldstyle) { + i = strdic (Memc[key], Memc[expr], sz_cmd, SPECIAL) + if (i > 0 && streq (Memc[key], Memc[expr])) { + ip = 1 + Memc[key] = EOS + } + } else { + ip = 1 + Memc[key] = EOS + } + } + default: + ip = 1 + Memc[key] = EOS + } + + # Parse expression. + while (IS_WHITE(Memc[cmd+ip-1]) || Memc[cmd+ip-1] == '=') + ip = ip + 1 + call strcpy (Memc[cmd+ip-1], Memc[expr], sz_cmd) + + if (streq (Memc[key], "quit")) + break + + # Save command. + if (ncmds == 0) { + call malloc (keys, 100, TY_POINTER) + call malloc (exprs, 100, TY_POINTER) + } else if (mod (ncmds, 100) == 0) { + call realloc (keys, ncmds+100, TY_POINTER) + call realloc (exprs, ncmds+100, TY_POINTER) + } + + call salloc (Memi[keys+ncmds], SZ_KEY, TY_CHAR) + call strcpy (Memc[key], Memc[Memi[keys+ncmds]], SZ_KEY) + ip = strlen (Memc[expr]) + call salloc (Memi[exprs+ncmds], ip, TY_CHAR) + call strcpy (Memc[expr], Memc[Memi[exprs+ncmds]], ip) + + # Evaluate expression. + call ah_evaluate (ast, Memc[key], Memc[expr], eval, verbose) + + ncmds = ncmds + 1 + } + call imunmap (AST_IM(ast)) + call close (fdcmd) + + # Repeat commands for other images. + if (ncmds > 0 && nim > 1) { + while (imtgetim (imlist, Memc[image], SZ_FNAME) != EOF) { + if (AST_TFD(ast) != NULL) { + if (pos == note (AST_TFD(ast))) + break + if (fstati (AST_TFD(ast), F_EOF) == YES) + call error (1, "Premature end-of-file in table") + } + + iferr (AST_IM(ast) = immap (Memc[image], acmode, 0)) { + call erract (EA_WARN) + next + } + + if (verbose) { + call printf ("%s:\n") + call pargstr (Memc[image]) + } + + eval = TRUE + call sprintf (Memc[expr], sz_cmd, "\"%s\"") + call pargstr (Memc[image]) + call ah_evaluate (ast, "$I", Memc[expr], eval, verbose) + + do i = 1, ncmds + call ah_evaluate (ast, Memc[Memi[keys+i-1]], + Memc[Memi[exprs+i-1]], eval, verbose) + + call imunmap (AST_IM(ast)) + } + } + + if (AST_TFD(ast) != NULL) + call close (AST_TFD(ast)) + if (AST_STP(ast) != NULL) + call stclose (AST_STP(ast)) + call mfree (cmd, TY_CHAR) + call mfree (expr, TY_CHAR) + call sfree (sp) +end + + +# AH_EVALUATE -- Evaluate the value of the named key and add it to symbol table. + +procedure ah_evaluate (ast, key, expr, eval, verbose) + +pointer ast #I Data structure +char key[ARB] #I name of key to be edited +char expr[ARB] #I value expression +bool eval #U Conditional flag +bool verbose #I verbose output? + +bool streq() +pointer sp, newval, oldval, o, im, sym, evvexpr(), stfind(), stenter() +int locpr(), strncmp() +extern ah_getop(), ast_func() +errchk evvexpr + +begin + call smark (sp) + + # Check conditional evaluation. + if (streq (key, "endif")) { + eval = TRUE + return + } else if (streq (key, "else")) { + eval = (!eval) + return + } + if (!eval) + return + + # Evaluate the expression. + o = NULL + if (expr[1] != EOS) + o = evvexpr (expr, locpr (ah_getop), ast, locpr (ast_func), ast, 0) + + # Set conditional evalution. + if (key[1] == EOS) { + if (strncmp (expr, "if ", 3) == 0 || strncmp (expr, "if(", 3) == 0) + eval = (O_VALI(o) != 0) + + } else if (o != NULL) { + # Print the verbose output. + if (verbose) { + call salloc (oldval, SZ_LINE, TY_CHAR) + call salloc (newval, SZ_LINE, TY_CHAR) + + switch (O_TYPE(o)) { + case TY_BOOL: + call sprintf (Memc[newval], SZ_LINE, "%b") + call pargi (O_VALI(o)) + case TY_CHAR: + call sprintf (Memc[newval], SZ_LINE, "%s") + call pargstr (O_VALC(o)) + case TY_INT: + call sprintf (Memc[newval], SZ_LINE, "%d") + call pargi (O_VALI(o)) + case TY_REAL: + call sprintf (Memc[newval], SZ_LINE, "%g") + call pargr (O_VALR(o)) + case TY_DOUBLE: + call sprintf (Memc[newval], SZ_LINE, "%g") + call pargd (O_VALD(o)) + } + + if (key[1] == '$') { + call printf (" %s = %s\n") + call pargstr (key) + call pargstr (Memc[newval]) + } else { + iferr (call imgstr (AST_IM(ast), key, Memc[oldval], + SZ_LINE)) { + call printf (" %s = %s\n") + call pargstr (key) + call pargstr (Memc[newval]) + } else { + call printf (" %s = %s -> %s\n") + call pargstr (key) + call pargstr (Memc[oldval]) + call pargstr (Memc[newval]) + } + } + } + + if (key[1] == '$') { + sym = stfind (AST_STP(ast), key) + if (sym == NULL) + sym = stenter (AST_STP(ast), key, SZ_LINE) + Memi[sym] = O_TYPE(o) + switch (O_TYPE(o)) { + case TY_BOOL: + Memi[sym+2] = O_VALI(o) + case TY_CHAR: + call strcpy (O_VALC(o), Memc[P2C(sym+2)], SZ_LINE) + case TY_INT: + Memi[sym+2] = O_VALI(o) + case TY_REAL: + Memd[P2D(sym+2)] = O_VALR(o) + case TY_DOUBLE: + Memd[P2D(sym+2)] = O_VALD(o) + } + } else if (key[1] != EOS) { + im = AST_IM(ast) + iferr (call imdelf (im, key)) + ; + switch (O_TYPE(o)) { + case TY_BOOL: + call imaddb (im, key, (O_VALI(o) == YES)) + case TY_CHAR: + call imastr (im, key, O_VALC(o)) + case TY_INT: + call imaddi (im, key, O_VALI(o)) + case TY_REAL: + call imaddr (im, key, O_VALR(o)) + case TY_DOUBLE: + call imaddd (im, key, O_VALD(o)) + } + } + } else if (key[1] != '$') { + im = AST_IM(ast) + + # Print the verbose output. + if (verbose) { + call salloc (oldval, SZ_LINE, TY_CHAR) + ifnoerr (call imgstr (im, key, Memc[oldval], SZ_LINE)) { + call printf (" %s = %s -> DELETED\n") + call pargstr (key) + call pargstr (Memc[oldval]) + } + } + + iferr (call imdelf (im, key)) + ; + } + + call mfree (o, TY_STRUCT) + call sfree (sp) +end + + +# AH_GETOP -- Satisfy an operand request from EVEXPR. In this context, +# operand names refer to image keywords or entries in the symbol table. + +procedure ah_getop (ast, operand, o) + +pointer ast #I Data structure +char operand[ARB] #I name of operand to be returned +pointer o #O pointer to output operand + +int ip, type, nchars +pointer sym, im, cp +int lexnum(), ctoi(), ctod(), imaccf(), imgeti(), imgftype() +double imgetd() +pointer stfind() + +begin + # Symbol table values. + if (operand[1] == '$') { + sym = stfind (AST_STP(ast), operand) + if (sym == NULL) + call xvv_error1 ("variable `%s' not found", operand[1]) + + switch (Memi[sym]) { + case TY_BOOL, TY_SHORT, TY_INT, TY_LONG: + call xvv_initop (o, 0, TY_INT) + O_VALI(o) = Memi[sym+2] + + case TY_REAL, TY_DOUBLE, TY_COMPLEX: + call xvv_initop (o, 0, TY_DOUBLE) + O_VALD(o) = Memd[P2D(sym+2)] + + default: + call xvv_initop (o, SZ_LINE, TY_CHAR) + call strcpy (Memc[P2C(sym+2)], O_VALC(o), SZ_LINE) + } + + # Expression values. + } else { + im = AST_IM(ast) + if (imaccf (im, operand) == NO) + call xvv_error1 ("image keyword `%s' not found", operand[1]) + + switch (imgftype (im, operand)) { + case TY_BOOL, TY_SHORT, TY_INT, TY_LONG: + call xvv_initop (o, 0, TY_INT) + O_VALI(o) = imgeti (im, operand) + + case TY_REAL, TY_DOUBLE, TY_COMPLEX: + call xvv_initop (o, 0, TY_DOUBLE) + O_VALD(o) = imgetd (im, operand) + + default: + call malloc (cp, SZ_LINE, TY_CHAR) + call imgstr (im, operand, Memc[cp], SZ_LINE) + + ip = 1 + type = lexnum (Memc[cp], ip, nchars) + if (Memc[cp+nchars+ip-1] != EOS) + type = LEX_NONNUM + + switch (type) { + case LEX_OCTAL, LEX_DECIMAL, LEX_HEX: + call xvv_initop (o, 0, TY_INT) + ip = 1 + nchars = ctoi (Memc[cp], ip, O_VALI(o)) + case LEX_REAL: + call xvv_initop (o, 0, TY_DOUBLE) + ip = 1 + nchars = ctod (Memc[cp], ip, O_VALD(o)) + case LEX_NONNUM: + call xvv_initop (o, SZ_LINE, TY_CHAR) + call strcpy (Memc[cp], O_VALC(o), SZ_LINE) + } + + call mfree (cp, TY_CHAR) + } + } +end diff --git a/noao/astutil/t_asttimes.x b/noao/astutil/t_asttimes.x new file mode 100644 index 00000000..57f0d8af --- /dev/null +++ b/noao/astutil/t_asttimes.x @@ -0,0 +1,168 @@ +include <error.h> + +# T_ASTTIMES -- Print and record astronomical times for the given date. + +procedure t_asttimes () + +int list # List of files +int header # Print header? +int year # Year +int month # Month +int day # Day +double zt # Zone time +double zone # Time zone from Greenwich +double longitude # Longitude for LMST + +double ut # Universal time (output) +double epoch # Epoch (output) +double jd # Julian day (output) +double lmst # Local mean siderial time (output) + +int fd +char file[SZ_FNAME] +pointer obs + +int clpopnu(), clplen(), clgfil(), clgeti(), btoi() +int open(), fscan(), nscan() +bool clgetb() +double clgetd(), obsgetd() +pointer obsopen() + +begin + # Get parameters other than date. + list = clpopnu ("files") + header = btoi (clgetb ("header")) + call clgstr ("observatory", file, SZ_FNAME) + obs = obsopen (file) + if (header == YES) + call obslog (obs, "ASTTIMES", "timezone longitude", STDOUT) + zone = obsgetd (obs, "timezone") + longitude = obsgetd (obs, "longitude") + + # If no files are given then get dates from the CL. + if (clplen (list) == 0) { + # Get and print times. + year = clgeti ("year") + month = clgeti ("month") + day = clgeti ("day") + zt = clgetd ("time") + + call ast_times (year, month, day, zt, zone, longitude, ut, epoch, + jd, lmst, header) + + # Record results in the parameter file. + call clputd ("ut", ut) + call clputd ("epoch", epoch) + call clputd ("jd", jd) + call clputd ("lmst", lmst) + + } else { + # Scan each file in the list. + while (clgfil (list, file, SZ_FNAME) != EOF) { + iferr (fd = open (file, READ_ONLY, TEXT_FILE)) { + call erract (EA_WARN) + next + } + + # Get and print times. + while (fscan (fd) != EOF) { + call gargi (year) + call gargi (month) + call gargi (day) + call gargd (zt) + if (nscan() < 4) + next + + call ast_times (year, month, day, zt, zone, longitude, ut, + epoch, jd, lmst, header) + } + + call close (fd) + } + call clpcls (list) + } + + call obsclose (obs) +end + + +# TIMES -- Print times. + +procedure ast_times (year, month, day, zt, zone, longitude, ut, epoch, jd, lmst, + header) + +int year # Year +int month # Month (1-12) +int day # Day of month +double zt # Zone time +double zone # Time zone +double longitude # Longitude +double ut # UT +double epoch # Epoch in 365.25 solar mean days +double jd # Julian date +double lmst # Mean Sidereal Time +int header # Print header? + +char dow[3] +int d + +double ast_date_to_julday(), ast_mst() + +begin + # Determine day of the week in zone time. + if (zt < 0.) { + zt = zt + 24 + day = day - 1 + } + if (zt >= 24.) { + zt = zt - 24 + day = day + 1 + } + jd = ast_date_to_julday (year, month, day, zt) + call ast_julday_to_date (jd, year, month, day, zt) + call ast_date_to_epoch (year, month, day, zt, epoch) + call ast_day_of_week (jd, d, dow, 3) + + # Determine UT, EPOCH, JD, and MST. + for (ut=zone; ut<-12.; ut=ut+24.) + ; + for (; ut>=12.; ut=ut-24.) + ; + ut = zt + ut + d = day + if (ut < 0.) { + ut = ut + 24 + d = d - 1 + } + if (ut >= 24.) { + ut = ut - 24 + d = d + 1 + } + jd = ast_date_to_julday (year, month, d, ut) + call ast_date_to_epoch (year, month, d, ut, epoch) + lmst = ast_mst (epoch, longitude) + + # Print Times. + if (header == YES) { + call printf ("##%2s %3s %6s %10s %10s %10s %12s %10s\n") + call pargstr ("YR") + call pargstr ("MON") + call pargstr (" DAY ") + call pargstr ("ZT") + call pargstr ("UT") + call pargstr ("EPOCH") + call pargstr ("JD") + call pargstr ("LMST") + header = NO + } + call printf ("%4d %3d %2d %3s %10.1h %10.1h %10.5f %12.4f %10.1h\n") + call pargi (year) + call pargi (month) + call pargi (day) + call pargstr (dow) + call pargd (nint (zt*36000.0D0)/36000.0D0) + call pargd (nint (ut*36000.0D0)/36000.0D0) + call pargd (epoch) + call pargd (jd) + call pargd (nint (lmst*36000.0D0)/36000.0D0) +end diff --git a/noao/astutil/t_gratings.x b/noao/astutil/t_gratings.x new file mode 100644 index 00000000..69e75ec1 --- /dev/null +++ b/noao/astutil/t_gratings.x @@ -0,0 +1,345 @@ +include <error.h> +include <math.h> + + +# T_GRATINGS -- Compute grating parameters. +# Given a subset of grating parameters the remainder are computed. + +procedure t_gratings() + +bool e # Echelle grating? +real f # Focal length (mm) +real g # Grating grooves per mm +real b # Blaze angle (degrees) +real t # Angle of incidence (degrees) +int m # Order +real w # Blaze wavelength (Angstroms) +real d # Blaze dispersion (Angstroms / mm) + +bool clgetb() +int clgeti() +real clgetr() + +begin + # Input grating parameters. + e = clgetb ("echelle") + f = clgetr ("f") + g = clgetr ("gmm") + b = clgetr ("blaze") + t = clgetr ("theta") + m = clgeti ("order") + w = clgetr ("wavelength") + d = clgetr ("dispersion") + + # Derive and check grating parameters. + iferr (call ast_grating (e, f, g, b, t, m, w, d)) + call erract (EA_WARN) + + # Print final parameters. + call printf ("Grating parameters:\n") + call printf (" Focal length = %g mm\n") + call pargr (f) + call printf (" Grating = %g grooves/mm\n") + call pargr (g) + call printf (" Blaze angle = %g degrees\n") + call pargr (b) + call printf (" Incidence angle = %g degrees\n") + call pargr (t) + call printf (" Order = %d\n") + call pargi (m) + call printf (" Blaze wavelength = %g Angstroms\n") + call pargr (w) + call printf (" Blaze dispersion = %g Angstroms/mm\n") + call pargr (d) +end + + +# Definitions of INDEF parameter flags. +define F 1B +define G 2B +define B 4B +define T 10B +define M 20B +define W 40B +define D 100B + +# Combinations +define FG 3B +define FB 5B +define FT 11B +define FM 21B +define FW 41B +define GB 6B +define GT 12B +define GW 42B +define GD 102B +define BT 14B +define BM 24B +define BW 44B +define BD 104B +define TM 30B +define TW 50B +define TD 110B +define MW 60B +define MD 120B +define WD 140B + + +# AST_GRATING -- Derive and check grating parameters. + +procedure ast_grating (e, f, g, b, t, m, w, d) + +bool e +real f, g, b, t, w, d, x +int m + +int i, flags +define err_ 10 + +begin + if (!IS_INDEF(f)) { + if (f <= 0.) + f = INDEF + } + if (!IS_INDEF(g)) { + if (g <= 0.) + g = INDEF + else + g = g / 1e7 + } + if (!IS_INDEF(b)) { + b = DEGTORAD (b) + if (b == 0. && t == 0.) + t = INDEF + } + if (!IS_INDEF(t)) { + t = DEGTORAD (t) + if (t > PI && !IS_INDEF(b)) + t = t - TWOPI + b + } + if (!IS_INDEFI(m) && m <= 0) + m = INDEFI + if (!IS_INDEF(w) && w <= 0.) + w = INDEF + if (!IS_INDEF(d) && d <= 0.) + d = INDEF + + flags = 0 + if (IS_INDEF(f)) + flags = flags + F + if (IS_INDEF(g)) + flags = flags + G + if (IS_INDEF(b)) + flags = flags + B + if (IS_INDEF(t)) + flags = flags + T + if (IS_INDEFI(m)) + flags = flags + M + if (IS_INDEF(w)) + flags = flags + W + if (IS_INDEF(d)) + flags = flags + D + + switch (flags) { + case 0, F, G, B, T, M, W, D: + switch (flags) { + case F: + f = cos (2 * b - t) / (g * m * d) + case G: + g = (sin (t) + sin (2 * b - t)) / (m * w) + if (g == 0.) + g = INDEF + case B: + if (t > PI) { + x = g * m * w / (2 * cos (t)) + if (abs (x) > 1.) + goto err_ + b = asin (x) + t = t - TWOPI + b + } else { + x = g * m * w - sin (t) + if (abs (x) > 1.) + goto err_ + b = (t + asin (x)) / 2 + } + case T: + x = g * m * w / (2 * sin(b)) + if (abs (x) > 1.) + goto err_ + if (e) + t = b + acos (x) + else + t = b - acos (x) + case M: + m = max (1, nint ((sin(t) + sin(2*b-t)) / (g * w))) + } + if (!IS_INDEF(g)) { + w = (sin (t) + sin (2 * b - t)) / (g * m) + d = cos (2 * b - t) / (f * g * m) + } + case FG: + x = (sin (t) + sin (2 * b - t)) / (m * w) + if (x == 0.) + goto err_ + g = x + f = cos (2 * b - t) / (g * m * d) + case FB: + if (t > PI) { + x = g * m * w / (2 * cos (t)) + if (abs (x) > 1.) + goto err_ + b = asin (x) + t = t - TWOPI + b + } else { + x = g * m * w - sin (t) + if (abs (x) > 1.) + goto err_ + b = (t + asin (x)) / 2 + } + f = cos (2 * b - t) / (g * m * d) + case FT: + x = g * m * w / (2 * sin (b)) + if (abs (x) > 1.) + goto err_ + if (e) + t = b + acos (x) + else + t = b - acos (x) + f = cos (2 * b - t) / (g * m * d) + case FM: + m = nint ((sin (t) + sin (2 * b - t)) / (g * w)) + f = cos (2 * b - t) / (g * m * d) + w = (sin (t) + sin (2 * b - t)) / (g * m) + d = cos (2 * b - t) / (f * g * m) + case FW: + w = (sin (t) + sin (2 * b - t)) / (g * m) + f = cos (2 * b - t) / (g * m * d) + case GB: + x = f * d / w + if (t > PI) { + b = atan (1 / (2 * x - tan (t))) + t = t - TWOPI + b + } else { + x = (tan (t) - x) / (1 + 2 * x * tan (t)) + b = atan (x + sqrt (1 + x * x)) + } + g = (sin (t) + sin (2 * b - t)) / (m * w) + case GT: + t = b + atan (2 * f * d / w - 1 / tan (b)) + g = (sin (t) + sin (2 * b - t)) / (m * w) + case GW: + g = cos (2 * b - t) / (f * m * d) + if (g == 0.) + g = INDEF + else + w = (sin (t) + sin (2 * b - t)) / (g * m) + case GD: + x = (sin (t) + sin (2 * b - t)) / (m * w) + if (x == 0.) + goto err_ + g = x + d = cos (2 * b - t) / (f * g * m) + case BT: + x = f * g * m * d + if (abs (x) > 1.) + goto err_ + x = acos (x) + x = g * m * w - sin (x) + if (abs (x) > 1.) + goto err_ + t = asin (x) + b = (acos (f * g * m * d) + t) / 2 + case BM: + x = f * d / w + if (t > PI) { + b = atan (1 / (2 * x - tan (t))) + t = t - TWOPI + b + } else { + x = (tan (t) - x) / (1 + 2 * x * tan (t)) + b = atan (x + sqrt (1 + x * x)) + } + m = max (1, nint ((sin(t) + sin(2*b-t)) / (g * w))) + b = (t + asin (g * m * w - sin (t))) / 2 + w = (sin (t) + sin (2 * b - t)) / (g * m) + d = cos (2 * b - t) / (f * g * m) + case BW: + b = (t + acos (f * g * m * d)) / 2 + w = (sin (t) + sin (2 * b - t)) / (g * m) + case BD: + if (t > PI) { + x = g * m * w / (2 * cos (t)) + if (abs (x) > 1.) + goto err_ + b = asin (x) + t = t - TWOPI + b + } else { + x = g * m * w - sin (t) + if (abs (x) > 1.) + goto err_ + b = (t + asin (x)) / 2 + } + d = cos (2 * b - t) / (f * g * m) + case TM: + x = f * d / w + x = b + 2 * atan (x - 1 / (2 * tan (b))) + i = max (1, nint ((sin(x) + sin(2*b-x)) / (g * w))) + x = g * i * w / (2 * sin (b)) + if (abs (x) > 1.) + goto err_ + if (e) + t = b + acos (x) + else + t = b - acos (x) + m = i + w = (sin (t) + sin (2 * b - t)) / (g * m) + d = cos (2 * b - t) / (f * g * m) + case TW: + x = f * g * m * d + if (abs (x) > 1.) + goto err_ + t = 2 * b - acos (x) + w = (sin (t) + sin (2 * b - t)) / (g * m) + case TD: + x = g * m * w / (2 * sin (b)) + if (abs (x) > 1.) + goto err_ + if (e) + t = b + acos (x) + else + t = b - acos (x) + d = cos (2 * b - t) / (f * g * m) + case MW: + m = max (1, nint (cos (2 * b - t) / (f * g * d))) + w = (sin (t) + sin (2 * b - t)) / (g * m) + d = cos (2 * b - t) / (f * g * m) + case MD: + m = max (1, nint ((sin(t) + sin(2*b-t)) / (g * w))) + w = (sin (t) + sin (2 * b - t)) / (g * m) + d = cos (2 * b - t) / (f * g * m) + case WD: + w = (sin (t) + sin (2 * b - t)) / (g * m) + d = cos (2 * b - t) / (f * g * m) + } + + if (!IS_INDEF(g)) + g = g * 1e7 + if (!IS_INDEF(b)) + b = RADTODEG (b) + if (!IS_INDEF(t)) + t = RADTODEG (t) + + if (IS_INDEF(f) || IS_INDEF(g) || IS_INDEF(b) || IS_INDEF(t) || + IS_INDEF(m) || IS_INDEF(w) || IS_INDEF(d)) + call error (1, + "Insufficient information to to determine grating parameters") + + return + +err_ if (!IS_INDEF(g)) + g = g * 1e7 + if (!IS_INDEF(b)) + b = RADTODEG (b) + if (!IS_INDEF(t)) + t = RADTODEG (t) + call error (2, "Impossible combination of grating parameters") +end diff --git a/noao/astutil/t_obs.x b/noao/astutil/t_obs.x new file mode 100644 index 00000000..39c274db --- /dev/null +++ b/noao/astutil/t_obs.x @@ -0,0 +1,102 @@ +include <error.h> + +define COMMANDS "|set|list|images|" +define SET 1 # Set observatory task parameters +define LIST 2 # List default observatory data +define IMAGES 3 # List observatory data for images + +# T_OBSERVATORY -- Set/list parameters from the observatory database. + +procedure t_observatory () + +pointer list # Image list +pointer observatory # Default observatory +int verbose # Verbose? + +int cmd, clgwrd(), btoi(), imtgetim() +pointer sp, image, obs, im, imtopenp(), obsvopen(), immap() +bool new, header, clgetb() +double dval, obsgetd() +errchk obsvopen, obsimopen + +begin + call smark (sp) + call salloc (observatory, SZ_FNAME, TY_CHAR) + + cmd = clgwrd ("command", Memc[observatory], SZ_FNAME, COMMANDS) + call clgstr ("obsid", Memc[observatory], SZ_FNAME) + verbose = btoi (clgetb ("verbose")) + switch (cmd) { + case SET: # Set default observatory and observatory parameters + obs = obsvopen (Memc[observatory], verbose) + if (obs != NULL) { + # List + call obslog (obs, "", "", STDOUT) + call obsinfo (obs, STDOUT) + + # Fill in parameter file. + call obsgstr (obs, "observatory", Memc[observatory], SZ_FNAME) + call clpstr ("observatory", Memc[observatory]) + call obsgstr (obs, "name", Memc[observatory], SZ_FNAME) + call clpstr ("name", Memc[observatory]) + iferr (dval = obsgetd (obs, "longitude")) + dval = INDEFD + call clputd ("longitude", dval) + iferr (dval = obsgetd (obs, "latitude")) + dval = INDEFD + call clputd ("latitude", dval) + iferr (dval = obsgetd (obs, "altitude")) + dval = INDEFD + call clputd ("altitude", dval) + iferr (dval = obsgetd (obs, "timezone")) + dval = INDEFD + call clputd ("timezone", dval) + call obsclose (obs) + } + + case LIST: # List observatory parameters for specified observatory + obs = obsvopen (Memc[observatory], verbose) + if (obs != NULL) { + # List + call obslog (obs, "", "", STDOUT) + call obsinfo (obs, STDOUT) + call obsclose (obs) + } + + case IMAGES: # List observatory parameters for a list of images + call salloc (image, SZ_FNAME, TY_CHAR) + + list = imtopenp ("images") + obs = NULL + while (imtgetim (list, Memc[image], SZ_FNAME) != EOF) { + # Get image observatory + iferr (im = immap (Memc[image], READ_ONLY, 0)) { + call erract (EA_WARN) + next + } + call obsimopen (obs, im, Memc[observatory], verbose, new,header) + call imunmap (im) + if (obs == NULL) + next + + # Print observatory info + if (new) { + call obslog (obs, "", "", STDOUT) + call obsinfo (obs, STDOUT) + call printf ("\tImages:\t%s") + call pargstr (Memc[image]) + } else { + call printf ("\t\t%s") + call pargstr (Memc[image]) + } + if (header) + call printf (" (OBSERVAT keyword)\n") + else + call printf (" (default observatory)\n") + } + call imtclose (list) + call obsclose (obs) + } + + call sfree (sp) +end diff --git a/noao/astutil/t_rvcorrect.x b/noao/astutil/t_rvcorrect.x new file mode 100644 index 00000000..a15cfe56 --- /dev/null +++ b/noao/astutil/t_rvcorrect.x @@ -0,0 +1,411 @@ +include <error.h> +include <time.h> + +# T_RVCORRECT -- Compute the radial velocity components of an observer. +# +# Input may be from text files, images, or CL parameters. Output is +# to STDOUT and to CL parameters. + +procedure t_rvcorrect () + +int list # List of files or images +int header # Print header? +int input # Print input data? +int imupdate # Update image headers? + +int btoi(), clpopnu(), clplen(), imtopenp(), imtlen() +bool clgetb() +double clgetd() + +include "rvcorrect.com" + +begin + # Solar motion relative to desired standard of rest. + vs = clgetd ("vsun") + ras = clgetd ("ra_vsun") + decs = clgetd ("dec_vsun") + eps = clgetd ("epoch_vsun") + + # Print header and input data? + header = btoi (clgetb ("header")) + input = btoi (clgetb ("input")) + imupdate = btoi (clgetb ("imupdate")) + + # Read observations from a list of files. + list = clpopnu ("files") + if (clplen (list) > 0) { + call rvc_files (list, header, input) + call clpcls (list) + return + } + + # Read observations from a list of images. + list = imtopenp ("images") + if (imtlen (list) > 0) { + call rvc_images (list, header, input, imupdate) + call imtclose (list) + return + } + + # Get observation from CL. + call rvc_cl (header, input) +end + + +# RVC_FILES -- Compute radial velocities from a list of files. + +procedure rvc_files (list, header, input) + +int list # List of files. +int header # Print header? +int input # Print input data? + +double ra, dec, ep # Coordinates of observation +int year, month, day # Date of observation +double ut # Time of observation +double vobs # Observed velocity + +int fd +char file[SZ_FNAME] +double hjd, vrot, vorb, vbary, vsol +pointer obs, ptr + +int clgfil(), open(), fscan(), nscan() +double obsgetd() +pointer obsopen(), immap() +errchk obsopen + +include "rvcorrect.com" + +begin + # Location of observation. + call clgstr ("observatory", file, SZ_FNAME) + obs = obsopen (file) + call obslog (obs, "RVCORRECT", "latitude longitude altitude", STDOUT) + latitude = obsgetd (obs, "latitude") + longitude = obsgetd (obs, "longitude") + altitude = obsgetd (obs, "altitude") + call obsclose (obs) + + # Loop through files. + while (clgfil (list, file, SZ_FNAME) != EOF) { + ifnoerr (ptr = immap (file, READ_ONLY, 0)) { + call imunmap (ptr) + call eprintf ("WARNING: Use 'images' parameter for (%s)\n") + call pargstr (file) + next + } + iferr (fd = open (file, READ_ONLY, TEXT_FILE)) { + call erract (EA_WARN) + next + } + while (fscan (fd) != EOF) { + call gargi (year) + call gargi (month) + call gargi (day) + call gargd (ut) + call gargd (ra) + call gargd (dec) + if (nscan() != 6) + next + call gargd (ep) + if (nscan() != 7) + ep = INDEFD + call gargd (vobs) + if (nscan() != 8) + vobs = 0. + + # Compute the radial velocities and output the results. + call rvcorrect (ra, dec, ep, year, month, day, ut, hjd, vrot, + vbary, vorb, vsol) + call rvc_output (year, month, day, ut, ra, dec, hjd, vobs, vrot, + vbary, vorb, vsol, header, input) + } + call close (fd) + } +end + + +# RVC_IMAGES -- Compute radial velocities from a list of images. + +procedure rvc_images (list, header, input, imupdate) + +int list # List of files. +int header # Print header? +int input # Print input data? +int imupdate # Update image header? + +double ra, dec, ep # Coordinates of observation +int year, month, day # Date of observation +double ut # Time of observation +double vobs # Observed velocity + +int flags +bool newobs, obshead +double hjd, vrot, vorb, vbary, vsol +pointer sp, observatory, image, date, im, obs +pointer kp, datop, utp, rap, decp, epochp, vobp + +int imtgetim(), dtm_decode() +double imgetd(), obsgetd() +pointer immap(), clopset() + +errchk imgetd, imgstr, obsopen + +include "rvcorrect.com" + +begin + call smark (sp) + call salloc (datop, SZ_FNAME, TY_CHAR) # stack storage + call salloc (utp, SZ_FNAME, TY_CHAR) + call salloc (rap, SZ_FNAME, TY_CHAR) + call salloc (decp, SZ_FNAME, TY_CHAR) + call salloc (epochp, SZ_FNAME, TY_CHAR) + call salloc (vobp, SZ_FNAME, TY_CHAR) + call salloc (observatory, SZ_FNAME, TY_CHAR) + call salloc (image, SZ_FNAME, TY_CHAR) + call salloc (date, SZ_LINE, TY_CHAR) + + call clgstr ("observatory", Memc[observatory], SZ_FNAME) + obs = NULL + + # Get the KEYWPARS image header keywords values. + kp = clopset ("keywpars") + call clgpset (kp, "date_obs", Memc[datop], SZ_FNAME) + call clgpset (kp, "ut", Memc[utp], SZ_FNAME) + call clgpset (kp, "ra", Memc[rap], SZ_FNAME) + call clgpset (kp, "dec", Memc[decp], SZ_FNAME) + call clgpset (kp, "epoch", Memc[epochp], SZ_FNAME) + call clgpset (kp, "vobs", Memc[vobp], SZ_FNAME) + call clcpset (kp) + + # Loop through images. + while (imtgetim (list, Memc[image], SZ_FNAME) != EOF) { + if (imupdate == YES) { + iferr (im = immap (Memc[image], READ_WRITE, 0)) { + call erract (EA_WARN) + next + } + } else { + iferr (im = immap (Memc[image], READ_ONLY, 0)) { + call erract (EA_WARN) + next + } + } + + iferr { + call obsimopen (obs, im, Memc[observatory], NO, newobs, obshead) + if (newobs) { + call obslog (obs, "RVCORRECT", + "latitude longitude altitude", STDOUT) + latitude = obsgetd (obs, "latitude") + longitude = obsgetd (obs, "longitude") + altitude = obsgetd (obs, "altitude") + } + + # Parse UT in either date or hour formats. + call imgstr (im, Memc[utp], Memc[date], SZ_LINE) + if (dtm_decode (Memc[date], year, month, day, ut, flags)==ERR) { + iferr (ut = imgetd (im, Memc[utp])) + call error (1, "Error parsing UT keyword") + } + + # Parse date. + call imgstr (im, Memc[datop], Memc[date], SZ_LINE) + if (dtm_decode (Memc[date], year, month, day, hjd, flags)==ERR) + call error (1, "Error parsing DATE-OBS keyword") + if (!IS_INDEFD(hjd)) + ut = hjd + + ra = imgetd (im, Memc[rap]) + dec = imgetd (im, Memc[decp]) + ep = imgetd (im, Memc[epochp]) + iferr (vobs = imgetd (im, Memc[vobp])) + vobs = 0. + + # Compute the radial velocities and output the results. + call rvcorrect (ra, dec, ep, year, month, day, ut, hjd, vrot, + vbary, vorb, vsol) + call rvc_output (year, month, day, ut, ra, dec, hjd, vobs, vrot, + vbary, vorb, vsol, header, input) + + # Write the corrected velocity to the image. + if (imupdate == YES) { + call imaddd (im, "hjd", hjd) + call imaddd (im, "vhelio", vobs+vrot+vbary+vorb) + call imaddd (im, "vlsr", vobs+vrot+vbary+vorb+vsol) + call sprintf (Memc[date], SZ_LINE, "%6g %6g %6g %6g") + call pargd (vs) + call pargd (ras) + call pargd (decs) + call pargd (eps) + call imastr (im, "vsun", Memc[date]) + } + + } then + call erract (EA_WARN) + + call imunmap (im) + } + + call obsclose (obs) + call sfree (sp) +end + + +# RVC_CL -- Compute radial velocities from the CL parameters. + +procedure rvc_cl (header, input) + +int header # Print header? +int input # Print input data? + +double ra, dec, ep # Coordinates of observation +int year, month, day # Date of observation +double ut # Time of observation +double vobs # Observed velocity + +double hjd, vrot, vorb, vbary, vsol +pointer obs, file + +int clgeti() +double obsgetd(), clgetd() +pointer obsopen() +errchk obsopen + +include "rvcorrect.com" + +begin + # Location of observation. + call malloc (file, SZ_FNAME, TY_CHAR) + call clgstr ("observatory", Memc[file], SZ_FNAME) + obs = obsopen (Memc[file]) + call mfree (file, TY_CHAR) + call obslog (obs, "RVCORRECT", "latitude longitude altitude", STDOUT) + latitude = obsgetd (obs, "latitude") + longitude = obsgetd (obs, "longitude") + altitude = obsgetd (obs, "altitude") + call obsclose (obs) + + # Date of observation. + year = clgeti ("year") + month = clgeti ("month") + day = clgeti ("day") + ut = clgetd ("ut") + + # Direction of observation. + ra = clgetd ("ra") + dec = clgetd ("dec") + ep = clgetd ("epoch") + + # Observed velocity. + + vobs = clgetd ("vobs") + + # Compute radial velocities and output resutls. + call rvcorrect (ra, dec, ep, year, month, day, ut, hjd, vrot, vbary, + vorb, vsol) + call rvc_output (year, month, day, ut, ra, dec, hjd, vobs, vrot, vbary, + vorb, vsol, header, input) + + # Record velocities in the parameter file. + call clputd ("hjd", hjd) + call clputd ("vhelio", vobs+vrot+vbary+vorb) + call clputd ("vlsr", vobs+vrot+vbary+vorb+vsol) +end + + +# RVCORRECT -- Compute the radial velocities. + +procedure rvcorrect (ra, dec, ep, year, month, day, ut, hjd, vrot, vbary, + vorb, vsol) + +double ra, dec, ep # Coordinates of observation +int year, month, day # Date of observation +double ut # Time of observation +double hjd # Helocentric Julian Day +double vrot, vbary, vorb, vsol # Returned velocity components + +double epoch, ra_obs, dec_obs, ra_vsun, dec_vsun, t + +include "rvcorrect.com" + +begin + # Determine epoch of observation and precess coordinates. + call ast_date_to_epoch (year, month, day, ut, epoch) + call ast_precess (ra, dec, ep, ra_obs, dec_obs, epoch) + call ast_precess (ras, decs, eps, ra_vsun, dec_vsun, epoch) + call ast_hjd (ra_obs, dec_obs, epoch, t, hjd) + + # Determine velocity components. + call ast_vr (ra_vsun, dec_vsun, vs, ra_obs, dec_obs, vsol) + call ast_vorbit (ra_obs, dec_obs, epoch, vorb) + call ast_vbary (ra_obs, dec_obs, epoch, vbary) + call ast_vrotate (ra_obs, dec_obs, epoch, latitude, longitude, + altitude, vrot) +end + + +# RVC_OUTPUT -- Output radial velocities. + +procedure rvc_output (year, month, day, ut, ra, dec, hjd, vobs, vrot, vbary, + vorb, vsol, header, input) + +int year, month, day # Date of observation +double ut # Time of observation +double ra, dec # Coordinates of observation +double hjd # Helocentric Julian Day +double vobs # Observed radial velocity +double vrot, vbary, vorb, vsol # Velocity components +int input # Print input data? +int header # Print header? + +begin + # Print header. + if (header == YES) { + if (input == YES) { + call printf ("%4s %2s %2s %8s %8s %9s %8s\n") + call pargstr ("##YR") + call pargstr ("MO") + call pargstr ("DY") + call pargstr (" UT ") + call pargstr (" RA ") + call pargstr (" DEC ") + call pargstr (" VOBS ") + } + call printf ("%13s %8s %8s %8s %8s %8s %8s %8s\n") + call pargstr ("## HJD ") + call pargstr ("VOBS") + call pargstr ("VHELIO") + call pargstr ("VLSR") + call pargstr ("VDIURNAL") + call pargstr ("VLUNAR") + call pargstr ("VANNUAL") + call pargstr ("VSOLAR") + header = NO + } + + # Print input if desired. + if (input == YES) { + call printf ("%4d %2d %2d %8.0h %8.0h %9.0h %8.1f\n") + call pargi (year) + call pargi (month) + call pargi (day) + call pargd (ut) + call pargd (ra) + call pargd (dec) + call pargd (vobs) + } + + # Print helocentric Julian day and velocities. + call printf ( + "%13.5f %8.2f %8.2f %8.2f %8.3f %8.3f %8.3f %8.3f\n") + call pargd (hjd) + call pargd (vobs) + call pargd (vobs+vrot+vbary+vorb) + call pargd (vobs+vrot+vbary+vorb+vsol) + call pargd (vrot) + call pargd (vbary) + call pargd (vorb) + call pargd (vsol) +end diff --git a/noao/astutil/t_setairmass.x b/noao/astutil/t_setairmass.x new file mode 100644 index 00000000..49b3431d --- /dev/null +++ b/noao/astutil/t_setairmass.x @@ -0,0 +1,329 @@ +include <imhdr.h> +include <ctype.h> +include <error.h> + +# SETAIRMASS -- Compute the airmass for a series of images and optionally +# store these in the image header. + +# The exposure time is assumed to be in seconds. There is no provision +# for observatories that save the begin and end integration times in +# the header but not the exposure duration. Note that shutter closings +# (due to clouds) void the assumptions about effective airmass. + +# Possible keyword input and output time stamps + +define AIR_TYPES "|beginning|middle|end|effective|" + +define BEGINNING 1 +define MIDDLE 2 +define END 3 +define EFFECTIVE 4 + +define UT_DEF 0D0 # for precession if the keyword is missing + +define SOLTOSID (($1)*1.00273790935d0) + + +# T_SETAIRMASS -- Read the parameters, loop over the images using Stetson's +# rule, print out answers and update the header + +procedure t_setairmass() + +pointer imlist, im, obs +pointer sp, input, observatory, date_key, exp_key, air_key, utm_key, ut_hms +pointer ra_key, dec_key, eqn_key, st_key, ut_key, datestr +int intype, outtype, year, month, day, day1, fmt +bool show, update, override, newobs, obshead + +double dec, latitude, exptime, scale, jd +double ha, ha_beg, ha_mid, ha_end, ut, ut_mid +double airm_beg, airm_end, airm_mid, airm_eff + +bool clgetb() +int imtgetim(), clgwrd(), imaccf(), dtm_encode() +pointer imtopenp(), immap() +double clgetd(), airmassx(), obsgetd(), ast_date_to_julday() +errchk obsobpen, obsgetd, sa_rheader, airmassx, obsimopen + +begin + call smark (sp) + call salloc (input, SZ_FNAME, TY_CHAR) + call salloc (observatory, SZ_FNAME, TY_CHAR) + call salloc (ra_key, SZ_FNAME, TY_CHAR) + call salloc (dec_key, SZ_FNAME, TY_CHAR) + call salloc (eqn_key, SZ_FNAME, TY_CHAR) + call salloc (st_key, SZ_FNAME, TY_CHAR) + call salloc (ut_key, SZ_FNAME, TY_CHAR) + call salloc (date_key, SZ_FNAME, TY_CHAR) + call salloc (exp_key, SZ_FNAME, TY_CHAR) + call salloc (air_key, SZ_FNAME, TY_CHAR) + call salloc (utm_key, SZ_FNAME, TY_CHAR) + call salloc (ut_hms, SZ_FNAME, TY_CHAR) + call salloc (datestr, SZ_FNAME, TY_CHAR) + + # Get the parameters + imlist = imtopenp ("images") + intype = clgwrd ("intype", Memc[input], SZ_FNAME, AIR_TYPES) + call clgstr ("observatory", Memc[observatory], SZ_FNAME) + call clgstr ("ra", Memc[ra_key], SZ_FNAME) + call clgstr ("dec", Memc[dec_key], SZ_FNAME) + call clgstr ("equinox", Memc[eqn_key], SZ_FNAME) + call clgstr ("st", Memc[st_key], SZ_FNAME) + call clgstr ("ut", Memc[ut_key], SZ_FNAME) + call clgstr ("date", Memc[date_key], SZ_FNAME) + call clgstr ("exposure", Memc[exp_key], SZ_FNAME) + call clgstr ("airmass", Memc[air_key], SZ_FNAME) + call clgstr ("utmiddle", Memc[utm_key], SZ_FNAME) + scale = clgetd ("scale") + + # just to be neat + call strupr (Memc[date_key]) + call strupr (Memc[exp_key]) + call strupr (Memc[air_key]) + call strupr (Memc[utm_key]) + + show = clgetb ("show") + update = clgetb ("update") + + # Open observatory later. + obs = NULL + + if (update) { + outtype = clgwrd ("outtype", Memc[input], SZ_FNAME, AIR_TYPES) + override = clgetb ("override") + } + + # Print a header line (the # should imply a comment to another task) + if (show) { + call printf ("# Image UT middle ") + call printf ("effective begin middle end updated\n") + } else if (!update) + call eprintf ("WARNING: Image headers are not updated\n") + + # Loop over all images + while (imtgetim (imlist, Memc[input], SZ_FNAME) != EOF) { + iferr { + if (update) + im = immap (Memc[input], READ_WRITE, 0) + else + im = immap (Memc[input], READ_ONLY, 0) + } then { + call erract (EA_WARN) + next + } + + iferr { + call sa_rheader (im, Memc[ra_key], Memc[dec_key], + Memc[eqn_key], Memc[st_key], Memc[ut_key], Memc[date_key], + Memc[exp_key], ha, dec, year, month, day, ut, exptime, + fmt) + + # Calculate the mid-UT and HA's for the various input types + switch (intype) { + case BEGINNING: + ha_beg = ha + ha_mid = ha + SOLTOSID(exptime) / 2. + ha_end = ha + SOLTOSID(exptime) + + if (IS_INDEFD(ut)) + ut_mid = INDEFD + else + ut_mid = ut + exptime / 2. + + case MIDDLE: + ha_beg = ha - SOLTOSID(exptime) / 2. + ha_mid = ha + ha_end = ha + SOLTOSID(exptime) / 2. + + if (IS_INDEFD(ut)) + ut_mid = INDEFD + else + ut_mid = ut + + case END: + ha_beg = ha - SOLTOSID(exptime) + ha_mid = ha - SOLTOSID(exptime) / 2. + ha_end = ha + + if (IS_INDEFD(ut)) + ut_mid = INDEFD + else + ut_mid = ut - exptime / 2. + + default: + call error (1, "Bad switch in t_setairmass") + } + + # Adjust for possible change of date in ut_mid. + day1 = day + jd = ast_date_to_julday (year, month, day, ut_mid) + call ast_julday_to_date (jd, year, month, day, ut_mid) + + # Save the mid-UT as a sexigesimal string for output + call sprintf (Memc[ut_hms], SZ_FNAME, "%h") + call pargd (ut_mid) + + # Compute the beginning, middle and ending airmasses + # First get the latitude from the observatory database. + + call obsimopen (obs, im, Memc[observatory], NO, newobs, obshead) + if (newobs) + call obslog (obs, "SETAIRMASS", "latitude", STDOUT) + latitude = obsgetd (obs, "latitude") + airm_beg = airmassx (ha_beg, dec, latitude, scale) + airm_mid = airmassx (ha_mid, dec, latitude, scale) + airm_end = airmassx (ha_end, dec, latitude, scale) + + # Combine as suggested by P. Stetson (Simpson's rule) + airm_eff = (airm_beg + 4.*airm_mid + airm_end) / 6. + + } then { + call erract (EA_WARN) + call imunmap (im) + next + } + + if (show) { + call printf ("%20s %11s %7.4f %7.4f %7.4f %7.4f %b\n") + call pargstr (Memc[input]) + call pargstr (Memc[ut_hms]) + call pargd (airm_eff) + call pargd (airm_beg) + call pargd (airm_mid) + call pargd (airm_end) + call pargb (update) + call flush (STDOUT) + } + + if (update) { + if (imaccf (im, Memc[air_key]) == NO || override) + switch (outtype) { + case BEGINNING: + call imaddr (im, Memc[air_key], real(airm_beg)) + case MIDDLE: + call imaddr (im, Memc[air_key], real(airm_mid)) + case END: + call imaddr (im, Memc[air_key], real(airm_end)) + case EFFECTIVE: + call imaddr (im, Memc[air_key], real(airm_eff)) + default: + call error (1, "Bad switch in t_setairmass") + } + + # Should probably update a date keyword as well + if ((imaccf (im, Memc[utm_key]) == NO || override) && + (! IS_INDEFD(ut_mid))) { +# if (fmt == NO && day == day1) +# call imastr (im, Memc[utm_key], Memc[ut_hms]) +# else if (dtm_encode (Memc[datestr], SZ_FNAME, +# year, month, day, utmid, 2, 0) > 0) +# call imastr (im, Memc[utm_key], Memc[datestr]) + if (dtm_encode (Memc[datestr], SZ_FNAME, + year, month, day, utmid, 2, 0) > 0) + call imastr (im, Memc[utm_key], Memc[datestr]) + } + } + + call imunmap (im) + } + + call obsclose (obs) + call sfree (sp) +end + + +# SA_RHEADER -- derive the ha, dec, ut, and exptime from the header. + +define SZ_TOKEN 2 + +procedure sa_rheader (im, ra_key, dec_key, eqn_key, st_key, ut_key, dkey, ekey, + ha, dec, year, month, day, ut, exptime, fmt) + +pointer im #I imio pointer +char ra_key[ARB] #I date keyword (hh.hhh or hh:mm:ss.s) +char dec_key[ARB] #I date keyword (dd.ddd or dd:mm:ss.s) +char eqn_key[ARB] #I date keyword (yyyy.yyy) +char st_key[ARB] #I date keyword (hh.hhh or hh:mm:ss.s) +char ut_key[ARB] #I date keyword (hh.hhh or hh:mm:ss.s) +char dkey[ARB] #I date keyword (YYYY-MM-DDTHH:MM:SS.S or DD/MM/YY) +char ekey[ARB] #I exposure keyword (seconds) + +double ha #O hour angle +double dec #O current epoch declination +int year #O year +int month #O month +int day #O day +double ut #O universal time +double exptime #O exposure time (hours) +int fmt #O Date format? + +pointer date, sp +double ra1, dec1, epoch1, ra2, dec2, epoch2, st2, ut2 +int ip, flags + +double imgetd() +int dtm_decode(), strmatch() +bool fp_equald() + +errchk imgetd, imgstr + +begin + call smark (sp) + call salloc (date, SZ_LINE, TY_CHAR) + + iferr { + # `1' is the coordinate epoch, `2' is the observation epoch + ra1 = imgetd (im, ra_key) + ip = strmatch (ra_key, "^{CRVAL}") + if (ip > 0) { + if (IS_DIGIT(ra_key[ip]) && TO_INTEG(ra_key[ip] > 0)) + ra1 = ra1 / 15.0d0 + } + dec1 = imgetd (im, dec_key) + st2 = imgetd (im, st_key) + + # Parse UT keyword in either hours or date. + fmt = YES + call imgstr (im, ut_key, Memc[date], SZ_LINE) + if (dtm_decode (Memc[date],year,month,day,ut,flags) == ERR) { + iferr (ut = imgetd (im, ut_key)) + call error (1, "Error in ut keyword") + fmt = NO + } + + # Parse the date. + call imgstr (im, dkey, Memc[date], SZ_LINE) + if (dtm_decode (Memc[date],year,month,day,ut2,flags) == ERR) + call error (1, "Error in date keyword") + + iferr (epoch1 = imgetd (im, eqn_key)) + epoch1 = INDEFD + if (!(fp_equald (epoch1, double(0.)) || IS_INDEFD(epoch1))) { + if (IS_INDEFD(ut)) + call ast_date_to_epoch (year, month, day, UT_DEF, epoch2) + else + call ast_date_to_epoch (year, month, day, ut, epoch2) + call astprecess (ra1, dec1, epoch1, ra2, dec2, epoch2) + } else { + ra2 = ra1 + dec2 = dec1 + call eprintf ("\tCoords not precessed for %s: check %s\n") + call pargstr (IM_HDRFILE(im)) + call pargstr (eqn_key) + call flush (STDERR) + } + + # don't use the output arguments internally + ha = st2 - ra2 + dec = dec2 + exptime = imgetd (im, ekey) / 3600.d0 + } then { + call sfree (sp) + call eprintf ("Problem reading header for %s:\n") + call pargstr (IM_HDRFILE(im)) + call flush (STDERR) + call erract (EA_ERROR) + } + + call sfree (sp) +end diff --git a/noao/astutil/t_setjd.x b/noao/astutil/t_setjd.x new file mode 100644 index 00000000..29cad054 --- /dev/null +++ b/noao/astutil/t_setjd.x @@ -0,0 +1,217 @@ +include <error.h> +include <imhdr.h> +include <ctype.h> + + +# T_SETJD -- Set Julian dates +# This task computes the Geocentric Julian date, the Helocentric Julian Date, +# and the local Julian day for a list of images. Any set of these may +# be output. The input keywords include the date of observation, the +# time of observation, the exposure time, and the RA/DEC/EPOCH of observation. +# If an exposure time specified the times are corrected to midexposure. + +procedure t_setjd() + +pointer imlist # List of images +pointer date_key # Date keyword +pointer time_key # Time keyword +pointer exp_key # Exposure keyword +pointer ra_key # RA keyword (hours) +pointer dec_key # DEC keyword (hours) +pointer ep_key # RA/DEC epoch keyword + +pointer ujd_key # JD keyword +pointer hjd_key # HJD keyword +pointer ljd_key # Local JD keyword + +bool utdate # UT date? +bool uttime # UT time? +bool listonly # List only? +pointer observatory # Observatory + +bool newobs, obshead +int i, year, month, day, flags +double zone, exp, time, ra, dec, ep, epoch, ujd, hjd, ljd, lt +pointer im, obs, sp, input, date, ep_str + +bool clgetb() +int nowhite(), imtgetim(), ctod(), dtm_decode() +pointer imtopenp(), immap() +double imgetd(), obsgetd(), ast_julday() +errchk immap, obsobpen, obsgetd, obsimopen, imgstr, imgetd + +begin + call smark (sp) + call salloc (input, SZ_FNAME, TY_CHAR) + call salloc (observatory, SZ_FNAME, TY_CHAR) + call salloc (date_key, SZ_FNAME, TY_CHAR) + call salloc (time_key, SZ_FNAME, TY_CHAR) + call salloc (exp_key, SZ_FNAME, TY_CHAR) + call salloc (ra_key, SZ_FNAME, TY_CHAR) + call salloc (dec_key, SZ_FNAME, TY_CHAR) + call salloc (ep_key, SZ_FNAME, TY_CHAR) + call salloc (ep_str, SZ_FNAME, TY_CHAR) + call salloc (ujd_key, SZ_FNAME, TY_CHAR) + call salloc (hjd_key, SZ_FNAME, TY_CHAR) + call salloc (ljd_key, SZ_FNAME, TY_CHAR) + call salloc (date, SZ_FNAME, TY_CHAR) + + # Get the parameters + imlist = imtopenp ("images") + call clgstr ("observatory", Memc[observatory], SZ_FNAME) + obs = NULL + + call clgstr ("date", Memc[date_key], SZ_FNAME) + call clgstr ("time", Memc[time_key], SZ_FNAME) + call clgstr ("exposure", Memc[exp_key], SZ_FNAME) + call clgstr ("ra", Memc[ra_key], SZ_FNAME) + call clgstr ("dec", Memc[dec_key], SZ_FNAME) + call clgstr ("epoch", Memc[ep_key], SZ_FNAME) + + call clgstr ("jd", Memc[ujd_key], SZ_FNAME) + call clgstr ("hjd", Memc[hjd_key], SZ_FNAME) + call clgstr ("ljd", Memc[ljd_key], SZ_FNAME) + + i = nowhite (Memc[date_key], Memc[date_key], SZ_FNAME) + i = nowhite (Memc[time_key], Memc[time_key], SZ_FNAME) + i = nowhite (Memc[exp_key], Memc[exp_key], SZ_FNAME) + i = nowhite (Memc[ra_key], Memc[ra_key], SZ_FNAME) + i = nowhite (Memc[dec_key], Memc[dec_key], SZ_FNAME) + i = nowhite (Memc[ep_key], Memc[ep_key], SZ_FNAME) + i = nowhite (Memc[ujd_key], Memc[ujd_key], SZ_FNAME) + i = nowhite (Memc[hjd_key], Memc[hjd_key], SZ_FNAME) + i = nowhite (Memc[ljd_key], Memc[ljd_key], SZ_FNAME) + + utdate = clgetb ("utdate") + uttime = clgetb ("uttime") + listonly = clgetb ("listonly") + + # Set log header + call printf ("#%19s") + call pargstr ("Image") + if (nowhite (Memc[ujd_key], Memc[ujd_key], SZ_LINE) != 0) { + call printf (" %13s") + call pargstr (Memc[ujd_key]) + } + if (nowhite (Memc[hjd_key], Memc[hjd_key], SZ_LINE) != 0) { + call printf (" %13s") + call pargstr (Memc[hjd_key]) + } + if (nowhite (Memc[ljd_key], Memc[ljd_key], SZ_LINE) != 0) { + call printf (" %8s") + call pargstr (Memc[ljd_key]) + } + call printf ("\n") + + # Loop over all images + while (imtgetim (imlist, Memc[input], SZ_FNAME) != EOF) { + iferr { + im = NULL + if (listonly) + i = immap (Memc[input], READ_ONLY, 0) + else + i = immap (Memc[input], READ_WRITE, 0) + im = i + + # Get time zone for the observatory. + call obsimopen (obs, im, Memc[observatory], NO, newobs, obshead) + if (newobs) + call obslog (obs, "SETJD", "timezone", STDOUT) + zone = obsgetd (obs, "timezone") + + # Determine the date and time of observation. + + call imgstr (im, Memc[date_key], Memc[date], SZ_LINE) + if (dtm_decode (Memc[date],year,month,day,time,flags) == ERR) + call error (1, "Error in date keyword") + if (IS_INDEFD(time)) + time = imgetd (im, Memc[time_key]) + + # Correct to midexposure if desired. + if (Memc[exp_key] != EOS) { + if (Memc[exp_key] == '-') + exp = -imgetd (im, Memc[exp_key+1]) + else + exp = imgetd (im, Memc[exp_key]) + time = time + exp / (2 * 3600.) + } + + # Compute UJD and LJD. + call ast_date_to_epoch (year, month, day, time, epoch) + ujd = ast_julday (epoch) + if (utdate) { + if (uttime) + ljd = ujd - zone / 24. + else { + ljd = ujd + ujd = ljd + zone / 24. + } + } else { + if (uttime) { + if (time - zone < 0.) + ujd = ujd + 1 + if (time + zone >= 24.) + ujd = ujd - 1 + ljd = ujd - zone / 24. + } else { + ljd = ujd + ujd = ljd + zone / 24. + } + } + + # Get RA, DEC, EPOCH if needed. + if (Memc[hjd_key] != EOS) { + ra = imgetd (im, Memc[ra_key]) + dec = imgetd (im, Memc[dec_key]) + ep = INDEFD + if (Memc[ep_key] != EOS) { + call imgstr (im, Memc[ep_key], Memc[ep_str], SZ_FNAME) + if (nowhite (Memc[ep_str],Memc[ep_str],SZ_FNAME) > 0) { + call strupr (Memc[ep_str]) + i = 1 + if (Memc[ep_str] == 'B' || Memc[ep_str] == 'J') + i = 2 + if (ctod (Memc[ep_str], i, ep) == 0) + call error (0, "Epoch not understood") + if (ep < 1800. || ep > 2100.) { + call eprintf ( + "# Warning: Epoch %d is unlikely.\n") + call pargstr (Memc[ep_str]) + } + } + } + } + + + # Print results. + call printf ("%20s") + call pargstr (Memc[input]) + if (Memc[ujd_key] != EOS) { + call imaddd (im, Memc[ujd_key], ujd) + call printf (" %13.5f") + call pargd (ujd) + } + if (Memc[hjd_key] != EOS) { + call ast_precess (ra, dec, ep, ra, dec, epoch) + call ast_jd_to_hjd (ra, dec, ujd, lt, hjd) + call imaddd (im, Memc[hjd_key], hjd) + call printf (" %13.5f") + call pargd (hjd) + } + if (Memc[ljd_key] != EOS) { + ljd = int (ljd) + call imaddd (im, Memc[ljd_key], ljd) + call printf (" %8d") + call pargi (int (ljd)) + } + call printf ("\n") + } then + call erract (EA_WARN) + + if (im != NULL) + call imunmap (im) + } + + call obsclose (obs) + call sfree (sp) +end diff --git a/noao/astutil/x_astutil.x b/noao/astutil/x_astutil.x new file mode 100644 index 00000000..03e8b6b3 --- /dev/null +++ b/noao/astutil/x_astutil.x @@ -0,0 +1,14 @@ +# Process definition of the ASTUTIL package. + +task airmass = t_airmass, + astcalc = t_astcalc, + asthedit = t_asthedit, + asttimes = t_asttimes, + galactic = t_galactic, + gratings = t_gratings, + observatory = t_observatory, + pdm = t_pdm, + precess = t_precess, + rvcorrect = t_rvcorrect, + setairmass = t_setairmass, + setjd = t_setjd |