LOCAL INCLUDE 'PCDIV.INC'
C                                                          Include PCDIV
C                                       Local include for PCDIV
      INCLUDE 'INCS:PUVD.INC'
      HOLLERITH XNAMEI(3), XCLAIN(2), XINEXT(1), XOPTYP(1)
      CHARACTER NAMEIN*12, CLAIN*6, INEXT*2, OPTYPE*4
      REAL      XSIN, XDISIN, XINVER, XTYVER, DETIME, BADD(10)
      INTEGER   DISKIN, SEQIN, CNOIN, INVER, OUTVER, ITYVER,
     *   BUFFER(512), RECMAX(MAXANT), NIF, NANT, MREC, NPOL, NTIME
      COMMON /INPARM/ XNAMEI, XCLAIN, XSIN, XDISIN, XINVER, XINEXT,
     *   XTYVER, DETIME, XOPTYP, BADD
      COMMON /CHRCOM/ NAMEIN, CLAIN, INEXT, OPTYPE
      COMMON /INFOLS/ DISKIN, SEQIN, CNOIN, INVER, OUTVER, ITYVER,
     *   NIF, NANT, MREC, BUFFER, RECMAX, NPOL, NTIME
      INCLUDE 'INCS:DMSG.INC'
      INCLUDE 'INCS:DDCH.INC'
      INCLUDE 'INCS:DCAT.INC'
C                                                          End PCDIV
LOCAL END
LOCAL INCLUDE 'TYDATA.INC'
      INTEGER   TYBUFF(512), ITYRNO, TYKOLS(MAXTYC), TYNUMV(MAXTYC),
     *   SOURID, ANTNO, SUBA, FREQID, SYKOLS(MAXSYC), SYNUMV(MAXSYC)
      REAL      TIMEI, TSYS(2,MAXIF), TANT(2,MAXIF), PSUM(2,MAXIF),
     *   PDIF(2,MAXIF), PGAIN(2,MAXIF)
      DOUBLE PRECISION TIME
      EQUIVALENCE (PSUM, TSYS), (PDIF, TANT)
      COMMON /TYDATA/ TIME, TYBUFF, ITYRNO, TYKOLS, TYNUMV, SOURID,
     *   ANTNO, SUBA, FREQID, TIMEI, TSYS, TANT, SYKOLS, SYNUMV,
     *   PGAIN
LOCAL END
LOCAL INCLUDE 'PCDATA.INC'
      INCLUDE 'INCS:PPCV.INC'
      DOUBLE PRECISION TIME, CABCAL, PCFREQ(2,MAXTON,MAXIF)
      INTEGER   PCNPOL, PCNIF, NUMTON, PCBUFF(512), PCNUMV(MAXPCC),
     *   PCKOLS(MAXPCC), PCROW, OUTROW
      REAL      TIMINT, STATE(2,4,MAXIF), PCREAL(2,MAXTON,MAXIF),
     *   PCIMAG(2,MAXTON,MAXIF), PCRATE(2,MAXTON,MAXIF)
      COMMON /PCDATA/ PCFREQ, TIME, CABCAL, STATE, PCREAL, PCIMAG,
     *   PCRATE, PCBUFF, TIMINT, PCKOLS, PCNUMV, PCNPOL, PCNIF, NUMTON,
     *   PCROW, OUTROW
LOCAL END
      PROGRAM PCDIV
C-----------------------------------------------------------------------
C! scale a PC table by the TY Tsys values
C# UV Calibration EXT-appl VLBI
C-----------------------------------------------------------------------
C;  Copyright (C) 2021-2022
C;  Associated Universities, Inc. Washington DC, USA.
C;
C;  This program is free software; you can redistribute it and/or
C;  modify it under the terms of the GNU General Public License as
C;  published by the Free Software Foundation; either version 2 of
C;  the License, or (at your option) any later version.
C;
C;  This program is distributed in the hope that it will be useful,
C;  but WITHOUT ANY WARRANTY; without even the implied warranty of
C;  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
C;  GNU General Public License for more details.
C;
C;  You should have received a copy of the GNU General Public
C;  License along with this program; if not, write to the Free
C;  Software Foundation, Inc., 675 Massachusetts Ave, Cambridge,
C;  MA 02139, USA.
C;
C;  Correspondence concerning AIPS should be addressed as follows:
C;         Internet email: aipsmail@nrao.edu.
C;         Postal address: AIPS Project Office
C;                         National Radio Astronomy Observatory
C;                         520 Edgemont Road
C;                         Charlottesville, VA 22903-2475 USA
C-----------------------------------------------------------------------
C   Task PCDIV sorts a PC table into time-antenna order and then
C   writes a new table with PC amplitudes divided by Tsys
C   Inputs:
C      AIPS Adverb   Prg. Name          Description
C      INNAME         NAMEIN        File name to be imaged
C      INCLASS        CLAIN         File class to be imaged
C      INSEQ          SEQIN         File sequence number
C      INDISK         DISKIN        Disk volume on which file resides
C      INVERS         INVER         Input version
C      INEXT          INEXT         'TY' or 'SY'
C      TYVER          ITYVER        TY / SY version
C      DETIME         DETIME        In seconds, treat times as equal
C-----------------------------------------------------------------------
      CHARACTER PRGM*6
      INTEGER   IRET, NWORDS, ND
      REAL      TYDATA(2)
      LONGINT   PTYDAT
      INCLUDE 'PCDIV.INC'
      DATA PRGM /'PCDIV '/
