$ VLBAPIPE - Lorant Sjouwerman, NRAO - Mar 25 02
$ Ver 0.2 : mainly to run BS104?, BS103? and BS086
$0000000011111111112222222222333333333344444444445555555555666666666677777777778
$2345678901234567890123456789012345678901234567890123456789012345678901234567890
$===============================================
$! Procedure for initial VLBA data calibration
$# RUN POPS VLBI UTILITY CALIBRATION
$----------------------------------------------
$;  Copyright (C) 2001-2002
$ and the whole GNU GPL ... 
$===============================================
PROCEDURE P_INIT
$
$   Define VLBAUTIL and variables for VLBA pipeline
$----------------------------------------------
$ What I usually do before starting the procedure (one line each, can't here)
$ restore 0
$ run vlbautil
$ version'mya'
$ run vlbapipe
$ compress
$ and I keep the inputs for BS104?, BS103? and BS086 in ~/bs104_inputs.sav
$---
  msgkill 1;docrt 1;dowa true;prnu -1;prta'';clrm;priority 10
  SCALAR    P_DOALL, P_DOTVPLOT, P_NTAPES, P_DISK
  SCALAR    P_CLINT, P_ANTNUM, P_TECORDAY, P_SOLINT
  ARRAY     P_CALSCANT(8), P_NCOUNT(10), P_BADDISKS(10), P_NO_SLFCL(30)
  STRING*2  P_REFANT
  STRING*4  P_INTERPOL
  STRING*12 P_EXPNAME
  STRING*16 P_CALSOURC(30), P_ATARGETS(30)
  STRING*48 P_TECORFLE
  SCALAR    P_DOSTART, P_DOTIMER, P_NUMCAL, P_NUMREF, P_FREQUID
  SCALAR    P_ERROR, P_DEBUG, P_SUGGEST, P_ROW, P_FACTOR
  ARRAY     P_IMSIZE(2)
  STRING*2  P_EXT
  STRING*4  P_TYP, P_MODE
  STRING*8  P_TASK

$ from input dialog:
  P_DOALL    = DOALL     ;  P_DOTVPLOT = DOTV    ;  P_NTAPES   = NCOUNT
  P_NCOUNT   = APARM     ;  P_EXPNAME  = OUTNAME ;  P_DISK     = OUTDISK
  P_CLINT    = CLINT     ;  P_ANTNUM   = REFANT  ;  P_REFANT   = SORT
  P_CALSCANT = TIMERANG  ;  P_TECORFLE = INFILE  ;  P_TECORDAY = NFILES
  P_INTERPOL = INTERPOL  ;  P_CALSOURC = CALSOUR ;  P_MODE     = OPTYPE
  P_FACTOR   = FACTOR    ;  P_ATARGETS = SOURCES ;  P_BADDISKS = BADDISK
  P_SOLINT   = SOLINT    ;  P_IMSIZE   = IMSIZE
$---
  P_DOTIMER  = 0         ;  P_ERROR    = 0       ;  P_DEBUG    = 0
  P_SUGGEST  = 1
RETURN
FINISH
$===============================================
PROCEDURE P_RESTART
  clrs;ine'pl';j = maxtab(ine);if (j>0) then;inv -1;extd;end
  ine'bp';j = maxtab(ine);if (j>0) then;inv -1;extd;end
  ine'fg';j = maxtab(ine);if (j>1) then;for i=2:j;inv i;extd;end;end
  ine'cl';j = maxtab(ine);if (j>1) then;for i=2:j;inv i;extd;end;end
  ine'sn';j = maxtab(ine);if (j>0) then;inv -1;extd;end
  clrtemp
RETURN
FINISH
$===============================================
PROCEDURE P_RESET
  p_restart
RETURN
FINISH
$===============================================
PROCEDURE P_ZAPALL
  if (error < 1) then
    indisk p_disk;for j = 1 to (-1 * error + 1);zap;end
  end
  clrtemp
RETURN
FINISH
$===============================================
PROCEDURE P_ALLPLOT
  j = maxtab('PL');typ 'TOTAL NUMBER OF PLOT FILES TO SHOW ON TV:'!!char(j)
  for i=1:j;plv i;typ 'plot'char(i)!!'/'!!char(j);runwait('tvpl');read;end
RETURN
FINISH
$===============================================
PROCEDURE P_ALLPRINT
  printer 16 $ make sure not blindly sent to the printer -> ghostview first
  j = maxtab('PL');typ 'TOTAL NUMBER OF PLOT FILES SENT TO PRINTER :'!!char(j)
  plv 1;inv j;lpen 1;functype'';dpar 0;outfile'';copies 1;runwait('lwpla')
RETURN
FINISH
$===============================================
PROCEDURE P_INFO (P_TASK)
  if (p_debug > 0) then
    task p_task
    type '*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*'
    inp
    type '*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*'
    type 'TYPE RETURN TO CONTINUE, ZERO TO STOP'
    read j
    if (j = 0) then
      type 'OK, STOPPING AT' p_task
      p_error = 99
    end    
  end
RETURN
FINISH
$===============================================
PROCEDURE P_SNPLOT (P_EXT, P_TYP)
  inext p_ext
  opty p_typ
  timer 0
  sources ''
  nplots 8
  p_info('vlbasnpl')
  if (p_error = 0) then
    if (p_dotvplot > 0) then $ plot on tv 
      dotv 1
      go vlbasnpl
      typ 'PLOTTING FINISHED, PRESS RETURN TO CONTINUE WITH THE PROCEDURE'
      read
    else
      dotv -1
      plver = maxtab('PL')
      go vlbasnpl
      if (p_dotvplot < 0) then $ divert to printer)
        inver = maxtab('PL')
        runwait('lwpla')
        inver 0
      end
    end
    dotv p_dotvplot
  end
  timer p_calscant
