C @(#)cpcntr.for	17.1.1.1 (ES0-DMD) 01/25/02 17:15:40
C===========================================================================
C Copyright (C) 1995 European Southern Observatory (ESO)
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 Massachusetss Ave, Cambridge, 
C MA 02139, USA.
C
C Corresponding concerning ESO-MIDAS should be addressed as follows:
C	Internet e-mail: midas@eso.org
C	Postal address: European Southern Observatory
C			Data Management Division 
C			Karl-Schwarzschild-Strasse 2
C			D 85748 Garching bei Muenchen 
C			GERMANY
C===========================================================================
C
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C.IDENT:  subroutine CPCNTR         version 1.1       830907
C         A. Kruszewski             ESO Garching
C         modified for FX           version 1.2       870303
C         A. Kruszewski             Obs. de Geneve
C.PURPOSE:finds center of a blended component
C.INPUT/OUTPUT
C  input arguments
C
C  A           real*4 array      image frame
C  JAPY        integer*4 array   pointers to image lines
C  IBUF        integer*4 array   limits of image buffer
C  I           integer*4         x-coordinate of a parent object
C  J           integer*4         y-coordinate of a parend object
C  L           integer*4         octant of a component
C  K           integer*4         ring of a component
C  output arguments
C
C  IK          integer*4         x-coordinate of a component
C  JK          integer*4         y-coordinate of a component
C-----------------------------------------------------------------------
      SUBROUTINE CPCNTR(A, JAPY, IBUF, I, J, L, K, IK, JK)
C
      IMPLICIT  NONE
      INCLUDE  'MID_REL_INCL:INVENT.INC/NOLIST'
C
      REAL      A(1)
      INTEGER   JAPY(1)
      INTEGER   IBUF(4)
      INTEGER   I , J , L , K , IK , JK
C
      INTEGER   ICOR
      INTEGER   KK
      INTEGER   II1
      INTEGER   II2
      INTEGER   JJ1
      INTEGER   JJ2
      INTEGER   JJJ
      INTEGER   JOF
      INTEGER   III
      INTEGER   IDIST
      INTEGER   IARG
C
      REAL      TMP1
      REAL      TMP
C
C ****** Find approximate position IK,JK
C
      ICOR = NINT( 0.7071 * FLOAT(K) )
      IF ( L .EQ. 1 ) THEN
            IK = I + K
            JK = J
      ELSE IF ( L .EQ. 2 ) THEN
            IK = I + ICOR
            JK = J + ICOR
      ELSE IF ( L .EQ. 3 ) THEN
            IK = I
            JK = J + K
      ELSE IF ( L .EQ. 4 ) THEN
            IK = I - ICOR
            JK = J + ICOR
      ELSE IF ( L .EQ. 5 ) THEN
            IK = I - K
            JK = J
      ELSE IF ( L .EQ. 6 ) THEN
            IK = I - ICOR
            JK = J - ICOR
      ELSE IF ( L .EQ. 7 ) THEN
            IK = I
            JK = J - K
      ELSE IF ( L .EQ. 8 ) THEN
            IK = I + ICOR
            JK = J - ICOR
      ENDIF
C
C ******      Define square to be searched for highest pixel.
C
      TMP = 0.0
      KK = NINT( 0.4 * FLOAT(K) ) + 1
      II1 = MAX( IBUF(1) , IK - KK )
      II2 = MIN( IBUF(3) , IK + KK )
      JJ1 = MAX( IBUF(2) , JK - KK )
      JJ2 = MIN( IBUF(4) , JK + KK )
C
C ******      Find highest pixel in an arc of radius k crossing
C ******      small square centered on approximate position.
C
      DO 10 JJJ = JJ1 , JJ2
            JOF = JJJ - IBUF(2) + 1
            DO 20 III = II1 , II2
                  IARG = JAPY(JOF) + III
                  TMP1 = A(IARG)
                  IF ( TMP1 .GT. TMP ) THEN
                        IDIST = (I-III)*(I-III)+(J-JJJ)*(J-JJJ)
                        IDIST = NINT( SQRT( FLOAT( IDIST ) ) )
                        IF ( IDIST .EQ. K ) THEN
                              TMP = TMP1
                              IK = III
                              JK = JJJ
                        ENDIF
                  ENDIF
   20            CONTINUE
   10      CONTINUE
C
      RETURN
      END