Télécharger conge2.eso

Retour à la liste

Numérotation des lignes :

  1. C CONGE2 SOURCE CHAT 05/01/12 22:17:07 5004
  2. SUBROUTINE CONGE2 (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 2
  8. * -----------
  9. *
  10. * FONCTION:
  11. * ---------
  12. *
  13. * CREER UN CONGE DE RACCORDEMENT ENTRE DEUX LIGNES
  14. *
  15. * TYPE DU CONGE : CIRCULAIRE
  16. *
  17. * MODULES UTILISES:
  18. * -----------------
  19. *
  20. -INC CCOPTIO
  21. -INC SMELEME
  22. *
  23. * PARAMETRES: (E)=ENTREE (S)=SORTIE (+ = CONTENU DANS UN COMMUN)
  24. * -----------
  25. *
  26. * L1 (E) PREMIERE LIGNE A RACCORDER
  27. * L2 (E) DEUXIEME LIGNE A RACCORDER
  28. * RCONGE (E) RAYON DU CONGE DU RACCORDEMENT
  29. * NCONGE (E) FACTEUR DE DECOUPAGE DU CONGE (CONVENTIONS
  30. * CLASSIQUES SUR SON SIGNE)
  31. * = 0 SI NON FOURNI
  32. * NL1 (S) LIGNE APPUYEE SUR L1 ET ABOUTISSANT SUR LE CONGE
  33. * LRAC (S) CONGE DE RACCORDEMENT
  34. * NL2 (S) LIGNE APPUYEE SUR L2 ET COMMENCANT SUR LE CONGE
  35. *
  36. INTEGER NCONGE
  37. *
  38. * CONSTANTES:
  39. * -----------
  40. *
  41. PARAMETER (DEMI=0.5D0)
  42. *
  43. * VARIABLES:
  44. * ----------
  45. *
  46. * ANG = DEMI ANGLE AU SOMMET DES DEUX DROITES
  47. * DID = DISTANCE DU PT D'INTERSECTION AU PT D'UNE DROITE
  48. * DIC = DISTANCE DU PT D'INTERSECTION AU CENTRE DU CERCLE
  49. * RESULT = 'OK ' OU 'PARA' OU 'NON '
  50. * NBNOEU = NOMBRE DE NOEUD DE L'ELEMENT
  51. * NBELEM = NOMBRE D'ELEMENT
  52. *
  53. INTEGER N,NBNOEU,NBELEM,NL
  54. CHARACTER*4 RESULT
  55. *
  56. * AUTEUR, DATE DE CREATION:
  57. * -------------------------
  58. *
  59. * LIONEL VIVAN 20 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 DE LA VALEUR DE RESULT
  94. *
  95. CALL INT2D(IP9,IP8,IP1,IP2,INTERS,RESULT)
  96. IF (IERR.NE.0) RETURN
  97. IF (RESULT.EQ.'PARA') THEN
  98. CALL ERREUR(397)
  99. RETURN
  100. ELSE IF (RESULT.EQ.'NON ') THEN
  101. CALL ERREUR(398)
  102. RETURN
  103. END IF
  104. *
  105. CALL EXCOO1(IP1,X1,Y1,Z1,D1)
  106. CALL EXCOO1(IP2,X2,Y2,Z2,D2)
  107. CALL EXCOO1(IP8,X8,Y8,Z8,D8)
  108. CALL EXCOO1(IP9,X9,Y9,Z9,D9)
  109. CALL EXCOO1(INTERS,XI,YI,ZI,DI)
  110. *
  111. * CONSTRUCTION DES VECTEURS P1P2 P9P8
  112. P1P21=X2-X1
  113. P1P22=Y2-Y1
  114. P1P23=Z2-Z1
  115. P9P81=X8-X9
  116. P9P82=Y8-Y9
  117. P9P83=Z8-Z9
  118. *
  119. PSA=(P1P21*P9P81)+(P1P22*P9P82)+(P1P23*P9P83)
  120. XN1=SQRT(P1P21**2+P1P22**2+P1P23**2)
  121. XN8=SQRT(P9P81**2+P9P82**2+P9P83**2)
  122. *
  123. * DEMI-ANGLE AU SOMMET DES DEUX DROITES
  124. ANG=(ACOS(PSA/(XN1*XN8)))*DEMI
  125. *
  126. * DISTANCE PT D'INTERSECTION - PT D'EXTREMITE DE LA DROITE
  127. DID=RCONGE/TAN(ANG)
  128. *
  129. * DISTANCE PT D'INTERSECTION - PT CENTRE DU CERCLE
  130. DIC=SQRT(RCONGE**2+DID**2)
  131. *
  132. * DETERMINATION DU POINT E (OU DEBUTERA LE CONGE)
  133. *
  134. XE=(DID/XN8)*P9P81+XI
  135. YE=(DID/XN8)*P9P82+YI
  136. ZE=(DID/XN8)*P9P83+ZI
  137. CALL CREPO1(XE,YE,ZE,IPE)
  138. *
  139. * DETERMINATION DU POINT F (OU FINIRA LE CONGE)
  140. *
  141. XF=(DID/XN1)*P1P21+XI
  142. YF=(DID/XN1)*P1P22+YI
  143. ZF=(DID/XN1)*P1P23+ZI
  144. CALL CREPO1(XF,YF,ZF,IPF)
  145. *
  146. * DETERMINATION DU POINT O (CENTRE DU CERCLE OU S'APPUIERA LE CONGE)
  147. *
  148. XEF=XE+XF-2.D0*XI
  149. YEF=YE+YF-2.D0*YI
  150. ZEF=ZE+ZF-2.D0*ZI
  151. PRO=DIC/SQRT(XEF**2+YEF**2+ZEF**2)
  152. XO=PRO*XEF+XI
  153. YO=PRO*YEF+YI
  154. ZO=PRO*ZEF+ZI
  155. CALL CREPO1(XO,YO,ZO,IPO)
  156. *
  157. * CREATION DES EXTREMITES DES LIGNES A RACCORDER
  158. *
  159. CALL RACLI1(L1,IPE,NL1)
  160. IF (IERR.NE.0) RETURN
  161. CALL RACLI2(IPF,L2,NL2)
  162. IF (IERR.NE.0) RETURN
  163. *
  164. * CREATION ARC DE CERCLE (COMMENCANT EN E, FINISSANT EN F)
  165. *
  166. IF (NCONGE.NE.0) THEN
  167. CALL ECRENT(NCONGE)
  168. END IF
  169. CALL ECROBJ('POINT',IPF)
  170. CALL ECROBJ('POINT',IPO)
  171. CALL ECROBJ('POINT',IPE)
  172. CALL LIGNE(3,1,DEN1,DEN2,N)
  173. IF (IERR.NE.0) RETURN
  174. CALL LIROBJ('MAILLAGE',LRAC,1,IRETOU)
  175. IF (IERR .NE. 0) RETURN
  176. CALL EXCOO1(IPE,XE,YE,ZE,DE)
  177. CALL EXCOO1(IPF,XF,YF,ZF,DF)
  178. IF (NCONGE.GT.0) THEN
  179. MELEME=LRAC
  180. SEGACT,MELEME
  181. NBNOEU=NUM(/1)
  182. NBELEM=NUM(/2)
  183. IP1C=NUM(NBNOEU,1)
  184. CALL EXCOO1(IP1C,X1C,Y1C,Z1C,D1C)
  185. CALL MODPOI(XE,YE,ZE,D1C,IPE)
  186. IP2C=NUM(1,NBELEM)
  187. CALL EXCOO1(IP2C,X2C,Y2C,Z2C,D2C)
  188. CALL MODPOI(XF,YF,ZF,D2C,IPF)
  189. SEGDES,MELEME
  190. END IF
  191. *
  192. END
  193.  
  194.  

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