RETURN
FINISH
$===============================================
PROCEDURE P_CRPLOT (P_EXT, P_TYP)
  inext p_ext
  opty p_typ
  timer 0
  sources ''
  nplots 8
  p_info('vlbacrpl')
  if (p_error = 0) then
    if (p_dotvplot > 0) then $ plot on tv 
      dotv 1
      go vlbacrpl
      typ 'PLOTTING FINISHED, PRESS RETURN TO CONTINUE WITH THE PROCEDURE'
      read
    else
      dotv -1
      plver = maxtab('PL')
      go vlbacrpl
      if (p_dotvplot < 0) then $ divert to printer)
        inver = maxtab('PL')
        runwait('lwpla')
        inver 0
      end
    end
    dotv p_dotvplot
  end
  timer p_calscant
RETURN
FINISH
$===============================================
PROCEDURE P_GETFQNUM
  inext'fq';invers 1;keyword = 'num row';getthead;VBA_NFQI = keyvalue(1)
RETURN
FINISH
$===============================================
PROCEDURE P_GETSUROW
$   NOTE: proc sets p_row
  inext'su'; invers 0; keyword'num row'; getthead;p_row = keyvalue(1)
RETURN
FINISH
$===============================================
PROCEDURE P_EXIT
$
$   Restore values
$----------------------------------------------
  DOALL    = P_DOALL     ;  DOTV     = P_DOTVPLOT;  NCOUNT   = P_NTAPES
  APARM    = P_NCOUNT    ;  OUTNAME  = P_EXPNAME ;  OUTDISK  = P_DISK
  CLINT    = P_CLINT     ;  REFANT   = P_ANTNUM  ;  SORT     = P_REFANT
  TIMERANG = P_CALSCANT  ;  INFILE   = P_TECORFLE;  NFILES   = P_TECORDAY
  CALSOUR  = P_CALSOURC  ;  SOURCES  = P_ATARGETS;  BADDISK  = P_BADDISKS
  OPTYPE   = P_MODE      ;  FACTOR   = P_FACTOR  ;  IMSIZE   = P_IMSIZE
  INTERPOL = P_INTERPOL  ;  SOLINT   = P_SOLINT  ;
if (substr(p_calsourc(2),1,1)='*') then
   inn p_expname;inc 'UVDATA';ins 1;intype'uv';p_getsurow;p_numcal=MIN(p_row,30)
end
for i = 1 to p_numcal $ undo changes - in case of request to skip selfcal
  if ( (p_calsourc(i) <> ' ') & (p_no_slfcl(i) = 0) ) then
    p_calsourc(i) = '-'!!p_calsourc(i)
  end
end
*  msgkill -1;docrt 1;dowa false;prnu -1;prta'';clrm
RETURN
FINISH
$===============================================
PROCEDURE P_PRECHECK
$
$   Prepare and check inputs for VLBA pipeline
$   NOTE: proc sets p_dotimer and p_dostart
$----------------------------------------------
$ spectral line data or continuum data to be expected?
  if (p_mode = 'SPEC') then $ apparently spectral line
    type 'DOING SPECTRAL LINE PROCEDURE: NO P-CAL OR FREQUENCY AVERAGING'
  else
    if (p_mode = 'CONT') then $ apparently continuum
      type 'DOING CONTINUUM PROCEDURE: WITH P-CAL AND FREQUENCY AVERAGING'
    else 
      if (p_mode = 'PSEU') then $ pseudo continuum
        type 'DOING PSEUDO CONTINUUM PROCEDURE: '
        type '                 WITH P-CAL BUT -NO- FREQUENCY AVERAGING'
      else 
        type 'OBSERVATION MODE NOT KNOWN - FILL IN "OPTYPE" PROPERLY'
        p_error = 1
      end
    end
  end
