OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
mod_close.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!|| mod_close ../engine/source/elements/solid/solide/mod_close.F
25!||--- called by ------------------------------------------------------
26!|| sforc3 ../engine/source/elements/solid/solide/sforc3.F
27!|| szforc3 ../engine/source/elements/solid/solidez/szforc3.F
28!||====================================================================
29 SUBROUTINE mod_close(
30 1 GEO, NGEO, X1, X2,
31 2 X3, X4, X5, X6,
32 3 X7, X8, Y1, Y2,
33 4 Y3, Y4, Y5, Y6,
34 5 Y7, Y8, Z1, Z2,
35 6 Z3, Z4, Z5, Z6,
36 7 Z7, Z8, HH, XD1,
37 8 XD2, XD3, XD4, XD5,
38 9 XD6, XD7, XD8, YD1,
39 A YD2, YD3, YD4, YD5,
40 B YD6, YD7, YD8, ZD1,
41 C ZD2, ZD3, ZD4, ZD5,
42 D ZD6, ZD7, ZD8, NEL)
43C-----------------------------------------------
44C I m p l i c i t T y p e s
45C-----------------------------------------------
46#include "implicit_f.inc"
47C-----------------------------------------------
48C C o m m o n B l o c k s
49C-----------------------------------------------
50#include "mvsiz_p.inc"
51#include "param_c.inc"
52C-----------------------------------------------
53C D u m m y A r g u m e n t s
54C-----------------------------------------------
55 INTEGER, INTENT(IN) :: NEL
56 DOUBLE PRECISION
57 . XD1(*), XD2(*), XD3(*), XD4(*), XD5(*), XD6(*), XD7(*), XD8(*),
58 . YD1(*), YD2(*), YD3(*), YD4(*), YD5(*), YD6(*), YD7(*), YD8(*),
59 . ZD1(*), ZD2(*), ZD3(*), ZD4(*), ZD5(*), ZD6(*), ZD7(*), ZD8(*)
60
61 my_real
62 . X1(*), X2(*), X3(*), X4(*), X5(*), X6(*), X7(*), X8(*),
63 . Y1(*), Y2(*), Y3(*), Y4(*), Y5(*), Y6(*), Y7(*), Y8(*),
64 . Z1(*), Z2(*), Z3(*), Z4(*), Z5(*), Z6(*), Z7(*), Z8(*),
65 . GEO(NPROPG,*),HH(*)
66
67 INTEGER NGEO(*)
68C-----------------------------------------------
69C L o c a l V a r i a b l e s
70C-----------------------------------------------
71 INTEGER I,J,J1,J2,K,IX1,IX2,IX3,IX4,IX5,IX6,IX7,IX8,KMAX
72 my_real
73 . X13,Y13,Z13,X24,Y24,Z24,SX(3),SY(3),SZ(3),SN(3),DH,DHX,DHY,DHZ,
74 . h,snmax,htest(mvsiz),hclos(mvsiz),x(3,8)
75 INTEGER ICF1(4,3),ICF2(4,3)
76 DATA ICF1/1,2,3,4, 2,6,7,3, 1,5,6,2/
77 DATA ICF2/5,6,7,8, 1,5,8,4, 4,8,7,3/
78C
79 DO I=1,nel
80 hclos(i)=geo(129,ngeo(i))
81 htest(i)=geo(130,ngeo(i))
82 ENDDO
83C
84 DO i=1,nel
85 x(1,1)=xd1(i)
86 x(2,1)=yd1(i)
87 x(3,1)=zd1(i)
88 x(1,2)=xd2(i)
89 x(2,2)=yd2(i)
90 x(3,2)=zd2(i)
91 x(1,3)=xd3(i)
92 x(2,3)=yd3(i)
93 x(3,3)=zd3(i)
94 x(1,4)=xd4(i)
95 x(2,4)=yd4(i)
96 x(3,4)=zd4(i)
97 x(1,5)=xd5(i)
98 x(2,5)=yd5(i)
99 x(3,5)=zd5(i)
100 x(1,6)=xd6(i)
101 x(2,6)=yd6(i)
102 x(3,6)=zd6(i)
103 x(1,7)=xd7(i)
104 x(2,7)=yd7(i)
105 x(3,7)=zd7(i)
106 x(1,8)=xd8(i)
107 x(2,8)=yd8(i)
108 x(3,8)=zd8(i)
109C
110 DO k=1,3
111 ix1=icf1(1,k)
112 ix2=icf1(2,k)
113 ix3=icf1(3,k)
114 ix4=icf1(4,k)
115 ix5=icf2(1,k)
116 ix6=icf2(2,k)
117 ix7=icf2(3,k)
118 ix8=icf2(4,k)
119 x13=x(1,ix3)-x(1,ix1)+x(1,ix7)-x(1,ix5)
120 y13=x(2,ix3)-x(2,ix1)+x(2,ix7)-x(2,ix5)
121 z13=x(3,ix3)-x(3,ix1)+x(3,ix7)-x(3,ix5)
122 x24=x(1,ix4)-x(1,ix2)+x(1,ix8)-x(1,ix6)
123 y24=x(2,ix4)-x(2,ix2)+x(2,ix8)-x(2,ix6)
124 z24=x(3,ix4)-x(3,ix2)+x(3,ix8)-x(3,ix6)
125 sx(k)=y13*z24-z13*y24
126 sy(k)=z13*x24-x13*z24
127 sz(k)=x13*y24-y13*x24
128 sn(k)=sqrt(sx(k)**2+sy(k)**2+sz(k)**2)
129 ENDDO
130 snmax=0
131 kmax = 1
132 DO k=1,3
133 IF(sn(k)>snmax)THEN
134 kmax=k
135 snmax=sn(k)
136 sx(k)=sx(k)/sn(k)
137 sy(k)=sy(k)/sn(k)
138 sz(k)=sz(k)/sn(k)
139 ENDIF
140 ENDDO
141C
142 h=1.e30
143 DO j=1,4
144 j2=icf2(j,kmax)
145 j1=icf1(j,kmax)
146 h=min(h,
147 . (x(1,j2)-x(1,j1))*sx(kmax)+
148 . (x(2,j2)-x(2,j1))*sy(kmax)+
149 . (x(3,j2)-x(3,j1))*sz(kmax) )
150 ENDDO
151C
152 hh(i)=zero
153C
154 IF(h<htest(i))THEN
155 ix1=icf1(1,kmax)
156 ix2=icf1(2,kmax)
157 ix3=icf1(3,kmax)
158 ix4=icf1(4,kmax)
159 ix5=icf2(1,kmax)
160 ix6=icf2(2,kmax)
161 ix7=icf2(3,kmax)
162 ix8=icf2(4,kmax)
163 dh=half*(htest(i)-h)
164 dhx=dh*sx(kmax)
165 dhy=dh*sy(kmax)
166 dhz=dh*sz(kmax)
167 x(1,ix1)=x(1,ix1)-dhx
168 x(2,ix1)=x(2,ix1)-dhy
169 x(3,ix1)=x(3,ix1)-dhz
170 x(1,ix2)=x(1,ix2)-dhx
171 x(2,ix2)=x(2,ix2)-dhy
172 x(3,ix2)=x(3,ix2)-dhz
173 x(1,ix3)=x(1,ix3)-dhx
174 x(2,ix3)=x(2,ix3)-dhy
175 x(3,ix3)=x(3,ix3)-dhz
176 x(1,ix4)=x(1,ix4)-dhx
177 x(2,ix4)=x(2,ix4)-dhy
178 x(3,ix4)=x(3,ix4)-dhz
179 x(1,ix5)=x(1,ix5)+dhx
180 x(2,ix5)=x(2,ix5)+dhy
181 x(3,ix5)=x(3,ix5)+dhz
182 x(1,ix6)=x(1,ix6)+dhx
183 x(2,ix6)=x(2,ix6)+dhy
184 x(3,ix6)=x(3,ix6)+dhz
185 x(1,ix7)=x(1,ix7)+dhx
186 x(2,ix7)=x(2,ix7)+dhy
187 x(3,ix7)=x(3,ix7)+dhz
188 x(1,ix8)=x(1,ix8)+dhx
189 x(2,ix8)=x(2,ix8)+dhy
190 x(3,ix8)=x(3,ix8)+dhz
191 xd1(i)=x(1,1)
192 yd1(i)=x(2,1)
193 zd1(i)=x(3,1)
194 xd2(i)=x(1,2)
195 yd2(i)=x(2,2)
196 zd2(i)=x(3,2)
197 xd3(i)=x(1,3)
198 yd3(i)=x(2,3)
199 zd3(i)=x(3,3)
200 xd4(i)=x(1,4)
201 yd4(i)=x(2,4)
202 zd4(i)=x(3,4)
203 xd5(i)=x(1,5)
204 yd5(i)=x(2,5)
205 zd5(i)=x(3,5)
206 xd6(i)=x(1,6)
207 yd6(i)=x(2,6)
208 zd6(i)=x(3,6)
209 xd7(i)=x(1,7)
210 yd7(i)=x(2,7)
211 zd7(i)=x(3,7)
212 xd8(i)=x(1,8)
213 yd8(i)=x(2,8)
214 zd8(i)=x(3,8)
215 hh(i)=max(one-h/hclos(i),zero)
216 hh(i)=min(one,hh(i))
217 ENDIF
218 ENDDO
219
220c copy and cast XD(DP) to X(SP) to assure coherence between XD et X
221 DO i=1,nel
222 x1(i)= xd1(i)
223 y1(i)= yd1(i)
224 z1(i)= zd1(i)
225 x2(i)= xd2(i)
226 y2(i)= yd2(i)
227 z2(i)= zd2(i)
228 x3(i)= xd3(i)
229 y3(i)= yd3(i)
230 z3(i)= zd3(i)
231 x4(i)= xd4(i)
232 y4(i)= yd4(i)
233 z4(i)= zd4(i)
234 x5(i)= xd5(i)
235 y5(i)= yd5(i)
236 z5(i)= zd5(i)
237 x6(i)= xd6(i)
238 y6(i)= yd6(i)
239 z6(i)= zd6(i)
240 x7(i)= xd7(i)
241 y7(i)= yd7(i)
242 z7(i)= zd7(i)
243 x8(i)= xd8(i)
244 y8(i)= yd8(i)
245 z8(i)= zd8(i)
246 ENDDO
247
248 RETURN
249 END
250
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, hh, xd1, xd2, xd3, xd4, xd5, xd6, xd7, xd8, yd1, yd2, yd3, yd4, yd5, yd6, yd7, yd8, zd1, zd2, zd3, zd4, zd5, zd6, zd7, zd8, nel)
Definition mod_close.F:43
min
#define min(a, b)
Definition macros.h:20
max
#define max(a, b)
Definition macros.h:21