Index: /tags/ohana/perl-1-3/Ohana/src/perl/.status =================================================================== --- /tags/ohana/perl-1-3/Ohana/src/perl/.status (revision 21906) +++ /tags/ohana/perl-1-3/Ohana/src/perl/.status (revision 21906) @@ -0,0 +1,60 @@ +elixir status +elixir flips +elixir ptolemy +nav +nav +!radec -hms +region 168.148 6.9777 1.0 +catalog -g -m 14 20 +catalog -g -all -m 14 20 +style -pt 1 +region 168.148 6.9777 1.0 +catalog -g -all -m 14 20 +region 168.148 6.9777 0.3 +region 168.148 6.9777 1.0 +region 168.148 6.9777 0.3 +catalog -g -all -m 14 20 +catalog -g -all -m 10 15 +region 168.148 6.9777 0.3 +catalog -g -all -m 10 15 +nav +pmeasure -all -m 16 22 +nav +pmeasure -all -m 16 22 +style -pt 2 +c +elixir flips +elixir ptolemy +elixir flips +elixir complete +elixir complete -time +elixir complete -time +na +region +region 30 0 90 ait +style -c red; cgrid +style -c black; images +box +region 30 0 90 ait +style -c red; cgrid +region 40 0 90 ait +style -c red; cgrid +style -c black; images +clear +style -c red; cgrid +style -c black; images +jpeg -g -name /h/eugene/spplots/allsky.png +elixir complete +elixir complete +elixir complete -time +elixir complete -time +elixir complete -time +elixir complete +elixir complete +echo {2500*60/11} +echo {2500*60/11/3600} +elixir complte +elixir complete +elixir complete -time +elixir complete +elixir complete -kill Index: /tags/ohana/perl-1-3/Ohana/src/perl/Makefile =================================================================== --- /tags/ohana/perl-1-3/Ohana/src/perl/Makefile (revision 21906) +++ /tags/ohana/perl-1-3/Ohana/src/perl/Makefile (revision 21906) @@ -0,0 +1,62 @@ +include ../../Configure +HOME = $(ROOT)/src/perl + +DESTBIN = $(LBIN) + +perl: default + +default: install + +DADS = \ +dads.detrend dads.jpeg dads.keywords grab.keywords + +DETREND = \ +darktime.cfh12k darktime.linear \ +demodemap flatten.mana flatten.flips defringe getfringe defringe.ccd + +GENERAL = \ +cfht.names checkconfig mkrun megacenter megacoords \ +update.astrometry.iraf wfi.keywords mefheadunstrip cadc2qso \ +mkhtml mkidx mkdist + +IMSTATS = \ +imstatqso imstats \ +irstats seeingstats + +MKDETREND = \ +create.subset dt.select fixscat fixscat.mef mkscat \ +mkdetrend mosaic.merge mosaic.stats \ +normalize split.mef \ +detflips merge.lists + +MKFRINGE = \ +fr.mkmodes fr.modesave fr.modestats \ +fr.ckfile fr.detrend fr.frstats \ +fr.getfringe fr.imdata fr.jpegs \ +fr.medbin.spline fr.medbin.interp fr.mkhtml fr.mklists \ +fr.select mkfringe fr.defringe fr.smooth + +POSTRUN = \ +ckastrom ckdetrend ckphotom \ +ckrunid ckvalid elixir.photreport \ +elixir.postrun mktrans mktreport \ +validate rerun.complete elixir.rerun + +PTOLEMY = \ +cmp.header imclean.cfht imclean.subaru gastro.raw elixir.export + +REALTIME = \ +ckimregdb elixir.link elixir.reload + +CODE = $(DADS) $(DETREND) $(GENERAL) $(IMSTATS) $(MKDETREND) $(MKFRINGE) $(POSTRUN) $(PTOLEMY) $(REALTIME) + +install: + @if [ ! -d $(DESTBIN) ]; then mkdir -p $(DESTBIN); fi + for file in $(CODE); do \ + (chmod +x src/$$file && cd $(DESTBIN) && rm -f $$file && ln -s $(HOME)/src/$$file .); \ + done + +# utilities ################################################# +clean: + rm -f `find . -name "*~"` + rm -f `find . -name "#*"` Index: /tags/ohana/perl-1-3/Ohana/src/perl/doc/Changes.log =================================================================== --- /tags/ohana/perl-1-3/Ohana/src/perl/doc/Changes.log (revision 21906) +++ /tags/ohana/perl-1-3/Ohana/src/perl/doc/Changes.log (revision 21906) @@ -0,0 +1,10 @@ + +perl-1-3: + - added mkdist, mkhtml, mkidx for ohana support + +perl-1-2: + - modified elixir.postrun to use unified addstar (not addref) + +perl-1-1: + - fixed /usr/bin/perl references everywhere *except* mkdetrend and + mkfringe, which must have the path explicitly defined. Index: /tags/ohana/perl-1-3/Ohana/src/perl/doc/keywords.txt =================================================================== --- /tags/ohana/perl-1-3/Ohana/src/perl/doc/keywords.txt (revision 21906) +++ /tags/ohana/perl-1-3/Ohana/src/perl/doc/keywords.txt (revision 21906) @@ -0,0 +1,130 @@ + +Elixir data products are modified by several programs, each of which +needs to make certain additions or changes to the headers. this is a +summary of those programs and the relevant keywords. These programs +may also add COMMENT and HISTORY fields, but these are ignored. + +* basic master bias, flat, dark frames are created by 'imcombred' + and adjusted by 'normalize'. + +- 'imcombred' adds the following keywords: + +IMCMB_DT= 'FLIPS ver 2.0 - Elixir by CFHT - Tue Aug 12 2003 - 9:09:32' / Date +IMCMB_AL= 'SIGMA ' / CCD or SIGMA clipping, Scaled or Weighted Diff +IMCMB_CA= 'MEAN ' / Combining algorithm on final stack +IMCMB_LS= 3.5 / Lower threshold for clipping rejection +IMCMB_HS= 3.5 / Lower threshold for clipping rejection +IMCMB_FT= 'MASTER_DETREND_SKYFLAT' / Stacked frame type +IMCMB_OP= '1DYMODEL_OVERSCAN + COMPUTED_MODE_RESCALING' / Input operations +IMCMB_NI= 16 / Number of input files +IMCMB_DA= T / Dual amplifier A,B (IMCMB_XX list format) +IMCMB_IF= 'NAME BIAS_A MODE_A BIAS_B MODE_B' / Input file parameters +IMCMB_nn= '712143f.fits[ccd00] 1287 3204 1232 3266' / Input file stats + +- 'normalize' adds the following keywords: + +FLATSCAL= 1.0642668848 / +TVSTART = '2000/1/1 ' / data validity start time +TVSTOP = '2001/1/1 ' / data validity start time +ELCONF = '03Bm01.flat.g.0 ' / Original Elixir config +EL_SYS = '2.0 ' / Elixir System Version +EL_NRM = '1.4 ' / Elixir Normalize Version +REL_DATE= '2003-09-30T15:59:33' / UTC Release Date + +* scatter-corrected flats are created by 'fixscat' +- 'fixscat' adds the following keywords: + +EL_SFILE= '02Bm05.scatter.g.36.00.fits' / Scattered Light Image Used +EL_SVER = 'B.0 ' / Scatter Correction Version + +* scatter frames are created by 'mkscat' +- 'mkscat' adds the following keywords: + +TVSTART = '2000/1/1 ' / data validity start time +TVSTOP = '2001/1/1 ' / data validity start time +FILTER = 'g ' / filter uxed for model +EL_SYS = '2.0 ' / Elixir System Version +EL_SVER = 'B.0 ' / Scatter Correction Version +VERSION = 'B.0 ' / Scatter Correction Version + +* master fringe frames are created by 'imcombred' and adjusted by + 'fr.smooth' + +- imcombred adds the following keywords: + +IMCMB_DT= 'FLIPS ver 2.1 - Elixir by CFHT - Tue Sep 16 2003 - 14:00:18' / Date +IMCMB_AL= 'SIGMA ' / CCD or SIGMA clipping, Scaled or Weighted Diff +IMCMB_CA= 'MEDIAN ' / Combining algorithm on final stack +IMCMB_LS= 2.0 / Lower threshold for clipping rejection +IMCMB_HS= 2.0 / Lower threshold for clipping rejection +IMCMB_FT= 'MASTER_DETREND_FRINGE' / Stacked frame type +IMCMB_OP= 'MODE_OFFSETING + FRINGE_RESCALING' / Input operations +IMCMB_NI= 31 / Number of input files +IMCMB_DA= F / Dual amplifier A,B (IMCMB_XX list format) +IMCMB_IF= 'NAME BIAS MODE SCALING' / Input file parameters +IMCMB_00= '714505o00.fits 0 2582 0.441' / Input file stats + +- fr.smooth adds the following keywords: + +FRNG_C0 = 0.0000000000 / Fringe Cross Correlation linear fit term +FRNG_C1 = 0.7197280000 / Fringe Cross Correlation linear fit term +FRNG_SKY= 2882.0000000000 / Fringe Frame sky level +FRNG_RNG= -80.0000000000 / Fringe Frame fringe strength +FRNG_REF= 'ccd13 ' / Fringe Cross Correlation reference chip +FRNG_PTS= '2003A.frpts.i.36.00.fits' / Fringe Point File +TVSTART = '2000/1/1 ' / data validity start time +TVSTOP = '2001/1/1 ' / data validity stop time +EL_SYS = '2.0 ' / Elixir System Version + + +* processed science images are created by 'imred', defringed with + 'imcombred', and keywords are updated with 'grab.keywords' + +- imred adds the following keywords: + +IMRED_DT= 'FLIPS ver 2.1 - Elixir by CFHT - Tue Sep 9 2003 - 12:29:37' / Date +IMRED_IF= '703406o.fits[ccd00]' / Input file to process by imred +IMRED_OF= '703406p00.fits' / Output file resulting from the process by imre +IMRED_OP= 'MASK_BP + OVERSCAN + BIAS + DARK_CURRENT + FLAT-FIELD' / Operation(s +IMRED_MK= '2003A.mask.0.36.00.fits[ccd00]' / Mask of bad pixels (0/1) input fil +IMRED_OV= '1DYMODEL_OVERSCAN' / Type of overscan level correction +IMRED_BS= '03Am04n.bias.0.18.00.fits[ccd00]' / Bias frame input file +IMRED_DK= '03Am04n.dark.300.18.00.fits[ccd00]' / Dark frame input file +IMRED_DS= 1.0000 / Dark frame scaling factor +IMRED_DB= T / Dark frame first corrected by bias frame +IMRED_FF= '03Am04n.flat.r.18.01.fits[ccd00]' / Flat-field frame input file +IMRED_NF= T / Normalized flat-field +IMRED_SF= 1.009331465 / Output file dynamic stretching factor (BSCALe) + +- imcombred adds the following keywords: + +IMCMB_DT= 'FLIPS ver 2.1 - Elixir by CFHT - Tue Sep 9 2003 - 12:16:00' / Date +IMCMB_AL= 'SD ' / CCD or SIGMA clipping, Scaled or Weighted Diff +IMCMB_CA= 'SCALED_DIFFERENCE' / Combining algorithm on final stack +IMCMB_LS= 2.0 / Lower threshold for clipping rejection +IMCMB_HS= 2.0 / Lower threshold for clipping rejection +IMCMB_FT= 'DEFRINGE_SCIENCE' / Stacked frame type +IMCMB_OP= 'MODE_OFFSETING + FRINGE_RESCALING' / Input operations +IMCMB_NI= 2 / Number of input files +IMCMB_DA= F / Dual amplifier A,B (IMCMB_XX list format) +IMCMB_IF= 'NAME BIAS MODE SCALING' / Input file parameters +IMCMB_00= '703266p00.det 0 3808 1.000' / Input file stats +IMCMB_01= '03Am04n.fringe.i.18.00.fits[ccd00] 0 4062 1.108' / Input file stats + +- grab.keywords adds the following keywords: + +NASTRO = 49 / number of stars used for astrometry +CERROR = 0.7334717934 / scatter in astrometry soln (arcsec) +PHOT_C = 25.715 / Nightly zero point - actual +PHOT_C0 = 25.743 / Nightly zero point - nominal +PHOT_CS = 0.017 / Nightly zero point - scatter +PHOT_NS = 3 / Nightly zero point - N stars +PHOT_NM = 3 / Nightly zero point - N images +PHOT_X = 0.083 / Nightly zero point - color term +PHOT_K = -0.04 / Nightly zero point - airmass term +PHOT_C1 = 'r_SDSS ' / Nightly zero point - color 1 +PHOT_C2 = 'i_SDSS ' / Nightly zero point - color 2 +MAG_SAT = 13.8063 / approx saturation (mag) +MAG_LIM = 23.2063 / approx completeness limit (mag) +DATEPROC= '2003-09-30T17:14:50' / Processing Date +EL_SYS = '2.0 ' / Elixir System Version Index: /tags/ohana/perl-1-3/Ohana/src/perl/doc/mkdetrend-notes.txt =================================================================== --- /tags/ohana/perl-1-3/Ohana/src/perl/doc/mkdetrend-notes.txt (revision 21906) +++ /tags/ohana/perl-1-3/Ohana/src/perl/doc/mkdetrend-notes.txt (revision 21906) @@ -0,0 +1,46 @@ + +files used by mkdetrend: + +flips/02Bk06.flat.I.00.0.fits - master image, unnormalized +flips/02Bk06.flat.I.00.0.imbin - binned master image +flips/02Bk06.flat.I.00.0.log - log +flips/02Bk06.flat.I.00.0.master - list of input images +flips/02Bk06.flat.I.00.0.medbin - binned residual stack (50) +flips/02Bk06.flat.I.00.0.mef - list of mef images +flips/02Bk06.flat.I.00.0.msplit - list of split mef images +flips/02Bk06.flat.I.00.0.norm - master image, normalized +flips/02Bk06.flat.I.00.0.split - list of split images +flips/02Bk06.flat.I.00.0.stats - residual stats per input image +flips/02Bk06.flat.I.00.0.subset - list of images to be stacked +flips/02Bk06.flat.I.00.0.tenbin - binned residual stack (10) + +changes: + +dt.select2: +mkdetrend2 +mode.mkdetrend2 +cfh12k.config.mef + + +chip ID rules: + +there are two chip identifiers: CCD ID & CCD N + +CCD ID is an arbitrary string +CCD N is a two digit code for the CCDs base on the camera config file + +CCD ID: cameraconfig -ccds +CCD N: cameraconfig -ccdn + +detsearch / imsearch use CCD ID for -ccd filter + +filenames of derivative products should use CCD N as a marker +eg: 654321o.fits -> 654321o23.fits (for megacam ccd23 image) + +--- + +dt.select2 : CCD ID fixed +merge.lists : CCD n/a +create.subset : CCD n/a +detflips : CCD n/a - flips path needs to be set? +normalize : CCD ID Keyword used to id REF ccd (OK) Index: /tags/ohana/perl-1-3/Ohana/src/perl/doc/mkfringe.notes =================================================================== --- /tags/ohana/perl-1-3/Ohana/src/perl/doc/mkfringe.notes (revision 21906) +++ /tags/ohana/perl-1-3/Ohana/src/perl/doc/mkfringe.notes (revision 21906) @@ -0,0 +1,109 @@ + +mkfringe file name examples + +CONFIG = 01Ak01.fringe.I.0 +CONF-CCD = 01Ak01.fringe.I.00.0 +RAWPATH = /data/koa/cfh12k/01Ak04 +TMPPATH = /data/elixir2/cfh12k/detrend/01Ak04/proc +TMPDET-CCD = /data/elixir2/cfh12k/detrend/01Ak04/proc/543210o/543210o00.fits +TMPDEF-CCD = /data/elixir2/cfh12k/detrend/01Ak04/proc/543210o.def/543210o00.fits + +ROOT = 543210o +MODE = SPLIT / MEF +status = 2 = new image, detrend it please, 1 = use to create master, 0 = don't use + +CONFIG.mef, CONFIG.split [Nimage] + RAWPATH ROOT MODE + /data/koa/cfh12k/01Ak04 581688o SPLIT + /data/koa/cfh12k/01Ak04 581689o MEF + +CONFIG.master [Nimage] + RAWPATH ROOT MODE status + /data/koa/cfh12k/01Ak04 581688o SPLIT 1 + /data/koa/cfh12k/01Ak04 581689o MEF 1 + +CONFIG.detrend [Nimage] + RAWPATH ROOT MODE + /data/koa/cfh12k/01Ak04 581688o SPLIT + /data/koa/cfh12k/01Ak04 581689o MEF + +CONFIG.defringe [Nimage] + TMPPATH/ROOT CONFIG + proc/581688o 01Ak01.fringe.I.0 + +TMPPATH/ROOT.detlist [Nccd] + TMPDET-CCD + proc/581688o/581688o00.fits + +TMPPATH/ROOT.deflist [Nccd] + TMPDEF-CCD + proc/581688o.def/581688o00.fits + +CONF-CCD.ccdstats [Nimage] + TMPDET-CCD (sky) (fringe) 0.0 0.0 + proc/581688o/581688o00.fits (sky) (fringe) 0.0 0.0 + +CONFIG.statlist: + CONF-CCD.ccdstats + fringe/01Ak01.fringe.I.00.0.ccdstats + +CONFIG.frlist [Nccd] + CONF-CCD.fr.fits + fringe/01Ak01.fringe.I.00.0.fr.fits + +CONFIG.smlist [Nccd] + CONF-CCD.sm.fits + fringe/01Ak01.fringe.I.00.0.sm.fits + +CONFIG.medbin: + HTML/CONFIG.medbin.NNN.jpg + +CONFIG.tenbin: + HTML/CONFIG.tenbin.NNN.jpg + +CONFIG.stats + (stats per mosaic) + +###### init: (takes CONFIG as input list) (mode.fringe1) +fr.select I 2001/1/20 2001/2/5 split fringe/01Ak01.fringe.I.0.split +fr.select I 2001/1/20 2001/2/5 mef fringe/01Ak01.fringe.I.0.mef + +fr.mklists -initial fringe/01Ak01.fringe.I.0.split fringe/01Ak01.fringe.I.0.mef fringe/01Ak01.fringe.I.0.master + +fr.mklists -imlist fringe/01Ak01.fringe.I.CCDNUM.0.ccdstats fringe/01Ak01.fringe.I.0.statlist +fr.mklists -imlist fringe/01Ak01.fringe.I.CCDNUM.0.fr.fits fringe/01Ak01.fringe.I.0.frlist +fr.mklists -imlist fringe/01Ak01.fringe.I.CCDNUM.0.sm.fits fringe/01Ak01.fringe.I.0.smlist + +fr.mklists -mosaic fringe/01Ak01.fringe.I.0.master proc det (produces proc/ROOT.det/*NN.fits & proc/ROOT.detlist) +fr.mklists -mosaic fringe/01Ak01.fringe.I.0.master proc def (produces proc/ROOT.def/*NN.fits & proc/ROOT.deflist) +fr.mklists -mosaic fringe/01Ak01.fringe.I.0.master proc med (produces proc/ROOT.med/*NN.fits & proc/ROOT.medlist) + +fr.mklists -detrend fringe/01Ak01.fringe.I.0.master fringe/01Ak01.fringe.I.0.detrend +fr.mklists -defringe fringe/01Ak01.fringe.I.0.master fringe/01Ak01.fringe.I.0 proc fringe/01Ak01.fringe.I.0.defringe + +##### detrend: (takes CONFIG.detrend as input list) (mode.fringe2) +fr.detrend /data/koa/cfh12k/01Ak04 581688o SPLIT proc/581688o.det +fr.medbin proc/581688o.det 581688o 4 proc/581688o.med +fr.gtstats proc/581688o.med 581688o 4 proc/581688o.imstats + +##### mkstats (takes CONF-CCD as input list) (mode.fringe4) +fr.mklists -inlist fringe/01Ak01.fringe.I.0.master 00 proc fringe/01Ak01.fringe.I.00.0.inlist +fr.mklists -imstats fringe/01Ak01.fringe.I.0.master 00 proc fringe/01Ak01.fringe.I.0.imstats + +fr.mkstats fringe/01Ak01.fringe.I.00.0.inlist fringe/01Ak01.fringe.I.0.imstats 00 fringe/01Ak01.fringe.I.00.0.ccdstats fringe/01Ak01.fringe.I.0.frstats +fr.mkrough fringe/01Ak01.fringe.I.00.0.ccdstats fringe/01Ak01.fringe.I.00.0.fr.fits comment + +[ fr.smooth fringe/01Ak01.fringe.I.00.0.fr.fits fringe/01Ak01.fringe.I.00.0.sm.fits ] + +##### defringe (takes CONFIG.defringe as input) (mode.fringe3) +fr.defringe proc/581688o.medlist proc/581688o.imstats fringe/01Ak01.fringe.I.00.0.frlist fringe/01Ak01.fringe.I.00.0.frstats proc/581688o.deflist +fr.stats proc/581688o.deflist proc/581688o.tenbin proc/581688o.medbin proc/581688o.stats + +# merge (not parallel) + +status: 2 = new image, detrend it please, 1 = use to create master, 0 = don't use + +fr.mklists -master fringe/01Ak01.fringe.I.0.master fringe/01Ak01.fringe.I.0.detrend + +[merge ccdstats > statlist] + Index: /tags/ohana/perl-1-3/Ohana/src/perl/doc/mkfringe.txt =================================================================== --- /tags/ohana/perl-1-3/Ohana/src/perl/doc/mkfringe.txt (revision 21906) +++ /tags/ohana/perl-1-3/Ohana/src/perl/doc/mkfringe.txt (revision 21906) @@ -0,0 +1,59 @@ + +mkfringe states & programs [fringe only] + +running.init : mode.fringe1 (config.mosaic) + + - fr.select + - fr.mklists -initial + - fr.mklists -imlist + - fr.mklists -mosaic + - fr.mklists -detrend + - fr.mklists -maplist + - fr.mklists -mlist + +running.detrend : mode.fringe2 (image) + + - fr.ckfile + - fr.detrend + - fr.medbin.spline + - fr.getfringe + - fr.imdata + - fr.jpegs + - fr.mklists -master + +running.merge : mkfringe (config.mosaic) + + - fr.mklists -subset + - fr.frstats -fitpars + - fr.frstats -plotstats + - fr.frstats -frstats + - fr.frstats -dfstats + - fr.mklists -imstats + - fr.jpegs + - fr.mkhtml -imstats + - fr.mkhtml -jpglist + +running.mkrough : mkfringe / mode.fringe4 + + - fr.mklists -subset + - fr.frstats -fitpars + - fr.frstats -frstats + - fr.frstats -dfstats + - fr.mklists -imstats + - fr.mklists -ccdstast + - fr.mkrough + +running.defringe : mode.fringe3 + + - fr.defringe + - fr.getfringe + - fr.jpegs + +running.smooth : mode.fringe4 + + - fr.smooth + +running.reg : mkfringe + + - detregister + Index: /tags/ohana/perl-1-3/Ohana/src/perl/loneos/archive =================================================================== --- /tags/ohana/perl-1-3/Ohana/src/perl/loneos/archive (revision 21906) +++ /tags/ohana/perl-1-3/Ohana/src/perl/loneos/archive (revision 21906) @@ -0,0 +1,353 @@ +#!/usr/bin/perl + +$dumpspace = "/pallas/d1/"; +$workspace = "/metis/d27/workspace/"; +# $workspace = "/irene/d11/workspace/"; + +$scriptdir = "/hebe/d27/logs/"; +$donelogfile = $scriptdir . "done.log"; +$scriptfile = $scriptdir . "maestro.dat"; +$flatdir = "/hebe/d27/references/config/"; + +$database = "/hebe/d27/database/"; +$lockfile = $database . "lock"; +$alockfile = $database . "alock"; +$clockfile = $database . "clock"; +$killfile = $database . "kill"; +$haltfile = $database . "halt"; +$reffile = $database . "start.clean"; + +sub vsystem { + print STDERR "@_\n"; + $status = system ("@_"); + $status; +} + +sub goodbye { + print STDERR "ending execution\n"; + vsystem ("date"); + vsystem ("notify.pl $ARGV[0] none 0"); + die "@_"; +} + +if (@ARGV < 1) {die "USAGE: archive.pl Noutfile\n"; } +$Noutfile = $ARGV[0] + 1; +$outfile = "archive" . $Noutfile . ".log"; + +print STDERR "starting execution\n"; +vsystem ("date"); +if (-e $killfile) { goodbye "process killed with $killfile"; } + + +if (-e $alockfile) { goodbye "archive lock $alockfile is set"; } +open (TEMP, ">$alockfile"); +close (TEMP); + +# load in done date list +open (DONELOG, $donelogfile); +@donelist = (); +while ($line = ) { + chop ($line); + @donelist = (@donelist,$line); +} +$Ndone = @donelist; +close (DONELOG); + +# load in maestro list +open (MAESTRO, $scriptfile); +@todolist = (); +while ($line = ) { + chop ($line); + @todolist = (@todolist,$line); +} +$Ntodo = @todolist; +close (MAESTRO); + +# find entries in MAESTRO that are NOT in DONELOG +@leftlist = (); +for ($i = 0; $i < $Ntodo; $i ++) { + $gotit = 0; + for ($j = 0; ($j < $Ndone) && ! $gotit; $j ++) { + @entries = split (" ",$todolist[$i]); + if ($entries[0] eq $donelist[$j]) { + $gotit = 1; + } + } + if (!$gotit) { + @leftlist = (@leftlist, $todolist[$i]); + } +} +$Nleft = @leftlist; + +if (-e $killfile) { goodbye "process killed with $killfile"; } +# run controller on unfinished entries +# we are going to run this in the script directory +if ($Nleft) { + chdir $scriptdir; + for ($i = 0; $i < $Nleft; $i++) { + print STDERR "unfinished: $leftlist[$i]\n"; + @entries = split (" ",$leftlist[$i]); + $inlist = $entries[0] . ".inlist"; + $outlist = $entries[0] . ".outlist"; + $subdir = $entries[0]; + $photcode = $entries[1]; + print STDERR "$subdir: $inlist $outlist $photcode\n"; + if (-e $outlist) { + # partially successful run, restart controller in the middle + $tmp_inlist = $entries[0] . ".tmp_inlist"; + $tmpoutlist = $entries[0] . ".tmpoutlist"; + if (-e $tmpoutlist) { if (vsystem ("cat $tmpoutlist >> $outlist")) { goodbye "trouble merging $tmpoutlist and $outlist\n"; }} + # partially successful re-start: make sure $outlist is complete + if (parse_outlist ($outlist,$tmp_inlist,1)) { + docontroller ($subdir, $tmp_inlist, $tmpoutlist, $photcode, "-s flatten", 0); + vsystem ("cat $tmpoutlist >> $outlist"); + } + if (parse_outlist ($outlist,$tmp_inlist,2)) { + docontroller ($subdir, $tmp_inlist, $tmpoutlist, $photcode, "-s dophot", 0); + vsystem ("cat $tmpoutlist >> $outlist"); + } + if (parse_outlist ($outlist,$tmp_inlist,3)) { + docontroller ($subdir, $tmp_inlist, $tmpoutlist, $photcode, "-s fstat", 0); + vsystem ("cat $tmpoutlist >> $outlist"); + } + if (parse_outlist ($outlist,$tmp_inlist,4)) { + docontroller ($subdir, $tmp_inlist, $tmpoutlist, $photcode, "-s gastro", 0); + vsystem ("cat $tmpoutlist >> $outlist"); + } + if (parse_outlist ($outlist,$tmp_inlist,5)) { + docontroller ($subdir, $tmp_inlist, $tmpoutlist, $photcode, "-s addstar", 0); + vsystem ("cat $tmpoutlist >> $outlist"); + } + # do inlist entries not in outlist + if (parse_inlist ($inlist,$outlist,$tmp_inlist)) { + docontroller ($subdir, $tmp_inlist, $tmpoutlist, $photcode, "-s flatten", 0); + vsystem ("cat $tmpoutlist >> $outlist"); + } + unless (unlink ($tmpoutlist)) { goodbye "can't unlink $tmpoutlist, why not?"; } + unless (unlink ($tmp_inlist)) { goodbye "can't unlink $tmp_inlist, why not?"; } + vsystem ("cleaning.pl"); + if (-e $lockfile) { goodbye "lock file exists"; } + + print STDERR "done: $entries[0]\n"; + open (DONELOG, ">>$donelogfile"); + print DONELOG "$entries[0]\n"; + close (DONELOG); + } else { + $controlflags = ""; + docontroller ($subdir, $inlist, $outlist, $photcode, "-s flatten", 1); + print STDERR "done: $subdir\n"; + open (DONELOG, ">>$donelogfile"); + print DONELOG "$subdir\n"; + close (DONELOG); + } + } + unless (unlink ($alockfile)) { goodbye "can't unlink $alockfile, why not?"; } + print STDERR "remember to delete images from complete directories\n"; + + unless (-e $haltfile) { + print STDERR "re-did unfinished images\n"; + print STDERR "starting a new archive.pl with output to $outfile\n"; + vsystem ("notify.pl $ARGV[0] $outfile $Noutfile"); + vsystem ("archive.pl $Noutfile 1>$outfile 2>&1 &"); + exit; + } + goodbye "re-did unfinished images"; +} + +print STDERR "no unfinished nights, slurping a new set\n"; +if (-e $scriptfile) { if (vsystem ("rm $scriptfile")) { goodbye "couldn't delete old MAESTRO file"; }} + +if (vsystem ("rsh -n pallas slurp.pl")) { goodbye "couldn't start slurp on pallas"; } +if (-e $killfile) { goodbye "process killed with $killfile"; } +if (!-e $scriptfile) {goodbye "slurp failed to download files"; } + +print STDERR "done slurping, starting controller runs\n"; +vsystem ("date"); + +# run controller on the resulting images +# controller wants to be run in the same directory as the inlists +chdir $scriptdir; +open (MAESTRO, $scriptfile); +while ($line = ) { + @entries = split (" ",$line); + $inlist = $entries[0] . ".inlist"; + $outlist = $entries[0] . ".outlist"; + $subdir = $entries[0]; + $photcode = $entries[1]; + docontroller ($subdir, $inlist, $outlist, $photcode, "-s flatten", 1); + print STDERR "done: $subdir\n"; + open (DONELOG, ">>$donelogfile"); + print DONELOG "$entries[0]\n"; + close (DONELOG); +} +close (MAESTRO); + +unless (unlink ($alockfile)) { goodbye "can't unlink $alockfile, why not?"; } +print STDERR "ending execution\n"; +vsystem ("date"); +print STDERR "finished new images"; + +unless (-e $haltfile) { + print STDERR "starting a new archive.pl with output to $outfile\n"; + vsystem ("notify.pl $ARGV[0] $outfile $Noutfile"); + vsystem ("archive.pl $Noutfile 1>$outfile 2>&1 &"); +} else { + vsystem ("notify.pl $ARGV[0] none 0"); +} +exit; + +# run nrphot on the altered cpt files and quit +chdir $database; +@files = `find . -name "*.cpt" -newer $reffile`; +$Nfiles = @files; +print STDERR "N: $Nfiles\n"; +foreach $f (@files) { + chop ($f); + vsystem ("nrphot -v $f"); + if (-e $lockfile) { goodbye "lock file exists"; } +} + +# delete inlist files + +# do controller (& cleaning if needed), taking care of flats and error conditions +sub docontroller { + if (-e $killfile) { goodbye "process killed with $killfile"; } + if (-e $clockfile) { goodbye "lock file $clockfile exists"; } + # break up entry line + $outsubdir = $_[0]; + $in = $_[1]; + $out = $_[2]; + $phot = $_[3]; + $flags = $_[4]; + $clean = $_[5]; + # create sub-directory in output dir + $outdir = $workspace . $outsubdir; + unless (-e $outdir) { unless (mkdir ($outdir,0777)) { goodbye "cannot create output directory $outdir"; } } + # make link to correct flat + $flatlink = $flatdir . "newflat.fits"; + $realflat = $flatdir . "flatcode" . $phot . ".fits"; + if (-l $flatlink) { unless (unlink ($flatlink)) { goodbye "cannot unlink $flatlink"; }} + if (-e $flatlink) { goodbye "$flatlink exists, but is not a link!"; } + unless (symlink ($realflat, $flatlink)) { goodbye "cannot symlink $realflat to $flatlink"; } + # run controller and cleanup + if (-e $lockfile) { goodbye "lock file exists"; } + vsystem ("controller $flags -o $outsubdir $in $out $phot"); + if (-e $clockfile) { goodbye "lock file $clockfile exists"; } + if (-e $lockfile) { goodbye "lock file exists"; } + if (-e $killfile) { goodbye "process killed with $killfile"; } + if ($clean) { + vsystem ("cleaning.pl"); + if (-e $lockfile) { goodbye "lock file exists"; } + } +} + +sub by_filename { + @value1 = split (" ", $a); + @value2 = split (" ", $b); + $value1[0] cmp $value2[0]; +} + +# we read from in and write to out those files with 1st 0 in the mode column +sub parse_outlist { + $in = $_[0]; + $out = $_[1]; + $mode = $_[2]; + +# load inlist + open (INLIST, $in); + @inarray = (); + while ($line = ) { + chop ($line); + @inarray = (@inarray,$line); + } + $Nin = @inarray; + close (INLIST); + @inarray = sort by_filename @inarray; + + @outarray = (); + for ($k = 0; $k < $Nin; $k++) { + @pvalues = split (" ", $inarray[$k]); + $more = 1; + while ($more) { + print STDERR "."; + @nvalues = split (" ", $inarray[$k+1]); + if ($nvalues[0] cmp $pvalues[0]) { + $more = 0; + } else { + $pvalues[1] |= $nvalues[1]; + $pvalues[2] |= $nvalues[2]; + $pvalues[3] |= $nvalues[3]; + $pvalues[4] |= $nvalues[4]; + $pvalues[5] |= $nvalues[5]; + $k ++; + } + } + # check the earlier status values: if failed earlier, skip + $skip = 0; + for ($m = 1; $m < $mode; $m++) { if (!$pvalues[$m]) { $skip = 1; } } + if (! $skip && !$pvalues[$mode]) { + $name = $pvalues[0]; + $name =~ s/$dumpspace//; + $name =~ s/://; + @outarray = (@outarray,$name); + } + } + $Nout = @outarray; + if ($Nout) { + open (OUTLIST, ">$out"); + for ($k = 0; $k < $Nout; $k++) { + print OUTLIST "$outarray[$k]\n"; + } + close (OUTLIST); + } + $Nout; +} + +sub parse_inlist { + $in = $_[0]; + $out = $_[1]; + $new = $_[2]; + +# load inlist + open (INLIST, $in); + @inarray = (); + while ($line = ) { + chop ($line); + @inarray = (@inarray,$line); + } + $Nin = @inarray; + close (INLIST); + +# load inlist + open (OUTLIST, $out); + @outarray = (); + while ($line = ) { + chop ($line); + @outarray = (@outarray,$line); + } + $Nout = @outarray; + close (OUTLIST); + +# load outlist + @newarray = (); + for ($k = 0; $k < $Nin; $k++) { + $gotit = 0; + for ($m = 0; ! $gotit && ($m < $Nout); $m++) { + if ($outarray[$m] =~ /$inarray[$k]/) { + $gotit = 1; + } + } + if (!$gotit) { + @newarray = (@newarray,$inarray[$k]); + } + } + $Nnew = @newarray; + if ($Nnew) { + open (NEWLIST, ">$new"); + for ($k = 0; $k < $Nnew; $k++) { + print NEWLIST "$inarray[$k]\n"; + } + close (NEWLIST); + } + $Nnew; +} Index: /tags/ohana/perl-1-3/Ohana/src/perl/loneos/checkoutfail.pl =================================================================== --- /tags/ohana/perl-1-3/Ohana/src/perl/loneos/checkoutfail.pl (revision 21906) +++ /tags/ohana/perl-1-3/Ohana/src/perl/loneos/checkoutfail.pl (revision 21906) @@ -0,0 +1,63 @@ +#!/usr/bin/perl + +sub by_filename { + @value1 = split (" ", $a); + @value2 = split (" ", $b); + $value1[0] cmp $value2[0]; +} + +# we read from in and write to out those files with 1st 0 in the mode column +sub parse_outlist { + $in = $_[0]; + $mode = $_[1]; + +# load inlist + open (INLIST, $in); + @inarray = (); + while ($line = ) { + chop ($line); + @inarray = (@inarray,$line); + } + $Nin = @inarray; + close (INLIST); + @inarray = sort by_filename @inarray; + + @outarray = (); + for ($k = 0; $k < $Nin; $k++) { + @pvalues = split (" ", $inarray[$k]); + $more = 1; + while ($more) { + @nvalues = split (" ", $inarray[$k+1]); + if ($nvalues[0] cmp $pvalues[0]) { + $more = 0; + } else { + $pvalues[1] |= $nvalues[1]; + $pvalues[2] |= $nvalues[2]; + $pvalues[3] |= $nvalues[3]; + $pvalues[4] |= $nvalues[4]; + $pvalues[5] |= $nvalues[5]; + $k ++; + } + } + # check the earlier status values: if failed earlier, skip + $skip = 0; + for ($m = 1; $m < $mode; $m++) { if (!$pvalues[$m]) { $skip = 1; } } + if (! $skip && !$pvalues[$mode]) { + $name = $pvalues[0]; + $name =~ s/$topdir//; + $name =~ s/://; + @outarray = (@outarray,$name); + } + } + $Nout = @outarray; + if ($Nout) { + for ($k = 0; $k < $Nout; $k++) { + print STDERR "$mode: $outarray[$k]\n"; + } + } + $Nout; +} + +$outlist = $ARGV[0]; + +parse_outlist ($outlist,5); Index: /tags/ohana/perl-1-3/Ohana/src/perl/loneos/checkoutlist.pl =================================================================== --- /tags/ohana/perl-1-3/Ohana/src/perl/loneos/checkoutlist.pl (revision 21906) +++ /tags/ohana/perl-1-3/Ohana/src/perl/loneos/checkoutlist.pl (revision 21906) @@ -0,0 +1,65 @@ +#!/usr/bin/perl + +sub by_filename { + @value1 = split (" ", $a); + @value2 = split (" ", $b); + $value1[0] cmp $value2[0]; +} + +# we read from in and write to out those files with 1st 0 in the mode column +sub parse_outlist { + $in = $_[0]; + $mode = $_[1]; + +# load inlist + open (INLIST, $in); + @inarray = (); + while ($line = ) { + chop ($line); + @inarray = (@inarray,$line); + } + $Nin = @inarray; + close (INLIST); + @inarray = sort by_filename @inarray; + + @outarray = (); + for ($k = 0; $k < $Nin; $k++) { + @pvalues = split (" ", $inarray[$k]); + $more = 1; + while ($more) { + @nvalues = split (" ", $inarray[$k+1]); + if ($nvalues[0] cmp $pvalues[0]) { + $more = 0; + } else { + $pvalues[1] |= $nvalues[1]; + $pvalues[2] |= $nvalues[2]; + $pvalues[3] |= $nvalues[3]; + $pvalues[4] |= $nvalues[4]; + $pvalues[5] |= $nvalues[5]; + $k ++; + } + } + # check the earlier status values: if failed earlier, skip + $skip = 0; + for ($m = 1; $m < $mode; $m++) { if (!$pvalues[$m]) { $skip = 1; } } + if (! $skip && !$pvalues[$mode]) { + $name = $pvalues[0]; + $name =~ s/$topdir//; + $name =~ s/://; + @outarray = (@outarray,$name); + } + } + $Nout = @outarray; + if ($Nout) { + for ($k = 0; $k < $Nout; $k++) { + print STDOUT "$mode: $outarray[$k]\n"; + } + } + $Nout; +} + +$outlist = $ARGV[0]; + +for ($i = 1; $i < 6; $i++) { + parse_outlist ($outlist,$i); +} Index: /tags/ohana/perl-1-3/Ohana/src/perl/loneos/cleaning.pl =================================================================== --- /tags/ohana/perl-1-3/Ohana/src/perl/loneos/cleaning.pl (revision 21906) +++ /tags/ohana/perl-1-3/Ohana/src/perl/loneos/cleaning.pl (revision 21906) @@ -0,0 +1,30 @@ +#!/usr/bin/perl + +sub vsystem { + print STDERR "@_\n"; + $status = system ("@_"); + $status; +} + +$database = "/hebe/d27/database/"; +$lockfile = $database . "lock"; +$reffile = $database . "start.clean"; + +chdir $database; + +@files = `find . -name "*.cpt" -newer $reffile`; +$Nfiles = @files; +print STDERR "N: $Nfiles\n"; + +if (-e $lockfile) { die "lock file exists"; } + +foreach $f (@files) { + chop ($f); + vsystem ("markstar -v $f"); + if (-e $lockfile) { die "lock file exists"; } + vsystem ("addusno -v $f"); + if (-e $lockfile) { die "lock file exists"; } + vsystem ("markrock -v $f"); + if (-e $lockfile) { die "lock file exists"; } +} + Index: /tags/ohana/perl-1-3/Ohana/src/perl/loneos/locks.pl =================================================================== --- /tags/ohana/perl-1-3/Ohana/src/perl/loneos/locks.pl (revision 21906) +++ /tags/ohana/perl-1-3/Ohana/src/perl/loneos/locks.pl (revision 21906) @@ -0,0 +1,93 @@ +#!/usr/bin/perl + +$topdir = "/pallas/"; +$scriptdir = "/hebe/d27/logs/"; +$donelogfile = $scriptdir . "done.log"; +$scriptfile = $scriptdir . "maestro.dat"; +$flatdir = "/hebe/d27/references/config/"; + +$workspace = "/hebe/d27/workspace/"; +$database = "/hebe/d27/database/"; +$lockfile = $database . "lock"; +$alockfile = $database . "alock"; +$clockfile = $database . "clock"; +$killfile = $database . "kill"; +$haltfile = $database . "halt"; +$reffile = $database . "start.clean"; + +sub vsystem { + print STDERR "@_\n"; + $status = system ("@_"); + $status; +} + +sub goodbye { + print STDERR "ending execution\n"; + vsystem ("date"); + die "@_"; +} + +$Narg = @ARGV; +if ($Narg > 1) { + goodbye "USAGE: locks.pl [-reset] [-halt] [-kill] [-dB] [-controller] [-archive]"; +} + +unless ($ARGV[0] cmp "-reset") { + unlink ($lockfile); + unlink ($alockfile); + unlink ($clockfile); + unlink ($killfile); + unlink ($haltfile); + exit; +} + +unless ($ARGV[0] cmp "-kill") { + open (TEMP, ">$killfile"); + close (TEMP); + exit; +} + +unless ($ARGV[0] cmp "-halt") { + open (TEMP, ">$haltfile"); + close (TEMP); + exit; +} + +unless ($ARGV[0] cmp "-dB") { + open (TEMP, ">$lockfile"); + close (TEMP); + exit; +} + +unless ($ARGV[0] cmp "-controller") { + open (TEMP, ">$clockfile"); + close (TEMP); + exit; +} + +unless ($ARGV[0] cmp "-archive") { + open (TEMP, ">$alockfile"); + close (TEMP); + exit; +} + +@locks = (); +if (-e $lockfile) { @locks = (@locks,$lockfile); } +if (-e $alockfile) { @locks = (@locks,$alockfile); } +if (-e $clockfile) { @locks = (@locks,$clockfile); } +if (-e $killfile) { @locks = (@locks,$killfile); } +if (-e $haltfile) { @locks = (@locks,$haltfile); } + +$Nlocks = @locks; + +if ($Nlocks > 0) { + print STDERR "locks set:\n"; + for ($i = 0; $i < $Nlocks; $i++) { + print STDERR "$locks[$i]\n"; + } +} else { + print STDERR "no locks currently set\n"; +} + +print STDERR "\n"; +print STDERR "USAGE: locks.pl [-reset] [-kill] [-dB] [-controller] [-archive]\n"; Index: /tags/ohana/perl-1-3/Ohana/src/perl/loneos/notify.pl =================================================================== --- /tags/ohana/perl-1-3/Ohana/src/perl/loneos/notify.pl (revision 21906) +++ /tags/ohana/perl-1-3/Ohana/src/perl/loneos/notify.pl (revision 21906) @@ -0,0 +1,12 @@ +#!/usr/bin/perl + +$target= "gene\@astro.washington.edu"; +$targetmachine = "astro.washington.edu"; + +$last = "archive." . $ARGV[0]; +$next = $ARGV[1]; +$N = $ARGV[2]; + +# system ("echo \"done with $last, starting $next ($N)\" | mail $targetname\@$targetmachine"); +system ("echo \"done with $last, starting $next ($N)\" | mail $target"); + Index: /tags/ohana/perl-1-3/Ohana/src/perl/loneos/rearchive.pl =================================================================== --- /tags/ohana/perl-1-3/Ohana/src/perl/loneos/rearchive.pl (revision 21906) +++ /tags/ohana/perl-1-3/Ohana/src/perl/loneos/rearchive.pl (revision 21906) @@ -0,0 +1,71 @@ +#!/usr/bin/perl + +# $dumpspace = "/pallas/d1/"; +# $workspace = "/metis/d27/workspace/"; +# $workspace = "/irene/d11/workspace/"; + +$database = "/hebe/d27/database/"; +$lockfile = $database . "lock"; +$alockfile = $database . "alock"; +$clockfile = $database . "clock"; +$killfile = $database . "kill"; +$haltfile = $database . "halt"; +$reffile = $database . "start.clean"; + +sub vsystem { + print STDERR "@_\n"; + $status = system ("@_"); + $status; +} + +sub goodbye { + print STDERR "ending execution\n"; + vsystem ("date"); + die "@_"; +} + +if (@ARGV < 1) {die "USAGE: rearchive.pl dir\n"; } + +$target = $ARGV[0]; + +print STDERR "starting execution\n"; +vsystem ("date"); +if (-e $killfile) { goodbye "process killed with $killfile"; } + +if (-e $alockfile) { goodbye "archive lock $alockfile is set"; } +open (TEMP, ">$alockfile"); +close (TEMP); + +# untar directory + +if (!-e $target.tgz) { goodbye "target $target.tgz not found"; } + +if (vsystem ("gunzip -c $target.tgz | tar xvf -")) { goodbye "untar failed for $target.tgz"; } +if (vsystem ("ls $target/*.cmp > $target.lst")) { goodbye "failed to get directory listing for $target"; } + +open (TEMP, ">$target.log"); +close (TEMP); +if (!-e $target.log) { goodbye "could not create $target.log"; } + +# load in done date list +open (LISTFILE, $target.lst); +@listfile = (); +while ($line = ) { + chop ($line); + @listfile = (@listfile,$line); +} +$Nlist = @listfile; +close (LISTFILE); + +for ($i = 0; $i < Nlist; $i++) { + if (-e $lockfile) { goodbye "database lock $lockfile is set"; } + vsystem ("addstar -v $listfile[$i]"); +} + +if (-e $lockfile) { goodbye "lock file exists"; } +vsystem ("cleaning.pl"); +if (-e $lockfile) { goodbye "lock file exists"; } + +# vsystem ("rm $target"); +exit; + Index: /tags/ohana/perl-1-3/Ohana/src/perl/loneos/slurp =================================================================== --- /tags/ohana/perl-1-3/Ohana/src/perl/loneos/slurp (revision 21906) +++ /tags/ohana/perl-1-3/Ohana/src/perl/loneos/slurp (revision 21906) @@ -0,0 +1,223 @@ +#!/usr/bin/env perl + +$Ngrab = 5; +$scriptdir = "/hebe/d27/logs/"; +$dumpspace = "/pallas/d1/"; +$tapedrive = "/dev/rmt/1cn"; +$tapelogfile = $scriptdir . "tape.log"; +$donelogfile = $scriptdir . "processed.log"; +$scriptfile = $scriptdir . "extracted.log"; + +# old directories: +# $topdir = "/pallas/"; +# $rootdir = "/pallas/d1/"; + +sub vsystem { + print STDERR "@_\n"; + $status = system ("@_"); + $status; +} + +sub goodbye { + print STDERR "@_\n"; + vsystem ("unload $tape"); + vsystem ("lunlock $tapedrive"); + vsystem ("lunlock $dumpspace"); + die; +} + +# goodbye ("quit suddenly"); + +# checkdone (line) +# returns 1 if not in line (and sets $name), +# returns 0 otherwise +sub checkdone { + local($inline) = @_; + @entries = split (" ",$inline); + $found = 0; + if ((@entries[0] > 1996) && (@entries[0] < 2097)) { + $found = 1; + $name = substr(@entries[0],2,2) . @entries[1] . @entries[2]; + for ($j = 0; ($j < $Ndone) && ($found); $j++) { + @done = split (" ", $donelist[$j]); + if ($done[0] eq $name) { + $found = 0; + } + } + } + $found; +} + +# checktape (name) +# find all entries which match name and add to dolist +sub checktape { + local($inname) = @_; + $j = 0; + while ($j < $Ntape) { + @entries = split (" ",$tapelist[$j]); + if ((@entries[0] > 1996) && (@entries[0] < 2097)) { + $tmpname = substr(@entries[0],2,2) . @entries[1] . @entries[2]; + if ($inname eq $tmpname) { + @dolist = (@dolist,$tapelist[$j]); + @doname = (@doname,$inname); + } + } + $j ++; + } +} + + +# load in done date list +open (DONELOG, $donelogfile); +@donelist = (); +while ($line = ) { + chop ($line); + @donelist = (@donelist,$line); +} +$Ndone = @donelist; +close (DONELOG); +print "Ndone = $Ndone\n"; + +# load in tape.log list +open (TAPELOG, $tapelogfile); +@tapelist = (); +while ($line = ) { + chop ($line); + @tapelist = (@tapelist,$line); +} +$Ntape = @tapelist; +close (TAPELOG); +# @tapelist = reverse(@tapelist); +print "Ntape = $Ntape\n"; + +# find 5 new nights not already in the "donelist" +$N = 0; +@tryname = (); +for ($i = 0; ($i < $Ntape) && ($N < $Ngrab); $i++) { + if (&checkdone ($tapelist[$i])) { + $j = 0; + $gotit = 0; + for ($j = 0; ($j < $N) && (! $gotit); $j++) { + if ($name eq $tryname[$j]) { + $gotit = 1; + } + } + if (! $gotit) { + @tryname = (@tryname, $name); + $N ++; + } + } +} +$Ntryname = @tryname; +# tryname has a list of the 980103 style names + +# now that we have a list of interesting nights, +# get a list of the actual lines from tape.log, +# along with a list of the matchine names +$i = 0; +@dolist = (); +@doname = (); +while ($i < $Ntryname) { + &checktape ($tryname[$i]); + $i ++; +} + +$i = 0; +$Ndolist = @dolist; +@fileno = (); +@tapeno = (); +@gbytes = (); +@photno = (); +@entry = (); +while ($i < $Ndolist) { + print STDERR "$doname[$i] == $dolist[$i]\n"; + @words = split (" ",$dolist[$i]); + @entry = (@entry,$i); + @tapeno = (@tapeno,$words[3]); + @fileno = (@fileno,$words[4]); + @gbytes = (@gbytes,$words[5]); + @photno = (@photno,$words[8]); + $i ++; +} + +# delete old downloaded data + +$dir = $dumpspace . "9"; +print STDERR "dir: $dir\n"; +@files = <$dir*>; +$Nfiles = @files; +print "files: @files\n"; +for ($i = 0; $i < $Nfiles; $i++) { + if ((-d $files[$i]) && (-O $files[$i])) { + if (vsystem ("rm -r $files[$i]")) { goodbye "error deleting directory $files[$i]"; } + } +} + +# now sort the entries by tape and file number: + +sub by_tape_and_file { ($tapeno[$a] <=> $tapeno[$b]) || ($fileno[$a] <=> $fileno[$b]); } +@entry = sort by_tape_and_file @entry; + +# lock tape and disk space. keep trying for up to 10 hours +for ($i = 0; ($i < 30) && vsystem ("llock $dumpspace"); $i++) { system ("sleep 1200"); } + if ($i == 100) { goodbye "failed to grab disk space"; } +for ($i = 0; ($i < 30) && vsystem ("llock $tapedrive"); $i++) { system ("sleep 1200"); } + if ($i == 100) { goodbye "failed to grab tape drive"; } + +$tape = -1; +for ($i = 0; $i < $Ndolist; $i++) { + # do a df and compare to $gbytes[$entry[$i]] + @answer = `df -k $dumpspace`; + @tmp = split (" ", $answer[1]); + $space = $tmp[3] / (1024*1024); + print STDERR "compare $space and $gbytes[$entry[$i]]\n"; + if (0.95*$space < $gbytes[$entry[$i]]) { last; } + # load tape if needed + if ($tapeno[$entry[$i]] != $tape) { + # unload old tape, load desired tape + if ($tape != -1) { if (vsystem ("unload $tape")) { goodbye "trouble unloading tape $tape"; } } + if (vsystem ("load $tapeno[$entry[$i]]")) { goodbye "trouble loading tape $tapeno[$entry[$i]]"; } + $tape = $tapeno[$entry[$i]]; + $j = 0; + $offline = 1; + # wait for tape to come online before starting anything + while (($j < 12) && $offline) { + vsystem ("sleep 10"); + $offline = vsystem ("mt -f $tapedrive status"); + $j ++; + } + if ($j == 12) { goodbye "tape still not online!"; } + $file = 0; + } + # advance to first file of interest + $nskip = $fileno[$entry[$i]] - $file; + if ($nskip > 0) { + if (vsystem ("mt -f $tapedrive fsf $nskip")) { goodbye "error advancing tape"; } + } + # create output directory if it doesn't exist + $dir = $dumpspace . $doname[$entry[$i]]; + unless (-e $dir) { + unless (mkdir ($dir,0777)) { goodbye "cannot create output directory $dir"; } + } + chdir $dir; + # extract the files + vsystem ("tar -xvfb $tapedrive 128"); + $file = $fileno[$entry[$i]] + 1; +} +$Ndolist = $i; + +if (vsystem("unload $tape")) { goodbye "trouble unloading tape $tape"; } +if (vsystem("lunlock $tapedrive")) { goodbye "trouble unlocking tape drive $tapedrive"; } +if (vsystem ("lunlock $dumpspace")) { goodbye "trouble unlocking disk drive $dumpspace"; } + +open (MAESTRO, ">$scriptfile"); +chdir $dumpspace; +$i = 0; +while ($i < $Ndolist) { + vsystem ("ls $doname[$entry[$i]]/*b.fits > $scriptdir/$doname[$entry[$i]].inlist"); + print MAESTRO "$doname[$entry[$i]] $photno[$entry[$i]] \n"; + $i ++; +} +close (MAESTRO); + +1; Index: /tags/ohana/perl-1-3/Ohana/src/perl/loneos/stage1 =================================================================== --- /tags/ohana/perl-1-3/Ohana/src/perl/loneos/stage1 (revision 21906) +++ /tags/ohana/perl-1-3/Ohana/src/perl/loneos/stage1 (revision 21906) @@ -0,0 +1,342 @@ +#!/usr/bin/env perl + +# in this script, we run flatten, dophot, fstat, and gastro +# these can be run totally in parallel, so this routine runs +# independently of the series processing (addstar, markstar, etc) +# in stage2 + +# for now these directories are hard-wired. eventually, they +# should be looked up in the config file, so all scripts are +# consistent +$dumpspace = "/pallas/d1/"; +$workspace = "/metis/d27/workspace/"; +# $workspace = "/irene/d11/workspace/"; + +$scriptdir = "/hebe/d27/logs/"; +$donelogfile = $scriptdir . "processed.log"; +$scriptfile = $scriptdir . "extracted.log"; +$flatdir = "/hebe/d27/references/config/"; + +$database = "/hebe/d27/database/"; +$alockfile = $database . "alock1"; # lock on stage1 (only 1 running at a time) +$clockfile = $database . "clock1"; # lock on controller +$killfile = $database . "kill"; # quickly stop the processing +$haltfile = $database . "halt"; # halt processing after this loop +$reffile = $database . "start.clean"; + +sub vsystem { + print STDERR "@_\n"; + $status = system ("@_"); + $status; +} + +sub goodbye { + print STDERR "ending execution\n"; + vsystem ("date"); + vsystem ("notify.pl $ARGV[0] none 0"); + die "@_"; +} + +if (@ARGV < 1) {die "USAGE: stage1 Noutfile\n"; } +$Noutfile = $ARGV[0] + 1; +$outfile = "stage1." . $Noutfile . ".log"; + +print STDERR "starting execution\n"; +vsystem ("date"); +if (-e $killfile) { goodbye "process killed with $killfile"; } + + +if (-e $alockfile) { goodbye "archive lock $alockfile is set"; } +open (TEMP, ">$alockfile"); +close (TEMP); + +# load in done date list +open (DONELOG, $donelogfile); +@donelist = (); +while ($line = ) { + chop ($line); + @donelist = (@donelist,$line); +} +$Ndone = @donelist; +close (DONELOG); + +# load in maestro list +open (MAESTRO, $scriptfile); +@todolist = (); +while ($line = ) { + chop ($line); + @todolist = (@todolist,$line); +} +$Ntodo = @todolist; +close (MAESTRO); + +# find entries in MAESTRO that are NOT in DONELOG +@leftlist = (); +for ($i = 0; $i < $Ntodo; $i ++) { + $gotit = 0; + for ($j = 0; ($j < $Ndone) && ! $gotit; $j ++) { + @todo = split (" ",$todolist[$i]); + @done = split (" ",$donelist[$j]); + if ($todo[0] eq $done[0]) { + $gotit = 1; + } + } + if (!$gotit) { + @leftlist = (@leftlist, $todolist[$i]); + } +} +$Nleft = @leftlist; + +if (-e $killfile) { goodbye "process killed with $killfile"; } +# run controller on unfinished entries +# we are going to run this in the script directory +if ($Nleft) { + chdir $scriptdir; + for ($i = 0; $i < $Nleft; $i++) { + print STDERR "unfinished: $leftlist[$i]\n"; + @entries = split (" ",$leftlist[$i]); + $inlist = $entries[0] . ".inlist"; + $outlist = $entries[0] . ".addlist"; + $subdir = $entries[0]; + $photcode = $entries[1]; + print STDERR "$subdir: $inlist $outlist $photcode\n"; + if (-e $outlist) { + # partially successful run, restart controller in the middle + $tmp_inlist = $entries[0] . ".tmp_inlist"; + $tmpoutlist = $entries[0] . ".tmpaddlist"; + if (-e $tmpoutlist) { if (vsystem ("cat $tmpoutlist >> $outlist")) { goodbye "trouble merging $tmpoutlist and $outlist\n"; }} + # partially successful re-start: make sure $outlist is complete + if (parse_outlist ($outlist,$tmp_inlist,1)) { + docontroller ($subdir, $tmp_inlist, $tmpoutlist, $photcode, "-s flatten", 0); + vsystem ("cat $tmpoutlist >> $outlist"); + } + if (parse_outlist ($outlist,$tmp_inlist,2)) { + docontroller ($subdir, $tmp_inlist, $tmpoutlist, $photcode, "-s dophot", 0); + vsystem ("cat $tmpoutlist >> $outlist"); + } + if (parse_outlist ($outlist,$tmp_inlist,3)) { + docontroller ($subdir, $tmp_inlist, $tmpoutlist, $photcode, "-s fstat", 0); + vsystem ("cat $tmpoutlist >> $outlist"); + } + if (parse_outlist ($outlist,$tmp_inlist,4)) { + docontroller ($subdir, $tmp_inlist, $tmpoutlist, $photcode, "-s gastro", 0); + vsystem ("cat $tmpoutlist >> $outlist"); + } + # do inlist entries not in outlist + if (parse_inlist ($inlist,$outlist,$tmp_inlist)) { + docontroller ($subdir, $tmp_inlist, $tmpoutlist, $photcode, "-s flatten", 0); + vsystem ("cat $tmpoutlist >> $outlist"); + } + unless (unlink ($tmpoutlist)) { goodbye "can't unlink $tmpoutlist, why not?"; } + unless (unlink ($tmp_inlist)) { goodbye "can't unlink $tmp_inlist, why not?"; } + # done with this night, add to donelogfile + print STDERR "done: $subdir $photcode\n"; + open (DONELOG, ">>$donelogfile"); + print DONELOG "$subdir $photcode\n"; + close (DONELOG); + } else { + docontroller ($subdir, $inlist, $outlist, $photcode, "-s flatten", 1); + print STDERR "done: $subdir $photcode\n"; + open (DONELOG, ">>$donelogfile"); + print DONELOG "$subdir $photcode\n"; + close (DONELOG); + } + } + unless (unlink ($alockfile)) { goodbye "can't unlink $alockfile, why not?"; } + print STDERR "remember to delete images from complete directories\n"; + + unless (-e $haltfile) { + print STDERR "re-did unfinished images\n"; + print STDERR "starting a new stage1 with output to $outfile\n"; + vsystem ("notify.pl $ARGV[0] $outfile $Noutfile"); + vsystem ("stage1 $Noutfile 1>$outfile 2>&1 &"); + exit; + } + goodbye "re-did unfinished images"; +} + +# get a new set of data +print STDERR "no unfinished nights, slurping a new set\n"; +if (-e $scriptfile) { if (vsystem ("rm $scriptfile")) { goodbye "couldn't delete old MAESTRO file"; }} + +if (vsystem ("rsh -n pallas slurp")) { goodbye "couldn't start slurp on pallas"; } +if (-e $killfile) { goodbye "process killed with $killfile"; } +if (!-e $scriptfile) {goodbye "slurp failed to download files"; } + +print STDERR "done slurping, starting controller runs\n"; +vsystem ("date"); + +# run controller on the resulting images +# controller wants to be run in the same directory as the inlists +$Nruns = 0; +chdir $scriptdir; +open (MAESTRO, $scriptfile); +while ($line = ) { + @entries = split (" ",$line); + $inlist = $entries[0] . ".inlist"; + $outlist = $entries[0] . ".addlist"; + $subdir = $entries[0]; + $photcode = $entries[1]; + docontroller ($subdir, $inlist, $outlist, $photcode, "-s flatten", 1); + print STDERR "done: $subdir $photcode\n"; + open (DONELOG, ">>$donelogfile"); + print DONELOG "$subdir $photcode\n"; + close (DONELOG); + $Nruns ++; +} +close (MAESTRO); + +if (Nruns == 0) { + print STDERR "no data downloaded in slurp, waiting for a while\n"; + vsystem ("sleep 3600"); +} +unless (unlink ($alockfile)) { goodbye "can't unlink $alockfile, why not?"; } +print STDERR "ending execution\n"; +vsystem ("date"); +print STDERR "finished new images"; + +unless (-e $haltfile) { + print STDERR "starting a new stage1 with output to $outfile\n"; + vsystem ("notify.pl $ARGV[0] $outfile $Noutfile"); + vsystem ("stage1 $Noutfile 1>$outfile 2>&1 &"); +} else { + vsystem ("notify.pl $ARGV[0] none 0"); +} +exit; + +# do controller (& cleaning if needed), taking care of flats and error conditions +sub docontroller { + if (-e $killfile) { goodbye "process killed with $killfile"; } + if (-e $clockfile) { goodbye "lock file $clockfile exists"; } + # break up entry line + $outsubdir = $_[0]; + $in = $_[1]; + $out = $_[2]; + $phot = $_[3]; + $flags = $_[4]; + $clean = $_[5]; + # create sub-directory in output dir + $outdir = $workspace . $outsubdir; + unless (-e $outdir) { unless (mkdir ($outdir,0777)) { goodbye "cannot create output directory $outdir"; } } + # make link to correct flat + $flatlink = $flatdir . "newflat.fits"; + $realflat = $flatdir . "flatcode" . $phot . ".fits"; + if (-l $flatlink) { unless (unlink ($flatlink)) { goodbye "cannot unlink $flatlink"; }} + if (-e $flatlink) { goodbye "$flatlink exists, but is not a link!"; } + unless (symlink ($realflat, $flatlink)) { goodbye "cannot symlink $realflat to $flatlink"; } + # run controller and cleanup + vsystem ("control1 $flags -o $outsubdir $in $out $phot"); + if (-e $clockfile) { goodbye "lock file $clockfile exists"; } + if (-e $killfile) { goodbye "process killed with $killfile"; } +} + +sub by_filename { + @value1 = split (" ", $a); + @value2 = split (" ", $b); + $value1[0] cmp $value2[0]; +} + +# we read from in and write to out those files with 1st 0 in the mode column +sub parse_outlist { + $in = $_[0]; + $out = $_[1]; + $mode = $_[2]; + +# load inlist + open (INLIST, $in); + @inarray = (); + while ($line = ) { + chop ($line); + @inarray = (@inarray,$line); + } + $Nin = @inarray; + close (INLIST); + @inarray = sort by_filename @inarray; + + @outarray = (); + for ($k = 0; $k < $Nin; $k++) { + @pvalues = split (" ", $inarray[$k]); + $more = 1; + while ($more) { + print STDERR "."; + @nvalues = split (" ", $inarray[$k+1]); + if ($nvalues[0] cmp $pvalues[0]) { + $more = 0; + } else { + $pvalues[1] |= $nvalues[1]; + $pvalues[2] |= $nvalues[2]; + $pvalues[3] |= $nvalues[3]; + $pvalues[4] |= $nvalues[4]; + $pvalues[5] |= $nvalues[5]; + $k ++; + } + } + # check the earlier status values: if failed earlier, skip + $skip = 0; + for ($m = 1; $m < $mode; $m++) { if (!$pvalues[$m]) { $skip = 1; } } + if (! $skip && !$pvalues[$mode]) { + $name = $pvalues[0]; + $name =~ s/$dumpspace//; + $name =~ s/://; + @outarray = (@outarray,$name); + } + } + $Nout = @outarray; + if ($Nout) { + open (OUTLIST, ">$out"); + for ($k = 0; $k < $Nout; $k++) { + print OUTLIST "$outarray[$k]\n"; + } + close (OUTLIST); + } + $Nout; +} + +sub parse_inlist { + $in = $_[0]; + $out = $_[1]; + $new = $_[2]; + +# load inlist + open (INLIST, $in); + @inarray = (); + while ($line = ) { + chop ($line); + @inarray = (@inarray,$line); + } + $Nin = @inarray; + close (INLIST); + +# load inlist + open (OUTLIST, $out); + @outarray = (); + while ($line = ) { + chop ($line); + @outarray = (@outarray,$line); + } + $Nout = @outarray; + close (OUTLIST); + +# load outlist + @newarray = (); + for ($k = 0; $k < $Nin; $k++) { + $gotit = 0; + for ($m = 0; ! $gotit && ($m < $Nout); $m++) { + if ($outarray[$m] =~ /$inarray[$k]/) { + $gotit = 1; + } + } + if (!$gotit) { + @newarray = (@newarray,$inarray[$k]); + } + } + $Nnew = @newarray; + if ($Nnew) { + open (NEWLIST, ">$new"); + for ($k = 0; $k < $Nnew; $k++) { + print NEWLIST "$newarray[$k]\n"; + } + close (NEWLIST); + } + $Nnew; +} Index: /tags/ohana/perl-1-3/Ohana/src/perl/loneos/stage2 =================================================================== --- /tags/ohana/perl-1-3/Ohana/src/perl/loneos/stage2 (revision 21906) +++ /tags/ohana/perl-1-3/Ohana/src/perl/loneos/stage2 (revision 21906) @@ -0,0 +1,307 @@ +#!/usr/bin/env perl + +# in this script, we run addstar and the cleaning routines +# these must be run in series, so this routine runs +# independently of the parallel processing in stage1 + +# for now these directories are hard-wired. eventually, they +# should be looked up in the config file, so all scripts are +# consistent +$dumpspace = "/pallas/d1/"; +$workspace = "/metis/d27/workspace/"; +# $workspace = "/irene/d11/workspace/"; + +#$scriptdir = "/hebe/d27/logs/"; +$scriptdir = "./"; +$addstarfile = $scriptdir . "addstared.log"; +$processfile = $scriptdir . "processed.log"; +$flatdir = "/hebe/d27/references/config/"; + +$database = "/hebe/d27/database/"; +$lockfile = $database . "lock"; # lock on database files +$alockfile = $database . "alock2"; # lock on stage2 (only 1 running at a time) +$clockfile = $database . "clock2"; # lock on control2 +$killfile = $database . "kill"; # quickly stop the processing +$haltfile = $database . "halt"; # halt processing after this loop +$reffile = $database . "start.clean"; + +sub vsystem { + print STDERR "@_\n"; + $status = system ("@_"); + $status; +} + +sub goodbye { + print STDERR "ending execution\n"; + vsystem ("date"); + vsystem ("notify.pl $ARGV[0] none 0"); + die "@_"; +} + +if (@ARGV < 1) {die "USAGE: stage2 Noutfile\n"; } +$Noutfile = $ARGV[0] + 1; +$outfile = "stage2." . $Noutfile . ".log"; + +print STDERR "starting execution\n"; +vsystem ("date"); +if (-e $killfile) { goodbye "process killed with $killfile"; } + +if (-e $alockfile) { goodbye "archive lock $alockfile is set"; } +open (TEMP, ">$alockfile"); +close (TEMP); + +$Ntries = 0; +$Nleft = 0; +@leftlist = (); + +while (! $Nleft) { + compare_done_todo (); + if (-e $killfile) { goodbye "process killed with $killfile"; } + vsystem ("sleep 60"); + if (-e $killfile) { goodbye "process killed with $killfile"; } + $Ntries ++; + if ($Ntries == 1440) { goodbye "timeout waiting for new data"; } +} + +if (-e $killfile) { goodbye "process killed with $killfile"; } + +chdir $scriptdir; + +for ($i = 0; $i < $Nleft; $i++) { + print STDERR "adding: $leftlist[$i]\n"; + @entries = split (" ",$leftlist[$i]); + $inlist = $entries[0] . ".addlist"; + $outlist = $entries[0] . ".outlist"; + $subdir = $entries[0]; + $photcode = $entries[1]; + print STDERR "$subdir: $inlist $outlist $photcode\n"; + if (-e $outlist) { + # partially successful run, restart controller in the middle + $tmp_inlist = $entries[0] . ".tmpaddlist"; + $tmpoutlist = $entries[0] . ".tmpoutlist"; + if (-e $tmpoutlist) { if (vsystem ("cat $tmpoutlist >> $outlist")) { goodbye "trouble merging $tmpoutlist and $outlist\n"; }} + # partially successful re-start: make sure $outlist is complete + print STDERR "re-running unfinished entries in outlist\n"; + if (parse_outlist ($outlist,$tmp_inlist, 4)) { + docontroller ($subdir, $tmp_inlist, $tmpoutlist, $photcode, "-s addstar", 0); + vsystem ("cat $tmpoutlist >> $outlist"); + } + # do inlist entries not in outlist + print STDERR "running undone entries in addlist\n"; + parse_outlist ($inlist,"tmpinlist", 4); + parse_outlist ($outlist,"tmpoutlist", 5); + if (match_lists ("tmpinlist","tmpoutlist","$tmp_inlist")) { + docontroller ($subdir, $tmp_inlist, $tmpoutlist, $photcode, "-s addstar", 0); + vsystem ("cat $tmpoutlist >> $outlist"); + } + # check ending success + unless (unlink ($tmpoutlist)) { goodbye "can't unlink $tmpoutlist, why not?"; } + unless (unlink ($tmp_inlist)) { goodbye "can't unlink $tmp_inlist, why not?"; } + vsystem ("cleaning.pl"); + if (-e $lockfile) { goodbye "lock file exists"; } + + print STDERR "done: $subdir\n"; + open (DONELOG, ">>$addstarfile"); + print DONELOG "$subdir\n"; + close (DONELOG); + } else { + $controlflags = ""; + parse_outlist ($inlist,"tmpinlist", 4); + docontroller ($subdir, "tmpinlist", $outlist, $photcode, "-s addstar", 1); + print STDERR "done: $subdir\n"; + open (DONELOG, ">>$addstarfile"); + print DONELOG "$subdir\n"; + close (DONELOG); + } +} +unless (unlink ($alockfile)) { goodbye "can't unlink $alockfile, why not?"; } +print STDERR "remember to delete images from complete directories\n"; + +unless (-e $haltfile) { + print STDERR "re-did unfinished images\n"; + print STDERR "starting a new stage2 with output to $outfile\n"; + vsystem ("notify.pl $ARGV[0] $outfile $Noutfile"); + vsystem ("stage2 $Noutfile 1>$outfile 2>&1 &"); + exit; +} +goodbye "added images"; +exit; + +# do controller (& cleaning if needed), taking care of flats and error conditions +sub docontroller { + if (-e $killfile) { goodbye "process killed with $killfile"; } + if (-e $clockfile) { goodbye "lock file $clockfile exists"; } + # break up entry line + $outsubdir = $_[0]; + $in = $_[1]; + $out = $_[2]; + $phot = $_[3]; + $flags = $_[4]; + $clean = $_[5]; + # run controller and cleanup + if (-e $lockfile) { goodbye "lock file exists"; } + vsystem ("control2 $flags -o $outsubdir $in $out $phot"); + if (-e $clockfile) { goodbye "lock file $clockfile exists"; } + if (-e $lockfile) { goodbye "lock file exists"; } + if (-e $killfile) { goodbye "process killed with $killfile"; } + if ($clean) { + vsystem ("cleaning.pl"); + if (-e $lockfile) { goodbye "lock file exists"; } + } +} + +sub by_filename { + @value1 = split (" ", $a); + @value2 = split (" ", $b); + $value1[0] cmp $value2[0]; +} + +# we read from in and write to out those files with 1st 0 in the mode column +sub parse_outlist { + $in = $_[0]; + $out = $_[1]; + $mode = $_[2]; + +# load inlist + open (INLIST, $in); + @inarray = (); + while ($line = ) { + chop ($line); + @inarray = (@inarray,$line); + } + $Nin = @inarray; + close (INLIST); + @inarray = sort by_filename @inarray; + + @outarray = (); + for ($k = 0; $k < $Nin; $k++) { + @pvalues = split (" ", $inarray[$k]); + $more = 1; + while ($more) { + print STDERR "."; + @nvalues = split (" ", $inarray[$k+1]); + if ($nvalues[0] cmp $pvalues[0]) { + $more = 0; + } else { + $pvalues[1] |= $nvalues[1]; + $pvalues[2] |= $nvalues[2]; + $pvalues[3] |= $nvalues[3]; + $pvalues[4] |= $nvalues[4]; + $pvalues[5] |= $nvalues[5]; + $k ++; + } + } + # in this version, we only care about pvalues[4,5] (addstar) + if (($mode == 4) && $pvalues[4] && !$pvalues[5]) { + $name = $pvalues[0]; + $name =~ s/$dumpspace//; + $name =~ s/://; + @outarray = (@outarray,$name); + } + if (($mode == 5) && $pvalues[5]) { + $name = $pvalues[0]; + $name =~ s/$dumpspace//; + $name =~ s/://; + @outarray = (@outarray,$name); + } + } + $Nout = @outarray; + if ($Nout) { + open (OUTLIST, ">$out"); + for ($k = 0; $k < $Nout; $k++) { + print OUTLIST "$outarray[$k]\n"; + } + close (OUTLIST); + } + $Nout; +} + +# find lines in inlist which are not in outlist +sub match_lists { + $in = $_[0]; + $out = $_[1]; + $new = $_[2]; + +# load inlist + open (INLIST, $in); + @inarray = (); + while ($line = ) { + chop ($line); + @inarray = (@inarray,$line); + } + $Nin = @inarray; + close (INLIST); + +# load outlist + open (OUTLIST, $out); + @outarray = (); + while ($line = ) { + chop ($line); + @outarray = (@outarray,$line); + } + $Nout = @outarray; + close (OUTLIST); + +# find matched lines + @newarray = (); + for ($k = 0; $k < $Nin; $k++) { + $gotit = 0; + for ($m = 0; ! $gotit && ($m < $Nout); $m++) { + if ($outarray[$m] =~ /$inarray[$k]/) { + $gotit = 1; + } + } + if (!$gotit) { + @newarray = (@newarray,$inarray[$k]); + } + } + $Nnew = @newarray; + if ($Nnew) { + open (NEWLIST, ">$new"); + for ($k = 0; $k < $Nnew; $k++) { + print NEWLIST "$newarray[$k]\n"; + } + close (NEWLIST); + } + $Nnew; +} + +sub compare_done_todo { + print STDERR "starting compare\n"; +# load in done date list + open (DONELOG, $addstarfile); + @donelist = (); + while ($line = ) { + chop ($line); + @donelist = (@donelist,$line); + } + $Ndone = @donelist; + close (DONELOG); + +# load in maestro list + open (TODOLOG, $processfile); + @todolist = (); + while ($line = ) { + chop ($line); + @todolist = (@todolist,$line); + } + $Ntodo = @todolist; + close (TODOLOG); + +# find entries in MAESTRO that are NOT in DONELOG + for ($i = 0; $i < $Ntodo; $i ++) { + $gotit = 0; + for ($j = 0; ($j < $Ndone) && ! $gotit; $j ++) { + @todo = split (" ",$todolist[$i]); + @done = split (" ",$donelist[$j]); + if ($todo[0] eq $done[0]) { + $gotit = 1; + } + } + if (!$gotit) { + @leftlist = (@leftlist, $todolist[$i]); + } + } + $Nleft = @leftlist; + $Nleft; +} Index: /tags/ohana/perl-1-3/Ohana/src/perl/loneos/testlogs.pl =================================================================== --- /tags/ohana/perl-1-3/Ohana/src/perl/loneos/testlogs.pl (revision 21906) +++ /tags/ohana/perl-1-3/Ohana/src/perl/loneos/testlogs.pl (revision 21906) @@ -0,0 +1,86 @@ +#!/usr/bin/perl + +sub vsystem { + print STDERR "@_\n"; + $status = system ("@_"); + $status; +} + +sub goodbye { + print STDERR "ending execution\n"; + vsystem ("date"); + die "@_"; +} + +$Nline = -1; +while ($line = ) { + $Nline ++; + if ($Nline == 0) { next; } + if ($Nline == 1) { + @parts = split (" ",$line); + $N1 = $parts[9]; + next; + } + if ($Nline == 2) { + @parts = split (" ",$line); + $N2 = $parts[2]; + if ($N1 != $N2) { + print STDERR "problem in dophot\n"; + exit; + } + next; + } + if ($Nline == 3) { + @parts = split (" ",$line); + $N1 = $parts[10]; + next; + } + if ($Nline == 4) { + @parts = split (" ",$line); + $N2 = $parts[2]; + if ($N1 != $N2) { + print STDERR "problem in fstat\n"; + exit; + } + next; + } + if ($Nline == 5) { + @parts = split (" ",$line); + $N1 = $parts[8]; + next; + } + if ($Nline == 6) { + @parts = split (" ",$line); + $N2 = $parts[2]; + if ($N1 != $N2) { + print STDERR "problem in gastro\n"; + exit; + } + next; + } + if ($Nline == 7) { + @parts = split (" ",$line); + $N1 = $parts[6]; + next; + } + if ($Nline == 8) { + @parts = split (" ",$line); + $N2 = $parts[2]; + if ($N1 != $N2) { + print STDERR "problem in addstar\n"; + exit; + } + next; + } + if ($Nline > 8) { + print STDERR "$line\n"; + print STDERR "too many lines?\n"; + exit; + } + +} + +if ($Nline != 8) { + print STDERR "not enough lines\n"; + exit; +} Index: /tags/ohana/perl-1-3/Ohana/src/perl/new/defringe =================================================================== --- /tags/ohana/perl-1-3/Ohana/src/perl/new/defringe (revision 21906) +++ /tags/ohana/perl-1-3/Ohana/src/perl/new/defringe (revision 21906) @@ -0,0 +1,65 @@ +#!/usr/bin/env perl + +if (@ARGV != 2) { &usage; } + +# command line arguments +$inlist = $ARGV[0]; +$outlist = $ARGV[1]; + +# setup elixir references +$coordpath = `gconfig FRINGE_COORD_PATH`; chop $coordpath; +$confdir = `gconfig CONFDIR`; chop $confdir; +$script = "$confdir/mana/fringe.pro"; + +$filtkwd = `gconfig FILTER-KEYWORD`; chop $filtkwd; +$camerakwd = `gconfig CAMERA-KEYWORD`; chop $camerakwd; +$ccdkwd = `gconfig CCDNUM-KEYWORD`; chop $ccdkwd; + +$Nccd = `cameraconfig -Nccd`; chop $Nccd; +$answer = `cameraconfig -ccds`; +@ccds = split (" ", $answer); + +# temporary files needed: +set imstats=`mktemp /tmp/defringe.XXXXXX`; +set frstats=`mktemp /tmp/defringe.XXXXXX`; + +# calculate imstats for the input image, get stats from fringe image header +set filtvalue = `head -1 $imlist | fields $filtkwd | awk '{print $2}'`; +set filter = `filtnames $filtvalue`; + +set camera = `head -1 $imlist | fields $camerakwd | awk '{print $2}'`; +if ("$camera" == "") set camera = "WFI"; + +# load input / output lists: +open (FILE, "$inlist"); +@inlist = ; +close (FILE); + +open (FILE, "$outlist"); +@outlist = ; +close (FILE); + +if (@inlist != @outlist) { die "ERROR: mismatched lists\n"; } + +# measure fringe amplitude + + + +sub vsystem { + print STDERR "@_\n"; + $status = system ("@_"); + $status; +} + +sub goodbye { + die "@_\n"; +} + +sub usage { + print STDERR "USAGE: defringe (inlist) (outlist)\n"; + exit 2; +} + +sub uppercase { + return "\U$_[0]\E"; +} Index: /tags/ohana/perl-1-3/Ohana/src/perl/new/getfringe =================================================================== --- /tags/ohana/perl-1-3/Ohana/src/perl/new/getfringe (revision 21906) +++ /tags/ohana/perl-1-3/Ohana/src/perl/new/getfringe (revision 21906) @@ -0,0 +1,80 @@ +#!/usr/bin/env perl + +if (@ARGV != 4) { die "USAGE: gtfringe (in.fits) (fringe.coords) (binning) (out.dat)\n"; } + +$input = $ARGV[0]; +$coords = $ARGV[1]; +$binning = $ARGV[2]; +$output = $ARGV[3]; + +# create temporary files: +$PARFILE = `mktemp /tmp/gtfringe.XXXXXX`; +$INFILE = `mktemp /tmp/@gtfringe.XXXXXX` +$OUTFILE = `mktemp /tmp/gtfringe.XXXXXX` + +# convert + +open (FILE, "$inlist"); +@mef = ; +close (FILE); + +@split = (); +foreach $name (@mef) { + chop ($name); + + # convert name /path/name.fits to /outdir/rootNN.fits + @words = split ("/", $name); + $root = $words[-1]; + $root =~ s/.fits//; + + $new = sprintf "%s/%s%02d.fits", $outdir, $root, $ccd; + push @split, $new; +} + +open (MANA, "|mana --norc"); + +# define the macro 'split' +print MANA "macro split\n"; +print MANA " rd a \$1 -n $ccd\n"; +print MANA " keyword a NAXIS1 nx\n"; +print MANA " keyword a NAXIS2 ny\n"; +print MANA " if ((\$nx == 2080) && (\$ny == 4128))\n"; +print MANA " wd a \$2 -bitpix 16 -bzero 32768 -bscale 1.0\n"; +print MANA " exec echo \$2 >> $outlist\n"; +print MANA " end\n"; +print MANA "end\n"; + +# create the macro 'go' with the commands +print MANA "macro go\n"; +for ($i = 0; $i < @mef; $i++) { + if (-e $split[$i]) { + print STDERR "$split[$i] exists, skipping\n"; + next; + } + print MANA " split $mef[$i] $split[$i]\n"; +} +# if the macro ends successfully, exit 0 +print MANA " exit 0\n"; +print MANA "end\n"; + +# if the macro exits before the end, exit 1 +print MANA "go\n"; +print MANA "exit 1\n"; +close (MANA); + +$status = $?; +print STDERR "mana exit status: $status\n"; +if ($status) { + print STDERR "ERROR: problem running split.mef\n"; + exit 1; +} + +print STDERR "SUCCESS\n"; +exit 0; + +sub vsystem { + print STDERR "@_\n"; + $status = system ("@_"); + $status; +} + Index: /tags/ohana/perl-1-3/Ohana/src/perl/old/clear.rawdir =================================================================== --- /tags/ohana/perl-1-3/Ohana/src/perl/old/clear.rawdir (revision 21906) +++ /tags/ohana/perl-1-3/Ohana/src/perl/old/clear.rawdir (revision 21906) @@ -0,0 +1,258 @@ +#!/usr/bin/env perl + +# this script is very much specific to the CFHT data layout + +$archive = "/h/archive/current/instrument/cfh12k"; +$force = 0; + +# grab the command line arguments: +@tARGV = (); +for (; @ARGV > 0; ) { + + if ($ARGV[0] eq "-force") { + shift; + $force = 1; + next; + } + + @tARGV = (@tARGV, $ARGV[0]); + shift; +} +@ARGV = @tARGV; + +if (@ARGV != 1) { die "USAGE: clean.rawdir (crunid)\n" ;} + +if ($ARGV[0] eq "-current") { + $runid = `gconfig -q RUNID`; chop ($runid); +} else { + $runid = $ARGV[0]; +} +print "runid: $runid\n"; + +$rawdir = `gconfig -q -D RUNID $runid RAWDIR`; chop ($rawdir); +if ($rawdir eq "") { + print STDERR "can't find config entry RAWDIR\n"; + exit 1; +} +print "rawdir: $rawdir\n"; + +@meflist = (); +@splitlist = (); + +# load in the MEF files (must be of format 123456x.fits) +@tlist = <$rawdir/*.fits>; +foreach $tname (@tlist) { + if ((-f $tname) && ($tname =~ /\d\d\d\d\d\d\w.fits$/)) { + @meflist = (@meflist, $tname); + } +} + +# load in the SPLIT directories (must be of format 123456x) +@tlist = <$rawdir/???????>; +foreach $tname (@tlist) { + if ((-d $tname) && ($tname =~ /\d\d\d\d\d\d\w$/)) { + @splitlist = (@splitlist, $tname); + } +} +$N1 = @meflist; +$N2 = @splitlist; + +foreach $file (@meflist) { + + # grab the root name: + $root = mefnames ($file, "root"); + + $arname = "$archive/$root.fits"; + $newname = $file; + + # check that the file exists in the archive + if (-l $file) { next; } + if (! -e $arname) { next; } + if (! -f $arname) { next; } + + unlink $file; + symlink $arname, $newname; +} + +foreach $file (@splitlist) { + + # grab the root name: + $root = splitnames ($file, "root"); + + $arname = "$archive/$root.fits"; + $newname = "$rawdir/$root.fits"; + + # check that the file exists in the archive + if (! -e $arname) { next; } + if (! -f $arname) { next; } + + vsystem ("rm -rf $file\n"); + symlink $arname, $newname; + vsystem ("imsearch -name $root -split2mef\n"); +} + +exit 0; + +# utilities ############################################## + +sub gt_names { + # in: filename mode type + # out: word + + my ($value); + + $value = ""; + if ($_[2] eq "MEF") { $value = mefnames ($_[0], $_[1]); } + if ($_[2] eq "SPLIT") { $value = splitnames ($_[0], $_[1]); } + + return $value; +} + +sub mefnames { + # in: (/path/file.fits) (mode) + # out: word + + my($fullname) = $_[0]; + my($mode) = $_[1]; + my($answer); + + # split rootdir and filename: + my (@words) = split ("/", $fullname); + $N = @words; + + if ($mode eq "path") { + $answer = ""; + for ($i = 0; $i < $N - 1; $i++) { + $answer = $answer . $words[$i] . "/"; + } + chop ($answer); # strip off last / + if ($answer eq "") { $answer = "."; } + return ($answer); + } + + if ($mode eq "root") { + $answer = "$words[$N-1]"; + $answer =~ s/.fits$//; + return ($answer); + } + + if ($mode eq "Nccd") { + if (! -e $fullname) { + return (0); + } + $answer = `echo $fullname | fields NEXTEND`; + @words = split (" ", $answer); + if ($words[1] eq "") { + return (0); + } + return ($words[1]); + } + + return (0); +} + +sub splitnames { + # in: (/path/file) (mode) + # out: word + # /path/file is directory containing Nccd fits images + + my($fullname) = $_[0]; + my($mode) = $_[1]; + my($answer, $N, $tmpname, @imlist, @words); + + # split rootdir and filename: + @words = split ("/", $fullname); + $N = @words; + + if ($mode eq "path") { + $answer = ""; + for ($i = 0; $i < $N - 1; $i++) { + $answer = $answer . $words[$i] . "/"; + } + chop ($answer); # strip off last / + if ($answer eq "") { $answer = "."; } + return ($answer); + } + + if ($mode eq "root") { + $answer = "$words[$N-1]"; + return ($answer); + } + + if ($mode eq "Nccd") { + + $tmpname = "$fullname/$words[$N-1]"; + @imlist = <$tmpname??.fits>; + + $Nccd = @imlist; + return $Nccd; + } + + return (0); +} + +sub ckimtype { + # in: (/path/file) + # out: MEF | SPLIT | SINGLE | (NULL) + + my ($answer, $name, $value); + my ($file) = $_[0]; + + if (! -e $file) { + print STDOUT "can't open file\n"; + return ""; + } + + # if /path/file is a directory, it is split: + if (-d $file) { return "SPLIT"; } + + # check that the file is a FITS image + $answer = `file -L $file`; + if ($?) { + print STDOUT "can't open file\n"; + return ""; + } + ($name, $value) = split (" ", $answer); + if ($value ne "FITS") { + print STDOUT "not a valid image\n"; + return ""; + } + + # check for NAXIS = 0 (MEF) + $answer = `echo $file | fields NAXIS`; + # if ($?) { return ""; } + ($name, $value) = split (" ", $answer); + if ($value eq 0) { return "MEF"; } + + if ($value == 2) { return "SINGLE"; } + + print STDOUT "not a valid image\n"; + return ""; +} + +sub vsystem { + # print STDERR "@_\n"; + my($status) = system ("@_"); + $status; +} + +sub goodbye { + die "@_\n"; +} + + +# This program calls several other perl scripts to get information +# about the image. +# ckrunid - determine the appropriate Camera Run ID for this image +# ckastrom - check for the appropriate astrometry information +# ckdetrend - check for the appropriate detrend images +# ckphotom - check for the appropriate photometry data + +# at the moment, there are different calling conventions for each of +# these functions. Some take a single name (MEF / SPLIT), some take a +# reference to the specific CCD (filename CCD MODE). + +# none of the called functions need to find the number of CCDs +# ckvalid determines the number of CCDs from the header (MEF) or the +# number of appropriately named FITS files in the directory (SPLIT). + Index: /tags/ohana/perl-1-3/Ohana/src/perl/old/create.imlists =================================================================== --- /tags/ohana/perl-1-3/Ohana/src/perl/old/create.imlists (revision 21906) +++ /tags/ohana/perl-1-3/Ohana/src/perl/old/create.imlists (revision 21906) @@ -0,0 +1,67 @@ +#!/usr/bin/env perl + +# take single list of images, create collection of lists in path, each with files for one image, +# place list of lists in outlist + +if (@ARGV != 3) { die "ERROR: USAGE: create.subset (inlist) (path) (outlist)\n" } + +$inlist = $ARGV[0]; +$path = $ARGV[1]; +$outlist = $ARGV[2]; + +open (FILE, $inlist); +@inlist = ; +close (FILE); +foreach $name (@inlist) { chop ($name); } + +open (OUT, ">$outlist"); + +while (@inlist) { + $name = pop (@inlist); + + @sublist = ($name); + ($subname, $ext) = $name =~ /(\S+)(\d\d\D+)/; + ($filename) = $subname =~ /(\d\d\d\d\d\d.)$/; + print STDERR "subname: $subname\n"; + print STDERR "filename: $filename\n"; + print STDERR "ext: $ext\n"; + + @outlist = (); + while (@inlist) { + $name = pop (@inlist); + + if ($name =~ /$subname/) { + push (@sublist, $name); + } else { + push (@outlist, $name); + } + } + + @sublist = sort @sublist; + + # file lists have names like /path/filename.imlist + open (FILE, ">$path/$filename.imlist"); + foreach $name (@sublist) { + print FILE "$name\n"; + } + close (FILE); + + print OUT "$path/$filename.imlist\n"; + + @inlist = @outlist; +} + +close (OUT); + +########################################################################### + +sub vsystem { + print STDERR "@_\n"; + $status = system ("@_"); + $status; +} + +sub goodbye { + die "@_\n"; +} + Index: /tags/ohana/perl-1-3/Ohana/src/perl/old/elixir.grabd =================================================================== --- /tags/ohana/perl-1-3/Ohana/src/perl/old/elixir.grabd (revision 21906) +++ /tags/ohana/perl-1-3/Ohana/src/perl/old/elixir.grabd (revision 21906) @@ -0,0 +1,159 @@ +#!/usr/bin/env perl + +# this daemon creates links for new images in the elixir TMPDIR tree +# and registers the images in the elixir database, and sends the image +# to imstats for processing. + +# the standard elixir config system is used to id the TMPDIR and the +# appropriate imstats.fifo, etc. + +# TMPDIR should be checked on each scan loop, in case the TMPDIR or +# RUNID is switched + +# make sure the appropriate config file is used. + +use English; + +# check usage +if (@ARGV != 0) { die "USAGE: elixir.grabd\n"; } + +# what do we do about config file? demand account be set up correctly? +$fifos = `gconfig FIFOS`; chop ($fifos); +if ($?) { die "error in config system\n"; } + +# check for existing process and exit +$pidfile = "$fifos/gradb.pid"; +if (-e $pidfile) { + $line = `head -1 $pidfile`; + ($ohost, $ouser, $opid) = split (" ", $line); + + print STDERR "elixir.grabd is already being run:\n"; + print STDERR " machine: $ohost\n"; + print STDERR " user: $ouser\n"; + print STDERR " pid: $opid\n"; + print STDERR " pidfile: $pidfile\n"; + exit 1; +} + +# set process lock file: +$host = `hostname`; chop ($host); +$user = getlogin; +open (FILE, ">$pidfile"); +print FILE "$host $user $PID\n"; +close (FILE); + +# place this in the config system? +$srcdir = "/data/kapu/elixir/cfh12k"; +while (-e $pidfile) { + grabfiles (); + system ("sleep 60"); +} + +# clear process lock file: +unlink ($pidfile); +exit 0; + + +########################################################## + +sub grabfiles () { + + $rawdir = `gconfig -q RAWDIR`; chop $rawdir; + + @files = glob ("$srcdir/*"); + + if (! @files) { + system ("sleep 60"); + return; + } + + foreach $name (@files) { + if (! -l $name) { next; } + + # find real path + $path = convertlink ($name); + $file = filename ($path); + + # set new path (skip if it exists) + $new = sprintf "%s/%s", $rawdir, $file; + if (-e $new) { + print STDERR "skipping file\n"; + next; + } + + # print "$name -> $path ($file) -> $new\n"; + + # link file to rawdir: + symlink ($path, $new); + + # these files always come in as MEF + vsystem ("imsort $new"); + if ($?) { next; } + + unlink $name + } +} + + +# utilities ############################################## +sub vsystem { + print STDERR "@_\n"; + my ($status) = system ("@_"); + $status; +} + +sub filename { + + my ($path) = $_[0]; + my (@tmp); + + @tmp = split ("/", $path); + return $tmp[-1]; +} + +sub convertlink { + my ($link) = $_[0]; + my ($file); + + while (-l $link) { + $file = readlink ($link); + $path1 = path ($link); + $path2 = path ($file); + + unless ($path2 =~ m|^/|) { + $file = "$path1/$file"; + } + $link = $file; + } + return ($link); +} + +sub usage { + + if (@ARGV == 1) { + print STDERR "\n --- user modes ---\n"; + print STDERR "create (run) (start) (stop)\n"; + print STDERR "addqso (runid) (qsoid)\n"; + print STDERR "delqso (qsoid)\n"; + print STDERR "sched (runid)\n"; + print STDERR "status\n"; + &goodbye; + } + + if (@ARGV > 2) { print STDERR "USAGE: prepare.run (help) [mode]\n"; &goodbye; } + + &goodbye; +} + +sub path { + + my ($file) = $_[0]; + + @words = split ("/", $file); + + pop (@words); + + $path = join ("/", @words); + + return ($path); +} Index: /tags/ohana/perl-1-3/Ohana/src/perl/old/fixlists =================================================================== --- /tags/ohana/perl-1-3/Ohana/src/perl/old/fixlists (revision 21906) +++ /tags/ohana/perl-1-3/Ohana/src/perl/old/fixlists (revision 21906) @@ -0,0 +1,43 @@ +#!/usr/bin/env perl + +sub vsystem { + print STDERR "@_\n"; + $status = system ("@_"); + $status; +} + +sub goodbye { + die "@_\n"; +} + +if (@ARGV != 3) { die "ERROR: USAGE: fixlists (in) (keep) (out)\n" } + +open (FILE, $ARGV[1]); +@keep = (); +while ($line = ) { + chop ($line); + @keep = (@keep, $line); +} +close (FILE); + +open (IN, $ARGV[0]); +open (OUT, ">$ARGV[2]"); + +for ($j = 0; $line = ; $j++) { + chop ($line); + $found = 0; + for ($i = 0; !$found && ($i < @keep); $i++) { + if ($keep[$i] == $j) { + $found = 1; + } + } + if ($found) { + print OUT "$line\n"; + } +} +close (IN); +close (OUT); + +print STDERR "SUCCESS\n"; + +# put the logic for selecting images in this file Index: /tags/ohana/perl-1-3/Ohana/src/perl/old/fl.split2mef =================================================================== --- /tags/ohana/perl-1-3/Ohana/src/perl/old/fl.split2mef (revision 21906) +++ /tags/ohana/perl-1-3/Ohana/src/perl/old/fl.split2mef (revision 21906) @@ -0,0 +1,98 @@ +#!/usr/bin/env perl + +# check the usage +if (@ARGV != 2) { die "USAGE: fl.split2mef (file.master) (splitdir)\n" } + +# assign the command line arguments +$master = $ARGV[0]; +$splitdir = $ARGV[1]; + +open (FILE, "$master"); +@master = ; +close (FILE); + +# master contains lines from both split and mef. +# convert all to split format, and write to root.mef +# empty the split file, re-write the master file with new names. +# when the new mef list is run through split.mef, only un-split entries +# will get split + +# /data/koa/cfh12k/01Ak05/587554f/587554f04.fits +# /data/elixir2/cfh12k/detrend/01Ak04/split/582967f00.fits 1 + +foreach $line (@master) { + + ($name, $mode) = split (" ", $line); + + # test filename: + unless ($name =~ m|/\d\d\d\d\d\d\w\d\d.fits\Z|) { + print STDERR "Error with $name: not in split-name format\n"; + next; + } + + ($path, $root1, $root2, $ccd) = $name =~ m|(\S+)/(\d\d\d\d\d\d\w)/(\d\d\d\d\d\d\w)(\d\d).fits\Z|; + + # test for originally SPLIT image: + if ($root1 eq $root2) { + # check for existence of mef version file: + $new = sprintf "%s/%s.fits", $path, $root1; + if (! -e $new) { + print STDERR "Error, file $new is missing\n"; + exit 1; + } + @newmef = (@newmef, $new); + + # create split version name: + $new = sprintf "%s/%s%02d.fits", $splitdir, $root1, $ccd; + @split = (@split, $new); + @splitmode = (@splitmode, $mode); + next; + } + + # test for previously MEF -> SPLIT images: + if ($root1 eq "split") { + @mef = (@mef, $name); + @mefmode = (@mefmode, $mode); + next; + } + + print STDERR "Error with $name - neither split nor mef\n"; +} + +# empty *.split file +$splitname = $master; +$splitname =~ s/master\Z/split/; +open (FILE, ">$splitname"); +close (FILE); + +# create *.mef file with new mefs (to be split) +$mefname = $master; +$mefname =~ s/master\Z/mef/; +print STDERR "mefname: $mefname\n"; +open (FILE, ">$mefname"); +foreach $name (@newmef) { + print FILE "$name\n"; +} +close (FILE); + +# save *.master file +vsystem ("cp $master $master~"); + +# re-create *.master file +open (FILE, ">$master"); +@all = (@mef, @split); +@allmode = (@mefmode, @splitmode); +for ($i = 0; $i < @all; $i++) { + print FILE "$all[$i] $allmode[$i]\n"; +} +close (FILE); + +sub vsystem { + print STDERR "@_\n"; + $status = system ("@_"); + $status; +} + +sub goodbye { + die "@_\n"; +} Index: /tags/ohana/perl-1-3/Ohana/src/perl/old/fr.detrend =================================================================== --- /tags/ohana/perl-1-3/Ohana/src/perl/old/fr.detrend (revision 21906) +++ /tags/ohana/perl-1-3/Ohana/src/perl/old/fr.detrend (revision 21906) @@ -0,0 +1,102 @@ +#!/usr/bin/env perl +# calls flatten.flips, but no direct flips functions + +# check the usage +if ($ARGV[0] eq "-h") { usage (); } +if ($ARGV[0] eq "-help") { usage (); } +if (@ARGV != 4) { die "USAGE: fr.detrend (path) (root) (mode) (outdir)\n" } + +# assign the command line arguments +$path = $ARGV[0]; +$root = $ARGV[1]; +$mode = "\U$ARGV[2]\E"; +if (($mode ne "MEF") && ($mode ne "SPLIT")) { die "ERROR: mode must be either -split or -mef\n";} +$outdir = $ARGV[3]; +if (! -d $outdir) { vsystem ("mkdir -p $outdir"); } + +# get info on input image +$basename = mk_basename ($path, $root, $mode); +$Nccd = `cameraconfig -Nccd`; chop ($Nccd); + +for ($ccd = 0; $ccd < $Nccd; $ccd++) { + + $infile = mk_filename ($path, $root, $mode, $ccd); + $outfile = mk_filename2 ($outdir, $root, "SPLIT", $ccd); + + $status = vsystem ("flatten.flips -quiet $infile $outfile $ccd $mode"); + if ($status) { die "ERROR: problem running flatten on $infile\n"; } + +} + +print STDOUT "SUCCESS: finished with fr.detrend\n"; +exit 0; + +sub mk_basename { + my ($path) = $_[0]; + my ($root) = $_[1]; + my ($mode) = $_[2]; + + if ($mode eq "MEF") { + $name = sprintf "%s/%s.fits", $path, $root; + return $name; + } + if ($mode eq "SPLIT") { + $name = sprintf "%s/%s", $path, $root; + return $name; + } + return ""; +} + +sub mk_filename { + my ($path) = $_[0]; + my ($root) = $_[1]; + my ($mode) = $_[2]; + my ($ccd) = $_[3]; + + if ($mode eq "MEF") { + $name = sprintf "%s/%s.fits", $path, $root; + return $name; + } + if ($mode eq "SPLIT") { + $name = sprintf "%s/%s/%s%02d.fits", $path, $root, $root, $ccd; + return $name; + } + return ""; +} + +sub mk_filename2 { + my ($path) = $_[0]; + my ($root) = $_[1]; + my ($mode) = $_[2]; + my ($ccd) = $_[3]; + + if ($mode eq "MEF") { + $name = sprintf "%s/%s.fits", $path, $root; + return $name; + } + if ($mode eq "SPLIT") { + $name = sprintf "%s/%s%02d.fits", $path, $root, $ccd; + return $name; + } + return ""; +} + +sub vsystem { + print STDERR "@_\n"; + $status = system ("@_"); + $status; +} + +sub goodbye { + die "@_\n"; +} + +sub usage { + print "\n"; + print "USAGE: fr.detrend (path) (root) (mode) (outdir)\n"; + print " path: path to MEF image or SPLIT dir\n"; + print " root: root name of image (MEF = root.fits, SPLIT = root/rootNN.fits)\n"; + print " mode: MEF or SPLIT\n"; + print " outdir: directory for output results (all split)\n"; + exit 1; +} Index: /tags/ohana/perl-1-3/Ohana/src/perl/old/fr.gtstats =================================================================== --- /tags/ohana/perl-1-3/Ohana/src/perl/old/fr.gtstats (revision 21906) +++ /tags/ohana/perl-1-3/Ohana/src/perl/old/fr.gtstats (revision 21906) @@ -0,0 +1,75 @@ +#!/usr/bin/env perl + +# check the usage +if ($ARGV[0] eq "-h") { usage (); } +if ($ARGV[0] eq "-help") { usage (); } +if (@ARGV != 3) { die "USAGE: fr.gtstats (inlist) (binning) (output)\n" } + +# define the path to include FLIPS: +$flipsconf=`gconfig -q FLIPSCONF`; chop ($flipsconf); +$flipspath=`gconfig -q FLIPSPATH`; chop ($flipspath); +$ENV{'PATH'} = "$ENV{'PATH'}:$flipspath"; +$ENV{'FLIPSDIR'} = $flipsconf; + +# assign the command line arguments +$inlist = $ARGV[0]; +$bin = $ARGV[1]; +$output = $ARGV[2]; + +# load input list: +open (FILE, "$inlist"); +@inlist = ; +close (FILE); + +# gtfringe is appending to the output file: +unlink ($output); + +# we construct the Fringe Coord File from: FRINGE_COORD_PATH/CAMERA-FILTER-CCDNN-FringeCoord.reg +$fkey = `gconfig -q FILTER-KEYWORD`; chop ($fkey); +$ckey = `gconfig -q CAMERA-KEYWORD`; chop ($ckey); +$coordpath = `gconfig -q FRINGE_COORD_PATH`; chop ($coordpath); +$Nccd = `cameraconfig -Nccd`; chop ($Nccd); + +# double check lists size: +if ($Nccd != @inlist) { die "ERROR: mis-matched image list sizes\n"; } + +# find filter and camera from image +$answer = `echo $inlist[0] | fields $fkey $ckey`; +($name, $filter, $camera) = split (" ", $answer); + +for ($ccd = 0; $ccd < $Nccd; $ccd++) { + + $infile = $inlist[$ccd]; + $coordfile = sprintf "%s/%s-%s-CCD%02d-FringeCoord.reg", $coordpath, $camera, $filter, $ccd; + + # each call to gtfringe adds a line to $output + vsystem ("gtfringe $infile $coordfile $bin $output"); + if ($?) { + print STDERR "ERROR running gtfringe\n"; + exit 1; + } +} + +print STDOUT "SUCCESS: finished with fr.gtstats\n"; +exit 0; + +sub vsystem { + print STDERR "@_\n"; + $status = system ("@_"); + $status; +} + +sub goodbye { + die "@_\n"; +} + +sub usage { + print "\n"; + print "USAGE: fr.gtstats (path) (root) (binning) (output)\n"; + print " calculate fringe pattern strengths for images in (path)\n"; + print " path: path to MEF image or SPLIT dir\n"; + print " root: root name of image (MEF: root.fits, SPLIT: root/rootNN.fits)\n"; + print " binning: binning factor of images\n"; + print " outdir: output file\n"; + exit 1; +} Index: /tags/ohana/perl-1-3/Ohana/src/perl/old/fr.medbin =================================================================== --- /tags/ohana/perl-1-3/Ohana/src/perl/old/fr.medbin (revision 21906) +++ /tags/ohana/perl-1-3/Ohana/src/perl/old/fr.medbin (revision 21906) @@ -0,0 +1,71 @@ +#!/usr/bin/env perl + +# check the usage +if ($ARGV[0] eq "-h") { usage (); } +if ($ARGV[0] eq "-help") { usage (); } +if (@ARGV != 4) { die "USAGE: fr.medbin (path) (root) (factor) (outpath)\n" } + +# assign the command line arguments +$path = $ARGV[0]; +$root = $ARGV[1]; +$factor = $ARGV[2]; +$outpath = $ARGV[3]; + +$Nccd = `cameraconfig -Nccd`; chop ($Nccd); + +# need some extra here: make the hierarchy needed, check exit status +if (! -d $outpath) { vsystem ("mkdir -p $outpath"); } + +open (MANA, "|mana --norc"); + +print MANA "macro mkmap\n"; +print MANA " rd a \$1\n"; +print MANA " keyword a NAXIS1 nx\n"; +print MANA " keyword a NAXIS2 ny\n"; +print MANA " medianmap a b {\$nx/$factor} {\$ny/$factor} -range 0.25 0.75\n"; +print MANA " wd b \$2\n"; +print MANA "end\n"; + +print MANA "macro go\n"; +for ($ccd = 0; $ccd < $Nccd; $ccd++) { + $infile = sprintf "%s/%s%02d.fits", $path, $root, $ccd; + $outfile = sprintf "%s/%s%02d.fits", $outpath, $root, $ccd; + print MANA " mkmap $infile $outfile\n"; +} +print MANA " exit 0\n"; +print MANA "end\n"; +print MANA "go\n"; +print MANA "exit 1\n"; +close (MANA); +if ($?) { + print STDERR "ERROR running mana\n"; + exit 1; +} + +print STDOUT "SUCCESS: finished with fr.detrend\n"; +exit 0; + +sub vsystem { + print STDERR "@_\n"; + $status = system ("@_"); + $status; +} + +sub goodbye { + die "@_\n"; +} + +sub usage { + print "\n"; + print "USAGE: fr.medbin (path) (root) (factor) (outpath)\n"; + print " path: path to MEF image or SPLIT dir\n"; + print " root: root name of image (MEF = root.fits, SPLIT = root/rootNN.fits)\n"; + print " mode: MEF or SPLIT\n"; + print " outdir: directory for output results (all split)\n"; + exit 1; +} + +# mana within perl: we embed the mana functions within a macro to trap the +# exit status. If mana has an error with one of the steps, it will exit the macros and +# the second exit will be called. Otherwise, the "go" macro will perform the exit 0 +# and mana will exit with status 0 Index: /tags/ohana/perl-1-3/Ohana/src/perl/old/fr.stats =================================================================== --- /tags/ohana/perl-1-3/Ohana/src/perl/old/fr.stats (revision 21906) +++ /tags/ohana/perl-1-3/Ohana/src/perl/old/fr.stats (revision 21906) @@ -0,0 +1,69 @@ +#!/usr/bin/env perl + +# check the usage +if ($ARGV[0] eq "-h") { &usage (); } +if ($ARGV[0] eq "-help") { &usage (); } +if (@ARGV != 5) { &usage (); } + +# assign the command line arguments +$list = $ARGV[0]; +$tenbin = $ARGV[1]; +$medbin = $ARGV[2]; +$stats = $ARGV[3]; +$range = $ARGV[4]; + +# check for files to be processed +@status = stat ($list); +if ($status[7] == 0) { + print STDERR "no files in source list, skipping\n"; + exit 1; +} + +# find the appropriate script file +$confdir = `gconfig -q CONFDIR`; chop ($confdir); +$script = "$confdir/mana/fringe.pro"; + +# test named Xserver, or start vnc on specified machine +$xhost=`gconfig -q XHOST`; chop ($xhost); +$xdisp=`gconfig -q XDISP`; chop ($xdisp); +if (vsystem ("xdpyinfo -display $xdisp")) { + print STDERR "X server is not running. start it now on $xhost\n"; + exit 1; +} +$ENV{'DISPLAY'} = $xdisp; + +# run mana script: +open (MANA, "|mana --norc"); +print MANA "input $script\n"; +print MANA "\$RANGE = $range\n"; +print MANA "fringelist $list $tenbin $medbin $stats\n"; +print MANA "exit 1\n"; +close (MANA); + +if ($?) { + print STDERR "ERROR problem with fr.stats\n"; + exit 1; +} + +print STDOUT "SUCCESS: finished with fr.stats\n"; +exit 0; + +sub vsystem { + print STDERR "@_\n"; + $status = system ("@_"); + $status; +} + +sub goodbye { + die "@_\n"; +} + +sub usage { + print "USAGE: fr.stats (list) (tenbin) (medbin) (stats) (range)\n"; + exit 1; +} + +# mana within perl: we embed the mana functions within a macro to trap the +# exit status. If mana has an error with one of the steps, it will exit the macros and +# the second exit will be called. Otherwise, the "go" macro will perform the exit 0 +# and mana will exit with status 0 Index: /tags/ohana/perl-1-3/Ohana/src/perl/old/fr.subset =================================================================== --- /tags/ohana/perl-1-3/Ohana/src/perl/old/fr.subset (revision 21906) +++ /tags/ohana/perl-1-3/Ohana/src/perl/old/fr.subset (revision 21906) @@ -0,0 +1,232 @@ +#!/usr/bin/env perl + +# check the usage +if ($ARGV[0] eq "-h") { usage (); } +if ($ARGV[0] eq "-help") { usage (); } +if (@ARGV != 3) { die "ERROR: USAGE: fr.subset (master) (outdir) (subset)\n" } + +$inlist = $ARGV[0]; +$outdir = $ARGV[1]; +$outlist= $ARGV[2]; + +print STDERR "ERROR: not fixed!!!\n"; +exit 1; + +# load in stats lines +open (FILE, "$ARGV[0]"); +@list = ; +close (FILE); + +open (FILE, ">$outlist"); + +foreach $line (@list) { + chop ($line); + + # the infile contains (path) (root) (mode) (flag) + ($path, $root, $mode, $stat) = split (" ", $line); + + if ($stat) { + + $basename = mk_basename ($path, $root, $mode); + $Nccd = gt_names ($basename, "Nccd", $mode); + + for ($ccd = 0; $ccd < $Nccd; $ccd++) { + + $outfile = mk_filename ($outdir, $root, "SPLIT", $ccd); + + print FILE "$outfile\n"; + + } + } +} +close (FILE); + +print STDERR "SUCCESS\n"; + +exit 0; + +######## cfht MEF/SPLIT name utilities ########### + +sub gt_names { + # in: filename mode type + # out: word + + my ($value); + + $value = ""; + if ($_[2] eq "MEF") { $value = mefnames ($_[0], $_[1]); } + if ($_[2] eq "SPLIT") { $value = splitnames ($_[0], $_[1]); } + + return $value; +} + +sub mefnames { + # in: (/path/file.fits) (mode) + # out: word + + my($fullname) = $_[0]; + my($mode) = $_[1]; + my($answer); + + # split rootdir and filename: + my (@words) = split ("/", $fullname); + $N = @words; + + if ($mode eq "path") { + $answer = ""; + for ($i = 0; $i < $N - 1; $i++) { + $answer = $answer . $words[$i] . "/"; + } + chop ($answer); # strip off last / + if ($answer eq "") { $answer = "."; } + return ($answer); + } + + if ($mode eq "root") { + $answer = "$words[$N-1]"; + $answer =~ s/.fits$//; + return ($answer); + } + + if ($mode eq "Nccd") { + if (! -e $fullname) { return 0; } + $answer = `echo $fullname | fields NEXTEND`; + @words = split (" ", $answer); + if ($words[1] eq "") { return 0; } + return ($words[1]); + } + + return (0); +} + +sub splitnames { + # in: (/path/file) (mode) + # out: word + # /path/file is directory containing Nccd fits images + + my($fullname) = $_[0]; + my($mode) = $_[1]; + my($answer, $N, $tmpname, @imlist, @words); + + # split rootdir and filename: + @words = split ("/", $fullname); + $N = @words; + + if ($mode eq "path") { + $answer = ""; + for ($i = 0; $i < $N - 1; $i++) { + $answer = $answer . $words[$i] . "/"; + } + chop ($answer); # strip off last / + if ($answer eq "") { $answer = "."; } + return ($answer); + } + + if ($mode eq "root") { + $answer = "$words[$N-1]"; + return ($answer); + } + + if ($mode eq "Nccd") { + + $tmpname = "$fullname/$words[$N-1]"; + @imlist = <$tmpname??.fits>; + + $Nccd = @imlist; + return $Nccd; + } + + return (0); +} + +sub ckimtype { + # in: (/path/file) + # out: MEF | SPLIT | SINGLE | (NULL) + + my ($answer, $name, $value); + my ($file) = $_[0]; + + if (! -e $file) { + print STDOUT "can't open file\n"; + return ""; + } + + # if /path/file is a directory, it is split: + if (-d $file) { return "SPLIT"; } + + # check that the file is a FITS image + $answer = `file -L $file`; + if ($?) { + print STDOUT "can't open file\n"; + return ""; + } + ($name, $value) = split (" ", $answer); + if ($value ne "FITS") { + print STDOUT "not a valid image\n"; + return ""; + } + + # check for NAXIS = 0 (MEF) + $answer = `echo $file | fields NAXIS`; + # if ($?) { return ""; } + ($name, $value) = split (" ", $answer); + if ($value eq 0) { return "MEF"; } + + if ($value == 2) { return "SINGLE"; } + + print STDOUT "not a valid image\n"; + return ""; +} + +sub mk_basename { + my ($path) = $_[0]; + my ($root) = $_[1]; + my ($mode) = $_[2]; + + if ($mode eq "MEF") { + $name = sprintf "%s/%s.fits", $path, $root; + return $name; + } + if ($mode eq "SPLIT") { + $name = sprintf "%s/%s", $path, $root; + return $name; + } + return ""; +} + +sub mk_filename { + my ($path) = $_[0]; + my ($root) = $_[1]; + my ($mode) = $_[2]; + my ($ccd) = $_[3]; + + if ($mode eq "MEF") { + $name = sprintf "%s/%s.fits", $path, $root; + return $name; + } + if ($mode eq "SPLIT") { + $name = sprintf "%s/%s/%s%02d.fits", $path, $root, $root, $ccd; + return $name; + } + return ""; +} + +sub vsystem { + print STDERR "@_\n"; + $status = system ("@_"); + $status; +} + +sub goodbye { + die "@_\n"; +} + +sub usage { + print "\n"; + print "USAGE: fr.detrend (path) (root) (mode) (outdir)\n"; + print " path: path to MEF image or SPLIT dir\n"; + print " root: root name of image (MEF = root.fits, SPLIT = root/rootNN.fits)\n"; + print " mode: MEF or SPLIT\n"; + print " outdir: directory for output results (all split)\n"; + exit 1; +} Index: /tags/ohana/perl-1-3/Ohana/src/perl/old/get.standards =================================================================== --- /tags/ohana/perl-1-3/Ohana/src/perl/old/get.standards (revision 21906) +++ /tags/ohana/perl-1-3/Ohana/src/perl/old/get.standards (revision 21906) @@ -0,0 +1,103 @@ +#!/usr/bin/env perl + +# this script is very much specific to the CFHT data layout + +$VERBOSE = 1; +$stdpath = "/h/archive/current/01aq97"; + +$run = "all"; +# grab the command line arguments: +@tARGV = (); +for (; @ARGV > 0; ) { + + # by default, all OBJECT images are returned. specify a run with -run + if ($ARGV[0] eq "-run") { + shift; + $run = $ARGV[0]; + shift; + next; + } + + @tARGV = (@tARGV, $ARGV[0]); + shift; +} +@ARGV = @tARGV; + +if (@ARGV != 0) { die "USAGE: ckrunid [-run RunID]\n" ;} + +# the archive is supposed to contain only MEF images. +# The standard star images might get a few focus or detrend images +# mixed in, so restrict the glob to only *o.fits images: +@imlist = <$stdpath/*o.fits>; + +# find date range in run list +foreach $name (@imlist) { + + if ($run eq "all") { + @outlist = (@outlist, $name); + next; + } + + $runid = `ckrunid $name`; + if ($?) { + if ($VERBOSE) { print STDERR "no crunid for $name\n"; } + next; + } + chop ($runid); + + if ($runid ne $run) { + if ($VERBOSE) { print STDERR "wrong crunid for $name ($runid vs $run)\n"; } + next; + } + + @outlist = (@outlist, $name); +} + +foreach $name (@outlist) { + print STDOUT "$name\n"; +} + +exit 0; + +################################################################################### + +sub vsystem { + print STDERR "@_\n"; + $status = system ("@_"); + $status; +} + +sub goodbye { + die "@_\n"; +} + +sub get_jd { + + my($year) = $_[0]; + my($month) = $_[1]; + my($day) = $_[2]; + + my($jd) = $day - 32075 + int (1461*($year + 4800 + int (($month - 14)/12))/4) + + int(367*($month - 2 - int(($month - 14)/12)*12)/12) + - int(3*int(($year + 4900 + int(($month - 14)/12))/100)/4) - 0.5; + + + return ($jd); + +} + +sub get_mjd { + + my($year) = $_[0]; + my($month) = $_[1]; + my($day) = $_[2]; + + my($jd) = $day - 32075 + int (1461*($year + 4800 + int (($month - 14)/12))/4) + + int(367*($month - 2 - int(($month - 14)/12)*12)/12) + - int(3*int(($year + 4900 + int(($month - 14)/12))/100)/4) - 0.5 - 2400000.5; + + + return ($jd); + +} + Index: /tags/ohana/perl-1-3/Ohana/src/perl/old/gtfringe =================================================================== --- /tags/ohana/perl-1-3/Ohana/src/perl/old/gtfringe (revision 21906) +++ /tags/ohana/perl-1-3/Ohana/src/perl/old/gtfringe (revision 21906) @@ -0,0 +1,80 @@ +#!/usr/bin/env perl + +if (@ARGV != 4) { die "USAGE: gtfringe (in.fits) (fringe.coords) (binning) (out.dat)\n"; } + +$input = $ARGV[0]; +$coords = $ARGV[1]; +$binning = $ARGV[2]; +$output = $ARGV[3]; + +# create temporary files: +$PARFILE = `mktemp /tmp/gtfringe.XXXXXX`; +$INFILE = `mktemp /tmp/@gtfringe.XXXXXX` +$OUTFILE = `mktemp /tmp/gtfringe.XXXXXX` + +# convert + +open (FILE, "$inlist"); +@mef = ; +close (FILE); + +@split = (); +foreach $name (@mef) { + chop ($name); + + # convert name /path/name.fits to /outdir/rootNN.fits + @words = split ("/", $name); + $root = $words[-1]; + $root =~ s/.fits//; + + $new = sprintf "%s/%s%02d.fits", $outdir, $root, $ccd; + push @split, $new; +} + +open (MANA, "|mana --norc"); + +# define the macro 'split' +print MANA "macro split\n"; +print MANA " rd a \$1 -n $ccd\n"; +print MANA " keyword a NAXIS1 nx\n"; +print MANA " keyword a NAXIS2 ny\n"; +print MANA " if ((\$nx == 2080) && (\$ny == 4128))\n"; +print MANA " wd a \$2 -bitpix 16 -bzero 32768 -bscale 1.0\n"; +print MANA " exec echo \$2 >> $outlist\n"; +print MANA " end\n"; +print MANA "end\n"; + +# create the macro 'go' with the commands +print MANA "macro go\n"; +for ($i = 0; $i < @mef; $i++) { + if (-e $split[$i]) { + print STDERR "$split[$i] exists, skipping\n"; + next; + } + print MANA " split $mef[$i] $split[$i]\n"; +} +# if the macro ends successfully, exit 0 +print MANA " exit 0\n"; +print MANA "end\n"; + +# if the macro exits before the end, exit 1 +print MANA "go\n"; +print MANA "exit 1\n"; +close (MANA); + +$status = $?; +print STDERR "mana exit status: $status\n"; +if ($status) { + print STDERR "ERROR: problem running split.mef\n"; + exit 1; +} + +print STDERR "SUCCESS\n"; +exit 0; + +sub vsystem { + print STDERR "@_\n"; + $status = system ("@_"); + $status; +} + Index: /tags/ohana/perl-1-3/Ohana/src/perl/old/images.names =================================================================== --- /tags/ohana/perl-1-3/Ohana/src/perl/old/images.names (revision 21906) +++ /tags/ohana/perl-1-3/Ohana/src/perl/old/images.names (revision 21906) @@ -0,0 +1,170 @@ +#!/usr/local/bin/perl + +$WANT = 0; + +# possible things to return: +$FILE = 1; +$PATH = 2; +$ROOT = 3; +$EXT = 4; +$NCCD = 5; +$CCD = 6; +$BASEEXT = 7; +$CCDLIST = 8; + +while (@ARGV) { + + $name = shift (@ARGV); + + # provided component(s) + if ($name eq "-file") { + $file = shift (@ARGV); + } + if ($name eq "-path") { + $path = shift (@ARGV); + } + if ($name eq "-root") { + $root = shift (@ARGV); + } + if ($name eq "-base") { + $base = shift (@ARGV); + } + if ($name eq "-ext") { + $ext = shift (@ARGV); + } + if ($name eq "-baseext") { + $baseext = shift (@ARGV); + } + if ($name eq "-Nccd") { + $Nccd = shift (@ARGV); + } + if ($name eq "-ccd") { + $ccd = shift (@ARGV); + } + if ($name eq "-mode") { + $mode = "\U$ARGV[0]\E"; + shift (@ARGV); + } + + # desired component + if ($name eq "+file") { + if ($WANT) { &badchoice; } + $WANT = $FILE; + } + if ($name eq "+path") { + if ($WANT) { &badchoice; } + $WANT = $PATH; + } + if ($name eq "+root") { + if ($WANT) { &badchoice; } + $WANT = $ROOT; + } + if ($name eq "+ext") { + if ($WANT) { &badchoice; } + $WANT = $EXT; + } + if ($name eq "+baseext") { + if ($WANT) { &badchoice; } + $WANT = $BASEEXT; + } + if ($name eq "+Nccd") { + if ($WANT) { &badchoice; } + $WANT = $NCCD; + } + if ($name eq "+ccd") { + if ($WANT) { &badchoice; } + $WANT = $CCD; + } + if ($name eq "+mode") { + if ($WANT) { &badchoice; } + $WANT = $MODE; + } +} + +if ($base eq "") { $base = $root; } +if ($root eq "") { $root = $base; } +if ($ext eq "") { $ext = "fits"; } +if ($path eq "") { $path = "."; } +if ($mode eq "") { $mode = "MEF"; } + +if (@ARGV != 0) { &usage; } +if (!$WANT) { &usage; } + +if (0) { + print STDERR "want: $WANT\n"; + print STDERR "file: $file\n"; + print STDERR "path: $path\n"; + print STDERR "root: $root\n"; + print STDERR "base: $base\n"; + print STDERR "ext: $ext\n"; + print STDERR "baseext: $baseext\n"; + print STDERR "Nccd: $Nccd\n"; + print STDERR "ccd: $ccd\n"; + print STDERR "mode: $mode\n"; +} + +if ($WANT == $FILE) { + if ($mode eq "SPLIT") { + $output = sprintf "%s/%s%s/%s%02d.%s", $path, $base, $baseext, $root, $ccd, $ext; + } + if ($mode eq "MEF") { + $output = sprintf "%s/%s%s.%s", $path, $base, $baseext, $ext; + } +} + +if ($WANT == $PATH) { + # split path and filename: + @words = split ("/", $file); + $N = @words; + + for ($i = 0; $i < $N - 1; $i++) { + $output = $output . $words[$i] . "/"; + } + chop ($output); # strip off last / +} + +if ($WANT == $CCD) { + # split path and filename: + @words = split ("/", $file); + $N = @words; + + for ($i = 0; $i < $N - 1; $i++) { + $output = $output . $words[$i] . "/"; + } + chop ($output); # strip off last / +} + +print STDOUT "$output\n"; +exit 0; + +# definition of the path components: + +# MEF: +# /path/root/base.ext + +# SPLIT: +# /path/root/base.ext + +# file = +# 1: /data/koa/cfh12k/01Ak01/543210f.fits +# 2: /data/koa/cfh12k/01Ak01/543210f/543210f00.fits +# 3: /data/koa/cfh12k/01Ak01/543210f.alt/543210f00.fits + +# base = 543210f +# path = /data/koa/cfh12k/01Ak01 +# root = 543210f (1,2), 543210f.alt (3) +# ext = fits +# ext = "" (1,2), ".alt" (3) +# Nccd = 12 [for CFH12K] +# ccd = NN (1), 00 (2,3) + +sub badchoice { + print STDERR "only one choice allowed\n"; + exit 1; +} + +sub usage { + print STDERR "USAGE: image.names [options]\n"; + exit 2; +} + Index: /tags/ohana/perl-1-3/Ohana/src/perl/old/imselect =================================================================== --- /tags/ohana/perl-1-3/Ohana/src/perl/old/imselect (revision 21906) +++ /tags/ohana/perl-1-3/Ohana/src/perl/old/imselect (revision 21906) @@ -0,0 +1,189 @@ +#!/usr/bin/env perl +$SKIPDOME = 0; + +sub vsystem { + print STDERR "@_\n"; + $status = system ("@_"); + $status; +} + +sub goodbye { + print STDERR "ending execution\n"; + die "@_"; +} + +if (@ARGV != 7) { die "ERROR: USAGE: imselect (ccd) (type) (filter) (tstart) (tend) (output) (-split | -mef)\n" } + +$type = "\U$ARGV[1]\E"; +if ($type eq "DARK") { } + +if ($type eq "FLAT") { + # define some of the relevant parameters + $min = 2000; + $max = 60000; + $minrate = 100; + $ratescale = 70; + $filter = "\U$ARGV[2]\E"; + if ($filter eq "B") { $minrate = 0.5 * $ratescale; } + if ($filter eq "V") { $minrate = 1.0 * $ratescale; } + if ($filter eq "R") { $minrate = 3.5 * $ratescale; } + if ($filter eq "I") { $minrate = 14.2 * $ratescale; } + if ($filter eq "Z") { $minrate = 10.5 * $ratescale; } + if ($filter eq "HA") { $min = 1000; } + if ($filter eq "HAOFF") { $min = 1000; } + # probably need to set these in a more intelligent fashion. +} + +# $ccd is ccd number (see camera config), $ARGV[0] is ccd id +$ccd = `cameraconfig -N $ARGV[0]`; chop ($ccd); +if ($ccd eq "") { die "ERROR : can't find CCD $ARGV[0]\n"; } + +$Nccd = `cameraconfig -Nccd`; chop ($Nccd); +$line = `cameraconfig -axes`; chop ($line); +($Naxis1, $Naxis2) = split (" ", $line); + +$mode = "none"; +if ($ARGV[6] eq "-split") { $mode = "split"; } +if ($ARGV[6] eq "-mef") { $mode = "mef"; } +if ($mode eq "none") { + die "ERROR: mode must be either -split or -mef\n"; +} + +@good = (); +@marginal = (); + +# define filter lines for imsearch. for flats, there may be alternate filter names to test +@filtline = (); +if ($type eq "FLAT") { + # convert given filter name to list of possible names: + $answer = `filtnames $ARGV[2] -all`; + @filtlist = split (" ", $answer); + + foreach $name (@filtlist) { + $line = "-type flat -filter $name -mode $mode -trange $ARGV[3] $ARGV[4]"; + push @filtline, $line; + } +} +if ($type eq "BIAS") { + push @filtline, "-type bias -mode $mode -trange $ARGV[3] $ARGV[4]"; +} +if ($type eq "DARK") { + push @filtline, "-type dark -etime $ARGV[2] -mode $mode -trange $ARGV[3] $ARGV[4]"; +} + +# run selection on each possible $filtline +@list = (); +foreach $line (@filtline) { + @tlist = `imsearch -ccd $ccd $line`; + @list = (@list, @tlist); +} +$Nlist = @list; +print STDERR "found $Nlist images\n"; + +for ($i = 0; $i < $Nlist; $i++) { + @words = split (" ",$list[$i]); + + if ($SKIPDOME) { + # a fairly lame and non-robust way to detect dome flats + if ($type eq "FLAT") { + @answer = `echo $words[4]/$words[5] | fields OBJECT | grep -i dome`; + if ($answer[0] ne "") { print STDERR "$words[5] rejected: dome flat\n"; next; } + } + } + + if ($mode eq "split") { + # all $Nccd images must exist on disk, split files are assumed to be + # in a subdirectory of their own, .fits extension assumed + @answer = <$words[4]/*.fits>; + if (@answer != $Nccd) { print STDERR "$words[5] rejected: missing images\n"; next; } + } + + # images have to have the correct dimensions + if ($mode eq "split") { + @answer = `echo $words[4]/$words[5] | fields NAXIS1 NAXIS2`; + @wds = split (" ",$answer[0]); + $Nx = $wds[1]; $Ny = $wds[2]; + } else { + @answer = `ftable -X 1 $words[4]/$words[5] | grep "^NAXIS1"`; + @wds = split (" ",$answer[0]); + $Nx = $wds[2]; + @answer = `ftable -X 1 $words[4]/$words[5] | grep "^NAXIS2"`; + @wds = split (" ",$answer[0]); + $Ny = $wds[2]; + } + if (($Nx != $Naxis1) || ($Ny != $Naxis2)) { print STDERR "$words[5] rejected: wrong dimensions\n"; next; } + + # $match is a word unique to the full mosaic image (the rootdir for split, the image for mef) + if ($mode eq "split") { + @answer = split ("/", $words[4]); + $match = $answer[-1]; + } else { + $match = $words[5]; + } + @list2 = `imsearch -name $match`; + $Nlist2 = @list2; + print STDERR "$match: $Nlist2\n"; + if (@list2 != $Nccd) { + print STDERR "$words[5] rejected: missing entries in image database\n"; + next; + } + + if ($type eq "FLAT") { + + if ($SKIPDOME) { + # test for acceptable time (or is probably a dome flat) + @answer = `dusktime $words[8]`; + @wds = split (" ",$answer[0]); + if ($wds[2] < 0) { print STDERR "$words[5] rejected: not twilight\n"; next; } + } + + $range = 1; + $rate = 1; + + # check for counts or flux out of range or any chip + for ($j = 0; $rate && $range && ($j < @list2); $j++) { + @words2 = split (" ", $list2[$j]); + + # test for acceptable flux range + if ($words2[11] < $min) { $range = 0; print STDERR "$words[5] rejected: signal too low: $words2[11] vs $min\n"; next; } + if ($words2[11] > $max) { $range = 0; print STDERR "$words[5] rejected: signal too high: $words2[11] vs $max\n"; next; } + + # test for acceptable rate + if (($words2[11] / $words2[7]) < $minrate) { + $rate = 0; + $F = $words2[11] / $words2[7]; + print STDERR "$words[5] rejected: flux too low: $F vs $minrate\n"; next; } + } + if (!$range) { next; } + + @marginal = (@marginal, "$words[4]/$words[5]"); + if (!$rate) { next; } + } else { + @marginal = (@marginal, "$words[4]/$words[5]"); + } + + @good = (@good, "$words[4]/$words[5]"); +} + +open (LIST, ">$ARGV[5]"); +if (@good > 5) { + for ($i = 0; $i < @good; $i++) { + print LIST "$good[$i]\n"; + if (($type eq "BIAS") && ($i > 30)) { last; } + if (($type eq "DARK") && ($i > 30)) { last; } + } +} else { + print STDERR "warning: limited number of flat images, scraping the bottom\n"; + for ($i = 0; $i < @marginal; $i++) { + print LIST "$marginal[$i]\n"; + } +} +close (LIST); +print STDERR "SUCCESS\n"; +exit 0; + +# we need to select the list of images which satisfy a few criteria: +# 1) all 12 CCDs must exist +# 2) stats must be measured for each +# 3) stats for all 12 must be within range (2000 - 40000) +# 4) NAXIS1 == 2080 && NAXIS2 == 4128 Index: /tags/ohana/perl-1-3/Ohana/src/perl/old/merge.lists =================================================================== --- /tags/ohana/perl-1-3/Ohana/src/perl/old/merge.lists (revision 21906) +++ /tags/ohana/perl-1-3/Ohana/src/perl/old/merge.lists (revision 21906) @@ -0,0 +1,92 @@ +#!/usr/bin/env perl + +$update = 0; + +# grab the command line arguments: +@tARGV = (); +for (; @ARGV > 0; ) { + + # new images get mode of 0, old image keep their mode + if ($ARGV[0] eq "-update") { + shift; + $update = 1; + next; + } + + @tARGV = (@tARGV, $ARGV[0]); + shift; +} +@ARGV = @tARGV; + +if (@ARGV != 3) { die "USAGE: merge.lists (list.split) (list.msplit) (list.master) [-update]\n" ;} + +# load names from SPLIT and MEF +open (FILE, "$ARGV[0]"); +@split = ; +close (FILE); + +open (FILE, "$ARGV[1]"); +@mef = ; +close (FILE); + +# load old names from MASTER +open (FILE, "$ARGV[2]"); +@master = ; +close (FILE); + +# merge new entries into a single list, compare with state in master +@names = (@split, @mef); + +@newname = (); +@newmode = (); + +for ($i = 0; $i < @names; $i++) { + + $name = $names[$i]; chop ($name); + + $mode = 1; + if ($update) { + $mode = 0; + + INNER: + foreach $line (@master) { + @words = split (" ", $line); + if ($words[0] eq $name) { + $mode = $words[1]; + last INNER; + } + } + } + @newname = (@newname, $name); + @newmode = (@newmode, $mode); +} + +if (! @newname) { + print STDERR "ERROR: no relevant ccd images\n"; + exit 1; +} + +# check on list: if there are none selected, select all +$Ngood = 0; +foreach $mode (@newmode) { + if ($mode) { + $Ngood ++; + } +} +if ($Ngood == 0) { + foreach $mode (@newmode) { + $mode = 1; + } +} + +open (FILE, ">$ARGV[2]"); +for ($i = 0; $i < @newname; $i++) { + print FILE "$newname[$i] $newmode[$i]\n"; +} +close (FILE); + +# this file must be accessible by www user +chmod 0666, $ARGV[2]; + +print STDOUT "SUCCESS\n"; +exit 0; Index: /tags/ohana/perl-1-3/Ohana/src/perl/old/mkptolemy.names =================================================================== --- /tags/ohana/perl-1-3/Ohana/src/perl/old/mkptolemy.names (revision 21906) +++ /tags/ohana/perl-1-3/Ohana/src/perl/old/mkptolemy.names (revision 21906) @@ -0,0 +1,71 @@ +#!/usr/bin/env perl + +$Nccd = 12; + +if (@ARGV != 3) { die "USAGE: mkptolemy.names (name) (mode) (dir)\n" ;} + +$name = $ARGV[0]; +$mode = "\U$ARGV[1]\E"; +$dir = $ARGV[2]; + +unless ($name =~ /^\d\d\d\d\d\d\w$/) { + print STDERR "name does not match the expected format 555555o\n"; + exit 1; +} + +for ($ccd = 0; $ccd < $Nccd; $ccd++) { + + if ($mode eq "MEF") { + printf "%s/%s.fits %s/%s%02d %02d MEF\n", $dir, $name, $name, $name, $ccd, $ccd; + } + + if ($mode eq "SPLIT") { + printf "%s/%s/%s%02d.fits %s/%s%02d %02d MEF\n", $dir, $name, $name, $ccd, $name, $name, $ccd, $ccd; + } + +} + +exit 0; + +################################################################################### + +sub vsystem { + print STDERR "@_\n"; + $status = system ("@_"); + $status; +} + +sub goodbye { + die "@_\n"; +} + +sub get_jd { + + my($year) = $_[0]; + my($month) = $_[1]; + my($day) = $_[2]; + + my($jd) = $day - 32075 + int (1461*($year + 4800 + int (($month - 14)/12))/4) + + int(367*($month - 2 - int(($month - 14)/12)*12)/12) + - int(3*int(($year + 4900 + int(($month - 14)/12))/100)/4) - 0.5; + + + return ($jd); + +} + +sub get_mjd { + + my($year) = $_[0]; + my($month) = $_[1]; + my($day) = $_[2]; + + my($jd) = $day - 32075 + int (1461*($year + 4800 + int (($month - 14)/12))/4) + + int(367*($month - 2 - int(($month - 14)/12)*12)/12) + - int(3*int(($year + 4900 + int(($month - 14)/12))/100)/4) - 0.5 - 2400000.5; + + + return ($jd); + +} + Index: /tags/ohana/perl-1-3/Ohana/src/perl/old/prepare.run =================================================================== --- /tags/ohana/perl-1-3/Ohana/src/perl/old/prepare.run (revision 21906) +++ /tags/ohana/perl-1-3/Ohana/src/perl/old/prepare.run (revision 21906) @@ -0,0 +1,349 @@ +#!/usr/bin/env perl + +# global vars: +$atmach = "druid.cfht.hawaii.edu"; +$runlist = ""; +@runlist = (); + +# check usage +if (@ARGV < 1) { + print STDOUT "USAGE: mkrun (mode) [arguments]\n"; + print STDOUT " mkrun help gives a complete list\n"; + &goodbye; +} +if ($ARGV[0] eq "help") { &usage; } + +&set_globals; + +# call appropriate command +if ($ARGV[0] eq "create") { &create (@ARGV); } +if ($ARGV[0] eq "addqso") { &addqso (@ARGV); } +if ($ARGV[0] eq "delqso") { &delqso (@ARGV); } +if ($ARGV[0] eq "status") { &status; } +if ($ARGV[0] eq "sched") { &sched (@ARGV); } + +print STDOUT "invalid mkrun command\n"; +exit 1; + +sub status { + + &load_runlist; + foreach $line (@runlist) { + print STDOUT "$line\n"; + } + exit 0; +} + +############ +sub create { + + my (@argv) = @_; + + if (@argv != 4) { + print STDOUT "USAGE: mkrun create (run) (start) (stop)\n"; + exit 2; + } + + $runid = $argv[1]; + $start = $argv[2]; + $stop = $argv[3]; + + &load_runlist; + + $line = grab_runline ($runid); + ($Orunid, $Ostart, $Ostop, $qrunid) = split (" ", $line); + $line = mk_runline ($runid, $start, $stop, $qrunid); + insert_runline ($line); + + &save_runlist; + exit 0; +} + +############ +sub addqso { + + my (@argv) = @_; + + if (@argv != 3) { + print STDOUT "USAGE: mkrun addqso (run) (qsorun)\n"; + exit 2; + } + + $runid = $argv[1]; + $qrunid = $argv[2]; + + &load_runlist; + + $line = grab_runline ($runid); + if ($line eq "") { + print STDERR "run id $runid not in run list\n"; + exit 1; + } + ($runid, $start, $stop, $Oqrunid) = split (" ", $line, 4); + if ($Oqrunid) { + $qrunid = $Oqrunid . " " . $qrunid; + } + + $line = mk_runline ($runid, $start, $stop, $qrunid); + insert_runline ($line); + + &save_runlist; + exit 0; +} + +############ +sub delqso { + my (@argv) = @_; + if (@argv != 2) { + print STDOUT "USAGE: mkrun addqso (qsorun)\n"; + exit 2; + } + + $qrunid = $argv[1]; + + &load_runlist; + + # find listed qrunid + $match = ""; + SEARCH: + foreach $line (@runlist) { + if ($line =~ /^\#/) { next; } # skip commented lines + ($tmp, $tmp, $tmp, $qlist) = split (" ", $line, 4); + @qlist = split (" ", $qlist); + foreach $qid (@qlist) { + if ($qrunid ne $qid) { next; } + $match = $line; + last SEARCH; + } + } + if ($match eq "") { + print STDERR "QSO run id $qrunid not found in run list\n"; + exit 1; + } + + # recreate $qlist without $qrunid + $qlist = ""; + foreach $qid (@qlist) { + if ($qid eq $qrunid) { next; } + $qlist = $qlist . $qid . " "; + } + + ($runid, $start, $stop) = split (" ", $match); + + $line = mk_runline ($runid, $start, $stop, $qlist); + insert_runline ($line); + + &save_runlist; + exit 0; +} + +############## + +sub sched { + my (@argv) = @_; + if (@argv != 2) { + print STDOUT "USAGE: mkrun sched (runid)\n"; + exit 2; + } + + $runid = $argv[1]; + &load_runlist; + + $line = grab_runline ($runid); + ($runid, $start, $stop, $qlist) = split (" ", $line, 4); + + at_loop ($runid, $start, $stop); + + exit 0; +} + +############## +sub at_loop { + my ($runid, $start, $stop); + $runid = $_[0]; + $start = $_[1]; + $stop = $_[2]; + + $mjd_start = date_to_mjd ($start); + $mjd_stop = date_to_mjd ($stop); + + $Nday = $mjd_stop - $mjd_start; + + ($year, $month, $day) = $start =~ /(\d+)\/(\d+)\/(\d+)/; + for ($Day = -1; $Day < $Nday; $Day++) { + + # 'at' needs date in format MM/DD/YYYY or DD.MM.YYYY + $tday = $day + $Day; + $date = `date -d $year/$month/$tday +%m/%d/%Y`; chop ($date); + + if ($Day == -1) { + atcommand ("clear.rawdir -current >& /h/eugene/cfh12k/logs/clear.log &", "10:00", $date); + } + + if ($Day == 0) { + atcommand ("echo RUNID $runid > /h/cfh12k/elixir.run", "10:00", $date); + atcommand ("mkdetrend create $runid $start $stop >& /h/eugene/cfh12k/logs/mkdetrend.log", "10:05", $date); + atcommand ("mkfringe config $runid >& /h/eugene/cfh12k/logs/mkdetrend.log", "10:10", $date); + atcommand ("mkfringe mkconfig $runid >& /h/eugene/cfh12k/logs/mkdetrend.log", "10:15", $date); + + atcommand ("elixir -D mode imstats >& /h/eugene/cfh12k/logs/imstats.log &", "15:00", $date); + atcommand ("elixir -D mode sextract >& /h/eugene/cfh12k/logs/ptolemy.log &", "15:00", $date); + atcommand ("gettemps &", "15:00", $date); + atcommand ("elixir.report &", "15:00", $date); + } + + if (($Day > 0) && ($Day < 4)) { + atcommand ("mkdetrend init >& /h/eugene/cfh12k/logs/mkdetrend.log; mkdetrend run >& /h/eugene/cfh12k/logs/mkdetrend.log", "07:00", $date); + } + if ($Day >= 4) { + atcommand ("mkdetrend update >& /h/eugene/cfh12k/logs/mkdetrend.log", "07:00", $date); + } + if ($Day > 0) { + # atcommand ("clear /h/cfh12k/images/elixir", "12:00", $date); + } + } +} + +####### runlist utilities ############################ +sub load_runlist { + open (FILE, "$runlist"); + @runlist = ; + foreach $line (@runlist) { + chop ($line); + } + close (FILE); +} + +sub save_runlist { + open (FILE, ">$runlist"); + foreach $line (@runlist) { + print FILE "$line\n"; + } + close (FILE); +} + +sub grab_runline { + my ($id) = $_[0]; + my ($line); + my ($runid); + + foreach $line (@runlist) { + if ($line =~ /^\#/) { next; } # skip commented lines + ($runid) = split (" ", $line); + if ($runid ne $id) { next; } + return ($line); + } + return (""); +} + +sub insert_runline { + my ($runline) = $_[0]; + my ($line); + my ($runid, $id); + + # match the run id lines + ($id) = split (" ", $runline); + foreach $line (@runlist) { + if ($line =~ /^\#/) { next; } # skip commented lines + ($runid) = split (" ", $line); + if ($runid ne $id) { next; } + $line = $runline; + return 1; + } + @runlist = (@runlist, $runline); + return 0; +} + +sub mk_runline { + my ($runid, $start, $stop, $qrunid, $line); + $runid = $_[0]; + $start = $_[1]; + $stop = $_[2]; + $qrunid = $_[3]; + + $start = date_format ($start); + $stop = date_format ($stop); + $line = sprintf "%s %s %s %s", $runid, $start, $stop, $qrunid; + return ($line); +} + +# utilities ############################################## + +sub atcommand { + my ($cmd, $time, $date); + $cmd = $_[0]; + $time = $_[1]; + $date = $_[2]; + + $line = sprintf "echo %s | at %s %s", $cmd, $time, $date; + print STDOUT "$line\n"; +} + + +sub vsystem { + # print STDERR "@_\n"; + my($status) = system ("@_"); + $status; +} + +sub goodbye { + die "@_\n"; +} + +sub date_format { + my ($date) = $_[0]; + my ($year, $month, $day); + + ($year, $month, $day) = $date =~ /(\d+)\/(\d+)\/(\d+)/; + $date = sprintf "%4d/%02d/%02d", $year, $month, $day; + return ($date); +} + +sub date_to_mjd { + my ($date) = $_[0]; + my ($year, $month, $day, $mjd); + + ($year, $month, $day) = $date =~ /(\d+)\/(\d+)\/(\d+)/; + $mjd = get_mjd ($year, $month, $day); + + return ($mjd); +} + +sub get_mjd { + + my($year) = $_[0]; + my($month) = $_[1]; + my($day) = $_[2]; + + my($jd) = $day - 32075 + int (1461*($year + 4800 + int (($month - 14)/12))/4) + + int(367*($month - 2 - int(($month - 14)/12)*12)/12) + - int(3*int(($year + 4900 + int(($month - 14)/12))/100)/4) - 0.5 - 2400000.5; + + + return ($jd); + +} + +sub set_globals { + + # this should come fron the config system +# $runlist = "/data/milo/eugene/elixir/refs/cfh12k.runs"; + $runlist = "/h/eugene/test.runs"; +} + +sub usage { + + if (@ARGV == 1) { + print STDERR "\n --- user modes ---\n"; + print STDERR "create (run) (start) (stop)\n"; + print STDERR "addqso (runid) (qsoid)\n"; + print STDERR "delqso (qsoid)\n"; + print STDERR "sched (runid)\n"; + print STDERR "status\n"; + &goodbye; + } + + if (@ARGV > 2) { print STDERR "USAGE: prepare.run (help) [mode]\n"; &goodbye; } + + &goodbye; +} Index: /tags/ohana/perl-1-3/Ohana/src/perl/old/pt.run =================================================================== --- /tags/ohana/perl-1-3/Ohana/src/perl/old/pt.run (revision 21906) +++ /tags/ohana/perl-1-3/Ohana/src/perl/old/pt.run (revision 21906) @@ -0,0 +1,66 @@ +#!/usr/bin/env perl + +# USAGE: pt.run (obsid) + +if (@ARGV != 1) { die "USAGE: ckvalid (obsid)\n" ;} + +$obsid = $ARGV[0]; +$archive = "/h/archive/current/instrument/cfh12k"; + +# find the run id for this image +$runid = `ckrunid $archive/$obsid.fits`; +if ($?) { + print STDOUT "$obsid: no run ID\n"; + exit 1; +} +chop ($runid); + +# try to use the flt files, if they exist, for headers +$tmpdir = "/data/elixir2/cfh12k/tmpdata/$runid/$obsid"; + +print "$tmpdir\n"; + +@flt = <$tmpdir/*.flt>; +$Nflt = @flt; +if ($Nflt != 12) { + print STDOUT "not enough *.flt files ($Nflt)\n"; + @smp = <$tmpdir/*.smp>; + if (@smp == 12) { + print STDOUT "using old *.smp files\n"; + @flt = (); + foreach $smp (@smp) { + $flt = $smp; + $flt =~ s/smp/flt/; + vsystem ("cp $smp $flt"); + @flt = (@flt, "$flt"); + } + } else { + exit 1; + } +} + +foreach $flt (@flt) { + $smp = $flt; + $smp =~ s/flt/smp/; + + $sx = $flt; + $sx =~ s/flt/sx/; + + vsystem ("imclean -sex $flt $sx $smp"); + vsystem ("gastro -v $smp"); + + # imclean -sex *.flt *.sx *.smp + # gastro -v *.smp +} + +exit 0; + +sub vsystem { + print STDERR "@_\n"; + my($status) = system ("@_"); + $status; +} + +sub goodbye { + die "@_\n"; +} Index: /tags/ohana/perl-1-3/Ohana/src/perl/old/scheduler =================================================================== --- /tags/ohana/perl-1-3/Ohana/src/perl/old/scheduler (revision 21906) +++ /tags/ohana/perl-1-3/Ohana/src/perl/old/scheduler (revision 21906) @@ -0,0 +1,248 @@ +#!/usr/bin/env perl + +$ENV{'PATH'} = "$ENV{'PATH'}:/apps/elixir/bin"; + +$schedule = `gconfig SCHEDULE`; chop $schedule; +$logdir = `gconfig LOGDIR`; chop $logdir; +$log = "$logdir/scheduler.log"; +$window = 0.02; # ~0.5 hours. +$machine = "milo.cfht.hawaii.edu"; + +$LIST = 0; +$ALL = 0; +$RUN = 0; + +# execute any event which is within the time range: +# $last + $window < event < NOW + $window + +# check usage +if ($ARGV[0] eq "help") { &usage; } +if ($ARGV[0] eq "all") { &list_all; } +if ($ARGV[0] eq "list") { &list_active; } +if ($ARGV[0] eq "run") { &run_active; } +if ($ARGV[0] eq "clear") { &clear_all; } +print STDERR "scheduler command '$ARGV[0]' not found\n"; +&usage; + +sub list_active { + + &set_current_time; # set $NOWdate, $NOWtime $NOWmjd + &load_schedule; # load into @list + &find_previous; # set $last (last runtime) + &find_active; # fill @execute & @cmdlogs for active commands + + for ($i = 0; $i < @execute; $i++) { + print "$execute[$i] ($cmdlogs[$i])\n"; + } + exit 0; +} + +sub run_active { + + &set_current_time; + &load_schedule; + &find_previous; + &find_active; + + # re-create schedule with new PREVIOUS: + if (@list && (-e "$schedule")) { + system ("cp $schedule $schedule~"); + open (FILE, ">$schedule"); + foreach $line (@list) { + if ($line =~ /^\s*PREVIOUS/) { + printf FILE "PREVIOUS %s %s\n", $NOWdate, $NOWtime; + next; + } + + print FILE "$line"; + } + close (FILE); + } else { + # create a new schedule with PREVIOUS set to NEVER + print STDERR "creating $schedule\n"; + open (FILE, ">$schedule"); + print FILE "# schedule for scheduler system\n"; + print FILE "# E. Magnier\n"; + print FILE "\n"; + print FILE "# last time scheduler was run:\n"; + printf FILE "PREVIOUS %s %s\n", $NOWdate, $NOWtime; + print FILE "\n"; + close (FILE); + } + + # launch commands one-by-one in background + for ($i = 0; $i < @execute; $i++) { + docommand ($cmdlogs[$i], $execute[$i]); + system ("sleep 60"); + } + exit 0; +} + +# utilities ############################################## + +sub docommand { + my ($log, $cmd); + $log = $_[0]; + $cmd = $_[1]; + + $line = sprintf "scheduler.exec $log \"$cmd\" "; + vsystem ($line); +} + + +sub vsystem { + print STDERR "@_\n"; + my($status) = system ("@_"); + $status; +} + +sub goodbye { + die "@_\n"; +} + +sub load_schedule { + open (FILE, "$schedule"); + @list = ; + close (FILE); +} + +sub clear_all { + if (-e $schedule) { + vsystem ("cp $schedule $schedule~"); + vsystem ("rm $schedule"); + } + exit 0; +} + +sub find_previous { + $last = 0; + $date = "NEVER"; + # find previous runtime: + foreach $line (@list) { + if ($line =~ /^\#/) { next; } # skip commented lines + unless ($line =~ /^\s*PREVIOUS/) { next; } + + ($tmp, $date, $time) = split (" ", $line); + if ($date eq "NEVER") { + $last = 0; + last; + } + $last = timedate_to_mjd ($time, $date); + last; + } + print STDERR "run scheduler: $NOWdate $NOWtime (prev: $date $time)\n"; +} + +sub find_active { + + @execute = (); + @cmdlogs = (); + # find relevant commands + foreach $line (@list) { + if ($line =~ /^\#/) { next; } # skip commented lines + if ($line =~ /^\s*PREVIOUS/) { next; } + + ($date, $time, $cmdlog, $command) = split (" ", $line, 4); + if ($command eq "") { next; } + chop ($command); + + $mjd = timedate_to_mjd ($time, $date); + + if ($last + $window > $mjd) { next; } + if ($NOWmjd + $window < $mjd) { next; } + + @cmdlogs = (@cmdlogs, $cmdlog); + @execute = (@execute, $command); + } + +} + +sub set_current_time { + + ($sec, $min, $hour, $day, $mon, $year) = localtime (); + $mon += 1; + $year += 1900; + $NOWdate = sprintf "%s/%02d/%02d", $year, $mon, $day; + $NOWtime = sprintf "%02d:%02d:%02d", $hour, $min, $sec; + $NOWmjd = timedate_to_mjd ($NOWtime, $NOWdate); +} + +sub date_format { + my ($date) = $_[0]; + my ($year, $month, $day); + + ($year, $month, $day) = $date =~ /(\d+)\/(\d+)\/(\d+)/; + $date = sprintf "%4d/%02d/%02d", $year, $month, $day; + return ($date); +} + +sub timedate_to_mjd { + my ($time) = $_[0]; + my ($date) = $_[1]; + my ($mjd, $day); + + $mjd = date_to_mjd ($date); + $day += time_to_day ($time); + + $mjd += $day; + return ($mjd); +} + + +sub date_to_mjd { + my ($date) = $_[0]; + my ($year, $month, $day, $mjd); + + ($year, $month, $day) = $date =~ /(\d+)\/(\d+)\/(\d+)/; + $mjd = get_mjd ($year, $month, $day); + + return ($mjd); +} + +sub time_to_day { + my ($time) = $_[0]; + my ($hour, $min, $sec, $days); + + ($hour, $min, $sec) = split (":", $time); + $day = $hour / 24.0 + $min / 1440.0 + $sec / 86400.0; + + return ($day); +} + +sub get_mjd { + + my($year) = $_[0]; + my($month) = $_[1]; + my($day) = $_[2]; + + my($jd) = $day - 32075 + int (1461*($year + 4800 + int (($month - 14)/12))/4) + + int(367*($month - 2 - int(($month - 14)/12)*12)/12) + - int(3*int(($year + 4900 + int(($month - 14)/12))/100)/4) - 0.5 - 2400000.5; + + + return ($jd); + +} + +sub list_all { + + # load schedule: + open (FILE, "$schedule"); + @list = ; + close (FILE); + + foreach $line (@list) { + print "$line"; + } + exit 0; +} + +sub usage { + + print STDERR "USAGE: scheduler [mode]\n"; + print STDERR " list : list all active commands\n"; + print STDERR " all : list all commands\n"; + print STDERR " run : execute active commands\n"; + print STDERR " clear : delete schedule\n"; + &goodbye; +} Index: /tags/ohana/perl-1-3/Ohana/src/perl/old/scheduler.exec =================================================================== --- /tags/ohana/perl-1-3/Ohana/src/perl/old/scheduler.exec (revision 21906) +++ /tags/ohana/perl-1-3/Ohana/src/perl/old/scheduler.exec (revision 21906) @@ -0,0 +1,21 @@ +#!/bin/csh -f + +set logdir = `gconfig LOGDIR` +set log = "$logdir/scheduler.log" + +if ($#argv < 2) then + echo "USAGE: scheduler.exec (logfile) (cmd)" + exit 2; +endif + +set cmdlog = $1 +shift + +set start=`date` +echo "start: $start - $*" >> $log + +csh -c "$*" >>& $cmdlog +set stat=$status + +set stop=`date` +echo "stop: $stop $stat $*" >> $log Index: /tags/ohana/perl-1-3/Ohana/src/perl/old/validate-1.0 =================================================================== --- /tags/ohana/perl-1-3/Ohana/src/perl/old/validate-1.0 (revision 21906) +++ /tags/ohana/perl-1-3/Ohana/src/perl/old/validate-1.0 (revision 21906) @@ -0,0 +1,287 @@ +#!/usr/bin/env perl + +# validate +# -update sends the validation value to the QSO database +# 1 - valid image +# 2 - subvalid image (problem, but doesn't matter) +# 3 - invalid image +# 4 - data error (missing, corrupted image) + +# global constants: + +$TRUE = 1; +$FALSE = 0; +$RETRY = $TRUE; + +$MODE_UNSET = 0; +$MODE_VALID = 1; +$MODE_SUBVALID = 2; +$MODE_INVALID = 3; +$MODE_DATAERR = 4; + +$infile = ""; +$update = $FALSE; +# put this in the CONFIG file: +$runlist = "/data/milo/eugene/elixir/refs/cfh12k.runs"; + +# include the CFHT bin directory in the path so we have access to QSO functions: +$ENV{'PATH'} = "$ENV{'PATH'}:/cfht/bin"; + +# grab the command line arguments: +@tARGV = (); +for (; @ARGV > 0; ) { + + if ($ARGV[0] eq "-update") { + shift; + $update = $TRUE; + next; + } + if ($ARGV[0] eq "-skip") { + shift; + $RETRY = $FALSE; + next; + } + if ($ARGV[0] eq "-infile") { + shift; + $infile = $ARGV[0]; + shift; + next; + } + + @tARGV = (@tARGV, $ARGV[0]); + shift; +} +@ARGV = @tARGV; + +if (@ARGV != 1) { die "USAGE: validate (crunid) [-infile filename] [-update]\n" ;} + +$crunid = $ARGV[0]; + +# find qso run id for this camera run id: +open (FILE, "$runlist"); +@list = ; +close (FILE); + +# find date range in run list +foreach $line (@list) { + chop ($line); + if ($line =~ /^\#/) { next; } + ($Crunid, $start, $stop, $Qrunid) = split (" ", $line, 4); + if (($start eq "") || ($stop eq "")) { next; } + if ($Crunid eq $crunid) { $qrunid = $Qrunid; last; } +} + +print STDERR "qso run ID(s): $qrunid\n"; + +@valid = (); +@invalid = (); +@dataerr = (); +@subvalid = (); + +if ($infile) { + # load images from previous output run or source file: + open (FILE, $infile); + @rawlist = ; + close (FILE); + + $mode = $MODE_UNSET; + @imlist = (); + + RAWLIST: + foreach $name (@rawlist) { + chop ($name); + + if ($name eq "") { next RAWLIST; } + + if ($name =~ /^valid images/) { + $mode = $MODE_VALID; + next RAWLIST; + } + if ($name =~ /^invalid images/) { + $mode = $MODE_INVALID; + next RAWLIST; + } + if ($name =~ /^subvalid images/) { + $mode = $MODE_SUBVALID; + next RAWLIST; + } + if ($name =~ /^dataerr images/) { + $mode = $MODE_DATAERR; + next RAWLIST; + } + + # plain list of image names (/path/name.fits) + if ($mode == $MODE_UNSET) { + # double check on name validity + ($file, $junk) = split (" ", $name, 2); + unless ($file =~ /\d\d\d\d\d\d\w/) { print STDERR "?"; next RAWLIST; } + @imlist = (@imlist, $file); + next RAWLIST; + # if (! -e $file) { print STDERR "x"; next RAWLIST; } + } + # place image names in the appropriate list + if ($mode == $MODE_VALID) { + ($file, $result) = split (":", $name, 2); + @valid = (@valid, $file); + next RAWLIST; + } + if ($mode == $MODE_INVALID) { + ($file, $result) = split (":", $name, 2); + @invalid = (@invalid, $file); + next RAWLIST; + } + if ($mode == $MODE_SUBVALID) { + ($file, $result) = split (":", $name, 2); + @subvalid = (@subvalid, $file); + next RAWLIST; + } + if ($mode == $MODE_DATAERR) { + ($file, $result) = split (":", $name, 2); + @dataerr = (@dataerr, $file); + next RAWLIST; + } + } +} else { + # load images directly from directory + # this is not sufficient. we need a better way to get a list of images for + # a given run id (with the current MEF / SPLIT state correct). + # + # probably we can just use imsearch -ccd 0 + $rawdir = `gconfig -q -D RUNID $crunid RAWDIR`; + chop ($rawdir); + if ($rawdir eq "") { + print STDERR "can't find config entry TMPDIR\n"; + exit 1; + } + @imlist = (); + + # load in the MEF files (must be of format 123456x.fits) + @tlist = <$rawdir/*.fits>; + foreach $tname (@tlist) { + if ((-f $tname) && ($tname =~ /\d\d\d\d\d\d\w.fits/)) { + @imlist = (@imlist, $tname); + } + } + + # load in the SPLIT directories (must be of format 123456x) + @tlist = <$rawdir/???????>; + foreach $tname (@tlist) { + if ((-d $tname) && ($tname =~ /\d\d\d\d\d\d\w/)) { + @imlist = (@imlist, $tname); + } + } +} + +# load the QSO validated image list +@qsovalid = (); +if ($qrunid) { + @qruns = split (" ", $qrunid); + @qsovalid = (); + foreach $id (@qruns) { + print STDERR "trying $id\n"; + @answer = `select_val_xexp.sh -U qso_elixir -P op1eliw -qrunid $id`; + if ($?) { + print STDERR "error in qso run ID\n"; + exit 1; + } + @qsovalid = (@qsovalid, @answer); + } +} +foreach $qname (@qsovalid) { chop ($qname); } + +if ($RETRY) { +# evaluate the remaining entries in imlist & invalid: + @imlist = (@imlist, @invalid, @dataerr); + @invalid = (); + @dataerr = (); + + IMLIST: + foreach $name (@imlist) { + $answer = `ckvalid $name`; + if ($?) { print STDERR "error with $name\n"; } + chop ($answer); + + ($file, $result) = split (" ", $answer, 2); + @words = split (" ", $answer); + + if ($words[1] eq "pass") { + @valid = (@valid, $answer); + next IMLIST; + } + + if ($result eq "binned image") { + @subvalid = (@subvalid, $answer); + next IMLIST; + } + + if ($result eq "sub-rastered image") { + @subvalid = (@subvalid, $answer); + next IMLIST; + } + + if ($result eq "wrong image type") { + @subvalid = (@subvalid, $answer); + next IMLIST; + } + + if ($result eq "can't open file") { + @dataerr = (@dataerr, $answer); + next IMLIST; + } + + if ($result eq "no run ID") { + @dataerr = (@dataerr, $answer); + next IMLIST; + } + + if ($result eq "not a valid image") { + @dataerr = (@dataerr, $answer); + next IMLIST; + } + + if ($words[1] eq "fail") { + foreach $line (@qsovalid) { + ($qname, $qmode, $emode) = split (" ", $line); + if ($name =~ /$qname/) { + @invalid = (@invalid, $answer); + next IMLIST; + } + } + @subvalid = (@subvalid, $answer); + next IMLIST; + } + + print STDERR "unknown result $answer\n"; + + } +} + +@mode = ('valid', 'subvalid', 'invalid', 'dataerr'); +@code = ($MODE_VALID, $MODE_SUBVALID, $MODE_INVALID, $MODE_DATAERR); + +for ($i = 0; $i < @mode; $i++) { + $mode = $mode[$i]; + $code = $code[$i]; + + print STDOUT "$mode images\n"; + foreach $file (@$mode) { + print STDOUT "$file\n"; + if ($update) { + @w = split ("/", $file); + $n = substr ($w[-1], 0, 6); + vsystem ("update_xexpe.sh -U qso_elixir -P op1eliw --obsid $n --eval $code >> test.list"); + } + } + print STDOUT "\n"; +} + +sub vsystem { + print STDERR "@_\n"; + my($status) = system ("@_"); + $status; +} + +sub goodbye { + die "@_\n"; +} + Index: /tags/ohana/perl-1-3/Ohana/src/perl/src/cadc2qso =================================================================== --- /tags/ohana/perl-1-3/Ohana/src/perl/src/cadc2qso (revision 21906) +++ /tags/ohana/perl-1-3/Ohana/src/perl/src/cadc2qso (revision 21906) @@ -0,0 +1,46 @@ +#!/usr/local/bin/perl +# extract mosaic IQ values from table, send to QSO db + +sub vsystem { + print STDERR "@_\n"; + $status = system ("@_"); + $status; +} + +sub goodbye { + die "@_\n"; +} + +if (@ARGV != 1) { die "USAGE: cadc2qso (table.fits)\n"; } + +# update the following entries to the QSO database (one per mosaic): + +# --iq_center (OBS_IQ_CENTER) +# --iq_r_ratio (OBS_IQ_R_RATIO) +# --iq_x_ratio (OBS_IQ_X_RATIO) +# --iq_y_ratio (OBS_IQ_Y_RATIO) + +# add error checking on the ftable call... +@obsid = `ftable -column OBSID $ARGV[0]`; +@iqcen = `ftable -column OBS_IQ_CENTER $ARGV[0]`; +@iqr = `ftable -column OBS_IQ_R_RATIO $ARGV[0]`; +@iqx = `ftable -column OBS_IQ_X_RATIO $ARGV[0]`; +@iqy = `ftable -column OBS_IQ_Y_RATIO $ARGV[0]`; + +foreach $value (@obsid) { chop $value; } +foreach $value (@iqcen) { chop $value; } +foreach $value (@iqr) { chop $value; } +foreach $value (@iqx) { chop $value; } +foreach $value (@iqy) { chop $value; } + +$Nrow = @obsid; +if ($Nrow != @iqcen) { &goodbye ("error in OBS_IQ_CENTER"); } +if ($Nrow != @iqr) { &goodbye ("error in OBS_IQ_R_RATIO"); } +if ($Nrow != @iqx) { &goodbye ("error in OBS_IQ_X_RATIO"); } +if ($Nrow != @iqy) { &goodbye ("error in OBS_IQ_Y_RATIO"); } + +for ($i = 0; $i < $Nrow; $i++) { + vsystem ("/cfht/bin/update_xexpe.sh -U qso_elixir -P op1eliw --obsid $obsid[$i] --iq_center $iqcen[$i] --iq_r_ratio $iqr[$i] --iq_x_ratio $iqx[$i] --iq_y_ratio $iqy[$i]"); +} +print STDOUT "SUCCESS: done with $ARGV[0]\n"; +exit (0); Index: /tags/ohana/perl-1-3/Ohana/src/perl/src/cfht.names =================================================================== --- /tags/ohana/perl-1-3/Ohana/src/perl/src/cfht.names (revision 21906) +++ /tags/ohana/perl-1-3/Ohana/src/perl/src/cfht.names (revision 21906) @@ -0,0 +1,49 @@ +#!/usr/bin/env perl + +if (@ARGV != 1) { + print STDERR "USAGE: cfht.names (file)\n"; + exit 2; +} + +# given (filename) : return (path) (name) (mef) + +if (! -e $ARGV[0]) { + print STDERR "file $ARGV[0] not found\n"; + exit 1; +} + +$fullname = $ARGV[0]; + +# if we get a relative path, add cwd: +@words = split ("/", $ARGV[0]); +if ($words[0] ne "") { + $cwd=`pwd`; + chop ($cwd); + $fullname = "$cwd/$ARGV[0]"; +} +# we are now guaranteed to have a /complete/path/filename + +# if file is a directory, we assume it is split: +if (-d $fullname) { + $mef = "off"; +} else { + $mef = "on"; +} + +# split path and filename: +$path = "/"; +@words = split ("/", $fullname); +$N = @words; +for ($i = 1; $i < $N - 1; $i++) { + $path = $path . $words[$i] . "/"; +} +chop ($path); # strip off last / + +$file = $words[$N-1]; + +if ($mef eq "on") { + $file =~ s/.fits$//; +} + +print STDOUT "$path $file $mef\n"; +exit 0; Index: /tags/ohana/perl-1-3/Ohana/src/perl/src/checkconfig =================================================================== --- /tags/ohana/perl-1-3/Ohana/src/perl/src/checkconfig (revision 21906) +++ /tags/ohana/perl-1-3/Ohana/src/perl/src/checkconfig (revision 21906) @@ -0,0 +1,464 @@ +#!/usr/bin/env perl + +@ARGV = &elixir_config (@ARGV); +if (@ARGV == 0) { &usage; } + +&pnotice; +&pnotice ("current run ID: $run"); +&pnotice ("current camera: $camera"); +&pnotice; + +{ # check for valid camera + if ($camera eq "cfh12k") { last; } + if ($camera eq "cfhtir") { last; } + if ($camera eq "megacam") { last; } + if ($camera eq "meganorth") { last; } + &escape ("camera $camera not supported, skipping"); +} + +if ($ARGV[0] eq "init") { + &ck_dirs; + &ck_flocks; + &ck_fifos; + + if ($camera eq "cfh12k") { &ck_detrend; } + if ($camera eq "megacam") { &ck_detrend; } + if ($camera eq "meganorth") { &ck_detrend; } + &goodbye; +} +# if ($ARGV[0] eq "unlock") { &ck_dirs; &ck_flocks; &cl_locks; &goodbye; } + +&escape ("checkconfig command $ARGV[0] not valid"); + +### main user functions + +# check state of directories +sub ck_detrend { + + $answer = `mkdetrend state -camera $camera -run $run`; + if ($VERBOSE) { + &pnotice ("checking mkdetrend system"); + push @notices, $answer; + } + if ($?) { + &pnotice ("define mkdetrend $camera $run"); + $answer = `mkdetrend create run $run`; + if ($?) { + &pwarning ("can't define mkdetrend $camera $run"); + push @warnings, $answer; + } + } + + $answer = `mkfringe state -camera $camera -run $run`; + if ($VERBOSE) { + &pnotice ("checking mkfringe system"); + push @notices, $answer; + } + if ($?) { + &pnotice ("define mkfringe $camera $run"); + $answer = `mkfringe create run $run`; + if ($?) { + &pwarning ("can't define mkfringe $camera $run"); + push @warnings, $answer; + } + } +} + +sub ck_dirs { + my ($i, @dirs, @need); + + @dirs = ('RAWDIR', 'TMPDIR', 'HDXDIR', 'CATDIR', 'DATDIR', 'FIFOS'); + @need = ( 20, 5, 1, 0.2, 2, 0); + + if ($VERBOSE) { + foreach $dir (@dirs) { + $filename = `gconfig $dir`; chop ($filename); + &pnotice ("check $dir : $filename"); + } + &pnotice; + } + + for ($i = 0; $i < @dirs; $i++) { + checkdir ($dirs[$i], 0777, $need[$i]); + } + if ($VERBOSE) { &pnotice; } + return 0; +} + +# check state of files with locks +sub ck_flocks { + + @files = ('REGISTRATION_DATABASE'); + foreach $file (@files) { + &checklocks ($file, 0666); + } + if ($VERBOSE) { &pnotice; } +} + +# check elixir fifo files +sub ck_fifos { + @elixirs = ('imstats', 'ptolemy'); + @fifos = ('global.source', 'global.msg', 'global.end'); + + foreach $elixir (@elixirs) { + if ($VERBOSE) { &pnotice ("check fifos for elixir $elixir"); } + foreach $fifo (@fifos) { + $filename = `gconfig -D mode $elixir $fifo`; chop ($filename); + setmode ($filename, 0666); + } + } + if ($VERBOSE) { &pnotice; } +} + +sub cl_locks { + + @files = ('REGISTRATION_DATABASE'); + foreach $file (@files) { + + $filename = `gconfig $file`; chop ($filename); + $lock = lockname ($filename); + + if (!cklock ($lock) && $unlock) { setlock ($lock); } + } +} + +sub ckelixir { + my($elixir) = $_[0]; + + if ($VERBOSE) { &pnotice ("Checking on Elixir $elixir"); } + + $answer = `elixir -status -D mode $elixir`; + if ($?) { } + if ($VERBOSE) { push @notices, $answer; } + + return (1); +} + +# check that directory exists, create it if not, set permissions +sub checkdir { + # in: dir-key, mode, bytes + # out: status + + my ($dir) = $_[0]; + my ($mode) = $_[1]; + my ($bytes) = $_[2]; + my ($status); + + # set camera, runid from .current + $filename = `gconfig $dir`; chop ($filename); + + # this will make a dir if the parent doesn't exist. + if (! -e $filename) { + $status = mkdirhier ($filename, $mode); + if (!$status) { + &pwarning ("can't create directory $filename ($dir)"); + return 0; + } + } + + # set mode to desired value + if (!ckmode ($filename, $mode)) { + if (!chmod $mode, $filename) { + &pwarning ("can't set permissions on $filename ($dir)"); + return 0; + } + } + + # check available space + if ($bytes) { + $left = `sdf $filename`; + $left = sprintf "%5.1f", ($left / 1024 / 1024); + if ($VERBOSE) { &pnotice ("$dir : $left GB free : $filename"); } + if ($left < $bytes) { + &pwarning ("$filename ($dir) is getting full"); + return 0; + } + } + return 1; +} + +# check existence & permissions on file & corresponding lockfile +sub checklocks { + + my ($file) = $_[0]; + my ($mode) = $_[1]; + + $filename = `gconfig $file`; chop ($filename); + $lock = lockname ($filename); + + if ($VERBOSE) { &pnotice ("check $file ($filename)"); } + + # create file if it does not exist + setmode ($filename, $mode); + + # create file if it does not exist + setmode ($lock, $mode); + + return 1; +} + +# basic utilities + +sub lockname { + # in: path/file + # out: path/.file.lck + + my($lock, $N, $i); + + @words = split ("/", $_[0]); + + $lock = ""; + $N = @words - 1; + for ($i = 0; $i < $N; $i++) { + $lock = $lock . $words[$i] . "/"; + } + $lock = $lock . "." . "$words[$N]" . ".lck"; + + return ($lock); +} + +sub ckmode { + # in: file mode + # out: yes/no + + $filename = $_[0]; + $mode = $_[1]; + $setmode = $mode; + + unless (@fstat = stat ($filename)) { + if ($VERBOSE) { &pwarning ("$filename not found"); } + return 0; + } + + $fmode = 07777 & $fstat[2]; + $status = !($setmode ^ $fmode); + + if (!$status && $VERBOSE) { + $line = sprintf "$filename has wrong mode: %o vs %o\n", $fmode, $setmode; + &pnotice ($line); + } + + return ($status); +} + +sub cklock { + # in: file + # out: yes/no + + $filename = $_[0]; + + if (! -e $filename) { return (1); } + + open (FILE, $filename); + $word = ; + close (FILE); + + unless ($word =~ /^IDLE/) { + &pwarning ("$filename is locked"); + return 0; + } + + return 1; +} + +# create file & set mode +sub setmode { + # in: file mode + # out: yes/no + + $filename = $_[0]; + $mode = $_[1]; + + if (! -e $filename) { + if (!open (FILE, ">$filename")) { + &pwarning ("can't create file $filename"); + return 0; + } + close (FILE); + } + + if (!ckmode ($filename, $mode)) { + if (!chmod $mode, $filename) { + &pwarning ("can't set mode on $filename"); + return 0; + } + } + + return 1; +} + +sub setlock { + # in: file + # out: yes/no + + $filename = $_[0]; + + unless (open (FILE, ">$filename")) { + &pwarning ("can't set lock $filename"); + return 0; + } + print FILE "IDLE"; + close (FILE); + return 1; +} + +sub mkdirhier { + # in: directory mode + # out: status + + my ($dir) = $_[0]; + my ($mode) = $_[1]; + my (@words, $first, $last, $i, $part); + + @words = split ("/", $dir); + + foreach $level (@words) { + if ($level eq "") { $part = "/"; next; } + $part = $part . $level; + + if (-e $part && !-d $part) { return 0; } + if (! -e $part && !mkdir ($part, $mode)) { return 0; } + chmod $mode, $part; + + $part = $part . "/"; + } + return 1; +} + +sub usage { + print STDERR "USAGE: checkconfig [command]\n"; + print STDERR " check elixir configuration & files\n"; + exit 2; +} + +sub escape { + &dump_output; + if ($_[0]) { print "$_[0]\n"; } + unlink $tmpenv; + exit 1; +} + +sub goodbye { + &dump_output; + if ($_[0]) { print "$_[0]\n"; } + unlink $tmpenv; + exit 0; +} + +sub pwarning { + push @warnings, $_[0]; +} + +sub pnotice { + push @notices, $_[0]; +} + +sub dump_output { + # output to screen + if (@warnings) { + print STDERR "\n--- problem with elixir system checkconfig --\n\n"; + foreach $line (@warnings) { print STDERR "$line\n"; } + print STDERR "\n--- checkconfig output ---\n"; + } + foreach $line (@notices) { print STDERR "$line\n"; } + + if ($notify && @warnings) { + $answer = `mkrun sys notify`; + @list = split (",", $answer); + open (MAIL, "|mail -s 'elixir checkconfig error' @list"); + print MAIL "problem with elixir system checkconfig:\n"; + foreach $line (@warnings) { print MAIL "$line\n"; } + print MAIL "\n--- checkconfig output ---\n"; + foreach $line (@notices) { print MAIL "$line\n"; } + close (MAIL); + } +} + +# grab complete configuration info from the elixir config system, +# applying appropriate command-line arguments +sub elixir_config { + my (@argv) = @_; + my ($opt, $config, @tmparg, $status); + $config = ""; + if ($ENV{'PTOLEMY'}) { $config = "-c $ENV{'PTOLEMY'}"; } + umask (0); + $notify = 0; + $VERBOSE = 0; + + # look for optional command-line arguments + @tmparg = @argv; + foreach (@tmparg) { + $value = shift @argv; + + if ($value eq "-h") { &usage; } + if ($value eq "--help") { &usage; } + + if ($value eq "-c") { + $value = shift @argv; + $config = "-c $value"; + next; + } + + if ($value eq "-C") { + push @opt, $value; + $value = shift @argv; + push @opt, $value; + $elconf = $value; + next; + } + + if ($value eq "-C") { + push @opt, $value; + $value = shift @argv; + push @opt, $value; + $value = shift @argv; + push @opt, $value; + next; + } + + if ($value eq "-run") { + $run = shift @argv; + push @opt, "-D RUNID.CURRENT $run -D RUNID $run"; + next; + } + if ($value eq "-camera") { + $camera = shift @argv; + push @opt, "-D CAMERA.CURRENT $camera -D CAMERA $camera"; + next; + } + if ($value eq "-notify") { + $notify = 1; + next; + } + if ($value eq "-v") { + $VERBOSE = 1; + next; + } + push @argv, $value; + } + + # load RUNID from state.data (unless set on command line) + if ($run eq "") { + $run = `gconfig RUNID.CURRENT`; chop $run; + if ($?) { &escape ("run is not defined: use 'mkrun sys'\n"); } + if ($run eq "") { &escape ("run is not defined: use 'mkrun sys'\n"); } + push @opt, "-D RUNID.CURRENT $run -D RUNID $run"; + } + + # load CAMERA from state.data (unless set on command line) + if ($camera eq "") { + $camera = `gconfig CAMERA.CURRENT`; chop $camera; + if ($?) { &escape ("camera is not defined: use 'mkrun sys' to set\n"); } + if ($camera eq "") { &escape ("camera is not defined: use 'mkrun sys'\n"); } + push @opt, "-D CAMERA.CURRENT $camera -D CAMERA $camera"; + } + + # set env PTOLEMY using values from command line + $config = join (" ", $config, @opt); + $tmpenv = `mktemp /tmp/elixir.XXXXXX`; chop ($tmpenv); + $status = system ("gconfig -raw $config > $tmpenv"); + if ($status) { &escape ("error in elixir configuration: gconfig fails"); } + $ENV{'PTOLEMY'} = "$tmpenv"; + + return (@argv); +} Index: /tags/ohana/perl-1-3/Ohana/src/perl/src/ckastrom =================================================================== --- /tags/ohana/perl-1-3/Ohana/src/perl/src/ckastrom (revision 21906) +++ /tags/ohana/perl-1-3/Ohana/src/perl/src/ckastrom (revision 21906) @@ -0,0 +1,58 @@ +#!/usr/bin/env perl + +# we need a mechanism to define the appropriate ext value + +if (@ARGV != 3) { die "USAGE: ckastrom (run) (root) (Nccd)\n" ;} + +$runid = $ARGV[0]; +$root = $ARGV[1]; +$Nccd = $ARGV[2]; + +$tmpdir = `gconfig -q -D RUNID $runid HDXDIR`; chop ($tmpdir); +if ($?) { + print STDERR "can't find config entry HDXDIR\n"; + exit 1; +} +chop ($runid); + +$Nbad = 0; +$Nmiss = 0; +for ($ccd = 0; $ccd < $Nccd; $ccd++) { + + $found = 0; + + $name = sprintf "%s/%s/%s%02d.hdx", $tmpdir, $root, $root, $ccd; + if (-e $name) { + $found = 1; + $answer = `echo $name | fields NASTRO`; + @words = split (" ", $answer); + if ($words[1] > 0) { next; } + } + + if (! $found) { $Nmiss ++; } + $Nbad ++; +} + +if (!$Nbad) { + print STDOUT "pass\n"; + exit 0; +} +if ($Nbad < 0.4*$Nccd) { + print STDOUT "pass $Nbad bad\n"; + exit 0; +} +print STDOUT "$Nbad bad\n"; +exit 1; + +# utilities ############################ + +sub vsystem { + print STDERR "@_\n"; + $status = system ("@_"); + $status; +} + +sub goodbye { + die "@_\n"; +} + Index: /tags/ohana/perl-1-3/Ohana/src/perl/src/ckdetrend =================================================================== --- /tags/ohana/perl-1-3/Ohana/src/perl/src/ckdetrend (revision 21906) +++ /tags/ohana/perl-1-3/Ohana/src/perl/src/ckdetrend (revision 21906) @@ -0,0 +1,55 @@ +#!/usr/bin/env perl + +# the specific CCD is specified on the command line + +if ((@ARGV != 3) && (@ARGV != 4)) { die "USAGE: ckdetrend (name) (ccd) (mode) [-fringe]\n" ;} + +$fringe = 0; +if (@ARGV == 4) { $fringe = 1; } + +$name = $ARGV[0]; +$ccd = $ARGV[1]; +$mode = "\U$ARGV[2]\E"; + +if (($mode ne "SPLIT") && ($mode ne "MEF")) { + print STDERR "mode must be SPLIT or MEF\n"; + exit (2); +} + +if ($fringe) { + @type = ("fringe"); +} else { + @type = ("mask", "bias", "dark", "flat"); +} + +@missing = (); + +foreach $type (@type) { + if (vsystem ("detsearch -image $name $ccd $mode -type $type")) { + print STDERR "can't find $type\n"; + @missing = (@missing, $type); + } +} + +if (@missing) { + print STDOUT "$name fails, missing: @missing\n"; + exit 1; +} else { + print STDOUT "$name: pass\n"; + exit 0; +} + +# utilities ############################ + +sub vsystem { + print STDERR "@_\n"; + $status = system ("@_"); + $status; +} + +sub goodbye { + die "@_\n"; +} + +### this is no needed anymore - superceeded by detsearch -mosaic filename.fits -recipe + Index: /tags/ohana/perl-1-3/Ohana/src/perl/src/ckimregdb =================================================================== --- /tags/ohana/perl-1-3/Ohana/src/perl/src/ckimregdb (revision 21906) +++ /tags/ohana/perl-1-3/Ohana/src/perl/src/ckimregdb (revision 21906) @@ -0,0 +1,116 @@ +#!/usr/bin/env perl + +# this script deals with: +# - archived images which have not been reported to elixir, +# - images which need to be reprocessed, +# - images which can be send to CADC + +if (@ARGV != 2) { die "USAGE: ckimregdb (start) (range)\n" ;} + +# imsearch and ardrange12k have different default hr:mn:sc values +# this script converts to the ardrange12k defaults: 12:00:00 + +# WARNING: define a ref CCD for seeing + +# test for current camera? + +system ("gconfig CAMERA"); +exit; + +$start = $ARGV[0]; +$range = $ARGV[1]; + +# force explicit starting hours: +@words = split (/\D/, $start); +if (@words == 3) { $start = "$start,12:00:00"; } +@words = split (/\D/, $range); +if (@words == 3) { $range = "$range,12:00:00"; } + +# get list of images in the archive & imreg.db: +if ($range =~ m|^-\d+[dhms]|) { + $answer = `/h/archive/sw/tools/ardrange12k $start$range`; +} else { + $answer = `/h/archive/sw/tools/ardrange12k $start+$range`; +} + +@ccds = split (" ", `cameraconfig -ccds`); +if ($?) { &escape ("error with elixir camera configuration"); } + +@archive = split (" ", $answer); +$N = @archive; +print "archive: $N files\n"; + +@imregdb = `imsearch -ccd $ccds[0] -trange $start $range -tz 10.0`; +$N = @imregdb; +print "imregdb: $N files\n"; + +# search for missing images in archive + ARCH: foreach $arch (@archive) { + + # is $arch in @imregdb? + foreach $imreg (@imregdb) { + @words = split (" ", $imreg); + if ($arch eq $words[5]) { next ARCH; } + } + + push @missing, $arch; + } + +$Nmiss = @missing; +print "$Nmiss files missing\n"; + +# link each missing image in /data/kapu/elixir/cfh12k: +$linkdir = `gconfig $opts ARCLINK_DIR`; chop $linkdir; +if ($?) { die "error in config system: missing ARCLINK_DIR\n"; } + +$archive = `gconfig $opts ARCHIVE_DIR`; chop $archive; +if ($?) { die "error in config system: missing ARCHIVE_DIR\n"; } + +# add missing links, elixir.link will add them to db +foreach $file (@missing) { + + print STDERR "link: $file\n"; + $arcfile = sprintf "%s/%s", $archive, $file; + $linkfile = sprintf "%s/%s", $linkdir, $file; + + if (-l $linkfile) { + print STDERR "$linkfile exists, skipping\n"; + next; + } + symlink ($linkfile, $arcfile); +} + +# at this point, imstats from the last night is still running +# the unprocessed images and the newly linked images will be +# added to the imstats fifo (not ptolemy, don't bother!) + +# find images which need to be re-processed (entire run) +$runid = `gconfig RUNID.CURRENT`; chop $runid; +$answer = `mkrun run $runid`; +($tmp, $start, $stop) = split (" ", $answer); + +$fifo = `gconfig imstats`; chop $fifo; + +# the db lookup may take a long time or fail, the cat probably won't +system ("imsearch -trange $start $stop -proc f > $fifo.tmp"); +if (! -s "$fifo.tmp") { + system ("glockfile $fifo.source xcld 5 &"); + system ("cat $fifo.tmp >> $fifo.source"); +} + +# generate table of images which can be sent to CADC, mark as distributed: +system ("imsearch -ccd $ccds[3] -trange $start $stop -proc t -dist f -cadctable cadc.fits"); +system ("imsearch -ccd $ccds[3] -trange $start $stop -proc t -dist f -modify dist t"); + +# utilities ############################ + +sub vsystem { + print STDERR "@_\n"; + $status = system ("@_"); + $status; +} + +sub goodbye { + die "@_\n"; +} + Index: /tags/ohana/perl-1-3/Ohana/src/perl/src/ckphotom =================================================================== --- /tags/ohana/perl-1-3/Ohana/src/perl/src/ckphotom (revision 21906) +++ /tags/ohana/perl-1-3/Ohana/src/perl/src/ckphotom (revision 21906) @@ -0,0 +1,35 @@ +#!/usr/bin/env perl + +# the specific ccd is passed in from outside + +if (@ARGV != 3) { die "USAGE: ckphotom (name) (ccd) (mode)\n" ;} + +$name = $ARGV[0]; +$ccd = $ARGV[1]; +$mode = "\U$ARGV[2]\E"; + +if (($mode ne "SPLIT") && ($mode ne "MEF")) { + print STDERR "mode must be SPLIT or MEF\n"; + exit (2); +} + +if (vsystem ("photsearch -trans -image $name $ccd $mode -equiv")) { + print STDOUT "$name fails, no photom data\n"; + exit 1; +} else { + print STDOUT "$name: pass\n"; + exit 0; +} + +# utilities ############################ + +sub vsystem { +# print STDERR "@_\n"; + $status = system ("@_"); + $status; +} + +sub goodbye { + die "@_\n"; +} + Index: /tags/ohana/perl-1-3/Ohana/src/perl/src/ckrunid =================================================================== --- /tags/ohana/perl-1-3/Ohana/src/perl/src/ckrunid (revision 21906) +++ /tags/ohana/perl-1-3/Ohana/src/perl/src/ckrunid (revision 21906) @@ -0,0 +1,228 @@ +#!/usr/bin/env perl + +# USAGE: ckrunid (name) +# (name) may be a MEF or SINGLE CCD file or a SPLIT directory +# does not depend on the number of CCDs in the image + +if (@ARGV != 1) { die "USAGE: ckrunid (name)\n" ;} + +$name = $ARGV[0]; +$imtype = ckimtype ($name); +if (!$imtype) { exit 1; } + +if ($imtype eq SPLIT) { + $root = gt_names ($name, "root", $imtype); + $tmpname = "$name/$root" . "00.fits"; +} else { + $tmpname = $name; +} + +# need to abstract MJD-OBS keywrod +$answer = `echo $tmpname | fields MJD-OBS`; chop ($answer); +($fullname, $mjd_obs) = split (" ", $answer); +if ($mjd_obs eq "") { + print STDOUT "MJD-OBS not found in header for $tmpname\n"; + exit 1; +} + +$date = mjd_to_date ($mjd_obs); +print STDERR "date: $date\n"; + +$runinfo = `mkrun date $date`; +if ($?) { die "no run defined $date $mjd\n"; } + +($crunid, $start, $stop, $camera, $qrunid) = split (" ", $runinfo); +print STDOUT "$crunid\n"; +exit 0; + +################################################################################### + +sub vsystem { + print STDERR "@_\n"; + $status = system ("@_"); + $status; +} + +sub goodbye { + die "@_\n"; +} + +sub get_jd { + + my($year) = $_[0]; + my($month) = $_[1]; + my($day) = $_[2]; + + my($jd) = $day - 32075 + int (1461*($year + 4800 + int (($month - 14)/12))/4) + + int(367*($month - 2 - int(($month - 14)/12)*12)/12) + - int(3*int(($year + 4900 + int(($month - 14)/12))/100)/4) - 0.5; + + + return ($jd); + +} + +sub get_mjd { + + my($year) = $_[0]; + my($month) = $_[1]; + my($day) = $_[2]; + + my($jd) = $day - 32075 + int (1461*($year + 4800 + int (($month - 14)/12))/4) + + int(367*($month - 2 - int(($month - 14)/12)*12)/12) + - int(3*int(($year + 4900 + int(($month - 14)/12))/100)/4) - 0.5 - 2400000.5; + + + return ($jd); + +} + +sub mjd_to_date { + my ($mjd) = $_[0]; + my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday); + my ($date, $time); + + $time = 86400 * ($mjd - 40587.0); + ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday) = gmtime ($time); + $year += 1900; + $mon ++; + + $date = sprintf "%04d/%02d/%02d,%02d:%02d:%04.1f", $year, $mon, $mday, $hour, $min, $sec; + + return $date; +} + +sub gt_names { + # in: filename mode type + # out: word + + my ($value); + + $value = ""; + if ($_[2] eq "MEF") { $value = mefnames ($_[0], $_[1]); } + if ($_[2] eq "SPLIT") { $value = splitnames ($_[0], $_[1]); } + + return $value; +} + +sub mefnames { + # in: (/path/file.fits) (mode) + # out: word + + my($fullname) = $_[0]; + my($mode) = $_[1]; + my($answer); + + # split rootdir and filename: + my (@words) = split ("/", $fullname); + $N = @words; + + if ($mode eq "path") { + $answer = ""; + for ($i = 0; $i < $N - 1; $i++) { + $answer = $answer . $words[$i] . "/"; + } + chop ($answer); # strip off last / + if ($answer eq "") { $answer = "."; } + return ($answer); + } + + if ($mode eq "root") { + $answer = "$words[$N-1]"; + $answer =~ s/.fits$//; + return ($answer); + } + + if ($mode eq "Nccd") { + if (! -e $fullname) { + return (0); + } + $answer = `echo $fullname | fields NEXTEND`; + @words = split (" ", $answer); + if ($words[1] eq "") { + return (0); + } + return ($words[1]); + } + + return (0); +} + +sub splitnames { + # in: (/path/file) (mode) + # out: word + # /path/file is directory containing Nccd fits images + + my($fullname) = $_[0]; + my($mode) = $_[1]; + my($answer, $N, $tmpname, @imlist, @words); + + # split rootdir and filename: + @words = split ("/", $fullname); + $N = @words; + + if ($mode eq "path") { + $answer = ""; + for ($i = 0; $i < $N - 1; $i++) { + $answer = $answer . $words[$i] . "/"; + } + chop ($answer); # strip off last / + if ($answer eq "") { $answer = "."; } + return ($answer); + } + + if ($mode eq "root") { + $answer = "$words[$N-1]"; + return ($answer); + } + + if ($mode eq "Nccd") { + + $tmpname = "$fullname/$words[$N-1]"; + @imlist = <$tmpname??.fits>; + + $Nccd = @imlist; + return $Nccd; + } + + return (0); +} + +sub ckimtype { + # in: (/path/file) + # out: MEF | SPLIT | SINGLE | (NULL) + + my ($answer, $name, $value); + my ($file) = $_[0]; + + if (! -e $file) { + print STDOUT "can't open file\n"; + return ""; + } + + # if /path/file is a directory, it is split: + if (-d $file) { return "SPLIT"; } + + # check that the file is a FITS image + $answer = `file -L $file`; + if ($?) { + print STDOUT "can't open file\n"; + return ""; + } + ($name, $value) = split (" ", $answer); + if ($value ne "FITS") { + print STDOUT "not a valid image\n"; + return ""; + } + + # check for NAXIS = 0 (MEF) + $answer = `echo $file | fields NAXIS`; + # if ($?) { return ""; } + ($name, $value) = split (" ", $answer); + if ($value eq 0) { return "MEF"; } + + if ($value == 2) { return "SINGLE"; } + + print STDOUT "not a valid image\n"; + return ""; +} Index: /tags/ohana/perl-1-3/Ohana/src/perl/src/ckvalid =================================================================== --- /tags/ohana/perl-1-3/Ohana/src/perl/src/ckvalid (revision 21906) +++ /tags/ohana/perl-1-3/Ohana/src/perl/src/ckvalid (revision 21906) @@ -0,0 +1,302 @@ +#!/usr/bin/env perl + +$PASS = 0; +$FAIL = 1; +$SUBVALID = 2; +$DATA_ERR = 3; +$VERBOSE = 0; + +$eval{DATA} = 0; # image exists and is full-raster object MEF or SPLIT type +$eval{DETREND} = 0; # all needed detrend files exist for this image +$eval{FRINGES} = 0; # fringe frames exists if needed +$eval{ASTROM} = 0; # astrometry measured for at least N / 12 chips +$eval{PHOTOM} = 0; # photometry terms available for this image + +# USAGE: ckvalid (filename) +# (filename) may be a MEF file or a SPLIT directory +# [see end for notes] + +@tARGV = (); +while (@ARGV) { + if ($ARGV[0] eq "-v") { + $VERBOSE = 1; + shift @ARGV; + next; + } + @tARGV = (@tARGV, $ARGV[0]); + shift @ARGV; +} +@ARGV = @tARGV; + +if (@ARGV != 1) { die "USAGE: ckvalid (filename)\n" ;} +$name = $ARGV[0]; +$mode = "unknown"; +$type = "unknown"; +$runid = "none"; + +# load ccd config information +@ccdn = split (" ", `cameraconfig -ccdn`); if ($?) { &goodbye ("ERROR in cameraconfig"); } +@ccds = split (" ", `cameraconfig -ccds`); if ($?) { &goodbye ("ERROR in cameraconfig"); } + +# determine image mode (SPLIT / MEF / SINGLE) +$mode = ckimmode ($name); +if ($mode eq "unknown") { + if ($VERBOSE) { print "can't identify image mode\n"; } + &print_status; + exit $DATA_ERR; +} +if ($mode eq "SINGLE") { + if ($VERBOSE) { print STDERR "mode = SINGLE, validation undefined\n"; } + &print_status; + exit $DATA_ERR; +} + +# get filename components +$path = gt_names ($name, "path", $mode); +$root = gt_names ($name, "root", $mode); +$Nccd = gt_names ($name, "Nccd", $mode); + +# create the name of a real file: +if ($mode eq SPLIT) { + $tmpname = sprintf "%s/%s%s.fits", $name, $root, $ccdn[0]; +} else { + $tmpname = $name; +} + +# find the run id for this image (needed to get astrometry) +$runid = `ckrunid $tmpname`; chop ($runid); +if ($?) { + if ($VERBOSE) { print STDOUT "$name: no run ID\n"; } + $runid = "none"; +} + +# check the IMAGETYP: +$answer = `echo $tmpname | fields OBSTYPE`; +($tmp, $type) = split (" ", $answer); +if ($type ne "OBJECT") { + if ($VERBOSE) { print STDOUT "$name: wrong image type $type\n"; } + &print_status; + exit $SUBVALID; +} + +# check the GEOMETRY: +$answer = `echo $tmpname | fields CCDBIN1 CCDBIN2 RASTER`; +@words = split (" ", $answer); +if (($words[1] != 1) || ($words[2] != 1)) { + if ($VERBOSE) { print STDOUT "$name: binned image\n"; } + &print_status; + exit $SUBVALID; +} +if ($words[3] ne "FULL") { + if ($VERBOSE) { print STDOUT "$name: sub-rastered image\n"; } + &print_status; + exit $SUBVALID; +} + +# image is OK +$eval{DATA} = 1; + +# check the ASTROMETRY: +unless ($runid eq "none") { + $answer = `ckastrom $runid $root $Nccd`; chop ($answer); + if ($?) { + if ($VERBOSE) { print "astrometry: $answer\n"; } + } else { + $eval{ASTROM} = 1; + } +} + +# check the DETREND data: +if ($mode eq "SPLIT") { + # we only need the name of an single representative file on disk + $tmpname = sprintf "%s/%s%s.fits", $name, $root, $ccdn[0]; +} else { + $tmpname = $name; +} +$answer = `detsearch -quiet -mosaic $tmpname -recipe`; +if ($?) { + if ($VERBOSE) { print "missing detrend: $answer\n"; } +} else { + $eval{DETREND} = 1; +} + +# check on PHOTOMETRY +$answer = `ckphotom $tmpname $ccds[0] $mode`; +if ($?) { + if ($VEROSE) { print STDERR "photom failed: $answer\n"; } +} else { + $eval{PHOTOM} = 1; +} + +&print_status; +if ($eval{DATA} && $eval{DETREND} && $eval{PHOTOM} && $eval{ASTROM}) { exit $PASS; } +exit $FAIL; + +# utilities ############################################## + +sub print_status { + printf STDOUT "%s %8s %8s %8s %d %d %d %d\n", $name, $mode, $type, + $runid, $eval{DATA}, $eval{DETREND}, $eval{PHOTOM}, $eval{ASTROM}; +} + +sub gt_names { + # in: filename mode type + # out: word + + my ($value); + + $value = ""; + if ($_[2] eq "MEF") { $value = mefnames ($_[0], $_[1]); } + if ($_[2] eq "SPLIT") { $value = splitnames ($_[0], $_[1]); } + + return $value; +} + +sub mefnames { + # in: (/path/file.fits) (mode) + # out: word + + my($fullname) = $_[0]; + my($mode) = $_[1]; + my($answer); + + # split rootdir and filename: + my (@words) = split ("/", $fullname); + $N = @words; + + if ($mode eq "path") { + $answer = ""; + for ($i = 0; $i < $N - 1; $i++) { + $answer = $answer . $words[$i] . "/"; + } + chop ($answer); # strip off last / + if ($answer eq "") { $answer = "."; } + return ($answer); + } + + if ($mode eq "root") { + $answer = "$words[$N-1]"; + $answer =~ s/.fits$//; + return ($answer); + } + + if ($mode eq "Nccd") { + if (! -e $fullname) { + return (0); + } + $answer = `echo $fullname | fields NEXTEND`; + @words = split (" ", $answer); + if ($words[1] eq "") { + return (0); + } + return ($words[1]); + } + + return (0); +} + +sub splitnames { + # in: (/path/file) (mode) + # out: word + # /path/file is directory containing Nccd fits images + + my($fullname) = $_[0]; + my($mode) = $_[1]; + my($answer, $N, $tmpname, @imlist, @words); + + # split rootdir and filename: + @words = split ("/", $fullname); + $N = @words; + + if ($mode eq "path") { + $answer = ""; + for ($i = 0; $i < $N - 1; $i++) { + $answer = $answer . $words[$i] . "/"; + } + chop ($answer); # strip off last / + if ($answer eq "") { $answer = "."; } + return ($answer); + } + + if ($mode eq "root") { + $answer = "$words[$N-1]"; + return ($answer); + } + + if ($mode eq "Nccd") { + + $tmpname = "$fullname/$words[$N-1]"; + @imlist = <$tmpname??.fits>; + + $Nccd = @imlist; + return $Nccd; + } + + return (0); +} + +sub ckimmode { + # in: (/path/file) + # out: MEF | SPLIT | SINGLE | (NULL) + + my ($answer, $name, $value); + my ($file) = $_[0]; + + if (! -e $file) { + if ($VERBOSE) { print STDOUT "$file: can't open file\n"; } + return "unknown"; + } + + # if /path/file is a directory, it is split: + if (-d $file) { return "SPLIT"; } + + # check that the file is a FITS image + $answer = `file -L $file`; + if ($?) { + if ($VERBOSE) { print STDOUT "can't open file\n"; } + return "unknown"; + } + ($name, $value) = split (" ", $answer); + if ($value ne "FITS") { + if ($VERBOSE) { print STDOUT "not a valid image\n"; } + return "unknown"; + } + + # check for NAXIS = 0 (MEF) + $answer = `echo $file | fields NAXIS`; + # if ($?) { return ""; } + ($name, $value) = split (" ", $answer); + if ($value eq 0) { return "MEF"; } + + if ($value == 2) { return "SINGLE"; } + + if ($VERBOSE) { print STDOUT "not a valid image\n"; } + return "unknown"; +} + +sub vsystem { + # print STDERR "@_\n"; + my($status) = system ("@_"); + $status; +} + +sub goodbye { + die "@_\n"; +} + + +# This program calls several other perl scripts to get information +# about the image. +# ckrunid - determine the appropriate Camera Run ID for this image +# ckastrom - check for the appropriate astrometry information +# ckdetrend - check for the appropriate detrend images +# ckphotom - check for the appropriate photometry data + +# at the moment, there are different calling conventions for each of +# these functions. Some take a single name (MEF / SPLIT), some take a +# reference to the specific CCD (filename CCD MODE). + +# none of the called functions need to find the number of CCDs +# ckvalid determines the number of CCDs from the header (MEF) or the +# number of appropriately named FITS files in the directory (SPLIT). + Index: /tags/ohana/perl-1-3/Ohana/src/perl/src/cmp.header =================================================================== --- /tags/ohana/perl-1-3/Ohana/src/perl/src/cmp.header (revision 21906) +++ /tags/ohana/perl-1-3/Ohana/src/perl/src/cmp.header (revision 21906) @@ -0,0 +1,101 @@ +#!/usr/bin/env perl + +$version = 1.0; +if (@ARGV != 2) { die "USAGE: cmp.header (cmpfile) (hdrfile)\n" ; } + +$cmpfile = $ARGV[0]; +$hdrfile = $ARGV[1]; + +&ckpathname ("$hdrfile"); + +if (! -e $cmpfile) { die "ERROR: source cmpfile $cmpfile not found\n"; } + +# grab astrometry keywords from $cmpfile: +@header = &load_header ($cmpfile); + +# convert stripped header to valid FITS file: NAXIS -> 0 +$found = 0; +for ($i = 0; ($i < 16) && ($i < @header); $i++) { + if ($header[$i] =~ /^NAXIS =/) { + $header[$i] = sprintf "NAXIS = %20d / %-47s", 0, "Header without Pixels"; + $found = 1; + last; + } +} +if (!$found) { print STDERR "header is missing NAXIS\n"; } + +# write output to file +open (FILE, ">$hdrfile"); +foreach $line (@header) { + print FILE "$line"; +} +for ($i = 0; $i < $Nextra; $i++) { + for ($j = 0; $j < 80; $j++) { + print FILE " "; + } +} +close (FILE); + +print "SUCCESS: done with cmp.header\n"; +exit 0; + +################################################################################### + +sub vsystem { + print STDERR "@_\n"; + $status = system ("@_"); + $status; +} + +sub goodbye { + die "@_\n"; +} + +sub load_header { + + my ($file) = $_[0]; + my ($ID, $buffer, $done, @buffer, $line); + + open (FILE, "$file"); + read FILE, $ID, 8; + if ($ID eq "SIMPLE ") { goto valid; } + if ($ID eq "XTENSION") { goto valid; } + close (FILE); + die "SUCCESS: $file is not a valid header file\n"; + +valid: + seek FILE, 0, "SEEK_SET"; + $done = 0; + @buffer = (); + + while (! $done) { + read FILE, $buffer, 2880; + for ($i = 0; $i < 2880; $i+=80) { + $line = substr ($buffer, $i, 80); + @buffer = (@buffer, $line); + if ($line =~ /^END /) { $done = 1; } + } + } + close (FILE); + return (@buffer); +} + +# given a filename, check that its path exists, create it if not +sub ckpathname { + my ($file) = $_[0]; + my (@words, $dir); + + @words = split ("/", $file); + pop (@words); + $dir = join ("/", @words); + + if ($dir eq "") { $dir = "."; } + + if (! -d $dir) { + system ("mkdir -p $dir"); + if ($?) { + print STDERR "ERROR: can't make directory component for $file\n"; + exit 1; + } + } +} Index: /tags/ohana/perl-1-3/Ohana/src/perl/src/complete.addstar =================================================================== --- /tags/ohana/perl-1-3/Ohana/src/perl/src/complete.addstar (revision 21906) +++ /tags/ohana/perl-1-3/Ohana/src/perl/src/complete.addstar (revision 21906) @@ -0,0 +1,31 @@ +#!/usr/bin/env perl + +# get list of *o/*.smp +@smplist = <*o/*.smp>; + +$i = 0; +foreach $file (@smplist) { + + # is NASTRO > 0? + ($tmp, $nastro) = split (" ", `echo $file | fields NASTRO`); + if ($nastro == 0) { next; } + + # is file already in db? + ($path, $root) = split ("/", $file); + $answer = `imphotsearch -D CATDIR $catdir -name $root`; + if ($answer == "") { next; } + + # addstar file + vsystem ("addstar -D CATDIR $catdir $file"); + + $i ++; + if ($i > 30) {exit;} +} + +sub vsystem { + print STDERR "@_\n"; +# my($status) = system ("@_"); +# $status; +} + + Index: /tags/ohana/perl-1-3/Ohana/src/perl/src/create.subset =================================================================== --- /tags/ohana/perl-1-3/Ohana/src/perl/src/create.subset (revision 21906) +++ /tags/ohana/perl-1-3/Ohana/src/perl/src/create.subset (revision 21906) @@ -0,0 +1,28 @@ +#!/usr/bin/env perl + +sub vsystem { + print STDERR "@_\n"; + $status = system ("@_"); + $status; +} + +sub goodbye { + die "@_\n"; +} + +if (@ARGV != 2) { die "ERROR: USAGE: create.subset (master) (subset)\n" } + +# load in stats lines +open (IN, $ARGV[0]); +open (OUT, ">$ARGV[1]"); +while ($line = ) { + chop ($line); + @words = split (" ", $line); + if ($words[1]) { + print OUT "$words[0]\n"; + } +} +close (IN); +close (OUT); + +print STDERR "SUCCESS\n"; Index: /tags/ohana/perl-1-3/Ohana/src/perl/src/dads.detrend =================================================================== --- /tags/ohana/perl-1-3/Ohana/src/perl/src/dads.detrend (revision 21906) +++ /tags/ohana/perl-1-3/Ohana/src/perl/src/dads.detrend (revision 21906) @@ -0,0 +1,324 @@ +#!/usr/bin/env perl +# calls flatten.flips & defringe, but no flips components directly + +$CLEANUP = 1; +$DO_DEFRINGE = 0; +$DO_DEMODE = 0; +$config = ""; +if ($ENV{'PTOLEMY'}) { $config = "-c $ENV{'PTOLEMY'}"; } +$tmpenv = `mktemp /tmp/elixir.XXXXXX`; chop ($tmpenv); + +@opt = (); +@tARGV = (); +$LIMITMODES = ""; +for (; @ARGV > 0; ) { + if ($ARGV[0] eq "-c") { + $config = "-c $ARGV[1]"; + shift; shift; next; + } + if ($ARGV[0] eq "-C") { + push @opt, "-C $ARGV[1]"; + shift; shift; next; + } + if ($ARGV[0] eq "-D") { + push @opt, "-D $ARGV[1] $ARGV[2]"; + shift; shift; shift; next; + } + if ($ARGV[0] eq "-cleanup") { + $CLEANUP = 0; + shift; next; + } + if ($ARGV[0] eq "-limitmodes") { + $LIMITMODES = "-limitmodes $ARGV[1]"; + shift; shift; next; + } + @tARGV = (@tARGV, $ARGV[0]); + shift; +} +@ARGV = @tARGV; + +$config = join (" ", $config, @opt); +$status = system ("gconfig -raw $config > $tmpenv"); +if ($status) { &escape ("error in elixir configuration: gconfig fails"); } +$ENV{'PTOLEMY'} = "$tmpenv"; + +if (@ARGV != 3) { &escape ("USAGE: dads.detrend (input) (outbase) (level) [-cleanup] [elixir options]"); } + +$input = $ARGV[0]; # input : /path/path/654321o.fits +$outdir = $ARGV[1]; # output: /path/path/654321p +$level = $ARGV[2]; # level : perfect, best, raw + +# validate level +$level = "\U$level\E"; +if (($level ne "PERFECT") && ($level ne "BEST") && ($level ne "RAW")) { + &escape ("ERROR: invalid entry for (level)"); +} +$close = ""; +if ($level eq "BEST") { $close = "-close"; } + +# check for input file (must be MEF) +if (! -e $input) { &escape ("ERROR: input file not found"); } + +# for raw distribution, simply use fhtool to split the files: +if ($level eq "RAW") { + system ("rmdir $outdir"); + if ($?) { &escape ("ERROR: can't remove target directory for fhtool"); } + system ("fhtool $input $outdir"); + if ($?) { &goodbye ("ERROR: failure in fhtool"); } + print STDOUT "SUCCESS: finished with dads.detrend\n"; + &goodbye; +} + +# force output directory to exist +if (! -d $outdir) { + system ("mkdir -p $outdir"); + if ($?) { &goodbye ("ERROR: can't create output directory"); } +} + +# load ccd config information +@ccdn = split (" ", `cameraconfig -ccdn`); if ($?) { &goodbye ("ERROR in cameraconfig"); } +@ccds = split (" ", `cameraconfig -ccds`); if ($?) { &goodbye ("ERROR in cameraconfig"); } + +# load abstracted keywords +($typekwd, $filtkwd, $exptkwd) = split (" ", `gconfig IMAGETYPE-KEYWORD FILTER-KEYWORD EXPTIME-KEYWORD`); +if ($?) { &goodbye ("ERROR: config system missing keyword abstractions"); } + +# extract keyword values: +($junk, $type, $exptime, $filtvalue) = split (" ", `echo $input | fields $typekwd $exptkwd $filtkwd`); +if ($?) { &goodbye ("ERROR: failure reading header keywords (1)"); } + +# check for valid imagetype & filter +if ($type ne "OBJECT") { &goodbye ("ERROR: $input: wrong image type"); } +$filter = `filtnames $filtvalue`; chop $filter; +if ($?) { &goodbye ("ERROR: filter not found"); } + +# check recipe file for detrend types & cutoff exptime values +$recipefile = `gconfig DETREND_RECIPES`; chop $recipefile; +($detypes, $cutoffs) = split (" ", `gconfig -c $recipefile $filter`); +if ($?) { &goodbye ("ERROR: failure to get detrend recipes"); } +@detypes = split (",", $detypes); +@cutoffs = split (",", $cutoffs); + +# check for DEFRINGE, DEMODE +$DO_DEFRINGE = 0; +for ($i = 0; $i < @detypes; $i++) { + if ($detypes[$i] eq "fringe") { + if ($exptime >= $cutoffs[$i]) { $DO_DEFRINGE = 1; } + last; + } +} +$DO_DEMODE = 0; +for ($i = 0; $i < @detypes; $i++) { + if ($detypes[$i] eq "modes") { + if ($exptime >= $cutoffs[$i]) { $DO_DEMODE = 1; } + last; + } +} +$camera = `gconfig CAMERA`; chop $camera; +if ($camera eq "meganorth") { $DO_DEMODE = 0; } + +# check the GEOMETRY: +($tmp, $bin1, $bin2, $raster) = split (" ", `echo $input | fields CCDBIN1 CCDBIN2 RASTER`); +if ($?) { &goodbye ("ERROR: failure reading header keywords (2)"); } + +if ($bin1 != 1) { &goodbye ("ERROR: $input: binned image"); } +if ($bin2 != 1) { &goodbye ("ERROR: $input: binned image"); } +if ($raster ne "FULL") { &goodbye ("ERROR: $input: sub-rastered image"); } + +# print a summary of the processing +print STDOUT "\n"; +print STDOUT "image: $input, filter: $filter, exptime: $exptime\n"; +print STDOUT "detrend processing: defringe: $DO_DEFRINGE, demode: $DO_DEMODE, level: $level\n\n"; + +# get image size: +@words = stat ($input); +$Nbyte = $words[7]; + +# check space on /tmp: +@answer = `df -k /tmp`; +@words = split (" ", $answer[1]); +$Nfree = $words[3]*1024; + +# need space in workdir for one image for each of DEMODE & DEFRINGE: +$Need = 0; +if ($DO_DEMODE) { $Need ++; } +if ($DO_DEFRINGE) { $Need ++; } +$Nneed = $Need*$Nbyte*1.01; + +# choose a work directory (/tmp vs $outdir): +$workdir = $outdir; +if ($Nfree > $Nneed) { + $workdir = "/tmp"; +} + +print STDERR "Need workspace for $Need images: $Nfree vs $Nneed\n"; + +# extract image rootname from $outdir: +$base = &basename ($outdir); + +# create output lists: +@detlist = (); +@deflist = (); +@demlist = (); +@fitlist = (); +foreach $ccd (@ccdn) { + push @fitlist, "$outdir/$base$ccd.fits"; + push @detlist, "$workdir/$base$ccd.det"; + push @deflist, "$workdir/$base$ccd.def"; +} +# phu file: +$phufile = "$outdir/$base.phu"; + +# detrend $input[ccd] @detlist +# defringe @detlist @deflist +# demode @deflist @demlist +# output @fitlist + +#* flatten.flips input fitlist + +#* flatten.flips input detlist +#* demode detlist fitlist + +# flatten.flips input detlist +# defringe detlist deflist + +#* flatten.flips input detlist +#* defringe detlist deflist +#* demode deflist fitlist + +# @demlist = @fitlist +# !demode: @deflist = @demlist +# !defringe: @detlist = @deflist + +if ($DO_DEMODE) { + @demlist = @fitlist; +} else { + if ($DO_DEFRINGE) { + @deflist = @fitlist; + } else { + @detlist = @fitlist; + } +} + +# run the detrend system +for ($i = 0; $i < @ccds; $i++) { + $status = &vsystem ("flatten.flips $close -quiet $input $detlist[$i] $ccds[$i] mef"); + if ($status) { &escape ("ERROR: problem running flatten on $input, $ccds[$i]"); } +} +$status = &vsystem ("flatten.flips $close -quiet $input $phufile phu mef"); +if ($status) { &escape ("ERROR: problem running flatten on $input, phu"); } + +# we need files containing detlist, demlist, deflist: +if ($DO_DEMODE || $DO_DEFRINGE) { + $detlist = "$outdir.detlist"; + open (FILE, ">$detlist"); + foreach $name (@detlist) { + print FILE "$name\n"; + } + close (FILE); +} +if ($DO_DEMODE) { + $mapfile = "$outdir.map.fits"; + $deflist = $detlist; + $demlist = "$outdir.demlist"; + open (FILE, ">$demlist"); + foreach $name (@demlist) { + print FILE "$name\n"; + } + close (FILE); +} +if ($DO_DEFRINGE) { + $deflist = "$outdir.deflist"; + open (FILE, ">$deflist"); + foreach $name (@deflist) { + print FILE "$name\n"; + } + close (FILE); +} + +if ($DO_DEFRINGE) { + $status = &vsystem ("defringe $detlist $deflist $close"); + if ($status) { &escape ("ERROR: problem running defringe on $outdir"); } +} + +if ($DO_DEMODE) { + $status = &vsystem ("demodemap $deflist $demlist -mapfile $mapfile $LIMITMODES $close"); + if ($status) { &escape ("ERROR: problem running demodemap on $outdir"); } +} + +# update the phu header with the results from ccd # 0 +if ($DO_DEMODE || $DO_DEFRINGE) { + $temp = `mktemp /tmp/elixir.XXXXXX`; chop ($temp); + system ("fhead $detlist[0] > $temp.1.hdr"); + system ("fhead $fitlist[0] > $temp.2.hdr"); + + @answer = `diff $temp.1.hdr $temp.2.hdr`; + open (FILE, ">$temp.hdr"); + foreach $line (@answer) { + if ($line =~ m|^>\s|) { + ($head) = $line =~ m|^>\s(.*)$|; + print FILE "$head\n"; + } + } + close FILE; + + vsystem ("fits_insert $phufile $temp.hdr"); + if ($?) { &escape ("ERROR: cannot update phu"); } + unlink ("$temp"); + unlink ("$temp.1.hdr"); + unlink ("$temp.2.hdr"); + unlink ("$temp.hdr"); +} +&goodbye ("SUCCESS: finished with dads.detrend"); + +######################################################################## + +sub cleanup { + + if (!$CLEANUP) { return; } + + unlink $tmpenv; + # detlist, demlist, deflist + foreach $name (@detlist) { + if (-e $name && ($name =~ m|^/tmp/|)) { unlink ($name); } + } + foreach $name (@demlist) { + if (-e $name && ($name =~ m|^/tmp/|)) { unlink ($name); } + } + foreach $name (@deflist) { + if (-e $name && ($name =~ m|^/tmp/|)) { unlink ($name); } + } + + if (-e $detlist) { unlink ($detlist); } + if (-e $demlist) { unlink ($demlist); } + if (-e $deflist) { unlink ($deflist); } + + return; +} + +sub basename { + + my ($file) = $_[0]; + my ($base, @words); + + @words = split ("/", $file); + $base = $words[-1]; + return $base; +} + +sub vsystem { + $status = system ("@_"); + $status; +} + +sub goodbye { + &cleanup; + print STDERR "@_\n"; + exit 0; +} + +sub escape { + &cleanup; + print STDERR "@_\n"; + exit 1; +} Index: /tags/ohana/perl-1-3/Ohana/src/perl/src/dads.jpeg =================================================================== --- /tags/ohana/perl-1-3/Ohana/src/perl/src/dads.jpeg (revision 21906) +++ /tags/ohana/perl-1-3/Ohana/src/perl/src/dads.jpeg (revision 21906) @@ -0,0 +1,59 @@ +#!/usr/bin/env perl + +if (@ARGV != 3) { die "USAGE: dads.jpeg (inbase) (outbase) (level)\n" } + +# test named Xserver, or start vnc on specified machine +$xhost = `gconfig XHOST`; chop $xhost; +$xdisp = `gconfig XDISP`; chop $xdisp; +if (vsystem ("xdpyinfo -display $xdisp")) { + print STDERR "X server is not running. start it now on $xhost\n"; + exit 1; +} +$ENV{'DISPLAY'} = $xdisp; + +# find mana script +$confdir = `gconfig CONFDIR`; chop $confdir; +$script = "$confdir/mana/dads.pro"; + +# get image list +@ilist = <$ARGV[0]/*.fits>; + +# level may be: 'perfect', 'best', 'raw' +$level = "\U$ARGV[2]\E"; +if (($level ne "PERFECT") && ($level ne "BEST") && ($level ne "RAW")) { + die "ERROR: invalid entry for (level)\n"; +} + +$out1 = "$ARGV[1].b10.jpg"; +$out2 = "$ARGV[1].b50.jpg"; + +open (MANA, "|mana --norc"); +print MANA "input $script\n"; +print MANA "init.mosaic\n"; +print MANA "macro go\n"; +foreach $in (@ilist) { + print MANA "load.image $in\n"; +} +print MANA "do.jpeg $out1 $out2 $level\n"; +print MANA "exit 0\n"; +print MANA "end\n"; +print MANA "go\n"; +print MANA "exit 1\n"; +close (MANA); +if ($?) { + die "ERROR: problem running dads.jpeg\n"; +} + +print STDOUT "SUCCESS: finished running dads.jpeg\n"; +exit 0; + +sub vsystem { + print STDERR "@_\n"; + $status = system ("@_"); + $status; +} + +sub goodbye { + die "@_\n"; +} + Index: /tags/ohana/perl-1-3/Ohana/src/perl/src/dads.keywords =================================================================== --- /tags/ohana/perl-1-3/Ohana/src/perl/src/dads.keywords (revision 21906) +++ /tags/ohana/perl-1-3/Ohana/src/perl/src/dads.keywords (revision 21906) @@ -0,0 +1,96 @@ +#!/usr/bin/env perl + +if (@ARGV != 1) { die "USAGE: dads.keywords (outdir)\n" ;} + +# get list of image files: +@list = <$ARGV[0]/*.fits>; +$name = $list[0]; + +# get appropriate run ID +$runid = `ckrunid $name`; chop ($runid); +if ($?) { + print STDERR "ERROR: can't find run ID\n"; + exit 1; +} + +# get the appropriate reduced data directory +$tmpdir=`gconfig -D RUNID $runid TMPDIR`; chop ($tmpdir); +if ($?) { + print STDERR "ERROR: can't find tmpdir\n"; + exit 1; +} + +if (! -d $tmpdir) { + print STDERR "ERROR: can't open $tmpdir\n"; + exit 1; +} + +foreach $name (@list) { + + # files have names like /path/654321p/654321p00.fits + + # split rootdir and filename: + @words = split ("/", $name); + $N = @words; + + # extract root (654321p) convert to original form (654321o) + ($root, $ccd) = $words[$N-1] =~ /(\d\d\d\d\d\d)\S(\d\d)/; + $base = sprintf "%so/%so%02d", $root, $root, $ccd; + + # generate name of output header file + $hdxfile = $name; + $hdxfile =~ s/.fits$/.hdx/; + if ($hdxfile eq $name) { + print STDERR "ERROR in format of filename $name\n"; + exit 1; + } + + # grab.keywords tests both smp & cmp + $cmproot = "$tmpdir/$base"; + if (vsystem ("grab.keywords $name $cmproot $hdxfile")) { + print STDERR "ERROR: can't get keywords for $name\n"; + exit 1; + } + + if (vsystem ("fits_insert $name $hdxfile -comment 5 'Fully Characterized and Analysed by Elixir @ CFHT'" )) { + print STDERR "ERROR inserting keywords in $name\n"; + exit 1; + } +} + +# add data for phu file: +@list = <$ARGV[0]/*.phu>; +$phufile = $list[0]; + +# generate name of output header file +$hdxfile = $name; +$hdxfile =~ s/.fits$/.phu/; +if ($hdxfile eq $name) { + print STDERR "ERROR in format of filename $name\n"; + exit 1; +} + +if (vsystem ("grab.keywords $phufile phu $hdxfile")) { + print STDERR "ERROR: can't get keywords for $name\n"; + exit 1; +} + +if (vsystem ("fits_insert $phufile $hdxfile -comment 5 'Fully Characterized and Analysed by Elixir @ CFHT'" )) { + print STDERR "ERROR inserting keywords in $name\n"; + exit 1; +} + +print STDERR "SUCCESS: applied new keywords\n"; +exit 0; + +# utilities ############################################## + +sub vsystem { + print STDERR "@_\n"; + $status = system ("@_"); + $status; +} + +sub goodbye { + die "@_\n"; +} Index: /tags/ohana/perl-1-3/Ohana/src/perl/src/darktime.cfh12k =================================================================== --- /tags/ohana/perl-1-3/Ohana/src/perl/src/darktime.cfh12k (revision 21906) +++ /tags/ohana/perl-1-3/Ohana/src/perl/src/darktime.cfh12k (revision 21906) @@ -0,0 +1,33 @@ +#!/usr/bin/env perl + +sub vsystem { + print STDERR "@_\n"; + $status = system ("@_"); + $status; +} + +sub goodbye { + die "@_\n"; +} + +if (@ARGV != 2) { die "USAGE: darktime.cfht (image.exptime) (dark.exptime)\n" } + +$t1 = $ARGV[0]; +$t2 = $ARGV[1]; + +$a = 0.000781480; +$b = 5.45879e-06; +$c = -1.21674e-09; + +$d1 = $a*$t1 + $b*$t1**2 + $c*$t1**3; + +$d2 = $a*$t2 + $b*$t2**2 + $c*$t2**3; + +$f = $d1 / $d2; + +# no dark correction for exptime < 15 sec +if ($t1 < 15) { $f = 0.001; } + +print STDOUT "$f\n"; + +exit 0; Index: /tags/ohana/perl-1-3/Ohana/src/perl/src/darktime.linear =================================================================== --- /tags/ohana/perl-1-3/Ohana/src/perl/src/darktime.linear (revision 21906) +++ /tags/ohana/perl-1-3/Ohana/src/perl/src/darktime.linear (revision 21906) @@ -0,0 +1,26 @@ +#!/usr/bin/env perl + +sub vsystem { + print STDERR "@_\n"; + $status = system ("@_"); + $status; +} + +sub goodbye { + die "@_\n"; +} + +if (@ARGV != 2) { die "USAGE: darktime.linear (image.exptime) (dark.exptime)\n" } + + +$t1 = $ARGV[0]; +$t2 = $ARGV[1]; + +$r = $t1 / $t2; + +# no dark correction for exptime < 60 sec +if ($t1 < 60) { $r = 0.0; } + +print STDOUT "$r\n"; + +exit 0; Index: /tags/ohana/perl-1-3/Ohana/src/perl/src/defringe =================================================================== --- /tags/ohana/perl-1-3/Ohana/src/perl/src/defringe (revision 21906) +++ /tags/ohana/perl-1-3/Ohana/src/perl/src/defringe (revision 21906) @@ -0,0 +1,177 @@ +#!/usr/bin/env perl + +# grab the command line options +$close = ""; +@tARGV = (); +for (; @ARGV > 0; ) { + if ($ARGV[0] eq "-close") { + $close = "-close"; + shift; next; + } + @tARGV = (@tARGV, $ARGV[0]); + shift; +} +@ARGV = @tARGV; + +if (@ARGV != 2) { &escape ("USAGE: defringe (inlist) (outlist) [-close]"); } + +# load config info +$confdir = `gconfig CONFDIR`; chop $confdir; +if ($?) { &escape ("config failure"); } +$script = "$confdir/mana/fringe.pro"; + +# various lists +@input = split (" ", `cat $ARGV[0]`); +@output = split (" ", `cat $ARGV[1]`); +@ccds = split (" ", `cameraconfig -ccds`); +$Nccd = @ccds; +$dbmode = `gconfig DETREND-DB-MODE`; chop $dbmode; + +# find fringe-point file +$frpts = `detsearch -quiet -image $input[0] $ccds[0] split -type frpts`; chop $frpts; +if ($?) { &escape ("can't get fringe points for image"); } + +# temporary files +$frstats = mktemp ("defringe"); +$imstats = mktemp ("defringe"); +$fitpars = mktemp ("defringe"); + +# prepare for defringing: +# 1) measure input image fringe stats (imstats) +# 2) extract master fringe frame stats (frstats) +# 3) create output directory if needed +# 4) delete output files if present + +open (FILE, ">$frstats"); +for ($i = 0; $i < $Nccd; $i++) { + # measure fringe amplitude of input image + vsystem ("getfringe $input[$i] $ccds[$i] $frpts 1 >> $imstats"); + if ($?) { die "failure to measure fringe amplitude\n"; } + + print "imstats; $imstats\n"; + + # find fringe master frames + @file = `detsearch -quiet $close -image $input[$i] $ccds[$i] split -type fringe`; + $file = $file[-1]; chop $file; + if ($?) { &escape ("can't find fringe master for $input[$i]"); } + $fringe[$i] = $file; + if ($dbmode eq "MEF") { $fringe[$i] = "$file\[$ccds[$i]\]"; } + + print "file: $file\n"; + print "fringe: $fringe[$i]\n"; + print "dbmode; $dbmode\n"; + + # get fringe master stats + if ($dbmode eq "MEF") { + ($name, $C0, $C1, $SKY, $RNG) = split (" ", `echo $file | fields -x $i FRNG_C0 FRNG_C1 FRNG_SKY FRNG_RNG`); + } else { + ($name, $C0, $C1, $SKY, $RNG) = split (" ", `echo $file | fields FRNG_C0 FRNG_C1 FRNG_SKY FRNG_RNG`); + } + print FILE "$C0 $C1 $SKY $RNG\n"; + print STDERR "$C0 $C1 $SKY $RNG\n"; + + # check on output directory + &ckdir ($output[$i]); + + if (-e $output[$i]) { unlink $output[$i]; } +} +close (FILE); + +# convert image stats to optimal image parameters +vsystem ("fr.frstats -applyfit $imstats $frstats $fitpars"); +if ($?) { &escape ("failure in fr.frstats"); } +@fitpars = `cat $fitpars`; + +# load flips parameter file +$paramfile = `gconfig FLIPS_PARAM_DEFRINGE`; chop $paramfile; +open (FILE, "$paramfile"); +@rawpars = ; +close (FILE); + +$infile = mktemp ("\@defringe"); +$parfile = mktemp ("defringe"); +for ($i = 0; $i < $Nccd; $i++) { + + # create input list file + ($s0, $s1, $RF, $ds) = split (" ", $fitpars[$i]); + open (FILE, ">$infile"); + print FILE "$input[$i] $s0 1.0 $ds\n"; + print FILE "$fringe[$i] $s1 $RF $ds\n"; + close (FILE); + + # create input par file + @params = @rawpars; + foreach $line (@params) { + $line =~ s|LISTNAME|$infile|; + $line =~ s|FILENAME|$output[$i]|; + $line =~ s|COMMENT|Elixir Defringing|; + } + open (FILE, ">$parfile"); + foreach $line (@params) { print FILE "$line"; } + close (FILE); + + vsystem ("imcombred $parfile"); + if ($?) { &escape ("failure running imcombred"); } +} + +&goodbye; + +######## + +sub ckdir { + + my ($file) = $_[0]; + my ($dir, @words); + + @words = split ("/", $file); + pop (@words); + $dir = join ("/", @words); + if ($dir eq "") { $dir = "."; } + if (! -e $dir) { + system ("mkdir -p $dir"); + if ($?) { die "can't create output directory $dir\n"; } + } +} + +sub loadlist { + + my($command) = $_[0]; + my(@list, $line); + + @list = `$command`; + + foreach $line (@list) { chop ($line); } + + return @list; +} + +sub vsystem { + print STDERR "@_\n"; + $status = system ("@_"); + $status; +} + +@temp = (); +sub mktemp { + + my ($base) = $_[0]; + my ($name); + $name = `mktemp /tmp/$base.XXXXXX`; + chop $name; + + push @temp, $name; + return $name; +} + +sub escape { + $message = $_[0]; + foreach $name (@temp) { + unlink ($name); + } + die "$message\n"; +} + +sub goodbye { + foreach $name (@temp) { unlink ($name); } + exit 0; +} Index: /tags/ohana/perl-1-3/Ohana/src/perl/src/defringe.ccd =================================================================== --- /tags/ohana/perl-1-3/Ohana/src/perl/src/defringe.ccd (revision 21906) +++ /tags/ohana/perl-1-3/Ohana/src/perl/src/defringe.ccd (revision 21906) @@ -0,0 +1,141 @@ +#!/usr/bin/env perl + +# grab the command line options +$close = ""; +$quiet = 0; +$preserve = 0; +@tARGV = (); +for (; @ARGV > 0; ) { + if ($ARGV[0] eq "-close") { + $close = "-close"; + shift; next; + } + if ($ARGV[0] eq "-quiet") { + $quiet = 1; + shift; next; + } + if ($ARGV[0] eq "-preserve") { + $preserve = 1; + shift; next; + } + @tARGV = (@tARGV, $ARGV[0]); + shift; +} +@ARGV = @tARGV; + +if (@ARGV != 4) { &escape ("USAGE: defringe.chip (input) (output) (ccd) (mode) [-close]"); } + +# various lists +$input = $ARGV[0]; +$output = $ARGV[1]; +$ccd = $ARGV[2]; +$mode = uppercase ($ARGV[3]); +if ($mode ne "SPLIT") { &escape ("defringe.ccd requires SPLIT input data for now"); } + +# load config info +$dbmode = `gconfig DETREND-DB-MODE`; chop $dbmode; +$ccdn = `cameraconfig -N $ccd`; chop $ccdn; + +# find fringe-point file (always MEF) +$frpts = `detsearch -quiet -image $input $ccd split -type frpts`; chop $frpts; +if ($?) { &escape ("can't get fringe points for image"); } + +# measure fringe amplitude of input image +($name, $sky, $rng, $drng) = split (" ", `getfringe $input $ccd $frpts 1`); +if ($?) { &escape ("failure to measure fringe amplitude"); } + +# find fringe master frames +$file = `detsearch -quiet $close -image $input $ccd split -type fringe`; chop $file; +if ($?) { &escape ("can't find fringe master for $input"); } + +$frmaster = $file; +if ($dbmode eq "MEF") { $frmaster = "$file\[$ccd\]"; } + +# get fringe master stats +if ($dbmode eq "MEF") { + ($name, $C0, $C1, $SKY, $RNG) = split (" ", `echo $file | fields -x $ccdn FRNG_C0 FRNG_C1 FRNG_SKY FRNG_RNG`); +} else { + ($name, $C0, $C1, $SKY, $RNG) = split (" ", `echo $file | fields FRNG_C0 FRNG_C1 FRNG_SKY FRNG_RNG`); +} + +if (-e $output) { unlink $output; } + +# load flips parameter file +$paramfile = `gconfig FLIPS_PARAM_DEFRINGE`; chop $paramfile; +open (FILE, "$paramfile"); +@rawpars = ; +close (FILE); + +$infile = mktemp ("\@defringe"); +$parfile = mktemp ("defringe"); + +# create input list file +$s0 = $sky; +$s1 = $SKY; +$RF = $RNG / $rng; +$ds = 0.0; +open (FILE, ">$infile"); +print FILE "$input $s0 1.0 $ds\n"; +print FILE "$frmaster $s1 $RF $ds\n"; +close (FILE); + +# create input par file +@params = @rawpars; +foreach $line (@params) { + $line =~ s|LISTNAME|$infile|; + $line =~ s|FILENAME|$output|; + $line =~ s|COMMENT|Elixir Defringing|; +} +open (FILE, ">$parfile"); +foreach $line (@params) { print FILE "$line"; } +close (FILE); + +vsystem ("imcombred $parfile"); +if ($?) { &escape ("failure running imcombred"); } + +&goodbye; + +######## + +sub vsystem { + print STDERR "@_\n"; + $status = system ("@_"); + $status; +} + +@temp = (); +sub mktemp { + + my ($base) = $_[0]; + my ($name); + $name = `mktemp /tmp/$base.XXXXXX`; + chop $name; + + push @temp, $name; + return $name; +} + +sub uppercase { + return "\U$_[0]\E"; +} + +sub escape { + $message = $_[0]; + foreach $name (@temp) { + unlink ($name); + } + if ($quiet) { + die "$message\n"; + } else { + die "ERROR: $message\n"; + } +} + +sub goodbye { + foreach $name (@temp) { + if ($preserve) { print STDERR "tmp file: $name\n"; } + else { unlink ($name); } + } + if (!$quiet) { print STDERR "SUCCESS\n"; } + exit 0; +} Index: /tags/ohana/perl-1-3/Ohana/src/perl/src/demodemap =================================================================== --- /tags/ohana/perl-1-3/Ohana/src/perl/src/demodemap (revision 21906) +++ /tags/ohana/perl-1-3/Ohana/src/perl/src/demodemap (revision 21906) @@ -0,0 +1,74 @@ +#!/usr/bin/env perl + +# grab the command line options +$limitmodes = ""; +$mapfile = ""; +$close = ""; +@tARGV = (); +for (; @ARGV > 0; ) { + if ($ARGV[0] eq "-close") { + $close = "-close"; + shift; next; + } + if ($ARGV[0] eq "-mapfile") { + $mapfile = $ARGV[1]; + shift; shift; next; + } + if ($ARGV[0] eq "-limitmodes") { + $limitmodes = $ARGV[1]; + shift; shift; next; + } + @tARGV = (@tARGV, $ARGV[0]); + shift; +} +@ARGV = @tARGV; + +if (@ARGV != 2) { die "USAGE: demodemap (inlist) (outlist) [-mapfile file] [-limitmodes N] [-close]\n" } + +$inlist = $ARGV[0]; +$outlist = $ARGV[1]; + +open (FILE, "$inlist"); +@list = ; +$first = $list[$i]; chop ($first); +close (FILE); + +# find the appropriate script file +$confdir = `gconfig -q CONFDIR`; chop ($confdir); +$script = "$confdir/mana/modes.pro"; +$answer = `cameraconfig -ccds`; +@ccds = split (" ", $answer); + +$modefits = `detsearch $close -quiet -image $first $ccds[0] split -type modes`; chop ($modefits); +if ($?) { die "can't get mode image\n"; } + +@words = split ("/", $modefits); +$basename = $words[-1]; + +open (MANA, "|mana --norc"); +print MANA "input $script\n"; + +# override default values (set in modes.pro): +if ($limitmodes) { print MANA "\$Nmodes = $limitmodes\n"; } +if ($mapfile) { print MANA "\$savemap = $mapfile\n"; } +print MANA "demodemap $inlist $outlist $modefits $basename\n"; +print MANA "exit 1\n"; +close (MANA); +if ($?) { + print STDERR "problem with demodemap\n"; + exit 1; +} + +print STDOUT "finished with demodemap\n"; + +exit 0; + +sub vsystem { + print STDERR "@_\n"; + $status = system ("@_"); + $status; +} + +sub goodbye { + die "@_\n"; +} Index: /tags/ohana/perl-1-3/Ohana/src/perl/src/detflips =================================================================== --- /tags/ohana/perl-1-3/Ohana/src/perl/src/detflips (revision 21906) +++ /tags/ohana/perl-1-3/Ohana/src/perl/src/detflips (revision 21906) @@ -0,0 +1,90 @@ +#!/usr/bin/env perl + +# grab the command line options [-C config] [-c configfile] +$config = ""; +$preserve = 0; +@tARGV = (); +while (@ARGV) { + if ($ARGV[0] eq "-C") { + $config = "$config -C $ARGV[1]"; + shift; shift; next; + } + if ($ARGV[0] eq "-c") { + $config = "$config -c $ARGV[1]"; + shift; shift; next; + } + if ($ARGV[0] eq "-preserve") { + $preserve = 1; + shift; next; + } + push @tARGV, $ARGV[0]; + shift; +} +@ARGV = @tARGV; + +if (@ARGV != 3) { die "ERROR: USAGE: detflips (inlist) (output) (type)\n" } + +$inlist = $ARGV[0]; +$output = $ARGV[1]; +$type = "\U$ARGV[2]\E"; + +# count lines in $inlist, adjust statmode (FLAT only) +($nlines) = split (" ", `wc -l $inlist`); +$statmode = 0; +if ($nlines < 6) { $statmode = 1; } +if ($nlines == 0) { die "ERROR: no files in source list, skipping\n"; } + +# delete old output file +if (-e $output) { unlink "$output"; } + +$temp1 = `mktemp /tmp/detflips.XXXXXX`; chop $temp1; +$temp2 = `mktemp /tmp/\@detflips.XXXXXX`; chop $temp2; + +if ($type eq "BIAS") { $paramkey = "FLIPS_PARAM_DARK"; $detype = "bias"; } +if ($type eq "DARK") { $paramkey = "FLIPS_PARAM_DARK"; $detype = "dark"; } +if ($type eq "FLAT") { $paramkey = "FLIPS_PARAM_FLAT"; $detype = "skyflat"; } +if ($type eq "FRINGE") { $paramkey = "FLIPS_PARAM_FRINGE"; $detype = "fringe"; } +if ($type eq "STACK") { $paramkey = "FLIPS_PARAM_STACK"; $detype = "science"; } + +if ($paramkey eq "") { + print STDERR "ERROR: invalid detrend type $type\n"; + exit 1; +} + +$paramfile = `gconfig $config $paramkey`; chop $paramfile; +if ($?) { die "ERROR: missing parameter file $paramkey from config\n"; } + +open (FILE, "$paramfile"); +@params = ; +close (FILE); + +print STDERR "detflips parameter file: $paramfile\n"; + +foreach $line (@params) { + $line =~ s|LISTNAME|$temp2|; + $line =~ s|FILENAME|$output|; + $line =~ s|COMMENT|$type|; + $line =~ s|DETRENDTYPE|$detype|; + if ($type eq "FLAT") { $line =~ s|STATMODE|$statmode|; } +} + +open (FILE, ">$temp1"); +print FILE "@params\n"; +close $temp1; + +system ("cp $inlist $temp2"); +system ("imcombred $temp1"); +$stat = $?; + +if (! $preserve) { + unlink ($temp1); + unlink ($temp2); +} + +if ($stat) { + print STDERR "ERROR: failure in detflips\n"; +} else { + print STDERR "SUCCESS\n"; +} + +exit $stat; Index: /tags/ohana/perl-1-3/Ohana/src/perl/src/dt.select =================================================================== --- /tags/ohana/perl-1-3/Ohana/src/perl/src/dt.select (revision 21906) +++ /tags/ohana/perl-1-3/Ohana/src/perl/src/dt.select (revision 21906) @@ -0,0 +1,219 @@ +#!/usr/bin/env perl +$SKIPDOME = 0; + +if (@ARGV != 6) { die "ERROR: USAGE: imselect (type) (filter) (tstart) (tend) (output) (SPLIT | MEF)\n" } + +$type = "\U$ARGV[0]\E"; +$filter = "\U$ARGV[1]\E"; +$start = $ARGV[2]; +$stop = $ARGV[3]; +$output = $ARGV[4]; +$mode = $ARGV[5]; + +unless ($output =~ /CCDNUM/) { die "ERROR: output file needs CCDNUM component\n"; } + +if (($mode ne "MEF") && ($mode ne "SPLIT")) { die "ERROR: mode must be either -split or -mef\n"; } + +if ($type eq "DARK") { } + +if ($type eq "FLAT") { + # define some of the relevant parameters + $max = 60000; + + $tmp = `filtnames $filter`; chop $tmp; + if ($?) { die "ERROR: invalid filter $filter\n"; } + $filter = $tmp; + + # recipe file defines detrend types & cutoff exptime values + $recipefile = `gconfig DETREND_RECIPES`; chop $recipefile; + if ($?) { die "ERROR: missing DETREND_RECIPES in configuration\n"; } + + ($tmp, $tmp, $extras) = split (" ", `gconfig -c $recipefile $filter`); + if ($?) { die "ERROR: missing detrend recipe for $filter\n"; } + + # all filters have 'flat', grab extras: + ($detype, $minflux, $min) = split (",", $extras); + if ("\U$detype\E" ne "FLAT") { die "ERROR: flat extras are missing\n"; } +} + +$CCDWORD = `gconfig CCDNUM-KEYWORD`; chop $CCDWORD; +$CHIPSKIP = `gconfig CHIP_SKIP_LIST`; chop $CHIPSKIP; +@chipskip = (); +if (-e $CHIPSKIP) { + open (FILE, $CHIPSKIP); + @chipskip = ; + close (FILE); + foreach $chip (@chipskip) { chop $chip; } +} + +# relevant camera parameters +$Nccd = `cameraconfig -Nccd`; chop ($Nccd); +if ($?) { die "error in config\n"; } + +($Naxis1, $Naxis2) = split (" ", `cameraconfig -axes`); +if ($?) { die "error in config\n"; } + +@ccds = split (" ", `cameraconfig -ccds`); +if ($?) { die "error in config\n"; } + +@ccdn = split (" ", `cameraconfig -ccdn`); +if ($?) { die "error in config\n"; } + +@good = (); +@marginal = (); + +# define filter lines for imsearch. for flats, there may be alternate filter names to test +@filtline = (); +if ($type eq "FLAT") { + # convert given filter name to list of possible names: + @filtlist = split (" ", `filtnames $filter -all`); + foreach $filt (@filtlist) { + push @filtline, "-type flat -filter $filt -mode $mode -trange $start $stop"; + } +} +if ($type eq "BIAS") { + push @filtline, "-type bias -mode $mode -trange $start $stop"; +} +if ($type eq "DARK") { + push @filtline, "-type dark -etime $ARGV[1] -mode $mode -trange $start $stop"; +} + +# run selection on each possible $filtline +@list = (); +foreach $line (@filtline) { + @tlist = `imsearch -ccd $ccds[0] $line`; + @list = (@list, @tlist); +} +$Nlist = @list; +print STDERR "found $Nlist images\n"; + +FRAME: +foreach $frame (@list) { + @words = split (" ", $frame); + + # skip domeflat images + if ($SKIPDOME && ($type eq "FLAT")) { + # a fairly lame and non-robust way to detect dome flats + @answer = `echo $words[4]/$words[5] | fields OBJECT | grep -i dome`; + if ($answer[0] ne "") { print STDERR "$words[5] rejected: dome flat\n"; next FRAME; } + + # test for acceptable time (or is probably a dome flat) + $answer = `dusktime $words[8]`; + ($tmp, $tmp, $dt) = split (" ", $answer); + if ($dt < 0) { print STDERR "$words[5] rejected: not twilight\n"; next FRAME; } + } + + # image(s) must exist on disk: + if ($mode eq "SPLIT") { + # all $Nccd images must exist on disk, split files are assumed to be + # in a subdirectory of their own, .fits extension assumed + @answer = <$words[4]/*.fits>; + if (@answer != $Nccd) { print STDERR "$words[5] rejected: missing images\n"; next FRAME; } + } else { + # base file should exist: + if (! -e "$words[4]/$words[5]") { print STDERR "file $words[4]/$words[5] missing, skipping\n"; next FRAME; } + } + + # images have to have the correct dimensions + if ($mode eq "SPLIT") { + ($tmp, $Nx, $Ny) = split (" ", `echo $words[4]/$words[5] | fields NAXIS1 NAXIS2`); + } else { + ($tmp, $Nx, $Ny) = split (" ", `echo $words[4]/$words[5] | fields -x 0 NAXIS1 NAXIS2`); + } + if ($?) { print STDERR "failure to find NAXIS1, NAXIS2 in file $words[4]/$words[5], skipping\n"; next FRAME; } + if ($Nx != $Naxis1) { print STDERR "$words[5] rejected: wrong dimensions\n"; next FRAME; } + if ($Ny != $Naxis2) { print STDERR "$words[5] rejected: wrong dimensions\n"; next FRAME; } + + # must have Nccd entries in db: + if ($mode eq "SPLIT") { + @answer = split ("/", $words[4]); + $match = $answer[-1]; + } else { + $match = $words[5]; + } + @list2 = `imsearch -name $match`; + if (@list2 != $Nccd) { print STDERR "$words[5] rejected: missing entries in image database\n"; next FRAME; } + + # test flux levels for FLATS + if ($type eq "FLAT") { + CHIP: # check for counts or flux out of range or any chip + foreach $chip (@list2) { + @words2 = split (" ", $chip); + foreach $chipskip (@chipskip) { + if ($words2[3] eq $chipskip) { next CHIP; } + } + + # test for acceptable counts range + if ($words2[11] < $min) { print STDERR "$words[5] rejected: signal too low: $words2[11] vs $min\n"; next FRAME; } + if ($words2[11] > $max) { print STDERR "$words[5] rejected: signal too high: $words2[11] vs $max\n"; next FRAME; } + + # test for acceptable flux + if ($words2[7] > 0.0) { + $Flux = $words2[11] / $words2[7]; + } else { + $Flux = 0.0; + } + if ($Flux < $minflux) { print STDERR "$words[5] rejected: flux too low: $Flux vs $minflux\n"; next FRAME; } + } + } + # test bias levels for BIAS / DARK + if (($type eq "BIAS") || ($type eq "DARK")) { + CHIP: # check for values in bias column + foreach $chip (@list2) { + @words2 = split (" ", $chip); + if ($words2[10] == 0.0) { print STDERR "$words[5] rejected: no imstats\n"; next FRAME; } + } + } + + # add good images to the output lists (use CCD N for output filenames, CCD ID for [extname] in mef files) + # entries are not guaranteed to be in CCD N sequence + + foreach $line (@list2) { + @words2 = split (" ", $line); + $ccdid = $words2[3]; + if ($mode eq "MEF") { + @$ccdid = (@$ccdid, "$words2[4]/$words2[5]\[$ccdid]"); + } else { + @$ccdid = (@$ccdid, "$words2[4]/$words2[5]"); + } + } + if (($type eq "BIAS") && (@$ccdid > 30)) { last FRAME; } + if (($type eq "DARK") && (@$ccdid > 30)) { last FRAME; } + if (($type eq "FLAT") && (@$ccdid > 50)) { last FRAME; } +} + +# write output to Nccd list files +for ($i = 0; $i < $Nccd; $i++) { + $ccd = $ccdn[$i]; + $ccdid = $ccds[$i]; + + $name = $output; + $name =~ s/CCDNUM/$ccd/; + + open (LIST, ">$name"); + foreach $line (@$ccdid) { + print LIST "$line\n"; + } + close (LIST); +} +print STDERR "SUCCESS\n\n"; +exit 0; + +# we need to select the list of images which satisfy a few criteria: +# 1) all 12 CCDs must exist +# 2) stats must be measured for each +# 3) stats for all 12 must be within range (2000 - 40000) +# 4) NAXIS1 == 2080 && NAXIS2 == 4128 + + +sub vsystem { + print STDERR "@_\n"; + $status = system ("@_"); + $status; +} + +sub goodbye { + print STDERR "ending execution\n"; + die "@_"; +} + Index: /tags/ohana/perl-1-3/Ohana/src/perl/src/elixir.export =================================================================== --- /tags/ohana/perl-1-3/Ohana/src/perl/src/elixir.export (revision 21906) +++ /tags/ohana/perl-1-3/Ohana/src/perl/src/elixir.export (revision 21906) @@ -0,0 +1,88 @@ +#!/usr/bin/env perl + +if (@ARGV != 3) { die "ERROR: usage: elixir.export (rawfile) (datfile) (mode)\n"; } + +$datdir = `gconfig DATDIR`; chop $datdir; +$logdir = `gconfig LOGDIR`; chop $logdir; +$config = "$datdir/export.conf"; + +$rawfile = $ARGV[0]; +$datfile = $ARGV[1]; +$MODE = $ARGV[2]; + +if (! -e $config) { die "ERROR: config file $config missing\n"; } + +open (FILE, $config); +while ($line = ) { + if ($line =~ /^\s*$/) { next; } # skip empty lines + if ($line =~ /^\s*\#/) { next; } # skip commented lines + $Nlist = ($id, $runids, $filters, $modes, $outdir) = split (" ", $line); + if ($Nlist != 6) { print STDERR "WARNING: error in config file: $line\n"; } + push @id, $id; + $runids{$id} = $runids; + $filters{$id} = $filters; + $modes{$id} = $modes; + $outdir{$id} = $outdir; +} +close (FILE); + +($tmp, $RUNID) = split (" ", `echo $rawfile | fields RUNID`); +($tmp, $FILTER) = split (" ", `echo $rawfile | fields FILTER`); + +$FILTER = `filtnames $FILTER`; chop $FILTER; + +open (LOG, ">>$logdir/export.log"); + +if ($MODE eq "any") { goto wanted; } + +foreach $id (@id) { + + if (!findword ($MODE, $modes{$id})) { next; } + if (!findword ($RUNID, $runids{$id})) { next; } + if (!findword ($FILTER, $filters{$id})) { next; } + + # success, copy datfile to outdir: + + system ("cp $datfile $outdir{$id}\n"); + if ($?) { print STDERR "WARNING: can't write $datfile to $outdir{$id}\n"; } + + open (FILE, ">>$outdir/export.tbl"); + print FILE "$datfile\n"; + close (FILE); + + print LOG "export $datfile to $outdir for $id\n"; +} +close (LOG); + +print STDERR "SUCCESS: export $datfile to $outdir for $id\n"; +exit 0; + +wanted: +foreach $id (@id) { + + if (!findword ($RUNID, $runids{$id})) { next; } + if (!findword ($FILTER, $filters{$id})) { next; } + + print LOG "export $datfile is wanted, process\n"; + close (LOG); + print STDERR "SUCCESS: $datfile is wanted\n"; + exit 0; +} + +print LOG "export $datfile is not wanted, skip\n"; +close (LOG); +print STDERR "ERROR: $datfile is not wanted\n"; +exit 1; + +sub findword { + # findword $WORD $list + $WORD = "\U$_[0]\E"; + $list = $_[1]; + + @word = split (",", $list); + foreach $word (@word) { + $word = "\U$word\E"; + if ($word eq $WORD) { return 1; } + } + return 0; +} Index: /tags/ohana/perl-1-3/Ohana/src/perl/src/elixir.link =================================================================== --- /tags/ohana/perl-1-3/Ohana/src/perl/src/elixir.link (revision 21906) +++ /tags/ohana/perl-1-3/Ohana/src/perl/src/elixir.link (revision 21906) @@ -0,0 +1,150 @@ +#!/usr/bin/env perl + +# this script searches for new links in the archive elixir directory, +# creates links for the new images in the elixir TMPDIR tree, +# registers the images in the elixir database, and +# sends the images to imstats for processing. + +use English; + +# check usage +if (@ARGV != 0) { die "USAGE: elixir.link\n"; } + +# what do we do about config file? demand account be set up correctly? +$camera = `gconfig CAMERA.CURRENT`; chop $camera; +$runid = `gconfig RUNID.CURRENT`; chop $runid; +$opts = "-D CAMERA $camera -D RUNID $runid"; + +{ # check camera validity + if ($camera eq "cfh12k") { last; } + if ($camera eq "megacam") { last; } + if ($camera eq "meganorth") { last; } + if ($camera eq "cfhtir") { last; } + die "invalid camera $camera"; +} + +$fifos = `gconfig $opts FIFOS`; chop $fifos; +if ($?) { die "error in config system: missing FIFOS\n"; } + +$rawdir = `gconfig $opts RAWDIR`; chop $rawdir; +if ($?) { die "error in config system: missing RAWDIR\n"; } + +$linkdir = `gconfig $opts ARCLINK_DIR`; chop $linkdir; +if ($?) { die "error in config system: missing ARCLINK_DIR\n"; } + +$archive = `gconfig $opts ARCHIVE_DIR`; chop $archive; +if ($?) { die "error in config system: missing ARCHIVE_DIR\n"; } + +@links = glob ("$linkdir/*"); + +if (! @links) { exit 0; } + +$Ngood = 0; +$Nskip = 0; +$Nfail = 0; + +foreach $name (@links) { + if (! -l $name) { $Nskip ++; next; } + + # find real path + $rootname = filename ($name); + $arcfile = sprintf "%s/%s", $archive, $rootname; + + # set new path (skip if it exists) + $rawfile = sprintf "%s/%s", $rawdir, $rootname; + if ((-e $rawfile) || (-l $rawfile)) { + $Nskip ++; + unlink ($name); + next; + } + + # link file into rawdir: + $status = symlink ($arcfile, $rawfile); + if (! $status) { + $Nfail ++; + next; + } + + # these files always come in as MEF or CUBE + # -needtype will skip focus frames + vsystem ("imsort -needtype $opts $rawfile"); + if ($?) { + # allow for retry on failure + $Nfail ++; + + # save links for record. + if (! -d "$linkdir/failure") { mkdir "$linkdir/failure"; } + system ("mv $name $linkdir/failure/"); + next; + } + + $Ngood ++; + unlink $name; +} + +print STDERR "elixir.link: $Ngood good, $Nskip skip, $Nfail fail\n"; +exit 0; + +# utilities ############################################## + +sub vsystem { + print STDERR "@_\n"; + my ($status) = system ("@_"); + $status; +} + +sub filename { + + my ($path) = $_[0]; + my (@tmp); + + @tmp = split ("/", $path); + return $tmp[-1]; +} + +sub convertlink { + my ($link) = $_[0]; + my ($file); + + while (-l $link) { + $file = readlink ($link); + $path1 = path ($link); + $path2 = path ($file); + + unless ($path2 =~ m|^/|) { + $file = "$path1/$file"; + } + $link = $file; + } + return ($link); +} + +sub usage { + + if (@ARGV == 1) { + print STDERR "\n --- user modes ---\n"; + print STDERR "create (run) (start) (stop)\n"; + print STDERR "addqso (runid) (qsoid)\n"; + print STDERR "delqso (qsoid)\n"; + print STDERR "sched (runid)\n"; + print STDERR "status\n"; + &goodbye; + } + + if (@ARGV > 2) { print STDERR "USAGE: prepare.run (help) [mode]\n"; &goodbye; } + + &goodbye; +} + +sub path { + + my ($file) = $_[0]; + + @words = split ("/", $file); + + pop (@words); + + $path = join ("/", @words); + + return ($path); +} Index: /tags/ohana/perl-1-3/Ohana/src/perl/src/elixir.photreport =================================================================== --- /tags/ohana/perl-1-3/Ohana/src/perl/src/elixir.photreport (revision 21906) +++ /tags/ohana/perl-1-3/Ohana/src/perl/src/elixir.photreport (revision 21906) @@ -0,0 +1,48 @@ +#!/usr/bin/env perl + +if (@ARGV != 2) { die "USAGE : elixir.photreport (name) (catdir)\n"; } + +$name = $ARGV[0]; +$catdir = $ARGV[1]; + +# test named Xserver, or start vnc on specified machine +$xhost = `gconfig XHOST`; chop $xhost; +$xdisp = `gconfig XDISP`; chop $xdisp; +if (system ("/usr/bin/X11/xdpyinfo -display $xdisp")) { + print STDERR "X server is not running. start it now on $xhost\n"; + exit 1; +} +$ENV{'DISPLAY'} = $xdisp; + +# select filters +@filter = split (" ", `filtnames list`); + +$logdir = `gconfig LOGDIR`; chop $logdir; +$confdir = `gconfig CONFDIR`; chop $confdir; +$script = "$confdir/mana/standards"; + +# run mana, call script +open (STAT, "|dvo -D CATDIR $catdir --norc"); +print STAT "input $script\n"; + +# place commands in a macro +print STAT "macro go\n"; +foreach $filter (@filter) { + @word = split (" ", `filtnames $filter -cal`); + if (@word[1] == 0) { next; } + $target = $word[2]; + print STAT "echo $filter -> $target\n"; + print STAT "photreport $target $name\n"; +} +print STAT "exit 0\n"; +print STAT "end\n"; + +print STAT "go\n"; +print STAT "exit 1\n"; +close (STAT); +if ($?) { + print STDERR "ERROR problem with photreport\n"; + exit 1; +} +print STDOUT "SUCCESS: finished with photreport\n"; +exit 0; Index: /tags/ohana/perl-1-3/Ohana/src/perl/src/elixir.postrun =================================================================== --- /tags/ohana/perl-1-3/Ohana/src/perl/src/elixir.postrun (revision 21906) +++ /tags/ohana/perl-1-3/Ohana/src/perl/src/elixir.postrun (revision 21906) @@ -0,0 +1,690 @@ +#!/usr/bin/env perl + +# check usage +if (@ARGV == 0) { &usage; } +if ($ARGV[0] eq "help") { &usage; } + +@ARGV = elixir_config (@ARGV); + +if ($ARGV[0] eq "config") { &set_config; } +if ($ARGV[0] eq "set") { &set_entry; } +if ($ARGV[0] eq "state") { &state; } +if ($ARGV[0] eq "update") { &update; } + +&load_state; + +if ($ARGV[0] eq "imstats") { &imstats_state ("imstats"); &save_state; &goodbye; } +if ($ARGV[0] eq "ptolemy") { &ptolemy_state ("ptolemy"); &save_state; &goodbye; } +if ($ARGV[0] eq "standards") { &standards_state ("standards"); &save_state; &goodbye; } +if ($ARGV[0] eq "validate") { &validate_state ("validate"); &save_state; &goodbye; } + +&escape ("unknown command $ARGV[0]"); + +############# change current run ############## +sub set_config { + if (@ARGV != 3) { &escape ("USAGE: elixir.postrun config (camera) (run)"); } + + $camera = $ARGV[1]; + $run = $ARGV[2]; + + # set current run id: + system ("mkrun sys camera.postrun $camera"); + if ($?) { &escape ("can't define camera: error in mkrun"); } + + # set current run id: + system ("mkrun sys runid.postrun $run"); + if ($?) { &escape ("can't define run: error in mkrun"); } + + &goodbye; +} + +############## +sub state { + print STDOUT "CAMERA: $camera\n"; + print STDOUT "RUNID: $runid\n"; + print STDOUT "RUNDIR: $rundir\n"; + + &load_state; + foreach $entry (@entry) { + printf STDERR "%-15s %-10s\n", $entry, $state{$entry}; + } + &goodbye; +} + +############## +sub load_state { + # db contains: (entry) (state) + open (FILE, $dbfile); + @list = ; + close (FILE); + + # there should be one line for each possible entry in @entry + # if a line is missing, set it to init + # if a line is extra, kill it. + + # look for invalid entries + foreach $line (@list) { + ($entry, $state) = split (" ", $line); + if (! $def_state{$entry}) { next; } + $state{$entry} = $state; + } + + # look for missing entries + foreach $entry (@entry) { + if (! $state{$entry}) { $state{$entry} = $def_state{$entry}; } + } +} + +############## +sub save_state { + open (FILE, ">$dbfile"); + foreach $entry (@entry) { + print FILE "$entry $state{$entry}\n"; + } + close (FILE); +} + +############## +sub set_entry { + + if (@ARGV != 3) { &escape ("USAGE: elixir.postrun set (entry) (value)"); } + + $reset = $ARGV[1]; + $value = $ARGV[2]; + + &load_state; + + if (! $state{$reset}) { &escape ("invalid entry $reset"); } + + $state{$reset} = $value; + &save_state; + &goodbye; +} + +############## +sub update { + + &load_state; + + foreach $entry (@entry) { + update_state ($entry); + printf STDERR "%-15s %-10s\n", $entry, $state{$entry}; + } + + &save_state; + &goodbye; +} + +############## +sub update_state { + + my ($entry) = $_[0]; + + if ($entry eq "camera") { &camera_state ($entry); } + if ($entry eq "imstats") { &imstats_state ($entry); } + if ($entry eq "mkdetrend") { &detrend_state ($entry); } + if ($entry eq "mkfringe") { &detrend_state ($entry); } + if ($entry eq "ptolemy") { &ptolemy_state ($entry); } + if ($entry eq "standards") { &standards_state ($entry); } + if ($entry eq "validate") { &validate_state ($entry); } +} + +############## +sub ptolemy_state { + + my ($entry) = "ptolemy"; + $current = $state{$entry}; + if (! $current) { &escape ("error: ptolemy state not set?"); } + + $fifos = `gconfig FIFOS`; chop $fifos; + $ptlist = "$datdir/$runid/$runid.ptlist"; + $ptlog = "$datdir/$runid/$runid.log"; + + # if we can, run 'elixir complete' + if (($current eq "init") && ($state{"mkdetrend"} eq "done")) { + $state{$entry} = "running"; + &save_state; + + if (-e "$fifos/complete.pid") { + print STDERR "elixir (sex)complete already running? check pid file $fifos/complete.pid"; + &save_escape ($entry, "failed to start ptolemy"); + } + + if (! -d "$datdir/$runid") { mkdir ("$datdir/$runid", 0777); } + ($tmp, $start, $stop) = split (" ", `mkrun run $runid`); + if ($?) { &save_escape ($entry, "error in RUNID $runid"); } + vsystem ("imsearch -type object -trange $start $stop -pt > $ptlist"); + if ($?) { &save_escape ($entry, "error extracting images from db"); } + vsystem ("elixir -D mode sexcomplete $ptlist >& $ptlog &"); + + # wait for up to 10 seconds for $fifos/complete.pid to exist + for ($Nwait = 0; ($Nwait < 30) && (! -e "$fifos/complete.pid"); $Nwait ++) { sleep 2; } + + + if (! -e "$fifos/complete.pid") { &save_escape ($entry, "failed to start elixir (sex)complete"); } + } + + # has 'elixir complete' finished? successfully? + if ($current eq "running") { + if (-e "$fifos/complete.end") { + $answer = `wc -l $fifos/complete.success`; + ($Nsuccess) = split (" ", $answer); + $answer = `wc -l $fifos/complete.failure`; + ($Nfailure) = split (" ", $answer); + $answer = `wc -l $ptlist`; + ($Ntotal) = split (" ", $answer); + + $state{$entry} = "fail"; + if ($Nsuccess > 0.8*$Ntotal) { + $state{$entry} = "done"; + } else { + print STDERR "too many failures: $Nsuccess of $Ntotal\n"; + } + if ($Nsuccess + $Nfailure > $Ntotal) { + print STDERR "output list is inconsistent\n"; + $state{$entry} = "fail"; + } + } + if ((! -e "$fifos/complete.end") && (! -e "$fifos/complete.pid")) { + print STDERR "elixir complete killed?\n"; + $state{$entry} = "fail"; + } + } +} + +############## +sub standards_state { + + my ($entry) = "standards"; + $current = $state{$entry}; + + print "entry: $entry\n"; + print "current: $current\n"; + + if (! $current) { &escape ("error: standards state not set?"); } + + # if elixir complete is done, add standards, run photometry routines + if (($current eq "init") && ($state{"ptolemy"} eq "done")) { + $state{$entry} = "running"; + &save_state; + + $refs = `gconfig REFSDIR`; chop $refs; + $stds = "$refs/standards"; + + # insert standards in photometry database + foreach $filter (@filter) { + @words = split (" ", `filtnames $filter -cal`); + if ($words[1] == 0) { next; } + $photref = $words[2]; + vsystem ("addstar -replace -v -ref $stds/$photref.dat -p $photref"); + } + + # cd to $rundir so photreport plots land there? + chdir $rundir; + + # run elixir.photreport to generate plots (eg 02Ak03.B.time.png) and phot.reg files + vsystem ("elixir.photreport $runid $catdir"); + if ($?) { goto standards_fail; } + + # load lines from phot.reg files and execute: + @reglist = (); + foreach $filter (@filter) { + $regfile = "$runid.$filter.phot.reg"; + open (FILE, $regfile); + @list = ; + close (FILE); + @reglist = (@reglist, @list); + } + foreach $line (@reglist) { + vsystem ($line); + } + + # get date range for this run + $answer = `mkrun run $runid`; + ($tmp, $start, $stop) = split (" ", $answer); + if ($start eq "") { &escape ("error with date range: $line"); } + if ($stop eq "") { &escape ("error with date range: $line"); } + + # create transparency list, execute + vsystem ("mktrans $start $stop > $runid.trans.reg"); + open (FILE, "$runid.trans.reg"); + @list = ; + close (FILE); + foreach $line (@list) { + vsystem ($line); + } + + # create transparency report, execute + vsystem ("mktreport $start $stop > $runid.trans.txt"); + + $state{$entry} = "done"; + &save_state; + } + return; + + standards_fail: + $state{$entry} = "fail"; + return; +} + +############## +sub camera_state { + + # camera : 'pending' (date < start) + # camera : 'on' (date in range start - stop) + # camera : 'off' (date > stop) + + # transition on -> off : trigger message about mkdetrend + + # get date range for this run + $answer = `mkrun run $runid`; + ($tmp, $start, $stop) = split (" ", $answer); + if ($start eq "") { &escape ("error with date range: $line"); } + if ($stop eq "") { &escape ("error with date range: $line"); } + $mjd_start = &date_to_mjd ($start); + $mjd_stop = &date_to_mjd ($stop); + + # get current value of mjd + ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday) = gmtime (); + $year += 1900; + $mon += 1; + $mjd_now = &get_mjd ($year, $mon, $mday); + + # check appropriate state + $state = "on"; + if ($mjd_now < $mjd_start) { $state = "pending"; } + if ($mjd_now > $mjd_stop) { $state = "off"; } + + # if we are at end of run, check that mkdetrend has been started + if (($state{"camera"} eq "on") && ($state eq "off")) { + if ($state{"mkdetrend"} eq "init") { + ¬ify ("start mkdetrend"); + } + } + $state{"camera"} = $state; +} + +############## +sub notify { + print STDERR "$_[0]\n"; +} + +############## +sub validate_state { + + my ($entry) = "validate"; + $current = $state{$entry}; + if (! $current) { &escape ("error: validate state not set?"); } + + chdir $rundir; + + # if elixir complete is done, add standards, run photometry routines + if (($current eq "init") && ($state{"standards"} eq "done")) { + $state{$entry} = "running"; + &save_state; + + # find the first unused val file (run.val.N) + $ver = 1; + $outfile = "$rundir/$runid.val.$ver"; + while (-e $outfile) { + $ver ++; + $outfile = "$rundir/$runid.val.$ver"; + } + + # run first pass + vsystem ("validate $runid > $outfile"); + if ($?) { goto validate_fail; } + + # check output results + print STDERR "validate $runid -stats -infile $outfile\n"; + @result = `validate $runid -stats -infile $outfile`; + if ($?) { goto validate_fail; } + + system ("validate $runid -infile $outfile -update"); + + # order should be: run, valid, invalid, subvalid, dataerr + ($value, $Nvalid) = split (" ", $result[1]); + if ($value ne "valid") { goto validate_fail; } + ($value, $Ninvalid) = split (" ", $result[2]); + if ($value ne "invalid") { goto validate_fail; } + ($value, $Nsubvalid) = split (" ", $result[3]); + if ($value ne "subvalid") { goto validate_fail; } + ($value, $Ndataerr) = split (" ", $result[4]); + if ($value ne "dataerr") { goto validate_fail; } + + if ($invalid > 0) { goto validate_fail; } + if ($dataerr > 0) { goto validate_fail; } + + # if we pass validation, run validate -update: + + $state{$entry} = "done"; + } + + if ($current eq "fail") { + + # recheck the last validation file (run.val.N) + $outfile = ""; + $ver = 1; + $try = "$rundir/$runid.val.$ver"; + while (-e $try) { + $outfile = $try; + $ver ++; + $try = "$rundir/$runid.val.$ver"; + } + if ($outfile eq "") { goto validate_fail; } + + # check output results + print STDERR "validate $runid -stats -infile $outfile\n"; + @result = `validate $runid -stats -infile $outfile`; + if ($?) { goto validate_fail; } + + system ("validate $runid -infile $outfile -update"); + + # order should be: run, valid, invalid, subvalid, dataerr + $Nvalid = $Ninvalid = $Nsubvalid = $Ndataerr = -1; + foreach $line (@result) { + ($value, $Nvalue) = split (" ", $line); + if ($value eq "valid") { $Nvalid = $Nvalue; } + if ($value eq "invalid") { $Ninvalid = $Nvalue; } + if ($value eq "subvalid") { $Nsubvalid = $Nvalue; } + if ($value eq "dataerr") { $Ndataerr = $Nvalue; } + } + if ($Nvalid == -1) { goto validate_fail; } + if ($Nsubvalid == -1) { goto validate_fail; } + if (($Ninvalid == -1) || ($Ninvalid > 0)) { goto validate_fail; } + if (($Ndataerr == -1) || ($Ndataerr > 0)) { goto validate_fail; } + + # if we pass validation, run validate -update: + $state{$entry} = "done"; + } + return ; + + validate_fail: + $state{$entry} = "fail"; + return; +} + +############## +sub imstats_state { + + my ($entry) = "imstats"; + $current = $state{$entry}; + if (! $current) { &escape ("error: imstats state not set?"); } + + $fifos = `gconfig FIFOS`; chop $fifos; + $pid = "$fifos/imstats.pid"; + $end = "$fifos/imstats.pid"; + $ptlist = "$datdir/$runid/$runid.redo.list"; + $ptlog = "$datdir/$runid/$runid.redo.log"; + + # if we can, run 'elixir complete' + if (($current eq "init") && ($state{"camera"} eq "off")) { + $state{$entry} = "running"; + &save_state; + + # check for currently running imstats + if (-e $pid) { + print STDERR "elixir imstats still running?\n"; + print STDERR "run 'elixir -C $camera -D mode imstats -kill' to stop\n"; + &save_escape ($entry, "failure on imstats"); + } + + # extract redo list, run processing + ($tmp, $start, $stop) = split (" ", `mkrun run $runid`); + if ($?) { &save_escape ($entry, "error in RUNID $runid"); } + vsystem ("imsearch -trange $start $stop -proc f -pt > $ptlist"); + if ($?) { &save_escape ($entry, "error extracting unprocessed data"); } + vsystem ("elixir -D mode imstats $ptlist >& $ptlog &"); + + # wait for up to 10 seconds for $pid to exist + for ($Nwait = 0; ($Nwait < 30) && (! -e "$pid"); $Nwait ++) { sleep 2; } + if (! -e "$pid") { &save_escape ($entry, "failed to start elixir imstats"); } + } + + # has 'elixir complete' finished? successfully? + if ($current eq "running") { + if (-e "$fifos/imstats.end") { + $answer = `wc -l $fifos/imstats.success`; + ($Nsuccess) = split (" ", $answer); + $answer = `wc -l $fifos/imstats.failure`; + ($Nfailure) = split (" ", $answer); + $answer = `wc -l $ptlist`; + ($Ntotal) = split (" ", $answer); + + print "Ntotal: $Ntotal\n"; + print "Nsuccess: $Nsuccess\n"; + print "Nfailure: $Nfailure\n"; + + if ($Nsuccess < 0.5*$Ntotal) { &save_escape ($entry, "too many failures: $Nsuccess of $Ntotal"); } + if ($Nsuccess + $Nfailure > $Ntotal) { &save_escape ($entry, "output list is inconsistent"); } + $state{$entry} = "done"; + &save_state; + return; + } + if ((! -e "$fifos/imstats.end") && (! -e "$fifos/imstats.pid")) { &save_escape ($entry, "elixir complete killed?"); } + } +} + +############## +sub detrend_state { + + # force sequencing (mkdetrend -> mkfringe): + if (($entry eq "mkfringe") && ($state{"mkdetrend"} ne "done")) { + $state{$entry} = "init"; + return; + } + + # mkdetrend & mkfringe determine run from their own references, + # which can be overridden with the '-run RUNID' flag + + # determine state from mkdetrend / mkfringe response + $entry = $_[0]; + print STDERR "$entry state\n"; + @list = `$entry state`; + print STDERR "@list\n"; + + # skip first 4 lines + shift @list; shift @list; shift @list; shift @list; shift @list; + + $Ninit = $Nfail = $Ndone = $Nrun = $Nmiss = 0; + foreach $line (@list) { + # interesting values for state: + # init, not.available, running.xxx, done, fail.xxx + @words = split (" ", $line); + if ($words[7] eq "not.available") { $Nmiss ++; } + if ($words[7] eq "init") { $Ninit ++; } + if ($words[7] eq "done") { $Ndone ++; } + if ($words[7] eq "clean") { $Ndone ++; } + if ($words[7] =~ /^fail./) { $Nfail ++; } + if ($words[7] =~ /^running./) { $Nrun ++; } + } + + $state = "running"; + if ($Ninit > 0) { $state = "init"; } + if ($Nfail > 0) { $state = "fail"; } + if ($Nrun > 0) { $state = "running"; } + if ($Ndone + $Nmiss == @list) { $state = "done"; } + + # check for mkdetrend transition -> "done" + if (($entry eq "mkdetrend") && ($state{$entry} ne "done") && ($state eq "done")) { + ¬ify ("start mkfringe"); + } + + $state{$entry} = $state; +} + +####################################### + +sub vsystem { + print STDERR "@_\n"; + my($status) = system ("@_"); + $status; +} + +sub goodbye { + unlink $tmpenv; + if ($_[0]) { + print STDERR "@_\n"; + } + exit 0; +} + +sub escape { + unlink $tmpenv; + print "$_[0]\n"; + exit 1; +} + +sub save_escape { + my ($entry) = $_[0]; + my ($message) = $_[1]; + $state{$entry} = "fail"; + &save_state; + &escape ($message); +} + +sub elixir_config { + my (@arg) = @_; + my ($opt, $config, @tmparg, $status); + $config = ""; + if ($ENV{'PTOLEMY'}) { $config = "-c $ENV{'PTOLEMY'}"; } + + # default values, override on command line + $runid = `gconfig RUNID.POSTRUN`; chop $runid; + $camera = `gconfig CAMERA.POSTRUN`; chop $camera; + + # extract command line options + @tmparg = (); + while (@arg > 0) { + + # grab elixir/ptolemy config option -c + if ($arg[0] eq "-c") { + shift @arg; + $config = "-c $arg[0]"; + shift @arg; + next; + } + + # grab elixir/ptolemy config option -C + if ($arg[0] eq "-C") { + @opt = (@opt, $arg[0]); + shift @arg; + @opt = (@opt, $arg[0]); + $elconf = $arg[0]; + shift @arg; + next; + } + + # grab elixir/ptolemy config option -D + if ($arg[0] eq "-D") { + @opt = (@opt, $arg[0]); + shift @arg; + @opt = (@opt, $arg[0]); + shift @arg; + @opt = (@opt, $arg[0]); + shift @arg; + next; + } + + # by default, $run is loaded from state.data file + if ($arg[0] eq "-run") { + shift @arg; + $runid = $arg[0]; + shift @arg; + next; + } + + # by default, $camera is loaded from state.data file + if ($arg[0] eq "-camera") { + shift @arg; + $camera = $arg[0]; + shift @arg; + next; + } + @tmparg = (@tmparg, $arg[0]); + shift @arg; + } + + # create temporary ptolemy.rc file: + $catdir = `gconfig DB_STDS -D RUNID $runid -D CAMERA $camera`; chop $catdir; + @opt = (@opt, "-D CATDIR $catdir"); + @opt = (@opt, "-D RUNID $runid"); + @opt = (@opt, "-D CAMERA $camera"); + @opt = (@opt, "-D RUNID.MKDETREND $runid"); + @opt = (@opt, "-D CAMERA.MKDETREND $camera"); + @opt = (@opt, "-D RUNID.MKFRINGE $runid"); + @opt = (@opt, "-D CAMERA.MKFRINGE $camera"); + + $config = join (" ", $config, @opt); + $tmpenv = `mktemp /tmp/elixir.XXXXXX`; chop ($tmpenv); + $status = system ("gconfig -raw $config > $tmpenv"); + if ($status) { &escape ("error in elixir configuration: gconfig fails"); } + + $ENV{'PTOLEMY'} = "$tmpenv"; + + # global variables + # add this from the filter configuration system, eventually + @filter = split (" ", `filtnames list`); + + @def_state = ("camera", "off", + "imstats", "init", + "mkdetrend", "init", + "mkfringe", "init", + "ptolemy", "init", + "standards", "init", + "validate", "init"); + %def_state = @def_state; + + # generate list of keys + @entry = (); + foreach $name (@def_state) { + push @entry, $name; + shift @def_state; + } + + # global configuration variables + $datdir = `gconfig DATDIR`; chop $datdir; + $rundir = "$datdir/$runid"; + $dbfile = "$rundir/postrun.db"; + + if (! -d $rundir) { mkdir ($rundir, 0777); } + + return (@tmparg); +} + +sub set_globals { +} + +sub date_to_mjd { + my ($date) = $_[0]; + my ($year, $month, $day, $mjd); + + ($year, $month, $day) = $date =~ /(\d+)\/(\d+)\/(\d+)/; + $mjd = get_mjd ($year, $month, $day); + + return ($mjd); +} + +sub get_mjd { + + my($year) = $_[0]; + my($month) = $_[1]; + my($day) = $_[2]; + + my($jd) = $day - 32075 + int (1461*($year + 4800 + int (($month - 14)/12))/4) + + int(367*($month - 2 - int(($month - 14)/12)*12)/12) + - int(3*int(($year + 4900 + int(($month - 14)/12))/100)/4) - 0.5 - 2400000.5; + + + return ($jd); + +} + +sub usage { + + print STDERR "elixir.postrun (mode)\n"; + print STDERR " state - show current states\n"; + print STDERR " update - update system states\n"; + print STDERR " set (entry) (value) - manually set a state\n"; + &goodbye; +} Index: /tags/ohana/perl-1-3/Ohana/src/perl/src/elixir.reload =================================================================== --- /tags/ohana/perl-1-3/Ohana/src/perl/src/elixir.reload (revision 21906) +++ /tags/ohana/perl-1-3/Ohana/src/perl/src/elixir.reload (revision 21906) @@ -0,0 +1,57 @@ +#!/usr/bin/env perl + +if (@ARGV != 1) { die "USAGE: elixir.reload (elixir)\n"; } + +$elixir = $ARGV[0]; + +# if an elixir is not running, start it, send output to $logdir/$elixir.log +$logdir = `gconfig LOGDIR`; chop $logdir; +if ($?) { die "error getting LOGDIR from configuration system\n"; } +chdir $logdir; + +$pidfile = `gconfig -D mode $elixir global.pid`; chop ($pidfile); +if ($?) { die "error getting PID from configuration system - is elixir $elixir defined?\n"; } + +# check that elixir is running +if (! -f $pidfile) { &launch ($elixir, $logdir); } + +# load pid information +open (FILE, "$pidfile"); +@list = ; +close (FILE); + +($name, $pid) = split (" ", $list[0]); +($name, $user) = split (" ", $list[1]); +($name, $machine) = split (" ", $list[2]); + +# check that this process exists? +@list = `rsh $machine /bin/ps -A -o pid,cmd`; +$dead = 1; +foreach $line (@list) { + ($rpid, $cmd) = split (" ", $line); + if (($rpid == $pid) && ($cmd =~ /elixir/)) { + $dead = 0; + print STDERR "elixir $elixir is running as $pid on $machine\n"; + last; + } +} +if ($dead) { + unlink ($pidfile); + &launch ($elixir, $logdir); +} + +# send USR1 signal to process: +print STDERR "restarting process $pid\n"; +system ("rsh $machine kill -USR1 $pid"); +exit 0; + +sub launch { + + my ($elixir) = $_[0]; + my ($logdir) = $_[1]; + + # if elixir is not running, start it + print STDERR "starting elixir $elixir\n"; + system ("elixir -D mode $elixir >& $logdir/$elixir.log &"); + exit 0; +} Index: /tags/ohana/perl-1-3/Ohana/src/perl/src/elixir.rerun =================================================================== --- /tags/ohana/perl-1-3/Ohana/src/perl/src/elixir.rerun (revision 21906) +++ /tags/ohana/perl-1-3/Ohana/src/perl/src/elixir.rerun (revision 21906) @@ -0,0 +1,152 @@ +#!/usr/bin/env perl + +# case 1: run on a list of MEF images: +# case 2: run on a list from ptolemy.failure / ptolemy.success + +$complete = 0; +$stds = 0; +$demo = 0; +@tARGV = (); +for (; @ARGV > 0; ) { + if ($ARGV[0] eq "-C") { + $config = "$config -C $ARGV[1]"; + shift; shift; next; + } + if ($ARGV[0] eq "-c") { + $config = "$config -c $ARGV[1]"; + shift; shift; next; + } + if ($ARGV[0] eq "-D") { + $config = "$config -D $ARGV[1] $ARGV[2]"; + shift; shift; shift; next; + } + if ($ARGV[0] eq "-stds") { + $stds = 1; + shift; next; + } + if ($ARGV[0] eq "-demo") { + $demo = 1; + shift; next; + } + if ($ARGV[0] eq "-complete") { + $complete = 1; + shift; next; + } + if ($ARGV[0] eq "-h") { + print "USAGE: elixir.rerun (list) (mode) [elixir options]\n"; + print " options: \n"; + print " -C config (set value of CONFIG variable)\n"; + print " -c config.file (specify alternate to config file)\n"; + print " -D key value (set value of key)\n"; + print " -stds (send output to STDS directory)\n"; + print " -complete (use sexcomplete not sextract)\n"; + print " -demo (show input list and command)\n"; + exit 1; + } + @tARGV = (@tARGV, $ARGV[0]); + shift; +} +@ARGV = @tARGV; +if (@ARGV != 2) { die "USAGE: elixir.rerun (list) (mode) [elixir options]\n"; } + +if ($stds) { + $catdir = `gconfig $config DB_STDS`; chop $catdir; + if ($?) { die "config error with CATDIR\n" } +} else { + $catdir = `gconfig $config CATDIR`; chop $catdir; + if ($?) { die "config error with CATDIR\n" } +} + +$tmpdir = `gconfig $config TMPDIR`; chop $tmpdir; +if ($?) { die "config error with TMPDIR\n" } + +$input = $ARGV[0]; +$mode = $ARGV[1]; + +# check on mode: +if ($mode eq "fifo") { &getfifo; } +if ($mode eq "mef") { &getmef; } + +die "ERROR: unknown mode $mode\n"; + +sub getfifo { + + $temp = `mktemp elixir.XXXXXX`; chop $temp; + $templog = `mktemp elixir-log.XXXXXX`; chop $templog; + + open (FILE, "$input"); + @list = ; + close (FILE); + + # write input list in correct format to $temp + open (FILE, ">$temp"); + foreach $line (@list) { + ($raw, $root, $ccd, $inmode) = split (" ", $line); + print FILE "$raw $root $ccd $inmode\n"; + } + &runelixir; +} + +sub getmef { + + $temp = `mktemp elixir.XXXXXX`; chop $temp; + $templog = `mktemp elixir-log.XXXXXX`; chop $templog; + + @ccds = split (" ", `cameraconfig -ccds`); + if ($?) { die "error in cameraconfig -ccds\n"; } + + @ccdn = split (" ", `cameraconfig -ccdn`); + if ($?) { die "error in cameraconfig -ccdn\n"; } + + $Nccd = `cameraconfig -Nccd`; chop $Nccd; + if ($?) { die "error in cameraconfig -Nccd\n"; } + + open (FILE, "$input"); + @list = ; + close (FILE); + + # write input list in correct format to $temp + open (FILE, ">$temp"); + foreach $line (@list) { + ($file) = split (" ", $line); + if ($line =~ m|^\s*$|) { next; } # skip blank lines + if ($line =~ m|^\s*\#|) { next; } # skip commented lines + + # must be absolute path for elixir to work anyway + @words = split ("/", $file); + $root = $words[-1]; + $root =~ s/.fits$//; + for ($i = 0; $i < $Nccd; $i++) { + printf FILE "$file %s/%s%02d %s MEF\n", $root, $root, $ccdn[$i], $ccds[$i]; + } + } + &runelixir; +} + +sub runelixir { + + if ($demo) { + if ($complete) { + print "elixir -D mode sexcomplete -D CATDIR $catdir -D TMPDIR $tmpdir $temp >& $templog\n"; + } else { + print "elixir -D mode sextract -D CATDIR $catdir -D TMPDIR $tmpdir $temp >& $templog\n"; + } + printf "list is in $temp\n"; + exit 0; + } + + # launch elixir for input list + if ($complete) { + vsystem ("elixir -D mode sexcomplete -D CATDIR $catdir -D TMPDIR $tmpdir $temp >& $templog &"); + } else { + vsystem ("elixir -D mode sextract -D CATDIR $catdir -D TMPDIR $tmpdir $temp >& $templog &"); + } + exit 0; +} + +sub vsystem { + print STDERR "@_\n"; + $status = system ("@_"); + $status; +} + Index: /tags/ohana/perl-1-3/Ohana/src/perl/src/fixcoords2 =================================================================== --- /tags/ohana/perl-1-3/Ohana/src/perl/src/fixcoords2 (revision 21906) +++ /tags/ohana/perl-1-3/Ohana/src/perl/src/fixcoords2 (revision 21906) @@ -0,0 +1,77 @@ +#!/usr/bin/env perl + +# USAGE: fixcoords (input) (output) (ref) (chip) +use Math::Trig; +# $DEG_RAD = 57.298688; +# $RAD_DEG = 0.017452406; +$DEG_RAD = 57.29577951; +$RAD_DEG = 0.017453292; + +if (@ARGV != 4) { die "USAGE: fixcoords (input) (output) (ref) (chip)\n"; } + +$input = $ARGV[0]; +$output = $ARGV[1]; +$ref = $ARGV[2]; +$chip = $ARGV[3]; + +if (! -f $input) { die "file $input not found\n"; } + +# load astrometric terms from header of reference: + +$answer = `echo $ref | fields CRPIX1 CRPIX2 CRVAL1 CRVAL2 NASTRO`; +($file, $crpix1, $crpix2, $crval1, $crval2, $Nastro) = split (" ", $answer); +if ($Nastro == 0) { die "no astrometry solution in header\n"; } + +$answer = `echo $ref | fields PC001001 PC001002 PC002001 PC002002 CDELT1 CDELT2`; +($file, $pc11, $pc12, $pc21, $pc22, $cd1, $cd2) = split (" ", $answer); + +open (FILE, "$input"); +open (OUT, ">$output"); + +# copy header lines: +for ($i = 0; $i < 16; $i++) { $line = ; print OUT "$line"; } + +while ($line = ) { + + @words = split (" ", $line); + xy2rd ($words[12], $words[13]); + + if ($words[17] eq $chip) { + printf OUT "%4d %7.4f %7.4f %8.4f %9.1f %6.3f %5.2f %2d %9.1f %6.3f %5.2f %2d %8.3f %8.3f %15.11f %11.8f %1s %2s\n", + $words[0], $words[1], $words[2], $words[3], + $words[4], $words[5], $words[6], $words[7], + $words[8], $words[9], $words[10], $words[11], + $words[12], $words[13], $ra, $dec, + $words[16], $words[17]; + } +} + +close (OUT); +close (FILE); + +sub xy2rd { + $x = $_[0]; + $y = $_[1]; + + $X = $cd1*($x - $crpix1); + $Y = $cd2*($y - $crpix2); + + $L = $X*$pc11 + $Y*$pc12; + $M = $X*$pc21 + $Y*$pc22; + + $chi = $RAD_DEG*$L; + $eta = $RAD_DEG*$M; + + $sdp = sin ($RAD_DEG*$crval2); + $cdp = cos ($RAD_DEG*$crval2); + + $talp = $chi / ($cdp - $eta*$sdp); + $alpha = atan ($talp); + $calp = cos ($alpha); + $tdel = $calp*($sdp + $eta*$cdp) / ($cdp - $eta*$sdp); + $delta = atan ($tdel); + + $ra = $DEG_RAD*$alpha + $crval1; + $dec = $DEG_RAD*$delta; + +} Index: /tags/ohana/perl-1-3/Ohana/src/perl/src/fixscat =================================================================== --- /tags/ohana/perl-1-3/Ohana/src/perl/src/fixscat (revision 21906) +++ /tags/ohana/perl-1-3/Ohana/src/perl/src/fixscat (revision 21906) @@ -0,0 +1,75 @@ +#!/usr/bin/env perl + +# warning: this function currently uses a fixed temporary name 'fix.NN.fits' +# for the intermediate product. If we add this to elixir, convert to mktemp + +# check the usage +if ($ARGV[0] eq "-h") { &usage (); } +if ($ARGV[0] eq "-help") { &usage (); } +if (@ARGV != 3) { &usage (); } + +# assign the command line arguments +$inlist = $ARGV[0]; +$version = $ARGV[1]; +$ID = $ARGV[2]; + +# find the appropriate script file +$confdir = `gconfig -q CONFDIR`; chop ($confdir); +$script = "$confdir/mana/scatter.pro"; + +# run mana script: +open (MANA, "|mana --norc"); +print MANA "input $script\n"; +print MANA "applyscat $inlist $version $ID\n"; +print MANA "exit 1\n"; +close (MANA); +print STDERR "exit statue: $?\n"; +if ($? == 2 * 256) { + print STDERR "no scattered light term available\n"; + exit 2; +} +if ($?) { die "ERROR problem with fixscat\n"; } + +print STDOUT "SUCCESS: finished with fixscat\n"; +exit 0; + +sub vsystem { + print STDERR "@_\n"; + $status = system ("@_"); + $status; +} + +sub goodbye { + die "@_\n"; +} + +sub usage { + print "USAGE: fixscat (inlist) (version) (ID)\n"; + exit 1; +} + +# mana within perl: we embed the mana functions within a macro to trap the +# exit status. If mana has an error with one of the steps, it will exit the macros and +# the second exit will be called. Otherwise, the "go" macro will perform the exit 0 +# and mana will exit with status 0 + +# there are two possible flat-field photometric corrections: additive +# and multiplicative: +# The correction images constructed by examining +# the *difference* between dome-flats with and without the petals +# covered is additive: FLAT_new = (FLAT_old - SCAT) * A +# (A is set to maintain the original normalization of chip 04) +# +# The correction images constructed by examining stellar magnitude +# difference is multiplicative: FLAT_new = (FLAT_old * SCAT) * A +# (A is set to maintain the original normalization of chip 04) + +# there is a different scattered light image for each filter. +# (these images are the same file for the additive version) + +# there should be no arbitrary normalization in the scattered frames +# in the database. (we used to multiply the scattered light image by a +# value of 10.0). + +# images of the first class will be identified with the label scatter-A.0 +# images of the second class will be identified with the label scatter-B.0 Index: /tags/ohana/perl-1-3/Ohana/src/perl/src/fixscat.mef =================================================================== --- /tags/ohana/perl-1-3/Ohana/src/perl/src/fixscat.mef (revision 21906) +++ /tags/ohana/perl-1-3/Ohana/src/perl/src/fixscat.mef (revision 21906) @@ -0,0 +1,75 @@ +#!/usr/bin/env perl + +# warning: this function currently uses a fixed temporary name 'fix.NN.fits' +# for the intermediate product. If we add this to elixir, convert to mktemp + +# check the usage +if ($ARGV[0] eq "-h") { &usage (); } +if ($ARGV[0] eq "-help") { &usage (); } +if (@ARGV != 3) { &usage (); } + +# assign the command line arguments +$inlist = $ARGV[0]; +$version = $ARGV[1]; +$ID = $ARGV[2]; + +# find the appropriate script file +$confdir = `gconfig -q CONFDIR`; chop ($confdir); +$script = "$confdir/mana/scatter.pro"; + +# run mana script: +open (MANA, "|mana --norc"); +print MANA "input $script\n"; +print MANA "applyscat-mef $inlist $version $ID\n"; +print MANA "exit 1\n"; +close (MANA); +print STDERR "exit statue: $?\n"; +if ($? == 2 * 256) { + print STDERR "no scattered light term available\n"; + exit 2; +} +if ($?) { die "ERROR problem with fixscat\n"; } + +print STDOUT "SUCCESS: finished with fixscat\n"; +exit 0; + +sub vsystem { + print STDERR "@_\n"; + $status = system ("@_"); + $status; +} + +sub goodbye { + die "@_\n"; +} + +sub usage { + print "USAGE: fixscat (inlist) (version) (ID)\n"; + exit 1; +} + +# mana within perl: we embed the mana functions within a macro to trap the +# exit status. If mana has an error with one of the steps, it will exit the macros and +# the second exit will be called. Otherwise, the "go" macro will perform the exit 0 +# and mana will exit with status 0 + +# there are two possible flat-field photometric corrections: additive +# and multiplicative: +# The correction images constructed by examining +# the *difference* between dome-flats with and without the petals +# covered is additive: FLAT_new = (FLAT_old - SCAT) * A +# (A is set to maintain the original normalization of chip 04) +# +# The correction images constructed by examining stellar magnitude +# difference is multiplicative: FLAT_new = (FLAT_old * SCAT) * A +# (A is set to maintain the original normalization of chip 04) + +# there is a different scattered light image for each filter. +# (these images are the same file for the additive version) + +# there should be no arbitrary normalization in the scattered frames +# in the database. (we used to multiply the scattered light image by a +# value of 10.0). + +# images of the first class will be identified with the label scatter-A.0 +# images of the second class will be identified with the label scatter-B.0 Index: /tags/ohana/perl-1-3/Ohana/src/perl/src/flatten.flips =================================================================== --- /tags/ohana/perl-1-3/Ohana/src/perl/src/flatten.flips (revision 21906) +++ /tags/ohana/perl-1-3/Ohana/src/perl/src/flatten.flips (revision 21906) @@ -0,0 +1,276 @@ +#!/usr/bin/env perl + +### darks are currently disabled (look for dark detsearch and darkfactor) + +# grab the command line options +$defringe = 0; +$use_mask = 1; +$fast = 0; +$quiet = 0; +$close = ""; +$config = ""; +$preserve = 0; +@tARGV = (); +for (; @ARGV > 0; ) { + if ($ARGV[0] eq "-C") { + $config = "$config -C $ARGV[1]"; + shift; shift; next; + } + if ($ARGV[0] eq "-c") { + $config = "$config -c $ARGV[1]"; + shift; shift; next; + } + if ($ARGV[0] eq "-D") { + $config = "$config -D $ARGV[1] $ARGV[2]"; + shift; shift; shift; next; + } + if ($ARGV[0] eq "-preserve") { + $preserve = 1; + shift; next; + } + if ($ARGV[0] eq "-fast") { + $fast = 1; + shift; next; + } + if ($ARGV[0] eq "-quiet") { + $quiet = 1; + shift; next; + } + if ($ARGV[0] eq "-close") { + $close = "-close"; + shift; next; + } + if ($ARGV[0] eq "-defringe") { + $defringe = 1; + shift; next; + } + if ($ARGV[0] eq "-nomask") { + $use_mask = 0; + shift; next; + } + @tARGV = (@tARGV, $ARGV[0]); + shift; +} +@ARGV = @tARGV; + +if (@ARGV != 4) { &usage; } + +# command line arguments +$input = $ARGV[0]; +$output = $ARGV[1]; +$ccd = $ARGV[2]; +$mode = uppercase ($ARGV[3]); + +$chipname = "-chipname"; +$infile = $input; +if ($mode eq "MEF") { $infile = "$input\[$ccd]"; } +if ($ccd eq "phu") { + $infile = "$input"; + $ccd = "ccd00"; + $chipname = ""; +} + +# remove old file if it exists +if (-e $output) { unlink "$output"; } +ckpathname ($output); + +# find the appropriate detrend images (need to fix output name for MEF - option?) +$flat=`detsearch $config $chipname -quiet -image $input $ccd $mode -type flat $close`; chop ($flat); +if ($?) { die "ERROR: can't get flat for image\n"; } + +if (!$fast) { + $bias=`detsearch $config $chipname -quiet -image $input $ccd $mode -type bias $close`; chop ($bias); + if ($?) { die "ERROR: can't get bias for image\n"; } + +# $dark=`detsearch $config $chipname -quiet -image $input $ccd $mode -type dark $close`; chop ($dark); +# if ($?) { die "ERROR: can't get dark for image\n"; } +} + +# find the appropriate mask image +$mask = "none"; +if ($use_mask) { + $mask=`detsearch $config $chipname -quiet -image $input $ccd $mode -type mask $close`; chop ($mask); + if ($?) { die "ERROR: can't get mask for image\n"; } +} + +# abstracted keywords +$ccdkeyword = `gconfig $config CCDNUM-KEYWORD`; chop ($ccdkeyword); +$darkword = `gconfig $config DARKTIME-FUNCTION`; chop ($darkword); +$exptimeword = `gconfig $config EXPTIME-KEYWORD`; chop ($exptimeword); + +# find the appropriate fringe frame & coords file +$fringe = "none"; +$frpts = "none"; +if ($defringe) { + + $filterword = `gconfig $config FILTER-KEYWORD`; chop ($filterword); + + # check the FILTER and EXPTIME, include fringe correction?: + ($junk, $exptime, $filter) = `echo $input | fields $exptimeword $filterword`; + $filter = uppercase ($filter); + + # recipe file defines detrend types & cutoff exptime values + $recipefile = `gconfig $config DETREND_RECIPES`; chop $recipefile; + ($detypes, $cutoffs) = split (" ", `gconfig -c $recipefile $filter`); + if ($?) { die "ERROR: failure to get detrend recipes\n"; } + @detypes = split (",", $detypes); + @cutoffs = split (",", $cutoffs); + + # check for DEFRINGE, DEMODE + $defringe = 0; + for ($i = 0; $i < @detypes; $i++) { + if ($detypes[$i] eq "fringe") { + if ($exptime >= $cutoffs[$i]) { $defringe = 1; } + last; + } + } +} + +if (! $fast && 0) { + # determine scale factor for dark image (use MEF rootname if EXTNAME is given) + $darkfile = $dark; + $darkfile =~ s|\[.*\]||; + ($junk, $t1) = split (" ", `echo $input | fields $exptimeword`); + ($name, $t2) = split (" ", `echo $darkfile | fields $exptimeword`); + $darkfactor = `darktime.$darkword $t1 $t2`; chop ($darkfactor); + if ($?) { die "ERROR: failure to get darkfactor $t1 $t2\n"; } +} + +# load FLIPS parameter file, fill in missing words: +$paramfile = `gconfig $config FLIPS_PARAM_IMRED`; chop $paramfile; +if ($?) { die "ERROR: missing FLIPS_PARAM_IMRED in config\n"; } +open (FILE, "$paramfile"); +@params = ; +close (FILE); + +foreach $line (@params) { + # input / output file names + $line =~ s|INFILE|$infile|; + $line =~ s|OUTFILE|$output|; + $line =~ s|COMMENT|Elixir / Flips2 flatten.flips|; + + # overscan correction + $line =~ s|DOOVER|1|; + + if ($fast) { + $line =~ s|DOBIAS|0|; + $line =~ s|DODARK|0|; + } else { + # bias corrections + $line =~ s|DOBIAS|1|; + $line =~ s|BIASNAME|$bias|; + + # dark corrections - avoid for now + $line =~ s|DODARK|0|; +# $line =~ s|DODARK|1|; +# $line =~ s|DARK_FACT|$darkfactor|; +# $line =~ s|DARKNAME|$dark|; + } + + # flat corrections + $line =~ s|DOFLAT|1|; + $line =~ s|FLATNAME|$flat|; + + # mask corrections + if ($mask eq "none") { + $line =~ s|DOMASK|0|; + } else { + $line =~ s|DOMASK|1|; + $line =~ s|MASKNAME|$mask|; + } + + # header blocks - we need an extra block for elixir keywords + $line =~ s|DOHEADER|1|; + $line =~ s|NBLOCKS|2|; +} + +$temp = `mktemp /tmp/flatten.XXXXXX`; chop $temp; +open (FILE, ">$temp"); +foreach $line (@params) { + print FILE "$line"; +} +close (FILE); + +system ("imred $temp"); +$stat = $?; + +if ($preserve) { + print STDERR "imred input file: $temp\n"; +} else { + unlink $temp; +} + +if ($stat) { + if (! $quiet) { print STDOUT "ERROR: failure running flatten.flips\n"; } + exit 1; +} + +if ($defringe) { + system ("mv $output $output.det"); + if ($?) { + print STDERR "failure to save temporary output file\n"; + exit 1; + } + + system ("defringe.ccd -quiet $close $output.dat $output $ccd SPLIT"); + if ($?) { + print STDERR "failure in defringe\n"; + $stat = 1; + } + unlink "$output.dat"; +} + +if (! $quiet) { + if ($stat) { + print STDOUT "ERROR: failure running flatten.flips\n"; + } else { + print STDOUT "SUCCESS\n"; + } +} + +# always return 1, don't return just the exit status +if ($stat) { + exit 1; +} else { + exit 0; +} + +sub vsystem { + print STDERR "@_\n"; + $status = system ("@_"); + $status; +} + +sub goodbye { + die "@_\n"; +} + +sub usage { + print STDERR "USAGE: flatten.flips (input) (output) CCD MODE [-fast] [-close] [-quiet]\n"; + exit 2; +} + +sub uppercase { + return "\U$_[0]\E"; +} + +# given a filename, check that its path exists, create it if not +sub ckpathname { + my ($file) = $_[0]; + my (@words, $dir); + + @words = split ("/", $file); + pop (@words); + $dir = join ("/", @words); + + if ($dir eq "") { $dir = "."; } + + if (! -d $dir) { + system ("mkdir -p $dir"); + if ($?) { + print STDERR "ERROR: can't make directory component for $file\n"; + exit 1; + } + } +} + Index: /tags/ohana/perl-1-3/Ohana/src/perl/src/flatten.mana =================================================================== --- /tags/ohana/perl-1-3/Ohana/src/perl/src/flatten.mana (revision 21906) +++ /tags/ohana/perl-1-3/Ohana/src/perl/src/flatten.mana (revision 21906) @@ -0,0 +1,269 @@ +#!/usr/bin/env perl + +# grab the command line options +$use_fringe = 0; +$use_mask = 1; +$fast = 0; +$quiet = 0; +$close = ""; +@tARGV = (); +for (; @ARGV > 0; ) { + if ($ARGV[0] eq "-fast") { + $fast = 1; + shift; next; + } + if ($ARGV[0] eq "-quiet") { + $quiet = 1; + shift; next; + } + if ($ARGV[0] eq "-close") { + $close = "-close"; + shift; next; + } + if ($ARGV[0] eq "-defringe") { + $use_fringe = 1; + shift; next; + } + if ($ARGV[0] eq "-nomask") { + $use_mask = 0; + shift; next; + } + @tARGV = (@tARGV, $ARGV[0]); + shift; +} +@ARGV = @tARGV; + +if (@ARGV != 4) { &usage; } + +# command line arguments +$input = $ARGV[0]; +$output = $ARGV[1]; +$ccd = $ARGV[2]; +$mode = uppercase ($ARGV[3]); + +ckpathname ($output); + +if ($fast) { &fast; } else { &complete; } +exit 1; + +sub complete { + # find the appropriate flat-field image + $flat=`detsearch -quiet -image $input $ccd $mode -type flat $close`; chop ($flat); + if ($?) { + print STDERR "ERROR: can't get flat for image\n"; + exit 1; + } + # find the appropriate bias image + $bias=`detsearch -quiet -image $input $ccd $mode -type bias $close`; chop ($bias); + if ($?) { + print STDERR "ERROR: can't get bias for image\n"; + exit 1; + } + # find the appropriate dark image + $dark=`detsearch -quiet -image $input $ccd $mode -type dark $close`; chop ($dark); + if ($?) { + print STDERR "ERROR: can't get dark for image\n"; + exit 1; + } + + # find the appropriate mask image + $mask = "none"; + if ($use_mask) { + $mask=`detsearch -quiet -image $input $ccd $mode -type mask $close`; chop ($mask); + if ($?) { + print STDERR "ERROR: can't get mask for image\n"; + exit 1; + } + } + + # abstracted keywords + $ccdkeyword = `gconfig -q CCDNUM-KEYWORD`; chop ($ccdkeyword); + $darkword = `gconfig -q DARKTIME-FUNCTION`; chop ($darkword); + + # find the appropriate fringe frame & coords file + $fringe = "none"; + $coordfile = "none"; + if ($use_fringe) { + $exptimeword = `gconfig -q EXPTIME-KEYWORD`; chop ($exptimeword); + $filterword = `gconfig -q FILTER-KEYWORD`; chop ($filterword); + $cameraword = `gconfig -q CAMERA-KEYWORD`; chop ($cameraword); + $coordpath = `gconfig -q FRINGE_COORD_PATH`; chop ($coordpath); + + $ccdnum = `cameraconfig -N $ccd`; + + # check the FILTER and EXPTIME, include fringe correction?: + $answer = `echo $input | fields $exptimeword $filterword $cameraword`; + ($junk, $exptime, $filter, $camera) = split (" ", $answer); + # i need to do a look-up on the valid filter filternames (filtname) + $filter = uppercase ($filter); + + $use_fringe = 0; + # abstract this a bit: recipe gives guidance + # set defringe based on filter & exptime + if (($filter eq "I") && ($exptime > 60)) { $use_fringe = 1; } + if (($filter eq "Z") && ($exptime > 60)) { $use_fringe = 1; } + if (($filter eq "NB920") && ($exptime > 60)) { $use_fringe = 1; } + + if ($use_fringe) { + $fringe = `detsearch -quiet -image $input $ccd $mode -type fringe $close`; chop ($fringe); + if ($?) { + print STDERR "ERROR: can't get fringe for image\n"; + exit 1; + } + $coordfile = sprintf "%s/%s-%s-CCD%02d-FringeCoord.reg", $coordpath, $camera, $filter, $ccd; + } + } + + # determine scale factor for dark image + $answer = `echo $input | fields $exptimeword`; + ($name, $t1) = split (" ", $answer); + $answer = `echo $dark | fields $exptimeword`; + ($name, $t2) = split (" ", $answer); + $darkfactor = `darktime.$darkword $t1 $t2`; chop ($darkfactor); + + # find the appropriate script file + $confdir = `gconfig -q CONFDIR`; chop ($confdir); + $script = "$confdir/mana/flatten.pro"; + + # run mana, call script + open (MANA, "|mana --norc"); + print MANA "input $script\n"; + print MANA "\$CCDKEYWORD = $ccdkeyword\n"; + print MANA "\$bias = $bias\n"; + print MANA "\$dark = $dark\n"; + print MANA "\$flat = $flat\n"; + print MANA "\$mask = $mask\n"; + print MANA "\$fringe = $fringe\n"; + print MANA "\$use:mask = $use_mask\n"; + print MANA "\$use:fringe = $use_fringe\n"; + print MANA "\$darkfactor = $darkfactor\n"; + print MANA "\$coordfile = $coordfile\n"; + print MANA "flatten.complete $input $output $ccd $mode\n"; + print MANA "exit 1\n"; + close (MANA); + if ($?) { + print STDERR "ERROR problem with imstats\n"; + exit 1; + } + print STDOUT "SUCCESS: finished with imstats\n"; + exit 0; +} + +sub fast { + # find the appropriate flat-field image + $flat=`detsearch -quiet -image $input $ccd $mode -type flat -close`; chop ($flat); + if ($?) { + print STDERR "ERROR: can't get flat for image\n"; + exit 1; + } + + # find the appropriate mask image + $mask = "none"; + if ($use_mask) { + $mask=`detsearch -quiet -image $input $ccd $mode -type mask -close`; chop ($mask); + if ($?) { + print STDERR "ERROR: can't get mask for image\n"; + exit 1; + } + } + + # abstracted keywords + $ccdkeyword = `gconfig -q CCDNUM-KEYWORD`; chop ($ccdkeyword); + + # find the appropriate fringe frame & coords file + $fringe = "none"; + $coordfile = "none"; + if ($use_fringe) { + $exptimeword = `gconfig -q EXPTIME-KEYWORD`; chop ($exptimeword); + $filterword = `gconfig -q FILTER-KEYWORD`; chop ($filterword); + $cameraword = `gconfig -q CAMERA-KEYWORD`; chop ($cameraword); + $coordpath = `gconfig -q FRINGE_COORD_PATH`; chop ($coordpath); + + $ccdnum = `cameraconfig -N $ccd`; + + # check the FILTER and EXPTIME, include fringe correction?: + $answer = `echo $input | fields $exptimeword $filterword $cameraword`; + ($junk, $exptime, $filter, $camera) = split (" ", $answer); + # i need to do a look-up on the valid filter filternames (filtname) + $filter = uppercase ($filter); + + $use_fringe = 0; + # set defringe based on filter & exptime + if (($filter eq "I") && ($exptime > 60)) { $use_fringe = 1; } + if (($filter eq "Z") && ($exptime > 60)) { $use_fringe = 1; } + if (($filter eq "NB920") && ($exptime > 60)) { $use_fringe = 1; } + + if ($use_fringe) { + $fringe = `detsearch -quiet -image $input $ccd $mode -type fringe -close`; chop ($fringe); + if ($?) { + print STDERR "ERROR: can't get fringe for image\n"; + exit 1; + } + $coordfile = sprintf "%s/%s-%s-CCD%02d-FringeCoord.reg", $coordpath, $camera, $filter, $ccd; + } + } + + # find the appropriate script file + $confdir = `gconfig -q CONFDIR`; chop ($confdir); + $script = "$confdir/mana/flatten.pro"; + + # run mana, call script + open (MANA, "|mana --norc"); + print MANA "input $script\n"; + print MANA "\$CCDKEYWORD = $ccdkeyword\n"; + print MANA "\$flat = $flat\n"; + print MANA "\$mask = $mask\n"; + print MANA "\$fringe = $fringe\n"; + print MANA "\$use:mask = $use_mask\n"; + print MANA "\$use:fringe = $use_fringe\n"; + print MANA "\$coordfile = $coordfile\n"; + print MANA "flatten.fast $input $output $ccd $mode\n"; + print MANA "exit 1\n"; + close (MANA); + if ($?) { + print STDERR "ERROR problem with imstats\n"; + exit 1; + } + print STDOUT "SUCCESS: finished with imstats\n"; + exit 0; +} + +sub vsystem { + print STDERR "@_\n"; + $status = system ("@_"); + $status; +} + +sub goodbye { + die "@_\n"; +} + +sub usage { + print STDERR "USAGE: flatten.mana (input) (output) CCD MODE [-fast] [-close] [-quiet]\n"; + exit 2; +} + +sub uppercase { + return "\U$_[0]\E"; +} + +# given a filename, check that its path exists, create it if not +sub ckpathname { + my ($file) = $_[0]; + my (@words, $dir); + + @words = split ("/", $file); + pop (@words); + $dir = join ("/", @words); + + if ($dir eq "") { $dir = "."; } + + if (! -d $dir) { + system ("mkdir -p $dir"); + if ($?) { + print STDERR "ERROR: can't make directory component for $file\n"; + exit 1; + } + } +} + Index: /tags/ohana/perl-1-3/Ohana/src/perl/src/fr.ckfile =================================================================== --- /tags/ohana/perl-1-3/Ohana/src/perl/src/fr.ckfile (revision 21906) +++ /tags/ohana/perl-1-3/Ohana/src/perl/src/fr.ckfile (revision 21906) @@ -0,0 +1,30 @@ +#!/usr/bin/env perl + +# check the usage +if ($ARGV[0] eq "-h") { &usage (); } +if ($ARGV[0] eq "-help") { &usage (); } +if (@ARGV != 1) { &usage (); } + +# assign the command line arguments +$list = $ARGV[0]; + +# check for files to be processed +open (FILE, "$list"); +@list = ; +close (FILE); + +foreach $file (@list) { + chop ($file); + if (-e $file) { next; } + print STDERR "ERROR: missing file $file\n"; + exit 1; +} + +print STDOUT "SUCCESS: found all files from $list\n"; +exit 0; + +sub usage { + print "USAGE: fr.ckfile (list)\n"; + print " checks for the existence of each file in the list\n"; + exit 1; +} Index: /tags/ohana/perl-1-3/Ohana/src/perl/src/fr.defringe =================================================================== --- /tags/ohana/perl-1-3/Ohana/src/perl/src/fr.defringe (revision 21906) +++ /tags/ohana/perl-1-3/Ohana/src/perl/src/fr.defringe (revision 21906) @@ -0,0 +1,133 @@ +#!/usr/bin/env perl + +if (@ARGV != 5) { &escape ("ERROR: USAGE: defringe (imlist) (imstats) (frlist) (frstats) (outlist)"); } + +$imlist = $ARGV[0]; +$imstats = $ARGV[1]; +$frlist = $ARGV[2]; +$frstats = $ARGV[3]; +$output = $ARGV[4]; + +# load config info +$confdir = `gconfig CONFDIR`; chop $confdir; +if ($?) { &escape ("ERROR: config failure"); } + +# various lists +@input = split (" ", `cat $imlist`); +@output = split (" ", `cat $output`); +@ccds = split (" ", `cameraconfig -ccds`); +@ccdn = split (" ", `cameraconfig -ccdn`); +$Nccd = @ccds; + +# output directories must exist +for ($i = 0; $i < $Nccd; $i++) { &ckdir ($output[$i]); } + +# convert image stats to optimal image parameters +$fitpars = &mktemp ("defringe"); +vsystem ("fr.frstats -applyfit $imstats $frstats $fitpars"); +@fitpars = `cat $fitpars`; foreach $line (@fitpars) { chop $line; } +@fringe = `cat $frlist`; foreach $line (@fringe) { chop $line; } + +# load flips parameter file +$paramfile = `gconfig FLIPS_PARAM_DEFRINGE`; chop $paramfile; +if ($?) { die "ERROR: missing FLIPS_PARAM_DEFRINGE in config\n"; } + +open (FILE, "$paramfile"); +@rawpars = ; +close (FILE); + +$infile = &mktemp ("\@defringe"); +$parfile = &mktemp ("defringe"); +for ($i = 0; $i < $Nccd; $i++) { + + # create input list file + ($s0, $s1, $RF, $ds) = split (" ", $fitpars[$i]); + open (FILE, ">$infile"); + print FILE "$input[$i] $s0 1.0 $ds\n"; + print FILE "$fringe[$i] $s1 $RF $ds\n"; + close (FILE); + + print STDOUT "$fitpars[$i]\n"; + print STDOUT "$input[$i] $s0 1.0 $ds\n"; + print STDOUT "$fringe[$i] $s1 $RF $ds\n"; + + # create input par file + @params = @rawpars; + foreach $line (@params) { + $line =~ s|LISTNAME|$infile|; + $line =~ s|FILENAME|$output[$i]|; + $line =~ s|COMMENT|Elixir Defringing|; + } + open (FILE, ">$parfile"); + foreach $line (@params) { print FILE "$line"; } + close (FILE); + + if (-e $output[$i]) { unlink $output[$i]; } + vsystem ("imcombred $parfile"); + if ($?) { &escape ("ERROR: failure running imcombred"); } +} + +&goodbye; + +######################################################## + +sub ckdir { + + my ($file) = $_[0]; + my ($dir, @words); + + @words = split ("/", $file); + pop (@words); + $dir = join ("/", @words); + if ($dir eq "") { $dir = "."; } + if (! -e $dir) { + system ("mkdir -p $dir"); + if ($?) { die "ERROR: can't create output directory $dir\n"; } + } +} + +sub loadlist { + + my($command) = $_[0]; + my(@list, $line); + + @list = `$command`; + + foreach $line (@list) { chop ($line); } + + return @list; +} + +sub vsystem { + print STDERR "@_\n"; + $status = system ("@_"); + $status; +} + +@temp = (); +sub mktemp { + + my ($base) = $_[0]; + my ($name); + $name = `mktemp /tmp/$base.XXXXXX`; + chop $name; + + push @temp, $name; + return $name; +} + +sub escape { + $message = $_[0]; + foreach $name (@temp) { + unlink ($name); + } + die "$message\n"; +} + +sub goodbye { + foreach $name (@temp) { unlink ($name); } + print STDERR "SUCCESS\n"; + exit 0; +} + + Index: /tags/ohana/perl-1-3/Ohana/src/perl/src/fr.detrend =================================================================== --- /tags/ohana/perl-1-3/Ohana/src/perl/src/fr.detrend (revision 21906) +++ /tags/ohana/perl-1-3/Ohana/src/perl/src/fr.detrend (revision 21906) @@ -0,0 +1,79 @@ +#!/usr/bin/env perl +# calls flatten.flips, but no direct flips functions + +# check the usage +if ($ARGV[0] eq "-h") { usage (); } +if ($ARGV[0] eq "-help") { usage (); } +if (@ARGV != 4) { die "USAGE: fr.detrend (path) (root) (mode) (outlist)\n" } + +# assign the command line arguments +$path = $ARGV[0]; +$root = $ARGV[1]; +$mode = "\U$ARGV[2]\E"; +if (($mode ne "MEF") && ($mode ne "SPLIT")) { die "ERROR: mode must be either -split or -mef\n";} + +# load output list (must be created in ccd order) +$outlist = $ARGV[3]; +open (FILE, "$outlist"); +@outlist = ; +close (FILE); +foreach $line (@outlist) { chop ($line); } + +# double checks: should be Nccd +$Nccd = `cameraconfig -Nccd`; chop ($Nccd); +if ($Nccd != @outlist) { die "ERROR: mis-matched number of images\n"; } +@ccds = split (" ", `cameraconfig -ccds`); +if ($?) { die "ERROR: cameraconfig error\n"; } +@ccdn = split (" ", `cameraconfig -ccdn`); +if ($?) { die "ERROR: cameraconfig error\n"; } + +# run flatten.flips for each input and output image: +for ($ccd = 0; $ccd < $Nccd; $ccd++) { + + $infile = mk_filename ($path, $root, $mode, $ccdn[$ccd]); + $outfile = $outlist[$ccd]; + + $status = vsystem ("flatten.flips -quiet $infile $outfile $ccds[$ccd] $mode"); + if ($status) { die "ERROR: problem running flatten on $infile\n"; } +} +print STDOUT "SUCCESS: finished with fr.detrend\n"; +exit 0; + +## utilities + +sub mk_filename { + my ($path) = $_[0]; + my ($root) = $_[1]; + my ($mode) = $_[2]; + my ($ccd) = $_[3]; + + if ($mode eq "MEF") { + $name = sprintf "%s/%s.fits", $path, $root; + return $name; + } + if ($mode eq "SPLIT") { + $name = sprintf "%s/%s/%s%s.fits", $path, $root, $root, $ccd; + return $name; + } + return ""; +} + +sub vsystem { + print STDERR "@_\n"; + $status = system ("@_"); + $status; +} + +sub goodbye { + die "@_\n"; +} + +sub usage { + print "\n"; + print "USAGE: fr.detrend (path) (root) (mode) (outlist)\n"; + print " path: path to MEF image or SPLIT dir\n"; + print " root: root name of image (MEF = root.fits, SPLIT = root/rootNN.fits)\n"; + print " mode: MEF or SPLIT\n"; + print " outlist: list of output files\n"; + exit 1; +} Index: /tags/ohana/perl-1-3/Ohana/src/perl/src/fr.frstats =================================================================== --- /tags/ohana/perl-1-3/Ohana/src/perl/src/fr.frstats (revision 21906) +++ /tags/ohana/perl-1-3/Ohana/src/perl/src/fr.frstats (revision 21906) @@ -0,0 +1,171 @@ +#!/usr/bin/env perl + +if (@ARGV < 1) { &escape ("USAGE: fr.frstats -mode [args]"); } +if ($ARGV[0] eq "help") { &usage; } + +# find the appropriate script file +$confdir = `gconfig -q CONFDIR`; chop ($confdir); +$script = "$confdir/mana/fringe.pro"; + +# test named Xserver, or start vnc on specified machine +$xhost=`gconfig -q XHOST`; chop ($xhost); +$xdisp=`gconfig -q XDISP`; chop ($xdisp); +if (vsystem ("xdpyinfo -display $xdisp > /dev/null")) { + print STDERR "X server is not running. start it now on $xhost\n"; + exit 1; +} +$ENV{'DISPLAY'} = $xdisp; + +# determine fit parameters for list of raw fringe measurements +if ($ARGV[0] eq "-fitpars") { + + $list = $ARGV[1]; + $pars = $ARGV[2]; + + # run mana script: + open (MANA, "|mana --norc"); + print MANA "input $script\n"; + print MANA "getfitpars $list $pars\n"; + print MANA "exit 1\n"; + close (MANA); + if ($?) { &escape ("problem with fr.frstats -fitpars"); } + + &goodbye; +} + +# apply fit parameters for given chip +if ($ARGV[0] eq "-applyfit") { + + if (@ARGV != 4) { die "USAGE: fr.frstats -applyfit (imlist) (fitpars) (output)\n"; } + $list = $ARGV[1]; + $pars = $ARGV[2]; + $output = $ARGV[3]; + + if (-e $output) { unlink $output; } + + # run mana script: + open (MANA, "|mana --norc"); + print MANA "input $script\n"; + print MANA "applyfitstats $list $pars $output\n"; + print MANA "exit 1\n"; + close (MANA); + if ($?) { &escape ("problem with fr.frstats -applyfit"); } + + &goodbye; +} + +# determine fit parameters for list of raw fringe measurements +if ($ARGV[0] eq "-plotstats") { + + $list = $ARGV[1]; + $pars = $ARGV[2]; + $output = $ARGV[3]; + + # run mana script: + open (MANA, "|mana --norc"); + print MANA "input $script\n"; + print MANA "showfits $list $pars $output\n"; + print MANA "exit 1\n"; + close (MANA); + if ($?) { &escape ("problem with fr.frstats -plotstats"); } + + &goodbye; +} + +# create frstats file for list of raw fringe measurements using measure fringe parameters +if ($ARGV[0] eq "-frstats") { + + $list = $ARGV[1]; + $pars = $ARGV[2]; + $frstats = $ARGV[3]; + + # check if none of list exist, then skip + # otherwise, report error + + open (FILE, "$list"); + @list = ; + close (FILE); + + $Nfound = 0; + foreach $line (@list) { + chop $line; + if (-e $line) { $Nfound ++; } + } + if ($Nfound < @list) { + print STDERR "NOTE: missing some file from $list: assuming initial state\n"; + &goodbye; + } + + # run mana script: + open (MANA, "|mana --norc"); + print MANA "input $script\n"; + print MANA "getfrstats $pars $list $frstats\n"; + print MANA "exit 1\n"; + close (MANA); + if ($?) { &escape ("problem with fr.frstats -frstats"); } + + &goodbye; +} + +# create dfstats file for list of fringe residual measurements +if ($ARGV[0] eq "-dfstats") { + + $list = $ARGV[1]; + $pars = $ARGV[2]; + $frstats = $ARGV[3]; + + # check if none of list exist, then skip + # otherwise, report error + + open (FILE, "$list"); + @list = ; + close (FILE); + + $Nfound = 0; + foreach $line (@list) { + chop $line; + if (-e $line) { $Nfound ++; } + } + if ($Nfound < @list) { + print STDERR "NOTE: missing some files from $list: assuming initial state\n"; + &goodbye; + } + + # run mana script: + open (MANA, "|mana --norc"); + print MANA "input $script\n"; + print MANA "getdfstats $pars $list $frstats\n"; + print MANA "exit 1\n"; + close (MANA); + if ($?) { &escape ("problem with fr.frstats -frstats"); } + + &goodbye; +} + +&escape ("unknown fr.frstats command $ARGV[0]"); + +## utilities + +sub vsystem { + print STDERR "@_\n"; + $status = system ("@_"); + $status; +} + +sub goodbye { + print STDOUT "finished with fr.stats\n"; + exit 0; +} + +sub escape { + print STDOUT "ERROR: $_[0]\n"; + exit 1; +} + +sub usage { + + print STDOUT "fr.mklists -fitpars CONFIG.med.sublist CONFIG.fitpars\n"; + print STDOUT "fr.frstats -frstats CONFIG.med.statlist CONFIG.fitpars CONFIG.med.imstats\n"; + + exit 2; +} Index: /tags/ohana/perl-1-3/Ohana/src/perl/src/fr.getfringe =================================================================== --- /tags/ohana/perl-1-3/Ohana/src/perl/src/fr.getfringe (revision 21906) +++ /tags/ohana/perl-1-3/Ohana/src/perl/src/fr.getfringe (revision 21906) @@ -0,0 +1,59 @@ +#!/usr/bin/env perl + +# check the usage +if ($ARGV[0] eq "-h") { usage (); } +if ($ARGV[0] eq "-help") { usage (); } +if (@ARGV != 3) { die "USAGE: fr.getfringe (inlist) (binning) (output)\n" } + +# assign the command line arguments +$inlist = $ARGV[0]; +$bin = $ARGV[1]; +$output = $ARGV[2]; + +# load input list: +open (FILE, "$inlist"); +@inlist = ; +close (FILE); +foreach $line (@inlist) { chop $line; } + +# getfringe appends to the output file: +unlink ($output); + +# basic camera data +$Nccd = `cameraconfig -Nccd`; chop $Nccd; +if ($Nccd != @inlist) { die "ERROR: mis-matched image list sizes\n"; } +@ccds = split (" ", `cameraconfig -ccds`); +if ($?) { die "ERROR: cameraconfig error\n"; } + +# find fringe coordinate file +$coordfile = `detsearch -quiet -image $inlist[0] $ccds[0] split -type frpts`; chop $coordfile; +if ($?) { die "ERROR: can't find fringe point file for this image\n"; } + +# each call to getfringe adds a line to $output +for ($ccd = 0; $ccd < $Nccd; $ccd++) { + vsystem ("getfringe $inlist[$ccd] $ccds[$ccd] $coordfile $bin >> $output"); + if ($?) { die "ERROR running getfringe\n"; } +} + +print STDOUT "SUCCESS: finished with fr.getfringe\n"; +exit 0; + +sub vsystem { + print STDERR "@_\n"; + $status = system ("@_"); + $status; +} + +sub goodbye { + die "@_\n"; +} + +sub usage { + print "\n"; + print "USAGE: fr.getfringe (inlist) (binning) (output)\n"; + print " calculate fringe pattern strengths for images in (inlist)\n"; + print " inlist : list of input CCDs in CCD order\n"; + print " binning : binning factor of images\n"; + print " outdir : output file\n"; + exit 1; +} Index: /tags/ohana/perl-1-3/Ohana/src/perl/src/fr.imdata =================================================================== --- /tags/ohana/perl-1-3/Ohana/src/perl/src/fr.imdata (revision 21906) +++ /tags/ohana/perl-1-3/Ohana/src/perl/src/fr.imdata (revision 21906) @@ -0,0 +1,55 @@ +#!/usr/bin/env perl + +# check the usage +if ($ARGV[0] eq "-h") { &usage (); } +if ($ARGV[0] eq "-help") { &usage (); } +if (@ARGV != 2) { &usage (); } + +# assign the command line arguments +$list = $ARGV[0]; +$imdata = $ARGV[1]; + +# load input list: +open (FILE, "$list"); +@list = ; +close (FILE); +foreach $line (@list) {chop $line;} + +# check for file +if (! -e $list[0]) { die "ERROR: image file $list[0] is missing\n"; } + +print STDOUT "$list[0]\n"; + +# abstract header keywords +($datekwd, $timekwd, $obsidkwd, $exptimekwd) = + split (" ", `gconfig DATE-KEYWORD UT-KEYWORD ID-KEYWORD EXPTIME-KEYWORD`); +if ($?) { die "ERROR problem with keywords\n"; } + +($file, $date, $utc, $obsid, $exptime) = + split (" ", `echo $list[0] | fields $datekwd $timekwd $obsidkwd $exptimekwd`); +if ($?) { die "ERROR missing header information\n"; } + +open (FILE, ">$imdata"); +print FILE "$obsid $date $utc $exptime\n"; +close (FILE); + +print STDOUT "SUCCESS: finished with fr.stats\n"; +exit 0; + +## utilities + +sub vsystem { + print STDERR "@_\n"; + $status = system ("@_"); + $status; +} + +sub goodbye { + die "@_\n"; +} + +sub usage { + print "USAGE: fr.imdata (list) (imdata)\n"; + print " extract basic image data from header for later reference\n"; + exit 1; +} Index: /tags/ohana/perl-1-3/Ohana/src/perl/src/fr.jpegs =================================================================== --- /tags/ohana/perl-1-3/Ohana/src/perl/src/fr.jpegs (revision 21906) +++ /tags/ohana/perl-1-3/Ohana/src/perl/src/fr.jpegs (revision 21906) @@ -0,0 +1,65 @@ +#!/usr/bin/env perl + +# check the usage +if ($ARGV[0] eq "-h") { &usage (); } +if ($ARGV[0] eq "-help") { &usage (); } +if (@ARGV != 4) { &usage (); } + +# assign the command line arguments +$list = $ARGV[0]; +$tenbin = $ARGV[1]; +$medbin = $ARGV[2]; +$range = $ARGV[3]; + +# check for files to be processed +@status = stat ($list); +if ($status[7] == 0) { + print STDERR "no files in source list, skipping\n"; + exit 1; +} + +# find the appropriate script file +$confdir = `gconfig -q CONFDIR`; chop ($confdir); +$script = "$confdir/mana/fringe.pro"; + +# test named Xserver, or start vnc on specified machine +$xhost=`gconfig -q XHOST`; chop ($xhost); +$xdisp=`gconfig -q XDISP`; chop ($xdisp); +if (vsystem ("xdpyinfo -display $xdisp")) { + print STDERR "X server is not running. start it now on $xhost\n"; + exit 1; +} +$ENV{'DISPLAY'} = $xdisp; + +# run mana script: +open (MANA, "|mana --norc"); +print MANA "input $script\n"; +print MANA "\$RANGE = $range\n"; +print MANA "mkjpegs $list $tenbin $medbin $stats\n"; +print MANA "exit 1\n"; +close (MANA); +if ($?) { die "ERROR problem with fr.jpegs\n"; } + +print STDOUT "SUCCESS: finished with fr.jpegs\n"; +exit 0; + +sub vsystem { + print STDERR "@_\n"; + $status = system ("@_"); + $status; +} + +sub goodbye { + die "@_\n"; +} + +sub usage { + print "USAGE: fr.jpegs (list) (tenbin) (medbin) (range)\n"; + print " create big and small jpeg images from the input list\n"; + exit 1; +} + +# mana within perl: we embed the mana functions within a macro to trap the +# exit status. If mana has an error with one of the steps, it will exit the macros and +# the second exit will be called. Otherwise, the "go" macro will perform the exit 0 +# and mana will exit with status 0 Index: /tags/ohana/perl-1-3/Ohana/src/perl/src/fr.medbin.interp =================================================================== --- /tags/ohana/perl-1-3/Ohana/src/perl/src/fr.medbin.interp (revision 21906) +++ /tags/ohana/perl-1-3/Ohana/src/perl/src/fr.medbin.interp (revision 21906) @@ -0,0 +1,130 @@ +#!/usr/bin/env perl + +# check the usage +if ($ARGV[0] eq "-h") { usage (); } +if ($ARGV[0] eq "-help") { usage (); } +if (@ARGV != 5) { die "USAGE: fr.medbin (path) (root) (factor) (meddir) (mapdir)\n" } + +# assign the command line arguments +$path = $ARGV[0]; +$root = $ARGV[1]; +$factor = $ARGV[2]; +$meddir = $ARGV[3]; +$mapdir = $ARGV[4]; + +$Nccd = `cameraconfig -Nccd`; chop ($Nccd); +@ccds = split (" ", `cameraconfig -ccdn`); +if ($?) { die "ERROR: cameraconfig error\n"; } + +($Xmap, $Ymap) = split (" ", `gconfig FRINGE_MAP_SCALE`); +if ($?) { die "ERROR: missing FRINGE_MAP_SCALE in config system\n"; } + +if (! -d $meddir) { vsystem ("mkdir -p $meddir"); } +if (! -d $mapdir) { vsystem ("mkdir -p $mapdir"); } + +open (MANA, "|mana --norc"); + +# convert BIASSEC string to x1, x2, y1, y2 vars +print MANA "macro parsesec\n"; +print MANA " \$f = \$1\n"; +print MANA " getchr \$f : n\n"; +print MANA " substr \$f 1 {\$n-1} x1\n"; +print MANA " strlen \$f N\n"; +print MANA " substr \$f \$n {\$N-\$n} f\n"; + +print MANA " getchr \$f , n\n"; +print MANA " substr \$f 1 {\$n-1} x2\n"; +print MANA " strlen \$f N\n"; +print MANA " substr \$f \$n {\$N-\$n} f\n"; + +print MANA " getchr \$f : n\n"; +print MANA " substr \$f 1 {\$n-1} y1\n"; +print MANA " strlen \$f N\n"; +print MANA " substr \$f \$n {\$N-\$n} f\n"; + +print MANA " getchr \$f ] n\n"; +print MANA " substr \$f 1 {\$n-1} y2\n"; +print MANA " strlen \$f N\n"; +print MANA " substr \$f \$n {\$N-\$n} f\n"; +print MANA "end\n"; + +print MANA "macro mkmap\n"; +# load detrended image +print MANA " rd a \$1\n"; +print MANA " keyword a NAXIS1 nx\n"; +print MANA " keyword a NAXIS2 ny\n"; + +# generate binned image +print MANA " medianmap a b {\$nx/$factor} {\$ny/$factor} -range 0.25 0.75\n"; +print MANA " keyword a DATASEC line\n"; +print MANA " parsesec \$line\n"; +print MANA " sprint newline \"[%d:%d,%d:%d]\" {int(\$x1/2 + 1)} {int(\$x2/2 + 1)} {int(\$y1/2 + 1)} {int(\$y2/2 + 1)}\n"; +print MANA " keyword b DATASEC -w \$newline\n"; +print MANA " keyword b NAXIS1 nx\n"; +print MANA " keyword b NAXIS2 ny\n"; + +# sky from first ccd saved for reference +print MANA " if (\$setsky)\n"; +print MANA " stats -q b - - - -\n"; +print MANA " \$sky = \$MEDIAN\n"; +print MANA " \$setsky = 0\n"; +print MANA " end\n"; +# we use the sky value of the first chip to remove the DC level for map, add it to med + +# create Xmap x Ymap sky map, interpolate to medbin scale +print MANA " medianmap b m $Xmap $Ymap -ignore 0.0 -range 0.25 0.75\n"; +print MANA " set m = m - \$sky\n"; +print MANA " \$fm = \$nx / $Xmap\n"; +print MANA " \$fy = \$ny / $Ymap\n"; +print MANA " if (\$fy > \$fm)\n"; +print MANA " \$fm = \$fy\n"; +print MANA " end\n"; +print MANA " minterp m M \$fm\n"; +print MANA " extract M sky 0 0 \$nx \$ny 0 0 \$nx \$ny\n"; + +# multiplying by (abs(b) > 0.001) maintains the mask +print MANA " set c = (b - sky) * (abs(b) > 0.001)\n"; +print MANA " wd c \$2\n"; +print MANA " wd m \$3 -bitpix -32 -bzero 0.0 -bscale 1.0\n"; +print MANA "end\n"; + +print MANA "macro go\n"; +print MANA " \$setsky = 1\n"; +for ($ccd = 0; $ccd < $Nccd; $ccd++) { + $infile = sprintf "%s/%s%s.fits", $path, $root, $ccds[$ccd]; + $outmed = sprintf "%s/%s%s.fits", $meddir, $root, $ccds[$ccd]; + $outmap = sprintf "%s/%s%s.fits", $mapdir, $root, $ccds[$ccd]; + print MANA " mkmap $infile $outmed $outmap\n"; +} +print MANA " exit 0\n"; +print MANA "end\n"; +print MANA "go\n"; +print MANA "exit 1\n"; +close (MANA); +if ($?) { + print STDERR "ERROR running mana\n"; + exit 1; +} + +print STDOUT "SUCCESS: finished with fr.medbin.spline\n"; +exit 0; + +sub vsystem { + print STDERR "@_\n"; + $status = system ("@_"); + $status; +} + +sub goodbye { + die "@_\n"; +} + +sub usage { + print "\n"; + print "USAGE: fr.medbin.spline (path) (root) (factor) (outpath)\n"; + print " path: path to MEF image or SPLIT dir\n"; + print " root: root name of image (MEF = root.fits, SPLIT = root/rootNN.fits)\n"; + print " mode: MEF or SPLIT\n"; + print " outdir: directory for output results (all split)\n"; + exit 1; +} Index: /tags/ohana/perl-1-3/Ohana/src/perl/src/fr.medbin.spline =================================================================== --- /tags/ohana/perl-1-3/Ohana/src/perl/src/fr.medbin.spline (revision 21906) +++ /tags/ohana/perl-1-3/Ohana/src/perl/src/fr.medbin.spline (revision 21906) @@ -0,0 +1,125 @@ +#!/usr/bin/env perl + +# check the usage +if ($ARGV[0] eq "-h") { usage (); } +if ($ARGV[0] eq "-help") { usage (); } +if (@ARGV != 5) { die "USAGE: fr.medbin (path) (root) (factor) (meddir) (mapdir)\n" } + +# assign the command line arguments +$path = $ARGV[0]; +$root = $ARGV[1]; +$factor = $ARGV[2]; +$meddir = $ARGV[3]; +$mapdir = $ARGV[4]; + +$Nccd = `cameraconfig -Nccd`; chop ($Nccd); +@ccds = split (" ", `cameraconfig -ccdn`); +if ($?) { die "ERROR: cameraconfig error\n"; } + +($Xmap, $Ymap) = split (" ", `gconfig FRINGE_MAP_SCALE`); +if ($?) { die "ERROR: missing FRINGE_MAP_SCALE in config system\n"; } + +if (! -d $meddir) { vsystem ("mkdir -p $meddir"); } +if (! -d $mapdir) { vsystem ("mkdir -p $mapdir"); } + +open (MANA, "|mana --norc"); + +# convert BIASSEC string to x1, x2, y1, y2 vars +print MANA "macro parsesec\n"; +print MANA " \$f = \$1\n"; +print MANA " getchr \$f : n\n"; +print MANA " substr \$f 1 {\$n-1} x1\n"; +print MANA " strlen \$f N\n"; +print MANA " substr \$f \$n {\$N-\$n} f\n"; + +print MANA " getchr \$f , n\n"; +print MANA " substr \$f 1 {\$n-1} x2\n"; +print MANA " strlen \$f N\n"; +print MANA " substr \$f \$n {\$N-\$n} f\n"; + +print MANA " getchr \$f : n\n"; +print MANA " substr \$f 1 {\$n-1} y1\n"; +print MANA " strlen \$f N\n"; +print MANA " substr \$f \$n {\$N-\$n} f\n"; + +print MANA " getchr \$f ] n\n"; +print MANA " substr \$f 1 {\$n-1} y2\n"; +print MANA " strlen \$f N\n"; +print MANA " substr \$f \$n {\$N-\$n} f\n"; +print MANA "end\n"; + +print MANA "macro mkmap\n"; +# load detrended image +print MANA " rd a \$1\n"; +print MANA " keyword a NAXIS1 nx\n"; +print MANA " keyword a NAXIS2 ny\n"; + +# generate binned image +print MANA " medianmap a b {\$nx/$factor} {\$ny/$factor} -range 0.25 0.75\n"; +print MANA " keyword a DATASEC line\n"; +print MANA " parsesec \$line\n"; +print MANA " sprint newline \"[%d:%d,%d:%d]\" {int(\$x1/2 + 1)} {int(\$x2/2 + 1)} {int(\$y1/2 + 1)} {int(\$y2/2 + 1)}\n"; +print MANA " keyword b DATASEC -w \$newline\n"; +print MANA " keyword b NAXIS1 nx\n"; +print MANA " keyword b NAXIS2 ny\n"; + +# sky from first ccd saved for reference +print MANA " if (\$setsky)\n"; +print MANA " stats -q b - - - -\n"; +print MANA " \$sky = \$MEDIAN\n"; +print MANA " \$setsky = 0\n"; +print MANA " end\n"; +# we use the sky value of the first chip to remove the DC level for map, add it to med + +# create Xmap x Ymap sky map, spline-fit to medbin scale +print MANA " medianmap b m $Xmap $Ymap -ignore 0.0 -range 0.25 0.75\n"; +print MANA " set m = m - \$sky\n"; +print MANA " spline.construct m M x\n"; +print MANA " spline.apply m M sky x \$nx \$ny\n"; + +# multiplying by (abs(b) > 0.001) maintains the mask +print MANA " set c = (b - sky) * (abs(b) > 0.001)\n"; +print MANA " wd c \$2\n"; +print MANA " wd m \$3 -bitpix -32 -bzero 0.0 -bscale 1.0\n"; +print MANA "end\n"; + +print MANA "macro go\n"; +print MANA " \$setsky = 1\n"; +for ($ccd = 0; $ccd < $Nccd; $ccd++) { + $infile = sprintf "%s/%s%s.fits", $path, $root, $ccds[$ccd]; + $outmed = sprintf "%s/%s%s.fits", $meddir, $root, $ccds[$ccd]; + $outmap = sprintf "%s/%s%s.fits", $mapdir, $root, $ccds[$ccd]; + print MANA " mkmap $infile $outmed $outmap\n"; +} +print MANA " exit 0\n"; +print MANA "end\n"; +print MANA "go\n"; +print MANA "exit 1\n"; +close (MANA); +if ($?) { + print STDERR "ERROR running mana\n"; + exit 1; +} + +print STDOUT "SUCCESS: finished with fr.medbin.spline\n"; +exit 0; + +sub vsystem { + print STDERR "@_\n"; + $status = system ("@_"); + $status; +} + +sub goodbye { + die "@_\n"; +} + +sub usage { + print "\n"; + print "USAGE: fr.medbin.spline (path) (root) (factor) (outpath)\n"; + print " path: path to MEF image or SPLIT dir\n"; + print " root: root name of image (MEF = root.fits, SPLIT = root/rootNN.fits)\n"; + print " mode: MEF or SPLIT\n"; + print " outdir: directory for output results (all split)\n"; + exit 1; +} Index: /tags/ohana/perl-1-3/Ohana/src/perl/src/fr.mkhtml =================================================================== --- /tags/ohana/perl-1-3/Ohana/src/perl/src/fr.mkhtml (revision 21906) +++ /tags/ohana/perl-1-3/Ohana/src/perl/src/fr.mkhtml (revision 21906) @@ -0,0 +1,96 @@ +#!/usr/bin/env perl + +if (@ARGV < 1) { &escape ("USAGE: fr.mkhtml -mode [args]"); } +if ($ARGV[0] eq "help") { &usage; } + +# copy CONFIG.imstats to html dir +if ($ARGV[0] eq "-imstats") { + + $input = $ARGV[1]; + $outdir = $ARGV[2]; + + if (! -d $outdir) { + vsystem ("mkdir -p $outdir"); + if ($?) { &escape ("can't make directory component for output $outdir"); } + } + + vsystem ("cp $input $outdir"); + if ($?) { &escape ("problem copying $input to $outdir"); } + + &goodbye; +} + +# create frstats file for list of raw fringe measurements using measure fringe parameters +if ($ARGV[0] eq "-jpglist") { + + $list = $ARGV[1]; + $outdir = $ARGV[2]; + $root = $ARGV[3]; + $outlist = sprintf "%s/%s.list", $outdir, $root; + print STDERR "outlist: $outlist\n"; + + if (! -d $outdir) { + vsystem ("mkdir -p $outdir"); + if ($?) { &escape ("can't make directory component for output $outdir"); } + } + + open (FILE, "$list"); + @list = ; + close (FILE); + foreach $line (@list) { chop $line; } + + # list contains MOSAIC.med.medbin.jpg + # copy to html/CONFIG.med.medbin.NNN.jpg + + $Nfound = 0; + foreach $line (@list) { + if (-e $line) { $Nfound ++; } + } + if ($Nfound < @list) { + print STDERR "NOTE: no files from $list: assuming initial state\n"; + open (FILE, ">$outlist"); + close (FILE); + &goodbye; + } + + open (FILE, ">$outlist"); + for ($i = 0; $i < @list; $i++) { + + $inname = $list[$i]; + $outname = sprintf "%s/%s.%03d.jpg", $outdir, $root, $i; + vsystem ("cp -f $inname $outname"); + if ($?) { &escape ("problem copying $inname to $outname"); } + + print FILE "$outname\n"; + } + close (FILE); + &goodbye; +} + +&escape ("unknown fr.frstats command $ARGV[0]"); + +## utilities + +sub vsystem { + print STDERR "@_\n"; + $status = system ("@_"); + $status; +} + +sub goodbye { + print STDOUT "SUCCESS: finished with fr.stats\n"; + exit 0; +} + +sub escape { + print STDOUT "ERROR: $_[0]\n"; + exit 1; +} + +sub usage { + + print STDOUT "fr.mklists -fitpars CONFIG.med.sublist CONFIG.fitpars\n"; + print STDOUT "fr.frstats -frstats CONFIG.med.statlist CONFIG.fitpars CONFIG.med.imstats\n"; + + exit 2; +} Index: /tags/ohana/perl-1-3/Ohana/src/perl/src/fr.mklists =================================================================== --- /tags/ohana/perl-1-3/Ohana/src/perl/src/fr.mklists (revision 21906) +++ /tags/ohana/perl-1-3/Ohana/src/perl/src/fr.mklists (revision 21906) @@ -0,0 +1,529 @@ +#!/usr/bin/env perl + +if (@ARGV < 1) { + print STDERR "USAGE: fr.mklists -mode [args]\n"; + &escape; +} + +if ($ARGV[0] eq "help") { + + print STDERR "fr.mklists -initial CONFIG.split CONFIG.mef CONFIG.master\n"; + print STDERR "fr.mklists -detrend CONFIG.master CONFIG.detrend\n"; + print STDERR "fr.mklists -defringe CONFIG.master CONFIG.defringe\n"; + print STDERR "fr.mklists -imlist TEMPLATE CONFIG.statlist [Nccd?]\n"; + print STDERR "fr.mklists -mosaic CONFIG.master proc name\n"; + print STDERR "fr.mklists -master CONFIG.detrend CONFIG.master\n"; + print STDERR "fr.mklists -inlist CONFIG.master 00 proc CONF-CCD.inlist\n"; + print STDERR "fr.mklists -imstats CONFIG.master 00 proc CONF-CCD.imstats\n"; + print STDERR "fr.mklists -frstats CONFIG.master proc CONF-CCD.imstats\n"; + &escape; +} + +@ccds = split (" ", `cameraconfig -ccdn`); +if ($?) { die "error in config\n"; } + +$STAT_XCLD = 0; +$STAT_KEEP = 1; +$STAT_XDET = 2; +$STAT_DETR = 3; + +# merge CONFIG.mef & CONFIG.split to CONFIG.master [starting status = 3] +if ($ARGV[0] eq "-initial") { + + if (@ARGV != 4) { + print STDERR "fr.mklists -initial CONFIG.split CONFIG.mef CONFIG.master\n"; + &escape; + } + + open (FILE, "$ARGV[1]"); + @list1 = ; + close (FILE); + + open (FILE, "$ARGV[2]"); + @list2 = ; + close (FILE); + + open (FILE, ">$ARGV[3]"); + foreach $line (@list1) { + chop $line; + print FILE "$line $STAT_DETR\n"; + } + foreach $line (@list2) { + chop $line; + print FILE "$line $STAT_DETR\n"; + } + close (FILE); + + if ((@list1 == 0) && (@list2 == 0)) { + print STDERR "no images available\n"; + &escape; + } + + &goodbye; +} + +# convert CONFIG.master to CONFIG.detrend (status == XDET || DETR, strip status) +if ($ARGV[0] eq "-detrend") { + + if (@ARGV != 3) { + print STDERR "fr.mklists -detrend CONFIG.master CONFIG.detrend\n"; + &escape; + } + + open (FILE, "$ARGV[1]"); + @list = ; + close (FILE); + + open (FILE, ">$ARGV[2]"); + foreach $line (@list) { + @words = split (" ", $line); + if (($words[3] == $STAT_XDET) || ($words[3] == $STAT_DETR)) { + print FILE "$words[0] $words[1] $words[2]\n"; + } + } + close (FILE); + &goodbye; +} + +# convert CONFIG.master to CONFIG.defringe, used to generate input list to mode.fringe3 +if ($ARGV[0] eq "-defringe") { + + if (@ARGV != 5) { + print STDERR "@ARGV\n"; + print STDERR "fr.mklists -detrend CONFIG.master CONFIG TMPPATH CONFIG.defringe\n"; + &escape; + } + + $infile = $ARGV[1]; + $confline = $ARGV[2]; + $tmppath = $ARGV[3]; + $outfile = $ARGV[4]; + + open (FILE, "$infile"); + @list = ; + close (FILE); + + open (FILE, ">$outfile"); + foreach $line (@list) { + ($path, $root, $mode, $status) = split (" ", $line); + print FILE "$tmppath/$root $confline\n"; + } + close (FILE); + &goodbye; +} + +# use TEMPLATE to create a list with NCCD entries replacing CCDNUM +if ($ARGV[0] eq "-imlist") { + + if (@ARGV != 3) { + print STDERR "fr.mklists -detrend TEMPLATE CONFIG.defringe\n"; + &escape; + } + + open (FILE, ">$ARGV[2]"); + foreach $ccd (@ccds) { + $name = $ARGV[1]; + $name =~ s/CCDNUM/$ccd/; + print FILE "$name\n"; + } + close (FILE); + &goodbye; +} + +# use CONFIG.master to create Nimage lists, each called OUTDIR/root.WORDlist with +# NCCD entries OUTDIR/root.WORD/rootNN.fits +if ($ARGV[0] eq "-mosaic") { + + if (@ARGV != 4) { + print STDERR "fr.mklists -mosaic CONFIG.master OUTDIR WORD\n"; + &escape; + } + + $infile = $ARGV[1]; + $outpath = $ARGV[2]; + $word = $ARGV[3]; + + open (FILE, $infile); + @inlist = ; + close (FILE); + + foreach $name (@inlist) { + ($path, $root, $mode) = split (" ", $name); + + $outfile = sprintf "%s/%s.%slist", $outpath, $root, $word; + + open (FILE, ">$outfile"); + foreach $ccd (@ccds) { + printf FILE "$outpath/$root.$word/$root$ccd.fits\n"; + } + close (FILE); + } + &goodbye; +} + +# use CONFIG.master to create OUTPUT list with Nimage lines: OUTDIR/root.WORD +if ($ARGV[0] eq "-mlist") { + + if (@ARGV != 5) { &escape ("USAGE: fr.mklists -mlist CONFIG.master OUTDIR WORD OUTPUT"); } + + $infile = $ARGV[1]; + $outpath = $ARGV[2]; + $word = $ARGV[3]; + $outfile = $ARGV[4]; + + open (FILE, $infile); + @inlist = ; + close (FILE); + + open (FILE, ">$outfile"); + foreach $name (@inlist) { + ($path, $root, $mode) = split (" ", $name); + $file = sprintf "%s/%s.%s", $outpath, $root, $word; + printf FILE "$file\n"; + } + close (FILE); + + &goodbye; +} + +# merge data from master, med.imstats, def.imstats, datlist into a single file for the html scripts +if ($ARGV[0] eq "-imstats") { + + if (@ARGV != 6) { + print STDERR "fr.mklists -imstats CONFIG.master CONFIG.med.imstats CONFIG.def.imstats CONFIG.datlist CONFIG.imstats\n"; + &escape; + } + + $master = $ARGV[1]; + $medstat = $ARGV[2]; + $defstat = $ARGV[3]; + $datlist = $ARGV[4]; + $output = $ARGV[5]; + + open (FILE, "$master"); + @master = ; + close (FILE); + + open (FILE, "$medstat"); + @medstat = ; + close (FILE); + if (@master != @medstat) { &escape ("mismatch in master & medstat lists"); } + + open (FILE, "$defstat"); + @defstat = ; + close (FILE); + if (@master != @defstat) { print STDERR "NOTE: no data in $defstat\n"; } + + open (FILE, "$datlist"); + @datlist = ; + close (FILE); + if (@master != @datlist) { &escape ("mismatch in master & datlist lists"); } + + open (FILE, ">$output"); + for ($i = 0; $i < @master; $i++) { + ($path, $root, $mode, $status) = split (" ", $master[$i]); + + open (LIST, "$datlist[$i]"); + $line = ; + close (LIST); + ($obsid, $date, $time, $exptime) = split (" ", $line); + + ($S1, $F1, $dF1) = split (" ", $medstat[$i]); + if (@defstat) { + ($S2, $F2, $dF2) = split (" ", $defstat[$i]); + } + $flux = $S1 / $exptime; + + if (@defstat) { + printf FILE "%8s %11s %12s %7.1f %6.2f %6.1f %6.1f %6.1f %6.1f %2d %2d\n", $obsid, $date, $time, $S1, $flux, $F1, $dF1, $F2, $dF2, $status, $status; + } else { + printf FILE "%8s %11s %12s %7.1f %6.2f %6.1f %6.1f N/A N/A %2d %2d\n", $obsid, $date, $time, $S1, $flux, $F1, $dF1, $status, $status; + } + } + close (FILE); + &goodbye; +} + +# use CONFIG.master to create a subset of INPUT in OUTPUT +if ($ARGV[0] eq "-subset") { + + if (@ARGV != 4) { &escape ("USAGE: fr.mklists -subset CONFIG.master INPUT OUTPUT"); } + + $master = $ARGV[1]; + $input = $ARGV[2]; + $output = $ARGV[3]; + + open (FILE, $master); + @master = ; + close (FILE); + + open (FILE, $input); + @input = ; + close (FILE); + + if (@master != @input) { &escape ("mismatch in input & master file lengths"); } + + open (FILE, ">$output"); + + for ($i = 0; $i < @master; $i++) { + $line = $master[$i]; chop $line; + ($path, $root, $mode, $status) = split (" ", $line); + if ($status != $STAT_KEEP) { next; } + + $file = $input[$i]; chop $file; + printf FILE "$file\n"; + } + close (FILE); + + &goodbye; +} + +# use master, med.imstats, and statlist to create input list for fr.mkrough (file sky fringe 0 0) +if ($ARGV[0] eq "-ccdstats") { + + if (@ARGV != 6) { &escape ("USAGE: fr.mklists -ccdstats CONFIG.master CONFIG.med.imstats CONFIG.med.statlist CCD CONFIG.CCD.ccdstats"); } + + $master = $ARGV[1]; + $imstats = $ARGV[2]; # list of basic image stats + $statlist = $ARGV[3]; # list of image stat files (1 line per frame) + $ccd = $ARGV[4]; + $output = $ARGV[5]; + + # $ccd = `cameraconfig -N $ccdid`; + # if ($ccd eq "") { &escape ("error in CCD ID"); } + + open (FILE, $master); + @master = ; + close (FILE); + + open (FILE, $imstats); + @imstats = ; + close (FILE); + if (@master != @imstats) { &escape ("mismatch in master & imstats file lengths"); } + + open (FILE, $statlist); + @statlist = ; + close (FILE); + if (@master != @statlist) { &escape ("mismatch in master & statlist file lengths"); } + + # find image with strongest fringe amplitude + $fringemax = ""; + for ($i = 0; $i < @imstats; $i++) { + $line = $master[$i]; chop $line; + ($path, $root, $mode, $status) = split (" ", $line); + if ($status != $STAT_KEEP) { next; } + + $line = $imstats[$i]; chop $line; + ($SKY, $fringe, $dfringe) = split (" ", $line); + if ($fringemax eq "") { $fringemax = $fringe; } + if ($fringemax < $fringe) { $fringemax = $fringe; } + } + print "fringemax: $fringemax\n"; + + open (FILE, ">$output"); + for ($i = 0; $i < @master; $i++) { + $line = $master[$i]; chop $line; + ($path, $root, $mode, $status) = split (" ", $line); + if ($status != $STAT_KEEP) { next; } + + $line = $imstats[$i]; chop $line; + ($SKY, $fringe, $dfringe) = split (" ", $line); + $frnorm = $fringe / $fringemax; + # imcombred is not renormalizing: this will force fringe amplitude to a useful level + + # file is list of fringe stats (1 line per chip) + $file = $statlist[$i]; chop $file; + open (STAT, "$file"); + @stats = ; + close (STAT); + + $line = $stats[$ccd]; + ($name, $sky) = split (" ", $line); + + # compare $sky with average sky $SKY? + $dsky = $sky - $SKY; + print FILE "$name $sky $frnorm\n"; + } + close (FILE); + + &goodbye; +} + +# re-create master list, applying changes from detrend list +if ($ARGV[0] eq "-master") { + + if (@ARGV != 3) { + print STDERR "fr.mklists -master CONFIG.master CONFIG.detrend\n"; + &escape; + } + + $master = $ARGV[1]; + $detrend = $ARGV[2]; + + open (FILE, $master); + @master = ; + close (FILE); + foreach $name (@master) { chop ($name); } + + open (FILE, $detrend); + @detrend = ; + close (FILE); + foreach $name (@detrend) { chop ($name); } + + @remaster = (); + MASTER: + foreach $name (@master) { + ($path, $root, $mode, $status) = split (" ", $name); + + if (($status == $STAT_XDET) || ($status == $STAT_DETR)) { + # find entry in detrend list. if it exists, set status to status - 2 + DETREND: + foreach $dname (@detrend) { + ($dpath, $droot, $dmode) = split (" ", $name); + if ($droot eq $root) { + if ($status == $STAT_XDET) { $status = $STAT_XCLD; } + if ($status == $STAT_DETR) { $status = $STAT_KEEP; } + last DETREND; + } + } + } + + $new = "$path $root $mode $status"; + @remaster = (@remaster, $new); + } + + open (FILE, ">$master"); + foreach $name (@remaster) { + print FILE "$name\n"; + } + close (FILE); + &goodbye; +} + +# create list of input (detrended) frames for a single CCD for mkstats (status == 1) +if ($ARGV[0] eq "-inlist") { + + if (@ARGV != 5) { + print STDERR "fr.mklists -inlist CONFIG.master CCD TMPPATH CONF-CCD.inlist\n"; + &escape; + } + + $infile = $ARGV[1]; + $ccd = $ARGV[2]; + $tmppath = $ARGV[3]; + $outfile = $ARGV[4]; + + open (FILE, "$infile"); + @inlist = ; + close (FILE); + + open (FILE, ">$outfile"); + foreach $name (@inlist) { + ($path, $root, $mode, $status) = split (" ", $name); + if ($status != $STAT_KEEP) { next; } + + printf FILE "%s/%s.med/%s%s.fits\n", $tmppath, $root, $root, $ccd; + } + close (FILE); + &goodbye; +} + +### this old -imstats will be replaced. +# create list of input (detrended) frames for a single CCD for mkstats (status == 1) +if ($ARGV[0] eq "-imstats") { + + if (@ARGV != 5) { + print STDERR "fr.mklists -inlist CONFIG.master CCD TMPPATH CONF-CCD.imstats\n"; + &escape; + } + + $infile = $ARGV[1]; + $ccd = $ARGV[2]; + $tmppath = $ARGV[3]; + $outfile = $ARGV[4]; + + open (FILE, "$infile"); + @inlist = ; + close (FILE); + + open (FILE, ">$outfile"); + foreach $name (@inlist) { + ($path, $root, $mode, $status) = split (" ", $name); + if ($status != $STAT_KEEP) { next; } + + printf FILE "%s/%s.imstats\n", $tmppath, $root; + } + close (FILE); + &goodbye; +} + +# create list of input stats files +if ($ARGV[0] eq "-frstats") { + + if (@ARGV != 4) { + print STDERR "fr.mklists -frstats CONFIG.master TMPPATH CONF-CCD.imstats\n"; + &escape; + } + + $infile = $ARGV[1]; + $tmppath = $ARGV[2]; + $outfile = $ARGV[3]; + + open (FILE, "$infile"); + @inlist = ; + close (FILE); + + open (FILE, ">$outfile"); + foreach $name (@inlist) { + ($path, $root, $mode, $status) = split (" ", $name); + printf FILE "%s/%s.imstats\n", $tmppath, $root; + } + close (FILE); + &goodbye; +} + +# create list of input stats files +if ($ARGV[0] eq "-maplist") { + + if (@ARGV != 4) { + print STDERR "fr.mklists -maplist CONFIG.master TMPPATH CONFIG.maplists\n"; + &escape; + } + + $infile = $ARGV[1]; + $tmppath = $ARGV[2]; + $outfile = $ARGV[3]; + + open (FILE, "$infile"); + @inlist = ; + close (FILE); + + open (FILE, ">$outfile"); + foreach $name (@inlist) { + ($path, $root, $mode, $status) = split (" ", $name); + printf FILE "%s/%s.maplist 1\n", $tmppath, $root; + } + close (FILE); + &goodbye; +} + +&escape ("unknown mode $ARGV[0]"); + +########################################################################### + +sub vsystem { + print STDERR "@_\n"; + $status = system ("@_"); + $status; +} + +sub escape { + print STDERR "ERROR: @_\n"; + exit 1; +} + +sub goodbye { + print STDERR "SUCCESS @_\n"; + exit 0; +} + Index: /tags/ohana/perl-1-3/Ohana/src/perl/src/fr.mkmodes =================================================================== --- /tags/ohana/perl-1-3/Ohana/src/perl/src/fr.mkmodes (revision 21906) +++ /tags/ohana/perl-1-3/Ohana/src/perl/src/fr.mkmodes (revision 21906) @@ -0,0 +1,146 @@ +#!/usr/bin/env perl + +{ # grab the command line arguments: + $elconf = ""; + $elixcf = "-c /h/eugene/.ptolemyrc"; + @tARGV = (); + for (; @ARGV > 0; ) { + + # grab elixir/ptolemy config option -c + if ($ARGV[0] eq "-c") { + shift; + $elixcf = "-c $ARGV[0]"; + shift; + next; + } + + # grab elixir/ptolemy config option -C + if ($ARGV[0] eq "-C") { + @opt = (@opt, $ARGV[0]); + shift; + @opt = (@opt, $ARGV[0]); + $elconf = $ARGV[0]; + shift; + next; + } + + # grab elixir/ptolemy config option -D + if ($ARGV[0] eq "-D") { + @opt = (@opt, $ARGV[0]); + shift; + @opt = (@opt, $ARGV[0]); + shift; + @opt = (@opt, $ARGV[0]); + shift; + next; + } + + @tARGV = (@tARGV, $ARGV[0]); + shift; + } + @ARGV = @tARGV; + $elixir = join (" ", $elixcf, @opt); +} + +# check the usage +if ($ARGV[0] eq "-h") { usage (); } +if ($ARGV[0] eq "-help") { usage (); } +if (@ARGV != 3) { die "USAGE: fr.mkmodes (maplist) (mode.fits) (mode.list)\n" } + +# assign the command line arguments +$list = $ARGV[0]; +$output = $ARGV[1]; +$modes = $ARGV[2]; + +# find the appropriate script file +$confdir = `gconfig $elixir -q CONFDIR`; chop ($confdir); +$script = "$confdir/mana/modes.pro"; +$Nccd = `cameraconfig $elixir -Nccd`; chop ($Nccd); + +# load in list of input image lists +open (LIST, $list); +@list = ; +close (LIST); + +# if mode list exists, load it in and use the selected modes +# to set the new default selection +$GotModes = 0; +if (-e $modes) { + open (LIST, $modes); + @modes = ; + close (LIST); + $GotModes = 1; +} + +# send commands to mana: +open (MANA, "|mana --norc"); +print MANA "input $script\n"; + +# create a mana list of input file names +print MANA "list names\n"; +$Nimages = 0; +foreach $line (@list) { + ($name, $status) = split (" ", $line); + if ($status) { print MANA " $name\n"; } + $Nimages ++; +} +print MANA "end\n"; + +# create a mana list of input file names +print MANA "macro go\n"; +print MANA " mkimage $output\n"; +print MANA " exit 0\n"; +print MANA "end\n"; +print MANA "go\n"; +print MANA "exit 1\n"; +close (MANA); +if ($?) { + print STDERR "ERROR running mana\n"; + exit 1; +} + +# create new list of modes. if modes existed, use selected modes, otherwisaudio/x-pn-realaudio-plugine first 8: +$DefaultStatus = 1; +open (LIST, ">$modes"); +for ($i = 0; $i < $Nimages; $i++) { + # this is just a little funny: there is not a 1-1 relationship + # between the selected images and the modes in this selection. + # only the first few modes will be significant, so we are just + # cutting of the few end modes + if ($i >= 8) { $DefaultStatus = 0; } + if ($GotModes) { + ($mode, $status) = split (" ", $modes[$i]); + print LIST "$mode $status\n"; + } else { + print LIST "$i $DefaultStatus\n"; + } +} +close (LIST); + +print STDOUT "SUCCESS: finished with fr.detrend\n"; +exit 0; + +sub vsystem { + print STDERR "@_\n"; + $status = system ("@_"); + $status; +} + +sub goodbye { + die "@_\n"; +} + +sub usage { + print "\n"; + print "USAGE: fr.mkmodes (list) (output) (modes)\n"; + print " list: list of lists - each list contains names of the input images (*.map/*.fits)\n"; + print " output: master image of orthonormal modes\n"; + print " modes: list of modes in output, with status\n"; + exit 1; +} + +# mana within perl: we embed the mana functions within a macro to trap the +# exit status. If mana has an error with one of the steps, it will exit the macros and +# the second exit will be called. Otherwise, the "go" macro will perform the exit 0 +# and mana will exit with status 0 + Index: /tags/ohana/perl-1-3/Ohana/src/perl/src/fr.modesave =================================================================== --- /tags/ohana/perl-1-3/Ohana/src/perl/src/fr.modesave (revision 21906) +++ /tags/ohana/perl-1-3/Ohana/src/perl/src/fr.modesave (revision 21906) @@ -0,0 +1,78 @@ +#!/usr/bin/env perl + +# check the usage +if ($ARGV[0] eq "-h") { &usage (); } +if ($ARGV[0] eq "-help") { &usage (); } +if (@ARGV != 6) { &usage (); } + +# assign the command line arguments +$modefits = $ARGV[0]; +$modelist = $ARGV[1]; +$modesave = $ARGV[2]; +$startime = $ARGV[3]; +$stoptime = $ARGV[4]; +$filter = $ARGV[5]; + +# find the appropriate script file +$confdir = `gconfig -q CONFDIR`; chop ($confdir); +$script = "$confdir/mana/modes.pro"; + +# load in list of modes +open (LIST, $modelist); +@modelist = ; +close (LIST); + +$Nmode = 8; + +# run mana script: +open (MANA, "|mana --norc"); +print MANA "input $script\n"; + +print MANA "macro go\n"; +print MANA "\$filter = $filter\n"; +print MANA "\$start = \"$startime\"\n"; +print MANA "\$stop = \"$stoptime\"\n"; +print MANA "\$Nmode = $Nmode\n"; +for ($i = 0; $i < $Nmode; $i++ ) { + ($mode, $status) = split (" ", $modelist[$i]); + if ($status) { + print MANA "\$mode$i = 1\n"; + } else { + print MANA "\$mode$i = 0\n"; + } +} +print MANA "rd U $modefits\n"; +print MANA "savemodes $modesave\n"; +print MANA "exit 0\n"; + +print MANA "end\n"; +print MANA "go\n"; +print MANA "exit 1\n"; +close (MANA); +if ($?) { + print STDERR "ERROR problem with fr.modesave\n"; + exit 1; +} + +print STDOUT "SUCCESS: finished with fr.modesave\n"; +exit 0; + +sub vsystem { + print STDERR "@_\n"; + $status = system ("@_"); + $status; +} + +sub goodbye { + die "@_\n"; +} + +sub usage { + print "USAGE: fr.modesave (mode.fits) (mode.list) (mode.mef.fits) (start) (stop) (filter)\n"; + exit 1; +} + +# mana within perl: we embed the mana functions within a macro to trap the +# exit status. If mana has an error with one of the steps, it will exit the macros and +# the second exit will be called. Otherwise, the "go" macro will perform the exit 0 +# and mana will exit with status 0 Index: /tags/ohana/perl-1-3/Ohana/src/perl/src/fr.modestats =================================================================== --- /tags/ohana/perl-1-3/Ohana/src/perl/src/fr.modestats (revision 21906) +++ /tags/ohana/perl-1-3/Ohana/src/perl/src/fr.modestats (revision 21906) @@ -0,0 +1,98 @@ +#!/usr/bin/env perl + +# check the usage +if ($ARGV[0] eq "-h") { &usage (); } +if ($ARGV[0] eq "-help") { &usage (); } +if (@ARGV != 6) { &usage (); } + +# assign the command line arguments +$imlist = $ARGV[0]; +$modefits = $ARGV[1]; +$modelist = $ARGV[2]; +$modejpg = $ARGV[3]; # root of jpg images +$residjpg = $ARGV[4]; # root of jpg images +$inmapjpg = $ARGV[5]; # root of jpg images + +# find the appropriate script file +$confdir = `gconfig -q CONFDIR`; chop ($confdir); +$script = "$confdir/mana/modes.pro"; + +# test named Xserver, or start vnc on specified machine +$xhost=`gconfig -q XHOST`; chop ($xhost); +$xdisp=`gconfig -q XDISP`; chop ($xdisp); +if (vsystem ("xdpyinfo -display $xdisp >& /dev/null")) { + print STDERR "X server is not running. start it now on $xhost\n"; + exit 1; +} +$ENV{'DISPLAY'} = $xdisp; + +# load in list of input image lists +open (LIST, $imlist); +@imlist = ; +close (LIST); + +# load in list of input image lists +open (LIST, $modelist); +@modelist = ; +close (LIST); +$Nmode = 0; +foreach $line (@modelist) { + ($mode, $status) = split (" ", $line); + if ($status) { $Nmode ++; } +} + +# run mana script: +open (MANA, "|mana --norc"); +print MANA "input $script\n"; +print MANA "macro go\n"; + +# we'll use the default 8 to generate the jpgs of the modes +print MANA "jpgmodes $modefits $modejpg\n"; + +system ("rm -f $residjpg"); +system ("rm -f $inmapjpg"); + +# reset $Nmode for the actual number desired +print MANA "\$Nmode = $Nmode\n"; +print MANA "getmodes\n"; +for ($i = 0; $i < @imlist; $i++) { + ($name, $status) = split (" ", $imlist[$i]); + $jpgname = sprintf "%s.%03d.jpg", $residjpg, $i; + system ("basename $jpgname >> $residjpg"); + $srcname = sprintf "%s.%03d.jpg", $inmapjpg, $i; + system ("basename $srcname >> $inmapjpg"); + print MANA "jpgresid $name $jpgname $srcname\n"; +} +print MANA "exit 0\n"; + +print MANA "end\n"; +print MANA "go\n"; +print MANA "exit 1\n"; +close (MANA); +if ($?) { + print STDERR "ERROR problem with fr.modestats\n"; + exit 1; +} + +print STDOUT "SUCCESS: finished with fr.modestats\n"; +exit 0; + +sub vsystem { + print STDERR "@_\n"; + $status = system ("@_"); + $status; +} + +sub goodbye { + die "@_\n"; +} + +sub usage { + print "USAGE: fr.modestats (map.list) (mode.fits) (mode.list) (modes[.NNN.jpg]) (resid[.NNN.jpg]) (source[.NNN.jpg])\n"; + exit 1; +} + +# mana within perl: we embed the mana functions within a macro to trap the +# exit status. If mana has an error with one of the steps, it will exit the macros and +# the second exit will be called. Otherwise, the "go" macro will perform the exit 0 +# and mana will exit with status 0 Index: /tags/ohana/perl-1-3/Ohana/src/perl/src/fr.select =================================================================== --- /tags/ohana/perl-1-3/Ohana/src/perl/src/fr.select (revision 21906) +++ /tags/ohana/perl-1-3/Ohana/src/perl/src/fr.select (revision 21906) @@ -0,0 +1,325 @@ +#!/usr/bin/env perl + +# check the usage +if ($ARGV[0] eq "-h") { usage (); } +if ($ARGV[0] eq "-help") { usage (); } +if (@ARGV != 5) { die "ERROR: USAGE: fr.select (filter) (start) (stop) (mode) (output)\n"; } + +# assign the command line arguments +$filter = $ARGV[0]; +$start = $ARGV[1]; +$stop = $ARGV[2]; +$mode = "\U$ARGV[3]\E"; +if (($mode ne "MEF") && ($mode ne "SPLIT")) { die "ERROR: mode must be either SPLIT or MEF\n";} +$output = $ARGV[4]; + +# global constants +# these probably should go in the config files eventually. +$MAX_CNTS = 60000; +$MAX_FLUX = 40; + +# define some of the relevant parameters +$tmp = `filtnames $filter`; chop $tmp; +if ($?) { die "ERROR: invalid filter $filter\n"; } +$filter = $tmp; + +# recipe file defines detrend types & cutoff exptime values +$recipefile = `gconfig DETREND_RECIPES`; chop $recipefile; +if ($?) { die "ERROR: missing DETREND_RECIPES in configuration\n"; } + +# extract filter extras list +($tmp, $tmp, $tmp, $extras) = split (" ", `gconfig -c $recipefile $filter`); +if ($?) { die "ERROR: missing detrend recipe for $filter\n"; } + +# grab extra values: +($detype, $MIN_FLUX, $MIN_CNTS) = split (",", $extras); +if ("\U$detype\E" ne "FRINGE") { die "ERROR: fringe extras are missing\n"; } + +# relevant camera parameters +$Nccd = `cameraconfig -Nccd`; chop ($Nccd); +if ($?) { die "error in config\n"; } + +($Naxis1, $Naxis2) = split (" ", `cameraconfig -axes`); +if ($?) { die "error in config\n"; } + +@ccds = split (" ", `cameraconfig -ccds`); +if ($?) { die "error in config\n"; } + +@good = (); +@marginal = (); + +# special list to skip specific chips +$CHIPSKIP = `gconfig CHIP_SKIP_LIST`; chop $CHIPSKIP; +@chipskip = (); +if (-e $CHIPSKIP) { + open (FILE, $CHIPSKIP); + @chipskip = ; + close (FILE); + foreach $chip (@chipskip) { chop $chip; } +} + +$criteria = "-type object -mode $mode -trange $start $stop -filter $filter"; + +# define filter lines. +@filtline = (); +# convert given filter name to list of possible names: +$answer = `filtnames $ARGV[0] -all`; +@filtlist = split (" ", $answer); + +foreach $name (@filtlist) { + $line = "-type object -mode $mode -trange $start $stop -filter $name"; + push @filtline, $line; +} + +# run selection on each possible $filtline +@list = (); +foreach $line (@filtline) { + @tlist = `imsearch -ccd $ccds[0] $line`; + @list = (@list, @tlist); +} +$Nlist = @list; +print STDERR "found $Nlist images\n"; + +FRAME: + foreach $image (@list) { + @words = split (" ",$image); + + # poor way to search for all images + if ($mode eq "SPLIT") { + # all $Nccd images must exist on disk, split files are assumed to be + # in a subdirectory of their own, .fits extension assumed + @answer = <$words[4]/*.fits>; + if (@answer != $Nccd) { print STDERR "$words[5] rejected: missing images\n"; next FRAME; } + } + + # images have to have the correct dimensions + if ($mode eq "SPLIT") { + $answer = `echo $words[4]/$words[5] | fields NAXIS1 NAXIS2`; + } else { + $answer = `echo $words[4]/$words[5] | fields -x 0 NAXIS1 NAXIS2`; + } + ($tmp, $Nx, $Ny) = split (" ", $answer); + if (($Nx != $Naxis1) || ($Ny != $Naxis2)) { print STDERR "$words[5] rejected: wrong dimensions\n"; next FRAME; } + + # $match is a word unique to the full mosaic image (the rootdir for split, the image for mef) + if ($mode eq "split") { + @answer = split ("/", $words[4]); + $match = $answer[-1]; + } else { + $match = $words[5]; + } + @list2 = `imsearch -name $match`; + + CCD: + foreach $ccd (@list2) { + @words2 = split (" ", $ccd); + foreach $chipskip (@chipskip) { + if ($words2[3] eq $chipskip) { next CCD; } + } + + $cnts = $words2[11]; + $flux = $words2[11] / $words2[7]; + # test for acceptable flux range + if ($cnts < $MIN_CNTS) { print STDERR "$words[5] rejected: cnts too low: $cnts vs $MIN_CNTS\n"; next FRAME; } + if ($cnts > $MAX_CNTS) { print STDERR "$words[5] rejected: cnts too high: $cnts vs $MAX_CNTS\n"; next FRAME; } + if ($flux < $MIN_FLUX) { print STDERR "$words[5] rejected: flux too low: $flux vs $MIN_FLUX\n"; next FRAME; } + if ($flux > $MAX_FLUX) { print STDERR "$words[5] rejected: flux too high: $flux vs $MAX_FLUX\n"; next FRAME; } + } + + $fullname = "$words[4]/$words[5]"; + $root = gt_names ($fullname, "root", $mode); + $path = gt_names ($fullname, "path", $mode); + @good = (@good, "$path $root $mode"); +} + +open (LIST, ">$output"); +# write output to Nccd list files +# keep a random sample of roughly 60 images: +$Nselect = @good; +for ($i = 0; $i < $Nselect; $i++) { + if (rand ($Nselect) < 60) { + print LIST "$good[$i]\n"; + } +} +close (LIST); +print STDERR "SUCCESS\n\n"; +exit 0; + +# cfht MEF/SPLIT name utilities: + +sub gt_names { + # in: filename mode type + # out: word + + my ($value); + + $value = ""; + if ($_[2] eq "MEF") { $value = mefnames ($_[0], $_[1]); } + if ($_[2] eq "SPLIT") { $value = splitnames ($_[0], $_[1]); } + + return $value; +} + +sub mefnames { + # in: (/path/file.fits) (mode) + # out: word + + my($fullname) = $_[0]; + my($mode) = $_[1]; + my($answer); + + # split rootdir and filename: + my (@words) = split ("/", $fullname); + $N = @words; + + if ($mode eq "path") { + $answer = ""; + for ($i = 0; $i < $N - 1; $i++) { + $answer = $answer . $words[$i] . "/"; + } + chop ($answer); # strip off last / + if ($answer eq "") { $answer = "."; } + return ($answer); + } + + if ($mode eq "root") { + $answer = "$words[$N-1]"; + $answer =~ s/.fits$//; + return ($answer); + } + + if ($mode eq "Nccd") { + if (! -e $fullname) { + return (0); + } + $answer = `echo $fullname | fields NEXTEND`; + @words = split (" ", $answer); + if ($words[1] eq "") { + return (0); + } + return ($words[1]); + } + + return (0); +} + +sub splitnames { + # in: (/path/file) (mode) + # out: word + # /path/file is directory containing Nccd fits images + + my($fullname) = $_[0]; + my($mode) = $_[1]; + my($answer, $N, $tmpname, @imlist, @words); + + # split rootdir and filename: + @words = split ("/", $fullname); + $N = @words; + + if ($mode eq "path") { + $answer = ""; + for ($i = 0; $i < $N - 2; $i++) { + $answer = $answer . $words[$i] . "/"; + } + chop ($answer); # strip off last / + if ($answer eq "") { $answer = "."; } + return ($answer); + } + + if ($mode eq "root") { + $answer = "$words[$N-2]"; + return ($answer); + } + + if ($mode eq "Nccd") { + + $tmpname = "$fullname/$words[$N-1]"; + @imlist = <$tmpname??.fits>; + + $Nccd = @imlist; + return $Nccd; + } + + return (0); +} + +sub ckimtype { + # in: (/path/file) + # out: MEF | SPLIT | SINGLE | (NULL) + + my ($answer, $name, $value); + my ($file) = $_[0]; + + if (! -e $file) { + print STDOUT "can't open file\n"; + return ""; + } + + # if /path/file is a directory, it is split: + if (-d $file) { return "SPLIT"; } + + # check that the file is a FITS image + $answer = `file -L $file`; + if ($?) { + print STDOUT "can't open file\n"; + return ""; + } + ($name, $value) = split (" ", $answer); + if ($value ne "FITS") { + print STDOUT "not a valid image\n"; + return ""; + } + + # check for NAXIS = 0 (MEF) + $answer = `echo $file | fields NAXIS`; + # if ($?) { return ""; } + ($name, $value) = split (" ", $answer); + if ($value eq 0) { return "MEF"; } + + if ($value == 2) { return "SINGLE"; } + + print STDOUT "not a valid image\n"; + return ""; +} + +sub vsystem { + print STDERR "@_\n"; + $status = system ("@_"); + $status; +} + +sub goodbye { + print STDERR "ending execution\n"; + die "@_"; +} + +sub usage { + print "USAGE: fr.select (filter) (start) (stop) (mode) (output)\n"; + print " filter: R I Z (etc)\n"; + print " start: start date (yyyy/mm/dd,hh:mm:ss)\n"; + print " stop: stop date\n"; + print " mode: MEF or SPLIT\n"; + print " output: output file name\n"; + exit 1; +} + +# we need to select the list of images which satisfy a few criteria: +# 1) all 12 CCDs must exist +# 2) stats must be measured for each +# 3) stats for all 12 must be within range (2000 - 40000) +# 4) NAXIS1 == 2080 && NAXIS2 == 4128 + +# fr.select: +# this program takes a list of criteria which define a fringe / +# skyring frame, and an output filename, and fills the file with all +# images that fit the given criteria. It checks to make sure that the +# images have flux and counts in the appropriate range, and that all +# CCDs are available, and that they have the correct dimensions. + +# the output file consists of lines with the following entries: +# (path) (root) (mode) +# path: complete path to the image +# root: base name for file - MEF: root.fits, SPLIT: root/rootNN.fits +# mode: MEF / SPLIT + + Index: /tags/ohana/perl-1-3/Ohana/src/perl/src/fr.smooth =================================================================== --- /tags/ohana/perl-1-3/Ohana/src/perl/src/fr.smooth (revision 21906) +++ /tags/ohana/perl-1-3/Ohana/src/perl/src/fr.smooth (revision 21906) @@ -0,0 +1,196 @@ +#!/usr/bin/env perl + +# this program converts the binned fringe image to an unbinned image, +# adds necessary header information. it could be used to smooth the +# image based on the filter and chip, if needed + +$version = 2.0; + +if (@ARGV != 8) { &escape ("ERROR: USAGE: fr.smooth (infile) (filter) (CCD) (unbin) (start) (stop) (frstats) (outfile)"); } + +$infile = $ARGV[0]; # input image file +$filter = $ARGV[1]; # filter for image +$ccd = $ARGV[2]; # ccd number +$binning = $ARGV[3]; # binning of input image +$start = $ARGV[4]; # valid time range start +$stop = $ARGV[5]; # valid time range stop +$frstats = $ARGV[6]; # fringe statistics file +$outfile = $ARGV[7]; # output image file + +@ccds = split (" ", `cameraconfig -ccds`); +@ccdn = split (" ", `cameraconfig -ccdn`); +$Nccd = @ccds; + +$CCDKEYWORD = `gconfig CCDNUM-KEYWORD`; chop $CCDKEYWORD; +$dbmode = `gconfig DETREND-DB-MODE`; chop $dbmode; + +@frstats = `cat $frstats`; +for ($i = 0; $i < @frstats; $i++) { + if ($frstats[$i] =~ m|^\s*\#|) { + ($tmp, $entry, $value) = split (" ", $frstats[$i]); + if ($entry eq "REF_CHIP") { $RefChip = $ccds[$value]; } + splice @frstats, $i, 1; $i--; + } +} +($C0, $C1, $Fs, $Fr) = split (" ", $frstats[$ccd]); + +# find fringe-point file +$frpts = `detsearch -quiet -image $infile $ccds[$ccd] split -type frpts`; chop $frpts; +if ($?) { &escape ("can't get fringe points for image"); } +($name, $Fs, $Fr) = split (" ", `getfringe $infile $ccds[$ccd] $frpts $binning`); + +$mask = `detsearch -ccd $ccds[$ccd] -type mask -time $start -select -quiet`; chop $mask; +if ($?) { &escape ("ERROR: can't find mask for image $1"); } + +# unbin and insert header keywords +open (MANA, "|mana --norc"); + +# convert BIASSEC string to x1, x2, y1, y2 vars +print MANA "macro parsesec\n"; +print MANA " \$f = \$1\n"; +print MANA " getchr \$f : n\n"; +print MANA " substr \$f 1 {\$n-1} x1\n"; +print MANA " strlen \$f N\n"; +print MANA " substr \$f \$n {\$N-\$n} f\n"; + +print MANA " getchr \$f , n\n"; +print MANA " substr \$f 1 {\$n-1} x2\n"; +print MANA " strlen \$f N\n"; +print MANA " substr \$f \$n {\$N-\$n} f\n"; + +print MANA " getchr \$f : n\n"; +print MANA " substr \$f 1 {\$n-1} y1\n"; +print MANA " strlen \$f N\n"; +print MANA " substr \$f \$n {\$N-\$n} f\n"; + +print MANA " getchr \$f ] n\n"; +print MANA " substr \$f 1 {\$n-1} y2\n"; +print MANA " strlen \$f N\n"; +print MANA " substr \$f \$n {\$N-\$n} f\n"; +print MANA "end\n"; + +print MANA "list kernel\n"; +print MANA " 0.025\n"; +print MANA " 0.100\n"; +print MANA " 0.025\n"; +print MANA " 0.100\n"; +print MANA " 0.500\n"; +print MANA " 0.100\n"; +print MANA " 0.025\n"; +print MANA " 0.100\n"; +print MANA " 0.025\n"; +print MANA "end\n"; +print MANA "macro go\n"; +print MANA " \$CCDKEYWORD = $CCDKEYWORD\n"; +# read in mask, rebin +if ($dbmode eq "MEF") { + print MANA " rd mask $mask -n $ccds[$ccd]\n"; +} else { + print MANA " rd mask $mask\n"; +} +print MANA " keyword mask NAXIS1 nx2\n"; +print MANA " keyword mask NAXIS2 ny2\n"; +print MANA " rebin mask binmask $binning -norm\n"; +print MANA " clip binmask 0.9 0.0 1.1 0.0\n"; + +print MANA " rd a $infile\n"; +print MANA " set a = a * binmask\n"; +# print MANA " set a = a * binmask + $Fs*not(binmask)\n"; +print MANA " rebin a A -$binning\n"; +print MANA " keyword A NAXIS1 nx1\n"; +print MANA " keyword A NAXIS2 ny1\n"; +print MANA " delete a\n"; + +print MANA " extract A b 0 0 \$nx1 \$ny1 0 0 \$nx2 \$ny2\n"; +print MANA " keyword b DATASEC line\n"; +print MANA " parsesec \$line\n"; +print MANA " sprint newline \"[%d:%d,%d:%d]\" {\$x1*2} {\$x2*2} {\$y1*2} {\$y2*2}\n"; +print MANA " keyword b DATASEC -w \$newline\n"; + +@time = localtime; +$now = sprintf "%04d-%02d-%02dT%02d:%02d:%02d", $time[5]+1900, $time[4]+1, $time[3], $time[2], $time[1], $time[0]; +$elsys = `gconfig ELIXIR_VERSION`; chop ($elsys); + +@word = split ("/", $frpts); +$frpts = $word[-1]; + +# add keywords for fringe amplitude, fit, etc +print MANA " keyword b FRNG_C0 -wf $C0\n"; +print MANA " keyword b FRNG_C1 -wf $C1\n"; +print MANA " keyword b FRNG_SKY -wf $Fs\n"; +print MANA " keyword b FRNG_RNG -wf $Fr\n"; +print MANA " keyword b FRNG_REF -w $RefChip\n"; +print MANA " keyword b FRNG_PTS -w \"$frpts\"\n"; +print MANA " keyword b TVSTART -w $start\n"; +print MANA " keyword b TVSTOP -w $stop\n"; +print MANA " keyword b EL_SYS -w \"$elsys\"\n"; +print MANA " keyword b EL_SMTH -w \"$version\"\n"; +print MANA " keyword b REL_DATE -w \"$now\"\n"; + +# add comments for the new keywords +print MANA " keyword b FRNG_C0 -wc \"Fringe Cross Correlation linear fit term\"\n"; +print MANA " keyword b FRNG_C1 -wc \"Fringe Cross Correlation linear fit term\"\n"; +print MANA " keyword b FRNG_SKY -wc \"Fringe Frame sky level\" \n"; +print MANA " keyword b FRNG_RNG -wc \"Fringe Frame fringe strength\"\n"; +print MANA " keyword b FRNG_REF -wc \"Fringe Cross Correlation reference chip\"\n"; +print MANA " keyword b FRNG_PTS -wc \"Fringe Point File\"\n"; +print MANA " keyword b TVSTART -wc \"data validity start time\"\n"; +print MANA " keyword b TVSTOP -wc \"data validity stop time\"\n"; +print MANA " keyword b OBSTYPE -w \"FRINGE\"\n"; +print MANA " keyword b EXPTYPE -w \"FRINGE\"\n"; +print MANA " keyword b EL_SYS -wc \"Elixir System Version\"\n"; +print MANA " keyword b EL_SMTH -wc \"Elixir Smooth Version\"\n"; +print MANA " keyword b REL_DATE -wc \"UTC Release Date\"\n"; + +print MANA " keyword b COMMENT -ws \"Fringe (NN) = C0 + C1 * Fringe (REF)\"\n"; +print MANA " keyword b COMMENT -ws \"Elixir:fr.smooth version $version\"\n"; +print MANA " keyword b COMMENT -ws \"Elixir Fringe Frame\"\n"; +print MANA " keyword b COMMENT -ws \"Elixir smoothing: 3x3 kernel (1): 0.025, 0.100, 0.025\"\n"; +print MANA " keyword b COMMENT -ws \"Elixir smoothing: 3x3 kernel (2): 0.100, 0.500, 0.100\"\n"; +print MANA " keyword b COMMENT -ws \"Elixir smoothing: 3x3 kernel (3): 0.025, 0.100, 0.025\"\n"; + +print MANA " stat b - - - -\n"; +print MANA " \$range = \$MAX - \$MIN + 4\n"; +print MANA " if (\$range < 100)\n"; +print MANA " \$range = 100\n"; +print MANA " end\n"; +print MANA " sprintf bscale %9.4f {\$range / 2^16}\n"; +print MANA " \$bzero = \$bscale * int ((\$MIN + \$range / 2) / \$bscale)\n"; + +print MANA " wd b $outfile -bzero \$bzero -bscale \$bscale \n"; +print MANA " exit 0\n"; + +print MANA "end\n"; +print MANA "macro list go\n"; +print MANA "go\n"; +print MANA "exit 1\n"; +close (MANA); +if ($?) { &escape ("ERROR: failure running mana"); } + +print STDERR "SUCCESS\n"; +exit 0; + +#################################################### + +@temp = (); +sub mktemp { + + my ($base) = $_[0]; + my ($name); + $name = `mktemp /tmp/$base.XXXXXX`; + chop $name; + + push @temp, $name; + return $name; +} + +sub escape { + $message = $_[0]; + foreach $name (@temp) { + unlink ($name); + } + die "$message\n"; +} + +#print MANA " kern a kernel \n"; +#print MANA " set b = a*mask + $Fs*not(mask)\n"; Index: /tags/ohana/perl-1-3/Ohana/src/perl/src/gastro.raw =================================================================== --- /tags/ohana/perl-1-3/Ohana/src/perl/src/gastro.raw (revision 21906) +++ /tags/ohana/perl-1-3/Ohana/src/perl/src/gastro.raw (revision 21906) @@ -0,0 +1,79 @@ +#!/usr/bin/env perl + +$config = ""; +@tARGV = (); +for (; @ARGV > 0; ) { + if ($ARGV[0] eq "-C") { + $config = "-C $ARGV[1]"; + shift; shift; next; + } + if ($ARGV[0] eq "-c") { + $config = "-c $ARGV[1]"; + shift; shift; next; + } + if ($ARGV[0] eq "-D") { + $config = "-D $ARGV[1] $ARGV[2]"; + shift; shift; shift; next; + } + @tARGV = (@tARGV, $ARGV[0]); + shift; +} +@ARGV = @tARGV; + +if (@ARGV != 1) { die "USAGE: gastro.raw (filename)\n"; } + +if (! -e $ARGV[0]) { die "ERROR: file $ARGV[0] missing\n"; } + +($tmp, $RA, $DEC, $EXT) = split (" ", `echo $ARGV[0] | fields RA DEC EXTNAME`); + +if ($RA eq "") { die "ERROR: missing RA in header\n"; } +if ($DEC eq "") { die "ERROR: missing DEC in header\n"; } +if ($EXT eq "") { die "ERROR: missing EXTNAME in header\n"; } + +while ($RA =~ s|\:| |) { } +while ($DEC =~ s|\:| |) { } + +($ra, $dec) = split (" ", `echo $RA $DEC | radec -hms`); + +@ccdx = split (" ", `cameraconfig $config -xoff`); +@ccdy = split (" ", `cameraconfig $config -yoff`); +@dx = split (" ", `cameraconfig $config -xflip`); +@dy = split (" ", `cameraconfig $config -yflip`); + +$DX = `cameraconfig $config -axis0`; chop $DX; +$DY = `cameraconfig $config -axis1`; chop $DY; +$NX = `cameraconfig $config -mosaicx`; chop $NX; +$NY = `cameraconfig $config -mosaicy`; chop $NY; + +$N = `cameraconfig $config -N $EXT`; chop $N; + +$Ro = $ra - ($ccdx[$N] - $NX/2)*$DX*0.187/3600; +$Do = $dec + ($ccdy[$N] - $NY/2)*$DY*0.187/3600; +$Theta = 4; +$P1 = -1; +$P2 = 1; +if ($dx[$N] == 1) { + $P1 = 1; + $Theta = $Theta * -1; +} +if ($dy[$N] == 1) { + $P2 = -1; + $Theta = $Theta * -1; +} + +vsystem ("gastro -v $config $ARGV[0] -coords $Ro $Do -D CCD_PC1_1 $P1 -D CCD_PC2_2 $P2 -D ROT_ZERO $Theta"); +exit 0; + +############ + +sub vsystem { + print STDERR "@_\n"; + $status = system ("@_"); + $status; +} + +sub goodbye { + print STDERR "ending execution\n"; + die "@_"; +} + Index: /tags/ohana/perl-1-3/Ohana/src/perl/src/getfringe =================================================================== --- /tags/ohana/perl-1-3/Ohana/src/perl/src/getfringe (revision 21906) +++ /tags/ohana/perl-1-3/Ohana/src/perl/src/getfringe (revision 21906) @@ -0,0 +1,118 @@ +#!/usr/bin/env perl + +if (@ARGV != 4) { &escape ("USAGE: getfringe (input) (ccd) (frpts) (bin)"); } + +# assign the command line arguments +$input = $ARGV[0]; +$ccd = $ARGV[1]; +$frpts = $ARGV[2]; +$binning = $ARGV[3]; + +# temporary files for flips input/output +$temp1 = mktemp ("\@getfringe"); +$temp2 = mktemp ("getfringe"); +$temp3 = mktemp ("getfringe"); + +# create input list file +@coords = `gtfringetable $frpts $ccd $binning`; +if ($?) { &escape ("failure to extract fringe point table"); } +open (FILE, ">$temp1"); +foreach $line (@coords) { + chop ($line); + print FILE "$input $line\n"; +} +close (FILE); + +# box size for stats: +$dx = 1 + 2*int(0.5*25/$binning); + +# find input parameter file +$paramfile = `gconfig FLIPS_PARAM_IMSTAT`; chop $paramfile; +if ($?) { &escape ("paramfile FLIPS_PARAM_IMSTAT not in config system"); } + +# fill in missing keywords +open (FILE, "$paramfile"); +@params = ; +close (FILE); + +foreach $line (@params) { + chop ($line); + $line =~ s|INFILE|$temp1|; + $line =~ s|SIZEX|$dx|; + $line =~ s|SIZEY|$dx|; + $line =~ s|OUTFILE|$temp3|; +} + +# save new parameter file +open (FILE, ">$temp2"); +foreach $line (@params) { + print FILE "$line\n"; +} +close $temp2; + +# run imstat (change to flips2 version) +system ("imstat $temp2 > /dev/null"); +if ($?) { &escape ("failure in imstat"); } + +# accumulate sky, fringe +open (FILE, "$temp3"); +@stats = ; +@sky = (); +@fringe = (); +for ($i = 0; $i < @stats; $i++) { + ($name, $max) = split (" ", $stats[$i]); + $i ++; + ($name, $min) = split (" ", $stats[$i]); + + $fringe = $max - $min; + push @sky, $min; + push @fringe, $fringe; +} + +# calculate fringe sigma: +$F1 = $F2 = 0; +foreach $fringe (@fringe) { + $F1 += $fringe; + $F2 += $fringe*$fringe; +} +$N = @fringe; +$F1 = $F1 / $N; +$dfringe = sqrt ($F2/$N - $F1*$F1); + +# calculate fringe & sky medians +@fringe = sort {$a <=> $b} @fringe; +$fringe = $fringe[int(0.5*$N)]; +@sky = sort @sky; +$sky = $sky[int(0.5*$N)]; + +# write out results +print STDOUT "$input $sky $fringe $dfringe\n"; + +&goodbye; + +######## + +@temp = (); +sub mktemp { + + my ($base) = $_[0]; + my ($name); + $name = `mktemp /tmp/$base.XXXXXX`; + chop $name; + + push @temp, $name; + return $name; +} + +sub escape { + $message = $_[0]; + foreach $name (@temp) { + unlink ($name); + } + die "$message\n"; +} + +sub goodbye { + foreach $name (@temp) { unlink ($name); } + exit 0; +} Index: /tags/ohana/perl-1-3/Ohana/src/perl/src/grab.keywords =================================================================== --- /tags/ohana/perl-1-3/Ohana/src/perl/src/grab.keywords (revision 21906) +++ /tags/ohana/perl-1-3/Ohana/src/perl/src/grab.keywords (revision 21906) @@ -0,0 +1,243 @@ +#!/usr/bin/env perl + +$version = 2.0; + +if (@ARGV != 3) { die "USAGE: grab.keywords (infile) (cmproot) (outfile)\n" ; } + +$infile = $ARGV[0]; +$cmproot = $ARGV[1]; +$outfile = $ARGV[2]; + +# $infile is the image.fits file +# $cmproot is the rootname of the processed output for this file (contains astrom keywords) +# $outfile is the output header data file + +if ($cmproot eq "phu") { goto photometry; } + +# grab astrometry keywords from $cmpfile: +@header = (); + + CMPTEST: { + # make this look for hdx files in hdxdir (fix dads.keywords as well) + # need to extract all header files first + + # try *.smp: + $cmpfile = "$cmproot.smp"; + if (-e $cmpfile) { + $answer = `echo $cmpfile | fields NASTRO`; + @words = split (" ", $answer); + if ($words[1] > 0) { last CMPTEST; } + } + + # try *.cmp: + $cmpfile = "$cmproot.cmp"; + if (-e $cmpfile) { + $answer = `echo $cmpfile | fields NASTRO`; + @words = split (" ", $answer); + if ($words[1] > 0) { last CMPTEST; } + } + + $cmpfile = ""; + } + +if ($cmpfile) { @header = `fhead $cmpfile`; } + +# set some default values: +@astrom = (); +$fsatur = 0; +$flimit = 0; +$exptime = 0; +$Nastro = 0; + +# search for the appropriate lines: +foreach $line (@header) { + + # astrometry keywords which are copied directly + if ($line =~ /CTYPE1 =/) { @astrom = (@astrom, $line);} + if ($line =~ /CTYPE2 =/) { @astrom = (@astrom, $line);} + if ($line =~ /CRPIX1 =/) { @astrom = (@astrom, $line);} + if ($line =~ /CRPIX2 =/) { @astrom = (@astrom, $line);} + if ($line =~ /CRVAL1 =/) { @astrom = (@astrom, $line);} + if ($line =~ /CRVAL2 =/) { @astrom = (@astrom, $line);} + if ($line =~ /NASTRO =/) { @astrom = (@astrom, $line); $Nastro = substr ($line, 10, 21); } + if ($line =~ /CERROR =/) { @astrom = (@astrom, $line);} + if ($line =~ /EQUINOX =/) { @astrom = (@astrom, $line);} + + # convert the PC00i00j matrix & CDELTi to CDi_j + if ($line =~ /PC001001=/) { $pc11 = substr ($line, 10, 21); } + if ($line =~ /PC001002=/) { $pc12 = substr ($line, 10, 21); } + if ($line =~ /PC002001=/) { $pc21 = substr ($line, 10, 21); } + if ($line =~ /PC002002=/) { $pc22 = substr ($line, 10, 21); } + if ($line =~ /CDELT1 =/) { $cd1 = substr ($line, 10, 21); } + if ($line =~ /CDELT2 =/) { $cd2 = substr ($line, 10, 21); } + + # save these values for the photometry section + if ($line =~ /FSATUR =/) { $fsatur = substr ($line, 10, 21); } + if ($line =~ /FLIMIT =/) { $flimit = substr ($line, 10, 21); } + if ($line =~ /EXPTIME =/) { $exptime = substr ($line, 10, 21); } + + # we will not use the FWHM values until those are better defined... + if (0) { + if ($line =~ /FWHM_X =/) { + $tmp = substr ($line, 10, 21); + $tmp = $tmp * 0.2; + $line = sprintf "FWHM_A = %20G / stellar profile major axis (arcsec) \n", $tmp; + @astrom = (@astrom, $line); + } + if ($line =~ /FWHM_Y =/) { + $tmp = substr ($line, 10, 21); + $tmp = $tmp * 0.2; + $line = sprintf "FWHM_B = %20G / stellar profile minor axis (arcsec) \n", $tmp; + @astrom = (@astrom, $line); + } + if ($line =~ /ANGLE =/) { @astrom = (@astrom, $line);} + } +} + +# check for validity of astrometry data +if ($Nastro == 0) { + print STDERR "can't find all astrometry keywords from $cmproot\n"; + $line = sprintf "COMMENT Elixir: no astrometry solution for this image\n"; + @astrom = ($line); +} else { + # convert the pc, cdelt terms to cd terms + $cd11 = $cd1*$pc11; + $cd12 = $cd2*$pc12; + $cd21 = $cd1*$pc21; + $cd22 = $cd2*$pc22; + $line = sprintf "CD1_1 = %20.5E / WCS Coordinate scale matrix \n", $cd11; @astrom = (@astrom, $line); + $line = sprintf "CD1_2 = %20.5E / WCS Coordinate scale matrix \n", $cd12; @astrom = (@astrom, $line); + $line = sprintf "CD2_1 = %20.5E / WCS Coordinate scale matrix \n", $cd21; @astrom = (@astrom, $line); + $line = sprintf "CD2_2 = %20.5E / WCS Coordinate scale matrix \n", $cd22; @astrom = (@astrom, $line); +} + +# define a reference chip to grab the photometry data + photometry: + if ($cmproot eq "phu") { + $ccd = "phu"; + } else { + $ccd = `cameraconfig -ID 0`; chop $ccd; + if ($?) { die ("error in camera config\n"); } + } + +# grab the appropriate photometry data +@photom = (); +@photlist = `photsearch -trans -image $infile $ccd split -equiv`; +if ($?) { @photlist = (); } + +# check validity of photometry data +$Nphot = @photlist; +if ($Nphot == 0) { + print STDERR "can't get photometry data for this image\n"; + $line = sprintf "COMMENT Elixir: No photometry calibrations for this night & filter\n"; + @photom = ($line); +} else { + # parse the photometry data line + @words = split (" ", $photlist[$Nphot-1]); +# we conclude that the nightly zero point contains insufficient information + $line = sprintf "PHOT_C = %20.4F / Elixir zero point - measured for camera run \n", $words[2]; @photom = (@photom, $line); + $line = sprintf "PHOT_CS = %20.4F / Elixir zero point - scatter \n", $words[4]; @photom = (@photom, $line); + $line = sprintf "PHOT_NS = %20d / Elixir zero point - N stars \n", $words[5]; @photom = (@photom, $line); + $line = sprintf "PHOT_NM = %20d / Elixir zero point - N images \n", $words[6]; @photom = (@photom, $line); + $line = sprintf "PHOT_C0 = %20.4F / Elixir zero point - nominal \n", $words[3]; @photom = (@photom, $line); + $line = sprintf "PHOT_X = %20.4F / Elixir zero point - color term \n", $words[7]; @photom = (@photom, $line); + $line = sprintf "PHOT_K = %20.4F / Elixir zero point - airmass term \n", $words[8]; @photom = (@photom, $line); + $line = sprintf "PHOT_C1 = '%-18s' / Elixir zero point - color 1 \n", $words[10]; @photom = (@photom, $line); + $line = sprintf "PHOT_C2 = '%-18s' / Elixir zero point - color 2 \n", $words[11]; @photom = (@photom, $line); + + if ($cmproot ne "phu") { + # is there was no cmpfile, we should not set the SAT and LIM values. + if ($exptime == 0) { + $line = sprintf "COMMENT Photometric Analysis is incomplete for this image.\n"; + @photom = (@photom, $line); + $line = sprintf "COMMENT MAG_SAT and MAG_LIM cannot be determined.\n"; + @photom = (@photom, $line); + } else { + # adjust fsatur & flimit values by phot data + $fsatur = $fsatur - 25.0 + $words[2] + 2.5*log($exptime) / log(10.0); + $line = sprintf "MAG_SAT = %20G / approx saturation (mag) \n", $fsatur; + @photom = (@photom, $line); + + $flimit = $flimit - 25.0 + $words[2] + 2.5*log($exptime) / log(10.0); + $line = sprintf "MAG_LIM = %20G / approx completeness limit (mag) \n", $flimit; + @photom = (@photom, $line); + } + } + + # add some comments + $line = sprintf "COMMENT Formula for Photometry, based on keywords given in this header: \n"; @photom = (@photom, $line); + $line = sprintf "COMMENT m = -2.5*log(DN) + 2.5*log(EXPTIME) \n"; @photom = (@photom, $line); + $line = sprintf "COMMENT M = m + PHOT_C + PHOT_K*(AIRMASS - 1) + PHOT_X*(PHOT_C1 - PHOT_C2) \n"; @photom = (@photom, $line); +} + +# add generic Elixir comments: + +@time = localtime; +$now = sprintf "%04d-%02d-%02dT%02d:%02d:%02d", $time[5]+1900, $time[4]+1, $time[3], $time[2], $time[1], $time[0]; +$elsys = `gconfig ELIXIR_VERSION`; chop ($elsys); +# $frpts = `detsearch -quiet -image $infile $ccds[$ccd] split -type frpts`; chop $frpts; + +@comment = (); +$line = sprintf "COMMENT --------------- Elixir Analysis --------------- \n"; @comment = (@comment, $line); +$line = sprintf "COMMENT Elixir: processing performed \@ CFHT, version $elsys \n"; @comment = (@comment, $line); +$line = sprintf "COMMENT Elixir: version: $elsys \n"; @comment = (@comment, $line); +$line = sprintf "COMMENT Elixir: processing date: $now \n"; @comment = (@comment, $line); +$line = sprintf "COMMENT Elixir: website: http://www.cfht.hawaii.edu/Instruments/Elixir \n"; @comment = (@comment, $line); +$line = sprintf "COMMENT Elixir: email: elixir\@cfht.hawaii.edu \n"; @comment = (@comment, $line); +$line = sprintf "COMMENT Elixir: team: Eugene Magnier & Jean-Charles Cuillandre \n"; @comment = (@comment, $line); +$line = sprintf "DATEPROC= '$now' / Processing Date \n"; @comment = (@comment, $line); +$line = sprintf "EL_SYS = '%-18s' / Elixir System Version \n", "$elsys"; @comment = (@comment, $line); +# (line < 80) 12345678901234567890123456789012345678901234567890123456789012345678901234567890 + +@output = (@comment, @astrom, @photom); +$line = sprintf "COMMENT --------------- Elixir Analysis (end) --------------- \n"; @output = (@output, $line); + +# write output to file +open (FILE, ">$outfile"); +foreach $line (@output) { + print FILE "$line"; +} +close (FILE); +print STDERR "wrote $outfile\n"; + +exit 0; + +# given an image directory with a name like /path/output (a SPLIT): + +# for each ccd: + +# 1) get astrometry +# 2) + +#ckrunid 570965o/570965o00.fits +#set dir=`gconfig -q -D RUNID 01Ak01 TMPDIR` +#$dir/570965o/570965o00.cmp + + +################################################################################### + +sub vsystem { + print STDERR "@_\n"; + $status = system ("@_"); + $status; +} + +sub goodbye { + die "@_\n"; +} + + + +sub junk { + + # create the basic entries for a header + $line = sprintf "SIMPLE = T / Standard FITS \n"; @output = (@output, $line); + $line = sprintf "BITPIX = 8 / no actual data in this file\n"; @output = (@output, $line); + $line = sprintf "NAXIS = 0 / Number of axes \n"; @output = (@output, $line); + + + + # fill in the bottom of the header + $line = sprintf "END"; @output = (@output, $line); +} + Index: /tags/ohana/perl-1-3/Ohana/src/perl/src/imclean.cfht =================================================================== --- /tags/ohana/perl-1-3/Ohana/src/perl/src/imclean.cfht (revision 21906) +++ /tags/ohana/perl-1-3/Ohana/src/perl/src/imclean.cfht (revision 21906) @@ -0,0 +1,64 @@ +#!/usr/bin/env perl + +$config = ""; +@tARGV = (); +for (; @ARGV > 0; ) { + if ($ARGV[0] eq "-C") { + $config = "-C $ARGV[1]"; + shift; shift; next; + } + if ($ARGV[0] eq "-c") { + $config = "-c $ARGV[1]"; + shift; shift; next; + } + if ($ARGV[0] eq "-D") { + $config = "-D $ARGV[1] $ARGV[2]"; + shift; shift; shift; next; + } + @tARGV = (@tARGV, $ARGV[0]); + shift; +} +@ARGV = @tARGV; + +if (@ARGV < 3) { + print STDERR "ERROR: USAGE: USAGE: imclean.cfht (fits) (obj) (cmp) [option]\n"; + print STDERR " corrects for errors with CD1_1, CRPIX1 on 12k for 51400 < MJD < 51540\n"; + print STDERR " also determines and inserts the photcode for the image\n"; + exit 2; +} + +# input image must already be in SPLIT mode + +# determine the photcode of this image: +$photcode=`photcode $config -quiet $ARGV[0] 0 split`; chop $photcode; +if ($?) { die "ERROR: cannot find photcode\n"; } + +# check if we need to correct the WCS terms (only CFH12K) +($name, $id, $mjd) = split (" ", `echo $ARGV[0] | fields IMAGEID MJD-OBS`); + +$fix=""; +if (($mjd > 51400) && ($mjd < 51540) && (($id == 2) || ($id == 6))) { + $line = `echo $ARGV[0] | fields CD1_1 CRPIX1 NAXIS1`; + ($name, $cd11, $crpix1, $nx) = split (" ", $line, 4); + $crpix1 = $nx - $crpix1; + $cd11 = -$cd11; + $fix = "-key CD1_1 %f $cd11 -key CRPIX1 %f $crpix1"; +} + +vsystem ("imclean $config @ARGV -p $photcode $fix"); + +exit 0; + +############ + +sub vsystem { + print STDERR "@_\n"; + $status = system ("@_"); + $status; +} + +sub goodbye { + print STDERR "ending execution\n"; + die "@_"; +} + Index: /tags/ohana/perl-1-3/Ohana/src/perl/src/imclean.subaru =================================================================== --- /tags/ohana/perl-1-3/Ohana/src/perl/src/imclean.subaru (revision 21906) +++ /tags/ohana/perl-1-3/Ohana/src/perl/src/imclean.subaru (revision 21906) @@ -0,0 +1,52 @@ +#!/usr/bin/env perl + +sub vsystem { + print STDERR "@_\n"; + $status = system ("@_"); + $status; +} + +sub goodbye { + print STDERR "ending execution\n"; + die "@_"; +} + +if (@ARGV < 3) { + print STDERR "ERROR: USAGE: USAGE: imclean.cfht (fits) (obj) (cmp) [option]\n"; + print STDERR " corrects for errors with CD1_1, CRPIX1 on 12k for 51400 < MJD < 51540\n"; + print STDERR " also determines and inserts the photcode for the image\n"; + exit 2; +} + +# input image must already be in SPLIT mode +# determine the photcode of this image: +$photcode=`photcode -quiet $ARGV[0] 0 split`; +if ($?) { + print STDERR "ERROR: cannot find photcode\n"; + exit 1; +} +chop ($photcode); + +# check if we need to correct the WCS terms +$line = `echo $ARGV[0] | fields DET-ID`; +chop ($line); +($name, $id) = split (" ", $line); + +$cfix = ""; +if ($id == 0) { $cfix = "-key CRPIX1 %f 4000.0 -key CRPIX2 %f 5000.0"; } +if ($id == 1) { $cfix = "-key CRPIX1 %f 4000.0 -key CRPIX2 %f 3000.0"; } +if ($id == 2) { $cfix = "-key CRPIX1 %f 0.0 -key CRPIX2 %f 1000.0"; } +if ($id == 3) { $cfix = "-key CRPIX1 %f 0.0 -key CRPIX2 %f -1000.0"; } +if ($id == 4) { $cfix = "-key CRPIX1 %f 4000.0 -key CRPIX2 %f -1000.0"; } +if ($id == 5) { $cfix = "-key CRPIX1 %f 4000.0 -key CRPIX2 %f 1000.0"; } +if ($id == 6) { $cfix = "-key CRPIX1 %f 0.0 -key CRPIX2 %f 5000.0"; } +if ($id == 7) { $cfix = "-key CRPIX1 %f 0.0 -key CRPIX2 %f 3000.0"; } +if ($id == 8) { $cfix = "-key CRPIX1 %f 0.0 -key CRPIX2 %f -3000.0"; } +if ($id == 9) { $cfix = "-key CRPIX1 %f 4000.0 -key CRPIX2 %f -3000.0"; } + +$fix = "-key PC001001 %f 1.0 -key PC001002 %f 0.0 -key PC002001 %f 0.0 -key PC002002 %f 1.0"; + +vsystem ("imclean @ARGV -p $photcode $fix $cfix"); + +exit 0; + Index: /tags/ohana/perl-1-3/Ohana/src/perl/src/imstatqso =================================================================== --- /tags/ohana/perl-1-3/Ohana/src/perl/src/imstatqso (revision 21906) +++ /tags/ohana/perl-1-3/Ohana/src/perl/src/imstatqso (revision 21906) @@ -0,0 +1,87 @@ +#!/usr/bin/env perl + +# send sky & seeing to QSO db +# probably need some error checking on the +# system call functions (seeingstats & fields) + +sub vsystem { + print STDERR "@_\n"; + $status = system ("@_"); + $status; +} + +sub goodbye { + die "@_\n"; +} + +if (@ARGV != 3) { die "USAGE: imstatqso (name) (stats) (sdat)\n"; } + +$ccdkeyword = `gconfig CCDNUM-KEYWORD`; chop ($ccdkeyword); +if ($?) { die "ERROR: missing CCDNUM-KEYWORD in config system\n"; } + +$refccd = `gconfig SEEING_REF_CCD`; chop ($refccd); +if ($?) { die "ERROR: missing SEEING_REF_CCD in config system\n"; } + +$pixscale = `gconfig ASEC_PIX`; chop ($pixscale); +if ($?) { die "ERROR: missing ASEC_PIX in config system\n"; } + +$line = `echo $ARGV[0] | fields $ccdkeyword`; +($tmp, $ccd) = split (" ", $line); + +if ($ccd =~ m|amp|) { + # convert to equivalent ccd + ($n) = $ccd =~ m|amp(\d*)|; + $ccd = sprintf "ccd%02d", $n/2; +} + +if ($ccd ne $refccd) { + print STDOUT "SUCCESS: skipping ccd $ccd\n"; + exit 0; +} + +$line = `echo $ARGV[0] | fields OBSID`; +($tmp, $obs) = split (" ", $line); +$obs = substr ($obs, 0, 6); + +$line = `echo $ARGV[0] | fields OBSTYPE`; +($tmp, $type) = split (" ", $line); +$type = uc ($type); + +$line = `echo $ARGV[0] | fields EXPTIME`; +($tmp, $etime) = split (" ", $line); + +open (FILE, "$ARGV[1]"); +@lines = ; +close (FILE); +@words = split (" ", $lines[0]); +$skybg = $words[0]; +$bias = $words[1]; + +if ($etime == 0) { + $flux = -1000; +} else { + $flux = $skybg / $etime; +} + +$fwhm = `seeingstats $ARGV[2]`; +chop ($fwhm); +$fwhm = $fwhm * $pixscale; + +# if this is a BIAS, send just the bias for skybg +if ($type eq "BIAS") { + vsystem ("/cfht/bin/update_xexpe.sh -U qso_elixir -P op1eliw --obsid $obs --skybg $bias"); + print STDOUT "SUCCESS: done with $ARGV[0]\n"; + exit (0); +} + +# if this is an OBJECT, send both fwhm & flux +if ($type eq "OBJECT") { + vsystem ("/cfht/bin/update_xexpe.sh -U qso_elixir -P op1eliw --obsid $obs --skybg $flux --iq $fwhm"); + print STDOUT "SUCCESS: done with $ARGV[0]\n"; + exit (0); +} + +# otherwise, just send flux +vsystem ("/cfht/bin/update_xexpe.sh -U qso_elixir -P op1eliw --obsid $obs --skybg $flux"); +print STDOUT "SUCCESS: done with $ARGV[0]\n"; +exit (0); Index: /tags/ohana/perl-1-3/Ohana/src/perl/src/imstats =================================================================== --- /tags/ohana/perl-1-3/Ohana/src/perl/src/imstats (revision 21906) +++ /tags/ohana/perl-1-3/Ohana/src/perl/src/imstats (revision 21906) @@ -0,0 +1,63 @@ +#!/usr/bin/env perl + +if (@ARGV != 5) { die "USAGE: imstats (file.fits) (file.stats) (file.split) CCD MODE\n" } + +$file = $ARGV[0]; +$stats = $ARGV[1]; +$split = $ARGV[2]; +$ccd = $ARGV[3]; +$mode = $ARGV[4]; + +# check for outdir: +@words = split ("/", $stats); +pop (@words); +$outdir = join ("/", @words); +if ($outdir eq "") { $outdir = "."; } +if (! -d $outdir) { + vsystem ("mkdir -p $outdir"); + if ($?) { + print STDERR "ERROR: can't make directory component for output $outdir\n"; + exit 1; + } +} + +if (-e $stats) { unlink ($stats); } +if (-e $split) { unlink ($split); } + +# find the appropriate script file +$confdir = `gconfig -q CONFDIR`; chop ($confdir); +$script = "$confdir/mana/imstats.pro"; + +$ccdkeyword = `gconfig CCDNUM-KEYWORD`; chop ($ccdkeyword); + +open (MANA, "|mana --norc"); +print MANA "input $script\n"; + +print MANA "\$CCDKEYWORD = $ccdkeyword\n"; +print MANA "macro go\n"; +print MANA " getstats $file $ccd $mode $stats $split\n"; # load images, create mosaic +print MANA " exit 0\n"; +print MANA "end\n"; + +print MANA "go\n"; +print MANA "exit 1\n"; +close (MANA); +if ($?) { + print STDERR "ERROR problem with imstats\n"; + exit 1; +} + +print STDOUT "SUCCESS: finished with imstats\n"; + +exit 0; + +sub vsystem { + print STDERR "@_\n"; + $status = system ("@_"); + $status; +} + +sub goodbye { + die "@_\n"; +} + Index: /tags/ohana/perl-1-3/Ohana/src/perl/src/imstats.mana =================================================================== --- /tags/ohana/perl-1-3/Ohana/src/perl/src/imstats.mana (revision 21906) +++ /tags/ohana/perl-1-3/Ohana/src/perl/src/imstats.mana (revision 21906) @@ -0,0 +1,203 @@ +#!/usr/bin/env mana + +macro getstats + # usage getstats (filename) (ccd) (mef) (stats) (split) + + # load image into 'b' + if (($3 == mef) || ($3 == MEF)) + rd b $1 -n $2 + else + rd b $1 + end + + # raster goes in buffer 'a' + # $flux has sky + bias + getraster + + # result of this is $bias + getbiassec b $2 + + mkoutput $4 $5 +end + +# extract subraster from image center 0.1-0.9*NAXIS1 (max 800,800) +macro getraster + keyword b NAXIS1 nx + keyword b NAXIS2 ny + +# $DX = $nx * 0.8 +# if ($DX > $dx) +# $DX = $dx +# end +# $DY = $ny * 0.8 +# if ($DY > $dy) +# $DY = $dy +# end +# +# $X0 = 0.5*($nx - $DX) +# $Y0 = 0.5*($ny - $DX) +# +# extract b a $X0 $Y0 $DX $DY 0 0 $DX $DY + + if ($nx < (2*$dx)) + $dx = 0.5 * $nx + end + if ($ny < (2*$dy)) + $dy = 0.5 * $ny + end + echo extract a b {0.5*$nx - $dx} {0.5*$ny - $dy} {2*$dx} {2*$dy} 0 0 {2*$dx} {2*$dy} + extract b a {0.5*$nx - $dx} {0.5*$ny - $dy} {2*$dx} {2*$dy} 0 0 {2*$dx} {2*$dy} + + stats -q a - - - - + $flux = $MEDIAN +end + +# usage: mkoutput (stats) (split) +macro mkoutput + $sky = $flux - $bias + output $1 + echo $sky $bias + output stdout + wd a $2 +end + +# get bias from BIASSEC (header or config) +macro getbiassec + if ($BIASSEC) + echo "using header biassec" + keyword $1 BIASSEC biassec + else + # this line converts 2 digit zero-padded number to single + echo "using config biassec" + $ccd = $2 + $biassec = 0 + for n 0 $biassec:n + if ($ccdlist:$n == $ccd) + $biassec = $biassec:$n + end + end + if ($biassec == 0) + echo "biassec for chip $ccd not found" + exit 1 + end + end + parsesec $biassec + stats -q $1 $x1 $y1 {$x2-$x1} {$y2-$y1} + $bias = $MEDIAN +end + +# convert BIASSEC string to x1, x2, y1, y2 vars +macro parsesec + $f = $1 + getchr $f : n + substr $f 1 {$n-1} x1 + strlen $f N + substr $f $n {$N-$n} f + + getchr $f , n + substr $f 1 {$n-1} x2 + strlen $f N + substr $f $n {$N-$n} f + + getchr $f : n + substr $f 1 {$n-1} y1 + strlen $f N + substr $f $n {$N-$n} f + + getchr $f ] n + substr $f 1 {$n-1} y2 + strlen $f N + substr $f $n {$N-$n} f +end + +macro vysub + if ($0 != 2) + echo "USAGE vysub (buffer)" + break + end + + keyword $1 NAXIS1 nx + keyword $1 NAXIS2 ny + + create dy 0 $ny + create dx 0 $ny + for ty 0 $ny + cut $1 x y x 0 $ty $nx 1 + vstat -q y + dy[$ty] = $MEDIAN + end + + # this subtraction is not at all obvious + set $1 = $1 - dy +end + +macro vxsub + if ($0 != 2) + echo "USAGE vxsub (buffer)" + break + end + + keyword $1 NAXIS1 nx + keyword $1 NAXIS2 ny + + create dy 0 $nx + create dx 0 $nx + for tx 0 $nx + cut $1 x y y $tx 0 1 $ny + vstat -q y + dy[$tx] = $MEDIAN + end + + # this subtraction is not at all obvious + set $1 = -(dy - $1) +end + +macro irstats + $plane = $2 + 1 + rd a $1 -plane $plane + vysub a + vstat -q dy + $sky = $MEDIAN + vxsub a + set a = a / $sky + wd a $3 -bitpix 16 -bzero 0 -bscale {1/$sky} + exec sexstats $3 $4 + $fwhm = `seeingstats $4` + exec echo "$2 $sky $fwhm >> $5" + echo "$2 $sky $fwhm to $5" +end + +unsign 0 +$dx = 800 +$dy = 800 + +$CCDKEYWORD = `gconfig CCDNUM-KEYWORD` + +list biassec -x "cameraconfig -biassec" +$BIASSEC = `cameraconfig -usebiassec` +list ccdlist -x "cameraconfig -ccds" + +# if we can use BIASSEC, use it - BIASSEC changes with rastered, binned images +# if not, use xbias, ybias lists to extract bias + +if ($argv:n != 5) + echo "USAGE: imstats (file.fits) (file.stats) (file.split) CCD MODE" + exit 1 +end + +break -auto off +$path = `dirname $argv:1` +exec test -d $path +if ($STATUS == 0) + exec mkdir -p $path + if ($STATUS == 0) + echo "ERROR: can't make directory" + exit 1 + end +end + +echo exec rm -f $argv:1 +echo exec rm -f $argv:2 + +getstats $argv:0 $argv:3 $argv:4 $argv:1 $argv:2 +exit 0 Index: /tags/ohana/perl-1-3/Ohana/src/perl/src/irstats =================================================================== --- /tags/ohana/perl-1-3/Ohana/src/perl/src/irstats (revision 21906) +++ /tags/ohana/perl-1-3/Ohana/src/perl/src/irstats (revision 21906) @@ -0,0 +1,111 @@ +#!/usr/bin/env perl + +if (@ARGV != 2) { die "USAGE: imstats (file.fits) (file.stats)\n" } + +$file = $ARGV[0]; +$stats = $ARGV[1]; +@medlist = (); +$cube = 1; + +# check for outdir: +@words = split ("/", $stats); +pop (@words); +$outdir = join ("/", @words); +if ($outdir eq "") { $outdir = "."; } +if (! -d $outdir) { + system ("mkdir -p $outdir"); + if ($?) { &escape ("ERROR: can't make directory component for output $outdir"); } +} + +if (-e $stats) { unlink ($stats); } + +# find the appropriate script file +$confdir = `gconfig -q CONFDIR`; chop ($confdir); +$script = "$confdir/mana/imstats.pro"; + +# check that image is not MEF? +$answer = `echo $file | fields NAXIS3`; +($tmp, $Nplane) = split (" ", $answer); +if ($Nplane == 0) { + $Nplane = 1; + $cube = 0; +} + +$temp = `mktemp /tmp/imstats.XXXXXX`; chop ($temp); + +# loop over cube planes: +open (MANA, "|mana --norc > /dev/null"); +print MANA "input $script\n"; + +print MANA "macro go\n"; +for ($plane = 0; $plane < $Nplane; $plane++) { + print MANA " irstats $file $plane $temp.$plane.fits $temp.stats $stats\n"; + @medlist = (@medlist, "$temp.$plane.fits"); +} +print MANA " exit 0\n"; +print MANA "end\n"; + +print MANA "go\n"; +print MANA "exit 1\n"; +close (MANA); +if ($?) { &escape ("ERROR problem with imstats"); } + +if (@medlist > 1) { + open (MED, "|medianfilter $temp.fits 0.25 0.75"); + foreach $file (@medlist) { + print MED "$file\n"; + } + close (MED); + if ($?) { &escape ("ERROR problem with medianfilter"); } + + system ("sexstats $temp.fits $temp.stats > /dev/null"); + if ($?) { &escape ("ERROR problem with sexstats"); } +} else { + system ("sexstats $temp.0.fits $temp.stats > /dev/null"); + if ($?) { &escape ("ERROR problem with sexstats"); } +} + +if ($cube) { + $fwhm = `seeingstats $temp.stats`; chop ($fwhm); + if ($?) { &escape ("ERROR problem with sexstats"); } + + open (MED, "$stats"); + @list = ; + close (MED); + + $sky = 0; + foreach $line (@list) { + ($tmp, $isky, $tmp) = split (" ", $line); + $sky += $isky; + } + $sky = $sky / @list; + + open (MED, ">>$stats"); + print MED "$Nplane $sky $fwhm\n"; + close (MED); +} + +&cleanup; +print STDOUT "SUCCESS: finished with imstats\n"; + +exit 0; + +sub vsystem { + print STDERR "@_\n"; + $status = system ("@_"); + $status; +} + +sub escape { + &cleanup; + die "@_\n"; +} + +sub cleanup { + if (-e "$temp") { unlink ("$temp"); } + if (-e "$temp.stats") { unlink ("$temp.stats"); } + if (-e "$temp.fits") { unlink ("$temp.fits"); } + foreach $file (@medlist) { + if (-e $file) { unlink $file; } + } +} Index: /tags/ohana/perl-1-3/Ohana/src/perl/src/mefheadunstrip =================================================================== --- /tags/ohana/perl-1-3/Ohana/src/perl/src/mefheadunstrip (revision 21906) +++ /tags/ohana/perl-1-3/Ohana/src/perl/src/mefheadunstrip (revision 21906) @@ -0,0 +1,88 @@ +#!/usr/bin/env perl + +$xtline = "XTENSION= 'IMAGE ' / Image extension "; +$rwline = "SIMPLE = T / Standard FITS "; + +# input file is PHU: foo.fits.hdr +# expect NEXTEND files: fooNN.fits.hdr + +if (@ARGV != 2) { die "ERROR: USAGE: mefheadunstrip (input) (output)\n" } +$input = $ARGV[0]; +$output = $ARGV[1]; +($root) = $input =~ m|(\S*).fits.hdr|; + +# blank line for padding: +$blank = ""; +for ($i = 0; $i < 80; $i++) { $blank = $blank . " "; } + +if (-e $output) { die "remove existing target\n"; } + +open (OUT, ">$output"); + +# load primary header +@head = &loadheader ($input); +foreach $line (@head) { + print OUT "$line"; +} + +# find N extensions +$Nextend = 0; +foreach $line (@head) { + if ($line =~ m|^NEXTEND =\s+\d+|) { + ($Nextend) = $line =~ m|^NEXTEND =\s+(\d+)|; + last; + } +} +if (!$Nextend) { die "ERROR: no extensions\n"; } + +# load extension headers +for ($i = 0; $i < $Nextend; $i++) { + $file = sprintf "%s%02d.fits.hdr", $root, $i; + print STDERR "$file\n"; + + @head = &loadheader ($file); + foreach $line (@head) { + if ($line =~ s|^$rwline|$xtline|) { + print STDERR "fixed SIMPLE\n"; + } + } + foreach $line (@head) { + print OUT "$line"; + } +} + +close (OUT); +exit 0; + +# load, strip, pad, fix NAXIS: +sub loadheader { + + my ($file) = $_[0]; + my (@input, $i); + + open (FILE, "$file"); + @input = ; + close (FILE); + + # strip return chars + foreach $line (@input) { chop $line; } + + # pad end of block + $N = @input; + if ($N % 36) { + $Nxtra = 36 - ($N % 36); + for ($i = 0; $i < $Nxtra; $i++) { + @input = (@input, $blank); + } + } + + # NAXIS = 2 -> NAXIS = 0 + foreach $line (@input) { + if ($line =~ s|^NAXIS = 2|NAXIS = 0|) { + print STDERR "fixed NAXIS\n"; + } + } + + return (@input); +} + Index: /tags/ohana/perl-1-3/Ohana/src/perl/src/megacenter =================================================================== --- /tags/ohana/perl-1-3/Ohana/src/perl/src/megacenter (revision 21906) +++ /tags/ohana/perl-1-3/Ohana/src/perl/src/megacenter (revision 21906) @@ -0,0 +1,91 @@ +#!/usr/bin/env perl + +if (@ARGV != 1) { die "USAGE: megacenter (filename)\n"; } +$ENV{'PATH'} = "/apps/elixir/bin:$ENV{'PATH'}"; + +# currently we keep things hardwired: + +$input = $ARGV[0]; +$camera = `gconfig CAMERA`; chop $camera; +if ($camera eq "megacam") { + $ccd = "amp44"; + $Xref = 973; + $Yref = 4560; +} +if ($camera eq "meganorth") { + $ccd = "amp26"; + $Xref = 1140; + $Yref = 4717; +} +if ($ccd eq "") { die "ERROR: camera $camera not found\n"; } + +$temp = `mktemp /tmp/center.XXXXXX`; chop ($temp); + +# loop over cube planes: +open (MANA, "|mana --norc >& /dev/null"); + +print MANA "\$CCDKEYWORD = EXTNAME\n"; +print MANA "macro go\n"; +print MANA " rd a $input -n $ccd\n"; +print MANA " wd a $temp.fits\n"; +print MANA " exec gosexphot $temp.fits $temp.sx >& /dev/null\n"; +print MANA " exec imclean -sex $temp.fits $temp.sx $temp.smp >& /dev/null\n"; +print MANA " exec gastro $temp.smp >& /dev/null\n"; +print MANA " header a -w $temp.smp\n"; +print MANA " coords a -p $Xref $Yref\n"; +print MANA " exec echo \$RA \$DEC > $temp.coords\n"; +print MANA " exit 0\n"; +print MANA "end\n"; + +print MANA "go\n"; +print MANA "exit 1\n"; +close (MANA); + +($Robs, $Dobs) = split (" ", `cat $temp.coords`); +($tmp, $Rreq, $Dreq) = split (" ", `echo $input | fields RA_DEG DEC_DEG`); + +($tmp, $Nastro, $Cerror) = split (" ", `echo $temp.smp | fields NASTRO CERROR`); + +if ($Robs < 0.0) { $Robs += 360.0 } +if ($Robs > 360.0) { $Robs -= 360.0 } + +if ($Rreq < 0.0) { $Rreq += 360.0 } +if ($Rreq > 360.0) { $Rreq -= 360.0 } + +$dR = sprintf "%.2f", 3600.0 * ($Rreq - $Robs) * cos ($Dobs*3.141592643589/180.0); +$dD = sprintf "%.2f", 3600.0 * ($Dreq - $Dobs); + +$obscoords = `echo $Rreq $Dreq | radec -hh`; chop $obscoords; +$reqcoords = `echo $Robs $Dobs | radec -hh`; chop $reqcoords; + +print "\n"; +printf STDOUT "$Nastro stars used in astrometry, astrometry error: %.2f\n", $Cerror; + +printf STDOUT "REQ COORDS: %10.6f %10.6f ($reqcoords )\n", $Rreq, $Dreq; +printf STDOUT "OBS COORDS: %10.6f %10.6f ($obscoords )\n", $Robs, $Dobs; +printf STDOUT "OFFSET IS: $dR $dD (arcsec)\n"; + +if ($Nastro == 0) { + print "No Astrometry solution was found! please try again\n"; + goto escape; +} + +if ($Cerror > 2.5) { print "WARNING: astrometry error is surprisingly high\n"; } +if ($dR > 3600.0) { print "WARNING: RA offset > 1 degree! is this correct?\n"; } +if ($dD > 3600.0) { print "WARNING: DEC offset > 1 degree! is this correct?\n"; } + +print STDOUT "apply this offset? y/[n] "; +$answer = ; chop $answer; +$answer = "\U$answer\E"; + +if ($answer ne "Y") { + print STDOUT "offset not applied\n"; + goto escape; +} + +system ("clicmd ocoords rel t $dR $dD\n"); +system ("clicmd tcs.offset\n"); + +escape: +system ("rm -f $temp $temp.fits $temp.sx $temp.smp $temp.coords"); +exit 0; Index: /tags/ohana/perl-1-3/Ohana/src/perl/src/megacoords =================================================================== --- /tags/ohana/perl-1-3/Ohana/src/perl/src/megacoords (revision 21906) +++ /tags/ohana/perl-1-3/Ohana/src/perl/src/megacoords (revision 21906) @@ -0,0 +1,58 @@ +#!/usr/bin/env perl + +if (@ARGV != 2) { die "USAGE: megacoords (mode) (filename)\n"; } +$ENV{'PATH'} = "$ENV{'PATH'}:/apps/elixir/bin"; + +# currently we keep things hardwired: + +$mode = $ARGV[0]; +$input = $ARGV[1]; + +if ($mode eq "chip") { $ccd = "ccd22"; } +if ($mode eq "amp") { $ccd = "amp44"; } +$Xref = 973; +$Yref = 4560; + +if ($ccd eq "") { die "ERROR: camera $camera not found\n"; } + +$temp = `mktemp /tmp/center.XXXXXX`; chop ($temp); + +# mana processing of image +open (MANA, "|mana --norc >& /dev/null"); + +print MANA "\$CCDKEYWORD = EXTNAME\n"; +print MANA "macro go\n"; +print MANA " rd a $input -n $ccd\n"; +print MANA " wd a $temp.fits\n"; +print MANA " exec gosexphot $temp.fits $temp.sx >& /dev/null\n"; +print MANA " exec imclean -sex $temp.fits $temp.sx $temp.smp >& /dev/null\n"; +print MANA " exec gastro $temp.smp >& /dev/null\n"; +print MANA " header a -w $temp.smp\n"; +print MANA " coords a -p $Xref $Yref\n"; +print MANA " exec echo \$RA \$DEC > $temp.coords\n"; +print MANA " exit 0\n"; +print MANA "end\n"; + +print MANA "go\n"; +print MANA "exit 1\n"; +close (MANA); + +($Robs, $Dobs) = split (" ", `cat $temp.coords`); +($tmp, $Rreq, $Dreq) = split (" ", `echo $input | fields RA_DEG DEC_DEG`); + +($tmp, $obsid, $Nastro, $Cerror) = split (" ", `echo $temp.smp | fields OBSID NASTRO CERROR`); + +if ($Robs < 0.0) { $Robs += 360.0 } +if ($Robs > 360.0) { $Robs -= 360.0 } + +if ($Rreq < 0.0) { $Rreq += 360.0 } +if ($Rreq > 360.0) { $Rreq -= 360.0 } + +$dR = 3600.0 * ($Rreq - $Robs) * cos ($Dobs*3.141592643589/180.0); +$dD = 3600.0 * ($Dreq - $Dobs); + +printf "$obsid %10.6f %10.6f %10.6f %10.6f %6.1f %6.1f %3d %4.2f\n", $Rreq, $Dreq, $Robs, $Dobs, $dR, $dD, $Nastro, $Cerror; + +escape: +system ("rm -f $temp $temp.fits $temp.sx $temp.smp $temp.coords"); +exit 0; Index: /tags/ohana/perl-1-3/Ohana/src/perl/src/merge.lists =================================================================== --- /tags/ohana/perl-1-3/Ohana/src/perl/src/merge.lists (revision 21906) +++ /tags/ohana/perl-1-3/Ohana/src/perl/src/merge.lists (revision 21906) @@ -0,0 +1,101 @@ +#!/usr/bin/env perl + +$update = 0; + +# grab the command line arguments: +@tARGV = (); +for (; @ARGV > 0; ) { + + # new images get mode of 0, old image keep their mode + if ($ARGV[0] eq "-update") { + shift; + $update = 1; + next; + } + + @tARGV = (@tARGV, $ARGV[0]); + shift; +} +@ARGV = @tARGV; + +if (@ARGV != 3) { die "USAGE: merge.lists (list.split) (list.msplit) (list.master) [-update]\n" ;} + +print STDERR "$ARGV[0], $ARGV[1], $ARGV[2]\n"; + +# load names from SPLIT and MEF +open (FILE, "$ARGV[0]"); +@split = ; +close (FILE); + +open (FILE, "$ARGV[1]"); +@mef = ; +close (FILE); + +# load old names from MASTER +open (FILE, "$ARGV[2]"); +@master = ; +close (FILE); + +$N = @split; +print STDERR "N: $N\n"; +$N = @mef; +print STDERR "N: $N\n"; +$N = @master; +print STDERR "N: $N\n"; + +# merge new entries into a single list, compare with state in master +@names = (@split, @mef); + +@newname = (); +@newmode = (); + +for ($i = 0; $i < @names; $i++) { + + $name = $names[$i]; chop ($name); + + $mode = 1; + if ($update) { + $mode = 0; + + INNER: + foreach $line (@master) { + @words = split (" ", $line); + if ($words[0] eq $name) { + $mode = $words[1]; + last INNER; + } + } + } + @newname = (@newname, $name); + @newmode = (@newmode, $mode); +} + +if (! @newname) { + print STDERR "ERROR: no relevant ccd images\n"; + exit 1; +} + +# check on list: if there are none selected, select all +$Ngood = 0; +foreach $mode (@newmode) { + if ($mode) { + $Ngood ++; + } +} +if ($Ngood == 0) { + foreach $mode (@newmode) { + $mode = 1; + } +} + +open (FILE, ">$ARGV[2]"); +for ($i = 0; $i < @newname; $i++) { + print FILE "$newname[$i] $newmode[$i]\n"; +} +close (FILE); + +# this file must be accessible by www user +chmod 0666, $ARGV[2]; + +print STDOUT "SUCCESS\n"; +exit 0; Index: /tags/ohana/perl-1-3/Ohana/src/perl/src/mkdetrend =================================================================== --- /tags/ohana/perl-1-3/Ohana/src/perl/src/mkdetrend (revision 21906) +++ /tags/ohana/perl-1-3/Ohana/src/perl/src/mkdetrend (revision 21906) @@ -0,0 +1,2486 @@ +#!/usr/bin/perl +# this function is called from the detrend apache user: +# it must be explicit about the location of perl + +$MKDETREND = "mkdetrend"; + +# strip off args related to the elixir config system, set env PTOLEMY +@ARGV = elixir_config (@ARGV); + +# interpret command-line arguments +if (@ARGV < 1) { + print STDOUT "USAGE: $MKDETREND (mode) [arguments]\n"; + print STDOUT "mode = help gives a complete list\n"; + &escape; +} +if ($ARGV[0] eq "help") { &usage; } + +# main user level commands +if ($ARGV[0] eq "create") { &mk_create; } +if ($ARGV[0] eq "config") { &mk_config; } +if ($ARGV[0] eq "run") { &mk_run; } +if ($ARGV[0] eq "state") { &mk_state; } +if ($ARGV[0] eq "list.runs") { &mk_list_runs; } +if ($ARGV[0] eq "clean") { &mk_clean; } +if ($ARGV[0] eq "reset") { &mk_reset; } +if ($ARGV[0] eq "init") { &mk_init; } +if ($ARGV[0] eq "update") { &mk_update; } +if ($ARGV[0] eq "auto") { &mk_auto; } +# lower level user comands +if ($ARGV[0] eq "dup") { &mk_dup; } +if ($ARGV[0] eq "del") { &mk_del; } +if ($ARGV[0] eq "def") { &mk_def; } +if ($ARGV[0] eq "set") { &mk_set; } +if ($ARGV[0] eq "list.init") { &mk_list_init; } +if ($ARGV[0] eq "split") { &mk_split; } +if ($ARGV[0] eq "flips") { &mk_flips; } +if ($ARGV[0] eq "norm") { &mk_norm; } +if ($ARGV[0] eq "reg") { &mk_reg; } +if ($ARGV[0] eq "scat") { &mk_scat; } +if ($ARGV[0] eq "merge") { &mk_merge; } +if ($ARGV[0] eq "update.list") { &mk_update_list; } +if ($ARGV[0] eq "update.stats") { &mk_update_stats; } +# HTML cgibin commands +if ($ARGV[0] eq "htmldup") { &mk_htmldup; } +if ($ARGV[0] eq "htmldef") { &mk_htmldef; } +if ($ARGV[0] eq "htmldel") { &mk_htmldel; } +if ($ARGV[0] eq "htmlmod") { &mk_htmlmod; } +if ($ARGV[0] eq "htmlkeep") { &mk_htmlkeep; } +if ($ARGV[0] eq "htmlconfig") { &mk_htmlconfig; } +if ($ARGV[0] eq "html1") { &mk_html1; } +if ($ARGV[0] eq "html2") { &mk_html2; } +if ($ARGV[0] eq "html3") { &mk_html3; } +# other support commands +if ($ARGV[0] eq "dads") { &mk_dads; } +if ($ARGV[0] eq "dads.top") { &mk_dads_top; } +if ($ARGV[0] eq "meval") { &mk_meval; } +if ($ARGV[0] eq "eval") { &mk_eval; } +if ($ARGV[0] eq "fix.masters") { &mk_fixmasters; } +if ($ARGV[0] eq "check.splits") { &mk_checksplits; } + +if ($ARGV[0] eq "test") { &mk_test; } + +&escape ("invalid $MKDETREND command $ARGV[0]"); + +######## top level functions ###################### + +sub mk_test { + + print "Content-type: text/plain\n\n"; + + print "$MKDETREND\n"; + exit 0; +} + +############# define run ############## +sub mk_create { + if ($ARGV[1] eq "run") { &mk_createrun; } + if (@ARGV != 5) { &escape ("USAGE: $MKDETREND create (camera) (run) (startdate) (stopdate)"); } + + $camera = $ARGV[1]; + $run = $ARGV[2]; + $start = $ARGV[3]; + $stop = $ARGV[4]; + + # create should NOT set the mkdetrend defaults + if (0) { + # set current run id: + system ("mkrun sys camera.mkdetrend $camera"); + if ($?) { &escape ("can't define camera: error in mkrun"); } + + # set current camera: + system ("mkrun sys runid.mkdetrend $run"); + if ($?) { &escape ("can't define run: error in mkrun"); } + } + + # reset values for the directories, etc. + $oldenv = $tmpenv; + &elixir_config (split (" ", "-run $run -camera $camera")); + unlink ($oldenv); + + # create necessary directories, empty them if they exist + foreach $name ("detdir", "html", "stats", "flips") { + $file = mkfiles ($name); + if (! -d $file) { + if (! mkdir ($file, 0777)) { + &escape ("can't create detdir $file\n"); + } + chmod 0775, $file; + } + } + &save_dates ($start, $stop, "init"); + + # create run-specific config file + @list = (); + for ($i = 0; $i < @filt; $i++) { + $line = stconfig ("$run $type[$i] $filt[$i] 0 $start $stop init", "all"); + @list = (@list, $line); + } + save_config (@list); + + # make the necessary directories? + &goodbye; +} + +############# define run ############## +sub mk_createrun { + if (@ARGV != 3) { &escape ("USAGE: $MKDETREND create run (run)"); } + if ($ARGV[1] ne "run") { &escape ("USAGE: $MKDETREND create run (run)"); } + + $run = $ARGV[2]; + $answer = `mkrun run $run`; + if ($?) { &escape ("run $run not defined, use 'mkrun'"); } + ($newrun, $start, $stop, $camera) = split (" ", $answer); + if ($run ne $newrun) { &escape ("inconsistent answer from mkrun run $run"); } + + # reset values for the directories, etc. + $oldenv = $tmpenv; + &elixir_config (split (" ", "-run $run -camera $camera")); + unlink ($oldenv); + + # create necessary directories, empty them if they exist + foreach $name ("detdir", "html", "stats", "flips") { + $file = mkfiles ($name); + if (! -d $file) { + if (! mkdir ($file, 0777)) { + &escape ("can't create detdir $file\n"); + } + chmod 0775, $file; + } + } + &save_dates ($start, $stop, "init"); + + # create run-specific config file + @list = (); + for ($i = 0; $i < @filt; $i++) { + $line = stconfig ("$run $type[$i] $filt[$i] 0 $start $stop init", "all"); + @list = (@list, $line); + } + save_config (@list); + + # make the necessary directories? + &goodbye; +} + +############# change current run ############## +sub mk_config { + if (@ARGV != 3) { &escape ("USAGE: $MKDETREND config (camera) (run)"); } + + $camera = $ARGV[1]; + $run = $ARGV[2]; + + # set current run id: + system ("mkrun sys camera.mkdetrend $camera"); + if ($?) { &escape ("can't define camera: error in mkrun"); } + + # set current run id: + system ("mkrun sys runid.mkdetrend $run"); + if ($?) { &escape ("can't define run: error in mkrun"); } + + &goodbye; +} + +############# auto run system ############## +sub mk_auto { + my ($start, $stop, $mode); + + if ((@ARGV != 2) && (@ARGV != 3)) { &escape ("USAGE: $MKDETREND auto [command]"); } + $command = $ARGV[1]; + + ($start, $stop, $mode) = load_dates (); + if ($command eq "set") { + if (@ARGV != 3) { &escape ("USAGE: $MKDETREND auto set (mode)"); } + &save_dates ($start, $stop, $ARGV[2]); + &goodbye; + } + + if (@ARGV != 2) { &escape ("USAGE: $MKDETREND auto [command]"); } + if ($command eq "show") { + print STDERR "MODE : $mode\n"; + &goodbye; + } + + if ($command eq "run") { + if ($mode eq "init") { + system ("$MKDETREND reset hard"); + system ("$MKDETREND init"); + system ("$MKDETREND run"); + &save_dates ($start, $stop, "init"); + &goodbye; + } + + if ($mode eq "update") { + system ("$MKDETREND update"); + &save_dates ($start, $stop, "update"); + &goodbye; + } + + if ($mode eq "hold") { + &goodbye; + } + } + &escape ("$MKDETREND auto $command : command not found\n"); +} + +############# main run ############## +sub mk_run { + if (@ARGV != 1) { &escape ("USAGE: $MKDETREND run"); } + + system ("$MKDETREND flips"); + system ("$MKDETREND norm"); + system ("$MKDETREND merge"); + + &goodbye; +} + +############# main init ############## +sub mk_init { + if (@ARGV != 1) { &escape ("USAGE: $MKDETREND init"); } + + system ("$MKDETREND list.init"); + system ("$MKDETREND split"); + + &goodbye; +} + +############# main update ############## +sub mk_update { + if (@ARGV != 1) { &escape ("USAGE: $MKDETREND update"); } + + system ("$MKDETREND reset update"); + system ("$MKDETREND init"); + system ("$MKDETREND update.list"); + system ("$MKDETREND update.stats"); + system ("$MKDETREND run"); + + &goodbye; +} + +############# show current state ############## +sub mk_state { + if (@ARGV != 1) { &escape ("USAGE: $MKDETREND state"); } + + $file = mkfiles ("dates"); + if (! -e $file) { + print STDOUT "CAMERA $camera\n"; + print STDOUT "RUN $run\n"; + &escape ("setup not defined"); + } + ($start, $stop, $mode) = load_dates (); + + print STDOUT "CAMERA $camera\n"; + print STDOUT "RUN $run\n"; + print STDOUT "START $start\n"; + print STDOUT "STOP $stop\n"; + print STDOUT "MODE $mode\n"; + + @list = &load_config; + if (@list == 0) { &escape ("$MKDETREND not configured"); } + + for ($i = 0; $i < @list; $i++) { + printf STDOUT "%3d %s\n", $i, $list[$i]; + } + &goodbye; +} + +############# show current state ############## +sub mk_list_runs { + if (@ARGV != 1) { &escape ("USAGE: $MKDETREND list.runs"); } + + system ("ls $root"); + &goodbye; +} + +############## duplicate config ############### +sub mk_dup { + if (@ARGV != 2) { &escape ("USAGE: detrend dup (config)"); } + + $key = $ARGV[1]; + @list = load_config (); + + # look for entry that matches requested config + @match = (); + for ($i = 0; $i < @list; $i++) { + $config = gtconfig ($list[$i], "config"); + if ($key eq $config) { @match = (@match, $i); } + } + if (@match == 0) { &escape ("config $key not found\n"); } + + # create new config version based on version 0 + $Nnew = @match; + $old = $list[$match[0]]; + $new = stconfig ($old, "version", $Nnew); + @list = (@list, $new); + save_config (@list); + + # now we need to duplicate all of the reference files from the first config + foreach $ccd (@ccds) { + $fold = mknames ("master", $old, $ccd); + $fnew = mknames ("master", $new, $ccd); + system ("cp $fold $fnew"); + } + foreach $name ("stats", "medbin", "tenbin", "imbin") { + $fold = mknames ($name, $old); + $fnew = mknames ($name, $new); + system ("cp $fold $fnew"); + } + + &goodbye; + +} + +############## clean config ############### +sub mk_clean { + if (@ARGV != 1) { &escape ("USAGE: detrend clean"); } + # only deletes temporary files for configs in state 'done' + + @list = load_config (); + + $detdir = mkfiles ("detdir"); + open (CF, ">$detdir/clean.fail"); + + $Nmiss = 0; + $Nfail = 0; + $Ngood = 0; + + foreach $confline (@list) { + $status = gtconfig ($confline, "status"); + if ($status ne "done") { next; } + + print STDERR "deleting files from $confline\n"; + $confline = stconfig ($confline, "status", "running.clean"); + save_config (@list); + + foreach $ccd (@ccds) { + # delete these specific files: + @dlist = (); + push @dlist, &mknames ("fits", $confline, $ccd); + push @dlist, &mknames ("norm", $confline, $ccd); + push @dlist, &mknames ("proc.imbin", $confline, $ccd); + push @dlist, &mknames ("proc.medbin", $confline, $ccd); + push @dlist, &mknames ("proc.tenbin", $confline, $ccd); + + # delete file, if it exists + foreach $file (@dlist) { + if (! -e $file) { $Nmiss ++; next; } + if (!unlink $file) { $Nfail ++; print CF "$file\n"; next; } + $Ngood ++; + } + } + $confline = stconfig ($confline, "status", "clean"); + save_config (@list); + } + close (CF); + + print STDERR "$Ngood files deleted\n"; + print STDERR "$Nmiss files already removed\n"; + print STDERR "$Nfail files not deleted, see '$detdir/clean.fail'\n"; + + &goodbye; +} + +############## delete config ############### +sub mk_del { + if (@ARGV != 2) { &escape ("USAGE: $MKDETREND del (config.ver)"); } + + $key = $ARGV[1]; + @list = load_config (); + + # look for entry that matches requested config + $match = -1; + for ($i = 0; $i < @list; $i++) { + $version = gtconfig ($list[$i], "version"); + if ($key eq $version) { + $match = $i; + last; + } + } + if ($match == -1) { + print STDERR "config.ver $key not found\n"; + &escape; + } + + # create new list without match: + @newlist = (); + for ($i = 0; $i < @list; $i++) { + if ($i == $match) { next; } + @newlist = (@newlist, $list[$i]); + } + + save_config (@newlist); + &goodbye; + +} + +############## reset config ############### +sub mk_reset { + if (@ARGV != 2) { + print STDERR "USAGE: $MKDETREND reset (level)\n"; + print STDERR " level = hard || update\n"; + &escape; + } + + $level = $ARGV[1]; + @list = load_config (); + + # find specific config: +RESET: + foreach $confline (@list) { + $status = gtconfig ($confline, "status"); + + if ($level eq "hard" ) { + $confline = stconfig ($confline, "status", "init"); + } + if ($level eq "update") { + if (($status eq "done.merge") || ($status eq "modified") || ($status eq "update")) { + $confline = stconfig ($confline, "status", "update"); + next RESET; + } + if (($status eq "freeze") || ($status eq "accepted")) { + next RESET; + } + $confline = stconfig ($confline, "status", "init"); + } + } + save_config (@list); + &goodbye; +} + +############## define config ############### +sub mk_def { + if (@ARGV != 4) { &escape ("USAGE: $MKDETREND def (config.ver) (start) (stop)"); } + + $key = $ARGV[1]; + $start = $ARGV[2]; + $stop = $ARGV[3]; + + @list = load_config (); + + # find specific config: + $match = -1; + for ($i = 0; $i < @list; $i++) { + $version = gtconfig ($list[$i], "version"); + if ($key eq $version) { + $match = $i; + } + } + if (@match == -1) { + print STDERR "config.ver $key not found\n"; + &escape; + } + + $new = $list[$match]; + $new = stconfig ($new, "start", $start); + $new = stconfig ($new, "stop", $stop); + $list[$match] = $new; + + save_config (@list); + &goodbye; + +} + +############## list init ############### +sub mk_list_init { + if (@ARGV != 1) { &escape ("USAGE: $MKDETREND list.init"); } + + @list = load_config (); + + # create namelist + $Nrun = 0; + $file = mkfiles ("list"); + open (FILE, ">$file"); + foreach $confline (@list) { + $status = gtconfig ($confline, "status"); + if ($status ne "init") { next; } + $Nrun ++; + $line = gtconfig ($confline, "mosaic"); + print FILE "$line\n"; + $confline = stconfig ($confline, "status", "running.init"); + } + close (FILE); + save_config (@list); + + if ($Nrun == 0) { &goodbye; } + + vsystem ("elixir -D DETREND_DIR $det -D mode $MKDETREND -D global.pending imselect.split $file"); + system ("$MKDETREND meval init"); + + &goodbye; +} + +############## split ############### +sub mk_split { + if (@ARGV != 1) { &escape ("USAGE: $MKDETREND split"); } + + @list = load_config (); + + # create namelist + $Nrun = 0; + $file = mkfiles ("list"); + open (FILE, ">$file"); + foreach $confline (@list) { + $status = gtconfig ($confline, "status"); + if (($status ne "done.init") && ($status ne "split")) { next; } + $Nrun ++; + foreach $ccd (@ccds) { + $line = gtconfig ($confline, "chiprun", $ccd); + print FILE "$line\n"; + } + $confline = stconfig ($confline, "status", "running.split"); + } + close (FILE); + save_config (@list); + + if ($Nrun == 0) { &goodbye; } + + system ("elixir -D DETREND_DIR $det -D mode $MKDETREND -D global.pending merge.lists $file"); + system ("$MKDETREND eval split"); + + &goodbye; +} + +############## update lists ############### +sub mk_update_list { + if (@ARGV != 1) { &escape ("USAGE: $MKDETREND update.list"); } + + @list = load_config (); + + # create namelist + $Nrun = 0; + $file = mkfiles ("list"); + open (FILE, ">$file"); + foreach $confline (@list) { + $status = gtconfig ($confline, "status"); + if ($status ne "update") { next; } + $Nrun ++; + $line = gtconfig ($confline, "mosaic"); + print FILE "$line\n"; + $confline = stconfig ($confline, "status", "running.update.list"); + } + close (FILE); + save_config (@list); + + if ($Nrun == 0) { &goodbye; } + + system ("elixir -D DETREND_DIR $det -D mode $MKDETREND -D global.pending update.split $file"); + system ("$MKDETREND meval update.list"); + + &goodbye; +} + +############## update stats ############### +sub mk_update_stats { + if (@ARGV != 1) { &escape ("USAGE: $MKDETREND update.stats"); } + + @list = load_config (); + + # create namelist + $Nrun = 0; + $file = mkfiles ("list"); + open (FILE, ">$file"); + foreach $confline (@list) { + $status = gtconfig ($confline, "status"); + if (($status ne "done.update.list") && ($status ne "update.stats")) { next; } + $Nrun ++; + foreach $ccd (@ccds) { + $line = gtconfig ($confline, "chiprun", $ccd); + print FILE "$line\n"; + } + $confline = stconfig ($confline, "status", "running.update.stats"); + + } + close (FILE); + save_config (@list); + + if ($Nrun == 0) { &goodbye; } + + system ("elixir -D DETREND_DIR $det -D mode $MKDETREND -D global.pending update.msplit $file"); + system ("$MKDETREND eval update.stats"); + + &goodbye; +} + +############## set state ############### +sub mk_set { + if (@ARGV != 3) { &escape ("USAGE: $MKDETREND set (config number) (state)"); } + + @list = load_config (); + + $key = $ARGV[1]; + $state = $ARGV[2]; + + $new = stconfig ($list[$key], "status", "$state"); + $list[$key] = $new; + save_config (@list); + + &goodbye; +} + +############## flips run ############### +sub mk_flips { + if (@ARGV != 1) { &escape ("USAGE: $MKDETREND flips"); } + + @list = load_config (); + + # create namelist for those with appropriate status + $Nrun = 0; + $file = mkfiles ("list"); + open (FILE, ">$file"); + foreach $confline (@list) { + $status = gtconfig ($confline, "status"); + if (($status ne "done.split") && ($status ne "modified") && ($status ne "flips")) { next; } + $Nrun ++; + foreach $ccd (@ccds) { + $line = gtconfig ($confline, "chiprun", $ccd); + print FILE "$line\n"; + } + $confline = stconfig ($confline, "status", "running.flips"); + } + close (FILE); + save_config (@list); + + if ($Nrun == 0) { &goodbye; } + + system ("elixir -D DETREND_DIR $det -D mode $MKDETREND -D global.pending create.subset $file"); + system ("$MKDETREND eval flips"); + + &goodbye; +} + +############## norm run ############### +sub mk_norm { + if (@ARGV != 1) { &escape ("USAGE: $MKDETREND norm"); } + + @list = load_config (); + + # create namelist for those with appropriate status + $Nrun = 0; + $file = mkfiles ("list"); + open (FILE, ">$file"); + foreach $confline (@list) { + $status = gtconfig ($confline, "status"); + if (($status ne "done.flips") && ($status ne "norm")) { next; } + $Nrun ++; + foreach $ccd (@ccds) { + $line = gtconfig ($confline, "chiprun", $ccd); + print FILE "$line\n"; + } + $confline = stconfig ($confline, "status", "running.norm"); + } + close (FILE); + save_config (@list); + + if ($Nrun == 0) { &goodbye; } + + vsystem ("elixir -D DETREND_DIR $det -D mode $MKDETREND -D global.pending normal $file"); + vsystem ("$MKDETREND eval norm"); + + &goodbye; +} + +############## merge run ############### +sub mk_merge { + if (@ARGV != 1) { &escape ("USAGE: $MKDETREND merge"); } + + @list = load_config (); + + # create namelist for those with appropriate status + $Nrun = 0; + $file = mkfiles ("list"); + open (FILE, ">$file"); + foreach $confline (@list) { + $status = gtconfig ($confline, "status"); + if (($status ne "done.norm") && ($status ne "done.update.stats") && ($status ne "merge")) { next; } + $Nrun ++; + $line = gtconfig ($confline, "mosaic"); + $confline = stconfig ($confline, "status", "running.merge"); + print FILE "$line\n"; + } + close (FILE); + save_config (@list); + + if ($Nrun == 0) { &goodbye; } + + vsystem ("elixir -D DETREND_DIR $det -D mode $MKDETREND -D global.pending stats $file"); + vsystem ("$MKDETREND meval merge"); + + &goodbye; +} + +############## reg run ############### +sub mk_reg { + if (@ARGV != 1) { &escape ("USAGE: $MKDETREND reg"); } + + @list = load_config (); + + # create directory for fhtool to work in + $links = mkfiles ("links"); + if (! -e $links) { mkdir ($links); } + + # create namelist for those with appropriate status + foreach $confline (@list) { + $status = gtconfig ($confline, "status"); + if (($status ne "accepted") && ($status ne "reg")) { next; } + $confline = stconfig ($confline, "status", "running.reg"); + save_config (@list); + + $success = 1; + $ID = gtconfig ($confline, "ID"); + + $DBmode = `gconfig DETREND-DB-MODE`; chop $DBmode; + $DBmode = "\U$DBmode\E"; + + if ($DBmode eq "SPLIT") { + for ($j = 0; $j < $Nccd; $j++) { + $file = mknames ("norm", $confline, $ccds[$j]); + $line = "detregister $file -label elixir -ID $ID"; + $status = system ($line); + if ($status) { + print STDERR "error registering $file\n"; + $success = 0; + } + } + goto registered; + } + + if ($DBmode eq "MEF") { + # empty link directory: + system ("rm -f $links/*.fits"); + + # make links + foreach $ccd (@ccds) { + $file = mknames ("norm", $confline, $ccd); + $link = mknames ("link", $confline, $ccd); + symlink $file, $link; + } + + # mef, register + $mef = mknames ("mef", $confline); + if (-e $mef) { unlink $mef; } + vsystem ("fhtool -P $links $mef"); + if ($status) { $success = 0; } + vsystem ("detregister $mef -label elixir -ID $ID"); + if ($status) { $success = 0; } + + # remove links + foreach $ccd (@ccds) { + $link = mknames ("link", $confline, $ccd); + unlink $link; + } + goto registered; + } + print STDERR "DB mode not defined?\n"; + $success = 0; + + registered: + if ($success) { + $confline = stconfig ($confline, "status", "done.reg"); + } else { + print STDERR "error registering $file\n"; + $confline = stconfig ($confline, "status", "fail.reg"); + } + save_config (@list); + + } + + # use recipe file to decide if we apply 'scat' or not! + $file = mkfiles ("list"); + # create list of images to apply scattered-light correction: + foreach $confline (@list) { + $type = gtconfig ($confline, "type"); + $status = gtconfig ($confline, "status"); + if (($status ne "done.reg") && ($status ne "scat")) { next; } + + # only flats get scat correction + if ($type eq "flat") { + $ID = gtconfig ($confline, "ID"); + + open (FILE, ">$file"); + foreach $ccd (@ccds) { + $line = mknames ("norm", $confline, $ccd); + print FILE "$line\n"; + } + close (FILE); + + $confline = stconfig ($confline, "status", "running.scat"); + save_config (@list); + + $status = vsystem ("fixscat $file B.2 $ID"); + if (($status == 0) || ($status == 2 * 256)) { + $confline = stconfig ($confline, "status", "done.scat"); + } else { + $confline = stconfig ($confline, "status", "fail.scat"); + } + save_config (@list); + } + } + + foreach $confline (@list) { + $status = gtconfig ($confline, "status"); + if (($status ne "done.reg") && ($status ne "done.scat")) { next; } + $confline = stconfig ($confline, "status", "done"); + } + save_config (@list); + &goodbye; +} + +############## html modify ############### +sub mk_fixmasters { + if (@ARGV != 1) { &escape ("USAGE: $MKDETREND fix.masters"); } + + @list = load_config (); + + foreach $name (@list) { + + @mstate = (); + $master = mknames ("master", $name, $ccds[0]); + print STDERR "$master: $name\n"; + open (FILE, $master); + @master = ; + close FILE; + for ($j = 0; $j < @master; $j++) { + ($tmp, $state) = split (" ", $master[$j]); + @mstate = (@mstate, $state); + } + + # re-create all masters to match master for chip 00 + for ($i = 1; $i < $Nccd; $i++) { + + # load existing master file + $master = mknames ("master", $name, $ccds[$i]); + open (FILE, $master); + @master = ; + close FILE; + + $Nm = @master; + $Ns = @mstate; + if (@mstate != @master) { + print STDOUT "error: mis-match in image lists ccd $i\n"; + &escape; + } + + # write results back to master file + open (OUT, ">$master") or die "can't open $master"; + for ($j = 0; $j < @master; $j++) { + ($fname, $state) = split (" ", $master[$j]); + if ($state != $mstate[$j]) { print STDERR "error on $j $name\n"; } + printf OUT "%s %d\n", $fname, $mstate[$j]; + } + close (OUT); + } + } + &goodbye; +} + +############## html modify ############### +sub mk_checksplits { + if (@ARGV != 2) { &escape ("USAGE: $MKDETREND check.splits (config)"); } + + $Nconfig = $ARGV[1]; + @list = load_config (); + $name = $list[$Nconfig]; + + # re-create all masters to match master for chip 00 + foreach $ccd (@ccds) { + + # load existing master file + $master = mknames ("master", $name, $ccd); + open (FILE, $master); + @master = ; + close FILE; + + for ($j = 0; $j < @master; $j++) { + ($fname, $state) = split (" ", $master[$j]); + if (! -e $fname) { + print STDERR "missing file $fname\n"; + } + } + } + &goodbye; +} + +#### HTML cgibin functions ################ + +############## html duplicate ############### +sub mk_htmldup { + if (@ARGV != 2) { &escape ("USAGE: $MKDETREND htmldup (config)"); } + + $config = $ARGV[1]; + # we are just calling the "mkdetrend dup" function and then calling "$MKDETREND html1" + + system ("$MKDETREND dup $config"); + print STDOUT "\n"; + + &goodbye; + +} + +############## html delete ############### +sub mk_htmldel { + if (@ARGV != 2) { &escape ("USAGE: $MKDETREND htmldel (config.ver)"); } + + $config = $ARGV[1]; + # we are just calling the "mkdetrend del" function and then calling "mkdetrend html1" + + system ("$MKDETREND del $config"); + print STDOUT "\n"; + + &goodbye;; + +} + +############## html define ############### +sub mk_htmldef { + if (@ARGV != 2) { &escape ("USAGE: $MKDETREND htmldef (config.ver)"); } + + $key = $ARGV[1]; + + # find (config.ver) in list: + + @list = load_config (); + + $match = -1; + for ($i = 0; $i < @list; $i++) { + $version = gtconfig ($list[$i], "version"); + if ($key eq $version) { + $match = $i; + last; + } + } + if ($match == -1) { &escape ("error: can't find config entry"); } + + # show the complete list for reference + print STDOUT "
Elixir Mkdetrend Report
\n"; + print STDOUT "\n"; + print STDOUT "\n"; + for ($i = 0; $i < @list; $i++) { + $config = gtconfig ($list[$i], "config"); + $version = gtconfig ($list[$i], "version"); + $status = gtconfig ($list[$i], "status"); + $from = gtconfig ($list[$i], "from"); + $to = gtconfig ($list[$i], "to"); + print STDOUT "\n"; + print STDOUT "\n"; + print STDOUT "\n"; + print STDOUT "\n"; + print STDOUT "\n"; + print STDOUT "\n"; + print STDOUT "\n"; + } + print STDOUT "
$version $from $to $status split delete redefine


\n"; + + $version = gtconfig ($list[$match], "version"); + $status = gtconfig ($list[$match], "status"); + $from = gtconfig ($list[$match], "from"); + $to = gtconfig ($list[$match], "to"); + print STDOUT "redefining $key:
\n"; + print STDOUT "\n"; + print STDOUT "\n"; + print STDOUT "\n"; + print STDOUT "
$version $from $to $status
\n"; + + + # create a simple form for redefine: + print STDOUT "
\n"; + print STDOUT "start:
\n"; + print STDOUT "stop:
\n"; + print STDOUT "\n"; + print STDOUT "\n"; + print STDOUT "
\n"; + print STDOUT "\n"; + + &goodbye;; + +} + +############## html modify ############### +sub mk_htmlmod { + if (@ARGV != 1) { &escape ("USAGE: $MKDETREND htmlmod"); } + + $key = $ENV{'WWW_config'}; + $Nimage = $ENV{'WWW_Nimage'}; + + @list = load_config (); + + $match = -1; + for ($i = 0; $i < @list; $i++) { + $version = gtconfig ($list[$i], "version"); + if ($key eq $version) { + $match = $i; + last; + } + } + if ($match == -1) { &escape ("error: can't find config entry"); } + + # re-create $master to match selections + # depends on the format of data in the 'master' file + foreach $ccd (@ccds) { + + # load existing master file + $master = mknames ("master", $list[$match], $ccd); + open (FILE, $master); + @master = ; + close FILE; + + if ($Nimage != @master) { + print STDOUT "error: mis-match in image lists ccd $ccd\n"; + &escape; + } + + # write results back to master file + open (OUT, ">$master") or die "can't open $master"; + for ($j = 0; $j < @master; $j++) { + @tmpw = split (" ", $master[$j]); + $name = "WWW_image_$j"; + + $tmpw[1] = 0; + if ($ENV{$name} ne "") { $tmpw[1] = 1; } + printf OUT "%s %d\n", $tmpw[0], $tmpw[1]; + } + close (OUT); + } + # adjust the config file: convert status to 'modified' + $list[$match] = stconfig ($list[$match], "status", "modified"); + save_config (@list); + + print STDOUT "\n"; + &goodbye; +} + +############## html accept ############### +sub mk_htmlkeep { + if (@ARGV != 2) { &escape ("USAGE: $MKDETREND htmlkeep (config.ver)"); } + + $key = $ARGV[1]; + @list = load_config (); + + $match = -1; + for ($i = 0; $i < @list; $i++) { + $version = gtconfig ($list[$i], "version"); + if ($key eq $version) { + $match = $i; + last; + } + } + if ($match == -1) { + print STDERR "error: can't find config entry\n"; + &escape; + } + + # adjust the config file: convert status to 'accepted' + $list[$match] = stconfig ($list[$match], "status", "accepted"); + save_config (@list); + + print STDOUT ""; + &goodbye; +} + +############## html config ############### +sub mk_htmlconfig { + if (@ARGV != 1) { &escape ("USAGE: $MKDETREND htmlconfig"); } + + ## html headers + print STDOUT "
Elixir Mkdetrend Report
\n"; + print STDOUT "\n"; + + # create a simple form for redefine: + print STDOUT "
\n"; + if ($elconf) { + print STDOUT "enter new config:
\n"; + } else { + print STDOUT "enter new config:
\n"; + } + print STDOUT "\n"; + print STDOUT "
\n"; + print STDOUT "\n"; + + &goodbye; +} + +############## html level 1 ############### +sub mk_html1 { + if (@ARGV != 1) { &escape ("USAGE: $MKDETREND html1"); } + + @list = load_config (); + + ## html headers + print STDOUT "
Elixir Mkdetrend Report
\n"; + print STDOUT "\n"; + + print STDOUT "\n"; + for ($i = 0; $i < @list; $i++) { + $config = gtconfig ($list[$i], "config"); + $version = gtconfig ($list[$i], "version"); + $from = gtconfig ($list[$i], "from"); + $to = gtconfig ($list[$i], "to"); + $status = gtconfig ($list[$i], "status"); + print STDOUT "\n"; + print STDOUT "\n"; + print STDOUT "\n"; + print STDOUT "\n"; + print STDOUT "\n"; + print STDOUT "\n"; + print STDOUT "\n"; + } + + print STDOUT "
$version $from $to $status split delete redefine


\n"; + if ($elconf eq "") { + print STDOUT "Current Config: default
\n"; + } else { + print STDOUT "Current Config: $elconf
\n"; + } + print STDOUT "Change Config\n"; + print STDOUT "\n"; + &goodbye;; +} + +############## html level 2 ############### +sub mk_html2 { + if (@ARGV != 2) { &escape ("USAGE: $MKDETREND html2 (config.ver)"); } + + @list = load_config (); + + # entry on line will be either config.ver (== key) or config.ver.col for sorting + # grab just the key portion + $status = "none"; + ($key) = $ARGV[1] =~ /(\w+.\w+.\w+.\w+)/; # (config.ver) + $arg = $ARGV[1]; + + # find appropriate config.ver entry: + for ($i = 0; $i < @list; $i++) { + $version = gtconfig ($list[$i], "version"); + if ($key eq $version) { + $confline = $list[$i]; + $status = gtconfig ($confline, "status"); + last; + } + } + + $from = gtconfig ($confline, "from"); + $to = gtconfig ($confline, "to"); + print STDOUT "
Elixir Mkdetrend Report
\n"; + print STDOUT "\n"; + print STDOUT "
\n"; + print STDOUT "\n"; + print STDOUT "\n"; + print STDOUT "
config from to
$version $from $to
\n"; + + $master = mknames ("master", $confline, $ccds[0]); + + if ($status eq "modified") { flips_report ($arg, $confline, "modified"); } + if ($status eq "accepted") { flips_report ($arg, $confline, "accepted"); } + if ($status eq "done.merge") { flips_report ($arg, $confline, "merged"); } + if ($status eq "done.reg") { flips_report_done ($key, $confline, "registered"); } + if ($status eq "done") { flips_report_done ($key, $confline, "registered"); } + if ($status eq "clean") { flips_report ($key, $confline, "registered"); } + + if ($status eq "none") { $message = "not found"; } + if ($status eq "init") { $message = "initialized, not yet run."; } + if ($status eq "not.available") { $message = "has no images available for detrend creation."; } + + foreach $step (init, flips, norm, merge) { + if ($status eq "running.$step") { $message = "running step $step"; } + if ($status eq "fail.$step") { $message = "failed step $step"; } + if ($status eq "done.$step") { $message = "has finished $step"; } + } + + print STDOUT "config $key $message
\n"; + + print STDOUT "\n"; + open (FILE, "$master"); + while ($line = ) { + chop ($line); + @entry = split ("/", $line); + $N = @entry - 1; + print STDOUT "\n"; + } + print STDOUT "
$entry[$N]
\n"; + + print STDOUT "\n"; + &goodbye; +} + +############## html level 3 ############### +sub mk_html3 { + if (@ARGV != 2) { &escape ("USAGE: $MKDETREND html3 (entry.config.ver)"); } + + @list = load_config (); + + # extract the entry and key values from $ARGV[1] + ($entry, $key) = $ARGV[1] =~ /(\d+)\Q.\E(.*)/; + + $status = "none"; + # find appropriate config.ver entry: + for ($i = 0; $i < @list; $i++) { + $version = gtconfig ($list[$i], "version"); + if ($key eq $version) { + $confline = $list[$i]; + $status = gtconfig ($confline, "status"); + last; + } + } + + print STDOUT "
Elixir Mkdetrend Report
\n"; + print STDOUT "\n"; + + if ($status eq "none") { print STDOUT "config $key not found\n \n"; &goodbye; } + if ($status eq "init") { print STDOUT "config $key initialized, not yet run\n \n"; &goodbye; } + if ($status eq "not.available") { print STDOUT "config $key has no images available for detrend creation\n \n"; &goodbye; } + + # if ($status eq "done.update") { flips_entry ($key, $entry, $confline); } + if ($status eq "done.merge") { flips_entry ($key, $entry, $confline); } + if ($status eq "accepted") { flips_entry ($key, $entry, $confline); } + if ($status eq "modified") { flips_entry ($key, $entry, $confline); } + if ($status eq "done.reg") { flips_entry ($key, $entry, $confline); } + + foreach $step (init, flips, norm, merge) { + # print "step: $step, $status: $status\n"; + if ($status eq "running.$step") { print STDOUT "config $key running step $step \n \n"; &goodbye; } + if ($status eq "fail.$step") { print STDOUT "config $key failed step $step\n \n"; &goodbye; } + + if ($status eq "done.$step") { + print STDOUT "config $key has finished $step\n"; + + # load image names from CCD 0 list: + $master = mknames ("master", $confline, $ccds[0]); + print STDOUT "\n"; + open (FILE, "$master"); + while ($line = ) { + chop ($line); + @entry = split ("/", $line); + $N = @entry - 1; + print STDOUT "\n"; + } + print STDOUT "
$entry[$N]
\n"; + } + } + + # print STDOUT "\n"; + &goodbye; +} + +### other support commands #################### + +############## evaluate chip run ############### +sub mk_eval { + if (@ARGV != 2) { &escape ("USAGE: $MKDETREND eval (step)"); } + + $step = $ARGV[1]; + @list = load_config (); + + # load success fifo info: + $file = `gconfig -D mode $MKDETREND global.success`; chop $file; + open (FILE, "$file"); + @success = ; + close (FILE); + + # load failure fifo info: + $file = `gconfig -D mode $MKDETREND global.failure`; chop $file; + open (FILE, "$file"); + @failure = ; + close (FILE); + + # entry must be in state 'running.$step' + # possible states: + # 1 all 12 chips in success == done.$step + # 2 any chips in failure == fail.$step + # 3 any chips missing == fail.$step + # 4 any chips in failure, merge.list == not.available (only for $step eq init) + # valid steps: init flips norm + + CONFIG: + foreach $confline (@list) { + $status = gtconfig ($confline, "status"); + if ($status ne "running.$step") { next; } + $state = 1; + + CCD: + foreach $ccd (@ccds) { + $entry = gtconfig ($confline, "chiprun", $ccd); + + # search for entry in success fifo: + foreach $value (@success) { + if ($value =~ /^$entry/) { next CCD; } + } + + # search for entry in failure fifo: note the special ending state for 'init' + foreach $value (@failure) { + if ($value =~ /^$entry/) { + $state = 2; + if ($step eq "split") { + ($status) = $value =~ /$entry\s+\S+\s+(\S+)/; + if ($status eq "merge.lists") { + $state = 4; + } + } + last CCD; + } + } + + # if we make it here, it wasn't in either fifo.success or fifo.failure... + $state = 3; + last CCD; + } + + if ($state == 1) { $confline = stconfig ($confline, "status", "done.$step"); } + if ($state == 2) { $confline = stconfig ($confline, "status", "fail.$step"); } + if ($state == 3) { $confline = stconfig ($confline, "status", "fail.$step"); } + if ($state == 4) { $confline = stconfig ($confline, "status", "not.available"); } + } + save_config (@list); + + system ("$MKDETREND state"); + &goodbye; +} + +############## evaluate mosaic run ############### +sub mk_meval { + if (@ARGV != 2) { &escape ("USAGE: $MKDETREND meval (step)"); } + + $step = $ARGV[1]; + @list = load_config (); + + # load success fifo info: + $file = `gconfig -D mode $MKDETREND global.success`; chop $file; + open (FILE, "$file"); + @success = ; + close (FILE); + + # load failure fifo info: + $file = `gconfig -D mode $MKDETREND global.failure`; chop $file; + open (FILE, "$file"); + @failure = ; + close (FILE); + + # entry must be in state 'running.$step' + # possible states: + # 1 entry in success == done.$step + # 2 entry in failure == fail.$step + # 3 entry missing == fail.$step + # valid steps: merge + + foreach $confline (@list) { + $status = gtconfig ($confline, "status"); + if ($status ne "running.$step") { next; } + $state = 3; + $entry = gtconfig ($confline, "mosaic"); + + MCHECK: + { + foreach $value (@success) { + if ($value =~ /^$entry/) { + $state = 1; + last MCHECK; + } + } + + foreach $value (@failure) { + if ($value =~ /^$entry/) { + $state = 2; + next MCHECK; + } + } + } + + if ($state == 1) { $confline = stconfig ($confline, "status", "done.$step"); } + if ($state == 2) { $confline = stconfig ($confline, "status", "fail.$step"); } + if ($state == 3) { $confline = stconfig ($confline, "status", "fail.$step"); } + } + + save_config (@list); + system ("$MKDETREND state"); + + &goodbye; +} + +############## html for dads ############### +sub mk_dads { + if (@ARGV != 2) { &escape ("USAGE: $MKDETREND dads (config.ver)"); } + + # options: mkdetrend dads (config.ver) + # return all relevant images (jpegs) for given config.ver + + @list = load_config (); + + # entry on line will be either config.ver (== key) or config.ver.col for sorting + # grab just the key portion + $status = "none"; + $arg = $ARGV[1]; + ($key) = $arg =~ /(\w+.\w+.\w+.\w+)/; # (config.ver) + + # find appropriate config.ver entry: + for ($i = 0; $i < @list; $i++) { + $version = gtconfig ($list[$i], "version"); + if ($key eq $version) { + $confline = $list[$i]; + $status = gtconfig ($confline, "status"); + last; + } + } + if (!$confline) { &escape ("$key not found"); } + + # only print for config.ver entries which are ready (done, clean) + if (($status ne "done") && ($status ne "clean")) { + &escape ("$version is not ready for release by Elixir"); + } + + # parse config entry and get data from appropriate files + $from = gtconfig ($confline, "from"); + $to = gtconfig ($confline, "to"); + open (STAT, mknames ("stats", $confline)); @statdata = ; close (STAT); + open (MED, mknames ("medbin", $confline)); @medndata = ; close (MED); + open (TEN, mknames ("tenbin", $confline)); @tenndata = ; close (TEN); + open (MASTER, mknames ("master", $confline, $ccds[0])); @mastdata = ; close (MASTER); + + $tmpname = mknames ("master", $confline, $ccds[0]); + + # get stats from the stats & master files + $Nkeep = 0; + $Ncnt = 0; + $Sigma = 0; + $Nimage = @statdata; + for ($i = 0; $i < $Nimage; $i++) { + @tmpw = split (" ", $mastdata[$i]); + @tmps = split (" ", $statdata[$i]); + if ($tmpw[1]) { $Nkeep++; $Ncnt += $tmps[3]; $Sigma += $tmps[8]*$tmps[8]; } + } + $imbin = mknames ("dads.imbin", $confline); + + ($start, $stop, $mode) = &load_dates; + print STDOUT "$imbin $Nimage $start $stop\n"; + + $dir = mkfiles ("html"); + # create the image-by-image table lines + for ($i = 0; $i < $Nimage; $i++) { + @word = split (" ", $statdata[$i]); + $used = $word[12]; + $dawn = $word[11]; + + @tmpw = split (" ", $mastdata[$i]); + $keep = $tmpw[1]; + + # data files contain the complete path, but this may have changed + # replace path with mkfiles ("html") -> $dir + @tmpw = split ('/', $tenndata[$i]); + $tenimg = "$dir/$tmpw[-1]"; chop $tenimg; + @tmpw = split ('/', $medndata[$i]); + $medimg = "$dir/$tmpw[-1]"; chop $medimg; + + print STDOUT "$tenimg $medimg $word[0] $word[1] $dawn $word[2] $word[3] $word[5] $word[6] $word[8] $used\n"; + } + &goodbye; +} + +############## html for dads ############### +sub mk_dads_html { + if (@ARGV != 2) { &escape ("USAGE: $MKDETREND dads (config.ver)"); } + + @list = load_config (); + + # entry on line will be either config.ver (== key) or config.ver.col for sorting + # grab just the key portion + $status = "none"; + $arg = $ARGV[1]; + ($key) = $arg =~ /(\w+.\w+.\w+.\w+)/; # (config.ver) + + # find appropriate config.ver entry: + for ($i = 0; $i < @list; $i++) { + $version = gtconfig ($list[$i], "version"); + if ($key eq $version) { + $confline = $list[$i]; + $status = gtconfig ($confline, "status"); + last; + } + } + + print STDOUT "
Elixir Mkdetrend Report
\n"; + print STDOUT "\n"; + + # only print for config.ver entries which are ready + if ($status ne "done.reg") { &escape ("$version is not ready for release by Elixir"); } + + # parse config entry and get data from appropriate files + $from = gtconfig ($confline, "from"); + $to = gtconfig ($confline, "to"); + open (STAT, mknames ("stats", $confline)); @statdata = ; close (STAT); + open (MED, mknames ("medbin", $confline)); @medndata = ; close (MED); + open (TEN, mknames ("tenbin", $confline)); @tenndata = ; close (TEN); + open (MASTER, mknames ("master", $confline, $ccds[0])); @mastdata = ; close (MASTER); + + $tmpname = mknames ("master", $confline, $ccds[0]); + + # get stats from the stats & master files + $Nkeep = 0; + $Ncnt = 0; + $Sigma = 0; + $Nimage = @statdata; + for ($i = 0; $i < $Nimage; $i++) { + @tmpw = split (" ", $mastdata[$i]); + @tmps = split (" ", $statdata[$i]); + if ($tmpw[1]) { $Nkeep++; $Ncnt += $tmps[3]; $Sigma += $tmps[8]*$tmps[8]; } + } + $Sigma = sprintf "%5.3f", 100*sqrt ($Sigma/$Nkeep); + + print STDOUT "
\n"; + print STDOUT "\n"; + print STDOUT "\n"; + print STDOUT "
config from to
$version $from $to
\n"; + + $imbin = mknames ("dads.imbin", $confline); + print STDOUT "
\n"; + print STDOUT "this config has been created by Elixir.
\n"; + print STDOUT "there are $Nimage images, $Nkeep used.
\n"; + print STDOUT "Total Counts: $Ncnt
r.m.s. median sigma: $Sigma%

\n"; + print STDOUT "
\n"; + + print STDOUT "
Statistics on each available input image.
+ Time is in UT, light background means dawn, grey means dusk.\n"; + + print STDOUT "\n"; + print STDOUT "\n"; + print STDOUT "\n"; + print STDOUT "\n"; + print STDOUT "\n"; + print STDOUT "\n"; + print STDOUT "\n"; + print STDOUT "\n"; + print STDOUT "\n"; + print STDOUT "\n"; + print STDOUT "\n"; + + # sort the list by image seq number + @order = (); + for ($i = 0; $i < $Nimage; $i++) { @order = (@order, $i); } + $col = 0; + @entry = sort by_col @order; + + # create the image-by-image table lines + for ($i = 0; $i < $Nimage; $i++) { + $N = $entry[$i]; + + @word = split (" ", $statdata[$N]); + $used = $word[12]; + $dawn = $word[11]; + + @tmpw = split (" ", $mastdata[$N]); + $keep = $tmpw[1]; + + @tmpw = split ("/", $medndata[$N]); + $medname = $tmpw[-1]; + + @tmpw = split ("/", $tenndata[$N]); + $tenname = $tmpw[-1]; + + print STDOUT "\n"; + if ($dawn) { print STDOUT "\n"; } + else { print STDOUT "\n"; } + print STDOUT "\n"; + print STDOUT "\n"; + print STDOUT "\n"; + if ($used) { print STDOUT "\n"; } + else { print STDOUT "\n"; } + print STDOUT "\n\n"; + } + + print STDOUT "
image Date Time Mean Sigma (raw) Sigma (clipped) Sigma (med) image used?
$word[0] $word[1] $word[2] $word[2] $word[3] $word[5] $word[6] $word[8] yesno
\n"; + &goodbye; +} + +############## dads level 1 ############### +sub mk_dads_top { + if (@ARGV != 1) { &escape ("USAGE: $MKDETREND dads.top"); } + + @list = load_config (); + + ## html headers + print STDOUT "
Elixir Mkdetrend Report
\n"; + print STDOUT "\n"; + + print STDOUT "\n"; + for ($i = 0; $i < @list; $i++) { + $config = gtconfig ($list[$i], "config"); + $version = gtconfig ($list[$i], "version"); + $from = gtconfig ($list[$i], "from"); + $to = gtconfig ($list[$i], "to"); + $status = gtconfig ($list[$i], "status"); + print STDOUT "\n"; + print STDOUT "\n"; + print STDOUT "\n"; + print STDOUT "\n"; + } + + print STDOUT "
$version $from $to $status
\n"; + &goodbye;; + +} + +sub by_col { + @word = split (" ", $statdata[$a]); $va = $word[$col]; + @word = split (" ", $statdata[$b]); $vb = $word[$col]; + $va <=> $vb; +} + +sub flips_report { + + $col = 0; + ($type) = $_[0] =~ /\w+.(\w+).\w+/; + ($config) = $_[0] =~ /(\w+.\w+.\w+)/; + ($key) = $_[0] =~ /(\w+.\w+.\w+.\w+)/; # (config.ver) + + # look for optional sort key (config.ver[.key]) + if ($_[0] =~ /$key.(\d+)/) { + ($col) = $_[0] =~ /$key.(\d+)/; + } else { + $col = 0; + } + + $line = $_[1]; + $message = $_[2]; + + open (FILE, mknames ("stats", $line)); @statdata = ; close (FILE); + open (FILE, mknames ("medbin", $line)); @medndata = ; close (FILE); + open (FILE, mknames ("master", $line, $ccds[0])); @mastdata = ; close (FILE); + + $Nkeep = 0; + $Ncnt = 0; + $Sigma = 0; + $Nimage = @statdata; + for ($i = 0; $i < $Nimage; $i++) { + @tmpw = split (" ", $mastdata[$i]); + @tmps = split (" ", $statdata[$i]); + if ($tmpw[1]) { $Nkeep++; $Ncnt += $tmps[3]; $Sigma += $tmps[8]*$tmps[8]; } + } + if ($Nkeep > 0) { + if ($type eq "flat") { + $Sigma = sprintf "%5.3f", 100*sqrt ($Sigma/$Nkeep); + $statline = "Total Counts: $Ncnt
r.m.s. median sigma: $Sigma%

\n"; + } else { + $Sigma = sprintf "%5.3f", sqrt ($Sigma/$Nkeep); + $Ncnt = sprintf "%5.3f", ($Ncnt / $Nkeep); + $statline = "Mean Counts: $Ncnt
r.m.s. median sigma: $Sigma

\n"; + } + } else { + $statline = ""; + } + + $imbin = mknames ("imbin", $line); + print STDOUT "
\n"; + print STDOUT "this config has been $message.
\n"; + print STDOUT "there are $Nimage images, $Nkeep used.
\n"; + print STDOUT "$statline\n"; + print STDOUT "you have the following choices:
\n"; + print STDOUT " return to top level
\n"; + print STDOUT " split config
\n"; + print STDOUT " accept config
\n"; + print STDOUT "
\n"; + + print STDOUT "
\n"; + + print STDOUT "
Statistics on each available input image.
+ Time is in UT, light background means dawn, grey means dusk. Click + on the column heading to sort by that entry\n"; + + print STDOUT "\n"; + print STDOUT "\n"; + print STDOUT "\n"; + print STDOUT "\n"; + print STDOUT "\n"; + print STDOUT "\n"; + print STDOUT "\n"; + print STDOUT "\n"; + print STDOUT "\n"; + print STDOUT "\n"; + print STDOUT "\n"; + print STDOUT "\n\n"; + + @order = (); + for ($i = 0; $i < $Nimage; $i++) { @order = (@order, $i); } + + @entry = sort by_col @order; + + for ($i = 0; $i < $Nimage; $i++) { + $N = $entry[$i]; + + @word = split (" ", $statdata[$N]); + $used = $word[12]; + $dawn = $word[11]; + + @tmpw = split (" ", $mastdata[$N]); + $keep = $tmpw[1]; + + @tmpw = split ("/", $medndata[$N]); + $medname = $tmpw[-1]; + + print STDOUT "\n"; + if ($dawn) { print STDOUT "\n"; } + else { print STDOUT "\n"; } + print STDOUT "\n"; # mean + print STDOUT "\n"; # Sigma (raw) + print STDOUT "\n"; # Sigma (clip) + print STDOUT "\n"; # Sigma (med) + print STDOUT "\n"; + if ($used) { print STDOUT "\n"; } + else { print STDOUT "\n"; } + if ($keep) { print STDOUT "\n\n"; } + else { print STDOUT "\n\n"; } + + } + + print STDOUT "
image Date Time Mean Sigma (raw) Sigma (clipped) Sigma (med) image used? keep?
$word[0] $word[1] $word[2] $word[2] $word[3] $word[5] $word[6] $word[8] \n"; + print STDOUT "yesno
\n"; + print STDOUT "\n"; + print STDOUT "\n"; + print STDOUT "\n"; + print STDOUT "\n"; + # print STDOUT "
\n"; + print STDOUT "stop:
\n"; + print STDOUT "\n"; + print STDOUT "\n"; + print STDOUT "
\n"; + print STDOUT "\n"; + + &goodbye; +} + +############## html modify ############### +sub mk_htmlmod { + + if (@ARGV != 1) { &escape ("USAGE: $MKFRINGE htmlmod"); } + + # images which are marked for exclusion are included in the + # environment variable as $WWW_image_NN -- NN = sequence number + # in the master / defringe file + + $key = $ENV{'WWW_config'}; + $Nimage = $ENV{'WWW_Nimage'}; + + @list = load_config (); + + $match = -1; + for ($i = 0; $i < @list; $i++) { + $version = gtconfig ($list[$i], "version"); + if ($key eq $version) { + $match = $i; + last; + } + } + if ($match == -1) { &escape ("ERROR: can't find config entry"); } + + # change status entry in master list & $HTML.imstats + $HTML = mkfiles ("html"); + $imstat = "$HTML/$version.imstats"; + $master = mknames ("master", $list[$match]); + + # load data from master list + open (FILE, "$master"); + @master = ; + close (FILE); + if ($Nimage != @master) { &escape ("mis-match in image list lengths"); } + + # load data from imstats list + open (FILE, "$imstat"); + @imstat = ; + close (FILE); + if ($Nimage != @imstat) { &escape ("mis-match in image list lengths"); } + + for ($i = 0; $i < @master; $i++) { + chop ($master[$i]); + chop ($imstat[$i]); + ($path, $root, $mode, $status) = split (" ", $master[$i]); + $name = "WWW_image_$i"; + $newstatus = $status; + if ($ENV{$name} eq "") { + $hstatus = 0; + if (($status == 0) || ($status == 1)) { $newstatus = 0; } + if (($status == 2) || ($status == 3)) { $newstatus = 2; } + } else { + $hstatus = 1; + if (($status == 0) || ($status == 1)) { $newstatus = 1; } + if (($status == 2) || ($status == 3)) { $newstatus = 3; } + } + $master[$i] = "$path $root $mode $newstatus"; + ($line, $status) = $imstat[$i] =~ m|(\s*\S+\s+\S+\s+\S+\s+\S+\s+\S+\s+\S+\s+\S+\s+\S+\s+\S+\s+\S+\s+)(\S)|; + $imstat[$i] = "$line $hstatus"; + } + + # save master list + open (FILE, ">$master"); + foreach $line (@master) { print FILE "$line\n"; } + close (FILE); + + # save imstats list + open (FILE, ">$imstat"); + foreach $line (@imstat) { print FILE "$line\n"; } + close (FILE); + + print STDOUT "\n"; + + # adjust the config file: convert status to 'modified' + $list[$match] = stconfig ($list[$match], "status", "modified"); + save_config (@list); + &goodbye; + +} + +############## html changes modes ############### +sub mk_htmlmodes { + + if (@ARGV != 1) { &escape ("USAGE: $MKFRINGE htmlmodes"); } + + # modes which are marked for exclusion are included in the + # environment variable as $WWW_mode_NN -- NN = sequence number + + $key = $ENV{'WWW_config'}; + $Nmode = $ENV{'WWW_Nmode'}; + + @list = load_config (); + + $match = -1; + for ($i = 0; $i < @list; $i++) { + $version = gtconfig ($list[$i], "version"); + if ($key eq $version) { + $match = $i; + last; + } + } + if ($match == -1) { &escape ("ERROR: can't find config entry"); } + + $modelist = mknames ("modelist", $list[$match]); + open (FILE, "$modelist"); + @inlist = ; + close (FILE); + + open (FILE, ">$modelist"); + for ($i = 0; $i < @inlist; $i++) { + ($N, $status) = split (" ", $inlist[$i]); + if ($i < $Nmode) { + $name = "WWW_mode_$i"; + $newstatus = $status; + if ($ENV{$name} eq "") { + $newstatus = 0; + } else { + $newstatus = 1; + } + } else { + $newstatus = 0; + } + print FILE "$i $newstatus\n"; + } + close (FILE); + + print STDOUT "\n"; + + # adjust the config file: convert status to 'modified' + $list[$match] = stconfig ($list[$match], "status", "modified.map"); + save_config (@list); + &goodbye; +} + +############## html changes modes ############### +sub mk_htmlmaps { + + if (@ARGV != 1) { &escape ("USAGE: $MKFRINGE htmlmaps"); } + + # maps which are marked for inclusion are given in the + # environment variable as $WWW_mode_NN -- NN = sequence number + + $key = $ENV{'WWW_config'}; + $Nmaps = $ENV{'WWW_Nmaps'}; + + @list = load_config (); + + $match = -1; + for ($i = 0; $i < @list; $i++) { + $version = gtconfig ($list[$i], "version"); + if ($key eq $version) { + $match = $i; + last; + } + } + if ($match == -1) { &escape ("ERROR: can't find config entry"); } + + $maplist = mknames ("maplist", $list[$match]); + open (FILE, "$maplist"); + @inlist = ; + close (FILE); + + open (FILE, ">$maplist"); + for ($i = 0; $i < @inlist; $i++) { + ($Name, $status) = split (" ", $inlist[$i]); + $name = "WWW_map_$i"; + $newstatus = $status; + if ($ENV{$name} eq "") { + $newstatus = 0; + } else { + $newstatus = 1; + } + print FILE "$Name $newstatus\n"; + } + close (FILE); + + print STDOUT "\n"; + + # adjust the config file: convert status to 'modified' + $list[$match] = stconfig ($list[$match], "status", "modified.map"); + save_config (@list); + &goodbye; +} + +############## html accept ############### +sub mk_htmlkeep { + + if (@ARGV != 2) { &escape ("USAGE: $MKFRINGE htmlkeep (config.ver)"); } + + $key = $ARGV[1]; + @list = load_config (); + + $match = -1; + for ($i = 0; $i < @list; $i++) { + $version = gtconfig ($list[$i], "version"); + if ($key eq $version) { + $match = $i; + last; + } + } + if ($match == -1) { &escape ("ERROR: can't find config entry"); } + + # adjust the config file: convert status to 'accepted' + $list[$match] = stconfig ($list[$match], "status", "accepted"); + save_config (@list); + + print STDOUT ""; + &goodbye; +} + +############## html accept ############### +sub mk_htmlmapkeep { + + if (@ARGV != 2) { &escape ("USAGE: $MKFRINGE htmlmapkeep (config.ver)"); } + + $key = $ARGV[1]; + @list = load_config (); + + $match = -1; + for ($i = 0; $i < @list; $i++) { + $version = gtconfig ($list[$i], "version"); + if ($key eq $version) { + $match = $i; + last; + } + } + if ($match == -1) { &escape ("ERROR: can't find config entry"); } + + # adjust the config file: convert status to 'accepted' + $list[$match] = stconfig ($list[$match], "status", "accept.map"); + save_config (@list); + + print STDOUT ""; + &goodbye; +} + +############## html config ############### +sub mk_htmlconfig { + + if (@ARGV != 1) { &escape ("USAGE: mkdetrend htmlconfig"); } + + ## html headers + print STDOUT "
Elixir Mkdetrend Report
\n"; + print STDOUT "\n"; + + # create a simple form for redefine: + print STDOUT "
\n"; + if ($elconf) { + print STDOUT "enter new config:
\n"; + } else { + print STDOUT "enter new config:
\n"; + } + print STDOUT "\n"; + print STDOUT "
\n"; + print STDOUT "\n"; + + &goodbye; +} + +############## html level 1 ############### +sub mk_html1 { + + + if (@ARGV != 1) { &escape ("USAGE: $MKFRINGE html1"); } + + @list = load_config (); + + ## html headers + print STDOUT "
Elixir Mkfringe Report
\n"; + print STDOUT "\n"; + + print STDOUT "\n"; + for ($i = 0; $i < @list; $i++) { + $config = gtconfig ($list[$i], "config"); + $version = gtconfig ($list[$i], "version"); + $from = gtconfig ($list[$i], "from"); + $to = gtconfig ($list[$i], "to"); + $status = gtconfig ($list[$i], "status"); + print STDOUT "\n"; + print STDOUT "\n"; + print STDOUT "\n"; + print STDOUT "\n"; + print STDOUT "\n"; + print STDOUT "\n"; + print STDOUT "\n"; + } + + print STDOUT "
$version $from $to $status split delete redefine

\n"; + if ($elconf eq "") { + print STDOUT "Current Config: default
\n"; + } else { + print STDOUT "Current Config: $elconf
\n"; + } + print STDOUT "Change Config\n"; + print STDOUT "\n"; + &goodbye; + +} + + + +############## html level 2 ############### +sub mk_html2 { + + if (@ARGV != 2) { + print STDERR "USAGE: $MKFRINGE html2 (config.ver)\n"; + &goodbye; + } + + @list = load_config (); + + # config: run.type.filter + # key: run.type.filter.ver + # key.col run.type.filter.ver.column + # the words in config and key may consist of alphanumeric plus '_', '-' + # the words in col number be digits + + # entry on line will be either config.ver (== key) or config.ver.col for sorting + # grab just the key portion + $status = "none"; + ($key) = $ARGV[1] =~ /([-\w]+\.[-\w]+\.[-\w]+\.[-\w]+)/; # (config.ver) + $arg = $ARGV[1]; + + # find appropriate config.ver entry: + for ($i = 0; $i < @list; $i++) { + $version = gtconfig ($list[$i], "version"); + if ($key eq $version) { + $confline = $list[$i]; + $status = gtconfig ($confline, "status"); + last; + } + } + + $from = gtconfig ($confline, "from"); + $to = gtconfig ($confline, "to"); + print STDOUT "
Elixir Mkfringe Report
\n"; + print STDOUT "\n"; + print STDOUT "
\n"; + print STDOUT "\n"; + print STDOUT "\n"; + print STDOUT "
config from to status
$version $from $to $status
\n"; + + if ($status eq "modified") { flips_report ($arg, $confline, "modified"); } + if ($status eq "accepted") { flips_report ($arg, $confline, "accepted"); } + if ($status eq "done.merge") { flips_report ($arg, $confline, "merged"); } + if ($status eq "done.prep") { flips_report ($arg, $confline, "prepped"); } + if ($status eq "done.reg") { flips_report ($key, $confline, "registered"); } + if ($status eq "done") { flips_report ($key, $confline, "done"); } + + if ($status eq "done.map") { map_report ($arg, $confline, "mapped"); } + if ($status eq "modified.map") { map_report ($arg, $confline, "mapped"); } + + if ($status eq "none") { $message = "not found"; } + if ($status eq "init") { $message = "initialized, not yet run."; } + if ($status eq "not.available") { $message = "has no images available for detrend creation."; } + + foreach $step (init, flips, norm, merge) { + if ($status eq "running.$step") { $message = "running step $step"; } + if ($status eq "fail.$step") { $message = "failed step $step"; } + if ($status eq "done.$step") { $message = "has finished $step"; } + } + + print STDOUT "config $key $message
\n"; + + $master = mknames ("master", $confline); + print STDOUT "\n"; + open (FILE, "$master"); + while ($line = ) { + chop ($line); + @entry = split ("/", $line); + $N = @entry - 1; + print STDOUT "\n"; + } + print STDOUT "
$entry[$N]
\n"; + + # print STDOUT "\n"; + &goodbye; + print STDOUT "
"; +} + + + +############## html level 3 ############### +sub mk_html3 { + + if (@ARGV != 3) { + print STDERR "USAGE: $MKFRINGE html3 (entry.config.ver) (mode)\n"; + &goodbye; + } + + @list = load_config (); + + # extract the entry and key values from $ARGV[1] + ($entry, $key) = $ARGV[1] =~ /(\d+)\Q.\E(.*)/; + $mode = $ARGV[2]; + + $status = "none"; + # find appropriate config.ver entry: + for ($i = 0; $i < @list; $i++) { + $version = gtconfig ($list[$i], "version"); + if ($key eq $version) { + $confline = $list[$i]; + $status = gtconfig ($confline, "status"); + last; + } + } + + print STDOUT "
Elixir Mkfringe Report
\n"; + print STDOUT "\n"; + + if ($status eq "none") { print STDOUT "config $key not found\n \n"; &goodbye; } + if ($status eq "init") { print STDOUT "config $key initialized, not yet run\n \n"; &goodbye; } + if ($status eq "not.available") { print STDOUT "config $key has no images available for detrend creation\n \n"; &goodbye; } + + if ($status eq "done.prep") { flips_entry ($key, $entry, $confline, $mode); } + if ($status eq "done.merge") { flips_entry ($key, $entry, $confline, $mode); } + if ($status eq "accepted") { flips_entry ($key, $entry, $confline, $mode); } + if ($status eq "modified") { flips_entry ($key, $entry, $confline, $mode); } + if ($status eq "done.reg") { flips_entry ($key, $entry, $confline, $mode); } + if ($status eq "done") { flips_entry ($key, $entry, $confline, $mode); } + + foreach $step (init, flips, norm, merge) { + # print "step: $step, $status: $status\n"; + if ($status eq "running.$step") { print STDOUT "config $key running step $step \n \n"; &goodbye; } + if ($status eq "fail.$step") { print STDOUT "config $key failed step $step\n \n"; &goodbye; } + + if ($status eq "done.$step") { + print STDOUT "config $key has finished $step\n"; + + # load image names from CCD 0 list: + $master = mknames ("master", $confline, "00"); + print STDOUT "\n"; + open (FILE, "$master"); + while ($line = ) { + chop ($line); + @entry = split ("/", $line); + $N = @entry - 1; + print STDOUT "\n"; + } + print STDOUT "
$entry[$N]
\n"; + } + } + + # print STDOUT "\n"; + &goodbye; +} + +$dadswww = "img"; + + +############## html for dads ############### +sub mk_dads { + + if (@ARGV != 2) { + print STDERR "USAGE: $MKFRINGE dads (config.ver)\n"; + &goodbye; + } + + @list = load_config (); + + # entry on line will be either config.ver (== key) or config.ver.col for sorting + # grab just the key portion + $status = "none"; + $arg = $ARGV[1]; + ($key) = $arg =~ /([-\w]+\.[-\w]+\.[-\w]+\.[-\w]+)/; # (config.ver) + + # find appropriate config.ver entry: + for ($i = 0; $i < @list; $i++) { + $version = gtconfig ($list[$i], "version"); + if ($key eq $version) { + $confline = $list[$i]; + $status = gtconfig ($confline, "status"); + last; + } + } + + print STDOUT "
Elixir Mkfringe Report
\n"; + print STDOUT "\n"; + + # only print for config.ver entries which are ready + if ($status ne "done") { + &escape ("$version is not ready for release by Elixir"); + } + + # parse config entry and get data from appropriate files + $from = gtconfig ($confline, "from"); + $to = gtconfig ($confline, "to"); + open (STAT, mknames ("stats", $confline)); @statdata = ; close (STAT); + open (MED, mknames ("medbin", $confline)); @medndata = ; close (MED); + open (TEN, mknames ("tenbin", $confline)); @tenndata = ; close (TEN); + open (MASTER, mknames ("master", $confline, 0)); @mastdata = ; close (MASTER); + + $tmpname = mknames ("master", $confline, 0); + + # get stats from the stats & master files + $Nkeep = 0; + $Ncnt = 0; + $Sigma = 0; + $Nimage = @statdata; + for ($i = 0; $i < $Nimage; $i++) { + @tmpw = split (" ", $mastdata[$i]); + @tmps = split (" ", $statdata[$i]); + if ($tmpw[1]) { $Nkeep++; $Ncnt += $tmps[3]; $Sigma += $tmps[8]*$tmps[8]; } + } + $Sigma = sprintf "%5.3f", 100*sqrt ($Sigma/$Nkeep); + + print STDOUT "
\n"; + print STDOUT "\n"; + print STDOUT "\n"; + print STDOUT "
config from to
$version $from $to
\n"; + + $imbin = mknames ("dads.imbin", $confline); + print STDOUT "
\n"; + print STDOUT "this config has been created by Elixir.
\n"; + print STDOUT "there are $Nimage images, $Nkeep used.
\n"; + print STDOUT "Total Counts: $Ncnt
r.m.s. median sigma: $Sigma%

\n"; + print STDOUT "
\n"; + + print STDOUT "
Statistics on each available input image.
+ Time is in UT, light background means dawn, grey means dusk.\n"; + + print STDOUT "\n"; + print STDOUT "\n"; + print STDOUT "\n"; + print STDOUT "\n"; + print STDOUT "\n"; + print STDOUT "\n"; + print STDOUT "\n"; + print STDOUT "\n"; + print STDOUT "\n"; + print STDOUT "\n"; + print STDOUT "\n"; + + # sort the list by image seq number + @order = (); + for ($i = 0; $i < $Nimage; $i++) { @order = (@order, $i); } + $col = 0; + @entry = sort by_col @order; + + # create the image-by-image table lines + for ($i = 0; $i < $Nimage; $i++) { + $N = $entry[$i]; + + @word = split (" ", $statdata[$N]); + $used = $word[12]; + $dawn = $word[11]; + + @tmpw = split (" ", $mastdata[$N]); + $keep = $tmpw[1]; + + @tmpw = split ("/", $medndata[$N]); + $medname = $tmpw[-1]; + + @tmpw = split ("/", $tenndata[$N]); + $tenname = $tmpw[-1]; + + print STDOUT "\n"; + if ($dawn) { print STDOUT "\n"; } + else { print STDOUT "\n"; } + print STDOUT "\n"; + print STDOUT "\n"; + print STDOUT "\n"; + if ($used) { print STDOUT "\n"; } + else { print STDOUT "\n"; } + print STDOUT "\n\n"; + } + + print STDOUT "
image Date Time Mean Sigma (raw) Sigma (clipped) Sigma (med) image used?
$word[0] $word[1] $word[2] $word[2] $word[3] $word[4] $word[6] $word[8] yesno
\n"; + &goodbye; +} + + + +############## html level 1 ############### +sub mk_dads_top { + + if (@ARGV != 1) { + print STDERR "USAGE: $MKFRINGE dads.top\n"; + &goodbye; + } + + @list = load_config (); + + ## html headers + print STDOUT "
Elixir Mkfringe Report
\n"; + print STDOUT "\n"; + + print STDOUT "\n"; + for ($i = 0; $i < @list; $i++) { + $config = gtconfig ($list[$i], "config"); + $version = gtconfig ($list[$i], "version"); + $from = gtconfig ($list[$i], "from"); + $to = gtconfig ($list[$i], "to"); + $status = gtconfig ($list[$i], "status"); + print STDOUT "\n"; + print STDOUT "\n"; + print STDOUT "\n"; + print STDOUT "\n"; + } + + print STDOUT "
$version $from $to $status
\n"; + &goodbye; + +} + +sub by_col { + @word = split (" ", $statdata[$a]); $va = $word[$col]; + @word = split (" ", $statdata[$b]); $vb = $word[$col]; + $va <=> $vb; +} + +sub flips_report { + + $col = 0; + ($config) = $_[0] =~ /([-\w]+\.[-\w]+\.[-\w]+)/; + ($key) = $_[0] =~ /([-\w]+\.[-\w]+\.[-\w]+\.[-\w]+)/; # (config.ver) + + # look for optional sort key (config.ver[.key]) + if ($_[0] =~ /$key.(\d+)/) { + ($col) = $_[0] =~ /$key.(\d+)/; + } else { + $col = 0; + } + + $line = $_[1]; + $message = $_[2]; + + # list files: VERSION.imstats, VERSION.med.medbin.list, VERSION.med.tenbin.list, VERSION.def.medbin.list VERSION.def.tenbin.list + + $root = mknames ("htmlroot", $line); + open (FILE, "$root.imstats"); @statdata = ; close (FILE); + open (FILE, "$root.med.medbin.list"); @meddata = ; close (FILE); + open (FILE, "$root.def.medbin.list"); @defdata = ; close (FILE); + +# format of statdata file: +# OBS DATE TIME SKY FLUX FR1 dFR1 FR2 dFR2 stat keep +# 606363 2001-10-09 10:21:15.62 12455.7 20.76 246.9 84.0 N/A N/A 1 1 + + $Nkeep = 0; + $Ncnt = 0; + $Resid = 0; + $fResid = 0; + $Nimage = @statdata; + for ($i = 0; $i < $Nimage; $i++) { + @tmp = split (" ", $statdata[$i]); + if ($tmp[9]) { $Nkeep++; $Ncnt += $tmp[3]; } + $Resid += $tmp[8]; + $fResid += $tmp[8] / $tmp[3]; + } + if ($Nimage > 0) { $Resid = $Resid / $Nimage; } + if ($Nimage > 0) { $fResid = $fResid / $Nimage; } + $Resid = sprintf "%7.3f", $Resid; + $fResid = sprintf "%7.3f", $fResid; + + # $imbin = mknames ("dads.imbin", $line); + print STDOUT ""; + if (-e "$root.medbin.jpg") { + @tmpw = split ("/", "$root.medbin.jpg"); + $imname = "$www/$tmpw[-1]"; + print STDOUT "\n"; + } + print STDOUT "
\n"; + print STDOUT "this config has been $message.
\n"; + print STDOUT "there are $Nimage images, $Nkeep used.
\n"; + print STDOUT "Total Counts: $Ncnt
\n"; + print STDOUT "Median residual scatter: $Resid
\n"; + print STDOUT "Median fractional residual: $fResid

\n"; + print STDOUT "you have the following choices:
\n"; + print STDOUT " return to top level
"; + print STDOUT " split config
"; + print STDOUT " accept config
\n"; + + print STDOUT "
\n"; + print STDOUT "
Statistics on each available input image.
\n"; + print STDOUT "Time is in UT. Click on the column heading to sort by that entry\n"; + + print STDOUT "\n"; + print STDOUT "\n"; + print STDOUT "\n"; + print STDOUT "\n"; + print STDOUT "\n"; + print STDOUT "\n"; + print STDOUT "\n"; + print STDOUT "\n"; + print STDOUT "\n"; + print STDOUT "\n"; + print STDOUT "\n"; + print STDOUT "\n"; + print STDOUT "\n"; + print STDOUT "\n"; + print STDOUT "\n\n"; + + @order = (); + for ($i = 0; $i < $Nimage; $i++) { @order = (@order, $i); } + + @entry = sort by_col @order; + + for ($i = 0; $i < $Nimage; $i++) { + $N = $entry[$i]; + + @word = split (" ", $statdata[$N]); + $used = $word[9]; + $keep = $word[10]; + + @tmpw = split ("/", $meddata[$N]); + $medname = $tmpw[-1]; + @tmpw = split ("/", $defdata[$N]); + $defname = $tmpw[-1]; + + print STDOUT "\n"; + print STDOUT "\n"; + print STDOUT "\n"; + print STDOUT "\n"; + print STDOUT "\n"; + print STDOUT "\n"; + print STDOUT "\n"; + print STDOUT "\n"; + print STDOUT "\n"; + if ("$defname" ne "") { + print STDOUT "\n"; + } else { + print STDOUT "\n"; + } + if ($used) { print STDOUT "\n"; } + else { print STDOUT "\n"; } + if ($keep) { print STDOUT "\n\n"; } + else { print STDOUT "\n\n"; } + + } + + print STDOUT "
image Date Time Sky Flux Fringe dFringe Resid dResid F image R image used? keep?
$word[0] $word[1] $word[2] $word[3] $word[4] $word[5] $word[6] $word[7] $word[8] N/A yesno
\n"; + print STDOUT "\n"; + print STDOUT "\n"; + print STDOUT "\n"; + print STDOUT "\n"; + print STDOUT "
\n"; + + print STDOUT "
\n"; + print STDOUT "Fringe Correlation Plot
\n"; + if (-e "$root.stats.png") { + @tmpw = split ("/", "$root.stats.png"); + $imname = "$www/$tmpw[-1]"; + print STDOUT "\n"; + } + print STDOUT "
\n"; + + print STDOUT "\n"; + &goodbye; + +} + +sub flips_report_done { + + ($config) = $_[0] =~ /([-\w]+\.[-\w]+\.[-\w]+)/; + ($key) = $_[0] =~ /([-\w]+\.[-\w]+\.[-\w]+\.[-\w]+)/; # (config.ver) + + $line = $_[1]; + + open (STAT, mknames ("stats", $line)); + open (MED, mknames ("medbin", $line)); + open (MASTER, mknames ("master", $line, 0)); + + print STDOUT "\n"; + print STDOUT "\n"; + print STDOUT "\n\n"; + + for ($i = 0; $line = ; $i++) { + + chop ($line); + # print STDOUT "$line
\n"; + @word = split (" ",$line); + $used = $word[12]; + $dawn = $word[11]; + + $line = ; + chop ($line); + # print STDOUT "$line
\n"; + @tmpw = split (" ",$line); + $keep = $tmpw[1]; + + # mkfringe works with files in the user's paths, but the web page needs + # to work with files visible to the web server + $line = ; + chop ($line); + @tmpw = split ("/", $line); + $N = @tmpw - 1; + $medname = $tmpw[$N]; + + $sig1 = sprintf "%5.3f", $word[4]; + $sig2 = sprintf "%5.3f", $word[5]; + $sig3 = sprintf "%5.3f", $word[6]; + $sig4 = sprintf "%5.3f", $word[7]; + $mean = sprintf "%8.1f", $word[3]; + + print STDOUT "\n"; + if ($dawn) { print STDOUT "\n"; } + else { print STDOUT "\n"; } + print STDOUT "\n"; + print STDOUT "\n"; + if ($used) { print STDOUT "\n"; } + else { print STDOUT "\n"; } + } + $Nimage = $i; + + print STDOUT "
image Date Time Mean Sigma (raw) Sigma (clipped) Sigma (med) image used?
$word[0] $word[1] $word[2] $word[2] $word[3] $word[5] $word[6] $word[8] yesno
\n"; + print STDOUT "\n"; + + &goodbye; + +} + +sub flips_entry { + + my($version)= $_[0]; # version of desired entry + my($entry) = $_[1]; # desired entry in list + my($line) = $_[2]; # list of image stats + my($mode) = $_[3]; # 'def' or 'med' + + if (($mode ne "def") && ($mode ne "med")) { + print STDOUT "error in $MKFRINGE mode\n"; + &goodbye; + } + + # load image & stat lists + $root = mknames ("htmlroot", $line); + open (FILE, "$root.imstats"); @statdata = ; close (FILE); + open (FILE, "$root.$mode.tenbin.list"); @meddata = ; close (FILE); + + $Nimage = @statdata; + if ($entry >= $Nimage) { + print STDOUT " selected entry out of range\n"; + &goodbye; + } + + $first = ($entry == 0); + $last = ($entry == $Nimage - 1); + $next = $entry + 1; + $prev = $entry - 1; + + $line = $statdata[$entry]; + chop ($line); + @word = split (" ",$line); + $used = $word[9]; + $keep = $word[10]; + + # mkfringe works with files in the user's paths, but the web page needs + # to work with files visible to the web server + $line = $meddata[$entry]; + chop ($line); + @tmpw = split ("/", $line); + $name = "$www/$tmpw[-1]"; + + print STDOUT "\n"; + print STDOUT "mode: $mode
\n"; + + print STDOUT "\n"; + + print STDOUT "\n"; + print STDOUT "\n"; + if (!$first) { print STDOUT "\n"; } + if (!$last) { print STDOUT "\n"; } + print STDOUT "
\n"; + print STDOUT "\n"; + print STDOUT "\n"; + if ($mode eq "med") { + print STDOUT "\n"; + } else { + print STDOUT "\n"; + } + print STDOUT "\n"; + if ($used) { + print STDOUT "\n"; + } else { + print STDOUT "\n"; + } + print STDOUT "\n\n"; + print STDOUT "
image Date Time Sky Flux Fringe dFringe Resid dResid used?
$word[0]
$word[0] $word[1] $word[2] $word[3] $word[4] $word[5] $word[6] $word[7] $word[8] yesno
\n"; + + print STDOUT "
return to config list
return to $version
goto prev image
goto next image
\n"; + + print STDOUT "\n"; + &goodbye; +} + +sub map_report { + + print STDOUT "A Simple Test
\n"; + + $col = 0; + ($config) = $_[0] =~ /([-\w]+\.[-\w]+\.[-\w]+)/; + ($key) = $_[0] =~ /([-\w]+\.[-\w]+\.[-\w]+\.[-\w]+)/; # (config.ver) + + # look for optional sort key (config.ver[.key]) + if ($_[0] =~ /$key.(\d+)/) { + ($col) = $_[0] =~ /$key.(\d+)/; + } else { + $col = 0; + } + + $line = $_[1]; + $message = $_[2]; + + open (LIST, mknames ("maplist", $line)); @mapdata = ; close (LIST); + open (LIST, mknames ("modelist", $line)); @modedata = ; close (LIST); + + open (LIST, mknames ("modesjpg", $line)); @modeslist = ; close (LIST); + open (LIST, mknames ("residjpg", $line)); @residlist = ; close (LIST); + open (LIST, mknames ("inmapjpg", $line)); @inmaplist = ; close (LIST); + foreach $name (@modeslist) { chop ($name); } + foreach $name (@residlist) { chop ($name); } + foreach $name (@inmaplist) { chop ($name); } + + print STDOUT "You have the following choices:
\n"; + print STDOUT " return to top level
"; + print STDOUT " accept config
"; + + print STDOUT "Modes avaliable for this config
\n"; + print STDOUT "
\n"; + # 4 x N table of possible modes + $MaxModes = 8; + print STDOUT "\n"; + for ($i = 0; $i < $MaxModes; $i++) { + if ((($i - 0) % 4) == 0) { print STDOUT "\n"; } + ($junk, $status) = split (" ", $modedata[$i]); + $name = sprintf "%s/%s", $www, $modeslist[$i]; + print STDOUT "\n"; + if ($status) { print STDOUT "\n"; } + else { print STDOUT "\n"; } + if ((($i - 3) % 4) == 0) { print STDOUT "\n"; } + } + print STDOUT "
\n"; + print STDOUT "\n"; + print STDOUT "\n"; + print STDOUT "\n"; + print STDOUT "\n"; + print STDOUT "
\n"; + + # 2 x N table of image residuals + print STDOUT "Residual images
\n"; + print STDOUT "
\n"; + print STDOUT "\n"; + for ($i = 0; $i < @mapdata; $i++) { + if ((($i - 0) % 6) == 0) { print STDOUT "\n"; } + + ($name, $status) = split (" ", $mapdata[$i]); + @words = split ("/", $name); + $basename = $words[-1]; + $basename =~ s/.maplist$//; + + $imname = sprintf "%s/%s", $www, $residlist[$i]; + print STDOUT "\n"; + print STDOUT "\n"; + if ($status) { print STDOUT "\n"; } + else { print STDOUT "\n"; } + + if ((($i - 5) % 6) == 0) { print STDOUT "\n"; } + else { print STDOUT "\n"; } + + } + print STDOUT "
$basename
 
\n"; + $Nmaps = @mapdata; + print STDOUT "\n"; + print STDOUT "\n"; + print STDOUT "\n"; + print STDOUT "\n"; + print STDOUT "
\n"; + + # 2 x N table of source images + print STDOUT "Source images
\n"; + print STDOUT "
\n"; + print STDOUT "\n"; + for ($i = 0; $i < @mapdata; $i++) { + if ((($i - 0) % 6) == 0) { print STDOUT "\n"; } + + ($name, $status) = split (" ", $mapdata[$i]); + @words = split ("/", $name); + $basename = $words[-1]; + $basename =~ s/.maplist$//; + + $imname = sprintf "%s/%s", $www, $inmaplist[$i]; + print STDOUT "\n"; + print STDOUT "\n"; + if ($status) { print STDOUT "\n"; } + else { print STDOUT "\n"; } + + if ((($i - 5) % 6) == 0) { print STDOUT "\n"; } + else { print STDOUT "\n"; } + } + print STDOUT "
$basename
 
\n"; + $Nmaps = @mapdata; + print STDOUT "\n"; + print STDOUT "\n"; + print STDOUT "\n"; + print STDOUT "\n"; + print STDOUT "
\n"; + &goodbye; + +} + +print STDOUT "error: invalid $MKFRINGE command\n"; + +# run: $root/detrend.config - current run +# detdir: $det - directory for current run +# config: $det/fringe.config - config info for specific run, 1 line per setup +# dates: $det/dates.dat - dates for specific run +# list: $det/fringe.list - temporary list to pass to elixirs +# plist: $det/fringe.plist - list of files to process (detrend) for elixir +# proc: $det/proc - directory to store temporary processed images +# fringe: $det/fringe - directory to store data files +# html: $det/html - directory to store results for www +# www: $www/$run/html - html directory as seen by Web server + +#### TOOLS TO ABSTRACT FILENAMES ################################################################### + +# construct specific file names +sub mkfiles { + # in: (type) + my($type) = $_[0]; + my($value); + + { + if ($type eq "run") { + $value = "$root/fringe.config"; + last; + } + if ($type eq "detdir") { + $value = "$det"; + last; + } + if ($type eq "config") { + $value = "$det/fringe.config"; + last; + } + if ($type eq "dates") { + $value = "$det/dates.dat"; + last; + } + if ($type eq "list") { + $value = "$det/fringe.list"; + last; + } + if ($type eq "plist") { + $value = "$det/fringe.plist"; + last; + } + if ($type eq "proc") { + $value = "$det/proc"; + last; + } + if ($type eq "fringe") { + $value = "$det/fringe"; + last; + } + if ($type eq "links") { + $value = "$det/flips/links"; + last; + } + if ($type eq "html") { + $value = "$det/html"; + last; + } + if ($type eq "www") { + $value = "$www"; + last; + } + &escape ("unknown type for mkfiles"); + } + $value; +} + +# construct files from config info: +# CRUNID TYPE FILTER [CCD] VERSION START STOP STATE +#************************** + +sub mknames { + # in: (type) (config.ver) [ccd] + my ($type, $version, @words, $dir, $value, $ccd); + + $type = $_[0]; + $version = $_[1]; + @words = split (" ", $version); + $ccd = $_[2]; + + { + # list of fringe frames + if ($type eq "config") { + $dir = mkfiles ("fringe"); + $value = sprintf "$dir/$words[0].$words[1].$words[2].$words[3]"; + last; + } + # list of fringe frames + if ($type eq "frlist") { + $dir = mkfiles ("fringe"); + $value = sprintf "$dir/$words[0].$words[1].$words[2].$words[3].frlist"; + last; + } + # smoothed (final) fringe image + if ($type eq "smfile") { + $dir = mkfiles ("fringe"); + $value = sprintf "$dir/$words[0].$words[1].$words[2].$ccd.$words[3].sm.fits"; + last; + } + # raw fringe image + if ($type eq "frfile") { + $dir = mkfiles ("fringe"); + $value = sprintf "$dir/$words[0].$words[1].$words[2].$ccd.$words[3].fr.fits"; + last; + } + # master list of input images + if ($type eq "master") { + $dir = mkfiles ("fringe"); + $value = sprintf "$dir/$words[0].$words[1].$words[2].$words[3].master"; + last; + } + # output link file for fhtool + if ($type eq "link") { + $dir = mkfiles ("links"); + if ($ccd eq "") { &escape ("missing CCD for mknames link"); } + $value = "$dir/$words[0].$words[1].$words[2].$ccd.$words[3].fits"; + last; + } + # output mef file name + if ($type eq "mef") { + $dir = mkfiles ("fringe"); + $value = "$dir/$words[0].$words[1].$words[2].$words[3].fits"; + last; + } + # list of image statistics files + if ($type eq "imstats") { + $dir = mkfiles ("fringe"); + $value = sprintf "$dir/$words[0].$words[1].$words[2].$words[3].imstats"; + last; + } + # list of image map lists + if ($type eq "maplist") { + $dir = mkfiles ("fringe"); + $value = sprintf "$dir/$words[0].$words[1].$words[2].$words[3].maplist"; + last; + } + # list of image map lists + if ($type eq "modelist") { + $dir = mkfiles ("fringe"); + $value = sprintf "$dir/$words[0].$words[1].$words[2].$words[3].mode.list"; + last; + } + # list of image map lists + if ($type eq "modefits") { + $dir = mkfiles ("fringe"); + $value = sprintf "$dir/$words[0].$words[1].$words[2].$words[3].mode.fits"; + last; + } + # list of image map lists + if ($type eq "modesave") { + $dir = mkfiles ("fringe"); + $value = sprintf "$dir/$words[0].$words[1].$words[2].$words[3].mode.mef.fits"; + last; + } + # mosaic fringe statistics file + if ($type eq "frstats") { + $dir = mkfiles ("fringe"); + $value = sprintf "$dir/$words[0].$words[1].$words[2].$words[3].frstats"; + last; + } + # images to be detrended + if ($type eq "detrend") { + $dir = mkfiles ("fringe"); + $value = sprintf "$dir/$words[0].$words[1].$words[2].$words[3].detrend"; + last; + } + # list of input image lists to defringe + if ($type eq "defringe") { + $dir = mkfiles ("fringe"); + $value = sprintf "$dir/$words[0].$words[1].$words[2].$words[3].defringe"; + last; + } + # file in HTML dir with all image stats + if ($type eq "htmlroot") { + $dir = mkfiles ("html"); + $value = "$dir/$words[0].$words[1].$words[2].$words[3]"; + last; + } + # file in HTML dir with all image stats + if ($type eq "stats") { + $dir = mkfiles ("html"); + $value = "$dir/$words[0].$words[1].$words[2].$words[3].stats"; + last; + } + # file in HTML dir with all medbin jpg image names (also root for images) + if ($type eq "modesjpg") { + $dir = mkfiles ("html"); + $value = "$dir/$words[0].$words[1].$words[2].$words[3].modes"; + last; + } + # file in HTML dir with all medbin jpg image names (also root for images) + if ($type eq "residjpg") { + $dir = mkfiles ("html"); + $value = "$dir/$words[0].$words[1].$words[2].$words[3].resid"; + last; + } + # file in HTML dir with all medbin jpg image names (also root for images) + if ($type eq "inmapjpg") { + $dir = mkfiles ("html"); + $value = "$dir/$words[0].$words[1].$words[2].$words[3].inmap"; + last; + } + # file in HTML dir with all medbin jpg image names (also root for images) + if ($type eq "medbin") { + $dir = mkfiles ("html"); + $value = "$dir/$words[0].$words[1].$words[2].$words[3].medbin"; + last; + } + # file in HTML dir with all tenbin jpg image names (also root for images) + if ($type eq "tenbin") { + $dir = mkfiles ("html"); + $value = "$dir/$words[0].$words[1].$words[2].$words[3].tenbin"; + last; + } + # file in HTML dir with jpg image of fringe framge + if ($type eq "imbin") { + $dir = mkfiles ("html"); + $value = "$dir/$words[0].$words[1].$words[2].$words[3].imbin.jpg"; + last; + } + # file in WWW dir with jpg image of fringe framge + if ($type eq "dads.imbin") { + $dir = mkfiles ("www"); + $value = "$dir/$words[0].$words[1].$words[2].$words[3].imbin.jpg"; + last; + } + &escape ("unknown type for mknames: $type"); + } + return ($value); +} + +#### TOOLS TO INTERACT WITH FORMATED CONFIG FILE ##################################################### + +# parse config info +# CRUNID TYPE FILTER [CCD] VERSION START STOP STATE +#************************** +sub gtconfig { + my ($value, $type, @words, $ccd); + # in: (config line) (type) + @words = split (" ", $_[0]); + $type = $_[1]; + + { + if ($type eq "elixir") { + $value = "$words[0] $words[1] $words[2] $words[3] $words[4] $words[5]"; + last; + } + if ($type eq "chiprun") { + $ccd = $_[2]; + $value = "$words[0] $words[1] $words[2] $ccd $words[3] $words[4] $words[5]"; + last; + } + if ($type eq "config") { + $value = "$words[0].$words[1].$words[2]"; + last; + } + if ($type eq "filter") { + $value = "$words[2]"; + last; + } + if ($type eq "ID") { + $value = "$words[0]"; + last; + } + if ($type eq "version") { + $value = "$words[0].$words[1].$words[2].$words[3]"; + last; + } + if ($type eq "from") { + $value = "$words[4]"; + last; + } + if ($type eq "to") { + $value = "$words[5]"; + last; + } + if ($type eq "status") { + $value = "$words[6]"; + last; + } + &escape ("unknown type for gtconfig"); + } + + return $value; +} + +# set config value +# TYPE FILTER CRUNID VERSION START STOP STATE +# CRUNID TYPE FILTER [CCD] VERSION START STOP STATE +#************************** +sub stconfig { + # in: (config line) (value) (type) + my (@words) = split (" ", $_[0]); + my ($type) = $_[1]; + my ($value) = $_[2]; + my ($line); + + { + if ($type eq "all") { + $line = sprintf "%s %6s %4s %2d %s %s %s", $words[0], $words[1], $words[2], $words[3], $words[4], $words[5], $words[6]; + last; + } + if ($type eq "version") { + $line = sprintf "%s %6s %4s %2d %s %s %s", $words[0], $words[1], $words[2], $value, $words[4], $words[5], $words[6]; + last; + } + if ($type eq "start") { + $line = sprintf "%s %6s %4s %2d %s %s %s", $words[0], $words[1], $words[2], $words[3], $value, $words[5], $words[6]; + last; + } + if ($type eq "stop") { + $line = sprintf "%s %6s %4s %2d %s %s %s", $words[0], $words[1], $words[2], $words[3], $words[4], $value, $words[6]; + last; + } + if ($type eq "status") { + $line = sprintf "%s %6s %4s %2d %s %s %s", $words[0], $words[1], $words[2], $words[3], $words[4], $words[5], $value; + last; + } + &escape ("unknown type for stconfig"); + } + + return $line; +} + +# load dates & mode (returns @list) +sub load_dates { + my ($file, $line, @list); + my ($start, $stop); + + $file = mkfiles ("dates"); + @list = (); + open (FILE, "$file"); + @list = ; + close (FILE); + + ($tmp, $start) = split (" ", $list[0]); + if ($tmp ne "START") { print STDERR "dates file is confused\n"; } + + ($tmp, $stop) = split (" ", $list[1]); + if ($tmp ne "STOP") { print STDERR "dates file is confused\n"; } + + ($tmp, $mode) = split (" ", $list[2]); + if ($tmp ne "MODE") { print STDERR "dates file missing mode\n"; } + if ($mode eq "") { $mode = "hold"; } + + ($start, $stop, $mode); +} + +# write to dates file +sub save_dates { + # save_dates start stop auto.mode + my (@outlist) = @_; + + my ($file) = mkfiles ("dates"); + open (FILE, ">$file"); + print FILE "START $outlist[0]\n"; + print FILE "STOP $outlist[1]\n"; + print FILE "MODE $outlist[2]\n"; + close (FILE); +} + +# load config lines (returns @list) +sub load_config { + my ($file, $line, @list); + + $file = mkfiles ("config"); + @list = (); + open (FILE, "$file"); + while ($line = ) { + chop ($line); + @list = (@list, $line); + } + close (FILE); + + @list; +} + +# write to config file +sub save_config { + + my(@outlist) = sort @_; + + my($file) = mkfiles ("config"); + open (FILE, ">$file"); + for ($i = 0; $i < @outlist; $i++) { + print FILE "$outlist[$i]\n"; + } + close (FILE); + +} + +#### USEFUL TOOLS ################################################################################# + +sub vsystem { + print STDERR "@_\n"; + $status = system ("@_"); + $status; +} + +sub goodbye { + unlink $tmpenv; + exit 0; +} + +sub escape { + unlink $tmpenv; + print STDERR "$_[0]\n"; + exit 1; +} + +# grab complete configuration info from the elixir config system, +# applying appropriate command-line arguments +sub elixir_config { + my (@argv) = @_; + my ($opt, $config, @tmparg, $status); + $config = ""; + if ($ENV{'PTOLEMY'}) { $config = "-c $ENV{'PTOLEMY'}"; } + umask (0); + + # look for optional command-line arguments + @tmparg = @argv; + foreach (@tmparg) { + $value = shift @argv; + + if ($value eq "-c") { + $value = shift @argv; + $config = "-c $value"; + next; + } + + if ($value eq "-C") { + push @opt, $value; + $value = shift @argv; + push @opt, $value; + $elconf = $value; + next; + } + + if ($value eq "-D") { + push @opt, $value; + $value = shift @argv; + push @opt, $value; + $value = shift @argv; + push @opt, $value; + next; + } + + if ($value eq "-run") { + $run = shift @argv; + push @opt, "-D RUNID.MKFRINGE $run -D RUNID $run"; + next; + } + + if ($value eq "-camera") { + $camera = shift @argv; + push @opt, "-D CAMERA.MKFRINGE $camera -D CAMERA $camera"; + next; + } + push @argv, $value; + } + + # load RUNID from state.data (unless set on command line) + if ($run eq "") { + $run = `gconfig RUNID.MKFRINGE`; chop $run; + if ($?) { &escape ("run is not defined: use 'mkdetrend config' or 'mkrun sys'\n"); } + if ($run eq "") { &escape ("run is not defined: use 'mkdetrend config' or 'mkrun sys'\n"); } + push @opt, "-D RUNID.MKDETREND $run -D RUNID $run"; + } + + # load CAMERA from state.data (unless set on command line) + if ($camera eq "") { + $camera = `gconfig CAMERA.MKFRINGE`; chop $camera; + if ($?) { &escape ("camera is not defined: use 'mkrun sys' to set\n"); } + if ($camera eq "") { &escape ("camera is not defined: use 'mkrun sys'\n"); } + push @opt, "-D CAMERA.MKDETREND $camera -D CAMERA $camera"; + } + + # set env PTOLEMY using values from command line + $config = join (" ", $config, @opt); + $tmpenv = `mktemp /tmp/elixir.XXXXXX`; chop ($tmpenv); + $status = system ("gconfig -raw $config > $tmpenv"); + if ($status) { &escape ("error in elixir configuration: gconfig fails"); } + $ENV{'PTOLEMY'} = "$tmpenv"; + + # set global variables based on new config info + $root = `gconfig DETREND_ROOT`; chop $root; + if ($?) { &escape ("error with elixir configuration variable: DETREND_ROOT"); } + + $wwwroot = `gconfig DETREND_WWW`; chop $wwwroot; + if ($?) { &escape ("error with elixir configuration variable: DETREND_WWW"); } + + $Nccd = `cameraconfig -Nccd`; chop ($Nccd); + if ($?) { &escape ("error with elixir camera configuration"); } + + @ccds = split (" ", `cameraconfig -ccdn`); + if ($?) { &escape ("error with elixir camera configuration"); } + + # get list of valid filters from lookup table + @filters = split (" ", `filtnames list`); + if ($?) { &escape ("error with elixir filter configuration"); } + + # recipe file defines detrend types & cutoff exptime values + $recipefile = `gconfig DETREND_RECIPES`; chop $recipefile; + if ($?) { &escape ("missing DETREND_RECIPES in configuration"); } + + @filt = (); + foreach $filter (@filters) { + ($detypes) = split (" ", `gconfig -c $recipefile $filter`); + if ($?) { die "ERROR: missing detrend recipe for $filter\n"; } + + @detypes = split (",", $detypes); + for ($i = 0; $i < @detypes; $i++) { + if ($detypes[$i] eq "fringe") { + push @filt, $filter; + push @type, "fringe"; + last; + } + } + } + + $CGI = `gconfig CGIBIN`; chop ($CGI); + if ($?) { &escape ("error with elixir configuration variable: CGIBIN"); } + + $det = "$root/$run"; + $www = "$wwwroot/$run/html"; + return (@argv); +} + +sub usage { + + if (@ARGV == 1) { + print STDERR "\n --- user modes ---\n"; + print STDERR "create (run) (startdate) (stopdate)\n"; + print STDERR "mkconfig\n"; + print STDERR "config (run)\n"; + print STDERR "init\n"; + print STDERR "run\n"; + print STDERR "list.runs\n"; + print STDERR "set (config.ver) (state)\n"; + print STDERR "reg\n"; + print STDERR "state \n"; + print STDERR "help \n"; + print STDERR "\n --- internal modes --- \n"; + print STDERR "flips\n"; + print STDERR "norm\n"; + print STDERR "update\n"; + print STDERR "merge\n"; + print STDERR "dup (config)\n"; + print STDERR "del (config)\n"; + print STDERR "def (config.ver) (start) (stop)\n"; + print STDERR "eval (step)\n"; + print STDERR "mevel (step)\n"; + print STDERR "htmldup\n"; + print STDERR "htmldel\n"; + print STDERR "htmldef\n"; + print STDERR "htmlmod\n"; + print STDERR "htmlkeep\n"; + print STDERR "html1\n"; + print STDERR "html2 (config.ver)\n"; + print STDERR "html3 (entry.config.ver)\n"; + &goodbye; + } + + if (@ARGV > 2) { print STDERR "USAGE: $MKFRINGE (help) [mode]\n"; &goodbye; } + + if ($ARGV[1] eq "config") { + print STDERR "set up initial configuration\n"; + &goodbye; + } + + if ($ARGV[1] eq "save") { + print STDERR "save results from current configuration\n"; + &goodbye; + } + + print STDERR "help for $ARGV[1] not defined\n"; + &goodbye; +} + +#### overview ######## + +# init: create lists of possible images for each master type: +# 01Ak01.fringe.I.0.master (MOSAIC) + +# detrend: detrend the input images + +# files needed for html pages: + +# html/* +# fringe/*.master Index: /tags/ohana/perl-1-3/Ohana/src/perl/src/mkhtml =================================================================== --- /tags/ohana/perl-1-3/Ohana/src/perl/src/mkhtml (revision 21906) +++ /tags/ohana/perl-1-3/Ohana/src/perl/src/mkhtml (revision 21906) @@ -0,0 +1,183 @@ +#!/usr/bin/env perl + +$template = "template.htm"; +if ($ARGV[0] eq "-template") { + shift @ARGV; + $template = $ARGV[0]; + shift @ARGV; +} + +if (@ARGV != 3) { die "USAGE: mkhtml [-template template] (root) (src) (html)\n"; } + +$root = $ARGV[0]; +$root =~ s|/*$||; # strip trailing /'s to clean path + +$input = $ARGV[1]; +$output = $ARGV[2]; +$config = "Configure"; + +# print STDERR "template: $template\n"; + +# load variables from Configure (eg, ROOT, etc) +# these are interpolated except in the content section +open (FILE, $config); +@input = ; +close (FILE); +foreach $line (@input) { + ($var, $eq, $value) = split (" ", $line); + $$var = $value; +} + +# load data from template +open (FILE, $template); +@template = ; +close (FILE); + +# load data from input file +open (FILE, $input); +@input = ; +close (FILE); + +# default metadata values: +$title = &rootname ($input); +if ($title eq "index") { $title = &basename (&dirname ($input)); } + +$page = &rootname ($input); +if ($page eq "index") { $page = &basename (&dirname ($input)); } + +$path = &dirname ($input); + +$ext = &extname ($input); + +# file is the entry in the index listing +$file = $output; +if ($file =~ m|index.html|) { $file = &dirname ($output); } +$file =~ s|^$root|ROOT|; + +# apply ROOT variable to content (this comes from Configure) +# foreach $line (@input) { while ($line =~ m|\$ROOT|) { $line =~ s|\$ROOT|$ROOT|; } } + +# search for the metadata lines in input file +while (@input) { + $line = shift @input; + if ($line =~ /^\s*$/) { next; } + if ($line =~ //; + next; + } + if ($line =~ //; + next; + } + unshift @input, $line; + last; +} + +# create the output file +open (OUT, ">$output"); + +$found = $menu = 0; +foreach $line (@template) { + + chop $line; + while ($line =~ m|ROOT|) { $line =~ s|ROOT|$ROOT|; } + + # interpolate over basic metadata entries + if ($line =~ m||) { + print OUT "$page\n"; + next; + } + if ($line =~ m||) { + print OUT "$title\n"; + next; + } + if ($line =~ m||) { + # add in parsing of

tags, etc in here + &dumpinput; + next; + } + + # parse the index file + if ($line =~ m||; + $index = "$path/$index"; + open (INDEX, $index); + @index = ; + # need to find and tag this file + foreach $index (@index) { + if ($index =~ m|href=$file>|) { + $index =~ s|class=doc|class=sel|; + $index =~ s|class=dir|class=dsl|; + $index =~ s|class=dl|class=sl|; + $index =~ s|$file>\s+-\s+|$file> + |; + } + # interpolate ROOT + while ($index =~ m|ROOT|) { $index =~ s|ROOT|$ROOT|; } + } + + close (INDEX); + print OUT @index; + next; + } + print OUT "$line\n"; +} + +close (OUT); +exit 0; + +sub dumpinput { + + if ($ext eq "txt") { + print OUT "

\n";
+    }
+    print OUT "@input";
+    if ($ext eq "txt") {
+	print OUT "
\n"; + } +} + +# behaves just like system basename function (returns last portion of path) +sub basename { + + my ($file) = $_[0]; + my ($base, @words); + + @words = split ("/", $file); + $base = $words[-1]; + return $base; +} + + +# behaves just like system dirname function (strips last portion of path) +sub dirname { + + my ($file) = $_[0]; + my ($base, @words); + + @words = split ("/", $file); + if (@words == 1) { return "."; } + + pop @words; + $file = join ('/', @words); + return $file; +} + +# behaves just like system basename function (returns last portion of path) +sub extname { + my ($file) = &basename ($_[0]); + my($ext) = $file =~ m|\S*\.(\S*)$|; + return $ext; +} + +# behaves just like system basename function (returns last portion of path) +sub rootname { + my ($file) = &basename ($_[0]); + my($ext) = $file =~ m|(\S*)\.\S*$|; + return $ext; +} + +# input metadata lines: +# +# +# + Index: /tags/ohana/perl-1-3/Ohana/src/perl/src/mkidx =================================================================== --- /tags/ohana/perl-1-3/Ohana/src/perl/src/mkidx (revision 21906) +++ /tags/ohana/perl-1-3/Ohana/src/perl/src/mkidx (revision 21906) @@ -0,0 +1,232 @@ +#!/usr/bin/env perl + +use strict; + +if (@ARGV != 1) { die "USAGE: mkidx (directory)\n"; } + +# input is the name of a directory and current level +# outputs are: directory list, document list, index file for directory +# menu for that directory + +# parse input info +my($path); +$path = $ARGV[0]; +$path =~ s|/*$||; # strip trailing /'s to clean path + +local($mkidx::root) = $path; + +&mksubidx ($path, 0, 0, "template.htm"); +exit 0; + +sub mksubidx { + # USAGE: mksubidx (path) (entry) (template) (index) + my($path) = shift @_; + my($level) = shift @_; + my($entry) = shift @_; + my($template) = shift @_; + my(@updex) = @_; + + my($i, $j); + my($line, $value, $dir); + my(@list); + my($file, $root, $link, $ext); + my(@seq) = (); + my(@dirs) = (); + my(@mydirs) = (); + my(@docs) = (); + my(@txts) = (); + my(@index) = (); + my(@mydex) = (); + my($Nmydex); + my(@seqline); + + # if this directory contains a template file, reset entry and level + # supply the template file to mkhtml here and below + if (-e "$path/template.htm") { + @updex = (); + $level = 0; + $entry = 0; + $template = "$path/template.htm"; + } + # print STDERR "idx: $template\n"; + + # put leading portion of updex here + for ($i = 0; $i < $entry; $i++) { + push @index, $updex[$i]; + } + + # find all dirs in this directory + @list = <$path/*>; + foreach $file (@list) { + if (-e "$path/nochild.idx") { last; } + if (! -d $file) { next; } + $root = &basename ($file); + $link = $file; + $link =~ s|^$mkidx::root|ROOT|; + + # list special directories here + if ($root eq "CVS") { next; } + if (-e "$file/noindex.idx") { next; } + + push @mydirs, $file; + + $line = sprintf " ", $level, "href=$link>", $root; + push @mydex, $line; + push @seq, $root; + } + + # find all docs (htm, txt) in this directory + @list = (<$path/*.htm>,<$path/*.hts>,<$path/*.txt>); + foreach $file (@list) { + if (! -f $file) { next; } + + $ext = &extname ($file); + $root = &rootname ($file); + + $link = $file; + $link =~ s|.$ext$|.html|; + $link =~ s|^$mkidx::root|ROOT|; + + # list special files here + if ($root eq "index") { next; } + if ($root eq "template") { next; } + if ($root eq "sequence") { next; } + + # print STDERR "ext: $ext, root: $root\n"; + + push @docs, $file; + push @mydirs, "0"; + + if ($ext ne "hts") { + # simple case: no extra information: + $line = sprintf " ", $level, "href=$link>", $root; + push @mydex, $line; + push @seq, &basename ($file); + } + } + + # look for directory sequencing information + if (-f "$path/sequence.idx") { + open (FILE, "$path/sequence.idx"); + @seqline = ; + close (FILE); + OUT: + for ($i = 0; $i < @seqline; $i++) { + $Nmydex = @mydex; + chop $seqline[$i]; + IN: + for ($j = 0; $j < $Nmydex; $j++) { + $line = shift @mydex; + $value = shift @seq; + $dir = shift @mydirs; + if ($seqline[$i] eq $value) { + push @index, $line; + push @dirs, $dir; + # print "ADD SEQ: $dir, $line\n"; + next OUT; + } else { + push @mydex, $line; + push @mydirs, $dir; + push @seq, $value; + } + } + } + } + # add trailing portion of updex here + foreach $line (@mydex) { + $dir = shift @mydirs; + # print "ADD VAL: $dir, $line\n"; + push @dirs, $dir; + push @index, $line; + } + + # add trailing portion of updex here + for ($i = $entry; $i < @updex; $i++) { + push @index, $updex[$i]; + } + + for ($i = 0; $i < @dirs; $i++) { + if ($dirs[$i] eq 0) { next; } + &mksubidx ($dirs[$i], $level + 1, $i + $entry + 1, $template, @index); + } + + # output index for this directory + open (FILE, ">$path/index.idx"); + foreach $line (@index) { + print FILE "$line\n"; + } + close (FILE); + + # create html for docs in this directory + foreach $file (@docs, "$path/index.htm") { + $ext = &extname ($file); + # print STDERR "ext: $ext\n"; + # $root = &rootname ($file); + # print STDERR "root: $root\n"; + $link = $file; + $link =~ s|.$ext$|.html|; + system "mkhtml -template $template $mkidx::root $file $link"; + } + return; +} + +# behaves just like system basename function (returns last portion of path) +sub basename { + + my ($file) = $_[0]; + my ($base, @words); + + @words = split ("/", $file); + $base = $words[-1]; + return $base; +} + +# behaves just like system basename function (returns last portion of path) +sub extname { + my ($file) = &basename ($_[0]); + my($ext) = $file =~ m|\S*\.(\S*)$|; + return $ext; +} + +# behaves just like system basename function (returns last portion of path) +sub rootname { + my ($file) = &basename ($_[0]); + my($ext) = $file =~ m|(\S*)\.\S*$|; + return $ext; +} + +# behaves just like system dirname function (strips last portion of path) +sub dirname { + + my ($file) = $_[0]; + my ($base, @words); + + @words = split ("/", $file); + if (@words == 1) { return "."; } + + pop @words; + $file = join ('/', @words); + return $file; +} + +### +# # find all txt files in this directory +# @list = <$path/*.txt>; +# foreach $file (@list) { +# if (! -f $file) { next; } +# +# $ext = &extname ($file); +# +# $root = &basename ($file); +# $root =~ s|.txt$||; +# $link = $file; +# $link =~ s|.txt$|.html|; +# $link =~ s|^$mkidx::root|ROOT|; +# +# push @txts, $file; +# +# # simple case: no extra information: +# $line = sprintf " ", $level, "href=$link>", $root; +# push @index, $line; +# } + Index: /tags/ohana/perl-1-3/Ohana/src/perl/src/mkrun =================================================================== --- /tags/ohana/perl-1-3/Ohana/src/perl/src/mkrun (revision 21906) +++ /tags/ohana/perl-1-3/Ohana/src/perl/src/mkrun (revision 21906) @@ -0,0 +1,711 @@ +#!/usr/bin/env perl + +# check usage +if (@ARGV < 1) { + print STDOUT "USAGE: mkrun (mode) [arguments]\n"; + print STDOUT " mkrun help gives a complete list\n"; + &goodbye; +} +if ($ARGV[0] eq "help") { &usage; } + +# this should come fron the config system +$runlist = `gconfig RUN_LIST`; chop $runlist; +@runlist = (); + +# call appropriate command +if ($ARGV[0] eq "create") { &create; } +if ($ARGV[0] eq "delete") { &delete; } +if ($ARGV[0] eq "hstcreate") { &hstcreate; } +if ($ARGV[0] eq "addqso") { &addqso; } +if ($ARGV[0] eq "delqso") { &delqso; } +if ($ARGV[0] eq "comment") { &comment; } +if ($ARGV[0] eq "status") { &status; } +if ($ARGV[0] eq "state") { &status; } +if ($ARGV[0] eq "sys") { &sysfunc; } +if ($ARGV[0] eq "run") { &getrun; } +if ($ARGV[0] eq "date") { &getdate; } +if ($ARGV[0] eq "update") { &update; } +if ($ARGV[0] eq "test") { &test; } +if ($ARGV[0] eq "today") { &today; } + +print STDOUT "invalid mkrun command\n"; +exit 1; + +########################################################### + +###### +sub test { + + $date = mjd_to_date ($ARGV[1]); + print "$ARGV[1] : $date\n"; + exit 1; +} + +###### +sub sysfunc { + + $statedata = `gconfig STATE_DATA`; chop ($statedata); + if ($?) { die "can't find STATE_DATA\n"; } + + # show current state + if (@ARGV == 1) { + system ("cat $statedata"); + exit 0; + } + + if (@ARGV == 2) { + $var = "\U$ARGV[1]\E"; + if ($var eq "INIT") { goto initsys; } + if ($var eq "RUNID") { goto getsys; } + if ($var eq "PROCESS") { goto getsys; } + if ($var eq "NOTIFY") { goto getsys; } + if ($var =~ m|CAMERA.(\S+)|) { goto getsys; } + if ($var =~ m|RUNID.(\S+)|) { goto getsys; } + die "invalid sys parameter $var\n"; + + getsys: + open (FILE, "$statedata"); + @list = ; + close (FILE); + + foreach $line (@list) { + ($key, $value) = split (" ", $line); + $key = "\U$key\E"; + if ($key ne $var) { next; } + print STDOUT "$value\n"; + exit 0; + } + die "can't find entry $var\n"; + + initsys: + open (FILE, "$statedata"); + print FILE "# elixir current state\n"; + print FILE "\n"; + print FILE "RUNID 02Bk03\n"; + print FILE "PROCESS 02Bk03\n"; + print FILE "\n"; + print FILE "CAMERA.CURRENT none\n"; + print FILE "CAMERA.MKDETREND none\n"; + print FILE "CAMERA.MKFRINGE none\n"; + print FILE "CAMERA.POSTRUN none\n"; + print FILE "\n"; + print FILE "RUNID.CURRENT none\n"; + print FILE "RUNID.MKDETREND none\n"; + print FILE "RUNID.MKFRINGE none\n"; + print FILE "RUNID.POSTRUN none\n"; + print FILE "\n"; + print FILE "NOTIFY \n"; + close (FILE); + exit 0; + } + + if (@ARGV == 3) { + $var = "\U$ARGV[1]\E"; + $nval = $ARGV[2]; + if ($var eq "RUNID") { goto setsys; } + if ($var eq "PROCESS") { goto setsys; } + if ($var eq "NOTIFY") { goto setsys; } + if ($var =~ m|CAMERA.(\S+)|) { goto setsys; } + if ($var =~ m|RUNID.(\S+)|) { goto setsys; } + die "invalid sys parameter $var\n"; + + setsys: + open (FILE, "$statedata"); + @list = ; + close (FILE); + + $found = 0; + foreach $line (@list) { + ($key, $value) = split (" ", $line); + $key = "\U$key\E"; + if ($key ne $var) { next; } + $found = 1; + $line = sprintf "%-20s %s\n", $var, $nval; + } + + if (! $found) { die "can't find entry $var\n"; } + open (FILE, ">$statedata"); + foreach $line (@list) { + print FILE "$line"; + } + close (FILE); + exit 0; + } + + print "USAGE: mkrun sys\n"; + print "USAGE: mkrun sys init\n"; + print "USAGE: mkrun sys (key)\n"; + print "USAGE: mkrun sys (key) (value)\n"; + exit 1; +} + +###### +sub update { + + $now = time; + $mjd = &sec_to_mjd ($now); + + &load_runlist; + + $match = ""; + foreach $line (@runlist) { + if ($line =~ /^\#/) { next; } # skip commented lines + ($runid, $start, $stop, $camera) = split (" ", $line); + if ($runid eq "") { next; } # skip empty lines + $mjd_start = date_to_mjd ($start); + $mjd_stop = date_to_mjd ($stop); + if (($mjd >= $mjd_start) && ($mjd <= $mjd_stop)) { + $match = $line; + last; + } + } + if ($match eq "") { + $camera = "none"; + $runid = "none"; + } + system ("mkrun sys camera.current $camera"); + system ("mkrun sys runid.current $runid"); + system ("ssPut /e/state/$camera/cameraRun $runid COMMENT=\"valid current camera run ID (CRUNID)\" LIFETIME=90000"); + system ("ssPut /e/state/masterRun $runid COMMENT=\"master current camera run ID (CRUNID)\" LIFETIME=90000"); + exit 0; +} + +###### +sub today { + + $now = time; + $mjd = &sec_to_mjd ($now); + + &load_runlist; + + $match = ""; + foreach $line (@runlist) { + if ($line =~ /^\#/) { next; } # skip commented lines + ($runid, $start, $stop, $camera) = split (" ", $line); + if ($runid eq "") { next; } # skip empty lines + $mjd_start = date_to_mjd ($start); + $mjd_stop = date_to_mjd ($stop); + if (($mjd >= $mjd_start) && ($mjd <= $mjd_stop)) { + $match = $line; + last; + } + } + if ($match eq "") { + $camera = "none"; + $runid = "none"; + } + print STDOUT "CAMERA: $camera, RUNID: $runid\n"; + exit 0; +} + +###### +sub getrun { + + if (@ARGV != 2) { die "USAGE: mkrun run (runid)\n"; } + + &load_runlist; + $line = grab_runline ($ARGV[1]); + print STDOUT "$line\n"; + if ($line eq "") { + exit 1; + } else { + exit 0; + } +} + +###### +sub getdate { + + if (@ARGV != 2) { die "USAGE: mkrun date (yyyy/mm/dd)\n"; } + + my ($mjd) = date_to_mjd ($ARGV[1]); + + &load_runlist; + + foreach $line (@runlist) { + if ($line =~ /^\#/) { next; } # skip commented lines + ($runid, $start, $stop) = split (" ", $line); + if ($runid eq "") { next; } # skip empty lines + $mjd_start = date_to_mjd ($start); + $mjd_stop = date_to_mjd ($stop); + if (($mjd >= $mjd_start) && ($mjd < $mjd_stop)) { + print STDOUT "$line\n"; + exit 0; + } + } + print STDOUT ""; + exit 1; +} + +############ +sub status { + + &load_runlist; + foreach $line (@runlist) { + print STDOUT "$line\n"; + } + exit 0; +} + +############ +sub comment { + + my (@argv) = @_; + + if (@argv != 2) { + print STDOUT "USAGE: mkrun comment (comment line)\n"; + exit 2; + } + + $comment = $argv[1]; + + &load_runlist; + insert_comment ($argv[1]); + &save_runlist; + exit 0; +} + +############ +sub create { + + if (@ARGV != 5) { + print STDOUT "USAGE: mkrun create (run) (start) (stop) (camera)\n"; + exit 2; + } + + $runid = $ARGV[1]; + $start = $ARGV[2]; + $stop = $ARGV[3]; + $camera = $ARGV[4]; + + &load_runlist; + + $line = grab_runline ($runid); + ($Orunid, $Ostart, $Ostop, $Ocamera, $qrunid) = split (" ", $line); + $line = mk_runline ($runid, $start, $stop, $camera, $qrunid); + insert_runline ($line); + + # does not check for overlaps, but probably should + + &save_runlist; + exit 0; +} + +############ +sub delete { + + if (@ARGV != 2) { + print STDOUT "USAGE: mkrun delete (run)\n"; + exit 2; + } + + $runid = $ARGV[1]; + + &load_runlist; + + $Ns = @runlist; + delete_runline ($runid); + $Ne = @runlist; + + if ($Ns == $Ne) { + print STDERR "runid $runid not found\n"; + exit 1; + } + + &save_runlist; + exit 0; +} + +############ +sub hstcreate { + + if (@ARGV != 1) { + print STDOUT "USAGE: mkrun hstcreate\n"; + exit 2; + } + + print STDOUT "Enter HST date for start of first night (YYYY/MM/DD): "; + $start = ; chop $start; + $mjd = date_to_mjd ($start); + $mjd += 1.0; + $start = date_format (&mjd_to_date ($mjd)); + + print STDOUT "Enter HST date for start of last night (YYYY/MM/DD): "; + $stop = ; chop $stop; + $mjd = date_to_mjd ($stop); + $mjd += 2.0; + $stop = date_format (&mjd_to_date ($mjd)); + + print STDOUT "Enter camera: "; + $camera = ; chop $camera; + + print STDOUT "Enter run ID: "; + $runid = ; chop $runid; + + print STDOUT "Enter associated QSO run IDs (separated by commas): "; + $qrunid = ; chop $qrunid; + + &load_runlist; + +# $line = grab_runline ($runid); +# ($Orunid, $Ostart, $Ostop, $Ocamera, $Oqrunid) = split (" ", $line); + $line = mk_runline ($runid, $start, $stop, $camera, $qrunid); + insert_runline ($line); + + &save_runlist; + exit 0; +} + +############ +sub addqso { + if (@ARGV != 3) { + print STDOUT "USAGE: mkrun addqso (run) (qsorun)\n"; + exit 2; + } + + $runid = $ARGV[1]; + $qrunid = $ARGV[2]; + + &load_runlist; + + $line = grab_runline ($runid); + if ($line eq "") { + print STDERR "run id $runid not in run list\n"; + exit 1; + } + ($runid, $start, $stop, $camera, $Oqrunid) = split (" ", $line); + if ($Oqrunid) { + $qrunid = $Oqrunid . "," . $qrunid; + } + + $line = mk_runline ($runid, $start, $stop, $camera, $qrunid); + insert_runline ($line); + + &save_runlist; + exit 0; +} + +############ +sub delqso { + if (@ARGV != 2) { + print STDOUT "USAGE: mkrun delqso (qsorun)\n"; + exit 2; + } + + $qrunid = $ARGV[1]; + + &load_runlist; + + # find listed qrunid + $match = ""; + SEARCH: + foreach $line (@runlist) { + if ($line =~ /^\#/) { next; } # skip commented lines + ($tmp, $tmp, $tmp, $tmp, $qlist) = split (" ", $line); + @qlist = split (",", $qlist); + foreach $qid (@qlist) { + if ($qrunid ne $qid) { next; } + $match = $line; + last SEARCH; + } + } + if ($match eq "") { + print STDERR "QSO run id $qrunid not found in run list\n"; + exit 1; + } + + # recreate $qlist without $qrunid + @qnew = (); + foreach $qid (@qlist) { + if ($qid eq $qrunid) { next; } + push @qnew, $qid; + } + $qlist = join (",", @qnew); + + ($runid, $start, $stop, $camera) = split (" ", $match); + + $line = mk_runline ($runid, $start, $stop, $camera, $qlist); + insert_runline ($line); + + &save_runlist; + exit 0; +} + +####### runlist utilities ############################ +sub load_runlist { + open (FILE, "$runlist"); + @runlist = ; + foreach $line (@runlist) { + chop ($line); + } + close (FILE); +} + +sub save_runlist { + open (FILE, ">$runlist"); + foreach $line (@runlist) { + print FILE "$line\n"; + } + close (FILE); +} + +sub grab_runline { + my ($id) = $_[0]; + my ($line); + my ($runid); + + foreach $line (@runlist) { + if ($line =~ /^\#/) { next; } # skip commented lines + ($runid) = split (" ", $line); + if ($runid ne $id) { next; } + return ($line); + } + return (""); +} + +sub insert_comment { + my ($comment) = $_[0]; + + @runlist = (@runlist, $comment); + return 1; +} + +sub insert_runline { + my ($runline) = $_[0]; + my ($line); + my ($runid, $id); + + # match the run id lines + ($id) = split (" ", $runline); + foreach $line (@runlist) { + if ($line =~ /^\#/) { next; } # skip commented lines + ($runid) = split (" ", $line); + if ($runid ne $id) { next; } + $line = $runline; + return 1; + } + @runlist = (@runlist, $runline); + return 0; +} + +sub delete_runline { + my ($id) = $_[0]; + my ($line, $runid); + + # match the run id lines + @newlist = (); + foreach $line (@runlist) { + ($runid) = split (" ", $line); + if ($runid eq $id) { next; } + @newlist = (@newlist, $line); + } + @runlist = @newlist; + return 0; +} + +sub mk_runline { + my ($runid, $start, $stop, $camera, $qrunid, $line); + $runid = $_[0]; + $start = $_[1]; + $stop = $_[2]; + $camera = $_[3]; + $qrunid = $_[4]; + + $start = date_format ($start); + $stop = date_format ($stop); + $line = sprintf "%s %s %s %-9s %s", $runid, $start, $stop, $camera, $qrunid; + return ($line); +} + +# utilities ############################################## + +sub atcommand { + my ($cmd, $log, $time, $date); + $cmd = $_[0]; + $log = $_[1]; + $time = $_[2]; + $date = $_[3]; + + if (($log eq "") || ($log eq "NONE")) { $log = "/dev/null"; } + + printf "%s %s: %s\n", $date, $time, $cmd; + $line = sprintf "%s %s %s %s", $date, $time, $log, $cmd; + print SCHED "$line\n"; +} + + +sub vsystem { + # print STDERR "@_\n"; + my($status) = system ("@_"); + $status; +} + +sub goodbye { + die "@_\n"; +} + +sub date_format { + my ($date) = $_[0]; + my ($year, $month, $day); + + ($year, $month, $day) = $date =~ /(\d+)\/(\d+)\/(\d+)/; + $date = sprintf "%4d/%02d/%02d", $year, $month, $day; + return ($date); +} + +sub date_to_mjd { + my ($date) = $_[0]; + my ($year, $month, $day, $mjd); + + ($year, $month, $day) = $date =~ /(\d+)\/(\d+)\/(\d+)/; + + $mjd = get_mjd ($year, $month, $day); + + return ($mjd); +} + +sub mjd_to_date { + my ($mjd) = $_[0]; + my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday); + my ($date, $time); + + $time = 86400 * ($mjd - 40587.0); + ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday) = gmtime ($time); + $year += 1900; + $mon ++; + + $date = sprintf "%04d/%02d/%02d,%02d:%02d:%04.1f", $year, $mon, $mday, $hour, $min, $sec; + + return $date; +} + +sub sec_to_mjd { + my ($sec) = $_[0]; + my ($mjd); + + $mjd = $sec / 86400 + 40587.0; + return $mjd; +} + +# gmtime +# ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday) = gmtime(time); +# ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday) = localtime(time); +# $time = time +# 0 sec (unix) = 2440587.5 jd = 40587.0 mjd + +sub get_mjd { + + my($year) = $_[0]; + my($month) = $_[1]; + my($day) = $_[2]; + + my($jd) = $day - 32075 + int (1461*($year + 4800 + int (($month - 14)/12))/4) + + int(367*($month - 2 - int(($month - 14)/12)*12)/12) + - int(3*int(($year + 4900 + int(($month - 14)/12))/100)/4) - 0.5 - 2400000.5; + + return ($jd); +} + +sub usage { + + if (@ARGV == 1) { + print STDERR "create (runid) (start) (stop) (camera) - create / change a camera run\n"; + print STDERR "delete (runid) - delete a camera run\n"; + print STDERR "hstcreate - interactive camera run creation\n"; + print STDERR "addqso (runid) (qsoid) - add a qso run to camera run\n"; + print STDERR "delqso (qsoid) - delete a qso run\n"; + print STDERR "comment (line) - add a comment line to run list\n"; + print STDERR "status - check current run list\n"; + print STDERR "date (date) - return run info for given date\n"; + print STDERR "run (runid) - return run info for given camera run\n"; + print STDERR "\n"; + print STDERR "sys - display current system variables\n"; + print STDERR "sys init - set defaults for system variables\n"; + print STDERR "sys (key) - fetch value of system variable\n"; + print STDERR "sys (key) (value) - set value of system variable\n"; + print STDERR "\n"; + &goodbye; + } + + if (@ARGV > 2) { print STDERR "USAGE: prepare.run (help) [mode]\n"; &goodbye; } + + &goodbye; +} + + + +############## +sub mk_events { + my ($runid, $start, $stop); + $runid = $_[0]; + $start = $_[1]; + $stop = $_[2]; + + $mjd_start = date_to_mjd ($start); + $mjd_stop = date_to_mjd ($stop); + + $Nday = $mjd_stop - $mjd_start + 1; + + if (! -e $schedule) { + # create a new schedule with PREVIOUS set to NEVER + open (SCHED, ">$schedule"); + print SCHED "# schedule for scheduler system\n"; + print SCHED "# E. Magnier\n"; + print SCHED "\n"; + print SCHED "# last time scheduler was run:\n"; + print SCHED "PREVIOUS NEVER\n"; + print SCHED "\n"; + close (SCHED); + } + + open (SCHED, ">>$schedule"); + print "\n"; + $date = `date "+%Y/%m/%d %k:%M:%S"`; chop ($date); + print SCHED "# added $date\n"; + + + ($year, $month, $day) = $start =~ /(\d+)\/(\d+)\/(\d+)/; + for ($Day = -1; $Day < $Nday + 7; $Day++) { + + $tday = $day + $Day - 1; + $date = `date -d $year/$month/$tday +%Y/%m/%d`; chop ($date); + + if ($Day == 0) { + atcommand ("mkrun sys RUNID $runid", "$logdir/config.log", "10:00", $date); + atcommand ("checkconfig -ckdirs", "$logdir/config.log", "10:00", $date); + atcommand ("mkdetrend create $runid $start $stop", "$logdir/mkdetrend.log", "10:00", $date); + atcommand ("mkfringe config $runid", "$logdir/mkdetrend.log", "10:00", $date); + atcommand ("mkfringe mkconfig", "$logdir/mkdetrend.log", "10:00", $date); + } + if ($Day == 4) { + atcommand ("mkdetrend auto set update", "$logdir/mkdetrend.log", "10:00", $date); + } + if ($Day == $Nday) { + atcommand ("mkdetrend auto set hold", "$logdir/mkdetrend.log", "10:00", $date); + } + } + close (SCHED); + +} + + +############## + +sub sched { + if (@ARGV != 2) { + print STDOUT "USAGE: mkrun sched (runid)\n"; + exit 2; + } + + $runid = $ARGV[1]; + &load_runlist; + + $line = grab_runline ($runid); + ($runid, $start, $stop, $camera, $qlist) = split (" ", $line, 4); + + mk_events ($runid, $start, $stop); + + exit 0; +} + +if ($ARGV[0] eq "sched") { &sched (@ARGV); } Index: /tags/ohana/perl-1-3/Ohana/src/perl/src/mkscat =================================================================== --- /tags/ohana/perl-1-3/Ohana/src/perl/src/mkscat (revision 21906) +++ /tags/ohana/perl-1-3/Ohana/src/perl/src/mkscat (revision 21906) @@ -0,0 +1,72 @@ +#!/usr/bin/env perl + +# warning: this function currently uses a fixed temporary name 'fix.NN.fits' +# for the intermediate product. If we add this to elixir, convert to mktemp + +# need to assimilate the -c -C -D cmd line options -> env + +# check the usage +if ($ARGV[0] eq "-h") { &usage (); } +if ($ARGV[0] eq "-help") { &usage (); } +if (@ARGV != 5) { &usage (); } + +# find the appropriate script file +$confdir = `gconfig -q CONFDIR`; chop ($confdir); +$script = "$confdir/mana/scatter.pro"; + +# run mana script: +open (MANA, "|mana --norc"); +print MANA "input $script\n"; +print MANA "mkscat $ARGV[0] $ARGV[1] $ARGV[2] $ARGV[3] $ARGV[4]\n"; +print MANA "exit 1\n"; +close (MANA); +print STDERR "exit statue: $?\n"; +if ($? == 2 * 256) { + print STDERR "no scattered light term available\n"; + exit 2; +} +if ($?) { die "ERROR problem with mkscat\n"; } + +print STDOUT "SUCCESS: finished with mkscat\n"; +exit 0; + +sub vsystem { + print STDERR "@_\n"; + $status = system ("@_"); + $status; +} + +sub goodbye { + die "@_\n"; +} + +sub usage { + print "USAGE: mkscat (mosiac) (start) (stop) (filter) (ID)\n"; + exit 1; +} + +# mana within perl: we embed the mana functions within a macro to trap the +# exit status. If mana has an error with one of the steps, it will exit the macros and +# the second exit will be called. Otherwise, the "go" macro will perform the exit 0 +# and mana will exit with status 0 + +# there are two possible flat-field photometric corrections: additive +# and multiplicative: +# The correction images constructed by examining +# the *difference* between dome-flats with and without the petals +# covered is additive: FLAT_new = (FLAT_old - SCAT) * A +# (A is set to maintain the original normalization of chip 04) +# +# The correction images constructed by examining stellar magnitude +# difference is multiplicative: FLAT_new = (FLAT_old * SCAT) * A +# (A is set to maintain the original normalization of chip 04) + +# there is a different scattered light image for each filter. +# (these images are the same file for the additive version) + +# there should be no arbitrary normalization in the scattered frames +# in the database. (we used to multiply the scattered light image by a +# value of 10.0). + +# images of the first class will be identified with the label scatter-A.0 +# images of the second class will be identified with the label scatter-B.0 Index: /tags/ohana/perl-1-3/Ohana/src/perl/src/mktrans =================================================================== --- /tags/ohana/perl-1-3/Ohana/src/perl/src/mktrans (revision 21906) +++ /tags/ohana/perl-1-3/Ohana/src/perl/src/mktrans (revision 21906) @@ -0,0 +1,141 @@ +#!/usr/bin/env perl + +if (@ARGV != 2) { die "USAGE: mktrans (start) (stop)\n" ;} + +$start = $ARGV[0]; +$stop = $ARGV[1]; + +@photcodes = split (" ", `filtnames list`); + +foreach $code (@photcodes) { + + print STDERR "filter: $code\n"; + @list = `photsearch -trange $start $stop -photcode $code`; + if (! @list) { next; } + + # the lines from photsearch look like this: + # filter date zp dzp N T label (N - Nmeas, T - Ntime) + # V 2001/02/03,15:38:53 26.249 0.017 3 1 elixir + + if (1) { + + # first pass, get list of zp, sort, find median + @zp = (); + $sumN = $sumM = $sum1 = $sum2 = $n = 0; + foreach $line (@list) { + @words = split (" ", $line); + push @zp, $words[2]; + $sumN ++; + $sumM += $words[5]; + } + @zp = sort {$a <=> $b} @zp; + + $N = @zp; + for ($i = 0.2*$N; $i < 0.8*$N; $i++) { + $sum1 += $zp[$i]; + $sum2 += $zp[$i]*$zp[$i]; + $n ++; + } + + $zp = $sum1 / $n; + $dzp = sqrt (abs($sum2 / $n - $zp*$zp)); + + printf STDOUT "photreg -trans -photcode $code -zp %6.3f -dzp %6.4f -trange $start $stop -Nmeas $sumM -Ntime $sumN\n", $zp, $dzp; + + } else { + # use date hashes to extract stats for each date: + @dates = (); + foreach $line (@list) { + + # parse the line for the date + @words = split (" ", $line); + ($date) = $words[1] =~ /(\d\d\d\d\/\d\d\/\d\d),/; + + # if this is a new date, save it in the list + unless ($sum1{$date}) { @dates = (@dates, $date); } + + # add to the stats + $sumN{$date} ++; + $sumM{$date} += $words[5]; + $sum1{$date} += $words[2]; + $sum2{$date} += $words[2]*$words[2]; + } + + @sdates = sort by_date @dates; + + # calculate mean and stdev for each date + foreach $date (@sdates) { + + $Nm = $sumM{$date}; + $Np = $sumN{$date}; + $zp = $sum1{$date} / $Np; + $dzp = sqrt (abs($sum2{$date} / $Np - $zp*$zp)); + + printf STDOUT "photreg -trans -photcode $code -zp %6.3f -dzp %6.4f -trange $start $stop -Nmeas $Nm -Ntime $Np\n", $zp, $dzp; + } + + %sumM = (); + %sumN = (); + %sum1 = (); + %sum2 = (); + print STDOUT "\n"; + } + +} + +exit 0; + +sub by_date { + + ($year, $month, $day) = $a =~ /(\d\d\d\d).(\d\d).(\d\d)/; + $va = get_jd ($year, $month, $day); + ($year, $month, $day) = $b =~ /(\d\d\d\d).(\d\d).(\d\d)/; + $vb = get_jd ($year, $month, $day); + $va <=> $vb; +} + + + +################################################################################### + +sub vsystem { + print STDERR "@_\n"; + $status = system ("@_"); + $status; +} + +sub goodbye { + die "@_\n"; +} + + +sub get_jd { + + my($year) = $_[0]; + my($month) = $_[1]; + my($day) = $_[2]; + + my($jd) = $day - 32075 + int (1461*($year + 4800 + int (($month - 14)/12))/4) + + int(367*($month - 2 - int(($month - 14)/12)*12)/12) + - int(3*int(($year + 4900 + int(($month - 14)/12))/100)/4) - 0.5; + + + return ($jd); + +} + +sub get_mjd { + + my($year) = $_[0]; + my($month) = $_[1]; + my($day) = $_[2]; + + my($jd) = $day - 32075 + int (1461*($year + 4800 + int (($month - 14)/12))/4) + + int(367*($month - 2 - int(($month - 14)/12)*12)/12) + - int(3*int(($year + 4900 + int(($month - 14)/12))/100)/4) - 0.5 - 2400000.5; + + + return ($jd); + +} + Index: /tags/ohana/perl-1-3/Ohana/src/perl/src/mktreport =================================================================== --- /tags/ohana/perl-1-3/Ohana/src/perl/src/mktreport (revision 21906) +++ /tags/ohana/perl-1-3/Ohana/src/perl/src/mktreport (revision 21906) @@ -0,0 +1,135 @@ +#!/usr/bin/env perl + +if (@ARGV != 2) { die "USAGE: mktreport (start) (stop)\n" ;} + +$start = $ARGV[0]; +$stop = $ARGV[1]; + +@photcodes = split (" ", `filtnames list`); + +@list = `photsearch -trans -offset`; + +# the lines from transearch look like this: +# R 2001/04/15,00:00:00 -0.032 26.259 0.004 0.040 -0.090 B_L92 V_L92 5 15 elixir +# (date) (ZP) (ZPo) (sigma) + +@dates = (); + +# get the complete list of unique dates: + +LIST: +foreach $line (@list) { + + # parse the line for the date + @words = split (" ", $line); + ($date) = $words[1] =~ /(\d\d\d\d\/\d\d\/\d\d),/; + + unless ($found{$date}) { @dates = (@dates, $date); $found{$date} = 1; } + + for ($i = 0; $i < @photcodes; $i++) { + + if ($words[0] ne $photcodes[$i]) { next; } + + $name1 = "ZPo$i"; + $name2 = "dZP$i"; + $$name1{$date} = $words[2] - $words[3]; + $$name2{$date} = $words[4]; + next LIST; + } + + print STDERR "$words[0] not found in photcode list\n"; +} + +@sdates = sort by_date @dates; + +print STDOUT " "; +for ($i = 0; $i < @photcodes; $i++) { + printf STDOUT "%6s ", $photcodes[$i]; +} +print STDOUT " "; +for ($i = 0; $i < @photcodes; $i++) { + printf STDOUT "%6s ", "d$photcodes[$i]"; +} +print STDOUT "\n"; + +foreach $date (@sdates) { + + print STDOUT "$date "; + + for ($i = 0; $i < @photcodes; $i++) { + $name = "ZPo$i"; + if ($$name{$date}) { + printf STDOUT "%6.3f ", $$name{$date}; + } else { + print STDOUT " - "; + } + } + print STDOUT " "; + for ($i = 0; $i < @photcodes; $i++) { + $name = "dZP$i"; + if ($$name{$date}) { + printf STDOUT "%6.3f ", $$name{$date}; + } else { + print STDOUT " - "; + } + } + + print STDOUT "\n"; +} + +exit 0; + +sub by_date { + + ($year, $month, $day) = $a =~ /(\d\d\d\d).(\d\d).(\d\d)/; + $va = get_jd ($year, $month, $day); + ($year, $month, $day) = $b =~ /(\d\d\d\d).(\d\d).(\d\d)/; + $vb = get_jd ($year, $month, $day); + $va <=> $vb; +} + + + +################################################################################### + +sub vsystem { + print STDERR "@_\n"; + $status = system ("@_"); + $status; +} + +sub goodbye { + die "@_\n"; +} + + +sub get_jd { + + my($year) = $_[0]; + my($month) = $_[1]; + my($day) = $_[2]; + + my($jd) = $day - 32075 + int (1461*($year + 4800 + int (($month - 14)/12))/4) + + int(367*($month - 2 - int(($month - 14)/12)*12)/12) + - int(3*int(($year + 4900 + int(($month - 14)/12))/100)/4) - 0.5; + + + return ($jd); + +} + +sub get_mjd { + + my($year) = $_[0]; + my($month) = $_[1]; + my($day) = $_[2]; + + my($jd) = $day - 32075 + int (1461*($year + 4800 + int (($month - 14)/12))/4) + + int(367*($month - 2 - int(($month - 14)/12)*12)/12) + - int(3*int(($year + 4900 + int(($month - 14)/12))/100)/4) - 0.5 - 2400000.5; + + + return ($jd); + +} + Index: /tags/ohana/perl-1-3/Ohana/src/perl/src/mosaic.merge =================================================================== --- /tags/ohana/perl-1-3/Ohana/src/perl/src/mosaic.merge (revision 21906) +++ /tags/ohana/perl-1-3/Ohana/src/perl/src/mosaic.merge (revision 21906) @@ -0,0 +1,110 @@ +#!/usr/bin/env perl +# this program takes a file template, with CCDNUM substituted for the +# CCD number. each file contains the ccd frames as separate extents. The program +# loads the names, then for each frame, it goes through the CCDNUM entries +# and mosaics together the appropriate image, writing them to an output filename +# formed from ARGV[1] (ARGV[1].n.jpg). These names are written to ARGV[1] +# +# this program returns immediately if all CCDNUM entries are not found. +# the previous function, detstats, must not create the *.stats file until the +# process is done. similarly, this program deletes the *.stats files to avoid +# confusion on a second pass + +@ccds = split (" ", `cameraconfig -ccdn`); +if ($?) { die "ERROR: configuration problem\n"; } + +if (@ARGV != 3) { die "ERROR: USAGE: mosaic.tenbin (name) (out) (type)\n" } +$type = "\U$ARGV[2]\E"; + +# find the appropriate script file +$confdir = `gconfig -q CONFDIR`; chop $confdir; +$script = "$confdir/mana/flips.pro"; + +# test named Xserver, or start vnc on specified machine +$xhost = `gconfig -q XHOST`; chop $xhost; +$xdisp = `gconfig -q XDISP`; chop $xdisp; +if (vsystem ("xdpyinfo -display $xdisp")) { + print STDERR "ERROR: X server is not running. start it now on $xhost\n"; + exit 1; +} +$ENV{'DISPLAY'} = $xdisp; + +# check for the existence of each input file, exit if non-existent +foreach $ccd (@ccds) { + $name = $ARGV[0]; + $name =~ s/CCDNUM/$ccd/; + unless (-r $name) { + print STDERR "ERROR: can't find all files\n"; + exit 1; + } +} + +# we are constructing the names of the input files. there are NCCD +# files with names of the form path/01Ak01.flat.I.CCDNUM.0.medbin we +# need to loop over all NEXTEND entries in these files, creating +# NEXTEND output images. First check that each file has the same NEXTEND + +@filenames = (); +foreach $ccd (@ccds) { + $name = $ARGV[0]; + $name =~ s/CCDNUM/$ccd/; + push @filenames, $name; + + ($junk, $N) = split (" ", `echo $name | fields NEXTEND`); + if ($ccd eq $ccds[0]) { + $Nline = $N; + } + if ($N != $Nline) { die "ERROR: mis-matched number of images in $name\n"; } +} + +open (MANA, "|mana --norc"); +print MANA "input $script\n"; + +# define list of names as mana list +print MANA "list names\n"; +foreach $name (@filenames) { + print MANA "$name\n"; +} +print MANA "end\n"; + +# define macro for 1 image +print MANA "macro mkimage\n"; +print MANA " mergemosaic \$1\n"; +if ($type eq "RAW") { print MANA " jpgraw \$2\n"; } +if ($type eq "FLAT") { print MANA " jpgnorm \$2\n"; } +if ($type eq "BIAS") { print MANA " jpgmosaic \$2\n"; } +if ($type eq "DARK") { print MANA " jpgmosaic \$2\n"; } +print MANA "end\n"; + +# define macro for image list +print MANA "macro go\n"; +open (LIST, ">$ARGV[1]"); +for ($i = 0; $i < $Nline; $i++) { + $outfile = sprintf "%s.%03d.jpg", $ARGV[1], $i; + print MANA " mkimage $i $outfile\n"; + print LIST "$outfile\n"; +} +close (LIST); +print MANA " exit 0\n"; +print MANA "end\n"; +print MANA "go\n"; +print MANA "exit 1\n"; +close (MANA); +if ($?) { + print STDERR "ERROR running mana\n"; + exit 1; +} + +print STDOUT "SUCCESS\n"; +exit 0; + +sub vsystem { + print STDERR "@_\n"; + $status = system ("@_"); + $status; +} + +sub goodbye { + die "@_\n"; +} + Index: /tags/ohana/perl-1-3/Ohana/src/perl/src/mosaic.stats =================================================================== --- /tags/ohana/perl-1-3/Ohana/src/perl/src/mosaic.stats (revision 21906) +++ /tags/ohana/perl-1-3/Ohana/src/perl/src/mosaic.stats (revision 21906) @@ -0,0 +1,156 @@ +#!/usr/bin/env perl +# this program takes a list template, with CCDNUM substituted for the +# CCD number. each file contains a list of statistics for each image. The program +# loads the names, then for each frame, it goes through the CCDNUM entries +# and loads the appropriate statistics, writing them to the output file +# +# this program returns immediately if all CCDNUM entries are not found. +# the previous function, detstats, must not create the *.stats file until the +# process is done. similarly, this program deletes the *.stats files to avoid +# confusion on a second pass + +@ccdn = split (" ", `cameraconfig -ccdn`); +@ccds = split (" ", `cameraconfig -ccds`); +if ($?) { die "ERROR: configuration problem\n"; } + +sub vsystem { + print STDERR "@_\n"; + $status = system ("@_"); + $status; +} + +sub goodbye { + die "@_\n"; +} + +if (@ARGV != 3) { die "ERROR: USAGE: mosaic.stats (name) (out) (type)\n" } + +$type = "\U$ARGV[2]\E"; + +# load option list of ccds to skip (specific to run/camera) +$CHIPSKIP = `gconfig CHIP_SKIP_LIST`; chop $CHIPSKIP; +@chipskip = (); +if (-e $CHIPSKIP) { + open (FILE, $CHIPSKIP); + @chipskip = ; + close (FILE); + foreach $chip (@chipskip) { chop $chip; } +} + +# modify the list of ccds to exclude chipskip entries +$N = @ccds; +CCD: for ($i = 0; $i < $N; $i++) { + $ccds = shift @ccds; + $ccdn = shift @ccdn; + + foreach $skip (@chipskip) { if ($skip eq $ccds) { next CCD; } } + push @ccds, $ccds; + push @ccdn, $ccdn; +} + +# check for the existence of each input file, exit if non-existent +foreach $ccd (@ccdn) { + $name = $ARGV[0]; + $name =~ s/CCDNUM/$ccd/; + unless (-r $name) { + print STDERR "ERROR: can't find $name\n"; + exit (0); + } +} + +# load in stats from files (Nlist*Nccd entries) +# each file contains stats for a single ccd, for all N files +foreach $ccd (@ccdn) { + $name = $ARGV[0]; + $name =~ s/CCDNUM/$ccd/; + + open (FILE, $name); + @$ccd = ; + close (FILE); + + if ($ccd eq $ccdn[0]) { $Nline = @$ccd; } + if (@$ccd != $Nline) { die "ERROR mis-matched file lengths\n"; } +} + +$dawn = 0; +$dusk = 1; +@pdate = (); +@ptwil = (); +$Nperiod = 0; +@period = (); + +open (OUTPUT, ">$ARGV[1]"); +for ($i = 0; $i < $Nline; $i++) { + + $mean = 0; + $medn = 0; + $sig12 = 0; + $sig22 = 0; + $mean2 = 0; + $mbin = 0; + $sbin2 = 0; + $mbin2 = 0; + + foreach $ccd (@ccdn) { + $line = $$ccd[$i]; + chop ($line); + @words = split (" ", $line); + $file = $words[0]; + $date = $words[1]; + $time = $words[2]; + $stat = $words[9]; + $mean += $words[3]; + $medn += $words[4]; + $sig12 += $words[5]*$words[5]; + $sig22 += $words[6]*$words[6]; + $mean2 += $words[3]*$words[3]; + + $mbin += $words[7]; + $sbin2 += $words[8]*$words[8]; + $mbin2 += $words[7]*$words[7]; + } + $N = @ccdn; + + # identify even or morn twilight + @words = split (':', $time); + if (($words[0] > 12) && ($words[0] < 24)) { + $twilite = $dawn; + } else { + $twilite = $dusk; + } + $ThisPeriod = -1; + for ($j = 0; $j < $Nperiod; $j++) { + if (($pdate[$j] eq $date) && ($ptwil[$j] == $twilite)) { + $ThisPeriod = $j; + last; + } + } + if ($ThisPeriod == -1) { + $ThisPeriod = $Nperiod; + @pdate = (@pdate, $date); + @ptwil = (@ptwil, $twilite); + $Nperiod ++; + } + @period = (@period, $ThisPeriod); + + # determine global statistics + $Mean = $mean / $N; + $Medn = $medn / $N; + $Mbin = $mbin / $N; + + if ($type eq "FLAT") { + $Sig1 = sqrt ($sig12 / $N + $mean2 / $N - $Mean*$Mean) / abs ($Mean); + $Sig2 = sqrt ($sig22 / $N + $mean2 / $N - $Mean*$Mean) / abs ($Mean); + $Sbin = sqrt ($sbin2 / $N + $mbin2 / $N - $Mbin*$Mbin) / abs ($Mbin); + } else { + $Sig1 = sqrt ($sig12 / $N + $mean2 / $N - $Mean*$Mean); + $Sig2 = sqrt ($sig22 / $N + $mean2 / $N - $Mean*$Mean); + $Sbin = sqrt ($sbin2 / $N + $mbin2 / $N - $Mbin*$Mbin); + } + + printf OUTPUT "%6s %10s %11s %7.1f %7.1f %6.4f %6.4f %7.1f %6.4f %d %s %d %d\n", + $file, $date, $time, $Mean, $Medn, $Sig1, $Sig2, $Mbin, $Sbin, $period[$i], $pdate[$period[$i]], $ptwil[$period[$i]], $stat; + +} +close (OUTPUT); +print STDERR "SUCCESS\n"; Index: /tags/ohana/perl-1-3/Ohana/src/perl/src/normalize =================================================================== --- /tags/ohana/perl-1-3/Ohana/src/perl/src/normalize (revision 21906) +++ /tags/ohana/perl-1-3/Ohana/src/perl/src/normalize (revision 21906) @@ -0,0 +1,306 @@ +#!/usr/bin/env perl + +$revline = "\$Revision: 1.6 $?"; +($version) = $revline =~ m|\$Revision:\s*(\S*)|; + +# default variable values +$start = 0; +$stop = 0; +$oldflips = 0; +$addtime = 0; +$addconfig = 0; + +# grab the command line options +@tARGV = (); +for (; @ARGV > 0; ) { + if ($ARGV[0] eq "-oldflips") { + $oldflips = 1; + shift; next; + } + if ($ARGV[0] eq "-time") { + $addtime = 1; + $start = $ARGV[1]; + $stop = $ARGV[2]; + shift; shift; shift; next; + } + if ($ARGV[0] eq "-config") { + $addconfig = 1; + $elconf = $ARGV[1]; + shift; shift; next; + } + if ($ARGV[0] eq "-h") { &usage; } + if ($ARGV[0] eq "--help") { &usage; } + @tARGV = (@tARGV, $ARGV[0]); + shift; +} +@ARGV = @tARGV; + +if (@ARGV != 4) { &usage; } +if ($addtime && ("$start" == "")) { &usage; } +if ($addtime && ("$stop" == "")) { &usage; } + +# command line arguments +$input = $ARGV[0]; +$output = $ARGV[1]; +$ref = $ARGV[2]; +$type = uppercase ($ARGV[3]); + +$ccdword = `gconfig -q CCDNUM-KEYWORD`; chop ($ccdword); +$typeword = `gconfig -q IMAGETYPE-KEYWORD`; chop ($typeword); +$dbmode = `gconfig -q DETREND-DB-MODE`; chop ($dbmode); + +# choose appropriate type +if ($type eq "FLAT") { &mk_flat; } +if ($type eq "DARK") { &mk_dark; } +if ($type eq "BIAS") { &mk_dark; } +print STDERR "unknown type $type"; +exit 1; + +sub mk_dark { +# create mana macro, run (allows exit status to be checked) + open (MANA, "|mana --norc"); + print MANA "macro go\n"; + print MANA "echo 'starting normalize'\n"; + print MANA "rd a $input\n"; + print MANA "keyword a $typeword -w $type\n"; + + if ($addtime == 1) { + print MANA "keyword a TVSTART -w $start\n"; + print MANA "keyword a TVSTART -wc \"data validity start time\"\n"; + print MANA "keyword a TVSTOP -w $stop\n"; + print MANA "keyword a TVSTOP -wc \"data validity start time\"\n"; + } + if ($addconfig == 1) { + print MANA "keyword a ELCONF -w $elconf\n"; + print MANA "keyword a ELCONF -wc \"Original Elixir config\"\n"; + } + + $elsys = `gconfig ELIXIR_VERSION`; chop ($elsys); + @time = localtime; + $now = sprintf "%04d-%02d-%02dT%02d:%02d:%02d", $time[5]+1900, $time[4]+1, $time[3], $time[2], $time[1], $time[0]; + $elsys = `gconfig ELIXIR_VERSION`; chop ($elsys); + print MANA "keyword a EL_SYS -w \"$elsys\"\n"; + print MANA "keyword a EL_SYS -wc \"Elixir System Version\"\n"; + print MANA "keyword a EL_NRM -w \"$version\"\n"; + print MANA "keyword a EL_NRM -wc \"Elixir Normalize Version\"\n"; + print MANA "keyword a REL_DATE -w \"$now\"\n"; + print MANA "keyword a REL_DATE -wc \"UTC Release Date\"\n"; + + print MANA "keyword a COMMENT -ws \"Elixir:normalize $version\"\n"; + print MANA "keyword a COMMENT -ws \"no renormalization needed for $type\"\n"; + print MANA "wd a $output -bitpix 16 -bzero 32668.0 -bscale 1.0\n"; + print MANA "echo normlized done ($input to $output)\n"; + print MANA "exit 0\n"; + print MANA "end\n"; # end of macro 'go' + + print MANA "go\n"; + print MANA "exit 1\n"; + close (MANA); + if ($?) { + print STDERR "ERROR problem running mana in normalize (bias, dark)\n"; + exit 1; + } + print STDOUT "SUCCESS: finished with normalize\n"; + exit 0; +} + +sub mk_flat { + # check on reference existence (not needed for BIAS, DARK) + if (! -f $ref) { + print STDERR "ERROR: ref file $args[3] is missing\n"; + exit 1; + } + $chipref = `gconfig FLIPS_REF_CCD`; chop ($chipref); + $baseref = $chipref; + print STDERR "Normalizing reference: using file $ref\n"; + + # Check that FLIPS_REF_CCD is not in CHIPSKIP, otherwise find another CCD + $Nccd = `cameraconfig -Nccd`; chop ($Nccd); + @ccdn = split (" ", `cameraconfig -ccdn`); + $CHIPSKIP = `gconfig CHIP_SKIP_LIST`; chop $CHIPSKIP; + @chipskip = (); + if (-e $CHIPSKIP) { + + open (FILE, $CHIPSKIP); + @chipskip = ; + close (FILE); + foreach $chip (@chipskip) { chop $chip; } + + foreach $chip (@chipskip) { + $chip =~ s/ccd//; + if ($chip eq $chipref) { + print STDERR "Warning: found reference chip in skip list ($chipref)\n"; + + # Find a new reference: increment by one + for ($i = 0; $i < $Nccd; $i++) { + $ccdindex = $ccdn[$i]; + if ( $ccdindex eq $chipref ) { + $newref = $ccdn[$i + 1]; + } + } + $chipref = $newref + } + } + # Substitute the CCD reference number in the name of the ref FITS file + $ref =~ s/.$baseref./.$chipref./; + print STDERR "New SkipChip selection: using ref file $ref\n"; + } + + # we need keywords defined by the process (flips) which creates the master frame + if ($oldflips) { + # these lines were used before flips was upgraded to add the DATAMODE keywords + $answer = `fhead $ref | grep "Output file mode"`; + @words = split (" ", $answer); + $refmode = $words[-1]; + + $answer = `fhead $input | grep "Output file mode"`; + @words = split (" ", $answer); + $mode = $words[-1]; + } else { + # various options for datamode, refmode: + + # check for readout mode + ($junk, $amplist) = split (" ", `echo $input | fields AMPLIST`, 2); + if ($? == 0) { + # multiamp mode, expect IMMODE$amp, create FLATSCL$amp + @amps = split (" ", $amplist); + foreach $amp (@amps) { + ($junk, $mode) = split (" ", `echo $input | fields IMMODE$amp`); + if ($?) { die "ERROR: missing IMMODE$amp\n"; } + @ampmode = (@ampmode, $mode); + } + } + # try new IMMODE keyword: + $modeword = "IMMODE"; + ($junk, $mode) = split (" ", `echo $input | fields $modeword`); + if ($?) { + if (@amps) { die "ERROR: multiamp mode missing IMMODE\n"; } + $modeword = "DATAMODE"; + ($junk, $mode) = split (" ", `echo $input | fields $modeword`); + if ($?) { die "ERROR: missing DATAMODE & IMMODE\n"; } + } + ($junk, $refmode) = split (" ", `echo $ref | fields $modeword`); + if ($?) { die "ERROR: ref file missing $modeword\n"; } + } + ($junk, $refccd) = split (" ", `echo $ref | fields $ccdword`); + if ($?) { die "ERROR: ref file missing $ccdword in ref\n"; } + + # grab mask file + $mask = `detsearch -quiet -image $input 0 split -type mask`; chop ($mask); + if ($? || ($mask eq "")) { + print STDERR "can't find mask for this image, no mask applied\n"; + $mask = "none"; + } + + # run MANA + open (MANA, "|mana --norc"); + print MANA "macro go\n"; + print MANA "echo 'starting normalize'\n"; + print MANA "rd a $input\n"; + print MANA "\$CCDKEYWORD = $ccdword\n"; + print MANA "keyword a $ccdword ccd\n"; + if ($mask eq "none") { + print MANA "set b = a / $refmode\n"; + } else { + if ($dbmode eq "MEF") { + print MANA "rd c $mask -n \$ccd\n"; + } else { + print MANA "rd c $mask\n"; + } + print MANA "set b = (a / $refmode) * c\n"; + } + + $scale = $refmode / $mode; + $newmode = $mode / $refmode; + print MANA "keyword b $modeword -wf $newmode\n"; + print MANA "keyword b FLATSCAL -wf $scale\n"; + + if (@amps) { + for ($i = 0; $i < @amps; $i++) { + $amp = $amps[$i]; + $scale = $refmode / $ampmode[$i]; + $newmode = $ampmode[$i] / $refmode; + print MANA "keyword b IMMODE$amp -wf $newmode\n"; + print MANA "keyword b FLATSCL$amp -wf $scale\n"; + } + } + print MANA "keyword b $typeword -w $type\n"; + if ($addtime == 1) { + print MANA " keyword b TVSTART -w $start\n"; + print MANA " keyword b TVSTART -wc \"data validity start time\"\n"; + print MANA " keyword b TVSTOP -w $stop\n"; + print MANA " keyword b TVSTOP -wc \"data validity start time\"\n"; + } + if ($addconfig == 1) { + print MANA "keyword b ELCONF -w $elconf\n"; + print MANA "keyword b ELCONF -wc \"Original Elixir config\"\n"; + } + + @time = localtime; + $now = sprintf "%04d-%02d-%02dT%02d:%02d:%02d", $time[5]+1900, $time[4]+1, $time[3], $time[2], $time[1], $time[0]; + $elsys = `gconfig ELIXIR_VERSION`; chop ($elsys); + print MANA "keyword b EL_SYS -w \"$elsys\"\n"; + print MANA "keyword b EL_SYS -wc \"Elixir System Version\"\n"; + print MANA "keyword b EL_NRM -w \"$version\"\n"; + print MANA "keyword b EL_NRM -wc \"Elixir Normalize Version\"\n"; + print MANA "keyword b REL_DATE -w \"$now\"\n"; + print MANA "keyword b REL_DATE -wc \"UTC Release Date\"\n"; + + print MANA "keyword b COMMENT -ws \"Elixir:normalize version $version\"\n"; + print MANA "keyword b COMMENT -ws \"FLAT image normalized wrt CCD $refccd\"\n"; + print MANA "clip b 0.0 0.0 6.4 0.0\n"; + print MANA "wd b $output -bitpix 16 -bzero 3.2 -bscale 0.0001\n"; + print MANA "echo normlized done ($input to $output)\n"; + print MANA "exit 0\n"; + print MANA "end\n"; # end of macro 'go' + + print MANA "go\n"; + print MANA "exit 1\n"; + close (MANA); + if ($?) { + print STDERR "ERROR problem running mana in normalize (flat)\n"; + exit 1; + } + print STDOUT "SUCCESS: finished with normalize\n"; + exit 0; +} + +sub vsystem { + print STDERR "@_\n"; + $status = system ("@_"); + $status; +} + +sub goodbye { + die "@_\n"; +} + +sub uppercase { + return "\U$_[0]\E"; +} + +# given a filename, check that its path exists, create it if not +sub ckpathname { + my ($file) = $_[0]; + my (@words, $dir); + + @words = split ("/", $file); + pop (@words); + $dir = join ("/", @words); + + if ($dir eq "") { $dir = "."; } + + if (! -d $dir) { + system ("mkdir -p $dir"); + if ($?) { + print STDERR "ERROR: can't make directory component for $file\n"; + exit 1; + } + } +} + +sub usage { + print STDERR "normalize (input) (output) (ref) (type) [-time start stop] [-oldflips]\n"; + exit 2; +} + Index: /tags/ohana/perl-1-3/Ohana/src/perl/src/normalize.pre12KfiltersHandling =================================================================== --- /tags/ohana/perl-1-3/Ohana/src/perl/src/normalize.pre12KfiltersHandling (revision 21906) +++ /tags/ohana/perl-1-3/Ohana/src/perl/src/normalize.pre12KfiltersHandling (revision 21906) @@ -0,0 +1,271 @@ +#!/usr/bin/env perl + +$revline = "\$Revision: 1.1 $?"; +($version) = $revline =~ m|\$Revision:\s*(\S*)|; + +# default variable values +$start = 0; +$stop = 0; +$oldflips = 0; +$addtime = 0; +$addconfig = 0; + +# grab the command line options +@tARGV = (); +for (; @ARGV > 0; ) { + if ($ARGV[0] eq "-oldflips") { + $oldflips = 1; + shift; next; + } + if ($ARGV[0] eq "-time") { + $addtime = 1; + $start = $ARGV[1]; + $stop = $ARGV[2]; + shift; shift; shift; next; + } + if ($ARGV[0] eq "-config") { + $addconfig = 1; + $elconf = $ARGV[1]; + shift; shift; next; + } + if ($ARGV[0] eq "-h") { &usage; } + if ($ARGV[0] eq "--help") { &usage; } + @tARGV = (@tARGV, $ARGV[0]); + shift; +} +@ARGV = @tARGV; + +if (@ARGV != 4) { &usage; } +if ($addtime && ("$start" == "")) { &usage; } +if ($addtime && ("$stop" == "")) { &usage; } + +# command line arguments +$input = $ARGV[0]; +$output = $ARGV[1]; +$ref = $ARGV[2]; +$type = uppercase ($ARGV[3]); + +$ccdword = `gconfig -q CCDNUM-KEYWORD`; chop ($ccdword); +$typeword = `gconfig -q IMAGETYPE-KEYWORD`; chop ($typeword); +$dbmode = `gconfig -q DETREND-DB-MODE`; chop ($dbmode); + +# choose appropriate type +if ($type eq "FLAT") { &mk_flat; } +if ($type eq "DARK") { &mk_dark; } +if ($type eq "BIAS") { &mk_dark; } +print STDERR "unknown type $type"; +exit 1; + +sub mk_dark { +# create mana macro, run (allows exit status to be checked) + open (MANA, "|mana --norc"); + print MANA "macro go\n"; + print MANA "echo 'starting normalize'\n"; + print MANA "rd a $input\n"; + print MANA "keyword a $typeword -w $type\n"; + + if ($addtime == 1) { + print MANA "keyword a TVSTART -w $start\n"; + print MANA "keyword a TVSTART -wc \"data validity start time\"\n"; + print MANA "keyword a TVSTOP -w $stop\n"; + print MANA "keyword a TVSTOP -wc \"data validity start time\"\n"; + } + if ($addconfig == 1) { + print MANA "keyword a ELCONF -w $elconf\n"; + print MANA "keyword a ELCONF -wc \"Original Elixir config\"\n"; + } + + $elsys = `gconfig ELIXIR_VERSION`; chop ($elsys); + @time = localtime; + $now = sprintf "%04d-%02d-%02dT%02d:%02d:%02d", $time[5]+1900, $time[4]+1, $time[3], $time[2], $time[1], $time[0]; + $elsys = `gconfig ELIXIR_VERSION`; chop ($elsys); + print MANA "keyword a EL_SYS -w \"$elsys\"\n"; + print MANA "keyword a EL_SYS -wc \"Elixir System Version\"\n"; + print MANA "keyword a EL_NRM -w \"$version\"\n"; + print MANA "keyword a EL_NRM -wc \"Elixir Normalize Version\"\n"; + print MANA "keyword a REL_DATE -w \"$now\"\n"; + print MANA "keyword a REL_DATE -wc \"UTC Release Date\"\n"; + + print MANA "keyword a COMMENT -ws \"Elixir:normalize $version\"\n"; + print MANA "keyword a COMMENT -ws \"no renormalization needed for $type\"\n"; + print MANA "wd a $output -bitpix 16 -bzero 32668.0 -bscale 1.0\n"; + print MANA "echo normlized done ($input to $output)\n"; + print MANA "exit 0\n"; + print MANA "end\n"; # end of macro 'go' + + print MANA "go\n"; + print MANA "exit 1\n"; + close (MANA); + if ($?) { + print STDERR "ERROR problem running mana in normalize (bias, dark)\n"; + exit 1; + } + print STDOUT "SUCCESS: finished with normalize\n"; + exit 0; +} + +sub mk_flat { + # check on reference existence (not needed for BIAS, DARK) + if (! -f $ref) { + print STDERR "ERROR: ref file $args[3] is missing\n"; + exit 1; + } + + # we need keywords defined by the process (flips) which creates the master frame + if ($oldflips) { + # these lines were used before flips was upgraded to add the DATAMODE keywords + $answer = `fhead $ref | grep "Output file mode"`; + @words = split (" ", $answer); + $refmode = $words[-1]; + + $answer = `fhead $input | grep "Output file mode"`; + @words = split (" ", $answer); + $mode = $words[-1]; + } else { + # various options for datamode, refmode: + + # check for readout mode + ($junk, $amplist) = split (" ", `echo $input | fields AMPLIST`, 2); + if ($? == 0) { + # multiamp mode, expect IMMODE$amp, create FLATSCL$amp + @amps = split (" ", $amplist); + foreach $amp (@amps) { + ($junk, $mode) = split (" ", `echo $input | fields IMMODE$amp`); + if ($?) { die "ERROR: missing IMMODE$amp\n"; } + @ampmode = (@ampmode, $mode); + } + } + # try new IMMODE keyword: + $modeword = "IMMODE"; + ($junk, $mode) = split (" ", `echo $input | fields $modeword`); + if ($?) { + if (@amps) { die "ERROR: multiamp mode missing IMMODE\n"; } + $modeword = "DATAMODE"; + ($junk, $mode) = split (" ", `echo $input | fields $modeword`); + if ($?) { die "ERROR: missing DATAMODE & IMMODE\n"; } + } + ($junk, $refmode) = split (" ", `echo $ref | fields $modeword`); + if ($?) { die "ERROR: ref file missing $modeword\n"; } + } + ($junk, $refccd) = split (" ", `echo $ref | fields $ccdword`); + if ($?) { die "ERROR: ref file missing $ccdword in ref\n"; } + + # grab mask file + $mask = `detsearch -quiet -image $input 0 split -type mask`; chop ($mask); + if ($? || ($mask eq "")) { + print STDERR "can't find mask for this image, no mask applied\n"; + $mask = "none"; + } + + # run MANA + open (MANA, "|mana --norc"); + print MANA "macro go\n"; + print MANA "echo 'starting normalize'\n"; + print MANA "rd a $input\n"; + print MANA "\$CCDKEYWORD = $ccdword\n"; + print MANA "keyword a $ccdword ccd\n"; + if ($mask eq "none") { + print MANA "set b = a / $refmode\n"; + } else { + if ($dbmode eq "MEF") { + print MANA "rd c $mask -n \$ccd\n"; + } else { + print MANA "rd c $mask\n"; + } + print MANA "set b = (a / $refmode) * c\n"; + } + + $scale = $refmode / $mode; + $newmode = $mode / $refmode; + print MANA "keyword b $modeword -wf $newmode\n"; + print MANA "keyword b FLATSCAL -wf $scale\n"; + + if (@amps) { + for ($i = 0; $i < @amps; $i++) { + $amp = $amps[$i]; + $scale = $refmode / $ampmode[$i]; + $newmode = $ampmode[$i] / $refmode; + print MANA "keyword b IMMODE$amp -wf $newmode\n"; + print MANA "keyword b FLATSCL$amp -wf $scale\n"; + } + } + print MANA "keyword b $typeword -w $type\n"; + if ($addtime == 1) { + print MANA " keyword b TVSTART -w $start\n"; + print MANA " keyword b TVSTART -wc \"data validity start time\"\n"; + print MANA " keyword b TVSTOP -w $stop\n"; + print MANA " keyword b TVSTOP -wc \"data validity start time\"\n"; + } + if ($addconfig == 1) { + print MANA "keyword b ELCONF -w $elconf\n"; + print MANA "keyword b ELCONF -wc \"Original Elixir config\"\n"; + } + + @time = localtime; + $now = sprintf "%04d-%02d-%02dT%02d:%02d:%02d", $time[5]+1900, $time[4]+1, $time[3], $time[2], $time[1], $time[0]; + $elsys = `gconfig ELIXIR_VERSION`; chop ($elsys); + print MANA "keyword b EL_SYS -w \"$elsys\"\n"; + print MANA "keyword b EL_SYS -wc \"Elixir System Version\"\n"; + print MANA "keyword b EL_NRM -w \"$version\"\n"; + print MANA "keyword b EL_NRM -wc \"Elixir Normalize Version\"\n"; + print MANA "keyword b REL_DATE -w \"$now\"\n"; + print MANA "keyword b REL_DATE -wc \"UTC Release Date\"\n"; + + print MANA "keyword b COMMENT -ws \"Elixir:normalize version $version\"\n"; + print MANA "keyword b COMMENT -ws \"FLAT image normalized wrt CCD $refccd\"\n"; + print MANA "clip b 0.0 0.0 6.4 0.0\n"; + print MANA "wd b $output -bitpix 16 -bzero 3.2 -bscale 0.0001\n"; + print MANA "echo normlized done ($input to $output)\n"; + print MANA "exit 0\n"; + print MANA "end\n"; # end of macro 'go' + + print MANA "go\n"; + print MANA "exit 1\n"; + close (MANA); + if ($?) { + print STDERR "ERROR problem running mana in normalize (flat)\n"; + exit 1; + } + print STDOUT "SUCCESS: finished with normalize\n"; + exit 0; +} + +sub vsystem { + print STDERR "@_\n"; + $status = system ("@_"); + $status; +} + +sub goodbye { + die "@_\n"; +} + +sub uppercase { + return "\U$_[0]\E"; +} + +# given a filename, check that its path exists, create it if not +sub ckpathname { + my ($file) = $_[0]; + my (@words, $dir); + + @words = split ("/", $file); + pop (@words); + $dir = join ("/", @words); + + if ($dir eq "") { $dir = "."; } + + if (! -d $dir) { + system ("mkdir -p $dir"); + if ($?) { + print STDERR "ERROR: can't make directory component for $file\n"; + exit 1; + } + } +} + +sub usage { + print STDERR "normalize (input) (output) (ref) (type) [-time start stop] [-oldflips]\n"; + exit 2; +} + Index: /tags/ohana/perl-1-3/Ohana/src/perl/src/rerun.complete =================================================================== --- /tags/ohana/perl-1-3/Ohana/src/perl/src/rerun.complete (revision 21906) +++ /tags/ohana/perl-1-3/Ohana/src/perl/src/rerun.complete (revision 21906) @@ -0,0 +1,31 @@ +#!/usr/bin/env perl + +$fifo = `gconfig FIFOS`; chop $fifo; +$failure = "$fifo/complete.failure"; + +$Nflatten = `grep flatten $failure | wc -l`; chop $Nflatten; +$Ngophot = `grep gophot $failure | wc -l`; chop $Ngophot; +$Nimclean = `grep imclean $failure | wc -l`; chop $Nimclean; +$Ngastro = `grep gastro $failure | wc -l`; chop $Ngastro; +$Naddstar = `grep addstar $failure | wc -l`; chop $Naddstar; + +print "flatten: $Nflatten\n"; +print "gophot: $Ngophot\n"; +print "imclean: $Nimclean\n"; +print "gastro: $Ngastro\n"; +print "addstar: $Naddstar\n"; + +# get the list of things to re-run: +$runid = `gconfig RUNID.POSTRUN`; chop $runid; +$camera = `gconfig CAMERA.POSTRUN`; chop $camera; +$catdir = `gconfig DB_STDS -D RUNID $runid -D CAMERA $camera`; chop $catdir; +$datdir = `gconfig DATDIR`; chop $datdir; +$ptlist = "$datdir/$runid/$runid.rerun.dat"; +$ptlist = "$datdir/$runid/$runid.rerun.log"; + +#system ("grep addstar $failure | awk '{print \$1, \$2, \$3, \$4}' > $ptlist"); +#system ("elixir -D global.pending addstar -D RUNID $runid -D CAMERA $camera -D mode sexcomplete $ptlist >& $ptlog &"); + +system ("cat $failure | awk '{print \$1, \$2, \$3, \$4}' > $ptlist"); +system ("elixir -D RUNID $runid -D CAMERA $camera -D mode sexcomplete $ptlist >& $ptlog &"); + Index: /tags/ohana/perl-1-3/Ohana/src/perl/src/seeingstats =================================================================== --- /tags/ohana/perl-1-3/Ohana/src/perl/src/seeingstats (revision 21906) +++ /tags/ohana/perl-1-3/Ohana/src/perl/src/seeingstats (revision 21906) @@ -0,0 +1,113 @@ +#!/usr/bin/env perl + +sub vsystem { + print STDERR "@_\n"; + $status = system ("@_"); + $status; +} + +sub goodbye { + die "@_\n"; +} + +sub min { + if ($_[0] < $_[1]) { + return ($_[0]); + } else { + return ($_[1]); + } +} + +sub max { + if ($_[0] > $_[1]) { + return ($_[0]); + } else { + return ($_[1]); + } +} + +if (@ARGV != 1) { die "ERROR: USAGE: seeingstats (file)\n" } + +open (FILE, $ARGV[0]); +@list = ; +close (FILE); + +# the file contains results from sextractor. the lines +# contain: FWHM FLAGS CLASS MAG +# reject bad objects, find mag min & number +@mag = (); +for ($i = 0; $i < @list; $i++) { + @words = split (" ", $list[$i]); + if ($words[1] > 0) { next; } + if ($words[3] > 0) { next; } + @mag = (@mag, $words[3]); +} + +# find Mag threshold +@Mag = sort {$a <=> $b} @mag; +$Nmag = @Mag; +$Nwant = int(min(max(0.25*$Nmag, 10), $Nmag-1)); +$Mlim = $Mag[$Nwant]; + +# fast way to zero a list of 1024 elements +@Nfwhm = (0.0); +for ($i = 0; $i < 10; $i++) { + @Nfwhm = (@Nfwhm, @Nfwhm); +} +$N = @Nfwhm; + +# reject bad objects, find mag min & number +@fwhm = (); +for ($i = 0; $i < @list; $i++) { + @words = split (" ", $list[$i]); + if ($words[1] > 0) { next; } + if ($words[3] > $Mlim) { next; } + @fwhm = (@fwhm, $words[0]); + + # accumulate entry in histogram (@Nfwhm) + $bin = int ($words[0]*10.0); + if ($bin < 0) { next; } + if ($bin > 999) { next; } + $Nfwhm[$bin] ++; +} + +# find the mode (bin size = 0.1 pixels) +$mode = 0; +$Nmode = $Nfwhm[$mode]; +for ($i = 1; $i < @Nfwhm; $i++) { + if ($Nfwhm[$i] > $Nmode) { + $mode = $i; + $Nmode = $Nfwhm[$mode]; + } +} +$Vmode = $mode * 0.1; +$Fmin = $Vmode - 0.2; +$Fmax = $Vmode + 0.2; + +# find the mean of values within 0.2 pix of the mode +$F = 0; +$N = 0; +for ($i = 0; $i < @fwhm; $i++) { + if ($fwhm[$i] < $Fmin) { next; } + if ($fwhm[$i] > $Fmax) { next; } + $N++; + $F += $fwhm[$i]; +} +if ($N > 3) { + $fwhm = $F / $N; + printf "%7.3f\n", $fwhm; + exit 0; +} + +# I don't think the above can ever fail to get an answer, but... +# if the mode search didn't work, resort to median +$F = 0; +$N = 0; +@Fwhm = sort {$a <=> $b} @fwhm; +$Nc = int(0.5*@Fwhm); +for ($i = $Nc-1; $i < $Nc+2; $i++) { + $N++; + $F += $Fwhm[$i]; +} +$fwhm = $F / $N; +printf "%7.3f\n", $fwhm; Index: /tags/ohana/perl-1-3/Ohana/src/perl/src/split.mef =================================================================== --- /tags/ohana/perl-1-3/Ohana/src/perl/src/split.mef (revision 21906) +++ /tags/ohana/perl-1-3/Ohana/src/perl/src/split.mef (revision 21906) @@ -0,0 +1,99 @@ +#!/usr/bin/env perl + +# we could test for each resulting file and re-construct the +# output lists using only the successful ones. This would work +# best after we re-organize the flips elixirs to run imselect 1x +# and the split parallel by image, not config + +if (@ARGV != 4) { die "USAGE: split.mef (list.mef) (outdir) (ccd) (list.msplit)\n"; } + +$inlist = $ARGV[0]; +$outdir = $ARGV[1]; +$ccd = $ARGV[2]; +$outlist= $ARGV[3]; + +$ccdkeyword = `gconfig CCDNUM-KEYWORD`; chop ($ccdkeyword); + +$line = `cameraconfig -axes`; chop ($line); +($Naxis1, $Naxis2) = split (" ", $line); + +if (! -d $outdir) { vsystem ("mkdir -p $outdir"); } + +open (FILE, "$inlist"); +@mef = ; +close (FILE); + +@split = (); +foreach $name (@mef) { + chop ($name); + + # convert name /path/name.fits to /outdir/rootccd.fits + @words = split ("/", $name); + $root = $words[-1]; + $root =~ s/.fits//; + + # change to use ccd number, not id? + $new = sprintf "%s/%s%s.fits", $outdir, $root, $ccd; + push @split, $new; +} + +# convert mef file to split files in outdir +# write all valid entries to outlist + +# start with empty file for msplit +unlink ($outlist); + +open (MANA, "|mana --norc"); + +# define the macro 'split' +print MANA "macro split\n"; +print MANA " \$CCDKEYWORD = $ccdkeyword\n"; +print MANA " rd a \$1 -n $ccd\n"; +print MANA " keyword a NAXIS1 nx\n"; +print MANA " keyword a NAXIS2 ny\n"; +print MANA " if ((\$nx == $Naxis1) && (\$ny == $Naxis2))\n"; +print MANA " wd a \$2 -bitpix 16 -bzero 32768 -bscale 1.0\n"; +print MANA " exec echo \$2 >> $outlist\n"; +print MANA " end\n"; +print MANA "end\n"; + +# create the macro 'go' with the commands +print MANA "macro go\n"; +for ($i = 0; $i < @mef; $i++) { + if (-e $split[$i]) { + # if NAXIS1 & NAXIS2 are valid, add entry to outlist + $answer = `echo $split[$i] | fields NAXIS1 NAXIS2`; + ($tmp, $nx, $ny) = split (" ", $answer); + if ($nx != $Naxis1) { next; } + if ($ny != $Naxis2) { next; } + print MANA "exec echo $split[$i] >> $outlist\n"; + # print STDERR "$split[$i] exists, skipping\n"; + next; + } + print MANA " split $mef[$i] $split[$i]\n"; +} +# if the macro ends successfully, exit 0 +print MANA " exit 0\n"; +print MANA "end\n"; + +# if the macro exits before the end, exit 1 +print MANA "go\n"; +print MANA "exit 1\n"; +close (MANA); + +$status = $?; +print STDERR "mana exit status: $status\n"; +if ($status) { + print STDERR "ERROR: problem running split.mef\n"; + exit 1; +} + +print STDERR "SUCCESS\n"; +exit 0; + +sub vsystem { + print STDERR "@_\n"; + $status = system ("@_"); + $status; +} + Index: /tags/ohana/perl-1-3/Ohana/src/perl/src/update.astrometry.iraf =================================================================== --- /tags/ohana/perl-1-3/Ohana/src/perl/src/update.astrometry.iraf (revision 21906) +++ /tags/ohana/perl-1-3/Ohana/src/perl/src/update.astrometry.iraf (revision 21906) @@ -0,0 +1,116 @@ +#!/usr/bin/env perl + +$version = 1.0; +if (@ARGV != 2) { die "USAGE: update.astrometry.iraf (efile) (cmpfile)\n" ; } + +$efile = $ARGV[0]; +$cmpfile = $ARGV[1]; + +if (! -e $efile) { die "output file $efile not found\n"; } +if (! -e $cmpfile) { die "header source file $cmpfile not found\n"; } + +# grab astrometry keywords from $cmpfile: +@header = &load_header ($cmpfile); + +# set some default values: +@astrom = (); +$Nastro = 0; + +# search for the appropriate lines: +foreach $line (@header) { + + # astrometry keywords which are copied directly + if ($line =~ /NASTRO =/) { $Nastro = substr ($line, 10, 21); } + + if ($line =~ /CTYPE1 =/) { @astrom = (@astrom, $line);} + if ($line =~ /CTYPE2 =/) { @astrom = (@astrom, $line);} + if ($line =~ /CRPIX1 =/) { @astrom = (@astrom, $line);} + if ($line =~ /CRPIX2 =/) { @astrom = (@astrom, $line);} + if ($line =~ /CRVAL1 =/) { @astrom = (@astrom, $line);} + if ($line =~ /CRVAL2 =/) { @astrom = (@astrom, $line);} +# if ($line =~ /NASTRO =/) { @astrom = (@astrom, $line); $Nastro = substr ($line, 10, 21); } +# if ($line =~ /CERROR =/) { @astrom = (@astrom, $line);} + if ($line =~ /EQUINOX =/) { @astrom = (@astrom, $line);} + + # convert the PC00i00j matrix & CDELTi to CDi_j + if ($line =~ /PC001001=/) { $pc11 = substr ($line, 10, 21); } + if ($line =~ /PC001002=/) { $pc12 = substr ($line, 10, 21); } + if ($line =~ /PC002001=/) { $pc21 = substr ($line, 10, 21); } + if ($line =~ /PC002002=/) { $pc22 = substr ($line, 10, 21); } + if ($line =~ /CDELT1 =/) { $cd1 = substr ($line, 10, 21); } + if ($line =~ /CDELT2 =/) { $cd2 = substr ($line, 10, 21); } +} + +# check for validity of astrometry data +if ($Nastro == 0) { + print STDERR "can't find all astrometry keywords from $infile\n"; + @astrom = ($line); +} else { + # convert the pc, cdelt terms to cd terms + $cd11 = $cd1*$pc11; + $cd12 = $cd2*$pc12; + $cd21 = $cd1*$pc21; + $cd22 = $cd2*$pc22; + $line = sprintf "CD1_1 = %20G / WCS Coordinate scale matrix ", $cd11; @astrom = (@astrom, $line); + $line = sprintf "CD1_2 = %20G / WCS Coordinate scale matrix ", $cd12; @astrom = (@astrom, $line); + $line = sprintf "CD2_1 = %20G / WCS Coordinate scale matrix ", $cd21; @astrom = (@astrom, $line); + $line = sprintf "CD2_2 = %20G / WCS Coordinate scale matrix ", $cd22; @astrom = (@astrom, $line); +} + +# write output to file +foreach $line (@astrom) { + $hedit = convert_to_hedit ($line); + # print STDOUT "$line\n"; + print STDOUT "$hedit\n"; +} + +exit 0; + +################################################################################### + +sub vsystem { + print STDERR "@_\n"; + $status = system ("@_"); + $status; +} + +sub goodbye { + die "@_\n"; +} + +# load FITS header lines (up to including END) +sub load_header { + + my ($file) = $_[0]; + my ($buffer, $done, @buffer, $line); + + open (FILE, "$file"); + + $done = 0; + @buffer = (); + + while (! $done) { + read FILE, $buffer, 2880; + for ($i = 0; $i < 2880; $i+=80) { + $line = substr ($buffer, $i, 80); + if (! $done) { + @buffer = (@buffer, $line); + } + if ($line =~ /^END /) { $done = 1; } + } + } + close (FILE); + return (@buffer); +} + +sub convert_to_hedit { + + my ($line) = $_[0]; + my ($hedit, $keyword, $value); + + $keyword = substr ($line, 0, 8); + $value = substr ($line, 10, 21); + + $hedit = sprintf "hedit $efile $keyword $value ver- show-"; + return ($hedit); +} Index: /tags/ohana/perl-1-3/Ohana/src/perl/src/validate =================================================================== --- /tags/ohana/perl-1-3/Ohana/src/perl/src/validate (revision 21906) +++ /tags/ohana/perl-1-3/Ohana/src/perl/src/validate (revision 21906) @@ -0,0 +1,309 @@ +#!/usr/bin/env perl + +# validate +# -update sends the validation value to the QSO database +# 1 - valid image +# 2 - subvalid image (problem, but doesn't matter) +# 3 - invalid image +# 4 - data error (missing, corrupted image) + +# global constants: + +$TRUE = 1; +$FALSE = 0; +$RETRY = $TRUE; + +$PASS = (0 << 8); +$FAIL = (1 << 8); +$SUBVALID = (2 << 8); +$DATA_ERR = (3 << 8); + +$MODE_UNSET = 0; +$MODE_VALID = 1; +$MODE_SUBVALID = 2; +$MODE_INVALID = 3; +$MODE_DATAERR = 4; + +$STATS = $FALSE; +$update = $FALSE; + +$infile = ""; + +# include the CFHT bin directory in the path so we have access to QSO functions: +$ENV{'PATH'} = "$ENV{'PATH'}:/cfht/bin"; + +# grab the command line arguments: +@tARGV = (); +for (; @ARGV > 0; ) { + + if ($ARGV[0] eq "-stats") { + shift; + $STATS = $TRUE; + next; + } + if ($ARGV[0] eq "-update") { + shift; + $update = $TRUE; + next; + } + if ($ARGV[0] eq "-skip") { + shift; + $RETRY = $FALSE; + next; + } + if ($ARGV[0] eq "-infile") { + shift; + $infile = $ARGV[0]; + shift; + next; + } + + @tARGV = (@tARGV, $ARGV[0]); + shift; +} +@ARGV = @tARGV; + +if (@ARGV != 1) { die "USAGE: validate (crunid) [-infile filename] [-update]\n" ;} + +$crunid = $ARGV[0]; + +$answer = `mkrun run $crunid`; +if ($?) { die "ERROR finding run id: $crunid\n"; } +($id, $start, $stop, $camera, $qrunid) = split (" ", $answer); +# qrunid is space-separated (change?) +if ($id ne $crunid) { die "ERROR with run id: $crunid\n"; } +print STDERR "qso run ID(s): $qrunid\n"; + +@valid = (); +@invalid = (); +@dataerr = (); +@subvalid = (); + +if ($infile) { + # load images from previous output run or source file: + open (FILE, $infile); + @rawlist = ; + close (FILE); + + $mode = $MODE_UNSET; + @imlist = (); + + RAWLIST: + foreach $name (@rawlist) { + chop ($name); + + if ($name eq "") { next RAWLIST; } + + if ($name =~ /^valid images/) { + $mode = $MODE_VALID; + next RAWLIST; + } + if ($name =~ /^invalid images/) { + $mode = $MODE_INVALID; + next RAWLIST; + } + if ($name =~ /^subvalid images/) { + $mode = $MODE_SUBVALID; + next RAWLIST; + } + if ($name =~ /^dataerr images/) { + $mode = $MODE_DATAERR; + next RAWLIST; + } + + # plain list of image names (/path/name.fits) + if ($mode == $MODE_UNSET) { + # double check on name validity + ($file, $junk) = split (" ", $name, 2); + unless ($file =~ /\d\d\d\d\d\d\w/) { print STDERR "?"; next RAWLIST; } + @imlist = (@imlist, $file); + next RAWLIST; + } + + # ($file) = split (" ", $name); + $file = $name; + # place image names in the appropriate list + if ($mode == $MODE_VALID) { + @valid = (@valid, $file); + next RAWLIST; + } + if ($mode == $MODE_INVALID) { + @invalid = (@invalid, $file); + next RAWLIST; + } + if ($mode == $MODE_SUBVALID) { + @subvalid = (@subvalid, $file); + next RAWLIST; + } + if ($mode == $MODE_DATAERR) { + @dataerr = (@dataerr, $file); + next RAWLIST; + } + } +} else { + # load images directly from directory + # this is not sufficient. we need a better way to get a list of images for + # a given run id (with the current MEF / SPLIT state correct). + # + # probably we can just use imsearch -ccd 0 + $rawdir = `gconfig -q -D RUNID $crunid RAWDIR`; + chop ($rawdir); + if ($rawdir eq "") { + print STDERR "can't find config entry RAWDIR\n"; + exit 1; + } + @imlist = (); + + # load in the MEF files (must be of format 123456x.fits) + @tlist = <$rawdir/*.fits>; + foreach $tname (@tlist) { + if ((-f $tname) && ($tname =~ /\d\d\d\d\d\d\w.fits/)) { + @imlist = (@imlist, $tname); + } + } + + # load in the SPLIT directories (must be of format 123456x) + @tlist = <$rawdir/???????>; + foreach $tname (@tlist) { + if ((-d $tname) && ($tname =~ /\d\d\d\d\d\d\w/)) { + @imlist = (@imlist, $tname); + } + } +} + +if ($STATS) { + $Nvalid = @valid; + $Ninvalid = @invalid; + $Nsubvalid = @subvalid; + $Ndataerr = @dataerr; + + print STDOUT "valid $Nvalid\n"; + print STDOUT "invalid $Ninvalid\n"; + print STDOUT "subvalid $Nsubvalid\n"; + print STDOUT "dataerr $Ndataerr\n"; + exit 0; +} + +# load the QSO validated image list +@qsovalid = (); +if ($qrunid) { + @qruns = split (",", $qrunid); + @qsovalid = (); + foreach $id (@qruns) { + print STDERR "$id:\n"; + @answer = `select_val_xexp.sh -U qso_elixir -P op1eliw -qrunid $id`; + if ($?) { + print STDERR "error in qso run ID\n"; + exit 1; + } + @qsovalid = (@qsovalid, @answer); + } +} +# create qsostate hash to quickly find valid qso images +foreach $qline (@qsovalid) { + chop ($qline); + ($qname, $qeval, $eval, $seval) = split (" ", $qline); + $qsostate{$qname} = 1; +} + +if ($RETRY) { +# evaluate the remaining entries in imlist & invalid: + @imlist = (@imlist, @invalid, @dataerr); + @invalid = (); + @dataerr = (); + + IMLIST: + foreach $line (@imlist) { + ($name) = split (" ", $line); + @words = split ("/", $name); + $tmp = $words[-1]; + ($obsid) = $tmp =~ /(\d\d\d\d\d\d\w)/; + + $answer = `ckvalid $name`; chop ($answer); + $status = $?; + if ($status) { + print STDERR "-"; + } else { + print STDERR "+"; + } + + ($file, $mode, $type, $runid, $state) = split (" ", $answer, 2); + + if ($status == $PASS) { + @valid = (@valid, $answer); + next IMLIST; + } + if ($status == $SUBVALID) { + @subvalid = (@subvalid, $answer); + next IMLIST; + } + if ($status == $DATA_ERR) { + @dataerr = (@dataerr, $answer); + next IMLIST; + } + + # subvalid if not in qso list + if ($status == $FAIL) { + # are we in QSO list? + if ($qsostate{$obsid}) { + @invalid = (@invalid, $answer); + next IMLIST; + } else { + @subvalid = (@subvalid, $answer); + next IMLIST; + } + } + print STDERR "unknown result $answer\n"; + } +} + +@mode = ('valid', 'subvalid', 'invalid', 'dataerr'); +@code = ($MODE_VALID, $MODE_SUBVALID, $MODE_INVALID, $MODE_DATAERR); + +for ($i = 0; $i < @mode; $i++) { + $mode = $mode[$i]; + $code = $code[$i]; + + print STDOUT "$mode images\n"; + foreach $line (@$mode) { + print STDOUT "$line\n"; + if ($update) { + ($file, $mode, $type, $runid, $state) = split (" ", $line, 5); + $seval = get_seval ($state); + + @w = split ("/", $file); + $n = substr ($w[-1], 0, 6); + # print STDERR "update_xexpe.sh -U qso_elixir -P op1eliw --obsid $n --eval $code --Seval $seval >> test.list\n"; + vsystem ("update_xexpe.sh -U qso_elixir -P op1eliw --obsid $n --eval 0 --Seval $seval >> xexpe.list"); + } + } + print STDOUT "\n"; +} + +sub get_seval { + + my($state) = $_[0]; + my (@evals, $seval); + + @evals = split (" ", $state); + + $seval = ""; + if ($evals[0]) { $seval = $seval . "t"; } else { $seval = $seval . "f"; } # DATA + if ($evals[1]) { $seval = $seval . "t"; } else { $seval = $seval . "f"; } # DETREND + $seval = $seval . "-"; + if ($evals[2]) { $seval = $seval . "t"; } else { $seval = $seval . "f"; } # PHOTOM + if ($evals[3]) { $seval = $seval . "t"; } else { $seval = $seval . "f"; } # ASTROM + + return ($seval); +} + +sub vsystem { + print STDERR "@_\n"; + my($status) = system ("@_"); + $status; +} + +sub goodbye { + die "@_\n"; +} + Index: /tags/ohana/perl-1-3/Ohana/src/perl/src/wfi.keywords =================================================================== --- /tags/ohana/perl-1-3/Ohana/src/perl/src/wfi.keywords (revision 21906) +++ /tags/ohana/perl-1-3/Ohana/src/perl/src/wfi.keywords (revision 21906) @@ -0,0 +1,110 @@ +#!/usr/bin/env perl + +$version = 1.0; +$Nccd = `cameraconfig -Nccd`; chop ($Nccd); + +if (@ARGV != 2) { die "USAGE: grab.keywords (fitsfile) (hdrfile)\n" ; } + +$fitsfile = $ARGV[0]; # input image file +$hdrfile = $ARGV[1]; # hdr file for fits_insert + +@header = `fhead $fitsfile`; + +@newhead = (); +# grab lines from primary header +foreach $line (@header) { + # astrometry keywords which are copied directly + if ($line =~ /HIERARCH ESO INS FILT NAME =/) { + @word = split ("'", $line); + $newline = sprintf "FILTER = '%-18s' / %-46s \n", $word[1], "Filter name"; + @newhead = (@newhead, $newline); + } + if ($line =~ /HIERARCH ESO DPR TYPE =/) { + @word = split ("'", $line); + $value = @word[1]; + if ($value eq "SKY") { $value = "OBJECT"; } + if ($value eq "SKY,FLAT") { $value = "FLAT"; } + if ($value eq "DOME,FLAT") { $value = "FLAT"; } + $newline = sprintf "OBSTYPE = '%-18s' / %-46s \n", $value, "Obs Type"; + @newhead = (@newhead, $newline); + } + if ($line =~ /HIERARCH ESO TEL AIRM START =/) { + ($value) = $line =~ /HIERARCH ESO TEL AIRM START = \s*(\S+)/; + $newline = sprintf "AIRMASS = %20.10f / %-46s \n", $value, "Airmass"; + @newhead = (@newhead, $newline); + } + if ($line =~ /HIERARCH ESO TEL FOCU VALUE =/) { + ($value) = $line =~ /HIERARCH ESO TEL FOCU VALUE = \s*(\S+)/; + $newline = sprintf "FOCUS = %20.10f / %-46s \n", $value, "Focus Value"; + @newhead = (@newhead, $newline); + } + if ($line =~ /HIERARCH ESO INS SIGNAL1 ST =/) { + ($value) = $line =~ /HIERARCH ESO INS SIGNAL1 ST = \s*(\S+)/; + $newline = sprintf "SIGNAL1 = %20.10f / %-46s \n", $value, "Detector temp"; + @newhead = (@newhead, $newline); + } + if ($line =~ /HIERARCH ESO INS SIGNAL2 ST =/) { + ($value) = $line =~ /HIERARCH ESO INS SIGNAL2 ST = \s*(\S+)/; + $newline = sprintf "SIGNAL2 = %20.10f / %-46s \n", $value, "Electronic temp"; + @newhead = (@newhead, $newline); + } + if ($line =~ /HIERARCH ESO INS SIGNAL3 ST =/) { + ($value) = $line =~ /HIERARCH ESO INS SIGNAL3 ST = \s*(\S+)/; + $newline = sprintf "SIGNAL3 = %20.10f / %-46s \n", $value, "Barom press"; + @newhead = (@newhead, $newline); + } + $newline = sprintf "ROTATE = %20.10f / %-46s \n", 0.0, "Barom press"; + @newhead = (@newhead, $newline); + $newline = sprintf "NEXTEND = %20d / %-46s \n", $Nccd, "Nextend"; + @newhead = (@newhead, $newline); +} + +for ($i = 0; $i < $Nccd; $i++) { + @chiphead = (); + @header = `fhead -x $i $fitsfile`; + foreach $line (@header) { + if ($line =~ /HIERARCH ESO DET CHIP\d INDEX=/) { + ($value) = $line =~ /HIERARCH ESO DET CHIP\d INDEX= \s*(\S+)/; +# $newline = sprintf "CHIPID = %20d / %-46s \n", $value, "Detector ID"; +# @chiphead = (@chiphead, $newline); + $newline = sprintf "IMAGEID = %20d / %-46s \n", $value, "Detector ID"; + @chiphead = (@chiphead, $newline); + last; + } + } + + # write output to file + open (FILE, ">$hdrfile"); + foreach $line (@newhead) { + print FILE "$line"; + } + foreach $line (@chiphead) { + print FILE "$line"; + } + close (FILE); + + system ("fits_insert -X $i $fitsfile $hdrfile"); + if ($?) { die "problem with extension $i\n"; } +} + +# write output to file +open (FILE, ">$hdrfile"); +foreach $line (@newhead) { + print FILE "$line"; +} +system ("fits_insert $fitsfile $hdrfile"); +if ($?) { die "problem with phu\n"; } + +exit 0; + +################################################################################### + +sub vsystem { + print STDERR "@_\n"; + $status = system ("@_"); + $status; +} + +sub goodbye { + die "@_\n"; +}