$ check number of tapes and corresponding aparm in case of load
  if (p_doall > 0)  then
    if (p_ntapes = 0) then
      type 'NO TAPES ?? - TRY AGAIN'
      p_error = 1
    else 
      i = 0
      while (i < p_ntapes) $ check if all tapes have number of files specified
        i = i + 1
        if ( p_ncount(i) < 1 ) then
          type 'NUMBER OF FILES ON TAPE #'!!char(i)!!' TOO LOW - TRY AGAIN'
          p_error = 2
        end
      end
      for i = (i + 1) to 10 $ check if rest aparm is zero - typo/more tapes ??
        if ( p_ncount(i) > 0 ) then
          type 'MORE FILES EXPECTED ON A NON-DECLARED TAPE  - TRY AGAIN AND'
          type 'SPECIFY LARGER NCOUNT OR RESET NON-USED APARM('!!char(i)!!')'
          p_error = 3
        end
      end
    end
  end
$ check outname and tell it changes to header value
  if (substr(outname,1,1) = ' ') then
    type 'SPECIFY AN UNIQUE OUTNAME, E.G. YOUR EXPERIMENT NAME + SEGMENT'
    p_error = 4
  end
$ check outdisk ?
$ check reasonable clint later ?
$ check refant and corresponding sort, check if refant in array later
$ check timerange and corresp scantime, check if in data and in calsour later
  i = 1
  while (i < 8) $ if timer(2) or above non-zero, timer is specified (not scan)
    i = i + 1
    if (p_calscant(i) > 0) then
      p_dotimer = 1
    end
  end
  if (p_dotimer > 0) then
    if (p_error = 0) then
      type 'USING SPECIFIED TIMERANGE FOR VLBAPCOR'
      i = p_calscant(5) - p_calscant(1)
      i = p_calscant(6) - p_calscant(2) + 24 * i
      i = p_calscant(7) - p_calscant(3) + 60 * i
      if ( (p_calscant(8) - p_calscant(4) + 60 * i) < 1 ) then
        type 'BUT NOW ENDING TIME PRECEEDS STARTING TIME - TRY AGAIN'
        p_error = 6
      end
    end
  else
    if (p_calscant(1) = 0) then
      type 'NO CALIBRATOR SCAN NUMBER OR SCAN TIME SPECFIED - TRY AGAIN'
      p_error = 7
    else
      type 'USING SPECIFIED SCAN NUMBER INSTEAD OF TIMERANGE'
    end
  end
$ check infile and number of infiles later (see if they exist here?)
  if (p_tecorday > 0) then $ run tecor, check infile exits
    if (substr(p_tecorfle,1,1) = ' ') then $ no file specified
      type 'SPECIFY A TECOR FILE; MAKE SURE IT IS ANONYMOUS-FTP-ED FROM:'
      type 'CDDISA.GSFC.NASA.GOV/GPS/PRODUCTS/IONEX/<YEAR>/<DAY-OF-YEAR>'
      p_error = 8
    else
* check here if it exists.. can I?
    end
  else
    type 'TECOR NOT RUN AS REQUESTED BUT RECOMMENDED FOR FREQ <= 15GHZ'
  end
$ check later if in data
$ check later if in data, but here check if odd numbers are in calsource
  p_numref = 0
  i = 0
  while (i < 30) $ count number of sources targeted (incl its Ph-Ref.)
    i = i + 1
    if (substr(p_atargets(i),1,1) <> ' ') then
      p_numref = p_numref + 1
    end
  end
  p_numcal = 0
  i = 0
  while (i < 30) $ count number of sources in calsour, do self-cal ?
    i = i + 1
    if (substr(p_calsourc(i),1,1) <> ' ') then
      p_numcal = p_numcal + 1
      if (substr(p_calsourc(i),1,1) = '-') then
        j = length(p_calsourc(i))
        p_calsourc(i) = substr(p_calsourc(i),2,j)
        if (substr(p_calsourc(i),1,1) = '*') then
          type 'SORRY HAVE TO EXIT: NO SELF CAL ALLOWED FOR CALSOUR = *'
          p_error = 12
        end
        p_no_slfcl(i) = 0
      else
        p_no_slfcl(i) = 1
      end
    end
  end
  clrtemp
  if (p_numref = 0) then $ use calsour only (only strong sources, no Ph-Ref)
    type 'NO PHASE-REF SCHEME SPECIFIED, ASSUMING ALL SOURCES ARE STRONG'
    if (p_numcal = 0) then $ no sources specified !
