1 : C QZCONS SOURCE BP208322 12/10/03 21:15:26 7517 2 : SUBROUTINE QZCONS(RI1,RI2,RI3,XMATR1,XMATR2,MELEME,MLMOTS,DOUBLE) 3 : IMPLICIT INTEGER(I-N) 4 : IMPLICIT REAL*8 (A-H,O-Z) 5 : ********************************************************************************** 6 : * * 7 : * CONSTITUTION DES MATRICES A ET B DE TAILLE 2Nx2N POUR LE QZ * 8 : * ______________________________________________________________________________ * 9 : * * 10 : * * 11 : * DATE : le 24 Fevrier 1995 * 12 : * AUTEUR : Nicolas BENECH * 13 : * ______________________________________________________________________________ * 14 : * * 15 : * MODULE(S) APPELANT(S) : VIBRAC * 16 : * * 17 : * MODULE(S) APPELE(S) : ASSMAT, POSPT * 18 : * ______________________________________________________________________________ * 19 : * * 20 : * EN ENTREE : * 21 : * - RI1 : matrice masse * 22 : * - RI2 : matrice raideur * 23 : * - RI3 : matrice amortissement * 24 : * -DOUBLE : indique si on double le maillage * 25 : * * 26 : * !!!! RI1, RI2 et RI3 sont SUPPRIMEES en fin de QZCONS !!! * 27 : * * 28 : * EN SORTIE : * 29 : * - XMATR1, XMATR2 : les matrices A et B 2nx2n * 30 : * | -K . 0 | | C . M | * 31 : * A = | ....... | B = | ....... | * 32 : * | 0 . M | | M . 0 | * 33 : * * 34 : * - MELEME : le maillage support * 35 : * - MLMOTS : les composantes * 36 : ********************************************************************************** 37 : * 38 : -INC CCOPTIO 39 : -INC SMELEME 40 : -INC SMLMOTS 41 : -INC SMRIGID 42 : * 43 : LOGICAL AFFICH,DOUBLE 44 : INTEGER I, J, NBPT, P, MAT(3), NUMAFF 45 : * 46 : * Affichage des messages pour verification 47 : * 48 : NUMAFF = 21 49 : AFFICH = ((MOD(IIMPI,NUMAFF) .EQ. 0) .AND. (IIMPI.NE.0) ) 50 : * 51 : SEGACT, RI1 52 : IPT1=RI1.IRIGEL(1,1) 53 : DESCR=RI1.IRIGEL(3,1) 54 : SEGDES, RI1 55 : * 56 : SEGINI, MELEME=IPT1 57 : NBPT = MELEME.NUM(/1) 58 : c SEGDES, MELEME 59 : * 60 : * Tests sur les matrices a assembler : maillages identiques ? dimensions ? ... 61 : * 62 : MAT(1)=RI1 63 : MAT(2)=RI2 64 : MAT(3)=RI3 65 : 66 : DO 5, I=1, 3 67 : 68 : MRIGID=MAT(I) 69 : 70 : IF (MRIGID.NE.0) THEN 71 : SEGACT, MRIGID 72 : xMATRI=MRIGID.IRIGEL(4,1) 73 : IPT1= MRIGID.IRIGEL(1,1) 74 : SEGDES, MRIGID 75 : * 76 : * Verification des maillages 77 : * 78 : SEGACT, IPT1 79 : IF (IPT1.NUM(/1) .NE. NBPT) THEN 79 : CALL ERREUR(47) 80 : RETURN 81 : ENDIF 82 : DO 7, J=1, NBPT 82 : CALL POSPT(IPT1,J,MELEME, P) 83 : IF (P.EQ.0) THEN 83 : CALL ERREUR(47) 84 : RETURN 85 : ENDIF 86 : 7 CONTINUE 87 : SEGDES, IPT1 88 : * 89 : * Verification de la dimension des matrices 90 : * 91 : * SEGACT, IMATRI 92 : * XMATRI=IMATRI.IMATTT(1) 93 : * SEGDES, IMATRI 94 : SEGACT, XMATRI 95 : IF (((XMATRI.RE(/1)).NE.NBPT) 96 : & .OR. ((XMATRI.RE(/2)).NE.NBPT)) THEN 96 : CALL ERREUR(47) 97 : RETURN 98 : ENDIF 99 : SEGDES, XMATRI 100 : ENDIF 101 : 102 : 5 CONTINUE 103 : * 104 : * Assemblages 105 : * 106 : IF (AFFICH) 107 : & WRITE (*,*) 'Assemblage de la premiere matrice ...' 108 : NLIGRD=2*NBPT 109 : NLIGRP=2*NBPT 110 : nelrig=1 111 : SEGINI, XMATR1 112 : c SEGDES, XMATR1 112 : CALL ASSMAT (MELEME,-1.d0,RI2,0.d0,0,0.d0,0,1.d0,RI1,XMATR1) 113 : SEGINI, XMATR2 114 : c SEGDES, XMATR2 115 : IF (AFFICH) 116 : & WRITE (*,*) 'Assemblage de la seconde matrice ...' 116 : CALL ASSMAT (MELEME,1.d0,RI3,1.d0,RI1,1.d0,RI1,0.d0,0,XMATR2) 117 : * 118 : * Recuperation des composantes 119 : * 120 : SEGACT, DESCR 121 : IF (AFFICH) THEN 122 : WRITE (*,*) 'Longueur du DESCR : ', DESCR.LISINC(/2) 123 : WRITE (*,*) 'Nombre de points : ', NBPT 124 : ENDIF 125 : JGM = INT(DESCR.LISINC(/2)/NBPT) 126 : JGN=4 127 : SEGINI, MLMOTS 128 : DO 10, I=1,JGM 129 : MLMOTS.MOTS(I)=DESCR.LISINC(I) 130 : 10 CONTINUE 131 : SEGDES, MLMOTS 132 : SEGDES, DESCR 133 : * 134 : * Reorganisation du maillage pour la creation des CHPOINTs 135 : * 136 : NBELEM = NBPT 137 : NBNN=1 138 : NBSOUS=0 139 : NBREF=0 140 : SEGINI , IPT1 141 : c SEGACT, MELEME 142 : DO 1, I=1, NBPT 143 : IPT1.NUM(1,I)=MELEME.NUM(I,1) 144 : 1 CONTINUE 145 : SEGSUP, MELEME 146 : IF (DOUBLE) THEN 147 : NBELEM = NBPT*2 148 : SEGADJ, IPT1 149 : DO 2, I=1, NBPT 149 : CALL CREPO1 (0.0D0,0.0D0,0.0D0,IPOIN) 150 : IPT1.NUM(1,I+NBPT)=IPOIN 151 : 2 CONTINUE 152 : ENDIF 153 : SEGDES, IPT1 154 : MELEME = IPT1 155 : * 156 : * Menage ! 157 : * 158 : SEGSUP, RI1 159 : SEGSUP, RI2 160 : IF (RI3.NE.0) SEGSUP, RI3 161 : * 162 : RETURN 163 : END 164 : 165 : 166 :
© Cast3M 2003 - All rights reserved.
Disclaimer