OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
srcoor3.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!|| srcoor3 ../starter/source/elements/solid/solide/srcoor3.F
25!||--- called by ------------------------------------------------------
26!|| inisoldist ../starter/source/initial_conditions/inivol/inisoldist.f
27!|| multifluid_init3 ../starter/source/multifluid/multifluid_init3.F
28!|| s8cinit3 ../starter/source/elements/thickshell/solide8c/s8cinit3.F
29!|| s8zinit3 ../starter/source/elements/solid/solide8z/s8zinit3.F
30!|| sinit3 ../starter/source/elements/solid/solide/sinit3.F
31!|| suinit3 ../starter/source/elements/elbuf_init/suinit3.F
32!||--- calls -----------------------------------------------------
33!|| checkvolume_8n ../starter/source/elements/solid/solide/checksvolume.F
34!|| mod_close ../starter/source/elements/solid/solide/mod_close.F
35!|| sortho3 ../starter/source/elements/solid/solide/sortho3.F
36!|| srepiso3 ../starter/source/elements/solid/solide/srepiso3.F
37!||--- uses -----------------------------------------------------
38!|| message_mod ../starter/share/message_module/message_mod.f
39!||====================================================================
40 SUBROUTINE srcoor3(
41 . X ,XREFS,IXS ,GEO ,MXT ,NGEO ,NGL ,JHBE ,
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 )
52 USE message_mod
53C-----------------------------------------------
54C I m p l i c i t T y p e s
55C-----------------------------------------------
56#include "implicit_f.inc"
57C-----------------------------------------------
58C G l o b a l P a r a m e t e r s
59C-----------------------------------------------
60#include "mvsiz_p.inc"
61C-----------------------------------------------
62C C o m m o n B l o c k s
63C-----------------------------------------------
64#include "vect01_c.inc"
65#include "scr03_c.inc"
66#include "com04_c.inc"
67C-----------------------------------------------
68C D u m m y A r g u m e n t s
69C-----------------------------------------------
70 INTEGER IXS(NIXS,*),MXT(*),NGL(*),NGEO(*),JHBE,
71 . IX1(*),IX2(*),IX3(*),IX4(*),IX5(*),IX6(*),IX7(*),IX8(*)
72 INTEGER ,INTENT(IN) :: NINTEMP
73C REAL
74 my_real
75 . X(3,*),GEO(*),
76 . X1(*), X2(*), X3(*), X4(*), X5(*), X6(*), X7(*), X8(*),
77 . Y1(*), Y2(*), Y3(*), Y4(*), Y5(*), Y6(*), Y7(*), Y8(*),
78 . Z1(*), Z2(*), Z3(*), Z4(*), Z5(*), Z6(*), Z7(*), Z8(*),
79 . E1X(*),E2X(*),E3X(*),E1Y(*),E2Y(*),E3Y(*),E1Z(*),E2Z(*),E3Z(*),
80 . RX(*) ,RY(*) ,RZ(*) ,SX(*) ,SY(*) ,SZ(*) ,TX(*) ,TY(*) ,TZ(*),
81 . f1x(*),f1y(*),f1z(*),f2x(*),f2y(*),f2z(*),temp0(mvsiz),
82 . temp(*),xrefs(8,3,*)
83 DOUBLE PRECISION
84 . XD1(MVSIZ), XD2(MVSIZ), XD3(MVSIZ), XD4(MVSIZ),
85 . xd5(mvsiz), xd6(mvsiz), xd7(mvsiz), xd8(mvsiz),
86 . yd1(mvsiz), yd2(mvsiz), yd3(mvsiz), yd4(mvsiz),
87 . yd5(mvsiz), yd6(mvsiz), yd7(mvsiz), yd8(mvsiz),
88 . zd1(mvsiz), zd2(mvsiz), zd3(mvsiz), zd4(mvsiz),
89 . zd5(mvsiz), zd6(mvsiz), zd7(mvsiz), zd8(mvsiz)
90C-----------------------------------------------
91C L o c a l V a r i a b l e s
92C-----------------------------------------------
93 INTEGER I,J
94 DOUBLE PRECISION
95 . XL,YL,ZL
96C-----------------------------------------------
97C E x t e r n a l F u n c t i o n s
98C-----------------------------------------------
99 my_real
100 . CHECKVOLUME_8N
101C=======================================================================
102C CONNECTIVITES ET NUMERO DE MATERIAU ET PID
103C--------------------------------------------------
104 DO i=lft,llt
105 mxt(i)=ixs(1,i)
106 ix1(i)=ixs(2,i)
107 ix2(i)=ixs(3,i)
108 ix3(i)=ixs(4,i)
109 ix4(i)=ixs(5,i)
110 ix5(i)=ixs(6,i)
111 ix6(i)=ixs(7,i)
112 ix7(i)=ixs(8,i)
113 ix8(i)=ixs(9,i)
114 ngeo(i)=ixs(nixs-1,i)
115 ngl(i)=ixs(nixs,i)
116 IF (checkvolume_8n(x ,ixs(1,i)) < zero) THEN
117C renumber connectivity
118 ix1(i)=ixs(6,i)
119 ix2(i)=ixs(7,i)
120 ix3(i)=ixs(8,i)
121 ix4(i)=ixs(9,i)
122 ix5(i)=ixs(2,i)
123 ix6(i)=ixs(3,i)
124 ix7(i)=ixs(4,i)
125 ix8(i)=ixs(5,i)
126 ixs(2,i)=ix1(i)
127 ixs(3,i)=ix2(i)
128 ixs(4,i)=ix3(i)
129 ixs(5,i)=ix4(i)
130 ixs(6,i)=ix5(i)
131 ixs(7,i)=ix6(i)
132 ixs(8,i)=ix7(i)
133 ixs(9,i)=ix8(i)
134 ENDIF
135 ENDDO
136C
137C----------------------------
138C COORDONNEES
139C----------------------------
140 IF (nxref == 0) THEN
141 DO i=lft,llt
142 x1(i)=x(1,ix1(i))
143 y1(i)=x(2,ix1(i))
144 z1(i)=x(3,ix1(i))
145 x2(i)=x(1,ix2(i))
146 y2(i)=x(2,ix2(i))
147 z2(i)=x(3,ix2(i))
148 x3(i)=x(1,ix3(i))
149 y3(i)=x(2,ix3(i))
150 z3(i)=x(3,ix3(i))
151 x4(i)=x(1,ix4(i))
152 y4(i)=x(2,ix4(i))
153 z4(i)=x(3,ix4(i))
154 x5(i)=x(1,ix5(i))
155 y5(i)=x(2,ix5(i))
156 z5(i)=x(3,ix5(i))
157 x6(i)=x(1,ix6(i))
158 y6(i)=x(2,ix6(i))
159 z6(i)=x(3,ix6(i))
160 x7(i)=x(1,ix7(i))
161 y7(i)=x(2,ix7(i))
162 z7(i)=x(3,ix7(i))
163 x8(i)=x(1,ix8(i))
164 y8(i)=x(2,ix8(i))
165 z8(i)=x(3,ix8(i))
166 ENDDO
167 ELSE
168 DO i=lft,llt
169 IF (checkvolume_8n(x ,ixs(1,i)) < zero) THEN
170 x1(i)=xrefs(5,1,i)
171 y1(i)=xrefs(5,2,i)
172 z1(i)=xrefs(5,3,i)
173 x2(i)=xrefs(6,1,i)
174 y2(i)=xrefs(6,2,i)
175 z2(i)=xrefs(6,3,i)
176 x3(i)=xrefs(7,1,i)
177 y3(i)=xrefs(7,2,i)
178 z3(i)=xrefs(7,3,i)
179 x4(i)=xrefs(8,1,i)
180 y4(i)=xrefs(8,2,i)
181 z4(i)=xrefs(8,3,i)
182 x5(i)=xrefs(1,1,i)
183 y5(i)=xrefs(1,2,i)
184 z5(i)=xrefs(1,3,i)
185 x6(i)=xrefs(2,1,i)
186 y6(i)=xrefs(2,2,i)
187 z6(i)=xrefs(2,3,i)
188 x7(i)=xrefs(3,1,i)
189 y7(i)=xrefs(3,2,i)
190 z7(i)=xrefs(3,3,i)
191 x8(i)=xrefs(4,1,i)
192 y8(i)=xrefs(4,2,i)
193 z8(i)=xrefs(4,3,i)
194 xrefs(1,1,i)=x1(i)
195 xrefs(1,2,i)=y1(i)
196 xrefs(1,3,i)=z1(i)
197 xrefs(2,1,i)=x2(i)
198 xrefs(2,2,i)=y2(i)
199 xrefs(2,3,i)=z2(i)
200 xrefs(3,1,i)=x3(i)
201 xrefs(3,2,i)=y3(i)
202 xrefs(3,3,i)=z3(i)
203 xrefs(4,1,i)=x4(i)
204 xrefs(4,2,i)=y4(i)
205 xrefs(4,3,i)=z4(i)
206 xrefs(5,1,i)=x5(i)
207 xrefs(5,2,i)=y5(i)
208 xrefs(5,3,i)=z5(i)
209 xrefs(6,1,i)=x6(i)
210 xrefs(6,2,i)=y6(i)
211 xrefs(6,3,i)=z6(i)
212 xrefs(7,1,i)=x7(i)
213 xrefs(7,2,i)=y7(i)
214 xrefs(7,3,i)=z7(i)
215 xrefs(8,1,i)=x8(i)
216 xrefs(8,2,i)=y8(i)
217 xrefs(8,3,i)=z8(i)
218 ELSE
219 x1(i)=xrefs(1,1,i)
220 y1(i)=xrefs(1,2,i)
221 z1(i)=xrefs(1,3,i)
222 x2(i)=xrefs(2,1,i)
223 y2(i)=xrefs(2,2,i)
224 z2(i)=xrefs(2,3,i)
225 x3(i)=xrefs(3,1,i)
226 y3(i)=xrefs(3,2,i)
227 z3(i)=xrefs(3,3,i)
228 x4(i)=xrefs(4,1,i)
229 y4(i)=xrefs(4,2,i)
230 z4(i)=xrefs(4,3,i)
231 x5(i)=xrefs(5,1,i)
232 y5(i)=xrefs(5,2,i)
233 z5(i)=xrefs(5,3,i)
234 x6(i)=xrefs(6,1,i)
235 y6(i)=xrefs(6,2,i)
236 z6(i)=xrefs(6,3,i)
237 x7(i)=xrefs(7,1,i)
238 y7(i)=xrefs(7,2,i)
239 z7(i)=xrefs(7,3,i)
240 x8(i)=xrefs(8,1,i)
241 y8(i)=xrefs(8,2,i)
242 z8(i)=xrefs(8,3,i)
243 ENDIF
244 ENDDO
245 ENDIF
246C
247 DO i=lft,llt
248 xd1(i) = x1(i)
249 yd1(i) = y1(i)
250 zd1(i) = z1(i)
251 xd2(i) = x2(i)
252 yd2(i) = y2(i)
253 zd2(i) = z2(i)
254 xd3(i) = x3(i)
255 yd3(i) = y3(i)
256 zd3(i) = z3(i)
257 xd4(i) = x4(i)
258 yd4(i) = y4(i)
259 zd4(i) = z4(i)
260 xd5(i) = x5(i)
261 yd5(i) = y5(i)
262 zd5(i) = z5(i)
263 xd6(i) = x6(i)
264 yd6(i) = y6(i)
265 zd6(i) = z6(i)
266 xd7(i) = x7(i)
267 yd7(i) = y7(i)
268 zd7(i) = z7(i)
269 xd8(i) = x8(i)
270 yd8(i) = y8(i)
271 zd8(i) = z8(i)
272 ENDDO
273C
274 IF(jclos/=0) CALL mod_close(geo,ngeo,
275 . x1, x2, x3, x4, x5, x6, x7, x8,
276 . y1, y2, y3, y4, y5, y6, y7, y8,
277 . z1, z2, z3, z4, z5, z6, z7, z8)
278C
279C Repere isoparametrique conforme manuel pour les briques
280 CALL srepiso3(
281 . x1, x2, x3, x4, x5, x6, x7, x8,
282 . y1, y2, y3, y4, y5, y6, y7, y8,
283 . z1, z2, z3, z4, z5, z6, z7, z8,
284 . rx, ry, rz, sx, sy, sz, tx, ty,
285 . tz ,f1x ,f1y ,f1z ,f2x ,f2y ,f2z )
286C-----------
287C REPERE CONVECTE
288C-----------
289 IF (jhbe == 14 .OR. jhbe == 24) THEN
290C HA8 / HEPH
291 CALL sortho3(
292 . rx ,ry ,rz ,sx ,sy ,sz ,tx ,ty ,tz ,
293 . e2x ,e2y ,e2z ,e3x ,e3y ,e3z ,e1x ,e1y ,e1z )
294 ELSE
295 CALL sortho3(
296 . rx ,ry ,rz ,sx ,sy ,sz ,tx ,ty ,tz ,
297 . e1x ,e1y ,e1z ,e2x ,e2y ,e2z ,e3x ,e3y ,e3z )
298 END IF
299C-----------
300C PASSAGE to Local_SYS in DP, add case JHBE==1(ISORTH==0) but Xj remain in Global_sys as before
301C-----------
302 IF (jhbe==14 .OR. jhbe==24 .OR. jhbe==17 .OR.(jhbe==1 .AND. isorth==0)) THEN
303 DO i=lft,llt
304 xl=e1x(i)*xd1(i)+e1y(i)*yd1(i)+e1z(i)*zd1(i)
305 yl=e2x(i)*xd1(i)+e2y(i)*yd1(i)+e2z(i)*zd1(i)
306 zl=e3x(i)*xd1(i)+e3y(i)*yd1(i)+e3z(i)*zd1(i)
307 xd1(i)=xl
308 yd1(i)=yl
309 zd1(i)=zl
310 xl=e1x(i)*xd2(i)+e1y(i)*yd2(i)+e1z(i)*zd2(i)
311 yl=e2x(i)*xd2(i)+e2y(i)*yd2(i)+e2z(i)*zd2(i)
312 zl=e3x(i)*xd2(i)+e3y(i)*yd2(i)+e3z(i)*zd2(i)
313 xd2(i)=xl
314 yd2(i)=yl
315 zd2(i)=zl
316 xl=e1x(i)*xd3(i)+e1y(i)*yd3(i)+e1z(i)*zd3(i)
317 yl=e2x(i)*xd3(i)+e2y(i)*yd3(i)+e2z(i)*zd3(i)
318 zl=e3x(i)*xd3(i)+e3y(i)*yd3(i)+e3z(i)*zd3(i)
319 xd3(i)=xl
320 yd3(i)=yl
321 zd3(i)=zl
322 xl=e1x(i)*xd4(i)+e1y(i)*yd4(i)+e1z(i)*zd4(i)
323 yl=e2x(i)*xd4(i)+e2y(i)*yd4(i)+e2z(i)*zd4(i)
324 zl=e3x(i)*xd4(i)+e3y(i)*yd4(i)+e3z(i)*zd4(i)
325 xd4(i)=xl
326 yd4(i)=yl
327 zd4(i)=zl
328 xl=e1x(i)*xd5(i)+e1y(i)*yd5(i)+e1z(i)*zd5(i)
329 yl=e2x(i)*xd5(i)+e2y(i)*yd5(i)+e2z(i)*zd5(i)
330 zl=e3x(i)*xd5(i)+e3y(i)*yd5(i)+e3z(i)*zd5(i)
331 xd5(i)=xl
332 yd5(i)=yl
333 zd5(i)=zl
334 xl=e1x(i)*xd6(i)+e1y(i)*yd6(i)+e1z(i)*zd6(i)
335 yl=e2x(i)*xd6(i)+e2y(i)*yd6(i)+e2z(i)*zd6(i)
336 zl=e3x(i)*xd6(i)+e3y(i)*yd6(i)+e3z(i)*zd6(i)
337 xd6(i)=xl
338 yd6(i)=yl
339 zd6(i)=zl
340 xl=e1x(i)*xd7(i)+e1y(i)*yd7(i)+e1z(i)*zd7(i)
341 yl=e2x(i)*xd7(i)+e2y(i)*yd7(i)+e2z(i)*zd7(i)
342 zl=e3x(i)*xd7(i)+e3y(i)*yd7(i)+e3z(i)*zd7(i)
343 xd7(i)=xl
344 yd7(i)=yl
345 zd7(i)=zl
346 xl=e1x(i)*xd8(i)+e1y(i)*yd8(i)+e1z(i)*zd8(i)
347 yl=e2x(i)*xd8(i)+e2y(i)*yd8(i)+e2z(i)*zd8(i)
348 zl=e3x(i)*xd8(i)+e3y(i)*yd8(i)+e3z(i)*zd8(i)
349 xd8(i)=xl
350 yd8(i)=yl
351 zd8(i)=zl
352 ENDDO
353 END IF !(JHBE==14 .OR. JHBE==24 .OR. JHBE==17 .OR.(JHBE==1 .AND. ISORTH==0)) THEN
354 IF (jhbe==14 .OR. jhbe==24 .OR. jhbe==17 ) THEN
355 DO i=lft,llt
356 x1(i) = xd1(i)
357 y1(i) = yd1(i)
358 z1(i) = zd1(i)
359 x2(i) = xd2(i)
360 y2(i) = yd2(i)
361 z2(i) = zd2(i)
362 x3(i) = xd3(i)
363 y3(i) = yd3(i)
364 z3(i) = zd3(i)
365 x4(i) = xd4(i)
366 y4(i) = yd4(i)
367 z4(i) = zd4(i)
368 x5(i) = xd5(i)
369 y5(i) = yd5(i)
370 z5(i) = zd5(i)
371 x6(i) = xd6(i)
372 y6(i) = yd6(i)
373 z6(i) = zd6(i)
374 x7(i) = xd7(i)
375 y7(i) = yd7(i)
376 z7(i) = zd7(i)
377 x8(i) = xd8(i)
378 y8(i) = yd8(i)
379 z8(i) = zd8(i)
380 ENDDO
381 END IF !(JHBE==14 .OR. JHBE==24 .OR. JHBE==17 ) THEN
382C
383 IF (jthe < 0 .or. nintemp > 0) THEN
384 IF(nintemp > 0 ) THEN
385 DO i= lft,llt
386 IF(temp(ix1(i))== zero) temp(ix1(i)) = temp0(i)
387 IF(temp(ix2(i))== zero) temp(ix2(i)) = temp0(i)
388 IF(temp(ix3(i))== zero) temp(ix3(i)) = temp0(i)
389 IF(temp(ix4(i))== zero) temp(ix4(i)) = temp0(i)
390 IF(temp(ix5(i))== zero) temp(ix5(i)) = temp0(i)
391 IF(temp(ix6(i))== zero) temp(ix6(i)) = temp0(i)
392 IF(temp(ix7(i))== zero) temp(ix7(i)) = temp0(i)
393 IF(temp(ix8(i))== zero) temp(ix8(i)) = temp0(i)
394 ENDDO
395 ELSE
396 DO i=lft,llt
397 temp(ix1(i))=temp0(i)
398 temp(ix2(i))=temp0(i)
399 temp(ix3(i))=temp0(i)
400 temp(ix4(i))=temp0(i)
401 temp(ix5(i))=temp0(i)
402 temp(ix6(i))=temp0(i)
403 temp(ix7(i))=temp0(i)
404 temp(ix8(i))=temp0(i)
405 ENDDO
406 ENDIF
407 ENDIF
408C-----
409 RETURN
410 END
inisoldist
subroutine inisoldist(ifill, ixs, x, geo, ng, iparg, idp, ipart_, xrefs, glob_therm, ntrace, ntrace0, dis, nsoltosf, nbip, nnod2surf, inod2surf, knod2surf, surf_eltyp, surf_nodes, jmid, iphase, inphase, kvol, surf_type, iad_bufr, bufsf, nod_normal, isolnod, nbsubmat, fill_ratio, icumu, idc, nbconty, nseg, idsurf, swiftsurf, segtosurf, igrsurf, ivolsurf, nsurf_invol, ixq, ixtg, ityp, nel, numel_tot, num_inivol, inivol, i_inivol)
Definition inisoldist.F:47
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
sortho3
subroutine sortho3(rx, ry, rz, sx, sy, sz, tx, ty, tz, e1x, e1y, e1z, e2x, e2y, e2z, e3x, e3y, e3z)
Definition sortho3.F:33
srcoor3
subroutine srcoor3(x, xrefs, ixs, geo, mxt, ngeo, ngl, jhbe, 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 srcoor3.F:52
srepiso3
subroutine srepiso3(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, f1x, f1y, f1z, f2x, f2y, f2z)
Definition srepiso3.F:35
starter
program starter
Definition starter.F:39