Télécharger assem0.eso

Retour à la liste

Numérotation des lignes :

  1. C ASSEM0 SOURCE CHAT 09/10/09 21:15:50 6519
  2. SUBROUTINE ASSEM0(MRIGI1,ICLE,INWUIT)
  3. IMPLICIT INTEGER(I-N)
  4. IMPLICIT REAL*8 (A-H,O-Z)
  5.  
  6. -INC CCOPTIO
  7. -INC SMRIGID
  8. -INC SMLMOTS
  9. -INC SMLREEL
  10. -INC SMLENTI
  11.  
  12. *** SAVE INWAIT
  13. SEGMENT INWAIT
  14. INTEGER IIM(IRM)
  15. ENDSEGMENT
  16.  
  17. * write(6,fmt='('' entree dans assem0 icle'',i6)') icle
  18.  
  19. IF(ICLE.EQ.1) THEN
  20. C
  21. C on est en premier passage il faut triturer les matrices
  22. C
  23. MRIGID=MRIGI1
  24. SEGACT MRIGID*MOD
  25. INWAIT=0
  26.  
  27. * write(6,fmt='('' entree dans assem0 mrigi1 ichole ''
  28. * * ,2i6)')
  29. * * mrigid,ichole
  30.  
  31. IF(ICHOLE.NE.0) THEN
  32. SEGDES,MRIGID
  33. RETURN
  34. ENDIF
  35. IRM=IRIGEL(/2)
  36. SEGINI INWAIT
  37. inWUIT=inwait
  38. MLMOTS=NORINC
  39.  
  40. * write( 6,fmt='('' assem0 norinc '', i6)') norinc
  41.  
  42. C ... Si la normalisation est AUTOmatique ...
  43. IF( MLMOTS.EQ. -1) THEN
  44. C ... Taille initiale de la liste de coeff. ...
  45. JG=20
  46. C ... Taille initiale de la liste de nom de DDL ...
  47. JGN=4
  48. JGM=20
  49. C ... JFIN = nombre de différents noms de DDL ...
  50. JFIN=0
  51. C ... Taille actuelle des MLMOTS et MLREEL ...
  52. JMAX=20
  53. SEGINI MLMOTS,MLREEL
  54. CALL SAVSEG(MLMOTS)
  55. CALL SAVSEG(MLREEL)
  56. C ... Boucle sur les zones élémentaires ...
  57. DO 50 I=1,IRM
  58. DESCR=IRIGEL(3,I)
  59. SEGACT DESCR
  60. NLIGRP=NOELEP(/1)
  61. NLIGRD=NLIGRP
  62. C ... On met le premier DDL dans MLMOTS ...
  63. IF(I.EQ.1) THEN
  64. JFIN=1
  65. MOTS(JFIN)=LISINC(1)
  66. ENDIF
  67. C ... Si les autres n'y sont pas encore, on les rajoute ...
  68. DO 51 J=1,NLIGRP
  69. DO 52 K=1,JFIN
  70. IF( LISINC(J).EQ.MOTS(K)) GO TO 51
  71. 52 CONTINUE
  72. JFIN=JFIN+1
  73. C ... En agrandissant (s'il le faut) les MLMOTS et MLREEL ...
  74. IF(JFIN.GT.JMAX)THEN
  75. JG = JMAX+20
  76. JGM=JG
  77. SEGADJ MLMOTS,MLREEL
  78. ENDIF
  79. MOTS(JFIN)=LISINC(J)
  80. 51 CONTINUE
  81. C ... Initialisation de MLREE1 de taille NLIGRP ...
  82. JG=NLIGRP
  83. SEGINI MLREE1
  84. XMATRI=IRIGEL(4,I)
  85. SEGACT XMATRI
  86. C ... Dans lequel on mettra les maxi des NLIGRP termes diagonaux
  87. C de toutes le matrices élémentaires de la zone ...
  88. DO 53 J=1,RE(/3)
  89. * XMATRI=IMATTT(J)
  90. * SEGACT XMATRI
  91. DO 54 K=1,NLIGRP
  92. IF(ABS(RE(K,K,J)).GT.MLREE1.PROG(K))
  93. & MLREE1.PROG(K)=ABS(RE(K,K,J))
  94. 54 CONTINUE
  95. 53 CONTINUE
  96. C ... Puis, pour chaque DDL différent, on met le maxi des
  97. C termes diagonaux concernés dans MLREEL ...
  98. DO 55 J=1,NLIGRP
  99. DO 56 K=1,JFIN
  100. IF( LISINC(J).EQ.MOTS(K)) GO TO 57
  101. 56 CONTINUE
  102. 57 CONTINUE
  103. IF(MLREE1.PROG(J).GT.PROG(K))
  104. & PROG(K)=MLREE1.PROG(J)
  105. 55 CONTINUE
  106. SEGSUP MLREE1
  107. 50 CONTINUE
  108. C ... Toutes les zones étant parcourues, la taille des MLMOTS et MLREEL
  109. C est définitive, on peut donc l'ajuster ...
  110. JG=JFIN
  111. JGM=JG
  112. SEGADJ MLMOTS,MLREEL
  113. C ... Les coefficients valent 0.8/sqrt(terme maxi) pour les DDL
  114. C "physiques" et 1 pour les multiplicateurs de Lagrange ...
  115. DO 59 K=1,JFIN
  116. IF(PROG(K).EQ.0.D0) PROG(K)=1.D0
  117. PROG(K)=0.8D0 / SQRT(PROG(K))
  118. IF(MOTS(K).EQ.'LX') PROG(K)=1.D0
  119. 59 CONTINUE
  120. C ... Il n'y a pas de normalisation des variables duales ...
  121. MLMOT1=0
  122. MLREE1=0
  123. LIN=JFIN
  124. NORINC=MLMOTS
  125. NORVAL=MLREEL
  126.  
  127. * write(6,fmt='('' norinc '',4( A4,2x))')(mots(kk),kk=1,
  128. * * mots(/2))
  129. * write(6,fmt='('' norval '',4(e12.5,2x))')(prog(kk),kk=1,
  130. * * prog(/1))
  131.  
  132. C ... Sinon (cad. la normalisation n'est pas automatique) ...
  133. ELSE
  134. SEGACT MLMOTS
  135. LIN=MOTS(/2)
  136. MLREEL=NORVAL
  137. SEGACT MLREEL
  138. MLMOT1=NORIND
  139. MLREE1=NORVAD
  140. IF(MLMOT1.NE.0) THEN
  141. SEGACT MLMOT1
  142. SEGACT MLREE1
  143. LIND=MLREE1.PROG(/1)
  144. ENDIF
  145. ENDIF
  146.  
  147. C ... La normalisation proprement dite commence ici ...
  148. C
  149. C BOUCLE 1 SUR LES SOUS ZONES ELEMENTAIRES
  150. C
  151. DO 1 I=1,IRM
  152. DESCR=IRIGEL(3,I)
  153. SEGACT DESCR
  154. NLIGRP=NOELEP(/1)
  155. NLIGRD=NLIGRP
  156. JG=NLIGRP
  157. MLREE2=0
  158. MLREE3=0
  159. C
  160. C existe-t-il des inconnues a normer dans la matrice
  161. C si oui création de MLREE2 ET MLREE3 qui serviront de coef
  162. C multiplicateurs
  163. C
  164. DO 2 K=1,NLIGRP
  165. C ... Pour toute variable primale, on cherche si elle
  166. C est présente dans la liste des variables à normaliser ...
  167. DO 3 L=1,LIN
  168. IF(LISINC(K).EQ.MOTS(L)) THEN
  169. C ... Si c'est le cas, on vérifie si les listes des
  170. C coefficients sont initialisées ...
  171. IF(MLREE2.EQ.0) THEN
  172. SEGINI MLREE2
  173. DO 33 M=1,NLIGRP
  174. MLREE2.PROG(M)=1.D0
  175. 33 CONTINUE
  176. IF(MLMOT1.EQ.0) THEN
  177. SEGINI MLREE3
  178. DO 34 M=1,NLIGRP
  179. MLREE3.PROG(M)=1.D0
  180. 34 CONTINUE
  181. ENDIF
  182. ENDIF
  183. C ... Puis, on met le bon coefficient au bon endroit ...
  184. MLREE2.PROG(K)=PROG(L)
  185. C ... Si la normalisation des variables duales n'a pas été
  186. C demandée, les coeff. seront les mêmes que pour les
  187. C variables primales ...
  188. IF(MLREE3.NE.0) MLREE3.PROG(K)= PROG(L)
  189. ENDIF
  190. 3 CONTINUE
  191. 2 CONTINUE
  192.  
  193. C ... Si au contraire, la normalisation des variables duales a
  194. C été demandée, on refait la même chose pour les variables
  195. C duales ...
  196. IF(MLMOT1.EQ.0) GO TO 6
  197. NLIGRD=NOELED(/1)
  198. JG=NLIGRD
  199. MLREE3=0
  200. DO 4 K=1,NLIGRD
  201. DO 5 L=1,LIND
  202. IF(LISDUA(K).EQ.MLMOT1.MOTS(L)) THEN
  203. IF(MLREE3.EQ.0) THEN
  204. SEGINI MLREE3
  205. DO 35 M=1,NLIGRD
  206. MLREE3.PROG(M)=1.D0
  207. 35 CONTINUE
  208. ENDIF
  209. C ... c.a.d. on met les coefficients au bons endroits dans MLREE3 ...
  210. MLREE3.PROG(K)=MLREE1.PROG(L)
  211. ENDIF
  212. 5 CONTINUE
  213. 4 CONTINUE
  214. 6 CONTINUE
  215. C
  216. C si MLREE2*MLREE3 NE 0 il faut multiplier les matrices
  217. C On va le faire et on cree un nouveau segment IMATRI
  218. C l'ancien etant stocke dans inwait
  219. C
  220. IF(MLREE2*MLREE3.EQ.0) GO TO 15
  221. XMATRI=IRIGEL(4,I)
  222. SEGACT XMATRI
  223. NELRIG=RE(/3)
  224. C ... On met le pointeur IMATRI dans INWAIT ...
  225. IIM(I)=XMATRI
  226. C ... On créé un nouveau IMATRI et on le met dans MRIGID ...
  227. SEGINI,XMATR1=XMATRI
  228. IRIGEL(4,I)=XMATR1
  229. C ... Puis on parcourt les matrices élémentaires ...
  230. DO 7 K=1,NELRIG
  231. * XMATRI=IMATTT(K)
  232. C ... Chaque nouvelle matrice est égale au début à la précédente ...
  233. * SEGINI,XMATR1=XMATRI
  234. * IMATR1.IMATTT(K)=XMATR1
  235. C ... Boucle sur les variables duales ...
  236. DO 8 L=1,NLIGRD
  237. COE=MLREE3.PROG(L)
  238. IF(COE.EQ.1.D0) GO TO 8
  239. C ... Si le coefficient est différent de 1 ...
  240. DO 9 M=1,NLIGRP
  241. C ... On multiplie la ligne N° L par ce coeff. ...
  242. XMATR1.RE(L,M,k)=XMATR1.RE(L,M,k)*COE
  243. 9 CONTINUE
  244. 8 CONTINUE
  245. C ... Boucle sur les variables primales ...
  246. DO 10 L=1,NLIGRP
  247. COE=MLREE2.PROG(L)
  248. IF(COE.EQ.1.D0) GO TO 10
  249. C ... Si le coefficient est différent de 1 ...
  250. DO 11 M=1,NLIGRD
  251. C ... On multiplie la colonne N° L par ce coeff. ...
  252. XMATR1.RE(M,L,k)=XMATR1.RE(M,L,k)*COE
  253. 11 CONTINUE
  254. 10 CONTINUE
  255. * SEGDES XMATR1
  256. 7 CONTINUE
  257. C ... Ménage ...
  258. SEGDES XMATR1,XMATRI
  259. 15 CONTINUE
  260. SEGDES DESCR
  261. 1 CONTINUE
  262.  
  263. * write(6,fmt='('' assem0 norinc norval norind norvad'',4i6)
  264. * * ') norinc,norval,norind,norvad
  265.  
  266. SEGDES INWAIT
  267. SEGDES MRIGID
  268.  
  269. ELSEIF(ICLE.EQ.2) THEN
  270.  
  271. * write(6,fmt='('' assem0 inwait '' ,i6 )') inwait
  272.  
  273. C ... Destruction des matrices normalisées et remise dans MRIGID
  274. C des matrices d'origine conservées dans INWAIT ...
  275. inwait=inwuit
  276. IF(INWAIT.EQ.0) RETURN
  277. SEGACT INWAIT
  278. MRIGID=MRIGI1
  279. SEGACT MRIGID*MOD
  280. DO 20 I=1,IIM(/1)
  281. IF(IIM(I).EQ.0) GO TO 20
  282. XMATRI=IRIGEL(4,I)
  283. ** SEGACT IMATRI
  284. * DO 21 L=1,IMATTT(/1)
  285. * XMATRI=IMATTT(L)
  286. * SEGSUP XMATRI
  287. * 21 CONTINUE
  288. SEGSUP XMATRI
  289. IRIGEL(4,I) = IIM(I)
  290. 20 CONTINUE
  291. SEGSUP INWAIT
  292. SEGDES MRIGID
  293. INWUIT=0
  294. ENDIF
  295.  
  296. * write(6,fmt='('' sortie assem0 norinc norval'',2i6)')
  297. * * norinc,norval
  298. * mlmots = norinc
  299. * mlreel = norval
  300. * segact mlmots,mlreel
  301. * write(6,fmt='('' sortie assem0 definitive'')')
  302. RETURN
  303. END
  304.  
  305.  
  306.  
  307.  
  308.  
  309.  
  310.  
  311.  
  312.  
  313.  
  314.  

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