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 ../starter/source/elements/solid/solide/mod_close.F
25!||--- called by ------------------------------------------------------
26!|| sccoor3 ../starter/source/elements/thickshell/solidec/sccoor3.F
27!|| scoor3 ../starter/source/elements/solid/solide/scoor3.F
28!|| srcoor3 ../starter/source/elements/solid/solide/srcoor3.F
29!||====================================================================
30 SUBROUTINE mod_close(GEO,NGEO,
31 . X1, X2, X3, X4, X5, X6, X7, X8,
32 . Y1, Y2, Y3, Y4, Y5, Y6, Y7, Y8,
33 . Z1, Z2, Z3, Z4, Z5, Z6, Z7, Z8)
34C-----------------------------------------------
35C I m p l i c i t T y p e s
36C-----------------------------------------------
37#include "implicit_f.inc"
38C-----------------------------------------------
39C C o m m o n B l o c k s
40C-----------------------------------------------
41#include "mvsiz_p.inc"
42#include "param_c.inc"
43#include "vect01_c.inc"
44C-----------------------------------------------
45C D u m m y A r g u m e n t s
46C-----------------------------------------------
47C REAL
48 my_real
49 . x1(*), x2(*), x3(*), x4(*), x5(*), x6(*), x7(*), x8(*),
50 . y1(*), y2(*), y3(*), y4(*), y5(*), y6(*), y7(*), y8(*),
51 . z1(*), z2(*), z3(*), z4(*), z5(*), z6(*), z7(*), z8(*),
52 . geo(npropg,*)
53 INTEGER NGEO(*)
54C-----------------------------------------------
55C L o c a l V a r i a b l e s
56C-----------------------------------------------
57 INTEGER I,J,J1,J2,K,IX1,IX2,IX3,IX4,IX5,IX6,IX7,IX8,KMAX
58C REAL
59 my_real
60 . x13,y13,z13,x24,y24,z24,sx(3),sy(3),sz(3),sn(3),dh,dhx,dhy,dhz,
61 . xc1,yc1,zc1,xc2,yc2,zc2,x(3,8),h,snmax,htest(mvsiz)
62 INTEGER ICF1(4,3),ICF2(4,3)
63 DATA ICF1/1,2,3,4, 2,6,7,3, 1,5,6,2/
64 DATA ICF2/5,6,7,8, 1,5,8,4, 4,8,7,3/
65C
66 DO i=lft,llt
67 htest(i)=geo(130,ngeo(i))
68 ENDDO
69C
70 DO i=lft,llt
71 x(1,1)=x1(i)
72 x(2,1)=y1(i)
73 x(3,1)=z1(i)
74 x(1,2)=x2(i)
75 x(2,2)=y2(i)
76 x(3,2)=z2(i)
77 x(1,3)=x3(i)
78 x(2,3)=y3(i)
79 x(3,3)=z3(i)
80 x(1,4)=x4(i)
81 x(2,4)=y4(i)
82 x(3,4)=z4(i)
83 x(1,5)=x5(i)
84 x(2,5)=y5(i)
85 x(3,5)=z5(i)
86 x(1,6)=x6(i)
87 x(2,6)=y6(i)
88 x(3,6)=z6(i)
89 x(1,7)=x7(i)
90 x(2,7)=y7(i)
91 x(3,7)=z7(i)
92 x(1,8)=x8(i)
93 x(2,8)=y8(i)
94 x(3,8)=z8(i)
95C
96 DO k=1,3
97 ix1=icf1(1,k)
98 ix2=icf1(2,k)
99 ix3=icf1(3,k)
100 ix4=icf1(4,k)
101 ix5=icf2(1,k)
102 ix6=icf2(2,k)
103 ix7=icf2(3,k)
104 ix8=icf2(4,k)
105 x13=x(1,ix3)-x(1,ix1)+x(1,ix7)-x(1,ix5)
106 y13=x(2,ix3)-x(2,ix1)+x(2,ix7)-x(2,ix5)
107 z13=x(3,ix3)-x(3,ix1)+x(3,ix7)-x(3,ix5)
108 x24=x(1,ix4)-x(1,ix2)+x(1,ix8)-x(1,ix6)
109 y24=x(2,ix4)-x(2,ix2)+x(2,ix8)-x(2,ix6)
110 z24=x(3,ix4)-x(3,ix2)+x(3,ix8)-x(3,ix6)
111 sx(k)=y13*z24-z13*y24
112 sy(k)=z13*x24-x13*z24
113 sz(k)=x13*y24-y13*x24
114 sn(k)=sqrt(sx(k)**2+sy(k)**2+sz(k)**2)
115C SX(K)=SX(K)/SN(K)
116C SY(K)=SY(K)/SN(K)
117C SZ(K)=SZ(K)/SN(K)
118 ENDDO
119 snmax=0
120 kmax = 1
121 DO k=1,3
122 IF(sn(k)>snmax)THEN
123 kmax=k
124 snmax=sn(k)
125 sx(k)=sx(k)/sn(k)
126 sy(k)=sy(k)/sn(k)
127 sz(k)=sz(k)/sn(k)
128 ENDIF
129 ENDDO
130C
131 h=1.e30
132 DO j=1,4
133 j2=icf2(j,kmax)
134 j1=icf1(j,kmax)
135 h=min(h,
136 . (x(1,j2)-x(1,j1))*sx(kmax)+
137 . (x(2,j2)-x(2,j1))*sy(kmax)+
138 . (x(3,j2)-x(3,j1))*sz(kmax) )
139 ENDDO
140C
141 IF(h<htest(i))THEN
142 ix1=icf1(1,kmax)
143 ix2=icf1(2,kmax)
144 ix3=icf1(3,kmax)
145 ix4=icf1(4,kmax)
146 ix5=icf2(1,kmax)
147 ix6=icf2(2,kmax)
148 ix7=icf2(3,kmax)
149 ix8=icf2(4,kmax)
150 dh= half*(htest(i)-h)
151 dhx=dh*sx(kmax)
152 dhy=dh*sy(kmax)
153 dhz=dh*sz(kmax)
154 x(1,ix1)=x(1,ix1)-dhx
155 x(2,ix1)=x(2,ix1)-dhy
156 x(3,ix1)=x(3,ix1)-dhz
157 x(1,ix2)=x(1,ix2)-dhx
158 x(2,ix2)=x(2,ix2)-dhy
159 x(3,ix2)=x(3,ix2)-dhz
160 x(1,ix3)=x(1,ix3)-dhx
161 x(2,ix3)=x(2,ix3)-dhy
162 x(3,ix3)=x(3,ix3)-dhz
163 x(1,ix4)=x(1,ix4)-dhx
164 x(2,ix4)=x(2,ix4)-dhy
165 x(3,ix4)=x(3,ix4)-dhz
166 x(1,ix5)=x(1,ix5)+dhx
167 x(2,ix5)=x(2,ix5)+dhy
168 x(3,ix5)=x(3,ix5)+dhz
169 x(1,ix6)=x(1,ix6)+dhx
170 x(2,ix6)=x(2,ix6)+dhy
171 x(3,ix6)=x(3,ix6)+dhz
172 x(1,ix7)=x(1,ix7)+dhx
173 x(2,ix7)=x(2,ix7)+dhy
174 x(3,ix7)=x(3,ix7)+dhz
175 x(1,ix8)=x(1,ix8)+dhx
176 x(2,ix8)=x(2,ix8)+dhy
177 x(3,ix8)=x(3,ix8)+dhz
178 x1(i)=x(1,1)
179 y1(i)=x(2,1)
180 z1(i)=x(3,1)
181 x2(i)=x(1,2)
182 y2(i)=x(2,2)
183 z2(i)=x(3,2)
184 x3(i)=x(1,3)
185 y3(i)=x(2,3)
186 z3(i)=x(3,3)
187 x4(i)=x(1,4)
188 y4(i)=x(2,4)
189 z4(i)=x(3,4)
190 x5(i)=x(1,5)
191 y5(i)=x(2,5)
192 z5(i)=x(3,5)
193 x6(i)=x(1,6)
194 y6(i)=x(2,6)
195 z6(i)=x(3,6)
196 x7(i)=x(1,7)
197 y7(i)=x(2,7)
198 z7(i)=x(3,7)
199 x8(i)=x(1,8)
200 y8(i)=x(2,8)
201 z8(i)=x(3,8)
202 ENDIF
203 ENDDO
204 RETURN
205 END
206
my_real
#define my_real
Definition cppsort.cpp:32
min
#define min(a, b)
Definition macros.h:20
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)
Definition mod_close.F:34