Télécharger asse10.eso

Retour à la liste

Numérotation des lignes :

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

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