1 : C QZCON2 SOURCE BP208322 12/10/03 21:15:22 7517 2 : C QZCON2 SOURCE GORC 95/07/07 21:17:31 1742 3 : SUBROUTINE QZCON2(RI1,RI2,RI3,ROMEGA,RI4,MCHPO1) 4 : IMPLICIT INTEGER(I-N) 5 : IMPLICIT REAL*8 (A-H,O-Z) 6 : ********************************************************************************** 7 : * * 8 : * CONSTITUTION DE LA MATRICE XMATR1 DE TAILLE 2Nx2N * 9 : * ______________________________________________________________________________ * 10 : * * 11 : * * 12 : * DATE : le 19 Decembre 1995 * 13 : * AUTEUR : Jerome CHARPENTIER * 14 : * ______________________________________________________________________________ * 15 : * * 16 : * MODULE(S) APPELANT(S) : VIBRAC * 17 : * * 18 : * MODULE(S) APPELE(S) : ASSMAT, POSPT * 19 : * ______________________________________________________________________________ * 20 : * * 21 : * EN ENTREE : * 22 : * - RI1 : matrice masse * 23 : * - RI2 : matrice raideur * 24 : * - RI3 : matrice amortissement * 25 : * - ROMEGA : pulsation (rad/s) * 26 : * - MCHPO1 : force harmonique (sur 2N pts) * 27 : * * 28 : * !!!! RI1, RI2 et RI3 sont SUPPRIMEES en fin de QZCONS2 !!! * 29 : * * 30 : * EN SORTIE : * 31 : * - RI4 : matrice de rigidite sur les memes ddls que MCHPO1 * 32 : * matrice 2nx2n = * 33 : * | -w^2 * M + K | -w * C | * 34 : * |--------------+--------------| * 35 : * | w * C | -w^2 * M + K | * 36 : * * 37 : ********************************************************************************** 38 : * 39 : -INC CCOPTIO 40 : -INC SMELEME 41 : -INC SMLMOTS 42 : -INC SMRIGID 43 : -INC SMCHPOI 44 : * 45 : 46 : LOGICAL AFFICH 47 : INTEGER I, J, NBPT, P, MAT(3) 48 : * 49 : * Affichage des messages pour verification 50 : AFFICH = .FALSE. 51 : nelrig=1 52 : * 53 : * Lecture du support geometrique (points) de la rigidite RI1 (matrice de masse) 54 : * pour initialisation de MELEME, NBPT = Nbre de point du support (POINT_REPERE) 55 : * IPT1 : pointeur sur le support geométrique 56 : SEGACT, RI1 57 : IPT1=RI1.IRIGEL(1,1) 58 : DESCR=RI1.IRIGEL(3,1) 59 : SEGDES, RI1 60 : * 61 : SEGINI, MELEME=IPT1 62 : NBPT = MELEME.NUM(/1) 63 : c SEGDES, MELEME 64 : * 65 : * Tests sur les rigidités : supports geométriques, dimensions des matrices 66 : * XMATRI : pointeur sur la matrice elementaire (1 seule ici) 67 : MAT(1)=RI1 68 : MAT(2)=RI2 69 : MAT(3)=RI3 70 : DO 5, I=1, 3 71 : MRIGID=MAT(I) 72 : IF (MRIGID.NE.0) THEN 73 : SEGACT, MRIGID 74 : xMATRI=MRIGID.IRIGEL(4,1) 75 : IPT1= MRIGID.IRIGEL(1,1) 76 : SEGDES, MRIGID 77 : SEGACT, xMATRI 78 : * XMATRI=IMATRI.IMATTT(1) 79 : * SEGDES, IMATRI 80 : * 81 : SEGACT, IPT1 82 : * Verification des supports geométriques : taille identiques pour les 3 rigidites ? 83 : IF (IPT1.NUM(/1) .NE. NBPT) THEN 83 : CALL ERREUR(47) 84 : RETURN 85 : ENDIF 86 : * Verification des supports geométriques : points identiques pour les 3 rigidites ? 87 : DO 7, J=1, NBPT 87 : CALL POSPT(IPT1,J,MELEME, P) 88 : IF (P.EQ.0) THEN 88 : CALL ERREUR(47) 89 : RETURN 90 : ENDIF 91 : 7 CONTINUE 92 : SEGDES, IPT1 93 : * 94 : c SEGACT, XMATRI 95 : * Verification des dimensions : nbre de ligne et de col. identiques pour les 3 ? 96 : IF (((XMATRI.RE(/1)).NE.NBPT) 97 : & .OR. ((XMATRI.RE(/2)).NE.NBPT)) THEN 97 : CALL ERREUR(47) 98 : RETURN 99 : ENDIF 100 : SEGDES, XMATRI 101 : ENDIF 102 : 5 CONTINUE 103 : * 104 : * affectation de XMATR1, XMATR2, XMATR3 105 : SEGACT, RI1 106 : xMATR1=RI1.IRIGEL(4,1) 107 : SEGDES, RI1 108 : SEGACT, RI2 109 : xMATR2=RI2.IRIGEL(4,1) 110 : SEGDES, RI2 111 : IF (RI3.NE.0) THEN 112 : SEGACT, RI3 113 : xMATR3=RI3.IRIGEL(4,1) 114 : SEGDES, RI3 115 : ELSE 116 : xMATR3=0 117 : ENDIF 118 : SEGACT, xMATR1*MOD 119 : * XMATR1=IMATR1.IMATTT(1) 120 : * SEGDES, IMATR1 121 : SEGACT, xMATR2 122 : * XMATR2=IMATR2.IMATTT(1) 123 : * SEGDES, IMATR2 124 : IF (xMATR3.NE.0) THEN 125 : SEGACT, xMATR3*MOD 126 : * XMATR3=IMATR3.IMATTT(1) 127 : * SEGDES, IMATR3 128 : ELSE 129 : SEGINI, XMATR3=XMATR1 130 : DO 15, I=1, NBPT 131 : DO 15, J=1, NBPT 132 : XMATR3.RE(I,J,1)=0.d0 133 : 15 CONTINUE 134 : c SEGDES, XMATR3 135 : ENDIF 136 : * 137 : * Assemblage des matrices bloc 138 : c SEGACT, XMATR1*MOD 139 : c SEGACT, XMATR2 140 : c SEGACT, XMATR3*MOD 141 : DO 18, I=1, NBPT 142 : DO 18, J=1, NBPT 143 : XMATR1.RE(I,J,1)=XMATR2.RE(I,J,1)-(ROMEGA*ROMEGA*XMATR1.RE(I,J,1)) 144 : XMATR3.RE(I,J,1)=ROMEGA*XMATR3.RE(I,J,1) 145 : 18 CONTINUE 146 : c SEGDES, XMATR1 147 : c SEGDES, XMATR2 148 : c SEGDES, XMATR3 149 : * 150 : * initialisation des dimensions de la matrice resultat XMATR4 151 : NLIGRD=2*NBPT 152 : NLIGRP=2*NBPT 153 : SEGINI, XMATR4 154 : c SEGDES, XMATR4 155 : * 155 : CALL ASSMAT (MELEME,1.d0,RI1,-1.d0,RI3,1.d0,RI3,1.d0,RI1,XMATR4) 156 : * 157 : cbp : on desactive 158 : SEGDES, MELEME 159 : 160 : * Reorganisation du support geometrique à partir de celui de MCHPO1 161 : SEGACT, MCHPO1 162 : MSOUP1=MCHPO1.IPCHP(1) 163 : SEGDES, MCHPO1 164 : SEGACT, MSOUP1 165 : IPT2=MSOUP1.IGEOC 166 : SEGDES, MSOUP1 167 : * 168 : NBSOUS=0 169 : NBREF=0 170 : NBELEM=1 171 : NBNN=2*NBPT 172 : SEGINI, IPT1 173 : SEGACT, IPT2 174 : DO 28, I=1, NBNN 175 : IPT1.NUM(I,1)=IPT2.NUM(1,I) 176 : 28 CONTINUE 177 : SEGDES, IPT2 178 : * 179 : * Reorganisation des composantes 180 : SEGINI, DES1 181 : DO 38, I=1, NBNN 182 : DES1.NOELEP(I)=I 183 : DES1.NOELED(I)=I 184 : DES1.LISINC(I)='ALFA' 185 : DES1.LISDUA(I)='FALF' 186 : 38 CONTINUE 187 : * 188 : * Ecriture de la rigidite resultat RI4 189 : SEGINI, RI4=RI1 190 : c SEGACT, XMATR4 191 : RI4.IRIGEL(1,1)=IPT1 192 : RI4.IRIGEL(3,1)=DES1 193 : ri4.irigel(4,1)=xmatr4 194 : * IMATR4=RI4.IRIGEL(4,1) 195 : * SEGACT IMATR4*MOD 196 : * IMATR4.IMATTT(1)=XMATR4 197 : * SEGDES IMATR4 198 : SEGDES, RI4 199 : SEGDES, IPT1 200 : SEGDES, DES1 201 : SEGDES,XMATR1,XMATR2,XMATR3,XMATR4 202 : * 203 : * Menage ! 204 : * 205 : SEGSUP, RI1 206 : SEGSUP, RI2 207 : IF (RI3.NE.0) SEGSUP, RI3 208 : * 209 : RETURN 210 : END 211 : 212 : 213 :
© Cast3M 2003 - All rights reserved.
Disclaimer