1 : C CQ8LOC SOURCE CHAT 05/01/12 22:27:23 5004 2 : SUBROUTINE CQ8LOC(XX,NBNN,SHPELE,TXR,IRR) 3 : C======================================================================= 4 : C CALCULE LES REPERES LOCAUX DES NOEUDS COQ6 ET COQ8 5 : C ENTREES 6 : C XX(3,NBNN) : COORDONNEES DES NOEUDS 7 : C NBNN : NOMBRE DE NOEUDS 8 : C SHPELE(6,NBNN,NBNN) : VALEURS DES FONCTIONS DE FORME ET 9 : C DE LEURS DERIVEES AUX NOEUDS 10 : C SORTIES 11 : C TXR(3,3,NBNN) :LES NBNN REPERE LOCAUX AUX NOEUDS 12 : C IRR :INDICATEUR D ERREUR 13 : C----------------------------------------------------------------------- 14 : C RECUPERATION BILBO JUILLET 86 15 : C======================================================================= 16 : IMPLICIT INTEGER(I-N) 17 : IMPLICIT REAL*8 (A-H,O-Z) 18 : PARAMETER(XZER=0.D0) 19 : DIMENSION XX(3,*),SHPELE(6,NBNN,*),TXR(3,3,*) 20 : DIMENSION T(9) 21 : C 22 : C --- DETERMINATION DES AXES LOCAUX AU NOEUD I --- 23 : C 24 : DO 50 I=1,NBNN 25 : DO 20 L=1,3 26 : DO 20 J=1,2 27 : K1=3*(J-1)+L 28 : T(K1)=XZER 29 : DO 20 K=1,NBNN 30 : T(K1)=T(K1)+SHPELE(J+1,K,I)*XX(L,K) 31 : 20 CONTINUE 32 : C 33 : C --- PRODUIT VECTORIEL ET NORMALISATION --- 34 : C 34 : CALL CROSS2(T(1),T(4),T(7),IRR) 34 : CALL CROSS2(T(7),T(1),T(4),IRR) 34 : CALL CROSS2(T(4),T(7),T(1),IRR) 35 : C 36 : IF(IRR.EQ.0) RETURN 37 : C 38 : C --- TRANSFERT DANS LE TABLEAU TXR --- 39 : C 40 : DO 40 J=1,3 41 : DO 40 K=1,3 42 : K1=3*(K-1)+J 43 : TXR(J,K,I)=T(K1) 44 : 40 CONTINUE 45 : 50 CONTINUE 46 : RETURN 47 : END 48 :
© Cast3M 2003 - All rights reserved.
Disclaimer