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