pro  obs2stardb3,jd,ra,dec,mag,err,x,chip,xcen,ycen,sky,sharp,chi,$
     ra2m,dec2m,idno2m,j2m,h2m,k2m,dra,ddec,$
     hits,stdnames,targnames,unid,ibot,starid,zdb=zdb
; This routine identifies new observations with existing entries in the
; 'stars' database.  If no entry is a close positional match, a new entry
; is created.  The standards database is consulted first.  If no match
; there, then the target databases are queried.
; Matches for 2mass stars are sought first, and new entries created as
; needed.  When matches are found, the 2mass info is left alone.
; On input,
;  jd = scalar double-precision JD corresp to obs (R*8)
;  ra,dec,mag,err,x,chip,xcen,ycen = IDL vectors containing photometry data
;    (all R*4) except chip, which is I*2.
;  ra2m,dec2m,idno2m,j2m,h2m,k2m are 2mass coords, id number, and magnitudes.
;    All are R*4 except for the id no, which is type long (I*4)
; On output, ra,dec are set to the existing values for matching stars, and
; dra,ddec are set to the differences (input-output) coords.  If no matching
; star is found, ra,dec are left unchanged, and dra,ddec = 0.
;  hits = 0,1,2 according as the star is not matched with an existing one,
;           matches a target star, or matches a reference star.
;  stdnames contains names of the standard field tiles
;  targnames contains names of the target field tiles
;  unid = index of last star in each tile
;  ibot = index of first star in each tile
;  starid = list of starid names for unmatched stars. 
; On return, the stars will be sorted so that all stars lying within
; single tiles on the sky are contiguous.
; 
; This routine assumes the following path to the standard stars database
;     ZDBASE/survey/stars/tstds
;   where ZDBASE is set as an environment variable

; ***          IMPORTANT             ***
; This routine assumes there are no duplicates among the list of
; input stars.  Therefore, it must be called only one image at a time.
; ***************************************
;
;If keyword zdb is set, its value overrides environment var ZDBASE

; make path names
zdbase=getenv('ZDBASE')
if(keyword_set(zdb)) then zdbase=zdb
path=zdbase+'/survey/stars/'
rcap=1.2/60.                    ; 4 arcsec capture radius in arcmin
deg2rad=180./!pi                ; degrees per radian
;astrolib
!priv=2

; count stars, make output vectors
nst=n_elements(ra)
nst2m=n_elements(ra2m)
dra=fltarr(nst)
ddec=fltarr(nst)

; identify tiles that occur in this list of stars
ira=long(ra*15.)             ; assumes tiles are 1 degree square
idec=long(dec)
tileid=1000*ira+idec
ira2m=long(ra2m*15.)
idec2m=long(dec2m)
tileid2m=1000*ira2m+idec2m
; sort obs so common tiles are together
sot=sort(tileid)
tileid=tileid(sot)
ra=ra(sot)
dec=dec(sot)
mag=mag(sot)
err=err(sot)
x=x(sot)
chip=chip(sot)
xcen=xcen(sot)
ycen=ycen(sot)
sky=sky(sot)
sharp=sharp(sot)
chi=chi(sot)
sot2m=sort(tileid2m)
tileid2m=tileid2m(sot2m)
ra2m=ra2m(sot2m)
dec2m=dec2m(sot2m)
idno2m=idno2m(sot2m)
j2m=j2m(sot2m)
h2m=h2m(sot2m)
k2m=k2m(sot2m)

; merge 4s and 2m tiles, make unique list
tileidall=[tileid,tileid2m]
soall=sort(tileidall)
tileidall=tileidall(soall)
uniall=uniq(tileidall)
tileidall=tileidall(uniall)

; identify unique tiles, make names for them
ntile=n_elements(tileidall)       ; number of distinct tiles
ibot=[-1]                   ; index of first star for each tile
ibot2m=[-1]
unid=[-1]
unid2m=[-1]
for j=0,ntile-1 do begin
  s4s=where(tileid eq tileidall(j),ns4s)
  if(ns4s gt 0) then begin
    ibot=[ibot,min(s4s)]
    unid=[unid,max(s4s)]
  endif else begin 
    ibot=[ibot,-1]
    unid=[unid,-1]
  endelse
  s2m=where(tileid2m eq tileidall(j),ns2m)
  if(ns2m gt 0) then begin
    ibot2m=[ibot2m,min(s2m)]
    unid2m=[unid2m,max(s2m)]
  endif else begin
    ibot2m=[ibot2m,-1]
    unid2m=[unid2m,-1]
  endelse
endfor
ibot=ibot(1:*)
ibot2m=ibot2m(1:*)
unid=unid(1:*)
unid2m=unid2m(1:*)

tilecr=tileidall/1000
tilecd=tileidall-1000*tilecr
tilenames,1,ntile,tilecr,tilecd,stdnames
tilenames,0,ntile,tilecr,tilecd,targnames

; index through the tiles.  Keep track of hits among std stars, targets
hits=intarr(nst)
hits2m=intarr(nst2m)

for i=0,ntile-1 do begin
  
; open std star database
  dbname=path+stdnames(i)
  dbopen,dbname,1

