Télécharger j3coto.eso

Retour à la liste

Numérotation des lignes :

  1. C J3COTO SOURCE CHAT 05/01/13 00:46:10 5004
  2. SUBROUTINE J3COTO(WORK1,WORK2,TOL,IRET)
  3. C----------------------------------------------------
  4. C RAPPORT ENTRE LE CONTOUR DE WORK1 AVEC CELUI DE WORK2
  5. C
  6. C CODE IST(1,I): 0 point non traite
  7. C 1 est sur le segment IST(2,I)
  8. C 2 est sur les segments IST(2,I) et IST(3,I)
  9. C -1 est a l'interieur
  10. C -2 est a l'exterieur
  11. C
  12. C PP 6/97
  13. C Pierre Pegon/JRC Ispra
  14. C----------------------------------------------------
  15. C
  16. IMPLICIT INTEGER(I-N)
  17. IMPLICIT REAL*8(A-H,O-Z)
  18. -INC CCOPTIO
  19. SEGMENT WORK
  20. REAL*8 XYC(2,NPTO)
  21. INTEGER IST(3,NPTO)
  22. REAL*8 DENS(NPTO)
  23. INTEGER JUN
  24. ENDSEGMENT
  25. POINTEUR WORK1.WORK, WORK2.WORK
  26. C
  27. DIMENSION XY1(2),XY2(2),XY3(2),XY4(2),XY(2)
  28. C
  29. IRET=0
  30. C
  31. NPTO1=WORK1.XYC(/2)
  32. CALL J3ZERI(WORK1.IST,3,NPTO1)
  33. NPTO2=WORK2.XYC(/2)
  34. CALL J3ZERI(WORK2.IST,3,NPTO2)
  35. C
  36. C ON CHERCHE A SAVOIR SI LES POINTS DE XYC1 SONT CONFONDU
  37. C AVEC DES POINTS DE XYC2, OU SUR LES COTES DE XYC2, OU BIEN
  38. C DEDANS OU DEHORS DE XYC2
  39. C
  40. DO IE1=1,NPTO1
  41. DO IE2=1,2
  42. XY1(IE2)=WORK1.XYC(IE2,IE1)
  43. ENDDO
  44. C
  45. ICOD=0
  46. C
  47. CALL J3NOCO(XY1,WORK2.XYC,NPTO2,TOL,IE2)
  48. IF(IE2.NE.0)THEN
  49. ICOD=2
  50. CALL J3BOCO(WORK1,IE1,IE2,IRET)
  51. IE2=IE2-1+(1/IE2)*NPTO2
  52. CALL J3BOCO(WORK1,IE1,IE2,IRET)
  53. ENDIF
  54. C
  55. IF(ICOD.EQ.0)THEN
  56. CALL J3DESS(XY1,WORK2.XYC,NPTO2,TOL,IE2)
  57. IF(IE2.NE.0)THEN
  58. ICOD=1
  59. CALL J3BOCO(WORK1,IE1,IE2,IRET)
  60. ENDIF
  61. ENDIF
  62. C
  63. IF(ICOD.EQ.0)THEN
  64. CALL J3INEX(XY1,WORK2.XYC,NPTO2,TOL,ICOD,ISIGM,IRET)
  65. WORK1.IST(1,IE1)=ICOD
  66. ENDIF
  67. C
  68. IF(IRET.GT.0)THEN
  69. RETURN
  70. ENDIF
  71. ENDDO
  72. C
  73. C ON REGARDE MAINTENANT S'IL Y A DES POINTS DE XYC2 QUI SONT
  74. C SUR XYC1. IL FAUT AJOUTER CES POINTS
  75. C
  76. DO IE1=1,NPTO2
  77. DO IE2=1,2
  78. XY2(IE2)=WORK2.XYC(IE2,IE1)
  79. ENDDO
  80. CALL J3NOCO(XY2,WORK1.XYC,NPTO1,TOL,IE2)
  81. IF(IE2.EQ.0)THEN
  82. CALL J3DESS(XY2,WORK1.XYC,NPTO1,TOL,IE2)
  83. IF(IE2.NE.0)THEN
  84. NPTO1=NPTO1+1
  85. IE2=IE2+1
  86. DENS1=WORK2.DENS(IE1)
  87. CALL J3POIN(WORK1,NPTO1,IE2,XY2,DENS1)
  88. CALL J3BOCO(WORK1,IE2,IE1,IRET)
  89. I1=IE1-1+(1/IE1)*NPTO2
  90. CALL J3BOCO(WORK1,IE2, I1,IRET)
  91. ENDIF
  92. ENDIF
  93. ENDDO
  94. C
  95. C ON REGARDE MAINTENANT LES INTERSECTIONS DE XYC1 AVEC XYC2
  96. C ET ON AJOUTE LES POINTS D'INTERSECTION
  97. C
  98. IE1=0
  99. 1 IE1=IE1+1
  100. IF(IE1.GT.NPTO1)GOTO 3
  101. C
  102. I1=IE1
  103. I2=IE1+1-(IE1/NPTO1)*IE1
  104. C
  105. IB1=WORK1.IST(2,I1)
  106. IB2=WORK1.IST(3,I1)
  107. IB3=WORK1.IST(2,I2)
  108. IB4=WORK1.IST(3,I2)
  109. C
  110. DO IE2=1,2
  111. XY1(IE2)=WORK1.XYC(IE2,I1)
  112. XY2(IE2)=WORK1.XYC(IE2,I2)
  113. ENDDO
  114. C
  115. DO 2 IE2=1,NPTO2
  116. C
  117. C (ON ELIMINE LES COTES DE XYC2 DEJA COUPES PAR XYC1)
  118. C
  119. IB=MIN(ABS(IB1-IE2),ABS(IB2-IE2),ABS(IB3-IE2),ABS(IB4-IE2))
  120. IF(IB.EQ.0)GOTO 2
  121. C
  122. I3=IE2
  123. I4=IE2+1-(IE2/NPTO2)*IE2
  124. DO IE3=1,2
  125. XY3(IE3)=WORK2.XYC(IE3,I3)
  126. XY4(IE3)=WORK2.XYC(IE3,I4)
  127. ENDDO
  128. C
  129. CALL J3SINT(XY1,XY2,XY3,XY4,TOL,XLAM,XGAM,XY)
  130. C
  131. IF((XLAM.GT.0.D0).AND.(XLAM.LT.1.D0).AND.
  132. > (XGAM.GT.0.D0).AND.(XGAM.LT.1.D0))THEN
  133. NPTO1=NPTO1+1
  134. DENS1=XLAM*WORK1.DENS(I2)+(1-XLAM)*WORK1.DENS(I1)
  135. CALL J3POIN(WORK1,NPTO1,IE1+1,XY,DENS1)
  136. CALL J3BOCO(WORK1,IE1+1,IE2,IRET)
  137. IE1=IE1-1
  138. GOTO 1
  139. ENDIF
  140. 2 CONTINUE
  141. C
  142. GOTO 1
  143. 3 CONTINUE
  144. IF(IRET.GT.0)RETURN
  145. C
  146. C ON CHERCHE A SAVOIR SI LES POINTS DE XYC2 SONT CONFONDU
  147. C AVEC DES POINTS DE XYC1, OU SUR LES COTES DE XYC1, OU BIEN
  148. C DEDANS OU DEHORS DE XYC1
  149. C
  150. DO IE1=1,NPTO2
  151. DO IE2=1,2
  152. XY2(IE2)=WORK2.XYC(IE2,IE1)
  153. ENDDO
  154. C
  155. ICOD=0
  156. C
  157. CALL J3NOCO(XY2,WORK1.XYC,NPTO1,TOL,IE2)
  158. IF(IE2.NE.0)THEN
  159. ICOD=2
  160. CALL J3BOCO(WORK2,IE1,IE2,IRET)
  161. IE2=IE2-1+(1/IE2)*NPTO1
  162. CALL J3BOCO(WORK2,IE1,IE2,IRET)
  163. ENDIF
  164. C
  165. IF(ICOD.EQ.0)THEN
  166. CALL J3DESS(XY2,WORK1.XYC,NPTO1,TOL,IE2)
  167. IF(IE2.NE.0)THEN
  168. ICOD=1
  169. CALL J3BOCO(WORK2,IE1,IE2,IRET)
  170. ENDIF
  171. ENDIF
  172. C
  173. IF(ICOD.EQ.0)THEN
  174. CALL J3INEX(XY2,WORK1.XYC,NPTO1,TOL,ICOD,ISIGM,IRET)
  175. WORK2.IST(1,IE1)=ICOD
  176. ENDIF
  177. C
  178. IF(IRET.GT.0)THEN
  179. RETURN
  180. ENDIF
  181. ENDDO
  182. C
  183. IF (IIMPI.EQ.1789)THEN
  184. WRITE(IOIMP,*)'J3COTO'
  185. NPTO1=WORK1.XYC(/2)
  186. WRITE(IOIMP,*)'WORK1: NUM,X,Y,IST1,IST2,IST3,DENS ',WORK1
  187. DO IE1=1,NPTO1
  188. WRITE(IOIMP,*)IE1,WORK1.XYC(1,IE1),WORK1.XYC(2,IE1),
  189. > WORK1.IST(1,IE1),WORK1.IST(2,IE1),WORK1.IST(3,IE1),
  190. > WORK1.DENS(IE1)
  191. ENDDO
  192. NPTO2=WORK2.XYC(/2)
  193. WRITE(IOIMP,*)'WORK2: NUM,X,Y,IST1,IST2,IST3,DENS ',WORK2
  194. DO IE1=1,NPTO2
  195. WRITE(IOIMP,*)IE1,WORK2.XYC(1,IE1),WORK2.XYC(2,IE1),
  196. > WORK2.IST(1,IE1),WORK2.IST(2,IE1),WORK2.IST(3,IE1),
  197. > WORK2.DENS(IE1)
  198. ENDDO
  199. ENDIF
  200. C
  201. RETURN
  202. END
  203.  
  204.  
  205.  

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