1 : C DOHCIS SOURCE CHAT 05/01/12 22:53:21 5004
2 : C
3 : SUBROUTINE DOHCIS(VELA,MATE,IFOU,LHOOK,DDHOOK,IRET)
4 : C
5 : C=======================================================================
6 : C
7 : C MATRICE DE HOOKE DES COQUES MINCES AVEC CISAILLEMENT TRANSVERSE
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 : DDHOOK(3,3)=GEGE
52 : C
53 : DDHOOK(4,4)=AUX
54 : DDHOOK(5,4)=AUX1
55 : DDHOOK(4,5)=AUX1
56 : DDHOOK(5,5)=AUX
57 : DDHOOK(6,6)=GEGE
58 : C
59 : DDHOOK(7,7)=GEGE/XK
60 : DDHOOK(8,8)=GEGE/XK
61 : ELSE
62 : IRET=0
63 : ENDIF
64 : C
65 : C MATERIAU ORTHOTROPE OU UNIDIRECTIONNEL
66 : C
67 : ELSE IF(MATE.EQ.'ORTHOTRO'.OR.
68 : 1 MATE.EQ.'UNIDIREC')THEN
69 : C
70 : C CAS TRIDIMENSIONNEL
71 : C
72 : IF(IFOU.EQ.2)THEN
73 : C
74 : IF(MATE.EQ.'ORTHOTRO')THEN
75 : YG1 = VELA(1)
76 : YG2 = VELA(2)
77 : XNU12 = VELA(3)
78 : G12 = VELA(4)
79 : G23 = VELA(5)
80 : G13 = VELA(6)
81 : COSA = VELA(7)
82 : SINA = VELA(8)
83 : C
84 : X1NUNU = UN - (XNU12**2) * YG2 / YG1
85 : D3HOO1(1,1) = YG1 / X1NUNU
86 : D3HOO1(2,2) = YG2 / X1NUNU
87 : D3HOO1(1,2) = XNU12 * D3HOO1(2,2)
88 : D3HOO1(2,1) = D3HOO1(1,2)
89 : D3HOO1(3,3) = G12
90 : D3HOO1(1,3) = XZER
91 : D3HOO1(2,3) = XZER
92 : D3HOO1(3,1) = XZER
93 : D3HOO1(3,2) = XZER
94 : C
95 : D2HOO1(1,1) = G13/XK
96 : D2HOO1(2,2) = G23/XK
97 : D2HOO1(1,2) = XZER
98 : D2HOO1(2,1) = XZER
99 : ELSE
99 : CALL ZERO(D3HOO1,3,3)
99 : CALL ZERO(D2HOO2,2,2)
100 : D3HOO1(1,1)=VELA(1)
101 : COSA=VELA(2)
102 : SINA=VELA(3)
103 : ENDIF
104 : C
105 : COS2 = COSA**2
106 : SIN2 = SINA**2
107 : SINCOS = SINA * COSA
108 : ROTHOO(1,1) = COS2
109 : ROTHOO(1,2) = SIN2
110 : ROTHOO(1,3) = SINCOS
111 : ROTHOO(2,1) = SIN2
112 : ROTHOO(2,2) = COS2
113 : ROTHOO(2,3) = - SINCOS
114 : ROTHOO(3,1) = - DEUX * SINCOS
115 : ROTHOO(3,2) = DEUX * SINCOS
116 : ROTHOO(3,3) = COS2 - SIN2
117 : C
118 : C PASSAGE DANS LE REPERE DE L'ELEMENT:
118 : CALL PRODT (D3HOO2,D3HOO1,ROTHOO,3,3)
119 : DO 400 J=1,3
120 : DO 400 I=1,3
121 : DDHOOK(I,J) = D3HOO2(I,J)
122 : DDHOOK(I+3,J+3) = D3HOO2(I,J)
123 : 400 CONTINUE
124 : C
125 : IF(MATE.EQ.'ORTHOTRO')THEN
126 : RO2HOO(1,1) = COSA
127 : RO2HOO(1,2) = SINA
128 : RO2HOO(2,1) = -SINA
129 : RO2HOO(2,2) = COSA
129 : CALL PRODT (D2HOO2,D2HOO1,RO2HOO,2,2)
130 : ENDIF
131 : DO 500 J=1,2
132 : DO 500 I=1,2
133 : DDHOOK(6+I,6+J) = D2HOO2(I,J)
134 : 500 CONTINUE
135 : C
136 : ELSE
137 : IRET=0
138 : ENDIF
139 : ELSE
140 : IRET=0
141 : ENDIF
142 : RETURN
143 : END
144 :
© Cast3M 2003 - All rights reserved.
Disclaimer