$ VLBAPROC $--------------------------------------------------------------- $! Procedures for easy-to-learn VLBA data reduction $# RUN POPS VLBI UTILITY CALIBRATION $----------------------------------------------------------------------- $; Copyright (C) 2000-2009, 2011-2012, 2014-2015 $; 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. *----------------------------------------------------------------------- ARRAY VBA_APRM(10), VBA_ANTS(50), VBA_BASE(50), VBA_BPRM(10) ARRAY VBA_CLCP(20), VBA_CPRM(10), VBA_DPRM(10), VBA_FIT(30) ARRAY VBA_IPRM(3), VBA_KEYV(2), VBA_PIXY(7), VBA_TAU0(30) ARRAY VBA_TRAN(8), VBA_TREC(30), VBA_UVCP(10), VBA_UVRA(2) SCALAR VBA_BCHN, VBA_BIF, VBA_BLNK, VBA_CONC, VBA_CUT SCALAR VBA_DELC, VBA_DIGI, VBA_DOTB, VBA_DOTV, VBA_ECHN SCALAR VBA_EIF, VBA_FQID, VBA_FTOL, VBA_FVER, VBA_GCV SCALAR VBA_GUSE, VBA_GVER, VBA_LTYP, VBA_NCNT, VBA_NPCE SCALAR VBA_ODSK, VBA_OSEQ, VBA_OVER, VBA_PLEV, VBA_QUAL SCALAR VBA_SBND, VBA_SFRQ, VBA_SOLI, VBA_SUB, VBA_SVER SCALAR VBA_TVER, VBA_USER, VBA_VERS, VBA_WAIT, VBA_WTHR SCALAR VBA_SEQ, VBA_DISK, VBA_SCAN, VBA_LEAP STRING*2 VBA_SORT, VBA_EXT, VBA_TYPE STRING*4 VBA_CCOD, VBA_INTP, VBA_OPCO, VBA_OPTY, VBA_SCOD STRING*4 VBA_STOK, VBA_STYP STRING*6 VBA_OCLA, VBA_CLAS STRING*8 VBA_BPOL, VBA_TTSK, VBA_KEYW, VBA_ANAM, VBA_TASK STRING*12 VBA_ONAM, VBA_NAME STRING*16 VBA_CSRC(30), VBA_KEYS, VBA_SRCS(30), VBA_DATE STRING*48 VBA_INFI RETURN; FINISH PROCEDURE RUNWAIT (VBA_TASK) *----------------------------------------------------------------------- * Runs VBA_TASK and waits for it to complete regardless of the * value of DOWAIT. * * Inputs: * VBA_TASK name of task *----------------------------------------------------------------------- VBA_WAIT = DOWAIT; DOWAIT = TRUE; VBA_TTSK = TASK; TASK = VBA_TASK GO DOWAIT = VBA_WAIT; TASK = VBA_TTSK RETURN; FINISH PROCEDURE MAXTAB (VBA_TYPE) *----------------------------------------------------------------------- * Return the highest version number of a table of type VBA_TYPE * attached to the specified file. * * Inputs: * VBA_TYPE Table type * * Adverbs: * USERID User ID * INNAME File name * INCLASS File class * INSEQ File sequence number * INDISK File disk number *----------------------------------------------------------------------- SCALAR VBA_SLOT, VBA_VERS *Save adverb values VBA_KEYW = KEYWORD VBA_KEYV = KEYVALUE VBA_KEYS = KEYSTRNG VBA_SLOT = 0 KEYSTRNG = ' ' * Invariant: KEYSTRNG <> VBA_TYPE implies that no of the first * VBA_SLOT tables has type VBA_TYPE * Bound: 50 - VBA_SLOT WHILE VBA_SLOT <> 50 & KEYSTRNG <> VBA_TYPE VBA_SLOT = VBA_SLOT + 1; KEYWORD = 'EXTYPE' !! CHAR(VBA_SLOT) GETHEAD END * If KEYSTRNG = VBA_TYPE then VBA_SLOT is the index for table type * VBA_TYPE in the file header otherwise there are no tables of type * VBA_TYPE. IF KEYSTRNG = VBA_TYPE THEN KEYWORD = 'EXTVER' !! CHAR(VBA_SLOT); GETHEAD ELSE KEYVALUE(1) = 0 END VBA_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, VBA_NROW, 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, VBA_FINI, VBA_TIME, VBA_NROW * Save adverbs VBA_EXT = INEXT; VBA_VERS = INVERS; VBA_PIXY = PIXXY VBA_KEYW = KEYWORD; VBA_KEYV = KEYVALUE; VBA_KEYS = KEYSTRNG IF MAXTAB('NX') < 1 THEN PRINT 'SCANTIME: THERE IS NO INDEX TABLE' VBA_TIMR = 0, 0, 0, 0, 0, 0, 0, 0 ELSE * Get number of scans INEXT = 'NX'; INVERS = 1; KEYWORD = 'NUM ROW'; GETTHEAD VBA_NROW = KEYVALUE(1) IF VBA_SCAN < 1 ! VBA_SCAN > VBA_NROW THEN PRINT 'SCANTIME: THERE IS NO SCAN #' !! CHAR(VBA_SCAN) VBA_TIMR = 0, 0, 0, 0, 0, 0, 0, 0 ELSE PIXXY = VBA_SCAN, 1; TABGET; VBA_TIME = KEYVALUE(1) PIXXY = VBA_SCAN, 2; TABGET VBA_STRT = VBA_TIME - KEYVALUE(1)/2.; VBA_FINI = VBA_TIME + KEYVALUE(1)/2.; VBA_TIMR(1) = FLOOR(VBA_STRT); VBA_STRT = 24.0 * (VBA_STRT - VBA_TIMR(1)); VBA_TIMR(2) = FLOOR(VBA_STRT); VBA_STRT = 60.0 * (VBA_STRT - VBA_TIMR(2)); VBA_TIMR(3) = FLOOR(VBA_STRT); VBA_TIMR(4) = CEIL(60.0 * (VBA_STRT - VBA_TIMR(3))); VBA_TIMR(5) = FLOOR(VBA_FINI); VBA_FINI = 24.0 * (VBA_FINI - VBA_TIMR(5)); VBA_TIMR(6) = FLOOR(VBA_FINI); VBA_FINI = 60.0 * (VBA_FINI - VBA_TIMR(6)); VBA_TIMR(7) = FLOOR(VBA_FINI); VBA_TIMR(8) = FLOOR(60.0 * (VBA_FINI - VBA_TIMR(7))); END END * Restore adverbs: INEXT = VBA_EXT; INVERS = VBA_VERS; PIXXY = VBA_PIXY KEYWORD = VBA_KEYW; KEYVALUE = VBA_KEYV; KEYSTRNG = VBA_KEYS RETURN VBA_TIMR; FINISH PROCEDURE VBA_NEW *----------------------------------------------------------------------- * Returns TRUE if the current data set appears to be new (i.e. if * it has no more than one of each calibration table type) or FALSE * if the current data set appears to have undergone some calibration. * * Inputs: * INNAME file name * INCLASS file class * INSEQ file sequence number * INDISK file disk number *----------------------------------------------------------------------- SCALAR VBA_OK VBA_OK = TRUE IF MAXTAB ('CL') > 1 THEN; VBA_OK = FALSE; END IF MAXTAB ('GC') > 1 THEN; VBA_OK = FALSE; END IF MAXTAB ('PC') > 1 THEN; VBA_OK = FALSE; END IF MAXTAB ('TY') > 1 THEN; VBA_OK = FALSE; END RETURN VBA_OK FINISH PROCEDURE VBA_NSTK *----------------------------------------------------------------------- * Returns the number of STOKES axis values in a file. * * Issues an error message and returns zero if there is no STOKES * axis. * * Inputs: * USERID user ID. * INNAME file name * INCLASS file class * INSEQ file sequence number * INDISK file disk number *----------------------------------------------------------------------- SCALAR VBA_AXIS, VBA_NUM * Save adverbs VBA_KEYW = KEYWORD; VBA_KEYS = KEYSTRNG; VBA_KEYV = KEYVALUE VBA_AXIS = 0; KEYSTRNG = ' ' * Invariant: KEYSTRNG <> 'STOKES' implies that the STOKES axis is not * one of the first VBA_AXIS axes * Bound: 7 - VBA_AXIS WHILE VBA_AXIS <> 7 & KEYSTRNG <> 'STOKES' VBA_AXIS = VBA_AXIS + 1 KEYWORD = 'CTYPE' !! CHAR(VBA_AXIS); GETHEAD END IF KEYSTRNG = 'STOKES' THEN KEYWORD = 'NAXIS' !! CHAR(VBA_AXIS); GETHEAD VBA_NUM = KEYVALUE(1) ELSE PRINT 'VBA_NSTK: STOKES AXIS IS MISSING' VBA_NUM = 0 END * Restore adverbs KEYWORD = VBA_KEYW; KEYSTRNG = VBA_KEYS; KEYVALUE = VBA_KEYV RETURN VBA_NUM FINISH PROCEDURE VBA_STK1 *----------------------------------------------------------------------- * Returns the reference value for the STOKES axis in a file * * Inputs: * USERID user ID number * INNAME file name * INCLASS file class * INSEQ file sequence number * INDISK file disk number *----------------------------------------------------------------------- SCALAR VBA_AXIS, VBA_NUM * Save adverbs VBA_KEYW = KEYWORD; VBA_KEYS = KEYSTRNG; VBA_KEYV = KEYVALUE VBA_AXIS = 0; KEYSTRNG = ' ' * Invariant: KEYSTRNG <> 'STOKES' implies that the STOKES axis is not * one of the first VBA_AXIS axes * Bound: 7 - VBA_AXIS WHILE VBA_AXIS <> 7 & KEYSTRNG <> 'STOKES' VBA_AXIS = VBA_AXIS + 1 KEYWORD = 'CTYPE' !! CHAR(VBA_AXIS); GETHEAD END IF KEYSTRNG = 'STOKES' THEN KEYWORD = 'CRVAL' !! CHAR(VBA_AXIS); GETHEAD VBA_NUM = KEYVALUE(1) ELSE PRINT 'VBA_STK1: STOKES AXIS IS MISSING' VBA_NUM = 0 END KEYWORD = VBA_KEYW; KEYSTRNG = VBA_KEYS; KEYVALUE = VBA_KEYV RETURN VBA_NUM FINISH PROCEDURE VBA_ONLY *----------------------------------------------------------------------- * Returns TRUE if a data set only contains VLBA antennas or the VLA * or returns FALSE if other stations are present. * * Assumes that at least one antenna table is present. * * Inputs: * USERID user ID number * INNAME file name * INCLAS file class * INSEQ file sequence number * INDISK file disk number *----------------------------------------------------------------------- SCALAR VBA_NSUB, VBA_NANT, VBA_STAT, VBA_VLBA, VBA_ROW * Save adverbs VBA_EXT = INEXT; VBA_VERS = INVERS; VBA_PIXY = PIXXY; VBA_KEYW = KEYWORD; VBA_KEYV = KEYVALUE; VBA_KEYS = KEYSTRNG VBA_NSUB = MAXTAB ('AN'); VBA_VLBA = TRUE FOR INVER = 1 TO VBA_NSUB INEXT = 'AN' KEYWORD = 'NUM ROW' GETTHEAD VBA_NANT = KEYVALUE(1) FOR VBA_ROW = 1 TO VBA_NANT PIXXY = VBA_ROW, 1; TABGET; VBA_STAT = FALSE IF KEYSTRNG = 'BR' THEN; VBA_STAT = TRUE; END IF KEYSTRNG = 'FD' THEN; VBA_STAT = TRUE; END IF KEYSTRNG = 'HN' THEN; VBA_STAT = TRUE; END IF KEYSTRNG = 'KP' THEN; VBA_STAT = TRUE; END IF KEYSTRNG = 'LA' THEN; VBA_STAT = TRUE; END IF KEYSTRNG = 'MK' THEN; VBA_STAT = TRUE; END IF KEYSTRNG = 'NL' THEN; VBA_STAT = TRUE; END IF KEYSTRNG = 'OV' THEN; VBA_STAT = TRUE; END IF KEYSTRNG = 'PT' THEN; VBA_STAT = TRUE; END IF KEYSTRNG = 'SC' THEN; VBA_STAT = TRUE; END IF KEYSTRNG = 'Y' THEN; VBA_STAT = TRUE; END IF VBA_STAT = FALSE THEN; VBA_VLBA = FALSE; END END END * Restore adverbs INEXT = VBA_EXT; INVERS = VBA_VERS; PIXXY = VBA_PIX KEYWORD = VBA_KEYW; KEYVALUE = VBA_KEYV; KEYSTRNG = VBA_KEYS RETURN VBA_VLBA FINISH PROCEDURE VBA_SM1 *----------------------------------------------------------------------- * Prints a message informing the user that AIPS is looking for * subarrays. *----------------------------------------------------------------------- PRINT 'THIS DATA MAY CONTAIN MULTIPLE SUBARRAYS. PLEASE BE PATIENT' PRINT 'WHILE AIPS SEARCHES FOR SUBARRAY CONDITIONS. THIS MAY TAKE ' PRINT 'SEVERAL MINUTES. ' FINISH PROCEDURE VLBAMCAL *----------------------------------------------------------------------- * Merge redundant calibration data. Leave merged data in version 1 * tables. * * Input adverbs: * INNAME file name * INCLASS file class * INSEQ file sequence number * INDISK disk number * BADDISK disks not to be used for scratch files *----------------------------------------------------------------------- TPUT VLBAMCAL USERID = 0 IF VBA_NEW = TRUE THEN IF MAXTAB ('GC') = 1 THEN 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 VLBALOAD *----------------------------------------------------------------------- * Loads VLBA data from a tape. * * Input adverbs: * INTAPE input tape drive number * DATAIN to load files from disk * NFILES number of files to skip * OUTNAME output file name * OUTDISK output disk number * NCOUNT number of files to load from tape * DOUVCOMP compress output data? * CLINT interval between CL table entries *----------------------------------------------------------------------- SCALAR VBA_NTIM IF CLINT = 0 THEN; CLINT = 0.25; END 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 VLBAMCAL 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 = 1, 0, CLINT, 1 1, 0; INFILE='' 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, VBA_SRT, VBA_INDX TPUT VLBASUBS IF (CLINT = 0) THEN; CLINT = 0.25; END USERID = 0 IF VBA_NEW = TRUE THEN * If FITLD detects a potential subarray condition 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 = 1, 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 VLBAFQS *----------------------------------------------------------------------- * Split frequency IDs into separate files. * * Inputs: * INNAME input file name * INCLASS input file class * INSEQ input file sequence number * INDISK input file disk number * CLINT CL table interval * OUTDISK output disk number *----------------------------------------------------------------------- SCALAR VBA_9050, VBA_BFQ, VBA_FQ, VBA_I, VBA_J, VBA_LOFF, VBA_NFQI SCALAR VBA_NIF, VBA_MDIF, VBA_SX, VBA_ROW, VBA_TSEQ ARRAY VBA_IF1(20), VBA_IF2(20) STRING*6 VBA_TCLA TPUT VLBAFQS IF (CLINT = 0) THEN; CLINT = 0.25; END * Find out if data needs to be split into seperate frequencies INEXT = 'FQ'; INVERS = 1; KEYWORD = 'NUM ROW' GETTHEAD; VBA_NFQI = KEYVALUE(1) KEYWORD = 'NO_IF'; GETTHEAD; VBA_NIF = KEYVALUE(1) FOR VBA_I=2 TO 7 KEYWORD='CTYPE'!!CHAR(VBA_I); GETHEAD IF(SUBSTR(KEYSTRNG(1),1,4)='FREQ') THEN KEYWORD = 'CRVAL'!!CHAR(VBA_I); GETHEAD; VBA_BFQ = KEYVALUE(1) END END VBA_SX = -1; VBA_9050 = -1 FOR VBA_I = 1 TO VBA_NFQI PIXXY VBA_I, 2, 1; TABGET VBA_FQ=VBA_BFQ+KEYVALUE(1) IF(VBA_FQ < 9.1e9 & VBA_FQ > 7.8e9) THEN; VBA_SX=VBA_I;END IF(VBA_FQ < 2.8e9 & VBA_FQ > 2.0e9) THEN; VBA_SX=VBA_I;END IF(VBA_FQ < 6.3e8 & VBA_FQ > 5.9e8) THEN; VBA_9050=VBA_I;END IF(VBA_FQ < 3.5e8 & VBA_FQ > 3e8) THEN; VBA_9050=VBA_I;END END FOR VBA_I = 1 TO VBA_NFQI IF(VBA_SX = VBA_I ! VBA_9050 = VBA_I) THEN IF(VBA_SX = VBA_I) THEN; VBA_MDIF = 1E9; END IF(VBA_9050 = VBA_I) THEN; VBA_MDIF = 2E8; END VBA_LOFF=0 FOR VBA_J = 1 TO VBA_NIF PIXXY VBA_I, 2, VBA_J; TABGET IF(KEYVALUE(1)-VBA_LOFF > VBA_MDIF & VBA_J > 1)THEN VBA_IF1(VBA_I)=VBA_J END VBA_IF2(VBA_I)=VBA_J VBA_LOFF = KEYVALUE(1) END IF(VBA_IF1(VBA_I)=0 & VBA_SX=VBA_I)THEN; VBA_SX=-1; END IF(VBA_IF1(VBA_I)=0 & VBA_9050=VBA_I)THEN; VBA_9050=-1; END END END * Split into 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 <> vba_row & VBA_9050 <> vba_row 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(vba_row)-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 = 1, 0, CLINT, 1, 1, 0 RUNWAIT ('INDXR') TGET 'UVCOP' BIF=VBA_IF1(vba_row); EIF=VBA_IF2(vba_row) PRINT 'COPYING FREQUENCY ID #'!! CHAR(FREQID)!! '.5' OUTCLASS = 'FQ' !! CHAR(FREQID)!! '.5' RUNWAIT ('UVCOP') END * Index data VBA_TCLA = OUTCLASS; VBA_TSEQ = OUTSEQ TASK 'INDXR'; DEFAULT; TGET VLBAFQS; TASK 'INDXR' INCLASS = VBA_TCLA; INSEQ = VBA_TSEQ; INDISK = OUTDISK CPARM = 1, 0, CLINT, 1, 1, 0 RUNWAIT ('INDXR') TGET VLBAFQS END END IF VBA_SRT < 1 & SUBARRAY < 1 & VBA_NSTK <> 1 & VBA_INDX < 1 THEN IF VBA_NFQI < 2 & VBA_SX < 0 & VBA_9050 < 0 THEN TYPE 'YOUR DATA ONLY HAS ONE FREQUENCY' END END TGET VLBAFQS RETURN; FINISH PROCEDURE VBA_FPM1 *----------------------------------------------------------------------- * Print a message informing the user that his data set appears to * contain only one polarization. *----------------------------------------------------------------------- PRINT 'THIS DATA SET APPEARS TO CONTAIN ONLY ONE 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, VBA_PAIR, VBA_FREQ IF (OUTDISK = 0) THEN; OUTDISK = INDISK; END TPUT VLBAFPOL USERID = 0 IF VBA_NEW = TRUE THEN IF VBA_NSTK = 1 THEN IF MAXTAB ('FQ') > 0 THEN * Find the number of IFs: INEXT = 'FQ'; INVERS = 1; KEYWORD = 'NO_IF'; GETTHEAD; VBA_NIFS = KEYVALUE(1) * Find the number of IF pairs that have the same frequency: VBA_PAIR = 0 IF VBA_NIFS > 1 THEN FOR I = 0 TO VBA_NIFS / 2 - 1 USERID = 0; INEXT = 'FQ'; INVERS = 1; PIXXY = 1, 2, 2 * I + 1; TABGET VBA_FREQ = KEYVALUE(1); PIXXY = 1, 2, 2 * I + 2 TABGET IF KEYVALUE(1) = VBA_FREQ THEN VBA_PAIR = VBA_PAIR + 1 END END END IF VBA_PAIR = 0 THEN VBA_FPM1 ELSE IF 2 * VBA_PAIR = VBA_NIFS THEN * 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 *----------------------------------------------------------------------- * will merge tables, sort, correct subarrays, split into * different freqs, and index VLBA data if necessary. * * Input adverbs: * INNAME file name * INCLASS file class * INSEQ file sequence number * INDISK disk number * OUTDISK output disk number * CLINT CL table interval * SUBARRAY is there a subarray *----------------------------------------------------------------------- SCALAR VBA_9050, VBA_BFQ, VBA_FQ, VBA_INDX, VBA_I, VBA_J, VBA_LOFF SCALAR VBA_MDIF, VBA_NFQI, VBA_ROW, VBA_SRT, VBA_SX, VBA_TSEQ SCALAR VBA_MCAL, VBA_NANT ARRAY VBA_IF1(20), VBA_IF2(20) STRING*6 VBA_TCLA VNUM = 35; VPUT VLBAFIX IF (CLINT = 0) THEN; CLINT = 0.25; END IF (OUTDISK = 0) THEN; OUTDISK = INDISK; END TPUT VLBAFIX FOR VBA_I=1 TO 20 VBA_IF1(VBA_I)=0 VBA_IF2(VBA_I)=0 END IF VBA_NEW = TRUE THEN * Find out if data needs sorting VBA_SRT = TRUE; KEYWORD = 'SORTORD'; KEYVALUE = 0 KEYSTRNG = ''; GETHEAD IF SUBSTR(KEYSTRNG,1,2) = 'TB' THEN VBA_SRT = FALSE END * Find out if tables need merged VBA_MCAL = FALSE; KEYWORD = 'NUM ROW'; KEYVALUE = 0 KEYSTRNG = ''; INVERS=1; INEXT='AN'; GETTHEAD VBA_NANT=KEYVALUE(1); INEXT='GC'; GETTHEAD IF KEYVALUE(1) > VBA_NANT THEN VBA_MCAL = TRUE END * Find out if data needs to be split into seperate frequencies INEXT = 'FQ'; INVERS = 1; KEYWORD = 'NUM ROW' GETTHEAD; VBA_NFQI = KEYVALUE(1) KEYWORD = 'NO_IF'; GETTHEAD; VBA_NIF = KEYVALUE(1) FOR VBA_I=2 TO 7 KEYWORD='CTYPE'!!CHAR(VBA_I); GETHEAD IF(SUBSTR(KEYSTRNG(1),1,4)='FREQ') THEN KEYWORD = 'CRVAL'!!CHAR(VBA_I); GETHEAD; VBA_BFQ = KEYVALUE(1) END END VBA_SX = -1; VBA_9050 = -1 FOR VBA_I = 1 TO VBA_NFQI PIXXY VBA_I, 2, 1; TABGET VBA_FQ=VBA_BFQ+KEYVALUE(1) IF(VBA_FQ < 9.1e9 & VBA_FQ > 7.8e9) THEN; VBA_SX=VBA_I;END IF(VBA_FQ < 2.8e9 & VBA_FQ > 2.0e9) THEN; VBA_SX=VBA_I;END IF(VBA_FQ < 6.3e8 & VBA_FQ > 5.9e8) THEN; VBA_9050=VBA_I;END IF(VBA_FQ < 3.5e8 & VBA_FQ > 3e8) THEN; VBA_9050=VBA_I;END END FOR VBA_I = 1 TO VBA_NFQI IF(VBA_SX = VBA_I ! VBA_9050 = VBA_I) THEN IF(VBA_SX = VBA_I) THEN; VBA_MDIF = 1E9; END IF(VBA_9050 = VBA_I) THEN; VBA_MDIF = 2E8; END VBA_LOFF=0 FOR VBA_J = 1 TO VBA_NIF PIXXY VBA_I, 2, VBA_J; TABGET IF(KEYVALUE(1)-VBA_LOFF > VBA_MDIF & VBA_J > 1)THEN VBA_IF1(VBA_I)=VBA_J END VBA_IF2(VBA_I)=VBA_J VBA_LOFF = KEYVALUE(1) END IF(VBA_IF1(VBA_I)=0 & VBA_SX=VBA_I)THEN; VBA_SX=-1; END IF(VBA_IF1(VBA_I)=0 & VBA_9050=VBA_I)THEN; VBA_9050=-1; END END END type VBA_SX, VBA_IF1(1), VBA_IF2(1) * Find out if data needs indexing VBA_INDX = FALSE IF MAXTAB ('CL') = 0 THEN; VBA_INDX = TRUE; END IF MAXTAB ('NX') = 0 THEN; VBA_INDX = TRUE; END * merge calibration tables (if needed) IF VBA_MCAL = TRUE THEN DEFAULT VLBAMCAL; TGET VLBAFIX; TASK 'VLBAMCAL' VLBAMCAL END * Sort data (if needed) IF (VBA_SRT=TRUE) & (VBA_NFQI=1) & (VBA_SX<0) & (VBA_9050<0) THEN 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_ROW = 1 TO VBA_NFQI TGET VLBAFIX PIXXY = VBA_ROW, 1, 1; INVER = 1; INEXT = 'FQ' TABGET; FREQID = KEYVALUE(1); TPUT UVCOP IF(VBA_SX <> vba_row)&(VBA_9050 <> vba_row)THEN TGET UVCOP BIF = 0;EIF = 0; OUTCLASS = 'FQ-' !! CHAR(FREQID) PRINT 'COPYING FREQUENCY ID #' !! CHAR(FREQID) OUTSEQ=1; RUNWAIT ('UVCOP') VBA_TCLA = OUTCLASS; VBA_TSEQ = OUTSEQ ELSE TGET UVCOP BIF=1; EIF=VBA_IF1(vba_row)-1 PRINT 'COPYING FREQUENCY ID #' !! CHAR(FREQID) OUTCLASS = 'FQ-' !! CHAR(FREQID) OUTSEQ=1; RUNWAIT ('UVCOP') VBA_TCLA = OUTCLASS; VBA_TSEQ = OUTSEQ * Index data TASK 'INDXR'; DEFAULT; TGET VLBAFIX; TASK 'INDXR' INCLASS = VBA_TCLA; INSEQ = VBA_TSEQ; INDISK = OUTDISK CPARM = 1, 0, CLINT, 1, 1, 0 RUNWAIT ('INDXR') * run VLBAFPOL IF VBA_NSTK = 1 THEN; VLBAFPOL; END TGET 'UVCOP' BIF=VBA_IF1(vba_row); EIF=VBA_IF2(vba_row) PRINT 'COPYING FREQUENCY ID #'!! CHAR(VBA_NFQI+1) OUTCLASS = 'FQ-' !! CHAR(VBA_NFQI+1) RUNWAIT ('UVCOP') END * Find out if data needs sorting VBA_SRT = TRUE; KEYWORD = 'SORTORD'; KEYVALUE = 0 INCLASS = VBA_TCLA; INSEQ = VBA_TSEQ; INDISK = OUTDISK KEYSTRNG = ''; GETHEAD IF SUBSTR(KEYSTRNG,1,2) = 'TB' THEN VBA_SRT = FALSE END * Sort data (if needed) IF (VBA_SRT=TRUE) THEN TASK 'MSORT'; DEFAULT; TGET VLBAFIX; TASK 'MSORT' INCLASS = VBA_TCLA; INSEQ = VBA_TSEQ; INDISK = OUTDISK OUTNAME = INNAME; OUTCLASS = INCLASS; OUTSEQ = INSEQ OUTDISK = INDISK; SORT = 'TB' RUNWAIT ('MSORT') END * Index data VBA_TCLA = OUTCLASS; VBA_TSEQ = OUTSEQ TASK 'INDXR'; DEFAULT; TGET VLBAFIX; TASK 'INDXR' INCLASS = VBA_TCLA; INSEQ = VBA_TSEQ; INDISK = OUTDISK CPARM = 1, 0, CLINT, 1, 1, 0 RUNWAIT ('INDXR') TGET VLBAFIX INCLASS = VBA_TCLA; INSEQ = VBA_TSEQ; INDISK = OUTDISK * run VLBAFPOL 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 = 1, 0, CLINT, 1, 1, 0 RUNWAIT ('INDXR') TGET VLBAFIX END END IF VBA_SRT > 0 THEN TYPE 'YOUR DATA HAS BEEN SORTED' END IF VBA_MCAL > 0 THEN TYPE 'YOUR CAL TABLES HAVE BEEN MERGED' END IF SUBARRAY > 0 THEN TYPE 'YOUR DATA HAS BEEN CORRECTED FOR SUBARRAYS' END IF VBA_NFQI > 1 ! VBA_SX > 0 ! VBA_9050 > 0 THEN TYPE 'YOUR DATA HAS BEEN SPLIT INTO SEPARATE 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, VBA_SU, VBA_DOOP TPUT VLBACALA * Run ACCOR to determine sampling corrections TASK 'ACCOR'; DEFAULT; TGET VLBACALA; TASK 'ACCOR' SOLINT = -0.5; 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, 1; 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 TGET VLBACALA RETURN; FINISH PROCEDURE VLBAPANG *----------------------------------------------------------------------- * Corrects phases for parallactic angle effects. * * Inputs: * INNAME input file name * INCLASS input file class * INSEQ input file sequence number * INDISK input file disk number * SUBARRAY subarray number * BADDISK list of bad disks *----------------------------------------------------------------------- TPUT VLBAPANG * Make the correction: DEFAULT 'CLCOR'; TGET VLBAPANG; TASK 'CLCOR' GAINVER = MAXTAB('CL'); GAINUSE = GAINVER +1; OPCODE = 'PANG'; CLCORPRM = +1, 0; RUNWAIT('CLCOR') 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, vba_tim, vba_frg, vba_sn, vba_cl, 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 vlbapcor for i=1 to 8 if timerang(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')&(antennas(1)<>0)then; vba_frg=1;end if(vba_frg<0)&(ante(1)<>0)then vba_ok=-1 type 'Antennas is only set if antennas are missing from 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(antennas(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';timerang 0; source '' runwait('sncor'); opcode 'zdel';runwait('sncor') end type 'RUN CLCAL' task 'clcal';default; tget vlbapcor;task 'clcal' gainver gainuse; gainuse=MAXTAB('cl')+1; snver=MAXTAB('SN') interpol 'self'; calsour '';timerang 0; antennas 0;inver=0 runwait('clcal') vba_sn=snver vba_cl=gainu end if(vba_frg>0)&(vba_ok>0)then type 'run fring' task 'fring'; default; tget vlbapcor; task 'fring' gainuse vba_cl;docalib 2;dparm(8) 1;antennas(vba_lant+1) refant aparm(1) 2;dparm(1) 1; snver 0 runwait('fring') type 'run clcal' task 'clcal';default; tget vlbapcor;task 'clcal' gainver gainuse; gainuse=vba_cl; snver=MAXTAB('SN') calsour '';opcode 'cali'; timerang 0;inver=0 runwait('clcal') end if(vba_ok>0)then if(vba_frg>0)then type 'if there is a message about failed solutions in 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, vba_cl, vba_nms vba_nms=0 vba_ok=1 vnum=35 vput vlbafrng if(gainuse=0)then; gainuse=maxtab('cl');end tput vlbafrng $tget fring;vput 'FRING'; tget clcal;vput 'clcal' tget vlbafrng for i=1 to 30 if (source(i)<>'') then vba_nms=vba_nms+1 end end IF vba_ok >=0 then type 'run fring' task='fring'; default; tget vlbafrng;task='fring' if(search(1)<>0)then aparm(9)=1; end $ aparm(6)=1 docalib 2; runwait('fring') type 'RUN CLCAL' task 'clcal';default; tget vlbafrng;task 'clcal' vba_cl=maxtab('cl')+1 if interpol = 'self' ! sour(1)='' then gainver gainuse; gainuse=vba_cl; snver=maxtab('SN') runwait('clcal') else for i=1 to vba_nms tget vlbafrng task 'clcal';gainver gainuse; gainuse vba_cl source = source(i),''; calsour = source(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, vba_nums, vba_cl vba_ok=1 vba_nms=0 vnum=35 vput vlbakrng if(gainuse=0)then; gainuse=maxtab('cl');end tput vlbakrng $tget kring;vput 'kring'; tget clcal;vput 'clcal' tget vlbakrng for i=1 to 30 if (source(i)<>'') then vba_nms=vba_nms+1 end end IF vba_ok >=0 then type 'run kring' task='kring'; default; tget vlbakrng;task='kring' $ prtlev 2 docalib 2; runwait('kring') type 'RUN CLCAL' task 'clcal';default; tget vlbakrng;task 'clcal' vba_cl=maxtab('cl')+1 if interpol = 'self' ! sour(1)='' then gainver gainuse; gainuse=vba_cl; snver=maxtab('SN') runwait('clcal') else for i=1 to vba_nms tget vlbakrng;task 'clcal';gainver gainuse; gainuse vba_cl source = source(i),'';calsour = source(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, vba_nms, vba_nmc, vba_cl array vba_sc(30) vba_ok=1 vba_nms=0 vba_nmc=0 vnum=35 vput vlbafrgp if(gainuse=0)then; gainuse=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 (source(i)<>'') then vba_nms=vba_nms+1 end if (calsour(i)<>'') then vba_nmc=vba_nmc+1 end vba_sc(i)=-1 end IF vba_ok >=0 then for i=1 to vba_nms for j=1 to vba_nmc if(source(i)=calsour(j))then vba_sc(i)=1;end end end type 'run fring' task='fring'; default; tget vlbafrgp;task='fring' if(search(1)<>0)then aparm(9)=1; end $ aparm(6)=1 docalib 2; snver=0; runwait('fring') type 'RUN CLCAL' task 'clcal';default; tget vlbafrgp;task 'clcal' if source(1)='' then gainver gainuse; gainuse=maxtab('cl')+1; snver=maxtab('SN') calsour=calsour(1),'' type 'all sources referenced to calsour= '!!calsour(1) runwait('clcal') else vba_cl=maxtab('cl')+1 for i=1 to vba_nms tget vlbafrgp;task 'clcal' gainver gainuse; gainuse vba_cl;snver=maxtab('SN') if(vba_sc(i)>0) then source = source(i),''; calsour = source else source = source(i),''; calsour = calsour(1),'' end runwait('clcal') type source(1)!!' referenced to calsour='!!calsour(1) end end 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, vba_nms, vba_nmc, vba_cl array vba_sr(30) vba_ok=1 vba_nms=0 vba_nmc=0 vnum=35 vput vlbakrgp if(gainuse=0)then; gainuse=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(source(i),1,1)='-')then vba_ok=-1 type 'Sorry, -sources cannot be used in this procedure' type 'reset sources and run again' end if (substr(calsour(i),1,1)='-')then vba_ok=-1 type 'Sorry, -calsour cannot be used in this procedure' type 'reset calsour and run again' end if (source(i)<>'') then vba_nms=vba_nms+1 end if (calsour(i)<>'') then vba_nmc=vba_nmc+1 end vba_sr(i)=-1 end IF vba_ok >=0 then for i=1 to vba_nms for j=1 to vba_nmc if(source(i)=calsour(j))then vba_sr(i)=1;end end end type 'run kring' task='kring'; default; tget vlbakrgp;task='kring' $ prtlev 2 docalib 2; runwait('kring') type 'RUN CLCAL' task 'clcal';default; tget vlbakrgp;task 'clcal' if source(1)='' then gainver gainuse; gainuse=maxtab('cl')+1; snver=maxtab('SN') calsour=calsour(1),'' runwait('clcal') type 'all sources referenced to calsour='!!calsour(1) else vba_cl=maxtab('cl')+1 for i=1 to vba_nms tget vlbakrgp;task 'clcal' gainver gainuse; gainuse vba_cl;snver=maxtab('SN') if(vba_sr(i)>0) then source = source(i),''; calsour = source else source = source(i),''; calsour = calsour(1),'' end runwait('clcal') type source(1)!!' referenced to calsour='!!calsour(1) end end 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, vlb_ant, vlb_ok, vlb_low, vlb_hi, vlb_ref, 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 outdisk=0 then outdisk=indisk; end; tput vlbacpol tget vlbacpol inext 'cl'; inver 0; keyword 'NO_ANT'; getthead; vlb_ant=keyval(1) if gainuse=0 then type 'GAINUSE HAS NO DEFAULT' type 'SET GAINUSE AND RUN AGAIN' vlb_ok=-1 end if (refant=0) then type 'REFANT MUST BE EITHER LOWEST OR HIGHEST ANNTENNA #' type 'SELECT A REFANT AND RUN AGAIN' vlb_ok=-1 end if ((baseline(1)=0) & (refant <> 1) & (refant <> vlb_ant)) then type 'REFANT MUST BE EITHER LOWEST OR HIGHEST ANNTENNA #' type 'RESET REFANT AND RUN AGAIN' vlb_ok=-1 end for i=1 to vlb_ant; if(baseline(i) <> 0) & (refant > baseline(i)) then vlb_low=-1 end if(baseline(i) <> 0) & (refant < baseline(i))then vlb_hi=-1 end if(baseline(i)<>0) & (baseline(1)<>0) & (refant = baseline(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) & (baseline(1) <> 0) then type 'REFANT MUST BE PART OF BASELINE LIST' type 'RESET BASELINE AND RUN AGAIN' vlb_ok=-1 end for i=1 to 8 if(timerang(i)<>0)then vlb_tim=1 end end if(vlb_tim<0)then vlb_ok=-1 type 'timerange has no default' type 'pick a time range that has strong SNR for RL and LR fringes' end IF vlb_ok >=0 then type 'MAKE COPY OF SELECTED DATA' task='UVCOP'; default; tget vlbacpol;task='uvcop' outname='CROSSPOL TMP'; outclass='UVCOP'; outseq=666 runwait('uvcop') task 'INDXR';default; tget vlbacpol; task='indxr' inname='CROSSPOL TMP'; inclass='UVCOP'; inseq=666; indisk=outdisk runwait('indxr') inext 'SN'; inver=-1;extd type 'FRINGE FIT FOR PARALLEL HAND DATA' task='FRING';default; tget vlbacpol; task='fring' inname='CROSSPOL TMP'; inclass='UVCOP'; inseq=666; indisk=outdisk aparm=2,0; docalib=2; snver=1 runwait('fring') type 'CALIBRATE PARALLEL POLARIZATION' task='CLCAL'; default; tget vlbacpol; task='clcal' inname='CROSSPOL TMP'; inclass='UVCOP'; inseq=666; indisk=outdisk gainver gainuse; gainuse=maxtab('cl')+1 ;snver=1 opcode='CALI'; source calsour runwait('clcal') vlb_slot=gainuse type 'SWAP R AND L FOR REFERENCE ANTENNA' task='SWPOL';default; tget vlbacpol; task='swpol' inname='CROSSPOL TMP'; inclass='UVCOP'; inseq=666; indisk=outdisk outname='CROSSPOL TMP'; outclass='SWPOL'; outseq=666; antennas = refant, 0; gainuse=vlb_slot; docalib=2 runwait('swpol') task 'INDXR'; default; tget vlbacpol; task='indxr' inname='CROSSPOL TMP'; inclass='SWPOL'; inseq=666; indisk=outdisk runwait('indxr') inext 'SN'; inver=-1;extd type 'FRINGE FITS FOR CROSS HAND DATA' task='FRING'; default; tget vlbacpol; task='fring' inname='CROSSPOL TMP'; inclass='SWPOL'; inseq=666; indisk=outdisk aparm=2,0; gainuse=vlb_slot; docalib=2; snver=1 if(baseline(1)=0)then for i=1 to vlb_ant if(i<>refant)then antennas = refant, i type 'FIT FOR BASELINE',refant,i runwait('fring') end end else for i=1:30; if (baseline(i)<>refant) & (baseline(i) <> 0) then antennas = refant, baseline(i) type 'FIT FOR BASELINE',refant,baseline(i) runwait('fring') end end end type 'PROCESS SOLUTIONS' task='POLSN'; default; tget vlbacpol; task='polsn' inname='CROSSPOL TMP'; inclass='SWPOL'; inseq=666; indisk=outdisk inver=1; outver=2 runwait('polsn') type 'COPY SN TABLE TO ORIGINAL UV DATA' task='TACOP'; default; tget vlbacpol; task='tacop' in2disk=outdisk;outname=inname; outclass=inclass; outdisk=indisk; outseq=inseq inname='CROSSPOL TMP'; inclass='SWPOL'; inseq=666; indisk=in2disk inext 'SN'; inver =2; ncount=1 runwait('tacop') type 'RUN CLCAL' task 'clcal';default; tget vlbacpol;task 'clcal' snver=maxtab('sn'); gainver gainuse; gainuse=maxtab('cl')+1 opcode 'cali';timerang 0; calsour '';source '' runwait('clcal') type 'DESTROY TEMPORARY FILES' intype ='UV'; inname='CROSSPOL TMP'; indisk=outd; inseq=666 inclass='UVCOP'; zap inclass='SWPOL'; zap type 'SN #' !! char(snver) !!' contains cross pol. delay corrections' type 'CL #'!!char(gainuse)!!' 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(gainuse=0)then; gainuse=MAXTAB('cl');end if(refant=0)then; refant=1;end if(gainuse<0)then; docalib -1;end if(gainuse>0)then; docalib 2;end if(stokes='')then; stokes='I';end inext 'cl';invers 1; keyword 'NO_ANT'; getthead; nplot=keyvalue(1) 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(optype<>'' & optype<>'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; pixrange -180 180;end keyword 'NO_ANT'; getthead; nplot=keyvalue(1) if(nplot>12)then; nplot=10;end runwait('snplt') end tget vlbasnpl return; finish PROC VLBASUMM *----------------------------------------------------------------------- * Plots an 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, vba_tim, vba_tim2, vba_frg, vba_sn, vba_cl, vba_lant scalar vba_i, vba_j, vba_acnt array time2(8) vnum=35 vput vlbampcl if(gainuse=0)then; gainuse=MAXTAB('cl');end if(refant=0)then; refant=1;end tput vlbampcl vba_ok=1; vba_tim=-1; vba_tim2=-1; vba_frg=-1; vba_lant=0; vba_acnt=0 tget vlbampcl for i=1 to 8 if timerang(i)<>0 then vba_tim=1 end if time2(i)<>0 then vba_tim2=1 end end if vba_tim < 0 then type 'TIMRANGE HAS NO DEFAULT' type 'SET TIMERANGE TO A CALIBRATOR SCAN AND RUN AGAIN' vba_ok=-1 end tget vlbampcl if(opcode='calp')&(ante(1)<>0)&(vba_tim2>0)then; vba_frg=1;end if(opcode='calp')&(ante(1)=0)&(vba_tim2>0) then vba_ok=-1 type 'Antennas and TIME2 are only set if there are antennas 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(antennas(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 & vba_ok>=0)then for vba_i=1 to 50 if(antennas(vba_i)<>0)then; vba_lant=vba_i; end end if(vba_lant=50)then for vba_i=1 to 49 for vba_j=vba_i+1 to 50 if(ante(vba_i)=ante(vba_j))then;vba_acnt=vba_acnt+1;end end end type 'vba_acnt='!!char(vba_acnt) if(vba_acnt=1225) then antennas=antennas(1), 0; vba_lant=1;tput vlbampcl else if(vba_acnt>0) then type 'You have requested a single ANTENNA multiple times.' type 'I am very confused. I QUIT!' end if(vba_acnt=0) then type 'Sorry you are limited to 49 antennas (excluding the refant).' end vba_ok=-1 end end end if vba_ok >=0 then type 'run FRING' task 'fring'; default; tget vlbampcl; task 'fring' docalib 2;dparm(8) 1; aparm(1) 2;dparm(1) 1 antennas(1)=-antennas(1); snver=0 runwait('fring') type 'RUN CLCAL' task 'clcal';default; tget vlbampcl;task 'clcal' gainver gainuse; gainuse=MAXTAB('cl')+1; snver=MAXTAB('SN') calsour '';sources '';timerang 0; antennas 0 runwait('clcal') vba_sn=snver vba_cl=gainuse end if(vba_frg>0)&(vba_ok>0)then type 'run fring again' task 'fring'; default; tget vlbampcl; task 'fring' gainu vba_cl;docalib 2;dparm(8) 1;antennas(vba_lant+1) refant aparm(1) 2;dparm(1) 1;calsour=sources;timerang=time2;snver=0 runwait('fring') type 'run clcal' task 'clcal';default; tget vlbampcl;task 'clcal' gainver gainuse; gainuse=vba_cl; snver=MAXTAB('SN') calsour '';sources '';opcode 'cali'; timerang 0; runwait('clcal') end if(vba_ok>0)then 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 PROCEDURE VLBAEOPS *----------------------------------------------------------------------- * Search for subarrays in VLBA data. * * Input adverbs: * INNAME file name * INCLASS file class * INSEQ file sequence number * INDISK disk number * INFILE file with correct EOPs *----------------------------------------------------------------------- scalar vba_ok, vba_get tput vlbaeops;vnum 35; vput vlbaeops; vba_ok=1; sys2com='';sysout='' vba_get=1 type 'attempting to download file with correct EOPS' syscom 'which wget system; if(error>0) then syscom 'which curl system if(error>0) then syscom 'which ncftpget system; if(error>0) then; vba_ok=-1;else; vba_get=-2;end else vba_get=-1 end end if(vba_ok>0) then sys2com(1)=' http://gemini.gsfc.nasa.gov/solve_save/usno_finals.erp type 'Dowload file:' if(vba_get>0) then; syscom 'wget -O /tmp/usno_finals.erp system else; if(vba_get=-1) then; syscom= 'curl sys2com(2)= ' > /tmp/usno_finals.erp system else; syscom='cd /tmp ; ncftpget -t 120 system end end if(error>0) then; vba_ok=-2;end if(error<0)then sys2com='' syscom 'find /tmp/usno_finals.erp system if(error>0) then; vba_ok=-3;end end end if(vba_ok<0)then type 'The automatic download failed' if(vba_ok=-1)then type 'Your system does not have the comand wget, curl or ncftpget type 'one of which are needed to automatically download the file type 'from Goddard. If you are a Mac user, the wget and ncftpget type 'commands exist in Fink. end if(vba_ok=-2)then type 'Although your system claims to have an web download command type 'it did not seem to work. See the error messages and contact type 'your system manager. end if(vba_ok=-3)then type 'Although the download did not produce any errors this script type 'cannot find /tmp/usno_finals.erp. Give up in confusion. end type 'Download the file manually from: type 'http://gemini.gsfc.nasa.gov/solve_save/usno_finals.erp type 'and run CLCOR with OPCODE=EOPS.' end vput vlbaeops if(vba_ok>0) then default clcor; vget vlbaeops; task 'clcor' infi='/tmp/usno_finals.erp opcode 'eops' runwait('clcor') tget vlbaeops if(substr(infile,1,1)=' ')then syscom '\rm /tmp/usno_finals.erp system if(error>0) then type 'Cannot remove /tmp/usno_final.erp end end type 'CL #'!!char(maxtab('CL'))!!' contains the EOP corrections' type 'It is a good idea to check this table with SNPLT or VLBASNPL' end tget vlbaeops return;finish PROCEDURE DAYNUM(VBA_DATE) *----------------------------------------------------------------------- * Returns the day number when given a date as a character string in * yyyymmdd format. The leap year calculation is good from 1901-2099. * VBA_DATE is a 16 character string so the user can send KEYWORD. *----------------------------------------------------------------------- array vba_mnum(12) scalar vba_yr, vba_mo, vba_day, vba_dnum, vba_ok *----------------------------------------------------------------------- vba_leap = 0; vba_yr=value(substr(vba_date,1,4)) vba_mnum(1)=0;vba_mnum(2)=31;vba_mnum(3)=59;vba_mnum(4)=90 vba_mnum(5)=120;vba_mnum(6)=151;vba_mnum(7)=181;vba_mnum(8)=212 vba_mnum(9)=243;vba_mnum(10)=273;vba_mnum(11)=304;vba_mnum(12)=334 vba_mo=value(substr(vba_date,5,6)); vba_day=value(substr(vba_date,7,8)) if(mod(vba_yr,4)=0&vba_mo>2) then; vba_leap=1;end vba_dnum=vba_mnum(vba_mo)+vba_day+vba_leap if(vba_mo<1)!(vba_mo>12)!(vba_day<1)!(vba_day>31)then; vba_dnum=-1;end return vba_dnum finish PROCEDURE VLBATECR *----------------------------------------------------------------------- * Search for subarrays in VLBA data. * * Input adverbs: * INNAME file name * INCLASS file class * INSEQ file sequence number * INDISK disk number * INFILE file with correct EOPs *----------------------------------------------------------------------- scalar vba_ok, vba_yr, vba_cr, vba_dnum, vba_i, vba_get, vba_days, vba_nfil scalar vba_un, vba_ii string*3 vba_chdn string*48 vba_inf *----------------------------------------------------------------------- tput vlbatecr; vnum 35; vput vlbatecr; vba_un= 1;sysout='' vba_ok=1;vba_get=1; sys2com=''; if(maxtab('NX')=0)then;vba_ok=-6;end if(vba_ok>0)then default gethead; vget vlbatecr; keyword = 'DATE-MAP'; gethead; vba_cr=value(substr(keystrng,1,4)) keyword = 'DATE-OBS'; gethead; vba_yr=value(substr(keystrng,1,4)) if(vba_yr>1997)&(vba_yr<=vba_cr) then; vba_dnum=daynum(keystrng); if(vba_dnum<1)!(vba_dnum>366) then; vba_ok=-4;end if(vba_yr=1998)&(vba_dnum<151)then; vba_ok=-5;end else vba_ok=-4; if(vba_yr<=1997) then; vba_ok=-5; end end default getthead; vget vlbatecr; inext 'nx';keyword 'num row'; getthead; pixxy keyvalue(1), 1; tabget vba_days=keyvalue(1)+keyvalue(2); pixxy(2)=2; tabget vba_nfil=ceil(vba_days+0.5*(keyvalue(1)+keyvalue(2))) if(vba_ok>0)&((vba_yr<2002)!((vba_yr=2002)&(vba_dnum<305))) then if(((vba_days+0.5*(keyvalue(1)+keyvalue(2)))-vba_nfil+1.0)*24.0>23.0) then vba_nfil=vba_nfil+1 end pixxy 1, 1; tabget; vba_days=keyvalue(1)+keyvalue(2); pixxy(2)=2; tabget if((vba_days-0.5*(keyvalue(1)+keyvalue(2)))*24.0<1.0) then vba_nfil=vba_nfil+1; vba_dnum=vba_dnum-1 end if(vba_yr=1998)&(vba_dnum<151)then; vba_ok=-5;end end if(vba_ok>0) then syscom 'which wget system if(error>0) then syscom 'which curl system if(error>0) then syscom 'which ncftpget system if(error>0) then; vba_ok=-1;else; vba_get=-2;end else vba_get=-1 end end end if(vba_ok>0) then syscom 'which uncompress system if(error>0) then syscom 'which zcat system if(error>0) then; vba_un=-1;else; vba_un=2; end end end if(vba_ok>0) then type 'Download file(s):' for vba_ii=vba_dnum to vba_dnum+vba_nfil-1 vba_i=vba_ii if(vba_i > (365.0+vba_leap))then vba_i=vba_i-(365.0+vba_leap) vba_yr=vba_yr+1 end substr(vba_chdn,1,2)='00'; if(vba_i>99) then; vba_chdn=char(vba_i) else if(vba_i>9) then substr(vba_chdn,2,3)=char(vba_i) else substr(vba_chdn,3,3)=char(vba_i) end end sys2com(3)=' ftp://cddis.gsfc.nasa.gov/gps/products/ionex/ sys2com(4)=char(vba_yr)!!'/'!!vba_chdn!!'/' sys2com(5)='jplg sys2com(6)=vba_chdn!!'0.'!!substr(char(vba_yr),3,4)!!'i sys2com(7)='.Z' if(vba_get>0) then syscom 'wget -t 30 -O /tmp/jplg sys2com(1)=sys2com(6) sys2com(2)=sys2com(7) system if(error>0) then syscom 'wget -t 30 -O /tmp/codg sys2com(5)='codg system end else if(vba_get=-1) then syscom 'curl sys2com(1)='';sys2com(2) = '' sys2com(8)=' > /tmp/jplg sys2com(8)=sys2com(8)!!sys2com(6)!!sys2com(7) system if(error>0) then sys2com(5)='codg sys2com(8)=' > /tmp/codg sys2com(8)=sys2com(8)!!sys2com(6)!!sys2com(7) system end else syscom='cd /tmp ; ncftpget -t 120 system if(error>0) then sys2com(5)='codg system end end end if(error>0) then; vba_ok=-2; end if(error<=0 & vba_un>0)then if(vba_un=2)then syscom = 'zcat /tmp/ sys2com(2) = ' > /tmp/ sys2com(3) = sys2com(5)!!sys2com(6) else syscom = 'uncompress /tmp/ sys2com(2) = ''; sys2com(3) = '' end sys2com(1) = sys2com(5)!!sys2com(6)!!sys2com(7) if(vba_i=vba_dnum)then vba_inf = '/tmp/ vba_inf = vba_inf!!sys2com(5)!!sys2com(6) end sys2com(4)~'','','','',''; system if(error>0) then; vba_ok=-3;end end end end if(vba_ok<0)then type 'The automatic download failed' if(vba_ok=-1)then type 'Your system does not have any of the three possible commands, type 'wget, curl or ncftpget, that this script attempts to use to type 'automatically download the IONEX file(s). end if(vba_ok=-4) then type 'Attempt to convert observation date to day number failed.' type 'Check the observation date in the header of this file.' end if(vba_ok=-5) then type 'IONEX files do not exist for dates earlier than June 1, 1998.' end if(vba_ok<>-5) then type 'Download the file(s) manually (see TECOR EXPLAIN file),' type 'and run TECOR.' end end if(vba_un<0)then type 'Your system does not have one of the two possible commands, type 'uncompress or zcat, to uncompress the IONEX file(s). if(vba_ok>0)then type 'The files have been downloaded and are in your /tmp directory type 'so you can run TECOR on them if you can figure out how to type 'uncompress them. end end end if(vba_ok>0 & vba_un>0) then default tecor; vget vlbatecr; task 'tecor' nfiles=vba_nfil; aparm 1, 0; infile=vba_inf; runwait('tecor') type 'Number of files downloaded = '!!char(nfiles) type 'CL #'!!char(maxtab('CL'))!!' contains ionospheric corrections' vba_inf= 'X'!!vba_inf; substr(vba_inf,1,1)=' '; default system; syscom '\rm sys2com(1)=vba_inf; system end if(vba_ok=-6) then type 'You must have a NX table to use this procedure. type 'Run INDXR or VLBAFIX and try again. end tget vlbatecr return;finish