; locate any standard stars that match 2mass stars, update their 2mass data
  if(ibot2m(i) ge 0) then begin
  for j=ibot2m(i),unid2m(i) do begin
    ll=dbcircle(ra2m(j),dec2m(j),rcap,dis,/silent)
    if(ll(0) gt 0) then begin
      dmin=min(dis,llm)        ; if multiple hits, choose the nearest
; try not doing this update.  See similar comment about 60 lines down
;     dbupdate,ll(llm),'j,h,k,id2mass',j2m(j),h2m(j),k2m(j),idno2m(j), /silent
      if(abs(ra2m(j)-18.876846d0) le 3.e-4 and abs(dec2m(j)-40.804397d0) le 3.e-3) then stop
    endif
  endfor
  endif

; make dra, ddec, hits data for 4s stars matching std stars in this tile
  if(ibot(i) ge 0) then begin
  for j=ibot(i),unid(i) do begin    ; index over stars in this tile
    ll=dbcircle(ra(j),dec(j),rcap,dis,/silent)
    if(ll(0) gt 0) then begin          ; found a match
; choose nearest star with 2MASS magnitudes, if none, nearest star
      dbext,ll,'RA,Dec,J',tra,tdec,j2mc
      s2m=where(j2mc le 40.,ns2m)
      if(ns2m gt 0) then begin
        dis=dis(s2m)
        tra=tra(s2m)
        tdec=tdec(s2m)
        md=min(dis,ix) 
      endif else begin
        md=min(dis,ix)
      endelse
;     trap=0
;     if(abs(ra(j)-18.876846d0) le 3.e-4 and abs(dec(j)-40.804397d0) le 3.e-3) then begin
;       trap=1
;       stop
;     endif
      tra=tra(ix)
      tdec=tdec(ix)
      cdec=cos(dec(j)/deg2rad)
      dra(j)=(ra(j)-tra(0))*3600.*15.*cdec
      ddec(j)=(dec(j)-tdec(0))*3600.
      ra(j)=tra(0)
      dec(j)=tdec(0)
      hits(j)=2
;     if(trap) then stop
    endif                           ; no match among std stars
  endfor
  endif
  dbclose,dbname

; now search targets database
; check to see if database file exists.  If not, create it.
  ierr=findfile(path+targnames(i)+'.dbh')
  berr=byte(ierr)
  dbname=path+targnames(i)
  if(berr(0) eq 0) then begin
    comm='cp '+zdbase+'/stars3.dbd '+dbname+'.dbd'
    spawn,comm
    dbcreate,dbname,1,1, /silent
  endif

  dbopen,dbname,1
; search for 2mass stars in this tile already in database.  Enter 2mass
; data for these, create new entries for stars not found, sort results.
  if(ibot2m(i) ge 0) then begin
  for j=ibot2m(i),unid2m(i) do begin
    ll=dbcircle(ra2m(j),dec2m(j),rcap,dis,/silent)
    if(ll(0) gt 0) then begin
      dmin=min(dis,llm)
;  try not doing the update at all.  Bad case is if 4s star gets here before
;  its corresponding 2mass star, which shouldn't happen.
;     dbupdate,ll(llm),'j,h,k,id2mass',j2m(j),h2m(j),k2m(j),idno2m(j), /silent
      hits2m(j)=1
;if(abs(ra2m(j)-18.876846d0) le 3.e-4 and abs(dec2m(j)-40.804397d0) le 3.e-3) then stop
    endif
  endfor
; find stars that do not yet appear in database, within this tile
  s2m0=where(hits2m eq 0,ns2m0)
  s2m=where(s2m0 ge ibot2m(i) and s2m0 le unid2m(i),ns2m)
  if(ns2m gt 0) then begin
    sn2m=s2m0(s2m)
    tra=ra2m(sn2m)
    tdec=dec2m(sn2m)
;  shit=where(abs(tra-18.876846d0) le 3.e-4 and abs(tdec-40.804397d0) le 3.e-3,nshit)
;  if(nshit gt 0) then stop
    tj=j2m(sn2m)
    th=h2m(sn2m)
    tk=k2m(sn2m)
    tid=idno2m(sn2m)
    fd=fltarr(ns2m)+99.9
    fz=fltarr(ns2m)
    id=intarr(ns2m)+99
    jda=dblarr(ns2m)+jd
    src=intarr(ns2m)
    badf=intarr(7,ns2m)
    mk_starid,tra,tdec,starid
    starid=string(starid)
; add these to database
    dbopen,dbname,1
    dbbuild,starid,tra,tdec,fz,fz,fd,fd,fd,fd,fd,fd,fd,fd,fd,fd,fd,fd,fd,fd,$
       tj,th,tk,tid,id,id,jda,src,badf,/silent
