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