OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
spcoor3.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!|| spcoor3 ../starter/source/elements/solid/sconnect/spcoor3.F
25!||--- called by ------------------------------------------------------
26!|| suinit3 ../starter/source/elements/elbuf_init/suinit3.F
27!||--- calls -----------------------------------------------------
28!|| checkvolume_8n ../starter/source/elements/solid/solide/checksvolume.F
29!|| clskew3 ../starter/source/elements/shell/coque/clskew.F
30!||--- uses -----------------------------------------------------
31!|| message_mod ../starter/share/message_module/message_mod.F
32!||====================================================================
33 SUBROUTINE spcoor3(
34 . X ,IXS ,GEO ,NEL ,MXT ,PID ,NGL ,
35 . IX1 ,IX2 ,IX3 ,IX4 ,IX5 ,IX6 ,IX7 ,IX8 ,
36 . X1 ,X2 ,X3 ,X4 ,X5 ,X6 ,X7 ,X8 ,
37 . Y1 ,Y2 ,Y3 ,Y4 ,Y5 ,Y6 ,Y7 ,Y8 ,
38 . Z1 ,Z2 ,Z3 ,Z4 ,Z5 ,Z6 ,Z7 ,Z8 ,
39 . E1X ,E1Y ,E1Z ,E2X ,E2Y ,E2Z ,E3X ,E3Y ,E3Z ,
40 . VOLU ,THICK)
41 USE message_mod
42 use element_mod , only : nixs
43C-----------------------------------------------
44C I m p l i c i t T y p e s
45C-----------------------------------------------
46#include "implicit_f.inc"
47C-----------------------------------------------
48C G l o b a l P a r a m e t e r s
49C-----------------------------------------------
50#include "mvsiz_p.inc"
51C-----------------------------------------------
52C C o m m o n B l o c k s
53C-----------------------------------------------
54#include "vect01_c.inc"
55C-----------------------------------------------
56C D u m m y A r g u m e n t s
57C-----------------------------------------------
58 INTEGER ,INTENT(IN) :: NEL
59 INTEGER IXS(NIXS,*)
60 INTEGER ,DIMENSION(MVSIZ) :: MXT,NGL,PID
61 INTEGER ,DIMENSION(MVSIZ) :: IX1,IX2,IX3,IX4,IX5,IX6,IX7,IX8
62 my_real :: X(3,*)
63 my_real ,DIMENSION(MVSIZ) :: GEO,
64 . X1, X2, X3, X4, X5, X6, X7, X8,
65 . y1, y2, y3, y4, y5, y6, y7, y8,
66 . z1, z2, z3, z4, z5, z6, z7, z8,
67 . e1x,e2x,e3x,e1y,e2y,e3y,e1z,e2z,e3z
68 my_real, DIMENSION(MVSIZ), INTENT(OUT) :: volu
69 my_real, DIMENSION(NEL) , INTENT(OUT) :: thick
70C-----------------------------------------------
71C L o c a l V a r i a b l e s
72C-----------------------------------------------
73 INTEGER :: I,IREP
74 my_real :: XL,YL,ZL,H1,H2,H3,H4
75 my_real ::
76 . p1x(mvsiz), p2x(mvsiz), p3x(mvsiz), p4x(mvsiz),
77 . p1y(mvsiz), p2y(mvsiz), p3y(mvsiz), p4y(mvsiz),
78 . p1z(mvsiz), p2z(mvsiz), p3z(mvsiz), p4z(mvsiz),
79 . rx(mvsiz),ry(mvsiz),rz(mvsiz),sx(mvsiz),sy(mvsiz),sz(mvsiz)
80C-----------------------------------------------
81C E x t e r n a l F u n c t i o n s
82C-----------------------------------------------
83 my_real
84 . checkvolume_8n
85C=======================================================================
86C connectivities and material number and pid
87C--------------------------------------------------
88 DO i=1,nel
89 mxt(i) =ixs(1,i)
90 ix1(i) =ixs(2,i)
91 ix2(i) =ixs(3,i)
92 ix3(i) =ixs(4,i)
93 ix4(i) =ixs(5,i)
94 ix5(i) =ixs(6,i)
95 ix6(i) =ixs(7,i)
96 ix7(i) =ixs(8,i)
97 ix8(i) =ixs(9,i)
98 pid(i) =ixs(nixs-1,i)
99 ngl(i) =ixs(nixs,i)
100 IF (checkvolume_8n(x ,ixs(1,i)) < zero) THEN
101C renumber connectivity
102 ix1(i)=ixs(6,i)
103 ix2(i)=ixs(7,i)
104 ix3(i)=ixs(8,i)
105 ix4(i)=ixs(9,i)
106 ix5(i)=ixs(2,i)
107 ix6(i)=ixs(3,i)
108 ix7(i)=ixs(4,i)
109 ix8(i)=ixs(5,i)
110 ixs(2,i)=ix1(i)
111 ixs(3,i)=ix2(i)
112 ixs(4,i)=ix3(i)
113 ixs(5,i)=ix4(i)
114 ixs(6,i)=ix5(i)
115 ixs(7,i)=ix6(i)
116 ixs(8,i)=ix7(i)
117 ixs(9,i)=ix8(i)
118 ENDIF
119 ENDDO
120C----------------------------
121C COORDONNEES
122C----------------------------
123 DO i=1,nel
124 x1(i)=x(1,ix1(i))
125 y1(i)=x(2,ix1(i))
126 z1(i)=x(3,ix1(i))
127 x2(i)=x(1,ix2(i))
128 y2(i)=x(2,ix2(i))
129 z2(i)=x(3,ix2(i))
130 x3(i)=x(1,ix3(i))
131 y3(i)=x(2,ix3(i))
132 z3(i)=x(3,ix3(i))
133 x4(i)=x(1,ix4(i))
134 y4(i)=x(2,ix4(i))
135 z4(i)=x(3,ix4(i))
136 x5(i)=x(1,ix5(i))
137 y5(i)=x(2,ix5(i))
138 z5(i)=x(3,ix5(i))
139 x6(i)=x(1,ix6(i))
140 y6(i)=x(2,ix6(i))
141 z6(i)=x(3,ix6(i))
142 x7(i)=x(1,ix7(i))
143 y7(i)=x(2,ix7(i))
144 z7(i)=x(3,ix7(i))
145 x8(i)=x(1,ix8(i))
146 y8(i)=x(2,ix8(i))
147 z8(i)=x(3,ix8(i))
148 ENDDO
149 DO i=1,nel
150 p1x(i)=(x1(i)+x5(i))*half
151 p1y(i)=(y1(i)+y5(i))*half
152 p1z(i)=(z1(i)+z5(i))*half
153 p2x(i)=(x2(i)+x6(i))*half
154 p2y(i)=(y2(i)+y6(i))*half
155 p2z(i)=(z2(i)+z6(i))*half
156 p3x(i)=(x3(i)+x7(i))*half
157 p3y(i)=(y3(i)+y7(i))*half
158 p3z(i)=(z3(i)+z7(i))*half
159 p4x(i)=(x4(i)+x8(i))*half
160 p4y(i)=(y4(i)+y8(i))*half
161 p4z(i)=(z4(i)+z8(i))*half
162 rx(i)=x2(i)-x1(i)
163 ry(i)=y2(i)-y1(i)
164 rz(i)=z2(i)-z1(i)
165 sx(i)=x3(i)-x1(i)
166 sy(i)=y3(i)-y1(i)
167 sz(i)=z3(i)-z1(i)
168 ENDDO
169C----------------------------
170C LOCAL SYSTEM
171C----------------------------
172 irep = 0
173 CALL clskew3(1,nel ,irep,
174 . rx, ry, rz,sx, sy, sz,
175 . e1x,e2x,e3x,e1y,e2y,e3y,e1z,e2z,e3z,volu)
176C-----------
177C convected frame
178C-----------
179 DO i=1,nel
180 xl=e1x(i)*x1(i)+e1y(i)*y1(i)+e1z(i)*z1(i)
181 yl=e2x(i)*x1(i)+e2y(i)*y1(i)+e2z(i)*z1(i)
182 zl=e3x(i)*x1(i)+e3y(i)*y1(i)+e3z(i)*z1(i)
183 x1(i)=xl
184 y1(i)=yl
185 z1(i)=zl
186 xl=e1x(i)*x2(i)+e1y(i)*y2(i)+e1z(i)*z2(i)
187 yl=e2x(i)*x2(i)+e2y(i)*y2(i)+e2z(i)*z2(i)
188 zl=e3x(i)*x2(i)+e3y(i)*y2(i)+e3z(i)*z2(i)
189 x2(i)=xl
190 y2(i)=yl
191 z2(i)=zl
192 xl=e1x(i)*x3(i)+e1y(i)*y3(i)+e1z(i)*z3(i)
193 yl=e2x(i)*x3(i)+e2y(i)*y3(i)+e2z(i)*z3(i)
194 zl=e3x(i)*x3(i)+e3y(i)*y3(i)+e3z(i)*z3(i)
195 x3(i)=xl
196 y3(i)=yl
197 z3(i)=zl
198 xl=e1x(i)*x4(i)+e1y(i)*y4(i)+e1z(i)*z4(i)
199 yl=e2x(i)*x4(i)+e2y(i)*y4(i)+e2z(i)*z4(i)
200 zl=e3x(i)*x4(i)+e3y(i)*y4(i)+e3z(i)*z4(i)
201 x4(i)=xl
202 y4(i)=yl
203 z4(i)=zl
204 xl=e1x(i)*x5(i)+e1y(i)*y5(i)+e1z(i)*z5(i)
205 yl=e2x(i)*x5(i)+e2y(i)*y5(i)+e2z(i)*z5(i)
206 zl=e3x(i)*x5(i)+e3y(i)*y5(i)+e3z(i)*z5(i)
207 x5(i)=xl
208 y5(i)=yl
209 z5(i)=zl
210 xl=e1x(i)*x6(i)+e1y(i)*y6(i)+e1z(i)*z6(i)
211 yl=e2x(i)*x6(i)+e2y(i)*y6(i)+e2z(i)*z6(i)
212 zl=e3x(i)*x6(i)+e3y(i)*y6(i)+e3z(i)*z6(i)
213 x6(i)=xl
214 y6(i)=yl
215 z6(i)=zl
216 xl=e1x(i)*x7(i)+e1y(i)*y7(i)+e1z(i)*z7(i)
217 yl=e2x(i)*x7(i)+e2y(i)*y7(i)+e2z(i)*z7(i)
218 zl=e3x(i)*x7(i)+e3y(i)*y7(i)+e3z(i)*z7(i)
219 x7(i)=xl
220 y7(i)=yl
221 z7(i)=zl
222 xl=e1x(i)*x8(i)+e1y(i)*y8(i)+e1z(i)*z8(i)
223 yl=e2x(i)*x8(i)+e2y(i)*y8(i)+e2z(i)*z8(i)
224 zl=e3x(i)*x8(i)+e3y(i)*y8(i)+e3z(i)*z8(i)
225 x8(i)=xl
226 y8(i)=yl
227 z8(i)=zl
228 h1 = sqrt((x5(i)-x1(i))**2 + (y5(i)-y1(i))**2 + (z5(i)-z1(i))**2)
229 h2 = sqrt((x6(i)-x2(i))**2 + (y6(i)-y2(i))**2 + (z6(i)-z2(i))**2)
230 h3 = sqrt((x7(i)-x3(i))**2 + (y7(i)-y3(i))**2 + (z7(i)-z3(i))**2)
231 h4 = sqrt((x8(i)-x4(i))**2 + (y8(i)-y4(i))**2 + (z8(i)-z4(i))**2)
232 thick(i) = (h1 + h2 + h3 + h4) * fourth
233 ENDDO
234C-----------
235 RETURN
236 END
checkvolume_8n
function checkvolume_8n(x, ixs)
Definition checksvolume.F:39
clskew3
subroutine clskew3(jft, jlt, irep, rx, ry, rz, sx, sy, sz, e1x, e2x, e3x, e1y, e2y, e3y, e1z, e2z, e3z, det)
Definition clskew.F:34
message_mod
Definition message_mod.F:1257
spcoor3
subroutine spcoor3(x, ixs, geo, nel, mxt, pid, 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, e1x, e1y, e1z, e2x, e2y, e2z, e3x, e3y, e3z, volu, thick)
Definition spcoor3.F:41