LOCAL INCLUDE 'TEPLT.INC'
      INTEGER   NCODE
      PARAMETER (NCODE=16)
C                                       Local include for TEPLT
      INCLUDE 'INCS:PUVD.INC'
C                                       Input parameters
      REAL      XSIN, XDISIN, XNVER, XNVER2, XQUAL, XTIME(8), XANT(50),
     *   PIXR(2), XNCOU, XXINC, APARM(10), BPARM(10), CPARM(10), XDO3C,
     *   XSYM, FACTOR, XSCAN, XLABEL, XDOTV, XGRCH, XYRATO
      HOLLERITH XNAMEI(3), XCLAIN(2), XXSOUR(4,30), XOPTY(1), XOPCOD(1)
      CHARACTER NAMEIN*12, CLAIN*6, TYPE*2, XSOUR(30)*16, OPTYPE*4,
     *   OPCODE*4, TECTYP*8
C                                       Program info
C
      INTEGER   MXSCAN
      PARAMETER (MXSCAN=5000)
C
      REAL      TSTART, TSTOP, TINT, XYSCL(2), XYOFF(2), YYMX(10),
     *   YYMN(10), XMX, XMN, XMXW, XMNW, GMMOD, RATFAC(MAXIF), SELBAN,
     *   XSTART, XSTOP, CHOUT(4), XXMIN(MAXANT), XXMAX(MAXANT),
     *   YYMIN(MAXANT,10), TSCAN(MXSCAN),
     *   YYMAX(MAXANT,10), PRAN(2,2),
     *   DO3COL, TCAL(4,MAXIF,MAXANT), CSMIN, CSMAX
      INTEGER   SEQIN, DISKIN, CNOIN, IVER, BIF, ANTS(50), NCOUNT,
     *   ICODES(10), NCODES, NPARMS, NID, SID(500), NANTSL, NPLOTS,
     *   ISTOK, FRQSEL, XINC, GRCHN, GR2CHN, TVCHN, TVCORN(4), XVAR,
     *   ISOU, OSOU, IANT, EIF, ITPLOT, ITVER, PCNUM, LABEL, SUBARR,
     *   MUMPAR, MUMPOL, MUMIF, MUMANT, NTONE, NUMPTS(MAXANT), ISYM,
     *   NANREC(MAXANT), FANREC(MAXANT), NOSCAN, STRANS(MXSCAN),
     *   REFANT, I2VER
      LOGICAL   DOAWNT, DOTV, NNODAT, DOLINE, SWAP, REREF
      DOUBLE PRECISION SELFRQ, JD0
C                                       Constants
      DOUBLE PRECISION SIDER, CLIGHT
      COMMON /INPARM/ XNAMEI, XCLAIN, XSIN, XDISIN, XNVER, XNVER2,
     *   XXSOUR, XQUAL, XTIME, XANT, PIXR, XNCOU, XXINC, XOPTY, XOPCOD,
     *   APARM, BPARM, CPARM, XDO3C, XSYM, FACTOR, 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, ITPLOT, ITVER, PCNUM, DOTV, NNODAT, LABEL, CHOUT, DO3COL,
     *   DOLINE, NOSCAN, TSCAN, STRANS, SWAP, REREF, REFANT, GR2CHN,
     *   I2VER
      COMMON /VGNCOM/ SELFRQ, JD0,
     *   TSTART, TSTOP, TINT, XYSCL, XYOFF, SELBAN, XMX, XMN, XMXW,
     *   XMNW, XSTART, XSTOP, GMMOD, RATFAC, NID, SID, NANTSL, PRAN,
     *   NPLOTS, DOAWNT, ISTOK, FRQSEL, XINC,
     *   SUBARR, MUMPAR, MUMPOL, MUMIF, MUMANT, NUMPTS, NTONE,
     *   XXMIN, XXMAX, YYMIN, YYMAX, YYMX, YYMN, ISYM,
     *   TCAL, NANREC, FANREC, CSMIN, CSMAX
      COMMON /VGNCHR/ NAMEIN, CLAIN, TYPE, XSOUR, OPTYPE, OPCODE, TECTYP
      COMMON /CONST/ SIDER, CLIGHT
C                                                          End TEPLT
LOCAL END
LOCAL INCLUDE 'TEFILE.INC'
      INTEGER   TEBUFF(512), ITERNO, TEKOLS(16), TENUMV(16), TESOUR,
     *   TEANTE, NTEINR, TEBUF2(512)
      DOUBLE PRECISION TETIME
      REAL      TEHA, TEAZ, TEEL, TEAZIO, TEZAIO, TEDLON, TEDLAT,
     *   TEB(3), TEPATH, TEMAG, TETEC, TEIFR, TEDISP(2), TEVALS(17)
      EQUIVALENCE (TEVALS(2), TEHA)
      COMMON /TEDATA/ TEBUFF, TEBUF2, TETIME, TEHA, TEAZ, TEEL, TEAZIO,
     *   TEZAIO, TEDLON, TEDLAT, TEB, TEPATH, TEMAG, TETEC, TEIFR,
     *   TEDISP, ITERNO, TEKOLS, TENUMV, TESOUR, TEANTE, NTEINR
LOCAL END
      PROGRAM TEPLT
