LOCAL INCLUDE 'VLBRF.INC'
C                                       Local include for VLBRF
      INCLUDE 'INCS:ZPBUFSZ.INC'
      INCLUDE 'INCS:PUVD.INC'
      HOLLERITH XNAMEI(3), XCLAIN(2), XSOUR(4,30), XCALC(1), XSTOK(1),
     *   XOUTF(12)
      REAL      XSIN, XDISIN, XQUAL, XTIME(8), XANT(50), XBIF, XEIF,
     *   XBCHAN, XECHAN, XFLAG, XSMOTH(3), DOALL, DOSCAN, DOPLOT,
     *   XPIXR(2), APARM(10), FACTOR, XDOTV, XGRCH, XNPLOT, XLABEL,
     *   BADD(10)
      REAL      SCRBUF(512), CATOR(256), PMEAN(MAXCIF,20),
     *   PMAX(MAXCIF,20), PMIN(MAXCIF,20), RMEAN(MAXCIF,20),
     *   RMAX(MAXCIF,20), RMIN(MAXCIF,20), MMEAN(MAXCIF,20),
     *   MMAX(MAXCIF,20), MMIN(MAXCIF,20), PMWT(MAXCIF,20), VIS(UVBFSS),
     *   RPARM(20)
      HOLLERITH CATOH(256)
      LOGICAL   GOTANT(20), FRQLAB
      INTEGER   SEQIN, DISKIN, JBUFSZ, ILOCWT, CATOLD(256), INCSI,
     *   INCFI, INCIFI, OLDCNO, NSAMP, GRCHAN, NPARM, NVAL, NFREQ,
     *   NIF, NANT, NANS, NUMT(MAXANT), MAXA, MAXT, NPLOTS, NXP, NYP
      DOUBLE PRECISION CATOD(128), FRQMIN, FRQMAX
      CHARACTER NAMEIN*12, CLAIN*6, LTITLE*80, OUTFIL*48
      EQUIVALENCE (CATOD, CATOH, CATOR, CATOLD)
      COMMON /INPARM/ XNAMEI, XCLAIN, XSIN, XDISIN, XSOUR, XQUAL, XCALC,
     *   XSTOK, XTIME, XANT, XBIF, XEIF, XBCHAN, XECHAN, XFLAG, XSMOTH,
     *   DOALL, DOSCAN, XOUTF, DOPLOT, XPIXR, APARM, FACTOR, XDOTV,
     *   XGRCH, XNPLOT, XLABEL, BADD
      COMMON /VLBRFS/ CATOLD, FRQMIN, FRQMAX, SEQIN, DISKIN, ILOCWT,
     *   INCSI, INCFI, INCIFI, OLDCNO, NSAMP, GRCHAN, NPARM, NVAL,
     *   NFREQ, NIF, NANT, NANS, FRQLAB, GOTANT, NUMT, MAXA, MAXT,
     *   NPLOTS, NXP, NYP
      COMMON /ANSWER/ PMEAN, PMIN, PMAX, RMEAN, RMIN, RMAX, MMEAN, MMIN,
     *   MMAX, PMWT
      COMMON /CHARPM/ LTITLE, NAMEIN, CLAIN, OUTFIL
      COMMON /BUFRS/ VIS, RPARM, SCRBUF, JBUFSZ
C                                       End local include for VLBRF
LOCAL END
      PROGRAM VLBRF
C-----------------------------------------------------------------------
C! Plots statistics of selected autocorrelation data for VLBA RFI tests
C# UV UV-util Calibration Plot Hardcopy VLBA
C-----------------------------------------------------------------------
C;  Copyright (C) 2022-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   VLBRF plots statistics from a sample of autocorrelation data
C   Inputs:
C      AIPS adverb  Prg. name.          Description.
C      INNAME         NAMEIN        Name of input UV data.
C      INCLASS        CLAIN         Class of input UV data.
C      INSEQ          SEQIN         Seq. of input UV data.
C      INDISK         DISKIN        Disk number of input VU data.
C-----------------------------------------------------------------------
      CHARACTER PRGM*6
      INTEGER   IRET, NS, JA, IP, NWORDS, MAXIP, I, MXPLOT, LX, LY
      REAL      DBUF(2), WBUF(2)
      LONGINT   PDBUF, PWBUF


C      REAL      SUM(2), SUMS(2), WGT(2)
C      DOUBLE PRECISION DSUM(2), DSUMS(2), DWGT(2)
C      LONGINT   PSUM, PSUMS, PWGT
C      EQUIVALENCE (DSUM, SUM), (DSUMS, SUMS), (DWGT, WGT)
      INCLUDE 'VLBRF.INC'
      INCLUDE 'INCS:DFIL.INC'
      INCLUDE 'INCS:DMSG.INC'
      INCLUDE 'INCS:DDCH.INC'
      INCLUDE 'INCS:DHDR.INC'
      INCLUDE 'INCS:DUVH.INC'
      INCLUDE 'INCS:DSEL.INC'
      INCLUDE 'INCS:DANS.INC'
      DATA PRGM /'VLBRF '/
C-----------------------------------------------------------------------
C                                       Get input parameters and
C                                       create output file if nec.
      CALL VLBRFI (PRGM, IRET)
      IF (IRET.NE.0) GO TO 990
C                                       find # times for each antenna
      CALL VLBRFT (NS, IRET)
      IF (IRET.NE.0) GO TO 990

      NWORDS = NFREQ * NIF * NS * MAXT
      NWORDS = (NWORDS - 1) / 1024 + 4
      CALL ZMEMRY ('GET ', PRGM, NWORDS, DBUF, PDBUF, IRET)
      IF (IRET.EQ.0) THEN
         NWORDS = (MAXT - 1) / 1024 + 4
         CALL ZMEMRY ('GET ', PRGM, NWORDS, WBUF, PWBUF, IRET)
         END IF
      IF (IRET.NE.0) THEN
         MSGTXT = 'FAILED TO GET DYNAMIC MEMORY'
         CALL MSGWRT (8)
         GO TO 990
         END IF
C                                       read data
      CALL VLBRFR (NFREQ, NIF, NS, DBUF(1+PDBUF), WBUF(1+PWBUF), IRET)
      IF (IRET.NE.0) GO TO 990
C                                       output text
      IF (OUTFIL.NE.' ') THEN
         CALL VLBRFC (IRET)
         IF (IRET.NE.0) GO TO 990
         END IF
C                                       Plot mean, std spectra
      IF (DOPLOT.GT.0.0) THEN
         MAXIP = 0
         I = 0
         DO 10 JA = 1,4
            IF (APARM(5+JA).LE.0.0) THEN
               MAXIP = JA
               I = I + 1
               END IF
 10         CONTINUE
         MXPLOT = 0
         DO 20 JA = 1,20
            IF (GOTANT(JA)) THEN
               MXPLOT = MXPLOT + I
               END IF
 20         CONTINUE
         LX = 0
         LY = 1
         I = 0
         DO 30 JA = 1,20
            IF (GOTANT(JA)) THEN
               IP = 1
               IF ((IRET.EQ.0) .AND. (APARM(5+IP).LE.0.0)) THEN
                  I = I + 1
                  IF (MOD(I-1,NPLOTS).EQ.0) THEN
                     LX = 1
                     LY = 1
                  ELSE
                     LX = LX + 1
                     IF (LX.GT.NXP) THEN
                        LX = 1
                        LY = LY + 1
                        IF (LY.GT.NYP) LY = 1
                        END IF
                     END IF
                  IF (I.EQ.MXPLOT) IP = -IP
                  CALL VLBRFP (IP, LX, LY, PMEAN(1,JA), MMEAN(1,JA),
     *               RMEAN(1,JA), JA, IRET)
                  END IF
               IP = 2
               IF ((IRET.EQ.0) .AND. (APARM(5+IP).LE.0.0)) THEN
                  I = I + 1
                  IF (MOD(I-1,NPLOTS).EQ.0) THEN
                     LX = 1
                     LY = 1
                  ELSE
                     LX = LX + 1
                     IF (LX.GT.NXP) THEN
                        LX = 1
                        LY = LY + 1
                        IF (LY.GT.NYP) LY = 1
                        END IF
                     END IF
                  IF (I.EQ.MXPLOT) IP = -IP
                  CALL VLBRFP (IP, LX,LY, PMEAN(1,JA), PMIN(1,JA),
     *               PMAX(1,JA),JA, IRET)
                  END IF
               IP = 3
               IF ((IRET.EQ.0) .AND. (APARM(5+IP).LE.0.0)) THEN
                  I = I + 1
                  IF (MOD(I-1,NPLOTS).EQ.0) THEN
                     LX = 1
                     LY = 1
                  ELSE
                     LX = LX + 1
                     IF (LX.GT.NXP) THEN
                        LX = 1
                        LY = LY + 1
                        IF (LY.GT.NYP) LY = 1
                        END IF
                     END IF
                  IF (I.EQ.MXPLOT) IP = -IP
                  CALL VLBRFP (IP, LX, LY, RMEAN(1,JA), RMIN(1,JA),
     *               RMAX(1,JA), JA, IRET)
                  END IF
               IP = 4
               IF ((IRET.EQ.0) .AND. (APARM(5+IP).LE.0.0)) THEN
                  I = I + 1
                  IF (MOD(I-1,NPLOTS).EQ.0) THEN
                     LX = 1
                     LY = 1
                  ELSE
                     LX = LX + 1
                     IF (LX.GT.NXP) THEN
                        LX = 1
                        LY = LY + 1
                        IF (LY.GT.NYP) LY = 1
                        END IF
                     END IF
                  IF (I.EQ.MXPLOT) IP = -IP
                  CALL VLBRFP (IP, LX, LY, MMEAN(1,JA), MMIN(1,JA),
     *               MMAX(1,JA), JA, IRET)
                  END IF
               END IF
 30         CONTINUE
         END IF
      IRET = MAX (0, IRET)
      CALL VLBRFH
C                                       Close down files, etc.
 990  CALL DIE (IRET, SCRBUF)
C
 999  STOP
      END
      SUBROUTINE VLBRFI (PRGN, JERR)
C-----------------------------------------------------------------------
C   VLBRFI gets input parameters for VLBRF
C   Inputs:
C      PRGN    C*6  Program name
C   Output:
C      JERR    I    Error code: 0 => ok
C                                5 => catalog troubles
C                                8 => can't start
C   Output in common:
C      INCSI   I  Input Stokes' increment in vis.
C      INCFI   I  Input frequency increment in vis.
C      INCIFI  I  Input IF increment in vis.
C   Commons: /INPARM/ all input adverbs in order given by INPUTS
C                     file
C            /MAPHDR/ output file catalog header
C-----------------------------------------------------------------------
      INTEGER   JERR
      CHARACTER PRGN*6
C
      CHARACTER STAT*4, PTYPE*2
      INTEGER   IROUND, IERR, INCX, I, LUN, VER
      REAL      CATR(256)
      HOLLERITH CATH(256)
      DOUBLE PRECISION CATD(128), FF
      INCLUDE 'INCS:DSEL.INC'
      INCLUDE 'VLBRF.INC'
      INCLUDE 'INCS:DFIL.INC'
      INCLUDE 'INCS:DMSG.INC'
      INCLUDE 'INCS:DHDR.INC'
      INCLUDE 'INCS:DUVH.INC'
      INCLUDE 'INCS:DCHND.INC'
      EQUIVALENCE (CATBLK, CATR, CATH, CATD)
