Sources Esope | Cast3M

coq3st
C COQ3ST    SOURCE    CHAT      05/01/12    22:21:38     5004
      SUBROUTINE COQ3ST(XXE,UUE,CONT,DDHOOK)
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
C        ELEMENT COQ3 CALCUL DES EFFORTS AU CENTRE DE GRAVITE.
C
CCCCCCCCCCC  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
CCCCCCCCCCC SORTIE
C                 CONT EFFORTS AUX CENTRE DE GRAVITE
C                      RANGES 3 EFFORTS  PUIS
C                             3 MOMENTS DE FLEXION
C                      S1 EST PORTE PAR LE COTE 1 DE L ELEMENT
C                      S2 EST PORTE PAR LA DIRECTION PERPENDICULAIRE
C                         A 1 ET DANS LE PLAN DE L ELEMENT
C
CCCCCCCCCCCC TRAVAIL
C
CCCCCCCCCCCCCCCCAUTRES TABLEUX IL FAUT EN TOUT 160
C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)
      DIMENSION XXE(3,*),UUE(*),CONT(*),DDHOOK(6,*)
      DIMENSION XGRAV(3),TW(6),CM(3),TM(3),CONT0(6)
      DIMENSION UE(18),XX(3),YY(3),P(3,3),XE(3),YE(3),ZE(3),
     1     DT(6),DF(9)
     1,SK(3,6),T(3,3),Q(3,9),SD(3),CI(3),CE(3)
      DATA UNTIER,DETIER/.333333333333333D0,.6666666666666667D0/
      DATA QUTIER,CISOIX/1.33333333333333D0,.0833333333333333D0/
      DATA UNSIX/0.1666666666666667D0/
C
C
C
      PS1=0.5
      RAI=1.
      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)
      XGRAV(1)=(XE(1)+XE(2)+XE(3))*UNTIER
      XGRAV(2)=(YE(1)+YE(2)+YE(3))*UNTIER
      XGRAV(3)=(ZE(1)+ZE(2)+ZE(3))*UNTIER
      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
      SK(1,1)=Y23
      SK(1,2)=0.
      SK(1,3)=-Y13
      SK(1,4)=0.
      SK(1,5)=Y13-Y23
      SK(1,6)=0.
      SK(2,1)=0.
      SK(2,2)=-X23
      SK(2,3)=0.
      SK(2,4)=X13
      SK(2,5)=0.
      SK(2,6)=X23-X13
      SK(3,1)=-X23
      SK(3,3)=X13
      SK(3,5)=X23-X13
      SK(3,2)=Y23
      SK(3,4)=-Y13
      SK(3,6)=Y13-Y23
      T(1,1)=Y23*Y23
      T(1,2)=Y13*Y13
      T(1,3)=-2.*(Y13*Y23)
      T(2,1)=X23*X23
      T(2,2)=X13*X13
      T(2,3)=-2.*(X13*X23)
      T(3,1)=-2.*X23*Y23
      T(3,2)=-2.*X13*Y13
      T(3,3)=2.*(X13*Y23+X23*Y13)
      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)
      CALL MULMAT(CM,SK,DT,3,1,6)
      CALL MULMAT(SD,Q,DF,3,1,9)
      CALL MULMAT(TM,T,SD,3,1,3)
      CPLA=S*S
      CMEM=RAI*S
      DO 306 IP=1,3
      CONT0(IP+3)=-TM(IP)*CPLA
      CONT0(IP  )= CM(IP)*CMEM
  306 CONTINUE
      CALL MULMAT(CONT,DDHOOK,CONT0,6,1,6)
      RETURN
      END