Sources Esope | Cast3M

cq3grf
C CQ3GRF    SOURCE    CHAT      05/01/12    22:26:55     5004
      SUBROUTINE CQ3GRF(XXE,UUE,GRADF,
     1 UE,XX,YY,P,XE,YE,ZE,DT,DF,T,Q,SD,TM)
C|=====================================================================|
C|                                                                     |
C|       ELEMENT COQ3 CALCUL DES GRADIENS EN FLEXION ( GARFLEXI )      |
C|                                                                     |
C|== ENTREE                                                            |
C|      XXE(3,3) COORDONEES DES 3 NOEUDS DE L ELEMENT                  |
C|               RANGES X(1,2)=COORDONNEE X DU NOEUD 2                 |
C|                      X(2,2)=COORDONNEE Y DU NOEUD 2                 |
C|                      X(3,2)=COORDONNEE Z DU NOEUD 2                 |
C|      UUE(18)  VECTEUR DEPLACEMENT DE L ELEMENT                      |
C|                                                                     |
C|== SORTIE                                                            |
C|      GARDF(9) GARFLEXI AUX CENTRE DE GRAVITE                        |
C|               RANGEE  1-9                                           |
C|               WDXX   WDXY    0    0    WDYX   WDYY    0    0    0   |
C|                                                                     |
C|   CODE SUO X.Z.                                                     |
C|=====================================================================|
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)
      DIMENSION GRADF(9),XXE(3,3),UUE(18)
      DIMENSION TM(4),UE(18),DT(6),DF(9)
      DIMENSION XX(3),YY(3),P(3,3),XE(3),YE(3),ZE(3)
      DIMENSION T(4,3),Q(3,9),SD(3)
      DATA UNTIER,DETIER/.333333333333333D0,.6666666666666667D0/
      DATA QUTIER,CISOIX/1.33333333333333D0,.0833333333333333D0/
      DATA UNSIX/0.1666666666666667D0/
C
C
C
      DO 2 IP=1,18
    2 UE(IP)=UUE(IP)
      DO 4 IP=1,3
      XE(IP)=XXE(1,IP)
      YE(IP)=XXE(2,IP)
      ZE(IP)=XXE(3,IP)
    4 CONTINUE
      CALL PASSA(XE,YE,ZE,P,X13,X23,Y13,Y23)
      DO 10 IP=1,6
      IP1=3*(IP-1)
      DO 5 IQ=1,3
    5 XX(IQ)=UE(IQ+IP1)
      CALL MULMAT(YY,P,XX,3,1,3)
      DO 7 IQ=1,3
    7 UE(IQ+IP1)=YY(IQ)
   10 CONTINUE
      DO 8 IP=1,3
      IP1=IP-1
      IP2=2*IP1
      IP3=3*IP1
      IP6=6*IP1
      DO 9 IQ=1,2
    9 DT(IQ+IP2)=UE(IQ+IP6)
      DO 11 IQ=3,5
      IQ2=IQ-2
   11 DF(IQ2+IP3)=UE(IQ+IP6)
    8 CONTINUE
C ===
      S=1./(X13*Y23-X23*Y13)
      A1=Y13
      A2=-X13
      A3=Y23
      A4=-X23
C === MATRICE T(4,3)
      T(1,1)=Y23*Y23
      T(1,2)=Y13*Y13
      T(1,3)=-2.0D0*Y13*Y23
      T(2,1)=-X23*Y23
      T(2,2)=-X13*Y13
      T(2,3)=(X13*Y23+X23*Y13)
      T(3,1)=-X23*Y23
      T(3,2)=-X13*Y13
      T(3,3)=(X13*Y23+X23*Y13)
      T(4,1)=X23*X23
      T(4,2)=X13*X13
      T(4,3)=-2.0D0*X13*X23
C=== MATRICE Q(3,9)
      Q(1,1)=DETIER
      Q(1,2)=UNTIER*(2.*A1+A3)
      Q(1,3)=UNTIER*(2.*A2+A4)
      Q(1,4)=-QUTIER
      Q(1,5)=UNTIER*(-A1+2.*A3)
      Q(1,6)=UNTIER*(-A2+2.*A4)
      Q(1,7)=DETIER
      Q(1,8)=-A1+UNTIER*A3
      Q(1,9)=-A2+UNTIER*A4
      Q(2,1)=-QUTIER
      Q(2,2)=UNTIER*(2.*A1-A3)
      Q(2,3)=UNTIER*(2.*A2-A4)
      Q(2,4)=DETIER
      Q(2,5)=UNTIER*(A1+2.*A3)
      Q(2,6)=UNTIER*(A2+2.*A4)
      Q(2,7)=DETIER
      Q(2,8)=-A3+UNTIER*A1
      Q(2,9)=-A4+UNTIER*A2
      Q(3,1)=-DETIER
      Q(3,2)=UNTIER*A1+0.5*A3
      Q(3,3)=UNTIER*A2+0.5*A4
      Q(3,4)=-DETIER
      Q(3,5)=0.5*A1+UNTIER*A3
      Q(3,6)=0.5*A2+UNTIER*A4
      Q(3,7)=QUTIER
      Q(3,8)=-UNSIX*(A1+A3)
      Q(3,9)=-UNSIX*(A2+A4)
C ===
      CALL MULMAT(SD,Q,DF,3,1,9)
      CALL MULMAT(TM,T,SD,4,1,3)
      GRADF(1)=-S*S*TM(1)
      GRADF(2)=-S*S*TM(2)
      GRADF(3)=0.0D0
      GRADF(4)=-S*S*TM(3)
      GRADF(5)=-S*S*TM(4)
      GRADF(6)=0.0D0
      GRADF(7)=0.0D0
      GRADF(8)=0.0D0
      GRADF(9)=0.0D0
      RETURN
      END