C @(#)averpr.for	17.1.1.1 (ES0-DMD) 01/25/02 17:15:39
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
C.IDENTIFICATION
C
C  subroutine AVERPR         version 1.2       830914
C  A. Kruszewski             ESO Garching
C
C  modified                  version 1.3       870303
C  A. Kruszewski             Obs. de Geneve
C
C.KEYWORDS
C
C  profiles
C
C.PURPOSE
C
C  using a two-dimensional profile "PRFL" it calculates average
C  one-dimensional profile "AVPR" and a number of significant
C  profile rings "LIM"
C
C.INPUT/OUTPUT
C
C  input arguments
C
C  PRFL        real*4 array      two-dimensional profile
C  IHED        integer*4         radial dimension of profile in pixels
C  TRSH        real*4            limiting treshold for object detection
C  ICNT        integer*4 array   numbers of used pixels at calculating
C                                profile points
C
C  output arguments
C
C  AVPR        real*4 array      one-dimensional profile
C  LIM         integer*4         number of significant profile rings
C
C-----------------------------------------------------------------------
      SUBROUTINE AVERPR(IHED, PRFL, TRSH, ICNT, AVPR,
     &                  IAPR, KCLN, KSAT, LIM)
C
      IMPLICIT   NONE
      INCLUDE   'MID_REL_INCL:INVENT.INC/NOLIST'
C
      INTEGER   IHED
      REAL      PRFL(8,0:IHED)
      REAL      TRSH
      INTEGER   ICNT(8,0:IHED)
      REAL      AVPR(0:MAXSUB)
      INTEGER   IAPR(0:MAXSUB)
      INTEGER   KCLN
      INTEGER   KSAT
      INTEGER   LIM
C
C     INTEGER   IK(8)
      INTEGER   K, K1
      INTEGER   L
      INTEGER   NK
      REAL      TEMP
      REAL      TRSH3
     
C
      LOGICAL   VOID
C
C *** Calculates averaged over octants profile AVPR.
C
      DO 5 K = 0 , MAXSUB
          IAPR(K) = 0
    5 CONTINUE
      AVPR(0) = PRFL(1,0)
      IAPR(0) = ICNT(1,0)
      DO 10 K = 1 , IHED
          NK = 0
          TEMP = 0.0
          DO 20 L = 1 , 8
              IF ( ICNT(L,K) .EQ. -1 ) THEN
                  IAPR(K) = -1
                  AVPR(K) = PRFL(L,K)
                  GOTO 30
              ELSE        
                  TEMP = TEMP + ICNT(L,K) * PRFL(L,K)
                  NK = NK + ICNT(L,K)
              ENDIF
   20     CONTINUE
          IF ( NK .GT. 0 ) THEN
              AVPR(K) = TEMP / NK
              IAPR(K) = NK
          ELSE
              AVPR(K) = 0.0
              IAPR(K) = 0
          ENDIF
   30     CONTINUE
   10 CONTINUE
C
C *** Check how many profile rings are significantly above
C *** the sky background. Two profile rings with average
C *** less than 0.3*TRSH are a condition for terminating
C *** the profile. Skip invalid central points first.
C
      TRSH3 = 0.3 * TRSH
      IF ( IAPR(0) .EQ. 0 ) THEN
          VOID = .TRUE.
      ELSE
          VOID = .FALSE.
      ENDIF
      K = 0
   50 CONTINUE
          K = K + 1
          IF ( VOID ) THEN
              IF ( IAPR(K) .EQ. 0 ) THEN
                  GOTO 50
              ELSE
                  VOID = .FALSE.
              ENDIF
          ENDIF
      IF ( ( K .LT. IHED )
     &     .AND.
     &     ( MAX( AVPR(K-1) , AVPR(K) ) .GT. TRSH3 )
     &     .AND.
     &     ( .NOT. ( ( AVPR(K) .GT. AVPR(K-1) )
     &               .AND.
     &               ( AVPR(K-1) .LT. TRSH3 )
     &               .AND.
     &               (IAPR(K-1) .GT. 0 ) ) )
     &    .AND.
     &    ( AVPR(K+1) .GT. (-TRSH) ) ) GOTO 50
C
C *** Number of significant profile rings is defined as LIM.
C
      IF ( VOID ) THEN
          LIM = 0
      ELSE
          LIM = MIN( IHED , K )
          LIM = MAX( LIM , 4 )
      ENDIF
C
C *** Find extend of saturation KSAT.
C
      L = -1
   60 CONTINUE
          L = L + 1
      IF ( IAPR(L) .EQ. -1 .OR. IAPR(L) .EQ. 0 ) GOTO 60
      KSAT = L - 1
C
C *** Find extend of non-cleaned profile.
C
c      L = KSAT
c   70 CONTINUE
c         L = L + 1
c      IF ( IAPR(L) .GT. 0 .AND. L .LT. LIM ) GOTO 70
c      KCLN = L - 1
c      IF ( KCLN . EQ. KSAT ) THEN
c          KCLN = 0
c      ENDIF
C
C *** Set the remaining values to zero.
C
      IF ( LIM .LT. MAXSUB ) THEN
          K1 = LIM + 1
          DO 80 L = K1 , MAXSUB
              AVPR(L) = 0.0
              IAPR(L) = 0
   80     CONTINUE
      ENDIF
C
      RETURN
C
      END
C