Télécharger transa.eso

Retour à la liste

Numérotation des lignes :

  1. C TRANSA SOURCE PV 18/06/18 21:15:41 9860
  2. C SOUS PROGRAMME DE VERIFICATION QU'UN SEGMENT (LL1 LL2) NE COUPE
  3. C PAS UN SEGMENT DU CONTOUR
  4. C
  5. SUBROUTINE TRANSA(NFI,MAI,ITOUR,X,XMOY,IRECL,LL1,LL2,LL3,LL4)
  6. IMPLICIT INTEGER(I-N)
  7. IMPLICIT REAL*8 (A-H,O-Z)
  8. DIMENSION NFI(*),MAI(*),X(3,*)
  9. IRECL=0
  10. XCC=XMOY*XMOY*1D-5
  11. DO 1101 ILT=1,ITOUR
  12. ILD=MAI(ILT-1+1)+1
  13. ILF=MAI(ILT+1)
  14. LL4=NFI(ILF)
  15. X41=X(1,LL1)-X(1,LL4)
  16. Y41=X(2,LL1)-X(2,LL4)
  17. X42=X(1,LL2)-X(1,LL4)
  18. Y42=X(2,LL2)-X(2,LL4)
  19. DO 1102 II3=ILD,ILF
  20. LL3=NFI(II3)
  21. X31=X(1,LL1)-X(1,LL3)
  22. Y31=X(2,LL1)-X(2,LL3)
  23. X32=X(1,LL2)-X(1,LL3)
  24. Y32=X(2,LL2)-X(2,LL3)
  25. IF (LL4.EQ.LL1) GOTO 1104
  26. IF (LL4.EQ.LL2) GOTO 1104
  27. IF (LL3.EQ.LL1) GOTO 1104
  28. IF (LL3.EQ.LL2) GOTO 1104
  29. VL3=X31*Y32-Y31*X32
  30. VL4=X41*Y42-Y41*X42
  31. IF (ABS(VL3).LE.XCC) VL3=0.D0
  32. IF (ABS(VL4).LE.XCC) VL4=0.D0
  33. IF (VL3*VL4.GT.0.D0) GOTO 1104
  34. VL1=X31*Y41-Y31*X41
  35. VL2=X32*Y42-Y32*X42
  36. IF (ABS(VL1).LE.XCC) VL1=0.D0
  37. IF (ABS(VL2).LE.XCC) VL2=0.D0
  38. IF (VL1*VL2.LE.0.D0) GOTO 1105
  39. 1104 X41=X31
  40. Y41=Y31
  41. X42=X32
  42. Y42=Y32
  43. LL4=LL3
  44. GOTO 1102
  45. 1105 CONTINUE
  46. IF ((VL1.NE.0.D0.AND.VL2.NE.0.D0).OR.
  47. > (VL3.NE.0.D0.AND.VL4.NE.0.D0)) GOTO 1107
  48. C LES 4 PTS SONT ALIGNES .EST CE QUE LES SEGMENTS SE RECOUVRENT?
  49. SC4=X41*X42+Y41*Y42
  50. IF (SC4.LT.0.D0) GOTO 1107
  51. SC3=X31*X32+Y31*Y32
  52. IF (SC3.LT.0.D0) GOTO 1107
  53. SC2=X32*X42+Y32*Y42
  54. IF (SC2.LT.0.D0) GOTO 1107
  55. SC1=X31*X41+Y31*Y41
  56. IF (SC1.GE.0.D0) GOTO 1104
  57. 1107 IRECL=1
  58. GOTO 1106
  59. 1102 CONTINUE
  60. 1101 CONTINUE
  61. 1106 RETURN
  62. END
  63.  
  64.  
  65.  
  66.  
  67.  

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