LOCAL INCLUDE 'UVRMS.INC'
C                                       Local include for UVRMS
      INCLUDE 'INCS:ZPBUFSZ.INC'
      HOLLERITH XNAMEI(3), XCLAIN(2), XSOUR(4,30), XCALC(1), XXSTOK(1),
     *   XOPTYP(1), XFUNC(1)
      REAL      XSIN, XDISIN, XQUAL, XTIME(8), XBAND, XFREQ, XFQID,
     *   XANT(50), XBASE(50), XUVRA(2),  XSUBA, XBIF, XEIF, XBCHAN,
     *   XECHAN, XDOCAL, XGUSE, XDOPOL, XPDVER, XBLVER, XFLAG, XDOBND,
     *   XBPVER, XSMOTH(3), DOWGT, SOLINT, DOPLOT, XBOXES, XPIXR(2),
     *   APARM(10), XDOTV, XGRCHN, XLABEL, BADD(10), UVAVG, UVSTD
      REAL      FITPAR(10), HISTOG(0:1025), CATOR(256)
      HOLLERITH CATOH(256)
      INTEGER   SEQIN, DISKIN, JBUFSZ, ILOCWT, CATOLD(256), INCSI,
     *   INCFI, INCIFI, OLDCNO, IXANT(50), IXBAS(50), NXANT, NXBAS,
     *   NSAMP, MAXSAM, NBOXES, GRCHAN, NPARM, IOPT, IDOPLT, SCRBUF(256)
      LOGICAL   DESEL
      DOUBLE PRECISION VSUM, VSUMS, NSUMS, CATOD(128)
      CHARACTER NAMEIN*12, CLAIN*6, OPTYPE*4, FUNTYP*2, LTITLE*80
      EQUIVALENCE (CATOD, CATOH, CATOR, CATOLD)
      COMMON /INPARM/ XNAMEI, XCLAIN, XSIN, XDISIN, XSOUR, XQUAL, XCALC,
     *   XXSTOK, XTIME, XBAND, XFREQ, XFQID, XANT, XBASE, XUVRA, XSUBA,
     *   XBIF, XEIF, XBCHAN, XECHAN, XDOCAL, XGUSE, XDOPOL, XPDVER,
     *   XBLVER, XFLAG, XDOBND, XBPVER, XSMOTH, XOPTYP, DOWGT, SOLINT,
     *   DOPLOT, XBOXES, XPIXR, XFUNC, APARM, XDOTV, XGRCHN, XLABEL,
     *   BADD, UVAVG,  UVSTD
      COMMON /UVRMSS/ CATOLD, VSUM, VSUMS, NSUMS, SEQIN, DISKIN, ILOCWT,
     *   INCSI, INCFI,INCIFI, OLDCNO, IXANT, IXBAS,
     *   NXANT, NXBAS, DESEL, NSAMP, MAXSAM, NBOXES, GRCHAN, FITPAR,
     *   HISTOG, NPARM, IOPT, IDOPLT
      COMMON /CHARPM/ LTITLE, NAMEIN, CLAIN, OPTYPE, FUNTYP
      COMMON /BUFRS/ SCRBUF, JBUFSZ
C                                       End local include for UVRMS
LOCAL END
      PROGRAM UVRMS
C-----------------------------------------------------------------------
C! Prints statistics of selected uv data and plots them
C# UV UV-util Calibration Plot
C-----------------------------------------------------------------------
C;  Copyright (C) 2020, 2022-2023
C;  Associated Universities, Inc. Washington DC, USA.
C;
C;  This program is free software; you can redistribute it and/or
C;  modify it under the terms of the GNU General Public License as
C;  published by the Free Software Foundation; either version 2 of
C;  the License, or (at your option) any later version.
C;
C;  This program is distributed in the hope that it will be useful,
C;  but WITHOUT ANY WARRANTY; without even the implied warranty of
C;  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
C;  GNU General Public License for more details.
C;
C;  You should have received a copy of the GNU General Public
C;  License along with this program; if not, write to the Free
C;  Software Foundation, Inc., 675 Massachusetts Ave, Cambridge,
C;  MA 02139, USA.
C;
C;  Correspondence concerning AIPS should be addressed as follows:
C;         Internet email: aipsmail@nrao.edu.
C;         Postal address: AIPS Project Office
C;                         National Radio Astronomy Observatory
C;                         520 Edgemont Road
C;                         Charlottesville, VA 22903-2475 USA
C-----------------------------------------------------------------------
C   UVRMS prints statistics from a sample of uv data and plots
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   full set of calibration adverbs
C      OPTYPE         OPTYPE        Type of data to process
C      SOLINT         SOLINT        Averaging time (min)
C   returns
C      PIXAVG         UVAVG
C      PIXSTD         UVRMS
C-----------------------------------------------------------------------
      CHARACTER PRGM*6
      INTEGER   IRET, NWORDS, I
      LONGINT   PVALL, PVLO, PVHI, PVTIM
      REAL      VALL(2), VLO(2), VHI(2), VTIM(2)
      INCLUDE 'UVRMS.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'
      DATA PRGM /'UVRMS '/
C-----------------------------------------------------------------------
C                                       Get input parameters and
C                                       create output file if nec.
      CALL UVRMSI (PRGM, IRET)
      IF (IRET.NE.0) GO TO 990
C                                       dynamic memory excessive
      NWORDS = (NVIS - 1) / 1024 + 1
      MAXSAM = NWORDS * 1024
      CALL ZMEMRY ('GET ', TSKNAM, NWORDS, VALL, PVALL, IRET)
      IF (IRET.EQ.0) CALL ZMEMRY ('GET ', TSKNAM, NWORDS, VTIM, PVTIM,
     *   IRET)
      NWORDS = (NWORDS + 1) / 2
      IF (IRET.EQ.0) CALL ZMEMRY ('GET ', TSKNAM, NWORDS, VLO, PVLO,
     *   IRET)
      IF (IRET.EQ.0) CALL ZMEMRY ('GET ', TSKNAM, NWORDS, VHI, PVHI,
     *   IRET)
      IF (IRET.NE.0) THEN
         MSGTXT = 'UNABLE TO GET NEEDED DYNAMIC MEMORY'
         CALL MSGWRT (8)
         GO TO 990
         END IF
C                                       read data
      CALL UVRMSR (VALL(1+PVALL), VTIM(1+PVTIM), IRET)
      IF (IRET.NE.0) GO TO 990
C                                       Plot vs time
      IF (IDOPLT.GT.1) CALL UVRMST (VALL(1+PVALL), VTIM(1+PVTIM),
     *   STOKES, IRET)
      IF (IRET.GT.0) GO TO 990
      IF (IRET.LT.0) IDOPLT = 0
C                                       analyze data
      CALL UVRMSA (VALL(1+PVALL), VLO(1+PVLO), VHI(1+PVHI), IRET)
      IF (IRET.NE.0) GO TO 990
C                                       Plot histogram
      IF (MOD(IDOPLT,2).EQ.1) CALL UVRMSP (STOKES, IRET)
C                                       return answers
 900  CALL PTPARM (2, UVAVG, SCRBUF, I)
      IF (I.NE.0) THEN
         WRITE (MSGTXT,1010) I
         CALL MSGWRT (8)
         END IF
C                                       Close down files, etc.
 990  IRET = MAX (0, IRET)
      CALL DIE (IRET, SCRBUF)
C
 999  STOP
C-----------------------------------------------------------------------
 1010 FORMAT ('ERROR',I5,' RETURNING ANSWERS TO AIPS')
      END
      SUBROUTINE UVRMSI (PRGN, JERR)
C-----------------------------------------------------------------------
C   UVRMSI gets input parameters for UVRMS
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, NFREQ, LUN
      LOGICAL   MATCH
      REAL      CATR(256), RPARM(20)
      HOLLERITH CATH(256)
      DOUBLE PRECISION CATD(128)
      INCLUDE 'INCS:DSEL.INC'
      INCLUDE 'UVRMS.INC'
      INCLUDE 'INCS:DFIL.INC'
      INCLUDE 'INCS:DMSG.INC'
      INCLUDE 'INCS:DHDR.INC'
      INCLUDE 'INCS:DUVH.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
