Sources Esope | Cast3M

dohcom
C DOHCOM    SOURCE    CHAT      05/01/12    22:53:27     5004
C
      SUBROUTINE DOHCOM(VELA,NCOELE,MATE,IFOU,LHOOK,DDHOOK,IRET)
C
C=======================================================================
C
C  MATRICE DE HOOK DES COQUES MINCES
C
C  ENTREES
C     VELA() = materiau dans un tableau de travail
C     NCOELE = TAILLE DU TABLEAU VELA
C     MATE   = Nom du materiau
C     IFOU   = num{ro d'harmonique de  fourier: IFOUR de CCOPTIO
C     LHOOK  = taille de la matrice de hooke
C
C  SORTIES
C     DDHOOK(LHOOK,LHOOK) = matrice de hooke
C     IRET = 1 si option existante 0 SINON
C
C     Passage en nouveau CHAMELEM par I.Monnier le 4 05 90
C=======================================================================
C
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)
      PARAMETER(UNDEMI=.5D0,XZER=0.0D0,XK=1.2D0)
      PARAMETER(UN=1.D0,DEUX=2.D0)
      CHARACTER*8 MATE
C
      DIMENSION VELA(*),DDHOOK(LHOOK,*)
      REAL*8 D3HOO1(3,3),D3HOO2(3,3),ROTHOO(3,3)
      REAL*8 D2HOO1(2,2),D2HOO2(2,2),RO2HOO(2,2)
C
      IRET=1
      CALL ZERO(DDHOOK,LHOOK,LHOOK)
C
C     MATERIAU ISOTROPE
C
      IF(MATE.EQ.'ISOTROPE') THEN
C
C     CAS TRIDIMENSIONNEL  ET FOURIER
C
      IF(IFOU.EQ.2.OR.IFOU.EQ.1) THEN
      YOU =VELA(1)
      XNU =VELA(2)
      AUX=YOU/(UN-XNU*XNU)
      AUX1=AUX*XNU
      GEGE=YOU*UNDEMI/(UN+XNU)
C
      DDHOOK(1,1)=AUX
      DDHOOK(2,1)=AUX1
      DDHOOK(1,2)=AUX1
      DDHOOK(2,2)=AUX
      DDHOOK(3,3)=GEGE
C
      DDHOOK(4,4)=AUX
      DDHOOK(5,4)=AUX1
      DDHOOK(4,5)=AUX1
      DDHOOK(5,5)=AUX
      DDHOOK(6,6)=GEGE
C
C     CAS AXISYMETRIQUE ET DEFORMATIONS PLANES
C
      ELSE IF(IFOU.EQ.0.OR.IFOU.EQ.-1.OR.IFOU.EQ.-3) THEN
      YOU =VELA(1)
      XNU =VELA(2)
      AUX=YOU/(UN-XNU*XNU)
      AUX1=AUX*XNU
C
      DDHOOK(1,1)=AUX
      DDHOOK(2,1)=AUX1
      DDHOOK(1,2)=AUX1
      DDHOOK(2,2)=AUX
C
      DDHOOK(3,3)=AUX
      DDHOOK(4,3)=AUX1
      DDHOOK(3,4)=AUX1
      DDHOOK(4,4)=AUX
C
C     CAS CONTRAINTES PLANES
C
      ELSE IF(IFOU.EQ.-2) THEN
      YOU =VELA(1)
      DDHOOK(1,1)=YOU
      DDHOOK(3,3)=YOU
      ELSE
      IRET=0
      ENDIF
C
C     MATERIAU ORTHOTROPE ET UNIDIRECTIONNEL
C
      ELSE IF(MATE.EQ.'ORTHOTRO'.OR.
     1        MATE.EQ.'UNIDIREC')THEN
C
C     CAS TRIDIMENSIONNEL ET FOURIER
C
      IF(IFOU.EQ.2.OR.IFOU.EQ.1) THEN
        IF(MATE.EQ.'ORTHOTRO')THEN
         YG1 = VELA(1)
         YG2 = VELA(2)
         XNU12 = VELA(3)
         G12 = VELA(4)
         COSA = VELA(5)
         SINA = VELA(6)
C
         X1NUNU = UN - (XNU12**2) * YG2 / YG1
C
         D3HOO1(1,1) = YG1 / X1NUNU
         D3HOO1(2,2) = YG2 / X1NUNU
         D3HOO1(1,2) = XNU12 * D3HOO1(2,2)
         D3HOO1(2,1) = D3HOO1(1,2)
         D3HOO1(3,3) = G12
         D3HOO1(1,3) = XZER
         D3HOO1(2,3) = XZER
         D3HOO1(3,1) = XZER
         D3HOO1(3,2) = XZER
C
       ELSE
         CALL ZERO(D3HOO1,3,3)
         D3HOO1(1,1)=VELA(1)
         COSA=VELA(2)
         SINA=VELA(3)
       ENDIF
         COS2 = COSA**2
         SIN2 = SINA**2
         SINCOS = SINA * COSA
C
         ROTHOO(1,1) = COS2
         ROTHOO(1,2) = SIN2
         ROTHOO(1,3) = SINCOS
         ROTHOO(2,1) = SIN2
         ROTHOO(2,2) = COS2
         ROTHOO(2,3) = - SINCOS
         ROTHOO(3,1) = - DEUX * SINCOS
         ROTHOO(3,2) = DEUX * SINCOS
         ROTHOO(3,3) = COS2 - SIN2
