C @(#)putlss.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 PUTLSS         version 1.0        880901
C  A. Kruszewski             Warsaw U. Obs.
C.PURPOSE
C.INPUT/OUTPUT
C-----------------------------------------------------------------------
      SUBROUTINE PUTLSS(L, NREG, LSTP, NCAT, PMTR, PRCT)
C
      IMPLICIT  NONE
      INCLUDE  'MID_REL_INCL:INVENT.INC/NOLIST'
C
      INTEGER   NREG
      INTEGER   I , IPTR , IREG , ISIDE , IX , IY
      INTEGER   J , L , LSTP(0:4,0:NREG) , LZ
      INTEGER   KX , KY , NCAT(NIPAR,MAXCNT)
      REAL   PMTR(NRPAR,MAXCNT) , PRCT(0:MAXSUB,MAXCNT)
C
      IF ( LSTP(3,0) .NE. L-1 ) THEN
          WRITE(*,*) 'Regional linked lists are corrupted'
          STOP ' '
      ENDIF
C
C ******      Return if an object is already in the linked list.
C
      IF ( NCAT(7,L) .GT. 0 ) RETURN
C
C ******      Restore object's position.
C
      I = NCAT(1,L)
      J = NCAT(2,L)
C
C ******      Calculate region's number IREG.
C
      ISIDE = LSTP(0,0)
      KX = LSTP(1,0)
      KY = LSTP(2,0)
      IX = ( I - LSTP(1,1) ) / ISIDE + 1
      IY = ( J - LSTP(2,1) ) / ISIDE + 1
      IREG = (IY-1) * KX + IX
      IF ( IREG .LE. 0 . OR. IREG .GT. NREG ) THEN
          LSTP(3,0) = L
          NCAT(7,L) = 0
          NCAT(8,L) = 0
          RETURN
      ENDIF
C
C ******      Write region's number.
C
      NCAT(7,L) = IREG
C
C ******      Find pointer to begining of linked list.
C
      IPTR = LSTP(0,IREG)
C
C ******      Check if the list has any elements.
C
      IF ( IPTR .EQ. 0 ) THEN
            LSTP(0,IREG) = L
            NCAT(8,L) = 0
      ELSE IF ( IPTR .EQ. L ) THEN
            CONTINUE
      ELSE
   10            CONTINUE
            LZ = IPTR
            IPTR = NCAT(8,LZ)
            IF ( IPTR .NE. 0 ) GOTO 10
            NCAT(8,LZ) = L
            NCAT(8,L) = 0
      ENDIF
C
      LSTP(3,0) = L
C
      RETURN
      END