OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
i5for3.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!|| i5for3 ../engine/source/interfaces/inter3d/i5for3.F
25!||--- called by ------------------------------------------------------
26!|| intvo3 ../engine/source/interfaces/inter3d/intvo3.F
27!||--- calls -----------------------------------------------------
28!|| ibcoff ../engine/source/interfaces/interf/ibcoff.F
29!||--- uses -----------------------------------------------------
30!|| anim_mod ../common_source/modules/output/anim_mod.F
31!|| h3d_mod ../engine/share/modules/h3d_mod.F
32!||====================================================================
33 SUBROUTINE i5for3(LFT ,LLT ,NFT ,
34 2 E ,MSR ,NSV ,IRTL ,STF ,
35 3 STFN ,IBC ,ICODT ,FSAV ,IGIMP ,
36 4 FSKYI ,ISKY ,FCONT ,FNCONT,ICONTACT,
37 5 IBAG ,IADM ,H3D_DATA,
38 6 IX1 ,IX2 ,IX3 ,IX4 ,N1 ,
39 7 N2 ,N3 ,XFACE ,H1 ,H2 ,
40 8 H3 ,H4 ,THK ,ANS ,STIF ,
41 9 FNI )
42
43C-----------------------------------------------
44C M o d u l e s
45C-----------------------------------------------
46 USE h3d_mod
47 USE anim_mod
48C-----------------------------------------------
49C I m p l i c i t T y p e s
50C-----------------------------------------------
51#include "implicit_f.inc"
52#include "comlock.inc"
53C-----------------------------------------------
54C G l o b a l P a r a m e t e r s
55C-----------------------------------------------
56#include "mvsiz_p.inc"
57C-----------------------------------------------
58C C o m m o n B l o c k s
59C-----------------------------------------------
60#include "scr07_c.inc"
61#include "scr14_c.inc"
62#include "scr16_c.inc"
63#include "com06_c.inc"
64#include "com08_c.inc"
65#include "parit_c.inc"
66#include "impl1_c.inc"
67C-----------------------------------------------
68C D u m m y A r g u m e n t s
69C-----------------------------------------------
70 INTEGER IBC, IGIMP,LFT, LLT, NFT, IBAG, IADM
71 INTEGER MSR(*), NSV(*), IRTL(*), ICODT(*), ISKY(*),
72 . ICONTACT(*)
73 my_real
74 . E(*), STF(*), STFN(*), FSAV(*),FSKYI(LSKYI,4),FCONT(3,*),
75 . FNCONT(3,*)
76 TYPE(H3D_DATABASE) :: H3D_DATA
77 INTEGER, DIMENSION(MVSIZ), INTENT(IN) :: IX1,IX2,IX3,IX4
78 my_real, DIMENSION(MVSIZ), INTENT(IN) :: n1,n2,n3
79 my_real, DIMENSION(MVSIZ), INTENT(IN) :: h1,h2,h3,h4,thk
80 my_real, DIMENSION(MVSIZ), INTENT(INOUT) :: ans,stif,fni,xface
81C-----------------------------------------------
82C L o c a l V a r i a b l e s
83C-----------------------------------------------
84 INTEGER I, IL, L, J3, J2, J1, IG,
85 . i3, i2, i1
86 INTEGER NISKYL
87 my_real
88 . fxi(mvsiz), fyi(mvsiz), fzi(mvsiz), fx1(mvsiz), fx2(mvsiz), fx3(mvsiz), fx4(mvsiz),
89 . fy1(mvsiz), fy2(mvsiz), fy3(mvsiz), fy4(mvsiz), fz1(mvsiz), fz2(mvsiz), fz3(mvsiz), fz4(mvsiz)
90C-----------------------------------------------
91C
92 DO 100 i=lft,llt
93 ans(i)= min(zero,(ans(i)*xface(i)-thk(i)))
94C
95C A=CVMGN(B,C,D) => IF D=0 THEN A=C ELSE A=B
96C
97C XFACE(I)=CVMGN(XFACE(I),ZERO,ANS(I))
98 IF(ans(i)==zero)xface(i)=zero
99 ans(i)=xface(i)*ans(i)
100 100 CONTINUE
101C
102 igimp=0
103 DO 110 i=lft,llt
104 igimp=igimp+abs(xface(i))
105 110 CONTINUE
106 IF(igimp==0)RETURN
107C
108 DO 140 i=lft,llt
109 il=i+nft
110 l=irtl(il)
111 stif(i)=half*stf(l)
112 140 CONTINUE
113C
114 DO 150 i=lft,llt
115 fni(i)=ans(i)*stif(i)
116 fxi(i)=n1(i)*fni(i)
117 fyi(i)=n2(i)*fni(i)
118 fzi(i)=n3(i)*fni(i)
119 150 CONTINUE
120C---------------------------------
121C SAUVEGARDE DE L'IMPULSION TOTALE
122C---------------------------------
123 DO 155 i=lft,llt
124 fsav(1)=fsav(1)+fxi(i)*dt12
125 fsav(2)=fsav(2)+fyi(i)*dt12
126 fsav(3)=fsav(3)+fzi(i)*dt12
127 155 CONTINUE
128C
129 DO 160 i=lft,llt
130 fx1(i)=fxi(i)*h1(i)
131 fy1(i)=fyi(i)*h1(i)
132 fz1(i)=fzi(i)*h1(i)
133C
134 fx2(i)=fxi(i)*h2(i)
135 fy2(i)=fyi(i)*h2(i)
136 fz2(i)=fzi(i)*h2(i)
137C
138 fx3(i)=fxi(i)*h3(i)
139 fy3(i)=fyi(i)*h3(i)
140 fz3(i)=fzi(i)*h3(i)
141C
142 fx4(i)=fxi(i)*h4(i)
143 fy4(i)=fyi(i)*h4(i)
144 fz4(i)=fzi(i)*h4(i)
145C
146 160 CONTINUE
147C
148 IF(iparit==0)THEN
149 DO 180 i=lft,llt
150 j3=3*ix1(i)
151 j2=j3-1
152 j1=j2-1
153 e(j1)=e(j1)+fx1(i)
154 e(j2)=e(j2)+fy1(i)
155 e(j3)=e(j3)+fz1(i)
156C
157 j3=3*ix2(i)
158 j2=j3-1
159 j1=j2-1
160 e(j1)=e(j1)+fx2(i)
161 e(j2)=e(j2)+fy2(i)
162 e(j3)=e(j3)+fz2(i)
163C
164 j3=3*ix3(i)
165 j2=j3-1
166 j1=j2-1
167 e(j1)=e(j1)+fx3(i)
168 e(j2)=e(j2)+fy3(i)
169 e(j3)=e(j3)+fz3(i)
170C
171 j3=3*ix4(i)
172 j2=j3-1
173 j1=j2-1
174 e(j1)=e(j1)+fx4(i)
175 e(j2)=e(j2)+fy4(i)
176 e(j3)=e(j3)+fz4(i)
177C
178 il=i+nft
179 ig=nsv(il)
180 i3=3*ig
181 i2=i3-1
182 i1=i2-1
183 e(i1)=e(i1)-fxi(i)
184 e(i2)=e(i2)-fyi(i)
185 e(i3)=e(i3)-fzi(i)
186 180 CONTINUE
187C
188 ELSE
189C
190#include "lockon.inc"
191 niskyl = nisky
192 nisky = nisky + 5 * llt
193#include "lockoff.inc"
194C
195 DO 190 i=lft,llt
196 niskyl = niskyl + 1
197 fskyi(niskyl,1)=fx1(i)
198 fskyi(niskyl,2)=fy1(i)
199 fskyi(niskyl,3)=fz1(i)
200 fskyi(niskyl,4)=zero
201 isky(niskyl) = ix1(i)
202 niskyl = niskyl + 1
203 fskyi(niskyl,1)=fx2(i)
204 fskyi(niskyl,2)=fy2(i)
205 fskyi(niskyl,3)=fz2(i)
206 fskyi(niskyl,4)=zero
207 isky(niskyl) = ix2(i)
208 niskyl = niskyl + 1
209 fskyi(niskyl,1)=fx3(i)
210 fskyi(niskyl,2)=fy3(i)
211 fskyi(niskyl,3)=fz3(i)
212 fskyi(niskyl,4)=zero
213 isky(niskyl) = ix3(i)
214 niskyl = niskyl + 1
215 fskyi(niskyl,1)=fx4(i)
216 fskyi(niskyl,2)=fy4(i)
217 fskyi(niskyl,3)=fz4(i)
218 fskyi(niskyl,4)=zero
219 isky(niskyl) = ix4(i)
220 niskyl = niskyl + 1
221 fskyi(niskyl,1)=-fxi(i)
222 fskyi(niskyl,2)=-fyi(i)
223 fskyi(niskyl,3)=-fzi(i)
224 fskyi(niskyl,4)=zero
225 il=i+nft
226 isky(niskyl) = nsv(il)
227 190 CONTINUE
228 ENDIF
229C
230 IF(inconv/=1) RETURN
231 IF(ibag/=0.OR.iadm/=0)THEN
232#include "lockon.inc"
233 DO i=lft,llt
234 il=i+nft
235 icontact(nsv(il))=1
236 icontact(ix1(i))=1
237 icontact(ix2(i))=1
238 icontact(ix3(i))=1
239 icontact(ix4(i))=1
240 ENDDO
241#include "lockoff.inc"
242 ENDIF
243C
244 IF(anim_v(4)+outp_v(4)>0.AND.
245 . ((tt>=tanim .AND. tt<=tanim_stop).OR.tt>=toutp.OR.
246 . (manim>=4.AND.manim<=15)))THEN
247#include "lockon.inc"
248 DO i=1,llt
249 fcont(1,ix1(i)) =fcont(1,ix1(i)) + fx1(i)
250 fcont(2,ix1(i)) =fcont(2,ix1(i)) + fy1(i)
251 fcont(3,ix1(i)) =fcont(3,ix1(i)) + fz1(i)
252 fcont(1,ix2(i)) =fcont(1,ix2(i)) + fx2(i)
253 fcont(2,ix2(i)) =fcont(2,ix2(i)) + fy2(i)
254 fcont(3,ix2(i)) =fcont(3,ix2(i)) + fz2(i)
255 fcont(1,ix3(i)) =fcont(1,ix3(i)) + fx3(i)
256 fcont(2,ix3(i)) =fcont(2,ix3(i)) + fy3(i)
257 fcont(3,ix3(i)) =fcont(3,ix3(i)) + fz3(i)
258 fcont(1,ix4(i)) =fcont(1,ix4(i)) + fx4(i)
259 fcont(2,ix4(i)) =fcont(2,ix4(i)) + fy4(i)
260 fcont(3,ix4(i)) =fcont(3,ix4(i)) + fz4(i)
261 fcont(1,nsv(i+nft))=fcont(1,nsv(i+nft))- fxi(i)
262 fcont(2,nsv(i+nft))=fcont(2,nsv(i+nft))- fyi(i)
263 fcont(3,nsv(i+nft))=fcont(3,nsv(i+nft))- fzi(i)
264 ENDDO
265#include "lockoff.inc"
266 ENDIF
267C
268 IF(anim_v(12)+outp_v(12)+h3d_data%N_VECT_PCONT>0.AND.
269 . ((tt>=tanim .AND. tt<=tanim_stop).OR.tt>=toutp.OR.(tt>=h3d_data%TH3D.AND.tt<=h3d_data%TH3D_STOP).OR.
270 . (manim>=4.AND.manim<=15).OR.h3d_data%MH3D/=0))THEN
271#include "lockon.inc"
272 DO i=1,llt
273 fncont(1,ix1(i)) =fncont(1,ix1(i)) + fx1(i)
274 fncont(2,ix1(i)) =fncont(2,ix1(i)) + fy1(i)
275 fncont(3,ix1(i)) =fncont(3,ix1(i)) + fz1(i)
276 fncont(1,ix2(i)) =fncont(1,ix2(i)) + fx2(i)
277 fncont(2,ix2(i)) =fncont(2,ix2(i)) + fy2(i)
278 fncont(3,ix2(i)) =fncont(3,ix2(i)) + fz2(i)
279 fncont(1,ix3(i)) =fncont(1,ix3(i)) + fx3(i)
280 fncont(2,ix3(i)) =fncont(2,ix3(i)) + fy3(i)
281 fncont(3,ix3(i)) =fncont(3,ix3(i)) + fz3(i)
282 fncont(1,ix4(i)) =fncont(1,ix4(i)) + fx4(i)
283 fncont(2,ix4(i)) =fncont(2,ix4(i)) + fy4(i)
284 fncont(3,ix4(i)) =fncont(3,ix4(i)) + fz4(i)
285 fncont(1,nsv(i+nft))=fncont(1,nsv(i+nft))- fxi(i)
286 fncont(2,nsv(i+nft))=fncont(2,nsv(i+nft))- fyi(i)
287 fncont(3,nsv(i+nft))=fncont(3,nsv(i+nft))- fzi(i)
288 ENDDO
289#include "lockoff.inc"
290 ENDIF
291C
292 IF(ibc==0) RETURN
293 DO 200 i=lft,llt
294 IF(ibc==0.OR.xface(i)==zero)GOTO 200
295 il=i+nft
296 ig=nsv(il)
297 CALL ibcoff(ibc,icodt(ig))
298 200 CONTINUE
299C
300 RETURN
301 END
subroutine i5for3(lft, llt, nft, e, msr, nsv, irtl, stf, stfn, ibc, icodt, fsav, igimp, fskyi, isky, fcont, fncont, icontact, ibag, iadm, h3d_data, ix1, ix2, ix3, ix4, n1, n2, n3, xface, h1, h2, h3, h4, thk, ans, stif, fni)
Definition i5for3.F:42
subroutine ibcoff(ibc, icodt)
Definition ibcoff.F:44
#define min(a, b)
Definition macros.h:20