OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
i6ass3.F File Reference
#include "implicit_f.inc"
#include "comlock.inc"
#include "com06_c.inc"
#include "com08_c.inc"
#include "scr07_c.inc"
#include "scr14_c.inc"
#include "scr16_c.inc"
#include "parit_c.inc"
#include "scr18_c.inc"
#include "lockon.inc"
#include "lockoff.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine i6ass3 (e, msr, nsv, es, em, npc, tf, ansmx, fmx, fmy, fmz, xmas, ifunc, v, noint, nsn, nmn, fsav, dt2t, neltst, ityptst, ffac, fskyi, isky, fcont, facx, fac2, stiff, hflag, ifun2, icor, peni, ansmx0, ff0, h3d_data)

Function/Subroutine Documentation

◆ i6ass3()

subroutine i6ass3 ( e,
integer, dimension(*) msr,
integer, dimension(*) nsv,
es,
em,
integer, dimension(*) npc,
tf,
ansmx,
fmx,
fmy,
fmz,
xmas,
integer ifunc,
v,
integer noint,
integer nsn,
integer nmn,
fsav,
dt2t,
integer neltst,
integer ityptst,
ffac,
fskyi,
integer, dimension(*) isky,
fcont,
facx,
fac2,
stiff,
integer hflag,
integer ifun2,
integer icor,
peni,
ansmx0,
ff0,
type(h3d_database) h3d_data )

Definition at line 33 of file i6ass3.F.

