C @(#)serch.for	19.1 (ES0-DMD) 02/25/03 13:30:48
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.COPYRIGHT: Copyright (c) 1987 European Southern Observatory,                  
C                                         all rights reserved                   
C.LANGUAGE:       F77+ESOext                                                    
C.AUTHOR:         P.Stetsan                                                     
C.IDENTIFICATION: SERCH                                                         
C.KEYWORDS:       photometry,astrometry                                         
C.PURPOSE:        Subroutine to search for a star from a marginal distribution. 
C.ALGORITHM;      see Stetson, P.B.,  1979   Astron.  J.,  84  1149             
C.INPUT/OUPUT:    ->  KRX     marginal data REAL*8                              
C                 ->  NX      dimension of KRX                                  
C                 ->  KK      number of points ignored at each end of KRX       
C                             ( greater than or equal to 2)                     
C                 <-  XO      output estimate of the image centre               
C                 <-  SX      output estimate of the image with                 
C                 <-> JX      Low-side local minimum (stepped in by one)        
C                 <-> LX      High-side local minimum (stepped in by one)       
C                 ->  KDRX    work array dimension as KRX, REAL*8               
C                 ->  ICROWD  0  if no other star is detected in the field      
C                             -1  if a brighter star is found on the low side   
C                             +1  if a brighter star is found on the high side  
C.VERSION:    8212??   A.P. Stetson    Creation                                 
C.VERSION:    ??????   H.Waldthausen   VAX-implementation                       
C.VERSION:    871123   Rein H. Warmels ESO-FORTRAN Conversion                   
C -------------------------------------------------------------------           
      SUBROUTINE SERCH(KRX,NX,KK,XO,SX,JX,LX,KDRX,ICROWD)                       
C                                                                               
      IMPLICIT         NONE
      DOUBLE PRECISION KRX(1)
      INTEGER          NX
      INTEGER          KK
      REAL             XO
      REAL             SX
      INTEGER          JX
      INTEGER          LX
      DOUBLE PRECISION KDRX(1)                           
      INTEGER          ICROWD
C
      INTEGER          I, IBEG, IEND
      INTEGER          IMIN, IMAX
      INTEGER          J
      INTEGER          L
      INTEGER          M
      INTEGER          N
C    
      DOUBLE PRECISION KDRMX                           
      DOUBLE PRECISION KDRMN                           
      DOUBLE PRECISION KKS                           
C                                                                               
      ICROWD = 0                                                                
      IBEG   = KK + 1                                                           
      IEND   = NX - KK                                                          
      N      = NX - 2                                                           
      KDRMX  = 0                                                                
      KDRMN  = 0                                                                
C                                                                               
C *** find maximum and minimum derivative of KRX                                
C                                                                               
      DO 10 I = IBEG,IEND                                                       
         KKS    = KRX(I+1) - KRX(I-1)                                           
         KDRX(I) = KRX(I+2) - KRX(I-2) + KKS + KKS                              
         IF (KDRX(I).GE.KDRMX) THEN                                             
            KDRMX  = KDRX(I)                                                    
            IMAX   = I                                                          
         END IF                                                                 
                                                                                
         IF (KDRX(I).LE.KDRMN) THEN                                             
            KDRMN  = KDRX(I)                                                    
            IMIN   = I                                                          
         END IF                                                                 
                                                                                
   10 CONTINUE                                                                  
C                                                                               
C *** crowded ?                                                                 
C     bright source to left, compute right a new minima = KDRMN                 
                                                                                
      IF (IMIN.LE.IMAX) THEN                                                    
         IF ((NX-IMAX).GE. (IMIN-1)) THEN                                       
            ICROWD = -1                                                         
            KDRMN  = KDRMX                                                      
            J      = IMAX + 1                                                   
            DO 20 I = J,IEND                                                    
                IF (KDRX(I).LE.KDRMN) THEN                                      
                   KDRMN  = KDRX(I)                                             
                   IMIN   = I                                                   
                END IF                                                          
   20       CONTINUE                                                            
C                                                                               
C *** brigt source to the right, compute left a new maxima = KDRMX              
C                                                                               
         ELSE                                                                   
            ICROWD = 1                                                          
            KDRMX  = KDRMN                                                      
            J      = IMIN - 1                                                   
            DO 30 I = IBEG,J                                                    
               IF (KDRX(I).GE.KDRMX) THEN                                       
                  KDRMX  = KDRX(I)                                              
                  IMAX   = I                                                    
               END IF                                                           
   30       CONTINUE                                                            
         END IF                                                                 
      END IF                                                                    
C                                                                               
C *** compute estimates of image centre and width                               
C                                                                               
      KKS    = 0                                                                
      SX     = IMIN - IMAX                                                      
      DO 40 I = IMAX,IMIN                                                       
         KKS    = KKS + KDRX(I)                                                 
   40 CONTINUE                                                                  
C                                                                               
      XO     = 0.5* (IMAX+IMIN) + KKS*SX/ ((SX+1.0)* (KDRMX-KDRMN))             
      SX     = 0.5*SX                                                           
      J      = IFIX(XO+0.5)                                                     
C                                                                               
C *** find low- (left-) side local minimum                                      
      L      = J - 2                                                            
      JX     = 1                                                                
   50 L      = L - 1                                                            
C                                                                               
      GO TO (100,90,80,70,60),L                                                 
   60 IF (KRX(L).GT.KRX(L-4)) GO TO 50                                          
   70 IF (KRX(L).GT.KRX(L-3)) GO TO 50                                          
   80 IF (KRX(L).GT.KRX(L-2)) GO TO 50                                          
   90 IF (KRX(L).GT.KRX(L-1)) GO TO 50                                          
      JX     = L + 1                                                            
C                                                                               
C *** find high- (right-) side local minimum\                                   
C                                                                               
  100 L      = J + 2                                                            
      LX     = NX                                                               
      M      = NX + 1                                                           
  110 L      = L + 1                                                            
C                                                                               
      GO TO (160,150,140,130,120),M - L                                         
  120 IF (KRX(L).GT.KRX(L+4)) GO TO 110                                         
  130 IF (KRX(L).GT.KRX(L+3)) GO TO 110                                         
  140 IF (KRX(L).GT.KRX(L+2)) GO TO 110                                         
  150 IF (KRX(L).GT.KRX(L+1)) GO TO 110                                         
      LX     = L - 1                                                            
C                                                                               
C *** exit                                                                      
C                                                                               
  160 RETURN                                                                    
      END                                                                       
