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