C-----------------------------------------------------------------------
C                                       Init for AIPS, disks, ...
      CALL ZDCHIN (.TRUE.)
      CALL VHDRIN
      CALL SELINI
      JBUFSZ = UVBFSS * 2
C                                       Initialize /CFILES/
      NSCR = 0
      NCFILE = 0
      JERR = 0
      CALL LFILL (20, .FALSE., GOTANT)
      NANT = 0
C                                       Get input parameters.
      NPARM = 238
      CALL GTPARM (PRGN, NPARM, RQUICK, XNAMEI, SCRBUF, IERR)
      IF (IERR.NE.0) THEN
         RQUICK = .TRUE.
         JERR = 8
         IF (IERR.EQ.1) GO TO 999
            WRITE (MSGTXT,1000) IERR, 'OBTAINING INPUT PARAMETERS'
            CALL MSGWRT (8)
         END IF
C                                       Restart AIPS
      IF (RQUICK) CALL RELPOP (JERR, SCRBUF, IERR)
      IF (JERR.NE.0) GO TO 999
      JERR = 5
C                                       Crunch input parameters.
      CALL H2CHR (12, 1, XNAMEI, NAMEIN)
      CALL H2CHR (6, 1, XCLAIN, CLAIN)
      CALL H2CHR (4, 1, XCALC, SELCOD)
      CALL H2CHR (48, 1, XOUTF, OUTFIL)
      DO 5 I = 1,10
         IBAD(I) = IROUND (BADD(I))
 5       CONTINUE
      DO 10 I = 1,30
         CALL H2CHR (16, 1, XSOUR(1,I), SOURCS(I))
 10      CONTINUE
      DO 20 I = 1,50
         ANTENS(I) = IROUND (XANT(I))
 20      CONTINUE
      CALL RFILL (44, 0.0, XANT(7))
      CALL CHR2H (6, TSKNAM, 1, XANT(5))
      SELQUA = IROUND (XQUAL)
      SEQIN = IROUND (XSIN)
      DISKIN = IROUND (XDISIN)
      IF (ABS(FACTOR).LE.0.01) THEN
         IF (FACTOR.GE.0.0) FACTOR = 1.0
         IF (FACTOR.LT.0.0) FACTOR = -1.0
         END IF
      NPLOTS = XNPLOT + 0.5
      NPLOTS = MAX (1, MIN (9, NPLOTS))
      NYP = SQRT (REAL(NPLOTS))
      IF (NYP*NYP.LT.NPLOTS) NYP = NYP + 1
      NXP = NPLOTS / NYP
      IF (NXP*NYP.LT.NPLOTS) NXP = NXP + 1
C                                       Info for UVGET:
C                                       Put selection criteria into
C                                       correct common.
      UNAME = NAMEIN
      UCLAS = CLAIN
      UDISK = DISKIN
      USEQ = SEQIN
      DOACOR = .TRUE.
      DOXCOR = .FALSE.
      CALL RCOPY (3, XSMOTH, SMOOTH)
C                                       Set time range.
      FGVER = IROUND (XFLAG)
      GRCHAN = IROUND (XGRCH)
      FRQLAB = APARM(5).LE.0.0
C                                       Get CATBLK from old file.
      OLDCNO = 1
      PTYPE = 'UV'
      CALL CATDIR ('SRCH', DISKIN, OLDCNO, NAMEIN, CLAIN, SEQIN,
     *   PTYPE, NLUSER, STAT, SCRBUF, IERR)
      IF (IERR.NE.0) THEN
         WRITE (MSGTXT,1030) IERR, NAMEIN, CLAIN, SEQIN, DISKIN,
     *      NLUSER
         GO TO 990
         END IF
      CALL CATIO ('READ', DISKIN, OLDCNO, CATBLK, 'REST', SCRBUF, IERR)
      IF (IERR.NE.0) THEN
         WRITE (MSGTXT,1040) IERR
         GO TO 990
         END IF
C                                       Save input CATBLK
      CALL COPY (256, CATBLK, CATOLD)
C                                       Get uv header info.
      CALL UVPGET (JERR)
      IF (JERR.NE.0) GO TO 999
      I = CATBLK(KINAX+JLOCS)
      CALL H2CHR (4, 1, XSTOK, STOKES)
      IF ((STOKES.NE.'RR') .AND. (STOKES.NE.'LL') .AND. (STOKES.NE.'VV')
     *   .AND. (STOKES.NE.'HH')) THEN
         IF (I.GE.2) THEN
            STOKES = 'HALF'
         ELSE
            IF (ICOR0.EQ.-1) STOKES = 'RR'
            IF (ICOR0.EQ.-2) STOKES = 'LL'
            IF (ICOR0.EQ.-5) STOKES = 'VV'
            IF (ICOR0.EQ.-6) STOKES = 'HH'
            END IF
         END IF
C                                       Channel selection?
      IF (JLOCIF.LT.0) THEN
         BIF = 1
         EIF = 1
      ELSE
         BIF = IROUND (XBIF)
         EIF = IROUND (XEIF)
         BIF = MIN (MAX (1, BIF), CATBLK(KINAX+JLOCIF))
         IF (EIF.LT.BIF) EIF = CATBLK(KINAX+JLOCIF)
         END IF
      NIF = EIF - BIF + 1
      NFREQ = CATBLK(KINAX+JLOCF)
      BCHAN = IROUND (XBCHAN)
      ECHAN = IROUND (XECHAN)
      IF ((BCHAN.LE.0) .OR. (BCHAN.GT.NFREQ)) BCHAN = 1
      IF ((ECHAN.LE.0) .OR. (ECHAN.GT.NFREQ)) ECHAN = NFREQ
      IF (BCHAN.GT.ECHAN) THEN
         MSGTXT = 'INVALID BCHAN AND ECHAN'
         CALL MSGWRT (6)
         JERR = 1
         GO TO 990
         END IF
      NFREQ = ECHAN - BCHAN + 1
C                                       Freq id, antenna info
      FRQSEL = 1
      LUN = 28
      SUBARR = 1
      CALL GETANT (DISKIN, OLDCNO, SUBARR, CATBLK, SCRBUF, JERR)
      IF (JERR.NE.0) THEN
         WRITE (MSGTXT,1000) JERR, 'READING ANTENNA DATA'
         GO TO 990
         END IF
C                                       time range
      CALL RCOPY (8, XTIME, TIMRNG)
      IF ((TIMRNG(1)+TIMRNG(2)+TIMRNG(3)+TIMRNG(4)) .EQ.0.0)
     *   TIMRNG(1)=-1.0E6
      IF ((TIMRNG(5)+TIMRNG(6)+TIMRNG(7)+TIMRNG(8)) .EQ.0.0)
     *   TIMRNG(5)=1.0E6
      TSTART = TIMRNG(1) + TIMRNG(2) / 24. + TIMRNG(3) / (24. * 60.) +
     *   TIMRNG(4) / (24. * 60. * 60.)
      TEND = TIMRNG(5) + TIMRNG(6) / 24. + TIMRNG(7) / (24. * 60.) +
     *   TIMRNG(8) / (24. * 60. * 60.)
C                                       now using cal system -
C                                       UVGET makes header
      CALL UVGET ('INIT', RPARM, SCRBUF, JERR)
      IF (JERR.NE.0) THEN
         WRITE (MSGTXT,1035) JERR
         GO TO 990
         END IF
      CALL UVGET ('CLOS', RPARM, SCRBUF, IERR)
C                                       Save input file info
      INCX = CATBLK(KINAX)
      INCSI = INCS / INCX
      INCFI = INCF / INCX
      INCIFI = INCIF / INCX
C                                        Fill defaults for plots
      XBCHAN = BCHAN
      XECHAN = ECHAN
      XBIF = BIF
      XEIF = EIF
C                                        Put input file in READ
      PTYPE = 'UV'
      CALL CATDIR ('CSTA', DISKIN, OLDCNO, NAMEIN, CLAIN, SEQIN,
     *   PTYPE, NLUSER, 'READ', SCRBUF, IERR)
      NCFILE = NCFILE + 1
      FVOL(NCFILE) = DISKIN
      FCNO(NCFILE) = OLDCNO
      FRW(NCFILE) = 0
C                                       get frequencies
      VER = 1
      CALL CHNDAT ('READ', FQBUFF, IUDISK, IUCNO, VER, CATUV, IQLUN,
     *   CHNIF, FOFF, ISBAND, FINC, BNDCOD, FRQSEL, IERR)
      IF (IERR.NE.0) THEN
         WRITE (MSGTXT,1000) IERR, 'FINDING FREQUENCIES'
         GO TO 990
         END IF
      JERR = 0
C                                       init answers
      I = 20 * MAXCIF
      CALL RFILL (I, 0.0, PMEAN)
      CALL RFILL (I, 1.E10, PMIN)
      CALL RFILL (I, -1.E10, PMAX)
      CALL RFILL (I, 0.0, RMEAN)
      CALL RFILL (I, 1.E10, RMIN)
      CALL RFILL (I, -1.E10, RMAX)
      CALL RFILL (I, 0.0, MMEAN)
      CALL RFILL (I, 1.E10, MMIN)
      CALL RFILL (I, -1.E10, MMAX)
      CALL RFILL (I, 0.0, PMWT)
      NANS = 0
      FRQMIN = 1.E15
      FRQMAX = -1.E15
      DO 30 I = BIF,EIF
         FF = CATOD(KDCRV+JLOCF) + FOFF(I) +
     *      (BCHAN-1-CATOR(KRCRP+JLOCF)) * FINC(I)
         FRQMIN = MIN (FF, FRQMIN)
         FRQMAX = MAX (FF, FRQMAX)
         FF = FF + (ECHAN-BCHAN+2) * FINC(I)
         FRQMIN = MIN (FF, FRQMIN)
         FRQMAX = MAX (FF, FRQMAX)
 30      CONTINUE
      GO TO 999
C
 990  CALL MSGWRT (8)
C
 999  RETURN
C-----------------------------------------------------------------------
 1000 FORMAT ('VLBRFI: ERROR',I3,' ON ',A)
 1030 FORMAT ('ERROR',I3,' FINDING ',A12,'.',A6,'.',I4,' DISK=',
     *   I3,' USID=',I5)
 1035 FORMAT ('VLBRFI: UVGET INIT ERROR',I3,' CHECK ADVERBS')
 1040 FORMAT ('ERROR',I3,' COPYING CATBLK ')
      END
      SUBROUTINE VLBRFT (NS, IRET)
C-----------------------------------------------------------------------
C   Finds number of records for each antenna
C   Output:
C      NS     I   Number Stokes (1 or 2)
C      IRET   I   Error code
C-----------------------------------------------------------------------
      INTEGER   NS, IRET
C
      INCLUDE 'VLBRF.INC'
      INTEGER   I, IA1, IA2
      REAL      BASEN
      INCLUDE 'INCS:DMSG.INC'
      INCLUDE 'INCS:DCAT.INC'
      INCLUDE 'INCS:DUVH.INC'
      INCLUDE 'INCS:DHDR.INC'
C-----------------------------------------------------------------------
      CALL FILL (MAXANT, 0, NUMT)
      MAXA = 0
C                                       Open and init for read
      CALL UVGET ('INIT', RPARM, VIS, IRET)
      IF (IRET.NE.0) THEN
         WRITE (MSGTXT,1000) IRET, 'INIT READ OF DATA'
         GO TO 990
         END IF
      CALL UVPGET (IRET)
      NS = 1
      IF (JLOCS.GE.0) NS = CATBLK(KINAX+JLOCS)
      NS = MIN (2, NS)
