*
********************************************************************************
*
*This procedure is the finale in our AIPS processing.  This will combine four
*observation files (the .CVEL files) into one UV dataset, with the caveat that
*it will only work if you have one B-J1, one C-J1, one D-J1, and one D-J2
*observation files.  If you have anything else, you must torturously go through
*these steps by hand...pity.  This procedure uses DBCON to combine the files,
*UVPLT to make UV coverage plots of the final data set, and then makes two
*over-sized dirty image cubes with IMAGR (one robust = 5 (Natural weighting) 
*and one robust = 0.5).  It will then use SUBIM to cut out the required imsize
*from the oversized cubes.  It does this because we are not allowed to image in
*AIPS and must export the files to image in Miriad.  However, in order to image
*properly we need to have a beam twice as large as the image....hence the SUBIM
*task.  After all this the final dirty image cube and dirty beam will be output
*to disk and be ready to use in Miriad.  Joy!
*
*BTW...this may take a Myr to run...
*
********************************************************************************

proc combina

********************************************************************************

   clrtemp
   clrmsg

*Defining the needed variables
    array time1(8), time2(8), time3(8), time4(8), lfc(8)
    array times(8,4)
    scalar rant, ntime, loop, chan, fid, resp, j, i, junk1, junk2, vel, refc
    scalar f1, f2, p1, resp2, blech, good, del, umin, umax, resp3, file
    string*8 flux1, flux2, phase, date
    string*20 galn
    string*6 dgal,gal
    string*1 dconf,conf
    string*2 dobs,obs
    string*5 falt1, falt2
    string*3 getit
    string*50 sdir,pdir
    array numbers(6)
*    scalar number
    scalar nfiles
    scalar done
    scalar blah2

*input the script and plot directories
    sdir = '/local/tmp/vla-angst/SCRIPTS/
    pdir = '/local/tmp/vla-angst/PLOTS/

********************************************************************************
*removing the files ahead if they exist
   uca
   mcat
   print ''
   print 'do any old dbcon files need to be deleted?'
   print 'also, did you forget to delete any old image files?'
   print '(yes = 1   no = 2)' read resp3
   
   IF resp3 <> 2
     THEN
       return
   END

******************************************************************************
* Do you want postscript or jpg for plots?
   type ''
   type 'Do you want .ps or .jpg files?'
   type'(.ps = 1  .jpg = 2)' read file
   
   numbers = 0 0 0 0 0 0
   uca
   type ''
   type 'How many CVEL files do you want to combine (up to 6)?'
   type '' read nfiles

   done = 0
   WHILE done = 0
   
      type ''
      type 'Enter catalog numbers.'
      type '' read numbers
      
      
      IF numbers(1) > 0 THEN
         done = 1
      END
      IF numbers(1) = 0 THEN
         type 'Invalid catalog numbers.'
         type 'Enter valid catalog numbers.' read numbers
      END
   END
   
   DEFAULT DBCON
   indisk 1
   in2disk 1
   outdisk 1

   getn numbers(1)

   get2n numbers(2)

   outname 'dbcon1'
   go
   wait

   if nfiles > 2 then
     for j=3 to nfiles
       type j
       type numbers(j)
       type 'dbcon'!!char(j-2)!!' is first file'
       type char(numbers(j))!!'is second file'
       default dbcon
       indisk 1
       in2disk 1
       outdisk 1
       
       inname 'dbcon'!!char(j-2)
       inclass 'dbcon'
       inseq 1
       
       get2n numbers(j)
       
       outname 'dbcon'!!char(j-1)
       outclass 'dbcon'
       outseq 1
       
       go dbcon
       wait dbcon
       
*       default zap
*       inname 'dbcon'!!char(i-2)
*       inclass 'dbcon'
*       inseq 1
*       intype 'uv'
*       zap
       
     end
   end
   
* get rid of intermediate dbcon files
   for i=1 to nfiles-2
      default zap
      indisk 1
      inname 'dbcon'!!char(i)
      inclass 'dbcon'
      inseq 1
      intype 'uv'
      zap
   end
   
* rename last file
   DEFAULT RENAME
   inname 'dbcon'!!char(nfiles-1)
   inclass 'dbcon'
   inseq 1
   outname gal!!'-bcd'
   outclass 'dbcon'
   outseq 1

   rename
   recat

*type 'press 1 to continue' read blah2
*if blah2 = 1 then
*  type 'continuing'
*end


********************************************************************************
*Hooray for imaging...Let's do robust = 5 first
   DEFAULT IMAGR
   indisk 1
   outdisk 1
   
   inname gal!!'-bcd'
   inclass 'dbcon'
   inseq 1
   
   outna inna!!'50'
   
   cell 1.5
   imsize 2720
   robust 5
   
   go imagr
   wait
   
   recat
   
   
********************************************************************************
*Now let's do robust = 0.5
   DEFAULT IMAGR
   indisk 1
   outdisk 1
   
   inname gal!!'-bcd'
   inclass 'dbcon'
   inseq 1
   
   outna inna!!'05'
   
   cell 1.5
   imsize 2720
   robust 0.5
   
   go imagr
   wait
   
   recat
 
********************************************************************************
*Now we need to chop these images and beams up..first the image cube of the
*robust = 5 images
   DEFAULT SUBIM
   indisk 1
   outdisk 1
   
   inname gal!!'-bcd50'
   inclass 'IIM001'
   inseq 1

   blc 1369 1369 0
   trc 2728 2728 0
   
   outname inna
   outclass 'isubim'
      
   go subim
   wait

