1 : C DIST SOURCE PV 07/10/05 21:15:35 5890 2 : C---------------------------------------------------------------------| 3 : C | 4 : SUBROUTINE DIST(IP,JP,GL,IOK,I1,I2,I3,I4,I5,I6,I7,I8,I9,I10) 5 : C | 6 : C CETTE SUBROUTINE RECHERCHE LE POINT JP LE PLUS PROCHE DE | 7 : C IP. LA DISTANCE ENTRE LES 2 POINTS EST MEMORISEE DANS GL. | 8 : C LES POINTS I* SONT EXCLUS DE LA RECHERCHE | 9 : C | 10 : C---------------------------------------------------------------------| 11 : C 12 : IMPLICIT INTEGER(I-N) 13 : IMPLICIT REAL*8(A-H,O-Z) 14 : -INC TDEMAIT 15 : -INC CCOPTIO 16 : C 17 : IOK=1 18 : GL=1.0E+30 19 : JP=0 20 : C 21 : xp=XYZ(1,IP) 22 : yp=XYZ(2,IP) 23 : zp=XYZ(3,IP) 24 : tp=XYZ(4,IP) 25 : DO 100 I=NPTDIS,NPTMAX 26 : IF (NPF(1,I).EQ.0) GOTO 100 27 : IF (I.EQ.IP) GOTO 100 28 : IF (I.EQ.I1) GOTO 100 29 : IF (I.EQ.I2) GOTO 100 30 : IF (I.EQ.I3) GOTO 100 31 : IF (I.EQ.I4) GOTO 100 32 : IF (I.EQ.I5) GOTO 100 33 : IF (I.EQ.I6) GOTO 100 34 : IF (I.EQ.I7) GOTO 100 35 : IF (I.EQ.I8) GOTO 100 36 : IF (I.EQ.I9) GOTO 100 37 : IF (I.EQ.I10) GOTO 100 38 : S1=xp-XYZ(1,I) 39 : if (abs(s1).gt.2*tp) goto 100 40 : S2=yp-XYZ(2,I) 41 : if (abs(s2).gt.2*tp) goto 100 42 : S3=zp-XYZ(3,I) 43 : if (abs(s3).gt.2*tp) goto 100 44 : S=S1**2+s2**2+s3**2 45 : IF (S.GT.GL) GOTO 100 46 : GL=S 47 : JP=I 48 : 100 CONTINUE 49 : if (jp.ne.0) then 50 : xyztes=XYZ(4,JP) 51 : else 52 : xyztes=1e30 53 : endif 54 : * maintenant test avec le milieu des aretes 55 : * do 200 i=1,naret 56 : do 200 i=1,-1 57 : ii=iigard(i) 58 : jj=jjgard(i) 59 : if (ii.lt.0) goto 200 60 : if ((ii.eq.i1.or.ii.eq.i2.or.ii.eq.i3.or.ii.eq.i4.or.ii.eq.i5 61 : > .or.ii.eq.i6.or.ii.eq.i7.or.ii.eq.i8.or.ii.eq.i9.or.ii.eq.i10) 62 : > .or.(jj.eq.i1.or.jj.eq.i2.or.jj.eq.i3.or.jj.eq.i4.or.jj.eq.i5 63 : > .or.jj.eq.i6.or.jj.eq.i7.or.jj.eq.i8.or.jj.eq.i9.or.jj.eq.i10)) 64 : > goto 200 65 : S1=(xp-(XYZ(1,II)+XYZ(1,JJ))/2) 66 : if (abs(s1).gt.2*tp) goto 200 67 : S2=(yp-(XYZ(2,II)+XYZ(2,JJ))/2) 68 : if (abs(s2).gt.2*tp) goto 200 69 : S3=(zp-(XYZ(3,II)+XYZ(3,JJ))/2) 70 : if (abs(s3).gt.2*tp) goto 200 71 : S=S1**2+S2**2+S3**2 72 : IF (S.GT.GL) GOTO 200 73 : GL=S 74 : xyztes=sqrt(XYZ(4,II)*XYZ(4,JJ)) 75 : jp=0 76 : 200 continue 77 : IF (GL.LE.tp*xyztes*CDIST) IOK=0 78 : GL=SQRT(GL) 79 : * write (6,*) ' dist gl ',gl 80 : * write (6,*) ' ip ',XYZ(1,IP),XYZ(2,IP),XYZ(3,IP) 81 : * write (6,*) ' jp ',XYZ(1,jP),XYZ(2,jP),XYZ(3,jP) 82 : C 83 : RETURN 84 : C FIN DE LA SUBROUTINE DIST 85 : END 86 : 87 :
© Cast3M 2003 - All rights reserved.
Disclaimer