C @(#)extrem.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.IDENTIFICATION
C  subroutine EXTREM         version 1         820521
C  A. Kruszewski             ESO Garching
C.KEYWORDS
C  extrema
C.PURPOSE
C  selects two maxima and a minimum between them in an array "SCNX"
C.INPUT/OUTPUT
C  input arguments
C  SCNX        real*4 array      array to be analysed for extrema
C  M           integer*4         number of elements in array "SCNX"
C                                is equal to "2*M+1"
C  IDLM        integer*4 array   minimal distance between components
C  output arguments
C  EXTR        real*4 array      values of array "SCNX" in extremal
C                                points
C  LCTN        integer*4 array   locations of extremal points
C-----------------------------------------------------------------------
      SUBROUTINE EXTREM(SCNX, M, IDLM, EXTR, LCTN)
C
      IMPLICIT NONE
      INTEGER  M
      REAL     SCNX((-M):M)
      INTEGER  IDLM
      REAL     EXTR(3)
      INTEGER  LCTN(3)
C
      INTEGER  IVAR , IVAR1
      INTEGER  K, K1, K2, K3, L, MM
      REAL     VAR , VAR1
      REAL     DFMM, DIFF
      LOGICAL   DOWN
C
      VAR = SCNX(0)
      IVAR = 0
      EXTR(2) = 0.0
      EXTR(3) = 0.0
      LCTN(2) = 0
      LCTN(3) = 0
C
C ******      Searches for highest maximum.
C
      MM = -M
      DO 10 K = MM , M
          IF ( SCNX(K) .GT. VAR ) THEN
            VAR = SCNX(K)
            IVAR = K
          ENDIF
  10      CONTINUE
C
C ******      Store value of the highest maximum
C ******      as EXTR(1) and its position as LCTN(1).
C
      EXTR(1) = VAR
      LCTN(1) = IVAR
C
C ******      Search an array SCNX for another maximum
C ******      in interval from -M to LCTN(1)-IDLM.
C
      DOWN = .FALSE.
      DFMM = 0.0
      K1 = -M + 1
      K2 = LCTN(1) - IDLM + 1
      DO 11 K = K1 , K2
          IF ( SCNX(K) .LT. SCNX(K-1) ) THEN
            IF ( .NOT. DOWN ) THEN
                DOWN = .TRUE.
                VAR1 = SCNX(K-1)
                K3 = K2 + IDLM - 2
                DO 12 L = K , K2
                  IF ( SCNX(L) .LT. VAR1 ) THEN
                      VAR1 = SCNX(L)
                      IVAR1 = L
                  ENDIF
   12                CONTINUE
                  DIFF = SCNX(K-1) - VAR1
                IF ( DIFF .GT. DFMM ) THEN
                  EXTR(2) = SCNX(K-1)
                  EXTR(3) = VAR1
                  LCTN(2) = K-1
                  LCTN(3) = IVAR1
                  DFMM = DIFF
                ENDIF
            ENDIF
          ELSE
            DOWN = .FALSE.
          ENDIF
   11      CONTINUE 
C
C ******      Search array SCNX for another maximum
C ******      in interval from LCTN(1)+IDLM to M.
C
      DOWN = .FALSE.
      K1 = M - 1
      K2 = LCTN(1) + IDLM - 1
      DO 13 K = K1 , K2 , -1
          IF ( SCNX(K) .LT. SCNX(K+1) ) THEN
            IF ( .NOT. DOWN ) THEN
                DOWN = .TRUE.
                VAR1 = SCNX(K+1)
                K3 = K2 - IDLM + 2
                DO 14 L = K3 , K
                  IF( SCNX(L) .LT. VAR1 ) THEN
                      VAR1 = SCNX(L)
                      IVAR1 = L
                  ENDIF
   14                CONTINUE 
                  DIFF = SCNX(K+1) - VAR1
                IF ( DIFF .GT. DFMM ) THEN
                  EXTR(2) = SCNX(K+1)
                  EXTR(3) = VAR1
                  LCTN(2) = K + 1
                  LCTN(3) = IVAR1
                  DFMM = DIFF
                ENDIF
            ENDIF
          ELSE
            DOWN = .FALSE.
          ENDIF
   13      CONTINUE
C
      RETURN
C
      END