C                                       Loop
C                                       Read vis. record.
 100  CALL UVGET ('READ', RPARM, VIS, IRET)
      IF (IRET.GT.0) THEN
         WRITE (MSGTXT,1000) IRET, 'READ THE DATA'
         GO TO 990
C                                       Last or good
      ELSE IF (IRET.EQ.0) THEN
         IF (ILOCB.GE.0) THEN
            BASEN = RPARM(1+ILOCB)
            IA1 = BASEN / 256. + 0.1
            IA2 = BASEN - IA1*256. + 0.1
         ELSE
            IA1 = RPARM(1+ILOCA1) + 0.1
            IA2 = RPARM(1+ILOCA2) + 0.1
            END IF
         IF (IA1.EQ.IA2) THEN
            NUMT(IA1) = NUMT(IA1) + 1
            MAXA = MAX (MAXA, IA1)
            END IF
         GO TO 100
         END IF
C                                       close file
C                                       Close files
      CALL UVGET ('CLOS', RPARM, VIS, IRET)
      IRET = 0
      IF (MAXA.LE.0) THEN
         MSGTXT = 'NO AUTOCORRELATION DATA FOUND'
         IRET = 8
         GO TO 990
      ELSE
         MAXT = 0
         DO 120 I = 1,MAXA
            MAXT = MAX (MAXT, NUMT(I))
 120        CONTINUE
         END IF
      GO TO 999
C
 990  CALL MSGWRT (8)
C
 999  RETURN
C-----------------------------------------------------------------------
 1000 FORMAT ('VLBRFT ERROR',I4,' ON ',A)
      END
      SUBROUTINE VLBRFR (NC, NI, NS, DBUF, WBUF, IRET)
C-----------------------------------------------------------------------
C   VLBRFR reads the uv data and finds medians and MADs
C   Input:
C      NC      I      Number spectral channels
C      NI      I      Number IFs
C      NS      I      Number Stokes
C   Input in common:
C      INCSI   I      Input Stokes' increment in vis.
C      INCFI   I      Input frequency increment in vis.
C      INCIFI  I      Input IF increment in vis.
C   Out:
C      DBUF    R(*)   spectrum buffer
C      WBUF    R(*)   work buffer
C   Output:
C      IRET    I      Return code, 0 => OK, otherwise abort.
C-----------------------------------------------------------------------
      INTEGER   NC, NI, NS, IRET
      REAL      DBUF(NC,NI,NS,*), WBUF(*)
C
      INCLUDE 'VLBRF.INC'
      INTEGER   JI, JC, JS, IA1, IA2, I, INDEX, NN, IT, NCOUNT(MAXCIF),
     *   JST, LANT, MINRNO, MAXRNO, JNXRNO(86400), JNX, IT1, IT2
      REAL      BASEN, X, MEDIAN, XX, VR, VW
      INCLUDE 'INCS:DMSG.INC'
      INCLUDE 'INCS:DDCH.INC'
      INCLUDE 'INCS:DUVH.INC'
      INCLUDE 'INCS:DSEL.INC'
      INCLUDE 'INCS:DHDR.INC'
C-----------------------------------------------------------------------
      CALL FILL (MAXANT, 0, ANTENS)
      DO 100 LANT = 1,MAXA
         IF (NUMT(LANT).LE.0) GO TO 100
         ANTENS(1) = LANT
         CALL FILL (MAXCIF, 0, NCOUNT)
C                                       Open and init for read
         CALL UVGET ('INIT', RPARM, VIS, IRET)
         IF (IRET.NE.0) THEN
            WRITE (MSGTXT,1000) IRET, LANT, 'INIT READ OF DATA'
            GO TO 990
            END IF
         CALL UVPGET (IRET)
         IT = 0
         MINRNO = 100000
         MAXRNO = 0
C                                       Loop
C                                       Read vis. record.
 10      CALL UVGET ('READ', RPARM, VIS, IRET)
         IF (IRET.GT.0) THEN
            WRITE (MSGTXT,1000) IRET, LANT, 'READ OF DATA'
            GO TO 990
C                                       Last or good
         ELSE IF (IRET.EQ.0) THEN
            IF (ILOCB.GE.0) THEN
               BASEN = RPARM(1+ILOCB)
               IA1 = BASEN / 256. + 0.1
               IA2 = BASEN - IA1*256. + 0.1
            ELSE
               IA1 = RPARM(1+ILOCA1) + 0.1
               IA2 = RPARM(1+ILOCA2) + 0.1
               END IF
            IF ((IA1.EQ.IA2) .AND. (IA1.EQ.LANT)) THEN
               IT = IT + 1
               IF (DOSCAN.GT.0.0) THEN
                  JNXRNO(IT) = INXRNO
                  MAXRNO = MAX (MAXRNO, INXRNO)
                  MINRNO = MIN (MINRNO, INXRNO)
               ELSE
                  JNXRNO(IT) = 1
                  END IF
               DO 40 JS = 1,NS
                  DO 30 JI = 1,NI
                     DO 20 JC = 1,NC
                        INDEX = ((JI-1) * INCIFI + (JC-1) * INCFI +
     *                     (JS-1) * INCSI) * 3
                        VR = VIS(1+INDEX)
                        VW = VIS(3+INDEX)
                        IF (VW.LE.0.0) THEN
                           DBUF(JC,JI,JS,IT) = FBLANK
                        ELSE
                           DBUF(JC,JI,JS,IT) = VR
                           END IF
 20                     CONTINUE
 30                  CONTINUE
 40               CONTINUE
               END IF
            GO TO 10
            END IF
C                                       Close files
         CALL UVGET ('CLOS', RPARM, VIS, IRET)
C                                       now find stats
         IF (DOSCAN.LE.0) THEN
            MINRNO = 1
            MAXRNO = 1
            END IF
         DO 85 JNX = MINRNO,MAXRNO
            IT1 = IT + 1
            IT2 = 0
            DO 84 I = 1,IT
               IF (JNXRNO(I).EQ.JNX) THEN
                  IT1 = MIN (IT1, I)
                  IT2 = MAX (IT2, I)
                  END IF
 84            CONTINUE
            IF (IT1.GT.IT2) GO TO 85
            DO 80 JST = 1,NS
               JS = 0
               DO 70 JI = 1,NI
                  DO 60 JC = 1,NC
                     JS = JS + 1
                     NN = 0
                     DO 50 I = IT1,IT2
                        IF (DBUF(JC,JI,JST,I).NE.FBLANK) THEN
                           NN = NN + 1
                           WBUF(NN) = DBUF(JC,JI,JST,I)
                           IF (DOALL.GT.0.0) THEN
                              PMIN(JS,LANT) = MIN (PMIN(JS,LANT),
     *                           WBUF(NN))
                              PMAX(JS,LANT) = MAX (PMAX(JS,LANT),
     *                           WBUF(NN))
                              END IF
                           END IF
 50                     CONTINUE
C                                       find median
                     IF (NN.GT.0) THEN
                        NCOUNT(JS) = NCOUNT(JS) + 1
                        X = MEDIAN (NN, WBUF)
                        PMEAN(JS,LANT) = PMEAN(JS,LANT) + X
                        IF (DOALL.LE.0.0) THEN
                           PMAX(JS,LANT) = MAX (PMAX(JS,LANT), X)
                           PMIN(JS,LANT) = MIN (PMIN(JS,LANT), X)
                           END IF
C                                       now mad
                        DO 55 I = 1,NN
                           WBUF(I) = ABS (WBUF(I) - X)
 55                        CONTINUE
                        XX = 1.4826 * MEDIAN (NN, WBUF)
                        RMEAN(JS,LANT) = RMEAN(JS,LANT) + XX
                        RMAX(JS,LANT) = MAX (RMAX(JS,LANT), XX)
                        RMIN(JS,LANT) = MIN (RMIN(JS,LANT), XX)
                        XX = XX / ABS (X)
                        MMEAN(JS,LANT) = MMEAN(JS,LANT) + XX
                        MMIN(JS,LANT) = MIN (MMIN(JS,LANT), XX)
                        MMAX(JS,LANT) = MAX (MMAX(JS,LANT), XX)
                        END IF
 60                  CONTINUE
 70               CONTINUE
 80            CONTINUE
 85         CONTINUE
         JS = NC * NI
         DO 90 JC = 1,JS
            IF (NCOUNT(JC).GT.0) THEN
               GOTANT(LANT) = .TRUE.
               NANT = MAX (NANT, LANT)
               PMEAN(JC,LANT) = PMEAN(JC,LANT) / NCOUNT(JC)
               RMEAN(JC,LANT) = RMEAN(JC,LANT) / NCOUNT(JC)
               MMEAN(JC,LANT) = MMEAN(JC,LANT) / NCOUNT(JC)
            ELSE IF (NCOUNT(JC).LE.0) THEN
               PMEAN(JC,LANT) = FBLANK
               RMEAN(JC,LANT) = FBLANK
               MMEAN(JC,LANT) = FBLANK
               END IF
            IF ((PMEAN(JC,LANT).EQ.0.0) .OR. (PMEAN(JC,LANT).EQ.FBLANK))
     *         THEN
               RMEAN(JC,LANT) = FBLANK
               RMAX(JC,LANT) = FBLANK
               RMIN(JC,LANT) = FBLANK
               MMEAN(JC,LANT) = FBLANK
               MMAX(JC,LANT) = FBLANK
               MMIN(JC,LANT) = FBLANK
               END IF
 90         CONTINUE
 100     CONTINUE
      GO TO 999
C                                       Error
 990  CALL MSGWRT (8)
C
 999  RETURN
C-----------------------------------------------------------------------
 1000 FORMAT ('VLBRFR: ERROR',I3,' ANT',I4,' ON ',A)
      END
      SUBROUTINE VLBRFC (IRET)
C-----------------------------------------------------------------------
C   VLBRFC writes out the results to a text file for the data base
C   Output:
C      IRET   I   Error code
C-----------------------------------------------------------------------
      INTEGER   IRET
C
      INCLUDE 'VLBRF.INC'
      INTEGER   TXLUN, TXIND, JI, JC, I, JT, JTRIM, JA, IDOSCN, IFMT, KT
      REAL      REFPIX, REFINC, YMIN, YMAX
      DOUBLE PRECISION REFREQ, F
      CHARACTER DATOBS*8, OUTLIN*256
      INCLUDE 'INCS:DMSG.INC'
      INCLUDE 'INCS:DHDR.INC'
      INCLUDE 'INCS:DUVH.INC'
      INCLUDE 'INCS:DDCH.INC'
      INCLUDE 'INCS:DANS.INC'
      INCLUDE 'INCS:DSEL.INC'
      INCLUDE 'INCS:DCHND.INC'
      DATA TXLUN /3/
C-----------------------------------------------------------------------
      IDOSCN = 0
      IF (DOSCAN.GT.0.0) IDOSCN = 1
C                                       open output file
      CALL ZTXOPN ('WRIT', TXLUN, TXIND, OUTFIL, .TRUE., IRET)
      IF (IRET.NE.0) THEN
         WRITE (MSGTXT,1000) IRET, 'OPEN OUTPUT TEXT FILE'
         GO TO 990
         END IF
      REFREQ = CATOD(KDCRV+JLOCF)
      REFPIX = CATOR(KRCRP+JLOCF)
      REFINC = CATOR(KRCIC+JLOCF)
      CALL H2CHR (8, 1, CATOH(KHDOB), DATOBS)
