Télécharger crech4.eso

Retour à la liste

Numérotation des lignes :

  1. C CRECH4 SOURCE PV 16/11/17 21:58:56 9180
  2. C
  3. SUBROUTINE CRECH4(KTRAV,LCHPO)
  4. C
  5. C
  6. C
  7. C ******** CE SUBROUTINE SERT A CREER plusieurs CHAMP POINT A PARTIR
  8. C ******** D'UN SEGMENT MTRAV.
  9. C
  10. C ******** INCO(NNIN) CONTIENT LE NOMS DES NNIN INCONNUES DIFFERENTES.
  11. C
  12. C ******** BB(k,I,J) EST LA VALEUR DE LA IEME INCONNUE DU kieme CHAMP
  13. C ******** POUR LE JEME NOEUD DU TABLEAU IGEO.
  14. C
  15. C ******** IBIN(I,J)=1 OU 0. 1 INDIQUE QUE LA I EME INCONNUE DU CHAMP
  16. C ******** EXISTE POUR LE J EME NOEUD DU TABLEAU IGEO.
  17. C
  18. C ******** IGEO(I) EST LE NUMERO A METTRE DANS UN OBJET MELEME POUR
  19. C ******** REFERENCER LE IEME NOEUD
  20. C
  21. C ******** NHAR(I) EST LE NUMERO D'HARMONIQUE SI CALCUL AXI OU
  22. C ******** SIGNIFIE CONTRAINTE PLANE,DEFORMATION PLANE OU DEF PLAN GEN
  23. C
  24. C ******** ATTENTION ATTENTION ATTENTION IL EXISTE UNE VARIABLE
  25. C ******** POUVANT DEPENDRE DE LA MACHINE. NN25 EST SUPPOSE SUFFISAMENT
  26. C ******** PETIT POUR QUE 2**NN25 SOIT UN ENTIER POSSIBLE.
  27. C
  28. C
  29. C *** CREATION : BP, 2016 : COPIE DE CRECHP ADAPTEE AFIN DE TRAITER
  30. C PLUSIEURS CHPOINT DE MEME STRUCTURE EN 1 SEUL PASSAGE
  31. C + AJOUT DE QQ COMMENTAIRES ET INDENTATION
  32. C
  33. C
  34. IMPLICIT INTEGER(I-N)
  35. -INC CCOPTIO
  36. -INC SMCHPOI
  37. -INC SMLCHPO
  38. -INC SMELEME
  39. -INC SMMATRI
  40. * segment de travail = MTRAV modifie pour NNCHPO chpoints
  41. SEGMENT MTRAV
  42. CHARACTER*4 INCO(NNIN)
  43. REAL*8 BB(NNCHPO,NNIN,NNNOE)
  44. INTEGER IBIN(NNIN,NNNOE),IGEO(NNNOE),NHAR(NNIN)
  45. ENDSEGMENT
  46. *
  47. * ******** INCO(NNIN) CONTIENT LE NOMS DES NNIN INCONNUES DIFFERENTES.
  48. *
  49. * ******** BB(I,J) EST LA VALEUR DE LA IEME INCONNUE DU CHAMP POUR
  50. * ******** LE JEME NOEUD DU TABLEAU IGEO.
  51. *
  52. * ******** IBIN(I,J)=1 OU 0. 1 INDIQUE QUE LA I EME INCONNUE DU CHAMP
  53. * ******** EXISTE POUR LE J EME NOEUD DU TABLEAU IGEO.
  54. *
  55. * ******** IGEO(I) EST LE NUMERO A METTRE DANS UN OBJET MELEME POUR
  56. * ******** REFERENCER LE IEME NOEUD
  57. *
  58. * ******** NHAR(I) EST LE NUMERO D'HARMONIQUE SI CALCUL AXI OU
  59. * ******** SIGNIFIE CONTRAINTE PLANE,DEFORMATION PLANE OU DEF PLAN GEN
  60. *
  61. SEGMENT NTRAV
  62. INTEGER IDEJ(NNIN),INO(NNNOE),IBINN(NNNOE,N25),IVA(NNIN)
  63. INTEGER ICO(NNNOE)
  64. ENDSEGMENT
  65.  
  66. SEGMENT,ILO(0)
  67. SEGMENT,IPE(0)
  68.  
  69. NN25=25
  70. MTRAV=KTRAV
  71. SEGACT,MTRAV
  72. NNIN=INCO(/2)
  73. NNNOE=IBIN(/2)
  74.  
  75. N25=(NNIN+NN25-1)/NN25
  76. SEGINI,NTRAV
  77.  
  78. MLCHPO=LCHPO
  79. NBMOD1=ICHPOI(/1)
  80.  
  81.  
  82. C **** CREATION DU TABLEAU IBINN. CE TABLEAU PERMET DE REGROUPER
  83. C **** LES INFORMATIONS DE IBIN DE MANIERE A TESTER RAPIDEMENT
  84. C **** SI 2 NOEUDS ONT LES MEMES INCONNUES.
  85. C
  86. c on genere le tableau IVA :
  87. c I = 1 2 3 4 ... 25 | 26 27 28 ... 50
  88. c J = 1 2 3 4 25 | 1 2 3 25
  89. c IVA(I) = 1 2 4 8 2**24 | 1 2 4 2**24
  90. c
  91. J=0
  92. K=1
  93. IO=1
  94. DO 49 I=1,NNIN
  95. J=J+1
  96. IVA(I)=IO
  97. IO=IO*2
  98. IF(J.LT.NN25) GO TO 49
  99. IO=1
  100. J=0
  101. 49 CONTINUE
  102.  
  103. c boucle sur les noeuds ---------------------------------------
  104. DO 51 I=1,NNNOE
  105. K=0
  106. c boucle sur les blocs de 25 ------------
  107. DO 510 L=1,N25
  108. L1=1+(L-1)*NN25
  109. L2=L*NN25
  110. L2=MIN(L2,NNIN)
  111. IAFS=0
  112. c boucle sur les inconnues par bloc de 25 ------
  113. DO 52 J=L1,L2
  114. IF(IBIN(J,I).EQ.0) GO TO 52
  115. K=L
  116. JJ=J-(L-1)*NN25
  117. IAFS=IAFS+IVA(JJ)
  118. 52 CONTINUE
  119. c fin de boucle sur les inconnues ------
  120. c IAFS = somme_j 2**(j-1) pour les j inconnues de ce noeud I
  121. c L'indice L ne sert que pour eviter les pb de representativite
  122. c des entiers > 2**26
  123. IBINN(I,L)=IAFS
  124. 510 CONTINUE
  125. c fin de boucle sur les blocs de 25 ------------
  126. ICO(I)=K
  127. 51 CONTINUE
  128. c fin de boucle sur les noeuds --------------------------------
  129.  
  130.  
  131. C **** CLASSEMENT DES NOEUDS PAR TYPES. ON REMPLIT LE TABLEAU INO.
  132. C **** DEUX NOEUDS ONT LE MEME TYPE S'ILS ONT LES MEMES INCONNUES.
  133. C **** INO(I)=J VEUT DIRE QUE LE I EME NOEUD EST DE TYPE J.
  134. C **** N DONNE LE NOMBRE DE TYPES DE NOEUD DIFFERENTS.
  135. C
  136. N=0
  137. SEGINI,ILO,IPE
  138. NTROUV=0
  139. c Recherceh du 1er noeud avec effectivement une inconnue
  140. DO 53 IDEB=1,NNNOE
  141. IF(ICO(IDEB).NE.0) GO TO 54
  142. 53 CONTINUE
  143. GO TO 540
  144. 54 CONTINUE
  145. c Boucle sur les types -----------------------------
  146. 3 CONTINUE
  147. N=N+1
  148. c on enregistre dans IPE le 1er noeud du type N est IDEB
  149. IPE(**)=IDEB
  150. ITES=IDEB
  151. KK=0
  152. c boucle sur les noeuds ------
  153. DO 1 I=IDEB,NNNOE
  154. DO 2 J=1,N25
  155. IF(IBINN(I,J).NE.IBINN(ITES,J)) GO TO 1
  156. 2 CONTINUE
  157. KK=KK+1
  158. c on note que le noeud I est de type N, et qu'il a deja ete traite
  159. INO(I)=N
  160. ICO(I)=0
  161. 1 CONTINUE
  162. c fin de boucle sur les noeuds ------
  163. c on enregistre le nombre de noeud KK de type K dans ILO et le total
  164. ILO(**)=KK
  165. NTROUV=NTROUV+KK
  166. c faut-il encore iterer ?
  167. IF(NTROUV.NE.NNNOE) THEN
  168. DO 4 IDEB=1,NNNOE
  169. IF(ICO(IDEB).NE.0) GO TO 3
  170. 4 CONTINUE
  171. ENDIF
  172. c fin de boucle sur les types -----------------------------
  173. c write(*,*) N,'type detecte'
  174. c write(*,*) 'IPE=',(IPE(iou),iou=1,IPE(/1))
  175. c write(*,*) 'INO=',(INO(iou),iou=1,NNNOE)
  176. c write(*,*) 'ILO=',(ILO(iou),iou=1,ILO(/1))
  177.  
  178.  
  179. C **** ON CONNAIT LE NOMBRE DE SOUS CHAMPS
  180. NSOUPO=N
  181. NAT=1
  182.  
  183. C==== BOUCLE SUR LES CHPOINTS ==========================================
  184. 540 CONTINUE
  185. IMOD=0
  186. 541 CONTINUE
  187. IMOD=IMOD+1
  188. c write(*,*) '-------mode',IMOD
  189.  
  190. C **** ON INITIALISE LE SEGMENT MCHPOIN
  191. SEGINI,MCHPOI
  192. IFOPOI=IFOMOD
  193. JATTRI(1) = 0
  194. MTYPOI=' '
  195. MOCHDE='CHPOINT CREE PAR CRECH4'
  196. C
  197. C **** ON VA FABRIQUER LES SEGMENTS MSOUPO POUR LES REMPLIR IL FAUT
  198. C **** CONNAITRE LES INCONNUES DU SOUS CHAMPS ET L'OBJET GEOMETRIQUE
  199. C **** SUPPORT
  200. C
  201. c cas du chpoint vide
  202. IF(NSOUPO.EQ.0) GOTO 900
  203.  
  204. c Boucle sur les SOUPO ---------------------------------------------
  205. DO 100 I=1,NSOUPO
  206. C
  207. C **** ON CHERCHE D'ABORD LA LISTE DES INCONNUES A PARTIR DE LA
  208. C **** VALEUR DE IBINN ET ON REMPLIT NOCOMP
  209. C
  210. IHK=IPE(I)
  211. NC=0
  212. DO 20 JK=1,NNIN
  213. IF(IBIN(JK,IHK).EQ.0) GO TO 20
  214. NC=NC+1
  215. IDEJ(NC)=JK
  216. 20 CONTINUE
  217. SEGINI,MSOUPO
  218. IPCHP(I)=MSOUPO
  219. IB=0
  220. DO 14 J=1,NC
  221. NOHARM(J)=NHAR(IDEJ(J))
  222. NOCOMP(J)=INCO(IDEJ(J))
  223. 14 CONTINUE
  224. C
  225. C **** ON CHERCHE COMBIEN DE NOEUD DANS L'OBJET MELEME,ON LE CREE
  226. C
  227. c - 1er passage : il faut creer et remplir les MELEME + MPOVAL
  228. IF(IMOD.EQ.1) THEN
  229. NBELEM=ILO(I)
  230. NBSOUS=0
  231. NBREF=0
  232. NBNN=1
  233. SEGINI,MELEME
  234. ITYPEL=1
  235. N=NBELEM
  236. SEGINI,MPOVAL
  237. IC=0
  238. c remplissage de MELEME + MPOVAL
  239. DO 16 J=1,NNNOE
  240. IF(INO(J).NE.I) GO TO 16
  241. IC=IC+1
  242. NUM(1,IC)=IGEO(J)
  243. DO 18 K=1,NC
  244. IO=IDEJ(K)
  245. VPOCHA(IC,K)=BB(IMOD,IO,J)
  246. 18 CONTINUE
  247. 16 CONTINUE
  248. call crech1(meleme,1)
  249. IGEOC=MELEME
  250. IPOVAL=MPOVAL
  251. SEGDES,MPOVAL
  252. SEGDES,MSOUPO
  253. c SEGDES,MELEME
  254. c astuce: pour les passages suivants, on stocke le meleme actif dans ILO
  255. ILO(I)=IGEOC
  256.  
  257. c - passages suivants : il faut creer et remplir MPOVAL
  258. ELSE
  259. MELEME=ILO(I)
  260. segact,MELEME
  261. N=NUM(/2)
  262. SEGINI,MPOVAL
  263. IC=0
  264. c remplissage de MPOVAL
  265. DO 26 J=1,NNNOE
  266. IF(INO(J).NE.I) GO TO 26
  267. IC=IC+1
  268. DO 28 K=1,NC
  269. IO=IDEJ(K)
  270. VPOCHA(IC,K)=BB(IMOD,IO,J)
  271. 28 CONTINUE
  272. 26 CONTINUE
  273. IGEOC=MELEME
  274. IPOVAL=MPOVAL
  275. SEGDES,MPOVAL
  276. SEGDES,MSOUPO
  277. IF(IMOD.EQ.NBMOD1) SEGDES,MELEME
  278. ENDIF
  279.  
  280.  
  281. 100 CONTINUE
  282. c fin de Boucle sur les SOUPO --------------------------------------
  283.  
  284.  
  285. 900 CONTINUE
  286. KCHPOI=MCHPOI
  287. SEGDES,MCHPOI
  288. ICHPOI(IMOD)=KCHPOI
  289. c CALL ECCHPO(KCHPOI,0)
  290. IF(IMOD.LT.NBMOD1) GOTO 541
  291.  
  292. C==== FIN DE BOUCLE SUR LES CHPOINTS ===================================
  293.  
  294. 999 CONTINUE
  295. SEGSUP,ILO,IPE
  296. SEGSUP,NTRAV
  297. SEGDES,MTRAV
  298. RETURN
  299. END
  300.  
  301.  
  302.  
  303.  
  304.  
  305.  
  306.  
  307.  
  308.  
  309.  

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