C                                       Get input parameters.
      NPARM = 290
      CALL GTPARM (PRGN, NPARM, RQUICK, XNAMEI, SCRBUF, IERR)
      RQUICK = .FALSE.
      IF (IERR.NE.0) THEN
         RQUICK = .TRUE.
         JERR = 8
         IF (IERR.EQ.1) GO TO 999
            WRITE (MSGTXT,1000) IERR
            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 (4, 1, XXSTOK, STOKES)
      CALL H2CHR (2, 1, XFUNC, FUNTYP)
      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
      SELQUA = IROUND (XQUAL)
      SEQIN = IROUND (XSIN)
      DISKIN = IROUND (XDISIN)
      CALL H2CHR (4, 1, XOPTYP, OPTYPE)
      IDOPLT = IROUND (DOPLOT)
      IF (DOPLOT.GT.0) IDOPLT = MAX (1, IDOPLT)
      UVSTD = 0.0
      UVAVG = 0.0
C                                       Info for UVGET:
C                                       Put selection criteria into
C                                       correct common.
      UNAME = NAMEIN
      UCLAS = CLAIN
      UDISK = DISKIN
      USEQ = SEQIN
      DOCAL = XDOCAL.GT.0.0
      DOWTCL = DOCAL .AND. (XDOCAL.LE.99.0)
      IF (OPTYPE.EQ.'AUTO') THEN
         DOACOR = .TRUE.
         DOXCOR = .FALSE.
         OPTYPE = 'AMP'
         END IF
C                                       Set 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.)
      UVRNG(1) = XUVRA(1)
      UVRNG(2) = XUVRA(2)
      DOPOL = IROUND(XDOPOL)
      IF (XDOPOL.GT.0.0) DOPOL = MAX (1, DOPOL)
      PDVER = IROUND (XPDVER)
      DOAPPL = .FALSE.
      SUBARR = IROUND (XSUBA)
      IF (SUBARR.LT.0) SUBARR = 0
      FGVER = IROUND (XFLAG)
      DOBAND = IROUND (XDOBND)
      BPVER = IROUND (XBPVER)
      CALL RCOPY (3, XSMOTH, SMOOTH)
      CLVER = IROUND (XGUSE)
      CLUSE = IROUND (XGUSE)
      BLVER = IROUND (XBLVER)
      GRCHAN = XGRCHN + 0.1
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
C                                       Test OPTYPE, STOKES
      IF ((OPTYPE.NE.'AMP') .AND. (OPTYPE.NE.'PHAS') .AND.
     *   (OPTYPE.NE.'REAL') .AND. (OPTYPE.NE.'IMAG') .AND.
     *   (OPTYPE.NE.'SAMP')) THEN
         OPTYPE = 'AMP'
         MSGTXT = 'SETTING OPTYPE TO AMP'
         CALL MSGWRT (6)
         END IF
      IOPT = 1
      IF (OPTYPE.EQ.'REAL') IOPT = 2
      IF (OPTYPE.EQ.'IMAG') IOPT = 3
      IF (OPTYPE.EQ.'PHAS') IOPT = 4
      IF (OPTYPE.EQ.'SAMP') IOPT = 5
      IF (STOKES.EQ.' ') STOKES = 'I'
      IF ((STOKES.EQ.'I') .OR. (STOKES.EQ.'Q') .OR. (STOKES.EQ.'U') .OR.
     *   (STOKES.EQ.'V')) GO TO 20
      IF (CATD(KDCRV+JLOCS).LE.-5.0) THEN
         IF ((STOKES.EQ.'VV') .OR. (STOKES.EQ.'HH') .OR.
     *      (STOKES.EQ.'VH') .OR. (STOKES.EQ.'HV')) GO TO 20
      ELSE IF (CATD(KDCRV+JLOCS).LE.-1.0) THEN
         IF ((STOKES.EQ.'RR') .OR. (STOKES.EQ.'LL') .OR.
     *      (STOKES.EQ.'RL') .OR. (STOKES.EQ.'LR')) GO TO 20
         END IF
      MSGTXT = 'ONLY ONE POLARIZATION ALLOWED: NOT ' // STOKES
      JERR = 10
      GO TO 990
C                                       Channel selection?
 20   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
      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
C                                       Freq id
      IF (XBAND.GT.0.0) SELBAN = XBAND
      IF (XFREQ.GT.0.0) SELFRQ = XFREQ
      FRQSEL = IROUND (XFQID)
      IF (FRQSEL.EQ.0) FRQSEL = -1
      LUN = 28
      CALL FQMATC (DISKIN, OLDCNO, CATBLK, LUN, SELBAN, SELFRQ, MATCH,
     *   FRQSEL, JERR)
      IF (.NOT.MATCH) THEN
         MSGTXT = 'NO MATCH TO SELBAND/SELFREQ ADVERBS - CHECK INPUTS'
         JERR = 1
         GO TO 990
         END IF
      IF (JERR.GT.0) GO TO 999
C                                       Find baselines to copy
      CALL SETANT (50, XANT, XBASE, NXANT, NXBAS, IXANT, IXBAS, DESEL)
C                                       now using cal system -
C                                       UVGET makes header
      CALL UVGET ('INIT', RPARM, HISTOG, JERR)
      IF (JERR.NE.0) THEN
         WRITE (MSGTXT,1035) JERR
         GO TO 990
         END IF
      CALL UVGET ('CLOS', RPARM, HISTOG, IERR)
C                                       Save input file info
      INCX = CATBLK(KINAX)
      INCSI = INCS / INCX
      INCFI = INCF / INCX
      INCIFI = INCIF / INCX
C                                        Fill defaults for plots
      CALL RCOPY (8, TIMRNG, XTIME)
      CALL RCOPY (2, UVRNG, XUVRA)
      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
      JERR = 0
      GO TO 999
C
 990  CALL MSGWRT (8)
C
 999  RETURN
C-----------------------------------------------------------------------
 1000 FORMAT ('UVRMSI: ERROR',I3,' OBTAINING INPUT PARAMETERS')
 1030 FORMAT ('ERROR',I3,' FINDING ',A12,'.',A6,'.',I4,' DISK=',
     *   I3,' USID=',I5)
 1035 FORMAT ('UVRMSI: UVGET INIT ERROR',I3,' CHECK ADVERBS')
 1040 FORMAT ('ERROR',I3,' COPYING CATBLK ')
      END
      SUBROUTINE UVRMSR (VALL, VTIM, IRET)
C-----------------------------------------------------------------------
C   UVRMSR reads the uv data and prepares a list of values with time
C   averaging (one or multiple times)
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   Output:
C      VALL    R(*)   List of data values
C      VTIM    R(*)   List of data times
C      IRET    I      Return code, 0 => OK, otherwise abort.
C-----------------------------------------------------------------------
      INTEGER   IRET
      REAL      VALL(*), VTIM(*)
C
      INTEGER   IA1, IA2, NV
      LOGICAL   T, F, REQBAS
      INCLUDE 'UVRMS.INC'
      REAL      BASEN, VIS(UVBFSS), RR, RI, RPARM(20), LTIME, TIME, VS,
     *   TS, SR, SI, SW, RW, SA
      INCLUDE 'INCS:DMSG.INC'
      INCLUDE 'INCS:DUVH.INC'
      DATA T, F /.TRUE.,.FALSE./
C-----------------------------------------------------------------------
C                                       Open and init for read
      CALL UVGET ('INIT', RPARM, VIS, IRET)
      IF (IRET.NE.0) THEN
         WRITE (MSGTXT,1000) IRET
         GO TO 990
         END IF
      CALL UVPGET (IRET)
      IF (SOLINT.LE.0.0) SOLINT = 0.007
      SOLINT = SOLINT / (60.0 * 24.0)
      LTIME = -100.
      NV = 0
      SR = 0.0
      SI = 0.0
      SW = 0.0
      SA = 0.0
      TS = 0.0