$      type 'BUT NO CALIBRATOR SOURCES SPECIFIED ! TRY AGAIN'
      type 'AT LEAST ONE CALSOURCE NEEDED - FOR PULSE-CAL/BANDPASS CALIBRATION'
      p_error = 8
    else
    if (substr(p_calsourc(2),1,1)='*') then
        type 'WILL FRINGE FIT ALL SOURCES THAT ARE FOUND IN THE SU-TABLE'
        p_no_slfcl = 1
      else
        type 'WILL FRINGE FIT ALL SOURCES IN CALSOUR, I.E. :'!!char(p_numcal)
      end
    end
  end
$ if sources, check if p_numref even (pairs), borrow p_dostart for loop
  if (substr(p_atargets(1),1,1) <> ' ') then
    if (mod(p_numref,2) = 1) then $ odd number of sources
      type 'ODD NUMBER OF SOURCES - SPECIFY PHAS-REF *PAIRS* !!'
      p_error = 8
    else $ check if odd numbered are in calsour, evens not in calsour
      for i = 1 to p_numref by 2
        j = length(p_atargets(i))
        p_dostart = 1
        while ( (j < 17) & (substr(p_calsourc(p_dostart),1,1) <> ' ') )
          if (substr(p_calsourc(p_dostart),1,j)=substr(p_atargets(i),1,j)) then
            j = 17 $ found! stop the while loop
          else
            p_dostart = p_dostart + 1 $ not found .. next
          end
        end
        if (j <> 17) then $ source not found but should be there
   type 'CALSOUR DOES NOT, BUT SHOULD, INCLUDE PH-REF. SOURCE :'!!p_atargets(i)
          p_error 9
        end
      end
      for i = 2 to p_numref by 2
        j = length(p_atargets(i))
        p_dostart = 1
        while ( (j < 17) & (substr(p_calsourc(p_dostart),1,1) <> ' ') )
          if (substr(p_calsourc(p_dostart),1,j)=substr(p_atargets(i),1,j)) then
            j = 17 $ found! stop the while loop
          else
            p_dostart = p_dostart + 1 $ not found .. next
          end
        end
        if (j = 17) then $ source found but should not be there
   type 'CALSOUR DOES, BUT SHOULD NOT, INCLUDE PH-REF. SOURCE :'!!p_atargets(i)
          p_error 9
        end
      end
      p_numref = p_numref / 2 $ # of pairs; can do because p_numref even
    end
  end
$ check map sizes for factor and imsize
  if (p_factor < 1) then
    p_factor = 1
    type 'WILL NOT DO CALSOUR IMAGES SMALLER THAN 128 SQUARE; 128 IT IS'
  else
    if (p_factor > 64) then
      p_factor = 64
      type 'CALSOUR IMAGE REQUEST TOO BIG, WILL USE THE MAXIMUM OF 8192 SQUARE'
    end
  end
  if (substr(p_atargets(1),1,1) <> ' ') then
    if ( (p_imsize(1) < 512) ! (p_imsize(2) < 512) ) then
      p_imsize = 512
      type 'WILL NOT DO SOURCES IMAGES SMALLER THAN 512 SQUARE; 512 IT IS'
    else
      if ( (p_imsize(1) > 8192) ! (p_imsize(2) > 8192) )  then
        p_imsize = 8192
        type 'SOURCE IMAGE REQUEST TOO BIG, WILL USE THE MAXIMUM OF 8192 SQUARE'
      end
    end
  end
$ include subarray , change into vlbafix ??
$ check solint and interpol 
$ check 
$ check intape ? maybe search for file to use?
  if (p_doall < 0) then $ start at (negative) frequency ID
    p_dostart = MOD(-1 * p_doall, 1000)
    if (p_error = 0) then
      type 'SKIPPING LOAD, ASSUMING INNAME IS CORRECT'
      if (p_doall < -1000) then 
        type 'ONLY DOING FREQUENCY ID #'!!char(p_dostart)
      else
        type 'STARTING WITH FREQUENCY ID #'!!char(p_dostart)
      end
    end
  else
    p_dostart = 1 $ also for p_doall = 0, start at first freq-ID
  end
  if (p_debug > 0) then
