OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
s10coor3.F
Go to the documentation of this file.
1Copyright> OpenRadioss
2Copyright> Copyright (C) 1986-2025 Altair Engineering Inc.
3Copyright>
4Copyright> This program is free software: you can redistribute it and/or modify
5Copyright> it under the terms of the GNU Affero General Public License as published by
6Copyright> the Free Software Foundation, either version 3 of the License, or
7Copyright> (at your option) any later version.
8Copyright>
9Copyright> This program is distributed in the hope that it will be useful,
10Copyright> but WITHOUT ANY WARRANTY; without even the implied warranty of
11Copyright> MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12Copyright> GNU Affero General Public License for more details.
13Copyright>
14Copyright> You should have received a copy of the GNU Affero General Public License
15Copyright> along with this program. If not, see <https://www.gnu.org/licenses/>.
16Copyright>
17Copyright>
18Copyright> Commercial Alternative: Altair Radioss Software
19Copyright>
20Copyright> As an alternative to this open-source version, Altair also offers Altair Radioss
21Copyright> software under a commercial license. Contact Altair to discuss further if the
22Copyright> commercial version may interest you: https://www.altair.com/radioss/.
23!||====================================================================
24!|| s10coor3 ../engine/source/elements/solid/solide10/s10coor3.F
25!||--- called by ------------------------------------------------------
26!|| s10forc3 ../engine/source/elements/solid/solide10/s10forc3.F
27!||====================================================================
28 SUBROUTINE s10coor3(
29 1 X, IXS, IXS10, V,
30 2 W, XX, YY, ZZ,
31 3 VX, VY, VZ, VDXX,
32 4 VDYY, VDZZ, VDX, VDY,
33 5 VDZ, VD2, VIS, OFFG,
34 6 OFF, SAV, NC, NGL,
35 7 MXT, NGEO, FX, FY,
36 8 FZ, STIG, SIGG, EINTG,
37 9 RHOG, QG, EPLASM, EPSDG,
38 A VR, DR, D, WXXG,
39 B WYYG, WZZG, G_PLA, XDP,
40 C NEL, CONDEG, G_EPSD, JALE,
41 D ISMSTR, JEUL, JLAG, ISRAT,
42 E ISROT)
43C-----------------------------------------------
44C I m p l i c i t T y p e s
45C-----------------------------------------------
46#include "implicit_f.inc"
47C-----------------------------------------------
48C G l o b a l P a r a m e t e r s
49C-----------------------------------------------
50#include "mvsiz_p.inc"
51C-----------------------------------------------
52C C o m m o n B l o c k s
53C-----------------------------------------------
54#include "scr05_c.inc"
55#include "scr18_c.inc"
56C-----------------------------------------------
57C D u m m y A r g u m e n t s
58C-----------------------------------------------
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
72C REAL
73 my_real
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)
82C-----------------------------------------------
83C L o c a l V a r i a b l e s
84C-----------------------------------------------
85 INTEGER I, IPERM1(10),IPERM2(10),N,N1,N2,NN,IUN,MXT_1
86C REAL
87 my_real
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/
91C-----------------------------------------------
92 iun=1
93 off_l = zero
94C
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
146C
147 IF (jlag==0)THEN
148 vdx(1:nel)=zero
149 vdy(1:nel)=zero
150 vdz(1:nel)=zero
151 ENDIF
152C----------------------------
153C NODAL COORDINATES |
154C----------------------------
155 DO n=1,4
156 IF((ismstr<=4.AND.jlag>0).OR.(ismstr==12.AND.idtmin(1)==3)) THEN
157C--
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
177C SAV(I,N)=XX(I,N)
178C SAV(I,N+10)=YY(I,N)
179C SAV(I,N+20)=ZZ(I,N)
180 off(i) = abs(offg(i))
181 off_l = min(off_l,offg(i))
182 ENDIF
183 ENDDO
184 ELSE
185C--
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
202C
203 DO n=5,10
204 IF((ismstr<=4.AND.jlag>0).OR.(ismstr==12.AND.idtmin(1)==3)) THEN
205C
206 IF(isrot==0.OR.isrot==2)THEN
207C--
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
234C SAV(I,N)=XX(I,N)
235C SAV(I,N+10)=YY(I,N)
236C SAV(I,N+20)=ZZ(I,N)
237 off(i) = abs(offg(i))
238 off_l = min(off_l,offg(i))
239 ENDIF
240 ENDDO
241 ELSEIF(isrot==1)THEN
242c
243C--
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)
254c XX(I,N) = HALF*(XX(I,N1)+XX(I,N2))
255c YY(I,N) = HALF*(YY(I,N1)+YY(I,N2))
256c ZZ(I,N) = HALF*(ZZ(I,N1)+ZZ(I,N2))
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
267C SAV(I,N)=XX(I,N)
268C SAV(I,N+10)=YY(I,N)
269C SAV(I,N+20)=ZZ(I,N)
270c SAV(I,N)= HALF*(XX(I,N1)+XX(I,N2))
271c SAV(I,N+10)= HALF*(YY(I,N1)+YY(I,N2))
272c SAV(I,N+20)= HALF*(ZZ(I,N1)+ZZ(I,N2))
273 off(i) = abs(offg(i))
274 off_l = min(off_l,offg(i))
275 ENDIF
276 ENDDO
277 END IF
278C
279 ELSEIF(isrot==0.OR.isrot==2)THEN
280C
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
303C
304 ELSEIF(isrot==1)THEN
305C
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
321C
322c ELSEIF(ISROT==2)THEN
323C
324c DO I=1,NEL
325c NN = NC(I,N)
326c N1=IPERM1(N)
327c N2=IPERM2(N)
328c IF(NN==0)THEN
329c XX(I,N) = HALF*(XX(I,N1)+XX(I,N2))
330c YY(I,N) = HALF*(YY(I,N1)+YY(I,N2))
331c ZZ(I,N) = HALF*(ZZ(I,N1)+ZZ(I,N2))
332c ELSE
333c --------------will be done in resol
334c XX(I,N) = D(1,NC(I,N)) + HALF*(XX(I,N1)+XX(I,N2))
335c YY(I,N) = D(2,NC(I,N)) + HALF*(YY(I,N1)+YY(I,N2))
336c ZZ(I,N) = D(3,NC(I,N)) + HALF*(ZZ(I,N1)+ZZ(I,N2))
337c en entr X est faux, il manque 1/2(V1+V2)*dt
338c X(1,NC(I,N)) = XX(I,N)
339c X(2,NC(I,N)) = YY(I,N)
340c X(3,NC(I,N)) = ZZ(I,N)
341c IF(IRESP==1)THEN
342c XDP(1,NC(I,N)) = XX(I,N)
343c XDP(2,NC(I,N)) = YY(I,N)
344c XDP(3,NC(I,N)) = ZZ(I,N)
345c ENDIF
346c END IF
347c OFF(I) = MIN(ONE,ABS(OFFG(I)))
348c OFF_L = MIN(OFF_L,OFFG(I))
349c ENDDO
350C
351 ENDIF
352 END DO
353C
354 ! Initialization of VX, VY and VZ tables
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 ! Add a test on NN to avoid check bounds issue when NN = 0 (degenerated tetra)
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
404C
405 IF (jlag==0)THEN
406C
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
421C
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
429C
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
438C
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
467c ELSE IF(ISROT == 2)THEN
468c DO N=5,10
469c N1=IPERM1(N)
470c N2=IPERM2(N)
471c DO I=1,NEL
472c IF(NC(I,N) == 0)THEN
473c VX(I,N) = HALF*(VX(I,N1)+VX(I,N2))
474c VY(I,N) = HALF*(VY(I,N1)+VY(I,N2))
475c VZ(I,N) = HALF*(VZ(I,N1)+VZ(I,N2))
476c ELSE
477c VX(I,N) = VX(I,N) + HALF*(VX(I,N1)+VX(I,N2))
478c VY(I,N) = VY(I,N) + HALF*(VY(I,N1)+VY(I,N2))
479c VZ(I,N) = VZ(I,N) + HALF*(VZ(I,N1)+VZ(I,N2))
480c ENDIF
481c ENDDO
482c ENDDO
483 ENDIF
484C-----------
485 RETURN
486 END
my_real
#define my_real
Definition cppsort.cpp:32
s10coor3
subroutine s10coor3(x, ixs, ixs10, v, w, xx, yy, zz, vx, vy, vz, vdxx, vdyy, vdzz, vdx, vdy, vdz, vd2, vis, offg, off, sav, nc, ngl, mxt, ngeo, fx, fy, fz, stig, sigg, eintg, rhog, qg, eplasm, epsdg, vr, dr, d, wxxg, wyyg, wzzg, g_pla, xdp, nel, condeg, g_epsd, jale, ismstr, jeul, jlag, israt, isrot)
Definition s10coor3.F:43
min
#define min(a, b)
Definition macros.h:20
max
#define max(a, b)
Definition macros.h:21