42C-----------------------------------------------
43C M o d u l e s
44C-----------------------------------------------
45 USE h3d_mod
46 USE anim_mod
47C-----------------------------------------------
48C I m p l i c i t T y p e s
49C-----------------------------------------------
50#include "implicit_f.inc"
51#include "comlock.inc"
52C-----------------------------------------------
53C C o m m o n B l o c k s
54C-----------------------------------------------
55#include "com06_c.inc"
56#include "com08_c.inc"
57#include "scr07_c.inc"
58#include "scr14_c.inc"
59#include "scr16_c.inc"
60#include "parit_c.inc"
61#include "scr18_c.inc"
62C-----------------------------------------------
63C D u m m y A r g u m e n t s
64C-----------------------------------------------
65 INTEGER NELTST,ITYPTST, IFUNC,IFUN2, NOINT, NSN, NMN,HFLAG,ICOR
66 INTEGER MSR(*), NSV(*), NPC(*), ISKY(*)
67C REAL
68 my_real
69 . dt2t,ansmx,ansmx0,ff0,fmx,fmy,fmz,xmas,ffac,facx,fac2,stiff,
70 . peni
71 my_real
72 . e(*),es(*),em(*),tf(*),v(*),fsav(*),fskyi(lskyi,nfskyi),
73 . fcont(3,*)
74 TYPE(H3D_DATABASE) :: H3D_DATA
75C-----------------------------------------------
76C L o c a l V a r i a b l e s
77C-----------------------------------------------
78 INTEGER NPOINT, IL, IG, IG3, IG2, IG1, IL3, IL2, IL1, NISKYL
79C REAL
80 my_real
81 . vsmax, vmmax, vmax, ft,fu,ff, xk, dtmi, fac, facdt, dx, finter
82 EXTERNAL finter
83C=======================================================================
84 IF (tt == zero) THEN
85 ansmx0 = zero
86 ff0 = zero
87 IF (icor == 1) THEN
88 ansmx0 = -ansmx
89 IF (hflag == 1) ff0 = finter(ifun2,abs(peni)*facx,npc,tf,xk)
90 ENDIF
91 ENDIF
92c
93 IF (ansmx > zero)THEN
94 vsmax =zero
95 vmmax =zero
96 ansmx0=zero
97C
98 DO il=1,nsn
99 ig=nsv(il)
100 ig3=3*ig
101 ig2=ig3-1
102 ig1=ig2-1
103 vsmax = max(vsmax,v(ig1)**2+v(ig2)**2+v(ig3)**2)
104 ENDDO
105C
106 DO il=1,nmn
107 ig=msr(il)
108 ig3=3*ig
109 ig2=ig3-1
110 ig1=ig2-1
111 vmmax = max(vmmax,v(ig1)**2+v(ig2)**2+v(ig3)**2)
112 ENDDO
113C
114 vmax = sqrt(vsmax)+sqrt(vmmax)+ em15
115 ft = finter(ifunc,zero,npc,tf,xk)
116 xk = max(em15,xk)
117 dtmi = max(em01*sqrt(xmas/xk),ansmx/vmax)
118C------------------------------------------------
119 ELSEIF (ansmx == zero) THEN
120 ft = finter(ifunc,ansmx*facx,npc,tf,xk)
121 xk = max(em15,xk*ffac)
122 ft = ft*ffac
123 dtmi = em01*sqrt(xmas/xk)
124C------------------------------------------------
125 ELSE
126C ANSMX < 0
127 ansmx = -ansmx
128 ft = finter(ifunc,ansmx*facx,npc,tf,xk)
129 xk = max(em15,xk*ffac)
130 ft = ft*ffac
131 fu = zero
132 IF (hflag == 1) THEN
133 fu = finter(ifun2,ansmx*facx,npc,tf,xk)
134 fu = fu*fac2
135 ENDIF
136C
137 IF (hflag > 0) THEN
138 dx = ansmx-ansmx0
139 IF (dx >= zero) THEN
140c loading
141 ft = min(ft, ff0 + stiff*dx)
142 ELSE
143c unloading
144 ft = max(fu, ff0 + stiff*dx)
145 ENDIF
146 xk = ft - ff0 / max(em15,dx)
147 ansmx0 = ansmx
148 ff0 = ft
149 ENDIF
150 fac = ft / max(em15,sqrt(fmx**2+fmy**2+fmz**2))
151 facdt = fac*dt1
152C------------------------------------------------
153 fsav(1)=fsav(1)+fmx*facdt
154 fsav(2)=fsav(2)+fmy*facdt
155 fsav(3)=fsav(3)+fmz*facdt
156 fsav(4)=fsav(4)-fmx*facdt
157 fsav(5)=fsav(5)-fmy*facdt
158 fsav(6)=fsav(6)-fmz*facdt
159C
160 IF (iparit == 0) THEN
161 DO 190 il=1,nsn
162 ig=nsv(il)
163 ig3=3*ig
164 ig2=ig3-1
165 ig1=ig2-1
166 il3=3*il
167 il2=il3-1
168 il1=il2-1
169 e(ig1)=es(il1)*fac
170 e(ig2)=es(il2)*fac
171 e(ig3)=es(il3)*fac
172 190 CONTINUE
173C
174 DO 200 il=1,nmn
175 ig=msr(il)
176 ig3=3*ig
177 ig2=ig3-1
178 ig1=ig2-1
179 il3=3*il
180 il2=il3-1
181 il1=il2-1
182 e(ig1)=em(il1)*fac
183 e(ig2)=em(il2)*fac
184 e(ig3)=em(il3)*fac
185 fsav(4)=fsav(4)-em(il1)*facdt
186 fsav(5)=fsav(5)-em(il2)*facdt
187 fsav(6)=fsav(6)-em(il3)*facdt
188 200 CONTINUE
189
190 ELSE
191C IPARIT /= 0
192#include "lockon.inc"
193 niskyl = nisky
194 nisky = nisky + nsn + nmn
195#include "lockoff.inc"
196 IF (kdtint == 0) THEN
197 DO 220 il=1,nsn
198 il3=3*il
199 il2=il3-1
200 il1=il2-1
201 niskyl = niskyl + 1
202 fskyi(niskyl,1)=es(il1)*fac
203 fskyi(niskyl,2)=es(il2)*fac
204 fskyi(niskyl,3)=es(il3)*fac
205 fskyi(niskyl,4)=zero
206 isky(niskyl) = nsv(il)
207 220 CONTINUE
208C
209 DO 240 il=1,nmn
210 il3=3*il
211 il2=il3-1
212 il1=il2-1
213 niskyl = niskyl + 1
214 fskyi(niskyl,1)=em(il1)*fac
215 fskyi(niskyl,2)=em(il2)*fac
216 fskyi(niskyl,3)=em(il3)*fac
217 fskyi(niskyl,4)=zero
218 isky(niskyl) = msr(il)
219 fsav(4)=fsav(4)-em(il1)*facdt
220 fsav(5)=fsav(5)-em(il2)*facdt
221 fsav(6)=fsav(6)-em(il3)*facdt
222 240 CONTINUE
223 ELSE
224 DO il=1,nsn
225 il3=3*il
226 il2=il3-1
227 il1=il2-1
228 niskyl = niskyl + 1
229 fskyi(niskyl,1)=es(il1)*fac
230 fskyi(niskyl,2)=es(il2)*fac
231 fskyi(niskyl,3)=es(il3)*fac
232 fskyi(niskyl,4)=zero
233 fskyi(niskyl,5)=zero
234 isky(niskyl) = nsv(il)
235 ENDDO
236C
237 DO il=1,nmn
238 il3=3*il
239 il2=il3-1
240 il1=il2-1
241 niskyl = niskyl + 1
242 fskyi(niskyl,1)=em(il1)*fac
243 fskyi(niskyl,2)=em(il2)*fac
244 fskyi(niskyl,3)=em(il3)*fac
245 fskyi(niskyl,4)=zero
246 fskyi(niskyl,5)=zero
247 isky(niskyl) = msr(il)
248 fsav(4)=fsav(4)-em(il1)*facdt
249 fsav(5)=fsav(5)-em(il2)*facdt
250 fsav(6)=fsav(6)-em(il3)*facdt
251 ENDDO
252 ENDIF
253 ENDIF
254C------- parith
255 IF(anim_v(4)+outp_v(4)+h3d_data%N_VECT_CONT>0.AND.
256 . ((tt>=tanim .AND. tt<=tanim_stop).OR.tt>=toutp.OR.(tt>=h3d_data%TH3D.AND.tt<=h3d_data%TH3D_STOP).OR.
257 . (manim>=4.AND.manim<=15).OR. h3d_data%MH3D /= 0))THEN
258#include "lockon.inc"
259 DO il=1,nsn
260 il3=3*il
261 il2=il3-1
262 il1=il2-1
263 fcont(1,nsv(il)) =fcont(1,nsv(il)) + es(il1)*fac
264 fcont(2,nsv(il)) =fcont(2,nsv(il)) + es(il2)*fac
265 fcont(3,nsv(il)) =fcont(3,nsv(il)) + es(il3)*fac
266 ENDDO
267C
268 DO il=1,nmn
269 il3=3*il
270 il2=il3-1
271 il1=il2-1
272 fcont(1,msr(il)) =fcont(1,msr(il)) + em(il1)*fac
273 fcont(2,msr(il)) =fcont(2,msr(il)) + em(il2)*fac
274 fcont(3,msr(il)) =fcont(3,msr(il)) + em(il3)*fac
275 ENDDO
276#include "lockoff.inc"
277 ENDIF
278C
279 xk = max(xk,ft / max(em15,ansmx))
280 dtmi = em01*sqrt(xmas/max(xk,em20))
281 ENDIF
282C-----------
283 IF(dtmi<dt2t)THEN
284 dt2t = dtmi
285 neltst = noint
286 ityptst = 10
287 ENDIF
288C-----------
289 RETURN
my_real
#define my_real
Definition cppsort.cpp:32
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