LOCAL INCLUDE 'BPEPL.INC'
      INCLUDE 'INCS:PUVD.INC'
      REAL      XSEQ, XDISK, XVER, XFQ, XSUB, XTIME(8), XBCHAN, XECHAN,
     *   XBIF, XEIF, XANT(50), XDO3C, APARM(10), XLTYPE, XDOTV, XCHAN,
     *   XYRATO, XIMSIZ(2), XBADD(10)
      HOLLERITH XINNAM(3), XINCLS(2)
      CHARACTER INNAM*12, INCLS*6, TTYPE*2, IPOLC(2)*1
      COMMON /INPARM/ XINNAM, XINCLS, XSEQ, XDISK, XVER, XFQ, XSUB,
     *   XTIME, XBCHAN, XECHAN, XBIF, XEIF, XANT, XDO3C, APARM,
     *   XLTYPE, XDOTV, XCHAN, XYRATO, XIMSIZ, XBADD
      COMMON /CHPARM/ INNAM, INCLS, TTYPE, IPOLC
      INTEGER   INSEQ, INDISK, INVERS, CNO, IUSER, BIF, EIF, BPOL, EPOL,
     *   BCHAN, ECHAN, PBUFF(256), FQID, SUBARR, NPARMS, PLUN, PFIND,
     *   LABEL, IANTS(MAXANT), DO3COL, NIANTS, LTYPE, DOPLAN
      LOGICAL   DOTV
      DOUBLE PRECISION TIME, TIMBEG, TIMEND, TPLBEG, TPLEND
      REAL      ARANGE(2), PRANGE(2), SAPARM(10), COLV, DCOLV, AMAX,
     *   AMIN, PMAX, PMIN, BLC(7), TRC(7)
      COMMON /BPEPLC/ TIME, TIMBEG, TIMEND, TPLBEG, TPLEND, PBUFF,
     *   INSEQ, INDISK, INVERS, CNO, IUSER, BIF, EIF, BPOL, EPOL, BCHAN,
     *   ECHAN, FQID, SUBARR, NPARMS, PLUN, PFIND, LABEL, IANTS, ARANGE,
     *   DO3COL, NIANTS, LTYPE, PRANGE, SAPARM, DOPLAN, AMIN, AMAX,
     *   PMIN, PMAX, DOTV, COLV, DCOLV, BLC, TRC
      INCLUDE 'INCS:DBPC.INC'
LOCAL END
      PROGRAM BPEPL
