! @(#)set_of_frames.prg 17.1.1.1 (ESO-DMD) 01/25/02 17:46:45 ! ++++++++++++++++++++++++++++++++++++++++++++++++++++++ ! ! MIDAS procedure set_of_frames.prg for NTT/VLT pipeline ! K. Banse 970121, 971212, 981125, 990531, 000427, 010903 ! ! a) move a list of frames into local storage as input/reference data ! b) move single result frame or catalog of result frames out to Products-dir. ! and provide a link to it in $DHS_DATA so Archive knows about it ! ! use via: @d set_of_frames p1 p2 p3 p4 ! ! p1 = IN or OUT for Input or Output ! if p1 = IN ! convert (or just list) all frames given in an ASCII Set of Frames (SoF) ! if catalog name is given all files are named `simpe_name_#' and ! entered in that catalog ! on return OUTPUTI(1) = no. of input/reference frames processed ! = -1 if we couldn't read the SoF ! ! p2 = ASCII file with names of frames ! p3 = optional catalog name or catalog,app (for appending to exist. catal) ! p4 = Convert or List all frames in SoF, default = CONV ! ! if p1 = OUT ! p2 = result frame name (as in current work_dir) ! or name of catalog with result frame names (xyz.cat) ! p3 = complete output basename ! depending upon p2, either basename + extension `.fits' is used to ! construct a single result frame ! or basename_xy + extension `.fits' (xy in [00,99]) is used to ! construct a series of result frames ! p4 = name of result frame which should be stored in the archive ! p5 = name of ASCII file which will be filled with original + output names ! of products ! ! on return OUTPUTI(1) = no. of result frames processed ! OUTPUTI(1) = -9999, if procedure failed somehow ! OUTPUTI(1) = n (n < 0) indicates a problem working on the nth frame ! if OUTPUTI(1) < 0 then OUTPUTI(2) specifies the error more: ! -1 = aux. descr. list, -2 = overwrite, -3 = move to Product_Dir. ! -4 = delete/descr, -5 = copy/ad ! ++++++++++++++++++++++++++++++++++++++++++++++++++++++ ! define/param p1 IN c "Enter IN or OUT for Input/Output from/to FITS:" ! define/local k/i/1/5 0,0,0,0,0 ? +lower define/local fc/i/1/2 0,0 ? +lower define/local fname/c/1/128 " " all +lower write/keyw base_name/c/1/128 " " all +lower write/keyw outputi/i/1/2 -9999,-9 !in case `set_of_frames' fails... ! ! ************** ! here for Input ! ! ************** if p1(1:1) .eq. "I" then set/format i1 define/param p2 ? c "Enter SetofFrames (ASCII) file:" define/param p3 + c "Enter catalog name:" define/param p4 CONV c "Enter action:" define/local classif/c/1/32 " " all +lower define/local catflag/i/1/2 0,0 ? +lower ! if p3(1:1) .ne. "+" then inputi = m$index(p3,",a") if inputi .lt. 2 inputi = m$index(p3,",A") if inputi .lt. 2 then define/local catname/c/1/80 {p3} ? +lower create/icat {catname} NULL DO_CLASSIFICATION >Null else define/local catname/c/1/80 " " all +lower inputi = inputi - 1 write/keyw catname/c/1/{inputi} {p3} endif catflag(1) = 1 endif ! open/file {p2} READ fc if fc(1) .lt. 0 then write/out Could not open input/reference SetOfFrames {p2} ... outputi(1) = -1 return endif ! ! read from SOF and convert or just list the entries ! @d sofaux,readin {p4} close/file {fc(1)} outputi(1) = catflag(2) !set OUTPUTI(1) to no. of frames ! ! *************** ! here for Output ! ! *************** else define/param p4 + c "Enter name of frame for the archive:" define/param p5 + c "Enter name of ASCII file for file names:" ! define/local linkflag/i/1/1 {pipeline(8)} !check, if DHS_DATA is defined if linkflag .ne. 0 linkflag = 99 !do the 'ln' stuff define/local loco/i/1/3 0,0,-1 define/local work/c/1/100 " " all define/local ftype/c/1/6 ".fits " ? +lower define/local fbase/c/1/60 "{fname} " define/local inn_a/c/1/100 " " all +lower define/local fout/i/1/2 -1,-1 define/local mft/i/1/1 0 set/format i4 ! write/out if p5(1:1) .ne. "+" then define/local reco/c/1/200 " " all open/file {p5} write fout if fout(1) .le. 0 then write/out "Could not create ASCII file:" {p5} endif endif ! k(1) = m$indexb(p2,".cat") !check, if catalog if k(1) .lt. 2 then !No, single frame write/keyw work {p2} write/keyw fname {p3} goto process_result ! else !Yes, so p3 must be a SoF loco(2) = 1 define/local catal/i/1/1 0 !catalog control flag write/keyw base_name {p3} if linkflag .ne. 0 then if pipeline(9) .eq. 1 .and. p4(1:1) .ne. "+" then linkflag = 9 !if we're ON_LINE + have unique result frame endif endif ! cata_loop: !loop through catalog to find store/frame work {p2} 1 fin_a !unique product file if work .eq. p4 then !make product the first out loco(3) = catal !save index in catalog write/keyw fname {base_name}_{pipeline(3)} catal = 0 goto process_result else goto cata_loop endif fin_a: catal = 0 ! catal_read_loop: store/frame work {p2} 1 finito if loco(3) .eq. catal goto catal_read_loop !product already done write/keyw fname {base_name}_{pipeline(3)} goto process_result ! finito: !end of catalog reached outputi(1) = loco goto end_of_it endif ! ! here we handle a single result frame ! process_result: ! prepare file for `write/decr' mft = m$filtyp(work,".bdf") if mft .eq. 2 then !check type of input file write/keyw ftype/c/1/6 ".tfits" !it's a table else if mft .eq. 1 then write/keyw ftype/c/1/6 ".fits " !it's an image ! else k(1) = m$ftset(work) !test for filetype if k(1) .eq. 1 then k(1) = m$indexb(work,".") write/keyw ftype/c/1/6 {work({k(1)}:)} else write/keyw ftype/c/1/6 ".dat " endif write/keyw inn_a/c/1/100 "{fname}{ftype} " -rename {work} {inn_a} if m$exist(inn_a) .eq. 0 then !renaming/moving failed...! outputi(2) = -3 goto error_out else write/out {work} => file: {inn_a} if fout(1) .gt. 0 then write/file {fout} {work} {inn_a} endif goto end_test !look for next file endif endif ! k(1) = m$indexb(fname,"/")+1 !look for output file path write/keyw fbase/c/1/60 "{fname({k(1)}:)} " ! k(1) = m$len(fname) !look for output file type if k .gt. 5 then k(2) = k(1)-4 if fname({k(2)}:{k(1)}) .eq. ".fits" then write/keyw ftype/c/1/6 " " !we already have a file type elseif k .gt. 6 then k(2) = k(1)-5 if fname({k(2)}:{k(1)}) .eq. ".tfits" write/keyw ftype/c/1/6 " " endif endif ! write/keyw inn_a/c/1/100 "{fname}{ftype} " ! ! @d sofaux,descfile kuki.dat !build ASCII file "kuki.dat" if q1(1:2) .ne. "OK" then !for all the `write/descr' commands outputi(2) = -1 goto error_out endif ! write/descr {work} Null !calculcate MD5 signature ! products should not be overwritten... if m$exist(inn_a) .ne. 0 then !product exists already if pipeline(11) .eq. 1 then !we shall overwrite... $ chmod a+w {inn_a} else if fout(1) .gt. 0 write/file {fout} {work} NOT converted... ! write/out {inn_a} already exists - we stop! k(1) = m$indexb(inn_a,"/")+1 !skip path specs write/keyw mid$errmess "cannot overwrite product: {inn_a({k(1)}:)} ..." outputi(2) = -2 goto error_out endif endif if fout(1) .gt. 0 then write/file {fout} {work} {inn_a} endif ! if work .eq. p4 then !display major product @d sofaux,resdisp endif ! -rename simple_fits.fits {inn_a} if m$exist(inn_a) .eq. 0 then !renaming/moving failed...! outputi(2) = -3 goto error_out endif ! write/out {work} => FITS file: {inn_a} if linkflag .ne. 0 then !DFS_DATA_REDUCED_OLAS is set write/out *** and is also linked to the Archive *** $sh $MID_PROC/pipeline/DHSlink.sh {inn_a} {fbase}{ftype} if linkflag .ne. 99 linkflag = 0 !link in only 1 result frame endif ! end_test: if loco(2) .eq. 0 then outputi(1) = 1 goto end_of_it else loco = loco+1 pipeline(3) = pipeline(3)+1 goto catal_read_loop endif ! error_out: outputi(1) = -(loco+1) !indicate frame no. where it failed ! end_of_it: if fout(1) .gt. 0 close/file {fout} endif