Télécharger crech3.eso

Retour à la liste

Numérotation des lignes :

  1. C CRECH3 SOURCE PV 16/11/17 21:58:55 9180
  2. SUBROUTINE CRECH3(KTRAV,KCHPOI,NND,MRIGID)
  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. IMPLICIT REAL*8(A-H,O-Z)
  34. -INC CCOPTIO
  35. -INC SMCHPOI
  36. -INC SMELEME
  37. -INC TMTRAV
  38. -INC SMRIGID
  39. -INC SMMATRI
  40. SEGMENT NTRAV
  41. INTEGER IDEJ(NNIN),INO(NNNOE),IBINN(NNNOE,N25),IVA(NNIN)
  42. INTEGER ICO(NNNOE),ipoinc(nnin)
  43. ENDSEGMENT
  44. SEGMENT,ILO(0)
  45. SEGMENT,IPE(0)
  46. segact,mrigid*mod
  47. MMATRI=ICHOLE
  48. SEGACT MMATRI
  49. mimik=iimik
  50. midua=iidua
  51. NN25=25
  52. MTRAV=KTRAV
  53. SEGACT,MTRAV
  54. NNIN=INCO(/2)
  55. NNNOE=IBIN(/2)
  56. N25=(NNIN+NN25-1)/NN25
  57. SEGINI,NTRAV
  58. * on recherche dans quelle position est inco par rapport à mimik
  59. itrouv=0
  60. do ia=1,imik(/2)
  61. do ib=1,nnin
  62. if( inco( ib).eq.imik(ia) )then
  63. itrouv=1
  64. ipoinc(ib)=ia
  65. endif
  66. enddo
  67. enddo
  68. C
  69. C **** CREATION DU TABLEAU IBINN. CE TABLEAU PERMET DE REGROUPER
  70. C **** LES INFORMATIONS DE IBIN DE MANIERE A TESTER RAPIDEMENT
  71. C **** SI 2 NOEUDS ONT LES MEMES INCONNUES.
  72. C
  73. J=0
  74. K=1
  75. IO=1
  76. DO 49 I=1,NNIN
  77. J=J+1
  78. IVA(I)=IO
  79. IO=IO*2
  80. IF(J.LT.NN25) GO TO 49
  81. IO=1
  82. J=0
  83. 49 CONTINUE
  84. maxinc=0
  85. DO 51 I=1,NNNOE
  86. K=0
  87. maxinl=0
  88. DO 510 L=1,N25
  89. L1=1+(L-1)*NN25
  90. L2=L*NN25
  91. L2=MIN(L2,NNIN)
  92. IAFS=0
  93. DO 52 J=L1,L2
  94. IF(IBIN(J,I).EQ.0) GO TO 52
  95. K=L
  96. maxinl=maxinl+1
  97. JJ=J-(L-1)*NN25
  98. IAFS=IAFS+IVA(JJ)
  99. 52 CONTINUE
  100. IBINN(I,L)=IAFS
  101. 510 CONTINUE
  102. ICO(I)=K
  103. maxinc=max(maxinc,maxinl)
  104. 51 CONTINUE
  105. C
  106. C **** CLASSEMENT DES NOEUDS PAR TYPES. ON REMPLIT LE TABLEAU INO.
  107. C **** DEUX NOEUDS ONT LE MEME TYPE S'ILS ONT LES MEMES INCONNUES.
  108. C **** INO(I)=J VEUT DIRE QUE LE I EME NOEUD EST DE TYPE J.
  109. C **** N DONNE LE NOMBRE DE TYPES DE NOEUD DIFFERENTS.
  110. C
  111. N=0
  112. SEGINI,ILO,IPE
  113. NTROUV=0
  114. DO 53 IDEB=1,NNNOE
  115. IF(ICO(IDEB).NE.0) GO TO 54
  116. 53 CONTINUE
  117. GO TO 540
  118. 54 CONTINUE
  119. 3 CONTINUE
  120. N=N+1
  121. IPE(**)=IDEB
  122. ITES=IDEB
  123. KK=0
  124. DO 1 I=IDEB,NNNOE
  125. DO 2 J=1,N25
  126. IF(IBINN(I,J).NE.IBINN(ITES,J)) GO TO 1
  127. 2 CONTINUE
  128. KK=KK+1
  129. INO(I)=N
  130. ICO(I)=0
  131. 1 CONTINUE
  132. ILO(**)=KK
  133. NTROUV=NTROUV+KK
  134. IF(NTROUV.NE.NNNOE) THEN
  135. DO 4 IDEB=1,NNNOE
  136. IF(ICO(IDEB).NE.0) GO TO 3
  137. 4 CONTINUE
  138. ENDIF
  139. C
  140. C **** ON CONNAIT LE NOMBRE DE SOUS CHAMPS
  141. C **** ON INITIALISE LE SEGMENT MCHPOIN
  142. C
  143. C
  144. 540 CONTINUE
  145.  
  146. NSOUPO=N
  147. idimve=nnd
  148. segini mvecri
  149. NAT=1
  150. SEGINI,MCHPOI
  151. IFOPOI=IFOMOD
  152. JATTRI(1) = 0
  153. MTYPOI=' '
  154. MOCHDE=' CHPOINT CREE PAR CRECH3'
  155. C
  156. C **** ON VA FABRIQUER LES SEGMENTS MSOUPO POUR LES REMPLIR IL FAUT
  157. C **** CONNAITRE LES INCONNUES DU SOUS CHAMPS ET L'OBJET GEOMETRIQUE
  158. C **** SUPPORT
  159. C
  160. IF(NSOUPO.EQ.0) THEN
  161. KCHPOI=MCHPOI
  162. SEGDES,MCHPOI
  163. SEGSUP,NTRAV
  164. SEGDES,MTRAV
  165. SEGSUP ILO,IPE
  166. RETURN
  167. ENDIF
  168. DO 100 I=1,NSOUPO
  169. C
  170. C **** ON CHERCHE D'ABORD LA LISTE DES INCONNUES A PARTIR DE LA
  171. C **** VALEUR DE IBINN ET ON REMPLIT NOCOMP
  172. C
  173. IHK=IPE(I)
  174. NC=0
  175. DO 20 JK=1,NNIN
  176. IF(IBIN(JK,IHK).EQ.0) GO TO 20
  177. NC=NC+1
  178. IDEJ(NC)=JK
  179. 20 CONTINUE
  180. SEGINI,MSOUPO
  181. IPCHP(I)=MSOUPO
  182. IB=0
  183. DO 14 J=1,NC
  184. NOHARM(J)=NHAR(IDEJ(J))
  185. naminc(i,j)=imik(IPOINC(idej(j)))
  186. namdua(i,j)=idua(ipoinc(idej(j)))
  187. NUMHAR(i,j)=NOHARM(J)
  188. 14 NOCOMP(J)=INCO(IDEJ(J))
  189. C
  190. C **** ON CHERCHE COMBIEN DE NOEUD DANS L'OBJET MELEME,ON LE CREE
  191. C
  192. NBSOUS=0
  193. NBREF=0
  194. NBNN=1
  195. NBELEM=ILO(I)
  196. N=NBELEM
  197. SEGINI,MPOVAL
  198. SEGINI,MELEME
  199. numnom(I)=nc
  200. numnoe(i)=n
  201. ITYPEL=1
  202. IC=0
  203. DO 16 J=1,NNNOE
  204. IF(INO(J).NE.I) GO TO 16
  205. IC=IC+1
  206. NUM(1,IC)=IGEO(J)
  207. DO 18 K=1,NC
  208. IO=IDEJ(K)
  209. VPOCHA(IC,K)=BB(IO,J)
  210. ikk=ibin(io,j)
  211. numzon(ikk)=i
  212. nunolo(ikk)=ic
  213. nuinlo(ikk)=k
  214. 18 CONTINUE
  215. 16 CONTINUE
  216. call crech1(meleme,1)
  217. melzon(i)=meleme
  218. IGEOC=MELEME
  219. IPOVAL=MPOVAL
  220. SEGDES,MPOVAL
  221. SEGDES,MSOUPO
  222. SEGDES,MELEME
  223. 100 CONTINUE
  224. SEGSUP,ILO,IPE
  225. KCHPOI=MCHPOI
  226. ivecri=mvecri
  227. segdes mvecri
  228. SEGDES,MCHPOI
  229. SEGSUP,NTRAV
  230. RETURN
  231. END
  232.  
  233.  
  234.  
  235.  
  236.  
  237.  
  238.  
  239.  
  240.  

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