include include include include include include # T_ILLUMINATION -- Determine the illumination function for longslit spectra. # # The calibration image is binned in wavelength. Each wavelength bin is # then smoothed by curve fitting and normalized to the middle point. # Finally the binned image is interpolated back to the original image # dimension. The binning and curve fitting may be performed interactively. # A illumination function is determined for each input images. Image # sections in the input image allow only parts of the illumination function # to be created. Thus, multiple slits in the same image may have # independent illumination functions on the same illumination image. # CL callable procedure. # # The input and output images are given by image templates. The # number of output images must match the number of input images. # Input image sections are allowed. procedure t_illumination () pointer image1 pointer image2 int list1 # Calibration image list int list2 # Illumination image list int interactive # Interactive? int naverage # Sample averaging size int order # Order of curve fitting function real low_reject, high_reject # Rejection thresholds int niterate # Number of rejection iterations real grow # Rejection growing radius int answer char history[SZ_LINE] pointer in, out, ic, gt, sp, str int clgeti(), imtopen(), imtgetim(), imtlen(), gt_init() bool clgetb() real clgetr() errchk il_make begin call smark (sp) call salloc (image1, SZ_LINE, TY_CHAR) call salloc (image2, SZ_LINE, TY_CHAR) call salloc (str, SZ_LINE, TY_CHAR) # Get calibration and illumination image template lists. call clgstr ("images", Memc[image1], SZ_LINE) call clgstr ("illuminations", Memc[image2], SZ_LINE) # Check that the number of illumination calibration images are the same. list1 = imtopen (Memc[image1]) list2 = imtopen (Memc[image2]) if (imtlen (list1) != imtlen (list2)) { call imtclose (list1) call imtclose (list2) call error (0, "The number of input and output images are not the same.") } # Get other parameters and initialize the curve fitting package. if (clgetb ("interactive")) interactive = YES else interactive = ALWAYSNO call clgstr ("sample", Memc[image1], SZ_LINE) naverage = clgeti ("naverage") call clgstr ("function", Memc[str], SZ_LINE) order = clgeti ("order") low_reject = clgetr ("low_reject") high_reject = clgetr ("high_reject") niterate = clgeti ("niterate") grow = clgetr ("grow") # Set the ICFIT pointer structure. call ic_open (ic) call ic_pstr (ic, "sample", Memc[image1]) call ic_puti (ic, "naverage", naverage) call ic_pstr (ic, "function", Memc[str]) call ic_puti (ic, "order", order) call ic_putr (ic, "low", low_reject) call ic_putr (ic, "high", high_reject) call ic_puti (ic, "niterate", niterate) call ic_putr (ic, "grow", grow) call ic_pstr (ic, "ylabel", "") gt = gt_init() call gt_sets (gt, GTTYPE, "line") # Create an illumination image for each calibration image while ((imtgetim (list1, Memc[image1], SZ_LINE) != EOF) && (imtgetim (list2, Memc[image2], SZ_LINE) != EOF)) { call ls_immap (Memc[image1], Memc[image2], in, out) call sprintf (Memc[str], SZ_LINE, "Determine illumination interactively for %s") call pargstr (Memc[image1]) call xt_answer (Memc[str], interactive) answer = interactive iferr { call il_make (in, out, ic, gt, Memc[str], answer) call imaddr (out, "ccdmean", 1.) call sprintf (history, SZ_LINE, "Illumination correction determined from %s.") call pargstr (Memc[image1]) call imastr (out, "mkillum", history) call imunmap (in) call imunmap (out) } then { call erract (EA_WARN) call imunmap (in) call imunmap (out) call imdelete (Memc[image2]) } } call ic_closer (ic) call gt_free (gt) call imtclose (list1) call imtclose (list2) call sfree (sp) end # IL_MAKE -- Given the calibration and illumination image descriptors # make the illumination function. procedure il_make (in, out, ic, gt, title, interactive) pointer in # Calibration IMIO pointer pointer out # Illumination IMIO pointer pointer ic # ICFIT pointer pointer gt # GTOOLS pointer char title[ARB] # Title int interactive # Interactive? char graphics[SZ_FNAME] # Graphics output device int i, laxis, paxis, axis, npts, nbins, len_title pointer bins, cv, gp, sp, x, y, z, z1, wts pointer gopen() int strlen() errchk get_daxis begin # Determine the slit axis and set the axis labels. call get_daxis (in, laxis, paxis) if (laxis == 1) axis = 2 else axis = 1 switch (axis) { case 1: call ic_pstr (ic, "xlabel", "Column") case 2: call ic_pstr (ic, "xlabel", "Line") } # Set the bins and bin the calibration image. switch (axis) { case 1: call il_setbins (in, 2, interactive, bins) case 2: call il_setbins (in, 1, interactive, bins) } call il_binimage (in, axis, bins, x, y, z, npts, nbins) call rg_free (bins) # Allocate memory for the fit. call smark (sp) call salloc (wts, npts, TY_REAL) call amovkr (1., Memr[wts], npts) # Smooth each bin. call ic_putr (ic, "xmin", Memr[x]) call ic_putr (ic, "xmax", Memr[x+npts-1]) len_title = strlen (title) z1 = z do i = 1, nbins { title[len_title + 1] = EOS call sprintf (title, SZ_LINE, "%s at bin %d") call pargstr (title) call pargi (i) call xt_answer (title, interactive) if ((interactive == YES) || (interactive == ALWAYSYES)) { call sprintf (title, SZ_LINE, "%s\n%s") call pargstr (title) call pargstr (IM_TITLE(in)) call gt_sets (gt, GTTITLE, title) call clgstr ("graphics", graphics, SZ_FNAME) gp = gopen (graphics, NEW_FILE, STDGRAPH) call icg_fit (ic, gp, "cursor", gt, cv, Memr[x], Memr[z1], Memr[wts], npts) call amovkr (1., Memr[wts], npts) call gclose (gp) } else { call ic_fit (ic, cv, Memr[x], Memr[z1], Memr[wts], npts, YES, YES, YES, YES) } call cvvector (cv, Memr[x], Memr[z1], npts) z1 = z1 + npts } call cvfree (cv) # Compute the illumination image by linear interpolation. call il_expand (out, axis, Memr[x], Memr[y], Memr[z], npts, nbins) # Free allocated memory. call mfree (x, TY_REAL) call mfree (y, TY_REAL) call mfree (z, TY_REAL) call sfree (sp) end # IL_BINIMAGE -- Read the calibration image and bin it. procedure il_binimage (im, axis, bins, x, y, z, npts, nbins) pointer im # Calibration IMIO pointer int axis # Slit axis pointer bins # Bins pointer x # Slit positions pointer y # Dispersion positions of bins pointer z # Binned image int npts # Number of points per bin int nbins # Number of bins int i, y1, y2 pointer z1 begin # Allocate memory. npts = IM_LEN (im, axis) nbins = RG_NRGS (bins) call malloc (y, nbins, TY_REAL) call malloc (z, npts * nbins, TY_REAL) # Bin the image data. x = NULL do i = 1, nbins { y1 = RG_X1 (bins, i) y2 = RG_X2 (bins, i) Memr[y+i-1] = (y1 + y2) / 2 call mfree (x, TY_REAL) switch (axis) { case 1: call ls_aimavg (im, axis, 1, IM_LEN(im, 1), y1, y2, x, z1, npts) case 2: call ls_aimavg (im, axis, y1, y2, 1, IM_LEN(im, 2), x, z1, npts) } call amovr (Memr[z1], Memr[z+(i-1)*npts], npts) call mfree (z1, TY_REAL) } end # IL_EXPAND -- Expand the reduced illumination back to the original size. # This procedure request the interpolation type. procedure il_expand (im, axis, x, y, z, nx, ny) pointer im # Illumination image pointer int axis # Slit axis real x[nx] # Slit coordinates real y[ny] # Dispersion coordinates real z[nx, ny] # Slit profile int nx # Number of points per slit profile int ny # Number of slit profiles char dummy[7] int nyout, ncols, nlines int i, j, y1, y2 real dy pointer msi, sp, out, yout int clgwrd() pointer impl2r() int msitypes[5] data msitypes/II_BINEAREST,II_BILINEAR,II_BIPOLY3,II_BIPOLY5,II_BISPLINE3/ string msinames "|nearest|linear|poly3|poly5|spline3|" begin ncols = IM_LEN (im, 1) nlines = IM_LEN (im, 2) # Normalize illumination to the center of each slit. i = nx / 2 - 1 do j = 1, ny { dy = z[i, j] call adivkr (z[1, j], dy, z[1, j], nx) } # If there is only one slit profile then copy the profile to each # image line or column. if (ny == 1) { switch (axis) { case 1: do i = 1, nlines call amovr (z, Memr[impl2r (im, i)], ncols) case 2: do i = 1, nlines call amovkr (z[i, 1], Memr[impl2r (im, i)], ncols) } return } # If there is more than one slit profile fit a 2D interpolator. i = clgwrd ("interpolator", dummy, 7, msinames) if (i == 0) i = II_BILINEAR else i = msitypes[i] switch (i) { case II_POLY3, II_SPLINE3: if (ny < 4) i = II_BILINEAR case II_POLY5: if (ny < 6) { if (ny < 4) i = II_BILINEAR else i = II_POLY3 } } call msiinit (msi, i) call msifit (msi, z, nx, ny, nx) # Set the output grid in terms of the interpolation surface. switch (axis) { case 1: nyout = IM_LEN (im, 2) case 2: nyout = IM_LEN (im, 1) } call smark (sp) call salloc (yout, nyout, TY_REAL) y1 = 1 y2 = y[1] do i = y1, y2 Memr[yout+i-1] = 1 do j = 2, ny { y1 = y2 + 1 y2 = y[j] dy = 1. / (y2 - y1) do i = y1, y2 Memr[yout+i-1] = j - 1 + (i - y1) * dy } y1 = y2 + 1 y2 = nyout do i = y1, y2 Memr[yout+i-1] = ny # Evaluate the interpolation surface on the output grid. ncols = IM_LEN (im, 1) nlines = IM_LEN (im, 2) call salloc (out, ncols, TY_REAL) switch (axis) { case 1: do i = 1, nlines { call amovkr (Memr[yout+i-1], Memr[out], ncols) call msivector (msi, x, Memr[out], Memr[impl2r (im, i)], ncols) } case 2: do i = 1, nlines { call amovkr (x[i], Memr[out], ncols) call msivector (msi, Memr[out], Memr[yout], Memr[impl2r(im, i)], ncols) } } call sfree (sp) end