C                                       loop over antennas
      DO 100 JA = 1,20
         IF (.NOT.GOTANT(JA)) GO TO 100
         JT = JTRIM (STNNAM(JA))
         KT = JTRIM (STOKES)
         WRITE (OUTLIN,2000) DATOBS, JA, STNNAM(JA)(:JT), IDOSCN,
     *      STOKES(:KT)
         JT = JTRIM (OUTLIN)
         CALL ZTXIO ('WRIT', TXLUN, TXIND, OUTLIN(:JT), IRET)
         IF (IRET.NE.0) THEN
            WRITE (MSGTXT,1000) IRET, 'WRITING OBS DATE TO TEXT FILE'
            GO TO 990
            END IF
         WRITE (OUTLIN,2010)
         JT = JTRIM (OUTLIN)
         CALL ZTXIO ('WRIT', TXLUN, TXIND, OUTLIN(:JT), IRET)
         IF (IRET.NE.0) THEN
            WRITE (MSGTXT,1000) IRET, 'WRITING HEADER TO TEXT FILE'
            GO TO 990
            END IF
         WRITE (OUTLIN,2011)
         JT = JTRIM (OUTLIN)
         CALL ZTXIO ('WRIT', TXLUN, TXIND, OUTLIN(:JT), IRET)
         IF (IRET.NE.0) THEN
            WRITE (MSGTXT,1000) IRET, 'WRITING HEADER TO TEXT FILE'
            GO TO 990
            END IF
C                                       format?
         YMIN = 1.E10
         YMAX = -1.E10
         I = 0
         DO 30 JI = BIF,EIF
            DO 20 JC = BCHAN,ECHAN
               I = I + 1
               IF (PMEAN(I,JA).NE.FBLANK) THEN
                  YMIN = MIN (YMIN, PMIN(I,JA))
                  YMIN = MIN (YMIN, RMIN(I,JA))
                  YMAX = MAX (YMAX, PMAX(I,JA))
                  YMAX = MAX (YMAX, RMAX(I,JA))
                  END IF
 20            CONTINUE
 30         CONTINUE
         IFMT = 1
         IF (YMIN.GT.0.0995) IFMT = 0
         IF (YMAX.GT.1000.) IFMT = 0
C                                       now the data
         I = 0
         DO 50 JI = BIF,EIF
            DO 40 JC = BCHAN,ECHAN
               I = I + 1
               IF (PMEAN(I,JA).NE.FBLANK) THEN
                  F = (REFREQ + FOFF(JI) + (JC - REFPIX) * FINC(JI)) /
     *               1.D9
                  IF (IFMT.EQ.0) THEN
                     WRITE (OUTLIN,2020) JI, JC, F, PMEAN(I,JA),
     *                  PMIN(I,JA), PMAX(I,JA), RMEAN(I,JA),
     *                  RMIN(I,JA), RMAX(I,JA), MMEAN(I,JA)*1000.,
     *                  MMIN(I,JA)*1000., MMAX(I,JA)*1000.
                  ELSE
                     WRITE (OUTLIN,2021) JI, JC, F, PMEAN(I,JA),
     *                  PMIN(I,JA), PMAX(I,JA), RMEAN(I,JA),
     *                  RMIN(I,JA), RMAX(I,JA), MMEAN(I,JA)*1000.,
     *                  MMIN(I,JA)*1000., MMAX(I,JA)*1000.
                     END IF
                  JT = JTRIM (OUTLIN)
                  CALL ZTXIO ('WRIT', TXLUN, TXIND, OUTLIN(:JT), IRET)
                  IF (IRET.NE.0) THEN
                     WRITE (MSGTXT,1000) IRET,
     *                  'WRITING RESULTS TO TEXT FILE'
                     GO TO 990
                     END IF
                  END IF
 40            CONTINUE
 50         CONTINUE
C                                       Tear off line
         DO 60 I = 1,JT
            OUTLIN(I:I) = '#'
 60         CONTINUE
         CALL ZTXIO ('WRIT', TXLUN, TXIND, OUTLIN(:JT), IRET)
         IF (IRET.NE.0) THEN
            WRITE (MSGTXT,1000) IRET, 'WRITING BREAK LINE TO TEXT FILE'
            GO TO 990
            END IF
 100     CONTINUE
      CALL ZTXCLS (TXLUN, TXIND, IRET)
      IF (IRET.NE.0) THEN
         WRITE (MSGTXT,1000) IRET, 'CLOSING TEXT FILE'
         GO TO 990
         END IF
      GO TO 999
C
 990  CALL MSGWRT (8)
C
 999  RETURN
C-----------------------------------------------------------------------
 1000 FORMAT ('VLBRFC ERROR',I4,' ON ',A)
 2000 FORMAT ('**** DATEOBS = ''',A,'''',3X,'ANTENNA=',I3,3X,
     *   'STATION = ''',A,'''  TASK=''VLBRF''  DOSCAN=',I1,
     *   '  STOKES=''',A,'''')
 2010 FORMAT ('# IF CHAN',4X,'FREQ',10X,'Pmean',10X,'Pmin',10X,'Pmax',
     *   10X,'Rmean',10X,'Rmin',10X,'Rmax',8X,'Mmean',6X,'Mmin',7X,
     *   'Mmax')
 2011 FORMAT ('#',12X,'GHz',88X,3(6X,'milli'))
 2020 FORMAT (I4,I5,F11.5,6F14.3,3F11.3)
 2021 FORMAT (I4,I5,F11.5,6F14.4,3F11.3)
      END
      SUBROUTINE VLBRFH
C-----------------------------------------------------------------------
C   Writes info into history file
C-----------------------------------------------------------------------
C
      INCLUDE 'VLBRF.INC'
      INTEGER   LUN, LUNTMP, TIME(3), DATE(3), IERR, BUFF2(256), JTRIM
      CHARACTER CTIME(2)*12, HILINE*72
      INCLUDE 'INCS:DMSG.INC'
      INCLUDE 'INCS:DDCH.INC'
C-----------------------------------------------------------------------
      IF ((OUTFIL.EQ.' ') .AND. (DOPLOT.LE.0)) GO TO 999
C
      LUN = LUNTMP(1)
      CALL HIINIT (3)
C                                       Open old history
      CALL HIOPEN (LUN, DISKIN, OLDCNO, BUFF2, IERR)
      IF (IERR.NE.0) GO TO 200
C                                       Task message
      CALL ZDATE (DATE)
      CALL ZTIME (TIME)
      CALL TIMDAT (TIME, DATE, CTIME(2), CTIME)
      WRITE (HILINE,1000) TSKNAM, RLSNAM, CTIME
      CALL HIADD (LUN, HILINE, BUFF2, IERR)
      IF (IERR.NE.0) GO TO 200
C                                       calibration et al.
      CALL CALHIS (LUN, BUFF2, IERR)
      IF (IERR.NE.0) GO TO 200
C
      HILINE = TSKNAM // 'OUTFILE=''' // OUTFIL(1:JTRIM(OUTFIL)) //
     *   ''''
      CALL HIADD (LUN, HILINE, BUFF2, IERR)
      IF (IERR.NE.0) GO TO 200
      IF (DOALL.GT.0.0) THEN
         WRITE (HILINE,1010) TSKNAM, DOALL, 'max/min over all times'
      ELSE
         WRITE (HILINE,1010) TSKNAM, DOALL, 'max/min over pol averages'
         END IF
      CALL HIADD (LUN, HILINE, BUFF2, IERR)
      IF (IERR.NE.0) GO TO 200
C                                       Close HI file
 200  CALL HICLOS (LUN, .TRUE., BUFF2, IERR)
C
 999  RETURN
C-----------------------------------------------------------------------
 1000 FORMAT (A6,'RELEASE =''',A7,' ''  /********* Start ',
     *   A12,2X,A8)
 1010 FORMAT (A6,'DOALL =',F4.1,'    / ',A)
      END
      SUBROUTINE VLBRFP (KTYPE, LPX, LPY, SP, SN, SX, JANT, IRET)
C-----------------------------------------------------------------------
C   VLBRFP plots the the mean and std spectra
C   Inputs:
C       KTYPE    I       1 all three, 2 mean, 3 std, 4 std/mean, - LAST
C       LPX      I       X panel number (1 to NXP)  left to right
C       LPY      I       Y panel number (1 to NYP)  top to bottom
C       SP       R(*)    spectrum mean to plot
C       SN       R(*)    spectrum min to plot
C       SX       R(*)    spectrum max to plot
C    Outputs:
C       IRET     I       > 0 => plot failure
C-----------------------------------------------------------------------
      INTEGER   KTYPE, LPX, LPY, JANT, IRET
      REAL      SP(*), SN(*), SX(*)
C
      INCLUDE 'VLBRF.INC'
      INTEGER   I, PLUN, PLBUFF(256), IVER, TVCHN, TVCORN(4), IDEPTH(5),
     *   J, LTYPE, LABEL, PIND, IROUND, NC, NI, JC, JI, NOFF(MAXIF),
     *   INCHAR, ITYPE, PLTYIN, PLTXIN, PLTYOF, PLTXOF
      LOGICAL   DOTV, GOOD, FIRST, DOSP, DOPLT(3)
      CHARACTER PFILE*48, CHT12*12, CHT6*6, CHTY*2, MSGBUF*24
      REAL      YMAX, YMIN, BLC(2), TRC(2), CH(4), X, FAC, XYRATO, DX,
     *   DY, XMIN, XMAX, LOCRAN(2), XYRAT, Y, XPSAVE(2), APSAVE(4), YP,
     *   SPDIFF, SPMEAN, NSP, REFPIX, REFINC, XBLC(2), XTRC(2), XSC, SPD
      DOUBLE PRECISION F, REFREQ
      INCLUDE 'INCS:DMSG.INC'
      INCLUDE 'INCS:DSEL.INC'
      INCLUDE 'INCS:DTVC.INC'
      INCLUDE 'INCS:DFIL.INC'
      INCLUDE 'INCS:DGPH.INC'
      INCLUDE 'INCS:DDCH.INC'
      INCLUDE 'INCS:DANS.INC'
      INCLUDE 'INCS:DHDR.INC'
      INCLUDE 'INCS:DUVH.INC'
      INCLUDE 'INCS:DCHND.INC'
      SAVE FIRST
      DATA TVCHN, TVCORN, IDEPTH /1, 4*0, 5*1/
      DATA FIRST /.TRUE./
C-----------------------------------------------------------------------
      I = APARM(10) + 0.1
      DOPLT(1) = MOD(I,2).EQ.0 .OR. (ABS(KTYPE).EQ.1)
      I = I/2
      DOPLT(2) = MOD(I,2).EQ.0
      I = I/2
      DOPLT(3) = MOD(I,2).EQ.0
      DOTV = XDOTV.GT.0.0
      CALL RCOPY (2, XPIXR, XPSAVE)
      CALL RCOPY (4, APARM, APSAVE)
      REFREQ = CATOD(KDCRV+JLOCF)
      REFPIX = CATOR(KRCRP+JLOCF)
      REFINC = CATOR(KRCIC+JLOCF)
C                                       for EXTLIST
      ITYPE = ABS (KTYPE)
      XANT(1) = JANT
      XANT(2) = ITYPE
      CALL CHR2H (8, STNNAM(JANT), 1, XANT(3))