*    type 'P_PRECHECK ERROR = '!!char(p_error)
  end
RETURN
FINISH
$===============================================
PROCEDURE P_LOAD
$
$   Load data and split freq-id's to prepare for VLBA pipeline
$   NOTE: proc sets VBA_NFQI
$----------------------------------------------
  if (p_doall > 0) then $ start loading data
    intape p_doall
    nfiles 0 $ assumed
    outname p_expname
    outdisk p_disk
    douvcomp 1 $ assumed
    clint p_clint
    for i = 1 to p_ntapes
      ncount p_ncount(i) 
      type 'MOUNT TAPE #'!!char(i)!!' NOW OR ENTER A NON-ZERO VALUE TO STOP'
      type 'TO MOUNT THE TAPE, ENTER ZERO *AFTER* TAPE DRIVE HAS SETTLED'
      read j
      if (j <> 0) then
        type 'OK, STOPPING ON YOUR REQUEST'
        p_exit
        p_error = 99
      else
        if (i = p_ntapes) then
          type 'UNLESS DOTV > 0, YOU CAN GO HOME NOW; REST WILL BE AUTOMATIC'
          type 'PROVIDED THAT ALL INPUTS EXIST AND ARE VALID SO I WONT BREAK'
        end
        p_info('vlbaload')
        if (p_error = 0) then
          mount
          go vlbaload
          dismount
        end
        recat
      end
    end
    if (p_error = 0) then
      type 'DONE WITH LOADING THE DATA'
    end
  end
  if (p_error = 0) then
    inname p_expname
    inclass 'uvdata'
    inseq 0
    intype 'uv'
    indisk p_disk
    baddisk p_baddisks
    if ( (p_doall >= 0) & (p_dostart = 1) ) then $ for freshly loaded file
      p_info('vlbamcal')
      if (p_error = 0) then
        go vlbamcal
        p_info('vlbasubs')
        if (p_error = 0) then
          go vlbasubs
          p_info('vlbafqs')
          if (p_error = 0) then
            go vlbafqs
          end
        end
      end
    else $ make sure VBA_NFQI is (re-)defined with restart; from vlbautil
      p_getfqnum
$inext   = 'fq'
$      invers  = 1
$      keyword = 'num row'
$      getthead
$      VBA_NFQI = keyvalue(1)
    end
  end
RETURN
FINISH
$===============================================
PROCEDURE P_INSTCAL
$
$   Amplitude and instrumental phase calibration per freq-id
$   NOTE: proc sets VBA_PAIR
$----------------------------------------------
  if (VBA_NFQI > 1) then $ multiple freqid's, label in inclass
    inclass 'fq-'!!char(p_frequid)
    inseq 1
  end
  p_info('vlbafpol')
  if (p_error = 0) then
    go vlbafpol
    if (VBA_PAIR > 0) then $ fxpol worked and has a new outclass and outseq
      inclass 'fxpol'
      inseq p_frequid
    end
    if (p_antnum = 0) then
      refant = antnum(p_refant)
    else
      refant p_antnum
    end
    freqid 1 $ because vlbafqs is passed
    subarray 1 $ assumed
    p_info('vlbacala')
    if (p_error = 0) then
      go vlbacala
      inver 1; nplots 8
      p_snplot('cl', 'amp') $ #1
      p_snplot('sn', 'amp') $ #1
      inver 2
$      p_snplot('cl', 'amp') $ #2
      inver 0
      p_snplot('sn', 'amp') $ #2
$      p_snplot('cl', 'amp') $ #3
$      runwait('tasav')
      p_info('vlbapang')
      if (p_error = 0) then
        go vlbapang
        invers 0
*        p_snplot('cl', 'amp') $ #4
        p_snplot('cl', 'phas') $ #4
        if (p_dotimer = 0) then $ chose to supply scan number, not timerange
          timerang = scantime(p_calscant(1))
        else
          timerang = p_calscant
        end
        calsour p_calsour(1),''
        gainu 0; docal 2; doban -1 
$if (maxtab('bp') > 0) then; bpver 0; doban 1; end
        i = maxtab('pc') $ check for pc table
        if ( (p_mode <> 'SPEC') & (i > 0) ) then $ use pulse-cal tones
          p_info('vlbapcor')
          if (p_error = 0) then
            go vlbapcor
          end
        else $ spectral-line or pc table missing; do manual pcal
          aparm 2 0 0 0 0 1 0; dparm 1 0 0 0 0 0 0 1
          p_info('fring')
          if (p_error = 0) then
            runwait('fring')
          end
        end
        if (p_error = 0) then
          nplots 8