C                                       Loop
C                                       Read vis. record.
 100  CALL UVGET ('READ', RPARM, VIS, IRET)
      IF (IRET.GT.0) THEN
         WRITE (MSGTXT,1100) IRET
         GO TO 990
C                                       Loop over buffer
      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 (.NOT.REQBAS (IA1, IA2, DESEL, IXANT, NXANT, IXBAS, NXBAS))
     *      GO TO 100
         TIME = RPARM(1+ILOCT)
         IF (TIME.GT.LTIME+SOLINT) THEN
            IF (NV.GT.0.0) THEN
               IF (NSAMP.GE.MAXSAM) GO TO 900
               NSAMP = NSAMP + 1
               CALL FIXIT (OPTYPE, SW, SR, SI, SA, VS)
               VTIM(NSAMP) = TS / NV
               VALL(NSAMP) = VS
               END IF
            TS = 0.0
            NV = 0
            LTIME = TIME
            END IF
C                                       call user routine
         CALL UVRMSG (VIS, RR, RI, RW, IRET)
C                                       Copy to output.
         IF (IRET.EQ.0) THEN
            NV = NV + 1
            SR = SR + RR
            SI = SI + RI
            SA = SA + SQRT (RR*RR + RI*RI)
            SW = SW + RW
            TS = TS + TIME
            END IF
C                                       Read next buffer.
         IRET = 0
         GO TO 100
         END IF
C                                       Final value
      IF (NV.GT.0) THEN
         IF (NSAMP.GE.MAXSAM) GO TO 900
         NSAMP = NSAMP + 1
         CALL FIXIT (OPTYPE, SW, SR, SI, SA, VS)
         VALL(NSAMP) = VS
         VTIM(NSAMP) = TS / NV
         END IF
C                                       Close files
      CALL UVGET ('CLOS', RPARM, VIS, IRET)
C                                       close NX table
      IRET = 0
      IF (NSAMP.LE.0) THEN
         IRET = 10
         MSGTXT = 'NO DATA SAMPLES FOUND'
         GO TO 990
         END IF
      GO TO 999
C
 900  WRITE (MSGTXT,1900) MAXSAM
C                                       Error
 990  CALL MSGWRT (8)
C
 999  RETURN
C-----------------------------------------------------------------------
 1000 FORMAT ('UVRMSR: ERROR',I3,' OPEN/INIT INPUT VIS FILE')
 1100 FORMAT ('UVRMSR: ERROR',I3,' READING VIS FILE')
 1900 FORMAT ('UVRMSR: MAXIMUM NUMBER SAMPLES REACHED',I12)
      END
      SUBROUTINE UVRMSG (VIS, RR, RI, RW, IRET)
C-----------------------------------------------------------------------
C   Finds the requested value from the current data
C     Inputs:
C      VIS     R(3,*)  Visibilities in order real, imaginary, weight
C                   (Jy, Jy, unitless).  Weight <= 0 => flagged.
C   Inputs from COMMON:
C      CATBLK     I(256)  Catalog header record. See Going Aips for
C                         details.
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      DOWGT      R    > 0 do not average the output
C   Output:
C      RR         R    Output weighted summed value real part
C      RI         R    Output weighted summed value imag part
C      RW         R    Output summed weights
C      IRET       I    Return code  -1 => don't include
C                                    0 => OK
C-----------------------------------------------------------------------
      INTEGER   IRET
      REAL      VIS(3,*), RR, RI, RW
C
      INTEGER   JIF, JF, JS, NIF, NF, NS, INDEXI
      REAL      VR, VI, VW
      INCLUDE 'UVRMS.INC'
      INCLUDE 'INCS:DUVH.INC'
      INCLUDE 'INCS:DHDR.INC'
      INCLUDE 'INCS:DCAT.INC'
C-----------------------------------------------------------------------
      IRET = 0
C                                       pointers to traverse the data
      NS = 1
      NIF = 1
      NF = 1
      IF (JLOCS.GE.0) NS = CATBLK(KINAX+JLOCS)
      IF (JLOCIF.GE.0) NIF = CATBLK(KINAX+JLOCIF)
      IF (JLOCF.GE.0) NF = CATBLK(KINAX+JLOCF)
      RW = 0.0
      RR = 0.0
      RI = 0.0
      DO 40 JIF = 1,NIF
         DO 30 JF = 1,NF
            DO 20 JS = 1,NS
               INDEXI = (JIF-1) * INCIFI + (JF-1) * INCFI +
     *            (JS-1) * INCSI + 1
               VR = VIS(1,INDEXI)
               VI = VIS(2,INDEXI)
               VW = VIS(3,INDEXI)
               IF (VW.GT.0.0) THEN
                  RW = RW + VW
                  RR = RR + VW * VR
                  RI = RI + VW * VI
                  END IF
 20            CONTINUE
 30         CONTINUE
 40      CONTINUE
         IF (RW.LE.0.0) THEN
            IRET = -1
         ELSE IF (DOWGT.LE.0.0) THEN
            RR = RR / RW
            RI = RI / RW
            RW = 1.0
            END IF
C
 999  RETURN
      END
      SUBROUTINE FIXIT (OPTYPE, SW, SR, SI, SA, VS)
