43
44
45
46#include "implicit_f.inc"
47
48
49
50#include "mvsiz_p.inc"
51
52
53
54#include "scr05_c.inc"
55#include "scr18_c.inc"
56
57
58
59 INTEGER, INTENT(IN) :: JALE
60 INTEGER, INTENT(IN) :: ISMSTR
61 INTEGER, INTENT(IN) :: JEUL
62 INTEGER, INTENT(IN) :: JLAG
63 INTEGER, INTENT(IN) :: ISRAT
64 INTEGER, INTENT(IN) :: ISROT
65 INTEGER, INTENT(IN) :: G_PLA,NEL,G_EPSD
66 INTEGER NC(MVSIZ,10), MXT(*), NGL(*), NGEO(*),
67 . IXS(NIXS,*), IXS10(6,*)
68
69 double precision
70 . xdp(3,*),xx(mvsiz,10), yy(mvsiz,10), zz(mvsiz,10),sav(nel,30)
71
72
74 . x(3,*),v(3,*),w(3,*), vis(*),
75 . vx(mvsiz,10),vy(mvsiz,10),vz(mvsiz,10),
76 . vdxx(mvsiz,10), vdyy(mvsiz,10), vdzz(mvsiz,10),
77 . vdx(*), vdy(*), vdz(*),vd2(*),offg(*),off(*),
78 . fx(mvsiz,10), fy(mvsiz,10), fz(mvsiz,10),epsdg(*),
79 . sigg(nel,6),eintg(*),rhog(*),qg(*),stig(*),eplasm(*),
80 . vr(3,*),dr(3,*),d(3,*),
81 . wxxg(mvsiz),wyyg(mvsiz),wzzg(mvsiz),condeg(mvsiz)
82
83
84
85 INTEGER I, IPERM1(10),IPERM2(10),N,N1,N2,NN,IUN,MXT_1
86
88 . off_l,dvx,dvy,dvz,dx,dy,dz
89 DATA iperm1/0,0,0,0,1,2,3,1,2,3/
90 DATA iperm2/0,0,0,0,2,3,1,4,4,4/
91
92 iun=1
93 off_l = zero
94
95 mxt_1 = ixs(1,1)
96
97 vis(1:nel)=zero
98 vd2(1:nel)=zero
99 ngeo(1:nel)=ixs(10,1:nel)
100 ngl(1:nel) =ixs(11,1:nel)
101 mxt(1:nel) =mxt_1
102 nc(1:nel,1)=ixs(2,1:nel)
103 nc(1:nel,2)=ixs(4,1:nel)
104 nc(1:nel,3)=ixs(7,1:nel)
105 nc(1:nel,4)=ixs(6,1:nel)
106 eintg(1:nel)=zero
107 rhog(1:nel)=zero
108 qg(1:nel)=zero
109 sigg(1:nel,1)=zero
110 sigg(1:nel,2)=zero
111 sigg(1:nel,3)=zero
112 sigg(1:nel,4)=zero
113 sigg(1:nel,5)=zero
114 sigg(1:nel,6)=zero
115 stig(1:nel)=zero
116 condeg(1:nel)=zero
117
118 IF ((israt /= 0).OR.(g_epsd > 0)) THEN
119 epsdg(1:nel)=zero
120 ENDIF
121 IF (g_pla > 0) THEN
122 eplasm(1:nel)=zero
123 ENDIF
124
125 wxxg(1:nel)=zero
126 wyyg(1:nel)=zero
127 wzzg(1:nel)=zero
128
129 IF(isrot /= 1)THEN
130 DO i=1,nel
131 nc(i,5) =ixs10(1,i)
132 nc(i,6) =ixs10(2,i)
133 nc(i,7) =ixs10(3,i)
134 nc(i,8) =ixs10(4,i)
135 nc(i,9) =ixs10(5,i)
136 nc(i,10)=ixs10(6,i)
137 ENDDO
138 ELSE
139 nc(1:nel,5) =0
140 nc(1:nel,6) =0
141 nc(1:nel,7) =0
142 nc(1:nel,8) =0
143 nc(1:nel,9) =0
144 nc(1:nel,10)=0
145 ENDIF
146
147 IF (jlag==0)THEN
148 vdx(1:nel)=zero
149 vdy(1:nel)=zero
150 vdz(1:nel)=zero
151 ENDIF
152
153
154
155 DO n=1,4
156 IF((ismstr<=4.AND.jlag>0).OR.(ismstr==12.AND.idtmin(1)==3)) THEN
157
158 DO i=1,nel
159 nn = nc(i,n)
160 IF(abs(offg(i))>one)THEN
161 xx(i,n)=sav(i,n)
162 yy(i,n)=sav(i,n+10)
163 zz(i,n)=sav(i,n+20)
164 off(i) = abs(offg(i))-one
165 off_l =
min(off_l,offg(i))
166 ELSE
167 nn = nc(i,n)
168 IF(iresp==1)THEN
169 xx(i,n)=xdp(1,nn)
170 yy(i,n)=xdp(2,nn)
171 zz(i,n)=xdp(3,nn)
172 ELSE
173 xx(i,n)=x(1,nn)
174 yy(i,n)=x(2,nn)
175 zz(i,n)=x(3,nn)
176 ENDIF
177
178
179
180 off(i) = abs(offg(i))
181 off_l =
min(off_l,offg(i))
182 ENDIF
183 ENDDO
184 ELSE
185
186 DO i=1,nel
187 nn = nc(i,n)
188 IF(iresp==1)THEN
189 xx(i,n)=xdp(1,nn)
190 yy(i,n)=xdp(2,nn)
191 zz(i,n)=xdp(3,nn)
192 ELSE
193 xx(i,n)=x(1,nn)
194 yy(i,n)=x(2,nn)
195 zz(i,n)=x(3,nn)
196 ENDIF
197 off(i) =
min(one,abs(offg(i)))
198 off_l =
min(off_l,offg(i))
199 ENDDO
200 ENDIF
201 END DO
202
203 DO n=5,10
204 IF((ismstr<=4.AND.jlag>0).OR.(ismstr==12.AND.idtmin(1)==3)) THEN
205
206 IF(isrot==0.OR.isrot==2)THEN
207
208 DO i=1,nel
209 IF(abs(offg(i))>one)THEN
210 xx(i,n)=sav(i,n)
211 yy(i,n)=sav(i,n+10)
212 zz(i,n)=sav(i,n+20)
213 off(i) = abs(offg(i))-one
214 off_l =
min(off_l,offg(i))
215 ELSE
216 nn = nc(i,n)
217 IF(nn/=0)THEN
218 IF(iresp==1)THEN
219 xx(i,n)=xdp(1,nn)
220 yy(i,n)=xdp(2,nn)
221 zz(i,n)=xdp(3,nn)
222 ELSE
223 xx(i,n)=x(1,nn)
224 yy(i,n)=x(2,nn)
225 zz(i,n)=x(3,nn)
226 ENDIF
227 ELSE
228 n1=iperm1(n)
229 n2=iperm2(n)
230 xx(i,n) = half*(xx(i,n1)+xx(i,n2))
231 yy(i,n) = half*(yy(i,n1)+yy(i,n2))
232 zz(i,n) = half*(zz(i,n1)+zz(i,n2))
233 END IF
234
235
236
237 off(i) = abs(offg(i))
238 off_l =
min(off_l,offg(i))
239 ENDIF
240 ENDDO
241 ELSEIF(isrot==1)THEN
242
243
244 DO i=1,nel
245 IF(abs(offg(i))>one)THEN
246 xx(i,n)=sav(i,n)
247 yy(i,n)=sav(i,n+10)
248 zz(i,n)=sav(i,n+20)
249 off(i) = abs(offg(i))-one
250 off_l =
min(off_l,offg(i))
251 ELSE
252 n1=iperm1(n)
253 n2=iperm2(n)
254
255
256
257 dx = (yy(i,n2)-yy(i,n1))*(dr(3,nc(i,n2))-dr(3,nc(i,n1)))
258 . - (zz(i,n2)-zz(i,n1))*(dr(2,nc(i,n2))-dr(2,nc(i,n1)))
259 dy = (zz(i,n2)-zz(i,n1))*(dr(1,nc(i,n2))-dr(1,nc(i,n1)))
260 . - (xx(i,n2)-xx(i,n1))*(dr(3,nc(i,n2))-dr(3,nc(i,n1)))
261 dz = (xx(i,n2)-xx(i,n1))*(dr(2,nc(i,n2))-dr(2,nc(i,n1)))
262 . - (yy(i,n2)-yy(i,n1))*(dr(1,nc(i,n2))-dr(1,nc(i,n1)))
263
264 xx(i,n) = half*(xx(i,n1)+xx(i,n2)) + one_over_8 * dx
265 yy(i,n) = half*(yy(i,n1)+yy(i,n2)) + one_over_8 * dy
266 zz(i,n) = half*(zz(i,n1)+zz(i,n2)) + one_over_8 * dz
267
268
269
270
271
272
273 off(i) = abs(offg(i))
274 off_l =
min(off_l,offg(i))
275 ENDIF
276 ENDDO
277 END IF
278
279 ELSEIF(isrot==0.OR.isrot==2)THEN
280
281 DO i=1,nel
282 nn = nc(i,n)
283 IF(nn/=0)THEN
284 IF(iresp==1)THEN
285 xx(i,n)=xdp(1,nn)
286 yy(i,n)=xdp(2,nn)
287 zz(i,n)=xdp(3,nn)
288 ELSE
289 xx(i,n)=x(1,nn)
290 yy(i,n)=x(2,nn)
291 zz(i,n)=x(3,nn)
292 ENDIF
293 ELSE
294 n1=iperm1(n)
295 n2=iperm2(n)
296 xx(i,n) = half*(xx(i,n1)+xx(i,n2))
297 yy(i,n) = half*(yy(i,n1)+yy(i,n2))
298 zz(i,n) = half*(zz(i,n1)+zz(i,n2))
299 END IF
300 off(i) =
min(one,abs(offg(i)))
301 off_l =
min(off_l,offg(i))
302 ENDDO
303
304 ELSEIF(isrot==1)THEN
305
306 DO i=1,nel
307 n1=iperm1(n)
308 n2=iperm2(n)
309 dx = (yy(i,n2)-yy(i,n1))*(dr(3,nc(i,n2))-dr(3,nc(i,n1)))
310 . - (zz(i,n2)-zz(i,n1))*(dr(2,nc(i,n2))-dr(2,nc(i,n1)))
311 dy = (zz(i,n2)-zz(i,n1))*(dr(1,nc(i,n2))-dr(1,nc(i,n1)))
312 . - (xx(i,n2)-xx(i,n1))*(dr(3,nc(i,n2))-dr(3,nc(i,n1)))
313 dz = (xx(i,n2)-xx(i,n1))*(dr(2,nc(i,n2))-dr(2,nc(i,n1)))
314 . - (yy(i,n2)-yy(i,n1))*(dr(1,nc(i,n2))-dr(1,nc(i,n1)))
315 xx(i,n) = half*(xx(i,n1)+xx(i,n2)) + one_over_8 * dx
316 yy(i,n) = half*(yy(i,n1)+yy(i,n2)) + one_over_8 * dy
317 zz(i,n) = half*(zz(i,n1)+zz(i,n2)) + one_over_8 * dz
318 off(i) =
min(one,abs(offg(i)))
319 off_l =
min(off_l,offg(i))
320 ENDDO
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351 ENDIF
352 END DO
353
354
355 vx(1:mvsiz,1:10) = zero
356 vy(1:mvsiz,1:10) = zero
357 vz(1:mvsiz,1:10) = zero
358 IF(isrot/=1) THEN
359 DO n=1,10
360 DO i=1,nel
361 nn = nc(i,n)
362
363 IF (nn /= 0) THEN
364 vx(i,n)=v(1,nn)
365 vy(i,n)=v(2,nn)
366 vz(i,n)=v(3,nn)
367 ENDIF
368 ENDDO
369 ENDDO
370 ELSE
371 DO n=1,4
372 DO i=1,nel
373 nn = nc(i,n)
374 vx(i,n)=v(1,nn)
375 vy(i,n)=v(2,nn)
376 vz(i,n)=v(3,nn)
377 ENDDO
378 ENDDO
379 DO n=5,10
380 nn = 1
381 DO i=1,nel
382 vx(i,n)=v(1,nn)
383 vy(i,n)=v(2,nn)
384 vz(i,n)=v(3,nn)
385 ENDDO
386 ENDDO
387 ENDIF
388
389 DO n=1,10
390 DO i=1,nel
391 fx(i,n)=zero
392 fy(i,n)=zero
393 fz(i,n)=zero
394 ENDDO
395 IF(off_l<zero)THEN
396 DO i=1,nel
397 IF(offg(i)<zero)THEN
398 vx(i,n)=zero
399 vy(i,n)=zero
400 vz(i,n)=zero
401 ENDIF
402 ENDDO
403 ENDIF
404
405 IF (jlag==0)THEN
406
407 IF(jale/=0)THEN
408 DO i=1,nel
409 nn =
max(iun,nc(i,n))
410 vdxx(i,n)=vx(i,n)-w(1,nn)
411 vdyy(i,n)=vy(i,n)-w(2,nn)
412 vdzz(i,n)=vz(i,n)-w(3,nn)
413 ENDDO
414 ELSEIF(jeul/=0)THEN
415 DO i=1,nel
416 vdxx(i,n)=vx(i,n)
417 vdyy(i,n)=vy(i,n)
418 vdzz(i,n)=vz(i,n)
419 ENDDO
420 ENDIF
421
422 DO i=1,nel
423 vdx(i)=vdx(i)+vdxx(i,n)
424 vdy(i)=vdy(i)+vdyy(i,n)
425 vdz(i)=vdz(i)+vdzz(i,n)
426 ENDDO
427 ENDIF
428 ENDDO
429
430 IF (jlag==0)THEN
431 DO i=1,nel
432 vdx(i)=fourth*vdx(i)
433 vdy(i)=fourth*vdy(i)
434 vdz(i)=fourth*vdz(i)
435 vd2(i)=(vdx(i)**2+vdy(i)**2+vdz(i)**2)
436 ENDDO
437 ENDIF
438
439 IF(isrot == 0.OR.isrot == 2)THEN
440 DO n=5,10
441 n1=iperm1(n)
442 n2=iperm2(n)
443 DO i=1,nel
444 IF(nc(i,n)==0)THEN
445 vx(i,n) = half*(vx(i,n1)+vx(i,n2))
446 vy(i,n) = half*(vy(i,n1)+vy(i,n2))
447 vz(i,n) = half*(vz(i,n1)+vz(i,n2))
448 ENDIF
449 ENDDO
450 ENDDO
451 ELSEIF(isrot == 1)THEN
452 DO n=5,10
453 n1=iperm1(n)
454 n2=iperm2(n)
455 DO i=1,nel
456 dvx = (yy(i,n2)-yy(i,n1))*(vr(3,nc(i,n2))-vr(3,nc(i,n1)))
457 . - (zz(i,n2)-zz(i,n1))*(vr(2,nc(i,n2))-vr(2,nc(i,n1)))
458 dvy = (zz(i,n2)-zz(i,n1))*(vr(1,nc(i,n2))-vr(1,nc(i,n1)))
459 . - (xx(i,n2)-xx(i,n1))*(vr(3,nc(i,n2))-vr(3,nc(i,n1)))
460 dvz = (xx(i,n2)-xx(i,n1))*(vr(2,nc(i,n2))-vr(2,nc(i,n1)))
461 . - (yy(i,n2)-yy(i,n1))*(vr(1,nc(i,n2))-vr(1,nc(i,n1)))
462 vx(i,n) = half*(vx(i,n1)+vx(i,n2)) + one_over_8 * dvx
463 vy(i,n) = half*(vy(i,n1)+vy(i,n2)) + one_over_8 * dvy
464 vz(i,n) = half*(vz(i,n1)+vz(i,n2)) + one_over_8 * dvz
465 ENDDO
466 ENDDO
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483 ENDIF
484
485 RETURN