OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
s4coor3.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!|| s4coor3 ../starter/source/elements/solid/solide4/s4coor3.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_init3t ../starter/source/multifluid/multifluid_init3t.F
30!|| s4init3 ../starter/source/elements/solid/solide4/s4init3.F
31!||--- calls -----------------------------------------------------
32!|| checkvolume_4n ../starter/source/elements/solid/solide/checksvolume.F
33!||--- uses -----------------------------------------------------
34!|| message_mod ../starter/share/message_module/message_mod.F
35!||====================================================================
36 SUBROUTINE s4coor3(X ,XREFS ,IXS ,NGL ,MXT ,
37 . NGEO ,IX1 ,IX2 ,IX3 ,IX4 ,
38 . X1 ,X2 ,X3 ,X4 ,Y1 ,Y2 ,
39 . Y3 ,Y4 ,Z1 ,Z2 ,Z3 ,Z4 )
40 USE message_mod
41C-----------------------------------------------
42C I m p l i c i t T y p e s
43C-----------------------------------------------
44#include "implicit_f.inc"
45C-----------------------------------------------
46C C o m m o n B l o c k s
47C-----------------------------------------------
48#include "scr03_c.inc"
49#include "vect01_c.inc"
50C-----------------------------------------------
51C D u m m y A r g u m e n t s
52C-----------------------------------------------
53 INTEGER IXS(NIXS,*), NGL(*), MXT(*),NGEO(*),
54 . IX1(*), IX2(*), IX3(*), IX4(*)
55 DOUBLE PRECISION
56 . x1(*),x2(*),x3(*),x4(*),
57 . y1(*),y2(*),y3(*),y4(*),
58 . z1(*),z2(*),z3(*),z4(*)
59C REAL
60 my_real
61 . x(3,*),xrefs(8,3,*)
62C-----------------------------------------------
63C L o c a l V a r i a b l e s
64C-----------------------------------------------
65 INTEGER I,N1,N2,N3,N4
66C-----------------------------------------------
67C E x t e r n a l F u n c t i o n s
68C-----------------------------------------------
69 my_real
70 . checkvolume_4n
71C=======================================================================
72C CONNECTIVITES ET NUMERO DE MATERIAU ET PID
73C--------------------------------------------------
74 DO i=lft,llt
75 mxt(i) =ixs(1,i)
76 ngeo(i)=ixs(nixs-1,i)
77 ngl(i) =ixs(nixs,i)
78 ix1(i) =ixs(2,i)
79 ix2(i) =ixs(4,i)
80 ix3(i) =ixs(7,i)
81 ix4(i) =ixs(6,i)
82 ENDDO
83C
84 IF (nxref == 0) THEN
85 DO i=lft,llt
86 IF (checkvolume_4n(x ,ixs(1,i)) < zero) THEN
87C renumber connectivity
88 ix2(i)=ixs(6,i)
89 ix4(i)=ixs(4,i)
90 ixs(4,i)=ix2(i)
91 ixs(6,i)=ix4(i)
92 ixs(5,i)=ix2(i)
93 ixs(9,i)=ix4(i)
94 ENDIF
95 x1(i)=x(1,ix1(i))
96 y1(i)=x(2,ix1(i))
97 z1(i)=x(3,ix1(i))
98 x2(i)=x(1,ix2(i))
99 y2(i)=x(2,ix2(i))
100 z2(i)=x(3,ix2(i))
101 x3(i)=x(1,ix3(i))
102 y3(i)=x(2,ix3(i))
103 z3(i)=x(3,ix3(i))
104 x4(i)=x(1,ix4(i))
105 y4(i)=x(2,ix4(i))
106 z4(i)=x(3,ix4(i))
107 ENDDO
108 ELSE ! XREF
109 DO i=lft,llt
110 IF (checkvolume_4n(x ,ixs(1,i)) < zero) THEN
111C renumber connectivity
112 ix2(i)=ixs(6,i)
113 ix4(i)=ixs(4,i)
114 ixs(4,i)=ix2(i)
115 ixs(6,i)=ix4(i)
116 ixs(5,i)=ix2(i)
117 ixs(9,i)=ix4(i)
118 x1(i) = xrefs(1,1,i)
119 y1(i) = xrefs(1,2,i)
120 z1(i) = xrefs(1,3,i)
121 x2(i) = xrefs(5,1,i)
122 y2(i) = xrefs(5,2,i)
123 z2(i) = xrefs(5,3,i)
124 x3(i) = xrefs(6,1,i)
125 y3(i) = xrefs(6,2,i)
126 z3(i) = xrefs(6,3,i)
127 x4(i) = xrefs(3,1,i)
128 y4(i) = xrefs(3,2,i)
129 z4(i) = xrefs(3,3,i)
130 ELSE
131 x1(i) = xrefs(1,1,i)
132 y1(i) = xrefs(1,2,i)
133 z1(i) = xrefs(1,3,i)
134 x2(i) = xrefs(3,1,i)
135 y2(i) = xrefs(3,2,i)
136 z2(i) = xrefs(3,3,i)
137 x3(i) = xrefs(6,1,i)
138 y3(i) = xrefs(6,2,i)
139 z3(i) = xrefs(6,3,i)
140 x4(i) = xrefs(5,1,i)
141 y4(i) = xrefs(5,2,i)
142 z4(i) = xrefs(5,3,i)
143 ENDIF
144 xrefs(1,1,i) = x1(i)
145 xrefs(1,2,i) = y1(i)
146 xrefs(1,3,i) = z1(i)
147 xrefs(2,1,i) = x2(i)
148 xrefs(2,2,i) = y2(i)
149 xrefs(2,3,i) = z2(i)
150 xrefs(3,1,i) = x3(i)
151 xrefs(3,2,i) = y3(i)
152 xrefs(3,3,i) = z3(i)
153 xrefs(4,1,i) = x4(i)
154 xrefs(4,2,i) = y4(i)
155 xrefs(4,3,i) = z4(i)
156 ENDDO
157 ENDIF
158C-----------
159 RETURN
160 END
checkvolume_4n
function checkvolume_4n(x, ixs)
Definition checksvolume.F:212
my_real
#define my_real
Definition cppsort.cpp:32
message_mod
Definition message_mod.F:1249
s4coor3
subroutine s4coor3(x, xrefs, ixs, ngl, mxt, ngeo, ix1, ix2, ix3, ix4, x1, x2, x3, x4, y1, y2, y3, y4, z1, z2, z3, z4)
Definition s4coor3.F:40