Sources Esope | Cast3M

coq8jc
C COQ8JC    SOURCE    CHAT      05/01/12    22:21:57     5004
      SUBROUTINE COQ8JC(NOBG,NBNN,E,XX,TH,TXR,SHPCOQ,XJ,DET,IRR)
C=======================================================================
C                 CALCULE LE JACOBIEN  DU COQ8 ET COQ6
C ENTREES
C     NOBG    :    NUMERO DU POINT DE GAUSS
C     NBNN    :    NOMBRE DE NOEUDS
C     E       :    COORDONNEE REDUITE DU POINT DE GAUSS DANS
C                  L EPAISSEUR
C XX(3,NBNN)  :    TABLEAU DES COORDONNEES DES NOEUDS
C TH(NBNN)    :    TABLEAU DES EPAISSEURS
C SHPCOQ(6,NBNN,NBPGAU)   FONCTIONS DE FORME ET DERIVEES AUX PTS DE GSS
C
C SORTIES
C     XJ(3,3) :    JACOBIEN
C     DET     :    DETERMINANT DU JACOBIEN
C     IRR     :    INDICATEUR DE SUCCES ( 1) , D ERREUR ( -1 )
C=======================================================================
C
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8 (A-H,O-Z)
      PARAMETER(XZER=0.D0,UNDEMI=.5D0)
      DIMENSION XX(3,*),TH(*),TXR(3,3,*),SHPCOQ(6,NBNN,*),XJ(3,*)
C
      IRR =1
C*
C*    CALCUL DU JACOBIEN XJ
C*
      DO 50 I=1,2
      DO 50 J=1,3
      XJ(I,J) = XZER
      DO 20 K=1,NBNN
      XJ(I,J)=XJ(I,J)+SHPCOQ(I+1,K,NOBG)*(XX(J,K)+UNDEMI*E*TXR(J,3,K)*
     +        TH(K))
   20 CONTINUE
   50 CONTINUE
C
      DO 60 J=1,3
      XJ(3,J)=XZER
      DO 60 K=1,NBNN
      XJ(3,J)=XJ(3,J)+UNDEMI*SHPCOQ(1,K,NOBG)*TXR(J,3,K)*TH(K)
   60 CONTINUE
C*
C*    CALCUL DU DETERMINANT DU JACOBIEN
C*
      DET=XJ(1,1)*XJ(2,2)*XJ(3,3)
     1   +XJ(1,2)*XJ(2,3)*XJ(3,1)
     2   +XJ(1,3)*XJ(2,1)*XJ(3,2)
     3   -XJ(1,3)*XJ(2,2)*XJ(3,1)
     4   -XJ(1,2)*XJ(2,1)*XJ(3,3)
     5   -XJ(1,1)*XJ(2,3)*XJ(3,2)
      IF(DET) 100,90,110
   90 IRR =-1
      GO TO 110
  100 DET = -DET
  110 RETURN
      END