C @(#)deflst.for 17.1.1.1 (ES0-DMD) 01/25/02 17:15:40 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 DEFLST version 1.0 880901 C A. Kruszewski Warsaw U. Obs. C.PURPOSE C.INPUT/OUTPUT C Input parameters C ITOB integer*4 array limits of objects area C M integer*4 number of objects C Output parameters C LSTP integer*4 array array defining regional linked lists C NREG integer*4 number of regional linked lists C C----------------------------------------------------------------------- SUBROUTINE DEFLST(LSTP, ITOB, M, NREG) C IMPLICIT NONE INCLUDE 'MID_REL_INCL:INVENT.INC/NOLIST' C INTEGER LSTP(LPBUF) INTEGER ITOB(4) INTEGER M INTEGER NREG C INTEGER I INTEGER ISIDE INTEGER IX INTEGER IY INTEGER KX INTEGER KY INTEGER NREG1 C DO I = 1, LPBUF LSTP(I) = 0.0 ENDDO C NREG1 = LPBUF / 5 - 1 NREG = MIN ( NREG1 , M/5 ) IX = ITOB(3) - ITOB(1) + 1 IY = ITOB(4) - ITOB(2) + 1 ISIDE = ( IX * IY ) / NREG ISIDE = INT( SQRT( FLOAT( ISIDE ) ) ) 10 CONTINUE KX = IX / ISIDE IF ( MOD( IX , ISIDE ) .GT. 0 ) THEN KX = KX + 1 ENDIF KY = IY / ISIDE IF ( MOD( IY , ISIDE ) .GT. 0 ) THEN KY = KY + 1 ENDIF IF ( KX*KY .GT. NREG1 ) THEN ISIDE = ISIDE + 1 GOTO 10 ENDIF NREG = KX * KY LSTP(1) = ISIDE LSTP(2) = KX LSTP(3) = KY CALL FLSTBD( NREG , LSTP , ITOB ) C RETURN END