      SUBROUTINE ICBPLT (IBUFF, CBCORN, IGR, DOZERO, IERR)
C-----------------------------------------------------------------------
C! draws Clean beam on TV
C# TV-appl
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   ICBPLT draws the half power beam on a TV graphics plane
C   Inputs:
C      IBUFF    I(*)   The output buffer used in writing to the TV:
C                      size >= max x dimension
C      CBCORN   I      Corner of image: 1 lower left, 2 lower right,
C                      3 upper right, 4 upper left
C      IGR      I      Use graphics plane IGR
C      DOZERO   I      1 => zero full graphics plane (UNIQUE true)
C                      -1 => zero only needed piece of graphics plane
C                      0 => do NOT zero the graphics plane
C   Output:
C      IBUFF    I(*)   the updated TV output buffer.
C      IERR     I      error indicator: 0 no error; 10 = Image too small
C   Common:
C      /MAPHDR/ CATBLK   I(256)   the image catalog header.
C      Also assumes that LABINI has been called (e.g. by IAXIS1)
C-----------------------------------------------------------------------
      INTEGER   IBUFF(*), CBCORN, IGR, DOZERO, IERR
C
      INTEGER   I, IG1, IXCORN, IYCORN, IXTCRN, IYTCRN, IXBLC, IYBLC, J,
     *   IXTRC, IYTRC, BBLC(2), BTRC(2), IX(361), IY(361), ITG1, JERR
      REAL      BLC(2), TRC(2), BMAJ, BMIN, BEAMPA, XC, YC, XBC, YBC,
     *   CP, SP, CPA, SPA, PHI, X, Y, XINC, YINC
      DOUBLE PRECISION RAC, DECC, RA, DEC, DRA
      INCLUDE 'INCS:DMSG.INC'
      INCLUDE 'INCS:DTVC.INC'
      INCLUDE 'INCS:DHDR.INC'
      INCLUDE 'INCS:DLOC.INC'
      INCLUDE 'INCS:DCAT.INC'
      INCLUDE 'INCS:PSTD.INC'
C-----------------------------------------------------------------------
      CALL CHECKL ('ICBPLT')
      IF ((CORTYP(LOCNUM).LT.1) .OR. (CORTYP(LOCNUM).GT.2)) THEN
         IERR = -1
         MSGTXT = 'IMAGE NOT 2 CELESTIAL COORDINATES'
         GO TO 990
         END IF
      BMAJ = ABS (CATR(KRBMJ)) / 2.0
      BMIN = ABS (CATR(KRBMN)) / 2.0
      BEAMPA = CATR(KRBPA) * DG2RAD
C                                       Check that the beam is defined
      IF ((BMAJ.LT.1.E-9) .OR. (BMIN.LT.1.E-9)) THEN
         MSGTXT = 'NO CLEAN BEAM IN HEADER'
         IERR = -1
         GO TO 990
         END IF
C                                       Initial values.
      IG1 = IGR
      IF ((IG1.LE.0) .OR. (IG1.GT.NGRAPH-1)) IG1 = MIN (2, NGRAPH-1)
      ITG1 = IG1 + NGRAY
      IXCORN = CATBLK(IICOR)
      IYCORN = CATBLK(IICOR+1)
      IXTCRN = CATBLK(IICOR+2)
      IYTCRN = CATBLK(IICOR+3)
      IXBLC = CATBLK(IIWIN)
      IYBLC = CATBLK(IIWIN+1)
      IXTRC = CATBLK(IIWIN+2)
      IYTRC = CATBLK(IIWIN+3)
      IF ((IXTCRN-IXCORN.LE.2) .OR. (IYTCRN-IYCORN.LE.2) .OR.
     *   (IYTRC-IYBLC.LE.2) .OR. (IXTRC-IXBLC.LE.2)) THEN
         IERR = 10
         MSGTXT = 'IMAGE TOO SMALL TO PLOT BEAM'
         GO TO 990
         END IF
      XINC = REAL(IXTRC-IXBLC) / REAL(IXTCRN-IXCORN)
      YINC = REAL(IYTRC-IYBLC) / REAL(IYTCRN-IYCORN)
      ITG1 = NGRAY + IG1
      CALL YSLECT ('ONNN', ITG1, 0, IBUFF, IERR)
      IF (IERR.NE.0) GO TO 980
