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