pro dbdump,tilelist,outdir,zdb=zdb,filter=filter
; This routine makes an ascii dump of data needed for the final Kepler
; input catalog.   Data are taken from each of the tiles in the ascii file
; tilelist.  They are written to files with corresponding names only
; with extension _dmp.asc in the directory outdir.
; If the filter keyword is set, then stars are not passed to the output unless
; they have both valid 2MASS magnitudes and at least 2 valid optical mags.
; Also if filter is set, stars with fewer than 4 valid visible-light magnitudes
; or with err_logg indicating lack of convergence have all derived stellar
; parameters except for teff set to invalid=99.
; Data written are:
;  RA (decimal degree)
;  Dec (decimal degree)
;  u mag
;  g mag
;  r mag
;  i mag
;  z mag
;  Gred mag
;  D51 mag
;  J mag
;  H mag
;  K mag
;  2MASS ID
;  Kepler mag
;  Effective Temperature (K)
;  log(Z)  ie log[Z/Z_solar]
;  log(g)  (cgs units)
;  Reddening = E(B-V)
;  Extinction = A_V
;  Radius (solar units)
;  Bad flag (0-127, with nonzero bits indicating bad filter in order
;                     u,g,r,i,z,Gred,D51)
                                                                                
; Data are written in the above order; formats are
;  RA, dec = f10.5
;  magnitudes = f6.3
;  log(g),log(Z), Radius = f6.3
;  Teff = f6.0
;  2MASS ID = I10
;  Bad flag = I5
									;
; Values are separated  by the vertical bar '|' character.  There may be
; embedded blanks.
;  Invald values are indicated by value >= 99., except 2MASS ID = -1

; constants
zdbase=getenv('ZDBASE')
if(keyword_set(zdb)) then zdbase=zdb
starpath=zdbase+'/survey/stars/'
proppath=zdbase+'/survey/properties/'
astrolib
                                                                                
openr,iun,tilelist,/get_lun
ss=''
tiles=['']
ntiles=0
while(not eof(iun)) do begin
  readf,iun,ss
  tiles=[tiles,strtrim(ss,2)]
  ntiles=ntiles+1
endwhile
close,iun
free_lun,iun
tiles=tiles(1:*)
								                                                                                      
; the all-important format statement
f1='(2(f10.5,1a),10(f6.3,1a),i10,1a,f6.3,1a,f6.0,1a,4(f6.3,1a),f8.3,1a,i5,1a)'
; step through the tiles
for ii=0,ntiles-1 do begin
  stardb=starpath+tiles(ii)
  print,tiles(ii)
  dbopen,stardb
  dbext,-1,'starid,ra,dec,u,g,r,i,z,gred,d51',sid,ra,dec,u,g,r,i,z,gred,d51
  dbext,-1,'j,h,k,id2mass,badflag',j2m,h2m,k2m,id2m,bf
  dbclose
  bfp=bfpack(bf)
  nst=n_elements(sid)
  propdb=proppath+tiles(ii)
  dbopen,propdb
  ll=dbget('starid',sid)
  np=n_elements(ll)
  if(np ne nst) then begin
    print,'Stars, Properties tables do not match.'
    stop
  endif
  dbext,ll,'teff,logz,logg,ext,kepmag,radius,err_logg',teff,logz,logg,ext,kepmag,$
        radius,elogg
  dbclose
; do some simple conversions to desired output formats
  av=ext
  ext=ext/3.1             ; ext means reddening in this routine
  ra=15.*ra
; invent something for stellar radius, for which no good algorithm yet exists
; radius=1.+1.8*alog10((teff > 2000.)/5880.)
; make sure invalid 2MASS ID values are correct
  s=where(id2m le 0,ns)
  if(ns gt 0) then id2m(s)=-1

; filter out questionable data, if desired.
  if(keyword_set(filter)) then begin
    mop=intarr(nst,5)
    mir=intarr(nst,3)
    sf=where(g lt 40.,nsf)
    if(nsf gt 0) then mop(sf,0)=1
    sf=where(r lt 40.,nsf)
    if(nsf gt 0) then mop(sf,1)=1
    sf=where(i lt 40.,nsf)
    if(nsf gt 0) then mop(sf,2)=1
    sf=where(z lt 40.,nsf)
    if(nsf gt 0) then mop(sf,3)=1
    sf=where(d51 lt 40.,nsf)
    if(nsf gt 0) then mop(sf,4)=1

    sf=where(j2m lt 40.,nsf)
    if(nsf gt 0) then mir(sf,0)=1
    sf=where(h2m lt 40.,nsf)
    if(nsf gt 0) then mir(sf,1)=1
    sf=where(k2m lt 40.,nsf)
    if(nsf gt 0) then mir(sf,2)=1

    mtop=total(mop,2)
    mtir=total(mir,2)

; toss data lying within bad pointings, ie pointings with bad time series
; rms values.  We now think there are no more of these, so comment it out.
;   badpath=zdbase+'/survey/bad_point.sav'
;   restore,badpath
    badpoi=intarr(nst)
;   for ibad=0,npoi-1 do begin
;     sp=where(ra ge ralo(ibad) and ra le rahi(ibad) and $
;       dec ge declo(ibad) and dec le dechi(ibad),nsp)
;    if(nsp gt 0) then badpoi(sp)=1
;   endfor
    
    sg=where(mtop ge 2 and mtir eq 3 and badpoi eq 0,nsg)
    if(nsg gt 0) then begin
      ra=ra(sg)
      dec=dec(sg)
      u=u(sg)
      g=g(sg)
      r=r(sg)
      i=i(sg)
      z=z(sg)
      gred=gred(sg)
      d51=d51(sg)
      j2m=j2m(sg)
      h2m=h2m(sg)
      k2m=k2m(sg)
      id2m=id2m(sg)
      kepmag=kepmag(sg)
      teff=teff(sg)
      logz=logz(sg)
      logg=logg(sg)
      ext=ext(sg)
      av=av(sg)
      radius=radius(sg)
      bfp=bfp(sg)
      mtop=mtop(sg)
      elogg=elogg(sg)
      nst=nsg
    endif
      
; set derived params to 99, except for teff, if too few optical measurements 
; or bad convergence
    sb=where(mtop lt 4 or elogg gt 8.,nsb)
    if(nsb gt 0) then begin
;     teff(sb)=99.
      logz(sb)=99.
      logg(sb)=99.
      ext(sb)=99.
      av(sb)=99.
      radius(sb)=-1.0
    endif
  endif
       
; make sure radius fits format
  radius=radius < 999.9

; open output file
  outnam=outdir+'/'+tiles(ii)+'_dmp.asc'
  openw,iun,outnam,/get_lun

; write it out
  b='|'
  for j=0L,nst-1 do begin
  printf,iun,ra(j),b,dec(j),b,u(j),b,g(j),b,r(j),b,$
    i(j),b,z(j),b,gred(j),b,d51(j),b,j2m(j),b,h2m(j),b,k2m(j),b,$
    id2m(j),b,kepmag(j),b,teff(j),b,logz(j),b,logg(j),b,$
    av(j),b,ext(j),b,radius(j),b,bfp(j),b,format=f1
  endfor
  close,iun
  free_lun,iun
endfor
end