Télécharger j3junc.eso

Retour à la liste

Numérotation des lignes :

  1. C J3JUNC SOURCE CHAT 05/01/13 00:46:54 5004
  2. SUBROUTINE J3JUNC(WORK1,WORK2,TOL,IRET)
  3. C----------------------------------------------------
  4. C ON REGARDE LE STATUS DES SEGMENTS ADJACENTS A CHAQUE
  5. C POINT DE XYC1 PAR RAPPORT A XYC2
  6. C
  7. C CODE IST(1,I): 0 point non traite
  8. C 1 est sur le segment IST(2,I)
  9. C 2 est sur les segments IST(2,I) et IST(3,I)
  10. C -1 est a l'interieur
  11. C -2 est a l'exterieur
  12. C
  13. C CODE CRO(J,I): 1 cote sur le segment
  14. C -1 cote interieur
  15. C -2 cote exterieur
  16. C
  17. C PP 6/97
  18. C Pierre Pegon/JRC Ispra
  19. C----------------------------------------------------
  20. C
  21. IMPLICIT INTEGER(I-N)
  22. IMPLICIT REAL*8(A-H,O-Z)
  23. -INC CCOPTIO
  24. SEGMENT WORK
  25. REAL*8 XYC(2,NPTO)
  26. INTEGER IST(3,NPTO)
  27. REAL*8 DENS(NPTO)
  28. INTEGER JUN
  29. ENDSEGMENT
  30. POINTEUR WORK1.WORK, WORK2.WORK
  31. C
  32. SEGMENT JUNC
  33. INTEGER CRO(2,NPTO)
  34. ENDSEGMENT
  35. C
  36. DIMENSION XY1(2),XY2(2),XY3(2),XY4(2)
  37. C
  38. NPTO1=WORK1.XYC(/2)
  39. NPTO2=WORK2.XYC(/2)
  40. C
  41. C ENFIN ON REGARDE LE STATUS DES SEGMENTS ADJACENTS A CHAQUE
  42. C POINT DE XYC1 SUR LES COTES DE XYC2
  43. C
  44. JUNC=WORK1.JUN
  45. NPTO=NPTO1
  46. IF (JUNC.EQ.0)THEN
  47. SEGINI,JUNC
  48. WORK1.JUN=JUNC
  49. ELSE
  50. SEGADJ,JUNC
  51. ENDIF
  52. C
  53. DO IE1=1,NPTO1
  54. C
  55. C ON TRAITE FACILEMENT LE CAS OU XYC1(IE1) EST DANS OU HORS XYC2
  56. C
  57. J1=WORK1.IST(1,IE1)
  58. IF(J1.LT.0)THEN
  59. DO IE2=1,2
  60. CRO(IE2,IE1)=J1
  61. ENDDO
  62. C
  63. C A PARTIR D'ICI ON ATTAQUE LES POINTS SUR LES COTES
  64. C
  65. ELSE
  66. C
  67. C ON REGARDE LES VOISINS XYC1(I2) DE XYC1(IE1)
  68. C
  69. DO IE2=1,2
  70. IF(IE2.EQ.1)THEN
  71. I2=IE1-1+(1/IE1)*NPTO1
  72. ELSE
  73. I2=IE1+1-(IE1/NPTO1)*IE1
  74. ENDIF
  75. C
  76. C ON TRAITE FACILEMENT LE CAS OU CE POINT EST DANS OU HORS XYC2
  77. C
  78. J2=WORK1.IST(1,I2)
  79. CRO(IE2,IE1)=J2
  80. C
  81. C MAIS SI XYC1(I2) EST AUSSI SUR XYC2, ON REGARDE SI CE POINTS
  82. C ET XYC1(IE1) SONT SUR LE MEME SEGMENT DE XYC2
  83. C
  84. C
  85. IF(J2.GT.0)THEN
  86. DO IE3=2,J1+1
  87. J3=WORK1.IST(IE3,IE1)
  88. DO IE4=2,J2+1
  89. J4=WORK1.IST(IE4,I2)
  90. IF(J3.EQ.J4)GOTO 1
  91. ENDDO
  92. ENDDO
  93. C
  94. C SI XYC1(I2) ET XYC1(IE1) NE SONT PAS SUR LE MEME SEGMENT DE XYC2
  95. C ON REGARDE OU SE TROUVE LE MILIEU PAR RAPPORT A XYC2
  96. C
  97. DO IE3=1,2
  98. XY1(IE3)=(WORK1.XYC(IE3,IE1)+WORK1.XYC(IE3,I2))/2
  99. ENDDO
  100. CALL J3INEX(XY1,WORK2.XYC,NPTO2,TOL,ICOD,ISIGM,IRET)
  101. CRO(IE2,IE1)=ICOD
  102. GOTO 2
  103. C
  104. C SI XYC1(I2) ET XYC1(IE1) SONT SUR LE MEME SEGMENT DE XYC2
  105. C ALORS ON A LE CODE 1
  106. C
  107. 1 CONTINUE
  108. CRO(IE2,IE1)=1
  109. 2 CONTINUE
  110. ENDIF
  111. ENDDO
  112. C
  113. C FIN DES POINTS SUR LES COTES
  114. C
  115. ENDIF
  116. ENDDO
  117. C
  118. IF (IIMPI.EQ.1789)THEN
  119. WRITE(IOIMP,*)'J3JUNC'
  120. NPTO1=WORK1.XYC(/2)
  121. WRITE(IOIMP,*)'WORK1/WORK2: NUM,CRO1, CRO2, ',WORK1,WORK2
  122. DO IE1=1,NPTO1
  123. WRITE(IOIMP,*)IE1,CRO(1,IE1),CRO(2,IE1)
  124. ENDDO
  125. ENDIF
  126.  
  127. C
  128. RETURN
  129. END
  130.  
  131.  
  132.  

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