C-----------------------------------------------------------------------
C                                       get inputs, ...
      CALL PCDIVI (PRGM, IRET)
      IF (IRET.NE.0) GO TO 990
C                                       dynamic memory for TY data
      ND = 2 + NANT * NPOL * NIF
      NWORDS = ND * NTIME
      NWORDS = (NWORDS - 1) / 1024 + 4
      CALL ZMEMRY ('GET ', TSKNAM, NWORDS, TYDATA, PTYDAT, IRET)
      IF (IRET.NE.0) THEN
         MSGTXT = 'FAILED TO GET DYNAMIC MEMORY'
         CALL MSGWRT (8)
         GO TO 990
         END IF
      IF (INEXT.EQ.'TY') THEN
         CALL PCDITY (ND, TYDATA(1+PTYDAT), IRET)
      ELSE
         CALL PCDISY (ND, TYDATA(1+PTYDAT), IRET)
         END IF
      IF (IRET.NE.0) GO TO 990
      CALL PCDIPC (ND, TYDATA(1+PTYDAT), IRET)
      IF (IRET.NE.0) GO TO 990
C                                       Do history
      CALL PCDIHI
C                                       close down
 990  CALL DIE (IRET, BUFFER)
C
 999  STOP
      END
      SUBROUTINE PCDIVI (PRGM, IRET)
C-----------------------------------------------------------------------
C   PCDIVI gets the inputs for PCDIV.
C   Inputs:
C      PRGM   C*6   Task name
C   Output:
C      ONEIF  L     T => input has <= 1 IF
C      IRET   I     Error code: 0 ok, else quit
C-----------------------------------------------------------------------
      CHARACTER PRGM*6
      INTEGER   IRET
C
      CHARACTER STAT*4, UTYPE*2
      INTEGER   NPARM, IERR, IROUND, I, KEY(2,2), KEYSUB(2,2), LUN,
     *   LUNTMP, IREC, NREC, CALTYP
      REAL      FKEY(2,2), RTIME, LTIME
      INCLUDE 'PCDIV.INC'
      INCLUDE 'TYDATA.INC'
      INCLUDE 'INCS:DFIL.INC'
      DATA FKEY /1.0,0.0,1.0,0.0/
      DATA KEYSUB, KEY /4*1, 4*0/
C-----------------------------------------------------------------------
C                                       Init for AIPS, disks, ...
      CALL ZDCHIN (.TRUE.)
      CALL VHDRIN
C                                       Initialize /CFILES/
      NSCR = 0
      NCFILE = 0
      IRET = 0
C                                       Get input parameters.
      NPARM = 22
      CALL GTPARM (PRGM, NPARM, RQUICK, XNAMEI, BUFFER, IERR)
      IF (IERR.NE.0) THEN
         RQUICK = .TRUE.
         IRET = 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 (IRET, BUFFER, IERR)
      IRET = 5
C                                       Crunch input parameters.
      DO 5 I = 1,10
         IBAD(I) = IROUND(BADD(I))
 5       CONTINUE
      SEQIN = IROUND (XSIN)
      DISKIN = IROUND (XDISIN)
C                                       Convert characters
      CALL H2CHR (12, 1, XNAMEI, NAMEIN)
      CALL H2CHR (6, 1, XCLAIN, CLAIN)
      CALL H2CHR (4, 1, XOPTYP, OPTYPE)
