From fa080de7afc95aa1c19a6e6fc0e0708ced2eadc4 Mon Sep 17 00:00:00 2001 From: Joseph Hunkeler Date: Wed, 8 Jul 2015 20:46:52 -0400 Subject: Initial commit --- pkg/xtools/obsdb.x | 568 +++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 568 insertions(+) create mode 100644 pkg/xtools/obsdb.x (limited to 'pkg/xtools/obsdb.x') diff --git a/pkg/xtools/obsdb.x b/pkg/xtools/obsdb.x new file mode 100644 index 00000000..1bb2ea7d --- /dev/null +++ b/pkg/xtools/obsdb.x @@ -0,0 +1,568 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include +include +include + +.help obsdb Nov90 "Observatory Database Interface" +.ih +DESCRIPTION + +These procedures provide a simple interface to a simple observatory database. +It uses environment variables if possible to allow users and sites to +set or reset the observatory information. The observatory database is +specified by the environment parameter "obsdb" which defaults to +"noao$lib/obsdb.dat". The observatory may be specified as "observatory" +to look first for the environment parameter "observatory" and then +for the task parameter "observatory.observatory". The observatory +may also be specified as "obspars" to ignore the database and use the +parameters set in observatory task parameter set. This allows setting +arbitrary values without requiring the user modify or create a database +file. The case of the observatory identification is ignored. + +PROCEDURES + +.nf + obs = obsopen (observatory) + obs = obsvopen (observatory, verbose) + obsimopen (obs, im, observatory, verbose, newobs, obshead) + obsclose (obs) + obslog (obs, task, params, fd) + val = obsget[ird] (obs, param) + obsgstr (obs, param, str, maxchar) + obsinfo (obs, fd) +.fi + +DATABASE + +The database file is that defined by the environment variable "obsdb". +If absent the file is "noao$lib/obsdb.dat". The observatory name +used in the obsopen procedure is the observatory ID as defined +in the database, the special string "observatory" which uses +to the environment variable of the same name or the task parameter +"observatory.observatory", or the special string "obspars" which +uses the observatory task parameters and does not require an entry +in the database. + +The database format is simply a list of keyword/value definitions with +arbitrary whitespace allowed for visual formatting. Also comments +beginning with '#' may be used. Parameters for a particular +observatory begin with the "observatory" parameter and end with the +next observatory definitions (or end-of-file). For example: + +.nf +observatory = "kpno" + name = "Kitt Peak National Observatory" + longitude = 111:36.0 + latitude = 31:58.8 + altitude = 2120. + timezone = 7 + +observatory = "ctio" + +.fi + +String parameters must be quoted if they contain whitespace. +.ih +SEE ALSO +Source code +.endhelp + + +# Symbol table definitions. +define LEN_INDEX 10 # Length of symtab index +define LEN_STAB 512 # Length of symtab +define SZ_SBUF 512 # Size of symtab string buffer +define SYMLEN 40 # Length of symbol structure +define SZ_OBSVAL 79 # Size of observatory value string + +# Symbol table structure +define OBSVAL Memc[P2C($1)] # Observatory value string + + +# OBSOPEN -- Open observatory database and store the requested observatory +# information in symbol table. + +pointer procedure obsopen (observatory) + +char observatory[ARB] # Observatory name +pointer obsvopen() +errchk obsvopen + +begin + return (obsvopen (observatory, NO)) +end + + +# OBSVOPEN -- Open observatory database and store the requested observatory +# information in symbol table. + +pointer procedure obsvopen (observatory, verbose) + +char observatory[ARB] # Observatory name +int verbose # Verbose? +pointer obs # Observatory symbol table pointer + +int fd, envfind(), envgets(), open(), fscan(), nscan(), nowhite() +pointer sp, fname, obsname, key, str, temp, sym +pointer stopen(), stenter() +bool found, streq(), strne() +errchk open, stopen, stenter, envfind, envgets, fscan + +string obskey "observatory" +define getobs_ 99 + +begin + call smark (sp) + call salloc (fname, SZ_FNAME, TY_CHAR) + call salloc (obsname, SZ_FNAME, TY_CHAR) + call salloc (key, SZ_FNAME, TY_CHAR) + call salloc (str, SZ_LINE, TY_CHAR) + call salloc (temp, SZ_LINE, TY_CHAR) + + # Open observatory database. + if (envfind ("obsdb", Memc[fname], SZ_FNAME) <= 0) { + call strcpy ("noao$lib/obsdb.dat", Memc[fname], SZ_FNAME) + if (verbose == YES) { + call eprintf ("Using default observatory database: %s\n") + call pargstr ("noao$lib/obsdb.dat") + } + } else if (verbose == YES) { + call eprintf ( + "Using database defined by '%s' environment variable: %s\n") + call pargstr ("obsdb") + call pargstr (Memc[fname]) + } + fd = open (Memc[fname], READ_ONLY, TEXT_FILE) + + # Set observatory from the environment or task parameter if needed. + # Convert to lower case but save original name for documentation. + + if (streq (observatory, obskey)) { + if (envgets (obskey, Memc[obsname], SZ_FNAME) <= 0) { + call clgstr ("observatory.observatory", Memc[obsname], SZ_FNAME) + if (verbose == YES) { + call eprintf ( + "Using observatory defined by observatory task: %s\n") + call pargstr (Memc[obsname]) + } + } else if (verbose == YES) { + call eprintf ( + "Using observatory defined by '%s' environment variable: %s\n") + call pargstr (observatory) + call pargstr (Memc[obsname]) + } + } else + call strcpy (observatory, Memc[obsname], SZ_LINE) + +getobs_ + # Strip whitespace and convert to lower case. + call strcpy (Memc[obsname], Memc[temp], SZ_LINE) + if (nowhite (Memc[obsname], Memc[obsname], SZ_LINE) > 0) + call strlwr (Memc[obsname]) + + if (streq (Memc[obsname], "obspars")) { + if (verbose == YES) { + call eprintf ( + "Using observatory parameters from observatory task\n") + } + + # Create symbol table. + obs = stopen (Memc[obsname], LEN_INDEX, LEN_STAB, SZ_SBUF) + sym = stenter (obs, obskey, SYMLEN) + call strcpy (Memc[obsname], OBSVAL(sym), SZ_OBSVAL) +# sym = obspars (obs, "name") +# sym = obspars (obs, "longitude") +# sym = obspars (obs, "latitude") +# sym = obspars (obs, "altitude") +# sym = obspars (obs, "timezone") + } else { + if (verbose == YES) { + call eprintf ( + "Using observatory parameters for database entry: %s\n") + call pargstr (Memc[temp]) + } + + # Find observatory entry. + found = false + while (fscan (fd) != EOF) { + call gargwrd (Memc[key], SZ_FNAME) + call gargwrd (Memc[str], SZ_LINE) + call gargwrd (Memc[str], SZ_LINE) + if (nscan()<3 || Memc[key]=='#' || strne (Memc[key], obskey)) + next + call strlwr (Memc[str]) + if (streq (Memc[str], Memc[obsname])) { + found = true + break + } + } + + # Check if entry was found. + if (!found) { + if (Memc[obsname] != EOS && Memc[obsname] != '?') { + call eprintf ( + "WARNING: Observatory entry %s not found in database %s") + call pargstr (Memc[temp]) + call pargstr (Memc[fname]) + } + + # List database contents and try again + call seek (fd, BOF) + while (fscan (fd) != EOF) { + call gargwrd (Memc[key], SZ_FNAME) + call gargwrd (Memc[str], SZ_LINE) + call gargwrd (Memc[str], SZ_LINE) + if (nscan() < 3 || Memc[key] == '#') + next + if (streq (Memc[key], obskey)) { + call eprintf ("\n %s: ") + call pargstr (Memc[str]) + } else if (streq (Memc[key], "name")) + call eprintf (Memc[str]) + } + call seek (fd, BOF) + call eprintf ( + "\n obspars: Use parameters from OBSERVATORY task\n\n") + call flush (STDERR) + call clgstr ("observatory.override", Memc[obsname], SZ_LINE) + goto getobs_ + } + + # Create symbol table. + obs = stopen (Memc[obsname], LEN_INDEX, LEN_STAB, SZ_SBUF) + + # Read the file and enter the parameters in the symbol table. + sym = stenter (obs, Memc[key], SYMLEN) + call strcpy (Memc[obsname], OBSVAL(sym), SZ_OBSVAL) + while (fscan(fd) != EOF) { + call gargwrd (Memc[key], SZ_FNAME) + call gargwrd (Memc[str], SZ_LINE) + call gargwrd (Memc[str], SZ_LINE) + if (nscan() < 3 || Memc[key] == '#') + next + if (streq (Memc[key], obskey)) + break + sym = stenter (obs, Memc[key], SYMLEN) + call strcpy (Memc[str], OBSVAL(sym), SZ_OBSVAL) + } + } + + call close (fd) + call sfree (sp) + + return (obs) +end + + +# OBSCLOSE -- Close the observatory symbol table pointer. + +procedure obsclose (obs) + +pointer obs # Observatory symbol table pointer + +begin + if (obs != NULL) + call stclose (obs) +end + + +# OBSPARS -- Get parameter and if not found possibly get it from the +# observatory task + +pointer procedure obspars (obs, param) + +pointer obs # Observatory pointer +char param[ARB] # Parameter +pointer sym # Symbol table pointer + +bool streq() +pointer sp, str, stfind(), stenter() +double clgetd() + +begin + sym = stfind (obs, param) + if (sym != NULL) + return (sym) + + sym = stfind (obs, "observatory") + if (!streq (OBSVAL(sym), "obspars")) { + return (NULL) + } + + call smark (sp) + call salloc (str, SZ_LINE, TY_CHAR) + call sprintf (Memc[str], SZ_LINE, "observatory.%s") + call pargstr (param) + + if (streq (param, "name")) { + sym = stenter (obs, param, SYMLEN) + call clgstr (Memc[str], OBSVAL(sym), SZ_OBSVAL) + } else if (streq (param, "longitude")) { + sym = stenter (obs, param, SYMLEN) + call sprintf (OBSVAL(sym), SZ_OBSVAL, "%g") + call pargd (clgetd (Memc[str])) + } else if (streq (param, "latitude")) { + sym = stenter (obs, param, SYMLEN) + call sprintf (OBSVAL(sym), SZ_OBSVAL, "%g") + call pargd (clgetd (Memc[str])) + } else if (streq (param, "altitude")) { + sym = stenter (obs, param, SYMLEN) + call sprintf (OBSVAL(sym), SZ_OBSVAL, "%g") + call pargd (clgetd (Memc[str])) + } else if (streq (param, "timezone")) { + sym = stenter (obs, param, SYMLEN) + call sprintf (OBSVAL(sym), SZ_OBSVAL, "%g") + call pargd (clgetd (Memc[str])) + } + + call sfree (sp) + return (sym) +end + + + +# OBSLOG -- Log current observatory + +procedure obslog (obs, task, params, fd) + +pointer obs # Observatory symbol table pointer +char task[ARB] # Task name, image name, or other string +char params[ARB] # Parameters to log +int fd # File descriptor + +int ip, ctowrd() +pointer sym, obspars() +pointer sp, param + +begin + call smark (sp) + call salloc (param, SZ_FNAME, TY_CHAR) + + # Log task string and observatory name + sym = obspars (obs, "name") + if (sym == NULL) + sym = obspars (obs, "observatory") + + call fprintf (fd, "# ") + if (task[1] != EOS) { + call fprintf (fd, "%s: ") + call pargstr (task) + } + call fprintf (fd, "Observatory parameters for %s\n") + call pargstr (OBSVAL(sym)) + + for (ip=1; ctowrd (params, ip, Memc[param], SZ_FNAME) > 0;) { + sym = obspars (obs, Memc[param]) + if (sym == NULL) + next + call fprintf (fd, "#\t%s = %s\n") + call pargstr (Memc[param]) + call pargstr (OBSVAL(sym)) + } + call flush (fd) + + call sfree (sp) +end + + +# OBSGETI -- Get integer observatory parameter. + +int procedure obsgeti (obs, param) + +pointer obs # Observatory symbol table pointer +char param[ARB] # Observatory parameter + +int ip, ival, ctoi() +pointer sym, obspars() +errchk obspars + +begin + sym = obspars (obs, param) + if (sym == NULL) + call error (1, "OBSGETI: Observatory parameter not found") + ip = 1 + if (ctoi (OBSVAL(sym), ip, ival) <= 0) + call error (1, "OBSGETI: Observatory parameter not integer") + return (ival) +end + + +# OBSGETR -- Get real observatory parameter. + +real procedure obsgetr (obs, param) + +pointer obs # Observatory symbol table pointer +char param[ARB] # Observatory parameter + +int ip, ctor() +real rval +pointer sym, obspars() +errchk obspars + +begin + sym = obspars (obs, param) + if (sym == NULL) + call error (1, "OBSGETR: Observatory parameter not found") + ip = 1 + if (ctor (OBSVAL(sym), ip, rval) <= 0) + call error (1, "OBSGETR: Observatory parameter not real") + return (rval) +end + + +# OBSGETD -- Get double observatory parameter. + +double procedure obsgetd (obs, param) + +pointer obs # Observatory symbol table pointer +char param[ARB] # Observatory parameter + +int ip, ctod() +double dval +pointer sym, obspars() +errchk obspars + +begin + sym = obspars (obs, param) + if (sym == NULL) + call error (1, "OBSGETD: Observatory parameter not found") + ip = 1 + if (ctod (OBSVAL(sym), ip, dval) <= 0) + call error (1, "OBSGETD: Observatory parameter not double") + return (dval) +end + + +# OBSGSTR -- Get string valued observatory parameter. + +procedure obsgstr (obs, param, str, maxchar) + +pointer obs # Observatory symbol table pointer +char param[ARB] # Observatory parameter +char str[maxchar] # Observatory parameter value +int maxchar # Maximum characters for string + +pointer sym, obspars() +errchk obspars + +begin + sym = obspars (obs, param) + if (sym == NULL) + call error (1, "OBSGSTR: Observatory parameter not found") + call strcpy (OBSVAL(sym), str, maxchar) +end + + +# OBSIMOPEN - Open/reopen observatory for an image. +# Check if the OBSERVAT keyword is found. If found open/reopen the +# observatory. If not found open/reopen the default observatory. +# Return flags indicating a change in observatory and whether the +# observatory was defined in the image. + +procedure obsimopen (obs, im, observatory, verbose, newobs, obshead) + +pointer obs #U Observatory symbol table pointer +pointer im #I Image pointer +char observatory[ARB] #I Default observatory +int verbose #I Verbose? +bool newobs #O New observatory? +bool obshead #O Observatory found in header? + +bool strne() +pointer sp, observat, sym, obsvopen(), obspars() +errchk obsvopen + +begin + call smark (sp) + call salloc (observat, SZ_FNAME, TY_CHAR) + + if (verbose == YES) { + call imstats (im, IM_IMAGENAME, Memc[observat], SZ_FNAME) + call eprintf ("%s: ") + call pargstr (Memc[observat]) + } + + newobs = false + ifnoerr (call imgstr (im, "observat", Memc[observat], SZ_FNAME)) { + if (verbose == YES) { + call eprintf ("OBSERVAT = %s\n") + call pargstr (Memc[observat]) + } + + call strlwr (Memc[observat]) + if (obs == NULL) { + obs = obsvopen (Memc[observat], verbose) + newobs = true + } else { + sym = obspars (obs, "observatory") + if (strne (Memc[observat], OBSVAL(sym))) { + call obsclose (obs) + obs = obsvopen (Memc[observat], verbose) + newobs = true + } + } + obshead = true + } else { + if (verbose == YES) { + call eprintf ("No OBSERVAT keyword - using %s\n") + call pargstr (observatory) + } + + if (obs == NULL) { + obs = obsvopen (observatory, verbose) + newobs = true + } else { + sym = obspars (obs, "observatory") + if (strne (observatory, OBSVAL(sym))) { + call obsclose (obs) + obs = obsvopen (observatory, verbose) + newobs = true + } + } + obshead = false + } + + call sfree (sp) +end + + +# OBSINFO -- List observatory parameters + +procedure obsinfo (obs, fd) + +pointer obs # Observatory symbol table pointer +int fd # Output file descriptor + +pointer sym, name, obspars(), sthead(), stnext(), stname() +int stridxs() +bool streq() +errchk obspars +string obskey "observatory" + +begin + sym = obspars (obs, obskey) + call fprintf (fd, "\t%s = %s\n") + call pargstr (obskey) + call pargstr (OBSVAL(sym)) + + if (streq (OBSVAL(sym), "obspars")) { + sym = obspars (obs, "name") + sym = obspars (obs, "longitude") + sym = obspars (obs, "latitude") + sym = obspars (obs, "altitude") + sym = obspars (obs, "timezone") + } + + for (sym = sthead (obs); sym != NULL; sym = stnext (obs, sym)) { + name = stname (obs, sym) + if (streq (Memc[name], obskey)) + next + if (stridxs (" ", OBSVAL(sym)) > 0) + call fprintf (fd, "\t%s = '%s'\n") + else + call fprintf (fd, "\t%s = %s\n") + call pargstr (Memc[name]) + call pargstr (OBSVAL(sym)) + } +end -- cgit