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 (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 ( 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 46 of file intti1.F.

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