OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
i7cor3.F File Reference
#include "implicit_f.inc"
#include "mvsiz_p.inc"
#include "sms_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine i7cor3 (jlt, x, irect, nsv, cand_e, cand_n, stf, stfn, x1, x2, x3, x4, y1, y2, y3, y4, z1, z2, z3, z4, xi, yi, zi, stif, ix1, ix2, ix3, ix4, nsvg, igap, gap, gap_s, gap_m, gapv, ms, vxi, vyi, vzi, msi, nsn, v, kinet, kini, ity, nin, igsti, kmin, kmax, gapmax, gapmin, iadm, rcurv, rcurvi, anglm, anglmi, intth, temp, tempi, phi, areas, ielec, areasi, ieleci, nodnx_sms, nsms, gap_s_l, gap_m_l, intfric, ipartfrics, ipartfricsi, ipartfricm, ipartfricmi, iorthfric, irep_fricm, dir_fricm, irep_fricmi, dir_fricmi)

Function/Subroutine Documentation

◆ i7cor3()

subroutine i7cor3 ( integer jlt,
x,
integer, dimension(4,*) irect,
integer, dimension(*) nsv,
integer, dimension(*) cand_e,
integer, dimension(*) cand_n,
stf,
stfn,
x1,
x2,
x3,
x4,
y1,
y2,
y3,
y4,
z1,
z2,
z3,
z4,
xi,
yi,
zi,
stif,
integer, dimension(mvsiz) ix1,
integer, dimension(mvsiz) ix2,
integer, dimension(mvsiz) ix3,
integer, dimension(mvsiz) ix4,
integer, dimension(mvsiz) nsvg,
integer igap,
gap,
gap_s,
gap_m,
gapv,
ms,
vxi,
vyi,
vzi,
msi,
integer nsn,
v,
integer, dimension(*) kinet,
integer, dimension(*) kini,
integer ity,
integer nin,
integer igsti,
kmin,
kmax,
gapmax,
gapmin,
integer iadm,
rcurv,
rcurvi,
anglm,
anglmi,
integer intth,
temp,
tempi,
phi,
areas,
integer, dimension(*) ielec,
areasi,
integer, dimension(mvsiz) ieleci,
integer, dimension(*) nodnx_sms,
integer, dimension(mvsiz) nsms,
gap_s_l,
gap_m_l,
integer intfric,
integer, dimension(*) ipartfrics,
integer, dimension(mvsiz) ipartfricsi,
integer, dimension(*) ipartfricm,
integer, dimension(mvsiz) ipartfricmi,
integer iorthfric,
integer, dimension(*) irep_fricm,
dir_fricm,
integer, dimension(mvsiz) irep_fricmi,
dir_fricmi )

Definition at line 33 of file i7cor3.F.

