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