C                                       Get CATBLK.
      CNOIN = 1
      UTYPE = 'UV'
      CALL CATDIR ('SRCH', DISKIN, CNOIN, NAMEIN, CLAIN, SEQIN, UTYPE,
     *   NLUSER, STAT, BUFFER, IERR)
      IF (IERR.NE.0) THEN
         IF (IERR.NE.5) THEN
            WRITE (MSGTXT,1015) IERR, NAMEIN, CLAIN, SEQIN, DISKIN,
     *         NLUSER
         ELSE
            WRITE (MSGTXT,1016) NAMEIN, CLAIN, SEQIN, DISKIN, NLUSER
            END IF
         GO TO 990
         END IF
      CALL CATIO ('READ', DISKIN, CNOIN, CATBLK, 'WRIT', BUFFER, IERR)
      IF (IERR.NE.0) THEN
         WRITE (MSGTXT,1020) IERR
         GO TO 990
         END IF
      NCFILE = NCFILE + 1
      FVOL(NCFILE) = DISKIN
      FCNO(NCFILE) = CNOIN
      FRW(NCFILE) = 1
C                                       Get uv header info.
      CALL UVPGET (IRET)
      IF (IRET.NE.0) GO TO 999
C                                       size, sort TY table
      ITYVER = XTYVER + 0.1
      IF (DETIME.LE.0.0) DETIME = 1.0
      DETIME = DETIME / (24.0 * 3600.0)
      CALL H2CHR (2, 1, XINEXT, INEXT)
      IF ((INEXT.NE.'TY') .AND. (INEXT.NE.'SY')) INEXT = 'TY'
      LUN = LUNTMP (1)
      LTIME = -100.
      NTIME = 0
      NANT = 0
      IF (INEXT.EQ.'TY') THEN
         CALL TYINI ('READ', TYBUFF, DISKIN, CNOIN, ITYVER, CATBLK, LUN,
     *      ITYRNO, TYKOLS, TYNUMV, NPOL, NIF, IRET)
         IF (IRET.NE.0) THEN
            WRITE (MSGTXT,1000) IRET, 'OPENING TY TABLE'
            GO TO 990
            END IF
         IF ((TYBUFF(43).NE.1) .OR. (TYBUFF(44).NE.4)) THEN
            CALL TABIO ('CLOS', 0, ITYRNO, TYBUFF, TYBUFF, IRET)
            MSGTXT = 'Sorting input TY table'
            CALL MSGWRT (2)
            KEY(1,1) = 1
            KEY(1,2) = 4
            CALL TABSRT (DISKIN, CNOIN, 'TY', ITYVER, ITYVER, KEY,
     *         KEYSUB,FKEY, TYBUFF, CATBLK, IRET)
            IF (IRET.NE.0) THEN
               WRITE (MSGTXT,1000) IRET, 'SORTING TY TABLE'
               GO TO 990
               END IF
            CALL TYINI ('READ', TYBUFF, DISKIN, CNOIN, ITYVER, CATBLK,
     *         LUN,ITYRNO, TYKOLS, TYNUMV, NPOL, NIF, IRET)
            IF (IRET.NE.0) THEN
               WRITE (MSGTXT,1000) IRET, 'RE-OPENING TY TABLE'
               GO TO 990
               END IF
            END IF
         NREC = TYBUFF(5)
         DO 20 IREC = 1,NREC
            CALL TABTY ('READ', TYBUFF, ITYRNO, TYKOLS, TYNUMV, NPOL,
     *         NIF, RTIME, TIMEI, SOURID, ANTNO, SUBA, FREQID, TSYS,
     *         TANT, IRET)
            IF (IRET.GT.0) THEN
               WRITE (MSGTXT,1000) IRET, 'READING TY TABLE'
               GO TO 990
            ELSE IF (IRET.EQ.0) THEN
               IF (RTIME.GT.LTIME) THEN
                  NTIME = NTIME + 1
                  LTIME = RTIME + DETIME
                  END IF
               NANT = MAX (NANT, ANTNO)
               END IF
 20         CONTINUE
         CALL TABTY ('CLOS', TYBUFF, ITYRNO, TYKOLS, TYNUMV, NPOL, NIF,
     *      RTIME, TIMEI, SOURID, ANTNO, SUBA, FREQID, TSYS, TANT, IRET)
         IF (IRET.NE.0) THEN
            WRITE (MSGTXT,1000) IRET, 'CLOSING TY TABLE'
            GO TO 990
            END IF
