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
42C-----------------------------------------------
43C I m p l i c i t T y p e s
44C-----------------------------------------------
45#include "implicit_f.inc"
46C-----------------------------------------------
47C G l o b a l P a r a m e t e r s
48C-----------------------------------------------
49#include "mvsiz_p.inc"
50C-----------------------------------------------
51C C o m m o n B l o c k s
52C-----------------------------------------------
53#include "vect01_c.inc"
54C-----------------------------------------------
55C D u m m y A r g u m e n t s
56C-----------------------------------------------
57 INTEGER ,INTENT(IN) :: NEL
58 INTEGER IXS(NIXS,*),MXT(*),NGL(*),PID(*),
59 . IX1(*),IX2(*),IX3(*),IX4(*),IX5(*),IX6(*),IX7(*),IX8(*)
60C REAL
61 my_real
62 . X(3,*),GEO(*),VOLU(*),
63 . X1(*), X2(*), X3(*), X4(*), X5(*), X6(*), X7(*), X8(*),
64 . y1(*), y2(*), y3(*), y4(*), y5(*), y6(*), y7(*), y8(*),
65 . z1(*), z2(*), z3(*), z4(*), z5(*), z6(*), z7(*), z8(*),
66 . e1x(*),e2x(*),e3x(*),e1y(*),e2y(*),e3y(*),e1z(*),e2z(*),e3z(*)
67 my_real, DIMENSION(NEL), INTENT(OUT) :: thick
68C-----------------------------------------------
69C L o c a l V a r i a b l e s
70C-----------------------------------------------
71 INTEGER :: I,J,IREP
72 my_real :: XL,YL,ZL,SUM,H1,H2,H3,H4
73 my_real ::
74 . p1x(mvsiz), p2x(mvsiz), p3x(mvsiz), p4x(mvsiz),
75 . p1y(mvsiz), p2y(mvsiz), p3y(mvsiz), p4y(mvsiz),
76 . p1z(mvsiz), p2z(mvsiz), p3z(mvsiz), p4z(mvsiz),
77 . rx(mvsiz),ry(mvsiz),rz(mvsiz),sx(mvsiz),sy(mvsiz),sz(mvsiz)
78C-----------------------------------------------
79C E x t e r n a l F u n c t i o n s
80C-----------------------------------------------
81 my_real
82 . checkvolume_8n
83C=======================================================================
84C CONNECTIVITES ET NUMERO DE MATERIAU ET PID
85C--------------------------------------------------
86 DO i=lft,llt
87 mxt(i) =ixs(1,i)
88 ix1(i) =ixs(2,i)
89 ix2(i) =ixs(3,i)
90 ix3(i) =ixs(4,i)
91 ix4(i) =ixs(5,i)
92 ix5(i) =ixs(6,i)
93 ix6(i) =ixs(7,i)
94 ix7(i) =ixs(8,i)
95 ix8(i) =ixs(9,i)
96 pid(i) =ixs(nixs-1,i)
97 ngl(i) =ixs(nixs,i)
98 IF (checkvolume_8n(x ,ixs(1,i)) < zero) THEN
99C renumber connectivity
100 ix1(i)=ixs(6,i)
101 ix2(i)=ixs(7,i)
102 ix3(i)=ixs(8,i)
103 ix4(i)=ixs(9,i)
104 ix5(i)=ixs(2,i)
105 ix6(i)=ixs(3,i)
106 ix7(i)=ixs(4,i)
107 ix8(i)=ixs(5,i)
108 ixs(2,i)=ix1(i)
109 ixs(3,i)=ix2(i)
110 ixs(4,i)=ix3(i)
111 ixs(5,i)=ix4(i)
112 ixs(6,i)=ix5(i)
113 ixs(7,i)=ix6(i)
114 ixs(8,i)=ix7(i)
115 ixs(9,i)=ix8(i)
116 ENDIF
117 ENDDO
118C----------------------------
119C COORDONNEES
120C----------------------------
121 DO i=lft,llt
122 x1(i)=x(1,ix1(i))
123 y1(i)=x(2,ix1(i))
124 z1(i)=x(3,ix1(i))
125 x2(i)=x(1,ix2(i))
126 y2(i)=x(2,ix2(i))
127 z2(i)=x(3,ix2(i))
128 x3(i)=x(1,ix3(i))
129 y3(i)=x(2,ix3(i))
130 z3(i)=x(3,ix3(i))
131 x4(i)=x(1,ix4(i))
132 y4(i)=x(2,ix4(i))
133 z4(i)=x(3,ix4(i))
134 x5(i)=x(1,ix5(i))
135 y5(i)=x(2,ix5(i))
136 z5(i)=x(3,ix5(i))
137 x6(i)=x(1,ix6(i))
138 y6(i)=x(2,ix6(i))
139 z6(i)=x(3,ix6(i))
140 x7(i)=x(1,ix7(i))
141 y7(i)=x(2,ix7(i))
142 z7(i)=x(3,ix7(i))
143 x8(i)=x(1,ix8(i))
144 y8(i)=x(2,ix8(i))
145 z8(i)=x(3,ix8(i))
146 ENDDO
147 DO i=lft,llt
148 p1x(i)=(x1(i)+x5(i))*half
149 p1y(i)=(y1(i)+y5(i))*half
150 p1z(i)=(z1(i)+z5(i))*half
151 p2x(i)=(x2(i)+x6(i))*half
152 p2y(i)=(y2(i)+y6(i))*half
153 p2z(i)=(z2(i)+z6(i))*half
154 p3x(i)=(x3(i)+x7(i))*half
155 p3y(i)=(y3(i)+y7(i))*half
156 p3z(i)=(z3(i)+z7(i))*half
157 p4x(i)=(x4(i)+x8(i))*half
158 p4y(i)=(y4(i)+y8(i))*half
159 p4z(i)=(z4(i)+z8(i))*half
160 rx(i)=x2(i)-x1(i)
161 ry(i)=y2(i)-y1(i)
162 rz(i)=z2(i)-z1(i)
163 sx(i)=x3(i)-x1(i)
164 sy(i)=y3(i)-y1(i)
165 sz(i)=z3(i)-z1(i)
166 ENDDO
167C----------------------------
168C LOCAL SYSTEM
169C----------------------------
170 irep = 0
171 CALL clskew3(lft,llt ,irep,
172 . rx, ry, rz,sx, sy, sz,
173 . e1x,e2x,e3x,e1y,e2y,e3y,e1z,e2z,e3z,volu)
174C-----------
175C REPERE CONVECTE
176C-----------
177 DO i=lft,llt
178 xl=e1x(i)*x1(i)+e1y(i)*y1(i)+e1z(i)*z1(i)
179 yl=e2x(i)*x1(i)+e2y(i)*y1(i)+e2z(i)*z1(i)
180 zl=e3x(i)*x1(i)+e3y(i)*y1(i)+e3z(i)*z1(i)
181 x1(i)=xl
182 y1(i)=yl
183 z1(i)=zl
184 xl=e1x(i)*x2(i)+e1y(i)*y2(i)+e1z(i)*z2(i)
185 yl=e2x(i)*x2(i)+e2y(i)*y2(i)+e2z(i)*z2(i)
186 zl=e3x(i)*x2(i)+e3y(i)*y2(i)+e3z(i)*z2(i)
187 x2(i)=xl
188 y2(i)=yl
189 z2(i)=zl
190 xl=e1x(i)*x3(i)+e1y(i)*y3(i)+e1z(i)*z3(i)
191 yl=e2x(i)*x3(i)+e2y(i)*y3(i)+e2z(i)*z3(i)
192 zl=e3x(i)*x3(i)+e3y(i)*y3(i)+e3z(i)*z3(i)
193 x3(i)=xl
194 y3(i)=yl
195 z3(i)=zl
196 xl=e1x(i)*x4(i)+e1y(i)*y4(i)+e1z(i)*z4(i)
197 yl=e2x(i)*x4(i)+e2y(i)*y4(i)+e2z(i)*z4(i)
198 zl=e3x(i)*x4(i)+e3y(i)*y4(i)+e3z(i)*z4(i)
199 x4(i)=xl
200 y4(i)=yl
201 z4(i)=zl
202 xl=e1x(i)*x5(i)+e1y(i)*y5(i)+e1z(i)*z5(i)
203 yl=e2x(i)*x5(i)+e2y(i)*y5(i)+e2z(i)*z5(i)
204 zl=e3x(i)*x5(i)+e3y(i)*y5(i)+e3z(i)*z5(i)
205 x5(i)=xl
206 y5(i)=yl
207 z5(i)=zl
208 xl=e1x(i)*x6(i)+e1y(i)*y6(i)+e1z(i)*z6(i)
209 yl=e2x(i)*x6(i)+e2y(i)*y6(i)+e2z(i)*z6(i)
210 zl=e3x(i)*x6(i)+e3y(i)*y6(i)+e3z(i)*z6(i)
211 x6(i)=xl
212 y6(i)=yl
213 z6(i)=zl
214 xl=e1x(i)*x7(i)+e1y(i)*y7(i)+e1z(i)*z7(i)
215 yl=e2x(i)*x7(i)+e2y(i)*y7(i)+e2z(i)*z7(i)
216 zl=e3x(i)*x7(i)+e3y(i)*y7(i)+e3z(i)*z7(i)
217 x7(i)=xl
218 y7(i)=yl
219 z7(i)=zl
220 xl=e1x(i)*x8(i)+e1y(i)*y8(i)+e1z(i)*z8(i)
221 yl=e2x(i)*x8(i)+e2y(i)*y8(i)+e2z(i)*z8(i)
222 zl=e3x(i)*x8(i)+e3y(i)*y8(i)+e3z(i)*z8(i)
223 x8(i)=xl
224 y8(i)=yl
225 z8(i)=zl
226 h1 = sqrt((x5(i)-x1(i))**2 + (y5(i)-y1(i))**2 + (z5(i)-z1(i))**2)
227 h2 = sqrt((x6(i)-x2(i))**2 + (y6(i)-y2(i))**2 + (z6(i)-z2(i))**2)
228 h3 = sqrt((x7(i)-x3(i))**2 + (y7(i)-y3(i))**2 + (z7(i)-z3(i))**2)
229 h4 = sqrt((x8(i)-x4(i))**2 + (y8(i)-y4(i))**2 + (z8(i)-z4(i))**2)
230 thick(i) = (h1 + h2 + h3 + h4) * fourth
231 ENDDO
232C-----------
233 RETURN
234 END
checkvolume_8n
function checkvolume_8n(x, ixs)
Definition checksvolume.F:38
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:1249
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
starter
program starter
Definition starter.F:39
suinit3
subroutine suinit3(elbuf_str, ms, ixs, pm, x, detonators, geo, veul, ale_connectivity, iparg, dtelem, sigi, nel, skew, igeo, stifn, partsav, v, iparts, mss, ipart, sigsp, glob_therm, temp, nsigi, in, vr, ipm, nsigs, volnod, bvolnod, vns, bns, ptsol, bufmat, npf, tf, fail_ini, ins, iloadp, facload, rnoise, perturb, mat_param)
Definition suinit3.F:54