********************************************************************************
*Now the beam...but just the central (reference) channel
*What is the reference channel?  I have to use a lincop
*file instead of the dbcon file to find the reference channel
*because the dbcon file no longer contains this information...
   DEFAULT GETHEAD
   inname gal!!'-b-j1'
   inclass 'lincop'
   inseq 1
   
   keyword 'crpix3'
   gethead
   refc = keyvalue(1)
   
   DEFAULT SUBIM
   indisk 1
   outdisk 1
   
   inname gal!!'-bcd50'
   inclass 'IBM001'
   inseq 1

   blc 689 689 refc
   trc 3408 3408 refc
   
   outname inna
   outclass 'bsubim'
      
   go subim
   wait

********************************************************************************
*Now we need to chop up the robust = 0.5 images
   DEFAULT SUBIM
   indisk 1
   outdisk 1
   
   inname gal!!'-bcd05'
   inclass 'IIM001'
   inseq 1

   blc 1369 1369 0
   trc 2728 2728 0
   
   outname inna
   outclass 'isubim'
      
   go subim
   wait

********************************************************************************
*Now the beam...but just the central (reference) channel
   DEFAULT SUBIM
   indisk 1
   outdisk 1
   
   inname gal!!'-bcd05'
   inclass 'IBM001'
   inseq 1

   blc 689 689 refc
   trc 3408 3408 refc
   
   outname inna
   outclass 'bsubim'
      
   go subim
   wait

********************************************************************************
*Lets now delete the old images
   DEFAULT zap
   indisk 1
   
   inname gal!!'-bcd50'
   inclass 'IIM001'
   inseq 1
   intype 'ma'
   
   zap
   
   inname gal!!'-bcd50'
   inclass 'IBM001'
   inseq 1
   intype 'ma'
   
   zap
   
   inname gal!!'-bcd05'
   inclass 'IIM001'
   inseq 1
   intype 'ma'
   
   zap
   
   inname gal!!'-bcd05'
   inclass 'IBM001'
   inseq 1
   intype 'ma'
   
   zap

   recat
   
******************************************************************************
* Deleting old plot files if they exist

   DEFAULT SYSTEM
   syscom 'rm /
   sys2com(1) pdir
   sys2com(2) dgal!!'-bcd*jpg
   system
   
   sys2com(2) dgal!!'-bcd*ps
   system

   sys2com(2) dgal!!'-bcd*pdf
   system

********************************************************************************
*resetting the junk1 and junk2 variables
   junk1 = 0
   junk2 = 0

*plotting the UV coverage of the final combined images (full)
   clrtemp
   DEFAULT UVPLT
   indisk 1
   
   inname gal!!'-bcd'
   inclass 'dbcon'
   inseq 1

   source galn
   bchan refc
   echan refc
   
   bparm 6 7
   
   dotv -1
   
   go uvplt
   wait
         
   junk1 = junk2 + 1
   junk2 = maxtab('pl')

******************************************************************************    
*outputting uv coverage for the source (full)   
   clrtemp
   DEFAULT LWPLA;
   INDISK 1; 
   ASPMM 0; 
   LPEN 3; 
   RGBGAMMA 0; 
   FUNCTYPE ''; 
   DPARM 0;
   COPIES 1; 
   DODARK 1; 
   OFMFILE ''; 
   DOCOLOR 1; 

   plcolors(1,3)~ 1 0 0
   plcolors(1,4)~ 0 0 1
   plcolors(1,9)~ 0 0 0
   plcolors(1,10)~ 1 1 1

   inname gal!!'-bcd'
   inclass 'dbcon'
   inseq 1   
    
   plver junk1        
   invers junk2

   outfile 'red:/plots/'!!dgal!!'-bcd-uvcovf.ps
   
   GO LWPLA
   wait
   
******************************************************************************
*plotting the uv coverage for the source (inner 5 kilolambda)
   clrtemp
   DEFAULT UVPLT
   indisk 1
   
   inname gal!!'-bcd'
   inclass 'dbcon'
   inseq 1

   source galn
   bchan refc
   echan refc
   
   bparm 6 7
   uvrang 0 5
   
   dotv -1
   
   go uvplt
   wait
         
   junk1 = junk2 + 1
   junk2 = maxtab('pl')

******************************************************************************    
*outputting uv coverage for the source (inner 5 kilolambda)   
   clrtemp
   DEFAULT LWPLA;
   INDISK 1; 
   ASPMM 0; 
   LPEN 3; 
   RGBGAMMA 0; 
   FUNCTYPE ''; 
   DPARM 0;
   COPIES 1; 
   DODARK 1; 
   OFMFILE ''; 
   DOCOLOR 1; 

   plcolors(1,3)~ 1 0 0
   plcolors(1,4)~ 0 0 1
   plcolors(1,9)~ 0 0 0
   plcolors(1,10)~ 1 1 1

   inname gal!!'-bcd'
   inclass 'dbcon'
   inseq 1   
    
   plver junk1        
   invers junk2

   outfile 'red:/plots/'!!dgal!!'-bcd-uvcovi.ps
   
   GO LWPLA
   wait
   
******************************************************************************
   IF file = 2
     THEN

*Now let's convert all these postscript files to gif files in order to save 
*some space shall we...
      DEFAULT SYSTEM
      syscom sdir
      sys2com(1) 'ps2jpg.sc
      system
   
   END

******************************************************************************
*print out the message window contents to a file
*...but first deleting any older versions...
   default system
   syscom 'rm /
   sys2com(1) pdir
   sys2com(2) dgal!!'-bcd-combina.txt
   system
   
   
   default prtmsg
   docrt -1
   outprint 'red:/PLOTS/'!!dgal!!'-bcd-combina.txt
   prtmsg

********************************************************************************
*resetting the outprint and docrt adverbs
   DEFAULT EXPLAIN  
  
   clrtemp
   clrmsg

return;finish