C                                       SY table
      ELSE
         CALL SYINI ('READ', TYBUFF, DISKIN, CNOIN, ITYVER, CATBLK, LUN,
     *      ITYRNO, SYKOLS, SYNUMV, NANT, NPOL, NIF, IRET)
         IF (IRET.NE.0) THEN
            WRITE (MSGTXT,1000) IRET, 'OPENING SY TABLE'
            GO TO 990
            END IF
         IF ((TYBUFF(43).NE.1) .OR. (TYBUFF(44).NE.5)) THEN
            CALL TABIO ('CLOS', 0, ITYRNO, TYBUFF, TYBUFF, IRET)
            MSGTXT = 'Sorting input SY table'
            CALL MSGWRT (2)
            KEY(1,1) = 1
            KEY(1,2) = 5
            CALL TABSRT (DISKIN, CNOIN, 'SY', ITYVER, ITYVER, KEY,
     *         KEYSUB,FKEY, TYBUFF, CATBLK, IRET)
            IF (IRET.NE.0) THEN
               WRITE (MSGTXT,1000) IRET, 'SORTING SY TABLE'
               GO TO 990
               END IF
            CALL SYINI ('READ', TYBUFF, DISKIN, CNOIN, ITYVER, CATBLK,
     *         LUN, ITYRNO, SYKOLS, SYNUMV, NANT, NPOL, NIF, IRET)
            IF (IRET.NE.0) THEN
               WRITE (MSGTXT,1000) IRET, 'RE-OPENING SY TABLE'
               GO TO 990
               END IF
            END IF
         NREC = TYBUFF(5)
         NANT = 0
         DO 30 IREC = 1,NREC
            CALL TABSY ('READ', TYBUFF, ITYRNO, SYKOLS, SYNUMV, NPOL,
     *         NIF, TIME, TIMEI, CALTYP, SOURID, ANTNO, SUBA, FREQID,
     *         PDIF, PSUM, PGAIN, IRET)
            IF (IRET.GT.0) THEN
               WRITE (MSGTXT,1000) IRET, 'READING SY TABLE'
               GO TO 990
            ELSE IF (IRET.EQ.0) THEN
               IF (TIME.GT.LTIME) THEN
                  NTIME = NTIME + 1
                  LTIME = TIME + DETIME
                  END IF
               NANT = MAX (NANT, ANTNO)
               END IF
 30         CONTINUE
         CALL TABSY ('CLOS', TYBUFF, ITYRNO, SYKOLS, SYNUMV, NPOL,
     *      NIF, TIME, TIMEI, CALTYP, SOURID, ANTNO, SUBA, FREQID,
     *      PDIF, PSUM, PGAIN, IRET)
         IF (IRET.GT.0) THEN
            WRITE (MSGTXT,1000) IRET, 'CLOSING SY TABLE'
            GO TO 990
            END IF
         END IF
      GO TO 999
C                                       message
 990  CALL MSGWRT (8)
C
 999  RETURN
C-----------------------------------------------------------------------
 1000 FORMAT ('PCDIVI: ERROR',I3,' ON ',A)
 1015 FORMAT ('ERROR',I3,' FINDING ',A12,'.',A6,'.',I5,' DISK=',
     *   I3,' USID=',I5)
 1016 FORMAT (A12,'.',A6,'.',I5,' DISK=',I3,' USID=',I5,' NOT FOUND')
 1020 FORMAT ('PCDIVI: ERROR',I3,' READING CATBLK ')
      END
      SUBROUTINE PCDITY (ND, TYDAT, IRET)
C-----------------------------------------------------------------------
C   Reads in the TY data
C   Inputs:
C      ND      I      Number data = time, source, Nant*2*Nif
C   Outputs:
C      TYDAT   R(*)   Tsys (nd, ntime)
C      IRET    I      error code
C-----------------------------------------------------------------------
      INTEGER   ND, IRET
      REAL      TYDAT(ND,*)
C
      INCLUDE 'PCDIV.INC'
      INCLUDE 'TYDATA.INC'
      INTEGER   NP, IP, IREC, NREC, LUN, LUNTMP, IT
      REAL      RTIME, LTIME
