diff options
Diffstat (limited to 'noao/imred/quadred/src/quad/qpcalimage.x')
| -rw-r--r-- | noao/imred/quadred/src/quad/qpcalimage.x | 525 |
1 files changed, 525 insertions, 0 deletions
diff --git a/noao/imred/quadred/src/quad/qpcalimage.x b/noao/imred/quadred/src/quad/qpcalimage.x new file mode 100644 index 00000000..2e0ee40b --- /dev/null +++ b/noao/imred/quadred/src/quad/qpcalimage.x @@ -0,0 +1,525 @@ +include <error.h> +include <imset.h> +include "ccdtypes.h" + +define SZ_SUBSET 16 # Maximum size of subset string +define IMAGE Memc[$1+($2-1)*SZ_FNAME] # Image string +define SUBSET Memc[$1+($2-1)*SZ_SUBSET] # Subset string + +procedure t_qpcalimage () + +pointer im, subsets, list +int i, j +bool flatcor, illumcor, fringecor, found, check +char instrument[SZ_LINE], image[SZ_FNAME], buffer[SZ_SUBSET-1] + +pointer immap(), imtopenp() +int imtgetim() +bool clgetb(), streq() + +begin + # Open list of images and instrument file + list = imtopenp ("images") + call clgstr ("instrument", instrument, SZ_LINE) + call hdmopen (instrument) + + if (clgetb ("only_param")) { + call cal_open (NULL) + } else { + call cal_open (list) + } + + check = clgetb ("check") + + if (clgetb ("zerocor")) { + iferr (call cal_find (ZERO, "", image, SZ_FNAME)) { + if (check) { + call erract (EA_WARN) + } + + } else { + call printf ("%s\n") + call pargstr (image) + } + } + + if (clgetb ("darkcor")) { + iferr (call cal_find (DARK, "", image, SZ_FNAME)) { + if (check) + call erract (EA_WARN) + + } else { + call printf ("%s\n") + call pargstr (image) + } + } + + flatcor = clgetb ("flatcor") + illumcor = clgetb ("illumcor") + fringecor = clgetb ("fringecor") + + if (flatcor || illumcor || fringecor) { + + i = 1 + found = false + while (imtgetim (list, image, SZ_FNAME) != EOF) { + # Open the image. Silently skip any non-existant images + iferr (im = immap (image, READ_ONLY, 0)) + next + + call ccdsubset (im, buffer, SZ_SUBSET-1) + call imunmap (im) + + # Check to see if we have already dealt with this subset + do j = 1, i - 1 { + found = (streq (buffer, SUBSET (subsets, j))) + if (found) + break + } + + if (!found) { + + # Add subset to list of processed subsets + if (i == 1) + call malloc (subsets, i * SZ_SUBSET, TY_CHAR) + else + call realloc (subsets, i * SZ_SUBSET, TY_CHAR) + + call strcpy (buffer, SUBSET(subsets, i), SZ_SUBSET-1) + i = i + 1 + + # Find and print names of associated calibration images + if (flatcor) { + iferr (call cal_find (FLAT, buffer, image, SZ_FNAME)) { + if (check) + call erract (EA_WARN) + + } else { + call printf ("%s\n") + call pargstr (image) + } + } + + if (illumcor) { + iferr (call cal_find (ILLUM, buffer, image, SZ_FNAME)) { + if (check) + call erract (EA_WARN) + + } else { + call printf ("%s\n") + call pargstr (image) + } + } + + if (fringecor) { + iferr (call cal_find (FRINGE, buffer, image, SZ_FNAME)){ + if (check) + call erract (EA_WARN) + + } else { + call printf ("%s\n") + call pargstr (image) + } + } + } + } + } + + call hdmclose () + call imtclose (list) + call mfree (subsets, TY_CHAR) + call cal_close () + +end + +# CAL_FIND -- Return a calibration image of the specified type and subset +# CAL_IMAGE -- Return a calibration image for a specified input image. +# CAL_OPEN -- Open the calibration image list. +# CAL_CLOSE -- Close the calibration image list. +# CAL_LIST -- Add images to the calibration image list. +# +# The open procedure is called first to get the calibration image +# lists and add them to an internal list. Calibration images from the +# input list are also added so that calibration images may be specified +# either from the calibration image list parameters or in the input image list. +# Existence errors and duplicate calibration images are ignored. +# Validity checks are made when the calibration images are requested. +# +# During processing the calibration image names are requested for each input +# image. The calibration image list is searched for a calibration image of +# the right type and subset. If more than one is found the first one is +# returned and a warning given for the others. The warning is only issued +# once. If no calibration image is found then an error is returned. +# +# The calibration image list must be closed at the end of processing the +# input images. + +# CAL_FIND -- Return a calibration image of a particular type and subset. +# Search the calibration list for the first calibration image of the desired +# type and subset. Print a warning if there is more than one possible +# calibration image and return an error if there is no calibration image. + +procedure cal_find (ccdtype, subset, image, maxchars) + +int ccdtype #I Callibration CCD image type +char subset[ARB] #I Calibration image subset +char image[maxchars] #O Calibration image (returned) +int maxchars #I Maximum number chars in image name + +int i +char errmsg[SZ_LINE] +bool strne() + +pointer ccdtypes # Pointer to array of calibration ccdtypes +pointer subsets # Pointer to array of calibration subsets +pointer images # Pointer to array of calibration image names +int nimages # Number of images +common /calib/ ccdtypes, subsets, images, nimages + +begin + + switch (ccdtype) { + case ZERO, DARK: + do i = 1, nimages { + if (Memi[ccdtypes+i-1] != ccdtype) + next + + call strcpy (IMAGE(images,i), image, maxchars) + return + } + + case FLAT, ILLUM, FRINGE: + do i = 1, nimages { + if (Memi[ccdtypes+i-1] != ccdtype) + next + if (strne (SUBSET(subsets,i), subset)) + next + + call strcpy (IMAGE(images,i), image, maxchars) + return + } + } + + # If no calibration image is found then it is an error. + switch (ccdtype) { + case ZERO: + call error (0, "No zero level calibration image found") + case DARK: + call error (0, "No dark count calibration image found") + case FLAT: + call sprintf (errmsg, SZ_LINE, + "No flat field calibration image of subset %s found") + call pargstr (subset) + call error (0, errmsg) + case ILLUM: + call sprintf (errmsg, SZ_LINE, + "No illumination calibration image of subset %s found") + call pargstr (subset) + call error (0, errmsg) + case FRINGE: + call sprintf (errmsg, SZ_LINE, + "No fringe calibration image of subset %s found") + call pargstr (subset) + call error (0, errmsg) + } +end + +# CAL_IMAGE -- Return a calibration image of a particular type. +# Search the calibration list for the first calibration image of the desired +# type and subset. Print a warning if there is more than one possible +# calibration image and return an error if there is no calibration image. + +procedure cal_image (im, ccdtype, image, maxchars) + +pointer im # Image to be processed +int ccdtype # Callibration CCD image type +char image[maxchars] # Calibration image (returned) +int maxchars # Maximum number chars in image name + +int i, n +pointer sp, subset, str +bool strne(), ccd_cmp() + +pointer ccdtypes # Pointer to array of calibration ccdtypes +pointer subsets # Pointer to array of calibration subsets +pointer images # Pointer to array of calibration image names +int nimages # Number of images +common /calib/ ccdtypes, subsets, images, nimages + +begin + call smark (sp) + call salloc (subset, SZ_SUBSET, TY_CHAR) + call salloc (str, SZ_LINE, TY_CHAR) + + switch (ccdtype) { + case ZERO, DARK: + n = 0 + do i = 1, nimages { + if (Memi[ccdtypes+i-1] != ccdtype) + next + n = n + 1 + if (n == 1) + call strcpy (IMAGE(images,i), image, maxchars) + else { +# call eprintf ( +# "Warning: Extra calibration image %s ignored\n") +# call pargstr (IMAGE(images,i)) + + # Reset the image type to eliminate further warnings. + Memi[ccdtypes+i-1] = UNKNOWN + } + } + case FLAT, ILLUM, FRINGE: + call ccdsubset (im, Memc[subset], SZ_SUBSET) + + n = 0 + do i = 1, nimages { + if (Memi[ccdtypes+i-1] != ccdtype) + next + if (strne (SUBSET(subsets,i), Memc[subset])) + next + n = n + 1 + if (n == 1) + call strcpy (IMAGE(images,i), image, maxchars) + else { +# call eprintf ( +# "Warning: Extra calibration image %s ignored\n") +# call pargstr (IMAGE(images,i)) + + # Reset the image type to eliminate further warnings. + Memi[ccdtypes+i-1] = UNKNOWN + } + } + } + + # If no calibration image is found then it is an error. + if (n == 0) + switch (ccdtype) { + case ZERO: + call error (0, "No zero level calibration image found") + case DARK: + call error (0, "No dark count calibration image found") + case FLAT: + call sprintf (Memc[str], SZ_LINE, + "No flat field calibration image of subset %s found") + call pargstr (Memc[subset]) + call error (0, Memc[str]) + case ILLUM: + call sprintf (Memc[str], SZ_LINE, + "No illumination calibration image of subset %s found") + call pargstr (Memc[subset]) + call error (0, Memc[str]) + case FRINGE: + call sprintf (Memc[str], SZ_LINE, + "No fringe calibration image of subset %s found") + call pargstr (Memc[subset]) + call error (0, Memc[str]) + } + + # Check that the input image is not the same as the calibration image. + call imstats (im, IM_IMAGENAME, Memc[str], SZ_LINE) + if (ccd_cmp (Memc[str], image)) { + call sprintf (Memc[str], SZ_LINE, + "Calibration image %s is the same as the input image") + call pargstr (image) + call error (0, Memc[str]) + } + + call sfree (sp) +end + + +# CAL_OPEN -- Create a list of calibration images from the input image list +# and the calibration image lists. + +procedure cal_open (list) + +int list # List of input images +int list1 # List of calibration images + +pointer sp, str +int ccdtype, strdic(), imtopenp() +bool clgetb() + +pointer ccdtypes # Pointer to array of calibration ccdtypes +pointer subsets # Pointer to array of calibration subset numbers +pointer images # Pointer to array of calibration image names +int nimages # Number of images +common /calib/ ccdtypes, subsets, images, nimages + +errchk cal_list + +begin + call smark (sp) + call salloc (str, SZ_LINE, TY_CHAR) + + call clgstr ("ccdtype", Memc[str], SZ_LINE) + call xt_stripwhite (Memc[str]) + if (Memc[str] == EOS) + ccdtype = NONE + else + ccdtype = strdic (Memc[str], Memc[str], SZ_LINE, CCDTYPES) + + # Add calibration images to list. + nimages = 0 + if (ccdtype != ZERO && clgetb ("zerocor")) { + list1 = imtopenp ("zero") + call cal_list (list1, ZERO) + call imtclose (list1) + } + if (ccdtype != ZERO && ccdtype != DARK && clgetb ("darkcor")) { + list1 = imtopenp ("dark") + call cal_list (list1, DARK) + call imtclose (list1) + } + if (ccdtype != ZERO && ccdtype != DARK && ccdtype != FLAT && + clgetb ("flatcor")) { + list1 = imtopenp ("flat") + call cal_list (list1, FLAT) + call imtclose (list1) + } + if (ccdtype != ZERO && ccdtype != DARK && ccdtype != FLAT && + ccdtype != ILLUM && clgetb ("illumcor")) { + list1 = imtopenp ("illum") + call cal_list (list1, ILLUM) + call imtclose (list1) + } + if (ccdtype != ZERO && ccdtype != DARK && ccdtype != FLAT && + ccdtype != FRINGE && clgetb ("fringecor")) { + list1 = imtopenp ("fringe") + call cal_list (list1, FRINGE) + call imtclose (list1) + } + if (list != NULL) { + call cal_list (list, UNKNOWN) + call imtrew (list) + } + + call sfree (sp) +end + + +# CAL_CLOSE -- Free memory from the internal calibration image list. + +procedure cal_close () + +pointer ccdtypes # Pointer to array of calibration ccdtypes +pointer subsets # Pointer to array of calibration subset +pointer images # Pointer to array of calibration image names +int nimages # Number of images +common /calib/ ccdtypes, subsets, images, nimages + +begin + if (nimages > 0) { + call mfree (ccdtypes, TY_INT) + call mfree (subsets, TY_CHAR) + call mfree (images, TY_CHAR) + } +end + + +# CAL_LIST -- Add calibration images to an internal list. +# Map each image and get the CCD image type and subset. +# If the ccdtype is given as a procedure argument this overrides the +# image header type. For the calibration images add the type, subset, +# and image name to dynamic arrays. Ignore duplicate names. + +procedure cal_list (list, listtype) + +pointer list # Image list +int listtype # CCD type of image in list. + # Overrides header type if not UNKNOWN. + +int i, ccdtype, ccdtypei(), imtgetim() +pointer sp, image, im, immap() +bool streq() + +pointer ccdtypes # Pointer to array of calibration ccdtypes +pointer subsets # Pointer to array of calibration subsets +pointer images # Pointer to array of calibration image names +int nimages # Number of images +common /calib/ ccdtypes, subsets, images, nimages + +begin + call smark (sp) + call salloc (image, SZ_FNAME, TY_CHAR) + + while (imtgetim (list, Memc[image], SZ_FNAME) != EOF) { + # Open the image. If an explicit type is given it is an + # error if the image can't be opened. + iferr (im = immap (Memc[image], READ_ONLY, 0)) { + if (listtype == UNKNOWN) + next + else + call erract (EA_ERROR) + } + + # Override image header CCD type if a list type is given. + if (listtype == UNKNOWN) + ccdtype = ccdtypei (im) + else + ccdtype = listtype + + switch (ccdtype) { + case ZERO, DARK, FLAT, ILLUM, FRINGE: + # Check for duplication. + for (i=1; i<=nimages; i=i+1) + if (streq (Memc[image], IMAGE(images,i))) + break + if (i <= nimages) + break + + # Allocate memory for a new image. + if (i == 1) { + call malloc (ccdtypes, i, TY_INT) + call malloc (subsets, i * SZ_SUBSET, TY_CHAR) + call malloc (images, i * SZ_FNAME, TY_CHAR) + } else { + call realloc (ccdtypes, i, TY_INT) + call realloc (subsets, i * SZ_FNAME, TY_CHAR) + call realloc (images, i * SZ_FNAME, TY_CHAR) + } + + # Enter the ccdtype, subset, and image name. + Memi[ccdtypes+i-1] = ccdtype + call ccdsubset (im, SUBSET(subsets,i), SZ_SUBSET-1) + call strcpy (Memc[image], IMAGE(images,i), SZ_FNAME-1) + nimages = i + } + call imunmap (im) + } +# call eprintf ("nimages=%d\n") +# call pargi (nimages) +# do i = 1, nimages { +# call eprintf ("ccdtype=%d subset=%s image=%s\n") +# call pargi (Memi[ccdtypes+i-1]) +# call pargstr (SUBSET (subsets, i)) +# call pargstr (IMAGE (images, i)) +# } + + call sfree (sp) +end + +# CCD_CMP -- Compare two image names with extensions ignored. + +bool procedure ccd_cmp (image1, image2) + +char image1[ARB] # First image +char image2[ARB] # Second image + +int i, j, strmatch(), strlen(), strncmp() +bool streq() + +begin + if (streq (image1, image2)) + return (true) + + i = max (strmatch (image1, ".imh"), strmatch (image1, ".hhh")) + if (i == 0) + i = strlen (image1) + j = max (strmatch (image2, ".imh"), strmatch (image2, ".hhh")) + if (j == 0) + j = strlen (image2) + + return (strncmp (image1, image2, max (i, j)) == 0) +end |