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