C ASSE10 SOURCE MB234859 26/06/10 21:15:05 12569 C ASSEM0 SOURCE PV 99/03/11 21:16:48 3517 SUBROUTINE ASSE10(MRIGI1,ICLE,MDNO,MIMI,MINCP,INUIN1,inwuit) IMPLICIT INTEGER(I-N) IMPLICIT REAL*8 (A-H,O-Z) -INC PPARAM -INC CCOPTIO -INC SMRIGID -INC SMLMOTS -INC SMLREEL -INC SMLENTI -INC SMMATRI -INC SMELEME * ICLE=1 * ce subroutine a pour fonction d'initialiser le segment de * normalisation MDNOR et de fabriquer les matrices normalisees pour * les transferer a l'assemblage. * ICLE=2 * destructions des matrices normalisees * SEGMENT,INUINV(NNGLOB) SEGMENT MICOR(NLIGRP) SEGMENT INWAIT INTEGER IIM(IRM) ENDSEGMENT * write(6,fmt='('' entree dans asse10 icle'',i6)') icle IF(ICLE.EQ.1) THEN C C on est en premier passage il faut triturer les matrices C MRIGID=MRIGI1 SEGACT MRIGID*MOD * write(6,fmt='('' entree dans assem0 mrigi1 ichole '' * * ,2i6)') * * mrigid,ichole IRM=IRIGEL(/2) SEGINI INWAIT inwuit=inwait MLMOTS=NORINC * write( 6,fmt='('' assem0 norinc '', i6)') norinc INUINV=INUIN1 SEGACT INUINV MDNOR=MDNO SEGACT MDNOR*MOD MINCPO=MINCP SEGACT MINCPO ID1=INCPO(/1) ID2=INCPO(/2) MIMIK=MIMI SEGACT MIMIK C ... Si la normalisation est AUTOmatique ... IF(MLMOTS.EQ. -1) THEN JG=20 JGN=4 JGM=20 JFIN=0 JMAX=20 * SEGINI MLMOTS,MLREEL * CALL SAVSEG(MLMOTS) * CALL SAVSEG(MLREEL) DO 50 I=1,IRM DESCR=IRIGEL(3,I) SEGACT DESCR NLIGRP=NOELEP(/1) NLIGRD=NLIGRP JG=NLIGRP SEGINI MICOR * DO 51 J=1,NLIGRP DO 52 K=1,ID1 IF(IMIK(K).EQ.LISINC(J)) GO TO 590 52 CONTINUE call erreur(5) 590 CONTINUE MICOR(J)=K 51 CONTINUE MELEME=IRIGEL(1,I) SEGACT MELEME XMATRI=IRIGEL(4,I) segact Xmatri * on balaye toutes les matrices pour simuler l'assemblage du terme diagonale DO 53 J=1,RE(/3) * XMATRI=IMATTT(J) SEGACT XMATRI DO 54 K=1,NLIGRP Ia = INUINV(NUM(NOELEP(K),J)) inc = INCPO(MICOR(K),ia) dnor(inc)=dnor(inc)+re(K,K,j) 54 CONTINUE SEGDES XMATRI 53 CONTINUE * SEGDES MELEME 50 CONTINUE ILX=0 DO 56 IU=1,IMIK(/2) IF( IMIK(IU).EQ.'LX ') then ILX=IU GO TO 57 ENDIF 56 CONTINUE 57 CONTINUE * write(6,*) ' ilx',ilx * write(6,*) ' imik' ,( imik(iuo),iuo=1,imik(/2)) C ... Les coefficients valent 0.8/sqrt(terme maxi) pour les DDL C "physiques" et 1 pour les multiplicateurs de Lagrange ... DO 58 IO = 1, ID2 DO 59 IOP = 1 , ID1 IA = incpo(IOP,IO) IF(IA.NE.0) THEN IF(IOP.EQ.ILX) THEN DNOR(IA)=1.D0 ELSE IF(DNOR(IA).EQ.0.D0) DNOR(IA)=1.D0 DNOR(IA)=0.8D0 / SQRT(ABS(DNOR(IA))) * dnor(IA)=1.d-4 * IO ENDIF ENDIF 59 CONTINUE 58 CONTINUE C ... Sinon (cad. la normalisation n'est pas automatique) ... ELSE SEGACT MLMOTS LIN=MOTS(/2) MLREEL=NORVAL SEGACT MLREEL MLMOT1=NORIND MLREE1=NORVAD DO 61 IOP=1,ID1 do 62 IU=1,MOTS(/2) IPL=IU IF(IMIK(IOP).EQ.MOTS(IU) ) go to 63 62 CONTINUE xre=1.D0 GO TO 64 63 XRE = PROG(IPL) 64 CONTINUE do 65 io = 1,ID2 IA = INCPO(Iop,io) IF(IA.EQ.0) GO TO 65 DNOR(IA) = xre 65 CONTINUE 61 CONTINUE ENDIF C ... La normalisation proprement dite commence ici ... C C BOUCLE 1 SUR LES SOUS ZONES ELEMENTAIRES sans reflechir on multiplie C toutes les matrices par dnor C * write(6,*) ' dnor',(dnor(IUO),IUO=1,dnor(/1)) DO 1 I=1,IRM DESCR=IRIGEL(3,I) SEGACT DESCR NLIGRP=NOELEP(/1) NLIGRD=NLIGRP JG=NLIGRP segini mlenti meleme=irigel(1,I) segact meleme C C existe-t-il des inconnues a normer dans la matrice OUI! C si oui création de MLREE2 ET MLREE3 qui serviront de coef C multiplicateurs a partir de dnor C C C il faut multiplier les matrices C On va le faire et on cree un nouveau segment IMATRI C l'ancien etant stocke dans inwait C XMATRI=IRIGEL(4,I) SEGACT XMATRI NELRIG=RE(/3) C ... On met le pointeur IMATRI dans INWAIT ... IIM(I)=XMATRI C ... On créé un nouveau IMATRI et on le met dans MRIGID ... SEGINI,XMATR1=xmatri IRIGEL(4,I)=xMATR1 C ... Puis on parcourt les matrices élémentaires ... DO 3 IU=1,LISINC(/2) DO 2 IO=1,IMIK(/2) IF(LISINC(IU).EQ.IMIK(IO)) go to 4 2 CONTINUE CALL ERREUR(5) 4 CONTINUE LECT(IU)=IO 3 CONTINUE * write(6,*) ' lect', (lect(Iuo),iuo=1,lect(/1)) DO 7 K=1,NELRIG C ... Boucle sur les variables duales ... do 8 L=1,NLIGRP IAB=INUINV(NUM(NOELEP(L),K)) INH= INCPO(LECT(L),IAB) COE=DNOR(INH) IF(COE.EQ.1.D0) GO TO 8 C ... Si le coefficient est différent de 1 ... DO 9 M=1,NLIGRP C ... On multiplie la ligne N° L par ce coeff. ... XMATR1.RE(L,M,k)=XMATR1.RE(L,M,k)*COE XMATR1.RE(M,L,k)=XMATR1.RE(M,L,k)*COE 9 CONTINUE 8 CONTINUE 7 CONTINUE C ... Ménage ... SEGDES,XMATRI,XMATR1 SEGSUP MLENTI 1 CONTINUE * write(6,*) ' asse10 dnor' * write(6,*) ( dnor(IUO),iuo=1,100) * write(6,fmt='('' assem0 norinc norval norind norvad'',4i6) * * ') norinc,norval,norind,norvad * SEGDES INWAIT * SEGDES MRIGID ELSEIF(ICLE.EQ.2) THEN * write(6,fmt='('' assem0 inwait '' ,i6 )') inwait C ... Destruction des matrices normalisées et remise dans MRIGID C des matrices d'origine conservées dans INWAIT ... inwait=inwuit IF(INWAIT.EQ.0) RETURN SEGACT INWAIT MRIGID=MRIGI1 SEGACT MRIGID*MOD DO 20 I=1,IIM(/1) IF(IIM(I).EQ.0) GO TO 20 XMATRI=IRIGEL(4,I) SEGSUP XMATRI * DO 21 L=1,IMATTT(/1) * XMATRI=IMATTT(L) * SEGSUP XMATRI * 21 CONTINUE * SEGSUP IMATRI IRIGEL(4,I) = IIM(I) 20 CONTINUE SEGSUP INWAIT SEGDES MRIGID INWUIT=0 ENDIF * write(6,fmt='('' sortie assem0 norinc norval'',2i6)') * * norinc,norval * mlmots = norinc * mlreel = norval * segact mlmots,mlreel * write(6,fmt='('' sortie assem0 definitive'')') RETURN END