C DYNE02 SOURCE CHAT 09/10/09 21:17:30 6519 SUBROUTINE DYNE02(ICHOLX,IRSCPR,NDDL,IRIG,IVEC,IPZ,IPM, & MBLO,MBLO2,IPRIGZ,ICPC) IMPLICIT INTEGER(I-N) IMPLICIT REAL*8(A-H,O-Z) ************************************************************************ * * D Y N E 0 2 * ----------- * * FONCTION: * --------- * UTILITAIRE DE L'OPERATEUR "DYNE" * -1 T * CALCUL DU PRODUIT : Z = A M A * * PARAMETRES: (E)=ENTREE (S)=SORTIE (+ = CONTENU DANS UN COMMUN) * ----------- * * ICHOLX (E) POINTEUR SUR LE SEGMENT MMATRI ( ACTIF ) * IRSCPR (E) POINTEUR SUR LE SEGMENT ICPR ( ACTIF ) * NDDL (E) NOMBRE DE DEGRES DE LIBERTE * IRIG (E) POINTEUR SUR L'OBJET RIGIDITE A ( ACTIF ) * IVEC (E/S) POINTEUR SUR UN VECTEUR DE TRAVAIL * IPZ (S) POINTEUR SUR LE SEGMENT MZZZ ( LAISSE ACTIF ) * -1 * IPM (S) POINTEUR SUR LE VECTEUR CONTENANT M ( LAISSE ACTIF * MBLO (S) POINTEUR SUR LE SEGMENT MBLO | VOIR PLUS BAS * MBLO2 (S) POINTEUR SUR LE SEGMENT MBLO2 | ( LAISSES ACTIFS ) * IPRIGZ (S) POINTEUR SUR L'OBJET RIGIDITE Z * ICPC (S) POINTEUR SUR UN SEGMENT DE TYPE ICPR ( LAISSE ACTIF ) * * REMARQUES: * ---------- * CETTE VERSION NE TRAITE QUE LES DDL BLOQUES, POUR LES RELATIONS * IL FAUDRA PROCEDER AUTREMENT EN CE QUI CONCERNE LA MATRICE A. * -1 T * LE PRODUIT A M A NE SERA PLUS UNE MATRICE DIAGONALE, ON DEVRA * EFFECTUER UNE RESOLUTION : C'EST POURQUOI ON CREE L'OBJET Z * DE TYPE RIGIDITE. * * AUTEUR, DATE DE CREATION: * ------------------------- * DENIS ROBERT, LE 16 NOVEMBRE 1988. * * LANGAGE: * -------- * ESOPE + FORTRAN77 * ************************************************************************ * * MODULES UTILISES: * -INC CCOPTIO -INC SMELEME -INC SMRIGID -INC SMMATRI -INC SMVECTD -INC SMCOORD * PARAMETER ( UN = 1.D0 ) PARAMETER ( ZERO = 0.D0 ) * CHARACTER*4 NI * *--- SEGMENTS DE TRAVAIL : * -1 T * MZZZ CONTIENT LE PRODUIT A M A RANGE EN LIGNE * -1 * MBLO CONTIENT LE PRODUIT A M TABLEAU IDDL * NDDL * MBLO2 CONTIENT LA MATRICE A TABLEAU IDDL * NDDL * ICP. CONTIENT DES REFERENCES GEOMETRIQUES * MUITRA CONTIENT LES CORRESPONDANCES DES COMPOSANTES * SEGMENT MUITRA(NLIGRA) SEGMENT ICPR(XCOOR(/1)/(IDIM+1)) SEGMENT ICPA(XCOOR(/1)/(IDIM+1)) SEGMENT ICPB(XCOOR(/1)/(IDIM+1)) SEGMENT ICPC(XCOOR(/1)/(IDIM+1)) SEGMENT,MZZZ REAL*8 ZZZZ(LONZ,LONZ) ENDSEGMENT SEGMENT,MBLO REAL*8 BLO(IDDL,NDDL) ENDSEGMENT POINTEUR MBLO2.MBLO * MVECTD=IVEC MMATRI=ICHOLX MINCPO=IINCPO MIMIK=IIMIK ICPR=IRSCPR SEGINI,ICPA,ICPB,ICPC LNA=ICPA(/1) ININC=IMIK(/2) * DO 5 ILNA=1,LNA ICPA(ILNA)=0 ICPB(ILNA)=0 ICPC(ILNA)=0 5 CONTINUE * END DO * IF (IRIG.NE.0) THEN * *--- L'OBJET RIGIDITE "A" EXISTE * *------------------------------------------------* *--- BOUCLE SUR LES ZONES ELEMENTAIRES DE A ---* *------------------------------------------------* * IK=0 IKK=0 RI1=IRIG SEGACT,RI1 NRIGE1=RI1.IRIGEL(/2) DO 20 IRI=1,NRIGE1 MELEME=RI1.IRIGEL(1,IRI) SEGACT,MELEME * *--- REMPLISSAGE DE ICPA ET ICPB * REMARQUE : N1= 3 CAR ON VEUT TOUJOURS LE 3EME NOEUD QUI * EST RELATIF AU DDL PHYSIQUE * N1=NUM(/1) N2=NUM(/2) DO 30 I2 = 1,N2 IKK=IKK+1 K=NUM(3,I2) ICPC(IKK)=NUM(1,I2) IF (ICPA(K).EQ.0) THEN IK=IK+1 ICPA(K)=IK ICPB(IK)=K ENDIF 30 CONTINUE * END DO SEGDES,MELEME 20 CONTINUE * END DO IDDL=IKK * *---------------------------------------* *--- CREATION DE LA GEOMETRIE DE Z ---* *---------------------------------------* * NBSOUS=0 NBREF=0 NBNN=1 NBELEM=IK SEGINI,IPT1 DO 10 II=1,IK IPT1.NUM(1,II)=ICPB(II) 10 CONTINUE * END DO IPOGEO=IPT1 SEGDES,IPT1 SEGINI,MBLO DO 31 IA1=1,IDDL DO 32 IA2=1,NDDL BLO(IA1,IA2)=ZERO 32 CONTINUE * END DO 31 CONTINUE * END DO * *---------------------------------------------------* *--- RE-BOUCLE SUR LES ZONES ELEMENTAIRES DE A ---* *---------------------------------------------------* * IPPL=0 NLIGRP=IDDL NLIGRD=IDDL SEGINI,DESCR DO 50 IR=1,NRIGE1 MELEME=RI1.IRIGEL(1,IR) SEGACT,MELEME DES1=RI1.IRIGEL(3,IR) SEGACT,DES1 * *--- ON REMPLIT MUITRA(IN) = IJ QUI DIT QUE LA IEME INCONNUE *--- DE LA ZONE ELEMENTAIRE DE "A" EST LA JEME DE ININC * NLIGRA=DES1.LISINC(/2) SEGINI,MUITRA DO 51 IN=1,NLIGRA NI=DES1.LISINC(IN) DO 52 IJ=1,ININC IF(NI.EQ.IMIK(IJ)) GO TO 53 52 CONTINUE * END DO 53 CONTINUE MUITRA(IN)=IJ 51 CONTINUE * END DO * xMATR1=RI1.IRIGEL(4,IR) COER=RI1.COERIG(IR) * SEGACT,xMATR1 NN2=NUM(/2) * *---------------------------------------* *--- REMPLISSAGE DU TABLEAU BLO ---* *---------------------------------------* * DO 60 I22=1,NN2 IPPL=IPPL+1 * XMATR1=IMATR1.IMATTT(I22) * SEGACT,XMATR1 * J2=ICPR(NUM(DES1.NOELEP(3),I22)) J1=MUITRA(3) IKI=INCPO(J1,J2) BLO(IPPL,IKI)=UN * NOELEP(IPPL)=ICPA(NUM(DES1.NOELEP(3),I22)) NOELED(IPPL)=ICPA(NUM(DES1.NOELED(3),I22)) LISINC(IPPL)=DES1.LISINC(3) LISDUA(IPPL)=DES1.LISDUA(3) * * SEGDES,XMATR1 60 CONTINUE * END DO SEGDES,DES1,MELEME SEGSUP,MUITRA 50 CONTINUE * END DO IPDES1=DESCR SEGDES,DESCR,RI1 * IF (IPPL.NE.IDDL) THEN WRITE(IOIMP,*)'DYNE : IL MANQUE ',(IDDL-IPPL),' BLOCAGES |' ENDIF * *------------------------------------------* * -1 T * *--- CALCUL DU PRODUIT : Z = A M A * *------------------------------------------* * SEGINI,MBLO2=MBLO * -1 *--- CALCUL DE : A M ---> RANGE DANS BLO * DO 100 IL=1,IDDL DO 200 IK=1,NDDL IF (BLO(IL,IK).NE.ZERO) THEN BLO(IL,IK)=VECTBB(IK) ENDIF 200 CONTINUE * END DO 100 CONTINUE * END DO * -1 T *--- CALCUL DE : A M A ---> DIAGONALE *--- INFERIEURE STOCKEE EN LIGNE, DE LONGUEUR IDDL*(IDDL+1)/2 * LONZ=IDDL SEGINI,MZZZ IPZ=MZZZ DO 120 IZ=1,LONZ DO 120 IKZ=1,LONZ ZZZZ(IKZ,IZ)=ZERO 120 CONTINUE * END DO IZZ=0 DO 300 IB1=1,IDDL DO 400 IB2=1,IDDL IF (IB2.GE.IB1) THEN * IZZ=IZZ+1 DO 500 IBB=1,NDDL ZZZZ(IB2,IB1)=ZZZZ(IB2,IB1)+BLO(IB1,IBB)*MBLO2.BLO(IB2,IBB) 500 CONTINUE * END DO ELSE ZZZZ(IB2,IB1)=ZZZZ(IB1,IB2) ENDIF 400 CONTINUE * END DO 300 CONTINUE * END DO * IF (IZZ.NE.LONZ) THEN * WRITE(IOIMP,*)'DYNE : IL MANQUE',(LONZ-IZZ),'TERMES DANS Z |' * ENDIF * *--------------------------------------------------------------* *--- ON VA MAINTENANT CREER UN OBJET RIGIDITE CONTENANT Z ---* *--------------------------------------------------------------* * NRIGEL=1 NRIGE=8 SEGINI,MRIGID ICHOLE=0 IMGEO1=0 IMGEO2=0 IFORIG=IFOMOD ISUPEQ=0 NBGEOR=0 MTYMAT='RIGIDITE' COERIG(1)=UN IRIGEL(1,1)=IPOGEO IRIGEL(2,1)=0 IRIGEL(3,1)=IPDES1 IRIGEL(5,1)=0 IRIGEL(6,1)=0 NELRIG=1 * SEGINI,IMATRI NLIGRP=LONZ NLIGRD=LONZ SEGINI,XMATRI DO 600 IRZ=1,LONZ DO 600 IKRZ=1,LONZ RE(IKRZ,IRZ,1)=ZZZZ(IKRZ,IRZ) 600 CONTINUE * END DO * IMATTT(1)=XMATRI * SEGDES,XMATRI IRIGEL(4,1)=xMATRI SEGDES,xMATRI IPRIGZ=MRIGID SEGDES,MRIGID * *--- FIN DU TRAITEMENT DE L'OBJET RIGIDITE "A" * ENDIF * -1 *--- STOCKAGE DE M DANS UN VECTEUR DE LONGUEUR NDDL * IBB1=0 INC=NDDL SEGINI,MVECT1 DO 777 IB0=1,NDDL MVECT1.VECTBB(IB0)=ZERO 777 CONTINUE * END DO DO 888 IB1=1,VECTBB(/1) TTEST=VECTBB(IB1) IF (TTEST.NE.ZERO) THEN IBB1=IBB1+1 MVECT1.VECTBB(IBB1)=VECTBB(IB1) ENDIF 888 CONTINUE * END DO IPM=MVECT1 * SEGSUP,ICPA,ICPB * END