LOCAL INCLUDE 'SYVSN.INC'
      INTEGER   NCODE
      PARAMETER (NCODE=8)
C                                       Local include for SYVSN
      INCLUDE 'INCS:PUVD.INC'
C                                       Input parameters
      REAL      XSIN, XDISIN, XSYVER, XSNVER, XQUAL, XTIME(8), XBAND,
     *   XFREQ, XFQID, XSUBA, XANT(50), PIXR(2), XNCOU, XREF, APARM(10),
     *   BPARM(10), CPARM(10), XXINC, CROWD, ABSICA, XDO3C, XSYM,
     *   FACTOR, XDOBL, XCUTOF, XSCAN, XLABEL, XDOTV, XGRCH, XYRATO
      HOLLERITH XNAMEI(3), XCLAIN(2), XXSOUR(4,30), XXSTOK(1),
     *   XOPTY(1), XOPCOD(1), XSAMP(1)
      CHARACTER NAMEIN*12, CLAIN*6, TYPE*2, XSOUR(30)*16, XSTOK*4,
     *   OPTYPE*4, OPCODE*4, SAMTYP*4, SYTYPE*2
C                                       Program info
C
      INTEGER   MXSCAN
      PARAMETER (MXSCAN=5000)
C
      REAL      TSTART, TSTOP, TINT, XYSCL(2,2), XYOFF(2,2), YYMX(2,2),
     *   YYMN(2,2), XMX, XMN, XMXW, XMNW, GMMOD, SELBAN, TBEG, TEND,
     *   XSTART, XSTOP, CHOUT(4), XXMIN(MAXANT), XXMAX(MAXANT),
     *   YYMIN(2,MAXANT,2), TSCAN(MXSCAN), PPMAX(2,MAXANT),
     *   YYMAX(2,MAXANT,2), PPMIN(2,MAXANT), PRAN(2,2,2),
     *   DO3COL, TCAL(4,MAXIF,MAXANT), CSMIN, CSMAX, CUTOFF, STTSY(3),
     *   STTSN(3), RVALUE(2,MAXANT), RVALS(2,MAXANT,2000),
     *   RTS(2,MAXANT,2000)
      INTEGER   SEQIN, DISKIN, CNOIN, IVER(2), BIFS(3,2), ANTS(50),
     *   ICODES(2), NCODES, NPARMS, NID, SID(500), NANTSL, NPLOTS,
     *   SUMSTK, ISTOK, FRQSEL, XINC, GRCHN, TVCHN, TVCORN(4), XVAR,
     *   ISOU, OSOU, IANT, EIFS(3,2), ITVER(2), PCNUM, LABEL, SUBARR,
     *   MUMPOL, MUMIF, MUMANT, NTONE, NUMPTS(MAXANT,2), ISYM(2),
     *   BSYM, NANREC(MAXANT,2), FANREC(MAXANT,2), NOSCAN, BIF, EIF,
     *   STRANS(MXSCAN), SCNT(MXSCAN), REFANT, NCOUNT, COLORS(2,2),
     *   NSTRAN
      LOGICAL   DOAWNT, DOTV, NNODAT, DOLINE, SWAP, REREF
      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, XSYVER, XSNVER,
     *   XXSOUR, XQUAL, XTIME, XXSTOK, XBAND, XFREQ, XFQID, XSUBA, XANT,
     *   PIXR, XNCOU, XOPTY, XREF, XOPCOD, APARM, BPARM, XSAMP, CPARM,
     *   XXINC, CROWD, ABSICA, XDO3C, XSYM, FACTOR, XDOBL, XCUTOF,
     *   XSCAN, XLABEL, XDOTV, XGRCH, XYRATO
      COMMON /VPARM/ SEQIN, DISKIN, CNOIN, IVER, BIF, EIF, ANTS, NCOUNT,
     *   ICODES, NCODES, NPARMS, GRCHN, TVCHN, TVCORN, XVAR, ISOU, OSOU,
     *   IANT, ITVER, PCNUM, DOTV, NNODAT, LABEL, CHOUT, DO3COL,
     *   DOLINE, NOSCAN, TSCAN, STRANS, SCNT, SWAP, REREF, REFANT,
     *   CUTOFF, TBEG, TEND, BIFS, EIFS, COLORS, STTSY, STTSN, RVALUE,
     *   NSTRAN, RVALS, RTS
      COMMON /VGNCOM/ SELFRQ, JD0,
     *   TSTART, TSTOP, TINT, XYSCL, XYOFF, SELBAN, XMX, XMN, XMXW,
     *   XMNW, XSTART, XSTOP, GMMOD, NID, SID, NANTSL, PRAN,
     *   NPLOTS, DOAWNT, ISTOK, SUMSTK, FRQSEL, XINC,
     *   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,
     *   OPCODE, SAMTYP, SYTYPE
      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 SYVSN
LOCAL END
      PROGRAM SYVSN
C-----------------------------------------------------------------------
C! Plots data from anSY and an SN table
C# UV Plot EXT-appl Calibration
C-----------------------------------------------------------------------
C;  Copyright (C) 2019-2020, 2022
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   SYVSN plots SY and SN (phase)
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      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      PIXRANGE...Limit the plot to values between PIXR(1) and
C                 PIXR(2).  The plots will not exceed the min/max in
C                 the actual gains.  Basically, if PIXR(1) < PIXR(2),
C                 all plots will be on the same scale and be limited
C                 to max (datamin, PIXR(1)) through min (datamax,
C                 PIXR(2)).  If PIXR(1) >= PIXR(2), each plot will be
C                 self-scaled individually.
C      NCOUNT.....Number of antennas to plot per page (try 5).
C      OPTYPE.....Data to be plotted: 'PSYS' = Tsys from SY
C                 'PSUM' Psum frpm SY, 'PDIF'
C      OPCODE.....'PHAS' or 'DELA' or 'AMP' from SN
C      DOTV     R      > 0 => TV, else plot file
C      GRCHAN   R      graphics channel to use
C-----------------------------------------------------------------------
C
      CHARACTER PRGN*6
      REAL      DATPTS(2), SYDAT(2), SNDAT(2)
      LONGINT   PDATPT, PSYDAT, PSNDAT
      INTEGER   IRET, MVAL, NWORDS, NROWS, NVAL
      INCLUDE 'SYVSN.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 /'SYVSN '/
C-----------------------------------------------------------------------
C                                       Get input parameters
      CALL SYVSNI (PRGN, NROWS, IRET)
      IF (IRET.NE.0) GO TO 990
      MUMANT = MAX (1, MUMANT)
C                                       dynamic memory hold SY data
      NVAL = 2 + MUMPOL
      NWORDS = (NVAL * NROWS - 1) / 1024 + 21
      CALL ZMEMRY ('GET ', 'SYVALS', NWORDS, SYDAT, PSYDAT, IRET)
      IF (IRET.NE.0) THEN
         MSGTXT = 'UNABLE TO GET DYNAMIC MEMORY'
         CALL MSGWRT (8)
         GO TO 990
         END IF
      MVAL = 2 + MUMIF*MUMPOL
      NWORDS = (MVAL * NROWS - 1) / 1024  + 21
      CALL ZMEMRY ('GET ', 'SYDATA', NWORDS, DATPTS, PDATPT, IRET)
      IF (IRET.NE.0) THEN
         MSGTXT = 'UNABLE TO GET DYNAMIC MEMORY'
         CALL MSGWRT (8)
         GO TO 990
         END IF
C                                       read data to figure out
C                                       distribution
      NWORDS = NWORDS * 1024
      IF (IRET.EQ.0) CALL SYPCNT (NWORDS, IRET)
C                                       Fetch data
      IF (IRET.EQ.0) CALL SYPGET (MVAL, DATPTS(1+PDATPT), IRET)
      IF (IRET.NE.0) GO TO 990
C                                       subtract ref antenna
      IF (REREF) CALL SYPREF (MVAL, DATPTS(1+PDATPT), IRET)
      IF (IRET.NE.0) GO TO 990
C                                       Compute values, get scaling
      CALL SYPMAX (1, MVAL, APARM(7), DATPTS(1+PDATPT), NVAL,
     *   SYDAT(1+PSYDAT))
C                                       free big array
      CALL ZMEMRY ('FREE', 'SYDATA', NWORDS, DATPTS, PDATPT, IRET)
C                                       init SN table
      CALL INITSN (NROWS, IRET)
      IF (IRET.NE.0) GO TO 990
C                                       dynamic memory hold SN data
      NWORDS = (NVAL * NROWS - 1) / 1024 + 21
      CALL ZMEMRY ('GET ', 'SNVALS', NWORDS, SNDAT, PSNDAT, IRET)
      IF (IRET.NE.0) THEN
         MSGTXT = 'UNABLE TO GET DYNAMIC MEMORY'
         CALL MSGWRT (8)
         GO TO 990
         END IF
      NWORDS = (MVAL * NROWS - 1) / 1024  + 21
      CALL ZMEMRY ('GET ', 'SNDATA', NWORDS, DATPTS, PDATPT, IRET)
      IF (IRET.NE.0) THEN
         MSGTXT = 'UNABLE TO GET DYNAMIC MEMORY'
         CALL MSGWRT (8)
         GO TO 990
         END IF
      NWORDS = NWORDS * 1024
      IF (IRET.EQ.0) CALL SNPCNT (NWORDS, IRET)
C                                       Fetch data
      IF (IRET.EQ.0) CALL SNPGET (MVAL, DATPTS(1+PDATPT), IRET)
      IF (IRET.NE.0) GO TO 990
C                                       subtract ref antenna
      IF (REREF) CALL SNPREF (MVAL, DATPTS(1+PDATPT), IRET)
      IF (IRET.NE.0) GO TO 990
C                                       Compute values, get scaling
C                                       delay
      IF (ICODES(2).GT.4) THEN
         CALL SYPMAX (2, MVAL, BPARM(7), DATPTS(1+PDATPT), NVAL,
     *      SNDAT(1+PSNDAT))
C                                       phase
      ELSE
         CALL SNPMAX (MVAL, DATPTS(1+PDATPT), NVAL, SNDAT(1+PSNDAT))
         END IF
C                                       free big array
      CALL ZMEMRY ('FREE', 'SNDATA', NWORDS, DATPTS, PDATPT, IRET)
C                                       Do plots
      IF (SAMTYP.NE.' ') CALL SNPCOR (NVAL, MUMANT, SYDAT(1+PSYDAT),
     *   SNDAT(1+PSNDAT))
C                                       Do plots
      CALL SNPLOT (NVAL, MUMANT, SYDAT(1+PSYDAT), SNDAT(1+PSNDAT), IRET)
      IF (IRET.LT.0) IRET = 0
C                                       Close down
 990  CALL DIE (IRET, CLBUFF)
C
 999  STOP
      END
      SUBROUTINE SYVSNI (PRGN, NROWS, IERR)
C-----------------------------------------------------------------------
C   Gets the inputs parameters for SYVSN.
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    'PSUM', 'PSYS' 'PDIF', 'PHAS', 'DELA', 'AMP'
C-----------------------------------------------------------------------
      INTEGER   NROWS, IERR
      CHARACTER PRGN*6
C
      INCLUDE 'SYVSN.INC'
      CHARACTER STAT*4, TYPTMP*2
      INTEGER   IRET, BUFF(256), I, J, K, JERR, QUAL(30), NSOUR, LTYPE,
     *   BUFFER(512), IROUND, LUN, NSTOK, ICODE, JJ
      LOGICAL   T, F, MATCH
      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 T, F /.TRUE.,.FALSE./
C-----------------------------------------------------------------------
      OSOU = -1
      NPARMS = 243
C                                        Get input parameters.
      CALL SETUP (PRGN, NPARMS, XNAMEI, BUFF, IERR)
      IF (IERR.NE.0) THEN
         WRITE (MSGTXT,1000) IERR
         CALL MSGWRT (8)
         IRET = 8
         RQUICK = .FALSE.
         GO TO 990
         END IF
C                                       Decode inputs.
C                                       characters
      CALL H2CHR (12, 1, XNAMEI, NAMEIN)
      CALL H2CHR (6, 1, XCLAIN, CLAIN)
      CALL H2CHR (4, 1, XXSTOK, XSTOK)
      CALL H2CHR (4, 1, XOPTY, OPTYPE)
      CALL H2CHR (4, 1, XOPCOD, OPCODE)
      CALL H2CHR (4, 1, XSAMP, SAMTYP)
      ISYM(1) = IROUND (XSYM)
      IF ((ISYM(1).LE.0) .OR. (ISYM(1).GT.24)) ISYM(1) = 1
      ISYM(2) = MOD (ISYM(1), 24) + 1
      BSYM = IROUND (XDOBL)
      IF ((BSYM.GT.0) .AND. ((BSYM.EQ.ISYM(1)) .OR. (BSYM.EQ.ISYM(2))))
     *   BSYM = MOD (ISYM(2), 24) + 1
C
      DO3COL = XDO3C
      IF (XDO3C.GT.1.5) DO3COL = -1.
      DO 20 I = 1,30
         CALL H2CHR (16, 1, XXSOUR(1,I), XSOUR(I))
         QUAL(I) = IROUND (XQUAL)
 20      CONTINUE
C                                       Integers
      SEQIN = IROUND (XSIN)
      DISKIN = IROUND (XDISIN)
      IVER(1) = IROUND (XSYVER)
      IVER(2) = IROUND (XSNVER)
      NCOUNT = IROUND (XNCOU)
      IF (NCOUNT.LE.0) NCOUNT = 4
      XNCOU = NCOUNT
      XINC = IROUND (XXINC)
      IF ((XINC.LT.25) .AND. (XINC.GT.1)) XINC = 180
      IF (ABSICA.GE.0.0) XINC = 0
      XXINC = XINC
      XVAR = IROUND (ABSICA)
      IF ((XVAR.LT.1) .OR. (XVAR.GT.6)) XVAR = 1
      DOLINE = FACTOR.LT.0.0
      FACTOR = ABS (FACTOR)
      IF ((.NOT.DOLINE) .AND. (FACTOR.LT.0.1)) FACTOR = 1.0
      IF (FACTOR.GT.10.0) FACTOR = 1.0
      REFANT = XREF + 0.1
      REREF = REFANT.GT.0
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.GT.0) THEN
         IF (TSTOP.LE.TSTART) TSTOP = 999
      ELSE IF (TSTART.GE.TSTOP) THEN
         TSTART = 0.0
         TSTOP = 999.0
         END IF
      DOTV = XDOTV.GT.0.0
      GRCHN = XGRCH + 0.01
      TVCHN = 1
      CALL FILL (4, 0, TVCORN)
      LABEL = IROUND (XLABEL)
      LTYPE = MOD (ABS(LABEL), 100)
      IF ((LTYPE.EQ.0) .OR. (LTYPE.GT.10)) LTYPE = 3
      IF (LTYPE.GT.7) LTYPE = 7
      IF ((LTYPE.GE.4) .AND. (LTYPE.LE.6)) LTYPE = 3
      IF (LABEL.LT.0) THEN
         LABEL = (LABEL/100)*100 - LTYPE
      ELSE
         LABEL = (LABEL/100)*100 + LTYPE
         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 = 'WRIT'
      IF (DOTV) 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) = 1
      IF (DOTV) FRW(NCFILE) = 0
      XDISIN = DISKIN
      CALL UVPGET (IERR)
      IF (IERR.NE.0) GO TO 990
      SEQIN = CATBLK(KIIMS)
      XSIN = SEQIN
C                                       SY or TY
      CALL FNDEXT ('SY', CATBLK, JJ)
      IF (JJ.GT.0) THEN
         SYTYPE = 'SY'
      ELSE
         CALL FNDEXT ('TY', CATBLK, JJ)
         IF (JJ.GT.0) THEN
            SYTYPE = 'TY'
         ELSE
            MSGTXT = 'NEITHER SY OR TY TABLE FOUND'
            IERR = 10
            GO TO 990
            END IF
         END IF
C                                       plot types
      IF (SYTYPE.EQ.'SY') THEN
         ICODE = 1
         IF (OPTYPE.EQ.'PSUM') ICODE = 2
         IF (OPTYPE.EQ.'PDIF') ICODE = 3
         IF (ICODE.EQ.1) OPTYPE = 'PSYS'
         CALL CHR2H (4, OPTYPE, 1, XOPTY)
         NCODES = 1
         ICODES(1) = ICODE
      ELSE
         ICODE = 7
         IF (OPTYPE.EQ.'TANT') ICODE = 8
         IF (ICODE.EQ.7) OPTYPE = 'TSYS'
         ICODES(1) = ICODE
         END IF
      ICODE = 4
      IF (OPCODE.EQ.'DELA') ICODE = 5
      IF (OPCODE.EQ.'AMP')  ICODE = 6
      IF (ICODE.EQ.4) OPCODE = 'PHAS'
      CALL CHR2H (4, OPCODE, 1, XOPCOD)
      ICODES(2) = ICODE
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
      CALL FILL (6, 0, BIFS)
      CALL FILL (6, -1, EIFS)
      IF (APARM(7).EQ.0.0) APARM(7) = 1.0
      IF (BPARM(7).EQ.0.0) BPARM(7) = 1.0
      IF (JLOCIF.GE.0) THEN
         I = IROUND(APARM(1))
         J = IROUND(APARM(2))
         IF ((I.LE.0) .OR. (J.LT.I)) THEN
            MSGTXT = 'APARM(1,2) HAVE NO DEFAULT'
            IERR = 1
            GO TO 990
            END IF
         BIFS(1,1) = MIN (I, CATBLK(KINAX+JLOCIF))
         EIFS(1,1) = MIN (J, CATBLK(KINAX+JLOCIF))
         BIF = BIFS(1,1)
         EIF = EIFS(1,1)
         I = IROUND(APARM(3))
         J = IROUND(APARM(4))
         IF ((I.LE.0) .OR. (J.LT.I)) GO TO 21
         BIFS(2,1) = MIN (I, CATBLK(KINAX+JLOCIF))
         EIFS(2,1) = MIN (J, CATBLK(KINAX+JLOCIF))
         BIF = MIN (BIF, BIFS(2,1))
         EIF = MAX (EIF, EIFS(2,1))
         I = IROUND(APARM(5))
         J = IROUND(APARM(6))
         IF ((I.LE.0) .OR. (J.LT.I)) GO TO 21
         BIFS(3,1) = MIN (I, CATBLK(KINAX+JLOCIF))
         EIFS(3,1) = MIN (J, CATBLK(KINAX+JLOCIF))
         BIF = MIN (BIF, BIFS(3,1))
         EIF = MAX (EIF, EIFS(3,1))
 21      I = IROUND(BPARM(1))
         J = IROUND(BPARM(2))
         IF ((I.LE.0) .OR. (J.LT.I)) THEN
            MSGTXT = 'BPARM(1,2) HAVE NO DEFAULT'
            IERR = 1
            GO TO 990
            END IF
         BIFS(1,2) = MIN (I, CATBLK(KINAX+JLOCIF))
         EIFS(1,2) = MIN (J, CATBLK(KINAX+JLOCIF))
         BIF = MIN (BIF, BIFS(1,2))
         EIF = MAX (EIF, EIFS(1,2))
         I = IROUND(BPARM(3))
         J = IROUND(BPARM(4))
         IF ((I.LE.0) .OR. (J.LT.I)) GO TO 25
         BIFS(2,2) = MIN (I, CATBLK(KINAX+JLOCIF))
         EIFS(2,2) = MIN (J, CATBLK(KINAX+JLOCIF))
         BIF = MIN (BIF, BIFS(2,2))
         EIF = MAX (EIF, EIFS(2,2))
         I = IROUND(BPARM(5))
         J = IROUND(BPARM(6))
         IF ((I.LE.0) .OR. (J.LT.I)) GO TO 25
         BIFS(3,2) = MIN (I, CATBLK(KINAX+JLOCIF))
         EIFS(3,2) = MIN (J, CATBLK(KINAX+JLOCIF))
         BIF = MIN (BIF, BIFS(3,2))
         EIF = MAX (EIF, EIFS(3,2))
      ELSE
         BIFS(1,1) = 1
         EIFS(1,1) = 1
         BIF = 1
         EIF = 1
         BIFS(1,2) = 1
         EIFS(1,2) = 1
         END IF
