C @(#)renmbr.for	17.1.1.1 (ES0-DMD) 01/25/02 17:15:44
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 RENMBR         version 1         820723
C  A. Kruszewski             ESO Garching
C  modified                  version 1.1       870303
C  A. Kruszewski             Obs. de Geneve
C.PURPOSE
C  removes from arrays "NCAT", "ACAT", "PMTR", "PRCT" objects for
C  which a value PMTR(2,*) is smaller than "TRSH"
C  renumbers remaining objects
C.INPUT/OUTPUT
C  input arguments
C
C  NCAT        integer*4 array   integer parameters of objects
C  ACAT        real*4 array      real parameters of objects
C  PMTR        real*4 array      array holding classifiers
C  PRCT        real*4 array      array holding profiles
C  IVRF        integer*4         verification flag
C  M0          integer*4         initial number of objects
C  MM          integer*4         input number of entries
C  TRSH        real*4            limiting treshold
C  output parameters
C  NCAT        integer*4 array   integer parameters of objects
C  ACAT        real*4 array      real parameters of objects
C  PMTR        real*4 array      array holding classifiers
C  PRCT        real*4 array      array holding profiles
C  M           integer*4         outputed number of entries
C-----------------------------------------------------------------------
      SUBROUTINE RENMBR(L0, L1, LW, NREG, LSTP,
     &                  NCAT, PMTR, PRCT, IVRF, TRSH,
     &                  M0, MM, M)
C 
      IMPLICIT  NONE
      INCLUDE  'MID_REL_INCL:INVENT.INC/NOLIST'
C
      INTEGER   L0
      INTEGER   L1
      INTEGER   LW
      INTEGER   NREG
      INTEGER   LSTP(0:4,0:NREG)
      INTEGER   NCAT(NIPAR,MAXCNT)
      REAL      PMTR(NRPAR,MAXCNT)
      REAL      PRCT(0:MAXSUB,MAXCNT)
      INTEGER   IVRF
      REAL      TRSH
      INTEGER   M0
      INTEGER   MM
      INTEGER   M
C
      INTEGER   NP
      INTEGER   K, K0, KM
      INTEGER   LL0, L01
      INTEGER   LL, LL1, LB
     
C
C *** Initialize constants and variables.
C
      NP = MAXCNT
      IF (IVRF.EQ.0) THEN
          L01 = M0
      ELSE
          L01 = 0
      ENDIF
      M = 0
      K0 = 0
      LL0 = 0
      LSTP(3,0) = 0
      DO 5 LL = 1 , NREG
          LSTP(0,LL) = 0
    5 CONTINUE
C
C *** Set initial limits of buffers.
C
      LL1 = MIN( MM , NP )
      LB = LL1
C
C *** Refill buffers if necessary.
C
C      IF ( L0 .GT. LL0 .OR. L1 .NE. LL1 ) THEN
C          DO 10 LL = 1 , LB
C              READ ( ISF , REC=LL ) ( NCAT(KK,LL) , KK=1,NIPAR ) ,
C     &                                 ( PMTR(KK,LL) , KK=1,NRPAR ) ,
C     &                                 ( PRCT(KK,LL) , KK=0,MAXSUB )
C   10     CONTINUE
C      ENDIF
C
C *** Start renumbering.
C
C  20 CONTINUE
C
C ***     Process current content of buffers.
C
          KM = 0
          DO 30 LL = 1 , LB
              NCAT(7,LL) = 0
              NCAT(8,LL) = 0
              IF ( L0+LL .LE. L01 ) THEN
                  M = M + 1
                  KM = KM + 1
                  CALL PUTLSS( K0+KM , NREG , LSTP , NCAT , PMTR ,
     &                         PRCT )
              ELSE IF ( PMTR(2,LL) .GT. TRSH ) THEN
                  M = M + 1
                  KM = KM + 1
                  DO 40 K = 1 , NIPAR
                      NCAT(K,KM) = NCAT(K,LL)
   40             CONTINUE
                  DO 50 K = 1 , NRPAR
                      PMTR(K,KM) = PMTR(K,LL)
   50             CONTINUE
                  DO 60 K = 0 , MAXSUB
                      PRCT(K,KM) = PRCT(K,LL)
   60             CONTINUE
                  CALL PUTLSS( K0+KM , NREG , LSTP , NCAT , PMTR ,
     &                         PRCT )
              ENDIF
   30     CONTINUE
C
C ***     Save buffers.
C
C          DO 70 K = 1 , KM
C               WRITE ( ISF , REC=K0+K ) ( NCAT(KK,K) , KK=1,NIPAR ) ,
C     &                                 ( PMTR(KK,K) , KK=1,NRPAR ) ,
C     &                                 ( PRCT(KK,K) , KK=0,MAXSUB )
C   70     CONTINUE
C          LL0 = LL1
C          LL1 = MIN( LL0+NP , LW )
C          LB = LL1 - LL0
C          K0 = K0 + KM
C          IF ( LL0 .LT. LW ) THEN
CC
CC ***         Fill buffers and repeat the loop.
CC
C              DO 80 LL = 1 , LB
C                  READ ( ISF , REC=LL0+LL )
C     &                               ( NCAT(KK,LL) , KK=1,NIPAR ) ,
C     &                               ( PMTR(KK,LL) , KK=1,NRPAR ) ,
C     &                               ( PRCT(KK,LL) , KK=0,MAXSUB )
C   80         CONTINUE
C              GOTO 20
C          ENDIF
C
C *** Loop terminate here.
C
      CONTINUE
C
      LW = M
      L0 = LL0
      L1 = K0+KM
C
      RETURN
C
      END
C