Télécharger racli1.eso

Retour à la liste

Numérotation des lignes :

  1. C RACLI1 SOURCE BP208322 16/11/18 21:20:40 9177
  2. SUBROUTINE RACLI1(L1,IPE, NL1)
  3. IMPLICIT INTEGER(I-N)
  4. IMPLICIT REAL*8 (A-H,O-Z)
  5. ************************************************************************
  6. *
  7. * R A C L I 1
  8. * -----------
  9. *
  10. * FONCTION:
  11. * ---------
  12. *
  13. * CREER UNE LIGNE 'NL1' S'APPUYANT SUR LA LIGNE 'L1'
  14. * ET FINISSANT EN UN POINT E
  15. * L'ORIENTATION EST LIGNE-POINT
  16. *
  17. * MODULES UTILISES:
  18. * -----------------
  19. *
  20. -INC CCGEOME
  21. -INC CCOPTIO
  22. -INC SMELEME
  23. *
  24. * PARAMETRES: (E)=ENTREE (S)=SORTIE (+ = CONTENU DANS UN COMMUN)
  25. * -----------
  26. *
  27. * L1 (E) LIGNE
  28. * IPE (E) POINT
  29. * (S) ATTENTION: LA DENSITE DU POINT PEUT ETRE MODIFIEE
  30. * (EN FONCTION DE LA DENSITE SUR "L1").
  31. * NL1 (S) LIGNE DE RACCORDEMENT LIGNE-POINT
  32. *
  33. * CONSTANTES:
  34. * -----------
  35. *
  36. PARAMETER (DEMI=0.5D0)
  37. *
  38. * VARIABLES:
  39. * ----------
  40. *
  41. * NBNOEU = NOMBRE DE NOEUD
  42. * NBELEM = NOMBRE D'ELEMENT
  43. *
  44. INTEGER NBNOEU,NBELEM,NL,N,
  45. & ITYPLM,NBSOUS,NBREF,NBNN
  46. *
  47. * AUTEUR, DATE DE CREATION:
  48. * -------------------------
  49. *
  50. * LIONEL VIVAN 23 NOVEMBRE 1987
  51. *
  52. * LANGAGE:
  53. * --------
  54. *
  55. * ESOPE + FORTRAN77
  56. *
  57. ************************************************************************
  58. *
  59. MELEME=L1
  60. SEGACT,MELEME
  61. NL=LISOUS(/1)
  62. IF (NL.NE.0) THEN
  63. CALL ERREUR(25)
  64. RETURN
  65. END IF
  66. IF (ILCOUR.EQ.0) THEN
  67. CALL ERREUR(16)
  68. RETURN
  69. END IF
  70. ITYPLM=KDEGRE(ILCOUR)
  71. IF (ITYPLM.EQ.0) THEN
  72. CALL ERREUR(16)
  73. RETURN
  74. END IF
  75. NBNN=NBNNE(ITYPLM)
  76. IF (NBNN.NE.2.AND.NBNN.NE.3) THEN
  77. CALL ERREUR(16)
  78. RETURN
  79. END IF
  80. NBSOUS=0
  81. NBREF=0
  82. NBNOEU=NUM(/1)
  83. NBELEM=NUM(/2)
  84. IP8=NUM(1,NBELEM)
  85. IP9=NUM(NBNOEU,NBELEM)
  86. *
  87. CALL EXCOO1(IPE,XE,YE,ZE,DE)
  88. CALL EXCOO1(IP8,X8,Y8,Z8,D8)
  89. CALL EXCOO1(IP9,X9,Y9,Z9,D9)
  90. PS=(X9-X8)*(XE-X9)+(Y9-Y8)*(YE-Y9)+(Z9-Z8)*(ZE-Z9)
  91. *
  92. DE9=SQRT((X9-XE)**2+(Y9-YE)**2+(Z9-ZE)**2)
  93. D98=SQRT((X8-X9)**2+(Y8-Y9)**2+(Z8-Z9)**2)
  94. IF (PS.GE.0.) THEN
  95. *
  96. * POINT E HORS DE LA DROITE
  97. *
  98. IF (DE9 .GT. (D98/2.D0) ) THEN
  99. *
  100. * ON CREE UNE DROITE NL1 = L1 + DROITE(P9,PE)
  101. *
  102. CALL ECROBJ('POINT',IPE)
  103. CALL ECROBJ('MAILLAGE',L1)
  104. CALL LIGNE(1,1,DEN1,DEN2,N)
  105. IF (IERR.NE.0) RETURN
  106. CALL LIROBJ('MAILLAGE',NL1,1,IRETOU)
  107. IF (IERR.NE.0) RETURN
  108. ELSE
  109. *
  110. * ON RALLONGE LE DERNIER ELEMENT
  111. *
  112. DE = D9
  113. CALL MODPOI (XE,YE,ZE,DE,IPE)
  114. SEGINI,IPT1
  115. IPT1.ITYPEL=ITYPLM
  116. NL1=IPT1
  117. IPT1.NUM(NBNOEU,NBELEM)=IPE
  118. IPT1.NUM(1,NBELEM)=NUM(1,NBELEM)
  119. IPT1.ICOLOR(NBELEM)=IDCOUL
  120. IF (NBNOEU.EQ.3) THEN
  121. X7=(XE+X8)*DEMI
  122. Y7=(YE+Y8)*DEMI
  123. Z7=(ZE+Z8)*DEMI
  124. D7=(DE+D8)*DEMI
  125. CALL CREPO2(X7,Y7,Z7,D7,IP7)
  126. IPT1.NUM(2,NBELEM)=IP7
  127. END IF
  128. DO 12 I=1,(NBELEM-1)
  129. IPT1.ICOLOR(I)=IDCOUL
  130. DO 12 J=1,NBNOEU
  131. IPT1.NUM(J,I)=NUM(J,I)
  132. 12 CONTINUE
  133. * END DO
  134. * END DO
  135. SEGDES,IPT1
  136. END IF
  137. ELSE
  138. *
  139. * LE POINT E SE SITUE SUR LA DROITE
  140. *
  141. * RECHERCHE DE L'ELEMENT I OU SE TROUVE LE POINT E
  142. *
  143. 105 IF (DE9.GT.D98) THEN
  144. NBELEM=NBELEM-1
  145. IF (NBELEM.EQ.0) THEN
  146. CALL ERREUR(399)
  147. RETURN
  148. END IF
  149. IP9=NUM(NBNOEU,NBELEM)
  150. IP8=NUM(1,NBELEM)
  151. CALL EXCOO1(IP9,X9,Y9,Z9,D9)
  152. CALL EXCOO1(IP8,X8,Y8,Z8,D8)
  153. DE9=SQRT((X9-XE)**2+(Y9-YE)**2+(Z9-ZE)**2)
  154. D98=SQRT((X8-X9)**2+(Y8-Y9)**2+(Z8-Z9)**2)
  155. GOTO 105
  156. END IF
  157. IF (DE9 .LE. (D98/2.D0) ) THEN
  158. *
  159. * LE POINT E EST PROCHE DU POINT 9
  160. *
  161. DE = D9
  162. CALL MODPOI (XE,YE,ZE,DE,IPE)
  163. SEGINI,IPT1
  164. IPT1.ITYPEL=ITYPLM
  165. NL1=IPT1
  166. IPT1.NUM(NBNOEU,NBELEM)=IPE
  167. IPT1.NUM(1,NBELEM)=NUM(1,NBELEM)
  168. IPT1.ICOLOR(NBELEM)=IDCOUL
  169. IF (NBNOEU.EQ.3) THEN
  170. X7=(X8+XE)*DEMI
  171. Y7=(Y8+YE)*DEMI
  172. Z7=(Z8+ZE)*DEMI
  173. D7=(D8+DE)*DEMI
  174. CALL CREPO2(X7,Y7,Z7,D7,IP7)
  175. IPT1.NUM(2,NBELEM)=IP7
  176. END IF
  177. DO 22 I=1,(NBELEM-1)
  178. IPT1.ICOLOR(I)=IDCOUL
  179. DO 22 J=1,NBNOEU
  180. IPT1.NUM(J,I)=NUM(J,I)
  181. 22 CONTINUE
  182. * END DO
  183. * END DO
  184. SEGDES,IPT1
  185. ELSE
  186. *
  187. * LE POINT E EST PROCHE DU POINT 8
  188. *
  189. NBELEM = NBELEM - 1
  190. IF (NBELEM.LE.0) THEN
  191. * RAYON TROP GRAND
  192. CALL ERREUR(399)
  193. RETURN
  194. END IF
  195. *
  196. DE = D8
  197. CALL MODPOI (XE,YE,ZE,DE,IPE)
  198. SEGINI,IPT1
  199. IPT1.ITYPEL=ITYPLM
  200. NL1=IPT1
  201. IPT1.NUM(NBNOEU,NBELEM)=IPE
  202. IPT1.NUM(1,NBELEM)=NUM(1,NBELEM)
  203. IPT1.ICOLOR(NBELEM)=IDCOUL
  204. IF (NBNOEU.EQ.3) THEN
  205. IP6=NUM(1,NBELEM)
  206. CALL EXCOO1(IP6,X6,Y6,Z6,D6)
  207. X7=(XE+X6)*DEMI
  208. Y7=(YE+Y6)*DEMI
  209. Z7=(ZE+Z6)*DEMI
  210. D7=(DE+D6)*DEMI
  211. CALL CREPO2(X7,Y7,Z7,D7,IP7)
  212. IPT1.NUM(2,NBELEM)=IP7
  213. END IF
  214. DO 32 I=1,(NBELEM-1)
  215. IPT1.ICOLOR(I)=IDCOUL
  216. DO 32 J=1,NBNOEU
  217. IPT1.NUM(J,I)=NUM(J,I)
  218. 32 CONTINUE
  219. * END DO
  220. * END DO
  221. SEGDES,IPT1
  222. END IF
  223. END IF
  224. SEGDES,MELEME
  225. *
  226. END
  227.  
  228.  
  229.  
  230.  
  231.  
  232.  
  233.  
  234.  
  235.  
  236.  

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