OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
intti1.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!|| intti1 ../engine/source/interfaces/interf/intti1.F
25!||--- called by ------------------------------------------------------
26!|| resol ../engine/source/engine/resol.F
27!||--- calls -----------------------------------------------------
28!|| asspari2 ../engine/source/assembly/asspar4.F
29!|| i2skip ../engine/source/interfaces/interf/i2for3p.F
30!|| int2poff ../engine/source/interfaces/interf/int2poff.F
31!|| int2poffh ../engine/source/interfaces/interf/int2poff.F
32!|| int2rupt ../engine/source/interfaces/interf/int2rupt.F
33!|| intti12f ../engine/source/interfaces/interf/intti12.F
34!|| intti2f ../engine/source/interfaces/interf/intti2f.F
35!|| spmd_exch_a_int2 ../engine/source/mpi/forces/spmd_exch_a_int2.F
36!|| spmd_exch_a_int2_ams ../engine/source/mpi/forces/spmd_exch_a_int2_ams.F
37!|| spmd_exch_a_int2_pon ../engine/source/mpi/forces/spmd_exch_a_int2_pon.F
38!|| spmd_exch_a_int2h ../engine/source/mpi/forces/spmd_exch_a_int2h.f
39!|| spmd_exch_a_int2h_ams ../engine/source/mpi/forces/spmd_exch_a_int2h_ams.F
40!||--- uses -----------------------------------------------------
41!|| glob_therm_mod ../common_source/modules/mat_elem/glob_therm_mod.F90
42!|| h3d_mod ../engine/share/modules/h3d_mod.F
43!|| intbufdef_mod ../common_source/modules/interfaces/intbufdef_mod.F90
44!|| my_alloc_mod ../common_source/tools/memory/my_alloc.F90
45!|| nodal_arrays_mod ../common_source/modules/nodal_arrays.F90
46!||====================================================================
47 SUBROUTINE intti1(NODES,
48 1 IPARI ,X ,V ,A ,
49 2 VR ,AR ,WA ,MS ,IN ,WEIGHT ,
50 3 STIFN ,STIFR ,KHIE ,ITAB ,FR_I2M ,IAD_I2M ,
51 4 ADDCNI2 ,PROCNI2 ,IADI2 ,I2MSCH ,DMAST ,ADM ,
52 5 SKEW ,I2SIZE ,FR_NBCCI2,ADI ,IGEO ,BUFGEO ,
53 6 FSAV ,NPF ,TF ,FNCONT ,IAD_ELEM ,FR_ELEM ,
54 7 NODNX_SMS,DMINT2 ,PDAMA2 ,NB_FRI2M,FR_LOCI2M,
55 8 DT2T ,NELTST ,ITYPTST ,INTBUF_TAB,TEMP ,MCP ,
56 9 FTHE ,CONDN ,GLOB_THERM,
57 A H3D_DATA ,T2FAC_SMS,FNCONTP ,FTCONTP)
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
397 END
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
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
intti1
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)
Definition intti1.F:58
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