1 : C BGRCQ8 SOURCE CHAT 05/01/12 21:39:42 5004 2 : SUBROUTINE BGRCQ8(NOBG,XX,NBNN,TH,EXC,BGR,DET,E,SHPCOQ,TXR,IRR) 3 : C |====================================================================| 4 : C | ROUTINE MODIFIEE LE 29/01/96 POUR COQUE EPAISSE AVEC EXCENTREMENT | 5 : C | == ENTREES | 6 : C | NOBG : NUMERO DU POINT DE GAUSS | 7 : C | XX(3,NBNN) : TABLEAU DES COORDONNEES DES NOEUDS | 8 : C | NBNN : NOMBRE DE NOEUDS | 9 : C | TH(NBNN) : TABLEAU DES EPAISSEURS | 10 : C | EXC(NBNN) : TABLEAU DES EXCENTREMENTS | 11 : C | E : COORDONNEE REDUITE DU POINT DE GAUSS DANS | 12 : C | L EPAISSEUR | 13 : C | SHPCOQ(6,NBNN,NBPGAU) : FONCTIONS DE FORME ET DERIVESS | 14 : C | AUX POINTS DE GAUSS | 15 : C | TXR(3,3,NBNN):TABLEAU DE CHGMT DE REPERE ENTRE NOEUD | 16 : C | ET REP GLOBAL | 17 : C | == SORTIES | 18 : C | BGR(9,LRE): MATRICE BGR DE GRADIAN | 19 : C | DET : DETERMINANT DU JACOBIEN | 20 : C | IRE : INDICATEUR DE SUCCES ( 1 ) , D ECHEC (0 OU-1) | 21 : C | CODE SUO X.Z. | 22 : C |====================================================================| 23 : IMPLICIT INTEGER(I-N) 24 : IMPLICIT REAL*8 (A-H,O-Z) 25 : PARAMETER(UN=1.D0,UNDEMI=.5D0,XZER=0.D0) 26 : DIMENSION XX(3,*),TH(*),EXC(*),BGR(9,*) 27 : DIMENSION SHPCOQ(6,NBNN,*),TXR(3,3,*) 28 : DIMENSION XJ(3,3),XJI(3,3),BI(9,3),BT(9,3),TT(9) 29 : C* 30 : C* DETERMINATION DU JACOBIEN ET DE SON DETERMINANT AU POINT (R,S,T) 31 : C* 31 : CALL CQ8JCE(NOBG,NBNN,E,XX,TH,EXC,TXR,SHPCOQ,XJ,DET,IRR) 32 : C 33 : IF(IRR.EQ.-1) RETURN 34 : 35 : C* 36 : C* DETERMINATION DES COSINUS DIRECTEURS DES AXES LOCAUX EN CE POINT 37 : C* 38 : DO 10 I=1,3 39 : DO 10 J=1,2 40 : K=3*(J-1)+I 41 : TT(K) = XJ(J,I) 42 : 10 CONTINUE 43 : C* 44 : C* PRODUITS VECTORIELS ET NORMALISATIONS 45 : C* 45 : CALL CROSS2(TT(1),TT(4),TT(7),IRR) 45 : CALL CROSS2(TT(7),TT(1),TT(4),IRR) 45 : CALL CROSS2(TT(4),TT(7),TT(1),IRR) 46 : C 47 : IF(IRR.EQ.0) RETURN 48 : C* 49 : C* INVERSION DU JACOBIEN 50 : C* 51 : DUM =UN/DET 52 : XJI(1,1) = DUM*( XJ(2,2)*XJ(3,3) - XJ(2,3)*XJ(3,2)) 53 : XJI(2,1) = DUM*(-XJ(2,1)*XJ(3,3) + XJ(2,3)*XJ(3,1)) 54 : XJI(3,1) = DUM*( XJ(2,1)*XJ(3,2) - XJ(2,2)*XJ(3,1)) 55 : XJI(1,2) = DUM*(-XJ(1,2)*XJ(3,3) + XJ(1,3)*XJ(3,2)) 56 : XJI(2,2) = DUM*( XJ(1,1)*XJ(3,3) - XJ(1,3)*XJ(3,1)) 57 : XJI(3,2) = DUM*(-XJ(1,1)*XJ(3,2) + XJ(1,2)*XJ(3,1)) 58 : XJI(1,3) = DUM*( XJ(1,2)*XJ(2,3) - XJ(1,3)*XJ(2,2)) 59 : XJI(2,3) = DUM*(-XJ(1,1)*XJ(2,3) + XJ(1,3)*XJ(2,1)) 60 : XJI(3,3) = DUM*( XJ(1,1)*XJ(2,2) - XJ(1,2)*XJ(2,1)) 61 : C* 62 : C* PRODUIT MATRICIEL TT TRANSPOSE * XJI 63 : C* 64 : DO 20 I=1,3 65 : DO 20 J=1,3 66 : XJ(I,J)=XZER 67 : DO 20 K=1,3 68 : K1=3*(I-1)+K 69 : XJ(I,J) = XJ(I,J)+TT(K1)*XJI(K,J) 70 : 20 CONTINUE 71 : C* 72 : C* DETERMINATION DES COEFFICIENTS DES DEPLACEMENTS 73 : C* 74 : DO 100 I=1,NBNN 75 : B1=XJ(1,1)*SHPCOQ(2,I,NOBG) +XJ(1,2)*SHPCOQ(3,I,NOBG) 76 : B2=XJ(2,1)*SHPCOQ(2,I,NOBG) +XJ(2,2)*SHPCOQ(3,I,NOBG) 77 : DO 30 J=1,9 78 : DO 30 K=1,3 79 : BI(J,K)=XZER 80 : 30 CONTINUE 81 : BI(1,1) = B1 82 : BI(2,1) = B2 83 : BI(4,2) = B1 84 : BI(5,2) = B2 85 : BI(7,3) = B1 86 : BI(8,3) = B2 87 : C* 88 : C*==== 89 : C* 90 : DO 35 J=1,9 91 : DO 35 K=1,3 92 : KK=6*(I-1)+K 93 : BGR(J,KK)=XZER 94 : DO 35 L=1,3 95 : K1=3*(L-1)+K 96 : 35 BGR(J,KK) = BGR(J,KK)+BI(J,L)*TT(K1) 97 : C* 98 : C* DETERMINATION DES COEFFICIENTS DES ROTATIONS 99 : C* 100 : DUM = XJ(3,3)*SHPCOQ(1,I,NOBG) 101 : DO 40 J=1,9 102 : DO 40 K=1,3 103 : 40 BI(J,K) = BI(J,K) 104 : BI(3,1)=DUM 105 : BI(6,2)=DUM 106 : BI(9,3)=DUM 107 : C* 108 : C*===== 109 : C* 110 : DO 45 J=1,9 111 : DO 45 K=1,3 112 : BI(J,K) = BI(J,K)*UNDEMI*TH(I)*E + BI(J,K)*EXC(I) 113 : 45 CONTINUE 114 : BI(3,1)=DUM*UNDEMI*TH(I) 115 : BI(6,2)=DUM*UNDEMI*TH(I) 116 : BI(9,3)=DUM*UNDEMI*TH(I) 117 : C 118 : DO 50 J=1,9 119 : DO 50 K=1,3 120 : BT(J,K) = XZER 121 : DO 50 L=1,3 122 : K1=3*(L-1)+K 123 : BT(J,K) = BT(J,K) + BI(J,L)*TT(K1) 124 : 50 CONTINUE 125 : C 126 : DO 60 J=1,3 127 : 60 XJI(J,J)= XZER 128 : XJI(1,2) = TXR(1,1,I)*TXR(2,2,I)-TXR(2,1,I)*TXR(1,2,I) 129 : XJI(1,3) = TXR(1,1,I)*TXR(3,2,I)-TXR(1,2,I)*TXR(3,1,I) 130 : XJI(2,3) = TXR(2,1,I)*TXR(3,2,I)-TXR(2,2,I)*TXR(3,1,I) 131 : DO 70 J=1,3 132 : DO 70 K=J,3 133 : XJI(K,J) =-XJI(J,K) 134 : 70 CONTINUE 135 : C 136 : DO 80 J=1,9 137 : DO 80 K=1,3 138 : KK = 6*I+K-3 139 : BGR(J,KK)= XZER 140 : DO 80 L=1,3 141 : BGR(J,KK) = BGR(J,KK)+BT(J,L)*XJI(L,K) 142 : 80 CONTINUE 143 : 100 CONTINUE 144 : RETURN 145 : END 146 : 147 :
© Cast3M 2003 - All rights reserved.
Disclaimer