C-----------------------------------------------------------------------
C! Plots data from a TE (TECOR) table
C# UV Plot EXT-appl Calibration
C-----------------------------------------------------------------------
C;  Copyright (C) 2023-2025
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   TEPLT plots SN or CL extension files. A 'PL' extension file is made
C   which can be displayed in the usual ways .
C   Inputs:
C      INNAME.....UV file name (name).       Standard defaults.
C      INCLASS....UV file name (class).      Standard defaults.
C      INSEQ......UV file name (seq. #).     0 => highest.
C      INDISK.....Disk unit #.               0 => any.
C      INEXT......'TE'
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      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 on Y:
C      OPCODE.....Data to be plotted on X
C      APARM......Types to be plotted on Y for MULT
C      BPARM, CPARM... Pixrange for MULT
C      DOTV     R      > 0 => TV, else plot file
C      GRCHAN   R      graphics channel to use
C-----------------------------------------------------------------------
C
      CHARACTER PRGN*6
      REAL      PLTPTS(2)
      LONGINT   PPLTPT
      INTEGER   IRET, MVAL, NWORDS, NROWS
      INCLUDE 'TEPLT.INC'
      INCLUDE 'TEFILE.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 /'TEPLT '/
C-----------------------------------------------------------------------
C                                       Get input parameters
      CALL TEPIN (PRGN, NROWS, IRET)
      MUMANT = MAX (1, MUMANT)
      MVAL = 3 + NCODES
      NWORDS = (MVAL * NROWS - 1) / 1024  + 21
      CALL ZMEMRY ('GET ', TSKNAM, NWORDS, PLTPTS, PPLTPT, IRET)
      IF (IRET.NE.0) THEN
         MSGTXT = 'UNABLE TO GET DYNAMIC MEMORY'
         CALL MSGWRT (8)
         END IF
C                                       read data to figure out
C                                       distribution
      NWORDS = NWORDS * 1024
      IF (IRET.EQ.0) CALL TEPCNT (NWORDS, IRET)
C                                       Fetch data, determine scaling
      IF (IRET.EQ.0) CALL TEPMAX (MVAL, PLTPTS(1+PPLTPT), IRET)
C                                       Do plots
      IF (IRET.EQ.0) CALL TEPLOT (MVAL, MUMANT, PLTPTS(1+PPLTPT), IRET)
      IF (IRET.LT.0) IRET = 0
C                                       Close down
      CALL DIE (IRET, TEBUFF)
C
 999  STOP
      END
      SUBROUTINE TEPIN (PRGN, NROWS, IERR)
C-----------------------------------------------------------------------
C   Gets the inputs parameters for TEPLT.
C   Inputs:
C      PRGN    C*6  Program name
C   Output:
C      IERR    I    Error code: 0 => ok
C      ISTOK   I    1 = R, 2 = L
C      ICODE   I   'TIME','HA','AZ','ZA','AZIO','ZAIO','DLON','DLAT',
C                   'BX','BY','BZ','STEC','MAG', TEC','IFR', 'DISP'
C                   'MULT', 'DIFF' are special
C-----------------------------------------------------------------------
      INTEGER   NROWS, IERR
      CHARACTER PRGN*6
C
      INCLUDE 'TEPLT.INC'
      CHARACTER STAT*4, CODE(NCODE)*4, TYPTMP*2
      INTEGER   IRET, BUFF(256), I, J, K, JERR, QUAL(30), NSOUR, LTYPE,
     *   BUFFER(512), IROUND, LUN, ICODE
      LOGICAL T, F
      INCLUDE 'INCS:DDCH.INC'
      INCLUDE 'INCS:DCAT.INC'
      INCLUDE 'INCS:DANS.INC'
      INCLUDE 'INCS:DANT.INC'
      INCLUDE 'INCS:DFIL.INC'
      INCLUDE 'INCS:DMSG.INC'
      INCLUDE 'INCS:DHDR.INC'
      INCLUDE 'INCS:DUVH.INC'
      INCLUDE 'INCS:PSTD.INC'
      DATA CODE /'TIME', 'HA', 'AZ', 'ZA', 'AZIO', 'ZAIO', 'DLON',
     *  'DLAT', 'BX', 'BY', 'BZ', 'STEC', 'MAG', 'TEC', 'IFR', 'DISP'/
      DATA T, F /.TRUE.,.FALSE./
C-----------------------------------------------------------------------
      OSOU = -1
      NPARMS = 232
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)
      TYPE = 'TE'
      CALL H2CHR (4, 1, XOPTY, OPTYPE)
      CALL H2CHR (4, 1, XOPCOD, OPCODE)
      ISYM = IROUND (XSYM)
      IF ((ISYM.LE.0) .OR. (ISYM.GT.24)) ISYM = 1
C
      DO 20 I = 1,30
         CALL H2CHR (16, 1, XXSOUR(1,I), XSOUR(I))
         QUAL(I) = IROUND (XQUAL)
 20      CONTINUE
      CALL FILL (MAXANT, 0, NUMPTS)
C                                       Integers
      SEQIN = IROUND (XSIN)
      DISKIN = IROUND (XDISIN)
      IVER = IROUND (XNVER)
      I2VER = IROUND (XNVER2)
      NCOUNT = IROUND (XNCOU)
      IF (NCOUNT.LE.0) NCOUNT = 5
      XNCOU = NCOUNT
      XINC = IROUND (XXINC)
      IF (XINC.LE.0) XINC = 1
      XXINC = XINC
      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
