Sources Esope | Cast3M

bgrcq8
C BGRCQ8    SOURCE    CHAT      05/01/12    21:39:42     5004
      SUBROUTINE BGRCQ8(NOBG,XX,NBNN,TH,EXC,BGR,DET,E,SHPCOQ,TXR,IRR)
C |====================================================================|
C |  ROUTINE MODIFIEE LE 29/01/96 POUR COQUE EPAISSE AVEC EXCENTREMENT |
C | == ENTREES                                                         |
C |        NOBG    :    NUMERO DU POINT DE GAUSS                       |
C |        XX(3,NBNN) :    TABLEAU DES COORDONNEES DES NOEUDS          |
C |        NBNN    :    NOMBRE DE NOEUDS                               |
C |        TH(NBNN)   :    TABLEAU DES EPAISSEURS                      |
C |        EXC(NBNN)  :    TABLEAU DES EXCENTREMENTS                   |
C |        E   :    COORDONNEE REDUITE DU POINT DE GAUSS DANS          |
C |                 L EPAISSEUR                                        |
C |        SHPCOQ(6,NBNN,NBPGAU) : FONCTIONS DE FORME ET DERIVESS      |
C |                                AUX POINTS DE GAUSS                 |
C |        TXR(3,3,NBNN):TABLEAU DE CHGMT DE REPERE ENTRE NOEUD        |
C |                      ET REP GLOBAL                                 |
C | == SORTIES                                                         |
C |        BGR(9,LRE):  MATRICE BGR DE GRADIAN                         |
C |        DET     :    DETERMINANT DU JACOBIEN                        |
C |        IRE  : INDICATEUR DE SUCCES ( 1 ) , D ECHEC (0 OU-1)        |
C |   CODE SUO X.Z.                                                    |
C |====================================================================|
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8 (A-H,O-Z)
      PARAMETER(UN=1.D0,UNDEMI=.5D0,XZER=0.D0)
      DIMENSION XX(3,*),TH(*),EXC(*),BGR(9,*)
      DIMENSION SHPCOQ(6,NBNN,*),TXR(3,3,*)
      DIMENSION XJ(3,3),XJI(3,3),BI(9,3),BT(9,3),TT(9)
C*
C*    DETERMINATION DU JACOBIEN ET DE SON DETERMINANT AU POINT (R,S,T)
C*
      CALL CQ8JCE(NOBG,NBNN,E,XX,TH,EXC,TXR,SHPCOQ,XJ,DET,IRR)
C
      IF(IRR.EQ.-1) RETURN
 
C*
C*    DETERMINATION DES COSINUS DIRECTEURS DES AXES LOCAUX EN CE POINT
C*
      DO 10 I=1,3
      DO 10 J=1,2
      K=3*(J-1)+I
      TT(K)    = XJ(J,I)
   10 CONTINUE
C*
C*    PRODUITS VECTORIELS ET NORMALISATIONS
C*
      CALL CROSS2(TT(1),TT(4),TT(7),IRR)
      CALL CROSS2(TT(7),TT(1),TT(4),IRR)
      CALL CROSS2(TT(4),TT(7),TT(1),IRR)
C
      IF(IRR.EQ.0) RETURN
C*
C*    INVERSION DU JACOBIEN
C*
      DUM =UN/DET
      XJI(1,1) = DUM*( XJ(2,2)*XJ(3,3) - XJ(2,3)*XJ(3,2))
      XJI(2,1) = DUM*(-XJ(2,1)*XJ(3,3) + XJ(2,3)*XJ(3,1))
      XJI(3,1) = DUM*( XJ(2,1)*XJ(3,2) - XJ(2,2)*XJ(3,1))
      XJI(1,2) = DUM*(-XJ(1,2)*XJ(3,3) + XJ(1,3)*XJ(3,2))
      XJI(2,2) = DUM*( XJ(1,1)*XJ(3,3) - XJ(1,3)*XJ(3,1))
      XJI(3,2) = DUM*(-XJ(1,1)*XJ(3,2) + XJ(1,2)*XJ(3,1))
      XJI(1,3) = DUM*( XJ(1,2)*XJ(2,3) - XJ(1,3)*XJ(2,2))
      XJI(2,3) = DUM*(-XJ(1,1)*XJ(2,3) + XJ(1,3)*XJ(2,1))
      XJI(3,3) = DUM*( XJ(1,1)*XJ(2,2) - XJ(1,2)*XJ(2,1))
