OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
i11cor3.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!|| i11cor3 ../engine/source/interfaces/int11/i11cor3.F
25!||--- called by ------------------------------------------------------
26!|| i11fku3 ../engine/source/interfaces/int11/i11ke3.F
27!|| i11ke3 ../engine/source/interfaces/int11/i11ke3.f
28!|| i11mainf ../engine/source/interfaces/int11/i11mainf.F
29!|| imp_i11mainf ../engine/source/interfaces/int11/i11ke3.F
30!||--- uses -----------------------------------------------------
31!|| tri7box ../engine/share/modules/tri7box.F
32!||====================================================================
33 SUBROUTINE i11cor3(
34 1 JLT ,IRECTS ,IRECTM ,X ,V ,
35 2 CAND_S ,CAND_M ,STFS ,STFM ,GAP ,
36 3 GAP_S ,GAP_M ,IGAP ,GAPV ,MS ,
37 4 STIF ,XXS1 ,XXS2 ,XYS1 ,XYS2 ,
38 5 XZS1 ,XZS2 ,XXM1 ,XXM2 ,XYM1 ,
39 6 XYM2 ,XZM1 ,XZM2 ,VXS1 ,VXS2 ,
40 7 VYS1 ,VYS2 ,VZS1 ,VZS2 ,VXM1 ,
41 8 VXM2 ,VYM1 ,VYM2 ,VZM1 ,VZM2 ,
42 9 MS1 ,MS2 ,MM1 ,MM2 ,N1 ,
43 A N2 ,M1 ,M2 ,NRTS ,NIN ,
44 B IGSTI ,KMIN ,KMAX ,NODNX_SMS,NSMS ,
45 C GAP_S_L ,GAP_M_L ,INTTH ,TEMP ,TEMPI1 ,
46 D TEMPI2 ,TEMPM1 ,TEMPM2 ,AREAS ,AREAM ,
47 E AREAC ,IELECI ,IELESI ,IELEC ,IELES ,
48 F IFORM ,ITAB ,INTFRIC ,IPARTFRICS,IPARTFRICSI,
49 G IPARTFRICM,IPARTFRICMI)
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
402 END
i11cor3
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)
Definition i11cor3.F:50
i11ke3
subroutine i11ke3(a, v, ms, ipari, intbuf_tab, x, nin, num_imp, cand_n, cand_e, iddl, k_diag, k_lt, iadk, jdik, gap_imp, lrem, itab)
Definition i11ke3.F:41
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