      SUBROUTINE READPL (TTYPE, IVOL, CNO, IVER, CATBLK, FDVEC, INBLK,
     *   TBIND, TAPBUF, IRET)
C-----------------------------------------------------------------------
C! Reads a FITS plot/slice file pretending to be a FITS binary table
C# EXT-util FITS
C-----------------------------------------------------------------------
C;  Copyright (C) 2024-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   Reads FITS pseudo-table = aips PL file, creates and fills the file
C   Inputs
C      TTYPE    C*2      File type PL, SL
C      IVOL     I        Output file disk
C      CNO      I        Output file catalog number
C      IVER     I        Output PL version
C      INBLK    I        Number of 2880-byte records to read
C   In/out
C      CATBLK   I(256)   header
C      FDVEC    I(*)     I/O control array
C      TBIND    I        I/O pointer
C      TAPBUF   I(*)     I/O buffer
C   Output
C      IRET     I        Error code
C-----------------------------------------------------------------------
      CHARACTER TTYPE*2
      INTEGER   IVOL, CNO, IVER, CATBLK(256), FDVEC(*), INBLK, TBIND,
     *   TAPBUF(*), IRET
C
      INTEGER   LUN, FIND, IBUFF(256), IPOS, IC, IREC, FBUFF(720),
     *   ISIZE, I, FPOS, LUNTMP
      CHARACTER PHNAME*48
      INCLUDE 'INCS:DMSG.INC'
C-----------------------------------------------------------------------
      FIND = 0
C                                       PL in header
      CALL MADDEX (TTYPE, IVOL, CNO, CATBLK, IBUFF, .TRUE., 'UPDT',
     *   IVER, IRET)
      IF (IRET.NE.0) THEN
         WRITE (MSGTXT,1000) IRET, 'ADDING PL FILE TO HEADER'
         GO TO 980
         END IF
      WRITE (MSGTXT,1010) TTYPE, IVER
      CALL MSGWRT (3)
C                                       create file
      ISIZE = (INBLK * 720) / 256
      CALL ZPHFIL (TTYPE, IVOL, CNO, IVER, PHNAME, IRET)
      CALL ZCREAT (IVOL, PHNAME, ISIZE, .FALSE., I, IRET)
      IF (IRET.NE.0) THEN
         WRITE (MSGTXT,1000) IRET, 'CREATING ' // TTYPE // ' FILE'
         GO TO 970
         END IF
C                                       open
      LUN = LUNTMP (1)
      CALL ZOPEN (LUN, FIND, IVOL, PHNAME, .FALSE., .TRUE., .TRUE.,
     *   IRET)
      IF (IRET.NE.0) THEN
         WRITE (MSGTXT,1000) IRET, 'OPENING ' // TTYPE //
     *      'FILE TO WRITE'
         GO TO 960
      END IF
C                                       write the file
      IREC = 0
      IPOS = 1
      DO 100 I = 1,INBLK
         CALL TAPIO ('READ', FDVEC, TAPBUF, TBIND, IRET)
         IF (IRET.NE.0) THEN
            WRITE (MSGTXT,1000) IRET, 'READING FITS FILE FOR ' // TTYPE
     *         // ' FILE'
            GO TO 960
            END IF
         CALL ZI32IL (720, 1, TAPBUF(TBIND), FBUFF)
         FPOS = 1
 20      IC = 257 - IPOS
         IF (IC+FPOS.LT.721) THEN
            CALL COPY (IC, FBUFF(FPOS), IBUFF(IPOS))
            IPOS = IPOS + IC
            FPOS = FPOS + IC
         ELSE
            IC = 721 - FPOS
            CALL COPY (IC, FBUFF(FPOS), IBUFF(IPOS))
            IPOS = IPOS + IC
            FPOS = FPOS + IC
            END IF
         IF (IPOS.GT.256) THEN
            IREC = IREC + 1
            CALL ZFIO ('WRIT', LUN, FIND, IREC, IBUFF, IRET)
            IF (IRET.NE.0) THEN
               WRITE (MSGTXT,1000) IRET, 'WRITING ' // TTYPE // ' FILE'
               GO TO 960
               END IF
            IPOS = 1
            END IF
         IF (FPOS.LT.721) GO TO 20
 100     CONTINUE
C                                       close
      IF ((IPOS.GT.1) .AND. (IREC.LT.ISIZE)) THEN
         IREC = IREC + 1
         CALL ZFIO ('WRIT', LUN, FIND, IREC, IBUFF, IRET)
         IF (IRET.NE.0) THEN
            WRITE (MSGTXT,1000) IRET, 'WRITING ' // TTYPE //
     *         ' FILE LAST RECORD'
            GO TO 960
            END IF
         END IF
      CALL ZCLOSE (LUN, FIND, IC)
      GO TO 999
C
 960  CALL MSGWRT (8)
      CALL ZDESTR (IVOL, PHNAME, IC)
      IF (IC.NE.0) THEN
         WRITE (MSGTXT,1000) IC, 'FAILED TO DELETE BAD ' // TTYPE //
     *      ' FILE'
         CALL MSGWRT (8)
         END IF
      GO TO 975
C
 970  CALL MSGWRT (8)
 975  CALL DELEXT ('PL', IVOL, CNO, 'WRWR', CATBLK, FBUFF, IVER, IC)
      IF (IC.NE.0) THEN
         WRITE (MSGTXT,1000) IC, 'FAILED TO DELETE BAD ' // TTYPE //
     *      ' FROM HEADER'
         CALL MSGWRT (8)
         END IF
      IF (FIND.GT.0) CALL ZCLOSE (LUN, FIND, IC)
      GO TO 999
C
 980  CALL MSGWRT (8)
C
 999  RETURN
C-----------------------------------------------------------------------
 1000 FORMAT ('READPL ERROR',I5,' ON ',A)
 1010 FORMAT ('Reading ',A,' file version',I5)
      END
