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