LOCAL INCLUDE 'SNRMS.INC'
      INTEGER   NCODE
      PARAMETER (NCODE=27)
C                                       Local include for SNRMS
      INCLUDE 'INCS:PUVD.INC'
C                                       Input parameters
      REAL      XSIN, XDISIN, XNVER, XQUAL, XTIME(8), XBAND, XFREQ,
     *   XFQID, XSUBA, XBIF, XEIF, XANT(50), XREF, XPCNUM, CUTOFF,
     *   DOCRT
      HOLLERITH XNAMEI(3), XCLAIN(2), XTYPE(1), XXSOUR(4,30), XXSTOK(1),
     *   XOPTY(1), XOUTPR(12)
      CHARACTER NAMEIN*12, CLAIN*6, TYPE*2, XSOUR(30)*16, XSTOK*4,
     *   OPTYPE*4, OUTPRT*48, TITL1*256, TITL2*256
C                                       Program info
C
      INTEGER   MXSCAN
      PARAMETER (MXSCAN=5000)
C
      REAL      TSTART, TSTOP, TINT, XYSCL(2), XYOFF(2), YYMX(10),
     *   YYMN(10), XMX, XMN, XMXW, XMNW, GMMOD, RATFAC(MAXIF), SELBAN,
     *   XSTART, XSTOP, CHOUT(4), XXMIN(MAXANT), XXMAX(MAXANT),
     *   YYMIN(2,MAXIF,MAXANT,10), TSCAN(MXSCAN), PPMAX(2,MAXIF,MAXANT),
     *   YYMAX(2,MAXIF,MAXANT,10), PPMIN(2,MAXIF,MAXANT), PRAN(2,2),
     *   DO3COL, TCAL(4,MAXIF,MAXANT), CSMIN, CSMAX
      INTEGER   SEQIN, DISKIN, CNOIN, IVER, BIF, ANTS(50), NCOUNT,
     *   ICODES(10), NCODES, NPARMS, NID, SID(500), NANTSL, NPLOTS,
     *   SUMSTK, ISTOK, FRQSEL, GRCHN, TVCHN, TVCORN(4), XVAR,
     *   ISOU, OSOU, IANT, EIF, ITPLOT, ITVER, PCNUM, LABEL, SUBARR,
     *   MUMPOL, MUMIF, MUMANT, NTONE, NUMPTS(MAXANT), ISYM,
     *   BSYM, NANREC(MAXANT), FANREC(MAXANT), NOSCAN, STRANS(MXSCAN),
     *   REFANT, MAXREC, LUNP, FINDP, NACROS, IPCNT
      LOGICAL   DOAWNT, DOTV, NNODAT, DOLINE, SWAP, REREF, DOTEX
      DOUBLE PRECISION SELFRQ, JD0, GNRECD(XCLRSZ/2)
C                                       SN/CL table info
      INTEGER CLBUFF(512), NCLINR, NUMANT, NUMPOL, NUMIF, ICLRNO,
     *   KOLS(40), KOLTYP(40), KOLDIM(40), ICLUN, GNRECI(XCLRSZ),
     *   TIMKOL, INTKOL, SOUKOL, ANTKOL, SUBKOL, FRQKOL, IFRKOL,
     *   GEOKOL, DOPKOL, ATMKOL, DATKOL,
     *   MB1KOL, RE1KOL, IM1KOL, DL1KOL, RA1KOL, WT1KOL, RF1KOL, TS1KOL,
     *   TA1KOL, CK1KOL, DC1KOL, DS1KOL, DD1KOL,
     *   MB2KOL, RE2KOL, IM2KOL, DL2KOL, RA2KOL, WT2KOL, RF2KOL, TS2KOL,
     *   TA2KOL, CK2KOL, DC2KOL, DS2KOL, DD2KOL,
     *   MBKOL(4), REKOL(4), IMKOL(4), DLKOL(4), RAKOL(4), WTKOL(4),
     *   RFKOL(4), TSKOL(4), TAKOL(4), CKKOL(4), DCKOL(4), DSKOL(4),
     *   DDKOL(4), STKOL(4),
     *   DOPLKL, DOP3KL, CLTIME, CABKOL, ST1KOL, ST2KOL
      REAL GNREC(XCLRSZ)
C                                       Constants
      DOUBLE PRECISION SIDER, CLIGHT
      COMMON /INPARM/ XNAMEI, XCLAIN, XSIN, XDISIN, XTYPE, XNVER,
     *   XXSOUR, XQUAL, XTIME, XXSTOK, XBAND, XFREQ, XFQID, XSUBA, XBIF,
     *   XEIF, XANT, XOPTY, XREF, XPCNUM, CUTOFF, DOCRT, XOUTPR
      COMMON /VPARM/ SEQIN, DISKIN, CNOIN, IVER, BIF, EIF, ANTS, NCOUNT,
     *   ICODES, NCODES, NPARMS, GRCHN, TVCHN, TVCORN, XVAR, ISOU, OSOU,
     *   IANT, ITPLOT, ITVER, PCNUM, DOTV, NNODAT, LABEL, CHOUT, DO3COL,
     *   DOLINE, NOSCAN, TSCAN, STRANS, SWAP, REREF, REFANT, MAXREC,
     *   LUNP, FINDP, NACROS, IPCNT, DOTEX
      COMMON /VGNCOM/ SELFRQ, JD0,
     *   TSTART, TSTOP, TINT, XYSCL, XYOFF, SELBAN, XMX, XMN, XMXW,
     *   XMNW, XSTART, XSTOP, GMMOD, RATFAC, NID, SID, NANTSL, PRAN,
     *   NPLOTS, DOAWNT, ISTOK, SUMSTK, FRQSEL,
     *   SUBARR, MUMPOL, MUMIF, MUMANT, NUMPTS, NTONE,
     *   XXMIN, XXMAX, YYMIN, YYMAX, PPMIN, PPMAX, YYMX, YYMN, ISYM,
     *   BSYM, TCAL, NANREC, FANREC, CSMIN, CSMAX
      COMMON /VGNCHR/ NAMEIN, CLAIN, TYPE, XSOUR, XSTOK, OPTYPE,
     *   OUTPRT, TITL1, TITL2
      COMMON /TABCOM/ GNREC, CLBUFF, NCLINR, NUMANT, NUMPOL, NUMIF,
     *   ICLRNO, KOLS, KOLTYP, KOLDIM, ICLUN,
     *   MBKOL, REKOL, IMKOL, DLKOL, RAKOL, WTKOL, RFKOL, TSKOL,
     *   TAKOL, CKKOL, DCKOL, DSKOL, DDKOL, STKOL,
     *   DOPLKL, DOP3KL, CLTIME
      COMMON /CONST/ SIDER, CLIGHT
      EQUIVALENCE (GNREC, GNRECD, GNRECI)
      EQUIVALENCE (KOLS(1), TIMKOL), (KOLS(2), INTKOL),
     *   (KOLS(3), SOUKOL), (KOLS(4), ANTKOL), (KOLS(5), SUBKOL),
     *   (KOLS(6), FRQKOL), (KOLS(7), IFRKOL),
     *   (KOLS(8), GEOKOL), (KOLS(9), DOPKOL), (KOLS(10), ATMKOL),
     *   (KOLS(11), DATKOL)
      EQUIVALENCE (KOLS(12), MB1KOL),
     *   (KOLS(13), RE1KOL), (KOLS(14), IM1KOL),
     *   (KOLS(15), RA1KOL), (KOLS(16), DL1KOL), (KOLS(17), WT1KOL),
     *   (KOLS(18), RF1KOL), (KOLS(19), TS1KOL), (KOLS(20), TA1KOL),
     *   (KOLS(21), CK1KOL), (KOLS(22), DC1KOL),
     *   (KOLS(23), DS1KOL), (KOLS(24), DD1KOL)
      EQUIVALENCE (KOLS(25), MB2KOL),
     *   (KOLS(26), RE2KOL), (KOLS(27), IM2KOL),
     *   (KOLS(28), RA2KOL), (KOLS(29), DL2KOL), (KOLS(30), WT2KOL),
     *   (KOLS(31), RF2KOL), (KOLS(32), TS2KOL), (KOLS(33), TA2KOL),
     *   (KOLS(34), CK2KOL), (KOLS(35), DC2KOL),
     *   (KOLS(36), DS2KOL), (KOLS(37), DD2KOL),
     *   (KOLS(38), CABKOL), (KOLS(39), ST1KOL), (KOLS(40), ST2KOL)
C                                                          End SNRMS
LOCAL END
      PROGRAM SNRMS