*          p_snplot('sn', 'amp') $ #3
          p_snplot('sn', 'phas') $ #3
          p_snplot('sn', 'dela') $ #3
*          p_snplot('cl', 'amp') $ #5
*          p_snplot('cl', 'phas') $ #5
*          p_snplot('cl', 'dela') $ #5
        end
      end
    end
  end
RETURN
FINISH
$===============================================
PROCEDURE P_EXTRAS
$
$   Do some extras: TECOR, BPASS, UVMLN, BPASS
$----------------------------------------------
  if (p_tecorday > 0) then $ run tecor
    task 'tecor'
    infile p_tecorfle
    nfiles p_tecorday
    gainver 0;gainu 0;apar 1 0;clroname;outd p_disk
    p_info('tecor')
    if (p_error = 0) then
      runwait('tecor')
      i = maxtab('cl')
      type 'CL #'!!char(i)!!' ADDS TOTAL ELECTRON CONTENT CORRECTIONS'
      p_snplot('cl', 'ddly') $ #6
      p_snplot('cl', 'phas') $ #6
    end
  else $COPY over THE next CLTABLE ??
  end
  task'tacop'
  inext'fg';inv 0;outv 0;ncou 1;keyword'';keyv 0;outc''
  if (maxtab('fg') > 0) then
    runwait('tacop')
  end
  task 'clipm'
  docal 2;aparm 100, 0;timer 0
  if (p_error = 0) then
    runwait('clipm')
  end
  task 'bpass'
  calsour p_calsourc(1),''
  gainu 0;solint 0;bpver 1;flux 0;timer 0;ante 0
  bpassprm 1 0 1 0 0 0 0 1 1 1 0
  p_info('bpass')
  clrtemp
  if (p_error = 0) then
    runwait('bpass')
    task 'uvmln'
    docal 2;doban 1;bpver 1;flag 0
    flux .01 $ -- is this safe??
    p_info('uvmln')
    if (p_error = 0) then
      runwait('uvmln')
      tget 'bpass'
      bpver 2
      runwait('bpass')
   task'possm';bpver 0;apa 0 1 .5 1.3,-20 20 0 2 1 0;nplots 6;dotv p_dotvplot
      runwait('possm')
    end
  end
RETURN
FINISH
$===============================================
PROCEDURE P_FRING
$----------------------------------------------
$ First do all clcals on calsources, then the pairs
  if (substr(p_calsourc(2),1,1)='*') then
    calsour '';sources '';p_getsurow;p_numcal = p_row $ do all sources
  else
    calsour p_calsourc;  sources p_calsourc $ includes phase-refs, not targets
  end
*  search = 0 $ better make sure solutions exist
  search = antnum('PT'),antnum('LA'),antnum('KP'),antnum('FD'),antnum('OV')
  search(6)~antnum('NL'),antnum('BR'),antnum('NH'),antnum('SC'),antnum('MK')
  bchan 0;solint p_solint;interpol 'self';aparm(6) 1;aparm(9) 1;clrtemp
  baddisk p_baddisks
  p_info('vlbafrng')
  if (p_error = 0) then
    go vlbafrng $ -- for phase-ref
    if (p_numref > 0) then $ sources not empty, find how many/which
      for i = 1 to p_numref $ vlbafrng did all cals, now do the pairs
        j = length(p_atargets(2*i)); p_getsurow; keystrng''
     while ( (p_row>0) & (substr(p_atargets(2*i),1,j) <> substr(keystrng,1,j)) )
          inext'su';pixxy p_row 2 0; tabget
          if (substr(p_atargets(2*i),1,j) = substr(keystrng,1,j)) then $ found
            p_row = -1
            p_error = 0
          else
            p_row = p_row - 1
            p_error = 31
          end
        end   
        clrtemp
        if (p_error = 0) then $ source found; check for reference
          j = length(p_atargets(2*i-1)); p_getsurow; keystrng''
       while ((p_row>0)&(substr(p_atargets(2*i-1),1,j) <> substr(keystrng,1,j)))
            inext'su';pixxy p_row 2 0; tabget
        if (substr(p_atargets(2*i-1),1,j) = substr(keystrng,1,j)) then $ found
              p_row = -1
              p_error = 0
            else
              p_row = p_row - 1
              p_error = 32
            end
          end
          clrtemp
          if (p_error = 32) then
            type 'TARGET IN UV DATA FILE, BUT REFERENCE NOT - CANNOT DO THIS !!'
          end
        else
          type 'COULD NOT FIND TARGET IN UV DATA FILE - NOTHING TO REFERENCE'
          $ keep p_error non-zero to avoid next clcal
        end
        clrtemp
        if (p_error = 0) then $ pair observed in this freq-ID
          tget clcal
          interpol p_interpol
          sources p_atargets(2*i), ''
          calsour p_atargets(2*i-1), ''
          p_info('clcal')
          if (p_error = 0) then
            runwait('clcal')
            type '**'!!calsour(1)!!' USED TO PHASE-REFERENCE :'!!source(1)!!'**'
          end
        else
          type 'THUS :' p_atargets(2*i-1) p_atargets(2*i) 
          type '  AS PHASE REFERENCE PAIR SKIPPED - NOT AS PAIR IN UV DATA SET'
          $ reset p_error to finish loop and program
          p_error = 0
        end
      end
    end
    clrtemp
    if (p_error = 0) then
