$ VLBAPROC $--------------------------------------------------------------- $! Procedures for easy-to-learn VLBA data reduction $# RUN POPS VLBI UTILITY CALIBRATION $----------------------------------------------------------------------- $; Copyright (C) 2000-2004 $; 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 *----------------------------------------------------------------------- SCALAR VBA_NTIM IF CLINT = 0 THEN; CLINT = 1; END VNUM = 35; VPUT VLBALOAD IF SUBSTR(OUTNAME,1,1) = ' ' THEN; OUTNAME = 'MULTI'; END TPUT VLBALOAD * Set defaults for FITLD adverbs: TASK 'FITLD'; DEFAULT; TGET VLBALOAD; TASK 'FITLD' DOCONCAT = 1; WTTHRESH = 0.7; OUTCLASS = 'UVDATA' RUNWAIT ('FITLD') INNAME = OUTNAME; INCLASS = 'UVDATA'; INSEQ = 0; INDISK = OUTDISK CHKNAME FOR VBA_NTIM =1:(-1*ERROR+1) IF (MAXTAB('GC') > 0 ! MAXTAB('TY') > 0) THEN IF MAXTAB ('GC') = 1 THEN TASK 'TACOP'; DEFAULT; TGET VLBALOAD; TASK 'TACOP' INNAME = OUTNAME; INCLASS = 'UVDATA'; INSEQ = VBA_NTIM INDISK = OUTDISK; INEXT = 'GC'; INVERS = 1; NCOUNT = 1 OUTNAME = INNAME; OUTCLASS = INCLASS; OUTSEQ = INSEQ OUTDISK = INDISK; OUTVERS = 2; RUNWAIT ('TACOP'); EXTDEST TASK 'TAMRG'; DEFAULT; TGET VLBALOAD; TASK 'TAMRG' INNAME = OUTNAME; INCLASS = 'UVDATA'; INSEQ = VBA_NTIM INDISK = OUTDISK; INEXT = 'GC'; INVERS = 2; OUTVERS = 1 APARM = 1, 1, 2, 1, 3, 1; BPARM = 1, 2, 3; OUTSEQ = INSEQ RUNWAIT ('TAMRG'); EXTDEST END IF MAXTAB ('PC') = 1 THEN TASK 'TACOP'; DEFAULT; TGET VLBALOAD; TASK 'TACOP' INNAME = OUTNAME; INCLASS = 'UVDATA'; INSEQ = VBA_NTIM INDISK = OUTDISK; INEXT = 'PC'; INVERS = 1; NCOUNT = 1 OUTNAME = INNAME; OUTCLASS = INCLASS; OUTSEQ = INSEQ OUTDISK = INDISK; OUTVERS = 2; RUNWAIT ('TACOP'); EXTDEST TASK 'TAMRG'; DEFAULT; TGET VLBALOAD; TASK 'TAMRG' INNAME = OUTNAME; INCLASS = 'UVDATA'; INSEQ = VBA_NTIM INDISK = OUTDISK; 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; OUTSEQ = INSEQ RUNWAIT ('TAMRG'); EXTDEST END IF MAXTAB ('TY') = 1 THEN TASK 'TACOP'; DEFAULT; TGET VLBALOAD; TASK 'TACOP' INNAME = OUTNAME; INCLASS = 'UVDATA'; INSEQ = VBA_NTIM INDISK = OUTDISK; INEXT = 'TY'; INVERS = 1; NCOUNT = 1 OUTNAME = INNAME; OUTCLASS = INCLASS; OUTSEQ = INSEQ OUTDISK = INDISK; OUTVERS = 2; RUNWAIT ('TACOP'); EXTDEST TASK 'TAMRG'; DEFAULT; TGET VLBALOAD; TASK 'TAMRG' INNAME = OUTNAME; INCLASS = 'UVDATA'; INSEQ = VBA_NTIM INDISK = OUTDISK; 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; OUTSEQ = INSEQ RUNWAIT ('TAMRG'); EXTDEST END TYPE 'your GC, TY and PC tables have been merged' END END * check sort order, if TB then delete NX table and run INDXR TGET VLBALOAD INNAME = OUTNAME; INCLASS = 'UVDATA'; INSEQ = 0; INDISK = OUTDISK CHKNAME FOR VBA_NTIM =1:(-1*ERROR+1) KEYWORD = 'SORTORD'; KEYVALUE = 0; KEYSTRNG = ''; GETHEAD IF SUBSTR(KEYSTRNG,1,2) = 'TB' THEN IF(MAXTAB('NX')>0) THEN; INEXT 'NX'; INVERS 0; EXTD; END TASK 'INDXR'; DEFAULT; TGET VLBALOAD; TASK 'INDXR' INNAME = OUTNAME; INCLASS = 'UVDATA'; INSEQ = VBA_NTIM INDISK = OUTDISK; CPARM = 0, 0, CLINT, TRUE, TRUE, 0 RUNWAIT ('INDXR') END 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 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. TASK 'MSORT'; DEFAULT; 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: TASK 'USUBA'; DEFAULT; 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: TASK 'INDXR'; DEFAULT; TGET VLBALOAD; TASK 'INDXR' 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 TASK 'TACOP'; DEFAULT; TGET VLBAMCAL; TASK 'TACOP' INEXT = 'GC'; INVERS = 1; NCOUNT = 1 OUTNAME = INNAME; OUTCLASS = INCLASS; OUTSEQ = INSEQ OUTDISK = INDISK; OUTVERS = 2; RUNWAIT ('TACOP'); EXTDEST TASK 'TAMRG'; DEFAULT; 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 TASK 'TACOP'; DEFAULT; TGET VLBAMCAL; TASK 'TACOP' INEXT = 'PC'; INVERS = 1; NCOUNT = 1 OUTNAME = INNAME; OUTCLASS = INCLASS; OUTSEQ = INSEQ OUTDISK = INDISK; OUTVERS = 2; RUNWAIT ('TACOP'); EXTDEST TASK 'TAMRG'; DEFAULT; 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 TASK 'TACOP'; DEFAULT; TGET VLBAMCAL; TASK 'TACOP' INEXT = 'TY'; INVERS = 1; NCOUNT = 1 OUTNAME = INNAME; OUTCLASS = INCLASS; OUTSEQ = INSEQ OUTDISK = INDISK; OUTVERS = 2; RUNWAIT ('TACOP'); EXTDEST TASK 'TAMRG'; DEFAULT; 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 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. THIS IS PROBABLY ONLY THE CASE IF THERE ' PRINT 'NO VLBA STATIONS AND THE EXPERIMENT WAS CORRELATED AT THE ' PRINT 'VLBA CORRELATOR. 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 *----------------------------------------------------------------------- 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 * Guess BANDPOL IF VBA_STK1 = -1 THEN BANDPOL = '*(RL)' ELSE BANDPOL = '*(LR)' END * Set up for FXPOL: 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 * 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 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 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; IF(SUBARRAY = 1) THEN; RUNWAIT ('USUBA'); END IF(SUBARRAY = 2) THEN; SUBARRAY = 0; OPCODE = 'AUTO'; RUNWAIT ('USUBA'); END 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; INDISK = OUTDISK * 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_NFQI <= 1 & VBA_SX <= 0 & VBA_9050 <= 0 THEN IF SUBARRAY > 0 ! VBA_SRT = TRUE ! VBA_INDX > 0 THEN * Index data TASK 'INDXR'; DEFAULT; TGET VLBAFIX; TASK 'INDXR' CPARM = 0, 0, CLINT, 1, 1, 0 RUNWAIT ('INDXR') TGET VLBAFIX END 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 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 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 SCALAR VBA_DOOP *----------------------------------------------------------------------- TPUT VLBACALA * Run ACCOR to determine sampling corrections TASK 'ACCOR'; DEFAULT; TGET VLBACALA; TASK 'ACCOR' SOLINT = 2.0; RUNWAIT ('ACCOR') * Run SNSMO to clip bad points TASK 'SNSMO'; DEFAULT; TGET VLBACALA; TASK 'SNSMO' SAMPTYPE = 'MWF'; DOBLANK = -1; SMOTYPE = 'AMPL' CPARM = 0.5, 0, 0, 0, 0, 0.02; INVERS = MAXTAB('SN') OUTVERS = INVERS + 1; RUNWAIT ('SNSMO') * Replace original table with smoothed table INEXT = 'SN'; EXTDEST; VBA_SN = INVERS TASK 'TACOP'; DEFAULT; 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 TASK 'CLCAL'; DEFAULT; TGET VLBACALA; TASK 'CLCAL' OPCODE = 'CALI'; SNVER = VBA_SN; DOBLANK = -1 GAINVER = MAXTAB('CL'); GAINUSE = GAINVER + 1 RUNWAIT ('CLCAL') * Determine a-priori amplitude corrections TASK 'APCAL'; DEFAULT; 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 TASK 'CLCAL'; DEFAULT; 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 'YOU SHOULD VERIFY THAT THESE TABLES CONTAIN NO BAD POINTS' PRINT 'BEFORE CONTINUING' IF(VBA_DOOP>0) THEN PRINT 'You have done an opacity correction, you should look at the' PRINT 'plots produced by APCAL.' END 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') PRINT 'CL #' !! CHAR(GAINUSE) !! ' 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; snver 0 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; snver=0; 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 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 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 if(dotv>=1)then;tvinit;end 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 if(dotv>=1)then;tvinit;end 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);snver=0 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;snver=0 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 $ VLBAPIPE - Lorant Sjouwerman, NRAO - Nov 25 02 $ Ver 1.0 : released to public in July 2002 $ Ver 2.1 : released in MNJ in November 2002 $ Ver 2.2 and further : released to public through MNJ $ Ver 4.0 : now vipspipe for the VIPS survey AUG 04 $--------------------------------------------------------------- $0000000011111111112222222222333333333344444444445555555555666666666677777777778 $2345678901234567890123456789012345678901234567890123456789012345678901234567890 $=============================================== $! Applies amplitude and phase calibration procs to VLBA data $# RUN POPS VLBI UTILITY CALIBRATION IMAGING $--------------------------------------------------------------- $; Copyright (C) 2001-2003 $; 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 P_INIT $ $ Define VLBAUTIL and variables for VLBA pipeline $---------------------------------------------- docrt 1;dowa true SCALAR P_DOALL, P_DOTVPL, P_NTAPES, P_DISK, P_SQ, P_NUM, P_VER SCALAR P_CLINT, P_ANTNUM, P_TECORDAY, P_SOLINT, P_TINT, P_MIN, P_MAX SCALAR P_DOSTART, P_DOTIMER, P_NUMCAL, P_NUMREF, P_FREQUID, P_DOCOMP SCALAR P_ERROR, P_DEBUG, P_SUGGEST, P_ROW, P_FACTOR, P_IFS ARRAY P_IMSIZE(2), P_NSOLINT(10), P_PLCNT(15), P_CLCNT(8) ARRAY P_CALSCANT(8), P_NCOUNT(10), P_BADDISKS(10), P_NO_SLFCL(30) STRING*2 P_REFANT, P_EXT STRING*4 P_TYP, P_MODE, P_INTERPOL STRING*6 P_CL, P_CLASS STRING*8 P_TASK STRING*12 P_EXPNA, P_NA STRING*16 P_CALSOURC(30), P_ATARGETS(30) STRING*48 P_TECORFLE $ from input dialog: P_DOALL = DOALL ;P_DOTVPL = DOTV ;P_NTAPES = NCOUNT P_NCOUNT = APARM ;P_EXPNA = OUTNAME ;P_DISK = OUTDISK P_CLINT = CLINT ;P_ANTNUM = REFANT ;P_REFANT = SORT P_CALSCANT = TIMERANG ;P_TECORFLE = INFILE ;P_TECORDAY = NFILES P_INTERPOL = INTERPOL ;P_CALSOURC = CALSOUR ;P_MODE = OPTYPE P_FACTOR = FACTOR ;P_ATARGETS = SOURCES ;P_BADDISKS = BADDISK P_SOLINT = SOLINT ;P_NSOLINT = BPARM ;P_IMSIZE = IMSIZE P_DOCOMP = DOUVCOMP $--- P_DOTIMER = 0 ;P_ERROR = 0 ;P_SUGGEST = 1 $--- and set to defaults tput vipspipe;vnum 35;vput vipspipe;task'vipspipe';default VBA_NFQI=0;VBA_SX=0;VBA_9050=0 $ must be 0 in VLBAUTIL, used in P_GETFQNUM RETURN;finish $=============================================== PROCEDURE P_RESTART clrstat;inext'pl';j = maxtab(inext);if (j>0) then;invers -1;extdest;end ine'bp';j = maxtab(inext);if (j>0) then;invers -1;extdest;end ine'fg';j = maxtab(inext);if (j>1) then;for i=2:j;invers i;extdest;end;end ine'cl';j = maxtab(inext);if (j>1) then;for i=2:j;invers i;extdest;end;end ine'sn';j = maxtab(inext);if (j>0) then;invers -1;extdest;end clrtemp RETURN;finish $=============================================== PROCEDURE P_RESET p_restart RETURN;finish $=============================================== PROCEDURE P_ZAPALL chkname;if (error<1) then;indisk p_disk;for j=1 to (1-1*error);zap;end;end RETURN;finish $=============================================== PROCEDURE P_ALLPLOT(P_MIN) if(p_min=0)then;p_min=1;end;p_max=maxtab('PL');j=p_max-p_min+1 type char(j)!!' PLOT FILES TO SHOW ON TV:'!!char(p_min)!!' TO:'!!char(p_max) if (j > 0) then; tvinit; for i=p_min:p_max;plver i type 'plot #'!!char(i-p_min+1)!!'/'!!char(j)!!' -- TYPE A ZERO TO STOP' grchan=0;grclear;runwait('tvpl');p_num=1;clrtemp;read p_num if (p_num=0) then;i=p_max+1;end;end else;type 'NOTHING TO PLOT - DONE';end RETURN;finish $=============================================== PROCEDURE P_SETPRINT printer 999;type '';type 'BLINDLY PRINTING ALL OUTPUT IS HIGHLY DISCOURAGED!' type 'FOR VIPSPIPE AND VIEWING WITH P_ALLPLOT(1) AFTERWARDS TYPE ZERO' type 'SELECT PRINTER (PREVIEWER OR A ZERO IS RECOMMENDED, STOP=-1)';read j if (j=-1) then;p_error=1;else;if (j=0) then;p_dotvpl=0;else;printer j;end;end RETURN;finish $=============================================== PROCEDURE P_ALLPRINT p_setprint j = maxtab('PL');type 'TOTAL NUMBER OF PLOT FILES SENT TO PRINTER :'!!char(j) if (j > 0) then plver 1;invers j;lpen 1;dparm 0;outfile'';copies 1;runwait('lwpla') else;type 'NOTHING TO PLOT - DONE';end RETURN;finish $=============================================== PROCEDURE P_INFO (P_TASK) if (p_debug > 0) then task p_task;type '*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*' inp;type '*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*'; j = 1 type 'TYPE RETURN TO CONTINUE, ZERO TO STOP';read j if (j = 0) then;type 'OK, STOPPING AT' p_task;p_error = 99;end end;type p_task!!' RUNNING ..' RETURN;finish $=============================================== PROCEDURE P_GETSTOK $ NOTE: sets stokes (default/undetermined -> stokes = '') keyvalue 0;keystrng '';j = 0 while ( (j < 8) & (substr(keystrng,1,6) <> 'STOKES') ) j = j + 1;keyword 'ctype'!!char(j);gethead if (substr(keystrng,1,6) = 'STOKES') then keyword 'crval'!!char(j);gethead if (keyvalue(1) = -1) then;stokes = 'RR' else if (keyvalue(1) = -2) then;stokes = 'LL' else if (keyvalue(1) = 1) then;stokes = 'I' else;stokes = ' ';end;end;end;clrtemp end end RETURN;finish $=============================================== PROCEDURE P_SEFD (P_EXT, P_TYP, P_TINT) $ Scales the flux/noise parameters (~V2*SEFD) for P_EXT = BaseLine or IMage $ NOTE: sets FLUX for UVMLN, and STOKES, NITER and FLUX for IMAGR niter = sqrt(fldsize(1,1)*fldsize(2,1)) $ sensible MAX iterations, I presume p_getstok;keyvalue 0;keystrng '';j = 0 while (j < 8) $ find proper axes j = j + 1;keyword 'ctype'!!char(j);gethead if (substr(keystrng,1,4) = 'FREQ') then keyword 'crval'!!char(j);gethead;p_max = keyvalue(1) $ obs frequency keyword 'cdelt'!!char(j);gethead;p_min = keyvalue(1) $ channel bandwidth keyword 'naxis'!!char(j);gethead;p_num = keyvalue(1) $ number of channels end if (substr(keystrng,1,2) = 'IF') then keyword 'naxis'!!char(j);gethead;p_ifs = keyvalue(1) $ number of IFs end;clrtemp end $ * * * * find freq -> sefd $ * * * * find mode (typ) -> TBW (assume 2bit) and get #vis for ext=im - not bl RETURN;finish $=============================================== PROCEDURE P_SNPLOT (P_NA, P_CL, P_SQ, P_EXT, P_VER, P_TYP, P_MIN, P_MAX, P_NUM) task'snplt';default;inname p_na;inclass p_cl;inseq p_sq;indisk p_disk inext p_ext;invers p_ver;pixrange p_min,p_max;nplots p_num;optype p_typ dotv p_dotvpl if (p_typ = 'DDLY') then;p_getstok;end $ only one (first) stokes needed $ p_info('snplt') if (p_error = 0) then if (p_dotvpl > 0) then; dotv 1;runwait('snplt') $ plot on tv type 'PLOTTING FINISHED, PRESS RETURN TO CONTINUE THE PROCEDURE';read else;dotv -1;plver = p_ver;runwait('snplt') if (p_dotvpl < 0) then;invers = p_ver;runwait('lwpla');invers 0;end end;dotv p_dotvpl;end;timerang p_calscant;clrtemp RETURN;finish $=============================================== PROCEDURE P_CRPLOT (P_EXT, P_TYP) inext p_ext;optype p_typ;timerang 0;sources '';nplots 8; $p_info('vlbacrpl') if (p_error = 0) then if (p_dotvpl > 0) then; dotv 1;go vlbacrpl $ plot on tv type 'PLOTTING DONE, PRESS RETURN TO CONTINUE WITH THE PROCEDURE';read else;dotv -1;plver = maxtab('PL');go vlbacrpl if (p_dotvpl < 0) then $ divert to printer) invers = maxtab('PL');runwait('lwpla');invers 0 end;end;dotv p_dotvpl;end;timerang p_calscant;clrtemp RETURN;finish $=============================================== PROCEDURE P_GETFQNUM $ NOTE: resets VBA_NFQI, uses settings VBA_SX and/or VBA_9050 from VLBAUTIL inext'fq';invers 1;keyword = 'num row';getthead;VBA_NFQI=keyvalue(1);clrtemp if (VBA_SX > 0) then;VBA_NFQI = VBA_NFQI + 1;end $ add one for S/X band if (VBA_9050 > 0) then;VBA_NFQI = VBA_NFQI + 1;end $ add one for 90/50 band RETURN;finish $=============================================== PROCEDURE P_GETSUROW $ NOTE: proc sets p_row inext'su';invers 0;keyword'num row';getthead;p_row = keyvalue(1);clrtemp RETURN;finish $=============================================== PROCEDURE P_EXIT $ Restore values vnum 35;vget vipspipe;dowait -1;vnum 0;clrtemp RETURN;finish $=============================================== PROCEDURE P_GETUVF $ $ Determine UV file class to work on $ NOTE: proc sets P_CLASS $---------------------------------------------- inname p_expna;inseq 1;indisk p_disk;intype 'uv';inclass 'fxpol';chkname if (error = 0) then;p_class inclass $ dual polarization, one frequency else;inclass 'fpol'!!char(p_frequid);chkname;clrtemp if (error = 0) then $ dual pols and multi freq with new outclass;del old p_class inclass;inclass 'fq-'!!char(p_frequid);p_zapall;recat else;inclass 'fq-'!!char(p_frequid);chkname;clrtemp if (error = 0) then;p_class inclass $ polarizations okay, multiple freqs else;p_class 'uvdata';end;end $ polarizations okay, single frequency end;inclass p_class;clrtemp RETURN;finish $=============================================== PROCEDURE P_PRECHECK $ $ Prepare and check inputs for VLBA pipeline $ NOTE: proc sets p_dotimer and p_dostart $---------------------------------------------- if (p_dotvpl < 0) then; type 'YOU SELECTED DOTV=-1'; p_setprint; end $ check intape ? maybe search for file to use? if (p_doall < 0) then $ start at (negative) frequency ID p_dostart = mod(-1 * p_doall, 1000);clrtemp if (p_error = 0) then type 'SKIPPING LOAD, ASSUMING INNAME IS CORRECT' if (p_doall < -1000) then type 'ONLY DOING FREQUENCY ID #'!!char(p_dostart) else;type 'STARTING WITH FREQUENCY ID #'!!char(p_dostart);end end else;p_dostart = 1;end $ also for p_doall = 0, start at first freq-ID $ check number of tapes and corresponding aparm in case of load if (p_doall > 0) then if (p_ntapes = 0) then;type 'NO TAPES ?? - TRY AGAIN';p_error = 1 else i = 0;clrtemp while (i < p_ntapes) $ check if all tapes have number of files specified i = i + 1 if ( p_ncount(i) < 1 ) then type 'NUMBER OF FILES ON TAPE #'!!char(i)!!' TOO LOW - TRY AGAIN' p_error = 2 end;end;clrtemp for i = (i + 1) to 10 $ check if rest aparm is zero - typo/more tapes ?? if ( p_ncount(i) > 0 ) then type 'MORE FILES EXPECTED ON A NON-DECLARED TAPE - TRY AGAIN AND' type 'SPECIFY LARGER NCOUNT OR RESET NON-USED APARM('!!char(i)!!')' p_error = 3 end;end;end;end;clrtemp if (p_doall > 0) then if (p_docomp=0) then;type 'LOADING UNCOMPRESSED, SPLITTING COMPRESSED DATA' else; if (p_docomp=-1) then; type 'NOT COMPRESSING DATA AT ANY STAGE' else; if (p_docomp=1) then; type 'COMPRESSING DATA FROM NOW ON' else; type 'VALUE OF DOUVCOMP NOT SUPPORTED - STOP!'; p_error=5;end;end;end else if (p_docomp>=0) then;type 'SPLITTING RESULTS IN COMPRESSED DATA' else; if (p_docomp=-1) then; type 'SPLITTING DATA IN CURRENT COMPRESSION' else; type 'VALUE OF DOUVCOMP NOT SUPPORTED - STOP!'; p_error=5;end;end end $ check outname and tell it changes to header value if (substr(p_expna,1,1) = ' ') then type 'SPECIFY AN UNIQUE OUTNAME, E.G. YOUR EXPERIMENT NAME + SEGMENT' p_error = 4;clrtemp end $ check if outfile already exists - p_restart or bomb?? (latter) $ check outdisk ? $ spectral line data or continuum data to be expected? if (p_mode = 'LINE') then; p_mode = 'SPEC'; end if (p_mode = 'SPEC') then $ apparently spectral line type 'DOING SPECTRAL LINE PROCEDURE: NO P-CAL OR FREQUENCY AVERAGING' else if (p_mode = 'CONT') then $ apparently continuum type 'DOING CONTINUUM PROCEDURE: WITH P-CAL AND FREQUENCY AVERAGING' else if (p_mode = 'PSEU') then $ pseudo continuum type 'DOING PSEUDO CONTINUUM PROCEDURE: ';clrtemp type ' WITH P-CAL BUT -NO- FREQUENCY AVERAGING' else type 'OBSERVATION MODE NOT KNOWN - FILL IN "OPTYPE" PROPERLY';p_error 1 end;end;end;clrtemp $ check reasonable clint later ? $ check refant and corresponding sort, check if refant in array later if ( p_antnum < 0 ) then; type 'REFANT < 0 UNVALID ! - STOPPING'; p_error 11; else; if ( p_antnum = 0 ) then; if (p_refant<>'BR') then;if (p_refant<>'FD') then;if (p_refant<>'HN') then; if (p_refant<>'KP') then;if (p_refant<>'LA') then;if (p_refant<>'MK') then; if (p_refant<>'NL') then;if (p_refant<>'OV') then;if (p_refant<>'PT') then; if (p_refant<>'SC') then;type 'NON-VLBA REFERENCE ANTENNA .. ARE YOU SURE?' end;end;end;end;end;end;end;end;end;end;end;end;clrtemp $ check infile and number of infiles later (see if they exist here?) if (p_tecorday > 0) then $ run tecor, check infile exits if (substr(p_tecorfle,1,1) = ' ') then $ no file specified type 'SPECIFY A TECOR FILE; MAKE SURE IT IS ANONYMOUS-FTP-ED FROM:' type 'CDDISA.GSFC.NASA.GOV/GPS/PRODUCTS/IONEX//' p_error = 8 else * check here if it exists.. can I? end else;type 'TECOR NOT RUN AS REQUESTED BUT RECOMMENDED FOR FREQ <= 15GHZ';end $ check timerange and corresp scantime, check if in data and in calsour later i = 1 while (i < 8) $ if timer(2) or above non-zero, timer is specified (not scan) i = i + 1;if (p_calscant(i) > 0) then;p_dotimer = 1;end end;clrtemp if ( (p_dotimer > 0) & (p_error = 0) ) then type 'USING SPECIFIED TIMERANGE FOR VLBAPCOR OR VLBAMPCL' i = p_calscant(5) - p_calscant(1) i = p_calscant(6) - p_calscant(2) + 24 * i i = p_calscant(7) - p_calscant(3) + 60 * i if ( (p_calscant(8) - p_calscant(4) + 60 * i) < 1 ) then type 'BUT NOW ENDING TIME PRECEEDS STARTING TIME - TRY AGAIN' p_error = 6 end else if (p_calscant(1) = 0) then type 'NO CALIBRATOR SCAN NUMBER OR SCAN TIME SPECFIED - TRY AGAIN' p_error = 7 else;type 'USING SPECIFIED SCAN NUMBER INSTEAD OF TIMERANGE';end end;clrtemp $ check later if in data p_numcal = 0;i = 0;clrtemp while (i < 30) $ count number of sources in calsour, do self-cal ? i = i + 1 if (substr(p_calsourc(i),1,1) <> ' ') then p_numcal = p_numcal + 1 if (substr(p_calsourc(i),1,1) = '-') then j = length(p_calsourc(i)) p_calsourc(i) = substr(p_calsourc(i),2,j) if (substr(p_calsourc(i),1,1) = '*') then type 'SORRY HAVE TO EXIT: NO SELF CAL ALLOWED FOR CALSOUR = *' p_error = 12 end;p_no_slfcl(i) = 0 else;p_no_slfcl(i) = 1;end end;end;clrtemp;p_numref = 0;i = 0;clrtemp while (i < 30) $ count number of sources targeted (incl its Ph-Ref.) i=i+1;if (substr(p_atargets(i),1,1)<>' ') then;p_numref=p_numref+1;end end if (p_numref = 0) then $ use calsour only (only strong sources, no Ph-Ref) type 'NO PHASE-REF SCHEME SPECIFIED, ASSUMING ALL SOURCES ARE STRONG' if (p_numcal = 0) then $ no sources specified ! $ type 'BUT NO CALIBRATOR SOURCES SPECIFIED ! TRY AGAIN' type 'AT LEAST ONE CALSOURCE NEEDED - FOR P-CAL/BANDPASS CALIBRATION' p_error = 8 else if (substr(p_calsourc(2),1,1)='*') then type 'WILL FRINGE FIT ALL SOURCES THAT ARE FOUND IN THE SU-TABLE' p_no_slfcl = 1 else type 'WILL FRINGE FIT ALL SOURCES IN CALSOUR, I.E. :'!!char(p_numcal) end;end;end;clrtemp $ if sources, check if p_numref even (pairs), borrow p_num for loop $ check later if in data, but here check if odd numbers are in calsource if (substr(p_atargets(1),1,1) <> ' ') then if (mod(p_numref,2) = 1) then $ odd number of sources type 'ODD NUMBER OF SOURCES - SPECIFY PHAS-REF *PAIRS* !!' p_error = 8 else $ check if odd numbered are in calsour, evens not in calsour for i = 1 to p_numref by 2 j = length(p_atargets(i));p_num = 1 while ( (j < 17) & (substr(p_calsourc(p_num),1,1) <> ' ') ) if (substr(p_calsourc(p_num),1,j)=substr(p_atargets(i),1,j)) then j = 17 $ found! stop the while loop else;p_num = p_num + 1;end $ not found .. next end if (j <> 17) then $ source not found but should be there type 'CALSOUR DOES NOT, BUT SHOULD, INCLUDE PH-REF. SOURCE :'!!p_atargets(i) p_error 9 end;end;clrtemp for i = 2 to p_numref by 2 j = length(p_atargets(i));p_num = 1 while ( (j < 17) & (substr(p_calsourc(p_num),1,1) <> ' ') ) if (substr(p_calsourc(p_num),1,j)=substr(p_atargets(i),1,j)) then j = 17 $ found! stop the while loop else;p_num = p_num + 1;end $ not found .. next end if (j = 17) then $ source found but should not be there type 'CALSOUR DOES, BUT SHOULD NOT, INCLUDE PH-REF. SOURCE :'!!p_atargets(i) p_error 9 end;end p_numref = p_numref / 2 $ # of pairs;can do because p_numref even end if ( (p_numref = 1) & (p_atargets(2) = '*') ) then type 'PHASE-REFERENCING ALL NON-CALIBRATORS TO :'!!p_atargets(1) end;end;clrtemp $ check solint/bparm and interpol if (p_solint > 0) then for j=1:10;if (p_nsolint(j)>0) then;p_error=40;end;clrtemp if (p_error=40) then;type'USE SOLINT OR BPARM, NOT BOTH - STOPPING' else; type'WILL USE SAME SOLINT FOR ALL FREQUENCY-IDS';j=11;end;end else;if (p_solint=0) then;type'SOLINT ZERO NOT SUPPORTED';p_error=41;else if (p_solint=-1) then;type'USING IN BPARM SPECIFIED SOLINT PER FREQ-ID' if (p_nsolint(1)<=0) then;type'BUT THEN ALSO SUPPLY BPARMS';p_error=42;else if (p_nsolint(2)<=0) then;type'FOR ONE FREQ-ID USE SOLINT';p_error=43;end end;end;end;end;clrtemp $ check if (p_interpol<>'2PT') then;if (p_interpol<>'SIMP') then; if (p_interpol<>'AMBG') then;if (p_interpol<>'CUBE') then; type 'CALIBRATION INTERPOLATION METHOD NOT RECOGNIZED - HELP!';p_error=50 end;end;end;end;clrtemp $ check map sizes for factor and imsize if (p_factor < 1) then;p_factor = 1 type 'WILL NOT DO CALSOUR IMAGES SMALLER THAN 128 SQUARE; 128 IT IS' else;if (p_factor > 64) then;p_factor = 64 type 'CALSOUR IMAGE REQUEST TOO BIG, WILL USE THE MAXIMUM OF 8192 SQUARE' end;end;clrtemp if (substr(p_atargets(1),1,1) <> ' ') then if ( (p_imsize(1) < 512) ! (p_imsize(2) < 512) ) then;p_imsize = 512 type 'WILL NOT DO SOURCES IMAGES SMALLER THAN 512 SQUARE; 512 IT IS' else if ( (p_imsize(1) > 8192) ! (p_imsize(2) > 8192) ) then;p_imsize = 8192 type 'SOURCE IMAGE REQUEST TOO BIG, WILL USE THE MAXIMUM OF 8192 SQUARE' end;end;end;clrtemp $ include subarray , change into vlbafix ?? * if (p_debug > 0) then;type 'P_PRECHECK ERROR = '!!char(p_error);end RETURN;finish $=============================================== PROCEDURE P_LOAD $ $ Load data and split freq-id's to prepare for VLBA pipeline $ NOTE: proc sets VBA_NFQI $---------------------------------------------- if (p_doall > 0) then $ start loading data intape p_doall;nfiles 0;outname p_expna;outdisk p_disk;clint p_clint if (p_docomp = 0) then;douvcomp=-1;else;douvcomp=p_docomp;end for i = 1 to p_ntapes type 'MOUNT TAPE #'!!char(i)!!' NOW OR ENTER A NON-ZERO VALUE TO STOP' type 'TO MOUNT THE TAPE, ENTER ZERO *AFTER* TAPE DRIVE HAS SETTLED' read j;ncount p_ncount(i);clrtemp if (j <> 0) then;type 'OK, STOPPING ON YOUR REQUEST';p_exit;p_error 99 else if (i = p_ntapes) then type 'UNLESS DOTV > 0, YOU CAN GO HOME NOW; REST WILL BE AUTOMATIC' type 'PROVIDED THAT ALL INPUTS EXIST AND ARE VALID SO I WONT BREAK' end;p_info('vlbaload') if (p_error = 0) then;mount;go vlbaload;dismount;end;recat;clrtemp end;end;if (p_error = 0) then;type 'DONE WITH LOADING THE DATA';end;end if (p_error = 0) then;p_getuvf;p_restart;baddisk p_baddisks if (p_antnum = 0) then; p_antnum = antnum(p_refant) type 'USING REFERENCE ANTENNA #'!!char(p_antnum)!!'='!!p_refant; end if ( (p_doall>=0) & (p_dostart=1) ) then;p_info('vlbamcal') $ fresh file $ also do new index here? if (p_error = 0) then;go vlbamcal;clint p_clint $ QUACK HERE p_info('vlbafix');if (p_error = 0) then;go vlbafix;end;end else;p_getfqnum;end $ make sure VBA_NFQI is (re-)defined with restart end;clrtemp RETURN;finish $=============================================== PROCEDURE P_INSTCAL $ $ Amplitude and instrumental phase calibration per freq-id $ NOTE: proc sets VBA_PAIR $---------------------------------------------- if (p_error = 0) then;p_getuvf $ find uvfile to work on freqid 1;subarray 1 $ after vlbafix splitted into single freq/suba p_info('vlbacala') if (p_error = 0) then go vlbacala;i = maxtab('sn');j = maxtab('cl');p_plcnt(1) = maxtab('pl') p_snplot(inname, inclass, 1, 'cl', j-2, 'amp', .8, 1.1, 8) $ #1 p_plcnt(2) = maxtab('pl'); clrtemp p_snplot(inname, inclass, 1, 'sn', i-1, 'amp', .7, 1.1, 8) $ #1 p_plcnt(3) = maxtab('pl'); clrtemp * p_snplot(inname, inclass, 1, 'cl', j-1, 'amp', .7, 1.1, 8) $ #2 p_plcnt(4) = maxtab('pl'); clrtemp p_snplot(inname, inclass, 1, 'sn', i, 'amp', 0, 0, 8) $ #2 p_plcnt(5) = maxtab('pl'); clrtemp * p_snplot(inname, inclass, 1, 'cl', j, 'amp', 0, 0, 8) $ #3 p_plcnt(6) = maxtab('pl'); clrtemp $ outseq p_frequid;outclass '';runwait('tasav') p_clcnt(1) = j-2;p_clcnt(2) = j-1;p_clcnt(3) = j;p_info('vlbapang') if (p_error = 0) then;go vlbapang;j = maxtab('cl');p_clcnt(4) = j * p_snplot(inname, inclass, 1, 'cl', j, 'amp', 0, 0, 8) $ #4 * p_snplot(inname, inclass, 1, 'cl', j, 'phas', -180, 180, 8) $ #4 p_plcnt(7) = maxtab('pl'); clrtemp if (p_dotimer = 0) then $ chose to supply scan number, not timerange timerang = scantime(p_calscant(1));else;timerang = p_calscant;end calsour p_calsour(1),'';gainuse 0;docal 2;doban -1;opcode'' $if (maxtab('bp') > 0) then;bpver 0;doban 1;end inext'fq';invers 1;keyword = 'no_if';getthead;clrtemp if (keyvalue(1) > 1) then $ if only 1 IF then no need to align IFs .. refant=p_antnum;j = maxtab('pc') $ check for pc table if ( (p_mode = 'SPEC') & (j > 0) ) then type 'WEIRD: FOUND A PC TABLE IN MODE SPEC - WILL NOT USE IT ANYWAY' end if ( (p_mode <> 'SPEC') & (j > 0) ) then $ use pulse-cal tones p_info('vlbapcor');if (p_error = 0) then;go vlbapcor;end else $ spectral-line or pc table missing;do manual pcal p_info('vlbampcl');if (p_error = 0) then;go vlbampcl;end end;i = maxtab('sn');j = maxtab('cl');p_clcnt(5) = j;clrtemp if (p_error = 0) then p_snplot(inname, inclass, 1, 'sn', i, 'phas', 0, 0, 8) $ #3 p_snplot(inname, inclass, 1, 'sn', i, 'dela', 0, 0, 8) $ #3 p_plcnt(8) = maxtab('pl'); clrtemp * p_snplot(inname, inclass, 1, 'cl', j, 'amp', 0, 0, 8) $ #5 * p_snplot(inname, inclass, 1, 'cl', j, 'phas', -180, 180, 8) $ #5 * p_snplot(inname, inclass, 1, 'cl', j, 'dela', 0, 0, 8) $ #5 p_plcnt(9) = maxtab('pl'); clrtemp end;end;end;end;end;clrtemp RETURN;finish $=============================================== PROCEDURE P_EXTRAS $ $ Do some extras: TECOR, BPASS, UVMLN, BPASS $---------------------------------------------- if (p_tecorday > 0) then $ run tecor task 'tecor';infile p_tecorfle;nfiles p_tecorday;j=maxtab('cl');gainver j j = j + 1;gainuse j;apar 1 0;clroname;outd p_disk;p_info('tecor') if (p_error = 0) then runwait('tecor'); p_clcnt(6) = j type 'CL #'!!char(j)!!' ADDS TOTAL ELECTRON CONTENT CORRECTIONS' p_snplot(inname, inclass, 1, 'cl', j, 'ddly', 0, 0, 10) $ #6 p_plcnt(10) = maxtab('pl'); clrtemp * p_snplot(inname, inclass, 1, 'cl', j, 'phas', -180, 180, 8) $ #6 p_plcnt(11) = maxtab('pl'); clrtemp end else $COPY over THE next CLTABLE ?? end;clrtemp task'tacop';inext'fg';invers 0;outvers 0;ncount 1;keyword'';keyval 0 outclass'';outdisk indisk;if (maxtab('fg') > 0) then;runwait('tacop');end task 'clipm';docal 2;aparm 100, 0;timer 0;p_info('clipm') if (p_error = 0) then type 'CLIPPING HIGH AMPLITUDE VALUES (OVER 100 JY)';runwait('clipm') end;clrtemp task 'bpass';calsour p_calsourc(1),'';solint -1;bpver 1;flux 0;timerang 0 antenna 0;bchan 1;echan 0;bpassprm 1 0 1 0 0 0 0 1 1 1 0;stokes'' gainuse=maxtab('cl');refant=p_antnum;p_info('bpass');clrtemp if (p_error = 0) then vput bpass;runwait('bpass');task 'uvmln';docal 2;doban 1;bpver 1;flagver 0 flux .01 $ -- is this safe?? -- **** Here P_SEFD to determine flux p_info('uvmln') if (p_error = 0) then type 'RUNNING UVMLN TO FLAG OUTLYERS WITH FLUX LEVEL 0.01' runwait('uvmln');vget 'bpass';bpver 2;type 'DETERMINING SCALAR BANDPASS' runwait('bpass');task'possm';bpver 0;apa 0 1 .5 1.3,-20 20 0 2 1 0 baseline 0;antennas 0;outfile '' nplots 6;solint 0;dotv p_dotvpl;gainuse=maxtab('cl');runwait('possm') p_plcnt(12) = maxtab('pl'); clrtemp end;end;clrtemp RETURN;finish $=============================================== PROCEDURE P_FRING $---------------------------------------------- $ First do all clcals on calsources, then the pairs if (substr(p_calsourc(2),1,1)='*') then calsour '';sources '';p_getsurow;p_numcal = p_row $ do all sources else calsour p_calsourc;sources p_calsourc $ includes phase-refs, not targets end $LORANT for VIPS sources'' * search = 0 $ better make sure solutions exist search = antnum('PT'),antnum('LA'),antnum('KP'),antnum('FD'),antnum('OV') search(6)~antnum('NL'),antnum('BR'),antnum('NH'),antnum('SC'),antnum('MK') bchan 0;interpol p_interpol;aparm(6) 1;aparm(9) 1;baddisk p_baddisks;clrtemp if (p_solint = -1) then;solint = p_nsolint(p_frequid) else;solint = p_solint;end;dparm(8) 0;refant=p_antnum;p_info('vlbafrng') if (p_error = 0) then go vlbafrng;gainuse=maxtab('cl');vput clcal $ -- for phase-ref if ((p_numref>0)&(p_atargets(2)<>'*')) then $ sources not empty, nor all for i = 1 to p_numref $ vlbafrng did all cals, now do the pairs j = length(p_atargets(2*i));p_getsurow;keystrng'' while ((p_row>0)&(substr(p_atargets(2*i),1,j)<>substr(keystrng,1,j))) inext'su';pixxy p_row 2 0;tabget if (substr(p_atargets(2*i),1,j) = substr(keystrng,1,j)) then $ found p_row = -1;p_error = 0 else;p_row = p_row - 1;p_error = 31;end end;clrtemp if (p_error = 0) then $ source found;check for reference j = length(p_atargets(2*i-1));p_getsurow;keystrng'' while ((p_row>0)&(substr(p_atargets(2*i-1),1,j)<>substr(keystrng,1,j))) inext'su';pixxy p_row 2 0;tabget if (substr(p_atargets(2*i-1),1,j)=substr(keystrng,1,j)) then $found p_row = -1;p_error = 0 else;p_row = p_row - 1;p_error = 32;end end;clrtemp if (p_error = 32) then type 'TARGET IN UV DATA FILE, BUT REFERENCE NOT - CANNOT DO THIS !!' end else type 'COULD NOT FIND TARGET IN UV DATA FILE - NOTHING TO REFERENCE' $ keep p_error non-zero to avoid next clcal end;clrtemp if (p_error = 0) then $ pair observed in this freq-ID vget clcal;interpol p_interpol;sources p_atargets(2*i), '' calsour p_atargets(2*i-1), '';p_info('clcal') if (p_error = 0) then;runwait('clcal');vput clcal type '**'!!calsour(1)!!' USED TO PHASE-REFERENCE :'!!source(1)!!'**' end else type 'THUS :' p_atargets(2*i-1) p_atargets(2*i) type ' AS PHASE REFERENCE PAIR SKIPPED - NOT AS PAIR IN UV DATA SET' $ reset p_error to finish loop and program p_error = 0 end;end;clrtemp else if (p_atargets(2) = '*') then vget clcal;interpol p_interpol;calsour p_atargets(1), '' for i=1:p_numcal;sources(i)='-'!!p_calsourc(i);end $ not the cal's p_info('clcal') if (p_error = 0) then runwait('clcal') type '** ALL NON-CALIBRATORS PHASE-REFERENCED TO :'!!calsour(1)!!'**' end;end;end;clrtemp;i = maxtab('sn');j = maxtab('cl'); p_clcnt(7) = j if (p_error = 0) then p_snplot(inname, inclass, 1, 'sn', i, 'phas', -180, 180, 8) $ #4 p_snplot(inname, inclass, 1, 'sn', i, 'dela', 0, 0, 8) $ #4 p_snplot(inname, inclass, 1, 'sn', i, 'rate', 0, 0, 8) $ #4 p_plcnt(13) = maxtab('pl'); clrtemp p_snplot(inname, inclass, 1, 'sn', i, 'snr', 0, 0, 8) $ #4 p_plcnt(14) = maxtab('pl'); clrtemp p_snplot(inname, inclass, 1, 'cl', j, 'amp', 0, 0, 8) $ #7 p_snplot(inname, inclass, 1, 'cl', j, 'phas', -180, 180, 8) $ #7 p_snplot(inname, inclass, 1, 'cl', j, 'dela', 0, 0, 8) $ #7 p_snplot(inname, inclass, 1, 'cl', j, 'rate', 0, 0, 8) $ #7 p_plcnt(15) = maxtab('pl'); clrtemp end;end;clrtemp RETURN;finish $=============================================== PROCEDURE P_SPLIT $ $ Split data for this frequency ID $---------------------------------------------- task 'split';outdisk indisk;sources'';doban 1;bpver=maxtab('bp');gainuse 0 if (p_docomp = 0) then;douvcomp=1;else;douvcomp=p_docomp;end timerang 0;outseq p_frequid;outclass substr(p_expna,1,6);keyword'naxis3' gethead;bchan 1;echan keyvalue(1);nchav 0 if (p_mode <> 'CONT') then $ pseudo cont or spectral line, no freq averaging aparm 0; $type char(echan)!!' CHANNELS KEPT UNAVERAGED IN SINGLE SOURCE DATA' else $ continuum, grab all together aparm 1 0; $type char(echan)!!' CHANNELS AVERAGED IN SINGLE SOURCE DATA' end;aparm(4)=1;outclass'';solint 0;p_info('splat') if (p_error=0) then;runwait('splat');end;clrtemp;type'DOING VIPS SPLIT NOW' if (p_error=0) then;bif 4;eif 4;outclass'tburr';stokes'rr';keyword'crval3' gethead;if (keyval(1)<6e10) then;bif 3;eif 3;outclass'tbcrr';end aparm 1 0;sources p_calsourc;runwait('split');end;clrtemp inclass'splat';task'indxr';bparm 0;prtlev 0;infile'';in2file'';cparm 0 cparm(3) 10/60;runwait('indxr');task'fittp';p_getsurow;p_sq=1 while (p_sq<=p_row) inname p_expna;inclass p_class;inseq 1;inext'su';pixxy p_sq 2 0;tabget inname keystrng;inseq p_frequid;outseq p_frequid;inclass 'tburr';chkname if (error > 0) then;inclass 'tbcrr';chkname;end if (error < 1) then $ if (inclass = 'TBCRR') then;outfile='VIPS-05:';else;outfile='VIPS-15:';end outfile'VIPSDATA:'!!inname!!'.'!!inclass; doall -1;outtap 1;doeot 1;dostok -1;donewta 1;format 0;blocking 10;catno 0 type 'TARGET :'!!inname!!' NOW BEING WRITTEN IN VIPSDATA';runwait('fittp') end;clrtemp;p_sq = p_sq + 1; end RETURN;finish $=============================================== PROCEDURE P_SETCELL (P_TYP) $ NOTE: sets cellsize, bchan, echan and nchav for imagr keyword'crval3';gethead;cellsize 2.25e6/keyv(1);bchan 1;echan 1;nchav 1 if (p_typ <> 'CONT') then $ spec cube or otf-avg channels keyword'naxis3';gethead;echan = keyvalue(1); if (p_typ = 'PSEU') then;nchav = keyvalue(1);else $ skip few channels if (p_typ = 'SPEC') then;bchan = ceil(echan/10);echan = floor(echan*9/10) if (bchan = 1) then;bchan = 2;end;else $ ie first channel usually empty type 'CANNOT DETERMINE IMAGE PARAMETERS';p_error = 15;end;end end;clrtemp RETURN;finish $=============================================== PROCEDURE P_SCMAP(J) task'imagr';imsize 128;nit 5000;flux 5e-4;sources'';timerang 0;docal -1 gainuse 0;outdisk 2;uvwtfn'na';imagrp(1) 25;imagrp(10) 1;doband -1;invers 0 dotv p_dotvpl;inseq p_frequid;outn'';outseq p_frequid;outdisk p_disk fldsize p_factor*128 p_factor*128 0;minpatch fldsize(1,1);intype'uv' for i = j to p_numcal if (substr(p_calsourc(2),1,1)='*') then p_getuvf;inext'su';pixxy i 2 0;tabget;inname keystrng;inseq p_frequid else;inname p_calsourc(i);end inclass substr(p_expna,1,6);clrtemp;chkname if (error < 1) then $ always continuum image of strong sources (if > 10 vis) p_setcell('PSEU');timerang 0;keyword'gcount';gethead if ( (keyvalue(1) > 10) & (p_error = 0) ) then type 'CALIBRATOR :'!!inname!!' BEING IMAGED NOW';runwait('imagr') if (substr(p_calsourc(2),1,1)<>'*') then if (p_no_slfcl(i) = 0) then task'scmap';out2disk p_disk;nmaps 4;aparm 3 0;solmode'';docal -1 if (p_solint = -1) then;solint = p_nsolint(p_frequid) else;solint = p_solint;end;runwait('scmap') p_snplot(inname, inclass, inseq, 'sn', 0, 'phas', -20, 20, 8) inc'SWTCHD';chkname if (error < 1) then p_snplot(inname, inclass, inseq, 'sn', 0, 'phas', -20, 20, 8) p_snplot(inname, inclass, inseq, 'sn', 0, 'amp', .5, 2, 8) pixrang 0 end;end;end;end;clrtemp;end;end;clrtemp for i = 1 to p_numcal if (substr(p_calsourc(2),1,1)<>'*') then inname p_calsourc(i);inc'SCMAP';p_zapall $$ inc'SWTCHD';p_zapall inclass'IBM001';inseq 0;indisk p_disk;intype'ma';p_zapall inclass'RBM001';p_zapall;inclass'LBM001';p_zapall else inname p_expna;inclass p_class;inseq 0;ine'su' pixxy i 2 0;tabget;inname keystrng inclass'IBM001';inseq 0;intype'ma';indisk p_disk;p_zapall inclass'RBM001';p_zapall;inclass'LBM001';p_zapall end;intype'uv';end;clrtemp;recat;clrtemp RETURN;finish $=============================================== PROCEDURE P_IMAGR imsize 512;fldsize p_imsize(1) p_imsize(2) 0;outc'' $ now do targets only if (p_numref > 0) then if (substr(p_atargets(2),1,1)='*') then inname p_expna;inclass p_class;p_getsurow;p_numref=p_row-p_numcal;p_sq=1 end;clrtemp for i = 1 to p_numref if (substr(p_atargets(2),1,1)='*') then j = 0;inname p_expna;inclass p_class;inseq 1;inext'su' while ((p_sq<=p_row)&(j<>17)) pixxy p_sq 2 0;tabget;p_num = 1;j = length(keystrng) $ max 12 while ( (j<17) & (p_num<=p_numcal) ) if (substr(p_calsourc(p_num),1,j)=substr(keystrng,1,j)) then j = 17;p_sq = p_sq + 1 $ found, stop comparing, take next else p_num = p_num + 1;end end;if (j <> 17) then;inname keystrng;j = 17;p_sq = p_sq + 1;end;end else;inname p_atargets(2*i);end inseq p_frequid;outseq p_frequid;inclass substr(p_expna,1,6);chkname if (error < 1) then p_setcell(p_mode);timerang 0;keyword'gcount';gethead if ( (keyvalue(1) > 10) & (p_error = 0) ) then type 'TARGET :'!!inname!!' BEING IMAGED NOW';runwait('imagr') end;end;end;clrtemp for i = 1 to p_numref inname p_atargets(2*i);inclass'IBM001';inseq 0;indisk outdisk;intype'ma' p_zapall;inclass'RBM001';p_zapall;inclass'LBM001';p_zapall end;clrtemp;recat;end;clrtemp RETURN;finish $=============================================== PROCEDURE P_CRPOL task'vlbacpol';outdisk=0;flagver=0;gainuse=maxtab('cl');subarray 0 refant=p_antnum;calsour=p_calsourc(1),'';dparm 0;baseline(1)=refant;opcode'' if (p_dotimer=0)then;timerang=scantime(p_calscant(1)) else;timerang=p_calscant;end if (p_solint=-1) then;solint=p_nsolint(p_frequid);else;solint=p_solint;end baseline(2)~antnum('FD'),antnum('LA'),antnum('KP'),antnum('PT'),antnum('OV') clrtemp;p_info('vlbacpol');if (p_error = 0) then;vlbacpol;end RETURN;finish $=============================================== PROCEDURE P_REPORT $ $ Report on tables and plots made $---------------------------------------------- type ' ';type 'SUMMARY OF THE CL-TABLES PRODUCED FOR THIS FREQUENCY-ID:';type ' ' if (p_clcnt(1) < p_clcnt(2)) then type 'CL-'!!char(p_clcnt(1))!!' : ANTENNAS AND TIMES PRESENT' end;if (p_clcnt(2) < p_clcnt(3)) then type 'CL-'!!char(p_clcnt(2))!!' : SAMPLER CORRECTIONS ADDED' end;if (p_clcnt(3) < p_clcnt(4)) then type 'CL-'!!char(p_clcnt(3))!!' : GAIN CORRECTIONS ADDED' end;if (p_clcnt(4) < p_clcnt(5)) then type 'CL-'!!char(p_clcnt(4))!!' : PARALLACTIC ANGLE CORRECTION ADDED' end;if (p_clcnt(5) < p_clcnt(6)) then type 'CL-'!!char(p_clcnt(5))!!' : (MANUAL?) P-CAL ADDED' end;if (p_clcnt(6) < p_clcnt(7)) then type 'CL-'!!char(p_clcnt(6))!!' : IONOSPHERIC CORRECTION ADDED' end;if (p_clcnt(7) <> 0) then type 'CL-'!!char(p_clcnt(7))!!' : TOTAL CALIBRATION TABLE' end;clrtemp; type ' ' if (p_dotvpl > -1) then $ report about plots made for i=14:2 by -1;if (p_plcnt(i)=0) then;p_plcnt(i)=p_plcnt(i+1);end;end type 'THESE PLOTS HAVE BEEN PRODUCED FOR THIS FREQUENCY-ID:'; type ' ' if (p_plcnt(1) < p_plcnt(2)) then type char(p_plcnt(1)+1)!!'-'!!char(p_plcnt(2))!!' ANTENNAS AND TIMES PRESENT' end;if (p_plcnt(2) < p_plcnt(3)) then type char(p_plcnt(2)+1)!!'-'!!char(p_plcnt(3))!!' SAMPLER CORRECTIONS IN SN' end;if (p_plcnt(3) < p_plcnt(4)) then type char(p_plcnt(3)+1)!!'-'!!char(p_plcnt(4))!!' SAMPLER CORR. ADDED TO CL' end;if (p_plcnt(4) < p_plcnt(5)) then type char(p_plcnt(4)+1)!!'-'!!char(p_plcnt(5))!!' GAIN CORRECTIONS IN SN' end;if (p_plcnt(5) < p_plcnt(6)) then type char(p_plcnt(5)+1)!!'-'!!char(p_plcnt(6))!!' GAIN CORR. ADDED TO CL' end;if (p_plcnt(6) < p_plcnt(7)) then type char(p_plcnt(6)+1)!!'-'!!char(p_plcnt(7))!!' PARALLACTIC ANGLE ADDED TO CL' end;if (VBA_NFQI > 1) then;if (p_plcnt(7) < p_plcnt(8)) then type char(p_plcnt(7)+1)!!'-'!!char(p_plcnt(8))!!' (MANUAL?) P-CAL IN SN' end;if (p_plcnt(8) < p_plcnt(9)) then type char(p_plcnt(8)+1)!!'-'!!char(p_plcnt(9))!!' (MANUAL?) P-CAL ADDED TO CL' end;end;if (p_plcnt(9) < p_plcnt(10)) then type char(p_plcnt(9)+1)!!'-'!!char(p_plcnt(10))!!' IONOSPHERIC DELAY CORRECTION' end;if (p_plcnt(10) < p_plcnt(11)) then type char(p_plcnt(10)+1)!!'-'!!char(p_plcnt(11))!!' IONOSPHERE ADDED TO CL' end;if (p_plcnt(11) < p_plcnt(12)) then type char(p_plcnt(11)+1)!!'-'!!char(p_plcnt(12))!!' BANDPASS CORRECTIONS' end;if (p_plcnt(12) < p_plcnt(13)) then type char(p_plcnt(12)+1)!!'-'!!char(p_plcnt(13))!!' FRINGE-FIT SOLUTIONS IN SN' end;if (p_plcnt(13) < p_plcnt(14)) then type char(p_plcnt(13)+1)!!'-'!!char(p_plcnt(14))!!' SNR OF FRINGED SOLUTIONS' end;if (p_plcnt(14) < p_plcnt(15)) then type char(p_plcnt(14)+1)!!'-'!!char(p_plcnt(15))!!' TOTAL CALIBRATION TABLE' end;clrtemp; type ' ' end RETURN;finish $=============================================== PROCEDURE VIPSPIPE $ $ Do whole VLBA pipeline $---------------------------------------------- * inputs vipspipe type '=============================================================' p_init;clrtemp;p_precheck;clrtemp;p_suggest = p_doall if (p_error = 0) then;p_load;clrtemp;end if (p_error = 0) then;p_suggest = 0;clrtemp;end * if (p_error = 0) then;p_postchck;clrtemp;end type '-------------------------' for p_frequid = p_dostart to VBA_NFQI $ for each of the frequency ID's: if (p_error = 0) then inname p_expna;type 'NOW DOING FREQUENCY ID #'!!char(p_frequid) for i=1 to 15; P_PLCNT(i) = 0; end; for i=1 to 8; P_CLCNT(i) = 0; end p_suggest = -1 * p_frequid end;clrtemp if (p_error = 0) then;p_instcal;clrtemp;end if (p_error = 0) then;p_extras;clrtemp;end if (p_error = 0) then;p_fring;clrtemp;end if (p_error = 0) then;p_crpol;clrtemp;end $ new bandpass table and plots here if (p_error = 0) then;p_split;clrtemp;end if (p_error = 0) then;p_scmap(1);clrtemp;end if (p_error = 0) then;p_imagr;clrtemp;end if (p_error = 0) then;p_report;clrtemp type 'DONE WITH FREQUENCY ID #'!!char(p_frequid) type '-------------------------' p_suggest = -1 * p_frequid - 1 end;clrtemp if (p_doall < -1000) then;p_frequid=VBA_NFQI+99;end $ only do this freqid end;p_exit;clrtemp if (p_error = 0) then type '';type 'USE P_ALLPLOT(X) TO PLOT FROM PL-VERSION X ON TV';type '' type 'PROCEDURE DONE, THANK YOU FOR CHOOSING AIPS FOR YOUR BUSINESS' else type 'SOME ERROR OCCURRED - PLEASE REVIEW YOUR INPUTS AND TRY AGAIN' $ type 'SUGGESTED STARTING POINT (CAREFUL!) DOALL = '!!char(p_suggest) end;clrtemp type '=============================================================';clrtemp RETURN;finish $=============================================== PROCEDURE PIPE vipspipe RETURN;finish $=============================================== PROCEDURE BACKPIPE type 'DID YOU LOAD AND MOUNT A FRESH TAPE ? (Y)' read inn p_expna;ins 0;ind p_disk;inc p_class;p_getfqnum;doinvers -1 inclass 'fpol'!!char(p_frequid);inseq 1;intype'uv';chkname if (error = 1) then $ fxpol did not run after frequency split inc'fq-1';chkname if (error = 1) then inc p_class;nfiles = 1;chkname if (error = 1) then type 'NO MULTI-SOURCE DATA FILE FOUND - CHECK YOUR INPUTS!' p_error = 100 end else nfiles = VBA_NFQI;doinvers 1 end else $ keep 'fxpol' as inclass nfiles = (-1 * error + 1) end $ got nfiles of files and inclass fixed apart from fq-1 doall -1;outta 3;doeot -1;dostok -1;donewtab 1;format 0;blocking 10 for j = 1 to nfiles if (doinvers 1) then inc 'fq-'!!char(j) end outf'mya:'!!inn!!'_'!!inc!!'.'!!char(ins) end $$$$$$$$$$$$$$$$$$$$$$$$$$$$$ $ eigenlijn meteen voor split en na imaging op disk doen! en per freqid $ ook flag na split? $$$$$$$$$$$$$$$$$$$$$$$$$$$$$ $$$$$ for j = 1 to (-1 * error + 1);;end RETURN;finish $=============================================== P_DEBUG = 0 $ can set to true and back in the interactive AIPS window