Viewing contents of file '../idllib/contrib/icur/addsp.pro'
;**************************************************************************
pro addsp,file,h0,w,f0,e0,prlog=prlog,debug=debug
common trim,ntr,ntr1,range,kr,irg,r2
;
;
swlw=1255. & swuw=1265.                  ;Si
lwlw=2794. & lwuw=2797.                  ;MgII k
print,' ADDSP : procedure to coadd spectra'
print,' set debug=-1 to turn off cross correlation and add with no bin shift'
print,' set debug=2  to run fully interactively and query about all shifts'
print,' '
shftmode=1
if n_params(0) eq 0 then file=''
if file eq '' then read,' enter name of data file: ',file
!quiet=1
;
if not ffile(file) then begin
   print,' data file not found: returning
   return
   endif
;
get_lun,lu
print,' these are the current data file contents:'
ldat,file
read,' enter record number for storage, -1 to append, -9 to skip: ',savrec
if (savrec lt -1) and (n_params(0) lt 4) then begin
   print,' WARNING: no data being saved or passed to MAIN'
   print," To pass data back, call ADDSP,'',H,W,F,E"
   return
   endif
savrec=fix(savrec)
title=''
read,' enter title for header: ',title
;
free_lun,lu
print,' what records do you wish? (or first, -#) -1 to end'
print,' Note that the first record is the template, and should be properly exposed'
read,recs
if recs eq -1 then return
a=0
while a ge 0 do begin
   read,a
   recs=[recs,a]
   endwhile
nr=n_elements(recs)
if (nr eq 2) and (recs(1) lt 0) then begin
   nr=abs(recs(1))+1
   recs=recs(0)+indgen(nr)
   endif
nr=fix(nr)-1
recs=fix(recs(0:nr-1))    ;cut last value
print,nr,' Records chosen:',recs
if nr le 1 then stop
if not keyword_set(debug) then debug=0
if debug eq -1 then iccr=0 else iccr=1
if debug ne -1 then begin
   read,' if you wish to cross correlate the spectra, enter 1',iccr
   print,' You have 2 choices: automatic cross correlations (0) or'
   print,'                     manual shifting (default) (1)'
   read,' Enter your choice: ',iccr2
   if iccr2 ne 0 then iccr2=1
   print,' '
   eta=(nr-1)*7+3
;   if iccr eq 1 then print,'*** Estimated time to completion is',eta,' minutes ***'
   endif
;
get_lun,lu
openw,lu,'addsp.log'
print,' '
printf,lu,' ADDSP processing log'
print,' processing starting at ',systime(0)
printf,lu,' ADDSP processing starting at ',systime(0)
printf,lu,nr,' Records chosen:',recs
printf,lu,' Title:',title
if iccr eq 1 then z=' ' else z=' not '
printf,lu,' Spectra will',z,'be cross correlated'
print,' '
gdat,file,h0,w0,f0,e0,recs(0)
ncam=h0(3)
image=h0(4)
if (ncam le 4) and (image lt 0) then image=image+65636L
if ncam le 4 then printf,lu,' this camera is number ',ncam,' image',image $
   else printf,' Data is ',strtrim(byte(h(100:159)>32),2)
addspwl,h0,w0,lam1,lam2,dl,krange
printf,lu,' Wavelengths limits are ',lam1,' to',lam2,' ; increment=',dl
printf,lu,' '
w=lam1+dl*findgen((lam2-lam1)/dl)
e0=fix(e0)
finter,w,w0,f0,e0
if (ncam le 4) and (n_elements(w) gt 4000) then kgap,h0,w,wgap,ngap,e0
fref=f0
eref=e0     ;
if (ncam le 4) and (n_elements(w) gt 4000) then begin
   ksplice,h0,w,eref
;   fftsm,fref,1,0.6
   endif
f0=f0*(h0(5)>1)   ;multiply by observing time
time=long(h0(5))>1L
h0(180)=h0(4)
k=wherebad(e0,1)    ;bad data
f0(k)=0.
e0=long(e0)*0+(long(h0(5))>1L)
e0(k)=0
;
nrecs=nr-1
if nr eq 2 then nit=-1 else nit=0
for irecs=1,nrecs do begin
   gdat,file,h1,w1,f1,e1,recs(irecs)
   im2=h1(4)
   if (h1(3) le 4) and (im2 lt 0) then im2=im2+65636L
   if h1(3) ne ncam then begin
      print,' Warning: camera =',h1(3),' not ',ncam
      printf,lu,' Warning: camera =',h1(3),' not ',ncam
      if ((ncam eq 1) and (h1(3) eq 2)) or ((ncam eq 2) and (h1(3) eq 1)) then $
         goto, camok
      stop
      irecs=irecs+1
      nr=nr-1
      goto,done
      endif
   camok:
   if ncam le 4 then printf,lu,' Processing camera number',h1(3),', image',im2 $
      else printf,lu,' Processing record ',strtrim(byte(h(100:159)>32b),2)
   e1=fix(e1)
   finter,w,w1,f1,e1
   if (ncam le 4) and (n_elements(w) gt 4000) then begin
      kgap,h1,w,wg1,ng,e1
      for i=0,ng-1 do begin
         if i lt ngap then if abs(wg1(i,0)-wgap(i,0)) lt 3. then begin
            wgap(i,0)=(wgap(i,0)>wg1(i,0))
            wgap(i,1)=(wgap(i,1)<wg1(i,1))
            endif   ;reset gaps
         endfor    ;gap loop
      endif   ;idat = 7 gap loop
   e2=e1
   if (ncam le 4) and (n_elements(w) gt 4000)  then begin
      ksplice,h1,w,e2