C                                       Y scale
      YMAX = -1.E10
      YMIN = -YMAX
      NC = (ECHAN - BCHAN + 1)
      NI = (EIF - BIF + 1)
      JC = NC * NI
      SPMEAN = 0.0
      NSP = 0.0
      SPDIFF = 0.0
      SPD = 0.0
      DO 10 I = 1,JC
         IF (SP(I).NE.FBLANK) THEN
            YMIN = MIN (YMIN, SP(I))
            YMAX = MAX (YMAX, SP(I))
            END IF
         IF (ITYPE.NE.1) THEN
            IF ((SN(I).NE.FBLANK) .AND. (SX(I).NE.FBLANK) .AND.
     *         (SN(I).GT.SX(I))) THEN
               SN(I) = FBLANK
               SX(I) = FBLANK
               END IF
            IF (SN(I).NE.FBLANK) YMIN = MIN (YMIN, SN(I))
            IF (SX(I).NE.FBLANK) YMAX = MAX (YMAX, SX(I))
            IF ((SP(I).NE.FBLANK) .AND. (SN(I).NE.FBLANK) .AND.
     *         (SX(I).NE.FBLANK)) THEN
               SPDIFF = MAX (SPDIFF, ABS(2*SP(I)-SX(I)-SN(I)))
               SPMEAN = SPMEAN + SP(I)
               SPD = MAX (SPD, SX(I)-SN(I))
               NSP = NSP + 1.
               END IF
         ELSE
            IF (SN(I).NE.FBLANK) THEN
               YMIN = MIN (YMIN, SN(I))
               YMAX = MAX (YMAX, SN(I))
               END IF
            IF (SX(I).NE.FBLANK) THEN
               YMIN = MIN (YMIN, SX(I))
               YMAX = MAX (YMAX, SX(I))
               END IF
            END IF
 10      CONTINUE
      IF (ITYPE.EQ.1) SPDIFF = 1.
      IF (NSP.GT.0) SPMEAN = SPMEAN / NSP
      DOSP = (SPDIFF.GT.SPMEAN/1000.0) .AND. ((DOPLOT.LT.2.0) .OR.
     *   (ITYPE.EQ.1))
      DOSP = DOSP .OR. (SPDIFF.LT.1.E-6)
      SPD = SPD / SPMEAN
      IF (ITYPE.EQ.1) SPD = 1.
      IF (ITYPE.LE.2) THEN
         IF (XPIXR(2).GT.XPIXR(1)) THEN
            YMAX = XPIXR(2)
            YMIN = XPIXR(1)
         ELSE IF (XPIXR(2).EQ.0.0) THEN
            CALL DIDDLE (SP, SN, SX, YMIN, YMAX)
            END IF
      ELSE IF (ITYPE.EQ.3) THEN
         IF (APARM(2).GT.APARM(1)) THEN
            YMAX = APARM(2)
            YMIN = APARM(1)
         ELSE IF (APARM(2).EQ.0.0) THEN
            CALL DIDDLE (SP, SN, SX, YMIN, YMAX)
            END IF
      ELSE
         IF (APARM(4).GT.APARM(3)) THEN
            YMAX = APARM(4)
            YMIN = APARM(3)
         ELSE IF (APARM(4).EQ.0.0) THEN
            CALL DIDDLE (SP, SN, SX, YMIN, YMAX)
            END IF
         END IF
      IF (ITYPE.LE.2) THEN
         XPIXR(2) = YMAX + 0.04 * (YMAX - YMIN)
         XPIXR(1) = YMIN - 0.04 * (YMAX - YMIN)
         YMAX = XPIXR(2)
         YMIN = XPIXR(1)
      ELSE IF (ITYPE.EQ.3) THEN
         APARM(2) = YMAX + 0.04 * (YMAX - YMIN)
         APARM(1) = YMIN - 0.04 * (YMAX - YMIN)
         YMAX = APARM(2)
         YMIN = APARM(1)
      ELSE
         APARM(4) = YMAX + 0.04 * (YMAX - YMIN)
         APARM(3) = YMIN - 0.04 * (YMAX - YMIN)
         YMAX = APARM(4)
         YMIN = APARM(3)
         END IF
      XMIN = 0.0
      XMAX = (NC + 1) * NI
C                                       Add plot file to the image
C                                       catalog header.
      IF ((.NOT.DOTV) .AND. (LPX.EQ.1) .AND. (LPY.EQ.1)) THEN
         CHT12 = ' '
         CHT6 = ' '
         CHTY = ' '
         IVER = 0
         IF (FIRST) THEN
            CALL CATDIR ('CSTA', DISKIN, OLDCNO, CHT12, CHT6, 0, CHTY,
     *         0, 'CLRD', SCRBUF, IRET)
            IF (IRET.EQ.0) CALL CATDIR ('CSTA', DISKIN, OLDCNO, CHT12,
     *         CHT6, 0, CHTY, 0, 'WRIT', SCRBUF, IRET)
            FRW(NCFILE) = 1
            FIRST = .FALSE.
            END IF
         CALL MADDEX ('PL', DISKIN, OLDCNO, CATOLD, PLBUFF, .TRUE.,
     *      'WRIT', IVER, IRET)
         IF (IRET.NE.0) THEN
            MSGTXT = 'PLHGM: ERROR UPDATING CATALOGUE HEADER.'
            CALL MSGWRT (8)
            GO TO 999
            END IF
         END IF
C                                       Open the PLot file.
      IF ((LPX.EQ.1) .AND. (LPY.EQ.1)) THEN
         CALL ZPHFIL ('PL', DISKIN, OLDCNO, IVER, PFILE, IRET)
         CALL GINIT (DISKIN, OLDCNO, PFILE, 0, 76, NPARM, XNAMEI, DOTV,
     *      TVCHN, GRCHAN, TVCORN, CATOLD, PLBUFF, PLUN, PIND, IRET)
         IF (IRET.NE.0) THEN
            MSGTXT = 'VLBRFP: ERROR OPENING PLOT FILE.'
            CALL MSGWRT (8)
            IF (.NOT.DOTV) CALL DELEXT ('PL', DISKIN, OLDCNO, 'WRIT',
     *         CATOLD, PLBUFF, IVER, I)
            GO TO 999
            END IF
         END IF
C                                       Set character offsets.
      LABEL = IROUND (XLABEL)
      LTYPE = MOD (ABS (LABEL), 100)
      LOCRAN(2) = YMAX
      LOCRAN(1) = YMIN
      CALL GTICNT (LABEL, LOCRAN, I)
      CALL RFILL (4, 0.5, CH)
      IF (LTYPE.EQ.2) CH(1) = 3.5
      IF (LTYPE.GT.2) CH(1) = I + 4.0
      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) + 1.333
         CH(4) = 2.0
         IF (LABEL.GT.0) CH(4) = CH(4) + 1.333
         END IF
C                                       Set BLC, TRC, XYRATO.
      PLTXIN = 1000.0 / (NXP - 0.25)
      PLTYIN = 1000.0 / (NYP - 0.10)
      PLTXOF = NXP * PLTXIN - 1000.
      PLTYOF = NYP * PLTYIN - 1000.
      BLC(1) = 0.0
      BLC(2) = 0.0
      TRC(1) = 1000.0
      TRC(2) = 1000.0
      IF (DOTV) THEN
         DX = WINDTV(3) - WINDTV(1) + 1 - CSIZTV(1) * (CH(1) + CH(3))
         DY = WINDTV(4) - WINDTV(2) + 1 - CSIZTV(2) * (CH(2) + CH(4))
         XYRATO = 1.0
         IF (DY.GT.0.0) XYRATO = DX / DY
      ELSE
         XYRATO = 1.4
         END IF
      XYRAT = (TRC(1) - BLC(1)) / (TRC(2) - BLC(2))
      XYRAT = XYRATO / XYRAT
C                                       sub window parms
      XBLC(1) = BLC(1) + (LPX-1) * PLTXIN
      XTRC(1) = XBLC(1) + PLTXIN - 1.0 - PLTXOF
      XBLC(2) = BLC(2) + (NYP-LPY) * PLTYIN
      XTRC(2) = XBLC(2) + PLTYIN - 1.0 - PLTYOF
C                                       Initialize for line drawing
      IF ((LPX.EQ.1) .AND. (LPY.EQ.1)) THEN
         CALL GINITL (BLC, TRC, XYRAT, CH, IDEPTH, PLBUFF, IRET)
         IF (IRET.NE.0) THEN
            MSGTXT = 'DRWHGM: ERROR INITIALIZING FOR LINE DRAWING.'
            GO TO 950
            END IF
         END IF
      CALL GLTYPE (1, PLBUFF, IRET)
      IF (IRET.NE.0) GO TO 920
C                                       Draw borders.
      CALL GPOS (XBLC(1), XBLC(2), PLBUFF, IRET)
      IF (IRET.NE.0) GO TO 910
      CALL GVEC (XTRC(1), XBLC(2), PLBUFF, IRET)
      IF (IRET.NE.0) GO TO 920
      CALL GVEC (XTRC(1), XTRC(2), PLBUFF, IRET)
      IF (IRET.NE.0) GO TO 920
      CALL GVEC (XBLC(1), XTRC(2), PLBUFF, IRET)
      IF (IRET.NE.0) GO TO 920
      CALL GVEC (XBLC(1), XBLC(2), PLBUFF, IRET)
      IF (IRET.NE.0) GO TO 920
C                                       dividers
      DO 25 I = 1,NI-1
         IF (FRQLAB) THEN
            F = (REFREQ + FOFF(BIF+I) - REFPIX * FINC(BIF+I))
            X = (F - FRQMIN) / (FRQMAX-FRQMIN) * (XTRC(1) - XBLC(1))
     *         + XBLC(1)
         ELSE
            X = (I * (NC+1.0)) / (NI * (NC+1.0)) * (XTRC(1)-XBLC(1)) +
     *         XBLC(1)
            END IF
         CALL GPOS (X, XTRC(2), PLBUFF, IRET)
         IF (IRET.NE.0) GO TO 999
         CALL GVEC (X, XBLC(2), PLBUFF, IRET)
         IF (IRET.NE.0) GO TO 999
 25      CONTINUE
C                                       Labeling.
      CALL RMSLAB (ITYPE, XBLC, XTRC, FAC, XMIN, XMAX, YMIN, YMAX, NC,
     *   NI, BCHAN, BIF, IVER, LABEL, CATOLD, JANT, STNNAM(JANT),
     *   STOKES, APARM(5), FRQMAX, LPX, LPY, NYP, PLBUFF, IRET)
      IF (IRET.NE.0) GO TO 999
