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