diff --git a/noao/imred/imred.cl b/noao/imred/imred.cl index bccb27ffb..634b7b27e 100644 --- a/noao/imred/imred.cl +++ b/noao/imred/imred.cl @@ -18,6 +18,7 @@ set kpnocoude = "imred$kpnocoude/" set kpnoslit = "imred$kpnoslit/" set quadred = "imred$quadred/" set specred = "imred$specred/" +set vtel = "imred$vtel/" set apextract = "twodspec$apextract/" set doecslit = "imred$src/doecslit/" @@ -49,5 +50,6 @@ task kpnocoude.pkg = "kpnocoude$kpnocoude.cl" task kpnoslit.pkg = "kpnoslit$kpnoslit.cl" task quadred.pkg = "quadred$quadred.cl" task specred.pkg = "specred$specred.cl" +task vtel.pkg = "vtel$vtel.cl" clbye diff --git a/noao/imred/imred.hd b/noao/imred/imred.hd index 24c47403a..7e349d7e3 100644 --- a/noao/imred/imred.hd +++ b/noao/imred/imred.hd @@ -18,6 +18,7 @@ $kpnocoude = "noao$imred/kpnocoude/" $kpnoslit = "noao$imred/kpnoslit/" $quadred = "noao$imred/quadred/" $specred = "noao$imred/specred/" +$vtel = "noao$imred/vtel/" demos hlp=doc$demos.hlp #tutor hlp=doc$tutor.hlp, src=tutor.cl @@ -110,3 +111,9 @@ specred men=specred$specred.men, sys=specred$specred.hlp, pkg=specred$specred.hd, src=specred$specred.cl + +vtel men=vtel$vtel.men, + hlp=.., + sys=vtel$vtel.hlp, + pkg=vtel$vtel.hd, + src=vtel$vtel.cl diff --git a/noao/imred/imred.men b/noao/imred/imred.men index c68ba31e3..b9ddc2340 100644 --- a/noao/imred/imred.men +++ b/noao/imred/imred.men @@ -14,3 +14,4 @@ kpnoslit - KPNO low/moderate dispersion slits (Goldcam, RCspec, Whitecam) quadred - CCD reductions for QUAD amplifier data specred - Generic slit and fiber spectral reduction package + vtel - NSO Solar vacuum telescope image reductions diff --git a/noao/imred/mkpkg b/noao/imred/mkpkg index 08a3453b5..30057f0de 100644 --- a/noao/imred/mkpkg +++ b/noao/imred/mkpkg @@ -15,4 +15,6 @@ update: $call update@irred $echo "------------------ IMRED.QUADRED -------------------" $call update@quadred + $echo "------------------ IMRED.VTEL ----------------------" + $call update@vtel ; diff --git a/noao/imred/vtel/README b/noao/imred/vtel/README new file mode 100644 index 000000000..8f0be8f3d --- /dev/null +++ b/noao/imred/vtel/README @@ -0,0 +1,81 @@ +This is the home directory for the Kitt Peak vacuum telescope +reduction programs. + +README this file +Revisions revisions file +asciilook lookup table for ascii values into the pixelfont +d1900.x calculate number of days since turn of century +decodeheader.x decode/print vacuum telescope tape header +destreak.par +destreak.x destreak 10830 full disk helium grams +destreak5.cl script for processing 10830 tape containing 5 grams +destreak5.par +dicoplot.h header file containing defines for DICOPLOT +dicoplot.par +dicoplot.x program to make Carrington rotation mape on the Dicomed +doc documentation directory +ephem.x program to calculate solar ephemeris data +fitslogr.cl script, make a log file of a fits tape (daily grams) +fitslogr.par +getsqib.par +getsqib.x get the squibby brightness image from a full disk gram +gryscl.dico greyscale lookup table for use with DICOPLOT +imfglexr.x Get Line with EXtension Real for use with IMFilt +imfilt.x convolve an image with gaussian kernel, used in destreak +imratio.x find the ratio between two images, used in merge +imtext.x subroutine to load text into an image by overwriting pixels +lstsq.x least squares fitting subroutine +makehelium.cl script to process a helium 10830 tape into daily grams (180) +makehelium.par +makeimages.cl script to process a magnetogram tape into daily grams (180) +makeimages.par +merge.par +merge.x program to merge daily grams into Carrington rotation maps +mkpkg make the package +mrotlogr.cl script, make a log file of a fits tape (Carrington rotations) +mrotlogr.par +mscan.par +mscan.x read vacuum telescope area scan tapes +numeric.h header file for numeric subroutine +numeric.x subroutine to calculate derivitives of latitude and longitude + with respect to x and y respectively (used in rmap) +pimtext.par +pimtext.x program to put text into images by overwriting pixels +pixbit.x subroutine that looks up text pixel format in pixelfont +pixelfont pixel font for use with pimtext (no lower case, no decenders) +putsqib.par +putsqib.x program to put the squibby brightness back in a full disk gram +quickfit.par +quickfit.x fit an ellipse to the limb of the sun +readheader.x read a vacuum telescope header +readss1.x subroutine to read a type 1 area scan +readss2.x subroutine to read a type 2 area scan +readss3.x subroutine to read a type 3 area scan +readss4.x subroutine to read a type 4 area scan +readsubswath.x subroutine to read a sub-swath +readvt.par +readvt.x read full disk grams from tape +rmap.par +rmap.x map full disk grams into daily grams (180x180) +syndico.x Make dicomed print of daily grams 18 cm across. +tcopy.par +tcopy.x tape to tape copy program +trim.par +trim.x trim a full disk gram using squibby brightness info +unwrap.par +unwrap.x program to remove binary wrap-around from images +vt.h +vtblink.cl script to blink images on the IIS to check registration +vtblink.par +vtel.cl load the vacuum telescope package +vtel.hd info about locations of various files +vtel.men menu for package +vtel.par +vtexamine.par +vtexamine.x program to examine a vacuum telescope tape (tell about record + lengths, header info, number of files, etc.) +writetape.cl script to write five full disk grams to tape +writetape.par +writevt.par +writevt.x program to write a full disk gram to tape in mountain format +x_vtel.x package parent program diff --git a/noao/imred/vtel/Revisions b/noao/imred/vtel/Revisions new file mode 100644 index 000000000..054bb80ea --- /dev/null +++ b/noao/imred/vtel/Revisions @@ -0,0 +1,209 @@ +This is the vacuum telescope package revisions file. + +mkpkg + Added some missing file dependencies and removed unnecessary ones from + the mkpkg file. (9/30/99, Davis) + +doc/dicoplot.hlp +doc/readvt.hlp +doc/unwrap.hlp +doc/pimtext.hlp + Fixed minor formating problems. (4/22/99, Valdes) + +======= +V2.11.1 +======= + +May 16, 1989 by Dyer Lytle mods to 'readvt', 'syndico', and 'mscan' + +Fixed readvt to work with tape drives over the network [(if (mtfile(...]. +Modified syndico to take advantage of the disk-center info in the image +header. + +Modified mscan to be much faster by taking out the geometrical correction. +Also simplified it by removing the date/time pimtext call. Also made it +create only the images needed. Also made it have a short file name option. +Also made it work on tape drives over the net. + + +June 5, 1988 by Dyer Lytle modification to PUTSQIB + +PUTSQIB had code in it for triming the limb as well as merging the two +images. I simplified the program to just make the merge. The task TRIM +can be used to trim the limb, and do a better job of it at that. + +September 29, 1987 by Dyer Lytle add SYNDICO to package + +Added this new program for makeing dicomed prints of daily +grams 18 cm across. + +July 17, 1987 by Dyer Lytle fix bug in numeric.x + +There was a bug in the way an error flag was being set that made +the program fail with a 'divide by zero' error on some data sets. + +June 8, 1987 by Dyer Lytle Overhaul of the package + +Major modifications were made to the code to make it conform to IRAF +standards. Dynamic memory allocation replaced fixed memory allocation +in many places. Readvt was modified to accept templates for input +and output file names. New structures were provided for the vacuum +telescope header, the tapeio buffer, and to reduce the argument count +for the subroutine 'numeric'. Vtfix was dropped from the package +since 'readvt' was modified to check for long records by doing its +own buffering. Unwrap was updated to a new, more general and powerful +version. A major bug was found and fixed in 'rmap' which was causing +the total mapped pixel count to be off by about 20%. + +June 10, 1986 by Dyer Lytle Modification of PIMTEXT + +Pimtext was modified to allow the user to magnify the text in x and/or y +and to get the date and/or time from a reference image if desired. + +May 21, 1986 by Dyer Lytle Addition of PIMTEXT to package + +Pimtext was added to the vacuum telescope package. This program allows +the user to insert text directly into images. The default action of the +program is to look up the date and time in the image headers and insert +this information in the lower left corner of each image. The user can +modify the parameters to write any text string. + +May 15, 1986 by Dyer Lytle Modification to Mscan + +Mscan was modified to write the date and time into the images using +a pixel font. A hidden argument controls this option. The characters +are written into the image itself to speed up the moviemaking process. +Various hidden parameters were added to allow the user to specify +things about the text such as postition, pixel value, background fill, +and background value. + +May 7, 1986 by Dyer Lytle Modification to Makeimages and Destreak5 + +Makeimages and Destreak5 were modified to accept as another argument +the input scratch disk on which the input files are to be expected. + +February 19, 1986 by Dyer Lytle Modification to Fitslogr + +Rfits was changed to produce a short header by default instead of +a long header. I changed fitslogr to force the long header it needs. + +February 6, 1986 by Dyer Lytle Modification to Dicoplot + +Dicoplot was plotting all of the dates in the input image header +file. Sometimes, this list includes dates which should appear +off the plot, before the zero or after the 360 degree marks. +The modification involved teaching the program to dump these +extra dates instead of putting them on the plots. + +January 30, 1986 by Dyer Lytle Modification to vtfix + +Vtfix was originally set up to correct extra long records on +vacuum telescope tapes. It looked to record lengths of 10242 +bytes and truncated them to 10240 bytes. Today I found a tape +with lots of different record lengths all larger than 10240 so +I modified vtfix to look for records with lengths longer than +10240 bytes and truncate them to 10240. + +January 29, 1986 by Dyer Lytle Modification to makehelium. + +Makehelium was modified to automatically delete the absolute +value image output from RMAP since this image is junk anyway. + +January 29, 1986 by Dyer Lytle Bug fix and mods to dicoplot. + +Dicoplot had a bug which caused the Ratio (POLARITY) images to +come out zero. This was corrected. Also some of the constants +in GREYMAP were changed to increase the contrast in the weights +image and in the abs. flux image. The greyscale as drawn on the +images was modified to not have white boxes around each grey level +and to have the number associated with each grey level printed on the +plot. + +January 28, 1986 by Dyer Lytle Modifications to mscan. + +Mscan was using too much memory when processing large images. +This was causing a lot of page fault errors on VMS. A modification +was made to mscan to use fixed size subrasters, decreasing the +memory needs drastically. + +January 20, 1986 by Dyer Lytle Modifications to readss4.x. + +Readss4, which is a subroutine called by mscan to read type 4 +sector scans was set up to add the average field to each pixel +of the output image. This was found to be useful only in the +special case of type 4 intensity scans and was removed. +"It wasn't a BUG, it was a FEATURE!" + +January 20, 1986 by Dyer Lytle Modifications to destreak.x. + +Destreak was set up to use a temporary image for data storage +between the two destreaking passes. The temporary image was +hardwired into the name "tempim". This was found to unacceptable +since two or more destreaking jobs run at the same time would have +a collision at "tempim". The temporary image was made into an input +parameter. + +January 20, 1986 by Dyer Lytle Modifications to CL scripts. + +The CL scripts makeimages.cl, makehelium.cl, destreak5.cl, and +writetape.cl were modified to check for the existence of each file +before it tries to use it. An error message is output if an image +cannot be accessed. + +January 20, 1986 by Dyer Lytle Modification to vtblink.cl + +Vtblink was modified so that the command "stat" can be entered to the +"next image" prompt and the script will list which images are loaded +into which IIS memory plane. + +January 20, 1986 by Dyer Lytle Modification to merge.x + +Merge was not set up to handle the differences between the magnetogram +reduction and the 10830 reduction. Magnetogram data has three(3) images +per day and 10830 data has two(2) images per day. The extra image for +magnetogram data is the absolute value immage. Merge was designed to +expect all three images and to produce four(4) output images. When +10830 data is input merge should expect two input images per day and +only produce two output images. This modification was made. +Also the output images were set up such that the data and absolute +value images were output without being divided by the weight image. +This was changed since no information is lost by doing this division +since the weight image is also saved. Merge was also restructured +quite a bit but is still a mess and needs rewriting, but it works. + +January 20, 1986 by Dyer Lytle Modification to rmap.x + +Rmap was changed to calculate the average field, the average absolute +field, and the total number of pixels for each gram reduced. +These parameters are stored in the reduced data image header as +MEAN_FLD, MEANAFLD, and NUM_PIX. + +January 10, 1986 by Dyer Lytle Bug fix in tcopy. + +Tcopy was reporting errors incorrectly. The record number identified +with the error was one less than the actual error record. + +January 10, 1986 by Dyer Lytle Modification to decodeheader.x. + +Changed the format used by decodeheader to print out the date and time, +the format was of variable width depending on the size of the number printed. +The new format has fixed length fields. + +January 9, 1986 by Dyer Lytle Modification to merge. + +Merge was modified to expect the images in the textfile 'mergelist' to be in the +order (data, abs value, weights) instead of (data, weights, abs value). + +January 3, 1986 by Dyer Lytle Correction to dicoplot. + +Dicoplot had, for some integer expressions, TRUE/FALSE instead of YES/NO. +This works fine on the UNIX system but was found to fail on VMS. + +January 3, 1986 by Dyer Lytle Correction to mscan. + +Mscan was not reading type one(1) area scans properly. The error occurred +in readss1 where a temporary array was being salloced with the wrong length. +The correction involved replacing "ny" by "2*ny". +Also, readss1 and readss3 had a rather contrived error recovery mechanism built +in, I removed this and will add a more general and reliable error procedure +based on the fset(VALIDATE) call in a later revision. diff --git a/noao/imred/vtel/asciilook.inc b/noao/imred/vtel/asciilook.inc new file mode 100644 index 000000000..68974d34e --- /dev/null +++ b/noao/imred/vtel/asciilook.inc @@ -0,0 +1,19 @@ +data (asciilook[i], i=1,7) / 449, 449, 449, 449, 449, 449, 449 / +data (asciilook[i], i=8,14) / 449, 449, 449, 449, 449, 449, 449 / +data (asciilook[i], i=15,21) / 449, 449, 449, 449, 449, 449, 449 / +data (asciilook[i], i=22,28) / 449, 449, 449, 449, 449, 449, 449 / +data (asciilook[i], i=29,35) / 449, 449, 449, 449, 001, 008, 015 / +data (asciilook[i], i=36,42) / 022, 029, 036, 043, 050, 057, 064 / +data (asciilook[i], i=43,49) / 071, 078, 085, 092, 099, 106, 113 / +data (asciilook[i], i=50,56) / 120, 127, 134, 141, 148, 155, 162 / +data (asciilook[i], i=57,63) / 169, 176, 183, 190, 197, 204, 211 / +data (asciilook[i], i=64,70) / 218, 225, 232, 239, 246, 253, 260 / +data (asciilook[i], i=71,77) / 267, 274, 281, 288, 295, 302, 309 / +data (asciilook[i], i=78,84) / 316, 323, 330, 337, 344, 351, 358 / +data (asciilook[i], i=85,91) / 365, 372, 379, 386, 393, 400, 407 / +data (asciilook[i], i=92,98) / 414, 421, 428, 435, 442, 449, 232 / +data (asciilook[i], i=99,105) / 239, 246, 253, 260, 267, 274, 281 / +data (asciilook[i], i=106,112) / 288, 295, 302, 309, 316, 323, 330 / +data (asciilook[i], i=113,119) / 337, 344, 351, 358, 365, 372, 379 / +data (asciilook[i], i=120,126) / 386, 393, 400, 407, 449, 449, 449 / +data (asciilook[i], i=127,128) / 449, 449/ diff --git a/noao/imred/vtel/d1900.x b/noao/imred/vtel/d1900.x new file mode 100644 index 000000000..7af25a4b4 --- /dev/null +++ b/noao/imred/vtel/d1900.x @@ -0,0 +1,15 @@ +# D1900 -- Function to return the number of days since the turn of the +# century. + +int procedure d1900 (month, day, year) + +int month, day, year # m,d,y of date + +int mac[12] +data mac/0, 31, 59, 90, 120, 151, 181, 212, 243, 273, 304, 334/ + +begin + d1900 = 365 * year + (year - 1) / 4 + mac[month] + day + if (month >= 3 && mod(year,4) == 0) + d1900 = d1900 + 1 +end diff --git a/noao/imred/vtel/decodeheader.x b/noao/imred/vtel/decodeheader.x new file mode 100644 index 000000000..5d54753de --- /dev/null +++ b/noao/imred/vtel/decodeheader.x @@ -0,0 +1,67 @@ +include +include "vt.h" + +# DECODEHEADER -- Unpack date and time, and, if 'verbose' flag is set, +# display some information to the user. + +procedure decodeheader (hbuf, hs, verbose) + +pointer hbuf # header data input buffer pointer (short, SZ_VTHDR) +pointer hs # header data structure +bool verbose # verbose flag + +int hour, minute, second +int bitupk() + +begin + # Unpack date, time. The constants below are explained in the + # description of the image header and how it is packed. If any + # changes are made the following code will have to be rewritten. + + # Month. The month and day are stored in the first header word. + VT_HMONTH[hs] = (bitupk (int(Mems[hbuf]), 13, 4)) * 10 + + bitupk (int(Mems[hbuf]), 9, 4) + + # Day. + VT_HDAY[hs] = (bitupk (int(Mems[hbuf]), 5, 4)) * 10 + + bitupk (int(Mems[hbuf]), 1, 4) + + # Year. The year is stored in the second header word. + VT_HYEAR[hs] = (bitupk (int(Mems[hbuf+1]), 13, 4)) * 10 + + bitupk (int(Mems[hbuf+1]), 9, 4) + + # Time (seconds since midnight). Stored in the third and forth words. + VT_HTIME[hs] = (bitupk (int(Mems[hbuf+2]), 1, 2)) * 2**15 + + bitupk (int(Mems[hbuf+3]), 1, 15) + + # Store other header parameters. Stored one per word. + VT_HWVLNGTH[hs] = Mems[hbuf+4] # Wavelength (angstroms) + VT_HOBSTYPE[hs] = Mems[hbuf+5] # Observation type (0,1,2,3,or 4) + VT_HAVINTENS[hs] = Mems[hbuf+6] # Average intensity + VT_HNUMCOLS[hs] = Mems[hbuf+7] # Number of columns + VT_HINTGPIX[hs] = Mems[hbuf+8] # Integrations per pixel + VT_HREPTIME[hs] = Mems[hbuf+9] # Repitition time + + # Calculate the time in hours, minutes, and seconds instead of + # seconds since midnight. + + hour = int(VT_HTIME[hs]/3600) + minute = int((VT_HTIME[hs] - hour * 3600)/60) + second = VT_HTIME[hs] - hour * 3600 - minute * 60 + + # If verbose, print out some header info on one line no . + if (verbose) { + call printf ("%02d/%02d/%02d %02d:%02d:%02d") + call pargi (VT_HMONTH[hs]) + call pargi (VT_HDAY[hs]) + call pargi (VT_HYEAR[hs]) + call pargi (hour) + call pargi (minute) + call pargi (second) + call printf (" wvlngth %d obstype %d numcols %d") + call pargi (VT_HWVLNGTH[hs]) + call pargi (VT_HOBSTYPE[hs]) + call pargi (VT_HNUMCOLS[hs]) + call flush (STDOUT) + } +end diff --git a/noao/imred/vtel/dephem.x b/noao/imred/vtel/dephem.x new file mode 100644 index 000000000..6c8c315d9 --- /dev/null +++ b/noao/imred/vtel/dephem.x @@ -0,0 +1,139 @@ +# EPHEM -- Calculate ephemeris data for the sun, return latitude and +# longitude of sub-earth point. + +procedure ephem (month, day, year, hour, minute, second, image_r, + bn_degrees, cldc_degrees, verbose) + +int month # time of observation +int day # +int year # +int hour # +int minute # +int second # +real image_r # image radius +real bn_degrees # solar latitude of sub-earth point (degrees) +real cldc_degrees # Carrington longitude of disk center +bool verbose # verbose flag + +double radians_per_degree, pi, two_pi, st, d, dd +double ma, sin_ma, sin_two_ma, ml, e, e_squared, e_cubed +double ep, ea, r, image_r_squared, tl +double lan, bn, p, p_degrees +double sl1, sl2, cldc, cos_bn, x, cl1 +double sin_three_ma, sec_bn, y +double dd_squared, dd_cubed, c, s, cl2, sln +int mac[12] + +data mac/0, 31, 59, 90, 120, 151, 181, 212, 243, 273, 304, 334/ + +begin + # This version ignores lunar and planetary perturbations. + radians_per_degree = .017453292519943d+0 + pi = 3.1415926536d+0 + two_pi = pi + pi + + d = double(365 * year + (year - 1)/4 + mac[month] + day) + if (month >= 3 && mod(year, 4) == 0) + d = d + 1.d+0 + st = double(second / 3600. + minute / 60. + hour) + d = d + st/24.d+0 -.5d+0 + dd = d / 10000.d+0 + dd_squared = dd * dd + dd_cubed = dd * dd * dd + + # Mean anomaly. + ma = radians_per_degree * (358.475845d+0 + .985600267d+0 * + d - 1.12d-5 * dd_squared - 7.d-8 * dd_cubed) + ma = mod(ma, two_pi) + sin_ma = sin(ma) + sin_two_ma = sin(2.d+0 * ma) + sin_three_ma = sin(3.d+0 * ma) + + # Mean longitude. + ml = radians_per_degree * + (279.696678d+0 + .9856473354d+0 * d + 2.267d-5 * dd_squared) + ml = mod(ml, two_pi) + + # Ecentricity. + e = 0.01675104d+0 - 1.1444d-5 * dd - 9.4d-9 * dd_squared + e_squared = e * e + e_cubed = e_squared * e + + # Obliquity. + ep = radians_per_degree * (23.452294d+0 - + 3.5626d-3 * dd - 1.23d-7 * dd_squared + 1.03d-8 * dd_cubed) + + # Eccentric anomaly. + ea = ma + (e - e_cubed/8.d+0) * sin_ma + e_squared * sin_two_ma/2.d+0 + + 3.d+0 * e_cubed * sin_three_ma/8.d+0 + + # Radius vector. + r = 1.00000003d+0 * (1.d+0 - e * cos(ea)) + + # Image radius. + image_r = real(961.18d+0 / r) + image_r_squared = double(image_r * image_r) + + # True longitude. + tl = ml + (2.d+0 * e - e_cubed/4.d+0) * sin_ma + 5.d+0 * e_squared * + sin_two_ma/4.d+0 + 13.d+0 * e_cubed * sin_three_ma/12.d+0 + tl = mod(tl, two_pi) + + # Longitude of ascending node of solar equator. + lan = radians_per_degree * (73.666667d+0 + 0.0139583d+0 * + (year + 50.d+0)) + + # Solar latitude of sub-earth point. + bn = asin(sin(tl - lan) * .12620d+0) + bn_degrees = real(bn / radians_per_degree) + if (verbose) { + call printf("B0 (degrees) = %10.5f\n") + call pargr(bn_degrees) + } + + # Position angle of rotation axis. + p = atan(-cos(tl) * tan(ep)) + atan(-cos(tl - lan) * .12722d+0) + p_degrees = p/radians_per_degree + if (verbose) { + call printf("P-angle (degrees) = %10.5f\n") + call pargr(real(p_degrees)) + } + + # Carrington longitude of disk center. + sl1 = (d + 16800.d+0) * 360.d+0/25.38d+0 + sl2 = mod(sl1, 360.d+0) + sln = 360.d+0 - sl2 + sln = radians_per_degree * sln + + cos_bn = cos(bn) + sec_bn = 1.d+0/cos_bn + c = +1.d+0 + s = +1.d+0 + x = -sec_bn * cos(tl - lan) + if (x < 0.) + c = -1.d+0 + y = -sec_bn * sin(tl - lan) * .99200495d+0 + if (y < 0.) + s = -1.d+0 + + cl1 = tan(tl - lan) * 0.99200495d+0 + cl2 = atan(cl1) + if (s == 1.d+0 && c == 1.d+0) + cldc = sln + cl2 + if (s == -1.d+0 && c == -1.d+0) + cldc = sln + cl2 + pi + if (s == 1.d+0 && c == -1.d+0) + cldc = sln + cl2 + pi + if (s == -1.d+0 && c == 1.d+0) + cldc = sln + cl2 + if (cldc < 0.d+0) + cldc = cldc + two_pi + if (cldc > two_pi) + cldc = mod(cldc, two_pi) + + cldc_degrees = real(cldc / radians_per_degree) + if (verbose) { + call printf ("L0 (degrees) = %10.5f\n") + call pargr (cldc_degrees) + } +end diff --git a/noao/imred/vtel/destreak.par b/noao/imred/vtel/destreak.par new file mode 100644 index 000000000..4b03ee85b --- /dev/null +++ b/noao/imred/vtel/destreak.par @@ -0,0 +1,5 @@ +heimage,s,q,,,,Helium 10830 image to be destreaked +heout,s,q,,,,Output image +tempim,s,q,,,,Temporary image +verbose,b,h,no,,,Print out header data and give progress reports +threshold,i,h,3,,,Squibby brightness threshold defining the limb diff --git a/noao/imred/vtel/destreak.x b/noao/imred/vtel/destreak.x new file mode 100644 index 000000000..5002bab93 --- /dev/null +++ b/noao/imred/vtel/destreak.x @@ -0,0 +1,432 @@ +include +include +include +include "vt.h" + +define WINDEXC 800. # constant for weight index calculation +define WINDEX6TH 75. # constant for weight index calculation +define LIMBR .97 # Limb closeness rejection coefficient. +define SOWTHRESH 20. # Sum of weights threshold. +define SZ_WT10830 1024 # size of weight table for destreak +define FCORRECT .9375 # fractional term for lattitude correction + +# Structure for least square fitting parameters. + +define VT_LENSQSTRUCT 8 # Length of VT sq structure + +# Pointers +define VT_SQ1P Memi[$1] # pointers to arrays for least +define VT_SQ1Q1P Memi[$1+1] # squares fit +define VT_SQ1Q2P Memi[$1+2] # +define VT_SQ1Q3P Memi[$1+3] # +define VT_SQ2Q2P Memi[$1+4] # +define VT_SQ2Q3P Memi[$1+5] # +define VT_SQ3Q3P Memi[$1+6] # +define VT_NUMDATAP Memi[$1+7] # + +# Macro definitions +define VT_SQ1 Memr[VT_SQ1P($1)+$2-1] +define VT_SQ1Q1 Memr[VT_SQ1Q1P($1)+$2-1] +define VT_SQ1Q2 Memr[VT_SQ1Q2P($1)+$2-1] +define VT_SQ1Q3 Memr[VT_SQ1Q3P($1)+$2-1] +define VT_SQ2Q2 Memr[VT_SQ2Q2P($1)+$2-1] +define VT_SQ2Q3 Memr[VT_SQ2Q3P($1)+$2-1] +define VT_SQ3Q3 Memr[VT_SQ3Q3P($1)+$2-1] +define VT_NUMDATA Memi[VT_NUMDATAP($1)+$2-1] + + +# DESTREAK -- Destreak 10830 grams. On a 10830 full disk image. For +# each diode, based on the data from that diode calculate coefficients for +# a best fit function and subtract this function from the data. Apply a +# spatial filter to the resulting image. + +procedure t_destreak() + +char heimage[SZ_FNAME] # input image +char heout[SZ_FNAME] # output image +char tempim[SZ_FNAME] # temporary image +bool verbose # verbose flag +real el[LEN_ELSTRUCT] # ellipse parameters data structure +int threshold # squibby brightness threshold + +int diode, npix, i, line +int kxdim, kydim +real kernel[3,9] +pointer weights +pointer lgp1, lpp +pointer heim, heoutp +pointer a, c +pointer sqs, sp + +bool clgetb() +int clgeti() +real imgetr() +pointer imgl2s(), impl2s(), immap() +errchk immap, imgl2s, impl2s, imfilt + +begin + call smark (sp) + call salloc (sqs, VT_LENSQSTRUCT, TY_STRUCT) + call salloc (VT_SQ1P(sqs), DIM_VTFD, TY_REAL) + call salloc (VT_SQ1Q1P(sqs), DIM_VTFD, TY_REAL) + call salloc (VT_SQ1Q2P(sqs), DIM_VTFD, TY_REAL) + call salloc (VT_SQ1Q3P(sqs), DIM_VTFD, TY_REAL) + call salloc (VT_SQ2Q2P(sqs), DIM_VTFD, TY_REAL) + call salloc (VT_SQ2Q3P(sqs), DIM_VTFD, TY_REAL) + call salloc (VT_SQ3Q3P(sqs), DIM_VTFD, TY_REAL) + call salloc (VT_NUMDATAP(sqs), DIM_VTFD, TY_INT) + call salloc (a, DIM_VTFD, TY_REAL) + call salloc (c, DIM_VTFD, TY_REAL) + call salloc (weights, SZ_WT10830, TY_REAL) + + # Get parameters from the cl. + + call clgstr ("heimage", heimage, SZ_FNAME) + call clgstr ("heout", heout, SZ_FNAME) + call clgstr ("tempim", tempim, SZ_FNAME) + verbose = clgetb ("verbose") + threshold = clgeti("threshold") + + # Open the images + heim = immap (heimage, READ_WRITE, 0) + heoutp = immap (tempim, NEW_COPY, heim) + + # Ellipse parameters. + E_XCENTER[el] = imgetr (heim, "E_XCEN") + E_YCENTER[el] = imgetr (heim, "E_YCEN") + E_XSEMIDIAMETER[el] = imgetr (heim, "E_XSMD") + E_YSEMIDIAMETER[el] = imgetr (heim, "E_XSMD") + + # Generate the weight array. + do i = 1, SZ_WT10830 + Memr[weights+i-1] = exp((real(i) - WINDEXC)/WINDEX6TH) + + # Set the sq arrays and the a and c arrays to zero. + call aclrr (VT_SQ1(sqs,1), DIM_VTFD) + call aclrr (VT_SQ1Q1(sqs,1), DIM_VTFD) + call aclrr (VT_SQ1Q2(sqs,1), DIM_VTFD) + call aclrr (VT_SQ1Q3(sqs,1), DIM_VTFD) + call aclrr (VT_SQ2Q2(sqs,1), DIM_VTFD) + call aclrr (VT_SQ2Q3(sqs,1), DIM_VTFD) + call aclrr (VT_SQ3Q3(sqs,1), DIM_VTFD) + call aclri (VT_NUMDATA(sqs,1), DIM_VTFD) + call aclrr (Memr[a], DIM_VTFD) + call aclrr (Memr[c], DIM_VTFD) + + # for all lines in the image { + # calculate which diode this line corresponds to + # get the line from the image + # sum the q's for this line + # } + + npix = IM_LEN(heim,1) + do line = 1, DIM_VTFD { + diode = mod((line - 1), SWTH_HIGH) + 1 + lgp1 = imgl2s (heim, line) + call qsumq (Mems[lgp1], npix, el, threshold, weights, LIMBR, + line, sqs) + } + + # Fit the function to the data for each line. + do line = 1, DIM_VTFD { + call qfitdiode(sqs, line, npix, Memr[a+line-1], Memr[c+line-1], + threshold, verbose) + if (verbose) { + call printf ("line = %d\n") + call pargi (line) + call flush (STDOUT) + } + } + + # For each image line subtract the function from the data. + do line = 1, DIM_VTFD { + diode = mod((line - 1), SWTH_HIGH) + 1 + lgp1 = imgl2s (heim, line) + lpp = impl2s (heoutp, line) + call qrfunct(Mems[lgp1], Mems[lpp], npix, el, threshold, + Memr[a+line-1], Memr[c+line-1], LIMBR, line) + } + + # Switch images + call imunmap (heim) + call imunmap (heoutp) + heim = immap (tempim, READ_WRITE, 0) + heoutp = immap (heout, NEW_COPY, heim) + + # Call the spacial filter program. + + # First we have to load up the filter kernel + kxdim = 3 + kydim = 9 + kernel[1,1] = .017857 + kernel[1,2] = .017857 + kernel[1,3] = .035714 + kernel[1,4] = .035714 + kernel[1,5] = .035714 + kernel[1,6] = .035714 + kernel[1,7] = .035714 + kernel[1,8] = .017857 + kernel[1,9] = .017857 + kernel[2,1] = .017857 + kernel[2,2] = .053571 + kernel[2,3] = .071428 + kernel[2,4] = .071428 + kernel[2,5] = .071428 + kernel[2,6] = .071428 + kernel[2,7] = .071428 + kernel[2,8] = .053571 + kernel[2,9] = .017857 + kernel[3,1] = .017857 + kernel[3,2] = .017857 + kernel[3,3] = .035714 + kernel[3,4] = .035714 + kernel[3,5] = .035714 + kernel[3,6] = .035714 + kernel[3,7] = .035714 + kernel[3,8] = .017857 + kernel[3,9] = .017857 + + if (verbose) { + call printf ("filtering\n") + call flush(STDOUT) + } + call imfilt(heim, heoutp, kernel, kxdim, kydim, el) + + # Unmap the images. + call imunmap(heim) + call imunmap(heoutp) + + call sfree (sp) + +end + + +# QFITDIODE -- Calculate the coefficients of the best fit functions. + +procedure qfitdiode (sqs, line, npix, a, c, threshold, verbose) + +pointer sqs # q's structure +int line # line in image +int npix # number of pixels +real a, c # returned coeffs +int threshold # sqib threshold +bool verbose # verbose flag + +int i, j +real zz[4,4], limbr + +begin + # If the number of points is insufficient, skip. + if (VT_NUMDATA(sqs,line) < 50) { + a = 0.0 + c = 0.0 + return + } + + # First set the out arrays equal to the in arrays, initialize limbr. + limbr = LIMBR + + + # Clear the z array. + do i = 1,4 + do j = 1,4 + zz[i,j] = 0.0 + + # Fill the z array. + zz[1,2] = VT_SQ1Q1(sqs,line) + zz[1,3] = VT_SQ1Q2(sqs,line) + zz[1,4] = VT_SQ1Q3(sqs,line) + zz[2,3] = VT_SQ2Q2(sqs,line) + zz[2,4] = VT_SQ2Q3(sqs,line) + zz[3,4] = VT_SQ3Q3(sqs,line) + + # Do the fit if the sum of weights is sufficient. + if (VT_SQ1(sqs,line) > SOWTHRESH) + call lstsq(zz,4,VT_SQ1(sqs,line)) + else { + zz[3,1] = 0.0 + zz[3,2] = 0.0 + } + + # Coefficients are: + if (verbose) { + call printf ("a = %g, c = %g ") + call pargr(zz[3,1]) + call pargr(zz[3,2]) + call flush(STDOUT) + } + c = zz[3,1] + a = zz[3,2] +end + + +# SUMQ -- Sum up the values of the Qs for the least squares fit. + +procedure qsumq (in, npix, el, threshold, weights, limbr, y, sqs) + +short in[npix] # array to sum from +pointer weights # weights +real el[LEN_ELSTRUCT] # limb fit ellipse struct +real limbr # limb closeness rejection coefficient +int npix # numpix in im line +int threshold # sqib threshold +int y # line in image +pointer sqs # pointer to q's structure + +real q1, q2, q3 +int i, windex, itemp +real rsq, r4th, r6th, r8th +real x, xfr, yfr, data +short k + +int and() +short shifts() + +begin + k = -4 + + # First, calculate the y fractional radius squared. + yfr = (abs(real(y) - E_YCENTER[el]))**2 / (E_YSEMIDIAMETER[el]**2) + + # Do this for all the pixels in this row. + do i = 1, npix { + # Calculate the x fractional radius squared. + x = real(i) + xfr = (abs(x - E_XCENTER[el]))**2 / E_XSEMIDIAMETER[el]**2 + + # If off the disk, skip. + if (xfr > 1.0) { + next + } + + # Check to see if the brightness of this data point is above the + # threshold, if not, skip. + + itemp = in[i] + if (and(itemp,17B) < threshold) + next + + # Strip off the squibby brightness, if data too big skip. + data = real(shifts(in[i], k)) + if (data > 100.) + next + + # Calculate the radius squared. (fractional) + rsq = xfr + yfr + + # Check to see if the data point is on the disk. + if (rsq > limbr) + next + + r4th = rsq * rsq + r6th = rsq * r4th + r8th = r4th * r4th + + # Calculate the weight index. + windex = WINDEXC + data + WINDEX6TH * r6th + if (windex < 1) + windex = 1 + if (windex > SZ_WT10830) + windex = SZ_WT10830 + + # Calculate the Qs. + q1 = Memr[weights+windex-1] + q2 = q1 * r6th + q3 = q1 * data + VT_SQ1(sqs,y) = VT_SQ1(sqs,y) + q1 + VT_SQ1Q1(sqs,y) = VT_SQ1Q1(sqs,y) + q1 * q1 + VT_SQ1Q2(sqs,y) = VT_SQ1Q2(sqs,y) + q1 * q2 + VT_SQ1Q3(sqs,y) = VT_SQ1Q3(sqs,y) + q1 * q3 + VT_SQ2Q2(sqs,y) = VT_SQ2Q2(sqs,y) + q2 * q2 + VT_SQ2Q3(sqs,y) = VT_SQ2Q3(sqs,y) + q2 * q3 + VT_SQ3Q3(sqs,y) = VT_SQ3Q3(sqs,y) + q3 * q3 + VT_NUMDATA(sqs,y) = VT_NUMDATA(sqs,y) + 1 + } +end + + +# QRFUNCT -- Remove FUNCTion. Remove the calculated function from the data +# from a particular diode. Each data point is checked to see if it is on +# disk. If it is not then the input pixel is copied to the output array. +# if it is on the disk, the function defined by a and c is subtracted from +# the data point before it is copied to the output array. + +procedure qrfunct (in, out, npix, el, threshold, a, c, limbr, y) + +short in[npix] # inline without fit removed +short out[npix] # inline with fit removed +real el[LEN_ELSTRUCT] # ellipse parameter struct +real a, c # fit coefficients +real limbr # limb closeness coefficient +int y # line of image +int npix # number of pixels in this line +int threshold # sqib threshold + +int i +short fvalue +short data +real x, xfr, yfr, rsq, y4th, y6th +short correction +short k, kk + +short shifts() + +begin + k = -4 + kk = 4 + + # If a and c have zeros, skip. + if (abs(a) < EPSILONR && abs(c) < EPSILONR) { + do i = 1, npix { + out[i] = in[i] # leave original data. + } + return + } + + # First, calculate the y fractional radius. + yfr = (abs(real(y) - E_YCENTER[el]))**2 / (E_YSEMIDIAMETER[el]**2) + + # Calculate the correction. + y4th = yfr*yfr + y6th = y4th*yfr + correction = short(FCORRECT*(6.0*yfr + 8.0*y4th + 16.0*y6th)) + + # Do this for all the pixels in the row. + do i = 1, npix { + # Calculate the x fractional radius. + x = real(npix/2 - i + 1) + xfr = (abs(real(i) - E_XCENTER[el]))**2 / E_XSEMIDIAMETER[el]**2 + + # If off the disk, skip. + if (xfr > 1.0) { + out[i] = in[i] # leave original data + next + } + + # Check to see if the brightness of this data point is above the + # threshold, if not, skip. + + if (and(int(in[i]),17B) < threshold) { + out[i] = in[i] # leave original data + next + } + + # Strip off the squibby brightness + data = shifts(in[i], k) + + # Calculate the radius squared. (fractional) + rsq = xfr + yfr + + # Check to see if the data point is on the disk. + if (rsq > 1.0) { + out[i] = in[i] # leave original data + next + } + + # Calculate the function value. Subtract it from the data value. + fvalue = short(a * rsq**3 + c) # a * r**6 + c + data = data - fvalue + correction + # data + squib bright + out[i] = shifts(data, kk) + short(and(int(in[i]),17B)) + } +end diff --git a/noao/imred/vtel/destreak5.cl b/noao/imred/vtel/destreak5.cl new file mode 100644 index 000000000..40a3be552 --- /dev/null +++ b/noao/imred/vtel/destreak5.cl @@ -0,0 +1,91 @@ +#{ DESTREAK5 -- Destreak all five images from a vacuum telescope tape. The +# script accepts the general input image filename and the general output +# image filename from the user (and now the scratch disk). Destreak5 +# appends a digit [1-5] to the file name for each file read and each +# corresponding file written. + +# getinput,s,a,,,,General input filename for the 5 images +# getoutput,s,a,,,,General output filename for the 5 images +# inim,s,h +# outim,s,h + +{ + + inim = getinput + outim = getoutput + + if (access("vtelscr$"//inim//"001")) { + readvt ("vtelscr$"//inim//"001", inim//"tmp1") + quickfit (inim//"tmp1001",verbose=yes) + delete ("vtelscr$"//inim//"001") + getsqib (inim//"tmp1001", inim//"sqib1") + destreak (inim//"tmp1001", inim//"temp1", inim//"tmpr1") + imdelete (inim//"tmp1001") + imdelete (inim//"tmpr1") + putsqib (inim//"temp1", inim//"sqib1", outim//"1") + imdelete (inim//"temp1") + imdelete (inim//"sqib1") + } else { + print ("vtelscr$"//inim//"001 not accessable") + } + + if (access("vtelscr$"//inim//"002")) { + readvt ("vtelscr$"//inim//"002", inim//"tmp2") + quickfit (inim//"tmp2001",verbose=yes) + delete ("vtelscr$"//inim//"002") + getsqib (inim//"tmp2001", inim//"sqib2") + destreak (inim//"tmp2001", inim//"temp2", inim//"tmpr2") + imdelete (inim//"tmp2001") + imdelete (inim//"tmpr2") + putsqib (inim//"temp2", inim//"sqib2", outim//"2") + imdelete (inim//"temp2") + imdelete (inim//"sqib2") + } else { + print ("vtelscr$"//inim//"002 not accessable") + } + + if (access("vtelscr$"//inim//"003")) { + readvt ("vtelscr$"//inim//"003", inim//"tmp3") + quickfit (inim//"tmp3001",verbose=yes) + delete ("vtelscr$"//inim//"003") + getsqib (inim//"tmp3001", inim//"sqib3") + destreak (inim//"tmp3001", inim//"temp3", inim//"tmpr3") + imdelete (inim//"tmp3001") + imdelete (inim//"tmpr3") + putsqib (inim//"temp3", inim//"sqib3", outim//"3") + imdelete (inim//"temp3") + imdelete (inim//"sqib3") + } else { + print ("vtelscr$"//inim//"003 not accessable") + } + + if (access("vtelscr$"//inim//"004")) { + readvt ("vtelscr$"//inim//"004", inim//"tmp4") + quickfit (inim//"tmp4001",verbose=yes) + delete ("vtelscr$"//inim//"004") + getsqib (inim//"tmp4001", inim//"sqib4") + destreak (inim//"tmp4001", inim//"temp4", inim//"tmpr4") + imdelete (inim//"tmp4001") + imdelete (inim//"tmpr4") + putsqib (inim//"temp4", inim//"sqib4", outim//"4") + imdelete (inim//"temp4") + imdelete (inim//"sqib4") + } else { + print ("vtelscr$"//inim//"004 not accessable") + } + + if (access("vtelscr$"//inim//"005")) { + readvt ("vtelscr$"//inim//"005", inim//"tmp5") + quickfit (inim//"tmp5001",verbose=yes) + delete ("vtelscr$"//inim//"005") + getsqib (inim//"tmp5001", inim//"sqib5") + destreak (inim//"tmp5001", inim//"temp5", inim//"tmpr5") + imdelete (inim//"tmp5001") + imdelete (inim//"tmpr5") + putsqib (inim//"temp5", inim//"sqib5", outim//"5") + imdelete (inim//"temp5") + imdelete (inim//"sqib5") + } else { + print ("vtelscr$"//inim//"004 not accessable") + } +} diff --git a/noao/imred/vtel/destreak5.par b/noao/imred/vtel/destreak5.par new file mode 100644 index 000000000..41accc842 --- /dev/null +++ b/noao/imred/vtel/destreak5.par @@ -0,0 +1,4 @@ +getinput,s,a,,,,Root input filename for the 5 images +getoutput,s,a,,,,Root output filename for the 5 images +inim,s,h +outim,s,h diff --git a/noao/imred/vtel/dicoplot.h b/noao/imred/vtel/dicoplot.h new file mode 100644 index 000000000..592fc8c84 --- /dev/null +++ b/noao/imred/vtel/dicoplot.h @@ -0,0 +1,35 @@ +# for the following it is assumed the scale of the coordinate system is zero +# to one in both x and y. (0.0,0.0) to (1.0,1.0) +# coordinates of first image (bottom-left-x, bottom-left-y, top-right-x, t-r-y) +define IM1BL_X .242 +define IM1BL_Y .142 +define IM1TR_X .452 +define IM1TR_Y .822 + +# coordinates of second image +define IM2BL_X .525 +define IM2BL_Y .142 +define IM2TR_X .735 +define IM2TR_Y .822 + +# coordinates of greyscale box +define IMGBL_X .229 +define IMGBL_Y .867 +define IMGTR_X .748 +define IMGTR_Y .902 + +# coordinates of outside boundary of entire plot +define IMDBL_X .210 +define IMDBL_Y .076 +define IMDTR_X .810 +define IMDTR_Y .950 + +# length of tics when labeling axes +define TICLENGTH .002 + +#image types +define T10830 1 +define TFLUX 4 +define TWEIGHT 3 +define TABSFLX 2 +define TPLRTY 5 diff --git a/noao/imred/vtel/dicoplot.par b/noao/imred/vtel/dicoplot.par new file mode 100644 index 000000000..e8348a766 --- /dev/null +++ b/noao/imred/vtel/dicoplot.par @@ -0,0 +1,4 @@ +image1,s,q,,,,Image1 +image2,s,q,,,,Image2 +rotnum,i,q,,,,carrington rotation number +device,s,h,dicomed,,,plot device diff --git a/noao/imred/vtel/dicoplot.x b/noao/imred/vtel/dicoplot.x new file mode 100644 index 000000000..3754bb06d --- /dev/null +++ b/noao/imred/vtel/dicoplot.x @@ -0,0 +1,522 @@ +include +include +include +include +include +include "dicoplot.h" +include "vt.h" + +# DICOPLOT -- Make dicomed (or other graphics device) plots of Carrington +# rotation maps. The output of this program is a metacode file called +# "metacode" which can be plotted on whichever graphics device the user +# chooses. Before the program is run, STDGRAPH should be set to the target +# device. + +procedure t_dicoplot() + +char image1[SZ_FNAME] # first image to draw +char image2[SZ_FNAME] # second image to draw +int rotnum # carrington rotation number +char device[SZ_FNAME] # plot device + +int type1, type2 # types of the two images +pointer imout1 +pointer imout2 +int count, obsdate +int i, longitude, latitude, month, day, year +int xresolution, yresolution +real delta_gray, delta_long, delta_gblock, x, y +real offset, longituder +real mapx1, mapx2, mapy1, mapy2 +char ltext[SZ_LINE] +char system_id[SZ_LINE] + +bool up, pastm +int dateyn + +short gray[16] +pointer imgray1 +pointer imgray2 +pointer gp, p, sp +pointer im1, im2 +pointer subras1, subras2 + +pointer imgs2r() +pointer immap() +pointer gopen() +int imaccf() +int ggeti() +real imgetr() +int clgeti(), imgeti() +errchk gopen, immap, imgs2r, sysid + +begin + call smark (sp) + call salloc (imout1, DIM_SQUAREIM*DIM_XCARMAP, TY_REAL) + call salloc (imout2, DIM_SQUAREIM*DIM_XCARMAP, TY_REAL) + call salloc (imgray1, DIM_SQUAREIM*DIM_XCARMAP, TY_SHORT) + call salloc (imgray2, DIM_SQUAREIM*DIM_XCARMAP, TY_SHORT) + + # Get parameters from the cl. + call clgstr ("image1", image1, SZ_FNAME) + call clgstr ("image2", image2, SZ_FNAME) + rotnum = clgeti ("rotnum") + call clgstr ("device", device, SZ_FNAME) + + # Open the output file. + gp = gopen (device, NEW_FILE, STDPLOT) + + # Open the images + im1 = immap (image1, READ_ONLY, 0) + im2 = immap (image2, READ_ONLY, 0) + + # Find out what kind of images we have. + call gimtype (im1, type1) + call gimtype (im2, type2) + + # Draw boxes around the grayscale and the data images. + call box (gp, IM1BL_X, IM1BL_Y, IM1TR_X, IM1TR_Y) + call box (gp, IM2BL_X, IM2BL_Y, IM2TR_X, IM2TR_Y) + + delta_gblock = (IMGTR_X - IMGBL_X)/16. + y = IMGBL_Y - .005 + do i = 1, 16 { + x = IMGBL_X + real(i-1) * delta_gblock + delta_gblock/2. + call sprintf (ltext, SZ_LINE, "%d") + call pargi ((i-1)*int((254./15.)+0.5)) + call gtext (gp, x, y, ltext, "v=t;h=c;s=.20") + } + + + # Draw tic marks and labels on the image boxes. + # First the longitudes. + + delta_long = (IM1TR_Y-IM1BL_Y)/36. + longitude = 0 + do i = 1,37 { + call sprintf (ltext, SZ_LINE, "%d") + call pargi (longitude) + y = IM1TR_Y - real(i-1)*delta_long + x = IM1TR_X + call gline (gp, x,y,x+TICLENGTH,y) + x = IM1BL_X + call gline (gp, x,y,x-TICLENGTH,y) + call gtext (gp, x-.005, y, ltext, "v=c;h=r;s=.25;u=0") + x = IM2TR_X + call gline (gp, x,y,x+TICLENGTH,y) + x = IM2BL_X + call gline (gp, x,y,x-TICLENGTH,y) + call gtext (gp, x-.005, y, ltext, "v=c;h=r;s=.25;u=0") + longitude = longitude + 10 + } + + # Now the latitudes. + # First draw the tics and labels at 0 degrees on both images + + latitude = 0 + call sprintf (ltext, SZ_LINE, "%d") + call pargi (latitude) + x = (IM1BL_X + IM1TR_X)/2. + y = IM1TR_Y + call gline (gp, x, y, x, y+TICLENGTH) + call gtext (gp, x, y+.005, ltext, "v=b;h=c;s=.25;u=0") + y = IM1BL_Y + call gline (gp, x, y, x, y-TICLENGTH) + x = (IM2BL_X + IM2TR_X)/2. + y = IM2TR_Y + call gline (gp, x, y, x, y+TICLENGTH) + call gtext (gp, x, y+.005, ltext, "v=b;h=c;s=.25;u=0") + y = IM2BL_Y + call gline (gp, x, y, x, y-TICLENGTH) + + # Now the north latitudes. + do i = 1,4 { + switch (i) { + case 1: + latitude = 20 + case 2: + latitude = 40 + case 3: + latitude = 60 + case 4: + latitude = 90 + } + offset = ((IM1TR_X - IM1BL_X)/2.) * sin(real(latitude)*3.1415/180.) + x = IM1BL_X + ((IM1TR_X - IM1BL_X)/2.) + offset + y = IM1TR_Y + call sprintf (ltext, SZ_LINE, "%s%d") + call pargstr ("N") + call pargi (latitude) + call gline (gp, x, y, x, y+TICLENGTH) + call gtext (gp, x, y+.005, ltext, "v=b;h=c;s=.25;u=0") + y = IM1BL_Y + call gline (gp, x, y, x, y-TICLENGTH) + x = x + IM2BL_X - IM1BL_X + y = IM2TR_Y + call gline (gp, x, y, x, y+TICLENGTH) + call gtext (gp, x, y+.005, ltext, "v=b;h=c;s=.25;u=0") + y = IM2BL_Y + call gline (gp, x, y, x, y-TICLENGTH) + } + + # Finally the south latitudes. + do i = 1,4 { + switch (i) { + case 1: + latitude = -20 + case 2: + latitude = -40 + case 3: + latitude = -60 + case 4: + latitude = -90 + } + offset = ((IM2TR_X - IM2BL_X)/2.) * sin(real(latitude)*3.1415/180.) + x = IM1BL_X + ((IM1TR_X - IM1BL_X)/2.) + offset + y = IM1TR_Y + call sprintf (ltext, SZ_LINE, "%s%d") + call pargstr ("S") + call pargi (-latitude) + call gline (gp, x, y, x, y+TICLENGTH) + call gtext (gp, x, y+.005, ltext, "v=b;h=c;s=.25;u=0") + y=IM1BL_Y + call gline (gp, x, y, x, y-TICLENGTH) + x = x + IM2BL_X - IM1BL_X + y = IM2TR_Y + call gline (gp, x, y, x, y+TICLENGTH) + call gtext (gp, x, y+.005, ltext, "v=b;h=c;s=.25;u=0") + y=IM2BL_Y + call gline (gp, x, y, x, y-TICLENGTH) + } + + # Put the titles on. + # We got the carrington rotation number from the cl. + + call sprintf (ltext, SZ_LINE, "CARRINGTON ROTATION %d %s") + call pargi (rotnum) + switch (type1) { + case T10830: + call pargstr ("10830") + case TABSFLX: + call pargstr ("ABS. FLUX") + case TWEIGHT: + call pargstr ("WEIGHT") + case TFLUX: + call pargstr ("FLUX") + case TPLRTY: + call pargstr ("POLARITY") + } + + x = IM1TR_X+.025 + y = IM1BL_Y + (IM1TR_Y - IM1BL_Y) / 2. + call gtext (gp, x, y, ltext, "v=c;h=c;s=.5;u=0") + call sprintf (ltext, SZ_LINE, "CARRINGTON ROTATION %d %s") + call pargi (rotnum) + switch (type2) { + case T10830: + call pargstr ("10830") + case TABSFLX: + call pargstr ("ABS. FLUX") + case TWEIGHT: + call pargstr ("WEIGHT") + case TFLUX: + call pargstr ("FLUX") + case TPLRTY: + call pargstr ("POLARITY") + } + + x = IM2TR_X+.025 + y = IM2BL_Y + (IM2TR_Y - IM2BL_Y) / 2. + call gtext (gp, x, y, ltext, "v=c;h=c;s=.5;u=0") + + # Put on the dates at the appropriate longitudes. + # Get the dates and longitudes from the image header. + # Read dates until we run out. + # This code alternates between long and short tics for the dates. + # For this to work it is assumed that the dates are in + # cronological order. + + # Get the first date and longitude from the image header to check + # whether or not there are any dates. + + count = 1 + call sprintf (ltext, SZ_LINE, "DATE%04d") + call pargi (count) + dateyn = imaccf (im1, ltext) + if (dateyn == NO) + call error(0, "no dates in image header") + obsdate = imgeti (im1, ltext) + call sprintf (ltext, SZ_LINE, "LONG%04d") + call pargi (count) + longituder = imgetr (im1, ltext) + longitude = int(longituder + .5) + + # If we find some dates near the beginning of the list which have + # longitudes smaller than 180, they probably are some "extra" grams + # merged in to fill out the plot, don't plot these dates because they + # are really off the image and will come out in the wrong place if we + # allow them to be plotted. + + while (longitude < 180) { + count = count + 1 + call sprintf (ltext, SZ_LINE, "DATE%04d") + call pargi (count) + dateyn = imaccf (im1, ltext) + if (dateyn == NO) + break + obsdate = imgeti (im1, ltext) + call sprintf (ltext, SZ_LINE, "LONG%04d") + call pargi (count) + longituder = imgetr (im1, ltext) + longitude = int(longituder + .5) + } + + # Calculate the month/day/year. + month = obsdate/10000 + day = obsdate/100 - 100 * (obsdate/10000) + year = obsdate - 100 * (obsdate/100) + + up = FALSE + pastm = FALSE + + while (dateyn == YES) { + + # We check to see whether or not we have gotten past 180 degrees + # so that if we find some images near the end of the list with + # longitudes greater than 180 degrees we will know not to plot + # them since they are off the image. Longitudes of images in the + # image merge list decrease as we go down the list. + + # Past the middle yet? + if (longitude < 180) + pastm = true + + # Figure out where this longitude is in y on the image. + y = real(IM1BL_Y) + ((360. - real(longitude))/360.) * + real(IM1TR_Y - IM1BL_Y) + x = real(IM1TR_X) + + # Draw the tic and the label. + if (!up) + call gline (gp, x, y, x+.005, y) + else + call gline (gp, x, y, x+.011, y) + call sprintf(ltext, SZ_LINE, "%d/%d/%d") + call pargi(month) + call pargi(day) + call pargi(year) + if (!up) + call gtext (gp, x+.006, y, ltext, "v=c;h=l;s=.20;u=0") + else + call gtext (gp, x+.012, y, ltext, "v=c;h=l;s=.20;u=0") + + # Do the other image. + x = real(IM2TR_X) + if (!up) + call gline (gp, x, y, x+.005, y) + else + call gline (gp, x, y, x+.011, y) + if (!up) + call gtext (gp, x+.006, y, ltext, "v=c;h=l;s=.20;u=0") + else + call gtext (gp, x+.012, y, ltext, "v=c;h=l;s=.20;u=0") + + # Toggle up switch. + up = !up + + count = count + 1 + call sprintf (ltext, SZ_LINE, "DATE%04d") + call pargi (count) + dateyn = imaccf (im1, ltext) + + if (dateyn == YES) { + # Calculate the month/day/year. + obsdate = imgeti (im1, ltext) + month = obsdate/10000 + day = obsdate/100 - 100 * (obsdate/10000) + year = obsdate - 100 * (obsdate/100) + + # Read in the next longitude. + call sprintf (ltext, SZ_LINE, "LONG%04d") + call pargi (count) + longituder = imgeti (im1, ltext) + longitude = int(longituder + .5) + + # If we are past the middle and find a longitude in the list + # which is greater than 180 degrees, do not plot this date + # since it is off the image and will be plotted in the wrong + # place. + + if (pastm && longitude > 180) + dateyn = NO + } + } # End of while loop on dates/longitudes. + + # Fill in the gray scale. + delta_gray = 254./15. + do i = 1, 16 { + gray[i] = 1.+real(i-1)*delta_gray+0.5 + } + call gpcell (gp, gray, 16, 1, IMGBL_X, IMGBL_Y, IMGTR_X, IMGTR_Y) + + # Now map the input images from 360x180 to 180x360 and put them + # out to the image. We also map the data values into the appropriate + # gray scale. + + # Get subrasters of the images. + subras1 = imgs2r (im1, 1, DIM_XCARMAP, 1, DIM_SQUAREIM) + subras2 = imgs2r (im2, 1, DIM_XCARMAP, 1, DIM_SQUAREIM) + + # Call the image maping routine on both images. + call remap (Memr[subras1], DIM_XCARMAP, DIM_SQUAREIM, Memr[imout1]) + call remap (Memr[subras2], DIM_XCARMAP, DIM_SQUAREIM, Memr[imout2]) + + # Call the gray scale mapper. + call graymap (Memr[imout1], DIM_SQUAREIM, DIM_XCARMAP, Mems[imgray1], + type1) + call graymap (Memr[imout2], DIM_SQUAREIM, DIM_XCARMAP, Mems[imgray2], + type2) + + # Put the images out to the final image. + xresolution = ggeti (gp, "xr") + yresolution = ggeti (gp, "yr") + mapx1 = IM1BL_X + mapx2 = IM1TR_X + mapy1 = IM1BL_Y + mapy2 = IM1TR_Y + call gpcell (gp, Mems[imgray1], DIM_SQUAREIM, DIM_XCARMAP, mapx1, mapy1, + mapx2, mapy2) + mapx1 = IM2BL_X + mapx2 = IM2TR_X + mapy1 = IM2BL_Y + mapy2 = IM2TR_Y + call gpcell (gp, Mems[imgray2], DIM_SQUAREIM, DIM_XCARMAP, mapx1, mapy1, + mapx2, mapy2) + + # Put the system identification on the plot. + call sysid (system_id, SZ_LINE) + call gtext (gp, .51, .076, system_id, "h=c;s=0.45") + + # Close the graphics pointer. + call gclose(gp) + call close(p) + + call sfree (sp) +end + + +# BOX -- Draw a box around the square described by x1, y1 (bottom left corner) +# and x2, y2 (top right corner). + +procedure box(gp, x1, y1, x2, y2) + +real x1, y1 # bottom left corner position +real x2, y2 # top right corner position +pointer gp # graphics pointer + +begin + call gline (gp, x1, y1, x1, y2) + call gline (gp, x1, y2, x2, y2) + call gline (gp, x2, y2, x2, y1) + call gline (gp, x2, y1, x1, y1) +end + + +# REMAP -- Reformat a 360x180 image into a 180x360 image by rotating the image +# by 90 degrees clockwise. + +procedure remap (inim, x, y, outim) + +real inim[x,y] # input image +real outim[y,x] # output image +int x, y # size of images + +int i, j + +begin + do i = 1, x + do j = 1, y + outim[j,x-i+1] = inim[i,j] +end + + +# GREYMAP -- Map an integer image into a short integer image using a specific +# scaling algorithm to make the full scale 1 to 256. + +procedure graymap (inim, x, y, outim, type) + +real inim[x,y] # input image +int x, y # size of images +int type # type of image +short outim[x,y] # output image + +real zpp[5], zcc[5], zp, zc # parameters for different image types +int i, j, index +short ztbl[512] # grayscale map array, (in gryscl.inc) + +data zpp /.25, .80, 0.2, 1.0, 100. / +data zcc /384., 80., 0., 128., 128. / +include "gryscl.inc" + +begin + # If the image is not a 10830 gram then just multiply each pixel + # by a constant and then add another constant. (different constants + # for flux, abs. flux, weight, and polarity) + # If it is a 10830 gram then multiply and add as above, then use + # the result as an index into a lookup table. The table is enumerated + # above. + + zp = zpp[type] + zc = zcc[type] + do i = 1, x { + do j = 1, y { + outim[i,j] = inim[i,j] * zp + zc + if (type == 1) { # if this is a 10830 gram: + if (outim[i,j] <= 0) # make it fit in the table + outim[i,j] = 1 + if (outim[i,j] > 512) + outim[i,j] = 512 + index = outim[i,j] + outim[i,j] = ztbl[index] + 10 # look it up in the table. + } + if (outim[i,j] <= 0) # check boundaries + outim[i,j] = 1 + if (outim[i,j] >= 255) + outim[i,j] = 254 + } + } +end + + +# GIMTYPE -- Get IMage TYPE. Using information in the image header determine +# what type of image it is. 1 = 10830, 2 = ABS. FLUX, 3 = WEIGHTS, +# 4 = ABS. VALUE, 5 = POLARITY. + +procedure gimtype (im, type) + +pointer im # image pointer +int type # type + +int wavelength, imgeti() +int weightyn, absyn, polarityyn +int imaccf() + +begin + wavelength = imgeti (im, "WV_LNGTH") + weightyn = imaccf (im, "WEIGHTS") + absyn = imaccf (im, "ABS_VALU") + polarityyn = imaccf (im, "POLARITY") + + if (weightyn == NO && absyn == NO && polarityyn == NO) { + if (wavelength == 10830) + type = T10830 + if (wavelength == 8688) + type = TFLUX + } + if (weightyn == YES) + type = TWEIGHT + if (absyn == YES) + type = TABSFLX + if (polarityyn == YES) + type = TPLRTY +end diff --git a/noao/imred/vtel/doc/destreak.hlp b/noao/imred/vtel/doc/destreak.hlp new file mode 100644 index 000000000..ef05d9059 --- /dev/null +++ b/noao/imred/vtel/doc/destreak.hlp @@ -0,0 +1,50 @@ +.help destreak Dec84 noao.imred.vtel +.ih +NAME +destreak -- Remove streaks from Helium 10830 grams +.ih +USAGE +destreak input_image output_image +.ih +PARAMETERS +.ls input_image +Image to be destreaked. +.le +.ls output_image +Name to give destreaked output image (must be a separate image). +.le +.ls tempim +Temporary image used for pixel storage between destreak passes. +.le +.ls verbose=no +Flag to signal program that it should produce verbose output. +.le +.ls threshold = 4 +Squibby brightness threshold to use in determining limb points. +.le +.ih +DESCRIPTION +The helium 10830 grams as taken by the vacuum telescope have horizontal +streaks caused by the detecting apparatus. Destreak removes these streaks +and the limb darkening +using a two pass procedure. First, for each diode, a function of the form +'a + b*r**4', where r is the radius from disk center and a, b are parameters, +is fit to the intensity distribution and is then subtracted from the data. +Then a spatial filter is applied to the result and the final image is +written to disk. The full disk images are 2048 x 2048 and are taken using +a 512 diode array which is scanned from west to east across the solar disk +4 times. Thus, data from a particular diode consists of four lines of the +image. +.ih +EXAMPLES +1. To destreak "image1", put the output in "image2", put the temporary image in +"temp2", and see verbose output, the command would be: + +.nf + vt> destreak image1 image2 temp2 v+ +.fi + +.ih +SEE ALSO +readvt, writevt, quickfit, getsqib, putsqib +.endhelp diff --git a/noao/imred/vtel/doc/destreak5.hlp b/noao/imred/vtel/doc/destreak5.hlp new file mode 100644 index 000000000..8bf383fa9 --- /dev/null +++ b/noao/imred/vtel/doc/destreak5.hlp @@ -0,0 +1,43 @@ +.help destreak5 Dec85 noao.imred.vtel +.ih +NAME +destreak5 -- First pass of 10830 processing +.ih +USAGE +destreak5 input_root output_root +.ih +PARAMETERS +.ls input_root +Root name for input files. +.le +.ls output_root +Root name of output files. +.le +.ih +DESCRIPTION +Destreak5 takes as input the 5 files from a vacuum telescope 10830 +tape and produces 5 nearly identical files but with the streaks +removed from the solar images and with the best fit ellipse parameters +added to the image header. The input files are expected to be in the +directory 'imdir' and to have the extensions '001' thru '005'. These +input files are expected to be mag tape images produced by T2D. The output +files are stored in the current directory with the same extensions. +Destreak5 calls 'readvt','quickfit', 'destreak', and various other utilities +and is a cl script file. +If an input image is not found, the processing for that image is skipped and +a message is printed telling about the missing image. +The next step in the 10830 reduction process is 'makehelium' which produces +the projected daily grams. +.ih +EXAMPLES +1. To destreak five files with root name m1585 and store the resulting images +with root name M1585 the command would be: + +.nf + vt> destreak5 m1585 M1585 +.fi + +.ih +SEE ALSO +readvt, destreak, quickfit +.endhelp diff --git a/noao/imred/vtel/doc/dicoplot.hlp b/noao/imred/vtel/doc/dicoplot.hlp new file mode 100644 index 000000000..5bb9f0712 --- /dev/null +++ b/noao/imred/vtel/doc/dicoplot.hlp @@ -0,0 +1,36 @@ +.help dicoplot Dec84 noao.imred.vtel +.ih +NAME +dicoplot -- Make plots of Carrington maps on the Dicomed +.ih +USAGE +dicoplot input_image1 input_image2 rot_number +.ih +PARAMETERS +.ls input_image1 +First image to plot on the output. +.le +.ls input_image2 +Second image to plot on the output. +.le +.ls rot_number +Carrington rotation number. +.le +.ih +DESCRIPTION +Dicoplot produces plots on the Dicomed. +.ih +EXAMPLES +1. To make a plot containing a 10830 gram and the associated weight gram where +the carrington rotation number is 1841, the 10830 gram is "temp1", +and the weight gram is "carweight" type: + +.nf + vt> dicoplot temp1 carweight 1841 +.fi + +The program gets information about the dates and longitudes from the image +headers. +.ih +SEE ALSO +.endhelp diff --git a/noao/imred/vtel/doc/fitslogr.hlp b/noao/imred/vtel/doc/fitslogr.hlp new file mode 100644 index 000000000..4a195e458 --- /dev/null +++ b/noao/imred/vtel/doc/fitslogr.hlp @@ -0,0 +1,58 @@ +.help fitslogr Dec85 noao.imred.vtel +.ih +NAME +fitslogr -- Make a log of header information from a fits tape +.ih +USAGE +fitslogr input_dev out_file startfnum endfnum +.ih +PARAMETERS +.ls input_dev +Tape drive, e.g. "mta1600" or just "mta" +.le +.ls out_file +Name of output file to store information. Information is appended to this +file to allow one to update a previously created file. +.le +.ls startfnum +Tape file to start logging. +.le +.ls endfnum +Tape file to stop logging. +.le +.ih +DESCRIPTION +Fitslogr reads FITS headers from successive tape files and compiles +certain information into a single line of output for each file. +Currently, the information output for each file includes: + + Tape file number, IRAF image name, date, time, and the + Carrington longitude for each image. + +If all of these header parameters are not present, only the ones found +will be printed out and garbage will come out for the empty parameters. +The date is stored in a header parameter called OBS_DATE, the time is +stored as 'seconds since midnight' in OBS_TIME and the Carrington +longitude is stored in L_ZERO. +To use this script, both the DATAIO package and the VTEL package must +be loaded. +.ih +EXAMPLES +1. To log all of the FITS images on a tape mounted on 'mta' and store the +information in a file called 'CX052' the command would be: + +.nf + vt> fitslogr mta CX052 1 999 +.fi + +2. To log just the 40th through 60th files on mtb and see the output on +your terminal, the command would be: + +.nf + vt> fitslogr mtb STDOUT 40 60 +.fi + +.ih +SEE ALSO +rfits +.endhelp diff --git a/noao/imred/vtel/doc/getsqib.hlp b/noao/imred/vtel/doc/getsqib.hlp new file mode 100644 index 000000000..1bf24fb00 --- /dev/null +++ b/noao/imred/vtel/doc/getsqib.hlp @@ -0,0 +1,33 @@ +.help getsqib Jan85 noao.imred.vtel +.ih +NAME +getsqib -- Extract a full disk squibby brightness image from a full disk image +.ih +USAGE +getsqib inputimage outputimage +.ih +PARAMETERS +.ls inputimage +Name of image to get squibby brightness from. +.le +.ls outputimage +Name of new output squibby brightness image. +.le +.ih +DESCRIPTION +Getsqib takes as input any full disk image and extracts the lower four bits +from each pixel and stores this information in a new output image the same +size as the input image. +.ih +EXAMPLES +1. To extract the squibby brightness image from the image "test1" and store +it in an image called "test1.sqib" the command would be: + +.nf + vt> getsqib test1 test1.sqib +.fi + +.ih +SEE ALSO +putsqib +.endhelp diff --git a/noao/imred/vtel/doc/makehelium.hlp b/noao/imred/vtel/doc/makehelium.hlp new file mode 100644 index 000000000..df27430c7 --- /dev/null +++ b/noao/imred/vtel/doc/makehelium.hlp @@ -0,0 +1,38 @@ +.help makehelium Jan86 noao.imred.vtel +.ih +NAME +makehelium -- Second pass of 10830 processing +.ih +USAGE +makehelium input_root output_root +.ih +PARAMETERS +.ls input_root +Root name for input files. +.le +.ls output_root +Root name of output files. +.le +.ih +DESCRIPTION +Makehelium takes the files output by 'destreak5' and projects them the +small [180x180] maps. The input files are expected to be in the current +directory and have the extensions '1' thru '5'. The output files are +stored in the current directory with the extensions 'a1', 'a2', 'a3', 'b1', etc. +This coding scheme is the same as that used in makeimages. Note that the +absolute value images for 10830 grams should be thrown out since they are +garbage. +Makehelium calls 'rmap' and 'imdelete' and is a cl script file. +.ih +EXAMPLES +1. To run makehelium on five files with root name m1585 and store the resulting +images with root name M1585 the command would be: + +.nf + vt> makehelium m1585 M1585 +.fi + +.ih +SEE ALSO +rmap +.endhelp diff --git a/noao/imred/vtel/doc/makeimages.hlp b/noao/imred/vtel/doc/makeimages.hlp new file mode 100644 index 000000000..d5f5fe314 --- /dev/null +++ b/noao/imred/vtel/doc/makeimages.hlp @@ -0,0 +1,64 @@ +.help makeimages Jan86 noao.imred.vtel +.ih +NAME +makeimages -- Magnetogram batch processing script +.ih +USAGE +makeimages input_root output_root +.ih +PARAMETERS +.ls input_root +Root name for input files. +.le +.ls output_root +Root name of output files. +.le +.ih +DESCRIPTION +Makeimages processes 5 magnetograms from raw data tape images into projected +small [180x180] maps. The input images are expected be output from T2D, +be in the current imdir, and have the extensions '001' through '005'. +The output files are stored in the current directory with the extensions +'a1', 'a2', 'a3', 'b1', etc. The output image coding scheme is the following: + +.nf + On the filename extensions the first character is a letter + corresponding to the tape file position. + a = first file on tape + b = second + . + . + e = fifth + + The second character specifies which type of image this is. + 1 = data + 2 = absolute value + 3 = weights +.fi + +Note: A logical directory called "scratch" must be set up before this +program is run. This logical directory must point to the directory +containing the input images. This can be set up as in the following +example: + +vt> set scratch = "scr1:[recely]" + +where this particular directory is a VAX/VMS type name. If the image +files are in the user's home directory then "scratch" can be set to +"home". + +Makeimages calls 'readvt', 'quickfit', 'rmap', +'delete', and 'imdelete' and is a cl script. +.ih +EXAMPLES +1. To process five magnetograms with root name m1585 and produce output images +with the root name M1585, the command would be. + +.nf + vt> makeimages m1585 M1585 +.fi + +.ih +SEE ALSO +readvt, quickfit, rmap, delete, imdelete +.endhelp diff --git a/noao/imred/vtel/doc/merge.hlp b/noao/imred/vtel/doc/merge.hlp new file mode 100644 index 000000000..24dbb7780 --- /dev/null +++ b/noao/imred/vtel/doc/merge.hlp @@ -0,0 +1,90 @@ +.help merge Dec84 noao.imred.vtel +.ih +NAME +merge -- Merge together daily synoptic grams into a complete Carrington map +.ih +USAGE +merge outimage outweight outabs outratio month day year +.ih +PARAMETERS +.ls outimage +Name of output image. +.le +.ls outweight +Output image containing weights, number of pixels per pixel. +.le +.ls outabs +Output image containing the sums of the absolute values of the flux. +Not used when merging 10830 maps. +.le +.ls outratio +Output image containing the ratio of outimage/outabs. +Not used when merging 10830 maps. +.le +.ls month, day, year +Date of the center of this Carrington rotation. +.le +.ls longout = 180 +Longitude of the center of this Carrington rotation. +.le +.ls mergelist = "mergelist" +File containing list of files to be merged. +.le +.ih +DESCRIPTION +Merge adds up daily synoptic grams to produce a Carrington rotation map. +the input images are 180x180 and the output images are 360x180. The input +images are read from the file mergelist. Merge then weights the input +image as cos**4 in x where the center of the image corresponds to zero angle +and the left and right edges of the image correspond to -90 and +90 degrees +respectively. The input image consists of an unweighted "data" image, +a weight image, and an absolute value image. The summing is done on the +"data" image, on the weight image, and on the absolute value image +separately to produce three output images. Finally the "data" image is +divided by the absolute value image to produce a 4th output image. +If 10830 data is being merged there are only two(2) images per day, the +"data" image and the "weight" image. Also there are only two(2) output images, +the "data" merged image and the "weights" merged image. +A note about the mergelist file, the three grams for each day must be stored +in the following sequence (data, absolute value, weight) for magnetograms +and the two grams for each day must be stored as (data, weight) for 10830. +The filenames must be one file name per line in the mergelist and files +for different days must be grouped together, for example mergelist might look +like: + +.nf + MAG01 MAG01 + MAG01a MAG01w + MAG01w for magnetograms or MAG02 for 10830 grams + MAG02 MAG02w + MAG02a + MAG02w +.fi + +for merging only two days of data where the first day is MAG01 and the second +is MAG02. The 'a' extension stands for absolute value and the 'w' for weights. +.ih +EXAMPLES +1. To merge a number of images on disk into output images called "im", +"imweight", "imabs", and "imratio", where the date corresponding to the +center of the Carrington map is 3/20/84 the command would be (magnetograms): + +.nf + vt> merge im imweight imabs imratio 3 20 84 +.fi + +The same command used for 10830 grams would be: + +.nf + vt> merge im imweight 3 20 84 +.fi + +2. If you have the list of files to be merged listed in a file called "mlist" +instead of "mergelist" the command would be modified to read: + +.nf + vt> merge im imweight 3 20 84 mergelist="mlist" +.fi +.ih +SEE ALSO +.endhelp diff --git a/noao/imred/vtel/doc/mrotlogr.hlp b/noao/imred/vtel/doc/mrotlogr.hlp new file mode 100644 index 000000000..f86dbc0e8 --- /dev/null +++ b/noao/imred/vtel/doc/mrotlogr.hlp @@ -0,0 +1,63 @@ +.help mrotlogr Jul86 "noao.imred.vtel" +.ih +NAME +mrotlogr -- Make a log of header information from a fits tape (Carrington maps). +.ih +USAGE +mrotlogr input_dev out_file startfnum endfnum append +.ih +PARAMETERS +.ls input_dev +Tape drive, e.g. "mta1600" or just "mta" +.le +.ls out_file +Name of output file to store information. Information is appended to this +file to allow one to update a previously created file. +.le +.ls startfnum +Tape file to start logging. +.le +.ls endfnum +Tape file to stop logging. +.le +.ls append +Flag to signal that we are appending to an existing file. +.le +.ih +DESCRIPTION +Mrotlogr reads FITS headers from successive tape files and compiles +certain information into a single line of output for each file. +Currently, the information output for each file includes: + +.nf + Tape file number, IRAF image name, date, time, and the + Carrington longitude for each image. +.fi + +If all of these header parameters are not present, only the ones found +will be printed out and garbage will come out for the empty parameters. +The date is stored in a header parameter called OBS_DATE, the time is +stored as 'seconds since midnight' in OBS_TIME and the Carrington +longitude is stored in L_ZERO. +To use this script, both the DATAIO package and the VTEL package must +be loaded. +.ih +EXAMPLES +1. To log all of the FITS images on a tape mounted on 'mta' and store the +information in a file called 'CX052' the command would be: + +.nf + vt> mrotlogr mta CX052 1 999 no +.fi + +2. To log just the 40th through 60th files on mtb and see the output on +your terminal, the command would be: + +.nf + vt> mrotlogr mtb STDOUT 40 60 no +.fi + +.ih +SEE ALSO +rfits +.endhelp diff --git a/noao/imred/vtel/doc/mscan.hlp b/noao/imred/vtel/doc/mscan.hlp new file mode 100644 index 000000000..d6b7f46bc --- /dev/null +++ b/noao/imred/vtel/doc/mscan.hlp @@ -0,0 +1,86 @@ +.help mscan May88 noao.imred.vtel +.ih +NAME +mscan -- Read sector scans from tape into IRAF images +.ih +USAGE +mscan input +.ih +PARAMETERS +.ls input +File template or device, e.g. "junk" or "s*" or "mta1600[1]" or "mtb800" +.le +.ls files +List of tape file numbers or ranges delimited by commas, e.g. "1-3,5-8". +`Files' is requested only if no file number is given in `input' and the +input is tape. +Files will be read in ascending order, regardless of the order of the list. +Reading will terminate if EOT is reached, thus a list such as "1-999" +may be used to read all the files on the tape. +.le +.ls verbose = yes +Flag to signal program that it should produce verbose output. This means +header information. +.le +.ls makeimage = yes +Flag to signal the program that it should make images. If this parameter +is set to no, the header will be read and decoded but no data will be read +and no image will be produced on disk. +.le +.ls brief = yes +Flag to make mscan produce brief filenames for the output images. These +filenames have the form [svb]nnn e.g. s034 or b122. The b is for a brightness +image, the v is for a velocity image, and the s is for a select image. The +'nnn' is the tape sequence number or the filenumber in a template expansion. +If this flag is set to false the long filenames described below in the +"Description" section will be produced. +.le +.ls select = yes +Flag to tell the program to make a select image. +.le +.ls bright = yes +Flag to tell the program to make a brightness image. +.le +.ls velocity = yes +Flag to tell the program to make a velocity image. +.le +.ih +DESCRIPTION +Mscan reads all or selected area scans from a vacuum telescope tape +and formats the data into multiple IRAF images. Type 1, 2, and 3 area +scans can produce 3 output images and type 4 produces one output image. +The long image names are assembled in the following way: +.nf + + The first letter is one of [bsv] for brightness, select, or velocity. + The next two digits are the day of the month. + Underbar. + The next 4 digits are the hour and minute. + Underbar. + Finally there is a three digit tape sequence number. + ie. + + b13_1709_002 +.fi + +.ih +EXAMPLES +1. To read files 5-7 from mta at 1600 bpi, the command would be: + +.nf + vt> mscan mta1600 5-7 +.fi + +2. To see the header information only for file 6, one could use the command: + +.nf + vt> mscan mta1600[6] make- +.fi + +3. To read file 4 from mta and only produce a velocity image: + +.nf + vt> mscan mta[4] bri- sel- +.fi + +.endhelp diff --git a/noao/imred/vtel/doc/pimtext.hlp b/noao/imred/vtel/doc/pimtext.hlp new file mode 100644 index 000000000..e78fdc8d6 --- /dev/null +++ b/noao/imred/vtel/doc/pimtext.hlp @@ -0,0 +1,110 @@ +.help pimtext May86 noao.imred.vtel +.ih +NAME +pimtext -- Put image text. Use pixel font to write text into image. +.ih +USAGE +pimtext iraf_files +.ih +PARAMETERS +.ls iraf_files +Image or images to be written into. This entry may contain wild cards and +will be expanded into however many files match the wild card. +.le +.ls refim +Reference image to pull date and time parameters from in the event the "ref" +flag is set. +.le +.ls ref +Reference flag. When set, causes the program to take information (date/time) +from the reference image and write it into the image or images expanded from +the template "iraf_images". +.le +.ls x = 10 +X position (column) in image to write text. +.le +.ls y = 10 +Y position (line) in image to write text. +.le +.ls xmag = 2 +Factor by which to magnify the text in the x direction. This must be an +integer. The pixelfont is expanded by pixel replication. The font width +at xmag=1 is 6. +.le +.ls ymag = 2 +Factor by which to magnify the text in the y direction. This must be an +integer. The pixelfont is expanded by pixel replication. The font width +at ymag=1 is 7. +.le +.ls val = -10000 +Value to put in text pixels. +.le +.ls setbgnd = yes +Boolean parameter to signal the program to fill in the area behind the +characters with pixels set to bgndval. +.le +.ls bgndval = 10000 +Pixel value to use to fill in background in text block. +.le +.ls date = yes +Flag that instructs the program to look for the date in the +image header and write it into the image. If the date and time +flags are both set, both will be written into the image as a single +string. +.le +.ls time = yes +Flag that instructs the program to look for the time in the +image header and write it into the image. +.le +.ls text +Text string to write into image. +.le +.ih +DESCRIPTION +Pimtext writes either the date and/or time or the indicated text string into +the image or images specified. +Pimtext, by default, writes the date and/or time into the image in the lower +left corner. If it cannot find the date or time pimtext will give a warning +and read a text string from the users terminal. If the date and time flags are +set to 'no', pimtext will take the text string to be written from the user. +The position of the text may be adjusted by setting +the parameters 'x' and 'y' which set the lower left pixel of +the text block. The pixels in the text block behind the characters may +be set to a particular value when the 'setbgnd' flag is set. The pixel +values used to write the text and the background can be set by adjusting +the parameters 'val' and 'bgndval'. If the text overlaps the image +edge in the X direction it will be truncated. If it overlaps in Y it will +not be written. +The user may magnify the text by adjusting the "xmag" and "ymag" parameters. +The default (2,2) is a nice size for display in a 512 by 512 image. Bigger +images may need bigger text, smaller images may need smaller text. +The "ref" flag is used to write information from one image into another +image. + +.ih +EXAMPLES +1. To write the date and time into the three images s13_1709_001, v13_1709_001, +and b13_1709_001 (assuming the directory contains only these three images) +the command would be: + +.nf + vt> pimtext ?13* +.fi + +2. To write the text string "hello world" into the image 'testim' the command +would be + +.nf + vt> pimtext testim 'hello world' date=no time=no +.fi + +3. To write the date and time into the images s1, s2, s3, s4 and position +the text at pixel 30,30, and turn off the text background fill, the command +would be: + +.nf + vt> pimtext s* x=30 y=30 setbgnd=no +.fi +.ih +SEE ALSO +.endhelp diff --git a/noao/imred/vtel/doc/putsqib.hlp b/noao/imred/vtel/doc/putsqib.hlp new file mode 100644 index 000000000..f6400cfe1 --- /dev/null +++ b/noao/imred/vtel/doc/putsqib.hlp @@ -0,0 +1,38 @@ +.help putsqib Jan85 noao.imred.vtel +.ih +NAME +putsqib -- Merge a full disk image with a squibby brightness image +.ih +USAGE +putsqib inputimage sqibimage outputimage +.ih +PARAMETERS +.ls inputimage +Name of data image to merge with squibby brightness image. +.le +.ls sqibimage +Name of squibby brightness image to merge with data image. +.le +.ls outputimage +Name of new, merged, output image. +.le +.ih +DESCRIPTION +Putsqib accepts as input a data image and a squibby brightness image. It +multiplies each pixel in the input data image by 16 and adds the associated +pixel from the squibby brightness input image. The pixel is then written +to the new, output image. +.ih +EXAMPLES +1. To merge a data image called 'data' and a squibby brightness image called +'sqib' and store the result in an image called 'complete', the command +would be: + +.nf + vt> putsqib data sqib complete +.fi + +.ih +SEE ALSO +getsqib +.endhelp diff --git a/noao/imred/vtel/doc/quickfit.hlp b/noao/imred/vtel/doc/quickfit.hlp new file mode 100644 index 000000000..41621b6d6 --- /dev/null +++ b/noao/imred/vtel/doc/quickfit.hlp @@ -0,0 +1,59 @@ +.help quickfit Dec84 noao.imred.vtel +.ih +NAME +quickfit -- Fit an ellipse to the limb for a full disk scan +.ih +USAGE +quickfit image +.ih +PARAMETERS +.ls image +Name of image to be fit. +.le +.ls threshold = 4 +Squibby brightness threshold to use in determining limb points. +.le +.ls xguess = 1024 +X coordinate of center of first guess circle. +.le +.ls yguess = 1024 +Y coordinate of center of first guess circle. +.le +.ls halfwidth = 50 +Halfwidth of window centered on previous limb point to search through +for a limb point on the current line. +.le +.ls rowspace = 20 +Number of rows to skip between limbpoints near center in y. +.le +.ls rejectcoeff = .02 +Least squares rejection coefficient. If radius of a limbpoint is more than +this far from the limb, where limbradius = 1.0, it is not used in the fit. +.le +.ih +DESCRIPTION +Quickfit finds the least squares best fit ellipse to the limb in a full +disk scan. Quickfit returns the ellipse parameters (x,y coordinates of +the ellipse center and the x and y semidiameters), the number of limbpoints +found, the number of limbpoints rejected, and the fraction of limb +points rejected by the least squares routine. This 'fraction rejected' +allows the user to determine to some extent the goodness of the data and +allows him or her to rerun Quickfit with different parameters to take +this goodness into account. Quickfit also returns the sub-earth latitude +and longitude when in verbose mode. The ellipse and ephemeris parameters +are stored in the image header for future reference. +.ih +EXAMPLES +1. To find the best fit ellipse for the limb in an image called "image1" and to +see verbose output, one would use the following command: + +.nf + vt> quickfit image1 v+ +.fi + +This will also use the default values of rowspace, halfwidth, +and rejectcoeff. + +.ih +SEE ALSO +.endhelp diff --git a/noao/imred/vtel/doc/readvt.hlp b/noao/imred/vtel/doc/readvt.hlp new file mode 100644 index 000000000..b9d6abe74 --- /dev/null +++ b/noao/imred/vtel/doc/readvt.hlp @@ -0,0 +1,86 @@ +.help readvt May87 noao.imred.vtel +.ih +NAME +readvt -- Read vacuum telescope full disk grams +.ih +USAGE +readvt input_fd files output_image +.ih +PARAMETERS +.ls input_fd +File or device template, e.g. "mta1600[1]" or "mtb800" or "junk" or "s*" +.le +.ls files +List of tape file numbers or ranges delimited by commas, e.g. "1-3,5-8". +`Files' is requested only if no file number is given in `input'. +Files will be read in ascending order, regardless of the order of the list. +Reading will terminate if EOT is reached, thus a list such as "1-999" +may be used to read all the files on the tape. +.le +.ls output_image template +Name to give output image. If the input file template is not a magtape +specification then this can be an IRAF filename template to be +expanded into a list of files. If the number of files in the input +template and in the output template do not match and if the output +template expands to one filename then that filename is used as a +root name to which filenumbers are appended for each input file. +i.e. "junk" becomes "junk001", "junk002", etc. If the input template +is a magtape without a filenumber attached, i.e. "mta", the +output name is used as a root name and the file number is appended +for each file read. +.le +.ls verbose = no +Flag to signal program that it should produce verbose output. This includes +header information and progress reports. +.le +.ls headeronly = no +Flag to signal the program that it should only print out header information +and quit without reading the data. The 'verbose' flag must be set to yes +to use this flag since otherwise the header information will not be printed. +This flag is used to look at headers on the tape to check dates, times +and observation types. +.le +.ls robust = no +Flag to signal program that it should ignore a wrong observation type in the +image header. +.le +.ih +DESCRIPTION +Readvt reads any one of the grams on a vacuum telescope tape and puts the +data into an IRAF image. The IRAF image is 2048x2048 short integers. +.ih +EXAMPLES +1. To read the second image from mta at 1600 bpi, store the image into "image1" +and see verbose output the command would be: + +.nf + vt> readvt mta1600[2] image1 v+ +.fi + +2. To look at the header information of the 4th file on a tape which is on +mtb and which was written at 1600 bpi, the command would be: + +.nf + vt> readvt mtb1600[4] v+ h+ +.fi + +3. To read the disk files "s001", "s002", "s003", "s004" and put the output +images into the files "s001i", "s002i", "s003i", "s004i" without +verbose output (assuming no other file in the directory starts with "s") +the command would be: + +.nf + vt> readvt s* s*//i +.fi + +4. To read the first five files on mta and put the output images into files +images with root name HHH the command would be: + +.nf + vt> readvt mta 1-5 HHH +.fi + +.ih +SEE ALSO +writevt +.endhelp diff --git a/noao/imred/vtel/doc/syndico.hlp b/noao/imred/vtel/doc/syndico.hlp new file mode 100644 index 000000000..25b4b0ee4 --- /dev/null +++ b/noao/imred/vtel/doc/syndico.hlp @@ -0,0 +1,77 @@ +.help syndico May89 noao.imred.vtel +.ih +NAME +syndico -- Make dicomed plots of full disk images (18 centimeters in diameter) +.ih +USAGE +syndico image +.ih +PARAMETERS +.ls image +Image to plot on the dicomed. +.le +.ls logofile = iraf$noao/imred/vtel/nsolcrypt.dat +File containing the text encoded NSO logo image. +.le +.ls device = dicomed +Device on which to plot the image. +.le +.ls sbthresh = 2 +Squibby brightness threshold used to determine the limb for trimming. +.le +.ls plotlogo = yes +Flag indicating whether or not to plot the logo. +.le +.ls verbose = yes +Flag indicating to the program that it should give progress reports. +.le +.ls forcetype = no +Flag to override the wavelength designation from the image header. +.le +.ls magnetic = yes +If 'forcetype' = 'yes' then this flag designates that we should force +to magnetic (8688). If set to 'no' the type is forced to 10830. +The effect of forcing the type is to choose which lookup table to +use when scaling the image. +.le +.ls month +Month the observation was taken (January = 1,,,December = 12). +.le +.ls day +Day of the month the observation was taken. +.le +.ls year +Year the observation was taken (two digits only, ie. 89 for 1989). +.le +.ls hour +Hour of the day the observation was taken (universal time, 1-24). +.le +.ls minute +Minute the observation was taken (0-59). +.le +.ls second +Second the observation was taken (0-59). +.le +.ih +DESCRIPTION +Syndico produces full disk plots on the Dicomed. The ephemeris data +is used to estimate the radius of the image and the center of the +disk is gotten from the image header. Using this data, an image is +made that is as close to 18 centimeters in diameter as possible. +There are two greyscale lookup tables corresponding to the two types +of image normally used, the magnetogram and the spectroheliogram. +If the wavelength is something other than 8688 or 10830, a linear +greyscale is used. + +The National Solar Observatory (tentative) logo is read from an encoded +text file and put on the plot if requested (default). +.ih +EXAMPLES + +.nf + vt> syndico image1 +.fi + +.ih +SEE ALSO +.endhelp diff --git a/noao/imred/vtel/doc/tcopy.hlp b/noao/imred/vtel/doc/tcopy.hlp new file mode 100644 index 000000000..57a523cbb --- /dev/null +++ b/noao/imred/vtel/doc/tcopy.hlp @@ -0,0 +1,56 @@ +.help tcopy Oct85 noao.imred.vtel +.ih +NAME +tcopy -- Tape to tape copy +.ih +USAGE +tcopy input_fd output_fd +.ih +PARAMETERS +.ls input_fd +Tape file or device name for input, e.g. "mta1600[1]" or "mtb800" +.le +.ls files +List of tape file numbers or ranges delimited by commas, e.g. "1-3,5-8". +`Files' is requested only if no file number is given in `input_fd'. +Files will be read in ascending order, reguardless of the order of the list. +Reading will terminate if EOT is reached, thus a list such as "1-999" +may be used to read all the files on the tape. +.le +.ls output_fd +File or device name, e.g. "mta1600[1]" or "mtb800" If a file number is not +given the user will be asked whether or not this is a new tape. If it is +a new tape the file number "1" will be used. If it is not a new tape, i.e. +it already has data on it, then file number "EOT" will be used. +.le +.ls new_tape = no +New tape flag. Usage is described above. +.le +.ls verbose = no +Flag to signal program that it should print information about progress while +running. +.le +.ih +DESCRIPTION +Tcopy copies files from one tape to another reporting read errors on the +input tape as it goes. Tcopy, when it encounters a read error, does its +best to get as much data as possible by validating the input buffer after +the error, guessing its length, and writing it out to the output tape. +.ih +EXAMPLES +1. To copy all the files on mta to a new tape on mtb: + +.nf + vt> tcopy mta 1-999 mtb yes +.fi + +2. To copy file 5 from mta and append it to the tape on mtb: + +.nf + vt> tcopy mta1600[5] mtb no +.fi + +.ih +SEE ALSO +t2d +.endhelp diff --git a/noao/imred/vtel/doc/trim.hlp b/noao/imred/vtel/doc/trim.hlp new file mode 100644 index 000000000..9962db80d --- /dev/null +++ b/noao/imred/vtel/doc/trim.hlp @@ -0,0 +1,33 @@ +.help trim Jan85 noao.imred.vtel +.ih +NAME +trim -- Trim the limb. Zero all pixels off the limb in a full disk image +.ih +USAGE +trim inputimage threshold +.ih +PARAMETERS +.ls inputimage +Name of data image to trim. +.le +.ls threshold +Squibby brightness value to use as a threshold in determining the limb. +.le +.ih +DESCRIPTION +Trim scans all the pixels in an image and sets those pixels to zero that +contain a squibby brightness smaller than the threshold value. This is +done in place, that is, the input image gets modified. +.ih +EXAMPLES +1. To trim a data image called 'data' with a squibby brightness threshold +of 4 (the standard value) the command would be: + +.nf + vt> trim data 4 +.fi + +.ih +SEE ALSO +getsqib, putsqib +.endhelp diff --git a/noao/imred/vtel/doc/unwrap.hlp b/noao/imred/vtel/doc/unwrap.hlp new file mode 100644 index 000000000..67fad069b --- /dev/null +++ b/noao/imred/vtel/doc/unwrap.hlp @@ -0,0 +1,95 @@ +.help unwrap May87 noao.imred.vtel +.ih +NAME +unwrap -- Filter an IRAF image; remove binary wrap-around. +.ih +USAGE +unwrap listin listout +.ih +PARAMETERS +.ls listin +List of images to unwrap, this is an IRAF template. +.le +.ls listout +List of output images, this is an IRAF template. If the output list +is the same as the input list, the unwrapping is done in-place. +.le +.ls threshold1 = 128 +Data jump threshold for first unwrap pass. +.le +.ls wrapval1 = 256 +Factor to multiply wrap value by for first unwrap pass. +.le +.ls threshold2 = 128 +Data jump threshold for second unwrap pass. +.le +.ls wrapval2 = 256 +Factor to multiply wrap value by for second unwrap pass. +.le +.ls cstart = 2 +Column of image to start unwrapping. Columns are numbered from left to right. +.le +.ls step = 5 +Number of steps (1-5) to perform on image (unwrap1, difference, unwrap2, +reconstruct, fixlines). +.le +.ls verbose = yes +If set, program produces progress reports, etc. +.le +.ih +DESCRIPTION +Unwrap checks for binary wraparound in IRAF images. +The algorithm consists of reading the image line by line, unwrapping +each line, and writing the line out to another image. The procedure +for unwraping is a five step process. +.ls Step one: unwrap1 +Unwrapping is accomplished by scanning the data line and looking for +large jumps in the data values. Large negative jumps are interpreted +as data wrapping and large positive jumps are interpreted as data unwrapping. +The program keeps track of the number of wraps, each data element in the +array has wrapval1 * wrapnumber added. This effectively unwraps an image +in which the point to point variation in the data values is small compared +to the variation caused by a binary wrap. +.le +.ls Step two: difference +A difference image is produced from the above step one image by calculating +the pixel to pixel difference between all of the pixels in the line. The +first column of the image is generally left intact so that the image can +be reconstructed in a later step. Step one often produces streaks in the +image due to data variation large enough to mimic wrapping. This step +two difference image eliminates most of these streaks except for their +point of origin, where the confusion occured. +.le +.ls Step three: unwrap2 +This is the second unwrapping step. The image is unwrapped as in step +one using the second set of unwrap values (threshold2, wrapval2). +.le +.ls Step four: reconstruct +The original image is reconstructed from the step three image by +adding pixel values successively to line pixels. +.le +.ls Step five: fixlines +If bad lines (streaks) still can be found in the image, they are +eliminated by replacing the line by the average of the lines above +and below bad line. +.le +.ih +EXAMPLES +1. To unwrap an image called "continuum" and store the resulting image in +"unwrapped", and use the default parameters, the command might be: + +.nf + vt> unwrap continuum unwrapped +.fi + +2. To unwrap all the images in the directory starting with s1492 and store +the unwrapped images in s1492*u, to start in column 31, to do four steps, +and to see verbose output, the command might be: + +.nf + vt> unwrap s1494* s1492*//u cstart=31 step=4 v+ +.fi + +.ih +SEE ALSO +.endhelp diff --git a/noao/imred/vtel/doc/vtblink.hlp b/noao/imred/vtel/doc/vtblink.hlp new file mode 100644 index 000000000..0bb267798 --- /dev/null +++ b/noao/imred/vtel/doc/vtblink.hlp @@ -0,0 +1,53 @@ +.help vtblink Dec84 noao.imred.vtel +.ih +NAME +vtblink -- Blink daily grams to check registration +.ih +USAGE +vtblink +.ih +PARAMETERS +.ls imname1 +First image to be mapped. +.le +.ls imname2 +Subsequent images to be mapped +.le +.ls z1 = -3000.0 +Minimum grayscale intensity to be mapped during 'display'. +.le +.ls z2 = 3000.0 +Maximum grayscale intensity to be mapped during 'display'. +.le +.ih +DESCRIPTION +Vtblink allows the user to blink successive frames of data on the IIS. The +program calculates the offset between grams based on the +longitudes for each image. Vtblink will ask for each successive image +and will display it on the next (mod 4) IIS frame. +After each image is displayed the user is put back out in the cl so that he/she +can use any of the images$tv tasks to analyze the data. The user returns to +the blink program by typing 'bye' to the cl prompt. To exit the program the +user enters the "end" for the filename. Images are displayed with the grayscale +limits set by default to -3000.0 and 3000.0. These values correspond to the +parameters z1 and z2 which may be given on the command line. If the user +forgets which IIS frame contains which image, he/she can enter "stat" to the +"next image" prompt and will get a list of which images are in which frames. +.ih +EXAMPLES +1. To run vtblink with the default gray scale parameters just type: + +.nf + vt> vtblink +.fi + +2. To run vtblink with gray scale parameters z1=-4000.0, z2=4000.0, the +command would be: + +.nf + vt> vtblink z1=-4000.0 z2=4000.0 +.fi +.ih +SEE ALSO +display, blink, lumatch +.endhelp diff --git a/noao/imred/vtel/doc/vtexamine.hlp b/noao/imred/vtel/doc/vtexamine.hlp new file mode 100644 index 000000000..20bf13ebc --- /dev/null +++ b/noao/imred/vtel/doc/vtexamine.hlp @@ -0,0 +1,50 @@ +.help vtexamine Jan86 noao.imred.vtel +.ih +NAME +vtexamine -- examine the headers and record structure of vacuum telescope files +.ih +USAGE +mtexamine tape_file +.ih +PARAMETERS +.ls tape_file +Tape file, e.g. "mta1600[2]" or "mta1600". +.le +.ls files +List of tape file numbers or +ranges delimited by commas, e.g. "1-3,5-8". +File_list is requested only if no file number is given in tape_file. +Files will be read in ascending order, regardless of the order of the list. +Reading +will terminate if EOT is reached, thus a list such as "1-999" +may be used to read all the files on the tape. +.le +.ls headers=yes +Decode and print header information from each file examined. +.le +.ih +DESCRIPTION +By default, vtexamine decodes and prints header and record +structure information for each file examined. The header +information can be turned off by setting headers=no. +.ih +EXAMPLES +1. To see the header information and determine the record structure of all the +files on a vacuum telescope tape and send the result to the file vtdump: + +.nf + vt> vtexamine mtb1600 1-999 > vtdump +.fi + +2. To just get the record structure for the third file on a vacuum telescope +tape the command would be: + +.nf + vt> vtexamine mtb1600[3] headers=no +.fi +.ih +BUGS +The IRAF magtape i/o routines do not permit data beyond a double EOF +to be accessed. Therefore vtexamine cannot be used to examine tapes with +embedded double EOFs. +.endhelp diff --git a/noao/imred/vtel/doc/writetape.hlp b/noao/imred/vtel/doc/writetape.hlp new file mode 100644 index 000000000..6159c016b --- /dev/null +++ b/noao/imred/vtel/doc/writetape.hlp @@ -0,0 +1,35 @@ +.help writetape Jan86 noao.imred.vtel +.ih +NAME +writetape -- Write 5 grams to tape in full disk format. (Used as +intermediate step in 10830 processing. +.ih +USAGE +writetape input_root tape_name +.ih +PARAMETERS +.ls getname +Root name for input files. +.le +.ls getmtape +Tape file descriptor. +.le +.ih +DESCRIPTION +Writetape takes as input five(5) full disk grams in IRAF image format +and writes them to tape in a format identical to the original full disk +grams produced on the vacuum telescope. The input image names are expected +to be the "input_root" name concatenated with the numbers "1", "2", ... "5". +Writetape calls 'writevt' and is a cl script file. +.ih +EXAMPLES +1. To write five files with root name m1585 to tape mta, the command would be: + +.nf + vt> writetape m1585 mta +.fi + +.ih +SEE ALSO +readvt, writevt +.endhelp diff --git a/noao/imred/vtel/doc/writevt.hlp b/noao/imred/vtel/doc/writevt.hlp new file mode 100644 index 000000000..3475a5c44 --- /dev/null +++ b/noao/imred/vtel/doc/writevt.hlp @@ -0,0 +1,43 @@ +.help writevt Dec84 noao.imred.vtel +.ih +NAME +writevt -- Write vacuum telescope full disk grams to tape +.ih +USAGE +writevt input_image output_fd +.ih +PARAMETERS +.ls input_image +Name of input image. +.le +.ls output_fd +File or device name, e.g. "mta1600[1]" or "mtb800" If a file number is not +given the user will be asked whether or not this is a new tape. If it is +a new tape the file number "1" will be used. If it is not a new tape, i.e. +it already has data on it, then file number "EOT" will be used. +.le +.ls verbose = no +Flag to signal program that it should produce verbose output. This includes +header information and progress reports. +.le +.ls new_tape = no +New tape flag. Usage is described above. +.le +.ih +DESCRIPTION +Writevt writes a full disk vacuum telescope gram in IRAF image format to tape. +The IRAF image is 2048x2048 short integers. The tape format is the same as +that used to write original data tapes on the mountain. +.ih +EXAMPLES +1. To write the image "image1" to mta at 1600 bpi at file number 3 and +see verbose output the command would be: + +.nf + vt> writevt image1 mta1600[3] v+ +.fi + +.ih +SEE ALSO +readvt +.endhelp diff --git a/noao/imred/vtel/fitslogr.cl b/noao/imred/vtel/fitslogr.cl new file mode 100644 index 000000000..426811186 --- /dev/null +++ b/noao/imred/vtel/fitslogr.cl @@ -0,0 +1,104 @@ +#{ FITSLOGR -- Read all the headers on a FITS tape and print out some +# of the header information for each file. + +{ + struct header, headline, tfile, irafname + struct obsdate, lzero, keyword + struct tape, outfile, zcm, meanafld, numpix, meanfld + struct *fp + int sfnum, efnum, filenum, ssm + int hours, minutes, seconds + bool append, mag + + if (!deftask ("rfits")) { + print ("Task rfits not loaded. Load dataio and then try again.") + bye + } + + # Get the tape name and the output file name. + tape = gettape + outfile = getout + + # Get the starting and ending file numbers for the log. + sfnum = getsfnum + efnum = getefnum + + # Get the append flag. + append = getapp + + # Get the mag flag. + mag = getmag + + if (!append) { + if (mag) { + print ("File fname date time L-zero zcm meanafld numpix", >> outfile) + } else { + print ("File fname date time L-zero meanfld numpix", >> outfile) + } + } + + filenum = sfnum + while (YES) { + + # Read the next fits header from the tape. + header = mktemp("temp") + fp = header + rfits (tape, filenum, make_image=no, long_header=yes, > header) + + # Initialize the output variables. + tfile = " " + irafname = " " + obsdate = " " + lzero = " " + zcm = " " + meanafld = " " + numpix = " " + hours = 0 + minutes = 0 + seconds = 0 + + # Now match keywords against this header to obtain needed output. +tfile = filenum + while (fscan (fp, headline) != EOF) { + keyword = substr(headline, 1, 8) + if (keyword == "File: mt") + tfile = substr(headline, 7, 15) + else if (keyword == "IRAFNAME") + irafname = substr(headline, 12, 18) + else if (keyword == "OBS_DATE") + obsdate = substr(headline, 23, 30) + else if (keyword == "OBS_TIME") { + ssm = int(substr(headline, 23, 30)) # Seconds Since Midnight. + hours = ssm/3600 + minutes = (ssm - (hours*3600))/60 + seconds = ssm - hours*3600 - minutes*60 + } + else if (keyword == "L_ZERO ") + lzero = substr(headline, 19, 26) + else if (keyword == "ZCM ") + zcm = substr(headline, 18, 26) + else if (keyword == "MEANAFLD") + meanafld = substr(headline, 18, 26) + else if (keyword == "MEAN_FLD") + meanfld = substr(headline, 18, 26) + else if (keyword == "NUMPIX ") + numpix = substr(headline, 19, 30) + else if (keyword == "End of d") { + print (headline, >> outfile) + delete (header, verify-) + bye + } + } + if (mag) { + print (tfile, irafname, obsdate, " ", hours, minutes, seconds, + lzero, zcm, meanafld, numpix, >> outfile) + } else { + print (tfile, irafname, obsdate, " ", hours, minutes, seconds, + lzero, meanfld, numpix, >> outfile) + } + filenum = filenum + 1 + delete (header, verify-) + if (filenum > efnum) + bye + } +} diff --git a/noao/imred/vtel/fitslogr.par b/noao/imred/vtel/fitslogr.par new file mode 100644 index 000000000..f6d8c1418 --- /dev/null +++ b/noao/imred/vtel/fitslogr.par @@ -0,0 +1,6 @@ +gettape,s,a,,,,Tape to read fits headers from (i.e. "mta") +getout,s,a,,,,File to put output information in +getsfnum,i,a,,,,File number on tape from which to start logging +getefnum,i,a,,,,File number on tape at which logging is to end +getapp,b,a,,,,Append to existing file? +getmag,b,a,,,,Is this data magnetic field? (yes = 8688 no = 10830) diff --git a/noao/imred/vtel/gauss.x b/noao/imred/vtel/gauss.x new file mode 100644 index 000000000..fc5f9211e --- /dev/null +++ b/noao/imred/vtel/gauss.x @@ -0,0 +1,16 @@ +procedure gauss (x, a, ymod, dyda, ma) + +real x, a[ma], ymod, dyda[ma] +int ma + +real arg, ex, fac + +begin + arg = (x - a(2))/a(3) + ex = exp(-arg**2) + fac = a(1)*ex*2.0*arg + ymod = a(1)*ex + dyda(1) = ex + dyda(2) = fac/a(3) + dyda(3) = fac*arg/a(3) +end diff --git a/noao/imred/vtel/getsqib.par b/noao/imred/vtel/getsqib.par new file mode 100644 index 000000000..a148cafb8 --- /dev/null +++ b/noao/imred/vtel/getsqib.par @@ -0,0 +1,2 @@ +image,s,q,,,,Image to get sqibimage from +sqibimage,s,q,,,,New image to contain squibby brightness image diff --git a/noao/imred/vtel/getsqib.x b/noao/imred/vtel/getsqib.x new file mode 100644 index 000000000..76e7e44d5 --- /dev/null +++ b/noao/imred/vtel/getsqib.x @@ -0,0 +1,55 @@ +include +include +include "vt.h" + +# GETSQIB -- Make a new image from a solar synoptic image containing just +# the squibby brightness. + +procedure t_getsqib() + +char image[SZ_FNAME] # input image +char sqibimage[SZ_FNAME] # output squibby brightness image + +int i, numpix +pointer im, lgp, lpp, sqibim + +pointer immap(), imgl2s(), impl2s() +errchk immap, imgl2s, impl2s + +begin + # Get parameters from the CL. + call clgstr ("image", image, SZ_FNAME) + call clgstr ("sqibimage", sqibimage, SZ_FNAME) + + # Open image. + im = immap (image, READ_ONLY, 0) + sqibim = immap (sqibimage, NEW_COPY, im) + + numpix = IM_LEN(im,1) + do i = 1, IM_LEN(im,2) { + lgp = imgl2s (im, i) + lpp = impl2s (sqibim, i) + call sqibline (Mems[lgp], Mems[lpp], numpix) + } + + # Unmap images. + call imunmap (im) + call imunmap (sqibim) +end + + +# SQIBLINE -- Unpack squibby brightness from line1 and put it into line2. + +procedure sqibline (line1, line2, numpix) + +short line1[numpix] # input image line +short line2[numpix] # output image line +int numpix # number of pixels in line + +int i +int and() + +begin + do i = 1, numpix + line2[i] = and(int(line1[i]),17B) +end diff --git a/noao/imred/vtel/gryscl.inc b/noao/imred/vtel/gryscl.inc new file mode 100644 index 000000000..7198557a2 --- /dev/null +++ b/noao/imred/vtel/gryscl.inc @@ -0,0 +1,52 @@ +data (ztbl[i], i=1,10) / 003, 003, 003, 003, 003, 003, 003, 003, 004, 005 / +data (ztbl[i], i=11,20) / 005, 005, 005, 005, 005, 005, 005, 005, 006, 006 / +data (ztbl[i], i=21,30) / 006, 006, 006, 006, 006, 006, 006, 006, 006, 007 / +data (ztbl[i], i=31,40) / 007, 007, 007, 007, 007, 007, 007, 007, 007, 008 / +data (ztbl[i], i=41,50) / 008, 008, 008, 008, 008, 008, 008, 008, 008, 009 / +data (ztbl[i], i=51,60) / 009, 009, 009, 009, 009, 009, 009, 009, 009, 010 / +data (ztbl[i], i=61,70) / 010, 010, 010, 010, 010, 010, 010, 010, 010, 010 / +data (ztbl[i], i=71,80) / 010, 011, 011, 011, 011, 011, 011, 011, 011, 012 / +data (ztbl[i], i=81,90) / 012, 012, 012, 012, 012, 012, 012, 013, 013, 013 / +data (ztbl[i], i=91,100) / 013, 013, 013, 014, 014, 014, 014, 014, 014, 015/ +data (ztbl[i], i=101,110) /015, 015, 015, 015, 015, 015, 016, 016, 016, 016/ +data (ztbl[i], i=111,120) /016, 016, 017, 017, 017, 017, 017, 017, 017, 018/ +data (ztbl[i], i=121,130) /018, 018, 018, 018, 018, 018, 019, 019, 019, 019/ +data (ztbl[i], i=131,140) /019, 019, 020, 020, 020, 020, 020, 020, 021, 021/ +data (ztbl[i], i=141,150) /021, 021, 021, 021, 021, 022, 022, 022, 022, 022/ +data (ztbl[i], i=151,160) /022, 022, 023, 023, 023, 023, 023, 023, 024, 024/ +data (ztbl[i], i=161,170) /024, 024, 024, 024, 025, 025, 025, 025, 025, 026/ +data (ztbl[i], i=171,180) /026, 026, 026, 026, 026, 027, 027, 027, 027, 027/ +data (ztbl[i], i=181,190) /027, 028, 028, 028, 028, 028, 028, 029, 029, 029/ +data (ztbl[i], i=191,200) /029, 029, 029, 029, 029, 030, 030, 030, 030, 030/ +data (ztbl[i], i=201,210) /030, 030, 031, 031, 031, 031, 031, 031, 031, 031/ +data (ztbl[i], i=211,220) /032, 032, 032, 032, 032, 032, 032, 033, 033, 033/ +data (ztbl[i], i=221,230) /033, 033, 033, 034, 034, 034, 034, 034, 034, 035/ +data (ztbl[i], i=231,240) /035, 035, 035, 035, 035, 036, 036, 036, 036, 036/ +data (ztbl[i], i=241,250) /036, 037, 037, 037, 037, 037, 037, 038, 038, 038/ +data (ztbl[i], i=251,260) /038, 038, 038, 039, 039, 039, 039, 039, 039, 040/ +data (ztbl[i], i=261,270) /040, 040, 040, 040, 040, 041, 041, 041, 041, 041/ +data (ztbl[i], i=271,280) /041, 042, 042, 042, 042, 042, 042, 042, 042, 043/ +data (ztbl[i], i=281,290) /043, 043, 043, 044, 044, 044, 044, 045, 045, 045/ +data (ztbl[i], i=291,300) /045, 046, 046, 047, 047, 048, 048, 049, 049, 050/ +data (ztbl[i], i=301,310) /050, 051, 051, 052, 053, 054, 054, 055, 056, 057/ +data (ztbl[i], i=311,320) /057, 057, 057, 058, 058, 059, 059, 060, 060, 060/ +data (ztbl[i], i=321,330) /060, 061, 061, 063, 064, 065, 066, 067, 067, 068/ +data (ztbl[i], i=331,340) /068, 069, 069, 070, 071, 072, 072, 073, 074, 075/ +data (ztbl[i], i=341,350) /075, 076, 077, 078, 080, 082, 083, 084, 085, 086/ +data (ztbl[i], i=351,360) /086, 086, 087, 087, 088, 089, 089, 090, 091, 093/ +data (ztbl[i], i=361,370) /094, 095, 097, 099, 101, 102, 103, 105, 106, 108/ +data (ztbl[i], i=371,380) /109, 111, 113, 114, 115, 118, 121, 125, 128, 130/ +data (ztbl[i], i=381,390) /132, 135, 137, 140, 144, 148, 151, 154, 157, 162/ +data (ztbl[i], i=391,400) /166, 172, 177, 180, 184, 192, 200, 207, 213, 219/ +data (ztbl[i], i=401,410) /225, 231, 237, 240, 244, 246, 248, 250, 251, 252/ +data (ztbl[i], i=411,420) /253, 253, 254, 254, 255, 255, 255, 255, 255, 255/ +data (ztbl[i], i=421,430) /255, 255, 255, 255, 255, 255, 255, 255, 255, 255/ +data (ztbl[i], i=431,440) /255, 255, 255, 255, 255, 255, 255, 255, 255, 255/ +data (ztbl[i], i=441,450) /255, 255, 255, 255, 255, 255, 255, 255, 255, 255/ +data (ztbl[i], i=451,460) /255, 255, 255, 255, 255, 255, 255, 255, 255, 255/ +data (ztbl[i], i=461,470) /255, 255, 255, 255, 255, 255, 255, 255, 255, 255/ +data (ztbl[i], i=471,480) /255, 255, 255, 255, 255, 255, 255, 255, 255, 255/ +data (ztbl[i], i=481,490) /255, 255, 255, 255, 255, 255, 255, 255, 255, 255/ +data (ztbl[i], i=491,500) /255, 255, 255, 255, 255, 255, 255, 255, 255, 255/ +data (ztbl[i], i=501,510) /255, 255, 255, 255, 255, 255, 255, 255, 255, 255/ +data (ztbl[i], i=511,512) /255, 255 / diff --git a/noao/imred/vtel/imfglexr.x b/noao/imred/vtel/imfglexr.x new file mode 100644 index 000000000..3c6d4649b --- /dev/null +++ b/noao/imred/vtel/imfglexr.x @@ -0,0 +1,76 @@ +include +include +include "vt.h" + +# IMFGLEXR -- IMFilt Get Line with EXtension Real. Get a line from a +# full disk solar image and extend the boundary appropriately for use +# with acnvr. All pixels outside the limb are set equal to the value +# of the last pixel inside the limb. The line is extended in size by +# an amount given by 'extension' beyond the solar disk width. + +pointer procedure imfglexr (imptr, linenumber, el, extension) + +int linenumber # Line of input image to get +int extension # Amount of boundary extension needed +real el[LEN_ELSTRUCT] # limb ellipse structure +pointer imptr # Input image pointer + +pointer rlptr, sp, tmpptr +real p, n +int lpix1, lpix2 +int linelength +int lexb, rexb, i +short k + +pointer imgl2r() +short shifts() +errchk imgl2r + +begin + k = -4 + + # Calculate the left and right bounds of the extended data. + lexb = E_XCENTER[el] - E_XSEMIDIAMETER[el] - extension + rexb = E_XCENTER[el] + E_XSEMIDIAMETER[el] + extension + + # Extend 10 extra pixels beyond the minimum. + lexb = lexb - 10 + rexb = rexb + 10 + linelength = IM_LEN(imptr,1) + + # Make a temporary short buffer for stripping. + call smark (sp) + call salloc (tmpptr, linelength, TY_SHORT) + + # Get a line in the normal way. Point the real pointer to it. + rlptr = imgl2r (imptr, linenumber) + + # Copy the line into the short array for stripping. + do i = 1, linelength + Mems[tmpptr+i-1] = short(Memr[rlptr+i-1]) + + # Strip off the squibby brightness. Put back into real array. + do i = 1, linelength + Memr[rlptr+i-1] = real(shifts(Mems[tmpptr+i-1], k)) + + # If the whole line is off the limb, return NULL. + if (abs(linenumber - E_YCENTER[el]) >= E_YSEMIDIAMETER[el]) + return(NULL) + + # Use ellipse parameters to determine where the limb intersections are. + p = (real(linenumber) - E_YCENTER[el])**2/E_YSEMIDIAMETER[el]**2 + n = (1.0 - p) * E_XSEMIDIAMETER[el]**2 + + # The two limb points are: + lpix1 = int(-sqrt(abs(n)) + .5) + E_XCENTER[el] + lpix2 = int(sqrt(abs(n)) + .5) + E_XCENTER[el] + + # Extend the boundary of the data beyond the limb + # by duplicating the last inside_the_limb pixel. This extension + # is done out to lexb on the left and rexb on the right. + + call amovkr (Memr[rlptr+lpix1+1], Memr[rlptr+lexb], lpix1-1-lexb) + call amovkr (Memr[rlptr+lpix2-1], Memr[rlptr+lpix2+1], rexb-1-lpix2) + call sfree (sp) + return (rlptr) +end diff --git a/noao/imred/vtel/imfilt.x b/noao/imred/vtel/imfilt.x new file mode 100644 index 000000000..1f25efcfa --- /dev/null +++ b/noao/imred/vtel/imfilt.x @@ -0,0 +1,170 @@ +include +include +include +include "vt.h" + +# IMFILT -- Apply a spatial averageing filter to an image by convolving the +# image with a filter kernel. Return the resulting image in a separate +# image file. + +procedure imfilt (inim, outim, kernel, kxdim, kydim, el) + +pointer inim, outim # input and output images +int kxdim, kydim # dimensions of convolution kernel +real kernel[kxdim, kydim] # convolution kernel +real el[LEN_ELSTRUCT] # limb ellipse structure + +int nlines, linelength, startline +int linebuf, outline, i +int k, offset, x2semi +int extension, startpix, lastline +real p, n, lpix1, lpix2 +pointer lines, tmpptr, outptr, inptr, sp + +pointer impl2r(), imgl2r(), imfglexr() +errchk impl2r, imfglexr, imgl2r + +begin + # Set up the pointer array on the stack. + call smark (sp) + call salloc (lines, kydim, TY_POINTER) + + # Calculate the extension. + extension = kxdim / 2 + offset = E_XCENTER[el] - E_XSEMIDIAMETER[el] + x2semi = 2 * E_XSEMIDIAMETER[el] + + # Startpix is the x-coordinate of the beginning of the 1-D array + # we pass to the convolution vector routine. If wrong, return. + + startpix = offset - extension + if (startpix <= 0) { + call printf ("convolution kernel too wide for this image\n") + return + } + + # Get the dimensions of the image. + linelength = IM_LEN(inim, 1) + nlines = IM_LEN(inim, 2) + + # Pointers to the input and the output images are passed to this + # subroutine by the user. + + # Use imseti to set up the appropriate number of input buffers. + call imseti (inim, IM_NBUFS, kydim+1) + + # Read in the necessary number of input image lines to initially + # fill all but one of the input line buffers. + # First, skip over all lines that are off the limb. + # The size of the output image is defined prior to the call + # to this subroutine, the output image is the same size as the + # input image. + + startline = 0 + Memi[lines] = NULL + + # Skip over empty lines. + while (Memi[lines] == NULL) { + startline = startline + 1 + Memi[lines] = imfglexr (inim, startline, el, extension) + } + + # Fill (almost) the line buffer. + do linebuf = 1, kydim-2 + Memi[lines+linebuf] = imfglexr (inim, linebuf+startline, + el, extension) + + # Copy the first startline lines from the input image into the + # output image. + do outline = 1, startline + (kydim/2) { + + # Put next line to output image, get the corresponding line from + # the input image. + inptr = imgl2r (inim, outline) + outptr = impl2r (outim, outline) + + # Copy the input line into the ouput line. Strip sqib. + do i = 1, DIM_VTFD { + Memr[outptr+i-1] = Memr[inptr+i-1]/16. + } + } + + # Do the convolution, output line by output line. + do outline = (kydim/2) + startline, nlines { + + # Use ellipse parameters to determine where the limb + # intersections are. + p = (real(outline) - E_YCENTER[el])**2/E_YSEMIDIAMETER[el]**2 + n = (1.0 - p) * E_XSEMIDIAMETER[el]**2 + + # The two limb points are: + lpix1 = int(-sqrt(abs(n)) + .5) + E_XCENTER[el] + lpix2 = int(sqrt(abs(n)) + .5) + E_XCENTER[el] + + # Keep a copy of this input line around for filling outside + # the limb. + inptr = imgl2r (inim, outline) + + # Scroll the buffer pointer array. + if (outline > ((kydim/2) + startline)) + do i = 0, kydim - 2 + Memi[lines+i] = Memi[lines+i+1] + + # Get next line from input image, if it is off the limb then we + # are done. + + tmpptr = imfglexr (inim, outline+((kydim/2)+1), el, extension) + if (tmpptr == NULL) { + lastline = outline + break + } + Memi[lines+kydim-1] = tmpptr + + # Put next line to output image. + outptr = impl2r (outim, outline) + + # Zero the output line. + call aclrr (Memr[outptr], DIM_VTFD) + + # Here is the actual convolution, this is a do loop over the lines + # of the kernel, each call to acnvrs adds the convolution of a + # kernel line with an input line to the output line. + + do k = 1, kydim + call acnvr (Memr[Memi[lines+k-1]+startpix], Memr[outptr+offset], + x2semi, kernel[1,k], kxdim) + + # Fill outside the limb with orig data. + do i = 1, lpix1 { + Memr[outptr+i-1] = Memr[inptr+i-1]/16. + } + do i = lpix2, DIM_VTFD { + Memr[outptr+i-1] = Memr[inptr+i-1]/16. + } + + # Roundoff adjustment. + do i = startpix, startpix+x2semi { + if (Memr[outptr+i-1] < 0.0) + Memr[outptr+i-1] = Memr[outptr+i-1] - .5 + else + Memr[outptr+i-1] = Memr[outptr+i-1] + .5 + } + + } # End of do loop on outline. + + # Clear the rest of the image. + do outline = lastline, DIM_VTFD { + + # Put next line to output image, get the corresponding line from + # the input image. + inptr = imgl2r (inim, outline) + outptr = impl2r (outim, outline) + + # Copy the input line into the ouput line. Strip sqib. + do i = 1, DIM_VTFD { + Memr[outptr+i-1] = Memr[inptr+i-1]/16. + } + } + + call sfree (sp) +end diff --git a/noao/imred/vtel/imratio.x b/noao/imred/vtel/imratio.x new file mode 100644 index 000000000..5586d204f --- /dev/null +++ b/noao/imred/vtel/imratio.x @@ -0,0 +1,29 @@ +# IMRATIO -- Divide two images and return the result in a third image. + +procedure imratio (numerator, denominator, ratio, xdim, ydim) + +real numerator[xdim, ydim] # input numerator +real denominator[xdim, ydim] # input denominator +real ratio[xdim, ydim] # output ratio image +int xdim, ydim # dimensions of the image + +int i +real ezero() +extern ezero() + +begin + do i = 1, ydim { + call arltr (denominator[1,i], xdim, 1E-10, 0.0) + call advzr (numerator[1,i], denominator[1,i], ratio[1,i], xdim, + ezero) + } +end + + +real procedure ezero (input) + +real input + +begin + return (0.0) +end diff --git a/noao/imred/vtel/lstsq.x b/noao/imred/vtel/lstsq.x new file mode 100644 index 000000000..9091fb48c --- /dev/null +++ b/noao/imred/vtel/lstsq.x @@ -0,0 +1,85 @@ +include + +# LSTSQ -- Do a least squares fit to the data contained in the zz array. +# Algorithm is from Jack Harvey. (Yes, it's a black box...) + +procedure lstsq (zz, mz, fno) + +real zz[mz, mz] +int mz +real fno + +int n, m, m1, i, j, k, l, l1 +real fn, pp + +begin + n = mz - 2 + m = n + 1 + m1 = m + 1 + fn = n + + do i = 1, m { + l = i + 1 + do k = 1, i-1 { + zz[i,l] = zz[i,l] - zz[k,l]**2 + } + + if (i == m) + break + if (zz[i,l] >= 0.0) + zz[i,l] = zz[i,l]**.5 + else { + call eprintf ("square root of negitive number in lstsq\n") + zz[i,l] = 0.0 + } + l1 = l + 1 + + do j = l1, m1 { + do k = 1, i-1 { + zz[i,j] = zz[i,j] - zz[k,l] * zz[k,j] + } + if (zz[i,l] >= EPSILONR) + zz[i,j] = zz[i,j] / zz[i,l] + else + call eprintf ("divide by zero in lstsq\n") + } + + if (zz[i,l] >= EPSILONR) + zz[i,i] = 1. / zz[i,l] + else + call eprintf ("divide by zero in lstsq\n") + do j = 1, i-1 { + pp = 0. + l1 = i - 1 + do k = j, l1 { + pp = pp + zz[k,l] * zz[k,j] + } + zz[i,j] = -zz[i,i] * pp + } + } + + if ((fno - fn) >= EPSILONR) + if ((zz[m,m1] / (fno - fn)) >= 0.0) + zz[m1,m1] = .6745 * (zz[m,m1] / (fno - fn))**.5 + else { + call eprintf ("square root of negitive number in lstsq\n") + zz[m1,m1] = 0.0 + } + else + call eprintf ("divide by zero in lstsq\n") + + do i = 1, n { + zz[m,i] = 0. + pp = 0. + do j = i, n { + zz[m,i] = zz[m,i] + zz[j,i] * zz[j,m1] + pp = pp + zz[j,i] * zz[j,i] + } + if (pp >= 0.0) + zz[m1,i] = zz[m1,m1] * pp**.5 + else { + call eprintf ("square root of negitive number in lstsq\n") + zz[m1,i] = 0.0 + } + } +end diff --git a/noao/imred/vtel/makehelium.cl b/noao/imred/vtel/makehelium.cl new file mode 100644 index 000000000..5cab86962 --- /dev/null +++ b/noao/imred/vtel/makehelium.cl @@ -0,0 +1,51 @@ +#{ MAKEHELIUM -- + +# getinroot,s,a,,,,Input root file name +# getoutroot,s,a,,,,Root filename for output images +# inroot,s,h +# outroot,s,h + +{ + inroot = getinroot + outroot = getoutroot + + if (access(inroot//"1.imh")) { + rmap (inroot//"1", outroot//"a1", outroot//"a3", outroot//"a2", + "H"//outroot//"a") + imdelete (inroot//"1") + } else { + print (inroot//"1 not accessable") + } + + if (access(inroot//"2.imh")) { + rmap (inroot//"2", outroot//"b1", outroot//"b3", outroot//"b2", + "H"//outroot//"b") + imdelete (inroot//"2") + } else { + print (inroot//"2 not accessable") + } + + if (access(inroot//"3.imh")) { + rmap (inroot//"3", outroot//"c1", outroot//"c3", outroot//"c2", + "H"//outroot//"c") + imdelete (inroot//"3") + } else { + print (inroot//"3 not accessable") + } + + if (access(inroot//"4.imh")) { + rmap (inroot//"4", outroot//"d1", outroot//"d3", outroot//"d2", + "H"//outroot//"d") + imdelete (inroot//"4") + } else { + print (inroot//"4 not accessable") + } + + if (access(inroot//"5.imh")) { + rmap (inroot//"5", outroot//"e1", outroot//"e3", outroot//"e2", + "H"//outroot//"e") + imdelete (inroot//"5") + } else { + print (inroot//"5 not accessable") + } +} diff --git a/noao/imred/vtel/makehelium.par b/noao/imred/vtel/makehelium.par new file mode 100644 index 000000000..426eda03f --- /dev/null +++ b/noao/imred/vtel/makehelium.par @@ -0,0 +1,4 @@ +getinroot,s,a,,,,Input root file name +getoutroot,s,a,,,,Root filename for output images +inroot,s,h +outroot,s,h diff --git a/noao/imred/vtel/makeimages.cl b/noao/imred/vtel/makeimages.cl new file mode 100644 index 000000000..1da6b8323 --- /dev/null +++ b/noao/imred/vtel/makeimages.cl @@ -0,0 +1,66 @@ +#{ MAKEIMAGES -- + +# getinroot,s,a,,,,Input root file name +# getoutroot,s,a,,,,Root filename for output images +# inroot,s,h +# outroot,s,h + +{ + inroot = getinroot + outroot = getoutroot + + if (access("scratch$"//inroot//"001")) { + readvt ("scratch$"//inroot//"001", inroot//"tmp1") + quickfit (inroot//"tmp1001",verbose=yes) + rmap (inroot//"tmp1001",outroot//"a1",outroot//"a3", + outroot//"a2","H"//outroot//"a") + delete ("scratch$"//inroot//"001") + imdelete (inroot//"tmp1001") + } else { + print ("scratch$"//inroot//"001 not accessable") + } + + if (access("scratch$"//inroot//"002")) { + readvt ("scratch$"//inroot//"002", inroot//"tmp2") + quickfit (inroot//"tmp2001",verbose=yes) + rmap (inroot//"tmp2001",outroot//"b1",outroot//"b3", + outroot//"b2","H"//outroot//"b") + delete ("scratch$"//inroot//"002") + imdelete (inroot//"tmp2001") + } else { + print ("scratch$"//inroot//"002 not accessable") + } + + if (access("scratch$"//inroot//"003")) { + readvt ("scratch$"//inroot//"003", inroot//"tmp3") + quickfit (inroot//"tmp3001",verbose=yes) + rmap (inroot//"tmp3001",outroot//"c1",outroot//"c3", + outroot//"c2","H"//outroot//"c") + delete ("scratch$"//inroot//"003") + imdelete (inroot//"tmp3001") + } else { + print ("scratch$"//inroot//"003 not accessable") + } + + if (access("scratch$"//inroot//"004")) { + readvt ("scratch$"//inroot//"004", inroot//"tmp4") + quickfit (inroot//"tmp4001",verbose=yes) + rmap (inroot//"tmp4001",outroot//"d1",outroot//"d3", + outroot//"d2","H"//outroot//"d") + delete ("scratch$"//inroot//"004") + imdelete (inroot//"tmp4001") + } else { + print ("scratch$"//inroot//"004 not accessable") + } + + if (access("scratch$"//inroot//"005")) { + readvt ("scratch$"//inroot//"005", inroot//"tmp5") + quickfit (inroot//"tmp5001",verbose=yes) + rmap (inroot//"tmp5001",outroot//"e1",outroot//"e3", + outroot//"e2","H"//outroot//"e") + delete ("scratch$"//inroot//"005") + imdelete (inroot//"tmp5001") + } else { + print ("scratch$"//inroot//"005 not accessable") + } +} diff --git a/noao/imred/vtel/makeimages.par b/noao/imred/vtel/makeimages.par new file mode 100644 index 000000000..426eda03f --- /dev/null +++ b/noao/imred/vtel/makeimages.par @@ -0,0 +1,4 @@ +getinroot,s,a,,,,Input root file name +getoutroot,s,a,,,,Root filename for output images +inroot,s,h +outroot,s,h diff --git a/noao/imred/vtel/merge.par b/noao/imred/vtel/merge.par new file mode 100644 index 000000000..3a0b07685 --- /dev/null +++ b/noao/imred/vtel/merge.par @@ -0,0 +1,9 @@ +mergelist,s,h,"mergelist",,,List of files to merge +outputimage,s,q,"carmap",,,Outputimage +outweight,s,q,"carweight",,,Output image weights +outabs,s,q,"carabs",,,Absolute value image +outratio,s,q,"carratio",,,Ratio: outputimage over absolute value image +longout,r,h,180.0,1.,360.,Longitude of center of this carrington rotation +mapmonth,i,q,,1,12,Month of center of this carrington rotation +mapday,i,q,,1,31,Day of center of this carrington rotation +mapyear,i,q,,1,99,Year of center of this carrington rotation diff --git a/noao/imred/vtel/merge.x b/noao/imred/vtel/merge.x new file mode 100644 index 000000000..85d595f3e --- /dev/null +++ b/noao/imred/vtel/merge.x @@ -0,0 +1,762 @@ +include +include +include "vt.h" + +# MERGE -- Put together all appropriate daily grams to produce a full +# carrington rotation map. This is done both for the average input images +# and for the absolute value input images. The output of the program is +# 4 images, average image, absolute value image, weight image, ratio of +# first image to second image. + +procedure t_merge() + +char mergelist[SZ_FNAME] # list of images to be merged + +int wavelength, listfd +char inputimage[SZ_FNAME] +pointer inputim + +pointer immap() +int imgeti(), open(), fscan() +errchk immap, open + +begin + # Get the image name file from the cl and open it. + call clgstr ("mergelist", mergelist, SZ_FNAME) + listfd = open (mergelist, READ_ONLY, TEXT_FILE) + + # Get the wavelength from the first image in the mergelist. + if (fscan (listfd) != EOF) { + call gargwrd (inputimage, SZ_FNAME) + inputim = immap (inputimage, READ_ONLY, 0) + wavelength = imgeti (inputim, "WV_LNGTH") + call close (listfd) + } else { + call error (0, "No images in 'mergelist'") + call close (listfd) + return + } + + if (wavelength == 8688) + call mergem (mergelist, wavelength) + else + call mergeh (mergelist, wavelength) +end + + +# MERGEM -- MERGE Magnetograms. + +procedure mergem (mergelist, wavelength) + +char mergelist[SZ_FNAME] # list of images to be merged +int wavelength # wavelength of images + +pointer outputim, outw, outa, outr +pointer outptr, outwptr, outaptr, outrptr +char outputimage[SZ_FNAME], outweight[SZ_FNAME] +char outabs[SZ_FNAME], outratio[SZ_FNAME] +real longout, weight_tbl[SZ_WTBL], bzeroave +int i, mapmonth, mapday, mapyear + +real clgetr() +int clgeti() +pointer immap(), imps2r() +errchk immap, imps2r + +begin + # Get parameters from the cl. + + # Output images. + call clgstr ("outputimage", outputimage, SZ_FNAME) + call clgstr ("outweight", outweight, SZ_FNAME) + call clgstr ("outabs", outabs, SZ_FNAME) + call clgstr ("outratio", outratio, SZ_FNAME) + + # Longitude of center of output Carrington rotation map. + longout = clgetr ("longout") + + # Month, day, and year of the center of the output map. + mapmonth = clgeti ("mapmonth") + mapday = clgeti ("mapday") + mapyear = clgeti ("mapyear") + + # Open output image. + outputim = immap (outputimage, NEW_IMAGE, 0) + + # Define some parameters for the output images. + IM_NDIM(outputim) = 2 + IM_LEN(outputim, 1) = DIM_XCARMAP + IM_LEN(outputim, 2) = DIM_SQUAREIM + IM_PIXTYPE(outputim) = TY_REAL + + # Open the rest of the output images. + outw = immap (outweight, NEW_COPY, outputim) + outa = immap (outabs, NEW_COPY, outputim) + outr = immap (outratio, NEW_COPY, outputim) + + # Map the outputimages into memory. + outptr = imps2r (outputim, 1, DIM_XCARMAP, 1, DIM_SQUAREIM) + outwptr = imps2r (outw, 1, DIM_XCARMAP, 1, DIM_SQUAREIM) + outaptr = imps2r (outa, 1, DIM_XCARMAP, 1, DIM_SQUAREIM) + outrptr = imps2r (outr, 1, DIM_XCARMAP, 1, DIM_SQUAREIM) + + # Create weight table. + do i = 1,SZ_WTBL + weight_tbl[i] = (cos((real(i-91)+.5)*3.1415926/180.))**4 + + call mmall (mergelist, Memr[outptr], Memr[outwptr], Memr[outaptr], + outputim, outw, outa, outr, wavelength, weight_tbl, longout, + mapmonth, mapday, mapyear, bzeroave) + + # Fill the ratio image. + call imratio (Memr[outptr],Memr[outaptr],Memr[outrptr],DIM_XCARMAP, + DIM_SQUAREIM) + + # Write some information out to the image headers. + call imaddr (outputim, "AV_BZERO", bzeroave) + call imaddi (outputim, "WV_LNGTH", wavelength) + call imaddr (outw, "AV_BZERO", bzeroave) + call imaddi (outw, "WV_LNGTH", wavelength) + call imaddb (outw, "WEIGHTS", TRUE) + call imaddr (outa, "AV_BZERO", bzeroave) + call imaddr (outr, "AV_BZERO", bzeroave) + call imaddi (outa, "WV_LNGTH", wavelength) + call imaddi (outr, "WV_LNGTH", wavelength) + call imaddb (outa, "ABS_VALU", TRUE) + call imaddb (outr, "POLARITY", TRUE) + + # Weight the data image and the abs image. + call imratio (Memr[outptr],Memr[outwptr],Memr[outptr],DIM_XCARMAP, + DIM_SQUAREIM) + call imratio (Memr[outaptr],Memr[outwptr],Memr[outaptr],DIM_XCARMAP, + DIM_SQUAREIM) + + # Close images + call imunmap (outputim) + call imunmap (outw) + call imunmap (outa) + call imunmap (outr) +end + + +# MERGEH -- MERGE Helium 10830 grams. + +procedure mergeh (mergelist, wavelength) + +char mergelist[SZ_FNAME] # list of images to merge +int wavelength # wavelength of observation + +pointer outputim, outw +pointer outptr, outwptr +char outputimage[SZ_FNAME], outweight[SZ_FNAME] +real longout, weight_tbl[SZ_WTBL], bzeroave +int i, mapmonth, mapday, mapyear + +real clgetr() +int clgeti() +pointer immap(), imps2r() +errchk immap, imps2r + +begin + # Get parameters from the cl. + + # Output images. + call clgstr ("outputimage", outputimage, SZ_FNAME) + call clgstr ("outweight", outweight, SZ_FNAME) + + # Longitude of center of output Carrington rotation map. + longout = clgetr ("longout") + + # Month, day, and year of the center of the output map. + mapmonth = clgeti ("mapmonth") + mapday = clgeti ("mapday") + mapyear = clgeti ("mapyear") + + # Open output image. + outputim = immap (outputimage, NEW_IMAGE, 0) + + # Define some parameters for the output images. + IM_NDIM(outputim) = 2 + IM_LEN(outputim, 1) = DIM_XCARMAP + IM_LEN(outputim, 2) = DIM_SQUAREIM + IM_PIXTYPE(outputim) = TY_REAL + + # Open the other output image. + outw = immap (outweight, NEW_COPY, outputim) + + # Map the outputimages into memory. + outptr = imps2r (outputim, 1, DIM_XCARMAP, 1, DIM_SQUAREIM) + outwptr = imps2r (outw, 1, DIM_XCARMAP, 1, DIM_SQUAREIM) + + # Create weight table. + do i = 1,SZ_WTBL + weight_tbl[i] = (cos((real(i-91)+.5)*3.1415926/180.))**4 + + call mhall (mergelist, Memr[outptr], Memr[outwptr], outputim, + outw, wavelength, weight_tbl, longout, mapmonth, + mapday, mapyear, bzeroave) + + # Write some information out to the image headers. + call imaddr (outputim, "AV_BZERO", bzeroave) + call imaddi (outputim, "WV_LNGTH", wavelength) + call imaddr (outw, "AV_BZERO", bzeroave) + call imaddi (outw, "WV_LNGTH", wavelength) + call imaddb (outw, "WEIGHTS", TRUE) + + # Weight the data image. + call imratio (Memr[outptr],Memr[outwptr],Memr[outptr],DIM_XCARMAP, + DIM_SQUAREIM) + + # Close images. + call imunmap (outputim) + call imunmap (outw) +end + + +# MMALL -- Merge Magnetograms ALL. +# Map in each input image, weight it, figure out where it goes +# and add it to the output image. + +procedure mmall (mergelist, outarray, outarrayw, outarraya, outputim, + outw, outa, outr, wavelength, weight_tbl, longout, mapmonth, mapday, + mapyear, bzeroave) + +char mergelist[SZ_FNAME] # list of images to be merged +int wavelength # wavelength of observations +real outarray[DIM_XCARMAP, DIM_SQUAREIM] # output data array +real outarrayw[DIM_XCARMAP, DIM_SQUAREIM] # output weights array +real outarraya[DIM_XCARMAP, DIM_SQUAREIM] # output absolute value array +pointer inputim # pointer to input image +pointer outputim # pointer to output image +pointer outw # pointer to weight image +pointer outa # pointer to abs value image +pointer outr # pointer to ratio image +int mapmonth, mapday, mapyear # date of output map +real weight_tbl[SZ_WTBL] # weight table +real longout # longitude of map center +real bzeroave # average b-zero for map + +char inputimage[SZ_FNAME], inweight[SZ_FNAME], inabs[SZ_FNAME] +pointer inw, ina, inptr, inwptr, inaptr +int listfd, month, day, year, count +real longin, bzero, bzerosum +int obsdate, temp, i, j +char ltext[SZ_LINE] + +int open(), fscan(), imgeti() +real imgetr() +pointer immap(), imgs2i(), imgs2s() +errchk open, immap, imgs2i, imgs2s + +begin + count = 0 + bzerosum = 0.0 + listfd = open (mergelist, READ_ONLY, TEXT_FILE) + + # Zero the output images. + do i = 1, DIM_XCARMAP { + do j = 1, DIM_SQUAREIM { + outarray[i,j] = 0.0 + outarrayw[i,j] = 0.0 + outarraya[i,j] = 0.0 + } + } + + # Get inputimages from the mergelist until they are all used up. + while (fscan (listfd) != EOF) { + call gargwrd (inputimage, SZ_FNAME) + + # Get absolute value image. + if(fscan (listfd) != EOF) + call gargwrd (inabs, SZ_FNAME) + else + call error (0, "wrong number of file names in mergelist") + + # Get weight image. + if(fscan (listfd) != EOF) + call gargwrd (inweight, SZ_FNAME) + else + call error (0, "wrong number of file names in mergelist") + + # Open input image, its corresponding weight map, and its + # corresponding absolute value map. + + inputim = immap (inputimage, READ_ONLY, 0) + inw = immap (inweight, READ_ONLY, 0) + ina = immap (inabs, READ_ONLY, 0) + + bzero = imgetr (inputim, "B_ZERO") + bzerosum = bzerosum + bzero + longin = imgetr (inputim, "L_ZERO") + obsdate = imgeti (inputim, "OBS_DATE") + + # Check to see that the date is same on the three input images. + temp = imgeti (inw, "OBS_DATE") + if (temp != obsdate) { + call eprintf ("ERROR: date on weight image differs from that ") + call eprintf ("on data image!\n") + break + } + + temp = imgeti (ina, "OBS_DATE") + if (temp != obsdate) { + call eprintf ("ERROR: date on abs image differs from that ") + call eprintf ("on data image!\n") + break + } + + # Decode month, day, year. + month = obsdate/10000 + day = obsdate/100 - 100 * (obsdate/10000) + year = obsdate - 100 * (obsdate/100) + + # Pack a name for this date and longitude and then put them out + # into the outputimages' headers. + + count = count + 1 + call sprintf (ltext, SZ_LINE, "DATE%04d") + call pargi (count) + call imaddi (outputim, ltext, obsdate) + call imaddi (outw, ltext, obsdate) + call imaddi (outa, ltext, obsdate) + call imaddi (outr, ltext, obsdate) + + call sprintf (ltext, SZ_LINE, "LONG%04d") + call pargi (count) + call imaddr (outputim, ltext, longin) + call imaddr (outw, ltext, longin) + call imaddr (outa, ltext, longin) + call imaddr (outr, ltext, longin) + + # Map the inputimage, the weight map, and abs_image into memory. + inptr = imgs2i (inputim, 1, DIM_SQUAREIM, 1, DIM_SQUAREIM) + inwptr = imgs2s (inw, 1, DIM_SQUAREIM, 1, DIM_SQUAREIM) + inaptr = imgs2i (ina, 1, DIM_SQUAREIM, 1, DIM_SQUAREIM) + + # Weight this image and add it to the output image. + call addmweight (Memi[inptr],Mems[inwptr],Memi[inaptr],outarray, + outarrayw, outarraya, weight_tbl, longin, longout, + month, day, year, mapmonth, mapday, mapyear) + + # Close this input image. + call imunmap (inputim) + call imunmap (inw) + call imunmap (ina) + + } # end of do loop on input images + + bzeroave = bzerosum/real(count) + call close (listfd) +end + + +# MHALL -- Merge Heliumgrams ALL. +# Map in each input image, weight it, figure out where it goes +# and add it to the output image. + +procedure mhall (mergelist, outarray, outarrayw, outputim, + outw, wavelength, weight_tbl, longout, mapmonth, mapday, + mapyear, bzeroave) + +char mergelist[SZ_FNAME] # list of images to be merged +int wavelength # wavelength of observations +real outarray[DIM_XCARMAP, DIM_SQUAREIM] # output data array +real outarrayw[DIM_XCARMAP, DIM_SQUAREIM] # output weights array +pointer inputim # pointer to input image +pointer outputim # pointer to output image +pointer outw # pointer to weight image +int mapmonth, mapday, mapyear # date of output map +real weight_tbl[SZ_WTBL] # weight table +real longout # longitude of map center +real bzeroave # average b-zero for map + +char inputimage[SZ_FNAME], inweight[SZ_FNAME] +pointer inw, inptr, inwptr +int listfd, month, day, year, count +real longin, bzero, bzerosum +int obsdate, temp, i, j +char ltext[SZ_LINE] + +real imgetr() +int open(), fscan(), imgeti() +pointer immap(), imgs2i(), imgs2s() +errchk open, immap, imgs2i, imgs2s + +begin + count = 0 + bzerosum = 0.0 + listfd = open (mergelist, READ_ONLY, TEXT_FILE) + + # Zero the output images. + do i = 1, DIM_XCARMAP { + do j = 1, DIM_SQUAREIM { + outarray[i,j] = 0.0 + outarrayw[i,j] = 0.0 + } + } + + # Get inputimages from the mergelist until they are all used up. + while (fscan (listfd) != EOF) { + call gargwrd (inputimage, SZ_FNAME) + + # Get weight image. + if (fscan (listfd) != EOF) + call gargwrd (inweight, SZ_FNAME) + else + call error (0, "wrong number of file names in mergelist") + + # Open input image, its corresponding weight map, and its + # corresponding absolute value map. + + inputim = immap (inputimage, READ_ONLY, 0) + inw = immap (inweight, READ_ONLY, 0) + + bzero = imgetr (inputim, "B_ZERO") + bzerosum = bzerosum + bzero + longin = imgetr (inputim, "L_ZERO") + obsdate = imgeti (inputim, "OBS_DATE") + + # Check to see that the date is same on the three input images. + temp = imgeti (inw, "OBS_DATE") + if (temp != obsdate) { + call eprintf ("ERROR: date on weight image differs from that ") + call eprintf ("on data image!\n") + break + } + + # Decode month, day, year. + month = obsdate/10000 + day = obsdate/100 - 100 * (obsdate/10000) + year = obsdate - 100 * (obsdate/100) + + # Pack a name for this date and longitude and then put them out + # into the outputimages' headers. + + count = count + 1 + call sprintf (ltext, SZ_LINE, "DATE%04d") + call pargi (count) + call imaddi (outputim, ltext, obsdate) + call imaddi (outw, ltext, obsdate) + + call sprintf (ltext, SZ_LINE, "LONG%04d") + call pargi (count) + call imaddr (outputim, ltext, longin) + call imaddr (outw, ltext, longin) + + # Map the inputimage, the weight map, and abs_image into memory. + inptr = imgs2i (inputim, 1, DIM_SQUAREIM, 1, DIM_SQUAREIM) + inwptr = imgs2s (inw, 1, DIM_SQUAREIM, 1, DIM_SQUAREIM) + + # Weight this image and add it to the output image. + call addhweight (Memi[inptr], Mems[inwptr], outarray, outarrayw, + weight_tbl, longin, longout, month, day, year, mapmonth, + mapday, mapyear) + + # Close this input image. + call imunmap (inputim) + call imunmap (inw) + + } # end of do loop on input images + + bzeroave = bzerosum/real(count) + call close (listfd) +end + + +# ADDMWEIGHT -- Weight input image by cos(longitude - (L-L0))**4, and add +# it to the output image in the proper place. + +procedure addmweight (inim, inwim, inaim, outim, outwim, outaim, + weight_tbl, longin, longout, month, day, year, mapmonth, mapday, + mapyear) + +int inim[DIM_SQUAREIM, DIM_SQUAREIM] # input image +short inwim[DIM_SQUAREIM, DIM_SQUAREIM] # input image weights +int inaim[DIM_SQUAREIM, DIM_SQUAREIM] # input absolute image +real outim[DIM_XCARMAP, DIM_SQUAREIM] # outputimage +real outwim[DIM_XCARMAP, DIM_SQUAREIM] # output image weights +real outaim[DIM_XCARMAP, DIM_SQUAREIM] # output absolute image +int month, day, year # date of input image +int mapmonth, mapday, mapyear # date of output image +real weight_tbl[DIM_SQUAREIM] # weight table +real longin, longout # longitudes of images + +int p1offset, p2offset, firstpix, lastpix, column, row +int offset, datein, dateout, temp, temp2 +int d1900() + +begin + # Translate the two dates into julian day numbers to make comparisons + # simpler. + + datein = d1900 (month, day, year) + dateout = d1900 (mapmonth, mapday, mapyear) + + # Figure out the pixel offset between the first pixel of the input + # image and the first pixel of ther output image. + # Actually, there may be two pixel offsets for a particular image + # corresponding to the correct position of the image and the 360 + # degree offset position. + + p1offset = mod(abs(int(longin - longout + .5)), 360) # This is one. + p2offset = 360 - p1offset # This is the other. + + # Determine which side of the output image center is each of these + # offsets. + + if (datein > dateout) { + if (longout > 180) { + if (((longin >= longout) && (longin <= 360)) || + (longin <= mod((longout + 180.),360.))) { + if (p1offset < 180) + offset = p2offset + else + offset = p1offset + } else { + if (p1offset >= 180) + offset = p2offset + else + offset = p1offset + } + } else { + if ((longin >= longout) && (longin <= (longout + 180))) { + if (p1offset <= 180) + offset = p2offset + else + offset = p1offset + } else { + if (p1offset >= 180) + offset = p2offset + else + offset = p1offset + } + } + } else { + if (longout < 180) { + if (((longin >= (180 + longout)) && (longin <= 360)) || + (longin <= longout)) { + if (p1offset < 180) + offset = p2offset + else + offset = p1offset + } else { + if (p1offset >= 180) + offset = p2offset + else + offset = p1offset + } + } else { + if ((longin < longout) && (longin > (longout - 180))) { + if (p1offset < 180) + offset = p2offset + else + offset = p1offset + } else { + if (p1offset >= 180) + offset = p2offset + else + offset = p1offset + } + } + } + + # Make sure the sign is right + if (datein > dateout) + offset = -offset + + # Check for the case that the two longitudes are equal. + if (longin == longout) { + if (abs(datein - dateout) <= 1) { + offset = 0 + } else { + call eprintf ("input day too far from center of output map\n") + return + } + } + + # Check for the case that the two dates are equal. + if (datein == dateout) + offset = longin - longout + + # If the offset is too large then do not use this image. + if (abs(offset) > 240) { + call eprintf ("input day too far from center of output map\n") + return + } + + # Determine what part, if not all, of the input image will lie on the + # output image. + + firstpix = 1 + if (offset < -90) + firstpix = abs(offset+90) + lastpix = DIM_SQUAREIM + if (offset > 90) + lastpix = 180 - (offset - 90) + + + # Do all 180 columns in the image. + if (offset <= 0) + temp = 91 + else + temp = 90 + + do column = firstpix,lastpix { + do row = 1, DIM_SQUAREIM { + temp2 = column + temp + offset + outim[temp2,row] = outim[temp2, row] + + inim[column, row] * weight_tbl[column] + outwim[temp2,row] = outwim[temp2, row] + + inwim[column, row] * weight_tbl[column] + outaim[temp2,row] = outaim[temp2, row] + + inaim[column, row] * weight_tbl[column] + } + } +end + + +# ADDHWEIGHT -- Weight input image by cos(longitude - (L-L0))**4, and add +# it to the output image in the proper place. (For 10830 grams) + +procedure addhweight (inim, inwim, outim, outwim, weight_tbl, longin, longout, + month, day, year, mapmonth, mapday, mapyear) + +int inim[DIM_SQUAREIM, DIM_SQUAREIM] # input image +short inwim[DIM_SQUAREIM, DIM_SQUAREIM] # input image weights +real outim[DIM_XCARMAP, DIM_SQUAREIM] # outputimage +real outwim[DIM_XCARMAP, DIM_SQUAREIM] # output image weights +int month, day, year # date of input image +int mapmonth, mapday, mapyear # date of output image +real weight_tbl[DIM_SQUAREIM] # weight table +real longin, longout # longitudes of images + +int p1offset, p2offset, firstpix, lastpix, column, row +int offset, datein, dateout, temp, temp2 +int d1900() + +begin + # Translate the two dates into julian day numbers to make comparisons + # simpler. + + datein = d1900 (month, day, year) + dateout = d1900 (mapmonth, mapday, mapyear) + + # Figure out the pixel offset between the first pixel of the input + # image and the first pixel of ther output image. + # Actually, there may be two pixel offsets for a particular image + # corresponding to the correct position of the image and the 360 + # degree offset position. + + p1offset = mod(abs(int(longin - longout + .5)), 360) # this is one. + p2offset = 360 - p1offset # this is the other. + + # Determine which side of the output image center is each of these + # offsets. + + if (datein > dateout) { + if (longout > 180) { + if (((longin >= longout) && (longin <= 360)) || + (longin <= mod((longout + 180.),360.))) { + if (p1offset < 180) + offset = p2offset + else + offset = p1offset + } else { + if (p1offset >= 180) + offset = p2offset + else + offset = p1offset + } + } else { + if ((longin >= longout) && (longin <= (longout + 180))) { + if (p1offset <= 180) + offset = p2offset + else + offset = p1offset + } else { + if (p1offset >= 180) + offset = p2offset + else + offset = p1offset + } + } + } else { + if (longout < 180) { + if (((longin >= (180 + longout)) && (longin <= 360)) || + (longin <= longout)) { + if (p1offset < 180) + offset = p2offset + else + offset = p1offset + } else { + if (p1offset >= 180) + offset = p2offset + else + offset = p1offset + } + } else { + if ((longin < longout) && (longin > (longout - 180))) { + if (p1offset < 180) + offset = p2offset + else + offset = p1offset + } else { + if (p1offset >= 180) + offset = p2offset + else + offset = p1offset + } + } + } + + # Make sure the sign is right. + if (datein > dateout) + offset = -offset + + # Check for the case that the two longitudes are equal. + if (longin == longout) { + if (abs(datein - dateout) <= 1) { + offset = 0 + } else { + call eprintf ("Input day too far from center of output map.\n") + return + } + } + + # Check for the case that the two dates are equal. + if (datein == dateout) + offset = longin - longout + + # If the offset is too large then do not use this image. + if (abs(offset) > 240) { + call eprintf ("input day too far from center of output map\n") + return + } + + # Determine what part, if not all, of the input image will lie on the + # output image. + + firstpix = 1 + if (offset < -90) + firstpix = abs(offset+90) + lastpix = DIM_SQUAREIM + if (offset > 90) + lastpix = 180 - (offset - 90) + + + # Do all 180 columns in the image. + if (offset <= 0) + temp = 91 + else + temp = 90 + + do column = firstpix, lastpix { + do row = 1, DIM_SQUAREIM { + temp2 = column + temp + offset + outim[temp2,row] = outim[temp2, row] + + inim[column, row] * weight_tbl[column] + outwim[temp2,row] = outwim[temp2, row] + + inwim[column, row] * weight_tbl[column] + } + } +end diff --git a/noao/imred/vtel/mkpkg b/noao/imred/vtel/mkpkg new file mode 100644 index 000000000..fce77cd7f --- /dev/null +++ b/noao/imred/vtel/mkpkg @@ -0,0 +1,57 @@ +# Make the VTEL Package + +$call relink +$exit + +update: + $call relink + $call install + ; + +relink: + $set LIBS = "-lxtools" + $update libpkg.a + $omake x_vtel.x + $link x_vtel.o libpkg.a $(LIBS) + ; + +install: + $move x_vtel.e noaobin$ + ; + +libpkg.a: + d1900.x + decodeheader.x "vt.h" + destreak.x "vt.h" + dicoplot.x "gryscl.inc" "dicoplot.h" "vt.h" \ + + dephem.x + gauss.x + getsqib.x "vt.h" + imfglexr.x "vt.h" + imfilt.x "vt.h" + imratio.x + textim.x + lstsq.x + merge.x "vt.h" + mscan.x "vt.h" + numeric.x "vt.h" "numeric.h" + pimtext.x "vt.h" + pixbit.x "asciilook.inc" "pixelfont.inc" + putsqib.x "vt.h" + quickfit.x "vt.h" + readheader.x "vt.h" + readss1.x "vt.h" + readss2.x "vt.h" + readss3.x "vt.h" + readss4.x "vt.h" + readsubswath.x "vt.h" + readvt.x "vt.h" + syndico.x "vt.h" "trnsfrm.inc" "syndico.h" \ + + tcopy.x "vt.h" + trim.x "vt.h" + unwrap.x + vtexamine.x "vt.h" + writevt.x "vt.h" + ; diff --git a/noao/imred/vtel/mrotlogr.cl b/noao/imred/vtel/mrotlogr.cl new file mode 100644 index 000000000..1612d0304 --- /dev/null +++ b/noao/imred/vtel/mrotlogr.cl @@ -0,0 +1,68 @@ +#{ MROTLOGR -- Read all the headers on a FITS tape and print out some +# of the header information for each file. (for Carrington rotation maps) + +{ + struct header, headline, tfile, irafname + struct avbzero, keyword + struct tape, outfile + struct *fp + int sfnum, efnum, filenum + bool append + + if (!deftask ("rfits")) { + print ("Task rfits not loaded. Load dataio and then try again.") + bye + } + + # Get the tape name and the output file name. + tape = gettape + outfile = getout + + # Get the starting and ending file numbers for the log. + sfnum = getsfnum + efnum = getefnum + + # Get the append flag. + append = getapp + + if (!append) { + print ("File fname avbzero", >> outfile) + } + + filenum = sfnum + while (YES) { + + # Read the next fits header from the tape. + header = mktemp("temp") + fp = header + rfits (tape, filenum, make_image=no, long_header=yes, > header) + + # Initialize the output variables. + tfile = " " + irafname = " " + avbzero = " " + + # Now match keywords against this header to obtain needed output. + while (fscan (fp, headline) != EOF) { + keyword = substr(headline, 1, 8) + if (keyword == "File: mt") + tfile = substr(headline, 7, 15) + else if (keyword == "IRAFNAME") + irafname = substr(headline, 12, 20) + else if (keyword == "AV_BZERO") + avbzero = substr(headline, 19, 27) + else if (keyword == "L_ZERO ") + lzero = substr(headline, 19, 26) + else if (keyword == "End of d") { + print (headline, >> outfile) + delete (header, verify-) + bye + } + } + print (tfile, irafname, avbzero, >> outfile) + filenum = filenum + 1 + delete (header, verify-) + if (filenum > efnum) + bye + } +} diff --git a/noao/imred/vtel/mrotlogr.par b/noao/imred/vtel/mrotlogr.par new file mode 100644 index 000000000..a18b0f4b3 --- /dev/null +++ b/noao/imred/vtel/mrotlogr.par @@ -0,0 +1,5 @@ +gettape,s,a,,,,Tape to read fits headers from (i.e. "mta") +getout,s,a,,,,File to put output information in +getsfnum,i,a,,,,File number on tape from which to start logging +getefnum,i,a,,,,File number on tape at which logging is to end +getapp,b,a,,,,Append to existing file? diff --git a/noao/imred/vtel/mscan.par b/noao/imred/vtel/mscan.par new file mode 100644 index 000000000..8c9032209 --- /dev/null +++ b/noao/imred/vtel/mscan.par @@ -0,0 +1,8 @@ +input,s,a,,,,Input file descriptor +verbose,b,h,yes,,,Print out header data +files,s,a,,,,List of files to be examined +makeimage,b,h,yes,,,Make images? +brief,b,h,y,,,short output image names +select,b,h,y,,,make select image +bright,b,h,y,,,make brightness image +velocity,b,h,y,,,make velocity image diff --git a/noao/imred/vtel/mscan.x b/noao/imred/vtel/mscan.x new file mode 100644 index 000000000..9044b9433 --- /dev/null +++ b/noao/imred/vtel/mscan.x @@ -0,0 +1,188 @@ +include +include +include "vt.h" + +define MAX_RANGES 100 + +# MSCAN -- Read vacuum telescope area scans. + +procedure t_mscan() + +char input[SZ_FNAME] # input file template +char files[SZ_LINE] # file list to process +bool verbose # verbose flag +bool makeimage # flag to make an image +bool bright # flag to make a brightness image +bool velocity # flag to make a velocity image +bool select # flag to make a select image +bool brief # flag to make brief file names + +char tapename[SZ_FNAME] +char diskfile[SZ_LINE] +int filerange[2 * MAX_RANGES + 1] +int nfiles, filenumber, recsize, listin + +bool clgetb() +int decode_ranges(), get_next_number(), mscan() +int fntopnb(), clgfil(), mtneedfileno() +int mtfile() +errchk mscan + +begin + # CLIO for parameters. + verbose = clgetb ("verbose") + makeimage = clgetb ("makeimage") + bright = clgetb ("bright") + velocity = clgetb ("velocity") + select = clgetb ("select") + brief = clgetb ("brief") + + # If the user hasn't asked for ANY of the images, just return. + if (!bright && !velocity && !select) + return + + # Get input file(s). + call clgstr ("input", input, SZ_FNAME) + if (mtfile (input) == NO) { + + # This is not a tape file, expand as a list template. + listin = fntopnb (input, 0) + filenumber = 1 + + while (clgfil (listin, diskfile, SZ_FNAME) != EOF) { + iferr (recsize = mscan (diskfile, filenumber, brief, + verbose, makeimage, select, bright, velocity)) { + call eprintf ("Error reading file %s\n") + call pargstr (diskfile) + } + if (recsize == EOF) { + call printf ("Tape at EOT\n") + break + } + filenumber = filenumber + 1 + } + call clpcls (listin) + + } else if (mtneedfileno(input) == NO) { + + # This is a tape file and the user specified which file. + iferr (recsize = mscan (input, 0, brief, verbose, + makeimage, select, bright, velocity)) { + call eprintf ("Error reading file %s\n") + call pargstr (input) + } + } else { + + # This is a tape file or files and the user did not specify + # which file. + call clgstr ("files", files, SZ_LINE) + + if (decode_ranges (files, filerange, MAX_RANGES, nfiles) == ERR) + call error (0, "Illegal file number list.") + + if (verbose) + call printf ("\n") + + # Loop over files. + filenumber = 0 + while (get_next_number (filerange, filenumber) != EOF) { + + # Assemble the appropriate tape file name. + call mtfname (input, filenumber, tapename, SZ_FNAME) + + # Read this file. + iferr { + recsize = mscan (tapename, filenumber, brief, + verbose, makeimage, select, bright, velocity) + } then { + call eprintf ("Error reading file: %s\n") + call pargstr (tapename) + call erract (EA_WARN) + next + } + if (recsize == EOF) { + call printf ("Tape at EOT\n") + break + } + + } # End while. + } +end + + +# MSCAN -- Read in the next sector scan file from tape. First read the file +# header to determine what type scan it is and then call the appropriate +# subroutime for that type of scan. + +int procedure mscan (input, filenumber, brief, verbose, makeimage, select, + bright, velocity) + +char input[SZ_FNAME] # input file name +int filenumber # file number +bool brief # brief disk file names? +bool verbose # print header info? +bool makeimage # make images? +bool select # make select image? +bool bright # make bright image? +bool velocity # make velocity image? + +int in +int lastrecsize +int recsize +bool selfbuf +pointer sp, hbuf, hs + +int mtopen() +int readheader() +define nexit_ 10 +errchk mtopen, close, readheader + +begin + call smark (sp) + call salloc (hbuf, SZ_VTHDR, TY_SHORT) + call salloc (hs, VT_LENHSTRUCT, TY_STRUCT) + + in = mtopen (input, READ_ONLY, 0) + + call printf ("File %s: ") + call pargstr (input) + + lastrecsize = 0 + + # First, read the header file + selfbuf = FALSE + recsize = readheader (in, hbuf, selfbuf) + if (recsize == EOF) + return (recsize) + + # Decode the header and jump if '!makeimage'. + lastrecsize = recsize + call decodeheader (hbuf, hs, verbose) + if (verbose) { + call printf ("\n") + call flush (STDOUT) + } + if (!makeimage) + goto nexit_ + + # Call the appropriate area scan reader. + switch (VT_HOBSTYPE(hs)) { + case 1: + call readss1 (in, filenumber, brief, select, bright, velocity, hs) + case 2: + call readss2 (in, filenumber, brief, select, bright, velocity, hs) + case 3: + call readss3 (in, filenumber, brief, select, bright, velocity, hs) + case 4: + call readss4 (in, filenumber, brief, select, bright, velocity, hs) + case 0: + call printf ("Observation type zero encountered, image skipped.\n") + default: + call error (0, "unknown observation type, image skipped") + } # End of switch case. + +nexit_ + call sfree (sp) + call close (in) + return (recsize) +end diff --git a/noao/imred/vtel/nsolcrypt.dat b/noao/imred/vtel/nsolcrypt.dat new file mode 100644 index 000000000..65c3b067d --- /dev/null +++ b/noao/imred/vtel/nsolcrypt.dat @@ -0,0 +1,555 @@ + + + ' + + # + # +' + # + + + + + + + + + + + + + + + + + + 6L X}r '[T E_: + + ' + +}}# y}}A #v}: v}2 TA + + P}E + y}= :}}}k T}kEEEX}r +}y + + +EXv+ I}_ + _}T [}[y}6 .}}}}}}}P 6}k + + #Lr}}}k. .}v + T}T y}2T}g g}_2I}}' E}[ #EckcI# + + A}}_E+ v} +EE_}}. =}r .}}. A}n L}_ X}L +n}}}}}r2 + + #2. '}}# _} +}}}}}v6 _}P [}[ #y}2r}A g}E# #n}r= '[}v' + + 6c}}}n+ k}= 26 E} +yL.#[}c #y}. 2}y' T}n}v v}2 A}y. _}P + + E}}r[v}n P}kXv}y '} +} I}n :}r k}T .}}}T +}} _}T :}r L[' + + 'y}I +}}2 .}}}v_= r +}=6Ly}[ _}P :}v g}}+ 'IAI}k n}A 2}} 'y}. + + :}n :}}2 r}P T +}}}}}c+ =E' .XI :}}}}y[A' k}A :}v P}g .: + + Ak}k6 2}X #T}}g [}X :PE 6 +}v_E+ 6IXgy}}A X}[ c}_ #v}A n}[ + + # #In}}}}y+ + 6r}}c'.' =}v[v}}c + +:# .y}E X}}6 E}}# :}}. + + =v}y[2.v}E 2y}vA T}T #y}}nL2 + E}}k[r}}T n}}vL.k}_ + + ' A}}2 [}A L}v+ [}P =I2 + 2g}}}n: 6}y_}}}}y. += + + v}I :yr# I}n# Ey}2 + #2' c}T '_}c+ k}= + + +AE6 I}r:g}}}n+ +y}yv}}E + +}}: .}v E}v# + + # 2k}}}}n2 #y}}}gEr}[ 6c}rX2 + 2y}yT6X}r +v}I + + # +y}cEEn}y. P}}: E}n + 'Pv}}}}P #Ly}v# + + g}X #g}k +}}6 .r}_ # ' + #AckL =r}}}y + + .}v# +y}6 [}k[}}k+ + .c}}n6}v + + E}k c}E .}}}nA + 'y}yL }} + + E}n c}P [g6 + +L+ }} + + 2}}. v}A + }} + + g}g# I}v# + }} + + # 2y}k=6X}}A + Ac + + 6n}}}}r: + + + :II6 # + :2 '' + + + }k kc + + + }k rk + + + }n nk + + 'c2 + rr ky + + .A.}g + }} k} + + T}6k}' + }} k} + + :}_E}T + y} g} 2T# + + r}+vv# + n} [} +vy' + + I}IT}E + k} X} g}TE}A + + 'vr.}c + k} X}# P}r6y}: + + # X}:c}. + ky X}+ 2}}2n}[ + + 2}[=}[ + '}} X}= k}PP}r# + + c}.rv# + _}I Ey}_ A}}E L}k2}}= + + A}LE}I + +}}}X +g}yE Ly}X# +__+ 2}}:g}X + + '}v'}v + L}gy}n}}c+ .k}r2 'g}}g #n}PL}k# + + _}=_}_EEXEE +ELv}'6v}vE P}}[r}cv}: '_}n:}y2 + + E}X6y}}}}}} +}}}_ +E' 6v}}X#:}v#.:Tcv}}}6r}P + + [}L +222226 +:A=# +[T# g}}}}}}}rkA_}k# + + # +yv+ + :ELXgkkkknkkgXLE2 '[kXXI=' }y2 + + X}L + +I_v}}}}}}}}}}}}}}}}}kX=' vy+ + + '}v# 'E +g}}}}}kXLA2222226AT[ky}}}y[A P}T + + T}I .[y} +}}kP:# ':Tk}}}vL' +yy. + + :}v# 2c}}}k +I' 2Tv}}yP# X}c + + 'cv}}}}I 'X}}}_6 + #An}}vA '}}. + + A}}}}}_ =r}}[+ + =r}}k. [}X + + EkE 2}c' #_}}k2 + #Ey}}I 'y}PEE# + + A}}k. 2}[ 2r}yL + +c}}_# I}}}}[ + + =:2k}}T# #X}g =v}n2 + L}}g' =EP}_ + + + # #y}c'Iy}vE Av}v: E}}g# + 6+ :y}r. .}X Iry + + :r}yI'[}}k2 6n}yT' E}}X# + P}y. +k}v2 E}g# Ar}yL + + #Ly}r:6n}}T=c}}[' E}}T + +y}}c #k}y2 +y}v= An}vI.Pg. + + +[}}[+Ly}}}g2 6}}P + #k}}}}A #k}r+ 6k}}[' An}vI#Iy}y. + + =v}yI.PX= +v}X + T}}}}}v' 'r}n# Ev}yL#Ir}yT'Pv}yT' + + #P}}r. #k}c# .2+ #==+ + =}}}}}}}X cnkA :n}r +r}_ 'T}}}}}T'Iv}yT+ + + +g}c P}r+ A}}}: T}}y + 'y}}}}}}}}A }}}k T}}} 6y}E 6gyX'=n}yT' + + nn :}}6 I}}}E X}}} + _}}}}}}}}}v' }}}k X}}} E}y+ 6k}}X' + + ## [} #r}P E}}}E X}}} + A}}}}}}}}}}}[ }}}k X}}}+ c}k y}[. + + X}. P}k# E}}}E X}}y + +y}}}}}}}}}}}}: }}}k X}}} 'y}E }n + + E}2 'y}. E}}}E X}}v + c}}}}}}}}}}}}}v# }}}k X}}} L}v# #}[ + + E}A [}[ E}}}E [}}r + .}}}}}}}}}}}}}}}2 r}}k X}}} n}L +}X + + :}I 'yy. E}}}E X}}y + _kggkgccXg_ckc[# }}}k X}}} :}v' 2}T + + :}X T}X E}}}E [}}k + }}}k X}}} k}I 2}P + + :r}E#y}. E}}}A X}}k + y}}k X}}y A}v :}E + + #X}yE A}_ E}}}E [}}k + y}}_ X}}} #v}: E}E + ' + n}n. c}A E}}}E c}}k + y}}[ X}}} X}c E}X + + y}. +}y# E}}}E k}}k + }}}X X}}} .}y'6}}g= + + I}[ =}_ =}}}= [}}P + r}}X T}}} k}= =n}y# + + k}6 _}A AEA 2. + 2EE' #EA2 P}[ +}y + + T}= v}+ + 2}v _}A + + +yv#.}y + .# #}}.=}n + + X}E A}c '2:E +IXXP' _}}ykXXLE:2. r}EA}n + + :}k P}X +2AEIX[ky}}}} +}}}}X k}}}}}}}}}}}}nkkXXTEEE22+ [}X _}E + + #ny+ X}T :X_kk}}}}}}}}}}}}}}} +}}}}[ _}}}}}}}}}}}}}}}}}}}}}}}}A I}[ .yv# + + L}L k}A g}}}}}}}}}}}}}}}}}}} +}}}}c X}}}}}}}}}}}}}}}}}}}}}}}}X =}k T}I + + :E:22::=:AEP}n# k}6 n}}}}}}}}}}}}}}}}}}} +}}}}k [}}}}}}}}}}}}}}}}}}}}}}}}X 2}k #yv+ + + .}}}}}}}}}}}}}6 k}2 }}}}}}}}}}}}}}}}}}}} +}}}}g g}}}}}}}}}}}}}}}}}}}}}}}}X 2}} I}nXXXXXXXXTXXP# + + #PPITXXIILPIT6 }}# [}}}}}}}}}}}}}}}}}}} +}}}}k k}}}}}}}}}}}}}}}}}}}}}}}}E }n #n}}}}}}}}}}}}}2 + + +XXXc__ccgkkkc# [T .266AEIXTXXXgkkrv}} +}}}}X P}}rkkc[XXXIEEA:=22222'' =2 #+ 222222:E6 + + A}}}}}}}}}}}}}A # ++22=+ 'kkkknkrrkk}kX + + .22+#. 'vr + X}}}}y}}ny}}}g + + T}E + .}g# + + .}n +2222222222222222.2222222 +222222222222222222:6:EEEEEEEEEEEEEEEEEEEEEEEELLLTXX2 n}6 + + [}6 y}}}}}}}}}}}}}}}}}}}}}}}} +}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}r I}_ + + .}c A}}}}}}}}}}}}}}}}}}}}}}}}} +}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}' +yr+ + + rv E}}}}}}}}}}}}}}}}}}}}}}}}} +}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}2 _}I + + +}r 6}}}}}}}}}}}}}}}}}}}}}}}}} +}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}y 6}k + + # P}I v}}}}}}}}}}}}}}}}}}}}}}}} +}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}I T}A + + v}+ +2222222222222222+22222.. +222.'.++2A}}}}}}r+'+'##.2+'#. 2'.'+#''' ++'2222222' A}r# + + .}}P2 + }}}}}}k _}T + + #g}}}: + }}}}}}k +g}g + + 'T}T +# }}}}}}k .22222222222222222222226AA+ #Py}r2 + + 2}E 6nnv}yr}nn}v}}}}}}}}}}} +}}}k }}}}}}k 6}}}}}}}}}}}}}}}}}}}}}}}}}}y+P}yP# + + 6}E k}}}}}}}}}}}}}}}}}}}}}} +}}}}' #}}}}}}k E}}}}}}}}}}}}}}}}}}}}}}}}}}y#T}I + + E}E L}}}}}}}}}}}}}}}}}}}}}} +}}}}. '}}}}}}k P}}}}}}}}}}}}}}}}}}}}}}}}}}I E}A + + # E}E #v}}}}}}}}}}}}}}}}}}}}} +}}}}2 }}}}}}k E}}}}}}}}}}}}}}}}}}}}}}}}}v# E}A + + E}6 I}}}}}}}}}}}}}}}}}}}}} +}}}}. }}}}}}g E}}}}}}}}}}}}}}}}}}}}}}}}}L =}E + + T}6 #n}}}}}}}}}}}}}}}}}}}} +}}}}2 .}}}}}}g E}}}}}}}}}}}}}}}}}}}}}}}}v# 2}L + + 2r}2 A}}}}}}}}}}}}}}}}}}}} +}}}}2 .}}}}}}g E}}}}}}}}}}}}}}}}}}}}}}}}= 2}X + + =g}}n# g}}}}}}}}}}}}}}}}}}} +}}}}2 '}}}}}}c E}}}}}}}}}}}}}}}}}}}}}}}g #}[ + ' + #In}}gA#. +y}}}}}}}}}}}}}}}}}} +}}}}' #}}}}}}X E}}}}}}}}}}}}}}}}}}}}}}y+ }y= + + 'Pv}}_:.X}}c2 A}}}}}}}}}}}}}}}}}} +}}}}+ #}}}}}}X E}}}}}}}}}}}}}}}}}}}}}}I P}}_. + + 2[}}yX.=g}}}}}}X+ [}}}}}}}}}}}}}}}}} +}}}}+ '}}}}}}X L}}}}}}}}}}}}}}}}}}}}}g +Tc62g}yT# + + P}}vI+Lr}}vP''T}}yT+ #n}}}}}}}}}}}}}}}} +}}}}. 2}}}}}}g I}}}}}}}}}}}}}}}}}}}}n# Ev}}}c'6v}vP + + # =kL6Xy}}c=# 'Pv}yL #r}}}}}}}}}}}}}}} +}}}}. .}}}}}}X E}}}}}}}}}}}}}}}}}}}r+ +_}}XPy}yE'[}}g2 + + +g}}vT' #Tyy# +r}}}}}}}}}}}}}} +}}}}2 .}}}}}}[ E}}}}}}}}}}}}}}}}}}y2 Ey}k.# +c}}nI2k}yX# + + T}rI# _}2 .r}}}}}}}}}}}}} +}}}}+ 2}}}}}}X E}}}}}}}}}}}}}}}}}v. _}yL :k}}_#Ay}n + + #2 X}2 .r}}}}}}}}}}}} +}}}}' 2}}}}}}X E}}}}}}}}}}}}}}}}r. .}r+ Ly}vE'PT + + X}IAA# 'g}}}}}}}}}}} +}}}} 2}}}}}}X E}}}}}}}}}}}}}}}g+ 2}X '_}}k' + + X}}}}g# T}}}}}}}}}} +}}}} 2}}}}}}X E}}}}}}}}}}}}}}X +}X 2g}2 + + E}kLn}[ :v}}}}}}}} +}}}} 2}}}}}}X E}}}}}}}}}}}}yI +_kkk}c . + + #n}= 'X}}}}}}} +}}}} 2}}}}}}X L}}}}}}}}}}}c. #v}}}}}X + + 2yy' 2g}}}}} +}}}}# 2}}}}}}X X}}}}}}}}}n= # P}P # + + I}_ 6g}}} +}}}} 2}}}}}}X X}}}}}}}rA 'yr# + + g}E 6_y +}}}} 2}}}}}}X X}}}}}nI [}: + + .}y. ' +Pr}k 2}}}}}}T E}}y_= 6}k + + X}E + .' .v}}}}g+ A:# n}6 + + # # #k}:2EEEEEEPXI +# =EA. =cXXXXXLXT+=}g + + # [}[2}}}}}}}}}} +[ EXI .}}}}}}}}}}[6}n + + A}r'k}kEEEEA=Av +}+X}}}rI 2gvc.g}I222222=}y'v}: + + +yy.X}r' I +}}}n:Ty}k. ._}}v}}}k c}IP}X + + #n}I=}}: # +y}g# .[}}c' #Py}v= I}}A =}g2}v# + + IT T}_+v}I +.A# +g}_ :v}}X' :T# r}+k}: + + #X}}6 E}r#g}_ + +}k k}v= P}PA}_ + + #g}}E ' .y}2P}r' + # }k k}6 .}n'}y' + + +r}y: n}P:}}6 + .}k k}2 k}6g}E + + 6y}r. y_#r}P + +}k g}2 E}X=}c #_# + + Ey}n+ +226EE# X}c + }k k}. '}y#r}. _}X + + A}}}}}}}}}}}}[ vy. + }k c}+ _}AP}P A}}P + + .y}}}ykkk[y}}P +' + }k _}+ A}g+}k L}}+ + + +2' #g}yE E+ + }k k} # #v} IE 6T c}6# + + +n}y6 'yr # + }n c}. 6: v}X .y}}}L + + 6r}n+ =}n + }y c}# :}}T6y}gc}}6 + + Ey}g# [}T # + }} k}2 := E}}}}T r}E + + g}X# #y}v6 + }} c}. 6}c E}}_ +v}: + + += =}yyyA .P+ + ng 6T '}v L}}E+r}c + + '+ [}P6r}g}}n + }}. X}}y}X# + + y}.#_}}}[. + +# +k}}E X}}X + + =}vIv}}c. :L + Ayn:Py}n}X TL + + [}}}}g6 .y}= + 6r}}}r:2}n + + k}}n= #r}g + .T# #X}}r2 }}' + + 2gA _}r' + '[}}= =r}}Ig}6 + + L}y2 .kA # + 'Ty}nA '_}}}}L + + #P' 6}}E g}n + +y}vA =v}}X + + E}r=y}_ A}}6 + n}T '[n2 + + T}}}k# #r}[ + 2A6' 6}y' + + Ay}_# P}y' Ig}}gI + =r}}}yP# k}T + + #6y}c# #y}T _}}}}}}c + A}}kEk}}_ :}}+ + + #_y+ T}n# P}yE .k}T +. + .}}6 =}}E g}[ + # + +2# .v}E 'v}L# 6}v# [k. + :PXT6 L}c X}n 2}y. + + [}_ =}y# k}: #}}' 6vk+ + 6n}}}}}I k}E 2}}' [}_ + + =X' E}k k}E 6}n 6y}}26X +A .2 =PXPEPP #v}k=2L}y' k}L }}2 'yy# + + E}k #v}= I}[ :}}}y A} +r #y}. }}}}}}} :}y# y}6 T}k 2}y# :' + + +}}. L}y# X}L E}}g}k v +}A2' T}g }}A222. A}X '[}}2 6}}I _}c + + X}n. I}}P k}:L}}EL}T T +}}}}}}}6 }}+ .[}}}T _}}T26_}y. + + #g}}nv}}c# }}g}}E X}= : +}}TXr}n }}. E}}}n= ' #_}}}}}r6 + + Agy}kI 2}}}y= n}. +v}2 n}A }}' 'y}c2 .yy 6TXX= + + A}}y6 }} +X}P6}v k}' 2}}# A}n + + # E}y6 2}g +:}rg}I r}2 'y}TAPy}I + + #' E}X + v}}y' n}. A}}}}}P + + ' 'A. # + P}}T k}. .LTE+ + + ' + .kr' [k# + + + # + + + + + + # + + + # + # + # + + + + + + + + + + $ + diff --git a/noao/imred/vtel/numeric.h b/noao/imred/vtel/numeric.h new file mode 100644 index 000000000..765fac039 --- /dev/null +++ b/noao/imred/vtel/numeric.h @@ -0,0 +1,12 @@ +# Structure for argument list to subroutine 'numeric'. + +define VT_LENNUMSTRUCT 8 # Length of VT num structure + +define VT_DLODX Memr[P2R($1)] # deriv longitude wrt x +define VT_DLATDY Memr[P2R($1+1)] # deriv latitude wrt y +define VT_LATTOP Memr[P2R($1+2)] # latitude of top of output pixel +define VT_LATBOT Memr[P2R($1+3)] # latitude of bottom of output pixel +define VT_LOLEFT Memr[P2R($1+4)] # longitude of left side of out pixel +define VT_LORITE Memr[P2R($1+5)] # longitude of right side of out pixel +define VT_LATMID Memr[P2R($1+6)] # latitude of middle of output pixel +define VT_LOMID Memr[P2R($1+7)] # longitude of middle of output pixel diff --git a/noao/imred/vtel/numeric.x b/noao/imred/vtel/numeric.x new file mode 100644 index 000000000..640778c81 --- /dev/null +++ b/noao/imred/vtel/numeric.x @@ -0,0 +1,177 @@ +include +include "vt.h" +include "numeric.h" + +# NUMERIC -- calculate some of the necessary information, including +# the partial derivitives of latitude and longitude with respect +# to x and y, that we need to do the projection. + +procedure numeric (bzero, el, outputrow, pixel, xpixcenter, ypixcenter, num) + +real bzero # latitude of subearth point +real el[LEN_ELSTRUCT] # ellipse parameters data structure +int outputrow # which output row are we working on +int pixel # which pixel in that output row +real xpixcenter, ypixcenter # coordinates of center of pixel +pointer num # numeric structure pointer + +real dlatdy, dlongdx # partial derivitives +real lat_top, lat_bot # latitude of top and bottom of pix +real long_left, long_rite # longitude of left and right of pix +real lat_mid, long_mid # latitude and longitude of middle +real lat1, long1, lat3, long3, lat4, long4, lat5, long5 +real x1, y1, x3, y3, x4, y4, x5, y5 +bool skip + +begin + skip = false + + # First calculate lats, longs for this pixel. + lat_top = 180./3.1415926*asin(real(outputrow - 90)/90.) + lat_bot = 180./3.1415926*asin(real(outputrow - 91)/90.) + long_left = real(pixel - 1) - 90. + long_rite = real(pixel) - 90. + lat_mid = .5 * (lat_top + lat_bot) + long_mid = .5 * (long_left + long_rite) + + # Check the proximity of this pixel to the image boundary, if its + # too close, set that output pixel to zero. + + if (abs(abs(lat_mid) - 90.0) < abs(bzero)) { + if (abs(abs(lat_top) - 90.0) >= abs(bzero)) { + lat_bot = -90.0 + bzero + lat_mid = .5 * (lat_top + lat_bot) + } else { + if (abs(abs(lat_bot) - 90.0) >= abs(bzero)) { + lat_top = 90.0 + bzero + lat_mid = .5 * (lat_top + lat_bot) + } else { + # Nothing to map! + # Flag to pixelmap marking zero pixel. + VT_LATTOP(num) = 10000. + return + } + } + } else { + if (abs(abs(lat_top) - 90.0) < abs(bzero)) + lat_top = 90.0 + bzero + else + if (abs(abs(lat_bot) - 90.0) < abs(bzero)) + lat_bot = -90.0 + bzero + } + + # Now that we have the pixel we want defined, calculate the partial + # derivitives we need numerically. First calculate the latitude and + # longitude of the centers of the 4 adjacent pixels. + + lat1 = lat_mid + if (pixel == 1) + long1 = long_mid + else + long1 = long_mid - 1.0 + + lat3 = lat_mid + if (pixel == 180) + long3 = long_mid + else + long3 = long_mid + 1.0 + + long5 = long_mid + if (outputrow == 1) + lat5 = lat_mid + else + lat5 = 180./3.1415926*((asin(real(outputrow - 92)/90.) + + asin(real(outputrow - 91)/90.))/2.) + + long4 = long_mid + if (outputrow == 180) + lat4 = lat_mid + else + lat4 = 180./3.1415926*((asin(real(outputrow - 89)/90.) + + asin(real(outputrow - 90)/90.))/2.) + + # Given these latitudes and longitudes, find out where in xy coords + # they are. Get xpixcenter and ypixcenter then the x#s and y#s. + + call getxy (lat_mid, long_mid, bzero, el, xpixcenter, ypixcenter, skip) + if (skip) { + + # Off the limb or behind the sun. + # Flag to pixelmap marking zero pixel. + VT_LATTOP(num) = 10000. + return + } + + call getxy (lat1, long1, bzero, el, x1, y1, skip) + call getxy (lat3, long3, bzero, el, x3, y3, skip) + call getxy (lat4, long4, bzero, el, x4, y4, skip) + call getxy (lat5, long5, bzero, el, x5, y5, skip) + + # Calculate the partials. + if (x3 == x1) + dlongdx = 9999. + else + dlongdx = (long3 - long1) / (x3 - x1) + + if (y4 == y5) + dlatdy = 9999. + else + dlatdy = (lat4 - lat5) / (y4 - y5) + + VT_DLODX(num) = dlongdx + VT_DLATDY(num) = dlatdy + VT_LATTOP(num) = lat_top + VT_LATBOT(num) = lat_bot + VT_LOLEFT(num) = long_left + VT_LORITE(num) = long_rite + VT_LATMID(num) = lat_mid + VT_LOMID(num) = long_mid +end + + +# GETXY -- Given the latitude and longitude of a point and the image +# parameters, return the x and y position of that point. + +procedure getxy (lat, lml0, b0, el, x, y, skip) + +real lat # latitude of point on image +real lml0 # distance in longitude from disk center +real b0 # latitude of sub earth point +real el[LEN_ELSTRUCT] # ellipse parameters data structure +real x, y # returned position +bool skip # skip flag + +real sinlat, coslat, sinbzero, cosbzero, sinlminusl0, coslminusl0 +real cosrho, sinrho, sinpminustheta, cospminustheta +real latitude, lminusl0, bzero + +begin + skip = false + lminusl0 = lml0*3.1415926/180. + bzero = b0*3.1415926/180. + latitude = lat*3.1415926/180. + sinlat = sin(latitude) + coslat = cos(latitude) + sinbzero = sin(bzero) + cosbzero = cos(bzero) + sinlminusl0 = sin(lminusl0) + coslminusl0 = cos(lminusl0) + cosrho = sinbzero * sinlat + cosbzero * coslat * coslminusl0 + + # If we are behind limb return skip = true. + if (cosrho <= 0.00) skip = true + sinrho = (1. - cosrho**2)**.5 + if (sinrho >= EPSILONR) { + sinpminustheta = (coslat/sinrho) * sinlminusl0 + cospminustheta = (coslat/sinrho) * (cosbzero * tan(latitude) - + sinbzero * coslminusl0) + } else { + sinpminustheta = 0.000001 + cospminustheta = 0.000001 + } + + x = E_XSEMIDIAMETER(el) * sinrho * sinpminustheta + y = E_YSEMIDIAMETER(el) * sinrho * cospminustheta + x = x + real(E_XCENTER(el)) + y = y + real(E_YCENTER(el)) +end diff --git a/noao/imred/vtel/pimtext.par b/noao/imred/vtel/pimtext.par new file mode 100644 index 000000000..fa0494d9d --- /dev/null +++ b/noao/imred/vtel/pimtext.par @@ -0,0 +1,13 @@ +iraf_files,s,q,,,,Images to be written +refim,s,q,,,,Reference image to get date and time from +ref,b,h,no,,,Find the date and time in a reference image +x,i,h,10,,,X position of text in image +y,i,h,10,,,Y position of text in image +xmag,i,h,2,,,Text magnification factor in x direction +ymag,i,h,2,,,Text magnification factor in y direction +val,i,h,-10000,,,Value to use to write text in images +setbgnd,b,h,yes,,,Set the pixels in the image behind the text +bgndval,i,h,10000,,,Value to use in background of text +date,b,h,yes,,,Write the date into the images +time,b,h,yes,,,Write the time into the images +text,s,q,,,,Text string to write into image diff --git a/noao/imred/vtel/pimtext.x b/noao/imred/vtel/pimtext.x new file mode 100644 index 000000000..b39c12bee --- /dev/null +++ b/noao/imred/vtel/pimtext.x @@ -0,0 +1,131 @@ +include "vt.h" + +# PIMTEXT -- Put a text string directly into an image using a pixel font +# and writing over the image pixels. + +procedure t_pimtext() + +char im[SZ_FNAME] # image to put text in +char refim[SZ_FNAME] # reference image (get date/time) +int x, y # position to put text +int xmag, ymag # text magnification parameters +int val # value to use for text pixels +int bgndval # value to use for background pixels +bool setbgnd # flag, should we set the background? +bool ref # flag, are we using a ref image + +int obstime, obsdate, hour, minute, second +int list, nfiles +int month, day, year +char dt[DTSTRING] +bool istime, isdate, date, time +pointer imp, rimp + +bool clgetb(), imaccf() +int clgeti(), imgeti() +int clpopni(), clplen(), clgfil() +pointer immap() +errchk immap + +begin + # Get file name template from the CL. + list = clpopni ("iraf_files") + nfiles = clplen (list) + + # Get some other parameters. + ref = clgetb ("ref") + if (ref) + call clgstr ("refim", refim, SZ_FNAME) + x = clgeti ("x") + y = clgeti ("y") + xmag = clgeti ("xmag") + ymag = clgeti ("ymag") + val = clgeti ("val") + setbgnd = clgetb ("setbgnd") + bgndval = clgeti ("bgndval") + date = clgetb ("date") + time = clgetb ("time") + + while (clgfil (list, im, SZ_FNAME) != EOF) { + # Open the image(s). + imp = immap (im, READ_WRITE, 0) + if (ref) + rimp = immap (refim, READ_ONLY, 0) + + if (date || time) { + # Find out if the date and time exist in the image header. + if (ref) { + istime = imaccf (rimp, "obs_time") + isdate = imaccf (rimp, "obs_date") + } else { + istime = imaccf (imp, "obs_time") + isdate = imaccf (imp, "obs_date") + } + + # Get the date and/or time. + if (date && isdate && !time) { + if (ref) + obsdate = imgeti (rimp, "obs_date") + else + obsdate = imgeti (imp, "obs_date") + + month = obsdate / 10000 + day = obsdate/100 - 100 * (obsdate/10000) + year = obsdate - 100 * (obsdate/100) + call sprintf (dt, DTSTRING, "%02d/%02d/%02d") + call pargi (month) + call pargi (day) + call pargi (year) + + } else if (time && istime && !date) { + if (ref) + obstime = imgeti (rimp, "obs_time") + else + obstime = imgeti (imp, "obs_time") + + hour = int(obstime/3600) + minute = int((obstime - hour * 3600)/60) + second = obstime - hour * 3600 - minute * 60 + call sprintf (dt, DTSTRING, "%02d:%02d:%02d") + call pargi (hour) + call pargi (minute) + call pargi (second) + + } else if (istime && isdate && time && date) { + if (ref) { + obstime = imgeti (rimp, "obs_time") + obsdate = imgeti (rimp, "obs_date") + } else { + obstime = imgeti (imp, "obs_time") + obsdate = imgeti (imp, "obs_date") + } + + month = obsdate/10000 + day = obsdate/100 - 100 * (obsdate/10000) + year = obsdate - 100 * (obsdate/100) + hour = int(obstime/3600) + minute = int((obstime - hour * 3600)/60) + second = obstime - hour * 3600 - minute * 60 + call sprintf (dt, DTSTRING, "%02d:%02d:%02d %02d/%02d/%02d") + call pargi (hour) + call pargi (minute) + call pargi (second) + call pargi (month) + call pargi (day) + call pargi (year) + } else { + call printf ("Warning: cannot get date and/or time.\n") + call printf ("Getting text string fron the CL.\n") + call clgstr ("text", dt, DTSTRING) + } + } else + call clgstr ("text", dt, DTSTRING) + + call textim (imp, dt, x, y, xmag, ymag, val, setbgnd, bgndval) + call imunmap (imp) + if (ref) + call imunmap (rimp) + } # end while + + call clpcls (list) +end diff --git a/noao/imred/vtel/pixbit.x b/noao/imred/vtel/pixbit.x new file mode 100644 index 000000000..a6db321a2 --- /dev/null +++ b/noao/imred/vtel/pixbit.x @@ -0,0 +1,23 @@ +# PIXBIT -- Look up which bits should be set for this character on this line. + +procedure pixbit (code, line, bitarray) + +int code # character we are writing +int line # line of the character we are writing +int bitarray[5] # bit-array to receive data + +int pix, i +short asciilook[128] +short font[455] +int bitupk() +include "pixelfont.inc" +include "asciilook.inc" + +begin + pix = font[asciilook[code+1]+line-1] + bitarray[5] = bitupk (pix, 1, 1) + bitarray[4] = bitupk (pix, 4, 1) + bitarray[3] = bitupk (pix, 7, 1) + bitarray[2] = bitupk (pix, 10, 1) + bitarray[1] = bitupk (pix, 13, 1) +end diff --git a/noao/imred/vtel/pixelfont.inc b/noao/imred/vtel/pixelfont.inc new file mode 100644 index 000000000..92216e6de --- /dev/null +++ b/noao/imred/vtel/pixelfont.inc @@ -0,0 +1,519 @@ +data (font[i], i=1,7) / 00000B, + 00000B, + 00000B, + 00000B, + 00000B, + 00000B, + 00000B / # (space) + +data (font[i], i=8,14) / 00100B, + 00100B, + 00100B, + 00100B, + 00100B, + 00000B, + 00100B / # ! + +data (font[i], i=15,21) / 01010B, + 01010B, + 01010B, + 00000B, + 00000B, + 00000B, + 00000B / # " + +data (font[i], i=22,28) / 01010B, + 01010B, + 11111B, + 01010B, + 11111B, + 01010B, + 01010B / # # + +data (font[i], i=29,35) / 00100B, + 01111B, + 10100B, + 01110B, + 00101B, + 11110B, + 00100B / # $ + +data (font[i], i=36,42) / 11000B, + 11001B, + 00010B, + 00100B, + 01000B, + 10011B, + 00011B / # % + +data (font[i], i=43,49) / 01000B, + 10100B, + 10100B, + 01000B, + 10101B, + 10010B, + 01101B / # & + +data (font[i], i=50,56) / 00100B, + 00100B, + 00100B, + 00000B, + 00000B, + 00000B, + 00000B / # ' + +data (font[i], i=57,63) / 00100B, + 01000B, + 10000B, + 10000B, + 10000B, + 01000B, + 00100B / # ( + +data (font[i], i=64,70) / 00100B, + 00010B, + 00001B, + 00001B, + 00001B, + 00010B, + 00100B / # ) + +data (font[i], i=71,77) / 00100B, + 10101B, + 01110B, + 00100B, + 01110B, + 10101B, + 00100B / # * + +data (font[i], i=78,84) / 00000B, + 00100B, + 00100B, + 11111B, + 00100B, + 00100B, + 00000B / # + + +data (font[i], i=85,91) / 00000B, + 00000B, + 00000B, + 00000B, + 00100B, + 00100B, + 01000B / # , + +data (font[i], i=92,98) / 00000B, + 00000B, + 00000B, + 11111B, + 00000B, + 00000B, + 00000B / # - + +data (font[i], i=99,105) / 00000B, + 00000B, + 00000B, + 00000B, + 00000B, + 00000B, + 00100B / # . + +data (font[i], i=106,112) / 00000B, + 00001B, + 00010B, + 00100B, + 01000B, + 10000B, + 00000B / # / + +data (font[i], i=113,119) / 01110B, + 10001B, + 10011B, + 10101B, + 11001B, + 10001B, + 01110B / # 0 + +data (font[i], i=120,126) / 00100B, + 01100B, + 00100B, + 00100B, + 00100B, + 00100B, + 01110B / # 1 + +data (font[i], i=127,133) / 01110B, + 10001B, + 00001B, + 00110B, + 01000B, + 10000B, + 11111B / # 2 + +data (font[i], i=134,140) / 11111B, + 00001B, + 00010B, + 00110B, + 00001B, + 10001B, + 11111B / # 3 + +data (font[i], i=141,147) / 00010B, + 00110B, + 01010B, + 11111B, + 00010B, + 00010B, + 00010B / # 4 + +data (font[i], i=148,154) / 11111B, + 10000B, + 11110B, + 00001B, + 00001B, + 10001B, + 01110B / # 5 + +data (font[i], i=155,161) / 00111B, + 01000B, + 10000B, + 11110B, + 10001B, + 10001B, + 01110B / # 6 + +data (font[i], i=162,168) / 11111B, + 00001B, + 00010B, + 00100B, + 01000B, + 01000B, + 01000B / # 7 + +data (font[i], i=169,175) / 01110B, + 10001B, + 10001B, + 01110B, + 10001B, + 10001B, + 01110B / # 8 + +data (font[i], i=176,182) / 01110B, + 10001B, + 10001B, + 01111B, + 00001B, + 00010B, + 11100B / # 9 + +data (font[i], i=183,189) / 00000B, + 00000B, + 00100B, + 00000B, + 00100B, + 00000B, + 00000B / # : + +data (font[i], i=190,196) / 00000B, + 00000B, + 00100B, + 00000B, + 00100B, + 00100B, + 01000B / # ; + +data (font[i], i=197,203) / 00010B, + 00100B, + 01000B, + 10000B, + 01000B, + 00100B, + 00010B / # < + +data (font[i], i=204,210) / 00000B, + 00000B, + 11111B, + 00000B, + 11111B, + 00000B, + 00000B / # = + +data (font[i], i=211,217) / 01000B, + 00100B, + 00010B, + 00001B, + 00010B, + 00100B, + 01000B / # > + +data (font[i], i=218,224) / 01110B, + 10001B, + 00010B, + 00100B, + 00100B, + 00000B, + 00100B / # ? + +data (font[i], i=225,231) / 01110B, + 10001B, + 10101B, + 10111B, + 10110B, + 10000B, + 01111B / # @ + +data (font[i], i=232,238) / 00100B, + 01010B, + 10001B, + 10001B, + 11111B, + 10001B, + 10001B / # A + +data (font[i], i=239,245) / 11110B, + 10001B, + 10001B, + 11110B, + 10001B, + 10001B, + 11110B / # B + +data (font[i], i=246,252) / 01110B, + 10001B, + 10000B, + 10000B, + 10000B, + 10001B, + 01110B / # C + +data (font[i], i=253,259) / 11110B, + 10001B, + 10001B, + 10001B, + 10001B, + 10001B, + 11110B / # D + +data (font[i], i=260,266) / 11111B, + 10000B, + 10000B, + 11110B, + 10000B, + 10000B, + 11111B / # E + +data (font[i], i=267,273) / 11111B, + 10000B, + 10000B, + 11110B, + 10000B, + 10000B, + 10000B / # F + +data (font[i], i=274,280) / 01111B, + 10000B, + 10000B, + 10000B, + 10011B, + 10001B, + 01111B / # G + +data (font[i], i=281,287) / 10001B, + 10001B, + 10001B, + 11111B, + 10001B, + 10001B, + 10001B / # H + +data (font[i], i=288,294) / 01110B, + 00100B, + 00100B, + 00100B, + 00100B, + 00100B, + 01110B / # I + +data (font[i], i=295,301) / 00001B, + 00001B, + 00001B, + 00001B, + 00001B, + 10001B, + 01110B / # J + +data (font[i], i=302,308) / 10001B, + 10010B, + 10100B, + 11000B, + 10100B, + 10010B, + 10001B / # K + +data (font[i], i=309,315) / 10000B, + 10000B, + 10000B, + 10000B, + 10000B, + 10000B, + 11111B / # L + +data (font[i], i=316,322) / 10001B, + 11011B, + 10101B, + 10101B, + 10001B, + 10001B, + 10001B / # M + +data (font[i], i=323,329) / 10001B, + 10001B, + 11001B, + 10101B, + 10011B, + 10001B, + 10001B / # N + +data (font[i], i=330,336) / 01110B, + 10001B, + 10001B, + 10001B, + 10001B, + 10001B, + 01110B / # O + +data (font[i], i=337,343) / 11110B, + 10001B, + 10001B, + 11110B, + 10000B, + 10000B, + 10000B / # P + +data (font[i], i=344,350) / 01110B, + 10001B, + 10001B, + 10001B, + 10101B, + 10010B, + 01101B / # Q + +data (font[i], i=351,357) / 11110B, + 10001B, + 10001B, + 11110B, + 10100B, + 10010B, + 10001B / # R + +data (font[i], i=358,364) / 01110B, + 10001B, + 10000B, + 01110B, + 00001B, + 10001B, + 01110B / # S + +data (font[i], i=365,371) / 11111B, + 00100B, + 00100B, + 00100B, + 00100B, + 00100B, + 00100B / # T + +data (font[i], i=372,378) / 10001B, + 10001B, + 10001B, + 10001B, + 10001B, + 10001B, + 01110B / # U + +data (font[i], i=379,385) / 10001B, + 10001B, + 10001B, + 10001B, + 10001B, + 01010B, + 00100B / # V + +data (font[i], i=386,392) / 10001B, + 10001B, + 10001B, + 10101B, + 10101B, + 11011B, + 10001B / # W + +data (font[i], i=393,399) / 10001B, + 10001B, + 01010B, + 00100B, + 01010B, + 10001B, + 10001B / # X + +data (font[i], i=400,406) / 10001B, + 10001B, + 01010B, + 00100B, + 00100B, + 00100B, + 00100B / # Y + +data (font[i], i=407,413) / 11111B, + 00001B, + 00010B, + 00100B, + 01000B, + 10000B, + 11111B / # Z + +data (font[i], i=414,420) / 11111B, + 11000B, + 11000B, + 11000B, + 11000B, + 11000B, + 11111B / # [ + +data (font[i], i=421,427) / 00000B, + 10000B, + 01000B, + 00100B, + 00010B, + 00001B, + 00000B / # \ + +data (font[i], i=428,434) / 11111B, + 00011B, + 00011B, + 00011B, + 00011B, + 00011B, + 11111B / # ] + +data (font[i], i=435,441) / 00000B, + 00000B, + 00100B, + 01010B, + 10001B, + 00000B, + 00000B / # ^ + +data (font[i], i=442,448) / 00000B, + 00000B, + 00000B, + 00000B, + 00000B, + 00000B, + 11111B / # _ + +data (font[i], i=449,455) / 11111B, + 10001B, + 11011B, + 10101B, + 11011B, + 10001B, + 11111B / # (unknown) diff --git a/noao/imred/vtel/putsqib.par b/noao/imred/vtel/putsqib.par new file mode 100644 index 000000000..635f540f2 --- /dev/null +++ b/noao/imred/vtel/putsqib.par @@ -0,0 +1,3 @@ +image,s,q,,,,Data image to merge with squibby brightness image +sqibimage,s,q,,,,Squibby brightness image +merged,s,q,,,,New image to contain the merged image diff --git a/noao/imred/vtel/putsqib.x b/noao/imred/vtel/putsqib.x new file mode 100644 index 000000000..9299c4d40 --- /dev/null +++ b/noao/imred/vtel/putsqib.x @@ -0,0 +1,69 @@ +include +include +include "vt.h" + +# PUTSQIB -- Murge a solar synoptic 'data only' image with a +# squibby brightness image. Output image is separate image. + +procedure t_putsqib() + +char image[SZ_FNAME] # input image +char sqibimage[SZ_FNAME] # squibby brightness image +char merged[SZ_FNAME] # output merged image + +int i, numpix +pointer im, ldatagp, lsqibgp, lpp, sqibim, mim +pointer immap(), imgl2s(), impl2s() +errchk immap, imgl2s, impl2s + +begin + # Get parameters from the CL. + call clgstr ("image", image, SZ_FNAME) + call clgstr ("sqibimage", sqibimage, SZ_FNAME) + call clgstr ("merged", merged, SZ_FNAME) + + # Open the two input images, see that they are the same size. + im = immap (image, READ_ONLY, 0) + sqibim = immap (sqibimage, READ_ONLY, 0) + + # If not, error. + if (IM_LEN(im,2) != IM_LEN(sqibim,2)) + call error(0,"sizes of data image and sqib image must match") + + if (IM_LEN(im,1) != IM_LEN(sqibim,1)) + call error(0,"sizes of data image and sqib image must match") + + # Open the new image. + mim = immap (merged, NEW_COPY, im) + + do i = 1, IM_LEN(im,2) { + ldatagp = imgl2s (im, i) + lsqibgp = imgl2s (sqibim, i) + lpp = impl2s (mim, i) + numpix = IM_LEN(im,1) + call sqibput (Mems[ldatagp], Mems[lsqibgp], Mems[lpp], numpix) + } + + # Unmap images. + call imunmap (im) + call imunmap (sqibim) + call imunmap (mim) +end + + +# SQIBPUT -- pack squibby brightness from line2 into line1 and put the +# result into line3. + +procedure sqibput (line1, line2, line3, numpix) + +short line1[numpix] # data line +short line2[numpix] # sqib line +short line3[numpix] # out line +int numpix # number of pixels + +int i + +begin + do i = 1, numpix + line3[i] = line1[i]*16 + line2[i] +end diff --git a/noao/imred/vtel/quickfit.par b/noao/imred/vtel/quickfit.par new file mode 100644 index 000000000..6ce8e742f --- /dev/null +++ b/noao/imred/vtel/quickfit.par @@ -0,0 +1,8 @@ +image,s,q,,,,Image file descriptor +threshold,i,h,4,,,Squibby brightness threshold +verbose,b,h,no,,,Print out in verbose mode? +xguess,i,h,1024,,,X coordinate of center of guess circle +yguess,i,h,1024,,,Y coordinate of center of guess circle +halfwidth,i,h,50,,,Halfwidth of limbfinding window +rowspace,i,h,20,,,# of rows to skip near center in limbfind +rejectcoeff,r,h,.02,,,Least squares rejection coefficient diff --git a/noao/imred/vtel/quickfit.x b/noao/imred/vtel/quickfit.x new file mode 100644 index 000000000..40efb257f --- /dev/null +++ b/noao/imred/vtel/quickfit.x @@ -0,0 +1,499 @@ +include +include +include "vt.h" + +define SZ_VTPBUF 4096 # Size of limb point buffer. + +# QUICKFIT -- Given a fulldisk solar image, find the parameters of an ellipse +# that best fits the limb. First the points on the limb are determined using +# the squibby brightness, then an initial guess for the limb parameters is +# made, and finally a least squares fit is made by an iterative method. + +procedure t_quickfit() + +char image[SZ_FNAME] # image to find the limb on +int threshold # squibby limb threshold +bool verbose # verbose flag + +pointer pb # buffer for saving limb points +int npoints, rejects # number of limb pts, rejects +real x, y, a, b # x, y, a, b (a = z0) +real rguess, rpercent # initial guess at r, % rejects +errchk limbfind, efit +pointer im, sp + +pointer immap() +int clgeti() +bool clgetb() +errchk immap, limbfind + +begin + call smark (sp) + call salloc (pb, 2*SZ_VTPBUF, TY_INT) + + # Get parameters from the cl. + call clgstr ("image", image, SZ_FNAME) + threshold = clgeti ("threshold") + verbose = clgetb ("verbose") + + # Open image. + im = immap (image, READ_WRITE, 0) + + # Get the point buffer and npoints. + iferr (call limbfind (im, Memi[pb], npoints, threshold, rguess, + verbose)) + call eprintf("Error getting limbpoints.\n") + if (verbose) { + call printf ("\nrguess = %g\n") + call pargr (rguess) + call flush (STDOUT) + } + + # Fit the ellipse. + b = rguess + a = rguess + x = real(DIM_VTFD)/2. + y = real(DIM_VTFD)/2. + iferr (call efit (Memi[pb], npoints, x, y, a, b, rejects, verbose)) + call eprintf ("Error fitting elipse.\n") + + rpercent = real(rejects)/real(npoints) + if (verbose) { + call printf ("\nTotal number of limbpoints found was %d\n") + call pargi (npoints) + call printf ("Number of limbpoints rejected was %d\n") + call pargi (rejects) + call printf ("Fraction of limb points rejected = %g\n") + call pargr (rpercent) + call flush (STDOUT) + } + + # Put ellipse parameters in image header. + call imaddr (im, "E_XCEN", x) + call imaddr (im, "E_YCEN", y) + call imaddr (im, "E_XSMD", a) + call imaddr (im, "E_YSMD", b) + + # Close the image. + call imunmap (im) + + call sfree (sp) +end + + +# LIMBFIND - Find all of the points on the image that determine the +# limb. This is done line by line. + +procedure limbfind (imageptr, pointbuf, npoints, threshold, rguess, verbose) + +pointer imageptr # pointer to image +int pointbuf[SZ_VTPBUF,2] # buffer in which to store limb points +int npoints # number of points +int threshold # squibby threshold +real rguess # first guess at radius +bool verbose # verbose flag + +int rowspace, halfwidth, leftsave, rightsave, y +int numpix, numrow, leftx, rightx, yesno +int month, day, year, hour, minute, second, obsdate, obstime +real b0, l0 +pointer lpg + +pointer imgl2s() +int clgeti(), imgeti() +errchk ephem, flocr, florr, imgl2s + +begin + # Get date and time from the header. + obsdate = imgeti (imageptr, "OBS_DATE") + obstime = imgeti (imageptr, "OBS_TIME") + + # Calculate the month/day/year. + month = obsdate/10000 + day = obsdate/100 - 100 * (obsdate/10000) + year = obsdate - 100 * (obsdate/100) + + # Calculate the hour:minute:second. + hour = int(obstime/3600) + minute = int((obstime - hour * 3600)/60) + second = obstime - hour * 3600 - minute * 60 + if (verbose) { + call printf("date and time of this image = %d/%d/%d, %d:%d:%d\n") + call pargi(month) + call pargi(day) + call pargi(year) + call pargi(hour) + call pargi(minute) + call pargi(second) + call flush (STDOUT) + } + + # Get rowspace and halfwidth from the cl. + halfwidth = clgeti("halfwidth") + rowspace = clgeti("rowspace") + + numpix = IM_LEN(imageptr, 1) + numrow = IM_LEN(imageptr, 2) + npoints = 0 + + # Get rguess from ephem. + iferr (call ephem (month, day, year, hour, minute, second, rguess, + b0, l0, verbose)) + call eprintf ("Error getting ephemeris data.\n") + + # Put b0 and l0 in the image header. + call imaddr (imageptr, "B_ZERO", b0) + call imaddr (imageptr, "L_ZERO", l0) + + # Get central row to start with and find its limb points. + lpg = imgl2s (imageptr, numrow/2) + yesno = YES + iferr (call flocr (Mems[lpg], numpix, pointbuf, numrow, npoints, leftx, + rightx, threshold, yesno)) + call eprintf ("Error in 'find limb on center row(flocr)'\n") + if (yesno == NO) + call error (0,"Failure to find initial limb points, quickfit dies") + + leftsave = leftx + rightsave = rightx + + # Find the limb points for the lower half of the image. + yesno = YES + y = numrow/2-rowspace + while (y >= 1) { + + # Read this line in from the image. + lpg = imgl2s (imageptr, y) + + # Find its limb points. + iferr (call florr (Mems[lpg], numpix, pointbuf, npoints, numrow, + y, leftx, rightx, threshold, yesno, rguess, halfwidth)) + call eprintf ("Error in florr.\n") + if (yesno == NO) + break + if (abs(y-numrow/2) > rguess) + break + if ((int(rowspace * (rguess**2 - + real(y-numrow/2)**2)**.5/rguess)) >= 1) + y = y - int(rowspace * (rguess**2 - + real(y-numrow/2)**2)**.5/rguess) + else + y = y - 1 + } + + # Find the limb points for the upper half of the image. + + # Restore the pointers to the limb at disk center. + leftx = leftsave + rightx = rightsave + yesno = NO + y = numrow/2+rowspace + + while (y <= numrow) { + # Read this line in from the image. + lpg = imgl2s (imageptr, y) + + # Find its limb points. + iferr (call florr (Mems[lpg], numpix, pointbuf, npoints, numrow, + y, leftx, rightx, threshold, yesno, rguess, halfwidth)) + call eprintf ("Error in florr.\n") + + # If we couldn't find any limb points then it's time to go. + if (yesno == NO) + break + + # If we are beyond the limb vertically then its time to go. + if (abs(y-numrow/2) > rguess) + break + + # If the calculated rowspacing gets less than 1, just set it to 1. + if ((int(rowspace * (rguess**2 - + real(y-numrow/2)**2)**.5/rguess)) >= 1) { + y = y + int(rowspace * (rguess**2 - + real(y-numrow/2)**2)**.5/rguess) + } else + y = y + 1 + } +end + + +# FLOCR -- Find Limbpoints On Center Row. Since this is the first row +# to be searched, we have no idea of approximately where the limb points +# will be found in the row as we have in florr. We search from the endpoints +# of the row inward until the squibby brightness crosses the threshold. + +procedure flocr (array, numpix, pointbuf, npoints, numrow, leftx, rightx, + threshold, yesno) + +short array[numpix] # line of image +int pointbuf[SZ_VTPBUF,2] # limb point storage array +int numpix # number of pixels in line +int npoints # number of limb points +int numrow # which row this is in image +int leftx # return left boundary position here +int rightx # return right boundary position here +int threshold # squibby brightness limb threshold +int yesno # return yes if we found the limb + +int i, j, foundi, foundj + +begin + # Start at beginning and end of array and work in. + i = 1 + j = numpix + + # Flags that indicate when a limbpoint has been found. + foundi = 0 + foundj = 0 + + while (i <= j) { + if (foundi == 0) { + if (and(int(array[i]), 17B) >= threshold) { + foundi = 1 + npoints = npoints + 1 + pointbuf[npoints,1] = i + pointbuf[npoints,2] = numrow/2 + leftx = i + } + if (i == j) { + yesno = NO + return + } + } + + if (foundj == 0) { + if (and(int(array[j]), 17B) >= threshold) { + foundj = 1 + npoints = npoints + 1 + pointbuf[npoints,1] = j + pointbuf[npoints,2] = numrow/2 + rightx = j + } + } + if ((foundi == 1) && (foundj == 1)) + break + i = i + 1 + j = j - 1 + } +end + + +# FLORR -- Find Limbpoints On Random Row. Since we know the approximate +# positions of the limbpoints based on their positions on the ajacent +# row, we can restrict the range of x positions to be searched to those +# within a certain distance of those positions. These ranges we will +# call windows. Each window is checked for validity before it is +# searched for the limbpoints, if invalid a correct window is found. + +procedure florr (array, numpix, pointbuf, npoints, numrow, y, leftx, rightx, + threshold, yesno, rguess, halfwidth) + +short array[numpix] # line of image +int pointbuf[SZ_VTPBUF,2] # limb point storage array +int numpix # number of pixels in line +int npoints # number of limb points +int numrow # which row this is in image +int leftx # return left boundary position here +int rightx # return right boundary position here +int threshold # squibby brightness limb threshold +int yesno # return yes if we found the limb +int halfwidth # halfwidth of limb search window +real rguess # radius for sun guess + +int i, j, y + +begin + # Windows are leftx plus or minus halfwidth and rightx plus or + # minus halfwidth. Before searching windows, check them for + # validity and call newwindow if necessary. + + # Check for validity means the endpoint we expect to be outside + # the limb should have a squibby brightness less than the + # threshold and the inside the limb endpoint should have a + # squibby brightness greater than the threshold. + + # if invalid... + if ((and(int(array[max(1,(leftx-halfwidth))]),17B) >= threshold) || + (and(int(array[leftx+halfwidth]),17B) < threshold)) { + + # if we are getting too far from the center (outside limb) + # then return flag for no limbpoints. + + if (abs(y-numrow/2) > int(rguess)) { + yesno = NO + return + } + + # Otherwise calculate a new leftx for this row. + leftx = -((int(rguess**2) - (y-numrow/2)**2)**.5) + numrow/2 + } + + # If we now have a valid window... + if ((and(int(array[max(1,(leftx-halfwidth))]),17B) < threshold) && + (and(int(array[leftx+halfwidth]),17B) >= threshold)) { + + # Search window for limb point. + do i = max(1,(leftx-halfwidth)), leftx+halfwidth { + + # When we find it add it to the limbpoints array and + # break out of the do loop + + if (and(int(array[i]), 17B) >= threshold) { + + # Set the 'we found it' flag. + yesno = YES + + npoints = npoints + 1 + pointbuf[npoints,1] = i + pointbuf[npoints,2] = y + leftx = i + break + } + } + } + + # Same stuff for the right hand window. + if ((and(int(array[min(numpix,(rightx+halfwidth))]),17B) >= + threshold) || (and(int(array[rightx-halfwidth]),17B) < threshold)) { + if (abs(y-numrow/2) > int(rguess)) { + yesno = NO + return + } + rightx = (int(rguess**2) - (y-numrow/2)**2)**.5 + numrow/2 + } + + if ((and(int(array[min(numpix,(rightx+halfwidth))]),17B) < threshold) && + (and(int(array[rightx-halfwidth]),17B) >= threshold)) { + do j = min(numpix,(rightx+halfwidth)), rightx-halfwidth, -1 { + if (and(int(array[j]), 17B) >= threshold) { + yesno = YES + npoints = npoints + 1 + pointbuf[npoints,1] = j + pointbuf[npoints,2] = y + rightx = j + break + } + } + } +end + + +# EFIT - Find the best fitting ellipse to the limb points. We iterate +# 10 times, this seems to converge very well. +# Algorithm due to Jack Harvey. + +procedure efit (pointbuf, npoints, xzero, yzero, azero, bzero, rejects, + verbose) + +int pointbuf[SZ_VTPBUF,2] # buffer containing limb points +int npoints # number of limb points +real xzero, yzero, azero, bzero # return elipse parameters +int rejects # number of points rejected +bool verbose # verbose flag + +int i, j, ij, n +real xcenter, ycenter, a, b, a2, b2, a3, b3 +real z[6,6] +real x1, y1, x2, y2, q[5], fn, sq +real rejectcoeff + +real clgetr() + +begin + # Get the least squares rejection coefficient. + rejectcoeff = clgetr("rejectcoeff") + xcenter = xzero + ycenter = yzero + a = azero + b = azero + + do ij = 1, 10 { + a2 = a**2 + a3 = a2 * a + b2 = b**2 + b3 = b2 * b + sq = 0. + + do i = 1, 6 + do j = 1, 6 + z[i,j] = 0 + + fn = 0. + rejects = 0 + + do n = 1, npoints { + x1 = real(pointbuf[n,1]) - xcenter + y1 = real(pointbuf[n,2]) - ycenter + x2 = x1**2 + y2 = y1**2 + q[1] = x1/a2 + q[2] = y1/b2 + q[3] = -x2/a3 + q[4] = -y2/b3 + q[5] = .5 * (1. - x2/a2 - y2/b2) + + # Reject a point if it is too far from the approximate ellipse. + if (abs(q[5]) >= rejectcoeff) { + rejects = rejects + 1 + next + } + + sq = sq + q[5] + + do i = 1, 5 + do j = i, 5 + z[i,j+1] = z[i,j+1] + q[i] * q[j] + + fn = fn + 1. + } + + sq = sq/fn + call flush(STDOUT) + call lstsq (z, 6, fn) + if (z(5,3) > 3.) + z(5,3) = 3. + if (z(5,3) < -3.) + z(5,3) = -3. + if (z(5,4) > 3.) + z(5,4) = 3. + if (z(5,4) < -3.) + z(5,4) = -3. + if (z(5,1) > 10.) + z(5,1) = 10. + if (z(5,1) < -10.) + z(5,1) = -10. + if (z(5,2) > 10.) + z(5,2) = 10. + if (z(5,2) < -10.) + z(5,2) = -10. + a = a + z[5,3] + b = b + z[5,4] + xcenter = xcenter - z[5,1] + ycenter = ycenter - z[5,2] + + if (verbose) { + call printf ("x = %f, y = %f, a = %f, b = %f, sq = %13.10f\n") + call pargr (xcenter) + call pargr (ycenter) + call pargr (a) + call pargr (b) + call pargr (sq) + call flush (STDOUT) + } + } + + if (verbose) { + call printf ("\nCoordinates of center are x = %f, y = %f\n") + call pargr(xcenter) + call pargr(ycenter) + call printf ("xsemidiameter = %f, ysemidiameter = %f\n") + call pargr(a) + call pargr(b) + call flush (STDOUT) + } + + xzero = xcenter + yzero = ycenter + azero = a + bzero = b +end diff --git a/noao/imred/vtel/readheader.x b/noao/imred/vtel/readheader.x new file mode 100644 index 000000000..85fb6f664 --- /dev/null +++ b/noao/imred/vtel/readheader.x @@ -0,0 +1,59 @@ +include +include +include "vt.h" + +# READHEADER -- Read header info from the input. + +int procedure readheader(inputfd, hbuf, selfbuf) + +int inputfd # input file discriptor +pointer hbuf # header data input buffer pointer (short, SZ_VTHDR) +bool selfbuf # flag to tell if we should do our own buffering + +int numchars +pointer sp, tempbuf +int read() +errchk read + +begin + call smark (sp) + call salloc (tempbuf, 100, TY_SHORT) + + # If we are reading from tape and buffering for ourselves then + # do a large read and see how many chars we get. If too few or + # too many give an error. Otherwise just read the correct number + # of chars. + + if (selfbuf) { + iferr (numchars = read (inputfd, Mems[tempbuf], + 10000*SZB_SHORT/SZB_CHAR)) { + call fseti (inputfd, F_VALIDATE, SZ_VTHDR*SZB_SHORT/SZB_CHAR) + call printf ("Error reading header.\n") + numchars = read (inputfd, Mems[tempbuf], + SZ_VTHDR*SZB_SHORT/SZB_CHAR) + } + if (numchars < 10 || numchars >= 100) { + call error (0, "error reading header") + return (numchars) + } + call amovs (Mems[tempbuf], Mems[hbuf], SZ_VTHDR*SZB_SHORT/SZB_CHAR) + } else { + iferr (numchars = read (inputfd, Mems[hbuf], + SZ_VTHDR*SZB_SHORT/SZB_CHAR)) { + call fseti (inputfd, F_VALIDATE, SZ_VTHDR*SZB_SHORT/SZB_CHAR) + call printf ("Error reading header.\n") + numchars = read (inputfd, Mems[tempbuf], + SZ_VTHDR*SZB_SHORT/SZB_CHAR) + } + if (numchars < SZ_VTHDR*SZB_SHORT/SZB_CHAR) { + call error (0, "eof encountered when reading header") + return (0) + } + } + + if (BYTE_SWAP2 == YES) + call bswap2 (Mems[hbuf], 1, Mems[hbuf], 1, SZ_VTHDR*SZB_SHORT) + call sfree (sp) + + return (SZ_VTHDR*SZB_SHORT/SZB_CHAR) +end diff --git a/noao/imred/vtel/readss1.x b/noao/imred/vtel/readss1.x new file mode 100644 index 000000000..2aea6d51e --- /dev/null +++ b/noao/imred/vtel/readss1.x @@ -0,0 +1,163 @@ +include +include +include +include "vt.h" + +define WDSBRSTR 50 + +# READSS1 -- Read a type 1 sector scan from tape and format into 3 iraf images. +# Type one sector scans consist of three images packed into 32 bits per +# pixel. The three images are 1. velocity (12 bits) 2. select (12 bits) and +# 3. continuum intensity (8 bits). The images are only 256 pixels high as +# opposed to 512 pixels high for the other scans. + +procedure readss1 (inputfd, filenumber, brief, select, bright, velocity, hs) + +int inputfd # file descriptor for input (usually tape) +int filenumber # file number on tape +bool brief # short output file names +bool select # flag to make select image +bool bright # flag to make bright image +bool velocity # flag to make velocity image +int hs # header data structure pointer + +char velimage[SZ_FNAME] # Velocity image +char selimage[SZ_FNAME] # Select image +char britimage[SZ_FNAME] # Brightness image +short u[SWTH_HIGH], dat +int date, hour, minute, seconds, i, j, num, lrs +pointer velim, selim, britim, velsrp, selsrp, britsrp + +int read() +pointer immap(), impl2s() +errchk immap, impl2s + +begin + # Calculate the time. Assemble the output image names. + hour = int(VT_HTIME(hs)/3600) + minute = int((VT_HTIME(hs) - hour * 3600)/60) + seconds = int(VT_HTIME(hs) - hour * 3600 - minute * 60) + if (brief) { + call sprintf (velimage[1], SZ_FNAME, "v%03d") + call pargi (filenumber) + call sprintf (selimage[1], SZ_FNAME, "s%03d") + call pargi (filenumber) + call sprintf (britimage[1], SZ_FNAME, "b%03d") + call pargi (filenumber) + } else { + call sprintf (velimage[1], SZ_FNAME, "v%02d_%02d%02d_%03d") + call pargi (VT_HDAY(hs)) # day of month + call pargi (hour) + call pargi (minute) + call pargi (filenumber) + call sprintf (selimage[1], SZ_FNAME, "s%02d_%02d%02d_%03d") + call pargi (VT_HDAY(hs)) # day of month + call pargi (hour) + call pargi (minute) + call pargi (filenumber) + call sprintf (britimage[1], SZ_FNAME, "b%02d_%02d%02d_%03d") + call pargi (VT_HDAY(hs)) # day of month + call pargi (hour) + call pargi (minute) + call pargi (filenumber) + } + if (select) { + selim = immap (selimage, NEW_IMAGE, 0) + IM_NDIM(selim) = 2 + IM_LEN(selim,1) = SWTH_HIGH/2 + IM_LEN(selim,2) = VT_HNUMCOLS(hs) + IM_PIXTYPE(selim) = TY_SHORT + call imaddi (selim, "obs_time", VT_HTIME(hs)) + date = VT_HMONTH(hs) * 10000 + VT_HDAY(hs) * 100 + VT_HYEAR(hs) + call imaddi (selim, "obs_date", date ) + call imaddi (selim, "wv_lngth", VT_HWVLNGTH(hs)) + call imaddi (selim, "obs_type", VT_HOBSTYPE(hs)) + call imaddi (selim, "av_intns", VT_HAVINTENS(hs)) + call imaddi (selim, "num_cols", VT_HNUMCOLS(hs)) + call imaddi (selim, "intg/pix", VT_HINTGPIX(hs)) + call imaddi (selim, "rep_time", VT_HREPTIME(hs)) + } + if (bright) { + britim = immap (britimage, NEW_IMAGE, 0) + IM_NDIM(britim) = 2 + IM_LEN(britim,1) = SWTH_HIGH/2 + IM_LEN(britim,2) = VT_HNUMCOLS(hs) + IM_PIXTYPE(britim) = TY_SHORT + call imaddi (britim, "obs_time", VT_HTIME(hs)) + date = VT_HMONTH(hs) * 10000 + VT_HDAY(hs) * 100 + VT_HYEAR(hs) + call imaddi (britim, "obs_date", date ) + call imaddi (britim, "wv_lngth", VT_HWVLNGTH(hs)) + call imaddi (britim, "obs_type", VT_HOBSTYPE(hs)) + call imaddi (britim, "av_intns", VT_HAVINTENS(hs)) + call imaddi (britim, "num_cols", VT_HNUMCOLS(hs)) + call imaddi (britim, "intg/pix", VT_HINTGPIX(hs)) + call imaddi (britim, "rep_time", VT_HREPTIME(hs)) + } + if (velocity) { + velim = immap (velimage, NEW_IMAGE, 0) + IM_NDIM(velim) = 2 + IM_LEN(velim,1) = SWTH_HIGH/2 + IM_LEN(velim,2) = VT_HNUMCOLS(hs) + IM_PIXTYPE(velim) = TY_SHORT + call imaddi (velim, "obs_time", VT_HTIME(hs)) + date = VT_HMONTH(hs) * 10000 + VT_HDAY(hs) * 100 + VT_HYEAR(hs) + call imaddi (velim, "obs_date", date ) + call imaddi (velim, "wv_lngth", VT_HWVLNGTH(hs)) + call imaddi (velim, "obs_type", VT_HOBSTYPE(hs)) + call imaddi (velim, "av_intns", VT_HAVINTENS(hs)) + call imaddi (velim, "num_cols", VT_HNUMCOLS(hs)) + call imaddi (velim, "intg/pix", VT_HINTGPIX(hs)) + call imaddi (velim, "rep_time", VT_HREPTIME(hs)) + } + + do j = 1, VT_HNUMCOLS(hs) { + if (select) + selsrp = impl2s (selim, j) + if (bright) + britsrp = impl2s (britim, j) + if (velocity) + velsrp = impl2s (velim, j) + + iferr (num = read (inputfd, u, SWTH_HIGH*SZB_SHORT/SZB_CHAR)) { + call fseti (inputfd, F_VALIDATE, lrs*SZB_SHORT/SZB_CHAR) + call eprintf ("Error on tape read.\n") + num = read (inputfd, u, SWTH_HIGH*SZB_SHORT/SZB_CHAR) + } + lrs = num + if (num < SWTH_HIGH*SZB_SHORT/SZB_CHAR) + call error (0, "eof encountered when reading file") + if (BYTE_SWAP2 == YES) + call bswap2 (u, 1, u, 1, SWTH_HIGH * SZB_SHORT) + + # Unpack the data into the three arrays. + do i = 257, 512 { + if (select) { + dat = u[i]/16 + if (u[i] < 0) + dat = dat - 1 + Mems[selsrp+i-257] = dat + } + if (bright) + Mems[britsrp+i-257] = and(int(u[i]),17B)*16 + } + + do i = 1, 256 { + if (velocity) { + dat = u[i]/16 + if (u[i] < 0) + dat = dat - 1 + Mems[velsrp+i-1] = dat + } + if (bright) + Mems[britsrp+i-1] = Mems[britsrp+i-1]+and(int(u[i]),17B) + } + } + + # Unmap images. + if (select) + call imunmap (selim) + if (velocity) + call imunmap (velim) + if (bright) + call imunmap (britim) +end diff --git a/noao/imred/vtel/readss2.x b/noao/imred/vtel/readss2.x new file mode 100644 index 000000000..71ae87588 --- /dev/null +++ b/noao/imred/vtel/readss2.x @@ -0,0 +1,174 @@ +include +include +include +include "vt.h" + +define WDSBRSTR 50 + +# READSS2 -- Read a type 2 sector scan from tape and format into 3 iraf images. +# Type two sector scans consist of three images with 16 bits per +# pixel. The three images are 1. velocity (16 bits) 2. select (16 bits) and +# 3. brightness (16 bits). The images are 512 pixels high. + +procedure readss2 (inputfd, filenumber, brief, select, bright, velocity, hs) + +int inputfd # file descriptor for input (usually tape) +int filenumber # file number on tape +bool brief # short output file names +bool select # flag to make select image +bool bright # flag to make bright image +bool velocity # flag to make velocity image +int hs # header data structure pointer + +char velimage[SZ_FNAME] # velocity image +char selimage[SZ_FNAME] # select image +char britimage[SZ_FNAME] # brightness image +short u[SWTH_HIGH] +int date, hour, minute, seconds, i, j, num, lrs +pointer velim, selim, britim, velsrp, selsrp, britsrp + +int read() +pointer immap(), impl2s() +errchk immap, impl2s + +begin + # Calculate the time. Assemble the output image names. + hour = int(VT_HTIME(hs)/3600) + minute = int((VT_HTIME(hs) - hour * 3600)/60) + seconds = int(VT_HTIME(hs) - hour * 3600 - minute * 60) + if (brief) { + call sprintf (velimage[1], SZ_FNAME, "v%03d") + call pargi (filenumber) + call sprintf (selimage[1], SZ_FNAME, "s%03d") + call pargi (filenumber) + call sprintf (britimage[1], SZ_FNAME, "b%03d") + call pargi (filenumber) + } else { + call sprintf (velimage[1], SZ_FNAME, "v%02d_%02d%02d_%03d") + call pargi (VT_HDAY(hs)) # day of month + call pargi (hour) + call pargi (minute) + call pargi (filenumber) + call sprintf (selimage[1], SZ_FNAME, "s%02d_%02d%02d_%03d") + call pargi (VT_HDAY(hs)) # day of month + call pargi (hour) + call pargi (minute) + call pargi (filenumber) + call sprintf (britimage[1], SZ_FNAME, "b%02d_%02d%02d_%03d") + call pargi (VT_HDAY(hs)) # day of month + call pargi (hour) + call pargi (minute) + call pargi (filenumber) + } + + if (select) { + selim = immap (selimage, NEW_IMAGE, 0) + IM_NDIM(selim) = 2 + IM_LEN(selim,1) = SWTH_HIGH + IM_LEN(selim,2) = VT_HNUMCOLS(hs) + IM_PIXTYPE(selim) = TY_SHORT + call imaddi (selim, "obs_time", VT_HTIME(hs)) + date = VT_HMONTH(hs) * 10000 + VT_HDAY(hs) * 100 + VT_HYEAR(hs) + call imaddi (selim, "obs_date", date ) + call imaddi (selim, "wv_lngth", VT_HWVLNGTH(hs)) + call imaddi (selim, "obs_type", VT_HOBSTYPE(hs)) + call imaddi (selim, "av_intns", VT_HAVINTENS(hs)) + call imaddi (selim, "num_cols", VT_HNUMCOLS(hs)) + call imaddi (selim, "intg/pix", VT_HINTGPIX(hs)) + call imaddi (selim, "rep_time", VT_HREPTIME(hs)) + } + if (bright) { + britim = immap (britimage, NEW_IMAGE, 0) + IM_NDIM(britim) = 2 + IM_LEN(britim,1) = SWTH_HIGH + IM_LEN(britim,2) = VT_HNUMCOLS(hs) + IM_PIXTYPE(britim) = TY_SHORT + call imaddi (britim, "obs_time", VT_HTIME(hs)) + date = VT_HMONTH(hs) * 10000 + VT_HDAY(hs) * 100 + VT_HYEAR(hs) + call imaddi (britim, "obs_date", date ) + call imaddi (britim, "wv_lngth", VT_HWVLNGTH(hs)) + call imaddi (britim, "obs_type", VT_HOBSTYPE(hs)) + call imaddi (britim, "av_intns", VT_HAVINTENS(hs)) + call imaddi (britim, "num_cols", VT_HNUMCOLS(hs)) + call imaddi (britim, "intg/pix", VT_HINTGPIX(hs)) + call imaddi (britim, "rep_time", VT_HREPTIME(hs)) + } + if (velocity) { + velim = immap (velimage, NEW_IMAGE, 0) + IM_NDIM(velim) = 2 + IM_LEN(velim,1) = SWTH_HIGH + IM_LEN(velim,2) = VT_HNUMCOLS(hs) + IM_PIXTYPE(velim) = TY_SHORT + call imaddi (velim, "obs_time", VT_HTIME(hs)) + date = VT_HMONTH(hs) * 10000 + VT_HDAY(hs) * 100 + VT_HYEAR(hs) + call imaddi (velim, "obs_date", date ) + call imaddi (velim, "wv_lngth", VT_HWVLNGTH(hs)) + call imaddi (velim, "obs_type", VT_HOBSTYPE(hs)) + call imaddi (velim, "av_intns", VT_HAVINTENS(hs)) + call imaddi (velim, "num_cols", VT_HNUMCOLS(hs)) + call imaddi (velim, "intg/pix", VT_HINTGPIX(hs)) + call imaddi (velim, "rep_time", VT_HREPTIME(hs)) + } + + do j = 1, VT_HNUMCOLS(hs) { + if (select) + selsrp = impl2s (selim, j) + if (bright) + britsrp = impl2s (britim, j) + if (velocity) + velsrp = impl2s (velim, j) + + iferr (num = read (inputfd, u, SWTH_HIGH*SZB_SHORT/SZB_CHAR)) { + call fseti (inputfd, F_VALIDATE, lrs*SZB_SHORT/SZB_CHAR) + call eprintf ("Error on tape read.\n") + num = read (inputfd, u, SWTH_HIGH*SZB_SHORT/SZB_CHAR) + } + lrs = num + if (num < SWTH_HIGH*SZB_SHORT/SZB_CHAR) + call error (0, "eof encountered when reading file") + if (BYTE_SWAP2 == YES) + call bswap2 (u, 1, u, 1, SWTH_HIGH * SZB_SHORT) + + if (velocity) + do i = 1, 512 + Mems[velsrp+i-1] = u[i] + + iferr (num = read (inputfd, u, SWTH_HIGH*SZB_SHORT/SZB_CHAR)) { + call fseti (inputfd, F_VALIDATE, lrs*SZB_SHORT/SZB_CHAR) + call eprintf ("Error on tape read.\n") + num = read (inputfd, u, SWTH_HIGH*SZB_SHORT/SZB_CHAR) + } + lrs = num + if (num < SWTH_HIGH*SZB_SHORT/SZB_CHAR) + call error (0, "eof encountered when reading file") + if (BYTE_SWAP2 == YES) + call bswap2 (u, 1, u, 1, SWTH_HIGH * SZB_SHORT) + + if (select) + do i = 1, 512 + Mems[selsrp+i-1] = u[i] + + iferr (num = read (inputfd, u, SWTH_HIGH*SZB_SHORT/SZB_CHAR)) { + call fseti (inputfd, F_VALIDATE, lrs*SZB_SHORT/SZB_CHAR) + call eprintf ("Error on tape read.\n") + num = read (inputfd, u, SWTH_HIGH*SZB_SHORT/SZB_CHAR) + } + lrs = num + if (num < SWTH_HIGH*SZB_SHORT/SZB_CHAR) + call error (0, "eof encountered when reading file") + if (BYTE_SWAP2 == YES) + call bswap2 (u, 1, u, 1, SWTH_HIGH * SZB_SHORT) + + if (bright) + do i = 1, 512 + Mems[britsrp+i-1] = u[i] + } + + # Unmap images. + if (select) + call imunmap (selim) + if (velocity) + call imunmap (velim) + if (bright) + call imunmap (britim) +end diff --git a/noao/imred/vtel/readss3.x b/noao/imred/vtel/readss3.x new file mode 100644 index 000000000..f8721ae0c --- /dev/null +++ b/noao/imred/vtel/readss3.x @@ -0,0 +1,171 @@ +include +include +include +include "vt.h" + +define WDSBRSTR 50 + +# READSS3 -- Read a type 3 sector scan from tape and format into 3 iraf images. +# Type three sector scans consist of three images packed into 32 bits per +# pixel. The three images are 1. velocity (12 bits) 2. select (12 bits) and +# 3. continuum intensity (8 bits) + +procedure readss3 (inputfd, filenumber, brief, select, bright, velocity, hs) + +int inputfd # file descriptor for input (usually tape) +int filenumber # file number on tape +bool brief # short output file names +bool select # flag to make select image +bool bright # flag to make bright image +bool velocity # flag to make velocity image +int hs # header data structure pointer + +char velimage[SZ_FNAME] # Velocity image +char selimage[SZ_FNAME] # Select image +char britimage[SZ_FNAME] # Brightness image +bool zero +short t[SWTH_HIGH], u[SWTH_HIGH], k +int date, hour, minute, seconds, i, j, num, lrs +pointer velim, selim, britim, velsrp, selsrp, britsrp + +define redo_ 10 + +int read() +short shifts() +pointer immap(), impl2s() +errchk immap, impl2s + +begin + k = -4 + + # Calculate the time. Assemble the output image names. + hour = int(VT_HTIME(hs)/3600) + minute = int((VT_HTIME(hs) - hour * 3600)/60) + seconds = int(VT_HTIME(hs) - hour * 3600 - minute * 60) + if (brief) { + call sprintf (velimage[1], SZ_FNAME, "v%03d") + call pargi (filenumber) + call sprintf (selimage[1], SZ_FNAME, "s%03d") + call pargi (filenumber) + call sprintf (britimage[1], SZ_FNAME, "b%03d") + call pargi (filenumber) + } else { + call sprintf (velimage[1], SZ_FNAME, "v%02d_%02d%02d_%03d") + call pargi (VT_HDAY(hs)) # day of month + call pargi (hour) + call pargi (minute) + call pargi (filenumber) + call sprintf (selimage[1], SZ_FNAME, "s%02d_%02d%02d_%03d") + call pargi (VT_HDAY(hs)) # day of month + call pargi (hour) + call pargi (minute) + call pargi (filenumber) + call sprintf (britimage[1], SZ_FNAME, "b%02d_%02d%02d_%03d") + call pargi (VT_HDAY(hs)) # day of month + call pargi (hour) + call pargi (minute) + call pargi (filenumber) + } + if (select) { + selim = immap (selimage, NEW_IMAGE, 0) + IM_NDIM(selim) = 2 + IM_LEN(selim,1) = SWTH_HIGH + IM_LEN(selim,2) = VT_HNUMCOLS(hs) + IM_PIXTYPE(selim) = TY_SHORT + call imaddi (selim, "obs_time", VT_HTIME(hs)) + date = VT_HMONTH(hs) * 10000 + VT_HDAY(hs) * 100 + VT_HYEAR(hs) + call imaddi (selim, "obs_date", date ) + call imaddi (selim, "wv_lngth", VT_HWVLNGTH(hs)) + call imaddi (selim, "obs_type", VT_HOBSTYPE(hs)) + call imaddi (selim, "av_intns", VT_HAVINTENS(hs)) + call imaddi (selim, "num_cols", VT_HNUMCOLS(hs)) + call imaddi (selim, "intg/pix", VT_HINTGPIX(hs)) + call imaddi (selim, "rep_time", VT_HREPTIME(hs)) + } + if (bright) { + britim = immap (britimage, NEW_IMAGE, 0) + IM_NDIM(britim) = 2 + IM_LEN(britim,1) = SWTH_HIGH + IM_LEN(britim,2) = VT_HNUMCOLS(hs) + IM_PIXTYPE(britim) = TY_SHORT + call imaddi (britim, "obs_time", VT_HTIME(hs)) + date = VT_HMONTH(hs) * 10000 + VT_HDAY(hs) * 100 + VT_HYEAR(hs) + call imaddi (britim, "obs_date", date ) + call imaddi (britim, "wv_lngth", VT_HWVLNGTH(hs)) + call imaddi (britim, "obs_type", VT_HOBSTYPE(hs)) + call imaddi (britim, "av_intns", VT_HAVINTENS(hs)) + call imaddi (britim, "num_cols", VT_HNUMCOLS(hs)) + call imaddi (britim, "intg/pix", VT_HINTGPIX(hs)) + call imaddi (britim, "rep_time", VT_HREPTIME(hs)) + } + if (velocity) { + velim = immap (velimage, NEW_IMAGE, 0) + IM_NDIM(velim) = 2 + IM_LEN(velim,1) = SWTH_HIGH + IM_LEN(velim,2) = VT_HNUMCOLS(hs) + IM_PIXTYPE(velim) = TY_SHORT + call imaddi (velim, "obs_time", VT_HTIME(hs)) + date = VT_HMONTH(hs) * 10000 + VT_HDAY(hs) * 100 + VT_HYEAR(hs) + call imaddi (velim, "obs_date", date ) + call imaddi (velim, "wv_lngth", VT_HWVLNGTH(hs)) + call imaddi (velim, "obs_type", VT_HOBSTYPE(hs)) + call imaddi (velim, "av_intns", VT_HAVINTENS(hs)) + call imaddi (velim, "num_cols", VT_HNUMCOLS(hs)) + call imaddi (velim, "intg/pix", VT_HINTGPIX(hs)) + call imaddi (velim, "rep_time", VT_HREPTIME(hs)) + } + + do j = 1, VT_HNUMCOLS(hs) { +redo_ if (select) + selsrp = impl2s (selim, j) + if (bright) + britsrp = impl2s (britim, j) + if (velocity) + velsrp = impl2s (velim, j) + + iferr (num = read (inputfd, u, SWTH_HIGH*SZB_SHORT/SZB_CHAR)) { + call fseti (inputfd, F_VALIDATE, lrs*SZB_SHORT/SZB_CHAR) + call eprintf ("Error on tape read.\n") + num = read (inputfd, u, SWTH_HIGH*SZB_SHORT/SZB_CHAR) + } + lrs = num + if (num < SWTH_HIGH*SZB_SHORT/SZB_CHAR) + call error (0, "eof encountered when reading file") + if (BYTE_SWAP2 == YES) + call bswap2 (u, 1, u, 1, SWTH_HIGH * SZB_SHORT) + iferr (num = read (inputfd, t, SWTH_HIGH*SZB_SHORT/SZB_CHAR)) { + call fseti (inputfd, F_VALIDATE, lrs*SZB_SHORT/SZB_CHAR) + call eprintf ("Error on tape read.\n") + num = read (inputfd, t, SWTH_HIGH*SZB_SHORT/SZB_CHAR) + } + lrs = num + if (num < SWTH_HIGH*SZB_SHORT/SZB_CHAR) + call error (0, "eof encountered when reading file") + if (BYTE_SWAP2 == YES) + call bswap2 (t, 1, t, 1, SWTH_HIGH * SZB_SHORT) + + zero = true + do i = 1, SWTH_HIGH { + if (select) + Mems[selsrp+i-1] = shifts(t[i], k) + if (velocity) + Mems[velsrp+i-1] = shifts(u[i], k) + if (bright) + Mems[britsrp+i-1] = and(int(t[i]),17B)*16+and(int(u[i]),17B) + if (t[i] != 0) + zero = false + } + if (zero) { + call eprintf ("READSS3: found a zero line in image, skip.\n") + goto redo_ + } + } + + # Unmap images. + if (select) + call imunmap (selim) + if (velocity) + call imunmap (velim) + if (bright) + call imunmap (britim) +end diff --git a/noao/imred/vtel/readss4.x b/noao/imred/vtel/readss4.x new file mode 100644 index 000000000..2ab3199da --- /dev/null +++ b/noao/imred/vtel/readss4.x @@ -0,0 +1,85 @@ +include +include +include +include "vt.h" + +define WDSBRSTR 50 + +# READSS4 -- Read data file from tape or disk and format the data into +# an IRAF image. This is for type 4 sector scans. + +procedure readss4 (inputfd, filenumber, brief, select, bright, velocity, hs) + +int inputfd # file descriptor for input (usually tape) +int filenumber # file number on tape +bool brief # short output file names +bool select # flag to make select image +bool bright # flag to make bright image +bool velocity # flag to make velocity image +int hs # header data structure pointer + +pointer im, srp +char imagefile[SZ_FNAME] +int date, hour, minute, seconds, i, j, num, lrs +short u[SWTH_HIGH] + +int read() +pointer immap(), impl2s() +errchk immap, impl2s + +begin + # Calculate the time. Assemble the output image name. + hour = int(VT_HTIME(hs)/3600) + minute = int((VT_HTIME(hs) - hour * 3600)/60) + seconds = int(VT_HTIME(hs) - hour * 3600 - minute * 60) + if (brief) { + call sprintf (imagefile[1], SZ_FNAME, "s%03d") + call pargi (filenumber) + } else { + call sprintf (imagefile[1], SZ_FNAME, "s%02d_%02d%02d_%03d") + call pargi (VT_HDAY(hs)) # day of month + call pargi (hour) + call pargi (minute) + call pargi (filenumber) + } + + if (select) { + im = immap (imagefile, NEW_IMAGE, 0) + IM_NDIM(im) = 2 + IM_LEN(im,1) = SWTH_HIGH + IM_LEN(im,2) = VT_HNUMCOLS(hs) + IM_PIXTYPE(im) = TY_SHORT + call imaddi (im, "obs_time", VT_HTIME(hs)) + date = VT_HMONTH(hs) * 10000 + VT_HDAY(hs) * 100 + VT_HYEAR(hs) + call imaddi (im, "obs_date", date ) + call imaddi (im, "wv_lngth", VT_HWVLNGTH(hs)) + call imaddi (im, "obs_type", VT_HOBSTYPE(hs)) + call imaddi (im, "av_intns", VT_HAVINTENS(hs)) + call imaddi (im, "num_cols", VT_HNUMCOLS(hs)) + call imaddi (im, "intg/pix", VT_HINTGPIX(hs)) + call imaddi (im, "rep_time", VT_HREPTIME(hs)) + } + + do j = 1, VT_HNUMCOLS(hs) { + if (select) + srp = impl2s (im, j) + + iferr (num = read (inputfd, u, SWTH_HIGH*SZB_SHORT/SZB_CHAR)) { + call fseti (inputfd, F_VALIDATE, lrs*SZB_SHORT/SZB_CHAR) + call eprintf ("Error on tape read.\n") + num = read (inputfd, u, SWTH_HIGH*SZB_SHORT/SZB_CHAR) + } + lrs = num + if (num < SWTH_HIGH*SZB_SHORT/SZB_CHAR) + call error (0, "eof encountered when reading file") + if (BYTE_SWAP2 == YES) + call bswap2 (u, 1, u, 1, SWTH_HIGH * SZB_SHORT) + + if (select) + do i = 1, 512 + Mems[srp+i-1] = u[i] + } + + if (select) + call imunmap (im) +end diff --git a/noao/imred/vtel/readsubswath.x b/noao/imred/vtel/readsubswath.x new file mode 100644 index 000000000..9c15bb447 --- /dev/null +++ b/noao/imred/vtel/readsubswath.x @@ -0,0 +1,91 @@ +include +include +include "vt.h" + +define SZ_VTRECFD 5120 # length, in chars, of full disk recs + +# READSUBSWATH -- Read data from file whose logical unit is inputfd. +# Swap the bytes in each data word. + +procedure readsubswath (inputfd, selfbuf, databuf, buflength, bp) + +int inputfd # input file discriptor +int buflength # length of data buffer +bool selfbuf # self buffering flag +short databuf[buflength] # data buffer +pointer bp # buffer pointer structure pointer + +int num, bleft, last_recsize +int read() +errchk read + +begin + # If we are doing our own buffering, keep track of the number + # of records in each file, else let mtio do it. + + last_recsize = 0 + if (selfbuf) { # do our own buffering + + # If there is enough data still in the buffer, just copy data + # to the output buffer and move the pointer, otherwise, read + # the next tape record. + + if ((VT_BUFBOT(bp) - VT_BP(bp)) >= buflength) { + # Copy the data into the data buffer, move the pointer. + call amovs (Mems[VT_BP(bp)], databuf, buflength) + VT_BP(bp) = VT_BP(bp) + buflength + + } else { + # Copy leftover data from the bottom of the input buffer + # into the top of the input buffer, reset the flags. + + bleft = VT_BUFBOT(bp) - VT_BP(bp) + call amovs (Mems[VT_BP(bp)], Mems[VT_BUFP(bp)], bleft) + VT_BP(bp) = VT_BUFP(bp) + bleft + + # Read in another tape record. + # Check the number of chars read. If this number is EOF or + # too short, error. If it is too long, truncate to correct + # length. This is done because some data tapes are written + # in a weird way and have some noise chars tacked on the end + # of each tape record. + + iferr (num = read (inputfd, Mems[VT_BP(bp)], + 10000*SZB_SHORT/SZB_CHAR)) { + call fseti (inputfd, F_VALIDATE, + SZ_VTRECFD*SZB_SHORT/SZB_CHAR) + call printf ("Error reading subswath.\n") + num = read (inputfd, Mems[VT_BP(bp)], + SZ_VTRECFD*SZB_SHORT/SZB_CHAR) + } + if (num == EOF) + call error (0, "EOF encountered on tape read") + else if (num < SZ_VTRECFD*SZB_SHORT/SZB_CHAR) + call error (0, "error on tape read, record too short") + else if (num >= SZ_VTRECFD*SZB_SHORT/SZB_CHAR && + num < (SZ_VTRECFD+300)*SZB_SHORT/SZB_CHAR) + num = SZ_VTRECFD*SZB_SHORT/SZB_CHAR + else + call error (0, "error on tape read, record too long") + + # Update the pointers, move data into the data buffer. + VT_BUFBOT(bp) = VT_BP(bp) + num + call amovs (Mems[VT_BP(bp)], databuf, buflength) + VT_BP(bp) = VT_BP(bp) + buflength + } + } else { # Let the mtio do the buffering. + iferr (num = read (inputfd, databuf, + buflength*SZB_SHORT/SZB_CHAR)) { + call fseti (inputfd, F_VALIDATE, + last_recsize*SZB_SHORT/SZB_CHAR) + call printf ("Error on tape read.\n") + num = read (inputfd, databuf, buflength*SZB_SHORT/SZB_CHAR) + } + last_recsize = num + if (num < buflength*SZB_SHORT/SZB_CHAR) + call error (0, "eof encountered when reading subswath") + } + + if (BYTE_SWAP2 == YES) + call bswap2 (databuf, 1, databuf, 1, buflength * SZB_SHORT) +end diff --git a/noao/imred/vtel/readvt.par b/noao/imred/vtel/readvt.par new file mode 100644 index 000000000..5986a8c0f --- /dev/null +++ b/noao/imred/vtel/readvt.par @@ -0,0 +1,6 @@ +infile,s,q,,,,Input file descriptor +outfile,s,q,,,,Output image file descriptor +files,s,q,,,,Tape files to read +verbose,b,h,no,,,Print out header data and give progress reports +headeronly,b,h,no,,,Print out the header data and quit +robust,b,h,no,,,Ignore wrong observation type in header diff --git a/noao/imred/vtel/readvt.x b/noao/imred/vtel/readvt.x new file mode 100644 index 000000000..27e34be3d --- /dev/null +++ b/noao/imred/vtel/readvt.x @@ -0,0 +1,347 @@ +include +include +include +include "vt.h" + +define MAX_RANGES 100 +define VT_TBUF 15000 + +# READVT -- Read data from tape or disk and format the data into an IRAF image. +# Display header information to the user as a check if the 'verbose' flag is +# set. + +procedure t_readvt() + +pointer infile # pointer to input filename(s) +pointer outfile # pointer to output filename(s) +bool verbose # verbose flag +bool headeronly # if set, just print the header +bool robust # if set, ignore wrong observation type +pointer files # file list for multiple tape files + +int listin # list of input images +int listout # list of output images +bool selfbuf, rootflag +int nfiles, filenumber, stat +pointer bp, sp, tapename, dfilename, diskfile, root +int filerange[2 * MAX_RANGES + 1] + +bool clgetb() +int get_next_number(), mtneedfileno() +int strlen(), decode_ranges() +int fntopnb(), imtopenp(), clgfil(), imtgetim(), clplen(), imtlen() +int mtfile() +errchk vt_rfd + +begin + call smark (sp) + call salloc (infile, SZ_LINE, TY_CHAR) + call salloc (outfile, SZ_LINE, TY_CHAR) + call salloc (tapename, 2*SZ_LINE, TY_CHAR) + call salloc (dfilename, 2*SZ_LINE, TY_CHAR) + call salloc (diskfile, SZ_LINE, TY_CHAR) + call salloc (root, SZ_LINE, TY_CHAR) + call salloc (files, SZ_LINE, TY_CHAR) + + call fseti (STDOUT, F_FLUSHNL, YES) + + # Get parameters from the CL. + verbose = clgetb ("verbose") + headeronly = clgetb ("headeronly") + robust = clgetb ("robust") + + call clgstr ("infile", Memc[infile], SZ_FNAME) + + # Set up the buffer structure, we may need it. + call salloc (bp, VT_LENBSTRUCT, TY_STRUCT) + call salloc (VT_BUFP(bp), VT_TBUF, TY_SHORT) + VT_BP(bp) = VT_BUFP(bp) + VT_BUFBOT(bp) = VT_BUFP(bp) + + if (mtfile (Memc[infile]) == NO) { + # This is not a tape file, expand as a list template. + listin = fntopnb (Memc[infile], 0) + rootflag = FALSE + filenumber = 1 + if (!headeronly) { + listout = imtopenp ("outfile") + + # Compare the lengths of the two lists. If equal, proceed, + # otherwise if the outlist is of length one, use it as a root + # name, otherwise error. + + if (imtlen (listout) == 1) { + rootflag = TRUE + stat = imtgetim (listout, Memc[root], SZ_FNAME) + } else if (clplen (listin) != imtlen (listout)) { + call clpcls (listin) + call imtclose (listout) + call error (1, "Wrong number of elements in operand lists") + } + } + + while (clgfil (listin, Memc[diskfile], SZ_FNAME) != EOF) { + if (!headeronly) { + if (!rootflag) + stat = imtgetim (listout, Memc[dfilename], SZ_FNAME) + else { + # Assemble an output filename from the root name. + call sprintf (Memc[dfilename], SZ_FNAME, "%s") + call pargstr (Memc[root]) + call sprintf (Memc[dfilename+strlen(Memc[root])], + SZ_FNAME, "%03d") + call pargi (filenumber) + filenumber = filenumber + 1 + } + } + + # Of course, if the user is reading from disk, we can't + # check record sizes. + + selfbuf = false + iferr (call vt_rfd (diskfile, dfilename, + selfbuf, verbose, headeronly, robust, bp)) { + call eprintf ("Error reading file %s\n") + call pargstr (Memc[infile]) + } + } + call clpcls (listin) + if (!headeronly) + call imtclose (listout) + + } else if (mtneedfileno(Memc[infile]) == NO) { + + # This is a tape file and the user specified which file. + if (!headeronly) + call clgstr ("outfile", Memc[outfile], SZ_FNAME) + selfbuf = true + iferr (call vt_rfd (infile, outfile, selfbuf, verbose, + headeronly, robust, bp)) { + call eprintf ("Error reading file %s\n") + call pargstr (Memc[infile]) + } + + } else { + + # This is a tape file and the user did not specify which file. + call clgstr ("files", Memc[files], SZ_LINE) + if (!headeronly) + call clgstr ("outfile", Memc[outfile], SZ_FNAME) + + # Set up the file names, then do the read. + if (decode_ranges (Memc[files], filerange, MAX_RANGES, + nfiles) == ERR) + call error (0, "Illegal file number list.") + + while (get_next_number (filerange, filenumber) != EOF) { + # Assemble the appropriate tape file name. + call mtfname (Memc[infile], filenumber, Memc[tapename], + SZ_FNAME) + + # Assemble the appropriate disk file name. + if (!headeronly) { + call strcpy (Memc[outfile], Memc[dfilename], SZ_FNAME) + call sprintf (Memc[dfilename+strlen(Memc[outfile])], + SZ_FNAME, "%03d") + call pargi (filenumber) + } + + selfbuf = TRUE + iferr (call vt_rfd (tapename, dfilename, selfbuf, + verbose, headeronly, robust, bp)) { + call eprintf ("Error reading file %s\n") + call pargstr (Memc[infile]) + } + } + } + + call sfree (sp) +end + + +# VT_RFD -- Do the actual read of a full disk gram. + +procedure vt_rfd (in, out, selfbuf, verbose, headeronly, robust, bp) + +pointer in # input file +pointer out # output file +bool selfbuf # do input buffering and correct for bad record lengths +bool verbose # verbose flag +bool headeronly # if set, just print the header +bool robust # if set, ignore wrong observation type + +short one +int date, numchars +int subraster, x1, y1, inputfd +pointer table, bp, im, srp, hs, sp, hbuf +pointer immap(), imps2s() +int mtopen(), readheader() +errchk readheader, loadsubswath, immap, imps2s +define exit_ 10 + +begin + call smark (sp) + call salloc (hbuf, SZ_VTHDR, TY_SHORT) + call salloc (table, SZ_TABLE, TY_SHORT) + call salloc (hs, VT_LENHSTRUCT, TY_STRUCT) + + if (verbose) { + call printf ("\nfile %s ") + call pargstr (Memc[in]) + } + + # Open input file. + inputfd = mtopen (Memc[in], READ_ONLY, 0) + + # Read header. + iferr (numchars = readheader (inputfd, hbuf, selfbuf)) + call error (0, "Error reading header information.") + call decodeheader (hbuf, hs, verbose) + if (verbose) + call printf ("\n") + + # Check the observation type in the header. If this value is not + # zero (full disk) then write an error message, if the robust flag + # is set go ahead and read the file. + + if (!robust) { + if (VT_HOBSTYPE[hs] != 0) { + call printf ("file %s is not a type zero scan (full disk)\n") + call pargstr (Memc[in]) + call printf ("Use 'mscan' to read this type %d area scan\n") + call pargi (VT_HOBSTYPE[hs]) + goto exit_ # close input file and exit + } + } else { + if (VT_HOBSTYPE[hs] != 0) { + call printf ("The header for file %s contains 'observation ") + call pargstr (Memc[in]) + call printf ("type = %d'\n") + call pargi (VT_HOBSTYPE[hs]) + call printf ("READVT expects the observation type ") + call printf ("to be zero.\n") + call printf ("This error will be ignored since the 'robust'") + call printf (" flag is set\n") + } + } + + if (headeronly) + goto exit_ # close input file and exit + + if (verbose) { + call printf ("\nwriting %s\n") + call pargstr (Memc[out]) + } + + # Open the output image. Set it up. + im = immap (Memc[out], NEW_IMAGE, 0) + IM_NDIM(im) = 2 + IM_LEN(im,1) = DIM_VTFD + IM_LEN(im,2) = DIM_VTFD + IM_PIXTYPE(im) = TY_SHORT + + # Set up the 8 header fields we need and store the information we + # obtained from the raw data image header. + + call imaddi (im, "obs_time", VT_HTIME[hs]) + date = VT_HMONTH[hs] * 10000 + VT_HDAY[hs] * 100 + VT_HYEAR[hs] + + call imaddi (im, "obs_date", date ) + call imaddi (im, "wv_lngth", VT_HWVLNGTH[hs]) + call imaddi (im, "obs_type", VT_HOBSTYPE[hs]) + call imaddi (im, "av_intns", VT_HAVINTENS[hs]) + call imaddi (im, "num_cols", VT_HNUMCOLS[hs]) + call imaddi (im, "intg/pix", VT_HINTGPIX[hs]) + call imaddi (im, "rep_time", VT_HREPTIME[hs]) + + # Set up lookuptable. + one = 1 + call amovks (one, Mems[table], SZ_TABLE) + call aclrs (Mems[table], HALF_DIF) + call aclrs (Mems[table + SWTHWID_14 + HALF_DIF], HALF_DIF) + call aclrs (Mems[table + SWTHWID_23 * 3], HALF_DIF) + call aclrs (Mems[table + SZ_TABLE - HALF_DIF], HALF_DIF) + + # Now, fill the image with data. + do subraster = 1, NUM_SRSTR { + + # Calculate position of bottom left corner of this subraster + x1 = ((NUM_SRSTR_X - 1) - mod((subraster - 1), NUM_SRSTR_X)) * + SRSTR_WID + 1 + y1 = ((NUM_SRSTR_Y - 1) - ((subraster - mod((subraster - 1), + NUM_SRSTR_Y)) / NUM_SRSTR_Y)) * SWTH_HIGH + 1 + + # Get subraster. + srp = imps2s (im, x1, x1+(SRSTR_WID - 1), y1, y1+(SWTH_HIGH - 1)) + + # Load the subraster with data. + iferr (call loadsubraster (inputfd, Mems[srp], SRSTR_WID, SWTH_HIGH, + Mems[table], subraster, selfbuf, bp)) { + call eprintf ("Error in loadsubraster, subraster = %d\n") + call pargi (subraster) + break + } + + if (verbose) { + call printf("%d%% ") + call pargi ((subraster*100)/NUM_SRSTR) + call flush (STDOUT) + } + } + + if (verbose) + call printf ("\n") + + # Unmap image and close input file. + call imunmap (im) +exit_ + call sfree (sp) + call close (inputfd) +end + + +# LOADSUBRASTER -- Get data from the input and load it into this +# subraster, look in the table to see if each subswath should be +# filled with data or zeros. + +procedure loadsubraster (inputfd, array, nx, ny, table, subraster, selfbuf, bp) + +int inputfd # input file we are reading from +short array[nx, ny] # array to put the data in +int nx # x length of the array +int ny # y length of the array +short table[SZ_TABLE] # lookup table for data +int subraster # subraster number are we loading +bool selfbuf # buffering and record length checking? +pointer bp # pointer to buffer pointer structure + +pointer sp, bufpointer +int i, subswath, tableindex +errchk readsubswath + +begin + call smark (sp) + call salloc (bufpointer, ny, TY_SHORT) + + for (subswath = nx; subswath >= 1; subswath = subswath - 1) { + tableindex = (subraster - 1) * nx + ((nx + 1) - subswath) + + if (table[tableindex] == IS_DATA) { + iferr (call readsubswath (inputfd, selfbuf, Mems[bufpointer], + ny, bp)) { + + call eprintf ("Error in readsubswath, subswath = %d\n") + call pargi (subswath) + } + + do i = ny, 1, -1 + array[subswath,i] = Mems[bufpointer + ny - i] + + } else { + do i = 1, ny + array[subswath,i] = 0 + } + } + + call sfree (sp) +end diff --git a/noao/imred/vtel/rmap.par b/noao/imred/vtel/rmap.par new file mode 100644 index 000000000..b8c6efd08 --- /dev/null +++ b/noao/imred/vtel/rmap.par @@ -0,0 +1,5 @@ +inputimage,s,q,,,,Input image +outputimage,s,q,,,,Output data image +outweight,s,q,,,,Weights image +outabs,s,q,,,,Absolute value image +histoname,s,q,,,,Histogram name diff --git a/noao/imred/vtel/syndico.h b/noao/imred/vtel/syndico.h new file mode 100644 index 000000000..d76930575 --- /dev/null +++ b/noao/imred/vtel/syndico.h @@ -0,0 +1,13 @@ +# coordinates of center of picture. +define DICO_XCENTER .505 +define DICO_YCENTER .500 + +# The number of dicomed pixels it takes to make 18 centimeters on a +# standard dicomed plot. +define DICO_18CM 2436.0 + +# coordinates of greyscale box +define IMGBL_X .245 +define IMGBL_Y .867 +define IMGTR_X .765 +define IMGTR_Y .902 diff --git a/noao/imred/vtel/syndico.par b/noao/imred/vtel/syndico.par new file mode 100644 index 000000000..b36d0624a --- /dev/null +++ b/noao/imred/vtel/syndico.par @@ -0,0 +1,14 @@ +image,s,a,,,,input image +logofile,s,h,iraf$noao/imred/vtel/nsolcrypt.dat,,,logo file +device,s,h,dicomed,,,plot device +sbthresh,i,h,2,,,squibby brightness threshold +plotlogo,b,h,yes,,,plot the logo on the image? +verbose,b,h,no,,,give progress reports? +forcetype,b,h,no,,,force the data type? +magnetic,b,h,yes,,,if forcing datatype is it magnetic else 10830 +month,i,q,,,,month the observation was made +day,i,q,,,,day the observation was made +year,i,q,,,,year the observation was made +hour,i,q,,,,hour the observation was made +minute,i,q,,,,minute the observation was made +second,i,q,,,,second the observation was made diff --git a/noao/imred/vtel/syndico.x b/noao/imred/vtel/syndico.x new file mode 100644 index 000000000..64910679f --- /dev/null +++ b/noao/imred/vtel/syndico.x @@ -0,0 +1,416 @@ +include +include +include +include +include "syndico.h" +include "vt.h" + +# SYNDICO -- Make Dicomed prints of synoptic images. This program is tuned +# to make the images 18 centimeters in diameter. + +procedure t_syndico() + +char image[SZ_FNAME] # image to plot +char logofile[SZ_FNAME] # file containing logo +char device[SZ_FNAME] # plot device +int sbthresh # squibby brightness threshold +bool verbose # verbose flag +bool plotlogo # plotlogo flag +bool forcetype # force image type flag +bool magnetic # image type = magnetic flag + +int obsdate, wavelength, obstime +int i, j, month, day, year, hour, minute, second, stat, bufptr +real delta_gblock, x, y +real excen, eycen, exsmd, eysmd, rguess +real b0, l0 +real mapy1, mapy2, radius, scale, diskfrac +char ltext[SZ_LINE] +char system_id[SZ_LINE] + +short grey[16] +pointer gp, sp, im, lf +pointer subrasp, subras1, buff +int trnsfrm[513] +int lkup10830[1091] +int gs10830[16] +real xstart, xend, ystart, yend, yinc +real xcenerr, ycenerr, ndc_xcerr, ndc_ycerr +real temp_xcenter, temp_ycenter + +pointer immap(), gopen(), imgl2s() +int imgeti(), clgeti(), open(), read() +real imgetr() +bool clgetb(), imaccf() +include "trnsfrm.inc" +errchk gopen, immap, sysid, imgs2s, imgl2s + +# Grey scale points for 10830. +data (gs10830[i], i = 1, 6) /-1000,-700,-500,-400,-300,-250/ +data (gs10830[i], i = 7, 10) /-200,-150,-100,-50/ +data (gs10830[i], i = 11, 16) /0,10,20,40,60,90/ + +begin + call smark (sp) + call salloc (subrasp, DIM_VTFD, TY_SHORT) + call salloc (subras1, 185*185, TY_SHORT) + call salloc (buff, 185, TY_CHAR) + + # Get parameters from the cl. + call clgstr ("image", image, SZ_FNAME) + call clgstr ("logofile", logofile, SZ_FNAME) + call clgstr ("device", device, SZ_FNAME) + sbthresh = clgeti ("sbthresh") + plotlogo = clgetb ("plotlogo") + verbose = clgetb ("verbose") + forcetype = clgetb ("forcetype") + magnetic = clgetb ("magnetic") + + # Open the input image, open the logo image if requested. + im = immap (image, READ_ONLY, 0) + if (plotlogo) + iferr { + lf = open (logofile, READ_ONLY, TEXT_FILE) + } then { + call eprintf ("Error opening the logo file, logo not made.\n") + plotlogo = false + } + + # Get/calculate some of the housekeeping data. + if (imaccf (im, "obs_date")) { + obsdate = imgeti (im, "obs_date") + obstime = imgeti (im, "obs_time") + month = obsdate/10000 + day = obsdate/100 - 100 * (obsdate/10000) + year = obsdate - 100 * (obsdate/100) + hour = int(obstime/3600) + minute = int((obstime - hour * 3600)/60) + second = obstime - hour * 3600 - minute * 60 + } else { + # Use cl query parameters to get these values. + call eprintf ("Date and Time not found in image header.\n") + call eprintf ("Please enter them below.\n") + month = clgeti ("month") + day = clgeti ("day") + year = clgeti ("year") + hour = clgeti ("hour") + minute = clgeti ("minute") + second = clgeti ("second") + } + + # Get the solar image center and radius from the image header, + # get the solar image radius from the ephemeris routine. If + # the two radii are similar, use the former one, if they are + # %10 percent or more different, use the ephemeris radius and + # assume the center is at (1024,1024). + + # Get ellipse parameters from image header. + # If they are not there, warn the user that we are using ephemeris + # values. + if (imaccf (im, "E_XCEN")) { + excen = imgetr (im, "E_XCEN") + eycen = imgetr (im, "E_YCEN") + exsmd = imgetr (im, "E_XSMD") + eysmd = imgetr (im, "E_YSMD") + + # Get rguess from ephem. + iferr (call ephem (month, day, year, hour, minute, second, rguess, + b0, l0, false)) + call eprintf ("Error getting ephemeris data.\n") + + radius = (exsmd + eysmd) / 2.0 + if (abs(abs(radius-rguess)/rguess - 1.0) > 0.1) { + radius = rguess + excen = 1024.0 + eycen = 1024.0 + } + + } else { + call eprintf ("No ellipse parameters in image header.\n Using") + call eprintf (" ephemeris value for radius and setting center to") + call eprintf (" 1024, 1024\n") + + # Get rguess from ephem. + iferr (call ephem (month, day, year, hour, minute, second, rguess, + b0, l0, false)) + call eprintf ("Error getting ephemeris data.\n") + + radius = rguess + excen = 1024.0 + eycen = 1024.0 + } + + # Error in center. (units of pixels) + xcenerr = excen - 1024.0 + ycenerr = eycen - 1024.0 + + # Transform error to NDC. + ndc_xcerr = xcenerr * (1.0/4096.0) + ndc_ycerr = ycenerr * (1.0/4096.0) + + # Next, knowing that the image diameter must be 18 centimeters, + # calculate the scaling factor we must use to expand the image. + # DICO_18CM is a MAGIC number = 18 centimeters on dicomed prints + # given the way the NOAO photo lab currently enlarges the images. + scale = DICO_18CM / real(radius*2) + + # Open the output file. + gp = gopen (device, NEW_FILE, STDGRAPH) + + # Put feducial(sp?) marks on plot. + diskfrac = radius/1024.0 + temp_xcenter = DICO_XCENTER-ndc_xcerr + temp_ycenter = DICO_YCENTER-ndc_ycerr + call gline (gp, temp_xcenter, temp_ycenter+diskfrac*.25*scale+.01, + temp_xcenter, temp_ycenter+diskfrac*.25*scale+.025) + call gline (gp, temp_xcenter, temp_ycenter-diskfrac*.25*scale-.01, + temp_xcenter, temp_ycenter-diskfrac*.25*scale-.025) + + # Draw a little compass on the plot. + call gline (gp, .25, DICO_YCENTER+.25+.01, + .25, DICO_YCENTER+.25+.035) + call gtext (gp, .25, DICO_YCENTER+.25+.037, + "N", "v=b;h=c;s=.50") + call gmark (gp, .2565, DICO_YCENTER+.25+.037, + GM_CIRCLE, .006, .006) + call gmark (gp, .2565, DICO_YCENTER+.25+.037, + GM_CIRCLE, .001, .001) + call gline (gp, .25, DICO_YCENTER+.25+.01, + .28, DICO_YCENTER+.25+.01) + call gtext (gp, .282, DICO_YCENTER+.25+.01, + "W", "v=c;h=l;s=.50") + call gmark (gp, .290, DICO_YCENTER+.25+.01-.006, + GM_CIRCLE, .006, .006) + call gmark (gp, .290, DICO_YCENTER+.25+.01-.006, + GM_CIRCLE, .001, .001) + + # Get the wavelength from the image header. If the user wants + # to force the wavelength, do so. (this is used if the header + # information about wavelength is wrong.) + wavelength = imgeti (im, "wv_lngth") + if (forcetype) + if (magnetic) + wavelength = 8688 + else + wavelength = 10830 + + # Write the grey scale labels onto the plot. + delta_gblock = (IMGTR_X - IMGBL_X)/16. + y = IMGBL_Y - .005 + do i = 1, 16 { + x = IMGBL_X + real(i-1) * delta_gblock + delta_gblock/2. + call sprintf (ltext, SZ_LINE, "%d") + if (wavelength == 8688) + call pargi ((i-1)*(int((512./15.)+0.5))-256) + else if (wavelength == 10830) + call pargi (gs10830(i)) + call gtext (gp, x, y, ltext, "v=t;h=c;s=.20") + } + + # Label on grey scale. + call sprintf (ltext, SZ_LINE, "%s") + if (wavelength == 8688) + call pargstr ("gauss") + else if (wavelength == 10830) + call pargstr ("relative line strength") + call gtext (gp, DICO_XCENTER, (IMGBL_Y-.024), ltext, "v=c;h=c;s=.5") + + # Put the title on. + call sprintf (ltext, SZ_LINE, "%s") + if (wavelength == 8688) + call pargstr ("8688 MAGNETOGRAM") + else if (wavelength == 10830) + call pargstr ("10830 SPECTROHELIOGRAM") + else + call pargstr (" ") + call gtext (gp, DICO_XCENTER, .135, ltext, "v=c;h=c;s=.7") + + # If we don't have a logo to plot, write the data origin on the plot. + if (!plotlogo) { + + call sprintf (ltext, SZ_LINE, "%s") + call pargstr ("National") + call gtext (gp, .24, .155, ltext, "v=c;h=c;s=.7") + call sprintf (ltext, SZ_LINE, "%s") + call pargstr ("Solar") + call gtext (gp, .24, .135, ltext, "v=c;h=c;s=.7") + call sprintf (ltext, SZ_LINE, "%s") + call pargstr ("Observatory") + call gtext (gp, .24, .115, ltext, "v=c;h=c;s=.7") + } + + # Put month/day/year on plot. + call sprintf (ltext, SZ_LINE, "%02d/%02d/%02d") + call pargi (month) + call pargi (day) + call pargi (year) + call gtext (gp, .70, .175, ltext, "v=c;h=l;s=.5") + + # Put the hour:minute:second on plot. + call sprintf (ltext, SZ_LINE, "%02d:%02d:%02d UT") + call pargi (hour) + call pargi (minute) + call pargi (second) + call gtext (gp, .70, .155, ltext, "v=c;h=l;s=.5") + + # Fill in the grey scale. + if (wavelength == 8688) { + do i = 1, 16 + grey[i] = (trnsfrm[(i-1)*(int((512./15.)+0.5))+1]) + call gpcell (gp, grey, 16, 1, IMGBL_X, IMGBL_Y, IMGTR_X, IMGTR_Y) + } else if (wavelength == 10830) { + do i = 1, 16 + grey[i] = (lkup10830[gs10830(i)+1001]) + call gpcell (gp, grey, 16, 1, IMGBL_X, IMGBL_Y, IMGTR_X, IMGTR_Y) + } + + # Prepare some constants for plotting. + xstart = temp_xcenter - .25 * scale + xend = temp_xcenter + .25 * scale + ystart = temp_ycenter - .25 * scale + yend = temp_ycenter + .5 * scale + mapy1 = ystart + mapy2 = ystart + yinc = (.5*scale)/real(DIM_VTFD) + + # Put the data on the plot. Line by line. + do i = 1, DIM_VTFD { + + if (verbose) { + call printf ("line = %d\n") + call pargi (i) + call flush (STDOUT) + } + + subrasp = imgl2s (im, i) + + # Call the limb trimmer and data divider. + call fixline (Mems[subrasp], DIM_VTFD, wavelength, sbthresh) + + # Update the top and bottom edges of this line. + mapy1 = mapy2 + mapy2 = mapy2 + yinc + + # Put the line on the output plot. + call gpcell (gp, Mems[subrasp], DIM_VTFD, 1, xstart, + mapy1, xend, mapy2) + + } # End of do loop on image lines. + + # Put the system identification on the plot. + call sysid (system_id, SZ_LINE) + call gtext (gp, DICO_XCENTER, .076, system_id, "h=c;s=0.45") + + # Put the NSO logo on the plot. + if (plotlogo) { + + # Read in the image. (the image is encoded in a text file) + do i = 1, 185 { + bufptr = 0 + while (bufptr < 185-79) { + stat = read (lf, Memc[buff+bufptr], 80) + bufptr = bufptr + 79 + } + stat = read (lf, Memc[buff+bufptr], 80) + do j = 1, 185 { + Mems[subras1+(i-1)*185+j-1] = + short((Memc[buff+j-1]-32.)*2.7027027) + } + } + + # Put it on the plot. + call gpcell (gp, Mems[subras1], 185, 185, .24, .13, .32, .21) + } + + # Close the graphics pointer, unmap images, free stack. + call gclose (gp) + call imunmap (im) + if (plotlogo) + call close (lf) + call sfree (sp) +end + + +# FIXLINE -- Clean up the line. Set the value of pixels off the limb to +# zero, remove the squibby brightness from each pixel, and apply a +# nonlinear lookup table to the greyscale mapping. + +procedure fixline (ln, xlength, wavelength, sbthresh) + +int xlength # length of line buffer +short ln[xlength] # line buffer +int wavelength # wavelength of the observation +int sbthresh # squibby brightness threshold + +int trnsfrm[513] +int lkup10830[1091] +bool found +int i, left, right +include "trnsfrm.inc" + +begin + # Look in from the left end till squibby brightness goes above the + # threshold, remember where this limbpoint is. + found = false + do i = 1, xlength { # Find left limbpoint. + if (and(int(ln[i]),17B) > sbthresh) { + found = true + left = i + break + } + } + + if (found) { + # Find the right limbpoint. + do i = xlength, 1, -1 { + if (and(int(ln[i]),17B) > sbthresh) { + right = i + break + } + } + + # Divide the image by 16, map the greyscale, and trim the limb. + do i = left+1, right-1 { + + # Remove squibby brightness. + ln[i] = ln[i]/16 + + if (wavelength == 8688) { + # Magnetogram, nonlinear greyscale. + # Make data fit in the table. + if (ln[i] < -256) + ln[i] = -256 + if (ln[i] > 256) + ln[i] = 256 + + # Look it up in the table. + ln[i] = trnsfrm[ln[i]+257] + } else if (wavelength == 10830) { + # 10830 spectroheliogram, nonlinear greyscale. + # Make data fit in the table. + if (ln[i] < -1000) + ln[i] = -1000 + if (ln[i] > 90) + ln[i] = 90 + # Look it up in the table. + ln[i] = lkup10830[ln[i]+1001] + } else { + # Unknown type, linear greyscale. + if (ln[i] < 1) + ln[i] = 1 + if (ln[i] > 255) + ln[i] = 255 + } + } + + # Set stuff outside the limb to zero. + do i = 1, left + ln[i] = 0 + do i = right, xlength + ln[i] = 0 + } else { + # This line is off the limb, set it to zero. + do i = 1, xlength + ln[i] = 0 + } +end diff --git a/noao/imred/vtel/tcopy.par b/noao/imred/vtel/tcopy.par new file mode 100644 index 000000000..4facf8274 --- /dev/null +++ b/noao/imred/vtel/tcopy.par @@ -0,0 +1,5 @@ +inputfile,s,q,,,,Input file descriptor +files,s,q,,,,List of files to be examined +outputfile,s,q,,,,Output file descriptor +new_tape,b,q,,,,Are you using a new tape? +verbose,b,h,no,,,Print out header data and give progress reports diff --git a/noao/imred/vtel/tcopy.x b/noao/imred/vtel/tcopy.x new file mode 100644 index 000000000..427095635 --- /dev/null +++ b/noao/imred/vtel/tcopy.x @@ -0,0 +1,190 @@ +include +include +include +include +include "vt.h" + +define SZ_VTRECFD 5120 # length, in chars, of full disk recs +define YABUF 20000 # Yet Another BUFfer +define SWAP {temp=$1;$1=$2;$2=temp} +define MAX_RANGES 100 + +# TCOPY -- This is an asynchronous tape to tape copy routine. It considers +# the input and output to be streaming devices. +# The user specifies which files on tape s/he wants and a root name for the +# output file names. + +procedure t_tcopy() + +char inputfile[SZ_FNAME] +char files[SZ_LINE] +char outputfile[SZ_FNAME] + +char tapename[SZ_FNAME] +int filerange[2 * MAX_RANGES + 1] +int nfiles, filenumber, numrecords, whichfile +bool verbose + +int decode_ranges(), mtfile() +int get_next_number(), tapecopy(), mtneedfileno() +bool clgetb() +errchk tapecopy + +begin + call fseti (STDOUT, F_FLUSHNL, YES) + + # Get input file(s). + call clgstr ("inputfile", inputfile, SZ_FNAME) + if (mtfile (inputfile) == NO || mtneedfileno (inputfile) == NO) { + call strcpy ("1", files, SZ_LINE) + } else { + call clgstr ("files", files, SZ_LINE) + } + + if (decode_ranges (files, filerange, MAX_RANGES, nfiles) == ERR) + call error (0, "Illegal file number list.") + + # Get the output file from the cl. + call clgstr ("outputfile", outputfile, SZ_FNAME) + + # See if the output is mag tape, if not, error. + if (mtfile (outputfile) == NO) + call error (1, "Outputfile should be magnetic tape.") + + # If no tape file number is given, then ask whether the tape + # is blank or contains data. If blank then start at [1], else + # start at [EOT]. + + if (mtneedfileno(outputfile) == YES) + if (!clgetb ("new_tape")) + call mtfname (outputfile, EOT, outputfile, SZ_FNAME) + else + call mtfname (outputfile, 1, outputfile, SZ_FNAME) + + # Get verbose flag. + verbose = clgetb ("verbose") + + # Loop over files + whichfile = 1 + filenumber = 0 + while (get_next_number (filerange, filenumber) != EOF) { + + # Assemble the appropriate tape file name. + if (mtneedfileno (inputfile) == NO) + call strcpy (inputfile, tapename, SZ_FNAME) + else + call mtfname (inputfile, filenumber, tapename, SZ_FNAME) + + if (whichfile > 1) { + # Assemble the appropriate output file name. + call mtfname (outputfile, EOT, outputfile, SZ_FNAME) + } + + if (verbose) { + call printf ("reading %s, writing %s\n") + call pargstr(tapename) + call pargstr(outputfile) + } + + iferr { + numrecords = tapecopy (tapename, outputfile) + } then { + call eprintf ("Error copying file: %s\n") + call pargstr (tapename) + call erract (EA_WARN) + next + } else if (numrecords == 0) { + call printf ("Tape at EOT\n") + break + } + whichfile = whichfile + 1 + + } # End while. +end + + +# TAPECOPY -- This is the actual tape to tape copy routine. + +int procedure tapecopy (infile, outfile) + +char infile[SZ_FNAME] +char outfile[SZ_FNAME] + +pointer bufa, bufb, temp +int bufsz, numrecords +int nbytes, lastnbytes, in, out +int fstati(), mtopen(), awaitb() +errchk mtopen, areadb, awriteb, awaitb + +begin + # Open input file, see if it has anything in it. If not, return. + in = mtopen (infile, READ_ONLY, 0) + + bufsz = fstati (in, F_MAXBUFSIZE) # Maximum output buffer size. + if (bufsz == 0) # If no max, set a max. + bufsz = YABUF + + call malloc (bufa, bufsz, TY_CHAR) # Allocate output buffer. + call malloc (bufb, bufsz, TY_CHAR) # Other output buffer + + call areadb (in, Memc[bufa], bufsz, 0) + nbytes = awaitb (in) + if (nbytes == EOF) { + call close (in) + call mfree (bufa, TY_CHAR) + call mfree (bufb, TY_CHAR) + return (EOF) + } + + # Open the output file. + out = mtopen (outfile, WRITE_ONLY, 0) + + lastnbytes = 0 # Last record size memory. + numrecords = 0 # Number of records read. + + if (nbytes > 0) { + if (nbytes > SZ_VTRECFD*SZB_SHORT && + nbytes < SZ_VTRECFD*SZB_SHORT+600) + nbytes = SZ_VTRECFD*SZB_SHORT + call awriteb (out, Memc[bufa], nbytes, 0) + call areadb (in, Memc[bufb], bufsz, 0) + numrecords = numrecords + 1 + } + + SWAP (bufa, bufb) + + # Main Loop. + repeat { + if (awaitb (out) != nbytes) { + call printf ("Write error, record = %d.\n") + call pargi (numrecords+1) + } + + nbytes = awaitb (in) + if (nbytes == ERR) { + call printf ("Read error, record = %d.\n") + call pargi (numrecords+1) + nbytes = lastnbytes + } + lastnbytes = nbytes + + if (nbytes > 0) { + if (nbytes > SZ_VTRECFD*SZB_SHORT && + nbytes < SZ_VTRECFD*SZB_SHORT+600) + nbytes = SZ_VTRECFD*SZB_SHORT + call awriteb (out, Memc[bufa], nbytes, 0) + call areadb (in, Memc[bufb], bufsz, 0) + numrecords = numrecords + 1 + } + + SWAP (bufa, bufb) + + } until (nbytes == 0) # all done + + call mfree (bufa, TY_CHAR) + call mfree (bufb, TY_CHAR) + call close (in) + call close (out) + + return (numrecords) +end diff --git a/noao/imred/vtel/textim.x b/noao/imred/vtel/textim.x new file mode 100644 index 000000000..4ca5a8c1b --- /dev/null +++ b/noao/imred/vtel/textim.x @@ -0,0 +1,114 @@ +include +include + +define FONTWIDE 6 +define FONTHIGH 7 +define MAXSTRING 100 + +# TEXTIM -- Write a text string into an image using a pixel font for speed. +# Characters are made twice as big as the font by doubling in both axes. + +procedure textim (im, s, x, y, xmag, ymag, value, zerobgnd, bgndvalu) + +pointer im # Image to put the text in. +char s[MAXSTRING] # Text to put in the image. +int x, y # x, y position in the image. +int xmag, ymag # x, y magnification values. +int value # Value to use in image for text. +int zerobgnd # Flag to tell if we should zero bgnd. +int bgndvalu # Background value to use. + +int numrow, numcol, numchars +int fonthigh, fontwide +int i, l, ch +int nchar, line +int pixary[5] +pointer lineget, lineput + +short tshort +int strlen() +pointer imgl2s(), impl2s() +errchk imgl2s, impl2s + +begin + # Find the length of the string (if there aren't any chars, return). + numchars = strlen (s) + if (numchars <= 0) + return + + # Calculate height and width of magnified font. + fonthigh = FONTHIGH * ymag + fontwide = FONTWIDE * xmag + + # Check for row/col out of bounds. + numcol= IM_LEN(im,1) + numrow = IM_LEN(im,2) + + if (x <= 0) { + call printf ("Warning: Image text deleted, column <= 0.\n") + return + } + + if (x > numcol - fontwide*numchars) { + call printf ("Warning: Image text truncated or deleted\n") + numchars = int((numcol - x)/fontwide) + if (numchars <= 0) + return + } + + if ((y <= 0) || (y > numrow - fonthigh)) { + call printf ("Warning: Image text deleted, wrong row number.\n") + return + } + + # For each line of the text (backward). + for (i=7; i>=1; i=i-1) { + line = y+(8-i)*ymag-1 + + do l = 1, ymag { + + # Get and put the line of the image. + lineget = imgl2s (im, line+(l-1)) + lineput = impl2s (im, line+(l-1)) + + # Copy input array or the background value to output array. + if (zerobgnd == 1) { + tshort = bgndvalu + call amovks (tshort, Mems[lineput+x-1], + fontwide*numchars) + } else + call amovs (Mems[lineget], Mems[lineput], numcol) + + # Put the font. + do ch = 1, numchars { + nchar = int(s[ch]) + call pixbit (nchar, i, pixary) + call putpix (pixary, Mems[lineput], numcol, + x+(ch-1)*fontwide, value, xmag) + } + } # End of do on l. + } +end + + +# PUTPIX -- Put one line of one character into the data array. + +procedure putpix (pixary, array, size, position, value, xmag) + +int pixary[5] # array of pixels in character +int size, position # size of data array +short array[size] # data array in which to put character line +int value # value to use for character pixels +int xmag # x-magnification of text + +int i, k, x + +begin + do i = 1, 5 { + if (pixary[i] == 1) { + x = position + (i-1) * xmag + do k = 1, xmag + array[x+(k-1)] = value + } + } +end diff --git a/noao/imred/vtel/trim.par b/noao/imred/vtel/trim.par new file mode 100644 index 000000000..49e6184e7 --- /dev/null +++ b/noao/imred/vtel/trim.par @@ -0,0 +1,2 @@ +image,s,q,,,,Image name +threshold,i,q,,0,15,Squibby brightness threshold for limb diff --git a/noao/imred/vtel/trim.x b/noao/imred/vtel/trim.x new file mode 100644 index 000000000..8e76489b3 --- /dev/null +++ b/noao/imred/vtel/trim.x @@ -0,0 +1,75 @@ +include +include +include "vt.h" + +# TRIM -- Trim a full disk image using the squibby brightness template. +# Leave all the squibby brightness information intact, set data outside the +# limb to zero. + +procedure t_trim() + +char image[SZ_FNAME] # image to trim +int threshold # squibby brightness threshold defining limb + +int i, numpix +pointer im, lgp, lpp +pointer immap(), imgl2s(), impl2s() +int clgeti() +errchk immap, imgl2s, impl2s + +begin + # Get parameters from the CL. + call clgstr ("image", image, SZ_FNAME) + threshold = clgeti("threshold") + + # Open image. + im = immap (image, READ_WRITE, 0) + + do i = 1, IM_LEN(im,2) { + lgp = imgl2s (im, i) + lpp = impl2s (im, i) + numpix = IM_LEN(im,1) + call trimline (Mems[lgp], Mems[lpp], numpix, threshold) + } + + # Unmap image. + call imunmap (im) +end + + +# TRIMLINE -- trim line1 and put it into line2. + +procedure trimline (line1, line2, numpix, threshold) + +short line1[numpix] # input line +short line2[numpix] # output line +int numpix # number of pixels in this line +int threshold # squibby brightness threshold + +int i, left, right + +begin + left = 0 + right = 0 + + do i = 1, numpix { + if (and(int(line1[i]),17B) >= threshold) { + left = i + break + } else + line2[i] = and(int(line1[i]),17B) + } + + if (left != 0) + do i = numpix, 1, -1 { + if(and(int(line1[i]),17B) >= threshold) { + right = i + break + } else + line2[i] = and(int(line1[i]),17B) + } + + if (left != 0 && right != 0 && left < right) + do i = left, right + line2[i] = line1[i] +end diff --git a/noao/imred/vtel/trnsfrm.inc b/noao/imred/vtel/trnsfrm.inc new file mode 100644 index 000000000..b916b126d --- /dev/null +++ b/noao/imred/vtel/trnsfrm.inc @@ -0,0 +1,163 @@ +data (trnsfrm[i], i = 1, 10) /56,56,56,56,57,57,57,57,58,58/ +data (trnsfrm[i], i = 11, 20) /58,58,59,59,59,59,60,60,60,60/ +data (trnsfrm[i], i = 21, 30) /61,61,61,61,62,62,62,63,63,63/ +data (trnsfrm[i], i = 31, 40) /63,64,64,64,64,65,65,65,65,66/ +data (trnsfrm[i], i = 41, 50) /66,66,67,67,67,67,68,68,68,68/ +data (trnsfrm[i], i = 51, 60) /69,69,69,70,70,70,70,71,71,71/ +data (trnsfrm[i], i = 61, 70) /71,72,72,72,73,73,73,73,74,74/ +data (trnsfrm[i], i = 71, 80) /74,75,75,75,75,76,76,76,77,77/ +data (trnsfrm[i], i = 81, 90) /77,77,78,78,78,79,79,79,79,80/ +data (trnsfrm[i], i = 91, 100) /80,80,81,81,81,82,82,82,82,83/ +data (trnsfrm[i], i = 101, 110) /83,83,84,84,84,85,85,85,85,86/ +data (trnsfrm[i], i = 111, 120) /86,86,87,87,87,88,88,88,89,89/ +data (trnsfrm[i], i = 121, 130) /89,90,90,90,90,91,91,91,92,92/ +data (trnsfrm[i], i = 131, 140) /92,93,93,93,94,94,94,95,95,95/ +data (trnsfrm[i], i = 141, 150) /96,96,96,97,97,97,98,98,98,99/ +data (trnsfrm[i], i = 151, 160) /99,99,100,100,101,101,101,102,102,102/ +data (trnsfrm[i], i = 161, 170) /103,103,103,104,104,104,105,105,106,106/ +data (trnsfrm[i], i = 171, 180) /106,107,107,107,108,108,109,109,109,110/ +data (trnsfrm[i], i = 181, 190) /110,110,111,111,112,112,112,113,113,114/ +data (trnsfrm[i], i = 191, 200) /114,114,115,115,116,116,117,117,117,118/ +data (trnsfrm[i], i = 201, 210) /118,119,119,120,120,120,121,121,122,122/ +data (trnsfrm[i], i = 211, 220) /123,123,124,124,125,125,126,126,127,127/ +data (trnsfrm[i], i = 221, 230) /128,128,129,129,130,130,131,131,132,132/ +data (trnsfrm[i], i = 231, 240) /133,133,134,135,135,136,136,137,138,138/ +data (trnsfrm[i], i = 241, 250) /139,140,140,141,142,143,143,144,145,146/ +data (trnsfrm[i], i = 251, 260) /147,148,149,150,151,153,156,158,160,161/ +data (trnsfrm[i], i = 261, 270) /162,163,164,165,166,167,168,168,169,170/ +data (trnsfrm[i], i = 271, 280) /171,171,172,173,173,174,175,175,176,176/ +data (trnsfrm[i], i = 281, 290) /177,178,178,179,179,180,180,181,181,182/ +data (trnsfrm[i], i = 291, 300) /182,183,183,184,184,185,185,186,186,187/ +data (trnsfrm[i], i = 301, 310) /187,188,188,189,189,190,190,191,191,191/ +data (trnsfrm[i], i = 311, 320) /192,192,193,193,194,194,194,195,195,196/ +data (trnsfrm[i], i = 321, 330) /196,197,197,197,198,198,199,199,199,200/ +data (trnsfrm[i], i = 331, 340) /200,201,201,201,202,202,202,203,203,204/ +data (trnsfrm[i], i = 341, 350) /204,204,205,205,205,206,206,207,207,207/ +data (trnsfrm[i], i = 351, 360) /208,208,208,209,209,209,210,210,210,211/ +data (trnsfrm[i], i = 361, 370) /211,212,212,212,213,213,213,214,214,214/ +data (trnsfrm[i], i = 371, 380) /215,215,215,216,216,216,217,217,217,218/ +data (trnsfrm[i], i = 381, 390) /218,218,219,219,219,220,220,220,221,221/ +data (trnsfrm[i], i = 391, 400) /221,221,222,222,222,223,223,223,224,224/ +data (trnsfrm[i], i = 401, 410) /224,225,225,225,226,226,226,226,227,227/ +data (trnsfrm[i], i = 411, 420) /227,228,228,228,229,229,229,229,230,230/ +data (trnsfrm[i], i = 421, 430) /230,231,231,231,232,232,232,232,233,233/ +data (trnsfrm[i], i = 431, 440) /233,234,234,234,234,235,235,235,236,236/ +data (trnsfrm[i], i = 441, 450) /236,236,237,237,237,238,238,238,238,239/ +data (trnsfrm[i], i = 451, 460) /239,239,240,240,240,240,241,241,241,241/ +data (trnsfrm[i], i = 461, 470) /242,242,242,243,243,243,243,244,244,244/ +data (trnsfrm[i], i = 471, 480) /244,245,245,245,246,246,246,246,247,247/ +data (trnsfrm[i], i = 481, 490) /247,247,248,248,248,248,249,249,249,250/ +data (trnsfrm[i], i = 491, 500) /250,250,250,251,251,251,251,252,252,252/ +data (trnsfrm[i], i = 501, 510) /252,253,253,253,253,254,254,254,254,255/ +data (trnsfrm[i], i = 511, 513) /255,255,255/ + +data (lkup10830[i], i = 1, 10) /50,50,50,50,50,50,50,50,50,50/ +data (lkup10830[i], i = 11, 20) /50,50,50,50,50,50,50,50,50,50/ +data (lkup10830[i], i = 21, 30) /50,50,50,50,50,50,50,50,50,50/ +data (lkup10830[i], i = 31, 40) /51,51,51,51,51,51,51,51,51,51/ +data (lkup10830[i], i = 41, 50) /51,51,51,51,51,51,51,51,51,51/ +data (lkup10830[i], i = 51, 60) /51,51,51,51,51,51,51,51,51,51/ +data (lkup10830[i], i = 61, 70) /51,51,51,51,51,51,51,51,51,51/ +data (lkup10830[i], i = 71, 80) /51,51,51,51,51,51,51,51,51,51/ +data (lkup10830[i], i = 81, 90) /51,51,51,51,51,51,51,51,51,51/ +data (lkup10830[i], i = 91, 100) /51,51,51,51,51,51,51,51,51,51/ +data (lkup10830[i], i = 101, 110) /51,51,51,51,51,51,51,51,51,51/ +data (lkup10830[i], i = 111, 120) /51,51,51,51,51,51,51,51,51,51/ +data (lkup10830[i], i = 121, 130) /51,51,51,51,51,51,51,51,51,51/ +data (lkup10830[i], i = 131, 140) /51,51,51,51,51,51,51,51,51,51/ +data (lkup10830[i], i = 141, 150) /51,51,51,51,51,51,51,51,51,51/ +data (lkup10830[i], i = 151, 160) /51,51,51,51,51,51,51,51,51,51/ +data (lkup10830[i], i = 161, 170) /51,51,51,51,51,51,51,51,51,51/ +data (lkup10830[i], i = 171, 180) /51,51,51,51,51,51,51,51,51,51/ +data (lkup10830[i], i = 181, 190) /51,51,51,51,51,51,51,51,51,51/ +data (lkup10830[i], i = 191, 200) /51,51,51,51,51,51,51,51,51,51/ +data (lkup10830[i], i = 201, 210) /51,51,51,51,51,51,51,51,51,51/ +data (lkup10830[i], i = 211, 220) /51,51,51,51,51,51,51,51,51,51/ +data (lkup10830[i], i = 221, 230) /51,51,51,51,51,51,51,51,51,51/ +data (lkup10830[i], i = 231, 240) /51,51,52,52,52,52,52,52,52,52/ +data (lkup10830[i], i = 241, 250) /52,52,52,52,52,52,52,52,52,52/ +data (lkup10830[i], i = 251, 260) /52,52,52,52,52,52,52,52,52,52/ +data (lkup10830[i], i = 261, 270) /52,52,52,52,52,52,52,52,52,52/ +data (lkup10830[i], i = 271, 280) /52,52,52,52,52,52,52,52,52,52/ +data (lkup10830[i], i = 281, 290) /52,52,52,52,52,52,52,52,52,52/ +data (lkup10830[i], i = 291, 300) /52,52,52,52,52,52,52,52,52,52/ +data (lkup10830[i], i = 301, 310) /52,52,52,53,53,53,53,53,53,53/ +data (lkup10830[i], i = 311, 320) /53,53,53,53,53,53,53,53,53,53/ +data (lkup10830[i], i = 321, 330) /53,53,53,53,53,53,53,53,53,53/ +data (lkup10830[i], i = 331, 340) /53,53,53,53,53,53,53,53,53,54/ +data (lkup10830[i], i = 341, 350) /54,54,54,54,54,54,54,54,54,54/ +data (lkup10830[i], i = 351, 360) /54,54,54,54,54,54,54,54,54,54/ +data (lkup10830[i], i = 361, 370) /54,54,54,54,54,55,55,55,55,55/ +data (lkup10830[i], i = 371, 380) /55,55,55,55,55,55,55,55,55,55/ +data (lkup10830[i], i = 381, 390) /55,55,55,55,55,55,55,56,56,56/ +data (lkup10830[i], i = 391, 400) /56,56,56,56,56,56,56,56,56,56/ +data (lkup10830[i], i = 401, 410) /56,56,56,56,56,57,57,57,57,57/ +data (lkup10830[i], i = 411, 420) /57,57,57,57,57,57,57,57,57,57/ +data (lkup10830[i], i = 421, 430) /57,57,58,58,58,58,58,58,58,58/ +data (lkup10830[i], i = 431, 440) /58,58,58,58,58,58,58,59,59,59/ +data (lkup10830[i], i = 441, 450) /59,59,59,59,59,59,59,59,59,59/ +data (lkup10830[i], i = 451, 460) /59,60,60,60,60,60,60,60,60,60/ +data (lkup10830[i], i = 461, 470) /60,60,60,60,60,61,61,61,61,61/ +data (lkup10830[i], i = 471, 480) /61,61,61,61,61,61,61,62,62,62/ +data (lkup10830[i], i = 481, 490) /62,62,62,62,62,62,62,62,62,63/ +data (lkup10830[i], i = 491, 500) /63,63,63,63,63,63,63,63,63,63/ +data (lkup10830[i], i = 501, 510) /63,64,64,64,64,64,64,64,64,64/ +data (lkup10830[i], i = 511, 520) /64,64,65,65,65,65,65,65,65,65/ +data (lkup10830[i], i = 521, 530) /65,65,65,66,66,66,66,66,66,66/ +data (lkup10830[i], i = 531, 540) /66,66,66,67,67,67,67,67,67,67/ +data (lkup10830[i], i = 541, 550) /67,67,67,67,68,68,68,68,68,68/ +data (lkup10830[i], i = 551, 560) /68,68,68,68,69,69,69,69,69,69/ +data (lkup10830[i], i = 561, 570) /69,69,69,70,70,70,70,70,70,70/ +data (lkup10830[i], i = 571, 580) /70,70,70,71,71,71,71,71,71,71/ +data (lkup10830[i], i = 581, 590) /71,71,72,72,72,72,72,72,72,72/ +data (lkup10830[i], i = 591, 600) /72,73,73,73,73,73,73,73,73,73/ +data (lkup10830[i], i = 601, 610) /74,74,74,74,74,74,74,74,74,75/ +data (lkup10830[i], i = 611, 620) /75,75,75,75,75,75,75,75,76,76/ +data (lkup10830[i], i = 621, 630) /76,76,76,76,76,76,77,77,77,77/ +data (lkup10830[i], i = 631, 640) /77,77,77,77,78,78,78,78,78,78/ +data (lkup10830[i], i = 641, 650) /78,78,78,79,79,79,79,79,79,79/ +data (lkup10830[i], i = 651, 660) /79,80,80,80,80,80,80,80,80,81/ +data (lkup10830[i], i = 661, 670) /81,81,81,81,81,81,81,82,82,82/ +data (lkup10830[i], i = 671, 680) /82,82,82,82,82,83,83,83,83,83/ +data (lkup10830[i], i = 681, 690) /83,83,83,84,84,84,84,84,84,84/ +data (lkup10830[i], i = 691, 700) /85,85,85,85,85,85,85,85,86,86/ +data (lkup10830[i], i = 701, 710) /86,86,86,86,86,86,87,87,87,87/ +data (lkup10830[i], i = 711, 720) /87,87,87,88,88,88,88,88,88,88/ +data (lkup10830[i], i = 721, 730) /88,89,89,89,89,89,89,89,90,90/ +data (lkup10830[i], i = 731, 740) /90,90,90,90,90,91,91,91,91,91/ +data (lkup10830[i], i = 741, 750) /91,91,91,92,92,92,92,92,92,92/ +data (lkup10830[i], i = 751, 760) /93,93,93,93,93,93,93,94,94,94/ +data (lkup10830[i], i = 761, 770) /94,94,94,95,95,95,95,95,95,95/ +data (lkup10830[i], i = 771, 780) /96,96,96,96,96,96,97,97,97,97/ +data (lkup10830[i], i = 781, 790) /97,97,98,98,98,98,98,98,99,99/ +data (lkup10830[i], i = 791, 800) /99,99,99,99,100,100,100,100,100,101/ +data (lkup10830[i], i = 801, 810) /101,101,101,101,101,102,102,102,102,102/ +data (lkup10830[i], i = 811, 820) /103,103,103,103,103,104,104,104,104,104/ +data (lkup10830[i], i = 821, 830) /105,105,105,105,106,106,106,106,106,107/ +data (lkup10830[i], i = 831, 840) /107,107,107,108,108,108,108,108,109,109/ +data (lkup10830[i], i = 841, 850) /109,109,110,110,110,110,111,111,111,111/ +data (lkup10830[i], i = 851, 860) /112,112,112,113,113,113,113,114,114,114/ +data (lkup10830[i], i = 861, 870) /114,115,115,115,116,116,116,116,117,117/ +data (lkup10830[i], i = 871, 880) /117,118,118,118,118,119,119,119,120,120/ +data (lkup10830[i], i = 881, 890) /120,121,121,121,122,122,122,123,123,123/ +data (lkup10830[i], i = 891, 900) /124,124,124,125,125,125,126,126,126,127/ +data (lkup10830[i], i = 901, 910) /127,128,128,128,129,129,129,130,130,131/ +data (lkup10830[i], i = 911, 920) /131,131,132,132,132,133,133,134,134,135/ +data (lkup10830[i], i = 921, 930) /135,135,136,136,137,137,137,138,138,139/ +data (lkup10830[i], i = 931, 940) /139,140,140,141,141,141,142,142,143,143/ +data (lkup10830[i], i = 941, 950) /144,144,145,145,146,146,147,147,148,148/ +data (lkup10830[i], i = 951, 960) /149,149,150,150,151,151,152,152,153,153/ +data (lkup10830[i], i = 961, 970) /154,154,155,155,156,156,157,158,158,159/ +data (lkup10830[i], i = 971, 980) /159,160,160,161,162,162,163,163,164,164/ +data (lkup10830[i], i = 981, 990) /165,166,166,167,167,168,169,169,170,171/ +data (lkup10830[i], i = 991, 1000) /171,172,173,173,174,174,175,176,176,177/ +data (lkup10830[i], i = 1001, 1010) /178,178,179,180,180,181,182,183,183,184/ +data (lkup10830[i], i = 1011, 1020) /185,185,186,187,187,188,189,190,190,191/ +data (lkup10830[i], i = 1021, 1030) /192,193,193,194,195,196,196,197,198,199/ +data (lkup10830[i], i = 1031, 1040) /200,200,201,202,203,203,204,205,206,207/ +data (lkup10830[i], i = 1041, 1050) /208,208,209,210,211,212,213,213,214,215/ +data (lkup10830[i], i = 1051, 1060) /216,217,218,219,220,220,221,222,223,224/ +data (lkup10830[i], i = 1061, 1070) /225,226,227,228,229,230,230,231,232,233/ +data (lkup10830[i], i = 1071, 1080) /234,235,236,237,238,239,240,241,242,243/ +data (lkup10830[i], i = 1081, 1090) /244,245,246,247,248,249,250,251,252,253/ +data (lkup10830[i], i = 1091, 1091) /254/ diff --git a/noao/imred/vtel/unwrap.par b/noao/imred/vtel/unwrap.par new file mode 100644 index 000000000..1a1d35044 --- /dev/null +++ b/noao/imred/vtel/unwrap.par @@ -0,0 +1,9 @@ +image,s,a,,,,image +outimage,s,a,,,,outimage +threshold1,i,h,128,,,threshold for first unwrap +wrapval1,i,h,256,,,wrap displacement for first unwrap +threshold2,i,h,128,,,threshold for second unwrap +wrapval2,i,h,256,,,wrap displacement for second unwrap +cstart,i,h,2,,,column start +step,i,h,5,,,number of steps to take +verbose,b,h,yes,,,verbose flag diff --git a/noao/imred/vtel/unwrap.x b/noao/imred/vtel/unwrap.x new file mode 100644 index 000000000..a753ddf41 --- /dev/null +++ b/noao/imred/vtel/unwrap.x @@ -0,0 +1,293 @@ +include +include + +define MAXBADLINES 20 # maximum number of bad lines +define BADTHRESH 1000 # threshold for bad lines +define FIXWIDTH 20 # Width of average for fixline + +# UNWRAP -- Filter an iraf image. This filter checks for binary wraparound +# in IRAF images. The algorithm is described in detail in the help page. +# The program accepts templates for both input and output image lists. + +procedure t_unwrap() + +char image[SZ_FNAME] # input image template +char outimage[SZ_FNAME] # output image template +int threshold1 # threshold value for first unwrap +int threshold2 # threshold value for second unwrap +int wrapval1 # wrapvalue for first unwrap +int wrapval2 # wrapvalue for second unwrap +int cstart # column to start on +int step # number of steps to perform +bool verbose # verbose flag + +int i, j +int listin, listout +int length, nlines +int badlines[MAXBADLINES] +int diff, nbad +char tempimage[SZ_FNAME] +pointer im, imout, lgp, lgp2, lpp, cck, sp + +bool clgetb() +int imtopenp(), imtlen(), imtgetim(), clgeti() +pointer immap(), imgl2s(), impl2s() +errchk immap, imgl2s, impl2s + +begin + # Get parameters from the CL. + listin = imtopenp ("image") + listout = imtopenp ("outimage") + threshold1 = clgeti("threshold1") + wrapval1 = clgeti("wrapval1") + threshold2 = clgeti("threshold2") + wrapval2 = clgeti("wrapval2") + cstart = clgeti("cstart") + step = clgeti("step") + verbose = clgetb("verbose") + + if (verbose) { + call printf ("\n\nUNWRAP: ") + call printf ("threshold1 = %d\n") + call pargi (threshold1) + call printf ("\twrapval1 = %d\n") + call pargi (wrapval1) + call printf ("\tthreshold2 = %d\n") + call pargi (threshold2) + call printf ("\twrapval2 = %d\n") + call pargi (wrapval2) + call printf ("\tcstart = %d\n") + call pargi (cstart) + call printf ("\tstep = %d\n\n") + call pargi (step) + call flush (STDOUT) + } + + # Check the number of elements. + if (imtlen (listin) != imtlen (listout)) { + call imtclose (listin) + call imtclose (listout) + call error (1, "Wrong number of elements in the operand lists") + } + + # Get the next images from the lists. + while (imtgetim (listin, image, SZ_FNAME) != EOF) { + if (imtgetim (listout, outimage, SZ_FNAME) != EOF) { + + if (verbose) { + # Write out about the input file name and output file name. + call printf ("\tUnwrapping %s into %s. ") + call pargstr (image) + call pargstr (outimage) + call flush (STDOUT) + } + + # Open images. + iferr { + im = immap (image, READ_WRITE, 0) + } then { + call eprintf ("Cannot open image %s.\n") + call pargstr (image) + next + } + + call xt_mkimtemp (image, outimage, tempimage, SZ_FNAME) + + iferr { + imout = immap (outimage, NEW_COPY, im) + } then { + call eprintf ("Cannot open image %s, (already exists?).\n") + call pargstr (outimage) + next + } + + length = IM_LEN(im,1) + nlines = IM_LEN(im,2) + + # Set up the column check array, then unwrap line by line. + call smark (sp) + call salloc (cck, nlines, TY_INT) + call amovks (0, Memi[cck], nlines) + do i = 1, nlines { + lgp = imgl2s (im, i) + lpp = impl2s (imout, i) + call unwrapline (Mems[lgp], Mems[lpp], cck, length, + threshold1, wrapval1, threshold2, wrapval2, cstart, + step, i) + } + + # Step 5 is the final step. (fixline) + if (step == 5) { + # Analyze the column, check for wraps. + nbad = 0 + do i = 2, nlines { + diff = Memi[cck+i-1] - Memi[cck+i-2] + if (abs(diff) > BADTHRESH) { + # Mark this line bad. + nbad = nbad + 1 + if (nbad > MAXBADLINES) + break + badlines[nbad] = i + } + } + } + + # If number bad lines <= than MAXBADLINES, fix em, else, quit. + if (nbad <= MAXBADLINES && nbad > 0) { + do i = 1, nbad { + + # GET the lines above and below the bad line and PUT the + # bad line. Then average the above and below lines and + # save in the bad line. + + if (badlines[i] != 1 && badlines[i] != nlines) { + if ((badlines[i+1] - badlines[i]) == 1) { + lgp = imgl2s (imout, badlines[i]-1) + lgp2 = imgl2s (imout, badlines[i]+1) + lpp = impl2s (imout, badlines[i]) + do j = 1, length { + Mems[lpp+j-1] = int((real(Mems[lgp+j-1]) + + real(Mems[lgp2+j-1]))/2. + .5) + } + } + } + } + } + + if (verbose) { + call printf ("number of bad lines = %d\n") + call pargi (nbad) + do i = 1, nbad { + call printf ("\tbadlines[%d] = %d\n") + call pargi (i) + call pargi (badlines[i]) + } + call printf ("\n") + call flush (STDOUT) + } + + # Unmap images. + call imunmap (im) + call imunmap (imout) + call xt_delimtemp (outimage, tempimage) + call sfree (sp) + + } # End of if (not EOF) + } # End of while loop on input images + + call imtclose (listin) + call imtclose (listout) +end + + +# UNWRAPLINE -- Unwrap a line of the image. + +procedure unwrapline (line1, line2, cck, numpix, threshold1, wrapval1, + threshold2, wrapval2, cstart, step, whichline) + +short line1[numpix] # input line +short line2[numpix] # output line +pointer cck # pointer to array for column check +int numpix # number of pixels per line +int threshold1 # unwrap threshold for first unwrap +int wrapval1 # unwrap value for first unwrap +int threshold2 # unwrap threshold for second unwrap +int wrapval2 # unwrap value for second unwrap +int cstart # column to start on +int step # steps to complete +int whichline # which line this is we are unwrapping + +pointer tl1, tl2, tl3 # pointers of temporary arrays +pointer sp # stack pointer +int i, diff, sum +short wrap # wrap number + +begin + # Mark the stack and allcoate the temporary arrays. + call smark (sp) + call salloc (tl1, numpix, TY_SHORT) + call salloc (tl2, numpix, TY_SHORT) + call salloc (tl3, numpix, TY_SHORT) + + # Initialize wrap. + wrap = 0 + + # Copy the input line into the output line and the temporary arrays. + call amovs (line1, line2, numpix) + call amovs (line1, Mems[tl1], numpix) + call amovs (line1, Mems[tl2], numpix) + call amovs (line1, Mems[tl3], numpix) + + # Check the image width, do various things if the image is too small. + + # Too small for anything. + if (numpix <= 4) { + call sfree (sp) + return + } + + # Too small for step 5 (fixline). + if (numpix <= FIXWIDTH && step == 5) + step = 4 + + # Unwrap1 (step 1). + Mems[tl1+cstart-1] = line1[cstart] + do i = cstart+1, numpix { + diff = line1[i] - line1[i-1] + if (diff < -threshold1) + wrap = wrap + 1 + if (diff > threshold1) + wrap = wrap - 1 + + Mems[tl1+i-1] = line1[i] + wrap * wrapval1 + } + if (step == 1) { + call amovs (Mems[tl1], line2, numpix) + call sfree (sp) + return + } + + # If the user wants it, step 2 (dif). + do i = cstart, numpix + Mems[tl2+i-1] = Mems[tl1+i-1] - Mems[tl1+i-2] + + if (step == 2) { + call amovs (Mems[tl2], line2, numpix) + call sfree (sp) + return + } + + # If the user wants it, step 3 (unwrap2). + wrap = 0 + line2[cstart] = Mems[tl2+cstart-1] + do i = cstart+1, numpix { + diff = Mems[tl2+i-1] - Mems[tl2+i-2] + if (diff < -threshold2) + wrap = wrap + 1 + if (diff > threshold2) + wrap = wrap - 1 + + line2[i] = Mems[tl2+i-1] + wrap * wrapval2 + } + if (step == 3) { + call sfree (sp) + return + } + + # If the user wants it, step 4 (reconstruct). + do i = cstart, numpix + line2[i] = line2[i-1] + line2[i] + + if (step == 4) { + call sfree (sp) + return + } + + # Again, if the user wants it, save data for step 5, (fixline). + sum = 0 + do i = numpix-FIXWIDTH+1, numpix + sum = sum + line2[i] + Memi[cck+whichline-1] = int(real(sum)/real(FIXWIDTH) + .5) + + call sfree (sp) +end diff --git a/noao/imred/vtel/vt.h b/noao/imred/vtel/vt.h new file mode 100644 index 000000000..73d9c22af --- /dev/null +++ b/noao/imred/vtel/vt.h @@ -0,0 +1,73 @@ +# Vacuum_telescope analysis package header file. + +# General defines common to most of the programs in this package. +define DIM_VTFD 2048 # full disk image = 2048 x 2048 array +define SZB_SHORT SZ_SHORT*SZB_CHAR # number of bytes per short integer +define SZB_REAL SZ_REAL*SZB_CHAR # number of bytes per real +define THRESHOLD 4 # limb cutoff value, squib brightness + +# Defines related to the tape format. +define SZ_VTHDR 20 # number of 16-bit words in vt header +define SZ_VTREC 5120 # number of 16-bit words in vt record +define NUM_VTREC 750 # number of records in full disk image + +# Ellipse structure defines. +define LEN_ELSTRUCT 4 # real el[LEN_ELSTRUCT] + +define E_XCENTER $1[1] # x-coord of center of limb ellipse +define E_YCENTER $1[2] # y-coord of center of limb ellipse +define E_XSEMIDIAMETER $1[3] # length of x semiaxis of limb ellipse +define E_YSEMIDIAMETER $1[4] # length of y semiaxis of limb ellipse + +# Defines for readvt, etc. +define SWTH_HIGH 512 # height of each swath +define SWTHWID_14 1700 # width of swaths 1 and 4 +define SWTHWID_23 2048 # width of swaths 2 and 3 +define HALF_DIF 174 # one half of difference in swath widths +define SZ_TABLE 8192 # length of lookup table (16-bit words) +define NUM_SRSTR 16 # total # of subrasters in full disk +define LEN_HDRDAT 10 # length of header data +define NUM_SRSTR_X 4 # number of subrasters in x direction +define NUM_SRSTR_Y 4 # number of subrasters in y direction +define SRSTR_WID 512 # width of each subraster +define IS_DATA 1 # subswath data indicator +define DTSTRING 100 # length of date/time string + +# Defines for rmap, etc. +define DIM_IN_RAS 150 # y dimension for input image subraster +define DIM_SQUAREIM 180 # x or y dimension of daily projection + +# Defines for merge, etc. +define DIM_XCARMAP 360 # x dimension of carrington map +define SZ_WTBL 180 # size of weight table for merge + +# Mscan text (pixelfont) structure. +define LEN_TXSTRUCT 10 + +define TX_XPOS Memi[$1] # x position of start of text +define TX_YPOS Memi[$1+1] # y position of start of text +define TX_VALUE Memi[$1+2] # value to write text with +define PRINT_TEXT Memi[$1+3] # to text, or not to text (1=yes,0=no) +define ZERO_BGND Memi[$1+4] # fill background w/ VALU? (1=yes,0=no) +define BGND_VALU Memi[$1+5] # background value to use + +# Vacuum telescope header struture. +define VT_LENHSTRUCT 10 + +define VT_HMONTH Memi[$1] # month of observation (1-12) +define VT_HDAY Memi[$1+1] # day of observation (1-31) +define VT_HYEAR Memi[$1+2] # year (two digits) +define VT_HTIME Memi[$1+3] # time (seconds since midnight) +define VT_HWVLNGTH Memi[$1+4] # wavelength (angstroms) +define VT_HOBSTYPE Memi[$1+5] # observation type (0,1,2,3,or 4) +define VT_HAVINTENS Memi[$1+6] # average intensity +define VT_HNUMCOLS Memi[$1+7] # number of columns +define VT_HINTGPIX Memi[$1+8] # integrations per pixel +define VT_HREPTIME Memi[$1+9] # repitition time + +# I/O buffer structure. +define VT_LENBSTRUCT 3 + +define VT_BUFP Memi[$1] # pointer, top of i/o buf +define VT_BP Memi[$1+1] # pointer, current position in i/o buf +define VT_BUFBOT Memi[$1+2] # pointer, current bottom of i/o buf diff --git a/noao/imred/vtel/vtblink.cl b/noao/imred/vtel/vtblink.cl new file mode 100644 index 000000000..d9e51a61a --- /dev/null +++ b/noao/imred/vtel/vtblink.cl @@ -0,0 +1,150 @@ +#{ VTBLINK -- Blink successive frames of daily grams to check registration. + +# imname1,s,a,,,,Name of first image +# imname2,s,a,,,,Name of next image +# z1,r,h,-3000.0,,,Minimum graylevel to be displayed. +# z2,r,h,3000.0,,,Minimum graylevel to be displayed. + +{ + real zz1, zz2, offset, currentoffset + char im1name, im2name, framelog[4] + int im1long, im2long, currentframe, offscreenflag + + # initialize + print (" ") + print (" ") + print ("vtblink vtblink vtblink vtblink vtblink vtblink vtblink") + print (" ") + currentframe = 1 + offscreenflag = 0 + currentoffset = .72 # Start at the right side of the screen. + framelog[1] = "none" + framelog[2] = "none" + framelog[3] = "none" + framelog[4] = "none" + + # Get the gray scale. + zz1 = z1 + zz2 = z2 + + # Get the first frame from the user, display it, allow user to window. + im1name = imname1 + if (im1name == "end") { + bye + } + while (!access(im1name//".imh") && im1name != "end") { + print (im1name, "not accessable, try again") + im1name = imname1 + if (im1name == "end") { + bye + } + } + imgets (im1name, "L_ZERO") + im1long = real(imgets.value) + print ("Longitude of first image is ", im1long) + print ("Displaying frame.") + display (im1name, currentframe, xcenter=currentoffset, zrange=no, + zscale=no, z1=zz1, z2=zz2) + framelog[currentframe] = im1name + frame (currentframe) + print ("Now, please window this frame for the desired color table.") + window + + # Make all the color tables of the other 3 frames the same as this. + print ("Equalizing color tables of 4 frames, Please wait.") + lumatch (2, currentframe) + lumatch (3, currentframe) + lumatch (4, currentframe) + + # Get the next frame from the user. + im2name = imname2 + while (im2name == "stat") { + print ("Frame 1 contains image ", framelog[1]) + print ("Frame 2 contains image ", framelog[2]) + print ("Frame 3 contains image ", framelog[3]) + print ("Frame 4 contains image ", framelog[4]) + im2name = imname2 + } + if (im2name == "end") { + bye + } + while (!access(im2name//".imh") && im2name != "end") { + print (im2name, "not accessable, try again") + im2name = imname2 + if (im2name == "end") { + bye + } + } + imgets (im2name, "L_ZERO") + im2long = real(imgets.value) + print ("Longitude of this image is ", im2long) + + # While the user does not enter 'end' for the image name, keep going. + # also check the offscreenflag and exit it it becomes set. + while (im2name != 'end' && offscreenflag != 1) { + + # Calculate offset. subsequent images in general have smaller + # longitudes, that is, longitude decreases with time. + # If the new image has a larger longitude then fix up offset. + if (im1long < im2long) { + offset = real((im2long - 360) - im1long)/512. + } else { + offset = real(im2long - im1long)/512. + } + + # If we are getting too close to the left side, restart program. + if ((currentoffset+offset) <= .18) { + print("*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*") + print("* The next image would overlap the edge of the *") + print("* screen. Please restart the program with the last *") + print("* image. *") + print("*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*") + offscreenflag = 1 + } + + # Display the next image and blink it with the previously displayed + # image. + if (offscreenflag != 1) { + print ("Displaying frame.") + display (im2name, mod(currentframe,4)+1, + xcenter=currentoffset+offset, zscale=no, zrange=no, + z1=zz1, z2=zz2) + framelog[mod(currentframe,4)+1] = im2name + + # Return the user to the cl so s/he can do whatever s/he wants. + print(" ") + print("You are now in the cl, type 'bye' to return to vtlbink") + cl() + print(" ") + + # Update currentframe and print it out, update the offset. + currentframe = mod(currentframe,4)+1 + print ("The next frame to be used for display is frame ", + mod(currentframe,4)+1) + currentoffset += offset + + # Move image2 to image1 and then get a new image2 and loop back. + im1name = im2name + im1long = im2long + im2name = imname2 + while (im2name == "stat") { + print ("Frame 1 contains image ", framelog[1]) + print ("Frame 2 contains image ", framelog[2]) + print ("Frame 3 contains image ", framelog[3]) + print ("Frame 4 contains image ", framelog[4]) + im2name = imname2 + } + while (!access(im2name//".imh") && im2name != "end") { + print (im2name, "not accessable, try again") + im2name = imname2 + if (im2name == "end") { + bye + } + } + if (im2name != "end") { + imgets (im2name, "L_ZERO") + im2long = real(imgets.value) + } + } + } +} diff --git a/noao/imred/vtel/vtblink.par b/noao/imred/vtel/vtblink.par new file mode 100644 index 000000000..def7c1eb8 --- /dev/null +++ b/noao/imred/vtel/vtblink.par @@ -0,0 +1,4 @@ +imname1,s,a,,,,Name of first image +imname2,s,a,,,,Name of next image +z1,r,h,-3000.0,,,Minimum graylevel to be displayed. +z2,r,h,3000.0,,,Minimum graylevel to be displayed. diff --git a/noao/imred/vtel/vtel.cl b/noao/imred/vtel/vtel.cl new file mode 100644 index 000000000..2789034f5 --- /dev/null +++ b/noao/imred/vtel/vtel.cl @@ -0,0 +1,37 @@ +#{ VTEL -- Vacuum_telescope package. + +# load necessary packages +images +tv + +set vtel = "imred$vtel/" + +package vtel + +task readvt, + writevt, + unwrap, + quickfit, + getsqib, + putsqib, + mscan, + merge, + destreak, + trim, + vtexamine, + tcopy, + pimtext, + syndico, + dicoplot = "vtel$x_vtel.e" + +# scripts + +task vtblink = "vtel$vtblink.cl" +task writetape = "vtel$writetape.cl" +task destreak5 = "vtel$destreak5.cl" +task fitslogr = "vtel$fitslogr.cl" +task mrotlogr = "vtel$mrotlogr.cl" +task makeimages = "vtel$makeimages.cl" +task makehelium = "vtel$makehelium.cl" + +clbye() diff --git a/noao/imred/vtel/vtel.hd b/noao/imred/vtel/vtel.hd new file mode 100644 index 000000000..7e9e8a302 --- /dev/null +++ b/noao/imred/vtel/vtel.hd @@ -0,0 +1,28 @@ +# Help directory for the VACUUM package. + +$doc = "./doc/" + +vtel men=vtel$vtel.men, src=vtel$vtel.cl +destreak hlp=doc$destreak.hlp, src=vtel$destreak.x +destreak5 hlp=doc$destreak5.hlp, src=vtel$destreak5.cl +readvt hlp=doc$readvt.hlp, src=vtel$readvt.x +writevt hlp=doc$writevt.hlp, src=vtel$writevt.x +vtblink hlp=doc$vtblink.hlp, src=vtel$vtblink.cl +quickfit hlp=doc$quickfit.hlp, src=vtel$quickfit.x +merge hlp=doc$merge.hlp, src=vtel$merge.x +dicoplot hlp=doc$dicoplot.hlp, src=vtel$dicoplot.x +unwrap hlp=doc$unwrap.hlp, src=vtel$unwrap.x +getsqib hlp=doc$getsqib.hlp, src=vtel$getsqib.x +putsqib hlp=doc$putsqib.hlp, src=vtel$putsqib.x +trim hlp=doc$trim.hlp, src=vtel$trim.x +mscan hlp=doc$mscan.hlp, src=vtel$mscan.x +vtexamine hlp=doc$vtexamine.hlp, src=vtel$vtexamine.x +tcopy hlp=doc$tcopy.hlp, src=vtel$tcopy.x +pimtext hlp=doc$pimtext.hlp, src=vtel$pimtext.x +fitslogr hlp=doc$fitslogr.hlp, src=vtel$fitslogr.cl +mrotlogr hlp=doc$mrotlogr.hlp, src=vtel$mrotlogr.cl +makeimages hlp=doc$makeimages.hlp, src=vtel$makeimages.cl +makehelium hlp=doc$makehelium.hlp, src=vtel$makehelium.cl +writetape hlp=doc$writetape.hlp, src=vtel$writetape.cl +syndico hlp=doc$syndico.hlp, src=vtel$syndico.x +revisions sys=Revisions diff --git a/noao/imred/vtel/vtel.men b/noao/imred/vtel/vtel.men new file mode 100644 index 000000000..a9dd3c789 --- /dev/null +++ b/noao/imred/vtel/vtel.men @@ -0,0 +1,22 @@ + destreak - Destreak He 10830 grams. + destreak5 - First pass processing CL script for 10830 grams. + dicoplot - Make dicomed plots of carrington maps. + fitslogr - Make a log of certain header parameters from a FITS tape. + getsqib - Extract the squibby brightness image from a full disk scan. + makehelium - Cl script for processing destreaked 10830 grams(second pass). + makeimages - Cl script for processing magnetograms into projected maps + merge - Merge daily grams into a Carrington map. + mrotlogr - Log some header parameters from a FITS rotation map tape. + mscan - Read all sector scans on a tape and put them into images. + pimtext - Put text directly into images using a pixel font. + putsqib - Merge a squibby brightness image into a full disk image. + quickfit - Fit an ellipse to the solar limb. + readvt - Read a full disk tape and produce an IRAF image. + syndico - Make dicomed print of daily grams 18 cm across. + tcopy - Tape to tape copy routine. + trim - Set all pixels outside the limb to 0.0 (use sqib for limb). + unwrap - Remove effects of data wraparound on continuum scans. + vtblink - Blink daily grams on the IIS to check for registration. + vtexamine - Examine a vacuum telescope tape, print headers and profile. + writetape - Cl script to write 5 full disk grams to tape. + writevt - Write an IRAF image to tape in vacuum telescope format. diff --git a/noao/imred/vtel/vtel.par b/noao/imred/vtel/vtel.par new file mode 100644 index 000000000..dde78dd5b --- /dev/null +++ b/noao/imred/vtel/vtel.par @@ -0,0 +1 @@ +version,s,h,"8Jun87" diff --git a/noao/imred/vtel/vtexamine.par b/noao/imred/vtel/vtexamine.par new file mode 100644 index 000000000..39283d0e1 --- /dev/null +++ b/noao/imred/vtel/vtexamine.par @@ -0,0 +1,3 @@ +input,s,q,,,,Input file descriptor +headers,b,h,yes,,,Print out header data +files,s,q,,,,List of files to be examined diff --git a/noao/imred/vtel/vtexamine.x b/noao/imred/vtel/vtexamine.x new file mode 100644 index 000000000..2b482bbe6 --- /dev/null +++ b/noao/imred/vtel/vtexamine.x @@ -0,0 +1,195 @@ +include +include +include +include +include "vt.h" + +define MAX_RANGES 100 + +# VTEXAMINE -- Examine a vacuum telescope tape. Decode and print the +# header and tell the user info about number and length of records +# on the tape. + +procedure t_vtexamine() + +char input[SZ_FNAME] # input template +char files[SZ_LINE] # which files to examine +bool headers # print headers? + +char tapename[SZ_FNAME] +int filerange[2 * MAX_RANGES + 1] +int nfiles, filenumber, nrecords + +bool clgetb() +int decode_ranges(), get_next_number() +int vtexamine(), mtfile(), mtneedfileno() +errchk vtexamine + +begin + call fseti (STDOUT, F_FLUSHNL, YES) + + # Find out if user wants to see header info. + headers = clgetb ("headers") + + # Get input file(s) + call clgstr ("input", input, SZ_FNAME) + if (mtfile (input) == NO || mtneedfileno (input) == NO) + call strcpy ("1", files, SZ_LINE) + else + call clgstr ("files", files, SZ_LINE) + + if (decode_ranges (files, filerange, MAX_RANGES, nfiles) == ERR) + call error (0, "Illegal file number list.") + call printf ("\n") + + # Loop over files. + filenumber = 0 + while (get_next_number (filerange, filenumber) != EOF) { + + # Assemble the appropriate tape file name. + call strcpy (input, tapename, SZ_FNAME) + if (mtfile(input) == YES && mtneedfileno (input) == YES) + call mtfname (input, filenumber, tapename, SZ_FNAME) + + iferr { + nrecords = vtexamine (tapename, headers) + } then { + call eprintf ("Error reading file: %s\n") + call pargstr (tapename) + call erract (EA_WARN) + next + } else if (nrecords == 0) { + call printf ("Tape at EOT\n") + break + } + + } # End while. +end + + +# VTEXAMINE -- examine a tape (or disk) file. Report about size and +# number of records and, if requested, decode and print the header +# information. + +int procedure vtexamine (input, headers) + +char input[ARB] # input file name +bool headers + +int in, bufsize, totrecords +int nrecords, totbytes, lastrecsize +int recsize +bool trufls +pointer hs, sp +pointer pchar, hpchar + +int mtopen(), fstati(), get_next_record() +errchk mtopen, close, get_next_record + +begin + call smark (sp) + call salloc (hs, VT_LENHSTRUCT, TY_STRUCT) + + in = mtopen (input, READ_ONLY, 0) + bufsize = fstati (in, F_BUFSIZE) + + call malloc (pchar, bufsize, TY_CHAR) + call malloc (hpchar, bufsize, TY_SHORT) + + call printf ("File %s: ") + call pargstr (input) + + totrecords = 0 + nrecords = 0 + totbytes = 0 + lastrecsize = 0 + + + # First read the header file. + recsize = get_next_record (in, Memc[pchar], bufsize, recsize, + SZ_VTHDR * SZB_SHORT/SZB_CHAR) + if (recsize == EOF) + return (totrecords) + call amovs (Memc[pchar], Mems[hpchar], SZ_VTHDR * SZB_SHORT/SZB_CHAR) + + nrecords = nrecords + 1 + totrecords = totrecords + 1 + totbytes = totbytes + recsize + lastrecsize = recsize + trufls = TRUE + if (headers) + call decodeheader (hpchar, hs, trufls) + call printf ("\n") + + # Loop through the rest of the records. + while (get_next_record (in, Memc[pchar], bufsize, recsize, + lastrecsize) != EOF) { + + if (recsize == lastrecsize) + nrecords = nrecords + 1 + else { + call printf ("\t %d %d-byte records\n") + call pargi (nrecords) + call pargi (lastrecsize) + nrecords = 1 + lastrecsize = recsize + } + + totrecords = totrecords + 1 + totbytes = totbytes + recsize + + } # End while. + + if (nrecords > 0 ) { + call printf ("\t %d %d-byte records\n") + call pargi (nrecords) + call pargi (lastrecsize) + } + + # Print total number of records and bytes. + call printf ("\t Total %d records, %d bytes\n") + call pargi (totrecords) + call pargi (totbytes) + + call mfree (pchar, TY_CHAR) + call mfree (hpchar, TY_SHORT) + call sfree (sp) + call close (in) + + return (totrecords) +end + + +# GET_NEXT_RECORD -- Read the next record from tape (or disk) and, +# if an error is found, patch up the data as best we can and use it. +# Also, tell the user about the error. + +int procedure get_next_record(fd, buffer, bufsize, recsize, lastbufsize) + +int bufsize +char buffer[bufsize] +int recsize, lastbufsize +pointer fd + +int read(), fstati() +bool eofflag +errchk read + +begin + eofflag = false + iferr { + if (read (fd, buffer, bufsize) == EOF) + eofflag = true + recsize = fstati (fd, F_SZBBLK) + } then { + call fseti (fd, F_VALIDATE, lastbufsize) + recsize = read (fd, buffer, bufsize) + recsize = fstati (fd, F_SZBBLK) + } + if (BYTE_SWAP2 == YES) + call bswap2 (buffer, 1, buffer, 1, SZ_VTHDR*SZB_SHORT) + if (eofflag) + return (EOF) + else + return (recsize) +end diff --git a/noao/imred/vtel/writetape.cl b/noao/imred/vtel/writetape.cl new file mode 100644 index 000000000..76bb23f25 --- /dev/null +++ b/noao/imred/vtel/writetape.cl @@ -0,0 +1,45 @@ +#{ WRITETAPE -- Write five images to a vacuum telescope tape. The +# script accepts the name of the mag tape device and the general input +# image filename from the user. Writetape appends a digit [1-5] to the +# file name for each file to be written. + +# getmtape,s,a,,,,Mag tape device to write to +# getname,s,a,,,,Root filename for the 5 images +# magtape,s,h +# imname,s,h + +{ + + imname = getname + magtape = getmtape + + if (access(imname//"1.imh")) { + writevt (imname//"1", magtape//"1600[1]") + } else { + print (imname//"1 not accessable") + } + + if (access(imname//"2.imh")) { + writevt (imname//"2", magtape//"1600[2]") + } else { + print (imname//"2 not accessable") + } + + if (access(imname//"3.imh")) { + writevt (imname//"3", magtape//"1600[3]") + } else { + print (imname//"3 not accessable") + } + + if (access(imname//"4.imh")) { + writevt (imname//"4", magtape//"1600[4]") + } else { + print (imname//"4 not accessable") + } + + if (access(imname//"5.imh")) { + writevt (imname//"5", magtape//"1600[5]") + } else { + print (imname//"5 not accessable") + } +} diff --git a/noao/imred/vtel/writetape.par b/noao/imred/vtel/writetape.par new file mode 100644 index 000000000..863a283d6 --- /dev/null +++ b/noao/imred/vtel/writetape.par @@ -0,0 +1,5 @@ + +getmtape,s,a,,,,Mag tape device to write to +getname,s,a,,,,Root filename for the 5 images +magtape,s,h +imname,s,h diff --git a/noao/imred/vtel/writevt.par b/noao/imred/vtel/writevt.par new file mode 100644 index 000000000..de11cb13c --- /dev/null +++ b/noao/imred/vtel/writevt.par @@ -0,0 +1,4 @@ +imagefile,s,q,,,,Image file descriptor +outputfile,s,q,,,,Output file descriptor +verbose,b,h,no,,,Print out header data and give progress reports +new_tape,b,q,,,,Are you using a new tape? diff --git a/noao/imred/vtel/writevt.x b/noao/imred/vtel/writevt.x new file mode 100644 index 000000000..390884b29 --- /dev/null +++ b/noao/imred/vtel/writevt.x @@ -0,0 +1,232 @@ +include +include +include +include "vt.h" + +define SZ_TABLE 8192 # size of lookup table (data) + +# WRITEVT -- Write an IRAF image (vacuum telescope full disk image) out to +# tape in a format identical to the format produced bye the vacuum telescope. + +procedure t_writevt() + +char imagefile[SZ_FNAME] # name of image to be written +char outputfile[SZ_FNAME] # output file name (tape) +bool verbose # verbose flag + +int obsdate +int x1, y1, subraster, outfd +int one +pointer table +pointer srp, im, hs, sp + +int imgeti(), mtopen() +int mtfile(), mtneedfileno() +bool clgetb() +pointer imgs2s(), immap() +errchk immap, imgs2s, mtopen + +begin + call smark (sp) + call salloc (table, SZ_TABLE, TY_SHORT) + call salloc (hs, VT_LENHSTRUCT, TY_STRUCT) + + # Get the image name and the verbose flag from the cl. + call clgstr ("imagefile", imagefile, SZ_FNAME) + verbose = clgetb ("verbose") + + # Get the output file from the cl. + call clgstr ("outputfile", outputfile, SZ_FNAME) + + # See if the outputfile is mag tape, if not, error. + if (mtfile (outputfile) == NO) + call error (1, "Outputfile should be magnetic tape.") + + # If no tape file number is given, then ask whether the tape + # is blank or contains data. If blank then start at [1], else + # start at [EOT]. + + if (mtneedfileno(outputfile) == YES) + if (!clgetb ("new_tape")) + call mtfname (outputfile, EOT, outputfile, SZ_FNAME) + else + call mtfname (outputfile, 1, outputfile, SZ_FNAME) + + if (verbose) { + call printf ("outputfile name = %s\n") + call pargstr (outputfile) + } + + # Open the image file and the output file. + im = immap (imagefile, READ_ONLY, 0) + outfd = mtopen (outputfile, WRITE_ONLY, SZ_VTREC) + + # Get date and time from the header. + obsdate = imgeti (im, "OBS_DATE") + VT_HMONTH(hs) = obsdate/10000 + VT_HDAY(hs) = obsdate/100 - 100 * (obsdate/10000) + VT_HYEAR(hs) = obsdate - 100 * (obsdate/100) + VT_HTIME(hs) = imgeti (im, "OBS_TIME") + VT_HWVLNGTH(hs) = imgeti(im, "wv_lngth") + VT_HOBSTYPE(hs) = imgeti (im, "obs_type") + VT_HAVINTENS(hs) = imgeti (im, "av_intns") + VT_HNUMCOLS(hs) = imgeti (im, "num_cols") + VT_HINTGPIX(hs) = imgeti (im, "intg/pix") + VT_HREPTIME(hs) = imgeti (im, "rep_time") + + # Write header data to tape. + call writeheader (outfd, hs, verbose) + + # Set up lookuptable for data subswaths. + one = 1 + call amovks (one, Mems[table], SZ_TABLE) + call aclrs (Mems[table], HALF_DIF) + call aclrs (Mems[table + SWTHWID_14 + HALF_DIF], HALF_DIF) + call aclrs (Mems[table + SWTHWID_23 * 3], HALF_DIF) + call aclrs (Mems[table + SZ_TABLE - HALF_DIF], HALF_DIF) + + # Write the image data to tape. + do subraster = 1, NUM_SRSTR { + + # Calculate position of bottom left corner of this subraster. + x1 = ((NUM_SRSTR_X - 1) - mod((subraster - 1), NUM_SRSTR_X)) * + SRSTR_WID + 1 + y1 = ((NUM_SRSTR_Y - 1) - ((subraster - mod((subraster - 1), + NUM_SRSTR_Y)) / NUM_SRSTR_Y)) * SWTH_HIGH + 1 + + # Get subraster. + srp = imgs2s (im, x1, x1+(SRSTR_WID - 1), y1, y1+(SWTH_HIGH - 1)) + iferr (call putsubraster (outfd, Mems[srp], SRSTR_WID, + SWTH_HIGH, Mems[table], subraster)) + call eprintf ("Error in putsubraster, subraster = %d\n") + call pargi (subraster) + if (verbose) { + call printf("%d%% done\n") + call pargi ((subraster*100)/NUM_SRSTR) + call flush (STDOUT) + } + } + + # Close output file and unmap image. + call close (outfd) + call imunmap (im) + call sfree (sp) +end + + +# WRITEHEADER -- Write header info to the output, pack date +# and time, and, if 'verbose' flag is set, display some information +# to the user. + +procedure writeheader(outfd, hs, verbose) + +int outfd # output file descriptor +pointer hs # header data structure pointer +bool verbose # verbose flag + +int i +short hbuf[SZ_VTHDR] +int fstati() +errchk write + +begin + # Pack date, time. The constants below are explained in the + # description of the image header and how it is packed. If any + # changes are made the following code will have to be rewritten. + + call bitpak (VT_HMONTH(hs)/10, hbuf[1], 13, 4) + call bitpak ((VT_HMONTH(hs)-(VT_HMONTH(hs)/10)*10), hbuf[1], 9, 4) + call bitpak (VT_HDAY(hs)/10, hbuf[1], 5, 4) + call bitpak ((VT_HDAY(hs)-(VT_HDAY(hs)/10)*10), hbuf[1], 1, 4) + call bitpak (VT_HYEAR(hs)/10, hbuf[2], 13, 4) + call bitpak ((VT_HYEAR(hs)-(VT_HYEAR(hs)/10)*10), hbuf[2], 9, 4) + call bitpak (VT_HTIME(hs)/2**15, hbuf[3], 1, 2) + call bitpak ((VT_HTIME(hs)-(VT_HTIME(hs)/2**15)*2**15), hbuf[4], 1, 15) + + # Put other parameters in appropriate places. + hbuf[5] = VT_HWVLNGTH(hs) + hbuf[6] = VT_HOBSTYPE(hs) + hbuf[7] = VT_HAVINTENS(hs) + hbuf[8] = VT_HNUMCOLS(hs) + hbuf[9] = VT_HINTGPIX(hs) + hbuf[10] = VT_HREPTIME(hs) + + # Store other header parameters. + for (i = 11 ; i <= SZ_VTHDR ; i = i + 1) + hbuf[i] = 0 + + if (verbose) { + call printf ("\nmonth/day/year = %d/%d/%d\n") + call pargi (VT_HMONTH(hs)) + call pargi (VT_HDAY(hs)) + call pargi (VT_HYEAR(hs)) + call printf ("time = %d seconds since midnight\n") + call pargi (VT_HTIME(hs)) + call printf ("wavelength = %d\nobservation type = %d\n") + call pargi (VT_HWVLNGTH(hs)) + call pargi (VT_HOBSTYPE(hs)) + call flush (STDOUT) + } + + if (BYTE_SWAP2 == YES) + call bswap2 (hbuf, 1, hbuf, 1, SZ_VTHDR*SZB_SHORT) + call write (outfd, hbuf, SZ_VTHDR*SZB_SHORT/SZB_CHAR) + if (fstati (outfd, F_NCHARS) != SZ_VTHDR*SZB_SHORT/SZB_CHAR) + call error (0, "error when writing header") + call flush (outfd) +end + + +# PUTSUBRASTER -- Write data to the output from this subraster, look +# in the table to see if each subswath should be filled with data or zeros. + +procedure putsubraster (outfd, array, nx, ny, table, subraster) + +int outfd # output file descriptor +int subraster # subraster number +int nx # size of the data array (x) +int ny # size of the data array (y) +short array[nx, ny] # data array +short table[SZ_TABLE] # subswath lookup table + +int i, subswath, tableindex +pointer sp, bufpointer +errchk writesubswath + +begin + call smark (sp) + call salloc (bufpointer, ny, TY_SHORT) + + do subswath = nx, 1, -1 { + tableindex = (subraster - 1) * nx + ((nx + 1) - subswath) + if (table[tableindex] == IS_DATA) { + do i = ny, 1, -1 + Mems[bufpointer + ny - i] = array[subswath,i] + call writesubswath (outfd, Mems[bufpointer], ny) + } else + next + } + + call sfree(sp) +end + + +# WRITESUBSWATH -- Write data to file whose logical unit is outfd. +# Swap the bytes in each data word. + +procedure writesubswath (outfd, buf, buflength) + +int outfd # output file descriptor +int buflength # length of data buffer +short buf[buflength] # data buffer + +int fstati() +errchk write + +begin + if (BYTE_SWAP2 == YES) + call bswap2 (buf, 1, buf, 1, buflength * SZB_SHORT) + call write (outfd, buf, buflength*SZB_SHORT/SZB_CHAR) + if (fstati (outfd, F_NCHARS) != buflength*SZB_SHORT/SZB_CHAR) + call error (0, "eof encountered when reading subswath") +end diff --git a/noao/imred/vtel/x_vtel.x b/noao/imred/vtel/x_vtel.x new file mode 100644 index 000000000..15117968d --- /dev/null +++ b/noao/imred/vtel/x_vtel.x @@ -0,0 +1,15 @@ +task readvt = t_readvt, + writevt = t_writevt, + unwrap = t_unwrap, + quickfit = t_quickfit, + getsqib = t_getsqib, + putsqib = t_putsqib, + merge = t_merge, + destreak = t_destreak, + trim = t_trim, + dicoplot = t_dicoplot, + vtexamine = t_vtexamine, + tcopy = t_tcopy, + mscan = t_mscan, + syndico = t_syndico, + pimtext = t_pimtext diff --git a/test/files.md b/test/files.md index e5ad6da51..b47ceb7c9 100644 --- a/test/files.md +++ b/test/files.md @@ -122,6 +122,7 @@ noaobin$x_quad.e noaobin$x_quadred.e noaobin$x_rv.e noaobin$x_scombine.e +noaobin$x_vtel.e ``` ```