OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
i11cor3.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 i11cor3 (jlt, irects, irectm, x, v, cand_s, cand_m, stfs, stfm, gap, gap_s, gap_m, igap, gapv, ms, stif, xxs1, xxs2, xys1, xys2, xzs1, xzs2, xxm1, xxm2, xym1, xym2, xzm1, xzm2, vxs1, vxs2, vys1, vys2, vzs1, vzs2, vxm1, vxm2, vym1, vym2, vzm1, vzm2, ms1, ms2, mm1, mm2, n1, n2, m1, m2, nrts, nin, igsti, kmin, kmax, nodnx_sms, nsms, gap_s_l, gap_m_l, intth, temp, tempi1, tempi2, tempm1, tempm2, areas, aream, areac, ieleci, ielesi, ielec, ieles, iform, itab, intfric, ipartfrics, ipartfricsi, ipartfricm, ipartfricmi)

Function/Subroutine Documentation

◆ i11cor3()

subroutine i11cor3 ( integer jlt,
integer, dimension(2,*) irects,
integer, dimension(2,*) irectm,
x,
v,
integer, dimension(*) cand_s,
integer, dimension(*) cand_m,
stfs,
stfm,
gap,
gap_s,
gap_m,
integer igap,
gapv,
ms,
stif,
xxs1,
xxs2,
xys1,
xys2,
xzs1,
xzs2,
xxm1,
xxm2,
xym1,
xym2,
xzm1,
xzm2,
vxs1,
vxs2,
vys1,
vys2,
vzs1,
vzs2,
vxm1,
vxm2,
vym1,
vym2,
vzm1,
vzm2,
ms1,
ms2,
mm1,
mm2,
integer, dimension(mvsiz) n1,
integer, dimension(mvsiz) n2,
integer, dimension(mvsiz) m1,
integer, dimension(mvsiz) m2,
integer nrts,
integer nin,
integer igsti,
kmin,
kmax,
integer, dimension(*) nodnx_sms,
integer, dimension(mvsiz) nsms,
gap_s_l,
gap_m_l,
integer intth,
temp,
tempi1,
tempi2,
tempm1,
tempm2,
areas,
aream,
areac,
integer, dimension(mvsiz) ieleci,
integer, dimension(mvsiz) ielesi,
integer, dimension(*) ielec,
integer, dimension(*) ieles,
integer iform,
integer, dimension(*) itab,
integer intfric,
integer, dimension(*) ipartfrics,
integer, dimension(mvsiz) ipartfricsi,
integer, dimension(*) ipartfricm,
integer, dimension(mvsiz) ipartfricmi )

