Télécharger elftr2.eso

Retour à la liste

Numérotation des lignes :

  1. C ELFTR2 SOURCE CHAT 05/01/12 23:32:48 5004
  2. SUBROUTINE ELFTR2(MATTAC,KNREFE)
  3. IMPLICIT INTEGER(I-N)
  4. IMPLICIT REAL*8(A-H,O-Z)
  5. C
  6. C ====================================================================
  7. C = APPELE PAR ELFE =
  8. C = REGROUPEMENT DES JONCTIONS RELIEES PAR DES ELEMENTS RIGIDES EN =
  9. C = UNE SEULE =
  10. C = CREATION : 22/07/87 =
  11. C = PROGRAMMEUR : GUILBAUD =
  12. C ====================================================================
  13. C
  14. -INC CCOPTIO
  15. -INC SMATTAC
  16. C
  17. SEGMENT MNREFE
  18. INTEGER NREFE(8,NSTR)
  19. INTEGER NTANBN
  20. INTEGER NIDNCN
  21. INTEGER NTVN
  22. POINTEUR NREPA.MPASS
  23. POINTEUR NRECA.MCARA
  24. POINTEUR NRENO.MNORM
  25. POINTEUR NRECPR.ICPR
  26. POINTEUR NREMEL.MELEME
  27. POINTEUR NREDEN.MDEN
  28. ENDSEGMENT
  29. C
  30. C NSTR : NOMBRE D'ELEMENTS
  31. C NREFE(1,I) : MELEME
  32. C NREFE(2,I) : MSOSTU
  33. C NREFE(3,I) : TYPE DE L'ELEMENT
  34. C NREFE(4,I) : NOMBRE DE POINTS DU MELEME
  35. C NREFE(5,I) : NOMBRE DE DDL PAR POINT
  36. C NREFE(6,I)=IVN :LE 1ER DDL DE L'ELEMENT EST LE IVN+1 IEME DE VN
  37. C NREFE(7,I)=IAN :LE 1ER TERME DE LA MATRICE A EST LE IAN IEME DE ANBN
  38. C NREFE(8,I)= 1 :LE IEME ELEMENT EST RIGIDE (OU PARTIELLEMENT) SINON 0
  39. C NTANBN : NOMBRE DE TERMES DES MATRICES A ET B POUR TOUS LES ELEMENTS
  40. C NIDNCN : NOMBRE TOTAL D'INCONNUES DE DNCN
  41. C NTVN : LONGUEUR DU TABLEAU VN
  42. C
  43. SEGMENT /JTRAI/(ITRAI(NN))
  44. SEGMENT /JTRAL/(ITRAL(NSOUMA))
  45. SEGMENT /JDEJL/(IDEJL(NSOUMA))
  46. SEGMENT /JDEJA/(IDEJA(NN))
  47. SEGMENT /JTRAV/(ITRAV(NN))
  48. C
  49. WRITE(IOIMP,*) ' DEBUT DE ELFTR2 '
  50. C
  51. MNREFE=KNREFE
  52. NSTR=NREFE(/2)
  53. NN=NSTR
  54. SEGINI JTRAV
  55. NN=0
  56. DO 10 N=1,NSTR
  57. IF(NREFE(8,N).EQ.1) THEN
  58. NN=NN+1
  59. ITRAV(NN)=NREFE(2,N)
  60. ENDIF
  61. 10 CONTINUE
  62. IF(NN.EQ.0) THEN
  63. SEGSUP JTRAV
  64. RETURN
  65. ENDIF
  66. SEGADJ JTRAV
  67. SEGINI JDEJA
  68. SEGINI JTRAI
  69. DO 9 I=1,NN
  70. IDEJA(I)=0
  71. 9 CONTINUE
  72. SEGACT MATTAC
  73. NSOUMA=LISATT(/1)
  74. SEGINI JDEJL,JTRAL
  75. DO 11 I=1,NSOUMA
  76. IDEJL(I)=0
  77. 11 CONTINUE
  78. N=NSOUMA
  79. SEGINI MATTA1
  80. C
  81. C BOUCLE SUR LES ELEMENTS RIGIDES
  82. C
  83. NKK=0
  84. DO 130 NE=1,NN
  85. IF(IDEJA(NE).EQ.0) THEN
  86. WRITE(IOIMP,*) ' ELEMENT RIGIDE NE = ',NE
  87. NI1=1
  88. NI2=1
  89. ITRAI(NI1)=NE
  90. NLL=0
  91. NL1=1
  92. IDEJA(NE)=1
  93. 15 CONTINUE
  94. C
  95. C 1 - RECHERCHE DE TOUTES LES NOUVELLES LIAISONS QUI S'APPUIENT SUR
  96. C LES DERNIERS ELEMENTS RIGIDES TROUVES
  97. C
  98. DO 60 NI=NI1,NI2
  99. NK=ITRAI(NI)
  100. MSOST1=ITRAV(NK)
  101. IDEJA(NK)=1
  102. DO 40 NSOU=1,NSOUMA
  103. IF(IDEJL(NSOU).EQ.0) THEN
  104. MSOUMA=LISATT(NSOU)
  105. SEGACT MSOUMA
  106. NJON=IATREL(/1)
  107. DO 30 NJ=1,NJON
  108. MJONCT=IATREL(NJ)
  109. SEGACT MJONCT
  110. NTJ=ISTRJO(/1)
  111. DO 20 J=1,NTJ
  112. MSOSTU=ISTRJO(J)
  113. IF(MSOSTU.EQ.MSOST1) THEN
  114. NLL=NLL+1
  115. ITRAL(NLL)=NSOU
  116. SEGDES MJONCT,MSOUMA
  117. IDEJL(NSOU)=1
  118. GOTO 40
  119. ENDIF
  120. 20 CONTINUE
  121. SEGDES MJONCT
  122. 30 CONTINUE
  123. SEGDES MSOUMA
  124. ENDIF
  125. 40 CONTINUE
  126. 60 CONTINUE
  127. WRITE(IOIMP,*) ' NI1 NI2 ',NI1,NI2
  128. WRITE(IOIMP,*) ' ITRAL ',(ITRAL(NLLL),NLLL=1,NLL)
  129. WRITE(IOIMP,*) ' IDEJA ',(IDEJA(NLLL),NLLL=1,NN)
  130. C
  131. C 2 - RECHERCHE DE TOUS LES NOUVEAUX ELEMENTS RIGIDES SUR LESQUELS
  132. C S'APPUIENT LES DERNIERES LIAISONS TROUVEES
  133. C
  134. DO 100 NL=NL1,NLL
  135. NSOU=ITRAL(NL)
  136. MSOUMA=LISATT(NSOU)
  137. SEGACT MSOUMA
  138. NJON=IATREL(/1)
  139. DO 90 NJ=1,NJON
  140. MJONCT=IATREL(NJ)
  141. SEGACT MJONCT
  142. NTJ=ISTRJO(/1)
  143. DO 80 J=1,NTJ
  144. MSOSTU=ISTRJO(J)
  145. DO 70 KK=1,NN
  146. IF(IDEJA(KK).EQ.0.AND.MSOSTU.EQ.ITRAV(KK)) THEN
  147. NI=NI+1
  148. ITRAI(NI)=KK
  149. IDEJA(KK)=1
  150. GOTO 80
  151. ENDIF
  152. 70 CONTINUE
  153. 80 CONTINUE
  154. SEGDES MJONCT
  155. 90 CONTINUE
  156. SEGDES MSOUMA
  157. C IDEJL(NSOU)=1
  158. 100 CONTINUE
  159. WRITE(IOIMP,*) ' NL1 NLL ',NL1,NLL
  160. WRITE(IOIMP,*) ' ITRAI ',(ITRAI(NLLL),NLLL=1,NI)
  161. WRITE(IOIMP,*) ' IDEJL ',(IDEJL(NLLL),NLLL=1,NSOUMA)
  162. NL1=NLL+1
  163. NI1=NI2+1
  164. IF(NI2.GE.NI1) GOTO 15
  165. M=0
  166. N=0
  167. SEGINI MSOUM1
  168. MSOUM1.IGEOCH=0
  169. MSOUM1.IPHYCH=0
  170. MSOUM1.ITYATT='MECA'
  171. NJJ=0
  172. DO 120 NL=1,NLL
  173. NSOU=ITRAL(NL)
  174. MSOUMA=LISATT(NSOU)
  175. SEGACT MSOUMA
  176. NJON=IATREL(/1)
  177. N=NJJ+NJON
  178. SEGADJ MSOUM1
  179. DO 110 NJ=1,NJON
  180. NJJ=NJJ+1
  181. MSOUM1.IATREL(NJJ)=IATREL(NJ)
  182. 110 CONTINUE
  183. SEGSUP MSOUMA
  184. 120 CONTINUE
  185. SEGDES MSOUM1
  186. NKK=NKK+1
  187. MATTA1.LISATT(NKK)=MSOUM1
  188. ENDIF
  189. 130 CONTINUE
  190. DO 140 NSOU=1,NSOUMA
  191. IF(IDEJL(NSOU).EQ.0) THEN
  192. NKK=NKK+1
  193. MATTA1.LISATT(NKK)=LISATT(NSOU)
  194. ENDIF
  195. 140 CONTINUE
  196. N=NKK
  197. SEGADJ MATTA1
  198. SEGSUP MATTAC,JTRAL,JDEJL,JDEJA,JTRAV,JTRAI
  199. MATTAC=MATTA1
  200. C
  201. IF(IIMPI.EQ.1) THEN
  202. WRITE(IOIMP,105) MATTAC
  203. 105 FORMAT(/,10X,' CREATION DE L''OBJET ATTACHE ',I4///)
  204. NATTA=LISATT(/1)
  205. WRITE(IOIMP,101)
  206. 101 FORMAT(10X,28('*'))
  207. WRITE(IOIMP,102)
  208. 102 FORMAT(10X,'* MSOUMA * ITYATT * IATREL *')
  209. WRITE(IOIMP,101)
  210. DO 160 IL=1,NATTA
  211. MSOUMA=LISATT(IL)
  212. SEGACT MSOUMA
  213. WRITE(IOIMP,103) MSOUMA,ITYATT,IATREL(1)
  214. 103 FORMAT(10X,'* ',I4,' * ',A4,' * ',I4,' * ')
  215. NRELA=IATREL(/1)
  216. DO 150 IN=2,NRELA
  217. WRITE(IOIMP,104) IATREL(IN)
  218. 104 FORMAT(10X,2('* '),'* ',I4,' *')
  219. 150 CONTINUE
  220. SEGDES MSOUMA
  221. WRITE(IOIMP,101)
  222. 160 CONTINUE
  223. ENDIF
  224. SEGDES MATTAC
  225. WRITE(IOIMP,*) ' FIN DE ELFTR2 '
  226. RETURN
  227. END
  228.  
  229.  

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