C                                       Draw the data
      XSC = (XTRC(1) - XBLC(1)) / (NI * (NC+1.0))
      DO 26 I = 4,2,-1
         CALL GLTYPE (I, PLBUFF, IRET)
         IF (IRET.NE.0) GO TO 920
         IF (DOTV) THEN
            CALL GCINIT (GPHTVG(GPHLTY), 0, IRET)
            IF (IRET.NE.0) GO TO 920
            END IF
 26      CONTINUE
      CALL FILL (NI, 0, NOFF)
      IF ((FACTOR.LT.0.0) .AND. (DOSP) .AND. (DOPLT(1))) THEN
         I = 0
         J = 0
         DX = 0.5 * ABS(FACTOR)
         DY = 0.5 * (XTRC(2) - XBLC(2)) / ((NC + 1.0)* NI) * ABS(FACTOR)
         CALL GPOS (X, 1.0, PLBUFF, IRET)
         IF (IRET.NE.0) GO TO 910
         DO 40 JI = BIF,EIF
            DO 30 JC = BCHAN,ECHAN
               I = I + 1
               IF (FRQLAB) THEN
                  F = (REFREQ + FOFF(JI) + (JC - REFPIX) * FINC(JI))
                  X = (F - FRQMIN) / (FRQMAX-FRQMIN) * (XTRC(1)-XBLC(1))
     *               + XBLC(1)
               ELSE
                  X = I * XSC + XBLC(1)
                  END IF
               J = J + 1
               IF (SP(J).NE.FBLANK) THEN
                  Y = (SP(J) - YMIN) / (YMAX - YMIN) * (XTRC(2)-XBLC(2))
     *               + XBLC(2)
                  IF ((Y.LT.XBLC(2)) .OR. (Y.GT.XTRC(2))) THEN
                     NOFF(JI) = NOFF(JI) + 1
                     Y = MAX (XBLC(2), MIN (XTRC(2), Y))
                     END IF
                  CALL GPOS (X-DX, Y+DY, PLBUFF, IRET)
                  IF (IRET.NE.0) GO TO 910
                  CALL GVEC (X+DX, Y-DY, PLBUFF, IRET)
                  IF (IRET.NE.0) GO TO 920
                  CALL GPOS (X+DX, Y+DY, PLBUFF, IRET)
                  IF (IRET.NE.0) GO TO 910
                  CALL GVEC (X-DX, Y-DY, PLBUFF, IRET)
                  IF (IRET.NE.0) GO TO 920
                  END IF
  30           CONTINUE
            I = I + 1
  40        CONTINUE
      ELSE IF ((DOSP) .AND. (DOPLT(1))) THEN
         I = 0
         J = 0
         DO 50 JI = BIF,EIF
            GOOD = .FALSE.
            DO 45 JC = BCHAN,ECHAN
               I = I + 1
               IF (FRQLAB) THEN
                  F = (REFREQ + FOFF(JI) + (JC - REFPIX) * FINC(JI))
                  X = (F - FRQMIN) / (FRQMAX-FRQMIN) * (XTRC(1)-XBLC(1))
     *               + XBLC(1)
               ELSE
                  X = I * XSC + XBLC(1)
                  END IF
               J = J + 1
               IF (SP(J).NE.FBLANK) THEN
                  Y = (SP(J) - YMIN) / (YMAX - YMIN) * (XTRC(2)-XBLC(2))
     *               + XBLC(2)
                  IF ((Y.LT.XBLC(2)) .OR. (Y.GT.XTRC(2))) THEN
                     NOFF(JI) = NOFF(JI) + 1
                     Y = MAX (XBLC(2), MIN (XTRC(2), Y))
                     END IF
                  IF (GOOD) THEN
                     CALL GVEC (X, Y, PLBUFF, IRET)
                     IF (IRET.NE.0) GO TO 920
                  ELSE
                     CALL GPOS (X, Y, PLBUFF, IRET)
                     IF (IRET.NE.0) GO TO 910
                     END IF
                  GOOD = .TRUE.
               ELSE
                  GOOD = .FALSE.
                  END IF
 45            CONTINUE
            I = I + 1
 50         CONTINUE
         END IF
C                                       if max=min do not plot
      IF ((SPD.GE.1.E-4) .AND. (DOPLT(2))) THEN
         CALL GLTYPE (4, PLBUFF, IRET)
         IF (IRET.NE.0) GO TO 920
         IF (DOTV) THEN
            CALL GCINIT (GPHTVG(GPHLTY), 0, IRET)
            IF (IRET.NE.0) GO TO 920
            END IF
         I = 0
         J = 0
         DO 60 JI = BIF,EIF
            GOOD = .FALSE.
            DO 55 JC = BCHAN,ECHAN
               I = I + 1
               IF (FRQLAB) THEN
                  F = (REFREQ + FOFF(JI) + (JC - REFPIX) * FINC(JI))
                  X = (F - FRQMIN) / (FRQMAX-FRQMIN) * (XTRC(1)-XBLC(1))
     *               + XBLC(1)
               ELSE
                  X = I * XSC + XBLC(1)
                  END IF
               J = J + 1
               IF (SN(J).NE.FBLANK) THEN
                  Y = (SN(J) - YMIN) / (YMAX - YMIN) * (XTRC(2)-XBLC(2))
     *               + XBLC(2)
                  IF ((Y.LT.XBLC(2)) .OR. (Y.GT.XTRC(2))) THEN
                     NOFF(JI) = NOFF(JI) + 1
                     Y = MAX (XBLC(2), MIN (XTRC(2), Y))
                     END IF
                  IF (GOOD) THEN
                     CALL GVEC (X, Y, PLBUFF, IRET)
                     IF (IRET.NE.0) GO TO 920
                  ELSE
                     CALL GPOS (X, Y, PLBUFF, IRET)
                     IF (IRET.NE.0) GO TO 910
                     END IF
                  GOOD = .TRUE.
               ELSE
                  GOOD = .FALSE.
                  END IF
 55            CONTINUE
            I = I + 1
 60         CONTINUE
         END IF
      IF ((SPD.GE.1.E-4) .AND. (DOPLT(3))) THEN
         CALL GLTYPE (3, PLBUFF, IRET)
         IF (IRET.NE.0) GO TO 920
         IF (DOTV) THEN
            CALL GCINIT (GPHTVG(GPHLTY), 0, IRET)
            IF (IRET.NE.0) GO TO 920
            END IF
         I = 0
         J = 0
         DO 70 JI = BIF,EIF
            GOOD = .FALSE.
            DO 65 JC = BCHAN,ECHAN
               I = I + 1
               IF (FRQLAB) THEN
                  F = (REFREQ + FOFF(JI) + (JC - REFPIX) * FINC(JI))
                  X = (F - FRQMIN) / (FRQMAX-FRQMIN) * (XTRC(1)-XBLC(1))
     *               + XBLC(1)
               ELSE
                  X = I * XSC + XBLC(1)
                  END IF
               J = J + 1
               IF (SX(J).NE.FBLANK) THEN
                  YP = (XTRC(2) + XBLC(2)) / 2.0
                  IF (SP(J).NE.FBLANK) YP = (SP(J) - YMIN) / (YMAX -
     *               YMIN)* (XTRC(2)-XBLC(2)) + XBLC(2)
                  Y = (SX(J) - YMIN) / (YMAX - YMIN) * (XTRC(2)-XBLC(2))
     *               + XBLC(2)
                  IF ((Y.LT.XBLC(2)) .OR. (Y.GT.XTRC(2))) THEN
                     IF ((YP.GT.XBLC(2)) .AND. (YP.LT.XTRC(2))) NOFF(JI)
     *                  = NOFF(JI) + 1
                     Y = MAX (XBLC(2), MIN (XTRC(2), Y))
                     END IF
                  IF (GOOD) THEN
                     CALL GVEC (X, Y, PLBUFF, IRET)
                     IF (IRET.NE.0) GO TO 920
                  ELSE
                     CALL GPOS (X, Y, PLBUFF, IRET)
                     IF (IRET.NE.0) GO TO 910
                     END IF
                  GOOD = .TRUE.
               ELSE
                  GOOD = .FALSE.
                  END IF
 65            CONTINUE
            I = I + 1
 70         CONTINUE
         END IF
      DO 80 JI = 1,NI
         WRITE (MSGTXT,1065) JI+BIF-1, NOFF(JI)
         IF (NOFF(JI).GT.0) THEN
            CALL MSGWRT (3)
            IF (FRQLAB) THEN
               F = (REFREQ + FOFF(BIF+JI-1) - REFPIX * FINC(BIF+JI-1))
               X = (F - FRQMIN) / (FRQMAX-FRQMIN) * (XTRC(1) - XBLC(1))
     *            + XBLC(1)
            ELSE
               X = (JI-1) * (NC + 1.0) + XBLC(1)
               END IF
            CALL GPOS (X, XTRC(2), PLBUFF, IRET)
            IF (IRET.NE.0) GOTO 910
            WRITE (MSGBUF,1060) NOFF(JI)
            CALL CHTRIM (MSGBUF, 8, MSGBUF, INCHAR)
            CALL GLTYPE (1, PLBUFF, IRET)
            IF (IRET.NE.0) GO TO 920
            IF (DOTV) THEN
               CALL GCINIT (GPHTVG(GPHLTY), 0, IRET)
               IF (IRET.NE.0) GO TO 920
               END IF
            CALL GICHAR (1, INCHAR, 0, 4.0, -3.5, MSGBUF, PLBUFF,
     *         IRET)
            IF (IRET.NE.0) GO TO 920
            IF (FRQLAB) THEN
               F = REFREQ + FOFF(BIF+JI) - REFPIX * FINC(BIF+JI)
               IF (BIF+JI.GT.EIF) F = FRQMAX
               X = (F - FRQMIN) / (FRQMAX-FRQMIN) * (XTRC(1) - XBLC(1))
     *            + XBLC(1)
            ELSE
               X = JI * (NC + 1.0) + XBLC(1)
               END IF
            CALL GPOS (X, XTRC(2), PLBUFF, IRET)
            IF (IRET.NE.0) GOTO 910
            DX = -4 - INCHAR
            CALL GICHAR (1, INCHAR, 0, DX, -3.5, MSGBUF, PLBUFF, IRET)
            IF (IRET.NE.0) GO TO 920
            END IF
 80      CONTINUE
      IF (((LPY-1)*NXP + LPX.EQ.NPLOTS) .OR. (KTYPE.LT.0)) THEN
         WRITE (MSGTXT,1070) IVER
         IF (.NOT.DOTV) CALL MSGWRT (3)
         GPHPAG = KTYPE.GT.0
         CALL GFINIS (PLBUFF, IRET)
         IF (IRET.NE.0) GO TO 950
         END IF
      CALL RCOPY (2, XPSAVE, XPIXR)
      CALL RCOPY (4, APSAVE, APARM)
      GO TO 999
C                                       Error return from GPOS.
 910  MSGTXT = 'VLBRFP: PLOT ERROR OCCURRED WHILE MOVING TO A POINT.'
      GO TO 940
C                                       Error return from GVEC.
 920  MSGTXT = 'VLBRFP: PLOT ERROR OCCURRED WHILE DRAWING A LINE.'
 940  CALL MSGWRT (8)
C                                       Destroy the PLot file on error.
 950  IF (.NOT.DOTV) THEN
         WRITE (MSGTXT,1950) IVER
         CALL MSGWRT (8)
         CALL ZCLOSE (PLUN, PIND, I)
         CALL ZDESTR (DISKIN, PFILE, I)
         CALL DELEXT ('PL', DISKIN, OLDCNO, 'WRIT', CATOLD, PLBUFF,
     *      IVER, I)
         END IF
C
 999  RETURN
C-----------------------------------------------------------------------
 1060 FORMAT (I8)
 1065 FORMAT ('IF',I3,I7,' points off the plot')
 1070 FORMAT ('Created plot file version',I4)
 1950 FORMAT ('DESTROY PLOT VERSION',I4,' DUE TO ERRORS')
      END
      SUBROUTINE DIDDLE (SP, SN, SX, YMIN, YMAX)
C-----------------------------------------------------------------------
C   DIDDLE tries to find a revised YMAX s.t. the display range shows
C   most but not all points
C   Inputs:
C       SP       R(*)    spectrum mean to plot
C       SN       R(*)    spectrum min to plot
C       SX       R(*)    spectrum max to plot
C       YMIN     R       Low plot range
C   In/out:
C       YMAX     R       High plot range: in actual extreme, out revised
C-----------------------------------------------------------------------
      REAL      SP(*), SN(*), SX(*), YMIN, YMAX
