1 : C CQ8JCE SOURCE CHAT 05/01/12 22:27:16 5004 2 : SUBROUTINE CQ8JCE(NOBG,NBNN,E,XX,TH,EXC,TXR,SHPCOQ,XJ,DET,IRR) 3 : C======================================================================= 4 : C CALCULE LE JACOBIEN DU COQ8 ET COQ6 AVEC EXCENTREMENT. 5 : C ENTREES 6 : C NOBG : NUMERO DU POINT DE GAUSS 7 : C NBNN : NOMBRE DE NOEUDS 8 : C E : COORDONNEE REDUITE DU POINT DE GAUSS DANS 9 : C L EPAISSEUR 10 : C XX(3,NBNN) : TABLEAU DES COORDONNEES DES NOEUDS 11 : C TH(NBNN) : TABLEAU DES EPAISSEURS 12 : C EXC(NBNN) : TABLEAU DES EXCENTREMENTS 13 : C SHPCOQ(6,NBNN,NBPGAU) FONCTIONS DE FORME ET DERIVEES AUX PTS DE GSS 14 : C 15 : C SORTIES 16 : C XJ(3,3) : JACOBIEN 17 : C DET : DETERMINANT DU JACOBIEN 18 : C IRR : INDICATEUR DE SUCCES ( 1) , D ERREUR ( -1 ) 19 : C======================================================================= 20 : C 21 : IMPLICIT INTEGER(I-N) 22 : IMPLICIT REAL*8 (A-H,O-Z) 23 : PARAMETER(XZER=0.D0,UNDEMI=.5D0) 24 : DIMENSION XX(3,*),TH(*),EXC(*),TXR(3,3,*),SHPCOQ(6,NBNN,*),XJ(3,*) 25 : C 26 : IRR =1 27 : C* 28 : C* CALCUL DU JACOBIEN XJ 29 : C* 30 : DO 50 I=1,2 31 : DO 50 J=1,3 32 : XJ(I,J) = XZER 33 : DO 20 K=1,NBNN 34 : XJ(I,J)=XJ(I,J)+SHPCOQ(I+1,K,NOBG)*(XX(J,K)+UNDEMI*TH(K)*E* 35 : + TXR(J,3,K)+EXC(K)*TXR(J,3,K)) 36 : 20 CONTINUE 37 : 50 CONTINUE 38 : C 39 : DO 60 J=1,3 40 : XJ(3,J)=XZER 41 : DO 60 K=1,NBNN 42 : XJ(3,J)=XJ(3,J)+UNDEMI*SHPCOQ(1,K,NOBG)*TXR(J,3,K)*TH(K) 43 : 60 CONTINUE 44 : C* 45 : C* CALCUL DU DETERMINANT DU JACOBIEN 46 : C* 47 : DET=XJ(1,1)*XJ(2,2)*XJ(3,3) 48 : 1 +XJ(1,2)*XJ(2,3)*XJ(3,1) 49 : 2 +XJ(1,3)*XJ(2,1)*XJ(3,2) 50 : 3 -XJ(1,3)*XJ(2,2)*XJ(3,1) 51 : 4 -XJ(1,2)*XJ(2,1)*XJ(3,3) 52 : 5 -XJ(1,1)*XJ(2,3)*XJ(3,2) 53 : IF(DET) 100,90,110 54 : 90 IRR =-1 55 : GO TO 110 56 : 100 DET = -DET 57 : 110 RETURN 58 : END 59 :
© Cast3M 2003 - All rights reserved.
Disclaimer