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!|| h3d_mod ../engine/share/modules/h3d_mod.F
31!|| output_mod ../common_source/modules/output/output_mod.F90
32!||====================================================================
33 SUBROUTINE i5for3(OUTPUT,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 output_mod, ONLY: output_
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 TYPE(output_), INTENT(inout) :: OUTPUT
71 INTEGER IBC, IGIMP,LFT, LLT, NFT, IBAG, IADM
72 INTEGER MSR(*), NSV(*), IRTL(*), ICODT(*), ISKY(*),
73 . ICONTACT(*)
74 my_real
75 . E(*), STF(*), STFN(*), FSAV(*),FSKYI(LSKYI,4),FCONT(3,*),
76 . FNCONT(3,*)
77 TYPE(H3D_DATABASE) :: H3D_DATA
78 INTEGER, DIMENSION(MVSIZ), INTENT(IN) :: IX1,IX2,IX3,IX4
79 my_real, DIMENSION(MVSIZ), INTENT(IN) :: n1,n2,n3
80 my_real, DIMENSION(MVSIZ), INTENT(IN) :: h1,h2,h3,h4,thk
81 my_real, DIMENSION(MVSIZ), INTENT(INOUT) :: ans,stif,fni,xface
82C-----------------------------------------------
83C L o c a l V a r i a b l e s
84C-----------------------------------------------
85 INTEGER I, IL, L, J3, J2, J1, IG,
86 . i3, i2, i1
87 INTEGER NISKYL
88 my_real
89 . fxi(mvsiz), fyi(mvsiz), fzi(mvsiz), fx1(mvsiz), fx2(mvsiz), fx3(mvsiz), fx4(mvsiz),
90 . fy1(mvsiz), fy2(mvsiz), fy3(mvsiz), fy4(mvsiz), fz1(mvsiz), fz2(mvsiz), fz3(mvsiz), fz4(mvsiz)
91C-----------------------------------------------
92C
93 DO 100 i=lft,llt
94 ans(i)= min(zero,(ans(i)*xface(i)-thk(i)))
95C
96C A=CVMGN(B,C,D) => IF D=0 THEN A=C ELSE A=B
97C
98C XFACE(I)=CVMGN(XFACE(I),ZERO,ANS(I))
99 IF(ans(i)==zero)xface(i)=zero
100 ans(i)=xface(i)*ans(i)
101 100 CONTINUE
102C
103 igimp=0
104 DO 110 i=lft,llt
105 igimp=igimp+abs(xface(i))
106 110 CONTINUE
107 IF(igimp==0)RETURN
108C
109 DO 140 i=lft,llt
110 il=i+nft
111 l=irtl(il)
112 stif(i)=half*stf(l)
113 140 CONTINUE
114C
115 DO 150 i=lft,llt
116 fni(i)=ans(i)*stif(i)
117 fxi(i)=n1(i)*fni(i)
118 fyi(i)=n2(i)*fni(i)
119 fzi(i)=n3(i)*fni(i)
120 150 CONTINUE
121C---------------------------------
122C SAUVEGARDE DE L'IMPULSION TOTALE
123C---------------------------------
124 DO 155 i=lft,llt
125 fsav(1)=fsav(1)+fxi(i)*dt12
126 fsav(2)=fsav(2)+fyi(i)*dt12
127 fsav(3)=fsav(3)+fzi(i)*dt12
128 155 CONTINUE
129C
130 DO 160 i=lft,llt
131 fx1(i)=fxi(i)*h1(i)
132 fy1(i)=fyi(i)*h1(i)
133 fz1(i)=fzi(i)*h1(i)
134C
135 fx2(i)=fxi(i)*h2(i)
136 fy2(i)=fyi(i)*h2(i)
137 fz2(i)=fzi(i)*h2(i)
138C
139 fx3(i)=fxi(i)*h3(i)
140 fy3(i)=fyi(i)*h3(i)
141 fz3(i)=fzi(i)*h3(i)
142C
143 fx4(i)=fxi(i)*h4(i)
144 fy4(i)=fyi(i)*h4(i)
145 fz4(i)=fzi(i)*h4(i)
146C
147 160 CONTINUE
148C
149 IF(iparit==0)THEN
150 DO 180 i=lft,llt
151 j3=3*ix1(i)
152 j2=j3-1
153 j1=j2-1
154 e(j1)=e(j1)+fx1(i)
155 e(j2)=e(j2)+fy1(i)
156 e(j3)=e(j3)+fz1(i)
157C
158 j3=3*ix2(i)
159 j2=j3-1
160 j1=j2-1
161 e(j1)=e(j1)+fx2(i)
162 e(j2)=e(j2)+fy2(i)
163 e(j3)=e(j3)+fz2(i)
164C
165 j3=3*ix3(i)
166 j2=j3-1
167 j1=j2-1
168 e(j1)=e(j1)+fx3(i)
169 e(j2)=e(j2)+fy3(i)
170 e(j3)=e(j3)+fz3(i)
171C
172 j3=3*ix4(i)
173 j2=j3-1
174 j1=j2-1
175 e(j1)=e(j1)+fx4(i)
176 e(j2)=e(j2)+fy4(i)
177 e(j3)=e(j3)+fz4(i)
178C
179 il=i+nft
180 ig=nsv(il)
181 i3=3*ig
182 i2=i3-1
183 i1=i2-1
184 e(i1)=e(i1)-fxi(i)
185 e(i2)=e(i2)-fyi(i)
186 e(i3)=e(i3)-fzi(i)
187 180 CONTINUE
188C
189 ELSE
190C
191#include "lockon.inc"
192 niskyl = nisky
193 nisky = nisky + 5 * llt
194#include "lockoff.inc"
195C
196 DO 190 i=lft,llt
197 niskyl = niskyl + 1
198 fskyi(niskyl,1)=fx1(i)
199 fskyi(niskyl,2)=fy1(i)
200 fskyi(niskyl,3)=fz1(i)
201 fskyi(niskyl,4)=zero
202 isky(niskyl) = ix1(i)
203 niskyl = niskyl + 1
204 fskyi(niskyl,1)=fx2(i)
205 fskyi(niskyl,2)=fy2(i)
206 fskyi(niskyl,3)=fz2(i)
207 fskyi(niskyl,4)=zero
208 isky(niskyl) = ix2(i)
209 niskyl = niskyl + 1
210 fskyi(niskyl,1)=fx3(i)
211 fskyi(niskyl,2)=fy3(i)
212 fskyi(niskyl,3)=fz3(i)
213 fskyi(niskyl,4)=zero
214 isky(niskyl) = ix3(i)
215 niskyl = niskyl + 1
216 fskyi(niskyl,1)=fx4(i)
217 fskyi(niskyl,2)=fy4(i)
218 fskyi(niskyl,3)=fz4(i)
219 fskyi(niskyl,4)=zero
220 isky(niskyl) = ix4(i)
221 niskyl = niskyl + 1
222 fskyi(niskyl,1)=-fxi(i)
223 fskyi(niskyl,2)=-fyi(i)
224 fskyi(niskyl,3)=-fzi(i)
225 fskyi(niskyl,4)=zero
226 il=i+nft
227 isky(niskyl) = nsv(il)
228 190 CONTINUE
229 ENDIF
230C
231 IF(inconv/=1) RETURN
232 IF(ibag/=0.OR.iadm/=0)THEN
233#include "lockon.inc"
234 DO i=lft,llt
235 il=i+nft
236 icontact(nsv(il))=1
237 icontact(ix1(i))=1
238 icontact(ix2(i))=1
239 icontact(ix3(i))=1
240 icontact(ix4(i))=1
241 ENDDO
242#include "lockoff.inc"
243 ENDIF
244C
245 IF(anim_v(4)+outp_v(4)>0.AND.
246 . ((tt>=output%TANIM .AND. tt<=output%TANIM_STOP).OR.tt>=toutp.OR.
247 . (manim>=4.AND.manim<=15)))THEN
248#include "lockon.inc"
249 DO i=1,llt
250 fcont(1,ix1(i)) =fcont(1,ix1(i)) + fx1(i)
251 fcont(2,ix1(i)) =fcont(2,ix1(i)) + fy1(i)
252 fcont(3,ix1(i)) =fcont(3,ix1(i)) + fz1(i)
253 fcont(1,ix2(i)) =fcont(1,ix2(i)) + fx2(i)
254 fcont(2,ix2(i)) =fcont(2,ix2(i)) + fy2(i)
255 fcont(3,ix2(i)) =fcont(3,ix2(i)) + fz2(i)
256 fcont(1,ix3(i)) =fcont(1,ix3(i)) + fx3(i)
257 fcont(2,ix3(i)) =fcont(2,ix3(i)) + fy3(i)
258 fcont(3,ix3(i)) =fcont(3,ix3(i)) + fz3(i)
259 fcont(1,ix4(i)) =fcont(1,ix4(i)) + fx4(i)
260 fcont(2,ix4(i)) =fcont(2,ix4(i)) + fy4(i)
261 fcont(3,ix4(i)) =fcont(3,ix4(i)) + fz4(i)
262 fcont(1,nsv(i+nft))=fcont(1,nsv(i+nft))- fxi(i)
263 fcont(2,nsv(i+nft))=fcont(2,nsv(i+nft))- fyi(i)
264 fcont(3,nsv(i+nft))=fcont(3,nsv(i+nft))- fzi(i)
265 ENDDO
266#include "lockoff.inc"
267 ENDIF
268C
269 IF(anim_v(12)+outp_v(12)+h3d_data%N_VECT_PCONT>0.AND.
270 . ((tt>=output%TANIM .AND. tt<=output%TANIM_STOP).OR.tt>=toutp.OR.(tt>=h3d_data%TH3D.AND.tt<=h3d_data%TH3D_STOP).OR.
271 . (manim>=4.AND.manim<=15).OR.h3d_data%MH3D/=0))THEN
272#include "lockon.inc"
273 DO i=1,llt
274 fncont(1,ix1(i)) =fncont(1,ix1(i)) + fx1(i)
275 fncont(2,ix1(i)) =fncont(2,ix1(i)) + fy1(i)
276 fncont(3,ix1(i)) =fncont(3,ix1(i)) + fz1(i)
277 fncont(1,ix2(i)) =fncont(1,ix2(i)) + fx2(i)
278 fncont(2,ix2(i)) =fncont(2,ix2(i)) + fy2(i)
279 fncont(3,ix2(i)) =fncont(3,ix2(i)) + fz2(i)
280 fncont(1,ix3(i)) =fncont(1,ix3(i)) + fx3(i)
281 fncont(2,ix3(i)) =fncont(2,ix3(i)) + fy3(i)
282 fncont(3,ix3(i)) =fncont(3,ix3(i)) + fz3(i)
283 fncont(1,ix4(i)) =fncont(1,ix4(i)) + fx4(i)
284 fncont(2,ix4(i)) =fncont(2,ix4(i)) + fy4(i)
285 fncont(3,ix4(i)) =fncont(3,ix4(i)) + fz4(i)
286 fncont(1,nsv(i+nft))=fncont(1,nsv(i+nft))- fxi(i)
287 fncont(2,nsv(i+nft))=fncont(2,nsv(i+nft))- fyi(i)
288 fncont(3,nsv(i+nft))=fncont(3,nsv(i+nft))- fzi(i)
289 ENDDO
290#include "lockoff.inc"
291 ENDIF
292C
293 IF(ibc==0) RETURN
294 DO 200 i=lft,llt
295 IF(ibc==0.OR.xface(i)==zero)GOTO 200
296 il=i+nft
297 ig=nsv(il)
298 CALL ibcoff(ibc,icodt(ig))
299 200 CONTINUE
300C
301 RETURN
302 END
i5for3
subroutine i5for3(output, 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
ibcoff
subroutine ibcoff(ibc, icodt)
Definition ibcoff.F:44
min
#define min(a, b)
Definition macros.h:20
h3d_mod
Definition h3d_mod.F:311