1 : C COQ8KS SOURCE CHAT 05/01/12 22:22:05 5004 2 : SUBROUTINE COQ8KS(AKS,XX,SHPCOQ,SHPELE,NBPGAU,POIGAU, 3 : 1 DZEGAU,ES,SIGGAU,NBNN,LRE,LRI,RI) 4 : C============================================================== 5 : C MATRICE DES CONTRAINTES INITIALES COQ8 ET COQ6 6 : C ENTREES 7 : C XX(3,NBNN) = COORDONNEES DE L ELELEMENT 8 : C SHPCOQ(6,NBNN,NBPGAU) = FONCTIONS DE FORME POINTS DE CONTRAINTES 9 : C SHPELE(6,NBNN,NBNN) = FONCTIONS DE FORME NOEUDS 10 : C NBPGAU = NOMBRE DE POINTS DE GAUSS 11 : C POIGAU(NBPGAU) = POIDS D INTEGRATION 12 : C DZEGAU(NBPGAU) = TROISIEME COORDONNEE REDUITE 13 : C ES(NBNN) = EPAISSEURS 14 : C SIGGAU(5*NBPGAU) = LES CONTRAINTES 15 : C NBNN = NOMBRE DE NOEUDS 16 : C LRE = NOMBRE DE D.D.L. ( NBNN*6) 17 : C LRI = NOMBRE DE D.D.L. REDUITS ( NBNN*5) 18 : C TABLEAU DE TRAVAIL 19 : C RI(LRI,LRI) = TABLEAU DE TRAVAIL 20 : C SORTIES 21 : C AKS(LRE,LRE) = MATRICE DES CONTRAINTES INITIALES 22 : C 23 : C================================================================= 24 : IMPLICIT INTEGER(I-N) 25 : IMPLICIT REAL*8(A-H,O-Z) 26 : PARAMETER(XZER=0.D0,UN=1.D0,UNDEMI=.5D0) 27 : DIMENSION AKS(LRE,*),XX(3,*),SHPCOQ(6,NBNN,*),SHPELE(6,NBNN,*) 28 : DIMENSION POIGAU(*),DZEGAU(*) 29 : DIMENSION SIGGAU(*),ES(*),RI(LRI,*) 30 : DIMENSION H(8),P(2,8),TH(8),XJ(3,3),XJI(3,3) 31 : DIMENSION XJIT(3,3),TET(3,3),TT(9),TE(3,3),SIG(3,3),SIGT(3,3) 32 : DIMENSION SI(3,3),A(3,8),V2V1(3,2),V2V1T(2,3),RIP(2,2) 33 : DIMENSION VR(3,2),AKSP(3,3),TXR(3,3,8) 34 : DIMENSION AMA1(3,3),AMA2(3,3),AMA3(3,3) 35 : C 36 : C 37 : EQUIVALENCE(TET(1,1),TT(1)) 38 : C 39 : C OBJET MATRICE DE RIGIDITE GEOMETRIQUE ELEMENTAIRE 40 : C 41 : DO 5 I=1,NBNN 42 : 5 TH(I)=ES(I) 43 : DO 10 I=1,LRE 44 : DO 10 J=1,LRE 45 : 10 AKS(I,J)=XZER 45 : CALL CQ8LOC(XX,NBNN,SHPELE,TXR,IRR) 46 : DO 50 NGAU=1,NBPGAU 47 : DO 20 I=1,NBNN 48 : H(I) =SHPCOQ(1,I,NGAU) 49 : P(1,I)=SHPCOQ(2,I,NGAU) 50 : P(2,I)=SHPCOQ(3,I,NGAU) 51 : 20 CONTINUE 52 : DO 11 I=1,LRI 53 : DO 11 J=1,LRI 54 : RI(I,J)=XZER 55 : 11 CONTINUE 56 : E3=DZEGAU(NGAU) 57 : WT=POIGAU(NGAU) 57 : CALL COQ8JC(NGAU,NBNN,E3,XX,TH,TXR,SHPCOQ,XJ,DET,IRR) 58 : FACT=WT*DET 59 : C 60 : C INVERSION DE LA MATRICE JACOBIENNE 61 : C 62 : DUM= UN/DET 63 : XJI(1,1)=DUM*( XJ(2,2)*XJ(3,3)-XJ(2,3)*XJ(3,2)) 64 : XJI(2,1)=DUM*(-XJ(2,1)*XJ(3,3)+XJ(2,3)*XJ(3,1)) 65 : XJI(3,1)=DUM*( XJ(2,1)*XJ(3,2)-XJ(2,2)*XJ(3,1)) 66 : XJI(1,2)=DUM*(-XJ(1,2)*XJ(3,3)+XJ(1,3)*XJ(3,2)) 67 : XJI(2,2)=DUM*( XJ(1,1)*XJ(3,3)-XJ(1,3)*XJ(3,1)) 68 : XJI(3,2)=DUM*(-XJ(1,1)*XJ(3,2)+XJ(1,2)*XJ(3,1)) 69 : XJI(1,3)=DUM*( XJ(1,2)*XJ(2,3)-XJ(1,3)*XJ(2,2)) 70 : XJI(2,3)=DUM*(-XJ(1,1)*XJ(2,3)+XJ(1,3)*XJ(2,1)) 71 : XJI(3,3)=DUM*( XJ(1,1)*XJ(2,2)-XJ(1,2)*XJ(2,1)) 72 : C 73 : C CALCUL DE J-1 TRANSPOSEE 74 : C 75 : DO 30 I=1,3 76 : DO 30 J=1,3 77 : XJIT(I,J)=XJI(J,I) 78 : 30 CONTINUE 79 : C 80 : C CALCUL DE TET MATRICE DE LA ROTATION LOCALE AU POINT DE GAUSS 81 : C 82 : DO 31 I=1,3 83 : DO 31 J=1,2 84 : TET(I,J)=XJ(J,I) 85 : 31 CONTINUE 85 : CALL CROSS2(TT(1),TT(4),TT(7),IERR) 85 : CALL CROSS2(TT(7),TT(1),TT(4),IERR) 85 : CALL CROSS2(TT(4),TT(7),TT(1),IERR) 86 : C 87 : C TE EST LA TRANSPOSEE DE TET 88 : C 89 : DO 32 I=1,3 90 : DO 32 J=1,3 91 : TE(I,J)=TET(J,I) 92 : 32 CONTINUE 93 : C 94 : C ON RECUPERE LES CONTRAINTES D UN POINT DE GAUSS 95 : C 96 : SIG(1,1)=SIGGAU((NGAU-1)*5+1) 97 : SIG(2,2)=SIGGAU((NGAU-1)*5+2) 98 : SIG(1,2)=SIGGAU((NGAU-1)*5+3) 99 : SIG(1,3)=SIGGAU((NGAU-1)*5+4) 100 : SIG(2,3)=SIGGAU((NGAU-1)*5+5) 101 : SIG(2,1)=SIG(1,2) 102 : SIG(3,2)=SIG(2,3) 103 : SIG(3,1)=SIG(1,3) 104 : SIG(3,3)=XZER 105 : C 106 : C CALCUL DE SIGT=TET*SIG*TE 107 : C 107 : CALL MULMAT(AMA1,XJIT,TET,3,3,3) 107 : CALL MULMAT(AMA2,AMA1,SIG,3,3,3) 107 : CALL MULMAT(AMA3,AMA2,TE,3,3,3) 107 : CALL MULMAT(SIGT,AMA3,XJI,3,3,3) 108 : C 109 : C CALCUL DES TERMES RELATIFS AU NOEUD I,J 110 : C 111 : DO 40 I=1,NBNN 112 : DO 100 J=I,NBNN 113 : A(1,I)=P(1,I)*E3*TH(I)*UNDEMI 114 : A(2,I)=P(2,I)*E3*TH(I)*UNDEMI 115 : A(1,J)=P(1,J)*E3*TH(J)*UNDEMI 116 : A(2,J)=P(2,J)*E3*TH(J)*UNDEMI 117 : A(3,I)=H(I)*TH(I)*UNDEMI 118 : A(3,J)=H(J)*TH(J)*UNDEMI 119 : C 120 : DO 116 K=1,3 121 : IK=5*(I-1)+K 122 : JK=5*(J-1)+K 123 : DO 200 M=1,2 124 : DO 200 N=1,2 125 : RI(IK,JK)=RI(IK,JK)+SIGT(M,N)*P(M,I)*P(N,J) 126 : 200 CONTINUE 127 : 116 CONTINUE 128 : C 129 : DO 117 K=1,3 130 : IS=-1 131 : DO 117 L=4,5 132 : LL=L-3 133 : C 134 : C 135 : IK=5*(I-1)+K 136 : JL=5*(J-1)+L 137 : IS=-IS 138 : DO 210 M=1,2 139 : DO 210 N=1,3 140 : RI(IK,JL)=RI(IK,JL)+SIGT(M,N)*P(M,I)*TXR(K,LL,J)*A(N,J)*IS 141 : 210 CONTINUE 142 : 117 CONTINUE 143 : IS=-1 144 : C 145 : DO 119 K=4,5 146 : IS=-IS 147 : DO 119 L=1,3 148 : IK=5*(I-1)+K 149 : JL=5*(J-1)+L 150 : KK=K-3 151 : DO 230 N=1,2 152 : DO 230 M=1,3 153 : RI(IK,JL)=RI(IK,JL)+SIGT(M,N)*P(N,J)*TXR(L,KK,I)*A(M,I)*IS 154 : 230 CONTINUE 155 : 119 CONTINUE 156 : IS=1 157 : C 158 : DO 121 K=4,5 159 : IS=-IS 160 : DO 121 L=4,5 161 : IS=-IS 162 : KK=K-3 163 : LL=L-3 164 : IK=5*(I-1)+K 165 : JL=5*(J-1)+L 166 : COE1=XZER 167 : COE2=XZER 168 : DO 240 M=1,3 169 : DO 240 N=1,3 170 : COE1=COE1+SIGT(M,N)*A(M,I)*A(N,J) 171 : 240 CONTINUE 172 : DO 241 MM=1,3 173 : COE2=COE2+TXR(MM,KK,I)*TXR(MM,LL,J) 174 : 241 CONTINUE 175 : RI(IK,JL)=COE1*COE2*IS 176 : 121 CONTINUE 177 : C 178 : C CHANGEMENT DE VARIABLE ROTATIONS LOCALES-GLOBALES 179 : C ET INTEGRATION 180 : C 181 : DO 130 K=1,3 182 : DO 130 L=1,3 183 : IK6=6*(I-1)+K 184 : JL6=6*(J-1)+L 185 : IK5=5*(I-1)+K 186 : JL5=5*(J-1)+L 187 : AKS(IK6,JL6)=AKS(IK6,JL6)+FACT*RI(IK5,JL5) 188 : 130 CONTINUE 189 : C 190 : 100 CONTINUE 191 : 40 CONTINUE 192 : 50 CONTINUE 193 : C 194 : DO 150 I=1,LRE 195 : DO 150 J=1,I 196 : AKS(I,J)=AKS(J,I) 197 : 150 CONTINUE 198 : C 199 : RETURN 200 : END 201 :
© Cast3M 2003 - All rights reserved.
Disclaimer