Definition at line 33 of file i11cor3.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 IRECTS(2,*), IRECTM(2,*), CAND_M(*), CAND_S(*),
70 . JLT, IGAP , NRTS, NIN, IGSTI, NODNX_SMS(*),
71 . N1(MVSIZ), N2(MVSIZ), M1(MVSIZ), M2(MVSIZ), NSMS(MVSIZ),
72 . INTTH,IELEC(*),IELECI(MVSIZ),ITAB(*),IELES(*),IELESI(MVSIZ),IFORM,
73 . INTFRIC,
74 . IPARTFRICS(*),IPARTFRICSI(MVSIZ),IPARTFRICM(*),IPARTFRICMI(MVSIZ)
75C REAL
76 my_real
77 . gap, x(3,*), stfm(*), stfs(*),gap_s(*),gap_m(*),
78 . ms(*), v(3,*),
79 . xxs1(mvsiz), xxs2(mvsiz), xys1(mvsiz), xys2(mvsiz),
80 . xzs1(mvsiz), xzs2(mvsiz), xxm1(mvsiz), xxm2(mvsiz),
81 . xym1(mvsiz), xym2(mvsiz), xzm1(mvsiz), xzm2(mvsiz),
82 . vxs1(mvsiz), vxs2(mvsiz), vys1(mvsiz), vys2(mvsiz),
83 . vzs1(mvsiz), vzs2(mvsiz), vxm1(mvsiz), vxm2(mvsiz),
84 . vym1(mvsiz), vym2(mvsiz), vzm1(mvsiz), vzm2(mvsiz),
85 . ms1(mvsiz), ms2(mvsiz), mm1(mvsiz), mm2(mvsiz),
86 . gapv(mvsiz), stif(mvsiz), kmin, kmax, drad,
87 . gap_s_l(*),gap_m_l(*),temp(*),areas(*),aream(*),
88 . tempi1(mvsiz),tempi2(mvsiz),tempm1(mvsiz),tempm2(mvsiz),
89 . areac(mvsiz)
90C-----------------------------------------------
91C L o c a l V a r i a b l e s
92C-----------------------------------------------
93 INTEGER I ,NN ,NI ,L
94 my_real
95 . tm,dist,secs,secm,xs,ys,zs,xm,ym,zm,ls,lm,ct,st,area1,area2
96C-----------------------------------------------
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_s(i)<=nrts) THEN
105 gapv(i)=gap_s(cand_s(i))+gap_m(cand_m(i))
106 IF(igap == 3)
107 . gapv(i)=min(gap_s_l(cand_s(i))+gap_m_l(cand_m(i)),gapv(i))
108 ELSE
109 gapv(i)=gapfi(nin)%P(cand_s(i)-nrts)+gap_m(cand_m(i))
110 IF(igap == 3)
111 . gapv(i)=
112 . min(gap_lfi(nin)%P(cand_s(i)-nrts)+gap_m_l(cand_m(i)),gapv(i))
113 ENDIF
114 gapv(i)=max(gap,gapv(i))
115 ENDDO
116 ENDIF
117C
118 IF(igsti == 1)THEN
119 DO i=1,jlt
120 IF(cand_s(i)<=nrts) THEN
121 stif(i)=abs(stfs(cand_s(i)))*stfm(cand_m(i))
122 . / max(em20,abs(stfs(cand_s(i)))+stfm(cand_m(i)))
123 ELSE
124 nn = cand_s(i) - nrts
125 stif(i)=abs(stifi(nin)%P(nn))*stfm(cand_m(i))
126 . / max(em20,abs(stifi(nin)%P(nn))+stfm(cand_m(i)))
127 END IF
128 END DO
129 ELSEIF(igsti == 5)THEN
130 DO i=1,jlt
131 IF(cand_s(i)<=nrts) THEN
132 stif(i)=abs(stfs(cand_s(i)))*stfm(cand_m(i))
133 . / max(em20,abs(stfs(cand_s(i)))+stfm(cand_m(i)))
134 ELSE
135 nn = cand_s(i) - nrts
136 stif(i)=abs(stifi(nin)%P(nn))*stfm(cand_m(i))
137 . / max(em20,abs(stifi(nin)%P(nn))+stfm(cand_m(i)))
138 END IF
139 stif(i)=max(kmin,min(stif(i),kmax))
140 END DO
141 ELSEIF(igsti == 2)THEN
142 DO i=1,jlt
143 IF(cand_s(i)<=nrts) THEN
144 stif(i)=half*(abs(stfs(cand_s(i)))+stfm(cand_m(i)))
145 ELSE
146 nn = cand_s(i) - nrts
147 stif(i)=half*(abs(stifi(nin)%P(nn))+stfm(cand_m(i)))
148 END IF
149 stif(i)=max(kmin,min(stif(i),kmax))
150 END DO
151 ELSEIF(igsti == 3)THEN
152 DO i=1,jlt
153 IF(cand_s(i)<=nrts) THEN
154 stif(i)=max(abs(stfs(cand_s(i))),stfm(cand_m(i)))
155 ELSE
156 nn = cand_s(i) - nrts
157 stif(i)=max(abs(stifi(nin)%P(nn)),stfm(cand_m(i)))
158 END IF
159 stif(i)=max(kmin,min(stif(i),kmax))
160 END DO
161 ELSEIF(igsti == 4)THEN
162 DO i=1,jlt
163 IF(cand_s(i)<=nrts) THEN
164 stif(i)=min(abs(stfs(cand_s(i))),stfm(cand_m(i)))
165 ELSE
166 nn = cand_s(i) - nrts
167 stif(i)=min(abs(stifi(nin)%P(nn)),stfm(cand_m(i)))
168 END IF
169 stif(i)=max(kmin,min(stif(i),kmax))
170 END DO
171 END IF
172C
173 DO i=1,jlt
174 IF(cand_s(i)<=nrts) THEN
175 n1(i)=irects(1,cand_s(i))
176 n2(i)=irects(2,cand_s(i))
177 m1(i)=irectm(1,cand_m(i))
178 m2(i)=irectm(2,cand_m(i))
179 xxs1(i) = x(1,n1(i))
180 xys1(i) = x(2,n1(i))
181 xzs1(i) = x(3,n1(i))
182 xxs2(i) = x(1,n2(i))
183 xys2(i) = x(2,n2(i))
184 xzs2(i) = x(3,n2(i))
185 xxm1(i) = x(1,m1(i))
186 xym1(i) = x(2,m1(i))
187 xzm1(i) = x(3,m1(i))
188 xxm2(i) = x(1,m2(i))
189 xym2(i) = x(2,m2(i))
190 xzm2(i) = x(3,m2(i))
191 vxs1(i) = v(1,n1(i))
192 vys1(i) = v(2,n1(i))
193 vzs1(i) = v(3,n1(i))
194 vxs2(i) = v(1,n2(i))
195 vys2(i) = v(2,n2(i))
196 vzs2(i) = v(3,n2(i))
197 vxm1(i) = v(1,m1(i))
198 vym1(i) = v(2,m1(i))
199 vzm1(i) = v(3,m1(i))
200 vxm2(i) = v(1,m2(i))
201 vym2(i) = v(2,m2(i))
202 vzm2(i) = v(3,m2(i))
203 ms1(i) = ms(n1(i))
204 ms2(i) = ms(n2(i))
205 mm1(i) = ms(m1(i))
206 mm2(i) = ms(m2(i))
207 ELSE
208 nn = cand_s(i) - nrts
209 n1(i)=2*(nn-1)+1
210 n2(i)=2*nn
211 m1(i)=irectm(1,cand_m(i))
212 m2(i)=irectm(2,cand_m(i))
213 xxs1(i) = xfi(nin)%P(1,n1(i))
214 xys1(i) = xfi(nin)%P(2,n1(i))
215 xzs1(i) = xfi(nin)%P(3,n1(i))
216 xxs2(i) = xfi(nin)%P(1,n2(i))
217 xys2(i) = xfi(nin)%P(2,n2(i))
218 xzs2(i) = xfi(nin)%P(3,n2(i))
219 xxm1(i) = x(1,m1(i))
220 xym1(i) = x(2,m1(i))
221 xzm1(i) = x(3,m1(i))
222 xxm2(i) = x(1,m2(i))
223 xym2(i) = x(2,m2(i))
224 xzm2(i) = x(3,m2(i))
225 vxs1(i) = vfi(nin)%P(1,n1(i))
226 vys1(i) = vfi(nin)%P(2,n1(i))
227 vzs1(i) = vfi(nin)%P(3,n1(i))
228 vxs2(i) = vfi(nin)%P(1,n2(i))
229 vys2(i) = vfi(nin)%P(2,n2(i))
230 vzs2(i) = vfi(nin)%P(3,n2(i))
231 vxm1(i) = v(1,m1(i))
232 vym1(i) = v(2,m1(i))
233 vzm1(i) = v(3,m1(i))
234 vxm2(i) = v(1,m2(i))
235 vym2(i) = v(2,m2(i))
236 vzm2(i) = v(3,m2(i))
237 ms1(i) = msfi(nin)%P(n1(i))
238 ms2(i) = msfi(nin)%P(n2(i))
239 mm1(i) = ms(m1(i))
240 mm2(i) = ms(m2(i))
241 END IF
242 END DO
243C
244 IF(idtmins==2)THEN
245 DO i=1,jlt
246 IF(cand_s(i)<=nrts)THEN
247 nsms(i)=nodnx_sms(n1(i))+nodnx_sms(n2(i))+
248 . nodnx_sms(m1(i))+nodnx_sms(m2(i))
249 ELSE
250 nsms(i)=nodnxfi(nin)%P(n1(i))+nodnxfi(nin)%P(n2(i))+
251 . nodnx_sms(m1(i))+nodnx_sms(m2(i))
252 END IF
253 ENDDO
254 IF(idtmins_int/=0)THEN
255 DO i=1,jlt
256 IF(nsms(i)==0)nsms(i)=-1
257 ENDDO
258 END IF
259 ELSEIF(idtmins_int/=0)THEN
260 DO i=1,jlt
261 nsms(i)=-1
262 ENDDO
263 ENDIF
264C
265C Thermal Modelling
266C
267 IF(intth/=0)THEN
268C
269 IF(iform == 0) THEN
270C
271 DO i=1,jlt
272 IF(cand_s(i)<=nrts) THEN
273C SECND EDGE AREA
274 secs=areas(cand_s(i))
275C AREA COMPUTING
276 xs = xxs2(i)-xxs1(i)
277 ys = xys2(i)-xys1(i)
278 zs = xzs2(i)-xzs1(i)
279C
280 ls = sqrt(xs*xs + ys*ys + zs*zs)
281C
282 areac(i) = ls*secs
283C SECND TEMPERATURE
284 tempi1(i) = temp(n1(i))
285 tempi2(i) = temp(n2(i))
286 ieleci(i)= ielec(cand_s(i))
287 ELSE
288 nn = cand_s(i) - nrts
289C SECND EDGE AREA
290 secs =areasfi(nin)%P(nn)
291C AREA COMPUTING
292 xs = xxs2(i)-xxs1(i)
293 ys = xys2(i)-xys1(i)
294 zs = xzs2(i)-xzs1(i)
295C
296 ls = sqrt(xs*xs + ys*ys + zs*zs)
297C
298 areac(i) = ls*secs
299C SECND TEMPERATURE
300 tempi1(i) = tempfi(nin)%P(n1(i))
301 tempi2(i) = tempfi(nin)%P(n2(i))
302
303 ieleci(i)= matsfi(nin)%P(nn)
304C
305 END IF
306 END DO
307C
308 ELSE
309C
310 DO i=1,jlt
311 IF(cand_s(i)<=nrts) THEN
312C SECND EDGE AREA
313 secs=areas(cand_s(i))
314C main EDGE AREA
315 secm=aream(cand_m(i))
316C AREA COMPUTING
317 xs = xxs2(i)-xxs1(i)
318 ys = xys2(i)-xys1(i)
319 zs = xzs2(i)-xzs1(i)
320 xm = xxm2(i)-xxm1(i)
321 ym = xym2(i)-xym1(i)
322 zm = xzm2(i)-xzm1(i)
323
324 ls = sqrt(xs*xs + ys*ys + zs*zs)
325 lm = sqrt(xm*xm + ym*ym + zm*zm)
326
327 ct = (xs*xm + ys*ym + zs*zm)/(ls*lm)
328 st = sqrt(one-min(ct*ct,one))
329
330 area1 = min(ls,lm)*min(secs,secm)
331 area2 = secs*secm/max(st,em30)
332
333 areac(i) = min(area1,area2)
334
335C SECND TEMPERATURE
336 tempi1(i) = temp(n1(i))
337 tempi2(i) = temp(n2(i))
338C main TEMPERATURE
339 tempm1(i) = temp(m1(i))
340 tempm2(i) = temp(m2(i))
341
342 ieleci(i)= ielec(cand_s(i))
343 ielesi(i)= ieles(cand_m(i))
344 ELSE
345 nn = cand_s(i) - nrts
346C SECND NODAL AREA
347 secs =areasfi(nin)%P(nn)
348C main EDGE AREA
349 secm =aream(cand_m(i))
350C AREA COMPUTING
351 xs = xxs2(i)-xxs1(i)
352 ys = xys2(i)-xys1(i)
353 zs = xzs2(i)-xzs1(i)
354 xm = xxm2(i)-xxm1(i)
355 ym = xym2(i)-xym1(i)
356 zm = xzm2(i)-xzm1(i)
357
358 ls = sqrt(xs*xs + ys*ys + zs*zs)
359 lm = sqrt(xm*xm + ym*ym + zm*zm)
360
361 ct = (xs*xm + ys*ym + zs*zm)/(ls*lm)
362 st = sqrt(one-min(ct*ct,one))
363
364 area1 = min(ls,lm)*min(secs,secm)
365 area2 = secs*secm/max(st,em30)
366
367 areac(i) = min(area1,area2)*half
368
369C SECND TEMPERATURE
370 tempi1(i) = tempfi(nin)%P(n1(i))
371 tempi2(i) = tempfi(nin)%P(n2(i))
372C main TEMPERATURE
373 tempm1(i) = temp(m1(i))
374 tempm2(i) = temp(m2(i))
375
376 ieleci(i)= matsfi(nin)%P(nn)
377 ielesi(i)= ieles(cand_m(i))
378 END IF
379C
380 END DO
381C
382 ENDIF
383C
384 ENDIF
385C
386 IF(intfric > 0) THEN
387 DO i=1,jlt
388 ni = cand_s(i)
389 l = cand_m(i)
390 IF(ni<=nrts)THEN
391 ipartfricsi(i)= ipartfrics(ni)
392 ELSE
393 nn = ni - nrts
394 ipartfricsi(i)= ipartfricsfi(nin)%P(nn)
395 END IF
396C
397 ipartfricmi(i) = ipartfricm(l)
398 ENDDO
399 ENDIF
400C
401 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