Télécharger elftri.eso

Retour à la liste

Numérotation des lignes :

  1. C ELFTRI SOURCE CHAT 05/01/12 23:32:53 5004
  2. SUBROUTINE ELFTRI(MATTAC,KNREFE,MATTA1)
  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 LIAISONS ELEMENTAIRES CONSTITUANT UNE JONCTION =
  9. C = CREATION : 22/07/87 =
  10. C = PROGRAMMEUR : GUILBAUD =
  11. C ====================================================================
  12. C
  13. -INC CCOPTIO
  14. -INC SMATTAC
  15. -INC SMELEME
  16. -INC SMCHPOI
  17. -INC SMCOORD
  18. C
  19. SEGMENT MNREFE
  20. INTEGER NREFE(7,NSTR)
  21. INTEGER NTANBN
  22. INTEGER NIDNCN
  23. INTEGER NTVN
  24. POINTEUR NREPA.MPASS
  25. POINTEUR NRECA.MCARA
  26. POINTEUR NRENO.MNORM
  27. POINTEUR NRECPR.ICPR
  28. POINTEUR NREMEL.MELEME
  29. POINTEUR NREMAT.MATGRE
  30. ENDSEGMENT
  31. C
  32. C NSTR : NOMBRE D'ELEMENTS
  33. C NREFE(1,I) : MELEME
  34. C NREFE(2,I) : MSOSTU
  35. C NREFE(3,I) : TYPE DE L'ELEMENT
  36. C NREFE(4,I) : NOMBRE DE POINTS DU MELEME
  37. C NREFE(5,I) : NOMBRE DE DDL PAR POINT
  38. C NREFE(6,I)=IVN :LE 1ER DDL DE L'ELEMENT EST LE IVN+1 IEME DE VN
  39. C NREFE(7,I)=IAN :LE 1ER TERME DE LA MATRICE A EST LE IAN IEME DE ANBN
  40. C NTANBN : NOMBRE DE TERMES DES MATRICES A ET B POUR TOUS LES ELEMENTS
  41. C NIDNCN : NOMBRE TOTAL D'INCONNUES DE DNCN
  42. C NTVN : LONGUEUR DU TABLEAU VN
  43. C
  44. SEGMENT ICPR(XCOOR(/1)/(IDIM+1))
  45. SEGMENT /JTRAK/(ITRAK(NJONT))
  46. SEGMENT /JTRAJ/(ITRAJ(NJONT))
  47. SEGMENT /JDEJA/(IDEJA(NBPTOT))
  48. SEGMENT /JTRAS/(ITRAS(NBPTOT))
  49. C
  50. WRITE(IOIMP,*) ' DEBUT DE ELFTRI '
  51. C
  52. SEGACT MCOORD
  53. SEGINI ICPR
  54. MNREFE=KNREFE
  55. MELEME=NREMEL
  56. SEGACT MELEME
  57. NBPTOT=NUM(/2)
  58. SEGINI JDEJA,JTRAS
  59. DO 5 NBP=1,NBPTOT
  60. ICPR(NUM(1,NBP))=NBP
  61. IDEJA(NBP)=0
  62. ITRAS(NBP)=0
  63. 5 CONTINUE
  64. C
  65. SEGACT MATTAC
  66. NSOUMA=LISATT(/1)
  67. NJONT=0
  68. NJONP=0
  69. SEGINI JTRAJ,JTRAK
  70. DO 20 NSOU=1,NSOUMA
  71. MSOUMA=LISATT(NSOU)
  72. SEGACT MSOUMA
  73. NJON=IATREL(/1)
  74. NJONT=NJONT+NJON
  75. SEGADJ JTRAJ
  76. SEGADJ JTRAK
  77. DO 10 NJ=1,NJON
  78. ITRAJ(NJONP+NJ)=IATREL(NJ)
  79. ITRAK(NJONP+NJ)=0
  80. 10 CONTINUE
  81. SEGDES MSOUMA
  82. NJONP=NJONT
  83. 20 CONTINUE
  84. SEGDES MATTAC
  85. C
  86. N=NJONT
  87. M=0
  88. SEGINI MATTA1
  89. NSOU=0
  90. DO 70 NBP=1,NBPTOT
  91. C RECHERCHE SUR LES POINTS DONT L'APPARTENANCE AUX LIAISONS N'EST PAS
  92. C ENCORE ETABLIE
  93. IF(IDEJA(NBP).EQ.0) THEN
  94. NI=0
  95. NSOU=NSOU+1
  96. N=NJONT
  97. SEGINI MSOUMA
  98. MATTA1.LISATT(NSOU)=MSOUMA
  99. NV=1
  100. NVV=1
  101. ITRAS(1)=NUM(1,NBP)
  102. IDEJA(NBP)=1
  103. C RECHERCHE SUR LES POINTS DEJA CONNUS D'UNE JONCTION POUR TROUVER
  104. C TOUTES LES LIAISONS ELEMENTAIRES DE CETTE JONCTION
  105. 100 CONTINUE
  106. IKI=ITRAS(NV)
  107. C
  108. DO 60 NJ=1,NJONT
  109. C RECHERCHE SUR LES LIAISONS ELEMENTAIRES NON DEJA TROUVEES
  110. IF(ITRAK(NJ).EQ.0) THEN
  111. MJONCT=ITRAJ(NJ)
  112. SEGACT MJONCT
  113. NCHP=IPCHJO(/1)
  114. DO 55 NFOIS=1,2
  115. DO 50 NST=1,NCHP
  116. MCHPOI=IPCHJO(NST)
  117. SEGACT MCHPOI
  118. NSOUPO=IPCHP(/1)
  119. DO 40 NS=1,NSOUPO
  120. MSOUPO=IPCHP(NS)
  121. SEGACT MSOUPO
  122. IPT1=IGEOC
  123. SEGACT IPT1
  124. NBELEM=IPT1.NUM(/2)
  125. IF(NFOIS.EQ.1) THEN
  126. C NFOIS=1 ON RECHERCHE SI LA LIAISON ELEMENTAIRE PORTE SUR LE POINT
  127. DO 30 NB=1,NBELEM
  128. IKI1=IPT1.NUM(1,NB)
  129. IF(IKI1.EQ.IKI) GOTO 55
  130. 30 CONTINUE
  131. ELSE
  132. C NFOIS=2 ON RASSEMBLE TOUS LES POINTS CONCERNES PAR CETTE LIAISON
  133. DO 35 NBB=1,NBELEM
  134. IKI2=IPT1.NUM(1,NBB)
  135. IPP=ICPR(IKI2)
  136. IF(IDEJA(IPP).EQ.0) THEN
  137. NVV=NVV+1
  138. ITRAS(NVV)=IKI2
  139. IDEJA(IPP)=1
  140. ENDIF
  141. 35 CONTINUE
  142. ENDIF
  143. SEGDES MSOUPO,IPT1
  144. 40 CONTINUE
  145. SEGDES MCHPOI
  146. 50 CONTINUE
  147. IF(NFOIS.EQ.1) GOTO 57
  148. ITRAK(NJ)=NSOU
  149. NI=NI+1
  150. IATREL(NI)=ITRAJ(NJ)
  151. 55 CONTINUE
  152. 57 CONTINUE
  153. SEGDES MJONCT
  154. ENDIF
  155. 60 CONTINUE
  156. C
  157. NV=NV+1
  158. IF(NV.LE.NVV) GOTO 100
  159. C
  160. IF(NI.EQ.0) THEN
  161. C *** LE POINT N'APPARTIENT PAS AUX LIAISONS
  162. INTERR(1)=NUM(1,NBP)
  163. CALL ERREUR(383)
  164. SEGSUP JTRAK,JTRAJ,JDEJA,JTRAS,ICPR
  165. NSOU1=NSOU-1
  166. DO 65 NS=1,NSOU1
  167. MSOUMA=MATTA1.LISATT(NS)
  168. IF(MSOUMA.NE.0) SEGSUP MSOUMA
  169. 65 CONTINUE
  170. SEGSUP MATTA1
  171. MATTA1=0
  172. RETURN
  173. ELSE
  174. N=NI
  175. SEGADJ MSOUMA
  176. IGEOCH=0
  177. IPHYCH=0
  178. ITYATT='MECA'
  179. SEGDES MSOUMA
  180. ENDIF
  181. ENDIF
  182. 70 CONTINUE
  183. C
  184. N=NSOU
  185. SEGADJ MATTA1
  186. C
  187. IF(IIMPI.EQ.1) THEN
  188. WRITE(IOIMP,105) MATTA1
  189. 105 FORMAT(/,10X,' CREATION DE L''OBJET ATTACHE ',I4///)
  190. NATTA=MATTA1.LISATT(/1)
  191. WRITE(IOIMP,101)
  192. 101 FORMAT(10X,28('*'))
  193. WRITE(IOIMP,102)
  194. 102 FORMAT(10X,'* MSOUMA * ITYATT * IATREL *')
  195. WRITE(IOIMP,101)
  196. DO 90 IL=1,NATTA
  197. MSOUMA=MATTA1.LISATT(IL)
  198. SEGACT MSOUMA
  199. WRITE(IOIMP,103) MSOUMA,ITYATT,IATREL(1)
  200. 103 FORMAT(10X,'* ',I4,' * ',A4,' * ',I4,' * ')
  201. NRELA=IATREL(/1)
  202. DO 80 IN=2,NRELA
  203. WRITE(IOIMP,104) IATREL(IN)
  204. 104 FORMAT(10X,2('* '),'* ',I4,' *')
  205. 80 CONTINUE
  206. SEGDES MSOUMA
  207. WRITE(IOIMP,101)
  208. 90 CONTINUE
  209. ENDIF
  210. SEGDES MATTA1
  211. SEGSUP JTRAJ,JDEJA,ICPR,JTRAS,JTRAK
  212. WRITE(IOIMP,*) ' FIN DE ELFTRI '
  213. RETURN
  214. END
  215.  
  216.  

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