C*
C*    PRODUIT MATRICIEL TT TRANSPOSE * XJI
C*
      DO 20 I=1,3
      DO 20 J=1,3
      XJ(I,J)=XZER
      DO 20 K=1,3
      K1=3*(I-1)+K
      XJ(I,J) = XJ(I,J)+TT(K1)*XJI(K,J)
   20 CONTINUE
C*
C*    DETERMINATION DES COEFFICIENTS DES DEPLACEMENTS
C*
      DO 100 I=1,NBNN
      B1=XJ(1,1)*SHPCOQ(2,I,NOBG) +XJ(1,2)*SHPCOQ(3,I,NOBG)
      B2=XJ(2,1)*SHPCOQ(2,I,NOBG) +XJ(2,2)*SHPCOQ(3,I,NOBG)
      DO 30 J=1,9
      DO 30 K=1,3
      BI(J,K)=XZER
   30 CONTINUE
      BI(1,1) = B1
      BI(2,1) = B2
      BI(4,2) = B1
      BI(5,2) = B2
      BI(7,3) = B1
      BI(8,3) = B2
C*
C*====
C*
      DO 35 J=1,9
      DO 35 K=1,3
      KK=6*(I-1)+K
      BGR(J,KK)=XZER
      DO 35 L=1,3
      K1=3*(L-1)+K
   35 BGR(J,KK) = BGR(J,KK)+BI(J,L)*TT(K1)
C*
C*    DETERMINATION DES COEFFICIENTS DES ROTATIONS
C*
      DUM = XJ(3,3)*SHPCOQ(1,I,NOBG)
      DO 40 J=1,9
      DO 40 K=1,3
   40 BI(J,K) = BI(J,K)
      BI(3,1)=DUM
      BI(6,2)=DUM
      BI(9,3)=DUM
C*
C*=====
C*
      DO 45 J=1,9
      DO 45 K=1,3
      BI(J,K) = BI(J,K)*UNDEMI*TH(I)*E + BI(J,K)*EXC(I)
   45 CONTINUE
      BI(3,1)=DUM*UNDEMI*TH(I)
      BI(6,2)=DUM*UNDEMI*TH(I)
      BI(9,3)=DUM*UNDEMI*TH(I)
C
      DO 50 J=1,9
      DO 50 K=1,3
      BT(J,K) = XZER
      DO 50 L=1,3
      K1=3*(L-1)+K
      BT(J,K) = BT(J,K) + BI(J,L)*TT(K1)
   50 CONTINUE
C
      DO 60 J=1,3
   60 XJI(J,J)= XZER
      XJI(1,2) = TXR(1,1,I)*TXR(2,2,I)-TXR(2,1,I)*TXR(1,2,I)
      XJI(1,3) = TXR(1,1,I)*TXR(3,2,I)-TXR(1,2,I)*TXR(3,1,I)
      XJI(2,3) = TXR(2,1,I)*TXR(3,2,I)-TXR(2,2,I)*TXR(3,1,I)
      DO 70 J=1,3
      DO 70 K=J,3
      XJI(K,J) =-XJI(J,K)
   70 CONTINUE
C
      DO 80 J=1,9
      DO 80 K=1,3
      KK = 6*I+K-3
      BGR(J,KK)= XZER
      DO 80 L=1,3
      BGR(J,KK) = BGR(J,KK)+BT(J,L)*XJI(L,K)
   80 CONTINUE
  100 CONTINUE
      RETURN
      END