53 use element_mod , only : nixs
54
55
56
57#include "implicit_f.inc"
58
59
60
61#include "mvsiz_p.inc"
62
63
64
65#include "scr05_c.inc"
66#include "scr18_c.inc"
67
68
69
70 INTEGER, INTENT(IN) :: JALE
71 INTEGER, INTENT(IN) ::
72 INTEGER, INTENT(IN) :: JEUL
73 INTEGER, INTENT(IN) :: JLAG
74 INTEGER, INTENT(IN) :: NEL
75 INTEGER, INTENT(IN) :: IXS(NIXS,*)
77 . x(3,*),v(3,*),w(3,*), vis(mvsiz),
78 . x1(mvsiz), x2(mvsiz), x3(mvsiz), x4(mvsiz),
79 . y1(mvsiz), y2(mvsiz), y3(mvsiz), y4(mvsiz),
80 . z1(mvsiz), z2(mvsiz), z3(mvsiz), z4(mvsiz),
81 . vx1(mvsiz), vx2(mvsiz), vx3(mvsiz), vx4(mvsiz),
82 . vy1(mvsiz), vy2(mvsiz), vy3(mvsiz), vy4(mvsiz),
83 . vz1(mvsiz), vz2(mvsiz), vz3(mvsiz), vz4(mvsiz),
84 . vdx1(mvsiz),vdx2(mvsiz),vdx3(mvsiz),vdx4(mvsiz),
85 . vdy1(mvsiz),vdy2(mvsiz),vdy3(mvsiz),vdy4(mvsiz),
86 . vdz1(mvsiz),vdz2(mvsiz),vdz3(mvsiz),vdz4(mvsiz),
87 . vdx(mvsiz), vdy(mvsiz), vdz(mvsiz),vd2(mvsiz),
88 . offg(nel),off(mvsiz),rho(nel),
89 . f11(mvsiz),f21(mvsiz),f31(mvsiz),f12(mvsiz),f22(mvsiz),f32(mvsiz),
90 . f13(mvsiz),f23(mvsiz),f33(mvsiz),f14(mvsiz),f24(mvsiz),f34(mvsiz),
91 . rhoo(mvsiz)
92 INTEGER NC1(MVSIZ), NC2(MVSIZ), NC3(MVSIZ), NC4(MVSIZ),
93 . MXT(MVSIZ), NGL(MVSIZ),NGEO(MVSIZ)
94
95 DOUBLE PRECISION
96 . XDP(3,*), SAV(NEL,9),
97 . XD1(MVSIZ), XD2(MVSIZ), XD3(MVSIZ), XD4(MVSIZ),
98 . YD1(MVSIZ), YD2(MVSIZ), YD3(MVSIZ), YD4(MVSIZ),
99 . ZD1(MVSIZ), ZD2(MVSIZ), ZD3(MVSIZ), ZD4(MVSIZ)
100
102 . off_l
103
104
105
106 INTEGER I
107
108#include "vectorize.inc"
109 DO i=1,nel
110 vis(i)=zero
111 ngeo(i)=ixs(10,i)
112 ngl(i)=ixs(11,i)
113 mxt(i)=ixs(1,i)
114 nc1(i)=ixs(2,i)
115 nc2(i)=ixs(4,i)
116 nc3(i)=ixs(7,i)
117 nc4(i)=ixs(6,i)
118 rhoo(i)=rho(i)
119 ENDDO
120#include "vectorize.inc"
121 DO i=1,nel
122 x1(i) =x(1,nc1(i))
123 y1(i) =x(2,nc1(i))
124 z1(i) =x(3,nc1(i))
125 x2(i) =x(1,nc2(i))
126 y2(i) =x(2,nc2(i))
127 z2(i) =x(3,nc2(i))
128 x3(i) =x(1,nc3(i))
129 y3(i) =x(2,nc3(i))
130 z3(i) =x(3,nc3(i))
131 x4(i) =x(1,nc4(i))
132 y4(i) =x(2,nc4(i))
133 z4(i) =x(3,nc4(i))
134 vx1(i)=v(1,nc1(i))
135 vy1(i)=v(2,nc1(i))
136 vz1(i)=v(3,nc1(i))
137 vx2(i)=v(1,nc2(i))
138 vy2(i)=v(2,nc2(i))
139 vz2(i)=v(3,nc2(i))
140 vx3(i)=v(1,nc3(i))
141 vy3(i)=v(2,nc3(i))
142 vz3(i)=v(3,nc3(i))
143 vx4(i)=v(1,nc4(i))
144 vy4(i)=v(2,nc4(i))
145 vz4(i)=v(3,nc4(i))
146 ENDDO
147
148 off_l = zero
149
150
151
152 IF((ismstr<=4.AND.jlag>0).OR.(ismstr==12.AND.idtmin(1)==3)) THEN
153
154 IF(iresp == 1) THEN
155#include "vectorize.inc"
156 DO i=1,nel
157 IF(abs(offg(i))>one)THEN
158 xd1(i)=sav(i,1)
159 yd1(i)=sav(i,2)
160 zd1(i)=sav(i,3)
161 xd2(i)=sav(i,4)
162 yd2(i)=sav(i,5)
163 zd2(i)=sav(i,6)
164 xd3(i)=sav(i,7)
165 yd3(i)=sav(i,8)
166 zd3(i)=sav(i,9)
167 xd4(i)=zero
168 yd4(i)=zero
169 zd4(i)=zero
170 off(i) = abs(offg(i))-one
171
172 ELSE
173 xd1(i)=xdp(1,nc1(i))
174 yd1(i)=xdp(2,nc1(i))
175 zd1(i)=xdp(3,nc1(i))
176 xd2(i)=xdp(1,nc2(i))
177 yd2(i)=xdp(2,nc2(i))
178 zd2(i)=xdp(3,nc2(i))
179 xd3(i)=xdp(1,nc3(i))
180 yd3(i)=xdp(2,nc3(i))
181 zd3(i)=xdp(3,nc3(i))
182 xd4(i)=xdp(1,nc4(i))
183 yd4(i)=xdp(2,nc4(i))
184 zd4(i)=xdp(3,nc4(i))
185 off(i) = abs(offg(i))
186
187 ENDIF
188 ENDDO
189 off_l =
min(off_l,minval(offg(1:nel)))
190 ELSE
191#include "vectorize.inc"
192 DO i=1,nel
193 IF(abs(offg(i))>one)THEN
194 xd1(i)=sav(i,1)
195 yd1(i)=sav(i,2)
196 zd1(i)=sav(i,3)
197 xd2(i)=sav(i,4)
198 yd2(i)=sav(i,5)
199 zd2(i)=sav(i,6)
200 xd3(i)=sav(i,7)
201 yd3(i)=sav(i,8)
202 zd3(i)=sav(i,9)
203 xd4(i)=zero
204 yd4(i)=zero
205 zd4(i)=zero
206 off(i) = abs(offg(i))-one
207
208 ELSE
209 xd1(i)=x1(i)
210 yd1(i)=y1(i)
211 zd1(i)=z1(i)
212 xd2(i)=x2(i)
213 yd2(i)=y2(i)
214 zd2(i)=z2(i)
215 xd3(i)=x3(i)
216 yd3(i)=y3(i)
217 zd3(i)=z3(i)
218 xd4(i)=x4(i)
219 yd4(i)=y4(i)
220 zd4(i)=z4(i)
221 off(i) = abs(offg(i))
222
223 ENDIF
224 ENDDO
225 off_l =
min(off_l,minval(offg(1:nel)))
226 ENDIF
227
228 ELSE
229
230 IF(iresp==1)THEN
231#include "vectorize.inc"
232 DO i=1,nel
233 xd1(i)=xdp(1,nc1(i))
234 yd1(i)=xdp(2,nc1(i))
235 zd1(i)=xdp(3,nc1(i))
236 xd2(i)=xdp(1,nc2(i))
237 yd2(i)=xdp(2,nc2(i))
238 zd2(i)=xdp(3,nc2(i))
239 xd3(i)=xdp(1,nc3(i))
240 yd3(i)=xdp(2,nc3(i))
241 zd3(i)=xdp(3,nc3(i))
242 xd4(i)=xdp(1,nc4(i))
243 yd4(i)=xdp(2,nc4(i))
244 zd4(i)=xdp(3,nc4(i))
245 off(i) = abs(offg(i))
246
247 ENDDO
248 off_l =
min(off_l,minval(offg(1:nel)))
249 ELSE
250#include "vectorize.inc"
251 DO i=1,nel
252 xd1(i)=x1(i)
253 yd1(i)=y1(i)
254 zd1(i)=z1(i)
255 xd2(i)=x2(i)
256 yd2(i)=y2(i)
257 zd2(i)=z2(i)
258 xd3(i)=x3(i)
259 yd3(i)=y3(i)
260 zd3(i)=z3(i)
261 xd4(i)=x4(i)
262 yd4(i)=y4(i)
263 zd4(i)=z4(i)
264 off(i) = abs(offg(i))
265
266 ENDDO
267 off_l =
min(off_l,minval(offg(1:nel)))
268 ENDIF
269
270 ENDIF
271
272 IF(off_l<zero)THEN
273#include "vectorize.inc"
274 DO i=1,nel
275 IF(offg(i)<zero)THEN
276 vx1(i)=zero
277 vy1(i)=zero
278 vz1(i)=zero
279 vx2(i)=zero
280 vy2(i)=zero
281 vz2(i)=zero
282 vx3(i)=zero
283 vy3(i)=zero
284 vz3(i)=zero
285 vx4(i)=zero
286 vy4(i)=zero
287 vz4
288 ENDIF
289 ENDDO
290 ENDIF
291
292 f11(1:nel)=zero
293 f21(1:nel)=zero
294 f31(1:nel)=zero
295 f12(1:nel)=zero
296 f22(1:nel)=zero
297 f32(1:nel)=zero
298 f13(1:nel)=zero
299 f23(1:nel)=zero
300 f33(1:nel)=zero
301 f14(1:nel)=zero
302 f24(1:nel)=zero
303 f34(1:nel)=zero
304
305 IF (jlag/=0)THEN
306 vd2(1:nel)=zero
307 RETURN
308
309 ELSEIF(jale/=0)THEN
310#include "vectorize.inc"
311 DO i=1,nel
312 vdx1(i)=vx1(i)-w(1,nc1(i))
313 vdy1(i)=vy1(i)-w(2,nc1(i))
314 vdz1(i)=vz1(i)-w(3,nc1(i))
315 vdx2(i)=vx2(i)-w(1,nc2(i))
316 vdy2(i)=vy2(i)-w(2,nc2(i))
317 vdz2(i)=vz2(i)-w(3,nc2(i))
318 vdx3(i)=vx3(i)-w(1,nc3(i))
319 vdy3(i)=vy3(i)-w(2,nc3(i))
320 vdz3(i)=vz3(i)-w(3,nc3(i))
321 vdx4(i)=vx4(i)-w(1,nc4(i))
322 vdy4(i)=vy4(i)-w(2,nc4(i))
323 vdz4(i)=vz4(i)-w(3,nc4(i))
324 ENDDO
325 ELSEIF(jeul/=0)THEN
326#include "vectorize.inc"
327 DO i=1,nel
328 vdx1(i)=vx1(i)
329 vdy1(i)=vy1(i)
330 vdz1(i)=vz1(i)
331 vdx2(i)=vx2(i)
332 vdy2(i)=vy2(i)
333 vdz2(i)=vz2(i)
334 vdx3(i)=vx3(i)
335 vdy3(i)=vy3(i)
336 vdz3(i)=vz3(i)
337 vdx4(i)=vx4(i)
338 vdy4(i)=vy4(i)
339 vdz4(i)=vz4(i)
340 ENDDO
341 ENDIF
342#include "vectorize.inc"
343 DO i=1,nel
344 vdx(i)=fourth*(vdx1(i)+vdx2(i)+vdx3(i)+vdx4(i))
345 vdy(i)=fourth*(vdy1(i)+vdy2(i)+vdy3(i)+vdy4(i))
346 vdz(i)=fourth*(vdz1(i)+vdz2(i)+vdz3(i)+vdz4(i))
347 vd2(i)=nine*(vdx(i)**2+vdy(i)**2+vdz(i)**2)
348 ENDDO
349
350 RETURN