46
47
48
49#include "implicit_f.inc"
50
51
52
53#include "mvsiz_p.inc"
54
55
56
57 INTEGER, INTENT(IN) :: NEL
58
60 . r11(*), r12(*), r13(*),
61 . r21(*), r22(*), r23(*),
62 . r31(*), r32(*), r33(*),
63 . k11(9,*) ,k12(9,*) ,k13(9,*) ,k14(9,*) ,k15(9,*) ,
64 . k16(9,*) ,k22(9,*) ,k23(9,*) ,k24(9,*) ,k25(9,*) ,
65 . k26(9,*) ,k33(9,*) ,k34(9,*) ,k35(9,*) ,k36(9,*) ,
66 . k44(9,*) ,k45(9,*) ,k46(9,*) ,k55(9,*) ,k56(9,*) ,
67 . k66(9,*)
69 . x1(*), x2(*), x3(*), x4(*),x5(*), x6(*),
70 . y1(*), y2(*), y3(*), y4(*),y5(*), y6(*),
71 . z1(*), z2(*), z3(*), z4(*),z5(*), z6(*)
72
73
74
75
76
77
78 INTEGER I,ISYM,L,J
79
81 . q(3,3,mvsiz)
83 . dr(3,3,mvsiz),
84 . r1(3,3,mvsiz),r2(3,3,mvsiz),r3(3,3,mvsiz),r4(3,3,mvsiz),
85 . r5(3,3,mvsiz),r6(3,3,mvsiz),di(6),xx,yy,zz,xy,xz,yz,rtr(6),
86 . abc,xxyz2,zzxy2,yyxz2,deta
87
88
89 DO i=1,nel
90 xx = x1(i)*x1(i)+x2(i)*x2(i)+x3(i)*x3(i)
91 1 +x4(i)*x4(i)+x5(i)*x5(i)+x6(i)*x6(i)
92 yy = y1(i)*y1(i)+y2(i)*y2(i)+y3(i)*y3(i)
93 1 +y4(i)*y4(i)+y5(i)*y5(i)+y6(i)*y6(i)
94 xy = x1(i)*y1(i)+x2(i)*y2(i)+x3(i)*y3(i)
95 1 +x4(i)*y4(i)+x5(i)*y5(i
96 xz = x1(i)*z1(i)+x2(i)*z2(i)+x3(i)*z3(i)
97 1 +x4(i)*z4(i)+x5(i)*z5(i)+x6(i)*z6(i)
98 yz = y1(i)*z1(i)+y2(i)*z2(i)+y3(i)*z3(i)
99 1 +y4(i)*z4(i)+y5(i)*z5(i)+y6(i)*z6(i)
100 zz = z1(i)*z1(i)+z2(i)*z2(i)+z3(i)*z3(i)
101 1 +z4(i)*z4(i)+z5(i)*z5(i)+z6(i)*z6(i)
102 rtr(1)= yy+zz
103 rtr(2)= xx+zz
104 rtr(3)= xx+yy
105 rtr(4)= -xy
106 rtr(5)= -xz
107 rtr(6)= -yz
108
109 abc = rtr(1)*rtr(2)*rtr(3)
110 xxyz2 = rtr(1)*rtr(6)*rtr(6)
111 yyxz2 = rtr(2)*rtr(5)*rtr(5)
112 zzxy2 = rtr(3)*rtr(4)*rtr(4)
113 deta = abc + two*rtr(4)*rtr(5)*rtr(6)-xxyz2-yyxz2-zzxy2
114 IF (deta<em20) THEN
115 deta=one
116 ELSE
117 deta=one/deta
118 ENDIF
119 di(1) = (abc-xxyz2)*deta/rtr(1)
120 di(2) = (abc-yyxz2)*deta/rtr(2)
121 di(3) = (abc-zzxy2)*deta/rtr(3)
122 di(4) = (rtr(5)*rtr(6)-rtr(4)*rtr(3))*deta
123 di(5) = (rtr(6)*rtr(4)-rtr(5)*rtr(2))*deta
124 di(6) = (rtr(4)*rtr(5)-rtr(6)*rtr(1))*deta
125 dr(1,1,i)= di(1)
126 dr(2,2,i)= di(2)
127 dr(3,3,i)= di(3)
128 dr(1,2,i)= di(4)
129 dr(1,3,i)= di(5)
130 dr(2,3,i)= di(6)
131 dr(2,1,i)= dr(1,2,i)
132 dr(3,1,i)= dr(1,3,i)
133 dr(3,2,i)= dr(2,3,i)
134 ENDDO
135
136 DO i=1,nel
137 DO l=1,3
138 DO j=1,3
139 r1(l,j,i)=zero
140 r2(l,j,i)=zero
141 r3(l,j,i)=zero
142 r4(l,j,i)=zero
143 r5(l,j,i)=zero
144 r6(l,j,i)=zero
145 ENDDO
146 ENDDO
147 END DO
148
149 DO i=1,nel
150 q(1,1,i)=r11(i)
151 q(1,2,i)=r21(i)
152 q(1,3,i)=r31(i)
153 q(2,1,i)=r12(i)
154 q(2,2,i)=r22(i)
155 q(2,3,i)=r32(i)
156 q(3,1,i)=r13(i)
157 q(3,2,i)=r23(i)
158 q(3,3,i)=r33(i)
159 ENDDO
160
161 CALL set_ri33(x1 ,y1, z1 ,r1 ,1,nel)
162 CALL set_ri33(x2 ,y2, z2 ,r2 ,1,nel)
163 CALL set_ri33(x3 ,y3, z3 ,r3 ,1,nel)
164 CALL set_ri33(x4 ,y4, z4 ,r4 ,1,nel)
165 CALL set_ri33(x5 ,y5, z5 ,r5 ,1,nel)
166 CALL set_ri33(x6 ,y6, z6 ,r6 ,1,nel)
168 1 r5 ,r6 ,
169 2 k11,k12,k13,k14,k15,k16,k22,k23,
170 3 k24,k25,k26,k33,k34,k35,k36,k44,
171 4 k45,k46,k55,k56,k66,
172 5 q ,1,nel )
173
174 RETURN
175
176 DO i=1,nel
177 q(1,1,i)=r11(i)
178 q(2,1,i)=r21(i)
179 q(3,1,i)=r31(i)
180 q(1,2,i)=r12(i)
181 q(2,2,i)=r22(i)
182 q(3,2,i)=r32(i)
183 q(1,3,i)=r13(i)
184 q(2,3,i)=r23(i)
185 q(3,3,i)=r33(i)
186 ENDDO
187 isym=1
188
195 isym=0
211
212 RETURN
subroutine set_ri33(xi, yi, zi, ri, jft, jlt)
subroutine setprojks6(dr, r1, r2, r3, r4, r5, r6, k11, k12, k13, k14, k15, k16, k22, k23, k24, k25, k26, k33, k34, k35, k36, k44, k45, k46, k55, k56, k66, vq, jft, jlt)
subroutine systran3(jft, jlt, vq, kk, isym)