$ VLBAPROC $--------------------------------------------------------------- $! Procedures for easy-to-learn VLBA data reduction $# RUN POPS VLBI UTILITY CALIBRATION $--------------------------------------------------------------- $; Copyright (C) 2000-2009, 2011-2012, 2014-2024 $; Associated Universities, Inc. Washington DC, USA. $; $; This program is free software; you can redistribute it $; 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. *--------------------------------------------------------------- ARRAY VBA_APRM(10), VBA_ANTS(50), VBA_BASE(50), VBA_BPRM(10) ARRAY VBA_CLCP(20), VBA_CPRM(10), VBA_DPRM(10), VBA_FIT(30) ARRAY VBA_IPRM(3), VBA_KEYV(2), VBA_PIXY(7), VBA_TAU0(30) ARRAY VBA_TRAN(8), VBA_TREC(30), VBA_UVCP(10), VBA_UVRA(2) SCALAR VBA_BCHN, VBA_BIF, VBA_BLNK, VBA_CONC, VBA_CUT SCALAR VBA_DELC, VBA_DIGI, VBA_DOTB, VBA_DOTV, VBA_ECHN SCALAR VBA_EIF, VBA_FQID, VBA_FTOL, VBA_FVER, VBA_GCV SCALAR VBA_GUSE, VBA_GVER, VBA_LTYP, VBA_NCNT, VBA_NPCE SCALAR VBA_ODSK, VBA_OSEQ, VBA_OVER, VBA_PLEV, VBA_QUAL SCALAR VBA_SBND, VBA_SFRQ, VBA_SOLI, VBA_SUB, VBA_SVER SCALAR VBA_TVER, VBA_USER, VBA_VERS, VBA_WAIT, VBA_WTHR SCALAR VBA_SEQ, VBA_DISK, VBA_SCAN, VBA_LEAP, VBA_SCR SCALAR VBA_CHIN STRING*2 VBA_SORT, VBA_EXT, VBA_TYPE STRING*4 VBA_CCOD, VBA_INTP, VBA_OPCO, VBA_OPTY, VBA_SCOD STRING*4 VBA_STOK, VBA_STYP STRING*6 VBA_OCLA, VBA_CLAS STRING*8 VBA_BPOL, VBA_TTSK, VBA_KEYW, VBA_ANAM, VBA_TASK STRING*12 VBA_ONAM, VBA_NAME STRING*16 VBA_CSRC(30), VBA_KEYS, VBA_SRCS(30), VBA_DATE STRING*48 VBA_INFI, EOPSFILE 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, 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_VERS = KEYVALUE(1) * Restore saved adverbs KEYWORD = VBA_KEYW; KEYVALUE = VBA_KEYV; KEYSTRNG = VBA_KEYS RETURN VBA_VERS 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, VBA_NROW, VBA_NUM,VBA_VERS2 * Save adverb values: VBA_EXT = INEXT; VBA_VERS2 = INVERS; VBA_PIXY = PIXXY INEXT = 'AN'; VBA_KEYW = KEYWORD; VBA_KEYV = KEYVALUE; VBA_KEYS = KEYSTRNG IF SUBARRAY > 0 THEN INVERS = SUBARRAY ELSE INVERS = 1 END 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_VERS2; 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, VBA_FINI, VBA_TIME, 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, 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, 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 FINDCHIN *--------------------------------------------------------------- * Returns the CHINC for use in FRING * Inputs: * INNAME file name * INCLASS file class * INSEQ file sequence number * INDISK file disk number *--------------------------------------------------------------- SCALAR VBA_AXIS, VBA_NUM * Save adverbs VBA_KEYW = KEYWORD; VBA_KEYS = KEYSTRNG; VBA_KEYV = KEYVALUE VBA_AXIS = 0; KEYSTRNG = ' '; VBA_CHIN=CHINC; VBA_NUM=1 * Invariant: KEYSTRNG <> 'FREQ' implies that the FREQ axis * is not one of the first VBA_AXIS axes * Bound: 7 - VBA_AXIS WHILE VBA_AXIS <> 7 & KEYSTRNG <> 'FREQ' VBA_AXIS=VBA_AXIS+1;KEYWORD='CTYPE' !! CHAR(VBA_AXIS) GETHEAD; END IF KEYSTRNG = 'FREQ' THEN KEYWORD='CDELT' !! CHAR(VBA_AXIS); GETHEAD IF (KEYVALUE(1) < 0.5E6) THEN VBA_NUM = FLOOR (0.5E6 / KEYVALUE(1)) VBA_NUM = MIN (16, VBA_NUM) PRINT 'CHINC SET TO', VBA_NUM END ELSE PRINT 'FINDCHIN: FREQ AXIS IS MISSING' 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, VBA_NANT, VBA_STAT, VBA_VLBA, 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 PRINT 'patient while AIPS searches for subarray conditions. PRINT 'This may take several minutes. 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 DEFAULT 'TACOP'; TGET VLBAMCAL; TASK 'TACOP' INEXT = 'GC'; INVERS = 1; NCOUNT = 1 OUTNAME = INNAME; OUTCLASS = INCLASS; OUTSEQ = INSEQ OUTDISK = INDISK; OUTVERS = 2; RUNWAIT('TACOP'); EXTDEST DEFAULT 'TAMRG'; TGET VLBAMCAL; TASK 'TAMRG' INEXT = 'GC'; INVERS = 2; OUTVERS = 1 APARM = 1, 1, 2, 1, 3, 1; BPARM = 1, 2, 3; RUNWAIT ('TAMRG'); EXTDEST END IF MAXTAB ('PC') = 1 THEN DEFAULT 'TACOP'; TGET VLBAMCAL; TASK 'TACOP' INEXT = 'PC'; INVERS = 1; NCOUNT = 1 OUTNAME = INNAME; OUTCLASS = INCLASS; OUTSEQ = INSEQ OUTDISK = INDISK; OUTVERS = 2; RUNWAIT('TACOP'); EXTDEST DEFAULT 'TAMRG'; TGET VLBAMCAL; TASK 'TAMRG' INEXT = 'PC'; 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 RUNWAIT ('TAMRG'); EXTDEST END IF MAXTAB ('TY') = 1 THEN DEFAULT 'TACOP'; TGET VLBAMCAL; TASK 'TACOP' INEXT = 'TY'; INVERS = 1; NCOUNT = 1 OUTNAME = INNAME; OUTCLASS = INCLASS; OUTSEQ = INSEQ OUTDISK = INDISK; OUTVERS = 2; RUNWAIT('TACOP'); EXTDEST DEFAULT 'TAMRG'; TGET VLBAMCAL; TASK 'TAMRG' INEXT = 'TY'; 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 RUNWAIT ('TAMRG'); EXTDEST END ELSE PRINT 'THIS DATA HAS BEEN PROCESSED TOO FAR FOR' PRINT 'VLBAMCAL TO BE EFFECTIVE.' END FINISH PROCEDURE VLBALOAD *--------------------------------------------------------------- * Loads VLBA data from a tape. * Input adverbs: * INTAPE input tape drive number * DATAIN to load files from disk * 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 *--------------------------------------------------------------- SCALAR VBA_NTIM IF CLINT = 0 THEN; CLINT = 0.25; END VNUMBER = 36-GETPOPSN; VPUT VLBALOAD IF SUBSTR(OUTNAME,1,1) = ' ' THEN; OUTNAME = 'MULTI'; END TPUT VLBALOAD * Set defaults for FITLD adverbs: DEFAULT 'FITLD'; TGET VLBALOAD; TASK 'FITLD' WTTHRESH = 0.7; OUTCLASS = 'UVDATA'; ANTNAME='VLBA','' RUNWAIT ('FITLD') INNAME = OUTNAME; INCLASS = 'UVDATA'; INSEQ = 0 INDISK = OUTDISK; NAMEGET IF (MAXTAB('GC') > 0 ! MAXTAB('TY') > 0) THEN VLBAMCAL TYPE 'your GC, TY and PC tables have been merged' END * check sort order, if TB then delete NX table and run INDXR TGET VLBALOAD INNAME = OUTNAME; INCLASS = 'UVDATA'; INSEQ = 0 INDISK = OUTDISK; NAMEGET; VBA_NTIM = INSEQ KEYWORD = 'SORTORD'; KEYVALUE = 0; KEYSTRNG = ''; GETHEAD IF SUBSTR(KEYSTRNG,1,2) = 'TB' THEN IF (MAXTAB('NX')>0) THEN; INEXT 'NX'; INVERS 0; EXTD; END DEFAULT 'INDXR'; TGET VLBALOAD; TASK 'INDXR' INNAME = OUTNAME; INCLASS = 'UVDATA'; INSEQ = VBA_NTIM INDISK = OUTDISK; CPARM = 1, 0, CLINT, 1, 1, 0 INFILE=''; RUNWAIT ('INDXR') END TYPE 'VLBALOAD has flagged all data with weight below 0.7' VGET 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, VBA_SRT, VBA_INDX TPUT VLBASUBS IF (CLINT = 0) THEN; CLINT = 0.25; END USERID = 0 IF VBA_NEW = TRUE THEN * If FITLD detects a potential subarray condition, 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 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. DEFAULT 'MSORT'; TGET VLBALOAD; TASK 'MSORT' OUTNAME = INNAME; OUTCLASS = INCLASS; OUTSEQ = INSEQ OUTDISK = INDISK; SORT = 'TB'; RUNWAIT ('MSORT') END IF VBA_MSUB = TRUE THEN VBA_SM1 * Now look for subarrays: DEFAULT 'USUBA'; TGET VLBALOAD; TASK 'USUBA' IF(SUBARRAY=1)THEN RUNWAIT ('USUBA');END IF(SUBARRAY=2)THEN SUBARRAY = 0; OPCODE 'AUTO'; RUNWAIT ('USUBA');END ELSE PRINT 'THERE ARE NO SUBARRAYS IN THIS DATA.' END IF IF VBA_INDX = TRUE THEN * Rebuild index and calibration tables: DEFAULT 'INDXR'; TGET VLBALOAD; TASK 'INDXR' CPARM = 1, 0, CLINT, TRUE, TRUE, 0 RUNWAIT ('INDXR') END ELSE PRINT 'THIS DATA HAS BEEN PROCESSED TOO FAR FOR' PRINT 'VLBASUBS TO BE EFFECTIVE.' END RETURN; 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, VBA_BFQ, VBA_FQ, VBA_I, VBA_J, VBA_LOFF SCALAR VBA_NIF, VBA_MDIF, VBA_SX, VBA_ROW, VBA_TSEQ SCALAR VBA_NFQI ARRAY VBA_IF1(20), VBA_IF2(20) STRING*6 VBA_TCLA TPUT VLBAFQS IF (CLINT = 0) THEN; CLINT = 0.25; 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 < 9.1e9 & VBA_FQ > 7.8e9) THEN; VBA_SX=VBA_I;END IF(VBA_FQ < 2.8e9 & VBA_FQ > 2.0e9) 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 * Split into separate frequencies (if needed) IF (VBA_NFQI > 1) ! (VBA_SX > 0) ! (VBA_9050 > 0) THEN DEFAULT 'UVCOP'; 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 <> vba_row & VBA_9050 <> vba_row THEN TGET UVCOP; OUTCLASS = 'FQ' !! CHAR(FREQID) BIF = 0; EIF= 0 PRINT 'COPYING FREQUENCY ID #' !! CHAR(FREQID) RUNWAIT ('UVCOP') ELSE TGET UVCOP; BIF=1; EIF=VBA_IF1(vba_row)-1 PRINT 'COPYING FREQUENCY ID #' !! CHAR(FREQID) OUTCLASS = 'FQ' !! CHAR(FREQID); RUNWAIT ('UVCOP') VBA_TCLA = OUTCLASS; VBA_TSEQ = OUTSEQ * Index data DEFAULT 'INDXR'; TGET VLBAFQS; TASK 'INDXR' INCLASS = VBA_TCLA; INSEQ = VBA_TSEQ INDISK = OUTDISK; CPARM = 1, 0, CLINT, 1, 1, 0 RUNWAIT ('INDXR') TGET 'UVCOP'; BIF = VBA_IF1(vba_row) EIF = VBA_IF2(vba_row) PRINT 'COPYING FREQUENCY ID #'!!CHAR(FREQID)!!'.5' OUTCLASS = 'FQ' !! CHAR(FREQID)!! '.5' RUNWAIT ('UVCOP') END * Index data VBA_TCLA = OUTCLASS; VBA_TSEQ = OUTSEQ DEFAULT 'INDXR'; TGET VLBAFQS; TASK 'INDXR' INCLASS = VBA_TCLA; INSEQ = VBA_TSEQ; INDISK=OUTDISK CPARM=1,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 PRINT 'polarization. You do not need to change the PRINT 'polarization labels unless you used an unusual PRINT '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 PRINT 'original 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 PRINT 'a small chance that LCP and RCP are interchanged in PRINT 'the data file created by FXPOL. This is probably PRINT 'only the case if there no VLBA stations and the PRINT 'experiment was correlated at the VLBA correlator. PRINT 'Check this before deleting the original file. If PRINT 'the polarizations are interchanged then TGET FXPOL, PRINT 'change BANDPOL, and run FXPOL by hand. FINISH PROCEDURE VBA_FPM4 *--------------------------------------------------------------- * Print a message informing the user that AIPS cannot guess * the correct setting for BANDPOL *--------------------------------------------------------------- PRINT 'Your data appears to have two polarizations but uses PRINT 'an unusual observing set-up. You will have to set PRINT 'BANDPOL 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, VBA_PAIR, VBA_FREQ IF (OUTDISK = 0) THEN; OUTDISK = INDISK; END 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 IF VBA_NIFS > 1 THEN 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; END IF VBA_PAIR = 0 THEN VBA_FPM1 ELSE IF 2 * VBA_PAIR = VBA_NIFS THEN IF VBA_STK1 = -1 THEN BANDPOL = '*(RL)' ELSE BANDPOL = '*(LR)' END DEFAULT 'FXPOL'; TGET VLBAFPOL; TASK 'FXPOL' OUTNAME = INNAME; OUTCLASS = 'FXPOL' IF (SUBSTR(INCLASS,1,3) = 'FQ-') THEN OUTCLASS='FPOL'!! SUBSTR(INCLASS,4,5) END RUNWAIT ('FXPOL') IF VBA_ONLY = TRUE THEN VBA_FPM2 ELSE VBA_FPM3 END ELSE VBA_FPM4 END ; END ELSE PRINT 'THIS DATA SET IS CORRUPT. THERE IS NO' PRINT 'FREQUENCY (FQ) TABLE.' END ELSE PRINT 'Polarization labelling is already correct for PRINT 'this data set. END ELSE PRINT 'THIS DATA HAS BEEN PROCESSED TOO FAR FOR VLBAFPOL' PRINT 'TO BE EFFECTIVE.' END RETURN; FINISH PROCEDURE VLBAFIX *--------------------------------------------------------------- * will merge tables, sort, correct subarrays, split into * different freqs, and index VLBA data if necessary. * 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, VBA_BFQ, VBA_FQ, VBA_INDX, VBA_I, VBA_J SCALAR VBA_MDIF, VBA_NFQI, VBA_ROW, VBA_SRT, VBA_SX SCALAR VBA_MCAL, VBA_NANT, VBA_LOFF, VBA_TSEQ ARRAY VBA_IF1(20), VBA_IF2(20) STRING*6 VBA_TCLA VNUMBER = 36-GETPOPSN; VPUT VLBAFIX IF (CLINT = 0) THEN; CLINT = 0.25; END IF (OUTDISK = 0) THEN; OUTDISK = INDISK; 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 tables need merged VBA_MCAL = FALSE; KEYWORD = 'NUM ROW'; KEYVALUE = 0 KEYSTRNG = ''; INVERS=1; INEXT='AN'; GETTHEAD VBA_NANT=KEYVALUE(1); INEXT='GC'; GETTHEAD IF KEYVALUE(1) > VBA_NANT THEN VBA_MCAL = TRUE; END * Find out if data needs to be split into separate 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 < 9.1e9 & VBA_FQ > 7.8e9) THEN; VBA_SX=VBA_I; END IF (VBA_FQ < 2.8e9 & VBA_FQ > 2.0e9) 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 * merge calibration tables (if needed) IF VBA_MCAL = TRUE THEN DEFAULT VLBAMCAL; TGET VLBAFIX; TASK 'VLBAMCAL' VLBAMCAL END * Sort data (if needed) IF VBA_SRT=TRUE & VBA_NFQI=1 & VBA_SX<0 & VBA_9050<0 THEN DEFAULT 'MSORT'; 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 DEFAULT 'USUBA'; TGET VLBAFIX; TASK 'USUBA' FREQID = 0; IF (SUBARRAY = 1) THEN; RUNWAIT ('USUBA'); END IF (SUBARRAY = 2) THEN; SUBARRAY = 0; OPCODE = 'AUTO' RUNWAIT ('USUBA'); END END * Split into separate frequencies (if needed) IF (VBA_NFQI > 1) ! (VBA_SX > 0) ! (VBA_9050 > 0) THEN DEFAULT 'UVCOP'; 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_ROW = 1 TO VBA_NFQI II = VBA_ROW TGET VLBAFIX PIXXY = VBA_ROW, 1, 1; INVER = 1; INEXT = 'FQ' TABGET; FREQID = KEYVALUE(1); TPUT UVCOP IF (VBA_SX <> VBA_ROW)&(VBA_9050 <> VBA_ROW) THEN TGET UVCOP; BIF = 0; EIF = 0 OUTCLASS = 'FQ-' !! CHAR(FREQID) PRINT 'COPYING FREQUENCY ID #' !! CHAR(FREQID) OUTSEQ=1; RUNWAIT ('UVCOP') VBA_TCLA = OUTCLASS; VBA_TSEQ = OUTSEQ ELSE TGET UVCOP BIF=1; EIF=VBA_IF1(vba_row)-1 PRINT 'COPYING FREQUENCY ID #' !! CHAR(FREQID) OUTCLASS = 'FQ-' !! CHAR(FREQID) OUTSEQ=1; RUNWAIT ('UVCOP') VBA_TCLA = OUTCLASS; VBA_TSEQ = OUTSEQ * Index data DEFAULT 'INDXR'; TGET VLBAFIX TASK 'INDXR'; INCLASS = VBA_TCLA; INSEQ = VBA_TSEQ; INDISK = OUTDISK CPARM = 1, 0, CLINT, 1, 1, 0 RUNWAIT ('INDXR') * run VLBAFPOL IF VBA_NSTK = 1 THEN; VLBAFPOL; END TGET 'UVCOP' BIF = VBA_IF1(vba_row); EIF = VBA_IF2(vba_row) PRINT 'COPYING FREQUENCY ID #'!!CHAR(VBA_NFQI+1) OUTCLASS = 'FQ-' !! CHAR(VBA_NFQI+1) RUNWAIT ('UVCOP') END * Find out if data needs sorting VBA_SRT = TRUE; KEYWORD = 'SORTORD'; KEYVALUE = 0 INCLASS = VBA_TCLA; INSEQ = VBA_TSEQ INDISK = OUTDISK; KEYSTRNG = ''; GETHEAD IF SUBSTR(KEYSTRNG,1,2) = 'TB' THEN VBA_SRT = FALSE; END * Sort data (if needed) IF (VBA_SRT = TRUE) THEN DEFAULT 'MSORT'; TGET VLBAFIX; TASK 'MSORT' INCLASS = VBA_TCLA; INSEQ = VBA_TSEQ INDISK = OUTDISK; OUTNAME = INNAME OUTCLASS = INCLASS; OUTSEQ = INSEQ; OUTDISK = INDISK; SORT = 'TB' RUNWAIT ('MSORT') END * Index data VBA_TCLA = OUTCLASS; VBA_TSEQ = OUTSEQ DEFAULT 'INDXR'; TGET VLBAFIX; TASK 'INDXR' INCLASS = VBA_TCLA; INSEQ = VBA_TSEQ INDISK = OUTDISK; CPARM = 1, 0, CLINT, 1, 1, 0 RUNWAIT ('INDXR') TGET VLBAFIX INCLASS=VBA_TCLA; INSEQ=VBA_TSEQ; INDISK = OUTDISK * run VLBAFPOL messes up VBA_ROW for no clear reason IF VBA_NSTK = 1 THEN; VLBAFPOL; END VBA_ROW = II 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_NFQI <= 1 & VBA_SX <= 0 & VBA_9050 <= 0 THEN IF SUBARRAY > 0 ! VBA_SRT = TRUE ! VBA_INDX > 0 THEN * Index data DEFAULT 'INDXR'; TGET VLBAFIX; TASK 'INDXR' CPARM = 1, 0, CLINT, 1, 1, 0 RUNWAIT ('INDXR') TGET VLBAFIX END END IF VBA_SRT > 0 THEN TYPE 'YOUR DATA HAS BEEN SORTED'; END IF VBA_MCAL > 0 THEN TYPE 'YOUR CAL TABLES HAVE BEEN MERGED'; 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' TYPE 'FREQUENCY ID FILES AND INDEXED'; END IF SUBARRAY > 0 ! VBA_SRT = TRUE ! VBA_INDX > 0 THEN IF VBA_NFQI < 2 & VBA_SX < 0 & VBA_9050 < 0 THEN TYPE 'YOUR DATA HAS BEEN INDEXED'; 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 DID NOT NEED FIXING'; END END ELSE PRINT 'THIS DATA HAS BEEN PROCESSED TOO FAR FOR VLBAFIX' PRINT 'TO BE EFFECTIVE.' END VNUMBER = 36-GETPOPSN; VGET VLBAFIX; TPUT VLBAFIX RETURN; FINISH PROCEDURE VLBACALA *--------------------------------------------------------------- * THIS PROCEDURE IS NOW OUTDATED AND HAS BEEN REPLACED BY * VLBACCOR AND VLBAAMP * 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 * DOFIT fit opacity * BADDISK bad disk array *--------------------------------------------------------------- SCALAR VBA_SN, VBA_SU, VBA_DOOP TPUT VLBACALA * Run ACCOR to determine sampling corrections DEFAULT 'ACCOR'; TGET VLBACALA; TASK 'ACCOR' SOLINT = -0.5; RUNWAIT ('ACCOR') * Run SNSMO to clip bad points DEFAULT 'SNSMO'; TGET VLBACALA; TASK 'SNSMO' SAMPTYPE = 'MWF'; DOBLANK = -1; SMOTYPE = 'AMPL' CPARM = 0.5, 0, 0, 0, 0, 1; INVERS = MAXTAB('SN') OUTVERS = INVERS + 1; RUNWAIT ('SNSMO') * Replace original table with smoothed table INEXT = 'SN'; EXTDEST; VBA_SN = INVERS DEFAULT 'TACOP'; TGET VLBACALA; TASK 'TACOP' INVERS = VBA_SN + 1; OUTVERS = VBA_SN; OUTNAME = INNAME INEXT = 'SN'; OUTCLASS = INCLASS; OUTSEQ = INSEQ OUTDISK = INDISK; RUNWAIT ('TACOP'); EXTDEST * Apply corrections to CL table DEFAULT 'CLCAL'; TGET VLBACALA; TASK 'CLCAL' OPCODE = 'CALI'; SNVER = VBA_SN; DOBLANK = -1 GAINVER = MAXTAB('CL'); GAINUSE = GAINVER + 1 RUNWAIT ('CLCAL') * Determine a-priori amplitude corrections DEFAULT 'APCAL'; TGET VLBACALA; TASK 'APCAL' TYVER = MAXTAB('TY'); GCVER = MAXTAB('GC'); SNVER = 0 IF (DOFIT(1)>0) THEN; OPCODE = 'GRID'; INVERS = 1; VBA_DOOP = 1;END RUNWAIT ('APCAL') * Apply corrections to CL table DEFAULT 'CLCAL'; TGET VLBACALA; TASK 'CLCAL' OPCODE = 'CALI'; INTERPOL = 'SELF'; SNVER = MAXTAB('SN') GAINVER = MAXTAB('CL'); GAINUSE = GAINVER + 1; DOBLANK = -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 'THIS IS NO LONGER THE RECOMMENDED WAY TO CALIBRATE' PRINT 'AMPS. USE VLBACCOR, VLBABPSS AND VLBAAMP INSTEAD' IF (VBA_DOOP>0) THEN PRINT 'You have done an opacity correction, you should PRINT 'look at the plots produced by APCAL. END TGET VLBACALA 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 * Make the correction: DEFAULT 'CLCOR'; TGET VLBAPANG; TASK 'CLCOR' GAINVER = MAXTAB('CL'); GAINUSE = GAINVER +1 OPCODE = 'PANG'; CLCORPRM = +1, 0; RUNWAIT('CLCOR') VBA_CLAS = 'CL #' !! CHAR(GAINUSE) PRINT VBA_CLAS !! ' 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. * CHINC For narrow-band data in FRING (< 0 -> find) *--------------------------------------------------------------- SCALAR VBA_OK, VBA_TIM, VBA_FRG, VBA_SN, VBA_CL, VBA_LANT vnumber = 36-getpopsn; 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 vlbapcor; doband = -1 for i = 1 to 8 if (timerang(i) <> 0) then; vba_tim = 1; end end if (vba_tim < 0) then type 'TIMERANG HAS NO DEFAULT' type 'SET TIMERANG TO A CALIBRATOR SCAN AND RUN AGAIN' vba_ok = -1 end tget vlbapcor if ((opcode='calp') & (antennas(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 the type 'PC table. If this is the case set OPCODE=CALP, type 'if not set ANTE=0 end if (vba_frg>0) then for i = 1 to 50 if (antennas(i)<>0) then; vba_lant = i; end end end if (vba_ok>=0) then type 'run pccor'; default 'pccor'; tget vlbapcor task='pccor'; delcorr 0; runwait('pccor') if (vba_frg>0) then type 'run sncor'; default 'sncor'; tget vlbapcor task 'sncor'; opcode 'zphs'; timerang 0; source '' runwait('sncor'); opcode 'zdel'; runwait('sncor') end type 'RUN CLCAL'; default 'clcal'; tget vlbapcor task 'clcal'; gainver gainuse; gainuse = MAXTAB('cl')+1; snver = MAXTAB('SN'); interpol 'self'; calsour ''; timerang 0; antennas 0; inver = 0; runwait('clcal') vba_sn = snver; vba_cl = gainu end if ((vba_frg>0) & (vba_ok>0)) then type 'run fring'; default 'fring'; tget vlbapcor task 'fring'; gainuse vba_cl; docalib 2; dparm(8) 1 if (maxtab('bp')>0) then doband = 1; bpver = maxtab('bp'); end chinc = min(chinc, 1); if (chinc<0) then chinc=findchin; end antennas(vba_lant+1) = refant; aparm(1) 2;dparm(1) 1; snver 0 runwait('fring') type 'run clcal'; default 'clcal'; tget vlbapcor task 'clcal'; gainver gainuse; gainuse = vba_cl snver = MAXTAB('SN'); calsour ''; opcode 'cali'; timerang 0; inver = 0; runwait('clcal') end if (vba_ok>0) then if (vba_frg>0) then type 'if there is a message about failed solutions in type 'FRING find a better calibrator scan and run again end vba_clas = 'SN #' !! char(vba_sn) type vba_clas !! ' contains pcal instr. phase corrections if (vba_frg>0) then vba_clas = 'SN #' !! char(snver) type vba_clas !!' contains manual instr. phase corrections end type 'CL #' !! char(vba_cl) !!' adds instr. phase corrections end vnum = 36-getpopsn; vget vlbapcor; tput vlbapcor; vnumber 0 return; finish PROC VLBAFRNG *--------------------------------------------------------------- * 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 * CHINC set CHINC for narrow-band data (< 0 -> find) * INTERPOL interpolation method to use * BADDISK bad disk *--------------------------------------------------------------- SCALAR VBA_OK, VBA_CL, VBA_NMS vba_nms = 0; vba_ok = 1; vnumber = 36-getpopsn; vput vlbafrng if (gainuse=0) then; gainuse = maxtab('cl'); end tput vlbafrng for i = 1 to 30 if (source(i)<>'') then vba_nms = vba_nms + 1 end end if (vba_ok>=0) then type 'run fring'; clrtemp default 'fring'; tget vlbafrng; task = 'fring' clrtemp if (search(1)<>0) then aparm(9) = 1; end clrtemp $ aparm(6) = 1 if (maxtab('bp')>0) then; doband = 1; bpver = maxtab('bp'); end chinc = min(chinc, 1); if (chinc<0) then chinc=findchin; end docalib 2; runwait('fring') type 'RUN CLCAL'; default 'clcal'; tget vlbafrng task 'clcal'; vba_cl = maxtab('cl')+1 if ((interpol='self') ! (sources(1) = '')) then gainver gainuse; gainuse = vba_cl; snver = maxtab('SN') runwait('clcal') else $$$ manual self for i = 1 to vba_nms tget vlbafrng; task 'clcal'; gainver gainuse; gainuse vba_cl; calsour = source(i), '' source = source(i),''; snver = maxtab('SN') runwait('clcal') end end vba_clas = 'SN #' !! char(snver) type vba_clas!!' contains fringe solns for sources in calsour vba_clas = 'CL #' !! char(vba_cl) type vba_clas !! ' adds fringe solns for sources in sources vnumber=36-getpopsn; vget vlbafrng; tput vlbafrng; vnumber 0 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, VBA_NUMS, VBA_CL vba_ok = 1; vba_nms = 0; vnumber = 36-getpopsn; vput vlbakrng if (gainuse=0) then; gainuse = maxtab('cl'); end tput vlbakrng for i = 1 to 30 if (source(i)<>'') then vba_nms = vba_nms+1 end end if (vba_ok >= 0) then type 'run kring'; default 'kring'; tget vlbakrng task = 'kring' $ prtlev 2 if (maxtab('bp')>0) then; doband = 1; bpver = maxtab('bp'); end docalib 2; runwait('kring') type 'RUN CLCAL'; default 'clcal'; tget vlbakrng task 'clcal'; vba_cl = maxtab('cl')+1 if ((interpol = 'self') ! (sources(1) = '')) then gainver gainuse; gainuse = vba_cl; snver = maxtab('SN') runwait('clcal') else for i = 1 to vba_nms tget vlbakrng; task 'clcal'; gainver gainuse; gainuse vba_cl; calsour = source(i), '' source = source(i),'';snver = maxtab('SN') runwait('clcal') end end vba_clas = 'SN #' !! char(snver) type vba_clas!!' contains fringe solns for sources in calsour vba_clas = 'CL #' !! char(vba_cl) type vba_clas !! ' adds fringe solns for sources in sources vnumber = 36-getpopsn; vget vlbakrng; tput vlbakrng vnumber 0; 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 * CHINC set CHINC for narrow-band data (< 0 -> find) * BADDISK bad disk *--------------------------------------------------------------- SCALAR VBA_OK, VBA_NMS, VBA_NMC, VBA_CL ARRAY VBA_SC(30) vba_ok = 1; vba_nms = 0; vba_nmc = 0; vnumber = 36-getpopsn vput vlbafrgp if (gainuse = 0) then; gainuse = maxtab('cl'); end tput 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(sources(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 (source(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 (source(i) = calsour(j)) then vba_sc(i) = 1; end end end type 'run fring'; default 'fring'; tget vlbafrgp task = 'fring' if (search(1)<>0) then aparm(9) = 1; end $ aparm(6) = 1 if (maxtab('bp')>0) then doband = 1; bpver = maxtab('bp'); end chinc = min(chinc, 1); if (chinc<0) then chinc=findchin; end docalib 2; snver = 0; runwait('fring') type 'RUN CLCAL'; default 'clcal'; tget vlbafrgp task 'clcal' ; vba_cl = maxtab('cl') + 1 if (source(1)='') then gainver gainuse; gainuse = maxtab('cl')+1 snver = maxtab('SN'); calsour = calsour(1),'' type 'all sources referenced to calsour= '!!calsour(1) runwait('clcal') else for i = 1 to vba_nms tget vlbafrgp; task 'clcal' gainver gainuse; gainuse vba_cl; snver = maxtab('SN') if (vba_sc(i)>0) then source = source(i),''; calsour = source else source = source(i),''; calsour = calsour(1),'' end runwait('clcal') type source(1)!!' referenced to calsour= '!!calsour(1) end end vba_clas = 'SN #' !! char(snver) type vba_clas!!' contains fringe solns for sources in calsour vba_clas = 'CL #' !! char(vba_cl) type vba_clas !! ' adds fringe solns for sources in sources vnumber = 36-getpopsn; vget vlbafrgp; tput vlbafrgp vnumber 0 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, VBA_NMS, VBA_NMC, VBA_CL ARRAY VBA_SR(30) vba_ok = 1; vba_nms = 0; vba_nmc = 0 vnumber = 36-getpopsn; vput vlbakrgp if (gainuse=0) then; gainuse = maxtab('cl'); end tput 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(source(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 (source(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 (source(i)=calsour(j)) then vba_sr(i) = 1; end end end type 'run kring'; default 'kring'; tget vlbakrgp task = 'kring' $ prtlev 2 if (maxtab('bp')>0) then doband = 1; bpver = maxtab('bp'); end docalib 2; runwait('kring') type 'RUN CLCAL'; default 'clcal'; tget vlbakrgp task 'clcal' if (source(1)='') then gainver gainuse; gainuse = 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' gainver gainuse; gainuse vba_cl; snver = maxtab('SN') if (vba_sr(i)>0) then source = source(i),''; calsour = source else source = source(i),''; calsour = calsour(1),'' end runwait('clcal') type source(1)!!' referenced to calsour= '!!calsour(1) end end vba_clas = 'SN #' !! char(snver) type vba_clas!!' contains fringe solns for sources in calsour vba_clas = 'CL #' !! char(vba_cl) type vba_clas !! ' adds fringe solns for sources in sources vnumber = 36-getpopsn; vget vlbakrgp; tput vlbakrgp vnumber 0 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, VLB_ANT, VLB_OK, VLB_LOW, VLB_HI, VLB_REF SCALAR VLB_TIM vlb_slot = 0; vlb_ok = 1; vlb_low = 1; vlb_hi = 1; vlb_ref = -1; vlb_tim = -1; vnumber = 36-getpopsn; vput vlbacpol if (outdisk=0) then outdisk = indisk; end; tput vlbacpol inext 'cl'; inver 0; keyword 'NO_ANT'; getthead 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 ((baseline(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 (baseline(i) <> 0) & (refant < baseline(i)) then vlb_hi = -1; end if ((baseline(i)<>0) & (baseline(1)<>0)) then if (refant = baseline(i)) then; vlb_ref = 1; end 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) & (baseline(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 (timerang(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; type 'for RL and LR fringes' end if (vlb_ok >= 0) then type 'Make copy of selected data default 'UVCOP'; tget vlbacpol; task = 'uvcop' outname = 'CROSSPOL TMP'; outclass = 'UVCOP'; outseq = 666 runwait('uvcop') default 'INDXR'; tget vlbacpol; task = 'indxr' inname = 'CROSSPOL TMP'; inclass = 'UVCOP'; inseq = 666 indisk = outdisk; runwait('indxr') inext 'SN'; inver = -1; extd type 'Fringe fit for parallel hand data default 'FRING'; tget vlbacpol; task = 'fring' inname = 'CROSSPOL TMP'; inclass = 'UVCOP'; inseq = 666 indisk = outdisk; aparm = 2,0; docalib = 2; snver = 1 runwait('fring') type 'Calibrate parallel polarization default 'CLCAL'; tget vlbacpol; task = 'clcal' inname = 'CROSSPOL TMP'; inclass = 'UVCOP'; inseq = 666 indisk = outdisk; gainver gainuse; gainuse = maxtab('cl')+1 snver = 1; opcode = 'CALI'; source calsour; runwait('clcal') vlb_slot = gainuse type 'Swap R and L for reference antenna default 'SWPOL'; tget vlbacpol; task = 'swpol' inname = 'CROSSPOL TMP'; inclass = 'UVCOP'; inseq = 666 indisk = outdisk; outname = 'CROSSPOL TMP' outclass = 'SWPOL'; outseq = 666; antennas = refant, 0 gainuse = vlb_slot; docalib = 2; runwait('swpol') default 'INDXR'; tget vlbacpol; task = 'indxr' inname = 'CROSSPOL TMP'; inclass = 'SWPOL'; inseq = 666 indisk = outdisk; runwait('indxr') inext 'SN'; inver = -1; extd type 'Fringe fits for cross hand data default 'FRING'; tget vlbacpol; task = 'fring' inname = 'CROSSPOL TMP'; inclass = 'SWPOL'; inseq = 666 indisk = outdisk; aparm = 2,0; gainuse = vlb_slot docalib = 2; snver = 1 if (baseline(1)=0) then for i = 1 to vlb_ant if (i<>refant) then antennas = refant, i type 'FIT FOR BASELINE', refant,i runwait('fring') end end else for i = 1:30; if (baseline(i)<>refant) & (baseline(i) <> 0) then antennas = refant, baseline(i) type 'FIT FOR BASELINE',refant,baseline(i) runwait('fring') end end end type 'Process solutions default 'POLSN'; tget vlbacpol; task = 'polsn' inname = 'CROSSPOL TMP'; inclass = 'SWPOL'; inseq = 666 indisk = outdisk; inver = 1; outver = 2 runwait('polsn') type 'Copy SN table to original UV data default 'TACOP'; tget vlbacpol; task = 'tacop' in2disk = outdisk;outname = inname; outclass = inclass; outdisk = indisk; outseq = inseq inname = 'CROSSPOL TMP'; inclass = 'SWPOL'; inseq = 666 indisk = in2disk; inext 'SN'; inver = 2; ncount = 1 runwait('tacop') type 'RUN CLCAL'; default 'clcal'; tget vlbacpol task 'clcal'; snver = maxtab('sn'); gainver gainuse gainuse = maxtab('cl')+1; opcode 'cali'; timerang 0 calsour ''; source ''; runwait('clcal') type 'Destroy temporary files intype = 'UV'; inname = 'CROSSPOL TMP'; indisk = outd inseq = 666; inclass = 'UVCOP'; zap inclass = 'SWPOL'; zap vba_clas = 'SN #' !! char(snver) type vba_clas !! ' contains cross pol. delay corrections vba_clas = 'CL #' !! char(gainuse) type vba_clas !!' adds cross pol. delay corrections vnumber = 36-getpopsn; vget vlbacpol; tput vlbacpol vnumber 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, VLB_IF tput vlbacrpl if (dotv>=1) then; tvinit; end default 'possm'; tget vlbacrpl; task 'possm' if (gainuse=0) then; gainuse = MAXTAB('cl'); end if (refant=0) then; refant = 1; end if (gainuse<0) then; docalib = -1; end if (gainuse>0) then; docalib = 2; end if (stokes='') then; stokes = 'I'; end inext 'cl';invers 1; keyword 'NO_ANT'; getthead nplot = keyvalue(1); nplot = min (nplot,9) baseline = refant, 0; aparm 0, 1, 0, 0, -180, 180, 0, 0, 3 keyword 'naxis4'; gethead; vlb_if = keyvalue(1) if (vlb_if>4) then; aparm(9) = 1; end runwait('possm'); tget vlbacrpl return; finish PROC VLBASNPL *--------------------------------------------------------------- * Plots an SN 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') then if (optype<>'' & optype<>'DDLY' & opty<>'RATE') 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 if (dotv>=1) then; tvinit; end default 'snplt'; tget vlbasnpl; task 'snplt' if (optype='' ! optype='phas') then; pixrange -180 180; end keyword 'NO_ANT'; getthead; nplot = keyvalue(1) if (nplot>12) then; nplot = 10;end runwait('snplt') end tget vlbasnpl return; finish PROC VLBASUMM *--------------------------------------------------------------- * Plots an SN 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 *--------------------------------------------------------------- SCALAR VBA_ANT tput vlbasumm; vba_ant = maxtab('an') default 'prtan'; tget vlbasumm; task 'prtan' for i = 1 to vba_ant invers i; runwait('prtan') end default 'listr'; 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 * CHINC set CHINC for narrow-band data (< 0 -> find) *--------------------------------------------------------------- SCALAR VBA_OK, VBA_TIM, VBA_TIM2, VBA_FRG, VBA_SN, VBA_CL SCALAR VBA_I, VBA_J, VBA_ACNT, VBA_LANT ARRAY TIME2(8) vnumber = 36-getpopsn; vput vlbampcl if (gainuse = 0) then; gainuse = 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; vba_acnt = 0; tget vlbampcl for i = 1 to 8 if timerang(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 type 'that are not corrected with the scan in timerang, if type 'this is the case set both, if not set ANTE=0 and type ' 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 type 'that are not corrected with the scan in timerang, if type 'this is the case set both, if not set ANTE=0 and type '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 type 'that are not corrected with the scan in timerang, if type 'this is the case set both, if not set ANTE=0 and type 'TIME2=0. end if (vba_ok>0) then for i = 1 to 50 if (antennas(i)=refant) then vba_ok = -1 type 'REFANT must be corrected with the scan in' type 'timerang if not, pick another refant.' end end end if (vba_frg>0 & vba_ok>=0) then for vba_i=1 to 50 if (antennas(vba_i)<>0) then; vba_lant = vba_i; end end if (vba_lant=50) then for vba_i=1 to 49 for vba_j=vba_i+1 to 50 if (ante(vba_i)=ante(vba_j)) then; vba_acnt = vba_acnt+1; end end end type 'vba_acnt=' !! char(vba_acnt) if (vba_acnt=1225) then antennas = antennas(1), 0; vba_lant = 1;tput vlbampcl else if (vba_acnt>0) then type 'You have requested a single ANTENNA multiple' type 'times! I am very confused. I QUIT!' end if (vba_acnt=0) then type 'Sorry you are limited to 49 antennas' type '(excluding the refant)' end vba_ok=-1 end end end if vba_ok >=0 then type 'run FRING'; default 'fring'; tget vlbampcl if (maxtab('bp')>0) then; doband=1; bpver = maxtab('bp'); end task 'fring'; docalib 2; dparm(8) 1; aparm(1) 2; dparm(1) 1 antennas(1)=-antennas(1); snver=0 chinc = min(chinc, 1); if (chinc<0) then chinc=findchin; end runwait('fring') type 'RUN CLCAL'; default 'clcal'; tget vlbampcl gainver gainuse; gainuse=MAXTAB('cl')+1; snver=MAXTAB('SN') task 'clcal'; calsour ''; sources ''; timerang 0; antennas 0 runwait('clcal') vba_sn = snver; vba_cl = gainuse end if (vba_frg>0) & (vba_ok>0) then type 'run fring again'; default 'fring'; tget vlbampcl if (maxtab('bp')>0) then; doband=1; bpver = maxtab('bp'); end task 'fring'; gainu vba_cl; docalib 2; dparm(8) 1; antennas(vba_lant+1) refant; aparm(1) 2; dparm(1) 1 calsour = sources; timerang = time2; snver =0 chinc = min(chinc, 1); if (chinc<0) then chinc=findchin; end runwait('fring') type 'run clcal'; default 'clcal'; tget vlbampcl task 'clcal'; gainver gainuse; gainuse = vba_cl snver=MAXTAB('SN'); calsour ''; sources ''; opcode 'cali' timerang 0; runwait('clcal') end if (vba_ok>0) then vba_clas = 'SN #' !! char(vba_sn) type vba_clas!!' contains corrections from 1st run of FRING if (vba_frg>0) then vba_clas = 'SN #' !! char(snver) type vba_clas!!' contains corrections from 2nd run of FRING end type 'CL #'!!char(vba_cl)!!' adds instr. phase corrections end vnumber = 36-getpopsn; vget vlbampcl; tput vlbampcl vnumber 0 return; finish PROCEDURE VLBAEOPS *--------------------------------------------------------------- * Correct Earth orientation parameters * Input adverbs: * INNAME file name * INCLASS file class * INSEQ file sequence number * INDISK disk number * INFILE file with correct EOPs *--------------------------------------------------------------- SCALAR VBA_OK, VBA_GET STRING*48 EOPSFILE tput vlbaeops; vnumber 36-getpopsn; vput vlbaeops; vba_ok=1 sys2com='';sysout='' vba_get=1; if (length(eopsfile)>0) then; vba_get = -10; end if (vba_get=-10) then; type 'You have your own EOP file end if (vba_get>0) then type 'Attempting to download file with correct EOPS syscom 'which curl system if (error>0) then vba_ok=-1; else vba_get=-1; end if (vba_ok>0) then sys2com(1)=' --ftp-ssl ftp://gdc.cddis.eosdis.nasa.gov/vlbi/gsfc/ sys2com(2)='ancillary/solve_apriori/usno_finals.erp type 'Dowload file: if (vba_get=-1) then; syscom= 'curl -u anonymous:daip@nrao.edu sys2com(3) = ' > /tmp/usno_finals.erp system end if (error>0) then; vba_ok = -2; end if (error<0) then sys2com='' syscom 'find /tmp/usno_finals.erp system if (error>0) then; vba_ok = -3; end end end if (vba_ok<0) then type 'The automatic download failed' if (vba_ok=-1) then type 'Your system does not have the comand wget, curl type 'or ncftpget one of which is needed to download type 'the file from Goddard. If you are a Mac user, type 'the wget and ncftpget commands exist in Fink. end if (vba_ok=-2) then type 'Although your system claims to have an web type 'download command it did not seem to work. type 'See the error messages and contact your type 'system manager. end if (vba_ok=-3) then type 'Although the download did not produce any errors type 'this script cannott find /tmp/usno_finals.erp. type 'I give up in confusion. end type 'Download the file manually from: type 'ftp://cddis.gsfc.nasa.gov/vlbi/gsfc/ancillary/ type 'solve_apriori/usno_finals.erp type 'and run VLBAEOPS with the EOPSFILE parameter set. end end vput vlbaeops if (vba_ok>0) then default clcor; vget vlbaeops; task 'clcor' infile = '/tmp/usno_finals.erp if (vba_get=-10) then; infile = eopsfile; end opcode 'eops'; runwait('clcor') tget vlbaeops if (substr(infile,1,1)=' ' & vba_get<>-10) then syscom '\rm /tmp/usno_finals.erp system if (error>0) then type 'Cannot remove /tmp/usno_final.erp end end *--------------------------------------------------------------- vba_clas = 'CL #'!!char(maxtab('CL')) type vba_clas !!' contains the EOP corrections type 'It is a good idea to check this table with type 'SNPLT or VLBASNPL end tget vlbaeops return;finish PROCEDURE DAYNUM(VBA_DATE) *--------------------------------------------------------------- * Returns the day number when given a date as a character * string in yyyymmdd format. The leap year calculation is * good from 1901-2099. VBA_DATE is a 16 character string so * the user can send KEYWORD. *--------------------------------------------------------------- ARRAY VBA_MNUM(12) SCALAR VBA_YR, VBA_MO, VBA_DAY, VBA_DNUM, VBA_OK vba_leap = 0; vba_yr = value (substr(vba_date,1,4)) vba_mnum = 0, 31, 59, 90, 120, 151, 181, 212, 243, 273, 304, 334 vba_mo = value (substr(vba_date,5,6)) vba_day = value(substr(vba_date,7,8)) if (mod(vba_yr,4)=0 & vba_mo>2) then; vba_leap=1; end vba_dnum = vba_mnum(vba_mo) + vba_day + vba_leap if (vba_mo<1) ! (vba_mo>12) ! (vba_day<1) ! (vba_day>31) then; vba_dnum=-1;end return vba_dnum finish PROCEDURE VLBATECR *--------------------------------------------------------------- * Calculate ionospheric delay and Faraday rotation corrections * Input adverbs: * INNAME file name * INCLASS file class * INSEQ file sequence number * INDISK disk number * INFILE file with correct EOPs * APARM TECOR adverbs: (1) do dispersive delay * (2) time correction * (3) > Use IGRF magnetic field * (4)-(6) Petrov model *--------------------------------------------------------------- SCALAR VBA_OK, VBA_YR, VBA_CR, VBA_DNUM, VBA_I, VBA_GET SCALAR VBA_UN, VBA_II, VBA_DAYS, VBA_NFIL, VBA_SCR, VBA_CDD STRING*3 VBA_CHDN STRING*48 VBA_INF, VBA_OUF, VBA_OUFZ tput vlbatecr; vnumber=36-getpopsn; vput vlbatecr; vba_un = 1 sysout=''; vba_ok=1; vba_get=1; sys2com='' if (maxtab('NX')=0) then; vba_ok = -6; end if (length(tecrfile)>0) then; vba_get=-10; vba_nfil=nfiles; end if (vba_get>0) then if (vba_ok>0) then default gethead; vget vlbatecr; keyword = 'DATE-MAP'; gethead vba_cr = value (substr(keystrng,1,4)) keyword = 'DATE-OBS'; gethead vba_yr = value (substr(keystrng,1,4)) if (vba_yr>1997) & (vba_yr<=vba_cr) then; vba_dnum = daynum(keystrng); if (vba_dnum<1)!(vba_dnum>366) then; vba_ok=-4;end if (vba_yr=1998)&(vba_dnum<151) then; vba_ok=-5;end else vba_ok=-4; if (vba_yr<=1997) then; vba_ok=-5; end end default getthead; vget vlbatecr; inext 'nx'; keyword 'num row'; getthead; pixxy = keyvalue(1), 1; tabget; vba_days = keyvalue(1) pixxy(2)=2; tabget; vba_scr = vba_days + 0.5*keyvalue(1) vba_nfil = ceil (vba_scr) if (vba_ok>0) then if ((vba_yr<2002) ! (vba_yr=2002 & vba_dnum<305)) then if ((vba_scr-vba_nfil+1.0)*24.0>23.0) then vba_nfil = vba_nfil + 1; end pixxy 1, 1; tabget; vba_days = keyvalue(1) pixxy(2)=2; tabget if ((vba_days-0.5*keyvalue(1))*24.0 < 1.0) then vba_nfil = vba_nfil+1; vba_dnum = vba_dnum-1 end if (vba_yr=1998)&(vba_dnum<151) then; vba_ok=-5;end end end end if (vba_ok>0) then syscom 'which curl system if (error>0) then vba_ok=-1 else vba_get = -1 end end if (vba_ok>0) then syscom 'which uncompress system if (error>0) then syscom 'which zcat system if (error>0) then; vba_un = -1; else; vba_un = 2; end end end if (vba_ok>0) then type 'Download file(s): for vba_ii = vba_dnum to vba_dnum+vba_nfil-1 vba_i=vba_ii if (vba_i > (365.0+vba_leap)) then vba_i=vba_i-(365.0+vba_leap) vba_yr=vba_yr+1 end substr(vba_chdn,1,2) = '00'; if (vba_i>99) then; vba_chdn=char(vba_i) else if (vba_i>9) then substr(vba_chdn,2,3)=char(vba_i) else substr(vba_chdn,3,3)=char(vba_i) end end if (tecrtype=' ') then; tecrtype='jplg'; end; downcase(tecrtype); sys2com(3)=' ftp://gdc.cddis.eosdis.nasa.gov/gps/products/ionex/ sys2com(4)=char(vba_yr)!!'/'!!vba_chdn!!'/' sys2com(5)=tecrtype sys2com(6)=vba_chdn!!'0.'!!substr(char(vba_yr),3,4)!!'i sys2com(7)='.Z' if (vba_get=-1) then syscom 'curl -u anonymous:daip@nrao.edu sys2com(1)='';sys2com(2) = ' --ftp-ssl sys2com(8)=' > ' $ NEW CODE 2023 DAY 220 if ((vba_yr<2023) ! ((vba_yr=2023) & (vba_ii<220))) then $ PRINT 'OLD FORMAT' VBA_CDD=0 vba_ouf = ' /tmp/ vba_ouf = vba_ouf!!sys2com(5)!!sys2com(6) vba_oufz = vba_ouf!!sys2com(7) sys2com(8)=sys2com(8)!!vba_oufz system if (error>0) then sys2com(5)='codg sys2com(8)=' > /tmp/codg sys2com(8)=sys2com(8)!!sys2com(6)!!sys2com(7) system end else $ PRINT 'NEW FORMAT' VBA_CDD=1 vba_ouf = ' /tmp/ vba_ouf = vba_ouf!!substr(tecrtype,1,3)!!'g vba_ouf = vba_ouf!!sys2com(6) vba_oufz = vba_ouf!!'.gz upcase(tecrtype); sys2com(5)=substr(tecrtype,1,3)!!'0OPSFIN_' sys2com(5)=sys2com(5)!!char(vba_yr)!!vba_chdn sys2com(5)=sys2com(5)!!'0000_01D_02H_GIM.INX.gz sys2com(8)= ' >'!!vba_oufz sys2com(6)=''; sys2com(7)='' $$$ inputs system system end end if (error>0) then; vba_ok=-2; end if (error<=0 & vba_un>0) then if (vba_un=2) then syscom = 'zcat /tmp/ sys2com(2) = ' > /tmp/ sys2com(3) = sys2com(5)!!sys2com(6) else if (vba_cdd = 0) then syscom = 'uncompress else syscom = 'gunzip end if sys2com(2) = ''; sys2com(3) = '' end $ sys2com(1) = sys2com(5) !! sys2com(6) !! sys2com(7) sys2com(1) = vba_oufz if (vba_i=vba_dnum) then vba_inf = substr(vba_ouf,2,48) end sys2com(4)~'','','','',''; $$$$ inputs system system if (error>0) then; vba_ok=-3;end end end end if (vba_ok<0) then type 'The automatic download failed' if (vba_ok=-1) then type 'Your system does not have any of the three type 'possible commands, wget, curl or ncftpget, that type 'this script attempts to use to automatically type 'download the IONEX file(s). end if (vba_ok=-4) then type 'Attempt to convert observation date to day number type 'failed. Check the observation date in the type 'header of this file. end if (vba_ok=-5) then type 'IONEX files do not exist for dates earlier than type 'June 1, 1998. end if (vba_ok<>-5) then type 'Download the file(s) manually (see TECOR EXPLAIN type ' file), and run TECOR. end end if (vba_un<0) then type 'Your system does not have one of the two possible type 'commands, unompress or zcat, to uncompress the type 'IONEX file(s). if (vba_ok>0) then type 'The files have been downloaded and are in your type '/tmp directory so you can run TECOR on them if type 'you can figure out how to uncompress them. end end end if (vba_ok>0 & vba_un>0) then default tecor; vget vlbatecr; task 'tecor'; dotable=1 nfiles = vba_nfil; aparm(1)=1; infile = vba_inf; if (vba_get=-10) then; infile = tecrfile; end runwait('tecor') if (vba_get>0) then; type 'Number of files downloaded = '!!char(nfiles);end vba_clas = 'CL #' !! char(maxtab('CL')) type vba_clas !! ' contains ionospheric corrections' if (vba_get>0) then vba_inf= 'X'!!vba_inf; substr(vba_inf,1,1)=' ' default system; syscom '\rm sys2com(1) = vba_inf; system end end if (vba_ok=-6) then type 'You must have a NX table to use this procedure.' type 'Run INDXR or VLBAFIX and try again.' end tget vlbatecr return;finish PROCEDURE VLBACCOR *--------------------------------------------------------------- * Applies digital sampling corrections. * Inputs: * INNAME input file name * INCLASS input file class * INSEQ input file sequence number * INDISK input file disk number * SUBARRAY subarray number * BADDISK bad disk array *--------------------------------------------------------------- tput vlbaccor * Run ACCOR to determine sampling corrections default 'accor'; tget vlbaccor; solint = -0.5 runwait ('ACCOR') * Run SNSMO to clip bad points default 'snsmo'; tget vlbaccor; samptype = 'mwf'; doblank = -1; smotype = 'ampl'; cparm = 0.5, 0, 0, 0, 0, 1 invers = maxtab('SN'); outvers = invers+1; runwait ('SNSMO') * Replace original table with smoothed table inext = 'SN'; extdest; vba_sn = invers; default 'TACOP'; tget vlbaccor; invers = vba_sn + 1; outvers = vba_sn; outname = inname; inext = 'SN'; outclass = inclass; outseq = inseq; outdisk = indisk runwait ('TACOP'); extdest * Apply corrections to CL table default 'CLCAL'; tget vlbaccor; opcode = 'cali' interpol 'self'; snver = vba_sn; doblank = -1 gainver = maxtab('CL'); gainuse = gainver + 1 runwait ('CLCAL') vba_clas = 'SN #' !! char(maxtab('SN')) PRINT vba_clas !! ' contains sampler corrections PRINT 'CL #' !! char(gainuse) !! ' adds sampler corrections tget vlbaccor return;finish PROCEDURE VLBAAMP *--------------------------------------------------------------- * Applies a-priori amplitude corrections. * Inputs: * INNAME input file name * INCLASS input file class * INSEQ input file sequence number * INDISK input file disk number * SUBARRAY subarray number * DOFIT fit opacities * BADDISK bad disk array *--------------------------------------------------------------- SCALAR VBA_SN, VBA_SU, VBA_DOOP tput vlbaamp * Do additional autocorrelation corrections default 'ACSCL'; tget vlbaamp; docal 1; gainuse=maxtab('cl') timerang 0; doband -1; bpver=maxtab('BP'); solint -2 if (bpver > 0) then; doband=1; end if (doband) then runwait ('ACSCL') * Run SNSMO to clip bad points default 'SNSMO'; tget vlbaamp; samptype = 'mwf'; doblank = -1; smotype = 'ampl'; cparm = 0.5, 0,0,0,0, 1 invers = maxtab('SN'); outvers = invers + 1 runwait ('SNSMO') * Replace original table with smoothed table inext = 'SN'; extdest; vba_sn = invers; default 'TACOP'; tget vlbaamp; invers = vba_sn + 1; outvers = vba_sn; outname = inname; inext = 'SN'; outclass = inclass; outseq = inseq; outdisk = indisk runwait ('TACOP'); extdest * Apply corrections to CL table default 'CLCAL'; tget vlbaamp; opcode = 'cali' interpol = 'self'; snver = maxtab('SN'); doblank = -1 gainver = maxtab('CL'); gainuse = gainver + 1 calsour = ''; runwait ('CLCAL') end * Determine a-priori amplitude corrections default 'APCAL'; tget vlbaamp; tyver = maxtab('TY') gcver = maxtab('GC'); snver = 0 IF (dofit(1)>0) THEN; opcode = 'grid'; invers = 1; vba_doop = 1; end runwait ('APCAL') * Apply corrections to CL table default 'CLCAL'; tget vlbaamp; opcode = 'cali'; interpol = 'self'; snver = maxtab('SN') gainver = maxtab('CL');; gainuse = gainver+1; doblank = -1 runwait ('CLCAL') vba_sn = maxtab('SN') vba_clas = 'SN #' !! char(vba_sn - 1) PRINT vba_clas !! ' 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 PRINT 'bad points before continuing IF (VBA_DOOP>0) THEN PRINT 'You have done an opacity correction, you should PRINT 'look at the plots produced by APCAL. END tget vlbaamp RETURN; FINISH PROCEDURE VLBABPSS *--------------------------------------------------------------- * computes spectral bandpass correction table * Inputs: * INNAME input file name * INCLASS input file class * INSEQ input file sequence number * INDISK input file disk number * CALSOUR Bandpass calibrator source(s) * SUBARRAY subarray number * REFANT refernce antenna * DOFIT fit opacities * BADDISK bad disk array *--------------------------------------------------------------- SCALAR VBA_MOD, VBA_NCHAN, BPASS5 tput vlbabpss; vba_mod = 0; j = 0 while ((j < 8) & (substr(keystrng,1,4) <> 'FREQ')) j = j + 1; keyword 'CTYPE'!!char(j); gethead if (substr(keystrng,1,4) = 'FREQ') then keyword 'NAXIS'!!char(j); gethead vba_nchan = keyvalue(1) $ number of channelS end end if (substr(calsour(1),1,1)='') then if (substr(calcode,1,1)='') then; vba_mod=1; end end * Determine bandpass corrections default 'BPASS'; tget vlbabpss; docal 1; solint = -1 bchan 1; echan 0; bpassprm 0 0 vba_mod 0 1 0 0 0 1 6 0 if (bpass5<>0) then; bpassprm(5)=bpass5; end gainuse = maxtab('CL'); ichansel = 1, vba_nchan, 1, 0 runwait ('BPASS') print 'BP #' !! char(maxtab('BP')) !! ' bandpass table tget vlbabpss RETURN; FINISH