Télécharger conge3.eso

Retour à la liste

Numérotation des lignes :

  1. C CONGE3 SOURCE CHAT 05/01/12 22:17:11 5004
  2. SUBROUTINE CONGE3 (L1,L2,RCONGE,NCONGE, NL1,LRAC,NL2)
  3. IMPLICIT INTEGER(I-N)
  4. IMPLICIT REAL*8 (A-H,O-Z)
  5. ************************************************************************
  6. *
  7. * C O N G E 3
  8. * -----------
  9. *
  10. * FONCTION:
  11. * ---------
  12. *
  13. * CREER UN CONGE DE RACCORDEMENT ENTRE DEUX LIGNES
  14. *
  15. * TYPE DU CONGE : DOUBLE COUDE
  16. *
  17. *
  18. * MODULES UTILISES:
  19. * -----------------
  20. *
  21. -INC CCOPTIO
  22. -INC SMELEME
  23. *
  24. * PARAMETRES: (E)=ENTREE (S)=SORTIE (+ = CONTENU DANS UN COMMUN)
  25. * -----------
  26. *
  27. * L1 (E) PREMIERE LIGNE A RACCORDER
  28. * L2 (E) DEUXIEME LIGNE A RACCORDER
  29. * RCONGE (E) RAYON DU CONGE DU RACCORDEMENT
  30. * NCONGE (E) FACTEUR DE DECOUPAGE DU CONGE (CONVENTIONS
  31. * CLASSIQUES SUR SON SIGNE)
  32. * = 0 SI NON FOURNI
  33. * NL1 (S) LIGNE APPUYEE SUR L1 ET ABOUTISSANT SUR LE CONGE
  34. * LRAC (S) CONGE DE RACCORDEMENT
  35. * NL2 (S) LIGNE APPUYEE SUR L2 ET COMMENCANT SUR LE CONGE
  36. *
  37. INTEGER NCONGE
  38. REAL*8 RCONGE
  39. *
  40. * CONSTANTES:
  41. * -----------
  42. *
  43. *
  44. PARAMETER (DEMI=0.5D0)
  45. *
  46. * VARIABLES:
  47. * ----------
  48. *
  49. * RESULT = DROITES PARALLELES ?
  50. *
  51. INTEGER N,NBNOEU,NBELEM,NL,ND,
  52. & ITYPLM,NBSOUS,NBREF,NBNN
  53. CHARACTER*4 RESULT
  54. *
  55. *
  56. * AUTEUR, DATE DE CREATION:
  57. * -------------------------
  58. *
  59. * LIONEL VIVAN 30 NOVEMBRE 1987
  60. *
  61. * LANGAGE:
  62. * --------
  63. *
  64. * ESOPE + FORTRAN77
  65. *
  66. ************************************************************************
  67. *
  68. MELEME=L1
  69. SEGACT,MELEME
  70. NL=LISOUS(/1)
  71. IF (NL.NE.0) THEN
  72. CALL ERREUR(25)
  73. RETURN
  74. END IF
  75. NBNOEU=NUM(/1)
  76. NBELEM=NUM(/2)
  77. IP9=NUM(NBNOEU,NBELEM)
  78. IP8=NUM(1,NBELEM)
  79. SEGDES,MELEME
  80. *
  81. MELEME=L2
  82. SEGACT,MELEME
  83. NL=LISOUS(/1)
  84. IF (NL.NE.0) THEN
  85. CALL ERREUR(25)
  86. RETURN
  87. END IF
  88. NBNOEU=NUM(/1)
  89. IP1=NUM(1,1)
  90. IP2=NUM(NBNOEU,1)
  91. SEGDES,MELEME
  92. *
  93. * TEST DROITES PARALLELES , DROITES NON COPLANAIRES
  94. *
  95. CALL INT2D(IP9,IP8,IP1,IP2,INTERS,RESULT)
  96. IF (IERR.NE.0) RETURN
  97. IF (RESULT .EQ. 'NON') THEN
  98. CALL CONGE4(L1,L2,RCONGE,NCONGE,NL1,LRAC,NL2)
  99. RETURN
  100. END IF
  101. IF (RESULT.EQ.'OK')THEN
  102. CALL ERREUR(400)
  103. RETURN
  104. END IF
  105. *
  106. CALL EXCOO1(IP9,X9,Y9,Z9,D9)
  107. CALL EXCOO1(IP8,X8,Y8,Z8,D8)
  108. CALL EXCOO1(IP1,X1,Y1,Z1,D1)
  109. CALL EXCOO1(IP2,X2,Y2,Z2,D2)
  110. *
  111. * RECHERCHE DU POINT C :
  112. * - SUR LA PERPENDICULAIRE AUX DEUX DROITES PASSANT PAR LE POINT
  113. * - APPARTENANT A LA DROITE 'L2'
  114. *
  115. A8921=(X8-X9)*(X2-X1)+(Y8-Y9)*(Y2-Y1)+(Z8-Z9)*(Z2-Z1)
  116. B8929=(X8-X9)*(X2-X9)+(Y8-Y9)*(Y2-Y9)+(Z8-Z9)*(Z2-Z9)
  117. XC=X2-(B8929/A8921)*(X2-X1)
  118. YC=Y2-(B8929/A8921)*(Y2-Y1)
  119. ZC=Z2-(B8929/A8921)*(Z2-Z1)
  120. CALL CREPO1(XC,YC,ZC,IPC)
  121. *
  122. * DISTANCE ENTRE LES DEUX DROITES
  123. *
  124. D2D=SQRT((X9-XC)**2+(Y9-YC)**2+(Z9-ZC)**2)
  125. *
  126. * TEST DE LA VALEUR DE RCONGE
  127. *
  128. IF (RCONGE.LT.(D2D*DEMI)) THEN
  129. CALL ERREUR(401)
  130. RETURN
  131. END IF
  132. *
  133. * RECHERCHE DU POINT P1 ,SE SITUE SUR 'L1'
  134. *
  135. ANG=ASIN((RCONGE-D2D*DEMI)/RCONGE)
  136. XN9=SQRT((X8-X9)**2+(Y8-Y9)**2+(Z8-Z9)**2)
  137. XP1=X9+D2D*DEMI*(X8-X9)*TAN(ANG)/XN9
  138. YP1=Y9+D2D*DEMI*(Y8-Y9)*TAN(ANG)/XN9
  139. ZP1=Z9+D2D*DEMI*(Z8-Z9)*TAN(ANG)/XN9
  140. CALL CREPO1(XP1,YP1,ZP1,IPP1)
  141. *
  142. * RECHERCHE DU POINT P2 ,SE SITUE SUR 'L2'
  143. *
  144. XN1=SQRT((X2-X1)**2+(Y2-Y1)**2+(Z2-Z1)**2)
  145. XP2=XC+D2D*DEMI*(X2-X1)*TAN(ANG)/XN1
  146. YP2=YC+D2D*DEMI*(Y2-Y1)*TAN(ANG)/XN1
  147. ZP2=ZC+D2D*DEMI*(Z2-Z1)*TAN(ANG)/XN1
  148. CALL CREPO1(XP2,YP2,ZP2,IPP2)
  149. *
  150. * RECHERCHE DU POINT O ,MILIEU DE P1 P2
  151. *
  152. XO=(XP1+XP2)*DEMI
  153. YO=(YP1+YP2)*DEMI
  154. ZO=(ZP1+ZP2)*DEMI
  155. CALL CREPO1(XO,YO,ZO,IPO)
  156. *
  157. * CREATION DE LA DROITE P1-O
  158. *
  159. ND=1
  160. CALL ECRENT(ND)
  161. CALL ECROBJ('POINT',IPO)
  162. CALL ECROBJ('POINT',IPP1)
  163. CALL LIGNE(1,1,DEN1,DEN2,N)
  164. IF (IERR.NE.0) RETURN
  165. CALL LIROBJ('MAILLAGE',L3,1,IRETOU)
  166. IF (IERR.NE.0) RETURN
  167. *
  168. * CREATION DE LA DROITE O-P2
  169. *
  170. ND=1
  171. CALL ECRENT(ND)
  172. CALL ECROBJ('POINT',IPP2)
  173. CALL ECROBJ('POINT',IPO)
  174. CALL LIGNE(1,1,DEN1,DEN2,N)
  175. IF (IERR.NE.0) RETURN
  176. CALL LIROBJ('MAILLAGE',L4,1,IRETOU)
  177. IF (IERR.NE.0) RETURN
  178. *
  179. * CREATION DU CONGE DOUBLE
  180. *
  181. NCONGE=(NCONGE+1)/2
  182. CALL CONGE2(L1,L4,RCONGE,NCONGE,NL1,LRAC1,NL4)
  183. IF (IERR.NE.0) RETURN
  184. CALL CONGE2(L3,L2,RCONGE,NCONGE,NL3,LRAC2,NL2)
  185. IF (IERR.NE.0) RETURN
  186. *
  187. * LES 2 DEMI-CERCLES ONT UN POINT EN COMMUN:
  188. MELEME=LRAC1
  189. SEGACT,MELEME
  190. NBNOEU=NUM(/1)
  191. NBELEM=NUM(/2)
  192. IPO1=NUM(NBNOEU,NBELEM)
  193. SEGDES,MELEME
  194. MELEME=LRAC2
  195. SEGACT,MELEME
  196. NUM(1,1)=IPO1
  197. SEGDES,MELEME
  198. * ON REUNIT LES 2 DEMI-CERCLES:
  199. CALL ECROBJ('MAILLAGE',LRAC2)
  200. CALL ECROBJ('MAILLAGE',LRAC1)
  201. CALL PRFUSE
  202. IF (IERR.NE.0) RETURN
  203. CALL LIROBJ('MAILLAGE',LRAC,1,IRETOU)
  204. IF (IERR.NE.0) RETURN
  205. MELEME=LRAC1
  206. SEGSUP,MELEME
  207. MELEME=LRAC2
  208. SEGSUP,MELEME
  209. *
  210. MELEME=L3
  211. SEGSUP,MELEME
  212. MELEME=NL3
  213. SEGSUP,MELEME
  214. MELEME=L4
  215. SEGSUP,MELEME
  216. MELEME=NL4
  217. SEGSUP,MELEME
  218. *
  219. END
  220.  
  221.  

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