OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
intti1.F File Reference
#include "implicit_f.inc"
#include "com01_c.inc"
#include "com04_c.inc"
#include "com09_c.inc"
#include "param_c.inc"
#include "task_c.inc"
#include "parit_c.inc"
#include "scr18_c.inc"
#include "spmd_c.inc"
#include "sms_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine intti1 (nodes, ipari, x, v, a, vr, ar, wa, ms, in, weight, stifn, stifr, khie, itab, fr_i2m, iad_i2m, addcni2, procni2, iadi2, i2msch, dmast, adm, skew, i2size, fr_nbcci2, adi, igeo, bufgeo, fsav, npf, tf, fncont, iad_elem, fr_elem, nodnx_sms, dmint2, pdama2, nb_fri2m, fr_loci2m, dt2t, neltst, ityptst, intbuf_tab, temp, mcp, fthe, condn, glob_therm, h3d_data, t2fac_sms, fncontp, ftcontp)

Function/Subroutine Documentation

◆ intti1()

subroutine intti1 ( type(nodal_arrays_) nodes,
integer, dimension(npari,*) ipari,
x,
v,
a,
vr,
ar,
wa,
ms,
in,
integer, dimension(*) weight,
stifn,
stifr,
integer khie,
integer, dimension(*) itab,
integer, dimension(*) fr_i2m,
integer, dimension(*) iad_i2m,
integer, dimension(*) addcni2,
integer, dimension(*) procni2,
integer, dimension(*) iadi2,
integer i2msch,
dmast,
adm,
skew,
integer i2size,
integer, dimension(2,*) fr_nbcci2,
adi,
integer, dimension(*) igeo,
bufgeo,
fsav,
integer, dimension(*) npf,
tf,
fncont,
integer, dimension(2,*) iad_elem,
integer, dimension(*) fr_elem,
integer, dimension(*) nodnx_sms,
dmint2,
pdama2,
integer nb_fri2m,
integer, dimension(*) fr_loci2m,
dt2t,
integer neltst,
integer ityptst,
type(intbuf_struct_), dimension(*) intbuf_tab,
temp,
mcp,
fthe,
condn,
type (glob_therm_), intent(inout) glob_therm,
type (h3d_database) h3d_data,
t2fac_sms,
fncontp,
ftcontp )

Definition at line 47 of file intti1.F.

