@PROCESS VECTOR DIR('@DIR')
      SUBROUTINE QMULCL (COMP, FLDECS, ABEAM, BBEAM, NCOMP)
C-----------------------------------------------------------------------
C! Pseudo AP routine: High level Clark CLEAN routine
C# AP-appl
C-----------------------------------------------------------------------
C;  Copyright (C) 1995
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-----------------------------------------------------------------------
C   Pseudo-AP version
C   Calls B. Clark's QCLNSU routine multiple times to
C   accumulate a number of CLEAN components in one AP call.
C   Inputs:
C      COMP  I   Base address of component vector 4 words per comp.:
C                1 = component intensity.
C                2 = x location (cells)
C                3 = y location (cells)
C                4 = field number
C                NOTE: this vector is the output of this routine.
C      FLDESC I  Field descriptor vector base address.
C                0 = Number of fields (REAL value)
C                 for each field:
C                0 = Start address of residuals (REAL value) (AMAP)
C                   (X,Y,intensity)
C                1 = Number of points in the map. (REAL value) (LMAP)
C                2 = Current max. flux density (loc = FCOMP)
C                3 = X position of current max.
C                4 = Y position of current max.
C                5 = CLEAN gain
C      ABEAM  I  Base address of the square (folded) beam patch.
C                The Y direction is most rapid variable:-BY<Y<BY,
C                X varies less rapidly, -1<X<BX
C      BBEAM  I  Beam description vector (BX,BY).
C                In the current QCLNSU BX must equal BY.
C      NCOMP  I  Number of components to CLEAN.
C-----------------------------------------------------------------------
      INTEGER   COMP, FLDECS, AMAP, LMAP, ABEAM, BBEAM, NCOMP, CCOMP,
     *   NFIELD, JNCOMP, JFDV, ILOOP, JAMAP, JNDEX, LOOP, JLMAP, JCOMP,
     *   I, IFIELD, JFDVT, JLOOP, JFIELD, IFIX, SAVLOC, IMAX
      REAL      AXMAX, XMAX, XLOC, X, Y, ARG
      INCLUDE 'INCS:DAPC.INC'
C-----------------------------------------------------------------------
C                                       Addresses to 1-rel etc.
      JFDV = FLDECS + 1
      JCOMP = COMP + 1
      NFIELD = APCORE(JFDV) + 0.3
C                                       Find maxima in fields
      DO 300 ILOOP = 1,NFIELD
C                                        Find largest mag. residual
         JNDEX = JFDV + (ILOOP-1) * 6 + 1
         JAMAP = APCORE(JNDEX) + 3.3
         JLMAP = APCORE(JNDEX+1) + 0.3
         JFDVT = JNDEX + 2
C                                        Loop thru residuals
         IF (JLMAP.LE.0) GO TO 210
C                                        Use ESSL routine to find
C                                        ABS maximum.
         IMAX = ISAMAX(JLMAP,APCORE(JAMAP),3)
         SAVLOC = JAMAP + (IMAX - 1) * 3
 210     CONTINUE
C                                        Save location
         APCORE(JFDVT) = APCORE(SAVLOC)
         APCORE(JFDVT+1) = APCORE(SAVLOC-2)
         APCORE(JFDVT+2) = APCORE(SAVLOC-1)
 300     CONTINUE
C                                       Loop
      DO 600 JLOOP = 1,NCOMP
C                                       Find field with max.
         JFDVT = JFDV + 3
C                                       Use ESSL routine to find
C                                       ABS maximum.
         IFIELD = ISAMAX(NFIELD,APCORE(JFDVT),6)
         JFIELD = JFDVT + (IFIELD - 1) * 6
C                                       Copy result to output vector
         APCORE(JCOMP) = APCORE(JFIELD)
         APCORE(JCOMP+1) = APCORE(JFIELD+1)
         APCORE(JCOMP+2) = APCORE(JFIELD+2)
         APCORE(JCOMP+3) = IFIELD
C                                       Get AMAP, LMAP for QCLNSU
C                                       (positions in FDV)
         AMAP = APCORE(JFIELD-2) + 0.3
         LMAP = APCORE(JFIELD-1) + 0.3
         CCOMP = JFIELD - 1
C                                       Subtract / find max.
         CALL QCLNSU (CCOMP, AMAP, LMAP, ABEAM, BBEAM)
C                                       Update JCOMP
         JCOMP = JCOMP + 4
 600     CONTINUE
C
 999  RETURN
      END
