$ VLBAPROC $--------------------------------------------------------------- $! Procedures for easy-to-learn VLBA data reduction $# RUN POPS VLBI UTILITY CALIBRATION $----------------------------------------------------------------------- $; Copyright (C) 2000-2002 $; Associated Universities, Inc. Washington DC, USA. $; $; This program is free software; you can redistribute it/or $; and/or modify it under the terms of the GNU General Public $; License as published by the Free Software Foundation; either $; version 2 of the License, or (at your option) any later $; version. $; $; This program is distributed in the hope that it will be $; useful, but WITHOUT ANY WARRANTY; without even the implied $; warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR $; PURPOSE. See the GNU General Public License for more $; details. $; $; You should have received a copy of the GNU General Public $; License along with this program; if not, write to the Free $; Software Foundation, Inc., 675 Massachusetts Ave, Cambridge, $; MA 02139, USA. $; $; Correspondence concerning AIPS should be addressed as $; follows: $; Internet email: aipsmail@nrao.edu. $; Postal address: AIPS Project Office $; National Radio Astronomy Observatory $; 520 Edgemont Road $; Charlottesville, VA 22903-2475 USA $----------------------------------------------------------------------- PROCEDURE VBA_VARS *----------------------------------------------------------------------- * Define variables for VLBA procedures. *----------------------------------------------------------------------- * * These are used as arguments for procedures * STRING*8 VBA_ANAM SCALAR VBA_SCAN STRING*8 VBA_TASK STRING*2 VBA_TYPE * * These are used to store adverb settings that should be restored * at the end of a procedure. * ARRAY VBA_APRM(10) ARRAY VBA_ANTS(50) ARRAY VBA_BASE(50) SCALAR VBA_BCHN SCALAR VBA_BIF SCALAR VBA_BLNK STRING*8 VBA_BPOL ARRAY VBA_BPRM(10) STRING*4 VBA_CCOD ARRAY VBA_CLCP(20) SCALAR VBA_CONC ARRAY VBA_CPRM(10) STRING*16 VBA_CSRC(30) SCALAR VBA_CUT SCALAR VBA_DELC SCALAR VBA_DIGI SCALAR VBA_DOTB SCALAR VBA_DOTV ARRAY VBA_DPRM(10) SCALAR VBA_ECHN SCALAR VBA_EIF STRING*2 VBA_EXT SCALAR VBA_FQID ARRAY VBA_FIT(30) SCALAR VBA_FTOL SCALAR VBA_FVER SCALAR VBA_GCV SCALAR VBA_GUSE SCALAR VBA_GVER STRING*48 VBA_INFI STRING*4 VBA_INTP ARRAY VBA_IPRM(3) STRING*16 VBA_KEYS ARRAY VBA_KEYV(2) STRING*8 VBA_KEYW SCALAR VBA_LTYP SCALAR VBA_NCNT SCALAR VBA_NPCE STRING*6 VBA_OCLA SCALAR VBA_ODSK STRING*12 VBA_ONAM STRING*4 VBA_OPCO STRING*4 VBA_OPTY SCALAR VBA_OSEQ SCALAR VBA_OVER ARRAY VBA_PIXY(7) SCALAR VBA_PLEV SCALAR VBA_QUAL SCALAR VBA_SBND STRING*4 VBA_SCOD SCALAR VBA_SFRQ SCALAR VBA_SOLI STRING*2 VBA_SORT STRING*16 VBA_SRCS(30) STRING*4 VBA_STOK STRING*4 VBA_STYP SCALAR VBA_SUB SCALAR VBA_SVER ARRAY VBA_TAU0(30) ARRAY VBA_TRAN(8) ARRAY VBA_TREC(30) STRING*8 VBA_TTSK SCALAR VBA_TVER SCALAR VBA_USER ARRAY VBA_UVCP(10) ARRAY VBA_UVRA(2) SCALAR VBA_VERS SCALAR VBA_WAIT SCALAR VBA_WTHR * STRING*12 VBA_NAME STRING*6 VBA_CLAS SCALAR VBA_SEQ SCALAR VBA_DISK RETURN FINISH PROCEDURE RUNWAIT (VBA_TASK) *----------------------------------------------------------------------- * Runs VBA_TASK and waits for it to complete regardless of the * value of DOWAIT. * * Inputs: * VBA_TASK name of task *----------------------------------------------------------------------- VBA_WAIT = DOWAIT; DOWAIT = TRUE; VBA_TTSK = TASK; TASK = VBA_TASK GO DOWAIT = VBA_WAIT; TASK = VBA_TTSK RETURN FINISH PROCEDURE MAXTAB (VBA_TYPE) *----------------------------------------------------------------------- * Return the highest version number of a table of type VBA_TYPE * attached to the specified file. * * Inputs: * VBA_TYPE Table type * * Adverbs: * USERID User ID * INNAME File name * INCLASS File class * INSEQ File sequence number * INDISK File disk number *----------------------------------------------------------------------- SCALAR VBA_SLOT SCALAR VBA_VERS *----------------------------------------------------------------------- * * Save adverb values * VBA_KEYW = KEYWORD VBA_KEYV = KEYVALUE VBA_KEYS = KEYSTRNG * VBA_SLOT = 0 KEYSTRNG = ' ' * Invariant: KEYSTRNG <> VBA_TYPE implies that no of the first * VBA_SLOT tables has type VBA_TYPE * Bound: 50 - VBA_SLOT WHILE VBA_SLOT <> 50 & KEYSTRNG <> VBA_TYPE VBA_SLOT = VBA_SLOT + 1 KEYWORD = 'EXTYPE' !! CHAR(VBA_SLOT) GETHEAD END * If KEYSTRNG = VBA_TYPE then VBA_SLOT is the index for table type * VBA_TYPE in the file header otherwise there are no tables of type * VBA_TYPE. IF KEYSTRNG = VBA_TYPE THEN KEYWORD = 'EXTVER' !! CHAR(VBA_SLOT); GETHEAD ELSE KEYVALUE(1) = 0 END VBA_VER = KEYVALUE(1) * Restore saved adverbs KEYWORD = VBA_KEYW; KEYVALUE = VBA_KEYV; KEYSTRNG = VBA_KEYS RETURN VBA_VER FINISH PROCEDURE ANTNUM (VBA_ANAM) *----------------------------------------------------------------------- * Returns the antenna number for the antenna with name VBA_ANAM in * subarray SUBARRAY. Returns zero if there is no antenna with the * specified name in that subarray. * * Displays an error message and returns zero if the subarray number * is out of range. * * Inputs: * VBA_ANAM Antenna name * * Adverbs: * USERID User ID of file * INNAME Name of file * INCLASS Class of file * INSEQ Sequence number of file * INDISK Disk number of file * SUBARRAY Subarray number *----------------------------------------------------------------------- SCALAR VBA_ROW SCALAR VBA_NROW SCALAR VBA_NUM *----------------------------------------------------------------------- * Save adverb values: VBA_EXT = INEXT; VBA_VERS = INVERS; VBA_PIXY = PIXXY VBA_KEYW = KEYWORD; VBA_KEYV = KEYVALUE; VBA_KEYS = KEYSTRNG * INEXT = 'AN' IF SUBARRAY > 0 THEN INVERS = SUBARRAY ELSE INVERS = 1 END IF * IF INVERS > MAXTAB('AN') THEN PRINT 'ANTNUM: SUBARRAY #' !! CHAR(INVERS) !! ' DOES NOT EXIST' VBA_NUM = 0 ELSE * Find the number of rows in the antenna table KEYWORD = 'NUM ROW'; GETTHEAD; VBA_NROW = KEYVALUE(1) VBA_ROW = 0; VBA_NUM = 0 * Invariant: VBA_NUM = 0 implies that antenna VBA_ANAM is not * in the first VBA_ROW rows of the antenna table * Bound: VBA_NROW - VBA_ROW WHILE VBA_NUM = 0 & VBA_ROW <> VBA_NROW VBA_ROW = VBA_ROW + 1; PIXXY = VBA_ROW, 1, 1; TABGET IF KEYSTRNG = VBA_ANAM THEN PIXXY = VBA_ROW, 4, 1; TABGET; VBA_NUM = KEYVALUE(1) END END END * Restore adverbs INEXT = VBA_EXT; INVERS = VBA_VERS; PIXXY = VBA_PIXY KEYWORD = VBA_KEYW; KEYVALUE = VBA_KEYV; KEYSTRNG = VBA_KEYS RETURN VBA_NUM FINISH PROCEDURE SCANTIME(VBA_SCAN) *----------------------------------------------------------------------- * Returns the time range covered by a scan listed in the index table * * Inputs: * VBA_SCAN scan number * * Adverbs: * USERID user ID * INNAME file name * INCLASS file class * INSEQ file sequence number * INDISK file disk number *----------------------------------------------------------------------- ARRAY VBA_TIMR(8) SCALAR VBA_STRT SCALAR VBA_FINI SCALAR VBA_TIME SCALAR VBA_NROW *----------------------------------------------------------------------- * * Save adverbs * VBA_EXT = INEXT; VBA_VERS = INVERS; VBA_PIXY = PIXXY VBA_KEYW = KEYWORD; VBA_KEYV = KEYVALUE; VBA_KEYS = KEYSTRNG * IF MAXTAB('NX') < 1 THEN PRINT 'SCANTIME: THERE IS NO INDEX TABLE' VBA_TIMR = 0, 0, 0, 0, 0, 0, 0, 0 ELSE * * Get number of scans * INEXT = 'NX'; INVERS = 1; KEYWORD = 'NUM ROW'; GETTHEAD VBA_NROW = KEYVALUE(1) * IF VBA_SCAN < 1 ! VBA_SCAN > VBA_NROW THEN PRINT 'SCANTIME: THERE IS NO SCAN #' !! CHAR(VBA_SCAN) VBA_TIMR = 0, 0, 0, 0, 0, 0, 0, 0 ELSE PIXXY = VBA_SCAN, 1; TABGET; VBA_TIME = KEYVALUE(1) PIXXY = VBA_SCAN, 2; TABGET VBA_STRT = VBA_TIME - KEYVALUE(1)/2.; VBA_FINI = VBA_TIME + KEYVALUE(1)/2.; VBA_TIMR(1) = FLOOR(VBA_STRT); VBA_STRT = 24.0 * (VBA_STRT - VBA_TIMR(1)); VBA_TIMR(2) = FLOOR(VBA_STRT); VBA_STRT = 60.0 * (VBA_STRT - VBA_TIMR(2)); VBA_TIMR(3) = FLOOR(VBA_STRT); VBA_TIMR(4) = CEIL(60.0 * (VBA_STRT - VBA_TIMR(3))); VBA_TIMR(5) = FLOOR(VBA_FINI); VBA_FINI = 24.0 * (VBA_FINI - VBA_TIMR(5)); VBA_TIMR(6) = FLOOR(VBA_FINI); VBA_FINI = 60.0 * (VBA_FINI - VBA_TIMR(6)); VBA_TIMR(7) = FLOOR(VBA_FINI); VBA_TIMR(8) = FLOOR(60.0 * (VBA_FINI - VBA_TIMR(7))); END END * Restore adverbs: INEXT = VBA_EXT; INVERS = VBA_VERS; PIXXY = VBA_PIXY KEYWORD = VBA_KEYW; KEYVALUE = VBA_KEYV; KEYSTRNG = VBA_KEYS RETURN VBA_TIMR FINISH PROCEDURE VBA_NEW *----------------------------------------------------------------------- * Returns TRUE if the current data set appears to be new (i.e. if * it has no more than one of each calibration table type) or FALSE * if the current data set appears to have undergone some calibration. * * Inputs: * INNAME file name * INCLASS file class * INSEQ file sequence number * INDISK file disk number *----------------------------------------------------------------------- SCALAR VBA_OK *----------------------------------------------------------------------- VBA_OK = TRUE IF MAXTAB ('CL') > 1 THEN; VBA_OK = FALSE; END IF MAXTAB ('GC') > 1 THEN; VBA_OK = FALSE; END IF MAXTAB ('PC') > 1 THEN; VBA_OK = FALSE; END IF MAXTAB ('TY') > 1 THEN; VBA_OK = FALSE; END RETURN VBA_OK FINISH PROCEDURE VBA_NSTK *----------------------------------------------------------------------- * Returns the number of STOKES axis values in a file. * * Issues an error message and returns zero if there is no STOKES * axis. * * Inputs: * USERID user ID. * INNAME file name * INCLASS file class * INSEQ file sequence number * INDISK file disk number *----------------------------------------------------------------------- SCALAR VBA_AXIS SCALAR VBA_NUM *----------------------------------------------------------------------- * Save adverbs VBA_KEYW = KEYWORD; VBA_KEYS = KEYSTRNG; VBA_KEYV = KEYVALUE VBA_AXIS = 0; KEYSTRNG = ' ' * Invariant: KEYSTRNG <> 'STOKES' implies that the STOKES axis is not * one of the first VBA_AXIS axes * Bound: 7 - VBA_AXIS WHILE VBA_AXIS <> 7 & KEYSTRNG <> 'STOKES' VBA_AXIS = VBA_AXIS + 1 KEYWORD = 'CTYPE' !! CHAR(VBA_AXIS); GETHEAD END IF KEYSTRNG = 'STOKES' THEN KEYWORD = 'NAXIS' !! CHAR(VBA_AXIS); GETHEAD VBA_NUM = KEYVALUE(1) ELSE PRINT 'VBA_NSTK: STOKES AXIS IS MISSING' VBA_NUM = 0 END * Restore adverbs KEYWORD = VBA_KEYW; KEYSTRNG = VBA_KEYS; KEYVALUE = VBA_KEYV RETURN VBA_NUM FINISH PROCEDURE VBA_STK1 *----------------------------------------------------------------------- * Returns the reference value for the STOKES axis in a file * * Inputs: * USERID user ID number * INNAME file name * INCLASS file class * INSEQ file sequence number * INDISK file disk number *----------------------------------------------------------------------- SCALAR VBA_AXIS SCALAR VBA_NUM *----------------------------------------------------------------------- * Save adverbs VBA_KEYW = KEYWORD; VBA_KEYS = KEYSTRNG; VBA_KEYV = KEYVALUE VBA_AXIS = 0; KEYSTRNG = ' ' * Invariant: KEYSTRNG <> 'STOKES' implies that the STOKES axis is not * one of the first VBA_AXIS axes * Bound: 7 - VBA_AXIS WHILE VBA_AXIS <> 7 & KEYSTRNG <> 'STOKES' VBA_AXIS = VBA_AXIS + 1 KEYWORD = 'CTYPE' !! CHAR(VBA_AXIS); GETHEAD END IF KEYSTRNG = 'STOKES' THEN KEYWORD = 'CRVAL' !! CHAR(VBA_AXIS); GETHEAD VBA_NUM = KEYVALUE(1) ELSE PRINT 'VBA_STK1: STOKES AXIS IS MISSING' VBA_NUM = 0 END KEYWORD = VBA_KEYW; KEYSTRNG = VBA_KEYS; KEYVALUE = VBA_KEYV RETURN VBA_NUM FINISH PROCEDURE VBA_ONLY *----------------------------------------------------------------------- * Returns TRUE if a data set only contains VLBA antennas or the VLA * or returns FALSE if other stations are present. * * Assumes that at least one antenna table is present. * * Inputs: * USERID user ID number * INNAME file name * INCLAS file class * INSEQ file sequence number * INDISK file disk number *----------------------------------------------------------------------- SCALAR VBA_NSUB SCALAR VBA_NANT SCALAR VBA_STAT SCALAR VBA_VLBA SCALAR VBA_ROW *----------------------------------------------------------------------- * Save adverbs VBA_EXT = INEXT; VBA_VERS = INVERS; VBA_PIXY = PIXXY; VBA_KEYW = KEYWORD; VBA_KEYV = KEYVALUE; VBA_KEYS = KEYSTRNG VBA_NSUB = MAXTAB ('AN'); VBA_VLBA = TRUE FOR INVER = 1 TO VBA_NSUB INEXT = 'AN' KEYWORD = 'NUM ROW' GETTHEAD VBA_NANT = KEYVALUE(1) FOR VBA_ROW = 1 TO VBA_NANT PIXXY = VBA_ROW, 1; TABGET; VBA_STAT = FALSE IF KEYSTRNG = 'BR' THEN; VBA_STAT = TRUE; END IF KEYSTRNG = 'FD' THEN; VBA_STAT = TRUE; END IF KEYSTRNG = 'HN' THEN; VBA_STAT = TRUE; END IF KEYSTRNG = 'KP' THEN; VBA_STAT = TRUE; END IF KEYSTRNG = 'LA' THEN; VBA_STAT = TRUE; END IF KEYSTRNG = 'MK' THEN; VBA_STAT = TRUE; END IF KEYSTRNG = 'NL' THEN; VBA_STAT = TRUE; END IF KEYSTRNG = 'OV' THEN; VBA_STAT = TRUE; END IF KEYSTRNG = 'PT' THEN; VBA_STAT = TRUE; END IF KEYSTRNG = 'SC' THEN; VBA_STAT = TRUE; END IF KEYSTRNG = 'Y' THEN; VBA_STAT = TRUE; END IF VBA_STAT = FALSE THEN; VBA_VLBA = FALSE; END END END * Restore adverbs INEXT = VBA_EXT; INVERS = VBA_VERS; PIXXY = VBA_PIX KEYWORD = VBA_KEYW; KEYVALUE = VBA_KEYV; KEYSTRNG = VBA_KEYS RETURN VBA_VLBA FINISH PROCEDURE VBA_SM1 *----------------------------------------------------------------------- * Prints a message informing the user that AIPS is looking for * subarrays. *----------------------------------------------------------------------- PRINT 'THIS DATA MAY CONTAIN MULTIPLE SUBARRAYS. PLEASE BE PATIENT' PRINT 'WHILE AIPS SEARCHES FOR SUBARRAY CONDITIONS. THIS MAY TAKE ' PRINT 'SEVERAL MINUTES. ' FINISH PROCEDURE VLBALOAD *----------------------------------------------------------------------- * Loads VLBA data from a tape. * * Input adverbs: * INTAPE input tape drive number * NFILES number of files to skip * OUTNAME output file name * OUTDISK output disk number * NCOUNT number of files to load from tape * DOUVCOMP compress output data? * CLINT interval between CL table entries *----------------------------------------------------------------------- TPUT VLBALOAD * Set defaults for FITLD adverbs: TASK 'FITLD'; DEFAULT; TGET VLBALOAD; TASK 'FITLD' DOTABLE = TRUE; DOCONCAT = TRUE; SELBAND = 0.0 SELFREQ = 0.0; WTTHRESH = 0.7; NPIECE = 90 RUNWAIT ('FITLD') INNAME = OUTNAME; INCLASS = 'UVDATA'; INSEQ = 0; INDISK = OUTDISK IF (MAXTAB('GC') > 0 ! MAXTAB('TY') > 0) THEN IF(SUBSTR(OUTNAME,1,1) = ' ') THEN; INNAME = 'MULTI'; END IF MAXTAB ('GC') = 1 THEN INEXT = 'GC'; INVERS = 1; NCOUNT = 1; OUTNAME = INNAME OUTCLASS = INCLASS; OUTSEQ = INSEQ; OUTDISK = INDISK OUTVERS = 2; KEYWORD = ''; KEYVALUE = 0, 0; KEYSTRNG = '' RUNWAIT ('TACOP'); EXTDEST INVERS = 2; OUTVERS = 1; APARM = 1, 1, 2, 1, 3, 1 BPARM = 1, 2, 3; CPARM = 0; DPARM = 0 RUNWAIT ('TAMRG'); EXTDEST END IF MAXTAB ('PC') = 1 THEN INEXT = 'PC'; INVERS = 1; NCOUNT = 1; OUTNAME = INNAME OUTCLASS = INCLASS; OUTSEQ = INSEQ; OUTDISK = INDISK OUTVERS = 2; KEYWORD = ''; KEYVALUE = 0, 0; KEYSTRNG = '' RUNWAIT ('TACOP'); EXTDEST INVERS = 2; OUTVERS = 1; APARM = 1, 1, 4, 1, 5, 1, 6, 1 BPARM = 1, 3, 4, 5, 6 CPARM = (0.05 / (24.0 * 60.0 * 60.0)), 0; DPARM = 0 RUNWAIT ('TAMRG'); EXTDEST END IF MAXTAB ('TY') = 1 THEN INEXT = 'TY'; INVERS = 1; NCOUNT = 1; OUTNAME = INNAME OUTCLASS = INCLASS; OUTSEQ = INSEQ; OUTDISK = INDISK OUTVERS = 2; KEYWORD = ' '; KEYVALUE = 0, 0; KEYSTRNG = ' ' RUNWAIT ('TACOP'); EXTDEST INVERS = 2; OUTVERS = 1; APARM = 1, 1, 4, 1, 5, 1, 6, 1 BPARM = 1, 3, 4, 5, 6 CPARM = (0.05 / (24.0 * 60.0 * 60.0)), 0; DPARM = 0 RUNWAIT ('TAMRG'); EXTDEST END TYPE 'your GC, TY and PC tables have been merged' END TYPE 'VLBALOAD has flagged all data with weight below 0.7' TGET VLBALOAD RETURN * FINISH PROCEDURE VLBASUBS *----------------------------------------------------------------------- * Search for subarrays in VLBA data. * * Input adverbs: * INNAME file name * INCLASS file class * INSEQ file sequence number * INDISK disk number * CLINT CL table interval *----------------------------------------------------------------------- SCALAR VBA_MSUB SCALAR VBA_SRT SCALAR VBA_INDX *----------------------------------------------------------------------- TPUT VLBASUBS IF (CLINT = 0) THEN; CLINT = 1; END USERID = 0 IF VBA_NEW = TRUE THEN * If FITLD detects a potential subarray condition then it deletes * both the index and the CL table. This implies that we do not * need to look for subarrays if either table exists. VBA_MSUB = TRUE IF MAXTAB ('CL') > 0 THEN; VBA_MSUB = FALSE; END IF MAXTAB ('NX') > 0 THEN; VBA_MSUB = FALSE; END IF VBA_INDX = FALSE IF MAXTAB ('CL') = 0 THEN; VBA_INDX = TRUE; END IF MAXTAB ('NX') = 0 THEN; VBA_INDX = TRUE; END * Find out if data needs sorting VBA_SRT = TRUE; KEYWORD = 'SORTORD'; KEYVALUE = 0 KEYSTRNG = ''; GETHEAD IF SUBSTR(KEYSTRNG,1,2) = 'TB' THEN; VBA_SRT = FALSE; END * IF VBA_SRT = TRUE THEN * Need to ensure that data are in time order. OUTNAME = INNAME; OUTCLASS = INCLASS; OUTSEQ = INSEQ OUTDISK = INDISK; SORT = 'TB'; PRTLEV = 0 RUNWAIT ('MSORT') END * IF VBA_MSUB = TRUE THEN VBA_SM1 * Now look for subarrays: OPCODE = ' '; TIMERANG = 0; SOURCES = ' '; FREQID = 0; SUBARRAY = 1; INFILE = ' '; RUNWAIT ('USUBA') ELSE PRINT 'THERE ARE NO SUBARRAYS IN THIS DATA.' END IF IF VBA_INDX = TRUE THEN * Rebuild index and calibration tables: CPARM = 0, 0, CLINT, TRUE, TRUE, 0 RUNWAIT ('INDXR') END ELSE PRINT 'THIS DATA HAS BEEN PROCESSED TOO FAR FOR VLBASUBS TO BE' PRINT 'EFFECTIVE.' END RETURN FINISH PROCEDURE VLBAMCAL *----------------------------------------------------------------------- * Merge redundant calibration data. Leave merged data in version 1 * tables. * * Input adverbs: * INNAME file name * INCLASS file class * INSEQ file sequence number * INDISK disk number * BADDISK disks not to be used for scratch files *----------------------------------------------------------------------- TPUT VLBAMCAL USERID = 0 IF VBA_NEW = TRUE THEN IF MAXTAB ('GC') = 1 THEN INEXT = 'GC'; INVERS = 1; NCOUNT = 1; OUTNAME = INNAME OUTCLASS = INCLASS; OUTSEQ = INSEQ; OUTDISK = INDISK OUTVERS = 2; KEYWORD = ' '; KEYVALUE = 0, 0; KEYSTRNG = ' ' RUNWAIT ('TACOP'); EXTDEST INVERS = 2; OUTVERS = 1; APARM = 1, 1, 2, 1, 3, 1 BPARM = 1, 2, 3; CPARM = 0; DPARM = 0 RUNWAIT ('TAMRG'); EXTDEST END IF MAXTAB ('PC') = 1 THEN INEXT = 'PC'; INVERS = 1; NCOUNT = 1; OUTNAME = INNAME OUTCLASS = INCLASS; OUTSEQ = INSEQ; OUTDISK = INDISK OUTVERS = 2; KEYWORD = ' '; KEYVALUE = 0, 0; KEYSTRNG = ' ' RUNWAIT ('TACOP'); EXTDEST INVERS = 2; OUTVERS = 1; APARM = 1,1,4,1,5,1,6,1 BPARM = 1,3,4,5,6; CPARM = (0.05 / (24.0 * 60.0 * 60.0)), 0 DPARM = 0 RUNWAIT ('TAMRG'); EXTDEST END IF MAXTAB ('TY') = 1 THEN INEXT = 'TY'; INVERS = 1; NCOUNT = 1; OUTNAME = INNAME OUTCLASS = INCLASS; OUTSEQ = INSEQ; OUTDISK = INDISK OUTVERS = 2; KEYWORD = ' '; KEYVALUE = 0, 0; KEYSTRNG = ' ' RUNWAIT ('TACOP'); EXTDEST INVERS = 2; OUTVERS = 1; APARM = 1,1,4,1,5,1,6,1 BPARM = 1,3,4,5,6; CPARM = (0.05 / (24.0 * 60.0 * 60.0)), 0 DPARM = 0 RUNWAIT ('TAMRG'); EXTDEST END ELSE PRINT 'THIS DATA HAS BEEN PROCESSED TOO FAR FOR VLBAMCAL TO BE' PRINT 'EFFECTIVE.' END FINISH PROCEDURE VLBAFQS *----------------------------------------------------------------------- * Split frequency IDs into separate files. * * Inputs: * INNAME input file name * INCLASS input file class * INSEQ input file sequence number * INDISK input file disk number * CLINT CL table interval * OUTDISK output disk number *----------------------------------------------------------------------- SCALAR VBA_9050 SCALAR VBA_BFQ SCALAR VBA_FQ SCALAR VBA_I ARRAY VBA_IF1(20) ARRAY VBA_IF2(20) SCALAR VBA_J SCALAR VBA_LOFF SCALAR VBA_NFQI SCALAR VBA_NIF SCALAR VBA_MDIF SCALAR VBA_SX SCALAR VBA_ROW STRING*6 VBA_TCLA SCALAR VBA_TSEQ *----------------------------------------------------------------------- TPUT VLBAFQS IF (CLINT = 0) THEN; CLINT = 1; END * Find out if data needs to be split into seperate frequencies INEXT = 'FQ'; INVERS = 1; KEYWORD = 'NUM ROW' GETTHEAD; VBA_NFQI = KEYVALUE(1) KEYWORD = 'NO_IF'; GETTHEAD; VBA_NIF = KEYVALUE(1) FOR VBA_I=2 TO 7 KEYWORD='CTYPE'!!CHAR(VBA_I); GETHEAD IF(SUBSTR(KEYSTRNG(1),1,4)='FREQ') THEN KEYWORD = 'CRVAL'!!CHAR(VBA_I); GETHEAD; VBA_BFQ = KEYVALUE(1) END END VBA_SX = -1; VBA_9050 = -1 FOR VBA_I = 1 TO VBA_NFQI PIXXY VBA_I, 2, 1; TABGET VBA_FQ=VBA_BFQ+KEYVALUE(1) IF(VBA_FQ < 8.8e9 & VBA_FQ > 8e9) THEN; VBA_SX=VBA_I;END IF(VBA_FQ < 2.4e9 & VBA_FQ > 2.1e9) THEN; VBA_SX=VBA_I;END IF(VBA_FQ < 6.3e8 & VBA_FQ > 5.9e8) THEN; VBA_9050=VBA_I;END IF(VBA_FQ < 3.5e8 & VBA_FQ > 3e8) THEN; VBA_9050=VBA_I;END END FOR VBA_I = 1 TO VBA_NFQI IF(VBA_SX = VBA_I ! VBA_9050 = VBA_I) THEN IF(VBA_SX = VBA_I) THEN; VBA_MDIF = 1E9; END IF(VBA_9050 = VBA_I) THEN; VBA_MDIF = 2E8; END VBA_LOFF=0 FOR VBA_J = 1 TO VBA_NIF PIXXY VBA_I, 2, VBA_J; TABGET IF(KEYVALUE(1)-VBA_LOFF > VBA_MDIF)THEN VBA_IF1(VBA_I)=VBA_J END VBA_IF2(VBA_I)=VBA_J VBA_LOFF = KEYVALUE(1) END IF(VBA_IF2(VBA_I)=0 & VBA_SX=VBA_I)THEN; VBA_SX=-1; END IF(VBA_IF2(VBA_I)=0 & VBA_9050=VBA_I)THEN; VBA_9050=-1; END END END * Split into seperate frequencies (if needed) IF (VBA_NFQI > 1) ! (VBA_SX > 0) ! (VBA_9050 > 0) THEN TASK 'UVCOP'; DEFAULT; TGET VLBAFQS; TASK 'UVCOP' * Set invarient inputs FLAGVER = MAXTAB('FG') UVCOPPRM = 0, 0, 0, 1, 0; OUTNAME = INNAME;TPUT UVCOP * Loop through frequencies FOR VBA_ROW = 1 TO VBA_NFQI TGET VLBAFQS PIXXY = VBA_ROW, 1, 1; INVER = 1; INEXT = 'FQ' TABGET; FREQID = KEYVALUE(1); TPUT UVCOP IF VBA_SX <> FREQID & VBA_9050 <> FREQID THEN TGET UVCOP BIF = 0;EIF = 0; OUTCLASS = 'FQ' !! CHAR(FREQID) PRINT 'COPYING FREQUENCY ID #' !! CHAR(FREQID) RUNWAIT ('UVCOP') ELSE TGET UVCOP BIF=1; EIF=VBA_IF1(FREQID)-1 PRINT 'COPYING FREQUENCY ID #' !! CHAR(FREQID) OUTCLASS = 'FQ' !! CHAR(FREQID) RUNWAIT ('UVCOP') VBA_TCLA = OUTCLASS; VBA_TSEQ = OUTSEQ * Index data TASK 'INDXR'; DEFAULT; TGET VLBAFQS; TASK 'INDXR' INCLASS = VBA_TCLA; INSEQ = VBA_TSEQ; INDISK = OUTDISK CPARM = 0, 0, CLINT, 1, 1, 0 RUNWAIT ('INDXR') TGET 'UVCOP' BIF=VBA_IF1(FREQID); EIF=VBA_IF2(FREQID) PRINT 'COPYING FREQUENCY ID #'!! CHAR(FREQID)!! '.5' OUTCLASS = 'FQ' !! CHAR(FREQID)!! '.5' RUNWAIT ('UVCOP') END * Index data VBA_TCLA = OUTCLASS; VBA_TSEQ = OUTSEQ TASK 'INDXR'; DEFAULT; TGET VLBAFQS; TASK 'INDXR' INCLASS = VBA_TCLA; INSEQ = VBA_TSEQ; INDISK = OUTDISK CPARM = 0, 0, CLINT, 1, 1, 0 RUNWAIT ('INDXR') TGET VLBAFQS END END IF VBA_SRT < 1 & SUBARRAY < 1 & VBA_NSTK <> 1 & VBA_INDX < 1 THEN IF VBA_NFQI < 2 & VBA_SX < 0 & VBA_9050 < 0 THEN TYPE 'YOUR DATA ONLY HAS ONE FREQUENCY' END END TGET VLBAFQS RETURN FINISH PROCEDURE VBA_FPM1 *----------------------------------------------------------------------- * Print a message informing the user that his data set appears to * contain only one polarization. *----------------------------------------------------------------------- PRINT 'THIS DATA SET APPEARS TO CONTAIN ONLY ONE POLARIZATION. YOU DO' PRINT 'NOT NEED TO CHANGE THE POLARIZATION LABELS UNLESS YOU USED AN ' PRINT 'UNUSUAL OBSERVING SET-UP. ' FINISH PROCEDURE VBA_FPM2 *----------------------------------------------------------------------- * Print a message informing the user that he can delete the input * file if FXPOL ran successfully. *----------------------------------------------------------------------- PRINT 'IF FXPOL ENDED SUCCESSFULLY THEN YOU MAY DELETE THE ORIGINAL' PRINT 'DATA FILE NOW. ' FINISH PROCEDURE VBA_FPM3 *----------------------------------------------------------------------- * Print a message informing the user that there is a chance that * FXPOL got things wrong. *----------------------------------------------------------------------- PRINT 'SINCE YOUR DATA SET USED NON-VLBA STATIONS THERE IS A SMALL' PRINT 'CHANCE THAT LCP AND RCP ARE INTERCHANGED IN THE DATA FILE ' PRINT 'CREATED BY FXPOL. CHECK THIS BEFORE DELETING THE ORIGINAL ' PRINT 'FILE. IF THE POLARIZATIONS ARE INTERCHANGED THEN TGET ' PRINT 'FXPOL, CHANGE BANDPOL, AND RUN FXPOL BY HAND. ' FINISH PROCEDURE VBA_FPM4 *----------------------------------------------------------------------- * Print a message informing the user that AIPS can not guess the * correct setting for BANDPOL *----------------------------------------------------------------------- PRINT 'YOUR DATA APPEARS TO HAVE TWO POLARIZATIONS BUT USES AN' PRINT 'UNUSUAL OBSERVING SET-UP. YOU WILL HAVE TO SET BANDPOL ' PRINT 'AND RUN FXPOL BY HAND. ' FINISH PROCEDURE VLBAFPOL *----------------------------------------------------------------------- * Check whether polarization labelling needs to be fixed and either * fix it automatically if it is safe to do so or recommend settings * for FXPOL if not. * * Input adverbs: * INNAME input file name * INCLASS input file class * INSEQ input file sequence number * INDISK input file disk number * OUTDISK output file disk number *----------------------------------------------------------------------- SCALAR VBA_NIFS SCALAR VBA_PAIR SCALAR VBA_FREQ *----------------------------------------------------------------------- TPUT VLBAFPOL USERID = 0 IF VBA_NEW = TRUE THEN IF VBA_NSTK = 1 THEN IF MAXTAB ('FQ') > 0 THEN * Find the number of IFs: INEXT = 'FQ'; INVERS = 1; KEYWORD = 'NO_IF'; GETTHEAD; VBA_NIFS = KEYVALUE(1) * Find the number of IF pairs that have the same frequency: VBA_PAIR = 0 FOR I = 0 TO VBA_NIFS / 2 - 1 USERID = 0; INEXT = 'FQ'; INVERS = 1; PIXXY = 1, 2, 2 * I + 1; TABGET VBA_FREQ = KEYVALUE(1); PIXXY = 1, 2, 2 * I + 2; TABGET IF KEYVALUE(1) = VBA_FREQ THEN VBA_PAIR = VBA_PAIR + 1 END END IF VBA_PAIR = 0 THEN VBA_FPM1 ELSE IF 2 * VBA_PAIR = VBA_NIFS THEN * Guess BANDPOL IF VBA_STK1 = -1 THEN BANDPOL = '*(RL)' ELSE BANDPOL = '*(LR)' END * Set up for FXPOL: OUTNAME = INNAME; OUTCLASS = 'FXPOL' IF(SUBSTR(INCLASS,1,3) = 'FQ-') THEN OUTCLASS='FPOL'!! SUBSTR(INCLASS,4,5) END OUTSEQ = 0; FQTOL = -1.0 RUNWAIT ('FXPOL') IF VBA_ONLY = TRUE THEN VBA_FPM2 ELSE * Some foreign stations present so BANDPOL might be wrong: VBA_FPM3 END ELSE VBA_FPM4 END END ELSE PRINT 'THIS DATA SET IS CORRUPT. THERE IS NO FREQUENCY (FQ)' PRINT 'TABLE.' END ELSE PRINT 'POLARIZATION LABELLING IS ALREADY CORRECT FOR THIS' PRINT 'DATA SET.' END ELSE PRINT 'THIS DATA HAS BEEN PROCESSED TOO FAR FOR VLBAFPOL TO BE' PRINT 'EFFECTIVE.' END RETURN FINISH PROCEDURE VLBAFIX *----------------------------------------------------------------------- * Search for subarrays in VLBA data. * * Input adverbs: * INNAME file name * INCLASS file class * INSEQ file sequence number * INDISK disk number * OUTDISK output disk number * CLINT CL table interval * SUBARRAY is there a subarray *----------------------------------------------------------------------- SCALAR VBA_9050 SCALAR VBA_BFQ SCALAR VBA_FQ ARRAY VBA_IF1(20) ARRAY VBA_IF2(20) SCALAR VBA_INDX SCALAR VBA_I SCALAR VBA_J SCALAR VBA_LOFF SCALAR VBA_MDIF SCALAR VBA_NFQI SCALAR VBA_ROWS SCALAR VBA_SRT SCALAR VBA_SX STRING*6 VBA_TCLA SCALAR VBA_TSEQ *----------------------------------------------------------------------- VNUM = 35; VPUT VLBAFIX IF (CLINT = 0) THEN; CLINT = 1; END TPUT VLBAFIX FOR VBA_I=1 TO 20 VBA_IF1(VBA_I)=0 VBA_IF2(VBA_I)=0 END IF VBA_NEW = TRUE THEN * Find out if data needs sorting VBA_SRT = TRUE; KEYWORD = 'SORTORD'; KEYVALUE = 0 KEYSTRNG = ''; GETHEAD IF SUBSTR(KEYSTRNG,1,2) = 'TB' THEN VBA_SRT = FALSE END * Find out if data needs to be split into seperate frequencies INEXT = 'FQ'; INVERS = 1; KEYWORD = 'NUM ROW' GETTHEAD; VBA_NFQI = KEYVALUE(1) KEYWORD = 'NO_IF'; GETTHEAD; VBA_NIF = KEYVALUE(1) FOR VBA_I=2 TO 7 KEYWORD='CTYPE'!!CHAR(VBA_I); GETHEAD IF(SUBSTR(KEYSTRNG(1),1,4)='FREQ') THEN KEYWORD = 'CRVAL'!!CHAR(VBA_I); GETHEAD; VBA_BFQ = KEYVALUE(1) END END VBA_SX = -1; VBA_9050 = -1 FOR VBA_I = 1 TO VBA_NFQI PIXXY VBA_I, 2, 1; TABGET VBA_FQ=VBA_BFQ+KEYVALUE(1) IF(VBA_FQ < 8.8e9 & VBA_FQ > 8e9) THEN; VBA_SX=VBA_I;END IF(VBA_FQ < 2.4e9 & VBA_FQ > 2.1e9) THEN; VBA_SX=VBA_I;END IF(VBA_FQ < 6.3e8 & VBA_FQ > 5.9e8) THEN; VBA_9050=VBA_I;END IF(VBA_FQ < 3.5e8 & VBA_FQ > 3e8) THEN; VBA_9050=VBA_I;END END FOR VBA_I = 1 TO VBA_NFQI IF(VBA_SX = VBA_I ! VBA_9050 = VBA_I) THEN IF(VBA_SX = VBA_I) THEN; VBA_MDIF = 1E9; END IF(VBA_9050 = VBA_I) THEN; VBA_MDIF = 2E8; END VBA_LOFF=0 FOR VBA_J = 1 TO VBA_NIF PIXXY VBA_I, 2, VBA_J; TABGET IF(KEYVALUE(1)-VBA_LOFF > VBA_MDIF & VBA_J > 1)THEN VBA_IF1(VBA_I)=VBA_J END VBA_IF2(VBA_I)=VBA_J VBA_LOFF = KEYVALUE(1) END IF(VBA_IF1(VBA_I)=0 & VBA_SX=VBA_I)THEN; VBA_SX=-1; END IF(VBA_IF1(VBA_I)=0 & VBA_9050=VBA_I)THEN; VBA_9050=-1; END END END * Find out if data needs indexing VBA_INDX = FALSE IF MAXTAB ('CL') = 0 THEN; VBA_INDX = TRUE; END IF MAXTAB ('NX') = 0 THEN; VBA_INDX = TRUE; END * Sort data (if needed) IF VBA_SRT = TRUE THEN TASK 'MSORT'; DEFAULT; TGET VLBAFIX; TASK 'MSORT' OUTNAME = INNAME; OUTCLASS = INCLASS; OUTSEQ = INSEQ OUTDISK = INDISK; SORT = 'TB' RUNWAIT ('MSORT') END * Correct for subarrys (if needed) IF SUBARRAY > 0 THEN VBA_SM1 TASK 'USUBA'; DEFAULT; TGET VLBAFIX; TASK 'USUBA' FREQID = 0; SUBARRAY = 1 RUNWAIT ('USUBA') END * Split into seperate frequencies (if needed) IF (VBA_NFQI > 1) ! (VBA_SX > 0) ! (VBA_9050 > 0) THEN TASK 'UVCOP'; DEFAULT; TGET VLBAFIX; TASK 'UVCOP' * Set invarient inputs FLAGVER = MAXTAB('FG') UVCOPPRM = 0, 0, 0, 1, 0; OUTNAME = INNAME;TPUT UVCOP * Loop through frequencies FOR VBA_ROWS = 1 TO VBA_NFQI TGET VLBAFIX PIXXY = VBA_ROWS, 1, 1; INVER = 1; INEXT = 'FQ' TABGET; FREQID = KEYVALUE(1); TPUT UVCOP IF VBA_SX <> FREQID & VBA_9050 <> FREQID THEN TGET UVCOP BIF = 0;EIF = 0; OUTCLASS = 'FQ-' !! CHAR(FREQID) PRINT 'COPYING FREQUENCY ID #' !! CHAR(FREQID) RUNWAIT ('UVCOP') ELSE TGET UVCOP BIF=1; EIF=VBA_IF1(FREQID)-1 PRINT 'COPYING FREQUENCY ID #' !! CHAR(FREQID) OUTCLASS = 'FQ-' !! CHAR(FREQID) RUNWAIT ('UVCOP') VBA_TCLA = OUTCLASS; VBA_TSEQ = OUTSEQ * Index data TASK 'INDXR'; DEFAULT; TGET VLBAFIX; TASK 'INDXR' INCLASS = VBA_TCLA; INSEQ = VBA_TSEQ; INDISK = OUTDISK CPARM = 0, 0, CLINT, 1, 1, 0 RUNWAIT ('INDXR') * run VLBAFPOL IF VBA_NSTK = 1 THEN; VLBAFPOL; END TGET 'UVCOP' BIF=VBA_IF1(FREQID); EIF=VBA_IF2(FREQID) PRINT 'COPYING FREQUENCY ID #'!! CHAR(VBA_NFQI+1) OUTCLASS = 'FQ-' !! CHAR(VBA_NFQI+1) RUNWAIT ('UVCOP') END * Index data VBA_TCLA = OUTCLASS; VBA_TSEQ = OUTSEQ TASK 'INDXR'; DEFAULT; TGET VLBAFIX; TASK 'INDXR' INCLASS = VBA_TCLA; INSEQ = VBA_TSEQ; INDISK = OUTDISK CPARM = 0, 0, CLINT, 1, 1, 0 RUNWAIT ('INDXR') TGET VLBAFIX INCLASS = VBA_TCLA; INSEQ = VBA_TSEQ * run VLBAFPOL IF VBA_NSTK = 1 THEN; VLBAFPOL; END END ELSE IF VBA_NSTK = 1 THEN; VLBAFPOL; END END IF VBA_SX > 0 ! VBA_9050 > 0 THEN; VBA_NFQI=VBA_NFQI+1; END IF VBA_SRT > 0 THEN TYPE 'YOUR DATA HAS BEEN SORTED' END IF SUBARRAY > 0 THEN TYPE 'YOUR DATA HAS BEEN CORRECTED FOR SUBARRAYS' END IF VBA_NFQI > 1 ! VBA_SX > 0 ! VBA_9050 > 0 THEN TYPE 'YOUR DATA HAS BEEN SPLIT INTO SEPARATE FREQUENCY FILES' TYPE 'AND INDEXED' END IF VBA_INDX > 0 & VBA_NFQI < 2 & VBA_SX < 0 & VBA_9050 < 0 THEN TYPE 'YOUR DATA HAS BEEN INDEXED' END IF VBA_SRT < 1 & SUBARRAY < 1 & VBA_NSTK <> 1 & VBA_INDX < 1 THEN IF VBA_NFQI < 2 & VBA_SX < 0 & VBA_9050 < 0 THEN TYPE 'YOUR DATA DID NOT NEED FIXING' END END ELSE PRINT 'THIS DATA HAS BEEN PROCESSED TOO FAR FOR VLBAFIX TO BE' PRINT 'EFFECTIVE.' END VNUM = 35; VGET VLBAFIX; TPUT VLBAFIX RETURN FINISH PROCEDURE VLBACALA *----------------------------------------------------------------------- * Applies a-priori amplitude corrections and digital sampling * corrections. * * Inputs: * INNAME input file name * INCLASS input file class * INSEQ input file sequence number * INDISK input file disk number * FREQID frequency ID * SUBARRAY subarray number * REFANT reference antenna number * BADDISK bad disk array *----------------------------------------------------------------------- SCALAR VBA_SN SCALAR VBA_SU *----------------------------------------------------------------------- TPUT VLBACALA * Run ACCOR to determine sampling corrections TIMERANG = 0, 0, 0, 0, 0, 0, 0, 0; SOLINT = 2.0; RUNWAIT ('ACCOR') * Run SNSMO to clip bad points SOURCES = ' '; SELBAND = -1; SELFREQ = -1; BIF = 0; EIF = 0 ANTENNAS = 0; INTERPOL = 'MWF'; BPARM = 0; DOBLANK = TRUE SMOTYPE = 'AMPL'; CPARM = 0.5, 0, 0, 0, 0, 0.02; REFANT 0 INVERS = MAXTAB('SN'); OUTVERS = INVERS + 1 RUNWAIT ('SNSMO') * Replace original table with smoothed table INEXT = 'SN'; EXTDEST VBA_SN = INVERS; INVERS = OUTVERS; OUTVERS = VBA_SN; OUTNAME = INNAME OUTCLASS = INCLASS; OUTSEQ = INSEQ; OUTDISK = INDISK; KEYWORD = ' ' KEYVALUE = 0; KEYSTRNG = ' ' RUNWAIT ('TACOP') EXTDEST * Apply corrections to CL table SOUCODE = ' '; CALSOUR = ' '; QUAL = -1; CALCODE = ' '; OPCODE = 'CALI' INTERPOL = ' '; INTPARM = 0; CUTOFF = 0; SMOTYPE = ' '; SNVER = OUTVERS GAINVER = MAXTAB('CL'); GAINUSE = GAINVER + 1 RUNWAIT ('CLCAL') * Determine a-priori amplitude corrections STOKES = ' '; TYVER = MAXTAB('TY'); GCVER = MAXTAB('GC') SNVER = MAXTAB('SN') + 1; OPCODE = ' '; APARM = 0; SOLINT = 0 INFILE = ' '; TREC = 0; TAU0 = 0; DOFIT = 0; PRTLEV = 0 DOTV = FALSE; LTYPE = 0 RUNWAIT ('APCAL') * Apply corrections to CL table SOUCODE = ' '; CALSOUR = ' '; QUAL = -1; CALCODE = ' ' OPCODE = 'CALI'; INTERPOL = 'SELF'; INTPARM = 0; CUTOFF = 0 SMOTYPE = ' '; SNVER = MAXTAB('SN'); GAINVER = MAXTAB('CL') GAINUSE = GAINVER + 1 RUNWAIT ('CLCAL') * Summarize new tables VBA_SN = MAXTAB('SN') PRINT 'SN #' !! CHAR(VBA_SN - 1) !! ' CONTAINS SAMPLER CORRECTIONS' PRINT 'SN #' !! CHAR(VBA_SN) !! ' CONTAINS GAIN CORRECTIONS' PRINT 'CL #' !! CHAR(GAINVER) !! ' ADDS SAMPLER CORRECTIONS' PRINT 'CL #' !! CHAR(GAINUSE) !! ' ADDS GAIN CORRECTIONS' PRINT 'YOU SHOULD VERIFY THAT THESE TABLES CONTAIN NO BAD POINTS' PRINT 'BEFORE CONTINUING' RETURN FINISH PROCEDURE VLBAPANG *----------------------------------------------------------------------- * Corrects phases for parallactic angle effects. * * Inputs: * INNAME input file name * INCLASS input file class * INSEQ input file sequence number * INDISK input file disk number * SUBARRAY subarray number * BADDISK list of bad disks *----------------------------------------------------------------------- TPUT VLBAPANG * Copy the last CL table INEXT = 'CL'; INVERS = MAXTAB('CL'); NCOUNT = 1; OUTNAME = INNAME OUTCLASS = INCLASS; OUTSEQ = INSEQ; OUTDISK = INDISK OUTVERS = INVERS + 1; KEYWORD = ' '; KEYVALUE = 0; KEYSTRNG = ' ' RUNWAIT('TACOP') * Make the correction: SOURCES = ' '; STOKES = ' '; SELBAND = -1; SELFREQ = -1 FREQID = 1; BIF = 0; EIF = 0; TIMERANG = 0; ANTENNAS = 0 GAINVER = OUTVERS; OPCODE = 'PANG'; CLCORPRM = +1, 0 RUNWAIT('CLCOR') PRINT 'CL #' !! CHAR(GAINVER) !! ' ADDS PARALLACTIC ANGLE CORRECTIONS' RETURN FINISH * PROC VLBAPCOR *-------------------------------------------------------------------- * Solves for intrumental phase corrections using PCOR and, * if requested, FRING and then applies then using CLAL * * Input adverbs: * INNAME file name * INCLASS file class * INSEQ file sequence number * INDISK disk number * TIMERANG time range * REFANT reference antenna * CALSOUR calibrator source * GAINUSE CL table to use * OPCODE OPCODE in CLCAL * ANTENNAS antennas for which manual phase corrections * should be obtained. *-------------------------------------------------------------------- scalar vba_ok scalar vba_tim scalar vba_frg scalar vba_sn scalar vba_cl scalar vba_lant vnum=35 vput vlbapcor if(gainu=0)then; gainu=MAXTAB('cl');end if(refant=0)then; refant=1;end tput vlbapcor vba_ok=1 vba_tim=-1 vba_frg=-1 vba_lant=0 $tget 'pccor';vput 'PCCOR';tget 'clcal'; vput 'clcal' $tget fring; vput fring; tget sncor; vput 'sncor' tget vlbapcor for i=1 to 8 if timer(i)<>0 then vba_tim=1 end end if vba_tim < 0 then type 'TIMRANGE HAS NO DEFAULT' type 'SET TIMERANGE to a calibrator scan AND RUN AGAIN' vba_ok=-1 end tget vlbapcor if(opcode='calp')&(ante(1)<>0)then; vba_frg=1;end if(vba_frg<0)&(ante(1)<>0)then vba_ok=-1 type 'Antennas is only set if antennas are missing from PC table' type 'if this is the case set OPCODE=CALP, if not ANTE=0' end if(vba_frg>0)then for i=1 to 50 if(ante(i)<>0)then; vba_lant=i; end end end if vba_ok >=0 then type 'run pccor' task='pccor'; default; tget vlbapcor;task='pccor' delcorr 0; runwait('pccor') if(vba_frg>0)then type 'run sncor' task 'sncor';default; tget vlbapcor;task 'sncor' snver=MAXTAB('SN');opcode 'zphs';timer 0; sour '' runwait('sncor'); opcode 'zdel';runwait('sncor') end type 'RUN CLCAL' task 'clcal';default; tget vlbapcor;task 'clcal' gainv gainu; gainu=MAXTAB('cl')+1; snver=MAXTAB('SN') calsour '';timer 0; ante 0;runwait('clcal') vba_sn=snver vba_cl=gainu end if(vba_frg>0)&(vba_ok>0)then type 'run fring' task 'fring'; default; tget vlbapcor; task 'fring' gainu vba_cl;docal 2;dparm(8) 1;ante(vba_lant+1) refant aparm(1) 2;dparm(1) 1 runwait('fring') type 'run clcal' task 'clcal';default; tget vlbapcor;task 'clcal' gainv gainu; gainu=vba_cl; snver=MAXTAB('SN') calsour '';opcode 'cali'; timer 0; runwait('clcal') end if(vba_ok>0)then if(vba_frg>0)then type 'if there is a message about failed solutions in FRING' type 'find a better calibrator scan and run again' end type 'SN #'!!char(vba_sn)!!' contains pcal instr. phase corrections' if(vba_frg>0)then type 'SN #'!!char(snver)!!' contains manual instr. phase corrections' end type 'CL #'!!char(vba_cl)!!' adds instr. phase corrections' end vnum=35 $vget 'pccor';tput 'pccor'; vget 'clcal';tput 'clcal' $vget fring; tput 'fring'; vget 'sncor'; tput sncor vget vlbapcor; tput vlbapcor vnum 0 return; finish * PROC VLBAFRNG *------------------------------------------------------------------- * procedure fringe fit a dataset using FRING and then apply * the corrections using CLCAL. * * Input adverbs: * INNAME file name * INCLASS file class * INSEQ file sequence number * INDISK disk number * CALSOUR calibrator source * TIMERANG time range * BCHAN lowest channel * ECHAN highest channel * GAINUSE CL table to use * REFANT reference antenna * SEARCH prioritized reference antenna list * SOLINT solution interval * DPARM FRING DPARMS * SOURCES sources to calibrate in CLCAL * INTERPOL interpolation method to use * BADDISK bad disk *-------------------------------------------------------------------- scalar vba_ok scalar vba_cl scalar vba_nms vba_nms=0 vba_ok=1 vnum=35 vput vlbafrng if(gainu=0)then; gainu=maxtab('cl');end tput vlbafrng $tget fring;vput 'FRING'; tget clcal;vput 'clcal' tget vlbafrng for i=1 to 30 if (sour(i)<>'') then vba_nms=vba_nms+1 end end IF vba_ok >=0 then type 'run fring' task='fring'; default; tget vlbafrng;task='fring' if(search(1)<>0)then aparm(9)=1; end $ aparm(6)=1 docal 2; runwait('fring') type 'RUN CLCAL' task 'clcal';default; tget vlbafrng;task 'clcal' vba_cl=maxtab('cl')+1 if interpol = 'self' ! sour(1)='' then gainv gainu; gainu=vba_cl; snver=maxtab('SN') runwait('clcal') else for i=1 to vba_nms tget vlbafrng task 'clcal';gainv gainu; gainu vba_cl sour = sour(i),''; calsour = sour(i), '';snver=maxtab('SN') runwait('clcal') end end type 'SN #'!!char(snver)!!' contains fringe solns for sources in calsour' type 'CL #'!!char(vba_cl)!!' adds fringe solns for sources in sources' vnum=35 vget vlbafrng; tput vlbafrng $vget 'fring';tput fring; vget 'clcal';tput clcal vnum 0 tget vlbafrng END return; finish * PROC VLBAKRNG *------------------------------------------------------------------- * procedure fringe fit a dataset using KRING and then apply * the corrections using CLCAL. * * Input adverbs: * INNAME file name * INCLASS file class * INSEQ file sequence number * INDISK disk number * CALSOUR calibrator source * TIMERANG time range * BCHAN lowest channel * ECHAN highest channel * GAINUSE CL table to use * REFANT reference antenna * SEARCH prioritized reference antenna list * SOLINT solution interval * OPCODE OPCODE in KRING * CPARM FRING CPARMS * SOURCES sources to calibrate in CLCAL * INTERPOL interpolation method to use * BADDISK bad disk *-------------------------------------------------------------------- scalar vba_ok scalar vba_nums scalar vba_cl vba_ok=1 vba_nms=0 vnum=35 vput vlbakrng if(gainu=0)then; gainu=maxtab('cl');end tput vlbakrng $tget kring;vput 'kring'; tget clcal;vput 'clcal' tget vlbakrng for i=1 to 30 if (sour(i)<>'') then vba_nms=vba_nms+1 end end IF vba_ok >=0 then type 'run kring' task='kring'; default; tget vlbakrng;task='kring' $ prtlev 2 docal 2; runwait('kring') type 'RUN CLCAL' task 'clcal';default; tget vlbakrng;task 'clcal' vba_cl=maxtab('cl')+1 if interpol = 'self' ! sour(1)='' then gainv gainu; gainu=vba_cl; snver=maxtab('SN') runwait('clcal') else for i=1 to vba_nms tget vlbakrng;task 'clcal';gainv gainu; gainu vba_cl sour = sour(i),''; calsour = sour(i), ''; snver=maxtab('SN') runwait('clcal') end end type 'SN #'!!char(snver)!!' contains fringe solns for sources in calsour' type 'CL #'!!char(vba_cl)!!' adds fringe solns for sources in sources' vnum=35 vget vlbakrng;tput vlbakrng $vget 'kring';tput kring; vget 'clcal';tput clcal vnum 0 tget vlbakrng END return; finish * PROC VLBAFRGP *------------------------------------------------------------------- * procedure fringe fit a dataset using FRING and then apply * the corrections using CLCAL for phase reference data sets. * * Input adverbs: * INNAME file name * INCLASS file class * INSEQ file sequence number * INDISK disk number * CALSOUR calibrator source * TIMERANG time range * BCHAN lowest channel * ECHAN highest channel * GAINUSE CL table to use * REFANT reference antenna * SEARCH prioritized reference antenna list * SOLINT solution interval * DPARM FRING DPARMS * SOURCES sources to calibrate in CLCAL, any sources in * source that are not in the CALSOUR list will * be phase referenced to the first source in the * CALSOUR list. * INTERPOL interpolation method to use * BADDISK bad disk *-------------------------------------------------------------------- scalar vba_ok scalar vba_nms scalar vba_nmc scalar vba_cl array vba_sc(30) vba_ok=1 vba_nms=0 vba_nmc=0 vnum=35 vput vlbafrgp if(gainu=0)then; gainu=maxtab('cl');end tput vlbafrgp $tget fring;vput 'fring'; tget clcal;vput 'clcal' tget vlbafrgp if(opcode='self')then vba_ok=-1 type 'OPCODE=SELF is not allowed in this procedure' type 'reset opcode and run again' end if(calsour(1)='')then vba_ok=-1 type 'There is no default CALSOUR' type 'set calsour and run again' end for i=1 to 30 if (substr(sour(i),1,1)='-')then vba_ok=-1 type 'Sorry, -sources cannot be used in this procedure' type 'reset sources and run again' end if (substr(calsour(i),1,1)='-')then vba_ok=-1 type 'Sorry, -calsour cannot be used in this procedure' type 'reset calsour and run again' end if (sour(i)<>'') then vba_nms=vba_nms+1 end if (calsour(i)<>'') then vba_nmc=vba_nmc+1 end vba_sc(i)=-1 end IF vba_ok >=0 then for i=1 to vba_nms for j=1 to vba_nmc if(sour(i)=calsour(j))then vba_sc(i)=1;end end end type 'run fring' task='fring'; default; tget vlbafrgp;task='fring' if(search(1)<>0)then aparm(9)=1; end $ aparm(6)=1 docal 2; runwait('fring') type 'RUN CLCAL' task 'clcal';default; tget vlbafrgp;task 'clcal' if sour(1)='' then gainv gainu; gainu=maxtab('cl')+1; snver=maxtab('SN') calsour=calsour(1),'' type 'all sources referenced to calsour= '!!calsour(1) runwait('clcal') else vba_cl=maxtab('cl')+1 for i=1 to vba_nms tget vlbafrgp;task 'clcal' gainv gainu; gainu vba_cl;snver=maxtab('SN') if(vba_sc(i)>0) then sour = sour(i),''; calsour = sour else sour = sour(i),''; calsour = calsour(1),'' end runwait('clcal') type sour(1)!!' referenced to calsour='!!calsour(1) end end type 'SN #'!!char(snver)!!' contains fringe solns for sources in calsour' type 'CL #'!!char(vba_cl)!!' adds fringe solns for sources in sources' vnum=35 vget vlbafrgp;tput vlbafrgp $vget 'fring';tput fring; vget 'clcal';tput clcal vnum 0 tget vlbafrgp END return; finish * PROC VLBAKRGP *------------------------------------------------------------------- * procedure fringe fit a dataset using KRING and then apply * the corrections using CLCAL for phase referencing. * * Input adverbs: * INNAME file name * INCLASS file class * INSEQ file sequence number * INDISK disk number * CALSOUR calibrator source * TIMERANG time range * BCHAN lowest channel * ECHAN highest channel * GAINUSE CL table to use * REFANT reference antenna * SEARCH prioritized reference antenna list * SOLINT solution interval * OPCODE OPCODE in KRING * CPARM FRING CPARMS * SOURCES sources to calibrate in CLCAL * source that are not in the CALSOUR list will * be phase referenced to the first source in the * CALSOUR list. * INTERPOL interpolation method to use * BADDISK bad disk *-------------------------------------------------------------------- scalar vba_ok scalar vba_nms scalar vba_nmc scalar vba_cl array vba_sr(30) vba_ok=1 vba_nms=0 vba_nmc=0 vnum=35 vput vlbakrgp if(gainu=0)then; gainu=maxtab('cl');end tput vlbakrgp $tget kring;vput 'kring'; tget clcal;vput 'clcal' tget vlbakrgp if(calsour(1)='')then vba_ok=-1 type 'There is no default CALSOUR' type 'set calsour and run again' end if(opcode='self')then vba_ok=-1 type 'OPCODE=SELF is not allowed in this procedure' type 'reset opcode and run again' end for i=1 to 30 if (substr(sour(i),1,1)='-')then vba_ok=-1 type 'Sorry, -sources cannot be used in this procedure' type 'reset sources and run again' end if (substr(calsour(i),1,1)='-')then vba_ok=-1 type 'Sorry, -calsour cannot be used in this procedure' type 'reset calsour and run again' end if (sour(i)<>'') then vba_nms=vba_nms+1 end if (calsour(i)<>'') then vba_nmc=vba_nmc+1 end vba_sr(i)=-1 end IF vba_ok >=0 then for i=1 to vba_nms for j=1 to vba_nmc if(sour(i)=calsour(j))then vba_sr(i)=1;end end end type 'run kring' task='kring'; default; tget vlbakrgp;task='kring' $ prtlev 2 docal 2; runwait('kring') type 'RUN CLCAL' task 'clcal';default; tget vlbakrgp;task 'clcal' if sour(1)='' then gainv gainu; gainu=maxtab('cl')+1; snver=maxtab('SN') calsour=calsour(1),'' runwait('clcal') type 'all sources referenced to calsour='!!calsour(1) else vba_cl=maxtab('cl')+1 for i=1 to vba_nms tget vlbakrgp;task 'clcal' gainv gainu; gainu vba_cl;snver=maxtab('SN') if(vba_sr(i)>0) then sour = sour(i),''; calsour = sour else sour = sour(i),''; calsour = calsour(1),'' end runwait('clcal') type sour(1)!!' referenced to calsour='!!calsour(1) end end type 'SN #'!!char(snver)!!' contains fringe solns for sources in calsour' type 'CL #'!!char(vba_cl)!!' adds fringe solns for sources in sources' vnum=35 vget vlbakrgp;tput vlbakrgp $vget 'kring';tput kring; vget 'clcal';tput clcal vnum 0 tget vlbakrgp END return; finish * PROC VLBACPOL *----------------------------------------------------------------------- * Corrects phases for parallactic angle effects. * * Inputs: * INNAME input file name * INCLASS input file class * INSEQ input file sequence number * INDISK input file disk number * OUTDISK disk for temporary files * GAINUSE CL table to apply * SUBARRAY subarray number * BASELINE list of antennas * REFANT reference antenna * CALSOUR calibrator source * TIMERANGE time range to plot * SOLINT solution interval * DPARM FRING control paramenters * OPCODE OPCODE in POLSN * BADDISK disk not to use for scratch files * *----------------------------------------------------------------------- scalar vlb_slot scalar vlb_ant scalar vlb_ok scalar vlb_low scalar vlb_hi scalar vlb_ref scalar vlb_tim vlb_slot=0 vlb_ok=1 vlb_low=1 vlb_hi=1 vlb_ref=-1 vlb_tim=-1 vnum=35 vput vlbacpol if outdi=0 then outd=ind; end; tput vlbacpol $tget uvcop;vput 'uvcop';tget fring; vput 'fring'; tget clcal $vput 'clcal';tget indxr; vput 'indxr';tget polsn; vput 'polsn' $tget swpol; vput 'swpol'; tget tacop; vput 'tacop' tget vlbacpol inext 'cl'; inver 0; keyw 'NO_ANT'; getth; vlb_ant=keyval(1) if gainuse=0 then type 'GAINUSE HAS NO DEFAULT' type 'SET GAINUSE AND RUN AGAIN' vlb_ok=-1 end if (refant=0) then type 'REFANT MUST BE EITHER LOWEST OR HIGHEST ANNTENNA #' type 'SELECT A REFANT AND RUN AGAIN' vlb_ok=-1 end if ((basel(1)=0) & (refant <> 1) & (refant <> vlb_ant)) then type 'REFANT MUST BE EITHER LOWEST OR HIGHEST ANNTENNA #' type 'RESET REFANT AND RUN AGAIN' vlb_ok=-1 end for i=1 to vlb_ant; if(baseline(i) <> 0) & (refant > baseline(i)) then vlb_low=-1 end if(basel(i) <> 0) & (refant < basel(i))then vlb_hi=-1 end if(basel(i)<>0) & (basel(1)<>0) & (refant = basel(i)) then vlb_ref=1 end end if(vlb_low < 0) & (vlb_hi < 0) then type 'REFANT MUST BE EITHER LOWEST OR HIGHEST ANNTENNA #' type 'RESET REFANT AND RUN AGAIN' vlb_ok=-1 end if(vlb_ref < 0) & (refant <> 0) & (basel(1) <> 0) then type 'REFANT MUST BE PART OF BASELINE LIST' type 'RESET BASELINE AND RUN AGAIN' vlb_ok=-1 end for i=1 to 8 if(timer(i)<>0)then vlb_tim=1 end end if(vlb_tim<0)then vlb_ok=-1 type 'timerange has no default' type 'pick a time range that has strong SNR for RL and LR fringes' end IF vlb_ok >=0 then type 'MAKE COPY OF SELECTED DATA' task='UVCOP'; default; tget vlbacpol;task='uvcop' outn='CROSSPOL TMP'; outc='UVCOP'; outs=666 runwait('uvcop') task 'INDXR';default; tget vlbacpol; task='indxr' inna='CROSSPOL TMP'; inc='UVCOP'; ins=666; indi=outd; runwait('indxr') inex 'SN'; inver=-1;extd type 'FRINGE FIT FOR PARALLEL HAND DATA' task='FRING';default; tget vlbacpol; task='fring' inna='CROSSPOL TMP'; inc='UVCOP'; ins=666; indi=outd aparm=2,0; docal=2; snver=1 runwait('fring') type 'CALIBRATE PARALLEL POLARIZATION' task='CLCAL'; default; tget vlbacpol; task='clcal' inna='CROSSPOL TMP'; inc='UVCOP'; ins=666; indi=outd gainv gainu; gainu=maxtab('cl')+1 ;snver=1 opcode='CALI'; sourc calsour runwait('clcal') vlb_slot=gainu type 'SWAP R AND L FOR REFERENCE ANTENNA' task='SWPOL';default; tget vlbacpol; task='swpol' inna='CROSSPOL TMP'; inc='UVCOP'; ins=666; indi=outd outn='CROSSPOL TMP'; outc='SWPOL'; outs=666; ante = refant, 0; gainu=vlb_slot; docalib=2 runwait('swpol') task 'INDXR'; default; tget vlbacpol; task='indxr' inn='CROSSPOL TMP'; inc='SWPOL'; ins=666; ind=outd runwait('indxr') inex 'SN'; inver=-1;extd type 'FRINGE FITS FOR CROSS HAND DATA' task='FRING'; default; tget vlbacpol; task='fring' inn='CROSSPOL TMP'; inc='SWPOL'; ins=666; ind=outd aparm=2,0; gainu=vlb_slot; docal=2; snver=1 if(baseline(1)=0)then for i=1 to vlb_ant if(i<>refant)then ante = refant, i type 'FIT FOR BASELINE',refant,basel(i) runwait('fring') end end else for i=1:30; if (basel(i)<>refant) & (basel(i) <> 0) then ante = refant, basel(i) type 'FIT FOR BASELINE',refant,basel(i) runwait('fring') end end end type 'PROCESS SOLUTIONS' task='POLSN'; default; tget vlbacpol; task='polsn' inn='CROSSPOL TMP'; inc='SWPOL'; ins=666; ind=outd inver=1; outver=2 runwait('polsn') type 'COPY SN TABLE TO ORIGINAL UV DATA' task='TACOP'; default; tget vlbacpol; task='tacop' in2d=outd;outna=inn; outc=inc; outd=ind; outs=ins inn='CROSSPOL TMP'; inc='SWPOL'; ins=666; ind=in2d inex 'SN'; inver =2; ncount=1 runwait('tacop') type 'RUN CLCAL' task 'clcal';default; tget vlbacpol;task 'clcal' snver=maxtab('sn'); gainv gainu; gainu=maxtab('cl')+1 opcode 'cali';timer 0; cals '';sour '' runwait('clcal') type 'DESTROY TEMPORARY FILES' inty ='UV'; inn='CROSSPOL TMP'; ind=outd; ins=666 inclass='UVCOP'; zap inclass='SWPOL'; zap type 'SN #' !! char(snver) !!' contains cross pol. delay corrections' type 'CL #'!!char(gainu)!!' adds cross pol. delay corrections' vnum=35 $vget 'uvcop';tput uvcop; vget 'fring'; tput fring; vget 'clcal' $tput clcal; vget 'indxr';tput indxr; vget 'polsn'; tput polsn $vget 'swpol'; tput swpol; vget 'tacop'; tput tacop vget vlbacpol;tput vlbacpol;tget vlbacpol vnum 0 END return; finish * PROC VLBACRPL *----------------------------------------------------------------------- * Plots cross-correlation spectrum. * * Inputs: * INNAME input file name * INCLASS input file class * INSEQ input file sequence number * INDISK input file disk number * SOURCES sources to plot * TIMERANGE time range to plot * SUBARRAY subarray number * REFANT all baselines to this antenna are plotted * STOKES stokes to plot * GAINUSE CL table to apply * *----------------------------------------------------------------------- scalar vlb_ok tput vlbacrpl tvinit task 'possm'; default; tget vlbacrpl; task 'possm' if(gainu=0)then; gainu=MAXTAB('cl');end if(refant=0)then; refant=1;end if(gainu<0)then; docal -1;end if(gainu>0)then; docal 2;end if(stokes='')then; stokes='I';end inext 'cl';invers 1; keyw 'NO_ANT'; getth; nplot=keyval(1) if(nplot>9)then; nplot=9;end baseline = refant, 0; aparm 0, 1, 0, 0, -180, 180, 0, 0, 1 runwait('possm') tget vlbacrpl return; finish * PROC VLBASNPL *----------------------------------------------------------------------- * Plots an AN or CL table versus time * * Inputs: * INNAME input file name * INCLASS input file class * INSEQ input file sequence number * INDISK input file disk number * INEXT table to be plotted * INVERS table number to be plotted * SOURCES sources to plot * TIMERANGE time range to plot * STOKES stokes to plot * SUBARRAY subarray number * OPTYPE data to be plotted * *----------------------------------------------------------------------- scalar vlb_ok vlb_ok=1 if(inext='')then; inext='cl'; end if(inext <> 'cl') & (inext <> 'sn') then vlb_ok=-1 type 'sorry this procedure is only for CL and SN tables' type 'use SNPLT for TY or PC tables' end if(optype<>'PHAS' & optype<>'AMP' & optype<>'DELA' & opty<>'RATE')then if(opty<>'' & opty<>'DDLY')then vlb_ok=-1 type 'optype must be phas, amp, delay, rate, ddly' type 'reset optype and run again, or use SNPLT' end end tput vlbasnpl if(vlb_ok>0)then tvinit task 'snplt'; default; tget vlbasnpl; task 'snplt' if(optype='' ! optype='phas')then; pixra -180 180;end keyw 'NO_ANT'; getth; nplot=keyval(1) if(nplot>12)then; nplot=10;end runwait('snplt') end tget vlbasnpl return; finish * PROC VLBASUMM *----------------------------------------------------------------------- * Plots an AN or CL table versus time * * Inputs: * INNAME input file name * INCLASS input file class * INSEQ input file sequence number * INDISK input file disk number * INEXT table to be plotted * INVERS table number to be plotted * STOKES stokes to plot * SUBARRAY subarray number * DOCRT print to screen? * OUTPRINT print to file * *----------------------------------------------------------------------- tput vlbasumm scalar vba_ant vba_ant=maxtab('an') task 'prtan'; default; tget vlbasumm; task 'prtan' for i=1 to vba_ant invers i; runwait('prtan') end task 'listr'; default; tget vlbasumm; task 'listr';optype 'scan' runwait('listr') tget vlbasumm return; finish PROC VLBAMPCL *-------------------------------------------------------------------- * Solves for intrumental phase corrections using PCOR and, * if requested, FRING and then applies then using CLAL * * Input adverbs: * INNAME file name * INCLASS file class * INSEQ file sequence number * INDISK disk number * TIMERANG time range * REFANT reference antenna * CALSOUR calibrator source for TIMERANG * GAINUSE CL table to use * OPCODE OPCODE in CLCAL * TIME2 time range of second scan * ANTENNAS antennas for which manual phase corrections * should be obtained. * SOURCES calibrator source for TIME2 *-------------------------------------------------------------------- scalar vba_ok scalar vba_tim scalar vba_tim2 array time2(8) scalar vba_frg scalar vba_sn scalar vba_cl scalar vba_lant vnum=35 vput vlbampcl if(gainu=0)then; gainu=MAXTAB('cl');end if(refant=0)then; refant=1;end tput vlbampcl vba_ok=1 vba_tim=-1 vba_tim2=-1 vba_frg=-1 vba_lant=0 tget vlbampcl for i=1 to 8 if timer(i)<>0 then vba_tim=1 end if time2(i)<>0 then vba_tim2=1 end end if vba_tim < 0 then type 'TIMRANGE HAS NO DEFAULT' type 'SET TIMERANGE TO A CALIBRATOR SCAN AND RUN AGAIN' vba_ok=-1 end tget vlbampcl if(opcode='calp')&(ante(1)<>0)&(vba_tim2>0)then; vba_frg=1;end if(opcode='calp')&(ante(1)=0)&(vba_tim2>0) then vba_ok=-1 type 'Antennas and TIME2 are only set if there are antennas that' type 'are not corrected with the scan in timerang, if this is' type 'the case set both, if not set ANTE=0 and TIME2=0.' end if(opcode='calp')&(ante(1)<>0)&(vba_tim2<0) then vba_ok=-1 type 'Antennas and TIME2 are only set if there are antennas that' type 'are not corrected with the scan in timerang, if this is' type 'the case set both, if not set ANTE=0 and TIME2=0.' end if(opcode<>'calp')&((ante(1)<>0)!(vba_tim2>0)) then vba_ok=-1 type 'Antennas and TIME2 are only set if there are antennas that' type 'are not corrected with the scan in timerang, if this is' type 'the case set OPCODE=CALP, if not set ANTE=0 and/or TIME2=0.' end if(vba_ok>0)then for i=1 to 50 if(ante(i)=refant)then vba_ok=-1 type 'REFANT must be corrected with the scan in timerang' type 'if not, pick another refant.' end end end if(vba_frg>0)then for i=1 to 50 if(ante(i)<>0)then; vba_lant=i; end end end if vba_ok >=0 then type 'run FRING' task 'fring'; default; tget vlbampcl; task 'fring' docal 2;dparm(8) 1; aparm(1) 2;dparm(1) 1;ante(1)=-ante(1) runwait('fring') type 'RUN CLCAL' task 'clcal';default; tget vlbampcl;task 'clcal' gainv gainu; gainu=MAXTAB('cl')+1; snver=MAXTAB('SN') calsour '';sources '';timer 0; ante 0 runwait('clcal') vba_sn=snver vba_cl=gainu end if(vba_frg>0)&(vba_ok>0)then type 'run fring again' task 'fring'; default; tget vlbampcl; task 'fring' gainu vba_cl;docal 2;dparm(8) 1;ante(vba_lant+1) refant aparm(1) 2;dparm(1) 1;calsour=sour;timerang=time2 runwait('fring') type 'run clcal' task 'clcal';default; tget vlbampcl;task 'clcal' gainv gainu; gainu=vba_cl; snver=MAXTAB('SN') calsour '';sources '';opcode 'cali'; timer 0; runwait('clcal') end if(vba_ok>0)then type 'SN #'!!char(vba_sn)!!' contains corrections from 1st run of FRING' if(vba_frg>0)then type 'SN #'!!char(snver)!!' contains corrections from 2nd run of FRING' end type 'CL #'!!char(vba_cl)!!' adds instr. phase corrections' end vnum=35 vget vlbampcl; tput vlbampcl vnum 0 return; finish