C-----------------------------------------------------------------------
      LUN  = LUNTMP (1)
      CALL TYINI ('READ', TYBUFF, DISKIN, CNOIN, ITYVER, CATBLK, LUN,
     *   ITYRNO, TYKOLS, TYNUMV, NPOL, NIF, IRET)
      IF (IRET.NE.0) THEN
         WRITE (MSGTXT,1000) IRET, 'OPENING TY TABLE'
         GO TO 990
         END IF
      LTIME = -100.
      NREC = TYBUFF(5)
      NP = NPOL * NIF
      IT = 0
      DO 20 IREC = 1,NREC
         CALL TABTY ('READ', TYBUFF, ITYRNO, TYKOLS, TYNUMV, NPOL, NIF,
     *      RTIME, TIMEI, SOURID, ANTNO, SUBA, FREQID, TSYS, TANT, IRET)
         IF (IRET.NE.0) THEN
            WRITE (MSGTXT,1000) IRET, 'READING TY TABLE'
            GO TO 990
            END IF
         IF (RTIME.GT.LTIME) THEN
            IT = IT + 1
            LTIME = RTIME + DETIME
            CALL RFILL (ND, 0.0, TYDAT(1,IT))
            TYDAT(1,IT) = RTIME
            TYDAT(2,IT) = SOURID
            END IF
         IP = 3 + (ANTNO-1) * NP
         CALL RCOPY (NP, TSYS, TYDAT(IP,IT))
 20      CONTINUE
      CALL TABTY ('CLOS', TYBUFF, ITYRNO, TYKOLS, TYNUMV, NPOL, NIF,
     *   RTIME, TIMEI, SOURID, ANTNO, SUBA, FREQID, TSYS, TANT, IRET)
      IF (IRET.NE.0) THEN
         WRITE (MSGTXT,1000) IRET, 'CLOSING TY TABLE'
         GO TO 990
         END IF
      GO TO 999
C
 990  CALL MSGWRT (8)
C
 999  RETURN
C-----------------------------------------------------------------------
 1000 FORMAT ('PCDITY ERROR',I4,' ON ',A)
      END
      SUBROUTINE PCDISY (ND, TYDAT, IRET)
C-----------------------------------------------------------------------
C   Reads in the SY data
C   Inputs:
C      ND      I      Number data = time, source, Nant*2*Nif
C   Outputs:
C      TYDAT   R(*)   Tsys (nd, ntime)
C      IRET    I      error code
C-----------------------------------------------------------------------
      INTEGER   ND, IRET
      REAL      TYDAT(ND,*)
C
      INCLUDE 'PCDIV.INC'
      INCLUDE 'TYDATA.INC'
      INTEGER   NP, IP, IREC, NREC, LUN, LUNTMP, IT, NA, CALTYP
      DOUBLE PRECISION LTIME
C-----------------------------------------------------------------------
      LUN  = LUNTMP (1)
      CALL SYINI ('READ', TYBUFF, DISKIN, CNOIN, ITYVER, CATBLK, LUN,
     *   ITYRNO, SYKOLS, SYNUMV, NA, NPOL, NIF, IRET)
      IF (IRET.NE.0) THEN
         WRITE (MSGTXT,1000) IRET, 'OPENING SY TABLE'
         GO TO 990
         END IF
      LTIME = -100.D0
      NREC = TYBUFF(5)
      NP = NPOL * NIF
      IT = 0
      DO 20 IREC = 1,NREC
         CALL TABSY ('READ', TYBUFF, ITYRNO, SYKOLS, SYNUMV, NPOL, NIF,
     *      TIME, TIMEI, CALTYP, SOURID, ANTNO, SUBA, FREQID, PDIF,
     *      PSUM, PGAIN, IRET)
         IF (IRET.NE.0) THEN
            WRITE (MSGTXT,1000) IRET, 'READING TY TABLE'
            GO TO 990
         ELSE IF (IRET.EQ.0) THEN
            IF (TIME.GT.LTIME) THEN
               IT = IT + 1
               LTIME = TIME + DETIME
               CALL RFILL (ND, 0.0, TYDAT(1,IT))
               TYDAT(1,IT) = TIME
               TYDAT(2,IT) = SOURID
               END IF
            IP = 3 + (ANTNO-1) * NP
            CALL RCOPY (NP, PSUM, TYDAT(IP,IT))
            END IF
 20      CONTINUE
      CALL TABSY ('CLOS', TYBUFF, ITYRNO, SYKOLS, SYNUMV, NPOL, NIF,
     *   TIME, TIMEI, CALTYP, SOURID, ANTNO, SUBA, FREQID, PDIF,
     *   PSUM, PGAIN, IRET)
      IF (IRET.NE.0) THEN
         WRITE (MSGTXT,1000) IRET, 'CLOSING SY TABLE'
         GO TO 990
         END IF
      GO TO 999
C
 990  CALL MSGWRT (8)
C
 999  RETURN
