Télécharger dist.eso

Retour à la liste

Numérotation des lignes :

  1. C DIST SOURCE JC220346 16/11/29 21:15:12 9221
  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.  
  88.  
  89.  

© Cast3M 2003 - Tous droits réservés.
Mentions légales