C @(#)identf.for	17.1.1.1 (ES0-DMD) 01/25/02 17:55:50
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

      SUBROUTINE IDENTF(NROW1,NACT1,BUF1,NROW2,NACT2,BUF2,ERROR,IDEG,
     +                    COEFF,IST,MODE)
C
C IDENTIFY DETECTED LINES
C
C INPUT ARGUMENTS
C NROW1   INTG*4  DIMENSION OF BUF1
C NACT1   INTG*4  NUMBER OF DETECTED LINES
C BUF1 REAL*8  BUFFER WITH DETECTED LINES
C NROW2   INTG*4  DIMENSION OF BUF2
C NACT2   INTG*4  NUMBER OF COMPARISON LINES
C BUF2 REAL*8  BUFFER WITH COMPARISON LINES
C ERROR REAL*8  TOLERANCE IN PIXELS
C IDEG INTG*4  DEGREE OF POLYNOMIAL
C MODE    INTG MODE=0 Normal identification, MODE=1 GUESS
C
C INPUT/OUTPUT ARGUMENTS
C COEFF REAL*8  DISPERSION COEFFICIENTS X <- F(WAVE)
C               COEFF is an input in mode GUESS 
C
C OUTPUT ARGUMENTS
C IST     INTG*4  STATUS RETURN (0 - OK)
C
C THE ARRAY BUF1 CONTAINS THE FOLLOWING INFORMATION:
C
C BUF1(I,1) - X1 LINE POSITION
C BUF1(I,2) - LINE FLAG  AS    1 MANUAL IDENTIFICATION
C                              0 NOT IDENTIFIED
C                             -1 AUTOMATIC IDENTIFICATION
C BUF1(I,3) - ACTUAL IDENTIFICATION
C BUF1(I,4) - COMPUTED WAVELENGTH
C BUF1(I,5) - RESIDUALS
C
      IMPLICIT NONE
C
      INTEGER      NROW1,NACT1,NROW2,NACT2,IST,MODE
      DOUBLE PRECISION ERROR,BUF1(NROW1,5),COEFF(30)
      DOUBLE PRECISION STDEV,STDEV1,STDEV3,BUF2(NROW2)
      INTEGER IDEG,ISTAT,NSTEP,NV
      INTEGER NTOT,NTOTAL,NTOTU,NTOTI,NTOTR1,NTOTR2,I
      CHARACTER*78 OUTPUT
      CHARACTER*78 OUTP2
      CHARACTER*72 OUTP3
C
      DATA OUTP2/
     +' iteration  total  unident. ident.  abs(res)>3*stdev  
     +stdev (pixel)'
     +      /
      DATA OUTP3/
     +' ---------  -----  -------  ------  ----------------  
     +-------------'
     +     /
C
      STDEV1 = -1.D20
      IST    = 0
C
C ... ITERATION
C
          OUTPUT = ' '
      CALL STTPUT(OUTPUT,ISTAT)
      CALL STTPUT(OUTP2,ISTAT)
      CALL STTPUT(OUTP3,ISTAT)

      DO 20 NSTEP = 1,10

          NV     = IDEG + 1

         IF (MODE.EQ.0.OR.NSTEP.GT.1)  THEN
C           LSOLVE is skipped at iteration 1 in mode MODE=1 (GUESS)
C
C ...    BUILD L - S MATRIX AND SOLVE SYSTEM
C
          CALL LSOLVE(NROW1,NACT1,BUF1,IDEG,NV,COEFF)

         ENDIF
C
C ...    IDENTIFY FEATURES
C
          CALL LSIDEN(IDEG,NV,COEFF,NROW1,NACT1,BUF1,NACT2,BUF2,ERROR,
     +                 NTOT,STDEV)
C
C ...    SELECT LINES WITH LOW RESIDUALS
C
          STDEV3 = STDEV*3.D0
          IF (NTOT.EQ.0) THEN
              IST    = 1
              RETURN
          ENDIF
C
C ...    STATISTICS ON THE IDENTIFICATIONS
C  !   TOTAL NUMBER OF LINES
          NTOTAL = 0  !   TOTAL NUMBER OF UNIDENTIFIED LINES
          NTOTU  = 0  !   TOTAL NUMBER OF IDENTIFIED LINES
          NTOTI  = 0  !   TOTAL NUMBER OF LINES WITH RESIDUALS .LT. 0.1 PIXEL
          NTOTR1 = 0  !   TOTAL NUMBER OF LINES WITH RESIDUALS .GT.3*STDEV
          NTOTR2 = 0
          DO 10 I = 1,NACT1
              NTOTAL = NTOTAL + 1
              IF (DABS(BUF1(I,2)).GT.0.5D0) THEN
                  NTOTI  = NTOTI + 1
                  IF (DABS(BUF1(I,5)).GT.STDEV3) THEN
                      BUF1(I,2) = 0.0D0
                      BUF1(I,4) = 0.0D0
                      BUF1(I,5) = 0.0D0
                      NTOTR2 = NTOTR2 + 1
                  END IF
              ENDIF
   10     CONTINUE
          NTOTU  = NTOTAL - NTOTI
          WRITE (OUTPUT,9000) NSTEP,NTOTAL,NTOTU,NTOTI,NTOTR2,STDEV
          CALL STTPUT(OUTPUT,ISTAT)
          IF (NTOTI.LT.NV) THEN
              CALL STTPUT(' Error : not enough  identified entries',
     +                    ISTAT)
              IST    = 1
              RETURN
          END IF
          IF (NSTEP.GT.1.AND.DABS((STDEV-STDEV1)/STDEV)
     +                                     .LE.0.005D0) RETURN
          STDEV1 = STDEV

   20 CONTINUE
 9000 FORMAT (1X,I9,2X,I5,2X,I7,2X,I6,10X,I8,2X,E10.3)

      RETURN
      END