1 : C DOHCOE SOURCE CHAT 05/01/12 22:53:24 5004
2 : C
3 : SUBROUTINE DOHCOE(VELA,MATE,IFOU,LHOOK,DDHOOK,IRET)
4 : C
5 : C=======================================================================
6 : C
7 : C MATRICE DE HOOK DES COQUES EPAISSES
8 : C
9 : C ENTREES
10 : C VELA() = materiau dans un tableau de travail
11 : C MATE = Nom du materiau
12 : C IFOU = num{ro d'harmonique de fourier: IFOUR de CCOPTIO
13 : C LHOOK = taille de la matrice de hooke
14 : C
15 : C SORTIES
16 : C DDHOOK(LHOOK,LHOOK) = matrice de hooke
17 : C IRET = 1 si option existante 0 SINON
18 : C
19 : C Passage en nouveau CHAMELEM par I.Monnier le 4 05 90
20 : C=======================================================================
21 : C
22 : IMPLICIT INTEGER(I-N)
23 : IMPLICIT REAL*8(A-H,O-Z)
24 : PARAMETER(UNDEMI=.5D0,XZER=0.0D0,XK=1.2D0)
25 : PARAMETER(UN=1.D0,DEUX=2.D0)
26 : CHARACTER*8 MATE
27 : C
28 : DIMENSION VELA(*),DDHOOK(LHOOK,*)
29 : REAL*8 D3HOO1(3,3),D3HOO2(3,3),ROTHOO(3,3)
30 : REAL*8 D2HOO1(2,2),D2HOO2(2,2),RO2HOO(2,2)
31 : C
32 : IRET=1
32 : CALL ZERO(DDHOOK,LHOOK,LHOOK)
33 : C
34 : C MATERIAU ISOTROPE
35 : C
36 : IF(MATE.EQ.'ISOTROPE') THEN
37 : C
38 : C CAS TRIDIMENSIONNEL
39 : C
40 : IF(IFOU.EQ.2) THEN
41 : YOU=VELA(1)
42 : XNU=VELA(2)
43 : AUX=YOU/(UN-XNU*XNU)
44 : AUX1=AUX*XNU
45 : GEGE=YOU*UNDEMI/(UN+XNU)
46 : C
47 : DDHOOK(1,1)=AUX
48 : DDHOOK(2,1)=AUX1
49 : DDHOOK(1,2)=AUX1
50 : DDHOOK(2,2)=AUX
51 : C
52 : DDHOOK(3,3)=GEGE
53 : DDHOOK(4,4)=GEGE/XK
54 : DDHOOK(5,5)=DDHOOK(4,4)
55 : ELSE
56 : IRET=0
57 : ENDIF
58 : C
59 : C MATERIAU ORTHOTROPE ET UNIDIRECTIONNEL
60 : C
61 : ELSE IF(MATE.EQ.'ORTHOTRO'.OR.
62 : 1 MATE.EQ.'UNIDIREC') THEN
63 : C
64 : C CAS TRIDIMENSIONNEL
65 : C
66 : IF(IFOU.EQ.2)THEN
67 : C
68 : IF(MATE.EQ.'ORTHOTRO')THEN
69 : YG1 = VELA(1)
70 : YG2 = VELA(2)
71 : XNU12 = VELA(3)
72 : G12 = VELA(4)
73 : G23 = VELA(5)
74 : G13 = VELA(6)
75 : COSA = VELA(7)
76 : SINA = VELA(8)
77 : X1NUNU = UN - (XNU12**2) * YG2 / YG1
78 : C
79 : D3HOO1(1,1) = YG1 / X1NUNU
80 : D3HOO1(2,2) = YG2 / X1NUNU
81 : D3HOO1(1,2) = XNU12 * D3HOO1(2,2)
82 : D3HOO1(2,1) = D3HOO1(1,2)
83 : D3HOO1(3,3) = G12
84 : D3HOO1(1,3) = XZER
85 : D3HOO1(2,3) = XZER
86 : D3HOO1(3,1) = XZER
87 : D3HOO1(3,2) = XZER
88 : C
89 : D2HOO1(1,1) = G13/XK
90 : D2HOO1(2,2) = G23/XK
91 : D2HOO1(1,2) = XZER
92 : D2HOO1(2,1) = XZER
93 : ELSE
93 : CALL ZERO(D3HOO1,3,3)
93 : CALL ZERO(D2HOO2,2,2)
94 : D3HOO1(1,1)=VELA(1)
95 : COSA=VELA(2)
96 : SINA=VELA(3)
97 : ENDIF
98 : C
99 : COS2 = COSA**2
100 : SIN2 = SINA**2
101 : SINCOS = SINA * COSA
102 : ROTHOO(1,1) = COS2
103 : ROTHOO(1,2) = SIN2
104 : ROTHOO(1,3) = SINCOS
105 : ROTHOO(2,1) = SIN2
106 : ROTHOO(2,2) = COS2
107 : ROTHOO(2,3) = - SINCOS
108 : ROTHOO(3,1) = - DEUX * SINCOS
109 : ROTHOO(3,2) = DEUX * SINCOS
110 : ROTHOO(3,3) = COS2 - SIN2
111 : C
112 : C PASSAGE DANS LE REPERE DE L'ELEMENT:
112 : CALL PRODT (D3HOO2,D3HOO1,ROTHOO,3,3)
113 : DO 400 J=1,3
114 : DO 400 I=1,3
115 : DDHOOK(I,J) = D3HOO2(I,J)
116 : 400 CONTINUE
117 : C
118 : IF(MATE.EQ.'ORTHOTRO')THEN
119 : RO2HOO(1,1) = COSA
120 : RO2HOO(1,2) = SINA
121 : RO2HOO(2,1) = -SINA
122 : RO2HOO(2,2) = COSA
122 : CALL PRODT (D2HOO2,D2HOO1,RO2HOO,2,2)
123 : ENDIF
124 : C
125 : DO 500 J=1,2
126 : DO 500 I=1,2
127 : DDHOOK(3+I,3+J) = D2HOO2(I,J)
128 : 500 CONTINUE
129 : C
130 : ELSE
131 : IRET=0
132 : ENDIF
133 : ELSE
134 : IRET=0
135 : ENDIF
136 : RETURN
137 : END
138 :
© Cast3M 2003 - All rights reserved.
Disclaimer