C @(#)rmflst.for	17.1.1.1 (ES0-DMD) 01/25/02 17:15:45
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
C
C----------------------------------------------------------------------
      SUBROUTINE RMFLST(M, L0, L1, NREG, LSTP, NCAT)
C
      IMPLICIT  NONE
      INCLUDE   'MID_REL_INCL:INVENT.INC/NOLIST'
C
      INTEGER   M
      INTEGER   L0
      INTEGER   L1
      INTEGER   NREG
      INTEGER   LSTP(0:4,0:NREG)
      INTEGER   NCAT(NIPAR,MAXCNT)
C
      INTEGER   LM, LL
      INTEGER   IREG , LOBJ
C     INTEGER   NCT1(NIPAR) , NCT2(NIPAR) 
      INTEGER   NOBJ , NP
C
C     REAL   PMT1(NRPAR) , PMT2(NRPAR)
C     REAL   PRC1(0:MAXSUB) , PRC2(0:MAXSUB)
C
      LOGICAL   BUFF1 , BUFF2
C
      NP = MAXCNT
C
C ******      Find first object in the region LOBJ.
C
C      IF ( M .GT. L0 .AND. M .LE. L1 ) THEN
          BUFF1 = .TRUE.
          LM = M - L0
          IREG = NCAT(7,LM)
C      ELSE
C          BUFF1 = .FALSE.
C          READ ( ISF , REC=M ) NCT1 , PMT1 , PRC1
C          IREG = NCT1(7)
C      ENDIF
      LOBJ = LSTP(0,IREG)
      IF ( LOBJ .EQ. M ) THEN
C
C ***     M is the first object on list.
C
C          IF ( BUFF1 ) THEN
              NOBJ = NCAT(8,LM)
C          ELSE
C              NOBJ = NCT1(8)
C          ENDIF
          LSTP(0,IREG) = NOBJ
C          IF ( BUFF1 ) THEN
              NCAT(7,LM) = 0
              NCAT(8,LM) = 0
C          ELSE
C              NCT1(7) = 0
C              NCT1(8) = 0
C              WRITE ( ISF , REC=M ) NCT1 , PMT1 , PRC1
C          ENDIF
      ELSE IF ( LOBJ .EQ. 0 ) THEN
C          IF ( BUFF1 ) THEN
              NCAT(7,LM) = 0
              NCAT(8,LM) = 0
C          ELSE
C              NCT1(7) = 0
C              NCT1(8) = 0
C              WRITE ( ISF , REC=M ) NCT1 , PMT1 , PRC1
C          ENDIF
      ELSE
C
C *** M is in the middle or on the end of list.
C
   10     CONTINUE
C              IF ( LOBJ .GT. L0 .AND. LOBJ .LE. L1 ) THEN
                  LL = LOBJ - L0
                  NOBJ = NCAT(8,LL)
                  BUFF2 = .TRUE.
C              ELSE
C                  READ ( ISF , REC=LOBJ ) NCT2 , PMT2 , PRC2
C                  NOBJ = NCT2(8)
C                  BUFF2 = .FALSE.
C              ENDIF
              IF ( NOBJ .EQ. M ) THEN
C                  IF ( BUFF1 ) THEN
                      NOBJ = NCAT(8,LM)
                      NCAT(7,LM) = 0
                      NCAT(8,LM) = 0 
C                  ELSE
C                      NOBJ = NCT1(8)
C                      NCT1(7) = 0
C                      NCT1(8) = 0
C                      WRITE ( ISF , REC=M ) NCT1 , PMT1 , PRC1
C                  ENDIF
C                  IF ( BUFF2 ) THEN
                      NCAT(8,LL) = NOBJ
C                  ELSE
C                      NCT2(8) = NOBJ
C                      WRITE ( ISF , REC=LOBJ ) NCT2 , PMT2 , PRC2
C                  ENDIF
              ELSE IF ( NOBJ .EQ. 0 ) THEN
C                  IF ( BUFF1 ) THEN
                      NCAT(7,LM) = 0
                      NCAT(8,LM) = 0
C                  ELSE
C                      NCT1(7) = 0
C                      NCT1(8) = 0
C                      WRITE ( ISF , REC=M ) NCT1 , PMT1 , PRC1
C                  ENDIF
              ELSE
                  LOBJ = NOBJ
                  GOTO 10
              ENDIF
          CONTINUE
      ENDIF
C
      IF ( LSTP(3,0) .EQ. M ) THEN
          LSTP(3,0) = M - 1
      ENDIF
C
      RETURN
C
      END
C