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/astcat | |
| download | iraf-linux-fa080de7afc95aa1c19a6e6fc0e0708ced2eadc4.tar.gz | |
Initial commit
Diffstat (limited to 'noao/astcat')
113 files changed, 19582 insertions, 0 deletions
diff --git a/noao/astcat/README b/noao/astcat/README new file mode 100644 index 00000000..ebd7d1b0 --- /dev/null +++ b/noao/astcat/README @@ -0,0 +1 @@ +# README file for the ASTCAT package diff --git a/noao/astcat/Revisions b/noao/astcat/Revisions new file mode 100644 index 00000000..00b1d61d --- /dev/null +++ b/noao/astcat/Revisions @@ -0,0 +1,132 @@ +.help revisions Sep01 noao.astcat +.nf + +astcat$src/attools/atsort.x + A strcmp() should have been strncmp() (7/12/09, MJF) + +astcat$src/agetcat/t_agetim.x + Some strcat() calls were missing a maxch arg (7/12/09, MJF) + +======= +V2.14 +======= + +astcat$lib/catdb.dat + Added usnob1@usno, usnoa2@usno, nomad@usno and act@usno (12/3/08, MJF) + +astcat$src/attools/atcathdr.x + Fixed some procedure calls being closed with a ']' instead of a ')' + (2/17/08, MJF) + +======= +V2.13 +======= + +astcat$lib/catdb.dat + Added twomass@noao and usnob1@noao using an scat interface. + (8/17/07, Valdes) + +astcat$lib/catdb.dat + Added twomass@irsa using their Gator interface. (7/17/07, Valdes) + +astcat$lib/catdb.dat + Removed references to 2Mass catalog. (9/27/04, Valdes) + +======= +V2.12.2 +======= + +astcat$lib/catdb.dat + The usno?@cadc entries were extend to allow more than the default + number of records to be returned. (11/6/03, Valdes) + +astcat$lib/astrom.h + The decoding of "hours" in awcs/dbwcs.x was not working because the + string match index values set when reading the units using AT_RAUNITS + from astrom.h are decoded using the index values from pkg/skywcs.h. + Since I could not find where "hms" and "dms" are used I made the + first three index values agree between the two include files. + (12/03/02, Valdes) + +======= +V2.12.1 +======= + +astcat$src/attools/atinpars.x + Added a protection against entering illegal numbers in aregpars. + (04/11/02, Davis) + +astcat$src/agetcat.par +astcat$src/afiltcat.par +astcat$src/agetim.par +astcat$src/ahedit.par +astcat$src/aimfind.par +astcat$doc/agetcat.hlp +astcat$doc/afiltcat.hlp +astcat$doc/agetim.hlp +astcat$doc/ahedit.hlp +astcat$doc/aimfind.hlp + Clarified the verbose and update parameter prompt string. Switched + the default values of the verbose parameter from no to yes. + (04/11/02, Davis) + +astcat$src/aclist.par +astcat$src/aslist.par + Clarifed the verbose parameter prompt. + (04/11/02, Davis) + +astcat$src/agetcat/atfcat.x + Added a missing sfree statement to the at_srtcat routine. + (02/19/02, Davis) + +astcat$src/agetcat/atfcat.x + Fixed a bug in the output ra and dec conversion code that results in the + ra values not being properly converted. (01/29/02, Davis) + +astcat$lib/catdb.dat + Added a new entry gsc2@stsci which accesses the guide star catalog at + ST. Renamed the record gsc@cadc to gsc1@cadc and fixed a type in its + query string. (01/29/02, Davis) + +astcat$astcat.cl +astcat$astcat.men +astcat$astcat.hd +astcat$src/asttest.cl + Added a test script to the astcat package. (08/01/02, Davis) + +astcat$lib/catdb.dat + Added a missing protocol field to the dummy catalog record filename@noao. + (07/01/02, Davis) + +astcat$doc/afiltcat.hlp + Fixed a typo in the afiltcat task help page. (07/01/02, Davis) + +astcat$lib/catdb.dat + Update the astcat package catalog database file. (03/01/02, Davis) + +astcat$doc/aclist.hlp +astcat$src/agetcat/t_aclist.x +astcat$src/agetcat/t_aslist.x + Fixed a typo in the aclist help page. + Fixed minor verbose mode bugs in the aclist and aslist tasks. + (03/01/02, Davis) + +astcat$src/agetget/mkpkg + Fixed various missing .h file dependencies in the mkpkg file. + +astcat$astcat.cl + Changed some incorrect astcatx variables to astcat. (11/14/01, Davis) + +astcat$src/agetcat/athedit.x +astcat$src/agetcat/atfcat.x +astcat$src/agetcat/atwcat.x +astcat$src/attools/atdefpars.x +astcat$doc/catalogs.hlp + Fixed various extra agument and subroutine/function mismatches found + by spplint. Also fixed a couple of formatting problems in the catalogs + help page. (19/09/01, Davis) + +astcat$ + Installed the astcat package in noao. (08/29/01, Davis) + +.endhelp diff --git a/noao/astcat/astcat.cl b/noao/astcat/astcat.cl new file mode 100644 index 00000000..78287b92 --- /dev/null +++ b/noao/astcat/astcat.cl @@ -0,0 +1,38 @@ +#{ ASTCAT.CL -- The Astronomical Catalogs and Surveys Access Package + +package astcat + +# Executable Tasks + +task aclist, + agetcat, + aimfind, + afiltcat, + aslist, + agetim, + ahedit, + adumpcat, + adumpim, + acqctest, + acqftest, + acqitest = "astcat$src/x_astcat.e" + +# Pset Tasks + +task aregpars = "astcat$src/aregpars.par" +task acatpars = "astcat$src/acatpars.par" +task afiltpars = "astcat$src/afiltpars.par" +task awcspars = "astcat$src/awcspars.par" +task aimpars = "astcat$src/aimpars.par" + +# CL tasks + +task asttest = "astcat$src/asttest.cl" + +# Hidden tasks + +hidetask acqctest, acqftest, acqitest + +keep + +clbye() diff --git a/noao/astcat/astcat.hd b/noao/astcat/astcat.hd new file mode 100644 index 00000000..12364c2c --- /dev/null +++ b/noao/astcat/astcat.hd @@ -0,0 +1,32 @@ +# Help directory for the ASTCAT package. + +$doc = "./doc/" +$srcdir = "./src/" + +$agetcat = "srcdir$agetcat/" +$debug = "srcdir$debug/" + +asttest hlp=doc$asttest.hlp, src=srcdir$asttest.cl +aclist hlp=doc$aclist.hlp, src=agetcat$t_aclist.x +aslist hlp=doc$aslist.hlp, src=agetcat$t_aslist.x +adumpcat hlp=doc$adumpcat.hlp, src=debug$t_adumpcat.x +adumpim hlp=doc$adumpim.hlp, src=debug$t_adumpim.x +agetcat hlp=doc$agetcat.hlp, src=agetcat$t_agetcat.x +afiltcat hlp=doc$afiltcat.hlp, src=agetcat$t_afiltcat.x +agetim hlp=doc$agetim.hlp, src=agetcat$t_agetim.x +ahedit hlp=doc$ahedit.hlp, src=agetcat$t_ahedit.x +aimfind hlp=doc$aimfind.hlp, src=agetcat$t_aimfind.x + +aregpars hlp=doc$aregpars.hlp +afiltpars hlp=doc$afiltpars.hlp +acatpars hlp=doc$acatpars.hlp +awcspars hlp=doc$awcspars.hlp +aimpars hlp=doc$aimpars.hlp + +ccsystems hlp=doc$ccsystems.hlp +catalogs hlp=doc$catalogs.hlp +surveys hlp=doc$surveys.hlp +afiles hlp=doc$afiles.hlp + +revisions sys=Revisions + diff --git a/noao/astcat/astcat.men b/noao/astcat/astcat.men new file mode 100644 index 00000000..5e776712 --- /dev/null +++ b/noao/astcat/astcat.men @@ -0,0 +1,23 @@ + asttest - Run basic tests on the astcat package + aclist - List the supported astrometric catalogs + agetcat - Extract astrometry files from astrometric catalogs + afiltcat - Filter astrometry files derived from astrometric catalogs + adumpcat - Catalog access debugging task + + aslist - List the supported image surveys + agetim - Extract FITS images from image surveys + ahedit - Initialize the image wcs and set standard keywords + aimfind - Select images containing catalog objects + adumpim - Image survey access debugging task + + aregpars - Default region parameter set + acatpars - Default astrometry file format parameter set + afiltpars - Default astrometry file filtering parameters + aimpars - Default image data parameters + awcspars - Default image wcs parameters + +help ccsystems - Describe the supported celestial coordinate systems + help catalogs - Describe the astrometric catalog configuration file + help surveys - Describe the image surveys configuration file + help afiles - Describe the standard astrometry file format + diff --git a/noao/astcat/astcat.par b/noao/astcat/astcat.par new file mode 100644 index 00000000..855025ae --- /dev/null +++ b/noao/astcat/astcat.par @@ -0,0 +1,8 @@ +# ASTCAT package parameter file. Set this up so it can be configured for +# a favorite catalog and / or image survey. + +catalogs,s,h,"usno2@noao",,,"The astrometric catalog" +catdb,s,h,"astcat$lib/catdb.dat",,,"The astrometric catalog configuration file" +imsurveys,s,h,"dss2@cadc",,,"The input image survey" +imdb,s,h,"astcat$lib/imdb.dat",,,"The image survey configuration file" +version,s,h,"Aug01" diff --git a/noao/astcat/doc/acatpars.hlp b/noao/astcat/doc/acatpars.hlp new file mode 100644 index 00000000..b64cadad --- /dev/null +++ b/noao/astcat/doc/acatpars.hlp @@ -0,0 +1,264 @@ +.help acatpars Mar00 astcat +.ih +NAME +acatpars -- edit the default astrometry file format parameters +.ih +USAGE +acatpars +.ih +PARAMETERS +.ls ftype = "stext" +The astrometry file format. The current options are: +.ls stext +Simple text. Records are newline delimited and fields are whitespace delimited. +.le +.ls btext +Blocked text. Records are newline delimited and fields are offset and +size delimited. +.le +.le +.ls ccsystem = "j2000" +The default celestial coordinate system. The coordinate systems of most +interest to users are "icrs", "j2000", and "b1950". For more detailed +information on all the celestial coordinate system options type +"help ccsystems". +.le +.ls standard astrometry file fields +The following parameters define the standard astrometry file fields. The +parameter names are the same as the standard field names. The parameter +values are the standard field descriptions. +.sp +Every astrometry file returned by +a catalog query or created by the user must contain the standard fields ra and +dec. The remaining fields are optional and may or may not be present +in either the original catalog or the astrometry file produced by a +catalog query. +.sp +The format of the standard fields is "fieldno [units [format]]" for simple +text files and "foffset fsize [units [format]]" for blocked text files +where the quantities in "[]" are optional. Standard fields with "" valued +field descriptions are assumed to be undefined. +.sp +.ls id = "" +The standard id field. The data type is character. The default units and +format values are "INDEF" and "%20s". +.le +.ls ra = "1 hours" +The standard right ascension / longitude field. The data type is double. The +default units and format values are "hours"and "%11.2h". +.le +.ls dec = "2 degrees" +The standard declination / latitude field. The data type is double. The default +units and format values are "degrees"and "%11.1h". +.le +.ls era = "" +The standard right ascension / longitude error field. The data type is double. +The default units and format values are "asecs" and "%6.3f". +.le +.ls edec = "" +The standard declination / latitude error field. The data type is double. +The default units and format values are "asecs" and "%6.3f". +.le +.ls pmra = "" +The standard right ascension / longitude proper motion field. The data type +is double. The default units and format values are "masecs/yr" and "%7.3f". +.le +.ls pmdec = "" +The standard declination / latitude proper motion field. The data type +is double. The default units and format values are "masecs/yr" and "%7.3f". +.le +.ls epmra = "" +The standard right ascension / longitude proper motion error field. The data +type is double. The default units and format values are "masecs/yr" and "%7.3f". +.le +.ls epmdec = "" +The standard declination / latitude proper motion error field. The data +type is double. The default units and format values are "masecs/yr" and "%7.3f". +.le +.ls catsystem = "" +The standard celestial coordinate system field. The data type is character. +The default units and format field values are "INDEF" and "%15s". If defined +the value of this field overrides the coordinate system defined by the +\fIcsystem\fR parameter. Supported values of catsystem are "icrs", "fk5", +"fk4", "fk4-noe", "ecliptic", "galactic", and "supergalactic". +.le +.ls equinox = "" +The standard celestial coordinate system equinox field. The data type is +character. The default units and format field values are "INDEF" and +"%15s". Equinoxes are typical expressed as Julian epochs e.g. "J2000.0", +Besselian epochs e.g. "B1950.0", or years "2000.0". +.le +.ls epoch = "" +The standard celestial coordinate system epoch field. The data type is +character. The default units and format field values are "INDEF" and +"%15s". Epochs are typical expressed as Julian epochs e.g. "J2000.0", +Besselian epochs e.g. "B1950.0", years "2000.0", or Julian date if the +epoch value > 3000.0. +.le +.ls px = "" +The standard parallax field. The data type is double. The default units +and format values are "msecs" and "%6.3f". +.le +.ls rv = "" +The standard radial velocity field. The data type is double. The default units +and format values are "km/sec" and "%6.3f". +.le +.ls epx = "" +The standard parallax error field. The data type is double. The default units +and format values are "msecs" and "%6.3f". +.le +.ls erv = "" +The standard radial velocity error field. The data type is double. The default +units and format values are "km/sec" and "%6.3f". +.le +.ls mag = "" +The standard magnitude field. The data type is real. The default units +and format field values are "mags" and "%8.3f". +.le +.ls color = "" +The standard color field. The data type is real. The default units +and format field values are "mags" and "%8.3f". +.le +.ls emag = "" +The standard magnitude error field. The data type is real. The default units +and format field values are "mags" and "%8.3f". +.le +.ls ecolor = "" +The standard color error field. The data type is real. The default units +and format field values are "mags" and "%8.3f". +.le +.ls xp = "" +The predicted x coordinate field. The data type is double. The default units +and format field values are "pixels" and "%9.3f". +.le +.ls yp = "" +The predicted y coordinate field. The data type is double. The default units +and format field values are "pixels" and "%9.3f". +.le +.ls xc = "" +The centered x coordinate field. The data type is double. The default units +and format field values are "pixels" and "%9.3f". +.le +.ls yc = "" +The centered y coordinate field. The data type is double. The default units +and format field values are "pixels" and "%9.3f". +.le +.ls exc = "" +The centered x coordinate error field. The data type is double. The default +units and format field values are "pixels" and "%9.3f". +.le +.ls eyc = "" +The centered y coordinate error field. The data type is double. The default +units and format field values are "pixels" and "%9.3f". +.le +.ls imag = "" +The standard instrumental magnitude field. The data type is real. The default +units and format values are "mags" and "8.3f". +.le +.ls eimag = "" +The standard instrumental magnitude error field. The data type is real. The +default units and format values are "mags" and "8.3f". +.le +.le + +.ih +DESCRIPTION + +The acatpars parameters define the default astrometry file format. These +parameters are used if the input astrometry file does not contain a standard +header describing the file format. By default standard headers are written +by all astcat package tasks which create astrometry files. If the +astrometry file does not have a header the acatpars parameters +are used to define one. + +By default acatpars assumes that the input astrometry file is a +simple text file, \fIftype\fR = "stext", with newline delimited records +and whitespace delimited fields. In this case users can define +the fields by setting the appropriate standard file parameters +to a string with the following format, e.g. + +.nf +parname = "fieldno [units [format]]" + + ra = "1 hours" + dec = "2 degrees" +.fi + +where fieldno is the field or column number in the record. The +units and format strings are optional and reasonable defaults are +supplied if they are missing. Currently the units information is +only used for decoding coordinate fields. For other fields the +units should be left at their default values. The format information +is used when an application has to decode a field into a numeric value +modify it in some way and rewrite it. + +If \fIftype\fR is set to "btext" for blocked text the input astrometry file +is assumed to be a text file with newline delimited records and fixed size +fields. This format can be used to describe astrometry files with +fields containing embedded blanks such as id fields. In this case users +define the fields by setting the appropriate standard file parameters to +a string with the following format, e.g. + +.nf +parname = "foffset fsize [units [format]]" + ra = "1 15 hours" + dec = "16 15 degrees" +.fi + +where foffset and fsize are the field offset and size in characters. +Formats and units are treated in the same way as they for simple text files. + +The fundamental coordinate system of the astrometry file is set by +the \fIcsystem\fR parameter. This is a global parameter applying to the +entire astrometry file . Its value is overwritten if the "catsystem" standard +field is defined, in which case the astrometry file may contain entries in +many different fundamental coordinate systems. + +.ih +EXAMPLES +1. List the astrometry file format parameters. + +.nf +cl> lpar acatpars +.fi + +2. Edit the astrometry file format parameters. + +.nf +cl> acatpars +... edit the parameters in the usual way +... type :wq to quit and save the edits +.fi + +3. Edit the astrometry file format parameters from the afiltcat task. + +.nf +cl> epar afiltcat +... edit the afiltcat parameters +... move to the acatpars parameter line and type :e +... edit the acatpars parameters +... type :wq to quit and save the acatpars edits +... continue editing the remaining afiltcat parameters +... type :go to execute the task +.fi + +4. Save the current acatpars parameter values in a text file called +acat1.par. Use the saved parameter set in the next call to the afiltcat +task. + +.nf +cl> epar acatpars +... edit some parameters in the usual way +... type :w acat1.par +... type :q to quit +cl> afiltcat ... acatpars=afilt1.par ... +.fi + +.ih +TIME REQUIREMENTS +.ih +BUGS +.ih +SEE ALSO +afiltcat +.endhelp diff --git a/noao/astcat/doc/aclist.hlp b/noao/astcat/doc/aclist.hlp new file mode 100644 index 00000000..7a917572 --- /dev/null +++ b/noao/astcat/doc/aclist.hlp @@ -0,0 +1,59 @@ +.help aclist Feb00 astcat +.ih +NAME +aclist -- list the supported astrometric catalogs +.ih +USAGE +aclist catalogs +.ih +PARAMETERS +.ls catalogs +The names of the astrometric catalogs to be listed. If catalogs = "*" then +all the astrometric catalogs in the catalog configuration file are listed. +.le +.ls verbose = no +List the catalog query and output formats after the catalog name ? +.le +.ls catdb = ")_.catdb" +The catalog configuration file. The value of catdb defaults to the value +of the package parameter of the same name. The default catalog configuration +file is "astcat$lib/catdb.dat". +.le +.ih +DESCRIPTION +Aclist lists the supported astrometric catalogs specified by the +\fIcatalogs\fR parameter. If catalogs = "*" then all the supported catalogs +are listed, otherwise only the catalog names specified by the user are +listed. Valid catalog names have the form "catalog@site", e.g. "usno2@noao". +If \fIverbose\fR = "yes", then the catalog query and output formats are +listed after the catalog name. + +The catalog names, addresses, query formats, and query output formats are +specified in the catalog configuration file \fIcatdb\fR. By default the catalog +configuration file name defaults to the value of the package parameter catdb. +The default catalog configuration file is "astcat$lib/catdb.dat". +Users can add records to this file or create their own configuration +file using catdb as a model. +.ih +EXAMPLES + +1. List all the astrometric catalogs in the catalog configuration file. + +.nf +cl> aclist * +.fi + +2. List the query format and the output format for the usno2@noao catalog. + +.nf +cl> aclist usno2@noao verbose+ +.fi + +.ih +TIME REQUIREMENTS +.ih +BUGS +.ih +SEE ALSO +aslist +.endhelp diff --git a/noao/astcat/doc/adumpcat.hlp b/noao/astcat/doc/adumpcat.hlp new file mode 100644 index 00000000..46302a64 --- /dev/null +++ b/noao/astcat/doc/adumpcat.hlp @@ -0,0 +1,153 @@ +.help adumpcat Mar00 astcat +.ih +NAME +adumpcat -- query a catalog and capture the results +.ih +USAGE +adumpcat catalog output ra dec size +.ih +PARAMETERS +.ls catalog +The name of the catalog to be queried. Catalog names have the form +catalog@site, e.g. "usno2@noao". The catalog address and query format are +stored in a record called catalog in the catalog configuration file. +.le +.ls output +The name of the output query results file. The query results are written +to the output file without modification, i.e. they may contain comments, +HTML markup, etc as well as the object list. +.le +.ls ra +The right ascension of the field center in the units expected by the catalog +query. The value of ra replaces the default value of the ra query parameter. +.le +.ls dec +The declination of the field center in the units expected by the catalog query. +The value of dec replaces the default value of the dec query parameters. +It may be necessary to add or remove a leading + to make the query work +correctly. +.le +.ls size +The field size in units expected by the catalog query. The value of size +replaces the default value of the width, ra/xwidth, dec/ywidth, +hwidth, x/rahwidth, y/dechwidth, or radius query parameters as appropriate. +.le +.ls catdb = ")_.catdb" +The catalog configuration file. The name of the catalog configuration file +defaults to the value of the package parameter of the same name. The +default configuration file is "astcat$lib/catdb.dat". +.le +.ih +DESCRIPTION +Adumpcat is a simple catalog access debugging task which queries the +astrometric catalog \fIcatalog\fR, captures the results, and writes them +to the file \fIoutput\fR without modification. + +The user must supply values for the query parameters ra, dec, and one or +more of the size query parameters width, ra/xwidth, dec/ywidth, hwidth, +ra/xhwidth, dec/yhwidth, or radius by +specifying appropriate values for the \fIra\fR, \fIdec\fR, and \fIsize\fR +parameters in the units expected by the catalog query. These values are +treated as strings and passed directly to the catalog query without +coordinate transformations or units conversions. + +The catalog configuration file \fIcatdb\fR contains a record for each +supported \fIcatalog\fR. This record contains the catalog address, +the query format, and the output format. The default configuration file +is "astcat$lib/catdb.dat". + +The output of adumpcat can be used to refine the catalog record in the +catalog configuration file. + +.ih +EXAMPLES + +1. List the supported catalogs, select a catalog to query, make the query, +and capture the results. The aclist task is used to list the supported +catalogs, as well as to list the query and output formats for the selected +catalog as shown below. The query format tells the user that the input +ra and dec must be entered in J2000 sexagesimal hours and degrees and +that the size parameter is a halfwidth in minutes. In this case the +results containing leading and trailing comments and +HTML markup as shown below. + +.nf +cl> aclist * +... +usno2@noao +... + +cl> aclist usno2@noao verb+ +Scanning catalog database astcat$lib/catdb.dat +Listing the supported catalogs +usno2@noao +nquery 4 + ra 00:00:00.00 hours %0.2h + dec 00:00:00.0 degrees %0.1h + hwidth 5.0 minutes %0.1f + qsystem J2000.0 INDEF %s +nheader 1 + csystem J2000.0 +nfields 4 + ra 1 0 d hours %12.3h + dec 2 0 d degrees %12.2h + mag1 3 0 r INDEF %4.1f + mag2 4 0 r INDEF %4.1f + +cl> adumpcat usno2@noao2 m51.res 13:29:53.27 +47:11:48.4 10.0 + +cl> page m51.res + +HTTP/1.1 200 OK^M +Date: Mon, 27 Mar 2000 20:59:46 GMT^M +Server: Apache/1.2.6^M +Connection: close^M +Content-Type: text/html^M +^M + +<HTML><HEAD><TITLE>USNO search results</TITLE><BODY> +<body bgcolor="#FFF9E6"><H1>USNO extraction (00:00:00.0 :00:00:00)</H1><P> +Output columns are RA, DEC, Red mag. (E/F) , and Blue mag. (O/J)<P> +<P><H2>Region number Z= 825 RA( 0: 60000) SPD( 32339999: + 32460000)</H2><P> + 00:00:01.443 -0:06:57.52 13.5 15.2<BR> + 00:00:01.574 -0:05:33.26 16.1 18.0<BR> + ... + 00:00:39.326 -0:00:47.83 14.6 16.9<BR> + 00:00:39.650 -0:02:02.64 18.8 19.4<BR> +<P><H2>Region number Z= 825 RA( 129539999: 129600000) SPD( 32339999: + 32460000)</H2><P> + 23:59:20.351 -0:09:34.07 18.3 19.5<BR> + 23:59:21.065 -0:01:18.44 17.4 19.1<BR> +... + 23:59:59.737 -0:03:54.75 10.5 12.4<BR> + 23:59:59.930 -0:01:57.84 18.1 18.6<BR> +<P><H2>Region number Z= 900 RA( 0: 60000) SPD( 32400000: + 32460000)</H2><P> + 00:00:00.503 0:06:07.90 18.0 19.5<BR> + 00:00:02.568 0:05:07.93 18.3 19.4<BR> +... + 00:00:39.056 0:02:11.91 18.4 19.2<BR> + 00:00:39.978 0:09:54.59 18.6 19.5<BR> +<P><H2>Region number Z= 900 RA( 129539999: 129600000) SPD( 32400000: +32460000)</H2><P> + 23:59:21.198 0:07:43.82 18.7 19.3<BR> + 23:59:21.364 0:08:05.09 18.4 19.6<BR> +... + 23:59:57.729 0:03:36.13 18.0 19.2<BR> + 23:59:59.460 0:08:42.02 19.2 19.7<BR> +<HR><P><P> Found 193 Entries<P><HR> +<address> + Central Computer Services, National Optical Astronomy Observatories, + 950 N. Cherry Ave., P.O. Box 26732, + Tucson, AZ 85726, Phone: 520-318-8000, FAX: 520-318-8360 + <P>Updated: 04Aug1998</address></body></html> +.fi +.ih +TIME REQUIREMENTS +.ih +BUGS +.ih +SEE ALSO +aclist, agetcat +.endhelp diff --git a/noao/astcat/doc/adumpim.hlp b/noao/astcat/doc/adumpim.hlp new file mode 100644 index 00000000..56270143 --- /dev/null +++ b/noao/astcat/doc/adumpim.hlp @@ -0,0 +1,125 @@ +.help adumpim Mar00 astcat +.ih +NAME +adumpim -- query an image survey and capture the results in a fits file +.ih +USAGE +adumpim imsurvey output ra dec size +.ih +PARAMETERS +.ls imsurvey +The name of the image survey to be queried. Image survey names have the form +survey@site, e.g. "dss2@cadc". The image survey address and query format are +stored in a record called imsurvey in the image survey configuration file. +.le +.ls output +The name of the output query results file. The query results are written +to the output file without modification, but at present they are implicitly +assumed to be in fits format. Users should append a ".fits" extension to +the output file name if they wish the output file to be visible to IRAF +as a FITS image. +.le +.ls ra +The right ascension of the field center in the units expected by the image +survey query. The value of ra replaces the default value of the ra query +parameter. +.le +.ls dec +The declination of the field center in the units expected by the image +survey query. The value of dec replaces the default value of the dec query +parameters. It may be necessary to add or remove a leading + sign from +in order to make the query function correctly. +.le +.ls size +The field size in units expected by the image survey query. The value of size +replaces the default value of the width, xwidth, ywidth, hwidth, hxwidth, +and hywidth query +parameters as appropriate. +.le +.ls imdb = ")_.imdb" +The image survey configuration file. The name of the image survey configuration +file defaults to the value of the imdb package parameter. The default +configuration file is "astcat$lib/imdb.dat". +.le +.ih +DESCRIPTION +Adumpim is a simple image survey access debugging task which queries the +image survey \fIimsurvey\fR, captures the results, and writes them +to the file \fIoutput\fR without modification. + +The user must supply values for the query parameters ra, dec, and one or +more of the size query parameters width, xwidth, ywidth, hwidth, xhwidth, +or yhwidth, by +specifying appropriate values for the \fIra\fR, \fIdec\fR, and \fIsize\fR +parameters in the units expected by the image survey query. These values are +treated as strings and passed directly to the image survey query without +coordinate transformations or units conversions. + +The image survey configuration file \fIimdb\fR contains a record for each +supported \fIimsurvey\fR. This record contains the image survey address, +the query format, and the output format. The default image survey configuration +file is "astcat$lib/imdb.dat". + +The output of adumpim can be used to refine the image survey record in the +image survey configuration file. + +.ih +EXAMPLES + +1. List the supported image surveys, select an image survey to query, make +the query and capture the results. The aslist task is used to list +the supported image surveys and the query and output formats for the selected +image survey as shown below. The query format tells the user that the input +ra and dec must be in sexagesimal hours and degrees and in the J2000 +coordinate system that the size parameter is a radius in minutes. + +.nf +cl> aslist * +... +dss2@cadc +... + +cl> aslist dss2@cadc verb+ +Scanning image surveys database astcat$lib/imdb.dat +Listing the supported image surveys +dss2@cadc +wcs dss +nwcs 10 + wxref INDEF INDEF d pixels + wyref INDEF INDEF d pixels + wxmag INDEF 1.009 d arcsec/pixel + wymag INDEF 1.009 d arcsec/pixel + wxrot INDEF 180.0 d degrees + wyrot INDEF 0.0 d degrees + wraref OBJCTRA INDEF d hms + wdecref OBJCTDEC INDEF d dms + wproj INDEF tan c INDEF + wsystem INDEF J2000 c INDEF +nkeys 13 + observat INDEF Palomar c INDEF + esitelng INDEF +116:51:46.80 d degrees + esitelat INDEF +33:21:21.6 d degrees + esitealt INDEF 1706 r meters + esitetz INDEF 8 r INDEF + emjdobs INDEF INDEF c INDEF + edatamin INDEF INDEF r ADU + edatamax INDEF INDEF r ADU + egain INDEF INDEF r e-/ADU + erdnoise INDEF INDEF r e- + ewavlen INDEF INDEF r angstroms + etemp INDEF INDEF r degrees + epress INDEF INDEF r mbars + +cl> adumpim dss2@cadc m51.fits 13:29:53.27 +47:11:48.4 10.0 + +cl> imheader m51.fits + +.fi +.ih +TIME REQUIREMENTS +.ih +BUGS +.ih +SEE ALSO +aslist, agetim +.endhelp diff --git a/noao/astcat/doc/afiles.hlp b/noao/astcat/doc/afiles.hlp new file mode 100644 index 00000000..83f08791 --- /dev/null +++ b/noao/astcat/doc/afiles.hlp @@ -0,0 +1,106 @@ +.help afiles Mar00 astcat +.ih +NAME +afiles -- describe the standard astrometry files +.ih +USAGE +help files + +.ih +ASTROMETRY FILES + +An astrometry file is any text file containing celestial coordinate information +for a small region of the sky. A minimal astrometry file consists of a list +of celestial coordinate pairs one pair per line. Most astrometry files also +contain additional non- positional information, e.g. proper motions, +magnitudes, colors, etc. + +A standard astrometry file as an astrometry file containing a standard header +describing the contents and format of the file. The astcat tasks use the +header to decode the file. Normally the astrometry file header is derived +from the parent astrometric catalog description in the catalog configuration +file. If the astrometry file header is missing one may be constructed +after the fact by setting the standard field description parameter +in the \fIacatpars\fR parameter set and running the \fIafiltcat\fR task. + +A set of standard field names is reserved for describing the format of +astrometry files. The current list of standard field names is: +id, ra, dec, era, edec, pmra, pmdec, epmra, epmdec, catsystem, equinox, +epoch, px, rv, epx, erv, mag, color, emag, ecolor, xp, yp, xc, yc, exc, +eyc, imag, and eimag. For more information about these fields type +"help acatpars". + +.ih +SAMPLE STANDARD ASTROMETRY FILE + +A sample astrometry file in standard format is shown below. + +.nf +# BEGIN CATALOG HEADER +# type stext +# nheader 1 +# csystem J2000 +# nfields 4 +# ra 1 0 d hours %12.3h +# dec 2 0 d degrees %12.2h +# mag1 3 0 r INDEF %4.1f +# mag2 4 0 r INDEF %4.1f +# END CATALOG HEADER + + 00:00:01.443 -0:06:57.52 13.5 15.2 + 00:00:01.574 -0:05:33.26 16.1 18.0 + 00:00:01.904 -0:09:48.51 18.2 19.6 + 00:00:02.529 -0:04:21.53 13.4 14.4 + 00:00:04.154 -0:01:56.32 17.1 18.3 + 00:00:04.438 -0:05:00.03 11.4 13.5 + 00:00:04.697 -0:03:24.59 16.9 17.7 + 00:00:05.989 -0:02:46.36 15.1 17.6 + 00:00:07.118 -0:09:03.53 19.1 19.8 + 00:00:07.260 -0:06:47.95 17.0 17.7 + 00:00:07.314 -0:00:22.35 15.3 16.8 + 00:00:07.818 -0:02:25.90 12.2 12.4 +.fi + +.ih +SAMPLE ASTROMETRY FILE + +A sample headerless astrometry file is shown below where ra, dec, mag1 +and mag2 are stored in columns 1 through 4 respectively. + +.nf + 00:00:01.443 -0:06:57.52 13.5 15.2 + 00:00:01.574 -0:05:33.26 16.1 18.0 + 00:00:01.904 -0:09:48.51 18.2 19.6 + 00:00:02.529 -0:04:21.53 13.4 14.4 + 00:00:04.154 -0:01:56.32 17.1 18.3 + 00:00:04.438 -0:05:00.03 11.4 13.5 + 00:00:04.697 -0:03:24.59 16.9 17.7 + 00:00:05.989 -0:02:46.36 15.1 17.6 + 00:00:07.118 -0:09:03.53 19.1 19.8 + 00:00:07.260 -0:06:47.95 17.0 17.7 + 00:00:07.314 -0:00:22.35 15.3 16.8 + 00:00:07.818 -0:02:25.90 12.2 12.4 +.fi + +This file can be converted to standard form with the afiltcat task as follows + +.nf +cl> agetcat input output filter- ra="1 hours %12.3h" dec="2 degrees %12.2h" \ +mag="1-2 INDEF %4.1f" +.fi + +or by editing in a header of the form shown in the previous section. The +lines + +.nf +# BEGIN CATALOG HEADER +# END CATALOG HEADER +.fi + +delimit the header. The header must contain the type, nheader, and +nfields keyword value pairs and accurate descriptions of file the format. + +.ih +SEE ALSO +help catalogs, agetcat, afiltcat, acatpars +.endhelp diff --git a/noao/astcat/doc/afiltcat.hlp b/noao/astcat/doc/afiltcat.hlp new file mode 100644 index 00000000..447891de --- /dev/null +++ b/noao/astcat/doc/afiltcat.hlp @@ -0,0 +1,167 @@ +.help afiltcat Mar00 astcat +.ih +NAME +afiltcat -- filter astrometry files +.ih +USAGE +afiltcat input output +.ih +PARAMETERS +.ls input +The list of input astrometry files. Astrometry files may be created by +other astcat tasks, e.g. agetcat, in which case they are preceded by a +header describing the format of the input astrometry file, or by +other IRAF or user tasks in which case the \fIacatpars\fR parameter set +must be used to describe them. +.le +.ls output +The list of output astrometry files. The number of output astrometry files +must be equal to the number of input astrometry files. If the output file +name equals the input file name then the original astrometry file is +overwritten. +.le +.ls acatpars = "" +The default input astrometry file format parameters. The acatpars parameters +are used only if the input astrometry file does not have a header. Type +"help acatpars" for a detailed description of the acatpars parameters. +.le +.ls catalogs = "filename@noao" +The dummy input catalog name. Afiltcat task users should leave this +parameter at its default setting. +.le +.ls standard = yes +Output a standard astrometry file ? If standard = yes then a header describing +the format of the output astrometry file is written to the output file. +Astcat package tasks use this information to decode the astrometry file. If +standard = no, no header is written and astcat tasks must use the acatpars +parameters to decode the astrometry file. +.le +.ls filter = yes +Filter rather than copy the input astrometry file to the output astrometry +file ? +.le +.ls afiltpars = "" +The astrometry file filtering parameter set. Afiltpars parameters permit the +user to sort the output on a field or field expression, select or reject +catalog records using a boolean expression, select or reject fields +to output, add new fields to the output that are expressions of existing +fields, and perform simple coordinate transformations. +.le +.ls update = no +Update the default values of the algorithm parameter sets, e.g. acatpars and +afiltpars, on task termination ? +.le +.ls verbose = yes +Print status messages on the terminal as the task proceeds ? +.le +.ls catdb = ")_.catdb" +The catalog configuration file. Catdb defaults to the value of the +package parameters catdb. The default catalog configuration file is +"astcat$lib/catdb.dat". +.le + +.ih +DESCRIPTION + +Afiltcat filters the list of input astrometry files \fIinput\fR +and writes the results to the output files \fIoutput\fR. The number of input +astrometry files must equal the number of output astrometry files. + +The format of the input astrometry files is defined by the file header +if the file was written by an astcat package task, or by the +\fIacatpars\fR parameter set. The acatpars parameters \fIftype\fR and +\fIcsystem\fR define the input astrometry file type and coordinate system. +The position, size, and units of the standard astrometry file fields +the associated error fields are defined by the parameters: +\fIid\fR, \fIra\fR, \fIdec\fR, \fIpmra\fR, \fIpmdec\fR, \fIcatsystem\fR, +\fIequinox\fR, \fIepoch\fR, \fIpx\fR, \fIrv\fR, \fImag\fR, \fIcolor\fR, +\fIxp\fR, \fIyp\fR, \fIxc\fR, \fIyc\fR, and \fIimag\fR, and: + \fIera\fR, \fIedec\fR, +\fIepmra\fR, \fIepmdec\fR, \fIepx\fR, \fIerv\fR, \fIemag\fR, \fIecolor\fR, +\fIexc\fR, \fIeyc\fR, \fIeimag\fR. More detailed information on astrometry +files and the acatpars parameters can be found by typing "help files" +and "help acatpars". + +If \fIfilter\fR = yes, the input astrometry file is filtered before being +written to the outputfile. The filtering parameters are defined by the +filtering parameter set \fIafiltpars\fR. +The afilterpars parameters permit the user to sort the query results by setting +the sort field parameter \fIfsort\fR, select or reject +catalog records by setting the selection expression parameter \fIfexpr\fR, +select or reject fields for output by setting the output field +list parameter \fIafields\fR, and change the coordinate system, units, +and format of the output coordinates by setting the \fIfosystem\fR, +\fIforaunits\fR, \fIfodecunits\fR, \fIforaformat\fR, and \fIfodecformat\fR +parameters. A more detailed description of the filtering +parameters can be obtained by typing "help afiltpars". + +If \fIstandard\fR = yes a header is written to the output file which +defines the contents and format of the output astrometry file. The astcat +tasks use this header to decode the astrometry files. If the header is +missing or has been modified by non-astcat tasks the user must set +standard = no, and use the \fIacatpars\fR parameters to define the +astrometry file format. Most non-astcat tasks will interpret the catalog +header as documentation and skip it. + +If \fIupdate\fR = yes the values of the \fIacatpars\fR and \fIafiltpars\fR +parameters are updated at task termination. If \fIverbose\fR = yes +then detailed status reports are issued as the task executes. + +.ih +EXAMPLES + +1. Sort the input astrometry file using the value of the magnitude field. + +.nf +cl> page reg001.cat.1 +... examine catalog header to determine name of magnitude field +cl> afiltcat reg001.cat.1 reg001.cat.2 fsort=mag1 +.fi + +2. Repeat example 1 but only output records for which mag1 <= 16.0. + +.nf +cl> afiltcat reg001.cat.1 reg001.cat.3 fsort=mag1 fexpr="mag1 <= 16.0" +.fi + +3. Repeat example 2 but since the input astrometry file has 2 magnitude +columns output a new color field equal to "mag2 - mag1". + +.nf +cl> afiltcat reg001.cat.1 reg001.cat.4 fsort=mag1 fexpr="mag1 <= 16.0" \ +fields="f[*],mag2-mag1" +.fi + +4. Repeat example 1 but overwrite the input astrometry file. + +.nf +cl> page reg001.cat.1 +... examine catalog header to determine name of magnitude field +cl> afiltcat reg001.cat.1 reg001.cat.1 fsort=mag1 +.fi + + +5. Filter a list of input astrometry files by extracting columns 1-4 +but reversing the order of fields 3 and 4. Overwrite the input files. + +.nf +cl> afiltcat @inlist @inlist fields="f[1-2],f4,f3" +.fi + +6. Repeat the previous example for a list of text files which have no catalog +headers but contain the ras and decs in hours and degrees in J2000 +coordinates of a list of source in columns 1 and 2 of a simple text file. + +.nf +cl> afiltcat @inlist @inlist ftype="stext" csystem=j2000 ra="1 hours" \ + dec="2 degrees" mag="3-4" fields="f[1-2],f4,f3" +.fi + +.ih +TIME REQUIREMENTS +.ih +BUGS +.ih +SEE ALSO +aclist, agetcat, acatpars, afiltpars +.endhelp diff --git a/noao/astcat/doc/afiltpars.hlp b/noao/astcat/doc/afiltpars.hlp new file mode 100644 index 00000000..673f2185 --- /dev/null +++ b/noao/astcat/doc/afiltpars.hlp @@ -0,0 +1,357 @@ +.help afiltpars Mar00 astcat +.ih +NAME +afiltpars -- edit the catalog filtering parameters +.ih +USAGE +afiltpars +.ih +PARAMETERS +.ls fsort = "" +The field or field expression on which to sort the catalog / file records. +The sort may be numeric or character. Sort fields may be expressed by name, +e.g. "mag1" or field number, e.g. "f3". Sort expressions must be a combination +of existing fields, e. g. "mag2 - mag1" or "f4 - f3". By default the records +are not sorted. +.le +.ls freverse = no +Sort in descending order ? +.le +.ls fexpr = yes +The boolean record selection expression. By default all catalog / file records +are selected, otherwise only records matching the selection expression +are selected. Selection expressions must be combination of existing fields +and field expressions, e.g. "mag1 < 16.0", or "(f4 - f3) < 1.5". +.le +.ls fields = "f[*]" +The list of output fields and field expressions. By default the sorted and +selected records are output as is. Output fields may be field names, e.g. +"mag1", field numbers e.g. "f3", or field ranges e.g. "f[1-4]". Output field +expressions must be a combination of existing fields, e.g. "mag2 - mag1", +or "f4 - f3". +.le +.ls fnames = "" +The list of new field names separated by commas. By default new fields, e.g. +fields that are expressions of existing fields are assigned names of the form +"f#" where # is the field sequence number. Field names must be valid tokens, +i.e. they cannot be expressions or contain embedded blanks. +.le +.ls fntypes = "" +The list of new field types separated by commas. By default new fields are +assigned type real. Permitted field types are "s" for string, "i" for +integer, "r" for real, or "d" for double". +.le +.ls fnunits = "" +The list of new field units separated by commas. By default new fields are +assigned units of INDEF. Units specifications may not contain embedded blanks. +.le +.ls fnformats = "" +The list of new field formats. By default string, integer, and floating +point fields are assigned formats of "%10s", "%10d", and "%10g" respectively. +.le +.ls fosystem = "" +The output celestial coordinate system. If fosystem is undefined +it defaults to the catalog celestial coordinate system. Popular options +are "icrs", "j2000.0", "b1950.0". The full set of options can be examined +by typing "help ccsystems". +.le +.ls fira = "ra" +The name of the catalog field containing the right ascension / longitude +of an object. Most users should leave fira set to "ra". If the user knows +the number of the right ascension / longitude field the generic field name +"f#", e.g. "f1" can be used. +.le +.ls fidec = "dec" +The name of the catalog field containing the declination / latitude +of an object. Most users should leave fidec set to "dec". If the user knows +the number of the declination / latitude field the generic field name "f#", +e.g. "f2" can be used. +.le +.ls foraunits = "" +The units of fira. Permitted values are "hours", "degrees", and "radians". If +foraunits is undefined it defaults to the preferred units of the +output celestial coordinate system fosystem, e.g. hours for equatorial +coordinate systems and degrees for ecliptic, galactic, and super-galactic +coordinate systems. +.le +.ls fodecunits = "" +The units of fidec. Permitted values are "degrees" and "radians". If +fodecunits is undefined it defaults to the preferred units of the +output celestial coordinate system fosystem, e.g. degrees for all systems. +.le +.ls foraformat = "" +The format of fira. If undefined foraformat defaults to the equivalent catalog +format. +.le +.ls fodecformat = "" +The format of fidec. If undefined fodecformat defaults to the equivalent +catalog format. +.le +.ls fixp = "xp" +The name of the catalog field containing the predicted x coordinate +of an object. Most users should leave fixp set to "xp". If the user knows +the number of the predicted x coordinate field the generic field name +"f#", e.g. "f1" can be used. +.le +.ls fiyp = "yp" +The name of the catalog field containing the predicted y coordinate +of an object. Most users should leave fiyp set to "yp". If the user knows +the number of the predicted y coordinate field the generic field name +"f#", e.g. "f2" can be used. +.le +.ls fixc = "xc" +The name of the catalog field containing the centered x coordinate +of an object. Most users should leave fixc set to "xc". If the user knows +the number of the centered x coordinate field the generic field name +"f#", e.g. "f1" can be used. +.le +.ls fiyc = "yc" +The name of the catalog field containing the centered y coordinate +of an object. Most users should leave fiyc set to "yc". If the user knows +the number of the centered y coordinate field the generic field name +"f#", e.g. "f2" can be used. +.le +.ls foxformat = "%10.3f" +The format of fixp and fixc. +.le +.ls foyformat = "%10.3f" +The format of fiyp and fiyc. +.le + +.ih +DESCRIPTION +The catalog / file filtering parameters are used to filter the results +of a catalog query before writing the results to disk. Catalog / file filtering +options include: sorting on a field or field expression, +selecting and rejecting records by evaluating a boolean expression +for each record, selecting a subset of the fields for output, +transforming the coordinates from the catalog / file celestial coordinate +system to a user specified celestial coordinate system, and computing new +fields from existing fields. + +\fIfsort\fR and \fIfreverse\fR define the sort field or field expression and +the sort order. Sort fields may be field names or field numbers, e.g. +"mag1" or "f3". By default the sort order is ascending. + +Records are selected or rejected based on the value of the boolean expression +\fIfexpr\fR. By default all catalog / file records are selected. The boolean +selection expression must be function of existing catalog fields, e.g. +the expression "mag1 <= 16.0" will select all records for which the mag1 +field is <= 16.0, and the expression "(f4 - f3) >= 0.0 && (f4 - f3) <= 1.0" +will select all records for which the difference between fields 4 and 3 +is >= 0.0 but <= 1.0. + +The \fIfields\fR parameter defines the list output fields and field +expressions. By default all the +input fields are output. By setting \fIfields\fR appropriately the user +can select a subset of the input fields for output, rearrange the order +of the input fields, and compute new fields. For example setting +fields to "f[2-5]" selects fields 2 to 5 for output; setting fields +to "f[2-3],f5,f4" select fields 2 to 5 but reverses the order of fields +4 and 5; setting fields to "f[2-5],f5-f4" selects fields 2 to 5 and +adds a new field which is the difference between fields 5 and 4. + +By default new fields are assigned names of the form "f#" where # is the field +number, a data type of real, units of INDEF, and formats of %10s, %10d, or +%10g if they are character, integer, or real respectively. Users can define +names, data types, units, and formats for the new fields by setting +the \fIfnames\fR, \fIfntypes\fR, \fIfnunits\fR, and \fIfnformats\fR +parameters. + +The coordinate system, units, or format of the output coordinates may +be changed by setting one or more of the \fIfosystem\fR, \fIforaunits\fR, +\fIfodecunits\fR, \fIforaformat\fR, \fIfodecformat\fR. By default the +filtering code expects the input coordinates to be located in fields +called "ra" and "dec". If these fields do not have valid names then +generic field names of the form "f#" can be substituted. + +The names and format of any newly computed pixel coordinate fields may +be specified by setting one or more of the \fIfixp\fR, \fIfiyp\fR, +\fIfixc\fR, \fIfiyc\fR, \fIfoxformat\fR, or \fIfoyformat\fR parameters. +By default the filtering code expects the pixel coordinates to be located +in fields called "xp", "yp", 'xc", and "yc". If these fields do not have +standard names then generic field names of the form "f#" can be substituted. +.ih +EXPRESSIONS + +The output records are selected on the basis of the input boolean +expression \fIfexpr\fR whose variables are the field names specified +in the configuration file or the generic equivalents f#. If after +substituting the values associated with a particular record into the +field name variables the expression evaluates to yes, that record is +included in the output catalog. Numeric expressions can also be used +to define the sort expression \fIfsort\fR or to define new fields in +\fIfields\fR. + +The supported operators and functions are briefly described below. A detailed +description of the boolean expression evaluator and its syntax can be found +in the manual page for the images package hedit task. + +The following logical operators can be used in the boolean expression. + +.nf + equal == not equal != + less than < less than or equal <= + greater than > greater than or equal >= + or || and && + negation ! pattern match ?= + concatenation // +.fi + +The pattern match character ?= takes a +string expression as its first argument and a pattern as its second argument. +The result is yes if the pattern is contained in the string expression. +Patterns are strings which may contain pattern matching meta-characters. +The meta-characters themselves can be matched by preceding them with the escape +character. The meta-characters listed below. + +.nf + beginning of string ^ end of string $ + one character ? zero or more characters * + white space # escape character \ + ignore case { end ignore case } + begin character class [ end character class ] + not, in char class ^ range, in char class - +.fi + +The expression may also include arithmetic operators and functions. +The following arithmetic operators and functions are supported. + +.nf +addition + subtraction - +multiplication * division / +negation - exponentiation ** +absolute value abs(x) cosine cos(x) +sine sin(x) tangent tan(x) +arc cosine acos(x) arc sine asin(x) +arc tangent atan(x) arc tangent atan2(x,y) +exponential exp(x) square root sqrt(x) +natural log log(x) common log log10(x) +minimum min(x,y) maximum max(x,y) +convert to integer int(x) convert to real real(x) +nearest integer nint(x) modulo mod(x) +.fi + +.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. List the catalog / file filtering parameters. + +.nf +cl> lpar afiltpars +.fi + +2. Edit the catalog / file filtering parameters. + +.nf +cl> afiltpars +... edit the parameters in the usual way +... type :wq to quit and save the edits +.fi + +3. Edit the catalog filtering parameters from the agetcat task. + +.nf +cl> epar agetcat +... edit the agetcat parameters +... move to the afiltpars parameter line and type :e +... edit the afiltpars parameters +... type :wq to quit and save the afiltpars edits +... continue editing the remaining agetcat parameters +... type :go to execute the task +.fi + +4. Save the current afiltpars parameter values in a text file called +afilt1.par. Use the saved parameter set in the next call to the agetcat +task. + +.nf +cl> epar afiltpars +... edit some parameters in the usual way +... type :w afilt1.par +... type :q to quit +cl> agetcat ... afiltpars=afilt1.par ... +.fi +.ih +TIME REQUIREMENTS +.ih +BUGS +.ih +SEE ALSO +agetcat, afiltcat +.endhelp diff --git a/noao/astcat/doc/agetcat.hlp b/noao/astcat/doc/agetcat.hlp new file mode 100644 index 00000000..291a6fbb --- /dev/null +++ b/noao/astcat/doc/agetcat.hlp @@ -0,0 +1,253 @@ +.help agetcat Mar00 astcat +.ih +NAME +agetcat -- Extract objects from astrometric catalogs +.ih +USAGE +agetcat regions output +.ih +PARAMETERS +.ls regions +The source of the extraction region definitions. The options are: +.ls <filename> +The name of a text file containing a list of region definitions, one +region definition per line. The format of the regions file is described +in detail below. +.le +.ls <image list> +The list of images containing the region definition. The input images +must have a valid FITS world coordinate system in order to be used +for region definition. +.le +.ls pars +If regions is set to the reserved keyword "pars" then a single region +definition is read from the \fIaregpars\fR parameter set. By default a region +ten arc minutes in size around coordinates ra = "00:00:00.0" and +dec = "+00:00:00" in the query coordinate system is extracted. +.le +.le +.ls output +The list of output astrometry files. The number of output files must be equal +to the number regions in the regions list times the number of astrometry +catalogs in the catalog list. By default the output files are assigned names of +the form "reg#[.cat#].cat.#" if the region definition source is "pars" or +a file e.g. "reg002.cat.1", or "image[.cat#].cat.#" if the region +definition source is an image list, e.g. "image.cat.1". The catalog number +is only inserted if there is more than one catalog in the catalog list. +.le +.ls aregpars = "" +The region definition parameter set. The aregpars parameters define the +extraction region center, region width, region center units, and the region +center coordinate system. The region definition parameters are used if +\fIregions\fR = "pars". +.le +.ls catalogs = ")_.catalogs" +The list of input astrometry catalogs. By default the catalog name is set to the +value of the package parameter catalogs. +.le +.ls standard = yes +Output a standard astrometry file ? If standard = yes then a header describing +the format of the astrometry file is written to the output file. The +astcat package +tasks use this information to decode the file. If standard = no, no +header is written and the user must instruct the astcat tasks how to decode the +file. +.le +.ls filter = no +Filter the results of the catalog query before writing the final results +to the output astrometry file ? +.le +.ls afiltpars = "" +The astrometry file filtering parameter set. These parameters permit the user +to sort the output on a field or field expression, select or reject +catalog records using a boolean expression, select or reject fields +to output, add new fields that are expressions of existing fields to +the output, and perform simple coordinate transformations. +.le +.ls update = no +Update the default values of the algorithm parameters, e.g. aregpars and +afiltpars, at task termination ? +.le +.ls verbose = yes +Print status messages on the terminal as the task proceeds ? +.le +.ls catdb = ")_.catdb" +The catalog configuration file. Catdb defaults to the value of the +package parameter catdb. The default catalog configuration file is +"astcat$lib/catdb.dat". +.le + +.ih +DESCRIPTION + +Agetcat extracts astrometry files from local or remote astrometry catalogs +\fIcatalogs\fR using a list of region definitions \fIregions\fR supplied by +the user and writes the results of each catalog query to the output astrometry +files \fIoutput\fR. + +A region definition consists of the coordinates of the field center, +the field size, the units of the field center, and the coordinate system of +the field center. If \fIregions\fR = "pars" these quantities are read +from the \fIaregpars\fR parameters \fIrcra\fR, \fIrcdec\fR, \fIrcrawidth\fR, +\fIrcdecwidth\fR \fIrcraunits\fR, \fIrcdecunits\fR., and \fIrcsystem\fR. +If \fIregions\fR is an image they are read from the FITS world coordinate +system in the image header. If \fIregions\fR is a file name they are +read from a file whose format is the following. + +.nf +# Optional comment + +ra1 dec1 xwidth1 ywidth1 [raunits1 [decunits1 [system1]]] +ra2 dec2 xwidth2 ywidth2 [raunits2 [decunits2 [system2]]] +... .... ....... ....... [........ [......... [.......]]] +raN decN xwidthN ywidthN [raunitsN [decunitsN [systemN]]] +.fi + +Quantities in square brackets are optional. If system is undefined the +coordinate system defaults to the query coordinate system, i.e. if the +catalog query expects coordinates in J2000.0 then ra and dec will be +interpreted as though they were in the J2000.0 system. If undefined +the ra and dec units default to the preferred units of the coordinate +system, i.e. hours and degrees for equatorial coordinate systems, +and degrees and degrees for ecliptic, galactic, and supergalactic +coordinate systems. + +A sample regions file is shown below. If the catalog query system is +J2000.0 then all four region definitions are equivalent, since J2000.0 +is assumed in examples 1 and 2, is specified in example 3, and example 4 +is same region as example 3 but expressed in the B1950.0 coordinate system. + +.nf +# List of targets + +13:29:53.27 +47:11:48.4 10.0 10.0 +13:29:53.27 +47:11:48.4 10.0 10.0 hours degrees +13:29:53.27 +47:11:48.4 10.0 10.0 hours degrees J2000.0 +13:27:46.90 +47:27:16.0 10.0 10.0 hours degrees B1950.0 +.fi + +For each specified astrometry catalog in \fIcatalog\fR agetcat loops through the +regions list, formats the catalog query, makes a local or remote +connection to the catalog server using the catalog description in the +catalog configuration file \fIcatdb\fR, and captures the results. +Catalog names must be of the forms catalog@site, e.g. usno2@noao. +Catalog names without entries in the catalog configuration file +are skipped. + +If \fIfilter\fR = yes, the captured results are filtered using the +values of the parameters in the filtering parameter set \fIafiltpars\fR. +The afilterpars parameters permits the user to sort the query results by setting +the sort field parameter \fIfsort\fR, select or reject +catalog records by setting the selection expression parameter \fIfexpr\fR, +select or reject fields for output by setting the output field +list parameter \fIfields\fR, and change the coordinate system, units, +and format of the catalog coordinates by setting the \fIfosystem\fR, +\fIforaunits\fR, \fIfodecunits\fR, \fIforaformat\fR, and \fIfodecformat\fR +parameters. A more detailed description of the region filtering +parameters can be obtained by typing "help afiltpars". + +If \fIstandard\fR = yes a header is written to the output astrometry file which +defines the contents and format of the output object list. The astcat +tasks use this header to decode the input catalog files. If it is +missing or has been modified by non-astcat tasks the user must use +the \fIacatpars\fR parameters to define the astrometry file format. Most +non-astcat tasks will interpret the astrometry file header as documentation +and skip it. + +If \fIupdate\fR = yes the values of the \fIaregpars\fR and \fIafilterpars\fR +parameters will be updated at task termination. If \fIverbose\fR = yes +then detailed status reports are issued as the task executes. + +.ih +EXAMPLES + +1. Extract data from the default catalog using the default region definition +and page the results to determine the catalog format, i.e. the number and +names of the default output fields. + +.nf +cl> agetcat pars default +cl> page reg001.cat.1 +.fi + +2. Repeat the previous example but sort the output on the sort field "mag1". + +.nf +cl> agetcat pars default filter+ fsort=mag1 +cl> page reg001.cat.2 +.fi + +3. Repeat example 2 but output only those records for which mag <= 16.0. + +.nf +cl> agetcat pars default filter+ fsort=mag1 fexpr="mag1 <= 16.0" +cl> page reg001.cat.3 +.fi + +4. Repeat example 3 but output a new field equal to mag2 - mag3. + +.nf +cl> agetcat pars default filter+ fsort=mag1 fexpr="mag1 <= 16.0" \ +fields="f[*],mag2-mag1" +cl> page reg001.cat.4 +.fi + +5. Run agetcat on the text file regions which contains a list of region +definitions. Note that the coordinate system and coordinate units default +to those expected by the catalog query. The latter information can be +determined by running aclist on the default catalog. + +.nf +cl> page regions +00:00:00.0 -90:00:00 10.0 10.0 +00:00:00.0 -60:00:00 10.0 10.0 +00:00:00.0 -30:00:00 10.0 10.0 +00:00:00.0 +00:00:00 10.0 10.0 +00:00:00.0 +30:00:00 10.0 10.0 +00:00:00.0 +60:00:00 10.0 10.0 +00:00:00.0 +90:00:00 10.0 10.0 +cl> agetcat regions default +cl> page reg001.cat.5 +cl> page reg002.cat.1 +cl> page reg003.cat.1 +cl> page reg004.cat.1 +cl> page reg005.cat.1 +cl> page reg006.cat.1 +cl> page reg007.cat.1 +.fi + +6. Repeat example 5 but find data for two catalogs the usno2@noao and +gsc@cadc. + +.nf +page regions +00:00:00.0 -90:00:00 10.0 10.0 +00:00:00.0 -60:00:00 10.0 10.0 +00:00:00.0 -30:00:00 10.0 10.0 +00:00:00.0 +00:00:00 10.0 10.0 +00:00:00.0 +30:00:00 10.0 10.0 +00:00:00.0 +60:00:00 10.0 10.0 +00:00:00.0 +90:00:00 10.0 10.0 +cl> agetcat regions default catalogs="usno2@noao,gsc@noao" +.fi + +7. Run agetcat on a list of images containing valid FITS WCS information. +Note that in the following example the test image dev$pix does not +have a FITS WCS so no data is extracted for it. + +.nf +cl> page imlist +dev$pix +dev$ypix +cl> agetcat @imlist default +cl> page wpix.cat.1 +.fi + +.ih +TIME REQUIREMENTS +.ih +BUGS +.ih +SEE ALSO +aclist, adumpcat, aregpars, afiltpars +.endhelp diff --git a/noao/astcat/doc/agetim.hlp b/noao/astcat/doc/agetim.hlp new file mode 100644 index 00000000..1809f3f9 --- /dev/null +++ b/noao/astcat/doc/agetim.hlp @@ -0,0 +1,242 @@ +.help agetim Mar00 astcat +.ih +NAME +agetim -- extract fits images from image surveys +.ih +USAGE +agetim regions output +.ih +PARAMETERS +.ls regions +The source of the extraction region definitions. The options are: +.ls <filename> +The name of a text file containing a list of region definitions, one +region definition per line. The format of the regions file is described +in detail below. +.le +.ls <image list> +The list of images containing the region definition. The input images +must have a valid FITS world coordinate system in order to be used +for region definition. +.le +.ls pars +If regions is set to the reserved keyword "pars" then a single region +definition is read from the \fIaregpars\fR parameter set. By default a region +ten arc minutes in size centered on coordinates ra = "00:00:00.0" and +dec = "+00:00:00" in the query coordinate system is extracted. +.le +.le +.ls images +The list of output FITS image files. The number of output files must be equal +to the number regions in the regions list times the number of astrometry +catalogs in the catalog list. By default the output images are assigned names of +the form "reg#[.sv#].#.fits" if the region definition source is "pars" or +a file, e.g. "reg002.1.fits", or "image[.sv#].#.fits" if the region +definition source is an image list, e.g. "image.1.fits". The image survey +number is only inserted if there is more than one image survey +in the image survey list. +.le +.ls aregpars = "" +The region definition parameter set. The aregpars parameters define the +extraction region center, region width, region center units, and the region +center coordinate system. The region definition parameters are used if +\fIregions\fR = "pars". +.le +.ls imsurveys = ")_.imsurveys" +The list of input image surveys. By default the image survey name is set to the +value of the package parameter imsurveys. +.le +.ls wcsedit = no +Convert a DSS WCS to a FITS WCS or add an approximate FITS style WCS to the +output image headers if they don't already possess one ? The WCS status +of the survey images plus approximate coordinate, scale, orientation, and +projection information is stored in the image surveys configuration +file \fIimdb\fR. +.le +.ls hdredit = no +Add a set of standard keywords to the image header which may be required or +useful in the later astrometric analysis steps ? These parameters divide +into two groups, those concerned with locating objects in an image and +those required to transform from mean place to observed coordinates. +Default settings for these parameters are stored in the images surveys +configuration file. +.le +.ls update = no +Update the default values of the algorithm parameters, e.g. aregpars +on task termination ? +.le +.ls verbose = yes +Print status messages on the terminal as the task proceeds ? +.le +.ls imdb = ")_.imdb" +The image surveys configuration file. Imdb defaults to the value of the +package parameter imdb. The default image surveys configuration file is +"astcat$lib/imdb.dat". +.le + +.ih +DESCRIPTION + +Agetim extracts fits images from local or remote image surveys +\fIimsurveys\fR using a list of region definitions supplied by the user +\fIregions\fR and writes the results of each image survey query to the output +images \fIoutput\fR. + +A regions definition consists of the coordinates of the field center, +the field size, the units of the field center, and the coordinate system of +the field center. If \fIregions\fR = "pars" these quantities are read +from the \fIaregpars\fR parameters \fIrcra\fR, \fIrcdec\fR, \fIrcrawidth\fR, +\fIrcdecwidth\fR \fIrcraunits\fR, \fIrcdecunits\fR., and \fIrcsystem\fR. +If \fIregions\fR is an input image +list they are read from the FITS world coordinate system in the image header. +If \fIregions\fR is a file name they are read from file whose format is +the following. + +.nf +# Optional comment + +ra1 dec1 xwidth1 ywidth1 [raunits1 [decunits1 [system1]]] +ra2 dec2 xwidth2 ywidth2 [raunits2 [decunits2 [system2]]] +... .... ....... ....... [........ [......... [.......]]] +raN decN xwidthN ywidthN [raunitsN [decunitsN [systemN]]] +.fi + +Quantities in square brackets are optional. If system is undefined the +coordinate system defaults to the query coordinate system, i.e. if the +catalog query expects coordinates in J2000.0 then ra and dec will be +interpreted as though they were in the J2000.0 system. If undefined +the ra and dec units default to the preferred units of the coordinate +system, i.e. hours and degrees for equatorial coordinate systems, +and degrees and degrees for ecliptic, galactic, and supergalactic +coordinate systems. + +A sample regions file is shown below. If the image query system is +J2000.0 then all four regions definitions are equivalent, since J2000.0 +is assumed in examples 1 and 2, is specified in example 3, and example +is same target as example but expressed in the B1950.0 coordinate system. + +.nf +# List of targets + +13:29:53.27 +47:11:48.4 10.0 10.0 +13:29:53.27 +47:11:48.4 10.0 10.0 hours degrees +13:29:53.27 +47:11:48.4 10.0 10.0 hours degrees J2000.0 +13:27:46.90 +47:27:16.0 10.0 10.0 hours degrees B1950.0 +.fi + +For each specified image survey in \fIimsurvey\fR agetim loops through the +regions list, formats the image survey query, makes a local or remote +connection to the image server using the image survey description in the +image survey configuration file \fIimdb\fR, and captures the results. +Image survey names must be of the form imsurvey@site, e.g. dss1@cadc. +Image survey names without entries in the image survey configuration file +are skipped. + +If \fIwcsedit\fR = yes then DSS coordinate systems are converted +into FITS coordinate systems or an approximate FITS WCS is added +to the image using information in the image surveys configuration file. +The quantities of interest are the values, units, and coordinates +system of the reference point \fIwxref\fR, \fIwyref\fR, \fIwraref\fR, +\fIwdecref\fR, \fIwraunits\fR, \fIwdecunits\fR, and \fIwsystem\fR, and the +scale, orientation, and projection information \fIwxmag\fR, \fIwymag\fR, +\fIwxrot\fR, \fIwyrot\fR, and \fIwproj\fR. For more information on how these +quantities are defined in the image surveys configuration file +type "help imsurveys". + +If \fIhdredit\fR = yes then a standard set of keyword equal values +pairs will be added to the image headers using information in the +image surveys configuration file. The parameters divide into two groups +those concerned with locating stars in the image and computing accurate +pixel centers: \fIedatamin\fR, \fIedatamax\fR, \fIegain\fR, and \fIerdnoise\fR, +and those required for transforming mean place coordinates to observed +plate coordinates as may be required to compute very accurate image scales, +\fIobservat\fR, \fIesitelng\fR, \fIesitelat\fR, \fIesitealt\fR, \fIesitetz\fR, +\fIemjdobs\fR, \fIewavlen\fR, \fIetemp\fR, and \fIepress\fR. New keyword +values are only added to the header if keywords of the same name do not +already exist and if appropriate values for the keywords exists, i.e. +"INDEF" valued parameters will not be added to the header. + +If \fIupdate\fR = yes the values of the \fIaregpars\fR parameters will be +updated at task termination. If \fIverbose\fR = yes then detailed status +reports are issued as the task executes. + +.ih +EXAMPLES + +1. Extract data from the default image survey using the default region +definition, display the resulting image, and examine its header. + +.nf +cl> agetim pars default +cl> display reg001.1.fits 1 fi+ +cl> imheader reg001.1.fits lo+ | page +.fi + +2. Repeat the previous example but convert the DSS WCS to a FITS WCS. +The DSS WCS is unaltered. + +.nf +cl> agetim pars default wcsedit+ +cl> display reg001.2.fits 1 fi+ +cl> imheader reg001.2.fits +.fi + + +3. Repeat example 2 but extract data for two surveys. + +.nf +cl> agetim pars default wcsedit+ imsurveys="dss1@cadc,dss2@cadc" +cl> display reg001.3.fits 1 fi+ +cl> imheader reg001.3.fits +cl> display reg002.1.fits 2 fi+ +cl> imheader reg002.1.fits +.fi + +4. Repeat example 2 but add the values of the standard astrometry image +keywords if these do not already exist in the image header and are defined. + +.nf +cl> agetim pars default wcsedit+ hdredit+ +cl> display reg001.4.fits 1 fi+ +cl> imheader reg001.4.fits +.fi + +5. Extract images for a list of regions in a text file. Note that the +coordinate system and coordinate units are not specified in this regions +list and default to those expected by the image survey query. + +.nf +page regions +00:00:00.0 -90:00:00 10.0 10.0 +00:00:00.0 -60:00:00 10.0 10.0 +00:00:00.0 -30:00:00 10.0 10.0 +00:00:00.0 +00:00:00 10.0 10.0 +00:00:00.0 +30:00:00 10.0 10.0 +00:00:00.0 +60:00:00 10.0 10.0 +00:00:00.0 +90:00:00 10.0 10.0 +cl> agetim regions default +.fi + +6. Run agetim on a list of images containing valid FITS WCS information. +Note that in the following example the test image dev$pix does not +have a FITS WCS so no data is extracted for it. + +.nf +cl> page imlist +dev$pix +dev$ypix +cl> agetim @imlist default +.fi + +.ih +TIME REQUIREMENTS +.ih +BUGS +If output file is not a fits file, as may be the case if an error occurred +in the network transfer, and header editing is enabled agetim will +crash with a file seek error. The bug is due to missing error check +statements in the FITS kernel and will be fixed for the next release. +.ih +SEE ALSO +aslist, adumpim, aregpars +.endhelp diff --git a/noao/astcat/doc/ahedit.hlp b/noao/astcat/doc/ahedit.hlp new file mode 100644 index 00000000..fd39c10c --- /dev/null +++ b/noao/astcat/doc/ahedit.hlp @@ -0,0 +1,181 @@ +.help ahedit Mar00 astcat +.ih +NAME +ahedit -- Add wcs and / or standard keywords to the image header +.ih +USAGE +ahedit images imsurveys +.ih +PARAMETERS +.ls images +The list of input images to be edited. +.le +.ls imsurveys +The input image survey that is the source of the input images. If imsurveys +is defined then the wcs status and the wcs and standard keyword parameter names +and values are read from the image survey configuration file \fIimdb\fR. If +imsurveys is undefined these quantities are read from the \fIwcs\fR parameter +and the default \fIawcspars\fR and \fIaimpars\fR parameter sets. +.le +.ls hupdate = yes +Update the image headers ? If hupdate = no the image header edits are +listed but the headers are not updated. +.le +.ls wcsedit = no +Convert a DSS WCS to a FITS WCS or add an approximate FITS style WCS to the +input image headers ? If \fIimsurveys\fR is defined the WCS status of the +survey images plus approximate image center coordinates, scale, orientation, +and projection information are read from the image surveys configuration file +\fIimdb\fR. If \fIimsurveys\fR is undefined these quantities are read +from the \fIwcs\fR parameter and \fIawcspars\fR parameter set. +.le +.ls wcs = "none" +The default wcs status of the input images if \fIimsurveys\fR is undefined. +The options are: +.ls fits +The input image is assumed to have a FITS WCS. No new FITS WCS is written. +.le +.ls dss +The input image is assumed to have a DSS WCS. The equivalent FITS WCS +is added, but the DSS WCS is left unchanged. +.le +.ls none +The input image is assumed to have no WCS. The parameters in \fIawcspars\fR +are used to create an approximate FITS WCS. +.le +.le +.ls awcspars = "" +The default WCS parameter set. If \fIwcsedit\fR = yes and \fIimsurveys\fR +is undefined then the awcspars parameters are used to create an approximate +FITS WCS. For more information about the awcspars parameters type +"help awcspars". +.le +.ls hdredit = no +Add a set of standard keywords to the image header which may be required or +useful in the later astrometric analysis steps ? These parameters divide +into two groups, those concerned with locating objects in an image and +those required to transform from mean place to observed coordinates. +If \fIimsurveys\fR is undefined the standard keyword names and values +are read from the images surveys configuration file \fIimdb\fR. If +\fIimsurveys\fR is defined they are read from the \fIaimpars\fR parameter set. +.le +.ls aimpars = "" +The default standard image header keywords parameter set. If \fIhdredit\fR = +yes and \fIimsurveys\fR is undefined the parameter names and values +in \fIaimpars\fR are used to write the standard image header keywords. For more +information about these parameters type "help aimpars". +.le +.ls update = no +Update the default values of the algorithm parameter sets, e.g. aregpars, +\fIawcspars\fR, and \fIaimpars\fR on task termination ? +.le +.ls verbose = yes +Print status messages on the terminal as the task proceeds ? +.le +.ls imdb = ")_.imdb) +The image surveys configuration file. Imdb defaults to the value of the +package parameter imdb. The default image surveys configuration file is +"astcat$lib/imdb.dat". +.le + +.ih +DESCRIPTION + +Ahedit adds an approximate FITS WCS and / or a standard set of keyword value +pair to the list of images \fIimages\fR extracted from the image survey +\fIimsurveys\fR. If hupdate = no the image edits are listed but not +implemented. + +If \fIwcsedit\fR = yes then either an existing DSS WCS is converted to +a FITS WCS or an approximate FITS WCS is added to the input image. If +\fIimsurveys\fR is undefined the current WCS status and WCS information +is read from the image surveys configuration file \fIimdb\fR. If +\fIimsurveys\fR is undefined the WCS status and coordinate information +are read from \fIwcs\fR parameter and the default WCS parameter set +\fIawcspars\fR. In both cases the quantities of interest are the values, +units, and coordinates system of the reference point \fIwxref\fR, \fIwyref\fR, +\fIwraref\fR, \fIwdecref\fR, \fIwraunits\fR, \fIwdecunits\fR, and +\fIwsystem\fR, and the image scale, orientation, and projection information +\fIwxmag\fR, \fIwymag\fR, \fIwxrot\fR, \fIwyrot\fR, and \fIwproj\fR. For +more information on how these quantities are defined in the image surveys +configuration file or the awcspars parameter set type "help imsurveys" and / or +"help awcspars". + +If \fIhdredit\fR = yes then a standard set of keyword equal value +pairs are added to the image headers. If \fIimsurveys\fR is defined +the standard keyword name and value pairs are read from the image surveys +configuration file. If \fIimsurveys\fR is undefined they are read from +the standard image keywords parameter set \fIaimpars\fR. In both cases the +parameters divide into two groups, +those concerned with locating stars in the image and computing accurate +pixel centers \fIedatamin\fR, \fIedatamax\fR, \fIegain\fR, and \fIerdnoise\fR, +and those required for transforming mean place coordinates to observed +plate coordinates, +\fIobservat\fR, \fIesitelng\fR, \fIesitelat\fR, \fIesitealt\fR, \fIesitetz\fR, +\fIemjdobs\fR, \fIewavlen\fR, \fIetemp\fR, and \fIepress\fR. New keyword +values are only added to the header if keywords of the same name do not +already exist, and if appropriate values for the keywords exists, i.e. +"INDEF" valued parameters will not be added to the header. + +If \fIupdate\fR = yes then the fIawcspars\fR, +and \fIaimpars\fR parameter sets are updated at task termination. If +\fIverbose\fR = yes then detailed status reports are issued as the task +executes. + +.ih +EXAMPLES + +1. List the header edits required to create a FITS WCS from a DSS WCS +for a set of images extracted from the dss1@cadc. + +.nf +cl> ahedit @imlist dss1@cadc hupdate- wcsedit+ hdredit- +.fi + +2. Repeat the previous example but actually do the edits. + +.nf +cl> ahedit @imlist dss2@cadc hupdate+ wcsedit+ hdredit- +.fi + +3. Repeat the previous example but get the current WCS stats from the user +rather than from the image survey configuration file. + +.nf +cl> ahedit @imlist "" hupdate+ wcsedit+ wcs=dss hdredit- +.fi + +4. Add an approximate FITS WCS to an image for which the coordinates +of the image center in hours and degrees are stored in the keywords +RA and DEC, the epoch of the image center coordinates is stored in EQUINOX, +the image scale is 0.261" per pixel and east is left and north is down. + +.nf +cl> ahedit image "" wcsedit+ wcs="none" wraref="RA" wdecref="DEC" \ +wxmag=0.26 wymag=0.26 wxrot=270 wyrot=90 wsystem="EQUINOX" hdredit- + +.fi + +5. Add the standard keyword name and values pairs for a list +of images extracted from the dss1@cadc. + +.nf +cl> ahedit @imlist dss1@cadc hupdate+ wcsedit- hdredit+ +.fi + +6. Store the CCD saturation limit in the image header in the EDATAMAX +keyword. Set the minimum good data limit at the same time. + +.nf +cl> ahedit image "" hupdate+ wcsedit- hdredit+ edatamin=-100.0 \ +edatamax=32000 +.fi + +.ih +TIME REQUIREMENTS +.ih +BUGS +.ih +SEE ALSO +aslist, adumpim, aregpars, awcspars, aimpars +.endhelp diff --git a/noao/astcat/doc/aimfind.hlp b/noao/astcat/doc/aimfind.hlp new file mode 100644 index 00000000..04d1a46e --- /dev/null +++ b/noao/astcat/doc/aimfind.hlp @@ -0,0 +1,148 @@ +.help aimfind Mar00 astcat +.ih +NAME +aimfind -- Select images containing catalog data and predict pixel coordinates +for the catalog objects +.ih +USAGE +aimfind images output imfile +.ih +PARAMETERS +.ls images +The input image list. The input images must contain a valid fits world +coordinate system which is used to determine the catalog extraction region. +.le +.ls output +The list of output astrometry file names. The number of output file names +must be equal to the number of input images. Output files are only created +if at least one catalog object is in the image. By default the output files +are assigned names of the form "image.cat.#", e.g. "image.cat.1". +.le +.ls imfile +The list of images containing catalog data. +.le +.ls catalogs = ")_.catalogs" +The input astrometry catalog. By default the catalog name is set to the +value of the package parameter catalogs. +.le +.ls standard = yes +Output a standard astrometry file ? If standard = yes then a header describing +the format of the astrometry file is written to the output file. The +astcat package +tasks use this information to decode the file. If standard = no, no +header is written and the user must instruct the astcat tasks how to decode the +file. +.le +.ls filter = no +Filter the results of the catalog query before writing the final results +to the output astrometry file ? +.le +.ls afiltpars = "" +The astrometry file filtering parameter set. These parameters permit the user +to sort the output on a field or field expression, select or reject +catalog records using a boolean expression, select or reject fields +to output, add new fields that are expressions of existing fields to +the output, and perform simple coordinate transformations. +.le +.ls append = no +By default the predicted pixel coordinates are prepended to each selected +output file record. If append = yes they are appended to each selected +record instead. +.le +.ls update = no +Update the default values of the algorithm parameters, e.g. aregpars and +afiltpars, at task termination ? +.le +.ls verbose = yes +Print status messages on the terminal as the task proceeds ? +.le +.ls catdb = ")_.catdb" +The catalog configuration file. Catdb defaults to the value of the +package parameter catdb. The default catalog configuration file is +"astcat$lib/catdb.dat". +.le + +.ih +DESCRIPTION + +Aimfind selects those images from the input image list \fIimages\fR +which contain one or more catalog \fIcatalogs\fR objects and writes +the resulting catalog records along with predicted pixel coordinates to +\fIoutput\fR and the selected image name to \fIimfile\fR. The input images +must contain a valid FITs wcs. + +For each input image aimfind determines the region of the sky covered +by the image, formats the appropriate catalog query, makes a local or remote +connection to the catalog server using the catalog description in the +catalog configuration file \fIcatdb\fR, and captures the results. +Catalog names must be of the form catalog@site, e.g. lan92@noao. + +If \fIfilter\fR = yes, the captured results are filtered using the +values of the parameters in the filtering parameter set \fIafiltpars\fR. +The afilterpars parameters permit the user to sort the query results by setting +the sort field parameter \fIfsort\fR, select or reject +catalog records by setting the selection expression parameter \fIfexpr\fR, +select or reject fields for output by setting the output field +list parameter \fIfields\fR, and change the coordinate system, units, +and format of the catalog coordinates by setting the \fIfosystem\fR, +\fIforaunits\fR, \fIfodecunits\fR, \fIforaformat\fR, and \fIfodecformat\fR +parameters. At present the names, data types, units, and format of the +predicted pixel coordinates computed by aimfind are fixed at "xp,yp", +"d,d", "pixels,pixels", and "%10.3f,%10.3f" respectively. A more detailed +description of the region filtering parameters can be obtained by typing +"help afiltpars". + +If \fIstandard\fR = yes a header is written to the output astrometry file which +defines the contents and format of the output object list. The astcat +tasks use this header to decode the input catalog files. If it is +missing or has been modified by non-astcat tasks the user must use +the \fIacatpars\fR parameters to define the astrometry file format. Most +non-astcat tasks will interpret the astrometry file header as documentation +and skip it. + +If \fIappend\fR = no then the values of the predicted pixel coordinates +are prepended to each selected catalog record. If append = tes they +are appended instead. + +If \fIupdate\fR = yes the values of the \fIaregpars\fR and \fIafilterpars\fR +parameters will be updated at task termination. If \fIverbose\fR = yes +then detailed status reports are issued as the task executes. + +.ih +EXAMPLES + +1. Determine which images in the input image list contain Landolt standards. + +.nf +cl> aimfind *.imh "" imlist catalogs=lan92@noao +cl> page imlist +.fi + +2. Repeat the previous example but write an output astrometry file for +each selected image. + +.nf +cl> aimfind *.imh default imlist catalogs=lan92@noao +.fi + +3. Repeat example 2 but sort the output on a field called v. + +.nf +cl> aimfind *.imh default filter+ fsort="v" +.fi + +4. Repeat example 2 but transform the catalog coordinates to the B1950 +system. + +.nf +cl> aimfind *.imh default filter+ fosystem="B1950" +.fi + +.ih +TIME REQUIREMENTS +.ih +BUGS +.ih +SEE ALSO +aclist, adumpcat, agetcat, afiltpars +.endhelp diff --git a/noao/astcat/doc/aimpars.hlp b/noao/astcat/doc/aimpars.hlp new file mode 100644 index 00000000..d699e05a --- /dev/null +++ b/noao/astcat/doc/aimpars.hlp @@ -0,0 +1,141 @@ +.help aimpars Mar00 astcat +.ih +NAME +aimpars -- Edit the standard image header keyword set +.ih +USAGE +aimpars +.ih +PARAMETERS +.ls observat = "OBSERVAT" +The image header keyword defining the observatory at which the data +was taken or the name of the observatory. If the observatory is defined then +the keyword "OBSERVAT" is written to the image header if it does not +already exist. +.le +.ls esitelng = "INDEF", esitelat = "INDEF" +The image header keywords defining the longitude and latitude of the +observatory in degrees or the longitude and latitude values in degrees. +If the longitude and latitude are defined the keywords "ESITELNG" and +"ESITELAT" are written to the image header if they do not already exist. +.le +.ls esitealt = "INDEF" +The image header keyword defining the altitude of the observatory in meters +or the altitude itself in meters. If the altitude is defined the keyword +"ESITEALT" is written to the image header if it does not already exist. +.le +.ls esitetz = "INDEF" +The image header keyword defining the timezone of the observatory +in hours from the Greenwich meridian or the timezone value +in hours from the Greenwich meridian. Positive values correspond to time +zones west of the meridian. If the time zone is defined the keyword +"ESITETZ" is written to the image header if it does not already exist. +.le +.ls emjdobs = "MJD-OBS" +The image header keyword defining the effective MJD of the observation +or the MJD. MJD-OBS normally defines the time of the beginning +of the observation. Users may wish to change this value to represent +the MJD at mid-exposure. If the effective MJD is defined the keyword +"EMJDOBS" is written to the image header if it does not already exist. +.le +.ls edatamin = "INDEF", edatamax = "INDEF" +The image header keywords defining the minimum and maximum good data +limits in ADU or the minimum and maximum good data values in ADU. +If these limits are defined the keywords "EDATAMIN" and "EDATAMAX" +are written to the image header if they do not already exist. +.le +.ls egain = "GAIN", erdnoise = "RDNOISE" +The image header keywords defining the effective gain in electrons per ADU +and readout noise in electrons or the gain and readout noise values in +electrons per ADU and electrons. If the gain and readout noise are defined +the keywords "EGAIN" and "ERDNOISE" are written to the image header if they do +not already exist. +.le +.ls ewavlen = "INDEF" +The image header keyword defining the effective wavelength in microns or +the effective wavelength value in microns. If the effective wavelength is +defined the keyword "EWAVLEN" is written to the image header if it does +not already exist. +.le +.ls etemp = "INDEF" +The image header keyword defining the effective temperature in degrees +or the effective temperature values in degrees. If the effective wavelength +is defined the keyword "ETEMP" is written to the image header it does +not already exist. +.le +.ls epress = "INDEF" +The image header keyword defining the effective pressure in millibars or +the effective pressure values in millibars. If the effective pressure is +defined the keyword "EPRESS" is written to the image header if it does +not already exist. +.le + +.ih +DESCRIPTION + +The standard image parameter set is used to encode quantities in the image +headers that may be required by the astrometric analysis tasks. The current +parameter set divides into two parameter groups: parameters +concerned with locating stars in an image and computing accurate pixel +coordinates and instrumental magnitudes \fIedatamin\fR, \fIedatamax\fR, +\fIegain\fR, and \fIerdnoise\fR, and parameters required to transform +from mean to observed place \fIobservat\fR, \fIesiteng\fR, +\fIesitelat\fR, \fIesitealt\fR, \fIesitetz\fR, \fIewavlen\fR, +\fIetem\fR, \fIepress\fR. The latter group of parameter is required for +astrometric analyses carried out in observed place rather than +mean place. + +If the quantity defined by the aimpars parameter is defined, i.e. the +parameter value is an image header keyword which defines a valid value, +or the parameter value is itself a valid value, then a keyword +with the same name as the parameter name is inserted into the image +header, if one with that name does not already exist. + +.ih +EXAMPLES + +1. List the default image header parameters. + +.nf +cl> lpar aimpars +.fi + +2. Edit the default image header parameters. + +.nf +cl> aimpars +... edit the parameters in the usual way +... type :wq to quit and save the edits +.fi + +3. Edit the default image header parameters from the agetim task. + +.nf +cl> epar agetim +... edit the agetim parameters +... move to the agetim parameter line and type :e +... edit the aimpars parameters +... type :wq to quit and save the aimpars edits +... continue editing the remaining aimpars parameters +... type :go to execute the task +.fi + +4. Save the current awcspars parameter values in a text file called +aimhdr1.par. Use the saved parameter set in the next call to the agetim +task. + +.nf +cl> epar aimpars +... edit some parameters in the usual way +... type :w aimhdr1.par +... type :q to quit +cl> agetim ... aimpars=aimhdr1.par ... + +.ih +TIME REQUIREMENTS +.ih +BUGS +.ih +SEE ALSO +agetim +.endhelp diff --git a/noao/astcat/doc/aregpars.hlp b/noao/astcat/doc/aregpars.hlp new file mode 100644 index 00000000..68f56aff --- /dev/null +++ b/noao/astcat/doc/aregpars.hlp @@ -0,0 +1,106 @@ +.help aregpars Mar00 astcat +.ih +NAME +aregpars -- edit the region extraction parameters +.ih +USAGE +aregpars +.ih +PARAMETERS +.ls rcra = "00:00:00.0" +The right ascension / longitude of the center of the region to be extracted. +.le +.ls rcdec = "+00:00.00" +The declination / latitude of the center of the region to be extracted. +.le +.ls rrawidth = 10.0 +The right ascension / longitude width in minutes of arc of the region to +be extracted. +.le +.ls rdecwidth = 10.0 +The declination / latitude width in minutes of arc of the region to +be extracted. +.le +.ls rcsystem = "" +The input celestial coordinate system. This is the celestial coordinate system +of the region center. If the input celestial coordinate system is undefined it +defaults to the query celestial coordinate system. Popular options are +"icrs", "j2000.0", and "b1950.0". The full set of options can be examined +by typing "help ccsystems". +.le +.ls rcraunits = "" +The units of rcra. Permitted values are "hours", "degrees", and radians. If +rcraunits is undefined it defaults to the preferred units of the +input celestial coordinate system, e.g. hours for equatorial coordinate +system, degrees for ecliptic, galactic, and super-galactic coordinate +systems. +.le +.ls rcdecunits = "" +The units of rcdec. Permitted values are "degrees" and "radians". If rcdecunits +is undefined it defaults to the preferred units of the input celestial +coordinate system, e.g. degrees for all systems. +.le +.ih +DESCRIPTION +The region to extracted from the selected astrometric catalog or image survey +is defined by the aregpars parameters \fIrcra\fR, \fIrcdec\fR, \fIrcrawidth\fR, +and \fIrcdecwidth\fR. + +\fIrcra\fR and \fIrcdec\fR are defined in the input celestial coordinate system +specified by \fIrcsystem\fR. If \fIrcsystem\fR is undefined it defaults to the +query celestial coordinate system defined by the qsystem query parameter in +the catalog configuration file. + +\fIrcra\fR and \fIrcdec\fR are expressed in the units specified by +\fIrcraunits\fR, and \fIrcdecunits\fR. If undefined \fIrcraunits\fR and +\fIrcdecunits\fR are expressed in the preferred units of the input +celestial coordinate system, e.g. hours and degrees for equatorial coordinate +systems, and degrees and degrees for ecliptic, galactic, +and super-galactic coordinate systems. +.ih +EXAMPLES +1. List the region extraction parameters. + +.nf +cl> lpar aregpars +.fi + +2. Edit the region extraction parameters. + +.nf +cl> aregpars +... edit the parameters in the usual way +... type :wq to quit and save the edits +.fi + +3. Edit the region extraction parameters from the agetcat task. + +.nf +cl> epar agetcat +... edit the agetcat parameters +... move to the aregpars parameter line and type :e +... edit the aregpar parameters +... type :wq to quit and save the aregpars edits +... continue editing the remaining agetcat parameters +... type :go to execute the task +.fi + +4. Save the current aregpars parameter values in a text file called +areg1.par. Use the saved parameter set in the next call to the agetcat +task. + +.nf +cl> epar aregpars +... edit some parameters in the usual way +... type :w areg1.par +... type :q to quit +cl> agetcat ... aregpars=areg1.par ... +.fi +.ih +TIME REQUIREMENTS +.ih +BUGS +.ih +SEE ALSO +agetcat, agetim, help ccsystems +.endhelp diff --git a/noao/astcat/doc/aslist.hlp b/noao/astcat/doc/aslist.hlp new file mode 100644 index 00000000..6dea51aa --- /dev/null +++ b/noao/astcat/doc/aslist.hlp @@ -0,0 +1,60 @@ +.help aslist Feb00 astcat +.ih +NAME +aslist -- list the supported image surveys +.ih +USAGE +aslist catalogs +.ih +PARAMETERS +.ls imsurveys +The names of the image surveys to be listed. If surveys = "*" then +all the image surveys in the image survey configuration file are listed. +.le +.ls verbose = no +List the image survey wcs and keyword information after the image survey +name ? +.le +.ls imdb = ")_.imdb" +The image survey configuration file. The value of imdb defaults to the value +of the package parameter of the same name. The default image survey +configuration file is "astcat$lib/imdb.dat". +.le +.ih +DESCRIPTION +Aslist lists the supported image surveys specified by the +\fIimsurveys\fR parameter. If imsurveys = "*" then all the supported image +surveys are listed, otherwise only the image survey names specified by the +user are listed. Valid image survey names have the form imsurvey@site, e.g. +"dss1@cadc". If \fIverbose\fR = "yes", then the image survey wcs and +keyword information is listed after the image survey name. + +The image survey names, addresses, query formats, output formats, wcs formats, +and keyword formats, are specified in the image survey configuration file +\fIimdb\fR. By default the image survey configuration file names defaults to +the value of the imdb package parameters. The default image survey +configuration file is "astcat$lib/imdb.dat". Users can add records +to this file or create their own configuration file. +.ih +EXAMPLES + +1. List all the image surveys in the image survey configuration file. + +.nf +cl> aslist * +.fi + +2. List the wcs and keyword information for the dss1@cadc image survey. + +.nf +cl> aslist dss1@cadc verbose+ +.fi + +.ih +TIME REQUIREMENTS +.ih +BUGS +.ih +SEE ALSO +aclist +.endhelp diff --git a/noao/astcat/doc/awcspars.hlp b/noao/astcat/doc/awcspars.hlp new file mode 100644 index 00000000..c6273d2c --- /dev/null +++ b/noao/astcat/doc/awcspars.hlp @@ -0,0 +1,113 @@ +.help awcspars Mar00 astcat +.ih +NAME +awcspars -- edit the default world coordinate system parameters +.ih +USAGE +awcspars +.ih +PARAMETERS +.ls wxref = "INDEF", wyref = "INDEF" +The image header keyword names or the numerical values of the x and y reference +point in pixels. If wxref = "INDEF" and wyref = "INDEF" the reference +point defaults to the center of the image. +.le +.ls wxmag = "INDEF", wymag = "INDEF" +The image header keyword names or the numerical values of the x and y scale +factors in arcseconds per pixel. If wxmag or wymag = are undefined a new +wcs cannot be created. +.le +.ls wxrot = "180.0", wyrot = "0.0" +The image header keyword names or the numerical values of the x and y rotation +angles in degrees measured counter-clockwise to the positive x and y image +axes. The default orientation is east=left, north=up. Wxrot values of 0.0, +90.0, 180.0, and 270.0 correspond to east=right, up, left, and down +respectively. Wyrot values of 0.0, 90.0, 180.0, and 270.0 correspond to +north=up, left, down, and right respectively. +.le +.ls wraref = "RA", wdecref = "DEC" +The image header keyword names or the numerical values of the reference +point in celestial coordinates. If wraref and wdecref are undefined +a new wcs cannot be created. +.le +.ls wraunits = "", wdecunits = "" +The units of the reference point celestial coordinates. The options are +"hours", "degrees", and "radians" for the ra coordinate and "degrees" +and "radians" for the dec coordinate. If wraunits and wdecunits are undefined +they default to the preferred units of the reference system. +.le +.ls wproj = "tan" +The sky projection geometry. The most commonly used projections are "tan", +"arc", "sin", and "lin". Other supported projections are "ait","car", "csc", +"gls", "mer", "mol", "par", "pco", "qsc", "stg", "tsc", and "zea". +.le +.ls wsystem = "EQUINOX" +The image header keyword name or string defining the celestial coordinate +system of the reference point. The most common values for wsystem are +"2000.0", "1950.0", "J2000.0", and "B1950.0". Type "help ccssytems" to get +a full list of options. +.le +.ih +DESCRIPTION +The default wcs parameters are used to create an approximate FITS wcs for +an images which do not have one. Creating an approximate header +from the telescope pointing position and the known scale and orientation +of the detector can make later steps like locating the catalog stars +for computing an accurate plate solution simpler. + +In coordinates of the reference point in pixels and celestial coordinates +\fIwxref\fR, \fIwyref\fR, \fIwraref\fR, \fIwdecref\fR, the scale factors +\fIwxmag\fR and \fIwymag\fR, and the orientation \fIwxrot\fR and \fIwyrot\fR +can be read from the image header or set by value. The coordinate system +and units of the celestial coordinates of the reference point \fIwsystem\fR +and \fIwraunits\fR and \fIwdecunits\fR must be set explicitly. The image +projection function \fIwproj\fR must also be set separately. + +.ih +EXAMPLES +1. List the default wcs parameters. + +.nf +cl> lpar awcspars +.fi + +2. Edit the default wcs parameters. + +.nf +cl> awcspars +... edit the parameters in the usual way +... type :wq to quit and save the edits +.fi + +3. Edit the default wcs parameters from the agetim task. + +.nf +cl> epar agetim +... edit the agetim parameters +... move to the agetim parameter line and type :e +... edit the awcspars parameters +... type :wq to quit and save the awcspars edits +... continue editing the remaining awcspars parameters +... type :go to execute the task +.fi + +4. Save the current awcspars parameter values in a text file called +awcs1.par. Use the saved parameter set in the next call to the agetim +task. + +.nf +cl> epar awcspars +... edit some parameters in the usual way +... type :w awcs1.par +... type :q to quit +cl> agetim ... awcspars=awcs1.par ... +.fi + +.ih +TIME REQUIREMENTS +.ih +BUGS +.ih +SEE ALSO +agetim, ahedit +.endhelp diff --git a/noao/astcat/doc/catalogs.hlp b/noao/astcat/doc/catalogs.hlp new file mode 100644 index 00000000..6852d102 --- /dev/null +++ b/noao/astcat/doc/catalogs.hlp @@ -0,0 +1,295 @@ +.help catalogs Mar00 astcat +.ih +NAME +catalogs -- describe the catalog configuration file +.ih +USAGE +help catalogs +.ih +ASTROMETRIC CATALOGS + +An astrometric catalog is a remote or local catalog containing accurate +positional data for a large region of the sky, from which accurate positional +data for a small region of the sky may be extracted by specifying an extraction +region. + +Astrometric catalogs may be installed locally or accessed remotely. Each +supported catalog must have a record in the catalog configuration file +specifying the catalog network address, the catalog query format, +and the query output format. The default configuration file is +"astcat$lib/catdb.dat". A list of the supported catalogs can be obtained +by running the aclist task. + +.ih +THE CATALOG CONFIGURATION FILE + +The catalog configuration file specifies the network address, the query +format, and the output format for each supported catalog server. Each catalog +server record is accessed via a record name of the form catalog@site, +e.g. "usno2@noao". Adding support for a new catalog server requires adding +a new record to the configuration file. Responding to changes in the behavior +of a supported catalog server requires editing the existing record. In +either case no modification of the compiled code should be required. + +The server network address tells the catalog access code where and how to +connect to the network. Each network address has the syntax +domain:port:address:flags e.g. "inet:80:www.noao.edu:text". + +The query format specifies the form of the query server command, and the +names, default values, units, and formats of the query parameters. A set of +query parameter names are reserved for accessing astrometric catalogs +including "ra", "dec", "radius", "hwidth", "width", "xwidth", and "ywidth". The +astcat package recognizes the reserved query parameter names, +replaces the default query parameter values with the user supplied ones, +and sends the query to the catalog server. "ra" and "dec" always refer +to the center of the region to be extracted. The size parameter is +always input by the user as a width in ra and dec in arcminutes. This quantity +is translated into a radius like parameter or a width like parameter +depending on whether the query parameter is defined as "radius", "hwidth", +"width", "xwidth", "ywidth", "xhwidth", "yhwidth", "rawidth", "decwidth", +"rahwidth", "dechwidth", etc. Most catalogs use "radius", "hwidth", or +"width" in their queries. + +The server output format specifies the form of the expected server output: +the data stream type, the record size, and the name, location, +size, data type, units and format of each field in a record. A set of +standard field names is reserved for accessing the output of astrometric +catalog servers including "id", "ra", "dec", and "mag[1-n]". The astcat +package tasks recognize the reserved field names and use the query output +description to decode the catalog records. + +.ih +SAMPLE CATALOG RECORD + +The following two examples illustrate the main features of the catalog +configuration file record. Both records describe the same catalog server +but define the output query format in different ways. + +.nf +begin susno2@noao +address inet:80:www.noao.edu:text +query GET /cgi-bin/usno/usnoextract?search=yes&ra=%-s&dec=%-s&width=%-s HTTP/1.0 +\n\n +nquery 4 + ra 00:00:00.00 hours %0.2h + dec 00:00:00.0 degrees %0.1h + radius 5.0 minutes %0.1f + qsystem J2000.0 INDEF %s +type stext + hskip 10 + tskip 6 + recsize 0 + triml 0 + trimr 4 +nheader 1 + csystem J2000.0 +nfields 4 + ra 1 0 d hours %12.3h + dec 2 0 d degrees %12.2h + mag1 3 0 r INDEF %4.1f + mag2 4 0 r INDEF %4.1f +.fi + +.nf +begin busno2@noao +address inet:80:www.noao.edu:text +query GET /cgi-bin/usno/usnoextract?search=yes&ra=%-s&dec=%-s&width=%-s HTTP/1.0 +\n\n +nquery 4 + ra 00:00:00.00 hours %0.2h + dec 00:00:00.0 degrees %0.1h + radius 5.0 minutes %0.1f + qsystem J2000.0 INDEF %s +type btext + hskip 10 + tskip 6 + recsize 44 + triml 0 + trimr 4 +nheader 1 + csystem J2000.0 +nfields 4 + ra 1 13 d hours %12.3h + dec 14 14 d degrees %12.2h + mag1 28 6 r INDEF %4.1f + mag2 34 6 r INDEF %4.1f +.fi + +The beginning of a new catalog record is marked by a line which looks like +"begin catname" where catname is a unique name of the form catalog@site. +More than one name can access the same catalog server. Multiple entries for +the same catalog are used to define a different query format or to interpret +the query output in different ways. For example if the catalog server supports +output record selection by magnitude then the query can be defined to make use +this feature. In other cases it can be advantageous to interpret the server +output as blocked text rather than simple text. + +The \fIaddress\fR, \fIquery\fR and \fInquery\fR keywords are required and +define the network address, query command format and query parameters for +the catalog server. + +The \fIaddress\fR keyword "domain", "port", and "flags" fields are almost +always "inet", "80", and "text" respectively. The remaining field +is the address field "www.noao.edu" in this case. + +The \fIquery\fR keyword defines the query command. The form of the query command +is server dependent. Note the %-s formatting strings in the above examples. +These strings are replaced by the query parameter values supplied +by the user or by the default query parameter values. + +The number of query parameters is defined by the \fInquery\fR parameter. The +number of query parameters must be greater than or equal to the number of "-%s" +strings in the query keyword value. The name, default value, units, +and format of each query parameter is listed below the nquery keyword and value, +one query parameter description per line. Alert users will notice that in the +above examples the number of query parameters is 4, but there are only 3 "%-s" +strings in the query keyword value. In these examples the qsystem query +parameter, which defines the coordinate system of the ra and dec query +parameters, is fixed at J2000. For some servers qsystem may be a true query +parameter, i.e. the server may accept coordinates in B1950 or J2000 +or some other system. + +Users must use the standard query parameter names "ra", "dec", and "qsystem" +to define the extraction region center and its coordinate system, and one or +more of "radius", "hwidth", "xhwidth", "yhwidth", "width", "xwidth", and +"ywidth" to define the extraction +region size. Currently the units of "ra" may be "hours", "degrees", or +"radians", the units of dec may be "degrees" or "radians", and units of the +size query parameter may be "degrees" or "arcmin". +The qsystem parameter may be any one of the supported celestial coordinate +systems. The most popular values are "icrs", "J2000", and "B1950". +For more information on coordinate systems type "help ccsystems". The +query parameter formats are used to convert +the numerical values supplied by the user to string arguments that +can be passed to the query command. + +The \fItype\fR keyword defines the query output type. The current options +are "stext" for simple text and "btext" for blocked text. Simple text +contains newline delimited records and whitespace delimited fields. +Blocked text contains newline delimited records and fixed position and size +fields. If the type keyword is missing "stext" is assumed. + +The \fIrecsize\fR keyword is the maximum length of the record in characters +including the newline character. Records greater in length than recsize are +skipped. If undefined the recsize keyword defaults to 0 meaning the record +size may not be fixed. + +The \fIhskip\fR, \fItskip\fR, \fIltrim\fR, and \fItrim\fR keywords define +the number of header and trailer records in the server output to skip, and +the number of header and trailer characters in each record to skip. The +latter 2 keywords can be used to trim (actually replace with blanks) leading +and trailing characters in each record. If absent all 4 keywords default to +zero. + +The \fInheader\fR keyword defines the number of header keywords. Header +keywords are global keywords which apply to all the output records. +There may be any number of header keywords or none. The header keyword +and value pairs are copied to the headers of the astrometry files created +by astcat. For most astrometry catalog the only header parameter is +\fIcsystem\fR which specifies the coordinate system of the query output +coordinates. + +The \fInfields\fR keyword specifies the number of fields in each output record. +The name, offset, size, datatype, units, and format of each field follow +the nfields keyword and value pair, +one field description per line. For simple text files the offset is the field +or column number and the field size is 0. For blocked text files the +offset is the 1-indexed position of the first character in the field and +size is the field size in characters. Using a blocked text description can +be useful for dealing with fields containing embedded blanks. + +Users should use the reserved standard fields names "id", "ra", "dec", "mag#" +etc to define the standard field names. The current list of standard field +names is \fIid\fR, \fIra\fR, \fIdec\fR, \fIera\fR, \fIedec\fR, \fIpmra\fR, +\fIpmdec\fR, \fIepmra\fR, \fIepmdec\fR, \fIcatsystem\fR, \fIequinox\fR, +\fIepoch\fR, \fIpx\fR, \fIrv\fR, \fIepx\fR, \fIerv\fR, \fImag\fR, \fIcolor\fR, +\fIemag\fR, \fIecolor\fR, \fIxp\fR, \fIyp\fR, \fIxc\fR, \fIyc\fR, \fIexc\fR, +\fIeyc\fR, \fIimag\fR, and \fIeimag\fR. + +.ih +INSTALLING A NEW CATALOG RECORD + +Some users may wish to install a local version of a standard catalog, +or add support for a new catalog server. The procedure for doing this +is outlined below. + +To install a new catalog record. + +.ls [1] +Create a new configuration file by making a copy of the existing one. +.le + +.ls [2] +Determine a unique name for the catalog server. This name should be short and +have the form catalog@site, e.g. "usno2@noao". Existing names can be +reviewed with the aclist task. +.le + +.ls [3] +Determine the appropriate values for the address, query, and nquery +keywords and enter these quantities in the catalog record. Determine the name, +default value, units and format for each query parameter and enter these +quantities in the catalog record in the order they are requested by +the query parameter string. Make sure that all the query keyword value +parameter format strings are -%s, that the value of the nquery keyword +is greater than or equal to the number of %-s strings in the query keyword +value, and that standard query parameter names are used where possible. +.le + +.ls [4] +Determine the query output type. If the query output type is unknown set +type to "stext". Leave the recsize, hskip, tskip, ltrim, and rtrim parameters +undefined. +.le + +.ls [5] +Set the nheader keyword value to 1 and determine the appropriate value for +the csystem header keyword. +.le + +.ls [6] +Set the nfields keyword to 0. +.le + +.ls [7] +Run the adumpcat task. Adumpcat tests the address and query parts of the +catalog record but dumps the query results directly to a text file without +modification. If adumpcat fails either the network connection is bad +or the address and / or query format is incorrect. +.le + +.ls [8] +Examine the adumpcat results. Determine whether the output is simple text +or blocked text. Simple text is usually the best choice. However if the +record fields contain embedded blanks it may be necessary to set type +to blocked text. Are there fixed numbers of leading and trailing junk records ? +If so set hskip and tskip appropriately. Are there fixed numbers of leading and +trailing junk record characters ? If so set ltrim and rtrim +appropriately. If the record size in characters fixed or does it +have a maximum size ? If so set recsize appropriately but remember to +include the newline character in the record size. +.le + +.ls [9] +Use the adumpcat task results to determine the value of the nfields parameter +and the required field descriptions. +Determine the name, position, size, data type, units, and format for +each field in the output records. Use the standard field names +and the standard field data types if possible. It is +a good idea to set the data type of coordinate fields to double. Check that +the units of the coordinate fields are correct as these are used to do +coordinate conversions. +.le + +.ls [10] +Run the agetcat task using the new catalog record and catalog configuration +file. Examine the header of the output astrometry file to make sure +the header and field descriptions have been transferred correctly. Apply a +few filtering options, i.e. sort on a field, or select a subset of fields for +output, to test the correctness of the field descriptions. +.le + +.ih +SEE ALSO +aclist, files +.endhelp diff --git a/noao/astcat/doc/ccsystems.hlp b/noao/astcat/doc/ccsystems.hlp new file mode 100644 index 00000000..4e67c568 --- /dev/null +++ b/noao/astcat/doc/ccsystems.hlp @@ -0,0 +1,210 @@ +.help ccsystems Mar00 astcat +.ih +NAME +ccsystems -- list and describe the supported coordinate systems +.ih +USAGE +help ccsystems +.ih +CATALOG ACCESS COORDINATE SYSTEMS + +Astcat supports several catalog access coordinate systems and manages all the +required transformation between them based on input from the user and +information in the catalog configuration file. + +.ls The Input Coordinate System +The input coordinate system specifies the coordinate system +of the region center coordinates used to extract data from a +catalog. The input coordinate +system is normally defined by the user. If undefined, the input coordinate +system defaults to the query coordinate system. +.le +.ls The Query Coordinate System +The query coordinate system specifies the coordinate system of the coordinates +used to formulate a catalog query. The query coordinate +system is normally defined in the catalog configuration file. +If undefined the query coordinate system defaults to the catalog +coordinate system. Coordinates in the input coordinate system +must be transformed to the query coordinate system in order to formulate +a correct query. +.le +.ls The Catalog Coordinate System +The catalog coordinate system is the coordinate system of the astrometric +catalog. The catalog coordinate system is normally defined in the catalog +configuration file. If undefined it defaults to J2000. +.le +.ls The Output Coordinate System +The output coordinate system is the coordinate system of the output +catalog produced by the catalog query. Normally the output coordinate +system is defined by the user. If undefined it default to the catalog +coordinate system. Catalog coordinates are transformed from the catalog +coordinate system to the output coordinate system before they are +written to the output file. +.le + +.ih +IMAGE ACCESS COORDINATE SYSTEMS + +Astcat supports several image access coordinate systems and manages the +required transformation between them based on input from the user, and +information in the return image headers and the image survey configuration +file. + +.ls The Input Coordinate System +The input coordinate system specifies the coordinate system of the region +center coordinates used to extract data from an image survey. The input +coordinate system is normally defined by the user. If undefined, the input +coordinate system defaults to the query coordinate system. +.le +.ls The Query Coordinate System +The query coordinate system specifies the coordinate system of the coordinates +used to formulate an image survey query. The query coordinate system is +normally defined in the image survey configuration file. If undefined the +query coordinate system defaults to J2000. Coordinates in the input coordinate +system must be transformed to the query coordinate system in order to formulate +a correct query. +.le +.ls Image Coordinate System +The image coordinate system is the coordinate system stored in the header +of the fits image returned by an image survey query. The image coordinate +system type is specified in the image survey configuration file. The +currently recognized types are "fits", "dss", and "none". The default +image coordinate system type is none. The dss wcs is always in the +J2000 system. The fits headers may be in any supported coordinate systems, +but the most common system is J2000. +.le +.ls the output coordinate system +The output coordinate system is the coordinate system of the final image +stored in the image header in FITS format. The output coordinate system +may be the same as the image coordinate system but encoded differently +as when a dss coordinate system is converted to its fits equivalent, +or different as when an image without a coordinate system is assigned +one by the user. +.le + +.ih +CELESTIAL COORDINATE SYSTEMS + +The astcat package supports the equatorial ("fk4", "fk4-noe", "fk5", "icrs"), +ecliptic, galactic, and supergalactic celestial coordinate systems. In most +cases and unless otherwise noted users can input their coordinates in +any one of these systems as long as they specify the coordinate system +correctly. + +Considerable flexibility is permitted in how the coordinate systems are +specified, e.g. J2000.0, j2000.0, 2000.0, fk5, fk5 J2000, and fk5 2000.0 +all specify the mean place post-IAU 1976 or FK5 system. Missing equinox and +epoch fields assume reasonable defaults. In most cases the +systems of most interest to users are "icrs", "j2000", and "b1950" +which stand for the ICRS J2000.0, FK5 J2000.0 and FK4 B1950.0 celestial +coordinate systems respectively. The full set of options are listed below: + +.ls equinox [epoch] +The equatorial mean place post-IAU 1976 (FK5) system if equinox is a +Julian epoch, e.g. J2000.0 or 2000.0, or the equatorial mean place +pre-IAU 1976 system (FK4) if equinox is a Besselian epoch, e.g. B1950.0 +or 1950.0. Julian equinoxes are prefixed by a J or j, Besselian equinoxes +by a B or b. Equinoxes without the J / j or B / b prefix are treated as +Besselian epochs if they are < 1984.0, Julian epochs if they are >= 1984.0. +Epoch is the epoch of the observation and may be a Julian +epoch, a Besselian epoch, or a Julian date. Julian epochs +are prefixed by a J or j, Besselian epochs by a B or b. +Epochs without the J / j or B / b prefix default to the epoch type of +equinox if the epoch value <= 3000.0, otherwise epoch is interpreted as +a Julian date. If undefined epoch defaults to equinox. +.le +.ls icrs [equinox] [epoch] +The International Celestial Reference System where equinox is +a Julian or Besselian epoch e.g. J2000.0 or B1980.0. +Equinoxes without the J / j or B / b prefix are treated as Julian epochs. +The default value of equinox is J2000.0. +Epoch is a Besselian epoch, a Julian epoch, or a Julian date. +Julian epochs are prefixed by a J or j, Besselian epochs by a B or b. +Epochs without the J / j or B / b prefix default to Julian epochs +if the epoch value <= 3000.0, otherwise epoch is interpreted as +a Julian date. If undefined epoch defaults to equinox. +.le +.ls fk5 [equinox] [epoch] +The equatorial mean place post-IAU 1976 (FK5) system where equinox is +a Julian or Besselian epoch e.g. J2000.0 or B1980.0. +Equinoxes without the J / j or B / b prefix are treated as Julian epochs. +The default value of equinox is J2000.0. +Epoch is a Besselian epoch, a Julian epoch, or a Julian date. +Julian epochs are prefixed by a J or j, Besselian epochs by a B or b. +Epochs without the J / j or B / b prefix default to Julian epochs +if the epoch value <= 3000.0, otherwise epoch is interpreted as +a Julian date. If undefined epoch defaults to equinox. +.le +.ls fk4 [equinox] [epoch] +The equatorial mean place pre-IAU 1976 (FK4) system where equinox is a +Besselian or Julian epoch e.g. B1950.0 or J2000.0, +and epoch is the Besselian epoch, the Julian epoch, or the Julian date of the +observation. +Equinoxes without the J / j or B / b prefix are treated +as Besselian epochs. The default value of equinox is B1950.0. Epoch +is a Besselian epoch, a Julian epoch, or a Julian date. +Julian epochs are prefixed by a J or j, Besselian epochs by a B or b. +Epochs without the J / j or B / b prefix default to Besselian epochs +if the epoch value <= 3000.0, otherwise epoch is interpreted as +a Julian date. If undefined epoch defaults to equinox. +.le +.ls noefk4 [equinox] [epoch] +The equatorial mean place pre-IAU 1976 (FK4) system but without the E-terms +where equinox is a Besselian or Julian epoch e.g. B1950.0 or J2000.0, +and epoch is the Besselian epoch, the Julian epoch, or the Julian date of the +observation. +Equinoxes without the J / j or B / b prefix are treated +as Besselian epochs. The default value of equinox is B1950.0. +Epoch is a Besselian epoch, a Julian epoch, or a Julian date. +Julian epochs are prefixed by a J or j, Besselian epochs by a B or b. +Epochs without the J / j or B / b prefix default to Besselian epochs +if the epoch value <= 3000.0, otherwise epoch is interpreted as +a Julian day. If undefined epoch defaults to equinox. +.le +.ls apparent epoch +The equatorial geocentric apparent place post-IAU 1976 system where +epoch is the epoch of observation. +Epoch is a Besselian epoch, a Julian epoch or a Julian date. +Julian epochs are prefixed by a J or j, Besselian epochs by a B or b. +Epochs without the J / j or B / b prefix default to Besselian +epochs if the epoch value < 1984.0, Julian epochs +if the epoch value <= 3000.0, otherwise epoch is interpreted as +a Julian date. +.le +.ls ecliptic epoch +The ecliptic coordinate system where epoch is the epoch of observation. +Epoch is a Besselian epoch, a Julian epoch, or a Julian date. +Julian epochs are prefixed by a J or j, Besselian epochs by a B or b. +Epochs without the J / j or B / b prefix default to Besselian epochs +if the epoch values < 1984.0, Julian epochs +if the epoch value <= 3000.0, otherwise epoch is interpreted as +a Julian day. +.le +.ls galactic [epoch] +The IAU 1958 galactic coordinate system. +Epoch is a Besselian epoch, a Julian epoch or a Julian date. +Julian epochs are prefixed by a J or j, Besselian epochs by a B or b. +Epochs without the J / j or B / b prefix default to Besselian +epochs if the epoch value < 1984.0, Julian epochs +if the epoch value <= 3000.0, otherwise epoch is interpreted as +a Julian date. The default value of epoch is B1950.0. +.le +.ls supergalactic [epoch] +The deVaucouleurs supergalactic coordinate system. +Epoch is a Besselian epoch, a Julian epoch or a Julian date. +Julian epochs are prefixed by a J or j, Besselian epochs by a B or b. +Epochs without the J / j or B / b prefix default to Besselian +epochs if the epoch value < 1984.0, Julian epochs +if the epoch value <= 3000.0, otherwise epoch is interpreted as +a Julian date. The default value of epoch is B1950.0. +.le + +Fields enclosed in [] are optional with the defaults as described. The epoch +field for the "icrs" , "fk5", "galactic", and "supergalactic" coordinate +systems is only used if the input coordinates are in the equatorial fk4, +noefk4, fk5, or icrs systems and proper motions are used to transform from +coordinate system to another. + +.ih +SEE ALSO +.endhelp diff --git a/noao/astcat/doc/surveys.hlp b/noao/astcat/doc/surveys.hlp new file mode 100644 index 00000000..2c5c4799 --- /dev/null +++ b/noao/astcat/doc/surveys.hlp @@ -0,0 +1,275 @@ +.help surveys Mar00 astcat +.ih +NAME +surveys -- describe the image survey configuration file +.ih +USAGE +help surveys +.ih +IMAGE SURVEYS + +An image survey is a collection of image data for a large region of +the sky from which image data for a small region of the sky can be extracted +by specifying an extraction region. + +Image surveys may be installed locally or accessed remotely. Each +supported survey must have a record in the image survey configuration file +defining the image survey network address, the image survey query format, +and the query output format. The default configuration file supplied with +the package is "astcat$lib/imdb.dat". A list of the supported surveys in the +configuration file can be obtained by running the aslist task. + +.ih +THE IMAGE SURVEY CONFIGURATION FILE + +The image survey configuration file specifies the network address, the query +format, and the output image format for each supported image server. Each +image survey record is accessed via a record name of the form +survey@site, e.g. "dss2@cadc". Adding support for a new image +server or responding to changes in the behavior of an existing image +server requires adding a new record to the configuration file or changing +an existing record. No modification to the code should be required. + +The image server network address tells the image survey access code where +and how to connect to the network. Each network address has the syntax +"domain:port:address:flags" e.g. "inet:80:www.noao.edu:text". + +The query format specifies the form of the query string, and the +names, default values, units, and format of the query parameters. A set of +query parameter names are reserved for accessing image surveys +including "ra", "dec", "width", "hwidth", "xwidth", "ywidth", "xhwidth", +and "yhwidth". The astcat package recognizes the reserved query parameter +names, replaces the default query parameter values with user supplied ones, +and sends the query to the image server. "ra" and "dec" always refer +to the center of the region to be extracted. The size parameter is +input by the user as a width in ra and dec in arcminutes. This value +is translated into a halfwidth or width like parameter +depending on whether the query parameter is defined as "hwidth", "width", +"xwidth", "ywidth", "hxwidth", or "hywidth" etc. + +The server output format specifies the form of the server query results: +including the image type, the world coordinate system type, and the +standard keyword set. At present the only supported image type is FITS, +the supported world coordinate system types are FITS and DSS, +and the standard keyword set includes keywords that are required or +useful for astrometric analysis tasks. + +.ih +SAMPLE IMAGE SURVEY RECORD + +The following example illustrates the main features of a image survey +configuration file record. + +.nf +begin dss1@cadc +address inet:80:cadcwww.hia.nrc.ca:text +query GET /cadcbin/dss-server?ra=%-s&dec=%-s&mime-type=application/x-fits&x=%-s +&y=%-s HTTP/1.0\n\n +nquery 5 + ra 00:00:00.00 hours %0.2h + dec +00:00:00.0 degrees %0.1h + xwidth 10.0 minutes %0.1f + ywidth 10.0 minutes %0.1f + qsystem J2000.0 INDEF %s +type fits +hread 1 +wcs dss +nwcs 10 + wxref INDEF INDEF d pixels + wyref INDEF INDEF d pixels + wxmag INDEF 1.701 d arcsec/pixel + wymag INDEF 1.701 d arcsec/pixel + wxrot INDEF 180.0 d degrees + wyrot INDEF 0.0 d degrees + wraref OBJCTRA INDEF d hms + wdecref OBJCTDEC INDEF d dms + wproj INDEF tan c INDEF + wsystem INDEF J2000 c INDEF +nkeys 13 + observat INDEF Palomar c INDEF + esitelng INDEF +116:51:46.80 d degrees + esitelat INDEF +33:21:21.6 d degrees + esitealt INDEF 1706 r meters + esitetz INDEF 8 r INDEF + emjdobs INDEF INDEF d INDEF + edatamin INDEF INDEF r ADU + edatamax INDEF INDEF r ADU + egain INDEF INDEF r e-/ADU + erdnoise INDEF INDEF r e- + ewavlen INDEF INDEF r angstroms + etemp INDEF INDEF r degrees + epress INDEF INDEF r mbars +.fi + +The beginning of a new image survey record is marked by a line +of the form "begin surveyname" where surveyname is a unique name of the +form survey@site. Any number of unique names can access the same +image survey. Multiple entries for the same survey +can be used to define a different query format or to interpret the +output in different ways. For example if the image server supports a +variety of image formats then the query can be set up to make +use of this facility. + +The \fIaddress\fR, \fIquery\fR and \fInquery\fR keywords are required and +define the network address, query command format, and query parameters for +the image survey. + +The \fIaddress\fR keyword "domain", "port", and "flags" fields are almost +always "inet", "80", and "text" respectively for image surveys, so +the only field that has to be set differently is the address +field :cadcwww.hia.nrc.ca" in this case. + +The \fIquery\fR keyword defines the query command whose form is server +dependent. Note the %-s formatting strings. These strings are replaced +by the query parameter values supplied by the user of the default query +parameter values. + +The number of query parameters is defined by the \fInquery\fR keyword. The +number of query parameters must be greater than or equal to the number of "-%s" +strings in the query keyword value. The name, default value, units, +and format of each query parameter is listed below the nquery keyword and value, +one parameter description per line. Alert users will notice that in the +example above the number of query parameters is 5 but there are only 4 "%-s" +strings in the query keyword value. In this case the qsystem query parameter +which defines the coordinate system of the ra and dec query parameters is +fixed at J2000. For some servers this could be a true query parameter, i.e. +the server may accept coordinates in B1950, J2000, or some other system. + +Users must use the standard query parameter names "ra", "dec", and "qysystem" +to define the extraction region center and its coordinate system, and one or +more of "width", "xwidth", "ywidth", "hwidth", "xhwidth", or "ywidth" to define +the extraction region size. Currently the units of "ra" may be "hours", +"degrees", or "radians", the units of dec may be "degrees" or "radians", +and units of the size query parameter may be "degrees" or "minutes". +The qsystem parameter may be any one of the supported celestial coordinate +systems. The most popular values are "icrs", "J2000", and "B1950". +For more details type "help ccsystems". The formats are used to convert +any numerical values supplied by the user to strings arguments that +can be passed to the query string. + +The \fItype\fR keyword defines the format of the output image file. At +present only fits data is supported. + +The \fIhread\fR keyword is the number of network reads to discard before +the image transfer begins. If undefined the hread keyword defaults to 0. +A related parameter \fIhskip\fR defines the amount of data to be skipped +in bytes. Hskip is not yet supported. + +The \fIwcs\fR parameter defines the wcs status of the image. The options +are "fits" for an image which already has a valid fits wcs, "dss" for an +image which has a dss WCS, and "none" for an image which has no wcs +information. The value of this parameter determines what if any fits wcs +information should be added to the output image headers. + +The \fInwcs\fR keyword defines the number of following wcs parameters. Each +parameter consists of a standard keyword name, the actual keyword name or INDEF +is no keyword exists, the default value or INDEF is there is no default value, +the data type which must be one of d(double), r(real), (i)integer, or +c(character), and the units which may be INDEF if they are undefined. + +Users should use the reserved wcs parameter names \fIwxref\fR, \fIwyref\fR, +\fIwxmag\fR, \fIwymag\fR, \fIwxref\fR, \fIwyref\fR, \fIwraref\fR, +\fIwdecref\fR, \fIwproj\fR, and \fIwsystem\fR to define the wcs parameter +pixel reference coordinates, pixel scale in "/ pixel, coordinate +system rotation and skew in degrees, reference coordinates in some celestial +coordinate system, projection scheme, and celestial coordinate system. At +present the units for all but the wraref and wdecref are fixed. + +The \fInkeys\fR keyword defines the number of following standard keyword +parameters. Each parameter consists of a standard keyword name, the actual +keyword name or INDEF is no keyword exists, the default value or INDEF is +there is no default value, the data type which must be one of d(double), +r(real), (i)integer, or c(character), and the parameter units which may be +INDEF if they are undefined. + +Users should use the reserved standard keyword names \fIobservat\fR, +\fIesitelng\fR, \fIesitelat\fR, \fIesitelat\fR, and \fIesitetz\fR to +define the site, \fIemjdobs\fR, \fIewavelen\fR, \fIetemp\fR, and \fIepress\fR +to define the time and physical conditions of the observation, and +\fIedatamin\fR, \fIedatamax\fR, \fIegain\fR, and \fIerdnoise\fR +to define the detector parameters. At present the units of all these +parameters should be regarded as fixed. The standard keyword set determines +what if any standard keyword and value information should be added to the +image headers. + +.ih +INSTALLING A NEW IMAGE SURVEY RECORD + +Some users may need to install a local version of an image survey , or +support a new image survey as it comes on line. The procedure for doing +this is outlined below. + +To install a new image survey record. + +.ls [1] +Create a new configuration file by making a copy of the old one. +.le + +.ls [2] +Determine a unique name for the image server. This name should be short and +have the form survey@site, e.g. "dss1@cadc". Existing names can be +reviewed with the aslist task. +.le + +.ls [3] +Determine the appropriate values for the address, query and nquery +keywords and enter these quantities in the survey record. +Determine the name, default value, units and format for each query parameter +and enter these quantities in the survey record in the order they are +requested by the query parameter string. Make sure that all the query keyword +value formatting strings are -%s, that the value of the nquery keyword is +greater than or equal to the number of %-s strings in the query keyword +value, and that standard query parameter names are used. +.le + +.ls [4] +Set the value of type to "fits". Note that image servers which do not +produce fits image files cannot be supported at present. +.le + +.ls [5] +Run the adumpim task. Adumpim tests the address and query parts of the +survey record but dumps the query results directly to a file without +modification. If adumpim fails either the network connection is bad +or the address and / or query format is incorrect. +.le + +.ls [6] +Examine the adumpim results with imhdr and imstat. Note that it may be +necessary to add a ".fits" extension to the output file name in order to +make IRAF think it is an image. If imheader or imstat fail it +may be because some leading junk header data got included with the image +data. Determine the size and type of this junk data, set hread or hskip +keywords appropriately, and run adumpim again. +.le + +.ls [7] +Examine the fits image header and determine the type of wcs information if +any in the header. For dss images set wcs to "dss", for images with fits +wcs information already present in the headers set wcs to "fits", for all +remaining images set wcs to "none". +.le + +.ls [8] +Fill in the wcs information using information in the returned image header +or apriori information about the survey, and one of the existing records +as a model. If no information is available set the nwcs keyword to 0. +.le + +.ls [9] +Fill in the standard keyword information using information in the image +header or apriori information about the survey, and one of the existing +records as a model. If no information is available set the nkeys keyword +to 0. +.le + +.ls [11] +Run the agetim task with and without the header editing options enabled +to check the accuracy of the survey record. +.le +.fi + +.ih +SEE ALSO +aslist +.endhelp diff --git a/noao/astcat/lib/acatalog.h b/noao/astcat/lib/acatalog.h new file mode 100644 index 00000000..bb794fb8 --- /dev/null +++ b/noao/astcat/lib/acatalog.h @@ -0,0 +1,39 @@ +# The builtin astrometry catalog definitions + +# Define the maximum length of an array column definition. + +define AT_MAX_NRANGES 10 + +# Define the currently supported file types. + +#define AT_FTYPES "|text|btext|" +#define AT_TEXT 1 +#define AT_BTEXT 2 + +# Define the standard fields. + +define AT_NSTDCOLS 28 + +define AT_CATNAMES "|id|ra|dec|era|edec|pmra|pmdec|epmra|epmdec|px|rv|\ +epx|erv|catsystem|equinox|epoch|mag|color|emag|ecolor|xp|yp|xc|yc|exc|eyc|\ +imag|eimag|" + +# Define the default data types of the standard fields + +define AT_CATTYPES "|c|d|d|d|d|d|d|d|d|d|d|d|d|c|c|c|r|r|r|r|d|d|d|d|d|d|r|r|" + +# Define the default units of the standard fields + +define AT_CATUNITS "|INDEF|hours|degrees|asecs|asecs|masecs/yr|masecs/yr|\ +masecs/yr|masecs/yr|msecs|km/sec|msecs|km/sec|INDEF|INDEF|INDEF|mags|mags|mags|\ +mags|pixels|pixels|pixels|pixels|pixels|pixels|mags|mags|" + +# Define the default formats of the standard fields + +define AT_CATFORMATS "|%20s|%11.2h|%11.1h|%6.3f|%6.3f|%7.3f|%7.3f|\ +%7.3f|%7.3f|%6.3f|%6.3f|%6.3f|%6.3f|%15s|%15s|%15s|%8.3f|%8.3f|%8.3f|\ +%8.3f|%9.3f|%9.3f|%9.3f|%9.3f|%9.3f|%9.3f|%8.3f|%8.3f|" + +# Define some useful defaults. + +define DEF_CATSYSTEM "J2000" diff --git a/noao/astcat/lib/aimpars.h b/noao/astcat/lib/aimpars.h new file mode 100644 index 00000000..e1482577 --- /dev/null +++ b/noao/astcat/lib/aimpars.h @@ -0,0 +1,123 @@ +# Define the public default image wcs structure. + +# Define the WCS parameters (# 401 - 500) + +define WXREF 401 +define WYREF 402 +define WXMAG 403 +define WYMAG 404 +define WXROT 405 +define WYROT 406 +define WRAREF 407 +define WDECREF 408 +#define WMJDOBS 409 +define WRAUNITS 410 +define WDECUNITS 411 +define WPROJ 412 +define WSYSTEM 413 +#define WEQUINOX 414 +#define WRADECSYS 415 +define WCST 416 + +# Define the default WCS parameters symbol table. +define LEN_WCST_STRUCT 15 + +define AT_WCSTKVAL Memc[P2C($1)] + +define DEF_LEN_WCST 100 +define DEF_WCST_ROOTNAME "wcs" + +define AT_NWFIELDS 12 + +# Define the wcs standard fields + +define AT_WFIELDS "|wxref|wyref|wxmag|wymag|wxrot|wyrot|wraref|wdecref|\ +wraunits|wdecunits|wproj|wsystem|" + +define WCS_WXREF 1 +define WCS_WYREF 2 +define WCS_WXMAG 3 +define WCS_WYMAG 4 +define WCS_WXROT 5 +define WCS_WYROT 6 +define WCS_WRAREF 7 +define WCS_WDECREF 8 +define WCS_WRAUNITS 9 +define WCS_WDECUNITS 10 +define WCS_WPROJ 11 +define WCS_WSYSTEM 12 + +# Define the defaults standard field values. + +define AT_WVALUES "|INDEF|INDEF|INDEF|INDEF|INDEF|INDEF|RA|DEC|\ +INDEF|INDEF|tan|J2000|" + +# Define the default wcs datatypes. + +define AT_WTYPES "|d|d|d|d|d|d|d|d|i|i|c|c|" + +define AT_WUNITS "|pixels|pixels|arcsec/pixel|arcsec/pixel|degrees|degrees|\ +hours|degrees|||||" + + +# Define the image data parameters (# 501 - 600) + +define OBSERVAT 501 +define ESITELNG 502 +define ESITELAT 503 +define ESITEALT 504 +define ESITETZ 505 +define EMJDOBS 507 +#define EXPOSURE 508 +define EDATAMIN 509 +define EDATAMAX 510 +define EGAIN 511 +define ERDNOISE 512 +define EWAVLEN 513 +define ETEMP 514 +define EPRESS 515 +define IMST 516 + +# Define the default image parameters symbol table. + +define LEN_IMST_STRUCT 15 + +define AT_IMSTKVAL Memc[P2C($1)] + +define DEF_LEN_IMST 100 +define DEF_IMST_ROOTNAME "impars" + +# Define the nu,ber of image fields. + +define AT_NIMFIELDS 13 + +# Define the image data standard fields + +define AT_IMFIELDS "|observat|esitelng|esitelat|esitealt|esitetz|emjdobs|\ +edatamin|edatamax|egain|erdnoise|ewavlen|etemp|epress|" + +define HDR_OBSERVAT 1 +define HDR_ESITELNG 2 +define HDR_ESITELAT 3 +define HDR_ESITEALT 4 +define HDR_ESITETZ 5 +define HDR_EMJDOBS 6 +define HDR_EDATAMIN 7 +define HDR_EDATAMAX 8 +define HDR_EGAIN 9 +define HDR_ERDNOISE 10 +define HDR_EWAVLEN 11 +define HDR_ETEMP 12 +define HDR_EPRESS 13 + +# Define the defaults standard field values. + +define AT_IMVALUES "|OBSERVAT|INDEF|INDEF|INDEF|INDEF|MJD-OBS|\ +INDEF|INDEF|GAIN|RDNOISE|INDEF|INDEF|INDEF|" + +# Define the default wcs datatypes. + +define AT_IMTYPES "|c|d|d|r|r|d|r|r|r|r|r|r|r|r|" + +define AT_IMUNITS "||degrees|degrees|meters|||ADU|ADU|electrons|\ +electrons/ADU|microns|degrees|mbars|" diff --git a/noao/astcat/lib/aimparsdef.h b/noao/astcat/lib/aimparsdef.h new file mode 100644 index 00000000..75e44b8a --- /dev/null +++ b/noao/astcat/lib/aimparsdef.h @@ -0,0 +1,47 @@ + +# Define the default image WCS data structure. + +define SZ_WPROJ 10 +define SZ_WFNAME (1 + SZ_FNAME) / 2 +define SZ_OBSERVAT 20 +define SZ_DATEOBS 20 + +#define LEN_PWCS (25 + SZ_WPROJ + 2 * SZ_WFNAME) +define LEN_PWCS (25 + SZ_WPROJ + SZ_WFNAME) + +define AT_WXREF Memd[P2D($1)] +define AT_WYREF Memd[P2D($1+2)] +define AT_WXMAG Memd[P2D($1+4)] +define AT_WYMAG Memd[P2D($1+6)] +define AT_WXROT Memd[P2D($1+8)] +define AT_WYROT Memd[P2D($1+10)] +define AT_WRAREF Memd[P2D($1+12)] +define AT_WDECREF Memd[P2D($1+14)] +#define AT_WMJDOBS Memd[P2D($1+16)] +#define AT_WEQUINOX Memd[P2D($1+18)] +define AT_WRAUNITS Memi[$1+20] +define AT_WDECUNITS Memi[$1+21] +define AT_WCST Memi[$1+22] +define AT_WPROJ Memc[P2C($1+23)] +define AT_WSYSTEM Memc[P2C($1+23+SZ_WPROJ)] +#define AT_WRADECSYS Memc[P2C($1+23+SZ_WPROJ+SZ_WFNAME)] + +#define LEN_PIMPARS (20 + SZ_OBSERVAT + SZ_DATEOBS) +define LEN_PIMPARS (20 + SZ_OBSERVAT) + +define AT_ESITELNG Memd[P2D($1)] +define AT_ESITELAT Memd[P2D($1+2)] +define AT_EMJDOBS Memd[P2D($1+4)] +define AT_ESITEALT Memr[P2R($1+6)] +define AT_ESITETZ Memr[P2R($1+7)] +#define AT_EXPOSURE Memr[P2R($1+8)] +define AT_EDATAMIN Memr[P2R($1+9)] +define AT_EDATAMAX Memr[P2R($1+10)] +define AT_EGAIN Memr[P2R($1+11)] +define AT_ERDNOISE Memr[P2R($1+12)] +define AT_EWAVLEN Memr[P2R($1+13)] +define AT_ETEMP Memr[P2R($1+14)] +define AT_EPRESS Memr[P2R($1+15)] +define AT_IMST Memi[$1+16] +define AT_OBSERVAT Memc[P2C($1+17)] +#define AT_DATEOBS Memc[P2C($1+17+SZ_OBSERVAT)] diff --git a/noao/astcat/lib/astrom.h b/noao/astcat/lib/astrom.h new file mode 100644 index 00000000..09a67f73 --- /dev/null +++ b/noao/astcat/lib/astrom.h @@ -0,0 +1,148 @@ +# Define the public astrometry pacakge interface. + +# Define the astrom parameters (1 -100) + +define PIO 1 # pointer to the i/o structure +define PRCENTER 2 # pointer to the region structure +define PFILTER 3 # pointer to the filter structure +define PWCS 4 # pointer to the wcs structure +define PIMPARS 5 # pointer to the image data structure + + +# Define the region parameters (101 - 200). + +define RCRA 101 # the field center ra +define RCDEC 102 # the field center dec +define RCRAWIDTH 103 # the field center ra width +define RCDECWIDTH 104 # the field center dec width +define RCRAUNITS 105 # the field center ra units +define RCDECUNITS 106 # the fields center dec units +#define RCCC 107 # the field center coordinate system +define RCST 108 # the field center symbol table +define RCSYSTEM 109 # the field center coordinate system +define RCSOURCE 110 # the field center source + +# Define the region commands for interactive mode. + +define RCCMDS "|rcra|rcdec|rrawidth|rdecwidth|rcraunits|\ +rcdecunits|rcsystem|" + + +# Define the field center symbol table structure. + +define RCST_SZ_FNAME (1 + SZ_FNAME) / 2 +define LEN_RCST_STRUCT (15 + 2 * RCST_SZ_FNAME) + +define AT_RCSTRA Memd[P2D($1)] # the field center ra / lon +define AT_RCSTDEC Memd[P2D($1+2)] # the field center dec / lat +define AT_RCSTRAWIDTH Memd[P2D($1+4)] # the field ra / lon width +define AT_RCSTDECWIDTH Memd[P2D($1+6)] # the field dec / lat width +define AT_RCSTRAUNITS Memi[$1+8] # the ra / lon units +define AT_RCSTDECUNITS Memi[$1+9] # the dec / lat units +define AT_RCSTSOURCE Memc[P2C($1+10)] # the field center source +define AT_RCSTNAME Memc[P2C($1+15)] # the field center file +define AT_RCSTSYSTEM Memc[P2C($1+15+RCST_SZ_FNAME)] # the field center cc system + +define DEF_LEN_RCST 100 +define DEF_RCST_ROOTNAME "reg" + + +# Define the builtin region query fields. + +define AT_QRCRA 1 +define AT_QRCDEC 2 +define AT_QRCWIDTH 3 +define AT_QRCHWIDTH 4 +define AT_QRCRADIUS 5 +define AT_QRCRAWIDTH 6 +define AT_QRCDECWIDTH 7 +define AT_QRCRAHWIDTH 8 +define AT_QRCDECHWIDTH 9 +define AT_QRCXWIDTH 10 +define AT_QRCYWIDTH 11 +define AT_QRCXHWIDTH 12 +define AT_QRCYHWIDTH 13 + +define AT_QRCFIELDS "|ra|dec|width|hwidth|radius|rawidth|decwidth|\ +rahwidth|dechwidth|xwidth|ywidth|xhwidth|yhwidth|" + + +# Define the i/o substructure parameters (201 - 300). + +define CATALOGS 201 +define SURVEYS 202 +define IMAGES 203 +define INPUT 204 +define OUTPUT 205 +define CATNAME 206 +define SVNAME 207 +define IMNAME 208 +define INFNAME 209 +define OUTFNAME 210 +define CATDB 211 +define IMDB 212 + +# Define the field center commands for interactive mode. + +define IOCMDS "|catalogs|surveys|images|input|output|catname|svname|imname|\ +infname|outfname|catdb|imdb|" + +# Define the filtering / selection parameters (301 - 400) + +define FREVERSE 301 +define FREPLACE 302 +define FORAUNITS 303 +define FODECUNITS 304 +define FSORT 305 +define FOSYSTEM 306 +define FIRA 307 +define FIDEC 308 +define FORAFORMAT 309 +define FODECFORMAT 310 +define FIXP 311 +define FIYP 312 +define FIXC 313 +define FIYC 314 +define FOXFORMAT 315 +define FOYFORMAT 316 +define FIELDS 317 +define FEXPR 318 +define FNAMES 319 +define FNTYPES 320 +define FNUNITS 321 +define FNFORMATS 322 + +define FSCMDS "|freverse|freplace|foraunits|fodecunits|fsort|fosystem|fira|\ +fidec|fixp|fiyp|fixc|fiyc|foxformat|foyformat|foraformat|fodecformat|fields|\ +fexpr|fnames|fntypes|fnunits|fnformats|" + +# Units definitions. + +# Define the supported celestial coordinate units. +# It appears only the first three are used and they must agree with skywcs.h. FV + +define AT_RA_UNITS "|degrees|radians|hours|dms|hms|" +define AT_DEC_UNITS "|degrees|radians|invalid|dms|" +define AT_DEGREES 1 +define AT_RADIANS 2 +define AT_HOURS 3 +define AT_DMS 4 +define AT_HMS 5 + +# Define the supported celestial coordinate error units. + +define AT_ERA_UNITS "|asecs|masecs|secs|msecs|" +define AT_EDEC_UNITS "|asecs|masecs|" +define AT_ASECS 1 +define AT_MASECS 2 +define AT_SECS 3 +define AT_MSECS 4 + +# Define the supported proper motion units. + +define AT_PMRA_UNITS "|asecs/yr|masecs/yr|secs/yr|msecs/yr|" +define AT_PMDEC_UNITS "|asecs/yr|masecs/yr|" +define AT_ASECSYR 1 +define AT_MASECSYR 2 +define AT_SECSYR 3 +define AT_MSECSYR 4 diff --git a/noao/astcat/lib/astromdef.h b/noao/astcat/lib/astromdef.h new file mode 100644 index 00000000..22babb65 --- /dev/null +++ b/noao/astcat/lib/astromdef.h @@ -0,0 +1,82 @@ +# The private astrometry package definitions. + + +# Define the astrometry package structure. + +define LEN_ASTROM 10 + +define AT_PIO Memi[$1] # the i/o structure +define AT_PRCENTER Memi[$1+1] # the region definition structure +define AT_PFILTER Memi[$1+2] # the catalog filtering structure +define AT_PWCS Memi[$1+3] # the image wcs structure +define AT_PIMPARS Memi[$1+4] # the image data structure + + +# Define the i/o substructure + +define IO_SZ_FNAME (SZ_FNAME + 1) / 2 +define LEN_PIO (10 + 12 * IO_SZ_FNAME) + +define AT_CATALOGS Memc[P2C($1+10)] +define AT_SURVEYS Memc[P2C($1+10+IO_SZ_FNAME)] +define AT_IMAGES Memc[P2C($1+10+2*IO_SZ_FNAME)] +define AT_INPUT Memc[P2C($1+10+3*IO_SZ_FNAME)] +define AT_OUTPUT Memc[P2C($1+10+4*IO_SZ_FNAME)] +define AT_CATNAME Memc[P2C($1+10+5*IO_SZ_FNAME)] +define AT_SVNAME Memc[P2C($1+10+6*IO_SZ_FNAME)] +define AT_IMNAME Memc[P2C($1+10+7*IO_SZ_FNAME)] +define AT_INFNAME Memc[P2C($1+10+8*IO_SZ_FNAME)] +define AT_OUTFNAME Memc[P2C($1+10+9*IO_SZ_FNAME)] +define AT_CATDB Memc[P2C($1+10+10*IO_SZ_FNAME)] +define AT_IMDB Memc[P2C($1+10+11*IO_SZ_FNAME)] + + +# Define the field center substructure + +define RC_SZ_FNAME (SZ_FNAME + 1) / 2 +define LEN_PRCENTER (12 + 2 * RC_SZ_FNAME) + +define AT_RCRA Memd[P2D($1)] # the field center ra / lon +define AT_RCDEC Memd[P2D($1+2)] # the field center dec / lat +define AT_RCRAWIDTH Memd[P2D($1+4)] # the field ra / lon width +define AT_RCDECWIDTH Memd[P2D($1+6)] # the field dec / lat width +define AT_RCRAUNITS Memi[$1+8] # the ra / lon units +define AT_RCDECUNITS Memi[$1+9] # the dec / lat units +#define AT_RCCC Memi[$1+10] # the field center cc structure +define AT_RCST Memi[$1+11] # the field center symbol table +define AT_RCSYSTEM Memc[P2C($1+12)] # the field center cc system +define AT_RCSOURCE Memc[P2C($1+12+RC_SZ_FNAME)] # the field center cc system + +# Define the field filtering subtructure. + +define FS_SZ_FNAME (SZ_FNAME + 1) / 2 +define FS_SZ_LINE (SZ_LINE + 1) / 2 + +define LEN_PFILTER (10+12*FS_SZ_FNAME+6*FS_SZ_LINE) +define F1OFFSET P2C($1+10+$2*FS_SZ_FNAME) +define F2OFFSET P2C($1+10+12*FS_SZ_FNAME+$2*FS_SZ_LINE) + +define AT_FREVERSE Memi[$1] +define AT_FREPLACE Memi[$1+1] +define AT_FORAUNITS Memi[$1+2] +define AT_FODECUNITS Memi[$1+3] + +define AT_FSORT Memc[F1OFFSET($1,0)] +define AT_FOSYSTEM Memc[F1OFFSET($1,1)] +define AT_FIRA Memc[F1OFFSET($1,2)] +define AT_FIDEC Memc[F1OFFSET($1,3)] +define AT_FORAFORMAT Memc[F1OFFSET($1,4)] +define AT_FODECFORMAT Memc[F1OFFSET($1,5)] +define AT_FIXP Memc[F1OFFSET($1,6)] +define AT_FIYP Memc[F1OFFSET($1,7)] +define AT_FIXC Memc[F1OFFSET($1,8)] +define AT_FIYC Memc[F1OFFSET($1,9)] +define AT_FOXFORMAT Memc[F1OFFSET($1,10)] +define AT_FOYFORMAT Memc[F1OFFSET($1,11)] + +define AT_FIELDS Memc[F2OFFSET($1,0)] +define AT_FNAMES Memc[F2OFFSET($1,1)] +define AT_FNTYPES Memc[F2OFFSET($1,2)] +define AT_FNUNITS Memc[F2OFFSET($1,3)] +define AT_FNFORMATS Memc[F2OFFSET($1,4)] +define AT_FEXPR Memc[F2OFFSET($1,5)] diff --git a/noao/astcat/lib/catdb.dat b/noao/astcat/lib/catdb.dat new file mode 100644 index 00000000..eba19d5d --- /dev/null +++ b/noao/astcat/lib/catdb.dat @@ -0,0 +1,429 @@ +# Initial cut at an astrometric catalog database file. +begin filename@noao +address +query +nquery 0 +protocol +nheader 1 + csystem J2000 +nfields 0 + + +begin usnob1@noao +address inet:80:archive.tuc.noao.edu:text +query GET /cgi-bin/scat?catalog=ub1&ra=%-s&dec=%-s&sys=J2000&mrad=%-s&nstar=-1 HTTP/1.0\n\n +nquery 4 + ra 00:00:00.00 hours %0.2h + dec 00:00:00.0 degrees %0.1h + radius 6.0 minutes %0.1f + qsystem J2000.0 INDEF %s +protocol http +type btext + hskip 12 +nheader 1 + csystem J2000.0 +nfields 11 + id 1 12 INDEF %12s + ra 14 12 d hours %12.3H + dec 27 12 d degrees %12.2h + b1mag 40 5 r INDEF %5.2f + r1mag 46 5 r INDEF %5.2f + b2mag 52 5 r INDEF %5.2f + r2mag 58 5 r INDEF %5.2f + i2mag 64 5 r INDEF %5.2f + mura 70 6 r INDEF %6.1f + mudec 77 6 r INDEF %6.1f + dist 90 4 r degrees %4.2f + + + +begin twomass@noao +address inet:80:archive.tuc.noao.edu:text +query GET /cgi-bin/scat?catalog=tmc&ra=%-s&dec=%-s&sys=J2000&mrad=%-s&nstar=-1 HTTP/1.0\n\n +nquery 4 + ra 00:00:00.00 hours %0.2h + dec 00:00:00.0 degrees %0.1h + radius 6.0 minutes %0.1f + qsystem J2000.0 INDEF %s +protocol http +type stext + hskip 11 +nheader 1 + csystem J2000.0 +nfields 7 + id 1 0 INDEF %11s + ra 2 0 d hours %12.3H + dec 3 0 d degrees %12.2h + mag1 4 0 r INDEF %6.3f + mag2 5 0 r INDEF %6.3f + mag3 6 0 r INDEF %6.3f + dist 7 0 r minutes %6.2f + +begin twomass@irsa +address inet:80:irsa.ipac.caltech.edu:text +query GET /cgi-bin/Gator/nph-query?outfmt=1&objstr=%-s+%-s&spatial=Cone&radius=%-s&radunits=arcmin&catalog=fp_psc HTTP/1.0\n\n +nquery 4 + ra 00:00:00.00 hours %0.2h + dec 00:00:00.0 degrees %0.1h + radius 1.0 minutes %0.1f + qsystem J2000.0 INDEF %s +protocol http +type btext + hskip 19 +nheader 1 + csystem J2000.0 +nfields 5 + ra 2 10 d degrees %12.3H + dec 13 10 d degrees %12.2h + mag1 58 6 r INDEF %6.3f + mag2 75 6 r INDEF %6.3f + mag3 92 6 r INDEF %6.3f + +begin twomass14@irsa +address inet:80:irsa.ipac.caltech.edu:text +query GET /cgi-bin/Gator/nph-query?outfmt=1&objstr=%-s+%-s&spatial=Cone&radius=%-s&radunits=arcmin&catalog=fp_psc&constraints=j_m<14 HTTP/1.0\n\n +nquery 4 + ra 00:00:00.00 hours %0.2h + dec 00:00:00.0 degrees %0.1h + radius 1.0 minutes %0.1f + qsystem J2000.0 INDEF %s +protocol http +type btext + hskip 19 +nheader 1 + csystem J2000.0 +nfields 5 + ra 2 10 d degrees %12.3H + dec 13 10 d degrees %12.2h + mag1 58 6 r INDEF %6.3f + mag2 75 6 r INDEF %6.3f + mag3 92 6 r INDEF %6.3f + +begin lan92@noao +address inet:80:www.noao.edu:text +query GET /cgi-bin/catalogs/ccget?catalog=landolt1992.dat&lngcenter=%-s&latcenter=%-s&width=%-s&columns=c[*] HTTP/1.0\n\n +nquery 4 + ra 00:00:00.00 hours %0.2h + dec 00:00:00.0 degrees %0.1h + width 10.0 degrees %0.3f + qsystem J2000.0 INDEF %s +protocol http +type stext + hskip 15 + tskip 1 +nheader 1 + csystem J2000.0 +nfields 17 + id 1 0 c INDEF %11s + ra 2 0 d hours %08.0h + dec 3 0 d degrees %9.0h + v 4 0 r INDEF %6.3f + bv 5 0 r INDEF %6.3f + ub 6 0 r INDEF %6.3f + vr 7 0 r INDEF %6.3f + ri 8 0 r INDEF %6.3f + vi 9 0 r INDEF %6.3f + n 10 0 i INDEF %2d + m 11 0 i INDEF %2d + ev 12 0 r INDEF %6.4f + ebv 13 0 r INDEF %6.4f + eub 14 0 r INDEF %6.3f + evr 15 0 r INDEF %6.4f + eri 16 0 r INDEF %6.4f + evi 17 0 r INDEF %6.4f + +begin usno2@cadc +address inet:80:cadcwww.dao.nrc.ca:text +query GET /cadcbin/getusno2?ra=%-s&dec=%-s&radius=%-s&m=0,21&nout=1000000 HTTP/1.0\n\n +nquery 4 + ra 00:00:00.00 hours %0.2h + dec +00:00:00.0 degrees %0.1h + radius 5 minutes %0.1f + qsystem J2000.0 INDEF %s +protocol http +type stext + hskip 2 + tskip 1 + recsize 73 + triml 0 + trimr 0 +nheader 1 + csystem J2000.0 +nfields 9 + id 1 0 c INDEF %15s + ra 2 0 d degrees %10.5f + dec 3 0 d degrees %10.5f + bmag 4 0 r INDEF %6.2f + rmag 5 0 r INDEF %6.2f + col1 6 0 r INDEF %6.2f + plateno 7 0 i INDEF %4d + acsstar 8 0 b INDEF %3b + arcdist 9 0 r asecs %6.1f + + +begin usno1@cadc +address inet:80:cadcwww.dao.nrc.ca:text +query GET /cadcbin/getusno?ra=%-s&dec=%-s&radius=%-s&m=0,21&nout=1000000 HTTP/1.0\n\n +nquery 4 + ra 00:00:00.00 hours %0.2h + dec +00:00:00.0 degrees %0.1h + radius 5 minutes %0.1f + qsystem J2000.0 INDEF %s +protocol http +type stext + hskip 2 + tskip 1 + recsize 73 + triml 0 + trimr 0 +nheader 1 + csystem J2000 +nfields 9 + id 1 0 c INDEF %15s + ra 2 0 d degrees %10.5f + dec 3 0 d degrees %10.5f + mag1 4 0 r INDEF %6.2f + mag2 5 0 r INDEF %6.2f + col1 6 0 r INDEF %6.2f + plateno 7 0 i INDEF %4d + acsstar 8 0 b INDEF %3b + arcdist 9 0 r asecs %6.1f + + +begin gsc1@cadc +address inet:80:cadcwww.dao.nrc.ca:text +query GET /cadcbin/gsc-server?%-s,%-s&r=0,%-s&m=0,21&f=8&s=R HTTP/1.0\n\n +nquery 4 + ra 00:00:00.00 hours %0.2h + dec +00:00:00.0 degrees %0.1h + radius 5 minutes %0.1f + qsystem J2000.0 INDEF %s +protocol http +type stext + hskip 4 + tskip 1 + recsize 65 + triml 0 + trimr 1 +nheader 1 + csystem J2000 +nfields 9 + id 1 0 c INDEF %13s + ra 2 0 d degrees %10.5f + dec 3 0 d degrees %10.5f + epos 4 0 r arcsecs %4.1f + mag1 5 0 r INDEF %6.2f + emag1 6 0 r INDEF %6.2f + acsstar 7 0 c INDEF %3s + arcdist 8 0 r arcmin %6.2f + pangle 9 0 r degrees %4d + +begin hipp@cadc +address inet:80:cadcwww.dao.nrc.ca:text +query GET /cadcbin/hipparcos-server?ra=%-s&dec=%-s&radius=%-s HTTP/1.0\n\n +nquery 4 + ra 00:00:00.00 hours %0.2h + dec +00:00:00.0 degrees %0.1h + radius 5 minutes %0.1f + qsystem J2000.0 INDEF %s +protocol http +type stext + hskip 2 + tskip 1 + recsize 0 + triml 0 + trimr 0 +nheader 1 + csystem J2000 +nfields 11 + id 1 0 c INDEF %8s + ra 2 0 d degrees %19g + dec 3 0 d degrees %19g + mag1 4 0 r INDEF %6.2f + px 5 0 d marcsec %6.2f + pmra 6 0 d marcsec/yr %7.2f + pmdec 7 0 d marcsec/yr %7.2f + sptype 8 0 c INDEF %5s + pangle 9 0 r degrees %3d + arcdist 10 0 r arcmin %6.1f + hip 11 0 c INDEF %s + +#begin tmass@ipac +#address inet:8002:irsadev.ipac.caltech.edu:text +#query GET /cgi-bin/CatRegion/nph-catregion?catalog=pt_src_cat&objstr=%-s,%-s,Equ+J2000&within=%-s+degree&select=designation,+ra,+dec,+j_m,+h_m,+k_m HTTP/1.0\n\n +#nquery 4 +# ra 0.00000 degrees %0.5f +# dec 0.00000 degrees %0.5f +# radius 0.100 degrees %0.03f +# qsystem J2000.0 INDEF %s +#protocol none +#type stext +# hskip 8 +# tskip 0 +# recsize 0 +# triml 0 +# trimr 0 +#nheader 1 +# csystem J2000 +#nfields 6 +# id 1 0 c INDEF %14s +# ra 2 0 d degrees %11.6f +# dec 3 0 d degrees %11.6f +# mag1 4 0 r INDEF %7.3f +# mag2 5 0 r INDEF %7.3f +# mag3 6 0 r INDEF %7.3f + +begin gsc2@stsci +address inet:80:www-gsss.stsci.edu:text +query GET /cgi-bin/gsc22query.exe?ra=%-s&dec=%-s&r1=0.0&r2=%-s&m1=0.0&m2=19.5&n=100000&submit2=Submit+Request HTTP/1.0\n\n +nquery 4 + ra 00:00:00.0 hours %0.2h + dec +00:00:00 degrees %0.1h + radius 5 minutes %0.1f + qsystem J2000.0 INDEF %s +protocol http +type stext + hskip 2 + tskip 1 + recsize 0 + triml 0 + trimr 1 +nheader 1 + csystem J2000 +nfields 23 + id 1 0 c INDEF %12s + ra 2 0 d degrees %12.8f + dec 3 0 d degrees %12.8f + era 4 0 d arcsec %8.6f + edec 5 0 d arcsec %8.6f + epoch 6 0 d years %11.6f + pmra 7 0 d marcsec/yr %10.8f + pmdec 8 0 d marcsec/yr %10.8f + epmra 9 0 d marcsec/yr %10.8f + epmdec 10 0 d marcsec/yr %10.8f + mag1 11 0 r INDEF %5.2f + emag1 12 0 r INDEF %5.2f + mag2 13 0 r INDEF %5.2f + emag2 14 0 r INDEF %5.2f + mag3 15 0 r INDEF %5.2f + emag3 16 0 r INDEF %5.2f + mag4 17 0 r INDEF %5.2f + emag4 18 0 r INDEF %5.2f + smaxis 19 0 r pixels %7.2f + ecc 20 0 r INDEF %4.2f + pangle 21 0 r degrees %6.2f + class 22 0 c INDEF %2s + status 23 0 c INDEF %7s + +begin usnob1@usno +address inet:80:www.nofs.navy.mil:text +query GET /cgi-bin/vo_cone.cgi?CAT=USNO-B1&RA=%-s&DEC=%-s&SR=%-s&VERB=1&cftype=ASCII&slf=hh.hhh/dd.ddd&skey=RA HTTP/1.0\n\n +nquery 3 + ra 0.00000 degrees %0.5f + dec 0.00000 degrees %0.5f + radius 0.100 degrees %0.03f +protocol http +type stext + hskip 26 + tskip 0 + recsize 0 + triml 1 + trimr 1 +nheader 1 + csystem J2000 +nfields 14 + id 1 0 c INDEF %12s + ra 2 0 r hours %11.8f + dec 3 0 r degrees %11.7f + sra 4 0 d milliarcsecs %3d + sde 5 0 d milliarcsecs %3d + mura 6 0 r INDEF %4.1f + mudec 7 0 r INDEF %4.1f + smura 8 0 r INDEF %4.1f + smudec 9 0 r INDEF %4.1f + b1mag 10 0 r INDEF %7.3f + r1mag 11 0 r INDEF %7.3f + b2mag 12 0 r INDEF %7.3f + r2mag 13 0 r INDEF %7.3f + i2mag 14 0 r INDEF %7.3f + +begin usnoa2@usno +address inet:80:www.nofs.navy.mil:text +query GET /cgi-bin/vo_cone.cgi?CAT=USNO-A2&RA=%-s&DEC=%-s&SR=%-s&VERB=1&cftype=ASCII&slf=hh.hhh/dd.ddd&skey=RA HTTP/1.0\n\n +nquery 3 + ra 0.00000 degrees %0.5f + dec 0.00000 degrees %0.5f + radius 0.100 degrees %0.03f +protocol http +type stext + hskip 26 + tskip 0 + recsize 0 + triml 1 + trimr 1 +nheader 1 + csystem J2000 +nfields 5 + id 1 0 c INDEF %12s + ra 2 0 r hours %12.3H + dec 3 0 r degrees %12.2h + bmag 4 0 r INDEF %7.3f + vmag 5 0 r INDEF %7.3f + +begin nomad@usno +address inet:80:www.nofs.navy.mil:text +query GET /cgi-bin/vo_cone.cgi?CAT=NOMAD&RA=%-s&DEC=%-s&SR=%-s&VERB=1&cftype=ASCII&slf=hh.hhh/dd.ddd&skey=RA HTTP/1.0\n\n +nquery 3 + ra 0.00000 degrees %0.5f + dec 0.00000 degrees %0.5f + radius 0.100 degrees %0.03f +protocol http +type stext + hskip 26 + tskip 0 + recsize 0 + triml 1 + trimr 1 +nheader 1 + csystem J2000 +nfields 15 + id 1 0 c INDEF %12s + ra 2 0 r degrees %12.3H + dec 3 0 r degrees %12.2h + sra 4 0 d milliarcsecs %3d + sde 5 0 d milliarcsecs %3d + mura 6 0 r INDEF %4.1f + mudec 7 0 r INDEF %4.1f + smura 8 0 r INDEF %4.1f + smude 9 0 r INDEF %4.1f + b 10 0 r INDEF %7.3f + v 11 0 r INDEF %7.3f + r 12 0 r INDEF %7.3f + j 13 0 r INDEF %7.3f + h 14 0 r INDEF %7.3f + k 15 0 r INDEF %7.3f + +begin act@usno +address inet:80:www.nofs.navy.mil:text +query GET /cgi-bin/vo_cone.cgi?CAT=ACT&RA=%-s&DEC=%-s&SR=%-s&VERB=1&cftype=ASCII&slf=hh.hhh/dd.ddd&skey=RA HTTP/1.0\n\n +nquery 3 + ra 0.00000 degrees %0.5f + dec 0.00000 degrees %0.5f + radius 0.100 degrees %0.03f +protocol http +type stext + hskip 26 + tskip 0 + recsize 0 + triml 1 + trimr 1 +nheader 1 + csystem J2000 +nfields 7 + id 1 0 c INDEF %12s + ra 2 0 r degrees %12.3H + dec 3 0 r degrees %12.2h + mura 4 0 r INDEF %4.1f + mudec 5 0 r INDEF %4.1f + b 6 0 r INDEF %7.3f + v 7 0 r INDEF %7.3f diff --git a/noao/astcat/lib/imdb.dat b/noao/astcat/lib/imdb.dat new file mode 100644 index 00000000..2d835e47 --- /dev/null +++ b/noao/astcat/lib/imdb.dat @@ -0,0 +1,106 @@ +# Initial cut at an astrometric image survey database file. The header keywords +# listed here are those that may be required to compute astrometric quantities, +# evalute an existing wcs, compute an initial guess wcs, find and locate +# objects, compute a plate solution, and update the image header. + +begin imname@noao +address +query +nquery 0 +type fits +wcs none +nwcs 0 +nkeys 0 + +begin ndwfs@noao +address inet:80:archive.noao.edu:text +query GET /ndwfs/cutout.php?ra=%-s&dec=%-s&rawidth=%-s&decwidth=%-s&filters=Bw HTTP/1.0\n\n +nquery 5 + ra 14:28:07.00 hours %0.2h + dec 34:55:00.0 degrees %0.1h + xwidth 10.0 minutes %0.1f + ywidth 10.0 minutes %0.1f + qsystem J2000.0 INDEF %s +protocol http +type fits +hskip 0 +wcs fits + +begin dss1@cadc +address inet:80:cadcwww.hia.nrc.ca:text +query GET /cadcbin/dss-server?ra=%-s&dec=%-s&mime-type=application/x-fits&x=%-s&y=%-s HTTP/1.0\n\n +nquery 5 + ra 00:00:00.00 hours %0.2h + dec +00:00:00.0 degrees %0.1h + xwidth 10.0 minutes %0.1f + ywidth 10.0 minutes %0.1f + qsystem J2000.0 INDEF %s +protocol http +type fits +hskip 0 +wcs dss +nwcs 10 + wxref INDEF INDEF d pixels + wyref INDEF INDEF d pixels + wxmag INDEF 1.701 d arcsec/pixel + wymag INDEF 1.701 d arcsec/pixel + wxrot INDEF 180.0 d degrees + wyrot INDEF 0.0 d degrees + wraref OBJCTRA INDEF d hms + wdecref OBJCTDEC INDEF d dms + wproj INDEF tan c INDEF + wsystem INDEF J2000 c INDEF +nkeys 13 + observat INDEF Palomar c INDEF + esitelng INDEF +116:51:46.80 d degrees + esitelat INDEF +33:21:21.6 d degrees + esitealt INDEF 1706 r meters + esitetz INDEF 8 r INDEF + emjdobs INDEF INDEF d INDEF + edatamin INDEF INDEF r ADU + edatamax INDEF INDEF r ADU + egain INDEF INDEF r e-/ADU + erdnoise INDEF INDEF r e- + ewavlen INDEF INDEF r angstroms + etemp INDEF INDEF r degrees + epress INDEF INDEF r mbars + + +begin dss2@cadc +address inet:80:cadcwww.hia.nrc.ca:text +query GET /cadcbin/xdss-server?ra=%-s&dec=%-s&mime-type=application/x-fits&x=%-s&y=%-s HTTP/1.0\n\n +nquery 5 + ra 00:00:00.00 hours %0.2h + dec +00:00:00.0 degrees %0.1h + xwidth 10.0 minutes %0.1f + ywidth 10.0 minutes %0.1f + qsystem J2000.0 INDEF %s +protocol http +type fits +hskip 0 +wcs dss +nwcs 10 + wxref INDEF INDEF d pixels + wyref INDEF INDEF d pixels + wxmag INDEF 1.009 d arcsec/pixel + wymag INDEF 1.009 d arcsec/pixel + wxrot INDEF 180.0 d degrees + wyrot INDEF 0.0 d degrees + wraref OBJCTRA INDEF d hms + wdecref OBJCTDEC INDEF d dms + wproj INDEF tan c INDEF + wsystem INDEF J2000 c INDEF +nkeys 13 + observat INDEF Palomar c INDEF + esitelng INDEF +116:51:46.80 d degrees + esitelat INDEF +33:21:21.6 d degrees + esitealt INDEF 1706 r meters + esitetz INDEF 8 r INDEF + emjdobs INDEF INDEF c INDEF + edatamin INDEF INDEF r ADU + edatamax INDEF INDEF r ADU + egain INDEF INDEF r e-/ADU + erdnoise INDEF INDEF r e- + ewavlen INDEF INDEF r angstroms + etemp INDEF INDEF r degrees + epress INDEF INDEF r mbars diff --git a/noao/astcat/lib/reg001.cat.1 b/noao/astcat/lib/reg001.cat.1 new file mode 100644 index 00000000..de683589 --- /dev/null +++ b/noao/astcat/lib/reg001.cat.1 @@ -0,0 +1,31 @@ +# BEGIN CATALOG HEADER +# catdb astcat$lib/catdb.dat +# catname usno2@noao +# nquery 4 +# ra 0:00:00.00 hours +# dec 10:00:00.0 degrees +# hwidth 2.5 minutes +# qsystem J2000.0 INDEF +# type stext +# nheader 1 +# csystem J2000.0 +# nfields 4 +# ra 1 0 d hours %12.3h +# dec 2 0 d degrees %12.2h +# mag1 3 0 r INDEF %4.1f +# mag2 4 0 r INDEF %4.1f +# END CATALOG HEADER +# +00:00:01.034 10:02:07.69 18.6 19.2 +00:00:02.230 10:02:05.36 19.4 20.1 +00:00:02.615 9:58:14.16 17.4 19.5 +00:00:06.452 10:01:42.01 13.6 14.8 +00:00:08.187 9:58:24.30 17.7 18.8 +00:00:08.602 9:59:50.80 11.9 12.7 +00:00:10.067 10:01:47.30 17.8 19.6 +23:59:53.772 9:57:41.77 15.8 18.1 +23:59:54.003 9:59:05.11 18.6 19.3 +23:59:56.052 9:58:23.12 17.0 18.9 +23:59:56.713 10:00:10.70 18.7 19.1 +23:59:58.477 9:57:56.94 17.7 19.5 +23:59:59.600 9:58:05.56 17.7 19.0 diff --git a/noao/astcat/lib/reg001.cat.2 b/noao/astcat/lib/reg001.cat.2 new file mode 100644 index 00000000..a8ab1f9f --- /dev/null +++ b/noao/astcat/lib/reg001.cat.2 @@ -0,0 +1,18 @@ +# BEGIN CATALOG HEADER +# catdb astcat$lib/catdb.dat +# catname usno2@noao +# nquery 4 +# ra 30:00:00.00 hours +# dec 10:00:00.0 degrees +# hwidth 2.5 minutes +# qsystem J2000.0 INDEF +# type stext +# nheader 1 +# csystem J2000.0 +# nfields 4 +# ra 1 0 d hours %12.3h +# dec 2 0 d degrees %12.2h +# mag1 3 0 r INDEF %4.1f +# mag2 4 0 r INDEF %4.1f +# END CATALOG HEADER +# diff --git a/noao/astcat/mkpkg b/noao/astcat/mkpkg new file mode 100644 index 00000000..cd925566 --- /dev/null +++ b/noao/astcat/mkpkg @@ -0,0 +1,9 @@ +# Make the ASTCAT package. + +$call update@src +$exit + +update: + $call update@src + ; + diff --git a/noao/astcat/src/acatpars.par b/noao/astcat/src/acatpars.par new file mode 100644 index 00000000..45735023 --- /dev/null +++ b/noao/astcat/src/acatpars.par @@ -0,0 +1,65 @@ +# The AICATPARS parameter file + +# The input catalog format parameter set. + +# Global parameters. The only global parameter at present is the +# input catalog celestial coordinate system parameter icatsystem. +# This is overridden by the contents of the icoosystem field. + +# Standard column / field definitions ... +# +# The column / field definitions are strings containing the following +# quantities in the case of type = text files. +# +# "column [units [format]]". +# +# The column is a required quantity. A column value of 0 means that the +# standard column is not present in the input catalog. If absent +# the units and format fields default to reasonable expected values. +# +# In the case of type = btext files the column / field definitions have +# the following format. +# +# "coloffset colsize [units [format]]" +# +# The coloffset and colsize are required quantities. An offset of 0 means +# that the standard column is not present in the input catalog. If absent +# The units and format fields default to reasonable expected values. + +ftype,s,h,"stext","|stext|btext|",,"The file format type" +csystem,s,h,"J2000",,,"The catalog coordinate system" + +id,s,h,"",,,"The id field" + +ra,s,h,"1 hours",,,"The ra / longitude field" +dec,s,h,"2 degrees",,,"The dec / latitude field" +era,s,h,"",,,"The ra / longitude error field" +edec,s,h,"",,,"The dec / latitude error field" + +pmra,s,h,"",,,"The ra / longitude proper motion field" +pmdec,s,h,"",,,"The dec / latitude proper motion field" +epmra,s,h,"",,,"The ra / longitude proper motion error field" +epmdec,s,h,"",,,"The dec / latitude proper motion error field" + +catsystem,s,h,"",,,"The catalog coordinate system field" +equinox,s,h,"",,,"The epoch of the equinox field" +epoch,s,h,"",,,"The epoch of the observation field" + +px,s,h,"",,,"The parallax field" +rv,s,h,"",,,"The radial velocity field" +epx,s,h,"",,,"The parallax error field" +erv,s,h,"",,,"The radial error velocity field" + +mag,s,h,"",,,"The magnitude field(s)" +color,s,h,"",,,"The color indices field(s)" +emag,s,h,"",,,"The magnitude error field(s)" +ecolor,s,h,"",,,"The color indices error field(s)" + +xp,s,h,"",,,"The predicted x coordinate field" +yp,s,h,"",,,"The predicted y coordinate field" +xc,s,h,"",,,"The measured x coordinate field" +yc,s,h,"",,,"The measured y coordinate field" +exc,s,h,"",,,"The measured x coordinate error field" +eyc,s,h,"",,,"The measured y coordinate error field" +imag,s,h,"",,,"The instrumental magnitude field(s)" +eimag,s,h,"",,,"The instrumental magnitude error field(s)" diff --git a/noao/astcat/src/aclist.par b/noao/astcat/src/aclist.par new file mode 100644 index 00000000..72e0ca61 --- /dev/null +++ b/noao/astcat/src/aclist.par @@ -0,0 +1,6 @@ +# The ACLIST parameter file. + +catalogs,s,a,"*",,,"The astrometric catalog(s)" +verbose,b,h,no,,,"Print verbose messages ?" +catdb,s,h,)_.catdb,,,"The astrometric catalog configuration file" +mode,s,h,"ql",,, diff --git a/noao/astcat/src/acqctest.par b/noao/astcat/src/acqctest.par new file mode 100644 index 00000000..1cd24e81 --- /dev/null +++ b/noao/astcat/src/acqctest.par @@ -0,0 +1,6 @@ +record,s,a,"usno2@noao",,,"Database record name" +ra,s,a,"12:12:12.00",,,"Ra in hours" +dec,s,a,"+12:12:12.0",,,"Dec in degrees" +width,r,a,10.0,,,Width in minutes +database,f,h,")_.catdb",,,"Catalog database file" +mode,s,h,"ql",,, diff --git a/noao/astcat/src/acqftest.par b/noao/astcat/src/acqftest.par new file mode 100644 index 00000000..e036a263 --- /dev/null +++ b/noao/astcat/src/acqftest.par @@ -0,0 +1,5 @@ +textfile,f,a,"",,,"Input astrometry text file" +record,s,a,"text",,,"Database record name" +database,s,h,")_.catdb",,,"The catalog database" +acatpars,pset,h,,,,"The catalog description parameter set" +mode,s,h,"ql",,, diff --git a/noao/astcat/src/acqitest.par b/noao/astcat/src/acqitest.par new file mode 100644 index 00000000..4acc90f2 --- /dev/null +++ b/noao/astcat/src/acqitest.par @@ -0,0 +1,7 @@ +record,s,a,"dss2@cadc",,,"Database record name" +image,s,a,"",,,"Output image name" +ra,s,a,"12:12:12.00",,,"Ra in hours" +dec,s,a,"+12:12:12.0",,,"Dec in degrees" +width,r,a,10.0,,,Width in minutes +database,f,a,")_.imdb",,,"Surveys database file" +mode,s,h,"ql",,, diff --git a/noao/astcat/src/adumpcat.par b/noao/astcat/src/adumpcat.par new file mode 100644 index 00000000..c508cc78 --- /dev/null +++ b/noao/astcat/src/adumpcat.par @@ -0,0 +1,7 @@ +catalog,s,a,"",,,"The astrometric catalog" +output,s,a,"",,,"The query results file" +ra,s,a,"00:00:00.0",,,"The field center ra / longitude" +dec,s,a,"+00:00:00",,,"The field center dec / latitude" +size,s,a,15.0,,,"The field size" +catdb,s,h,")_.catdb",,,"The catalog configuration file" +mode,s,h,"ql",,, diff --git a/noao/astcat/src/adumpim.par b/noao/astcat/src/adumpim.par new file mode 100644 index 00000000..9be409a1 --- /dev/null +++ b/noao/astcat/src/adumpim.par @@ -0,0 +1,7 @@ +imsurvey,s,a,dss2@cadc,,,"The input image survey" +output,s,a,"",,,"The output image" +ra,s,a,"00:00:00.0",,,"The field center ra / longitude" +dec,s,a,"+00:00:00",,,"The field center dec / latitude" +size,s,a,15.0,,,"The field size" +imdb,s,h,")_.imdb",,,"The image survey configuration file" +mode,s,h,"ql",,, diff --git a/noao/astcat/src/afiltcat.par b/noao/astcat/src/afiltcat.par new file mode 100644 index 00000000..025c8d41 --- /dev/null +++ b/noao/astcat/src/afiltcat.par @@ -0,0 +1,27 @@ +# The AFILTCAT parameter file. + +# The input and output catalog parameters. + +input,s,a,"",,,"The input catalogs(s)" +output,s,a,"",,,"The output catalogs(s)" +acatpars,pset,h,"",,,"The default catalog format parameters" + +# The astrometric catalog parameters. + +catalogs,s,h,filename@noao,,,"The input astrometric catalog" + +# The output catalog filtering parameters. + +standard,b,h,yes,,,Output a standard catalog ? +filter,b,h,yes,,,"Filter the output catalog ?" +afiltpars,pset,h,"",,,The catalog filtering parameters + +# The taskmode parameters + +update,b,h,no,,,"Update algorithm parameters at task termination ?" +verbose,b,h,yes,,,"Print task status messages ?" + +# The task configuration parameters. +catdb,s,h,)_.catdb,,,"The astrometric catalog configuration file" + +mode,s,h,"ql",,, diff --git a/noao/astcat/src/afiltpars.par b/noao/astcat/src/afiltpars.par new file mode 100644 index 00000000..fb89f814 --- /dev/null +++ b/noao/astcat/src/afiltpars.par @@ -0,0 +1,36 @@ +# The AFILTPARS parameter set. + +# Standard filtering options. Default is to select all fields in all records. + +# Sorting options. + +fsort,s,h,"",,,"The sort field or expression" +freverse,b,h,no,,,"Sort in descending order ?" + +# Record selection options. + +fexpr,s,h,"yes",,,"The record selection expression" + +# The output field parameters. + +fields,s,h,"f[*]",,,"The list of output fields and field expressions" +fnames,s,h,"",,,"The new field names list" +fntypes,s,h,"",,,"The new field datatype list" +fnunits,s,h,"",,,"The new field units list" +fnformats,s,h,"",,,"The new field format list" + +# Coordinate transformation options. + +fosystem,s,h,"",,,"The filtered output celestial coordinate system" +fira,s,h,"ra",,,"Field containing the ra / longitude" +fidec,s,h,"dec",,,"Field containing the dec / latitude" +foraunits,s,h,"",,,"The filtered output ra / longitude units" +fodecunits,s,h,"",,, "The filtered ouput dec / latitude units" +foraformat,s,h,"",,,"The filtered output ra / longitude format" +fodecformat,s,h,"",,,"The filtered output dec / latitude format" +fixp,s,h,"xp",,,"Field containing the predicted x coordinate" +fiyp,s,h,"yp",,,"Field containing the predicted y coordinate" +fixc,s,h,"xc",,,"Field containing the centered x coordinate" +fiyc,s,h,"yc",,,"Field containing the centered y coordinate" +foxformat,s,h,"%10.3f",,,"The filtered output x coordinate format" +foyformat,s,h,"%10.3f",,,"The filtered output y coordinate format" diff --git a/noao/astcat/src/agetcat.par b/noao/astcat/src/agetcat.par new file mode 100644 index 00000000..f118ee3d --- /dev/null +++ b/noao/astcat/src/agetcat.par @@ -0,0 +1,28 @@ +# The AGETCAT parameter file. + +# The field center parameters. + +regions,s,a,"pars",,,"The regions list (pars,file,images)" +output,s,a,"default",,,"The output astrometry file(s)" +aregpars,pset,h,"",,,"The default field center parameters" + +# The astrometric catalog parameters. + +catalogs,s,h,)_.catalogs,,,"The astrometric catalog(s)" + +# The output catalog filtering parameters. + +standard,b,h,yes,,,Output a standard astrometry file ? +filter,b,h,no,,,"Filter the output astrometry file ?" +afiltpars,pset,h,"",,,The astrometry file filtering parameters + +# The task mode parameters + +update,b,h,no,,,"Update algorithm parameters at task termination ?" +verbose,b,h,yes,,,"Print task messages ?" + +# The task configuration parameters. + +catdb,s,h,)_.catdb,,,"The astrometric catalog configuration file" + +mode,s,h,"ql",,, diff --git a/noao/astcat/src/agetcat/atcatinit.x b/noao/astcat/src/agetcat/atcatinit.x new file mode 100644 index 00000000..04e9dff6 --- /dev/null +++ b/noao/astcat/src/agetcat/atcatinit.x @@ -0,0 +1,167 @@ + +# AT_AGINIT -- Inititialize the AGETCAT task structure. + +procedure at_aginit (at) + +pointer at #O the pointer to the astrometry descriptor + +begin + # Initialize the astrometry structure. + call at_ainit (at) + + # Initialize the i/o structure. + call at_ioinit (at) + + # Initialize the region definition structure. + call at_rcinit (at) + + # Initialize the filtering / selection structure. + call at_fsinit (at) +end + + +# AT_AGFREE -- Free the AGETCAT task structure. + +procedure at_agfree (at) + +pointer at #U the pointer to the astrometry descriptor + +begin + # Free the filtering / selection structure. + call at_fsfree (at) + + # Free the field center structure. + call at_rcfree (at) + + # Free the i/o structure + call at_iofree (at) + + # Free the astrometry structure. + call at_afree (at) +end + + +# AT_AFINIT -- Inititialize the AFILTCAT task structure. + +procedure at_afinit (at) + +pointer at #O the pointer to the astrometry descriptor + +begin + # Initialize the astrometry structure. + call at_ainit (at) + + # Initialize the i/o structure. + call at_ioinit (at) + + # Initialize the filtering / selection structure. + call at_fsinit (at) +end + + +# AT_AFFREE -- Free the AFILTCAT task structure. + +procedure at_affree (at) + +pointer at #U the pointer to the astrometry descriptor + +begin + # Free the filtering / selection structure. + call at_fsfree (at) + + # Free the i/o structure + call at_iofree (at) + + # Free the astrometry structure. + call at_afree (at) +end + + +# AT_AIGINIT -- Inititialize the agetim task structure. + +procedure at_aiginit (at) + +pointer at #O the pointer to the astrometry descriptor + +begin + # Initialize the astrometry structure. + call at_ainit (at) + + # Initialize the i/o structure. + call at_ioinit (at) + + # Initialize the region definition structure. + call at_rcinit (at) + + # Initialize the default wcs structure. + #call at_wcinit (at) + + # Initialize the default image data structure. + #call at_iminit (at) +end + + +# AT_AIGFREE -- Free the agetim task structure. + +procedure at_aigfree (at) + +pointer at #U the pointer to the astrometry descriptor + +begin + # Free the default image data structure. + #call at_imfree (at) + + # Free the default wcs structure. + #call at_wcfree (at) + + # Free the field center structure. + call at_rcfree (at) + + # Free the i/o structure + call at_iofree (at) + + # Free the astrometry structure. + call at_afree (at) +end + + +# AT_AHINIT -- Inititialize the AHEDIT task structure. + +procedure at_ahinit (at) + +pointer at #O the pointer to the astrometry descriptor + +begin + # Initialize the astrometry structure. + call at_ainit (at) + + # Initialize the i/o structure. + call at_ioinit (at) + + # Initialize the default wcs structure. + call at_wcinit (at) + + # Initialize the default image data structure. + call at_iminit (at) +end + + +# AT_AHFREE -- Free the AHEDIT task structure. + +procedure at_ahfree (at) + +pointer at #U the pointer to the astrometry descriptor + +begin + # Free the default image data structure. + call at_imfree (at) + + # Free the default wcs structure. + call at_wcfree (at) + + # Free the i/o structure + call at_iofree (at) + + # Free the astrometry structure. + call at_afree (at) +end diff --git a/noao/astcat/src/agetcat/atfcat.x b/noao/astcat/src/agetcat/atfcat.x new file mode 100644 index 00000000..b2265688 --- /dev/null +++ b/noao/astcat/src/agetcat/atfcat.x @@ -0,0 +1,1986 @@ +include <ctotok.h> +include <ctype.h> +include <evvexpr.h> +include <imhdr.h> +include <pkg/cq.h> +include <pkg/skywcs.h> +include "../../lib/astrom.h" +include "../../lib/acatalog.h" + +############################################################################## + +# Create a small data structure to describe the field list. Decide whether +# this should be part of the main astrometry package structure later ... + +define FL_FLENGTH 12 + +define FL_NEXPR Memi[$1] # The number of input expressions +define FL_NFIELDS Memi[$1+1] # The number of output fields + +# The field list decription +define FL_FLIST Memi[$1+2] # The list of field expressions +define FL_FRANGES Memi[$1+3] # The list of field ranges + +# New quantities to be written in the header (could be a symbol table ...) +define FL_FNAMES Memi[$1+4] # The list of field names +define FL_FOFFSETS Memi[$1+5] # The list of field offsets +define FL_FSIZES Memi[$1+6] # The list of field sizes +define FL_FTYPES Memi[$1+7] # The list of field types +define FL_FUNITS Memi[$1+8] # The list of field units +define FL_FFMTS Memi[$1+9] # The list of field formats + +# Useful constants +define FL_MAX_NEXPR 20 +define FL_MAX_NFIELDS 100 +define FL_SZ_EXPR SZ_LINE + +############################################################################## + +# AT_WIFILRECS -- Filter and write the output catalog. + +procedure at_wifilrecs (fd, im, at, res, standard) + +int fd #I the output file descriptor +pointer im #I the associated input image descriptor +pointer at #I the astrometry package descriptor +pointer res #I results descriptor +bool standard #I write a standard catalog header + +double raval, decval, oraval, odecval, iraval, idecval, xpval, ypval +pointer sp, sexpr, sfield, record, raname, decname, sindex +pointer flist, o, catcoo, outcoo, imcoo, mwim, ct +int i, nlines, nrecs, rafield, decfield, xpfield, ypfield, xcfield, ycfield +pointer at_flinit(), evvexpr(), locpr(), mw_sctran() +int at_wfcathdr(), cq_rstati(), at_srtcat(), at_flnexpr(), cq_grecord() +int cq_setrecord(), at_wcathdr(), at_mkrecord(), cq_gvald() +bool streq() +extern at_getop() + +int nchars + +begin + call smark (sp) + call salloc (sexpr, FL_SZ_EXPR, TY_CHAR) + call salloc (sfield, FL_SZ_EXPR, TY_CHAR) + call salloc (record, SZ_LINE, TY_CHAR) + call salloc (raname, FL_SZ_EXPR, TY_CHAR) + call salloc (decname, FL_SZ_EXPR, TY_CHAR) + + # Initialize the catalog, output, and image coordinate systems. + # and set up the image world to logical coordinate transformation. + call at_cowcs (at, res, im, catcoo, outcoo, imcoo, mwim) + if (imcoo != NULL) + ct = mw_sctran (mwim, "world", "logical", 03B) + + # Determine whether it is necessary to reformat. + call at_stats (at, FIELDS, Memc[record], SZ_LINE) + if (streq (Memc[record], "f[*]") && outcoo == NULL) { + + # The field list is NULL. + flist = NULL + + # Write the filtered catalog header. + if (standard) + nlines = at_wcathdr (fd, res) + + # Coordinate fields are not modified. + rafield = 0 + decfield = 0 + xpfield = 0 + ypfield = 0 + xcfield = 0 + ycfield = 0 + + } else { + + # Decode the output field list. + flist = at_flinit (at, res) + + # Write the filtered catalog header. + if (standard) + nlines = at_wfcathdr (fd, at, res, flist) + + # Get the offsets for the ra, dec, xp, yp, xc, and yc output fields. + call at_coofields (at, res, flist, Memc[raname], Memc[decname], + rafield, decfield, xpfield, ypfield, xcfield, ycfield) + if (outcoo == NULL) { + rafield = 0 + decfield = 0 + } + if (imcoo == NULL) { + xpfield = 0 + ypfield = 0 + } + xcfield = 0 + ycfield = 0 + } + + # Compute the sort index. + nrecs = cq_rstati (res, CQRNRECS) + call malloc (sindex, nrecs, TY_INT) + nrecs = at_srtcat (at, res, Memi[sindex], nrecs) + + # Get the selection expression and replace generic selection expression + # field names with their catalog equivalents. + call at_stats (at, FEXPR, Memc[sexpr], FL_SZ_EXPR) + i = 1 + if (at_flnexpr (res, Memc[sexpr], i, Memc[sfield], FL_SZ_EXPR) == EOF) + Memc[sfield] = EOS + + # Loop over the sorted records. Note that any reference to + # coordinates in the selection expression refers to the original + # not the transformed coordinates. + + o = NULL + do i = 1, nrecs { + + # Reject every record. + if (streq (Memc[sfield], "no")) + next + + # Evaluate the selection expression. + if (! streq (Memc[sfield], "yes")) { + if (cq_setrecord (res, Memi[sindex+i-1]) != Memi[sindex+i-1]) + next + if (o != NULL) + call evvfree (o) + o = evvexpr (Memc[sfield], locpr (at_getop), res, 0, res, 0) + if (O_TYPE(o) != TY_BOOL) + next + if (O_VALI(o) == NO) + next + } + + # Write the record. + if (flist == NULL) { + + # Copy the record. + nchars = cq_grecord (res, Memc[record], SZ_LINE, + Memi[sindex+i-1]) + + } else { + + # Get the ra and dec fields. + raval = INDEFD + decval = INDEFD + if (outcoo != NULL || imcoo != NULL) { + if (cq_gvald (res, Memi[sindex+i-1], Memc[raname], + raval) <= 0) + raval = INDEFD + if (cq_gvald (res, Memi[sindex+i-1], Memc[decname], + decval) <= 0) + decval = INDEFD + } + + # Transform the catalog coordinates to the output coordinate + # system. + oraval = INDEFD + odecval = INDEFD + if (outcoo != NULL && (rafield > 0 || decfield > 0)) { + if (! IS_INDEFD(raval) && ! IS_INDEFD(decval)) + call sk_ultran (catcoo, outcoo, raval, decval, oraval, + odecval, 1) + } + + # Transform the catalog coordinates to the image coordinate + # system and then to the image pixel coordinate system. + xpval = INDEFD + ypval = INDEFD + if (imcoo != NULL && (xpfield > 0 || ypfield > 0)) { + if (! IS_INDEFD(raval) && ! IS_INDEFD(decval)) { + call sk_ultran (catcoo, imcoo, raval, decval, iraval, + idecval, 1) + call mw_c2trand (ct, iraval, idecval, xpval, ypval) + if (xpval < 0.5d0 || xpval > (IM_LEN(im,1)+0.5d0) || + ypval < 0.5d0 || ypval > (IM_LEN(im,2)+0.5d0)) + next + } else { + xpval = INDEFD + ypval = INDEFD + } + } + + # Reformat the record. + nchars = at_mkrecord (flist, res, Memc[record], SZ_LINE, + Memi[sindex+i-1], rafield, decfield, oraval, odecval, + xpfield, ypfield, xpval, ypval) + + } + + # Write the new record. + if (nchars > 0) { + call fprintf (fd, "%s") + call pargstr (Memc[record]) + } + } + + # Free the selection expression descriptor. + if (o != NULL) + call evvfree (o) + + # Free the catalog, output, and image coordinate system descriptors. + if (catcoo != NULL) + call sk_close (catcoo) + if (outcoo != NULL) + call sk_close (outcoo) + if (imcoo != NULL) + call sk_close (imcoo) + if (mwim != NULL) + call mw_close (mwim) + + # Free output field list. + if (flist != NULL) + call at_flfree (flist) + + # Free thesort index descriptor. + call mfree (sindex, TY_INT) + + call sfree (sp) +end + + +# AT_WFILRECS -- Filter and write the output catalog. + +procedure at_wfilrecs (fd, at, res, standard) + +int fd #I the output file descriptor +pointer at #I the astrometry package descriptor +pointer res #I results descriptor +bool standard #I write a standard catalog header + +double raval, decval, oraval, odecval, iraval, idecval, xpval, ypval +pointer sp, sexpr, sfield, record, raname, decname, sindex +pointer flist, o, catcoo, outcoo, imcoo, mwim, ct +int i, nlines, nrecs, rafield, decfield, xpfield, ypfield, xcfield, ycfield +pointer at_flinit(), evvexpr(), locpr(), mw_sctran() +int at_wfcathdr(), cq_rstati(), at_srtcat(), at_flnexpr(), cq_grecord() +int cq_setrecord(), at_wcathdr(), at_mkrecord(), cq_gvald() +bool streq() +extern at_getop() + +int nchars + +begin + call smark (sp) + call salloc (sexpr, FL_SZ_EXPR, TY_CHAR) + call salloc (sfield, FL_SZ_EXPR, TY_CHAR) + call salloc (record, SZ_LINE, TY_CHAR) + call salloc (raname, FL_SZ_EXPR, TY_CHAR) + call salloc (decname, FL_SZ_EXPR, TY_CHAR) + + # Initialize the catalog, output, and field coordinate systems + # and set up the image world to logical coordinate transformation. + call at_cowcs (at, res, NULL, catcoo, outcoo, imcoo, mwim) + if (imcoo != NULL) + ct = mw_sctran (mwim, "world", "logical", 03B) + + # Determine whether it is necessary to reformat. + call at_stats (at, FIELDS, Memc[record], SZ_LINE) + if (streq (Memc[record], "f[*]") && outcoo == NULL) { + + # The field list is NULL. + flist = NULL + + # Write the filtered catalog header. + if (standard) + nlines = at_wcathdr (fd, res) + + # Coordinate fields are not altered. + rafield = 0 + decfield = 0 + xpfield = 0 + ypfield = 0 + xcfield = 0 + ycfield = 0 + + } else { + + # Decode the output field list. + flist = at_flinit (at, res) + + # Write the filtered catalog header. + if (standard) + nlines = at_wfcathdr (fd, at, res, flist) + + # Get the offsets for the ra, dec, xp, yp, xc, and yc output fields. + call at_coofields (at, res, flist, Memc[raname], Memc[decname], + rafield, decfield, xpfield, ypfield, xcfield, ycfield) + if (outcoo == NULL) { + rafield = 0 + decfield = 0 + } + if (imcoo == NULL) { + xpfield = 0 + ypfield = 0 + } + xcfield = 0 + ycfield = 0 + } + + # Compute the sort index. + nrecs = cq_rstati (res, CQRNRECS) + call malloc (sindex, nrecs, TY_INT) + nrecs = at_srtcat (at, res, Memi[sindex], nrecs) + + # Get the selection expression and replace generic selection expression + # field names with their catalog equivalents. + call at_stats (at, FEXPR, Memc[sexpr], FL_SZ_EXPR) + i = 1 + if (at_flnexpr (res, Memc[sexpr], i, Memc[sfield], FL_SZ_EXPR) == EOF) + Memc[sfield] = EOS + + # Loop over the sorted records. Note that any reference to + # coordinates in the selection expression refers to the original + # not the transformed coordinates. + + o = NULL + do i = 1, nrecs { + + # Reject every record. + if (streq (Memc[sfield], "no")) + next + + # Evaluate the selection expression. + if (! streq (Memc[sfield], "yes")) { + if (cq_setrecord (res, Memi[sindex+i-1]) != Memi[sindex+i-1]) + next + if (o != NULL) + call evvfree (o) + o = evvexpr (Memc[sfield], locpr (at_getop), res, 0, res, 0) + if (O_TYPE(o) != TY_BOOL) + next + if (O_VALI(o) == NO) + next + } + + # Write the record. + if (flist == NULL) { + + # Copy the record. + nchars = cq_grecord (res, Memc[record], SZ_LINE, + Memi[sindex+i-1]) + + } else { + + # Get the ra and dec fields. + raval = INDEFD + decval = INDEFD + if (outcoo != NULL || imcoo != NULL) { + if (cq_gvald (res, Memi[sindex+i-1], Memc[raname], + raval) <= 0) + raval = INDEFD + if (cq_gvald (res, Memi[sindex+i-1], Memc[decname], + decval) <= 0) + decval = INDEFD + } + + # Transform the catalog coordinates to the output coordinate + # system. + oraval = INDEFD + odecval = INDEFD + if (outcoo != NULL && (rafield > 0 || decfield > 0)) { + if (! IS_INDEFD(raval) && ! IS_INDEFD(decval)) + call sk_ultran (catcoo, outcoo, raval, decval, oraval, + odecval, 1) + } + + # Transform the catalog coordinates to the image coordinate + # system and then to the image pixel coordinate system. + xpval = INDEFD + ypval = INDEFD + if (imcoo != NULL && (xpfield > 0 || ypfield > 0)) { + if (! IS_INDEFD(raval) && ! IS_INDEFD(decval)) { + call sk_ultran (catcoo, imcoo, raval, decval, iraval, + idecval, 1) + call mw_c2trand (ct, iraval, idecval, xpval, ypval) + } else { + xpval = INDEFD + ypval = INDEFD + } + } + + # Reformat the record. + nchars = at_mkrecord (flist, res, Memc[record], SZ_LINE, + Memi[sindex+i-1], rafield, decfield, oraval, odecval, + xpfield, ypfield, xpval, ypval) + + } + + # Write the new record. + if (nchars > 0) { + call fprintf (fd, "%s") + call pargstr (Memc[record]) + } + } + + # Free the selection expression descriptor. + if (o != NULL) + call evvfree (o) + + # Free the catalog, output, and field coordinate system descriptors. + if (catcoo != NULL) + call sk_close (catcoo) + if (outcoo != NULL) + call sk_close (outcoo) + if (imcoo != NULL) + call sk_close (imcoo) + if (mwim != NULL) + call mw_close (mwim) + + # Free output field list. + if (flist != NULL) + call at_flfree (flist) + + # Free thesort index descriptor. + call mfree (sindex, TY_INT) + + call sfree (sp) +end + + +# AT_FCATHDR -- Write the filtered catalog header + +int procedure at_wfcathdr (fd, at, res, fl) + +int fd #I the output file descriptor +pointer at #I the astrometry pacakge descriptor +pointer res #I the results descriptor descriptor +pointer fl #I the output field list descriptor + +pointer sp, catname, qpnames, qpvalues, qpunits, fname, fvalue, funits +int i, nlines, nfields +int cq_rstati(), at_wrdstr(), cq_hinfon() +char cq_itype() +bool streq(), strne() + +begin + nlines = 0 + + # Allocate working space. + call smark (sp) + call salloc (catname, SZ_FNAME, TY_CHAR) + call salloc (qpnames, SZ_LINE, TY_CHAR) + call salloc (qpvalues, SZ_LINE, TY_CHAR) + call salloc (qpunits, SZ_LINE, TY_CHAR) + call salloc (fname, CQ_SZ_QPNAME, TY_CHAR) + call salloc (fvalue, CQ_SZ_QPVALUE, TY_CHAR) + call salloc (funits, CQ_SZ_QPUNITS, TY_CHAR) + + # Write the header banner. + call fprintf (fd, "# BEGIN CATALOG HEADER\n") + nlines = nlines + 1 + + # Write the catalog database and id. + call cq_rstats (res, CQRCATDB, Memc[catname], SZ_FNAME) + call fprintf (fd, "# catdb %s\n") + call pargstr (Memc[catname]) + nlines = nlines + 1 + call cq_rstats (res, CQRCATNAME, Memc[catname], SZ_FNAME) + call fprintf (fd, "# catname %s\n") + call pargstr (Memc[catname]) + nlines = nlines + 1 + + # Write out the query parameter names, values, and units used + # to generate the catalog. + call cq_rstats (res, CQRQPNAMES, Memc[qpnames], SZ_LINE) + call cq_rstats (res, CQRQPVALUES, Memc[qpvalues], SZ_LINE) + call cq_rstats (res, CQRQPUNITS, Memc[qpunits], SZ_LINE) + nfields = cq_rstati (res, CQRNQPARS) + call fprintf (fd, "# nquery %d\n") + call pargi (nfields) + nlines = nlines + 1 + do i = 1, nfields { + if (at_wrdstr (i, Memc[fname], CQ_SZ_QPNAME, Memc[qpnames]) != i) + ; + if (at_wrdstr (i, Memc[fvalue], CQ_SZ_QPVALUE, Memc[qpvalues]) != i) + ; + if (at_wrdstr (i, Memc[funits], CQ_SZ_QPUNITS, Memc[qpunits]) != i) + ; + call fprintf (fd, "# %s %s %s\n") + call pargstr (Memc[fname]) + call pargstr (Memc[fvalue]) + call pargstr (Memc[funits]) + nlines = nlines + 1 + } + + # Write out the results format type. + if (at_wrdstr (cq_rstati(res, CQRTYPE), Memc[fvalue], CQ_SZ_QPVALUE, + CQ_RTYPESTR) <= 0) + call strcpy ("stext", Memc[fvalue], CQ_SZ_QPVALUE) + call fprintf (fd, "# type %s\n") + call pargstr (Memc[fvalue]) + nlines = nlines + 1 + + # Write out the header parameters, + nfields = cq_rstati (res, CQNHEADER) + call fprintf (fd, "# nheader %d\n") + call pargi (nfields) + nlines = nlines + 1 + do i = 1, nfields { + if (cq_hinfon (res, i, Memc[fname], CQ_SZ_QPNAME, Memc[fvalue], + CQ_SZ_QPVALUE) != i) + next + + # Check for a changed coordinate system here + if (streq ("csystem", Memc[fname])) { + call at_stats (at, FOSYSTEM, Memc[qpvalues], SZ_LINE) + if (Memc[qpvalues] != EOS && strne (Memc[qpvalues], + Memc[fvalue])) + call strcpy (Memc[qpvalues], Memc[fvalue], CQ_SZ_QPVALUE) + } + + call fprintf (fd, "# %s %s\n") + call pargstr (Memc[fname]) + call pargstr (Memc[fvalue]) + nlines = nlines + 1 + } + + # Write out the field desription. + nfields = FL_NFIELDS(fl) + call fprintf (fd, "# nfields %d\n") + call pargi (nfields) + do i = 0, nfields - 1 { + call fprintf (fd, "# %s %d %d %c %s %s\n") + call pargstr (Memc[FL_FNAMES(fl)+i*(CQ_SZ_QPNAME+1)]) + call pargi (Memi[FL_FOFFSETS(fl)+i]) + call pargi (Memi[FL_FSIZES(fl)+i]) + call pargc (cq_itype (Memi[FL_FTYPES(fl)+i])) + call pargstr (Memc[FL_FUNITS(fl)+i*(CQ_SZ_QPUNITS+1)]) + call pargstr (Memc[FL_FFMTS(fl)+i*(CQ_SZ_QPFMTS+1)]) + nlines = nlines + 1 + } + + # Write the header trailer. + call fprintf (fd, "# END CATALOG HEADER\n#\n") + nlines = nlines + 1 + + call sfree (sp) + + return (nlines) +end + + +# AT_SRTCAT -- Sort the catalog on the user specified field. + +int procedure at_srtcat (at, res, sindex, max_nrecs) + +pointer at #I the astrometry package descriptor +pointer res #I results descriptor +int sindex[ARB] #O the output sort index +int max_nrecs #I the maximum number of records + +double dval +pointer sp, sexpr, sfield, sname, sval, darray, carray, o +int i, ip, nrecs, stype, snum, nchars, sz_carray +pointer evvexpr(), locpr() +int ctotok(), cq_fnumber(), cq_ftype(), cq_fname(), ctoi(), cq_gvald() +int cq_gvalc(), gstrcpy(), cq_setrecord(), at_flnexpr(), at_stati() +bool streq() +extern at_getop() + +begin + call smark (sp) + call salloc (sexpr, FL_SZ_EXPR, TY_CHAR) + call salloc (sfield, FL_SZ_EXPR, TY_CHAR) + call salloc (sname, CQ_SZ_QPNAME, TY_CHAR) + call salloc (sval, SZ_LINE, TY_CHAR) + + # Get the sort expression. + call at_stats (at, FSORT, Memc[sexpr], FL_SZ_EXPR) + i = 1 + if (at_flnexpr (res, Memc[sexpr], i, Memc[sfield], FL_SZ_EXPR) == EOF) + Memc[sfield] = EOS + + # Return initialized index array if the sort expression is undefined. + if (Memc[sfield] == EOS) { + do i = 1, max_nrecs + sindex[i] = i + call sfree (sp) + return (max_nrecs) + } + + # Determine the type of sort. If sfield and sname are identical + # sort expression is a field, otherwise it is an expression which + # must be evaluated. + ip = 1 + if (ctotok (Memc[sfield], ip, Memc[sname], CQ_SZ_QPNAME) == + TOK_IDENTIFIER) + ; + + # Initialize the sort index array. + do i = 1, max_nrecs + sindex[i] = i + + # The sort expression is a simple field. + if (streq (Memc[sfield], Memc[sname])) { + + if (cq_fnumber (res, Memc[sfield]) > 0) { # Catalog field name + stype = cq_ftype (res, Memc[sfield]) + } else if (Memc[sfield] == 'f') { # Generic f# name + ip = 2 + if (ctoi (Memc[sfield], ip, snum) <= 0) + stype = INDEFI + else if (cq_fname (res, snum, Memc[sname], CQ_SZ_FNAME) <= 0) + stype = INDEFI + else + stype = cq_ftype (res, Memc[sname]) + } else { # Unknown name. + stype = INDEFI + } + + # Do the sort. + if (IS_INDEFI(stype)) { # Field is undecodable. + nrecs = max_nrecs + + } else if (stype == TY_CHAR) { # Character sort. + sz_carray = 10 * SZ_LINE + call malloc (carray, sz_carray, TY_CHAR) + ip = 1 + do i = 1, max_nrecs { + nchars = cq_gvalc (res, i, Memc[sname], Memc[sval], + SZ_LINE) + if (nchars > sz_carray - ip + 1) { + sz_carray = sz_carray + 10 * SZ_LINE + call realloc (carray, sz_carray, TY_CHAR) + } + sindex[i] = ip + ip = ip + gstrcpy (Memc[sval], Memc[carray+ip-1], nchars) + Memc[carray+ip-1] = EOS + ip = ip + 1 + } + call at_ssquick (Memc[carray], sindex, sindex, max_nrecs) + call mfree (carray, TY_CHAR) + nrecs = max_nrecs + + } else { # Numeric sort. + call malloc (darray, max_nrecs, TY_DOUBLE) + do i = 1, max_nrecs { + nchars = cq_gvald (res, i, Memc[sname], dval) + if (nchars <= 0) + Memd[darray+i-1] = INDEFD + else + Memd[darray+i-1] = dval + } + call at_qsortd (Memd[darray], sindex, sindex, max_nrecs) + call mfree (darray, TY_DOUBLE) + nrecs = max_nrecs + } + + # The sort field is an expression which must be evaluated. + } else { + + # Determine the data type of the output from the first record. + if (cq_setrecord (res, 1) != 1) + ; + o = evvexpr (Memc[sfield], locpr (at_getop), res, 0, res, 0) + stype = O_TYPE(o) + call evvfree (o) + + if (stype == 0) # Expression cannot be decoded. + nrecs = max_nrecs + else if (stype == TY_CHAR || stype == TY_BOOL) { + sz_carray = 10 * SZ_LINE + call malloc (carray, sz_carray, TY_CHAR) + ip = 1 + do i = 1, max_nrecs { + if (cq_setrecord (res, i) != i) + break + o = evvexpr (Memc[sfield], locpr (at_getop), res, 0, res, 0) + if (O_LEN(o) > sz_carray - ip + 1) { + sz_carray = sz_carray + 10 * SZ_LINE + call realloc (carray, sz_carray, TY_CHAR) + } + sindex[i] = ip + ip = ip + gstrcpy (O_VALC(o), Memc[carray+ip-1], O_LEN(o)) + Memc[carray+ip-1] = EOS + ip = ip + 1 + call evvfree (o) + } + + call at_ssquick (Memc[carray], sindex, sindex, max_nrecs) + call mfree (carray, TY_CHAR) + nrecs = max_nrecs + } else { + call malloc (darray, max_nrecs, TY_DOUBLE) + do i = 1, max_nrecs { + if (cq_setrecord (res, i) != i) + break + o = evvexpr (Memc[sfield], locpr (at_getop), res, 0, res, 0) + switch (O_TYPE(o)) { + case TY_SHORT: + dval = O_VALS(o) + case TY_INT: + dval = O_VALI(o) + case TY_LONG: + dval = O_VALL(o) + case TY_REAL: + dval = O_VALR(o) + case TY_DOUBLE: + dval = O_VALD(o) + default: + dval = INDEFD + } + Memd[darray+i-1] = dval + call evvfree (o) + } + call at_qsortd (Memd[darray], sindex, sindex, max_nrecs) + call mfree (darray, TY_DOUBLE) + nrecs = max_nrecs + } + + } + + # Flip the index array if the sense of the sort is reversed. + if (at_stati (at, FREVERSE) == YES) { + do i = 1, nrecs / 2 { + ip = sindex[i] + sindex[i] = sindex[nrecs-i+1] + sindex[nrecs-i+1] = ip + } + } + + call sfree (sp) + + return (nrecs) +end + + +# AT_COWCS -- Initialize the catalog and output coordinate system +# descriptors. + +procedure at_cowcs (at, res, im, catcoo, outcoo, imcoo, mwim) + +pointer at #I the astrometry package descriptor +pointer res #I the catalog results descriptor +pointer im #I the associated image descriptor +pointer catcoo #O the output catalog system descriptor +pointer outcoo #O the output output system descriptor +pointer imcoo #O the output image system descriptor +pointer mwim #O the output image mwcs descriptor + +pointer sp, csystem, cfield, fra, fdec, mw +int i, catstat, outstat, imstat +int cq_hinfo(), sk_decwcs(), strdic(), at_wrdstr(), sk_stati() +int at_stati(), sk_decim() + +begin + call smark (sp) + call salloc (csystem, SZ_LINE, TY_CHAR) + call salloc (cfield, SZ_LINE, TY_CHAR) + call salloc (fra, SZ_FNAME, TY_CHAR) + call salloc (fdec, SZ_FNAME, TY_CHAR) + + # Get the catalog system. + if (cq_hinfo (res, "csystem", Memc[csystem], SZ_LINE) <= 0) + call strcpy ("", Memc[csystem], SZ_LINE) + + # Open the catalog system. + catstat = sk_decwcs (Memc[csystem], mw, catcoo, NULL) + if (catstat == ERR || mw != NULL) { + #call eprintf ( + #"Error: Cannot decode the catalog coordinate system\n") + if (mw != NULL) + call mw_close (mw) + call sk_close (catcoo) + catcoo = NULL + imcoo = NULL + outcoo = NULL + call sfree (sp) + return + } + + + # Get and set the ra catalog coordinate units. + call at_stats (at, FIRA, Memc[fra], SZ_FNAME) + call cq_funits (res, Memc[fra], Memc[cfield], SZ_LINE) + i = strdic (Memc[cfield], Memc[cfield], SZ_LINE, SKY_LNG_UNITLIST) + if (i > 0) + call sk_seti (catcoo, S_NLNGUNITS, i) + + # Get and set the dec catalog coordinate units. + call at_stats (at, FIDEC, Memc[fdec], SZ_FNAME) + call cq_funits (res, Memc[fdec], Memc[cfield], SZ_LINE) + i = strdic (Memc[cfield], Memc[cfield], SZ_LINE, SKY_LAT_UNITLIST) + if (i > 0) + call sk_seti (catcoo, S_NLATUNITS, i) + + # Open the output coordinate system if the output coordinate system is + # different from the catalog coordinate system or the units are + # different. + call at_stats (at, FOSYSTEM, Memc[csystem], SZ_LINE) + if (Memc[csystem] != EOS || at_stati(at,FORAUNITS) > 0 || at_stati(at, + FODECUNITS) > 0) { + + if (Memc[csystem] == EOS) + outstat = sk_decwcs (Memc[csystem], mw, outcoo, catcoo) + else + outstat = sk_decwcs (Memc[csystem], mw, outcoo, NULL) + + if (outstat == ERR || mw != NULL) { + #call eprintf ( + #"Error: Cannot decode the output coordinate system\n") + if (mw != NULL) + call mw_close (mw) + call sk_close (outcoo) + outcoo = NULL + } else { + + # Set the output catalog ra units. + i = at_stati (at, FORAUNITS) + if (i <= 0) { + Memc[cfield] = EOS + } else if (at_wrdstr (i, Memc[cfield], SZ_LINE, + AT_RA_UNITS) <= 0) { + Memc[cfield] = EOS + } + if (Memc[cfield] == EOS) { + call sk_seti (outcoo, S_NLNGUNITS, sk_stati (catcoo, + S_NLNGUNITS)) + } else { + i = strdic (Memc[cfield], Memc[cfield], FL_SZ_EXPR, + SKY_LNG_UNITLIST) + if (i > 0) + call sk_seti (outcoo, S_NLNGUNITS, i) + else + call sk_seti (outcoo, S_NLNGUNITS, sk_stati(catcoo, + S_NLNGUNITS)) + } + + # Set the output catalog dec units. + i = at_stati (at, FODECUNITS) + if (i <= 0) { + Memc[cfield] = EOS + } else if (at_wrdstr (i, Memc[cfield], SZ_LINE, + AT_DEC_UNITS) <= 0) { + Memc[cfield] = EOS + } + if (Memc[cfield] == EOS) { + call sk_seti (outcoo, S_NLATUNITS, sk_stati (catcoo, + S_NLATUNITS)) + } else { + i = strdic (Memc[cfield], Memc[cfield], SZ_LINE, + SKY_LAT_UNITLIST) + if (i > 0) + call sk_seti (outcoo, S_NLATUNITS, i) + else + call sk_seti (outcoo, S_NLATUNITS, sk_stati(catcoo, + S_NLATUNITS)) + } + + } + } else { + outcoo = NULL + } + + # Open the image coordinate system. + if (im == NULL) { + imcoo = NULL + mwim = NULL + } else { + imstat = sk_decim (im, "logical", mwim, imcoo) + if (imstat == ERR || mwim == NULL) { + if (mwim != NULL) + call mw_close (mwim) + mwim = NULL + call sk_close (outcoo) + outcoo = NULL + } else { + call sk_seti (imcoo, S_NLNGUNITS, SKY_DEGREES) + call sk_seti (imcoo, S_NLATUNITS, SKY_DEGREES) + } + } + + call sfree (sp) +end + + +# AT_COOFIELDS -- Get the sequence number of the coordinate output fields. + +procedure at_coofields (at, res, flist, raname, decname, rafield, decfield, + xpfield, ypfield, xcfield, ycfield) + + +pointer at #I the astrometry package descriptor +pointer res #I the output results descriptor +pointer flist #I the output field list descriptor +char raname[ARB] #O the catalog ra name +char decname[ARB] #O the catalog dec name +int rafield #O the output ra field no +int decfield #O the output dec field no +int xpfield #O the output xp field no +int ypfield #O the output yp field no +int xcfield #O the output xp field no +int ycfield #O the output yp field no + +pointer sp, xpname, ypname, str +int i +int at_flnexpr(), cq_fnumber() +bool streq() + +begin + # Get working space. + call smark (sp) + call salloc (xpname, FL_SZ_EXPR, TY_CHAR) + call salloc (ypname, FL_SZ_EXPR, TY_CHAR) + call salloc (str, FL_SZ_EXPR, TY_CHAR) + + # Initialize. + rafield = 0 + decfield = 0 + xpfield = 0 + ypfield = 0 + xcfield = 0 + ycfield = 0 + + # Get the ra and dec field names. + call at_stats (at, FIRA, Memc[str], FL_SZ_EXPR) + i = 1 + if (at_flnexpr (res, Memc[str], i, raname, FL_SZ_EXPR) == EOF) + raname[1] = EOS + call at_stats (at, FIDEC, Memc[str], FL_SZ_EXPR) + i = 1 + if (at_flnexpr (res, Memc[str], i, decname, FL_SZ_EXPR) == EOF) + decname[1] = EOS + + # Get the predicted x and y field names. + call at_stats (at, FIXP, Memc[str], FL_SZ_EXPR) + i = 1 + if (at_flnexpr (res, Memc[str], i, Memc[xpname], FL_SZ_EXPR) == EOF) + Memc[xpname] = EOS + call at_stats (at, FIYP, Memc[str], FL_SZ_EXPR) + i = 1 + if (at_flnexpr (res, Memc[str], i, Memc[ypname], FL_SZ_EXPR) == EOF) + Memc[ypname] = EOS + + # Get the center x and y field names. Ignore this for now. + + # Check to see whether the field names are in the input catalog + # and whether at least one of them is in the output catalog. + if (cq_fnumber (res, raname) > 0 && cq_fnumber (res, decname) > 0) { + do i = 0, FL_NFIELDS(flist) - 1 { + if (streq (raname, Memc[FL_FNAMES(flist)+i* + (CQ_SZ_QPNAME+1)])) { + rafield = i + 1 + } else if (streq (decname, Memc[FL_FNAMES(flist)+i* + (CQ_SZ_QPNAME+1)])) { + decfield = i + 1 + } else if (streq (Memc[xpname], Memc[FL_FNAMES(flist)+i* + (CQ_SZ_QPNAME+1)])) { + xpfield = i + 1 + } else if (streq (Memc[ypname], Memc[FL_FNAMES(flist)+i* + (CQ_SZ_QPNAME+1)])) { + ypfield = i + 1 + } + #if (rafield > 0 && decfield > 0) + #break + } + } + + call sfree (sp) +end + + +# AT_MKRECORD -- Format the output catalog record. + +int procedure at_mkrecord (flist, res, record, maxch, recno, rafield, decfield, + raval, decval, xpfield, ypfield, xpval, ypval) + +pointer flist #I the output field list descriptor +pointer res #I the output results descriptor +char record[ARB] #O the output record +int maxch #I the maximum size of a record +int recno #I the current record number +int rafield #I the output ra field +int decfield #I the output dec field +double raval #I the input ra value +double decval #I the input dec value +int xpfield #I the output predicted x field +int ypfield #I the output predicted y field +double xpval #I the input predicted x value +double ypval #I the input predicted y value + +pointer sp, newval, eptr, rptr, o +int i, j, k, op, findex, nchars +pointer evvexpr(), locpr() +int gstrcpy(), cq_rstati(), cq_gvalc(), strlen() +extern at_getop() + +begin + call smark (sp) + call salloc (newval, SZ_LINE, TY_CHAR) + + # Initialize. + findex = 0 + op = 1 + record[op] = EOS + o = NULL + eptr = FL_FLIST(flist) + rptr = FL_FRANGES(flist) + + # Loop over the expressions. + do i = 1, FL_NEXPR(flist) { + + # The output field is an expression. + if (IS_INDEFI(Memi[rptr])) { + + # Evaluate the expression. + if (xpfield == (findex + 1)) { + call sprintf (Memc[newval], maxch, Memc[FL_FFMTS(flist)+ + findex * (CQ_SZ_QPFMTS + 1)]) + call pargd (xpval) + } else if (ypfield == (findex + 1)) { + call sprintf (Memc[newval], maxch, Memc[FL_FFMTS(flist)+ + findex * (CQ_SZ_QPFMTS + 1)]) + call pargd (ypval) + } else { + + if (o != NULL) + call evvfree (o) + o = evvexpr (Memc[eptr], locpr (at_getop), res, 0, res, 0) + + # Encode the expression in a string. + switch (O_TYPE(o)) { + case TY_CHAR: + call sprintf (Memc[newval], maxch, Memc[FL_FFMTS(flist)+ + findex * (CQ_SZ_QPFMTS + 1)]) + call pargstr (O_VALC(o)) + case TY_INT: + call sprintf (Memc[newval], maxch, Memc[FL_FFMTS(flist)+ + findex * (CQ_SZ_QPFMTS + 1)]) + call pargi (O_VALI(o)) + case TY_REAL: + call sprintf (Memc[newval], maxch, Memc[FL_FFMTS(flist)+ + findex * (CQ_SZ_QPFMTS + 1)]) + call pargr (O_VALR(o)) + case TY_DOUBLE: + call sprintf (Memc[newval], maxch, Memc[FL_FFMTS(flist)+ + findex * (CQ_SZ_QPFMTS + 1)]) + call pargd (O_VALD(o)) + default: + call sprintf (Memc[newval], maxch, Memc[FL_FFMTS(flist)+ + findex * (CQ_SZ_QPFMTS + 1)]) + call pargstr (O_VALC(o)) + } + } + + # Copy the string to the output record. + if (Memi[FL_FSIZES(flist)+findex] == 0) { + op = op + gstrcpy (" ", record[op], maxch - op + 1) + op = op + gstrcpy (Memc[newval], record[op], maxch - op + 1) + op = op + gstrcpy (" ", record[op], maxch - op + 1) + } else { + nchars = min (Memi[FL_FSIZES(flist)+findex], + strlen (Memc[newval])) + do k = 1, Memi[FL_FSIZES(flist)+findex] - nchars - 1 { + if (op > maxch) + break + record[op] = ' ' + op = op + 1 + } + op = op + gstrcpy (Memc[newval], record[op], min (nchars, + maxch - op + 1)) + op = op + gstrcpy (" ", record[op], maxch - op + 1) + } + + findex = findex + 1 + + # The field expression are input catalog columns. + } else if (Memi[rptr] >= 1 && Memi[rptr+1] <= cq_rstati (res, + CQNFIELDS)) { + + # Loop over the fields in each range. + do j = max (1, Memi[rptr]), min (Memi[rptr+1], cq_rstati(res, + CQNFIELDS)), Memi[rptr+2] { + + # Encode the record values. + if (rafield == (findex + 1)) { + call sprintf (Memc[newval], SZ_LINE, + Memc[FL_FFMTS(flist)+ findex * (CQ_SZ_QPFMTS + 1)]) + call pargd (raval) + nchars = strlen (Memc[newval]) + } else if (decfield == (findex + 1)) { + call sprintf (Memc[newval], SZ_LINE, + Memc[FL_FFMTS(flist)+ findex * (CQ_SZ_QPFMTS + 1)]) + call pargd (decval) + nchars = strlen (Memc[newval]) + } else if (xpfield == (findex + 1)) { + call sprintf (Memc[newval], SZ_LINE, + Memc[FL_FFMTS(flist)+ findex * (CQ_SZ_QPFMTS + 1)]) + call pargd (xpval) + nchars = strlen (Memc[newval]) + } else if (ypfield == (findex + 1)) { + call sprintf (Memc[newval], SZ_LINE, + Memc[FL_FFMTS(flist)+ findex * (CQ_SZ_QPFMTS + 1)]) + call pargd (ypval) + nchars = strlen (Memc[newval]) + } else { + nchars = cq_gvalc (res, recno, Memc[FL_FNAMES(flist)+ + findex*(CQ_SZ_QPNAME+1)], Memc[newval], SZ_LINE) + } + + # Copy the string to the output record. + if (Memi[FL_FSIZES(flist)+findex] == 0) { + if ((j == 1) && (! IS_WHITE(Memc[newval]))) + op = op + gstrcpy (" ", record[op], maxch - op + 1) + else if (rafield == (findex + 1) || decfield == + (findex + 1) || xpfield == (findex + 1) || + ypfield == (findex + 1)) + op = op + gstrcpy (" ", record[op], maxch - op + 1) + op = op + gstrcpy (Memc[newval], record[op], + maxch - op + 1) + if (rafield == (findex + 1) || decfield == + (findex + 1) || xpfield == (findex + 1) || + ypfield == (findex + 1)) + op = op + gstrcpy (" ", record[op], maxch - op + 1) + } else { + nchars = min (Memi[FL_FSIZES(flist)+findex], nchars) + do k = 1, Memi[FL_FSIZES(flist)+findex] - nchars - 1 { + if (op > maxch) + break + record[op] = ' ' + op = op + 1 + } + op = op + gstrcpy (Memc[newval], record[op], + min (nchars, maxch - op + 1)) + op = op + gstrcpy (" ", record[op], maxch - op + 1) + } + + findex = findex + 1 + } + } + + # Increment the expression and ranges pointers. + eptr = eptr + FL_SZ_EXPR + 1 + rptr = rptr + 3 + } + if (o != NULL) + call evvfree (o) + + # Append a newline and EOS to the data. + if (record[1] != EOS) { + record[op] = '\n' + record[op+1] = EOS + } + + call sfree (sp) + + return (op - 1) +end + + +# AT_NFLIST -- Add new fields to the current output field list and optionally +# specify the field names, field types, field units, and field formats. + +procedure at_nflist (at, nfields, nfnames, nftypes, nfunits, nformats, append) + +pointer at #I the astrometry package descriptors +int nfields #I the number of new fields +char nfnames[ARB] #I the new field names list +char nftypes[ARB] #I the new field types list +char nfunits[ARB] #I the new field units list +char nformats[ARB] #I the new field formats list +bool append #I append the new fields + +pointer sp, str1, str2 +int i, op1, op2 +int gstrcpy(), strlen + +begin + call smark (sp) + call salloc (str1, SZ_LINE, TY_CHAR) + call salloc (str2, SZ_LINE, TY_CHAR) + + # Set the new output field expressions to INDEF and retrieve the + # original user fields value. + call at_stats (at, FIELDS, Memc[str1], SZ_LINE) + op1 = strlen (Memc[str1]) + op2 = 0 + do i = 1, nfields { + if (i == 1) { + op2 = op2 + gstrcpy ("INDEF", Memc[str2+op2], SZ_LINE - op2) + } else { + op2 = op2 + gstrcpy (",", Memc[str2+op2], SZ_LINE - op2) + op2 = op2 + gstrcpy ("INDEF", Memc[str2+op2], SZ_LINE - op2) + } + } + + # Construct the new output fields string. + if (append) { + op1 = op1 + gstrcpy (",", Memc[str1+op1], SZ_LINE - op1) + op1 = op1 + gstrcpy (Memc[str2], Memc[str1+op1], SZ_LINE - op1) + call at_sets (at, FIELDS, Memc[str1]) + } else { + op2 = op 2+ gstrcpy (",", Memc[str2+op2], SZ_LINE - op2) + op2 = op2 + gstrcpy (Memc[str1], Memc[str2+op2], SZ_LINE - op2) + call at_sets (at, FIELDS, Memc[str2]) + } + + # Construct the new field names. + call at_stats (at, FNAMES, Memc[str1], SZ_LINE) + op1 = strlen (Memc[str1]) + op2 = 0 + if (append) { + op1 = op1 + gstrcpy (",", Memc[str1+op1], SZ_LINE - op1) + op1 = op1 + gstrcpy (nfnames, Memc[str1+op1], SZ_LINE - op1) + call at_sets (at, FNAMES, Memc[str1]) + } else { + op2 = op2 + gstrcpy (nfnames, Memc[str2+op2], SZ_LINE - op2) + op2 = op2 + gstrcpy (",", Memc[str2+op2], SZ_LINE - op2) + op2 = op2 + gstrcpy (Memc[str1], Memc[str2+op2], SZ_LINE - op2) + call at_sets (at, FNAMES, Memc[str2]) + } + + # Construct the new field types. + call at_stats (at, FNTYPES, Memc[str1], SZ_LINE) + op1 = strlen (Memc[str1]) + op2 = 0 + if (append) { + op1 = op1 + gstrcpy (",", Memc[str1+op1], SZ_LINE - op1) + op1 = op1 + gstrcpy (nftypes, Memc[str1+op1], SZ_LINE - op1) + call at_sets (at, FNTYPES, Memc[str1]) + } else { + op2 = op2 + gstrcpy (nftypes, Memc[str2+op2], SZ_LINE - op2) + op2 = op2 + gstrcpy (",", Memc[str2+op2], SZ_LINE - op2) + op2 = op2 + gstrcpy (Memc[str1], Memc[str2+op2], SZ_LINE - op2) + call at_sets (at, FNTYPES, Memc[str2]) + } + + # Construct the new field units. + call at_stats (at, FNUNITS, Memc[str1], SZ_LINE) + op1 = strlen (Memc[str1]) + op2 = 0 + if (append) { + op1 = op1 + gstrcpy (",", Memc[str1+op1], SZ_LINE - op1) + op1 = op1 + gstrcpy (nfunits, Memc[str1+op1], SZ_LINE - op1) + call at_sets (at, FNUNITS, Memc[str1]) + } else { + op2 = op2 + gstrcpy (nfunits, Memc[str2+op2], SZ_LINE - op2) + op2 = op2 + gstrcpy (",", Memc[str2+op2], SZ_LINE - op2) + op2 = op2 + gstrcpy (Memc[str1], Memc[str2+op2], SZ_LINE - op2) + call at_sets (at, FNUNITS, Memc[str2]) + } + + # Construct the new field units. + call at_stats (at, FNFORMATS, Memc[str1], SZ_LINE) + op1 = strlen (Memc[str1]) + op2 = 0 + if (append) { + op1 = op1 + gstrcpy (",", Memc[str1+op1], SZ_LINE - op1) + op1 = op1 + gstrcpy (nformats, Memc[str1+op1], SZ_LINE - op1) + call at_sets (at, FNFORMATS, Memc[str1]) + } else { + op2 = op2 + gstrcpy (nformats, Memc[str2+op2], SZ_LINE - op2) + op2 = op2 + gstrcpy (",", Memc[str2+op2], SZ_LINE - op2) + op2 = op2 + gstrcpy (Memc[str1], Memc[str2+op2], SZ_LINE - op2) + call at_sets (at, FNFORMATS, Memc[str2]) + } + + call sfree (sp) +end + + +# AT_FLINIT -- Initialize the field list structure. This routines: 1) +# creates a list of fields, field ranges, and field expressions, 2) determines +# whether an output field is an input field or a field expression, and 3) +# assembles the information required to write a catalog header. + + +pointer procedure at_flinit (at, res) + +pointer at #I the astrometry package descriptor +pointer res #I results descriptor + +pointer sp, fields +pointer fl +int nexpr, nfields +int at_flelist(), at_flranges() + +begin + # Get some working space. + call smark (sp) + call salloc (fields, SZ_LINE, TY_CHAR) + + # Get the user field list. + call at_stats (at, FIELDS, Memc[fields], SZ_LINE) + + # Allocate the field list descriptor. + call calloc (fl, FL_FLENGTH, TY_STRUCT) + + # Create the field expression list. + nexpr = at_flelist (res, Memc[fields], fl) + if (nexpr > 0) { + + # Determine which individual fields are to be output. + nfields = at_flranges (res, fl) + + # Compile the new header info. + if (nfields > 0) + call at_flflist (at, res, fl) + } + + call sfree (sp) + + return (fl) +end + + +# AT_FLFREE -- Free the field list structure. + +procedure at_flfree (fl) + +pointer fl #I the field list descriptor + +begin + if (FL_FLIST(fl) != NULL) + call mfree (FL_FLIST(fl), TY_CHAR) + if (FL_FRANGES(fl) != NULL) + call mfree (FL_FRANGES(fl), TY_STRUCT) + + if (FL_FNAMES(fl) != NULL) + call mfree (FL_FNAMES(fl), TY_CHAR) + if (FL_FOFFSETS(fl) != NULL) + call mfree (FL_FOFFSETS(fl), TY_INT) + if (FL_FSIZES(fl) != NULL) + call mfree (FL_FSIZES(fl), TY_INT) + if (FL_FTYPES(fl) != NULL) + call mfree (FL_FTYPES(fl), TY_INT) + if (FL_FUNITS(fl) != NULL) + call mfree (FL_FUNITS(fl), TY_CHAR) + if (FL_FFMTS(fl) != NULL) + call mfree (FL_FFMTS(fl), TY_CHAR) + + call mfree (fl, TY_STRUCT) +end + + +# AT_FLELIST -- Create the expression list from the user field list. + +int procedure at_flelist (res, fields, fl) + +pointer res #I the results descriptor +char fields[ARB] #I the user field list +pointer fl #O the field list descriptor + +int i, ip, fp, nexpr +int at_flnexpr() + +begin + # Allocate space for the expression list. + call malloc (FL_FLIST(fl), FL_MAX_NEXPR * (FL_SZ_EXPR + 1), TY_CHAR) + + # Decode the user field list into a list of comma separated + # expressions. Expressions may be field names (e.g. "ra" or "f2"), + # field ranges (e.g. "f[*]" or "f[1-4]"), or field expressions + # (e.g. "f2 - f3" or "mag2 - mag1"). + + ip = 1 + fp = FL_FLIST(fl) + nexpr = 0 + do i = 1, FL_MAX_NEXPR { + if (at_flnexpr (res, fields, ip, Memc[fp], FL_SZ_EXPR) == EOF) + break + #call strlwr (Memc[fp]) + fp = fp + FL_SZ_EXPR + 1 + nexpr = nexpr + 1 + } + call realloc (FL_FLIST(fl), nexpr * (FL_SZ_EXPR + 1), TY_CHAR) + FL_NEXPR(fl) = nexpr + + return (nexpr) +end + + +# AT_FLNEXPR -- Get the next expression from an expression list. + +int procedure at_flnexpr (res, exprlist, ip, expr, maxch) + +pointer res #I pointer to the results descriptor +char exprlist[ARB] #I the input expression list +int ip #I pointer into the expression list +char expr[ARB] #O the output expression +int maxch #I maximum length of the output expression + +int ep, op, token, fnum +int ctotok(), strlen(), cq_fnumber(), ctoi(), cq_rstati(), cq_fname() + +begin + # Decode the column labels. + op = 1 + while (exprlist[ip] != EOS) { + + token = ctotok (exprlist, ip, expr[op], maxch) + if (expr[op] == EOS) + next + + if ((token == TOK_PUNCTUATION) && (expr[op] == ',')) { + if (op == 1) + next + else + break + } + + # Replace generic identifiers with their catalog equivalents. + if (token == TOK_IDENTIFIER) { + fnum = cq_fnumber (res, expr[op]) + if (fnum <= 0 && expr[op] == 'f') { + ep = 2 + if (ctoi (expr[op], ep, fnum) <= 0) + fnum = 0 + if (fnum < 1 || fnum > cq_rstati (res, CQRNRECS)) + fnum = 0 + if (fnum > 0) { + if (cq_fname (res, fnum, expr[op], maxch) != fnum) + ; + } + } + } + + + op = op + strlen (expr[op]) + } + + expr[op] = EOS + if ((exprlist[ip] == EOS) && (op == 1)) + return (EOF) + else + return (op - 1) +end + + +# AT_FLNITEM -- Get the next expression from an expression list. + +int procedure at_flnitem (itemlist, ip, item, maxch) + +char itemlist[ARB] #I the input item list +int ip #I pointer into the item list +char item[ARB] #O the output item +int maxch #I maximum length of the output item + +int op, token +int ctotok(), strlen() + +begin + # Decode the column labels. + op = 1 + while (itemlist[ip] != EOS) { + + token = ctotok (itemlist, ip, item[op], maxch) + if (item[op] == EOS) + next + + if ((token == TOK_PUNCTUATION) && (item[op] == ',')) { + if (op == 1) + next + else + break + } + + op = op + strlen (item[op]) + } + + item[op] = EOS + if ((itemlist[ip] == EOS) && (op == 1)) + return (EOF) + else + return (op - 1) +end + + +# AT_FLRANGES -- Get the field ranges for each output field. + +int procedure at_flranges (res, fl) + +pointer res #I the results descriptor +pointer fl #I the field list descriptor + +pointer sp, fname, fptr, rptr +int i, nin, nout, lindex, rindex, ip1, ip2, f1, f2 +char lbracket, rbracket +int cq_rstati(), strldx(), ctoi(), ctotok(), cq_fnumber() +bool streq() +data lbracket /'['/, rbracket /']'/ + +begin + # Allocate working space. + call smark (sp) + call salloc (fname, FL_SZ_EXPR, TY_CHAR) + + # Allocate space for the ranges list. + call calloc (FL_FRANGES(fl), 3 * FL_NEXPR(fl) + 1, TY_INT) + + # Initialize. + nin = cq_rstati (res, CQNFIELDS) + nout = 0 + + # Loop over the expressions. Fields which cannot be decoded + # have zero-valued range entries. Expression fields have INDEFI + # valued range entries. + fptr = FL_FLIST(fl) + rptr = FL_FRANGES(fl) + do i = 1, FL_NEXPR (fl) { + + lindex = strldx (lbracket, Memc[fptr]) + rindex = strldx (rbracket, Memc[fptr]) + ip1 = 1 + ip2 = lindex + 1 + + # Decode generic field ranges. + if (Memc[fptr] == 'f' && lindex == 2 && rindex > lindex) { + + # Find the range limits. + if (Memc[fptr+lindex] == '*') { + f1 = 1 + f2 = nin + } else { + if (ctoi (Memc[fptr], ip2, f1) <= 0) + f1 = 0 + else if (f1 < 1 || f1 > nin) + f1 = 0 + if (ctoi (Memc[fptr], ip2, f2) <= 0) + f2 = 0 + else + f2 = -f2 + if (f2 < 1 || f2 > nin) + f2 = 0 + } + + # Valid range. + if (f1 > 0 && f2 > f1) { + Memi[rptr] = f1 + Memi[rptr+1] = f2 + Memi[rptr+2] = 1 + nout = nout + f2 - f1 + 1 + + # Field cannot be decoded. + } else { + Memi[rptr] = 0 + Memi[rptr+1] = 0 + Memi[rptr+2] = 0 + } + + # Decode fields and expressions. + } else if (ctotok (Memc[fptr], ip1, Memc[fname], FL_SZ_EXPR) == + TOK_IDENTIFIER) { + + # Find the field number. + f1 = cq_fnumber (res, Memc[fptr]) + if (f1 <= 0 && streq (Memc[fptr], Memc[fname])) { + if (Memc[fptr] != 'f') + f1 = 0 + else { + f2 = 1 + if (ctoi (Memc[fptr+1], f2, f1) <= 0) + f1 = 0 + else if (f1 < 1 || f1 > nin) + f1 = 0 + } + } + + # Valid single field. + if (f1 > 0) { + Memi[rptr] = f1 + Memi[rptr+1] = f1 + Memi[rptr+2] = 1 + nout = nout + 1 + + # Field is an expression. + } else if (ctotok (Memc[fptr], ip1, Memc[fname], + FL_SZ_EXPR) != TOK_EOS) { + Memi[rptr] = INDEFI + Memi[rptr+1] = INDEFI + Memi[rptr+2] = INDEFI + nout = nout + 1 + + # Field cannot be decoded. + } else { + Memi[rptr] = 0 + Memi[rptr+1] = 0 + Memi[rptr+2] = 0 + } + + # What's left over is an expression field. + } else { + + Memi[rptr] = INDEFI + Memi[rptr+1] = INDEFI + Memi[rptr+2] = INDEFI + nout = nout + 1 + } + + fptr = fptr + FL_SZ_EXPR + 1 + rptr = rptr + 3 + } + + # Store the field counts. + FL_NFIELDS(fl) = nout + + call sfree (sp) + + return (nout) +end + + +# AT_FLFLIST -- Assemble the field header info for the new catalog. + +procedure at_flflist (at, res, fl) + +pointer at #I the astrometry package descriptor +pointer res #I the results descriptor +pointer fl #I the field list descriptor + +pointer sp, fnames, fntypes, fnunits, fnfmts, franame, fdecname, xpname +pointer ypname, xcname, ycname, str, rptr +int i, j, ip, nfields, fnp, ftp, fup, ffp, rtype, foffset, ival +int cq_rstati(), ctotok(), at_dtype(), ctoi(), cq_finfon() +int at_wrdstr(), at_stati(), at_flnitem() +bool streq(), strne() + +begin + # Get the number of output fields. + nfields = FL_NFIELDS(fl) + if (nfields <= 0) + return + + # Get some working space. + call smark (sp) + call salloc (fnames, SZ_LINE, TY_CHAR) + call salloc (fntypes, SZ_LINE, TY_CHAR) + call salloc (fnunits, SZ_LINE, TY_CHAR) + call salloc (fnfmts, SZ_LINE, TY_CHAR) + call salloc (franame, CQ_SZ_QPNAME, TY_CHAR) + call salloc (fdecname, CQ_SZ_QPNAME, TY_CHAR) + call salloc (xpname, CQ_SZ_QPNAME, TY_CHAR) + call salloc (ypname, CQ_SZ_QPNAME, TY_CHAR) + call salloc (xcname, CQ_SZ_QPNAME, TY_CHAR) + call salloc (ycname, CQ_SZ_QPNAME, TY_CHAR) + call salloc (str, SZ_FNAME, TY_CHAR) + + # Get the user parameters defining the names, types, units, and + # formats of the new fields. + call at_stats (at, FNAMES, Memc[fnames], SZ_LINE) + call at_stats (at, FNTYPES, Memc[fntypes], SZ_LINE) + call at_stats (at, FNUNITS, Memc[fnunits], SZ_LINE) + call at_stats (at, FNFORMATS, Memc[fnfmts], SZ_LINE) + fnp = 1 + ftp = 1 + fup = 1 + ffp = 1 + + # Get the special coordinate field names. + call at_stats (at, FIRA, Memc[franame], CQ_SZ_FNAME) + call at_stats (at, FIDEC, Memc[fdecname], CQ_SZ_FNAME) + call at_stats (at, FIXP, Memc[xpname], CQ_SZ_FNAME) + call at_stats (at, FIYP, Memc[ypname], CQ_SZ_FNAME) + call at_stats (at, FIXC, Memc[xcname], CQ_SZ_FNAME) + call at_stats (at, FIYC, Memc[ycname], CQ_SZ_FNAME) + + # Allocate space for the header field names, offsets, sizes, data + # types, units, and formats. + call calloc (FL_FNAMES(fl), nfields * (CQ_SZ_QPNAME + 1), TY_CHAR) + call calloc (FL_FOFFSETS(fl), nfields, TY_INT) + call calloc (FL_FSIZES(fl), nfields, TY_INT) + call calloc (FL_FTYPES(fl), nfields, TY_INT) + call calloc (FL_FUNITS(fl), nfields * (CQ_SZ_QPUNITS + 1), TY_CHAR) + call calloc (FL_FFMTS(fl), nfields * (CQ_SZ_QPFMTS + 1), TY_CHAR) + + # Get the output type. This is the same as the input type. + rtype = cq_rstati (res, CQRTYPE) + + # Loop over the ranges list. + nfields = 0 + foffset = 1 + rptr = FL_FRANGES(fl) + do i = 1, FL_NEXPR(fl) { + + # Skip non-decodable fields. + if (Memi[rptr] == 0) { + rptr = rptr + 3 + next + } + + # The field is an input catalog field. + if (! IS_INDEFI (Memi[rptr])) { + + do j = Memi[rptr], Memi[rptr+1] { + + # Get the field name, the field offset, size, data type, + # units and default format. + if (cq_finfon (res, j, Memc[FL_FNAMES(fl)+nfields* + (CQ_SZ_QPNAME+1)], CQ_SZ_QPNAME, Memi[FL_FOFFSETS(fl)+ + nfields], Memi[FL_FSIZES(fl)+nfields], + Memi[FL_FTYPES(fl)+nfields], + Memc[FL_FUNITS(fl)+nfields*(CQ_SZ_QPUNITS+1)], + CQ_SZ_QPUNITS, Memc[FL_FFMTS(fl)+nfields* + (CQ_SZ_QPFMTS+1)], CQ_SZ_QPFMTS) != j) + ; + + # Correct the field offset and field size. + switch (rtype) { + case CQ_STEXT: + Memi[FL_FOFFSETS(fl)+nfields] = nfields + 1 + Memi[FL_FSIZES(fl)+nfields] = 0 + case CQ_BTEXT: + Memi[FL_FOFFSETS(fl)+nfields] = foffset + foffset = foffset + Memi[FL_FSIZES(fl)+nfields] + default: + call error (0, "Unknown output catalog type") + ; + } + + # Correct for coordinate units and format transform here. + if (streq (Memc[franame], Memc[FL_FNAMES(fl)+ + nfields*(CQ_SZ_QPNAME+1)])) { + ival = at_stati (at, FORAUNITS) + if (ival <= 0) + Memc[str] = EOS + else if (at_wrdstr (ival, Memc[str], SZ_FNAME, + AT_RA_UNITS) <= 0) + Memc[str] = EOS + if (Memc[str] != EOS && strne (Memc[str], + Memc[FL_FUNITS(fl)+nfields*(CQ_SZ_QPUNITS+1)])) + call strcpy (Memc[str], Memc[FL_FUNITS(fl)+ + nfields*(CQ_SZ_QPUNITS+1)], CQ_SZ_QPUNITS) + call at_stats (at, FORAFORMAT, Memc[str], SZ_FNAME) + if (Memc[str] != EOS && strne (Memc[str], + Memc[FL_FFMTS(fl)+nfields*(CQ_SZ_QPFMTS+1)])) + call strcpy (Memc[str], Memc[FL_FFMTS(fl)+ + nfields*(CQ_SZ_QPFMTS+1)], CQ_SZ_QPFMTS) + } + if (streq (Memc[fdecname], Memc[FL_FNAMES(fl)+ + nfields*(CQ_SZ_QPNAME+1)])) { + ival = at_stati (at, FODECUNITS) + if (ival <= 0) + Memc[str] = EOS + else if (at_wrdstr (ival, Memc[str], SZ_FNAME, + AT_DEC_UNITS) <= 0) + Memc[str] = EOS + if (Memc[str] != EOS && strne (Memc[str], + Memc[FL_FUNITS(fl)+nfields*(CQ_SZ_QPUNITS+1)])) + call strcpy (Memc[str], Memc[FL_FUNITS(fl)+ + nfields*(CQ_SZ_QPUNITS+1)], CQ_SZ_QPUNITS) + call at_stats (at, FODECFORMAT, Memc[str], SZ_FNAME) + if (Memc[str] != EOS && strne (Memc[str], + Memc[FL_FFMTS(fl)+nfields*(CQ_SZ_QPFMTS+1)])) + call strcpy (Memc[str], Memc[FL_FFMTS(fl)+ + nfields*(CQ_SZ_QPFMTS+1)], CQ_SZ_QPFMTS) + } + + # Correct for pixel coordinate formats here. + if (streq (Memc[xpname], Memc[FL_FNAMES(fl)+ + nfields*(CQ_SZ_QPNAME+1)]) || streq (Memc[xcname], + Memc[FL_FNAMES(fl)+nfields*(CQ_SZ_QPNAME+1)])) { + call at_stats (at, FOXFORMAT, Memc[str], SZ_FNAME) + if (Memc[str] != EOS && strne (Memc[str], + Memc[FL_FFMTS(fl)+nfields*(CQ_SZ_QPFMTS+1)])) + call strcpy (Memc[str], Memc[FL_FFMTS(fl)+ + nfields*(CQ_SZ_QPFMTS+1)], CQ_SZ_QPFMTS) + } + if (streq (Memc[ypname], Memc[FL_FNAMES(fl)+ + nfields*(CQ_SZ_QPNAME+1)]) || streq (Memc[ycname], + Memc[FL_FNAMES(fl)+nfields*(CQ_SZ_QPNAME+1)])) { + call at_stats (at, FOYFORMAT, Memc[str], SZ_FNAME) + if (Memc[str] != EOS && strne (Memc[str], + Memc[FL_FFMTS(fl)+nfields*(CQ_SZ_QPFMTS+1)])) + call strcpy (Memc[str], Memc[FL_FFMTS(fl)+ + nfields*(CQ_SZ_QPFMTS+1)], CQ_SZ_QPFMTS) + } + + + nfields = nfields + 1 + } + + # This field is a new field. + } else { + + # Get the field names. The default is f#. + ip = 1 + if (at_flnitem (Memc[fnames], fnp, Memc[FL_FNAMES(fl)+ + nfields*(CQ_SZ_QPNAME+1)], CQ_SZ_QPNAME) == EOF) { + call sprintf (Memc[FL_FNAMES(fl)+nfields*(CQ_SZ_QPNAME+1)], + CQ_SZ_QPNAME, "f%d") + call pargi (nfields + 1) + } else if (ctotok (Memc[FL_FNAMES(fl)+nfields* + (CQ_SZ_QPNAME+1)], ip, Memc[FL_FNAMES(fl)+nfields* + (CQ_SZ_QPNAME+1)], CQ_SZ_QPNAME) != TOK_IDENTIFIER) { + call sprintf (Memc[FL_FNAMES(fl)+nfields*(CQ_SZ_QPNAME+1)], + CQ_SZ_QPNAME, "f%d") + call pargi (nfields + 1) + } + + # Get the data types. The default for now is type real. + ip = 1 + if (at_flnitem (Memc[fntypes], ftp, Memc[str], + SZ_FNAME) == EOF) { + Memi[FL_FTYPES(fl)+nfields] = TY_REAL + } else if (ctotok (Memc[str], ip, Memc[str], SZ_FNAME) != + TOK_IDENTIFIER) { + Memi[FL_FTYPES(fl)+nfields] = TY_REAL + } else { + #call strlwr (Memc[str]) + #Memi[FL_FTYPES(fl)+nfields] = cq_dtype(Memc[str]) + Memi[FL_FTYPES(fl)+nfields] = at_dtype(Memc[str]) + } + + # Get the data units. The default is INDEF. + ip = 1 + if (at_flnitem (Memc[fnunits], fup, Memc[FL_FUNITS(fl)+ + nfields*(CQ_SZ_QPUNITS+1)], CQ_SZ_QPUNITS) == EOF) { + call strcpy ("INDEF", Memc[FL_FUNITS(fl)+nfields* + (CQ_SZ_QPUNITS+1)], CQ_SZ_QPUNITS) + } else if (ctotok (Memc[FL_FUNITS(fl)+nfields* + (CQ_SZ_QPUNITS+1)], ip, Memc[FL_FUNITS(fl)+nfields* + (CQ_SZ_QPUNITS+1)], CQ_SZ_QPUNITS) != TOK_IDENTIFIER) { + call strcpy ("INDEF", Memc[FL_FUNITS(fl)+nfields* + (CQ_SZ_QPUNITS+1)], CQ_SZ_QPUNITS) + } + + # Get the data formats. The default is %10s, %10d, and %10g + # for character, integer, and floating data points respectively. + ip = 1 + if (at_flnitem (Memc[fnfmts], ffp, Memc[FL_FFMTS(fl)+nfields* + (CQ_SZ_QPFMTS+1)], CQ_SZ_QPFMTS) == EOF) { + switch (Memi[FL_FTYPES(fl)+nfields]) { + case TY_CHAR: + call strcpy ("%10s", Memc[FL_FFMTS(fl)+nfields* + (CQ_SZ_QPFMTS+1)], CQ_SZ_QPFMTS) + case TY_SHORT, TY_INT, TY_LONG: + call strcpy ("%10d", Memc[FL_FFMTS(fl)+nfields* + (CQ_SZ_QPFMTS+1)], CQ_SZ_QPFMTS) + case TY_REAL, TY_DOUBLE: + call strcpy ("%10g", Memc[FL_FFMTS(fl)+nfields* + (CQ_SZ_QPFMTS+1)], CQ_SZ_QPFMTS) + } + } else if (Memc[FL_FFMTS(fl)+nfields*(CQ_SZ_QPFMTS+1)] != '%') { + switch (Memi[FL_FTYPES(fl)+nfields*(CQ_SZ_QPFMTS+1)]) { + case TY_CHAR: + call strcpy ("%10s", Memc[FL_FFMTS(fl)+nfields* + (CQ_SZ_QPFMTS+1)], CQ_SZ_QPFMTS) + case TY_SHORT, TY_INT, TY_LONG: + call strcpy ("%10d", Memc[FL_FFMTS(fl)+nfields* + (CQ_SZ_QPFMTS+1)], CQ_SZ_QPFMTS) + case TY_REAL, TY_DOUBLE: + call strcpy ("%10g", Memc[FL_FFMTS(fl)+nfields* + (CQ_SZ_QPFMTS+1)], CQ_SZ_QPFMTS) + } + } + + # Correct for pixel coordinate formats here. + if (streq (Memc[xpname], Memc[FL_FNAMES(fl)+ + nfields*(CQ_SZ_QPNAME+1)]) || streq (Memc[xcname], + Memc[FL_FNAMES(fl)+nfields*(CQ_SZ_QPNAME+1)])) { + call at_stats (at, FOXFORMAT, Memc[str], SZ_FNAME) + if (Memc[str] != EOS && strne (Memc[str], + Memc[FL_FFMTS(fl)+nfields*(CQ_SZ_QPFMTS+1)])) + call strcpy (Memc[str], Memc[FL_FFMTS(fl)+ + nfields*(CQ_SZ_QPFMTS+1)], CQ_SZ_QPFMTS) + } + if (streq (Memc[ypname], Memc[FL_FNAMES(fl)+ + nfields*(CQ_SZ_QPNAME+1)]) || streq (Memc[ycname], + Memc[FL_FNAMES(fl)+nfields*(CQ_SZ_QPNAME+1)])) { + call at_stats (at, FOYFORMAT, Memc[str], SZ_FNAME) + if (Memc[str] != EOS && strne (Memc[str], + Memc[FL_FFMTS(fl)+nfields*(CQ_SZ_QPFMTS+1)])) + call strcpy (Memc[str], Memc[FL_FFMTS(fl)+ + nfields*(CQ_SZ_QPFMTS+1)], CQ_SZ_QPFMTS) + } + + # Get the field width. + ip = 2 + if (ctoi (Memc[FL_FFMTS(fl)+nfields*(CQ_SZ_QPFMTS+1)], ip, + ival) <= 0) + ival = 10 + else if (ival <= 0 || IS_INDEFI(ival)) + ival = 10 + + # Get the field offset and field size. Note the extra + # character added to the width ... + switch (rtype) { + case CQ_STEXT: + Memi[FL_FOFFSETS(fl)+nfields] = nfields + 1 + Memi[FL_FSIZES(fl)+nfields] = 0 + case CQ_BTEXT: + Memi[FL_FOFFSETS(fl)+nfields] = foffset + Memi[FL_FSIZES(fl)+nfields] = ival + 1 + foffset = foffset + Memi[FL_FSIZES(fl)+nfields] + default: + call error (0, "Unknown output catalog type") + } + + nfields = nfields + 1 + + } + + rptr = rptr + 3 + } + + call sfree (sp) +end + + +# AT_GETOP -- Fetch an operand from the data structure. + +procedure at_getop (res, operand, o) + +pointer res #I pointer to the data structure +char operand[ARB] #I name of operand to be returned +pointer o #I pointer to output operand + +pointer sp, fvalue +int fieldno, nchars +int cq_fnumber(), cq_ftype(), cq_gvald(), cq_gvali(), cq_gvalc() +int cq_rstati() + +begin + fieldno = cq_fnumber (res, operand) + if (fieldno <= 0) + call error (0, "Illegal operand in expression") + + switch (cq_ftype (res, operand)) { + + case TY_CHAR: + call smark (sp) + call salloc (fvalue, SZ_LINE, TY_CHAR) + nchars = cq_gvalc (res, cq_rstati(res, CQRECPTR), operand, + Memc[fvalue], SZ_LINE) + if (nchars <= 0) { + call strcpy ("INDEF", Memc[fvalue], 5) + nchars = 5 + } + O_TYPE(o) = TY_CHAR + O_LEN(o) = nchars + O_FLAGS(o) = O_FREEVAL + call malloc (O_VALP(o), nchars, TY_CHAR) + call strcpy (Memc[fvalue], O_VALC(o), nchars) + call sfree (sp) + + case TY_SHORT, TY_INT, TY_LONG: + O_TYPE(o) = TY_INT + O_LEN(o) = 0 + O_FLAGS(o) = 0 + nchars = cq_gvali (res, cq_rstati (res, CQRECPTR), operand, + O_VALI(o)) + + case TY_REAL, TY_DOUBLE: + O_TYPE(o) = TY_DOUBLE + O_LEN(o) = 0 + O_FLAGS(o) = 0 + nchars = cq_gvald (res, cq_rstati(res, CQRECPTR), operand, + O_VALD(o)) + + default: + call smark (sp) + call salloc (fvalue, SZ_LINE, TY_CHAR) + nchars = cq_gvalc (res, cq_rstati(res, CQRECPTR), operand, + Memc[fvalue], SZ_LINE) + if (nchars <= 0) { + call strcpy ("INDEF", Memc[fvalue], 5) + nchars = 5 + } + O_TYPE(o) = TY_CHAR + O_LEN(o) = nchars + O_FLAGS(o) = O_FREEVAL + call malloc (O_VALP(o), nchars, TY_CHAR) + call strcpy (Memc[fvalue], O_VALC(o), nchars) + call sfree (sp) + } +end diff --git a/noao/astcat/src/agetcat/athedit.x b/noao/astcat/src/agetcat/athedit.x new file mode 100644 index 00000000..73815db0 --- /dev/null +++ b/noao/astcat/src/agetcat/athedit.x @@ -0,0 +1,614 @@ +include "../../lib/astrom.h" +include "../../lib/aimpars.h" +include <pkg/cq.h> + + +# AT_HEDIT -- Add a set of standard keywords to the image header. + +procedure at_hedit (im, res, at, update, verbose) + +pointer im #I the input image descriptor +pointer res #I the image results descriptor +pointer at #I the astrometry package descriptor +bool update #I update the header ? +bool verbose #I verbose mode ? + +begin + if (res != NULL) + call at_dbkey (im, res, update, verbose) + if (at != NULL) + call at_parkey (im, at, update, verbose) +end + + +# AT_DBKEY -- Add a set of standard keywords required by astrometric +# reductions to the image header. New keywords will only be added if +# the keyword name is defined in the in the image survey database and the +# standard keyword does not already exist in the image header, or if the +# keyword has a default value in the image survey database. + +procedure at_dbkey (im, res, update, verbose) + +pointer im #I the input image descriptor +pointer res #I the image results descriptor +bool update #I update the header ? +bool verbose #I verbose mode ? + +pointer sp, kfield, kname, kvalue, kunits +int i, nkey, ktype +int cq_istati(), cq_kinfon(), imaccf(), at_akeyword() +bool streq() + +begin + call smark (sp) + call salloc (kfield, CQ_SZ_QPNAME, TY_CHAR) + call salloc (kname, CQ_SZ_QPNAME, TY_CHAR) + call salloc (kvalue, CQ_SZ_QPVALUE, TY_CHAR) + call salloc (kunits, CQ_SZ_QPUNITS, TY_CHAR) + + # Loop over the keywords. + nkey = cq_istati (res, CQNIMPARS) + do i = 1, nkey { + + # Get the keyword information. + if (cq_kinfon (res, i, Memc[kfield], CQ_SZ_QPNAME, Memc[kname], + CQ_SZ_QPNAME, Memc[kvalue], CQ_SZ_QPVALUE, ktype, Memc[kunits], + CQ_SZ_QPUNITS) != i) + next + + # The keyword names is INDEF. + if (streq (Memc[kname], "INDEF")) { + + # Go to next keyword if the keyword value is also INDEF. + if (streq (Memc[kvalue], "INDEF")) + next + + # Add keyword with its default value if it does not exist. + if (imaccf (im, Memc[kfield]) == NO) { + if (at_akeyword (im, Memc[kfield], Memc[kvalue], ktype, + Memc[kunits], update) == OK) { + #if (update || verbose) { + if (verbose) { + call printf ( + " Adding survey keyword %s = %s to header\n") + call pargstr (Memc[kfield]) + call pargstr (Memc[kvalue]) + } + #} else if (update || verbose) { + } else if (verbose) { + call printf ( + " Error adding survey keyword %s to header\n") + call pargstr (Memc[kfield]) + } + #} else if (update || verbose) { + } else if (verbose) { + call printf ( + " Warning survey keyword %s already exists\n") + call pargstr (Memc[kfield]) + } + + # The keyword name is defined and it exists in the image. + } else if (imaccf (im, Memc[kname]) == YES) { + + # Add the new keyword with the old keyword value to the image + call imgstr (im, Memc[kname], Memc[kvalue], CQ_SZ_QPVALUE) + if (imaccf (im, Memc[kfield]) == NO) { + if (at_akeyword (im, Memc[kfield], Memc[kvalue], ktype, + Memc[kunits], update) == OK) { + #if (update || verbose) { + if (verbose) { + call printf ( + " Adding survey keyword %s = %s to header\n") + call pargstr (Memc[kfield]) + call pargstr (Memc[kvalue]) + } + #} else if (update || verbose) { + } else if (verbose) { + call printf ( + " Error adding survey keyword %s to header\n") + call pargstr (Memc[kfield]) + } + #} else if (update || verbose) { + } else if (verbose) { + call printf ( + " Warning survey keyword %s already exists\n") + call pargstr (Memc[kfield]) + } + + # The keywords names does not exist in the image. + #} else if (update || verbose) { + } else if (verbose) { + + call printf ( + " Warning survey keyword %s value %s does not exist\n") + call pargstr (Memc[kfield]) + call pargstr (Memc[kname]) + } + } + + call sfree (sp) +end + + +# AT_PARKEY -- Add a set of standard keywords required by astrometric +# reductions to the image header. New keywords will only be added if +# the keyword name is defined in default AIMPARS parameter file and the +# standard keyword does not already exist in the image header, or if the +# keyword has a default value in the AIMPARS parameter file. + +procedure at_parkey (im, at, update, verbose) + +pointer im #I the input image descriptor +pointer at #I the astrometry package descriptor +bool update #I update the header ? +bool verbose #I verbose mode ? + +double dval +real rval +pointer imst, sym, sp, kfield, kvalue +int i, key +double at_statd(), imgetd() +real at_statr(), imgetr() +pointer at_statp(), stfind() +int at_wrdstr(), imaccf() +bool streq() +errchk imgetd(), imgetr(), imgstr() + +begin + if (at_statp (at, PIMPARS) == NULL) + return + imst = at_statp (at, IMST) + if (imst == NULL) + return + + call smark (sp) + call salloc (kfield, SZ_FNAME, TY_CHAR) + call salloc (kvalue, SZ_FNAME, TY_CHAR) + + # Loop over the keywords. + do i = 1, AT_NIMFIELDS { + + # Get the parameter name. + key = at_wrdstr (i, Memc[kfield], SZ_FNAME, AT_IMFIELDS) + switch (key) { + case HDR_OBSERVAT: + sym = stfind (imst, Memc[kfield]) + if (sym != NULL) { + if (streq (AT_IMSTKVAL(sym), "INDEF")) + call at_stats (at, OBSERVAT, Memc[kvalue], SZ_FNAME) + else iferr (call imgstr (im, AT_IMSTKVAL(sym), + Memc[kvalue], SZ_FNAME)) + call at_stats (at, OBSERVAT, Memc[kvalue], SZ_FNAME) + } else + call at_stats (at, OBSERVAT, Memc[kvalue], SZ_FNAME) + + if (! streq (Memc[kvalue], "INDEF")) { + if (imaccf (im, Memc[kfield]) == YES) { + #if (update || verbose) { + if (verbose) { + call printf (" Keyword %s already exists\n") + call pargstr (Memc[kfield]) + } + } else { + if (update) + call imastr (im, Memc[kfield], Memc[kvalue]) + if (verbose) { + call printf ( + " Adding default keyword %s = %s to header\n") + call pargstr (Memc[kfield]) + call pargstr (Memc[kvalue]) + } + } + } + + case HDR_ESITELNG: + sym = stfind (imst, Memc[kfield]) + if (sym != NULL) { + if (streq (AT_IMSTKVAL(sym), "INDEF")) + dval = at_statd (at, ESITELNG) + else iferr (dval = imgetd (im, AT_IMSTKVAL(sym))) + dval = at_statd (at, ESITELNG) + } else + dval = at_statd (at, ESITELNG) + if (! IS_INDEFD(dval)) { + if (imaccf (im, Memc[kfield]) == YES) { + #if (update || verbose) { + if (verbose) { + call printf (" Keyword %s already exists\n") + call pargstr (Memc[kfield]) + } + } else { + if (update) + call imaddd (im, Memc[kfield], dval) + #if (update || verbose) { + if (verbose) { + call printf ( + " Adding default keyword %s = %h to header\n") + call pargstr (Memc[kfield]) + call pargd (dval) + } + } + } + + case HDR_ESITELAT: + sym = stfind (imst, Memc[kfield]) + if (sym != NULL) { + if (streq (AT_IMSTKVAL(sym), "INDEF")) + dval = at_statd (at, ESITELAT) + else iferr (dval = imgetd (im, AT_IMSTKVAL(sym))) + dval = at_statd (at, ESITELAT) + } else + dval = at_statd (at, ESITELAT) + if (! IS_INDEFD(dval)) { + if (imaccf (im, Memc[kfield]) == YES) { + #if (update || verbose) { + if (verbose) { + call printf (" Keyword %s already exists\n") + call pargstr (Memc[kfield]) + } + } else { + if (update) + call imaddd (im, Memc[kfield], dval) + #if (update || verbose) { + if (verbose) { + call printf ( + " Adding default keyword %s = %h to header\n") + call pargstr (Memc[kfield]) + call pargd (dval) + } + } + } + + case HDR_ESITEALT: + sym = stfind (imst, Memc[kfield]) + if (sym != NULL) { + if (streq (AT_IMSTKVAL(sym), "INDEF")) + rval = at_statr (at, ESITEALT) + else iferr (rval = imgetr (im, AT_IMSTKVAL(sym))) + rval = at_statr (at, ESITEALT) + } else + rval = at_statr (at, ESITEALT) + if (! IS_INDEFR(rval)) { + if (imaccf (im, Memc[kfield]) == YES) { + #if (update || verbose) { + if (verbose) { + call printf (" Keyword %s already exists\n") + call pargstr (Memc[kfield]) + } + } else { + if (update) + call imaddr (im, Memc[kfield], rval) + #if (update || verbose) { + if (verbose) { + call printf ( + " Adding default keyword %s = %0.1f to header\n") + call pargstr (Memc[kfield]) + call pargr (rval) + } + } + } + + case HDR_ESITETZ: + sym = stfind (imst, Memc[kfield]) + if (sym != NULL) { + if (streq (AT_IMSTKVAL(sym), "INDEF")) + rval = at_statr (at, ESITETZ) + else iferr (rval = imgetr (im, AT_IMSTKVAL(sym))) + rval = at_statr (at, ESITETZ) + } else + rval = at_statr (at, ESITETZ) + if (! IS_INDEFR(rval)) { + if (imaccf (im, Memc[kfield]) == YES) { + #if (update || verbose) { + if (verbose) { + call printf (" Keyword %s already exists\n") + call pargstr (Memc[kfield]) + } + } else { + if (update) + call imaddr (im, Memc[kfield], rval) + if (verbose) { + call printf ( + " Adding default keyword %s = %0.1f to header\n") + call pargstr (Memc[kfield]) + call pargr (rval) + } + } + } + + case HDR_EMJDOBS: + sym = stfind (imst, Memc[kfield]) + if (sym != NULL) { + if (streq (AT_IMSTKVAL(sym), "INDEF")) + dval = at_statd (at, EMJDOBS) + else iferr (dval = imgetd (im, AT_IMSTKVAL(sym))) + dval = at_statd (at, EMJDOBS) + } else + dval = at_statd (at, EMJDOBS) + if (! IS_INDEFD(dval)) { + if (imaccf (im, Memc[kfield]) == YES) { + #if (update || verbose) { + if (verbose) { + call printf (" Keyword %s already exists\n") + call pargstr (Memc[kfield]) + } + } else { + if (update) + call imaddd (im, Memc[kfield], dval) + #if (update || verbose) { + if (verbose) { + call printf ( + " Adding default keyword %s = %0.5f to header\n") + call pargstr (Memc[kfield]) + call pargd (dval) + } + } + } + + case HDR_EDATAMIN: + sym = stfind (imst, Memc[kfield]) + if (sym != NULL) { + if (streq (AT_IMSTKVAL(sym), "INDEF")) + rval = at_statr (at, EDATAMIN) + else iferr (rval = imgetr (im, AT_IMSTKVAL(sym))) + rval = at_statr (at, EDATAMIN) + } else + rval = at_statr (at, EDATAMIN) + if (! IS_INDEFR(rval)) { + if (imaccf (im, Memc[kfield]) == YES) { + #if (update || verbose) { + if (verbose) { + call printf (" Keyword %s already exists\n") + call pargstr (Memc[kfield]) + } + } else { + if (update) + call imaddr (im, Memc[kfield], rval) + #if (update || verbose) { + if (verbose) { + call printf ( + " Adding default keyword %s = %g to header\n") + call pargstr (Memc[kfield]) + call pargr (rval) + } + } + } + + case HDR_EDATAMAX: + sym = stfind (imst, Memc[kfield]) + if (sym != NULL) { + if (streq (AT_IMSTKVAL(sym), "INDEF")) + rval = at_statr (at, EDATAMAX) + else iferr (rval = imgetr (im, AT_IMSTKVAL(sym))) + rval = at_statr (at, EDATAMAX) + } else + rval = at_statr (at, EDATAMAX) + if (! IS_INDEFR(rval)) { + if (imaccf (im, Memc[kfield]) == YES) { + #if (update || verbose) { + if (verbose) { + call printf (" Keyword %s already exists\n") + call pargstr (Memc[kfield]) + } + } else { + if (update) + call imaddr (im, Memc[kfield], rval) + #if (update || verbose) { + if (verbose) { + call printf ( + " Adding default keyword %s = %g to image\n") + call pargstr (Memc[kfield]) + call pargr (rval) + } + } + } + + case HDR_EGAIN: + sym = stfind (imst, Memc[kfield]) + if (sym != NULL) { + if (streq (AT_IMSTKVAL(sym), "INDEF")) + rval = at_statr (at, EGAIN) + else iferr (rval = imgetr (im, AT_IMSTKVAL(sym))) + rval = at_statr (at, EGAIN) + } else + rval = at_statr (at, EGAIN) + if (! IS_INDEFR(rval)) { + if (imaccf (im, Memc[kfield]) == YES) { + #if (update || verbose) { + if (verbose) { + call printf (" Keyword %s already exists\n") + call pargstr (Memc[kfield]) + } + } else { + if (update) + call imaddr (im, Memc[kfield], rval) + #if (update || verbose) { + if (verbose) { + call printf ( + " Adding default keyword %s = %0.1f to image\n") + call pargstr (Memc[kfield]) + call pargr (rval) + } + } + } + + case HDR_ERDNOISE: + sym = stfind (imst, Memc[kfield]) + if (sym != NULL) { + if (streq (AT_IMSTKVAL(sym), "INDEF")) + rval = at_statr (at, ERDNOISE) + else iferr (rval = imgetr (im, AT_IMSTKVAL(sym))) + rval = at_statr (at, ERDNOISE) + } else + rval = at_statr (at, ERDNOISE) + if (! IS_INDEFR(rval)) { + if (imaccf (im, Memc[kfield]) == YES) { + #if (update || verbose) { + if (verbose) { + call printf (" Keyword %s already exists\n") + call pargstr (Memc[kfield]) + } + } else { + if (update) + call imaddr (im, Memc[kfield], rval) + #if (update || verbose) { + if (verbose) { + call printf ( + " Adding default keyword %s = %0.1f to image\n") + call pargstr (Memc[kfield]) + call pargr (rval) + } + } + } + + case HDR_EWAVLEN: + sym = stfind (imst, Memc[kfield]) + if (sym != NULL) { + if (streq (AT_IMSTKVAL(sym), "INDEF")) + rval = at_statr (at, EWAVLEN) + else iferr (rval = imgetr (im, AT_IMSTKVAL(sym))) + rval = at_statr (at, EWAVLEN) + } else + rval = at_statr (at, EWAVLEN) + if (! IS_INDEFR(rval)) { + if (imaccf (im, Memc[kfield]) == YES) { + #if (update || verbose) { + if (verbose) { + call printf (" Keyword %s already exists\n") + call pargstr (Memc[kfield]) + } + } else { + if (update) + call imaddr (im, Memc[kfield], rval) + #if (update || verbose) { + if (verbose) { + call printf ( + " Adding default keyword %s = %0.1f to header\n") + call pargstr (Memc[kfield]) + call pargr (rval) + } + } + } + + case HDR_ETEMP: + sym = stfind (imst, Memc[kfield]) + if (sym != NULL) { + if (streq (AT_IMSTKVAL(sym), "INDEF")) + rval = at_statr (at, ETEMP) + else iferr (rval = imgetr (im, AT_IMSTKVAL(sym))) + rval = at_statr (at, ETEMP) + } else + rval = at_statr (at, ETEMP) + if (! IS_INDEFR(rval)) { + if (imaccf (im, Memc[kfield]) == YES) { + #if (update || verbose) { + if (verbose) { + call printf (" Keyword %s already exists\n") + call pargstr (Memc[kfield]) + } + } else { + if (update) + call imaddr (im, Memc[kfield], rval) + #if (update || verbose) { + if (verbose) { + call printf ( + " Adding default keyword %s to image header\n") + call pargstr (Memc[kfield]) + call pargr (rval) + } + } + } + + case HDR_EPRESS: + sym = stfind (imst, Memc[kfield]) + if (sym != NULL) { + if (streq (AT_IMSTKVAL(sym), "INDEF")) + rval = at_statr (at, EPRESS) + else iferr (rval = imgetr (im, AT_IMSTKVAL(sym))) + rval = at_statr (at, EPRESS) + } else + rval = at_statr (at, EPRESS) + if (! IS_INDEFR(rval)) { + if (imaccf (im, Memc[kfield]) == YES) { + #if (update || verbose) { + if (verbose) { + call printf (" Keyword %s already exists\n") + call pargstr (Memc[kfield]) + } + } else { + if (update) + call imaddr (im, Memc[kfield], rval) + #if (update || verbose) { + if (verbose) { + call printf ( + " Adding default keyword %s = %g to header\n") + call pargstr (Memc[kfield]) + call pargr (rval) + } + } + } + + default: + ; + } + } + + call sfree (sp) +end + + +# AT_AKEYWORD -- Add a new keyword to the image header. Note that at present +# nothing is done with the units information although this may be used in the +# future. + +int procedure at_akeyword (im, kname, kvalue, ktype, kunits, update) + +pointer im #I the image descriptor +char kname[ARB] #I the image keyword name +char kvalue[ARB] #I the image keyword value +int ktype #I the image keyword data type +char kunits[ARB] #I the image keyword units (not used) +bool update #I actually update the header ? + +double dval +real rval +long lval +int ip, stat +int ctod(), ctor(), ctol() + +begin + stat = OK + + switch (ktype) { + + case TY_DOUBLE: + ip = 1 + if (ctod (kvalue, ip, dval) > 0) { + if (update) + call imaddd (im, kname, dval) + } else + stat = ERR + + case TY_REAL: + ip = 1 + if (ctor (kvalue, ip, rval) > 0) { + if (update) + call imaddr (im, kname, rval) + } else + stat = ERR + + case TY_LONG, TY_INT, TY_SHORT: + ip = 1 + if (ctol (kvalue, ip, lval) > 0) { + if (update) + call imaddl (im, kname, lval) + } else + stat = ERR + + default: + if (update) + call imastr (im, kname, kvalue) + } + + return (stat) +end diff --git a/noao/astcat/src/agetcat/atincat.x b/noao/astcat/src/agetcat/atincat.x new file mode 100644 index 00000000..1d0ce61e --- /dev/null +++ b/noao/astcat/src/agetcat/atincat.x @@ -0,0 +1,70 @@ +# AT_GAPARS -- Read in the algorithm parameters for the AGETCAT task. + +procedure at_gapars (at) + +pointer at #I the pointer to the main astrom structure + +begin + # Initialize the region parameters. + call at_grcpset ("aregpars", at) + + # Initialize the catalog filter / selection parameters. + call at_gfspset ("afiltpars", at) +end + + +# AT_FAPARS -- Read in the algorithm parameters for the AFILTCAT task. + +procedure at_fapars (at) + +pointer at #I the pointer to the main astrom structure + +begin + # Initialize the catalog filter / selection parameters. + call at_gfspset ("afiltpars", at) +end + + +# AT_GIAPARS -- Read in the algorithm parameters for the AGETIM task. + +procedure at_giapars (at) + +pointer at #I the pointer to the main astrom structure + +begin + # Initialize the region parameters. + call at_grcpset ("aregpars", at) + + # Initialize the default wcs parameters. + #call at_gwcpset ("awcspars", at) + + # Initialize the default image data parameters. + #call at_gimpset ("aimpars", at) +end + + +# AT_HAPARS -- Read in the algorithm parameters for the AHEDIT task. + +procedure at_hapars (at) + +pointer at #I the pointer to the main astrom structure + +begin + # Initialize the default wcs parameters. + call at_gwcpset ("awcspars", at) + + # Initialize the default image data parameters. + call at_gimpset ("aimpars", at) +end + + +# AT_IAPARS -- Read in the algorithm parameters for the AIMFIND task. + +procedure at_iapars (at) + +pointer at #I the pointer to the main astrom structure + +begin + # Initialize the catalog filter / selection parameters. + call at_gfspset ("afiltpars", at) +end diff --git a/noao/astcat/src/agetcat/atoutcat.x b/noao/astcat/src/agetcat/atoutcat.x new file mode 100644 index 00000000..a3215003 --- /dev/null +++ b/noao/astcat/src/agetcat/atoutcat.x @@ -0,0 +1,72 @@ + + +# AT_GPPARS -- Update the AGETCAT task algorithm parameter sets. + +procedure at_gppars (at) + +pointer at #I the pointer to the main astrom structure + +begin + # Update the region definition parameters. + call at_prcpset ("aregpars", at) + + # Update the catalog filtering parameters. + call at_pfspset ("afiltpars", at) +end + + +# AT_FPPARS -- Update the AFILTCAT task algorithm parameter sets. + +procedure at_fppars (at) + +pointer at #I the pointer to the main astrom structure + +begin + # Update the catalog filtering parameters. + call at_pfspset ("afiltpars", at) +end + + +# AT_GIPPARS -- Update the AGETIM task algorithm parameter sets. + +procedure at_gippars (at) + +pointer at #I the pointer to the main astrom structure + +begin + # Update the region definition parameters. + call at_prcpset ("aregpars", at) + + # Update the default wcs parameters. + #call at_pwcpset ("awcspars", at) + + # Update the default image data parameters. + #call at_pimpset ("aimpars", at) +end + + +# AT_HPPARS -- Update the AHEDIT task algorithm parameter sets. + +procedure at_hppars (at) + +pointer at #I the pointer to the main astrom structure + +begin + # Update the default wcs parameters. + call at_pwcpset ("awcspars", at) + + # Update the default image data parameters. + call at_pimpset ("aimpars", at) +end + + +# AT_IPPARS -- Update the AIMFIND task algorithm parameter sets. + +procedure at_ippars (at) + +pointer at #I the pointer to the main astrom structure + +begin + # Update the catalog filtering parameters. + call at_pfspset ("afiltpars", at) +end diff --git a/noao/astcat/src/agetcat/atrcquery.x b/noao/astcat/src/agetcat/atrcquery.x new file mode 100644 index 00000000..393f7b4c --- /dev/null +++ b/noao/astcat/src/agetcat/atrcquery.x @@ -0,0 +1,522 @@ +include <math.h> +include <pkg/cq.h> +include <pkg/skywcs.h> +include "../../lib/astrom.h" +include "../../lib/acatalog.h" + +# AT_RCQUERY -- Format the catalog query for the specified field using +# field data supplied by the user and stored in a symbol table and query +# information stored in the catalog database. + +int procedure at_rcquery (at, cq, fieldno) + +pointer at #I the astrometry pacakge descriptor +pointer cq #I the database descriptor +int fieldno #I the field number descriptor + +double ra, dec, width +pointer sp, qsystem, fsystem, qpname, qpvalue, qpunits, qpformats, raformats +pointer decformats, symbol, qcoo, fcoo, mw +int i, stat, parno, units, nqpars + +pointer stfind(), at_statp() +int sk_decwcs(), cq_nqpars(), cq_gqparn(), cq_sqpar(), strdic(), at_wrdstr() +int sk_stati() +bool streq() +errchk cq_fgwrd() + +begin + call smark (sp) + + # Allocate space for the coordinate system descriptions. + call salloc (qsystem, SZ_FNAME, TY_CHAR) + call salloc (fsystem, SZ_FNAME, TY_CHAR) + + # Fetch the field center symbol. + call sprintf (Memc[qsystem], SZ_FNAME, "%s%d") + call pargstr (DEF_RCST_ROOTNAME) + call pargi (fieldno) + symbol = stfind (at_statp(at, RCST), Memc[qsystem]) + if (symbol == NULL) { + call sfree (sp) + return (ERR) + } + + # Determine the query coordinate system. If the query coordinate system + # is undefined, set it to the current catalog coordinate system. If + # the catalog system is undefined set it to the global default. + iferr (call cq_fgwrd (cq, "qsystem", Memc[qsystem], SZ_FNAME)) { + iferr (call cq_fgwrd (cq, "csystem", Memc[qsystem], SZ_FNAME)) + call strcpy ("DEF_CATSYSTEM", Memc[qsystem], SZ_FNAME) + } + if (Memc[qsystem] == EOS || streq (Memc[qsystem], "INDEF")) + call strcpy ("DEF_CATSYSTEM", Memc[qsystem], SZ_FNAME) + + # Open the query coordinate system data structure. + stat = sk_decwcs (Memc[qsystem], mw, qcoo, NULL) + if (stat == ERR || mw != NULL) { + if (mw != NULL) + call mw_close (mw) + call sk_close (qcoo) + call sfree (sp) + return (ERR) + } + + # Determine the field center coordinate system. If the field center + # coordinate system is undefined, set it to the query coordinate + # system. + if (AT_RCSTSYSTEM(symbol) == EOS || streq (AT_RCSTSYSTEM(symbol), + "INDEF")) + call strcpy (Memc[qsystem], Memc[fsystem], SZ_FNAME) + else + call strcpy (AT_RCSTSYSTEM(symbol), Memc[fsystem], SZ_FNAME) + + # Open the field center coordinate system data structure. + stat = sk_decwcs (Memc[fsystem], mw, fcoo, NULL) + if (stat == ERR || mw != NULL) { + if (mw != NULL) + call mw_close (mw) + call sk_close (fcoo) + call sk_close (qcoo) + call sfree (sp) + return (ERR) + } + + # Allocate space for the query parameter description. + call salloc (qpname, CQ_SZ_QPNAME, TY_CHAR) + call salloc (qpvalue, CQ_SZ_QPVALUE, TY_CHAR) + call salloc (qpunits, CQ_SZ_QPUNITS, TY_CHAR) + call salloc (qpformats, CQ_SZ_QPFMTS, TY_CHAR) + call salloc (raformats, CQ_SZ_QPFMTS, TY_CHAR) + call salloc (decformats, CQ_SZ_QPFMTS, TY_CHAR) + + # Loop through the query parameter list encoding the non-coordinate + # system parameters. + nqpars = cq_nqpars (cq) + do i = 1, nqpars { + + # Get the query parameter description. + if (cq_gqparn (cq, i, Memc[qpname], CQ_SZ_QPNAME, Memc[qpvalue], + CQ_SZ_QPVALUE, Memc[qpunits], CQ_SZ_QPUNITS, Memc[qpformats], + CQ_SZ_QPFMTS) != i) + next + + parno = strdic (Memc[qpname], Memc[qpname], CQ_SZ_QPNAME, + AT_QRCFIELDS) + if (parno <= 0) + next + + # Field center right ascension. Set the units and save the format + # for later use since we cannot perform the coordinate + # transformation until both ra and dec units are decoded. + switch (parno) { + case AT_QRCRA: + units = strdic (Memc[qpunits], Memc[qpunits], CQ_SZ_QPUNITS, + SKY_LNG_UNITLIST) + if (units > 0) + call sk_seti (qcoo, S_NLNGUNITS, units) + switch (AT_RCSTRAUNITS(symbol)) { + case AT_DEGREES: + units = SKY_DEGREES + case AT_RADIANS: + units = SKY_RADIANS + case AT_HOURS: + units = SKY_HOURS + default: + units = sk_stati (fcoo, S_NLNGUNITS) + } + call sk_seti (fcoo, S_NLNGUNITS, units) + + call strcpy (Memc[qpformats], Memc[raformats], CQ_SZ_QPFMTS) + + # Field center declination. Set the units and save the format + # for later use since we cannot perform the coordinate + # transformation until both ra and dec units are decoded. + case AT_QRCDEC: + units = strdic (Memc[qpunits], Memc[qpunits], CQ_SZ_QPUNITS, + SKY_LAT_UNITLIST) + if (units > 0) + call sk_seti (qcoo, S_NLATUNITS, units) + switch (AT_RCSTDECUNITS(symbol)) { + case AT_DEGREES: + units = SKY_DEGREES + case AT_RADIANS: + units = SKY_RADIANS + default: + units = sk_stati (fcoo, S_NLATUNITS) + } + call sk_seti (fcoo, S_NLATUNITS, units) + + call strcpy (Memc[qpformats], Memc[decformats], CQ_SZ_QPFMTS) + + # Width. Input units are minutes. Output units are minutes or + # degrees. + case AT_QRCWIDTH: + width = max (AT_RCSTRAWIDTH(symbol), AT_RCSTDECWIDTH(symbol)) + if (streq (Memc[qpunits], "degrees")) + width = width / 60.0d0 + call sprintf (Memc[qpvalue], CQ_SZ_QPVALUE, Memc[qpformats]) + call pargd (width) + if (cq_sqpar (cq, Memc[qpname], Memc[qpvalue]) != i) + ; + + # Radius. Input units are minutes. Output units are minutes or + # degrees. + case AT_QRCRADIUS: + width = max (AT_RCSTRAWIDTH(symbol), + AT_RCSTDECWIDTH(symbol)) / 2.0d0 + if (streq (Memc[qpunits], "degrees")) + width = width / 60.0d0 + call sprintf (Memc[qpvalue], CQ_SZ_QPVALUE, Memc[qpformats]) + call pargd (width) + if (cq_sqpar (cq, Memc[qpname], Memc[qpvalue]) != i) + ; + + # Half width. Input units are minutes. Output units are minutes or + # degrees. + case AT_QRCHWIDTH: + width = max (AT_RCSTRAWIDTH(symbol), + AT_RCSTDECWIDTH(symbol)) / 2.0d0 + if (streq (Memc[qpunits], "degrees")) + width = width / 60.0d0 + call sprintf (Memc[qpvalue], CQ_SZ_QPVALUE, Memc[qpformats]) + call pargd (width) + if (cq_sqpar (cq, Memc[qpname], Memc[qpvalue]) != i) + ; + + # Ra width. Input units are minutes. Output units are minutes or + # degrees. + case AT_QRCRAWIDTH: + width = AT_RCSTRAWIDTH(symbol) + if (streq (Memc[qpunits], "degrees")) + width = width / 60.0d0 + call sprintf (Memc[qpvalue], CQ_SZ_QPVALUE, Memc[qpformats]) + call pargd (width) + if (cq_sqpar (cq, Memc[qpname], Memc[qpvalue]) != i) + ; + + # Dec width. Input units are minutes. Output units are minutes or + # degrees. + case AT_QRCDECWIDTH: + width = AT_RCSTDECWIDTH(symbol) + if (streq (Memc[qpunits], "degrees")) + width = width / 60.0d0 + call sprintf (Memc[qpvalue], CQ_SZ_QPVALUE, Memc[qpformats]) + call pargd (width) + if (cq_sqpar (cq, Memc[qpname], Memc[qpvalue]) != i) + ; + + # Ra half width. Input units are minutes. Output units are minutes + # or degrees. + case AT_QRCRAHWIDTH: + width = AT_RCSTRAWIDTH(symbol) / 2.0 + if (streq (Memc[qpunits], "degrees")) + width = width / 60.0d0 + call sprintf (Memc[qpvalue], CQ_SZ_QPVALUE, Memc[qpformats]) + call pargd (width) + if (cq_sqpar (cq, Memc[qpname], Memc[qpvalue]) != i) + ; + + # Dec half width. Input units are minutes. Output units are minutes + # or degrees. + case AT_QRCDECHWIDTH: + width = AT_RCSTDECWIDTH(symbol) / 2.0 + if (streq (Memc[qpunits], "degrees")) + width = width / 60.0d0 + call sprintf (Memc[qpvalue], CQ_SZ_QPVALUE, Memc[qpformats]) + call pargd (width) + if (cq_sqpar (cq, Memc[qpname], Memc[qpvalue]) != i) + ; + + # X width. Input units are minutes. Output units are minutes + # or degrees. + case AT_QRCXWIDTH: + width = AT_RCSTRAWIDTH(symbol) + if (streq (Memc[qpunits], "degrees")) + width = width / 60.0d0 + call sprintf (Memc[qpvalue], CQ_SZ_QPVALUE, Memc[qpformats]) + call pargd (width) + if (cq_sqpar (cq, Memc[qpname], Memc[qpvalue]) != i) + ; + + # Y width. Input units are minutes. Output units are minutes + # or degrees. + case AT_QRCYWIDTH: + width = AT_RCSTDECWIDTH(symbol) + if (streq (Memc[qpunits], "degrees")) + width = width / 60.0d0 + call sprintf (Memc[qpvalue], CQ_SZ_QPVALUE, Memc[qpformats]) + call pargd (width) + if (cq_sqpar (cq, Memc[qpname], Memc[qpvalue]) != i) + ; + + # X half width. Input units are minutes. Output units are minutes + # or degrees. + case AT_QRCXHWIDTH: + width = AT_RCSTRAWIDTH(symbol) / 2.0 + if (streq (Memc[qpunits], "degrees")) + width = width / 60.0d0 + call sprintf (Memc[qpvalue], CQ_SZ_QPVALUE, Memc[qpformats]) + call pargd (width) + if (cq_sqpar (cq, Memc[qpname], Memc[qpvalue]) != i) + ; + + # Y half width. Input units are minutes. Output units are minutes + # or degrees. + case AT_QRCYHWIDTH: + width = AT_RCSTDECWIDTH(symbol) / 2.0 + if (streq (Memc[qpunits], "degrees")) + width = width / 60.0d0 + call sprintf (Memc[qpvalue], CQ_SZ_QPVALUE, Memc[qpformats]) + call pargd (width) + if (cq_sqpar (cq, Memc[qpname], Memc[qpvalue]) != i) + ; + + + } + + } + + # Transform the ra and dec from the field center coordinate system to + # the query coordinate system and reformat the query. + call sk_ultran (fcoo, qcoo, AT_RCSTRA(symbol), AT_RCSTDEC(symbol), ra, + dec, 1) + if (at_wrdstr (AT_QRCRA, Memc[qpname], CQ_SZ_QPNAME, + AT_QRCFIELDS) > 0) { + call sprintf (Memc[qpvalue], CQ_SZ_QPVALUE, Memc[raformats]) + call pargd (ra) + if (cq_sqpar (cq, Memc[qpname], Memc[qpvalue]) == 0) + ; + } + if (at_wrdstr (AT_QRCDEC, Memc[qpname], CQ_SZ_QPNAME, + AT_QRCFIELDS) > 0) { + call sprintf (Memc[qpvalue], CQ_SZ_QPVALUE, Memc[decformats]) + call pargd (dec) + if (cq_sqpar (cq, Memc[qpname], Memc[qpvalue]) == 0) + ; + } + + # Cleanup. + call sk_close (fcoo) + call sk_close (qcoo) + call sfree (sp) + + return (OK) +end + + +# AT_RCREGION -- Determine the region extraction parameters for the specified +# field using field data supplied by the user and stored in a symbol table and +# information stored in the catalog . + +int procedure at_rcregion (at, cres, fieldno, ra, dec, rawidth, decwidth) + +pointer at #I the astrometry pacakge descriptor +pointer cres #I the catalog results descriptor +int fieldno #I the field number descriptor +double ra #O the field center ra in degrees +double dec #O the field center dec in degrees +double rawidth #O the field ra width in degrees +double decwidth #O the field dec width in degrees + +pointer sp, qsystem, fsystem, raname, decname, raunits, decunits +pointer symbol, mw, qcoo, fcoo +int stat, units +pointer stfind(), at_statp() +int sk_decwcs(), cq_hinfo(), strdic(), sk_stati() +bool streq() +errchk at_stats() + +begin + call smark (sp) + + # Allocate space for the coordinate system descriptions. + call salloc (qsystem, SZ_FNAME, TY_CHAR) + call salloc (fsystem, SZ_FNAME, TY_CHAR) + call salloc (raname, CQ_SZ_FNAME, TY_CHAR) + call salloc (decname, CQ_SZ_FNAME, TY_CHAR) + call salloc (raunits, CQ_SZ_FNAME, TY_CHAR) + call salloc (decunits, CQ_SZ_FNAME, TY_CHAR) + + # Fetch the field center symbol. + call sprintf (Memc[qsystem], SZ_FNAME, "%s%d") + call pargstr (DEF_RCST_ROOTNAME) + call pargi (fieldno) + symbol = stfind (at_statp(at, RCST), Memc[qsystem]) + if (symbol == NULL) { + call sfree (sp) + return (ERR) + } + + # Set the query coordinate system to the catalog coordinate system. + # the catalog system is undefined set it to the global default. + if (cq_hinfo (cres, "csystem", Memc[qsystem], SZ_FNAME) <= 0) + Memc[qsystem] = EOS + if (Memc[qsystem] == EOS || streq (Memc[qsystem], "INDEF")) + call strcpy ("DEF_CATSYSTEM", Memc[qsystem], SZ_FNAME) + + # Open the query coordinate system data structure. + stat = sk_decwcs (Memc[qsystem], mw, qcoo, NULL) + if (stat == ERR || mw != NULL) { + if (mw != NULL) + call mw_close (mw) + call sk_close (qcoo) + call sfree (sp) + return (ERR) + } + + # Determine the field center coordinate system. If the field center + # coordinate system is undefined, set it to the query coordinate + # system. + if (AT_RCSTSYSTEM(symbol) == EOS || streq (AT_RCSTSYSTEM(symbol), + "INDEF")) + call strcpy (Memc[qsystem], Memc[fsystem], SZ_FNAME) + else + call strcpy (AT_RCSTSYSTEM(symbol), Memc[fsystem], SZ_FNAME) + + # Open the field center coordinate system data structure. + stat = sk_decwcs (Memc[fsystem], mw, fcoo, NULL) + if (stat == ERR || mw != NULL) { + if (mw != NULL) + call mw_close (mw) + call sk_close (fcoo) + call sk_close (qcoo) + call sfree (sp) + return (ERR) + } + + # Get the names of the columns containing ra and dec. + iferr (call at_stats (at, FIRA, Memc[raname], CQ_SZ_FNAME)) + call strcpy ("ra", Memc[raname], SZ_FNAME) + iferr (call at_stats (at, FIDEC, Memc[decname], CQ_SZ_FNAME)) + call strcpy ("dec", Memc[decname], SZ_FNAME) + + # Get the query ra units. + call cq_funits (cres, Memc[raname], Memc[raunits], CQ_SZ_FUNITS) + units = strdic (Memc[raunits], Memc[raunits], CQ_SZ_FUNITS, + SKY_LNG_UNITLIST) + if (units > 0) + call sk_seti (qcoo, S_NLNGUNITS, units) + else + units = sk_stati (qcoo, S_NLNGUNITS) + switch (AT_RCSTRAUNITS(symbol)) { + case AT_DEGREES: + units = SKY_DEGREES + case AT_RADIANS: + units = SKY_RADIANS + case AT_HOURS: + units = SKY_HOURS + default: + ; + } + call sk_seti (fcoo, S_NLNGUNITS, units) + + # Get the query dec units. + call cq_funits (cres, Memc[decname], Memc[decunits], CQ_SZ_FUNITS) + units = strdic (Memc[decunits], Memc[decunits], CQ_SZ_FUNITS, + SKY_LAT_UNITLIST) + if (units > 0) + call sk_seti (qcoo, S_NLATUNITS, units) + else + units = sk_stati (qcoo, S_NLATUNITS) + switch (AT_RCSTDECUNITS(symbol)) { + case AT_DEGREES: + units = SKY_DEGREES + case AT_RADIANS: + units = SKY_RADIANS + case AT_HOURS: + units = SKY_HOURS + default: + ; + } + call sk_seti (fcoo, S_NLATUNITS, units) + + # Transform the ra and dec from the field center coordinate system to + # the query coordinate system and convert the units to degrees. + call sk_ultran (fcoo, qcoo, AT_RCSTRA(symbol), AT_RCSTDEC(symbol), ra, + dec, 1) + + # Transform the ra, dec, and width parameters to degrees. + switch (sk_stati(qcoo, S_NLNGUNITS)) { + case SKY_HOURS: + ra = 15.0d0 * ra + case SKY_DEGREES: + ; + case SKY_RADIANS: + ra = DRADTODEG (ra) + default: + ; + } + switch (sk_stati(qcoo, S_NLATUNITS)) { + case SKY_HOURS: + dec = 15.0d0 * dec + case SKY_DEGREES: + ; + case SKY_RADIANS: + dec = DRADTODEG (dec) + default: + ; + } + rawidth = AT_RCSTRAWIDTH(symbol) / 60.0d0 + decwidth = AT_RCSTDECWIDTH(symbol) / 60.0d0 + + # Cleanup. + call sk_close (fcoo) + call sk_close (qcoo) + call sfree (sp) + + return (OK) +end + + +# AT_RCLIMITS -- Given the ra, dec, ra width, and dec width of the field +# compute the field corners. + +procedure at_rclimits (ra, dec, rawidth, decwidth, ra1, ra2, dec1, dec2) + +double ra #I the field center ra in degrees +double dec #I the field center dec in degrees +double rawidth #I the field ra width in degrees +double decwidth #I the field dec width in degrees +double ra1 #O lower ra limit in degrees +double ra2 #O upper ra limit in degrees +double dec1 #O lower dec limit in degrees +double dec2 #O upper dec limit in degrees + +double cosdec, dra + +begin + # Find the field corners. + dec1 = dec - 0.5d0 * decwidth + dec2 = dec + 0.5d0 * decwidth + if (dec1 <= -90.0d0) { + dec1 = -90.0d0 + dec2 = min (dec + 0.5d0 * decwidth, 90.0d0) + ra1 = 0.0d0 + ra2 = 360.0d0 + return + } else if (dec2 >= 90.0d0) { + dec2 = 90.0d0 + dec1 = max (dec - 0.5d0 * decwidth, -90.0d0) + ra1 = 0.0d0 + ra2 = 360.0d0 + } else { + if (dec > 0.0d0) + cosdec = cos (DEGTORAD(dec2)) + else + cosdec = cos (DEGTORAD(dec1)) + dra = 0.50d0 * rawidth / cosdec + if (dra >= 180.0d0) { + ra1 = 0.0d0 + ra2 = 360.0d0 + } else { + ra1 = ra - dra + if (ra1 < 0.0d0) + ra1 = ra1 + 360.0d0 + ra2 = ra + dra + if (ra2 > 360.0d0) + ra2 = ra2 - 360.0d0 + } + } + +end diff --git a/noao/astcat/src/agetcat/atrcrd.x b/noao/astcat/src/agetcat/atrcrd.x new file mode 100644 index 00000000..7a770c4f --- /dev/null +++ b/noao/astcat/src/agetcat/atrcrd.x @@ -0,0 +1,314 @@ +include <fset.h> +include <imhdr.h> +include <mwset.h> +include <pkg/skywcs.h> +include "../../lib/astrom.h" +include "../../lib/acatalog.h" + +# AT_RCLIST -- Create a list of field centers. + +int procedure at_rclist (at, rcsource) + +pointer at #I the astrometry descriptor +char rcsource[ARB] #I the source of the regions list + +pointer sp, symname, st, sym +int nfields, fd, imlist +double at_statd() +pointer at_statp(), stopen(), stenter() +int at_stati(), access(), open(), imtopen(), at_rcread(), at_rcwcsim() +bool streq() + +begin + # Store the rcsource name in the data structure. + call at_sets (at, RCSOURCE, rcsource) + + # Check that the field center pointer is defined. + if (at_statp (at, PRCENTER) == NULL) + return (0) + + call smark (sp) + call salloc (symname, SZ_FNAME, TY_CHAR) + + # Open the symbol table. + if (at_statp (at, RCST) != NULL) + call stclose (at_statp(at, RCST)) + st = stopen ("fclist", 2 * DEF_LEN_RCST, DEF_LEN_RCST, + 10 * DEF_LEN_RCST) + call at_setp (at, RCST, st) + + # The source is the fcpars parameter set. + if (streq (rcsource, "pars")) { + + if (at_statd (at, RCRA) < 0.0d0 || at_statd(at, RCRA) > 360.0d0) + nfields = 0 + else if (at_statd (at, RCDEC) < -90.0d0 || at_statd(at, RCDEC) > + 90.0d0) + nfields = 0 + else if (at_statd (at, RCRAWIDTH) / 60.0d0 <= 0.0d0 || + at_statd(at, RCRAWIDTH) / 60.0d0 > 360.0d0) + nfields = 0 + else if (at_statd (at, RCDECWIDTH) / 60.0d0 <= 0.0d0 || + at_statd(at, RCDECWIDTH) / 60.0d0 > 180.0d0) + nfields = 0 + else { + call sprintf (Memc[symname], SZ_FNAME, "%s1") + call pargstr (DEF_RCST_ROOTNAME) + sym = stenter (st, Memc[symname], LEN_RCST_STRUCT) + AT_RCSTRA(sym) = at_statd (at, RCRA) + AT_RCSTDEC(sym) = at_statd (at, RCDEC) + AT_RCSTRAWIDTH(sym) = at_statd (at, RCRAWIDTH) + AT_RCSTDECWIDTH(sym) = at_statd (at, RCDECWIDTH) + AT_RCSTRAUNITS(sym) = at_stati (at, RCRAUNITS) + AT_RCSTDECUNITS(sym) = at_stati (at, RCDECUNITS) + call at_stats (at, RCSYSTEM, Memc[symname], SZ_FNAME) + call strcpy (Memc[symname], AT_RCSTSYSTEM(sym), SZ_FNAME) + call strcpy ("pars", AT_RCSTSOURCE(sym), SZ_FNAME) + call strcpy ("", AT_RCSTNAME(sym), SZ_FNAME) + nfields = 1 + } + + # The source is a text file. + } else if (access (rcsource, READ_ONLY, TEXT_FILE) == YES) { + + fd = open (rcsource, READ_ONLY, TEXT_FILE) + nfields = at_rcread (fd, at, st) + call close (fd) + + # The field center source is a list of images. Assume for now that + # images with celestial coordinate systems have a wcs system name + # of "image". This is true of images with a standard FITS wcs and + # for images with a wcs created by the core IRAF tasks. + } else { + imlist = imtopen (rcsource) + nfields = at_rcwcsim (imlist, at, st) + call imtclose (imlist) + } + + call sfree (sp) + + return (nfields) +end + + +# AT_RCREAD -- Read in the field center information from a text file. + +int procedure at_rcread (fd, at, st) + +int fd #I the field center file descriptor +pointer at #I the astrometry descriptor +pointer st #I the field center symbol table descriptor. + +double ra, dec, rawidth, decwidth +pointer sp, symname, sym +int nfields +pointer stenter() +int fscan(), nscan(), at_stati(), strdic() + +begin + call smark (sp) + call salloc (symname, SZ_FNAME, TY_CHAR) + + nfields = 0 + while (fscan(fd) != EOF) { + + # Get the minimum number of fields. + call gargd (ra) + call gargd (dec) + call gargd (rawidth) + call gargd (decwidth) + if (nscan() < 4) + next + if (ra < 0.0d0 || ra > 360.0d0) + next + if (dec < -90.0d0 || dec > 90.0d0) + next + if (rawidth / 60.0d0 <= 0.0d0 || rawidth / 60.0d0 > 360.0d0) + next + if (decwidth / 60.0d0 <= 0.0d0 || decwidth / 60.0d0 > 180.0d0) + next + + # Get the next symbols. + nfields = nfields + 1 + call sprintf (Memc[symname], SZ_FNAME, "%s%d") + call pargstr (DEF_RCST_ROOTNAME) + call pargi (nfields) + sym = stenter (st, Memc[symname], LEN_RCST_STRUCT) + + AT_RCSTRA(sym) = ra + AT_RCSTDEC(sym) = dec + AT_RCSTRAWIDTH(sym) = rawidth + AT_RCSTDECWIDTH(sym) = decwidth + + # Set the source and source name. + call strcpy ("file", AT_RCSTSOURCE(sym), SZ_FNAME) + call fstats (fd, F_FILENAME, Memc[symname], SZ_FNAME) + call strcpy (Memc[symname], AT_RCSTNAME(sym), SZ_FNAME) + + # Decode the units. + call gargwrd (Memc[symname], SZ_FNAME) + if (nscan() < 5) { + AT_RCSTRAUNITS(sym) = at_stati (at, RCRAUNITS) + AT_RCSTDECUNITS(sym) = at_stati (at, RCDECUNITS) + call at_stats (at, RCSYSTEM, Memc[symname], SZ_FNAME) + call strcpy (Memc[symname], AT_RCSTSYSTEM(sym), SZ_FNAME) + next + } else + AT_RCSTRAUNITS(sym) = strdic (Memc[symname], Memc[symname], + SZ_FNAME, AT_RA_UNITS) + call gargwrd (Memc[symname], SZ_FNAME) + if (nscan() < 6) { + AT_RCSTDECUNITS(sym) = at_stati (at, RCDECUNITS) + call at_stats (at, RCSYSTEM, Memc[symname], SZ_FNAME) + call strcpy (Memc[symname], AT_RCSTSYSTEM(sym), SZ_FNAME) + next + } else + AT_RCSTDECUNITS(sym) = strdic (Memc[symname], Memc[symname], + SZ_FNAME, AT_DEC_UNITS) + + # Decode the coordinate system. + call gargstr (Memc[symname], SZ_FNAME) + if (Memc[symname] == EOS || nscan() < 7) { + call at_stats (at, RCSYSTEM, Memc[symname], SZ_FNAME) + call strcpy (Memc[symname], AT_RCSTSYSTEM(sym), SZ_FNAME) + } else + call strcpy (Memc[symname], AT_RCSTSYSTEM(sym), SZ_FNAME) + + } + + call sfree (sp) + + return (nfields) +end + + +# AT_RCWCSIM -- Read in the field center information from a list of images. + +int procedure at_rcwcsim (imlist, at, st) + +int imlist #I the image list descriptor +pointer at #I the astrometry descriptor +pointer st #I the field center symbol table descriptor. + +double ra, dec, width +pointer sp, image, symname, im, mw, coo, sym, ct +int nfields +pointer immap(), mw_sctran(), stenter() +int imtgetim(), sk_decim(), sk_stati() + +begin + call smark (sp) + call salloc (image, SZ_FNAME, TY_CHAR) + call salloc (symname, SZ_FNAME, TY_CHAR) + + nfields = 0 + while (imtgetim (imlist, Memc[image], SZ_FNAME) != EOF) { + + # The image must be 2D. + im = immap (Memc[image], READ_ONLY, 0) + if (IM_NDIM(im) != 2) { + call imunmap (im) + next + } + + # The image must have a FITS celestial coordinate system. + if (sk_decim (im, "world", mw, coo) == ERR) { + if (mw != NULL) + call mw_close (mw) + call sk_close (coo) + call imunmap (im) + next + } + + # Find the center of the image. + ct = mw_sctran (mw, "logical", "world", 03B) + call mw_c2trand (ct, double((1.0d0 + IM_LEN(im,1)) / 2.0d0), + double((1.0d0 + IM_LEN(im,2)) / 2.0d0), ra, dec) + if (ra < 0.0d0 || ra > 360.0d0) + next + if (dec < -90.0d0 || dec > 90.0d0) + next + + # Find the width of the field. + call at_gfwidth (im, mw, sk_stati(coo, S_PLNGAX), + sk_stati(coo, S_PLATAX), width) + + # Get the next symol. + nfields = nfields + 1 + call sprintf (Memc[symname], SZ_FNAME, "%s%d") + call pargstr (DEF_RCST_ROOTNAME) + call pargi (nfields) + sym = stenter (st, Memc[symname], LEN_RCST_STRUCT) + + AT_RCSTRA(sym) = ra + AT_RCSTDEC(sym) = dec + AT_RCSTRAWIDTH(sym) = width + AT_RCSTDECWIDTH(sym) = width + AT_RCSTRAUNITS(sym) = AT_DEGREES + AT_RCSTDECUNITS(sym) = AT_DEGREES + call sk_enwcs (coo, AT_RCSTSYSTEM(sym), SZ_FNAME) + + call strcpy ("image", AT_RCSTSOURCE(sym), SZ_FNAME) + call strcpy (Memc[image], AT_RCSTNAME(sym), SZ_FNAME) + + # Cleanup. + call sk_close (coo) + call mw_close (mw) + call imunmap (im) + } + + call sfree (sp) + + return (nfields) +end + + +define NEWCD Memd[ncd+(($2)-1)*ndim+($1)-1] + +# AT_GFWIDTH -- Estimate the field width in arcminutes from the size of the +# image and the image wcs. + +procedure at_gfwidth (im, mw, lngax, latax, width) + +pointer im #I the input image desciptor +pointer mw #I the input wcs descriptor +int lngax #I the longitude axis +int latax #I the latitude axis +double width #O the output field width in minutes of arc + +double scale +pointer r, cd, ltm, iltm, ncd +int ndim +int mw_stati() + +begin + # Get the dimension of the wcs. + ndim = mw_stati (mw, MW_NPHYSDIM) + + # Allocate working memory. + call malloc (r, ndim * ndim, TY_DOUBLE) + call malloc (cd, ndim * ndim, TY_DOUBLE) + call malloc (ltm, ndim * ndim, TY_DOUBLE) + call malloc (iltm, ndim * ndim, TY_DOUBLE) + call malloc (ncd, ndim * ndim, TY_DOUBLE) + + # Compute the original world to logical transformation. + call mw_gwtermd (mw, Memd[r], Memd[r], Memd[cd], ndim) + call mw_gltermd (mw, Memd[ltm], Memd[r], ndim) + call mwinvertd (Memd[ltm], Memd[iltm], ndim) + call mwmmuld (Memd[cd], Memd[iltm], Memd[ncd], ndim) + + # Estimate the scale. + scale = max (sqrt (NEWCD(lngax,lngax)**2 + NEWCD(lngax,latax)**2), + sqrt (NEWCD(latax,lngax)**2 + NEWCD(latax,latax)**2)) + + # Compute the width + width = 60.0d0 * scale * max (IM_LEN(im,1), IM_LEN(im,2)) + + # Free the space. + call mfree (r, TY_DOUBLE) + call mfree (cd, TY_DOUBLE) + call mfree (ncd, TY_DOUBLE) + call mfree (ltm, TY_DOUBLE) + call mfree (iltm, TY_DOUBLE) +end diff --git a/noao/astcat/src/agetcat/atrcsym.x b/noao/astcat/src/agetcat/atrcsym.x new file mode 100644 index 00000000..268ea86b --- /dev/null +++ b/noao/astcat/src/agetcat/atrcsym.x @@ -0,0 +1,29 @@ +include "../../lib/astrom.h" + +# AT_RCSYM -- Return the symbol for the specified field nymber. + +pointer procedure at_rcsym (at, fieldno) + +pointer at #I the astrometry package descriptor +int fieldno #I the region whose symbol is to be locate + +pointer sp, symname, st, sym +pointer at_statp(), stfind() + +begin + st = at_statp (at, RCST) + if (st == NULL) + return (NULL) + + call smark (sp) + call salloc (symname, SZ_FNAME, TY_CHAR) + + call sprintf (Memc[symname], SZ_FNAME, "%s%d") + call pargstr (DEF_RCST_ROOTNAME) + call pargi (fieldno) + sym = stfind (st, Memc[symname]) + + call sfree (sp) + + return (sym) +end diff --git a/noao/astcat/src/agetcat/attquery.x b/noao/astcat/src/agetcat/attquery.x new file mode 100644 index 00000000..3f8ff6d4 --- /dev/null +++ b/noao/astcat/src/agetcat/attquery.x @@ -0,0 +1,183 @@ +include <math.h> +include <pkg/cq.h> +include <pkg/skywcs.h> +include "../../lib/astrom.h" + +# AT_TQUERY -- Extract catalog objects from a text file stored in a results +# query structure. + +pointer procedure at_tquery (at, cq, cres, hdrtext, nlines, fieldno) + +pointer at #I the astrometry package descriptor +pointer cq #I the astrometric catalog descriptor +pointer cres #I the input catalog results descriptor +char hdrtext[ARB] #I the catalog header test +int nlines #I the number of lines in the header text +int fieldno #I the region number + +double rac, decc, ra, dec, rawidth, decwidth, ra1, ra2, dec1, dec2, dist +double tra, trac +pointer sp, csystem, raname, decname, funits, tmpname, line +pointer res, ccoo, mw +int i, fd, strfd, stat, units +pointer cq_fquery() +int cq_rstati(), at_rcregion(), open(), strlen(), cq_hinfo(), sk_decwcs() +int stropen(), getline(), strdic(), cq_gvald(), cq_grecord(), sk_stati() +bool streq() + +begin + # Return if the input catalog is undefined or contains no records. + if (cres == NULL) + return (NULL) + if (cq_rstati (cres, CQRNRECS) <= 0) + return (NULL) + + # Return if the header is undefined. + if (nlines <= 0 || hdrtext[1] == EOS) + return (NULL) + + # Get the region to be extracted. + if (at_rcregion (at, cres, fieldno, rac, decc, rawidth, + decwidth) == ERR) + return (NULL) + + # Compute the ra and dec limits. + call at_rclimits (rac, decc, rawidth, decwidth, ra1, ra2, dec1, dec2) + + # Get some working space. + call smark (sp) + call salloc (csystem, CQ_SZ_FNAME, TY_CHAR) + call salloc (tmpname, SZ_FNAME, TY_CHAR) + call salloc (raname, CQ_SZ_FNAME, TY_CHAR) + call salloc (decname, CQ_SZ_FNAME, TY_CHAR) + call salloc (funits, CQ_SZ_FUNITS, TY_CHAR) + call salloc (line, SZ_LINE, TY_CHAR) + + # Open the catalog coordinate system. + if (cq_hinfo (cres, "csystem", Memc[csystem], SZ_FNAME) <= 0) + Memc[csystem] = EOS + if (Memc[csystem] == EOS || streq (Memc[csystem], "INDEF")) + call strcpy ("DEF_CATSYSTEM", Memc[csystem], SZ_FNAME) + + # Open the query coordinate system data structure. + stat = sk_decwcs (Memc[csystem], mw, ccoo, NULL) + if (stat == ERR || mw != NULL) { + if (mw != NULL) + call mw_close (mw) + call sk_close (ccoo) + call sfree (sp) + return (NULL) + } + + # Open the temporary results file. + call mktemp ("res", Memc[tmpname], SZ_FNAME) + fd = open (Memc[tmpname], NEW_FILE, TEXT_FILE) + + # Write the file header to the temporary results file. + strfd = stropen (hdrtext, strlen(hdrtext), READ_ONLY) + call fprintf (fd, "# BEGIN CATALOG HEADER\n") + while (getline (strfd, Memc[line]) != EOF) { + call fprintf (fd, "# %s") + call pargstr (Memc[line]) + } + call fprintf (fd, "# END CATALOG HEADER\n#\n") + call strclose (strfd) + + # Determine the names of the ra and dec columns. + iferr (call at_stats (at, FIRA, Memc[raname], CQ_SZ_FNAME)) + call strcpy ("ra", Memc[raname], CQ_SZ_FNAME) + iferr (call at_stats (at, FIDEC, Memc[decname], CQ_SZ_FNAME)) + call strcpy ("dec", Memc[decname], CQ_SZ_FNAME) + + # Determine the units of the ra and dec keywords. + call cq_funits (cres, Memc[raname], Memc[funits], CQ_SZ_QPUNITS) + units = strdic (Memc[funits], Memc[funits], CQ_SZ_FUNITS, + SKY_LNG_UNITLIST) + if (units > 0) + call sk_seti (ccoo, S_NLNGUNITS, units) + call cq_funits (cres, Memc[decname], Memc[funits], CQ_SZ_QPUNITS) + units = strdic (Memc[funits], Memc[funits], CQ_SZ_FUNITS, + SKY_LAT_UNITLIST) + if (units > 0) + call sk_seti (ccoo, S_NLATUNITS, units) + + # Loop over the catalog records selecting those that match + # the region description. + do i = 1, cq_rstati (cres, CQRNRECS) { + + # Decode the coordinates. + if (cq_gvald (cres, i, Memc[raname], ra) <= 0) + next + if (cq_gvald (cres, i, Memc[decname], dec) <= 0) + next + + # Determine the coordinate units. + switch (sk_stati(ccoo, S_NLNGUNITS)) { + case SKY_HOURS: + ra = 15.0d0 * ra + case SKY_DEGREES: + ; + case SKY_RADIANS: + ra = DRADTODEG(ra) + default: + ; + } + switch (sk_stati(ccoo, S_NLATUNITS)) { + case SKY_HOURS: + dec = 15.0d0 * dec + case SKY_DEGREES: + ; + case SKY_RADIANS: + dec = DRADTODEG(dec) + default: + ; + } + + # Test the limits + if (dec < dec1 || dec > dec2) + next + if (ra1 < ra2) { + if (ra < ra1 || ra > ra2) + next + } else { + if (ra > ra2 && ra < ra1) + next + } + + # Check the longitude coordinate distance to remove pathologies + # in longitude or latitude strips involving the pole. This is + # an extra test of my own. + if (ra1 < ra2) { + dist = abs (ra - rac) + } else { + if (ra > ra1) + tra = ra - 360.0d0 + else + tra = ra + if (rac > ra1) + trac = rac - 360.0d0 + else + trac = rac + dist = abs (tra - trac) + } + if (abs (2.0d0 * dist *cos(DEGTORAD(dec))) > rawidth) + next + + # Record has been selected. + if (cq_grecord (cres, Memc[line], SZ_LINE, i) <= 0) + next + call putline (fd, Memc[line]) + } + + # Close the tmeporary file. + call close (fd) + + # Query the temporary file and then delete it. + res = cq_fquery (cq, Memc[tmpname], hdrtext) + call delete (Memc[tmpname]) + + # Clean up. + call sfree (sp) + + return (res) +end diff --git a/noao/astcat/src/agetcat/atwcat.x b/noao/astcat/src/agetcat/atwcat.x new file mode 100644 index 00000000..01d9ef6b --- /dev/null +++ b/noao/astcat/src/agetcat/atwcat.x @@ -0,0 +1,197 @@ +include <pkg/cq.h> + +# AT_WNOFILRECS -- Write out the catalog header and records without filtering. + +procedure at_wnofilrecs (fd, res, standard) + +int fd #I the output file descriptor +pointer res #I the results descriptor +bool standard #I write a standard catalog header. + +int nlines, nrecs +int at_wcathdr(), at_wcatrecs() + +begin + # Write out the catalog header. + if (standard) + nlines = at_wcathdr (fd, res) + + # Write out the records. + nrecs = at_wcatrecs (fd, res) +end + + +# AT_WCATHDR -- Write out a catalog header. + +int procedure at_wcathdr (fd, res) + +int fd #I the output file descriptor +pointer res #I the results descriptor + +pointer sp, catname, qpnames, qpvalues, qpunits, fname, fvalue, funits, ffmts +int i, nlines, nfields, fsize, foffset, ftype +int at_wrdstr(), cq_rstati(), cq_hinfon(), cq_finfon() +char cq_itype() + +begin + nlines = 0 + + # Allocate working space. + call smark (sp) + call salloc (catname, SZ_FNAME, TY_CHAR) + call salloc (fname, max (CQ_SZ_QPNAME, CQ_SZ_FNAME), TY_CHAR) + call salloc (fvalue, CQ_SZ_QPVALUE, TY_CHAR) + call salloc (funits, max (CQ_SZ_QPUNITS, CQ_SZ_FUNITS), TY_CHAR) + call salloc (ffmts, CQ_SZ_FFMTS, TY_CHAR) + call salloc (qpnames, SZ_LINE, TY_CHAR) + call salloc (qpvalues, SZ_LINE, TY_CHAR) + call salloc (qpunits, SZ_LINE, TY_CHAR) + + # Write the header banner. + call fprintf (fd, "# BEGIN CATALOG HEADER\n") + nlines = nlines + 1 + + # Write the catalog database and id. + call cq_rstats (res, CQRCATDB, Memc[catname], SZ_FNAME) + call fprintf (fd, "# catdb %s\n") + call pargstr (Memc[catname]) + nlines = nlines + 1 + call cq_rstats (res, CQRCATNAME, Memc[catname], SZ_FNAME) + call fprintf (fd, "# catname %s\n") + call pargstr (Memc[catname]) + nlines = nlines + 1 + + # Write out the query parameter names, values, and units used + # to generate the catalog. + call cq_rstats (res, CQRQPNAMES, Memc[qpnames], SZ_LINE) + call cq_rstats (res, CQRQPVALUES, Memc[qpvalues], SZ_LINE) + call cq_rstats (res, CQRQPUNITS, Memc[qpunits], SZ_LINE) + nfields = cq_rstati (res, CQRNQPARS) + call fprintf (fd, "# nquery %d\n") + call pargi (nfields) + nlines = nlines + 1 + do i = 1, nfields { + if (at_wrdstr (i, Memc[fname], CQ_SZ_QPNAME, Memc[qpnames]) != i) + ; + if (at_wrdstr (i, Memc[fvalue], CQ_SZ_QPVALUE, Memc[qpvalues]) != i) + ; + if (at_wrdstr (i, Memc[funits], CQ_SZ_QPUNITS, Memc[qpunits]) != i) + ; + call fprintf (fd, "# %s %s %s\n") + call pargstr (Memc[fname]) + call pargstr (Memc[fvalue]) + call pargstr (Memc[funits]) + nlines = nlines + 1 + } + + # Write out the results format type. + if (at_wrdstr (cq_rstati(res, CQRTYPE), Memc[fvalue], CQ_SZ_QPVALUE, + CQ_RTYPESTR) <= 0) + call strcpy ("stext", Memc[fvalue], CQ_SZ_QPVALUE) + call fprintf (fd, "# type %s\n") + call pargstr (Memc[fvalue]) + nlines = nlines + 1 + + # Write out the header parameters, + nfields = cq_rstati (res, CQNHEADER) + call fprintf (fd, "# nheader %d\n") + call pargi (nfields) + nlines = nlines + 1 + do i = 1, nfields { + if (cq_hinfon (res, i, Memc[fname], CQ_SZ_QPNAME, Memc[fvalue], + CQ_SZ_QPVALUE) != i) + next + call fprintf (fd, "# %s %s\n") + call pargstr (Memc[fname]) + call pargstr (Memc[fvalue]) + nlines = nlines + 1 + } + + # Write out the field parameters. + nfields = cq_rstati (res, CQNFIELDS) + call fprintf (fd, "# nfields %d\n") + call pargi (nfields) + do i = 1, nfields { + if (cq_finfon (res, i, Memc[fname], CQ_SZ_FNAME, foffset, fsize, + ftype, Memc[funits], CQ_SZ_FUNITS, Memc[ffmts], + CQ_SZ_FFMTS) != i) + next + call fprintf (fd, "# %s %d %d %c %s %s\n") + call pargstr (Memc[fname]) + call pargi (foffset) + call pargi (fsize) + call pargc (cq_itype (ftype)) + call pargstr (Memc[funits]) + call pargstr (Memc[ffmts]) + nlines = nlines + 1 + } + + # Write the header trailer. + call fprintf (fd, "# END CATALOG HEADER\n#\n") + nlines = nlines + 1 + + call sfree (sp) + + return (nlines) +end + + +# AT_WCATRECS -- Write out the catalog records without modification, except +# for the builtin trim parameters. + +int procedure at_wcatrecs (fd, res) + +int fd #I the output file descriptor +pointer res #I the results descriptor + +pointer sp, record +int sz_rec, nrec, recptr, nchars +int cq_rstati(), cq_gnrecord() + +begin + # Allocate space for the record. For now SZ_LINE is the default. + if (cq_rstati(res, CQRECSIZE) > 0) + sz_rec = max (SZ_LINE, cq_rstati (res, CQRECSIZE)) + else + sz_rec = SZ_LINE + nrec = cq_rstati (res, CQRNRECS) + + # Allocate working space. + call smark (sp) + call salloc (record, sz_rec, TY_CHAR) + + # For the moment assume that the simple and blocked text file records + # are newline delimited, and that the simple text file fields are + # whitespace delimited. + + # Write the records. + switch (cq_rstati (res, CQRTYPE)) { + + case CQ_STEXT: + recptr = 0 + while (recptr < nrec) { + nchars = cq_gnrecord (res, Memc[record], sz_rec, recptr) + if (nchars == EOF) + break + call fprintf (fd, "%s") + call pargstr (Memc[record]) + } + + case CQ_BTEXT: + recptr = 0 + while (recptr < nrec) { + nchars = cq_gnrecord (res, Memc[record], sz_rec, recptr) + if (nchars == EOF) + break + call fprintf (fd, "%s") + call pargstr (Memc[record]) + } + + default: + ; + } + + call sfree (sp) + + return (recptr) +end diff --git a/noao/astcat/src/agetcat/atwedit.x b/noao/astcat/src/agetcat/atwedit.x new file mode 100644 index 00000000..7678eb35 --- /dev/null +++ b/noao/astcat/src/agetcat/atwedit.x @@ -0,0 +1,83 @@ +include <imhdr.h> +include <pkg/cq.h> + +# Add a valid WCS to the image header if it does not already have one using +# the image WCS status specified by the wcs keyword in the image survey +# database. If the wcs keyord is "fits", the image is assumed to have a +# valid FITS WCS and no new wcs is computed, if it is "dss" the image is assumed +# to have a valid DSS image header which will be transformed to a valid FITS +# WCS if a FITS WCS is not already present, if it is "none" the image is +# assumed to have no valid WCS and the code will attempt to insert one using +# information in the image results structure. An error status is returned +# only if there is no valid wcs code. + +procedure at_wedit (im, res, at, wcstype, update, verbose) + +pointer im #I the input image descriptor +pointer res #I the image query results descriptor +pointer at #I the astrometry package descriptor +int wcstype #I the default wcs type +bool update #I actually update the header ? +bool verbose #I verbose mode ? + +int cq_istati(), at_mkdss(), at_dbwcs(), at_parwcs() + +begin + # Update WCS from database + if (res != NULL) { + + switch (cq_istati (res, CQWCS)) { + + # Image surveys database indicates image already has a FITS WCS. + case CQ_WFITS: + ; + + # Image surveys database indicates image has a DSS WCS. + case CQ_WDSS: + if (at_mkdss (im, update, verbose) == ERR) { + #if (update || verbose) + if (verbose) + call printf ( + " Error converting DSS wcs to FITS wcs\n") + } + + # Image surveys database indicates image has no WCS. If the proper + # information is not in the image survey then default to awcspars. + default: + if (at_dbwcs (im, res, update, verbose) == ERR) { + #if (update || verbose) + if (verbose) + call printf ( + " Error creating FITS wcs using image survey db\n") + } + } + + } else { + + switch (wcstype) { + + # User parameter indicates image already has a FITS WCS. + case CQ_WFITS: + ; + + # User parameter indicates image has a DSS WCS. + case CQ_WDSS: + if (at_mkdss (im, update, verbose) == ERR) { + #if (update || verbose) + if (verbose) + call printf ( + " Error converting DSS wcs to FITS wcs\n") + } + + default: + if (at == NULL) + ; + else if (at_parwcs (im, at, update, verbose) == ERR) { + #if (update || verbose) + if (verbose) + call printf ( + " Error creating FITS wcs using default parameters\n") + } + } + } +end diff --git a/noao/astcat/src/agetcat/mkpkg b/noao/astcat/src/agetcat/mkpkg new file mode 100644 index 00000000..c8b025b5 --- /dev/null +++ b/noao/astcat/src/agetcat/mkpkg @@ -0,0 +1,31 @@ +# AGETCAT task subdirectory + +$checkout libpkg.a ".." +$update libpkg.a +$checkin libpkg.a ".." +$exit + +libpkg.a: + t_aclist.x + t_aslist.x + t_agetcat.x "../../lib/astrom.h" + t_afiltcat.x "../../lib/astrom.h" + t_agetim.x "../../lib/astrom.h" <pkg/cq.h> + t_ahedit.x "../../lib/astrom.h" <pkg/cq.h> + t_aimfind.x "../../lib/astrom.h" <pkg/cq.h> + atrcquery.x <math.h> <pkg/cq.h> <pkg/skywcs.h> \ + "../../lib/astrom.h" "../../lib/acatalog.h" + atrcrd.x <fset.h> <imhdr.h> <mwset.h> <pkg/skywcs.h> \ + "../../lib/astrom.h" "../../lib/acatalog.h" + attquery.x <math.h> <pkg/cq.h> <pkg/skywcs.h> "../../lib/astrom.h" + atwcat.x <pkg/cq.h> + atfcat.x <imhdr.h> <ctotok.h> <evvexpr.h> "../../lib/astrom.h" \ + <ctype.h> "../../lib/acatalog.h" <pkg/cq.h> \ + <pkg/skywcs.h> + athedit.x "../../lib/astrom.h" "../../lib/aimpars.h" <pkg/cq.h> + atwedit.x <imhdr.h> <pkg/cq.h> + atcatinit.x + atincat.x + atoutcat.x + atrcsym.x "../../lib/astrom.h" + ; diff --git a/noao/astcat/src/agetcat/t_aclist.x b/noao/astcat/src/agetcat/t_aclist.x new file mode 100644 index 00000000..4c13e1ed --- /dev/null +++ b/noao/astcat/src/agetcat/t_aclist.x @@ -0,0 +1,112 @@ +# T_ACLIST -- List the supported catalogs. + +procedure t_aclist() + +pointer sp, str1, str2, line, cq +int i, j, catlist, nquery, nheader, nfields +bool verbose +pointer cq_map() +int at_catlist(), fntlenb(), fntrfnb(), cq_setcat(), cq_fgeti(), cq_scan() +bool clgetb() +errchk cq_fgeti() + +begin + # Allocate some working memory. + call smark (sp) + call salloc (str1, SZ_FNAME, TY_CHAR) + call salloc (str2, SZ_FNAME, TY_CHAR) + call salloc (line, SZ_LINE, TY_CHAR) + + # Get the parameters. + call clgstr ("catalogs", Memc[str1], SZ_FNAME) + call clgstr ("catdb", Memc[str2], SZ_FNAME) + verbose = clgetb ("verbose") + + # Get the catalog list. + catlist = at_catlist (Memc[str1], Memc[str2]) + if (fntlenb (catlist) <= 0) { + if (verbose) + call printf ("The catalog list is empty\n") + call fntclsb (catlist) + call sfree (sp) + return + } + + # Open the catalog database. + cq = cq_map (Memc[str2], READ_ONLY) + if (verbose) { + call printf ("\nScanning catalog database %s\n") + call pargstr (Memc[str2]) + } + + # Loop over the catalogs. + if (verbose) + call printf ("Listing the supported catalogs\n") + do i = 1, fntlenb (catlist) { + + # Get the catalog name and set the current catalog. + if (fntrfnb (catlist, i, Memc[str1], SZ_FNAME) == EOF) + break + if (cq_setcat (cq, Memc[str1]) <= 0) { + next + } else { + call printf ("%s\n") + call pargstr (Memc[str1]) + } + + # Do a detailed listing. + if (verbose) { + iferr (nquery = cq_fgeti (cq, "nquery")) + nquery = 0 + call printf ("nquery %d\n") + call pargi (nquery) + if (nquery > 0) { + do j = 1, nquery { + if (cq_scan (cq) == EOF) + break + call gargstr (Memc[line], SZ_LINE) + call printf ("%s\n") + call pargstr (Memc[line]) + } + } + iferr (nheader = cq_fgeti (cq, "nheader")) + nheader = 0 + call printf ("nheader %d\n") + call pargi (nheader) + if (nheader > 0) { + do j = 1, nheader { + if (cq_scan (cq) == EOF) + break + call gargstr (Memc[line], SZ_LINE) + call printf ("%s\n") + call pargstr (Memc[line]) + } + } + iferr (nfields = cq_fgeti (cq, "nfields")) + nfields = 0 + call printf ("nfields %d\n") + call pargi (nfields) + if (nfields > 0) { + do j = 1, nfields { + if (cq_scan (cq) == EOF) + break + call gargstr (Memc[line], SZ_LINE) + call printf ("%s\n") + call pargstr (Memc[line]) + } + } + if (nquery > 0 || nheader > 0 || nfields > 0) + call printf ("\n") + } + } + + + # Close the catalog database. + call cq_unmap (cq) + + # Close the catalog list. + call fntclsb (catlist) + + # Free working memory. + call sfree (sp) +end diff --git a/noao/astcat/src/agetcat/t_afiltcat.x b/noao/astcat/src/agetcat/t_afiltcat.x new file mode 100644 index 00000000..72dfe8b1 --- /dev/null +++ b/noao/astcat/src/agetcat/t_afiltcat.x @@ -0,0 +1,211 @@ +include "../../lib/astrom.h" + +define SZ_HDRTEXT 5 * SZ_LINE + +# T_AFILTCAT -- Filter existing astrometry catalogs. + +procedure t_afiltcat() + +pointer sp, input, output, catdb, catname, infname, outfname, tmpfname, hdrtext +pointer at, cq, res +int icatlist, ocatlist, catno, infd, outfd, nlines +bool standard, filter, update, verbose +pointer cq_map(), cq_fquery() +int fntopnb(), fntlenb(), fntgfnb(), cq_setcat(), open(), at_gcathdr() +int at_pcathdr() +bool streq(), clgetb() +errchk open() + +begin + # Allocate some working space. + call smark (sp) + call salloc (input, SZ_FNAME, TY_CHAR) + call salloc (output, SZ_FNAME, TY_CHAR) + call salloc (catdb, SZ_FNAME, TY_CHAR) + call salloc (catname, SZ_FNAME, TY_CHAR) + call salloc (infname, SZ_FNAME, TY_CHAR) + call salloc (outfname, SZ_FNAME, TY_CHAR) + call salloc (tmpfname, SZ_FNAME, TY_CHAR) + call salloc (hdrtext, SZ_HDRTEXT, TY_CHAR) + + # Get the important query parameters. + call clgstr ("input", Memc[input], SZ_FNAME) + call clgstr ("output", Memc[output], SZ_FNAME) + call clgstr ("catdb", Memc[catdb], SZ_FNAME) + call clgstr ("catalogs", Memc[catname], SZ_FNAME) + + standard = clgetb ("standard") + filter = clgetb ("filter") + update = clgetb ("update") + verbose = clgetb ("verbose") + + # Open the input catalog list. + icatlist = fntopnb (Memc[input], NO) + ocatlist = fntopnb (Memc[output], NO) + + # Check that the input and output catalogs are the same size. + if (fntlenb (icatlist) != fntlenb (ocatlist)) { + if (verbose) { + call printf ( + "Input and output file lists lengths are different\n") + call flush (STDOUT) + } + call fntclsb (icatlist) + call fntclsb (ocatlist) + call sfree (sp) + return + } + + # Map the database. + cq = cq_map (Memc[catdb], READ_ONLY) + if (cq == NULL) { + if (verbose) { + call printf ("Cannot open catalog configuration file %s\n") + call pargstr (Memc[catdb]) + call flush (STDOUT) + } + call fntclsb (icatlist) + call fntclsb (ocatlist) + call sfree (sp) + return + } else { + if (verbose) { + call printf ("\nOpening catalog configuration file %s ...\n") + call pargstr (Memc[catdb]) + call flush (STDOUT) + } + } + + # Locate the dummy record, usually called "stext". + catno = cq_setcat (cq, Memc[catname]) + if (catno <= 0) { + if (verbose) { + call printf ("Cannot locate dummy catalog %s\n") + call pargstr (Memc[catname]) + call flush (STDOUT) + } + call cq_unmap (cq) + call fntclsb (icatlist) + call fntclsb (ocatlist) + call sfree (sp) + return + } else { + if (verbose) { + call printf ("Selecting dummy catalog %s\n") + call pargstr (Memc[catname]) + call flush (STDOUT) + } + } + + # Initilize the astrometry data structure. + call at_afinit (at) + + # Initialize the algorithm parameters. + call at_fapars (at) + + # Store the input and output templates. + call at_sets (at, CATALOGS, Memc[catname]) + call at_sets (at, INPUT, Memc[input]) + call at_sets (at, OUTPUT, Memc[output]) + call at_sets (at, CATDB, Memc[catdb]) + call at_sets (at, CATNAME, Memc[catname]) + + # Loop over the input and output files. + while (fntgfnb (icatlist, Memc[infname], SZ_FNAME) != EOF && + fntgfnb (ocatlist, Memc[outfname], SZ_FNAME) != EOF) { + + # Store the input and output catalog names. + call at_sets (at, INFNAME, Memc[infname]) + call at_sets (at, OUTFNAME, Memc[outfname]) + + # Create a temporary name and open the output file. + if (streq (Memc[infname], Memc[outfname])) + call mktemp ("tmp", Memc[tmpfname], SZ_FNAME) + else + call strcpy (Memc[outfname], Memc[tmpfname], SZ_FNAME) + iferr { + outfd = open (Memc[tmpfname], NEW_FILE, TEXT_FILE) + } then { + if (verbose) { + call printf (" Cannot open output file %s\n") + call pargstr (Memc[outfname]) + call flush (STDOUT) + next + } + } + + # Read the input catalog header. + infd = open (Memc[infname], READ_ONLY, TEXT_FILE) + nlines = at_gcathdr (infd, Memc[hdrtext], SZ_HDRTEXT) + call close (infd) + if (nlines <= 0) + nlines = at_pcathdr ("acatpars", Memc[hdrtext], SZ_HDRTEXT) + + # Read in the catalog and make it look like the results + # of a query. + if (nlines > 0) { + res = cq_fquery (cq, Memc[infname], Memc[hdrtext]) + if (res != NULL) { + if (filter) { + if (verbose) { + call printf ( + " Filtering catalog %s to catalog %s\n") + call pargstr (Memc[infname]) + call pargstr (Memc[outfname]) + } + call at_wfilrecs (outfd, at, res, standard) + } else { + if (verbose) { + call printf ( + " Copying catalog %s to catalog %s\n") + call pargstr (Memc[infname]) + call pargstr (Memc[outfname]) + } + call at_wnofilrecs (outfd, res, standard) + } + } else { + if (verbose) { + call printf (" Cannot read catalog %s\n") + call pargstr (Memc[infname]) + call flush (STDOUT) + } + } + } else { + if (verbose) { + call printf (" Cannot decode catalog %s\n") + call pargstr (Memc[infname]) + call flush (STDOUT) + } + res = NULL + } + + # Close the results structure. + if (res != NULL) + call cq_rclose (res) + + # Close the output file. + call close (outfd) + + # Replace the existing file with the temporary one. + if (streq (Memc[infname], Memc[outfname])) { + call delete (Memc[infname]) + call rename (Memc[tmpfname], Memc[infname]) + } + } + + # Free the database. + call cq_unmap (cq) + + # Update the algorithm parameters. + if (update) + call at_fppars (at) + + # Free the astrometry data structure. + call at_affree (at) + + # Free the input catalog list. + call fntclsb (icatlist) + call fntclsb (ocatlist) + + call sfree (sp) +end diff --git a/noao/astcat/src/agetcat/t_agetcat.x b/noao/astcat/src/agetcat/t_agetcat.x new file mode 100644 index 00000000..5f888eef --- /dev/null +++ b/noao/astcat/src/agetcat/t_agetcat.x @@ -0,0 +1,251 @@ +include "../../lib/astrom.h" + +define SZ_HDRTEXT (5 * SZ_LINE) + +procedure t_agetcat() + +pointer sp, output, hdrtext, str1, str2, at, cq, res, cres +int i, j, nfields, catlist, outlist, infd, outfd, nlines +bool standard, filter, update, verbose +pointer cq_map(), cq_query, cq_fquery(), at_tquery() +int at_rclist(), at_ocatlist(), at_catlist(), fntlenb(), cq_setcat() +int fntrfnb(), open(), at_rcquery(), access(), at_gcathdr() +bool clgetb() +errchk open() + +begin + # Allocate some working memory. + call smark (sp) + call salloc (output, SZ_FNAME, TY_CHAR) + call salloc (str1, SZ_FNAME, TY_CHAR) + call salloc (str2, SZ_FNAME, TY_CHAR) + call salloc (hdrtext, SZ_HDRTEXT, TY_CHAR) + + # Initalize the data structures + call at_aginit (at) + + # Get the iportant query parameters. + call clgstr ("regions", Memc[str1], SZ_FNAME) + call clgstr ("output", Memc[output], SZ_FNAME) + + # Get the mode parameters. + standard = clgetb ("standard") + filter = clgetb ("filter") + update = clgetb ("update") + verbose = clgetb ("verbose") + + # Allocate the astrometry structure and read in the algorithm + # parameters. This must be done before the field centers are + # decoded. + call at_gapars (at) + + # Print the field center parameters. + #call at_rcshow (at) + # Print the filtering parameters. + #call at_fsshow (at) + # Print the wcs parameters. + #call at_wcshow (at) + # Print the image parameters. + #call at_imshow (at) + + # Get the field center list. + nfields = at_rclist (at, Memc[str1]) + if (nfields <= 0) { + if (verbose) + call printf ("The field center list is empty\n") + call at_agfree (at) + call sfree (sp) + return + } + + # Print the field center symbol table. + #call at_stshow (at) + + # Get the catalog list. + call clgstr ("catalogs", Memc[str1], SZ_FNAME) + call clgstr ("catdb", Memc[str2], SZ_FNAME) + catlist = at_catlist (Memc[str1], Memc[str2]) + if (fntlenb (catlist) <= 0) { + if (verbose) + call printf ("The catalog list is empty\n") + call fntclsb (catlist) + call at_agfree (at) + call sfree (sp) + return + } + call at_sets (at, CATALOGS, Memc[str1]) + call at_sets (at, CATDB, Memc[str2]) + + + # Print the i/o parameters. + #call at_ioshow (at) + + # Create the output catalog file list. + outlist = at_ocatlist (at, catlist, Memc[output], "default", "cat", NO) + if (fntlenb (outlist) <= 0) { + if (verbose) + call printf ("The output file list is empty\n") + call fntclsb (outlist) + call fntclsb (catlist) + call at_agfree (at) + call sfree (sp) + return + } + call at_sets (at, OUTPUT, Memc[output]) + + # Open the catalog database. + cq = cq_map (Memc[str2], READ_ONLY) + if (verbose) { + call printf ("\nOpening catalog database %s\n") + call pargstr (Memc[str2]) + } + + # Loop over the catalog list. + do i = 1, fntlenb (catlist) { + + # Get the catalog name and save it. + if (fntrfnb (catlist, i, Memc[str2], SZ_FNAME) == EOF) + break + if (access (Memc[str2], READ_ONLY, TEXT_FILE) == YES) { + if (cq_setcat (cq, "filename@noao") <= 0) { + if (verbose) { + call printf ("Skipping catalog %s\n") + call pargstr (Memc[str2]) + call flush (STDOUT) + } + next + } else { + call at_sets (at, CATNAME, Memc[str2]) + if (verbose) { + call printf ("Selecting catalog %s\n") + call pargstr (Memc[str2]) + call flush (STDOUT) + } + } + } else if (cq_setcat (cq, Memc[str2]) <= 0) { + if (verbose) { + call printf ("Skipping catalog %s\n") + call pargstr (Memc[str2]) + call flush (STDOUT) + } + next + } else { + call at_sets (at, CATNAME, Memc[str2]) + if (verbose) { + call printf ("Selecting catalog %s\n") + call pargstr (Memc[str2]) + call flush (STDOUT) + } + } + + # Loop over the field centers. + do j = 1, nfields { + + # Get the output file name. + if (fntrfnb (outlist, (i - 1) * nfields + j, Memc[str1], + SZ_FNAME) == EOF) + break + call at_sets (at, OUTFNAME, Memc[str1]) + + # Open the output file. + iferr { + outfd = open (Memc[str1], NEW_FILE, TEXT_FILE) + } then { + if (verbose) { + call printf (" Unable to open output file %s\n") + call pargstr (Memc[str1]) + } + break + } + + if (access (Memc[str2], READ_ONLY, TEXT_FILE) == YES) { + + # Read the catalog header. + infd = open (Memc[str2], READ_ONLY, TEXT_FILE) + nlines = at_gcathdr (infd, Memc[hdrtext], SZ_HDRTEXT) + call close (infd) + if (nlines <= 0) { + if (verbose) + call printf (" Unable to read catalog header\n") + break + } + + # Copy the catalog file into the query structure. + cres = cq_fquery (cq, Memc[str2], Memc[hdrtext]) + if (cres == NULL) { + call printf (" Catalog query failed\n") + break + } + + # Extract the requested data. + res = at_tquery (at, cq, cres, Memc[hdrtext], nlines, j) + if (res == NULL) { + if (verbose) + call printf (" Catalog query failed\n") + break + } + + } else { + + # Format the query. + if (at_rcquery (at, cq, j) == ERR) { + if (verbose) + call printf (" Unable to format network query\n") + break + } + + # Query the catalog. + res = cq_query (cq) + if (res == NULL) { + if (verbose) + call printf (" Network query failed\n") + break + } + } + + # Write the output file. + if (filter) { + if (verbose) { + call printf (" Filtering region %d to file %s\n") + call pargi (j) + call pargstr (Memc[str1]) + call flush (STDOUT) + } + call at_wfilrecs (outfd, at, res, standard) + } else { + if (verbose) { + call printf (" Copying region %d to file %s\n") + call pargi (j) + call pargstr (Memc[str1]) + call flush (STDOUT) + } + call at_wnofilrecs (outfd, res, standard) + } + + # Close the output file. + call close (outfd) + + # Close the query structure. + call cq_rclose (res) + + } + + } + + # Close the catalog database. + call cq_unmap (cq) + + # Update the algorithm parameters. + if (update) + call at_gppars (at) + + # Close the catalog and output file lists. + call fntclsb (outlist) + call fntclsb (catlist) + + # Free the astrometry structure. + call at_agfree (at) + + # Free the working memory. + call sfree (sp) +end diff --git a/noao/astcat/src/agetcat/t_agetim.x b/noao/astcat/src/agetcat/t_agetim.x new file mode 100644 index 00000000..687c1229 --- /dev/null +++ b/noao/astcat/src/agetcat/t_agetim.x @@ -0,0 +1,247 @@ +include "../../lib/astrom.h" +include <pkg/cq.h> + +define SZ_IMEXTN 10 + +procedure t_agetim() + +pointer sp, output, extn, str1, str2 +pointer cq, at, im, res +int i, j, index, nfields, svlist, imlist, addext +char period +bool wcsedit, hdredit, update, verbose +pointer cq_map(), immap(), cq_imquery() +int at_rclist(), at_svlist(), at_osvlist(), fntlenb(), cq_setcat() +int at_rcquery(), fntrfnb(), strldx(), imaccess(), imtlen(), imtrgetim() +int open() +bool clgetb(), streq() +data period /'.'/ +errchk open(), immap(), imaccess(), cq_fgstr() + +begin + # Allocate some working memory. + call smark (sp) + call salloc (output, SZ_FNAME, TY_CHAR) + call salloc (str1, SZ_FNAME, TY_CHAR) + call salloc (str2, SZ_FNAME, TY_CHAR) + call salloc (extn, SZ_IMEXTN, TY_CHAR) + + # Initalize the data structures + call at_aiginit (at) + + # Get the iportant query parameters. + call clgstr ("regions", Memc[str1], SZ_FNAME) + call clgstr ("images", Memc[output], SZ_FNAME) + + # Get the editing parameters. + wcsedit = clgetb ("wcsedit") + hdredit = clgetb ("hdredit") + update = clgetb ("update") + verbose = clgetb ("verbose") + + # Allocate the astrometry structure and read in the algorithm + # parameters. This must be done before the field centers are + # decoded. + call at_giapars (at) + + # Print the field center parameters. + #call at_rcshow (at) + # Print the default wcs parameters. + #call at_wcshow (at) + # Print the default image data parameters. + #call at_imshow (at) + + # Get the field center list. + nfields = at_rclist (at, Memc[str1]) + if (nfields <= 0) { + if (verbose) + call printf ("The field center list is empty\n") + call at_aigfree (at) + call sfree (sp) + return + } + + # Print the field center symbol table. + #call at_stshow (at) + + # Get the surverys list. + call clgstr ("imsurveys", Memc[str1], SZ_FNAME) + call clgstr ("imdb", Memc[str2], SZ_FNAME) + svlist = at_svlist (Memc[str1], Memc[str2]) + if (fntlenb (svlist) <= 0) { + if (verbose) + call printf ("The image surveys list is empty\n") + call at_aigfree (at) + call fntclsb (svlist) + call sfree (sp) + return + } + call at_sets (at, SURVEYS, Memc[str1]) + call at_sets (at, IMDB, Memc[str2]) + + # Print the i/o parameters. + #call at_ioshow (at) + + # Create the output image list. + imlist = at_osvlist (at, svlist, Memc[output], "default", "", NO) + if (imtlen (imlist) <= 0) { + if (verbose) + call printf ("The output images list is empty\n") + call at_aigfree (at) + call imtclose (imlist) + call fntclsb (svlist) + call sfree (sp) + return + } + call at_sets (at, IMAGES, Memc[output]) + + # Open the catalog database. + cq = cq_map (Memc[str2], READ_ONLY) + if (verbose) { + call printf ("\nOpening surveys database %s\n") + call pargstr (Memc[str2]) + } + + # Loop over the catalog list. + do i = 1, fntlenb (svlist) { + + # Get the catalog name and save it. + if (fntrfnb (svlist, i, Memc[str1], SZ_FNAME) == EOF) + break + if (cq_setcat (cq, Memc[str1]) <= 0) { + if (verbose) { + call printf ("Skipping survey %s\n") + call pargstr (Memc[str1]) + call flush (STDOUT) + } + next + } else { + call at_sets (at, SVNAME, Memc[str1]) + if (verbose) { + call printf ("Selecting survey %s\n") + call pargstr (Memc[str1]) + call flush (STDOUT) + } + } + + # Loop over the field centers. + do j = 1, nfields { + + # Get the output file name. + if (imtrgetim (imlist, (i - 1) * nfields + j, Memc[str1], + SZ_FNAME) == EOF) + break + + # If the file is a fits file tack on the user extension. This + # is not the correct way to do this but for the moment it will + # work. Not sure there is a totally clean way to do this since + # we are not going through imio. + + ifnoerr { + call cq_fgstr (cq, "type", Memc[extn], SZ_IMEXTN) + } then { + addext = YES + index = strldx (period, Memc[str1]) + if (index > 0) { + if (streq (Memc[extn], Memc[str1+index])) + addext = NO + else + addext = YES + } + if (addext == YES) { + call strcpy (Memc[str1], Memc[str2], SZ_FNAME) + call strcat (".", Memc[str2], SZ_FNAME) + call strcat (Memc[extn], Memc[str2], SZ_FNAME) + call strcpy (Memc[str2], Memc[str1], SZ_FNAME) + } + } else { + if (verbose) + call printf ( + " Warning the image format is undefined\n") + } + call at_sets (at, IMNAME, Memc[str1]) + + # Can the output file be opened ? + iferr { + im = open (Memc[str1], NEW_FILE, BINARY_FILE) + } then { + if (verbose) { + call printf (" Unable to write output image %s\n") + call pargstr (Memc[str1]) + } + break + } else { + call close (im) + call delete (Memc[str1]) + } + + # Format the query. + if (at_rcquery (at, cq, j) == ERR) { + if (verbose) + call printf (" Unable to format network query\n") + break + } + + # Query the image surveys. + if (verbose) { + call printf ("Getting image %s ...\n") + call pargstr (Memc[str1]) + call flush (STDOUT) + } + res = cq_imquery (cq, Memc[str1]) + if (res == NULL) { + if (verbose) + call printf (" Network query failed\n") + next + } + + # Open the output file. + iferr { + if (imaccess (Memc[str1], READ_WRITE) == YES) { + if (wcsedit || hdredit) { + im = immap (Memc[str1], READ_WRITE, 0) + if (wcsedit) + call at_wedit (im, res, NULL, CQ_WNONE, true, + verbose) + if (hdredit) + call at_hedit (im, res, NULL, true, verbose) + call imunmap (im) + } + } else + im = NULL + } then { + if (verbose) { + call printf ( + " Warning %s is not a valid image\n") + call pargstr (Memc[str1]) + } + im = NULL + } + + if (verbose) + call flush (STDOUT) + + # Close the query structure. + call cq_imclose (res) + + } + + } + + # Close the catalog database. + call cq_unmap (cq) + + # Update the algorithm parameters. + if (update) + call at_gippars (at) + + # Close the file and image lists. + call imtclose (imlist) + call fntclsb (svlist) + + # Free the astrometry structure. + call at_aigfree (at) + + # Free the working memory. + call sfree (sp) +end diff --git a/noao/astcat/src/agetcat/t_ahedit.x b/noao/astcat/src/agetcat/t_ahedit.x new file mode 100644 index 00000000..c75ce3a7 --- /dev/null +++ b/noao/astcat/src/agetcat/t_ahedit.x @@ -0,0 +1,175 @@ +include "../../lib/astrom.h" +include <pkg/cq.h> + +procedure t_ahedit() + +pointer sp, images, str1, str2 +pointer at, cq, res, im +int j, imlist, catno, wcstype +bool hupdate, wcsedit, hdredit, update, verbose +bool clgetb() +pointer cq_map(), cq_fimquery(), immap() +int imtopen(), imtlen(), cq_setcat(), imtrgetim(), imaccess(), strdic() +errchk immap(), imaccess() + +begin + # Allocate some working memory. + call smark (sp) + call salloc (images, SZ_FNAME, TY_CHAR) + call salloc (str1, SZ_FNAME, TY_CHAR) + call salloc (str2, SZ_FNAME, TY_CHAR) + + # Get the iportant query parameters. + call clgstr ("images", Memc[images], SZ_FNAME) + + # Get the editing parameters. + hupdate = clgetb ("hupdate") + wcsedit = clgetb ("wcsedit") + call clgstr ("wcs", Memc[str1], SZ_FNAME) + wcstype = strdic (Memc[str1], Memc[str1], SZ_FNAME, CQ_WTYPESTR) + if (wcstype <= 0) + wcstype = CQ_WNONE + hdredit = clgetb ("hdredit") + update = clgetb ("update") + if (hupdate) + verbose = clgetb ("verbose") + else + verbose = true + + # Open the image list. + imlist = imtopen (Memc[images]) + if (imtlen (imlist) <= 0) { + if (verbose) + call printf ("The input image list is empty\n") + call imtclose (imlist) + call sfree (sp) + return + } + + # Initalize the data structures + call at_ahinit (at) + + # Allocate the astrometry structure and read in the algorithm + # parameters. + call at_hapars (at) + + # Print the default wcs parameters. + #call at_wcshow (at) + # Print the default image data parameters. + #call at_imshow (at) + + # Set the i/o parameters. + call clgstr ("imsurveys", Memc[str1], SZ_FNAME) + call clgstr ("imdb", Memc[str2], SZ_FNAME) + call at_sets (at, IMAGES, Memc[images]) + call at_sets (at, SURVEYS, Memc[str1]) + call at_sets (at, IMDB, Memc[str2]) + + # Print the i/o parameters. + #call at_ioshow (at) + + # Open the catalog database. + cq = cq_map (Memc[str2], READ_ONLY) + if (cq == NULL) { + if (verbose) { + call printf ("\nCannot opening surveys database %s\n") + call pargstr (Memc[str2]) + } + call at_ahfree (at) + call imtclose (imlist) + call sfree (sp) + return + } else if (verbose) { + call printf ("\nOpening surveys database %s\n") + call pargstr (Memc[str2]) + call flush (STDOUT) + } + + # Get the catalog name and save it. + catno = cq_setcat (cq, Memc[str1]) + if (Memc[str1] == EOS) { + catno = ERR + } else if (catno == 0) { + if (verbose) { + call printf ("Cannot locate survey %s\n") + call pargstr (Memc[str1]) + } + } else { + if (verbose) { + call printf ("Selecting survey %s\n") + call pargstr (Memc[str1]) + } + call at_sets (at, CATNAME, Memc[str1]) + } + + # Loop over the field centers. + do j = 1, imtlen (imlist) { + + # Get the output image name. + if (imtrgetim (imlist, j, Memc[str1], SZ_FNAME) == EOF) + break + call at_sets (at, IMNAME, Memc[str1]) + + # Query the image survey to get the header info even though the + # image already exists. + if (verbose) { + call printf ("Getting image %s ...\n") + call pargstr (Memc[str1]) + call flush (STDOUT) + } + if (catno <= 0) + res = NULL + else + res = cq_fimquery (cq, Memc[str1]) + + # Open the output file. + iferr { + if (imaccess (Memc[str1], READ_WRITE) == YES) { + im = immap (Memc[str1], READ_WRITE, 0) + if (wcsedit) { + if (res != NULL) + call at_wedit (im, res, NULL, wcstype, hupdate, + verbose) + else + call at_wedit (im, NULL, at, wcstype, hupdate, + verbose) + } + if (hdredit) { + if (res != NULL) + call at_hedit (im, res, NULL, hupdate, verbose) + else + call at_hedit (im, NULL, at, hupdate, verbose) + } + call imunmap (im) + } else + im = NULL + } then { + if (verbose) { + call printf (" Warning %s is not a valid image name\n") + call pargstr (Memc[str1]) + } + im = NULL + } + + # Close the query structure. + if (res != NULL) + call cq_imclose (res) + + } + + # Close the catalog database. + call cq_unmap (cq) + + # Update the algorithm parameters. + if (update) + call at_hppars (at) + + # Close the image lists. + call imtclose (imlist) + + # Free the astrometry structure. + call at_ahfree (at) + + # Free the working memory. + call sfree (sp) +end diff --git a/noao/astcat/src/agetcat/t_aimfind.x b/noao/astcat/src/agetcat/t_aimfind.x new file mode 100644 index 00000000..58601bef --- /dev/null +++ b/noao/astcat/src/agetcat/t_aimfind.x @@ -0,0 +1,318 @@ +include <pkg/cq.h> +include "../../lib/astrom.h" + +define SZ_HDRTEXT (5 * SZ_LINE) + +procedure t_aimfind() + +pointer sp, images, output, imfile, catalog, catdb, hdrtext, str1 +pointer at, cq, cres, res, sym, im +int i, j, nfields, nout, nlines, catlist, outlist, imfd, infd, outfd +bool standard, filter, append, update, verbose +pointer cq_map(), cq_query(), cq_fquery(), at_tquery(), at_rcsym(), immap() +int at_rclist(), at_catlist(), at_ocatlist(), open(), access() +int fntlenb(), fntrfnb(), cq_setcat(), at_rcquery() +int at_gcathdr(), cq_rstati() +bool clgetb() +errchk open() + +begin + # Allocate some working memory. + call smark (sp) + call salloc (images, SZ_FNAME, TY_CHAR) + call salloc (output, SZ_FNAME, TY_CHAR) + call salloc (imfile, SZ_FNAME, TY_CHAR) + call salloc (catalog, SZ_FNAME, TY_CHAR) + call salloc (catdb, SZ_FNAME, TY_CHAR) + call salloc (hdrtext, SZ_HDRTEXT, TY_CHAR) + call salloc (str1, SZ_FNAME, TY_CHAR) + + # Initalize the data structures + call at_aginit (at) + + # Get the iportant query parameters. + call clgstr ("images", Memc[images], SZ_FNAME) + call clgstr ("output", Memc[output], SZ_FNAME) + call clgstr ("imfile", Memc[imfile], SZ_FNAME) + + # Get the mode parameters. + standard = clgetb ("standard") + filter = clgetb ("filter") + append = clgetb ("append") + update = clgetb ("update") + verbose = clgetb ("verbose") + + # Allocate the astrometry structure and read in the algorithm + # parameters. If filtering is turned off then the filtering + # parameters are set to their default values. Probably need to + # make high level wrapper routines for the parameter defaults + # routines at some point. + if (! filter) + call at_dfspset(at) + else + call at_iapars (at) + + # Set the new field values and new field descriptions. At some + # point these may be input from parameters. At present they are + # hardwired. + call at_nflist (at, 2, "xp,yp", "d,d", "pixels,pixels", + "%10.3f,%10.3f", append) + + # Print the field center parameters. + #call at_rcshow (at) + # Print the filtering parameters. + #call at_fsshow (at) + # Print the wcs parameters. + #call at_wcshow (at) + # Print the image parameters. + #call at_imshow (at) + + # Create the region list from the image list. If an image does not + # have a valid fits wcs it will not be included in the valid + # region list. + nfields = at_rclist (at, Memc[images]) + if (nfields <= 0) { + if (verbose) + call printf ("The image list is empty\n") + call at_agfree (at) + call sfree (sp) + return + } + +# # Print the field center symbol table. +# #call at_stshow (at) + + # Get the catalog. The catalog may be a catalog server or an + # astrometry file. + call clgstr ("catalogs", Memc[catalog], SZ_FNAME) + call clgstr ("catdb", Memc[catdb], SZ_FNAME) + catlist = at_catlist (Memc[catalog], Memc[catdb]) + if (fntlenb (catlist) != 1) { + if (verbose) { + if (fntlenb (catlist) <= 0) + call printf ("The catalog is undefined\n") + else + call printf ("More than one catalog is specified\n") + + } + call fntclsb (catlist) + call at_agfree (at) + call sfree (sp) + return + } + call at_sets (at, CATALOGS, Memc[catalog]) + call at_sets (at, CATDB, Memc[catdb]) + + # Open the output image list file. If the output image file name + # is imdefined then no image list file is written. + if (Memc[imfile] == EOS) { + imfd = NULL + } else { + iferr (imfd = open (Memc[imfile], NEW_FILE, TEXT_FILE)) + imfd = NULL + } + +# # Print the i/o parameters. +# #call at_ioshow (at) + + # Create the output astrometry file list. If the output astrometry + # file list is empty no astrometry file is written. + outlist = at_ocatlist (at, catlist, Memc[output], "default", "coo", NO) + call at_sets (at, OUTPUT, Memc[output]) + + # Open the catalog database. + cq = cq_map (Memc[catdb], READ_ONLY) + if (verbose) { + call printf ("\nOpening catalog database %s\n") + call pargstr (Memc[catdb]) + } + + # Loop over the catalog list. + nout = 0 + do i = 1, fntlenb (catlist) { + + # Get the catalog name and save it. + if (fntrfnb (catlist, i, Memc[catalog], SZ_FNAME) == EOF) + break + + # Set the catalog. + if (access (Memc[catalog], READ_ONLY, TEXT_FILE) == YES) { + if (cq_setcat (cq, "filename@noao") <= 0) { + if (verbose) { + call printf ("Skipping catalog %s\n") + call pargstr (Memc[catalog]) + call flush (STDOUT) + } + next + } else { + call at_sets (at, CATNAME, Memc[catalog]) + if (verbose) { + call printf ("Selecting catalog %s\n") + call pargstr (Memc[catalog]) + call flush (STDOUT) + } + } + } else if (cq_setcat (cq, Memc[catalog]) <= 0) { + if (verbose) { + call printf ("Skipping catalog %s\n") + call pargstr (Memc[catalog]) + call flush (STDOUT) + } + next + } else { + call at_sets (at, CATNAME, Memc[catalog]) + if (verbose) { + call printf ("Selecting catalog %s\n") + call pargstr (Memc[catalog]) + call flush (STDOUT) + } + } + + # Loop over the field centers. + do j = 1, nfields { + + # Get the output file name. + if (fntrfnb (outlist, (i - 1) * nfields + j, Memc[str1], + SZ_FNAME) == EOF) + call at_sets (at, OUTFNAME, "") + #break + else + call at_sets (at, OUTFNAME, Memc[str1]) + + # Query the catalog. + if (access (Memc[catalog], READ_ONLY, TEXT_FILE) == YES) { + + # Read the catalog header. + infd = open (Memc[catalog], READ_ONLY, TEXT_FILE) + nlines = at_gcathdr (infd, Memc[hdrtext], SZ_HDRTEXT) + call close (infd) + if (nlines <= 0) { + if (verbose) + call printf (" Unable to read catalog header\n") + break + } + + # Copy the standard star catalog into the query structure. + cres = cq_fquery (cq, Memc[catalog], Memc[hdrtext]) + if (cres == NULL) { + if (verbose) + call printf (" Catalog query failed\n") + break + } + + # Extract the requested data. + res = at_tquery (at, cq, cres, Memc[hdrtext], nlines, j) + if (res == NULL) { + if (verbose) + call printf (" Catalog query failed\n") + break + } + call cq_rclose (cres) + + + } else { + + # Format the network query. + if (at_rcquery (at, cq, j) == ERR) { + if (verbose) + call printf (" Unable to format network query\n") + break + } + + # Query the catalog. + res = cq_query (cq) + if (res == NULL) { + if (verbose) + call printf (" Network query failed\n") + break + } + } + + # Get the region symbol. + sym = at_rcsym (at, j) + + # If at least one object was detected in the image then + # write out the catalog for that image, and add the image + # name to the image file. + if (cq_rstati (res, CQRNRECS) > 0) { + + # Print the number of objects found. + if (verbose) { + call printf ( + " Image %s contains %d catalog objects\n") + call pargstr (AT_RCSTNAME(sym)) + call pargi (cq_rstati(res, CQRNRECS)) + call flush (STDOUT) + } + + # Write the query results to the astrometry file. + outfd = NULL + if (fntlenb (outlist) > 0) { + + # Open the output file. + outfd = open (Memc[str1], NEW_FILE, TEXT_FILE) + if (verbose) { + call printf (" Writing catalog file %s\n") + call pargstr (Memc[str1]) + } + + im = immap (AT_RCSTNAME(sym), READ_ONLY, 0) + call at_wifilrecs (outfd, im, at, res, standard) + call imunmap (im) + + # Close the output file. + call close (outfd) + } + + # Write the image name to the image file. + if (imfd != NULL) { + if (outfd != NULL) { + call fprintf (imfd, "%s %s\n") + call pargstr (AT_RCSTNAME(sym)) + call pargstr (Memc[str1]) + } else { + call fprintf (imfd, "%s\n") + call pargstr (AT_RCSTNAME(sym)) + } + } + + # Count the number of non-empty files + nout = nout + 1 + + } else if (verbose) { + call printf (" Image %s contains no catalog objects\n") + call pargstr (AT_RCSTNAME(sym)) + call flush (STDOUT) + } + + # Close the query structure. + call cq_rclose (res) + + } + + } + + # Close the catalog database. + call cq_unmap (cq) + + # Update the algorithm parameters. + if (update) + call at_ippars (at) + + # Close the catalog and output file lists. + call fntclsb (outlist) + call fntclsb (catlist) + + # Close the image list file. Delete it if it is empty. + if (imfd != NULL) { + call close (imfd) + if (nout <= 0) + call delete (Memc[imfile]) + } + + # Free the astrometry structure. + call at_agfree (at) + + # Free the working memory. + call sfree (sp) +end diff --git a/noao/astcat/src/agetcat/t_aslist.x b/noao/astcat/src/agetcat/t_aslist.x new file mode 100644 index 00000000..19f7a55d --- /dev/null +++ b/noao/astcat/src/agetcat/t_aslist.x @@ -0,0 +1,102 @@ +# T_ASLIST -- List the support image surveys. + +procedure t_aslist() + +pointer sp, str1, str2, line, cq +int i, j, svlist, nwcs, nkeys +bool verbose +pointer cq_map() +int at_svlist(), fntlenb(), fntrfnb(), cq_setcat(), cq_fgeti(), cq_scan() +bool clgetb() +errchk cq_fgstr(), cq_fgeti() + +begin + # Allocate some working memory. + call smark (sp) + call salloc (str1, SZ_FNAME, TY_CHAR) + call salloc (str2, SZ_FNAME, TY_CHAR) + call salloc (line, SZ_LINE, TY_CHAR) + + # Get the parameters. + call clgstr ("imsurveys", Memc[str1], SZ_FNAME) + call clgstr ("imdb", Memc[str2], SZ_FNAME) + verbose = clgetb ("verbose") + + # Get the catalog list. + svlist = at_svlist (Memc[str1], Memc[str2]) + if (fntlenb (svlist) <= 0) { + if (verbose) + call printf ("The image surveys list is empty\n") + call fntclsb (svlist) + call sfree (sp) + return + } + + # Open the catalog database. + cq = cq_map (Memc[str2], READ_ONLY) + if (verbose) { + call printf ("\nScanning image surveys database %s\n") + call pargstr (Memc[str2]) + } + + # Loop over the catalogs. + if (verbose) + call printf ("Listing the supported image surveys\n") + do i = 1, fntlenb (svlist) { + + # Get the catalog name and set the current catalog. + if (fntrfnb (svlist, i, Memc[str1], SZ_FNAME) == EOF) + break + if (cq_setcat (cq, Memc[str1]) <= 0) { + next + } else { + call printf ("%s\n") + call pargstr (Memc[str1]) + } + + # Do a detailed listing. + if (verbose) { + iferr (call cq_fgstr (cq, "wcs", Memc[line], SZ_LINE)) + call strcpy ("none", Memc[line], SZ_LINE) + call printf ("wcs %s\n") + call pargstr (Memc[line]) + iferr (nwcs = cq_fgeti (cq, "nwcs")) + nwcs = 0 + call printf ("nwcs %d\n") + call pargi (nwcs) + if (nwcs > 0) { + do j = 1, nwcs { + if (cq_scan (cq) == EOF) + break + call gargstr (Memc[line], SZ_LINE) + call printf ("%s\n") + call pargstr (Memc[line]) + } + } + iferr (nkeys = cq_fgeti (cq, "nkeys")) + nkeys = 0 + call printf ("nkeys %d\n") + call pargi (nkeys) + if (nkeys > 0) { + do j = 1, nkeys { + if (cq_scan (cq) == EOF) + break + call gargstr (Memc[line], SZ_LINE) + call printf ("%s\n") + call pargstr (Memc[line]) + } + } + if (nwcs > 0 || nkeys > 0) + call printf ("\n") + } + } + + # Close the image surveys database. + call cq_unmap (cq) + + # Close the image surveys list. + call fntclsb (svlist) + + # Free working memory. + call sfree (sp) +end diff --git a/noao/astcat/src/agetim.par b/noao/astcat/src/agetim.par new file mode 100644 index 00000000..4febee1f --- /dev/null +++ b/noao/astcat/src/agetim.par @@ -0,0 +1,29 @@ +# The AGETIM parameter file. + +# The field center parameters. + +regions,s,a,"pars",,,"The regions source (pars,file,images)" +images,s,a,"default",,,"The output image(s)" +aregpars,pset,h,"",,,"The default field center parameters" + +# The image survey parameters. + +imsurveys,s,h,)_.imsurveys,,,"The input image survey(s)" + +# The image editing parameters. + +wcsedit,b,h,no,,,"Add a new FITS wcs to each image ?" +#awcspars,pset,h,,,,The default wcs parameters +hdredit,b,h,no,,,"Standardize the non-wcs image header parameters ?" +#aimpars,pset,h,"",,,The default image header parameters + +# The task mode parameters. + +update,b,h,no,,,"Update algorithm parameters at task termination ?" +verbose,b,h,yes,,,"Print task status messages ?" + +# The task configuration parameters. + +imdb,s,h,)_.imdb,,,"The image survey configuration file" + +mode,s,h,"ql",,, diff --git a/noao/astcat/src/ahedit.par b/noao/astcat/src/ahedit.par new file mode 100644 index 00000000..6538507a --- /dev/null +++ b/noao/astcat/src/ahedit.par @@ -0,0 +1,29 @@ +# The AHEDIT parameter file. + +# The images parameters. + +images,s,a,"",,,"The images to be edited" + +# The image survey parameters. + +imsurveys,s,a,"",,,"The image survey" + +# The image editing parameters. + +hupdate,b,h,yes,,,"Update the header keywords ?" +wcsedit,b,h,no,,,"Add a new FITS wcs to each image ?" +wcs,s,h,"none","|fits|dss|none|",,"The default input image wcs type" +awcspars,pset,h,"",,,"The default wcs parameters" +hdredit,b,h,yes,,,"Standardize the non-wcs image header parameters ?" +aimpars,pset,h,"",,,"The default image header keyword parameters" + +# The task parameters + +update,b,h,no,,,"Update algorithm parameters at task termination ?" +verbose,b,h,yes,,,"Print task status messages ?" + +# The task configuration parameters. + +imdb,s,h,)_.imdb,,,"The image survey configuration file" + +mode,s,h,"ql",,, diff --git a/noao/astcat/src/aimfind.par b/noao/astcat/src/aimfind.par new file mode 100644 index 00000000..089098fe --- /dev/null +++ b/noao/astcat/src/aimfind.par @@ -0,0 +1,29 @@ +# The AIMFIND parameter file. + +# The field center parameters. + +images,s,a,"",,,"The input images" +output,s,a,"default",,,"The output astrometry file(s)" +imfile,s,a,"",,,"The output image list" + +# The astrometric catalog parameters. + +catalogs,s,h,)_.catalogs,,,"The astrometric catalog(s)" + +# The output catalog filtering parameters. + +standard,b,h,yes,,,Output a standard astrometry file ? +filter,b,h,no,,,"Filter the output astrometry file ?" +afiltpars,pset,h,"",,,"The astrometry file filtering parameters" +append,b,h,no,,,"Append the predicted pixel coordinates ?" + +# The task mode parameters + +update,b,h,no,,,"Update algorithm parameters at task termination ?" +verbose,b,h,yes,,,"Print task status messages ?" + +# The task configuration parameters. + +catdb,s,h,)_.catdb,,,"The astrometric catalog configuration file" + +mode,s,h,"ql",,, diff --git a/noao/astcat/src/aimpars.par b/noao/astcat/src/aimpars.par new file mode 100644 index 00000000..63d6c8f7 --- /dev/null +++ b/noao/astcat/src/aimpars.par @@ -0,0 +1,21 @@ +# THE AIMPARS parameter set + +observat,s,h,"OBSERVAT",,,"The observatory site id" +esitelng,s,h,"INDEF",,,"The observatory longitude (degrees)" +esitelat,s,h,"INDEF",,,"The observatory latitude (degrees)" +esitealt,s,h,"INDEF",,,"The observatory altitude (meters)" +esitetz,s,h,"INDEF",,,"The observatory time zone" +emjdobs,s,h,"MJD-OBS",,,"The effective date of the observation" + +#ut,s,h,"UT",,,"The beginning UT of the observation" +#exposure,s,h,"EXPTIME",,,"The exposure time" + +edatamin,s,h,"INDEF",,,"The effective good data minimum (ADU)" +edatamax,s,h,"INDEF",,,"The effective good data maximum (ADU)" +egain,s,h,"GAIN",,,"The effective gain (electrons / ADU)" +erdnoise,s,h,"RDNOISE",,,"The effective readout noise (electrons)" +ewavlen,s,h,"INDEF",,,"The effective wavelength (microns)" +etemp,s,h,"INDEF",,,"The effective ambient temperature (degrees)" +epress,s,h,"INDEF",,,"The effective ambient pressure (mbars)" + +mode,s,h,"ql",,, diff --git a/noao/astcat/src/aobspars.par b/noao/astcat/src/aobspars.par new file mode 100644 index 00000000..b43b39cb --- /dev/null +++ b/noao/astcat/src/aobspars.par @@ -0,0 +1,29 @@ +# THE AOBSPARS parameter set + +# The observing parameters. + +csystem,s,h,"RADECSYS",,,"The image coordinate system" +equinox,s,h,"EQUINOX",,,"The equinox of the reference ra and dec" +epoch,s,h,"DATE-OBS",,,"The epoch of the observation" + +xref,s,h,"INDEF",,,"The x reference pixel" +yref,s,h,"INDEF",,,"The y reference pixel" +xmag,s,h,"SCALE",,,"The x axis image scale in arcseconds per pixel" +ymag,s,h,"SCALE",,,"The y axis image scale in arcseconds per pixel" +xrotation,s,h,"0.0",,,"The x axis rotation in degrees" +yrotation,s,h,"0.0",,,"The y axis rotation in degrees" +raref,s,h,"RA",,,"The ra of the image reference point in hours" +decref,s,h,"DEC",,,"The dec of the image reference point in degrees" +projection,s,h,"tan",,,"The image projection geometry" +raaxis,i,h,1,,,"The image ra axis" +decaxis,i,h,2,,,"The image dec axis" + +gain,s,h,"GAIN",,,"The image gain" +rdnoise,s,h,"RDNOISE",,,"The image readout noise" + +observatory,s,h,"OBSERVAT",,,"The site of the observation" +temperature,s,h,"INDEF",,,"The ambient temperature during observation" +pressure,s,h,"INDEF",,,"The ambient pressure during the observation" +elambda,s,h,"INDEF",,,"The effective wavelength of the bandpass" + +mode,s,h,"ql",,, diff --git a/noao/astcat/src/aocatpars.par b/noao/astcat/src/aocatpars.par new file mode 100644 index 00000000..2c8146f3 --- /dev/null +++ b/noao/astcat/src/aocatpars.par @@ -0,0 +1,37 @@ +# The AOCATPARS parameter file + +# The standard output catalog format parameter set. + +# Global parameters + +ocatsystem,s,h,"J2000",,,The output catalog celestial coordinate system + +# Standard column / field definitions + +oid,s,h,"",,,"The id field" + +ora,s,h,"",,,"The ra / longitude field" +odec,s,h,"",,,"The dec / latitude field" +oera,s,h,"",,,"The ra / longitude error field" +oedec,s,h,"",,,"The dec / latitude error field" + +opmra,s,h,"",,,"The ra / longitude proper motion field" +opmdec,s,h,"",,,"The dec / latitude proper motion field" +oepmra,s,h,"",,,"The ra / longitude proper motion error field" +oepmdec,s,h,"",,,"The dec / latitude proper motion error field" + +ocoosystem,s,h,"",,,"The celestial coordinate system field" +oequinox,s,h,"",,,"The epoch of the equinox field" +oepoch,s,h,"",,,"The epoch of the observation field" + +opx,s,h,"",,,"The parallax field" +orv,s,h,"",,,"The radial velocity field" +oepx,s,h,"",,,"The parallax error field" +oerv,s,h,"",,,"The radial error velocity field" + +omags,s,h,"",,,"The magnitude field(s)" +ocolors,s,h,"",,,"The color indices field(s)" +oemags,s,h,"",,,"The magnitude error field(s)" +oecolors,s,h,"",,,"The color indices error field(s)" + +# Additions .... diff --git a/noao/astcat/src/aregpars.par b/noao/astcat/src/aregpars.par new file mode 100644 index 00000000..5fa56895 --- /dev/null +++ b/noao/astcat/src/aregpars.par @@ -0,0 +1,9 @@ +# The AREGPARS parameter set file + +rcra,s,h,"00:00:00.0",,,"The region center ra / longitude" +rcdec,s,h,"+00:00:00",,,"The region center dec / latitude" +rrawidth,r,h,10.0,0.0,21600.0,"The ra / longitude region width in minutes" +rdecwidth,r,h,10.0,0.0,10800.0,"The dec / latitude region width in minutes" +rcsystem,s,h,"",,,"The region center celestial coordinate system" +rcraunits,s,h,"",,,"The region center ra / longitude units" +rcdecunits,s,h,"",,,"The region center dec / latitude units" diff --git a/noao/astcat/src/aslist.par b/noao/astcat/src/aslist.par new file mode 100644 index 00000000..136b5d84 --- /dev/null +++ b/noao/astcat/src/aslist.par @@ -0,0 +1,6 @@ +# The ASLIST parameter file. + +imsurveys,s,a,"*",,,"The image surveys(s)" +verbose,b,h,no,,,"Print verbose messages ?" +imdb,s,h,)_.imdb,,,"The image survey configuration file" +mode,s,h,"ql",,, diff --git a/noao/astcat/src/asttest.cl b/noao/astcat/src/asttest.cl new file mode 100644 index 00000000..23292172 --- /dev/null +++ b/noao/astcat/src/asttest.cl @@ -0,0 +1,289 @@ +# ASTTEST - Self testing procedure for the ASTCAT package. + +procedure asttest (rootname) + +string rootname {prompt="Root name of the output test files"} +string astlogfile {"", prompt="Name of the output log file"} + +struct *catlist +struct *svlist + +begin + # Declare local variables. + string troot, tastlog, tcatlist, tcatalog, tcatfile + string tsvlist, tsurvey, timage, ttemp1 + int tfirst, tlast, tindex + + # Check that the user truly wants to proceed. + ttemp1 = "" + print ("") + print ("ASTTEST initializes the ASTCAT task parameters") + print ("Type 'q' or 'Q' to quit, any other key to proceed") + if (scan (ttemp1) != EOF) { + if (ttemp1 == "q" || ttemp1 == "Q") { + print ("Terminating the ASTTEST task") + bye + } + } + print ("") + + # Define the plot file name. + + troot = rootname + tastlog = astlogfile + if (tastlog == "") { + tastlog = troot // ".log" + } + + # Check for the existence of the test files. + + if (access (tastlog)) { + error (0, "Error: The log file already exists on disk") + } + + # Create some temporary files. + + tcatlist = mktemp (troot) + tsvlist = mktemp (troot) + + # Initialize the ASTCAT package. + + print ("Initialize the ASTCAT package", >> tastlog) + print ("", >> tastlog) + print ("") + print ("Initialize the ASTCAT package") + print ("") + + astcat.catalogs = "usno2@noao" + astcat.catdb = "astcat$lib/catdb.dat" + astcat.imsurveys = "dss2@cadc" + astcat.imdb = "astcat$lib/imdb.dat" + + # Unlearning tasks and psets. Ran into a problem with doing + # unlearn on astcat which I will have to work around. + + # unlearn ("astcat") + unlearn ("acatpars") + unlearn ("aclist") + unlearn ("adumpcat") + unlearn ("adumpim") + unlearn ("afiltcat") + unlearn ("afiltpars") + unlearn ("agetcat") + unlearn ("agetim") + unlearn ("ahedit") + unlearn ("aimfind") + unlearn ("aimpars") + unlearn ("aregpars") + unlearn ("aslist") + unlearn ("awcspars") + + # Do the tests. + + # Test the ACLIST task. + + print ("", >> tastlog) + print ("Testing the ACLIST task", >> tastlog) + print ("Testing the ACLIST task") + print ("", >> tastlog) + + aclist ("*", verbose+, catdb=")_.catdb", >> tastlog) + aclist ("*", verbose-, catdb=")_.catdb", > tcatlist) + print ("", >> tastlog) + + # Test the ADUMPCAT task. + + print ("", >> tastlog) + print ("Testing the ADUMPCAT task", >> tastlog) + print ("Testing the ADUMPCAT task") + print ("", >> tastlog) + + catlist = tcatlist + while (fscan (catlist, tcatalog) != EOF) { + print ("", >> tastlog) + print (tcatalog, >> tastlog) + print ("", >> tastlog) + print (" ", tcatalog) + if (tcatalog == "tmass@ipac") { + adumpcat (tcatalog, "STDOUT", ra="00:00:00.0", dec="00:00:00", + size="0.17", catdb=")_.catdb", >> tastlog) + } else { + adumpcat (tcatalog, "STDOUT", ra="00:00:00.0", dec="00:00:00", + size="10.0", catdb=")_.catdb", >> tastlog) + } + print ("", >> tastlog) + } + + # Test the AGETCAT and AFILTCAT tasks. + + print ("", >> tastlog) + print ("Testing the AGETCAT and AFILTCAT tasks", >> tastlog) + print ("Testing the AGETCAT and AFILTCAT tasks") + print ("", >> tastlog) + + catlist = tcatlist + while (fscan (catlist, tcatalog) != EOF) { + print ("", >> tastlog) + print (tcatalog, >> tastlog) + print ("", >> tastlog) + print (" ", tcatalog) + tfirst = 1 + tlast = strlen (tcatalog) + tindex = stridx ("@", tcatalog) + tcatfile = substr (tcatalog, tfirst, tindex - 1) // "." // + substr (tcatalog, tindex + 1, tlast) // ".cat" + if (access (tcatfile)) { + delete (tcatfile, verify-) + } + agetcat ("pars", tcatfile, rcra="00:00:00.00", rcdec="+00:00:00.0", + rrawidth=20.0, rdecwidth=20.0, catalogs=tcatalog, standard+, + filter-, update-, verbose+, catdb=")_.catdb", >> tastlog) + print ("", >> tastlog) + type (tcatfile, map_cc+, device="terminal", >> tastlog) + print ("", >> tastlog) + afiltcat (tcatfile, tcatfile, catalogs="filename@noao", standard+, + filter+, fsort="mag1", update-, verbose+, catdb=")_.catdb", + >> tastlog) + print ("", >> tastlog) + type (tcatfile, map_cc+, device="terminal", >> tastlog) + print ("", >> tastlog) + delete (tcatfile, verify-) + } + + # Test the ASLIST task. + + print ("", >> tastlog) + print ("Testing the ASLIST task", >> tastlog) + print ("Testing the ASLIST task") + print ("", >> tastlog) + + aslist ("*", verbose+, imdb=")_.imdb", >> tastlog) + aslist ("*", verbose-, imdb=")_.imdb", > tsvlist) + print ("", >> tastlog) + + # Test the ADUMPIM task. + + print ("", >> tastlog) + print ("Testing the ADUMPIM task", >> tastlog) + print ("Testing the ADUMPIM task") + print ("", >> tastlog) + + svlist = tsvlist + while (fscan (svlist, tsurvey) != EOF) { + print ("", >> tastlog) + print (tsurvey, >> tastlog) + print ("", >> tastlog) + print (" ", tsurvey) + tfirst = 1 + tlast = strlen (tsurvey) + tindex = stridx ("@", tsurvey) + timage = substr (tsurvey, tfirst, tindex - 1) // "." // + substr (tsurvey, tindex + 1, tlast) // ".fits" + if (imaccess (timage)) { + imdelete (timage, verify-) + } + adumpim (tsurvey, timage, ra="14:28:07.0", dec="+34:55:00", + size="10.0", imdb=")_.imdb", >> tastlog) + printf (" ") + imheader (timage, longheader-, userfields+) + print ("", >> tastlog) + imheader (timage, longheader+, userfields+, >> tastlog) + print ("", >> tastlog) + imdelete (timage, verify-) + } + + # Test the AGETIM and AHEDIT tasks. + + print ("", >> tastlog) + print ("Testing the AGETIM and AHEDIT tasks", >> tastlog) + print ("Testing the AGETIM and AHEDIT tasks") + print ("", >> tastlog) + + svlist = tsvlist + while (fscan (svlist, tsurvey) != EOF) { + print ("", >> tastlog) + print (tsurvey, >> tastlog) + print ("", >> tastlog) + tfirst = 1 + tlast = strlen (tsurvey) + tindex = stridx ("@", tsurvey) + timage = substr (tsurvey, tfirst, tindex - 1) // "." // + substr (tsurvey, tindex + 1, tlast) // ".fits" + if (imaccess (timage)) { + imdelete (timage, verify-) + } + agetim ("pars", timage, rcra="14:28:07.00", rcdec="+34:55:00.0", + rrawidth=10.0, rdecwidth=10.0, imsurveys=tsurvey, wcsedit-, + hdredit-, update-, verbose+, imdb=")_.imdb", >> tastlog) + printf (" ") + imheader (timage, longheader-, userfields+) + print ("", >> tastlog) + imheader (timage, longheader+, userfields+, >> tastlog) + print ("", >> tastlog) + ahedit (timage, tsurvey, hupdate+, wcsedit+, wcs="none", hdredit+, + update-, verbose+, imdb=")_.imdb", >> tastlog) + print ("", >> tastlog) + imheader (timage, longheader+, userfields+, >> tastlog) + #imdelete (timage, verify-) + } + + # Test the AIMFIND task. + + print ("", >> tastlog) + print ("Testing the AIMFIND task", >> tastlog) + print ("Testing the AIMFIND task") + print ("", >> tastlog) + + # Test the aimfind task using the USNO2 survey + + svlist = tsvlist + while (fscan (svlist, tsurvey) != EOF) { + tfirst = 1 + tlast = strlen (tsurvey) + tindex = stridx ("@", tsurvey) + timage = substr (tsurvey, tfirst, tindex - 1) // "." // + substr (tsurvey, tindex + 1, tlast) // ".fits" + tcatfile = substr (tsurvey, tfirst, tindex - 1) // "." // + substr (tsurvey, tindex + 1, tlast) // ".cat" + if (access (tcatfile)) { + delete (tcatfile, verify-) + } + aimfind (timage, tcatfile, imfile="", catalogs="usno2@noao", + standard+, filter-, append-, update-, verbose+, + catdb=")_.catdb", >> tastlog) + } + + # Reinitialize the astcat package. + + # unlearn ("astcat") + unlearn ("acatpars") + unlearn ("aclist") + unlearn ("adumpcat") + unlearn ("adumpim") + unlearn ("afiltcat") + unlearn ("afiltpars") + unlearn ("agetcat") + unlearn ("agetim") + unlearn ("ahedit") + unlearn ("aimfind") + unlearn ("aimpars") + unlearn ("aregpars") + unlearn ("aslist") + unlearn ("awcspars") + + # Delete some temporary files. + + delete (tsvlist, verify-) + delete (tcatlist, verify-) + svlist = "" + catlist = "" + + print ("", >> tastlog) + print ("ASTCAT package tests completed", >> tastlog) + print ("", >> tastlog) + print ("") + print ("ASTCAT package tests completed") + print ("") + + bye +end diff --git a/noao/astcat/src/attools/atalloc.x b/noao/astcat/src/attools/atalloc.x new file mode 100644 index 00000000..7a46c936 --- /dev/null +++ b/noao/astcat/src/attools/atalloc.x @@ -0,0 +1,288 @@ +include "../../lib/astromdef.h" +include "../../lib/astrom.h" +include "../../lib/acatalog.h" +include "../../lib/aimparsdef.h" +include "../../lib/aimpars.h" + + +# AT_AINIT -- Initialize the main astrometry structure. + +procedure at_ainit (at) + +pointer at #I the pointer to the astrometry descriptor + +begin + call calloc (at, LEN_ASTROM, TY_STRUCT) + AT_PIO(at) = NULL + AT_PRCENTER(at) = NULL + AT_PFILTER(at) = NULL +end + + +# AT_AFREE -- Free the main astrometry structure. + +procedure at_afree (at) + +pointer at #I the pointer to the astrometry descriptor + +begin + call mfree (at, TY_STRUCT) +end + + +# AT_RCINIT -- Initialize the field center structure. + +procedure at_rcinit (at) + +pointer at #I the pointer to the astrometry descriptor + +pointer fc + +begin + call calloc (fc, LEN_PRCENTER, TY_STRUCT) + + # Set the default field. + AT_RCRA(fc) = 0.0d0 + AT_RCDEC(fc) = 0.0d0 + AT_RCRAWIDTH(fc) = 1.0d0 + AT_RCDECWIDTH(fc) = 1.0d0 + AT_RCRAUNITS(fc) = AT_HOURS + AT_RCDECUNITS(fc) = AT_DEGREES + call strcpy ("J2000", AT_RCSYSTEM(fc), SZ_FNAME) + call strcpy ("", AT_RCSOURCE(fc), SZ_FNAME) + + # Initialize the internal data structures. + #AT_RCCC(fc) = NULL + AT_RCST(fc) = NULL + + AT_PRCENTER(at) = fc +end + + +# AT_RCFREE -- Free the field center structure. + +procedure at_rcfree (at) + +pointer at #I the pointer to the astrometry descriptor + +pointer fc + +begin + fc = AT_PRCENTER(at) + + # Close the field center symbol table. + if (AT_RCST(fc) != NULL) + call stclose (AT_RCST(fc)) + AT_RCST(fc) = NULL + + # Close the coordinate structure. + #if (AT_RCCC(fc) != NULL) + #call sk_close (AT_RCCC(fc)) + #AT_RCCC(fc) = NULL + + call mfree (AT_PRCENTER(at), TY_STRUCT) + AT_PRCENTER(at) = NULL +end + + +# AT_IOINIT -- Initialize the i/o structure. + +procedure at_ioinit (at) + +pointer at #I the pointer to the i/o descriptor + +pointer io + +begin + call calloc (io, LEN_PIO, TY_STRUCT) + + AT_CATALOGS(io) = EOS + AT_SURVEYS(io) = EOS + AT_IMAGES(io) = EOS + AT_INPUT(io) = EOS + AT_OUTPUT(io) = EOS + AT_CATNAME(io) = EOS + AT_SVNAME(io) = EOS + AT_IMNAME(io) = EOS + AT_INFNAME(io) = EOS + AT_OUTFNAME(io) = EOS + AT_CATDB(io) = EOS + AT_IMDB(io) = EOS + + AT_PIO(at) = io +end + + +# AT_IOFREE -- Free the i/o structure. + +procedure at_iofree (at) + +pointer at #I the pointer to the i/o descriptor + +pointer io + +begin + io = AT_PIO(at) + + call mfree (io, TY_STRUCT) + AT_PIO(at) = NULL +end + + +# AT_FSINIT -- Initialize the filtering / selection structure. + +procedure at_fsinit (at) + +pointer at #I the pointer to the astrometry descriptor + +pointer fs + +begin + call calloc (fs, LEN_PFILTER, TY_STRUCT) + + AT_FSORT(fs) = EOS + AT_FREVERSE(fs) = NO + AT_FREPLACE(fs) = YES + + call strcpy ("J2000", AT_FOSYSTEM(fs), SZ_LINE) + call strcpy ("ra", AT_FIRA(fs), SZ_LINE) + call strcpy ("dec", AT_FIDEC(fs), SZ_LINE) + AT_FORAFORMAT(fs) = EOS + AT_FODECFORMAT(fs) = EOS + AT_FORAUNITS(fs) = AT_HOURS + AT_FODECUNITS(fs) = AT_DEGREES + + call strcpy ("xp", AT_FIXP(fs), SZ_LINE) + call strcpy ("yp", AT_FIYP(fs), SZ_LINE) + call strcpy ("xc", AT_FIXC(fs), SZ_LINE) + call strcpy ("yc", AT_FIYC(fs), SZ_LINE) + AT_FOXFORMAT(fs) = EOS + AT_FOYFORMAT(fs) = EOS + + call strcpy ("*", AT_FIELDS(fs), SZ_LINE) + call strcpy ("yes", AT_FEXPR(fs), SZ_LINE) + AT_FNAMES(fs) = EOS + AT_FNTYPES(fs) = EOS + AT_FNUNITS(fs) = EOS + AT_FNFORMATS(fs) = EOS + + AT_PFILTER(at) = fs +end + + +# AT_FSFREE -- Free the filtering / selection structure. + +procedure at_fsfree (at) + +pointer at #I the pointer to the astrometry descriptor + +pointer fs + +begin + fs = AT_PFILTER(at) + call mfree (fs, TY_STRUCT) + AT_PFILTER(at) = NULL +end + + +# AT_WCINIT -- Initialize the default WCS structure + +procedure at_wcinit (at) + +pointer at #I the mail astrometry package descriptor + +pointer wc + +begin + call calloc (wc, LEN_PWCS, TY_STRUCT) + AT_WXREF(wc) = INDEFD + AT_WYREF(wc) = INDEFD + AT_WXMAG(wc) = 1.0 + AT_WYMAG(wc) = 1.0 + AT_WXROT(wc) = 0.0 + AT_WYROT(wc) = 0.0 + AT_WRAREF(wc) = 0.0 + AT_WDECREF(wc) = 0.0 + AT_WRAUNITS(wc) = 0 + AT_WDECUNITS(wc) = 0 + AT_WPROJ(wc) = EOS + AT_WSYSTEM(wc) = EOS + + AT_WCST(wc) = NULL + + AT_PWCS(at) = wc +end + + +# AT_WCFREE -- Free the default WCS structure + +procedure at_wcfree (at) + +pointer at #I the mail astrometry package descriptor + +pointer wc + +begin + wc = AT_PWCS(at) + + # Close the default wcspars parameters symbol table. + if (AT_WCST(wc) != NULL) + call stclose(AT_WCST(wc)) + AT_WCST(wc) = NULL + + call mfree (wc, TY_STRUCT) + AT_PWCS(at) = NULL +end + + +# AT_IMINIT -- Initialize the default mage data structure + +procedure at_iminit (at) + +pointer at #I the mail astrometry package descriptor + +pointer ip + +begin + call calloc (ip, LEN_PIMPARS, TY_STRUCT) + AT_ESITELNG(ip) = INDEFD + AT_ESITELAT(ip) = INDEFD + AT_EMJDOBS(ip) = INDEFD + + AT_ESITEALT(ip) = INDEFR + AT_ESITETZ(ip) = INDEFR + AT_EDATAMIN(ip) = INDEFR + AT_EDATAMAX(ip) = INDEFR + AT_EGAIN(ip) = 1.0 + AT_ERDNOISE(ip) = 0.0 + AT_EWAVLEN(ip) = INDEFR + AT_ETEMP(ip) = INDEFR + AT_EPRESS(ip) = INDEFR + + AT_OBSERVAT(ip) = EOS + + AT_IMST(ip) = NULL + + AT_PIMPARS(at) = ip +end + + +# AT_IMFREE -- Free the default image data structure + +procedure at_imfree (at) + +pointer at #I the mail astrometry package descriptor + +pointer ip + +begin + ip = AT_PIMPARS(at) + + # Close the default wcspars parameters symbol table. + if (AT_IMST(ip) != NULL) + call stclose(AT_IMST(ip)) + AT_IMST(ip) = NULL + + call mfree (ip, TY_STRUCT) + AT_PIMPARS(at) = NULL +end diff --git a/noao/astcat/src/attools/atcathdr.x b/noao/astcat/src/attools/atcathdr.x new file mode 100644 index 00000000..d261e3cd --- /dev/null +++ b/noao/astcat/src/attools/atcathdr.x @@ -0,0 +1,262 @@ +include <pkg/cq.h> +include "../../lib/acatalog.h" + +# AT_GCATHDR -- Read a standard ASTROMZ catalog header. + +int procedure at_gcathdr (fd, hdrtext, maxch) + +int fd #I the input file descriptor +char hdrtext[ARB] #O the output catalog description +int maxch #I the maximum size of the catalog description + +pointer sp, line +int nlines, strfd, nchars +bool first_line +int stropen(), getline(), strncmp() + +begin + call smark (sp) + call salloc (line, SZ_LINE, TY_CHAR) + + # Go to the beginning of the file. + call seek (fd, BOF) + + # Initialize the number of lines in the catalog description. + nlines = 0 + first_line = true + + # Open the output text as a string. + hdrtext[1] = EOS + strfd = stropen (hdrtext, maxch, NEW_FILE) + + # Read in the catalog header as delimited by BEGIN CATALOG HEADER + # and END CATALOG HEADER strings. Skip leading blank lines. + repeat { + nchars = getline (fd, Memc[line]) + if (nchars == EOF) + break + if (first_line) { + if (Memc[line] == '\n') + next + if (strncmp (Memc[line], "#\n", 2) == 0) + next + if (strncmp (Memc[line], "# \n", 3) == 0) + next + if (strncmp (Memc[line], "# BEGIN CATALOG HEADER", 22) != 0) + break + first_line = false + next + } + if (strncmp (Memc[line], "# END CATALOG HEADER", 20) == 0) + break + call fprintf (strfd, "%s") + call pargstr (Memc[line+2]) + nlines = nlines + 1 + } + call close (strfd) + + # Return to the beginning of the file if no header was found. + if (nlines == 0) + call seek (fd, BOF) + + call sfree (sp) + + return (nlines) +end + + +# AT_PCATHDR -- Read in the catalog format from a parameter set and create +# a standard ASTROMZ catalog header suitable for input to the catalog +# query routines. + +int procedure at_pcathdr (pset, hdrtxt, maxch) + +char pset[ARB] #I the name of the catalog description pset +char hdrtxt[ARB] #O the standard output catalog description +int maxch #I the maximum size of the header text + +pointer sp, fname, fval, funits, fmts, findex, ranges, pp +int i, j, nfields, ncols, nvals, nlines, number, type, fsize, fd +char cdtype +pointer clopset() +int at_wrdstr(), decode_ranges(), stropen(), strdic(), nscan() +int get_next_number + +begin + # Get working space. + call smark (sp) + call salloc (fname, SZ_FNAME, TY_CHAR) + call salloc (fval, SZ_FNAME, TY_CHAR) + call salloc (funits, SZ_FNAME, TY_CHAR) + call salloc (fmts, SZ_FNAME, TY_CHAR) + call salloc (findex, AT_NSTDCOLS, TY_INT) + call salloc (ranges, 3 * AT_MAX_NRANGES + 1, TY_INT) + + # Open the pset + pp = clopset (pset) + + # Get the file type. + call clgpset (pp, "ftype", Memc[fval], SZ_FNAME) + type = strdic (Memc[fval], Memc[fval], SZ_FNAME, CQ_RTYPESTR) + if (type <= 0) + type = CQ_STEXT + + # Count the fields. + nfields = 0; ncols = 0 + do i = 1, AT_NSTDCOLS { + if (at_wrdstr (i, Memc[fname], SZ_FNAME, AT_CATNAMES) <= 0) + next + if (Memc[fname] == EOS) + next + call clgpset (pp, Memc[fname], Memc[fval], SZ_FNAME) + if (Memc[fval] == EOS) + next + call sscan (Memc[fval]) + call gargwrd (Memc[fval], SZ_FNAME) + if (nscan() < 1) + next + if (decode_ranges (Memc[fval], Memi[ranges], AT_MAX_NRANGES, + nvals) == ERR) + next + if (nvals <= 0) + next + if (type == CQ_BTEXT) { + call gargi (j) + if (nscan() < 2) + next + } + Memi[findex+nfields] = i + nfields = nfields + 1 + ncols = ncols + nvals + } + + # Write the header description. + nlines = 0 + if (nfields > 0) { + + # Open the string as a file. + hdrtxt[1] = EOS + fd = stropen (hdrtxt, maxch, NEW_FILE) + + # Write the catalog type. + call clgpset (pp, "ftype", Memc[fval], SZ_FNAME) + type = strdic (Memc[fval], Memc[fval], SZ_FNAME, CQ_RTYPESTR) + call fprintf (fd, "%s %s\n") + call pargstr ("type") + call pargstr (Memc[fval]) + nlines = nlines + 1 + + # Write out the header parameters. At present there is only one + # the catalog coordinate system. + call fprintf (fd, "nheader 1\n") + nlines = nlines + 1 + call clgpset (pp, "csystem", Memc[fval], SZ_FNAME) + call fprintf (fd, " %s %s\n") + call pargstr ("csystem") + call pargstr (Memc[fval]) + nlines = nlines + 1 + + # Write out the legal fields. + call fprintf (fd, "nfields %d\n") + call pargi (ncols) + nlines = nlines + 1 + do i = 1, nfields { + if (at_wrdstr (Memi[findex+i-1], Memc[fname], SZ_FNAME, + AT_CATNAMES) <= 0) + next + if (Memc[fname] == EOS) + next + call clgpset (pp, Memc[fname], Memc[fval], SZ_FNAME) + if (Memc[fval] == EOS) + next + call sscan (Memc[fval]) + switch (type) { + case CQ_BTEXT: + call gargwrd (Memc[fval], SZ_FNAME) + call gargi (fsize) + call gargwrd (Memc[funits], SZ_FNAME) + call gargwrd (Memc[fmts], SZ_FNAME) + default: + call gargwrd (Memc[fval], SZ_FNAME) + call gargwrd (Memc[funits], SZ_FNAME) + call gargwrd (Memc[fmts], SZ_FNAME) + } + if (decode_ranges (Memc[fval], Memi[ranges], AT_MAX_NRANGES, + nvals) == ERR) + next + if (nvals <= 0) + next + if (at_wrdstr (Memi[findex+i-1], cdtype, 1, AT_CATTYPES) <= 0) + cdtype = 'c' + if (Memc[funits] == EOS) { + if (at_wrdstr (Memi[findex+i-1], Memc[funits], SZ_FNAME, + AT_CATUNITS) <= 0) + call strcpy ("INDEF", Memc[fmts], SZ_FNAME) + } + if (Memc[fmts] == EOS) { + if (at_wrdstr (Memi[findex+i-1], Memc[fmts], SZ_FNAME, + AT_CATFORMATS) <= 0) + call strcpy ("%s", Memc[fmts], SZ_FNAME) + } + switch (type) { + case CQ_BTEXT: + if (nvals == 1) { + call fprintf (fd, " %s %s %d %c %s %s\n") + call pargstr (Memc[fname]) + call pargstr (Memc[fval]) + call pargi (fsize) + call pargc (cdtype) + call pargstr (Memc[funits]) + call pargstr (Memc[fmts]) + nlines = nlines + 1 + } else { + number = 0 + do j = 1, nvals { + call fprintf (fd, " %s%d %d %d %c %s %s\n") + call pargstr (Memc[fname]) + call pargi (j) + call pargi (get_next_number (Memi[ranges], + number)) + call pargi (fsize) + call pargc (cdtype) + call pargstr (Memc[funits]) + call pargstr (Memc[fmts]) + nlines = nlines + 1 + } + } + default: + if (nvals == 1) { + call fprintf (fd, " %s %s 0 %c %s %s\n") + call pargstr (Memc[fname]) + call pargstr (Memc[fval]) + call pargc (cdtype) + call pargstr (Memc[funits]) + call pargstr (Memc[fmts]) + nlines = nlines + 1 + } else { + number = 0 + do j = 1, nvals { + call fprintf (fd, " %s%d %d 0 %c %s %s\n") + call pargstr (Memc[fname]) + call pargi (j) + call pargi (get_next_number (Memi[ranges], + number)) + call pargc (cdtype) + call pargstr (Memc[funits]) + call pargstr (Memc[fmts]) + nlines = nlines + 1 + } + } + } + } + + call close (fd) + } + + # Close the pset + call clcpset (pp) + + call sfree (sp) + + return (nlines) +end diff --git a/noao/astcat/src/attools/atdefpars.x b/noao/astcat/src/attools/atdefpars.x new file mode 100644 index 00000000..0b8b2cb7 --- /dev/null +++ b/noao/astcat/src/attools/atdefpars.x @@ -0,0 +1,305 @@ +include "../../lib/astrom.h" +include "../../lib/acatalog.h" +include "../../lib/aimpars.h" + + +# AT_DRCPSET -- Reset the region definition parameters to their default values. + +procedure at_drcpset (at) + +pointer at #I the pointer to the main astrom structure + +begin + # Set the default field center and width. + call at_setd (at, RCRA, 0.0d0) + call at_setd (at, RCDEC, 0.0d0) + call at_setd (at, RCRAWIDTH, 10.0d0) + call at_setd (at, RCDECWIDTH, 10.0d0) + + # Set the default field center units. + call at_seti (at, RCRAUNITS, 0) + call at_seti (at, RCDECUNITS, 0) + + # Set the default field center coordinate system. + call at_sets (at, RCSYSTEM, "") +end + + +# AT_DFSPSET -- Reset the filtering parameters to their default values. + +procedure at_dfspset (at) + +pointer at #I the pointer to the main astrom structure + +begin + call at_sets (at, FIELDS, "f[*]") + call at_sets (at, FEXPR, "yes") + call at_sets (at, FNAMES, "") + call at_sets (at, FNTYPES, "") + call at_sets (at, FNUNITS, "") + call at_sets (at, FNFORMATS, "") + call at_sets (at, FSORT, "") + call at_seti (at, FREVERSE, NO) + call at_sets (at, FOSYSTEM, "") + call at_sets (at, FIRA, "ra") + call at_sets (at, FIDEC, "dec") + call at_seti (at, FORAUNITS, 0) + call at_seti (at, FODECUNITS, 0) + call at_sets (at, FORAFORMAT, "") + call at_sets (at, FODECFORMAT, "") + call at_sets (at, FIXP, "xp") + call at_sets (at, FIYP, "yp") + call at_sets (at, FIXC, "xc") + call at_sets (at, FIYC, "yc") + call at_sets (at, FOXFORMAT, "%10.3f") + call at_sets (at, FOYFORMAT, "%10.3f") +end + + +# AT_DWCPSET -- Reset the wcs parameters to their default values. + +procedure at_dwcpset (at) + +pointer at #I the pointer to the main astrom structure + +double dval +pointer st, sym +int ip +pointer at_statp(), stfind() +int ctod() + +begin + st = at_statp (at, WCST) + if (st == NULL) + return + + sym = stfind (st, "wxref") + if (sym != NULL) { + call strcpy ("INDEF", AT_WCSTKVAL(sym), LEN_WCST_STRUCT) + ip = 1 + if (ctod ("INDEF", ip, dval) <= 0) + dval = INDEFD + call at_setd (at, WXREF, dval) + } + + sym = stfind (st, "wyref") + if (sym != NULL) { + call strcpy ("INDEF", AT_WCSTKVAL(sym), LEN_WCST_STRUCT) + ip = 1 + if (ctod ("INDEF", ip, dval) <= 0) + dval = INDEFD + call at_setd (at, WYREF, dval) + } + + sym = stfind (st, "wxmag") + if (sym != NULL) { + call strcpy ("INDEF", AT_WCSTKVAL(sym), LEN_WCST_STRUCT) + ip = 1 + if (ctod ("INDEF", ip, dval) <= 0) + dval = INDEFD + call at_setd (at, WXMAG, dval) + } + + sym = stfind (st, "wymag") + if (sym != NULL) { + call strcpy ("INDEF", AT_WCSTKVAL(sym), LEN_WCST_STRUCT) + ip = 1 + if (ctod ("INDEF", ip, dval) <= 0) + dval = INDEFD + call at_setd (at, WYMAG, dval) + } + + sym = stfind (st, "wxrot") + if (sym != NULL) { + call strcpy ("180.0", AT_WCSTKVAL(sym), LEN_WCST_STRUCT) + ip = 1 + if (ctod ("180.0", ip, dval) <= 0) + dval = INDEFD + call at_setd (at, WXROT, dval) + } + + sym = stfind (st, "wyrot") + if (sym != NULL) { + call strcpy ("0.0", AT_WCSTKVAL(sym), LEN_WCST_STRUCT) + ip = 1 + if (ctod ("0.0", ip, dval) <= 0) + dval = INDEFD + call at_setd (at, WYROT, dval) + } + + sym = stfind (st, "wraref") + if (sym != NULL) { + call strcpy ("RA", AT_WCSTKVAL(sym), LEN_WCST_STRUCT) + ip = 1 + if (ctod ("RA", ip, dval) <= 0) + dval = INDEFD + call at_setd (at, WRAREF, dval) + } + + sym = stfind (st, "wdecref") + if (sym != NULL) { + call strcpy ("DEC", AT_WCSTKVAL(sym), LEN_WCST_STRUCT) + ip = 1 + if (ctod ("DEC", ip, dval) <= 0) + dval = INDEFD + call at_setd (at, WDECREF, dval) + } + + sym = stfind (st, "wraunits") + if (sym != NULL) { + call strcpy ("", AT_WCSTKVAL(sym), LEN_WCST_STRUCT) + call at_seti (at, WRAUNITS, 0) + } + + sym = stfind (st, "wdecunits") + if (sym != NULL) { + call strcpy ("", AT_WCSTKVAL(sym), LEN_WCST_STRUCT) + call at_seti (at, WDECUNITS, 0) + } + + sym = stfind (st, "wproj") + if (sym != NULL) { + call strcpy ("INDEF", AT_WCSTKVAL(sym), LEN_WCST_STRUCT) + call at_sets (at, WPROJ, "tan") + } + + sym = stfind (st, "wsystem") + if (sym != NULL) { + call strcpy ("EQUINOX", AT_WCSTKVAL(sym), LEN_WCST_STRUCT) + call at_sets (at, WSYSTEM, "EQUINOX") + } +end + + +# AT_DIMPSET -- Read in the default image data parameters. + +procedure at_dimpset (at) + +pointer at #I the pointer to the main astrom structure + +double dval +real rval +pointer st, sym +int ip +pointer at_statp(), stfind() +int ctod(), ctor() + +begin + st = at_statp (at, IMST) + if (st == NULL) + return + + sym = stfind (st, "esitelng") + if (sym != NULL) { + call strcpy ("INDEF", AT_IMSTKVAL(sym), LEN_IMST_STRUCT) + ip = 1 + if (ctod ("INDEF", ip, dval) <= 0) + dval = INDEFD + call at_setd (at, ESITELNG, dval) + } + + sym = stfind (st, "esitelat") + if (sym != NULL) { + call strcpy ("INDEF", AT_IMSTKVAL(sym), LEN_IMST_STRUCT) + ip = 1 + if (ctod ("INDEF", ip, dval) <= 0) + dval = INDEFD + call at_setd (at, ESITELAT, dval) + } + + sym = stfind (st, "esitealt") + if (sym != NULL) { + call strcpy ("INDEF", AT_IMSTKVAL(sym), LEN_IMST_STRUCT) + ip = 1 + if (ctor ("INDEF", ip, rval) <= 0) + rval = INDEFR + call at_setr (at, ESITEALT, rval) + } + + sym = stfind (st, "esitetz") + if (sym != NULL) { + call strcpy ("INDEF", AT_IMSTKVAL(sym), LEN_IMST_STRUCT) + ip = 1 + if (ctor ("INDEF", ip, rval) <= 0) + rval = INDEFR + call at_setr (at, ESITETZ, rval) + } + + sym = stfind (st, "emjdobs") + if (sym != NULL) { + call strcpy ("MJD-OBS", AT_IMSTKVAL(sym), LEN_IMST_STRUCT) + ip = 1 + if (ctod ("MJD-OBS", ip, dval) <= 0) + dval = INDEFD + call at_setd (at, EMJDOBS, dval) + } + + sym = stfind (st, "edatamin") + if (sym != NULL) { + call strcpy ("INDEF", AT_IMSTKVAL(sym), LEN_IMST_STRUCT) + ip = 1 + if (ctor ("INDEF", ip, rval) <= 0) + rval = INDEFR + call at_setr (at, EDATAMIN, rval) + } + + sym = stfind (st, "edatamax") + if (sym != NULL) { + call strcpy ("INDEF", AT_IMSTKVAL(sym), LEN_IMST_STRUCT) + ip = 1 + if (ctor ("INDEF", ip, rval) <= 0) + rval = INDEFR + call at_setr (at, EDATAMAX, rval) + } + + sym = stfind (st, "egain") + if (sym != NULL) { + call strcpy ("GAIN", AT_IMSTKVAL(sym), LEN_IMST_STRUCT) + ip = 1 + if (ctor ("GAIN", ip, rval) <= 0) + rval = INDEFR + call at_setr (at, EGAIN, rval) + } + + sym = stfind (st, "erdnoise") + if (sym != NULL) { + call strcpy ("RDNOISE", AT_IMSTKVAL(sym), LEN_IMST_STRUCT) + ip = 1 + if (ctor ("RDNOISE", ip, rval) <= 0) + rval = INDEFR + call at_setr (at, ERDNOISE, rval) + } + + sym = stfind (st, "ewavlen") + if (sym != NULL) { + call strcpy ("INDEF", AT_IMSTKVAL(sym), LEN_IMST_STRUCT) + ip = 1 + if (ctor ("INDEF", ip, rval) <= 0) + rval = INDEFR + call at_setr (at, EWAVLEN, rval) + } + + sym = stfind (st, "etemp") + if (sym != NULL) { + call strcpy ("INDEF", AT_IMSTKVAL(sym), LEN_IMST_STRUCT) + ip = 1 + if (ctor ("INDEF", ip, rval) <= 0) + rval = INDEFR + call at_setr (at, ETEMP, rval) + } + + sym = stfind (st, "epress") + if (sym != NULL) { + call strcpy ("INDEF", AT_IMSTKVAL(sym), LEN_IMST_STRUCT) + ip = 1 + if (ctor ("INDEF", ip, rval) <= 0) + rval = INDEFR + call at_setr (at, EPRESS, rval) + } + + sym = stfind (st, "observat") + if (sym != NULL) { + call strcpy ("OBSERVAT", AT_WCSTKVAL(sym), LEN_WCST_STRUCT) + call at_sets (at, OBSERVAT, "OBSERVAT") + } +end diff --git a/noao/astcat/src/attools/atdtype.x b/noao/astcat/src/attools/atdtype.x new file mode 100644 index 00000000..44ba4051 --- /dev/null +++ b/noao/astcat/src/attools/atdtype.x @@ -0,0 +1,55 @@ +# AT_DTYPE -- Decode the field data type. + +define NTYPES 6 + +# AT_DTYPE -- Given a single character data type from the set [csilrd] return +# the appropriate integer type, + +int procedure at_dtype (c) + +char c + +int type_codes[NTYPES], i +string types "csilrd" +int stridx() +data type_codes /TY_CHAR, TY_SHORT, TY_INT, TY_LONG, TY_REAL, TY_DOUBLE/ + +begin + i = stridx (c, types) + if (i == 0) + return (TY_CHAR) + else + return (type_codes[stridx(c,types)]) +end + + +# AT_ITYPE -- Given an integer code from the set TY_CHAR, TY_SHORT, TY_INT, +# TY_LONG, TY_REAL, and TY_DOUBLE return the appropriate character code +# from the set [csilrd]. + +char procedure at_itype (itype) + +int itype #I the integer data type + +char c + +begin + switch (itype) { + case TY_CHAR: + c = 'c' + case TY_SHORT: + c = 's' + case TY_INT: + c = 'i' + case TY_LONG: + c = 'l' + case TY_REAL: + c = 'r' + case TY_DOUBLE: + c = 'd' + default: + c = 'c' + } + + return (c) +end diff --git a/noao/astcat/src/attools/atfnames.x b/noao/astcat/src/attools/atfnames.x new file mode 100644 index 00000000..67741d5e --- /dev/null +++ b/noao/astcat/src/attools/atfnames.x @@ -0,0 +1,748 @@ +include <pkg/cq.h> +include "../../lib/astrom.h" + +# AT_SVLIST -- Create the input image survey list + +int procedure at_svlist (surveys, imdb) + +char surveys[ARB] #I the input image survey list +char imdb[ARB] #I the input image survey database file + +pointer sp, stemplate, svname, cq +int i, svlist, len_stemplate, strfd, svno +pointer cq_map() +int fntopnb(), fntlenb(), fntrfnb(), stropen(), cq_setcat(), strlen() +int cq_stati(), cq_locaten() +errchk fntopnb() + +begin + iferr (svlist = fntopnb (surveys, NO)) + svlist = fntopnb ("", NO) + if (surveys[1] == EOS) + return (svlist) + if (surveys[1] != '*' && fntlenb (svlist) <= 0) + return (svlist) + + # Open the catalog database. + cq = cq_map (imdb, READ_ONLY) + if (cq == NULL) { + call fntclsb (svlist) + svlist = fntopnb ("", NO) + return (svlist) + } + + # Determine the length of the image survey list string. + call smark (sp) + call salloc (svname, SZ_FNAME, TY_CHAR) + if (surveys[1] == '*') + len_stemplate = cq_stati (cq, CQNRECS) * SZ_FNAME + 1 + else + len_stemplate = fntlenb (svlist) * SZ_FNAME + 1 + call salloc (stemplate, len_stemplate, TY_CHAR) + Memc[stemplate] = EOS + + # Loop through the surveys checking for appropriate entry in the + # survey database + strfd = stropen (Memc[stemplate], len_stemplate, NEW_FILE) + if (surveys[1] == '*') { + do i = 1, cq_stati (cq, CQNRECS) { + if (cq_locaten (cq, i, Memc[svname], SZ_FNAME) != i) + next + call fprintf (strfd, "%s,") + call pargstr (Memc[svname]) + } + } else { + do i = 1, fntlenb (svlist) { + if (fntrfnb (svlist, i, Memc[svname], SZ_FNAME) == EOF) + break + svno = cq_setcat (cq, Memc[svname]) + if (svno <= 0) + next + call fprintf (strfd, "%s,") + call pargstr (Memc[svname]) + } + } + call close (strfd) + + # Create the final catalog list. + if (Memc[stemplate] != EOS) + Memc[stemplate+strlen(Memc[stemplate])-1] = EOS + call fntclsb (svlist) + svlist = fntopnb (Memc[stemplate], NO) + + # Unmap the catalog database. + call cq_unmap (cq) + + call sfree (sp) + + return (svlist) +end + +define SZ_HDRTEXT (5 * SZ_LINE) + +# AT_CATLIST -- Create the input catalog list + +int procedure at_catlist (catalogs, catdb) + +char catalogs[ARB] #I the input catalog list +char catdb[ARB] #I the input catalog database file + +pointer sp, ctemplate, catname, hdrtext, cq +int i, catlist, len_ctemplate, strfd, catno, tmpfd +pointer cq_map() +int fntopnb(), fntlenb(), fntrfnb(), stropen(), cq_setcat(), strlen() +int cq_stati(), cq_locaten(), access(), open(), at_gcathdr() +bool streq() +errchk fntopnb() + +begin + iferr (catlist = fntopnb (catalogs, NO)) + catlist = fntopnb ("", NO) + if (catalogs[1] == EOS) + return (catlist) + if (catalogs[1] != '*' && fntlenb (catlist) <= 0) + return (catlist) + + # Open the catalog database. + cq = cq_map (catdb, READ_ONLY) + if (cq == NULL) { + call fntclsb (catlist) + catlist = fntopnb ("", NO) + return (catlist) + } + + # Determine the length of the catalog list string. + call smark (sp) + call salloc (catname, SZ_FNAME, TY_CHAR) + if (catalogs[1] == '*') + len_ctemplate = cq_stati (cq, CQNRECS) * SZ_FNAME + 1 + else + len_ctemplate = fntlenb (catlist) * SZ_FNAME + 1 + call salloc (ctemplate, len_ctemplate, TY_CHAR) + Memc[ctemplate] = EOS + call salloc (hdrtext, SZ_HDRTEXT, TY_CHAR) + + # Loop through the catalogs checking for appropriate entry in the + # catalog database + strfd = stropen (Memc[ctemplate], len_ctemplate, NEW_FILE) + if (catalogs[1] == '*') { + do i = 1, cq_stati (cq, CQNRECS) { + if (cq_locaten (cq, i, Memc[catname], SZ_FNAME) != i) + next + if (streq (Memc[catname], "filename@noao")) + next + call fprintf (strfd, "%s,") + call pargstr (Memc[catname]) + } + } else { + do i = 1, fntlenb (catlist) { + if (fntrfnb (catlist, i, Memc[catname], SZ_FNAME) == EOF) + break + catno = cq_setcat (cq, Memc[catname]) + if (catno <= 0) { + if (access (Memc[catname], READ_ONLY, TEXT_FILE) == NO) + next + tmpfd = open (Memc[catname], READ_ONLY, TEXT_FILE) + if (at_gcathdr (tmpfd, Memc[hdrtext], SZ_HDRTEXT) <= 0) + next + call close (tmpfd) + } + call fprintf (strfd, "%s,") + call pargstr (Memc[catname]) + } + } + call close (strfd) + + # Create the final catalog list. + if (Memc[ctemplate] != EOS) + Memc[ctemplate+strlen(Memc[ctemplate])-1] = EOS + call fntclsb (catlist) + catlist = fntopnb (Memc[ctemplate], NO) + + # Unmap the catalog database. + call cq_unmap (cq) + + call sfree (sp) + + return (catlist) +end + + +# AT_OSVLIST -- Create a list output images using the input surveys list, +# the field center list stored in the field center symbol table, and an input +# template string. + +int procedure at_osvlist (at, svlist, output, defaultstr, extstr, append) + +pointer at #I the astrometry package descriptor +int svlist #I the input surveys list descriptor +char output[ARB] #I the input output file list +char defaultstr[ARB] #I the defaults id string +char extstr[ARB] #I the extension string +int append #I test for existence of file ? + +pointer sp, dirname, fname, fcname, symlist, symbol, otemplate, st +int i, j, imlist, len_dir, len_otemplate, strfd +pointer sthead(), stnext(), at_statp() +int imtopen(), fntlenb(), stnsymbols(), fnldir(), strncmp() +int strlen(), stropen(), access(), imtlen(), imtrgetim() +errchk imtopen() + +begin + # Return if the input file list is empty. + call at_sets (at, OUTPUT, "") + if (at_statp(at, PRCENTER) == NULL) { + imlist = imtopen ("") + } else if (at_statp(at, RCST) == NULL) { + imlist = imtopen ("") + } else { + iferr (imlist = imtopen (output)) + imlist = imtopen ("") + } + if (output[1] == EOS || imtlen (imlist) <= 0) + return (imlist) + + # Get the symbol table descriptor. + st = at_statp(at,RCST) + + # Return if the output file list is the wrong length. + if ((imtlen (imlist) > 1) && (imtlen (imlist) != fntlenb(svlist) * + stnsymbols(st, 0))) { + call imtclose (imlist) + imlist = imtopen ("") + return (imlist) + } + + # Get working space + call smark (sp) + call salloc (dirname, SZ_FNAME, TY_CHAR) + call salloc (fname, SZ_FNAME, TY_CHAR) + call salloc (fcname, SZ_FNAME, TY_CHAR) + call salloc (symlist, stnsymbols(st,0), TY_INT) + + # Get the symbol list. Note that it is in reverse order. + symbol = sthead (st) + do i = 1, stnsymbols (st, 0) { + Memi[symlist+i-1] = symbol + symbol = stnext (st, symbol) + } + + # Get the directory name. + if (imtrgetim (imlist, 1, Memc[fname], SZ_FNAME) == EOF) + Memc[fname] = EOS + len_dir = fnldir (Memc[fname], Memc[dirname], SZ_FNAME) + + # Get the default output file names. There will be one output file per + # input image. + if (strncmp (defaultstr, Memc[fname+len_dir], + strlen (defaultstr)) == 0 || len_dir == strlen (Memc[fname])) { + + # Creata temporary list string. + call imtclose (imlist) + len_otemplate = fntlenb (svlist) * stnsymbols (st, 0) * + SZ_FNAME + 1 + call salloc (otemplate, len_otemplate, TY_CHAR) + Memc[otemplate] = EOS + + # Loop over the catalog list. + strfd = stropen (Memc[otemplate], len_otemplate, NEW_FILE) + do j = 1, fntlenb (svlist) { + + # Loop over the symbol table. + do i = stnsymbols (st, 0), 1, -1 { + + symbol = Memi[symlist+i-1] + if (strncmp (AT_RCSTSOURCE(symbol), "image", 5) == 0) { + if (fntlenb (svlist) > 1) { + call sprintf (Memc[fcname], SZ_FNAME, "%s.%03d") + call pargstr (AT_RCSTNAME(symbol)) + call pargi (j) + call at_oimname (Memc[fcname], Memc[dirname], + extstr, Memc[dirname], SZ_FNAME) + } else + call at_oimname (AT_RCSTNAME(symbol), Memc[dirname], + extstr, Memc[dirname], SZ_FNAME) + } else { + if (fntlenb (svlist) > 1) { + call sprintf (Memc[fcname], SZ_FNAME, + "reg%03d.%03d") + call pargi (stnsymbols(st, 0) - i + 1) + call pargi (j) + } else { + call sprintf (Memc[fcname], SZ_FNAME, "reg%03d") + call pargi (stnsymbols(st, 0) - i + 1) + } + call at_oimname (Memc[fcname], Memc[dirname], extstr, + Memc[dirname], SZ_FNAME) + } + + # Record the file name. + call fprintf (strfd, "%s,") + call pargstr (Memc[dirname]) + + } + } + call close (strfd) + + # Create the final list. + if (Memc[otemplate] != EOS) + Memc[otemplate+strlen(Memc[otemplate])-1] = EOS + imlist = imtopen (Memc[otemplate]) + + # Get the user output names. + } else { + + # Create a temporary list string. + len_otemplate = imtlen (imlist) * SZ_FNAME + 1 + call salloc (otemplate, len_otemplate, TY_CHAR) + Memc[otemplate] = EOS + + strfd = stropen (Memc[otemplate], len_otemplate, NEW_FILE) + do j = 1, fntlenb (svlist) { + + # Loop over the fields. + do i = 1, imtlen (imlist) { + + # Get the output file name. + if (imtrgetim (imlist, i, Memc[fname], SZ_FNAME) == EOF) + break + + # Provide a default name if necessary. + if (append == NO && access (Memc[fname], 0, 0) == YES) { + symbol = Memi[symlist+stnsymbols(st,0)-i] + if (strncmp (AT_RCSTSOURCE(symbol), "image", 5) == 0) { + if (stnsymbols (st,0) > 1) { + call sprintf (Memc[fcname], SZ_FNAME, "%s.%03d") + call pargstr (AT_RCSTNAME(symbol)) + call pargi (j) + call at_oimname (Memc[fcname], Memc[dirname], + extstr, Memc[fname], SZ_FNAME) + } else + call at_oimname (AT_RCSTNAME(symbol), + Memc[dirname], extstr, Memc[fname], + SZ_FNAME) + } else { + if (fntlenb (svlist) > 1) { + call sprintf (Memc[fcname], SZ_FNAME, + "reg%03d.%03d") + call pargi (stnsymbols(st, 0) - i + 1) + call pargstr (j) + } else { + call sprintf (Memc[fcname], SZ_FNAME, + "reg%03d") + call pargi (stnsymbols(st, 0) - i + 1) + } + call at_oimname (Memc[fcname], Memc[dirname], + extstr, Memc[fname], SZ_FNAME) + } + } + + # Add the file name to the list. + call fprintf (strfd, "%s,") + call pargstr (Memc[fname]) + } + } + call close (strfd) + + if (Memc[otemplate] != EOS) + Memc[otemplate+strlen(Memc[otemplate])-1] = EOS + call imtclose (imlist) + imlist = imtopen (Memc[otemplate]) + } + call at_sets (at, OUTPUT, output) + + call sfree (sp) + + return (imlist) +end + + +# AT_OCATLIST -- Create a list output files list using the input catalog list, +# the field center list stored in the field center symbol table, and an input +# file template string. + +int procedure at_ocatlist (at, catlist, output, defaultstr, extstr, append) + +pointer at #I the astrometry package descriptor +int catlist #I the input catalog list descriptor +char output[ARB] #I the input output file list +char defaultstr[ARB] #I the defaults id string +char extstr[ARB] #I the extension string +int append #I test for existence of file ? + +pointer sp, dirname, fname, fcname, symlist, symbol, otemplate, st +int i, j, olist, len_dir, len_otemplate, strfd +pointer sthead(), stnext(), at_statp() +int fntopnb(), fntlenb(), stnsymbols(), fntrfnb(), fnldir(), strncmp() +int strlen(), stropen(), access() +errchk fntopnb() + +begin + # Return if the input file list is empty. + if (at_statp(at, PRCENTER) == NULL) { + olist = fntopnb ("", NO) + } else if (at_statp(at, RCST) == NULL) { + olist = fntopnb ("", NO) + } else { + iferr (olist = fntopnb (output, NO)) + olist = fntopnb ("", NO) + } + if (output[1] == EOS || fntlenb (olist) <= 0) + return (olist) + + # Get the symbol table descriptor. + st = at_statp(at,RCST) + + # Return if the output file list is the wrong length. + if ((fntlenb (olist) > 1) && (fntlenb (olist) != fntlenb(catlist) * + stnsymbols(st, 0))) { + call fntclsb (olist) + olist = fntopnb ("", NO) + return (olist) + } + + # Get working space + call smark (sp) + call salloc (dirname, SZ_FNAME, TY_CHAR) + call salloc (fname, SZ_FNAME, TY_CHAR) + call salloc (fcname, SZ_FNAME, TY_CHAR) + call salloc (symlist, stnsymbols(st,0), TY_INT) + + # Get the symbol list. Note that it is in reverse order. + symbol = sthead (st) + do i = 1, stnsymbols (st, 0) { + Memi[symlist+i-1] = symbol + symbol = stnext (st, symbol) + } + + # Get the directory name. + if (fntrfnb (olist, 1, Memc[fname], SZ_FNAME) == EOF) + Memc[fname] = EOS + len_dir = fnldir (Memc[fname], Memc[dirname], SZ_FNAME) + + # Get the default output file names. There will be one output file per + # input image. + if (strncmp (defaultstr, Memc[fname+len_dir], + strlen (defaultstr)) == 0 || len_dir == strlen (Memc[fname])) { + + # Creata temporary list string. + call fntclsb (olist) + len_otemplate = fntlenb (catlist) * stnsymbols (st, 0) * + SZ_FNAME + 1 + call salloc (otemplate, len_otemplate, TY_CHAR) + Memc[otemplate] = EOS + + # Loop over the catalog list. + strfd = stropen (Memc[otemplate], len_otemplate, NEW_FILE) + do j = 1, fntlenb (catlist) { + + # Loop over the symbol table. + do i = stnsymbols (st, 0), 1, -1 { + + symbol = Memi[symlist+i-1] + if (strncmp (AT_RCSTSOURCE(symbol), "image", 5) == 0) { + if (fntlenb (catlist) > 1) { + call sprintf (Memc[fcname], SZ_FNAME, "%s.%03d") + call pargstr (AT_RCSTNAME(symbol)) + call pargi (j) + call at_outname (Memc[fcname], Memc[dirname], + extstr, Memc[dirname], SZ_FNAME) + } else + call at_outname (AT_RCSTNAME(symbol), Memc[dirname], + extstr, Memc[dirname], SZ_FNAME) + } else { + if (fntlenb (catlist) > 1) { + call sprintf (Memc[fcname], SZ_FNAME, + "reg%03d.%03d") + call pargi (stnsymbols(st, 0) - i + 1) + call pargi (j) + } else { + call sprintf (Memc[fcname], SZ_FNAME, "reg%03d") + call pargi (stnsymbols(st, 0) - i + 1) + } + call at_outname (Memc[fcname], Memc[dirname], extstr, + Memc[dirname], SZ_FNAME) + } + + # Record the file name. + call fprintf (strfd, "%s,") + call pargstr (Memc[dirname]) + + } + } + call close (strfd) + + # Create the final list. + if (Memc[otemplate] != EOS) + Memc[otemplate+strlen(Memc[otemplate])-1] = EOS + olist = fntopnb (Memc[otemplate], NO) + + # Get the user output names. + } else { + + # Create a temporary list string. + len_otemplate = fntlenb (olist) * SZ_FNAME + 1 + call salloc (otemplate, len_otemplate, TY_CHAR) + Memc[otemplate] = EOS + + strfd = stropen (Memc[otemplate], len_otemplate, NEW_FILE) + do j = 1, fntlenb (catlist) { + + # Loop over the fields. + do i = 1, fntlenb (olist) { + + # Get the output file name. + if (fntrfnb (olist, i, Memc[fname], SZ_FNAME) == EOF) + break + + # Provide a default name if necessary. + if (append == NO && access (Memc[fname], 0, 0) == YES) { + symbol = Memi[symlist+stnsymbols(st,0)-i] + if (strncmp (AT_RCSTSOURCE(symbol), "image", 5) == 0) { + if (fntlenb(catlist) > 1) { + call sprintf (Memc[fcname], SZ_FNAME, "%s.%03d") + call pargstr (AT_RCSTNAME(symbol)) + call pargi (j) + call at_outname (Memc[fcname], Memc[dirname], + extstr, Memc[fname], SZ_FNAME) + } else + call at_outname (AT_RCSTNAME(symbol), + Memc[dirname], extstr, Memc[fname], + SZ_FNAME) + } else { + if (fntlenb (catlist) > 1) { + call sprintf (Memc[fcname], SZ_FNAME, + "reg%03d.%03d") + call pargi (stnsymbols(st, 0) - i + 1) + call pargi (j) + } else { + call sprintf (Memc[fcname], SZ_FNAME, + "reg%03d") + call pargi (stnsymbols(st, 0) - i + 1) + } + call at_outname (Memc[fcname], Memc[dirname], + extstr, Memc[dirname], SZ_FNAME) + } + } + + # Add the file name to the list. + call fprintf (strfd, "%s,") + call pargstr (Memc[fname]) + } + } + call close (strfd) + + if (Memc[otemplate] != EOS) + Memc[otemplate+strlen(Memc[otemplate])-1] = EOS + call fntclsb (olist) + olist = fntopnb (Memc[otemplate], NO) + } + + call sfree (sp) + + return (olist) +end + + +# AT_OUTNAME -- Construct an astrom output file name. +# If output is null or a directory, a name is constructed from the root +# of the image name and the extension. The disk is searched to avoid +# name collisions. + +procedure at_outname (image, output, ext, name, maxch) + +char image[ARB] #I input image name +char output[ARB] #I input output directory or name +char ext[ARB] #I input extension +char name[ARB] #O output file name +int maxch #I maximum size of name + +int ndir, nimdir, clindex, clsize +pointer sp, root, str +int fnldir(), strlen(), + +begin + call smark (sp) + call salloc (root, SZ_FNAME, TY_CHAR) + call salloc (str, SZ_FNAME, TY_CHAR) + + ndir = fnldir (output, name, maxch) + if (strlen (output) == ndir) { + call imparse (image, Memc[root], SZ_FNAME, Memc[str], SZ_FNAME, + Memc[str], SZ_FNAME, clindex, clsize) + nimdir = fnldir (Memc[root], Memc[str], SZ_FNAME) + if (clindex >= 0) { + if (ext[1] == EOS) { + call sprintf (name[ndir+1], maxch, "%s%d.*") + call pargstr (Memc[root+nimdir]) + call pargi (clindex) + } else { + call sprintf (name[ndir+1], maxch, "%s%d.%s.*") + call pargstr (Memc[root+nimdir]) + call pargi (clindex) + call pargstr (ext) + } + } else { + if (ext[1] == EOS) { + call sprintf (name[ndir+1], maxch, "%s.*") + call pargstr (Memc[root+nimdir]) + } else { + call sprintf (name[ndir+1], maxch, "%s.%s.*") + call pargstr (Memc[root+nimdir]) + call pargstr (ext) + } + } + call at_oversion (name, name, maxch) + } else + call strcpy (output, name, maxch) + + call sfree (sp) +end + + +# AT_OVERSION -- Compute the next available version number of a given file +# name template and output the new file name. + +procedure at_oversion (template, filename, maxch) + +char template[ARB] #I the input name template +char filename[ARB] #O the output name +int maxch #I the maximum number of characters + +char period +int newversion, version, len +pointer sp, list, name +int fntgfnb() strldx(), ctoi(), fntopnb() +errchk fntopnb() + +begin + # Allocate temporary space + call smark (sp) + call salloc (name, maxch, TY_CHAR) + period = '.' + iferr (list = fntopnb (template, NO)) + list = fntopnb ("", NO) + + # Loop over the names in the list searchng for the highest version. + newversion = 0 + while (fntgfnb (list, Memc[name], maxch) != EOF) { + len = strldx (period, Memc[name]) + len = len + 1 + if (ctoi (Memc[name], len, version) <= 0) + next + newversion = max (newversion, version) + } + + # Make new output file name. + len = strldx (period, template) + call strcpy (template, filename, len) + call sprintf (filename[len+1], maxch, "%d") + call pargi (newversion + 1) + + call fntclsb (list) + call sfree (sp) +end + + +# AT_OIMNAME -- Construct an output image name. If output is null or a +# directory a name is constructed from the root of the image name and the +# extension. The disk is searched to avoid name collisions. + +procedure at_oimname (image, output, ext, name, maxch) + +char image[ARB] #I the input image name +char output[ARB] #I the output directory or ouput image name +char ext[ARB] #I the output image extension +char name[ARB] #O the final output image name +int maxch #I maximum size of name + +int ndir, nimdir, clindex, clsize +pointer sp, root, str +int fnldir(), strlen() + +begin + # Allocate some temporary space. + call smark (sp) + call salloc (root, SZ_FNAME, TY_CHAR) + call salloc (str, SZ_FNAME, TY_CHAR) + + # Determine the length of the directory spec. + ndir = fnldir (output, name, maxch) + + # If the file spec is a directory create a name from the directory and + # the route image name, otherwise use the output name directly. + if (strlen (output) == ndir) { + call imparse (image, Memc[root], SZ_FNAME, Memc[str], SZ_FNAME, + Memc[str], SZ_FNAME, clindex, clsize) + nimdir = fnldir (Memc[root], Memc[str], SZ_FNAME) + if (clindex >= 0) { + if (ext[1] == EOS) { + call sprintf (name[ndir+1], maxch, "%s%d.*") + call pargstr (Memc[root+nimdir]) + call pargi (clindex) + } else { + call sprintf (name[ndir+1], maxch, "%s%d.%s.*") + call pargstr (Memc[root+nimdir]) + call pargi (clindex) + call pargstr (ext) + } + } else { + if (ext[1] == EOS) { + call sprintf (name[ndir+1], maxch, "%s.*") + call pargstr (Memc[root+nimdir]) + } else { + call sprintf (name[ndir+1], maxch, "%s.%s.*") + call pargstr (Memc[root+nimdir]) + call pargstr (ext) + } + } + call at_oimversion (name, name, maxch) + } else + call strcpy (output, name, maxch) + + call sfree (sp) +end + + +# AT_OIMVERSION -- Determine the next available version number of for a given +# image name template and output the new image name. + +procedure at_oimversion (template, filename, maxch) + +char template[ARB] #I the image name template +char filename[ARB] #O the output image name +int maxch #I the maximum number of characters + +char period +int newversion, version, len +pointer sp, list, name +int imtopen(), imtgetim(), strldx(), ctoi() + +begin + # Allocate temporary space + call smark (sp) + call salloc (name, maxch, TY_CHAR) + period = '.' + list = imtopen (template) + + # Loop over the names in the list searchng for the highest version. + newversion = 0 + while (imtgetim (list, Memc[name], maxch) != EOF) { + len = strldx (period, Memc[name]) + Memc[name+len-1] = EOS + len = strldx (period, Memc[name]) + len = len + 1 + if (ctoi (Memc[name], len, version) <= 0) + next + newversion = max (newversion, version) + } + + # Make new output file name. + len = strldx (period, template) + call strcpy (template, filename, len) + call sprintf (filename[len+1], maxch, "%d") + call pargi (newversion + 1) + + call imtclose (list) + call sfree (sp) +end diff --git a/noao/astcat/src/attools/atinpars.x b/noao/astcat/src/attools/atinpars.x new file mode 100644 index 00000000..df0f5d95 --- /dev/null +++ b/noao/astcat/src/attools/atinpars.x @@ -0,0 +1,408 @@ +include "../../lib/astrom.h" +include "../../lib/acatalog.h" +include "../../lib/aimpars.h" + + +# AT_GRCPSET -- Read in the region definition parameters. + +procedure at_grcpset (psetname, at) + +char psetname[ARB] #I the input pset name +pointer at #I the pointer to the main astrom structure + +double dval +pointer sp, str, pp +int ival, nchars +double clgpsetd() +pointer clopset() +int ctod(), strlen(), strdic() + +begin + call smark (sp) + call salloc (str, SZ_FNAME, TY_CHAR) + + pp = clopset (psetname) + + # Get the field center and width. + call clgpset (pp, "rcra", Memc[str], SZ_FNAME) + nchars = strlen (Memc[str]) + ival = 1 + if (nchars != 0 && (ctod (Memc[str], ival, dval) == nchars)) + call at_setd (at, RCRA, dval) + else + call error (0, "Parameter not a legal number (aregpars.rcra)") + + call clgpset (pp, "rcdec", Memc[str], SZ_FNAME) + nchars = strlen (Memc[str]) + ival = 1 + if (nchars != 0 && (ctod (Memc[str], ival, dval) == nchars)) + call at_setd (at, RCDEC, dval) + else + call error (0, "Parameter not a legal number (aregpars.rcdec)") + + call at_setd (at, RCRAWIDTH, clgpsetd (pp, "rrawidth")) + call at_setd (at, RCDECWIDTH, clgpsetd (pp, "rdecwidth")) + + # Get the field center units. + call clgpset (pp, "rcraunits", Memc[str], SZ_FNAME) + ival = strdic (Memc[str], Memc[str], SZ_FNAME, AT_RA_UNITS) + if (ival <= 0) + call at_seti (at, RCRAUNITS, 0) + else + call at_seti (at, RCRAUNITS, ival) + call clgpset (pp, "rcdecunits", Memc[str], SZ_FNAME) + ival = strdic (Memc[str], Memc[str], SZ_FNAME, AT_DEC_UNITS) + if (ival <= 0) + call at_seti (at, RCDECUNITS, 0) + else + call at_seti (at, RCDECUNITS, ival) + + # Get the field center celestial coordinate system. + call clgpset (pp, "rcsystem", Memc[str], SZ_FNAME) + call at_sets (at, RCSYSTEM, Memc[str]) + + call clcpset (pp) + + call sfree (sp) +end + + +# AT_GFSPSET -- Read in the input catalog filtering / selection parameters. + +procedure at_gfspset (psetname, at) + +char psetname[ARB] #I the input pset name +pointer at #I the pointer to the main astrom structure + +pointer sp, str, pp +int ival +pointer clopset() +int btoi(), strdic() +bool clgpsetb() + +begin + call smark (sp) + call salloc (str, SZ_LINE, TY_CHAR) + + pp = clopset (psetname) + + call clgpset (pp, "fields", Memc[str], SZ_LINE) + call at_sets (at, FIELDS, Memc[str]) + call clgpset (pp, "fexpr", Memc[str], SZ_LINE) + call at_sets (at, FEXPR, Memc[str]) + call clgpset (pp, "fnames", Memc[str], SZ_LINE) + call at_sets (at, FNAMES, Memc[str]) + call clgpset (pp, "fntypes", Memc[str], SZ_LINE) + call at_sets (at, FNTYPES, Memc[str]) + call clgpset (pp, "fnunits", Memc[str], SZ_LINE) + call at_sets (at, FNUNITS, Memc[str]) + call clgpset (pp, "fnformats", Memc[str], SZ_LINE) + call at_sets (at, FNFORMATS, Memc[str]) + + call clgpset (pp, "fsort", Memc[str], SZ_LINE) + call at_sets (at, FSORT, Memc[str]) + call at_seti (at, FREVERSE, btoi (clgpsetb (pp, "freverse"))) + + #call at_seti (at, FREPLACE, btoi (clgpsetb (pp, "freplace"))) + call clgpset (pp, "fosystem", Memc[str], SZ_LINE) + call at_sets (at, FOSYSTEM, Memc[str]) + + call clgpset (pp, "fira", Memc[str], SZ_LINE) + call at_sets (at, FIRA, Memc[str]) + call clgpset (pp, "fidec", Memc[str], SZ_LINE) + call at_sets (at, FIDEC, Memc[str]) + call clgpset (pp, "foraunits", Memc[str], SZ_LINE) + ival = strdic (Memc[str], Memc[str], SZ_FNAME, AT_RA_UNITS) + if (ival <= 0) + call at_seti (at, FORAUNITS, 0) + else + call at_seti (at, FORAUNITS, ival) + call clgpset (pp, "fodecunits", Memc[str], SZ_LINE) + ival = strdic (Memc[str], Memc[str], SZ_FNAME, AT_DEC_UNITS) + if (ival <= 0) + call at_seti (at, FODECUNITS, 0) + else + call at_seti (at, FODECUNITS, ival) + call clgpset (pp, "foraformat", Memc[str], SZ_LINE) + call at_sets (at, FORAFORMAT, Memc[str]) + call clgpset (pp, "fodecformat", Memc[str], SZ_LINE) + call at_sets (at, FODECFORMAT, Memc[str]) + + call clgpset (pp, "fixp", Memc[str], SZ_LINE) + call at_sets (at, FIXP, Memc[str]) + call clgpset (pp, "fiyp", Memc[str], SZ_LINE) + call at_sets (at, FIYP, Memc[str]) + call clgpset (pp, "fixc", Memc[str], SZ_LINE) + call at_sets (at, FIXC, Memc[str]) + call clgpset (pp, "fiyc", Memc[str], SZ_LINE) + call at_sets (at, FIYC, Memc[str]) + + call clgpset (pp, "foxformat", Memc[str], SZ_LINE) + call at_sets (at, FOXFORMAT, Memc[str]) + call clgpset (pp, "foyformat", Memc[str], SZ_LINE) + call at_sets (at, FOYFORMAT, Memc[str]) + + call clcpset (pp) + + call sfree (sp) +end + + +# AT_GWCPSET -- Read in the default image wcs parameters. + +procedure at_gwcpset (psetname, at) + +char psetname[ARB] #I the input pset name +pointer at #I the pointer to the main astrom structure + +double dval +pointer sp, str, pp, st, sym +int ip, ival +pointer clopset(), stopen(), stenter() +int ctod(), strdic() +bool streq() + +begin + call smark (sp) + call salloc (str, SZ_LINE, TY_CHAR) + + st = stopen ("wcslist", 2 * DEF_LEN_WCST, DEF_LEN_WCST, + 10 * DEF_LEN_WCST) + call at_setp (at, WCST, st) + + pp = clopset (psetname) + + call clgpset (pp, "wxref", Memc[str], SZ_LINE) + sym = stenter (st, "wxref", LEN_WCST_STRUCT) + call strcpy (Memc[str], AT_WCSTKVAL(sym), LEN_WCST_STRUCT) + ip = 1 + if (ctod (Memc[str], ip, dval) <= 0) + dval = INDEFD + call at_setd (at, WXREF, dval) + + call clgpset (pp, "wyref", Memc[str], SZ_LINE) + sym = stenter (st, "wyref", LEN_WCST_STRUCT) + call strcpy (Memc[str], AT_WCSTKVAL(sym), LEN_WCST_STRUCT) + ip = 1 + if (ctod (Memc[str], ip, dval) <= 0) + dval = INDEFD + call at_setd (at, WYREF, dval) + + call clgpset (pp, "wxmag", Memc[str], SZ_LINE) + sym = stenter (st, "wxmag", LEN_WCST_STRUCT) + call strcpy (Memc[str], AT_WCSTKVAL(sym), LEN_WCST_STRUCT) + ip = 1 + if (ctod (Memc[str], ip, dval) <= 0) + dval = INDEFD + call at_setd (at, WXMAG, dval) + + call clgpset (pp, "wymag", Memc[str], SZ_LINE) + sym = stenter (st, "wymag", LEN_WCST_STRUCT) + call strcpy (Memc[str], AT_WCSTKVAL(sym), LEN_WCST_STRUCT) + ip = 1 + if (ctod (Memc[str], ip, dval) <= 0) + dval = INDEFD + call at_setd (at, WYMAG, dval) + + call clgpset (pp, "wxrot", Memc[str], SZ_LINE) + sym = stenter (st, "wxrot", LEN_WCST_STRUCT) + call strcpy (Memc[str], AT_WCSTKVAL(sym), LEN_WCST_STRUCT) + ip = 1 + if (ctod (Memc[str], ip, dval) <= 0) + dval = INDEFD + call at_setd (at, WXROT, dval) + + call clgpset (pp, "wyrot", Memc[str], SZ_LINE) + sym = stenter (st, "wyrot", LEN_WCST_STRUCT) + call strcpy (Memc[str], AT_WCSTKVAL(sym), LEN_WCST_STRUCT) + ip = 1 + if (ctod (Memc[str], ip, dval) <= 0) + dval = INDEFD + call at_setd (at, WYROT, dval) + + call clgpset (pp, "wraref", Memc[str], SZ_LINE) + sym = stenter (st, "wraref", LEN_WCST_STRUCT) + call strcpy (Memc[str], AT_WCSTKVAL(sym), LEN_WCST_STRUCT) + ip = 1 + if (ctod (Memc[str], ip, dval) <= 0) + dval = INDEFD + call at_setd (at, WRAREF, dval) + + call clgpset (pp, "wdecref", Memc[str], SZ_LINE) + sym = stenter (st, "wdecref", LEN_WCST_STRUCT) + call strcpy (Memc[str], AT_WCSTKVAL(sym), LEN_WCST_STRUCT) + ip = 1 + if (ctod (Memc[str], ip, dval) <= 0) + dval = INDEFD + call at_setd (at, WDECREF, dval) + + call clgpset (pp, "wraunits", Memc[str], SZ_LINE) + sym = stenter (st, "wraunits", LEN_WCST_STRUCT) + call strcpy (Memc[str], AT_WCSTKVAL(sym), LEN_WCST_STRUCT) + ival = strdic (Memc[str], Memc[str], SZ_FNAME, AT_RA_UNITS) + if (ival <= 0) + call at_seti (at, WRAUNITS, 0) + else + call at_seti (at, WRAUNITS, ival) + + call clgpset (pp, "wdecunits", Memc[str], SZ_LINE) + sym = stenter (st, "wdecunits", LEN_WCST_STRUCT) + call strcpy (Memc[str], AT_WCSTKVAL(sym), LEN_WCST_STRUCT) + ival = strdic (Memc[str], Memc[str], SZ_FNAME, AT_DEC_UNITS) + if (ival <= 0) + call at_seti (at, WDECUNITS, 0) + else + call at_seti (at, WDECUNITS, ival) + + call clgpset (pp, "wproj", Memc[str], SZ_LINE) + sym = stenter (st, "wproj", LEN_WCST_STRUCT) + call strcpy (Memc[str], AT_WCSTKVAL(sym), LEN_WCST_STRUCT) + if (streq (Memc[str], "INDEF")) + call at_sets (at, WPROJ, "tan") + else + call at_sets (at, WPROJ, Memc[str]) + + call clgpset (pp, "wsystem", Memc[str], SZ_LINE) + sym = stenter (st, "wsystem", LEN_WCST_STRUCT) + call strcpy (Memc[str], AT_WCSTKVAL(sym), LEN_WCST_STRUCT) + if (streq (Memc[str], "INDEF")) + call at_sets (at, WSYSTEM, "J2000") + else + call at_sets (at, WSYSTEM, Memc[str]) + + call clcpset (pp) + + call sfree (sp) +end + + + +# AT_GIMPSET -- Read in the default image data parameters. + +procedure at_gimpset (psetname, at) + +char psetname[ARB] #I the input pset name +pointer at #I the pointer to the main astrom structure + +double dval +real rval +pointer sp, str, pp, st, sym +int ip +pointer clopset(), stopen(), stenter() +int ctod(), ctor() + +begin + call smark (sp) + call salloc (str, SZ_LINE, TY_CHAR) + + pp = clopset (psetname) + st = stopen ("imlist", 2 * DEF_LEN_IMST, DEF_LEN_IMST, + 10 * DEF_LEN_IMST) + call at_setp (at, IMST, st) + + call clgpset (pp, "esitelng", Memc[str], SZ_LINE) + sym = stenter (st, "esitelng", LEN_IMST_STRUCT) + call strcpy (Memc[str], AT_IMSTKVAL(sym), LEN_IMST_STRUCT) + ip = 1 + if (ctod (Memc[str], ip, dval) <= 0) + dval = INDEFD + call at_setd (at, ESITELNG, dval) + + call clgpset (pp, "esitelat", Memc[str], SZ_LINE) + sym = stenter (st, "esitelat", LEN_IMST_STRUCT) + call strcpy (Memc[str], AT_IMSTKVAL(sym), LEN_IMST_STRUCT) + ip = 1 + if (ctod (Memc[str], ip, dval) <= 0) + dval = INDEFD + call at_setd (at, ESITELAT, dval) + + call clgpset (pp, "esitealt", Memc[str], SZ_LINE) + sym = stenter (st, "esitealt", LEN_IMST_STRUCT) + call strcpy (Memc[str], AT_IMSTKVAL(sym), LEN_IMST_STRUCT) + ip = 1 + if (ctor (Memc[str], ip, rval) <= 0) + rval = INDEFR + call at_setr (at, ESITEALT, rval) + + call clgpset (pp, "esitetz", Memc[str], SZ_LINE) + sym = stenter (st, "esitetz", LEN_IMST_STRUCT) + call strcpy (Memc[str], AT_IMSTKVAL(sym), LEN_IMST_STRUCT) + ip = 1 + if (ctor (Memc[str], ip, rval) <= 0) + rval = INDEFR + call at_setr (at, ESITETZ, rval) + + call clgpset (pp, "emjdobs", Memc[str], SZ_LINE) + sym = stenter (st, "emjdobs", LEN_IMST_STRUCT) + call strcpy (Memc[str], AT_IMSTKVAL(sym), LEN_IMST_STRUCT) + ip = 1 + if (ctod (Memc[str], ip, dval) <= 0) + dval = INDEFD + call at_setd (at, EMJDOBS, dval) + + call clgpset (pp, "edatamin", Memc[str], SZ_LINE) + sym = stenter (st, "edatamin", LEN_IMST_STRUCT) + call strcpy (Memc[str], AT_IMSTKVAL(sym), LEN_IMST_STRUCT) + ip = 1 + if (ctor (Memc[str], ip, rval) <= 0) + rval = INDEFR + call at_setr (at, EDATAMIN, rval) + + call clgpset (pp, "edatamax", Memc[str], SZ_LINE) + sym = stenter (st, "edatamax", LEN_IMST_STRUCT) + call strcpy (Memc[str], AT_IMSTKVAL(sym), LEN_IMST_STRUCT) + ip = 1 + if (ctor (Memc[str], ip, rval) <= 0) + rval = INDEFR + call at_setr (at, EDATAMAX, rval) + + call clgpset (pp, "egain", Memc[str], SZ_LINE) + sym = stenter (st, "egain", LEN_IMST_STRUCT) + call strcpy (Memc[str], AT_IMSTKVAL(sym), LEN_IMST_STRUCT) + ip = 1 + if (ctor (Memc[str], ip, rval) <= 0) + rval = INDEFR + call at_setr (at, EGAIN, rval) + + call clgpset (pp, "erdnoise", Memc[str], SZ_LINE) + sym = stenter (st, "erdnoise", LEN_IMST_STRUCT) + call strcpy (Memc[str], AT_IMSTKVAL(sym), LEN_IMST_STRUCT) + ip = 1 + if (ctor (Memc[str], ip, rval) <= 0) + rval = INDEFR + call at_setr (at, ERDNOISE, rval) + + call clgpset (pp, "ewavlen", Memc[str], SZ_LINE) + sym = stenter (st, "ewavlen", LEN_IMST_STRUCT) + call strcpy (Memc[str], AT_IMSTKVAL(sym), LEN_IMST_STRUCT) + ip = 1 + if (ctor (Memc[str], ip, rval) <= 0) + rval = INDEFR + call at_setr (at, EWAVLEN, rval) + + call clgpset (pp, "etemp", Memc[str], SZ_LINE) + sym = stenter (st, "etemp", LEN_IMST_STRUCT) + call strcpy (Memc[str], AT_IMSTKVAL(sym), LEN_IMST_STRUCT) + ip = 1 + if (ctor (Memc[str], ip, rval) <= 0) + rval = INDEFR + call at_setr (at, ETEMP, rval) + + call clgpset (pp, "epress", Memc[str], SZ_LINE) + sym = stenter (st, "epress", LEN_IMST_STRUCT) + call strcpy (Memc[str], AT_IMSTKVAL(sym), LEN_IMST_STRUCT) + ip = 1 + if (ctor (Memc[str], ip, rval) <= 0) + rval = INDEFR + call at_setr (at, EPRESS, rval) + + call clgpset (pp, "observat", Memc[str], SZ_LINE) + sym = stenter (st, "observat", LEN_WCST_STRUCT) + call strcpy (Memc[str], AT_WCSTKVAL(sym), LEN_WCST_STRUCT) + call at_sets (at, OBSERVAT, Memc[str]) + + + call clcpset (pp) + + call sfree (sp) +end diff --git a/noao/astcat/src/attools/atoutpars.x b/noao/astcat/src/attools/atoutpars.x new file mode 100644 index 00000000..6c2bf213 --- /dev/null +++ b/noao/astcat/src/attools/atoutpars.x @@ -0,0 +1,258 @@ +include "../../lib/astrom.h" +include "../../lib/acatalog.h" +include "../../lib/aimpars.h" + + +# AT_PRCPSET -- Write the current parameter values out to the region +# parameters set. + +procedure at_prcpset (psetname, at) + +char psetname[ARB] #I the parameter set name +pointer at #I the pointer to the main astrom structure + +pointer sp, str, pp +int ival +double at_statd() +pointer clopset() +int at_wrdstr(), at_stati() + +begin + call smark (sp) + call salloc (str, SZ_FNAME, TY_CHAR) + + pp = clopset ("psetname") + + # Update the field center and field width parameters. + call clppsetd (pp, "rcra", at_statd (at, RCRA)) + call clppsetd (pp, "rcdec", at_statd (at, RCDEC)) + call clppsetd (pp, "rrawidth", at_statd (at, RCRAWIDTH)) + call clppsetd (pp, "rdecwidth", at_statd (at, RCDECWIDTH)) + + # Update the units parameters. + ival = at_stati (at, RCRAUNITS) + if (ival <= 0) + Memc[str] = EOS + else if (at_wrdstr (ival, Memc[str], SZ_FNAME, AT_RA_UNITS) <= 0) + Memc[str] = EOS + call clppset (pp, "rcraunits", Memc[str]) + + ival = at_stati (at, RCDECUNITS) + if (ival <= 0) + Memc[str] = EOS + else if (at_wrdstr (ival, Memc[str], SZ_FNAME, AT_DEC_UNITS) <= 0) + Memc[str] = EOS + call clppset (pp, "rcdecunits", Memc[str]) + + # Update the celestial coordinate system. + call at_stats (at, RCSYSTEM, Memc[str], SZ_FNAME) + call clppset (pp, "rcsystem", Memc[str]) + + call clcpset (pp) + + call sfree (sp) +end + + +# AT_PFSPSET -- Write the current parameter values out to the filtering +# parameters parameter set. + +procedure at_pfspset (psetname, at) + +char psetname[ARB] #I the parameter set name +pointer at #I the pointer to the main astrom structure + +pointer sp, str, pp +int ival +pointer clopset() +int at_stati(), at_wrdstr() +bool itob() + +begin + call smark (sp) + call salloc (str, SZ_LINE, TY_CHAR) + + pp = clopset ("psetname") + + call at_stats (pp, FIELDS, Memc[str], SZ_LINE) + call clppset (pp, "fields", Memc[str]) + call at_stats (pp, FEXPR, Memc[str], SZ_LINE) + call clppset (pp, "fexpr", Memc[str]) + call at_stats (pp, FNAMES, Memc[str], SZ_LINE) + call clppset (pp, "fnames", Memc[str]) + call at_stats (pp, FNTYPES, Memc[str], SZ_LINE) + call clppset (pp, "fntypes", Memc[str]) + call at_stats (pp, FNUNITS, Memc[str], SZ_LINE) + call clppset (pp, "fnunits", Memc[str]) + call at_stats (pp, FNFORMATS, Memc[str], SZ_LINE) + call clppset (pp, "fnformats", Memc[str]) + + call at_stats (pp, FSORT, Memc[str], SZ_LINE) + call clppset (pp, "fsort", Memc[str]) + call clppsetb (pp, "freverse", itob(at_stati(at,FREVERSE))) + + #call clppsetb (pp, "freplace", itob(at_stati(at,FREPLACE))) + call at_stats (pp, FOSYSTEM, Memc[str], SZ_LINE) + call clppset (pp, "fosystem", Memc[str]) + call at_stats (pp, FIRA, Memc[str], SZ_LINE) + call clppset (pp, "fira", Memc[str]) + call at_stats (pp, FIDEC, Memc[str], SZ_LINE) + call clppset (pp, "fidec", Memc[str]) + ival = at_wrdstr (at_stati(at,FORAUNITS), Memc[str], SZ_FNAME, + AT_RA_UNITS) + if (ival <= 0) + call clppset (pp, "foraunits", "") + else + call clppset (pp, "foraunits", Memc[str]) + ival = at_wrdstr (at_stati(at,FODECUNITS), Memc[str], SZ_FNAME, + AT_DEC_UNITS) + if (ival <= 0) + call clppset (pp, "fodecunits", "") + else + call clppset (pp, "fodecunits", Memc[str]) + call at_stats (pp, FORAFORMAT, Memc[str], SZ_LINE) + call clppset (pp, "foraformats", Memc[str]) + call at_stats (pp, FODECFORMAT, Memc[str], SZ_LINE) + call clppset (pp, "fodecformats", Memc[str]) + + call at_stats (pp, FIXP, Memc[str], SZ_LINE) + call clppset (pp, "fixp", Memc[str]) + call at_stats (pp, FIYP, Memc[str], SZ_LINE) + call clppset (pp, "fiyp", Memc[str]) + call at_stats (pp, FIXC, Memc[str], SZ_LINE) + call clppset (pp, "fixc", Memc[str]) + call at_stats (pp, FIYC, Memc[str], SZ_LINE) + call clppset (pp, "fiyc", Memc[str]) + call at_stats (pp, FOXFORMAT, Memc[str], SZ_LINE) + call clppset (pp, "foxformat", Memc[str]) + call at_stats (pp, FOYFORMAT, Memc[str], SZ_LINE) + call clppset (pp, "foyformat", Memc[str]) + + call clcpset (pp) + + call sfree (sp) +end + + +# AT_PWCPSET -- Write the current parameter values out to the default WCS +# parameters parameter set. + +procedure at_pwcpset (psetname, at) + +char psetname[ARB] #I the parameter set name +pointer at #I the pointer to the main astrom structure + +pointer pp, st, sym +pointer clopset(), at_statp(), stfind() + + +begin + pp = clopset ("psetname") + st = at_statp (at, WCST) + + sym = stfind (st, "wxref") + call clppset (pp, "wxref", AT_WCSTKVAL(sym)) + + sym = stfind (st, "wyref") + call clppset (pp, "wyref", AT_WCSTKVAL(sym)) + + sym = stfind (st, "wxmag") + call clppset (pp, "wxmag", AT_WCSTKVAL(sym)) + + sym = stfind (st, "wymag") + call clppset (pp, "wymag", AT_WCSTKVAL(sym)) + + sym = stfind (st, "wxrot") + call clppset (pp, "wxrot", AT_WCSTKVAL(sym)) + + sym = stfind (st, "wyrot") + call clppset (pp, "wyrot", AT_WCSTKVAL(sym)) + + sym = stfind (st, "wraref") + call clppset (pp, "wraref", AT_WCSTKVAL(sym)) + + sym = stfind (st, "wdecref") + call clppset (pp, "wdecref", AT_WCSTKVAL(sym)) + + sym = stfind (st, "wraunits") + call clppset (pp, "wraunits", AT_WCSTKVAL(sym)) + + sym = stfind (st, "wdecunits") + call clppset (pp, "wdecunits", AT_WCSTKVAL(sym)) + + sym = stfind (st, "wproj") + call clppset (pp, "wproj", AT_WCSTKVAL(sym)) + + sym = stfind (st, "wsystem") + call clppset (pp, "wsystem", AT_WCSTKVAL(sym)) + + call clcpset (pp) +end + + +# AT_PIMPSET -- Write the current parameter values out to the default WCS +# parameters parameter set. + +procedure at_pimpset (psetname, at) + +char psetname[ARB] #I the parameter set name +pointer at #I the pointer to the main astrom structure + +pointer pp, st, sym +pointer clopset(), at_statp(), stfind() + + +begin + pp = clopset ("psetname") + st = at_statp (at, IMST) + + sym = stfind (st, "esitelng") + call clppset (pp, "esitelng", AT_IMSTKVAL(sym)) + + sym = stfind (st, "esitelat") + call clppset (pp, "esitelat", AT_IMSTKVAL(sym)) + + sym = stfind (st, "emjdobs") + call clppset (pp, "emjdobs", AT_IMSTKVAL(sym)) + + #sym = stfind (st, "ut") + #call clppset (pp, "ut", AT_IMSTKVAL(sym)) + + sym = stfind (st, "esitealt") + call clppset (pp, "esitealt", AT_IMSTKVAL(sym)) + + sym = stfind (st, "esitetz") + call clppset (pp, "esitetz", AT_IMSTKVAL(sym)) + + #sym = stfind (st, "exposure") + #call clppset (pp, "exposure", AT_IMSTKVAL(sym)) + + sym = stfind (st, "edatamin") + call clppset (pp, "edatamin", AT_IMSTKVAL(sym)) + + sym = stfind (st, "edatamax") + call clppset (pp, "edatamax", AT_IMSTKVAL(sym)) + + sym = stfind (st, "egain") + call clppset (pp, "egain", AT_IMSTKVAL(sym)) + + sym = stfind (st, "erdnoise") + call clppset (pp, "erdnoise", AT_IMSTKVAL(sym)) + + sym = stfind (st, "ewavlen") + call clppset (pp, "ewavlen", AT_IMSTKVAL(sym)) + + sym = stfind (st, "etemp") + call clppset (pp, "etemp", AT_IMSTKVAL(sym)) + + sym = stfind (st, "epress") + call clppset (pp, "epress", AT_IMSTKVAL(sym)) + + sym = stfind (st, "observat") + call clppset (pp, "observat", AT_IMSTKVAL(sym)) + + #sym = stfind (st, "dateobs") + #call clppset (pp, "dateobs", AT_IMSTKVAL(sym)) + + call clcpset (pp) +end diff --git a/noao/astcat/src/attools/atset.x b/noao/astcat/src/attools/atset.x new file mode 100644 index 00000000..882fe13a --- /dev/null +++ b/noao/astcat/src/attools/atset.x @@ -0,0 +1,509 @@ +include "../../lib/astromdef.h" +include "../../lib/astrom.h" +include "../../lib/aimparsdef.h" +include "../../lib/aimpars.h" + +# AT_SETI -- Set the value of an astrom integer parameter. + +procedure at_seti (at, parameter, value) + +pointer at #I the pointer to the main astrom structure +int parameter #I the parameter to be set +int value #I the value of the parameter to be set + +pointer fcp, fsp, wcp +string iestring "AT_SETI: Cannot set undefined integer parameter" + +begin + fcp = AT_PRCENTER(at) + fsp = AT_PFILTER(at) + wcp = AT_PWCS(at) + + switch (parameter) { + + case RCRAUNITS: + if (fcp == NULL) + call error (0, iestring) + else + AT_RCRAUNITS(fcp) = value + case RCDECUNITS: + if (fcp == NULL) + call error (0, iestring) + else + AT_RCDECUNITS(fcp) = value + + + case FREVERSE: + if (fsp == NULL) + call error (0, iestring) + else + AT_FREVERSE(fsp) = value + case FREPLACE: + if (fsp == NULL) + call error (0, iestring) + else + AT_FREPLACE(fsp) = value + case FORAUNITS: + if (fsp == NULL) + call error (0, iestring) + else + AT_FORAUNITS(fsp) = value + case FODECUNITS: + if (fsp == NULL) + call error (0, iestring) + else + AT_FODECUNITS(fsp) = value + + case WRAUNITS: + if (wcp == NULL) + call error (0, iestring) + else + AT_WRAUNITS(wcp) = value + case WDECUNITS: + if (wcp == NULL) + call error (0, iestring) + else + AT_WDECUNITS(wcp) = value + + default: + call error (0, iestring) + } +end + + +# AT_SETP -- Set the value of an astrom pointer parameter. + +procedure at_setp (at, parameter, value) + +pointer at #I the pointer to the main astrom structure +int parameter #I the parameter to be set +pointer value #I the value of the parameter to be set + +pointer fcp, wcp, ipp +string pestring "AT_SETP: Cannot set undefined pointer parameter" + +begin + fcp = AT_PRCENTER(at) + wcp = AT_PWCS(at) + ipp = AT_PIMPARS(at) + + switch (parameter) { + case PIO: + AT_PIO(at) = value + case PRCENTER: + AT_PRCENTER(at) = value + case PFILTER: + AT_PFILTER(at) = value + case PWCS: + AT_PWCS(at) = value + case PIMPARS: + AT_PIMPARS(at) = value + + #case RCCC: + #AT_RCCC(fcp) = value + case RCST: + if (fcp == NULL) + call error (0, pestring) + else + AT_RCST(fcp) = value + + case WCST: + if (wcp == NULL) + call error (0, pestring) + else + AT_WCST(wcp) = value + + case IMST: + if (ipp == NULL) + call error (0, pestring) + else + AT_IMST(ipp) = value + + default: + call error (0, pestring) + } +end + + +# AT_SETR -- Set the value of an astrom real parameter. + +procedure at_setr (at, parameter, value) + +pointer at #I the pointer to the main astrom structure +int parameter #I the parameter to be set +real value #I the value of the parameter to be set + +pointer fcp, ipp +string restring "AT_SETR: Cannot set undefined real parameter" + +begin + fcp = AT_PRCENTER(at) + ipp = AT_PIMPARS(at) + + switch (parameter) { + + case ESITEALT: + if (ipp == NULL) + call error (0, restring) + else + AT_ESITEALT(ipp) = value + case ESITETZ: + if (ipp == NULL) + call error (0, restring) + else + AT_ESITETZ(ipp) = value + case EDATAMIN: + if (ipp == NULL) + call error (0, restring) + else + AT_EDATAMIN(ipp) = value + case EDATAMAX: + if (ipp == NULL) + call error (0, restring) + else + AT_EDATAMAX(ipp) = value + case EGAIN: + if (ipp == NULL) + call error (0, restring) + else + AT_EGAIN(ipp) = value + case ERDNOISE: + if (ipp == NULL) + call error (0, restring) + else + AT_ERDNOISE(ipp) = value + case EWAVLEN: + if (ipp == NULL) + call error (0, restring) + else + AT_EWAVLEN(ipp) = value + case ETEMP: + if (ipp == NULL) + call error (0, restring) + else + AT_ETEMP(ipp) = value + case EPRESS: + if (ipp == NULL) + call error (0, restring) + else + AT_EPRESS(ipp) = value + + default: + call error (0, restring) + } +end + + +# AT_SETD -- Set the value of an astrom double parameter. + +procedure at_setd (at, parameter, value) + +pointer at #I the pointer to the main astrom structure +int parameter #I the parameter to be set +double value #I the value of the parameter to be set + +pointer fcp, wcp, ipp +string destring "AT_SETD: Cannot set undefined double parameter" + +begin + fcp = AT_PRCENTER(at) + wcp = AT_PWCS(at) + ipp = AT_PIMPARS(at) + + switch (parameter) { + + case RCRA: + if (fcp == NULL) + call error (0, destring) + else + AT_RCRA(fcp) = value + case RCDEC: + if (fcp == NULL) + call error (0, destring) + else + AT_RCDEC(fcp) = value + case RCRAWIDTH: + if (fcp == NULL) + call error (0, destring) + else + AT_RCRAWIDTH(fcp) = value + case RCDECWIDTH: + if (fcp == NULL) + call error (0, destring) + else + AT_RCDECWIDTH(fcp) = value + + case WXREF: + if (wcp == NULL) + call error (0, destring) + else + AT_WXREF(wcp) = value + case WYREF: + if (wcp == NULL) + call error (0, destring) + else + AT_WYREF(wcp) = value + case WXMAG: + if (wcp == NULL) + call error (0, destring) + else + AT_WXMAG(wcp) = value + case WYMAG: + if (wcp == NULL) + call error (0, destring) + else + AT_WYMAG(wcp) = value + case WXROT: + if (wcp == NULL) + call error (0, destring) + else + AT_WXROT(wcp) = value + case WYROT: + if (wcp == NULL) + call error (0, destring) + else + AT_WYROT(wcp) = value + case WRAREF: + if (wcp == NULL) + call error (0, destring) + else + AT_WRAREF(wcp) = value + case WDECREF: + if (wcp == NULL) + call error (0, destring) + else + AT_WDECREF(wcp) = value + + case ESITELNG: + if (ipp == NULL) + call error (0, destring) + else + AT_ESITELNG(ipp) = value + case ESITELAT: + if (ipp == NULL) + call error (0, destring) + else + AT_ESITELAT(ipp) = value + case EMJDOBS: + if (ipp == NULL) + call error (0, destring) + else + AT_EMJDOBS(ipp) = value + #case UT: + #if (ipp == NULL) + #call error (0, + #"AT_SETD: Cannot set undefined double parameter") + #else + #AT_UT(ipp) = value + + default: + call error (0, destring) + } +end + + +# AT_SETS -- Set the value of an astrom string parameter. + +procedure at_sets (at, parameter, value) + +pointer at #I the pointer to the main astrom structure +int parameter #I the parameter to be set +char value[ARB] #I the value of the parameter to be set + +pointer fcp, iop, fsp, wcp, ipp +string sestring "AT_SETS: Cannot set undefined string parameter" + +begin + iop = AT_PIO(at) + fcp = AT_PRCENTER(at) + fsp = AT_PFILTER(at) + wcp = AT_PWCS(at) + ipp = AT_PIMPARS(at) + + switch (parameter) { + + case CATALOGS: + if (iop == NULL) + call error (0, sestring) + else + call strcpy (value, AT_CATALOGS(iop), SZ_FNAME) + case SURVEYS: + if (iop == NULL) + call error (0, sestring) + else + call strcpy (value, AT_SURVEYS(iop), SZ_FNAME) + case IMAGES: + if (iop == NULL) + call error (0, sestring) + else + call strcpy (value, AT_IMAGES(iop), SZ_FNAME) + case INPUT: + if (iop == NULL) + call error (0, sestring) + else + call strcpy (value, AT_INPUT(iop), SZ_FNAME) + case OUTPUT: + if (iop == NULL) + call error (0, sestring) + else + call strcpy (value, AT_OUTPUT(iop), SZ_FNAME) + case CATNAME: + if (iop == NULL) + call error (0, sestring) + else + call strcpy (value, AT_CATNAME(iop), SZ_FNAME) + case SVNAME: + if (iop == NULL) + call error (0, sestring) + else + call strcpy (value, AT_SVNAME(iop), SZ_FNAME) + case IMNAME: + if (iop == NULL) + call error (0, sestring) + else + call strcpy (value, AT_IMNAME(iop), SZ_FNAME) + case INFNAME: + if (iop == NULL) + call error (0, sestring) + else + call strcpy (value, AT_INFNAME(iop), SZ_FNAME) + case OUTFNAME: + if (iop == NULL) + call error (0, sestring) + else + call strcpy (value, AT_OUTFNAME(iop), SZ_FNAME) + case CATDB: + if (iop == NULL) + call error (0, sestring) + else + call strcpy (value, AT_CATDB(iop), SZ_FNAME) + case IMDB: + if (iop == NULL) + call error (0, sestring) + else + call strcpy (value, AT_IMDB(iop), SZ_FNAME) + + case RCSYSTEM: + if (fcp == NULL) + call error (0, sestring) + else + call strcpy (value, AT_RCSYSTEM(fcp), SZ_FNAME) + case RCSOURCE: + if (fcp == NULL) + call error (0, sestring) + else + call strcpy (value, AT_RCSOURCE(fcp), SZ_FNAME) + + + case FSORT: + if (fsp == NULL) + call error (0, sestring) + else + call strcpy (value, AT_FSORT(fsp), SZ_FNAME) + case FOSYSTEM: + if (fsp == NULL) + call error (0, sestring) + else + call strcpy (value, AT_FOSYSTEM(fsp), SZ_FNAME) + case FIRA: + if (fsp == NULL) + call error (0, sestring) + else + call strcpy (value, AT_FIRA(fsp), SZ_FNAME) + case FIDEC: + if (fsp == NULL) + call error (0, sestring) + else + call strcpy (value, AT_FIDEC(fsp), SZ_FNAME) + case FORAFORMAT: + if (fsp == NULL) + call error (0, sestring) + else + call strcpy (value, AT_FORAFORMAT(fsp), SZ_FNAME) + case FODECFORMAT: + if (fsp == NULL) + call error (0, sestring) + else + call strcpy (value, AT_FODECFORMAT(fsp), SZ_FNAME) + case FIXP: + if (fsp == NULL) + call error (0, sestring) + else + call strcpy (value, AT_FIXP(fsp), SZ_FNAME) + case FIYP: + if (fsp == NULL) + call error (0, sestring) + else + call strcpy (value, AT_FIYP(fsp), SZ_FNAME) + case FIXC: + if (fsp == NULL) + call error (0, sestring) + else + call strcpy (value, AT_FIXC(fsp), SZ_FNAME) + case FIYC: + if (fsp == NULL) + call error (0, sestring) + else + call strcpy (value, AT_FIYC(fsp), SZ_FNAME) + case FOXFORMAT: + if (fsp == NULL) + call error (0, sestring) + else + call strcpy (value, AT_FOXFORMAT(fsp), SZ_FNAME) + case FOYFORMAT: + if (fsp == NULL) + call error (0, sestring) + else + call strcpy (value, AT_FOYFORMAT(fsp), SZ_FNAME) + case FIELDS: + if (fsp == NULL) + call error (0, sestring) + else + call strcpy (value, AT_FIELDS(fsp), SZ_FNAME) + case FEXPR: + if (fsp == NULL) + call error (0, sestring) + else + call strcpy (value, AT_FEXPR(fsp), SZ_FNAME) + case FNAMES: + if (fsp == NULL) + call error (0, sestring) + else + call strcpy (value, AT_FNAMES(fsp), SZ_FNAME) + case FNTYPES: + if (fsp == NULL) + call error (0, sestring) + else + call strcpy (value, AT_FNTYPES(fsp), SZ_FNAME) + case FNUNITS: + if (fsp == NULL) + call error (0, sestring) + else + call strcpy (value, AT_FNUNITS(fsp), SZ_FNAME) + case FNFORMATS: + if (fsp == NULL) + call error (0, sestring) + else + call strcpy (value, AT_FNFORMATS(fsp), SZ_FNAME) + + case WPROJ: + if (wcp == NULL) + call error (0, sestring) + else + call strcpy (value, AT_WPROJ(wcp), SZ_FNAME) + case WSYSTEM: + if (wcp == NULL) + call error (0, sestring) + else + call strcpy (value, AT_WSYSTEM(wcp), SZ_FNAME) + + case OBSERVAT: + if (ipp == NULL) + call error (0, sestring) + else + call strcpy (value, AT_OBSERVAT(ipp), SZ_FNAME) + + default: + call error (0, sestring) + } +end diff --git a/noao/astcat/src/attools/atshow.x b/noao/astcat/src/attools/atshow.x new file mode 100644 index 00000000..e3a9b26b --- /dev/null +++ b/noao/astcat/src/attools/atshow.x @@ -0,0 +1,375 @@ +include "../../lib/astrom.h" +include "../../lib/acatalog.h" +include "../../lib/aimpars.h" + +# AT_IMSHOW -- Print the current default WCS parameters. + +procedure at_imshow (at) + +pointer at #I the astrometry package descriptor + +pointer sp, str1, str2 +double at_statd() +real at_statr() +pointer at_statp() + +begin + if (at_statp(at, PIMPARS) == NULL) + return + + call smark (sp) + call salloc (str1, SZ_FNAME, TY_CHAR) + call salloc (str2, SZ_FNAME, TY_CHAR) + + call printf ("\nDefault Image Data Parameters\n") + call at_stats (at, OBSERVAT, Memc[str1], SZ_FNAME) + call printf (" The observatory id: %s MJD: %0.5f\n") + call pargstr (Memc[str1]) + call pargd (at_statd (at, EMJDOBS)) + call printf ( + " The site longitude and latitude: %0.2h %0.2h (degrees degrees)\n") + call pargd (at_statd(at, ESITELNG)) + call pargd (at_statd(at, ESITELAT)) + call printf ( + " The site altitude and time zone: %0.1f %0.1f (m hours)\n") + call pargr (at_statr(at, ESITEALT)) + call pargr (at_statr(at, ESITETZ)) + call printf ( + " Effective wavelength: %0.2f (microns)\n") + call pargr (at_statr (at, EWAVLEN)) + call printf ( + " Effective tempaerature and pressure: %0.2f %0.2f (K mbars)\n") + call pargr (at_statr (at, ETEMP)) + call pargr (at_statr (at, EPRESS)) + call printf ( + " Effective gain and readout noise: %0.2f %0.2f (e-/ADU e-)\n") + call pargr (at_statr (at, EGAIN)) + call pargr (at_statr (at, ERDNOISE)) + call printf ( + " Low and high good data limits: %0.2f %0.2f (ADU ADU)\n") + call pargr (at_statr (at, EDATAMIN)) + call pargr (at_statr (at, EDATAMAX)) + + call sfree (sp) +end + + +# AT_WCSHOW -- Print the current default WCS parameters. + +procedure at_wcshow (at) + +pointer at #I the astrometry package descriptor + +pointer sp, str1, str2 +int ival +double at_statd() +pointer at_statp() +int at_stati(), at_wrdstr() + +begin + if (at_statp(at, PWCS) == NULL) + return + + call smark (sp) + call salloc (str1, SZ_FNAME, TY_CHAR) + call salloc (str2, SZ_FNAME, TY_CHAR) + + call printf ("\nDefault WCS Parameters\n") + call at_stats (at, WPROJ, Memc[str1], SZ_FNAME) + call printf (" Sky projection geometry: %s\n") + call pargstr (Memc[str1]) + ival = at_stati (at, WRAUNITS) + if (ival <= 0) + #Memc[str1] = EOS + call strcpy ("default", Memc[str1], SZ_FNAME) + else if (at_wrdstr (ival, Memc[str1], SZ_FNAME, AT_RA_UNITS) <= 0) + #Memc[str1] = EOS + call strcpy ("default", Memc[str1], SZ_FNAME) + ival = at_stati (at, WDECUNITS) + if (ival <= 0) + #Memc[str2] = EOS + call strcpy ("default", Memc[str2], SZ_FNAME) + else if (at_wrdstr (ival, Memc[str2], SZ_FNAME, AT_DEC_UNITS) <= 0) + #Memc[str2] = EOS + call strcpy ("default", Memc[str2], SZ_FNAME) + call printf (" Reference point: %0.3h %0.2h (%s %s)\n") + call pargd (at_statd(at, WRAREF)) + call pargd (at_statd(at, WDECREF)) + call pargstr (Memc[str1]) + call pargstr (Memc[str2]) + call printf (" Reference point: %0.3f %0.3f (pixels pixels)\n") + call pargd (at_statd(at, WXREF)) + call pargd (at_statd(at, WYREF)) + call printf ( + " X and Y scale: %0.3f %0.3f (arcsec/pixel arsec/pixel)\n") + call pargd (at_statd(at, WXMAG)) + call pargd (at_statd(at, WYMAG)) + call printf ( + " X and Y axis rotation: %0.3f %0.3f (degrees degrees)\n") + call pargd (at_statd(at, WXROT)) + call pargd (at_statd(at, WYROT)) + call at_stats (at, WSYSTEM, Memc[str1], SZ_FNAME) + call printf (" System: %s\n") + call pargstr (Memc[str1]) + + call sfree (sp) +end + + +# AT_IOSHOW -- Print the current i/o parameters. + +procedure at_ioshow (at) + +pointer at #I the astrometry package descriptor + +pointer sp, str1, str2 +pointer at_statp() + +begin + if (at_statp(at, PIO) == NULL) + return + + call smark (sp) + call salloc (str1, SZ_FNAME, TY_CHAR) + call salloc (str2, SZ_FNAME, TY_CHAR) + + call printf ("\nI/O Parameters\n") + + call at_stats (at, CATDB, Memc[str1], SZ_FNAME) + call printf (" catdb = %s\n") + call pargstr (Memc[str1]) + call at_stats (at, CATALOGS, Memc[str1], SZ_FNAME) + call at_stats (at, CATNAME, Memc[str2], SZ_FNAME) + call printf (" catalog = %s catname = %s\n") + call pargstr (Memc[str1]) + call pargstr (Memc[str2]) + + call at_stats (at, IMDB, Memc[str1], SZ_FNAME) + call printf (" imdb = %s\n") + call pargstr (Memc[str1]) + call at_stats (at, SURVEYS, Memc[str1], SZ_FNAME) + call at_stats (at, SVNAME, Memc[str2], SZ_FNAME) + call printf (" survey = %s svname = %s\n") + call pargstr (Memc[str1]) + call pargstr (Memc[str2]) + + call at_stats (at, IMAGES, Memc[str1], SZ_FNAME) + call at_stats (at, IMNAME, Memc[str2], SZ_FNAME) + call printf (" images = %s imname = %s\n") + call pargstr (Memc[str1]) + call pargstr (Memc[str2]) + + call at_stats (at, INPUT, Memc[str1], SZ_FNAME) + call at_stats (at, INFNAME, Memc[str2], SZ_FNAME) + call printf (" input = %s infname = %s\n") + call pargstr (Memc[str1]) + call pargstr (Memc[str2]) + + call at_stats (at, OUTPUT, Memc[str1], SZ_FNAME) + call at_stats (at, OUTFNAME, Memc[str2], SZ_FNAME) + call printf (" output = %s outfname = %s\n") + call pargstr (Memc[str1]) + call pargstr (Memc[str2]) + + call sfree (sp) +end + + +# AT_RCSHOW -- Print the current field center parameters. + +procedure at_rcshow (at) + +pointer at #I the astrometry package descriptor + +pointer sp, str1, str2 +int ival +double at_statd() +pointer at_statp() +int at_wrdstr(), at_stati() + +begin + if (at_statp(at, PRCENTER) == NULL) + return + + call smark (sp) + call salloc (str1, SZ_FNAME, TY_CHAR) + call salloc (str2, SZ_FNAME, TY_CHAR) + + call printf ("\nField Center Parameters\n") + call at_stats (at, RCSOURCE, Memc[str1], SZ_FNAME) + call at_stats (at, RCSYSTEM, Memc[str2], SZ_FNAME) + call printf (" rcsource = %s rcsystem = %s\n") + call pargstr (Memc[str1]) + call pargstr (Memc[str2]) + + call printf (" rcra = %h rcdec = %h\n") + call pargd (at_statd (at, RCRA)) + call pargd (at_statd (at, RCDEC)) + call printf (" rrawidth = %0.2f rdecwidth = %0.2f\n") + call pargd (at_statd (at, RCRAWIDTH)) + call pargd (at_statd (at, RCDECWIDTH)) + + ival = at_stati (at, RCRAUNITS) + if (ival <= 0) + #Memc[str1] = EOS + call strcpy ("default", Memc[str1], SZ_FNAME) + else if (at_wrdstr (ival, Memc[str1], SZ_FNAME, AT_RA_UNITS) <= 0) + #Memc[str1] = EOS + call strcpy ("default", Memc[str1], SZ_FNAME) + ival = at_stati (at, RCDECUNITS) + if (ival <= 0) + #Memc[str2] = EOS + call strcpy ("default", Memc[str2], SZ_FNAME) + else if (at_wrdstr (ival, Memc[str2], SZ_FNAME, AT_DEC_UNITS) <= 0) + #Memc[str2] = EOS + call strcpy ("default", Memc[str2], SZ_FNAME) + call printf (" rcraunits = %s rcdecunits = %s\n") + call pargstr (Memc[str1]) + call pargstr (Memc[str2]) + + call printf ("\n") + + call sfree (sp) +end + + +# AT_FSSHOW -- Print the current filtering parameters. + +procedure at_fsshow (at) + +pointer at #I the astrometry package descriptor + +pointer sp, str1, str2 +int ival +pointer at_statp() +int at_stati(), at_wrdstr() +bool itob() + +begin + if (at_statp(at, PFILTER) == NULL) + return + + call smark (sp) + call salloc (str1, SZ_FNAME, TY_CHAR) + call salloc (str2, SZ_FNAME, TY_CHAR) + + call printf ("\nRecord Filtering Parameters\n") + call at_stats (at, FIELDS, Memc[str1], SZ_FNAME) + call at_stats (at, FEXPR, Memc[str2], SZ_FNAME) + call printf (" fields = %s fexpr = %s\n") + call pargstr (Memc[str1]) + call pargstr (Memc[str2]) + call at_stats (at, FNAMES, Memc[str1], SZ_FNAME) + call at_stats (at, FNTYPES, Memc[str2], SZ_FNAME) + call printf (" fnames = %s fntypes = %s\n") + call pargstr (Memc[str1]) + call pargstr (Memc[str2]) + call at_stats (at, FNUNITS, Memc[str1], SZ_FNAME) + call at_stats (at, FNFORMATS, Memc[str2], SZ_FNAME) + call printf (" fnunits = %s fnformats = %s\n") + call pargstr (Memc[str1]) + call pargstr (Memc[str2]) + + call at_stats (at, FSORT, Memc[str1], SZ_FNAME) + call printf (" fsort = %s freverse = %b\n") + call pargstr (Memc[str1]) + call pargb (itob(at_stati(at, FREVERSE))) + + call at_stats (at, FOSYSTEM, Memc[str1], SZ_FNAME) + call printf (" freplace = %b fosystem = %s\n") + call pargb (itob(at_stati(at, FREPLACE))) + call pargstr (Memc[str1]) + call at_stats (at, FIRA, Memc[str1], SZ_FNAME) + call at_stats (at, FIDEC, Memc[str2], SZ_FNAME) + call printf (" fira = %s fidec = %s\n") + call pargstr (Memc[str1]) + call pargstr (Memc[str2]) + + ival = at_stati (at, FORAUNITS) + if (ival <= 0) + Memc[str1] = EOS + else if (at_wrdstr (ival, Memc[str1], SZ_FNAME, AT_RA_UNITS) <= 0) + Memc[str1] = EOS + ival = at_stati (at, FODECUNITS) + if (ival <= 0) + Memc[str2] = EOS + else if (at_wrdstr (ival, Memc[str2], SZ_FNAME, AT_DEC_UNITS) <= 0) + Memc[str2] = EOS + call printf (" foraunits = %s fodecunits = %s\n") + call pargstr (Memc[str1]) + call pargstr (Memc[str2]) + call at_stats (at, FORAFORMAT, Memc[str1], SZ_FNAME) + call at_stats (at, FODECFORMAT, Memc[str2], SZ_FNAME) + call printf (" foraformat = %s fodecformat = %s\n") + call pargstr (Memc[str1]) + call pargstr (Memc[str2]) + + call at_stats (at, FIXP, Memc[str1], SZ_FNAME) + call at_stats (at, FIYP, Memc[str2], SZ_FNAME) + call printf (" fixp = %s fiyp = %s\n") + call pargstr (Memc[str1]) + call pargstr (Memc[str2]) + call at_stats (at, FIXC, Memc[str1], SZ_FNAME) + call at_stats (at, FIYC, Memc[str2], SZ_FNAME) + call printf (" fixc = %s fiyc = %s\n") + call pargstr (Memc[str1]) + call pargstr (Memc[str2]) + call at_stats (at, FOXFORMAT, Memc[str1], SZ_FNAME) + call at_stats (at, FOYFORMAT, Memc[str2], SZ_FNAME) + call printf (" foxformat = %s foyformat = %s\n") + call pargstr (Memc[str1]) + call pargstr (Memc[str2]) + + call printf ("\n") + + call sfree (sp) +end + + +# AT_STSHOW -- Dump the contents of the field center symbol table + +procedure at_stshow (at) + +pointer at #I the astrometry package descriptor + +pointer st, symlist, symbol +int i, nfields +pointer at_statp(), sthead(), stnext() +int stnsymbols() + +begin + if (at_statp(at, PRCENTER) == NULL) + return + + st = at_statp(at, RCST) + if (st == NULL) + return + + nfields = stnsymbols (st, 0) + if (nfields <= 0) + return + + call malloc (symlist, nfields, TY_INT) + symbol = sthead (st) + do i = 1, nfields { + Memi[symlist+i-1] = symbol + symbol = stnext (st, symbol) + } + + do i = nfields, 1, -1 { + symbol = Memi[symlist+i-1] + call printf ("%s %s\n") + call pargstr (AT_RCSTSOURCE(symbol)) + call pargstr (AT_RCSTNAME(symbol)) + call printf (" %h %h %8.3f %8.3f %d %d %s\n") + call pargd (AT_RCSTRA(symbol)) + call pargd (AT_RCSTDEC(symbol)) + call pargd (AT_RCSTRAWIDTH(symbol)) + call pargd (AT_RCSTDECWIDTH(symbol)) + call pargi (AT_RCSTRAUNITS(symbol)) + call pargi (AT_RCSTDECUNITS(symbol)) + call pargstr (AT_RCSTSYSTEM(symbol)) + } + + call mfree (symlist, TY_INT) +end diff --git a/noao/astcat/src/attools/atsort.x b/noao/astcat/src/attools/atsort.x new file mode 100644 index 00000000..315e6d16 --- /dev/null +++ b/noao/astcat/src/attools/atsort.x @@ -0,0 +1,76 @@ +define LOGPTR 32 +define swap {temp=$1;$1=$2;$2=temp} + +# AT_SSQUICK -- Quicksort for text data. NOTE -- This algorithm is quadratic in +# the worst case, i.e., when the data is already sorted. A random method of +# selecting the pivot should be used to improve the behaviour on sorted arrays. + +procedure at_ssquick (linbuf, linptr, index, nlines) + +char linbuf[ARB] #I the input string buffer +int linptr[ARB] #U the indices of strings in buffer +int index[ARB] #O the output sort index +int nlines #I the number of strings + +int i, j, k, temp, lv[LOGPTR], p, pivlin, uv[LOGPTR] +int strncmp() + +begin + lv[1] = 1 + uv[1] = nlines + p = 1 + + do i = 1, nlines + index[i] = i + + while (p > 0) { + if (lv[p] >= uv[p]) # only one elem in this subset + p = p - 1 # pop stack + else { + # Dummy loop to trigger optimizer. + do p = p, ARB { + i = lv[p] - 1 + j = uv[p] + + # Select pivot element at midpoint of interval to avoid + # quadratic behavior on a sorted list. + + k = (lv[p] + uv[p]) / 2 + swap (linptr[j], linptr[k]) + swap (index[j], index[k]) + pivlin = linptr[j] + while (i < j) { + for (i=i+1; strncmp (linbuf, linptr[i], pivlin) < 0; + i=i+1) + ; + for (j=j-1; j > i; j=j-1) + if (strncmp (linbuf, linptr[j], pivlin) <= 0) + break + if (i < j) { # out of order pair + swap (linptr[i], linptr[j]) + swap (index[i], index[j]) + } + + } + + j = uv[p] # move pivot to position i + swap (linptr[i], linptr[j]) + swap (index[i], index[j]) + + if (i-lv[p] < uv[p] - i) { # stack so shorter done first + lv[p+1] = lv[p] + uv[p+1] = i - 1 + lv[p] = i + 1 + } else { + lv[p+1] = i + 1 + uv[p+1] = uv[p] + uv[p] = i - 1 + } + + break + } + + p = p + 1 # push onto stack + } + } +end diff --git a/noao/astcat/src/attools/atstat.x b/noao/astcat/src/attools/atstat.x new file mode 100644 index 00000000..7deb2e87 --- /dev/null +++ b/noao/astcat/src/attools/atstat.x @@ -0,0 +1,506 @@ +include "../../lib/astromdef.h" +include "../../lib/astrom.h" +include "../../lib/aimparsdef.h" +include "../../lib/aimpars.h" + + +# AT_STATI -- Get the value of an astrom integer parameter. + +int procedure at_stati (at, parameter) + +pointer at #I the pointer to the main astrom structure +int parameter #I the parameter to be set + +pointer fcp, fsp, wcp +string iestring "T_STATI: Cannot fetch undefined integer parameter" + +begin + fcp = AT_PRCENTER(at) + fsp = AT_PFILTER(at) + wcp = AT_PWCS(at) + + switch (parameter) { + + case RCRAUNITS: + if (fcp == NULL) + call error (0, iestring) + else + return (AT_RCRAUNITS(fcp)) + case RCDECUNITS: + if (fcp == NULL) + call error (0, iestring) + else + return (AT_RCDECUNITS(fcp)) + + case FREVERSE: + if (fsp == NULL) + call error (0, iestring) + else + return (AT_FREVERSE(fsp)) + case FREPLACE: + if (fsp == NULL) + call error (0, iestring) + else + return (AT_FREPLACE(fsp)) + case FORAUNITS: + if (fsp == NULL) + call error (0, iestring) + else + return (AT_FORAUNITS(fsp)) + case FODECUNITS: + if (fsp == NULL) + call error (0, iestring) + else + return (AT_FODECUNITS(fsp)) + + case WRAUNITS: + if (wcp == NULL) + call error (0, iestring) + else + return (AT_WRAUNITS(wcp)) + case WDECUNITS: + if (wcp == NULL) + call error (0, iestring) + else + return (AT_WDECUNITS(wcp)) + + default: + call error (0, "AT_STATI: Cannot fetch unknown integer parameter") + } +end + + +# AT_STATP -- Get the value of an astrom pointer parameter. + +pointer procedure at_statp (at, parameter) + +pointer at #I the pointer to the main astrom structure +int parameter #I the parameter to be set + +pointer fcp, fsp, wcp, ipp +string pestring "AT_STATP: Cannot fetch undefined pointer parameter" + +begin + fcp = AT_PRCENTER(at) + fsp = AT_PFILTER(at) + wcp = AT_PWCS(at) + ipp = AT_PIMPARS(at) + + switch (parameter) { + + case PIO: + return (AT_PIO(at)) + case PRCENTER: + return (AT_PRCENTER(at)) + case PFILTER: + return (AT_PFILTER(at)) + case PWCS: + return (AT_PWCS(at)) + case PIMPARS: + return (AT_PIMPARS(at)) + + #case RCCC: + #return (AT_RCCC(fcp)) + case RCST: + if (fcp == NULL) + call error (0, pestring) + else + return (AT_RCST(fcp)) + + case WCST: + if (wcp == NULL) + call error (0, pestring) + else + return (AT_WCST(wcp)) + + case IMST: + if (ipp == NULL) + call error (0, pestring) + else + return (AT_IMST(ipp)) + + default: + call error (0, pestring) + } +end + + +# AT_STATR -- Get the value of an astrom real parameter. + +real procedure at_statr (at, parameter) + +pointer at #I the pointer to the main astrom structure +int parameter #I the parameter to be set + +pointer fcp, ipp +string restring "AT_STATR: Cannot fetch undefined real parameter" + +begin + fcp = AT_PRCENTER(at) + ipp = AT_PIMPARS(at) + + switch (parameter) { + + case ESITEALT: + if (ipp == NULL) + call error (0, restring) + else + return (AT_ESITEALT(ipp)) + case ESITETZ: + if (ipp == NULL) + call error (0, restring) + else + return (AT_ESITETZ(ipp)) + #case EXPOSURE: + #if (ipp == NULL) + #call error (0, + #"AT_STATR: Cannot fetch undefined real parameter") + #else + #return (AT_EXPOSURE(ipp)) + case EDATAMIN: + if (ipp == NULL) + call error (0, restring) + else + return (AT_EDATAMIN(ipp)) + case EDATAMAX: + if (ipp == NULL) + call error (0, restring) + else + return (AT_EDATAMAX(ipp)) + case EGAIN: + if (ipp == NULL) + call error (0, restring) + else + return (AT_EGAIN(ipp)) + case ERDNOISE: + if (ipp == NULL) + call error (0, restring) + else + return (AT_ERDNOISE(ipp)) + case EWAVLEN: + if (ipp == NULL) + call error (0, restring) + else + return (AT_EWAVLEN(ipp)) + case ETEMP: + if (ipp == NULL) + call error (0, restring) + else + return (AT_ETEMP(ipp)) + case EPRESS: + if (ipp == NULL) + call error (0, restring) + else + return (AT_EPRESS(ipp)) + + default: + call error (0, restring) + } +end + + +# AT_STATD -- Get the value of an astrom double parameter. + +double procedure at_statd (at, parameter) + +pointer at #I the pointer to the main astrom structure +int parameter #I the parameter to be set + +pointer fcp, wcp, ipp +string destring "AT_STATD: Cannot fetch undefined double parameter" + +begin + fcp = AT_PRCENTER(at) + wcp = AT_PWCS(at) + ipp = AT_PIMPARS(at) + + switch (parameter) { + + case RCRA: + if (fcp == NULL) + call error (0, destring) + else + return (AT_RCRA(fcp)) + case RCDEC: + if (fcp == NULL) + call error (0, destring) + else + return (AT_RCDEC(fcp)) + case RCRAWIDTH: + if (fcp == NULL) + call error (0, destring) + else + return (AT_RCRAWIDTH(fcp)) + case RCDECWIDTH: + if (fcp == NULL) + call error (0, destring) + else + return (AT_RCDECWIDTH(fcp)) + + case WXREF: + if (wcp == NULL) + call error (0, destring) + else + return (AT_WXREF(wcp)) + case WYREF: + if (wcp == NULL) + call error (0, destring) + else + return (AT_WYREF(wcp)) + case WXMAG: + if (wcp == NULL) + call error (0, destring) + else + return (AT_WXMAG(wcp)) + case WYMAG: + if (wcp == NULL) + call error (0, destring) + else + return (AT_WXMAG(wcp)) + case WXROT: + if (wcp == NULL) + call error (0, destring) + else + return (AT_WXROT(wcp)) + case WYROT: + if (wcp == NULL) + call error (0, destring) + else + return (AT_WYROT(wcp)) + case WRAREF: + if (wcp == NULL) + call error (0, destring) + else + return (AT_WRAREF(wcp)) + case WDECREF: + if (wcp == NULL) + call error (0, destring) + else + return (AT_WDECREF(wcp)) + + case ESITELNG: + if (ipp == NULL) + call error (0, destring) + else + return (AT_ESITELNG(ipp)) + case ESITELAT: + if (ipp == NULL) + call error (0, destring) + else + return (AT_ESITELAT(ipp)) + case EMJDOBS: + if (ipp == NULL) + call error (0, destring) + else + return (AT_EMJDOBS(ipp)) + + default: + call error (0, destring) + } +end + + +# AT_STATS -- Get the value of an astrom string parameter. + +procedure at_stats (at, parameter, value, maxch) + +pointer at #I the pointer to the main astrom structure +int parameter #I the parameter to be set +char value[ARB] #O the value of the parameter to be set +int maxch #I the maximum number of characters + +pointer fcp, iop, fsp, wcp, ipp +string sestring "AT_STATS: Cannot fetch undefined string parameter" + +begin + iop = AT_PIO(at) + fcp = AT_PRCENTER(at) + fsp = AT_PFILTER(at) + wcp = AT_PWCS(at) + ipp = AT_PIMPARS(at) + + switch (parameter) { + + case CATALOGS: + if (iop == NULL) + call error (0, sestring) + else + call strcpy (AT_CATALOGS(iop), value, maxch) + case SURVEYS: + if (iop == NULL) + call error (0, sestring) + else + call strcpy (AT_SURVEYS(iop), value, maxch) + case IMAGES: + if (iop == NULL) + call error (0, sestring) + else + call strcpy (AT_IMAGES(iop), value, maxch) + case INPUT: + if (iop == NULL) + call error (0, sestring) + else + call strcpy (AT_INPUT(iop), value, maxch) + case OUTPUT: + if (iop == NULL) + call error (0, sestring) + else + call strcpy (AT_OUTPUT(iop), value, maxch) + case CATNAME: + if (iop == NULL) + call error (0, sestring) + else + call strcpy (AT_CATNAME(iop), value, maxch) + case SVNAME: + if (iop == NULL) + call error (0, sestring) + else + call strcpy (AT_SVNAME(iop), value, maxch) + case IMNAME: + if (iop == NULL) + call error (0, sestring) + else + call strcpy (AT_IMNAME(iop), value, maxch) + case INFNAME: + if (iop == NULL) + call error (0, sestring) + else + call strcpy (AT_INFNAME(iop), value, maxch) + case OUTFNAME: + if (iop == NULL) + call error (0, sestring) + else + call strcpy (AT_OUTFNAME(iop), value, maxch) + case CATDB: + if (iop == NULL) + call error (0, sestring) + else + call strcpy (AT_CATDB(iop), value, maxch) + case IMDB: + if (iop == NULL) + call error (0, sestring) + else + call strcpy (AT_IMDB(iop), value, maxch) + + case RCSYSTEM: + if (fcp == NULL) + call error (0, sestring) + else + call strcpy (AT_RCSYSTEM(fcp), value, maxch) + case RCSOURCE: + if (fcp == NULL) + call error (0, sestring) + else + call strcpy (AT_RCSOURCE(fcp), value, maxch) + + case FSORT: + if (fsp == NULL) + call error (0, sestring) + else + call strcpy (AT_FSORT(fsp), value, maxch) + case FOSYSTEM: + if (fsp == NULL) + call error (0, sestring) + else + call strcpy (AT_FOSYSTEM(fsp), value, maxch) + case FIRA: + if (fsp == NULL) + call error (0, sestring) + else + call strcpy (AT_FIRA(fsp), value, maxch) + case FIDEC: + if (fsp == NULL) + call error (0, sestring) + else + call strcpy (AT_FIDEC(fsp), value, maxch) + case FORAFORMAT: + if (fsp == NULL) + call error (0, sestring) + else + call strcpy (AT_FORAFORMAT(fsp), value, maxch) + case FODECFORMAT: + if (fsp == NULL) + call error (0, sestring) + else + call strcpy (AT_FODECFORMAT(fsp), value, maxch) + case FIXP: + if (fsp == NULL) + call error (0, sestring) + else + call strcpy (AT_FIXP(fsp), value, maxch) + case FIYP: + if (fsp == NULL) + call error (0, sestring) + else + call strcpy (AT_FIYP(fsp), value, maxch) + case FIXC: + if (fsp == NULL) + call error (0, sestring) + else + call strcpy (AT_FIXC(fsp), value, maxch) + case FIYC: + if (fsp == NULL) + call error (0, sestring) + else + call strcpy (AT_FIYC(fsp), value, maxch) + case FOXFORMAT: + if (fsp == NULL) + call error (0, sestring) + else + call strcpy (AT_FOXFORMAT(fsp), value, maxch) + case FOYFORMAT: + if (fsp == NULL) + call error (0, sestring) + else + call strcpy (AT_FOYFORMAT(fsp), value, maxch) + case FIELDS: + if (fsp == NULL) + call error (0, sestring) + else + call strcpy (AT_FIELDS(fsp), value, maxch) + case FEXPR: + if (fsp == NULL) + call error (0, sestring) + else + call strcpy (AT_FEXPR(fsp), value, maxch) + case FNAMES: + if (fsp == NULL) + call error (0, sestring) + else + call strcpy (AT_FNAMES(fsp), value, maxch) + case FNTYPES: + if (fsp == NULL) + call error (0, sestring) + else + call strcpy (AT_FNTYPES(fsp), value, maxch) + case FNUNITS: + if (fsp == NULL) + call error (0, sestring) + else + call strcpy (AT_FNUNITS(fsp), value, maxch) + case FNFORMATS: + if (fsp == NULL) + call error (0, sestring) + else + call strcpy (AT_FNFORMATS(fsp), value, maxch) + + case WPROJ: + if (wcp == NULL) + call error (0, sestring) + else + call strcpy (AT_WPROJ(wcp), value, maxch) + case WSYSTEM: + if (wcp == NULL) + call error (0, sestring) + else + call strcpy (AT_WSYSTEM(wcp), value, maxch) + + case OBSERVAT: + if (ipp == NULL) + call error (0, sestring) + else + call strcpy (AT_OBSERVAT(ipp), value, maxch) + default: + call error (0, sestring) + } +end diff --git a/noao/astcat/src/attools/atvectors.x b/noao/astcat/src/attools/atvectors.x new file mode 100644 index 00000000..9d32967b --- /dev/null +++ b/noao/astcat/src/attools/atvectors.x @@ -0,0 +1,66 @@ +define LOGPTR 20 # log2(maxpts) (1e6) + +# AT_QSORTD -- Vector Quicksort. In this version the index array is sorted. +# The input and output index array may be the same. + +procedure at_qsortd (data, a, b, npix) + +double data[ARB] #I the input data array +int a[ARB] #I the input index array +int b[ARB] #O the output index array +int npix #I the number of pixels + +int i, j, lv[LOGPTR], p, uv[LOGPTR], temp +double pivot + +begin + # Initialize the indices for an inplace sort. + do i = 1, npix + a[i] = i + call amovi (a, b, npix) + + p = 1 + lv[1] = 1 + uv[1] = npix + while (p > 0) { + + # If only one elem in subset pop stack otherwise pivot line. + if (lv[p] >= uv[p]) + p = p - 1 + else { + i = lv[p] - 1 + j = uv[p] + pivot = data[b[j]] + + while (i < j) { + for (i=i+1; data[b[i]] < pivot; i=i+1) + ; + for (j=j-1; j > i; j=j-1) + if (data[b[j]] <= pivot) + break + if (i < j) { # out of order pair + temp = b[j] # interchange elements + b[j] = b[i] + b[i] = temp + } + } + + j = uv[p] # move pivot to position i + temp = b[j] # interchange elements + b[j] = b[i] + b[i] = temp + + if (i-lv[p] < uv[p] - i) { # stack so shorter done first + lv[p+1] = lv[p] + uv[p+1] = i - 1 + lv[p] = i + 1 + } else { + lv[p+1] = i + 1 + uv[p+1] = uv[p] + uv[p] = i - 1 + } + + p = p + 1 # push onto stack + } + } +end diff --git a/noao/astcat/src/attools/atwrdstr.x b/noao/astcat/src/attools/atwrdstr.x new file mode 100644 index 00000000..934570da --- /dev/null +++ b/noao/astcat/src/attools/atwrdstr.x @@ -0,0 +1,57 @@ + +# AT_WRDSTR -- Search a dictionary string for a given string index number. +# This is the opposite function of strdic(), that returns the index for +# given string. The entries in the dictionary string are separated by +# a delimiter character which is the first character of the dictionary +# string. The index of the string found is returned as the function value. +# Otherwise, if there is no string for that index, a zero is returned. + +int procedure at_wrdstr (index, outstr, maxch, dict) + +int index # String index +char outstr[ARB] # Output string as found in dictionary +int maxch # Maximum length of output string +char dict[ARB] # Dictionary string + +int i, len, start, count + +int strlen() + +begin + # Clear output string + outstr[1] = EOS + + # Return if index is not positive. + if (index <= 0) + return (0) + + # Return if the dictionary is not long enough + if (dict[1] == EOS) + return (0) + + # Initialize counters + count = 1 + len = strlen (dict) + + # Search the dictionary string. This loop only terminates + # successfully if the index is found. Otherwise the procedure + # returns with and error condition. + for (start = 2; count < index; start = start + 1) { + if (dict[start] == dict[1]) + count = count + 1 + if (start == len) + return (0) + } + + # Extract the output string from the dictionary + for (i = start; dict[i] != EOS && dict[i] != dict[1]; i = i + 1) { + if (i - start + 1 > maxch) + break + outstr[i - start + 1] = dict[i] + } + + outstr[i - start + 1] = EOS + + # Return index for output string + return (count) +end diff --git a/noao/astcat/src/attools/liststr.gx b/noao/astcat/src/attools/liststr.gx new file mode 100644 index 00000000..3af9b6a3 --- /dev/null +++ b/noao/astcat/src/attools/liststr.gx @@ -0,0 +1,496 @@ +include <ctype.h> + +$for (r) + +# LI_FIND_FIELDS -- This procedure finds the starting column for each field +# in the input line. These column numbers are returned in the array +# field_pos; the number of fields is also returned. + +procedure li_find_fields (linebuf, field_pos, max_fields, nfields) + +char linebuf[ARB] #I the input buffer +int field_pos[max_fields] #O the output field positions +int max_fields #I the maximum number of fields +int nfields #O the computed number of fields + +bool in_field +int ip, field_num + +begin + field_num = 1 + field_pos[1] = 1 + in_field = false + + for (ip=1; linebuf[ip] != '\n' && linebuf[ip] != EOS; ip=ip+1) { + if (! IS_WHITE(linebuf[ip])) + in_field = true + else if (in_field) { + in_field = false + field_num = field_num + 1 + field_pos[field_num] = ip + } + } + + field_pos[field_num+1] = ip + nfields = field_num +end + + +# LI_CAPPEND_LINE -- Fields are copied from the input buffer to the +# output buffer. + +procedure li_cappend_line (inbuf, outbuf, maxch, xoffset, yoffset, + xwidth, ywidth) + +char inbuf[ARB] #I the input string buffer +char outbuf[maxch] #O the output string buffer +int maxch #I the maximum size of the output buffer +int xoffset #I the offset to the x field +int yoffset #I the offset to the y field +int xwidth #I the width of the x field +int ywidth #I the width of the y field + +int ip, op +int gstrcpy() + +begin + # Copy the input buffer into the output buffer minus the newline. + op = 1 + for (ip = 1; ip <= maxch; ip = ip + 1) { + if (inbuf[ip] == '\n' || inbuf[ip] == EOS) + break + outbuf[op] = inbuf[ip] + op = op + 1 + } + + # Add a blank. + if (op <= maxch) { + outbuf[op] = ' ' + op = op + 1 + } + + # Copy the two fields. + op = op + gstrcpy (inbuf[xoffset], outbuf[op], min (maxch - op + 1, + xwidth)) + op = op + gstrcpy (inbuf[yoffset], outbuf[op], min (maxch - op + 1, + ywidth)) + + # Add a newline. + if (op <= maxch) { + outbuf[op] = '\n' + op = op + 1 + } + outbuf[op] = EOS +end + + +define LOGPTR 20 # log2(maxpts) (1e6) + +# LI_PQSORTI -- Vector quicksort an integer array. In this version the index +# array is actually sorted not the data array. The input and output index +# arrays may be the same. + +procedure li_pqsorti (data, a, b, npix) + +int data[ARB] # data array +int a[ARB] # input index array +int b[ARB] # output index array +int npix # number of pixels + +int i, j, lv[LOGPTR], p, uv[LOGPTR], temp, pivot + +begin + # Initialize the indices for an inplace sort. + call amovi (a, b, npix) + + p = 1 + lv[1] = 1 + uv[1] = npix + while (p > 0) { + + + # If only one elem in subset pop stack otherwise pivot line. + if (lv[p] >= uv[p]) + p = p - 1 + else { + i = lv[p] - 1 + j = uv[p] + pivot = data[b[j]] + + while (i < j) { + for (i=i+1; data[b[i]] < pivot; i=i+1) + ; + for (j=j-1; j > i; j=j-1) + if (data[b[j]] <= pivot) + break + if (i < j) { # out of order pair + temp = b[j] # interchange elements + b[j] = b[i] + b[i] = temp + } + } + + j = uv[p] # move pivot to position i + temp = b[j] # interchange elements + b[j] = b[i] + b[i] = temp + + if (i-lv[p] < uv[p] - i) { # stack so shorter done first + lv[p+1] = lv[p] + uv[p+1] = i - 1 + lv[p] = i + 1 + } else { + lv[p+1] = i + 1 + uv[p+1] = uv[p] + uv[p] = i - 1 + } + + p = p + 1 # push onto stack + } + } +end + + +$endfor + +$for (rd) + +# LT_GET_NUM -- The field entry is converted from character to real or double +# in preparation for the transformation. The number of significant +# digits is counted and returned as an argument; the number of chars in +# the number is returned as the function value. + +int procedure li_get_num$t (linebuf, fval, nsdig) + +char linebuf[ARB] #I the input line buffer +PIXEL fval #O the output floating point value +int nsdig #O the number of significant digits + +char ch +int nchar, ip +int cto$t(), stridx() + +begin + ip = 1 + nsdig = 0 + nchar = cto$t (linebuf, ip, fval) + if (nchar == 0 || fval == $INDEF$T) + return (nchar) + + # Skip leading white space. + ip = 1 + repeat { + ch = linebuf[ip] + if (! IS_WHITE(ch)) + break + ip = ip + 1 + } + + # Count signifigant digits + for (; ! IS_WHITE(ch) && ch != '\n' && ch != EOS; ch=linebuf[ip]) { + if (stridx (ch, "eEdD") > 0) + break + if (IS_DIGIT (ch)) + nsdig = nsdig + 1 + ip = ip + 1 + } + + return (nchar) +end + + +# LI_PACK_LINE -- Fields are packed into the outbuf buffer. Transformed +# fields are converted to strings; other fields are copied from +# the input line to output buffer. + +procedure li_pack_line$t (inbuf, outbuf, maxch, field_pos, nfields, + xfield, yfield, xt, yt, xformat, yformat, nsdig_x, nsdig_y, + min_sigdigits) + +char inbuf[ARB] #I the input string buffer +char outbuf[maxch] #O the output string buffer +int maxch #I the maximum size of the output buffer +int field_pos[ARB] #I starting positions for the fields +int nfields #I the number of fields +int xfield #I the field number of the x coordinate column +int yfield #I the field number of the y coordinate column +PIXEL xt #I the transformed x coordinate +PIXEL yt #I the transformed y coordinate +char xformat[ARB] #I the output format for the x column +char yformat[ARB] #I the output format for the y column +int nsdig_x #I the number of significant digits in x +int nsdig_y #I the number of significant digits in y +int min_sigdigits #I the minimum number of significant digits + +int num_field, width, op +pointer sp, field +int gstrcpy() + +begin + call smark (sp) + call salloc (field, SZ_LINE, TY_CHAR) + + # Initialize output pointer. + op = 1 + + do num_field = 1, nfields { + width = field_pos[num_field + 1] - field_pos[num_field] + + if (num_field == xfield) { + call li_format_field$t (xt, Memc[field], maxch, xformat, + nsdig_x, width, min_sigdigits) + } else if (num_field == yfield) { + call li_format_field$t (yt, Memc[field], maxch, yformat, + nsdig_y, width, min_sigdigits) + } else { + # Put "width" characters from inbuf into field + call strcpy (inbuf[field_pos[num_field]], Memc[field], width) + } + + # Fields must be delimited by at least one blank. + if (num_field > 1 && !IS_WHITE (Memc[field])) { + outbuf[op] = ' ' + op = op + 1 + } + + # Copy "field" to output buffer. + op = op + gstrcpy (Memc[field], outbuf[op], maxch) + } + + outbuf[op] = '\n' + outbuf[op+1] = EOS + + call sfree (sp) +end + + +# LI_NPACK_LINE -- Fields are packed into the outbuf buffer. Transformed +# fields are converted to strings; other fields are copied from +# the input line to output buffer. + +procedure li_npack_line$t (inbuf, outbuf, maxch, field_pos, nfields, + vfields, values, nsdigits, nvalues, vformats, sz_fmt, min_sigdigits) + +char inbuf[ARB] #I the input string buffer +char outbuf[maxch] #O the output string buffer +int maxch #I the maximum size of the output buffer +int field_pos[ARB] #I starting positions for the fields +int nfields #I the number of fields +int vfields[ARB] #I the fields to be formatted +PIXEL values[ARB] #I the field values to be formatted +int nsdigits[ARB] #I the number of field significant digits +int nvalues #I the number of fields to be formatted +char vformats[sz_fmt,ARB] #I the field formats +int sz_fmt #I the size of the format string +int min_sigdigits #I the minimum number of significant digits + +bool found +int op, num_field, num_var, width +pointer sp, field +int gstrcpy() + +begin + call smark (sp) + call salloc (field, SZ_LINE, TY_CHAR) + + # Initialize output pointer. + op = 1 + + do num_field = 1, nfields { + width = field_pos[num_field + 1] - field_pos[num_field] + + found = false + do num_var = 1, nvalues { + if (num_field == vfields[num_var]) { + found = true + break + } + } + + if (found) { + call li_format_field$t (values[num_var], Memc[field], + maxch, vformats[1,num_var], nsdigits[num_var], width, + min_sigdigits) + } else { + # Put "width" characters from inbuf into field + call strcpy (inbuf[field_pos[num_field]], Memc[field], width) + } + + # Fields must be delimited by at least one blank. + if (num_field > 1 && !IS_WHITE (Memc[field])) { + outbuf[op] = ' ' + op = op + 1 + } + + # Copy "field" to output buffer. + op = op + gstrcpy (Memc[field], outbuf[op], maxch) + } + + outbuf[op] = '\n' + outbuf[op+1] = EOS + + call sfree (sp) +end + + +# LI_APPEND_LINE -- Fields are appened to the input buffer. Transformed +# fields are converted to strings and added to the end of the input buffer. + +procedure li_append_line$t (inbuf, outbuf, maxch, xt, yt, xformat, yformat, + nsdig_x, nsdig_y, min_sigdigits) + +char inbuf[ARB] #I the input string buffer +char outbuf[maxch] #O the output string buffer +int maxch #I the maximum size of the output buffer +PIXEL xt #I the transformed x coordinate +PIXEL yt #I the transformed y coordinate +char xformat[ARB] #I the output format for the x column +char yformat[ARB] #I the output format for the y column +int nsdig_x #I the number of significant digits in x +int nsdig_y #I the number of significant digits in y +int min_sigdigits #I the minimum number of significant digits + +int ip, op +pointer sp, field +int gstrcpy() + +begin + # Allocate some working space. + call smark (sp) + call salloc (field, SZ_LINE, TY_CHAR) + + # Copy the input buffer into the output buffer minus the newline. + op = 1 + for (ip = 1; ip <= maxch; ip = ip + 1) { + if (inbuf[ip] == '\n' || inbuf[ip] == EOS) + break + outbuf[op] = inbuf[ip] + op = op + 1 + } + + # Add two blanks. + op = op + gstrcpy (" ", outbuf[op], maxch - op + 1) + + # Format and add the the two extra fields with a blank between. + call li_format_field$t (xt, Memc[field], SZ_LINE, xformat, + nsdig_x, 0, min_sigdigits) + op = op + gstrcpy (Memc[field], outbuf[op], maxch - op + 1) + if (op <= maxch) { + outbuf[op] = ' ' + op = op + 1 + } + call li_format_field$t (yt, Memc[field], SZ_LINE, yformat, + nsdig_y, 0, min_sigdigits) + op = op + gstrcpy (Memc[field], outbuf[op], maxch - op + 1) + + # Add a newline. + if (op <= maxch) { + outbuf[op] = '\n' + op = op + 1 + } + outbuf[op] = EOS + + call sfree (sp) +end + + +# LI_NAPPEND_LINE -- Fields are appened to the input buffer. Transformed +# fields are converted to strings and added to the end of the input buffer. + +procedure li_nappend_line$t (inbuf, outbuf, maxch, field_pos, nfields, + vfields, values, nsdigits, nvalues, vformats, sz_fmt, min_sigdigits) + +char inbuf[ARB] #I the input string buffer +char outbuf[maxch] #O the output string buffer +int maxch #I the maximum size of the output buffer +int field_pos[ARB] #I starting positions for the fields +int nfields #I the number of fields +int vfields[ARB] #I the fields to be formatted +PIXEL values[ARB] #I the field values to be formatted +int nsdigits[ARB] #I the number of field significant digits +int nvalues #I the number of fields to be formatted +char vformats[sz_fmt,ARB] #I the field formats +int sz_fmt #I the size of the format string +int min_sigdigits #I the minimum number of significant digits + +int num_var, ip, op, index +pointer sp, field, nvfields +int gstrcpy() + +begin + # Allocate some working space. + call smark (sp) + call salloc (field, SZ_LINE, TY_CHAR) + call salloc (nvfields, nvalues, TY_INT) + do num_var = 1, nvalues + Memi[nvfields+num_var-1] = num_var + call li_pqsorti (vfields, Memi[nvfields], Memi[nvfields], nvalues) + + # Copy the input buffer into the output buffer minus the newline. + op = 1 + for (ip = 1; ip <= maxch; ip = ip + 1) { + if (inbuf[ip] == '\n' || inbuf[ip] == EOS) + break + outbuf[op] = inbuf[ip] + op = op + 1 + } + + # Add two blanks. + op = op + gstrcpy (" ", outbuf[op], maxch - op + 1) + + do num_var = 1, nvalues { + index = Memi[nvfields+num_var-1] + call li_format_field$t (values[index], Memc[field], SZ_LINE, + vformats[sz_fmt,index], nsdigits[index], 0, min_sigdigits) + op = op + gstrcpy (Memc[field], outbuf[op], maxch - op + 1) + if (num_var == nvalues) { + if (op <= maxch) { + outbuf[op] = '\n' + op = op + 1 + } + } else { + if (op <= maxch) { + outbuf[op] = ' ' + op = op + 1 + } + } + } + + outbuf[op] = EOS + + call sfree (sp) +end + + +# LI_FORMAT_FIELD -- A transformed coordinate is written into a string +# buffer. The output field is of (at least) the same width and significance +# as the input list entry. + +procedure li_format_field$t (fval, wordbuf, maxch, format, nsdig, width, + min_sigdigits) + +PIXEL fval #I the input value to be formatted +char wordbuf[maxch] #O the output formatted string +int maxch #I the maximum length of the output string +char format[ARB] #I the output format +int nsdig #I the number of sig-digits in current value +int width #I the width of the curent field +int min_sigdigits #I the minimum number of significant digits + +int fdigits, fwidth +begin + if (format[1] == EOS) { + fdigits = max (min_sigdigits, nsdig) + fwidth = max (width, fdigits + 1) + call sprintf (wordbuf, maxch, "%*.*g") + call pargi (fwidth) + call pargi (fdigits) + call parg$t (fval) + } else { + call sprintf (wordbuf, maxch, format) + call parg$t (fval) + } +end + + +$endfor diff --git a/noao/astcat/src/attools/liststr.x b/noao/astcat/src/attools/liststr.x new file mode 100644 index 00000000..05f937a0 --- /dev/null +++ b/noao/astcat/src/attools/liststr.x @@ -0,0 +1,833 @@ +include <ctype.h> + + + +# LI_FIND_FIELDS -- This procedure finds the starting column for each field +# in the input line. These column numbers are returned in the array +# field_pos; the number of fields is also returned. + +procedure li_find_fields (linebuf, field_pos, max_fields, nfields) + +char linebuf[ARB] #I the input buffer +int field_pos[max_fields] #O the output field positions +int max_fields #I the maximum number of fields +int nfields #O the computed number of fields + +bool in_field +int ip, field_num + +begin + field_num = 1 + field_pos[1] = 1 + in_field = false + + for (ip=1; linebuf[ip] != '\n' && linebuf[ip] != EOS; ip=ip+1) { + if (! IS_WHITE(linebuf[ip])) + in_field = true + else if (in_field) { + in_field = false + field_num = field_num + 1 + field_pos[field_num] = ip + } + } + + field_pos[field_num+1] = ip + nfields = field_num +end + + +# LI_CAPPEND_LINE -- Fields are copied from the input buffer to the +# output buffer. + +procedure li_cappend_line (inbuf, outbuf, maxch, xoffset, yoffset, + xwidth, ywidth) + +char inbuf[ARB] #I the input string buffer +char outbuf[maxch] #O the output string buffer +int maxch #I the maximum size of the output buffer +int xoffset #I the offset to the x field +int yoffset #I the offset to the y field +int xwidth #I the width of the x field +int ywidth #I the width of the y field + +int ip, op +int gstrcpy() + +begin + # Copy the input buffer into the output buffer minus the newline. + op = 1 + for (ip = 1; ip <= maxch; ip = ip + 1) { + if (inbuf[ip] == '\n' || inbuf[ip] == EOS) + break + outbuf[op] = inbuf[ip] + op = op + 1 + } + + # Add a blank. + if (op <= maxch) { + outbuf[op] = ' ' + op = op + 1 + } + + # Copy the two fields. + op = op + gstrcpy (inbuf[xoffset], outbuf[op], min (maxch - op + 1, + xwidth)) + op = op + gstrcpy (inbuf[yoffset], outbuf[op], min (maxch - op + 1, + ywidth)) + + # Add a newline. + if (op <= maxch) { + outbuf[op] = '\n' + op = op + 1 + } + outbuf[op] = EOS +end + + +define LOGPTR 20 # log2(maxpts) (1e6) + +# LI_PQSORTI -- Vector quicksort an integer array. In this version the index +# array is actually sorted not the data array. The input and output index +# arrays may be the same. + +procedure li_pqsorti (data, a, b, npix) + +int data[ARB] # data array +int a[ARB] # input index array +int b[ARB] # output index array +int npix # number of pixels + +int i, j, lv[LOGPTR], p, uv[LOGPTR], temp, pivot + +begin + # Initialize the indices for an inplace sort. + call amovi (a, b, npix) + + p = 1 + lv[1] = 1 + uv[1] = npix + while (p > 0) { + + + # If only one elem in subset pop stack otherwise pivot line. + if (lv[p] >= uv[p]) + p = p - 1 + else { + i = lv[p] - 1 + j = uv[p] + pivot = data[b[j]] + + while (i < j) { + for (i=i+1; data[b[i]] < pivot; i=i+1) + ; + for (j=j-1; j > i; j=j-1) + if (data[b[j]] <= pivot) + break + if (i < j) { # out of order pair + temp = b[j] # interchange elements + b[j] = b[i] + b[i] = temp + } + } + + j = uv[p] # move pivot to position i + temp = b[j] # interchange elements + b[j] = b[i] + b[i] = temp + + if (i-lv[p] < uv[p] - i) { # stack so shorter done first + lv[p+1] = lv[p] + uv[p+1] = i - 1 + lv[p] = i + 1 + } else { + lv[p+1] = i + 1 + uv[p+1] = uv[p] + uv[p] = i - 1 + } + + p = p + 1 # push onto stack + } + } +end + + + + + + +# LT_GET_NUM -- The field entry is converted from character to real or double +# in preparation for the transformation. The number of significant +# digits is counted and returned as an argument; the number of chars in +# the number is returned as the function value. + +int procedure li_get_numr (linebuf, fval, nsdig) + +char linebuf[ARB] #I the input line buffer +real fval #O the output floating point value +int nsdig #O the number of significant digits + +char ch +int nchar, ip +int ctor(), stridx() + +begin + ip = 1 + nsdig = 0 + nchar = ctor (linebuf, ip, fval) + if (nchar == 0 || fval == INDEFR) + return (nchar) + + # Skip leading white space. + ip = 1 + repeat { + ch = linebuf[ip] + if (! IS_WHITE(ch)) + break + ip = ip + 1 + } + + # Count signifigant digits + for (; ! IS_WHITE(ch) && ch != '\n' && ch != EOS; ch=linebuf[ip]) { + if (stridx (ch, "eEdD") > 0) + break + if (IS_DIGIT (ch)) + nsdig = nsdig + 1 + ip = ip + 1 + } + + return (nchar) +end + + +# LI_PACK_LINE -- Fields are packed into the outbuf buffer. Transformed +# fields are converted to strings; other fields are copied from +# the input line to output buffer. + +procedure li_pack_liner (inbuf, outbuf, maxch, field_pos, nfields, + xfield, yfield, xt, yt, xformat, yformat, nsdig_x, nsdig_y, + min_sigdigits) + +char inbuf[ARB] #I the input string buffer +char outbuf[maxch] #O the output string buffer +int maxch #I the maximum size of the output buffer +int field_pos[ARB] #I starting positions for the fields +int nfields #I the number of fields +int xfield #I the field number of the x coordinate column +int yfield #I the field number of the y coordinate column +real xt #I the transformed x coordinate +real yt #I the transformed y coordinate +char xformat[ARB] #I the output format for the x column +char yformat[ARB] #I the output format for the y column +int nsdig_x #I the number of significant digits in x +int nsdig_y #I the number of significant digits in y +int min_sigdigits #I the minimum number of significant digits + +int num_field, width, op +pointer sp, field +int gstrcpy() + +begin + call smark (sp) + call salloc (field, SZ_LINE, TY_CHAR) + + # Initialize output pointer. + op = 1 + + do num_field = 1, nfields { + width = field_pos[num_field + 1] - field_pos[num_field] + + if (num_field == xfield) { + call li_format_fieldr (xt, Memc[field], maxch, xformat, + nsdig_x, width, min_sigdigits) + } else if (num_field == yfield) { + call li_format_fieldr (yt, Memc[field], maxch, yformat, + nsdig_y, width, min_sigdigits) + } else { + # Put "width" characters from inbuf into field + call strcpy (inbuf[field_pos[num_field]], Memc[field], width) + } + + # Fields must be delimited by at least one blank. + if (num_field > 1 && !IS_WHITE (Memc[field])) { + outbuf[op] = ' ' + op = op + 1 + } + + # Copy "field" to output buffer. + op = op + gstrcpy (Memc[field], outbuf[op], maxch) + } + + outbuf[op] = '\n' + outbuf[op+1] = EOS + + call sfree (sp) +end + + +# LI_NPACK_LINE -- Fields are packed into the outbuf buffer. Transformed +# fields are converted to strings; other fields are copied from +# the input line to output buffer. + +procedure li_npack_liner (inbuf, outbuf, maxch, field_pos, nfields, + vfields, values, nsdigits, nvalues, vformats, sz_fmt, min_sigdigits) + +char inbuf[ARB] #I the input string buffer +char outbuf[maxch] #O the output string buffer +int maxch #I the maximum size of the output buffer +int field_pos[ARB] #I starting positions for the fields +int nfields #I the number of fields +int vfields[ARB] #I the fields to be formatted +real values[ARB] #I the field values to be formatted +int nsdigits[ARB] #I the number of field significant digits +int nvalues #I the number of fields to be formatted +char vformats[sz_fmt,ARB] #I the field formats +int sz_fmt #I the size of the format string +int min_sigdigits #I the minimum number of significant digits + +bool found +int op, num_field, num_var, width +pointer sp, field +int gstrcpy() + +begin + call smark (sp) + call salloc (field, SZ_LINE, TY_CHAR) + + # Initialize output pointer. + op = 1 + + do num_field = 1, nfields { + width = field_pos[num_field + 1] - field_pos[num_field] + + found = false + do num_var = 1, nvalues { + if (num_field == vfields[num_var]) { + found = true + break + } + } + + if (found) { + call li_format_fieldr (values[num_var], Memc[field], + maxch, vformats[1,num_var], nsdigits[num_var], width, + min_sigdigits) + } else { + # Put "width" characters from inbuf into field + call strcpy (inbuf[field_pos[num_field]], Memc[field], width) + } + + # Fields must be delimited by at least one blank. + if (num_field > 1 && !IS_WHITE (Memc[field])) { + outbuf[op] = ' ' + op = op + 1 + } + + # Copy "field" to output buffer. + op = op + gstrcpy (Memc[field], outbuf[op], maxch) + } + + outbuf[op] = '\n' + outbuf[op+1] = EOS + + call sfree (sp) +end + + +# LI_APPEND_LINE -- Fields are appened to the input buffer. Transformed +# fields are converted to strings and added to the end of the input buffer. + +procedure li_append_liner (inbuf, outbuf, maxch, xt, yt, xformat, yformat, + nsdig_x, nsdig_y, min_sigdigits) + +char inbuf[ARB] #I the input string buffer +char outbuf[maxch] #O the output string buffer +int maxch #I the maximum size of the output buffer +real xt #I the transformed x coordinate +real yt #I the transformed y coordinate +char xformat[ARB] #I the output format for the x column +char yformat[ARB] #I the output format for the y column +int nsdig_x #I the number of significant digits in x +int nsdig_y #I the number of significant digits in y +int min_sigdigits #I the minimum number of significant digits + +int ip, op +pointer sp, field +int gstrcpy() + +begin + # Allocate some working space. + call smark (sp) + call salloc (field, SZ_LINE, TY_CHAR) + + # Copy the input buffer into the output buffer minus the newline. + op = 1 + for (ip = 1; ip <= maxch; ip = ip + 1) { + if (inbuf[ip] == '\n' || inbuf[ip] == EOS) + break + outbuf[op] = inbuf[ip] + op = op + 1 + } + + # Add two blanks. + op = op + gstrcpy (" ", outbuf[op], maxch - op + 1) + + # Format and add the the two extra fields with a blank between. + call li_format_fieldr (xt, Memc[field], SZ_LINE, xformat, + nsdig_x, 0, min_sigdigits) + op = op + gstrcpy (Memc[field], outbuf[op], maxch - op + 1) + if (op <= maxch) { + outbuf[op] = ' ' + op = op + 1 + } + call li_format_fieldr (yt, Memc[field], SZ_LINE, yformat, + nsdig_y, 0, min_sigdigits) + op = op + gstrcpy (Memc[field], outbuf[op], maxch - op + 1) + + # Add a newline. + if (op <= maxch) { + outbuf[op] = '\n' + op = op + 1 + } + outbuf[op] = EOS + + call sfree (sp) +end + + +# LI_NAPPEND_LINE -- Fields are appened to the input buffer. Transformed +# fields are converted to strings and added to the end of the input buffer. + +procedure li_nappend_liner (inbuf, outbuf, maxch, field_pos, nfields, + vfields, values, nsdigits, nvalues, vformats, sz_fmt, min_sigdigits) + +char inbuf[ARB] #I the input string buffer +char outbuf[maxch] #O the output string buffer +int maxch #I the maximum size of the output buffer +int field_pos[ARB] #I starting positions for the fields +int nfields #I the number of fields +int vfields[ARB] #I the fields to be formatted +real values[ARB] #I the field values to be formatted +int nsdigits[ARB] #I the number of field significant digits +int nvalues #I the number of fields to be formatted +char vformats[sz_fmt,ARB] #I the field formats +int sz_fmt #I the size of the format string +int min_sigdigits #I the minimum number of significant digits + +int num_var, ip, op, index +pointer sp, field, nvfields +int gstrcpy() + +begin + # Allocate some working space. + call smark (sp) + call salloc (field, SZ_LINE, TY_CHAR) + call salloc (nvfields, nvalues, TY_INT) + do num_var = 1, nvalues + Memi[nvfields+num_var-1] = num_var + call li_pqsorti (vfields, Memi[nvfields], Memi[nvfields], nvalues) + + # Copy the input buffer into the output buffer minus the newline. + op = 1 + for (ip = 1; ip <= maxch; ip = ip + 1) { + if (inbuf[ip] == '\n' || inbuf[ip] == EOS) + break + outbuf[op] = inbuf[ip] + op = op + 1 + } + + # Add two blanks. + op = op + gstrcpy (" ", outbuf[op], maxch - op + 1) + + do num_var = 1, nvalues { + index = Memi[nvfields+num_var-1] + call li_format_fieldr (values[index], Memc[field], SZ_LINE, + vformats[sz_fmt,index], nsdigits[index], 0, min_sigdigits) + op = op + gstrcpy (Memc[field], outbuf[op], maxch - op + 1) + if (num_var == nvalues) { + if (op <= maxch) { + outbuf[op] = '\n' + op = op + 1 + } + } else { + if (op <= maxch) { + outbuf[op] = ' ' + op = op + 1 + } + } + } + + outbuf[op] = EOS + + call sfree (sp) +end + + +# LI_FORMAT_FIELD -- A transformed coordinate is written into a string +# buffer. The output field is of (at least) the same width and significance +# as the input list entry. + +procedure li_format_fieldr (fval, wordbuf, maxch, format, nsdig, width, + min_sigdigits) + +real fval #I the input value to be formatted +char wordbuf[maxch] #O the output formatted string +int maxch #I the maximum length of the output string +char format[ARB] #I the output format +int nsdig #I the number of sig-digits in current value +int width #I the width of the curent field +int min_sigdigits #I the minimum number of significant digits + +int fdigits, fwidth +begin + if (format[1] == EOS) { + fdigits = max (min_sigdigits, nsdig) + fwidth = max (width, fdigits + 1) + call sprintf (wordbuf, maxch, "%*.*g") + call pargi (fwidth) + call pargi (fdigits) + call pargr (fval) + } else { + call sprintf (wordbuf, maxch, format) + call pargr (fval) + } +end + + + + +# LT_GET_NUM -- The field entry is converted from character to real or double +# in preparation for the transformation. The number of significant +# digits is counted and returned as an argument; the number of chars in +# the number is returned as the function value. + +int procedure li_get_numd (linebuf, fval, nsdig) + +char linebuf[ARB] #I the input line buffer +double fval #O the output floating point value +int nsdig #O the number of significant digits + +char ch +int nchar, ip +int ctod(), stridx() + +begin + ip = 1 + nsdig = 0 + nchar = ctod (linebuf, ip, fval) + if (nchar == 0 || fval == INDEFD) + return (nchar) + + # Skip leading white space. + ip = 1 + repeat { + ch = linebuf[ip] + if (! IS_WHITE(ch)) + break + ip = ip + 1 + } + + # Count signifigant digits + for (; ! IS_WHITE(ch) && ch != '\n' && ch != EOS; ch=linebuf[ip]) { + if (stridx (ch, "eEdD") > 0) + break + if (IS_DIGIT (ch)) + nsdig = nsdig + 1 + ip = ip + 1 + } + + return (nchar) +end + + +# LI_PACK_LINE -- Fields are packed into the outbuf buffer. Transformed +# fields are converted to strings; other fields are copied from +# the input line to output buffer. + +procedure li_pack_lined (inbuf, outbuf, maxch, field_pos, nfields, + xfield, yfield, xt, yt, xformat, yformat, nsdig_x, nsdig_y, + min_sigdigits) + +char inbuf[ARB] #I the input string buffer +char outbuf[maxch] #O the output string buffer +int maxch #I the maximum size of the output buffer +int field_pos[ARB] #I starting positions for the fields +int nfields #I the number of fields +int xfield #I the field number of the x coordinate column +int yfield #I the field number of the y coordinate column +double xt #I the transformed x coordinate +double yt #I the transformed y coordinate +char xformat[ARB] #I the output format for the x column +char yformat[ARB] #I the output format for the y column +int nsdig_x #I the number of significant digits in x +int nsdig_y #I the number of significant digits in y +int min_sigdigits #I the minimum number of significant digits + +int num_field, width, op +pointer sp, field +int gstrcpy() + +begin + call smark (sp) + call salloc (field, SZ_LINE, TY_CHAR) + + # Initialize output pointer. + op = 1 + + do num_field = 1, nfields { + width = field_pos[num_field + 1] - field_pos[num_field] + + if (num_field == xfield) { + call li_format_fieldd (xt, Memc[field], maxch, xformat, + nsdig_x, width, min_sigdigits) + } else if (num_field == yfield) { + call li_format_fieldd (yt, Memc[field], maxch, yformat, + nsdig_y, width, min_sigdigits) + } else { + # Put "width" characters from inbuf into field + call strcpy (inbuf[field_pos[num_field]], Memc[field], width) + } + + # Fields must be delimited by at least one blank. + if (num_field > 1 && !IS_WHITE (Memc[field])) { + outbuf[op] = ' ' + op = op + 1 + } + + # Copy "field" to output buffer. + op = op + gstrcpy (Memc[field], outbuf[op], maxch) + } + + outbuf[op] = '\n' + outbuf[op+1] = EOS + + call sfree (sp) +end + + +# LI_NPACK_LINE -- Fields are packed into the outbuf buffer. Transformed +# fields are converted to strings; other fields are copied from +# the input line to output buffer. + +procedure li_npack_lined (inbuf, outbuf, maxch, field_pos, nfields, + vfields, values, nsdigits, nvalues, vformats, sz_fmt, min_sigdigits) + +char inbuf[ARB] #I the input string buffer +char outbuf[maxch] #O the output string buffer +int maxch #I the maximum size of the output buffer +int field_pos[ARB] #I starting positions for the fields +int nfields #I the number of fields +int vfields[ARB] #I the fields to be formatted +double values[ARB] #I the field values to be formatted +int nsdigits[ARB] #I the number of field significant digits +int nvalues #I the number of fields to be formatted +char vformats[sz_fmt,ARB] #I the field formats +int sz_fmt #I the size of the format string +int min_sigdigits #I the minimum number of significant digits + +bool found +int op, num_field, num_var, width +pointer sp, field +int gstrcpy() + +begin + call smark (sp) + call salloc (field, SZ_LINE, TY_CHAR) + + # Initialize output pointer. + op = 1 + + do num_field = 1, nfields { + width = field_pos[num_field + 1] - field_pos[num_field] + + found = false + do num_var = 1, nvalues { + if (num_field == vfields[num_var]) { + found = true + break + } + } + + if (found) { + call li_format_fieldd (values[num_var], Memc[field], + maxch, vformats[1,num_var], nsdigits[num_var], width, + min_sigdigits) + } else { + # Put "width" characters from inbuf into field + call strcpy (inbuf[field_pos[num_field]], Memc[field], width) + } + + # Fields must be delimited by at least one blank. + if (num_field > 1 && !IS_WHITE (Memc[field])) { + outbuf[op] = ' ' + op = op + 1 + } + + # Copy "field" to output buffer. + op = op + gstrcpy (Memc[field], outbuf[op], maxch) + } + + outbuf[op] = '\n' + outbuf[op+1] = EOS + + call sfree (sp) +end + + +# LI_APPEND_LINE -- Fields are appened to the input buffer. Transformed +# fields are converted to strings and added to the end of the input buffer. + +procedure li_append_lined (inbuf, outbuf, maxch, xt, yt, xformat, yformat, + nsdig_x, nsdig_y, min_sigdigits) + +char inbuf[ARB] #I the input string buffer +char outbuf[maxch] #O the output string buffer +int maxch #I the maximum size of the output buffer +double xt #I the transformed x coordinate +double yt #I the transformed y coordinate +char xformat[ARB] #I the output format for the x column +char yformat[ARB] #I the output format for the y column +int nsdig_x #I the number of significant digits in x +int nsdig_y #I the number of significant digits in y +int min_sigdigits #I the minimum number of significant digits + +int ip, op +pointer sp, field +int gstrcpy() + +begin + # Allocate some working space. + call smark (sp) + call salloc (field, SZ_LINE, TY_CHAR) + + # Copy the input buffer into the output buffer minus the newline. + op = 1 + for (ip = 1; ip <= maxch; ip = ip + 1) { + if (inbuf[ip] == '\n' || inbuf[ip] == EOS) + break + outbuf[op] = inbuf[ip] + op = op + 1 + } + + # Add two blanks. + op = op + gstrcpy (" ", outbuf[op], maxch - op + 1) + + # Format and add the the two extra fields with a blank between. + call li_format_fieldd (xt, Memc[field], SZ_LINE, xformat, + nsdig_x, 0, min_sigdigits) + op = op + gstrcpy (Memc[field], outbuf[op], maxch - op + 1) + if (op <= maxch) { + outbuf[op] = ' ' + op = op + 1 + } + call li_format_fieldd (yt, Memc[field], SZ_LINE, yformat, + nsdig_y, 0, min_sigdigits) + op = op + gstrcpy (Memc[field], outbuf[op], maxch - op + 1) + + # Add a newline. + if (op <= maxch) { + outbuf[op] = '\n' + op = op + 1 + } + outbuf[op] = EOS + + call sfree (sp) +end + + +# LI_NAPPEND_LINE -- Fields are appened to the input buffer. Transformed +# fields are converted to strings and added to the end of the input buffer. + +procedure li_nappend_lined (inbuf, outbuf, maxch, field_pos, nfields, + vfields, values, nsdigits, nvalues, vformats, sz_fmt, min_sigdigits) + +char inbuf[ARB] #I the input string buffer +char outbuf[maxch] #O the output string buffer +int maxch #I the maximum size of the output buffer +int field_pos[ARB] #I starting positions for the fields +int nfields #I the number of fields +int vfields[ARB] #I the fields to be formatted +double values[ARB] #I the field values to be formatted +int nsdigits[ARB] #I the number of field significant digits +int nvalues #I the number of fields to be formatted +char vformats[sz_fmt,ARB] #I the field formats +int sz_fmt #I the size of the format string +int min_sigdigits #I the minimum number of significant digits + +int num_var, ip, op, index +pointer sp, field, nvfields +int gstrcpy() + +begin + # Allocate some working space. + call smark (sp) + call salloc (field, SZ_LINE, TY_CHAR) + call salloc (nvfields, nvalues, TY_INT) + do num_var = 1, nvalues + Memi[nvfields+num_var-1] = num_var + call li_pqsorti (vfields, Memi[nvfields], Memi[nvfields], nvalues) + + # Copy the input buffer into the output buffer minus the newline. + op = 1 + for (ip = 1; ip <= maxch; ip = ip + 1) { + if (inbuf[ip] == '\n' || inbuf[ip] == EOS) + break + outbuf[op] = inbuf[ip] + op = op + 1 + } + + # Add two blanks. + op = op + gstrcpy (" ", outbuf[op], maxch - op + 1) + + do num_var = 1, nvalues { + index = Memi[nvfields+num_var-1] + call li_format_fieldd (values[index], Memc[field], SZ_LINE, + vformats[sz_fmt,index], nsdigits[index], 0, min_sigdigits) + op = op + gstrcpy (Memc[field], outbuf[op], maxch - op + 1) + if (num_var == nvalues) { + if (op <= maxch) { + outbuf[op] = '\n' + op = op + 1 + } + } else { + if (op <= maxch) { + outbuf[op] = ' ' + op = op + 1 + } + } + } + + outbuf[op] = EOS + + call sfree (sp) +end + + +# LI_FORMAT_FIELD -- A transformed coordinate is written into a string +# buffer. The output field is of (at least) the same width and significance +# as the input list entry. + +procedure li_format_fieldd (fval, wordbuf, maxch, format, nsdig, width, + min_sigdigits) + +double fval #I the input value to be formatted +char wordbuf[maxch] #O the output formatted string +int maxch #I the maximum length of the output string +char format[ARB] #I the output format +int nsdig #I the number of sig-digits in current value +int width #I the width of the curent field +int min_sigdigits #I the minimum number of significant digits + +int fdigits, fwidth +begin + if (format[1] == EOS) { + fdigits = max (min_sigdigits, nsdig) + fwidth = max (width, fdigits + 1) + call sprintf (wordbuf, maxch, "%*.*g") + call pargi (fwidth) + call pargi (fdigits) + call pargd (fval) + } else { + call sprintf (wordbuf, maxch, format) + call pargd (fval) + } +end diff --git a/noao/astcat/src/attools/mkpkg b/noao/astcat/src/attools/mkpkg new file mode 100644 index 00000000..24889814 --- /dev/null +++ b/noao/astcat/src/attools/mkpkg @@ -0,0 +1,39 @@ +# ATTOOLS tools subdirectory + +$checkout libpkg.a ".." +$update libpkg.a +$checkin libpkg.a ".." +$exit + +tfiles: + $ifolder (liststr.x,liststr.gx) + $generic -k liststr.gx -o liststr.x $endif + ; + +libpkg.a: + $ifeq (USE_GENERIC, yes) $call tfiles $endif + + atalloc.x "../../lib/astromdef.h" "../../lib/astrom.h" \ + "../../lib/acatalog.h" "../../lib/aimparsdef.h" \ + "../../lib/aimpars.h" + atcathdr.x <pkg/cq.h> "../../lib/acatalog.h" + atfnames.x "../../lib/astrom.h" <pkg/cq.h> + atinpars.x "../../lib/astrom.h" "../../lib/acatalog.h" \ + "../../lib/aimpars.h" + atdefpars.x "../../lib/astrom.h" "../../lib/acatalog.h" \ + "../../lib/aimpars.h" + atoutpars.x "../../lib/astrom.h" "../../lib/acatalog.h" \ + "../../lib/aimpars.h" + atset.x "../../lib/astromdef.h" "../../lib/astrom.h" \ + "../../lib/aimparsdef.h" "../../lib/aimpars.h" + atshow.x "../../lib/astrom.h" "../../lib/acatalog.h" \ + "../../lib/aimpars.h" + atstat.x "../../lib/astromdef.h" "../../lib/astrom.h" \ + "../../lib/aimparsdef.h" "../../lib/aimpars.h" + atwrdstr.x + + liststr.x <ctype.h> + atvectors.x + atsort.x + atdtype.x + ; diff --git a/noao/astcat/src/awcs/atmwshow.x b/noao/astcat/src/awcs/atmwshow.x new file mode 100644 index 00000000..cc39bbf3 --- /dev/null +++ b/noao/astcat/src/awcs/atmwshow.x @@ -0,0 +1,129 @@ +# AT_MWSHOW -- Print a quick summary of the current wcs. + +procedure at_mwshow (mwim, ltv, ltm, w, r, cd, ndim) + +pointer mwim # pointer to the current wcs +double ltv[ARB] # the lterm offsets +double ltm[ndim,ARB] # the lterm rotation matrix +double w[ARB] # the fits crval parameters +double r[ARB] # the fits crpix parameters +double cd[ndim,ARB] # the fits rotation matrix +int ndim # the dimension of the wcs + +int i,j +pointer sp, str +errchk mw_gwattrs() + +begin + # Allocate working space. + call smark (sp) + call salloc (str, SZ_LINE, TY_CHAR) + + # Print the axis banner. + call printf (" AXIS ") + do i = 1, ndim { + call printf ("%8d ") + call pargi (i) + } + call printf ("\n") + + # Print the crval parameters. + call printf (" CRVAL ") + do i = 1, ndim { + call printf ("%8g ") + call pargd (w[i]) + } + call printf ("\n") + + # Print the crpix parameters. + call printf (" CRPIX ") + do i = 1, ndim { + call printf ("%8g ") + call pargd (r[i]) + } + call printf ("\n") + + # Print the cd matrix. + do i = 1, ndim { + call printf (" CD %d ") + call pargi (i) + do j = 1, ndim { + call printf ("%8g ") + call pargd (cd[j,i]) + } + call printf ("\n") + } + + # Print the ltv parameters. + call printf (" LTV ") + do i = 1, ndim { + call printf ("%8g ") + call pargd (ltv[i]) + } + call printf ("\n") + + # Print the ltm matrix. + do i = 1, ndim { + call printf (" LTM %d ") + call pargi (i) + do j = 1, ndim { + call printf ("%8g ") + call pargd (ltm[i,j]) + } + call printf ("\n") + } + + # Print the transformation type. + call printf (" WTYPE ") + do i = 1, ndim { + iferr (call mw_gwattrs (mwim, i, "wtype", Memc[str], SZ_LINE)) + Memc[str] = EOS + call printf ("%8s ") + call pargstr (Memc[str]) + } + call printf ("\n") + + # Print the axis type. + call printf (" AXTYPE ") + do i = 1, ndim { + iferr (call mw_gwattrs (mwim, i, "axtype", Memc[str], SZ_LINE)) + Memc[str] = EOS + call printf ("%8s ") + call pargstr (Memc[str]) + } + call printf ("\n") + + # Print the units. + call printf (" UNITS ") + do i = 1, ndim { + iferr (call mw_gwattrs (mwim, i, "units", Memc[str], SZ_LINE)) + Memc[str] = EOS + call printf ("%8s ") + call pargstr (Memc[str]) + } + call printf ("\n") + + # Print the label. + call printf (" LABEL ") + do i = 1, ndim { + iferr (call mw_gwattrs (mwim, i, "label", Memc[str], SZ_LINE)) + Memc[str] = EOS + call printf ("%8s ") + call pargstr (Memc[str]) + } + call printf ("\n") + + # Print the format. + call printf (" FORMAT ") + do i = 1, ndim { + iferr (call mw_gwattrs (mwim, i, "format", Memc[str], SZ_LINE)) + Memc[str] = EOS + call printf ("%8s ") + call pargstr (Memc[str]) + } + call printf ("\n") + + call printf ("\n") + + call sfree (sp) +end diff --git a/noao/astcat/src/awcs/calcds.x b/noao/astcat/src/awcs/calcds.x new file mode 100644 index 00000000..de7ebcf2 --- /dev/null +++ b/noao/astcat/src/awcs/calcds.x @@ -0,0 +1,128 @@ +include <math.h> + +define SZ_GRID 10 +define SZ_NTERMS 2 + +# CALCDS -- Procedure to calculate the values of the CD matrix from the +# GSSS plate solution and a grid of 100 tie points. This routine was +# adapted from one in stsdas$pkg/analysis/gasp/gasplib/. See the routine +# stsdas$copyright.stsdas. + +procedure calcds (plt_centre_ra, plt_centre_dec, plt_centre_x, plt_centre_y, + x_corner, y_corner, x_pixel_size, y_pixel_size, plate_scale, x_size, + y_size, im_cen_ra, im_cen_dec, amd_x, amd_y, cd_matrix) + +double plt_centre_ra #I plate centre RA (radians) +double plt_centre_dec #I plate centre DEC (radians) +double plt_centre_x #I x center position (microns) +double plt_centre_y #I y center position (microns) +int x_corner #I x lower left of the extracted image +int y_corner #I y lower left of the extracted image +double x_pixel_size #I y scan pixel size (microns) +double y_pixel_size #I y scan pixel size (microns) +double plate_scale #I plate scale (arcsec / mm) +int x_size #I extracted image size x_axis (pixel) +int y_size #I extracted image size y_axis (pixel) +double im_cen_ra #I extracted image center RA (radians) +double im_cen_dec #I extracted image center DEC (radians) +double amd_x[ARB] #I XI plate solution coefficients +double amd_y[ARB] #I ETA coefficients (arsec / mm) +double cd_matrix[ARB] #O CD1_1, CD1_2, CD2_1, CD2_2 (degrees / pixel) + +double ra, dec, new_plt_centre_x, new_plt_centre_y, xref, yref, mag, color +double x_coeff[SZ_NTERMS], y_coeff[SZ_NTERMS], xchisqr, ychisqr +double x_sigma[SZ_NTERMS], y_sigma[SZ_NTERMS], x, y, xc, yc +pointer sp, xip, etap, x_arr, y_arr, ww, u, v, w, cvm +int sx, sy, xlim, ylim, nx, ny, nxy +int i, j, nterms, xi, eta, npts + +begin + # Initialize color and magnitude. + mag = 0.0d0 + color = 0.0d0 + + # Calculate new plate center in microns. + new_plt_centre_x = (x_size / 2.0d0) * x_pixel_size + new_plt_centre_y = (y_size / 2.0d0) * y_pixel_size + + call smark (sp) + call salloc (xip, SZ_GRID * SZ_GRID, TY_DOUBLE) + call salloc (etap, SZ_GRID * SZ_GRID, TY_DOUBLE) + call salloc (x_arr, SZ_NTERMS * SZ_GRID * SZ_GRID, TY_DOUBLE) + call salloc (y_arr, SZ_NTERMS * SZ_GRID * SZ_GRID, TY_DOUBLE) + call salloc (ww, SZ_GRID * SZ_GRID, TY_REAL) + + sx = max (1, x_size / SZ_GRID) + sy = max (1, y_size / SZ_GRID) + xlim = x_size - mod (x_size, sx) + ylim = y_size - mod (y_size, sy) + nx = xlim / sx + ny = ylim / sy + nxy = nx * ny + xi = xip + eta = etap + + # Compute the grid points. + npts = 0 + do i = sx, xlim, sx { + y = i # x coord. from lower left + do j = sy, ylim, sy { + x =j # y coord. from lower left + xc = x + x_corner + yc = y + y_corner + + # Obtain ra and dec from this grid (w/r to the original lower + # left corner) given the original plate center. + call ccgseq (plt_centre_ra, plt_centre_dec, plt_centre_x, + plt_centre_y, x_pixel_size, y_pixel_size, plate_scale, + amd_x, amd_y, xc, yc, mag, color, ra, dec) + + # Calculate xi and eta given the new plate center. + call treqst (im_cen_ra, im_cen_dec, ra, dec, Memd[xi], Memd[eta]) + xi = xi + 1 + eta = eta + 1 + + # Pixel to mm from the new plate center, notice x, y are + # w/r to the new lower left corner. +# xref = (new_plt_centre_x - x * x_pixel_size) / 1000. + xref = (x * x_pixel_size - new_plt_centre_x) / 1000. + yref = (y * y_pixel_size - new_plt_centre_y) / 1000. + + # Form normal equations for the model. + # xi = a*xref + b*yref + # eta = c*yref + d*xref + # + Memd[x_arr+npts] = xref # XAR(j,1) + Memd[x_arr+npts+nxy] = yref # XAR(j,2) + Memd[y_arr+npts] = yref # YAR(i,1) + Memd[y_arr+npts+nxy] = xref # YAR(i,2) + Memr[ww+npts] = 1.0 + npts = npts + 1 + } + } + + # Calculate the coefficients. + nterms = SZ_NTERMS + call salloc (u, npts * nterms, TY_DOUBLE) + call salloc (v, nterms * nterms, TY_DOUBLE) + call salloc (w, nterms, TY_DOUBLE) + call salloc (cvm, nterms * nterms, TY_DOUBLE) + call fitsvd (Memd[x_arr], Memd[xip], Memr[ww], npts, x_coeff, + nterms, Memd[u], Memd[v], Memd[w], xchisqr) + call varsvd (Memd[v], nterms, Memd[w], Memd[cvm], nterms) + do i =1, nterms + x_sigma[i] = sqrt(Memd[cvm+(i-1)+(i-1)*nterms]) + call fitsvd (Memd[y_arr], Memd[etap], Memr[ww], npts, y_coeff, + nterms, Memd[u], Memd[v], Memd[w], ychisqr) + call varsvd (Memd[v], nterms, Memd[w], Memd[cvm], nterms) + do i =1, nterms + y_sigma[i] = sqrt(Memd[cvm+(i-1)+(i-1)*nterms]) + + # Degrees/pixel = (arcsec/mm)*(mm/pixel)*(degrees/arcsec) + cd_matrix[1] = x_coeff[1] * (x_pixel_size / 1000.0d0 / 3600.0d0) + cd_matrix[2] = x_coeff[2] * (y_pixel_size / 1000.0d0 / 3600.0d0) + cd_matrix[3] = y_coeff[2] * (y_pixel_size / 1000.0d0 / 3600.0d0) + cd_matrix[4] = y_coeff[1] * (x_pixel_size / 1000.0d0 / 3600.0d0) + + call sfree (sp) +end diff --git a/noao/astcat/src/awcs/ccqseq.x b/noao/astcat/src/awcs/ccqseq.x new file mode 100644 index 00000000..542ea05e --- /dev/null +++ b/noao/astcat/src/awcs/ccqseq.x @@ -0,0 +1,95 @@ +# CCGSEQ -- Routine for computing RA and Dec for a given X,Y pixel +# position on a GSSS image. Adapted from stsdas$pkg/analysis/gasp/gasplib/. +# See stsdas$copyright.stdas for copyright restrictions. + +procedure ccgseq (plate_centre_ra, plate_centre_dec, plate_centre_x, + plate_centre_y, x_pixel_size, y_pixel_size, plate_scale, amd_x, + amd_y, object_x, object_y, object_mag, object_col, object_ra, + object_dec) + +double plate_centre_ra #I plate Right Ascension (radians) +double plate_centre_dec #I plate Declination (radians) +double plate_centre_x #I x position used in solution (microns) +double plate_centre_y #I y position used in solution (microns) +double x_pixel_size #I scan pixel size in x (microns) +double y_pixel_size #I scan pixel size in y (microns) +double plate_scale #I plate scale (arcsec / mm) +double amd_x[ARB] #I ra plate model coefficients +double amd_y[ARB] #I dec plate model coefficinets +double object_x #I x pixel position for object +double object_y #I y pixel positions for objects +double object_mag #I object magnitude +double object_col #I object colour +double object_ra #O object ra (radians) +double object_dec #O object dec (radians) + +double x # position from center (mm) +double y # position from center (mm) +double xi_object # xi standard coordinate (arcsec) +double eta_object # eta standard coordinate (arcsec) +double p1,p2,p3,p4 + +begin + # Convert x,y from pixels to mm measured from the plate centre + + x = (plate_centre_x - object_x * x_pixel_size) / 1000.0d0 + y = (object_y * y_pixel_size - plate_centre_y) / 1000.0d0 + + # Compute standard coordinates from x,y and plate model coefficients + + p1 = amd_x(1) *x + + amd_x(2) *y + + amd_x(3) + + amd_x(4) *x**2 + + amd_x(5) *x*y + + amd_x(6) *y**2 + + p2 = amd_x(7) *(x**2+y**2) + + amd_x(8) *x**3 + + amd_x(9) *x**2*y + + amd_x(10) *x*y**2 + + amd_x(11) *y**3 + + p3 = amd_x(12) *x*(x**2+y**2) + + amd_x(13) *x*(x**2+y**2)**2 + + amd_x(14) *object_mag + + amd_x(15) *object_mag**2 + + amd_x(16) *object_mag**3 + + p4 = amd_x(17) *object_mag*x + + amd_x(18) *object_mag*(x**2+y**2) + + amd_x(19) *object_mag*x*(x**2+y**2) + + amd_x(20) *object_col + + xi_object = p1 + p2 + p3 + p4 + + p1 = amd_y(1) *y + + amd_y(2) *x + + amd_y(3) + + amd_y(4) *y**2 + + amd_y(5) *x*y + + amd_y(6) *x**2 + + p2 = amd_y(7) *(x**2+y**2) + + amd_y(8) *y**3 + + amd_y(9) *y**2*x + + amd_y(10) *y*x**2 + + amd_y(11) *x**3 + + p3 = amd_y(12) *y*(x**2+y**2) + + amd_y(13) *y*(x**2+y**2)**2 + + amd_y(14) *object_mag + + amd_y(15) *object_mag**2 + + amd_y(16) *object_mag**3 + + p4 = amd_y(17) *object_mag*y + + amd_y(18) *object_mag*(x**2+y**2) + + amd_y(19) *object_mag*y*(x**2+y**2) + + amd_y(20) *object_col + + eta_object = p1 + p2 + p3 + p4 + + call trsteq (plate_centre_ra, plate_centre_dec, + xi_object, eta_object, object_ra, object_dec) + +end diff --git a/noao/astcat/src/awcs/dbwcs.x b/noao/astcat/src/awcs/dbwcs.x new file mode 100644 index 00000000..f3109050 --- /dev/null +++ b/noao/astcat/src/awcs/dbwcs.x @@ -0,0 +1,522 @@ +include <imhdr.h> +include <math.h> +include <mwset.h> +include <pkg/skywcs.h> +include <pkg/cq.h> + +# These should probably go into aimpars.h. + +define IMDB_WCSDICT "|wxref|wyref|wxmag|wymag|wxrot|wyrot|wraref|wdecref|\ +wproj|wsystem|" + +define IMDB_WCS_WXREF 1 +define IMDB_WCS_WYREF 2 +define IMDB_WCS_WXMAG 3 +define IMDB_WCS_WYMAG 4 +define IMDB_WCS_WXROT 5 +define IMDB_WCS_WYROT 6 +define IMDB_WCS_WLNGREF 7 +define IMDB_WCS_WLATREF 8 +define IMDB_WCS_WPROJ 9 +define IMDB_WCS_WSYSTEM 10 + + +# AT_DBWCS -- Compute a FITS WCS from an image using WCS definitions +# stored in the image surveys configuration file and transferred to the +# image query results structure. At the moment I am going to keep this +# routine simple by not worrying about the units of any quantities but the +# world coordinates of the reference point. This routine can be made more +# sophisticated later as time permits. The information is there ... + +int procedure at_dbwcs (im, res, update, verbose) + +pointer im #I the input image descriptor +pointer res #I the image query results descriptor +bool update #I update rather than list the wcs +bool verbose #I verbose mode + +double xref, yref, xmag, ymag, xrot, yrot, lngref, latref, dval +pointer sp, kfield, kname, kvalue, kunits, wtype, ctype, coo, mw +int i, ip, stat, coostat, ktype, nwcs, wkey, lngunits, latunits +double imgetd(), at_imhms() +int cq_istati(), cq_winfon(), strdic(), ctod(), ctowrd(), sk_decwcs() +bool streq() +errchk imgetd() + +begin + # Return if the input is not 2D. + + if (IM_NDIM(im) != 2) + return (ERR) + + # Allocate working space. + + call smark (sp) + call salloc (kfield, CQ_SZ_QPNAME, TY_CHAR) + call salloc (kname, CQ_SZ_QPNAME, TY_CHAR) + call salloc (kvalue, CQ_SZ_QPVALUE, TY_CHAR) + call salloc (kunits, CQ_SZ_QPUNITS, TY_CHAR) + call salloc (wtype, SZ_FNAME, TY_CHAR) + call salloc (ctype, SZ_FNAME, TY_CHAR) + + # Assume some sensible defaults, e.g. the reference point is at + # the center of the image, the orientation is the standard astronomical + # orientation with ra increasing to the left and declination increasing + # to the top, the projection is tan, the coordinate system is J2000. + + xref = (IM_LEN(im,1) + 1.0d0)/ 2.0d0 + yref = (IM_LEN(im,2) + 1.0d0)/ 2.0d0 + xmag = INDEFD + ymag = INDEFD + xrot = 180.0d0 + yrot = 0.0d0 + lngref = INDEFD + latref = INDEFD + call strcpy ("tan", Memc[wtype], SZ_FNAME) + call strcpy ("J2000", Memc[ctype], SZ_FNAME) + + # Loop over the mwcs database quantities. + + nwcs = cq_istati (res, CQNWCS) + do i = 1, nwcs { + + # Get the keyword information. + if (cq_winfon (res, i, Memc[kfield], CQ_SZ_QPNAME, Memc[kname], + CQ_SZ_QPNAME, Memc[kvalue], CQ_SZ_QPVALUE, ktype, Memc[kunits], + CQ_SZ_QPUNITS) != i) + next + + # Which keyword have we got ? + wkey = strdic (Memc[kfield], Memc[kfield], CQ_SZ_QPNAME, + IMDB_WCSDICT) + ip = 1 + switch (wkey) { + + # Get the x reference point in pixels. + case IMDB_WCS_WXREF: + if (streq (Memc[kname], "INDEF")) { + if (streq (Memc[kvalue], "INDEF")) + dval = INDEFD + else if (ctod (Memc[kvalue], ip, dval) <= 0) + dval = INDEFD + } else iferr (dval = imgetd (im, Memc[kname])) + dval = INDEFD + if (! IS_INDEFD(dval)) + xref = dval + + case IMDB_WCS_WYREF: + if (streq (Memc[kname], "INDEF")) { + if (streq (Memc[kvalue], "INDEF")) + dval = INDEFD + else if (ctod (Memc[kvalue], ip, dval) <= 0) + dval = INDEFD + } else iferr (dval = imgetd (im, Memc[kname])) + dval = INDEFD + if (! IS_INDEFD(dval)) + yref = dval + + case IMDB_WCS_WXMAG: + if (streq (Memc[kname], "INDEF")) { + if (streq (Memc[kvalue], "INDEF")) + dval = INDEFD + else if (ctod (Memc[kvalue], ip, dval) <= 0) + dval = INDEFD + } else iferr (dval = imgetd (im, Memc[kname])) + dval = INDEFD + if (! IS_INDEFD(dval)) + xmag = dval + + case IMDB_WCS_WYMAG: + if (streq (Memc[kname], "INDEF")) { + if (streq (Memc[kvalue], "INDEF")) + dval = INDEFD + else if (ctod (Memc[kvalue], ip, dval) <= 0) + dval = INDEFD + } else iferr (dval = imgetd (im, Memc[kname])) + dval = INDEFD + if (! IS_INDEFD(dval)) + ymag = dval + + case IMDB_WCS_WXROT: + if (streq (Memc[kname], "INDEF")) { + if (streq (Memc[kvalue], "INDEF")) + dval = INDEFD + else if (ctod (Memc[kvalue], ip, dval) <= 0) + dval = INDEFD + } else iferr (dval = imgetd (im, Memc[kname])) + dval = INDEFD + if (! IS_INDEFD(dval)) + xrot = dval + + case IMDB_WCS_WYROT: + if (streq (Memc[kname], "INDEF")) { + if (streq (Memc[kvalue], "INDEF")) + dval = INDEFD + else if (ctod (Memc[kvalue], ip, dval) <= 0) + dval = INDEFD + } else iferr (dval = imgetd (im, Memc[kname])) + dval = INDEFD + if (! IS_INDEFD(dval)) + yrot = dval + + case IMDB_WCS_WLNGREF: + if (streq (Memc[kname], "INDEF")) { + if (streq (Memc[kvalue], "INDEF")) + dval = INDEFD + else if (ctod (Memc[kvalue], ip, dval) <= 0) + dval = INDEFD + } else { + dval = at_imhms (im, Memc[kname]) + if (IS_INDEFD(dval)) { + iferr (dval = imgetd (im, Memc[kname])) + dval = INDEFD + } + } + if (! IS_INDEFD(dval)) + lngref = dval + lngunits = strdic (Memc[kunits], Memc[kunits], CQ_SZ_QPUNITS, + SKY_LNG_UNITLIST) + + case IMDB_WCS_WLATREF: + if (streq (Memc[kname], "INDEF")) { + if (streq (Memc[kvalue], "INDEF")) + dval = INDEFD + else if (ctod (Memc[kvalue], ip, dval) <= 0) + dval = INDEFD + } else { + dval = at_imhms (im, Memc[kname]) + if (IS_INDEFD(dval)) { + iferr (dval = imgetd (im, Memc[kname])) + dval = INDEFD + } + } + if (! IS_INDEFD(dval)) + latref = dval + latunits = strdic (Memc[kunits], Memc[kunits], CQ_SZ_QPUNITS, + SKY_LAT_UNITLIST) + + case IMDB_WCS_WPROJ: + if (streq (Memc[kname], "INDEF")) { + if (streq (Memc[kvalue], "INDEF")) + call strcpy ("tan", Memc[wtype], SZ_FNAME) + else if (ctowrd (Memc[kvalue], ip, Memc[wtype], + SZ_FNAME) <= 0) + call strcpy ("tan", Memc[wtype], SZ_FNAME) + } else iferr (call imgstr (im, Memc[kname], Memc[wtype], + SZ_FNAME)) + call strcpy ("tan", Memc[wtype], SZ_FNAME) + + case IMDB_WCS_WSYSTEM: + if (streq (Memc[kname], "INDEF")) { + if (streq (Memc[kvalue], "INDEF")) + call strcpy ("J2000", Memc[ctype], SZ_FNAME) + else if (ctowrd (Memc[kvalue], ip, Memc[ctype], + SZ_FNAME) <= 0) + call strcpy ("J2000", Memc[ctype], SZ_FNAME) + } else iferr (call imgstr (im, Memc[kname], Memc[ctype], + SZ_FNAME)) + call strcpy ("J2000", Memc[ctype], SZ_FNAME) + + default: + ; + } + } + + # Check to see of the critical quantities image scale and reference + # point are defined. Quit if they are not, otherwise update the + # header. + + if (IS_INDEFD(xmag) || IS_INDEFD(ymag) || IS_INDEFD(lngref) || + IS_INDEFD(latref)) { + + stat = ERR + + } else { + + # Open the coordinate system structure. + coostat = sk_decwcs (Memc[ctype], mw, coo, NULL) + + # Update hte header. + if (coostat == ERR || mw != NULL) { + if (mw != NULL) + call mw_close (mw) + stat = ERR + } else { + if (lngunits > 0) + call sk_seti (coo, S_NLNGUNITS, lngunits) + if (latunits > 0) + call sk_seti (coo, S_NLATUNITS, latunits) + if (verbose) + call printf (" Writing FITS wcs using image survey db\n") + call at_uwcs (im, coo, Memc[wtype], lngref, latref, xref, + yref, xmag, ymag, xrot, yrot, false, update) + stat = OK + } + + # Close the coordinate structure + if (coo != NULL) + call sk_close (coo) + } + + call sfree (sp) + return (stat) +end + + +define NEWCD Memd[ncd+(($2)-1)*ndim+($1)-1] + +# AT_UWCS -- Compute the image wcs from the user parameters. + +procedure at_uwcs (im, coo, projection, lngref, latref, xref, yref, + xscale, yscale, xrot, yrot, transpose, update) + +pointer im #I pointer to the input image +pointer coo #I pointer to the coordinate structure +char projection[ARB] #I the sky projection geometry +double lngref, latref #I the world coordinates of the reference point +double xref, yref #I the reference point in pixels +double xscale, yscale #I the x and y scale in arcsec / pixel +double xrot, yrot #I the x and y axis rotation angles in degrees +bool transpose #I transpose the wcs +bool update #I update rather than list the wcs + + +double tlngref, tlatref +int l, i, ndim, naxes, axmap, wtype, ax1, ax2, szatstr +pointer mw, sp, r, w, cd, ltm, ltv, iltm, nr, ncd, axes, axno, axval +pointer projstr, projpars, wpars, mwnew, atstr +int mw_stati(), sk_stati(), strdic(), strlen(), itoc() +pointer mw_openim(), mw_open() +errchk mw_newsystem(), mw_gwattrs() + +begin + mw = mw_openim (im) + ndim = mw_stati (mw, MW_NPHYSDIM) + + # Allocate working memory for the vectors and matrices. + call smark (sp) + call salloc (projstr, SZ_FNAME, TY_CHAR) + call salloc (projpars, SZ_LINE, TY_CHAR) + call salloc (wpars, SZ_LINE, TY_CHAR) + call salloc (r, ndim, TY_DOUBLE) + call salloc (w, ndim, TY_DOUBLE) + call salloc (cd, ndim * ndim, TY_DOUBLE) + call salloc (ltm, ndim * ndim, TY_DOUBLE) + call salloc (ltv, ndim, TY_DOUBLE) + call salloc (iltm, ndim * ndim, TY_DOUBLE) + call salloc (nr, ndim, TY_DOUBLE) + call salloc (ncd, ndim * ndim, TY_DOUBLE) + call salloc (axes, IM_MAXDIM, TY_INT) + call salloc (axno, IM_MAXDIM, TY_INT) + call salloc (axval, IM_MAXDIM, TY_INT) + + # Open the new wcs + mwnew = mw_open (NULL, ndim) + call mw_gsystem (mw, Memc[projstr], SZ_FNAME) + iferr { + call mw_newsystem (mw, "image", ndim) + } then { + call mw_newsystem (mwnew, Memc[projstr], ndim) + } else { + call mw_newsystem (mwnew, "image", ndim) + } + + # Set the LTERM. + call mw_gltermd (mw, Memd[ltm], Memd[ltv], ndim) + call mw_sltermd (mwnew, Memd[ltm], Memd[ltv], ndim) + + # Store the old axis map for later use. + call mw_gaxmap (mw, Memi[axno], Memi[axval], ndim) + + # Get the 2 logical axes. + call mw_gaxlist (mw, 03B, Memi[axes], naxes) + axmap = mw_stati (mw, MW_USEAXMAP) + ax1 = Memi[axes] + ax2 = Memi[axes+1] + + # Set the axes and projection type. + if (projection[1] == EOS) { + call mw_swtype (mwnew, Memi[axes], ndim, "linear", "") + } else { + call sscan (projection) + call gargwrd (Memc[projstr], SZ_FNAME) + call gargstr (Memc[projpars], SZ_LINE) + call sprintf (Memc[wpars], SZ_LINE, + "axis 1: axtype = ra %s axis 2: axtype = dec %s") + call pargstr (Memc[projpars]) + call pargstr (Memc[projpars]) + call mw_swtype (mwnew, Memi[axes], ndim, Memc[projstr], Memc[wpars]) + } + + # Copy in the atrributes of the other axes. + szatstr = SZ_LINE + call malloc (atstr, szatstr, TY_CHAR) + do l = 1, ndim { + if (l == ax1 || l == ax2) + next + iferr { + call mw_gwattrs (mw, l, "wtype", Memc[projpars], SZ_LINE) + } then { + call mw_swtype (mwnew, l, 1, "linear", "") + } else { + call mw_swtype (mwnew, l, 1, Memc[projpars], "") + } + for (i = 1; ; i = i + 1) { + if (itoc (i, Memc[projpars], SZ_LINE) <= 0) + Memc[atstr] = EOS + repeat { + iferr (call mw_gwattrs (mw, l, Memc[projpars], + Memc[atstr], szatstr)) + Memc[atstr] = EOS + if (strlen (Memc[atstr]) < szatstr) + break + szatstr = szatstr + SZ_LINE + call realloc (atstr, szatstr, TY_CHAR) + } + if (Memc[atstr] == EOS) + break + call mw_swattrs (mwnew, 1, Memc[projpars], Memc[atstr]) + } + } + call mfree (atstr, TY_CHAR) + + # Compute the referemce point world coordinates. + switch (sk_stati(coo, S_NLNGUNITS)) { + case SKY_DEGREES: + tlngref = lngref + case SKY_RADIANS: + tlngref = RADTODEG(lngref) + case SKY_HOURS: + tlngref = 15.0d0 * lngref + default: + tlngref = lngref + } + switch (sk_stati(coo, S_NLATUNITS)) { + case SKY_DEGREES: + tlatref = latref + case SKY_RADIANS: + tlatref = RADTODEG(latref) + case SKY_HOURS: + tlatref = 15.0d0 * latref + default: + tlatref = latref + } + + if (! transpose) { + Memd[w+ax1-1] = tlngref + Memd[w+ax2-1] = tlatref + } else { + Memd[w+ax2-1] = tlngref + Memd[w+ax1-1] = tlatref + } + + # Compute the reference point pixel coordinates. + Memd[nr+ax1-1] = xref + Memd[nr+ax2-1] = yref + + # Compute the new CD matrix. + if (! transpose) { + NEWCD(ax1,ax1) = xscale * cos (DEGTORAD(xrot)) / 3600.0d0 + NEWCD(ax2,ax1) = -yscale * sin (DEGTORAD(yrot)) / 3600.0d0 + NEWCD(ax1,ax2) = xscale * sin (DEGTORAD(xrot)) / 3600.0d0 + NEWCD(ax2,ax2) = yscale * cos (DEGTORAD(yrot)) / 3600.0d0 + } else { + NEWCD(ax1,ax1) = xscale * sin (DEGTORAD(xrot)) / 3600.0d0 + NEWCD(ax2,ax1) = yscale * cos (DEGTORAD(yrot)) / 3600.0d0 + NEWCD(ax1,ax2) = xscale * cos (DEGTORAD(xrot)) / 3600.0d0 + NEWCD(ax2,ax2) = -yscale * sin (DEGTORAD(yrot)) / 3600.0d0 + } + + if (! update) + call at_mwshow (mwnew, Memd[ltv], Memd[ltm], Memd[w], Memd[nr], + Memd[ncd], ndim) + + # Reset the axis map. + call mw_seti (mw, MW_USEAXMAP, axmap) + + # Recompute and store the new wcs if update is enabled. + call mw_saxmap (mwnew, Memi[axno], Memi[axval], ndim) + if (sk_stati (coo, S_PIXTYPE) == PIXTYPE_PHYSICAL) { + call mw_swtermd (mwnew, Memd[nr], Memd[w], Memd[ncd], ndim) + } else { + call mwmmuld (Memd[ncd], Memd[ltm], Memd[cd], ndim) + call mwinvertd (Memd[ltm], Memd[iltm], ndim) + call asubd (Memd[nr], Memd[ltv], Memd[r], ndim) + call mwvmuld (Memd[iltm], Memd[r], Memd[nr], ndim) + call mw_swtermd (mwnew, Memd[nr], Memd[w], Memd[cd], ndim) + } + + # Save the fit. + if (! transpose) { + call sk_seti (coo, S_PLNGAX, ax1) + call sk_seti (coo, S_PLATAX, ax2) + } else { + call sk_seti (coo, S_PLNGAX, ax2) + call sk_seti (coo, S_PLATAX, ax1) + } + if (update) { + call sk_saveim (coo, mwnew, im) + call mw_saveim (mwnew, im) + } + + # Close the wcs, + call mw_close (mwnew) + call mw_close (mw) + + # Force the CDELT keywords to update. This will be unecessary when + # mwcs is updated to deal with non-quoted and / or non left-justified + # CTYPE keywords.. + wtype = strdic (Memc[projstr], Memc[projstr], SZ_FNAME, WTYPE_LIST) + if (wtype > 0) + call sk_seti (coo, S_WTYPE, wtype) + call sk_ctypeim (coo, im) + + # Reset the fit. This will be unecessary when wcs is updated to deal + # with non-quoted and / or non left-justified CTYPE keywords. + call sk_seti (coo, S_WTYPE, 0) + call sk_seti (coo, S_PLNGAX, 0) + call sk_seti (coo, S_PLATAX, 0) + + call sfree (sp) +end + + +# AT_IMHMS -- Fetch a quantity form the image header that is in hms or dms +# format, e.g. in the form "+/-hh mm ss.x" or "+/-dd mm ss.s". + +double procedure at_imhms (im, kname) + +pointer im #I the image descriptor +char kname[ARB] #I the image keyword name + +double dval, hours, minutes, seconds +pointer sp, value +int nscan() +errchk imgstr() + +begin + call smark (sp) + call salloc (value, SZ_FNAME, TY_CHAR) + + iferr { + call imgstr (im, kname, Memc[value], SZ_FNAME) + } then { + dval = INDEFD + } else { + call sscan (Memc[value]) + call gargd (hours) + call gargd (minutes) + call gargd (seconds) + if (nscan() != 3) + dval = INDEFD + else if (hours >= 0.0d0) + dval = hours + (minutes / 60.0d0) + (seconds / 3600.0d0) + else + dval = -(abs(hours) + (minutes / 60.0d0) + (seconds / 3600.0d0)) + + } + + call sfree (sp) + + return (dval) +end diff --git a/noao/astcat/src/awcs/dcmpsv.f b/noao/astcat/src/awcs/dcmpsv.f new file mode 100644 index 00000000..5326e098 --- /dev/null +++ b/noao/astcat/src/awcs/dcmpsv.f @@ -0,0 +1,233 @@ +C This routine was copied from the stsdas$pkg/analysis/gasp/gasplib/ +C directory. See stsdas$copyright.stsdas for copyright restrictions. +C + subroutine dcmpsv (a,m,n,w,v) + parameter (nmax=1000) + real*8 a(m,n),w(n),v(n,n),rv1(nmax) + real*8 c, g, f, h, s, y, z, x, scale, anorm + + g=0.0 + scale=0.0 + anorm=0.0 + do i=1,n + l=i+1 + rv1(i)=scale*g + g=0.0 + s=0.0 + scale=0.0 + if (i.le.m) then + do k=i,m + scale=scale+dabs(a(k,i)) + enddo + if (scale.ne.0.0) then + do k=i,m + a(k,i)=a(k,i)/scale + s=s+a(k,i)*a(k,i) + enddo + f=a(i,i) + g=-dsign(dsqrt(s),f) + h=f*g-s + a(i,i)=f-g + if (i.ne.n) then + do j=l,n + s=0.0 + do k=i,m + s=s+a(k,i)*a(k,j) + enddo + f=s/h + do k=i,m + a(k,j)=a(k,j)+f*a(k,i) + enddo + enddo + endif + do k= i,m + a(k,i)=scale*a(k,i) + enddo + endif + endif + w(i)=scale *g + g=0.0 + s=0.0 + scale=0.0 + if ((i.le.m).and.(i.ne.n)) then + do k=l,n + scale=scale+dabs(a(i,k)) + enddo + if (scale.ne.0.0) then + do k=l,n + a(i,k)=a(i,k)/scale + s=s+a(i,k)*a(i,k) + enddo + f=a(i,l) + g=-dsign(dsqrt(s),f) + h=f*g-s + a(i,l)=f-g + do k=l,n + rv1(k)=a(i,k)/h + enddo + if (i.ne.m) then + do j=l,m + s=0.0 + do k=l,n + s=s+a(j,k)*a(i,k) + enddo + do k=l,n + a(j,k)=a(j,k)+s*rv1(k) + enddo + enddo + endif + do k=l,n + a(i,k)=scale*a(i,k) + enddo + endif + endif + anorm=dmax1(anorm,(dabs(w(i))+dabs(rv1(i)))) + enddo + do i=n,1,-1 + if (i.lt.n) then + if (g.ne.0.0) then + do j=l,n + v(j,i)=(a(i,j)/a(i,l))/g + enddo + do j=l,n + s=0.0 + do k=l,n + s=s+a(i,k)*v(k,j) + enddo + do k=l,n + v(k,j)=v(k,j)+s*v(k,i) + enddo + enddo + endif + do j=l,n + v(i,j)=0.0 + v(j,i)=0.0 + enddo + endif + v(i,i)=1.0 + g=rv1(i) + l=i + enddo + do i=n,1,-1 + l=i+1 + g=w(i) + if (i.lt.n) then + do j=l,n + a(i,j)=0.0 + enddo + endif + if (g.ne.0.0) then + g=1.0/g + if (i.ne.n) then + do j=l,n + s=0.0 + do k=l,m + s=s+a(k,i)*a(k,j) + enddo + f=(s/a(i,i))*g + do k=i,m + a(k,j)=a(k,j)+f*a(k,i) + enddo + enddo + endif + do j=i,m + a(j,i)=a(j,i)*g + enddo + else + do j= i,m + a(j,i)=0.0 + enddo + endif + a(i,i)=a(i,i)+1.0 + enddo + do k=n,1,-1 + do its=1,30 + do l=k,1,-1 + nm=l-1 + if ((dabs(rv1(l))+anorm).eq.anorm) go to 2 + if ((dabs(w(nm))+anorm).eq.anorm) go to 1 + enddo +1 c=0.0 + s=1.0 + do i=l,k + f=s*rv1(i) + if ((dabs(f)+anorm).ne.anorm) then + g=w(i) + h=dsqrt(f*f+g*g) + w(i)=h + h=1.0/h + c= (g*h) + s=-(f*h) + do j=1,m + y=a(j,nm) + z=a(j,i) + a(j,nm)=(y*c)+(z*s) + a(j,i)=-(y*s)+(z*c) + enddo + endif + enddo +2 z=w(k) + if (l.eq.k) then + if (z.lt.0.0) then + w(k)=-z + do j=1,n + v(j,k)=-v(j,k) + enddo + endif + go to 3 + endif + if (its.eq.30) pause 'nO CONVERGENCE IN 30 ITERATIONS' + x=w(l) + nm=k-1 + y=w(nm) + g=rv1(nm) + h=rv1(k) + f=((y-z)*(y+z)+(g-h)*(g+h))/(2.0*h*y) + g=dsqrt(f*f+1.0) + f=((x-z)*(x+z)+h*((y/(f+dsign(g,f)))-h))/x + c=1.0 + s=1.0 + do j=l,nm + i=j+1 + g=rv1(i) + y=w(i) + h=s*g + g=c*g + z=dsqrt(f*f+h*h) + rv1(j)=z + c=f/z + s=h/z + f= (x*c)+(g*s) + g=-(x*s)+(g*c) + h=y*s + y=y*c + do nm=1,n + x=v(nm,j) + z=v(nm,i) + v(nm,j)= (x*c)+(z*s) + v(nm,i)=-(x*s)+(z*c) + enddo + z=sqrt(f*f+h*h) + w(j)=z + if (z.ne.0.0) then + z=1.0/z + c=f*z + s=h*z + endif + f= (c*g)+(s*y) + x=-(s*g)+(c*y) + do nm=1,m + y=a(nm,j) + z=a(nm,i) + a(nm,j)= (y*c)+(z*s) + a(nm,i)=-(y*s)+(z*c) + enddo + enddo + rv1(l)=0.0 + rv1(k)=f + w(k)=x + enddo +3 continue + enddo + return + end diff --git a/noao/astcat/src/awcs/dsswcs.x b/noao/astcat/src/awcs/dsswcs.x new file mode 100644 index 00000000..0fe3b169 --- /dev/null +++ b/noao/astcat/src/awcs/dsswcs.x @@ -0,0 +1,300 @@ +include <imhdr.h> +include <mwset.h> +include <math.h> + +define SZ_KEYWORD 8 +define SZ_PLATECOEFF 20 +define SZ_CDMATX 4 + +# AT_MKDSS -- Compute the FITS WCS from the general plate solution for a +# DSS image. This routine assumes that the geometry of the DSS image has not +# been modified since it was extracted, i.e. it has not been shifed,rotated, +# scaled, transposed etc. This routine has been adapted from one in the STSDAS +# GASP package, whose maim limitation for IRAF purposes was that it bypassed +# the IRAF MWCS routines. Return OK it the header is successfully updated, +# ERR otherwise. + +int procedure at_mkdss (im, update, verbose) + +pointer im #I the DSS image descriptor +bool update #I update rather than list the wcs ? +bool verbose #I verbose mode ? + +double amdx[SZ_PLATECOEFF] # the RA plate solution coefficients +double amdy[SZ_PLATECOEFF] # the DEC plate solution coefficients +double plate_cen_x # the x center position in microns +double plate_cen_y # the y center position in microns +double plate_cen_ra # the RA plate center in radians +double plate_cen_dec # the DEC plate center in radians +double x_pixel_size # the x step size in microns +double y_pixel_size # the y step size in microns +double plate_scale # the plate sclae in arcsec / mm +double im_x_center_pix # the x of ll corner of scanned plate +double im_y_center_pix # the y of ll corner of scanned plate +double ra_s # the plate center RA in seconds +double dec_s # the plate center DEC in seconds +double object_mag # the object magnitude +double object_col # the object color +int ra_h, ra_m # the plate center RA hours, minutes +int dec_d, dec_m # the plate center DEC degrees, minutes +char dec_sign # the plate center DEC sign +/- +int xcorner # the ll x of image w/r to plate +int ycorner # the ll y of image w/r to plate +int xsize # naxis1 +int ysize # naxis2 + +double crpix1, crpix2, crval1, crval2, cdmatx[SZ_CDMATX] +int i +char parname[SZ_KEYWORD] + +double imgetd() +real imgetr() +int imaccf(), imgeti() +errchk imgetr(), imgetd(), imgeti() + +begin + # Check that the image is 2D, if not it is not a DSS image. + if (IM_NDIM(im) != 2) + return (ERR) + + # See if image header contains the general plate solution. + if (imaccf (im,"PPO3 ") == NO) + return (ERR) + + # If we have an old DSS image, i.e. the one with the CRPIX rather + # than CNPIX keywords, rename CRPIX to CNPIX and proceed. + # this keyword to CNPIX and proceed. + + if (imaccf (im,"CRPIX1") == YES || imaccf (im, "CRPIX2") == YES) { + if (imaccf (im,"CRVAL1") == YES || imaccf (im, "CRVAL2") == YES) { + if (imaccf (im,"CD1_1") == NO && imaccf (im, "CD1_2") == NO && + imaccf (im, "CD2_1") == NO && imaccf (im, "CD2_2") == NO) { + # This is the case when we have CRPIX, CRVAL and no CD + # so, proceed to calculate the WCS again. + iferr (crpix1 = imgetr (im, "CRPIX1")) + return (ERR) + iferr (crpix2 = imgetr (im, "CRPIX2")) + return (ERR) + call imdelf (im, "CRPIX1") + call imaddr (im, "CNPIX1", real (crpix1)) + call imdelf (im, "CRPIX2") + call imaddr (im, "CNPIX2", real (crpix2)) + } + } else { + iferr (crpix1 = imgetr (im, "CRPIX1")) + return (ERR) + iferr (crpix2 = imgetr (im, "CRPIX2")) + return (ERR) + call imdelf (im, "CRPIX1") + call imaddr (im, "CNPIX1", real (crpix1)) + call imdelf (im, "CRPIX2") + call imaddr (im, "CNPIX2", real (crpix2)) + } + } + if (imaccf (im,"CNPIX1") == NO || imaccf (im, "CNPIX2") == NO ) + return (ERR) + + # Get the plate solution. + iferr { + + # Get the plate center parameters. + plate_cen_x = imgetd (im, "PPO3 ") + plate_cen_y = imgetd (im, "PPO6 ") + x_pixel_size = imgetd (im, "XPIXELSZ") + y_pixel_size = imgetd (im, "YPIXELSZ") + plate_scale = imgetd (im, "PLTSCALE") + ra_h = imgeti (im, "PLTRAH ") + ra_m = imgeti (im, "PLTRAM ") + ra_s = imgetd (im, "PLTRAS ") + call imgstr (im, "PLTDECSN", dec_sign, 1) + dec_d = imgeti (im, "PLTDECD ") + dec_m = imgeti (im, "PLTDECM ") + dec_s = imgetd (im, "PLTDECS ") + plate_cen_ra = DDEGTORAD ((ra_h + ra_m / 60.0d0 + ra_s / + 3600.0d0) * 15.0d0) + plate_cen_dec = DDEGTORAD (dec_d + dec_m / 60.0d0 + dec_s / + 3600.0d0) + if (dec_sign == '-') + plate_cen_dec = -plate_cen_dec + + # Get general plate solution coefficients + do i = 1, SZ_PLATECOEFF { + call sprintf (parname, SZ_KEYWORD, "AMDX%d") + call pargi(i) + amdx[i] = imgetd (im, parname) + } + do i = 1, SZ_PLATECOEFF { + call sprintf (parname, SZ_KEYWORD, "AMDY%d") + call pargi(i) + amdy[i] = imgetd (im, parname) + } + xcorner = imgetr (im, "CNPIX1") + ycorner = imgetr (im, "CNPIX2") + object_mag = 0.0d0 + object_col = 0.0d0 + } then + return (ERR) + + xsize = IM_LEN(im,1) + ysize = IM_LEN(im,2) + crpix1 = xsize / 2.0d0 + crpix2 = ysize / 2.0d0 + + # Center of image w/r to original lower left corner of scanned plate. + im_x_center_pix = xcorner + (xsize / 2.0d0) - 0.5d0 + im_y_center_pix = ycorner + (ysize / 2.0d0) - 0.5d0 + + # Calculate equatorial coordinates for the center of subset giving + # the complete plate solution w/r to the original lower left corner. + call ccgseq (plate_cen_ra, + plate_cen_dec, + plate_cen_x, + plate_cen_y, + x_pixel_size, + y_pixel_size, + plate_scale, + amdx, + amdy, + im_x_center_pix, + im_y_center_pix, + object_mag, + object_col, + crval1, + crval2) + + + # Calculate CD matrix values for the input subset from the original + # plate solution. + call calcds (plate_cen_ra, + plate_cen_dec, + plate_cen_x, + plate_cen_y, + xcorner, + ycorner, + x_pixel_size, + y_pixel_size, + plate_scale, + xsize, + ysize, + crval1, + crval2, + amdx, + amdy, + cdmatx) + + # Update the image header. + crval1 = DRADTODEG (crval1) + crval2 = DRADTODEG (crval2) + + if (verbose || ! update) + call printf (" Converting DSS wcs to FITS wcs\n") + call at_dmwcs (im, crpix1, crpix2, crval1, crval2, cdmatx, update) + + return (OK) +end + +define NEWCD Memd[ncd+(($2)-1)*ndim+($1)-1] + +# AT_DMWCS -- Create new image WCS from the approximation to the DSS plate +# solution. This routine assumes that the geometry of the DSS image has +# not been changed since since the image has been exracted from the image +# survey. + +procedure at_dmwcs (im, xref, yref, lngref, latref, cdmatx, update) + +pointer im #I pointer to the input image +double xref, yref #I the reference point in pixels +double lngref, latref #I the reference point in degrees +double cdmatx[ARB] #I CD1_1, CD1_2, CD2_1, CD2_2 +bool update #I update rather than list the wcs ? + +pointer mw, mwnew +pointer sp, projstr, r, w, cd, ltm, ltv, iltm, nr, ncd, axno, axval, axes +int ndim, ax1, ax2, naxes +pointer mw_openim(), mw_open() +int mw_stati() +errchk mw_newsystem() + +begin + mw = mw_openim (im) + ndim = mw_stati (mw, MW_NPHYSDIM) + + # Allocate working memory for the vectors and matrices. + call smark (sp) + call salloc (projstr, SZ_LINE, TY_CHAR) + call salloc (r, ndim, TY_DOUBLE) + call salloc (w, ndim, TY_DOUBLE) + call salloc (cd, ndim * ndim, TY_DOUBLE) + call salloc (ltm, ndim * ndim, TY_DOUBLE) + call salloc (ltv, ndim, TY_DOUBLE) + call salloc (iltm, ndim * ndim, TY_DOUBLE) + call salloc (nr, ndim, TY_DOUBLE) + call salloc (ncd, ndim * ndim, TY_DOUBLE) + call salloc (axno, IM_MAXDIM, TY_INT) + call salloc (axval, IM_MAXDIM, TY_INT) + call salloc (axes, IM_MAXDIM, TY_INT) + + # Open the new wcs. + mwnew = mw_open (NULL, ndim) + call mw_gsystem (mw, Memc[projstr], SZ_LINE) + iferr { + call mw_newsystem (mw, "image", ndim) + } then { + call mw_newsystem (mwnew, Memc[projstr], ndim) + } else { + call mw_newsystem (mwnew, "image", ndim) + } + + # Set the LTERM. + call mw_gltermd (mw, Memd[ltm], Memd[ltv], ndim) + call mw_sltermd (mwnew, Memd[ltm], Memd[ltv], ndim) + + # Store the old axis map for later use. + call mw_gaxmap (mw, Memi[axno], Memi[axval], ndim) + + # Get the 2 logical axes. + call mw_gaxlist (mw, 03B, Memi[axes], naxes) + ax1 = Memi[axes] + ax2 = Memi[axes+1] + + # Set the axes and projection type. + call sprintf (Memc[projstr], SZ_LINE, + "axis 1: axtype = ra axis 2: axtype = dec ") + call mw_swtype (mwnew, Memi[axes], ndim, "tan", Memc[projstr]) + + # Set the reference point world coordinates. + Memd[w+ax1-1] = lngref + Memd[w+ax2-1] = latref + + # Set the reference point pixel coordinates. + Memd[nr+ax1-1] = xref + Memd[nr+ax2-1] = yref + + # Compute the new CD matrix. + NEWCD(ax1,ax1) = cdmatx[1] # xscale * cos (DEGTORAD(xrot)) / 3600.0d0 + NEWCD(ax2,ax1) = cdmatx[2] # -yscale * sin (DEGTORAD(yrot)) / 3600.0d0 + NEWCD(ax1,ax2) = cdmatx[3] # xscale * sin (DEGTORAD(xrot)) / 3600.0d0 + NEWCD(ax2,ax2) = cdmatx[4] # yscale * cos (DEGTORAD(yrot)) / 3600.0d0 + + # List the new wcs. + if (! update) + call at_mwshow (mwnew, Memd[ltv], Memd[ltm], Memd[w], Memd[nr], + Memd[ncd], ndim) + + # Recompute and store the new wcs. + call mw_saxmap (mwnew, Memi[axno], Memi[axval], ndim) + call mwmmuld (Memd[ncd], Memd[ltm], Memd[cd], ndim) + call mwinvertd (Memd[ltm], Memd[iltm], ndim) + call asubd (Memd[nr], Memd[ltv], Memd[r], ndim) + call mwvmuld (Memd[iltm], Memd[r], Memd[nr], ndim) + call mw_swtermd (mwnew, Memd[nr], Memd[w], Memd[cd], ndim) + + # Update the image wcs. + if (update) + call mw_saveim (mwnew, im) + + call mw_close (mwnew) + call mw_close (mw) + + call sfree (sp) +end diff --git a/noao/astcat/src/awcs/fitsvd.f b/noao/astcat/src/awcs/fitsvd.f new file mode 100644 index 00000000..bb8d0f4e --- /dev/null +++ b/noao/astcat/src/awcs/fitsvd.f @@ -0,0 +1,38 @@ +C This routine was copied from the stsdas$pkg/analysis/gasp/gasplib/ +C directory. See stsdas$copyright.stsdas for copyright restrictions. +C + subroutine fitsvd (x, y, wg, npts, coef, nterms, + * u, v, w, chisq) + parameter(nmax=1000,mmax=50,tol=1.d-14) + + real wg(npts) + real*8 x(npts,nterms), y(npts), coef(nterms), v(nterms,nterms), + * u(npts,nterms), w(nterms), b(nmax) + real*8 wmax, thresh, chisq, sum + + do i=1,npts + do j=1,nterms + u(i,j)=x(i,j)*wg(i) + enddo + b(i)=y(i)*wg(i) + enddo + call dcmpsv (u,npts,nterms,w,v) + wmax=0. + do j=1,nterms + if(w(j).gt.wmax) wmax=w(j) + enddo + thresh=tol*wmax + do j=1,nterms + if(w(j).lt.thresh) w(j)=0. + enddo + call ksbsvd (u, w, v, npts, nterms, b, coef) + chisq=0. + do i=1,npts + sum=0. + do j=1,nterms + sum=sum+coef(j)*x(i,j) + enddo + chisq=chisq+((y(i)-sum)*wg(i))**2 + enddo + return + end diff --git a/noao/astcat/src/awcs/ksbsvd.f b/noao/astcat/src/awcs/ksbsvd.f new file mode 100644 index 00000000..3c78ec23 --- /dev/null +++ b/noao/astcat/src/awcs/ksbsvd.f @@ -0,0 +1,27 @@ +C This routines was copied from the stsdas$pkg/analysis/gasp/gasplib/ +C directory. See the file stsdas$copyright.stsdas for copyright +C restrictions. + subroutine ksbsvd (u,w,v,m,n,b,x) + parameter (nmax=1000) + real*8 u(m,n),w(n),v(n,n),b(m),x(n),tmp(nmax) + real*8 s + + do j=1,n + s=0. + if(w(j).ne.0.)then + do i=1,m + s=s+u(i,j)*b(i) + enddo + s=s/w(j) + endif + tmp(j)=s + enddo + do j=1,n + s=0. + do jj=1,n + s=s+v(j,jj)*tmp(jj) + enddo + x(j)=s + enddo + return + end diff --git a/noao/astcat/src/awcs/mkpkg b/noao/astcat/src/awcs/mkpkg new file mode 100644 index 00000000..29160f2a --- /dev/null +++ b/noao/astcat/src/awcs/mkpkg @@ -0,0 +1,22 @@ +# AWCS task subdirectory + +$checkout libpkg.a "../" +$update libpkg.a +$checkin libpkg.a "../" +$exit + +libpkg.a: + dsswcs.x <imhdr.h> <mwset.h> <math.h> + dbwcs.x <imhdr.h> <mwset.h> <math.h> <pkg/skywcs.h> <pkg/cq.h> + parswcs.x <imhdr.h> "../../lib/astrom.h" "../../lib/aimpars.h" \ + <pkg/skywcs.h> + atmwshow.x + ccqseq.x + calcds.x <math.h> + trsteq.x <math.h> + treqst.x + dcmpsv.f + fitsvd.f + ksbsvd.f + varsvd.f + ; diff --git a/noao/astcat/src/awcs/parswcs.x b/noao/astcat/src/awcs/parswcs.x new file mode 100644 index 00000000..56cf33f2 --- /dev/null +++ b/noao/astcat/src/awcs/parswcs.x @@ -0,0 +1,251 @@ +include <imhdr.h> +include "../../lib/astrom.h" +include "../../lib/aimpars.h" +include <pkg/skywcs.h> + + +# AT_PARWCS -- Compute a FITS WCS from an image using WCS definitions +# read from the AWCSPARS parameter file and stored in the astromery +# package descriptor. At the moment I am going to keep this routine simple +# by not worrying about the units of any quantities but the world coordinates +# of the reference point. This routine can be made more sophisticated later +# as time permits. The information is there ... + +int procedure at_parwcs (im, at, update, verbose) + +pointer im #I the input image descriptor +pointer at #I the astrometry package descriptor +bool update #I update rather than list the wcs +bool verbose #I verbose mode ? + +double xref, yref, xmag, ymag, xrot, yrot, lngref, latref, dval +pointer sp, wfield, wtype, ctype, wcst, sym, coo, mw +int i, wkey, lngunits, latunits, coostat, stat +double at_imhms(), imgetd(), at_statd() +pointer at_statp(), stfind() +int at_wrdstr(), at_stati(), sk_decwcs() +bool streq() +errchk imgetd() + +begin + # Return if the input is not 2D. + if (IM_NDIM(im) != 2) + return (ERR) + + # Return if the wcs pointer is undefined. + if (at_statp (at, PWCS) == NULL) + return (ERR) + + # Return if the keyword symbol table is undefined. + wcst = at_statp (at, WCST) + if (wcst == NULL) + return (ERR) + + # Allocate working space. + call smark (sp) + call salloc (wfield, SZ_FNAME, TY_CHAR) + call salloc (wtype, SZ_FNAME, TY_CHAR) + call salloc (ctype, SZ_FNAME, TY_CHAR) + + # Initialize. + xref = (1.0d0 + IM_LEN(im,1)) / 2.0d0 + yref = (1.0d0 + IM_LEN(im,2)) / 2.0d0 + xmag = INDEFD + ymag = INDEFD + xrot = 180.0d0 + yrot= 0.0d0 + lngref = INDEFD + latref = INDEFD + lngunits = 0 + latunits = 0 + call strcpy ("tan", Memc[wtype], SZ_FNAME) + call strcpy ("J2000", Memc[ctype], SZ_FNAME) + + do i = 1, AT_NWFIELDS { + + # Which keyword have we got ? + wkey = at_wrdstr (i, Memc[wfield], SZ_FNAME, AT_WFIELDS) + + switch (wkey) { + + # Get the x reference point in pixels. + case WCS_WXREF: + sym = stfind (wcst, Memc[wfield]) + if (sym != NULL) { + if (streq (AT_WCSTKVAL(sym), "INDEF")) + dval = at_statd (at, WXREF) + else iferr (dval = imgetd (im, AT_WCSTKVAL(sym))) + dval = at_statd (at, WXREF) + } else + dval = at_statd (at, WXREF) + if (! IS_INDEFD(dval)) + xref = dval + + case WCS_WYREF: + sym = stfind (wcst, Memc[wfield]) + if (sym != NULL) { + if (streq (AT_WCSTKVAL(sym), "INDEF")) + dval = at_statd (at, WYREF) + else iferr (dval = imgetd (im, AT_WCSTKVAL(sym))) + dval = at_statd (at, WYREF) + } else + dval = at_statd (at, WYREF) + if (! IS_INDEFD(dval)) + yref = dval + + case WCS_WXMAG: + sym = stfind (wcst, Memc[wfield]) + if (sym != NULL) { + if (streq (AT_WCSTKVAL(sym), "INDEF")) + dval = at_statd (at, WXMAG) + else iferr (dval = imgetd (im, AT_WCSTKVAL(sym))) + dval = at_statd (at, WXMAG) + } else + dval = at_statd (at, WXMAG) + if (! IS_INDEFD(dval)) + xmag = dval + + case WCS_WYMAG: + sym = stfind (wcst, Memc[wfield]) + if (sym != NULL) { + if (streq (AT_WCSTKVAL(sym), "INDEF")) + dval = at_statd (at, WYMAG) + else iferr (dval = imgetd (im, AT_WCSTKVAL(sym))) + dval = at_statd (at, WYMAG) + } else + dval = at_statd (at, WYMAG) + if (! IS_INDEFD(dval)) + ymag = dval + + case WCS_WXROT: + sym = stfind (wcst, Memc[wfield]) + if (sym != NULL) { + if (streq (AT_WCSTKVAL(sym), "INDEF")) + dval = at_statd (at, WXROT) + else iferr (dval = imgetd (im, AT_WCSTKVAL(sym))) + dval = at_statd (at, WXROT) + } else + dval = at_statd (at, WXROT) + if (! IS_INDEFD(dval)) + xrot = dval + + case WCS_WYROT: + sym = stfind (wcst, Memc[wfield]) + if (sym != NULL) { + if (streq (AT_WCSTKVAL(sym), "INDEF")) + dval = at_statd (at, WYROT) + else iferr (dval = imgetd (im, AT_WCSTKVAL(sym))) + dval = at_statd (at, WYROT) + } else + dval = at_statd (at, WYROT) + if (! IS_INDEFD(dval)) + yrot = dval + + case WCS_WRAREF: + sym = stfind (wcst, Memc[wfield]) + if (sym != NULL) { + if (streq (AT_WCSTKVAL(sym), "INDEF")) + dval = at_statd (at, WRAREF) + else { + dval = at_imhms (im, AT_WCSTKVAL(sym)) + if (IS_INDEFD(dval)) { + iferr (dval = imgetd (im, AT_WCSTKVAL(sym))) + dval = at_statd (at, WRAREF) + } + } + } else + dval = at_statd (at, WRAREF) + if (! IS_INDEFD(dval)) + lngref = dval + + case WCS_WDECREF: + sym = stfind (wcst, Memc[wfield]) + if (sym != NULL) { + if (streq (AT_WCSTKVAL(sym), "INDEF")) + dval = at_statd (at, WDECREF) + else { + dval = at_imhms (im, AT_WCSTKVAL(sym)) + if (IS_INDEFD(dval)) { + iferr (dval = imgetd (im, AT_WCSTKVAL(sym))) + dval = at_statd (at, WDECREF) + } + } + } else + dval = at_statd (at, WDECREF) + if (! IS_INDEFD(dval)) + latref = dval + + case WCS_WRAUNITS: + lngunits = at_stati (at, WRAUNITS) + + case WCS_WDECUNITS: + latunits = at_stati (at, WDECUNITS) + + case WCS_WPROJ: + sym = stfind (wcst, Memc[wfield]) + if (sym != NULL) { + if (streq (AT_WCSTKVAL(sym), "INDEF")) + call at_stats (at, WPROJ, Memc[wtype], SZ_FNAME) + else iferr (call imgstr (im, AT_WCSTKVAL(sym), Memc[wtype], + SZ_FNAME)) + call at_stats (at, WPROJ, Memc[wtype], SZ_FNAME) + } else + call at_stats (at, WPROJ, Memc[wtype], SZ_FNAME) + if (streq (Memc[wtype], "INDEF")) + call strcpy ("tan", Memc[wtype], SZ_FNAME) + + case WCS_WSYSTEM: + sym = stfind (wcst, Memc[wfield]) + if (sym != NULL) { + if (streq (AT_WCSTKVAL(sym), "INDEF")) + call at_stats (at, WSYSTEM, Memc[ctype], SZ_FNAME) + else iferr (call imgstr (im, AT_WCSTKVAL(sym), Memc[ctype], + SZ_FNAME)) + call at_stats (at, WSYSTEM, Memc[ctype], SZ_FNAME) + } else + call at_stats (at, WSYSTEM, Memc[ctype], SZ_FNAME) + if (streq (Memc[ctype], "INDEF")) + call strcpy ("J2000", Memc[ctype], SZ_FNAME) + + default: + ; + } + } + + # Update the header. + if (IS_INDEFD(xmag) || IS_INDEFD(ymag) || IS_INDEFD(lngref) || + IS_INDEFD(latref)) { + + stat = ERR + + } else { + + # Open coordinate system struct + coostat = sk_decwcs (Memc[ctype], mw, coo, NULL) + + if (coostat == ERR || mw != NULL) { + if (mw != NULL) + call mw_close (mw) + stat = ERR + } else { + if (verbose) + call printf ( + " Writing FITS wcs using default parameters\n") + if (lngunits > 0) + call sk_seti (coo, S_NLNGUNITS, lngunits) + if (latunits > 0) + call sk_seti (coo, S_NLATUNITS, latunits) + call at_uwcs (im, coo, Memc[wtype], lngref, latref, xref, + yref, xmag, ymag, xrot, yrot, false, update) + stat = OK + } + + # Close the coordinate structure + if (coo != NULL) + call sk_close (coo) + } + + call sfree (sp) + + return (stat) +end diff --git a/noao/astcat/src/awcs/treqst.x b/noao/astcat/src/awcs/treqst.x new file mode 100644 index 00000000..c4cd27e5 --- /dev/null +++ b/noao/astcat/src/awcs/treqst.x @@ -0,0 +1,49 @@ +# This routine was copied from the stsdas$pkg/analysis/gasp/gasplib/ +# directory. See stsdas$copyright.stsdas for copyright restrictions. +# + +define ARCSEC_PER_RADIAN 206264.8062470964d0 + +# TREQST -- Procedure to convert RA and Dec to standard coordinates +# given the plate centre. + +procedure treqst (plate_centre_ra, plate_centre_dec, object_ra, object_dec, + xi_object, eta_object) + +double plate_centre_ra #I plate ra center (radians) +double plate_centre_dec #I plate dec center (radians) +double object_ra #I object ra center (radians) +double object_dec #I object dec center (radians) +double xi_object #O object xi standard coordinate (arcsecs) +double eta_object #O object eta standard coordinate (arcsecs) + +#double div +double ra, cosra, sinra, cosdec, sindec, cosd0, sind0, cosdist + +begin + ra = object_ra - plate_centre_ra + cosra = cos (ra) + sinra = sin (ra) + cosdec = cos (object_dec) + sindec = sin (object_dec) + cosd0 = cos (plate_centre_dec) + sind0 = sin (plate_centre_dec) + cosdist = sindec * sind0 + cosdec * cosd0 * cosra + xi_object = cosdec * sinra * ARCSEC_PER_RADIAN / cosdist + eta_object = (sindec * cosd0 - cosdec * sind0 * cosra) * + ARCSEC_PER_RADIAN / cosdist + +# # Find the divisor. +# div = (sin(object_dec) * sin(plate_centre_dec) + +# cos(object_dec) * cos(plate_centre_dec) * +# cos(object_ra -plate_centre_ra)) +# +# # Compute standard coords and convert to arcsec +# xi_object = cos(object_dec) * sin(object_ra-plate_centre_ra) * +# ARCSEC_PER_RADIAN/div +# eta_object = (sin(object_dec) * cos(plate_centre_dec) - +# cos(object_dec) * dsin(plate_centre_dec) * +# cos(object_ra - plate_centre_ra)) * +# ARCSEC_PER_RADIAN/div + +end diff --git a/noao/astcat/src/awcs/trsteq.x b/noao/astcat/src/awcs/trsteq.x new file mode 100644 index 00000000..5fa5ea8e --- /dev/null +++ b/noao/astcat/src/awcs/trsteq.x @@ -0,0 +1,64 @@ +# This routine was copied from stsdas$pkg/asnalysis/gasp/gasplib/. See +# stsdas$copyright.stsdas for copyright restrictions. +# +include <math.h> + +define ARCSEC_PER_RADIAN 206264.8062470964d0 + +# TRSTEQ -- Procedure to compute the RA and DEC from the standard coordinates +# given the plate centre. + +procedure trsteq (plate_centre_ra, plate_centre_dec, xi, eta, ra, dec) + +double plate_centre_ra #I plate center ra (radians) +double plate_centre_dec #I plate center dec (radians) +double xi #I xi standard coordinate (arcsec) +double eta #I eta standard coordinate (arcsec) +double ra #O ra (radians) +double dec #O dec (radians) + +#double object_xi, object_eta, numerator, denominator +double object_xi, object_eta, x, y, z + +begin + # Convert from arcseconds to radians. + object_xi = xi/ARCSEC_PER_RADIAN + object_eta = eta/ARCSEC_PER_RADIAN + + # Convert to RA and Dec + x = cos (plate_centre_dec) - object_eta * sin (plate_centre_dec) + y = object_xi + z = sin (plate_centre_dec) + object_eta * cos (plate_centre_dec) + + if (x == 0.0d0 && y == 0.0d0) + ra = 0.0d0 + else + ra = atan2 (y, x) + dec = atan2 (z, sqrt (x * x + y * y)) + ra = ra + plate_centre_ra + if (ra < 0.0d0) + ra = ra + DTWOPI + else if (ra > DTWOPI) + ra = ra - DTWOPI + +## numerator = object_xi / dcos(plate_centre_dec) +# numerator = object_xi +# +## denominator = 1.0d0 - object_eta * dtan(plate_centre_dec) +# denominator = cos (plate_centre_dec) - +# object_eta * sin (plate_centre_dec) +# ra = atan2 (numerator,denominator) + plate_centre_ra +# if (ra < 0.0d0) +# ra = ra + DTWOPI +# else if (ra > DTWOPI) +# ra = ra - DTWOPI +# +## numerator = dcos(ra-plate_centre_ra) * +## (object_eta + dtan(plate_centre_dec)) +# numerator = cos (ra - plate_centre_ra) * +# (cos (plate_centre_dec) * object_eta + sin (plate_centre_dec)) +## denominator = 1.0d0 - object_eta * dtan(plate_centre_dec) +# denominator = cos (plate_centre_dec) - object_eta * +# sin (plate_centre_dec) +# dec = atan2 (numerator, denominator) +end diff --git a/noao/astcat/src/awcs/varsvd.f b/noao/astcat/src/awcs/varsvd.f new file mode 100644 index 00000000..b779a1e0 --- /dev/null +++ b/noao/astcat/src/awcs/varsvd.f @@ -0,0 +1,24 @@ +C This routine was copied from stsdas$pkg/analysis/gasp/gasplib/. +C See stsdas$copyright.stsdas for copyright restrictions. +C + subroutine varsvd (v,ma,w,cvm,ncvm) + parameter (mmax=20) + real*8 v(ma,ma),w(ma),cvm(ncvm,ncvm),wti(mmax) + real*8 sum + + do i=1,ma + wti(i)=0. + if(w(i).ne.0.0d0) wti(i)=1./(w(i)*w(i)) + enddo + do i=1,ma + do j=1,i + sum=0. + do k=1,ma + sum=sum+v(i,k)*v(j,k)*wti(k) + enddo + cvm(i,j)=sum + cvm(j,i)=sum + enddo + enddo + return + end diff --git a/noao/astcat/src/awcspars.par b/noao/astcat/src/awcspars.par new file mode 100644 index 00000000..9bf51d8a --- /dev/null +++ b/noao/astcat/src/awcspars.par @@ -0,0 +1,18 @@ +# The AWCSPARS parameter set + +wxref,s,h,"INDEF",,,"The x axis reference pixel" +wyref,s,h,"INDEF",,,"The y axis reference pixel" +wxmag,s,h,"INDEF",,,"The x axis image scale in arcseconds per pixel" +wymag,s,h,"INDEF",,,"The y axis image scale in arcseconds per pixel" +wxrot,s,h,"180.0",,,"The x axis rotation in degrees" +wyrot,s,h,"0.0",,,"The y axis rotation in degrees" +wraref,s,h,"RA",,,"The ra / longitude of the image reference point" +wdecref,s,h,"DEC",,,"The dec / latitude of the image reference point" +wraunits,s,h,"",,,The ra / longitude reference units +wdecunits,s,h,"",,,The dec / latitude reference units +wproj,s,h,tan,,,"The image projection geometry" +wsystem,s,h,"EQUINOX",,,"The image coordinate system" +#wradecsys,s,h,"RADECSYS",,,The equatorial reference frame +#wequinox,s,h,"EQUINOX",,,The equinox in years +#wmjdobs,s,h,"MJD-OBS",,,The MJD of the observation +mode,s,h,"ql",,, diff --git a/noao/astcat/src/debug/mkpkg b/noao/astcat/src/debug/mkpkg new file mode 100644 index 00000000..9546b422 --- /dev/null +++ b/noao/astcat/src/debug/mkpkg @@ -0,0 +1,15 @@ +# Catalog query and access tools subdirectory + +$checkout libpkg.a ".." +$update libpkg.a +$checkin libpkg.a ".." +$exit + +libpkg.a: + t_acqctest.x <pkg/cq.h> + t_acqftest.x <pkg/cq.h> + t_adumpcat.x <fset.h> <pkg/cq.h> + t_adumpim.x <mach.h> <fset.h> <pkg/cq.h> + t_acqitest.x <pkg/cq.h> + zzdebug.x <fset.h> + ; diff --git a/noao/astcat/src/debug/t_acqctest.x b/noao/astcat/src/debug/t_acqctest.x new file mode 100644 index 00000000..e59fb80d --- /dev/null +++ b/noao/astcat/src/debug/t_acqctest.x @@ -0,0 +1,304 @@ +include <pkg/cq.h> + +# T_ACQCTEST -- Test basic catalog database access and query procedures. + +procedure t_acqctest () + +double dval1, dval2 +real width, rval1, rval2 +long lval1, lval2 +pointer cq, sp, reclist, res +int i, ip, catno, nqpars, parno, nres, recptr, nchars, foffset, fsize +int ftype, nfields, ival1, ival2 +short sval1, sval2 +char database[SZ_FNAME], record[SZ_LINE], ra[SZ_FNAME], dec[SZ_FNAME] +char str[SZ_FNAME], catalog[SZ_LINE] +char qpname[CQ_SZ_QPNAME], qpvalue[CQ_SZ_QPVALUE], qpunits[CQ_SZ_QPUNITS] +char qpformats[CQ_SZ_QPFMTS] + +real clgetr() +pointer cq_map(), cq_query() +int cq_stati(), cq_statt(), cq_setcat(), cq_setcatn(), cq_nqpars() +int cq_gqpar(), cq_gqparn(), cq_sqpar(), ctod(), cq_rstati() +int cq_gnrecord(), cq_grecord(), cq_finfon(), cq_finfo(), cq_fname() +int cq_foffset(), cq_fsize(), cq_ftype(), cq_gvali(), cq_hinfo() +int cq_gvalc(), cq_gvald(), cq_gvalr(), cq_gvall(), cq_gvals(), cq_hinfon() +bool streq() + +begin + # Get the database and record names. + call clgstr ("record", record, SZ_LINE) + call clgstr ("ra", ra, SZ_FNAME) + call clgstr ("dec", dec, SZ_FNAME) + width = clgetr ("width") + call clgstr ("database", database, SZ_FNAME) + + # Map the database. + cq = cq_map (database, READ_ONLY) + + # Print the database file name and number of records. + call cq_stats (cq, CQCATDB, database, SZ_FNAME) + call printf ("\nDatabase: %s Nrecs: %d\n\n") + call pargstr (database) + call pargi (cq_stati (cq, CQNRECS)) + + # Print the record list. + call printf ("Szreclist = %d characters\n") + call pargi (cq_stati (cq, CQSZRECLIST)) + + call smark (sp) + call salloc (reclist, cq_stati(cq, CQSZRECLIST), TY_CHAR) + if (cq_statt (cq, CQRECLIST, Memc[reclist], cq_stati(cq, + CQSZRECLIST)) <= 0) + Memc[reclist] = EOS + call printf ("%s") + call pargstr (Memc[reclist]) + call sfree (sp) + + # Print the current catalog name and number. + call cq_stats (cq, CQCATNAME, catalog, SZ_LINE) + call printf ("\nCurrent catalog: %s index: %d\n") + call pargstr (catalog) + call pargi (cq_stati (cq, CQCATNO)) + + # Set the current catalog by name. + catno = cq_setcat (cq, record) + call cq_stats (cq, CQCATNAME, catalog, SZ_LINE) + call printf ("\nCurrent catalog: %s index: %d\n") + call pargstr (catalog) + call pargi (cq_stati (cq, CQCATNO)) + + # Set the same catalog by number. + catno = cq_setcatn (cq, catno) + call cq_stats (cq, CQCATNAME, catalog, SZ_LINE) + call printf ("\nCurrent catalog: %s index: %d\n\n") + call pargstr (catalog) + call pargi (cq_stati (cq, CQCATNO)) + + # Set the query parameters. Don't worry about units in this case. + nqpars = cq_nqpars (cq) + do i = 1, nqpars { + + # Get description of each query parameter. + parno = cq_gqparn (cq, i, qpname, CQ_SZ_QPNAME, qpvalue, + CQ_SZ_QPVALUE, qpunits, CQ_SZ_QPUNITS, qpformats, CQ_SZ_QPFMTS) + call printf ("parno: %d %s %s %s %s\n") + call pargi (parno) + call pargstr (qpname) + call pargstr (qpvalue) + call pargstr (qpunits) + call pargstr (qpformats) + parno = cq_gqpar (cq, qpname, qpname, CQ_SZ_QPNAME, qpvalue, + CQ_SZ_QPVALUE, qpunits, CQ_SZ_QPUNITS, qpformats, CQ_SZ_QPFMTS) + call printf ("parno: %d %s %s %s %s\n") + call pargi (parno) + call pargstr (qpname) + call pargstr (qpvalue) + call pargstr (qpunits) + call pargstr (qpformats) + + + # Set the astrometric parameters. + if (streq (qpname, "ra")) { + ip = 1 + if (ctod (ra, ip, dval1) > 0) { + call sprintf (ra, SZ_FNAME, qpformats) + call pargd (dval1) + } + parno = cq_sqpar (cq, qpname, ra) + } else if (streq (qpname, "dec")) { + ip = 1 + if (ctod (dec, ip, dval1) > 0) { + if (dval1 >= 0.0) { + #dec[1] = '+' + #call sprintf (dec[2], SZ_FNAME - 1, qpformats) + call sprintf (dec, SZ_FNAME, qpformats) + } else { + call sprintf (dec, SZ_FNAME, qpformats) + } + call pargd (dval1) + } + parno = cq_sqpar (cq, qpname, dec) + } else if (streq (qpname, "width")) { + call sprintf (str, SZ_FNAME, qpformats) + call pargr (width) + parno = cq_sqpar (cq, qpname, str) + } else if (streq (qpname, "radius")) { + call sprintf (str, SZ_FNAME, qpformats) + call pargr (width / 2.0) + parno = cq_sqpar (cq, qpname, str) + } + + } + call flush (STDOUT) + + # Send the query and get back the results. + res = cq_query (cq) + if (res == NULL) + return + + call cq_rstats (res, CQRADDRESS, str, SZ_FNAME) + call printf ("\nraddress: %s\n") + call pargstr (str) + call cq_rstats (res, CQRQUERY, str, SZ_FNAME) + call printf ("rquery: %s\n") + call pargstr (str) + call cq_rstats (res, CQRQPNAMES, str, SZ_FNAME) + call printf ("rqpnames:%s\n") + call pargstr (str) + call cq_rstats (res, CQRQPVALUES, str, SZ_FNAME) + call printf ("rqpvalues:%s\n") + call pargstr (str) + + # Get the number of header parameters. + nfields = cq_rstati (res, CQNHEADER) + call printf ("nheader = %d\n") + call pargi (nfields) + + # Print the information for each field. + do i = 1, nfields { + if (cq_hinfon (res, i, qpname, CQ_SZ_QPNAME, record, SZ_LINE) <= 0) + next + call printf ("keyword: %d %s %s\n") + call pargi (i) + call pargstr (qpname) + call pargstr (record) + if (cq_hinfo (res, qpname, record, SZ_LINE) <= 0) + next + call printf ("keyword: %d %s %s\n") + call pargi (i) + call pargstr (qpname) + call pargstr (record) + } + call printf ("\n") + + # Get the number of fields. + nfields = cq_rstati (res, CQNFIELDS) + call printf ("nfields = %d\n") + call pargi (nfields) + + # Print the information for each field. + do i = 1, nfields { + if (cq_finfon (res, i, qpname, CQ_SZ_FNAME, foffset, fsize, + ftype, qpunits, CQ_SZ_FUNITS, qpformats, CQ_SZ_FFMTS) <= 0) + next + call printf ("field: %d %s %d %d %d %s %s\n") + call pargi (i) + call pargstr (qpname) + call pargi (foffset) + call pargi (fsize) + call pargi (ftype) + call pargstr (qpunits) + call pargstr (qpformats) + if (cq_finfo (res, qpname, foffset, fsize, ftype, qpunits, + CQ_SZ_FUNITS, qpformats, CQ_SZ_FFMTS) <= 0) + next + call printf ("field: %d %s %d %d %d %s %s\n") + call pargi (i) + call pargstr (qpname) + call pargi (foffset) + call pargi (fsize) + call pargi (ftype) + call pargstr (qpunits) + call pargstr (qpformats) + if (cq_fname (res, i, qpname, CQ_SZ_FNAME) <= 0) + next + foffset = cq_foffset (res, qpname) + fsize = cq_fsize (res, qpname) + ftype = cq_ftype (res, qpname) + call cq_funits (res, qpname, qpunits, CQ_SZ_FUNITS) + call cq_ffmts (res, qpname, qpformats, CQ_SZ_FFMTS) + call printf ("field: %d %s %d %d %d %s %s\n") + call pargi (i) + call pargstr (qpname) + call pargi (foffset) + call pargi (fsize) + call pargi (ftype) + call pargstr (qpunits) + call pargstr (qpformats) + } + call printf ("\n") + + # Get the number of records. + nres = cq_rstati (res, CQRNRECS) + call printf ("nrecords = %d\n") + call pargi (nres) + + # Loop through and print the records. + recptr = 0 + while (recptr < nres) { + nchars = cq_gnrecord (res, record, SZ_LINE, recptr) + if (nchars == EOF) + break + call printf ("record %4d %4d %s") + call pargi (recptr) + call pargi (nchars) + call pargstr (record) + } + + # Find and print records at random. + record[1] = EOS + nchars = cq_grecord (res, record, SZ_LINE, 1) + call printf ("\nrecord %4d %4d %s") + call pargi (1) + call pargi (nchars) + call pargstr (record) + + record[1] = EOS + nchars = cq_grecord (res, record, SZ_LINE, (1 + nres) / 2) + call printf ("record %4d %4d %s") + call pargi ((1 + nres) / 2) + call pargi (nchars) + call pargstr (record) + + record[1] = EOS + nchars = cq_grecord (res, record, SZ_LINE, nres) + call printf ("record %4d %4d %s") + call pargi (nres) + call pargi (nchars) + call pargstr (record) + + # Loop through the records and decode the ra and dec fields as + # char, double precision, real precision, and integer fields. + call printf ("\nra dec\n") + do i = 1, nres { + call printf ("rec %d\n") + call pargi (i) + nchars = cq_gvalc (res, i, "ra", ra, SZ_FNAME) + nchars = cq_gvalc (res, i, "dec", dec, SZ_FNAME) + call printf (" %s %s\n") + call pargstr (ra) + call pargstr (dec) + nchars = cq_gvald (res, i, "ra", dval1) + nchars = cq_gvald (res, i, "dec", dval2) + call printf (" %h %h\n") + call pargd (dval1) + call pargd (dval2) + nchars = cq_gvalr (res, i, "ra", rval1) + nchars = cq_gvalr (res, i, "dec", rval2) + call printf (" %h %h\n") + call pargr (rval1) + call pargr (rval2) + nchars = cq_gvall (res, i, "ra", lval1) + nchars = cq_gvall (res, i, "dec", lval2) + call printf (" %h %h\n") + call pargl (lval1) + call pargl (lval2) + nchars = cq_gvali (res, i, "ra", ival1) + nchars = cq_gvali (res, i, "dec", ival2) + call printf (" %h %h\n") + call pargi (ival1) + call pargi (ival2) + nchars = cq_gvals (res, i, "ra", sval1) + nchars = cq_gvals (res, i, "dec", sval2) + call printf (" %h %h\n") + call pargs (sval1) + call pargs (sval2) + } + + # Close the query descriptor. + call cq_rclose (res) + + # Unmap the database. + call cq_unmap (cq) +end diff --git a/noao/astcat/src/debug/t_acqftest.x b/noao/astcat/src/debug/t_acqftest.x new file mode 100644 index 00000000..fd896fb7 --- /dev/null +++ b/noao/astcat/src/debug/t_acqftest.x @@ -0,0 +1,244 @@ +include <pkg/cq.h> + +# T_ACQFTEXT -- Procedure to use the catalog access API routines to make +# an astrometry text file look like the results of a database query. +# There are two cases: 1) the astrometry file has a simple header record +# generated by an astrometry package routine and 2) the calling program +# get this information from another source and set it. + +procedure t_acqftest() + +double dval1, dval2 +real rval1, rval2 +long lval1, lval2 +int ival1, ival2 +short sval1, sval2 + +pointer cq, res +int i, catno, nqpars, fd, nlines, nfields, nres, foffset, fsize, ftype +int recptr, nchars +char textfile[SZ_FNAME], record[SZ_FNAME], database[SZ_FNAME] +char catalog[SZ_FNAME], hdrtext[SZ_LINE], str[SZ_FNAME] +char qpname[CQ_SZ_QPNAME], qpunits[CQ_SZ_QPUNITS], qpformats[CQ_SZ_QPFMTS] +char ra[SZ_FNAME], dec[SZ_FNAME] + +pointer cq_map(), cq_fquery() +int cq_setcat(), cq_stati(), cq_nqpars(), open(), at_gcathdr() +int cq_rstati(), cq_finfon(), cq_finfo(), cq_fname() +int cq_foffset(), cq_ftype(), cq_fsize(), cq_grecord(), cq_gnrecord() +int cq_gvali(), at_pcathdr(), cq_hinfon(), cq_hinfo() +int cq_gvald(), cq_gvalr(), cq_gvall(), cq_gvals(), cq_gvalc() + +begin + # Get the parameters. + call clgstr ("textfile", textfile, SZ_FNAME) + call clgstr ("record", record, SZ_FNAME) + call clgstr ("database", database, SZ_FNAME) + + # Map the database. + cq = cq_map (database, READ_ONLY) + + # Set the current catalog by name. In this case the catalog record + # is the dummy record "text". + catno = cq_setcat (cq, record) + call cq_stats (cq, CQCATNAME, catalog, SZ_LINE) + call printf ("\nCurrent catalog: %s index: %d\n") + call pargstr (catalog) + call pargi (cq_stati (cq, CQCATNO)) + call flush (STDOUT) + + # Get the number of query parameters. This should be zero in this + # case. + nqpars = cq_nqpars (cq) + call printf ("nqpars = %d\n") + call pargi (nqpars) + + # Read the catalog header. + fd = open (textfile, READ_ONLY, TEXT_FILE) + nlines = at_gcathdr (fd, hdrtext, SZ_LINE) + call printf ("catalog header text: nlines = %d\n%s\n") + call pargi (nlines) + call pargstr (hdrtext) + call close (fd) + + # If the catalog has no header then create one from the acatpars + # pset. + if (nlines <= 0) { + nlines = at_pcathdr ("acatpars", hdrtext, SZ_LINE) + call printf ("catalog header text: nlines = %d\n%s\n") + call pargi (nlines) + call pargstr (hdrtext) + } + + # Read in the catalog and make it look like a query. + res = cq_fquery (cq, textfile, hdrtext) + if (res == NULL) + return + + # Print basic query info. + call cq_rstats (res, CQRADDRESS, str, SZ_FNAME) + call printf ("\nraddress: %s\n") + call pargstr (str) + call cq_rstats (res, CQRQUERY, str, SZ_FNAME) + call printf ("rquery: %s\n") + call pargstr (str) + call cq_rstats (res, CQRQPNAMES, str, SZ_FNAME) + call printf ("rqpnames:%s\n") + call pargstr (str) + call cq_rstats (res, CQRQPVALUES, str, SZ_FNAME) + call printf ("rqpvalues:%s\n") + call pargstr (str) + + # Get the number of keywords. + nfields = cq_rstati (res, CQNHEADER) + call printf ("nheader = %d\n") + call pargi (nfields) + + # Print information for each keyword. + do i = 1, nfields { + if (cq_hinfon (res, i, qpname, CQ_SZ_QPNAME, record, SZ_LINE) <= 0) + next + call printf ("keyword: %d %s %s\n") + call pargi (i) + call pargstr (qpname) + call pargstr (record) + if (cq_hinfo (res, qpname, record, SZ_LINE) <= 0) + next + call printf ("keyword: %d %s %s\n") + call pargi (i) + call pargstr (qpname) + call pargstr (record) + } + call printf ("\n") + + # Get the number of fields. + nfields = cq_rstati (res, CQNFIELDS) + call printf ("nfields = %d\n") + call pargi (nfields) + + # Print the information for each field. + do i = 1, nfields { + if (cq_finfon (res, i, qpname, CQ_SZ_FNAME, foffset, fsize, + ftype, qpunits, CQ_SZ_FUNITS, qpformats, CQ_SZ_FFMTS) <= 0) + next + call printf ("field: %d %s %d %d %d %s %s\n") + call pargi (i) + call pargstr (qpname) + call pargi (foffset) + call pargi (fsize) + call pargi (ftype) + call pargstr (qpunits) + call pargstr (qpformats) + if (cq_finfo (res, qpname, foffset, fsize, ftype, qpunits, + CQ_SZ_FUNITS, qpformats, CQ_SZ_FFMTS) <= 0) + next + call printf ("field: %d %s %d %d %d %s %s\n") + call pargi (i) + call pargstr (qpname) + call pargi (foffset) + call pargi (fsize) + call pargi (ftype) + call pargstr (qpunits) + call pargstr (qpformats) + if (cq_fname (res, i, qpname, CQ_SZ_FNAME) <= 0) + next + foffset = cq_foffset (res, qpname) + fsize = cq_fsize (res, qpname) + ftype = cq_ftype (res, qpname) + call cq_funits (res, qpname, qpunits, CQ_SZ_FUNITS) + call cq_ffmts (res, qpname, qpformats, CQ_SZ_FFMTS) + call printf ("field: %d %s %d %d %d %s %s\n") + call pargi (i) + call pargstr (qpname) + call pargi (foffset) + call pargi (fsize) + call pargi (ftype) + call pargstr (qpunits) + call pargstr (qpformats) + } + call printf ("\n") + + # Get the number of records. + nres = cq_rstati (res, CQRNRECS) + call printf ("nrecords = %d\n") + call pargi (nres) + + # Loop through and print the records. + recptr = 0 + while (recptr < nres) { + nchars = cq_gnrecord (res, record, SZ_LINE, recptr) + if (nchars == EOF) + break + call printf ("record %4d %4d %s") + call pargi (recptr) + call pargi (nchars) + call pargstr (record) + } + + # Find and print records at random. + record[1] = EOS + nchars = cq_grecord (res, record, SZ_LINE, 1) + call printf ("\nrecord %4d %4d %s") + call pargi (1) + call pargi (nchars) + call pargstr (record) + + record[1] = EOS + nchars = cq_grecord (res, record, SZ_LINE, (1 + nres) / 2) + call printf ("record %4d %4d %s") + call pargi ((1 + nres) / 2) + call pargi (nchars) + call pargstr (record) + + record[1] = EOS + nchars = cq_grecord (res, record, SZ_LINE, nres) + call printf ("record %4d %4d %s") + call pargi (nres) + call pargi (nchars) + call pargstr (record) + + # Loop through the records and decode the ra and dec fields as + # char, double precision, real precision, and integer fields. + call printf ("\nra dec\n") + do i = 1, nres { + call printf ("rec %d\n") + call pargi (i) + nchars = cq_gvalc (res, i, "ra", ra, SZ_FNAME) + nchars = cq_gvalc (res, i, "dec", dec, SZ_FNAME) + call printf (" %s %s\n") + call pargstr (ra) + call pargstr (dec) + nchars = cq_gvald (res, i, "ra", dval1) + nchars = cq_gvald (res, i, "dec", dval2) + call printf (" %h %h\n") + call pargd (dval1) + call pargd (dval2) + nchars = cq_gvalr (res, i, "ra", rval1) + nchars = cq_gvalr (res, i, "dec", rval2) + call printf (" %h %h\n") + call pargr (rval1) + call pargr (rval2) + nchars = cq_gvall (res, i, "ra", lval1) + nchars = cq_gvall (res, i, "dec", lval2) + call printf (" %h %h\n") + call pargl (lval1) + call pargl (lval2) + nchars = cq_gvali (res, i, "ra", ival1) + nchars = cq_gvali (res, i, "dec", ival2) + call printf (" %h %h\n") + call pargi (ival1) + call pargi (ival2) + nchars = cq_gvals (res, i, "ra", sval1) + nchars = cq_gvals (res, i, "dec", sval2) + call printf (" %h %h\n") + call pargs (sval1) + call pargs (sval2) + } + + + # Close the query. + call cq_rclose (res) + + # Unmap the database. + call cq_unmap (cq) +end diff --git a/noao/astcat/src/debug/t_acqitest.x b/noao/astcat/src/debug/t_acqitest.x new file mode 100644 index 00000000..56e532ec --- /dev/null +++ b/noao/astcat/src/debug/t_acqitest.x @@ -0,0 +1,220 @@ +include <pkg/cq.h> + +# T_ACQITEST -- Test basic catalog database access and query procedures. + +procedure t_acqitest () + +double dval1 +real width +pointer cq, sp, reclist, res +int i, ip, catno, nqpars, parno, ftype, nfields +char database[SZ_FNAME], record[SZ_LINE], ra[SZ_FNAME], dec[SZ_FNAME] +char str[SZ_FNAME], catalog[SZ_LINE], imname[SZ_LINE] +char qpname[CQ_SZ_QPNAME], qkname[CQ_SZ_QPNAME], qpvalue[CQ_SZ_QPVALUE] +char qpunits[CQ_SZ_QPUNITS], qpformats[CQ_SZ_QPFMTS] + +real clgetr() +pointer cq_map(), cq_imquery() +int cq_stati(), cq_statt(), cq_setcat(), cq_setcatn(), cq_nqpars() +int cq_gqpar(), cq_gqparn(), cq_sqpar(), ctod(), cq_istati() +int cq_winfon(), cq_winfo(), cq_kinfon(), cq_kinfo() +bool streq() + +begin + # Get the database and record names. + call clgstr ("record", record, SZ_LINE) + call clgstr ("image", imname, SZ_LINE) + call clgstr ("ra", ra, SZ_FNAME) + call clgstr ("dec", dec, SZ_FNAME) + width = clgetr ("width") + call clgstr ("database", database, SZ_FNAME) + + # Map the database. + cq = cq_map (database, READ_ONLY) + + # Print the database file name and number of records. + call cq_stats (cq, CQCATDB, database, SZ_FNAME) + call printf ("\nDatabase: %s Nrecs: %d\n\n") + call pargstr (database) + call pargi (cq_stati (cq, CQNRECS)) + + # Print the record list. + call printf ("Szreclist = %d characters\n") + call pargi (cq_stati (cq, CQSZRECLIST)) + + call smark (sp) + call salloc (reclist, cq_stati(cq, CQSZRECLIST), TY_CHAR) + if (cq_statt (cq, CQRECLIST, Memc[reclist], cq_stati(cq, + CQSZRECLIST)) <= 0) + Memc[reclist] = EOS + call printf ("%s") + call pargstr (Memc[reclist]) + call sfree (sp) + + # Print the current catalog name and number. + call cq_stats (cq, CQCATNAME, catalog, SZ_LINE) + call printf ("\nCurrent catalog: %s index: %d\n") + call pargstr (catalog) + call pargi (cq_stati (cq, CQCATNO)) + + # Set the current catalog by name. + catno = cq_setcat (cq, record) + call cq_stats (cq, CQCATNAME, catalog, SZ_LINE) + call printf ("\nCurrent catalog: %s index: %d\n") + call pargstr (catalog) + call pargi (cq_stati (cq, CQCATNO)) + + # Set the same catalog by number. + catno = cq_setcatn (cq, catno) + call cq_stats (cq, CQCATNAME, catalog, SZ_LINE) + call printf ("\nCurrent catalog: %s index: %d\n\n") + call pargstr (catalog) + call pargi (cq_stati (cq, CQCATNO)) + + # Set the query parameters. Don't worry about units in this case. + nqpars = cq_nqpars (cq) + do i = 1, nqpars { + + # Get description of each query parameter. + parno = cq_gqparn (cq, i, qpname, CQ_SZ_QPNAME, qpvalue, + CQ_SZ_QPVALUE, qpunits, CQ_SZ_QPUNITS, qpformats, CQ_SZ_QPFMTS) + call printf ("parno: %d %s %s %s %s\n") + call pargi (parno) + call pargstr (qpname) + call pargstr (qpvalue) + call pargstr (qpunits) + call pargstr (qpformats) + parno = cq_gqpar (cq, qpname, qpname, CQ_SZ_QPNAME, qpvalue, + CQ_SZ_QPVALUE, qpunits, CQ_SZ_QPUNITS, qpformats, CQ_SZ_QPFMTS) + call printf ("parno: %d %s %s %s %s\n") + call pargi (parno) + call pargstr (qpname) + call pargstr (qpvalue) + call pargstr (qpunits) + call pargstr (qpformats) + + + # Set the astrometric parameters. + if (streq (qpname, "ra")) { + ip = 1 + if (ctod (ra, ip, dval1) > 0) { + call sprintf (ra, SZ_FNAME, qpformats) + call pargd (dval1) + } + parno = cq_sqpar (cq, qpname, ra) + } else if (streq (qpname, "dec")) { + ip = 1 + if (ctod (dec, ip, dval1) > 0) { + if (dval1 >= 0.0) { + #dec[1] = '+' + #call sprintf (dec[2], SZ_FNAME - 1, qpformats) + call sprintf (dec, SZ_FNAME, qpformats) + } else { + call sprintf (dec, SZ_FNAME, qpformats) + } + call pargd (dval1) + } + parno = cq_sqpar (cq, qpname, dec) + } else if (streq (qpname, "width")) { + call sprintf (str, SZ_FNAME, qpformats) + call pargr (width) + parno = cq_sqpar (cq, qpname, str) + } else if (streq (qpname, "radius")) { + call sprintf (str, SZ_FNAME, qpformats) + call pargr (width / 2.0) + parno = cq_sqpar (cq, qpname, str) + } + + } + call flush (STDOUT) + + # Send the query and get back the results. + res = cq_imquery (cq, imname) + if (res == NULL) + return + + call cq_istats (res, CQIMADDRESS, str, SZ_FNAME) + call printf ("\nimaddress: %s\n") + call pargstr (str) + call cq_istats (res, CQIMQUERY, str, SZ_FNAME) + call printf ("imquery: %s\n") + call pargstr (str) + call cq_istats (res, CQIQPNAMES, str, SZ_FNAME) + call printf ("iqpnames:%s\n") + call pargstr (str) + call cq_istats (res, CQIQPVALUES, str, SZ_FNAME) + call printf ("iqpvalues:%s\n") + call pargstr (str) + call flush (STDOUT) + + # Get the number of wcs parameters. + call printf ("nheader = 0\n") + nfields = cq_istati (res, CQNWCS) + call printf ("nheader = %d\n") + call pargi (nfields) + call flush (STDOUT) + + # Print the information for each field. + do i = 1, nfields { + if (cq_winfon (res, i, qpname, CQ_SZ_QPNAME, qkname, CQ_SZ_QPNAME, + qpvalue, CQ_SZ_QPVALUE, ftype, qpunits, CQ_SZ_QPUNITS) <= 0) + next + call printf ("keyword: %d %s %s %s %d %s\n") + call pargi (i) + call pargstr (qpname) + call pargstr (qkname) + call pargstr (qpvalue) + call pargi (ftype) + call pargstr (qpunits) + if (cq_winfo (res, qpname, qkname, CQ_SZ_QPNAME, qpvalue, + CQ_SZ_QPVALUE, ftype, qpunits, CQ_SZ_QPUNITS) <= 0) + next + call printf ("keyword: %d %s %s %s %d %s\n") + call pargi (i) + call pargstr (qpname) + call pargstr (qkname) + call pargstr (qpvalue) + call pargi (ftype) + call pargstr (qpunits) + } + call printf ("\n") + call flush (STDOUT) + + # Get the number of fields. + nfields = cq_istati (res, CQNIMPARS) + call printf ("nfields = %d\n") + call pargi (nfields) + call flush (STDOUT) + + # Print the information for each field. + do i = 1, nfields { + if (cq_kinfon (res, i, qpname, CQ_SZ_QPNAME, qkname, CQ_SZ_QPNAME, + qpvalue, CQ_SZ_QPVALUE, ftype, qpunits, CQ_SZ_QPUNITS) <= 0) + next + call printf ("keyword: %d %s %s %s %d %s\n") + call pargi (i) + call pargstr (qpname) + call pargstr (qkname) + call pargstr (qpvalue) + call pargi (ftype) + call pargstr (qpunits) + if (cq_kinfo (res, qpname, qkname, CQ_SZ_QPNAME, qpvalue, + CQ_SZ_QPVALUE, ftype, qpunits, CQ_SZ_QPUNITS) <= 0) + next + call printf ("keyword: %d %s %s %s %d %s\n") + call pargi (i) + call pargstr (qpname) + call pargstr (qkname) + call pargstr (qpvalue) + call pargi (ftype) + call pargstr (qpunits) + } + call printf ("\n") + call flush (STDOUT) + + # Close the query descriptor. + call cq_imclose (res) + + # Unmap the database. + call cq_unmap (cq) +end diff --git a/noao/astcat/src/debug/t_adumpcat.x b/noao/astcat/src/debug/t_adumpcat.x new file mode 100644 index 00000000..de2c9a1c --- /dev/null +++ b/noao/astcat/src/debug/t_adumpcat.x @@ -0,0 +1,164 @@ +include <fset.h> +include <pkg/cq.h> + +define DEF_SZPARS 15 +define DEF_SZBUF 32768 + +procedure t_adumpcat() + +pointer sp, catalog, output, catdb, ra, dec, size +pointer query, qpname, qpvalue, qpunits, qpformats, str, cq, buf +int i, fd, ofd, nqpars, parno, nchars +bool done +pointer cq_map() +int cq_setcat(), ndopen(), open(), cq_nqpars(), cq_gqparn(), read() +int getline() +bool streq() +errchk ndopen() + +begin + # Allocate some working space. + call smark (sp) + call salloc (catalog, SZ_FNAME, TY_CHAR) + call salloc (output, SZ_FNAME, TY_CHAR) + call salloc (catdb, SZ_FNAME, TY_CHAR) + call salloc (ra, DEF_SZPARS, TY_CHAR) + call salloc (dec, DEF_SZPARS, TY_CHAR) + call salloc (size, DEF_SZPARS, TY_CHAR) + call salloc (qpname, CQ_SZ_QPNAME, TY_CHAR) + call salloc (qpvalue, CQ_SZ_QPVALUE, TY_CHAR) + call salloc (qpunits, CQ_SZ_QPUNITS, TY_CHAR) + call salloc (qpformats, CQ_SZ_QPFMTS, TY_CHAR) + call salloc (query, SZ_LINE, TY_CHAR) + call salloc (str, SZ_LINE, TY_CHAR) + call salloc (buf, DEF_SZBUF, TY_CHAR) + + # Get the parameters. + call clgstr ("catalog", Memc[catalog], SZ_FNAME) + call clgstr ("output", Memc[output], SZ_FNAME) + call clgstr ("ra", Memc[ra], DEF_SZPARS) + call clgstr ("dec", Memc[dec], DEF_SZPARS) + call clgstr ("size", Memc[size], DEF_SZPARS) + call clgstr ("catdb", Memc[catdb], SZ_FNAME) + + # Map the catalog configuration file. + cq = cq_map (Memc[catdb], READ_ONLY) + if (cq == NULL) { + call eprintf ("Cannot open catalog configuration file %s\n") + call pargstr (Memc[catdb]) + call sfree (sp) + return + } + + # Locate the catalog record. + if (cq_setcat (cq, Memc[catalog]) <= 0) { + call eprintf ("Cannot locate catalog record %s\n") + call pargstr (Memc[catalog]) + call cq_unmap (cq) + call sfree (sp) + return + } + + # Connect to the HTTP server. + call cq_fgwrd (cq, "address", Memc[str], SZ_LINE) + iferr (fd = ndopen (Memc[str], READ_WRITE)) { + call eprintf ("Cannot access catalog %s at host %s\n") + call pargstr (Memc[catalog]) + call pargstr (Memc[str]) + call cq_unmap (cq) + call sfree (sp) + return + } + + # Open the output file. + ofd = open (Memc[output], NEW_FILE, TEXT_FILE) + + # Format the query without worrying about coordinate systems, + # or formats. Just assume that the user types in ra, dec, and + # size in the form expected by the server. + call cq_fgstr (cq, "query", Memc[query], SZ_LINE) + nqpars = cq_nqpars (cq) + call sprintf (Memc[str], SZ_LINE, Memc[query]) + do i = 1, nqpars { + + # Get description of each query parameter. + parno = cq_gqparn (cq, i, Memc[qpname], CQ_SZ_QPNAME, + Memc[qpvalue], CQ_SZ_QPVALUE, Memc[qpunits], CQ_SZ_QPUNITS, + Memc[qpformats], CQ_SZ_QPFMTS) + + # Pass the parameters to the query string. + if (streq (Memc[qpname], "ra")) { + call pargstr (Memc[ra]) + } else if (streq (Memc[qpname], "dec")) { + call pargstr (Memc[dec]) + } else if (streq (Memc[qpname], "width")) { + call pargstr (Memc[size]) + } else if (streq (Memc[qpname], "xwidth")) { + call pargstr (Memc[size]) + } else if (streq (Memc[qpname], "ywidth")) { + call pargstr (Memc[size]) + } else if (streq (Memc[qpname], "rawidth")) { + call pargstr (Memc[size]) + } else if (streq (Memc[qpname], "decwidth")) { + call pargstr (Memc[size]) + } else if (streq (Memc[qpname], "hwidth")) { + call pargstr (Memc[size]) + } else if (streq (Memc[qpname], "xhwidth")) { + call pargstr (Memc[size]) + } else if (streq (Memc[qpname], "yhwidth")) { + call pargstr (Memc[size]) + } else if (streq (Memc[qpname], "xrawidth")) { + call pargstr (Memc[size]) + } else if (streq (Memc[qpname], "ydecwidth")) { + call pargstr (Memc[size]) + } else if (streq (Memc[qpname], "radius")) { + call pargstr (Memc[size]) + } else { + call pargstr (Memc[qpvalue]) + } + + } + + # Send the query. + call fprintf (fd, "%s") + call pargstr (Memc[str]) + call flush (fd) + call fseti (fd, F_CANCEL, OK) + + # Read the reply. Skip the HTTP header assuming it ends with a \n or + # a \r\n. + call cq_fgwrd (cq, "protocol", Memc[str], SZ_LINE) + if (streq (Memc[str], "http")) { + repeat { + nchars = getline (fd, Memc[buf]) + if (nchars <= 0) + break + Memc[buf+nchars] = EOS + } until ((Memc[buf] == '\r' && Memc[buf+1] == '\n') || + (Memc[buf] == '\n')) + } + + # Read the reply. + repeat { + nchars = read (fd, Memc[buf], DEF_SZBUF) + if (nchars > 0) { + Memc[buf+nchars] = EOS + call write (ofd, Memc[buf], nchars) + done = false + } else { + done = true + } + } until (done) + call flush (ofd) + + # Close the output. + call close (ofd) + + # Close the network connection. + call close (fd) + + # Unmap the database. + call cq_unmap (cq) + + call sfree (sp) +end diff --git a/noao/astcat/src/debug/t_adumpim.x b/noao/astcat/src/debug/t_adumpim.x new file mode 100644 index 00000000..e214b8fd --- /dev/null +++ b/noao/astcat/src/debug/t_adumpim.x @@ -0,0 +1,163 @@ +include <mach.h> +include <fset.h> +include <pkg/cq.h> + +define DEF_SZPARS 15 +define DEF_SZBUF 28800 + +# T_ADUMPIM -- Image survey access debugging routines. + +procedure t_adumpim() + +pointer sp, imsurvey, output, ra, dec, size, imdb, query, buf, str +pointer qpname, qpvalue, qpunits, qpformats, cq +int i, fd, ofd, nqpars, parno, nchars +bool done + +pointer cq_map() +int cq_setcat(), ndopen(), open(), cq_nqpars(), cq_gqparn(), strlen() +int getline(), read() +bool streq() +errchk cq_fgeti() + +begin + # Allocate some working space. + call smark (sp) + call salloc (imsurvey, SZ_FNAME, TY_CHAR) + call salloc (output, SZ_FNAME, TY_CHAR) + call salloc (imdb, SZ_FNAME, TY_CHAR) + call salloc (ra, DEF_SZPARS, TY_CHAR) + call salloc (dec, DEF_SZPARS, TY_CHAR) + call salloc (size, DEF_SZPARS, TY_CHAR) + call salloc (query, SZ_LINE, TY_CHAR) + call salloc (qpname, CQ_SZ_QPNAME, TY_CHAR) + call salloc (qpvalue, CQ_SZ_QPVALUE, TY_CHAR) + call salloc (qpunits, CQ_SZ_QPUNITS, TY_CHAR) + call salloc (qpformats, CQ_SZ_QPFMTS, TY_CHAR) + call salloc (buf, 2*DEF_SZBUF, TY_CHAR) + call salloc (str, SZ_LINE, TY_CHAR) + + # Get the parameters. + call clgstr ("imsurvey", Memc[imsurvey], SZ_FNAME) + call clgstr ("output", Memc[output], SZ_FNAME) + call clgstr ("ra", Memc[ra], DEF_SZPARS) + call clgstr ("dec", Memc[dec], DEF_SZPARS) + call clgstr ("size", Memc[size], DEF_SZPARS) + call clgstr ("imdb", Memc[imdb], SZ_FNAME) + + # Map the image surfvey configuration file. + cq = cq_map (Memc[imdb], READ_ONLY) + if (cq == NULL) { + call eprintf ("Cannot open image survey configuration file %s\n") + call pargstr (Memc[imdb]) + call sfree (sp) + return + } + + # Locate the image survey record. + if (cq_setcat (cq, Memc[imsurvey]) <= 0) { + call eprintf ("Cannot locate image survey record %s\n") + call pargstr (Memc[imsurvey]) + call cq_unmap (cq) + call sfree (sp) + return + } + + # Connect to the HTTP server. + call cq_fgwrd (cq, "address", Memc[str], SZ_LINE) + iferr (fd = ndopen (Memc[str], READ_WRITE)) { + call eprintf ("Cannot access image server %s at host %s\n") + call pargstr (Memc[imsurvey]) + call pargstr (Memc[str]) + call cq_unmap (cq) + call sfree (sp) + return + } + + # Open the output file. + #ofd = open (Memc[output], NEW_FILE, BINARY_FILE) + ofd = open (Memc[output], NEW_FILE, TEXT_FILE) + + # Format the query without worrying about coordinate systems, + # or formats. Just assume that the user types in ra, dec, and + # size in the form expected by the server. + + call cq_fgstr (cq, "query", Memc[query], SZ_LINE) + nqpars = cq_nqpars (cq) + call sprintf (Memc[str], SZ_LINE, Memc[query]) + do i = 1, nqpars { + + # Get description of each query parameter. + parno = cq_gqparn (cq, i, Memc[qpname], CQ_SZ_QPNAME, + Memc[qpvalue], CQ_SZ_QPVALUE, Memc[qpunits], CQ_SZ_QPUNITS, + Memc[qpformats], CQ_SZ_QPFMTS) + + # Pass the parameters to the query string. + if (streq (Memc[qpname], "ra")) { + call pargstr (Memc[ra]) + } else if (streq (Memc[qpname], "dec")) { + call pargstr (Memc[dec]) + } else if (streq (Memc[qpname], "width")) { + call pargstr (Memc[size]) + } else if (streq (Memc[qpname], "xwidth")) { + call pargstr (Memc[size]) + } else if (streq (Memc[qpname], "ywidth")) { + call pargstr (Memc[size]) + } else if (streq (Memc[qpname], "radius")) { + call pargstr (Memc[size]) + } else { + call pargstr (Memc[qpvalue]) + } + + } + + # Send the query. Note that since the communication mode and output + # file type are binary the command must be converted from IRAF chars + # type byte chars. Leave as text for now since it works for FITS + # files. + + nchars = strlen (Memc[str]) + #call chrpak (Memc[str], 1, Memc[str], 1, nchars) + #call awriteb (fd, Memc[str], nchars, 1) + #nread = awaitb (fd) + call write (fd, Memc[str], nchars) + call flush (fd) + call fseti (fd, F_CANCEL, OK) + + # Read the reply. Skip the HTTP header assuming it ends with a \n or + # a \r\n. + call cq_fgstr (cq, "protocol", Memc[str], SZ_LINE) + if (streq (Memc[str], "http")) { + repeat { + nchars = getline (fd, Memc[buf]) + if (nchars <= 0) + break + Memc[buf+nchars] = EOS + } until ((Memc[buf] == '\r' && Memc[buf+1] == '\n') || + (Memc[buf] == '\n')) + } + + repeat { + nchars = read (fd, Memc[buf], DEF_SZBUF) + if (nchars > 0) { + Memc[buf+nchars] = EOS + call write (ofd, Memc[buf], nchars) + done = false + } else { + done =true + } + } until (done) + + call flush (ofd) + + # Close the output image. + call close (ofd) + + # Close the network connection. + call close (fd) + + # Unmap the database. + call cq_unmap (cq) + + call sfree (sp) +end diff --git a/noao/astcat/src/debug/zzdebug.x b/noao/astcat/src/debug/zzdebug.x new file mode 100644 index 00000000..3ee5ad24 --- /dev/null +++ b/noao/astcat/src/debug/zzdebug.x @@ -0,0 +1,142 @@ +include <fset.h> + +# T_TEST2 -- Test Doug's idea of how to access a piece of memory as a +# binary file using the pushback technique. This works but is a bit +# inefficient. + +procedure t_test2() + +pointer inbuf, outbuf +int i, fd, nchars, ntimes +int open(), read() + +begin + # Allocate a char array. + call malloc (inbuf, 1000, TY_CHAR) + call malloc (outbuf, 200, TY_CHAR) + do i = 1, 1000 + Memc[inbuf+i-1] = i + + # Open char array as a binary file. + fd = open ("dev$null", READ_ONLY, BINARY_FILE) + call fseti (fd, F_PBBSIZE, 1008) + call unread (fd, Memc[inbuf], 1000) + + # Try to read the data. + ntimes = 1 + nchars = read (fd, Memc[outbuf], 200) + while (nchars != EOF) { + call printf ("ntimes=%d nchars=%d firstchar = %d\n") + call pargi (ntimes) + call pargi (nchars) + call pargi (int(Memc[outbuf])) + nchars = read (fd, Memc[outbuf], 200) + ntimes = ntimes + 1 + } + + call close (fd) + + # Free char array. + call mfree (inbuf, TY_CHAR) + call mfree (outbuf, TY_CHAR) +end + + +# T_TEST3 -- Test Doug's idea of how to access a piece of memory as a +# binary file using the spool file technique. This works but is still a bit +# inefficient. + +procedure t_test3() + +pointer inbuf, outbuf +int i, fd, ntimes, nchars +int open(), read() + +begin + # Allocate a char array. + call malloc (inbuf, 1000, TY_CHAR) + call malloc (outbuf, 200, TY_CHAR) + do i = 1, 1000 + Memc[inbuf+i-1] = i + + # Open char array as a binary file. + fd = open ("dev$null", READ_WRITE, SPOOL_FILE) + call write (fd, Memc[inbuf], 1000) + call seek (fd, BOF) + + # Try to read the data. + ntimes = 1 + nchars = read (fd, Memc[outbuf], 200) + while (nchars != EOF) { + call printf ("ntimes=%d nchars=%d firstchar = %d\n") + call pargi (ntimes) + call pargi (nchars) + call pargi (int(Memc[outbuf])) + nchars = read (fd, Memc[outbuf], 200) + ntimes = ntimes + 1 + } + + call close (fd) + + # Free char array. + call mfree (inbuf, TY_CHAR) + call mfree (outbuf, TY_CHAR) +end + +# T_TEST5 -- Test Doug's idea of how to access a piece of memory as a +# text file using the spool file technique. This works but is still a bit +# inefficient. + +procedure t_test5() + +pointer inbuf, outbuf +int i, fd, ntimes, nchars +long note() +int open(), getline() + +begin + # Allocate a char array. + call malloc (inbuf, 1000, TY_CHAR) + call malloc (outbuf, 200, TY_CHAR) + do i = 1, 200 + Memc[inbuf+i-1] = 'a' + Memc[inbuf+199] = '\n' + do i = 201, 400 + Memc[inbuf+i-1] = 'b' + Memc[inbuf+399] = '\n' + do i = 401, 600 + Memc[inbuf+i-1] = 'c' + Memc[inbuf+599] = '\n' + do i = 601, 800 + Memc[inbuf+i-1] = 'd' + Memc[inbuf+799] = '\n' + do i = 801, 1000 + Memc[inbuf+i-1] = 'e' + Memc[inbuf+999] = '\n' + + # Open char array as a binary file. + fd = open ("dev$null", READ_WRITE, SPOOL_FILE) + call write (fd, Memc[inbuf], 1000) + call seek (fd, BOF) + + # Try to read the data. + ntimes = 1 + #nchars = read (fd, Memc[outbuf], 200) + nchars = getline (fd, Memc[outbuf]) + while (nchars != EOF) { + call printf ("ntimes=%d nchars=%d firstchar = %c seek=%d\n") + call pargi (ntimes) + call pargi (nchars) + call pargc (Memc[outbuf]) + call pargl (note(fd)) + #nchars = read (fd, Memc[outbuf], 200) + nchars = getline (fd, Memc[outbuf]) + ntimes = ntimes + 1 + } + + call close (fd) + + # Free char array. + call mfree (inbuf, TY_CHAR) + call mfree (outbuf, TY_CHAR) +end diff --git a/noao/astcat/src/mkpkg b/noao/astcat/src/mkpkg new file mode 100644 index 00000000..05300d2b --- /dev/null +++ b/noao/astcat/src/mkpkg @@ -0,0 +1,28 @@ +# Make the ASTCAT package + +$call relink +$exit + +update: + $call relink + $call install + ; + +relink: + $set LIBS = "-lxtools -lslalib" + $update libpkg.a + $omake x_astcat.x + $link x_astcat.o libpkg.a $(LIBS) -o x_astcat.e + ; + +install: + $move x_astcat.e noaobin$x_astcat.e + ; + + +libpkg.a: + @agetcat + @attools + @awcs + @debug + ; diff --git a/noao/astcat/src/pltmodel/pltmodel.par b/noao/astcat/src/pltmodel/pltmodel.par new file mode 100644 index 00000000..61ecb7a0 --- /dev/null +++ b/noao/astcat/src/pltmodel/pltmodel.par @@ -0,0 +1,36 @@ +# PLTMODEL Parameters. + +# Image parameters. +ncols,i,h,2048,1,,Number of image columns +nlines,i,h,2048,1,,Number of image lines +ncgrid,i,h,10,1,,Number of grid columns +nlgrid,i,h,10,1,,Number of grid lines + +# Linear model parameters. +x_zero,r,h,INDEF,,,X origin in pixels +y_zero,r,h,INDEF,,,Y origin in pixels +xi_zero,r,h,INDEF,,,XI origin in arcseconds +eta_zero,r,h,INDEF,,,ETA origin in arcseconds +scale,r,h,INDEF,,,Scale in arcseconds / pixel +ratio,r,h,INDEF,,,Ratio of Y to Y scale +xrot,r,h,INDEF,,,X rotation angle in degrees +yrot,r,h,INDEF,,,Y rotation angle in degrees + +# Tangent point position. +ra_tan,r,h,INDEF,,,Ra of assumed tangent point in hours +dec_tan,r,h,INDEF,,,Dec of assumed tangent point in degrees + +# Tangent point error. +dra_tan,r,h,INDEF,,,Ra error of assumed tangent point in minutes +ddec_tan,r,h,INDEF,,,Dec error of assumed tangent point in minutes + +# Tilt error. +tra,r,h,INDEF,,,Ra offset of plate normal +tdec,r,h,INDEF,,,Dec offset of platenormal + +# Cubic distortion. +q3ra,r,h,INDEF,,,Ra offset of cubic distortion center in minutes +q3dec,r,h,INDEF,,,Dec offset of cubic distortion center in minutes +q3,r,h,INDEF,,,Cubic distortion coefficient + +mode,s,h,'ql' diff --git a/noao/astcat/src/pltmodel/t_pltmodel.x b/noao/astcat/src/pltmodel/t_pltmodel.x new file mode 100644 index 00000000..33c865e2 --- /dev/null +++ b/noao/astcat/src/pltmodel/t_pltmodel.x @@ -0,0 +1,196 @@ +include <math.h> + +task pltmodel = t_pltmodel + +procedure t_pltmodel() + +double x_zero, y_zero, xi_zero, eta_zero, ra_tan, dec_tan, scale, ratio +double xrot, yrot, dra_tan, ddec_tan, x, y, xstep, ystep, tra, tdec +double xpix[1000], ypix[1000], xi[1000], eta[1000], dxi[1000], deta[1000] +double cosd, sind, dra, ddec, c1, f1, b1, ddxi, ddeta, q1, q2, q3 +double rpix, theta, rstd, tstd +int i, j, ncols, nlines, ncgrid, nlgrid, npts +double clgetd() +int clgeti() + +begin + # Get the image size. + ncols = clgeti ("ncols") + nlines = clgeti ("nlines") + ncgrid = clgeti ("ncgrid") + nlgrid = clgeti ("nlgrid") + + # Get the image zero point in pixels. + x_zero = clgetd ("x_zero") + if (IS_INDEFD(x_zero)) + x_zero = (1.0d0 + ncols) / 2.0d0 + y_zero = clgetd ("y_zero") + if (IS_INDEFD(y_zero)) + y_zero = (1.0d0 + nlines) / 2.0d0 + xi_zero = clgetd ("xi_zero") + if (IS_INDEFD(xi_zero)) + xi_zero = 0.0d0 + eta_zero = clgetd ("eta_zero") + if (IS_INDEFD(eta_zero)) + eta_zero = 0.0d0 + + # Get the image scale in " / pixel and the ratio of x to y scales. + scale = clgetd ("scale") + if (IS_INDEFD(scale)) + scale = 1.0d0 + scale = DEGTORAD (scale / 3600.0d0) + ratio = clgetd ("ratio") + if (IS_INDEFD(ratio)) + ratio = 1.0d0 + + # Get the rotation and ske in degrees. + xrot = clgetd ("xrot") + if (IS_INDEFD(xrot)) + xrot = 0.0d0 + yrot = clgetd ("yrot") + if (IS_INDEFD(yrot)) + yrot = 0.0d0 + + # Get the assumed image tangent point in hours and degrees. + ra_tan = clgetd ("ra_tan") + if (IS_INDEFD(ra_tan)) + ra_tan = 0.0d0 + dec_tan = clgetd ("dec_tan") + if (IS_INDEFD(dec_tan)) + dec_tan = 0.0d0 + cosd = cos (DEGTORAD(dec_tan)) + sind = sin (DEGTORAD(dec_tan)) + + # Get the tangent point error. + dra_tan = clgetd ("dra_tan") + if (IS_INDEFD(dra_tan)) + dra_tan = 0.0d0 + ddec_tan = clgetd ("ddec_tan") + if (IS_INDEFD(ddec_tan)) + ddec_tan = 0.0d0 + + # Get the tilt error. + tra = clgetd ("tra") + if (IS_INDEFD(tra)) + tra = 0.0d0 + tdec = clgetd ("tdec") + if (IS_INDEFD(tdec)) + tdec = 0.0d0 + + # Get the cubic distortion term + q1 = clgetd ("q3ra") + if (IS_INDEFD(q1)) + q1 = 0.0d0 + q2 = clgetd ("q3dec") + if (IS_INDEFD(q2)) + q2 = 0.0d0 + q3 = clgetd ("q3") + if (IS_INDEFD(q3)) + q3 = 0.0d0 + + # Compute the x and y grid. + xstep = (ncols - 1.0d0) / (ncgrid - 1.0d0) + ystep = (nlines - 1.0d0) / (nlgrid - 1.0d0) + npts = 0 + y = 1.0d0 + do j = 1, nlgrid { + x = 1.0d0 + do i = 1, ncgrid { + npts = npts + 1 + xpix[npts] = x + ypix[npts] = y + dxi[npts] = 0.0d0 + deta[npts] = 0.0d0 + x = x + xstep + } + y = y + ystep + } + + # Compute the linear part of the plate solution. + do i = 1, npts { + xi[i] = xi_zero + scale * (xpix[i] - x_zero) * + cos (DEGTORAD(xrot)) - scale * ratio * (ypix[i] - y_zero) * + sin(DEGTORAD(yrot)) + eta[i] = eta_zero + scale * (xpix[i] - x_zero) * + sin(DEGTORAD(xrot)) + scale * ratio * (ypix[i] - y_zero) * + cos(DEGTORAD(yrot)) + } + + # Estimate the tilt terms. + dra = DEGTORAD(tra / 60.0d0) + ddec = DEGTORAD(tdec / 60.0d0) + c1 = cosd * dra + f1 = ddec + do i = 1, npts { + ddxi = c1 * xi[i] ** 2 + f1 * xi[i] * eta[i] + ddeta = f1 * xi[i] * eta[i] + c1 * eta[i] ** 2 + dxi[i] = dxi[i] + ddxi + deta[i] = deta[i] + ddeta + } + + # Compute the components of the centering error. + dra = DEGTORAD(dra_tan / 60.0d0) + ddec = DEGTORAD(ddec_tan / 60.0d0) + c1 = cosd * dra + b1 = sind * dra + f1 = ddec + do i = 1, npts { + ddxi = c1 - b1 * eta[i] + c1 * xi[i] ** 2 + f1 * xi[i] * + eta[i] + ddeta = f1 + b1 * xi[i] + f1 * eta[i] ** 2 + c1 * xi[i] * + eta[i] + dxi[i] = dxi[i] + ddxi + deta[i] = deta[i] + ddeta + } + + # Compute the radial distortion terms + dra = DEGTORAD(q1 / 60.0d0) + ddec = DEGTORAD(q2 / 60.0d0) + c1 = -cosd * dra * q3 + f1 = -ddec * q3 + do i = 1, npts { + ddxi = c1 * (3.0d0 * xi[i] ** 2 + eta[i] ** 2) + 2.0d0 * f1 * + xi[i] * eta[i] + q3 * xi[i] * (xi[i] ** 2 + eta[i] ** 2) + ddeta = 2.0d0 * c1 * xi[i] * eta[i] + f1 * (xi[i] ** 2 + 3.0d0 * + eta[i] ** 2) + q3 * eta[i] * (xi[i] ** 2 + eta[i] ** 2) + dxi[i] = dxi[i] - ddxi + deta[i] = deta[i] - ddeta + } + + + # Estimate the refraction and aberration terms. + + # Compute the cubic distortion correction. + # Do the correction + do i = 1, npts { + xi[i] = xi[i] + dxi[i] + eta[i] = eta[i] + deta[i] + } + + # Print the results. + do i = 1, npts { + rpix = sqrt ((xpix[i] - x_zero) ** 2 + (ypix[i] - y_zero) ** 2) + if (ypix[i] == y_zero && xpix[i] == x_zero) + theta = 0.0d0 + else + theta = RADTODEG(atan2 (ypix[i] - y_zero, xpix[i] - x_zero)) + #if (theta < 0.0d0) + #theta = theta + 360.0d0 + rstd = sqrt ((xi[i] - xi_zero) ** 2 + (eta[i] - eta_zero) ** 2) + if (eta[i] == eta_zero && xi[i] == xi_zero) + tstd = 0.0d0 + else + tstd = RADTODEG(atan2 (eta[i] - eta_zero, xi[i] - xi_zero)) + #if (tstd < 0.0d0) + #tstd = tstd + 360.0d0 + call printf ("%12g %12g %12g %12g %12g %12g %12g %12g\n") + call pargd (xpix[i]) + call pargd (ypix[i]) + call pargd (RADTODEG(xi[i]) * 3600.0d0) + call pargd (RADTODEG(eta[i]) * 3600.0d0) + call pargd (rpix) + call pargd (theta) + call pargd (RADTODEG(rstd) * 3600.0d0) + call pargd (tstd) + } +end diff --git a/noao/astcat/src/x_astcat.x b/noao/astcat/src/x_astcat.x new file mode 100644 index 00000000..8feeb9c4 --- /dev/null +++ b/noao/astcat/src/x_astcat.x @@ -0,0 +1,12 @@ +task aclist = t_aclist, + agetcat = t_agetcat, + aimfind = t_aimfind, + afiltcat = t_afiltcat, + aslist = t_aslist, + agetim = t_agetim, + ahedit = t_ahedit, + adumpcat = t_adumpcat, + acqctest = t_acqctest, + acqftest = t_acqftest, + acqitest = t_acqitest, + adumpim = t_adumpim |