C-----------------------------------------------------------------------
C    FIXIT averages the real and imag sums and returns the desired value
C    Input
C       OPTYPE   C*4   AMP, {HAS, REAL, IMAG
C    In/out
C       SW       R     Sum of weights       returns 0.0
C       SR       R     Sum of real          returns 0.0
C       SI       R     Sum of imaginary     returns 0.0
C       SA       R     Sum of amplitudes    returns 0.0
C    Output:
C       VS       R     Desired parameter
C-----------------------------------------------------------------------
      CHARACTER OPTYPE*4
      REAL      SW, SR, SI, SA, VS
C
      INCLUDE 'INCS:PSTD.INC'
C-----------------------------------------------------------------------
      SR = SR / SW
      SI = SI / SW
      IF (OPTYPE.EQ.'AMP') THEN
         VS = SQRT (SR*SR + SI*SI)
      ELSE IF (OPTYPE.EQ.'PHAS') THEN
         VS = 0.0
         IF ((SR.NE.0.0) .OR. (SI.NE.0.0)) VS = ATAN2 (SI, SR) * RAD2DG
      ELSE IF (OPTYPE.EQ.'REAL') THEN
         VS = SR
      ELSE IF (OPTYPE.EQ.'IMAG') THEN
         VS = SI
      ELSE IF (OPTYPE.EQ.'SAMP') THEN
         VS = SA / SW
         END IF
      SW = 0.0
      SR = 0.0
      SI = 0.0
      SA = 0.0
C
 999  RETURN
      END
      SUBROUTINE UVRMSA (VALL, VLO, VHI, IRET)
C-----------------------------------------------------------------------
C   UVRMSA analyzes the data list for statistical parameters and then
C   displays them
C   In/Out:
C      VALL    R(*)   List of data values - rearranged, destroyed
C   Output:
C      VLO     R(*)   Work list
C      VHI     R(*)   Work list
C      IRET    I      Return code, 0 => OK, otherwise abort.
C-----------------------------------------------------------------------
      INTEGER   IRET
      REAL      VALL(*), VLO(*), VHI(*)
C
      INTEGER   I, NLO, NHI, I1, I2, IT1(3), IT2(3), IBOX
      INCLUDE 'UVRMS.INC'
      REAL      MEDIAN, XMIN, XQ1, XMED, XQ3, XMAX, XVAR, XSTD, XRMS,
     *   XMEAN, XMAD, T1, T2, FACT, RBOX
      CHARACTER XTYPE(13)*20
      INCLUDE 'UVRMS.INC'
      INCLUDE 'INCS:DMSG.INC'
      INCLUDE 'INCS:DSEL.INC'
      INCLUDE 'INCS:DUVH.INC'
      INCLUDE 'INCS:DHDR.INC'
      EQUIVALENCE (FITPAR(1), XMIN)
      EQUIVALENCE (FITPAR(2), XQ1)
      EQUIVALENCE (FITPAR(3), XMED)
      EQUIVALENCE (FITPAR(4), XQ3)
      EQUIVALENCE (FITPAR(5), XMAX)
      EQUIVALENCE (FITPAR(6), XMAD)
      EQUIVALENCE (FITPAR(7), XMEAN)
      EQUIVALENCE (FITPAR(8), XVAR)
      EQUIVALENCE (FITPAR(9), XSTD)
      EQUIVALENCE (FITPAR(10), XRMS)
      DATA XTYPE /'Minimum', '1st quartile', 'Median', '3rd quartile',
     *   'Maximum', 'Median abs deviation', 'Mean', 'Variance',
     *   'Standard deviation', 'Value rms', 'Value sum',
     *   'Value sum squared', 'Number samples'/
C-----------------------------------------------------------------------
      IRET = 0
C                                       get median
      XMED = MEDIAN (NSAMP, VALL)
C                                       now analyze
      VSUM = 0.0D0
      VSUMS = 0.0D0
      NSUMS = 0.0D0
      NLO = 0
      NHI = 0
      XMIN = 1.E15
      XMAX = -XMIN
      DO 20 I = 1,NSAMP
         IF (VALL(I).LT.XMED) THEN
            NLO = NLO + 1
            VLO(NLO) = VALL(I)
         ELSE IF (VALL(I).GT.XMED) THEN
            NHI = NHI + 1
            VHI(NHI) = VALL(I)
         END IF
         VSUM = VSUM + VALL(I)
         VSUMS = VSUMS + VALL(I) * VALL(I)
         NSUMS = NSUMS + 1.0D0
         XMIN = MIN (XMIN, VALL(I))
         XMAX = MAX (XMAX, VALL(I))
 20      CONTINUE
      XMEAN = VSUM / NSUMS
      XVAR = VSUMS / NSUMS - XMEAN * XMEAN
      XSTD = SQRT (MAX (0.0, XVAR))
      XQ1 = MEDIAN (NLO, VLO)
      XQ3 = MEDIAN (NHI, VHI)
      XRMS = SQRT (VSUMS / NSUMS)
C                                       histogram
      IF (MOD(IDOPLT,2).EQ.1) THEN
         NBOXES = XBOXES + 0.1
         IF (NBOXES.LT.16) NBOXES = 256
         NBOXES = MIN (NBOXES, 1024)
         IF (XPIXR(2).LE.XPIXR(1)) THEN
            XPIXR(2) = XMAX
            XPIXR(1) = XMIN
            END IF
         FACT = NBOXES / (XPIXR(2) - XPIXR(1))
         CALL RFILL (1026, 0.0, HISTOG)
         DO 30 I = 1,NSAMP
            RBOX = FACT * (VALL(I) - XPIXR(1)) + 1.0000
            RBOX = MAX (0.0, MIN (RBOX, NBOXES+1.0))
            IF (ABS(1.0-RBOX).LT.0.01) THEN
               IBOX = 1
            ELSE IF (ABS(RBOX-NBOXES-1).LT.0.01) THEN
               IBOX = NBOXES
            ELSE
               IBOX = RBOX
               END IF
            HISTOG(IBOX) = HISTOG(IBOX) + 1.0
 30         CONTINUE
         END IF
C                                       MAD
      DO 40 I = 1,NSAMP
         VALL(I) = ABS (VALL(I) - XMED)
 40      CONTINUE
      XMAD = MEDIAN (NSAMP, VALL)
C                                       prepare plot line
      LTITLE = ' '
      IF ((JLOCIF.GE.0) .AND. (CATBLK(KINAX+JLOCIF).GT.1)) THEN
         IF (CATBLK(KINAX+JLOCF).GT.1) THEN
            WRITE (LTITLE,2020) BIF, EIF, BCHAN, ECHAN
         ELSE
            WRITE (LTITLE,2021) BIF, EIF
            END IF
      ELSE
         IF (CATBLK(KINAX+JLOCF).GT.1) WRITE (LTITLE,2022) BCHAN, ECHAN
         END IF
      CALL REFRMT (LTITLE, '_', I)
C                                       now report
      WRITE (MSGTXT,1000) BIF, EIF, BCHAN, ECHAN
      CALL MSGWRT (5)
      IF ((NXANT.LE.0) .AND. (NXBAS.LE.0)) THEN
         MSGTXT = 'All baselines'
         CALL MSGWRT (5)
      ELSE
         IF (DESEL) THEN
            MSGTXT = 'Exclude:'
         ELSE
            MSGTXT = 'Include:'
            END IF
         CALL MSGWRT (5)
         IF (NXANT.LE.0) THEN
            MSGTXT = '  All antennas'
            CALL MSGWRT (5)
         ELSE
            MSGTXT = '  Antennas='
            I2 = 0
 21         I1 = I2 + 1
            I2 = MIN (I1 + 9, NXANT)
            WRITE (MSGTXT(13:),1005) (IXANT(I), I = I1,I2)
            CALL MSGWRT (5)
            MSGTXT = ' '
            IF (I2.LT.NXANT) GO TO 21
            END IF
         IF (NXBAS.LE.0) THEN
            MSGTXT = '  with all antennas'
            CALL MSGWRT (5)
         ELSE
            MSGTXT = '  Baseline='
            I2 = 0
 22         I1 = I2 + 1
            I2 = MIN (I1 + 9, NXBAS)
            WRITE (MSGTXT(13:),1005) (IXBAS(I), I = I1,I2)
            CALL MSGWRT (5)
            MSGTXT = ' '
            IF (I2.LT.NXBAS) GO TO 22
            END IF
         END IF
      IF (NSOUWD.LE.0) THEN
         MSGTXT = 'Include all sources'
         CALL MSGWRT (5)
      ELSE
         IF (DOSWNT) THEN
            MSGTXT = 'Include:'
         ELSE
            MSGTXT = 'Exclude:'
            END IF
         CALL MSGWRT (5)
         I2 = 0
 23      I1 = I2 + 1
         I2 = MIN (I1+2, NSOUWD)
         WRITE (MSGTXT(13:),1010) (SOURCS(I)(:12), I = I1,I2)
         CALL MSGWRT (5)
         MSGTXT = ' '
         IF (I2.LT.NSOUWD) GO TO 23
      END IF

      IF (TSTART.GT.0.0) THEN
         T1 = TSTART
         IT1(1) = T1
         T1 = 24.0 * (T1 - IT1(1))
         IT1(2) = T1
         T1 = 60.0 * (T1 - IT1(2))
         IT1(3) = T1
         T1 = 60.0 * (T1 - IT1(3))
         END IF
      IF (TEND.LT.1.0E4) THEN
         T2 = TEND
         IT2(1) = T2
         T2 = 24.0 * (T2 - IT2(1))
         IT2(2) = T2
         T2 = 60.0 * (T2 - IT2(2))
         IT2(3) = T2
         T2 = 60.0 * (T2 - IT2(3))
         END IF
C                                       Man-readable form
      IF (TSTART.LE.0.0) THEN
         IF (TEND.GE.1.0E4) THEN
            MSGTXT = 'All times included'
         ELSE
            WRITE (MSGTXT,1015) IT2, T2
            IF (MSGTXT(37:37).EQ.' ') MSGTXT(37:37) = '0'
            END IF
      ELSE
         IF (TEND.GE.1.0E4) THEN
            WRITE (MSGTXT,1016) IT1, T1
            IF (MSGTXT(24:24).EQ.' ') MSGTXT(24:24) = '0'
         ELSE
            WRITE (MSGTXT,1017) IT1, T1, IT2, T2
            IF (MSGTXT(24:24).EQ.' ') MSGTXT(24:24) = '0'
            IF (MSGTXT(44:44).EQ.' ') MSGTXT(44:44) = '0'
            END IF
         END IF
      CALL MSGWRT (5)
      MSGTXT = '-------------------------------------------------------'
      CALL MSGWRT (5)
C                                       now report results
      WRITE (MSGTXT,1020) XTYPE(1), XMIN
      CALL MSGWRT (5)
      WRITE (MSGTXT,1020) XTYPE(2), XQ1
      CALL MSGWRT (5)
      WRITE (MSGTXT,1020) XTYPE(3), XMED
      CALL MSGWRT (5)
      WRITE (MSGTXT,1020) XTYPE(4), XQ3
      CALL MSGWRT (5)
      WRITE (MSGTXT,1020) XTYPE(5), XMAX
      CALL MSGWRT (5)
      WRITE (MSGTXT,1020) XTYPE(6), XMAD
      CALL MSGWRT (5)
      WRITE (MSGTXT,1020) XTYPE(7), XMEAN
      CALL MSGWRT (5)
      UVAVG = XMEAN
      WRITE (MSGTXT,1020) XTYPE(8), XVAR
      CALL MSGWRT (5)
      WRITE (MSGTXT,1020) XTYPE(9), XSTD
      CALL MSGWRT (5)
      UVSTD = XSTD
      WRITE (MSGTXT,1020) XTYPE(10), XRMS
      CALL MSGWRT (5)
      WRITE (MSGTXT,1025) XTYPE(11), VSUM
      CALL MSGWRT (5)
      WRITE (MSGTXT,1025) XTYPE(12), VSUMS
      CALL MSGWRT (5)
      WRITE (MSGTXT,1030) XTYPE(13), NSAMP
      CALL MSGWRT (5)
C
 999  RETURN
C-----------------------------------------------------------------------
 1000 FORMAT ('Samples limited to IFs',I3,' -',I3,' channels',I6,' -',
     *   I6)
 1005 FORMAT (10I5)
 1010 FORMAT (3(1X,'''',A,'''',1X))
 1015 FORMAT ('Timerange = beginning to',I5,'/',2(I2.2,':'),F5.2)
 1016 FORMAT ('Timerange =',I5,'/',2(I2.2,':'),F5.2,' to end')
 1017 FORMAT ('Timerange =',I5,'/',2(I2.2,':'),F5.2,' to',
     *   I5,'/',2(I2.2,':'),F5.2)
 1020 FORMAT (A,F13.6)
 1025 FORMAT (A,1PE13.6)
 1030 FORMAT (A,I13)
 2020 FORMAT ('IF number',2I3,'__Spectral channel',2I5)
 2021 FORMAT ('IF number',2I3)
 2022 FORMAT ('Spectral channel',2I5)
      END
      SUBROUTINE UVRMSP (STOKES, IRET)
C-----------------------------------------------------------------------
C    UVRMSP plots the histogram
C    Outputs:
C       IRET   I   > 0 => plot failure
C-----------------------------------------------------------------------
      CHARACTER STOKES*4
      INTEGER   IRET
C
      INCLUDE 'UVRMS.INC'
      INTEGER   I, PLUN, PLBLK(256), IVER, TVCHN, TVCORN(4), IDEPTH(5),
     *   J, NCHAR, IT(3), ID(3), JTRIM, LTYPE, LABEL, NOUT(2), PIND,
     *   IROUND
      LOGICAL   DOTV, FLAG
      CHARACTER PFILE*48, CHT12*12, CHT6*6, CHTY*2, UNITS(5)*20,
     *   STRING*80, CHT8*8, NS*18, ADATE*12, ATIME*8
      REAL      YMAX, YMIN, BLC(2), TRC(2), CH(4), X, X2, Y1, Y2,
     *   XYRATO, DX, DY, XSCALE, YSCALE
      DOUBLE PRECISION XX
      INCLUDE 'INCS:DMSG.INC'
      INCLUDE 'INCS:DLOC.INC'
      INCLUDE 'INCS:DUVH.INC'
      INCLUDE 'INCS:DHDR.INC'
      INCLUDE 'INCS:DCAT.INC'
      INCLUDE 'INCS:DTVC.INC'
      INCLUDE 'INCS:DFIL.INC'
      DATA TVCHN, TVCORN, IDEPTH /1, 4*0, 5*1/
      DATA UNITS /'Amplitude (Jy)', 'Real part (Jy)', 'Imaginary (Jy)',
     *   'Phase (degrees)', 'Scalar amp (Jy)'/
C-----------------------------------------------------------------------
      DOTV = XDOTV.GT.0.0
      NOUT(1) = HISTOG(0) + 0.1
      NOUT(2) = HISTOG(NBOXES+1) + 0.1
C                                       Logarithm, y scale
      IF (FUNTYP.EQ.'LG') THEN
         DO 10 I = 1,NBOXES
            IF (HISTOG(I).LE.0.0) THEN
               HISTOG(I) = LOG10 (0.5)
            ELSE
               HISTOG(I) = LOG10 (HISTOG(I))
               END IF
 10         CONTINUE
         END IF
      YMAX = -1.E10
      YMIN = -YMAX
      DO 20 I = 1,NBOXES
         YMIN = MIN (YMIN, HISTOG(I))
         YMAX = MAX (YMAX, HISTOG(I))
 20      CONTINUE
C                                       Add plot file to the image
C                                       catalog header.
      IF (.NOT.DOTV) THEN
         CHT12 = ' '
         CHT6 = ' '
         CHTY = ' '
         IF (IDOPLT.LT.2) 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
            END IF
         CALL MADDEX ('PL', DISKIN, OLDCNO, CATOLD, SCRBUF, .TRUE.,
     *      'WRIT', IVER, IRET)
         IF (IRET.NE.0) THEN
            MSGTXT = 'UVRMSP: ERROR UPDATING CATALOG HEADER.'
            CALL MSGWRT (8)
            GO TO 999
            END IF
         END IF
C                                       Open the PLot file.
      CALL ZPHFIL ('PL', DISKIN, OLDCNO, IVER, PFILE, IRET)
      APARM(10) = 2
      SOLINT = SOLINT * 24.0 * 60.0
      CALL GINIT (DISKIN, OLDCNO, PFILE, 0, 67, NPARM, XNAMEI, DOTV,
     *   TVCHN, GRCHAN, TVCORN, CATOLD, PLBLK, PLUN, PIND, IRET)
      IF (IRET.NE.0) THEN
         MSGTXT = 'UVRMSP: ERROR OPENING PLOT FILE FOR THE HISTOGRAM.'
         CALL MSGWRT (8)
         IF (.NOT.DOTV) CALL DELEXT ('PL', DISKIN, OLDCNO, 'WRIT',
     *      CATOLD, SCRBUF, IVER, I)
         GO TO 999
         END IF
      SOLINT = SOLINT / (24.0 * 60.0)
C                                       Set BLC, TRC, XYRATO.
      BLC(1) = -1.0
      BLC(2) = -1.0
      TRC(1) = 102.0
      TRC(2) = 102.0
C                                       Set coordinate common
      LOCNUM = 1
      RPVAL(1,LOCNUM) = XPIXR(1)
      RPVAL(2,LOCNUM) = YMIN
      RPLOC(1,LOCNUM) = 1.0
      RPLOC(2,LOCNUM) = 1.0
      AXINC(1,LOCNUM) = (XPIXR(2) - XPIXR(1)) / 99.0
      AXINC(2,LOCNUM) = (YMAX - YMIN) / 99.0
      ROT(LOCNUM) = 0.0
      NCHLAB(1,LOCNUM) = 0
      NCHLAB(2,LOCNUM) = 0
      LABTYP(LOCNUM) = 0
      CORTYP(LOCNUM) = 0
      AXTYP(LOCNUM) = 4
      AXFUNC(1,LOCNUM) = 0
      AXFUNC(2,LOCNUM) = 0
      NCHLAB(1,LOCNUM) = 0
      NCHLAB(2,LOCNUM) = 0
      CTYP(1,LOCNUM) = UNITS(IOPT)
      IF (FUNTYP.EQ.'LG') THEN
         CTYP(2,LOCNUM) = 'LOG10 (counts)'
      ELSE
         CTYP(2,LOCNUM) = 'Counts'
         END IF
C                                       metric scaling
      LABEL = IROUND (XLABEL)
      DO 30 I = 1,2
         Y1 = ABS (AXINC(I,LOCNUM) * (TRC(I) - BLC(I)))
         Y2 = Y1
         CALL METSCL (LABEL, Y2, CPREF(I,LOCNUM), FLAG)
         IF ((.NOT.FLAG) .AND. (Y1.NE.0.0)) THEN
            RPVAL(I,LOCNUM) = RPVAL(I,LOCNUM) * Y2 / Y1
            AXINC(I,LOCNUM) = AXINC(I,LOCNUM) * Y2 / Y1
         ELSE
            CPREF(I,LOCNUM) = ' '
            END IF
 30      CONTINUE
C                                       Set character offsets.
      LTYPE = MOD (ABS (LABEL), 100)
      CALL RFILL (4, 0.5, CH)
      CALL CHNTIC (BLC, TRC, J)
      IF (LTYPE.EQ.2) CH(1) = 2.5
      IF (LTYPE.GT.2) CH(1) = J + 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
         IF (LTITLE.NE.' ') CH(2) = CH(2) + 1.333
         IF ((NOUT(1).GT.0) .OR. (NOUT(2).GT.0)) CH(2) = CH(2) + 1.333
         CH(4) = 2.0
         IF (LABEL.GT.0) CH(4) = CH(4) + 1.333
         END IF
      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.0
         END IF
C                                       Initialize for line drawing
      CALL GINITL (BLC, TRC, XYRATO, CH, IDEPTH, PLBLK, IRET)
      IF (IRET.NE.0) THEN
         MSGTXT = 'UVRMSP: ERROR INITIALIZING FOR LINE DRAWING.'
         GO TO 950
         END IF
      CALL GLTYPE (1, PLBLK, IRET)
      IF (IRET.NE.0) GO TO 920
C                                       Draw borders.
      CALL GPOS (BLC(1), BLC(2), PLBLK, IRET)
      IF (IRET.NE.0) GO TO 910
      CALL GVEC (TRC(1), BLC(2), PLBLK, IRET)
      IF (IRET.NE.0) GO TO 920
      CALL GVEC (TRC(1), TRC(2), PLBLK, IRET)
      IF (IRET.NE.0) GO TO 920
      CALL GVEC (BLC(1), TRC(2), PLBLK, IRET)
      IF (IRET.NE.0) GO TO 920
      CALL GVEC (BLC(1), BLC(2), PLBLK, IRET)
      IF (IRET.NE.0) GO TO 920
C                                       Calculate range and scales.
      XSCALE = 99.0 / NBOXES
      YSCALE = 99.0 / (YMAX - YMIN)
C                                       Labeling: source, freq, etc
      IF ((LTYPE.GT.1) .AND. (LTYPE.LT.7)) THEN
         DX = 0.0
         DY = 0.5
         CALL H2CHR (8, 1, CATOH(KHOBJ), CHT8)
         XX = (CATOD(KDCRV+JLOCF) + CATOR(KRCIC+JLOCF)
     *      * (1.0 - CATOR(KRCRP+JLOCF))) / 1.0E6
         WRITE (STRING,1030) CHT8, XX, STOKES
         NS = NAMEIN // CLAIN
         CALL NAMEST (NS, CATOLD(KIIMS), STRING(31:), I)
         CALL REFRMT (STRING, '_', NCHAR)
         CALL GPOS (BLC(1), TRC(2), PLBLK, IRET)
         IF (IRET.NE.0) GO TO 910
         CALL GCHAR (NCHAR, 0, DX, DY, STRING, PLBLK, IRET)
         IF (IRET.NE.0) GO TO 930
         END IF
C                                       Labeling: date
      IF ((LABEL.GT.0) .AND. (LTYPE.GT.1) .AND. (LTYPE.LT.7)) THEN
         CALL ZDATE (ID)
         CALL ZTIME (IT)
         CALL TIMDAT (IT, ID, ATIME, ADATE)
         WRITE (STRING,1031) IVER, ADATE, ATIME
         DY = DY + 1.333
         CALL REFRMT (STRING, '_', NCHAR)
         CALL GPOS (BLC(1), TRC(2), PLBLK, IRET)
         IF (IRET.NE.0) GO TO 910
         CALL GCHAR (NCHAR, 0, DX, DY, STRING, PLBLK, IRET)
         IF (IRET.NE.0) GO TO 930
         END IF
C                                       Labeling: bin stuff
      WRITE (STRING,1035) NBOXES
      CALL CHTRIM (STRING, 10, STRING, NCHAR)
      NCHAR = NCHAR + 2
      STRING(NCHAR-1:) = ' '
      STRING(NCHAR:) = ' bins of width '
      NCHAR = NCHAR + 15
      X = (XPIXR(2) - XPIXR(1)) / (NBOXES - 1)
      WRITE (ADATE,1036) X
      STRING(NCHAR:) = ADATE(2:10)
      NCHAR = JTRIM (STRING)
      MSGTXT = 'Plot ' // STRING
      CALL MSGWRT (4)
      IF ((LTYPE.GT.1) .AND. (LTYPE.LT.7)) THEN
         DY = -1.5 - 1.333
         IF (LTYPE.GT.2) DY = DY - 1.333
         CALL GPOS (BLC(1), BLC(2), PLBLK, IRET)
         IF (IRET.NE.0) GO TO 910
         CALL GCHAR (NCHAR, 0, DX, DY, STRING, PLBLK, IRET)
         IF (IRET.NE.0) GO TO 930
C                                       samples outside
         IF ((NOUT(1).GT.0) .OR. (NOUT(2).GT.0)) THEN
            WRITE (STRING,1040) NOUT
            CALL REFRMT (STRING, '_', NCHAR)
            DY = DY - 1.333
            CALL GPOS (BLC(1), BLC(2), PLBLK, IRET)
            IF (IRET.NE.0) GO TO 910
            CALL GCHAR (NCHAR, 0, DX, DY, STRING, PLBLK, IRET)
            IF (IRET.NE.0) GO TO 930
            END IF
C                                       lower title: chan, IF
         IF (LTITLE.NE.' ') THEN
            NCHAR = JTRIM (LTITLE)
            DY = DY - 1.333
            CALL GPOS (BLC(1), BLC(2), PLBLK, IRET)
            IF (IRET.NE.0) GO TO 910
            CALL GCHAR (NCHAR, 0, DX, DY, LTITLE, PLBLK, IRET)
            IF (IRET.NE.0) GO TO 930
            END IF
         END IF
C                                       tick marks, labels, ...
      CALL CLAB1 (BLC, TRC, CH, LABEL, XYRATO, .FALSE., PLBLK, IRET)
      IF (IRET.NE.0) THEN
         MSGTXT = 'UVRMSP: PLOT ERROR OCCURRED WHILE DRAWING TICKS.'
         GO TO 950
         END IF
C                                       Draw the histogram
      CALL GLTYPE (2, PLBLK, IRET)
      IF (IRET.NE.0) GO TO 920
      X = 1.0
      CALL GPOS (X, 1.0, PLBLK, IRET)
      IF (IRET.NE.0) GO TO 910
      DO 40 I = 1,NBOXES
         Y1 = HISTOG(I)
         Y1 = (Y1 - YMIN) * YSCALE + 1.0
         CALL GVEC (X, Y1, PLBLK, IRET)
         IF (IRET.NE.0) GO TO 920
         X2 = X + XSCALE
         CALL GVEC (X2, Y1, PLBLK, IRET)
         IF (IRET.NE.0) GO TO 920
         X = X2
 40      CONTINUE
C                                       Mark quartiles
      CALL GLTYPE (4, PLBLK, IRET)
      IF (IRET.NE.0) GO TO 920
      DY = BLC(2) + 0.07 * (TRC(2) - BLC(2))
      DX = 99.0 / (XPIXR(2) - XPIXR(1))
      IF ((FITPAR(2).GT.XPIXR(1)) .AND. (FITPAR(2).LT.XPIXR(2))) THEN
         X = DX * (FITPAR(2) - XPIXR(1)) + 1.0
         CALL GPOS (X, BLC(2), PLBLK, IRET)
         IF (IRET.NE.0) GO TO 920
         CALL GVEC (X, DY, PLBLK, IRET)
         IF (IRET.NE.0) GO TO 920
         END IF
      IF ((FITPAR(4).GT.XPIXR(1)) .AND. (FITPAR(4).LT.XPIXR(2))) THEN
         X = DX * (FITPAR(4) - XPIXR(1)) + 1.0
         CALL GPOS (X, BLC(2), PLBLK, IRET)
         IF (IRET.NE.0) GO TO 920
         CALL GVEC (X, DY, PLBLK, IRET)
         IF (IRET.NE.0) GO TO 920
         END IF
      DY = BLC(2) + 0.14 * (TRC(2) - BLC(2))
      IF ((FITPAR(3).GT.XPIXR(1)) .AND. (FITPAR(3).LT.XPIXR(2))) THEN
         X = DX * (FITPAR(3) - XPIXR(1)) + 1.0
         CALL GPOS (X, BLC(2), PLBLK, IRET)
         IF (IRET.NE.0) GO TO 920
         CALL GVEC (X, DY, PLBLK, IRET)
         IF (IRET.NE.0) GO TO 920
         END IF
      CALL GFINIS (PLBLK, IRET)
      IF (IRET.NE.0) GO TO 950
      WRITE (MSGTXT,1050) IVER
      IF (.NOT.DOTV) CALL MSGWRT (3)
      GO TO 999
C                                       Error return from GPOS.
 910  MSGTXT = 'UVRMSP: PLOT ERROR OCCURRED WHILE MOVING TO A POINT.'
      GO TO 940
C                                       Error return from GVEC.
 920  MSGTXT = 'UVRMSP: PLOT ERROR OCCURRED WHILE DRAWING A LINE.'
      GO TO 940
C                                       error return from GCHAR
 930  MSGTXT = 'UVRMSP: PLOT ERROR OCCURRED WHILE DRAWING CHARACTERS.'
 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, SCRBUF,
     *      IVER, I)
         END IF
C
 999  RETURN
C-----------------------------------------------------------------------
 1030 FORMAT (A8,1X,F10.3,' MHz__',A4)
 1031 FORMAT ('PLot file version',I4,'__created ',A12,A8)
 1035 FORMAT (I8)
 1036 FORMAT (1PE10.3)
 1040 FORMAT ('Samples outside plot:',I8,' below,_',I8,' above')
 1050 FORMAT ('Successful  plot version',I4,' created')
 1950 FORMAT ('DESTROY PLOT VERSION',I4,' DUE TO ERRORS')
      END
      SUBROUTINE UVRMST (VALL, VTIM, STOKES, IRET)
C-----------------------------------------------------------------------
C    UVRMST plots the data vs time
C    Inputs:
C       VALL   R(*)   Data samples
C       VTIM   R(*)   Data times
C    Outputs:
C       IRET   I   > 0 => plot failure
C-----------------------------------------------------------------------
      REAL      VALL(*), VTIM(*)
      CHARACTER STOKES*4
      INTEGER   IRET
C
      INCLUDE 'UVRMS.INC'
      INTEGER   I, PLUN, PLBLK(256), IVER, TVCHN, TVCORN(4), IDEPTH(5),
     *   J, NCHAR, IT(3), ID(3), JTRIM, LTYPE, LABEL, PIND, IROUND
      LOGICAL   DOTV, FLAG
      CHARACTER PFILE*48, CHT12*12, CHT6*6, CHTY*2, UNITS(5)*20,
     *   STRING*80, CHT8*8, NS*18, ADATE*12, ATIME*8
      REAL      YMAX, YMIN, BLC(2), TRC(2), CH(4), X, Y, Y1, Y2,
     *   XYRATO, DX, DY, XSCALE, YSCALE, XMIN, XMAX
      DOUBLE PRECISION XX
      INCLUDE 'INCS:DMSG.INC'
      INCLUDE 'INCS:DLOC.INC'
      INCLUDE 'INCS:DUVH.INC'
      INCLUDE 'INCS:DHDR.INC'
      INCLUDE 'INCS:DCAT.INC'
      INCLUDE 'INCS:DTVC.INC'
      INCLUDE 'INCS:DGPH.INC'
      INCLUDE 'INCS:DFIL.INC'
      DATA TVCHN, TVCORN, IDEPTH /1, 4*0, 5*1/
      DATA UNITS /'Amplitude (Jy)', 'Real part (Jy)', 'Imaginary (Jy)',
     *   'Phase (degrees)', 'Scalar amp (Jy)'/
C-----------------------------------------------------------------------
      DOTV = XDOTV.GT.0.0
      YMAX = -1.E10
      YMIN = -YMAX
      XMAX = YMAX
      XMIN = YMIN
      DO 10 I = 1,NSAMP
         XMIN = MIN (XMIN, VTIM(I))
         XMAX = MAX (XMAX, VTIM(I))
         YMIN = MIN (YMIN, VALL(I))
         YMAX = MAX (YMAX, VALL(I))
 10      CONTINUE
      IF (APARM(2).GT.APARM(1)) THEN
         YMIN = APARM(1)
         YMAX = APARM(2)
         END IF
      APARM(1) = YMIN
      APARM(2) = YMAX
C                                       Add plot file to the image
C                                       catalog header.
      IF (.NOT.DOTV) THEN
         CHT12 = ' '
         CHT6 = ' '
         CHTY = ' '
         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
         CALL MADDEX ('PL', DISKIN, OLDCNO, CATOLD, SCRBUF, .TRUE.,
     *      'WRIT', IVER, IRET)
         IF (IRET.NE.0) THEN
            MSGTXT = 'UVRMST: ERROR UPDATING CATALOG HEADER.'
            CALL MSGWRT (8)
            GO TO 999
            END IF
         END IF
C                                       Open the PLot file.
      CALL ZPHFIL ('PL', DISKIN, OLDCNO, IVER, PFILE, IRET)
      APARM(10) = 1
      SOLINT = SOLINT * 24.0 * 60.0
      CALL GINIT (DISKIN, OLDCNO, PFILE, 0, 67, NPARM, XNAMEI, DOTV,
     *   TVCHN, GRCHAN, TVCORN, CATOLD, PLBLK, PLUN, PIND, IRET)
      IF (IRET.NE.0) THEN
         MSGTXT = 'UVRMST: ERROR OPENING PLOT FILE FOR TIME PLOT'
         CALL MSGWRT (8)
         IF (.NOT.DOTV) CALL DELEXT ('PL', DISKIN, OLDCNO, 'WRIT',
     *      CATOLD, PLBLK, IVER, I)
         GO TO 999
         END IF
      SOLINT = SOLINT / (24.0 * 60.0)
      IF (GRCHAN.LE.0) CALL GCINIT (GPHTVG(4), 0, IRET)
C                                       Set BLC, TRC, XYRATO.
      BLC(1) = -1.0
      BLC(2) = -1.0
      TRC(1) = 102.0
      TRC(2) = 102.0
C                                       Set coordinate common
      LOCNUM = 1
      RPVAL(1,LOCNUM) = XMIN * 360.0
      RPVAL(2,LOCNUM) = YMIN
      RPLOC(1,LOCNUM) = 1.0
      RPLOC(2,LOCNUM) = 1.0
      AXINC(1,LOCNUM) = (XMAX - XMIN) / 99.0 * 360
      AXINC(2,LOCNUM) = (YMAX - YMIN) / 99.0
      ROT(LOCNUM) = 0.0
      NCHLAB(1,LOCNUM) = 0
      NCHLAB(2,LOCNUM) = 0
      LABTYP(LOCNUM) = 7
      CORTYP(LOCNUM) = 0
      AXTYP(LOCNUM) = 4
      AXFUNC(1,LOCNUM) = 0
      AXFUNC(2,LOCNUM) = 0
      NCHLAB(1,LOCNUM) = 0
      NCHLAB(2,LOCNUM) = 0
      CTYP(1,LOCNUM) = 'Time (hours)'
      CTYP(2,LOCNUM) = UNITS(IOPT)
C                                       metric scaling
      LABEL = IROUND (XLABEL)
      CPREF(1,LOCNUM) = ' '
      DO 30 I = 2,2
         Y1 = ABS (AXINC(I,LOCNUM) * (TRC(I) - BLC(I)))
         Y2 = Y1
         CALL METSCL (LABEL, Y2, CPREF(I,LOCNUM), FLAG)
         IF ((.NOT.FLAG) .AND. (Y1.NE.0.0)) THEN
            RPVAL(I,LOCNUM) = RPVAL(I,LOCNUM) * Y2 / Y1
            AXINC(I,LOCNUM) = AXINC(I,LOCNUM) * Y2 / Y1
         ELSE
            CPREF(I,LOCNUM) = ' '
            END IF
 30      CONTINUE
C                                       Set character offsets.
      LTYPE = MOD (ABS (LABEL), 100)
      CALL RFILL (4, 0.5, CH)
      CALL CHNTIC (BLC, TRC, J)
      IF (LTYPE.EQ.2) CH(1) = 2.5
      IF (LTYPE.GT.2) CH(1) = J + 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
         IF (LTITLE.NE.' ') CH(2) = CH(2) + 1.333
         CH(4) = 2.0
         IF (LABEL.GT.0) CH(4) = CH(4) + 1.333
         END IF
      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.0
         END IF
C                                       Initialize for line drawing
      CALL GINITL (BLC, TRC, XYRATO, CH, IDEPTH, PLBLK, IRET)
      IF (IRET.NE.0) THEN
         MSGTXT = 'UVRMST: ERROR INITIALIZING FOR LINE DRAWING.'
         GO TO 950
         END IF
      CALL GLTYPE (1, PLBLK, IRET)
      IF (IRET.NE.0) GO TO 920
C                                       Draw borders.
      CALL GPOS (BLC(1), BLC(2), PLBLK, IRET)
      IF (IRET.NE.0) GO TO 910
      CALL GVEC (TRC(1), BLC(2), PLBLK, IRET)
      IF (IRET.NE.0) GO TO 920
      CALL GVEC (TRC(1), TRC(2), PLBLK, IRET)
      IF (IRET.NE.0) GO TO 920
      CALL GVEC (BLC(1), TRC(2), PLBLK, IRET)
      IF (IRET.NE.0) GO TO 920
      CALL GVEC (BLC(1), BLC(2), PLBLK, IRET)
      IF (IRET.NE.0) GO TO 920
C                                       Calculate range and scales.
      XSCALE = 99.0 / (XMAX - XMIN)
      YSCALE = 99.0 / (YMAX - YMIN)
C                                       Labeling: source, freq, etc
      IF ((LTYPE.GT.1) .AND. (LTYPE.LT.7)) THEN
         DX = 0.0
         DY = 0.5
         CALL H2CHR (8, 1, CATOH(KHOBJ), CHT8)
         XX = (CATOD(KDCRV+JLOCF) + CATOR(KRCIC+JLOCF)
     *      * (1.0 - CATOR(KRCRP+JLOCF))) / 1.0E6
         WRITE (STRING,1030) CHT8, XX, STOKES
         NS = NAMEIN // CLAIN
         CALL NAMEST (NS, CATOLD(KIIMS), STRING(31:), I)
         CALL REFRMT (STRING, '_', NCHAR)
         CALL GPOS (BLC(1), TRC(2), PLBLK, IRET)
         IF (IRET.NE.0) GO TO 910
         CALL GCHAR (NCHAR, 0, DX, DY, STRING, PLBLK, IRET)
         IF (IRET.NE.0) GO TO 930
         END IF
C                                       Labeling: date
      IF ((LABEL.GT.0) .AND. (LTYPE.GT.1) .AND. (LTYPE.LT.7)) THEN
         CALL ZDATE (ID)
         CALL ZTIME (IT)
         CALL TIMDAT (IT, ID, ATIME, ADATE)
         WRITE (STRING,1031) IVER, ADATE, ATIME
         DY = DY + 1.333
         CALL REFRMT (STRING, '_', NCHAR)
         CALL GPOS (BLC(1), TRC(2), PLBLK, IRET)
         IF (IRET.NE.0) GO TO 910
         CALL GCHAR (NCHAR, 0, DX, DY, STRING, PLBLK, IRET)
         IF (IRET.NE.0) GO TO 930
         END IF
C                                       Labeling:
      IF ((LTYPE.GT.1) .AND. (LTYPE.LT.7)) THEN
         DY = -1.5
C                                       lower title: chan, IF
         IF (LTITLE.NE.' ') THEN
            NCHAR = JTRIM (LTITLE)
            DY = DY - 1.333
            CALL GPOS (BLC(1), BLC(2), PLBLK, IRET)
            IF (IRET.NE.0) GO TO 910
            CALL GCHAR (NCHAR, 0, DX, DY, LTITLE, PLBLK, IRET)
            IF (IRET.NE.0) GO TO 930
            END IF
         END IF
C                                       tick marks, labels, ...
      CALL CLAB1 (BLC, TRC, CH, LABEL, XYRATO, .FALSE., PLBLK, IRET)
      IF (IRET.NE.0) THEN
         MSGTXT = 'UVRMST: PLOT ERROR OCCURRED WHILE DRAWING TICKS.'
         GO TO 950
         END IF
C                                       Draw the data
      CALL GLTYPE (2, PLBLK, IRET)
      IF (IRET.NE.0) GO TO 920
      DX = 0.1
      DO 40 I = 1,NSAMP
         X = (VTIM(I) - XMIN) * XSCALE + 1.0
         Y = (VALL(I) - YMIN) * YSCALE + 1.0
         CALL GPOS (X-DX, Y+DX, PLBLK, IRET)
         IF (IRET.NE.0) GO TO 910
         CALL GVEC (X+DX, Y-DX, PLBLK, IRET)
         IF (IRET.NE.0) GO TO 920
         CALL GPOS (X+DX, Y+DX, PLBLK, IRET)
         IF (IRET.NE.0) GO TO 910
         CALL GVEC (X-DX, Y-DX, PLBLK, IRET)
         IF (IRET.NE.0) GO TO 920
 40      CONTINUE
      GPHPAG = MOD(IDOPLT,2).EQ.1
      CALL GFINIS (PLBLK, IRET)
      IF (IRET.NE.0) GO TO 950
      WRITE (MSGTXT,1050) IVER
      IF (.NOT.DOTV) CALL MSGWRT (3)
      GO TO 999
C                                       Error return from GPOS.
 910  MSGTXT = 'UVRMST: PLOT ERROR OCCURRED WHILE MOVING TO A POINT.'
      GO TO 940
C                                       Error return from GVEC.
 920  MSGTXT = 'UVRMST: PLOT ERROR OCCURRED WHILE DRAWING A LINE.'
      GO TO 940
C                                       error return from GCHAR
 930  MSGTXT = 'UVRMST: PLOT ERROR OCCURRED WHILE DRAWING CHARACTERS.'
 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, SCRBUF,
     *      IVER, I)
         END IF
C
 999  RETURN
C-----------------------------------------------------------------------
 1030 FORMAT (A8,1X,F10.3,' MHz__',A4)
 1031 FORMAT ('PLot file version',I4,'__created ',A12,A8)
 1050 FORMAT ('Successful  plot version',I4,' created')
 1950 FORMAT ('DESTROY PLOT VERSION',I4,' DUE TO ERRORS')
      END