C-----------------------------------------------------------------------
C! Plots bandpass table profiles with times overlapped
C# EXT-appl Calibration Plot
C-----------------------------------------------------------------------
C;  Copyright (C) 2020-2021, 2024
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   Plots bandpass table with times overlapping
C   Inputs from user
C      USERID.....Input file user number.  ignored
C                 32000 => any user.
C      INNAME.....Input UV file name (name).      Standard defaults.
C      INCLASS....Input UV file name (class).     Standard defaults.
C      INSEQ......Input UV file name (seq. #).    0 => highest.
C      INDISK.....Disk drive # of input UV file.  0 => any.
C      INVERS.....Specifies the version of the BP table to be read as
C                 input.   0 -> highest.
C                 The output version is always highest + 1.
C      FREQID.....Frequency ID, 0 -> 1
C      SUBARRAY...Limit to subarray #.
C      TIMERANG...Time range
C      BCHAN......Lowest channel of a range of channels to be plotted.
C                 0 => 1.
C      ECHAN......Highest channel number to be plotted.  0 => highest.
C      BIF........Lowest IF to be plotted.  0 => 1
C      EIF........Highest IF to be plotted.  0 => highest.
C      ANTENNAS...List of antennas to do
C      CROWDED....> 0 overplot all times
C      DO3COLOR...> 0 use color to separate times
C      APARM......(1,2) amplitude range; (3,4) phase range
C      LTYPE......Labelling type: 1 = border, 2 = no ticks, 3 or 7 =
C                 standard, 4 or 8 = relative to ref. pixel, 5 or 9 =
C                 relative to subimage (BLC, TRC) center, 6 or 10 =
C                 pixels. 7-10 all labels other than tick numbers and
C                 axis type are omitted.  Less than 0 is the same except
C                 that the plot file version number and create time are
C                 omitted.
C      DOTV.......> 0 => plot directly on the TV device, otherwise make
C                 plot files for later display on one or more devices
C                 (including the TV if desired).
C      GRCHAN.....Graphics channel (1 - 7) to use for line drawing.
C                 0 => 1.
C      BADDISK....Disks to avoid
C-----------------------------------------------------------------------
      INTEGER   IRET
      INCLUDE 'INCS:DDCH.INC'
      INCLUDE 'INCS:DHDR.INC'
      INCLUDE 'INCS:DMSG.INC'
      INCLUDE 'INCS:DFIL.INC'
      INCLUDE 'INCS:DCAT.INC'
      INCLUDE 'BPEPL.INC'
C-----------------------------------------------------------------------
C                                       Get parms, open things
      CALL BPEPLI (IRET)
C                                       do plotting
      IF (IRET.EQ.0) CALL BPEPLT (IRET)
C                                       close down
      CALL DIE (IRET, PBUFF)
C
 999  STOP
      END
      SUBROUTINE BPEPLI (IERR)
C-----------------------------------------------------------------------
C   BPEPLI performs initialization for AIPS task BPEPL.  It gets the
C   adverbs, opens the catalog file for 'READ' (eventually), sorts and
C   opens the BP input file, and determines which FQs, times, and
C   antenna counts apply to the table.
C   Output:
C      IERR    I      Error code: 0 => keep going, else quit.
C-----------------------------------------------------------------------
      INTEGER   IERR
C
      INCLUDE 'BPEPL.INC'
      CHARACTER INTYP*2, STAT*4, PRGN*6, KEYSBP(2)*24, LTYPBP*8
      INTEGER   IROUND, BPLUN, JERR, J, KEY(2,2), NKEY, KOLS(2), J1, J2,
     *   KEYSUB(2,2), I, IST, DROUND
      REAL      FKEY(2,2), TEMP
      INCLUDE 'INCS:DMSG.INC'
      INCLUDE 'INCS:DDCH.INC'
      INCLUDE 'INCS:DFIL.INC'
      INCLUDE 'INCS:DCAT.INC'
      INCLUDE 'INCS:DUVH.INC'
      INCLUDE 'INCS:DHDR.INC'
      DATA BPLUN, INTYP /27, 'UV'/
      DATA PRGN /'BPEPL '/
      DATA NKEY /2/
      DATA FKEY /1.0,0.0, 1.0,0.0/
      DATA KEYSUB /4*1/
      DATA KEYSBP /'ANTENNA ', 'TIME '/
C-----------------------------------------------------------------------
C                                       AIPS init
      CALL ZDCHIN (.TRUE.)
      CALL VHDRIN
      NCFILE = 0
      NSCR = 0
C                                       get adverbs
      NPARMS = 99
      IERR = 0
      CALL GTPARM (PRGN, NPARMS, RQUICK, XINNAM, BPBUFF, JERR)
      IF (JERR.NE.0) THEN
         RQUICK = .TRUE.
         IERR = 8
         IF (JERR.EQ.1) THEN
            GO TO 999
         ELSE
            WRITE (MSGTXT,1000) JERR, 'GET INPUT ADVERBS'
            CALL MSGWRT (8)
            END IF
         END IF
C                                       restart AIPS
      IF (RQUICK) CALL RELPOP (IERR, BPBUFF, JERR)
      IF (IERR.NE.0) GO TO 999
C                                       Hollerith -> Char
      CALL H2CHR (12, 1, XINNAM, INNAM)
      CALL H2CHR (6, 1, XINCLS, INCLS)
      INSEQ = IROUND (XSEQ)
      INDISK = IROUND (XDISK)
      INVERS = IROUND (XVER)
      IUSER = NLUSER
      CNO = 1
      CALL CATDIR ('SRCH', INDISK, CNO, INNAM, INCLS, INSEQ, INTYP,
     *   IUSER, STAT, BPBUFF, IERR)
      IF (IERR.NE.0) THEN
         WRITE (MSGTXT,1010) IERR, INNAM, INCLS, INSEQ, INTYP,
     *      INDISK, IUSER
         GO TO 990
         END IF
C                                       Get catblk, mark file write
      CALL CATIO ('READ', INDISK, CNO, CATBLK, 'WRIT', BPBUFF, IERR)
      IF (IERR.NE.0) THEN
         WRITE (MSGTXT,1000) IERR, 'READ CATALOG HEADER'
         GO TO 990
         END IF
      NCFILE = 1
      FVOL(1) = INDISK
      FCNO(1) = CNO
      FRW(1) = 1
      DO3COL = IROUND (XDO3C)
      IF (XDO3C.GT.0.0) DO3COL = MAX (1, DO3COL)
      DO 5 I = 1,10
         IBAD(I) = XBADD(I) + 0.5
 5       CONTINUE
      CALL UVPGET (IERR)
      IST = DROUND (CATD(KDCRV+JLOCS))
      IPOLC(1) = '?'
      IPOLC(2) = '?'
      IF (IST.GT.0) THEN
         IPOLC(1) = 'I'
      ELSE IF (IST.EQ.-1) THEN
         IPOLC(1) = 'R'
         IPOLC(2) = 'L'
      ELSE IF (IST.EQ.-2) THEN
         IPOLC(1) = 'L'
      ELSE IF (IST.EQ.-5) THEN
         IPOLC(1) = 'X'
         IPOLC(2) = 'Y'
      ELSE IF (IST.EQ.-6) THEN
         IPOLC(1) = 'Y'
         END IF
C                                       Open BP file
      TTYPE = 'BP'
      CALL BPREFM (INDISK, CNO, INVERS, CATBLK, BPLUN, IERR)
      IF (IERR.NE.0) GO TO 999
      CALL BPINI ('READ', BPBUFF, INDISK, CNO, INVERS, CATBLK, BPLUN,
     *   IBPRNO, BPKOLS, BPNUMV, NANTBP, NPOLBP, NIFBP, NCHNBP,
     *   BCHNBP, NUMSHF, LOWSHF, DELSHF, LTYPBP, IERR)
      IF (IERR.GT.0) THEN
         WRITE (MSGTXT,1000) IERR, 'OPEN INPUT BP TABLE'
         GO TO 990
         END IF
      WPOLY = LTYPBP.NE.' '
      XVER = INVERS
C                                       Set column pointers for sort
      CALL FNDCOL (NKEY, KEYSBP, 24, .TRUE., BPBUFF, KOLS, IERR)
      IF (IERR.GT.0) THEN
         WRITE (MSGTXT,1000) IERR, 'FIND BP COLUMNS'
         GO TO 990
         END IF
C                                       Sort to ant-time order
      J1 = 1
      J2 = 2
      IF ((BPBUFF(43).NE.KOLS(J1)) .OR. (BPBUFF(44).NE.KOLS(J2)))
     *   THEN
C                                       Close
         CALL TABIO ('CLOS', 0, IBPRNO, BPBUFF, BPBUFF, IERR)
         IF (IERR.GT.0) THEN
            WRITE (MSGTXT,1000) IERR, 'CLOSE BP TABLE'
            GO TO 990
            END IF
C                                       sort
         KEY(1,1) = KOLS(J1)
         KEY(2,1) = KOLS(J1)
         KEY(1,2) = KOLS(J2)
         KEY(2,2) = KOLS(J2)
         CALL TABSRT (INDISK, CNO, 'BP', INVERS, INVERS, KEY, KEYSUB,
     *      FKEY, BPBUFF, CATBLK, IERR)
         IF (IERR.GT.0) THEN
            WRITE (MSGTXT,1000) IERR, 'SORT BP TABLE'
            GO TO 990
            END IF
C                                       Re-open BP table for read
         CALL BPINI ('READ', BPBUFF, INDISK, CNO, INVERS, CATBLK,
     *      BPLUN, IBPRNO, BPKOLS, BPNUMV, NANTBP, NPOLBP, NIFBP,
     *      NCHNBP, BCHNBP, NUMSHF, LOWSHF, DELSHF, LTYPBP, IERR)
         IF (IERR.GT.0) THEN
            WRITE (MSGTXT,1000) IERR, 'OPEN SORTED BP TABLE'
            GO TO 990
            END IF
         END IF
C                                      number of records
      NBPINR = BPBUFF(5)
      BPOL = 1
      EPOL = NPOLBP
      CALL RCOPY (10, APARM, SAPARM)
      BCHAN = IROUND (XBCHAN)
      BCHAN = MAX (1, MIN (BCHAN, NCHNBP))
      ECHAN = IROUND (XECHAN)
      IF ((ECHAN.LE.BCHAN) .OR. (ECHAN.GT.NCHNBP)) ECHAN = NCHNBP
      XBCHAN = BCHAN
      XECHAN = ECHAN
      BIF = IROUND (XBIF)
      BIF = MAX (1, MIN (BIF, NIFBP))
      EIF = IROUND (XEIF)
      IF ((EIF.LT.BIF) .OR. (EIF.GT.NIFBP)) EIF = NIFBP
      XBIF = BIF
      XEIF = EIF
      ARANGE(1) = APARM(1)
      ARANGE(2) = APARM(2)
      PRANGE(1) = APARM(3)
      PRANGE(2) = APARM(4)
      TIMBEG = ((XTIME(4)/60.0 + XTIME(3)) / 60.0 + XTIME(2)) / 24.0 +
     *   XTIME(1)
      TIMEND = ((XTIME(8)/60.0 + XTIME(7)) / 60.0 + XTIME(6)) / 24.0 +
     *   XTIME(5)
      TPLBEG = TIMBEG
      TPLEND = TIMEND
      IF ((TIMEND.LE.TIMBEG) .OR. (TIMEND.LE.0.0)) THEN
         TIMEND = 9999.
         TIMBEG = -100.
         END IF
      IF (TPLEND.EQ.TPLBEG) THEN
         TPLEND = 9999.
         TPLBEG = -100.0
      ELSE IF (TPLEND.LT.TPLBEG) THEN
         TEMP = TPLEND
         TPLEND = TPLBEG
         TPLBEG = TEMP
         END IF
      FQID = IROUND (XFQ)
      IF (FQID.LE.0) FQID = 1
      SUBARR = IROUND (XSUB)
      IF (SUBARR.LE.0) SUBARR = 1
      LABEL = IROUND (XLTYPE)
      CALL FILL (MAXANT, 0, IANTS)
      CALL FILL (NANTBP, 1, IANTS)
      J1 = 0
      DO 10 J = 1,50
         J2 = IROUND (XANT(J))
         IF (J2.LT.0) THEN
            J1 = J2
         ELSE IF (J1.GE.0) THEN
            J1 = MAX (J1, J2)
            END IF
 10      CONTINUE
C                                       none negative, some > 0
      NIANTS = NANTBP
      IF (J1.GT.0) THEN
         NIANTS = 0
         CALL FILL (NANTBP, 0, IANTS)
         DO 20 J = 1,50
            J2 = IROUND (XANT(J))
            IF ((J2.GT.0) .AND. (J2.LE.NANTBP)) THEN
               IF (IANTS(J2).LE.0) NIANTS = NIANTS + 1
               IANTS(J2) = 1
               END IF
 20         CONTINUE
C                                       some negative
      ELSE IF (J1.LT.0) THEN
         DO 30 J = 1,50
            J2 = IROUND (ABS (XANT(J)))
            IF ((J2.GT.0) .AND. (J2.LE.NANTBP)) THEN
               IF (IANTS(J2).GT.0) NIANTS = NIANTS - 1
               IANTS(J2) = 0
               END IF
 30         CONTINUE
         END IF
      GO TO 999
C
 990  CALL MSGWRT (8)
C
 999  RETURN
C-----------------------------------------------------------------------
 1000 FORMAT ('BPEPLI: ERROR',I5,' ON ',A)
 1010 FORMAT ('ERROR',I3,' FINDING ',A12,'.',A6,'.',I3,1X,A2,
     *   'DISK=',I2,' USER=',I5)
      END
      SUBROUTINE BPEPLT (IERR)
C-----------------------------------------------------------------------
C   BPEPLT uses the open BP table to generate the plots.
C   Output:
C      IERR   I   Error code
C-----------------------------------------------------------------------
      INTEGER   IERR
C
      INCLUDE 'BPEPL.INC'
      CHARACTER PFILE*48, FUNC*12
      INTEGER   I, J, J1, J2, NREC, SOURID, SUBA, ANTNO, FREQID, IP, IA,
     *   BPREF(2), JERR, ANTS(MAXANT), THEANT, IIF, IIC, IIP, MREC,
     *   LINE, TVCHN, GRCHN, TVCORN(2), IVER, IROUND, NP, NX, NY, NZ,
     *   ITYPE, NPLOT, NRECI, NRECC, KREC, INIANT, K, TVPLAN(2)
      REAL      TIMES(20000), INTERV, WT, LMAX, BNDPAS(2,MAXCIF), XT,
     *   WEIGHT(2*MAXIF), DX, X0, Y0, SCALE, X, Y, PLPTS(2,MAXCIF+100),
     *   COL(3), PPMAX, PPMIN, A, P, LMIN
      LOGICAL   LBLANK, SPHASE
      LONGINT   PTVPLN
      DOUBLE PRECISION TTIME, DTIME
      INCLUDE 'INCS:DMSG.INC'
      INCLUDE 'INCS:DCAT.INC'
      INCLUDE 'INCS:DDCH.INC'
      INCLUDE 'INCS:DGPH.INC'
      INCLUDE 'INCS:PSTD.INC'
C-----------------------------------------------------------------------
      DTIME = 5. / 60.0 / 24.0
      IIP = BPOL - 1
      INIANT = NIANTS
 5    IIP = IIP + 1
      IF (IIP.GT.EPOL) GO TO 350
      J2 = 0
      NPLOT = 0
      NIANTS = INIANT
      LTYPE = MOD (ABS(LABEL), 100)
C                                       loop for next plot
 10   J1 = J2 + 1
C                                       find range of desired data
         NREC = 0
         KREC = 0
         MREC = 0
         DO 90 J = J1,NBPINR
            IBPRNO = J
            CALL TABBP ('READ', BPBUFF, IBPRNO, BPKOLS, BPNUMV, NIFBP,
     *         NCHNBP, NPOLBP, TIME, INTERV, SOURID, SUBA, ANTNO,
     *         CHNBND, BPFREQ, FREQID, BPREF, WEIGHT, BNDPAS, IERR)
            IF (IERR.GT.0) THEN
               WRITE (MSGTXT,1000) IERR, 'READ BP TABLE'
               GO TO 990
               END IF
            IF (((FREQID.EQ.FQID) .OR. (FREQID.LE.0)) .AND.
     *         ((SUBA.EQ.SUBARR) .OR. (SUBA.LE.0)) .AND.
     *         (TIME.GE.TIMBEG) .AND. (TIME.LE.TIMEND) .AND.
     *         (IANTS(ANTNO).GT.0)) THEN
               IF (NREC.EQ.0) THEN
                  J1 = J
                  KREC = 0
                  THEANT = ANTNO
                  CALL FILL (MAXANT, 0, ANTS)
                  TTIME = TIME
                  AMAX = -1.E10
                  AMIN = -AMAX
                  PPMAX = AMAX
                  PPMIN = AMIN
                  PMAX = AMAX
                  PMIN = AMIN
                  END IF
               IF (ANTNO.NE.THEANT) GO TO 100
C                                       check for valid data
               DO 14 IIF = BIF,EIF
                  I = IIF + (IIP - 1) * NIFBP
                  WT = WEIGHT(I)
                  IF (WT.LE.0) GO TO 14
                  I = (IIP - 1) * NCHNBP * NIFBP + (IIF - 1) *
     *               NCHNBP + BCHAN - 1
                  DO 13 IIC = BCHAN,ECHAN
                     I = I + 1
                     IF (BNDPAS(1,I).NE.FBLANK) GO TO 18
 13                  CONTINUE
 14               CONTINUE
               J2 = J
               ANTS(ANTNO) = J
               IF ((TIME.GE.TPLBEG) .AND. (TIME.LE.TPLEND)) THEN
                  KREC = KREC + 1
                  TIMES(KREC) = TIME
                  END IF
               GO TO 90
 18            MREC = MREC + 1
               ANTS(ANTNO) = J
               J2 = J
               IF ((TIME.GE.TPLBEG) .AND. (TIME.LE.TPLEND)) THEN
                  NREC = NREC + 1
                  KREC = KREC + 1
                  TIMES(KREC) = TIME
                  END IF
C                                       or find max/min
               IF ((ARANGE(2).LE.ARANGE(1)) .OR.
     *            (PRANGE(2).LE.PRANGE(1))) THEN
                  DO 45 IIF = BIF,EIF
                     I = IIF + (IIP - 1) * NIFBP
                     WT = WEIGHT(I)
                     IF (WT.LE.0) GO TO 45
                     I = (IIP - 1) * NCHNBP * NIFBP + (IIF - 1) *
     *                  NCHNBP + BCHAN - 1
                     DO 40 IIC = BCHAN,ECHAN
                        I = I + 1
                        IF (BNDPAS(1,I).NE.FBLANK) THEN
                           A = SQRT (BNDPAS(1,I)**2 + BNDPAS(2,I)**2)
                           P = 0.0
                           IF ((BNDPAS(1,I).NE.0.0) .OR.
     *                        (BNDPAS(2,I).NE.0.0)) P = RAD2DG *
     *                        ATAN2 (BNDPAS(2,I), BNDPAS(1,I))
                           AMAX = MAX (A, AMAX)
                           AMIN = MIN (A, AMIN)
                           PMAX = MAX (P, PMAX)
                           PMIN = MIN (P, PMIN)
                           IF (P.LT.0.0) P = P + 360.0
                           PPMAX = MAX (P, PPMAX)
                           PPMIN = MIN (P, PPMIN)
                           END IF
 40                     CONTINUE
 45                  CONTINUE
                  END IF
               END IF
 90         CONTINUE
C                                       Found no more data
 100     IF (MREC.LE.0) THEN
            MSGTXT = 'Done with all selected data this polarization'
            CALL MSGWRT (2)
            IF (NPLOT.GT.0) THEN
               IERR = 0
            ELSE
               IERR = 1
               MSGTXT = 'But no plots were done'
               CALL MSGWRT (7)
               END IF
            GO TO 5
            END IF
C                                       found data but no plot
         IF (NREC.EQ.0) THEN
            IF (J2.LT.NBPINR) GO TO 10
            GO TO 350
            END IF
         NREC = KREC
C                                       set scale, blank array
         I = MAXCIF + 100
         IF (PRANGE(2).GT.PRANGE(1)) THEN
            PMIN = PRANGE(1)
            PMAX = PRANGE(2)
            SPHASE = PMIN.GE.0.0
         ELSE
            IF (PMAX-PMIN.LE.PPMAX-PPMIN) THEN
               SPHASE = .FALSE.
            ELSE
               PMIN = PPMIN
               PMAX = PPMAX
               SPHASE = .TRUE.
               END IF
            END IF
         IF (PMIN.EQ.PMAX) THEN
            IF (PMIN.EQ.0.0) THEN
               PMAX = 1.
               PMIN = -1.
            ELSE
               PMAX = 1.03 * PMIN
               PMIN = 0.97 * PMIN
               END IF
            END IF
         IF (ARANGE(2).GT.ARANGE(1)) THEN
            AMIN = ARANGE(1)
            AMAX = ARANGE(2)
            END IF
C                                       now init the plot
         APARM(1) = AMIN
         APARM(2) = AMAX
         APARM(3) = PMIN
         APARM(4) = PMAX
         IF ((APARM(5).LT.0.1) .OR. (APARM(5).GT.0.9)) APARM(5) = 0.3
         DOTV = XDOTV.GT.0.0
         IF (DOTV) THEN
            DOPLAN = 1
            IF (DO3COL.GT.0) DOPLAN = 2
         ELSE
            DOPLAN = 3
            IF (DO3COL.GE.0) DOPLAN = 4
            END IF
         IF (APARM(6).LE.0.0) DOPLAN = 0
         TVCHN = 0
         TVCORN(1) = 0
         TVCORN(2) = 0
         GRCHN = IROUND (XCHAN)
         PLUN = 26
         IVER = 0
         IF (.NOT.DOTV) THEN
            CALL MADDEX ('PL', INDISK, CNO, CATBLK, PBUFF, .TRUE.,
     *         'WRIT', IVER, IERR)
            IF (IERR.NE.0) THEN
               WRITE (MSGTXT,1000) IERR, 'CREATE PLOT FILE'
               CALL MSGWRT (7)
               GO TO 999
               END IF
            END IF
C                                       gridded image
         DCOLV = 0.97 / MAX (1, NREC-1)
         COLV = 0.0
         IF (APARM(6).LE.0.0) THEN
            NX = 0
            NY = 0
            NZ = 0
         ELSE
            CALL PLPLAN (NX, NY, NZ, TVPLAN, PTVPLN, THEANT, IIP, IVER,
     *         J1, J2, SPHASE, IERR)
            IF (IERR.NE.0) GO TO 999
            END IF
         XIMSIZ(1) = NX
         XIMSIZ(2) = NY
C                                       time/antenna adverbs to match
C                                       one time
         CALL RFILL (8, 0.0, XTIME)
C                                       one antenna
         XTIME(1) = TPLBEG
         XTIME(5) = TPLEND
         APARM(9) = THEANT
         APARM(10) = IIP
         CALL ZPHFIL ('PL', INDISK, CNO, IVER, PFILE, IERR)
         ITYPE = 71
         CALL GINIT (INDISK, CNO, PFILE, 0, ITYPE, NPARMS, XINNAM, DOTV,
     *      TVCHN, GRCHN, TVCORN, CATBLK, PBUFF, PLUN, PFIND, IERR)
         FUNC = 'GINIT'
         IF (IERR.NE.0) GO TO 900
         CALL BPLABL (IVER, THEANT, IIP, NX, NY, NZ, TVPLAN(1+PTVPLN),
     *      IERR)
         FUNC = 'BPLABL'
         IF (IERR.NE.0) GO TO 900
         IF (NX.GT.0) THEN
            CALL ZMEMRY ('FRAL', 'PLPLAN', J, TVPLAN, PTVPLN, IERR)
            GO TO 300
            END IF
         NP = (EIF-BIF+1)
         DX = NP*(ECHAN-BCHAN+4)
         DX = 1000.0 / DX
         X0 = DX / 2.0
         Y0 = 0.0
         XT = MAX (X0, 17.5)
         COLV = 0.0
C                                       get the data part
         MREC = J2 - J1 + 1
         IA = 0
         LINE = 0
         NRECC = 0
         NRECI = MAX (1, NREC / 20)
         DO 290 J = 1,MREC
            IBPRNO = J + J1 - 1
            CALL TABBP ('READ', BPBUFF, IBPRNO, BPKOLS, BPNUMV, NIFBP,
     *         NCHNBP, NPOLBP, TIME, INTERV, SOURID, SUBA, ANTNO,
     *         CHNBND, BPFREQ, FREQID, BPREF, WEIGHT, BNDPAS, IERR)
            IF (IERR.GT.0) THEN
               WRITE (MSGTXT,1000) IERR, 'READ BP TABLE'
               GO TO 990
               END IF
            IF (((FREQID.EQ.FQID) .OR. (FREQID.LE.0)) .AND.
     *         ((SUBA.EQ.SUBARR) .OR. (SUBA.LE.0)) .AND.
     *         (TIME.GE.TPLBEG) .AND. (TIME.LE.TPLEND) .AND.
     *         (IANTS(ANTNO).GT.0)) THEN
               NRECC = NRECC + 1
               IF (DO3COL.GT.0) THEN
                  CALL COLOR3 (COLV, .FALSE., COL)
                  COLV = COLV + DCOLV
                  CALL G3VCOL (COL(1), COL(2), COL(3), PBUFF, IERR)
                  FUNC = 'G3VCOL'
                  IF (IERR.NE.0) GO TO 900
                  END IF
               IP = 0
               LINE = LINE + 1
               DO 235 IIF = BIF,EIF
                  I = IIF + (IIP - 1) * NIFBP
                  WT = WEIGHT(I)
                  I = (IIP - 1) * NCHNBP * NIFBP + (IIF - 1) *
     *               NCHNBP + BCHAN - 1
                  IP = IP + 1
                  PLPTS(1,IP) = FBLANK
                  PLPTS(2,IP) = FBLANK
                  DO 230 IIC = BCHAN,ECHAN
                     I = I + 1
                     IP = IP + 1
                     A = FBLANK
                     P = FBLANK
                     IF ((WT.GT.0.0) .AND. (BNDPAS(1,I).NE.FBLANK)) THEN
                        P = 0.0
                        A =  SQRT (BNDPAS(1,I)**2 + BNDPAS(2,I)**2)
                        IF ((BNDPAS(1,I).NE.0.0) .OR.
     *                     (BNDPAS(2,I).NE.0.0)) THEN
                           P = ATAN2 (BNDPAS(2,I), BNDPAS(1,I)) * RAD2DG
                           IF ((SPHASE) .AND. (P.LT.0.0))
     *                         P = P + 360.0
                           END IF
                        IF ((A.NE.FBLANK) .AND. ((A.LT.AMIN) .OR.
     *                     (A.GT.AMAX))) A = FBLANK
                        IF ((P.NE.FBLANK) .AND. ((P.LT.PMIN) .OR.
     *                     (P.GT.PMAX))) P = FBLANK
                        END IF
                     PLPTS(1,IP) = A
                     PLPTS(2,IP) = P
 230                 CONTINUE
                  IP = IP + 1
                  PLPTS(1,IP) = FBLANK
                  PLPTS(2,IP) = FBLANK
                  IP = IP + 1
                  PLPTS(1,IP) = FBLANK
                  PLPTS(2,IP) = FBLANK
 235              CONTINUE
C                                       Do the plot now
               SCALE = 1000.0 * (1.0 - APARM(5)) / (AMAX - AMIN)
               CALL GLTYPE (2, PBUFF, IERR)
               FUNC = 'GLTYPE'
               IF (IERR.NE.0) GO TO 900
               Y0 = 0.0
               LMAX = AMAX
               LMIN = AMIN
               DO 260 K = 1,2
                  LBLANK = .TRUE.
                  X = X0
                  DO 250 I = 1,IP
                     IF (PLPTS(K,I).EQ.FBLANK) THEN
                        LBLANK = .TRUE.
                        X = X + DX
                     ELSE
                        Y = Y0 + (PLPTS(K,I)-LMIN) * SCALE
                        IF (LBLANK) THEN
                           CALL GPOS (X, Y, PBUFF, IERR)
                        ELSE IF (DO3COL.GT.0) THEN
                           CALL G3VEC (X, Y, PBUFF, IERR)
                        ELSE
                           CALL GVEC (X, Y, PBUFF, IERR)
                           END IF
                        FUNC = 'GVEC'
                        IF (IERR.NE.0) GO TO 900
                        LBLANK = .FALSE.
                        X = X + DX
                        END IF
                     IF (IERR.NE.0) GO TO 900
 250                 CONTINUE
                  LMAX = PMAX
                  LMIN = PMIN
                  SCALE = 1000.0 * APARM(5) / (PMAX - PMIN)
                  Y0 = 1000.0 * (1.0 - APARM(5))
 260              CONTINUE
               END IF
 290        CONTINUE
C                                       finish plot and continue?
 300     NIANTS = NIANTS - 1
         GPHPAG = (DOTV) .AND. (((J2.LT.NBPINR) .AND. (NIANTS.GT.0))
     *      .OR. (IIP.LT.EPOL))
         CALL GFINIS (PBUFF, IERR)
C                                       Successful plot file finished.
         IF (IERR.EQ.0) THEN
            NPLOT = NPLOT + 1
            IF (.NOT.DOTV) THEN
               CALL HIPLOT (INDISK, CNO, IVER, PBUFF, IERR)
               WRITE (MSGTXT,1290) IVER
               CALL MSGWRT (5)
               IERR = 0
               END IF
            END IF
C                                       loop
         IF (IERR.EQ.0) THEN
            IF (J2.LT.NBPINR) GO TO 10
            IF (IIP.LT.EPOL) GO TO 5
            END IF
 350  IERR = MAX (0, IERR)
C                                       close
      CALL TABBP ('CLOS', BPBUFF, IBPRNO, BPKOLS, BPNUMV, NIFBP, NCHNBP,
     *   NPOLBP, TIME, INTERV, SOURID, SUBA, ANTNO, CHNBND, BPFREQ,
     *   FREQID, BPREF, WEIGHT, BNDPAS, JERR)
      GO TO 999
C                                       plotter error
 900  WRITE (MSGTXT,1900) IERR, FUNC
      CALL MSGWRT (8)
      MSGTXT = 'WILL TRY TO SAVE PARTIAL GRAPH'
      CALL MSGWRT (8)
      GPHPAG = .FALSE.
      CALL GFINIS (PBUFF, I)
      GO TO 999
C
 990  CALL MSGWRT (8)
C
 999  RETURN
C-----------------------------------------------------------------------
 1000 FORMAT ('BPEPLT: ERROR',I5,' ON ',A)
 1290 FORMAT ('Successful plot file version',I5,' written')
 1900 FORMAT ('PLOTTING ERROR',I5,' AT ',A)
      END
      SUBROUTINE PLPLAN (NX, NY, NZ, TVPLAN, PTVPLN, THEANT, IIP, IVER,
     *   J1, J2, SPHASE, IERR)
C-----------------------------------------------------------------------
C   PLPLAN creates a plot grid containing an image of the plot
C   Inputs:
C      THEANT   I      The current antenna number
C      IIP      I      The current polarization
C      IVER     I      the current plot file version
C      J1       I      start BP rec number
C      J2       I      end BP rec number
C      SPHASE   L      T => all P positive
C   Outputs:
C      NX       I      X dimension
C      NY       I      Y dimension
C      NZ       I      1 - B/W, 3 color
C      PTVPLN   LI     Pointer to dynamic memory
C      TVPLAN   I(*)   Memory
C      IERR     I      > 0 quit
C-----------------------------------------------------------------------
      INTEGER   NX, NY, NZ, TVPLAN(*), THEANT, IIP, IVER, J1, J2, IERR
      LONGINT   PTVPLN
      LOGICAL   SPHASE
C
      INCLUDE 'BPEPL.INC'
      INTEGER   ITYPE, NWORDS, NP, ICOL(3), MREC, IA, LINE, NRECC, K,
     *   I, J, SOURID, SUBA, ANTNO, FREQID, IP, IIF, IIC, BPREF(2),
     *   SCRTCH(256), GRCHN, IDEPTH(5), TVCHN, TVCORN(2), GRCOLS(3,8)
      CHARACTER PFILE*48, FUNC*8
      REAL      CH(4), XMIN, YMIN, DX, X0, Y0, WT, A, P, SCALE, X, Y,
     *   BNDPAS(2,MAXCIF), WEIGHT(2*MAXIF), PLPTS(2,MAXCIF+100), INTERV,
     *   LMAX, LMIN
      LOGICAL   LBLANK
      INCLUDE 'INCS:DMSG.INC'
      INCLUDE 'INCS:DCAT.INC'
      INCLUDE 'INCS:DDCH.INC'
      INCLUDE 'INCS:DGPH.INC'
      INCLUDE 'INCS:DTVC.INC'
      INCLUDE 'INCS:PSTD.INC'
      DATA TVCHN, IDEPTH, TVCORN /1, 5*1, 2*0/
      DATA GRCOLS /255,255,0, 16,255,0, 255,171,255, 0,255,255,
     *   255,45,45, 153,153,255, 255,204,102, 0,0,0/
C-----------------------------------------------------------------------
      GRCHN = XCHAN + 0.1
C                                       create plot file
      CALL ZPHFIL ('PL', INDISK, CNO, IVER, PFILE, IERR)
      ITYPE = 71
      CALL GINIT (INDISK, CNO, PFILE, 0, ITYPE, NPARMS, XINNAM, DOTV,
     *   TVCHN, GRCHN, TVCORN, CATBLK, PBUFF, PLUN, PFIND, IERR)
      FUNC = 'GINIT'
      IF (IERR.NE.0) GO TO 900
C                                       number characters around
      LTYPE = MOD (ABS(LABEL), 100)
      IF (LTYPE.EQ.0) LTYPE = 3
      IF (LABEL.GE.0) THEN
         LABEL = (LABEL/100)*100 + LTYPE
      ELSE
         LABEL = (LABEL/100)*100 - LTYPE
         END IF
      CALL RFILL (4, 0.5, CH)
      IF (LTYPE.EQ.2) CH(1) = 2.5
      IF (LTYPE.GT.2) CH(1) = 6.5
      IF (LTYPE.GT.1) CH(2) = 2.0
      IF (LTYPE.GT.2) CH(2) = CH(2) + 1.333
      IF ((LTYPE.GT.1) .AND. (LTYPE.LT.7)) THEN
         CH(2) = CH(2) + 2 * 1.333
         END IF
      IF (LTYPE.EQ.2) CH(3) = 2.5
      IF (LTYPE.GT.1) CH(4) = CH(4) + 1.5
      IF ((LABEL.GT.1) .AND. (LTYPE.LT.7)) CH(4) = CH(4) + 1.333
C                                       Set BLC, TRC, XYRATO.
      BLC(2) = 0.0
      BLC(1) = 0.0
      TRC(1) = 1000.0
      TRC(2) = 1000.0
      IF ((XIMSIZ(1).GT.100.) .AND. (XIMSIZ(2).GT.100.) .AND.
     *   (.NOT.DOTV)) CALL RCOPY (2, XIMSIZ, TRC)
C                                       default XYRATIO
      IF (XYRATO.LT.0.01) THEN
         IF (XDOTV.GT.0.0) THEN
            XMIN = WINDTV(3) - WINDTV(1) + 1 - CSIZTV(1) * (CH(1)+CH(3))
            YMIN = WINDTV(4) - WINDTV(2) + 1 - CSIZTV(2) * (CH(2)+CH(4))
            XYRATO = 1.0
            IF (YMIN.GT.0.0) XYRATO = XMIN / YMIN
         ELSE
            XYRATO = 1.0
            END IF
         END IF
C                                       Initialize plot file line drw.
      CALL GINITL (BLC, TRC, XYRATO, CH, IDEPTH, PBUFF, IERR)
      IF (IERR.NE.0) GO TO 999
C                                       get memory
      IF (DOTV) THEN
         NX = GPHSCX + 1.01
         NY = GPHSCY + 1.01
      ELSE
         NX = TRC(1) - BLC(1) + 1.01
         NY = TRC(2) - BLC(2) + 1.01
         END IF
      NZ = 1
      IF (MOD(DOPLAN,2).EQ.0) NZ = 3
      NWORDS = (NX * NY * NZ - 1) / 1024 + 4
      CALL ZMEMRY ('GET ', 'PLPLAN', NWORDS, TVPLAN, PTVPLN, IERR)
      IF (IERR.NE.0) THEN
         MSGTXT = 'UNABLE TO GET DYNAMIC MEMORY'
         CALL MSGWRT (8)
         PTVPLN = 0
         NX = 0
         NY = 0
         NZ = 0
         IERR = 0
         GO TO 999
         END IF
      NWORDS = NX * NY * NZ
      CALL FILL (NWORDS, 0, TVPLAN(1+PTVPLN))
C                                       start plot
      NP = (EIF-BIF+1)
      DX = NP*(ECHAN-BCHAN+4)
      DX = (TRC(1)-BLC(1)) / DX
      X0 = DX / 2.0
      Y0 = 0.0
      I = MOD (GRCHN, 10)
      IF (I.LE.0) I = 4
      IF (NZ.EQ.3) THEN
         IF (MAXINT.LE.0) MAXINT = 8191
         ICOL(1) = GRCOLS(1,I) / 256.0 * MAXINT
         ICOL(2) = GRCOLS(2,I) / 256.0 * MAXINT
         ICOL(3) = GRCOLS(3,I) / 256.0 * MAXINT
      ELSE
         ICOL(1) = 32767
         ICOL(2) = 0
         ICOL(3) = 0
         END IF
C                                       get the data part
      MREC = J2 - J1 + 1
      IA = 0
      LINE = 0
      NRECC = 0
      DO 290 J = 1,MREC
         IBPRNO = J + J1 - 1
         CALL TABBP ('READ', BPBUFF, IBPRNO, BPKOLS, BPNUMV, NIFBP,
     *      NCHNBP, NPOLBP, TIME, INTERV, SOURID, SUBA, ANTNO,
     *      CHNBND, BPFREQ, FREQID, BPREF, WEIGHT, BNDPAS, IERR)
         IF (IERR.GT.0) THEN
            WRITE (MSGTXT,1000) IERR, 'READ BP TABLE'
            GO TO 990
            END IF
         IF (((FREQID.EQ.FQID) .OR. (FREQID.LE.0)) .AND.
     *      ((SUBA.EQ.SUBARR) .OR. (SUBA.LE.0)) .AND.
     *      (TIME.GE.TPLBEG) .AND. (TIME.LE.TPLEND) .AND.
     *      (IANTS(ANTNO).GT.0)) THEN
            NRECC = NRECC + 1
            IF (DO3COL.GT.0) THEN
               CALL PLCOL3 (COLV, ICOL)
               COLV = COLV + DCOLV
               END IF
            IP = 0
            LINE = LINE + 1
            DO 235 IIF = BIF,EIF
               I = IIF + (IIP - 1) * NIFBP
               WT = WEIGHT(I)
               I = (IIP - 1) * NCHNBP * NIFBP + (IIF - 1) *
     *            NCHNBP + BCHAN - 1
               IP = IP + 1
               PLPTS(1,IP) = FBLANK
               PLPTS(2,IP) = FBLANK
               DO 230 IIC = BCHAN,ECHAN
                  I = I + 1
                  IP = IP + 1
                  A = FBLANK
                  P = FBLANK
                  IF ((WT.GT.0.0) .AND. (BNDPAS(1,I).NE.FBLANK)) THEN
                     P = 0.0
                     A =  SQRT (BNDPAS(1,I)**2 + BNDPAS(2,I)**2)
                     IF ((BNDPAS(1,I).NE.0.0) .OR.
     *                  (BNDPAS(2,I).NE.0.0)) THEN
                        P = ATAN2 (BNDPAS(2,I), BNDPAS(1,I)) * RAD2DG
                        IF ((SPHASE) .AND. (P.LT.0.0))
     *                      P = P + 360.0
                        END IF
                     IF ((A.NE.FBLANK) .AND. ((A.LT.AMIN) .OR.
     *                  (A.GT.AMAX))) A = FBLANK
                     IF ((P.NE.FBLANK) .AND. ((P.LT.PMIN) .OR.
     *                  (P.GT.PMAX))) P = FBLANK
                     END IF
                  PLPTS(1,IP) = A
                  PLPTS(2,IP) = P
 230              CONTINUE
               IP = IP + 1
               PLPTS(1,IP) = FBLANK
               PLPTS(2,IP) = FBLANK
               IP = IP + 1
               PLPTS(1,IP) = FBLANK
               PLPTS(2,IP) = FBLANK
 235           CONTINUE
C                                       Do the plot now
            SCALE = (TRC(2)-BLC(2)) * (1.0 - APARM(5)) / (AMAX - AMIN)
            CALL GLTYPE (2, PBUFF, IERR)
            FUNC = 'GLTYPE'
            IF (IERR.NE.0) GO TO 900
            Y0 = 0.0
            LMAX = AMAX
            LMIN = AMIN
            DO 260 K = 1,2
               LBLANK = .TRUE.
               X = X0
               DO 250 I = 1,IP
                  IF (PLPTS(K,I).EQ.FBLANK) THEN
                     LBLANK = .TRUE.
                     X = X + DX
                  ELSE
                     Y = Y0 + (PLPTS(K,I)-LMIN) * SCALE
                     IF (LBLANK) THEN
                        CALL GPLPOS (X, Y, DOPLAN, TVPLAN(1+PTVPLN),
     *                     IERR)
                     ELSE
                        CALL GPLVEC (X, Y, ICOL, NX, NY, NZ, DOPLAN,
     *                     TVPLAN(1+PTVPLN), IERR)
                        IF (IERR.EQ.0) CALL GPLPOS (X, Y, DOPLAN,
     *                     TVPLAN(1+PTVPLN), IERR)
                        END IF
                     FUNC = 'GVEC'
                     IF (IERR.NE.0) GO TO 900
                     LBLANK = .FALSE.
                     X = X + DX
                     END IF
                  IF (IERR.NE.0) GO TO 900
 250              CONTINUE
               LMAX = PMAX
               LMIN = PMIN
               SCALE = (TRC(2)-BLC(2)) * APARM(5) / (PMAX - PMIN)
               Y0 = (TRC(2)-BLC(2)) * (1.0 - APARM(5))
 260           CONTINUE
            END IF
 290     CONTINUE
      IF (DOTV) THEN
         CALL TVCLOS (SCRTCH, IERR)
      ELSE
         CALL ZCLOSE (PLUN, PFIND, IERR)
         CALL ZDESTR (INDISK, PFILE, IERR)
         END IF
      IERR = 0
      GO TO 999
C
 900  WRITE (MSGTXT,1900) IERR, FUNC
 990  CALL MSGWRT (8)
C
 999  RETURN
C-----------------------------------------------------------------------
 1000 FORMAT ('LPLAN ERROR',I4,' ON ',A)
 1900 FORMAT ('PLPLAN: ERROR PLOTTING',I4)
      END
      SUBROUTINE BPLABL (IVER, THEANT, IPOL, NX, NY, NZ, TVPLAN, IERR)
C-----------------------------------------------------------------------
C   Do the init for line drawing, ...
C   Inputs:
C      IVER    I      File version number
C      THEANT  I      antenna number
C      IPOL    I      polarization
C   Output:
C      IERR   I   Error code
C-----------------------------------------------------------------------
      INTEGER   IVER, THEANT, IPOL, NX, NY, NZ, TVPLAN(NX,NY,*), IERR
C
      REAL      CH(4), X, DX, DY, DCX, DCY, XMIN, YMIN, Y
      INTEGER   IDEPTH(5), I, JP, IIF, XINTER(10), NP, XINT, XLO, XHI,
     *   TIME1(4), TIME2(4), INCHAR, DEG, DU, DL
      CHARACTER STRING*80, NAMSTR*20, CTIME*8, CDATE*12
      INCLUDE 'BPEPL.INC'
      INCLUDE 'INCS:DCAT.INC'
      INCLUDE 'INCS:DHDR.INC'
      INCLUDE 'INCS:DTVC.INC'
      DATA XINTER /2,5,10,20,50,100,200,500,1000,2000/
C-----------------------------------------------------------------------
C                                       number characters around
      LTYPE = MOD (ABS(LABEL), 100)
      IF (LTYPE.EQ.0) LTYPE = 3
      IF (LABEL.GE.0) THEN
         LABEL = (LABEL/100)*100 + LTYPE
      ELSE
         LABEL = (LABEL/100)*100 - LTYPE
         END IF
      CALL RFILL (4, 0.5, CH)
      IF (LTYPE.EQ.2) CH(1) = 2.5
      IF (LTYPE.GT.2) CH(1) = 6.5
      IF (LTYPE.GT.1) CH(2) = 2.0
      IF (LTYPE.GT.2) CH(2) = CH(2) + 1.333
      IF ((LTYPE.GT.1) .AND. (LTYPE.LT.7)) THEN
         CH(2) = CH(2) + 2 * 1.333
         END IF
      IF (LTYPE.EQ.2) CH(3) = 2.5
      IF (LTYPE.GT.1) CH(4) = CH(4) + 1.5
      IF ((LABEL.GT.1) .AND. (LTYPE.LT.7)) CH(4) = CH(4) + 1.333
C                                       Set BLC, TRC, XYRATO.
      CALL RFILL (5, 1.0, BLC(3))
      CALL RFILL (5, 1.0, TRC(3))
      CALL FILL (5, 1, IDEPTH)
      IF (NX.EQ.0) THEN
         BLC(1) = 0.0
         BLC(2) = 0.0
         TRC(1) = 1000.0
         TRC(2) = 1000.0
         END IF
C                                       default XYRATIO
      IF (XYRATO.LT.0.01) THEN
         IF (XDOTV.GT.0.0) THEN
            XMIN = WINDTV(3) - WINDTV(1) + 1 - CSIZTV(1) * (CH(1)+CH(3))
            YMIN = WINDTV(4) - WINDTV(2) + 1 - CSIZTV(2) * (CH(2)+CH(4))
            XYRATO = 1.0
            IF (YMIN.GT.0.0) XYRATO = XMIN / YMIN
         ELSE
            XYRATO = 1.0
            END IF
         END IF
C                                       Initialize plot file line drw.
      CALL GINITL (BLC, TRC, XYRATO, CH, IDEPTH, PBUFF, IERR)
      IF (IERR.NE.0) GO TO 999
C                                       If a graphics plane already
      IF (NX.GT.0) THEN
         IF ((DOPLAN.EQ.1) .OR. (DOPLAN.EQ.2)) CALL DRPLAN (NX, NY, NZ,
     *      TVPLAN, PBUFF, IERR)
         IF ((DOPLAN.EQ.3) .OR. (DOPLAN.EQ.4)) CALL GRPLAN (NX, NY, NZ,
     *      TVPLAN, PBUFF, IERR)
         IF (IERR.NE.0) GO TO 999
         END IF
C                                       Draw borders.
      CALL GLTYPE (1, PBUFF, IERR)
      IF (IERR.NE.0) GO TO 999
      CALL GPOS (BLC(1), BLC(2), PBUFF, IERR)
      IF (IERR.NE.0) GO TO 999
      CALL GVEC (TRC(1), BLC(2), PBUFF, IERR)
      IF (IERR.NE.0) GO TO 999
      CALL GVEC (TRC(1), TRC(2), PBUFF, IERR)
      IF (IERR.NE.0) GO TO 999
      CALL GVEC (BLC(1), TRC(2), PBUFF, IERR)
      IF (IERR.NE.0) GO TO 999
      CALL GVEC (BLC(1), BLC(2), PBUFF, IERR)
      IF (IERR.NE.0) GO TO 999
      Y = (TRC(2) - BLC(2)) * (1.0 - APARM(5))
      CALL GPOS (BLC(1), Y, PBUFF, IERR)
      IF (IERR.NE.0) GO TO 999
      CALL GVEC (TRC(1), Y, PBUFF, IERR)
      IF (IERR.NE.0) GO TO 999
C                                       separate polarizations/IFs
      NP = (EIF-BIF+1)
      I = NP * (ECHAN-BCHAN+4)
      DX = (TRC(1)-BLC(1)+1.0) / I
      IF (NP.GT.1) THEN
         X = 0.0
         DO 20 JP = 2,NP
            X = X + (ECHAN-BCHAN+4) * DX
            CALL GPOS (X, BLC(2), PBUFF, IERR)
            IF (IERR.NE.0) GO TO 999
            CALL GVEC (X, TRC(2), PBUFF, IERR)
            IF (IERR.NE.0) GO TO 999
 20         CONTINUE
         END IF
      IF (LTYPE.LE.1) GO TO 999
C                                       Horizontal ticks
      DCY = -0.17
      IF (LTYPE.EQ.2) GO TO 100
      JP = 12
      IF (NP.GT.1) JP = 11 - NP
      JP = MAX (3, JP)
      DO 30 I = 1,10
         DEG = XINTER(I)
         DU = (ECHAN/DEG) * DEG
         IF (DU.GT.ECHAN) DU = DU - DEG
         DL = (BCHAN/DEG) * DEG
         IF (DL.LT.BCHAN) DL = DL + DEG
         IIF = (DU-DL) / DEG + 1
         IF (IIF.LE.JP) GO TO 35
 30      CONTINUE
      GO TO 100
C                                       tick drawing
 35   XINT = DEG
      XLO = (BCHAN / XINT) * XINT
      IF (XLO.LT.BCHAN) XLO = XLO + XINT
      XHI = (ECHAN / XINT) * XINT
      DY = 25. * (TRC(2)-BLC(2)+1.) / 1000.0
      DCY = -1.5
      DO 60 JP = 1,NP
         DO 50 I = XLO,XHI,XINT
            X = DX * (2.0 + I - BCHAN) + (JP-1) * (ECHAN-BCHAN+4) * DX
            WRITE (STRING,1035) I
            CALL CHTRIM (STRING, 4, STRING, IIF)
            DCX = -IIF + 0.5
            CALL GPOS (X, TRC(2), PBUFF, IERR)
            IF (IERR.NE.0) GO TO 999
            CALL GVEC (X, TRC(2)-DY, PBUFF, IERR)
            IF (IERR.NE.0) GO TO 999
            CALL GPOS (X, BLC(2)+DY, PBUFF, IERR)
            IF (IERR.NE.0) GO TO 999
            CALL GVEC (X, BLC(2), PBUFF, IERR)
            IF (IERR.NE.0) GO TO 999
            CALL GCHAR (IIF, 0, DCX, DCY, STRING(:IIF), PBUFF, IERR)
            IF (IERR.NE.0) GO TO 999
 50         CONTINUE
 60      CONTINUE
C                                       IF, POL labels
      X = DX
      DCY = 1.5
      DO 65 IIF = BIF,EIF
         CALL GPOS (X, BLC(2)+DY, PBUFF, IERR)
         IF (IERR.NE.0) GO TO 999
         WRITE (STRING,1060) IIF
         DCX = 1.5
         CALL GICHAR (1, 4, 0, DCX, DCY, STRING(:4), PBUFF, IERR)
         IF (IERR.NE.0) GO TO 999
         X = X + (ECHAN-BCHAN+4) * DX
 65      CONTINUE
C                                       horizontal axis label
      DCY = -2.833
      CALL GPOS (TRC(1)/2.0, 0., PBUFF, IERR)
      IF (IERR.NE.0) GO TO 999
      DCX = -8.5
      CALL GCHAR (17, 0, DCX, DCY, 'SPECTRAL CHANNELS', PBUFF, IERR)
      IF (IERR.NE.0) GO TO 999
C                                       vertical axis
      CALL YLABEL (IERR)
      IF (IERR.NE.0) GO TO 999
C                                       more labels
 100  IF (LTYPE.GE.7) GO TO 999
C                                       image name etc
      CALL GPOS (BLC(1), TRC(2), PBUFF, IERR)
      IF (IERR.NE.0) GO TO 999
      DCY = 0.5
      DCX = 0.0
      CALL H2CHR (12, KHIMNO, CATH(KHIMN), NAMSTR(1:12))
      CALL H2CHR (6, KHIMCO, CATH(KHIMC), NAMSTR(13:18))
      CALL NAMEST (NAMSTR, CATBLK(KIIMS), STRING, IIF)
      STRING(IIF+1:) = ' '
      IIF = IIF + 4
      WRITE (STRING(IIF:),1121) INVERS, THEANT, IPOLC(IPOL)
      CALL REFRMT (STRING, '_', INCHAR)
      CALL GCHAR (INCHAR, 0, DCX, DCY, STRING(:INCHAR), PBUFF, IERR)
      IF (IERR.NE.0) GO TO 999
C                                       time/date, version
      IF (LABEL.GT.0) THEN
         CALL GPOS (BLC(1), TRC(2), PBUFF, IERR)
         IF (IERR.NE.0) GO TO 999
         CALL ZDATE (TIME1)
         CALL ZTIME (TIME2)
         CALL TIMDAT (TIME2, TIME1, CTIME, CDATE)
         WRITE (STRING,1130) IVER, CDATE, CTIME
         CALL REFRMT (STRING, '_', INCHAR)
         IIF = 51
         DCY = DCY + 1.333
         CALL GCHAR (INCHAR, 0, DCX, DCY, STRING(:INCHAR), PBUFF, IERR)
         END IF
C
 999  RETURN
C-----------------------------------------------------------------------
 1035 FORMAT (I4)
 1060 FORMAT ('IF',I2.2)
 1121 FORMAT ('___bpver',I4,' _antenna',I3,' _pol ''',A1,'''')
 1130 FORMAT ('Plot file version',I4,'__created ',A,A)
      END
      SUBROUTINE YLABEL (IERR)
C-----------------------------------------------------------------------
C   Does tick labels and tics
C   Inputs:
C      BLC    R(*)    Botton left corner
C      TRC    R(*)    Top right corner
C   Outputs
C      IERR   I       Error code
C   Plus lots in COMMON
C-----------------------------------------------------------------------
      INTEGER   IERR
C
      INCLUDE 'BPEPL.INC'
      INTEGER   IT, INOINT, IXO, INCHAR, I
      REAL      XINTER(19), DCX, DCY, DIST, YMIN, YMAX, YBLC, YTRC,
     *   XINT, XVAL, DCXM, TICLEN, YTICEL, YTICER, YPOS, TICSCL, DEG,
     *   DU, DL
      CHARACTER MSGBUF*20
      INCLUDE 'INCS:DMSG.INC'
      DATA XINTER /.001, .002, .005, .01, .02, .05,.1, .2, .5, 1., 2.,
     *   5., 10., 20., 50., 100., 200., 500., 1000./
      DATA TICSCL /70.0/
C-----------------------------------------------------------------------
C                                       loop amp, phase
      DO 100 IT = 1,2
         YMIN = APARM(2*IT-1)
         YMAX = APARM(2*IT)
         DIST = YMAX - YMIN
         IF (IT.EQ.1) THEN
            YBLC = BLC(2)
            YTRC = YBLC + (1.0-APARM(5)) * (TRC(2) - BLC(2))
            XINT = (1.0 - APARM(5)) * 14.0
         ELSE
            YBLC = YTRC
            YTRC = TRC(2)
            XINT = APARM(5) * 14.0
            END IF
         DO 10 I = 1,19
            DEG = XINTER(I)
            DU = AINT (YMAX/DEG) * DEG
            IF (DU.GT.YMAX) DU = DU + DEG
            DL = AINT (YMIN/DEG) * DEG
            IF (DL.LT.YMIN) DL = DL + DEG
            INOINT = AINT ((DU-DL)/DEG) + 1
            IF (INOINT.LE.XINT) GO TO 20
 10         CONTINUE
         MSGTXT = 'Y AXIS LAELING PROBLEM'
         CALL MSGWRT (6)
         GO TO 100
C                                       Interval and no of inter found.
 20      XINT = DEG
         INOINT = INOINT + 2
         XVAL = AINT (YMIN/XINT) * XINT
         IF (XVAL.GE.YMIN) XVAL = XVAL - XINT
         IXO = I
         DCXM = -0.5
         TICLEN = (TRC(1) - BLC(1)) / TICSCL
         YTICEL = BLC(1) + TICLEN
         YTICER = TRC(1) - TICLEN
C                                       Loop for all tics.
         DO 30 I = 1,INOINT
            XVAL = XVAL + XINT
            YPOS = YBLC + (XVAL - YMIN) / DIST * (YTRC - YBLC)
            IF (YPOS.GT.YTRC) GO TO 40
C                                       TOP tic.
            CALL GPOS (TRC(1), YPOS, PBUFF, IERR)
            IF (IERR.NE.0) GO TO 999
            CALL GVEC (YTICER, YPOS, PBUFF, IERR)
            IF (IERR.NE.0) GO TO 999
C                                       Left hand tic.
            CALL GPOS (YTICEL, YPOS, PBUFF, IERR)
            IF (IERR.NE.0) GO TO 999
            CALL GVEC (BLC(1), YPOS, PBUFF, IERR)
            IF (IERR.NE.0) GO TO 999
C                                       Write value.
            IF (LTYPE.GT.2) THEN
               WRITE (MSGBUF,1030) XVAL
               CALL CHTRIM (MSGBUF, 14, MSGBUF, INCHAR)
               IF (IXO.GT.3) INCHAR = INCHAR - 1
               IF (IXO.GT.6) INCHAR = INCHAR - 1
               IF (IXO.GT.9) INCHAR = INCHAR - 2
               DCX = - INCHAR - 1.0
               DCY = -0.5
               DCXM = MIN (DCXM, DCX)
               CALL GCHAR (INCHAR, 0, DCX, DCY, MSGBUF, PBUFF, IERR)
               IF (IERR.NE.0) GO TO 999
               END IF
 30         CONTINUE
 40      IF (IT.EQ.1) THEN
            MSGBUF = 'Amplitude'
            INCHAR = 9
         ELSE
            MSGBUF = 'Phase'
            INCHAR = 5
            END IF
         YPOS = (YTRC + YBLC) / 2.0
         CALL GPOS (BLC(1), YPOS, PBUFF, IERR)
         IF (IERR.NE.0) GO TO 999
         DCX = DCXM - 2.
         DCY = INCHAR / 2.0 - 1.0
         CALL GCHAR (INCHAR, 1, DCX, DCY, MSGBUF, PBUFF, IERR)
         IF (IERR.NE.0) GO TO 999
 100     CONTINUE
C
 999  RETURN
C-----------------------------------------------------------------------
 1030 FORMAT (F14.3)
      END
      SUBROUTINE GPLPOS (X, Y, DOPLAN, BUFF, IERR)
C-----------------------------------------------------------------------
C   Inputs:
C      X        R      X position
C      Y        R      Y position
C      DOPLAN   I      > 2 -> plot file
C   Outputs
C      BUFF     I(*)   unused
C      IERR     I      error code
C-----------------------------------------------------------------------
      INTEGER   DOPLAN, BUFF(*), IERR
      REAL      X, Y
C
      REAL      RX, RY, RLIM
      INCLUDE 'INCS:DGPH.INC'
C-----------------------------------------------------------------------
      IERR = 0
C                                       Scale X and Y.
      RLIM = 4.0
      IF (GPHIX2.EQ.GPHIX1) THEN
         RX = 0.0
      ELSE
         RX = (X - GPHX1) / (GPHX2 - GPHX1)
         END IF
      IF (GPHIY2.EQ.GPHIY1) THEN
         RY = 0.0
      ELSE
         RY = (Y - GPHY1) / (GPHY2 - GPHY1)
         END IF
      RX = MAX (-RLIM, MIN (RLIM, RX))
      RY = MAX (-RLIM, MIN (RLIM, RY))
C                                       tv
      IF (DOPLAN.LE.2) THEN
         GPHIXL = RX * GPHSCX + 1.5
         GPHIYL = RY * GPHSCY + 1.5
      ELSE
         GPHIXL = RX * (GPHIX2 - GPHIX1) + GPHIX1 + 1.5
         GPHIYL = RY * (GPHIY2 - GPHIY1) + GPHIY1 + 1.5
         END IF
C
 999  RETURN
      END
      SUBROUTINE GPLVEC (X, Y, ICOL, NX, NY, NZ, DOPLAN, TVPLAN, IERR)
C-----------------------------------------------------------------------
C   Inputs:
C      X        R      X position
C      Y        R      Y position
C      ICOL     I(3)   RGB color to use
C      NX       I      X dimension of BUFF
C      NY       I      Y dimension of BUFF
C      NZ       I      Z dimension of BUFF
C      DOPLAN   I      > 2 -> plot file
C   Outputs
C      TVPLAN   I(*)   unused
C      IERR     i      error code
C-----------------------------------------------------------------------
      INTEGER   ICOL(3), NX, NY, NZ, DOPLAN, TVPLAN(NX,NY,*), IERR
      REAL      X, Y
C
      REAL      RX, RY, RLIM, ALPHA, BETA
      INTEGER   IXN, IYN, X1, X2, Y1, Y2, XLIM, YLIM, ZLIM
      INCLUDE 'INCS:DGPH.INC'
C-----------------------------------------------------------------------
      IERR = 0
C                                       Scale X and Y.
      RLIM = 4.0
      IF (GPHIX2.EQ.GPHIX1) THEN
         RX = 0.0
      ELSE
         RX = (X - GPHX1) / (GPHX2 - GPHX1)
         END IF
      IF (GPHIY2.EQ.GPHIY1) THEN
         RY = 0.0
      ELSE
         RY = (Y - GPHY1) / (GPHY2 - GPHY1)
         END IF
      RX = MAX (-RLIM, MIN (RLIM, RX))
      RY = MAX (-RLIM, MIN (RLIM, RY))
      XLIM = NX
      YLIM = NY
      ZLIM = NZ
C                                       scale
      IF (DOPLAN.LE.2) THEN
         IXN = RX * GPHSCX + 1.5
         IYN = RY * GPHSCY + 1.5
      ELSE
         IXN = RX * (GPHIX2 - GPHIX1) + GPHIX1 + 1.5
         IYN = RY * (GPHIY2 - GPHIY1) + GPHIY1 + 1.5
         END IF
      X1 = MAX (1, MIN (XLIM, GPHIXL))
      Y1 = MAX (1, MIN (YLIM, GPHIYL))
      X2 = MAX (1, MIN (XLIM, IXN))
      Y2 = MAX (1, MIN (YLIM, IYN))
      IF ((X1.NE.GPHIXL) .OR. (Y1.NE.GPHIYL)) THEN
         ALPHA = 1.0
         IF (IXN.NE.GPHIXL) ALPHA = REAL(X1-IXN)/REAL(GPHIXL-IXN)
         BETA = 1.0
         IF (IYN.NE.GPHIYL) BETA = REAL(Y1-IYN)/REAL(GPHIYL-IYN)
         ALPHA = MIN (ALPHA, BETA)
         X1 = IXN + ALPHA * (GPHIXL-IXN) + 0.5
         Y1 = IYN + ALPHA * (GPHIYL-IYN) + 0.5
         END IF
      IF ((X2.NE.IXN) .OR. (Y2.NE.IYN)) THEN
         ALPHA = 1.0
         IF (IXN.NE.GPHIXL) ALPHA = REAL(X2-GPHIXL)/REAL(IXN-GPHIXL)
         BETA = 1.0
         IF (IYN.NE.GPHIYL) BETA = REAL(Y2-GPHIYL)/REAL(IYN-GPHIYL)
         ALPHA = MIN (ALPHA, BETA)
         X2 = GPHIXL + ALPHA * (IXN-GPHIXL) + 0.5
         Y2 = GPHIYL + ALPHA * (IYN-GPHIYL) + 0.5
         END IF
      CALL PLVECT (XLIM, YLIM, ZLIM, ICOL, X1, Y1, X2, Y2, TVPLAN)
C
 999  RETURN
      END
      SUBROUTINE PLVECT (NX, NY, NZ, ICOL, X1, Y1, X2, Y2, TVPLAN)
C-----------------------------------------------------------------------
C   Fills a line in an array
C   Inputs:
C      NX       I      X dimension of plane
C      NY       I      Y dimension of plane
C      NZ       I      Z dimension of plane
C      ICOL     I(3)   rgb colors to use
C      X1       I      X of first point
C      Y1       i      Y of first point
C      X2       I      X of 2nd point
C      Y2       I      Y of 2nd point
C   Output:
C      TVPLAN   I(*)   plane
C-----------------------------------------------------------------------
      INTEGER   NX, NY, NZ, ICOL(3), X1, X2, Y1, Y2, TVPLAN(NX,NY,*)
C
      REAL      X, Y, SLOPE
      INTEGER   IX, IY, IZ, IROUND
C-----------------------------------------------------------------------
      IX = ABS (X2-X1)
      IY = ABS (Y2-Y1)
C                                       loop over X
      IF (IX.GE.IY) THEN
         SLOPE = FLOAT (Y2 - Y1) / FLOAT (X2 - X1)
         IF (X1.LT.X2) THEN
            DO 10 IX = X1,X2
               Y = Y1 + SLOPE * (IX - X1)
               IY = IROUND (Y)
               IF ((IX.GE.1) .AND. (IX.LE.NX) .AND. (IY.GE.1) .AND.
     *            (IY.LE.NY)) THEN
                  DO 5 IZ = 1,NZ
                     TVPLAN(IX,IY,IZ) = ICOL(IZ)
 5                   CONTINUE
                  END IF
 10            CONTINUE
         ELSE IF (X2.LT.X1) THEN
            DO 20 IX = X2,X1
               Y = Y1 + SLOPE * (IX - X1)
               IY = IROUND (Y)
               IF ((IX.GE.1) .AND. (IX.LE.NX) .AND. (IY.GE.1) .AND.
     *            (IY.LE.NY)) THEN
                  DO 15 IZ = 1,NZ
                     TVPLAN(IX,IY,IZ) = ICOL(IZ)
 15                  CONTINUE
                  END IF
 20            CONTINUE
C                                       single pixel
         ELSE
            IX = X1
            IY = Y1
            IF ((IX.GE.1) .AND. (IX.LE.NX) .AND. (IY.GE.1) .AND.
     *         (IY.LE.NY)) THEN
               DO 22 IZ = 1,NZ
                  TVPLAN(IX,IY,IZ) = ICOL(IZ)
 22               CONTINUE
               END IF
            END IF
C                                       loop over Y
      ELSE
         SLOPE = FLOAT (X2 - X1) / FLOAT (Y2 - Y1)
         IF (Y1.LT.Y2) THEN
            DO 30 IY = Y1,Y2
               X = X1 + SLOPE * (IY - Y1)
               IX = IROUND (X)
               IF ((IX.GE.1) .AND. (IX.LE.NX) .AND. (IY.GE.1) .AND.
     *            (IY.LE.NY)) THEN
                  DO 25 IZ = 1,NZ
                     TVPLAN(IX,IY,IZ) = ICOL(IZ)
 25                  CONTINUE
                  END IF
 30            CONTINUE
         ELSE
            DO 40 IY = Y2,Y1
               X = X1 + SLOPE * (IY - Y1)
               IX = IROUND (X)
               IF ((IX.GE.1) .AND. (IX.LE.NX) .AND. (IY.GE.1) .AND.
     *            (IY.LE.NY)) THEN
                  DO 35 IZ = 1,NZ
                     TVPLAN(IX,IY,IZ) = ICOL(IZ)
 35                  CONTINUE
                  END IF
 40            CONTINUE
            END IF
         END IF
C
 999  RETURN
      END
      SUBROUTINE PLCOL3 (COLV, ICOL)
C-----------------------------------------------------------------------
C   Color integers returned
C   Input:
C      COLV   R      Color level 0 - 1
C   Output
C      ICOL   I(3)   R, G, B colors (0 to 1) * 32767
C-----------------------------------------------------------------------
      REAL      COLV
      INTEGER   ICOL(3)
C
      INTEGER   I
      REAL      COL(3)
      INCLUDE 'INCS:DTVC.INC'
C-----------------------------------------------------------------------
      IF (MAXINT.LE.0) MAXINT = 8191
      CALL COLOR3 (COLV, .FALSE., COL)
      DO 10 I = 1,3
         ICOL(I) = COL(I) * MAXINT + 0.5
 10      CONTINUE
C
 999  RETURN
      END
      SUBROUTINE DRPLAN (NX, NY, NZ, TVPLAN, BUFFER, IERR)
C-----------------------------------------------------------------------
C   Draw TVPLAN into a graphics plane or memory planes of TV only
C   Inputs:
C      NX       I      X dimension
C      NY       I      Y dimension
C      TVPLAN   I(*)   plane to draw
C   Outputs:
C      BUFFER   I(*)   plot buffer
C      IERR     I      error code
C-----------------------------------------------------------------------
      INTEGER   NX, NY, NZ, TVPLAN(NX,NY,*), BUFFER(*), IERR
C
      INTEGER   LX, IY, LY, CHAN, LC
      INCLUDE 'INCS:DGPH.INC'
C-----------------------------------------------------------------------
C                                       graphics
      IF (NZ.LE.1) THEN
         CALL GLTYPE (4, BUFFER, IERR)
         IF (IERR.NE.0) GO TO 999
C                                       Channel okay?
         GPHLTY = MAX (1, GPHLTY)
         CHAN = GPHTVG(GPHLTY)
         CALL GCINIT (CHAN, 0, IERR)
         IF (IERR.NE.0) GO TO 999
C                                       load image
         LX = GPHIX0
         LY = GPHIY0 - 1
         DO 10 IY = 1,NY
            LY = LY + 1
            CALL YIMGIO ('WRIT', CHAN, LX, LY, 0, NX, TVPLAN(1,IY,1),
     *         IERR)
            IF (IERR.NE.0) GO TO 999
 10         CONTINUE
C                                       3 color grey scale
      ELSE
         DO 50 LC = 1,NZ
            CHAN = GPHTVC(LC)
            CALL GCINIT (CHAN, LC, IERR)
            IF (IERR.NE.0) GO TO 999
C                                       load image
            LX = GPHIX0
            LY = GPHIY0 - 1
            DO 30 IY = 1,NY
               LY = LY + 1
               CALL YIMGIO ('WRIT', CHAN, LX, LY, 0, NX,
     *            TVPLAN(1,IY,LC), IERR)
               IF (IERR.NE.0) GO TO 999
 30            CONTINUE
 50         CONTINUE
         END IF
C
 999  RETURN
      END
      SUBROUTINE GRPLAN (NX, NY, NZ, TVPLAN, BUFFER, IERR)
C-----------------------------------------------------------------------
C   Draw TVPLAN into a plot file
C   Inputs:
C      NX       I      X dimension
C      NY       I      Y dimension
C      NZ       I      Z dimension (1 B&W, 3 color)
C      TVPLAN   I(*)   plane to draw
C   Outputs:
C      BUFFER   I(*)   plot buffer
C      IERR     I      error code
C-----------------------------------------------------------------------
      INTEGER   NX, NY, NZ, TVPLAN(NX,NY,*), BUFFER(*), IERR
C
      INTEGER   LX, IY, LY, IGLO, IGHI
      REAL      RANGE(2), RANGES(2,3), X, Y
      INCLUDE 'INCS:DGPH.INC'
      INCLUDE 'INCS:DTVC.INC'
C-----------------------------------------------------------------------
      IF (MAXINT.LE.0) MAXINT = 8191
C                                       Black & white
      IF (NZ.LE.1) THEN
         IGLO = 0
         IGHI = MAXINT
         RANGE(1) = 0.0
         RANGE(2) = MAXINT
         CALL GINITG (IGLO, IGHI, RANGE, BUFFER, IERR)
         IF (IERR.NE.0) GO TO 999
C                                       load image
         LX = GPHIX1
         X = LX
         LY = GPHIY1 - 1
         DO 10 IY = 1,NY
            LY = LY + 1
            Y = LY
            CALL GPOS (X, Y, BUFFER, IERR)
            IF (IERR.NE.0) GO TO 999
            CALL GRAYPX (NX, 0, TVPLAN(1,IY,1), BUFFER, IERR)
            IF (IERR.NE.0) GO TO 999
 10         CONTINUE
C                                       3 color grey scale
      ELSE
         IGLO = 0
         IGHI = MAXINT
         RANGES(1,1) = 0.0
         RANGES(2,1) = MAXINT
         RANGES(1,2) = 0.0
         RANGES(2,2) = MAXINT
         RANGES(1,3) = 0.0
         RANGES(2,3) = MAXINT
         CALL GINITC (IGLO, IGHI, RANGES, BUFFER, IERR)
         IF (IERR.NE.0) GO TO 999
C                                       load image
         LX = GPHIX1
         X = LX
         LY = GPHIY1 - 1
         DO 20 IY = 1,NY
            LY = LY + 1
            Y = LY
            CALL GPOS (X, Y, BUFFER, IERR)
            IF (IERR.NE.0) GO TO 999
            CALL G3COLR (NX, 0, TVPLAN(1,IY,1), TVPLAN(1,IY,2),
     *         TVPLAN(1,IY,3), BUFFER, IERR)
            IF (IERR.NE.0) GO TO 999
 20         CONTINUE
         END IF
C
 999  RETURN
      END