C                                       determine area of beam
      BLC(1) = IXBLC
      BLC(2) = IYBLC
      TRC(1) = IXTRC
      TRC(2) = IYTRC
      CALL PLTBSZ (CBCORN, BLC, TRC, CATR, BBLC, BTRC)
      J = MOD (CBCORN, 5)
      I = (BTRC(1) - BBLC(1) + 1) / 2
      IF ((J.EQ.2) .OR. (J.EQ.3)) I = -I
      BBLC(1) = BBLC(1) + I
      BTRC(1) = BTRC(1) + I
      I = (BTRC(2) - BBLC(2) + 1) / 2
      IF ((J.EQ.3) .OR. (J.EQ.4)) I = -I
      BBLC(2) = BBLC(2) + I
      BTRC(2) = BTRC(2) + I
      IX(1) = (BBLC(1) - IXBLC) / XINC + IXCORN + 0.5
      IX(2) = (BTRC(1) - IXBLC) / XINC + IXCORN + 0.5
      IX(3) = IX(2)
      IX(4) = IX(1)
      IX(5) = IX(1)
      IY(1) = (BBLC(2) - IYBLC) / YINC + IYCORN + 0.5
      IY(2) = IY(1)
      IY(3) = (BTRC(2) - IYBLC) / YINC + IYCORN + 0.5
      IY(4) = IY(3)
      IY(5) = IY(1)
C                                       zeroing
      IF (DOZERO.GT.0) THEN
         CALL YZERO (ITG1, IERR)
C                                       Clear part of sceen.
      ELSE IF (DOZERO.LT.0) THEN
         CALL YFILL (ITG1, IX(1), IY(1), IX(3), IY(3), 0, IBUFF,
     *      IERR)
         END IF
      IF (IERR.NE.0) THEN
         WRITE (MSGTXT,1000) IERR, 'ZEROING GRAPHICS PLANE'
         GO TO 990
         END IF
C                                       draw boundary
      CALL IMVECT ('ONNN', ITG1, 5, IX, IY, IBUFF, IERR)
      IF (IERR.NE.0) THEN
         WRITE (MSGTXT,1000) IERR, 'IMVECT THE BOUNDARY'
         GO TO 990
         END IF
C                                       find coordinate info
      XC = (BLC(1) + TRC(1)) / 2.0
      YC = (BLC(2) + TRC(2)) / 2.0
      IF (CORTYP(LOCNUM).EQ.1) THEN
         CALL XYVAL (XC, YC, RAC, DECC, DRA, JERR)
      ELSE
         CALL XYVAL (XC, YC, DECC, RAC, DRA, JERR)
         END IF
      IF (JERR.NE.0) GO TO 980
      XBC = (BBLC(1) + BTRC(1)) / 2.0
      YBC = (BBLC(2) + BTRC(2)) / 2.0
C                                       Compute the extrema of X and Y
      CPA = COS (BEAMPA)
      SPA = SIN (BEAMPA)
      DRA = COS (DECC * DG2RAD)
      IF (DRA.EQ.0.0) DRA = 1.0
      DO 10 I = 0,360
         PHI = I * DG2RAD
         CP = BMIN * COS(PHI)
         SP = BMAJ * SIN(PHI)
         X  = CP*CPA - SP*SPA
         Y  = CP*SPA + SP*CPA
         RA = RAC - X / DRA
         DEC = DECC + Y
         IF (CORTYP(LOCNUM).EQ.1) THEN
            CALL XYPIX (RA, DEC, X, Y, JERR)
         ELSE
            CALL XYPIX (DEC, RA, X, Y, JERR)
            END IF
         IF (JERR.NE.0) GO TO 980
         X = X - XC + XBC
         Y = Y - YC + YBC
         IX(I+1) = (X - IXBLC) / XINC + IXCORN + 0.5
         IY(I+1) = (Y - IYBLC) / YINC + IYCORN + 0.5
 10      CONTINUE
C                                       draw boundary
      CALL IMVECT ('ONNN', ITG1, 361, IX, IY, IBUFF, IERR)
      IF (IERR.NE.0) THEN
         WRITE (MSGTXT,1000) IERR, 'IMVECT THE BEAM'
         GO TO 990
         END IF
      GO TO 999
C                                       coordinate issue
 980  MSGTXT = 'ERROR DURING COORDINATE COMPUTATION'
      IERR = 1
C
 990  CALL MSGWRT (7)
C
 999  RETURN
C-----------------------------------------------------------------------
 1000 FORMAT ('ICBPLT: ERROR',I4,' ON ',A)
      END