C
C        PASSAGE DANS LE REPERE DE L'ELEMENT:
         CALL PRODT (D3HOO2,D3HOO1,ROTHOO,3,3)
         DO 200 J=1,3
            DO 200 I=1,3
               DDHOOK(I,J) = D3HOO2(I,J)
               DDHOOK(I+3,J+3) = D3HOO2(I,J)
  200       CONTINUE
C
C     CAS AXISYMETRIQUE ET DEFORMATIONS PLANES
C
      ELSE IF(IFOU.EQ.0.OR.IFOU.EQ.-1.OR.IFOU.EQ.-3) THEN
        IF(MATE.EQ.'ORTHOTRO')THEN
         YG1 = VELA(1)
         YG2 = VELA(2)
         XNU12 = VELA(3)
         COSA = VELA(5)
         SINA = VELA(6)
C
         X1NUNU = UN - (XNU12**2) * YG2 / YG1
C
         D2HOO1(1,1) = YG1 / X1NUNU
         D2HOO1(2,2) = YG2 / X1NUNU
         D2HOO1(1,2) = XNU12 * D2HOO1(2,2)
         D2HOO1(2,1) = D2HOO1(1,2)
C
       ELSE
         CALL ZERO(D2HOO1,2,2)
         D2HOO1(1,1)=VELA(1)
         COSA=VELA(2)
         SINA=VELA(3)
       ENDIF
C
         COS2 = COSA**2
         SIN2 = SINA**2
         RO2HOO(1,1) = COS2
         RO2HOO(1,2) = SIN2
         RO2HOO(2,1) = SIN2
         RO2HOO(2,2) = COS2
C
C        PASSAGE DANS LE REPERE DE L'ELEMENT:
         CALL PRODT (D2HOO2,D2HOO1,RO2HOO,2,2)
         DO 300 J=1,2
            DO 300 I=1,2
               DDHOOK(I,J) = D2HOO2(I,J)
               DDHOOK(I+2,J+2) = D2HOO2(I,J)
  300       CONTINUE
C
C     CAS CONTRAINTES PLANES
C
      ELSE IF(IFOU.EQ.-2) THEN
        YG1=VELA(1)
         DDHOOK(1,1)=YG1
         DDHOOK(3,3)=YG1
C
      ELSE
      IRET=0
      ENDIF
C
C     MATERIAU COMPOSITE
C
      ELSE IF(MATE.EQ.'COMPOSIT') THEN
C
C        TRIDIM
C
      IF(IFOU.EQ.2) THEN
C
      M = NCOELE
      N = M/5
      N4 = N*4
C
C
      H = XZER
      DO 2072 J = N4+1,M
        H = H + VELA(J)
 2072 CONTINUE
C
      CMAT11=XZER
      CMAT12=XZER
      CMAT33=XZER
      CMAT14=XZER
      CMAT15=XZER
      CMAT36=XZER
      CMAT44=XZER
      CMAT45=XZER
      CMAT66=XZER
      Y2 = -H/2
C
      DO 2073 J = 1,N
        YOU = VELA(J )
        XNU = VELA(N+J )
        EPAI= VELA(N4+J)
        Y1 = Y2
        Y2 = EPAI + Y1
        X1B = EPAI
        X2B = ((Y2*Y2)-(Y1*Y1))/2.D0
        X3B = ((Y2**3)-(Y1**3))/3.D0
        AUX1 = YOU/(1.D0-XNU*XNU)
        AUX2 = (1.D0-XNU)*AUX1/2.D0
        CMAT11 = CMAT11 + (AUX1*X1B)
        CMAT12 = CMAT12 + (AUX1*XNU*X1B)
        CMAT33 = CMAT33 + (AUX2*X1B)
        CMAT14 = CMAT14 + (AUX1*X2B)
        CMAT15 = CMAT15 + (AUX1*XNU*X2B)
        CMAT36 = CMAT36 + (AUX2*X2B)
        CMAT44 = CMAT44 + (AUX1*X3B)
        CMAT45 = CMAT45 + (AUX1*XNU*X3B)
        CMAT66 = CMAT66 + (AUX2*X3B)
 2073 CONTINUE
C
      DDHOOK(1,1)  = CMAT11
      DDHOOK(2,2)  = CMAT11
      DDHOOK(1,2)  = CMAT12
      DDHOOK(2,1)  = CMAT12
      DDHOOK(3,3) =  CMAT33
C
      DDHOOK(4,1) = CMAT14
      DDHOOK(1,4) = CMAT14
      DDHOOK(5,2) = CMAT14
      DDHOOK(2,5) = CMAT14
C
      DDHOOK(1,5) = CMAT15
      DDHOOK(5,1) = CMAT15
      DDHOOK(2,4) = CMAT15
      DDHOOK(4,2) = CMAT15
C
      DDHOOK(3,6) = CMAT36
      DDHOOK(6,3) = CMAT36
C
      DDHOOK(4,4) = CMAT44
      DDHOOK(5,5) = CMAT44
      DDHOOK(4,5) = CMAT45
      DDHOOK(5,4) = CMAT45
      DDHOOK(6,6) = CMAT66
      ELSE
      IRET=0
      ENDIF
      ELSE
      IRET=0
      ENDIF
      RETURN
      END