Télécharger crechp.eso

Retour à la liste

Numérotation des lignes :

  1. C CRECHP SOURCE PV 15/04/01 21:15:03 8452
  2. SUBROUTINE CRECHP(KTRAV,KCHPOI)
  3. C
  4. C
  5. C
  6. C ******** CE SUBROUTINE SERT A CREER UN CHAMP POINT A PARTIR
  7. C ******** D'UN SEGMENT MTRAV.
  8. C
  9. C ******** INCO(NNIN) CONTIENT LE NOMS DES NNIN INCONNUES DIFFERENTES.
  10. C
  11. C ******** BB(I,J) EST LA VALEUR DE LA IEME INCONNUE DU CHAMP POUR
  12. C ******** LE JEME NOEUD DU TABLEAU IGEO.
  13. C
  14. C ******** IBIN(I,J)=1 OU 0. 1 INDIQUE QUE LA I EME INCONNUE DU CHAMP
  15. C ******** EXISTE POUR LE J EME NOEUD DU TABLEAU IGEO.
  16. C
  17. C ******** IGEO(I) EST LE NUMERO A METTRE DANS UN OBJET MELEME POUR
  18. C ******** REFERENCER LE IEME NOEUD
  19. C
  20. C ******** NHAR(I) EST LE NUMERO D'HARMONIQUE SI CALCUL AXI OU
  21. C ******** SIGNIFIE CONTRAINTE PLANE,DEFORMATION PLANE OU DEF PLAN GEN
  22. C
  23. C ******** ATTENTION ATTENTION ATTENTION IL EXISTE UNE VARIABLE
  24. C ******** POUVANT DEPENDRE DE LA MACHINE. NN25 EST SUPPOSE SUFFISAMENT
  25. C ******** PETIT POUR QUE 2**NN25 SOIT UN ENTIER POSSIBLE.
  26. C
  27. C
  28. C *** POUR PLUS DE RENSEIGNEMENTS VOIR CHARRAS.
  29. C
  30. C
  31. C
  32. IMPLICIT INTEGER(I-N)
  33. -INC CCOPTIO
  34. -INC SMCHPOI
  35. -INC SMELEME
  36. -INC TMTRAV
  37. SEGMENT/NTRAV/(IDEJ(NNIN),INO(NNNOE),IBINN(NNNOE,N25),IVA(NNIN),
  38. 1 ICO(NNNOE))
  39. SEGMENT,ILO(0)
  40. SEGMENT,IPE(0)
  41. NN25=25
  42. MTRAV=KTRAV
  43. SEGACT,MTRAV
  44. NNIN=INCO(/2)
  45. NNNOE=IBIN(/2)
  46. N25=(NNIN+NN25-1)/NN25
  47. SEGINI,NTRAV
  48. C
  49. C **** CREATION DU TABLEAU IBINN. CE TABLEAU PERMET DE REGROUPER
  50. C **** LES INFORMATIONS DE IBIN DE MANIERE A TESTER RAPIDEMENT
  51. C **** SI 2 NOEUDS ONT LES MEMES INCONNUES.
  52. C
  53. J=0
  54. K=1
  55. IO=1
  56. DO 49 I=1,NNIN
  57. J=J+1
  58. IVA(I)=IO
  59. IO=IO*2
  60. IF(J.LT.NN25) GO TO 49
  61. IO=1
  62. J=0
  63. 49 CONTINUE
  64. DO 51 I=1,NNNOE
  65. K=0
  66. DO 510 L=1,N25
  67. L1=1+(L-1)*NN25
  68. L2=L*NN25
  69. L2=MIN(L2,NNIN)
  70. IAFS=0
  71. DO 52 J=L1,L2
  72. IF(IBIN(J,I).EQ.0) GO TO 52
  73. K=L
  74. JJ=J-(L-1)*NN25
  75. IAFS=IAFS+IVA(JJ)
  76. 52 CONTINUE
  77. IBINN(I,L)=IAFS
  78. 510 CONTINUE
  79. ICO(I)=K
  80. 51 CONTINUE
  81. C
  82. C **** CLASSEMENT DES NOEUDS PAR TYPES. ON REMPLIT LE TABLEAU INO.
  83. C **** DEUX NOEUDS ONT LE MEME TYPE S'ILS ONT LES MEMES INCONNUES.
  84. C **** INO(I)=J VEUT DIRE QUE LE I EME NOEUD EST DE TYPE J.
  85. C **** N DONNE LE NOMBRE DE TYPES DE NOEUD DIFFERENTS.
  86. C
  87. N=0
  88. SEGINI,ILO,IPE
  89. NTROUV=0
  90. DO 53 IDEB=1,NNNOE
  91. IF(ICO(IDEB).NE.0) GO TO 54
  92. 53 CONTINUE
  93. GO TO 540
  94. 54 CONTINUE
  95. 3 CONTINUE
  96. N=N+1
  97. IPE(**)=IDEB
  98. ITES=IDEB
  99. KK=0
  100. DO 1 I=IDEB,NNNOE
  101. DO 2 J=1,N25
  102. IF(IBINN(I,J).NE.IBINN(ITES,J)) GO TO 1
  103. 2 CONTINUE
  104. KK=KK+1
  105. INO(I)=N
  106. ICO(I)=0
  107. 1 CONTINUE
  108. ILO(**)=KK
  109. NTROUV=NTROUV+KK
  110. IF(NTROUV.NE.NNNOE) THEN
  111. DO 4 IDEB=1,NNNOE
  112. IF(ICO(IDEB).NE.0) GO TO 3
  113. 4 CONTINUE
  114. ENDIF
  115. C
  116. C **** ON CONNAIT LE NOMBRE DE SOUS CHAMPS
  117. C **** ON INITIALISE LE SEGMENT MCHPOIN
  118. C
  119. C
  120. 540 CONTINUE
  121. NSOUPO=N
  122. NAT=1
  123. SEGINI,MCHPOI
  124. IFOPOI=IFOMOD
  125. JATTRI(1) = 0
  126. MTYPOI=' '
  127. MOCHDE=' CHPOINT CREE PAR CRECHP'
  128. C
  129. C **** ON VA FABRIQUER LES SEGMENTS MSOUPO POUR LES REMPLIR IL FAUT
  130. C **** CONNAITRE LES INCONNUES DU SOUS CHAMPS ET L'OBJET GEOMETRIQUE
  131. C **** SUPPORT
  132. C
  133. IF(NSOUPO.EQ.0) THEN
  134. KCHPOI=MCHPOI
  135. SEGDES,MCHPOI
  136. SEGSUP,NTRAV
  137. SEGDES,MTRAV
  138. SEGSUP ILO,IPE
  139. RETURN
  140. ENDIF
  141. DO 100 I=1,NSOUPO
  142. C
  143. C **** ON CHERCHE D'ABORD LA LISTE DES INCONNUES A PARTIR DE LA
  144. C **** VALEUR DE IBINN ET ON REMPLIT NOCOMP
  145. C
  146. IHK=IPE(I)
  147. NC=0
  148. DO 20 JK=1,NNIN
  149. IF(IBIN(JK,IHK).EQ.0) GO TO 20
  150. NC=NC+1
  151. IDEJ(NC)=JK
  152. 20 CONTINUE
  153. SEGINI,MSOUPO
  154. IPCHP(I)=MSOUPO
  155. IB=0
  156. DO 14 J=1,NC
  157. NOHARM(J)=NHAR(IDEJ(J))
  158. 14 NOCOMP(J)=INCO(IDEJ(J))
  159. C
  160. C **** ON CHERCHE COMBIEN DE NOEUD DANS L'OBJET MELEME,ON LE CREE
  161. C
  162. NBSOUS=0
  163. NBREF=0
  164. NBNN=1
  165. NBELEM=ILO(I)
  166. N=NBELEM
  167. SEGINI,MPOVAL
  168. SEGINI,MELEME
  169. ITYPEL=1
  170. IC=0
  171. DO 16 J=1,NNNOE
  172. IF(INO(J).NE.I) GO TO 16
  173. IC=IC+1
  174. NUM(1,IC)=IGEO(J)
  175. DO 18 K=1,NC
  176. IO=IDEJ(K)
  177. VPOCHA(IC,K)=BB(IO,J)
  178. 18 CONTINUE
  179. 16 CONTINUE
  180. call crech1(meleme,1)
  181. IGEOC=MELEME
  182. IPOVAL=MPOVAL
  183. SEGDES,MPOVAL
  184. SEGDES,MSOUPO
  185. SEGDES,MELEME
  186. 100 CONTINUE
  187. SEGSUP,ILO,IPE
  188. KCHPOI=MCHPOI
  189. SEGDES,MCHPOI
  190. SEGSUP,NTRAV
  191. SEGDES,MTRAV
  192. RETURN
  193. END
  194.  
  195.  
  196.  
  197.  
  198.  
  199.  
  200.  

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