;      fftsm,f1,1,0.6
      endif
;
   if iccr eq 1 then begin
      if debug ne 0 then print,' beginning SPSHFT'
      nit=nit+1
      s=spshft(fref,f1,eref,e2,nit) 
      if iccr2 eq 0 then begin   ; autoshift
         wk=where(w gt lw) & kw1=(wk(0)-150)>0
         wk=where(w gt uw) & kw2=(wk(0)+150)<(n_elements(w)-1)
         print,' bin limits=',kw1,kw2
         print,systime(0)
         s=spshft(fref(kw1:kw2),f1(kw1:kw2),eref(kw1:kw2),e2(kw1:kw2),nit)
         print,' SPSHFT done, s=',s,systime(0)
         endif else begin                        ;manual shift
         s=shfth2(w,fref,f1,lw,uw)
         print,' SHFTH2 done, s=',s
         ;s=0
         endelse          ;iccr2
      endif else s=0.     ;iccr
;
   igo=0
   case 1 of
      s eq -1000: begin
         printf,lu,' WARNING: file number',irecs+1,': peak too close to edge'
         end
      s lt -8000: begin
        printf,lu,' file number',irecs+1,' WARNING: NO SIGNIFICANT PEAK FOUND'
         s=s+9000
         igo=1
         end
      abs(s) gt krange: begin
         z=string(s,'(I2)')
         printf,lu,' file number',irecs+1,' WARNING: PEAK @ ',z,' OUTSIDE BOUNDS - RESETTING'
         igo=1
         end
      else:
      endcase
   if (igo eq 1) or (debug eq 2) then begin         
      if debug gt 0 then begin           ;check manually
         print,string(7b),' shift=',s
         igo=0.0
    read,' is this shift OK? enter 99 to accept,-99 to omit, other to set: ',igo
         case 1 of
            igo ge 98.9:
            igo le -98.9: s=-1000
            else: s=igo
            endcase
         endif else s=-1000     ;ignore data if running on auto
      endif   ;igo
   if s eq -1000 then begin     ;skip this record
      printf,lu,' file number',irecs+1,' not added'
      nr=nr-1 & goto,done
      endif
   f1=f1*(h1(5)>1)
   time=time+(long(h1(5))>1L)
   h0(180+irecs)=h1(4)
   k=wherebad(e1,1)                   ;bad data
   f1(k)=0.
   e1=long(e1)*0+(long(h1(5))>1L)
   e1(k)=0
   if s ne 0 then begin    ;apply shift
      if (shftmode eq 0) or (abs(s-fix(s)) lt 0.01)  then begin
         s=fix(s)
         f1=shift(f1,s)
         e1=shift(e1,s)
         case 1 of
            s gt 0: begin
               f1(n_elements(f1)-1-s:*)=0.
               e1(n_elements(f1)-1-s:*)=0
               end
            s lt 0: begin
               f1(0:abs(s)-1)=0.
               e1(0:abs(s)-1)=0
               end
            else:
            endcase
         endif else begin
         dl=w(1)-w(0)
         shft=s*dl
         f1=interpol(f1,w,w+shft)
         e1=interpol(e1,w,w+shft)
         endelse
      endif
   f0=f0+f1
   e0=e0+e1
   print,' file number',irecs+1,' added, shift=',s,' accumulated time=',time
   printf,lu,' file number',irecs+1,' added, shift=',s,' accumulated time=',time
   done:
   endfor     ;irecs
f0=f0/(e0>1)    ;flux/sec
;
if (ncam le 4) and (n_elements(w) gt 4000) then cutgaps,h0,w,f0,e0,ngap,wgap(*,0),wgap(*,1)
;
h0(4)=0     ;dummy record number
if time gt 32767L then h0(5)=-fix(time/60) else h0(5)=time
h0(9)=nr    ;records added
title=title+' sum of '+strtrim(nr,2)+' spectra'
title=byte(title)
h0(100)=title
;
print,h0(20:23)
e0=byte(127.*float(e0)/max(e0))
if savrec ne -1 then begin
   kdat,file,h0,w,f0,e0,savrec
   printf,lu,' data saved to ',file,' record #',savrec
   endif
!x.title='!6 Angstroms'
!y.title=ytit(0)
!p.title=strtrim(byte(title),2)
!p.font=-1
!p.charsize=7./5.       ;!fancy=3
print,' '
printf,lu,' '
print,' Done at ',systime(0)
printf,lu,' ADDSP done at ',systime(0)
close,lu
free_lun,lu
if !version.os eq 'vms' then z='delete/noconfirm spshft.tmp;*' $
      else z='rm spshft.tmp'
spawn,z
if keyword_set(prlog) then spawn_print,'addsp.log' else print,' Log in addsp.log'
print,' '
return
end