C                                       Look up sources
 25   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
      I = 0
      DO 70 J = 1,50
         JJ = IROUND (XANT(J))
         IF (JJ.LT.0) DOAWNT = F
C                                       Make positive
         JJ = ABS (JJ)
C                                       Check for multiple entries
         DO 50 K = 1,I
            IF (JJ.EQ.ANTS(K)) GO TO 70
 50         CONTINUE
         IF (JJ.GT.0) THEN
            I = I + 1
            ANTS(I) = JJ
            NANTSL = I
            END IF
 70      CONTINUE
C                                       Make sure not too many
      IF (NANTSL.GT.MAXANT) NANTSL = MAXANT
C                                       add rEFANT if needed
      IF ((DOAWNT) .AND. (NANTSL.GT.0) .AND. (REFANT.GT.0)) THEN
         DO 71 K = 1,NANTSL
            IF (ANTS(I).EQ.REFANT) GO TO 75
 71         CONTINUE
         IF (NANTSL.LT.MAXANT) NANTSL = NANTSL + 1
         ANTS(NANTSL) = REFANT
         END IF
C                                       Get antenna names
 75   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                                       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'
            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'
            MUMPOL = 2
            END IF
         END IF
      CALL CHR2H (4, XSTOK, 1, XXSTOK)
C                                       Open table to check
      TYPE = SYTYPE
      CUTOFF = XCUTOF
      CALL FILL (2*MAXANT, 0, NUMPTS)
C                                       Open SN, CL, TY or PC table
      CALL SNPOPN (NROWS, IERR)
      IF (IERR.NE.0) GO TO 999
C                                       Get TCals
      IF (OPTYPE.EQ.'PSYS') THEN
         J = 0
         CALL GETCDS (DISKIN, CNOIN, J, SUBARR, FRQSEL, CATBLK, TCAL,
     *      JERR)
         IF (JERR.NE.0) GO TO 999
         END IF
      XSYVER = IVER(1)
      MUMIF = EIF - BIF + 1
      CSMAX = -100000
      CSMIN = 1000000
      CALL RFILL (MAXANT, 1.E5, XXMIN)
      CALL RFILL (MAXANT, -1.E5, XXMAX)
      I = 2 * MAXANT
      CALL RFILL (I, 1.E8, PPMIN)
      CALL RFILL (I, -1.E8, PPMAX)
      I = I * 2
      CALL RFILL (I, 1.E8, YYMIN)
      CALL RFILL (I, -1.E8, YYMAX)
      CALL RFILL (2, -1.E8, YYMX)
      CALL RFILL (2,  1.E8, YYMN)
      IF (XVAR.EQ.1) THEN
         IF (TSTART.GT.0.0) CALL RFILL (MAXANT, TSTART, XXMIN)
         IF ((TSTOP.LT.999.) .AND. (TSTOP.GT.TSTART) .AND.
     *      (TSTOP.GT.0.0)) CALL RFILL (MAXANT, TSTOP, XXMAX)
         END IF
      IF ((XSCAN.GT.0.0) .AND. (XVAR.EQ.1)) THEN
         LUN = 25
         CALL GETNX (LUN, DISKIN, CNOIN, CATBLK, SUBARR, BUFFER, NOSCAN,
     *      TSCAN)
      ELSE
         NOSCAN = 0
         END IF
C                                       smoothing parms
      IF ((SAMTYP.NE.' ') .AND. (XVAR.GT.1)) THEN
         IF ((SAMTYP.EQ.'MWF') .OR. (SAMTYP.EQ.'2PT')) THEN
            MSGTXT = 'SAMTYP = MWF OR 2PT WORKS ONLY ON XAXIS 1 (TIME)'
            CALL MSGWRT (6)
            SAMTYP = ' '
            END IF
         END IF
      IF (SAMTYP.NE.' ') THEN
         STTSY(1) = CPARM(1)
         STTSY(2) = CPARM(6)
         STTSY(3) = 0.01
         IF (STTSY(1).LE.0.0) STTSY(1) = 30.0
         IF (STTSY(2).LE.0.0) STTSY(2) = STTSY(1) / 2.0
         STTSN(1) = CPARM(2)
         STTSN(2) = CPARM(7)
         STTSN(3) = 0.01
         IF (STTSN(1).LE.0.0) STTSN(1) = 30.0
         IF (STTSN(2).LE.0.0) STTSN(2) = STTSN(1) / 2.0
         I = 2 * MAXANT
         CALL RFILL (I, 0.0, RVALUE)
         END IF
      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 INITSN (NROWS, IERR)
C-----------------------------------------------------------------------
C   Inits the I/O to the SN table
C   Outputs:
C      NROWS   I   Number rows in SN table
C      IERR    I   Error code
C-----------------------------------------------------------------------
      INTEGER   NROWS, IERR
C
      INCLUDE 'SYVSN.INC'
C-----------------------------------------------------------------------
      TYPE = 'SN'
      CALL SNPOPN (NROWS, IERR)
      XSNVER = IVER(2)
C
 999  RETURN
      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                     3=difference, 4=ratio
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 'SYVSN.INC'
C
      CHARACTER KEYW(4)*8, COLHD1(11)*24, COLHD2(13)*24, COLHD3(13)*24,
     *   COLTAB(40)*24, COLHED(37)*24, KEYSN(4)*8
      INTEGER   NKEY, NREC, NCOL, DATP(128,2), IPOINT, KEYTYP(4), KK,
     *   KLOCS(4), KEYVAL(6), I, KP, MSGSAV
      LOGICAL   T, 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)
      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 KEYSN /'NO_ANT  ', 'NO_POL  ', 'NO_IF   ','MGMOD   '/
      DATA T /.TRUE./
C-----------------------------------------------------------------------
C                                       Open table
      ICLUN = 28
      NKEY = 0
      NREC = 0
      NCOL = 0
      ICLRNO = 1
      KK = 2
      IF (TYPE.EQ.'SY') KK = 1
      IF (TYPE.EQ.'TY') KK = 1
      CALL TABINI ('READ', TYPE, DISKIN, CNOIN, IVER(KK), CATBLK, ICLUN,
     *   NKEY, NREC, NCOL, DATP, CLBUFF, IERR)
      IF (IERR.GT.0) THEN
         WRITE (MSGTXT,1100) IERR, TYPE, IVER(KK)
         GO TO 980
         END IF
      ITVER(KK) = IVER(KK)
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
      DO 10 I = 1,NKEY
         COLTAB(I) = COLHED(I)
 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
      DO 30 I = 1,NKEY
         KEYW(I) = KEYSN(I)
 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: other
      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
