194 use element_mod , only : nixtg
195
196
197
198#include "implicit_f.inc"
199
200
201
202#include "mvsiz_p.inc"
203
204
205
206 INTEGER JFT, JLT,ISROT,NEL
207 INTEGER IXTG(NIXTG,*)
209 . x(3,*), offg(*), dr(3,*),
210 . e1x(*), e1y(*), e1z(*),
211 . e2x(*), e2y(*), e2z(*),e3x(*), e3y(*), e3z(*),
212 . xl2(*),xl3(*),yl2(*),yl3(*),
area(*),
213 . v21x(*),v31x(*),v21y(*),v31y(*),rz13(*),rz23(*),
214 . x2_t(*),x3_t(*),y2_t(*),y3_t(*)
215 DOUBLE PRECISION
216 . SMSTR(*)
217
218
219
220 INTEGER I,II(6),NN(3)
222 . x0g2(mvsiz),x0g3(mvsiz),y0g2(mvsiz),y0g3(mvsiz),off_l,
223 . z0g2(mvsiz),z0g3(mvsiz),axyz(mvsiz,3,3),
224 . e01x(mvsiz), e01y(mvsiz), e01z(mvsiz),
225 . e02x(mvsiz), e02y(mvsiz), e02z(mvsiz),e03x(mvsiz),
226 . e03y(mvsiz), e03z(mvsiz),x0l2(mvsiz), x0l3(mvsiz),
227 . y0l2(mvsiz),y0l3(mvsiz),sum(mvsiz),
norm,xl,yl,vr1_12,vr1_21,
228 . rlz1,rlz2,rlz3,areai,x0g32,y0g32,z0g32,dirz(mvsiz,2)
229
230 DO i=1,6
231 ii(i) = nel*(i-1)
232 ENDDO
233
234 DO i=jft,jlt
235 IF(abs(offg(i))==one)offg(i)=sign(two,offg(i))
236 axyz(i,1:3,1:3)= zero
237
238 IF (isrot > 0 ) THEN
239 nn(1) = ixtg(2,i)
240 nn(2) = ixtg(3,i)
241 nn(3) = ixtg(4,i)
242 axyz(i,1,1) = dr(1,nn(1))
243 axyz(i,2,1) = dr(2,nn(1))
244 axyz(i,3,1) = dr(3,nn(1))
245 axyz(i,1,2) = dr(1,nn(2))
246 axyz(i,2,2) = dr(2,nn(2))
247 axyz(i,3,2) = dr(3,nn(2))
248 axyz(i,1,3) = dr(1,nn(3))
249 axyz(i,2,3) = dr(2,nn(3))
250 axyz(i,3,3) = dr(3,nn(3))
251 END IF
252
253 x0g2(i) = smstr(ii(1)+i)
254 y0g2(i) = smstr(ii(2)+i)
255 z0g2(i) = smstr(ii(3)+i)
256 x0g3(i) = smstr(ii(4)+i)
257 y0g3(i) = smstr(ii(5)+i)
258 z0g3(i) = smstr(ii(6)+i)
259 ENDDO
260
261 DO i=jft,jlt
262 e01x(i)= x0g2(i)
263 e01y(i)= y0g2(i)
264 e01z(i)= z0g2(i)
265 sum(i) = sqrt(e01x(i)*e01x(i)+e01y(i)*e01y(i)+e01z(i)*e01z(i))
266 e01x(i)=e01x(i)/sum(i)
267 e01y(i)=e01y(i)/sum(i)
268 e01z(i)=e01z(i)/sum(i)
269 ENDDO
270
271 DO i=jft,jlt
272 x0g32=x0g3(i)-x0g2(i)
273 y0g32=y0g3(i)-y0g2(i)
274 z0g32=z0g3(i)-z0g2(i)
275 e03x(i)=y0g3(i)*z0g32-z0g3(i)*y0g32
276 e03y(i)=z0g3(i)*x0g32-x0g3(i)*z0g32
277 e03z(i)=x0g3(i)*y0g32-y0g3(i)*x0g32
278 sum(i) = sqrt(e03x(i)*e03x(i)+e03y(i)*e03y(i)+e03z(i)*e03z(i))
279 e03x(i)=e03x(i)/sum(i)
280 e03y(i)=e03y(i)/sum(i)
281 e03z(i)=e03z(i)/sum(i)
282 area(i) = half * sum(i)
283 ENDDO
284
285 DO i=jft,jlt
286 e02x(i)=e03y(i)*e01z(i)-e03z(i)*e01y(i)
287 e02y(i)=e03z(i)*e01x(i)-e03x(i)*e01z(i)
288 e02z(i)=e03x(i)*e01y(i)-e03y(i)*e01x(i)
289 sum(i) = sqrt(e02x(i)*e02x(i)+e02y(i)*e02y(i)+e02z(i)*e02z(i))
290 e02x(i)=e02x(i)/sum(i)
291 e02y(i)=e02y(i)/sum(i)
292 e02z(i)=e02z(i)/sum(i)
293 ENDDO
294
295
296
297 DO i=jft,jlt
298 vr1_12=e01x(i)*e2x(i)+e01y(i)*e2y(i)+e01z(i)*e2z(i)
299 vr1_21=e02x(i)*e1x(i)+e02y(i)*e1y(i)+e02z(i)*e1z(i)
300 dirz(i,2) = half*(vr1_12-vr1_21)
301 norm = one-dirz(i,2)*dirz(i,2)
302 dirz(i,1) = sqrt(
max(zero,
norm))
303 ENDDO
304 DO i=jft,jlt
305 x0l2(i)=e01x(i)*x0g2(i)+e01y(i)*y0g2(i)+e01z(i)*z0g2(i)
306 y0l2(i)=e02x(i)*x0g2(i)+e02y(i)*y0g2(i)+e02z(i)*z0g2(i)
307 x0l3(i)=e01x(i)*x0g3(i)+e01y(i)*y0g3(i)+e01z(i)*z0g3(i)
308 y0l3(i)=e02x(i)*x0g3(i)+e02y(i)*y0g3(i)+e02z(i)*z0g3(i)
309 ENDDO
310
311
312
313 DO i=jft,jlt
314 xl= x0l2(i)*dirz(i,1)-y0l2(i)*dirz(i,2)
315 yl= x0l2(i)*dirz(i,2)+y0l2(i)*dirz(i,1)
316 x0l2(i)=xl
317 y0l2(i)=yl
318 xl= x0l3(i)*dirz(i,1)-y0l3(i)*dirz(i,2)
319 yl= x0l3(i)*dirz(i,2)+y0l3(i)*dirz(i,1)
320 x0l3(i)=xl
321 y0l3(i)=yl
322 ENDDO
323
324 DO i=jft,jlt
325 v21x(i)=xl2(i)-x0l2(i)
326 v31x(i)=xl3(i)-x0l3(i)
327 v21y(i)=yl2(i)-y0l2(i)
328 v31y(i)=yl3(i)-y0l3(i)
329 ENDDO
330 DO i=jft,jlt
331 x2_t(i) = x0l2(i)
332 x3_t(i) = x0l3(i)
333 y2_t(i) = y0l2(i)
334 y3_t(i) = y0l3(i)
335 ENDDO
336 IF (isrot>0) THEN
337
338 DO i=jft,jlt
340 rlz1 =e3x(i)*axyz(i,1,1)+e3y(i)*axyz(i,2,1)+e3z(i)*axyz(i,3,1)
341 rlz2 =e3x(i)*axyz(i,1,2)+e3y(i)*axyz(i,2,2)+e3z(i)*axyz(i,3,2)
342 rlz3 =e3x(i)*axyz(i,1,3)+e3y(i)*axyz(i,2,3)+e3z(i)*axyz(i,3,3)
343 rz13(i)=(rlz1-rlz3)*areai
344 rz23(i)=(rlz2-rlz3)*areai
345 ENDDO
346 END IF
347
348 off_l = zero
349 DO i=jft,jlt
350 off_l =
min(off_l,offg(i))
351 ENDDO
352 IF (off_l < zero) THEN
353 DO i=jft,jlt
354 IF (offg(i) < zero) THEN
355 v21x(i) = zero
356 v31x(i) = zero
357 v21y(i) = zero
358 v31y(i) = zero
359 rz13(i) = zero
360 rz23(i) = zero
361 ENDIF
362 ENDDO
363 ENDIF
364
365 RETURN
norm(diag(diag(diag(inv(mat))) -id.SOL), 2) % destroy mumps instance id.JOB
subroutine area(d1, x, x2, y, y2, eint, stif0)