*      p_snplot('sn', 'amp') $ #4
      p_snplot('sn', 'phas') $ #4
      p_snplot('sn', 'dela') $ #4
      p_snplot('sn', 'rate') $ #4
*      p_snplot('cl', 'amp') $ #7
      p_snplot('cl', 'phas') $ #7
      p_snplot('cl', 'dela') $ #7
      p_snplot('cl', 'rate') $ #7
    end
  end
RETURN
FINISH
$===============================================
PROCEDURE P_SPLIT
$
$   Split data for this frequency ID
$----------------------------------------------
  task 'split'
  outdisk indisk;sour'';doban 1;bpver 2;gainu 0;npoints 0;timer 0
  outs p_frequid;outc substr(p_expname,1,6)
  if (p_mode <> 'CONT') then $ spectral line, no freq averaging
    aparm 0
  else $ continuum, grab all together
    aparm 3 0
  end
  runwait('split')
RETURN
FINISH
$===============================================
PROCEDURE P_SETCELL
  keyw'crval3';geth;cell 2.25e6/keyv(1)
RETURN
FINISH
$===============================================
PROCEDURE P_SCMAP(J)
  task'ima';imsize 128;nit 1000;flux 1e-3;sour'';timer 0;docal -1;doban -1
  gainu 0;bch 0;outd 2;uvwt'na';imagrp(1) 25;imagrp(10) 1
  dotv p_dotvplot;ins p_frequid;outn'';outs p_frequid;outd p_disk
  fldsize p_factor*128 p_factor*128 0;minpa fldsize(1,1)
  for i = j to p_numcal
    if (substr(p_calsourc(2),1,1)='*') then
      inn p_expname;inc 'UVDATA';ins 1;intype'uv'
      ine'su';pixxy i 2 0; tabget
      inn keystrng;inc substr(p_expname,1,6);ins p_frequid;intype'uv';chkname
    else
      inn p_calsourc(i);inc substr(p_expname,1,6);intype'uv';chkname
    end
    clrtemp
    if (error < 1) then
      p_setcell;timer 0;keyword'gcount';gethead
$ differ bch/ech for spec, pseu, etc - this is cont
$ can do cont of calibrators, npoints! both cont/pseu, as well as spec!!
      if (keyval(1) > 10) then
        runwait('imagr')
        if (substr(p_calsourc(2),1,1)<>'*') then
          if (p_no_slfcl(i) = 0) then
            task'scmap';out2d p_disk;nmaps 4;solint p_solint;apa 3 0
            solmode'';docal -1
            runwait('scmap')
            pixr = -20, 20;p_snplot('sn', 'phas') 
            inc'SWTCHD';intype'uv';chkname
            if (error < 1) then
              pixr = -20, 20;p_snplot('sn', 'phas')
              pixr .5 2;p_snplot('sn', 'amp');pixr 0
            end
          end
        end
      end
      clrtemp
    end
  end
  for i = 1 to p_numcal
    if (substr(p_calsourc(2),1,1)<>'*') then
      inn p_calsourc(i);inc'IBM001';ins 0;indi p_disk;intype'ma';chkname
      p_zapall;inc'SCMAP';intype'uv';chkname;p_zapall
$$    inc'SWTCHD';chkname;p_zapall
    else
      inn p_expname;inc 'UVDATA';ins 0;intype'uv';ine'su';pixxy i 2 0; tabget
      inn keystrng;inc 'IBM001';ins 0;intype'ma';chkname;p_zapall
    end
  end
  clrtemp
  recat
