;+ ; NAME: ; astcol ; PURPOSE: ; Collect astrometry observations for multiple objects ; DESCRIPTION: ; ; CATEGORY: ; Astrometry ; CALLING SEQUENCE: ; astcol,OBSCODE=obscode,SAVEDIR=savedir ; ; INPUTS: ; ; OPTIONAL INPUT PARAMETERS: ; ; KEYWORD INPUT PARAMETERS: ; NONEWCODE - Flag, if set suppresses the generation of new object id codes. ; OBSCODE - Observatory code for observations, default=688 (Lowell Obs.) ; SAVEDIR - Directory where final astrometry is to be placed. The default ; value is /gryll/data1/buie/astrometry ; ; OUTPUTS: ; ; KEYWORD OUTPUT PARAMETERS: ; ; COMMON BLOCKS: ; ; SIDE EFFECTS: ; ; RESTRICTIONS: ; ; PROCEDURE: ; ; MODIFICATION HISTORY: ; 97/03/18 - Written by Marc W. Buie, Lowell Observatory ; 97/07/09 - Added the savedir keyword ; 97/07/25, MWB, slight change to the Bowell file format output. ; 98/06/22, MWB, added call to ASTLIST at end, also newcodes are taken from ; first available number, not last code in file. ; 98/11/04, MWB, now filters out magnitudes fainter than 80.0 ; 2000/03/09, MWB, moved creation of .ted file to ast2ted.pro ; 2000/09/20, MWB, changed to support vectors with repwrite. ;- pro astcol,OBSCODE=obscode,SAVEDIR=savedir,NONEWCODE=nonewcode if badpar(obscode,[0,1,2,3],0,CALLER='ASTCOL: (OBSCODE) ',default=688) then return if badpar(savedir,[0,7],0,CALLER='ASTCOL: (SAVEDIR) ', $ default='/gryll/data1/buie/astrometry/') then return if badpar(nonewcode,[0,1,2,3],0,CALLER='ASTCOL: (NONEWCODE) ',default=0) then return savedir=addslash(savedir) ; Look for a cross-reference file. final = exists('lplast.xrft') if final then begin ; Read in the cross-reference file. rdlplast,tmpid,realid,nxrf,/trim if not nonewcode then begin ans='' read,'Do you want to setup final ID codes? (def=no) ',ans if strmid(ans,0,1) ne 'y' then nonewcode = 1 endif if not nonewcode then begin ; Locate the id code file and load it ncodes = 0L codetag = '?' if exists(savedir+'newobj.dat') then begin openr,lun,savedir+'newobj.dat',/get_lun line='' while not eof(lun) do begin readf,lun,line,format='(a1)' ncodes = ncodes+1L endwhile point_lun,lun,0L tagid=strarr(ncodes) lines=strarr(ncodes) for i=0L,ncodes-1 do begin readf,lun,line,format='(a)' lines[i]=line words=strsplit(line,/extract) tagid[i]=words[0] endfor free_lun,lun i=0 repeat begin if tagid[i] ne '' then begin j=0 repeat begin ok=valid_num(strmid(tagid[i],j,99),code,/integer) if ok and j ne 0 then $ codetag = strmid(tagid[i],0,j) j=j+1 endrep UNTIL j eq strlen(tagid[i]) or ok endif i=i+1 endrep UNTIL codetag ne '?' or i eq ncodes if codetag eq '?' then begin print,'Sorry, this file does not have a clearly defined tag code.' print,'Unable to continue.' endif tagnum=lonarr(ncodes) for i=0L,ncodes-1 do begin tagnum[i]=long(strmid(tagid[i],strlen(codetag),99)) endfor print,'codetag is ',codetag idx=sort(tagnum) tagid = tagid[idx] lines = lines[idx] tagnum = tagnum[idx] endif endif endif ; Get current directory, this will identify the date of observation. cd,'.',current=cdir pos=strpos(cdir,'/',/reverse_search) date = strmid(cdir,pos+1,99) filelist = findfile('*.ast',count=nfiles) if nfiles eq 0 then begin print,'No astrometry files to collect. Aborting.' return endif line='' blanks=' ' tab = string( byte(9) ) outast = savedir+date+'.ast' outted = savedir+date+'.ted' outkted = savedir+date+'.kted' outinfo = savedir+date+'.info' outkinfo = savedir+date+'.kinfo' openw,last,outast,/get_lun,width=200 ; When new codes are being defined, the new stuff is accumulated to ; a set of string arrays and then written out at the end. nxrft = 0 ; number of lines to add to lplast.xrft nncod = 0 ; number of lines to add to newobj.dat nobs=0 istr='' for i=0L,nfiles-1 do begin obj=strsplit(filelist[i],'.',/extract) obj=obj[0] newobj=0 if strmid(obj,0,1) eq 'a' then obj=strmid(obj,1,99) obj=strupcase(obj) ; Process the data for this object openr,lun,filelist[i],/get_lun if final then begin origobj = obj z=where(origobj eq tmpid,count) if count ne 0 then begin obj = realid[z[0]] istr= '' endif else if not nonewcode then begin ; Get the next valid code number diff = tagnum[1:ncodes-1]-tagnum[0:ncodes-2] zdiff = where(diff ne 1,count) if count eq 0 then begin newcode = tagnum[ncodes-1]+1 istr = ' new end code '+strn(newcode) endif else begin newcode = tagnum[zdiff[0]]+1 istr = ' new code '+strn(newcode)+' between '+ $ strn(tagnum[zdiff[0]])+' and '+strn(tagnum[zdiff[0]+1]) endelse obj = strcompress(codetag+string(newcode),/remove_all) tag = strmid(origobj+blanks,0,8) line = '* '+obj if nxrft eq 0 then begin xtag = tag xinfo = tag+line endif else begin xtag = [xtag,tag] xinfo = [xinfo,tag+line] endelse nxrft = nxrft + 1 tagnum = [tagnum,newcode] idx = sort(tagnum) tagnum = tagnum[idx] ncodes = ncodes+1 newobj=1 endif print,origobj,obj,istr,format='(a,1x,a,1x,a)' endif ; Read through file and add to the ast output file j=0 while not eof(lun) do begin readf,lun,line,format='(a)' words=strsplit(line,/extract) if j eq 0 then firstfile = words[0] printf,last,line,' ',strtrim(string(obscode),2),' ',obj nobs=nobs+1 j=j+1 endwhile free_lun,lun if final and newobj then begin if nncod eq 0 then begin tobj = obj tinfo = obj+tab+firstfile endif else begin tobj = [tobj,obj] tinfo = [tinfo,obj+tab+firstfile] endelse nncod = nncod + 1 endif endfor free_lun,last if nxrft ne 0 then begin print,'Update lplast.xrft file with ',strn(nxrft),' new entries.' repwrite,'lplast.xrft',xtag,xinfo endif if nncod ne 0 then begin print,'Update newobj.dat file with ',strn(nncod),' new entries.' repwrite,savedir+'newobj.dat',tobj,tinfo,/nosort endif print,'Astrometry saved: ',date,', ',strtrim(string(nfiles),2), $ ' objects and ',strtrim(string(nobs),2),' measurements.' print,'Creating Ted format output file.' ast2ted,outast,outted,outkted astlist,outast,outinfo,outkinfo end