C
      INCLUDE 'VLBRF.INC'
      INTEGER   NST
      PARAMETER (NST=200)
C
      INTEGER   I, NOUT(NST), J, NC, NI, JC, NTOT
      REAL      YMAXIN, YX(NST)
      INCLUDE 'INCS:DDCH.INC'
      INCLUDE 'INCS:DSEL.INC'
C-----------------------------------------------------------------------
      YMAXIN = YMAX
      YMAXIN = MIN (1.E6, YMAXIN)
      DO 10 I = 1,NST
         YX(I) = YMAXIN * I / REAL (NST)
 10      CONTINUE
      CALL FILL (NST, 0, NOUT)
      NTOT = 0
      NC = (ECHAN - BCHAN + 1)
      NI = (EIF - BIF + 1)
      JC = NC * NI
      DO 40 I = 1,JC
         IF ((SP(I).NE.FBLANK) .AND. (SX(I).NE.FBLANK)) THEN
            NTOT = NTOT + 1
            DO 20 J = 1,NST
               IF ((SP(I).GT.YX(J)) .OR. (SX(I).GT.YX(J))) NOUT(J) =
     *            NOUT(J) + 1
 20            CONTINUE
            END IF
 40      CONTINUE
      I = NST
      DO 50 J = NST,1,-1
         YX(J) = REAL (NOUT(J)) / REAL (NTOT)
         IF (YX(J).LT.0.05) I = J
 50      CONTINUE
      YMAX = YMAXIN * I / REAL (NST)
C
 999  RETURN
      END
      SUBROUTINE RMSLAB (ITY, BLC, TRC, FAC, XMIN, XMAX, YMIN, YMAX,
     *   NC, NI, LBCHAN, LBIF, IVER, LABEL, CATOLD, JANT, STN, STOKES,
     *   LABFRQ, FRQMAX, LPX, LPY, NYP, PLBUFF, IRET)
C-----------------------------------------------------------------------
C   Write labeling for VLBRF plots
C   Inputs:
C      ITY     I        Plot type: 1 all 3, 2 mean, 3 std, 4 std/mean
C      BLC     R(2)     bottom left corner of plot.
C      TRC     R(2)     top right hand corner of plot.
C      FAC     R        FAC*XYRATO = real XYRATIO.
C      IVER    I        plot file version number
C      LABEL   I        labeling type
C      LABFRQ  R        <= 0 label frequency else channels
C   In/out:
C      PLBUFF   I(256)   I/O buffer for plot file.
C   Output:
C      IRET    I        error code returned from GVEC.
C-----------------------------------------------------------------------
      REAL      BLC(2), TRC(2), FAC, XMIN, XMAX, YMIN, YMAX, LABFRQ
      INTEGER   ITY, NC, NI, LBCHAN, LBIF, IVER, LABEL, CATOLD(256),
     *   JANT, LPX, LPY, NYP, PLBUFF(256), IRET
      CHARACTER STN*(*), STOKES*(*)
      DOUBLE PRECISION FRQMAX
C
      CHARACTER PREFIX(2)*5, TIME*8, DATE*12, NAMSTR*18, MSGBUF*80
      LOGICAL   PFLAG
      REAL      XINTER(24), DCX, DCY, XNOINT, DIST, ODIST, TICSCL, XVAL,
     *   YTICEL, YTICER, YPOS, TICLEN, XINT, X, DCXM, XDIST, DEGL, DEGU,
     *   GTRC, GBLC, DEG
      INTEGER   INOINT, INCHAR, I, IXO, IANGL, IT(3), ID(3), ITMP, JT,
     *   LTYPE, LECHAN, JTRIM, IDUM(5), KT, IDEPTH(5)
      HOLLERITH HDUM(5)
      EQUIVALENCE (IDUM, HDUM)
      INCLUDE 'INCS:DMSG.INC'
      INCLUDE 'INCS:DHDR.INC'
      INCLUDE 'INCS:DLOC.INC'
      DATA TICSCL /70.0/
      DATA XINTER /.001, .002, .005, .01, .02, .05, .1, .2, .5,
     *   1., 2., 5., 10., 20., 50., 100., 200., 500.,
     *   1000., 2000., 5000., 10000., 20000., 50000./
C-----------------------------------------------------------------------
C                                        Set up the location common
C                                        for tick marks etc.
      CALL FILL (5, 1, IDEPTH)
      LOCNUM = 1
      CALL SETLOC (IDEPTH, .FALSE.)
      ROT(LOCNUM) = 0.0
      CORTYP(LOCNUM) = 0
      LABTYP(LOCNUM) = 0
      AXTYP(LOCNUM) = 0
      AXFUNC(1,LOCNUM) = 0
      AXFUNC(2,LOCNUM) = 0
      CPREF(1,LOCNUM) = ' '
      CPREF(2,LOCNUM) = ' '
      LTYPE = MOD (ABS(LABEL), 100)
      IF (LTYPE.LE.1) GO TO 999
      LECHAN = LBCHAN + NC - 1
C                                       Tic positions.
      TICLEN = (TRC(1) - BLC(1)) / TICSCL
      YTICEL = BLC(1) + TICLEN
      YTICER = TRC(1) - TICLEN
C                                       Find vertical interval value.
      DIST = YMAX - YMIN
      ODIST = DIST
      CALL METSCL (LABEL, DIST, PREFIX(2), PFLAG)
      IF (PFLAG) GO TO 110
      XDIST = DIST / ODIST
      GTRC = YMAX * XDIST
      GBLC = YMIN * XDIST
      XINT = 8.0
      DO 20 I = 1,24
         DEG = XINTER(I)
         DEGU = AINT (GTRC/DEG) * DEG
         IF (DEGU.GT.GTRC) DEGU = DEGU - DEG
         DEGL = AINT (GBLC/DEG) * DEG
         IF (DEGL.LT.GBLC) DEGL = DEGL + DEG
         XNOINT = AINT ((DEGU-DEGL)/DEG) + 1.0
         IF (XNOINT.LE.XINT) GO TO 30
 20      CONTINUE
      GO TO 110
C                                       Interval and no of inter found.
 30   XINT = DEG
      INOINT = XNOINT + 2
      ODIST = XDIST * YMIN
      XVAL = AINT (ODIST/XINT) * XINT
      IF (XVAL.GE.ODIST) XVAL = XVAL - XINT
      IXO = I
      DCXM = -0.5
C                                       Loop for all tics.
      DO 100 I = 1,INOINT
         XVAL = XVAL + XINT
         YPOS = XVAL / XDIST
         YPOS = (YPOS - YMIN) / (YMAX - YMIN) * (TRC(2)-BLC(2)) + BLC(2)
         IF (YPOS.GT.TRC(2)) GO TO 110
C                                       right hand tic.
         CALL GPOS (TRC(1), YPOS, PLBUFF, IRET)
         IF (IRET.NE.0) GO TO 999
         CALL GVEC (YTICER, YPOS, PLBUFF, IRET)
         IF (IRET.NE.0) GO TO 999
C                                       Left hand tic.
         CALL GPOS (YTICEL, YPOS, PLBUFF, IRET)
         IF (IRET.NE.0) GO TO 999
         CALL GVEC (BLC(1), YPOS, PLBUFF, IRET)
         IF (IRET.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, PLBUFF, IRET)
            IF (IRET.NE.0) GO TO 999
            END IF
 100     CONTINUE
C                                       RMS
 110  DCX = DCXM - 2.0
      YPOS = (TRC(2) + BLC(2)) / 2.0
      CALL GPOS (BLC(1), YPOS, PLBUFF, IRET)
      IF (IRET.NE.0) GO TO 999
      IF (ITY.EQ.2) THEN
         MSGBUF = PREFIX(2) // ' Mean'
      ELSE IF (ITY.EQ.3) THEN
         MSGBUF = PREFIX(2) // ' RMS'
      ELSE IF (ITY.EQ.1) THEN
         MSGBUF = PREFIX(2) // ' All 3'
      ELSE
         MSGBUF = PREFIX(2) // ' ModIndx'
         END IF
      CALL CHTRIM (MSGBUF, 80, MSGBUF, INCHAR)
      MSGBUF(INCHAR+2:) = 'AutoCorr'
      CALL CHTRIM (MSGBUF, 80, MSGBUF, INCHAR)
      DCY = INCHAR / 2.0 - 1.0
      CALL GCHAR (INCHAR, 1, DCX, DCY, MSGBUF, PLBUFF, IRET)
      IF (IRET.NE.0) GO TO 999
C                                       Nchan, BIF, EIF
      IF ((LTYPE.LT.7) .AND. (LPY.EQ.NYP)) THEN
         MSGBUF = 'IF'
         DCY = -2.833 - 1.333
         IF (LTYPE.EQ.2) DCY = -2.833
         XDIST = (TRC(1) - BLC(1)) / NI
         DO 120 I = 1,NI
            ITMP = LBIF + I - 1
            IF ((I.EQ.1) .OR. (NI.LE.4)) THEN
               IF (ITMP.LT.10) THEN
                  WRITE (MSGBUF(4:),1110) ITMP
               ELSE
                  WRITE (MSGBUF(4:),1111) ITMP
                  END IF
            ELSE
               IF (ITMP.LT.10) THEN
                  WRITE (MSGBUF(1:),1110) ITMP
               ELSE
                  WRITE (MSGBUF(1:),1111) ITMP
                  END IF
               END IF
            CALL REFRMT (MSGBUF, '_', INCHAR)
            X = (I - 0.5) * XDIST + BLC(1)
            CALL GPOS (X, BLC(2), PLBUFF, IRET)
            IF (IRET.NE.0) GO TO 999
            DCX = -INCHAR/2.0
            CALL GCHAR (INCHAR, 0, DCX, DCY, MSGBUF, PLBUFF, IRET)
            IF (IRET.NE.0) GO TO 999
 120        CONTINUE
         END IF
C                                       Determine label range
      IF (LABFRQ.LE.0.0) THEN
         CALL FINLAB (BLC, TRC, LBCHAN, LECHAN, LBIF, NI, LABEL, PLBUFF,
     *      IRET)
         MSGBUF = 'Frequency (GHz)'
         IF (FRQMAX.LT.1.E9) MSGBUF = 'Frequency (MHz)'
      ELSE
         CALL PINLAB (BLC, TRC, LBCHAN, LECHAN, NI, LABEL, PLBUFF, IRET)
         MSGBUF = 'Spectral channels'
         END IF
      IF (IRET.NE.0) GO TO 999
C                                       Label with prefix
      DCY = -1.5
      IF (LTYPE.GT.2) DCY = -2.833
      X = (TRC(1) + BLC(1)) / 2.0
      CALL GPOS (X, BLC(2), PLBUFF, IRET)
      IF (IRET.NE.0) GO TO 999
      CALL CHTRIM (MSGBUF, 17, MSGBUF, INCHAR)
      DCX = 0.5 - INCHAR / 2.0
      CALL GCHAR (INCHAR, 0, DCX, DCY, MSGBUF, PLBUFF, IRET)
      IF (IRET.NE.0) GO TO 999
      IF (LTYPE.GE.7) GO TO 999
C                                       which axis is which?
C                                       Source name, stokes, freq.
      CALL GPOS (BLC(1), TRC(2), PLBUFF, IRET)
      IF (IRET.NE.0) GO TO 999
      DCX = 0.0
      DCY = 0.5
      IANGL = 0
      JT = JTRIM (STN)
      KT = JTRIM (STOKES)
      WRITE (MSGBUF,1200) JANT, STN(:JT), STOKES(:KT)
      INCHAR = JTRIM (MSGBUF)
