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