C @(#)inters.for 17.1.1.1 (ES0-DMD) 01/25/02 17:17:56 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 INTERS(SF,NDIM,NT,NC,NI,IFNM,RMA,NST,FAR,DAT) C +++ C --- IMPLICIT NONE INTEGER NDIM REAL SF(NDIM,7) INTEGER NT INTEGER NC INTEGER NI INTEGER IFNM REAL RMA INTEGER NST REAL FAR REAL DAT(7,1) C REAL V(7) REAL DF, DI INTEGER NCS INTEGER I, IFL, IL1, K, LI, J REAL KPRO REAL DX, DY C NCS = NC IFNM = 1 C IF (SF(NI,7).NE.1.AND.SF(NI,7).NE.3) THEN DF = SF(NI,6)+RMA I = SF(NI,1) IFL = 0 C C 20 CONTINUE IF (IFL.NE.0 .OR. I.GT.NST) GO TO 10 I = I+1 KPRO = 1 GO TO 100 C 10 CONTINUE IF (IFNM.EQ.1) THEN IFL = 0 I = SF(NI,1) CONTINUE IF (IFL.NE.0 .OR. I.LE.2) THEN RETURN ENDIF I = I-1 KPRO = 2 GO TO 100 END IF ENDIF RETURN C C *** 100 CONTINUE IL1 = 0 K = 0 50 CONTINUE IF (IL1.NE.0 .OR. K.GE.NC-1) GO TO 60 K = K+1 IF (SF(K,1).EQ.I) IL1=1 GO TO 50 C 60 CONTINUE IF (IL1.EQ.0) THEN DO 61 LI=2,7 V(LI)=DAT(LI,I) 61 CONTINUE C IF (V(7).NE.2.AND.V(7).NE.1) THEN IF (V(4).GT.0..AND.V(6).GT.0.) THEN DY = ABS(SF(NI,3)-V(3)) IF (DY.LE.DF) THEN DX = ABS(SF(NI,2)-V(2)) IF (DX.LE.DF) THEN DI = SQRT(DX**2+DY**2)/FAR IF (DI.LT.SF(NI,6)+V(6)) THEN IF (NC-1.LT.NT) THEN DO 62 J=2,7 SF(NC,J)=V(J) 62 CONTINUE SF(NC,1) = I NC = NC+1 ELSE NC = NCS IFL = 1 IFNM = 0 END IF END IF END IF ELSE IFL = 1 END IF END IF END IF END IF C IF (KPRO.EQ.1) THEN IF (IFL.NE.0 .OR. I.GT.NST) GO TO 11 I = I+1 KPRO = 1 GO TO 100 C 11 CONTINUE IF (IFNM.EQ.1) THEN IFL = 0 I = SF(NI,1) CONTINUE IF (IFL.NE.0 .OR. I.LE.2) THEN RETURN ENDIF I = I-1 KPRO = 2 GO TO 100 END IF RETURN ELSE IF (IFL.NE.0 .OR. I.LE.2) THEN RETURN ENDIF I = I-1 KPRO = 2 GO TO 100 ENDIF C END