49
50
51
53
54
55
56#include "implicit_f.inc"
57#include "comlock.inc"
58
59
60
61#include "mvsiz_p.inc"
62
63
64
65
66
67
68 INTEGER, INTENT(IN) :: ISMSTR
69 INTEGER NNEGA,INDEX(MVSIZ),NEL
70
71 double precision
72 . x1(*), x2(*), x3(*), x4(*), x5(*), x6(*), x7(*), x8(*),
73 . y1(*), y2(*), y3(*), y4(*), y5(*), y6(*), y7(*), y8(*),
74 . z1(*), z2(*), z3(*), z4(*), z5(*), z6(*), z7(*), z8(*),
75 . sav(nel,21)
76
78 . det(*),
79 . px1(*), px2(*), px3(*), px4(*),
80 . py1(*), py2(*), py3(*), py4(*),
81 . pz1(*), pz2(*), pz3(*), pz4(*),
82 . hx(mvsiz,4), hy(mvsiz,4), hz(mvsiz,4),
83 . aj1(*),aj2(*),aj3(*),
84 . aj4(*),aj5(*),aj6(*),
85 . aj7(*),aj8(*),aj9(*),smax(*),offg(*)
86
87
88
89 INTEGER NGL(*), I, J ,ICOR
90
91
93 . dett(mvsiz) ,
94 . aji1(mvsiz), aji2(mvsiz), aji3(mvsiz),
95 . aji4(mvsiz), aji5(mvsiz), aji6(mvsiz),
96 . aji7(mvsiz), aji8(mvsiz), aji9(mvsiz),
97 . x17(mvsiz) , x28(mvsiz) , x35(mvsiz) , x46(mvsiz),
98 . y17(mvsiz) , y28(mvsiz) , y35(mvsiz) , y46(mvsiz),
99 . z17(mvsiz) , z28(mvsiz) , z35(mvsiz) , z46(mvsiz),
100 . jac_59_68(mvsiz), jac_67_49(mvsiz), jac_48_57(mvsiz),
101 . jac_38_29(mvsiz), jac_19_37(mvsiz), jac_27_18(mvsiz),
102 . jac_26_35(mvsiz), jac_34_16(mvsiz), jac_15_24(mvsiz),
103 . aj12(mvsiz), aj45(mvsiz), aj78(mvsiz),
104 . a17(mvsiz) , a28(mvsiz) ,
105 . b17(mvsiz) , b28(mvsiz) ,
106 . c17(mvsiz) , c28(mvsiz)
107
108 IF (nnega>0) THEN
109 IF (ismstr==10.OR.ismstr==12) THEN
110#include "vectorize.inc"
111 DO j=1,nnega
112 i = index(j)
113 x1(i)=sav(i,1)
114 y1(i)=sav(i,8)
115 z1(i)=sav(i,15)
116 x2(i)=sav(i,2)
117 y2(i)=sav(i,9)
118 z2(i)=sav(i,16)
119 x3(i)=sav(i,3)
120 y3(i)=sav(i,10)
121 z3(i)=sav(i,17)
122 x4(i)=sav(i,4)
123 y4(i)=sav(i,11)
124 z4(i)=sav(i,18)
125 x5(i)=sav(i,5)
126 y5(i)=sav(i,12)
127 z5(i)=sav(i,19)
128 x6(i)=sav(i,6)
129 y6(i)=sav(i,13)
130 z6(i)=sav(i,20)
131 x7(i)=sav(i,7)
132 y7(i)=sav(i,14)
133 z7(i)=sav(i,21)
134 x8(i)=zero
135 y8(i)=zero
136 z8(i)=zero
137 ENDDO
138 ELSE
139#include "vectorize.inc"
140 DO j=1,nnega
141 i = index(j)
142 x1(i)=sav(i,1)
143 y1(i)=sav(i,2)
144 z1(i)=sav(i,3)
145 x2(i)=sav(i,4)
146 y2(i)=sav(i,5)
147 z2(i)=sav(i,6)
148 x3(i)=sav(i,7)
149 y3(i)=sav(i,8)
150 z3(i)=sav(i,9)
151 x4(i)=sav(i,10)
152 y4(i)=sav(i,11)
153 z4(i)=sav(i,12)
154 x5(i)=sav(i,13)
155 y5(i)=sav(i,14)
156 z5(i)=sav(i,15)
157 x6(i)=sav(i,16)
158 y6(i)=sav(i,17)
159 z6(i)=sav(i,18)
160 x7(i)=sav(i,19)
161 y7(i)=sav(i,20)
162 z7(i)=sav(i,21)
163 x8(i)=zero
164 y8(i)=zero
165 z8(i)=zero
166 ENDDO
167 END IF
168#include "vectorize.inc"
169 DO j=1,nnega
170 i = index(j)
171#include "lockon.inc"
172 IF(ismstr<10) THEN
173 CALL ancmsg(msgid=260,anmode=aninfo,
174 . i1=ngl(i))
175 ELSE
176 CALL ancmsg(msgid=262,anmode=aninfo,
177 . i1=ngl(i))
178 END IF
179#include "lockoff.inc"
180
181 x17(i)=x7(i)-x1(i)
182 x28(i)=x8(i)-x2(i)
183 x35(i)=x5(i)-x3(i)
184 x46(i)=x6(i)-x4(i)
185 y17(i)=y7(i)-y1(i)
186 y28(i)=y8(i)-y2(i)
187 y35(i)=y5(i)-y3(i)
188 y46(i)=y6(i)-y4(i)
189 z17(i)=z7(i)-z1(i)
190 z28(i)=z8(i)-z2(i)
191 z35(i)=z5(i)-z3(i)
192 z46(i)=z6(i)-z4(i)
193
194 aj4(i)=x17(i)+x28(i)-x35(i)-x46(i)
195 aj5(i)=y17(i)+y28(i)-y35(i)-y46(i)
196 aj6(i)=z17(i)+z28(i)-z35(i)-z46(i)
197 a17(i)=x17(i)+x46(i)
198 a28(i)=x28(i)+x35(i)
199 b17(i)=y17(i)+y46(i)
200 b28(i)=y28(i)+y35(i)
201 c17(i)=z17(i)+z46(i)
202 c28(i)=z28(i)+z35(i)
203 aj7(i)=a17(i)+a28(i)
204 aj8(i)=b17(i)+b28(i)
205 aj9(i)=c17(i)+c28(i)
206 aj1(i)=a17(i)-a28(i)
207 aj2(i)=b17(i)-b28(i)
208 aj3(i)=c17(i)-c28(i)
209
210 jac_59_68(i)=aj5(i)*aj9(i)-aj6(i)*aj8(i)
211 jac_67_49(i)=aj6(i)*aj7(i)-aj4(i)*aj9(i)
212 jac_48_57(i)=aj4(i)*aj8(i)-aj5(i)*aj7(i)
213
214 det(i)=one_over_64*(aj1(i)*jac_59_68(i)+aj2(i)*jac_67_49(i)+aj3(i)*jac_48_57(i))
215 ENDDO
216 END IF
217
218#include "vectorize.inc"
219 DO j=1,nnega
220 i = index(j)
221 jac_38_29(i)=(-aj2(i)*aj9(i)+aj3(i)*aj8(i))
222 jac_19_37(i)=( aj1(i)*aj9(i)-aj3(i)*aj7(i))
223 jac_27_18(i)=(-aj1(i)*aj8(i)+aj2(i)*aj7(i))
224 jac_26_35(i)=( aj2(i)*aj6(i)-aj3(i)*aj5(i))
225 jac_34_16(i)=(-aj1(i)*aj6(i)+aj3(i)*aj4(i))
226 jac_15_24(i)=( aj1(i)*aj5(i)-aj2(i)*aj4(i))
227 dett(i)=one_over_64/det(i)
228 aji1(i)=dett(i)*jac_59_68(i)
229 aji4(i)=dett(i)*jac_67_49(i)
230 aji7(i)=dett(i)*jac_48_57(i)
231 aji2(i)=dett(i)*jac_38_29(i)
232 aji5(i)=dett(i)*jac_19_37(i)
233 aji8(i)=dett(i)*jac_27_18(i)
234 aji3(i)=dett(i)*jac_26_35(i)
235 aji6(i)=dett(i)*jac_34_16(i)
236 aji9(i)=dett(i)*jac_15_24(i)
237 aj12(i)=aji1(i)-aji2(i)
238 aj45(i)=aji4(i)-aji5(i)
239 aj78(i)=aji7(i)-aji8(i)
240 px2(i)= aj12(i)-aji3(i)
241 py2(i)= aj45(i)-aji6(i)
242 pz2(i)= aj78(i)-aji9(i)
243 px4(i)=-aj12(i)-aji3(i)
244 py4(i)=-aj45(i)-aji6(i)
245 pz4(i)=-aj78(i)-aji9(i)
246 aj12(i)=aji1(i)+aji2(i)
247 aj45(i)=aji4(i)+aji5(i)
248 aj78(i)=aji7(i)+aji8(i)
249 px1(i)=-aj12(i)-aji3(i)
250 py1(i)=-aj45(i)-aji6(i)
251 pz1(i)=-aj78(i)-aji9(i)
252 px3(i)=aj12(i)-aji3(i)
253 py3(i)=aj45(i)-aji6(i)
254 pz3(i)=aj78(i)-aji9(i)
255 END DO
256
257
258
259#include "vectorize.inc"
260 DO j=1,nnega
261 i = index(j)
262 hx(i,1)=(x1(i)+x2(i)-x3(i)-x4(i)-x5(i)-x6(i)+x7(i)+x8(i))
263 hy(i,1)=(y1(i)+y2(i)-y3(i)-y4(i)-y5(i)-y6(i)+y7(i)+y8(i))
264 hz(i,1)=(z1(i)+z2(i)-z3(i)-z4(i)-z5(i)-z6(i)+z7(i)+z8(i))
265
266 hx(i,2)=(x1(i)-x2(i)-x3(i)+x4(i)-x5(i)+x6(i)+x7(i)-x8(i))
267 hy(i,2)=(y1(i)-y2(i)-y3(i)+y4(i)-y5(i)+y6(i)+y7(i)-y8(i))
268 hz(i,2)=(z1(i)-z2(i)-z3(i)+z4(i)-z5(i)+z6(i)+z7(i)-z8(i))
269
270 hx(i,3)=(x1(i)-x2(i)+x3(i)-x4(i)+x5(i)-x6(i)+x7(i)-x8(i))
271 hy(i,3)=(y1(i)-y2(i)+y3(i)-y4(i)+y5(i)-y6(i)+y7(i)-y8(i))
272 hz(i,3)=(z1(i)-z2(i)+z3(i)-z4(i)+z5(i)-z6(i)+z7(i)-z8(i))
273
274 hx(i,4)=(-x1(i)+x2(i)-x3(i)+x4(i)+x5(i)-x6(i)+x7(i)-x8(i))
275 hy(i,4)=(-y1(i)+y2(i)-y3(i)+y4(i)+y5(i)-y6(i)+y7(i)-y8(i))
276 hz(i,4)=(-z1(i)+z2(i)-z3(i)+z4(i)+z5(i)-z6(i)+z7(i)-z8(i))
277 smax(i)= jac_59_68(i)*jac_59_68(i)+jac_67_49(i)*jac_67_49(i)
278 . +jac_48_57(i)*jac_48_57(i)
279 smax(i)=
max(smax(i),jac_38_29(i)*jac_38_29(i)+jac_19_37(i)*jac_19_37(i)
280 . +jac_27_18(i)*jac_27_18(i))
281 smax(i)=
max(smax(i),jac_26_35(i)*jac_26_35(i)+jac_34_16(i)*jac_34_16(i)
282 . +jac_15_24(i)*jac_15_24(i))
283 ENDDO
284
285 RETURN
286
287 3000 FORMAT(/' ZERO OR NEGATIVE SUB-VOLUME : 3D-ELEMENT NB:',i10/,
288 + ' ELEMENT IS SWITCHED TO SMALL STRAIN OPTION'/)
subroutine ancmsg(msgid, msgtype, anmode, i1, i2, i3, i4, i5, i6, i7, i8, i9, i10, i11, i12, i13, i14, i15, i16, i17, i18, i19, i20, r1, r2, r3, r4, r5, r6, r7, r8, r9, c1, c2, c3, c4, c5, c6, c7, c8, c9, prmode)