OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
scoor3.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!|| scoor3 ../starter/source/elements/solid/solide/scoor3.F
25!||--- called by ------------------------------------------------------
26!|| inirig_mat ../starter/source/elements/initia/inirig_mat.F
27!|| inisoldist ../starter/source/initial_conditions/inivol/inisoldist.F
28!|| inivoid ../starter/source/elements/initia/inivoid.F
29!|| multifluid_init3 ../starter/source/multifluid/multifluid_init3.F
30!|| s8cinit3 ../starter/source/elements/thickshell/solide8c/s8cinit3.F
31!|| s8zinit3 ../starter/source/elements/solid/solide8z/s8zinit3.F
32!|| sinit3 ../starter/source/elements/solid/solide/sinit3.F
33!|| suinit3 ../starter/source/elements/elbuf_init/suinit3.F
34!||--- calls -----------------------------------------------------
35!|| checkvolume_8n ../starter/source/elements/solid/solide/checksvolume.F
36!|| mod_close ../starter/source/elements/solid/solide/mod_close.F
37!||--- uses -----------------------------------------------------
38!|| message_mod ../starter/share/message_module/message_mod.F
39!||====================================================================
40 SUBROUTINE scoor3(
41 . X ,XREFS,IXS ,GEO ,MXT ,NGEO ,NGL ,
42 . IX1 ,IX2 ,IX3 ,IX4 ,IX5 ,IX6 ,IX7 ,IX8 ,
43 . X1 ,X2 ,X3 ,X4 ,X5 ,X6 ,X7 ,X8 ,
44 . Y1 ,Y2 ,Y3 ,Y4 ,Y5 ,Y6 ,Y7 ,Y8 ,
45 . Z1 ,Z2 ,Z3 ,Z4 ,Z5 ,Z6 ,Z7 ,Z8 ,
46 . RX ,RY ,RZ ,SX ,SY ,SZ ,TX ,TY ,TZ ,
47 . E1X ,E1Y ,E1Z ,E2X ,E2Y ,E2Z ,E3X ,E3Y ,E3Z ,
48 . F1X ,F1Y ,F1Z ,F2X ,F2Y ,F2Z ,TEMP0,TEMP,NINTEMP,
49 . XD1 ,XD2 ,XD3 ,XD4 ,XD5 ,XD6 ,XD7 ,XD8 ,
50 . YD1 ,YD2 ,YD3 ,YD4 ,YD5 ,YD6 ,YD7 ,YD8 ,
51 . ZD1 ,ZD2 ,ZD3 ,ZD4 ,ZD5 ,ZD6 ,ZD7 ,ZD8 )
52C-----------------------------------------------
53C M o d u l e s
54C-----------------------------------------------
55 USE message_mod
56 use element_mod , only : nixs
57C-----------------------------------------------
58C I m p l i c i t T y p e s
59C-----------------------------------------------
60#include "implicit_f.inc"
61C-----------------------------------------------
62C G l o b a l P a r a m e t e r s
63C-----------------------------------------------
64#include "mvsiz_p.inc"
65C-----------------------------------------------
66C C o m m o n B l o c k s
67C-----------------------------------------------
68#include "vect01_c.inc"
69#include "scr03_c.inc"
70#include "com04_c.inc"
71C-----------------------------------------------
72C D u m m y A r g u m e n t s
73C-----------------------------------------------
74 INTEGER IXS(NIXS,*), MXT(*), NGL(*), NGEO(*),
75 . IX1(*),IX2(*),IX3(*),IX4(*),IX5(*),IX6(*),IX7(*),IX8(*)
76 INTEGER ,INTENT(IN) :: NINTEMP
77 my_real
78 . X(3,*),GEO(*),TEMP0(MVSIZ),
79 . TEMP(*),XREFS(8,3,*)
80 my_real, DIMENSION(MVSIZ), INTENT(OUT) ::
81 . X1, X2, X3, X4, X5, X6, X7, X8,
82 . Y1, Y2, Y3, Y4, Y5, Y6, Y7, Y8,
83 . Z1, Z2, Z3, Z4, Z5, Z6, Z7, Z8,
84 . RX ,RY ,RZ ,SX ,SY ,SZ ,TX ,TY ,TZ,
85 . e1x,e1y,e1z,e2x,e2y,e2z,e3x,e3y,e3z,
86 . f1x,f1y,f1z,f2x,f2y,f2z
87 DOUBLE PRECISION
88 . xd1(mvsiz), xd2(mvsiz), xd3(mvsiz), xd4(mvsiz),
89 . xd5(mvsiz), xd6(mvsiz), xd7(mvsiz), xd8(mvsiz),
90 . yd1(mvsiz), yd2(mvsiz), yd3(mvsiz), yd4(mvsiz),
91 . yd5(mvsiz), yd6(mvsiz), yd7(mvsiz), yd8(mvsiz),
92 . zd1(mvsiz), zd2(mvsiz), zd3(mvsiz), zd4(mvsiz),
93 . zd5(mvsiz), zd6(mvsiz), zd7(mvsiz), zd8(mvsiz)
94C-----------------------------------------------
95C L o c a l V a r i a b l e s
96C-----------------------------------------------
97 INTEGER I
98 my_real
99 . suma
100C-----------------------------------------------
101C E x t e r n a l F u n c t i o n s
102C-----------------------------------------------
103 my_real
104 . checkvolume_8n
105C=======================================================================
106C CONNECTIVITIES AND MATERIAL NUMBER AND PID
107C--------------------------------------------------
108 DO i=lft,llt
109 mxt(i)=ixs(1,i)
110 ix1(i)=ixs(2,i)
111 ix2(i)=ixs(3,i)
112 ix3(i)=ixs(4,i)
113 ix4(i)=ixs(5,i)
114 ix5(i)=ixs(6,i)
115 ix6(i)=ixs(7,i)
116 ix7(i)=ixs(8,i)
117 ix8(i)=ixs(9,i)
118 ngeo(i)=ixs(nixs-1,i)
119 ngl(i)=ixs(nixs,i)
120 IF (checkvolume_8n(x ,ixs(1,i)) < zero) THEN
121C renumber connectivity
122 ix1(i)=ixs(6,i)
123 ix2(i)=ixs(7,i)
124 ix3(i)=ixs(8,i)
125 ix4(i)=ixs(9,i)
126 ix5(i)=ixs(2,i)
127 ix6(i)=ixs(3,i)
128 ix7(i)=ixs(4,i)
129 ix8(i)=ixs(5,i)
130 ixs(2,i)=ix1(i)
131 ixs(3,i)=ix2(i)
132 ixs(4,i)=ix3(i)
133 ixs(5,i)=ix4(i)
134 ixs(6,i)=ix5(i)
135 ixs(7,i)=ix6(i)
136 ixs(8,i)=ix7(i)
137 ixs(9,i)=ix8(i)
138 ENDIF
139 ENDDO
140C
141C----------------------------
142C COORDONNEES
143C----------------------------
144 IF (nxref == 0) THEN
145 DO i=lft,llt
146 x1(i)=x(1,ix1(i))
147 y1(i)=x(2,ix1(i))
148 z1(i)=x(3,ix1(i))
149 x2(i)=x(1,ix2(i))
150 y2(i)=x(2,ix2(i))
151 z2(i)=x(3,ix2(i))
152 x3(i)=x(1,ix3(i))
153 y3(i)=x(2,ix3(i))
154 z3(i)=x(3,ix3(i))
155 x4(i)=x(1,ix4(i))
156 y4(i)=x(2,ix4(i))
157 z4(i)=x(3,ix4(i))
158 x5(i)=x(1,ix5(i))
159 y5(i)=x(2,ix5(i))
160 z5(i)=x(3,ix5(i))
161 x6(i)=x(1,ix6(i))
162 y6(i)=x(2,ix6(i))
163 z6(i)=x(3,ix6(i))
164 x7(i)=x(1,ix7(i))
165 y7(i)=x(2,ix7(i))
166 z7(i)=x(3,ix7(i))
167 x8(i)=x(1,ix8(i))
168 y8(i)=x(2,ix8(i))
169 z8(i)=x(3,ix8(i))
170 ENDDO
171 ELSE
172 DO i=lft,llt
173 IF (checkvolume_8n(x ,ixs(1,i)) < zero) THEN
174 x1(i)=xrefs(5,1,i)
175 y1(i)=xrefs(5,2,i)
176 z1(i)=xrefs(5,3,i)
177 x2(i)=xrefs(6,1,i)
178 y2(i)=xrefs(6,2,i)
179 z2(i)=xrefs(6,3,i)
180 x3(i)=xrefs(7,1,i)
181 y3(i)=xrefs(7,2,i)
182 z3(i)=xrefs(7,3,i)
183 x4(i)=xrefs(8,1,i)
184 y4(i)=xrefs(8,2,i)
185 z4(i)=xrefs(8,3,i)
186 x5(i)=xrefs(1,1,i)
187 y5(i)=xrefs(1,2,i)
188 z5(i)=xrefs(1,3,i)
189 x6(i)=xrefs(2,1,i)
190 y6(i)=xrefs(2,2,i)
191 z6(i)=xrefs(2,3,i)
192 x7(i)=xrefs(3,1,i)
193 y7(i)=xrefs(3,2,i)
194 z7(i)=xrefs(3,3,i)
195 x8(i)=xrefs(4,1,i)
196 y8(i)=xrefs(4,2,i)
197 z8(i)=xrefs(4,3,i)
198 xrefs(1,1,i)=x1(i)
199 xrefs(1,2,i)=y1(i)
200 xrefs(1,3,i)=z1(i)
201 xrefs(2,1,i)=x2(i)
202 xrefs(2,2,i)=y2(i)
203 xrefs(2,3,i)=z2(i)
204 xrefs(3,1,i)=x3(i)
205 xrefs(3,2,i)=y3(i)
206 xrefs(3,3,i)=z3(i)
207 xrefs(4,1,i)=x4(i)
208 xrefs(4,2,i)=y4(i)
209 xrefs(4,3,i)=z4(i)
210 xrefs(5,1,i)=x5(i)
211 xrefs(5,2,i)=y5(i)
212 xrefs(5,3,i)=z5(i)
213 xrefs(6,1,i)=x6(i)
214 xrefs(6,2,i)=y6(i)
215 xrefs(6,3,i)=z6(i)
216 xrefs(7,1,i)=x7(i)
217 xrefs(7,2,i)=y7(i)
218 xrefs(7,3,i)=z7(i)
219 xrefs(8,1,i)=x8(i)
220 xrefs(8,2,i)=y8(i)
221 xrefs(8,3,i)=z8(i)
222 ELSE
223 x1(i)=xrefs(1,1,i)
224 y1(i)=xrefs(1,2,i)
225 z1(i)=xrefs(1,3,i)
226 x2(i)=xrefs(2,1,i)
227 y2(i)=xrefs(2,2,i)
228 z2(i)=xrefs(2,3,i)
229 x3(i)=xrefs(3,1,i)
230 y3(i)=xrefs(3,2,i)
231 z3(i)=xrefs(3,3,i)
232 x4(i)=xrefs(4,1,i)
233 y4(i)=xrefs(4,2,i)
234 z4(i)=xrefs(4,3,i)
235 x5(i)=xrefs(5,1,i)
236 y5(i)=xrefs(5,2,i)
237 z5(i)=xrefs(5,3,i)
238 x6(i)=xrefs(6,1,i)
239 y6(i)=xrefs(6,2,i)
240 z6(i)=xrefs(6,3,i)
241 x7(i)=xrefs(7,1,i)
242 y7(i)=xrefs(7,2,i)
243 z7(i)=xrefs(7,3,i)
244 x8(i)=xrefs(8,1,i)
245 y8(i)=xrefs(8,2,i)
246 z8(i)=xrefs(8,3,i)
247 ENDIF
248 ENDDO
249 ENDIF
250C
251 DO i=lft,llt
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 xd5(i) = x5(i)
265 yd5(i) = y5(i)
266 zd5(i) = z5(i)
267 xd6(i) = x6(i)
268 yd6(i) = y6(i)
269 zd6(i) = z6(i)
270 xd7(i) = x7(i)
271 yd7(i) = y7(i)
272 zd7(i) = z7(i)
273 xd8(i) = x8(i)
274 yd8(i) = y8(i)
275 zd8(i) = z8(i)
276 ENDDO
277C
278 IF(jclos/=0) CALL mod_close(geo,ngeo,
279 . x1, x2, x3, x4, x5, x6, x7, x8,
280 . y1, y2, y3, y4, y5, y6, y7, y8,
281 . z1, z2, z3, z4, z5, z6, z7, z8)
282c
283C Repere isoparametrique
284C
285 DO i=lft,llt
286 f1x(i) = x2(i)+x3(i)-x1(i)-x4(i)
287 f1y(i) = y2(i)+y3(i)-y1(i)-y4(i)
288 f1z(i) = z2(i)+z3(i)-z1(i)-z4(i)
289 f2x(i) = x3(i)+x4(i)-x1(i)-x2(i)
290 f2y(i) = y3(i)+y4(i)-y1(i)-y2(i)
291 f2z(i) = z3(i)+z4(i)-z1(i)-z2(i)
292 rx(i) = f2x(i)+x7(i)+x8(i)-x5(i)-x6(i)
293 ry(i) = f2y(i)+y7(i)+y8(i)-y5(i)-y6(i)
294 rz(i) = f2z(i)+z7(i)+z8(i)-z5(i)-z6(i)
295 tx(i) = f1x(i)+x6(i)+x7(i)-x5(i)-x8(i)
296 ty(i) = f1y(i)+y6(i)+y7(i)-y5(i)-y8(i)
297 tz(i) = f1z(i)+z6(i)+z7(i)-z5(i)-z8(i)
298 sx(i) = x5(i)+x6(i)+x7(i)+x8(i)-x1(i)-x2(i)-x3(i)-x4(i)
299 sy(i) = y5(i)+y6(i)+y7(i)+y8(i)-y1(i)-y2(i)-y3(i)-y4(i)
300 sz(i) = z5(i)+z6(i)+z7(i)+z8(i)-z1(i)-z2(i)-z3(i)-z4(i)
301 ENDDO
302C Orthogonalization of the reference frame
303C E1=R, E3=R^S, E2=E3^E1
304C
305 DO i=lft,llt
306 suma = sqrt(rx(i)**2+ry(i)**2+rz(i)**2)
307 IF (suma > zero) suma=one/suma
308 e1x(i) = rx(i)*suma
309 e1y(i) = ry(i)*suma
310 e1z(i) = rz(i)*suma
311 e3x(i) = e1y(i)*sz(i) - e1z(i)*sy(i)
312 e3y(i) = e1z(i)*sx(i) - e1x(i)*sz(i)
313 e3z(i) = e1x(i)*sy(i) - e1y(i)*sx(i)
314 suma = sqrt(e3x(i)**2+e3y(i)**2+e3z(i)**2)
315 IF (suma > zero) suma=one/suma
316 e3x(i) = e3x(i)*suma
317 e3y(i) = e3y(i)*suma
318 e3z(i) = e3z(i)*suma
319 e2x(i) = e3y(i)*e1z(i) - e3z(i)*e1y(i)
320 e2y(i) = e3z(i)*e1x(i) - e3x(i)*e1z(i)
321 e2z(i) = e3x(i)*e1y(i) - e3y(i)*e1x(i)
322 suma = sqrt(e2x(i)**2+e2y(i)**2+e2z(i)**2)
323 IF (suma > zero) suma=one/suma
324 e2x(i) = e2x(i)*suma
325 e2y(i) = e2y(i)*suma
326 e2z(i) = e2z(i)*suma
327 ENDDO
328 IF (jthe < 0 .or. nintemp > 0) THEN
329 IF (nintemp > 0) THEN
330 DO i= lft,llt
331 IF(temp(ix1(i))== zero) temp(ix1(i)) = temp0(i)
332 IF(temp(ix2(i))== zero) temp(ix2(i)) = temp0(i)
333 IF(temp(ix3(i))== zero) temp(ix3(i)) = temp0(i)
334 IF(temp(ix4(i))== zero) temp(ix4(i)) = temp0(i)
335 IF(temp(ix5(i))== zero) temp(ix5(i)) = temp0(i)
336 IF(temp(ix6(i))== zero) temp(ix6(i)) = temp0(i)
337 IF(temp(ix7(i))== zero) temp(ix7(i)) = temp0(i)
338 IF(temp(ix8(i))== zero) temp(ix8(i)) = temp0(i)
339 ENDDO
340 ELSE
341 DO i=lft,llt
342 temp(ix1(i))=temp0(i)
343 temp(ix2(i))=temp0(i)
344 temp(ix3(i))=temp0(i)
345 temp(ix4(i))=temp0(i)
346 temp(ix5(i))=temp0(i)
347 temp(ix6(i))=temp0(i)
348 temp(ix7(i))=temp0(i)
349 temp(ix8(i))=temp0(i)
350 ENDDO
351 ENDIF
352 ENDIF
353C-----------
354 RETURN
355 END
356!||====================================================================
357!|| sgsavini ../starter/source/elements/solid/solide/scoor3.F
358!||--- called by ------------------------------------------------------
359!|| initia ../starter/source/elements/initia/initia.F
360!||--- calls -----------------------------------------------------
361!|| checkvolume_4n ../starter/source/elements/solid/solide/checksvolume.F
362!||--- uses -----------------------------------------------------
363!||====================================================================
364 SUBROUTINE sgsavini(NPE,X,IXS,SAV,NEL)
365 use element_mod , only : nixs
366C-----------------------------------------------
367C I m p l i c i t T y p e s
368C-----------------------------------------------
369#include "implicit_f.inc"
370C-----------------------------------------------
371C G l o b a l P a r a m e t e r s
372C-----------------------------------------------
373#include "mvsiz_p.inc"
374C-----------------------------------------------
375C C o m m o n B l o c k s
376C-----------------------------------------------
377#include "vect01_c.inc"
378C-----------------------------------------------
379C D u m m y A r g u m e n t s
380C-----------------------------------------------
381 INTEGER NPE,NEL
382 INTEGER IXS(NIXS,*)
383 my_real
384 . X(3,*)
385 DOUBLE PRECISION
386 . SAV(NEL,3*(NPE-1))
387C-----------------------------------------------
388C E x t e r n a l F u n c t i o n s
389C-----------------------------------------------
390 my_real
391 . CHECKVOLUME_4N
392C-----------------------------------------------
393C L o c a l V a r i a b l e s
394C-----------------------------------------------
395 INTEGER I,NPE1,N
396 INTEGER NC(MVSIZ,NPE)
397C REAL
398c my_real
399 DOUBLE PRECISION
400 . XL(MVSIZ),YL(MVSIZ),ZL(MVSIZ)
401C-----------------------------------------------
402C
403 npe1=npe-1
404 IF (npe==4) THEN
405 DO i=lft,llt
406 IF (checkvolume_4n(x ,ixs(1,i)) < zero) THEN
407C renumber connectivity
408 nc(i,2)=ixs(6,i)
409 nc(i,4)=ixs(4,i)
410 ixs(4,i)=nc(i,2)
411 ixs(6,i)=nc(i,4)
412 ixs(5,i)=nc(i,2)
413 ixs(9,i)=nc(i,4)
414 ENDIF
415 ENDDO
416 DO i=lft,llt
417 nc(i,1)=ixs(2,i)
418 nc(i,2)=ixs(4,i)
419 nc(i,3)=ixs(7,i)
420 nc(i,4)=ixs(6,i)
421 ENDDO
422 ELSE
423 DO n=1,npe
424 DO i=lft,llt
425 nc(i,n)=ixs(n+1,i)
426 ENDDO
427 ENDDO
428 ENDIF
429C
430 DO i=lft,llt
431 xl(i)=x(1,nc(i,npe))
432 yl(i)=x(2,nc(i,npe))
433 zl(i)=x(3,nc(i,npe))
434 ENDDO
435 DO n=1,npe1
436 DO i=lft,llt
437 sav(i,n) = x(1,nc(i,n))-xl(i)
438 sav(i,n+npe1) = x(2,nc(i,n))-yl(i)
439 sav(i,n+2*npe1)= x(3,nc(i,n))-zl(i)
440 ENDDO
441 ENDDO
442C
443 RETURN
444 END
checkvolume_8n
function checkvolume_8n(x, ixs)
Definition checksvolume.F:39
message_mod
Definition message_mod.F:1257
mod_close
subroutine mod_close(geo, ngeo, x1, x2, x3, x4, x5, x6, x7, x8, y1, y2, y3, y4, y5, y6, y7, y8, z1, z2, z3, z4, z5, z6, z7, z8)
Definition mod_close.F:34
scoor3
subroutine scoor3(x, xrefs, ixs, geo, mxt, ngeo, ngl, ix1, ix2, ix3, ix4, ix5, ix6, ix7, ix8, x1, x2, x3, x4, x5, x6, x7, x8, y1, y2, y3, y4, y5, y6, y7, y8, z1, z2, z3, z4, z5, z6, z7, z8, rx, ry, rz, sx, sy, sz, tx, ty, tz, e1x, e1y, e1z, e2x, e2y, e2z, e3x, e3y, e3z, f1x, f1y, f1z, f2x, f2y, f2z, temp0, temp, nintemp, xd1, xd2, xd3, xd4, xd5, xd6, xd7, xd8, yd1, yd2, yd3, yd4, yd5, yd6, yd7, yd8, zd1, zd2, zd3, zd4, zd5, zd6, zd7, zd8)
Definition scoor3.F:52
sgsavini
subroutine sgsavini(npe, x, ixs, sav, nel)
Definition scoor3.F:365