C                                       image name
      INCHAR = INCHAR + 1
      IF (INCHAR.GT.1) THEN
         MSGBUF(INCHAR:INCHAR+2) = ' __'
         INCHAR = INCHAR + 3
         END IF
      CALL COPY (5, CATOLD(KHIMN), IDUM)
      CALL H2CHR (12, KHIMNO, HDUM, NAMSTR(1:12))
      CALL H2CHR (6, KHIMCO, HDUM, NAMSTR(13:18))
      CALL NAMEST (NAMSTR, CATOLD(KIIMS), MSGBUF(INCHAR:), ITMP)
      CALL REFRMT (MSGBUF, '_', INCHAR)
      CALL GCHAR (INCHAR, 0, DCX, DCY, MSGBUF, PLBUFF, IRET)
      IF (IRET.NE.0) GO TO 999
C                                       time/date, version
      IF ((LABEL.GT.0) .AND. (LPX.EQ.1) .AND. (LPY.EQ.1)) THEN
         CALL GPOS (BLC(1), TRC(2), PLBUFF, IRET)
         IF (IRET.NE.0) GO TO 999
         CALL ZDATE (ID)
         CALL ZTIME (IT)
         CALL TIMDAT (IT, ID, TIME, DATE)
         WRITE (MSGBUF,1210) IVER, DATE, TIME
         CALL REFRMT (MSGBUF, '_', INCHAR)
         DCY = DCY + 1.333
         CALL GCHAR (INCHAR, 0, DCX, DCY, MSGBUF, PLBUFF, IRET)
         END IF
C
 999  RETURN
C-----------------------------------------------------------------------
 1030 FORMAT (F14.3)
 1110 FORMAT (I1)
 1111 FORMAT (I2)
 1200 FORMAT ('Antenna',I3,1X,'''',A,'''',2x,'___Stokes ''',A,'''')
 1210 FORMAT ('Plot file version',I4,'__created ',A,A)
      END
      SUBROUTINE PINLAB (BLC, TRC, BC, EC, NG, ILTYPE, PLBUFF, IERR)
C-----------------------------------------------------------------------
C   To do X axis where we have multiple sub panels with integer counts
C   Inputs:
C      BLC      R(2)    X, Y pixels to form bottom left hand corner
C      TRC      R(2)    X, Y pixels to form the top right hand corner
C      BC       I       Begin count
C      EC       I       End count
C      NG       I       Number of such groups
C      ILTYPE   I       label type: 1 none, 2 no ticks, 3 RA/DEC
C                          4 center relative
C   In/out:
C      PLBUFF   I(256)  the updated graphics output buffer.
C      IERR     I       error indicator: 0 = No error.
C-----------------------------------------------------------------------
      REAL      BLC(2), TRC(2)
      INTEGER   BC, EC, NG, ILTYPE, PLBUFF(*), IERR
C
      INTEGER   NINTER
      PARAMETER (NINTER=15)
C
      INTEGER   INCHAR, LTYPE, I, XINTER(NINTER), XINT, DIST, NOINT,
     *   NINT, IG, XVAL, DEGL, DEGU, DEG
      REAL      DCX, DCY, XL, XI, XPOS, XSC
      CHARACTER SPRTXT*8
      INCLUDE 'INCS:DMSG.INC'
      DATA XINTER /1, 2, 5, 10, 20, 50, 100, 200, 500, 1000,
     *   2000, 5000, 10000, 20000, 50000/
C-----------------------------------------------------------------------
      LTYPE = MOD (ABS (ILTYPE), 100)
      IF (LTYPE.EQ.1) GO TO 999
C                                       tick marks
      XINT = 32 / NG
      XINT = MAX (3, MIN (16, XINT))
      DIST = EC - BC + 2
      DO 20 I = 1,NINTER
         DEG = XINTER(I)
         DEGU = (EC / DEG) * DEG
         IF (DEGU.GT.EC) DEGU = DEGU - DEG
         DEGL = (BC / DEG) * DEG
         IF (DEGL.LT.BC) DEGL = DEGL + DEG
         NOINT = (DEGU - DEGL) / DEG + 1
         IF (NOINT.LE.XINT) GO TO 30
 20      CONTINUE
      MSGTXT = 'PINLAB: TICK MARK ALGORITHM FAILED'
      CALL MSGWRT (6)
      IERR = 0
      GO TO 999
C                                       plot tick marks
 30   XINT = DEG
      NINT = (NOINT * NG) / 16
      NINT = MAX (1, MIN (NINT, NOINT))
      NOINT = NOINT + 2
      DCX = -0.5
      XL = DIST * NG + 1
      XL = (TRC(1) - BLC(1)) / XL
      XI = (TRC(2) - BLC(2)) / 25.
      DCY = -1.5
      XSC = (TRC(1) - BLC(1)) / (NG * DIST)
      DO 50 IG = 1,NG
         XVAL = (BC / XINT) * XINT
         IF (XVAL.GE.BC) XVAL = XVAL - XINT
         DO 40 I = 1,NOINT
            XVAL = XVAL + XINT
            IF ((XVAL.GE.BC) .AND. (XVAL.LE.EC)) THEN
               XPOS = (XVAL-BC+1 + (IG-1)*DIST) * XSC + BLC(1)
               CALL GPOS (XPOS, TRC(2), PLBUFF, IERR)
               IF (IERR.NE.0) GO TO 999
               CALL GVEC (XPOS, TRC(2)-XI, PLBUFF, IERR)
               IF (IERR.NE.0) GO TO 999
               CALL GPOS (XPOS, BLC(2)+XI, PLBUFF, IERR)
               IF (IERR.NE.0) GO TO 999
               CALL GVEC (XPOS, BLC(2), PLBUFF, IERR)
               IF (IERR.NE.0) GO TO 999
               IF ((LTYPE.GT.2) .AND. (MOD(I,NINT).EQ.0)) THEN
                  WRITE (SPRTXT,1030) XVAL
                  CALL CHTRIM (SPRTXT, 6, SPRTXT, INCHAR)
                  DCX = 0.5 - INCHAR
                  CALL GCHAR (INCHAR, 0, DCX, DCY, SPRTXT, PLBUFF, IERR)
                  IF (IERR.NE.0) GO TO 999
                  END IF
               END IF
 40         CONTINUE
 50      CONTINUE
C
 999  RETURN
C-----------------------------------------------------------------------
 1030 FORMAT (I6)
      END
      SUBROUTINE FINLAB (BLC, TRC, BC, EC, BIF, NG, ILTYPE, PLBUFF,
     *   IERR)
C-----------------------------------------------------------------------
C   To do X axis in frequency over full plot ignorng sub-panels
C   Inputs:
C      BLC      R(2)    X, Y pixels to form bottom left hand corner
C      TRC      R(2)    X, Y pixels to form the top right hand corner
C      BC       I       Begin count
C      EC       I       End count
C      NG       I       Number of such groups
C      ILTYPE   I       label type: 1 none, 2 no ticks, 3 RA/DEC
C                          4 center relative
C   In/out:
C      PLBUFF   I(256)  the updated graphics output buffer.
C      IERR     I       error indicator: 0 = No error.
C-----------------------------------------------------------------------
      REAL      BLC(2), TRC(2)
      INTEGER   BC, EC, BIF, NG, ILTYPE, PLBUFF(*), IERR
C
      INTEGER   NINTER
      PARAMETER (NINTER=24)
C
      INCLUDE 'VLBRF.INC'
      INCLUDE 'INCS:DCHND.INC'
      INTEGER   INCHAR, LTYPE, I, NOINT, NINT, ITRY
      REAL      DCX, DCY, XI, XPOS, DEG, DEGU, DEGL, XVAL, XINT,
     *   XINTER(NINTER)
      DOUBLE PRECISION F1, F2
      CHARACTER SPRTXT*16
      INCLUDE 'INCS:DMSG.INC'
      INCLUDE 'INCS:DCAT.INC'
      INCLUDE 'INCS:DHDR.INC'
      INCLUDE 'INCS:DUVH.INC'
      DATA XINTER /0.001, 0.002, 0.005, 0.01, 0.02, 0.05, 0.1, 0.2, 0.5,
     *   1, 2, 5, 10, 20, 50, 100, 200, 500, 1000, 2000, 5000, 10000,
     *   20000, 50000/
C-----------------------------------------------------------------------
      LTYPE = MOD (ABS (ILTYPE), 100)
      IF (LTYPE.EQ.1) GO TO 999
      XI = (TRC(2) - BLC(2)) / 25.
C                                       CRP offset by BC
C                                       tick marks
      IF (FRQMAX.LT.1.E9) THEN
         F1 = FRQMIN / 1.D6
         F2 = FRQMAX / 1.E6
      ELSE
         F1 = FRQMIN / 1.D9
         F2 = FRQMAX / 1.E9
         END IF
      XINT = 32
      DO 20 ITRY = 1,NINTER
         DEG = XINTER(ITRY)
         DEGU = AINT (F2/DEG) * DEG
         IF (DEGU.GT.F2) DEGU = DEGU - DEG
         DEGL = AINT (F1/DEG) * DEG
         IF (DEGL.LT.F1) DEGL = DEGL + DEG
         NOINT = (DEGU - DEGL) / DEG + 1.001
         IF (NOINT.LE.XINT) GO TO 30
 20      CONTINUE
      MSGTXT = 'FINLAB: TICK MARK ALGORITHM FAILED'
      CALL MSGWRT (6)
      IERR = 0
      GO TO 999
C                                       plot tick marks
 30   XINT = DEG
      NOINT = NOINT + 2
      NINT = 1
      XVAL = AINT (F1/XINT) * XINT
      IF (XVAL.GE.F1) XVAL = XVAL - XINT
      DO 50 I = 1,NOINT
         XVAL = XVAL + XINT
         IF (XVAL.GT.DEGU) GO TO 999
         XPOS = (XVAL - F1) / (F2 - F1) * (TRC(1) - BLC(1)) + BLC(1)
         CALL GPOS (XPOS, TRC(2), PLBUFF, IERR)
         IF (IERR.NE.0) GO TO 999
         CALL GVEC (XPOS, TRC(2)-XI, PLBUFF, IERR)
         IF (IERR.NE.0) GO TO 999
         CALL GPOS (XPOS, BLC(2)+XI, PLBUFF, IERR)
         IF (IERR.NE.0) GO TO 999
         CALL GVEC (XPOS, BLC(2), PLBUFF, IERR)
         IF (IERR.NE.0) GO TO 999
         IF ((LTYPE.GT.2) .AND. (MOD(I,NINT).EQ.0)) THEN
            WRITE (SPRTXT,1030) XVAL
            CALL CHTRIM (SPRTXT, 10, SPRTXT, INCHAR)
            IF (ITRY.GT.9) THEN
               INCHAR = INCHAR - 4
            ELSE IF (ITRY.GT.6) THEN
               INCHAR = INCHAR - 2
            ELSE IF (ITRY.GT.3) THEN
               INCHAR = INCHAR - 1
               END IF
            DCX = 0.5 - INCHAR
            DCY = -1.5
            CALL GCHAR (INCHAR, 0, DCX, DCY, SPRTXT, PLBUFF, IERR)
            IF (IERR.NE.0) GO TO 999
            END IF
 50      CONTINUE
C
 999  RETURN
C-----------------------------------------------------------------------
 1030 FORMAT (F10.3)
      END
