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