      SUBROUTINE POSEL (DISKI, CNOI, DISKO, CNOO, VER, CATIN, CATOUT,
     *   LUNI, LUNO, ISOU, BUFFER, OBUFF, IRET)
C-----------------------------------------------------------------------
C! Copies one or all sources in a PO table
C# EXT-appl Calibration
C-----------------------------------------------------------------------
C;  Copyright (C) 2019
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   copies one or all sources in a PO table
C   Inputs:
C      DISKI    I        Input volume number
C      CNOI     I        Input catalog number
C      DISKO    I        Output volume number
C      CNOO     I        Output catalog number
C      VER      I        Version to check/modify
C      CATIN    I(256)   Input catalog header
C      CATOUT   I(256)   Output catalog header
C      LUNI     I        LUN to use
C      LUNO     I        LUN to use
C      ISOU     I        0 -> copy all, else copy only ISOU and set to 1
C   Input/Output:
C      BUFFER   I(*)     Work buffer
C      OBUFF    I(*)     Work buffer
C   Output:
C      IRET     I        Error, 0 => OK
C-----------------------------------------------------------------------
      INTEGER   DISKI, CNOI, DISKO, CNOO, VER, CATIN(256), CATOUT(256),
     *   LUNI, LUNO, ISOU, BUFFER(*), OBUFF(*), IRET
C
      INCLUDE 'INCS:DPOV.INC'
      INTEGER   IPORNO, POKOLS(MAXPOC), PONUMV(MAXPOC), TABVER, OVER, I,
     *   NROWS, OPORNO, SOUID
      DOUBLE PRECISION TIME, DRA, DDEC, DDIST
      CHARACTER OBSDAT*8
      INCLUDE 'INCS:DMSG.INC'
C-----------------------------------------------------------------------
      CALL POINI ('READ', BUFFER, DISKI, CNOI, VER, CATIN, LUNI,
     *   IPORNO, POKOLS, PONUMV, OBSDAT, TABVER, IRET)
      IF (IRET.NE.0) THEN
         WRITE (MSGTXT,1000) IRET, 'OPENING INPUT PO TABLE'
         GO TO 980
         END IF
      NROWS = BUFFER(5)
C                                       does the 1 source exist?
C                                       avoid making an empty PO file
      IF (ISOU.GT.0) THEN
         DO 20 I = 1,NROWS
            IPORNO = I
            CALL TABPO ('READ', BUFFER, IPORNO, POKOLS, PONUMV, TIME,
     *         SOUID, DRA, DDEC, DDIST, IRET)
            IF (IRET.NE.0) THEN
               IF (IRET.LT.0) GO TO 20
               WRITE (MSGTXT,1000) IRET, 'READING INPUT PO TABLE'
               GO TO 980
               END IF
            IF (SOUID.EQ.ISOU) GO TO 50
 20         CONTINUE
         GO TO 910
         END IF
C                                       open new table
 50   OVER = VER
      CALL POINI ('WRIT', OBUFF, DISKO, CNOO, OVER, CATOUT, LUNO,
     *   OPORNO, POKOLS, PONUMV, OBSDAT, TABVER, IRET)
      IF (IRET.NE.0) THEN
         WRITE (MSGTXT,1000) IRET, 'OPENING OUTPUT PO TABLE'
         GO TO 980
         END IF
      DO 100 I = 1,NROWS
         IPORNO = I
         CALL TABPO ('READ', BUFFER, IPORNO, POKOLS, PONUMV, TIME,
     *      SOUID, DRA, DDEC, DDIST, IRET)
         IF (IRET.NE.0) THEN
            IF (IRET.LT.0) GO TO 100
            WRITE (MSGTXT,1000) IRET, 'READING INPUT PO TABLE'
            GO TO 980
            END IF
         IF (ISOU.GT.0) THEN
            IF (SOUID.NE.ISOU) GO TO 100
            SOUID = 1
            END IF
         CALL TABPO ('WRIT', OBUFF, OPORNO, POKOLS, PONUMV, TIME,
     *      SOUID, DRA, DDEC, DDIST, IRET)
         IF (IRET.NE.0) THEN
            WRITE (MSGTXT,1000) IRET, 'WRITING OUTPUT PO TABLE'
            GO TO 980
            END IF
 100     CONTINUE
      CALL TABPO ('CLOS', OBUFF, OPORNO, POKOLS, PONUMV, TIME, SOUID,
     *   DRA, DDEC, DDIST, I)
      IF ((MSGSUP.LT.31990) .OR. (MSGSUP.GE.32000)) THEN
         WRITE (MSGTXT,1100) DISKI, CNOI, VER, DISKO, CNOO, OVER
         CALL MSGWRT (3)
         END IF
 910  CALL TABPO ('CLOS', BUFFER, IPORNO, POKOLS, PONUMV, TIME, SOUID,
     *   DRA, DDEC, DDIST, I)
      GO TO 999
C
 980  CALL MSGWRT (8)
C
 999  RETURN
C-----------------------------------------------------------------------
 1000 FORMAT ('POSEL ERROR',I4,' ON ',A)
 1100 FORMAT ('Copied PO file from vol/cno/vers',I3,I5,I4,' to',
     *   I3,I5,I4)
      END