58C-----------------------------------------------
59C M o d u l e s
60C-----------------------------------------------
61 USE intbufdef_mod
62 USE h3d_mod
63 use glob_therm_mod
64 USE my_alloc_mod
65 USE nodal_arrays_mod, ONLY : nodal_arrays_
66C-----------------------------------------------
67C I m p l i c i t T y p e s
68C-----------------------------------------------
69#include "implicit_f.inc"
70C-----------------------------------------------
71C C o m m o n B l o c k s
72C-----------------------------------------------
73#include "com01_c.inc"
74#include "com04_c.inc"
75#include "com09_c.inc"
76#include "param_c.inc"
77#include "task_c.inc"
78#include "parit_c.inc"
79#include "scr18_c.inc"
80#include "spmd_c.inc"
81#include "sms_c.inc"
82C-----------------------------------------------
83C D u m m y A r g u m e n t s
84C-----------------------------------------------
85 type(nodal_arrays_) :: nodes
86 INTEGER IPARI(NPARI,*), WEIGHT(*), FR_I2M(*), IAD_I2M(*),
87 . ITAB(*),KHIE,ADDCNI2(*),PROCNI2(*),IADI2(*),IGEO(*),
88 . FR_NBCCI2(2,*),NPF(*),IAD_ELEM(2,*),FR_ELEM(*),
89 . NODNX_SMS(*),NB_FRI2M,FR_LOCI2M(*)
90 INTEGER I2MSCH,ILAGM,I2SIZE,NELTST,ITYPTST
91C REAL
92 my_real
93 . x(3,*), v(3,*), a(3,*), wa(*), ms(*),in(*),
94 . ar(3,*),vr(3,*),stifn(*),stifr(*),dmast,adm(*),skew(*),
95 . adi(*),bufgeo(*),fsav(nthvki,*),tf(*), fncont(3,*),
96 . dmint2(*),pdama2(*),dt2t,temp(*),fthe(*),condn(*),mcp(*),
97 . t2fac_sms(*),
98 . fncontp(3,*),ftcontp(3,*)
99
100 TYPE(INTBUF_STRUCT_) INTBUF_TAB(*)
101 TYPE (H3D_DATABASE) :: H3D_DATA
102 type (glob_therm_) ,intent(inout) :: glob_therm
103C-----------------------------------------------
104C L o c a l V a r i a b l e s
105C-----------------------------------------------
106 INTEGER N, NTY, JI, JB, NMN, NINT, I2OK,
107 . LCOMI2M, I0, NIR, LENS, LENR, I, J, ILEV,
108 . K10, K11, K12, NSN, KSN,I25PENA,
109 . I2SIZETH,INTTH2, SIZE_INER_POFF,II
110 INTEGER,DIMENSION(:), ALLOCATABLE :: TAGNOD
111C REAL
112 my_real, DIMENSION(:,:),ALLOCATABLE :: fskyi2
113 my_real, DIMENSION(:),ALLOCATABLE :: ftheskyi2
114 my_real, DIMENSION(:),ALLOCATABLE :: condnskyi2
115 my_real, DIMENSION(:,:),ALLOCATABLE :: sav_for_pena
116 my_real, DIMENSION(:),ALLOCATABLE :: ms_pena,sav_iner_poff
117C=======================================================================
118 CALL my_alloc(tagnod,numnod)
119 CALL my_alloc(fskyi2,i2size,lcni2)
120 CALL my_alloc(ftheskyi2,lcni2)
121 CALL my_alloc(condnskyi2,lcni2)
122C-----------------------------------------------
123 i25pena=0
124 size_iner_poff = 0
125C
126 IF (iparit == 0)THEN
127 DO n=1,ninter
128 nty = ipari(7,n)
129 ilev = ipari(20,n)
130 IF (nty == 2) THEN
131 IF (ilev == 25) THEN
132 i25pena=max(i25pena,1)
133 ELSEIF (ilev == 26) THEN
134 i25pena=max(i25pena,2)
135 ELSEIF (ilev == 27 .or. ilev == 28) THEN
136 i25pena=max(i25pena,2)
137 ENDIF
138 IF (iroddl > 0) size_iner_poff = numnod
139 ENDIF
140 ENDDO
141C
142 IF (i25pena == 2) THEN
143 ALLOCATE(sav_for_pena(8,numnod))
144 sav_for_pena(1:8,1:numnod) = zero
145 ALLOCATE(ms_pena(numnod))
146 ms_pena(1:numnod) = ms(1:numnod)
147 ELSEIF (i25pena == 1) THEN
148 ALLOCATE(sav_for_pena(4,numnod))
149 sav_for_pena(1:4,1:numnod) = zero
150 ALLOCATE(ms_pena(numnod))
151 ms_pena(1:numnod) = ms(1:numnod)
152 ELSE
153 ALLOCATE(sav_for_pena(8,0))
154 ALLOCATE(ms_pena(0))
155 ENDIF
156C
157C-- For parithoff inertia of main and secondary node must be saved
158 ALLOCATE(sav_iner_poff(size_iner_poff))
159 IF (size_iner_poff>0) sav_iner_poff(1:numnod) = in(1:numnod)
160C
161 ENDIF
162C
163C rupture flag calculation for interface type 2 user
164 DO n=1,ninter
165 nty = ipari(7,n)
166 ilev = ipari(20,n)
167 IF (nty == 2 .AND. ilev >= 10 .AND. ilev < 23) THEN
168 ji =ipari(1,n)
169 jb =ipari(2,n)
170 CALL int2rupt(
171 . ipari(1,n),ms ,in ,
172 . x ,v ,a ,stifn ,igeo ,
173 . weight ,fsav(1,n),ilev ,npf ,tf ,
174 . itab ,fncont ,pdama2 ,intbuf_tab(n),h3d_data,
175 . fncontp ,ftcontp )
176 ENDIF
177 ENDDO
178C
179C POF PUFF PB CORRECTION SI MAN IN PROWS TYPE2 Interfaces
180 IF (iparit == 0) THEN
181 IF (nhin2 == 0) THEN
182 DO n=1,ninter
183 nty =ipari(7,n)
184 IF (ipari(26,n) == khie) THEN
185 ji=ipari(1,n)
186 jb=ipari(2,n)
187 nmn =ipari(6,n)
188 nint=n
189 ilagm = ipari(33,n)
190 IF (nty == 2 .AND. ilagm == 0)THEN
191 CALL int2poff(
192 . ipari(1,n) ,x ,v ,
193 . a ,vr ,ar ,ms ,in ,
194 . weight ,stifn ,stifr ,mcp ,condn ,
195 . fthe ,intbuf_tab(n) ,glob_therm%ITHERM_FE,glob_therm%NODADT_THERM)
196 ENDIF
197 ENDIF
198 ENDDO
199 ELSE
200 tagnod=0
201 DO n=1,ninter
202 nty = ipari(7,n)
203 IF (ipari(26,n) == khie) THEN
204 ji=ipari(1,n)
205 jb=ipari(2,n)
206 nmn =ipari(6,n)
207 nint=n
208 ilagm = ipari(33,n)
209 IF (nty == 2 .AND. ilagm == 0) THEN
210 CALL int2poffh(
211 . ipari(1,n),x ,v ,
212 . a ,vr ,ar ,ms ,in ,
213 . weight ,stifn ,stifr ,tagnod,intbuf_tab(n))
214 ENDIF
215 ENDIF
216 ENDDO
217 ENDIF
218 ELSEIF (iparit /= 0) THEN
219 DO i=1,lcni2
220 DO j=1,i2size
221 fskyi2(j,i)=zero
222 END DO
223 END DO
224 ENDIF
225C
226 IF (iparit /= 0 .AND. glob_therm%INTHEAT /= 0)THEN
227 DO i=1,lcni2
228 ftheskyi2(i)=zero
229 END DO
230 IF (glob_therm%IDT_THERM == 1) THEN
231 DO i=1,lcni2
232 condnskyi2(i)=zero
233 ENDDO
234 ENDIF
235 ENDIF
236C
237 i2ok = 0
238 i2msch=0
239 i0 = 0
240 nir=2
241 IF(n2d == 0)nir=4
242 ksn=1
243 intth2 = 0
244C---
245 DO n=1,ninter
246 nty = ipari(7,n)
247 IF (ipari(26,n) == khie) THEN
248 ji=ipari(1,n)
249 jb=ipari(2,n)
250 nsn =ipari(5,n)
251 nmn =ipari(6,n)
252 ilev=ipari(20,n)
253 nint=n
254 ilagm = ipari(33,n)
255 IF(nty == 2 .AND. ilagm == 0)THEN
256 i2ok=1
257 IF (ilev == 0.OR.ilev == 1.OR.ilev == 3.OR.ilev == 27.OR.ilev == 28) i2msch = 1
258 IF (ilev==25.OR.ilev==26.OR.ilev==27.OR.ilev==28) i7kglo=1
259 ! Optimization :
260 ! If NSN=0, some variables are loaded in INTTI2F (NRTS,...)
261 ! if the number of TYPE2 interface is important (>3000) and if the number of
262 ! spmd domain is quite important (NSPMD>50), the initialisation time is important :
263 ! for_array_copy_in and other initialisations represent up to 5% of total CPUTIME
264 ! and break the scalability of the code
265 IF((nsn>0)) THEN
266 CALL intti2f(
267 1 ipari(1,n),x ,v ,a ,
268 2 vr ,ar ,ms ,in ,weight ,stifn ,
269 3 stifr ,fskyi2 ,iadi2 ,i2msch ,dmast ,adm ,
270 4 i0 ,nir ,i2size ,adi ,igeo ,bufgeo ,
271 5 fsav(1,n) ,fncont ,nodnx_sms,dmint2(ksn) ,sav_for_pena,
272 6 ms_pena ,dt2t ,neltst ,ityptst ,intbuf_tab(n),temp,
273 7 fthe ,ftheskyi2,condn ,condnskyi2,itab,
274 8 sav_iner_poff ,h3d_data,t2fac_sms,fncontp ,
275 a ftcontp,glob_therm%IDT_THERM ,glob_therm%THEACCFACT)
276 ELSE
277 ! WARNING : if NSN==0 and ILEV==2 or 4, ones needs to save the mass
278 ilev = ipari(20,n)
279 IF(ilev==2.OR.ilev==4) THEN
280 DO ii=1,nmn
281 j=intbuf_tab(n)%MSR(ii)
282 intbuf_tab(n)%NMAS(ii) = ms(j)
283 ENDDO
284 ENDIF
285 ENDIF
286 IF (ilev==25 .or. ilev==26 .or. ilev==27 .or. ilev==28) ksn=ksn+4*nsn
287 ELSEIF(nty == 12)THEN
288 IF(ispmd == 0)THEN
289 CALL intti12f(
290 . ipari(1,n),intbuf_tab(n) ,x ,v ,
291 . a ,ms ,itab ,weight ,stifn,wa,skew )
292 ENDIF
293 ENDIF
294 ELSEIF(iparit > 0)THEN
295 ilagm = ipari(33,n)
296 IF(ipari(26,n) /= khie.AND.nty == 2.AND.ilagm == 0)THEN
297 k10=ipari(1,n)
298 k11=k10+4*ipari(3,n)
299 k12=k11+4*ipari(4,n)
300 CALL i2skip(ipari(5,n) ,intbuf_tab(n)%NSV ,weight ,i0 )
301 ENDIF
302 ENDIF
303 IF(nty == 2 .AND. ipari(47,n)> 0)THEN
304 intth2 = 1
305 ENDIF
306 ENDDO
307 IF (intth2 == 1) THEN
308 i2sizeth = i2size + 1
309 IF (glob_therm%IDT_THERM == 1) i2sizeth = i2sizeth + 1
310 ELSE
311 i2sizeth = i2size
312 ENDIF
313C------------------------------------------------------------
314 IF (i2ok == 1) THEN
315C spmd version with more than one proc: sum a and ar on main nodes
316 IF (iparit == 0.AND.nspmd > 1) THEN
317 IF(nhin2 == 0) THEN
318 lcomi2m = iad_i2m(nspmd+1)
319 IF(idtmins/=0)THEN
320 CALL spmd_exch_a_int2_ams(
321 . a ,ar ,ms ,in ,stifn,
322 . stifr,fr_i2m,iad_i2m,lcomi2m,i2sizeth,
323 . nb_fri2m,fr_loci2m,intth2,fthe,condn,
324 . fncont,fncontp,ftcontp,h3d_data,glob_therm%IDT_THERM)
325 ELSE
326 CALL spmd_exch_a_int2(
327 . a ,ar ,ms ,in ,stifn,
328 . stifr,fr_i2m,iad_i2m,lcomi2m,i2sizeth,
329 . intth2,fthe ,condn ,fncont ,fncontp ,
330 . ftcontp,h3d_data ,glob_therm%IDT_THERM)
331 ENDIF
332 ELSE
333 lcomi2m = iad_i2m(nspmd+1)
334 IF(idtmins/=0)THEN
335 CALL spmd_exch_a_int2h_ams(
336 . a ,ar ,ms ,in ,stifn,
337 . stifr,fr_i2m,iad_i2m,lcomi2m,i2sizeth,
338 . nb_fri2m,fr_loci2m,tagnod,intth2,fthe,
339 . condn,fncont,fncontp,ftcontp,h3d_data ,glob_therm%IDT_THERM)
340 ELSE
341 CALL spmd_exch_a_int2h(
342 . a ,ar ,ms ,in ,stifn,
343 . stifr,fr_i2m,iad_i2m,lcomi2m,i2sizeth,
344 . tagnod,intth2,fthe ,condn ,fncont ,
345 . fncontp,ftcontp,h3d_data ,glob_therm%IDT_THERM)
346 ENDIF
347 END IF
348 ELSEIF (iparit > 0) THEN
349C version spmd p/on
350 IF (nspmd > 1) THEN
351 lens = fr_nbcci2(1,nspmd+1)
352 lenr = fr_nbcci2(2,nspmd+1)
353 lcomi2m = iad_i2m(nspmd+1)
354 CALL spmd_exch_a_int2_pon(
355 1 fr_i2m ,iad_i2m,addcni2,procni2,fr_nbcci2,
356 2 i2sizeth,lenr ,lens ,fskyi2 ,intth2 ,
357 3 ftheskyi2,condnskyi2 ,i2size,lcomi2m,fncont,
358 4 fncontp,ftcontp,h3d_data ,glob_therm%IDT_THERM)
359 END IF
360C
361C Routine assemblage parith/ON
362C
363C Rare case where type2 interfaces are defined with no more active second nodes
364 IF(i2nsnt > 0)
365 * CALL asspari2(nodes%NUMNOD0,
366 1 a ,ar ,stifn ,stifr ,ms ,
367 2 in ,fskyi2,i2size,addcni2,addcni2(numnod+2),
368 3 ftheskyi2, fthe ,condnskyi2,condn,glob_therm)
369 ENDIF
370 ENDIF
371C
372 IF (i25pena > 0 .AND. i2nsnt>0)THEN
373 DO i=1,numnod
374 a(1,i)=a(1,i)+sav_for_pena(1,i)
375 a(2,i)=a(2,i)+sav_for_pena(2,i)
376 a(3,i)=a(3,i)+sav_for_pena(3,i)
377 stifn(i) = stifn(i) + sav_for_pena(4,i)
378 ENDDO
379 IF (i25pena == 2 .and. iroddl == 1)THEN
380 DO i=1,numnod
381 ar(1,i)=ar(1,i)+sav_for_pena(5,i)
382 ar(2,i)=ar(2,i)+sav_for_pena(6,i)
383 ar(3,i)=ar(3,i)+sav_for_pena(7,i)
384 stifr(i) = stifr(i) + sav_for_pena(8,i)
385 ENDDO
386 ENDIF
387 DEALLOCATE(sav_for_pena)
388 DEALLOCATE(ms_pena)
389 ENDIF
390C
391 DEALLOCATE(tagnod)
392 DEALLOCATE(fskyi2)
393 DEALLOCATE(ftheskyi2)
394 DEALLOCATE(condnskyi2)
395C
396 RETURN
asspari2
subroutine asspari2(initial_numnod, a, ar, stifn, stifr, ms, in, fskyi2, i2size, addcni2, indsky, ftheskyi2, fthe, condnskyi2, condn, glob_therm)
Definition asspar4.F:1016
my_real
#define my_real
Definition cppsort.cpp:32
i2skip
subroutine i2skip(nsn, nsv, weight, i0)
Definition i2for3p.F:1634
int2poff
subroutine int2poff(ipari, x, v, a, vr, ar, ms, in, weight, stifn, stifr, mcp, condn, fthe, intbuf_tab, itherm_fe, nodadt_therm)
Definition int2poff.F:36
int2poffh
subroutine int2poffh(ipari, x, v, a, vr, ar, ms, in, weight, stifn, stifr, tagnod, intbuf_tab)
Definition int2poff.F:107
int2rupt
subroutine int2rupt(ipari, ms, in, x, v, a, stifn, igeo, weight, fsav, ilev, npf, tf, itab, fncont, pdama2, intbuf_tab, h3d_data, fncontp, ftcontp)
Definition int2rupt.F:38
intti12f
subroutine intti12f(ipari, intbuf_tab, x, v, a, ms, itab, weight, stifn, wa, skew)
Definition intti12.F:243
intti2f
subroutine intti2f(ipari, x, v, a, vr, ar, ms, in, weight, stifn, stifr, fskyi2, iadi2, i2msch, dmast, adm, i0, nir, i2size, adi, igeo, bufgeo, fsav, fncont, nodnx_sms, dmint2, sav_for_pena, ms_pena, dt2t, neltst, ityptst, intbuf_tab, temp, fthe, ftheskyi2, condn, condnskyi2, itab, sav_iner_poff, h3d_data, t2fac_sms, fncontp, ftcontp, idt_therm, theaccfact)
Definition intti2f.F:70
max
#define max(a, b)
Definition macros.h:21
h3d_mod
Definition h3d_mod.F:311
spmd_exch_a_int2
subroutine spmd_exch_a_int2(a, ar, ms, in, stifn, stifr, fr_i2m, iad_i2m, lcomi2m, isize, intth2, fthe, condn, fncont, fncontp, ftcontp, h3d_data, idt_therm)
Definition spmd_exch_a_int2.F:38
spmd_exch_a_int2_ams
subroutine spmd_exch_a_int2_ams(a, ar, ms, in, stifn, stifr, fr_i2m, iad_i2m, lcomi2m, isize, nb_fri2m, fr_loci2m, intth2, fthe, condn, fncont, fncontp, ftcontp, h3d_data, idt_therm)
Definition spmd_exch_a_int2_ams.F:38
spmd_exch_a_int2_pon
subroutine spmd_exch_a_int2_pon(fr_i2m, iad_i2m, addcni2, procni2, fr_nbcci2, i2size, lenr, lens, fskyi2, intth2, ftheskyi2, condnskyi2, i2sizemec, lcomi2m, fncont, fncontp, ftcontp, h3d_data, idt_therm)
Definition spmd_exch_a_int2_pon.F:38
spmd_exch_a_int2h
subroutine spmd_exch_a_int2h(a, ar, ms, in, stifn, stifr, fr_i2m, iad_i2m, lcomi2m, isize, tagnod, intth2, fthe, condn, fncont, fncontp, ftcontp, h3d_data, idt_therm)
Definition spmd_exch_a_int2h.F:37
spmd_exch_a_int2h_ams
subroutine spmd_exch_a_int2h_ams(a, ar, ms, in, stifn, stifr, fr_i2m, iad_i2m, lcomi2m, isize, nb_fri2m, fr_loci2m, tagnod, intth2, fthe, condn, fncont, fncontp, ftcontp, h3d_data, idt_therm)
Definition spmd_exch_a_int2h_ams.F:38
tagnod
subroutine tagnod(ix, nix, nix1, nix2, numel, iparte, tagbuf, npart)
Definition tagnod.F:29