Télécharger crechp.eso

Retour à la liste

Numérotation des lignes :

  1. C CRECHP SOURCE CB215821 19/08/20 21:16:28 10287
  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.  
  38. SEGMENT/NTRAV/(IDEJ(NNIN),INO(NNNOE),IBINN(NNNOE,N25),IVA(NNIN),
  39. 1 ICO(NNNOE))
  40. SEGMENT,ILO(0)
  41. SEGMENT,IPE(0)
  42. NN25=25
  43. MTRAV=KTRAV
  44. NNIN=INCO(/2)
  45. NNNOE=IBIN(/2)
  46. N25=(NNIN+NN25-1)/NN25
  47.  
  48. CALL oooprl(1)
  49. SEGINI,NTRAV,ILO,IPE
  50. CALL oooprl(0)
  51. C
  52. C **** CREATION DU TABLEAU IBINN. CE TABLEAU PERMET DE REGROUPER
  53. C **** LES INFORMATIONS DE IBIN DE MANIERE A TESTER RAPIDEMENT
  54. C **** SI 2 NOEUDS ONT LES MEMES INCONNUES.
  55. C
  56. J=0
  57. K=1
  58. IO=1
  59. DO 49 I=1,NNIN
  60. J=J+1
  61. IVA(I)=IO
  62. IO=IO*2
  63. IF(J.LT.NN25) GO TO 49
  64. IO=1
  65. J=0
  66. 49 CONTINUE
  67. DO 51 I=1,NNNOE
  68. K=0
  69. DO 510 L=1,N25
  70. L1=1+(L-1)*NN25
  71. L2=L*NN25
  72. L2=MIN(L2,NNIN)
  73. IAFS=0
  74. DO 52 J=L1,L2
  75. IF(IBIN(J,I).EQ.0) GO TO 52
  76. K=L
  77. JJ=J-(L-1)*NN25
  78. IAFS=IAFS+IVA(JJ)
  79. 52 CONTINUE
  80. IBINN(I,L)=IAFS
  81. 510 CONTINUE
  82. ICO(I)=K
  83. 51 CONTINUE
  84. C
  85. C **** CLASSEMENT DES NOEUDS PAR TYPES. ON REMPLIT LE TABLEAU INO.
  86. C **** DEUX NOEUDS ONT LE MEME TYPE S'ILS ONT LES MEMES INCONNUES.
  87. C **** INO(I)=J VEUT DIRE QUE LE I EME NOEUD EST DE TYPE J.
  88. C **** N DONNE LE NOMBRE DE TYPES DE NOEUD DIFFERENTS.
  89. C
  90. N=0
  91. NTROUV=0
  92. DO 53 IDEB=1,NNNOE
  93. IF(ICO(IDEB).NE.0) GO TO 54
  94. 53 CONTINUE
  95. GO TO 540
  96. 54 CONTINUE
  97. 3 CONTINUE
  98. N=N+1
  99. IPE(**)=IDEB
  100. ITES=IDEB
  101. KK=0
  102. DO 1 I=IDEB,NNNOE
  103. DO 2 J=1,N25
  104. IF(IBINN(I,J).NE.IBINN(ITES,J)) GO TO 1
  105. 2 CONTINUE
  106. KK=KK+1
  107. INO(I)=N
  108. ICO(I)=0
  109. 1 CONTINUE
  110. ILO(**)=KK
  111. NTROUV=NTROUV+KK
  112. IF(NTROUV.NE.NNNOE) THEN
  113. DO 4 IDEB=1,NNNOE
  114. IF(ICO(IDEB).NE.0) GO TO 3
  115. 4 CONTINUE
  116. ENDIF
  117. C
  118. C **** ON CONNAIT LE NOMBRE DE SOUS CHAMPS
  119. C **** ON INITIALISE LE SEGMENT MCHPOIN
  120. C
  121. C
  122. 540 CONTINUE
  123. NSOUPO=N
  124. NAT=1
  125. NBSOUS=0
  126. NBREF=0
  127. NBNN=1
  128.  
  129. C Creation du resultat par paquets
  130. CALL oooprl(1)
  131. SEGINI,MCHPOI
  132. DO I=1,NSOUPO
  133. IHK=IPE(I)
  134. NC=0
  135. DO 21 JK=1,NNIN
  136. IF(IBIN(JK,IHK).EQ.0) GO TO 21
  137. NC=NC+1
  138. IDEJ(NC)=JK
  139. 21 CONTINUE
  140. SEGINI,MSOUPO
  141. IPCHP(I)=MSOUPO
  142.  
  143. NBELEM=ILO(I)
  144. N=NBELEM
  145. SEGINI,MPOVAL
  146. SEGINI,MELEME
  147. IGEOC=MELEME
  148. IPOVAL=MPOVAL
  149. ENDDO
  150. CALL oooprl(0)
  151.  
  152. IFOPOI=IFOMOD
  153. JATTRI(1) = 0
  154. MTYPOI=' '
  155. MOCHDE=' CHPOINT CREE PAR CRECHP'
  156. C
  157. C **** ON VA FABRIQUER LES SEGMENTS MSOUPO POUR LES REMPLIR IL FAUT
  158. C **** CONNAITRE LES INCONNUES DU SOUS CHAMPS ET L'OBJET GEOMETRIQUE
  159. C **** SUPPORT
  160. C
  161. IF(NSOUPO.EQ.0) THEN
  162. KCHPOI=MCHPOI
  163. SEGSUP,NTRAV,ILO,IPE
  164. RETURN
  165. ENDIF
  166.  
  167. DO 100 I=1,NSOUPO
  168. C
  169. C **** ON CHERCHE D'ABORD LA LISTE DES INCONNUES A PARTIR DE LA
  170. C **** VALEUR DE IBINN ET ON REMPLIT NOCOMP
  171. C
  172. IHK=IPE(I)
  173. NC=0
  174. DO 20 JK=1,NNIN
  175. IF(IBIN(JK,IHK).EQ.0) GO TO 20
  176. NC=NC+1
  177. IDEJ(NC)=JK
  178. 20 CONTINUE
  179. MSOUPO=IPCHP(I)
  180. DO 14 J=1,NC
  181. NOHARM(J)=NHAR(IDEJ(J))
  182. NOCOMP(J)=INCO(IDEJ(J))
  183. 14 CONTINUE
  184. C
  185. C **** ON CHERCHE COMBIEN DE NOEUD DANS L'OBJET MELEME,ON LE CREE
  186. C
  187. NBELEM=ILO(I)
  188. N=NBELEM
  189. MPOVAL=IPOVAL
  190. MELEME=IGEOC
  191. ITYPEL=1
  192. IC=0
  193. DO 16 J=1,NNNOE
  194. IF(INO(J).NE.I) GOTO 16
  195. IC=IC+1
  196. NUM(1,IC)=IGEO(J)
  197. DO 18 K=1,NC
  198. IO=IDEJ(K)
  199. VPOCHA(IC,K)=BB(IO,J)
  200. 18 CONTINUE
  201. 16 CONTINUE
  202.  
  203. call crech1(meleme,1)
  204. IGEOC=MELEME
  205.  
  206. 100 CONTINUE
  207. SEGSUP,ILO,IPE,NTRAV
  208. KCHPOI=MCHPOI
  209.  
  210. END
  211.  
  212.  
  213.  

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