RETURN
FINISH
$===============================================
PROCEDURE P_IMAGR
  imsize 512; fldsize p_imsize p_imsize 0; outc'' $ now tagrets, even only (odd done above)
$ NOTE: targets can be empty (strong sources only)
  if (p_numref > 0) then
    for i=1 to p_numref
      inn p_atargets(2*i);ins p_frequid;outs p_frequid
      inc substr(p_expname,1,6);intype'uv';chkname
      if (error < 1) then
        p_setcell;timer 0;keyword'gcount';gethead
$ differ bch/ech for spec, pseu, etc - this is cont
        if (keyval(1) > 10) then
          runwait('imagr')
        end
      end
    end
    for i=1 to p_numref
      inn p_atargets(2*i);inc'IBM001';ins 0;indi outdisk;intype'ma'
      chkname;p_zapall
    end
    recat
  end
RETURN
FINISH
$===============================================
PROCEDURE VLBAPIPE
$
$   Do whole VLBA pipeline
$----------------------------------------------
  inp vlbapipe
  type '============================================================='
  p_init;clrtemp
  p_precheck;clrtemp
  p_suggest = p_doall
  if (p_error = 0) then
    p_load;clrtemp
  end
  if (p_error = 0) then
    p_suggest = 0
  end
  if (p_error = 0) then
*    p_postchck;clrtemp
  end
  type '-------------------------'
  for p_frequid = p_dostart to VBA_NFQI $ for each of the frequency ID's:
    if (p_error = 0) then
      inname p_expname
      type 'NOW DOING FREQUENCY ID #'!!char(p_frequid)
      p_suggest = -1 * p_frequid
    end
    if (p_error = 0) then
      p_instcal;clrtemp
    end
    if (p_error = 0) then
      p_extras;clrtemp
    end
    if (p_error = 0) then
      p_fring;clrtemp
    end
$ new bandpass table here
    if (p_error = 0) then
      p_split;clrtemp
    end
    if (p_error = 0) then
      p_scmap(1);clrtemp
    end
    if (p_error = 0) then
      p_imagr;clrtemp
    end
    if (p_error = 0) then
      type 'DONE WITH FREQUENCY ID #'!!char(p_frequid)
      type '-------------------------'
      p_suggest = -1 * p_frequid - 1
    end
    if (p_doall < -1000) then $ only do this freqid, stop by overflow of index
      p_frequid = VBA_NFQI + 1
    end
  end
  p_exit
  if (p_error = 0) then
    type 'PROCEDURE DONE, THANK YOU FOR CHOOSING AIPS FOR YOUR BUSINESS'
  else
    type 'SOME ERROR OCCURRED - PLEASE REVIEW YOUR INPUTS AND TRY AGAIN'
    type 'SUGGESTED STARTING POINT (CAREFUL!) DOALL = '!!char(p_suggest)
  end
  type '============================================================='
  clrtemp
RETURN
FINISH
$===============================================
PROCEDURE PIPE
  vlbapipe
RETURN
FINISH
$===============================================
PROCEDURE BACKPIPE
  type 'DID YOU LOAD AND MOUNT A FRESH TAPE ? (Y)'
  read
  inn p_expname;ins 0;ind p_disk;inc'uvdata';p_getfqnum;doinv -1
  inc'fxpol';intype'uv';chkname
  if (error = 1) then $ fxpol did not run after frequency split
    inc'fq-1';intype'uv';chkname
    if (error = 1) then
      inc'uvdata'; nfiles = 1;intype'uv';chkname
      if (error = 1) then
        type 'NO MULTI-SOURCE DATA FILE FOUND - CHECK YOUR INPUTS!'
        p_error = 100
      end
    else
      nfiles = VBA_NFQI;doinver 1
    end
  else
$ keep 'fxpol' as inclass
    nfiles = (-1 * error + 1)
  end
$ got nfiles of files and inclass fixed apart from fq-1
  doall -1;outta 3;doeot -1;dostok -1;donewtab 1;format 0;blocking 10
  for j = 1 to nfiles
    if (doinver 1) then
      inc 'fq-'!!char(j)
    end
    outf'mya:'!!inn!!'_'!!inc!!'.'!!char(ins)
  end
$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
$ eigenlijn meteen voor split en na imaging op disk doen! en per freqid
$ ook flag na split?
$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
$$$$$    for j = 1 to (-1 * error + 1);;end
RETURN
FINISH