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
41 use element_mod , only : nixs
42C-----------------------------------------------
43C I m p l i c i t T y p e s
44C-----------------------------------------------
45#include "implicit_f.inc"
46C-----------------------------------------------
47C C o m m o n B l o c k s
48C-----------------------------------------------
49#include "scr03_c.inc"
50#include "vect01_c.inc"
51C-----------------------------------------------
52C D u m m y A r g u m e n t s
53C-----------------------------------------------
54 INTEGER IXS(NIXS,*), NGL(*), MXT(*),NGEO(*),
55 . IX1(*), IX2(*), IX3(*), IX4(*)
56 DOUBLE PRECISION
57 . x1(*),x2(*),x3(*),x4(*),
58 . y1(*),y2(*),y3(*),y4(*),
59 . z1(*),z2(*),z3(*),z4(*)
60C REAL
61 my_real
62 . x(3,*),xrefs(8,3,*)
63C-----------------------------------------------
64C L o c a l V a r i a b l e s
65C-----------------------------------------------
66 INTEGER I
67C-----------------------------------------------
68C E x t e r n a l F u n c t i o n s
69C-----------------------------------------------
70 my_real
71 . checkvolume_4n
72C=======================================================================
73C connectivities and material number and pid
74C--------------------------------------------------
75 DO i=lft,llt
76 mxt(i) =ixs(1,i)
77 ngeo(i)=ixs(nixs-1,i)
78 ngl(i) =ixs(nixs,i)
79 ix1(i) =ixs(2,i)
80 ix2(i) =ixs(4,i)
81 ix3(i) =ixs(7,i)
82 ix4(i) =ixs(6,i)
83 ENDDO
84C
85 IF (nxref == 0) THEN
86 DO i=lft,llt
87 IF (checkvolume_4n(x ,ixs(1,i)) < zero) THEN
88C renumber connectivity
89 ix2(i)=ixs(6,i)
90 ix4(i)=ixs(4,i)
91 ixs(4,i)=ix2(i)
92 ixs(6,i)=ix4(i)
93 ixs(5,i)=ix2(i)
94 ixs(9,i)=ix4(i)
95 ENDIF
96 x1(i)=x(1,ix1(i))
97 y1(i)=x(2,ix1(i))
98 z1(i)=x(3,ix1(i))
99 x2(i)=x(1,ix2(i))
100 y2(i)=x(2,ix2(i))
101 z2(i)=x(3,ix2(i))
102 x3(i)=x(1,ix3(i))
103 y3(i)=x(2,ix3(i))
104 z3(i)=x(3,ix3(i))
105 x4(i)=x(1,ix4(i))
106 y4(i)=x(2,ix4(i))
107 z4(i)=x(3,ix4(i))
108 ENDDO
109 ELSE ! XREF
110 DO i=lft,llt
111 IF (checkvolume_4n(x ,ixs(1,i)) < zero) THEN
112C renumber connectivity
113 ix2(i)=ixs(6,i)
114 ix4(i)=ixs(4,i)
115 ixs(4,i)=ix2(i)
116 ixs(6,i)=ix4(i)
117 ixs(5,i)=ix2(i)
118 ixs(9,i)=ix4(i)
119 x1(i) = xrefs(1,1,i)
120 y1(i) = xrefs(1,2,i)
121 z1(i) = xrefs(1,3,i)
122 x2(i) = xrefs(5,1,i)
123 y2(i) = xrefs(5,2,i)
124 z2(i) = xrefs(5,3,i)
125 x3(i) = xrefs(6,1,i)
126 y3(i) = xrefs(6,2,i)
127 z3(i) = xrefs(6,3,i)
128 x4(i) = xrefs(3,1,i)
129 y4(i) = xrefs(3,2,i)
130 z4(i) = xrefs(3,3,i)
131 ELSE
132 x1(i) = xrefs(1,1,i)
133 y1(i) = xrefs(1,2,i)
134 z1(i) = xrefs(1,3,i)
135 x2(i) = xrefs(3,1,i)
136 y2(i) = xrefs(3,2,i)
137 z2(i) = xrefs(3,3,i)
138 x3(i) = xrefs(6,1,i)
139 y3(i) = xrefs(6,2,i)
140 z3(i) = xrefs(6,3,i)
141 x4(i) = xrefs(5,1,i)
142 y4(i) = xrefs(5,2,i)
143 z4(i) = xrefs(5,3,i)
144 ENDIF
145 xrefs(1,1,i) = x1(i)
146 xrefs(1,2,i) = y1(i)
147 xrefs(1,3,i) = z1(i)
148 xrefs(2,1,i) = x2(i)
149 xrefs(2,2,i) = y2(i)
150 xrefs(2,3,i) = z2(i)
151 xrefs(3,1,i) = x3(i)
152 xrefs(3,2,i) = y3(i)
153 xrefs(3,3,i) = z3(i)
154 xrefs(4,1,i) = x4(i)
155 xrefs(4,2,i) = y4(i)
156 xrefs(4,3,i) = z4(i)
157 ENDDO
158 ENDIF
159C-----------
160 RETURN
161 END
checkvolume_4n
function checkvolume_4n(x, ixs)
Definition checksvolume.F:217
my_real
#define my_real
Definition cppsort.cpp:32
message_mod
Definition message_mod.F:1257
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