50C-----------------------------------------------
51C M o d u l e s
52C-----------------------------------------------
53 USE tri7box
54C-----------------------------------------------
55C I m p l i c i t T y p e s
56C-----------------------------------------------
57#include "implicit_f.inc"
58C-----------------------------------------------
59C G l o b a l P a r a m e t e r s
60C-----------------------------------------------
61#include "mvsiz_p.inc"
62C-----------------------------------------------
63C C o m m o n B l o c k s
64C-----------------------------------------------
65#include "sms_c.inc"
66C-----------------------------------------------
67C D u m m y A r g u m e n t s
68C-----------------------------------------------
69 INTEGER IRECT(4,*), NSV(*), CAND_E(*), CAND_N(*),KINET(*),KINI(*),
70 . JLT,IDT, NOINT,IGAP , NSN, ITY, NIN, IGSTI,
71 . IADM,INTTH,INTFRIC,IORTHFRIC
72 INTEGER IX1(MVSIZ), IX2(MVSIZ), IX3(MVSIZ), IX4(MVSIZ),
73 . NSVG(MVSIZ),IELEC(*),IELECI(MVSIZ), NSMS(MVSIZ),
74 . NODNX_SMS(*),IPARTFRICS(*),IPARTFRICSI(MVSIZ),IPARTFRICM(*),
75 . IPARTFRICMI(MVSIZ),IREP_FRICM(*),IREP_FRICMI(MVSIZ)
76C REAL
77 my_real
78 . gap, x(3,*), stf(*), stfn(*),gap_s(*),gap_m(*),
79 . ms(*), v(3,*), rcurv(*),anglm(*),temp(*),areas(*),phi(*),
80 . tempi(*),areasi(*),gap_s_l(*),gap_m_l(*)
81 my_real
82 . x1(mvsiz), x2(mvsiz), x3(mvsiz), x4(mvsiz),
83 . y1(mvsiz), y2(mvsiz), y3(mvsiz), y4(mvsiz),
84 . z1(mvsiz), z2(mvsiz), z3(mvsiz), z4(mvsiz),
85 . xi(mvsiz), yi(mvsiz), zi(mvsiz), stif(mvsiz),
86 . gapv(mvsiz),
87 . vxi(mvsiz), vyi(mvsiz), vzi(mvsiz), msi(mvsiz),
88 . kmin, kmax, gapmax, gapmin,
89 . rcurvi(mvsiz), anglmi(mvsiz),
90 . dir_fricm(2,*) ,dir_fricmi(mvsiz,2)
91C-----------------------------------------------
92C L o c a l V a r i a b l e s
93C-----------------------------------------------
94 INTEGER I ,J ,IL, L, NN, IG,JFT, IX, NI
95C-----------------------------------------------
96C S o u r c e L i n e s
97C-----------------------------------------------
98 IF(igap==0)THEN
99 DO i=1,jlt
100 gapv(i)=gap
101 ENDDO
102 ELSE
103 DO i=1,jlt
104 IF(cand_n(i)<=nsn) THEN
105 gapv(i)=gap_s(cand_n(i))+gap_m(cand_e(i))
106 ELSE
107 gapv(i)=gapfi(nin)%P(cand_n(i)-nsn)+gap_m(cand_e(i))
108 ENDIF
109 enddo!next I
110 IF(igap==3)THEN
111 DO i=1,jlt
112 IF(cand_n(i)<=nsn) THEN
113 gapv(i)=min(gap_s_l(cand_n(i))+gap_m_l(cand_e(i)),gapv(i))
114 ELSE
115 gapv(i)= min(gap_lfi(nin)%P(cand_n(i)-nsn)+gap_m_l(cand_e(i)),gapv(i))
116 ENDIF
117 enddo!next I
118 ENDIF
119 DO i=1,jlt
120 gapv(i)=min(gapv(i),gapmax)
121 gapv(i)=max(gapmin,gapv(i))
122 ENDDO
123 ENDIF
124
125 IF(ity==7) THEN
126 IF(intth == 0 )THEN
127 DO i=1,jlt
128 ni = cand_n(i)
129 l = cand_e(i)
130 IF(ni<=nsn)THEN
131 ig = nsv(ni)
132 nsvg(i) = ig
133 kini(i) = kinet(ig)
134 xi(i) = x(1,ig)
135 yi(i) = x(2,ig)
136 zi(i) = x(3,ig)
137 vxi(i) = v(1,ig)
138 vyi(i) = v(2,ig)
139 vzi(i) = v(3,ig)
140 msi(i) = ms(ig)
141 ELSE
142 nn = ni - nsn
143 nsvg(i) = -nn
144 kini(i) = kinfi(nin)%P(nn)
145 xi(i) = xfi(nin)%P(1,nn)
146 yi(i) = xfi(nin)%P(2,nn)
147 zi(i) = xfi(nin)%P(3,nn)
148 vxi(i)= vfi(nin)%P(1,nn)
149 vyi(i)= vfi(nin)%P(2,nn)
150 vzi(i)= vfi(nin)%P(3,nn)
151 msi(i)= msfi(nin)%P(nn)
152 END IF
153C
154 ix=irect(1,l)
155 ix1(i)=ix
156 x1(i)=x(1,ix)
157 y1(i)=x(2,ix)
158 z1(i)=x(3,ix)
159C
160 ix=irect(2,l)
161 ix2(i)=ix
162 x2(i)=x(1,ix)
163 y2(i)=x(2,ix)
164 z2(i)=x(3,ix)
165C
166 ix=irect(3,l)
167 ix3(i)=ix
168 x3(i)=x(1,ix)
169 y3(i)=x(2,ix)
170 z3(i)=x(3,ix)
171C
172 ix=irect(4,l)
173 ix4(i)=ix
174 x4(i)=x(1,ix)
175 y4(i)=x(2,ix)
176 z4(i)=x(3,ix)
177C
178 END DO
179 ELSE
180 DO i=1,jlt
181 ni = cand_n(i)
182 l = cand_e(i)
183 IF(ni<=nsn)THEN
184 ig = nsv(ni)
185 nsvg(i) = ig
186 kini(i) = kinet(ig)
187 xi(i) = x(1,ig)
188 yi(i) = x(2,ig)
189 zi(i) = x(3,ig)
190 vxi(i) = v(1,ig)
191 vyi(i) = v(2,ig)
192 vzi(i) = v(3,ig)
193 msi(i)= ms(ig)
194 tempi(i) = temp(ig)
195 areasi(i)= areas(ni)
196 ieleci(i)= ielec(ni)
197 phi(i) = zero
198 ELSE
199 nn = ni - nsn
200 nsvg(i) = -nn
201 kini(i) = kinfi(nin)%P(nn)
202 xi(i) = xfi(nin)%P(1,nn)
203 yi(i) = xfi(nin)%P(2,nn)
204 zi(i) = xfi(nin)%P(3,nn)
205 vxi(i)= vfi(nin)%P(1,nn)
206 vyi(i)= vfi(nin)%P(2,nn)
207 vzi(i)= vfi(nin)%P(3,nn)
208 msi(i)= msfi(nin)%P(nn)
209 tempi(i) = tempfi(nin)%P(nn)
210 areasi(i)= areasfi(nin)%P(nn)
211 ieleci(i)= matsfi(nin)%P(nn)
212 END IF
213C
214 ix=irect(1,l)
215 ix1(i)=ix
216 x1(i)=x(1,ix)
217 y1(i)=x(2,ix)
218 z1(i)=x(3,ix)
219C
220 ix=irect(2,l)
221 ix2(i)=ix
222 x2(i)=x(1,ix)
223 y2(i)=x(2,ix)
224 z2(i)=x(3,ix)
225C
226 ix=irect(3,l)
227 ix3(i)=ix
228 x3(i)=x(1,ix)
229 y3(i)=x(2,ix)
230 z3(i)=x(3,ix)
231C
232 ix=irect(4,l)
233 ix4(i)=ix
234 x4(i)=x(1,ix)
235 y4(i)=x(2,ix)
236 z4(i)=x(3,ix)
237C
238 END DO
239 ENDIF
240 IF(igsti<=1)THEN
241 DO i=1,jlt
242 l = cand_e(i)
243 ni = cand_n(i)
244 IF(ni<=nsn)THEN
245 stif(i)=stf(l)*abs(stfn(ni))
246 ELSE
247 nn = ni - nsn
248 stif(i)=stf(l)*abs(stifi(nin)%P(nn))
249 END IF
250 ENDDO
251 ELSEIF(igsti==2)THEN
252 DO i=1,jlt
253 l = cand_e(i)
254 ni = cand_n(i)
255 IF(ni<=nsn)THEN
256 stif(i)=abs(stfn(ni))
257 ELSE
258 nn = ni - nsn
259 stif(i)=abs(stifi(nin)%P(nn))
260 END IF
261 stif(i)=half*(stf(l)+stif(i))
262 stif(i)=max(kmin,min(stif(i),kmax))
263 ENDDO
264 ELSEIF(igsti==3)THEN
265 DO i=1,jlt
266 l = cand_e(i)
267 ni = cand_n(i)
268 IF(ni<=nsn)THEN
269 stif(i)=abs(stfn(ni))
270 ELSE
271 nn = ni - nsn
272 stif(i)=abs(stifi(nin)%P(nn))
273 END IF
274 stif(i)=max(stf(l),stif(i))
275 stif(i)=max(kmin,min(stif(i),kmax))
276 ENDDO
277 ELSEIF(igsti==4)THEN
278 DO i=1,jlt
279 l = cand_e(i)
280 ni = cand_n(i)
281 IF(ni<=nsn)THEN
282 stif(i)=abs(stfn(ni))
283 ELSE
284 nn = ni - nsn
285 stif(i)=abs(stifi(nin)%P(nn))
286 END IF
287 stif(i)=min(stf(l),stif(i))
288 stif(i)=max(kmin,min(stif(i),kmax))
289 ENDDO
290 ELSEIF(igsti==5)THEN
291 DO i=1,jlt
292 l = cand_e(i)
293 ni = cand_n(i)
294 IF(ni<=nsn)THEN
295 stif(i)=abs(stfn(ni))
296 ELSE
297 nn = ni - nsn
298 stif(i)=abs(stifi(nin)%P(nn))
299 END IF
300 stif(i)=stf(l)*stif(i)/max(em30,(stf(l)+stif(i)))
301 stif(i)=max(kmin,min(stif(i),kmax))
302 ENDDO
303 ENDIF
304 IF(intfric > 0) THEN
305 DO i=1,jlt
306 ni = cand_n(i)
307 l = cand_e(i)
308 IF(ni<=nsn)THEN
309 ipartfricsi(i)= ipartfrics(ni)
310 ELSE
311 nn = ni - nsn
312 ipartfricsi(i)= ipartfricsfi(nin)%P(nn)
313 END IF
314C
315 ipartfricmi(i) = ipartfricm(l)
316 IF(iorthfric > 0) THEN
317 irep_fricmi(i) =irep_fricm(l)
318 dir_fricmi(i,1:2)=dir_fricm(1:2,l)
319 ENDIF
320 ENDDO
321 ENDIF
322C
323 ELSE
324C type7 KINET en -
325 IF(intth == 0 ) THEN
326 DO i=1,jlt
327 ni = cand_n(i)
328 l = cand_e(i)
329 IF(ni<=nsn)THEN
330 ig = nsv(ni)
331 nsvg(i) = ig
332C KINI(I) = KINET(IG)
333 xi(i) = x(1,ig)
334 yi(i) = x(2,ig)
335 zi(i) = x(3,ig)
336 vxi(i) = v(1,ig)
337 vyi(i) = v(2,ig)
338 vzi(i) = v(3,ig)
339 msi(i)= ms(ig)
340 stif(i)=stf(l)*abs(stfn(ni))
341 ELSE
342 nn = ni - nsn
343 nsvg(i) = -nn
344C KINI(I) = KINFI(NIN)%P(NN)
345 xi(i) = xfi(nin)%P(1,nn)
346 yi(i) = xfi(nin)%P(2,nn)
347 zi(i) = xfi(nin)%P(3,nn)
348 vxi(i)= vfi(nin)%P(1,nn)
349 vyi(i)= vfi(nin)%P(2,nn)
350 vzi(i)= vfi(nin)%P(3,nn)
351 msi(i)= msfi(nin)%P(nn)
352 stif(i)=stf(l)*abs(stifi(nin)%P(nn))
353 END IF
354C
355 ix=irect(1,l)
356 ix1(i)=ix
357 x1(i)=x(1,ix)
358 y1(i)=x(2,ix)
359 z1(i)=x(3,ix)
360C
361 ix=irect(2,l)
362 ix2(i)=ix
363 x2(i)=x(1,ix)
364 y2(i)=x(2,ix)
365 z2(i)=x(3,ix)
366C
367 ix=irect(3,l)
368 ix3(i)=ix
369 x3(i)=x(1,ix)
370 y3(i)=x(2,ix)
371 z3(i)=x(3,ix)
372C
373 ix=irect(4,l)
374 ix4(i)=ix
375 x4(i)=x(1,ix)
376 y4(i)=x(2,ix)
377 z4(i)=x(3,ix)
378C
379 END DO
380 ELSEIF(intth > 0 .AND. ity == 7) THEN
381 DO i=1,jlt
382 ni = cand_n(i)
383 l = cand_e(i)
384 IF(ni<=nsn)THEN
385 ig = nsv(ni)
386 nsvg(i) = ig
387 xi(i) = x(1,ig)
388 yi(i) = x(2,ig)
389 zi(i) = x(3,ig)
390 vxi(i) = v(1,ig)
391 vyi(i) = v(2,ig)
392 vzi(i) = v(3,ig)
393 msi(i)= ms(ig)
394 stif(i)=stf(l)*abs(stfn(ni))
395 tempi(i) = temp(ig)
396 areasi(i)= areas(ni)
397 ieleci(i)= ielec(ni)
398 phi(i) = zero
399 ELSE
400 nn = ni - nsn
401 nsvg(i) = -nn
402 xi(i) = xfi(nin)%P(1,nn)
403 yi(i) = xfi(nin)%P(2,nn)
404 zi(i) = xfi(nin)%P(3,nn)
405 vxi(i)= vfi(nin)%P(1,nn)
406 vyi(i)= vfi(nin)%P(2,nn)
407 vzi(i)= vfi(nin)%P(3,nn)
408 msi(i)= msfi(nin)%P(nn)
409 stif(i)=stf(l)*abs(stifi(nin)%P(nn))
410 tempi(i) = tempfi(nin)%P(nn)
411 areasi(i)= areasfi(nin)%P(nn)
412 ieleci(i)= matsfi(nin)%P(nn)
413 END IF
414C
415 ix=irect(1,l)
416 ix1(i)=ix
417 x1(i)=x(1,ix)
418 y1(i)=x(2,ix)
419 z1(i)=x(3,ix)
420C
421 ix=irect(2,l)
422 ix2(i)=ix
423 x2(i)=x(1,ix)
424 y2(i)=x(2,ix)
425 z2(i)=x(3,ix)
426C
427 ix=irect(3,l)
428 ix3(i)=ix
429 x3(i)=x(1,ix)
430 y3(i)=x(2,ix)
431 z3(i)=x(3,ix)
432C
433 ix=irect(4,l)
434 ix4(i)=ix
435 x4(i)=x(1,ix)
436 y4(i)=x(2,ix)
437 z4(i)=x(3,ix)
438 END DO
439C
440 ENDIF
441 END IF
442C
443 IF(idtmins==2)THEN
444 DO i=1,jlt
445 IF(nsvg(i)>0)THEN
446 nsms(i)=nodnx_sms(nsvg(i))
447 . +nodnx_sms(ix1(i))+nodnx_sms(ix2(i))
448 . +nodnx_sms(ix3(i))+nodnx_sms(ix4(i))
449 ELSE
450 nn=-nsvg(i)
451 nsms(i)=nodnxfi(nin)%P(nn)
452 . +nodnx_sms(ix1(i))+nodnx_sms(ix2(i))
453 . +nodnx_sms(ix3(i))+nodnx_sms(ix4(i))
454 END IF
455 ENDDO
456 IF(idtmins_int/=0)THEN
457 DO i=1,jlt
458 IF(nsms(i)==0)nsms(i)=-1
459 ENDDO
460 END IF
461 ELSEIF(idtmins_int/=0)THEN
462 DO i=1,jlt
463 nsms(i)=-1
464 ENDDO
465 ENDIF
466C
467 IF(iadm/=0)THEN
468 DO i=1,jlt
469 l = cand_e(i)
470 rcurvi(i)=rcurv(l)
471 anglmi(i)=anglm(l)
472 END DO
473 END IF
474C
475 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
tri7box::vfi
type(real_pointer2), dimension(:), allocatable vfi
Definition tri7box.F:459
tri7box::matsfi
type(int_pointer), dimension(:), allocatable matsfi
Definition tri7box.F:440
tri7box::tempfi
type(real_pointer), dimension(:), allocatable tempfi
Definition tri7box.F:449
tri7box::stifi
type(real_pointer), dimension(:), allocatable stifi
Definition tri7box.F:449
tri7box::gap_lfi
type(real_pointer), dimension(:), allocatable gap_lfi
Definition tri7box.F:449
tri7box::gapfi
type(real_pointer), dimension(:), allocatable gapfi
Definition tri7box.F:449
tri7box::nodnxfi
type(int_pointer), dimension(:), allocatable nodnxfi
Definition tri7box.F:440
tri7box::areasfi
type(real_pointer), dimension(:), allocatable areasfi
Definition tri7box.F:449
tri7box::msfi
type(real_pointer), dimension(:), allocatable msfi
Definition tri7box.F:449
tri7box::ipartfricsfi
type(int_pointer), dimension(:), allocatable ipartfricsfi
Definition tri7box.F:440
tri7box::xfi
type(real_pointer2), dimension(:), allocatable xfi
Definition tri7box.F:459
tri7box::kinfi
type(int_pointer), dimension(:), allocatable kinfi
Definition tri7box.F:440