; and sort them
    dbopen,dbname
    so=dbsort(-1,'ra,dec')
    dbext,so,'starid,ra,dec,u,sig_u,g,sig_g,r,sig_r,i,sig_i',v1,v2,v3,v4,v5,$
             v6,v7,v8,v9,v10,v11
    dbext,so,'z,sig_z,D51,sig_D51,Gred,sig_Gred,J,H,K,id2mass',w1,w2,w3,$
             w4,w5,w6,w7,w8,w9,w10
    dbext,so,'var,crwd,jd,source,dra,ddec,badflag',x1,x2,x3,x4,x5,x6,x7
    dbopen,dbname,1
    dbupdate,-1,'starid,ra,dec,u,sig_u,g,sig_g,r,sig_r,i,sig_i',v1,v2,v3,v4,$
             v5,v6,v7,v8,v9,v10,v11, /silent
    dbupdate,-1,'z,sig_z,D51,sig_D51,Gred,sig_Gred,J,H,K,id2mass',$
             w1,w2,w3,w4,w5,w6,w7,w8,w9,w10, /silent
    dbupdate,-1,'var,crwd,jd,source,dra,ddec,badflag',$
             x1,x2,x3,x4,x5,x6,x7, /silent
    dbindex
    
    dbclose
  endif
  endif

  rastart0=ra
  decstart0=dec
; make dra,ddec,hits values for 4s stars that match those already in dbase
  if(ibot(i) ge 0) then begin
  dbopen,dbname
  for j=ibot(i),unid(i) do begin
    if(hits(j) eq 0) then begin     ; don't bother with stars that matched stds
      ll=dbcircle(ra(j),dec(j),rcap,dis,/silent)
      if(ll(0) gt 0) then begin
; choose nearest star with 2MASS magnitudes, if none, nearest star
        dbext,ll,'RA,Dec,J',tra,tdec,j2mc
        s2m=where(j2mc le 40.,ns2m)
        if(ns2m gt 0) then begin
          dis=dis(s2m)
          tra=tra(s2m)
          tdec=tdec(s2m)
          md=min(dis,ix) 
        endif else begin
          md=min(dis,ix)
        endelse
;     trap=0
;     if(abs(ra(j)-18.876846d0) le 3.e-4 and abs(dec(j)-40.804397d0) le 3.e-3) then begin
;       trap=1
;       stop
;     endif
        tra=tra(ix)
        tdec=tdec(ix)
        cdec=cos(dec(j)/deg2rad)
        dra(j)=(ra(j)-tra(0))*3600.*15.*cdec
        ddec(j)=(dec(j)-tdec(0))*3600.
        ra(j)=tra(0)
        dec(j)=tdec(0)
        hits(j)=1
;      if(trap) then stop
      endif
    endif
  endfor
  dbclose,dbname
  endif

  rastart1=ra
  decstart1=dec

; now create targets database entries for any unmatched stars
  if(ibot(i) ge 0) then begin
  smiss=where(hits(ibot(i):unid(i)) eq 0,nmiss)
  if(nmiss gt 0) then begin
    sm=smiss+ibot(i)
    tra=ra(sm)
    tdec=dec(sm)
;  shit=where(abs(tra-18.876846d0) le 3.e-4 and abs(tdec-40.804397d0) le 3.e-3,nshit)
;  if(nshit gt 0) then stop
    fd=fltarr(nmiss)+99.9
    fz=fltarr(nmiss)
    id=intarr(nmiss)+99
    lid=lonarr(nmiss)-1
    jda=dblarr(nmiss)+jd
    src=intarr(nmiss)
    badf=intarr(7,nmiss)
    mk_starid,tra,tdec,starid
    starid=string(starid)
    dbopen,dbname,1
    dbbuild,starid,tra,tdec,fz,fz,fd,fd,fd,fd,fd,fd,fd,fd,fd,fd,fd,fd,fd,fd,$
       fd,fd,fd,lid,id,id,jda,src,badf,/silent
    dbclose,dbname

; sort on ra,dec, put all the data back in sorted order
    dbopen,dbname
    so=dbsort(-1,'ra,dec')
    dbext,so,'starid,ra,dec,u,sig_u,g,sig_g,r,sig_r,i,sig_i',v1,v2,v3,v4,v5,$
             v6,v7,v8,v9,v10,v11
    dbext,so,'z,sig_z,D51,sig_D51,Gred,sig_Gred,J,H,K,id2mass',w1,w2,w3,$
             w4,w5,w6,w7,w8,w9,w10
    dbext,so,'var,crwd,jd,source,dra,ddec,badflag',x1,x2,x3,x4,x5,x6,x7
    dbopen,dbname,1
    dbupdate,-1,'starid,ra,dec,u,sig_u,g,sig_g,r,sig_r,i,sig_i',v1,v2,v3,v4,$
             v5,v6,v7,v8,v9,v10,v11, /silent
    dbupdate,-1,'z,sig_z,D51,sig_D51,Gred,sig_Gred,J,H,K,id2mass',$
             w1,w2,w3,w4,w5,w6,w7,w8,w9,w10, /silent
    dbupdate,-1,'var,crwd,jd,source,dra,ddec,badflag',$
             x1,x2,x3,x4,x5,x6,x7, /silent
    dbindex

    dbclose

;   stop

  endif
  endif

endfor

; make starid values one last time, to get correct values for full list
mk_starid,ra,dec,starid
starid=string(starid)

;if(nss gt 0) then stop
end