      SUBROUTINE TABPP (OPCODE, BUFFER, IPPRNO, PPKOLS, PPNUMV, TIME,
     *   SUBA, FREQID, PHASES, ERRORS, IERR)
C-----------------------------------------------------------------------
C! Does I/O to phase differenence (PP) table opened by PPINI
C# EXT-util UV Calibration Spectral
C-----------------------------------------------------------------------
C;  Copyright (C) 2019, 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   Does I/O to phase difference (PP) extention tables. Used after
C   setup by PPINI.
C   Inputs:
C      OPCODE   C*4      Operation code:
C                        'READ' = read entry from table.
C                        'WRIT' = write entry in table.
C                        'CLOS' = close file, flush on write
C      BUFFER   I(512)   I/O buffer and related storage, also defines
C                        file if open. Should have been returned by
C                        PPINI or TABINI.
C      IPPRNO   I        Next entry number to read or write.
C      PPKOLS   I(MAXPPC) The column pointer array in order,
C                        SUBARRAY, FREQID,
C                        data
C      PPNUMV   I(MAXPPC) Element count in each column.
C   Input/output: (written to or read from baseline file)
C      SUBA    I        Subarray number.
C      FREQID  I        Freq. id number
C      PHASES  D(n,m)   Phases: m IFS; n channels; p polns
C      ERRORS  D(n,m)   Phases errors: m IFS; n channels; p polns
C   Output:
C      IPPRNO    I      Next solution number.
C      IERR      I      Error code, 0=>OK else TABIO error.
C-----------------------------------------------------------------------
      INCLUDE 'INCS:PUVD.INC'
      INTEGER   XPPRSZ, MAXPPC
      PARAMETER (XPPRSZ = 3 + MAXCIF)
      PARAMETER (MAXPPC = 5)
C
      CHARACTER OPCODE*4
      REAL      TIME
      INTEGER   BUFFER(*), IPPRNO, PPKOLS(MAXPPC), PPNUMV(MAXPPC),
     *   SUBA, FREQID, IERR
      DOUBLE PRECISION PHASES(*), ERRORS(*)
C
      INTEGER   RECI(XPPRSZ), KOLS(MAXPPC), TIMKOL, SUBKOL, FRQKOL,
     *   PHSKOL, ERRKOL, LOOP, NDATA, INDX, NNDX
      REAL      RECORD(XPPRSZ)
      DOUBLE PRECISION RECD(XPPRSZ/2)
      INCLUDE 'INCS:DMSG.INC'
      INCLUDE 'INCS:DDCH.INC'
      EQUIVALENCE (KOLS(1), TIMKOL),  (KOLS(2), SUBKOL),
     *    (KOLS(3), FRQKOL), (KOLS(4), PHSKOL), (KOLS(5), ERRKOL)
      SAVE RECORD
      EQUIVALENCE (RECD, RECORD, RECI)
C-----------------------------------------------------------------------
C                                       Close
      IF (OPCODE.EQ.'CLOS') THEN
         CALL TABIO ('CLOS', 0, IPPRNO, RECORD, BUFFER, IERR)
         IF (IERR.GT.0) GO TO 980
         GO TO 999
         END IF
C                                       Check sizes
      NNDX = PPNUMV(4)
      IF (NNDX.GT.MAXCIF) THEN
         IERR = 1
         MSGTXT = 'TABPP: RECORDS TOO BIG FOR BUFFERS'
         GO TO 985
         END IF
      IF (NNDX.LE.0) THEN
         IERR = 1
         MSGTXT = 'TABPP: ZERO SIZE DATA REQUESTED'
         GO TO 985
         END IF
C                                       Set pointers
      NDATA = MAXPPC
      CALL COPY (NDATA, PPKOLS, KOLS)
C                                       If write fill RECORD
      IF (OPCODE.NE.'READ') THEN
         RECORD(TIMKOL) = TIME
         RECI(SUBKOL) = SUBA
         IF (FRQKOL.GT.0) RECI(FRQKOL) = FREQID
C
         INDX = PHSKOL - 1
         DO 20 LOOP = 1,NNDX
            INDX = INDX + 1
            IF (PHASES(LOOP).EQ.DBLANK) THEN
               RECORD(INDX) = FBLANK
            ELSE
               RECORD(INDX) = PHASES(LOOP)
               END IF
 20         CONTINUE
         INDX = ERRKOL - 1
         DO 25 LOOP = 1,NNDX
            INDX = INDX + 1
            IF (ERRORS(LOOP).EQ.DBLANK) THEN
               RECORD(INDX) = FBLANK
            ELSE
               RECORD(INDX) = ERRORS(LOOP)
               END IF
 25         CONTINUE
         END IF
C                                       Process record.
      CALL TABIO (OPCODE, 0, IPPRNO, RECORD, BUFFER, IERR)
      IPPRNO = IPPRNO + 1
      IF (IERR.GT.0) GO TO 980
C                                       If READ pick data from RECORD.
      IF (OPCODE.EQ.'READ') THEN
         TIME = RECORD(TIMKOL)
         SUBA   = RECI(SUBKOL)
         IF (FRQKOL.LE.0) THEN
            FREQID = 1
         ELSE
            FREQID = RECI(FRQKOL)
            END IF
C                                       phase shifts
         INDX = PHSKOL - 1
         DO 80 LOOP = 1,NNDX
            INDX = INDX + 1
            IF (RECORD(INDX).EQ.FBLANK) THEN
               PHASES(LOOP) = DBLANK
            ELSE
               PHASES(LOOP) = RECORD(INDX)
               END IF
 80         CONTINUE
C                                       errors - may be missing
         CALL DFILL (NNDX, 0.0D0, ERRORS)
         INDX = ERRKOL - 1
         NNDX = PPNUMV(5)
         DO 85 LOOP = 1,NNDX
            INDX = INDX + 1
            IF (RECORD(INDX).EQ.FBLANK) THEN
               ERRORS(LOOP) = DBLANK
            ELSE
               ERRORS(LOOP) = RECORD(INDX)
               END IF
 85         CONTINUE
         END IF
      GO TO 999
C                                       Error
 980  WRITE (MSGTXT,1980) IERR
C
 985  CALL MSGWRT (8)
C
 999  RETURN
C-----------------------------------------------------------------------
 1980 FORMAT ('TABPP: TABIO ERROR',I3)
      END