C-----------------------------------------------------------------------
 1000 FORMAT ('PCDITY ERROR',I4,' ON ',A)
      END
      SUBROUTINE PCDIPC (ND, TYDAT, IRET)
C-----------------------------------------------------------------------
C   PCDIPC sorts the input table if needed and does the scaling by an
C   interpolated set of TY values
C   Output:
C      IRET     I      Error code: 0 => okay, else die.
C-----------------------------------------------------------------------
      INTEGER   ND, IRET
      REAL      TYDAT(ND,*)
C
      INCLUDE 'PCDIV.INC'
      INCLUDE 'PCDATA.INC'
      INTEGER   I, ISUB, PCLUN, KEY(2,2), KEYSUB(2,2), NXVER, ANTNUM,
     *   FREQID, IROW, NSCAN, NUMPC, NXLUN, SOUNUM, PC2LUN, OUBUFF(512),
     *   LANT, LSOUR, LIF, LP, LCH, IP, IT,NP, NT0, NT1
      REAL      FKEY(2,2), STIMES(2000), TSYS(2), W0, W1
      DOUBLE PRECISION LTIME
      DATA FKEY /1.0,0.0,1.0,0.0/
      DATA KEYSUB, KEY /4*1, 4*0/
      DATA PCLUN, PC2LUN, NXLUN /43,44,45/
C-----------------------------------------------------------------------
C                                       open PC table
      INVER = XINVER + 0.1
      CALL FNDEXT ('PC', CATBLK, I)
      IF (INVER.LE.0) INVER = I
      IF (INVER.GT.I) INVER = I
      OUTVER = I + 1
      CALL PCINI ('READ', PCBUFF, DISKIN, CNOIN, INVER, CATBLK, PCLUN,
     *   PCROW, PCKOLS, PCNUMV, PCNPOL, PCNIF, NUMTON, IRET)
      IF (IRET.NE.0) THEN
         WRITE (MSGTXT,1000) IRET, 'OPENING INPUT PC TABLE'
         GO TO 990
         END IF
      XINVER = INVER
C                                       sort to output PC table
      CALL TABIO ('CLOS', 0, PCROW, PCBUFF, PCBUFF, IRET)
      IF ((PCBUFF(43).NE.1) .OR. (PCBUFF(44).NE.4)) THEN
         MSGTXT = 'Sorting input table'
         CALL MSGWRT (2)
         KEY(1,1) = 1
         KEY(1,2) = 4
         CALL TABSRT (DISKIN, CNOIN, 'PC', INVER, INVER, KEY, KEYSUB,
     *      FKEY, PCBUFF, CATBLK, IRET)
         IF (IRET.NE.0) THEN
            WRITE (MSGTXT,1000) IRET, 'SORTING PC TABLE'
            GO TO 990
            END IF
         END IF
      CALL PCINI ('READ', PCBUFF, DISKIN, CNOIN, INVER, CATBLK, PCLUN,
     *   PCROW, PCKOLS, PCNUMV, PCNPOL, PCNIF, NUMTON, IRET)
      IF (IRET.NE.0) THEN
         WRITE (MSGTXT,1000) IRET, 'RE-OPENING INPUT PC TABLE'
         GO TO 990
         END IF
      CALL PCINI ('WRIT', OUBUFF, DISKIN, CNOIN, OUTVER, CATBLK, PC2LUN,
     *   OUTROW, PCKOLS, PCNUMV, PCNPOL, PCNIF, NUMTON, IRET)
      IF (IRET.NE.0) THEN
         WRITE (MSGTXT,1000) IRET, 'OPENING OUTPUT PC TABLE'
         GO TO 990
         END IF
      OUBUFF(43) = PCBUFF(43)
      OUBUFF(44) = PCBUFF(44)
C                                       scan list
      CALL FNDEXT ('NX', CATBLK, NXVER)
      IF (NXVER.LE.0) THEN
         NSCAN = 0
         MSGTXT = 'NO INDEX TABLE SO NO SCAN BREAKS'
         CALL MSGWRT (6)
      ELSE
         ISUB = 0
         CALL GETNX (NXLUN, DISKIN, CNOIN, CATBLK, ISUB, BUFFER,
     *      NSCAN, STIMES)
         IF (NSCAN.LE.0) THEN
            MSGTXT = 'INDEX TABLE TROUBLES, SO NO SCAN BREAKS'
            CALL MSGWRT (6)
            END IF
         END IF
