Télécharger asse10.eso

Retour à la liste

Numérotation des lignes :

asse10
  1. C ASSE10 SOURCE PV 20/09/26 21:15:10 10724
  2. C ASSEM0 SOURCE PV 99/03/11 21:16:48 3517
  3. SUBROUTINE ASSE10(MRIGI1,ICLE,MDNO,MIMI,MINCP,INUIN1,inwuit)
  4. IMPLICIT INTEGER(I-N)
  5. IMPLICIT REAL*8 (A-H,O-Z)
  6.  
  7.  
  8. -INC PPARAM
  9. -INC CCOPTIO
  10. -INC SMRIGID
  11. -INC SMLMOTS
  12. -INC SMLREEL
  13. -INC SMLENTI
  14. -INC SMMATRI
  15. -INC SMELEME
  16. * ICLE=1
  17. * ce subroutine a pour fonction d'initialiser le segment de
  18. * normalisation MDNOR et de fabriquer les matrices normalisees pour
  19. * les transferer a l'assemblage.
  20. * ICLE=2
  21. * destructions des matrices normalisees
  22. *
  23. SEGMENT,INUINV(NNGLOB)
  24. SEGMENT MICOR(NLIGRP)
  25. SEGMENT INWAIT
  26. INTEGER IIM(IRM)
  27. ENDSEGMENT
  28.  
  29. * write(6,fmt='('' entree dans asse10 icle'',i6)') icle
  30.  
  31. IF(ICLE.EQ.1) THEN
  32. C
  33. C on est en premier passage il faut triturer les matrices
  34. C
  35. MRIGID=MRIGI1
  36. SEGACT MRIGID*MOD
  37.  
  38. * write(6,fmt='('' entree dans assem0 mrigi1 ichole ''
  39. * * ,2i6)')
  40. * * mrigid,ichole
  41.  
  42. IF(ICHOLE.NE.0) THEN
  43. ****** SEGDES,MRIGID
  44. RETURN
  45. ENDIF
  46. IRM=IRIGEL(/2)
  47. SEGINI INWAIT
  48. inwuit=inwait
  49. MLMOTS=NORINC
  50.  
  51. * write( 6,fmt='('' assem0 norinc '', i6)') norinc
  52. INUINV=INUIN1
  53. SEGACT INUINV
  54. MDNOR=MDNO
  55. SEGACT MDNOR*MOD
  56. MINCPO=MINCP
  57. SEGACT MINCPO
  58. ID1=INCPO(/1)
  59. ID2=INCPO(/2)
  60. MIMIK=MIMI
  61. SEGACT MIMIK
  62.  
  63. C ... Si la normalisation est AUTOmatique ...
  64.  
  65. IF( MLMOTS.EQ. -1) THEN
  66. JG=20
  67. JGN=4
  68. JGM=20
  69. JFIN=0
  70. JMAX=20
  71. * SEGINI MLMOTS,MLREEL
  72. * CALL SAVSEG(MLMOTS)
  73. * CALL SAVSEG(MLREEL)
  74. DO 50 I=1,IRM
  75. DESCR=IRIGEL(3,I)
  76. SEGACT DESCR
  77. NLIGRP=NOELEP(/1)
  78. NLIGRD=NLIGRP
  79. JG=NLIGRP
  80. SEGINI MICOR
  81. *
  82. DO 51 J=1,NLIGRP
  83. DO 52 K=1,ID1
  84. IF(IMIK(K).EQ.LISINC(J)) GO TO 590
  85. 52 CONTINUE
  86. call erreur(5)
  87. 590 CONTINUE
  88. MICOR(J)=K
  89. 51 CONTINUE
  90. MELEME=IRIGEL(1,I)
  91. SEGACT MELEME
  92. XMATRI=IRIGEL(4,I)
  93. segact Xmatri
  94. * on balaye toutes les matrices pour simuler l'assemblage du terme diagonale
  95. DO 53 J=1,RE(/3)
  96. * XMATRI=IMATTT(J)
  97. * SEGACT XMATRI
  98. DO 54 K=1,NLIGRP
  99. Ia = INUINV(NUM(NOELEP(K),J))
  100. inc = INCPO(MICOR(K),ia)
  101. dnor(inc)=dnor(inc)+re(K,K,j)
  102. 54 CONTINUE
  103. 53 CONTINUE
  104. * SEGDES MELEME
  105. 50 CONTINUE
  106.  
  107. ILX=0
  108. DO 56 IU=1,IMIK(/2)
  109. IF( IMIK(IU).EQ.'LX ') then
  110. ILX=IU
  111. GO TO 57
  112. ENDIF
  113. 56 CONTINUE
  114. 57 CONTINUE
  115. * write(6,*) ' ilx',ilx
  116. * write(6,*) ' imik' ,( imik(iuo),iuo=1,imik(/2))
  117. C ... Les coefficients valent 0.8/sqrt(terme maxi) pour les DDL
  118. C "physiques" et 1 pour les multiplicateurs de Lagrange ...
  119. DO 58 IO = 1, ID2
  120. DO 59 IOP = 1 , ID1
  121. IA = incpo(IOP,IO)
  122. IF(IA.NE.0) THEN
  123. IF(IOP.EQ.ILX) THEN
  124. DNOR(IA)=1.D0
  125. ELSE
  126. IF(DNOR(IA).EQ.0.D0) DNOR(IA)=1.D0
  127. DNOR(IA)=0.8D0 / SQRT(ABS(DNOR(IA)))
  128. * dnor(IA)=1.d-4 * IO
  129. ENDIF
  130. ENDIF
  131. 59 CONTINUE
  132. 58 CONTINUE
  133. C ... Sinon (cad. la normalisation n'est pas automatique) ...
  134. ELSE
  135. SEGACT MLMOTS
  136. LIN=MOTS(/2)
  137. MLREEL=NORVAL
  138. SEGACT MLREEL
  139. MLMOT1=NORIND
  140. MLREE1=NORVAD
  141.  
  142. DO 61 IOP=1,ID1
  143. do 62 IU=1,MOTS(/2)
  144. IPL=IU
  145. IF(IMIK(IOP).EQ.MOTS(IU) ) go to 63
  146. 62 CONTINUE
  147. xre=1.D0
  148. GO TO 64
  149. 63 XRE = PROG(IPL)
  150. 64 CONTINUE
  151. do 65 io = 1,ID2
  152. IA = INCPO(Iop,io)
  153. IF(IA.EQ.0) GO TO 65
  154. DNOR(IA) = xre
  155. 65 CONTINUE
  156. 61 CONTINUE
  157. ENDIF
  158.  
  159. C ... La normalisation proprement dite commence ici ...
  160. C
  161. C BOUCLE 1 SUR LES SOUS ZONES ELEMENTAIRES sans reflechir on multiplie
  162. C toutes les matrices par dnor
  163. C
  164. * write(6,*) ' dnor',(dnor(IUO),IUO=1,dnor(/1))
  165. DO 1 I=1,IRM
  166. DESCR=IRIGEL(3,I)
  167. SEGACT DESCR
  168. NLIGRP=NOELEP(/1)
  169. NLIGRD=NLIGRP
  170. JG=NLIGRP
  171. segini mlenti
  172. meleme=irigel(1,I)
  173. segact meleme
  174. C
  175. C existe-t-il des inconnues a normer dans la matrice OUI!
  176. C si oui création de MLREE2 ET MLREE3 qui serviront de coef
  177. C multiplicateurs a partir de dnor
  178. C
  179. C
  180. C il faut multiplier les matrices
  181. C On va le faire et on cree un nouveau segment IMATRI
  182. C l'ancien etant stocke dans inwait
  183. C
  184. XMATRI=IRIGEL(4,I)
  185. SEGACT XMATRI
  186. NELRIG=RE(/3)
  187. C ... On met le pointeur IMATRI dans INWAIT ...
  188. IIM(I)=XMATRI
  189. C ... On créé un nouveau IMATRI et on le met dans MRIGID ...
  190. SEGINI,XMATR1=xmatri
  191. IRIGEL(4,I)=xMATR1
  192. C ... Puis on parcourt les matrices élémentaires ...
  193. DO 3 IU=1,LISINC(/2)
  194. DO 2 IO=1,IMIK(/2)
  195. IF(LISINC(IU).EQ.IMIK(IO)) go to 4
  196. 2 CONTINUE
  197. CALL ERREUR(5)
  198. 4 CONTINUE
  199. LECT(IU)=IO
  200. 3 CONTINUE
  201. * write(6,*) ' lect', (lect(Iuo),iuo=1,lect(/1))
  202. DO 7 K=1,NELRIG
  203. * XMATRI=IMATTT(K)
  204. C ... Chaque nouvelle matrice est égale au début à la précédente ...
  205. * SEGINI,XMATR1=XMATRI
  206. * IMATR1.IMATTT(K)=XMATR1
  207. C ... Boucle sur les variables duales ...
  208. do 8 L=1,NLIGRP
  209. IAB=INUINV(NUM(NOELEP(L),K))
  210. INH= INCPO(LECT(L),IAB)
  211. COE=DNOR(INH)
  212. IF(COE.EQ.1.D0) GO TO 8
  213. C ... Si le coefficient est différent de 1 ...
  214. DO 9 M=1,NLIGRP
  215. C ... On multiplie la ligne N° L par ce coeff. ...
  216. XMATR1.RE(L,M,k)=XMATR1.RE(L,M,k)*COE
  217. XMATR1.RE(M,L,k)=XMATR1.RE(M,L,k)*COE
  218. 9 CONTINUE
  219. 8 CONTINUE
  220. * SEGDES XMATR1
  221. 7 CONTINUE
  222. C ... Ménage ...
  223. * SEGDES IMATR1,IMATRI
  224. * SEGDES DESCR,MELEME
  225. SEGSUP MLENTI
  226. 1 CONTINUE
  227. * write(6,*) ' asse10 dnor'
  228. * write(6,*) ( dnor(IUO),iuo=1,100)
  229.  
  230. * write(6,fmt='('' assem0 norinc norval norind norvad'',4i6)
  231. * * ') norinc,norval,norind,norvad
  232.  
  233. * SEGDES INWAIT
  234. * SEGDES MRIGID
  235.  
  236. ELSEIF(ICLE.EQ.2) THEN
  237.  
  238. * write(6,fmt='('' assem0 inwait '' ,i6 )') inwait
  239.  
  240. C ... Destruction des matrices normalisées et remise dans MRIGID
  241. C des matrices d'origine conservées dans INWAIT ...
  242. inwait=inwuit
  243. IF(INWAIT.EQ.0) RETURN
  244. SEGACT INWAIT
  245. MRIGID=MRIGI1
  246. SEGACT MRIGID*MOD
  247. DO 20 I=1,IIM(/1)
  248. IF(IIM(I).EQ.0) GO TO 20
  249. XMATRI=IRIGEL(4,I)
  250. SEGSUP XMATRI
  251. * DO 21 L=1,IMATTT(/1)
  252. * XMATRI=IMATTT(L)
  253. * SEGSUP XMATRI
  254. * 21 CONTINUE
  255. * SEGSUP IMATRI
  256. IRIGEL(4,I) = IIM(I)
  257. 20 CONTINUE
  258. SEGSUP INWAIT
  259. SEGDES MRIGID
  260. INWUIT=0
  261. ENDIF
  262.  
  263. * write(6,fmt='('' sortie assem0 norinc norval'',2i6)')
  264. * * norinc,norval
  265. * mlmots = norinc
  266. * mlreel = norval
  267. * segact mlmots,mlreel
  268. * write(6,fmt='('' sortie assem0 definitive'')')
  269.  
  270. RETURN
  271. END
  272.  
  273.  
  274.  
  275.  
  276.  
  277.  
  278.  
  279.  
  280.  
  281.  
  282.  
  283.  
  284.  
  285.  
  286.  
  287.  
  288.  

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