C QZCON2 SOURCE BP208322 12/10/03 21:15:22 7517 C QZCON2 SOURCE GORC 95/07/07 21:17:31 1742 SUBROUTINE QZCON2(RI1,RI2,RI3,ROMEGA,RI4,MCHPO1) IMPLICIT INTEGER(I-N) IMPLICIT REAL*8 (A-H,O-Z) ********************************************************************************** * * * CONSTITUTION DE LA MATRICE XMATR1 DE TAILLE 2Nx2N * * ______________________________________________________________________________ * * * * * * DATE : le 19 Decembre 1995 * * AUTEUR : Jerome CHARPENTIER * * ______________________________________________________________________________ * * * * MODULE(S) APPELANT(S) : VIBRAC * * * * MODULE(S) APPELE(S) : ASSMAT, POSPT * * ______________________________________________________________________________ * * * * EN ENTREE : * * - RI1 : matrice masse * * - RI2 : matrice raideur * * - RI3 : matrice amortissement * * - ROMEGA : pulsation (rad/s) * * - MCHPO1 : force harmonique (sur 2N pts) * * * * !!!! RI1, RI2 et RI3 sont SUPPRIMEES en fin de QZCONS2 !!! * * * * EN SORTIE : * * - RI4 : matrice de rigidite sur les memes ddls que MCHPO1 * * matrice 2nx2n = * * | -w^2 * M + K | -w * C | * * |--------------+--------------| * * | w * C | -w^2 * M + K | * * * ********************************************************************************** * -INC CCOPTIO -INC SMELEME -INC SMLMOTS -INC SMRIGID -INC SMCHPOI * LOGICAL AFFICH INTEGER I, J, NBPT, P, MAT(3) * * Affichage des messages pour verification AFFICH = .FALSE. nelrig=1 * * Lecture du support geometrique (points) de la rigidite RI1 (matrice de masse) * pour initialisation de MELEME, NBPT = Nbre de point du support (POINT_REPERE) * IPT1 : pointeur sur le support geométrique SEGACT, RI1 IPT1=RI1.IRIGEL(1,1) DESCR=RI1.IRIGEL(3,1) SEGDES, RI1 * SEGINI, MELEME=IPT1 NBPT = MELEME.NUM(/1) c SEGDES, MELEME * * Tests sur les rigidités : supports geométriques, dimensions des matrices * XMATRI : pointeur sur la matrice elementaire (1 seule ici) MAT(1)=RI1 MAT(2)=RI2 MAT(3)=RI3 DO 5, I=1, 3 MRIGID=MAT(I) IF (MRIGID.NE.0) THEN SEGACT, MRIGID xMATRI=MRIGID.IRIGEL(4,1) IPT1= MRIGID.IRIGEL(1,1) SEGDES, MRIGID SEGACT, xMATRI * XMATRI=IMATRI.IMATTT(1) * SEGDES, IMATRI * SEGACT, IPT1 * Verification des supports geométriques : taille identiques pour les 3 rigidites ? IF (IPT1.NUM(/1) .NE. NBPT) THEN CALL ERREUR(47) RETURN ENDIF * Verification des supports geométriques : points identiques pour les 3 rigidites ? DO 7, J=1, NBPT CALL POSPT(IPT1,J,MELEME, P) IF (P.EQ.0) THEN CALL ERREUR(47) RETURN ENDIF 7 CONTINUE SEGDES, IPT1 * c SEGACT, XMATRI * Verification des dimensions : nbre de ligne et de col. identiques pour les 3 ? IF (((XMATRI.RE(/1)).NE.NBPT) & .OR. ((XMATRI.RE(/2)).NE.NBPT)) THEN CALL ERREUR(47) RETURN ENDIF SEGDES, XMATRI ENDIF 5 CONTINUE * * affectation de XMATR1, XMATR2, XMATR3 SEGACT, RI1 xMATR1=RI1.IRIGEL(4,1) SEGDES, RI1 SEGACT, RI2 xMATR2=RI2.IRIGEL(4,1) SEGDES, RI2 IF (RI3.NE.0) THEN SEGACT, RI3 xMATR3=RI3.IRIGEL(4,1) SEGDES, RI3 ELSE xMATR3=0 ENDIF SEGACT, xMATR1*MOD * XMATR1=IMATR1.IMATTT(1) * SEGDES, IMATR1 SEGACT, xMATR2 * XMATR2=IMATR2.IMATTT(1) * SEGDES, IMATR2 IF (xMATR3.NE.0) THEN SEGACT, xMATR3*MOD * XMATR3=IMATR3.IMATTT(1) * SEGDES, IMATR3 ELSE SEGINI, XMATR3=XMATR1 DO 15, I=1, NBPT DO 15, J=1, NBPT XMATR3.RE(I,J,1)=0.d0 15 CONTINUE c SEGDES, XMATR3 ENDIF * * Assemblage des matrices bloc c SEGACT, XMATR1*MOD c SEGACT, XMATR2 c SEGACT, XMATR3*MOD DO 18, I=1, NBPT DO 18, J=1, NBPT XMATR1.RE(I,J,1)=XMATR2.RE(I,J,1)-(ROMEGA*ROMEGA*XMATR1.RE(I,J,1)) XMATR3.RE(I,J,1)=ROMEGA*XMATR3.RE(I,J,1) 18 CONTINUE c SEGDES, XMATR1 c SEGDES, XMATR2 c SEGDES, XMATR3 * * initialisation des dimensions de la matrice resultat XMATR4 NLIGRD=2*NBPT NLIGRP=2*NBPT SEGINI, XMATR4 c SEGDES, XMATR4 * CALL ASSMAT (MELEME,1.d0,RI1,-1.d0,RI3,1.d0,RI3,1.d0,RI1,XMATR4) * cbp : on desactive SEGDES, MELEME * Reorganisation du support geometrique à partir de celui de MCHPO1 SEGACT, MCHPO1 MSOUP1=MCHPO1.IPCHP(1) SEGDES, MCHPO1 SEGACT, MSOUP1 IPT2=MSOUP1.IGEOC SEGDES, MSOUP1 * NBSOUS=0 NBREF=0 NBELEM=1 NBNN=2*NBPT SEGINI, IPT1 SEGACT, IPT2 DO 28, I=1, NBNN IPT1.NUM(I,1)=IPT2.NUM(1,I) 28 CONTINUE SEGDES, IPT2 * * Reorganisation des composantes SEGINI, DES1 DO 38, I=1, NBNN DES1.NOELEP(I)=I DES1.NOELED(I)=I DES1.LISINC(I)='ALFA' DES1.LISDUA(I)='FALF' 38 CONTINUE * * Ecriture de la rigidite resultat RI4 SEGINI, RI4=RI1 c SEGACT, XMATR4 RI4.IRIGEL(1,1)=IPT1 RI4.IRIGEL(3,1)=DES1 ri4.irigel(4,1)=xmatr4 * IMATR4=RI4.IRIGEL(4,1) * SEGACT IMATR4*MOD * IMATR4.IMATTT(1)=XMATR4 * SEGDES IMATR4 SEGDES, RI4 SEGDES, IPT1 SEGDES, DES1 SEGDES,XMATR1,XMATR2,XMATR3,XMATR4 * * Menage ! * SEGSUP, RI1 SEGSUP, RI2 IF (RI3.NE.0) SEGSUP, RI3 * RETURN END