Télécharger crech4.eso

Retour à la liste

Numérotation des lignes :

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

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