C                                       prepare for averaging
      MSGTXT = 'Scaling input table'
      CALL MSGWRT (2)
      NUMPC = PCBUFF(5)
      LANT = 0
      LSOUR = 0
      LTIME = -1000.
      NT0 = 1
      NT1 = NTIME
      NP = NPOL * NIF
      DO 100 IROW = 1,NUMPC
         PCROW = IROW
         CALL TABPC ('READ', PCBUFF, PCROW, PCKOLS, PCNUMV, PCNPOL,
     *      TIME, TIMINT, SOUNUM, ANTNUM, ISUB, FREQID, CABCAL,
     *      STATE, PCFREQ, PCREAL, PCIMAG, PCRATE, IRET)
         IF (IRET.GT.0) THEN
            WRITE (MSGTXT,1000) IRET, 'READING PC TABLE'
            GO TO 990
            END IF
         IF (IRET.LT.0) GO TO 100
C                                       find TY time
         IF (TIME.GT.LTIME) THEN
            NT0 = MAX (1, NT0-2)
            LTIME = TIME + DETIME
            DO 20 IT = NT0,NTIME
               IF (TYDAT(1,IT).GT.TIME) THEN
                  NT0 = MAX (1, IT-1)
                  NT1 = IT
                  GO TO 25
                  END IF
 20            CONTINUE
            NT0 = NTIME
            NT1 = NTIME
            END IF
 25      W0 = 1.0
         IF (NT1.GT.NT0) W0 = (TYDAT(1,NT1) - TIME) /
     *      (TYDAT(1,NT1) - TYDAT(1,NT0))
         W1 = 1 - W0
         IF (ABS(SOUNUM-TYDAT(2,NT0)).GT.0.5) THEN
            W0 = 0.0
            W1 = 1.0
         ELSE IF (ABS(SOUNUM-TYDAT(2,NT1)).GT.0.5) THEN
            W0 = 1.0
            W1 = 0.0
            END IF
          IP = 3 + (ANTNUM -1) * NP
          DO 50 LIF = 1,NIF
             IF (TYDAT(IP,NT0).LE.0.0) THEN
                IF (TYDAT(IP,NT1).LE.0.0) THEN
                   TSYS(1) = FBLANK
                ELSE
                   TSYS(1) = TYDAT(IP,NT1)
                   END IF
             ELSE IF (TYDAT(IP,NT1).LE.0.0) THEN
                TSYS(1) = TYDAT(IP,NT0)
             ELSE
                TSYS(1) = W0*TYDAT(IP,NT0) + W1*TYDAT(IP,NT1)
                END IF
             IF (TYDAT(IP+1,NT0).LE.0.0) THEN
                IF (TYDAT(IP+1,NT1).LE.0.0) THEN
                   TSYS(2) = FBLANK
                ELSE
                   TSYS(2) = TYDAT(IP+1,NT1)
                   END IF
             ELSE IF (TYDAT(IP+1,NT1).LE.0.0) THEN
                TSYS(2) = TYDAT(IP+1,NT0)
             ELSE
                TSYS(2) = W0*TYDAT(IP+1,NT0) + W1*TYDAT(IP+1,NT1)
                END IF
             IP = IP + NPOL
             DO 40 LP = 1,NPOL
                DO 30 LCH = 1,NUMTON
                   IF (TSYS(LP).NE.FBLANK) THEN
                      IF (OPTYPE.EQ.'MULT') THEN
                         PCREAL(LP,LCH,LIF) = PCREAL(LP,LCH,LIF) *
     *                      TSYS(LP)
                         PCIMAG(LP,LCH,LIF) = PCIMAG(LP,LCH,LIF) *
     *                      TSYS(LP)
                      ELSE
                         PCREAL(LP,LCH,LIF) = PCREAL(LP,LCH,LIF) /
     *                      TSYS(LP)
                         PCIMAG(LP,LCH,LIF) = PCIMAG(LP,LCH,LIF) /
     *                      TSYS(LP)
                         END IF
                   ELSE
                      PCREAL(LP,LCH,LIF) = FBLANK
                      PCIMAG(LP,LCH,LIF) = FBLANK
                      END IF
 30                CONTINUE
 40             CONTINUE
 50          CONTINUE
         CALL TABPC ('WRIT', OUBUFF, OUTROW, PCKOLS, PCNUMV, PCNPOL,
     *      TIME, TIMINT, SOUNUM, ANTNUM, ISUB, FREQID, CABCAL,
     *      STATE, PCFREQ, PCREAL, PCIMAG, PCRATE, IRET)
         IF (IRET.GT.0) THEN
            WRITE (MSGTXT,1000) IRET, 'WRITING OUTPUT PC TABLE'
            GO TO 990
            END IF
 100     CONTINUE