C                                       Set pointers
      DOPKOL = DOPKOL + BIF - 1
      DOP3KL = DOPKOL + EIF - 1
      DOPLKL = DOPKOL
      PCNUM = 1
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
      DOM = .FALSE.
      IF ((TYPE.EQ.'SN') .AND. (OPCODE.EQ.'PHAS')) THEN
         IF ((REKOL(1).LT.0) .OR. (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
      IF ((TYPE.EQ.'SN') .AND. (OPCODE.EQ.'AMP')) THEN
         IF ((REKOL(1).LT.0) .OR. (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 ((TYPE.EQ.'SN') .AND. (OPCODE.EQ.'DELA')) THEN
         IF (DLKOL(1).LT.0) GO TO 500
         IF ((MUMPOL.EQ.2) .AND. (DLKOL(2).LT.0)) GO TO 500
         END IF
C                                       SY Pdif
      IF ((TYPE.EQ.'SY') .AND. (OPTYPE.EQ.'PDIF')) THEN
         IF (REKOL(1).LT.0) GO TO 500
         IF ((MUMPOL.EQ.2) .AND. (IMKOL(2).LT.0)) GO TO 500
         END IF
C                                       SY Psum
      IF ((TYPE.EQ.'SY') .AND. (OPTYPE.EQ.'PSUM')) 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 TSYS
      IF ((TYPE.EQ.'SY') .AND. (OPTYPE.EQ.'PSYS')) 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
C                                       System temperature
      IF ((TYPE.EQ.'TY') .AND. (OPTYPE.EQ.'TSYS')) THEN
         IF (TSKOL(1).LT.0) GO TO 500
         IF ((MUMPOL.EQ.2) .AND. (TSKOL(2).LT.0)) GO TO 500
         END IF
C                                       Antenna temperature
      IF ((TYPE.EQ.'TY') .AND. (OPTYPE.EQ.'TANT')) THEN
         IF (TAKOL(1).LT.0) GO TO 500
         IF ((MUMPOL.EQ.2) .AND. (TAKOL(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
      SUBROUTINE SYPCNT (NWORDS, IERR)
C-----------------------------------------------------------------------
C   SNPCNT reads the SY table to find the number of samples for each ant
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 'SYVSN.INC'
      LOGICAL   NODATA, OKAY
      INTEGER   I, NP
      REAL      GTIME, XVARIB, CSOU, VALUE(2*MAXIF), TEMP
      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(1,1))
      CALL FILL (MXSCAN, 0, SCNT)
      NODATA = .TRUE.
      TBEG = 1.0E5
      TEND = -1.0E5
      IF ((XVAR.EQ.1) .AND. (TSTART.GT.0.0) .AND. (TSTOP.LT.999.0)) THEN
         TBEG = TSTART
         TEND = TSTOP
         END IF
      XMX = TEND
      XMN = TBEG
      XMXW = TEND
      XMNW = TBEG
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                                       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 ((GNRECI(SUBKOL).GT.0) .AND. (SUBARR.GT.0) .AND.
     *      (GNRECI(SUBKOL).NE.SUBARR)) GO TO 100
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      TBEG = MIN (TBEG, GTIME)
         TEND = MAX (TEND, GTIME)
C                                       Get value
         CALL SNPDAT (1, VALUE, XVARIB, CSOU, OKAY)
C                                       Max. - Min
         IF (((OKAY) .OR. (BSYM.GT.0)) .AND. (XVARIB.NE.FBLANK)) THEN
            IF (OKAY) NODATA = .FALSE.
            NANREC(IANT,1) = NANREC(IANT,1) + 1
            I = CSOU + 0.1
            IF ((I.GT.0) .AND. (I.LE.MXSCAN)) SCNT(I) = SCNT(I) + 1
            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
            END IF
 100     CONTINUE
      IERR = MAX (0, IERR)
      FANREC(1,1) = 1
      DO 120 I = 2,MAXANT
         FANREC(I,1) = FANREC(I-1,1) + NANREC(I-1,1)
 120     CONTINUE
      IF (NWORDS.LT.FANREC(MAXANT,1)+NANREC(MAXANT,1)) THEN
         MSGTXT = 'SY 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
      NSTRAN = NP
C
 990  IF (IERR.NE.0) CALL MSGWRT (8)
C
 999  RETURN
C-----------------------------------------------------------------------
 1010 FORMAT ('SYPCNT: ERROR =',I3,' FROM TABIO')
      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 'SYVSN.INC'
      LOGICAL   NODATA, OKAY
      INTEGER   I, NP, IFNUM
      REAL      GTIME, XVARIB, CSOU, VALUE(2*MAXIF)
      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(1,2))
      NODATA = .TRUE.
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) 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
                        END IF
                     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
                        END IF
 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
                        END IF
 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
                        END IF
 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
                     END IF
 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 ((GNRECI(SUBKOL).GT.0) .AND. (SUBARR.GT.0) .AND.
     *      (GNRECI(SUBKOL).NE.SUBARR)) GO TO 100
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      TBEG = MIN (TBEG, GTIME)
         TEND = MAX (TEND, GTIME)
C                                       Get value
         CALL SNPDAT (2, VALUE, XVARIB, CSOU, OKAY)
C                                       Max. - Min
         IF (((OKAY) .OR. (BSYM.GT.0)) .AND. (XVARIB.NE.FBLANK)) THEN
            IF (OKAY) NODATA = .FALSE.
            NANREC(IANT,2) = NANREC(IANT,2) + 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,2) = 1
      DO 120 I = 2,MAXANT
         FANREC(I,2) = FANREC(I-1,2) + NANREC(I-1,2)
 120     CONTINUE
      IF (NWORDS.LT.FANREC(MAXANT,2)+NANREC(MAXANT,2)) THEN
         MSGTXT = 'SN MEMORY TOO SMALL'
         IERR = 10
         END IF
C                                       source number translation
      NP = NSTRAN
      DO 130 I = 1,MXSCAN
         IF ((SCNT(I).GT.0) .AND. (STRANS(I).EQ.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 SYPGET (NV, DATPTS, IERR)
C-----------------------------------------------------------------------
C   SYPGET reads the SY table to find the the data for Psum or Psys
C   for all IFs and then to compute the desired plot variable and find
C   the max and min of the variable
C   Input:
C      NV       I      Number values per time (source, 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      DATPTS   R(*)   Data to be plotted (NV, *)
C      IERR     I      Error code, 0=OK else failed
C   Outputs in common:
C-----------------------------------------------------------------------
      INTEGER   NV, IERR
      REAL      DATPTS(NV,*)
C
      LOGICAL   NODATA, OKAY
      INTEGER   I, NP, NN, IS, KK
      REAL      GTIME, XVARIB, CSOU, TEMP
      INCLUDE 'SYVSN.INC'
      REAL      VALUE(2*MAXIF)
      INCLUDE 'INCS:DDCH.INC'
      INCLUDE 'INCS:DCAT.INC'
      INCLUDE 'INCS:DMSG.INC'
      INCLUDE 'INCS:DFIL.INC'
      INCLUDE 'INCS:PSTD.INC'
C-----------------------------------------------------------------------
      NODATA = .TRUE.
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                                       no weight cutoff in SY table
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 ((GNRECI(SUBKOL).GT.0) .AND. (SUBARR.GT.0) .AND.
     *      (GNRECI(SUBKOL).NE.SUBARR)) GO TO 100
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      TBEG = MIN (TBEG, GTIME)
         TEND = MAX (TEND, GTIME)
C                                       Get value
         CALL SNPDAT (1, 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,1) = NUMPTS(IANT,1) + 1
            NN = FANREC(IANT,1) + NUMPTS(IANT,1) - 1
            IS = CSOU + 0.1
            IF ((IS.GT.0) .AND. (IS.LE.MXSCAN)) CSOU = STRANS(IS)
            DATPTS(1,NN) = CSOU
            DATPTS(2,NN) = XVARIB
            KK = 3
            CALL RCOPY (NP, VALUE, DATPTS(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)
            END IF
 100     CONTINUE
C                                       Check for no data
      IF (NODATA) THEN
         IERR = 6
         MSGTXT = 'SYPGET: NO DATA SELECTED'
         GO TO 990
         END IF
      IERR = MAX (0, IERR)
      CALL TABIO ('CLOS', 0, ICLRNO, GNREC, CLBUFF, I)
      GO TO 999
C
 990  CALL MSGWRT (8)
C
 999  RETURN
C-----------------------------------------------------------------------
 1010 FORMAT ('SYPGET: ERROR =',I3,' FROM TABIO')
      END
      SUBROUTINE SNPGET (NV, DATPTS, IERR)
C-----------------------------------------------------------------------
C   SNPMAX reads the SN or CL table to fill the data array
C   Input:
C      NV       I      Number values per time (source, 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      DATPTS   R(*)   Data to be plotted (NV, *)
C      IERR     I      Error code, 0=OK else failed
C   Outputs in common:
C-----------------------------------------------------------------------
      INTEGER   NV, IERR
      REAL      DATPTS(NV,*)
C
      LOGICAL   NODATA, OKAY
      INTEGER   I, NP, NN, IS, KK, IFNUM
      REAL      GTIME, XVARIB, CSOU, TEMP, TMAX, TMIN
      INCLUDE 'SYVSN.INC'
      REAL      VALUE(2*MAXIF)
      INCLUDE 'INCS:DDCH.INC'
      INCLUDE 'INCS:DCAT.INC'
      INCLUDE 'INCS:DMSG.INC'
      INCLUDE 'INCS:DFIL.INC'
      INCLUDE 'INCS:PSTD.INC'
C-----------------------------------------------------------------------
      NODATA = .TRUE.
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) 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
                       END IF
                    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
                       END IF
 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
                        END IF
 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
                        END IF
 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
                     END IF
 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 ((GNRECI(SUBKOL).GT.0) .AND. (SUBARR.GT.0) .AND.
     *      (GNRECI(SUBKOL).NE.SUBARR)) GO TO 100
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      TBEG = MIN (TBEG, GTIME)
         TEND = MAX (TEND, GTIME)
C                                       Get value
         CALL SNPDAT (2, 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,2) = NUMPTS(IANT,2) + 1
            NN = FANREC(IANT,2) + NUMPTS(IANT,2) - 1
            IS = CSOU + 0.1
            IF ((IS.GT.0) .AND. (IS.LE.MXSCAN)) CSOU = STRANS(IS)
            DATPTS(1,NN) = CSOU
            DATPTS(2,NN) = XVARIB
            KK = 3
            CALL RCOPY (NP, VALUE, DATPTS(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)
            END IF
 100     CONTINUE
      IERR = MAX (0, IERR)
C                                       Set actual X range
      SWAP = .FALSE.
      IF (XVAR.EQ.1) THEN
         XSTART = TBEG
         XSTOP = TEND
      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 = 'SNPGET: 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 = TBEG
      TSTOP = TEND
      XYOFF(1,1) = TMIN
      XYSCL(1,1) = 1000.0 / (TMAX - TMIN)
      XYOFF(1,2) = TMIN
      XYSCL(1,2) = 1000.0 / (TMAX - TMIN)
      PRAN(1,1,1) = TMIN
      PRAN(2,1,1) = TMAX
      PRAN(1,1,2) = TMIN
      PRAN(2,1,2) = 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
      CALL TABIO ('CLOS', 0, ICLRNO, GNREC, CLBUFF, I)
      GO TO 999
C
 990  CALL MSGWRT (8)
C
 999  RETURN
C-----------------------------------------------------------------------
 1010 FORMAT ('SNPGET: ERROR =',I3,' FROM TABIO')
      END
      SUBROUTINE SYPREF (NV, DATPTS, IERR)
C-----------------------------------------------------------------------
C   SYPREF re-references the Psum/Psys in DATPTS
C   Input:
C      NV       I      Number values per time (source, X, n*Y)
C   In/Output:
C      DATPTS   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      DATPTS(NV,*)
C
      INTEGER   JANT, IA, IR, NREC, NMISS, NP, IREC, RREC, JREC, IIF,
     *   IIS, IP
      REAL      EPS, PH
      INCLUDE 'SYVSN.INC'
      INCLUDE 'INCS:DDCH.INC'
      INCLUDE 'INCS:DMSG.INC'
      DATA EPS /1.E-6/
C-----------------------------------------------------------------------
      NP = MUMPOL * MUMIF
C                                       loop over all antennas except
      RREC = NUMPTS(REFANT,1)
      DO 50 JANT = 1,MUMANT
         NMISS = 0
         IF (JANT.EQ.REFANT) GO TO 50
         IA = FANREC(JANT,1) - 1
         NREC = NUMPTS(JANT,1)
         DO 40 IREC = 1,NREC
            IA = IA + 1
C                                       seek a match
            IR = FANREC(REFANT,1) - 1
            DO 10 JREC = 1,RREC
               IR = IR + 1
               IF ((DATPTS(1,IR).EQ.DATPTS(1,IA)) .AND.
     *            (ABS(DATPTS(2,IR)-DATPTS(2,IA)).LE.EPS)) GO TO 15
 10            CONTINUE
C                                       not match
            NMISS = NMISS + 1
            CALL RFILL (NP, FBLANK, DATPTS(3,IA))
            GO TO 40
C                                       close enough
 15         IP = 2
            DO 30 IIF = 1,MUMIF
               DO 20 IIS = 1,MUMPOL
                  IP = IP + 1
                  IF ((DATPTS(IP,IR).EQ.FBLANK) .OR.
     *               (DATPTS(IP,IA).EQ.FBLANK)) THEN
                     DATPTS(IP,IA) = FBLANK
C                                       Psum, Psys
                  ELSE
                     PH = DATPTS(IP,IA) - DATPTS(IP,IR)
                     DATPTS(IP,IA) = PH
                     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) - 1
      NREC = NUMPTS(REFANT,1)
      JANT = REFANT
      DO 80 IREC = 1,NREC
         IR = IR + 1
         IP = 2
         DO 70 IIF = 1,MUMIF
            DO 60 IIS = 1,MUMPOL
               IP = IP + 1
               IF (DATPTS(IP,IR).NE.FBLANK) THEN
                  DATPTS(IP,IR) = 0.0
                  END IF
 60            CONTINUE
 70         CONTINUE
 80      CONTINUE
C
      IERR = 0
 999  RETURN
C-----------------------------------------------------------------------
 1090 FORMAT ('SYPREF: Points misaligned',I6,' of',I7,' antenna',I4)
      END
      SUBROUTINE SNPREF (NV, DATPTS, IERR)
C-----------------------------------------------------------------------
C   SNPMAX re-references the phases in DATPTS and recomputes min/max
C   Input:
C      NV       I      Number values per time (source, X, n*Y)
C   In/Output:
C      DATPTS   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      DATPTS(NV,*)
C
      INTEGER   JANT, IA, IR, NREC, NMISS, NP, IP, IIF, IIS, IREC,
     *   RREC, JREC
      REAL      EPS, PH
      INCLUDE 'SYVSN.INC'
      INCLUDE 'INCS:DDCH.INC'
      INCLUDE 'INCS:DMSG.INC'
      DATA EPS /1.E-6/
C-----------------------------------------------------------------------
      NP = MUMPOL * MUMIF
C                                       loop over all antennas except
      RREC = NUMPTS(REFANT,2)
      DO 50 JANT = 1,MUMANT
         NMISS = 0
         IF (JANT.EQ.REFANT) GO TO 50
         IA = FANREC(JANT,2) - 1
         NREC = NUMPTS(JANT,2)
         DO 40 IREC = 1,NREC
            IA = IA + 1
C                                       seek a match
            IR = FANREC(REFANT,2) - 1
            DO 10 JREC = 1,RREC
               IR = IR + 1
               IF ((DATPTS(1,IR).EQ.DATPTS(1,IA)) .AND.
     *            (ABS(DATPTS(2,IR)-DATPTS(2,IA)).LE.EPS)) GO TO 15
 10            CONTINUE
C                                       not match
            NMISS = NMISS + 1
            CALL RFILL (NP, FBLANK, DATPTS(3,IA))
            GO TO 40
C                                       close enough
 15         IP = 2
            DO 30 IIF = 1,MUMIF
               DO 20 IIS = 1,MUMPOL
                  IP = IP + 1
                  IF ((DATPTS(IP,IR).EQ.FBLANK) .OR.
     *               (DATPTS(IP,IA).EQ.FBLANK)) THEN
                     DATPTS(IP,IA) = FBLANK
C                                       phase
                  ELSE IF (ICODES(2).EQ.4) THEN
                     PH = DATPTS(IP,IA) - DATPTS(IP,IR)
                     IF (PH.LT.-180.0) PH = PH + 360.0
                     IF (PH.GT.180.0) PH = PH - 360.0
                     DATPTS(IP,IA) = PH
C                                       delay, amp
                  ELSE
                     PH = DATPTS(IP,IA) - DATPTS(IP,IR)
                     DATPTS(IP,IA) = PH
                     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,2) - 1
      NREC = NUMPTS(REFANT,2)
      JANT = REFANT
      DO 80 IREC = 1,NREC
         IR = IR + 1
         IP = 2
         DO 70 IIF = 1,MUMIF
            DO 60 IIS = 1,MUMPOL
               IP = IP + 1
               IF (DATPTS(IP,IR).NE.FBLANK) THEN
                  DATPTS(IP,IR) = 0.0
                  END IF
 60            CONTINUE
 70         CONTINUE
 80      CONTINUE
C
      IERR = 0
C
 999  RETURN
C-----------------------------------------------------------------------
 1090 FORMAT ('SNPREF: Points misaligned',I6,' of',I7,' antenna',I4)
      END
      SUBROUTINE SYPMAX (KK, MV, FACT, DATPTS, NV, SYDAT)
C-----------------------------------------------------------------------
C   SYPMAX converts the full IF data into the desired form and then
C   finds the extrema
C   Inputs
C      KK       I         1 -> Psum, Psys, 2 -> delay
C      MV       I         Number points in DATPTS per sample
C      FACT     R         scale factor (APARM(7) or BPARM(7))
C      DATPTS   R(MV,*)   Full SY data
c      NV       I         Number of points in SYDAT per sample
C   Outputs:
C      SYDAT    R(NV,*)   SY data for plotting
C-----------------------------------------------------------------------
      INTEGER   KK, MV, NV
      REAL      FACT, DATPTS(MV,*), SYDAT(NV,*)
C
      INCLUDE 'SYVSN.INC'
      INTEGER   IA, IREC, NREC, JANT, IIF, IP, NSR, NSL, NBR, NBL
      REAL      VSR, VSL, VBR, VBL
      LOGICAL   NOBASE
      INCLUDE 'INS:DDCH.INC'
C-----------------------------------------------------------------------
      NOBASE = EIFS(2,KK).LT.BIFS(2,KK)
      DO 100 JANT = 1,MUMANT
         IA = FANREC(JANT,KK) - 1
         NREC = NUMPTS(JANT,KK)
         DO 90 IREC = 1,NREC
            IA = IA + 1
            NSR = 0
            NSL = 0
            VSR = 0.0
            VSL = 0.0
            NBR = 0
            NBL = 0
            VBR = 0.0
            VBL = 0.0
            SYDAT(1,IA) = DATPTS(1,IA)
            SYDAT(2,IA) = DATPTS(2,IA)
            IP = 2
            DO 50 IIF = BIF,MUMIF+BIF
               IP = IP + 1
               IF (DATPTS(IP,IA).NE.FBLANK) THEN
                  IF ((IIF.GE.BIFS(1,KK)) .AND. (IIF.LE.EIFS(1,KK)))
     *               THEN
                     NSR = NSR + 1
                     VSR = VSR + DATPTS(IP,IA)
                     END IF
                  IF ((IIF.GE.BIFS(2,KK)) .AND. (IIF.LE.EIFS(2,KK)))
     *               THEN
                     NBR = NBR + 1
                     VBR = VBR + DATPTS(IP,IA)
                     END IF
                  IF ((IIF.GE.BIFS(3,KK)) .AND. (IIF.LE.EIFS(3,KK)))
     *               THEN
                     NBR = NBR + 1
                     VBR = VBR + DATPTS(IP,IA)
                     END IF
                  END IF
               IF (MUMPOL.EQ.2) THEN
                  IP = IP + 1
                  IF (DATPTS(IP,IA).NE.FBLANK) THEN
                     IF ((IIF.GE.BIFS(1,KK)) .AND. (IIF.LE.EIFS(1,KK)))
     *                  THEN
                        NSL = NSL + 1
                        VSL = VSL + DATPTS(IP,IA)
                        END IF
                     IF ((IIF.GE.BIFS(2,KK)) .AND. (IIF.LE.EIFS(2,KK)))
     *                  THEN
                        NBL = NBL + 1
                        VBL = VBL + DATPTS(IP,IA)
                        END IF
                     IF ((IIF.GE.BIFS(3,KK)) .AND. (IIF.LE.EIFS(3,KK)))
     *                  THEN
                        NBL = NBL + 1
                        VBL = VBL + DATPTS(IP,IA)
                        END IF
                     END IF
                  END IF
 50            CONTINUE
C                                       output values
            IF (NSR.LE.0) THEN
               SYDAT(3,IA) = FBLANK
            ELSE IF (NOBASE) THEN
               SYDAT(3,IA) = VSR / NSR * FACT
            ELSE IF (NBR.LE.0) THEN
               SYDAT(3,IA) = FBLANK
            ELSE
               VSR = VSR / NSR
               VBR = VBR / NBR
               SYDAT(3,IA) = FACT * (VSR - VBR)
               IF (ABS(APARM(8)-1.0).LT.0.1) THEN
                  IF (VBR.EQ.0.0) THEN
                     SYDAT(3,IA) = FBLANK
                  ELSE
                     SYDAT(3,IA) = SYDAT(3,IA) / VBR
                     END IF
                  END IF
               END IF
            IF (SYDAT(3,IA).NE.FBLANK) THEN
               YYMIN(1,JANT,KK) = MIN (SYDAT(3,IA), YYMIN(1,JANT,KK))
               YYMAX(1,JANT,KK) = MAX (SYDAT(3,IA), YYMAX(1,JANT,KK))
               YYMN(1,KK) = MIN (SYDAT(3,IA), YYMN(1,KK))
               YYMX(1,KK) = MAX (SYDAT(3,IA), YYMX(1,KK))
               END IF
            IF (MUMPOL.EQ.2) THEN
               IF (NSL.LE.0) THEN
                  SYDAT(4,IA) = FBLANK
               ELSE IF (NOBASE) THEN
                  SYDAT(4,IA) = VSL / NSL * FACT
               ELSE IF (NBL.LE.0) THEN
                  SYDAT(4,IA) = FBLANK
               ELSE
                  VSL = VSL / NSL
                  VBL = VBL / NBL
                  SYDAT(4,IA) = FACT * (VSL - VBL)
                  IF (ABS(APARM(8)-1.0).LT.0.1) THEN
                     IF (VBL.EQ.0.0) THEN
                        SYDAT(4,IA) = FBLANK
                     ELSE
                        SYDAT(4,IA) = SYDAT(4,IA) / VBL
                        END IF
                     END IF
                  END IF
               IF (SYDAT(4,IA).NE.FBLANK) THEN
                  YYMIN(2,JANT,KK) = MIN (SYDAT(4,IA), YYMIN(2,JANT,KK))
                  YYMAX(2,JANT,KK) = MAX (SYDAT(4,IA), YYMAX(2,JANT,KK))
                  YYMN(2,KK) = MIN (SYDAT(4,IA), YYMN(2,KK))
                  YYMX(2,KK) = MAX (SYDAT(4,IA), YYMX(2,KK))
                  END IF
               END IF
 90         CONTINUE
 100     CONTINUE
C
 999  RETURN
      END
      SUBROUTINE SNPMAX (MV, DATPTS, NV, SNDAT)
C-----------------------------------------------------------------------
C   SNPMAX converts the full IF data into the desired form and then
C   finds the extrema - for phases
C   Inputs
C      MV       I         Number points in DATPTS per sample
C      DATPTS   R(MV,*)   Full SY data
c      NV       I         Number of points in SNDAT per sample
C   Outputs:
C      SNDAT    R(NV,*)   SY data for plotting
C-----------------------------------------------------------------------
      INTEGER   MV, NV
      REAL      DATPTS(MV,*), SNDAT(NV,*)
C
      INCLUDE 'SYVSN.INC'
      INTEGER   KK, IA, IREC, NREC, JANT, IIF, IP, NSR, NSL, NBR, NBL
      REAL      SVSR, SVSL, SVBR, SVBL, CVSR, CVSL, CVBR, CVBL, CPH,
     *   SPH, RDUM(8)
      LOGICAL   NOBASE
      EQUIVALENCE (RDUM, SVSR)
      INCLUDE 'INCS:DDCH.INC'
      INCLUDE 'INCS:PSTD.INC'
      COMMON /LOCAL/ SVSR, SVSL, SVBR, SVBL, CVSR, CVSL, CVBR, CVBL
C-----------------------------------------------------------------------
      KK = 2
      NOBASE = EIFS(2,KK).LT.BIFS(2,KK)
      DO 100 JANT = 1,MUMANT
         IA = FANREC(JANT,KK) - 1
         NREC = NUMPTS(JANT,KK)
         DO 90 IREC = 1,NREC
            IA = IA + 1
            NSR = 0
            NSL = 0
            CALL RFILL (8, 0.0, RDUM)
            NBR = 0
            NBL = 0
            SNDAT(1,IA) = DATPTS(1,IA)
            SNDAT(2,IA) = DATPTS(2,IA)
            IP = 2
            DO 50 IIF = BIF,MUMIF+BIF
               IP = IP + 1
               IF (DATPTS(IP,IA).NE.FBLANK) THEN
                  CPH = COS (DATPTS(IP,IA) * DG2RAD)
                  SPH = SIN (DATPTS(IP,IA) * DG2RAD)
                  IF ((IIF.GE.BIFS(1,KK)) .AND. (IIF.LE.EIFS(1,KK)))
     *               THEN
                     NSR = NSR + 1
                     SVSR = SVSR + SPH
                     CVSR = CVSR + CPH
                     END IF
                  IF ((IIF.GE.BIFS(2,KK)) .AND. (IIF.LE.EIFS(2,KK)))
     *               THEN
                     NBR = NBR + 1
                     SVBR = SVBR + SPH
                     CVBR = CVBR + CPH
                     END IF
                  IF ((IIF.GE.BIFS(3,KK)) .AND. (IIF.LE.EIFS(3,KK)))
     *               THEN
                     NBR = NBR + 1
                     SVBR = SVBR + SPH
                     CVBR = CVBR + CPH
                     END IF
                  END IF
               IF (MUMPOL.EQ.2) THEN
                  IP = IP + 1
                  IF (DATPTS(IP,IA).NE.FBLANK) THEN
                     CPH = COS (DATPTS(IP,IA) * DG2RAD)
                     SPH = SIN (DATPTS(IP,IA) * DG2RAD)
                     IF ((IIF.GE.BIFS(1,KK)) .AND. (IIF.LE.EIFS(1,KK)))
     *                  THEN
                        NSL = NSL + 1
                        SVSL = SVSL + SPH
                        CVSL = CVSL + CPH
                        END IF
                     IF ((IIF.GE.BIFS(2,KK)) .AND. (IIF.LE.EIFS(2,KK)))
     *                  THEN
                        NBL = NBL + 1
                        SVBL = SVBL + SPH
                        CVBL = CVBL + CPH
                        END IF
                     IF ((IIF.GE.BIFS(3,KK)) .AND. (IIF.LE.EIFS(3,KK)))
     *                  THEN
                        NBL = NBL + 1
                        SVBL = SVBL + SPH
                        CVBL = CVBL + CPH
                        END IF
                     END IF
                  END IF
 50            CONTINUE
C                                       output values
            IF (NSR.LE.0) THEN
               SNDAT(3,IA) = FBLANK
            ELSE IF (NOBASE) THEN
               SNDAT(3,IA) = RAD2DG * ATAN2 (SVSR, CVSR)  * BPARM(7)
            ELSE IF (NBR.LE.0) THEN
               SNDAT(3,IA) = FBLANK
            ELSE
               SVSR = RAD2DG * ATAN2 (SVSR, CVSR)
               SVBR = RAD2DG * ATAN2 (SVBR, CVBR)
               SVSR = SVSR - SVBR
               IF (SVSR.LT.-180.0) SVSR = SVSR + 360.0
               IF (SVSR.GT.180.0) SVSR = SVSR - 360.0
               SNDAT(3,IA) = BPARM(7) * SVSR
               END IF
            IF (SNDAT(3,IA).NE.FBLANK) THEN
               YYMIN(1,JANT,KK) = MIN (SNDAT(3,IA), YYMIN(1,JANT,KK))
               YYMAX(1,JANT,KK) = MAX (SNDAT(3,IA), YYMAX(1,JANT,KK))
               YYMN(1,KK) = MIN (SNDAT(3,IA), YYMN(1,KK))
               YYMX(1,KK) = MAX (SNDAT(3,IA), YYMX(1,KK))
               SPH = SNDAT(3,IA)
               IF (SPH.LT.0.0) SPH = SPH + 360.0 * ABS (BPARM(7))
               PPMIN(1,JANT) = MIN (SPH, PPMIN(1,JANT))
               PPMAX(1,JANT) = MAX (SPH, PPMAX(1,JANT))
               END IF
            IF (MUMPOL.EQ.2) THEN
               IF (NSL.LE.0) THEN
                  SNDAT(4,IA) = FBLANK
               ELSE IF (NOBASE) THEN
                  SNDAT(4,IA) = RAD2DG * ATAN2 (SVSL, CVSL)  * BPARM(7)
               ELSE IF (NBL.LE.0) THEN
                  SNDAT(4,IA) = FBLANK
               ELSE
                  SVSL = RAD2DG * ATAN2 (SVSL, CVSL)
                  SVBL = RAD2DG * ATAN2 (SVBL, CVBL)
                  SVSL = SVSL - SVBL
                  IF (SVSL.LT.-180.0) SVSL = SVSL + 360.0
                  IF (SVSL.GT.180.0) SVSL = SVSL - 360.0
                  SNDAT(4,IA) = BPARM(7) * SVSL
                  END IF
               IF (SNDAT(4,IA).NE.FBLANK) THEN
                  YYMIN(2,JANT,KK) = MIN (SNDAT(4,IA), YYMIN(2,JANT,KK))
                  YYMAX(2,JANT,KK) = MAX (SNDAT(4,IA), YYMAX(2,JANT,KK))
                  YYMN(2,KK) = MIN (SNDAT(4,IA), YYMN(2,KK))
                  YYMX(2,KK) = MAX (SNDAT(4,IA), YYMX(2,KK))
                  SPH = SNDAT(4,IA)
                  IF (SPH.LT.0.0) SPH = SPH + 360.0 * ABS (BPARM(7))
                  PPMIN(2,JANT) = MIN (SPH, PPMIN(2,JANT))
                  PPMAX(2,JANT) = MAX (SPH, PPMAX(2,JANT))
                  END IF
               END IF
 90         CONTINUE
 100     CONTINUE
C
 999  RETURN
      END
      SUBROUTINE GETSCL (KK, LST1, LST2, 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      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, LANT
      LOGICAL   DOIT
C
      INCLUDE 'SYVSN.INC'
      INTEGER   IST
      REAL      YMX, YMN, PMX, PMN, TMAX, TMIN, TDIF, TOLER(8), SIZEY
C                                       Minimum value range for each
C                                       ICODE
C                  Psum  Psys  Pdif   Phs    Delay    Amp     Tsys
      DATA TOLER /0.001, 0.01, 0.001, 0.001, 1.0E-12, 0.001, 0.001,
C        Tant
     *   0.000001/
C-----------------------------------------------------------------------
      DOIT = .FALSE.
      YMX = -1.E8
      YMN = -YMX
      PMX = YMX
      PMN = YMN
      DO 20 IST = LST1,LST2
         IF (YYMAX(IST,LANT,KK).GE.YYMIN(IST,LANT,KK)) THEN
            DOIT = .TRUE.
            YMX = MAX (YMX, YYMAX(IST,LANT,KK))
            YMN = MIN (YMN, YYMIN(IST,LANT,KK))
            IF (ICODES(KK).EQ.4) THEN
               PMX = MAX (PMX, PPMAX(IST,LANT))
               PMN = MIN (PMN, PPMIN(IST,LANT))
               END IF
            END IF
 20      CONTINUE
      IF ((ICODES(KK).EQ.4) .AND. (PMX-PMN.LT.YMX-YMN)) THEN
         YMX = PMX
         YMN = PMN
         END IF
      IF ((KK.EQ.1) .AND. (PIXR(2).GT.PIXR(1))) THEN
         YMX = PIXR(2)
         YMN = PIXR(1)
         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,KK) = TMIN
      XYSCL(2,KK) = 1000.0 / TDIF / NCOUNT
      PRAN(1,2,KK) = TMIN
      PRAN(2,2,KK) = TMAX
C
 999  RETURN
      END
      SUBROUTINE SNPDAT (KK, 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
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'
      INTEGER   KK
      REAL      VALUE(2*MAXIF), XVARIB, CSOU
      LOGICAL   OKAY
C
      INTEGER   IIS, IIF, IP1, IP2, LP, JP1, JP2, ICODE
      REAL      V, TC
      LOGICAL   T
      INCLUDE 'SYVSN.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)
      ICODE = ICODES(KK)
      CALL RFILL (LP, FBLANK, VALUE)
C                                       Select data type
C                                       Phase (deg)
      IF (ICODE.EQ.4) THEN
         DO 110 IIS = 1,MUMPOL
            LP = IIS - MUMPOL
            IP1 = REKOL(IIS) - NTONE
            JP1 = IMKOL(IIS) - NTONE
            IP2 = REKOL(2) - NTONE
            JP2 = IMKOL(2) - NTONE
            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) = 57.296 *
     *               ATAN2 (GNREC(JP1), GNREC(IP1) + 1.0E-20)
                  END IF
 105           CONTINUE
 110        CONTINUE
C                                       Delay (sec)
      ELSE IF (ICODE.EQ.5) THEN
         DO 150 IIS = 1,MUMPOL
            LP = IIS - MUMPOL
            IP1 = DLKOL(IIS) - 1
            IP2 = DLKOL(2) - 1
            DO 145 IIF = 1,MUMIF
               IP1 = IP1 + 1
               IP2 =  IP2 + 1
               LP = LP + MUMPOL
               IF (GNREC(IP1).NE.FBLANK) THEN
                  VALUE(LP) = GNREC(IP1)
                  END IF
 145           CONTINUE
 150        CONTINUE
C                                       Amplitude
      ELSE IF (ICODE.EQ.6) THEN
         DO 130 IIS = 1,MUMPOL
            LP = IIS - MUMPOL
            IP1 = REKOL(IIS) - NTONE
            JP1 = IMKOL(IIS) - NTONE
            IP2 = REKOL(2) - NTONE
            JP2 = IMKOL(2) - NTONE
            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) = SQRT ((GNREC(IP1)**2) + (GNREC(JP1)**2)) *
     *               GMMOD
                  END IF
 125           CONTINUE
 130        CONTINUE
C                                       Pdif
      ELSE IF (ICODE.EQ.3) THEN
         DO 420 IIS = 1,MUMPOL
            LP = IIS - MUMPOL
            IP1 = REKOL(IIS) - NTONE
            IP2 = REKOL(2) - NTONE
            DO 415 IIF = 1,MUMIF
               IP1 = IP1 + NTONE
               IP2 = IP2 + NTONE
               LP = LP + MUMPOL
               IF (GNREC(IP1).NE.FBLANK) VALUE(LP) = GNREC(IP1)
 415           CONTINUE
 420        CONTINUE
C                                       Psum
      ELSE IF (ICODE.EQ.2) THEN
         DO 430 IIS = 1,MUMPOL
            LP = IIS - MUMPOL
            IP1 = IMKOL(IIS) - NTONE
            IP2 = IMKOL(2) - NTONE
            DO 425 IIF = 1,MUMIF
               IP1 = IP1 + NTONE
               IP2 = IP2 + NTONE
               LP = LP + MUMPOL
               IF (GNREC(IP1).NE.FBLANK) VALUE(LP) = GNREC(IP1)
 425           CONTINUE
 430        CONTINUE
C                                       PSYS = PSUM / PDIF = Tsys/Tcal
      ELSE IF (ICODE.EQ.1) THEN
         DO 450 IIS = 1,MUMPOL
            LP = IIS - MUMPOL
            IP1 = REKOL(IIS) - NTONE
            IP2 = REKOL(2) - NTONE
            JP1 = IMKOL(IIS) - NTONE
            JP2 = IMKOL(2) - NTONE
            DO 445 IIF = 1,MUMIF
               IP1 = IP1 + NTONE
               IP2 = IP2 + NTONE
               JP1 = JP1 + NTONE
               JP2 = JP2 + 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) = V
                  END IF
 445           CONTINUE
 450        CONTINUE
C                                       Tsys (TY table)
      ELSE IF (ICODE.EQ.7) THEN
         DO 190 IIS = 1,MUMPOL
            LP = IIS - MUMPOL
            IP1 = TSKOL(IIS) - 1
            DO 185 IIF = 1,MUMIF
               IP1 = IP1 + 1
               LP = LP + MUMPOL
               IF (ABS(GNREC(IP1)-999.0).LT.0.1) GNREC(IP1) = FBLANK
               IF (GNREC(IP1).NE.FBLANK) VALUE(LP) = GNREC(IP1)
 185           CONTINUE
 190        CONTINUE
C                                       Tant (K)
      ELSE IF (ICODE.EQ.8) 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 (GNREC(IP1).NE.FBLANK) VALUE(LP) = GNREC(IP1)
 285           CONTINUE
 290        CONTINUE
         END IF
C
      OKAY = .TRUE.
      LP = MUMPOL * MUMIF
      DO 910 IIS = 1,LP
         IF (VALUE(IIS).NE.FBLANK) GO TO 999
 910     CONTINUE
      OKAY = .FALSE.
C
 999  RETURN
      END
      SUBROUTINE SNPCOR (NV, NA, SYPTS, SNPTS)
C-----------------------------------------------------------------------
C   Computes correlation coefficients: first regrids the data on a 1
C   second grid, then computes linear correlation coefficient and prints
C   it
C      NV       I      Number values per antenna
C      NA       I      Number antennas in data array
C      SYPTS    R(*)   SY Data (NV,*)
C      SNPTS    R(*)   SN Data (NV,*)
C   Output:
C      IRET     I      Return code, 0=OK else failed
C-----------------------------------------------------------------------
      INTEGER   NV, NA
      REAL      SYPTS(NV,*), SNPTS(NV,*)
C
      INCLUDE 'SYVSN.INC'
      INTEGER   IA, IIS, NST, I, IT, J, IXX(86400), LT, NT, IRET
      REAL      TMIN, TMAX, YY(86400), SS(86400), CC(86400), SYV(86400),
     *   SNV(86400), R, SYMIN, SNMIN, XSCALE(6), SCALE
      CHARACTER MARK*1
      LOGICAL   DOPLOT
      INCLUDE 'INCS:DMSG.INC'
      INCLUDE 'INCS:DDCH.INC'
      INCLUDE 'INCS:PSTD.INC'
      DATA XSCALE /86400., 100., 8640., 8640., 100., 100./
C-----------------------------------------------------------------------
      DOPLOT = ABSICA.LT.0.0
      TMIN = 1.E10
      TMAX = -1.E10
      NST = NV - 2
      DO 20 IA = 1,NA
         IF ((NUMPTS(IA,1).GT.0) .AND. (NUMPTS(IA,2).GT.0)) THEN
            I = FANREC(IA,1)
            DO 10 J = 1,NUMPTS(IA,1)
               TMIN = MIN (TMIN, SYPTS(2,I))
               TMAX = MAX (TMAX, SYPTS(2,I))
               I = I + 1
 10            CONTINUE
            I = FANREC(IA,2)
            DO 15 J = 1,NUMPTS(IA,2)
               TMIN = MIN (TMIN, SNPTS(2,I))
               TMAX = MAX (TMAX, SNPTS(2,I))
               I = I + 1
 15            CONTINUE
            END IF
 20      CONTINUE
      SCALE = XSCALE (XVAR)
      NT = (TMAX - TMIN) * SCALE + 1.99
      DO 100 IA = 1,NA
         IF ((NUMPTS(IA,1).GT.0) .AND. (NUMPTS(IA,2).GT.0) .AND.
     *      (IA.NE.REFANT)) THEN
            DO 90 IIS = 1,NST
C                                       copy SY to work area, smooth
               IT = 0
               DO 30 I = 1,NUMPTS(IA,1)
                  J = I + FANREC(IA,1) - 1
                  IF (SYPTS(2+IIS,J).NE.FBLANK) THEN
                     IT = IT + 1
                     IXX(IT) = (SYPTS(2,J) - TMIN) * SCALE + 1.5
                     YY(IT) = SYPTS(2+IIS,J)
                     END IF
 30               CONTINUE
               CALL SMOOTH (SAMTYP, STTSY, IT, IXX, YY, NT, SYV)
               LT = IT
C                                       copy SN to work area, smooth
               IT = 0
               DO 35 I = 1,NUMPTS(IA,2)
                  J = I + FANREC(IA,2) - 1
                  IF (SNPTS(2+IIS,J).NE.FBLANK) THEN
                     IT = IT + 1
                     IXX(IT) = (SNPTS(2,J) - TMIN) * SCALE + 1.5
                     SS(IT) = SIN (DG2RAD * SNPTS(2+IIS,J))
                     CC(IT) = COS (DG2RAD * SNPTS(2+IIS,J))
                     END IF
 35               CONTINUE
               LT = MIN (LT, IT)
               CALL SMOOTH (SAMTYP, STTSN, IT, IXX, CC, NT, YY)
               CALL SMOOTH (SAMTYP, STTSN, IT, IXX, SS, NT, CC)
               SYMIN = 1.E10
               SNMIN = 1000.
               DO 40 I = 1,NT
                  SNV(I) = FBLANK
                  IF ((CC(I).NE.FBLANK) .AND. (YY(I).NE.FBLANK)) THEN
                     SNV(I) = RAD2DG * ATAN2 (CC(I), YY(I))
                     SNMIN = MIN (SNMIN, SNV(I))
                     END IF
                  IF (SYV(I).NE.FBLANK) SYMIN = MIN (SYMIN, SYV(I))
 40               CONTINUE
C                                       get full correlation coeff
               CALL GETCOR (NT, SYV, SNV, R)
               MARK = ' '
               IF (ABS(R).GT.0.3) MARK = '*'
               WRITE (MSGTXT,1050) IA, IIS, LT, R, MARK
               CALL MSGWRT (4)
               RVALUE(IIS,IA) = R
               IF (DOPLOT) THEN
                  CALL PLTSY (NT, IA, IIS, R, SYV, SNV, IRET)
                  IF (IRET.NE.0) DOPLOT = .FALSE.
                  END IF
               IF (ABSICA.LT.0.0) CALL SUBCOR (NT, IIS, IA, SYV, SNV,
     *            TMIN)
 90            CONTINUE
            END IF
 100     CONTINUE
C      IF ((XINC.GT.0) .AND. (ABSICA.LT.0.0)) CALL PLTCOR
C
 999  RETURN
C-----------------------------------------------------------------------
 1050 FORMAT ('Ant',I4,' St',I2,'  Npoints',I8,'  Corr coef',F9.3,1X,A1)
      END
      SUBROUTINE GETCOR (NV, SYV, SNV, R)
C-----------------------------------------------------------------------
C   GETCOR computes the correlation of 2 arrays
C   Inputs
C      NV    I      Number values
C      SYV   R(*)   First array
C      SNV   R(*)   Second array
C   Outputs
C      R     R      Linear correlation coefficient
C-----------------------------------------------------------------------
      INTEGER   NV
      REAL      SYV(*), SNV(*), R
C
      INTEGER   I, NNT
      REAL      SX, SY, SXY, SXX, SYY
      INCLUDE 'INCS:DDCH.INC'
C-----------------------------------------------------------------------
      SX = 0.0
      SY = 0.0
      SXX = 0.0
      SYY = 0.0
      SXY = 0.0
      NNT = 0
      DO 20 I = 1,NV
         IF ((SYV(I).NE.FBLANK) .AND. (SNV(I).NE.FBLANK)) THEN
            NNT = NNT + 1
            SX = SX + SYV(I)
            SXX = SXX + SYV(I) * SYV(I)
            SXY = SXY + SYV(I) * SNV(I)
            SY = SY + SNV(I)
            SYY = SYY + SNV(I) * SNV(I)
            END IF
 20      CONTINUE
      R = (NNT * SXX - SX * SX) * (NNT * SYY - SY * SY)
      R = SQRT (MAX (0.0, R))
      IF (R.NE.0.0) R = (NNT * SXY - SX * SY) / R
C
 999  RETURN
      END
      SUBROUTINE SUBCOR (NV, IST, IA, SYV, SNV, TMIN)
C-----------------------------------------------------------------------
C   SUBCOR takes equal subintervals of 2 arrays and gets their linear
C   correlation coefficients as a function of time
C   Inputs:
C      NV     I      Number 1-sec times in arrays
C      IST    I      Stokes
C      IA     I      Antenna
C      SYV    R(*)   Array 1
C      SNV    R(*)   Array 2
C      TMIN   R      Start time
C   Inputs common:
C      XINC   I      Desired increment in seconds between sub groups
C   Outputs common
C      RVALS  R(*)   Corr coeff (ist, iant, t)
C      RTS    R      Times (t)
C-----------------------------------------------------------------------
      INTEGER   NV, IST, IA
      REAL      SYV(*), SNV(*), TMIN
C
      INCLUDE 'SYVSN.INC'
      INTEGER   I, J, NT
      REAL      R
C-----------------------------------------------------------------------
      IF (XINC.GT.0) THEN
         R = NV
         I = R / XINC + 0.5
         NT = NV / I
         J = NV / NT
         IF (J.GT.2000) NT = NV / 2000
         J = 0
         DO 20 I = 1,NV,NT
            J = J + 1
            CALL GETCOR (NT, SYV(I), SNV(I), R)
            RVALS(IST,IA,J) = R
            RTS(IST,IA,J) = TMIN + (I-0.5+NT/2.0) / 86400.0
 20         CONTINUE
         END IF
C
 999  RETURN
      END
      SUBROUTINE SMOOTH (TYPE, STT, IT, IXX, YY, NT, OUT)
C-----------------------------------------------------------------------
C   SMOOTH smooths an input array at irregular times to an output array
C   at integer seconds relative to the start
C   Inputs:
C      TYPE  C*4    type of smoothing
C      STT   R(3)   Support, half width, wt cutoff
C      IT    I      Number samples in input arrays
C      IXX   I(*)   Input times in integer seconds
C      YY    R(*)   Data values
C      NT    I      Number of times out (== max relative time)
C   Outputs
C      OUR   R(*)   Smoothed regular array
C-----------------------------------------------------------------------
      CHARACTER TYPE*4
      INTEGER   IT, IXX(*), NT
      REAL      STT(3), YY(*), OUT(*)
C
      INTEGER   I, J, J1, J2, K, K1, K2, J0, N
      REAL      HWIDTH, SCRTCH(86400), FWIDTH, WT, MEDIAN, CUT
      INCLUDE 'INCS:DDCH.INC'
C-----------------------------------------------------------------------
      HWIDTH = STT(1) / 2.0
      CALL RFILL (NT, 0.0, OUT)
      CALL RFILL (NT, 0.0, SCRTCH)
      K = HWIDTH + 0.5
      CUT = STT(3)
C                                       median window filter
      IF (TYPE.EQ.'MWF') THEN
         J0 = 1
         DO 130 I = 1,NT
            K1 = MAX (1, I-K)
            K2 = MIN (NT, I+K)
            J1 = NT
            J2 = 0
            DO 110 J = J0,IT
               IF (IXX(J).GE.K1) THEN
                  IF (IXX(J).LE.K2) THEN
                     J1 = MIN (J1, J)
                     J2 = MAX (J2, J)
                  ELSE
                     GO TO 115
                     END IF
                  END IF
 110           CONTINUE
 115        IF (J2.EQ.J1) THEN
               OUT(I) = YY(J)
               J0 = J1
            ELSE IF (J2.GT.J1) THEN
               N = J2 - J1 + 1
               CALL RCOPY (N, YY(J1), SCRTCH)
               OUT(I) = MEDIAN (N, SCRTCH)
               J0 = J1
               END IF
 130        CONTINUE
C                                       2 point
      ELSE IF (TYPE.EQ.'2PT') THEN
         J1 = IXX(1)
         CALL RCOPY (J1, YY(1), OUT(1))
         DO 220 J = 2,IT
            J2 = IXX(J)
            IF (J2.GT.J1) THEN
               WT = J2 - J1
               DO 210 I = J1,J2
                  OUT(I) = YY(J1) + (YY(J2)-YY(J1)) * (I-J1) / WT
 210              CONTINUE
               END IF
            J1 = J2
 220        CONTINUE
C                                       Gaussian
      ELSE IF (TYPE.EQ.'GAUS') THEN
         FWIDTH = STT(2) / 2.0 / SQRT (LOG (2.0))
         DO 320 J = 1,IT
            J1 = MAX (1, IXX(J) - K)
            J2 = MIN (IT, IXX(J) + K)
            DO 310 I = J1,J2
               WT = ABS (IXX(J) - I) / FWIDTH
               WT = EXP (-(WT*WT))
               OUT(I) = OUT(I) + YY(J) * WT
               SCRTCH(I) = SCRTCH(I) + WT
 310           CONTINUE
 320        CONTINUE
         DO 330 I = 1,NT
            IF (SCRTCH(I).GE.CUT) THEN
               OUT(I) = OUT(I) / SCRTCH(I)
            ELSE
               OUT(I) = FBLANK
               END IF
 330        CONTINUE
C                                       Exponential
      ELSE IF (TYPE.EQ.'EXP') THEN
         FWIDTH = STT(2) / 2.0 / LOG (2.0)
         DO 420 J = 1,IT
            J1 = MAX (1, IXX(J) - K)
            J2 = MIN (IT, IXX(J) + K)
            DO 410 I = J1,J2
               WT = ABS (IXX(J) - I) / FWIDTH
               WT = EXP (-WT)
               OUT(I) = OUT(I) + YY(J) * WT
               SCRTCH(I) = SCRTCH(I) + WT
 410           CONTINUE
 420        CONTINUE
         DO 430 I = 1,NT
            IF (SCRTCH(I).GE.CUT) THEN
               OUT(I) = OUT(I) / SCRTCH(I)
            ELSE
               OUT(I) = FBLANK
               END IF
 430        CONTINUE
C                                       Linear
      ELSE IF (TYPE.EQ.'LINE') THEN
         FWIDTH = STT(2)
         DO 520 J = 1,IT
            J1 = MAX (1, IXX(J) - K)
            J2 = MIN (IT, IXX(J) + K)
            DO 510 I = J1,J2
               WT = ABS (IXX(J) - I) / FWIDTH
               WT = MAX (0.0, 1.0-WT)
               OUT(I) = OUT(I) + YY(J) * WT
               SCRTCH(I) = SCRTCH(I) + WT
 510           CONTINUE
 520        CONTINUE
         DO 530 I = 1,NT
            IF (SCRTCH(I).GE.CUT) THEN
               OUT(I) = OUT(I) / SCRTCH(I)
            ELSE
               OUT(I) = FBLANK
               END IF
 530        CONTINUE
C                                       boxcar
      ELSE
         DO 620 J = 1,IT
            J1 = MAX (1, IXX(J) - K)
            J2 = MIN (IT, IXX(J) + K)
            DO 610 I = J1,J2
               OUT(I) = OUT(I) + YY(J)
               SCRTCH(I) = SCRTCH(I) + 1.0
 610           CONTINUE
 620        CONTINUE
         DO 630 I = 1,NT
            IF (SCRTCH(I).GE.CUT) THEN
               OUT(I) = OUT(I) / SCRTCH(I)
            ELSE
               OUT(I) = FBLANK
               END IF
 630        CONTINUE
         END IF
C
 999  RETURN
      END
      SUBROUTINE SNPLOT (NV, NA, SYPTS, SNPTS, IRET)
C-----------------------------------------------------------------------
C   SNPLOT plots the data thru calls to PLTSN.
C   Input:
C      NV       I      Number values per antenna
C      NA       I      Number antennas in data array
C      SYPTS    R(*)   SY Data (NV,*)
C      SNPTS    R(*)   SN Data (NV,*)
C   Output:
C      IRET     I      Return code, 0=OK else failed
C-----------------------------------------------------------------------
      INTEGER   NV, NA, IRET
      REAL      SYPTS(NV,*), SNPTS(NV,*)
C
      INTEGER   IPLOT, JPLT, IPLT, NPLT, KK, LUMST, LST1, LST2, IIS,
     *   DOLAB
      LOGICAL   DOIT, DOPOL, OVERL
      INCLUDE 'SYVSN.INC'
      INCLUDE 'INCS:DMSG.INC'
      INCLUDE 'INCS:PSTD.INC'
C-----------------------------------------------------------------------
      IRET = 0
      IPLOT = 0
C                                       Loop thru stations to plot
      LUMST = MUMPOL
      DOPOL = (ABS(CROWD-1.0).LT.0.5)
      OVERL = (ABS(CROWD-2.0).LT.0.5)
      CALL FILL (4, 4, COLORS)
      IF (DOPOL) THEN
         COLORS(1,1) = 3
         COLORS(1,2) = 3
      ELSE IF (OVERL) THEN
         COLORS(1,1) = 3
         COLORS(2,1) = 3
         END IF
      IF (DOPOL) LUMST = 1
      NCODES = 2
C                                       not overlapped
      IF (.NOT.OVERL) THEN
C                                       count the plots
         NPLOTS = 0
         DO 40 IPLT = 1,MUMANT
            IF (IPLT.NE.REFANT) THEN
               DO 30 IIS = 1,LUMST
                  IF (DOPOL) THEN
                     LST1 = 1
                     LST2 = MUMPOL
                  ELSE
                     LST1 = IIS
                     LST2 = IIS
                     END IF
                  DO 25 KK = 1,NCODES
                     CALL GETSCL (KK, LST1, LST2, IPLT, DOIT)
                     IF (DOIT) NPLOTS = NPLOTS + 1
 25                  CONTINUE
 30               CONTINUE
               END IF
 40         CONTINUE
C                                       Now plot
         NPLT = 0
         DOLAB = 2
         DO 90 IPLT = 1,MUMANT
            IF (IPLT.NE.REFANT) THEN
               DO 80 IIS = 1,LUMST
                  IF (DOPOL) THEN
                     LST1 = 1
                     LST2 = MUMPOL
                  ELSE
                     LST1 = IIS
                     LST2 = IIS
                     END IF
                  DO 70 KK = 1,NCODES
                     CALL GETSCL (KK, LST1, LST2, IPLT, DOIT)
                     IF (DOIT) THEN
                        NPLT = NPLT + 1
                        JPLT = NPLT
                        IPLOT = MOD (NPLT-1, NCOUNT) + 1
                        IF (NPLT.EQ.NPLOTS) IPLOT = -IPLOT
                        IF (KK.EQ.1) THEN
                           CALL PLTSN (DOLAB, IPLOT, KK, LST1, LST2,
     *                        IPLT,NV, SYPTS, IRET)
                        ELSE
                           CALL PLTSN (DOLAB, IPLOT, KK, LST1, LST2,
     *                        IPLT,NV, SNPTS, IRET)
                           END IF
                        IF (IRET.NE.0) GO TO 999
                        END IF
 70                  CONTINUE
 80               CONTINUE
               END IF
 90         CONTINUE
C                                       overlap 2 physical types
      ELSE
C                                       count the plots
         NPLOTS = 0
         DO 140 IPLT = 1,MUMANT
            IF (IPLT.NE.REFANT) THEN
               DO 130 IIS = 1,LUMST
                  IF (DOPOL) THEN
                     LST1 = 1
                     LST2 = MUMPOL
                  ELSE
                     LST1 = IIS
                     LST2 = IIS
                     END IF
                  CALL GETSCL (2, LST1, LST2, IPLT, DOIT)
                  IF (DOIT) THEN
                     CALL GETSCL (1, LST1, LST2, IPLT, DOIT)
                     IF (DOIT) NPLOTS = NPLOTS + 1
                     END IF
 130              CONTINUE
               END IF
 140        CONTINUE
C                                       Now plot
         NPLT = 0
         DO 190 IPLT = 1,MUMANT
            IF (IPLT.NE.REFANT) THEN
               DO 180 IIS = 1,LUMST
                  LST1 = IIS
                  LST2 = IIS
                  CALL GETSCL (2, LST1, LST2, IPLT, DOIT)
                  IF (DOIT) THEN
                     CALL GETSCL (1, LST1, LST2, IPLT, DOIT)
                     IF (DOIT) THEN
                        NPLT = NPLT + 1
                        JPLT = NPLT
                        IPLOT = MOD (NPLT-1, NCOUNT) + 1
                        DOLAB = 1
                        CALL PLTSN (DOLAB, IPLOT, 1, LST1, LST2, IPLT,
     *                     NV,SYPTS, IRET)
                        IF (IRET.NE.0) GO TO 999
                        CALL GETSCL (2, LST1, LST2, IPLT, DOIT)
                        IF (DOIT) THEN
                           DOLAB = 3
                           IF (NPLT.EQ.NPLOTS) IPLOT = -IPLOT
                           CALL PLTSN (DOLAB, IPLOT, 2, LST1, LST2, IPLT
     *                        ,NV, SNPTS, IRET)
                           IF (IRET.NE.0) GO TO 999
                           END IF
                        END IF
                     END IF
 180              CONTINUE
               END IF
 190        CONTINUE
         END IF
C
 999  RETURN
      END
      SUBROUTINE PLTSN (DOLAB, IPLOT, KK, LST1, LST2, ANTNO, NV, PLTPTS,
     *   IRET)
C-----------------------------------------------------------------------
C   PLTSN actually plots data.
C   Input:
C      DOLAB    I      1 -> label, do not end plot
C                      2 -> label and end plot is appropriate
C                      3 -> no label, end plot if appropriate
C      IPLOT    I      Plot number on current page. If neg. then this is
C                      last plot.
C      KK       I      Parameter number
C      LST1     I      1st Stokes this plot
C      LST2     I      last Stokes this plot
C      ANTNO    I      Antenna number
C      NV       I      Number values
C      PLTPTS   R(*)   Data to plot (NV,*)
C   Output:
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   DOLAB, IPLOT, KK, LST1, LST2, ANTNO, NV, IRET
      REAL      PLTPTS(NV,*)
C
      INCLUDE 'SYVSN.INC'
C
      CHARACTER TEXT*132, PFILE*48, ATIME*8, ADATE*12, CHTMP*18,
     *   AUNITS(NCODE)*8, CHTYPE(NCODE)*16, XUNITS(6)*20,
     *   TXTMSG*80, CSAVE*5, STEXT*16
      INTEGER   BUFFER(256), VER, IERR, ITYPE, IPSIZE, LUNPL, LTYPE,
     *   FINDPL, DEPTH(5), INCHAR, INP, IT(3), ID(3), IAXLAB, IAPLOT,
     *   I, NGOOD, NNOFIT, JCODE, NN, IP, IST, ILITY, NNN, NR(2)
      REAL      BLC(2), TRC(2), DX, DY, TR, VALUE, TI, XY(2),
     *   XTRC(2), XBLC(2), TLC(2), PLTINC, YYOFF(2), SIZE, XMULT(2),
     *   DBY, COLV, COL(3), AX(5), AY(5), OLDSRC, RMAX, RMIN
      LOGICAL   T, F, GOOD, CATUP, DONEG, BLNKD, SCOLOR, DOCOLR
      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'
      INCLUDE 'INCS:DGPH.INC'
      INCLUDE 'INCS:DTVC.INC'
      SAVE XMULT, CSAVE, LTYPE, BUFFER
      DATA LUNPL /26/
      DATA DEPTH /5*1/
      DATA T, F /.TRUE.,.FALSE./
      DATA AUNITS /'Kelvin', 'Counts', 'Counts', 'Degrees', 'Seconds',
     *   'Gain', 'Kelvin', 'Kelvin'/
      DATA CHTYPE /'Psys', 'Power sum', 'Power diff', 'Gain phs',
     *   'Delay', 'Gain amp', 'Tsys', 'Tant'/
      DATA XUNITS /'IAT (hr)', 'Elevation (degrees)',
     *   'Hour Angle (hr)', 'LST (hr)', 'Parallactic angle',
     *   'Azimuth (degrees)' /
C-----------------------------------------------------------------------
      IF (ABS(APARM(8)-1.0).LT.0.1) AUNITS(1) = 'Ratio-1'
      IF (ABS(APARM(8)-1.0).LT.0.1) AUNITS(2) = 'Ratio-1'
C                                       Time system from AN table
      SCOLOR = (XDO3C.GT.1.5) .AND. (CSMAX-CSMIN.GT.0.99)
      OLDSRC = -1000.0
      XUNITS(1)(1:3) = TIMLAB(1:3)
      NGOOD = 0
      NNOFIT = 0
      IRET = 3
      CATUP = T
C
      JCODE = ICODES(KK)
C                                       Create plot file
      IF ((ABS (IPLOT).EQ.1) .AND. (DOLAB.LT.3)) THEN
C                                       Update catalog header.
         VER = 0
         IRET = 1
         IF (.NOT.DOTV) THEN
            CALL MADDEX ('PL', DISKIN, CNOIN, CATBLK, BUFFER, CATUP,
     *         'WRIT', VER, IERR)
            IF (IERR.NE.0) THEN
               NCFILE = NCFILE - 1
               GO TO 999
               END IF
            END IF
         CALL ZPHFIL ('PL', DISKIN, CNOIN, VER, PFILE, IERR)
         IF (IERR.NE.0) GO TO 960
         IPSIZE = 0
         ITYPE = 58
         CALL GINIT (DISKIN, CNOIN, PFILE, IPSIZE, ITYPE, NPARMS,
     *      XNAMEI, DOTV, TVCHN, GRCHN, TVCORN, CATBLK, BUFFER, LUNPL,
     *      FINDPL, IERR)
         IRET = 2
         IF (IERR.NE.0) GO TO 960
         END IF
C                                       Graph drawing parameters.
      BLC(1) = 0.0
      BLC(2) = 0.0
      TRC(1) = 1000.0
      TRC(2) = 1000.0
      IF (DOTV) THEN
         TRC(1) = WINDTV(3) - WINDTV(1)
         TRC(2) = WINDTV(4) - WINDTV(2)
         IF (DO3COL.LE.0.0) THEN
            CALL GCINIT (GPHTVG(4), 0, IERR)
            IF (IERR.NE.0) GO TO 960
            CALL GCINIT (GPHTVG(3), 0, IERR)
            IF (IERR.NE.0) GO TO 960
            CALL GCINIT (GPHTVG(2), 0, IERR)
            IF (IERR.NE.0) GO TO 960
            END IF
         END IF
      PLTINC = TRC(2) / NCOUNT
      IF (XYRATO.LT.0.01) XYRATO = 1.0
C                                       Set window for current plot.
      XBLC(1) = BLC(1)
      XBLC(2) = TRC(2) - ABS (IPLOT) * PLTINC
      XTRC(1) = TRC(1)
      XTRC(2) = XBLC(2) + PLTINC - 1.0
      TLC(1) = XBLC(1)
      TLC(2) = XTRC(2)
C                                       Offsets for current plot.
      YYOFF(1) = XBLC(1)
      YYOFF(2) = XBLC(2)
C                                       fool with location common
      LOCNUM = 1
      ROT(LOCNUM) = 0.0
      CORTYP(LOCNUM) = 0
      LABTYP(LOCNUM) = 7
      IF (XVAR.EQ.2) LABTYP(LOCNUM) = 0
      IF (XVAR.EQ.6) LABTYP(LOCNUM) = 0
      IF (XVAR.EQ.3) LABTYP(LOCNUM) = 8
      IF (XVAR.EQ.4) LABTYP(LOCNUM) = 9
      IF (XVAR.EQ.5) LABTYP(LOCNUM) = 0
      AXTYP(LOCNUM) = 0
      TR = 1.1 * (PRAN(2,2,KK)-PRAN(1,2,KK))
      IF (TR.LE.0.0) TR = 1.0
      IF ((ABS(IPLOT).EQ.1) .OR. (NCODES.GT.1)) THEN
         TI = TR
         CALL METSCL (LABEL, TR, CPREF(2,LOCNUM), GOOD)
         XMULT(2) = TR / TI
         CSAVE = CPREF(2,LOCNUM)
         END IF
      CPREF(1,LOCNUM) = ' '
      XMULT(1) = 1.0
      DO 50 I = 1,2
         SIZE = XTRC(I) - XBLC(I) + 1
         TR = PRAN(2,I,KK) - PRAN(1,I,KK)
         XYSCL(I,KK) = (XTRC(I) - XBLC(I)) / TR
         RPLOC(I,LOCNUM) = XBLC(I)
         RPVAL(I,LOCNUM) = XYOFF(I,KK) * XMULT(I)
         AXINC(I,LOCNUM) = TR * XMULT(I) / (XTRC(I) - XBLC(I))
 50      CONTINUE
      CTYP(1,LOCNUM) = XUNITS(XVAR)
      CTYP(2,LOCNUM) = AUNITS(JCODE)
C                                       Init plot calls again
C                                       Number of characters on each
C                                       side of the plot
      IF ((ABS (IPLOT).EQ.1) .AND. (DOLAB.LT.3)) THEN
         CALL RFILL (4, 0.5, CHOUT)
C                                       Not fully initialized, may make
C                                       INP too large which is okay.
         CALL CHNTIC (XBLC, XTRC, INP)
         INP = MAX (INP, 3)
         IF (NCODES.GT.1) INP = MAX (INP, 7)
         LTYPE = MOD (ABS (LABEL), 100)
         IF (LTYPE.EQ.2) CHOUT(1) = 2.5
         IF (LTYPE.GT.2) CHOUT(1) = INP + 4
         IF (LTYPE.GT.1) CHOUT(2) = 2.0
         IF (LTYPE.GT.2) CHOUT(2) = CHOUT(2) + 1.333
         IF ((LTYPE.GT.1) .AND. (LTYPE.LT.7)) CHOUT(4) = 4.666
         IF ((LABEL.GT.0) .AND. (LTYPE.GT.1) .AND. (LTYPE.LT.7))
     *      CHOUT(4) = CHOUT(4) + 1.333
C                                       Init for line drawing.
         CALL GINITL (BLC, TRC, XYRATO, CHOUT, DEPTH, BUFFER, IERR)
         IRET = 3
         IF (IERR.NE.0) GO TO 970
         IF (.NOT.DOTV) THEN
            WRITE (MSGTXT,1000) VER
            CALL MSGWRT (2)
            END IF
         END IF
      IRET = 3
      CATUP = T
C                                       Draw border
      ILITY = 1
      CALL GLTYPE (ILITY, BUFFER, IERR)
      IF (IERR.NE.0) GO TO 970
      IF (DOLAB.LT.3) THEN
         CALL GPOS (XBLC(1), XTRC(2), BUFFER, IERR)
         IF (IERR.NE.0) GO TO 970
         CALL GVEC (XBLC(1), XBLC(2), BUFFER, IERR)
         IF (IERR.NE.0) GO TO 970
         CALL GVEC (XTRC(1), XBLC(2), BUFFER, IERR)
         IF (IERR.NE.0) GO TO 970
         CALL GVEC (XTRC(1), XTRC(2), BUFFER, IERR)
         IF (IERR.NE.0) GO TO 970
         CALL GVEC (XBLC(1), XTRC(2), BUFFER, IERR)
         IF (IERR.NE.0) GO TO 970
C                                       Top labels: type & name
         IF ((ABS(IPLOT).EQ.1) .AND. (LTYPE.GT.1) .AND. (LTYPE.LT.7))
     *      THEN
            DX = 0.0
            DY = 0.5 + 2 * 1.333
C                                       The second line of the header
            CALL GPOS (BLC(1), TRC(2), BUFFER, IERR)
            IF (IERR.NE.0) GO TO 970
            INCHAR = 16
            INP = 1
            TEXT = CHTYPE(ICODES(1))
            CALL CHTRIM (TEXT, INCHAR, TEXT, INP)
            IF (ABS(APARM(8)-1.0).LT.0.1) THEN
               TEXT(INP+1:) = ' ratio'
               INP = INP + 6
               END IF
            TEXT(INP+1:) = ' and ' // CHTYPE(ICODES(2))
            INCHAR = 40
            CALL CHTRIM (TEXT, INCHAR, TEXT, INP)
            INP = INP + 1
            IF (XVAR.EQ.1) THEN
               TEXT(INP:INP+16) = ' vs '// TIMLAB(1:3) // ' time for '
               INP = INP + 17
            ELSE IF (XVAR.EQ.2) THEN
               TEXT(INP:INP+17) = ' vs elevation for '
               INP = INP + 18
            ELSE IF (XVAR.EQ.3) THEN
               TEXT(INP:INP+10) = ' vs HA for '
               INP = INP + 11
            ELSE IF (XVAR.EQ.4) THEN
               TEXT(INP:INP+16) = ' vs LST time for '
               INP = INP + 17
            ELSE IF (XVAR.EQ.5) THEN
               TEXT(INP:INP+17) = ' vs parallactic angle for '
               INP = INP + 26
            ELSE IF (XVAR.EQ.6) THEN
               TEXT(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), TEXT(INP:), INCHAR)
            CALL REFRMT (TEXT, ' ', INCHAR)
            CALL GCHAR (INCHAR, 0, DX, DY, TEXT, BUFFER, IERR)
            IF (IERR.NE.0) GO TO 970
C                                       the third line of header
            DY = 0.5
            CALL GPOS (BLC(1), TRC(2), BUFFER, IERR)
            IF (IERR.NE.0) GO TO 970
            INP = 1
            WRITE (TEXT(INP:),1010) SYTYPE, ITVER(1), 'SN', ITVER(2)
            INP = INP + 16
C                                       Stokes and IF
            IF (SUMSTK.GT.0) THEN
               TEXT(INP:) = XSTOK(:1) // 'pol_'
               INP = INP + 7
            ELSE
               TEXT(INP:) = 'Rpol & Lpol_'
               IF (ICOR0.LT.-4) TEXT(INP:) = 'Vpol & Hpol_'
               INP = INP + 14
               END IF
            IF (BIFS(1,1).EQ.EIFS(1,1)) THEN
               WRITE (TEXT(INP:),1021) SYTYPE, BIFS(1,1)
               INP = INP + 12
            ELSE
               WRITE (STEXT,1026) BIFS(1,1), EIFS(1,1)
               CALL REBLNK (STEXT, INCHAR)
               WRITE (TEXT(INP:),1022) SYTYPE, STEXT(:INCHAR)
               INP = INP + 9 + INCHAR
               END IF
            IF (BIFS(1,2).EQ.EIFS(1,2)) THEN
               WRITE (TEXT(INP:),1021) 'SN', BIFS(1,2)
               INP = INP + 12
            ELSE
               WRITE (STEXT,1026) BIFS(1,2), EIFS(1,2)
               CALL REBLNK (STEXT, INCHAR)
               WRITE (TEXT(INP:),1022) 'SN', STEXT(:INCHAR)
               INP = INP + 9 + INCHAR
               END IF
            CALL REFRMT (TEXT, '_', INCHAR)
             CALL GCHAR (INCHAR, 0, DX, DY, TEXT, BUFFER, IERR)
            IF (IERR.NE.0) GO TO 970
C                                       refant, baseline
            DY = 0.5 + 1.333
            CALL GPOS (BLC(1), TRC(2), BUFFER, IERR)
            IF (IERR.NE.0) GO TO 970
            INP = 9
            IF (REFANT.GT.0) THEN
               WRITE (TEXT,1025) REFANT
            ELSE
               TEXT = 'No refant'
               END IF
            IF (BIFS(2,1).LE.EIFS(2,1)) THEN
               TEXT(INP+1:) = '__SY Baseline IFs'
               INP = INP + 18
               WRITE (STEXT,1026) BIFS(2,1), EIFS(2,1)
               CALL REBLNK (STEXT, INCHAR)
               TEXT(INP+1:) = STEXT(:INCHAR)
               INP = INP + INCHAR
               IF (BIFS(3,1).LE.EIFS(3,1)) THEN
                  TEXT(INP+1:) = ' + '
                  INP = INP + 3
                  WRITE (STEXT,1026) BIFS(3,1), EIFS(3,1)
                  CALL REBLNK (STEXT, INCHAR)
                  TEXT(INP+1:) = STEXT(:INCHAR)
                  INP = INP + INCHAR
                  END IF
            ELSE
               TEXT(INP+1:) = '___No SY basline IFs'
               INP = INP + 20
               END IF
            IF (BIFS(2,2).LE.EIFS(2,2)) THEN
               TEXT(INP+1:) = '__SN Baseline IFs'
               INP = INP + 18
               WRITE (STEXT,1026) BIFS(2,2), EIFS(2,2)
               CALL REBLNK (STEXT, INCHAR)
               TEXT(INP+1:) = STEXT(:INCHAR)
               INP = INP + INCHAR
               IF (BIFS(3,2).LE.EIFS(3,2)) THEN
                  TEXT(INP+1:) = ' + '
                  INP = INP + 3
                  WRITE (STEXT,1026) BIFS(3,2), EIFS(3,2)
                  CALL REBLNK (STEXT, INCHAR)
                  TEXT(INP+1:) = STEXT(:INCHAR)
                  INP = INP + INCHAR
                  END IF
            ELSE
               TEXT(INP+1:) = '___No SN basline IFs'
               END IF
            CALL REFRMT (TEXT, '_', INCHAR)
            CALL GCHAR (INCHAR, 0, DX, DY, TEXT, BUFFER, IERR)
            IF (IERR.NE.0) GO TO 970
C                                       Date/time/version
            IF ((LABEL.GT.0) .AND. (LTYPE.GT.1)) THEN
               DY = 0.5 + 3 * 1.333
C                                       the first line of the header
               CALL GPOS (BLC(1), TRC(2), BUFFER, IERR)
               IF (IERR.NE.0) GO TO 970
               CALL ZDATE (ID)
               CALL ZTIME (IT)
               CALL TIMDAT (IT, ID, ATIME, ADATE)
               WRITE (TEXT,1030) VER, ADATE, ATIME
               CALL REFRMT (TEXT, '_', INCHAR)
               CALL GCHAR (INCHAR, 0, DX, DY, TEXT, BUFFER, IERR)
               IF (IERR.NE.0) GO TO 970
               END IF
            END IF
C                                       station ID
         CALL GPOS (XBLC(1), XTRC(2), BUFFER, IERR)
         IF (IERR.NE.0) GO TO 970
         DX =  1.5
         DY = -1.8
         WRITE (TEXT,1040) ANTNO
         INP = 4
         IF (MUMPOL.LE.1) THEN
            TEXT(INP:) = XSTOK(:1)
            INP = INP + 1
         ELSE
            IF (ICOR0.LT.-4) THEN
               TEXT(INP:) = 'V'
               IF (LST1.EQ.2) TEXT(INP:) = 'H'
            ELSE
               TEXT(INP:) = 'R'
               IF (LST1.EQ.2) TEXT(INP:) = 'L'
               END IF
            INP = INP + 1
            END IF
         TEXT(INP+1:) = STNNAM(ANTNO)
         CALL CHTRIM (TEXT, 132, TEXT, INCHAR)
         IF (SAMTYP.NE.' ') WRITE (TEXT(INCHAR+1:),1050)
     *      RVALUE(LST1,ANTNO)
         CALL REFRMT (TEXT, '_', INCHAR)
         IF ((LST1.NE.LST2) .AND. (DO3COL.GT.0.0) .AND. (DOLAB.EQ.2))
     *      THEN
            IF (COLORS(LST1,KK).NE.ILITY) THEN
               ILITY = COLORS(LST1,KK)
               CALL GLTYPE (ILITY, BUFFER, IERR)
               IF (IERR.NE.0) GO TO 970
               END IF
            END IF
         CALL GICHAR (1, INCHAR, 0, DX, DY, TEXT, BUFFER, IERR)
         IF (IERR.NE.0) GO TO 970
         IF (LST1.NE.LST2) THEN
            CALL GPOS (XBLC(1), XTRC(2), BUFFER, IERR)
            IF (IERR.NE.0) GO TO 970
            DX =  1.5
            DY = -3.25
            WRITE (TEXT,1040) ANTNO
            INP = 4
            IF (MUMPOL.LE.1) THEN
               TEXT(INP:) = XSTOK(:1)
               INP = INP + 1
            ELSE
               IF (ICOR0.LT.-4) THEN
                  TEXT(INP:) = 'H'
               ELSE
                  TEXT(INP:) = 'L'
                  END IF
               INP = INP + 1
               END IF
            TEXT(INP+1:) = STNNAM(ANTNO)
            CALL CHTRIM (TEXT, 132, TEXT, INCHAR)
            IF (SAMTYP.NE.' ') WRITE (TEXT(INCHAR+1:),1050)
     *         RVALUE(LST2,ANTNO)
            CALL REFRMT (TEXT, '_', INCHAR)
            IF ((DO3COL.GT.0.0) .AND. (DOLAB.EQ.2)) THEN
               IF (COLORS(LST2,KK).NE.ILITY) THEN
                  ILITY = COLORS(LST2,KK)
                  CALL GLTYPE (ILITY, BUFFER, IERR)
                  IF (IERR.NE.0) GO TO 970
                  END IF
               END IF
            CALL GICHAR (1, INCHAR, 0, DX, DY, TEXT, BUFFER, IERR)
            IF (IERR.NE.0) GO TO 970
            END IF
         END IF
C                                       type of plot
      IF (NCODES.GT.1) THEN
         IF (DO3COL.GT.0.0) THEN
            IF (DOLAB.EQ.2) THEN
               IF (1.NE.ILITY) THEN
                  ILITY = 1
                  CALL GLTYPE (ILITY, BUFFER, IERR)
                  IF (IERR.NE.0) GO TO 970
                  END IF
            ELSE IF (COLORS(LST1,KK).NE.ILITY) THEN
               ILITY = COLORS(LST1,KK)
               CALL GLTYPE (ILITY, BUFFER, IERR)
               IF (IERR.NE.0) GO TO 970
               END IF
            END IF
         TEXT = CHTYPE(JCODE)
         CALL CHTRIM (TEXT, INCHAR, TEXT, INP)
         CALL GPOS (XTRC(1), XTRC(2), BUFFER, IERR)
         IF (IERR.NE.0) GO TO 970
         DX = -INP - 3.0
         DY = -4.25
         IF (DOLAB.LT.3) DY = -2.8
         CALL REFRMT (TEXT, '_', INCHAR)
         CALL GICHAR (1, INCHAR, 0, DX, DY, TEXT, BUFFER, IERR)
         IF (IERR.NE.0) GO TO 970
         END IF
C                                       Set up location common
C                                       Blank bottom label.
      IF ((IPLOT.GE.0) .AND. (ABS (IPLOT).NE.NCOUNT)) THEN
         CPREF(1,LOCNUM) = ' '
         CTYP(1,LOCNUM) = ' '
         END IF
C                                       Only label Y axis once.
      IAXLAB = NCOUNT / 2 + 1
      IAPLOT = ABS (IPLOT)
      IF (NCODES.LE.1) THEN
         CPREF(2,LOCNUM) = CSAVE
         IF ((IAPLOT.NE.IAXLAB) .AND. ((IPLOT.GE.0) .OR.
     *      (IAPLOT.GT.IAXLAB))) CPREF(2,LOCNUM) = '-1'
         END IF
C                                       Put on labels and ticks
      IF (DOLAB.LT.3) THEN
         IF (1.NE.ILITY) THEN
            ILITY = 1
            CALL GLTYPE (ILITY, BUFFER, IERR)
            IF (IERR.NE.0) GO TO 970
            END IF
         CALL CLAB1 (XBLC, XTRC, CHOUT, LABEL, XYRATO, F, BUFFER, IERR)
         IF (IERR.NE.0) GO TO 970
         END IF
C                                       Size of symbol.
      DBY = 0.5 * FACTOR
C                                       Loop
      ILITY = 4
      CALL GLTYPE (ILITY, BUFFER, IERR)
      IF (IERR.NE.0) GO TO 970
      DOCOLR = SCOLOR
C                                       Outer loop: IF, stokes
      COLV = 0.0
      DO 190 IST = LST1,LST2
         IF (DO3COL.GT.0.0) THEN
            IF (COLORS(IST,KK).NE.ILITY) THEN
               ILITY = COLORS(IST,KK)
               CALL GLTYPE (ILITY, BUFFER, IERR)
               IF (IERR.NE.0) GO TO 970
               END IF
            END IF
         IP = IST + 2
C                                       Point plot
         DO 120 NN = 1,NUMPTS(ANTNO,KK)
            DONEG = (JCODE.EQ.4)
C                                       Scale X
            NNN = NN - 1 + FANREC(ANTNO,KK)
            XY(1) = PLTPTS(2,NNN)
            IF ((SWAP) .AND. (XY(1).GT.180.0)) XY(1) = XY(1) - 360.0
            IF ((XVAR.EQ.1) .OR. (XVAR.EQ.3) .OR. (XVAR.EQ.4))
     *         XY(1) = XY(1) * 360.0
            XY(1) = XYSCL(1,KK) * (XY(1) - XYOFF(1,KK)) + YYOFF(1)
            IF ((XY(1).LT.XBLC(1)) .OR. (XY(1).GT.XTRC(1))) THEN
               NNOFIT = NNOFIT + (LST2-LST1+1)
               GO TO 120
               END IF
C                                       source color
            IF ((SCOLOR) .AND. (ABS(PLTPTS(1,NNN)-OLDSRC).GT.0.1)) THEN
               COLV = 0.97 * (PLTPTS(1,NNN)-CSMIN) / (CSMAX-CSMIN)
               CALL COLOR3 (COLV, .FALSE., COL)
               CALL G3VCOL (COL(1), COL(2), COL(3), BUFFER, IERR)
               IF (IERR.NE.0) GO TO 970
               OLDSRC = PLTPTS(1,NNN)
               END IF
C                                       loop for points
            VALUE = PLTPTS(IP,NNN)
C                                       ?????????????????
            IF (VALUE.NE.FBLANK) THEN
 110           XY(2) = VALUE
               XY(2) = XYSCL(2,KK) * (XY(2) - XYOFF(2,KK)) + YYOFF(2)
               IF ((XY(2).LT.XBLC(2)) .OR. (XY(2).GT.XTRC(2))) THEN
                  IF (DONEG) THEN
                     IF (VALUE.LT.0.) THEN
                        VALUE = VALUE + 360. * ABS (BPARM(7))
                     ELSE
                        VALUE = VALUE - 360. * ABS (BPARM(7))
                        END IF
                     DONEG = .FALSE.
                     GO TO 110
                  ELSE
                     NNOFIT = NNOFIT + 1
                     END IF
               ELSE
                  NGOOD = NGOOD + 1
C                                       Mark point
                  DY = 5.0 * FACTOR
                  DX = 5.0 * FACTOR
                  IF (XYRATO.GT.1.0) THEN
                     DY = DY * XYRATO
                  ELSE
                     DX = DX / XYRATO
                     END IF
                  AX(1) = XY(1)
                  AY(1) = XY(2)
                  AX(2) = AX(1)
                  AX(3) = AX(1)
                  AX(4) = AX(1) - DX
                  AX(5) = AX(1) + DX
                  AY(2) = AY(1) + DY
                  AY(3) = AY(1) - DY
                  AY(4) = AY(1)
                  AY(5) = AY(1)
                  IF ((DO3COL.LE.0) .AND. (ILITY.NE.4)) THEN
                     ILITY = 4
                     CALL GLTYPE (ILITY, BUFFER, IERR)
                     IF (IERR.NE.0) GO TO 970
                     END IF
                  CALL PNTPLT (ISYM(IST), AX, AY, XBLC, XTRC, .FALSE.,
     *               DOCOLR, BUFFER, IERR)
                  IF (IERR.NE.0) GO TO 970
                  END IF
            ELSE IF (BSYM.GT.0) THEN
               DY = 5.0 * FACTOR
               DX = 5.0 * FACTOR
               IF (XYRATO.GT.1.0) THEN
                  DY = DY * XYRATO
               ELSE
                  DX = DX / XYRATO
                  END IF
               XY(2) = XBLC(2) + DY
               AX(1) = XY(1)
               AY(1) = XY(2)
               AX(2) = AX(1)
               AX(3) = AX(1)
               AX(4) = AX(1) - DX
               AX(5) = AX(1) + DX
               AY(2) = AY(1) + DY
               AY(3) = AY(1) - DY
               AY(4) = AY(1)
               AY(5) = AY(1)
               IF ((DO3COL.LE.0) .AND. (ILITY.NE.3)) THEN
                  ILITY = 2
                  CALL GLTYPE (ILITY, BUFFER, IERR)
                  IF (IERR.NE.0) GO TO 970
                  END IF
               CALL PNTPLT (BSYM, AX, AY, XBLC, XTRC, .FALSE.,
     *            DOCOLR, BUFFER, IERR)
               IF (IERR.NE.0) GO TO 970
               END IF
 120        CONTINUE
C                                       Line plot
         IF (DOLINE) THEN
            BLNKD = .TRUE.
            DO 140 NN = 1,NUMPTS(ANTNO,KK)
               DONEG = (JCODE.EQ.4)
C                                       Scale X
               NNN = NN - 1 + FANREC(ANTNO,KK)
               XY(1) = PLTPTS(2,NNN)
               IF ((XVAR.NE.2) .AND. (XVAR.NE.5) .AND. (XVAR.NE.6))
     *            XY(1) = XY(1) * 360.0
               XY(1) = XYSCL(1,KK) * (XY(1) - XYOFF(1,KK)) + YYOFF(1)
               IF ((XY(1).LT.XBLC(1)) .OR. (XY(1).GT.XTRC(1)))
     *            GO TO 140
C                                       loop for points
               VALUE = PLTPTS(IP,NNN)
               IF (VALUE.EQ.FBLANK) THEN
                  BLNKD = .TRUE.
               ELSE
 130              XY(2) = VALUE
                  XY(2) = XYSCL(2,KK) * (XY(2) - XYOFF(2,KK)) +
     *               YYOFF(2)
                  IF ((XY(2).LT.XBLC(2)) .OR. (XY(2).GT.XTRC(2)))
     *               THEN
                     IF (DONEG) THEN
                        IF (VALUE.LT.0.) THEN
                           VALUE = VALUE + 360. * ABS (BPARM(7))
                        ELSE
                           VALUE = VALUE - 360. * ABS (BPARM(7))
                           END IF
                        DONEG = .FALSE.
                        GO TO 130
                        END IF
                  ELSE
                     NGOOD = NGOOD + 1
C                                       Mark point
                     IF (BLNKD) THEN
                        CALL GPOS (XY(1), XY(2), BUFFER, IERR)
                        BLNKD = .FALSE.
                     ELSE IF (DOCOLR) THEN
                        CALL G3VEC (XY(1), XY(2), BUFFER, IERR)
                     ELSE
                        CALL GVEC (XY(1), XY(2), BUFFER, IERR)
                        END IF
                     IF (IERR.NE.0) GO TO 970
                     END IF
                  END IF
 140           CONTINUE
            END IF
C                                       plot scan boundaries
         IF ((XSCAN.GT.0.0) .AND. (NOSCAN.GT.0)) THEN
            WRITE (TXTMSG,1150) NOSCAN
            CALL GCOMNT (-1, TXTMSG, BUFFER, IERR)
            IF (IERR.NE.0) GO TO 970
            ILITY = 2
            CALL GLTYPE (ILITY, BUFFER, IERR)
            IF (IERR.NE.0) GO TO 970
            AY(1) = XYSCL(2,KK) * (PRAN(1,2,KK)-XYOFF(2,KK)) +
     *         YYOFF(2)
            AY(2) = XYSCL(2,KK) * (PRAN(2,2,KK)-XYOFF(2,KK)) +
     *         YYOFF(2)
            IF (XSCAN.GE.1.5) AY(2) = AY(1) + 0.1*(AY(2)-AY(1))
            DO 160 I = 1,NOSCAN
               AX(1) = XYSCL(1,KK) * (TSCAN(I)*360.-XYOFF(1,KK)) +
     *            YYOFF(1)
               IF ((AX(1).GE.XBLC(1)) .AND. (AX(1).LE.XTRC(1))) THEN
                  CALL GPOS (AX(1), AY(1), BUFFER, IERR)
                  IF (IERR.NE.0) GO TO 970
                  CALL GVEC (AX(1), AY(2), BUFFER, IERR)
                  IF (IERR.NE.0) GO TO 970
                  END IF
 160           CONTINUE
            END IF
 190     CONTINUE
C                                       Plot multiple R values
      IF ((KK.EQ.1) .AND. (XINC.GT.0) .AND. (ABSICA.LT.0)) THEN
         RMAX = -100.
         RMIN = 100.
         DO 220 IST = LST1,LST2
C                                       find max min
            DO 210 NN = 1,1000
               IF (RTS(IST,ANTNO,NN).NE.0.0) THEN
                  NR(IST) = NN
                  RMAX = MAX (RMAX, RVALS(IST,ANTNO,NN))
                  RMIN = MIN (RMIN, RVALS(IST,ANTNO,NN))
                  END IF
 210           CONTINUE
 220        CONTINUE
         DX = MAX (RMAX-RMIN, 0.1)
         RMAX = RMAX + 0.1*DX
         RMIN = RMIN - 0.1*DX
         TR = (XTRC(2)-XBLC(2)) / (RMAX - RMIN)
C                                       plot
         ILITY = 2
         CALL GLTYPE (ILITY, BUFFER, IERR)
         IF (IERR.NE.0) GO TO 970
         WRITE (MSGTXT,1220) LST1, LST2, ANTNO, RMIN, RMAX
         CALL MSGWRT (2)
         DO 290 IST = LST1,LST2
            BLNKD = .TRUE.
            DO 230 NN = 1,NR(IST)
               XY(1) = RTS(IST,ANTNO,NN) * 360.0
               XY(1) = XYSCL(1,KK) * (XY(1) - XYOFF(1,KK)) + YYOFF(1)
               IF ((XY(1).LT.XBLC(1)) .OR. (XY(1).GT.XTRC(1)))
     *            GO TO 230
               VALUE = RVALS(IST,ANTNO,NN)
               IF (VALUE.EQ.FBLANK) THEN
                  BLNKD = .TRUE.
               ELSE
                  XY(2) = VALUE
                  XY(2) = TR * (VALUE - RMIN) + YYOFF(2)
                  IF ((XY(2).GE.XBLC(2)) .AND. (XY(2).LE.XTRC(2))) THEN
                     IF (BLNKD) THEN
                        CALL GPOS (XY(1), XY(2), BUFFER, IERR)
                        BLNKD = .FALSE.
                     ELSE
                        CALL GVEC (XY(1), XY(2), BUFFER, IERR)
                        END IF
                     IF (IERR.NE.0) GO TO 970
                  ELSE
                     BLNKD = .TRUE.
                     END IF
                  END IF
 230           CONTINUE
            DO 240 NN = 1,NR(IST)
               XY(1) = RTS(IST,ANTNO,NN) * 360.0
               XY(1) = XYSCL(1,KK) * (XY(1) - XYOFF(1,KK)) + YYOFF(1)
               IF ((XY(1).LT.XBLC(1)) .OR. (XY(1).GT.XTRC(1)))
     *            GO TO 240
               VALUE = RVALS(IST,ANTNO,NN)
               IF (VALUE.NE.FBLANK) THEN
                  XY(2) = TR * (VALUE - RMIN) + YYOFF(2)
                  IF ((XY(2).GE.XBLC(2)) .AND. (XY(2).LE.XTRC(2))) THEN
C                                       Mark point
                     DY = 5.0 * FACTOR
                     DX = 5.0 * FACTOR
                     IF (XYRATO.GT.1.0) THEN
                        DY = DY * XYRATO
                     ELSE
                        DX = DX / XYRATO
                        END IF
                     AX(1) = XY(1)
                     AY(1) = XY(2)
                     AX(2) = AX(1)
                     AX(3) = AX(1)
                     AX(4) = AX(1) - DX
                     AX(5) = AX(1) + DX
                     AY(2) = AY(1) + DY
                     AY(3) = AY(1) - DY
                     AY(4) = AY(1)
                     AY(5) = AY(1)
                     CALL PNTPLT (3, AX, AY, XBLC, XTRC, .FALSE.,
     *                  .FALSE., BUFFER, IERR)
                     END IF
                  END IF
 240           CONTINUE
 290        CONTINUE
         END IF
C                                       Done: finish plot
      WRITE (MSGTXT,1200) NGOOD
      CALL MSGWRT (2)
      IF (NNOFIT.GE.1) THEN
         WRITE (MSGTXT,1202) NNOFIT
         CALL MSGWRT (2)
         END IF
      IF ((IPLOT.LT.0) .OR. ((ABS(IPLOT).GE.NCOUNT) .AND. (DOLAB.GT.1)))
     *   THEN
         GPHPAG = IPLOT.GT.0
         CALL GFINIS (BUFFER, IERR)
         IF (IERR.GT.0) GO TO 975
         IF (.NOT.DOTV) THEN
            CALL HIPLOT (DISKIN, CNOIN, VER, BUFFER, IERR)
            IERR = 0
            END IF
         END IF
      IF (IERR.GT.0) GO TO 975
         IRET = IERR
         GO TO 999
C                                       ZPHFIL or GINIT failure.
 960  WRITE (MSGTXT,1960)
      CALL MSGWRT (8)
      IF (.NOT.DOTV) THEN
         CALL DELEXT ('PL', DISKIN, CNOIN, 'WRIT', CATBLK, BUFFER,
     *      VER, IERR)
         NCFILE = NCFILE - 1
         END IF
      GO TO 999
C                                       Try to finish partial graph
 970  WRITE (MSGTXT,1970)
      CALL MSGWRT (6)
      WRITE (MSGTXT,1200) NGOOD
      CALL MSGWRT (2)
      IF (NNOFIT.GE.1) THEN
         WRITE (MSGTXT,1202) NNOFIT
         CALL MSGWRT (2)
         END IF
      GPHPAG = IPLOT.GT.0
      CALL GFINIS (BUFFER, IERR)
      IF (IERR.NE.0) GO TO 975
         IF (.NOT.DOTV) THEN
            CALL HIPLOT (DISKIN, CNOIN, VER, BUFFER, IERR)
            IERR = 0
            END IF
         GO TO 999
C                                       Destroy the plot file
 975  IF (.NOT.DOTV) THEN
         CALL ZCLOSE (LUNPL, FINDPL, IERR)
         CALL ZDESTR (DISKIN, PFILE, IERR)
         CALL DELEXT ('PL', DISKIN, CNOIN, 'WRIT', CATBLK, BUFFER,
     *      VER, IERR)
         NCFILE = NCFILE - 1
         END IF
C
 999  RETURN
C-----------------------------------------------------------------------
 1000 FORMAT ('Plot file version',I4,'  created.')
 1010 FORMAT (A2,I4,'__',A2,I4,'_')
 1021 FORMAT ('___',A2,' IF ',I2)
 1022 FORMAT ('___',A2,' IF ',A)
 1025 FORMAT ('Refant',I3)
 1026 FORMAT (I3,' - ',I2)
 1030 FORMAT ('Plot file version',I4,'__created ',A, A)
 1040 FORMAT (I3)
 1050 FORMAT (' _R=',F6.3)
 1150 FORMAT ('Plotting',I4,' scan breaks')
 1200 FORMAT ('PLTSN:',I9,' points plotted')
 1202 FORMAT ('PLTSN:',I9,' points did not fit')
 1220 FORMAT ('Corr coeff: stokes',2I2,' ant',I4,' range',2F7.3)
 1960 FORMAT ('PLTSN: ERROR DURING GRAPH FILE CREATION')
 1970 FORMAT ('PLTSN: ERROR DURING GRAPHING. WILL TRY TO FINISH ',
     *   'PARTIAL GRAPH')
      END
      SUBROUTINE PLTSY (NV, ANTNO, IST, RV, SYPTS, SNPTS, IRET)
C-----------------------------------------------------------------------
C   PLTSY actually plots data.
C   Input:
C      NV       I      Number values
C      ANTNO    I      Antenna number
C      IST      I      Stokes
C      RV       R      Correlation coeff
C      SYPTS    R(*)   SY Data to plot (NV,*)
C      SnPTS    R(*)   Sn Data to plot (NV,*)
C   Output:
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   NV, ANTNO, IST, IRET
      REAL      RV, SYPTS(NV), SNPTS(NV)
C
      INCLUDE 'SYVSN.INC'
C
      CHARACTER TEXT*132, PFILE*48, ATIME*8, ADATE*12, CHTMP*18,
     *   AUNITS(NCODE)*8, CHTYPE(NCODE)*16, STEXT*16
      INTEGER   BUFFER(256), VER, IERR, ITYPE, IPSIZE, LUNPL, LTYPE,
     *   FINDPL, DEPTH(5), INCHAR, INP, IT(3), ID(3), I, NGOOD, NNOFIT,
     *   NN, IP, ILITY, IPLOT
      REAL      BLC(2), TRC(2), DX, DY, TR, TI, XY(2), XTRC(2), XBLC(2),
     *   TLC(2), PLTINC, YYOFF(2), SIZE, XMULT(2), DBY, COLV, AX(5),
     *   AY(5)
      LOGICAL   T, F, GOOD, CATUP, SCOLOR, DOCOLR
      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'
      INCLUDE 'INCS:DGPH.INC'
      INCLUDE 'INCS:DTVC.INC'
      SAVE XMULT, LTYPE, BUFFER
      DATA LUNPL /26/
      DATA DEPTH /5*1/
      DATA T, F /.TRUE.,.FALSE./
      DATA AUNITS /'Kelvin', 'Counts', 'Counts', 'Degrees', 'Seconds',
     *   'Gain', 'Kelvin', 'Kelvin'/
      DATA CHTYPE /'Psys', 'Power sum', 'Power diff', 'Gain phs',
     *   'Delay', 'Gain amp', 'Tsys', 'Tant'/
C-----------------------------------------------------------------------
      IPLOT = 1
      IF (ABS(APARM(8)-1.0).LT.0.1) AUNITS(1) = 'Ratio-1'
      IF (ABS(APARM(8)-1.0).LT.0.1) AUNITS(2) = 'Ratio-1'
      IF (ABS(APARM(8)-1.0).LT.0.1) AUNITS(3) = 'Ratio-1'
      NGOOD = 0
      NNOFIT = 0
      IRET = 3
      CATUP = T
      NCODES = 2
C                                       get the scales
      CALL SCALIT (NV, SYPTS, SNPTS)
C                                       Create plot file
C                                       Update catalog header.
      VER = 0
      IRET = 1
      IF (.NOT.DOTV) THEN
         CALL MADDEX ('PL', DISKIN, CNOIN, CATBLK, BUFFER, CATUP,
     *      'WRIT', VER, IERR)
         IF (IERR.NE.0) THEN
            NCFILE = NCFILE - 1
            GO TO 999
            END IF
         END IF
      CALL ZPHFIL ('PL', DISKIN, CNOIN, VER, PFILE, IERR)
      IF (IERR.NE.0) GO TO 960
      IPSIZE = 0
      ITYPE = 58
      CALL GINIT (DISKIN, CNOIN, PFILE, IPSIZE, ITYPE, NPARMS,
     *   XNAMEI, DOTV, TVCHN, GRCHN, TVCORN, CATBLK, BUFFER, LUNPL,
     *   FINDPL, IERR)
      IRET = 2
      IF (IERR.NE.0) GO TO 960
C                                       Graph drawing parameters.
      BLC(1) = 0.0
      BLC(2) = 0.0
      TRC(1) = 1000.0
      TRC(2) = 1000.0
      IF (DOTV) THEN
         TRC(1) = WINDTV(3) - WINDTV(1)
         TRC(2) = WINDTV(4) - WINDTV(2)
         CALL GCINIT (GPHTVG(4), 0, IERR)
         IF (IERR.NE.0) GO TO 960
         CALL GCINIT (GPHTVG(3), 0, IERR)
         IF (IERR.NE.0) GO TO 960
         CALL GCINIT (GPHTVG(2), 0, IERR)
         IF (IERR.NE.0) GO TO 960
         END IF
      PLTINC = TRC(2)
      IF (XYRATO.LT.0.01) XYRATO = 1.0
C                                       Set window for current plot.
      XBLC(1) = BLC(1)
      XBLC(2) = BLC(2)
      XTRC(1) = TRC(1)
      XTRC(2) = TRC(2)
      TLC(1) = XBLC(1)
      TLC(2) = XTRC(2)
C                                       Offsets for current plot.
      YYOFF(1) = XBLC(1)
      YYOFF(2) = XBLC(2)
C                                       fool with location common
      LOCNUM = 1
      ROT(LOCNUM) = 0.0
      CORTYP(LOCNUM) = 0
      LABTYP(LOCNUM) = 0
      AXTYP(LOCNUM) = 0
      TR = 1.1 * (PRAN(2,2,1)-PRAN(1,2,1))
      IF (TR.LE.0.0) TR = 1.0
      TI = TR
      CALL METSCL (LABEL, TR, CPREF(1,LOCNUM), GOOD)
      XMULT(1) = TR / TI
      TR = 1.1 * (PRAN(2,2,2)-PRAN(1,2,2))
      IF (TR.LE.0.0) TR = 1.0
      TI = TR
      CALL METSCL (LABEL, TR, CPREF(2,LOCNUM), GOOD)
      XMULT(2) = TR / TI
      DO 50 I = 1,2
         SIZE = XTRC(I) - XBLC(I) + 1
         TR = PRAN(2,2,I) - PRAN(1,2,I)
         XYSCL(2,I) = (XTRC(I) - XBLC(I)) / TR
         RPLOC(I,LOCNUM) = XBLC(I)
         RPVAL(I,LOCNUM) = XYOFF(2,I) * XMULT(I)
         AXINC(I,LOCNUM) = TR * XMULT(I) / (XTRC(I) - XBLC(I))
 50      CONTINUE
      CTYP(1,LOCNUM) = AUNITS(ICODES(1))
      CTYP(2,LOCNUM) = AUNITS(ICODES(2))
C                                       Init plot calls again
C                                       Number of characters on each
C                                       side of the plot
      CALL RFILL (4, 0.5, CHOUT)
C                                       Not fully initialized, may make
C                                       INP too large which is okay.
      CALL CHNTIC (XBLC, XTRC, INP)
      INP = MAX (INP, 3)
      INP = MAX (INP, 7)
      LTYPE = MOD (ABS (LABEL), 100)
      IF (LTYPE.EQ.2) CHOUT(1) = 2.5
      IF (LTYPE.GT.2) CHOUT(1) = INP + 4
      IF (LTYPE.GT.1) CHOUT(2) = 2.0
      IF (LTYPE.GT.2) CHOUT(2) = CHOUT(2) + 1.333
      IF ((LTYPE.GT.1) .AND. (LTYPE.LT.7)) CHOUT(4) = 4.666
      IF ((LABEL.GT.0) .AND. (LTYPE.GT.1) .AND. (LTYPE.LT.7))
     *   CHOUT(4) = CHOUT(4) + 1.333
C                                       Init for line drawing.
      CALL GINITL (BLC, TRC, XYRATO, CHOUT, DEPTH, BUFFER, IERR)
      IRET = 3
      IF (IERR.NE.0) GO TO 970
      IF (.NOT.DOTV) THEN
         WRITE (MSGTXT,1000) VER
         CALL MSGWRT (2)
         END IF
      IRET = 3
      CATUP = T
C                                       Draw border
      ILITY = 1
      CALL GLTYPE (ILITY, BUFFER, IERR)
      IF (IERR.NE.0) GO TO 970
      CALL GPOS (XBLC(1), XTRC(2), BUFFER, IERR)
      IF (IERR.NE.0) GO TO 970
      CALL GVEC (XBLC(1), XBLC(2), BUFFER, IERR)
      IF (IERR.NE.0) GO TO 970
      CALL GVEC (XTRC(1), XBLC(2), BUFFER, IERR)
      IF (IERR.NE.0) GO TO 970
      CALL GVEC (XTRC(1), XTRC(2), BUFFER, IERR)
      IF (IERR.NE.0) GO TO 970
      CALL GVEC (XBLC(1), XTRC(2), BUFFER, IERR)
      IF (IERR.NE.0) GO TO 970
C                                       Top labels: type & name
      IF ((LTYPE.GT.1) .AND. (LTYPE.LT.7)) THEN
         DX = 0.0
         DY = 0.5 + 2 * 1.333
C                                       The second line of the header
         CALL GPOS (BLC(1), TRC(2), BUFFER, IERR)
         IF (IERR.NE.0) GO TO 970
         INCHAR = 16
         INP = 1
         TEXT = CHTYPE(ICODES(1))
         CALL CHTRIM (TEXT, INCHAR, TEXT, INP)
         IF (ABS(APARM(8)-1.0).LT.0.1) THEN
            TEXT(INP+1:) = ' ratio'
            INP = INP + 6
            END IF
         TEXT(INP+1:) = ' vs ' // CHTYPE(ICODES(2))
         INCHAR = 40
         CALL CHTRIM (TEXT, INCHAR, TEXT, INP)
         INP = INP + 1
C                                       File name
         CALL H2CHR (18, KHIMNO, CATH(KHIMN), CHTMP)
         CALL H2CHR (6, KHIMCO, CATH(KHIMC), CHTMP(13:18))
         CALL NAMEST (CHTMP, CATBLK(KIIMS), TEXT(INP:), INCHAR)
         CALL REFRMT (TEXT, ' ', INCHAR)
         CALL GCHAR (INCHAR, 0, DX, DY, TEXT, BUFFER, IERR)
         IF (IERR.NE.0) GO TO 970
C                                       the third line of header
         DY = 0.5
         CALL GPOS (BLC(1), TRC(2), BUFFER, IERR)
         IF (IERR.NE.0) GO TO 970
         INP = 1
         WRITE (TEXT(INP:),1010) SYTYPE, ITVER(1), 'SN', ITVER(2)
         INP = INP + 16
C                                       Stokes and IF
         IF (SUMSTK.GT.0) THEN
            TEXT(INP:) = XSTOK(:1) // 'pol_'
            INP = INP + 7
         ELSE
            TEXT(INP:) = 'Rpol & Lpol_'
            IF (ICOR0.LT.-4) TEXT(INP:) = 'Vpol & Hpol_'
            INP = INP + 14
            END IF
         IF (BIFS(1,1).EQ.EIFS(1,1)) THEN
            WRITE (TEXT(INP:),1021) SYTYPE, BIFS(1,1)
            INP = INP + 12
         ELSE
            WRITE (STEXT,1026) BIFS(1,1), EIFS(1,1)
            CALL REBLNK (STEXT, INCHAR)
            WRITE (TEXT(INP:),1022) SYTYPE, STEXT(:INCHAR)
            INP = INP + 9 + INCHAR
            END IF
         IF (BIFS(1,2).EQ.EIFS(1,2)) THEN
            WRITE (TEXT(INP:),1021) 'SN', BIFS(1,2)
            INP = INP + 12
         ELSE
            WRITE (STEXT,1026) BIFS(1,2), EIFS(1,2)
            CALL REBLNK (STEXT, INCHAR)
            WRITE (TEXT(INP:),1022) 'SN', STEXT(:INCHAR)
            INP = INP + 9 + INCHAR
            END IF
         CALL REFRMT (TEXT, '_', INCHAR)
         CALL GCHAR (INCHAR, 0, DX, DY, TEXT, BUFFER, IERR)
         IF (IERR.NE.0) GO TO 970
C                                       refant, baseline
         DY = 0.5 + 1.333
         CALL GPOS (BLC(1), TRC(2), BUFFER, IERR)
         IF (IERR.NE.0) GO TO 970
         INP = 9
         IF (REFANT.GT.0) THEN
            WRITE (TEXT,1025) REFANT
         ELSE
            TEXT = 'No refant'
            END IF
         IF (BIFS(2,1).LE.EIFS(2,1)) THEN
            TEXT(INP+1:) = '__SY Baseline IFs'
            INP = INP + 18
            WRITE (STEXT,1026) BIFS(2,1), EIFS(2,1)
            CALL REBLNK (STEXT, INCHAR)
            TEXT(INP+1:) = STEXT(:INCHAR)
            INP = INP + INCHAR
            IF (BIFS(3,1).LE.EIFS(3,1)) THEN
               TEXT(INP+1:) = ' + '
               INP = INP + 3
               WRITE (STEXT,1026) BIFS(3,1), EIFS(3,1)
               CALL REBLNK (STEXT, INCHAR)
               TEXT(INP+1:) = STEXT(:INCHAR)
               INP = INP + INCHAR
               END IF
         ELSE
            TEXT(INP+1:) = '___No SY basline IFs'
            INP = INP + 20
            END IF
         IF (BIFS(2,2).LE.EIFS(2,2)) THEN
            TEXT(INP+1:) = '__SN Baseline IFs'
            INP = INP + 18
            WRITE (STEXT,1026) BIFS(2,2), EIFS(2,2)
            CALL REBLNK (STEXT, INCHAR)
            TEXT(INP+1:) = STEXT(:INCHAR)
            INP = INP + INCHAR
            IF (BIFS(3,2).LE.EIFS(3,2)) THEN
               TEXT(INP+1:) = ' + '
               INP = INP + 3
               WRITE (STEXT,1026) BIFS(3,2), EIFS(3,2)
               CALL REBLNK (STEXT, INCHAR)
               TEXT(INP+1:) = STEXT(:INCHAR)
               INP = INP + INCHAR
               END IF
         ELSE
            TEXT(INP+1:) = '___No SN basline IFs'
            END IF
         CALL REFRMT (TEXT, '_', INCHAR)
         CALL GCHAR (INCHAR, 0, DX, DY, TEXT, BUFFER, IERR)
         IF (IERR.NE.0) GO TO 970
C                                       Date/time/version
         IF ((LABEL.GT.0) .AND. (LTYPE.GT.1)) THEN
            DY = 0.5 + 3 * 1.333
C                                       the first line of the header
            CALL GPOS (BLC(1), TRC(2), BUFFER, IERR)
            IF (IERR.NE.0) GO TO 970
            CALL ZDATE (ID)
            CALL ZTIME (IT)
            CALL TIMDAT (IT, ID, ATIME, ADATE)
            WRITE (TEXT,1030) VER, ADATE, ATIME
            CALL REFRMT (TEXT, '_', INCHAR)
            CALL GCHAR (INCHAR, 0, DX, DY, TEXT, BUFFER, IERR)
            IF (IERR.NE.0) GO TO 970
            END IF
C                                       station ID
         CALL GPOS (XBLC(1), XTRC(2), BUFFER, IERR)
         IF (IERR.NE.0) GO TO 970
         DX =  1.5
         DY = -1.8
         WRITE (TEXT,1040) ANTNO
         INP = 4
         IF (MUMPOL.LE.1) THEN
            TEXT(INP:) = XSTOK(:1)
            INP = INP + 1
         ELSE
            IF (ICOR0.LT.-4) THEN
               TEXT(INP:) = 'V'
               IF (IST.EQ.2) TEXT(INP:) = 'H'
            ELSE
               TEXT(INP:) = 'R'
               IF (IST.EQ.2) TEXT(INP:) = 'L'
               END IF
            INP = INP + 1
            END IF
         TEXT(INP+1:) = STNNAM(ANTNO)
         CALL CHTRIM (TEXT, 132, TEXT, INCHAR)
         IF (SAMTYP.NE.' ') WRITE (TEXT(INCHAR+1:),1050) RV
         CALL REFRMT (TEXT, '_', INCHAR)
         CALL GICHAR (1, INCHAR, 0, DX, DY, TEXT, BUFFER, IERR)
         IF (IERR.NE.0) GO TO 970
         END IF
C                                       Put on labels and ticks
      IF (1.NE.ILITY) THEN
         ILITY = 1
         CALL GLTYPE (ILITY, BUFFER, IERR)
         IF (IERR.NE.0) GO TO 970
         END IF
      CALL CLAB1 (XBLC, XTRC, CHOUT, LABEL, XYRATO, F, BUFFER, IERR)
      IF (IERR.NE.0) GO TO 970
C                                       Size of symbol.
      DBY = 0.5 * FACTOR
C                                       Loop
      ILITY = 4
      CALL GLTYPE (ILITY, BUFFER, IERR)
      IF (IERR.NE.0) GO TO 970
      DOCOLR = SCOLOR
C                                       Outer loop: IF, stokes
      COLV = 0.0
      IP = IST + 2
C                                       Point plot
      DO 120 NN = 1,NV
C                                       Scale X
         IF ((SNPTS(NN).NE.FBLANK) .AND. (SYPTS(NN).NE.FBLANK)) THEN
            XY(1) = SYPTS(NN)
            XY(1) = XYSCL(2,1) * (XY(1) - XYOFF(2,1)) + YYOFF(1)
            IF ((XY(1).LT.XBLC(1)) .OR. (XY(1).GT.XTRC(1))) THEN
               NNOFIT = NNOFIT + 1
               GO TO 120
               END IF
C                                       loop for points
            XY(2) = SNPTS(NN)
            XY(2) = XYSCL(2,2) * (XY(2) - XYOFF(2,2)) + YYOFF(2)
            IF ((XY(2).LT.XBLC(2)) .OR. (XY(2).GT.XTRC(2))) THEN
               NNOFIT = NNOFIT + 1
            ELSE
               NGOOD = NGOOD + 1
C                                       Mark point
               DY = 5.0 * FACTOR
               DX = 5.0 * FACTOR
               IF (XYRATO.GT.1.0) THEN
                  DY = DY * XYRATO
               ELSE
                  DX = DX / XYRATO
                  END IF
               AX(1) = XY(1)
               AY(1) = XY(2)
               AX(2) = AX(1)
               AX(3) = AX(1)
               AX(4) = AX(1) - DX
               AX(5) = AX(1) + DX
               AY(2) = AY(1) + DY
               AY(3) = AY(1) - DY
               AY(4) = AY(1)
               AY(5) = AY(1)
               IF (ILITY.NE.4) THEN
                  ILITY = 4
                  CALL GLTYPE (ILITY, BUFFER, IERR)
                  IF (IERR.NE.0) GO TO 970
                  END IF
               CALL PNTPLT (ISYM(IST), AX, AY, XBLC, XTRC, .FALSE.,
     *            DOCOLR, BUFFER, IERR)
               IF (IERR.NE.0) GO TO 970
               END IF
         ELSE IF (BSYM.GT.0) THEN
            DY = 5.0 * FACTOR
            DX = 5.0 * FACTOR
            IF (XYRATO.GT.1.0) THEN
               DY = DY * XYRATO
            ELSE
               DX = DX / XYRATO
               END IF
            XY(2) = XBLC(2) + DY
            AX(1) = XY(1)
            AY(1) = XY(2)
            AX(2) = AX(1)
            AX(3) = AX(1)
            AX(4) = AX(1) - DX
            AX(5) = AX(1) + DX
            AY(2) = AY(1) + DY
            AY(3) = AY(1) - DY
            AY(4) = AY(1)
            AY(5) = AY(1)
            IF (ILITY.NE.3) THEN
               ILITY = 3
               CALL GLTYPE (ILITY, BUFFER, IERR)
               IF (IERR.NE.0) GO TO 970
               END IF
            CALL PNTPLT (BSYM, AX, AY, XBLC, XTRC, .FALSE.,
     *         DOCOLR, BUFFER, IERR)
            IF (IERR.NE.0) GO TO 970
            END IF
 120     CONTINUE
C                                       Done: finish plot
      WRITE (MSGTXT,1200) NGOOD
      CALL MSGWRT (2)
      IF (NNOFIT.GE.1) THEN
         WRITE (MSGTXT,1202) NNOFIT
         CALL MSGWRT (2)
         END IF
      GPHPAG = .TRUE.
      CALL GFINIS (BUFFER, IERR)
      IF (IERR.GT.0) GO TO 975
      IF (.NOT.DOTV) THEN
         CALL HIPLOT (DISKIN, CNOIN, VER, BUFFER, IERR)
         IERR = 0
         END IF
      IF (IERR.GT.0) GO TO 975
         IRET = IERR
         GO TO 999
C                                       ZPHFIL or GINIT failure.
 960  WRITE (MSGTXT,1960)
      CALL MSGWRT (8)
      IF (.NOT.DOTV) THEN
         CALL DELEXT ('PL', DISKIN, CNOIN, 'WRIT', CATBLK, BUFFER,
     *      VER, IERR)
         NCFILE = NCFILE - 1
         END IF
      GO TO 999
C                                       Try to finish partial graph
 970  WRITE (MSGTXT,1970)
      CALL MSGWRT (6)
      WRITE (MSGTXT,1200) NGOOD
      CALL MSGWRT (2)
      IF (NNOFIT.GE.1) THEN
         WRITE (MSGTXT,1202) NNOFIT
         CALL MSGWRT (2)
         END IF
      GPHPAG = .TRUE.
      CALL GFINIS (BUFFER, IERR)
      IF (IERR.NE.0) GO TO 975
         IF (.NOT.DOTV) THEN
            CALL HIPLOT (DISKIN, CNOIN, VER, BUFFER, IERR)
            IERR = 0
            END IF
         GO TO 999
C                                       Destroy the plot file
 975  IF (.NOT.DOTV) THEN
         CALL ZCLOSE (LUNPL, FINDPL, IERR)
         CALL ZDESTR (DISKIN, PFILE, IERR)
         CALL DELEXT ('PL', DISKIN, CNOIN, 'WRIT', CATBLK, BUFFER,
     *      VER, IERR)
         NCFILE = NCFILE - 1
         END IF
C
 999  RETURN
C-----------------------------------------------------------------------
 1000 FORMAT ('Plot file version',I4,'  created.')
 1010 FORMAT (A2,I4,'__',A2,I4,'_')
 1021 FORMAT ('___',A2,' IF ',I2)
 1022 FORMAT ('___',A2,' IF ',A)
 1025 FORMAT ('Refant',I3)
 1026 FORMAT (I3,' - ',I2)
 1030 FORMAT ('Plot file version',I4,'__created ',A, A)
 1040 FORMAT (I3)
 1050 FORMAT (' _R=',F6.3)
 1200 FORMAT ('PLTSY:',I9,' points plotted')
 1202 FORMAT ('PLTSY:',I9,' points did not fit')
 1960 FORMAT ('PLTSY: ERROR DURING GRAPH FILE CREATION')
 1970 FORMAT ('PLTSY: ERROR DURING GRAPHING. WILL TRY TO FINISH ',
     *   'PARTIAL GRAPH')
      END
      SUBROUTINE SCALIT (NV, SYPTS, SNPTS)
C-----------------------------------------------------------------------
C   Finds scales for SN vs SY plot
C   Inputs:
C      NV      I      Number samples
C      SYPTS   R(*)   SY data on regular grid
C      SNPTS   R(*)   SN data on same regular grid
C   Outputs in COMMON
C      XYOFF   R(2,*)   TMIN: (2,1) SY (2,2) SN
C      XYSCL   R(2,*)   1000/(tmax-tmin) as above
C      PRAN    R(2,2,*)   (1,2,1) SY TMIN (1,2,2) SN TMIN (2,2,1) SYTMAX
C-----------------------------------------------------------------------
      INTEGER   NV
      REAL      SYPTS(*), SNPTS(*)
C
      INCLUDE 'SYVSN.INC'
      INTEGER   I, KK
      REAL      YMX, YMN, PMX, PMN, TMAX, TMIN, TDIF, XXMX, XXMN, PH,
     *   TOLER(8)
      INCLUDE 'INCS:DDCH.INC'
C                                       Minimum value range for each
C                                       ICODE
C                  Psum  Psys  Pdif   Phs    Delay    Amp     Tsys
      DATA TOLER /0.001, 0.01, 0.001, 0.001, 1.0E-12, 0.001, 0.001,
C        Tant
     *   0.000001/
C-----------------------------------------------------------------------
      YMX = -1.E8
      YMN = -YMX
      PMX = YMX
      PMN = YMN
      XXMX = YMX
      XXMN = YMN
      DO 20 I = 1,NV
         IF ((SYPTS(I).NE.FBLANK) .AND. (SNPTS(I).NE.FBLANK)) THEN
            XXMX = MAX (XXMX, SYPTS(I))
            XXMN = MIN (XXMN, SYPTS(I))
            YMX = MAX (YMX, SNPTS(I))
            YMN = MIN (YMN, SNPTS(I))
            IF (ICODES(2).EQ.4) THEN
               PH = SNPTS(I)
               IF (PH.LT.0.0) PH = PH + 360.0
               PMX = MAX (PMX, PH)
               PMN = MIN (PMN, PH)
               END IF
            END IF
 20      CONTINUE
C                                       phase 0 -> 360 ??
      IF ((ICODES(2).EQ.4) .AND. (PMX-PMN.LT.YMX-YMN)) THEN
         YMX = PMX
         YMN = PMN
         DO 25 I = 1,NV
            IF (SNPTS(I).LT.0.0) SNPTS(I) = SNPTS(I) + 360.0
 25         CONTINUE
         END IF
      KK = 1
      TMAX = XXMX + 0.05 * (XXMX - XXMN)
      TMIN = XXMN - 0.05 * (XXMX - XXMN)
      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,KK) = TMIN
      XYSCL(2,KK) = 1000.0 / TDIF
      PRAN(1,2,KK) = TMIN
      PRAN(2,2,KK) = TMAX
      KK = 2
      TMAX = YMX + 0.05 * (YMX - YMN)
      TMIN = YMN - 0.05 * (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,KK) = TMIN
      XYSCL(2,KK) = 1000.0 / TDIF
      PRAN(1,2,KK) = TMIN
      PRAN(2,2,KK) = TMAX
C
 999  RETURN
      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 'SYVSN.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. (TIME.GT.LTIME)) 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
            END IF
         END IF
C
 999  RETURN
      END
