├── .gitattributes ├── .idlwave_catalog ├── LICENSE ├── README.md ├── aaareadme.txt ├── contents.txt ├── data ├── JPLEPH.405 └── testpo.405 ├── homepage.html ├── idlpackage.json ├── news.txt ├── pro ├── .idlwave_catalog ├── ad2xy.pro ├── add_distort.pro ├── adstring.pro ├── adxy.pro ├── airtovac.pro ├── aitoff.pro ├── aitoff_grid.pro ├── al_legend.pro ├── al_legendtest.pro ├── altaz2hadec.pro ├── aper.pro ├── arcbar.pro ├── arrows.pro ├── asinh.pro ├── astdisp.pro ├── astro.pro ├── astrolib.pro ├── autohist.pro ├── avg.pro ├── baryvel.pro ├── biweight_mean.pro ├── blink.pro ├── blkshift.pro ├── boost_array.pro ├── boxave.pro ├── bprecess.pro ├── break_path.pro ├── bsort.pro ├── calz_unred.pro ├── ccm_unred.pro ├── check_fits.pro ├── checksum32.pro ├── cic.pro ├── cirrange.pro ├── cleanplot.pro ├── cntrd.pro ├── co_aberration.pro ├── co_nutate.pro ├── co_refract.pro ├── compare_struct.pro ├── concat_dir.pro ├── cons_dec.pro ├── cons_ra.pro ├── convolve.pro ├── copy_struct.pro ├── copy_struct_inx.pro ├── correl_images.pro ├── correl_optimize.pro ├── corrmat_analyze.pro ├── cosmo_param.pro ├── cr_reject.pro ├── create_struct.pro ├── cspline.pro ├── ct2lst.pro ├── curs.pro ├── curval.pro ├── dao_value.pro ├── daoerf.pro ├── date.pro ├── date_conv.pro ├── daycnv.pro ├── db_ent2ext.pro ├── db_ent2host.pro ├── db_info.pro ├── db_item.pro ├── db_item_info.pro ├── db_or.pro ├── db_titles.pro ├── dbbuild.pro ├── dbcircle.pro ├── dbclose.pro ├── dbcompare.pro ├── dbcreate.pro ├── dbdelete.pro ├── dbedit.pro ├── dbedit_basic.pro ├── dbext.pro ├── dbext_dbf.pro ├── dbext_ind.pro ├── dbfind.pro ├── dbfind_entry.pro ├── dbfind_sort.pro ├── dbfparse.pro ├── dbget.pro ├── dbhelp.pro ├── dbindex.pro ├── dbindex_blk.pro ├── dbmatch.pro ├── dbopen.pro ├── dbprint.pro ├── dbput.pro ├── dbrd.pro ├── dbsearch.pro ├── dbsort.pro ├── dbtarget.pro ├── dbtitle.pro ├── dbupdate.pro ├── dbval.pro ├── dbwrt.pro ├── dbxput.pro ├── dbxval.pro ├── delvarx.pro ├── deredd.pro ├── detabify.pro ├── dist_circle.pro ├── dist_ellipse.pro ├── eci2geo.pro ├── eq2hor.pro ├── eqpole.pro ├── eqpole_grid.pro ├── euler.pro ├── expand_tilde.pro ├── extast.pro ├── extgrp.pro ├── f_format.pro ├── factor.pro ├── fdecomp.pro ├── file_launch.pro ├── filter_image.pro ├── find.pro ├── find_all_dir.pro ├── find_with_def.pro ├── findpro.pro ├── fitexy.pro ├── fits_add_checksum.pro ├── fits_adxy.pro ├── fits_ascii_encode.pro ├── fits_cd_fix.pro ├── fits_close.pro ├── fits_help.pro ├── fits_info.pro ├── fits_open.pro ├── fits_read.pro ├── fits_test_checksum.pro ├── fits_write.pro ├── fits_xyad.pro ├── fitsdir.pro ├── fitsrgb_to_tiff.pro ├── flegendre.pro ├── flux2mag.pro ├── fm_unred.pro ├── forprint.pro ├── frebin.pro ├── ftab_delrow.pro ├── ftab_ext.pro ├── ftab_help.pro ├── ftab_print.pro ├── ftaddcol.pro ├── ftcreate.pro ├── ftdelcol.pro ├── ftdelrow.pro ├── ftget.pro ├── fthelp.pro ├── fthmod.pro ├── ftinfo.pro ├── ftkeeprow.pro ├── ftprint.pro ├── ftput.pro ├── ftsize.pro ├── ftsort.pro ├── fxaddpar.pro ├── fxbaddcol.pro ├── fxbclose.pro ├── fxbcolnum.pro ├── fxbcreate.pro ├── fxbdimen.pro ├── fxbfind.pro ├── fxbfindlun.pro ├── fxbfinish.pro ├── fxbgrow.pro ├── fxbheader.pro ├── fxbhelp.pro ├── fxbhmake.pro ├── fxbintable.pro ├── fxbisopen.pro ├── fxbopen.pro ├── fxbparse.pro ├── fxbread.pro ├── fxbreadm.pro ├── fxbstate.pro ├── fxbtdim.pro ├── fxbtform.pro ├── fxbwrite.pro ├── fxbwritm.pro ├── fxfindend.pro ├── fxhclean.pro ├── fxhmake.pro ├── fxhmodify.pro ├── fxhread.pro ├── fxmove.pro ├── fxpar.pro ├── fxparpos.pro ├── fxposit.pro ├── fxread.pro ├── fxwrite.pro ├── gal_flat.pro ├── gal_uvw.pro ├── galage.pro ├── gaussian.pro ├── gcirc.pro ├── gcntrd.pro ├── geo2eci.pro ├── geo2geodetic.pro ├── geo2mag.pro ├── geodetic2geo.pro ├── get_coords.pro ├── get_date.pro ├── get_equinox.pro ├── get_juldate.pro ├── get_pipe_filesize.pro ├── getopt.pro ├── getpro.pro ├── getpsf.pro ├── getrot.pro ├── gettok.pro ├── getwrd.pro ├── glactc.pro ├── glactc_pm.pro ├── group.pro ├── gsss_stdast.pro ├── gsssadxy.pro ├── gsssextast.pro ├── gsssxyad.pro ├── hadec2altaz.pro ├── hastrom.pro ├── hboxave.pro ├── hcongrid.pro ├── headfits.pro ├── helio.pro ├── helio_jd.pro ├── helio_rv.pro ├── hermite.pro ├── heuler.pro ├── hextract.pro ├── hgrep.pro ├── histogauss.pro ├── hor2eq.pro ├── host_to_ieee.pro ├── hprecess.pro ├── hprint.pro ├── hrebin.pro ├── hreverse.pro ├── hrot.pro ├── hrotate.pro ├── ieee_to_host.pro ├── imcontour.pro ├── imdbase.pro ├── imf.pro ├── imlist.pro ├── irafdir.pro ├── irafrd.pro ├── irafwrt.pro ├── is_ieee_big.pro ├── isarray.pro ├── ismeuv.pro ├── jdcnv.pro ├── jplephinterp.pro ├── jplephread.pro ├── jplephtest.pro ├── jprecess.pro ├── juldate.pro ├── ksone.pro ├── kstwo.pro ├── kuiperone.pro ├── kuipertwo.pro ├── lineid_plot.pro ├── linmix_err.pro ├── linterp.pro ├── list_with_path.pro ├── lsf_rotate.pro ├── lumdist.pro ├── mag2flux.pro ├── mag2geo.pro ├── make_2d.pro ├── make_astr.pro ├── match.pro ├── match2.pro ├── max_entropy.pro ├── max_likelihood.pro ├── meanclip.pro ├── medarr.pro ├── medsmooth.pro ├── minf_bracket.pro ├── minf_conj_grad.pro ├── minf_parabol_d.pro ├── minf_parabolic.pro ├── minmax.pro ├── mkhdr.pro ├── mlinmix_err.pro ├── mmm.pro ├── modfits.pro ├── month_cnv.pro ├── moonpos.pro ├── mphase.pro ├── mrandomn.pro ├── mrd_hread.pro ├── mrd_skip.pro ├── mrd_struct.pro ├── mrdfits.pro ├── multinom.pro ├── multiplot.pro ├── mwrfits.pro ├── n_bytes.pro ├── ngp.pro ├── nint.pro ├── nstar.pro ├── nulltrim.pro ├── nutate.pro ├── observatory.pro ├── one_arrow.pro ├── one_ray.pro ├── oploterror.pro ├── ordinal.pro ├── partvelvec.pro ├── pca.pro ├── pent.pro ├── permute.pro ├── pixcolor.pro ├── pixwt.pro ├── pkfit.pro ├── planck.pro ├── planet_coords.pro ├── ploterror.pro ├── plothist.pro ├── plotsym.pro ├── poidev.pro ├── polint.pro ├── polrec.pro ├── poly_smooth.pro ├── polyleg.pro ├── posang.pro ├── positivity.pro ├── precess.pro ├── precess_cd.pro ├── precess_xyz.pro ├── premat.pro ├── prime.pro ├── print_struct.pro ├── prob_ks.pro ├── prob_kuiper.pro ├── psf_gaussian.pro ├── putast.pro ├── qdcb_grid.pro ├── qget_string.pro ├── qsimp.pro ├── qtrap.pro ├── quadterp.pro ├── query_irsa_cat.pro ├── querydss.pro ├── querygsc.pro ├── querysimbad.pro ├── queryvizier.pro ├── radec.pro ├── randomchi.pro ├── randomdir.pro ├── randomgam.pro ├── randomp.pro ├── randomwish.pro ├── rdfits_struct.pro ├── rdfloat.pro ├── rdplot.pro ├── rdpsf.pro ├── read_fmr.pro ├── read_ipac_table.pro ├── read_ipac_var.pro ├── read_key.pro ├── readcol.pro ├── readfits.pro ├── readfmt.pro ├── recpol.pro ├── rem_dup.pro ├── remchar.pro ├── remove.pro ├── repchr.pro ├── repstr.pro ├── resistant_mean.pro ├── rhotheta.pro ├── rinter.pro ├── rob_checkfit.pro ├── robust_linefit.pro ├── robust_poly_fit.pro ├── robust_sigma.pro ├── safe_correlate.pro ├── select_w.pro ├── sigma_filter.pro ├── sigrange.pro ├── sip_eval.pro ├── sixlin.pro ├── sixty.pro ├── sky.pro ├── skyadj_cube.pro ├── solve_astro.pro ├── spec_dir.pro ├── sphdist.pro ├── srcor.pro ├── st_diskread.pro ├── starast.pro ├── store_array.pro ├── str_index.pro ├── strcompress2.pro ├── strn.pro ├── strnumber.pro ├── substar.pro ├── sunpos.pro ├── sunsymbol.pro ├── sxaddhist.pro ├── sxaddpar.pro ├── sxdelpar.pro ├── sxginfo.pro ├── sxgpar.pro ├── sxgread.pro ├── sxhcopy.pro ├── sxhmake.pro ├── sxhread.pro ├── sxhwrite.pro ├── sxmake.pro ├── sxopen.pro ├── sxpar.pro ├── sxread.pro ├── sxwrite.pro ├── t_aper.pro ├── t_find.pro ├── t_getpsf.pro ├── t_group.pro ├── t_nstar.pro ├── t_substar.pro ├── tabinv.pro ├── tag_exist.pro ├── tbdelcol.pro ├── tbdelrow.pro ├── tbget.pro ├── tbhelp.pro ├── tbinfo.pro ├── tbprint.pro ├── tbsize.pro ├── tdb2tdt.pro ├── ten.pro ├── tenv.pro ├── textclose.pro ├── textopen.pro ├── tic_one.pro ├── ticlabels.pro ├── ticpos.pro ├── tics.pro ├── tnx_eval.pro ├── to_hex.pro ├── tpv_eval.pro ├── transform_coeff.pro ├── trapzd.pro ├── tsc.pro ├── tsum.pro ├── tvbox.pro ├── tvcircle.pro ├── tvellipse.pro ├── tvlaser.pro ├── tvlist.pro ├── unzoom_xy.pro ├── update_distort.pro ├── uvbybeta.pro ├── vactoair.pro ├── valid_num.pro ├── vect.pro ├── vsym.pro ├── wcs_check_ctype.pro ├── wcs_demo.pro ├── wcs_getpole.pro ├── wcs_rotate.pro ├── wcssph2xy.pro ├── wcsxy2sph.pro ├── webget.pro ├── wfpc2_metric.pro ├── wfpc2_read.pro ├── where_tag.pro ├── wherenan.pro ├── write_ipac_table.pro ├── writefits.pro ├── xdispstr.pro ├── xmedsky.pro ├── xy2ad.pro ├── xyad.pro ├── xyxy.pro ├── xyz.pro ├── ydn2md.pro ├── ymd2dn.pro ├── zang.pro ├── zbrent.pro ├── zenpos.pro ├── zoom_xy.pro └── zparcheck.pro └── text ├── aaareadme.txt ├── astro.readme ├── astrom.readme ├── coyote.readme ├── daophot.tex ├── data.readme ├── database.readme ├── database.tex ├── disk_io.readme ├── fits.readme ├── fits_bintable.readme ├── fits_bintable.tex ├── fits_table.readme ├── ft.tex ├── idlphot.readme ├── image.readme ├── jhuapl.readme ├── math.readme ├── misc.readme ├── mrdfits.txt ├── plot.readme ├── robust.readme ├── sdas.readme ├── sockets.readme ├── structure.readme └── tv.readme /.gitattributes: -------------------------------------------------------------------------------- 1 | # Auto detect text files and perform LF normalization 2 | * text=auto 3 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 2014, Wayne Landsman 2 | 3 | Redistribution and use in source and binary forms, with or without 4 | modification, are permitted provided that the following conditions are 5 | met: 6 | 7 | Redistributions of source code must retain the above copyright 8 | notice, this list of conditions and the following disclaimer. 9 | 10 | Redistributions in binary form must reproduce the above copyright 11 | notice, this list of conditions and the following disclaimer in 12 | the documentation and/or other materials provided with the 13 | distribution. 14 | 15 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 16 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 17 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 18 | A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 19 | HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 20 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 21 | LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 22 | DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 23 | THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 24 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 25 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 26 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | IDLAstro 2 | ======== 3 | 4 | Astronomy related procedures in the commercial IDL language 5 | -------------------------------------------------------------------------------- /data/JPLEPH.405: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/wlandsman/IDLAstro/729b572229af513c3b728ad8084b5cf5cc7768a9/data/JPLEPH.405 -------------------------------------------------------------------------------- /idlpackage.json: -------------------------------------------------------------------------------- 1 | { 2 | "Name": "IDLAstro", 3 | "Version": "v1.0.1", 4 | "Author": "Wayne Landsman", 5 | "Date": "Jul 24 2018", 6 | "Dependencies": [ 7 | { 8 | "Name": "IDL", 9 | "Version": "^6.4" 10 | }, 11 | { 12 | "Name": "coyote", 13 | "Version": ">1.0", 14 | "URL":"http://github.com/wlandsman/coyote" 15 | } 16 | ] 17 | } -------------------------------------------------------------------------------- /pro/airtovac.pro: -------------------------------------------------------------------------------- 1 | pro airtovac,wave_air, wave_vac 2 | ;+ 3 | ; NAME: 4 | ; AIRTOVAC 5 | ; PURPOSE: 6 | ; Convert air wavelengths to vacuum wavelengths 7 | ; EXPLANATION: 8 | ; Wavelengths are corrected for the index of refraction of air under 9 | ; standard conditions. Wavelength values below 2000 A will not be 10 | ; altered. Uses relation of Ciddor (1996). 11 | ; 12 | ; CALLING SEQUENCE: 13 | ; AIRTOVAC, WAVE_AIR, [ WAVE_VAC] 14 | ; 15 | ; INPUT/OUTPUT: 16 | ; WAVE_AIR - Wavelength in Angstroms, scalar or vector 17 | ; If this is the only parameter supplied, it will be updated on 18 | ; output to contain double precision vacuum wavelength(s). 19 | ; OPTIONAL OUTPUT: 20 | ; WAVE_VAC - Vacuum wavelength in Angstroms, same number of elements as 21 | ; WAVE_AIR, double precision 22 | ; 23 | ; EXAMPLE: 24 | ; If the air wavelength is W = 6056.125 (a Krypton line), then 25 | ; AIRTOVAC, W yields an vacuum wavelength of W = 6057.8019 26 | ; 27 | ; METHOD: 28 | ; Formula from Ciddor 1996, Applied Optics 62, 958 29 | ; 30 | ; NOTES: 31 | ; Take care within 1 A of 2000 A. Wavelengths below 2000 A *in air* are 32 | ; not altered. 33 | ; REVISION HISTORY 34 | ; Written W. Landsman November 1991 35 | ; Use Ciddor (1996) formula for better accuracy in the infrared 36 | ; Added optional output vector, W Landsman Mar 2011 37 | ; Iterate for better precision W.L./D. Schlegel Mar 2011 38 | ;- 39 | On_error,2 40 | compile_opt idl2 41 | 42 | if N_params() EQ 0 then begin 43 | print,'Syntax - AIRTOVAC, WAVE_AIR, [WAVE_VAC]' 44 | print,'WAVE_AIR (Input) is the air wavelength in Angstroms' 45 | return 46 | endif 47 | 48 | wave_vac = double(wave_air) 49 | g = where(wave_vac GE 2000, Ng) ;Only modify above 2000 A 50 | 51 | if Ng GT 0 then begin 52 | 53 | for iter=0, 1 do begin 54 | sigma2 = (1d4/double(wave_vac[g]) )^2. ;Convert to wavenumber squared 55 | 56 | ; Compute conversion factor 57 | fact = 1.D + 5.792105D-2/(238.0185D0 - sigma2) + $ 58 | 1.67917D-3/( 57.362D0 - sigma2) 59 | 60 | 61 | wave_vac[g] = wave_air[g]*fact ;Convert Wavelength 62 | endfor 63 | if N_params() EQ 1 then wave_air = wave_vac 64 | endif 65 | 66 | return 67 | end 68 | -------------------------------------------------------------------------------- /pro/aitoff.pro: -------------------------------------------------------------------------------- 1 | pro aitoff,l,b,x,y 2 | ;+ 3 | ; NAME: 4 | ; AITOFF 5 | ; PURPOSE: 6 | ; Convert longitude, latitude to X,Y using an AITOFF projection. 7 | ; EXPLANATION: 8 | ; This procedure can be used to create an all-sky map in Galactic 9 | ; coordinates with an equal-area Aitoff projection. Output map 10 | ; coordinates are zero longitude centered. 11 | ; 12 | ; CALLING SEQUENCE: 13 | ; AITOFF, L, B, X, Y 14 | ; 15 | ; INPUTS: 16 | ; L - longitude - scalar or vector, in degrees 17 | ; B - latitude - same number of elements as L, in degrees 18 | ; 19 | ; OUTPUTS: 20 | ; X - X coordinate, same number of elements as L. X is normalized to 21 | ; be between -180 and 180 22 | ; Y - Y coordinate, same number of elements as L. Y is normalized to 23 | ; be between -90 and 90. 24 | ; 25 | ; NOTES: 26 | ; See AIPS memo No. 46, page 4, for details of the algorithm. This 27 | ; version of AITOFF assumes the projection is centered at b=0 degrees. 28 | ; 29 | ; REVISION HISTORY: 30 | ; Written W.B. Landsman STX December 1989 31 | ; Modified for Unix: 32 | ; J. Bloch LANL SST-9 5/16/91 1.1 33 | ; Converted to IDL V5.0 W. Landsman September 1997 34 | ;- 35 | if N_params() ne 4 then begin 36 | print,'Syntax - AITOFF, L, B, X, Y' 37 | return 38 | endif 39 | 40 | sa = l 41 | if N_elements(sa) eq 1 then sa = fltarr(1) + sa 42 | x180 = where (sa gt 180.0) 43 | if x180[0] ne -1 then sa[x180] = sa[x180] - 360. 44 | alpha2 = sa/(2*!RADEG) 45 | delta = b/!RADEG 46 | r2 = sqrt(2.) 47 | f = 2*r2/!PI 48 | cdec = cos(delta) 49 | denom =sqrt(1. + cdec*cos(alpha2)) 50 | x = cdec*sin(alpha2)*2.*r2/denom 51 | y = sin(delta)*r2/denom 52 | x = x*!radeg/f 53 | y = y*!radeg/f 54 | 55 | return 56 | end 57 | -------------------------------------------------------------------------------- /pro/altaz2hadec.pro: -------------------------------------------------------------------------------- 1 | PRO altaz2hadec, alt, az, lat, ha, dec 2 | ;+ 3 | ; NAME: 4 | ; ALTAZ2HADEC 5 | ; PURPOSE: 6 | ; Convert Horizon (Alt-Az) coordinates to Hour Angle and Declination. 7 | ; EXPLANATION:: 8 | ; Can deal with the NCP singularity. Intended mainly to be used by 9 | ; program hor2eq.pro 10 | ; CALLING SEQUENCE: 11 | ; ALTAZ2HADEC, alt, az, lat, ha, dec 12 | ; 13 | ; INPUTS 14 | ; alt - the local apparent altitude, in DEGREES, scalar or vector 15 | ; az - the local apparent azimuth, in DEGREES, scalar or vector, 16 | ; measured EAST of NORTH!!! If you have measured azimuth west-of-south 17 | ; (like the book MEEUS does), convert it to east of north via: 18 | ; az = (az + 180) mod 360 19 | ; 20 | ; lat - the local geodetic latitude, in DEGREES, scalar or vector. 21 | ; 22 | ; OUTPUTS 23 | ; ha - the local apparent hour angle, in DEGREES. The hour angle is the 24 | ; time that right ascension of 0 hours crosses the local meridian. 25 | ; It is unambiguously defined. 26 | ; dec - the local apparent declination, in DEGREES. 27 | ; 28 | ; EXAMPLE: 29 | ; Arcturus is observed at an apparent altitude of 59d,05m,10s and an 30 | ; azimuth (measured east of north) of 133d,18m,29s while at the 31 | ; latitude of +43.07833 degrees. 32 | ; What are the local hour angle and declination of this object? 33 | ; 34 | ; IDL> altaz2hadec, ten(59,05,10), ten(133,18,29), 43.07833, ha, dec 35 | ; ===> Hour angle ha = 336.683 degrees 36 | ; Declination, dec = 19.1824 degrees 37 | ; 38 | ; The widely available XEPHEM code gets: 39 | ; Hour Angle = 336.683 40 | ; Declination = 19.1824 41 | ; 42 | ; REVISION HISTORY: 43 | ; Written Chris O'Dell Univ. of Wisconsin-Madison May 2002 44 | ;- 45 | 46 | if N_params() LT 4 then begin 47 | print,'Syntax - ALTAZ2HADEC, alt, az, lat, ha, dec' 48 | return 49 | endif 50 | d2r = !dpi/180.0d 51 | alt_r = alt*d2r 52 | az_r = az*d2r 53 | lat_r = lat*d2r 54 | 55 | ;****************************************************************************** 56 | ; find local HOUR ANGLE (in degrees, from 0. to 360.) 57 | ha = atan( -sin(az_r)*cos(alt_r), $ 58 | -cos(az_r)*sin(lat_r)*cos(alt_r)+sin(alt_r)*cos(lat_r)) 59 | ha = ha / d2r 60 | w = where(ha LT 0.) 61 | if w[0] ne -1 then ha[w] = ha[w] + 360. 62 | ha = ha mod 360. 63 | 64 | ; Find declination (positive if north of Celestial Equator, negative if south) 65 | sindec = sin(lat_r)*sin(alt_r) + cos(lat_r)*cos(alt_r)*cos(az_r) 66 | dec = asin(sindec)/d2r ; convert dec to degrees 67 | 68 | 69 | END 70 | -------------------------------------------------------------------------------- /pro/asinh.pro: -------------------------------------------------------------------------------- 1 | function asinh, x 2 | ;+ 3 | ; NAME: 4 | ; ASINH 5 | ; PURPOSE: 6 | ; Return the inverse hyperbolic sine of the argument 7 | ; EXPLANATION: 8 | ; The inverse hyperbolic sine is used for the calculation of asinh 9 | ; magnitudes, see Lupton et al. (1999, AJ, 118, 1406) 10 | ; 11 | ; CALLING SEQUENCE 12 | ; result = asinh( x) 13 | ; INPUTS: 14 | ; X - hyperbolic sine, numeric scalar or vector or multidimensional array 15 | ; (not complex) 16 | ; 17 | ; OUTPUT: 18 | ; result - inverse hyperbolic sine, same number of elements as X 19 | ; double precision if X is double, otherwise floating pt. 20 | ; 21 | ; METHOD: 22 | ; Expression given in Numerical Recipes, Press et al. (1992), eq. 5.6.7 23 | ; Note that asinh(-x) = -asinh(x) and that asinh(0) = 0. and that 24 | ; if y = asinh(x) then x = sinh(y). 25 | ; 26 | ; REVISION HISTORY: 27 | ; Written W. Landsman February, 2001 28 | ; Work for multi-dimensional arrays W. Landsman August 2002 29 | ; Simplify coding, and work for scalars again W. Landsman October 2003 30 | ;- 31 | On_error,2 32 | 33 | y = alog( abs(x) + sqrt( x^2 + 1.0) ) 34 | 35 | index = where(x LT 0 ,count) 36 | if count GT 0 then y[index] = -y[index] 37 | 38 | return, y 39 | 40 | end 41 | -------------------------------------------------------------------------------- /pro/astrolib.pro: -------------------------------------------------------------------------------- 1 | PRO ASTROLIB 2 | ;+ 3 | ; NAME: 4 | ; ASTROLIB 5 | ; PURPOSE: 6 | ; Add the non-standard system variables used by the IDL Astronomy Library 7 | ; EXPLANATION: 8 | ; Also defines the environment variable ASTRO_DATA pointing to the 9 | ; directory containing data files associated with the IDL Astronomy 10 | ; library (system dependent -- user must edit the third line in the 11 | ; program below). 12 | ; 13 | ; CALLING SEQUENCE: 14 | ; ASTROLIB 15 | ; 16 | ; INPUTS: 17 | ; None. 18 | ; 19 | ; OUTPUTS: 20 | ; None. 21 | ; 22 | ; METHOD: 23 | ; The non-standard system variables !PRIV, !TEXTUNIT, and 24 | ; !TEXTOUT are added using DEFSYSV. 25 | ; 26 | ; REVISION HISTORY: 27 | ; Written, Wayne Landsman, July 1986. 28 | ; Use DEFSYSV instead of ADDSYSVAR December 1990 29 | ; Test for system variable existence before definition July 2001 30 | ; Assume since V55, remove VMS support W. Landsman Sep 2006 31 | ; Remove !Debug, comment out ASTRO_DATA definition WL Jan 2009 32 | ;- 33 | On_error,2 34 | compile_opt idl2 35 | 36 | ; User should edit the folowing line and uncomment it to give the location of 37 | ; ASTRO_DATA on their own system (or define it in their .cshrc or .bashrc file). 38 | ; setenv,'ASTRO_DATA=/export/home/ftp/pub/data/' 39 | 40 | defsysv, '!PRIV', exist = exist 41 | if ~exist then defsysv, '!PRIV', 0 42 | defsysv, '!TEXTUNIT', exist = exist 43 | if ~exist then defsysv, '!TEXTUNIT', 0 44 | defsysv, '!TEXTOUT', exist = exist 45 | if ~exist then defsysv, '!TEXTOUT', 1 46 | 47 | message,'Astronomy Library system variables have been added',/INF 48 | 49 | return 50 | end 51 | 52 | -------------------------------------------------------------------------------- /pro/cirrange.pro: -------------------------------------------------------------------------------- 1 | PRO cirrange, ang, RADIANS=rad 2 | ;+ 3 | ; NAME: 4 | ; CIRRANGE 5 | ; PURPOSE: 6 | ; To force an angle into the range 0 <= ang < 360. 7 | ; CALLING SEQUENCE: 8 | ; CIRRANGE, ang, [/RADIANS] 9 | ; 10 | ; INPUTS/OUTPUT: 11 | ; ang - The angle to modify, in degrees. This parameter is 12 | ; changed by this procedure. Can be a scalar or vector. 13 | ; The type of ANG is always converted to double precision 14 | ; on output. 15 | ; 16 | ; OPTIONAL INPUT KEYWORDS: 17 | ; /RADIANS - If present and non-zero, the angle is specified in 18 | ; radians rather than degrees. It is forced into the range 19 | ; 0 <= ang < 2 PI. 20 | ; PROCEDURE: 21 | ; The angle is transformed between -360 and 360 using the MOD operator. 22 | ; Negative values (if any) are then transformed between 0 and 360 23 | ; MODIFICATION HISTORY: 24 | ; Written by Michael R. Greason, Hughes STX, 10 February 1994. 25 | ; Get rid of WHILE loop, W. Landsman, Hughes STX, May 1996 26 | ; Converted to IDL V5.0 W. Landsman September 1997 27 | ;- 28 | On_error,2 29 | if N_params() LT 1 then begin 30 | print, 'Syntax: CIRRANGE, ang, [ /RADIANS ]' 31 | return 32 | endif 33 | 34 | ; Determine the additive constant. 35 | 36 | if keyword_set(RAD) then cnst = !dpi * 2.d $ 37 | else cnst = 360.d 38 | 39 | ; Deal with the lower limit. 40 | 41 | ang = ang mod cnst 42 | 43 | ; Deal with negative values, if any 44 | 45 | neg = where(ang LT 0., Nneg) 46 | if Nneg GT 0 then ang[neg] = ang[neg] + cnst 47 | 48 | return 49 | end 50 | -------------------------------------------------------------------------------- /pro/daoerf.pro: -------------------------------------------------------------------------------- 1 | pro daoerf,x,y,a,f,pder ;DAOphot ERRor function 2 | ;+ 3 | ; NAME: 4 | ; DAOERF 5 | ; PURPOSE: 6 | ; Calulates the intensity, and derivatives, of a 2-d Gaussian PSF 7 | ; EXPLANATION: 8 | ; Corrects for the finite size of a pixel by integrating the Gaussian 9 | ; over the size of the pixel. Used in the IDL-DAOPHOT sequence. 10 | ; 11 | ; CALLING SEQUENCE: 12 | ; DAOERF, XIN, YIN, A, F, [ PDER ] 13 | ; 14 | ; INPUTS: 15 | ; XIN - input scalar, vector or array, giving X coordinate values 16 | ; YIN - input scalar, vector or array, giving Y coordinate values, must 17 | ; have same number of elements as XIN. 18 | ; A - 5 element parameter array describing the Gaussian 19 | ; A(0) - peak intensity 20 | ; A(1) - X position of peak intensity (centroid) 21 | ; A(2) - Y position of peak intensity (centroid) 22 | ; A(3) - X sigma of the gaussian (=FWHM/2.345) 23 | ; A(4) - Y sigma of gaussian 24 | ; 25 | ; OUTPUTS: 26 | ; F - array containing value of the function at each (XIN,YIN) 27 | ; The number of output elements in F and PDER is identical with 28 | ; the number of elements in X and Y 29 | ; 30 | ; OPTIONAL OUTPUTS: 31 | ; PDER - 2 dimensional array of size (NPTS,5) giving the analytic 32 | ; derivative at each value of F with respect to each parameter A. 33 | ; 34 | ; REVISION HISTORY: 35 | ; Written: W. Landsman October, 1987 36 | ; Converted to IDL V5.0 W. Landsman September 1997 37 | ;- 38 | norm = 2.506628275 ;norm = sqrt(2*!pi) 39 | npts = N_elements(x) 40 | 41 | u2 = (x[*] - a[1] + 0.5)/a[3] & u1 = (x[*] - a[1] - 0.5)/a[3] 42 | v2 = (y[*] - a[2] + 0.5)/a[4] & v1 = (y[*] - a[2] - 0.5)/a[4] 43 | fx = norm*a[3]*(gaussint(u2) - gaussint(u1)) 44 | fy = norm*a[4]*(gaussint(v2) - gaussint(v1)) 45 | f = a[0]*fx*fy 46 | if N_params() le 4 then return ;Need partial derivatives ? 47 | 48 | pder = fltarr(npts,5) 49 | pder[0,0] = fx*fy 50 | uplus = exp(-0.5*u2^2) & uminus = exp(-0.5*u1^2) 51 | pder[0,1] = a[0]*fy*(-uplus + uminus) 52 | vplus = exp(-0.5*v2^2) & vminus = exp(-0.5*v1^2) 53 | pder[0,2] = a[0]*fx*(-vplus + vminus) 54 | pder[0,3] = a[0]*fy*(fx/a[3] + u1*uminus - u2*uplus) 55 | pder[0,4] = a[0]*fx*(fy/a[4] + v1*vminus - v2*vplus) 56 | 57 | return 58 | end 59 | -------------------------------------------------------------------------------- /pro/date.pro: -------------------------------------------------------------------------------- 1 | FUNCTION DATE,YEAR,DAY 2 | ;+ 3 | ; NAME: 4 | ; DATE 5 | ; PURPOSE: 6 | ; Convert day-of-year to a DD-MMM-YYYY string 7 | ; 8 | ; CALLING SEQUENCE: 9 | ; D_String = DATE(Year, day ) 10 | ; 11 | ; INPUTS: 12 | ; Year - Integer scalar specifying the year. If the year contains only 13 | ; two digits, then it is assumed to indicate the number of 14 | ; years after 1900. 15 | ; 16 | ; Day - Integer scalar giving number of days after Jan 0 of the 17 | ; specified year. Can be larger than 366 18 | ; 19 | ; OUTPUTS: 20 | ; D_String - String giving date in format '13-MAR-1986' 21 | ; 22 | ; RESTRICTIONS: 23 | ; Will not work for years before 100 AD 24 | ; EXAMPLE: 25 | ; IDL> print, date(1997,279) 26 | ; '6-Oct-1997' 27 | ; 28 | ; MODIFICATION HISTORY: 29 | ; D.M. fecit 24 October,1983 30 | ; Work for years outside of the 19th century W. Landsman September 1997 31 | ; Converted to IDL V5.0 W. Landsman September 1997 32 | ;- 33 | IF day LE 0 THEN BEGIN 34 | D_String = '%DATE-F-DAY.LE.ZERO' 35 | ENDIF ELSE BEGIN 36 | Last_Day = [31,59,90,120,151,181,212,243,273,304,334,365] 37 | LD = [0,INTARR(11)+1] 38 | Day_of_Year = Day 39 | Months = 'JANFEBMARAPRMAYJUNJULAUGSEPOCTNOVDEC' 40 | 41 | ; Every year that is exactly divisible by 4 is a leap year, except for years 42 | ; that exactly divisible by 100; these centurial years are leap years only if 43 | ; they are exactly divisible by 400. 44 | 45 | IF Year LT 100 THEN Yr = Year + 1900 ELSE Yr = Year 46 | Leap = (((Yr MOD 4) EQ 0) AND ((Yr MOD 100) NE 0)) $ 47 | OR ((Yr MOD 400) EQ 0) 48 | N_Days = 365 + Leap 49 | 50 | WHILE Day_of_Year GT N_Days DO BEGIN 51 | Day_of_Year = Day_of_Year - N_Days 52 | Yr = Yr + 1 53 | Leap = (((Yr MOD 4) EQ 0) AND ((Yr MOD 100) NE 0)) $ 54 | OR ((Yr MOD 400) EQ 0) 55 | N_Days = 365 + Leap 56 | END 57 | 58 | End_Date = '-' + STRTRIM(YR,2) 59 | 60 | IF Leap THEN Last_Day = Last_Day + LD 61 | Last_Month = Day_of_Year LE Last_Day 62 | Where_LD = WHERE(Last_Month, N_Month) 63 | 64 | IF N_Month EQ 12 THEN BEGIN 65 | D_String = STRTRIM(Day_of_Year,2) + '-JAN' + End_Date 66 | ENDIF ELSE BEGIN 67 | LAST_Month = Where_LD[0] 68 | Month = STRMID(Months,3*Last_Month,3) 69 | Day_of_Month = Day_of_Year - Last_Day[Last_Month-1] 70 | D_String = STRTRIM(Day_of_Month,2) + '-' + Month + End_Date 71 | END 72 | END 73 | 74 | RETURN,D_String 75 | END 76 | -------------------------------------------------------------------------------- /pro/daycnv.pro: -------------------------------------------------------------------------------- 1 | PRO DAYCNV, XJD, YR, MN, DAY, HR 2 | ;+ 3 | ; NAME: 4 | ; DAYCNV 5 | ; PURPOSE: 6 | ; Converts Julian dates to Gregorian calendar dates 7 | ; 8 | ; EXPLANATION: 9 | ; Duplicates the functionality of the intrinsic JUL2GREG procedure 10 | ; which was introduced in V8.2.1 11 | ; CALLING SEQUENCE: 12 | ; DAYCNV, XJD, YR, MN, DAY, HR 13 | ; 14 | ; INPUTS: 15 | ; XJD = Julian date, positive double precision scalar or vector 16 | ; 17 | ; OUTPUTS: 18 | ; YR = Year (Integer) 19 | ; MN = Month (Integer) 20 | ; DAY = Day (Integer) 21 | ; HR = Hours and fractional hours (Real). If XJD is a vector, 22 | ; then YR,MN,DAY and HR will be vectors of the same length. 23 | ; 24 | ; EXAMPLE: 25 | ; IDL> DAYCNV, 2440000.D, yr, mn, day, hr 26 | ; 27 | ; yields yr = 1968, mn =5, day = 23, hr =12. 28 | ; 29 | ; WARNING: 30 | ; Be sure that the Julian date is specified as double precision to 31 | ; maintain accuracy at the fractional hour level. 32 | ; 33 | ; METHOD: 34 | ; Uses the algorithm of Fliegel and Van Flandern (1968) as reported in 35 | ; the "Explanatory Supplement to the Astronomical Almanac" (1992), p. 604 36 | ; Works for all Gregorian calendar dates with XJD > 0, i.e., dates after 37 | ; -4713 November 23. 38 | ; REVISION HISTORY: 39 | ; Converted to IDL from Yeoman's Comet Ephemeris Generator, 40 | ; B. Pfarr, STX, 6/16/88 41 | ; Converted to IDL V5.0 W. Landsman September 1997 42 | ;- 43 | On_error,2 44 | compile_opt idl2 45 | 46 | if N_params() lt 2 then begin 47 | print,"Syntax - DAYCNV, xjd, yr, mn, day, hr' 48 | print,' Julian date, xjd, should be specified in double precision' 49 | return 50 | endif 51 | 52 | ; Adjustment needed because Julian day starts at noon, calendar day at midnight 53 | 54 | jd = long(xjd) ;Truncate to integral day 55 | frac = double(xjd) - jd + 0.5 ;Fractional part of calendar day 56 | after_noon = where(frac ge 1.0, Next) 57 | if Next GT 0 then begin ;Is it really the next calendar day? 58 | frac[after_noon] = frac[after_noon] - 1.0 59 | jd[after_noon] = jd[after_noon] + 1 60 | endif 61 | hr = frac*24.0 62 | l = jd + 68569 63 | n = 4*l / 146097l 64 | l = l - (146097*n + 3l) / 4 65 | yr = 4000*(l+1) / 1461001 66 | l = l - 1461*yr / 4 + 31 ;1461 = 365.25 * 4 67 | mn = 80*l / 2447 68 | day = l - 2447*mn / 80 69 | l = mn/11 70 | mn = mn + 2 - 12*l 71 | yr = 100*(n-49) + yr + l 72 | return 73 | end 74 | -------------------------------------------------------------------------------- /pro/db_or.pro: -------------------------------------------------------------------------------- 1 | function db_or,list1,list2 2 | ;+ 3 | ; NAME: 4 | ; DB_OR 5 | ; PURPOSE: 6 | ; Combine two vectors of entry numbers, removing duplicate values. 7 | ; EXPLANATION: 8 | ; DB_OR can also be used to remove duplicate values from any longword 9 | ; vector 10 | ; 11 | ; CALLING SEQUENCE: 12 | ; LIST = DB_OR( LIST1 ) ;Remove duplicate values from LIST1 13 | ; or 14 | ; LIST = DB_OR( LIST1, LIST2 ) ;Concatenate LIST1 and LIST2, remove dups 15 | ; 16 | ; INPUTS: 17 | ; LIST1, LIST2 - Vectors containing entry numbers, must be non-negative 18 | ; integers or longwords. 19 | ; OUTPUT: 20 | ; LIST - Vector containing entry numbers in either LIST1 or LIST2 21 | ; 22 | ; METHOD 23 | ; DB_OR returns where the histogram of the entry vectors is non-zero 24 | ; 25 | ; PROCEDURE CALLS 26 | ; ZPARCHECK - checks parameters 27 | ; REVISION HISTORY: 28 | ; Written, W. Landsman February, 1989 29 | ; Check for degenerate values W.L. February, 1993 30 | ; Converted to IDL V5.0 W. Landsman September 1997 31 | ;- 32 | if N_params() EQ 0 then begin 33 | print,'Syntax - list = db_or( list1, [ list2] ) 34 | return, -1 35 | endif 36 | 37 | zparcheck, 'DB_OR', list1, 1, [1,2,3], [1,2], 'First Entry Vector' 38 | 39 | if N_params() eq 1 then begin 40 | minlist1 = min( list1, max = maxlist1 ) 41 | if ( minlist1 EQ maxlist1 ) then return, minlist1 else $ 42 | return, where( histogram( list1 ) GT 0 ) + minlist1 43 | endif 44 | 45 | zparcheck, 'DB_OR', list1, 1, [1,2,3], [1,2], 'Second Entry Vector' 46 | 47 | list = [list1, list2] 48 | minlist = min( list, max = maxlist ) 49 | if ( minlist EQ maxlist ) then return, minlist else $ 50 | return,where( histogram( list ) GT 0 ) + minlist 51 | 52 | end 53 | -------------------------------------------------------------------------------- /pro/db_titles.pro: -------------------------------------------------------------------------------- 1 | pro db_titles,fnames,titles 2 | ;+ 3 | ; NAME: 4 | ; DB_TITLES 5 | ; 6 | ; PURPOSE: 7 | ; Print database name and title. Called by DBHELP 8 | ; 9 | ; CALLING SEQUENCE: 10 | ; db_titles, fnames, titles 11 | ; 12 | ; INPUT: 13 | ; fnames - string array of data base names 14 | ; 15 | ; SIDE EFFECT: 16 | ; Database name is printed along with the description in the .dbh file 17 | ; 18 | ; HISTORY: 19 | ; version 2 W. Landsman May, 1989 20 | ; modified to work under Unix, D. Neill, ACC, Feb 1991. 21 | ; William Thompson, GSFC/CDS (ARC), 1 June 1994 22 | ; Added support for external (IEEE) representation. 23 | ; William Thompson, GSFC, 3 November 1994 24 | ; Modified to allow ZDBASE to be a path string. 25 | ; Converted to IDL V5.0 W. Landsman September 1997 26 | ; Assume since V5.5, W. Landsman September 2006 27 | ;- 28 | ; 29 | ;----------------------------------------------------------------------------- 30 | compile_opt idl2 31 | n = N_elements(fnames) 32 | get_lun,unit 33 | b = bytarr(59) 34 | npar = N_params() 35 | if npar eq 2 then titles = strarr(n) 36 | for i = 0,n-1 do begin 37 | dbh_file = find_with_def(strtrim(fnames[i])+'.dbh', 'ZDBASE') 38 | openr,unit,dbh_file,error=err 39 | if err lt 0 then $ ;Does database exist? 40 | printf,!TEXTUNIT,'Unable to locate database ',fnames[i] $ 41 | else begin 42 | readu,unit,b 43 | if npar eq 1 then begin 44 | printf,!TEXTUNIT,format='(A,T20,A)',fnames[i],strtrim(b[19:58],2) 45 | endif else titles[i] = string(b[19:58]) 46 | endelse 47 | 48 | close,unit 49 | 50 | endfor 51 | 52 | free_lun,unit 53 | return 54 | end 55 | -------------------------------------------------------------------------------- /pro/dbclose.pro: -------------------------------------------------------------------------------- 1 | pro dbclose,dummy 2 | ;+ 3 | ; NAME: 4 | ; DBCLOSE 5 | ; PURPOSE: 6 | ; procedure to close a data base file 7 | ; 8 | ; CALLING SEQUENCE: 9 | ; dbclose 10 | ; 11 | ; INPUTS: 12 | ; None 13 | ; 14 | ; OUTPUTS 15 | ; None 16 | ; 17 | ; SIDE EFFECTS: 18 | ; the data base files currently opened are closed 19 | ; 20 | ; PROCEDURE CALLS: 21 | ; DB_INFO() 22 | ; HISTORY: 23 | ; version 2 D. Lindler Oct. 1987 24 | ; For IDL version 2 August 1990 25 | ; William Thompson, GSFC/CDS (ARC), 30 May 1994 26 | ; Added support for external (IEEE) data format 27 | ; Remove call to HOST_TO_IEEE W. Landsman June 2013 28 | ;- 29 | ;------------------------------------------------------------------------ 30 | On_error,2 31 | common db_com, QDB, QITEMS, QDBREC ;Database common - see DBOPEN 32 | 33 | if N_elements(qdb) LT 120 then return ;No db opened 34 | ndb = db_info('NUMBER') ;number of data bases opened 35 | update = db_info('UPDATE',0) ;opened for update? 36 | 37 | ; If database open for update, write total number of entries in zeroeth record 38 | 39 | if update EQ 1 then begin ;update header 40 | output = [db_info('entries',0), db_info('seqnum',0)] 41 | if qdb[119] eq 1 then $ 42 | swap_endian_inplace, output, /Swap_if_little ;External format? 43 | qdbrec[0] = byte(output,0,8) 44 | endif 45 | 46 | for i = 0, ndb-1 do begin ;loop on units (2 per data base) 47 | unit1 = qdb[96,i] ;unit numbers 48 | unit2 = qdb[97,i] ;unit numbers 49 | if unit1 gt 0 then free_lun,unit1 ;Is it opened? 50 | if unit2 gt 0 then free_lun,unit2 ;Is it opened? 51 | endfor 52 | 53 | qdb=0 ;mark as closed 54 | 55 | return 56 | end 57 | -------------------------------------------------------------------------------- /pro/dbindex_blk.pro: -------------------------------------------------------------------------------- 1 | FUNCTION dbindex_blk, unit, nb, bsz, ofb, dtype 2 | ;+ 3 | ; NAME: 4 | ; DBINDEX_BLK 5 | ; PURPOSE: 6 | ; Subroutine of DBINDEX to create associated variable of correct datatype 7 | ; EXPLANATION: 8 | ; DBINDEX_BLK will offset into the file by a specified amount in 9 | ; preparation for writing to the file. V5.2 or later 10 | ; 11 | ; CALLING SEQUENCE: 12 | ; res = dbindex_blk(unit, nb, bsz, ofb, dtype) 13 | ; 14 | ; INPUTS: 15 | ; unit The unit number assigned to the file. 16 | ; nb The number of blocks to offset into the file. 17 | ; bsz The size of each block, in bytes, to offset into the file. 18 | ; ofb The offset into the block, in bytes. 19 | ; dtype The IDL datatype as defined in the SIZE function 20 | ; 21 | ; OUTPUTS: 22 | ; res The returned variable. This is an associated variable. 23 | ; 24 | ; RESTRICTIONS: 25 | ; The file must have been previously opened. 26 | ; 27 | ; MODIFICATION HISTORY: 28 | ; Written by Michael R. Greason, STX, 14 June 1990. 29 | ; Converted to IDL V5.0 W. Landsman September 1997 30 | ; Use 64 bit integer for very large databases W. Landsman February 2001 31 | ; Added new unsigned & 64bit integer datatypes W. Landsman July 2001 32 | ;- 33 | offset = long64(nb) * long64(bsz) + long64(ofb) 34 | case dtype of 35 | 7: datarec=assoc(unit,bytarr(1),offset) ; string 36 | 1: datarec=assoc(unit,bytarr(1),offset) ; byte 37 | 2: datarec=assoc(unit,intarr(1),offset) ; integer 38 | 4: datarec=assoc(unit,fltarr(1),offset) ; floating point 39 | 3: datarec=assoc(unit,lonarr(1),offset) ; longword 40 | 5: datarec=assoc(unit,dblarr(1),offset) ; double 41 | 6: datarec=assoc(unit,complexarr(1),offset) ; complex 42 | 12: datarec=assoc(unit,uintarr(1),offset) ; unsigned integer 43 | 13: datarec=assoc(unit,ulonarr(1),offset) ; unsigned longword 44 | 14: datarec=assoc(unit,lon64arr(1),offset) ; 64 bit longword 45 | 15: datarec=assoc(unit,ulon64arr(1),offset) ; unsigned 64bit longword 46 | endcase 47 | ; 48 | RETURN, datarec 49 | END 50 | -------------------------------------------------------------------------------- /pro/dbput.pro: -------------------------------------------------------------------------------- 1 | pro dbput,item,val,entry 2 | ;+ 3 | ; NAME: 4 | ; DBPUT 5 | ; PURPOSE: 6 | ; Procedure to place a new value for a specified item into 7 | ; a data base file entry. 8 | ; 9 | ; CALLING SEQUENCE: 10 | ; dbput, item, val, entry 11 | ; 12 | ; INPUTS: 13 | ; item - item name or number 14 | ; val - item value(s) 15 | ; 16 | ; INPUT/OUTPUT: 17 | ; entry - entry (byte array) or scalar entry number. 18 | ; if entry is a scalar entry number then the data 19 | ; base file will be updated. Otherwise the change 20 | ; will be only made to the entry array which must 21 | ; be written latter using DBWRT. 22 | ; 23 | ; OPERATIONAL NOTES: 24 | ; If entry is a scalar entry number or the input file name 25 | ; is supplied, the entry in the data base will be updated 26 | ; instead of a supplied entry variable. In this case, !priv 27 | ; must be greater than 1. 28 | ; EXAMPLE: 29 | ; IDL> dbput,'WAVELEN',1215.6,entry 30 | ; PROCEDURES USED: 31 | ; DB_ITEM, DBRD, DBXPUT, DBWRT 32 | ; HISTORY: 33 | ; version 2 D. Lindler Feb 1988 (new db formats) 34 | ; modified to convert blanks into zeros correctly D. Neill Jan 1991 35 | ; Converted to IDL V5.0 W. Landsman September 1997 36 | ; V5.2 version support unsigned, 64bit integers W. Landsman Sep. 2001 37 | ;- 38 | ;----------------------------------------------------------------------- 39 | ; 40 | ; get item number 41 | ; 42 | db_item, item, inum, ivalnum, dtype, sbyte, numvals, nbytes 43 | ; 44 | ; convert val to correct type and check size 45 | ; 46 | if (dtype[0] NE 7) and ( size(val,/type) EQ 7) then val = strtrim(val) 47 | case dtype[0] of 48 | 1: v = byte(fix(val)) 49 | 2: v = fix(val) 50 | 3: v = long(val) 51 | 4: v = float(val) 52 | 5: v = double(val) 53 | 7: v = string(val) 54 | 12: v = uint(val) 55 | 13: v = ulong(val) 56 | 14: v = long64(val) 57 | 15: v = ulong64(val) 58 | endcase 59 | ; 60 | if N_elements(v) NE numvals[0] then begin 61 | print,'DBPUT - Invalid number of data values' 62 | print,'Item '+item+' requires ',strtrim(numvals[0],2),' values' 63 | print,'DBPUT aborting' 64 | retall 65 | endif 66 | ; 67 | ; determine if entry number supplied 68 | ; 69 | if size(entry,/n_dimen) EQ 0 then begin ;scalar entry number supplied 70 | dbrd,entry,e 71 | dbxput,v,e,dtype[0],sbyte[0],nbytes[0]*numvals[0] ;update entry 72 | dbwrt,e ;update file 73 | end else begin ;array supplied, just update it 74 | dbxput,v,entry,dtype[0],sbyte[0],nbytes[0]*numvals[0] 75 | end 76 | 77 | return 78 | end 79 | -------------------------------------------------------------------------------- /pro/dbtitle.pro: -------------------------------------------------------------------------------- 1 | function dbtitle,c,f 2 | ;+ 3 | ; NAME: 4 | ; DBTITLE 5 | ; PURPOSE: 6 | ; function to create title line for routine dbprint 7 | ; 8 | ; CALLING SEQUENCE: 9 | ; result = dbtitle( c, f ) 10 | ; 11 | ; INPUTS: 12 | ; c = string array of titles for each item 13 | ; f = field length of each item 14 | ; 15 | ; OUTPUT: 16 | ; header string returned as function value 17 | ; 18 | ; OPERATIONAL NOTES: 19 | ; this is a subroutine of DBPRINT. 20 | ; 21 | ; HISTORY: 22 | ; version 1 D. Lindler Sept 86 23 | ; Converted to IDL V5.0 W. Landsman September 1997 24 | ;- 25 | ;------------------------------------------------------------ 26 | n=n_elements(c) 27 | h=' ' 28 | com = strtrim(c,0) ;header for item with trailing blanks removed 29 | ncom = strlen(com) 30 | for i=0,n-1 do begin ;loop on items 31 | flen=f[i] ;field length 32 | st=string(replicate(byte(32),flen+1));blank field 33 | ipos=((flen-ncom[i]+1)/2)>1 ;starting position in field for comment 34 | strput,st,com[i],ipos ;insert into field 35 | h=h+st ;add to header 36 | end; loop on items 37 | return,h ;return header 38 | end 39 | -------------------------------------------------------------------------------- /pro/dbval.pro: -------------------------------------------------------------------------------- 1 | function dbval,entry,item 2 | ;+ 3 | ; NAME: 4 | ; DBVAL 5 | ; PURPOSE: 6 | ; procedure to extract value(s) of the specified item from 7 | ; a data base file entry. 8 | ; 9 | ; CALLING SEQUENCE: 10 | ; result = dbval( entry, item ) 11 | ; 12 | ; INPUTS: 13 | ; entry - byte array containing the entry, or a scalar entry number 14 | ; item - name (string) or number (integer) of the item 15 | ; 16 | ; OUTPUT: 17 | ; the value(s) will be returned as the function value 18 | ; 19 | ; EXAMPLE: 20 | ; Extract a flux vector from entry 28 of the database FARUV 21 | ; ==> flux = dbval(28,'FLUX') 22 | ; 23 | ; HISTORY: 24 | ; version 2 D. Lindler Nov, 1987 (new db format) 25 | ; Converted to IDL V5.0 W. Landsman September 1997 26 | ;- 27 | ;------------------------------------------------------------------- 28 | ; 29 | ; get item info 30 | ; 31 | db_item,item,itnum,ival,idltype,sbyte,numvals,nbytes 32 | ; 33 | ; check to see if entry is a valid array 34 | ; 35 | s=size(entry) 36 | if s[0] gt 0 then begin ;array supplied 37 | if(s[0] ne 1) then begin ;is entry a 1-d array 38 | print,'entry must be a 1-d byte array, dbval aborting' 39 | retall 40 | endif 41 | if(s[2] ne 1) then begin ;check if byte array 42 | print,'entry must be a byte array, dbval aborting' 43 | retall 44 | endif 45 | return,dbxval(entry,idltype[0],numvals[0],sbyte[0],nbytes[0]) 46 | end else begin ;scalar supplied (assume entry number) 47 | dbrd,entry,e ;read entry 48 | return,dbxval(e,idltype[0],numvals[0],sbyte[0],nbytes[0]);return value(s) 49 | end 50 | end 51 | -------------------------------------------------------------------------------- /pro/dbxput.pro: -------------------------------------------------------------------------------- 1 | pro dbxput,val,entry,idltype,sbyte,nbytes 2 | ;+ 3 | ; NAME: 4 | ; DBXPUT 5 | ; PURPOSE: 6 | ; routine to replace value of an item in a data base entry 7 | ; 8 | ; CALLING SEQUENCE: 9 | ; dbxput, val, entry, idltype, sbyte, nbytes 10 | ; 11 | ; INPUT: 12 | ; val - value(s) to be placed into entry, string values might be 13 | ; truncated to fit number of allowed bytes in item 14 | ; entry - entry or entries to be updated 15 | ; idltype - idl data type for item (1-7) 16 | ; sbyte - starting byte in record 17 | ; nbytes - total number of bytes in value added 18 | ; 19 | ; OUTPUT: 20 | ; entry - (updated) 21 | ; 22 | ; OPERATIONAL NOTES: 23 | ; This routine assumes that the calling procedure or user knows what he 24 | ; or she is doing. String items are truncated or padded to the fixed 25 | ; size specified by the database but otherwise no validity checks are 26 | ; made. 27 | ; 28 | ; HISTORY: 29 | ; version 1, D. Lindler Aug, 1986 30 | ; converted to IDL Version 2. M. Greason, STX, June 1990. 31 | ; Work with multiple element string items W. Landsman August 1995 32 | ; Really work with multiple element string items 33 | ; R. Bergman/W. Landsman July 1996 34 | ; Work with multiple entries, R. Schwartz, GSFC/SDAC August 1996 35 | ; Use /overwrite with REFORM() W. Landsman May 1997 36 | ; Converted to IDL V5.0 W. Landsman September 1997 37 | ;- 38 | ;------------------------------------------------------- 39 | ; 40 | nentry = n_elements(entry[0,*]) 41 | case idltype of ;case of data type 42 | 43 | 7: begin ;string 44 | numvals = N_elements(val) ;Number of input values 45 | nbyte = nbytes/numvals ;Number of bytes/value 46 | val = strmid(val,0,nbyte) ;Truncate string 47 | temp = replicate( 32b, nbyte, numvals, nentry) ;Array of blanks 48 | for i = 0, numvals-1 do temp[0,i,0] = byte(val[i,*]) ;Fill with values 49 | entry[sbyte:sbyte+nbytes-1,*] = reform(temp,nbytes,nentry, /over) 50 | end 51 | 1: entry[sbyte:sbyte+nbytes-1,*]=val 52 | else: entry[sbyte:sbyte+nbytes-1,*] = byte(val,0,nbytes,nentry) 53 | 54 | endcase 55 | return 56 | end 57 | -------------------------------------------------------------------------------- /pro/delvarx.pro: -------------------------------------------------------------------------------- 1 | ;+ 2 | ; NAME: 3 | ; DELVARX 4 | ; PURPOSE: 5 | ; Undefine up to 10 variables for memory management (can call from routines) 6 | ; EXPLANATION: 7 | ; Similar to the intrinsic DELVAR function, but can be used from any calling level. 8 | ; (DELVAR can only be used at the main level.) Note, however, that unlike DELVAR, 9 | ; DELVARX does not delete the variables (they will be listed as UNDEFINED when 10 | ; viewed with HELP), but only makes them undefined and frees their memory 11 | ; 12 | ; Also look at the similar Coyote routine UNDEFINE 13 | ; http://www.idlcoyote.com/programs/undefine.pro 14 | ; 15 | ; CALLING SEQUENCE: 16 | ; DELVARX, p0, [p1, p2......p9] 17 | ; 18 | ; INPUTS: 19 | ; p0, p1...p9 - variables to delete 20 | ; 21 | ; OBSOLETE KEYWORD: 22 | ; /FREE_MEM - free memory associated with pointers and objects. Since this is now the 23 | ; DELVARX default (since 2012) this keyword now does nothing. 24 | ; 25 | ; METHOD: 26 | ; Uses HEAP_FREE and PTR_NEW(/NO_COPY) to undefine variables and free memory 27 | ; 28 | ; REVISION HISTORY: 29 | ; Copied from the Solar library, written by slf, 25-Feb-1993 30 | ; Added to Astronomy Library, September 1995 31 | ; Modified, 26-Mar-2003, Zarro (EER/GSFC) 26-Mar-2003 32 | ; - added FREE_MEM to free pointer/objects 33 | ; Modified, 28-Jan-2012, E. Rykoff (SLAC), W. Landsman - 34 | ; replace EXECUTE calls with SCOPE_VARFETCH. 35 | ; Clarified documentation W. Landsman Sep 2018 36 | ;- 37 | 38 | PRO delvarx, p0,p1,p2,p3,p4,p5,p6,p7,p8,p9,free_mem = free_mem 39 | 40 | npar = N_params() ; Number of parameters 41 | pp = 'p'+strtrim(indgen(npar),1) 42 | 43 | for i=0,npar-1 do begin 44 | defined = N_elements( SCOPE_VARFETCH(pp[i],LEVEL=0)) 45 | if LOGICAL_TRUE(defined) then $ 46 | heap_free, ptr_new( SCOPE_VARFETCH(pp[i],LEVEL=0),/no_copy) 47 | 48 | endfor 49 | 50 | return 51 | end 52 | 53 | -------------------------------------------------------------------------------- /pro/deredd.pro: -------------------------------------------------------------------------------- 1 | pro deredd,Eby,by,m1,c1,ub,by0,m0,c0,ub0, update = update 2 | ;+ 3 | ; NAME: 4 | ; DEREDD 5 | ; 6 | ; PURPOSE: 7 | ; Deredden stellar Stromgren parameters given for a value of E(b-y) 8 | ; EXPLANATION: 9 | ; See the procedure UVBYBETA for more info. 10 | ; 11 | ; CALLING SEQUENCE: 12 | ; deredd, eby, by, m1, c1, ub, by0, m0, c0, ub0, /UPDATE 13 | ; 14 | ; INPUTS: 15 | ; Eby - color index E(b-y),scalar (E(b-y) = 0.73*E(B-V) ) 16 | ; by - b-y color (observed) 17 | ; m1 - Stromgren line blanketing parameter (observed) 18 | ; c1 - Stromgren Balmer discontinuity parameter (observed) 19 | ; ub - u-b color (observed) 20 | ; 21 | ; These input values are unaltered unless the /UPDATE keyword is set 22 | ; OUTPUTS: 23 | ; by0 - b-y color (dereddened) 24 | ; m0 - Line blanketing index (dereddened) 25 | ; c0 - Balmer discontinuity parameter (dereddened) 26 | ; ub0 - u-b color (dereddened) 27 | ; 28 | ; OPTIONAL INPUT KEYWORDS: 29 | ; /UPDATE - If set, then input parameters are updated with the dereddened 30 | ; values (and output parameters are not used). 31 | ; REVISION HISTORY: 32 | ; Adapted from FORTRAN routine DEREDD by T.T. Moon 33 | ; W. Landsman STX Co. April, 1988 34 | ; Converted to IDL V5.0 W. Landsman September 1997 35 | ;- 36 | if N_Params() LT 2 then begin 37 | print,'Syntax - DEREDD, eby, by, m1, c1, ub, by0, m0, c0, ub0' 38 | return 39 | endif 40 | 41 | Rm1 = -0.33 & Rc1 = 0.19 & Rub = 1.53 42 | Eby0 = Eby >0 43 | if keyword_set(update) then begin 44 | by = by - eby0 45 | if N_elements(m1) GT 0 then m1 = m1 - Rm1*Eby0 46 | if N_elements(c1) GT 0 then c1 = c1 - Rc1*Eby0 47 | if N_elements(ub) GT 0 then ub = ub - Rub*Eby0 48 | endif else begin 49 | by0 = by - Eby0 50 | m0 = m1 - Rm1*Eby0 51 | c0 = c1 - Rc1*Eby0 52 | ub0 = ub - Rub*Eby0 53 | endelse 54 | return 55 | end 56 | -------------------------------------------------------------------------------- /pro/detabify.pro: -------------------------------------------------------------------------------- 1 | FUNCTION DETABIFY, CHAR_STR 2 | ;+ 3 | ; NAME: 4 | ; DETABIFY 5 | ; PURPOSE: 6 | ; Replaces tabs in character strings with appropriate number of spaces 7 | ; EXPLANATION: 8 | ; The number of space characters inserted is calculated to space 9 | ; out to the next effective tab stop, each of which is eight characters 10 | ; apart. 11 | ; 12 | ; CALLING SEQUENCE: 13 | ; Result = DETABIFY( CHAR_STR ) 14 | ; 15 | ; INPUT PARAMETERS: 16 | ; CHAR_STR = Character string variable (or array) to remove tabs from. 17 | ; 18 | ; OUTPUT: 19 | ; Result of function is CHAR_STR with tabs replaced by spaces. 20 | ; 21 | ; RESTRICTIONS: 22 | ; CHAR_STR must be a character string variable. 23 | ; 24 | ; MODIFICATION HISTORY: 25 | ; William Thompson, Feb. 1992. 26 | ; Converted to IDL V5.0 W. Landsman September 1997 27 | ;- 28 | ; 29 | ON_ERROR, 2 30 | ; 31 | ; Check the number of parameters. 32 | ; 33 | IF N_PARAMS() NE 1 THEN MESSAGE,'Syntax: Result = DETABIFY(CHAR_STR)' 34 | ; 35 | ; Make sure CHAR_STR is of type string. 36 | ; 37 | SZ = SIZE(CHAR_STR) 38 | IF SZ[SZ[0]+1] NE 7 THEN BEGIN 39 | MESSAGE,/INFORMATIONAL,'CHAR_STR must be of type string' 40 | RETURN, CHAR_STR 41 | ENDIF 42 | ; 43 | ; Step through each element of CHAR_STR. 44 | ; 45 | STR = CHAR_STR 46 | FOR I = 0,N_ELEMENTS(STR)-1 DO BEGIN 47 | ; 48 | ; Keep looking for tabs until there aren't any more. 49 | ; 50 | REPEAT BEGIN 51 | TAB = STRPOS(STR[I],STRING(9B)) 52 | IF TAB GE 0 THEN BEGIN 53 | NBLANK = 8 - (TAB MOD 8) 54 | STR[I] = STRMID(STR[I],0,TAB) + $ 55 | STRING(REPLICATE(32B,NBLANK)) + $ 56 | STRMID(STR[I],TAB+1,STRLEN(STR[I])-TAB-1) 57 | ENDIF 58 | ENDREP UNTIL TAB LT 0 59 | ENDFOR 60 | ; 61 | RETURN, STR 62 | END 63 | -------------------------------------------------------------------------------- /pro/eqpole.pro: -------------------------------------------------------------------------------- 1 | pro eqpole,l,b,x,y,southpole=southpole 2 | ;+ 3 | ; NAME: 4 | ; EQPOLE 5 | ; PURPOSE: 6 | ; Convert RA and Dec to X,Y using an equal-area polar projection. 7 | ; EXPLANATION: 8 | ; The output X and Y coordinates are scaled to be between 9 | ; -90 and +90 to go from equator to pole to equator. Output map points 10 | ; can be centered on the north pole or south pole. 11 | ; 12 | ; CALLING SEQUENCE: 13 | ; EQPOLE, L, B, X, Y, [ /SOUTHPOLE ] 14 | ; 15 | ; INPUTS: 16 | ; L - longitude - scalar or vector, in degrees 17 | ; B - latitude - same number of elements as RA, in degrees 18 | ; 19 | ; OUTPUTS: 20 | ; X - X coordinate, same number of elements as RA. X is normalized to 21 | ; be between -90 and 90. 22 | ; Y - Y coordinate, same number of elements as DEC. Y is normalized to 23 | ; be between -90 and 90. 24 | ; 25 | ; KEYWORDS: 26 | ; 27 | ; /SOUTHPOLE - Keyword to indicate that the plot is to be centered 28 | ; on the south pole instead of the north pole. 29 | ; 30 | ; REVISION HISTORY: 31 | ; J. Bloch LANL, SST-9 1.1 5/16/91 32 | ; Converted to IDL V5.0 W. Landsman September 1997 33 | ;- 34 | 35 | if N_params() NE 4 then begin 36 | print,'Syntax - EQPOLE,L, B, X, Y, [/SOUTHPOLE]' 37 | print,' Input longitude L, latitude B in *degrees*' 38 | return 39 | endif 40 | 41 | if keyword_set(southpole) then begin 42 | l1 = double(-l/!RADEG) 43 | b1 = double(-b/!RADEG) 44 | endif else begin 45 | l1 = double(l/!RADEG) 46 | b1 = double(b/!RADEG) 47 | endelse 48 | 49 | sq = 2.0d0*(1.0d0 - sin(double(b1))) 50 | chk = where(sq lt 0.0d0) 51 | if chk[0] ge 0 then sq[chk] = 0.0d0 52 | r = 18.0d0*3.53553391d0*sqrt(sq) 53 | y =r*cos(l1) 54 | x =r*sin(l1) 55 | 56 | return 57 | end 58 | -------------------------------------------------------------------------------- /pro/expand_tilde.pro: -------------------------------------------------------------------------------- 1 | ;+ 2 | ; NAME: 3 | ; EXPAND_TILDE() 4 | ; 5 | ; PURPOSE: 6 | ; Expand tilde in UNIX directory names 7 | ; 8 | ; CALLING SEQUENCE: 9 | ; IDL> output=expand_tilde(input) 10 | ; 11 | ; INPUTS: 12 | ; INPUT = input file or directory name, scalar string 13 | ; 14 | ; OUTPUT: 15 | ; Returns expanded filename, scalar string 16 | ; 17 | ; EXAMPLES: 18 | ; output=expand_tilde('~zarro/test.doc') 19 | ; ---> output='/usr/users/zarro' 20 | ; 21 | ; NOTES: 22 | ; This version of EXPAND_TILDE differs from the version in the Solar 23 | ; Library in that it does not call the functions EXIST and IDL_RELEASE. 24 | ; However, it should work identically. 25 | ; PROCEDURE CALLS: 26 | ; None. 27 | ; REVISION HISTORY: 28 | ; Version 1, 17-Feb-1997, D M Zarro. Written 29 | ; Transfered from Solar Library W. Landsman Sep. 1997 30 | ; Made more robust D. Zarro/W. Landsman Sep. 2000 31 | ; Made even more robust (since things like ~zarro weren't being expanded) 32 | ; Zarro (EITI/GSFC, Mar 2001) 33 | ;- 34 | 35 | function expand_tilde,name 36 | if N_elements(name) EQ 0 then return,'' 37 | if size(name,/TNAME) ne 'STRING' then return,name 38 | tpos=strpos(name,'~') 39 | if tpos eq -1 then return,name 40 | apos = strpos(name,'~/') 41 | bpos = strpos(name,'/~') 42 | 43 | tilde=name 44 | if apos GT -1 then begin 45 | tilde = strmid(name,0,apos+1) 46 | post = strmid(name,apos+1,strlen(name)) 47 | endif else begin 48 | if bpos gt -1 then begin 49 | pre = strmid(name,0,bpos+1) 50 | tilde = strmid(name,bpos+1,strlen(name)) 51 | endif 52 | endelse 53 | 54 | error=0 55 | catch,error 56 | if error ne 0 then begin 57 | catch,/cancel 58 | return,name 59 | endif 60 | 61 | cd,tilde,curr=curr 62 | cd,curr,curr=dcurr 63 | tname = dcurr 64 | if N_elements(pre) GT 0 then tname = pre+tname else $ 65 | if N_elements(post) GT 0 then tname = tname + post 66 | 67 | return,tname & end 68 | -------------------------------------------------------------------------------- /pro/extgrp.pro: -------------------------------------------------------------------------------- 1 | pro extgrp,hdr,par 2 | ;+ 3 | ; NAME: 4 | ; EXTGRP 5 | ; PURPOSE: 6 | ; Extract the group parameter information out of SXREAD output 7 | ; EXPLANATION: 8 | ; This procedure extracts the group parameter information out of a 9 | ; header and parameter variable obtained from SXREAD. This allows 10 | ; astrometry, photometry and other parameters to be easily SXPARed by 11 | ; conventional methods and allows the image and header to be saved in 12 | ; a SIMPLE format. 13 | ; 14 | ; CALLING SEQUENCE: 15 | ; ExtGrp, hdr, par 16 | ; 17 | ; INPUT: 18 | ; HDR - The header which is to be converted (input and output) 19 | ; PAR - The Parameter string returned from a call to SXREAD 20 | ; 21 | ; OUTPUT: 22 | ; HDR - The converted header, string array 23 | ; 24 | ; OTHER PROCEDURES CALLED: 25 | ; SXPAR(), SXADDPAR, SXGPAR(), STRN() 26 | ; 27 | ; HISTORY: 28 | ; 25-JUN-90 Version 1 written 29 | ; 13-JUL-92 Header finally added to this ancient procedure, code spiffed up 30 | ; a bit. Now 3 times faster. Added PTYPE comment inclusion. E. Deutsch 31 | ; Converted to IDL V5.0 W. Landsman September 1997 32 | ;- 33 | 34 | arg=n_params(0) 35 | if (arg lt 2) then begin 36 | print,'Call: IDL> EXTGRP,header,params_string' 37 | print,"e.g.: IDL> EXTGRP,h,par" 38 | return 39 | endif 40 | 41 | h=hdr 42 | pcount=sxpar(h,'PCOUNT') 43 | if (pcount le 0) then begin 44 | print,'[EXTGRP] Error: PCOUNT not >0 in header' 45 | return 46 | endif 47 | 48 | htmp=h & ih=0 49 | while (strmid(h[ih],0,4) ne 'PTYP') do ih=ih+1 50 | itmp=ih & stbyt=0 51 | hquick=strarr(4) & hquick[3]='END ' ; tiny temp. header for speed 52 | 53 | for t2=0,pcount-1 do begin 54 | hquick=h[ih+3*t2:ih+3*t2+2] 55 | 56 | pty=sxpar(hquick,'PTYPE'+strn(t2+1)) 57 | comment=strmid(hquick[0],30,50) 58 | pdty=sxpar(hquick,'PDTYPE'+strn(t2+1)) 59 | psz=sxpar(hquick,'PSIZE'+strn(t2+1))/8 60 | pvl=sxgpar(h,par,pty,pdty,stbyt,psz) 61 | 62 | sz=size(pvl) & stbyt=stbyt+psz 63 | if (sz[1] eq 7) then pvl="'"+strn(pvl,length=18)+"'" 64 | tmp=pty+'='+strn(pvl,length=21)+comment 65 | 66 | htmp[itmp]=tmp 67 | itmp=itmp+1 68 | endfor 69 | 70 | while (strmid(h[ih],0,1) eq 'P') do ih=ih+1 71 | 72 | while (strmid(h[ih],0,3) ne 'END') do begin 73 | htmp[itmp]=h[ih] 74 | itmp=itmp+1 75 | ih=ih+1 76 | endwhile 77 | 78 | htmp[itmp]=h[ih] 79 | hdr=htmp[0:itmp] 80 | 81 | sxaddpar,hdr,'SIMPLE','T',' Group Parameters extracted' 82 | sxaddpar,hdr,'PCOUNT',0,' All group parameters extracted' 83 | sxaddpar,hdr,'PSIZE',0,' All group parameters extracted' 84 | sxaddpar,hdr,'GROUPS','T' 85 | sxaddpar,hdr,'GCOUNT',1,' Number of groups' 86 | 87 | return 88 | end 89 | -------------------------------------------------------------------------------- /pro/fits_ascii_encode.pro: -------------------------------------------------------------------------------- 1 | function fits_ascii_encode, sum32 2 | ;+ 3 | ; NAME: 4 | ; FITS_ASCII_ENCODE() 5 | ; PURPOSE: 6 | ; Encode an unsigned longword as an ASCII string to insert in a FITS header 7 | ; EXPLANATION: 8 | ; Follows the July 2007 version of the FITS checksum proposal at 9 | ; http://fits.gsfc.nasa.gov/registry/checksum.html 10 | ; CALLING SEQUENCE: 11 | ; result = FITS_ASCII_ENCODE( sum32) 12 | ; INPUTS: 13 | ; sum32 - 32bit *unsigned longword* (e.g. as returned by CHECKSUM32) 14 | ; RESULT: 15 | ; A 16 character scalar string suitable for the CHECKSUM keyword 16 | ; EXAMPLE: 17 | ; A FITS header/data unit has a checksum of 868229149. Encode the 18 | ; complement of this value (3426738146) into an ASCII string 19 | ; 20 | ; IDL> print,FITS_ASCII_ENCODE(3426738146U) 21 | ; ===> "hcHjjc9ghcEghc9g" 22 | ; 23 | ; METHOD: 24 | ; The 32bit value is interpreted as a sequence of 4 unsigned 8 bit 25 | ; integers, and divided by 4. Add an offset of 48b (ASCII '0'). 26 | ; Remove non-alphanumeric ASCII characters (byte values 58-64 and 91-96) 27 | ; by simultaneously incrementing and decrementing the values in pairs. 28 | ; Cyclicly shift the string one place to the right. 29 | ; 30 | ; REVISION HISTORY: 31 | ; Written W. Landsman SSAI December 2002 32 | ; Use V6.0 notation W.L. August 2013 33 | ;- 34 | if N_Params() LT 1 then begin 35 | print,'Syntax - result = FITS_ASCII_ENCODE( sum32)' 36 | return,'0' 37 | endif 38 | 39 | ; Non-alphanumeric ASCII characters 40 | exclude = [58b,59b,60b,61b,62b,63b,64b,91b,92b,93b,94b,95b,96b] 41 | ch = bytarr(16) 42 | t = byte(sum32,0,4) 43 | byteorder,t,/htonl 44 | quot = t/4 + 48b 45 | for i=0,12,4 do ch[i] = quot 46 | 47 | remain = t mod 4 48 | ch[0] = ch[0:3] + remain ;Insert the remainder in the first 4 bytes 49 | 50 | ;Step through the 16 bytes, 8 at a time, removing nonalphanumeric characters 51 | repeat begin 52 | check = 0b 53 | for j=0,1 do begin 54 | il = j*8 55 | for i=il,il+3 do begin 56 | bad = where( (exclude EQ ch[i]) or (exclude Eq ch[i+4]) , Nbad) 57 | if Nbad GT 0 then begin 58 | ch[i]++ 59 | ch[i+4]-- 60 | check=1b 61 | endif 62 | endfor 63 | endfor 64 | endrep until (check EQ 0b) 65 | 66 | return, string( shift(ch,1)) 67 | end 68 | 69 | -------------------------------------------------------------------------------- /pro/fits_close.pro: -------------------------------------------------------------------------------- 1 | pro fits_close,fcb,no_abort=no_abort,message=message 2 | ;+ 3 | ; NAME: 4 | ; FITS_CLOSE 5 | ; 6 | ;*PURPOSE: 7 | ; Close a FITS data file 8 | ; 9 | ;*CATEGORY: 10 | ; INPUT/OUTPUT 11 | ; 12 | ;*CALLING SEQUENCE: 13 | ; FITS_CLOSE,fcb 14 | ; 15 | ;*INPUTS: 16 | ; FCB: FITS control block returned by FITS_OPEN. 17 | ; 18 | ;*KEYWORD PARAMETERS: 19 | ; /NO_ABORT: Set to return to calling program instead of a RETALL 20 | ; when an I/O error is encountered. If set, the routine will 21 | ; return a non-null string (containing the error message) in the 22 | ; keyword MESSAGE. If /NO_ABORT not set, then FITS_CLOSE will 23 | ; print the message and issue a RETALL 24 | ; MESSAGE = value: Output error message 25 | ; 26 | ;*EXAMPLES: 27 | ; Open a FITS file, read some data, and close it with FITS_CLOSE 28 | ; 29 | ; FITS_OPEN,'infile',fcb 30 | ; FITS_READ,fcb,data 31 | ; FITS_READ,fcb,moredata 32 | ; FITS_CLOSE,fcb 33 | ; 34 | ;*HISTORY: 35 | ; Written by: D. Lindler August, 1995 36 | ; Converted to IDL V5.0 W. Landsman September 1997 37 | ; Do nothing if fcb an invalid structure D. Schlegel/W. Landsman Oct. 2000 38 | ; Return Message='' for to signal normal operation W. Landsman Nov. 2000 39 | ;- 40 | ;---------------------------------------------------------------------------- 41 | ; 42 | ; print calling sequence if no parameters supplied 43 | ; 44 | if N_params() lt 1 then begin 45 | print,'Syntax - FITS_CLOSE, fcb' 46 | print,'KEYWORD PARAMETERS: /No_abort, message=' 47 | return 48 | end 49 | ; 50 | ; close unit 51 | ; 52 | on_ioerror,ioerror 53 | message = '' 54 | 55 | sz_fcb = size(fcb) ;Valid structure? 56 | if sz_fcb[2] EQ 8 then free_lun,fcb.unit 57 | return 58 | ; 59 | ; error exit (probably should never occur) 60 | ; 61 | ioerror: 62 | message = !error_state.msg 63 | if keyword_set(no_abort) then return 64 | message,' ERROR: '+message,/CON 65 | retall 66 | end 67 | -------------------------------------------------------------------------------- /pro/flegendre.pro: -------------------------------------------------------------------------------- 1 | function flegendre,x,m 2 | ;+ 3 | ; NAME: 4 | ; FLEGENDRE 5 | ; PURPOSE: 6 | ; Compute the first M terms in a Legendre polynomial expansion. 7 | ; EXPLANATION: 8 | ; Meant to be used as a supplied function to SVDFIT. 9 | ; 10 | ; This procedure became partially obsolete in IDL V5.0 with the 11 | ; introduction of the /LEGENDRE keyword to SVDFIT and the associated 12 | ; SVDLEG function. However, note that, unlike SVDLEG, FLEGENDRE works 13 | ; on vector values of X. 14 | ; CALLING SEQUENCE: 15 | ; result = FLEGENDRE( X, M) 16 | ; 17 | ; INPUTS: 18 | ; X - the value of the independent variable, scalar or vector 19 | ; M - number of term of the Legendre expansion to compute, integer scalar 20 | ; 21 | ; OUTPUTS: 22 | ; result - (N,M) array, where N is the number of elements in X and M 23 | ; is the order. Contains the value of each Legendre term for 24 | ; each value of X 25 | ; EXAMPLE: 26 | ; (1) If x = 2.88 and M = 3 then 27 | ; IDL> print, flegendre(x,3) ==> [1.00, 2.88, 11.9416] 28 | ; 29 | ; This result can be checked by explicitly computing the first 3 Legendre 30 | ; terms, 1.0, x, 0.5*( 3*x^2 -1) 31 | ; 32 | ; (2) Find the coefficients to an M term Legendre polynomial that gives 33 | ; the best least-squares fit to a dataset (x,y) 34 | ; IDL> coeff = SVDFIT( x,y,M,func='flegendre') 35 | ; 36 | ; The coefficients can then be supplied to the function POLYLEG to 37 | ; compute the best YFIT values for any X. 38 | ; METHOD: 39 | ; The recurrence relation for the Legendre polynomials is used to compute 40 | ; each term. Compare with the function FLEG in "Numerical Recipes" 41 | ; by Press et al. (1992), p. 674 42 | ; 43 | ; REVISION HISTORY: 44 | ; Written Wayne Landsman Hughes STX April 1995 45 | ; Converted to IDL V5.0 W. Landsman September 1997 46 | ;- 47 | On_Error,2 48 | 49 | if N_params() LT 2 then begin 50 | print,'Syntax - result = FLEGENDRE( x, m)' 51 | return,0 52 | endif 53 | 54 | if m LT 1 then message, $ 55 | 'ERROR - Order of Legendre polynomial must be at least 1' 56 | N = N_elements(x) 57 | size_x = size(x) 58 | leg = make_array(n, m, type = size_x[size_x[0]+1] > 4) 59 | 60 | leg[0,0] = replicate( 1., n) 61 | if m GE 2 then leg[0,1] = x 62 | if m GE 3 then begin 63 | twox = 2.*x 64 | f2 = x 65 | d = 1. 66 | for j=2,m-1 do begin 67 | f1 = d 68 | f2 = f2 + 2.*x 69 | d = d+1. 70 | leg[0,j] = ( f2*leg[*,j-1] - f1*leg[*,j-2] )/d 71 | endfor 72 | endif 73 | return, leg 74 | end 75 | -------------------------------------------------------------------------------- /pro/flux2mag.pro: -------------------------------------------------------------------------------- 1 | function flux2mag, flux, zero_pt, ABwave = abwave 2 | ;+ 3 | ; NAME: 4 | ; FLUX2MAG 5 | ; PURPOSE: 6 | ; Convert from flux (ergs/s/cm^2/A) to magnitudes. 7 | ; EXPLANATION: 8 | ; Use MAG2FLUX() for the opposite direction. 9 | ; 10 | ; CALLING SEQUENCE: 11 | ; mag = flux2mag( flux, [ zero_pt, ABwave= ] ) 12 | ; 13 | ; INPUTS: 14 | ; flux - scalar or vector flux vector, in erg cm-2 s-1 A-1 15 | ; 16 | ; OPTIONAL INPUT: 17 | ; zero_pt - scalar giving the zero point level of the magnitude. 18 | ; If not supplied then zero_pt = 21.1 (Code et al 1976) 19 | ; Ignored if the ABwave keyword is supplied 20 | ; 21 | ; OPTIONAL KEYWORD INPUT: 22 | ; ABwave - wavelength scalar or vector in Angstroms. If supplied, then 23 | ; FLUX2MAG() returns Oke AB magnitudes (Oke & Gunn 1983, ApJ, 266, 24 | ; 713). 25 | ; 26 | ; OUTPUT: 27 | ; mag - magnitude vector. If the ABwave keyword is set then mag 28 | ; is given by the expression 29 | ; ABMAG = -2.5*alog10(f) - 5*alog10(ABwave) - 2.406 30 | ; 31 | ; Otherwise, mag is given by the expression 32 | ; mag = -2.5*alog10(flux) - zero_pt 33 | ; EXAMPLE: 34 | ; Suppose one is given wavelength and flux vectors, w (in Angstroms) and 35 | ; f (in erg cm-2 s-1 A-1). Plot the spectrum in AB magnitudes 36 | ; 37 | ; IDL> plot, w, flux2mag(f,ABwave = w), /nozero 38 | ; 39 | ; REVISION HISTORY: 40 | ; Written J. Hill STX Co. 1988 41 | ; Converted to IDL V5.0 W. Landsman September 1997 42 | ; Added ABwave keyword W. Landsman September 1998 43 | ;- 44 | 45 | if ( N_params() LT 2 ) then zero_pt = 21.10 ;Default zero pt 46 | 47 | if keyword_set(ABwave) then $ 48 | return, -2.5*alog10(flux) - 5*alog10(ABwave) - 2.406 else $ 49 | return, -2.5*alog10(flux) - zero_pt 50 | 51 | end 52 | -------------------------------------------------------------------------------- /pro/ftcreate.pro: -------------------------------------------------------------------------------- 1 | pro ftcreate, MAXCOLS,MAXROWS,H,TAB 2 | ;+ 3 | ; NAME: 4 | ; FTCREATE 5 | ; PURPOSE: 6 | ; Create a new (blank) FITS ASCII table and header with specified size. 7 | ; 8 | ; CALLING SEQUENCE: 9 | ; ftcreate, maxcols, maxrows, h, tab 10 | ; 11 | ; INPUTS: 12 | ; maxcols - number of character columns allocated, integer scalar 13 | ; maxrows - maximum number of rows allocated, integer scalar 14 | ; 15 | ; OUTPUTS: 16 | ; h - minimal FITS Table extension header, string array 17 | ; OPTIONAL OUTPUT: 18 | ; tab - empty table, byte array 19 | ; HISTORY: 20 | ; version 1 D. Lindler July. 87 21 | ; Converted to IDL V5.0 W. Landsman September 1997 22 | ; Make table creation optional, allow 1 row table, add comments to 23 | ; required FITS keywords W. Landsman October 2001 24 | ;- 25 | ;---------------------------------------------------------------------- 26 | On_error,2 27 | 28 | if n_params() lt 3 then begin 29 | print,'Syntax - FTCREATE, maxcols, maxrows, h, [tab]' 30 | return 31 | endif 32 | 33 | ; Create blank table if tab output variable supplied 34 | 35 | if N_params() GE 4 then begin 36 | tab = replicate(32B, maxcols, maxrows) 37 | if maxrows EQ 1 then tab = reform(tab,maxcols,1) 38 | endif 39 | ; 40 | ; Create header (destroy any previous contents) and add required ASCII table 41 | ; keywords 42 | ; 43 | h = strarr(9) + string(' ',format='(a80)') 44 | h[0] = 'END' + string(replicate(32b,77)) 45 | sxaddpar, h, 'XTENSION', 'TABLE ',' ASCII table extension' 46 | sxaddpar, h, 'BITPIX', 8,' 8 bit bytes' 47 | sxaddpar, h, 'NAXIS', 2,' 2-dimensional ASCII table' 48 | sxaddpar, h, 'NAXIS1', 0,' Width of table in bytes' 49 | sxaddpar, h, 'NAXIS2', 0,' Number of rows in table' 50 | sxaddpar, h, 'PCOUNT', 0,' Size of special data area' 51 | sxaddpar, h, 'GCOUNT', 1,' one data group (required keyword) 52 | sxaddpar, h, 'TFIELDS', 0,' Number of fields in each row' 53 | 54 | return 55 | end 56 | -------------------------------------------------------------------------------- /pro/ftdelrow.pro: -------------------------------------------------------------------------------- 1 | pro ftdelrow,h,tab,rows 2 | ;+ 3 | ; NAME: 4 | ; FTDELROW 5 | ; PURPOSE: 6 | ; Delete a row of data from a FITS table 7 | ; 8 | ; CALLING SEQUENCE: 9 | ; ftdelrow, h, tab, rows 10 | ; 11 | ; INPUTS-OUPUTS 12 | ; h,tab - FITS table header and data array. H and TAB will 13 | ; be updated on output with the specified row(s) deleted. 14 | ; rows - scalar or vector, specifying the row numbers to delete 15 | ; This vector will be sorted and duplicates removed by FTDELROW 16 | ; 17 | ; EXAMPLE: 18 | ; Compress a table to include only non-negative flux values 19 | ; 20 | ; flux = FTGET(h,tab,'FLUX') ;Obtain original flux vector 21 | ; bad = where(flux lt 0) ;Find negative fluxes 22 | ; FTDELROW,h,tab,bad ;Delete rows with negative fluxes 23 | ; 24 | ; PROCEDURE: 25 | ; Specified rows are deleted from the data array, TAB. The NAXIS2 26 | ; keyword in the header is updated. 27 | ; 28 | ; PROCEDURES USED: 29 | ; sxaddpar 30 | ; 31 | ; REVISION HISTORY: 32 | ; Written W. Landsman STX Co. August, 1988 33 | ; Checked for IDL Version 2, J. Isensee, July, 1990 34 | ; Converted to IDL V5.0 W. Landsman September 1997 35 | ; Assume since V5.4, use BREAK instead of GOTO W. Landsman April 2006 36 | ; 37 | ;- 38 | On_error,2 39 | 40 | if N_params() LT 3 then begin 41 | print,'Syntax - ftdelrow,h,tab,rows' 42 | return 43 | endif 44 | 45 | nrows = sxpar(h,'NAXIS2') ;Original number of rows 46 | if (max(rows) GE nrows) or (min(rows) LT 0) then $ 47 | message,'Specified rows must be between 0 and ' + strtrim(nrows-1,2) 48 | 49 | ndel = N_elements(rows) 50 | if ndel GT 1 then begin 51 | rows = rows[rem_dup(rows)] ;Sort and remove duplicate values 52 | ndel = N_elements(rows) 53 | endif 54 | 55 | j = 0L 56 | i = rows[0] 57 | for k = long(rows[0]),nrows-1 do begin 58 | if k EQ rows[j] then begin 59 | j = j+1 60 | if j EQ ndel then BREAK 61 | endif else begin 62 | tab[0,i] = tab[*,k] 63 | i = i+1 64 | endelse 65 | 66 | endfor 67 | k = k-1 68 | 69 | if k NE nrows-1 then tab[0,i] = tab[*,i+j:nrows-1] 70 | tab = tab[*,0:nrows-ndel-1] 71 | sxaddpar,h,'NAXIS2',nrows-ndel ;Reduce number of rows 72 | 73 | return 74 | end 75 | -------------------------------------------------------------------------------- /pro/fthmod.pro: -------------------------------------------------------------------------------- 1 | pro fthmod,h,field,parameter,value 2 | ;+ 3 | ; NAME: 4 | ; FTHMOD 5 | ; PURPOSE: 6 | ; Procedure to modify header information for a specified field 7 | ; in a FITS table. 8 | ; 9 | ; CALLING SEQUENCE: 10 | ; fthmod, h, field, parameter, value 11 | ; 12 | ; INPUT: 13 | ; h - FITS header for the table 14 | ; field - field name or number 15 | ; parameter - string name of the parameter to modify. Choices 16 | ; include: 17 | ; TTYPE - field name 18 | ; TUNIT - physical units for field (eg. 'ANGSTROMS') 19 | ; TNULL - null value (string) for field, (eg. '***') 20 | ; TFORM - format specification for the field 21 | ; TSCAL - scale factor 22 | ; TZERO - zero offset 23 | ; User should be aware that the validity of the change is 24 | ; not checked. Unless you really know what you are doing, 25 | ; this routine should only be used to change field names, 26 | ; units, or another user specified parameter. 27 | ; value - new value for the parameter. Refer to the FITS table 28 | ; standards documentation for valid values. 29 | ; 30 | ; EXAMPLE: 31 | ; Change the units for a field name "FLUX" to "Janskys" in a FITS table 32 | ; header,h 33 | ; 34 | ; IDL> FTHMOD, h, 'FLUX', 'TUNIT','Janskys' 35 | ; METHOD: 36 | ; The header keyword is modified 37 | ; with the new value. 38 | ; HISTORY: 39 | ; version 1, D. Lindler July 1987 40 | ; Converted to IDL V5.0 W. Landsman September 1997 41 | ; Major rewrite to use new FTINFO call W. Landsman May 2000 42 | ;- 43 | ;----------------------------------------------------------------------- 44 | on_error,2 45 | 46 | ftinfo,h,ft_str 47 | sz = size(field) 48 | if ((sz[0] ne 0) or (sz[1] EQ 0)) then $ 49 | message,'Invalid field specification, it must be a scalar' 50 | 51 | if sz[1] EQ 7 then begin 52 | field = strupcase(strtrim(field,2)) 53 | ttype = strtrim(ft_str.ttype,2) 54 | ipos = where(ttype EQ field, Npos) 55 | if Npos EQ 0 then message, $ 56 | 'Specified field ' + strupcase(strtrim(field,2)) + ' not in table' 57 | endif else ipos = field -1 58 | 59 | ; 60 | par = parameter+strtrim(ipos[0]+1,2) 61 | sxaddpar,h,par,value 62 | return 63 | end 64 | -------------------------------------------------------------------------------- /pro/ftkeeprow.pro: -------------------------------------------------------------------------------- 1 | pro ftkeeprow,h,tab,subs 2 | ;+ 3 | ; NAME: 4 | ; FTKEEPROW 5 | ; PURPOSE: 6 | ; Subscripts (and reorders) a FITS table. A companion piece to FTDELROW. 7 | ; 8 | ; CALLING SEQUENCE: 9 | ; ftkeeprow, h, tab, subs 10 | ; 11 | ; INPUT PARAMETERS: 12 | ; h = FITS table header array 13 | ; tab = FITS table data array 14 | ; subs = subscript array of FITS table rows. Works like any other IDL 15 | ; subscript array (0 based, of course). 16 | ; 17 | ; OUTPUT PARAMETERS: 18 | ; h and tab are modified 19 | ; 20 | ; MODIFICATION HISTORY: 21 | ; Written by R. S. Hill, ST Sys. Corp., 2 May 1991. 22 | ; Converted to IDL V5.0 W. Landsman September 1997 23 | ;- 24 | On_error,2 ;Return to caller 25 | 26 | if N_params() LT 3 then begin 27 | print,'Syntax - ftkeeprow, h, tab, subs' 28 | return 29 | endif 30 | 31 | insize = sxpar(h,'NAXIS2') 32 | tab = tab[*,subs] 33 | outsize = N_elements(subs) 34 | sxaddpar, h, 'NAXIS2', outsize 35 | tag = 'FTKEEPROW '+systime(0)+': ' 36 | sxaddhist, tag + 'table subscripted', h 37 | sxaddhist, tag + strtrim(string(insize),2) + ' rows in, ' + $ 38 | strtrim(string(outsize),2) + ' rows out',h 39 | 40 | return 41 | end 42 | -------------------------------------------------------------------------------- /pro/ftsize.pro: -------------------------------------------------------------------------------- 1 | pro ftsize,h,tab,ncols,nrows,tfields,ncols_all,nrows_all, ERRMSG = ERRMSG 2 | ;+ 3 | ; NAME: 4 | ; FTSIZE 5 | ; PURPOSE: 6 | ; Procedure to return the size of a FITS ASCII table. 7 | ; 8 | ; CALLING SEQUENCE: 9 | ; ftsize,h,tab,ncols,rows,tfields,ncols_all,nrows_all, [ERRMSG = ] 10 | ; 11 | ; INPUTS: 12 | ; h - FITS ASCII table header, string array 13 | ; tab - FITS table array, 2-d byte array 14 | ; 15 | ; OUTPUTS: 16 | ; ncols - number of characters per row in table 17 | ; nrows - number of rows in table 18 | ; tfields - number of fields per row 19 | ; ncols_all - number of characters/row allocated (size of tab) 20 | ; nrows_all - number of rows allocated 21 | ; 22 | ; OPTIONAL OUTPUT KEYWORD: 23 | ; ERRMSG = If this keyword is present, then any error messages will be 24 | ; returned to the user in this parameter rather than 25 | ; depending on the MESSAGE routine in IDL. If no errors are 26 | ; encountered, then a null string is returned. 27 | ; HISTORY 28 | ; D. Lindler July, 1987 29 | ; Fix for 1-row table, W. Landsman HSTX, June 1994 30 | ; Converted to IDL V5.0 W. Landsman September 1997 31 | ; Added ERRMSG keyword W. Landsman May 2000 32 | ; 33 | ;- 34 | ;------------------------------------------------------------------------ 35 | On_error,2 36 | 37 | ; check for valid header type 38 | 39 | s=size(h) & ndim=s[0] & type=s[ndim+1] 40 | save_err = arg_present(errmsg) 41 | errmsg = '' 42 | 43 | if (ndim ne 1) or (type ne 7) then begin 44 | errmsg = 'Invalid FITS header, it must be a string array' 45 | if not save_err then message,'ERROR - ' + errmsg 46 | endif 47 | 48 | ; check for valid table array 49 | 50 | s = size(tab) & ndim = s[0] & vtype = s[ndim+1] 51 | if (vtype ne 1) then begin ;Mod June 1994, for degenerate dim. 52 | errmsg = 'Invalid table array, it must be a 2-D byte array' 53 | if not save_err then message,'ERROR - ' + errmsg 54 | endif 55 | 56 | ncols_all = s[1] ;allocated characters per row 57 | nrows_all = s[2] ;allocated rows 58 | 59 | ; Get number of fields 60 | 61 | tfields = sxpar(h,'TFIELDS', Count = N) 62 | if N LT 0 then begin 63 | errmsg = 'Invalid FITS ASCII table header, TFIELDS keyword missing' 64 | if not save_err then message,'ERROR - ' + errmsg 65 | endif 66 | 67 | ; Get number of columns and rows 68 | 69 | ncols = sxpar(h, 'NAXIS1') 70 | nrows = sxpar(h, 'NAXIS2') 71 | 72 | return 73 | end 74 | -------------------------------------------------------------------------------- /pro/fxbheader.pro: -------------------------------------------------------------------------------- 1 | FUNCTION FXBHEADER, UNIT 2 | ;+ 3 | ; NAME: 4 | ; FXBHEADER() 5 | ; 6 | ; PURPOSE: 7 | ; Returns the header of an open FITS binary table. 8 | ; 9 | ; EXPLANATION: 10 | ; This procedure returns the FITS extension header of a FITS 11 | ; binary table opened for read with the command FXBOPEN. 12 | ; 13 | ; Use : Result = FXBHEADER(UNIT) 14 | ; 15 | ; Inputs : UNIT = Logical unit number returned by FXBOPEN routine. 16 | ; Must be a scalar integer. 17 | ; 18 | ; Opt. Inputs : None. 19 | ; 20 | ; Outputs : The result of the function is a string array containing the 21 | ; header for the FITS binary table that UNIT points to. 22 | ; 23 | ; Opt. Outputs: None. 24 | ; 25 | ; Keywords : None. 26 | ; 27 | ; Calls : FXBFINDLUN 28 | ; 29 | ; Common : Uses common block FXBINTABLE--see "fxbintable.pro" for more 30 | ; information. 31 | ; 32 | ; Restrictions: None. 33 | ; 34 | ; Side effects: The string array returned always has as many elements as the 35 | ; largest header read by FXBOPEN. Any extra elements beyond the 36 | ; true header are blank or null strings. 37 | ; 38 | ; The header will be returned whether or not the table is still 39 | ; open or not. 40 | ; 41 | ; If UNIT does not point to a binary table, then a string array 42 | ; of nulls is returned. 43 | ; 44 | ; If UNIT is an undefined variable, then the null string is 45 | ; returned. 46 | ; 47 | ; Category : Data Handling, I/O, FITS, Generic. 48 | ; 49 | ; Prev. Hist. : None. 50 | ; 51 | ; Written : William Thompson, GSFC, 1 July 1993. 52 | ; 53 | ; Modified : Version 1, William Thompson, GSFC, 1 July 1993. 54 | ; 55 | ; Version : Version 1, 1 July 1993. 56 | ; Converted to IDL V5.0 W. Landsman September 1997 57 | ;- 58 | ; 59 | @fxbintable 60 | ON_ERROR, 2 61 | ; 62 | ; Check the number of parameters. 63 | ; 64 | IF N_PARAMS() NE 1 THEN MESSAGE,'Syntax: Result = FXBHEADER(UNIT)' 65 | ; 66 | ; If UNIT is undefined, then return the null string. 67 | ; 68 | IF N_ELEMENTS(UNIT) EQ 0 THEN RETURN, '' 69 | ; 70 | ; Check the validity of UNIT. 71 | ; 72 | IF N_ELEMENTS(UNIT) GT 1 THEN MESSAGE,'UNIT must be a scalar' 73 | SZ = SIZE(UNIT) 74 | IF SZ[SZ[0]+1] GT 3 THEN MESSAGE,'UNIT must be an integer' 75 | ; 76 | ; Get the state associated with UNIT. 77 | ; 78 | ILUN = FXBFINDLUN(UNIT) 79 | RETURN, HEAD[*,ILUN] 80 | ; 81 | END 82 | -------------------------------------------------------------------------------- /pro/fxbisopen.pro: -------------------------------------------------------------------------------- 1 | FUNCTION FXBISOPEN,UNIT 2 | ;+ 3 | ; NAME: 4 | ; FXBISOPEN() 5 | ; 6 | ; PURPOSE: 7 | ; Returns true if UNIT points to an open FITS binary table. 8 | ; 9 | ; Explanation : This procedure checks to see if the logical unit number given 10 | ; by the variable UNIT corresponds to a FITS binary table opened 11 | ; for read with the command FXBOPEN, and which has not yet been 12 | ; closed with FXBCLOSE. 13 | ; 14 | ; Use : Result = FXBISOPEN(UNIT) 15 | ; 16 | ; If FXBISOPEN(UNIT) THEN ... 17 | ; 18 | ; Inputs : UNIT = Logical unit number returned by FXBOPEN routine. 19 | ; Must be a scalar integer. 20 | ; 21 | ; Opt. Inputs : None. 22 | ; 23 | ; Outputs : The result of the function is either True (1) or False (0), 24 | ; depending on whether UNIT points to an open binary table or 25 | ; not. 26 | ; 27 | ; Opt. Outputs: None. 28 | ; 29 | ; Keywords : None. 30 | ; 31 | ; Calls : FXBFINDLUN 32 | ; 33 | ; Common : Uses common block FXBINTABLE--see "fxbintable.pro" for more 34 | ; information. 35 | ; 36 | ; Restrictions: None. 37 | ; 38 | ; Side effects: If UNIT is an undefined variable, then False (0) is returned. 39 | ; 40 | ; If UNIT points to a FITS binary table file that is opened for 41 | ; write, then False (0) is returned. 42 | ; 43 | ; Category : Data Handling, I/O, FITS, Generic. 44 | ; 45 | ; Prev. Hist. : None. 46 | ; 47 | ; Written : William Thompson, GSFC, 1 July 1993. 48 | ; 49 | ; Modified : Version 1, William Thompson, GSFC, 1 July 1993. 50 | ; 51 | ; Version : Version 1, 1 July 1993. 52 | ; Converted to IDL V5.0 W. Landsman September 1997 53 | ;- 54 | ; 55 | @fxbintable 56 | ON_ERROR, 2 57 | ; 58 | ; Check the number of parameters. 59 | ; 60 | IF N_PARAMS() NE 1 THEN MESSAGE,'Syntax: Result = FXBISOPEN(UNIT)' 61 | ; 62 | ; If UNIT is undefined, then return False. 63 | ; 64 | IF N_ELEMENTS(UNIT) EQ 0 THEN RETURN, 0 65 | ; 66 | ; Check the validity of UNIT. 67 | ; 68 | IF N_ELEMENTS(UNIT) GT 1 THEN MESSAGE,'UNIT must be a scalar' 69 | SZ = SIZE(UNIT) 70 | IF SZ[SZ[0]+1] GT 3 THEN MESSAGE,'UNIT must be an integer' 71 | ; 72 | ; Get the state associated with UNIT. 73 | ; 74 | ILUN = FXBFINDLUN(UNIT) 75 | RETURN, STATE[ILUN] EQ 1 76 | ; 77 | END 78 | -------------------------------------------------------------------------------- /pro/fxbstate.pro: -------------------------------------------------------------------------------- 1 | FUNCTION FXBSTATE, UNIT 2 | ;+ 3 | ; NAME: 4 | ; FXBSTATE() 5 | ; 6 | ; PURPOSE: 7 | ; Returns the state of a FITS binary table. 8 | ; 9 | ; Explanation : This procedure returns the state of a FITS binary table that 10 | ; was either opened for read with the command FXBOPEN, or for 11 | ; write with the command FXBCREATE. 12 | ; 13 | ; Use : Result = FXBSTATE(UNIT) 14 | ; 15 | ; Inputs : UNIT = Logical unit number returned by FXBOPEN routine. 16 | ; Must be a scalar integer. 17 | ; 18 | ; Opt. Inputs : None. 19 | ; 20 | ; Outputs : The result of the function is the state of the FITS binary 21 | ; table that UNIT points to. This can be one of three values: 22 | ; 23 | ; 0 = Closed 24 | ; 1 = Open for read 25 | ; 2 = Open for write 26 | ; 27 | ; Opt. Outputs: None. 28 | ; 29 | ; Keywords : None. 30 | ; 31 | ; Calls : FXBFINDLUN 32 | ; 33 | ; Common : Uses common block FXBINTABLE--see "fxbintable.pro" for more 34 | ; information. 35 | ; 36 | ; Restrictions: None. 37 | ; 38 | ; Side effects: If UNIT is an undefined variable, then 0 (closed) is returned. 39 | ; 40 | ; Category : Data Handling, I/O, FITS, Generic. 41 | ; 42 | ; Prev. Hist. : None. 43 | ; 44 | ; Written : William Thompson, GSFC, 1 July 1993. 45 | ; 46 | ; Modified : Version 1, William Thompson, GSFC, 1 July 1993. 47 | ; 48 | ; Version : Version 1, 1 July 1993. 49 | ; Converted to IDL V5.0 W. Landsman September 1997 50 | ;- 51 | ; 52 | @fxbintable 53 | ON_ERROR, 2 54 | ; 55 | ; Check the number of parameters. 56 | ; 57 | IF N_PARAMS() NE 1 THEN MESSAGE,'Syntax: Result = FXBSTATE(UNIT)' 58 | ; 59 | ; If UNIT is undefined, then return False. 60 | ; 61 | IF N_ELEMENTS(UNIT) EQ 0 THEN RETURN, 0 62 | ; 63 | ; Check the validity of UNIT. 64 | ; 65 | IF N_ELEMENTS(UNIT) GT 1 THEN MESSAGE,'UNIT must be a scalar' 66 | SZ = SIZE(UNIT) 67 | IF SZ[SZ[0]+1] GT 3 THEN MESSAGE,'UNIT must be an integer' 68 | ; 69 | ; Get the state associated with UNIT. 70 | ; 71 | ILUN = FXBFINDLUN(UNIT) 72 | RETURN, STATE[ILUN] 73 | ; 74 | END 75 | -------------------------------------------------------------------------------- /pro/fxbtdim.pro: -------------------------------------------------------------------------------- 1 | FUNCTION FXBTDIM, TDIM_KEYWORD 2 | ;+ 3 | ; NAME: 4 | ; FXBTDIM() 5 | ; Purpose : 6 | ; Parse TDIM-like kwywords. 7 | ; Explanation : 8 | ; Parses the value of a TDIM-like keyword (e.g. TDIMnnn, TDESC, etc.) to 9 | ; return the separate elements contained within. 10 | ; Use : 11 | ; Result = FXBTDIM( TDIM_KEYWORD ) 12 | ; Inputs : 13 | ; TDIM_KEYWORD = The value of a TDIM-like keyword. Must be a 14 | ; character string of the form "(value1,value2,...)". 15 | ; If the parentheses characters are missing, then the 16 | ; string is simply returned as is, without any further 17 | ; processing. 18 | ; Opt. Inputs : 19 | ; None. 20 | ; Outputs : 21 | ; The result of the function is a character string array containing the 22 | ; values contained within the keyword parameter. If a numerical result 23 | ; is desired, then simply call, e.g. 24 | ; 25 | ; Result = FIX( FXBTDIM( TDIM_KEYWORD )) 26 | ; 27 | ; Opt. Outputs: 28 | ; None. 29 | ; Keywords : 30 | ; None. 31 | ; Calls : 32 | ; GETTOK 33 | ; Common : 34 | ; None. 35 | ; Restrictions: 36 | ; The input parameter must have the proper format. The separate values 37 | ; must not contain the comma character. TDIM_KEYWORD must not be an 38 | ; array. 39 | ; Side effects: 40 | ; None. 41 | ; Category : 42 | ; Data Handling, I/O, FITS, Generic. 43 | ; Prev. Hist. : 44 | ; William Thompson, Jan. 1992. 45 | ; William Thompson, Jan. 1993, renamed to be compatible with DOS 46 | ; limitations. 47 | ; Written : 48 | ; William Thompson, GSFC, January 1992. 49 | ; Modified : 50 | ; Version 1, William Thompson, GSFC, 12 April 1993. 51 | ; Incorporated into CDS library. 52 | ; Version : 53 | ; Version 1, 12 April 1993. 54 | ; Converted to IDL V5.0 W. Landsman September 1997 55 | ;- 56 | ; 57 | ON_ERROR,2 58 | ; 59 | ; Make sure TDIM_KEYWORD is not an array. 60 | ; 61 | IF N_ELEMENTS(TDIM_KEYWORD) NE 1 THEN MESSAGE, $ 62 | 'TDIM_KEYWORD must be a scalar' 63 | ; 64 | ; Remove any leading or trailing blanks from the keyword. 65 | ; 66 | TDIM = STRTRIM(TDIM_KEYWORD,2) 67 | ; 68 | ; The first and last characters should be "(" and ")". If they are not, then 69 | ; simply return the string as is. 70 | ; 71 | FIRST = STRMID(TDIM,0,1) 72 | LAST = STRMID(TDIM,STRLEN(TDIM)-1,1) 73 | IF (FIRST NE "(") OR (LAST NE ")") THEN RETURN,TDIM 74 | ; 75 | ; Otherwise, remove the parentheses characters. 76 | ; 77 | TDIM = STRMID(TDIM,1,STRLEN(TDIM)-2) 78 | ; 79 | ; Get the first value. 80 | ; 81 | VALUE = GETTOK(TDIM,',') 82 | ; 83 | ; Get all the rest of the values. 84 | ; 85 | WHILE TDIM NE '' DO VALUE = [VALUE,GETTOK(TDIM,',')] 86 | ; 87 | ; Return the (string) array of values. 88 | ; 89 | RETURN,VALUE 90 | END 91 | -------------------------------------------------------------------------------- /pro/get_juldate.pro: -------------------------------------------------------------------------------- 1 | pro get_juldate,jd 2 | ;+ 3 | ; NAME: 4 | ; GET_JULDATE 5 | ; PURPOSE: 6 | ; Return the current Julian Date 7 | ; 8 | ; EXPLANATION: 9 | ; In V5.4, GET_JULDATE became completely obsolete with the introduction 10 | ; of the /UTC keyword to SYSTIME(). So GET_JULDATE,jd is equivalent to 11 | ; jd = SYSTIME(/JULIAN,/UTC). 12 | ; 13 | ; CALLING SEQUENCE: 14 | ; GET_JULDATE,jd 15 | ; 16 | ; INPUTS: 17 | ; None 18 | ; 19 | ; OUTPUTS: 20 | ; jd = Current Julian Date, double precision scalar 21 | ; 22 | ; EXAMPLE: 23 | ; Return the current hour, day, month and year as integers 24 | ; 25 | ; IDL> GET_JULDATE, JD ;Get current Julian date 26 | ; IDL> DAYCNV, JD, YR, MON, DAY, HOURS ;Convert to hour,day month & year 27 | ; 28 | ; METHOD: 29 | ; A call is made to SYSTIME(/JULIAN,/UTC). 30 | ; 31 | ; REVISION HISTORY: 32 | ; Written Wayne Landsman March, 1991 33 | ; Converted to IDL V5.0 W. Landsman September 1997 34 | ; Assume since V5.4 Use /UTC keyword to SYSTIME() W. Landsman April 2006 35 | ;- 36 | compile_opt idl2 37 | if N_Params() LT 1 then begin 38 | Print,'Syntax - GET_JULDATE, JD' 39 | return 40 | endif 41 | 42 | jd = SYSTIME(/JULIAN,/UTC) 43 | return 44 | end 45 | -------------------------------------------------------------------------------- /pro/get_pipe_filesize.pro: -------------------------------------------------------------------------------- 1 | pro get_pipe_filesize, unit, nbytes, buffer = buffer 2 | ;+ 3 | ; NAME: 4 | ; GET_PIPE_FILESIZE 5 | ; 6 | ; PURPOSE: 7 | ; Determine the number of bytes in a unit opened as a pipe with SPAWN 8 | ; 9 | ; EXPLANATION: 10 | ; Reads into a buffer until the end of file is reached and then counts the 11 | ; number of bytes read. Needed because the fstat.size field is not 12 | ; automatically set for a unit opened as a pipe. 13 | ; 14 | ; CALLING SEQUENCE: 15 | ; GET_PIPE_FILESIZE,unit, nbytes_in_file, BUFFER = 16 | ; 17 | ; INPUTS: 18 | ; unit - IDL unit number of a previously opened file. For example, 19 | ; an FPACK ( http://heasarc.gsfc.nasa.gov/fitsio/fpack/ ) compressed 20 | ; FITS file could be opened as follows: 21 | ; 22 | ; IDL> spawn,'funpack -S test.fits.fz', unit=unit 23 | ; OUTPUTS: 24 | ; nbytes_in_file - Unsigned long64 integer giving number of bytes in 25 | ; the file. 26 | ; 27 | ; INPUT KEYWORD PARAMETERS: 28 | ; BUFFER Integer giving number of bytes in the buffer. Default = 29 | ; . 1000000 30 | ; NOTES: 31 | ; Unite must be opened prior to calling GET_PIPE_FILESIZE, and the number 32 | ; of bytes is counted from the current pointer position. The pointer is 33 | ; left at the end of the file upon return. 34 | ; PROCEDURES USED: 35 | ; SETDEFAULTVALUE 36 | ; REVISION HISTORY: 37 | ; Written, W. Landsman Adnet Dec 2010 38 | 39 | On_error,2 40 | compile_opt idl2 41 | 42 | nbytes = 0ULL 43 | setdefaultvalue, buffer, 1000000 44 | ON_IOerror,Done 45 | b= bytarr(buffer,/noz) 46 | 47 | while 1 do begin 48 | readu,unit,b 49 | nbytes += buffer 50 | endwhile 51 | 52 | Done: 53 | On_IOError, null 54 | nbytes += (fstat(unit)).transfer_count 55 | 56 | return 57 | end 58 | -------------------------------------------------------------------------------- /pro/hadec2altaz.pro: -------------------------------------------------------------------------------- 1 | PRO hadec2altaz, ha, dec, lat, alt, az, WS=WS 2 | 3 | ;+ 4 | ; NAME: 5 | ; HADEC2ALTAZ 6 | ; PURPOSE: 7 | ; Converts Hour Angle and Declination to Horizon (alt-az) coordinates. 8 | ; EXPLANATION: 9 | ; Can deal with NCP/SCP singularity. Intended mainly to be used by 10 | ; program EQ2HOR 11 | ; 12 | ; CALLING SEQUENCE: 13 | ; HADEC2ALTAZ, ha, dec, lat ,alt ,az [ /WS ] 14 | ; 15 | ; INPUTS 16 | ; ha - the local apparent hour angle, in DEGREES, scalar or vector 17 | ; dec - the local apparent declination, in DEGREES, scalar or vector 18 | ; lat - the local latitude, in DEGREES, scalar or vector 19 | ; 20 | ; OUTPUTS 21 | ; alt - the local apparent altitude, in DEGREES. 22 | ; az - the local apparent azimuth, in DEGREES, all results in double 23 | ; precision 24 | ; OPTIONAL KEYWORD INPUT: 25 | ; /WS - Set this keyword for the output azimuth to be measured West from 26 | ; South. The default is to measure azimuth East from North. 27 | ; 28 | ; EXAMPLE: 29 | ; What were the apparent altitude and azimuth of the sun when it transited 30 | ; the local meridian at Pine Bluff Observatory (Lat=+43.07833 degrees) on 31 | ; April 21, 2002? An object transits the local meridian at 0 hour angle. 32 | ; Assume this will happen at roughly 1 PM local time (18:00 UTC). 33 | ; 34 | ; IDL> jdcnv, 2002, 4, 21, 18., jd ; get rough Julian date to determine 35 | ; ;Sun ra, dec. 36 | ; IDL> sunpos, jd, ra, dec 37 | ; IDL> hadec2altaz, 0., dec, 43.078333, alt, az 38 | ; 39 | ; ===> Altitude alt = 58.90 40 | ; Azimuth az = 180.0 41 | 42 | ; REVISION HISTORY: 43 | ; Written Chris O'Dell Univ. of Wisconsin-Madison May 2002 44 | ;- 45 | 46 | if N_params() LT 4 then begin 47 | print,'Syntax - HADEC2ALTAZ, ha, dec, lat ,alt ,az [ /WS ]' 48 | return 49 | endif 50 | 51 | d2r = !dpi/180. 52 | 53 | sh = sin(ha*d2r) & ch = cos(ha*d2r) 54 | sd = sin(dec*d2r) & cd = cos(dec*d2r) 55 | sl = sin(lat*d2r) & cl = cos(lat*d2r) 56 | 57 | x = - ch * cd * sl + sd * cl 58 | y = - sh * cd 59 | z = ch * cd * cl + sd * sl 60 | r = sqrt(x^2 + y^2) 61 | ; now get Alt, Az 62 | 63 | az = atan(y,x) /d2r 64 | alt = atan(z,r) / d2r 65 | 66 | ; correct for negative AZ 67 | w = where(az LT 0) 68 | if w[0] ne -1 then az[w] = az[w] + 360. 69 | 70 | ; convert AZ to West from South, if desired 71 | if keyword_set(WS) then az = (az + 180.) mod 360. 72 | 73 | 74 | END -------------------------------------------------------------------------------- /pro/hgrep.pro: -------------------------------------------------------------------------------- 1 | pro hgrep, header, substring, keepcase=keepcase, linenum=linenum 2 | 3 | ;+ 4 | ; NAME: 5 | ; HGREP 6 | ; 7 | ; PURPOSE: 8 | ; Find a substring in a FITS header (or any other string array) 9 | ; 10 | ; CALLING SEQUENCE: 11 | ; HGREP, header, substring, [/KEEPCASE, /LINENUM ] 12 | ; 13 | ; INPUTS: 14 | ; header - FITS header or other string array 15 | ; substring - scalar string to find in header; if a numeric value is 16 | ; supplied, it will be converted to type string 17 | ; 18 | ; OPTIONAL INPUT KEYWORDS: 19 | ; /KEEPCASE: if set, then look for an exact match of the input substring 20 | ; Default is to ignore case . 21 | ; /LINENUM: if set, prints line number of header in which 22 | ; substring appears 23 | ; 24 | ; OUTPUTS: 25 | ; None, results are printed to screen 26 | ; 27 | ; EXAMPLE: 28 | ; Find every place in a FITS header that the word 'aperture' 29 | ; appears in lower case letters and print the element number 30 | ; of the header array: 31 | ; 32 | ; IDL> hgrep, header, 'aperture', /keepcase, /linenum 33 | ; 34 | ; HISTORY: 35 | ; Written, Wayne Landsman (Raytheon ITSS) August 1998 36 | ; Adapted from STIS version by Phil Plait/ ACC November 14, 1997 37 | ; Remove trailing spaces if a non-string is supplied W. Landsman Jun 2002 38 | ;- 39 | 40 | if (N_params() LT 2) then begin 41 | print,'Syntax - HGREP, header, substring, [/KEEPCASE, /LINENUM ]' 42 | return 43 | endif 44 | 45 | if N_elements(header) eq 0 then begin 46 | print,'first parameter not defined. Returning...' 47 | return 48 | endif 49 | hh = strtrim(header,2) 50 | if size(substring,/tname) NE 'STRING' then substring = strtrim(substring,2) 51 | 52 | if keyword_set(keepcase) then $ 53 | flag = strpos(hh,substring) $ 54 | else flag = strpos(strlowcase(hh),strlowcase(substring)) 55 | 56 | 57 | g = where(flag NE -1, Ng) 58 | if Ng GT 0 then $ 59 | if keyword_set(linenum) then $ 60 | for i = 0, Ng-1 do print, string(g[i],f='(i4)') + ': ' + hh[g[i]] $ 61 | else $ 62 | for i = 0, Ng-1 do print,hh[g[i]] 63 | 64 | return 65 | end 66 | -------------------------------------------------------------------------------- /pro/is_ieee_big.pro: -------------------------------------------------------------------------------- 1 | function is_ieee_big 2 | ;+ 3 | ; NAME: 4 | ; IS_IEEE_BIG 5 | ; PURPOSE: 6 | ; Determine if the current machine uses IEEE, big-endian numbers. 7 | ; EXPLANATION: 8 | ; (Big endian implies that byteorder XDR conversions are no-ops). 9 | ; CALLING SEQUENCE: 10 | ; flag = is_ieee_big() 11 | ; INPUT PARAMETERS: 12 | ; None 13 | ; RETURNS: 14 | ; 1 if the machine appears to be IEEE-compliant, 0 if not. 15 | ; COMMON BLOCKS: 16 | ; None. 17 | ; SIDE EFFECTS: 18 | ; None 19 | ; RESTRICTIONS: 20 | ; PROCEDURE: 21 | ; The first byte of the two-byte representation of 1 is examined. 22 | ; If it is zero, then the data is stored in big-endian order. 23 | ; MODIFICATION HISTORY: 24 | ; Written 15-April-1996 by T. McGlynn for use in MRDFITS. 25 | ; 13-jul-1997 jkf/acc - added calls to check_math to avoid 26 | ; underflow messages in V5.0 on Win32 (NT). 27 | ; Converted to IDL V5.0 W. Landsman September 1997 28 | ; Follow RSI and just do a single test W. Landsman April 2003 29 | ;- 30 | 31 | return, 1b - (byte(1,0,1))[0] 32 | end 33 | -------------------------------------------------------------------------------- /pro/isarray.pro: -------------------------------------------------------------------------------- 1 | ;+ 2 | ; NAME: 3 | ; ISARRAY 4 | ; PURPOSE: 5 | ; Test if the argument is an array or not. 6 | ; 7 | ; CALLING SEQUENCE: 8 | ; res = isarray(a) 9 | ; 10 | ; INPUTS: 11 | ; a - argument 12 | ; 13 | ; REVISION HISTORY: 14 | ; Rewritten from scratch, Ole Streicher, 2015 15 | ; 16 | ;- 17 | FUNCTION isarray, a 18 | res = size(a) 19 | return, res[0] ne 0 20 | END 21 | -------------------------------------------------------------------------------- /pro/jdcnv.pro: -------------------------------------------------------------------------------- 1 | PRO JDCNV, YR, MN, DAY, HR, JULIAN 2 | ;+ 3 | ; NAME: 4 | ; JDCNV 5 | ; PURPOSE: 6 | ; Converts Gregorian dates to Julian days 7 | ; 8 | ; EXPLANATION: 9 | ; For IDL versions V5.1 or greater, this procedure is superceded by 10 | ; JULDAY() function in the standard IDL distribution. Note, however, 11 | ; that prior to V5.1 there wasa bug in JULDAY() that gave answers off 12 | ; by 0.5 days. 13 | ; 14 | ; CALLING SEQUENCE: 15 | ; JDCNV, YR, MN, DAY, HR, JULIAN 16 | ; 17 | ; INPUTS: 18 | ; YR = Year, integer scalar or vector 19 | ; MN = Month integer (1-12) scalar or vector 20 | ; DAY = Day integer 1-31) scalar or vector 21 | ; HR = Hours and fractions of hours of universal time (U.T.), scalar 22 | ; or vector 23 | ; 24 | ; OUTPUTS: 25 | ; JULIAN = Julian date (double precision) 26 | ; 27 | ; EXAMPLE: 28 | ; To find the Julian Date at 1978 January 1, 0h (U.T.) 29 | ; 30 | ; IDL> JDCNV, 1978, 1, 1, 0., JULIAN 31 | ; 32 | ; will give JULIAN = 2443509.5 33 | ; NOTES: 34 | ; (1) JDCNV will accept vector arguments 35 | ; (2) JULDATE is an alternate procedure to perform the same function 36 | ; 37 | ; REVISON HISTORY: 38 | ; Converted to IDL from Don Yeomans Comet Ephemeris Generator, 39 | ; B. Pfarr, STX, 6/15/88 40 | ; Converted to IDL V5.0 W. Landsman September 1997 41 | ; Added checks on valid month, day ranges W. Landsman July 2008 42 | ;- 43 | On_error,2 44 | compile_opt idl2 45 | 46 | if N_params() LT 5 then begin 47 | print,'Syntax - JDCNV, yr, mn, day, hr, julian' 48 | print,' yr - Input Year (e.g. 1978), scalar or vector' 49 | print,' mn - Input Month (1-12), scalar or vector' 50 | print,' day - Input Day (1-31), scalar or vector' 51 | print,' hr - Input Hour (0-24), scalar or vector' 52 | print,' julian - output Julian date' 53 | return 54 | endif 55 | if max(mn) GT 12 then message,/con, $ 56 | 'Warning - Month number outside of expected range [1-12] ' 57 | if max(day) GT 31 then message,/con, $ 58 | 'Warning - Day number outside of expected range [1-31] ' 59 | 60 | yr = long(yr) & mn = long(mn) & day = long(day) ;Make sure integral 61 | L = (mn-14)/12 ;In leap years, -1 for Jan, Feb, else 0 62 | julian = day - 32075l + 1461l*(yr+4800l+L)/4 + $ 63 | 367l*(mn - 2-L*12)/12 - 3*((yr+4900l+L)/100)/4 64 | julian = double(julian) + (HR/24.0D) - 0.5D 65 | 66 | return 67 | end 68 | -------------------------------------------------------------------------------- /pro/list_with_path.pro: -------------------------------------------------------------------------------- 1 | FUNCTION LIST_WITH_PATH, FILENAME, PATHS, NOCURRENT=NOCURRENT, $ 2 | COUNT = COUNT 3 | ;+ 4 | ; NAME: 5 | ; LIST_WITH_PATH 6 | ; PURPOSE: 7 | ; Search for files in a specified directory path. 8 | ; EXPLANATION: 9 | ; Lists files in a set of default paths, similar to using FILE_SEARCH, 10 | ; except that a list of paths to be searched can be given. 11 | ; 12 | ; CALLING SEQUENCE: 13 | ; Result = LIST_WITH_PATH( FILENAME, PATHS ) 14 | ; 15 | ; INPUTS: 16 | ; FILENAME = Name of file to be searched for. It may contain wildcard 17 | ; characters, e.g. "*.dat". 18 | ; 19 | ; PATHS = One or more default paths to use in the search in case 20 | ; FILENAME does not contain a path itself. The individual 21 | ; paths are separated by commas, although in UNIX, colons 22 | ; can also be used. In other words, PATHS has the same 23 | ; format as !PATH, except that commas can be used as a 24 | ; separator regardless of operating system. The current 25 | ; directory is always searched first, unless the keyword 26 | ; NOCURRENT is set. 27 | ; 28 | ; A leading $ can be used in any path to signal that what 29 | ; follows is an environmental variable, but the $ is not 30 | ; necessary. Environmental variables can themselves 31 | ; contain multiple paths. 32 | ; 33 | ; OUTPUTS: 34 | ; The result of the function is a list of filenames. 35 | ; EXAMPLE: 36 | ; FILENAME = '' 37 | ; READ, 'File to open: ', FILENAME 38 | ; FILE = LIST_WITH_PATH( FILENAME, 'SERTS_DATA', '.fix' ) 39 | ; IF FILE NE '' THEN ... 40 | ; PROCEDURE CALLS: 41 | ; BREAK_PATH, CONCAT_DIR() 42 | ; Category : 43 | ; Utilities, Operating_system 44 | ; REVISION HISTORY: 45 | ; Version 1, William Thompson, GSFC, 3 November 1994 46 | ; Documentation modified Wayne Landsman HSTX November 1994 47 | ; Assume since V5.5, vector call to FILE_SEARCH() W. Landsman Sep 2006 48 | ; Restore pre-Sep 2006 behavior of not searching subdirectories 49 | ; W.Landsman. Feb 2007 50 | ;- 51 | ; 52 | COMPILE_OPT IDL2 53 | ON_ERROR, 2 54 | ; 55 | ; Check the number of parameters: 56 | ; 57 | IF N_PARAMS() NE 2 THEN MESSAGE, 'Syntax: Result = ' + $ 58 | 'LIST_WITH_PATH(FILENAME, PATHS)' 59 | 60 | PATH = BREAK_PATH(PATHS) 61 | ; 62 | ; If NOCURRENT was set, then remove the first (blank) entry from the PATH 63 | ; array. 64 | ; 65 | IF KEYWORD_SET(NOCURRENT) THEN PATH = PATH[1:*] 66 | 67 | FILES = FILE_SEARCH( CONCAT_DIR(PATH, FILENAME), COUNT=COUNT) 68 | ; 69 | RETURN, FILES 70 | END 71 | -------------------------------------------------------------------------------- /pro/mag2flux.pro: -------------------------------------------------------------------------------- 1 | function mag2flux, mag, zero_pt, ABwave = ABwave 2 | ;+ 3 | ; NAME: 4 | ; MAG2FLUX 5 | ; PURPOSE: 6 | ; Convert from magnitudes to flux (ergs/s/cm^2/A). 7 | ; EXPLANATION: 8 | ; Use FLUX2MAG() for the opposite direction. 9 | ; 10 | ; CALLING SEQUENCE: 11 | ; flux = mag2flux( mag, [ zero_pt, ABwave = ] ) 12 | ; 13 | ; INPUTS: 14 | ; mag - scalar or vector of magnitudes 15 | ; 16 | ; OPTIONAL INPUT: 17 | ; zero_pt - scalar giving the zero point level of the magnitude. 18 | ; If not supplied then zero_pt = 21.1 (Code et al. 1976) 19 | ; Ignored if the ABwave keyword is set. 20 | ; 21 | ; OPTIONAL KEYWORD INPUT: 22 | ; ABwave - wavelength scalar or vector in Angstroms. If supplied, then 23 | ; the input vector, mag, is assumed to contain Oke AB magnitudes 24 | ; (Oke & Gunn 1983, ApJ, 266, 713) 25 | ; 26 | ; OUTPUT: 27 | ; flux - scalar or vector flux vector, in erg cm-2 s-1 A-1 28 | ; If the ABwave keyword is set, then the flux is given by 29 | ; 30 | ; f = 10^(-0.4*(mag +2.406 + 4*alog10(ABwave))) 31 | ; 32 | ; Otherwise the flux is given by 33 | ; f = 10^(-0.4*(mag + zero_pt)) 34 | ; 35 | ; EXAMPLE: 36 | ; Suppose one is given vectors of wavelengths and AB magnitudes, w (in 37 | ; Angstroms) and mag. Plot the spectrum in erg cm-2 s-1 A-1 38 | ; 39 | ; IDL> plot, w, mag2flux(mag,ABwave = w) 40 | ; REVISION HISTORY: 41 | ; Written J. Hill STX Co. 1988 42 | ; Converted to IDL V5.0 W. Landsman September 1997 43 | ; Added ABwave keyword, W. Landsman September 1998 44 | ;- 45 | if ( N_params() lt 2 ) then zero_pt = 21.10 46 | 47 | if keyword_set(ABwave) then $ 48 | return, 10^(-0.4*(mag + 2.406 + 5*alog10(ABwave))) else $ 49 | return, 10^(-0.4*( mag + zero_pt)) 50 | 51 | end 52 | -------------------------------------------------------------------------------- /pro/make_2d.pro: -------------------------------------------------------------------------------- 1 | pro make_2d,x,y,xx,yy 2 | ;+ 3 | ; NAME: 4 | ; MAKE_2D 5 | ; PURPOSE: 6 | ; Change from 1-d indexing to 2-d indexing 7 | ; EXPLANATION: 8 | ; Convert an N element X vector, and an M element Y vector, into 9 | ; N x M arrays giving all possible combination of X and Y pairs. 10 | ; Useful for obtaining the X and Y positions of each element of 11 | ; a regular grid. 12 | ; 13 | ; CALLING SEQUENCE: 14 | ; MAKE_2D, X, Y, [ XX, YY ] 15 | ; 16 | ; INPUTS: 17 | ; X - N element vector of X positions 18 | ; Y - M element vector of Y positions 19 | ; 20 | ; OUTPUTS: 21 | ; XX - N x M element array giving the X position at each pixel 22 | ; YY - N x M element array giving the Y position of each pixel 23 | ; If only 2 parameters are supplied then X and Y will be 24 | ; updated to contain the output arrays 25 | ; 26 | ; EXAMPLE: 27 | ; To obtain the X and Y position of each element of a 30 x 15 array 28 | ; 29 | ; IDL> x = indgen(30) & y = indgen(15) 30 | ; IDL> make_2d, x, y 31 | ; REVISION HISTORY: 32 | ; Written, Wayne Landsman ST Systems Co. May, 1988 33 | ; Added /NOZERO keyword W. Landsman Mar, 1991 34 | ; Converted to IDL V5.0 W. Landsman September 1997 35 | ; Improved speed P. Broos July 2000 36 | ;- 37 | On_error,2 38 | if N_params() LT 2 then begin 39 | print,'Syntax - make_2d, x, y, [xx, yy]' 40 | print,' x,y - Input X,Y vectors' 41 | print,' xx,yy - Output arrays specifying X and Y indices' 42 | return 43 | endif 44 | 45 | ny = N_elements(y) 46 | nx = N_elements(x) 47 | 48 | xx = rebin(reform(x, nx, 1,/OVERWRITE), nx, ny, /SAMPLE) 49 | yy = rebin(reform(y, 1, ny,/OVERWRITE), nx, ny, /SAMPLE) 50 | 51 | if N_params() LT 3 then begin ;Update X and Y vectors 52 | x = temporary(xx) 53 | y = temporary(yy) 54 | endif 55 | 56 | return 57 | end 58 | -------------------------------------------------------------------------------- /pro/medsmooth.pro: -------------------------------------------------------------------------------- 1 | FUNCTION MEDSMOOTH,ARRAY,WINDOW 2 | ;+ 3 | ; NAME: 4 | ; MEDSMOOTH 5 | ; 6 | ; PURPOSE: 7 | ; Median smoothing of a vector, including points near its ends. 8 | ; 9 | ; CALLING SEQUENCE: 10 | ; SMOOTHED = MEDSMOOTH( VECTOR, WINDOW_WIDTH ) 11 | ; 12 | ; INPUTS: 13 | ; VECTOR = The (1-d numeric) vector to be smoothed 14 | ; WINDOW = Odd integer giving the full width of the window over which 15 | ; the median is determined for each point. (If WINDOW is 16 | ; specified as an even number, then the effect is the same as 17 | ; using WINDOW+1) 18 | ; 19 | ; OUTPUT: 20 | ; Function returns the smoothed vector 21 | ; 22 | ; PROCEDURE: 23 | ; Each point is replaced by the median of the nearest WINDOW of points. 24 | ; The width of the window shrinks towards the ends of the vector, so that 25 | ; only the first and last points are not filtered. These points are 26 | ; replaced by forecasting from smoothed interior points. 27 | ; 28 | ; EXAMPLE: 29 | ; Create a vector with isolated high points near its ends 30 | ; IDL> a = randomn(seed,40) & a[1] = 10 & a[38] = 10 31 | ; Now do median smoothing with a 7 point window 32 | ; IDL> b = medsmooth(a,7) 33 | ; Note that, unlike MEDIAN(), that MEDSMOOTH will remove the isolated 34 | ; high points near the ends. 35 | ; REVISION HISTORY: 36 | ; Written, H. Freudenreich, STX, 12/89 37 | ; H.Freudenreich, 8/90: took care of end-points by shrinking window. 38 | ; Speed up using vector median when possible W. Landsman February 2002 39 | ;- 40 | 41 | LEND = N_ELEMENTS(ARRAY)-1 42 | IF (LEND+1) LT WINDOW THEN BEGIN 43 | message,/CON, $ 44 | 'ERROR - Size of smoothing window must be smaller than array size' 45 | RETURN,ARRAY 46 | ENDIF 47 | 48 | OFFSET = FIX(WINDOW/2) 49 | 50 | smoothed = median(array, window ) 51 | 52 | ; Fix the ends: 53 | NUMLOOP = (WINDOW-1)/2 - 1 54 | IF NUMLOOP GT 0 THEN BEGIN 55 | FOR J=1,NUMLOOP DO BEGIN 56 | 57 | LEN = 2*J+1 58 | SMOOTHED[J] = MEDIAN(ARRAY[0:LEN-1]) 59 | SMOOTHED[LEND-J] = MEDIAN(ARRAY[LEND-LEN+1:LEND]) 60 | 61 | ENDFOR 62 | ENDIF 63 | 64 | ; Now replace the very last and first points: 65 | Y0 = 3.*ARRAY[0]-2.*ARRAY[1] ; Predicted value of point -1 66 | SMOOTHED[0] = MEDIAN([Y0,ARRAY[0],ARRAY[1]]) 67 | Y0 = 3.*ARRAY[LEND]-2.*ARRAY[LEND-1] ; Predicted value of point LEND+1 68 | SMOOTHED[LEND] = MEDIAN([Y0,ARRAY[LEND],ARRAY[LEND-1]]) 69 | 70 | RETURN,SMOOTHED 71 | END 72 | -------------------------------------------------------------------------------- /pro/month_cnv.pro: -------------------------------------------------------------------------------- 1 | function month_cnv, MonthInput, Up=Up, Low=Low, Short=Short 2 | ;\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\ 3 | ;+ 4 | ; NAME: 5 | ; MONTH_CNV 6 | ; PURPOSE: 7 | ; Convert between a month name and the equivalent number 8 | ; EXPLANATION: (e.g., 9 | ; For example, converts from 'January' to 1 or vice-versa. 10 | ; CALLING SEQUENCE: 11 | ; Result = MONTH_CNV( MonthInput, [/UP, /LOW, /SHORT ] ) 12 | ; INPUTS: 13 | ; MonthInput - either a string ('January', 'Jan', 'Decem', etc.) or 14 | ; an number from 1 to 12. Scalar or array. 15 | ; OPTIONAL KEYWORDS: 16 | ; UP - if set and if a string is being returned, it will be in all 17 | ; uppercase letters. 18 | ; LOW - if set and if a string is being returned, it will be in all 19 | ; lowercase letters. 20 | ; SHORT - if set and if a string is being returned, only the first 21 | ; three letters are returned. 22 | ; 23 | ; OUTPUTS: 24 | ; If the input is a string, the output is the matching month number.If 25 | ; an input string isn't a valid month name, -1 is returned. 26 | ; If the input is a number, the output is the matching month name. The 27 | ; default format is only the first letter is capitalized. 28 | ; EXAMPLE: 29 | ; To get a vector of all the month names: 30 | ; Names = month_cnv(indgen(12)+1) 31 | ; 32 | ; MODIFICATION HISTORY: 33 | ; Written by: Joel Wm. Parker, SwRI, 1998 Dec 9 34 | ;- 35 | ;/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/ 36 | 37 | NumElem = n_elements(MonthInput) 38 | 39 | MonthNames = [' ', 'January', 'February', 'March', 'April', 'May', 'June', $ 40 | 'July', 'August', 'September', 'October', 'November', 'December'] 41 | MonthShort = strupcase(strmid(MonthNames,0,3)) 42 | 43 | 44 | if size(MonthInput,/TNAME) EQ 'STRING' then begin 45 | Result = intarr(NumElem) - 1 46 | ShortInput = strupcase(strmid(strtrim(MonthInput,2),0,3)) 47 | for N=1,12 do begin 48 | Mask = where(MonthShort[N] eq ShortInput) 49 | if (Mask[0] ne -1) then Result[Mask] = N 50 | endfor 51 | endif else begin 52 | if ( (min(MonthInput) lt 1) or (max(MonthInput) gt 12) ) then begin 53 | message, /CON, "Bad input values. Month numbers must be 1-12." 54 | Result = '' 55 | endif else begin 56 | Result = MonthNames[MonthInput] 57 | if keyword_set(Short) then Result = strmid(Result,0,3) 58 | if keyword_set(Up) then Result = strupcase(Result) 59 | if keyword_set(Low) then Result = strlowcase(Result) 60 | endelse 61 | endelse 62 | 63 | if (NumElem eq 1) then Result = Result[0] 64 | 65 | return, Result 66 | end ; function MONTH_CNV 67 | 68 | 69 | -------------------------------------------------------------------------------- /pro/mphase.pro: -------------------------------------------------------------------------------- 1 | pro mphase,jd, k 2 | ;+ 3 | ; NAME: 4 | ; MPHASE 5 | ; PURPOSE: 6 | ; Return the illuminated fraction of the Moon at given Julian date(s) 7 | ; 8 | ; CALLING SEQUENCE: 9 | ; MPHASE, jd, k 10 | ; INPUT: 11 | ; JD - Julian date, scalar or vector, double precision recommended 12 | ; OUTPUT: 13 | ; k - illuminated fraction of Moon's disk (0.0 < k < 1.0), same number 14 | ; of elements as jd. k = 0 indicates a new moon, while k = 1 for 15 | ; a full moon. 16 | ; EXAMPLE: 17 | ; Plot the illuminated fraction of the moon for every day in July 18 | ; 1996 at 0 TD (~Greenwich noon). 19 | ; 20 | ; IDL> jdcnv, 1996, 7, 1, 0, jd ;Get Julian date of July 1 21 | ; IDL> mphase, jd+dindgen(31), k ;Moon phase for all 31 days 22 | ; IDL> plot, indgen(31),k ;Plot phase vs. July day number 23 | ; 24 | ; METHOD: 25 | ; Algorithm from Chapter 46 of "Astronomical Algorithms" by Jean Meeus 26 | ; (Willmann-Bell, Richmond) 1991. SUNPOS and MOONPOS are used to get 27 | ; positions of the Sun and the Moon (and the Moon distance). The 28 | ; selenocentric elongation of the Earth from the Sun (phase angle) 29 | ; is then computed, and used to determine the illuminated fraction. 30 | ; PROCEDURES CALLED: 31 | ; MOONPOS, SUNPOS 32 | ; REVISION HISTORY: 33 | ; Written W. Landsman Hughes STX June 1996 34 | ; Converted to IDL V5.0 W. Landsman September 1997 35 | ; Use /RADIAN keywords to MOONPOS, SUNPOS internally W. Landsman Aug 2000 36 | ;- 37 | On_error,2 38 | 39 | if N_params() LT 2 then begin 40 | print,'Syntax - MPHASE, jd, k' 41 | return 42 | endif 43 | diss = 1.49598e8 ;Earth-Sun distance (1 AU) 44 | 45 | moonpos, jd, ram, decm, dism, /RADIAN 46 | sunpos, jd, ras, decs, /RADIAN 47 | 48 | ; phi - geocentric elongation of the Moon from the Sun 49 | ; inc - selenocentric (Moon centered) elongation of the Earth from the Sun 50 | 51 | phi = acos( sin(decs)*sin(decm) + cos(decs)*cos(decm)*cos(ras-ram) ) 52 | inc = atan( diss * sin(phi), dism - diss*cos(phi) ) 53 | k = (1 + cos(inc))/2. 54 | 55 | return 56 | end 57 | -------------------------------------------------------------------------------- /pro/mrandomn.pro: -------------------------------------------------------------------------------- 1 | function mrandomn, seed, covar, nrand, STATUS = status 2 | 3 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 4 | ;+ 5 | ; NAME: 6 | ; MRANDOMN 7 | ; PURPOSE: 8 | ; Function to draw NRAND random deviates from a multivariate normal 9 | ; distribution with zero mean and covariance matrix COVAR. 10 | ; 11 | ; AUTHOR : Brandon C. Kelly, Steward Obs., Sept. 2004 12 | ; 13 | ; INPUTS : 14 | ; 15 | ; SEED - The random number generator seed, the default is IDL's 16 | ; default in RANDOMN() 17 | ; COVAR - The covariance matrix of the multivariate normal 18 | ; distribution. 19 | ; OPTIONAL INPUTS : 20 | ; 21 | ; NRAND - The number of randomn deviates to draw. The default is 22 | ; one. 23 | ; OUTPUT : 24 | ; 25 | ; The random deviates, an [NRAND, NP] array where NP is the 26 | ; dimension of the covariance matrix, i.e., the number of 27 | ; parameters. 28 | ; 29 | ; OPTIONAL OUTPUT: 30 | ; STATUS - status of the Cholesky decomposition. If STATUS = 0 then 31 | ; the computation was successful. If STATUS > 0 then the 32 | ; input covariance matrix is not positive definite (see LA_CHOLDC), 33 | ; and MRANDOMN 34 | ; Note that if a STATUS keyword is supplied then no error message 35 | ; will be printed. 36 | ; REVISION HISTORY: 37 | ; Oct. 2013 -- Use LA_CHOLDC instead of CHOLDC to enable use of STATUS 38 | ; keyword. W. Landsman 39 | ;- 40 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 41 | 42 | if n_params() lt 2 then begin 43 | print, 'Syntax- Result = mrandomn( seed, covar, [nrand] , STATUS = )' 44 | return, 0 45 | endif 46 | 47 | printerr = ~arg_present(errmsg) 48 | errmsg = '' 49 | 50 | 51 | ;check inputs and set up defaults 52 | if n_elements(nrand) eq 0 then nrand = 1 53 | if size(covar, /n_dim) ne 2 then begin 54 | print, 'COVAR must be a matrix.' 55 | return, 0 56 | endif 57 | 58 | np = (size(covar))[1] 59 | if (size(covar))[2] ne np then begin 60 | print, 'COVAR must be a square matrix.' 61 | return, 0 62 | endif 63 | 64 | epsilon = randomn(seed, nrand, np) ;standard normal random deviates (NP x NRAND matrix) 65 | 66 | A = covar ;store covariance into dummy variable for input into TRIRED 67 | 68 | la_choldc, A, /double, status=status ;do Cholesky decomposition 69 | if status NE 0 then begin 70 | message,'Array is not positive definite, STATUS = ' + strtrim(status,2),/CON 71 | return,-1 72 | endif 73 | 74 | for i = 0, np - 2 do A[i+1:*,i] = 0d ;Zero out upper triangular portion 75 | 76 | ;transform standard normal deviates so they have covariance matrix COVAR 77 | epsilon = A ## epsilon 78 | 79 | return, epsilon 80 | end 81 | -------------------------------------------------------------------------------- /pro/multinom.pro: -------------------------------------------------------------------------------- 1 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 2 | ;+ 3 | ; NAME: 4 | ; MULTINOM 5 | ; PURPOSE: 6 | ; SIMULATE MULTINOMIAL RANDOM VARIABLES 7 | ; 8 | ; AUTHOR : BRANDON C. KELLY, STEWARD OBS., APR 2006 9 | ; 10 | ; INPUTS : 11 | ; 12 | ; N - THE NUMBER OF TRIALS 13 | ; P - A K-ELEMENT VECTOR CONTAINING THE PROBABILITIES FOR EACH 14 | ; CLASS. 15 | ; 16 | ; OPTIONAL INPUTS : 17 | ; 18 | ; NRAND - THE NUMBER OF RANDOM VARIABLES TO DRAW 19 | ; SEED - THE SEED FOR THE RANDOM NUMBER GENERATOR 20 | ; 21 | ; OUTPUT : 22 | ; NRAND RANDOM DRAWS FROM A MULTINOMIAL DISTRIBUTION WITH PARAMETERS 23 | ; N AND P. 24 | ;- 25 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 26 | 27 | function multinom, n, p, nrand, seed=seed 28 | 29 | if n_params() lt 2 then begin 30 | print, 'Syntax- theta = multinom( n, p,[ nrand, seed=seed] )' 31 | return, 0 32 | endif 33 | 34 | k = n_elements(p) 35 | 36 | bad = where(p lt 0 or p gt 1, nbad) 37 | if nbad gt 0 then begin 38 | print, 'All element of p must be 0 <= p <= 1.' 39 | return, 0 40 | endif 41 | 42 | if n lt 1 then begin 43 | print, 'N must be at least 1.' 44 | return, 0 45 | endif 46 | 47 | if n_elements(nrand) eq 0 then nrand = 1 48 | 49 | ;check if binomial 50 | if k eq 2 then begin 51 | 52 | binom = randomu(seed, nrand, binomial=[n, p[0]], /double) 53 | multi = [[binom], [n - binom]] 54 | 55 | return, transpose(multi) 56 | 57 | endif 58 | 59 | multi = lonarr(k, nrand) 60 | 61 | for i = 0L, nrand - 1 do begin 62 | 63 | multi[0,i] = randomu(seed, 1, binomial=[n, p[0]], /double) 64 | j = 1L 65 | nj = n - total(multi[0:j-1,i]) 66 | 67 | while nj gt 0 do begin 68 | 69 | pj = p[j] / total(p[j:*]) 70 | 71 | multi[j,i] = randomu(seed, 1, binomial=[nj,pj], /double) 72 | 73 | j = j + 1 74 | nj = n - total(multi[0:j-1,i]) 75 | 76 | endwhile 77 | 78 | endfor 79 | 80 | return, multi 81 | end 82 | -------------------------------------------------------------------------------- /pro/n_bytes.pro: -------------------------------------------------------------------------------- 1 | function N_bytes,a 2 | ;+ 3 | ; NAME: 4 | ; N_bytes() 5 | ; 6 | ; PURPOSE: 7 | ; To return the total number of bytes in data element 8 | ; 9 | ; CALLING SEQUENCE: 10 | ; result = N_bytes(a) 11 | ; 12 | ; INPUTS: 13 | ; a - any idl data element, scalar or array 14 | ; 15 | ; OUTPUTS: 16 | ; total number of bytes in a is returned as the function value 17 | ; (64bit longword scalar) 18 | ; NOTES: 19 | ; (1) Not valid for object or pointer data types 20 | ; (2) For a string array, the number of bytes is computed after conversion 21 | ; with the BYTE() function, i.e. each element has the same length, 22 | ; equal to the maximum individual string length. 23 | ; 24 | ; MODIFICATION HISTORY: 25 | ; Version 1 By D. Lindler Oct. 1986 26 | ; Include new IDL data types W. Landsman June 2001 27 | ; Now return a 64bit integer W. Landsman April 2006 28 | ;- 29 | ;----------------------------------------------------- 30 | ; 31 | dtype = size(a,/type) ;data type 32 | if dtype EQ 0 then return,0 ;undefined 33 | nel = N_elements(a) 34 | case dtype of 35 | 1: nb = 1 ;Byte 36 | 2: nb = 2 ;16 bit signed integer 37 | 3: nb = 4 ;32 bit signed integer 38 | 4: nb = 4 ;Float 39 | 5: nb = 8 ;Double 40 | 6: nb = 8 ;Complex 41 | 7: nb = max(strlen(a)) ;String 42 | 8: nb = N_tags(a,/length) ;Structure 43 | 9: nb = 16 ;Double Complex 44 | 12: nb = 2 ;Unsigned 16 bit Integer 45 | 13: nb = 4 ;Unsigned 32 bit Integer 46 | 14: nb = 8 ;64 bit signed integer 47 | 15: nb = 8 ;64 bit unsigned integer 48 | else: message,'ERROR - Object or Pointer data types not valid' 49 | endcase 50 | 51 | return,long64(nel)*nb 52 | end 53 | -------------------------------------------------------------------------------- /pro/nint.pro: -------------------------------------------------------------------------------- 1 | function nint, x, LONG = long ;Nearest Integer Function 2 | ;+ 3 | ; NAME: 4 | ; NINT 5 | ; PURPOSE: 6 | ; Nearest integer function. 7 | ; EXPLANATION: 8 | ; NINT() is similar to the intrinsic ROUND function, with the following 9 | ; two differences: 10 | ; (1) if no absolute value exceeds 32767, then the array is returned as 11 | ; as a type INTEGER instead of LONG 12 | ; (2) NINT will work on strings, e.g. print,nint(['3.4','-0.9']) will 13 | ; give [3,-1], whereas ROUND() gives an error message 14 | ; 15 | ; CALLING SEQUENCE: 16 | ; result = nint( x, [ /LONG] ) 17 | ; 18 | ; INPUT: 19 | ; X - An IDL variable, scalar or vector, usually floating or double 20 | ; Unless the LONG keyword is set, X must be between -32767.5 and 21 | ; 32767.5 to avoid integer overflow 22 | ; 23 | ; OUTPUT 24 | ; RESULT - Nearest integer to X 25 | ; 26 | ; OPTIONAL KEYWORD INPUT: 27 | ; LONG - If this keyword is set and non-zero, then the result of NINT 28 | ; is of type LONG. Otherwise, the result is of type LONG if 29 | ; any absolute values exceed 32767, and type INTEGER if all 30 | ; all absolute values are less than 32767. 31 | ; EXAMPLE: 32 | ; If X = [-0.9,-0.1,0.1,0.9] then NINT(X) = [-1,0,0,1] 33 | ; 34 | ; PROCEDURE CALL: 35 | ; None: 36 | ; REVISION HISTORY: 37 | ; Written W. Landsman January 1989 38 | ; Added LONG keyword November 1991 39 | ; Use ROUND if since V3.1.0 June 1993 40 | ; Always start with ROUND function April 1995 41 | ; Return LONG values, if some input value exceed 32767 42 | ; and accept string values February 1998 43 | ; Use size(/TNAME) instead of DATATYPE() October 2001 44 | ;- 45 | xmax = max(x,min=xmin) 46 | xmax = abs(xmax) > abs(xmin) 47 | if (xmax gt 32767) or keyword_set(long) then begin 48 | if size(x,/TNAME) eq 'STRING' then b = round(float(x)) else b = round(x) 49 | end else begin 50 | if size(x,/TNAME) eq 'STRING' then b = fix(round(float(x))) else $ 51 | b = fix(round(x)) 52 | endelse 53 | 54 | return, b 55 | end 56 | -------------------------------------------------------------------------------- /pro/nulltrim.pro: -------------------------------------------------------------------------------- 1 | function nulltrim,st 2 | ;+ 3 | ; NAME: 4 | ; NULLTRIM 5 | ; PURPOSE: 6 | ; Trim a string of all characters after and including the first null 7 | ; EXPLANATION: 8 | ; The null character is an ascii 0b 9 | ; 10 | ; CALLING SEQUENCE: 11 | ; result = nulltrim( st ) 12 | ; 13 | ; INPUTS: 14 | ; st = input string 15 | ; OUTPUTS: 16 | ; trimmed string returned as the function value. 17 | ; HISTORY: 18 | ; D. Lindler July, 1987 19 | ; Converted to IDL V5.0 W. Landsman September 1997 20 | ;- 21 | ;-------------------------------------------------------------------- 22 | ; 23 | b = byte(st) 24 | null = where( b eq 0, nfound ) 25 | if nfound lt 1 then return, st else return, strmid( st,0,null[0] ) 26 | end 27 | -------------------------------------------------------------------------------- /pro/one_ray.pro: -------------------------------------------------------------------------------- 1 | pro one_ray,xcen,ycen,len,angle,terminus,nodraw=nodraw, _EXTRA=_extra, $ 2 | data = data, normal = normal 3 | ;+ 4 | ; NAME: 5 | ; ONE_RAY 6 | ; PURPOSE: 7 | ; Draw a line with a specified starting point, length, and angle 8 | ; 9 | ; CALLING SEQUENCE: 10 | ; one_ray, xcen, ycen, len, angle, terminus, /NODRAW ] 11 | ; 12 | ; INPUT PARAMETERS: 13 | ; xcen, ycen = starting point in device coordinates, floating point 14 | ; scalars 15 | ; len = length in pixels, device coordinates 16 | ; angle = angle in degrees counterclockwise from +X direction 17 | ; 18 | ; OUTPUT PARAMETERS: 19 | ; terminus = two-element vector giving ending point of ray in device 20 | ; coordinates 21 | ; 22 | ; OPTIONAL KEYWORD INPUT PARAMETERS: 23 | ; /nodraw if non-zero, the ray is not actually drawn, but the terminus 24 | ; is still calculated 25 | ; 26 | ; Any valid keyword to cgPLOTS can also be passed ot ONE_RAY. In 27 | ; particular, COLOR, THICK, and LINESTYLE control the color, thickness 28 | ; and linestyle of the drawn line. 29 | ; EXAMPLE: 30 | ; Draw a double thickness line of length 32 pixels from (256,256) 31 | ; 45 degrees counterclockwise from the X axis 32 | ; 33 | ; IDL> one_ray, 256, 256, 32, 45 ,term, THICK = 2 34 | ; 35 | ; PROCEDURE: straightforward matrix arithmetic 36 | ; 37 | ; MODIFICATION HISTORY: 38 | ; Written by R. S. Hill, Hughes STX Corp., 20-May-1992. 39 | ; Modified to work correctly for COLOR=0 J.Wm.Parker HITC 1995 May 25 40 | ; Added _EXTRA keywords to PLOT W. Landsman November 2006 41 | ; Work with Coyote Graphcis W. Landsman February 2011 42 | ;- 43 | On_error,2 44 | compile_opt idl2 45 | 46 | if N_params() LT 3 then begin 47 | print,'Syntax - one_ray, xcen, ycen, len, angle, [terminus,] ' + $ 48 | '[ /DATA, /NORMAL, THICK= ,COLOR =, /NODRAW ]' 49 | endif 50 | 51 | device = ~keyword_set(normal) && ~keyword_set(data) 52 | sina = sin(angle/!radeg) 53 | cosa = cos(angle/!radeg) 54 | rot_mat = [ [ cosa, sina ], [-sina, cosa ] ] 55 | terminus = (rot_mat # [len, 0.0]) + [xcen, ycen] 56 | 57 | if ~keyword_set(nodraw) then $ 58 | cgplots, [xcen, terminus[0]], [ycen, terminus[1]], $ 59 | DEVICE=device, Normal=Normal,_STRICT_Extra= _extra 60 | 61 | return 62 | end 63 | -------------------------------------------------------------------------------- /pro/ordinal.pro: -------------------------------------------------------------------------------- 1 | FUNCTION ordinal,num 2 | ;+ 3 | ; NAME: 4 | ; ORDINAL 5 | ; PURPOSE: 6 | ; Convert an integer to a correct English ordinal string: 7 | ; EXPLANATION: 8 | ; The first four ordinal strings are "1st", "2nd", "3rd", "4th" .... 9 | ; 10 | ; CALLING SEQUENCE: 11 | ; result = ordinal( num ) 12 | ; 13 | ; INPUT PARAMETERS: 14 | ; num = number to be made an ordinal. If float, will be FIXed. 15 | ; 16 | ; OUTPUT PARAMETERS: 17 | ; result = string such as '1st' '3rd' '164th' '87th', etc. 18 | ; 19 | ; MODIFICATION HISTORY: 20 | ; Written by R. S. Hill, STX, 8 Aug. 1991 21 | ; Converted to IDL V5.0 W. Landsman September 1997 22 | ;- 23 | On_error,2 24 | num = fix(num) 25 | CASE num MOD 100 OF 26 | 11: suffix = 'th' 27 | 12: suffix = 'th' 28 | 13: suffix = 'th' 29 | ELSE: CASE num MOD 10 OF 30 | 1: suffix = 'st' 31 | 2: suffix = 'nd' 32 | 3: suffix = 'rd' 33 | ELSE: suffix = 'th' 34 | ENDCASE 35 | ENDCASE 36 | RETURN,strtrim(string(num),2)+suffix 37 | END 38 | -------------------------------------------------------------------------------- /pro/planck.pro: -------------------------------------------------------------------------------- 1 | function planck,wave,temp 2 | ;+ 3 | ; NAME: 4 | ; PLANCK() 5 | ; PURPOSE: 6 | ; To calculate the Planck function in units of ergs/cm2/s/A 7 | ; 8 | ; CALLING SEQUENCE: 9 | ; bbflux = PLANCK( wave, temp) 10 | ; 11 | ; INPUT PARAMETERS: 12 | ; WAVE Scalar or vector giving the wavelength(s) in **Angstroms** 13 | ; at which the Planck function is to be evaluated. 14 | ; TEMP Scalar giving the temperature of the planck function in degree K 15 | ; 16 | ; OUTPUT PARAMETERS: 17 | ; BBFLUX - Scalar or vector giving the blackbody flux (i.e. !pi*Intensity) 18 | ; in erg/cm^2/s/A in at the specified wavelength points. 19 | ; 20 | ; EXAMPLES: 21 | ; To calculate the blackbody flux at 30,000 K every 100 Angstroms between 22 | ; 2000A and 2900 A 23 | ; 24 | ; IDL> wave = 2000 + findgen(10)*100 25 | ; IDL> bbflux = planck(wave,30000) 26 | ; 27 | ; If a star with a blackbody spectrum has a radius R, and distance,d, then 28 | ; the flux at Earth in erg/cm^2/s/A will be bbflux*R^2/d^2 29 | ; PROCEDURE: 30 | ; The wavelength data are converted to cm, and the Planck function 31 | ; is calculated for each wavelength point. See Allen (1973), Astrophysical 32 | ; Quantities, section 44 for more information. 33 | ; 34 | ; NOTES: 35 | ; See the procedure planck_radiance.pro in 36 | ; ftp://origin.ssec.wisc.edu/pub/paulv/idl/Radiance/planck_radiance.pro 37 | ; for computation of Planck radiance given wavenumber in cm-1 or 38 | ; wavelength in microns 39 | ; MODIFICATION HISTORY: 40 | ; Adapted from the IUE RDAF August, 1989 41 | ; Converted to IDL V5.0 W. Landsman September 1997 42 | ; Improve precision of constants W. Landsman January 2002 43 | ;- 44 | On_error,2 45 | 46 | if ( N_elements(wave) LT 1 ) then begin 47 | print,'Syntax - bbflux = planck( wave, temp)' 48 | return,0 49 | endif 50 | 51 | if ( N_elements( temp ) NE 1 ) then $ 52 | read,'Enter a blackbody temperature', temp 53 | 54 | bbflux = wave*0. 55 | 56 | ; Gives the blackbody flux (i.e. PI*Intensity) ergs/cm2/s/a 57 | 58 | w = wave / 1.E8 ; Angstroms to cm 59 | ;constants appropriate to cgs units. 60 | c1 = 3.7417749d-5 ; =2*!DPI*h*c*c 61 | C2 = 1.4387687d ; =h*c/k 62 | val = c2/w/temp 63 | mstr = machar(double = (size(val,/type) EQ 5) ) ;Get machine precision 64 | good = where( val LT alog(mstr.xmax), Ngood ) ;Avoid floating underflow 65 | 66 | if ( Ngood GT 0 ) then $ 67 | bbflux[ good ] = C1 / ( w[good]^5 * ( exp( val[good])-1. ) ) 68 | 69 | return, bbflux*1.E-8 ; Convert to ergs/cm2/s/A 70 | 71 | end 72 | -------------------------------------------------------------------------------- /pro/polint.pro: -------------------------------------------------------------------------------- 1 | pro polint, xa, ya, x, y, dy 2 | ;+ 3 | ; NAME: 4 | ; POLINT 5 | ; PURPOSE: 6 | ; Interpolate a set of N points by fitting a polynomial of degree N-1 7 | ; EXPLANATION: 8 | ; Adapted from algorithm in Numerical Recipes, Press et al. (1992), 9 | ; Section 3.1. 10 | ; 11 | ; CALLING SEQUENCE 12 | ; POLINT, xa, ya, x, y, [ dy ] 13 | ; INPUTS: 14 | ; XA - X Numeric vector, all values must be distinct. The number of 15 | ; values in XA should rarely exceed 10 (i.e. a 9th order polynomial) 16 | ; YA - Y Numeric vector, same number of elements 17 | ; X - Numeric scalar specifying value to be interpolated 18 | ; 19 | ; OUTPUT: 20 | ; Y - Scalar, interpolated value in (XA,YA) corresponding to X 21 | ; 22 | ; OPTIONAL OUTPUT 23 | ; DY - Error estimate on Y, scalar 24 | ; 25 | ; EXAMPLE: 26 | ; Find sin(2.5) by polynomial interpolation on sin(indgen(10)) 27 | ; 28 | ; IDL> xa = indgen(10) 29 | ; IDL> ya = sin( xa ) 30 | ; IDL> polint, xa, ya, 2.5, y ,dy 31 | ; 32 | ; The above method gives y = .5988 & dy = 3.1e-4 a close 33 | ; approximation to the actual sin(2.5) = .5985 34 | ; 35 | ; METHOD: 36 | ; Uses Neville's algorithm to iteratively build up the correct 37 | ; polynomial, with each iteration containing one higher order. 38 | ; 39 | ; REVISION HISTORY: 40 | ; Written W. Landsman January, 1992 41 | ; Converted to IDL V5.0 W. Landsman September 1997 42 | ;- 43 | On_error,2 44 | 45 | if N_params() LT 4 then begin 46 | print,'Syntax - polint, xa, ya, x, y, [ dy ]' 47 | print,' xa,ya - Input vectors to be interpolated' 48 | print,' x - Scalar specifying point at which to interpolate' 49 | print,' y - Output interpolated scalar value' 50 | print,' dy - Optional error estimate on y' 51 | return 52 | endif 53 | 54 | N = N_elements( xa ) 55 | if N_elements( ya ) NE N then message, $ 56 | 'ERROR - Input X and Y vectors must have same number of elements' 57 | 58 | ; Find the index of XA which is closest to X 59 | 60 | dif = min( abs(x-xa), ns ) 61 | 62 | c = ya & d = ya 63 | y = ya[ns] 64 | ns = ns - 1 65 | 66 | for m = 1,n-1 do begin 67 | 68 | ho = xa[0:n-m-1] - x 69 | hp = xa[m:n-1] - x 70 | w = c[1:n-m] - d[0:n-m-1] 71 | den = ho - hp 72 | if min( abs(den) ) EQ 0 then message, $ 73 | 'ERROR - All input X vector values must be distinct' 74 | den = w / den 75 | d = hp * den 76 | c = ho * den 77 | if ( 2*ns LT n-m-1 ) then dy = c[ns+1] else begin 78 | dy = d[ns] 79 | ns = ns - 1 80 | endelse 81 | y = y + dy 82 | endfor 83 | 84 | return 85 | end 86 | -------------------------------------------------------------------------------- /pro/polrec.pro: -------------------------------------------------------------------------------- 1 | ;------------------------------------------------------------- 2 | ;+ 3 | ; NAME: 4 | ; POLREC 5 | ; PURPOSE: 6 | ; Convert 2-d polar coordinates to rectangular coordinates. 7 | ; CATEGORY: 8 | ; CALLING SEQUENCE: 9 | ; polrec, r, a, x, y 10 | ; INPUTS: 11 | ; r, a = vector in polar form: radius, angle (radians). in 12 | ; KEYWORD PARAMETERS: 13 | ; Keywords: 14 | ; /DEGREES means angle is in degrees, else radians. 15 | ; OUTPUTS: 16 | ; x, y = vector in rectangular form, double precision out 17 | ; COMMON BLOCKS: 18 | ; NOTES: 19 | ; MODIFICATION HISTORY: 20 | ; R. Sterner. 18 Aug, 1986. 21 | ; Johns Hopkins University Applied Physics Laboratory. 22 | ; RES 13 Feb, 1991 --- added /degrees. 23 | ; Converted to IDL V5.0 W. Landsman September 1997 24 | ; 1999 May 03 --- Made double precision. R. Sterner. 25 | ; 26 | ; Copyright (C) 1986, Johns Hopkins University/Applied Physics Laboratory 27 | ; This software may be used, copied, or redistributed as long as it is not 28 | ; sold and this copyright notice is reproduced on each copy made. This 29 | ; routine is provided as is without any express or implied warranties 30 | ; whatsoever. Other limitations apply as described in the file disclaimer.txt. 31 | ;- 32 | ;------------------------------------------------------------- 33 | 34 | PRO POLREC, R, A, X, Y, help=hlp, degrees=degrees 35 | 36 | IF (N_PARAMS(0) LT 4) or keyword_set(hlp) THEN BEGIN 37 | PRINT,' Convert 2-d polar coordinates to rectangular coordinates. 38 | PRINT,' polrec, r, a, x, y 39 | PRINT,' r, a = vector in polar form: radius, angle (radians). in' 40 | PRINT,' x, y = vector in rectangular form. out' 41 | print,' Keywords:' 42 | print,' /DEGREES means angle is in degrees, else radians.' 43 | RETURN 44 | ENDIF 45 | 46 | cf = 1.D0 47 | if keyword_set(degrees) then cf = 180.0d/!dpi 48 | 49 | X = R*COS(A/cf) 50 | Y = R*SIN(A/cf) 51 | RETURN 52 | END 53 | -------------------------------------------------------------------------------- /pro/polyleg.pro: -------------------------------------------------------------------------------- 1 | function polyleg,x,coeff 2 | ;+ 3 | ; NAME: 4 | ; POLYLEG 5 | ; 6 | ; PURPOSE: 7 | ; Evaluate a Legendre polynomial with specified coefficients. 8 | ; EXPLANATION: 9 | ; Meant to be used analogously to the POLY function in the IDL User's 10 | ; Library distribution. 11 | ; 12 | ; CALLING SEQUENCE: 13 | ; Result = POLYLEG( X, C ) 14 | ; 15 | ; INPUTS: 16 | ; X - input variable, scalar or vector 17 | ; C - vector of Legendre polynomial coefficients. 18 | ; OUTPUTS: 19 | ; POLYLEG returns a result equal to: 20 | ; C[0] + C[1]*P_1(x) + C[2]*P_2(x) + ... 21 | ; 22 | ; where P_j(x) is the jth Legendre polynomial. The output will have 23 | ; the same dimensions as the input X variable. 24 | ; 25 | ; EXAMPLE: 26 | ; If x = [0.5, 1.0] and C = [2.4, 1.3, 2.5] then 27 | ; print, polyleg(x, c) ====> [2.7375, 6.20] 28 | ; 29 | ; The result can be checked using the first 3 Legendre polynomial terms 30 | ; C[0] + C[1]*x + C[2]*(0.5*(3*x^2-1)) 31 | ; METHOD: 32 | ; Uses the recurrence relation of Legendre polynomials 33 | ; (n+1)*P_n+1(x) = (2n+1)*x*P_n(x) - n*P_n-1(x) 34 | ; evaluated with the Clenshaw recurrence formula, see Numerical Recipes 35 | ; by Press et al. (1992), Section 5.5 36 | ; 37 | ; REVISION HISTORY: 38 | ; Written W. Landsman Hughes STX Co. April, 1995 39 | ; Fixed for double precision W. Landsman May, 1997 40 | ; Converted to IDL V5.0 W. Landsman September 1997 41 | ;- 42 | On_error,2 43 | 44 | if N_params() LT 2 then begin 45 | print,'Syntax - result = POLYLEG( X, Coeff)' 46 | return, -1 47 | endif 48 | 49 | N= N_elements(coeff) -1 50 | M = N_elements(x) 51 | 52 | case N of 53 | 0: return, replicate( coeff, M) 54 | 1: return, x* coeff[1] + coeff[0] 55 | else: 56 | endcase 57 | 58 | ; If X is double then compute in double; otherwise compute in real 59 | 60 | if size(x,/TNAME) EQ 'DOUBLE' then begin 61 | y = dblarr( M, N+2) 62 | jj = dindgen(N) + 2.0d 63 | endif else begin 64 | y = fltarr( M, N+2 ) 65 | jj = findgen(N) + 2. 66 | endelse 67 | 68 | beta1 = -jj / (jj+1) 69 | for j = N,1,-1 do begin 70 | 71 | alpha = (2*j + 1.)*x/float(j + 1.) 72 | y[0,j-1] = alpha*y[*,j] + beta1[j-1]*y[*,j+1] + coeff[j] 73 | endfor 74 | 75 | return, -0.5*y[*,1] + x*y[*,0] + coeff[0] 76 | end 77 | -------------------------------------------------------------------------------- /pro/positivity.pro: -------------------------------------------------------------------------------- 1 | function positivity, x, DERIVATIVE=deriv, EPSILON=epsilon 2 | ;+ 3 | ; NAME: 4 | ; POSITIVITY 5 | ; PURPOSE: 6 | ; Map an image uniquely and smoothly into all positive values. 7 | ; EXPLANATION: 8 | ; Take unconstrained x (usually an image), and map it uniquely and 9 | ; smoothly into positive values. Negative values of x get mapped to 10 | ; interval ( 0, sqrt( epsilon )/2 ], positive values go to 11 | ; ( sqrt( epsilon )/2, oo ) with deriv approaching 1. Derivative is 12 | ; always 1/2 at x=0. Derivative is used by the MRL deconvolution 13 | ; algorithm. 14 | ; 15 | ; CALLING SEQUENCE: 16 | ; result = POSITIVITY( x, [ /DERIVATIVE, EPSILON = ) 17 | ; 18 | ; INPUTS: 19 | ; x - input array, unconstrained 20 | ; 21 | ; OUTPUT: 22 | ; result = output array = ((x + sqrt(x^2 + epsilon))/2 23 | ; if the /DERIV keyword is set then instead the derivative of 24 | ; the above expression with respect to X is returned 25 | ; 26 | ; OPTIONAL INPUT KEYWORDS: 27 | ; DERIV - if this keyword set, then the derivative of the positivity 28 | ; mapping is returned, rather than the mapping itself 29 | ; EPSILON - real scalar specifying the interval into which to map 30 | ; negative values. If EPSILON EQ 0 then the mapping reduces to 31 | ; positive truncation. If EPSILON LT then the mapping reduces to 32 | ; an identity (no change). Default is EPSILON = 1e-9 33 | ; 34 | ; REVISION HISTORY: 35 | ; F.Varosi NASA/GSFC 1992, as suggested by R.Pina UCSD. 36 | ; Converted to IDL V5.0 W. Landsman September 1997 37 | ;- 38 | 39 | if N_elements( epsilon ) NE 1 then epsilon = 1.e-9 40 | 41 | if keyword_set( deriv ) then begin 42 | if (epsilon GT 0) then return,(1 + x/sqrt( x^2 + epsilon ))/2 $ 43 | else if (epsilon LT 0) then return,(1) $ 44 | else return,( x GT 0 ) 45 | endif else begin 46 | if (epsilon GT 0) then return,( x + sqrt( x^2 + epsilon ) )/2 $ 47 | else if (epsilon LT 0) then return, x $ 48 | else return,( x > 0 ) 49 | endelse 50 | end 51 | -------------------------------------------------------------------------------- /pro/precess_xyz.pro: -------------------------------------------------------------------------------- 1 | pro precess_xyz,x,y,z,equinox1,equinox2 2 | ;+ 3 | ; NAME: 4 | ; PRECESS_XYZ 5 | ; 6 | ; PURPOSE: 7 | ; Precess equatorial geocentric rectangular coordinates. 8 | ; 9 | ; CALLING SEQUENCE: 10 | ; precess_xyz, x, y, z, equinox1, equinox2 11 | ; 12 | ; INPUT/OUTPUT: 13 | ; x,y,z: scalars or vectors giving heliocentric rectangular coordinates 14 | ; THESE ARE CHANGED UPON RETURNING. 15 | ; INPUT: 16 | ; EQUINOX1: equinox of input coordinates, numeric scalar 17 | ; EQUINOX2: equinox of output coordinates, numeric scalar 18 | ; 19 | ; OUTPUT: 20 | ; x,y,z are changed upon return 21 | ; 22 | ; NOTES: 23 | ; The equatorial geocentric rectangular coords are converted 24 | ; to RA and Dec, precessed in the normal way, then changed 25 | ; back to x, y and z using unit vectors. 26 | ; 27 | ;EXAMPLE: 28 | ; Precess 1950 equinox coords x, y and z to 2000. 29 | ; IDL> precess_xyz,x,y,z, 1950, 2000 30 | ; 31 | ;HISTORY: 32 | ; Written by P. Plait/ACC March 24 1999 33 | ; (unit vectors provided by D. Lindler) 34 | ; Use /Radian call to PRECESS W. Landsman November 2000 35 | ; Use two parameter call to ATAN W. Landsman June 2001 36 | ;- 37 | ;check inputs 38 | if N_params() NE 5 then begin 39 | print,'Syntax - PRECESS_XYZ,x,y,z,equinox1,equinox2' 40 | return 41 | endif 42 | 43 | ;take input coords and convert to ra and dec (in radians) 44 | 45 | ra = atan(y,x) 46 | del = sqrt(x*x + y*y + z*z) ;magnitude of distance to Sun 47 | dec = asin(z/del) 48 | 49 | ; precess the ra and dec 50 | precess, ra, dec, equinox1, equinox2, /Radian 51 | 52 | ;convert back to x, y, z 53 | xunit = cos(ra)*cos(dec) 54 | yunit = sin(ra)*cos(dec) 55 | zunit = sin(dec) 56 | 57 | x = xunit * del 58 | y = yunit * del 59 | z = zunit * del 60 | 61 | return 62 | end 63 | 64 | -------------------------------------------------------------------------------- /pro/prob_ks.pro: -------------------------------------------------------------------------------- 1 | pro prob_ks, D, N_eff, probks 2 | ;+ 3 | ; NAME: 4 | ; PROB_KS 5 | ; PURPOSE: 6 | ; Return the significance of the Kolmogoroff-Smirnov statistic 7 | ; EXPLANATION: 8 | ; Returns the significance level of an observed value of the 9 | ; Kolmogorov-Smirnov statistic D for an effective number of data points 10 | ; N_eff. Called by KSONE and KSTWO 11 | ; 12 | ; CALLING SEQUENCE: 13 | ; prob_ks, D, N_eff, probks 14 | ; 15 | ; INPUT PARAMETERS: 16 | ; D - Kolmogorov statistic, floating scalar, always non-negative 17 | ; N_eff - Effective number of data points, scalar. For a 2 sided test 18 | ; this is given by (N1*N2)/(N1+N2) where N1 and N2 are the number 19 | ; of points in each data set. 20 | ; 21 | ; OUTPUT PARAMETERS: 22 | ; probks - floating scalar between 0 and 1 giving the significance level of 23 | ; the K-S statistic. Small values of PROB suggest that the 24 | ; distribution being tested are not the same 25 | ; 26 | ; REVISION HISTORY: 27 | ; Written W. Landsman August, 1992 28 | ; Corrected typo (termbv for termbf) H. Ebeling/W.Landsman March 1996 29 | ; Probably did not affect numeric result, but iteration went longer 30 | ; than necessary 31 | ; Converted to IDL V5.0 W. Landsman September 1997 32 | ;- 33 | On_error,2 34 | 35 | if N_params() LT 3 then begin 36 | print,'Syntax - prob_ks, D, N_eff, prob' 37 | print,' D - Komolgorov-Smirnov statistic, input' 38 | print,' N_eff - effective number of data points, input' 39 | print,' prob - Significance level of D, output' 40 | return 41 | endif 42 | 43 | eps1 = 0.001 ;Stop if current term less than EPS1 times previous term 44 | eps2 = 1.e-8 ;Stop if current term changes output by factor less than EPS2 45 | 46 | en = sqrt( N_eff ) 47 | lambda = (en + 0.12 + 0.11/en)*D 48 | 49 | a2 = -2.*lambda^2 50 | probks = 0. 51 | termbf = 0. 52 | sign = 1. 53 | 54 | for j = 1,100 do begin 55 | 56 | term = sign*2*exp(a2*j^2) 57 | probks = probks + term 58 | 59 | if ( abs(term) LE eps1*termbf ) or $ 60 | ( abs(term) LE eps2*probks ) then return 61 | 62 | sign = -sign ;Series alternates in sign 63 | termbf = abs(term) 64 | 65 | endfor 66 | 67 | probks = 1. ;Sum did not converge after 100 iterations 68 | return 69 | 70 | end 71 | -------------------------------------------------------------------------------- /pro/prob_kuiper.pro: -------------------------------------------------------------------------------- 1 | pro prob_kuiper, D, N_eff, probks 2 | ;+ 3 | ; NAME: 4 | ; PROB_KUIPER 5 | ; PURPOSE: 6 | ; Return the significance of the Kuiper statistic 7 | ; EXPLANATION: 8 | ; Returns the significance level of an observed value of the 9 | ; Kuiper statistic D for an effective number of data points 10 | ; N_eff. Called by KUIPERONE 11 | ; 12 | ; CALLING SEQUENCE: 13 | ; prob_kuiper, D, N_eff, probks 14 | ; 15 | ; INPUT PARAMETERS: 16 | ; D - Kuiper statistic, floating scalar, always non-negative 17 | ; N_eff - Effective number of data points, scalar. For a 2 sided test 18 | ; this is given by (N1*N2)/(N1+N2) where N1 and N2 are the number 19 | ; of points in each data set. 20 | ; 21 | ; OUTPUT PARAMETERS: 22 | ; probks - floating scalar between 0 and 1 giving the significance level of 23 | ; the Kuiper statistic. Small values of PROB suggest that the 24 | ; distribution being tested are not the same 25 | ; 26 | ; REVISION HISTORY: 27 | ; Written W. Landsman August, 1992 28 | ; Corrected typo (termbv for termbf) H. Ebeling/W.Landsman March 1996 29 | ; Probably did not affect numeric result, but iteration went longer 30 | ; than necessary 31 | ; Converted to IDL V5.0 W. Landsman September 1997 32 | ; Adapted from PROB_KS J. Ballet July 2003 33 | ;- 34 | On_error,2 35 | 36 | if N_params() LT 3 then begin 37 | print,'Syntax - prob_kuiper, D, N_eff, prob' 38 | print,' D - Kuiper statistic, input' 39 | print,' N_eff - effective number of data points, input' 40 | print,' prob - Significance level of D, output' 41 | return 42 | endif 43 | 44 | eps1 = 0.001 ;Stop if current term less than EPS1 times previous term 45 | eps2 = 1.e-8 ;Stop if current term changes output by factor less than EPS2 46 | 47 | en = sqrt( N_eff ) 48 | lambda = (en + 0.155 + 0.24/en)*D 49 | 50 | ; No iteration if lambda is smaller than 0.4 51 | if lambda le 0.4 then begin 52 | probks = 1.0 53 | return 54 | endif 55 | 56 | a2 = -2.*lambda^2 57 | probks = 0. 58 | termbf = 0. 59 | 60 | for j = 1,100 do begin 61 | 62 | a2j2 = a2 * j^2 63 | term = 2 * (-2*a2j2-1) * exp(a2j2) 64 | probks = probks + term 65 | 66 | if ( abs(term) LE eps1*termbf ) or $ 67 | ( abs(term) LE eps2*probks ) then return 68 | 69 | termbf = abs(term) 70 | 71 | endfor 72 | 73 | probks = 1. ;Sum did not converge after 100 iterations 74 | return 75 | 76 | end 77 | -------------------------------------------------------------------------------- /pro/radec.pro: -------------------------------------------------------------------------------- 1 | pro radec,ra,dec,ihr,imin,xsec,ideg,imn,xsc, hours = hours 2 | ;+ 3 | ; NAME: 4 | ; RADEC 5 | ; PURPOSE: 6 | ; To convert RA and Dec from decimal to sexagesimal units. 7 | ; EXPLANATION: 8 | ; The conversion is to sexagesimal hours for RA, and sexagesimal 9 | ; degrees for declination. 10 | ; 11 | ; CALLING SEQUENCE: 12 | ; radec, ra, dec, ihr, imin, xsec, ideg, imn, xsc, [/HOURS} 13 | ; 14 | ; INPUTS: 15 | ; ra - Right ascension, scalar or vector, in DEGREES unless the 16 | ; /HOURS keyword is set 17 | ; dec - declination in decimal DEGREES, scalar or vector, same number 18 | ; of elements as RA 19 | ; 20 | ; OUTPUTS: 21 | ; ihr - right ascension hours (INTEGER*2) 22 | ; imin - right ascension minutes (INTEGER*2) 23 | ; xsec - right ascension seconds (REAL*4 or REAL*8) 24 | ; ideg - declination degrees (INTEGER*2) 25 | ; imn - declination minutes (INTEGER*2) 26 | ; xsc - declination seconds (REAL*4 or REAL*8) 27 | ; 28 | ; OPTIONAL KEYWORD INPUT: 29 | ; /HOURS - if set, then the input righ ascension should be specified in 30 | ; hours instead of degrees. 31 | ; RESTRICTIONS: 32 | ; RADEC does minimal parameter checking. 33 | ; 34 | ; REVISON HISTORY: 35 | ; Written by B. Pfarr, STX, 4/24/87 36 | ; Converted to IDL V5.0 W. Landsman September 1997 37 | ; Added /HOURS keyword W. Landsman August 2002 38 | ;- 39 | On_error,2 40 | 41 | if (N_params() LT 2 ) then begin 42 | print,'Syntax - radec, ra, dec, ihr, imin, xsec, ideg, imn, xsc' 43 | return 44 | endif 45 | 46 | ; Compute RA 47 | if keyword_set(hours) then begin 48 | ra = ra mod 24. 49 | ra = ra + 24*(ra lt 0) 50 | ihr = fix(ra) 51 | xmin = abs(ra*60. - ihr*60.) 52 | endif else begin 53 | ra = ra mod 360. ;Make sure between 0 and 24 hours 54 | ra = ra + 360*(ra lt 0) 55 | ihr = fix(ra/15.) 56 | xmin =abs(ra*4.0-ihr*60.0) 57 | endelse 58 | imin = fix(xmin) 59 | xsec = (xmin-imin)*60.0 60 | 61 | ; Compute Dec 62 | 63 | ideg = fix(dec) 64 | xmn = abs(dec-ideg)*60.0 65 | imn = fix(xmn) 66 | xsc = (xmn-imn)*60.0 67 | 68 | ; Now test for the special case of zero degrees 69 | 70 | zero_deg = ( ideg EQ 0 ) and (dec LT 0) 71 | imn = imn - 2*imn*fix( zero_deg*(imn NE 0) ) 72 | xsc = xsc - 2*xsc*zero_deg*(imn EQ 0) 73 | 74 | return 75 | end 76 | -------------------------------------------------------------------------------- /pro/randomchi.pro: -------------------------------------------------------------------------------- 1 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 2 | ;+ 3 | ; NAME: 4 | ; RANDOMCHI 5 | ; PURPOSE: 6 | ; GENERATE CHI-SQUARE DISTRIBUTED RANDOM VARIABLES. 7 | ; 8 | ; AUTHOR : BRANDON C. KELLY, STEWARD OBS., SEP 2005 9 | ; 10 | ; INPUTS : 11 | ; 12 | ; SEED - THE SEED FOR THE RANDOM NUMBER GENERATOR, CAN BE UNDEFINED. 13 | ; DOF - THE DEGREES OF FREEDOM FOR THE CHI-SQUARED DISTRIBUTION. 14 | ; 15 | ; OPTIONAL INPUTS : 16 | ; 17 | ; NRAND - THE NUMBER OF RANDOM NUMBERS TO DRAW 18 | ;- 19 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 20 | 21 | function randomchi, seed, dof, nrand 22 | 23 | if n_params() lt 2 then begin 24 | print, 'Syntax- result = randomchi( seed, dof[, nrand] )' 25 | return, -1 26 | endif 27 | 28 | if n_elements(nrand) eq 0 then nrand = 1 29 | 30 | alpha = dof / 2.0 31 | beta = 0.5 32 | 33 | chisqr = randomgam( seed, alpha, beta, nrand ) 34 | 35 | return, chisqr 36 | end 37 | -------------------------------------------------------------------------------- /pro/randomdir.pro: -------------------------------------------------------------------------------- 1 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 2 | ;+ 3 | ; NAME: 4 | ; RANDOMDIR 5 | ; PURPOSE: 6 | ; GENERATE DIRICHLET-DISTRIBUTED RANDOM VARIABLES. 7 | ; 8 | ; AUTHOR : BRANDON C. KELLY, STEWARD OBS., APRIL 2006 9 | ; 10 | ; INPUTS : 11 | ; 12 | ; SEED - THE SEED FOR THE RANDOM NUMBER GENERATOR, CAN BE UNDEFINED. 13 | ; ALPHA - THE SHAPE PARAMETERS FOR THE DIRICHLET DISTRIBUTION. THIS 14 | ; SHOULD BE A K-ELEMENT VECTOR. 15 | ; 16 | ; OPTIONAL INPUTS : 17 | ; 18 | ; NRAND - THE NUMBER OF RANDOM NUMBERS TO DRAW 19 | ; 20 | ; CALLED ROUTINES : 21 | ; 22 | ; RANDOMGAM 23 | ;- 24 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 25 | 26 | function randomdir, seed, alpha, nrand 27 | 28 | if n_params() lt 2 then begin 29 | print, 'Syntax- theta = randomdir( seed, alpha[, nrand] )' 30 | return, 0 31 | endif 32 | 33 | if n_elements(alpha) lt 2 then begin 34 | print, 'Alpha must have at least 2 elements.' 35 | return, 0 36 | endif 37 | 38 | K = n_elements(alpha) 39 | 40 | bad = where(alpha le 0, nbad) 41 | if nbad ne 0 then begin 42 | print, 'All elements of ALPHA must be greater than 0.' 43 | return, 0 44 | endif 45 | 46 | if n_elements(nrand) eq 0 then nrand = 1 47 | 48 | gamma = dblarr(nrand, K) 49 | 50 | for j = 0, K - 1 do $ 51 | gamma[0,j] = randomgam(seed, alpha[j], 1.0, nrand) 52 | 53 | theta = gamma / transpose(total(gamma,2) ## replicate(1, K)) 54 | 55 | return, theta 56 | end 57 | -------------------------------------------------------------------------------- /pro/randomgam.pro: -------------------------------------------------------------------------------- 1 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 2 | ;+ 3 | ; NAME: 4 | ; RANDOMGAM 5 | ; PURPOSE: 6 | ; GENERATE GAMMA-DISTRIBUTED RANDOM VARIABLES. 7 | ; 8 | ; AUTHOR : BRANDON C. KELLY, STEWARD OBS., APRIL 2006 9 | ; 10 | ; INPUTS : 11 | ; 12 | ; SEED - THE SEED FOR THE RANDOM NUMBER GENERATOR, CAN BE UNDEFINED. 13 | ; ALPHA, BETA - THE SHAPE PARAMETERS FOR THE GAMMA DISTRIBUTION. 14 | ; 15 | ; OPTIONAL INPUTS : 16 | ; 17 | ; NRAND - THE NUMBER OF RANDOM NUMBERS TO DRAW 18 | ;- 19 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 20 | 21 | function randomgam, seed, alpha, beta, nrand 22 | 23 | if n_params() lt 3 then begin 24 | print, 'Syntax- X = randomgam( seed, alpha, beta[, nrand] )' 25 | return, 0 26 | endif 27 | 28 | if alpha le 0 or beta le 0 then begin 29 | print, 'ALPHA and BETA must both be greater than zero.' 30 | return, 0 31 | endif 32 | 33 | if n_elements(nrand) eq 0 then nrand = 1 34 | 35 | if alpha le 1 then begin 36 | 37 | alpha = alpha + 1 38 | alfshift = 1 39 | 40 | endif else alfshift = 0 41 | 42 | d = alpha - 1d / 3 43 | c = 1 / sqrt(9 * d) 44 | 45 | gamma = dblarr(nrand) 46 | 47 | nempty = nrand 48 | empty = lindgen(nrand) 49 | 50 | repeat begin 51 | 52 | x = randomn(seed, nempty) 53 | v = 1 + c * x 54 | 55 | bad = where(v le 0, nbad) 56 | while nbad gt 0 do begin 57 | 58 | x2 = randomn(seed, nbad) 59 | x[bad] = x2 60 | v[bad] = 1 + c * x2 61 | bad2 = where(v[bad] le 0, nbad2) 62 | if nbad2 gt 0 then bad = bad[bad2] 63 | nbad = bad2 64 | 65 | endwhile 66 | 67 | v = v^3 68 | 69 | unif = randomu(seed, nempty) 70 | factor = 0.5 * x^2 + d - d * v + d * alog(v) 71 | u = where( alog(unif) lt factor, nu, comp=empty1 ) 72 | 73 | if nu gt 0 then gamma[empty[u]] = d * v[u] 74 | nempty = nempty - nu 75 | 76 | if nempty ne 0 then empty = empty[empty1] 77 | 78 | endrep until nempty eq 0 79 | 80 | if alfshift then begin 81 | alpha = alpha - 1 82 | gamma = gamma * (randomu(seed, nrand))^(1d / alpha) 83 | endif 84 | 85 | gamma = gamma / beta 86 | 87 | return, gamma 88 | end 89 | -------------------------------------------------------------------------------- /pro/randomwish.pro: -------------------------------------------------------------------------------- 1 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 2 | ;+ 3 | ; NAME: 4 | ; RANDOMWISH 5 | ; PURUPOSE: 6 | ; ROUTINE TO DRAW RANDOM MATRICES FROM A WISHART DISTRIBUTION WITH DOF 7 | ; DEGREES OF FREEDOM AND SCALE MATRIX S. 8 | ; 9 | ; AUTHOR : BRANDON C. KELLY, STEWARD OBS., JULY 2006 10 | ; 11 | ; INPUTS : 12 | ; 13 | ; SEED - THE SEED FOR THE RANDOM NUMBER GENERATOR, CAN BE UNDEFINED. 14 | ; DOF - THE DEGREES OF FREEDOM FOR THE WISHART DISTRIBUTION. 15 | ; S - THE SCALE MATRIX. THE DIMENSION OF S CANNOT BE GREATER THAN 16 | ; DOF. 17 | ; 18 | ; OPTIONAL INPUTS : 19 | ; 20 | ; NRAND - THE NUMBER OF RANDOM MATRICES TO DRAW 21 | ; 22 | ; CALLED ROUTINES : 23 | ; 24 | ; MRANDOMN 25 | ;- 26 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 27 | 28 | function randomwish, seed, dof, S, nrand 29 | 30 | if n_params() lt 3 then begin 31 | print, 'Syntax- W = randomwish( seed, dof, S[, nrand] )' 32 | return, 0 33 | endif 34 | 35 | dim = (size(S, /dim))[0] 36 | 37 | if dim gt dof then begin 38 | 39 | print, 'Dimension of S cannot be larger than DOF.' 40 | return, 0 41 | 42 | endif 43 | 44 | if n_elements(nrand) eq 0 then nrand = 1 45 | 46 | wish = dblarr(dim, dim, nrand) 47 | 48 | for i = 0, nrand - 1 do begin 49 | 50 | x = mrandomn(seed, S, dof) 51 | wish[*,*,i] = x ## transpose(x) 52 | 53 | endfor 54 | 55 | return, reform(wish) 56 | end 57 | -------------------------------------------------------------------------------- /pro/rdpsf.pro: -------------------------------------------------------------------------------- 1 | pro rdpsf,psf,hpsf,psfname 2 | ;+ 3 | ; NAME: 4 | ; RDPSF 5 | ; PURPOSE: 6 | ; Read the FITS file created by GETPSF in the DAOPHOT sequence 7 | ; EXPLANATION: 8 | ; Combines the Gaussian with the residuals to create an output PSF array. 9 | ; 10 | ; CALLING SEQUENCE: 11 | ; RDPSF, PSF, HPSF, [ PSFname] 12 | ; 13 | ; OPTIONAL INPUTS 14 | ; PSFname - string giving the name of the FITS file containing the PSF 15 | ; residuals 16 | ; 17 | ; OUTPUTS 18 | ; psf - array containing the actual PSF 19 | ; hpsf - header associated with psf 20 | ; 21 | ; PROCEDURES CALLED: 22 | ; DAO_VALUE(), MAKE_2D, SXADDPAR, READFITS(), SXPAR() 23 | ; REVISION HISTORY: 24 | ; Written W. Landsman December, 1988 25 | ; Checked for IDL Version 2, J. Isensee & J. Hill, December, 1990 26 | ; Converted to IDL V5.0 W. Landsman September 1997 27 | ;- 28 | On_error,2 29 | 30 | if N_params() LT 2 then begin 31 | print,'Syntax - RDPSF, psf, Hpsf, [ PSFname ]' 32 | print,' PSF,HPSF - are the output PSF array and header' 33 | print,' PSFNAME - the name of the file containing the PSF, input' 34 | return 35 | endif 36 | 37 | if N_params() EQ 2 then begin 38 | psfname = '' 39 | read,'Enter name of the FITS file containing the PSF residuals: ',psfname 40 | endif 41 | 42 | resid = readfits(psfname, hpsf) 43 | gauss = sxpar(hpsf,'GAUSS*') ;Get Gaussian parameters (5) 44 | psfrad = sxpar(hpsf,'PSFRAD') ;Get PSF radius 45 | npsf = 2*psfrad+1 ;Width of output array containing PSF 46 | psf = fltarr(npsf,npsf) ;Create output array 47 | dx = indgen(npsf) - psfrad ;Vector gives X distance from center of array 48 | dy = dx ;Ditto for dy 49 | make_2d,dx,dy ;Now have X and Y values for each pixel in 50 | ; the output array 51 | 52 | psf = psf + dao_value(dx,dy,gauss,resid) ;Compute DAOPHOT value at each point 53 | 54 | sxaddpar,hpsf,'NAXIS1',npsf ;Update header to contain PSF size 55 | sxaddpar,hpsf,'NAXIS2',npsf ;rather than residual array size 56 | 57 | return 58 | end 59 | -------------------------------------------------------------------------------- /pro/recpol.pro: -------------------------------------------------------------------------------- 1 | ;------------------------------------------------------------- 2 | ;+ 3 | ; NAME: 4 | ; RECPOL 5 | ; PURPOSE: 6 | ; Convert 2-d rectangular coordinates to polar coordinates. 7 | ; CATEGORY: 8 | ; CALLING SEQUENCE: 9 | ; recpol, x, y, r, a 10 | ; INPUTS: 11 | ; x, y = vector in rectangular form. in 12 | ; KEYWORD PARAMETERS: 13 | ; Keywords: 14 | ; /DEGREES means angle is in degrees, else radians. 15 | ; OUTPUTS: 16 | ; r, a = vector in polar form: radius, angle. out 17 | ; COMMON BLOCKS: 18 | ; NOTES: 19 | ; MODIFICATION HISTORY: 20 | ; R. Sterner. 18 Aug, 1986. 21 | ; Johns Hopkins University Applied Physics Laboratory. 22 | ; RES 13 Feb, 1991 --- added /degrees. 23 | ; R. Sterner, 30 Dec, 1991 --- simplified. 24 | ; R. Sterner, 25 May, 1993 --- Fixed atan (0,0) problem. 25 | ; 26 | ; Copyright (C) 1986, Johns Hopkins University/Applied Physics Laboratory 27 | ; This software may be used, copied, or redistributed as long as it is not 28 | ; sold and this copyright notice is reproduced on each copy made. This 29 | ; routine is provided as is without any express or implied warranties 30 | ; whatsoever. Other limitations apply as described in the file disclaimer.txt. 31 | ; Converted to IDL V5.0 W. Landsman September 1997 32 | ;- 33 | ;------------------------------------------------------------- 34 | 35 | 36 | pro recpol, x, y, r, a, help=hlp, degrees=degrees 37 | 38 | if (n_params(0) lt 4) or keyword_set(hlp) then begin 39 | print,' Convert 2-d rectangular coordinates to polar coordinates. 40 | print,' recpol, x, y, r, a 41 | print,' x, y = vector in rectangular form. in' 42 | print,' r, a = vector in polar form: radius, angle. out' 43 | print,' Keywords:' 44 | print,' /DEGREES means angle is in degrees, else radians.' 45 | return 46 | endif 47 | 48 | ;---------------------------------------------------------------- 49 | ; Angle complicated because atan won't take (0,0) and 50 | ; also because want to keep angle in 0 to 360 (2 pi) range. 51 | ;---------------------------------------------------------------- 52 | w = where((x ne 0) or (y ne 0), count) ; Where not both X,Y eq 0. 53 | a = x*0. ; Output angle array. 54 | if count gt 0 then a[w]=atan(y[w],x[w]) ; Find angles. 55 | w = where(a lt 0, count) ; find A < 0 and fix. 56 | if count gt 0 then a[w]= a[w]+2*!dpi ; add 2 pi to angles < 0. 57 | 58 | r = sqrt(x^2 + y^2) ; Find radii. 59 | 60 | if keyword_set(degrees) then a = a*!radeg 61 | 62 | return 63 | end 64 | -------------------------------------------------------------------------------- /pro/remchar.pro: -------------------------------------------------------------------------------- 1 | pro remchar,st,char ;Remove character 2 | ;+ 3 | ; NAME: 4 | ; REMCHAR 5 | ; PURPOSE: 6 | ; Remove all appearances of character (char) from string (st) 7 | ; 8 | ; CALLING SEQUENCE: 9 | ; REMCHAR, ST, CHAR 10 | ; 11 | ; INPUT-OUTPUT: 12 | ; ST - String from which character will be removed, scalar or vector 13 | ; INPUT: 14 | ; CHAR- Single character to be removed from string or all elements of a 15 | ; string array 16 | ; 17 | ; EXAMPLE: 18 | ; If a = 'a,b,c,d,e,f,g' then 19 | ; 20 | ; IDL> remchar,a, ',' 21 | ; 22 | ; will give a = 'abcdefg' 23 | ; 24 | ; REVISIONS HISTORY 25 | ; Written D. Lindler October 1986 26 | ; Test if empty string needs to be returned W. Landsman Feb 1991 27 | ; Work on string arrays W. Landsman August 1997 28 | ; Avoid 32 bit integer overflow K. Tolbert/W. Landsman Feb 2007 29 | ;- 30 | compile_opt idl2 31 | if N_params() LT 2 then begin 32 | print,'Syntax - REMCHAR, string, character' 33 | return 34 | endif 35 | 36 | bchar = byte(char) & bchar = bchar[0] ;Convert character to byte 37 | 38 | for i = 0L,N_elements(st)-1 do begin 39 | 40 | bst = byte(st[i]) 41 | good = where( bst NE bchar, Ngood) 42 | if Ngood GT 0 then st[i] = string(bst[good]) else st[i] = '' 43 | 44 | endfor 45 | return 46 | end 47 | -------------------------------------------------------------------------------- /pro/repchr.pro: -------------------------------------------------------------------------------- 1 | ;+ 2 | ; NAME: 3 | ; REPCHR() 4 | ; PURPOSE: 5 | ; Replace all occurrences of one character with another in a string. 6 | ; 7 | ; CALLING SEQUENCE: 8 | ; New_String = repchr( In_string, OldChar, [NewChar]) 9 | ; INPUTS: 10 | ; in_string = original text string, scalar or array 11 | ; OldChar = character to replace. If the OldChar contains 12 | ; more than 1 character, only the first character is used. 13 | ; OPTIONAL INPUT: 14 | ; newchar = single character to replace it with. 15 | ; The default is a single space 16 | ; OUTPUTS: 17 | ; new_string = same as in_string, but with all occurrences of old 18 | ; replaced by newchar 19 | ; EXAMPLE: 20 | ; in_string = ['lettuce, tomato, grape'] 21 | ; print, repchr( in_string, ',') ;replace comma with space 22 | ; 'lettuce tomato grape' 23 | ; NOTES: 24 | ; Use REPSTR() to replace words rather than a single character 25 | ; 26 | ; For a more sophisticated routine that allows regular expressions look 27 | ; at MG_STRREPLACE() http://docs.idldev.com/idllib/strings/mg_streplace.html 28 | ; 29 | ; Since IDL 8.4 one can use the .REPLACE() method for string variables 30 | ; 31 | ; Note that REPCHR() is the fastest (though least versatile) of these routines, 32 | ; because the length of the string never changes, allowing direct manipulation of 33 | ; byte values. 34 | ; MODIFICATION HISTORY: 35 | ; Written W. Landsman April 2016 36 | ; Adapted from similar code by R. Sterner JHUAPL Oct, 1986 37 | ;- 38 | 39 | 40 | function repchr, In_String, OldChar, NewChar 41 | 42 | if N_params() LT 2 then begin 43 | print,' Replace all occurrences of one character with another '+$ 44 | 'in a text string.' 45 | print,' new_string = repchr(In_String, OldChar, [NewChar])' 46 | return, -1 47 | endif 48 | 49 | bString = byte(In_String) ; convert string to a byte array. 50 | b_OldChar = byte(OldChar) ; convert OldChar to byte. 51 | 52 | g = where(bString EQ b_OldChar[0],Ng) ; find occurrences of char 1. 53 | IF Ng EQ 0 then return,In_string ; if none, return input string. 54 | 55 | if N_elements(NewChar) EQ 0 then NewChar = ' ' ;Default new char is a space 56 | b_NewChar = byte(NewChar) ;Convert NewChar to byte 57 | bstring[g] = b_NewChar[0] ; replace oldchar by newchar. 58 | 59 | return, STRING(bString) ; return new string. 60 | END 61 | -------------------------------------------------------------------------------- /pro/rob_checkfit.pro: -------------------------------------------------------------------------------- 1 | FUNCTION ROB_CHECKFIT,Y, YFIT, EPS, DEL, SIG, FRACDEV, NGOOD,W,B,$ 2 | BISQUARE_LIMIT=BLIM 3 | ;+ 4 | ; NAME: 5 | ; ROB_CHECKFIT 6 | ; PURPOSE: 7 | ; Used by ROBUST_... routines to determine the quality of a fit and to 8 | ; return biweights. 9 | ; CALLING SEQUENCE: 10 | ; status = ROB_CHECKFIT( Y, YFIT, EPS, DEL, SIG, FRACDEV, NGOOD, W, B 11 | ; BISQUARE_LIMIT = ) 12 | ; INPUT: 13 | ; Y = the data 14 | ; YFIT = the fit to the data 15 | ; EPS = the "too small" limit 16 | ; DEL = the "close enough" for the fractional median abs. deviations 17 | ; RETURNS: 18 | ; Integer status. if =1, the fit is considered to have converged 19 | ; 20 | ; OUTPUTS: 21 | ; SIG = robust standard deviation analog 22 | ; FRACDEV = the fractional median absolute deviation of the residuals 23 | ; NGOOD = the number of input point given non-zero weight in the 24 | ; calculation 25 | ; W = the bisquare weights of Y 26 | ; B = residuals scaled by sigma 27 | ; 28 | ; OPTIONAL INPUT KEYWORD: 29 | ; BISQUARE_LIMIT = allows changing the bisquare weight limit from 30 | ; default 6.0 31 | ; PROCEDURES USED: 32 | ; ROBUST_SIGMA() 33 | ; REVISION HISTORY: 34 | ; Written, H.T. Freudenreich, HSTX, 1/94 35 | ;- 36 | 37 | ISTAT = 0 38 | 39 | IF KEYWORD_SET(BLIM) THEN BFAC=BLIM ELSE BFAC=6. 40 | 41 | DEV = Y-YFIT 42 | 43 | SIG=ROBUST_SIGMA(DEV,/ZERO) 44 | ; If the standard deviation = 0 then we're done: 45 | IF SIG LT EPS THEN GOTO,DONE 46 | 47 | IF DEL GT 0. THEN BEGIN 48 | ; If the fraction std. deviation ~ machine precision, we're done: 49 | Q=WHERE( ABS(YFIT) GT EPS, COUNT ) 50 | IF COUNT LT 3 THEN FRACDEV = 0. ELSE $ 51 | FRACDEV = MEDIAN(ABS( DEV[Q]/YFIT[Q] ),/EVEN ) 52 | IF FRACDEV LT DEL THEN GOTO,DONE 53 | ENDIF 54 | 55 | ISTAT = 1 56 | 57 | ; Calculate the (bi)weights: 58 | B = ABS(DEV)/(BFAC*SIG) 59 | S = WHERE( B GT 1.0,COUNT ) & IF COUNT GT 0 THEN B[S] = 1. 60 | NGOOD = N_ELEMENTS(Y)-COUNT 61 | 62 | W=(1.-B^2) 63 | W=W/TOTAL(W) 64 | DONE: 65 | RETURN, ISTAT 66 | END 67 | -------------------------------------------------------------------------------- /pro/robust_sigma.pro: -------------------------------------------------------------------------------- 1 | FUNCTION ROBUST_SIGMA,Y, ZERO=REF, GOODVEC = Q 2 | ; 3 | ;+ 4 | ; NAME: 5 | ; ROBUST_SIGMA 6 | ; 7 | ; PURPOSE: 8 | ; Calculate a resistant estimate of the dispersion of a distribution. 9 | ; EXPLANATION: 10 | ; For an uncontaminated distribution, this is identical to the standard 11 | ; deviation. 12 | ; 13 | ; CALLING SEQUENCE: 14 | ; result = ROBUST_SIGMA( Y, [ /ZERO, GOODVEC = ] ) 15 | ; 16 | ; INPUT: 17 | ; Y = Vector of quantity for which the dispersion is to be calculated 18 | ; 19 | ; OPTIONAL INPUT KEYWORD: 20 | ; /ZERO - if set, the dispersion is calculated w.r.t. 0.0 rather than the 21 | ; central value of the vector. If Y is a vector of residuals, this 22 | ; should be set. 23 | ; 24 | ; OPTIONAL OUPTUT KEYWORD: 25 | ; GOODVEC = Vector of non-trimmed indices of the input vector 26 | ; OUTPUT: 27 | ; ROBUST_SIGMA returns the dispersion. In case of failure, returns 28 | ; value of -1.0 29 | ; 30 | ; PROCEDURE: 31 | ; Use the median absolute deviation as the initial estimate, then weight 32 | ; points using Tukey's Biweight. See, for example, "Understanding Robust 33 | ; and Exploratory Data Analysis," by Hoaglin, Mosteller and Tukey, John 34 | ; Wiley & Sons, 1983, or equation 9 in Beers et al. (1990, AJ, 100, 32) 35 | ; 36 | ; REVSION HISTORY: 37 | ; H. Freudenreich, STX, 8/90 38 | ; Replace MED() call with MEDIAN(/EVEN) W. Landsman December 2001 39 | ; Don't count NaN values W.Landsman June 2010 40 | ; 41 | ;- 42 | On_error,2 43 | compile_opt idl2 44 | 45 | EPS = 1.0E-20 46 | IF KEYWORD_SET(REF) THEN Y0=0. ELSE Y0 = MEDIAN(Y,/EVEN) 47 | 48 | ; First, the median absolute deviation MAD about the median: 49 | 50 | MAD = MEDIAN( ABS(Y-Y0), /EVEN )/0.6745 51 | 52 | ; If the MAD=0, try the MEAN absolute deviation: 53 | IF MAD LT EPS THEN MAD = MEAN( ABS(Y-Y0) )/.80 54 | IF MAD LT EPS THEN RETURN, 0.0 55 | 56 | ; Now the biweighted value: 57 | U = (Y-Y0)/(6.*MAD) 58 | UU = U*U 59 | Q = WHERE(UU LE 1.0, COUNT) 60 | IF COUNT LT 3 THEN BEGIN 61 | PRINT,'ROBUST_SIGMA: This distribution is TOO WEIRD! Returning -1' 62 | SIGGMA = -1. 63 | RETURN,SIGGMA 64 | ENDIF 65 | 66 | N = TOTAL(FINITE(Y),/INT) ;In case Y has NaN values ; 67 | NUMERATOR = TOTAL( (Y[Q]-Y0)^2 * (1-UU[Q])^4 ) 68 | DEN1 = TOTAL( (1.-UU[Q])*(1.-5.*UU[Q]) ) 69 | SIGGMA = N*NUMERATOR/(DEN1*(DEN1-1.)) 70 | 71 | IF SIGGMA GT 0. THEN RETURN, SQRT(SIGGMA) ELSE RETURN, 0. 72 | 73 | END 74 | -------------------------------------------------------------------------------- /pro/sip_eval.pro: -------------------------------------------------------------------------------- 1 | function sip_eval, xy 2 | ;+ 3 | ; NAME: 4 | ; SIP_EVAL 5 | ; PURPOSE: 6 | ; Compute distorted coordinates given SIP (simple imaging polynomial) 7 | ; coefficients. 8 | ; EXPLANATION: 9 | ; See http://fits.gsfc.nasa.gov/registry/sip.html for the SIP convention 10 | ; 11 | ; The coefficients are passed via common block. This is because this 12 | ; routine is called by the intrinisc BROYDEN() function in AD2XY, and 13 | ; common blocks are the only way to pass parameters to the user supplied 14 | ; function in BROYDEN(). 15 | ; CALLING SEQUENCE: 16 | ; res = SIP_EVAL(xy) 17 | ; INPUTS: 18 | ; xy - 2 elements vector giving the undistorted X,Y position 19 | ; OUTPUTS: 20 | ; res - 2 element vector giving the distorted position 21 | ; COMMON BLOCKS: 22 | ; common broyden_coeff,xcoeff,ycoeff 23 | ; 24 | ; XCOEFF, YCOEFF are both nxn arrays giving the SIP coefficient for an 25 | ; n x n polynomial. 26 | ; REVISION HISTORY: 27 | ; Written W. Landsman Dec 2013 28 | ;- 29 | compile_opt idl2,hidden 30 | common broyden_coeff,xcoeff,ycoeff 31 | 32 | dim = size(xcoeff,/dimen) 33 | n = dim[0] 34 | xp = xy[0] 35 | yp = xy[1] 36 | 37 | for i= 0,n-1 do begin 38 | for j=0,n-1 DO begin 39 | if xcoeff[i,j] NE 0.0 then xp += xcoeff[i,j]*xy[0]^i*xy[1]^j 40 | if ycoeff[i,j] NE 0.0 then yp += ycoeff[i,j]*xy[0]^i*xy[1]^j 41 | endfor 42 | endfor 43 | 44 | return, [xp,yp] 45 | 46 | end 47 | -------------------------------------------------------------------------------- /pro/sixty.pro: -------------------------------------------------------------------------------- 1 | FUNCTION sixty,scalar, Trailsign = trailsign 2 | ;+ 3 | ; NAME: 4 | ; SIXTY() 5 | ; PURPOSE: 6 | ; Converts a decimal number to sexagesimal. 7 | ; EXPLANATION: 8 | ; Reverse of the TEN() function. 9 | ; 10 | ; CALLING SEQUENCE: 11 | ; X = SIXTY( SCALAR, [ /TrailSign ] ) 12 | ; 13 | ; INPUTS: 14 | ; SCALAR -- Decimal quantity. 15 | ; OUTPUTS: 16 | ; Function value returned = real vector of three elements, 17 | ; sexagesimal equivalent of input decimal quantity. Double 18 | ; precision if the input is double, otherwise floating point. 19 | ; By default, a negative number is signified by making the first non-zero 20 | ; element of the output vection negative, but this can be modified with 21 | ; the /TrailSign keyword. 22 | ; 23 | ; OPTIONAL INPUT KEYWORD: 24 | ; /TrailSign - By default, SIXTY() returns a negative sign in the first 25 | ; nonzero element. If /TrailSign is set, then SIXTY() will return 26 | ; always return a negative sign in the first element, even if it is 27 | ; zero 28 | ; PROCEDURE: 29 | ; Mostly involves checking arguments and setting the sign. 30 | ; 31 | ; EXAMPLE: 32 | ; If x = -0.345d then sixty(x) = [0.0, -20.0, 42.0] 33 | ; and sixty(x,/trail) = [-0.0, 20.0, 42.0] 34 | ; MODIFICATION HISTORY: 35 | ; Written by R. S. Hill, STX, 19-OCT-87 36 | ; Output changed to single precision. RSH, STX, 1/26/88 37 | ; Accept single element vector W. Landsman Sep. 1996 38 | ; Converted to IDL V5.0 W. Landsman September 1997 39 | ; Added /TrailSign keyword, preserve data type 40 | ; B. Stecklum/ W. Landsman March 2006 41 | ;- 42 | 43 | if N_elements(scalar) NE 1 then begin 44 | message,'ERROR - First parameter must contain 1 element',/CON 45 | return,replicate(100.0e0,3) 46 | endif 47 | 48 | ss=abs(3600.0d0*scalar) 49 | mm=abs(60.0d0*scalar) 50 | dd=abs(scalar) 51 | if size(scalar,/tname) EQ 'DOUBLE' then result = dblarr(3) else $ 52 | result=fltarr(3) 53 | result[0]= fix(dd) 54 | result[1]= fix(mm-60.0d0*result[0]) 55 | result[2]= ss - 3600.d0*result[0] - 60.0d0*result[1] 56 | 57 | if scalar[0] lt 0.0d0 then begin 58 | if keyword_set(trailsign) then result[0] = -result[0] else begin 59 | if result[0] ne 0 then result[0] = -result[0] else $ 60 | if result[1] ne 0 then result[1] = -result[1] else $ 61 | result[2] = -result[2] 62 | endelse 63 | endif 64 | 65 | return,result 66 | end 67 | -------------------------------------------------------------------------------- /pro/spec_dir.pro: -------------------------------------------------------------------------------- 1 | function spec_dir,filename,extension 2 | ;+ 3 | ; NAME: 4 | ; SPEC_DIR() 5 | ; PURPOSE: 6 | ; Complete a file specification by appending the default disk or directory 7 | ; 8 | ; CALLING SEQUENCE: 9 | ; File_spec = SPEC_DIR( filename, [ extension ] ) 10 | ; INPUT: 11 | ; filename - character string giving partial specification of a file 12 | ; name. Examples for different operating systems include the 13 | ; following: 14 | ; Unix: 'pro/test.dat', '$IDL_HOME/test','~/subpro' 15 | ; MacOS: ':Programs:test' 16 | ; Windows: '\pro\test.dat','d:\pro\test' 17 | ; 18 | ; OPTIONAL INPUT: 19 | ; exten - string giving a default file name extension to be used if 20 | ; filename does not contain one. Do not include the period. 21 | ; 22 | ; OUTPUT: 23 | ; File_spec - Complete file specification using default disk or 24 | ; directory when necessary. 25 | ; 26 | ; EXAMPLE: 27 | ; IDL> a = spec_dir('test','dat') 28 | ; 29 | ; is equivalent to the commands 30 | ; IDL> cd, current=cdir 31 | ; IDL> a = cdir + delim + 'test.dat' 32 | ; 33 | ; where delim is the OS-dependent separator 34 | ; METHOD: 35 | ; SPEC_DIR() decomposes the file name using FDECOMP, and appends the 36 | ; default directory (obtained from the FILE_EXPAND_PATH) if necessary. 37 | ; 38 | ; SPEC_DIR() does not check whether the constructed file name actually 39 | ; exists. 40 | ; PROCEDURES CALLED: 41 | ; FDECOMP, EXPAND_TILDE() 42 | ; REVISION HISTORY: 43 | ; Written W. Landsman STX July, 1987 44 | ; Expand Unix tilde if necessary W. Landsman September 1997 45 | ; Assume since V5.5, use FILE_EXPAND_PATH, remove VMS support 46 | ; W. Landsman September 2006 47 | ;- 48 | On_error,2 ;Return to user 49 | compile_opt idl2 50 | fdecomp,filename,disk,dir,name,ext 51 | if N_elements(extension) GT 0 then $ 52 | if (ext EQ '') then ext = extension 53 | 54 | dir = disk+ dir 55 | if !VERSION.OS_FAMILY EQ 'unix' then $ 56 | if strpos(dir,'~') GE 0 then dir = expand_tilde(dir) 57 | 58 | dir = file_expand_path(disk+dir) 59 | return, dir + path_sep() + name + '.' + ext 60 | end 61 | -------------------------------------------------------------------------------- /pro/str_index.pro: -------------------------------------------------------------------------------- 1 | FUNCTION STR_INDEX, str, substr, offset 2 | ;+ 3 | ; NAME: 4 | ; STR_INDEX() 5 | ; 6 | ; PURPOSE: 7 | ; Get indices of a substring (SUBSTR) in string. 8 | ; 9 | ; EXPLANATION: 10 | ; The IDL intrinsic function STRPOS returns only the index of the first 11 | ; occurrence of a substring. This routine calls itself recursively to get 12 | ; indices of the remaining occurrences. 13 | ; 14 | ; CALLING SEQUENCE: 15 | ; result= STR_INDEX(str, substr [, offset]) 16 | ; 17 | ; INPUTS: 18 | ; STR -- The string in which the substring is searched for 19 | ; SUBSTR -- The substring to be searched for within STR 20 | ; 21 | ; OPTIONAL INPUTS: 22 | ; OFFSET -- The character position at which the search is begun. If 23 | ; omitted or being negative, the search begins at the first 24 | ; character (character position 0). 25 | ; 26 | ; OUTPUTS: 27 | ; RESULT -- Integer scalar or vector containing the indices of SUBSTR 28 | ; within STR. If no substring is found, it is -1. 29 | ; 30 | ; CALLS: 31 | ; DELVARX 32 | ; 33 | ; COMMON BLOCKS: 34 | ; STR_INDEX -- internal common block. The variable save in the block is 35 | ; deleted upon final exit of this routine. 36 | ; 37 | ; CATEGORY: 38 | ; Utility, string 39 | ; 40 | ; MODIFICATION HISTORY: 41 | ; Written January 3, 1995, Liyun Wang, GSFC/ARC 42 | ; Converted to IDL V5.0 W. Landsman September 1997 43 | ; Use size(/TNAME) instead of DATATYPE() W. Landsman October 2001 44 | ; 45 | ;- 46 | ; 47 | ON_ERROR, 2 48 | COMMON str_index, idx 49 | 50 | IF N_PARAMS() LT 2 THEN MESSAGE,'Syntax: str_index, str, substr [,offset]' 51 | 52 | IF size(str,/TNAME) NE 'STRING' OR size(substr,/TNAME) NE 'STRING' THEN $ 53 | MESSAGE, 'The first two input parameters must be of string type.' 54 | 55 | IF N_ELEMENTS(offset) EQ 0 THEN pos = 0 ELSE pos = offset 56 | aa = STRPOS(str,substr,pos) 57 | IF aa NE -1 THEN BEGIN 58 | IF N_ELEMENTS(idx) EQ 0 THEN idx = aa ELSE idx = [idx,aa] 59 | bb = str_index(str,substr,aa+1) 60 | RETURN, bb 61 | ENDIF ELSE BEGIN 62 | IF N_ELEMENTS(idx) NE 0 THEN BEGIN 63 | result = idx 64 | delvarx, idx 65 | ENDIF ELSE result = -1 66 | RETURN, result 67 | ENDELSE 68 | END 69 | -------------------------------------------------------------------------------- /pro/strcompress2.pro: -------------------------------------------------------------------------------- 1 | function strcompress2, str, chars 2 | ;+ 3 | ; NAME: 4 | ; STRCOMPRESS2 5 | ; PURPOSE: 6 | ; Remove blanks around specified characters in a string 7 | ; CALLING SEQUENCE 8 | ; newstring = strcompress2( st, chars) 9 | ; INPUTS: 10 | ; st - any scalar string 11 | ; chars - scalar or vector string specifing which characters around which 12 | ; blanks should be removed. For example, if chars=['=','-','+'] 13 | ; then spaces around the three characters "=', '-', and '+' will 14 | ; be removed. 15 | ; OUTPUTS: 16 | ; newstring - input string with spaces removed around the specified 17 | ; characters. 18 | ; EXAMPLE: 19 | ; The Vizier constraint string (see queryvizier.pro) does not allow 20 | ; blanks around the operators '=','<', or '>'. But we do not want 21 | ; to remove blanks around names (e.g. 'NGC 5342'): 22 | ; 23 | ; IDL> st = 'name = NGC 5342, v< 23' 24 | ; IDL> print,strcompress2(st, ['=','<','>']) 25 | ; name=NGC 5342, v<23 26 | ; MODIFICATION HISTORY: 27 | ; Written by W.Landsman July 2008 28 | ;- 29 | 30 | On_error,2 31 | compile_opt idl2 32 | st = strcompress(str) ;Ok to compress to a single space 33 | if N_elements(chars) GT 1 then op = '(' + strjoin(chars,'|') + ')' $ 34 | else op = chars 35 | 36 | op1 = ' ' + op ;first look for Leading space 37 | n = stregex(st, op1) 38 | while n GT 0 do begin 39 | st = strmid(st,0,n) + strmid(st,n+1) ;piece string together 40 | n = stregex(st,op1) ; Look for another occurrence since stregex just 41 | endwhile ; gives the first 42 | 43 | op2 = op + ' ' ;Now look for Following space 44 | n = stregex(st, op2) 45 | while n GT 0 do begin 46 | st = strmid(st,0,n+1) + strmid(st,n+2) 47 | n = stregex(st,op2) 48 | endwhile 49 | 50 | return,st 51 | end 52 | -------------------------------------------------------------------------------- /pro/sxdelpar.pro: -------------------------------------------------------------------------------- 1 | pro sxdelpar, h, parname 2 | ;+ 3 | ; NAME: 4 | ; SXDELPAR 5 | ; PURPOSE: 6 | ; Procedure to delete a keyword parameter(s) from a FITS header 7 | ; 8 | ; CALLING SEQUENCE: 9 | ; sxdelpar, h, parname 10 | ; 11 | ; INPUTS: 12 | ; h - FITS header, string array 13 | ; parname - string or string array of keyword name(s) to delete 14 | ; 15 | ; OUTPUTS: 16 | ; h - updated FITS header, If all lines are deleted from 17 | ; the header, then h is returned with a value of 0 18 | ; 19 | ; EXAMPLE: 20 | ; Delete the astrometry keywords CDn_n from a FITS header, h 21 | ; 22 | ; IDL> sxdelpar, h, ['CD1_1','CD1_2','CD2_1','CD2_2'] 23 | ; 24 | ; NOTES: 25 | ; (1) No message is returned if the keyword to be deleted is not found 26 | ; (2) All appearances of a keyword in the header will be deleted 27 | ; HISTORY: 28 | ; version 1 D. Lindler Feb. 1987 29 | ; Test for case where all keywords are deleted W. Landsman Aug 1995 30 | ; Allow for headers with more than 32767 lines W. Landsman Jan. 2003 31 | ; Use ARRAY_EQUAL, cleaner syntax W. L. July 2009 32 | ;------------------------------------------------------------------ 33 | On_error,2 34 | compile_opt idl2 35 | 36 | if N_Params() LT 2 then begin 37 | print,'Syntax - SXDELPAR, h, parname' 38 | return 39 | endif 40 | 41 | ; convert parameters to string array of upper case names of length 8 char 42 | 43 | 44 | if size(parname,/type) NE 7 then $ 45 | message,'Keyword name(s) must be a string or string array' 46 | par = strtrim( strupcase(parname),2 ) 47 | 48 | sz = size(h,/structure) 49 | if (sz.N_dimensions NE 1) || (sz.type NE 7) then $ 50 | message,'FITS header (1st parameter) must be a string array' 51 | 52 | nlines = sz.N_elements ;number of lines in header array 53 | pos = 0L ;position in compressed header with keywords removed 54 | 55 | ; loop on header lines 56 | 57 | keyword = strtrim( strmid(h,0,8), 2 ) 58 | for i = 0L, nlines-1 do begin 59 | if array_equal(keyword[i] NE par, 1b) then begin 60 | h[pos] = h[i] ;keep it 61 | pos++ ;increment number of lines kept 62 | if keyword[i] eq 'END' then break ;end of header 63 | endif 64 | endfor 65 | 66 | if pos GT 0 then h = h[0:pos-1] else h = 0 ;truncate 67 | 68 | return 69 | end 70 | -------------------------------------------------------------------------------- /pro/sxgread.pro: -------------------------------------------------------------------------------- 1 | function sxgread,unit,group 2 | ;+ 3 | ; NAME: 4 | ; SXGREAD 5 | ; PURPOSE: 6 | ; Read group parameters from a Space Telescope STSDAS image file 7 | ; 8 | ; CALLING SEQUENCE: 9 | ; grouppar = sxgread( unit, group ) 10 | ; 11 | ; INPUTS: 12 | ; UNIT = Supply same unit as used in SXOPEN. 13 | ; GROUP = group number to read. if omitted, read first group. 14 | ; The first group is number 0. 15 | ; 16 | ; OUTPUTS: 17 | ; GROUPPAR = parameter values from fits group parameter block. 18 | ; It is a byte array which may contain multiple data types. 19 | ; The function SXGPAR can be used to retrieve values from it. 20 | ; 21 | ; COMMON BLOCKS: 22 | ; Uses IDL Common STCOMMN to access parameters. 23 | ; SIDE EFFECTS: 24 | ; IO is performed. 25 | ; MODIFICATION HISTORY: 26 | ; WRITTEN, Don Lindler, July, 1 1987 27 | ; MODIFIED, Don Neill, Jan 11, 1991 - derived from sxread.pro 28 | ; Converted to IDL V5.0 W. Landsman September 1997 29 | ;- 30 | On_error,2 31 | ; 32 | ; common block containing description of file (see SXOPEN) 33 | ; 34 | common stcommn,result,filename 35 | ; 36 | ; check if unit open 37 | ; 38 | if (unit lt 1) or (unit gt 9) then $ 39 | message,'Invalid unit number, must be between 1 and 9' 40 | if N_elements(result) eq 0 then result = 0 41 | if (N_elements(result) ne 200) or (result[0,unit] ne 121147) then $ 42 | message,'Specified unit is not open' 43 | desc = result[*,unit] ;description for unit 44 | ; 45 | ; default group number is 0 (first group) 46 | ; 47 | if N_params() eq 1 then group = 0 48 | ; 49 | ; read group parameters 50 | ; 51 | parrec = assoc(UNIT,bytarr(desc[7]),(group+1)*desc[9]-desc[7]) 52 | par = parrec[0] 53 | ; 54 | return,par 55 | end 56 | -------------------------------------------------------------------------------- /pro/sxhcopy.pro: -------------------------------------------------------------------------------- 1 | pro sxhcopy, h, keyword1, keyword2, hout 2 | ;+ 3 | ; NAME: 4 | ; SXHCOPY 5 | ; PURPOSE: 6 | ; Copies selected portions of one header to another 7 | ; 8 | ; CALLING SEQUENCE: 9 | ; sxhcopy, h, keyword1, keyword2, hout 10 | ; 11 | ; INPUTS: 12 | ; h - input header 13 | ; keyword1 - first keyword to copy 14 | ; keyword2 - last keyword to copy 15 | ; 16 | ; INPUT/OUTPUT: 17 | ; hout - header to copy the information to. 18 | ; 19 | ; METHOD: 20 | ; the headers lines from keyword1 to keyword2 are copied to 21 | ; the end of the output header. No check is made to verify 22 | ; that a keyword value already exists in the output header. 23 | ; 24 | ; HISTORY: 25 | ; version 1 D. Lindler Sept. 1989 26 | ; Converted to IDL V5.0 W. Landsman September 1997 27 | ;- 28 | ;-------------------------------------------------------------------------- 29 | ; 30 | ; make keywords 8 characters long (upper case) 31 | ; 32 | key1 = strmid(strupcase(keyword1+' '),0,8) 33 | key2 = strmid(strupcase(keyword2+' '),0,8) 34 | ; 35 | ; get header lengths 36 | ; 37 | n = n_elements(h) 38 | nout = n_elements(hout) 39 | ; 40 | ; find position of first keyword in h 41 | ; 42 | i1 = 0 43 | 44 | while i1 lt n do begin 45 | key = strmid(h[i1],0,8) 46 | if key1 eq key then goto,found1 47 | if key eq 'END ' then begin 48 | print,'SXHCOPY -- keyword '+key1+' not found in header.' 49 | print,' Nothing copied to output header.' 50 | return 51 | endif 52 | i1 = i1+1 53 | endwhile 54 | found1: 55 | ; 56 | ; find position of second keyword 57 | ; 58 | i2 = i1 59 | while i2 lt n do begin 60 | key = strmid(h[i2],0,8) 61 | if key eq 'END ' then begin 62 | i2 = i2-1 ;do not copy 'END ' 63 | goto,found2 64 | endif 65 | if key2 eq key then goto,found2 66 | i2 = i2+1 67 | endwhile 68 | found2: 69 | ; 70 | ; find end of output header 71 | ; 72 | i = 0 73 | while i lt nout do begin 74 | if strmid(hout[i],0,8) eq 'END ' then goto,found 75 | i = i+1 76 | endwhile 77 | message,'No END keyword found in output header' 78 | found: 79 | ; 80 | ; create new output header 81 | ; 82 | if i gt 0 then hout=[hout[0:i-1],h[i1:i2],hout[i]] $ 83 | else hout=[h[i1:i2],hout[i]] 84 | return 85 | end 86 | -------------------------------------------------------------------------------- /pro/sxread.pro: -------------------------------------------------------------------------------- 1 | function sxread,unit,group,par 2 | ;+ 3 | ; NAME: 4 | ; SXREAD 5 | ; PURPOSE: 6 | ; Read a Space Telescope STSDAS image file 7 | ; 8 | ; CALLING SEQUENCE: 9 | ; result = sxread( Unit, group , [par] ) 10 | ; 11 | ; INPUTS: 12 | ; UNIT = Unit number of file, must be from 1 to 9. 13 | ; Unit must have been opened with SXOPEN. 14 | ; GROUP = group number to read. if omitted, read first record. 15 | ; The first record is number 0. 16 | ; OUTPUTS: 17 | ; Result of function = array constructed from designated record. 18 | ; 19 | ; OPTIONAL OUTPUT: 20 | ; PAR = Variable name into which parameter values from STSDAS 21 | ; group parameter block are read. It is a byte array 22 | ; which may contain multiple data types. The function 23 | ; SXGPAR can be used to retrieve values from it. 24 | ; 25 | ; COMMON BLOCKS: 26 | ; Uses IDL Common STCOMMN to access parameters. 27 | ; 28 | ; NOTES: 29 | ; Use the function SXGREAD to read the group parameter blocks without 30 | ; having to read the group array. 31 | ; 32 | ; If the STSDAS file does not contain groups, then the optional output 33 | ; parameter PAR is returned undefined, but no error message is given. 34 | ; 35 | ; SIDE EFFECTS: 36 | ; IO is performed. 37 | ; MODIFICATION HISTORY: 38 | ; WRITTEN, Don Lindler, July, 1 1987 39 | ; Converted to IDL V5.0 W. Landsman September 1997 40 | ;- 41 | On_error,2 42 | 43 | ; common block containing description of file (see SXOPEN) 44 | 45 | common stcommn,result,filename 46 | 47 | ; check if unit open 48 | 49 | if ( unit LT 1 ) or ( unit GT 9 ) then $ 50 | message,'Invalid unit number, must be between 1 and 9' 51 | 52 | if N_elements(result) EQ 0 then result = 0 53 | 54 | if ( N_elements(result) NE 200 ) or ( result[0,unit] NE 121147 ) then $ 55 | message,'Specified unit is not open' 56 | 57 | desc = result[*,unit] ;description for unit 58 | 59 | ; default group number is 0 (first group) 60 | 61 | if N_params() eq 1 then group = 0 62 | 63 | ; read group parameters if requested 64 | 65 | if (N_params() GT 2) and ( desc[7] GT 0 ) then begin 66 | parrec = assoc(UNIT, bytarr(desc[7]),(group+1)*desc[9]-desc[7]) 67 | par = parrec[0] 68 | end 69 | 70 | ; read data with dimensions specified in desc. 71 | 72 | ndimen = desc[3] 73 | dtype = desc[8] 74 | dimen = desc[10:9+ndimen] 75 | sbyte = long(group)*desc[9] 76 | 77 | rec = assoc(unit,make_array(size=[ndimen,dimen>1,dtype,0],/nozero),sbyte) 78 | 79 | return,rec[0] 80 | 81 | end 82 | -------------------------------------------------------------------------------- /pro/sxwrite.pro: -------------------------------------------------------------------------------- 1 | pro SXWRITE, Unit, Data, Par 2 | ;+ 3 | ; NAME: 4 | ; SXWRITE 5 | ; PURPOSE: 6 | ; Write a group of data and parameters in ST format 7 | ; to a STSDAS data file. 8 | ; 9 | ; CALLING SEQUENCE: 10 | ; SXWRITE, Unit, Data,[ Par] 11 | ; 12 | ; INPUTS: 13 | ; Unit = unit number of file. The file must have been 14 | ; previously opened by SXOPEN. 15 | ; Data = Array of data to be written. The dimensions 16 | ; must agree with those supplied to SXOPEN and written 17 | ; into the FITS header. The type is converted if 18 | ; necessary. 19 | ; 20 | ; OPTIONAL INPUT PARAMETERS: 21 | ; Par = parameter block. The size of this array must 22 | ; agree with the Psize parameter in the FITS header. 23 | ; 24 | ; OUTPUTS: 25 | ; None. 26 | ; COMMON BLOCKS: 27 | ; STCOMMN - Contains RESULT(20,10) where RESULT(i,LUN) = 28 | ; 0 - 121147 for consistency check, 1 - Unit for consistency, 29 | ; 2 - bitpix, 3 - naxis, 4 - groups (0 or 1), 5 - pcount, 30 | ; 6 - gcount, 7 - psize, 8 - data type as idl type code, 31 | ; 9 - bytes / record, 10 to 10+N-1 - dimension N, 32 | ; 18 - # of groups written, 19 = gcount. 33 | ; 34 | ; SIDE EFFECTS: 35 | ; The data are written into the next group. 36 | ; 37 | ; RESTRICTIONS: 38 | ; SXOPEN must have been called to initialize the 39 | ; header and the common block. 40 | ; 41 | ; MODIFICATION HISTORY: 42 | ; DMS, July, 1983. 43 | ; D.Lindler July, 1986 - changed block size of file to 512 44 | ; moved group parameters after the groups data. 45 | ; D.Lindler July, 1987 - modified to allow any size parameter block 46 | ; (in bytes). 47 | ; D. Lindler April, 1990 - converted to new VMS IDL 48 | ; Converted to IDL V5.0 W. Landsman September 1997 49 | ;- 50 | ;---------------------------------------------------------------------------- 51 | ; 52 | common stcommn, result, filename 53 | if N_params() LT 2 then begin 54 | print,'Syntax - SXWRITE, Unit, Data,[ Par] 55 | return 56 | endif 57 | ; 58 | if N_elements(result) ne 200 then begin 59 | print,'SXWRITE - Sxopen not called' 60 | return 61 | endif 62 | if result[1,unit] ne unit then begin 63 | print,'SXWRITE - unit not opened with SXOPEN' 64 | return 65 | endif 66 | ; 67 | on_error,2 ;return to caller on error 68 | s = size(data) ;get data dims 69 | ; 70 | ; determine position in file to write 71 | ; 72 | start=result[18,unit]*result[9,unit] 73 | ; 74 | ; create assoc variable for data 75 | ; 76 | rec = assoc(unit,data,start) 77 | ; 78 | ; write data 79 | ; 80 | rec[0]=data 81 | ; 82 | ; write pblk 83 | ; 84 | if result[7,unit] gt 0 then begin 85 | if n_params(0) lt 3 then par=bytarr(result[7,unit]) 86 | p=byte(par,0,result[7,unit]) 87 | rec=assoc(unit,p,start+result[9,unit]-result[7,unit]) 88 | rec[0]=p 89 | end 90 | result[18,unit] = result[18,unit]+1 ;did one more group 91 | return 92 | end 93 | -------------------------------------------------------------------------------- /pro/t_group.pro: -------------------------------------------------------------------------------- 1 | pro t_group,fitsfile,rmax,xpar=xpar,ypar=ypar, NEWTABLE = newtable 2 | ;+ 3 | ; NAME: 4 | ; T_GROUP 5 | ; PURPOSE: 6 | ; Driver procedure (for GROUP) to place stars in non-overlapping groups. 7 | ; EXPLANATION: 8 | ; This procedure is part of the DAOPHOT sequence that places star 9 | ; positions with non-overlapping PSFs into distinct groups 10 | ; Input and output are to FITS ASCII tables 11 | ; 12 | ; CALLING SEQUENCE: 13 | ; T_GROUP, fitsfile, [ rmax, XPAR = , YPAR = , NEWTABLE = ] 14 | ; 15 | ; INPUTS: 16 | ; FITSFILE - Name of disk FITS ASCII table containing the X,Y positions 17 | ; in FITS (FORTRAN) convention (first pixel is 1,1) 18 | ; 19 | ; OPTIONAL INPUTS: 20 | ; rmax - maximum allowable distance between stars in a single group 21 | ; 22 | ; OPTIONAL INPUT KEYWORDS: 23 | ; XPAR, YPAR - scalar strings giving the field name in the output table 24 | ; containing the X and Y coordinates. If not supplied, 25 | ; then the fields 'X' and 'Y' are read. 26 | ; NEWTABLE - scalar giving name of output disk FITS ASCII table. If not 27 | ; supplied, 28 | ; 29 | ; PROCEDURES: 30 | ; FTADDCOL, FTGET(), FTINFO, FTPUT, GROUP, READFITS(), SXADDHIST, 31 | ; SXADDHIST, WRITEFITS 32 | ; REVISION HISTORY: 33 | ; Written, W. Landsman STX Co. May, 1996 34 | ; Converted to IDL V5.0 W. Landsman September 1997 35 | ; Updated for new FTINFO call W. Landsman May 2000 36 | ;- 37 | On_error,2 38 | 39 | if N_params() LT 1 then begin 40 | print,'Syntax - T_GROUP, fitsfile, [rmax, XPAR = , YPAR =, NEWTABLE = ]' 41 | return 42 | endif 43 | 44 | if not keyword_set(XPAR) then xpar = 'X' 45 | if not keyword_set(YPAR) then ypar = 'Y' 46 | if not keyword_set(NEWTABLE) then newtable = fitsfile 47 | 48 | dummy = readfits( fitsfile, hprimary, /SILENT ) 49 | tab = readfits(fitsfile, h, /ext) 50 | 51 | ftinfo,h,ft_str 52 | ttype = strtrim(ft_str.ttype,2) 53 | x = ftget( ft_str, tab, xpar) - 1. 54 | y = ftget( ft_str, tab, ypar) - 1. 55 | 56 | if N_elements(rmax) EQ 0 then $ 57 | read,'Enter maximum distance between stars in a group: ',rmax 58 | 59 | group, x, y, rmax, ngroup 60 | 61 | sxaddpar, h, 'RMAX', rmax, 'Maximum Distance in Group', 'TTYPE1' 62 | sxaddpar, h, 'EXTNAME', 'IDL DAOPHOT: Group', 'DAOPHOT Stage' 63 | 64 | gid = where(ttype EQ 'GROUP_ID', Nid) 65 | if Nid EQ 0 then ftaddcol, h, tab, 'GROUP_ID', 4, 'I4' 66 | ftput, h, tab, 'GROUP_ID', 0, ngroup 67 | sxaddhist, 'T_GROUP: ' + systime(),h 68 | 69 | writefits, newtable, 0, hprimary 70 | writefits, newtable, tab,h,/append 71 | return 72 | 73 | end 74 | -------------------------------------------------------------------------------- /pro/tbdelrow.pro: -------------------------------------------------------------------------------- 1 | pro tbdelrow,h,tab,rows 2 | ;+ 3 | ; NAME: 4 | ; TBDELROW 5 | ; PURPOSE: 6 | ; Delete specified row or rows of data from a FITS binary table 7 | ; 8 | ; CALLING SEQUENCE: 9 | ; TBDELROW, h, tab, rows 10 | ; 11 | ; INPUTS-OUPUTS 12 | ; h,tab - FITS binary table header and data array. H and TAB will 13 | ; be updated on output with the specified row(s) deleted. 14 | ; 15 | ; rows - scalar or vector, specifying the row numbers to delete 16 | ; First row has index 0. If a vector it will be sorted and 17 | ; duplicates removed by TBDELROW 18 | ; 19 | ; EXAMPLE: 20 | ; Compress a table to include only non-negative flux values 21 | ; 22 | ; flux = TBGET(h,tab,'FLUX') ;Obtain original flux vector 23 | ; bad = where(flux lt 0) ;Find negative fluxes 24 | ; TBDELROW,h,tab,bad ;Delete rows with negative fluxes 25 | ; 26 | ; PROCEDURE: 27 | ; Specified rows are deleted from the data array, TAB. The NAXIS2 28 | ; keyword in the header is updated. 29 | ; 30 | ; REVISION HISTORY: 31 | ; Written W. Landsman STX Co. August, 1988 32 | ; Checked for IDL Version 2, J. Isensee, July, 1990 33 | ; Converted to IDL V5.0 W. Landsman September 1997 34 | ;- 35 | On_error,2 36 | 37 | if N_params() LT 3 then begin 38 | print,'Syntax - tbdelrow, h, tab, rows ' 39 | return 40 | endif 41 | 42 | nrows = sxpar(h,'NAXIS2') ;Original number of rows 43 | if (max(rows) GE nrows) or (min(rows) LT 0) then $ 44 | message,'Specified rows must be between 0 and ' + strtrim(nrows-1,2) 45 | 46 | ndel = N_elements(rows) 47 | if ndel GT 1 then begin 48 | rows = rows[rem_dup(rows)] 49 | ndel = N_elements(rows) 50 | endif 51 | 52 | j = 0L 53 | i = rows[0] 54 | 55 | for k = long(rows[0]),nrows-1 do begin 56 | 57 | if k eq rows[j] then begin 58 | j = j+1 59 | if j EQ ndel then goto,done 60 | endif else begin 61 | tab[0,i] = tab[*,k] 62 | i = i+1 63 | endelse 64 | 65 | endfor 66 | 67 | k = k-1 68 | 69 | DONE: 70 | 71 | if k NE nrows-1 then tab[0,i] = tab[*,i+j:nrows-1] 72 | tab = tab[*,0:nrows-ndel-1] 73 | sxaddpar,h,'NAXIS2',nrows-ndel ;Reduce number of rows 74 | 75 | return 76 | end 77 | -------------------------------------------------------------------------------- /pro/tbsize.pro: -------------------------------------------------------------------------------- 1 | pro tbsize, h, tab, ncols, nrows, tfields, ncols_all, nrows_all 2 | ;+ 3 | ; NAME: 4 | ; TBSIZE 5 | ; 6 | ; PURPOSE: 7 | ; Procedure to return the size of a FITS binary table. 8 | ; 9 | ; CALLING SEQUENCE: 10 | ; tbsize, h, tab, ncols, nrows, tfields, ncols_all, nrows_all 11 | ; 12 | ; INPUTS: 13 | ; h - FITS table header 14 | ; tab - FITS table array 15 | ; 16 | ; OUTPUTS: 17 | ; ncols - number of characters per row in table 18 | ; nrows - number of rows in table 19 | ; tfields - number of fields per row 20 | ; ncols_all - number of characters/row allocated (size of tab) 21 | ; nrows_all - number of rows allocated 22 | ; PROCEDURES USED: 23 | ; SXPAR() 24 | ; HISTORY 25 | ; D. Lindler July, 1987 26 | ; Converted to IDL V5.0 W. Landsman September 1997 27 | ; Remove obsolete !ERR call W. Landsman May 2000 28 | ;- 29 | ;------------------------------------------------------------------------ 30 | On_error,2 31 | 32 | ; check for valid header type 33 | 34 | s=size(h) & ndim=s[0] & type=s[ndim+1] 35 | if (ndim NE 1) or (type ne 7) then $ 36 | message,'Invalid FITS header, it must be a string array' 37 | 38 | ; check for valid table array 39 | 40 | s = size(tab) & ndim = s[0] & type = s[ndim+1] 41 | if (ndim gt 2) or (type ne 1) or (ndim lt 1) then $ 42 | message,'Invalid table array, it must be a 2-D byte array' 43 | 44 | ncols_all = s[1] ;allocated characters per row 45 | nrows_all = s[2] ;allocated rows 46 | 47 | ; 48 | ; get number of fields 49 | ; 50 | tfields = sxpar( h, 'TFIELDS', Count = N_tfields ) 51 | if N_tfields EQ 0 then $ 52 | message,'Invalid FITS table header, TFIELDS keyword missing' 53 | 54 | ; 55 | ; get number of columns and rows 56 | ; 57 | ncols = sxpar(h, 'NAXIS1' ) 58 | nrows = sxpar(h, 'NAXIS2' ) 59 | if ( ncols GT ncols_all ) or ( nrows GT nrows_all ) then message, $ 60 | 'WARNING - Size information in header does not match that in array',/CON 61 | 62 | return 63 | end 64 | -------------------------------------------------------------------------------- /pro/textclose.pro: -------------------------------------------------------------------------------- 1 | pro textclose,textout=textout 2 | ;+ 3 | ; NAME: 4 | ; TEXTCLOSE 5 | ; 6 | ; PURPOSE: 7 | ; Close a text outpu file previously opened with TEXTOPEN 8 | ; EXPLANATION: 9 | ; procedure to close file for text output as specifed 10 | ; by the (non-standard) system variable !TEXTOUT. 11 | ; 12 | ; CALLING SEQUENCE: 13 | ; textclose, [ TEXTOUT = ] 14 | ; 15 | ; KEYWORDS: 16 | ; textout - Indicates output device that was used by 17 | ; TEXTOPEN 18 | ; 19 | ; SIDE EFFECTS: 20 | ; if !textout is not equal to 5 and the textunit is 21 | ; opened. Then unit !textunit is closed and released 22 | ; 23 | ; HISTORY: 24 | ; D. Lindler Dec. 1986 (Replaces PRTOPEN) 25 | ; Test if TEXTOUT is a scalar string W. Landsman August 1993 26 | ; Can't close unit -1 (Standard Output) I. Freedman April 1994 27 | ; Converted to IDL V5.0 W. Landsman September 1997 28 | ;- 29 | ;----------------------------------------------------------- 30 | ; CLOSE PROPER UNIT 31 | ; 32 | 33 | if N_elements( textout ) EQ 0 then textout = !textout ;use default 34 | 35 | ptype = size( textout ) ;Test if TEXTOUT is a scalar string 36 | if ptype[1] EQ 7 then text_out = 6 else text_out = textout 37 | 38 | if ( text_out NE 5 ) then begin 39 | if !textunit ne 0 AND !textunit ne -1 then begin 40 | free_lun, !TEXTUNIT 41 | !textunit = 0 42 | end 43 | end 44 | 45 | return 46 | end 47 | -------------------------------------------------------------------------------- /pro/tic_one.pro: -------------------------------------------------------------------------------- 1 | pro tic_one, min, pixx, incr, min2, tic1, RA=ra 2 | ;+ 3 | ; NAME: 4 | ; TIC_ONE 5 | ; PURPOSE: 6 | ; Determine the position of the first tic mark for astronomical images. 7 | ; EXPLANATION: 8 | ; For use in labelling images with right ascension 9 | ; and declination axes. This routine determines the 10 | ; position in pixels of the first tic. 11 | ; 12 | ; CALLING SEQUENCE: 13 | ; tic_one, zmin, pixx, incr, min2, tic1, [RA = ] 14 | ; 15 | ; INPUTS: 16 | ; zmin - astronomical coordinate value at axis zero point (degrees 17 | ; or hours) 18 | ; pixx - distance in pixels between tic marks (usually obtained from TICS) 19 | ; incr - increment in minutes for labels (usually an even number obtained 20 | ; from the procedure TICS) 21 | ; 22 | ; OUTPUTS: 23 | ; min2 - astronomical coordinate value at first tic mark 24 | ; tic1 - position in pixels of first tic mark 25 | ; 26 | ; EXAMPLE: 27 | ; Suppose a declination axis has a value of 30.2345 degrees at its 28 | ; zero point. A tic mark is desired every 10 arc minutes, which 29 | ; corresponds to 12.74 pixels. Then 30 | ; 31 | ; IDL> TIC_ONE, 30.2345, 12.74, 10, min2, tic1 32 | ; 33 | ; yields values of min2 = 30.333 and tic1 = 7.55, i.e. the first tic 34 | ; mark should be labeled 30 deg 20 minutes and be placed at pixel value 35 | ; 7.55 36 | ; 37 | ; REVISION HISTORY: 38 | ; by B. Pfarr, 4/15/87 39 | ; Corrected documentation example W. Landsman Mar 2017 40 | ;- 41 | On_error,2 42 | ; convert min to minutes 43 | if keyword_set(RA) then mul = 4.0000 else mul = 60.00000 44 | min1 = min*mul ;Convert from degrees to minutes 45 | ; 46 | incra = abs(incr) 47 | rem = min1 mod incra ;get remainder 48 | sign = min1*incr 49 | 50 | if ( sign GT 0 ) then begin 51 | 52 | tic1 = pixx - abs(rem)*(pixx/incra) 53 | min2 = (min1+incr-rem)/mul 54 | 55 | endif else begin 56 | 57 | tic1 = abs(rem)*(pixx/incra) 58 | min2 = (min1 - rem)/mul 59 | 60 | endelse 61 | 62 | return 63 | end 64 | -------------------------------------------------------------------------------- /pro/to_hex.pro: -------------------------------------------------------------------------------- 1 | FUNCTION TO_HEX, D, NCHAR 2 | ;+ 3 | ; NAME: 4 | ; TO_HEX 5 | ; PURPOSE: 6 | ; Translate a non-negative decimal integer to a hexadecimal string 7 | ; CALLING SEQUENCE: 8 | ; HEX = TO_HEX( D, [ NCHAR ] ) 9 | ; INPUTS: 10 | ; D - non-negative decimal integer, scalar or vector. If input as a 11 | ; string, (e.g. '32') then all leading blanks are removed. 12 | ; 13 | ; OPTIONAL INPUT: 14 | ; NCHAR - number of characters in the output hexadecimal string. 15 | ; If not supplied, then the hex string will contain no 16 | ; leading zeros. 17 | ; 18 | ; OUTPUT: 19 | ; HEX - hexadecimal translation of input integer, string 20 | ; 21 | ; EXAMPLES: 22 | ; IDL> A = TO_HEX([11,16]) ==> A = ['B','10'] 23 | ; IDL> A = TO_HEX(100,3) ==> A = '064' 24 | ; 25 | ; METHOD: 26 | ; The hexadecimal format code '(Z)' is used to convert. No parameter 27 | ; checking is done. 28 | ; PROCEDURES CALLED: 29 | ; None. 30 | ; REVISION HISTORY: 31 | ; Written W. Landsman November, 1990 32 | ; Converted to IDL V5.0 W. Landsman September 1997 33 | ; Use FSTRING() for more than 1024 values March 2000 34 | ; Assume since V5.4, omit FSTRING() call April 2006 35 | ;- 36 | 37 | if N_elements(nchar) EQ 0 then format = '(Z)' else begin 38 | ch = strtrim( nchar, 2 ) 39 | format = '(Z' + ch + '.' + ch + ')' 40 | endelse 41 | 42 | return, strtrim( string(d, FORM = format), 2) 43 | 44 | end 45 | -------------------------------------------------------------------------------- /pro/transform_coeff.pro: -------------------------------------------------------------------------------- 1 | 2 | function transform_coeff, coeff, alpha, beta 3 | ;+ 4 | ; NAME: 5 | ; TRANSFORM_COEFF() 6 | ; PURPOSE: 7 | ; Compute new polynomial coefficients under a linear transformation 8 | ; EXPLANATION: 9 | ; Suppose one has a (nonlinear) polynomial (similar to the POLY() function) 10 | ; y = C[0] + C[1]*x + C[2]*x^2 + C[3]*x^3 + ... 11 | ; 12 | ; and one has a linear transformation in X 13 | ; 14 | ; x = alpha*x' + beta 15 | ; This function computes the new polynomial coefficients under the linear 16 | ; transformation. 17 | ; 18 | ; CALLING SEQUENCE: 19 | ; newcoeff = TRANSFORM_COEFF( coeff, alpha, beta) 20 | ; INPUTS: 21 | ; Coeff - vector of polynomial coefficients (as with POLY()). The 22 | ; degree of the polynomial is N_elements(coeff) - 1 23 | ; Alpha, Beta - numeric scalars defining the linear transformation in X 24 | ; OUTPUTS: 25 | ; NewCoeff - Vector (same size as Coeff) giving the new polynomial 26 | ; coefficients 27 | ; EXAMPLE: 28 | ; Suppose one has polynomial mapping a nonlinear distortion in the X 29 | ; direction of a spectrum 30 | ; 31 | ; y = 0.2 + 1.1*x + 0.1*x^2 32 | ; 33 | ; if one rebins the spectrum to half the size then the linear transformation 34 | ; is x = 2.*x' 35 | ; so alpha = 2 and beta = 0 36 | ; The new coefficients are 37 | ; IDL> print, transform_coeff([0.2,1.1,0.1],2.,0) 38 | ; ==> [0.2, 2.2, 0.4] 39 | ; METHOD: 40 | ; Performs a binomial expansion of the polynomial and collect like terms 41 | ; groups.google.com/group/comp.lang.idl-pvwave/msg/11132d96d9c0f93d?hl=en& 42 | ; REVISION HISTORY: 43 | ; Written W. Landsman December 2007 44 | ;- 45 | compile_opt idl2 46 | if N_Params() LT 3 then begin 47 | print,'Syntax - newcoeff = TRANSFORM_COEFF( coeff, alpha, beta) ' 48 | if N_elements(coeff) GT 0 then return,coeff else return,-1 49 | endif 50 | degree=n_elements(coeff)-1 51 | 52 | newarray=coeff*0 53 | 54 | FOR i=0,degree DO BEGIN 55 | FOR j=0,i DO BEGIN 56 | newarray[j] = newarray[j] + $ 57 | coeff[i]*factorial(i)*alpha^j*beta^(i-j)/factorial(j)/factorial(i-j) 58 | ENDFOR 59 | ENDFOR 60 | 61 | return, newarray 62 | end 63 | -------------------------------------------------------------------------------- /pro/update_distort.pro: -------------------------------------------------------------------------------- 1 | pro update_distort, distort, xcoeff, ycoeff 2 | ;+ 3 | ; NAME: 4 | ; UPDATE_DISTORT 5 | ; PURPOSE: 6 | ; Update SIP nonlinear distortion coefficients for a linear transformation 7 | ; EXPLANATION: 8 | ; The SIP coefficients can account for nonlinearities in the astrometry 9 | ; of an astronomical image. When the image is compressed or expanded 10 | ; these coefficients must be adjusted in a nonlinear way. 11 | ; CALLING SEQUENCE: 12 | ; UPDATE_DISTORT, distort, xcoeff, ycoeff 13 | ; INPUT/OUTPUT: 14 | ; distort - structure giving SIP coefficients. See extast.pro for 15 | ; description of the SIP distortion structure 16 | ; xcoeff - 2 element numeric vector describing the linear transformation 17 | ; xp = xcoeff[0]*x + xcoeff[1] 18 | ; xcoeff - 2 element numeric vector describing the linear transformation 19 | ; yp = ycoeff[0]*x + ycoeff[1] 20 | ; 21 | ; METHOD: 22 | ; The procedure TRANSFORM_COEFF is used to determine how the 23 | ; coefficients change under the linear transformation. 24 | ; 25 | ; See example of usage in hrebin.pro 26 | ; REVISION HISTORY: 27 | ; Written, December 2007 W. Landsman 28 | ;- 29 | compile_opt idl2 30 | On_error,2 31 | if N_params() LT 3 then begin 32 | print,'Syntax - UPDATE_DISTORT, distort, xcoeff, ycoeff' 33 | return 34 | endif 35 | 36 | a = distort.a 37 | b = distort.b 38 | a_sz = size(a,/dimen) 39 | 40 | for i=0,a_sz[0] - 1 do begin 41 | a[0,i] = transform_coeff(a[*,i], xcoeff[0], xcoeff[1] ) 42 | b[0,i] = transform_coeff(b[*,i], xcoeff[0], xcoeff[1] ) 43 | endfor 44 | 45 | a = transpose(a) 46 | b = transpose(b) 47 | for i=0,a_sz[1] - 1 do begin 48 | a[0,i] = transform_coeff(a[*,i], ycoeff[0], ycoeff[1] ) 49 | b[0,i] = transform_coeff(b[*,i], ycoeff[0], ycoeff[1] ) 50 | endfor 51 | distort.a = transpose(a)/xcoeff[0] 52 | distort.b = transpose(b)/ycoeff[0] 53 | 54 | if N_elements(distort.ap) GT 1 then begin 55 | 56 | ap = distort.ap 57 | bp = distort.bp 58 | ap_sz = size(ap,/dimen) 59 | 60 | for i=0,ap_sz[0] - 1 do begin 61 | ap[0,i] = transform_coeff(ap[*,i], xcoeff[0], xcoeff[1] ) 62 | bp[0,i] = transform_coeff(bp[*,i], xcoeff[0], xcoeff[1] ) 63 | endfor 64 | 65 | ap = transpose(ap) 66 | bp = transpose(bp) 67 | for i=0,ap_sz[1] - 1 do begin 68 | ap[0,i] = transform_coeff(ap[*,i], ycoeff[0], ycoeff[1] ) 69 | bp[0,i] = transform_coeff(bp[*,i], ycoeff[0], ycoeff[1] ) 70 | endfor 71 | distort.ap = transpose(ap)/xcoeff[0] 72 | distort.bp = transpose(bp)/ycoeff[0] 73 | 74 | endif 75 | 76 | return 77 | end 78 | 79 | -------------------------------------------------------------------------------- /pro/vactoair.pro: -------------------------------------------------------------------------------- 1 | pro vactoair,wave_vac, wave_air 2 | ;+ 3 | ; NAME: 4 | ; VACTOAIR 5 | ; PURPOSE: 6 | ; Convert vacuum wavelengths to air wavelengths 7 | ; EXPLANATION: 8 | ; Corrects for the index of refraction of air under standard conditions. 9 | ; Wavelength values below 2000 A will not be altered. Accurate to 10 | ; about 10 m/s. 11 | ; 12 | ; CALLING SEQUENCE: 13 | ; VACTOAIR, WAVE_VAC, [WAVE_AIR] 14 | ; 15 | ; INPUT/OUTPUT: 16 | ; WAVE_VAC - Vacuum Wavelength in Angstroms, scalar or vector 17 | ; If the second parameter is not supplied, then this will be 18 | ; updated on output to contain double precision air wavelengths. 19 | ; 20 | ; OPTIONAL OUTPUT: 21 | ; WAVE_AIR - Air wavelength in Angstroms, same number of elements as 22 | ; WAVE_VAC, double precision 23 | ; 24 | ; EXAMPLE: 25 | ; If the vacuum wavelength is W = 2000, then 26 | ; 27 | ; IDL> VACTOAIR, W 28 | ; 29 | ; yields an air wavelength of W = 1999.353 Angstroms 30 | ; 31 | ; METHOD: 32 | ; Formula from Ciddor 1996 Applied Optics , 35, 1566 33 | ; 34 | ; REVISION HISTORY 35 | ; Written, D. Lindler 1982 36 | ; Documentation W. Landsman Feb. 1989 37 | ; Use Ciddor (1996) formula for better accuracy in the infrared 38 | ; Added optional output vector, W Landsman Mar 2011 39 | ;- 40 | On_error,2 41 | compile_opt idl2 42 | 43 | if N_params() EQ 0 then begin 44 | print,'Syntax - VACTOAIR, Wave_Vac, [Wave_Air]' 45 | return 46 | endif 47 | 48 | wave_air = double(wave_vac) 49 | g = where(wave_vac GE 2000, Ng) ;Only modify above 2000 A 50 | 51 | if Ng GT 0 then begin 52 | 53 | sigma2 = (1d4/double(wave_vac[g]) )^2. ;Convert to wavenumber squared 54 | 55 | ; Compute conversion factor 56 | 57 | fact = 1.D + 5.792105D-2/(238.0185D0 - sigma2) + $ 58 | 1.67917D-3/( 57.362D0 - sigma2) 59 | 60 | 61 | ; Convert wavelengths 62 | 63 | wave_air[g] = wave_vac[g]/fact 64 | if N_Params() eq 1 then wave_vac = wave_air 65 | endif 66 | 67 | return 68 | end 69 | -------------------------------------------------------------------------------- /pro/vect.pro: -------------------------------------------------------------------------------- 1 | function VECT,vctr,form,Format=Format,delim=delim 2 | ;+ 3 | ; NAME: 4 | ; VECT 5 | ; PURPOSE: 6 | ; Print a set of numbers as a string with delimiters included 7 | ; EXPLANATION: 8 | ; This function returns the given vector in parenthesized coordinates 9 | ; as in the form (X,Y). No limit on the number of dimensions. Also 10 | ; note that the vector does not need to be numbers. It may also be a 11 | ; string vector. e.g. ['X','Y'] 12 | ; 13 | ; CALLING SEQEUNCE: 14 | ; tmp = VECT( vctr, [ form, FORMAT = , DELIM = ] ) 15 | ; INPUT: 16 | ; VCTR The vector to be displayed e.g. [56,44] 17 | ; 18 | ; OPTIONAL KEYWORD INPUT: 19 | ; FORMAT This KEYWORD allows the specification of a format for the 20 | ; elements. e.g.: VECT([2,3],format='(f7.1)') gives '(2.0,3.0)' 21 | ; DELIM This KEYWORD specifies the delimeter. The default is ',' but 22 | ; other useful examples might be ', ' or ':' 23 | ; 24 | ; OPTIONAL INPUT 25 | ; FORM This parameter may be used instead of the keyword FORMAT 26 | ; 27 | ; OUTPUT: 28 | ; tmp A returned string of the parenthesized vector 29 | ; 30 | ; Other Procedures/Functions Called: 31 | ; STRN 32 | ; 33 | ; HISTORY: 34 | ; 03-JUL-90 Version 1 written by Eric W. Deutsch 35 | ; 24-AUG-91 Format='' keyword added (E. Deutsch) 36 | ; 29-AUG-91 FORM parameter added (E. Deutsch) 37 | ; Converted to IDL V5.0 W. Landsman September 1997 38 | ;- 39 | 40 | if (n_params(0) lt 1) then begin 41 | print,'Call: IDL> stringvar=VECT(vector,[FORMAT],[FORMAT=])' 42 | print,"e.g.: IDL> tmp=VECT([512,512]) & print,'Center: ',tmp" 43 | return,'' 44 | endif 45 | if (n_params(0) lt 2) then FORM='' 46 | if (n_elements(vctr) lt 1) then return,'' 47 | if (n_elements(Format) eq 0) then Format='' 48 | if (n_elements(delim) eq 0) then delim=',' 49 | if (FORM ne '') then Format=FORM 50 | 51 | tmp='(' 52 | for i=0,n_elements(vctr)-1 do begin 53 | sep=delim 54 | if (i eq 0) then sep='' 55 | if (Format eq '') then tmp=tmp+sep+strn(vctr[i]) $ 56 | else tmp=tmp+sep+strn(vctr[i],Format=Format) 57 | endfor 58 | tmp=tmp+')' 59 | 60 | return,tmp 61 | end 62 | -------------------------------------------------------------------------------- /pro/ydn2md.pro: -------------------------------------------------------------------------------- 1 | ;------------------------------------------------------------- 2 | ;+ 3 | ; NAME: 4 | ; YDN2MD 5 | ; PURPOSE: 6 | ; Convert from year and day number of year to month and day of month. 7 | ; CALLING SEQUENCE: 8 | ; YDN2MD,yr,dy,m,d 9 | ; INPUTS: 10 | ; yr = 4 digit year (like 1988), integer scalar 11 | ; dy = day number in year (like 310), integer scalar or vector 12 | ; 13 | ; OUTPUTS: 14 | ; m = month number (1-12, e.g. 11 = Nov) 15 | ; d = day of month (like 5). 16 | ; Note: On error returns m = d = -1. 17 | ; 18 | ; EXAMPLE: 19 | ; Find the month/day of days 155 and 255 in the year 2001 20 | ; 21 | ; IDL> ydn2md, 2001, [155,255], m, d 22 | ; ==> m = [6,9] & d = [4,12] ; = June 4 and September 12 23 | ; 24 | ; MODIFICATION HISTORY: 25 | ; Adapted from Johns Hopkins University/Applied Physics Laboratory 26 | ; Update to use VALUE_LOCATE, W. Landsman January 2001 27 | ;- 28 | ;------------------------------------------------------------- 29 | 30 | PRO YDN2MD,YR,DY,M,D, help=hlp 31 | 32 | IF (N_PARAMS() LT 4) or keyword_set(hlp) THEN BEGIN 33 | PRINT,' Convert from year and day number of year to month '+$ 34 | 'and day of month.' 35 | PRINT,' ydn2md,yr,dy,m,d' 36 | PRINT,' yr = year (like 1988), scalar input' 37 | PRINT,' dy = day number in year (like 310), scalar or vector input' 38 | PRINT,' m = month number (like 11 = Nov). out' 39 | PRINT,' d = day of month (like 5). out' 40 | PRINT,' Note: On error returns m = d = -1.' 41 | RETURN 42 | ENDIF 43 | 44 | ; Days before start of each month. 45 | YDAYS = [0,31,59,90,120,151,181,212,243,273,304,334,366] + 1 46 | 47 | LEAP = (((YR MOD 4) EQ 0) AND ((YR MOD 100) NE 0)) OR $ 48 | ((YR MOD 400) EQ 0) 49 | 50 | IF LEAP THEN YDAYS[2] = YDAYS[2:*] + 1 51 | M = VALUE_LOCATE(YDAYS, DY) + 1 52 | D = DY - YDAYS[M-1] + 1 53 | BAD = WHERE(M GT 12, NBAD) 54 | 55 | IF NBAD GT 0 THEN BEGIN 56 | M[BAD] = -1 57 | D[BAD] = -1 58 | MESSAGE,'Error in Day Number',/CON 59 | ENDIF 60 | RETURN 61 | 62 | END 63 | -------------------------------------------------------------------------------- /pro/ymd2dn.pro: -------------------------------------------------------------------------------- 1 | ;------------------------------------------------------------- 2 | ;+ 3 | ; NAME: 4 | ; YMD2DN 5 | ; PURPOSE: 6 | ; Convert from year, month, day to day number of year. 7 | ; CATEGORY: 8 | ; CALLING SEQUENCE: 9 | ; dy = ymd2dn(yr,m,d) 10 | ; INPUTS: 11 | ; yr = year (like 1988). scalar or vector 12 | ; m = month number (like 11 = Nov). scalar or vector 13 | ; d = day of month (like 5). scalar or vector 14 | ; KEYWORD PARAMETERS: 15 | ; OUTPUTS: 16 | ; dy = day number in year (like 310). out 17 | ; COMMON BLOCKS: 18 | ; NOTES: 19 | ; MODIFICATION HISTORY: 20 | ; Written by R. Sterner, 20 June, 1985. 21 | ; Johns Hopkins University Applied Physics Laboratory. 22 | ; RES 18 Sep, 1989 --- converted to SUN 23 | ; R. Sterner, 1997 Feb 3 --- Made work for arrays. 24 | ; 25 | ; Copyright (C) 1985, Johns Hopkins University/Applied Physics Laboratory 26 | ; This software may be used, copied, or redistributed as long as it is not 27 | ; sold and this copyright notice is reproduced on each copy made. This 28 | ; routine is provided as is without any express or implied warranties 29 | ; whatsoever. Other limitations apply as described in the file disclaimer.txt. 30 | ; Converted to IDL V5.0 W. Landsman 2-Jan-1998 31 | ;- 32 | ;------------------------------------------------------------- 33 | 34 | function ymd2dn,yr,m,d, help=hlp 35 | 36 | if (n_params(0) lt 3) or keyword_set(hlp) then begin 37 | print,' Convert from year, month, day to day number of year.' 38 | print,' dy = ymd2dn(yr,m,d)' 39 | print,' yr = year (like 1988). in' 40 | print,' m = month number (like 11 = Nov). in' 41 | print,' d = day of month (like 5). in' 42 | print,' dy = day number in year (like 310). out' 43 | return, -1 44 | endif 45 | 46 | ;---- Days before start of each month (non-leap year) ----- 47 | idays = [0,31,59,90,120,151,181,212,243,273,304,334,366] 48 | 49 | ;---- Correct for leap year if month ge 3 ------------- 50 | lpyr = (((yr mod 4) eq 0) and ((yr mod 100) ne 0)) $ 51 | or ((yr mod 400) eq 0) and (m ge 3) 52 | 53 | dy = d + idays[m-1] + lpyr 54 | return, dy 55 | 56 | end 57 | -------------------------------------------------------------------------------- /text/aaareadme.txt: -------------------------------------------------------------------------------- 1 | December 2006 2 | This directory contains documentation for the procedures in the 3 | IDL Astronomy Library. 4 | 5 | *.readme -- these files duplicate the aaareadme.txt files in individual 6 | subdirectories in the IDL Astronomy Library, and give a brief 7 | description of the procedures in the directory. For example, 8 | astrom.readme describes the IDL procedure dealing with astrometry. 9 | 10 | daophot.tex -- A LaTeX file describing an early (1987) adaptation of the 11 | DAOPHOT FORTRAN photometry package into IDL and available in /daophot 12 | 13 | database.tex -- A LaTeX file describing how to use the IDL database software 14 | available in the /database directory. 15 | 16 | ft.tex - A LaTeX file describing how to use the ft* and tb* IDL procedures 17 | in the /fits_table directory along with READFITS/WRITEFITS to 18 | read and write FITS ASCII tables and read FITS binary tables. 19 | 20 | fits_bintable.tex - A LaTeX file written by Bill Thompson (ARC/Goddard) 21 | describing how to use the FITS binary table package in /fits_bintable. 22 | 23 | mrdfits.txt - A text file describing the use of the large program MRDFITS.PRO 24 | in the /fits directory. This program will directly map a FITS table 25 | into an IDL structure. This information is also available at 26 | http://idlastro.gsfc.nasa.gov/mrdfits.html 27 | 28 | idl_stsdas.tex -- a LaTeX file describing how to manipulate STSDAS 29 | images and tables using IDL procedures in the /sdas and /sdas_table 30 | directories. The file is taken from Chapter 10 of the 31 | Goddard High Resolution Spectrograph (GHRS) manual, written by 32 | J. Blackwell, S.N. Shore, R.D. Robinson, K. Feggans, D. Lindler, 33 | E. Malamuth, J. Sandoval, and T.B. Ake. 34 | -------------------------------------------------------------------------------- /text/data.readme: -------------------------------------------------------------------------------- 1 | Dec 2006 2 | 3 | This directory contains any data files which are used by procedures in the IDL 4 | astronomy library. These procedures look for these data files in a directory 5 | with the environment variable name ASTRO_DATA. 6 | 7 | As of May 2002, this directory contains two files 8 | 9 | 10 | 1. JPLEPH.405 - FITS file contain the JPL DE405 ephemeris (chebychev 11 | polynomials based upon the International Celestial Reference Frame 12 | (ICRF). Because of the size of this file it is not distributed 13 | along with the standard IDL Astronomy Library tar or zip files. 14 | 15 | 2. testpo.405 -- an ASCII file containing sample ephemeris test data for use 16 | the IDL jpl* ephemeris procedure 17 | 18 | 19 | Because of the large size of JPLEPH.405 and testpo.405 they are not included 20 | with the IDL Astronomy Library .tar or .zip files. Users who need these files 21 | should instead fetch them from http://idlastro.gsfc.nasa.gov/ftp/data/ . 22 | -------------------------------------------------------------------------------- /text/disk_io.readme: -------------------------------------------------------------------------------- 1 | /DISK_IO Sep 2006 2 | 3 | This subdirectory contains IDL procedures to read popular disk formats in 4 | astronomy. Currently available are procedures to access 5 | 6 | (1) IRAF image (.imh) files (read and write) 7 | (3) WFPC2 images (FITS or STSDAS) 8 | 9 | The procedures to access disk FITS files are kept in a separate subdirectory 10 | /FITS, and those to access STSDAS image files are in the subdirectory /SDAS. 11 | 12 | The procedure IRAFDIR uses the non-standard system variables !TEXTOUT and 13 | !TEXTUNIT. These can be added to one's session using the procedure 14 | ASTROLIB. 15 | 16 | -------------------------------------------------------------------------------- /text/idlphot.readme: -------------------------------------------------------------------------------- 1 | DAOPHOT-type Photometry March 2008 2 | 3 | These are a set of IDL procedures adapted from an early FORTRAN 4 | version of DAOPHOT aperture photometry. The creators of DAOPHOT 5 | have no responsibility whatsoever for the IDL code. The IDL code 6 | will give similar, but not identical, results as the original FORTRAN. 7 | A LaTex file daophot.tex in /text supplies further documentation for 8 | the IDL-DAOPHOT procedures for CCD images. The PSF fitting portion of the 9 | code (e.g. nstar.pro) is now fairly obsolete, but the routines for source 10 | detection, aperture photometry and sky level determination have been kept 11 | up to date. 12 | 13 | Changes: 14 | 15 | March 2008: GCNTRD - Modified to match IRAF/DAOFIND and use a more accurate 16 | (though possibly less robust) 17 | FIND - Now uses the Gaussian fits to the marginal X & Y 18 | distributions (as in GCNTRD) rather than finding where the 19 | derivative goes to zero. 20 | 21 | June 2004: SKY,MMM updated to better match more recent versions of DAOPHOT 22 | 23 | June 2004: the procedure GCNTRD was added to determine centroids using 24 | Gaussian fits to the marginal X and Y distributions. This is similar to the 25 | method used in current DAOPHOT versions, and allows the user to ignore possible 26 | bad pixels. (Very early -- pre-1987 -- versions of DAOPHOT used the 27 | centroid algorithm in CNTRD.PRO where the centroid is located where the X 28 | and Y derivatives go to zero.) 29 | 30 | June 2000: the procedure aper.pro was modified to allow it to compute the 31 | exact area of the intersection of a circle with square pixels. 32 | 33 | July 1997: the procedures were modified so that the PSF residuals are 34 | written to a FITS file, rather than a STSDAS file. To convert a PSF 35 | file 'psfname' created earlier in STSDAS format, use the following commands: 36 | IDL> sxopen,1,'psfname',h 37 | IDL> psf = sxread(1) 38 | IDL> writefits,'psfname.fits',psf,h 39 | 40 | 41 | May 1996: the following updates were made to the code 42 | (1) Non-standard system variables are no longer used. The PRINT 43 | keyword is used instead of !TEXTOUT, and the DEBUG keyword is used 44 | instead of !DEBUG. 45 | (2) The T_* procedures now request the *name* of a disk FITS ASCII table 46 | for storing the input and output results. 47 | (3) NSTAR now has a /VARSKY keyword to allow the skylevel to vary. 48 | 49 | 50 | -------------------------------------------------------------------------------- /text/image.readme: -------------------------------------------------------------------------------- 1 | June 1998 2 | 3 | This directory includes a few procedures for image processing or or analysis. 4 | 5 | The procedures MAX_ENTROPY and MAX_LIKELIHOOD were written by Frank Varosi 6 | to provide simple deconvolution methods. Additional procedures are available 7 | in pub/contrib/varosi/vlibm/deconv for monitoring the deconvolution iterations. 8 | Also see the LaTeX file in pub/contrib/varosi/deconv.tex 9 | 10 | ------- 11 | ------- 12 | BOXAVE() - Boxave an image, always using at least REAL*4 arithmetic 13 | CONVOLVE() - Convolve an image with a PSF using the product of Fourier Transforms 14 | CORREL_IMAGES() - Correlation of two images. Called by CORREL_OPTIMIZE 15 | CORREL_OPTIMIZE - Compute the optimal pixel offset of one image relative 16 | to another by maximizing the correlation function. 17 | CORRMAT_ANALYZE - Analyze the correlation function made by CORREL_IMAGE 18 | CR_REJECT - General iterative cosmic ray rejection for 2 or more images 19 | DIST_CIRCLE - Create a mask array useful for circular aperture photometry. 20 | DIST_ELLIPSE - Create a mask array useful for elliptical aperture photometry. 21 | FILTER_IMAGE() - Like MEDIAN or SMOOTH but handles edges & allows iteration 22 | FREBIN() - Shrink or expand an image by an arbitrary amount while conserving flux 23 | IMLIST - Display image pixel values around a specified center 24 | MAX_ENTROPY - Deconvolution by Maximum Entropy, given a PSF 25 | MAX_LIKELIHOOD - Deconvolution by maximum likelihood, given a PSF 26 | MEDARR - Median filter across a set of images (e.g. for cosmic ray removal) 27 | POSITIVITY() - Map an image uniquely and smoothly into all positive values 28 | PSF_GAUSSIAN() - Create a 1-d, 2-d, or 3-d Gaussian with specified FWHM, center 29 | RINTER() = Cubic interpolation at a set of reference points 30 | SIGMA_FILTER() - Replace pixels deviant by more than a specified sigma from 31 | its neighbors. 32 | ---------------------------------------------------------------------------- 33 | 34 | -------------------------------------------------------------------------------- /text/jhuapl.readme: -------------------------------------------------------------------------------- 1 | /jhuapl November 2007 2 | 3 | The procedures in this directory are taken from the IDL program library at the 4 | Johns Hopkins University (JHU) Applied Physics Lab (APL) at 5 | http://fermi.jhuapl.edu/s1r/idl/idl.html. They are duplicated here either 6 | because they are used by other procedures in the Astronomy library, or because 7 | they are strongly related to Astronomy. Users who have both the Astronomy 8 | Library and the JHU library can delete this directory. Please inform Wayne 9 | Landsman ( http://astrophysics.gsfc.nasa.gov/staff/CVs/Wayne.Landsman/) if there 10 | are any discrepancies between these procedures and those in the JHUAPL 11 | library. 12 | 13 | An updated version of YDN2MD procedure from the JHUAPL library is available in 14 | the /astro directory. 15 | 16 | Contents of /pro/jhuapl 17 | 18 | FACTOR - Find the prime factors of a given number 19 | GETWRD() - Get specified item (word) from a string 20 | ISARRAY() - Determine if an IDL variable is an array 21 | POLREC - Convert from polar to rectangular coordinates 22 | PRIME - Return the first N primes 23 | RECPOL - Convert from rectangular to polar coordinates 24 | REPCHR() - Replace all occurrences of one character by another 25 | SPHDIST() - Find angular distance on a sphere 26 | YMD2DN() - Convert year,month,day to day number of the year 27 | 28 | -------------------------------------------------------------------------------- /text/plot.readme: -------------------------------------------------------------------------------- 1 | Plotting Procedures pro/plot Feb 2011 2 | 3 | The procedures in this directory are useful additions to the intrinsic IDL 4 | plotting capabilities. 5 | 6 | The procedures marked with "CG" below were updated in February 2011 to use the 7 | Coyote Graphics library 8 | ( http://www.idlcoyote.com/graphics_tips/coyote_graphics.html ) 9 | 10 | CLEANPLOT - Reset all plotting system variables to their default (X) values 11 | AL_LEGEND - Create an annotation legend for a plot (CG) 12 | LEGENDTEST - Demo program demonstrating the capabilities of LEGEND (CG) 13 | LINEID_PLOT - Annotate the identified lines in a spectrum (CG) 14 | MULTIPLOT - Create multiple plots with shared axes (CG) 15 | OPLOTERROR - Overplot Y vs. X with optional X and Y error bars (CG) 16 | PARTVELVEC - Plot the velocity vectors of a set of particles (CG) 17 | PLOTERROR - Plot Y vs. X with optional X and Y error bars (CG) 18 | PLOTHIST - Plot the histogram of an array (CG) 19 | PLOTSYM - Define useful plotting symbols not in the standard PSYM definition 20 | RDPLOT - Like intrinsic CURSOR procedure but with a full-screen cursor 21 | SUNSYMBOL() - Return the character string to plot a subscripted Sun symbol 22 | VSYM - Create "Mongo"-like plotting symbols, rotationally symmetric polygons 23 | 24 | -------------------------------------------------------------------------------- /text/robust.readme: -------------------------------------------------------------------------------- 1 | Robust Statistics Procudures July 2003 2 | 3 | In 1995, Henry Freudenriech (Hughes STX) developed a library of robust 4 | statistics procedures in IDL (called ROBLIB), which has been stored in the 5 | http://idlastro.gsfc.nasa.gov/ftp/contrib/freudenreich/ directory of the IDL 6 | Astronomy library. These procedures are being updated for more recent versions 7 | of IDL and transferred to the main library. As of July 2003, the following 8 | procedures are now included: 9 | 10 | AUTOHIST - Draw a histogram using automatic bin-sizing. 11 | BIWEIGHT_MEAN() - Iterative biweighted determination of mean and std. dev. 12 | HISTOGAUSS - Outlier-resistant autoscaled histogram drawing 13 | MEDSMOOTH() - Median smoothing of a vector including points near its ends 14 | RESISTANT_MEAN - Outlier-resistant determination of mean and std. deviation. 15 | ROB_CHECKFIT() - Utility to determine quality of a fit and return biweights 16 | ROBUST_LINEFIT() - Robust fit of Y vs X (or bisector of Y vs X and X vs Y) 17 | ROBUST_POLY_FIT() - Robust polynomial fit 18 | ROBUST_SIGMA() - Robust analog of the standard deviation 19 | -------------------------------------------------------------------------------- /text/structure.readme: -------------------------------------------------------------------------------- 1 | pro/structure December 2006 2 | 3 | This directory contains IDL procedures for working with IDL structure 4 | variables. The *procedure* CREATE_STRUCT will dynamically create an IDL 5 | structure and is useful when the structure properties are not known before run 6 | time. The intrinsic *function* CREATE_STRUCT() in IDL has a similar purpose, 7 | but requires that each tag value be input as a separate parameter. This makes 8 | the intrinisc function awkward to use when the *number* of tags is not known 9 | prior to run time. The procedure MRD_STRUCT is similar to CREATE_STRUCT and 10 | was developed for the MRDFITS procedure. 11 | 12 | This directory also contains following IDL routines for working with 13 | structures, written by Frank Varosi (Hughes STX): 14 | 15 | 16 | COPY_STRUCT, struct_FROM, struct_TO, NF_copied, EXCEPT=["except_Tags"] ,$ 17 | /RECUR_FROM ,$ 18 | /RECUR_TO ,$ 19 | /RECUR_TANDEM 20 | 21 | Copies all Fields with matching Tag names (except for "except_Tags") 22 | from one structure array to a different structure array. 23 | Keyword options /RECUR_xxxx will cause recursive calls, 24 | in order to copy from/to nested sub-structures. 25 | NF_copied is incremented by # fields actually copied. 26 | 27 | 28 | 29 | diff_List = COMPARE_STRUCT( struct_A, struct_B, EXCEPT=["except_Tags"] ,$ 30 | /RECUR_A, /RECUR_B ) 31 | 32 | Compares all matching Tag names (except for "except_Tags") 33 | between two structure arrays (may be different struct.defs.). 34 | Returned Diff_List is a structure containing field names and # diffs. 35 | 36 | 37 | 38 | nbytes = SIZE_STRUCT( structure, /PRINT ) 39 | 40 | Obtain the size in bytes of an IDL structure definition. 41 | /PRINT = to print all sub-structure sizes. 42 | 43 | 44 | ns = N_STRUCT( structure, Ntags ) 45 | 46 | Return number of elements in array, if structured, and number of tags. 47 | Returns zero if not structured, also works on file assoc. structs. 48 | 49 | 50 | PRINT_STRUCT, structure, ["tags_print"], LUN_OUT=Lun 51 | Print specified tags from structure (to LUN if given). 52 | 53 | 54 | wsubs = WHERE_TAG( Struct, Nfound, TAG_NAME="Tag_Name", $ 55 | ISELECT=ipart, /NOPRINT, $ 56 | RANGE=[min,max], VALUES=[values] ) 57 | 58 | Obtain subscripts of elements in structure array for which 59 | specified Tag has values in a RANGE or matching specified VALUES. 60 | Useful in programming when Tag_Name is a variable. 61 | -------------------------------------------------------------------------------- /text/tv.readme: -------------------------------------------------------------------------------- 1 | TV Display Procedures pro/tv August 2000 2 | 3 | The procedures in this directory involve the use of direct graphics or the 4 | image display. 5 | 6 | BLINK - Blink two or more windows in an image display 7 | CURS - Change the shape of the (X windows only) cursor 8 | CURVAL - Interactive display of image intensities and astronomical coordinates 9 | PIXCOLOR - Set specified pixel values to a specified color 10 | SIGRANGE() - Find range of pixel values which contain 99% of the image values 11 | TVBOX - Draw a box of specified size on the image display 12 | TVCIRCLE - Draw a circle of specified radius on the current device 13 | TVELLIPSE - Draw an ellipse of specified axes on the current device 14 | TVLASER - Write an image to postscript file with annotation from a FITS header 15 | TVLIST - Display intensity values surrounding the cursor position 16 | UNZOOM_XY - Convert from window coordinates to image coordinates 17 | ZOOM_XY - Convert from image coordinates to window coordinates 18 | 19 | Notes: 20 | 21 | TVLIST requires the use of the non-standard system variable !TEXTOUT. 22 | This can be added to one's session using the astronomy library procedure 23 | ASTROLIB. 24 | 25 | To display astronomical coordinates with CURVAL, one must have a FITS header 26 | with astrometry information. Several procedures from the ASTROM directory 27 | are used. 28 | 29 | Users probably want to tailor TVLASER to choose their preferred FITS 30 | keywords for supplying annotation 31 | 32 | Bill Thompson has written an additional set of image display routines that are 33 | not part of the standard IDL astronomy library but which are available in the 34 | solar IDL Library at 35 | http://sohowww.nascom.nasa.gov/solarsoft/gen/idl/image/. See the 36 | aaareadme.txt file in that directory for more info. 37 | 38 | The version of SIGRANGE in this directory differs slightly from that found in 39 | the solar Library, in that it does not use the non-standard !MISSING system 40 | variable. 41 | --------------------------------------------------------------------------------