! @(#)irsconnect.prg	17.1.1.1 (ES0-DMD) 01/25/02 17:52:59
!+++++++++++++++++++++++++++++++++++++++++++++++++++++++
!
!.COPYRIGHT   (C) 1992 European Southern Observatory
!.IDENT       irsconnect.prg
!.AUTHOR      E. Oliva,  Firenze, Arcetri
!.KEYWORDS    Spectroscopy, IRSPEC
!.PURPOSE     Exexute command MERGE/IRSPEC
!             Merge 1D spectra at differnt wavelengths into a table.
!             It gives the possibility to force the connection on
!             the overlapping regions, this is possible only
!             for objects with relatively strong (well measured)
!             continuum (the correction applied is multiplicative!)
!             Does nor require external (.for) files.
!
!.VERSION     1.0    Creation     02.09.1992   E. Oliva
!
!-------------------------------------------------------
!
! Needs a modification, once MERGE/TABLE works with "&"...
!
! Used to connect together 1D spectra
!
! @s connect prefix i1,i2[,i3] out_table [n_pixels_out] [correct_option] 
! [#ref_image] [plot_option] [format] 
!
crossref prefix i out excl corr ref plot format
def/param p1 ? cha "Image prefix ? : "
def/param p2 ? cha "i1,i2[,i3] ? : "
def/param p3 ? tab "Ouput table ? : "
def/param p4 0 num "Number of pixels to be excluded at each edge ? : "  0,1000
def/param p5 1 num "Correction option >0 do correct"
def/param p6 0 num "# of reference image "
def/param p7 1 num "Plot option (>0=yes) "
def/param p8 i4 cha "Format for i-numbers "
!
def/loc incmd/c/1/132 "{MID$LINE}"
!
def/loc ii/i/1/3 0,0,1
def/loc i/i/1/1 0 ? +lower
def/loc icen/i/1/1 0
def/loc r1/r/1/1 0. ? +lower
def/loc r2/r/1/1 0. ? +lower
def/loc j/i/1/2 0,0
def/loc k/i/1/4 0,0,0,0 ? +lower
def/loc nout/i/1/1 0
def/loc npix/i/1/1 0 ? +lower
def/loc nima/i/1/1 0
def/loc l/i/1/1 0
def/loc jj/i/1/1 0
def/loc i3/i/1/1 0
def/loc xlim/r/1/2 0,0
def/loc ylim/r/1/2 0,0

@ creifnot 1

set/format 'p8'
nout = 'p4'
write/keyw ii 'p2'
if 'p7' .gt. 0 then
  xlim(1) = 1e10
  xlim(2) = -1e10
  ylim(1) = 1e10
  ylim(2) = -1e10
  write/out "Defining graphic limits, may take some time...."
  do l = 'ii(1)' 'ii(2)' 'ii(3)'
    copy/dk 'p1''l' step/d/1/1 r2/r/1/1
    copy/dk 'p1''l' npix/i/1/1 i/i/1/1
    if r2 .gt. 0 then
      copy/dk 'p1''l' start/d/1/1 r1/r/1/1
      r2 = r1+(i-1)*r2
    else
      r1 = r2
      copy/dk 'p1''l' start/d/1/1 r2/r/1/1
      r1 = r2+(i-1)*r1
    endif
    if r1 .lt. xlim(1) xlim(1) = r1
    if r2 .gt. xlim(2) xlim(2) = r2
    stat/image 'p1''l' option=rn
    copy/dk 'p1''l' statistic/r/1/2 outputr/r/1/2
    if outputr(1) .lt. ylim(1) ylim(1) = outputr(1)
    if outputr(2) .gt. ylim(2) ylim(2) = outputr(2)
  enddo
  r1 = xlim(2)-xlim(1)
  xlim(1) = xlim(1)-0.2*r1
  xlim(2) = xlim(2)+0.2*r1
  r1 = ylim(2)-ylim(1)
  ylim(1) = ylim(1)-0.7*r1
  ylim(2) = ylim(2)+0.7*r1
  set/graph xaxis={xlim(1)},{xlim(2)} yaxis={ylim(1)},{ylim(2)}
  l = ii(1)
  plot 'p1''l'
  i = l+ii(3)
  do l = 'i' 'ii(2)' 'ii(3)'
    over 'p1''l'
  enddo
endif

copy/dk 'p1''ii(2)' npix/i/1/1 npix/i/1/1
if npix .le. nout then
  write/out Number of pixels to exclude (nout) is larger than image X-size
  if 'p7' .gt. 0 then
    set/graph xaxis=auto yaxis=auto
  endif
  return/exit
endif
if 'p6' .le. 0 then
  nima = m$abs((ii(2)-ii(1))/ii(3))+1
  icen = nima/2
  icen = ii(1)+ii(3)*icen
else
  icen = 'p6'
endif
j(1) = nout+1
j(2) = npix-nout
do l = 'ii(1)' 'ii(2)' 'ii(3)'
  extr/image &a'l' = 'p1''l'[@'j(1)':@'j(2)']
enddo
if 'p5' .le. 0 goto jump2
l = icen
write/out Determining overlap factors
write/out Reference (untouched) image is 'p1''l'
jj = l+ii(3)
if jj .le. ii(2) then
  @s irsconnect,defoverlap &a'l' &a'jj'
  copy/kk outputi/i/1/4 k/i/1/4
else
  write/keyw k 1,1,1,1
endif
stat/image &a'l' [@'k(1)':@'k(2)'] option=rn
copy/dk  &a'l' statistic/r/3/1 r1/r/1/1
if 'p7' .gt. 0 plot &a'l'
i = icen+ii(3)
if i .gt. ii(2) goto jump1
do l = 'i' 'ii(2)' 'ii(3)'
  write/out overlapping image 'p1''l'
  stat/image &a'l' [@'k(3)':@'k(4)'] option=rn
  copy/dk  &a'l' statistic/r/3/1 r2/r/1/1
  comp &a'l' = &a'l'*'r1'/'r2'
  if 'p7' .gt. 0 over &a'l'
  if l .lt. ii(2) then
    jj = l+ii(3)
    @s irsconnect,defoverlap &a'l' &a'jj'
    copy/kk outputi/i/1/4 k/i/1/4
  else
    write/keyw k 1,1,1,1
  endif
  stat/image &a'l' [@'k(1)':@'k(2)'] option=rn
  copy/dk  &a'l' statistic/r/3/1 r1/r/1/1
enddo
jump1:
l = icen
jj = l-ii(3)
if jj .ge. ii(1) then
  @s irsconnect,defoverlap &a'jj' &a'l'
  copy/kk outputi/i/1/4 k/i/1/4
else
  write/keyw k 1,1,1,1
endif
stat/image &a'l' [@'k(3)':@'k(4)'] option=rn
copy/dk  &a'l' statistic/r/3/1 r2/r/1/1
i = icen-ii(3)
if i .lt. ii(1) goto jump2
i3 = -ii(3)
do l = 'i' 'ii(1)' 'i3'
  write/out overlapping image 'p1''l'
  stat/image &a'l' [@'k(1)':@'k(2)'] option=rn
  copy/dk  &a'l' statistic/r/3/1 r1/r/1/1
  comp &a'l' = &a'l'*'r2'/'r1'
  if 'p7' .gt. 0 over &a'l'
  if l .gt. ii(1) then
    jj = l-ii(3)
    @s irsconnect,defoverlap &a'jj' &a'l'
    copy/kk outputi/i/1/4 k/i/1/4
  else
    write/keyw k 1,1,1,1
  endif
  stat/image &a'l' [@'k(3)':@'k(4)'] option=rn
  copy/dk  &a'l' statistic/r/3/1 r2/r/1/1
enddo
jump2:

write/out Creating final table
i = 0
do l = 'ii(1)' 'ii(2)' 'ii(3)'
  i = i+1
  copy/it &a'l' &a'i' wl
  name/column &a'i' #2 :f
enddo
nima = i
i = 1
copy/table &a'i' &a
do i = 2 'nima' 
!
! To be modified once MERGE/TABLE works
!
!  merge/table &a &a'i' &b
  merge/table &a &a'i' middummb
!
  ren/table &b &a
enddo
ren/table &a 'p3'
sort/table 'p3' :wl
if 'p7' .gt. 0  then
  plot/table 'p3' :wl :f
  set/graph xaxis=auto yaxis=auto
endif
end:
copy/kd incmd/c/1/132 'p3'.tbl history/c/-1/132
return
!
!
!
!
entry defoverlap
!
! Used to define and write in OUTPUTI(1:4) the X-overlap
! between 2 images
!
! outputi(1,2) refers to 1st image
! outputi(3,4) refers to 2nd image
!
def/param p1 ? ima "imag #1 : "
def/param p2 ? ima "imag #2 : "

def/loc xmin/r/1/2 0,0 ? +lower
def/loc xmax/r/1/2 0,0
def/loc dx/r/1/2 0,0 ? +lower
def/loc nx/i/1/2 0,0 ? +lower

copy/dk 'p1' start/d/1/1 xmin/r/1/1
copy/dk 'p1' step/d/1/1 dx/r/1/1
copy/dk 'p1' npix/i/1/1 nx/i/1/1
xmax(1) = xmin(1)+('nx(1)'-1)*dx(1)
copy/dk 'p2' start/d/1/1 xmin/r/2/1
copy/dk 'p2' step/d/1/1 dx/r/2/1
copy/dk 'p2' npix/i/1/1 nx/i/2/1
xmax(2) = xmin(2)+('nx(2)'-1)*dx(2)
if xmin(1) .lt. xmin(2) then
  if xmax(1) .lt. xmin(2) then
!    write/out WARNING images 'p1','p2' do not overlap
    return
  endif
  outputi(1) = m$nint((xmin(2)-xmin(1))/dx(1)+1)
  if outputi(1) .gt. nx(1) outputi(1) = nx(1)
  outputi(2) = nx(1)
  outputi(3) = 1
  outputi(4) = m$nint((xmax(1)-xmin(2))/dx(2)+1)
  if outputi(4) .lt. 1 outputi(4) = 1
endif
if xmin(2) .lt. xmin(1) then
  if xmax(2) .lt. xmin(1) then
!    write/out WARNING images 'p1','p2' do not overlap
    return
  endif
  outputi(1) = 1
  outputi(2) = m$nint((xmax(2)-xmin(1))/dx(1)+1)
  if outputi(2) .lt. 1 outputi(2) = 1
  outputi(3) = m$nint((xmin(1)-xmin(2))/dx(2)+1)
  if outputi(3) .gt. nx(2) outputi(3) = nx(2)
  outputi(4) = nx(2)
endif
return