C                                       plot types
      IF ((OPTYPE.EQ.'MULT') .OR. (OPTYPE.EQ.'DIFF')) THEN
         NCODES = 0
         DO 25 I = 1,10
            ICODE = IROUND (APARM(I))
            IF ((ICODE.LT.1) .OR. (ICODE.GT.NCODE)) GO TO 26
            NCODES = NCODES + 1
            ICODES(NCODES) = ICODE
            APARM(I) = ICODE
 25         CONTINUE
 26      IF (NCODES.LE.0) THEN
            MSGTXT = 'OPTYPE ''' // OPTYPE //
     *         ''' HAS NO VALID TYPE CODES'
            CALL MSGWRT (8)
            IERR = 10
            GO TO 999
            END IF
         IF (NCODES.EQ.1) THEN
            CALL CHR2H (4, CODE(ICODES(1)), 1, XOPTY)
            PIXR(1) = BPARM(1)
            PIXR(2) = CPARM(1)
            END IF
      ELSE
         ICODE = 15
         DO 30 I = 1,NCODE
            IF (OPTYPE.EQ.CODE(I)) ICODE = I
 30         CONTINUE
         CALL CHR2H (4, CODE(ICODE), 1, XOPTY)
         APARM(1) = ICODE
         NCODES = 1
         ICODES(1) = ICODE
         BPARM(1) = PIXR(1)
         CPARM(1) = PIXR(2)
         END IF
      CALL RFILL (10-NCODES, 0.0, APARM(NCODES+1))
      CALL RFILL (10-NCODES, 0.0, BPARM(NCODES+1))
      CALL RFILL (10-NCODES, 0.0, CPARM(NCODES+1))
C                                       x axis
      XVAR = 1
      DO 35 I = 1,NCODE
         IF (OPCODE.EQ.CODE(I)) XVAR = I
 35      CONTINUE
      IF (XVAR.GT.0) CALL CHR2H (4, CODE(XVAR), 1, XOPCOD)
      DO 40 I = 1,NCODES
         IF (APARM(I).EQ.16) THEN
            BPARM(I) = BPARM(I) * 1.E-9
            CPARM(I) = CPARM(I) * 1.E-9
            END IF
 40      CONTINUE
C                                       Time range
      TSTART = XTIME(1) + (XTIME(2) / 24.0) + (XTIME(3) / (24.0*60.0)) +
     *   (XTIME(4) / (24.0*3600.0))
      TSTOP = XTIME(5) + (XTIME(6) / 24.0) + (XTIME(7) / (24.0*60.0)) +
     *   (XTIME(8) / (24.0*3600.0))
      IF (TSTART.GE.TSTOP) THEN
         TSTART = 0.0
         TSTOP = 999.0
         END IF
      DOTV = XDOTV.GT.0.0
      GRCHN = XGRCH + 0.01
      GR2CHN = GRCHN / 10
      GRCHN = MOD (GRCHN, 10)
      IF (GR2CHN.EQ.0) GR2CHN = MAX (1, GRCHN)
      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
      CALL FNDEXT ('TE', CATBLK, I)
      IF ((IVER.LT.1) .OR. (IVER.GT.I)) IVER = I
      IF (OPTYPE.EQ.'DIFF') THEN
         IF ((I2VER.LT.1) .OR. (I2VER.GT.I) .OR. (I2VER.EQ.IVER))
     *      I2VER = I - 1
      ELSE
         I2VER = 0
         END IF
C                                       Look up sources
      NID = 500
      NSOUR = 30
      MSGSUP = 32000
      CALL SOURNU (XSOUR, QUAL, NSOUR, DISKIN, CNOIN, NID, BUFFER, SID,
     *   JERR)
      MSGSUP = 0
      IF (JERR.LT.0) THEN
         MSGTXT = 'SPECIFIED SOURCE(S) NOT FOUND - CONTINUING'
         CALL MSGWRT (6)
         END IF
      IF (JERR.NE.0) NID = 0
C                                       Check antennas desired.
      NANTSL = 0
      DOAWNT = T
      DO 70 J = 1,50
         ANTS(J) = IROUND (XANT(J))
         IF (ANTS(J).LT.0) DOAWNT = F
C                                       Make positive
         ANTS(J) = ABS (ANTS(J))
         IF (NANTSL.LT.1) GO TO 60
            DO 50 K = 1,NANTSL
               IF (ANTS(J).EQ.ANTS(K)) ANTS(J) = 0
 50            CONTINUE
C                                       Check for multiple entries
 60      IF (ABS (ANTS(J)).GE.1) NANTSL = J
 70      CONTINUE
C                                       Make sure not too many
      IF (NANTSL.GT.MAXANT) NANTSL = MAXANT
C                                       Get antenna names
      CALL GETANT (DISKIN, CNOIN, MAX (1, SUBARR), CATBLK, BUFFER, JERR)
      MUMANT = NSTNS
      IF (MUMANT.LE.1) THEN
         MUMANT = MAXANT
         TIMLAB = 'IAT'
         END IF
      CALL JULDAY (RDATE, JD0)
C                                       Open table to check
      CALL TEPOPN (NROWS, IERR)
      IF (IERR.NE.0) GO TO 999
      XNVER = IVER
      XNVER2 = I2VER
      CSMAX = -100000
      CSMIN = 1000000
      CALL RFILL (MAXANT, 1.E5, XXMIN)
      CALL RFILL (MAXANT, -1.E5, XXMAX)
      I = MAXANT
      I = I * 10
      CALL RFILL (I, 1.E8, YYMIN)
      CALL RFILL (I, -1.E8, YYMAX)
      CALL RFILL (10, -1.E8, YYMX)
      CALL RFILL (10,  1.E8, YYMN)
      IF ((XVAR.EQ.1) .AND. (TSTART.GT.0.0) .AND. (TSTOP.LT.999.0)) THEN
         CALL RFILL (MAXANT, TSTART, XXMIN)
         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
      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')
      END
      SUBROUTINE TEPOPN (NROWS, IERR)
C-----------------------------------------------------------------------
C   Routine to open TE table
C   information
C   Input from Common:
C      TYPE     C*2  'TE'
C      DISKIN   I     Disk number
C      CNOIN    I     Catalog slot number
C      CATBLK   I(*)  Catalog header
C   Output:
C      IERR     I     Error code, 0=OK else failed.
C   Output in common:
C      ITERNO       I    Current TE record number
C      NTEINR       I    Number of gain records in file.
C      ITEVER       I    Version number opened.
C-----------------------------------------------------------------------
      INTEGER   NROWS, IERR
C
      INCLUDE 'TEPLT.INC'
      INCLUDE 'TEFILE.INC'
      INTEGER   LUN
      CHARACTER RDATE*8, TTYP*8, RD*8
      INCLUDE 'INCS:DCAT.INC'
      INCLUDE 'INCS:DMSG.INC'
C-----------------------------------------------------------------------
C                                       Open table
      LUN = 28
      CALL TEINI ('READ', TEBUFF, DISKIN, CNOIN, IVER, CATBLK, LUN,
     *   ITERNO, TEKOLS, TENUMV, RDATE, TECTYP, IERR)
      IF (IERR.NE.0) THEN
         WRITE (MSGTXT,1000) IERR, 'OPENING TE TABLE'
         GO TO 990
         END IF
      ITVER = IVER
C                                       Get number of scans
      NTEINR = TEBUFF(5)
      NROWS = NTEINR
C                                       Check if empty
      IF (NTEINR.LE.0) THEN
         IERR = 6
         MSGTXT = 'ERROR: SELECTED TABLE IS EMPTY'
         GO TO 990
         END IF
C                                       DIFF
      IF (I2VER.GT.0) THEN
         LUN = 39
         CALL TEINI ('READ', TEBUF2, DISKIN, CNOIN, I2VER, CATBLK, LUN,
     *      ITERNO, TEKOLS, TENUMV, RD, TTYP, IERR)
         IF (IERR.NE.0) THEN
            WRITE (MSGTXT,1000) IERR, 'OPENING 2ND TE TABLE'
            GO TO 990
         END IF
         IF (RD.NE.RDATE) THEN
            MSGTXT = 'DIFF DATES DO NOT MATCH'
            IERR = 10
            GO TO 990
            END IF
         IF (TEBUF2(5).NE.NROWS) THEN
            MSGTXT = 'DIFF: TE FILE SIZES NOT THE SAME'
            IERR = 10
            GO TO 990
            END IF
         END IF
      GO TO 999
C                                       Error
 990  CALL MSGWRT (8)
C
 999  RETURN
C-----------------------------------------------------------------------
 1000 FORMAT ('ERROR ',I3,' ON ',A)
      END
      LOGICAL FUNCTION ISTYPE (FTYPE)
C-----------------------------------------------------------------------
C   ISTYPE inquires if type in list of requested types
C   Inputs:
C      FTYPE    I   Test type
C   Output:
C      ISTYPE   L   T => TYPE in ICODES
C-----------------------------------------------------------------------
      INTEGER   FTYPE
C
      INTEGER   I
      INCLUDE 'TEPLT.INC'
C-----------------------------------------------------------------------
      ISTYPE = .FALSE.
      DO 10 I = 1,NCODES
         IF (ICODES(I).EQ.FTYPE) ISTYPE = .TRUE.
 10      CONTINUE
C
 999  RETURN
      END
      SUBROUTINE TEPCNT (NWORDS, IERR)
C-----------------------------------------------------------------------
C   TEPCNT reads the TE 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 'TEPLT.INC'
      INCLUDE 'TEFILE.INC'
      LOGICAL   NODATA, OKAY
      INTEGER   I, NP, SCNT(MXSCAN), IRNO
      REAL      TB, TE, GTIME, XVARIB, CSOU
      REAL      VALUE(2*MAXIF,10)
      INCLUDE 'INCS:DDCH.INC'
      INCLUDE 'INCS:DCAT.INC'
      INCLUDE 'INCS:DMSG.INC'
      INCLUDE 'INCS:DFIL.INC'
      INCLUDE 'INCS:PSTD.INC'
C-----------------------------------------------------------------------
      CALL FILL (MAXANT, 0, NANREC)
      CALL FILL (MXSCAN, 0, SCNT)
      NODATA = .TRUE.
      TB = 1.0E5
      TE = -1.0E5
      IF ((XVAR.EQ.1) .AND. (TSTART.GT.0.0) .AND. (TSTOP.LT.999.0)) THEN
         TB = TSTART
         TE = TSTOP
         END IF
      XMX = TE
      XMN = TB
      XMXW = TE
      XMNW = TB
C                                       Loop thru data
      DO 100 IRNO = 1,NTEINR,XINC
         ITERNO = IRNO
         CALL TABTE ('READ', TEBUFF, ITERNO, TEKOLS, TENUMV, TETIME,
     *      TESOUR, TEANTE, TEHA, TEAZ, TEEL, TEAZIO, TEZAIO, TEDLON,
     *      TEDLAT, TEB, TEPATH, TEMAG, TETEC, TEIFR, TEDISP, IERR)
         IF (IERR.LT.0) GO TO 100
         IF (IERR.GT.0) THEN
            WRITE (MSGTXT,1000) IERR, 'READING THE TE TABLE'
            GO TO 990
            END IF
C                                       time range ?
         GTIME = TETIME
         IF ((GTIME.LT.TSTART) .OR. (GTIME.GT.TSTOP)) GO TO 100
C                                       Antenna?
         IANT = TEANTE
         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 = TESOUR
            DO 70 I = 1,NID
               IF (ISOU.EQ.SID(I)) GO TO 80
 70            CONTINUE
            GO TO 100
            END IF
C                                      Get start, stop times
 80      TB = MIN (TB, GTIME)
         TE = MAX (TE, GTIME)
C                                       Get value
         CALL TEPDAT (VALUE, XVARIB, CSOU, OKAY)
C                                       Max. - Min
         IF ((OKAY) .AND. (XVARIB.NE.FBLANK)) THEN
            IF (OKAY) NODATA = .FALSE.
            NANREC(IANT) = NANREC(IANT) + 1
            I = CSOU + 0.1
            IF ((I.GT.0) .AND. (I.LE.MXSCAN)) SCNT(I) = SCNT(I) + 1
            END IF
 100     CONTINUE
      IERR = MAX (0, IERR)
      FANREC(1) = 1
      DO 120 I = 2,MAXANT
         FANREC(I) = FANREC(I-1) + NANREC(I-1)
 120     CONTINUE
      IF (NWORDS.LT.FANREC(MAXANT)+NANREC(MAXANT)) THEN
         MSGTXT = 'MEMORY TOO SMALL'
         IERR = 10
         END IF
C                                       source number translation
      NP = 0
      CALL FILL (MXSCAN, 0, STRANS)
      DO 130 I = 1,MXSCAN
         IF (SCNT(I).GT.0) THEN
            NP = NP + 1
            STRANS(I) = NP
            END IF
 130     CONTINUE
C
 990  IF (IERR.NE.0) CALL MSGWRT (8)
C
 999  RETURN
C-----------------------------------------------------------------------
 1000 FORMAT ('TEPCNT: ERROR',I4,' ON ',A)
      END
      SUBROUTINE TEPMAX (NV, PLTPTS, IERR)
C-----------------------------------------------------------------------
C   TEPMAX reads the TE table to find the max and min values for
C   each station prior to plotting.
C   Input:
C      NV       I      Number values per time (source, T, X, n*Y)
C   Input/Output in common:
C      TSTART   R      Start time of plot
C      TSTOP    R      Stop time of plot
C   Output:
C      PLTPTS   R(*)   Data to be plotted (NV, *)
C      IERR     I      Error code, 0=OK else failed
C   Outputs in common:
C-----------------------------------------------------------------------
      INTEGER   NV, IERR
      REAL      PLTPTS(NV,*)
C
      LOGICAL   NODATA, OKAY
      INTEGER   I, NN, IS, KK, IRNO, T2SOUR, T2ANTE
      REAL      TB, TE, TMAX, TMIN, GTIME, XVARIB, CSOU, TEMP
      INCLUDE 'TEPLT.INC'
      INCLUDE 'TEFILE.INC'
      REAL      VALUE(10), T2VALS(17)
      DOUBLE PRECISION T2TIME
      INCLUDE 'INCS:DDCH.INC'
      INCLUDE 'INCS:DCAT.INC'
      INCLUDE 'INCS:DMSG.INC'
      INCLUDE 'INCS:DFIL.INC'
      INCLUDE 'INCS:PSTD.INC'
C-----------------------------------------------------------------------
      NODATA = .TRUE.
      TB = 1.0E5
      TE = -1.0E5
      IF ((XVAR.EQ.1) .AND. (TSTART.GT.0.0) .AND. (TSTOP.LT.999.0)) THEN
         TB = TSTART
         TE = TSTOP
         END IF
      XMX = TE
      XMN = TB
      XMXW = TE
      XMNW = TB
C                                       Loop thru data
      DO 100 IRNO = 1,NTEINR,XINC
C                                       DIFF
         IF (I2VER.GT.0) THEN
            ITERNO = IRNO
            CALL TABTE ('READ', TEBUF2, ITERNO, TEKOLS, TENUMV, TETIME,
     *         TESOUR, TEANTE, TEHA, TEAZ, TEEL, TEAZIO, TEZAIO, TEDLON,
     *         TEDLAT, TEB, TEPATH, TEMAG, TETEC, TEIFR, TEDISP, IERR)
            IF (IERR.LT.0) GO TO 100
            IF (IERR.GT.0) THEN
               WRITE (MSGTXT,1000) IERR, 'READING THE 2ND TE TABLE'
               GO TO 990
               END IF
            CALL RCOPY (17, TEVALS, T2VALS)
            T2TIME = TETIME
            T2SOUR = TESOUR
            T2ANTE = TEANTE
            END IF
         ITERNO = IRNO
         CALL TABTE ('READ', TEBUFF, ITERNO, TEKOLS, TENUMV, TETIME,
     *      TESOUR, TEANTE, TEHA, TEAZ, TEEL, TEAZIO, TEZAIO, TEDLON,
     *      TEDLAT, TEB, TEPATH, TEMAG, TETEC, TEIFR, TEDISP, IERR)
         IF (IERR.LT.0) GO TO 100
         IF (IERR.GT.0) THEN
            WRITE (MSGTXT,1000) IERR, 'READING THE TE TABLE'
            GO TO 990
            END IF
C                                       Record within specified
C                                       time range ?
         GTIME = TETIME
         IF ((GTIME.LT.TSTART) .OR. (GTIME.GT.TSTOP)) GO TO 100
C                                       Antenna?
         IANT = TEANTE
         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 = TESOUR
            DO 70 I = 1,NID
               IF (ISOU.EQ.SID(I)) GO TO 80
 70            CONTINUE
            GO TO 100
            END IF
C                                      Get start, stop times
 80      TB = MIN (TB, GTIME)
         TE = MAX (TE, GTIME)
C                                       DIFF
         IF (I2VER.GT.0) THEN
            IF ((T2SOUR.NE.TESOUR) .OR. (T2ANTE.NE.TEANTE) .OR.
     *         (ABS(T2TIME-TETIME).GT.1.E-7)) THEN
               MSGTXT = 'TEPMAX: TWO TE FILES DO NOT MATCH'
               IERR = 11
               GO TO 990
               END IF
            DO 85 I = 2,17
               IF ((T2VALS(I).EQ.FBLANK) .OR. (TEVALS(I).EQ.FBLANK))
     *            THEN
                  TEVALS(I) = FBLANK
               ELSE
                  TEVALS(I) = TEVALS(I) - T2VALS(I)
                  END IF
 85            CONTINUE
            END IF
C                                       Get value
         CALL TEPDAT (VALUE, XVARIB, CSOU, OKAY)
C                                       Max. - Min
         IF ((OKAY) .AND. (XVARIB.NE.FBLANK)) THEN
            IF (OKAY) NODATA = .FALSE.
C                                       Put in array
            NUMPTS(IANT) = NUMPTS(IANT) + 1
            NN = FANREC(IANT) + NUMPTS(IANT) - 1
            IS = CSOU + 0.1
            IF ((IS.GT.0) .AND. (IS.LE.MXSCAN)) CSOU = STRANS(IS)
            PLTPTS(1,NN) = CSOU
            PLTPTS(2,NN) = GTIME
            PLTPTS(3,NN) = XVARIB
            KK = 4
            DO 81 I = 1,NCODES
               PLTPTS(KK,NN) = VALUE(I)
               KK = KK + 1
 81            CONTINUE
            IF ((XVAR.EQ.1) .OR. (XVAR.GT.8)) THEN
               XMX = MAX (XMX, XVARIB)
               XMN = MIN (XMN, XVARIB)
            ELSE
               TEMP = XVARIB
               IF (TEMP.LT.0.0) TEMP = TEMP + 360.
               XMX = MAX (XMX, TEMP)
               XMN = MIN (XMN, TEMP)
               IF (TEMP.GT.180.0) TEMP = TEMP - 360
               XMXW = MAX (XMXW, TEMP)
               XMNW = MIN (XMNW, TEMP)
               END IF
            XXMAX(IANT) = MAX (XXMAX(IANT), XVARIB)
            XXMIN(IANT) = MIN (XXMIN(IANT), XVARIB)
            CSMIN = MIN (CSMIN, CSOU)
            CSMAX = MAX (CSMAX, CSOU)
C                                       If not a summary plot
            DO 95 KK = 1,NCODES
               IF (VALUE(KK).NE.FBLANK) THEN
                  YYMX(KK) = MAX (YYMX(KK), VALUE(KK))
                  YYMN(KK) = MIN (YYMN(KK), VALUE(KK))
                  IF ((ICODES(KK).GT.1) .AND. (ICODES(KK).LE.8)) THEN
                     IF (VALUE(KK).LE.-180.0) THEN
                        VALUE(KK) = VALUE(KK) + 360.
                     ELSE IF (VALUE(KK).GT.180.) THEN
                        VALUE(KK) = VALUE(KK) - 360.
                        END IF
                     YYMIN(IANT,KK) = MIN (VALUE(KK),
     *                  YYMIN(IANT,KK))
                     YYMAX(IANT,KK) = MAX (VALUE(KK),
     *                  YYMAX(IANT,KK))
                     IF (VALUE(KK).LT.0.0) VALUE(KK) =
     *                  VALUE(KK) + 360.0
                  ELSE
                     YYMIN(IANT,KK) = MIN (VALUE(KK),
     *                  YYMIN(IANT,KK))
                     YYMAX(IANT,KK) = MAX (VALUE(KK),
     *                  YYMAX(IANT,KK))
                     END IF
                  END IF
 95            CONTINUE
            END IF
 100     CONTINUE
      IERR = MAX (0, IERR)
C                                       reset max min on fixed scale
      DO 125 KK = 1,NCODES
         IF (BPARM(KK).LT.CPARM(KK)) THEN
            YYMX(KK) = CPARM(KK)
            YYMN(KK) = BPARM(KK)
            DO 120 IANT = 1,MUMANT
               IF (YYMAX(IANT,KK).GE.
     *            YYMIN(IANT,KK)) THEN
                  YYMAX(IANT,KK) = CPARM(KK)
                  YYMIN(IANT,KK) = BPARM(KK)
                  END IF
 120           CONTINUE
            END IF
 125     CONTINUE
C                                       Set actual X range
      SWAP = .FALSE.
      IF (XVAR.EQ.1) THEN
         XSTART = TB
         XSTOP = TE
      ELSE IF ((XVAR.GE.2) .AND. (XVAR.LE.8)) THEN
         IF (XMX-XMN.LE.XMXW-XMNW) THEN
            XSTART = XMN
            XSTOP  = XMX
         ELSE
            XSTART = XMNW
            XSTOP  = XMXW
            SWAP = .TRUE.
            END IF
      ELSE
         XSTART = XMN
         XSTOP  = XMX
         END IF
C                                       Check for no data
      IF (NODATA) THEN
         IERR = 6
         MSGTXT = 'NO DATA SELECTED'
         GO TO 990
         END IF
C                                       check and set scaling
      IF ((XVAR.EQ.1) .AND. (TSTART.GT.0.0) .AND. (TSTOP.LT.999.0)) THEN
         TMAX = (XSTOP + 0.03 * (XSTOP - XSTART)) * 360.0
         TMIN = (XSTART- 0.03 * (XSTOP - XSTART)) * 360.0
      ELSE IF (XVAR.EQ.1) THEN
         TMAX = (XSTOP + 0.1 * (XSTOP - XSTART)) * 360.0
         TMIN = (XSTART- 0.1 * (XSTOP - XSTART)) * 360.0
      ELSE
         TMAX = (XSTOP + 0.1 * (XSTOP - XSTART))
         TMIN = (XSTART- 0.1 * (XSTOP - XSTART))
         END IF
C                                       If start time is stop time,
      IF (ABS (TMAX-TMIN) .LT. 0.01) THEN
         TMIN = MAX( TMIN-0.005, 0.0)
         TMAX = TMIN + 0.01
         END IF
      TSTART = TB
      TSTOP = TE
      XYOFF(1) = TMIN
      XYSCL(1) = 1000.0 / (TMAX - TMIN)
      PRAN(1,1) = TMIN
      PRAN(2,1) = TMAX
C                                       Send back time range
      XTIME(1) = TSTART
      XTIME(2) = 0.0
      XTIME(3) = 0.0
      XTIME(4) = 0.0
      XTIME(5) = TSTOP
      XTIME(6) = 0.0
      XTIME(7) = 0.0
      XTIME(8) = 0.0
      GO TO 999
C
 990  CALL MSGWRT (8)
C
 999  RETURN
C-----------------------------------------------------------------------
 1000 FORMAT ('TEPMAX: ERROR',I4,' ON ',A)
      END
      SUBROUTINE GETSCL (KK, LANT, DOIT)
C-----------------------------------------------------------------------
C   GETSCL converts a number of max/min's to a scale
C   Inputs:
C      KK      I   parameter number
C      LANT    I   Antenna number
C   Output:
C      DOIT    L      There were valid values
C   Output in common
C      XYSCL   R(2)   Scaling - only 2nd one changed
C      XYOFF   R(2)   Offset  - only second one changed
C-----------------------------------------------------------------------
      INTEGER   KK, LANT
      LOGICAL   DOIT
C
      INCLUDE 'TEPLT.INC'
      REAL      YMX, YMN, PMX, PMN, TMAX, TMIN, TDIF, TOLER(NCODE),
     *   SIZEY, FACT
C                                       Minimum value range for each
C                                       ICODE
c                 time   angles,  B field    tec  B      tec  ifr
      DATA TOLER /0.001, 7 * 1.0, 3 * 0.001, 0.1, 0.001, 0.1, 0.005,
c        disp
     *   1.E-9/
C-----------------------------------------------------------------------
      DOIT = .FALSE.
      FACT = 1.0
      IF (I2VER.GT.0) FACT = 100.0
      YMX = -1.E8
      YMN = -YMX
      PMX = YMX
      PMN = YMN
      IF (YYMAX(LANT,KK).GE.YYMIN(LANT,KK)) THEN
         DOIT = .TRUE.
         YMX = MAX (YMX, YYMAX(LANT,KK))
         YMN = MIN (YMN, YYMIN(LANT,KK))
         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))/FACT) THEN
         TMAX = TMAX + TOLER(ICODES(KK))/FACT
         TMIN = TMIN - TOLER(ICODES(KK))/FACT
         END IF
      TDIF = TMAX - TMIN
      IF (ABS (TDIF).LE.1.0E-25) TDIF = 1.0E-25
      XYOFF(2) = TMIN
      XYSCL(2) = 1000.0 / TDIF / NCOUNT
      PRAN(1,2) = TMIN
      PRAN(2,2) = TMAX
C
 999  RETURN
      END
      SUBROUTINE TEPDAT (VALUE, XVARIB, CSOU, OKAY)
C-----------------------------------------------------------------------
C   Routine to get the specified value from a TE table entry
C   Input from common:
C      ICODE    I     Plot code
C   Also uses pointers etc. set in TEPOPN
C   Output:
C      VALUE    R(*)   Table value, magic value blanked (amp on ICODE 6)
C      XVARIB   R      Value of associated x-axis variable
C      CSOU     R      source number
C      OKAY     L      Some values are good
C-----------------------------------------------------------------------
      INCLUDE 'INCS:PUVD.INC'
      REAL      VALUE(*), XVARIB, CSOU
      LOGICAL   OKAY
C
      INTEGER   KK, ICODE
      LOGICAL   T
      INCLUDE 'TEPLT.INC'
      INCLUDE 'TEFILE.INC'
      INCLUDE 'INCS:DMSG.INC'
      INCLUDE 'INCS:DDCH.INC'
      INCLUDE 'INCS:PSTD.INC'
      DATA T /.TRUE./
C-----------------------------------------------------------------------
C                                       In case the data is bad
      OKAY = .FALSE.
      CSOU = TESOUR
      IF (XVAR.EQ.1) THEN
         XVARIB = TETIME
      ELSE
         XVARIB = TEVALS(XVAR)
C         IF (XVAR.EQ.16) XVARIB = XVARIB * 1.0E9
         END IF
      DO 20 KK = 1,NCODES
         ICODE = ICODES(KK)
         IF (ICODE.EQ.1) THEN
            VALUE(KK) = TETIME
         ELSE
            VALUE(KK) = TEVALS(ICODE)
c            IF (ICODE.EQ.16) VALUE(KK) = VALUE(KK) * 1.E9
            END IF
         IF (VALUE(KK).NE.FBLANK) OKAY = .TRUE.
 20      CONTINUE
      IF (XVARIB.EQ.FBLANK) OKAY = .FALSE.
C
 999  RETURN
      END
      SUBROUTINE TEPLOT (NV, NA, PLTPTS, IRET)
C-----------------------------------------------------------------------
C   TEPLOT plots the data thru calls to PLTTE.
C   Input:
C      NV       I      Number values per antenna (source, T, X, Y data)
C      NA       I      Number antennas in data array
C      PLTPTS   R(*)   Data (NV,*)
C   Output:
C      IRET     I      Return code, 0=OK else failed
C-----------------------------------------------------------------------
      INTEGER   NV, NA, IRET
      REAL      PLTPTS(NV,*)
C
      INTEGER   IPLOT, JPLT, IPLT, NPLT, KK
      LOGICAL   DOIT
      INCLUDE 'TEPLT.INC'
      INCLUDE 'INCS:DMSG.INC'
      INCLUDE 'INCS:PSTD.INC'
C-----------------------------------------------------------------------
      IRET = 0
      IPLOT = 0
C                                       count the plots
      NPLOTS = 0
      DO 40 IPLT = 1,MUMANT
         DO 25 KK = 1,NCODES
            CALL GETSCL (KK, IPLT, DOIT)
            IF (DOIT) NPLOTS = NPLOTS + 1
 25         CONTINUE
 40      CONTINUE
C                                       Now plot
      NPLT = 0
      DO 100 IPLT = 1,MUMANT
         DO 70 KK = 1,NCODES
            CALL GETSCL (KK, IPLT, DOIT)
            IF (DOIT) THEN
               NPLT = NPLT + 1
               JPLT = NPLT
               IPLOT = MOD (NPLT-1, NCOUNT) + 1
               IF (NPLT.EQ.NPLOTS) IPLOT = -IPLOT
               CALL PLTTE (IPLOT, KK, IPLT, NV, PLTPTS, IRET)
               IF (IRET.NE.0) GO TO 999
               END IF
 70         CONTINUE
 100     CONTINUE
C
 999  RETURN
      END
      SUBROUTINE PLTTE (IPLOT, KK, ANTNO, NV, PLTPTS, IRET)
C-----------------------------------------------------------------------
C   PLTTE actually plots data.
C   Input:
C      IPLOT    I      Plot number on current page. If neg. then this is
C                      last plot.
C      KK       I      Parameter number
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   IPLOT, KK, ANTNO, NV, IRET
      REAL      PLTPTS(NV,*)
C
      INCLUDE 'TEPLT.INC'
C
      CHARACTER TEXT*132, PFILE*48, ATIME*8, ADATE*12, CHTMP*18,
     *   AUNITS(NCODE)*8, CHTYPE(NCODE)*16, TXTMSG*80, CSAVE*5
      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, ILITY, NNN, JTRIM
      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
      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 /'Days', 7*'Degrees', 3*'Gauss', '^16 /m/m',
     *   'Gauss', '^16 /m/m', 'Rad/m/m', 'Sec/m/m'/

      DATA CHTYPE /'Time', 'Hour angle', 'Azimuth', 'Zenith angle',
     *   'Ion azimuth', 'Ion zenith angle', 'Delta longitude',
     *   'Delta latitude', 'B radial', 'B east', 'B north',
     *   'Source TEC', 'Projected B', 'Vertical TEC', 'IFR',
     *   'Disp delay'/
C-----------------------------------------------------------------------
C                                       Time system from AN table
      SCOLOR = (XDO3C.GT.0.0) .AND. (CSMAX-CSMIN.GT.0.99)
      DOCOLR = SCOLOR
      OLDSRC = -1000.0
      NGOOD = 0
      NNOFIT = 0
      IRET = 3
      CATUP = T
C
      JCODE = ICODES(KK)
C                                       Create plot file
      IF (ABS (IPLOT).EQ.1) 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 = 77
         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
         IF (GR2CHN.GT.0) GPHTVG(1) = GR2CHN + NGRAY
         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)
         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) = 8
      IF (XVAR.GT.2) LABTYP(LOCNUM) = 0
      AXTYP(LOCNUM) = 0
      TR = 1.1 * (PRAN(2,2)-PRAN(1,2))
      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) - PRAN(1,I)
         XYSCL(I) = (XTRC(I) - XBLC(I)) / TR
         RPLOC(I,LOCNUM) = XBLC(I)
         RPVAL(I,LOCNUM) = XYOFF(I) * XMULT(I)
         AXINC(I,LOCNUM) = TR * XMULT(I) / (XTRC(I) - XBLC(I))
 50      CONTINUE
      CTYP(1,LOCNUM) = AUNITS(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) 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) = 3.333
         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
      CALL GLTYPE (1, 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 ((ABS(IPLOT).EQ.1) .AND. (LTYPE.GT.1) .AND. (LTYPE.LT.7)) THEN
         DX = 0.0
         DY = 1.833
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(JCODE)
         IF (NCODES.GT.1) TEXT = 'Multiple'
         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
            TEXT(INP:) = ' vs ' // CHTYPE(XVAR)
            INP = JTRIM (TEXT)
            TEXT(INP+1:) = ' for'
            INP = INP + 6
            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
C
         WRITE (TEXT(INP:),1010) TYPE, ITVER, TECTYP
         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 + 2 * 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
      TEXT(INP+1:) = STNNAM(ANTNO)
      CALL CHTRIM (TEXT, 132, TEXT, INCHAR)
      CALL REFRMT (TEXT, '_', INCHAR)
      CALL GICHAR (1, INCHAR, 0, DX, DY, TEXT, BUFFER, IERR)
      IF (IERR.NE.0) GO TO 970
C                                       type of plot
      IF (NCODES.GT.1) THEN
         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 = -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
      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
C                                       Outer loop: IF, stokes
      IP = 3 + KK
C                                       Point plot
      DO 120 NN = 1,NUMPTS(ANTNO)
         DONEG = (JCODE.GT.1) .AND. (JCODE.LT.9)
C                                       Scale X
         NNN = NN - 1 + FANREC(ANTNO)
         XY(1) = PLTPTS(3,NNN)
         IF ((SWAP) .AND. (XY(1).GT.180.0)) XY(1) = XY(1) - 360.0
         IF (XVAR.EQ.1) XY(1) = XY(1) * 360.0
         XY(1) = XYSCL(1) * (XY(1) - XYOFF(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                                       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) * (XY(2) - XYOFF(2)) + 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.
                  ELSE
                     VALUE = VALUE - 360.
                     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)
               CALL PNTPLT (ISYM, AX, AY, XBLC, XTRC, .FALSE.,
     *            DOCOLR, BUFFER, IERR)
               IF (IERR.NE.0) GO TO 970
               END IF
            END IF
 120     CONTINUE
C                                       Line plot
      IF (DOLINE) THEN
         BLNKD = .TRUE.
         DO 140 NN = 1,NUMPTS(ANTNO)
            DONEG = (JCODE.EQ.1) .OR. (JCODE.EQ.NCODE+1)
C                                       Scale X
            NNN = NN - 1 + FANREC(ANTNO)
            XY(1) = PLTPTS(3,NNN)
            IF (XVAR.EQ.1) XY(1) = XY(1) * 360.0
            XY(1) = XYSCL(1) * (XY(1) - XYOFF(1)) + 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) * (XY(2) - XYOFF(2)) + 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.
                     ELSE
                        VALUE = VALUE - 360.
                        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
         I = 3
         CALL GLTYPE (I, BUFFER, IERR)
         IF (IERR.NE.0) GO TO 970
         AY(1) = XYSCL(2) * (PRAN(1,2)-XYOFF(2)) + YYOFF(2)
         AY(2) = XYSCL(2) * (PRAN(2,2)-XYOFF(2)) + 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) * (TSCAN(I)*360.-XYOFF(1)) + 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
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.GT.0) .AND. (ABS(IPLOT).LT.NCOUNT)) GO TO 210
         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
 210  IF (IERR.GT.0) GO TO 975
         IRET = MIN (IERR, 0)
         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,' version',I4,'__ TECRtype ',A)
 1030 FORMAT ('Plot file version',I4,'__created ',A, A)
 1040 FORMAT (I3)
 1150 FORMAT ('Plotting',I4,' scan breaks')
 1200 FORMAT ('PLTTE:',I9,' points plotted')
 1202 FORMAT ('PLTTE:',I9,' points did not fit')
 1960 FORMAT ('PLTTE: ERROR DURING GRAPH FILE CREATION')
 1970 FORMAT ('PLTTE: ERROR DURING GRAPHING. WILL TRY TO FINISH ',
     *   'PARTIAL GRAPH')
      END
