Sources Esope | Cast3M

cq3gra
C CQ3GRA    SOURCE    CHAT      05/01/12    22:26:51     5004
      SUBROUTINE CQ3GRA(XXE,UUE,GRADI,
     1  UE,XX,YY,P,XE,YE,ZE,DT,DF,SK,T,Q,SD,CM,TM)
C
C |====================================================================|
C |                                                                    |
C |      ELEMENT COQ3 CALCUL DES GRADIANS
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 |           GRADI(9):GRADIAN AUX CENTRE DE GRAVITE                   |
C |           RANGEE 1-9                                               |
C |           UXDX  UXDY  UXDZ  UYDX  UYDY  UYDZ  UZDX  UZDY  UZDZ     |
C |    MAIS   UXDZ=-UZDX                                               |
C |           UYDZ=-UZDY                                               |
C |   CODE SUO X.Z.                                                    |
C |====================================================================|
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)
      DIMENSION GRADI(9)
      DIMENSION XXE(3,3),UUE(18)
      DIMENSION UE(18),XX(3),YY(3),P(3,3),XE(3),YE(3),ZE(3)
      DIMENSION DT(6),DF(9),SK(4,6),T(4,2),Q(2,9)
      DIMENSION CM(4),TM(4),SD(2)
C
C
      DATA S1SUR9/0.111111111111111D0/,S2SUR9/0.222222222222222D0/
      DATA S4SUR3/1.333333333333333D0/,S1SUR3/0.333333333333333D0/
      DATA XZERO/0.D0/
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
      S=1./(X13*Y23-X23*Y13)
      A1=Y13
      A2=-X13
      A3=Y23
      A4=-X23
C ====
      CALL ZERO(Q,2,9)
      CALL ZERO(SK,4,6)
      CALL ZERO(T,4,2)
C ====
      SK(1,1)=Y23
      SK(1,3)=-Y13
      SK(1,5)=Y13-Y23
      SK(2,1)=-X23
      SK(2,3)=X13
      SK(2,5)=X23-X13
      SK(3,2)=Y23
      SK(3,4)=-Y13
      SK(3,6)=Y13-Y23
      SK(4,2)=-X23
      SK(4,4)=X13
      SK(4,6)=X23-X13
C=====
      T(1,1)=-Y23
      T(1,2)= Y13
      T(2,1)= X23
      T(2,2)=-X13
      T(3,1)= Y23
      T(3,2)=-Y13
      T(4,1)=-X23
      T(4,2)= X13
C=====
      Q(1,1)= S4SUR3
      Q(1,2)= S2SUR9*A3-S1SUR3*A1
      Q(1,3)= S2SUR9*A4-S1SUR3*A2
      Q(1,4)= XZERO
      Q(1,5)= S1SUR9*A1
      Q(1,6)= S1SUR9*A2
      Q(1,7)=-S4SUR3
      Q(1,8)=-S2SUR9*A3-S1SUR9*A1
      Q(1,9)=-S2SUR9*A4-S1SUR9*A2
      Q(2,1)= XZERO
      Q(2,2)= S1SUR9*A3
      Q(2,3)= S1SUR9*A4
      Q(2,4)= S4SUR3
      Q(2,5)=-S1SUR3*A3+S2SUR9*A1
      Q(2,6)=-S1SUR3*A4+S2SUR9*A2
      Q(2,7)=-S4SUR3
      Q(2,8)=-S1SUR9*A3-S2SUR9*A1
      Q(2,9)=-S1SUR9*A4-S2SUR9*A2
C====
      CALL MULMAT(CM,SK,DT,4,1,6)
      CALL MULMAT(SD,Q,DF,2,1,9)
      CALL MULMAT(TM,T,SD,4,1,2)
      GRADI(1)= CM(1)*S
      GRADI(2)= CM(2)*S
      GRADI(4)= CM(3)*S
      GRADI(5)= CM(4)*S
      GRADI(3)= TM(1)*S
      GRADI(6)= TM(2)*S
      GRADI(7)= TM(3)*S
      GRADI(8)= TM(4)*S
      GRADI(9)= XZERO
      RETURN
      END