Sources Esope | Cast3M

cqtgr2
C CQTGR2    SOURCE    CHAT      05/01/12    22:27:38     5004
      SUBROUTINE CQTGR2(XE,NBNN,NBPGAU,LRE,EPAIST,DZEGAU,SHPCOQ,
     1                  SHPELE,XDDL,XDDL1,GRADI)
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)
C |=====================================================================
C |   SOUS-PROGRAMME DE L'OPERATEUR GRADIENT (APPELE PAR GRAD1)
C |   CALCUL DU GRADIENT DE TEMPERATURE POUR LES ELEMENT COQ4,COQ6,COQ8
C |== ENTREES
C |     XX(3,NBNN):  TABLEAU DES COORDONNEES DES NOEUDS
C |     NBNN    : NOMBRE DE NOUDS
C |     NBPGAU  : NOMBRE DE POINTS DE GAUSS
C |     LRE     :    NOMBRE DE DDL
C |     EPAIST  :    EPAISSEUR DE LA COQUE
C |     DZEGAU(NBPGAU): COORDONNEES REDUITES DES POIN
C |                     DE GAUSS DANS L EPAISSEUR
C |     SHPCOQ(6,NBNN,NBPGAU) :FONCTIONS DE FORME ET DERIVEES
C |                            AUX POINTS DE  GAUSS
C |     SHPELE(6,NBNN,NBNN) :FONCTIONS DE FORME ET DERIVEES AUX NOEUDS
C |     XDDL(LRE):   TEMPERATURES AU NOEUDS
C |     XDDL1(LRE):  TABLEAU DE TRAVAIL
C |== SORTIES
C |     GRADI(2*NBPGAU):2 TERMS DE GRADIANT AUX NBPGAU POINTS DE GAUSS
C |      AUTEUR : P. DOWLATYARI  30/5/91
C |=====================================================================
 
-INC PPARAM
-INC CCOPTIO
      DIMENSION DZEGAU(*),SHPCOQ(6,NBNN,*),SHPELE(6,NBNN,*)
      DIMENSION XE(3,*),GRADI(*),XDDL(*),XDDL1(*)
      DIMENSION TXR(3,3,8),BGR(2,24),TH(8),TT(9),EXC(8)
      DIMENSION XJ(3,3),XJI(3,3)
      PARAMETER (XZERO=0.D0,UN=1.D0,DEUX=2.D0)
C
C    CALCUL DES AXES LOCAUX A TOUS LES NOEUDS
C
      CALL CQ8LOC(XE,NBNN,SHPELE,TXR,IRR)
        IF(IRR.EQ.0)THEN
          CALL ERREUR(515)
          RETURN
         ENDIF
C
       DO 10 I=1,NBNN
         TH(I)=EPAIST
         EXC(I)=0.D0
   10  CONTINUE
C
C     ON REORDONNE LES COMPOSANTES DE TEMPERATURES ET ON
C     LES MET DANS XDDL1
C
        DO 11 I=1,LRE
          JJ=(I-1)/NBNN
          KK=I-JJ*NBNN
          II=(KK-1)*3+JJ+1
          XDDL1(I)=XDDL(II)
  11    CONTINUE
C
C     BOUCLE SUR LES POINTS DE GAUSS
C
C
        DO 100 IGAU=1,NBPGAU
          CALL ZERO(BGR,2,LRE)
C
C        CALCUL DU JACOBIEN ET DE SON DETERMINENT EN CE POINT DE GAUSS
C
         E3=DZEGAU(IGAU)
         CALL CQ8JCE(IGAU,NBNN,E3,XE,TH,EXC,TXR,SHPCOQ,XJ,DJAC,IRR)
         IF (IRR.LT.0)THEN
*         JACOBIEN NUL DANS L'ELEMENT IEL
          INTERR(1)=0
          CALL ERREUR (405)
          RETURN
          ENDIF
*
*    INVERSION DU JACOBIEN
*
      DUM =UN/DJAC
      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))
*
*    DETERMINATION DES COSINUS DIRECTEURS DES AXES LOCAUX EN CE POINT
*
*                COQ8       COQ6
        IF(NBNN.EQ.8.OR.NBNN.EQ.6)THEN
*
         DO 20 I=1,3
         DO 20 J=1,2
          K=3*(J-1)+I
          TT(K)    = XJ(J,I)
   20    CONTINUE
*
*    PRODUITS VECTORIELS ET NORMALISATIONS
*
         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)
*
        ELSE
         IF(IGAU.EQ.1)THEN
*
*         CALCUL DES AXES LOCAUX DE L 'ELEMENT COQ4
*
*          DIAGONALE 1
*
            TT(1)=XE(1,3)-XE(1,1)
            TT(2)=XE(2,3)-XE(2,1)
            TT(3)=XE(3,3)-XE(3,1)
*
*          DIAGONALE 2
*
            TT(4)=XE(1,4)-XE(1,2)
            TT(5)=XE(2,4)-XE(2,2)
            TT(6)=XE(3,4)-XE(3,2)
*
*         NORMALE AUX 2 DIAGONALES
*
            CALL CROSS2(TT(1),TT(4),TT(7),IRR)
*
            TT(1)=XE(1,2)-XE(1,1)
            TT(2)=XE(2,2)-XE(2,1)
            TT(3)=XE(3,2)-XE(3,1)
*
           CALL CROSS2(TT(7),TT(1),TT(4),IRR)
           CALL CROSS2(TT(4),TT(7),TT(1),IRR)
*
          ENDIF
        ENDIF
       IF(IRR.EQ.0) THEN
*       ECHEC DANS LE CALCUL DES AXES LOCAUX
        CALL ERREUR(515)
        RETURN
       ENDIF
*
*
*    PRODUIT MATRICIEL TT TRANSPOSE * XJI
*
       DO 30 I=1,3
       DO 30 J=1,3
       XJ(I,J)=XZERO
       DO 30 K=1,3
       K1=3*(I-1)+K
       XJ(I,J) = XJ(I,J)+TT(K1)*XJI(K,J)
   30  CONTINUE
*
*     CALCUL DE LA MATRICE DE GRADIENT DES FONCTIONS DE FORME
*     DANS LE REPERE LOCAL
*
      NBNN2=2*NBNN
      DO 40  K = 1,LRE
      DO 40  I = 1,2
      DO 40  J = 1,3
        JJ=J+1
        IF(JJ.EQ.4)JJ=1
        IF(K.LE.NBNN)THEN
          KK=K
          IF(J.LE.2)THEN
          COEF=(E3/DEUX)*(E3-UN)
          ELSE
          COEF=E3-UN/DEUX
          ENDIF
        ELSEIF(K.GT.NBNN.AND.K.LE.NBNN2)THEN
          KK=K-NBNN
          IF(J.LE.2)THEN
           COEF=UN-E3*E3
           ELSE
           COEF=-DEUX*E3
           ENDIF
        ELSE
          KK=K-NBNN2
          IF(J.LE.2)THEN
           COEF=(E3/DEUX)*(E3+UN)
           ELSE
           COEF=E3+UN/DEUX
           ENDIF
         ENDIF
        BGR(I,K)=BGR(I,K)+COEF*SHPCOQ(JJ,KK,IGAU)*XJ(I,J)
 40    CONTINUE
C
C       CALCUL DE BGR*XDDL
C
        IG=(IGAU-1)*2+1
        CALL BGRDEP(BGR,2,XDDL1,LRE,GRADI(IG))
C
  100   CONTINUE
C
        RETURN
        END