C-----------------------------------------------------------------------
C! Prints statitics from a SN, TY, PC or CL table
C# UV Plot EXT-appl Calibration
C-----------------------------------------------------------------------
C;  Copyright (C) 2023
C;  Associated Universities, Inc. Washington DC, USA.
C;
C;  This program is free software; you can redistribute it and/or
C;  modify it under the terms of the GNU General Public License as
C;  published by the Free Software Foundation; either version 2 of
C;  the License, or (at your option) any later version.
C;
C;  This program is distributed in the hope that it will be useful,
C;  but WITHOUT ANY WARRANTY; without even the implied warranty of
C;  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
C;  GNU General Public License for more details.
C;
C;  You should have received a copy of the GNU General Public
C;  License along with this program; if not, write to the Free
C;  Software Foundation, Inc., 675 Massachusetts Ave, Cambridge,
C;  MA 02139, USA.
C;
C;  Correspondence concerning AIPS should be addressed as follows:
C;         Internet email: aipsmail@nrao.edu.
C;         Postal address: AIPS Project Office
C;                         National Radio Astronomy Observatory
C;                         520 Edgemont Road
C;                         Charlottesville, VA 22903-2475 USA
C-----------------------------------------------------------------------
C   SNRMS plots SN or CL extension files. A 'PL' extension file is made
C   which can be displayed in the usual ways .
C   Inputs:
C      INNAME.....UV file name (name).       Standard defaults.
C      INCLASS....UV file name (class).      Standard defaults.
C      INSEQ......UV file name (seq. #).     0 => highest.
C      INDISK.....Disk unit #.               0 => any.
C      INEXT......'SN','TY','PC' or 'CL' table to be plotted
C      INVERS.....Version number of table to plot, 0=>highest no.
C      SOURCES....Source list.  '*' = all; a "-" before a source
C                 name means all except ANY source named.
C      TIMERANG...Time range of the data to be plotted. In order:
C                 Start day, hour, min. sec,
C                 end day, hour, min. sec. Days relative to ref.
C                 date.
C      STOKES.....The desired Stokes type of the output data:
C                 'R' = RCP, 'L' = LCP, 'DIFF' = difference
C      BIF........IF to plot
C      ANTENNAS...A list of the antennas to be plotted. All 0 => all.
C                 If any number is negative then all antennas listed
C                 are NOT to be plotted and all others are.
C      OPTYPE.....Data to be plotted: 'PHAS' = phase, 'AMP '=  ampl.,
C                 'DELA' = delay, 'RATE' = rate, 'TSYS' = sys. temp.
C                 'SUM ' = summary, 'DOPL' = doppler offset, 'SNR' =
C                 signal to noise ratio, 'CCAL' = cable-cal,
C                 'DDLY' = dispersive delay  'IFR' Faraday rotation
C                 '    ' => 'PHAS'
C-----------------------------------------------------------------------
      CHARACTER PRGN*6
      REAL      PLTPTS(2), STATS(2)
      LONGINT   PPLTPT, PSTAT
      INTEGER   IRET, MVAL, NWORDS, NROWS
      INCLUDE 'SNRMS.INC'
      INCLUDE 'INCS:DCAT.INC'
      INCLUDE 'INCS:DGPH.INC'
      INCLUDE 'INCS:DANS.INC'
      INCLUDE 'INCS:DLOC.INC'
      INCLUDE 'INCS:DFIL.INC'
      INCLUDE 'INCS:DMSG.INC'
      INCLUDE 'INCS:DHDR.INC'
      INCLUDE 'INCS:DDCH.INC'
      INCLUDE 'INCS:DUVH.INC'
      DATA PRGN /'SNRMS '/
C-----------------------------------------------------------------------
C                                       Get input parameters
      CALL SNPIN (PRGN, NROWS, IRET)
      MUMANT = MAX (1, MUMANT)
      MVAL = 3 + MUMPOL*MUMIF
      NWORDS = (MVAL * NROWS - 1) / 1024  + 21
      CALL ZMEMRY ('GET ', TSKNAM, NWORDS, PLTPTS, PPLTPT, IRET)
      IF (IRET.NE.0) THEN
         MSGTXT = 'UNABLE TO GET DYNAMIC MEMORY'
         CALL MSGWRT (8)
         END IF
C                                       read data to figure out
C                                       distribution
      NWORDS = NWORDS * 1024
      IF (IRET.EQ.0) CALL SNPCNT (NWORDS, IRET)
      NWORDS = (MAXREC - 1) / 1024 + 4
      CALL ZMEMRY ('GET ', TSKNAM, NWORDS, STATS, PSTAT, IRET)
      IF (IRET.NE.0) THEN
         MSGTXT = 'UNABLE TO GET DYNAMIC MEMORY'
         CALL MSGWRT (8)
         END IF
C                                       Fetch data, determine scaling
      IF (IRET.EQ.0) CALL SNPMAX (MVAL, PLTPTS(1+PPLTPT), IRET)
C                                       Re-reference
      IF ((IRET.EQ.0) .AND. (REREF)) CALL SNPREF (MVAL,
     *   PLTPTS(1+PPLTPT), IRET)
C                                       Do print out
      IF (IRET.EQ.0) CALL SNPRNT (MVAL, MUMANT, PLTPTS(1+PPLTPT),
     *   STATS(1+PSTAT), IRET)
      CALL LPCLOS (LUNP, FINDP, IPCNT, MVAL)
      IF (IRET.LT.0) IRET = 0
C                                       Close down
      CALL DIE (IRET, CLBUFF)
C
 999  STOP
      END
      SUBROUTINE SNPIN (PRGN, NROWS, IERR)
C-----------------------------------------------------------------------
C   Gets the inputs parameters for SNRMS.
C   Inputs:
C      PRGN    C*6  Program name
C   Output in common:
C      SUMSTK  I    Selected Stokes 0=both, 1=R, 2=L, 4=difference
C   Output:
C      IERR    I    Error code: 0 => ok
C      ISTOK   I    1 = R, 2 = L
C      ICODE   I    1='PHAS', 2='AMP ', 3='DELA', 4='RATE', 5='TSYS',
C                   6='SUM ', 7='DOPL', 8='SNR', 9='MDEL', 10='TANT',
C                   11='ATM', 12='GEO', 13='CCAL', 14='DDLY'
C                   15='REAL', 16='IMAG', 17='IFR', 18='PDIF',
C                   19='PSUM', 20=PGN ', 21='PON ', 22='POFF', 23='PSYS'
C                   24='PDGN', 25='PSGN', 26='POWR', 27='PODB'
C-----------------------------------------------------------------------
      INTEGER   NROWS, IERR
      CHARACTER PRGN*6
C
      INTEGER   NTPLT
      PARAMETER (NTPLT=5)
C
      INCLUDE 'SNRMS.INC'
      CHARACTER STAT*4, CODE(NCODE)*4, TYPTMP*2, TPLOT(NTPLT)*4
      INTEGER   IRET, BUFF(256), I, J, K, JERR, QUAL(30), NSOUR,
     *   BUFFER(512), IROUND, LUN, VER, NIF, NSTOK, FRQTMP, ICODE
      LOGICAL T, F, MATCH, ISTYPE
      DOUBLE PRECISION FOFF(MAXIF)
      INTEGER   ISBAND(MAXIF)
      REAL      FINC(MAXIF)
      CHARACTER BNDCOD(MAXIF)*8
      INCLUDE 'INCS:DDCH.INC'
      INCLUDE 'INCS:DCAT.INC'
      INCLUDE 'INCS:DANS.INC'
      INCLUDE 'INCS:DANT.INC'
      INCLUDE 'INCS:DFIL.INC'
      INCLUDE 'INCS:DMSG.INC'
      INCLUDE 'INCS:DHDR.INC'
      INCLUDE 'INCS:DUVH.INC'
      INCLUDE 'INCS:PSTD.INC'
      DATA CODE /'PHAS', 'AMP ', 'DELA', 'RATE', 'TSYS', 'SUM ', 'DOPL',
     *   'SNR ', 'MDEL', 'TANT', 'ATM ', 'GEO ', 'CCAL', 'DDLY', 'REAL',
     *   'IMAG', 'IFR ', 'PDIF', 'PSUM', 'PGN ', 'PON ', 'POFF', 'PSYS',
     *   'PDGN', 'PSGN', 'POWR', 'PODB'/
      DATA TPLOT /'ALIF', 'ALST', 'ALSI', 'IFDF', 'IFRA'/
      DATA T, F /.TRUE.,.FALSE./
C-----------------------------------------------------------------------
      OSOU = -1
      NPARMS = 211
      TSKNAM = PRGN
C                                       Initialize the IO parameters.
      CALL ZDCHIN (.TRUE.)
C                                       Initialize header index values.
      CALL VHDRIN
C                                       Zero counters for DIE.
      NCFILE = 0
      NSCR = 0
      CALL FILL (10, 0, IBAD)
C                                       Get input values from AIPS.
      IERR = 0
      CALL GTPARM (PRGN, NPARMS, RQUICK, XNAMEI, BUFF, IERR)
      IF (IERR.NE.0) THEN
         WRITE (MSGTXT,1000) IERR
         CALL MSGWRT (8)
         IERR = 1
         IRET = 8
         RQUICK = .FALSE.
         GO TO 990
         END IF
      IF (DOCRT.GT.0.0) RQUICK = .FALSE.
      IF (RQUICK) CALL RELPOP (IERR, BUFF, I)
C                                       Decode inputs.
C                                       characters
      CALL H2CHR (12, 1, XNAMEI, NAMEIN)
      CALL H2CHR (6, 1, XCLAIN, CLAIN)
      CALL H2CHR (2, 1, XTYPE, TYPE)
      CALL H2CHR (4, 1, XXSTOK, XSTOK)
      CALL H2CHR (4, 1, XOPTY, OPTYPE)
      CALL H2CHR (48, 1, XOUTPR, OUTPRT)
      DOTEX = (DOCRT.GT.132) .OR. (DOCRT.LT.-3.0)
      DOCRT = MIN (132., DOCRT)
      IF (DOCRT.LT.-3.0) DOCRT = -1.0
C                                       OPTYPE='REAL', 'IMAG' only for
C                                       SN table
      IF ((OPTYPE.EQ.'REAL' .OR. OPTYPE.EQ.'IMAG')
     *   .AND. (TYPE.NE.'SN' .AND. TYPE.NE.'CL')) THEN
         MSGTXT = '!!OPTYPE=REAL/IMAG works only with SN/CL table!!'
         CALL MSGWRT (8)
         IERR = 1
         GO TO 999
         END IF
C
      DO 20 I = 1,30
         CALL H2CHR (16, 1, XXSOUR(1,I), XSOUR(I))
         QUAL(I) = IROUND (XQUAL)
 20      CONTINUE
      IF (TYPE.EQ.' ') TYPE ='SN'
      CUTOFF = MAX (0.0, CUTOFF)
      IF ((TYPE.EQ.'TY') .OR. (TYPE.EQ.'PC') .OR. (TYPE.EQ.'SY'))
     *   CUTOFF = -1000.0
      CALL FILL (MAXANT, 0, NUMPTS)
C                                       Do not treat the weight for TY
C                                       and PC because these tables do
C                                       not have weight's collumn
      XTYPE = HBLANK
      CALL CHR2H (2, TYPE, 1, XTYPE)
C                                       Integers
      SEQIN = IROUND (XSIN)
      DISKIN = IROUND (XDISIN)
      IVER = IROUND (XNVER)
      PCNUM = IROUND (XPCNUM)
      IF (PCNUM.LE.0) PCNUM = 1
C                                       plot types
      REREF = (OPTYPE.EQ.'RPHS') .OR. (OPTYPE.EQ.'RDLY')
      IF (REREF) THEN
         REFANT = XREF + 0.1
         IF (OPTYPE.EQ.'RPHS') OPTYPE = 'PHAS'
         IF (OPTYPE.EQ.'RDLY') OPTYPE = 'DELA'
         BSYM = MAX (1, BSYM)
         IF (REFANT.LE.0) THEN
            MSGTXT = 'OPTYPE ''RPHS'' REQUIRES A REFANT'
            CALL MSGWRT (8)
            IERR = 10
            GO TO 999
            END IF
         END IF
      ICODE = 1
      DO 30 I = 1,NCODE
         IF (OPTYPE.EQ.CODE(I)) ICODE = I
 30      CONTINUE
      CALL CHR2H (4, CODE(ICODE), 1, XOPTY)
      NCODES = 1
      ICODES(1) = ICODE
C                                       Time range
      TSTART = XTIME(1) + (XTIME(2) / 24.0) + (XTIME(3) / (24.0*60.0)) +
     *   (XTIME(4) / (24.0*3600.0))
      TSTOP = XTIME(5) + (XTIME(6) / 24.0) + (XTIME(7) / (24.0*60.0)) +
     *   (XTIME(8) / (24.0*3600.0))
      IF (TSTART.GE.TSTOP) THEN
         TSTART = 0.0
         TSTOP = 999.0
         END IF
C                                       Find input catalog
      CNOIN = 1
      TYPTMP = 'UV'
      CALL CATDIR ('SRCH', DISKIN, CNOIN, NAMEIN, CLAIN, SEQIN, TYPTMP,
     *   NLUSER, STAT, BUFF, IERR)
      IF (IERR.NE.0) THEN
         WRITE (MSGTXT,1030) IERR, NAMEIN, CLAIN, SEQIN, DISKIN,
     *      'UV', NLUSER
         GO TO 990
         END IF
C                                       Save name class etc.
      CALL CHR2H (12, NAMEIN, 1, XNAMEI)
      CALL CHR2H (6, CLAIN, 1, XCLAIN)
      XDISIN = DISKIN
      XSIN = SEQIN
C                                       Read catalog header
      STAT = 'READ'
      CALL CATIO ('READ', DISKIN, CNOIN, CATBLK, STAT, BUFF, IERR)
      IF (IERR.NE.0) THEN
         WRITE (MSGTXT,1040) IERR
         GO TO 990
         END IF
      NCFILE = NCFILE + 1
      FCNO(NCFILE) = CNOIN
      FVOL(NCFILE) = DISKIN
      FRW(NCFILE) = 0
      XDISIN = DISKIN
      CALL UVPGET (IERR)
      IF (IERR.NE.0) GO TO 990
      SEQIN = CATBLK(KIIMS)
      XSIN = SEQIN
C                                       Subarray
      SUBARR = IROUND (XSUBA)
      IF (SUBARR.EQ.0) SUBARR = 1
C                                       Freq id
      IF (XBAND.GT.0.0) SELBAN = XBAND
      IF (XFREQ.GT.0.0) SELFRQ = XFREQ
      FRQSEL = IROUND (XFQID)
      IF (FRQSEL.GE.0) THEN
         LUN = 25
         CALL FQMATC (DISKIN, CNOIN, CATBLK, LUN, SELBAN, SELFRQ, MATCH,
     *      FRQSEL, IERR)
         IF (.NOT.MATCH) THEN
            WRITE (MSGTXT,1070)
            IERR = 1
            GO TO 990
            END IF
         IF (IERR.GT.0) GO TO 999
         END IF
C                                       IF'S
      IF (JLOCIF.GE.0) THEN
         BIF = IROUND (XBIF)
         BIF = MAX (1, MIN (BIF, CATBLK(KINAX+JLOCIF)))
         EIF = IROUND (XEIF)
         IF (EIF.LT.BIF) EIF = CATBLK(KINAX+JLOCIF)
         IF (EIF.GT.CATBLK(KINAX+JLOCIF)) EIF = CATBLK(KINAX+JLOCIF)
      ELSE
         BIF = 1
         EIF = 1
         END IF
C                                       Look up sources
      NID = 500
      NSOUR = 30
      MSGSUP = 32000
      CALL SOURNU (XSOUR, QUAL, NSOUR, DISKIN, CNOIN, NID, BUFFER, SID,
     *   JERR)
      MSGSUP = 0
      IF (JERR.LT.0) THEN
         MSGTXT = 'SPECIFIED SOURCE(S) NOT FOUND - CONTINUING'
         CALL MSGWRT (6)
         END IF
      IF (JERR.NE.0) NID = 0
C                                       Check antennas desired.
      NANTSL = 0
      DOAWNT = T
      DO 70 J = 1,50
         ANTS(J) = IROUND (XANT(J))
         IF (ANTS(J).LT.0) DOAWNT = F
C                                       Make positive
         ANTS(J) = ABS (ANTS(J))
         IF (NANTSL.LT.1) GO TO 60
            DO 50 K = 1,NANTSL
               IF (ANTS(J).EQ.ANTS(K)) ANTS(J) = 0
 50            CONTINUE
C                                       Check for multiple entries
 60      IF (ABS (ANTS(J)).GE.1) NANTSL = J
 70      CONTINUE
C                                       Make sure not too many
      IF (NANTSL.GT.MAXANT) NANTSL = MAXANT
C                                       need REFANT to rereference
      IF ((NANTSL.GT.0) .AND. (REREF)) THEN
         K = 0
         DO 75 J = 1,NANTSL
            IF (ANTS(J).EQ.REFANT) K = J
 75         CONTINUE
         IF (DOAWNT) THEN
            IF (K.EQ.0) THEN
               NANTSL = NANTSL + 1
               ANTS(NANTSL) = REFANT
               MSGTXT = 'YOU LEFT OUT REFANT - FIXING THAT'
               CALL MSGWRT (7)
               END IF
         ELSE
            IF (K.GT.0) THEN
               ANTS(K) = 0
               IF (K.EQ.NANTSL) NANTSL = NANTSL - 1
               MSGTXT = 'YOU INCLUDED REFANT TO BE AVOIDED - FIXING'
               CALL MSGWRT (7)
               END IF
            END IF
         END IF
C                                       Get antenna names
      CALL GETANT (DISKIN, CNOIN, MAX (1, SUBARR), CATBLK, BUFFER, JERR)
      MUMANT = NSTNS
      IF (MUMANT.LE.1) THEN
         MUMANT = MAXANT
         TIMLAB = 'IAT'
         END IF
      CALL JULDAY (RDATE, JD0)
C                                       Rate scaling to Hz
      DO 80 I = BIF,EIF
         RATFAC(I-BIF+1) = FREQ
 80      CONTINUE
      IF ((OPTYPE.EQ.'RATE') .OR. (ISTYPE(4))) THEN
         VER = 1
         LUN = 25
         IF (FRQSEL.LE.0) FRQTMP = 1
         IF (FRQSEL.GT.0) FRQTMP = FRQSEL
         CALL CHNDAT ('READ', BUFFER, DISKIN, CNOIN, VER, CATBLK, LUN,
     *      NIF, FOFF, ISBAND, FINC, BNDCOD, FRQTMP, JERR)
         IF (JERR.EQ.0) THEN
            DO 85 I = BIF,EIF
               RATFAC(I-BIF+1) = FREQ + FOFF(I)
 85         CONTINUE
            END IF
         END IF
C                                       Check Stokes' (R or IPOL)
C                                       Set stokes request
      NSTOK = CATBLK(KINAX+JLOCS)
      MUMPOL = 1
      IF ((ICOR0.EQ.1) .OR. (ICOR0.EQ.-2) .OR. (ICOR0.EQ.-6) .OR.
     *   (((ICOR0.EQ.-1) .OR. (ICOR0.EQ.-5)) .AND. (NSTOK.EQ.1))) THEN
         ISTOK = ABS (ICOR0)
         SUMSTK = 1
         XSTOK = 'I'
         IF (ICOR0.EQ.-2) XSTOK='L'
         IF (ICOR0.EQ.-1) XSTOK='R'
      ELSE IF (ICOR0.EQ.-1) THEN
         IF ((XSTOK.EQ.'R') .OR. (XSTOK.EQ.'RR')) THEN
            ISTOK = 1
            SUMSTK = 1
            XSTOK = 'R'
         ELSE IF ((XSTOK.EQ.'L') .OR. (XSTOK.EQ.'LL')) THEN
            ISTOK = 2
            SUMSTK = 2
            XSTOK = 'L'
         ELSE
            ISTOK = 1
            SUMSTK = 0
            XSTOK = 'R&L'
            IF (ICODES(1).NE.6) MUMPOL = 2
            END IF
      ELSE IF (ICOR0.EQ.-5) THEN
         IF ((XSTOK.EQ.'V') .OR. (XSTOK.EQ.'VV')) THEN
            ISTOK = 1
            SUMSTK = 1
            XSTOK = 'V'
         ELSE IF ((XSTOK.EQ.'H') .OR. (XSTOK.EQ.'HH')) THEN
            ISTOK = 2
            SUMSTK = 2
            XSTOK = 'H'
         ELSE
            ISTOK = 1
            SUMSTK = 0
            XSTOK = 'V&H'
            IF (ICODES(1).NE.6) MUMPOL = 2
            END IF
         END IF
      CALL CHR2H (4, XSTOK, 1, XXSTOK)
C                                       Open table to check
C                                       Open SN, CL, TY or PC table
      IF ((TYPE.EQ.'SN') .OR. (TYPE.EQ.'CL') .OR. (TYPE.EQ.'TY') .OR.
     *   (TYPE.EQ.'PC') .OR. (TYPE.EQ.'SY')) THEN
         CALL SNPOPN (NROWS, IERR)
         IF (IERR.NE.0) GO TO 999
C                                       Invalid table type
      ELSE
         IERR = 5
         MSGTXT = 'INVALID TABLE TYPE =' // TYPE
         GO TO 990
         END IF
C                                       Get TCals
      IF ((TYPE.EQ.'SY') .AND. (ISTYPE(23))) THEN
         J = 0
         CALL GETCDS (DISKIN, CNOIN, J, SUBARR, FRQSEL, CATBLK, TCAL,
     *      JERR)
         IF (JERR.NE.0) GO TO 999
         END IF
      XNVER = IVER
      MUMIF = EIF - BIF + 1
      IF (ITPLOT.GE.4) MUMIF = 1
      IF (ICODES(1).EQ.6) MUMIF = 1
      XBIF = BIF
      XEIF = EIF
      CSMAX = -100000
      CSMIN = 1000000
      CALL RFILL (MAXANT, 1.E5, XXMIN)
      CALL RFILL (MAXANT, -1.E5, XXMAX)
      I = 2 * MAXIF * MAXANT
      CALL RFILL (I, 1.E8, PPMIN)
      CALL RFILL (I, -1.E8, PPMAX)
      I = I * 10
      CALL RFILL (I, 1.E8, YYMIN)
      CALL RFILL (I, -1.E8, YYMAX)
      CALL RFILL (10, -1.E8, YYMX)
      CALL RFILL (10,  1.E8, YYMN)
      NOSCAN = 0
      GO TO 999
C
 990  CALL MSGWRT (8)
C
 999  RETURN
C-----------------------------------------------------------------------
 1000 FORMAT ('ERROR;',I7,'GETTING INPUT PARAMETERS')
 1030 FORMAT ('ERROR',I3,' FINDING ',A12,'.',A6,'.',I4,' DISK=',I3,
     *   ' TYPE=',A2,' USER=',I4)
 1040 FORMAT ('ERROR',I3,' COPYING CATALOG HEADER')
 1070 FORMAT ('NO MATCH TO SELBAND/SELFREQ ADVERBS - CHECK INPUTS')
      END
      SUBROUTINE SNPOPN (NROWS, IERR)
C-----------------------------------------------------------------------
C   Routine to open SN, CL, PC, TY, SY table and get necessary
C   information
C   Input from Common:
C      TYPE     C*2  'SN', 'CL', 'PC', 'TY', SY
C      DISKIN   I     Disk number
C      CNOIN    I     Catalog slot number
C      CATBLK   I(*)  Catalog header
C      SUMSTK   I     Stokes type requested 0=both, 1=R, 2=L,
C   Output:
C      IERR     I     Error code, 0=OK else failed.
C   Output in common:
C      ICLRNO       I    Current cal record number
C      NCLINR       I    Number of gain records in file.
C      NUMANT       I    Number of antennas
C      NUMPOL       I    Number of polarizations
C      NUMIF        I    Number of IFs.
C      ITVER        I    Version number opened.
C      KOLS         I(*) Column pointers
C      KOLTYP       I(*) Column data types
C      KOLDIM       I(*) Column dimension
C-----------------------------------------------------------------------
      INTEGER   NROWS, IERR
      INCLUDE 'SNRMS.INC'
C
      INTEGER MAXPCC
      PARAMETER (MAXPCC = 40)
      CHARACTER KEYW(4)*8, COLHD1(11)*24, COLHD2(13)*24, COLHD3(13)*24,
     *   COLTAB(40)*24, COLHED(37)*24, COLPC(MAXPCC)*24, KEYSN(4)*8,
     *   KEYPC(3)*8, COLPC1(20)*24, COLPC2(20)*24
      INTEGER   NKEY, NREC, NCOL, DATP(128,2), IPOINT, KEYTYP(4),
     *   KLOCS(4), KEYVAL(6), I, KP, MSGSAV
      LOGICAL   T, ISTYPE, DOM
      REAL      KEYVR(6)
      DOUBLE PRECISION KEYVAD
      INCLUDE 'INCS:DCAT.INC'
      INCLUDE 'INCS:DMSG.INC'
      INCLUDE 'INCS:DDCH.INC'
      INCLUDE 'INCS:DHDR.INC'
      INCLUDE 'INCS:DUVH.INC'
      INCLUDE 'INCS:PSTD.INC'
      INCLUDE 'INCS:DANS.INC'
      EQUIVALENCE (KEYVAL, KEYVR)
      EQUIVALENCE (COLHED(1), COLHD1), (COLHED(12), COLHD2),
     *   (COLHED(25), COLHD3)
      EQUIVALENCE (COLPC(1), COLPC1), (COLPC(21), COLPC2)
      DATA COLHD1 /'TIME                    ',
     *   'TIME INTERVAL           ',
     *   'SOURCE ID               ', 'ANTENNA NO.             ',
     *   'SUBARRAY                ', 'FREQ ID                 ',
     *   'I.FAR.ROT               ',
     *   'GEODELAY                ', 'DOPPOFF                 ',
     *   'ATMOS                   ', 'DATMOS                  '/
      DATA COLHD2 /'MBDELAY1      ',
     *   'REAL1                   ', 'IMAG1                   ',
     *   'RATE 1                  ', 'DELAY 1                 ',
     *   'WEIGHT 1                ', 'REFANT 1                ',
     *   'TSYS 1                  ', 'TANT 1                  ',
     *   'CLOCK 1                 ', 'DCLOCK 1                ',
     *   'DISP 1                  ', 'DDISP 1                 '/
      DATA COLHD3 /'MBDELAY2      ',
     *   'REAL2                   ', 'IMAG2                   ',
     *   'RATE 2                  ', 'DELAY 2                 ',
     *   'WEIGHT 2                ', 'REFANT 2                ',
     *   'TSYS 2                  ', 'TANT 2                  ',
     *   'CLOCK 2                 ', 'DCLOCK 2                ',
     *   'DISP 2                  ', 'DDISP 2                 '/
      DATA COLPC1 /'TIME                ',
     *   'TIME_INTERVAL           ', 'SOURCE_ID               ',
     *   'ANTENNA_NO              ', 'ARRAY                   ',
     *   'FREQID                  ', 'DUM1                    ',
     *   'DUM2                    ', 'DUM3                    ',
     *   'DUM4                    ', 'DUM5                    ',
     *   'PC_FREQ 1               ', 'PC_REAL 1               ',
     *   'PC_IMAG 1               ', 'PC_RATE 1               ',
     *   'DUM6                    ', 'DUM7                    ',
     *   'DUM8                    ', 'DUM9                    ',
     *   'DUM10                   ' /
      DATA COLPC2 /'DUM11                   ',
     *   'DUM12                   ', 'DUM13                   ',
     *   'DUM14                   ', 'PC_FREQ 2               ',
     *   'PC_REAL 2               ', 'PC_IMAG 2               ',
     *   'PC_RATE 2               ', 'DUM15                   ',
     *   'DUM16                   ', 'DUM17                   ',
     *   'DUM18                   ', 'DUM19                   ',
     *   'DUM20                   ', 'DUM21                   ',
     *   'DUM22                   ', 'DUM23                   ',
     *   'CABLE_CAL               ', 'STATE 1                 ',
     *   'STATE 2                 ' /
      DATA KEYSN /'NO_ANT  ', 'NO_POL  ', 'NO_IF   ','MGMOD   '/
      DATA KEYPC /'NO_POL  ', 'NO_BAND ', 'NO_TONES' /
      DATA T /.TRUE./
C-----------------------------------------------------------------------
      IF (TYPE.EQ.'SY') THEN
         DO 110 I = 1,NCODES
            IF ((ICODES(I).LT.18) .OR. (ICODES(I).GT.25)) THEN
               MSGTXT = 'DATA OF REQUESTED TYPE NOT IN SY TABLES'
               IERR = 5
               GO TO 980
               END IF
 110        CONTINUE
         END IF
      IF ((ISTYPE(3)) .AND. ((TYPE.EQ.'TY') .OR. (TYPE.EQ.'PC'))) THEN
         MSGTXT = 'NO SINGLEBAND DELAY IN THIS TABLE TYPE - CHECK INEXT'
         IERR = 5
         GO TO 980
         END IF
      IF ((ISTYPE(4)) .AND. (TYPE.EQ.'TY')) THEN
         MSGTXT = 'NO RESIDUAL RATE IN THIS TABLE TYPE - CHECK INEXT'
         IERR = 5
         GO TO 980
         END IF
      IF ((ISTYPE(5)) .AND. (TYPE.NE.'TY')) THEN
         MSGTXT = 'NO TSYS IN THIS TABLE TYPE - CHECK INEXT'
         IERR = 5
         GO TO 980
         END IF
      IF ((ISTYPE(7)) .AND. (TYPE.NE.'CL')) THEN
         MSGTXT = 'NO DOPPLER OFFSET IN THIS TABLE TYPE - CHECK INEXT'
         IERR = 5
         GO TO 980
         END IF
      IF ((ISTYPE(8)) .AND. ((TYPE.EQ.'TY') .OR. (TYPE.EQ.'PC'))) THEN
         MSGTXT = 'NO SNR IN THIS TABLE TYPE - CHECK INEXT'
         IERR = 5
         GO TO 980
         END IF
      IF ((ISTYPE(9)) .AND. ((TYPE.EQ.'TY') .OR. (TYPE.EQ.'PC'))) THEN
         MSGTXT = 'NO MULTIBAND DELAY IN THIS TABLE TYPE - CHECK INEXT'
         IERR = 5
         GO TO 980
         END IF
      IF ((ISTYPE(10)) .AND. (TYPE.NE.'TY')) THEN
         MSGTXT = 'NO TANT IN THIS TABLE TYPE - CHECK INEXT'
         IERR = 5
         GO TO 980
         END IF
      IF ((ISTYPE(11)) .AND. (TYPE.NE.'CL')) THEN
         MSGTXT = 'NO ATMOS. DELAY IN THIS TABLE TYPE - CHECK INEXT'
         IERR = 5
         GO TO 980
         END IF
      IF ((ISTYPE(12)) .AND. (TYPE.NE.'CL')) THEN
         MSGTXT = 'NO GEOM. DELAY IN THIS TABLE TYPE - CHECK INEXT'
         IERR = 5
         GO TO 980
         END IF
      IF ((ISTYPE(13)) .AND. (TYPE.NE.'PC')) THEN
         MSGTXT = 'NO CABLE CAL IN THIS TABLE TYPE - CHECK INEXT'
         IERR = 5
         GO TO 980
         END IF
      IF ((ISTYPE(14)) .AND. (TYPE.NE.'CL') .AND. (TYPE.NE.'SN')) THEN
         MSGTXT = 'NO DISP. DELAY IN THIS TABLE TYPE - CHECK INEXT'
         IERR = 5
         GO TO 980
         END IF
      IF ((ISTYPE(17)) .AND. (TYPE.NE.'CL') .AND. (TYPE.NE.'SN')) THEN
         MSGTXT = 'NO FARADAY ROT. IN THIS TABLE TYPE - CHECK INEXT'
         IERR = 5
         GO TO 980
         END IF
C                                       Open table
      ICLUN = 28
      NKEY = 0
      NREC = 0
      NCOL = 0
      ICLRNO = 1
      CALL TABINI ('READ', TYPE, DISKIN, CNOIN, IVER, CATBLK, ICLUN,
     *   NKEY, NREC, NCOL, DATP, CLBUFF, IERR)
      IF (IERR.GT.0) THEN
         WRITE (MSGTXT,1100) IERR, TYPE, IVER
         GO TO 980
         END IF
      ITVER = IVER
C                                       Get number of scans
      NCLINR = CLBUFF(5)
      NROWS = NCLINR
C                                       Check if empty
      IF (NCLINR.LE.0) THEN
         IERR = 6
         MSGTXT = 'ERROR: SELECTED TABLE IS EMPTY'
         CALL MSGWRT (8)
         GO TO 999
         END IF
C                                       Get column pointers
      NKEY = 40
      IF (TYPE.EQ.'PC') NKEY = MAXPCC
      DO 10 I = 1,NKEY
         IF (TYPE.EQ.'PC') THEN
            COLTAB(I) = COLPC(I)
         ELSE
            COLTAB(I) = COLHED(I)
            END IF
 10      CONTINUE
C                                       SY uses Re/Im/Wt for
C                                       DIF, SUM, GAIN
      IF (TYPE.EQ.'SY') THEN
         COLTAB(13) = 'POWER DIF1'
         COLTAB(14) = 'POWER SUM1'
         COLTAB(17) = 'POST GAIN1'
         COLTAB(21) = 'CAL TYPE'
         COLTAB(26) = 'POWER DIF2'
         COLTAB(27) = 'POWER SUM2'
         COLTAB(30) = 'POST GAIN2'
         COLTAB(34) = 'CAL TYPE'
         END IF
      CALL FNDCOL (NKEY, COLTAB, 24, T, CLBUFF, KOLS, IERR)
      IF ((IERR.GE.1) .AND. (IERR.LE.10)) GO TO 999
      IERR = 0
C                                       Time column logical number
      CLTIME = KOLS(1)
C                                       Convert to pointers, types
      DO 20 I = 1,NKEY
         KP = KOLS(I)
         IF (KP.GT.0) THEN
            KOLS(I) = DATP(KP,1)
            KOLTYP(I) = MOD (DATP(KP,2), 10)
            KOLDIM(I) = DATP(KP,2) / 10
         ELSE
            KOLS(I) = -1
            KOLTYP(I) = -1
            KOLDIM(I) = 0
            END IF
 20      CONTINUE
C                                       Table keywords
      NKEY = 4
      IF (TYPE.EQ.'PC') NKEY = 3
      DO 30 I = 1,NKEY
         IF (TYPE .EQ. 'PC') THEN
            KEYW(I) = KEYPC(I)
         ELSE
            KEYW(I) = KEYSN(I)
            END IF
 30      CONTINUE
      MSGSAV = MSGSUP
      MSGSUP = 32000
      CALL TABKEY ('READ', KEYW, NKEY, CLBUFF, KLOCS, KEYVAL, KEYTYP,
     *   IERR)
      MSGSUP = MSGSAV
      IF ((IERR.GE.1) .AND. (IERR.LE.20)) GO TO 999
      IERR = 0
C                                       Retrieve keyword values: PC
      IF (TYPE.EQ.'PC') THEN
         NUMANT = NSTNS
         GMMOD = 1.0
C                                       No. poln.
         NUMPOL = 1
         IPOINT = KLOCS(2)
         IF (IPOINT.GT.0) NUMPOL = KEYVAL(IPOINT)
C                                       No. IF
         NUMIF = 1
         IPOINT = KLOCS(3)
         IF (IPOINT.GT.0) NUMIF = KEYVAL(IPOINT)
C                                       No. tones
         NTONE = 1
         IPOINT = KLOCS(3)
         IF (IPOINT.GT.0) NTONE = KEYVAL(IPOINT)
C                                       Retrieve keyword values: other
      ELSE
         NTONE = 1
C                                       No. antennas.
         NUMANT = NSTNS
         IPOINT = KLOCS(1)
         IF (IPOINT.GT.0) NUMANT = KEYVAL(IPOINT)
C                                       No. poln.
         NUMPOL = 1
         IPOINT = KLOCS(2)
         IF (IPOINT.GT.0) NUMPOL = KEYVAL(IPOINT)
C                                       No. IF
         NUMIF = 1
         IPOINT = KLOCS(3)
         IF (IPOINT.GT.0) NUMIF = KEYVAL(IPOINT)
C                                       Mean gain modulus
         GMMOD = 1.0
         IPOINT = KLOCS(4)
         IF (IPOINT.GT.0) THEN
            IF (KEYTYP(4).EQ.1) THEN
               CALL DPCOPY (1, KEYVR(IPOINT), KEYVAD)
            ELSE
               KEYVAD = KEYVR(IPOINT)
               END IF
            IF (KEYVAD.GT.0.0) GMMOD = 1.0 / KEYVAD
            END IF
         END IF
C                                       Set pointers
      DOPKOL = DOPKOL + BIF - 1
      DOP3KL = DOPKOL + EIF - 1
      DOPLKL = DOPKOL
      IF (TYPE.NE.'PC') PCNUM = 1
      IF (PCNUM.GT.NTONE) PCNUM = 1
      PCNUM = MAX (1, PCNUM)
C                                       1st poln
      IF ((ISTOK.EQ.ABS (ICOR0)) .OR. (ISTOK.EQ.ABS (ICOR0+4))) THEN
         MBKOL(1) = MB1KOL
         REKOL(1) = RE1KOL + ((BIF-1) * NTONE) + PCNUM - 1
         IMKOL(1) = IM1KOL + ((BIF-1) * NTONE) + PCNUM - 1
         DLKOL(1) = DL1KOL + BIF - 1
         RAKOL(1) = RA1KOL + BIF - 1
         WTKOL(1) = WT1KOL + BIF - 1
         RFKOL(1) = RF1KOL + BIF - 1
         TSKOL(1) = TS1KOL + BIF - 1
         TAKOL(1) = TA1KOL + BIF - 1
         CKKOL(1) = CK1KOL
         DCKOL(1) = DC1KOL
         DSKOL(1) = DS1KOL
         DDKOL(1) = DD1KOL
         STKOL(1) = ST1KOL + BIF - 1
C                                       2nd poln
      ELSE
         MBKOL(1) = MB2KOL
         REKOL(1) = RE2KOL + ((BIF-1) * NTONE) + PCNUM - 1
         IMKOL(1) = IM2KOL + ((BIF-1) * NTONE) + PCNUM - 1
         DLKOL(1) = DL2KOL + BIF - 1
         RAKOL(1) = RA2KOL + BIF - 1
         WTKOL(1) = WT2KOL + BIF - 1
         RFKOL(1) = RF2KOL + BIF - 1
         TSKOL(1) = TS2KOL + BIF - 1
         TAKOL(1) = TA2KOL + BIF - 1
         CKKOL(1) = CK2KOL
         DCKOL(1) = DC2KOL
         DSKOL(1) = DS2KOL
         DDKOL(1) = DD2KOL
         STKOL(1) = ST2KOL + BIF - 1
         END IF
C                                       2nd Poln
      MBKOL(2) = MB2KOL
      REKOL(2) = RE2KOL + ((BIF-1) * NTONE) + PCNUM - 1
      IMKOL(2) = IM2KOL + ((BIF-1) * NTONE) + PCNUM - 1
      DLKOL(2) = DL2KOL + BIF - 1
      RAKOL(2) = RA2KOL + BIF - 1
      WTKOL(2) = WT2KOL + BIF - 1
      RFKOL(2) = RF2KOL + BIF - 1
      TSKOL(2) = TS2KOL + BIF - 1
      TAKOL(2) = TA2KOL + BIF - 1
      CKKOL(2) = CK2KOL
      DCKOL(2) = DC2KOL
      DSKOL(2) = DS2KOL
      DDKOL(2) = DD2KOL
      STKOL(2) = ST2KOL + BIF - 1
C                                       Phase, amplitude, summary
      DOM = .FALSE.
      IF ((ISTYPE(1)) .OR. (ISTYPE(2)) .OR. (ISTYPE(6))
     *      .OR. (ISTYPE(15)) .OR. (ISTYPE(16))
     *      .OR. (ISTYPE(24)) .OR. (ISTYPE(25))) THEN
         IF ((REKOL(1).LT.0) .AND. (IMKOL(1).LT.0)) GO TO 500
         IF (((MUMPOL.EQ.2)) .AND. ((REKOL(2).LT.0) .OR.
     *      (IMKOL(2).LT.0))) GO TO 500
         END IF
C                                       Singleband Delay
      IF (ISTYPE(3)) THEN
         IF (DLKOL(1).LT.0) GO TO 500
         IF ((MUMPOL.EQ.2) .AND. (DLKOL(2).LT.0)) GO TO 500
         END IF
C                                       Rate
      IF (ISTYPE(4)) THEN
         IF (RAKOL(1).LT.0) GO TO 500
         IF ((MUMPOL.EQ.2) .AND. (RAKOL(2).LT.0)) GO TO 500
         END IF
C                                       System temperature
      IF (ISTYPE(5)) THEN
         IF (TSKOL(1).LT.0) GO TO 500
         IF ((MUMPOL.EQ.2) .AND. (TSKOL(2).LT.0)) GO TO 500
         END IF
C                                       Doppler offset
      IF (ISTYPE(7)) THEN
         IF (DOPLKL.LT.0) GO TO 500
C                                       Only 1 value
         MUMPOL = 1
         SUMSTK = 0
         BIF = 1
         EIF = 1
         CUTOFF = -1000.0
         END IF
C                                       SNR
      IF (ISTYPE(8)) THEN
         IF (WTKOL(1).LT.0) GO TO 500
         IF ((SUMSTK.GE.3) .AND. (WTKOL(2).LT.0)) GO TO 500
         IF ((MUMPOL.EQ.2) .AND. (WTKOL(2).LT.0)) GO TO 500
         END IF
C                                       MDEL (multiband delay)
      IF (ISTYPE(9)) THEN
         IF (MBKOL(1).LT.0) GO TO 500
         IF ((SUMSTK.GE.3) .AND. (MBKOL(2).LT.0)) GO TO 500
         IF ((MUMPOL.EQ.2) .AND. (MBKOL(2).LT.0)) GO TO 500
C                                       Only 1 per poln
         BIF = 1
         EIF = 1
         CUTOFF = -1000.0
         END IF
C                                       IF Antenna Temp
      IF (ISTYPE(10)) THEN
         IF (TAKOL(1).LT.0) GO TO 500
         IF ((SUMSTK.GE.3) .AND. (TAKOL(2).LT.0)) GO TO 500
         IF ((MUMPOL.EQ.2) .AND. (TAKOL(2).LT.0)) GO TO 500
         END IF
C                                       Atmosphere
      IF (ISTYPE(11)) THEN
         IF (ATMKOL.LT.0) GO TO 500
C                                       Only 1 value
         MUMPOL = 1
         SUMSTK = 0
         BIF = 1
         EIF = 1
         CUTOFF = -1000.0
         END IF
C                                       If geometric delay
      IF (ISTYPE(12)) THEN
         IF (WTKOL(1).LT.0) GO TO 500
C                                       Only 1 value
         MUMPOL = 1
         SUMSTK = 0
         BIF = 1
         EIF = 1
         CUTOFF = -1000.0
         END IF
C                                       If cable cal
      IF (ISTYPE(13)) THEN
         IF (CABKOL.LT.0) GO TO 500
C                                       Only 1 value
         MUMPOL = 1
         SUMSTK = 0
         BIF = 1
         EIF = 1
         CUTOFF = -1000.0
         END IF
C                                       DDLY (dispersive delay)
      IF (ISTYPE(14)) THEN
         IF (DSKOL(1).LT.0) GO TO 500
         IF ((SUMSTK.GE.3) .AND. (DSKOL(2).LT.0)) GO TO 500
         IF ((MUMPOL.EQ.2) .AND. (DSKOL(2).LT.0)) GO TO 500
C                                       Only 1 per poln
         BIF = 1
         EIF = 1
         CUTOFF = -1000.0
         SUMSTK = MIN (SUMSTK, 3)
         END IF
C                                       Ionospheric Faraday rotation
      IF (ISTYPE(17)) THEN
         IF (IFRKOL.LT.0) GO TO 500
C                                       Only 1 value
         MUMPOL = 1
         BIF = 1
         EIF = 1
         CUTOFF = -1000.0
         END IF
C                                       SY Pdif
      IF (ISTYPE(18)) THEN
         IF (REKOL(1).LT.0) GO TO 500
         IF ((MUMPOL.EQ.2) .AND. (REKOL(2).LT.0)) GO TO 500
         END IF
C                                       SY Psum
      IF (ISTYPE(19)) THEN
         IF (IMKOL(1).LT.0) GO TO 500
         IF ((MUMPOL.EQ.2) .AND. (IMKOL(2).LT.0)) GO TO 500
         END IF
C                                       SY post gain
      IF (ISTYPE(20)) THEN
         IF (WTKOL(1).LT.0) GO TO 500
         IF ((MUMPOL.EQ.2) .AND. (WTKOL(2).LT.0)) GO TO 500
         END IF
C                                       SY Pon and Poff
      IF ((ISTYPE(21)) .OR. (ISTYPE(22))) THEN
         IF (REKOL(1).LT.0) GO TO 500
         IF ((MUMPOL.EQ.2) .AND. (REKOL(2).LT.0)) GO TO 500
         IF (IMKOL(1).LT.0) GO TO 500
         IF ((MUMPOL.EQ.2) .AND. (IMKOL(2).LT.0)) GO TO 500
         IF (WTKOL(1).LT.0) GO TO 500
         IF ((MUMPOL.EQ.2) .AND. (WTKOL(2).LT.0)) GO TO 500
         END IF
C                                       SY TSYS
      IF (ISTYPE(23)) THEN
         IF (REKOL(1).LT.0) GO TO 500
         IF ((MUMPOL.EQ.2) .AND. (REKOL(2).LT.0)) GO TO 500
         IF (IMKOL(1).LT.0) GO TO 500
         IF ((MUMPOL.EQ.2) .AND. (IMKOL(2).LT.0)) GO TO 500
         END IF
      GO TO 999
C                                       Requested data not in table
 500  WRITE(MSGTXT,1500) OPTYPE, TYPE
      IERR = 10
      GO TO 980
C                                       Error
 980  CALL MSGWRT (8)
C
 999  RETURN
C-----------------------------------------------------------------------
 1100 FORMAT ('ERROR ',I3,' OPENING ',A,' TABLE NO. ',I3)
 1500 FORMAT (' REQUESTED DATA ',A,' NOT IN ',A,' TABLE ')
      END
      LOGICAL FUNCTION ISTYPE (FTYPE)
C-----------------------------------------------------------------------
C   ISTYPE inquires if type in list of requested types
C   Inputs:
C      FTYPE    I   Test type
C   Output:
C      ISTYPE   L   T => TYPE in ICODES
C-----------------------------------------------------------------------
      INTEGER   FTYPE
C
      INTEGER   I
      INCLUDE 'SNRMS.INC'
C-----------------------------------------------------------------------
      ISTYPE = .FALSE.
      DO 10 I = 1,NCODES
         IF (ICODES(I).EQ.FTYPE) ISTYPE = .TRUE.
 10      CONTINUE
C
 999  RETURN
      END
      SUBROUTINE SNPCNT (NWORDS, IERR)
C-----------------------------------------------------------------------
C   SNPCNT reads the SN or CL table to find the number of samples for
C   each antenna
C   Input:
C      NWORDS   I      Size of work array
C   Input/Output in common:
C      TSTART   R      Start time of plot
C      TSTOP    R      Stop time of plot
C   Output:
C      IERR     I      Error code, 0=OK else failed
C   Outputs in common:
C-----------------------------------------------------------------------
      INTEGER   NWORDS, IERR
C
      INCLUDE 'SNRMS.INC'
      LOGICAL   NODATA, OKAY
      INTEGER   I, NP, IFNUM, SCNT(MXSCAN)
      REAL      TB, TE, GTIME, XVARIB, CSOU
      REAL      VALUE(2*MAXIF,10)
      INCLUDE 'INCS:DDCH.INC'
      INCLUDE 'INCS:DCAT.INC'
      INCLUDE 'INCS:DMSG.INC'
      INCLUDE 'INCS:DFIL.INC'
      INCLUDE 'INCS:PSTD.INC'
C-----------------------------------------------------------------------
      CALL FILL (MAXANT, 0, NANREC)
      CALL FILL (MXSCAN, 0, SCNT)
      NODATA = .TRUE.
      TB = 1.0E5
      TE = -1.0E5
      XVAR = 1
      IF ((XVAR.EQ.1) .AND. (TSTART.GT.0.0) .AND. (TSTOP.LT.999.0)) THEN
         TB = TSTART
         TE = TSTOP
         END IF
      XMX = TE
      XMN = TB
      XMXW = TE
      XMNW = TB
C                                       Loop thru data
      TINT = -1.0
      IF (INTKOL.LE.0) TINT = 10.0 / 86400.0
      NP = MUMPOL * MUMIF
      DO 100 ICLRNO = 1,NCLINR
         CALL TABIO ('READ', 0, ICLRNO, GNREC, CLBUFF, IERR)
         IF (IERR.LT.0) GO TO 100
         IF (IERR.GT.0) THEN
            WRITE (MSGTXT,1010) IERR
            GO TO 990
            END IF
C                                       Solution interval
         IF (TINT.LE.0) TINT = GNREC(INTKOL)
C                                       Check weight per IF
C                                       If weight < CUTOFF them
C                                       set amp, phase, delay and
C                                       rate to FBLANK FOR EACH IF
         IF ((CUTOFF.GE.0.0) .AND. (WT1KOL.GT.0)) THEN
            IF (NUMPOL.EQ.2) THEN
               IF ((SUMSTK.EQ.0) .OR. (SUMSTK.GE.3)) THEN
                  DO 5 IFNUM = 0, MUMIF - 1
                    IF (GNREC(WTKOL(1) + IFNUM).LE.CUTOFF) THEN
                       GNREC(REKOL(1) + IFNUM) = FBLANK
                       GNREC(IMKOL(1) + IFNUM) = FBLANK
                       GNREC(DLKOL(1) + IFNUM) = FBLANK
                       GNREC(RAKOL(1) + IFNUM) = FBLANK
                       ENDIF
                    IF (GNREC(WTKOL(2) + IFNUM).LE.CUTOFF) THEN
                       GNREC(REKOL(2) + IFNUM) = FBLANK
                       GNREC(IMKOL(2) + IFNUM) = FBLANK
                       GNREC(DLKOL(2) + IFNUM) = FBLANK
                       GNREC(RAKOL(2) + IFNUM) = FBLANK
                       ENDIF
5                 CONTINUE
               ELSE IF (SUMSTK.EQ.1) THEN
                  DO 15 IFNUM = 0, MUMIF - 1
                    IF (GNREC(WTKOL(1) + IFNUM).LE.CUTOFF) THEN
                       GNREC(REKOL(1) + IFNUM) = FBLANK
                       GNREC(IMKOL(1) + IFNUM) = FBLANK
                       GNREC(DLKOL(1) + IFNUM) = FBLANK
                       GNREC(RAKOL(1) + IFNUM) = FBLANK
                       ENDIF
15                CONTINUE
               ELSE IF (SUMSTK.EQ.2) THEN
                  DO 25 IFNUM = 0, MUMIF - 1
                    IF (GNREC(WTKOL(2) + IFNUM).LE.CUTOFF) THEN
                       GNREC(REKOL(2) + IFNUM) = FBLANK
                       GNREC(IMKOL(2) + IFNUM) = FBLANK
                       GNREC(DLKOL(2) + IFNUM) = FBLANK
                       GNREC(RAKOL(2) + IFNUM) = FBLANK
                       ENDIF
25                CONTINUE
                  END IF
               END IF
            IF (NUMPOL.EQ.1) THEN
                  DO 35 IFNUM = 0, MUMIF - 1
                    IF (GNREC(WTKOL(1) + IFNUM).LE.CUTOFF) THEN
                       GNREC(REKOL(1) + IFNUM) = FBLANK
                       GNREC(IMKOL(1) + IFNUM) = FBLANK
                       GNREC(DLKOL(1) + IFNUM) = FBLANK
                       GNREC(RAKOL(1) + IFNUM) = FBLANK
                       ENDIF
35                CONTINUE
               END IF
            END IF
C                                       Record within specified
C                                       time range ?
         IF (KOLTYP(CLTIME).EQ.1) THEN
            GTIME = GNRECD(TIMKOL)
         ELSE
            GTIME = GNREC(TIMKOL)
            END IF
         IF ((GTIME.LT.TSTART) .OR. (GTIME.GT.TSTOP)) GO TO 100
C                                       Freq id
         IF ((GNRECI(FRQKOL).GT.0) .AND. (GNRECI(FRQKOL).NE.FRQSEL)
     *      .AND. (FRQSEL.GT.0)) GO TO 100
C                                       Subarray
         IF (TYPE.NE.'PC') THEN
            IF ((GNRECI(SUBKOL).GT.0) .AND. (SUBARR.GT.0) .AND.
     *         (GNRECI(SUBKOL).NE.SUBARR)) GO TO 100
            END IF
C                                       Antenna?
         IANT = GNRECI(ANTKOL)
         IF (NANTSL.GT.0) THEN
            DO 50 I = 1,NANTSL
               IF ((IANT.EQ.ANTS(I)).AND.DOAWNT) GO TO 60
               IF ((IANT.EQ.ANTS(I)).AND.(.NOT.DOAWNT)) GO TO 100
 50            CONTINUE
            IF (DOAWNT) GO TO 100
            END IF
C                                       Check source
 60      IF (NID.GT.0) THEN
            ISOU = GNRECI(SOUKOL)
            DO 70 I = 1,NID
               IF (ISOU.EQ.SID(I)) GO TO 80
 70            CONTINUE
            GO TO 100
            END IF
C                                      Get start, stop times
 80      TB = MIN (TB, GTIME)
         TE = MAX (TE, GTIME)
C                                       Get value
         CALL SNPDAT (VALUE, XVARIB, CSOU, OKAY)
C                                       Max. - Min
         IF (((OKAY) .OR. (BSYM.GT.0)) .AND. (XVARIB.NE.FBLANK)) THEN
            IF (OKAY) NODATA = .FALSE.
            NANREC(IANT) = NANREC(IANT) + 1
            I = CSOU + 0.1
            IF ((I.GT.0) .AND. (I.LE.MXSCAN)) SCNT(I) = SCNT(I) + 1
            END IF
 100     CONTINUE
      IERR = MAX (0, IERR)
      FANREC(1) = 1
      MAXREC = NANREC(1)
      DO 120 I = 2,MAXANT
         FANREC(I) = FANREC(I-1) + NANREC(I-1)
         MAXREC = MAX (MAXREC, NANREC(I))
 120     CONTINUE
      IF (NWORDS.LT.FANREC(MAXANT)+NANREC(MAXANT)) THEN
         MSGTXT = 'MEMORY TOO SMALL'
         IERR = 10
         END IF
C                                       source number translation
      NP = 0
      CALL FILL (MXSCAN, 0, STRANS)
      DO 130 I = 1,MXSCAN
         IF (SCNT(I).GT.0) THEN
            NP = NP + 1
            STRANS(I) = NP
            END IF
 130     CONTINUE
C
 990  IF (IERR.NE.0) CALL MSGWRT (8)
C
 999  RETURN
C-----------------------------------------------------------------------
 1010 FORMAT ('SNPCNT: ERROR =',I3,' FROM TABIO')
      END
      SUBROUTINE SNPMAX (NV, PLTPTS, IERR)
C-----------------------------------------------------------------------
C   SNPMAX reads the SN or CL table to find the max and min values for
C   each station or IF prior to plotting.
C   Input:
C      NV       I      Number values per time (source, T, X, n*Y)
C   Input/Output in common:
C      TSTART   R      Start time of plot
C      TSTOP    R      Stop time of plot
C   Output:
C      PLTPTS   R(*)   Data to be plotted (NV, *)
C      IERR     I      Error code, 0=OK else failed
C   Outputs in common:
C-----------------------------------------------------------------------
      INTEGER   NV, IERR
      REAL      PLTPTS(NV,*)
C
      LOGICAL   NODATA, OKAY
      INTEGER   I, NP, NN, IP, IIF, IIS, IFNUM, IS, KK
      REAL      TB, TE, TMAX, TMIN, GTIME, XVARIB, CSOU, TEMP
      INCLUDE 'SNRMS.INC'
      REAL      VALUE(2*MAXIF,10)
      INCLUDE 'INCS:DDCH.INC'
      INCLUDE 'INCS:DCAT.INC'
      INCLUDE 'INCS:DMSG.INC'
      INCLUDE 'INCS:DFIL.INC'
      INCLUDE 'INCS:PSTD.INC'
C-----------------------------------------------------------------------
      NODATA = .TRUE.
      TB = 1.0E5
      TE = -1.0E5
      IF ((XVAR.EQ.1) .AND. (TSTART.GT.0.0) .AND. (TSTOP.LT.999.0)) THEN
         TB = TSTART
         TE = TSTOP
         END IF
      XMX = TE
      XMN = TB
      XMXW = TE
      XMNW = TB
C                                       Loop thru data
      TINT = -1.0
      IF (INTKOL.LE.0) TINT = 10.0 / 86400.0
      NP = MUMPOL * MUMIF
      DO 100 ICLRNO = 1,NCLINR
         CALL TABIO ('READ', 0, ICLRNO, GNREC, CLBUFF, IERR)
         IF (IERR.LT.0) GO TO 100
         IF (IERR.GT.0) THEN
            WRITE (MSGTXT,1010) IERR
            GO TO 990
            END IF
C                                       Solution interval
         IF (TINT.LE.0) TINT = GNREC(INTKOL)
C                                       Check weight per IF
C                                       If weight < CUTOFF them
C                                       set amp, phase, delay and
C                                       rate to FBLANK FOR EACH IF
         IF ((CUTOFF.GE.0.0) .AND. (WT1KOL.GT.0)) THEN
            IF (NUMPOL.EQ.2) THEN
               IF ((SUMSTK.EQ.0) .OR. (SUMSTK.GE.3)) THEN
                  DO 5 IFNUM = 0, MUMIF - 1
                    IF (GNREC(WTKOL(1) + IFNUM).LE.CUTOFF) THEN
                       GNREC(REKOL(1) + IFNUM) = FBLANK
                       GNREC(IMKOL(1) + IFNUM) = FBLANK
                       GNREC(DLKOL(1) + IFNUM) = FBLANK
                       GNREC(RAKOL(1) + IFNUM) = FBLANK
                       ENDIF
                    IF (GNREC(WTKOL(2) + IFNUM).LE.CUTOFF) THEN
                       GNREC(REKOL(2) + IFNUM) = FBLANK
                       GNREC(IMKOL(2) + IFNUM) = FBLANK
                       GNREC(DLKOL(2) + IFNUM) = FBLANK
                       GNREC(RAKOL(2) + IFNUM) = FBLANK
                       ENDIF
5                 CONTINUE
               ELSE IF (SUMSTK.EQ.1) THEN
                  DO 15 IFNUM = 0, MUMIF - 1
                    IF (GNREC(WTKOL(1) + IFNUM).LE.CUTOFF) THEN
                       GNREC(REKOL(1) + IFNUM) = FBLANK
                       GNREC(IMKOL(1) + IFNUM) = FBLANK
                       GNREC(DLKOL(1) + IFNUM) = FBLANK
                       GNREC(RAKOL(1) + IFNUM) = FBLANK
                       ENDIF
15                CONTINUE
               ELSE IF (SUMSTK.EQ.2) THEN
                  DO 25 IFNUM = 0, MUMIF - 1
                    IF (GNREC(WTKOL(2) + IFNUM).LE.CUTOFF) THEN
                       GNREC(REKOL(2) + IFNUM) = FBLANK
                       GNREC(IMKOL(2) + IFNUM) = FBLANK
                       GNREC(DLKOL(2) + IFNUM) = FBLANK
                       GNREC(RAKOL(2) + IFNUM) = FBLANK
                       ENDIF
25                CONTINUE
                  END IF
               END IF
            IF (NUMPOL.EQ.1) THEN
                  DO 35 IFNUM = 0, MUMIF - 1
                    IF (GNREC(WTKOL(1) + IFNUM).LE.CUTOFF) THEN
                       GNREC(REKOL(1) + IFNUM) = FBLANK
                       GNREC(IMKOL(1) + IFNUM) = FBLANK
                       GNREC(DLKOL(1) + IFNUM) = FBLANK
                       GNREC(RAKOL(1) + IFNUM) = FBLANK
                       ENDIF
35                CONTINUE
               END IF
            END IF
C                                       Record within specified
C                                       time range ?
         IF (KOLTYP(CLTIME).EQ.1) THEN
            GTIME = GNRECD(TIMKOL)
         ELSE
            GTIME = GNREC(TIMKOL)
            END IF
         IF ((GTIME.LT.TSTART) .OR. (GTIME.GT.TSTOP)) GO TO 100
C                                       Freq id
         IF ((GNRECI(FRQKOL).GT.0) .AND. (GNRECI(FRQKOL).NE.FRQSEL)
     *      .AND. (FRQSEL.GT.0)) GO TO 100
C                                       Subarray
         IF (TYPE.NE.'PC') THEN
            IF ((GNRECI(SUBKOL).GT.0) .AND. (SUBARR.GT.0) .AND.
     *         (GNRECI(SUBKOL).NE.SUBARR)) GO TO 100
            END IF
C                                       Antenna?
         IANT = GNRECI(ANTKOL)
         IF (NANTSL.GT.0) THEN
            DO 50 I = 1,NANTSL
               IF ((IANT.EQ.ANTS(I)).AND.DOAWNT) GO TO 60
               IF ((IANT.EQ.ANTS(I)).AND.(.NOT.DOAWNT)) GO TO 100
 50            CONTINUE
            IF (DOAWNT) GO TO 100
            END IF
C                                       Check source
 60      IF (NID.GT.0) THEN
            ISOU = GNRECI(SOUKOL)
            DO 70 I = 1,NID
               IF (ISOU.EQ.SID(I)) GO TO 80
 70            CONTINUE
            GO TO 100
            END IF
C                                      Get start, stop times
 80      TB = MIN (TB, GTIME)
         TE = MAX (TE, GTIME)
C                                       Get value
         CALL SNPDAT (VALUE, XVARIB, CSOU, OKAY)
C                                       Max. - Min
         IF (((OKAY) .OR. (BSYM.GT.0)) .AND. (XVARIB.NE.FBLANK)) THEN
            IF (OKAY) NODATA = .FALSE.
C                                       Put in array
            NUMPTS(IANT) = NUMPTS(IANT) + 1
            NN = FANREC(IANT) + NUMPTS(IANT) - 1
            IS = CSOU + 0.1
            IF ((IS.GT.0) .AND. (IS.LE.MXSCAN)) CSOU = STRANS(IS)
            PLTPTS(1,NN) = CSOU
            PLTPTS(2,NN) = GTIME
            PLTPTS(3,NN) = XVARIB
            KK = 4
            DO 81 I = 1,NCODES
               CALL RCOPY (NP, VALUE(1,I), PLTPTS(KK,NN))
               KK = KK + NP
 81            CONTINUE
            IF (ICODES(1).EQ.6) CALL RCOPY (NP, VALUE(1,2),
     *         PLTPTS(KK,NN))
            IF (XVAR.NE.6) THEN
               XMX = MAX (XMX, XVARIB)
               XMN = MIN (XMN, XVARIB)
            ELSE
               TEMP = XVARIB
               IF (TEMP.LT.0.0) TEMP = TEMP + 360.
               XMX = MAX (XMX, TEMP)
               XMN = MIN (XMN, TEMP)
               IF (TEMP.GT.180.0) TEMP = TEMP - 360
               XMXW = MAX (XMXW, TEMP)
               XMNW = MIN (XMNW, TEMP)
               END IF
            XXMAX(IANT) = MAX (XXMAX(IANT), XVARIB)
            XXMIN(IANT) = MIN (XXMIN(IANT), XVARIB)
            CSMIN = MIN (CSMIN, CSOU)
            CSMAX = MAX (CSMAX, CSOU)
C                                       If not a summary plot
            DO 95 KK = 1,NCODES
               IP = 0
               DO 90 IIF = 1,MUMIF
                  DO 85 IIS = 1,MUMPOL
                     IP = IP + 1
                     IF (VALUE(IP,KK).NE.FBLANK) THEN
                        YYMX(KK) = MAX (YYMX(KK), VALUE(IP,KK))
                        YYMN(KK) = MIN (YYMN(KK), VALUE(IP,KK))
                        IF (ICODES(KK).EQ.1) THEN
                           IF (VALUE(IP,KK).LE.-180.0) THEN
                              VALUE(IP,KK) = VALUE(IP,KK) + 360.
                           ELSE IF (VALUE(IP,KK).GT.180.) THEN
                              VALUE(IP,KK) = VALUE(IP,KK) - 360.
                              END IF
                           YYMIN(IIS,IIF,IANT,KK) = MIN (VALUE(IP,KK),
     *                        YYMIN(IIS,IIF,IANT,KK))
                           YYMAX(IIS,IIF,IANT,KK) = MAX (VALUE(IP,KK),
     *                        YYMAX(IIS,IIF,IANT,KK))
                           IF (VALUE(IP,KK).LT.0.0) VALUE(IP,KK) =
     *                        VALUE(IP,KK) + 360.0
                           PPMIN(IIS,IIF,IANT) = MIN (VALUE(IP,KK),
     *                        PPMIN(IIS,IIF,IANT))
                           PPMAX(IIS,IIF,IANT) = MAX (VALUE(IP,KK),
     *                        PPMAX(IIS,IIF,IANT))
                        ELSE IF (ICODES(KK).EQ.6) THEN
                           YYMIN(1,1,1,KK) = MIN (VALUE(IP,KK),
     *                        YYMIN(1,1,1,KK))
                           YYMAX(1,1,1,KK) = MAX (VALUE(IP,KK),
     *                        YYMAX(1,1,1,KK))
                           IF (VALUE(IP,2).LE.-180.0) THEN
                              VALUE(IP,2) = VALUE(IP,2) + 360.
                           ELSE IF (VALUE(IP,2).GT.180.) THEN
                              VALUE(IP,2) = VALUE(IP,2) - 360.
                              END IF
                           YYMIN(2,1,1,KK) = MIN (VALUE(IP,2),
     *                        YYMIN(2,1,1,KK))
                           YYMAX(2,1,1,KK) = MAX (VALUE(IP,2),
     *                        YYMAX(2,1,1,KK))
                           IF (VALUE(IP,2).LT.0.0) VALUE(IP,2) =
     *                        VALUE(IP,2) + 360.
                           PPMIN(1,1,1) = MIN (VALUE(IP,2),
     *                        PPMIN(1,1,1))
                           PPMAX(1,1,1) = MAX (VALUE(IP,2),
     *                        PPMAX(1,1,1))
                        ELSE
                           YYMIN(IIS,IIF,IANT,KK) = MIN (VALUE(IP,KK),
     *                        YYMIN(IIS,IIF,IANT,KK))
                           YYMAX(IIS,IIF,IANT,KK) = MAX (VALUE(IP,KK),
     *                        YYMAX(IIS,IIF,IANT,KK))
                           END IF
                        END IF
 85                  CONTINUE
 90               CONTINUE
 95            CONTINUE
            END IF
 100     CONTINUE
      IERR = MAX (0, IERR)
C                                       Set actual X range
      SWAP = .FALSE.
      IF (XVAR.EQ.1) THEN
         XSTART = TB
         XSTOP = TE
      ELSE IF (XVAR.EQ.6) THEN
         IF (XMX-XMN.LE.XMXW-XMNW) THEN
            XSTART = XMN
            XSTOP  = XMX
         ELSE
            XSTART = XMNW
            XSTOP  = XMXW
            SWAP = .TRUE.
            END IF
      ELSE
         XSTART = XMN
         XSTOP  = XMX
         END IF
C                                       Check for no data
      IF (NODATA) THEN
         IERR = 6
         MSGTXT = 'NO DATA SELECTED'
         GO TO 990
         END IF
C                                       check and set scaling
      IF ((XVAR.EQ.1) .AND. (TSTART.GT.0.0) .AND. (TSTOP.LT.999.0)) THEN
         TMAX = (XSTOP + 0.03 * (XSTOP - XSTART)) * 360.0
         TMIN = (XSTART- 0.03 * (XSTOP - XSTART)) * 360.0
      ELSE IF ((XVAR.EQ.1) .OR. (XVAR.EQ.3) .OR. (XVAR.EQ.4)) THEN
         TMAX = (XSTOP + 0.1 * (XSTOP - XSTART)) * 360.0
         TMIN = (XSTART- 0.1 * (XSTOP - XSTART)) * 360.0
      ELSE
         TMAX = (XSTOP + 0.1 * (XSTOP - XSTART))
         TMIN = (XSTART- 0.1 * (XSTOP - XSTART))
         END IF
C                                       If start time is stop time,
      IF (ABS (TMAX-TMIN) .LT. 0.01) THEN
         TMIN = MAX( TMIN-0.005, 0.0)
         TMAX = TMIN + 0.01
         END IF
      TSTART = TB
      TSTOP = TE
      XYOFF(1) = TMIN
      XYSCL(1) = 1000.0 / (TMAX - TMIN)
      PRAN(1,1) = TMIN
      PRAN(2,1) = TMAX
C                                       Send back time range
      XTIME(1) = TSTART
      XTIME(2) = 0.0
      XTIME(3) = 0.0
      XTIME(4) = 0.0
      XTIME(5) = TSTOP
      XTIME(6) = 0.0
      XTIME(7) = 0.0
      XTIME(8) = 0.0
      GO TO 999
C
 990  CALL MSGWRT (8)
C
 999  RETURN
C-----------------------------------------------------------------------
 1010 FORMAT ('SNPMAX: ERROR =',I3,' FROM TABIO')
      END
      SUBROUTINE SNPREF (NV, PLTPTS, IERR)
C-----------------------------------------------------------------------
C   SNPMAX re-references the phases in PLTPTS and recomputes min/max
C   Input:
C      NV       I      Number values per time (source, T, X, n*Y)
C   In/Output:
C      PLTPTS   R(*)   Data to be plotted (NV, *)
C   Outputs
C      IERR     I      Error code, 0=OK else failed
C   Outputs in common:
C-----------------------------------------------------------------------
      INTEGER   NV, IERR
      REAL      PLTPTS(NV,*)
C
      INTEGER   JANT, IA, IR, NREC, NMISS, NP, I, IP, IIF, IIS, IREC,
     *   RREC, JREC
      REAL      EPS, PH
      INCLUDE 'SNRMS.INC'
      INCLUDE 'INCS:DDCH.INC'
      INCLUDE 'INCS:DMSG.INC'
      DATA EPS /1.E-6/
C-----------------------------------------------------------------------
      NP = MUMPOL * MUMIF
      I = 2 * MAXIF * MAXANT
      CALL RFILL (I, 1.E8, PPMIN)
      CALL RFILL (I, -1.E8, PPMAX)
      I = I * 10
      CALL RFILL (I, 1.E8, YYMIN)
      CALL RFILL (I, -1.E8, YYMAX)
      CALL RFILL (10, -1.E8, YYMX)
      CALL RFILL (10,  1.E8, YYMN)
C                                       loop over all antennas except
      RREC = NUMPTS(REFANT)
      DO 50 JANT = 1,MUMANT
         NMISS = 0
         IF (JANT.EQ.REFANT) GO TO 50
         IA = FANREC(JANT) - 1
         NREC = NUMPTS(JANT)
         DO 40 IREC = 1,NREC
            IA = IA + 1
C                                       seek a match
            IR = FANREC(REFANT) - 1
            DO 10 JREC = 1,RREC
               IR = IR + 1
               IF ((PLTPTS(1,IR).EQ.PLTPTS(1,IA)) .AND.
     *            (ABS(PLTPTS(2,IR)-PLTPTS(2,IA)).LE.EPS)) GO TO 15
 10            CONTINUE
C                                       not match
            NMISS = NMISS + 1
            CALL RFILL (NP, FBLANK, PLTPTS(3,IA))
            GO TO 40
C                                       close enough
 15         IP = 3
            DO 30 IIF = 1,MUMIF
               DO 20 IIS = 1,MUMPOL
                  IP = IP + 1
                  IF ((PLTPTS(IP,IR).EQ.FBLANK) .OR.
     *               (PLTPTS(IP,IA).EQ.FBLANK)) THEN
                     PLTPTS(IP,IA) = FBLANK
C                                       phase
                  ELSE IF (ICODES(1).EQ.1) THEN
                     PH = PLTPTS(IP,IA) - PLTPTS(IP,IR)
                     IF (PH.LT.-180.0) PH = PH + 360.0
                     IF (PH.GT.180.0) PH = PH - 360.0
                     PLTPTS(IP,IA) = PH
                     YYMX(1) = MAX (YYMX(1), PH)
                     YYMN(1) = MIN (YYMN(1), PH)
                     YYMIN(IIS,IIF,JANT,1) = MIN (PH,
     *                  YYMIN(IIS,IIF,JANT,1))
                     YYMAX(IIS,IIF,JANT,1) = MAX (PH,
     *                  YYMAX(IIS,IIF,JANT,1))
                     IF (PH.LT.0.0) PH = PH + 360.0
                     PPMIN(IIS,IIF,JANT) = MIN (PH,
     *                  PPMIN(IIS,IIF,JANT))
                     PPMAX(IIS,IIF,JANT) = MAX (PH,
     *                  PPMAX(IIS,IIF,JANT))
C                                       delay
                  ELSE
                     PH = PLTPTS(IP,IA) - PLTPTS(IP,IR)
                     PLTPTS(IP,IA) = PH
                     YYMX(1) = MAX (YYMX(1), PH)
                     YYMN(1) = MIN (YYMN(1), PH)
                     YYMIN(IIS,IIF,JANT,1) = MIN (PH,
     *                  YYMIN(IIS,IIF,JANT,1))
                     YYMAX(IIS,IIF,JANT,1) = MAX (PH,
     *                  YYMAX(IIS,IIF,JANT,1))
                     END IF
 20               CONTINUE
 30            CONTINUE
 40         CONTINUE
         IF (NMISS.GT.0) THEN
            WRITE (MSGTXT,1090) NMISS, NREC, JANT
            CALL MSGWRT (7)
            END IF
 50      CONTINUE
C                                       zero out refant
      IR = FANREC(REFANT) - 1
      NREC = NUMPTS(REFANT)
      JANT = REFANT
      DO 80 IREC = 1,NREC
         IR = IR + 1
         IP = 3
         DO 70 IIF = 1,MUMIF
            DO 60 IIS = 1,MUMPOL
               IP = IP + 1
               IF (PLTPTS(IP,IR).NE.FBLANK) THEN
                  PLTPTS(IP,IR) = 0.0
                  YYMIN(IIS,IIF,JANT,1) = 0.0
                  YYMAX(IIS,IIF,JANT,1) = 0.0
                  PPMIN(IIS,IIF,JANT) = 0.0
                  PPMAX(IIS,IIF,JANT) = 0.0
                  END IF
 60            CONTINUE
 70         CONTINUE
 80      CONTINUE
C
      IERR = 0
 999  RETURN
C-----------------------------------------------------------------------
 1090 FORMAT ('Points misaligned',I6,' of',I7,' antenna',I4)
      END
      SUBROUTINE GETSCL (KK, LST1, LST2, LIF1, LIF2, LANT, DOIT)
C-----------------------------------------------------------------------
C   GETSCL converts a number of max/min's to a scale
C   Inputs:
C      KK      I   parameter number
C      LST1    I   1st Stokes
C      LST2    I   Upper Stokes
C      LIF1    I   1st IF number
C      LIF2    I   1st IF number
C      LANT    I   Antenna number
C   Output:
C      DOIT    L      There were valid values
C   Output in common
C      XYSCL   R(2)   Scaling - only 2nd one changed
C      XYOFF   R(2)   Offset  - only second one changed
C-----------------------------------------------------------------------
      INTEGER   KK, LST1, LST2, LIF1, LIF2, LANT
      LOGICAL   DOIT
C
      INCLUDE 'SNRMS.INC'
      INTEGER   IST, IIF
      REAL      YMX, YMN, PMX, PMN, TMAX, TMIN, TDIF, TOLER(30), SIZEY
C                                       Minimum value range for each
C                                       ICODE
C                  phs    amp    delay    rate    Tsys Summary doppler
      DATA TOLER /0.001, 0.001, 1.0E-12, 1.0E-8, 0.001,  0.01,  0.001,
C                  snr  MB delay   Tant    Atm dly  geo dly  ccal
     *            0.001, 1.0E-12, 0.000001, 1.0E-12, 1.0E-12, 1.0E-14,
C                  ddely   real   imag  Faraday Pdif   Psum   Pgn
     *            1.0E-12, 0.001, 0.001, 0.005, 0.001, 0.001, 1.E-5,
C                 Pon   Poff  Psys   PDgain PSgain
     *            0.01, 0.01, 0.01,  0.001, 0.001, 5*0.0/
C-----------------------------------------------------------------------
      DOIT = .FALSE.
      YMX = -1.E8
      YMN = -YMX
      PMX = YMX
      PMN = YMN
      DO 30 IIF = LIF1,LIF2
         DO 20 IST = LST1,LST2
            IF (YYMAX(IST,IIF,LANT,KK).GE.YYMIN(IST,IIF,LANT,KK)) THEN
               DOIT = .TRUE.
               YMX = MAX (YMX, YYMAX(IST,IIF,LANT,KK))
               YMN = MIN (YMN, YYMIN(IST,IIF,LANT,KK))
               IF (ICODES(KK).EQ.1) THEN
                  PMX = MAX (PMX, PPMAX(IST,IIF,LANT))
                  PMN = MIN (PMN, PPMIN(IST,IIF,LANT))
                  END IF
               END IF
 20         CONTINUE
 30      CONTINUE
      IF ((ICODES(KK).EQ.1) .AND. (PMX-PMN.LT.YMX-YMN)) THEN
         YMX = PMX
         YMN = PMN
         END IF
      SIZEY = 1000.0 / NCOUNT
      TMAX = YMX + 0.1 * (YMX - YMN)
      TMIN = YMN - 0.1 * (YMX - YMN)
      IF (ABS (TMAX-TMIN) .LT. TOLER(ICODES(KK))) THEN
         TMAX = TMAX + TOLER(ICODES(KK))
         TMIN = TMIN - TOLER(ICODES(KK))
         END IF
      TDIF = TMAX - TMIN
      IF (ABS (TDIF).LE.1.0E-25) TDIF = 1.0E-25
      XYOFF(2) = TMIN
      XYSCL(2) = 1000.0 / TDIF / NCOUNT
      PRAN(1,2) = TMIN
      PRAN(2,2) = TMAX
C
 999  RETURN
      END
      SUBROUTINE SNPDAT (VALUE, XVARIB, CSOU, OKAY)
C-----------------------------------------------------------------------
C   Routine to get the specified value from a SN/CL/TY table entry
C   Input from common:
C      GNREC    R(*)  Table record
C      ICODE    I     Plot code
C      SUMSTK   I     Selected Stokes 0=both, 1=R, 2=L, 3=Difference
C   Also uses pointers etc. set in SNPOPN
C   Output:
C      VALUE    R(*)   Table value, magic value blanked (amp on ICODE 6)
C      XVARIB   R      Value of associated x-axis variable
C      CSOU     R      source number
C      OKAY     L      Some values are good
C-----------------------------------------------------------------------
      INCLUDE 'INCS:PUVD.INC'
      REAL      VALUE(2*MAXIF,*), XVARIB, CSOU
      LOGICAL   OKAY
C
      INTEGER   IIS, IIF, IP1, IP2, LP, JP1, JP2, KP1, KK, ICODE,
     *   JIF
      REAL      AVAL, PVAL, AM, PH, V, S, TC
      LOGICAL   T, GOT
      INCLUDE 'SNRMS.INC'
      INCLUDE 'INCS:DMSG.INC'
      INCLUDE 'INCS:DDCH.INC'
      INCLUDE 'INCS:PSTD.INC'
      DATA T /.TRUE./
C-----------------------------------------------------------------------
C                                       In case the data is bad
      LP = MUMPOL * MUMIF
      CALL XCALC (XVARIB, CSOU)
      DO 900 KK = 1,NCODES
         ICODE = ICODES(KK)
         CALL RFILL (LP, FBLANK, VALUE(1,KK))
C                                       Select data type
C                                       Phase (deg)
         IF (ICODE.EQ.1) THEN
            DO 110 IIS = 1,MUMPOL
               LP = IIS - MUMPOL
               IP1 = REKOL(IIS) - NTONE
               JP1 = IMKOL(IIS) - NTONE
               IF (ITPLOT.GE.4) THEN
                  IP2 = REKOL(IIS+2) - NTONE
                  JP2 = IMKOL(IIS+2) - NTONE
               ELSE
                  IP2 = REKOL(2) - NTONE
                  JP2 = IMKOL(2) - NTONE
                  END IF
               DO 105 IIF = 1,MUMIF
                  IP1 = IP1 + NTONE
                  JP1 = JP1 + NTONE
                  IP2 =  IP2 + NTONE
                  JP2 = JP2 + NTONE
                  LP = LP + MUMPOL
                  IF ((GNREC(IP1).NE.FBLANK) .AND.
     *               (GNREC(JP1).NE.FBLANK)) THEN
                     VALUE(LP,KK) = 57.296 *
     *                  ATAN2 (GNREC(JP1), GNREC(IP1) + 1.0E-20)
                     END IF
 105              CONTINUE
 110           CONTINUE
C                                       Amplitude
         ELSE IF (ICODE.EQ.2) THEN
            DO 130 IIS = 1,MUMPOL
               LP = IIS - MUMPOL
               IP1 = REKOL(IIS) - NTONE
               JP1 = IMKOL(IIS) - NTONE
               IF (ITPLOT.GE.4) THEN
                  IP2 = REKOL(IIS+2) - NTONE
                  JP2 = IMKOL(IIS+2) - NTONE
               ELSE
                  IP2 = REKOL(2) - NTONE
                  JP2 = IMKOL(2) - NTONE
                  END IF
               DO 125 IIF = 1,MUMIF
                  IP1 = IP1 + NTONE
                  JP1 = JP1 + NTONE
                  IP2 =  IP2 + NTONE
                  JP2 = JP2 + NTONE
                  LP = LP + MUMPOL
                  IF ((GNREC(IP1).NE.FBLANK) .AND.
     *               (GNREC(JP1).NE.FBLANK)) THEN
                     VALUE(LP,KK) = GMMOD *
     *                  SQRT ((GNREC(IP1)**2) + (GNREC(JP1)**2))
                     END IF
 125              CONTINUE
 130           CONTINUE
C                                       Delay (sec)
         ELSE IF (ICODE.EQ.3) THEN
            DO 150 IIS = 1,MUMPOL
               LP = IIS - MUMPOL
               IP1 = DLKOL(IIS) - 1
               IF (ITPLOT.GE.4) THEN
                  IP2 = DLKOL(IIS+2) - 1
               ELSE
                  IP2 = DLKOL(2) - 1
                  END IF
               DO 145 IIF = 1,MUMIF
                  IP1 = IP1 + 1
                  IP2 =  IP2 + 1
                  LP = LP + MUMPOL
                  IF (GNREC(IP1).NE.FBLANK) THEN
                     VALUE(LP,KK) = GNREC(IP1)
                     END IF
 145              CONTINUE
 150           CONTINUE
C                                       Rate (Hz)
         ELSE IF (ICODE.EQ.4) THEN
            DO 170 IIS = 1,MUMPOL
               LP = IIS - MUMPOL
               IP1 = RAKOL(IIS) - NTONE
               IF (ITPLOT.GE.4) THEN
                  IP2 = RAKOL(IIS+2) - NTONE
                  JIF = IP2 - IP1 + 1
               ELSE
                  IP2 = RAKOL(2) - NTONE
                  END IF
               DO 165 IIF = 1,MUMIF
                  IP1 = IP1 + NTONE
                  IP2 = IP2 + NTONE
                  LP = LP + MUMPOL
                  IF (SUMSTK.EQ.3) JIF = IIF
                  IF (GNREC(IP1).NE.FBLANK) THEN
                     VALUE(LP,KK) = GNREC(IP1) * RATFAC(IIF)
                     END IF
 165              CONTINUE
 170           CONTINUE
C                                       System temperature (K)
         ELSE IF (ICODE.EQ.5) THEN
            DO 190 IIS = 1,MUMPOL
               LP = IIS - MUMPOL
               IP1 = TSKOL(IIS) - 1
               IP2 = IP1
               IF (ITPLOT.GE.4) THEN
                  IP2 = TSKOL(IIS+2) - 1
               ELSE
                  IP2 = TSKOL(2) - 1
                  END IF
               DO 185 IIF = 1,MUMIF
                  IP1 = IP1 + 1
                  IP2 =  IP2 + 1
                  LP = LP + MUMPOL
                  IF (ABS(GNREC(IP1)-999.0).LT.0.1) GNREC(IP1) = FBLANK
                  IF (ABS(GNREC(IP2)-999.0).LT.0.1) GNREC(IP2) = FBLANK
                  IF (GNREC(IP1).NE.FBLANK) THEN
                     VALUE(LP,KK) = GNREC(IP1)
                     END IF
 185              CONTINUE
 190           CONTINUE
C                                       Extreme amplitude or phase
C                                       Selected IF
         ELSE IF (ICODE.EQ.6) THEN
            AVAL = 0.0
            PVAL = 0.0
            GOT = .FALSE.
            DO 210 IIS = 1,MUMPOL
               LP = IIS - MUMPOL
               IP1 = REKOL(IIS) - 1
               JP1 = IMKOL(IIS) - 1
               IP2 = REKOL(2) - 1
               JP2 = IMKOL(2) - 1
               DO 205 IIF = BIF,EIF
                  IP1 = IP1 + 1
                  JP1 = JP1 + 1
                  IP2 = IP2 + 1
                  JP2 = JP2 + 1
                  LP = LP + MUMPOL
                  IF ((GNREC(IP1).EQ.FBLANK) .OR.
     *               (GNREC(JP1).EQ.FBLANK)) GO TO 205
                  AM = SQRT ((GNREC(IP1)**2) + (GNREC(JP1)**2))
                  IF (ABS(AM).GT.ABS(AVAL)) AVAL = AM
                  PH = 57.296 * ATAN2 (GNREC(JP1),GNREC(IP1)+1.0E-20)
                  IF (ABS(PH).GT.ABS(PVAL)) PVAL = PH
                  GOT = T
                  IF ((NUMPOL.GT.1) .AND. (SUMSTK.EQ.0)) THEN
                     IF ((GNREC(IP2).NE.FBLANK) .AND.
     *                  (GNREC(JP2).NE.FBLANK)) THEN
                        AM = SQRT ((GNREC(IP2)**2)+(GNREC(JP2)**2))
                        IF (ABS(AM).GT.ABS(AVAL)) AVAL = AM
                        PH = 57.296 *
     *                     ATAN2 (GNREC(JP2), GNREC(IP2)+1.0E-20)
                        IF (ABS(PH).GT.ABS(PVAL)) PVAL = PH
                        END IF
                     END IF
 205              CONTINUE
 210           CONTINUE
            IF (GOT) THEN
               VALUE(1,KK) = AVAL
               VALUE(1,2) = PVAL
               END IF
C                                       Doppler offset (Hz)
         ELSE IF (ICODE.EQ.7) THEN
            IF (GNREC(DOPLKL).NE.FBLANK) THEN
               VALUE(LP,KK) = GNREC(DOPLKL)
               END IF
C                                       SNR (no units)
         ELSE IF (ICODE.EQ.8) THEN
            DO 250 IIS = 1,MUMPOL
               LP = IIS - MUMPOL
               IP1 = WTKOL(IIS) - 1
               IP2 = WTKOL(2) - 1
               DO 245 IIF = 1,MUMIF
                  IP1 = IP1 + 1
                  IP2 =  IP2 + 1
                  LP = LP + MUMPOL
                  IF (GNREC(IP1).NE.FBLANK) THEN
                     VALUE(LP,KK) = GNREC(IP1)
                     END IF
 245              CONTINUE
 250           CONTINUE
C                                       Multiband Delay (sec)
         ELSE IF (ICODE.EQ.9) THEN
            DO 270 IIS = 1,MUMPOL
               LP = IIS
               IP1 = MBKOL(IIS)
               IP2 = MBKOL(2)
               IF (GNREC(IP1).NE.FBLANK) THEN
                  VALUE(LP,KK) = GNREC(IP1)
                  END IF
 270           CONTINUE
C                                       Tant (K)
         ELSE IF (ICODE.EQ.10) THEN
            DO 290 IIS = 1,MUMPOL
               LP = IIS - MUMPOL
               IP1 = TAKOL(IIS) - 1
               DO 285 IIF = 1,MUMIF
                  IP1 = IP1 + 1
                  LP = LP + MUMPOL
                  IF (ABS(GNREC(IP1)-999.0).LT.0.1) GNREC(IP1) = FBLANK
                  IF (ABS(GNREC(IP2)-999.0).LT.0.1) GNREC(IP2) = FBLANK
                  IF (GNREC(IP1).NE.FBLANK) THEN
                     VALUE(LP,KK) = GNREC(IP1)
                     END IF
 285              CONTINUE
 290           CONTINUE
C                                       Atmos. Delay (sec)
         ELSE IF (ICODE.EQ.11) THEN
            IF (GNREC(ATMKOL).NE.FBLANK) VALUE(LP,KK) = GNREC(ATMKOL)
C                                       Geometric Delay (sec)
         ELSE IF (ICODE.EQ.12) THEN
            IF (GNRECD(GEOKOL).NE.DBLANK) VALUE(LP,KK) = GNRECD(GEOKOL)
C                                       Cable cal (sec)
         ELSE IF (ICODE.EQ.13) THEN
            IF (GNRECD(CABKOL).NE.DBLANK) VALUE(LP,KK) = GNRECD(CABKOL)
C                                       Dispersive Delay (sec)
         ELSE IF (ICODE.EQ.14) THEN
            DO 370 IIS = 1,MUMPOL
               LP = IIS
               IP1 = DSKOL(IIS)
               IF (GNREC(IP1).NE.FBLANK) THEN
                  VALUE(LP,KK) = GNREC(IP1)
                  END IF
 370           CONTINUE
C                                       REAL
         ELSE IF (ICODE.EQ.15) THEN
            DO 395 IIS = 1,MUMPOL
               LP = IIS - MUMPOL
               IP1 = REKOL(IIS) - NTONE
               DO 390 IIF = 1,MUMIF
                  IP1 = IP1 + NTONE
                  LP = LP + MUMPOL
                  IF ( GNREC(IP1).NE.FBLANK ) THEN
                     VALUE(LP,KK) = GMMOD * GNREC(IP1)
                     END IF
 390              CONTINUE
 395           CONTINUE
C                                       IMAG
         ELSE IF (ICODE.EQ.16) THEN
            DO 420 IIS = 1,MUMPOL
               LP = IIS - MUMPOL
               JP1 = IMKOL(IIS) - NTONE
               DO 415 IIF = 1,MUMIF
                  JP1 = JP1 + NTONE
                  LP = LP + MUMPOL
                  IF (GNREC(JP1).NE.FBLANK) THEN
                     VALUE(LP,KK) = GMMOD * GNREC(JP1)
                     END IF
 415              CONTINUE
 420           CONTINUE
C                                       Atmos. Delay (sec)
         ELSE IF (ICODE.EQ.17) THEN
            IF (GNREC(IFRKOL).NE.FBLANK) VALUE(LP,KK) = GNREC(IFRKOL)
C                                       PDIF, PSUM, PGN
         ELSE IF ((ICODE.GE.18) .AND. (ICODE.LE.20)) THEN
            DO 430 IIS = 1,MUMPOL
               LP = IIS - MUMPOL
               IF (ICODE.EQ.18) THEN
                  IP1 = REKOL(IIS) - NTONE
               ELSE IF (ICODE.EQ.19) THEN
                  IP1 = IMKOL(IIS) - NTONE
               ELSE
                  IP1 = WTKOL(IIS) - NTONE
                  END IF
               DO 425 IIF = 1,MUMIF
                  IP1 = IP1 + NTONE
                  LP = LP + MUMPOL
                  IF (GNREC(IP1).NE.FBLANK) THEN
                     VALUE(LP,KK) = GNREC(IP1)
                     END IF
 425               CONTINUE
 430           CONTINUE
C                                       PON, POFF
         ELSE IF ((ICODE.GE.21) .AND. (ICODE.LE.22)) THEN
            S = 1.0
            IF (ICODE.EQ.22) S = -1.0
            DO 440 IIS = 1,MUMPOL
               LP = IIS - MUMPOL
               IP1 = REKOL(IIS) - NTONE
               JP1 = IMKOL(IIS) - NTONE
               KP1 = WTKOL(IIS) - NTONE
               DO 435 IIF = 1,MUMIF
                  IP1 = IP1 + NTONE
                  JP1 = JP1 + NTONE
                  KP1 = KP1 + NTONE
                  LP = LP + MUMPOL
                  IF ((GNREC(IP1).NE.FBLANK) .AND.
     *               (GNREC(JP1).NE.FBLANK).AND. (GNREC(KP1).NE.FBLANK)
     *               .AND.(GNREC(KP1).NE.0.0)) THEN
                     V = (GNREC(JP1) + S*GNREC(IP1)) / (2.0*GNREC(KP1))
                     VALUE(LP,KK) = V
                     END IF
 435              CONTINUE
 440           CONTINUE
C                                       PSYS = PSUM / PDIF = Tsys/Tcal
         ELSE IF (ICODE.EQ.23) THEN
            DO 450 IIS = 1,MUMPOL
               LP = IIS - MUMPOL
               IP1 = REKOL(IIS) - NTONE
               JP1 = IMKOL(IIS) - NTONE
               DO 445 IIF = 1,MUMIF
                  IP1 = IP1 + NTONE
                  JP1 = JP1 + NTONE
                  LP = LP + MUMPOL
                  IF ((CKKOL(1).GT.0) .AND. (GNRECI(CKKOL(1)).EQ.1))
     *               THEN
                     TC = TCAL(ISTOK+IIS+1,IIF-1+BIF,IANT)
                  ELSE
                     TC = TCAL(ISTOK+IIS-1,IIF-1+BIF,IANT)
                     END IF
                  IF (TC.LE.0.0) TC = FBLANK
                  IF ((GNREC(IP1).NE.FBLANK) .AND.
     *               (GNREC(JP1).NE.FBLANK).AND. (GNREC(IP1).GT.0.0)
     *               .AND. (TC.NE.FBLANK)) THEN
                     V = GNREC(JP1) / GNREC(IP1) / 2.0 * TC
                     VALUE(LP,KK) = V
                     END IF
 445              CONTINUE
 450           CONTINUE
C                                       PDIF, PSUM corr by PGN
         ELSE IF ((ICODE.GE.24) .AND. (ICODE.LE.25)) THEN
            DO 460 IIS = 1,MUMPOL
               LP = IIS - MUMPOL
               IF (ICODE.EQ.24) THEN
                  IP1 = REKOL(IIS) - NTONE
               ELSE
                  IP1 = IMKOL(IIS) - NTONE
                  END IF
               JP1 = WTKOL(IIS) - NTONE
               DO 455 IIF = 1,MUMIF
                  IP1 = IP1 + NTONE
                  JP1 = JP1 + NTONE
                  LP = LP + MUMPOL
                  IF ((GNREC(IP1).NE.FBLANK) .AND.
     *               (GNREC(JP1).NE.FBLANK)) THEN
                     V = 4096. * GNREC(JP1) * GNREC(JP1)
                     VALUE(LP,KK) = GNREC(IP1) / V
                     END IF
 455               CONTINUE
 460           CONTINUE
C                                       Gains as powers
         ELSE IF ((ICODE.EQ.26) .OR. (ICODE.EQ.27)) THEN
            DO 470 IIS = 1,MUMPOL
               LP = IIS - MUMPOL
               IP1 = REKOL(IIS) - NTONE
               JP1 = IMKOL(IIS) - NTONE
               DO 465 IIF = 1,MUMIF
                  IP1 = IP1 + NTONE
                  JP1 = JP1 + NTONE
                  LP = LP + MUMPOL
                  IF ((GNREC(IP1).NE.FBLANK) .AND.
     *               (GNREC(JP1).NE.FBLANK)) THEN
                     VALUE(LP,KK) = GMMOD *
     *                  ((GNREC(IP1)**2) + (GNREC(JP1)**2))
                     IF (VALUE(LP,KK).EQ.0.0) THEN
                        VALUE(LP,KK) = FBLANK
                     ELSE IF (ICODE.EQ.27) THEN
                        VALUE(LP,KK) = -10.0 * LOG10 (VALUE(LP,KK))
                     ELSE
                        VALUE(LP,KK) = 1.0 / VALUE(LP,KK)
                        END IF
                     END IF
 465              CONTINUE
 470           CONTINUE
            END IF
 900     CONTINUE
C
      OKAY = .TRUE.
      LP = MUMPOL * MUMIF
      DO 910 IIS = 1,LP
         IF (VALUE(IIS,KK).NE.FBLANK) GO TO 999
 910     CONTINUE
      OKAY = .FALSE.
C
 999  RETURN
      END
      SUBROUTINE SNPRNT (NV, NA, PLTPTS, STATS, IRET)
C-----------------------------------------------------------------------
C   SNPRNT the data thru calls to PRNTSN.
C   Input:
C      NV       I      Number values per antenna (source, T, X, Y data)
C      NA       I      Number antennas in data array
C      PLTPTS   R(*)   Data (NV,*)
C   Output:
C      IRET     I      Return code, 0=OK else failed
C-----------------------------------------------------------------------
      INTEGER   NV, NA, IRET
      REAL      PLTPTS(NV,*), STATS(*)
C
      INTEGER   IPLT, IIF, IIS
      INCLUDE 'SNRMS.INC'
      INCLUDE 'INCS:DMSG.INC'
      INCLUDE 'INCS:PSTD.INC'
C-----------------------------------------------------------------------
C                                       Now print
      DO 100 IPLT = 1,MUMANT
         DO 90 IIF = 1,MUMIF
            DO 80 IIS = 1,MUMPOL
               CALL PRNTSN (IIS, IIF, IPLT, NV, PLTPTS, STATS, IRET)
               IF (IRET.NE.0) GO TO 999
 80            CONTINUE
 90         CONTINUE
 100     CONTINUE
C
 999  RETURN
      END
      SUBROUTINE PRNTSN (LST, LIF, ANTNO, NV, PLTPTS, STATS, IRET)
C-----------------------------------------------------------------------
C   PLTSN actually prints the data.
C   Input:
C      LST      I      1st Stokes this plot
C      LIF      I      1st IF this plot
C      ANTNO    I      Antenna number
C      NV       I      Number values
C      PLTPTS   R(*)   Data to plot (NV,*)
C   Output:
C      STATS    R(*)   scratch buffer for medians
C      IRET     I      Return code, 0 => OK, otherwise abort.
C                       -1 => user request termination
C                        1 => failed to add to catalog
C                        2 => failed to create
C                        3 => graph file write error
C                        4 => UV file IO error
C-----------------------------------------------------------------------
      INTEGER   LST, LIF, ANTNO, NV, IRET
      REAL      PLTPTS(NV,*), STATS(*)
C
      INCLUDE 'SNRMS.INC'
C
      CHARACTER CHTMP*18, AUNITS(NCODE+2)*8, LINE*256, SCRTCH*256,
     *   CHTYPE(NCODE+2)*16
      INTEGER   BUFFER(256), INCHAR, INP, I, NGOOD, JCODE, NN, IP, NNN,
     *   J, JTRIM, NBLANK, PAGE, LANTNO
      REAL      VALUE, MEDIAN, MED, MAD, XMAX, XMIN
      LOGICAL   T, F, FIRST
      DOUBLE PRECISION SUM, SUMS
      INCLUDE 'INCS:PSTD.INC'
      INCLUDE 'INCS:DDCH.INC'
      INCLUDE 'INCS:DANS.INC'
      INCLUDE 'INCS:DCAT.INC'
      INCLUDE 'INCS:DLOC.INC'
      INCLUDE 'INCS:DMSG.INC'
      INCLUDE 'INCS:DUVH.INC'
      INCLUDE 'INCS:DHDR.INC'
      INCLUDE 'INCS:DFIL.INC'
      SAVE FIRST, LANTNO
      DATA LANTNO /0/
      DATA T, F /.TRUE.,.FALSE./
      DATA AUNITS /'Degrees','Gain','Seconds','Hz','Kelvin',' ','Hz',
     *             'SNR', 'Seconds', 'Kelvin', 'Seconds', 'Seconds',
     *             'Seconds','Sec/m**2','Gain','Gain','Rad/m**2',
     *             'Counts', 'Counts', 'Gain', 'Counts', 'Counts',
     *             'Kelvin', 'Counts', 'Counts', 'Gain^-2', 'db',
     *             'Degrees', 'PCamp'/
      DATA CHTYPE /'Gain phs', 'Gain amp', 'Delay','Rate','Tsys',
     *             ' ', 'Doppler offset', 'SNR', 'Multiband delay',
     *             'Tant', 'Atmosphere delay', 'Geometric Delay',
     *             'Cable Cal','Dispersive delay', 'Real', 'Imag',
     *             'Ion. Faraday rot', 'Power difference',
     *             'Power sum', 'Post gain', 'Power NT on',
     *             'Power NT off', 'Tsys', 'Pdif/Pgain**2',
     *             'Psum/Pgain**2', 'Rel. Power', 'Power db',
     *             'Phase-cal Phase', 'Phase-cal Ampl'/
      DATA FIRST /.TRUE./
C-----------------------------------------------------------------------
      IRET = 0
C
      JCODE = ICODES(1)
      IF (TYPE.EQ.'PC') THEN
         IF (JCODE.EQ.1) JCODE = NCODE+1
         IF (JCODE.EQ.2) JCODE = NCODE+2
         END IF
C                                       Start printing
      IF (FIRST) THEN
C                                       Open "line printer"
         IF (OUTPRT.EQ.' ') DOCRT = MAX (-1.0, DOCRT)
         LUNP = 3
         CALL LPOPEN (OUTPRT, DOCRT, LUNP, FINDP, NACROS, BUFFER, IRET)
         IF (IRET.NE.0) THEN
            WRITE (MSGTXT,1000) IRET, 'OPENING THE LINE PRINTER'
            GO TO 990
            END IF
         IF (DOTEX) NACROS = 256
C                                       TITLE ONE
         INCHAR = 16
         INP = 1
         TITL1 = CHTYPE(JCODE)
         IF (ICOR0.LT.-4) THEN
            IF (TITL1(1:3).EQ.'R-L') THEN
               TITL1(1:3) = 'V-H'
            ELSE IF (TITL1(:3).EQ.'R/L') THEN
               TITL1(1:3) = 'V/H'
               END IF
            END IF
         CALL CHTRIM (TITL1, INCHAR, TITL1, INP)
         INP = INP + 1
         IF (XVAR.EQ.1) THEN
            TITL1(INP:INP+16) = ' vs '// TIMLAB(1:3) // ' time for '
            INP = INP + 17
         ELSE IF (XVAR.EQ.2) THEN
            TITL1(INP:INP+17) = ' vs elevation for '
            INP = INP + 18
         ELSE IF (XVAR.EQ.3) THEN
            TITL1(INP:INP+10) = ' vs HA for '
            INP = INP + 11
         ELSE IF (XVAR.EQ.4) THEN
            TITL1(INP:INP+16) = ' vs LST time for '
            INP = INP + 17
         ELSE IF (XVAR.EQ.5) THEN
            TITL1(INP:INP+17) = ' vs parallactic angle for '
            INP = INP + 26
         ELSE IF (XVAR.EQ.6) THEN
            TITL1(INP:INP+17) = ' vs azimuth for '
            INP = INP + 16
            END IF
C                                       File name
         CALL H2CHR (18, KHIMNO, CATH(KHIMN), CHTMP)
         CALL H2CHR (6, KHIMCO, CATH(KHIMC), CHTMP(13:18))
         CALL NAMEST (CHTMP, CATBLK(KIIMS), TITL1(INP:), INCHAR)
         CALL REFRMT (TITL1, ' ', INCHAR)
C                                       TITLE TWO
         WRITE (TITL2,2000)
         IF (DOTEX) WRITE (TITL2,2001)
         IPCNT = 998
         PAGE = 0
         FIRST = .FALSE.
         END IF
C                                       new ant
      IF (ANTNO.LE.LANTNO) THEN
         LINE = ' '
         CALL PRTLIN (LUNP, FINDP, DOCRT, NACROS, TITL1, TITL2, LINE,
     *      IPCNT, PAGE, SCRTCH, IRET)
         IF (IRET.NE.0) GO TO 960
         LANTNO = ANTNO
         END IF
C                                       Loop
      IP = (LIF-1) * MUMPOL + LST + 3
      NGOOD = 0
      NBLANK = 0
      SUM = 0.0D0
      SUMS = 0.0D0
      MED = 0.0
      MAD = 0.0
      XMAX = -1.E10
      XMIN = 1.E10
C                                       Point plot
      DO 20 NN = 1,NUMPTS(ANTNO)
         NNN = NN - 1 + FANREC(ANTNO)
         VALUE = PLTPTS(IP,NNN)
         IF (VALUE.EQ.FBLANK) THEN
            NBLANK = NBLANK + 1
         ELSE
            NGOOD = NGOOD + 1
            STATS(NGOOD) = VALUE
            SUM = SUM + VALUE
            SUMS = SUMS + VALUE * VALUE
            XMAX = MAX (XMAX, VALUE)
            XMIN = MIN (XMIN, VALUE)
            END IF
 20      CONTINUE
C                                       average
      IF (NGOOD.GT.0) THEN
         SUM = SUM / NGOOD
         SUMS = SUMS / NGOOD - SUM * SUM
         IF (SUMS.GT.0.0) THEN
            SUMS = SQRT (SUMS)
         ELSE
            SUMS = -1.0D0
            END IF
         MED = MEDIAN (NGOOD, STATS)
         DO 30 I = 1,NGOOD
            STATS(I) = ABS (STATS(I) - MED)
 30         CONTINUE
         MAD = 1.4826 * MEDIAN (NGOOD, STATS)
         END IF
C                                       write it
      IF ((NGOOD.LE.0) .AND. (NBLANK.LE.0)) GO TO 999
      IF ((ABS(XMAX).GT.0.1) .AND. (ABS(XMAX).LT.1000000.) .AND.
     *   (XMIN.GT.-100000.)) THEN
         IF (DOTEX) THEN
            WRITE (LINE,2020) ANTNO, LIF+BIF-1, LST, NGOOD, XMAX, XMIN,
     *         SUM, SUMS, MED, MAD, NBLANK, STNNAM(ANTNO)
         ELSE
            WRITE (LINE,2030) ANTNO, LIF+BIF-1, LST, NGOOD, XMAX, XMIN,
     *         SUM, SUMS, MED, MAD, NBLANK, STNNAM(ANTNO)
            END IF
      ELSE
         IF (DOTEX) THEN
            WRITE (LINE,2021) ANTNO, LIF+BIF-1, LST, NGOOD, XMAX, XMIN,
     *         SUM, SUMS, MED, MAD, NBLANK, STNNAM(ANTNO)
         ELSE
            WRITE (LINE,2031) ANTNO, LIF+BIF-1, LST, NGOOD, XMAX, XMIN,
     *         SUM, SUMS, MED, MAD, NBLANK, STNNAM(ANTNO)
            END IF
         END IF
      J = JTRIM (LINE)
      CALL PRTLIN (LUNP, FINDP, DOCRT, NACROS, TITL1, TITL2,
     *   LINE(:J), IPCNT, PAGE, SCRTCH, IRET)
      IF (IRET.EQ.0) GO TO 999
C
 960  WRITE (MSGTXT,1000) IRET, 'PRINTING'
C
 990  CALL MSGWRT (8)
C
 999  RETURN
C-----------------------------------------------------------------------
 1000 FORMAT ('PRNTSN ERROR',I4,' ON ',A)
 2000 FORMAT ('Ant  IF S   Ngood        Max        Min        Avg',
     *   '        Rms     Median     Madrms  Nblank  Station')
 2001 FORMAT ('Ant &   IF &  S &    Ngood &         Max &         Min',
     *   ' &         Avg &         Rms &      Median &      Madrms & ',
     *   '  Nblank &   Station')
 2020 FORMAT (I3,' & ',I4,' & ',I2,' & ',I8,' & ',6(F11.3,' & '),I8,
     *   ' & ',2X,A)
 2021 FORMAT (I3,' & ',I4,' & ',I2,' & ',I8,' & ',6(1PE11.3,' & '),I8,
     *   ' & ',2X,A)
 2030 FORMAT (I3,I4,I2,I8,6F11.3,I8,2X,A)
 2031 FORMAT (I3,I4,I2,I8,6(1PE11.3),I8,2X,A)
      END
      SUBROUTINE XCALC (XVARIB, XSOU)
C-----------------------------------------------------------------------
C  Routine to use the source and antenna geometry information in order
C  to return the requested value of the x-variable against which the
C  data is to be plotted.
C  Inputs (in common):
C    XVAR        I       Type of variable to calculate:
C                        1 = time (easy)
C                        2 = source elevation
C                        3 = HA
C                        4 = LST
C                        5 = Parallactic angle
C                        6 = Azimuth
C  Output:
C    XVARIB      R       Value of requested variable
C                        Time, LST (days)
C                        Elevation, HA (degrees)
C    XSOU        I       source number
C----------------------------------------------------------------------
      REAL    XVARIB, XSOU
C
      REAL    HA, EL, PA, AZ, TT
      INTEGER IERR, ISLUN, CSOU, I
      DOUBLE PRECISION LST, TIME, LTIME, DRA, DDEC
      LOGICAL PLANET
      INCLUDE 'SNRMS.INC'
      INCLUDE 'INCS:PSTD.INC'
      INCLUDE 'INCS:DCAT.INC'
      INCLUDE 'INCS:DMSG.INC'
      INCLUDE 'INCS:DDCH.INC'
      SAVE LTIME, DRA, DDEC
      DATA ISLUN /25/
      DATA LTIME /-1.D0/
C-----------------------------------------------------------------------
      CSOU = GNRECI(SOUKOL)
      XSOU = CSOU
C                                      Time
      IF (KOLTYP(CLTIME).EQ.1) THEN
         TIME = GNRECD(TIMKOL)
      ELSE
         TIME = GNREC(TIMKOL)
         END IF
      IF (XVAR.EQ.1) THEN
         XVARIB = TIME
         GO TO 999
         END IF
C
C                                      Get source parameters
      IF ((OSOU.EQ.-1) .OR. (CSOU.NE.OSOU) .OR.
     *   (ABS(TIME-LTIME).GT.1.E-6)) THEN
         I = MSGSUP
         MSGSUP = 32000
         TT = TIME
         CALL FNDCOO (0, JD0, CSOU, DISKIN, CNOIN, CATBLK, ISLUN, TT,
     *      DRA, DDEC, PLANET, IERR)
         MSGSUP = I
         OSOU = CSOU
         LTIME = TIME
         END IF
C                                      Geometry parameters
      CALL ANTGEO (IANT, TIME, DRA, DDEC, HA, EL, LST, PA, AZ)
      IF (XVAR.EQ.2) THEN
         XVARIB = EL * RAD2DG
      ELSE IF (XVAR.EQ.3) THEN
         XVARIB = HA / TWOPI
      ELSE IF (XVAR.EQ.4) THEN
         XVARIB = LST / TWOPI
      ELSE IF (XVAR.EQ.5) THEN
         XVARIB = PA * RAD2DG
      ELSE IF (XVAR.EQ.6) THEN
         XVARIB = AZ * RAD2DG
         IF (XVARIB.LT.0.0) XVARIB = XVARIB + 360.0
         END IF
      IF (EL.LT.0.0) XVARIB = FBLANK
C
 999  RETURN
      END
      SUBROUTINE ANTGEO (ANTNO, TIME, DRA, DDEC, HA, EL, ANTLST, PA, AZ)
C-----------------------------------------------------------------------
C   Subroutine to compute the apparent source elevations based on source
C   and antenna coordinates in common.  The routines GETANT and GETSOU
C   should be called before this routine to put the correct values in
C   the relevant commons.
C   Inputs:
C      ANTNO      I    Antenna number
C      TIME       D    Current data time (days).
C      DRA        D    Apparent RA of source
C      DDEC       D    Apparent Declination of source.
C   Input from common:
C      STNLAT     D(*) Antenna latitude (rad).
C      STNLON     D(*) Antenna east longitudes (rad).
C      GSTIAT     D    GST at IAT=0 of reference day (rad).
C      ROTIAT     D    Rotation of the earth rate in IAT.
C   Output:
C      HA         R    Source hour angle (rad)
C      EL         R    Source elevation (rad)
C      ANTLST     D    Antenna LST (rad)
C      PA         R    Parallactic angle (rad)
C      AZ         R    Azimuth (rad)
C-----------------------------------------------------------------------
      INTEGER   ANTNO
      DOUBLE PRECISION TIME, ANTLST, DRA, DDEC
      REAL      HA, EL, PA, AZ
C
      LOGICAL   ISVLA
      DOUBLE PRECISION HRANG, ARLONG, ARLAT, DARG, DARG2, DAZ
      INCLUDE 'INCS:PUVD.INC'
      INCLUDE 'INCS:PSTD.INC'
      INCLUDE 'INCS:DSOU.INC'
      INCLUDE 'INCS:DANS.INC'
C-----------------------------------------------------------------------
C                                       Antenna LST
      ANTLST = GSTIAT + STNLON(ANTNO) + TIME * ROTIAT
C                                       Hour angle
      HRANG = ANTLST - DRA
      HRANG = DMOD (HRANG, TWOPI)
      IF (HRANG.GT.PI) HRANG = HRANG - TWOPI
      IF (HRANG.LT.-PI) HRANG = HRANG + TWOPI
      HA = HRANG
C                                       Elevation angle
      DARG = SIN (STNLAT(ANTNO)) * SIN (DDEC) + COS (STNLAT(ANTNO))
     *   * COS (DDEC) * COS (HRANG)
      EL = (PI/2.0D0 - ACOS (DARG))
C                                       AZ = ATAN2(SD*CL - CD*SL*CH,
C                                       CD*SH)
      DARG = SIN (DDEC) * COS (STNLAT(ANTNO)) -
     *       COS (DDEC) * SIN (STNLAT(ANTNO)) * COS(HRANG)
      DARG2 = COS (DDEC) * SIN (HRANG)
      DAZ = ATAN2 (DARG, DARG2)
      DAZ = MOD (DAZ - PI/2.0D0, TWOPI)
      IF (DAZ.LT.0.0D0) DAZ = DAZ + TWOPI
      AZ = DAZ
C                                       Is this the VLA?
      ISVLA = (ABS (CNTRX + 1.601162D6) .LE. 10.0D0) .AND.
     *   (ABS (CNTRY + 5.042003D6) .LE. 10.0D0) .AND.
     *   (ABS (CNTRZ - 3.554915D6) .LE. 10.0D0)
C                                       All VLA antennas have the same
C                                       parallactic angle.
      PA = 0.0
      IF (ISVLA) THEN
         ARLONG = ATAN2 (CNTRY, CNTRX)
         ARLAT = ASIN (CNTRZ / SQRT (CNTRX*CNTRX + CNTRY*CNTRY +
     *      CNTRZ*CNTRZ))
      ELSE
         ARLONG = STNLON(ANTNO)
         ARLAT = STNLAT(ANTNO)
         END IF
C                                       Dont compute Equatorial or space
      IF ((MNTYP(ANTNO).NE.1) .AND. (MNTYP(ANTNO).NE.2)) THEN
C                                       Antenna LST
         HRANG = GSTIAT + ARLONG + TIME * ROTIAT
C                                       Hour angle
         HRANG = HRANG - DRA
C                                       Parallactic angle
         PA = ATAN2 (COS (ARLAT) * SIN (HRANG),
     *     (SIN (ARLAT) * COS (DDEC) -
     *     COS (ARLAT) * SIN (DDEC) * COS(HRANG)))
C                                       EW-mount
         IF (MNTYP(ANTNO).EQ.3) THEN
            PA =  ATAN2 (COS(HRANG), SIN(HRANG)*SIN(DDEC))
C                                       Right  Nasmyth
         ELSE IF (MNTYP(ANTNO).EQ.4) THEN
            PA = PA + EL
C                                       Left Nasmyth
         ELSE IF (MNTYP(ANTNO).EQ.5) THEN
            PA = PA -EL
C                                       Right BWG
         ELSE IF (MNTYP(ANTNO).EQ.6) THEN
            PA = PA -AZ+EL
C                                       Left BWG
         ELSE IF (MNTYP(ANTNO).EQ.7) THEN
            PA = PA -EL+AZ
            END IF
         END IF
C
 999  RETURN
      END