C                                       done - close up files
      CALL TABPC ('CLOS', PCBUFF, PCROW, PCKOLS, PCNUMV, PCNPOL, TIME,
     *   TIMINT, SOUNUM, ANTNUM, ISUB, FREQID, CABCAL,STATE, PCFREQ,
     *   PCREAL, PCIMAG, PCRATE, IRET)
      CALL TABPC ('CLOS', OUBUFF, OUTROW, PCKOLS, PCNUMV, PCNPOL, TIME,
     *   TIMINT, SOUNUM, ANTNUM, ISUB, FREQID, CABCAL,STATE, PCFREQ,
     *   PCREAL, PCIMAG, PCRATE, IRET)
      GO TO 999
C
 990  CALL MSGWRT (8)
C
 999  RETURN
C-----------------------------------------------------------------------
 1000 FORMAT ('PCDIPC: ERROR',I5,' ON ',A)
      END
      SUBROUTINE PCDIHI
C-----------------------------------------------------------------------
C   PCDIHI adds to the history file of the input UV data set.
C-----------------------------------------------------------------------
C
      CHARACTER HILINE*72, CTIME(2)*12
      INTEGER   HLUNI, IERR, ITIME(3), DATE(3)
      INCLUDE 'PCDIV.INC'
      INCLUDE 'PCDATA.INC'
      INCLUDE 'INCS:DHIS.INC'
      DATA HLUNI /28/
C-----------------------------------------------------------------------
      CALL HIINIT (3)
      CALL HIOPEN (HLUNI, DISKIN, CNOIN, BUFFER, IERR)
      IF (IERR.NE.0) GO TO 999
C                                       Task message
      CALL ZDATE (DATE)
      CALL ZTIME (ITIME)
      CALL TIMDAT (ITIME, DATE, CTIME(2), CTIME)
      WRITE (HILINE,1000) TSKNAM, RLSNAM, CTIME
      CALL HIADD (HLUNI, HILINE, BUFFER, IERR)
      IF (IERR.NE.0) GO TO 100
C                                       TY/SY version
      WRITE (HILINE,1010) TSKNAM, INEXT
      CALL HIADD (HLUNI, HILINE, BUFFER, IERR)
      IF (IERR.NE.0) GO TO 100
      WRITE (HILINE,1011) TSKNAM, ITYVER
      CALL HIADD (HLUNI, HILINE, BUFFER, IERR)
      IF (IERR.NE.0) GO TO 100
C                                       equal time range
      DETIME = DETIME * 24.0 * 3600.0
      WRITE (HILINE,1012) TSKNAM, DETIME
      CALL HIADD (HLUNI, HILINE, BUFFER, IERR)
      IF (IERR.NE.0) GO TO 100
C                                       input version
      WRITE (HILINE,1013) TSKNAM, INVER
      CALL HIADD (HLUNI, HILINE, BUFFER, IERR)
      IF (IERR.NE.0) GO TO 100
C                                       output version
      WRITE (HILINE,1014) TSKNAM, OUTVER
      CALL HIADD (HLUNI, HILINE, BUFFER, IERR)
      IF (IERR.NE.0) GO TO 100
      MSGTXT = HILINE(7:)
      CALL MSGWRT (2)
C                                       records written
      WRITE (HILINE,1020) TSKNAM, OUTROW-1
      CALL HIADD (HLUNI, HILINE, BUFFER, IERR)
      IF (IERR.NE.0) GO TO 100
      MSGTXT = HILINE(7:)
      CALL MSGWRT (2)
C                                       Close HI file
 100  CALL HICLOS (HLUNI, .TRUE., BUFFER, IERR)
C
 999  RETURN
C-----------------------------------------------------------------------
 1000 FORMAT (A6,'RELEASE =''',A7,' ''  /********* Start ',
     *   A9,2X,A8)
 1010 FORMAT (A6,'INEXT = ''',A,'''  Tsys or Psum divides PC amp')
 1011 FORMAT (A6,'TYVER=',I5,'  / TY or SY table version used')
 1012 FORMAT (A6,'DETIME=',F6.2,'  / interval of equal times in sec.')
 1013 FORMAT (A6,'INVERS=',I4,'  / PC table input version')
 1014 FORMAT (A6,'OUTVERS=',I5,'  / output PC table version')
 1020 FORMAT (A6,'/  wrote',I8,' records in the output PC table')
      END
