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