OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
inint2.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!|| inint2 ../starter/source/interfaces/inter2d1/inint2.F
25!||--- called by ------------------------------------------------------
26!|| inintr ../starter/source/interfaces/interf1/inintr.F
27!||--- calls -----------------------------------------------------
28!|| ancmsg ../starter/source/output/message/message.F
29!|| i1bcs_check ../starter/source/interfaces/int01/i1bcs_check.F90
30!|| i1chk2 ../starter/source/interfaces/inter2d1/i1chk2.F
31!|| i1tid2 ../starter/source/interfaces/inter2d1/i1tid2.f
32!|| i2main ../starter/source/interfaces/interf1/i2master.F
33!|| i3pen2 ../starter/source/interfaces/inter2d1/i3pen2.F
34!|| i3sti2 ../starter/source/interfaces/inter2d1/i3sti2.f
35!|| i9bcs_check ../starter/source/interfaces/int09/i9bcs_check.F90
36!|| i9sti2 ../starter/source/interfaces/int09/i9sti2.F
37!|| inint0 ../starter/source/interfaces/interf1/inint0.f
38!|| invoi2 ../starter/source/interfaces/inter2d1/invoi2.F
39!||--- uses -----------------------------------------------------
40!|| i1bcs_check_mod ../starter/source/interfaces/int01/i1bcs_check.F90
41!|| i9bcs_check_mod ../starter/source/interfaces/int09/i9bcs_check.F90
42!|| message_mod ../starter/share/message_module/message_mod.F
43!||====================================================================
44 SUBROUTINE inint2(INTBUF_TAB ,INSCR ,X ,IXQ ,SINSCR ,
45 . PM ,GEO ,IPARI ,NINT ,ITAB ,
46 . ITABM1 ,NUMNOD ,IKINE ,MWA ,IPM ,
47 . ID ,TITR ,KNOD2ELQ ,NOD2ELQ ,SEGQUADFR,
48 . NUMMAT ,NINTER ,SITAB ,SITABM1 ,SICODE ,
49 . ICODE)
50C-----------------------------------------------
51C D e s c r i p t i o n
52C-----------------------------------------------
53C Interfaces initialization for 2D analysis (N2D>0)
54C-----------------------------------------------
55C M o d u l e s
56C-----------------------------------------------
57 USE message_mod
58 USE intbufdef_mod
59 USE i9bcs_check_mod , ONLY : i9bcs_check
60 use i1bcs_check_mod , only : i1bcs_check
61 USE names_and_titles_mod , ONLY : nchartitle
62C-----------------------------------------------
63C I m p l i c i t T y p e s
64C-----------------------------------------------
65#include "implicit_f.inc"
66C-----------------------------------------------
67C C o m m o n B l o c k s
68C-----------------------------------------------
69#include "units_c.inc"
70#include "scr03_c.inc"
71#include "param_c.inc"
72C-----------------------------------------------
73C D u m m y A r g u m e n t s
74C-----------------------------------------------
75 INTEGER,INTENT(IN) :: SITAB, SITABM1 !< array sizes
76 INTEGER,INTENT(IN) :: SICODE !< array size ICODE
77 INTEGER,INTENT(IN) :: ICODE(SICODE) !< boundary condition code for each node
78 INTEGER,INTENT(IN) :: NUMMAT,NINTER,SINSCR !< array sizes
79 INTEGER NINT, NUMNOD
80 INTEGER INSCR(*), IXQ(*), IPARI(NPARI), ITAB(SITAB),
81 . itabm1(sitabm1), ikine(*), mwa(*),ipm(npropmi,nummat),
82 . knod2elq(*),nod2elq(*),segquadfr(2,*)
83 my_real x(*), pm(npropm, nummat), geo(*)
84 INTEGER ID
85 CHARACTER(LEN=NCHARTITLE) :: TITR
86 TYPE(INTBUF_STRUCT_) INTBUF_TAB
87C-----------------------------------------------
88C L o c a l V a r i a b l e s
89C-----------------------------------------------
90 INTEGER NRTS, NRTM, NSN, NMN, NTY, NST, NMT, NOINT, K10, K11, K12,
91 . k13, k14, kfi, j10, j11, j12, jfi, k16, k21, k23, j20, l17,
92 . l20, l22, j21, j22, l16, l21, l23, k15, k17, k18, k19, k20,
93 . k22, j13, j14, j15, j16, j17, j18, j19, iwpene, k24, k25,k48,
94 . ibidon,i
95C-----------------------------------------------
96C S o u r c e L i n e s
97C-----------------------------------------------
98 iwpene = 0
99 nrts = ipari(3)
100 nrtm = ipari(4)
101 nsn = ipari(5)
102 nmn = ipari(6)
103 nty = ipari(7)
104 nst = ipari(8)
105 nmt = ipari(9)
106 noint = ipari(15)
107C
108 noint=nint
109 WRITE(iout,2100)noint,nty,nrts,nrtm,nsn,nmn
110 k10=1
111 k11=k10+4*nrts
112 k12=k11+4*nrtm
113 k13=k12+nsn
114 k14=k13+nmn
115 kfi=k14+nsn
116 j10=1
117 j11=j10+1
118 j12=j11+nparir
119 jfi=j12+2*nsn
120C
121 IF(nty == 1)THEN
122 k16=kfi
123 k21=k16+nsn
124 k23=k21+1+nmn
125 j20=jfi
126 l17=1
127 l20=l17+nmn
128 l22=l20+1+nsn
129 !must be flushed to 0 (in old code INBUF and BUFIN
130 !flushed between 2 domain decomposition (otherwise ININT0 subroutine does not store the expected segments)
131 intbuf_tab%NRT(1:nmt) = 0
132 CALL inint0(x,intbuf_tab%IRECTM,intbuf_tab%NSEGM,intbuf_tab%NRT,intbuf_tab%MSR,
133 1 intbuf_tab%NSV,intbuf_tab%ILOCS,nsn,nmn,nrtm,intbuf_tab%S_IRECTM, intbuf_tab%S_NRT)
134 CALL i1chk2(x,intbuf_tab%IRECTS,ixq,nrts, nint,
135 1 nsn,intbuf_tab%NSV,noint,id,titr)
136 CALL i1chk2(x,intbuf_tab%IRECTM,ixq,nrtm,-nint,
137 1 nmn,intbuf_tab%MSR,noint,id,titr)
138 CALL invoi2(x,intbuf_tab%IRECTM,intbuf_tab%NRT,intbuf_tab%MSR,intbuf_tab%NSV,
139 1 intbuf_tab%ILOCS,intbuf_tab%IRTLM,intbuf_tab%NSEGM,nsn,nrtm)
140 WRITE(iout,2200)
141 CALL i1tid2(x, intbuf_tab%IRECTM, intbuf_tab%CSTS, intbuf_tab%MSR, intbuf_tab%NSV,
142 1 intbuf_tab%ILOCS, intbuf_tab%IRTLM, nsn, itab ,id, titr, numnod)
143 CALL i1bcs_check(icode, sicode, nsn, intbuf_tab%NSV, sitab, itab, noint, titr, nty)
144
145 ELSEIF(nty == 2)THEN
146 j21=jfi
147 j22=j21+3*max0(nsn,nmn)
148 l16=1
149 l17=l16+nsn
150 l20=l17+nmn
151 l21=l20+1+nsn
152 l22=l21+1+nmn
153 l23=l22+nst
154 k48 = kfi
155 CALL inint0(x,intbuf_tab%IRECTM,inscr(l21),inscr(l23),intbuf_tab%MSR,
156 1 intbuf_tab%NSV,inscr(l16),nsn,nmn,nrtm,intbuf_tab%S_IRECTM, sinscr-l23+1)
157 CALL i1chk2(x,intbuf_tab%IRECTS,ixq,nrts, nint,
158 1 nsn,intbuf_tab%NSV,noint,id,titr)
159 CALL i1chk2(x,intbuf_tab%IRECTM,ixq,nrtm,-nint,
160 1 nmn,intbuf_tab%MSR,noint,id,titr)
161
162 CALL invoi2(x,intbuf_tab%IRECTM,inscr(l23),intbuf_tab%MSR,intbuf_tab%NSV,
163 1 inscr(l16),intbuf_tab%IRTLM,inscr(l21),nsn,nrtm)
164 WRITE(iout,2200)
165 CALL i1tid2(x,intbuf_tab%IRECTM,intbuf_tab%CSTS,intbuf_tab%MSR,intbuf_tab%NSV,
166 1 inscr(l16), intbuf_tab%IRTLM, nsn, itab ,id, titr, numnod)
167C Projection on edges is used only for the distribution of masses and inertia to avoid negative masses / inertia on MAIN nodes
168 DO i=1,nsn
169 intbuf_tab%CSTS_BIS(2*(i-1)+1)=min(one,max(-1*one,intbuf_tab%CSTS(2*(i-1)+1)))
170 intbuf_tab%CSTS_BIS(2*(i-1)+2)=intbuf_tab%CSTS(2*(i-1)+2)
171 ENDDO
172C selecting relevant main nodes and recompating interface buffer
173 CALL i2main(intbuf_tab%NSV,intbuf_tab%MSR,intbuf_tab%IRECTM,ipari,
174 . mwa,mwa(numnod+1),intbuf_tab)
175
176 ELSEIF(nty == 3)THEN
177 k15=kfi
178 k16=k15+nmn
179 k17=k16+nsn
180 k18=k17+nmn
181 k19=k18+nsn
182 k20=k19+nmn
183 k21=k20+1+nsn
184 k22=k21+1+nmn
185 k23=k22+nst
186 j13=jfi
187 j14=j13+2*nmn
188 j15=j14+nsn
189 j16=j15+nmn
190 j17=j16+nrts
191 j18=j17+nrtm
192 j19=j18+3*nsn
193
194 !must be flushed to 0 (in old code INBUF and BUFIN
195 !flushed between 2 domain decomposition
196 intbuf_tab%LNSV(1:nst) = 0
197 intbuf_tab%LMSR(1:nmt) = 0
198 intbuf_tab%STFNS(1:nsn) = 0
199 intbuf_tab%STFNM(1:nmn) = 0
200
201 CALL inint0(x,intbuf_tab%IRECTS,intbuf_tab%NSEGS,intbuf_tab%LNSV,intbuf_tab%NSV,
202 1 intbuf_tab%MSR,intbuf_tab%ILOCM,nmn,nsn,nrts,intbuf_tab%S_IRECTS,intbuf_tab%S_LNSV)
203 CALL inint0(x,intbuf_tab%IRECTM,intbuf_tab%NSEGM,intbuf_tab%LMSR,intbuf_tab%MSR,
204 1 intbuf_tab%NSV,intbuf_tab%ILOCS,nsn,nmn,nrtm,intbuf_tab%S_IRECTM,intbuf_tab%S_LMSR)
205 CALL i3sti2(
206 1 x ,intbuf_tab%IRECTS,intbuf_tab%STFS,ixq ,pm ,
207 2 nrts ,intbuf_tab%STFNS,intbuf_tab%NSEGS,intbuf_tab%LNSV,nint ,
208 3 nsn ,intbuf_tab%NSV,intbuf_tab%STFAC ,noint ,ipm ,
209 4 id ,titr ,intbuf_tab%AREAS ,knod2elq ,nod2elq ,
210 5 nty ,ibidon ,ibidon ,segquadfr )
211 CALL i3sti2(
212 1 x ,intbuf_tab%IRECTM,intbuf_tab%STFM,ixq ,pm ,
213 2 nrtm ,intbuf_tab%STFNM,intbuf_tab%NSEGM,intbuf_tab%LMSR,-nint ,
214 3 nmn ,intbuf_tab%MSR,intbuf_tab%STFAC ,noint ,ipm ,
215 4 id ,titr ,intbuf_tab%AREAM ,knod2elq ,nod2elq ,
216 5 nty ,ibidon ,ibidon ,segquadfr )
217
218 CALL invoi2(x,intbuf_tab%IRECTM,intbuf_tab%LMSR,intbuf_tab%MSR,intbuf_tab%NSV,
219 1 intbuf_tab%ILOCS,intbuf_tab%IRTLM,intbuf_tab%NSEGM,nsn,nrtm)
220 CALL invoi2(x,intbuf_tab%IRECTS,intbuf_tab%LNSV,intbuf_tab%NSV,intbuf_tab%MSR,
221 1 intbuf_tab%ILOCM,intbuf_tab%IRTLS,intbuf_tab%NSEGS,nmn,nrts)
222 WRITE(iout,2200)
223 CALL i3pen2
224 1 (x ,intbuf_tab%IRECTM ,intbuf_tab%MSR,intbuf_tab%NSV,intbuf_tab%ILOCS,
225 2 intbuf_tab%IRTLM,nsn ,intbuf_tab%CSTS,intbuf_tab%IRTLOM,intbuf_tab%FRICOS,
226 3 intbuf_tab%VARIABLES(1),intbuf_tab%VARIABLES(2),iwpene,itab ,id,titr)
227 WRITE(iout,2300)
228 CALL i3pen2
229 1 (x ,intbuf_tab%IRECTS ,intbuf_tab%NSV,intbuf_tab%MSR,intbuf_tab%ILOCM,
230 2 intbuf_tab%IRTLS,nmn ,intbuf_tab%CSTM,intbuf_tab%IRTLOS,intbuf_tab%FRICOM,
231 3 intbuf_tab%VARIABLES(1),intbuf_tab%VARIABLES(2),iwpene,itab ,id,titr)
232
233 ELSEIF(nty == 5)THEN
234 k15=kfi
235 k16=k15+nmn
236 k17=k16+nsn
237 k18=k17+nmn
238 k19=k18+nsn
239 k20=k19+nmn
240 k21=k20+1+nsn
241 k22=k21+1+nmn
242 k23=k22+nst
243 j13=jfi
244 j14=j13+2*nmn
245 j15=j14+nsn
246 j16=j15+nmn
247 j17=j16+nrts
248 j18=j17+nrtm
249 j19=j18+3*nsn
250
251 !must be flushed to 0 (in old code INBUF and BUFIN
252 !flushed between 2 domain decomposition
253 intbuf_tab%LNSV(1:nst) = 0
254 intbuf_tab%LMSR(1:nmt) = 0
255 intbuf_tab%STFNM(1:nmn) = 0
256
257 CALL inint0(x,intbuf_tab%IRECTM,intbuf_tab%NSEGM,intbuf_tab%LMSR,intbuf_tab%MSR,
258 1 intbuf_tab%NSV,intbuf_tab%ILOCS,nsn,nmn,nrtm,intbuf_tab%S_IRECTM, intbuf_tab%S_LMSR)
259 CALL i3sti2(
260 1 x ,intbuf_tab%IRECTM,intbuf_tab%STFM,ixq ,pm ,
261 2 nrtm ,intbuf_tab%STFNM,intbuf_tab%NSEGM,intbuf_tab%LMSR,-nint ,
262 3 nmn ,intbuf_tab%MSR,intbuf_tab%STFAC ,noint ,ipm ,
263 4 id ,titr ,intbuf_tab%AREAS ,knod2elq ,nod2elq ,
264 5 nty ,nsn ,intbuf_tab%NSV ,segquadfr )
265 CALL invoi2(x,intbuf_tab%IRECTM,intbuf_tab%LMSR,intbuf_tab%MSR,intbuf_tab%NSV,
266 1 intbuf_tab%ILOCS,intbuf_tab%IRTLM,intbuf_tab%NSEGM,nsn,nrtm)
267 WRITE(iout,2200)
268 CALL i3pen2
269 1 (x ,intbuf_tab%IRECTM ,intbuf_tab%MSR,intbuf_tab%NSV,intbuf_tab%ILOCS,
270 2 intbuf_tab%IRTLM,nsn ,intbuf_tab%CSTS,intbuf_tab%IRTLOM,intbuf_tab%FRICOS,
271 3 intbuf_tab%VARIABLES(1),intbuf_tab%VARIABLES(2),iwpene,itab ,id,titr)
272
273 ELSEIF(nty == 9)THEN
274 k15=kfi
275 k16=k15+nmn
276 k17=k16+nsn
277 k18=k17+nmn
278 k19=k18+nsn
279 k20=k19+nmn
280 k21=k20+1+nsn
281 k22=k21+1+nmn
282 k23=k22+nst
283 k24=k23+nmt
284 k25=k24+nrts
285 j13=jfi
286 j14=j13+2*nmn
287 j15=j14+nsn
288 j16=j15+nmn
289 j17=j16+nrts
290 j18=j17+nrtm
291 j19=j18+3*nsn
292
293 !must be flushed to 0 (in old code INBUF and BUFIN
294 !flushed between 2 domain decomposition
295 intbuf_tab%LNSV(1:nst) = 0
296 intbuf_tab%LMSR(1:nmt) = 0
297 intbuf_tab%STFNS(1:nsn)= 0
298 intbuf_tab%STFNM(1:nmn)= 0
299
300 CALL inint0(x,intbuf_tab%IRECTS,intbuf_tab%NSEGS,intbuf_tab%LNSV,intbuf_tab%NSV,
301 1 intbuf_tab%MSR,intbuf_tab%ILOCM,nmn,nsn,nrts,intbuf_tab%S_IRECTS ,intbuf_tab%S_LNSV)
302 CALL inint0(x,intbuf_tab%IRECTM,intbuf_tab%NSEGM,intbuf_tab%LMSR,intbuf_tab%MSR,
303 1 intbuf_tab%NSV,intbuf_tab%ILOCS,nsn,nmn,nrtm,intbuf_tab%S_IRECTM ,intbuf_tab%S_LMSR)
304 CALL i9sti2(
305 1 x ,intbuf_tab%IRECTS, ixq ,
306 2 nrts ,nint ,
307 3 nsn ,intbuf_tab%NSV, noint ,intbuf_tab%IELES,
308 4 id ,titr)
309 CALL i9sti2(
310 1 x ,intbuf_tab%IRECTS, ixq ,
311 2 nrtm ,-nint ,
312 3 nmn ,intbuf_tab%MSR, noint ,intbuf_tab%IELEM,
313 4 id ,titr)
314 CALL invoi2(x,intbuf_tab%IRECTM,intbuf_tab%LMSR,intbuf_tab%MSR,intbuf_tab%NSV,
315 1 intbuf_tab%ILOCS,intbuf_tab%IRTLM,intbuf_tab%NSEGM,nsn,nrtm)
316 CALL invoi2(x,intbuf_tab%IRECTS,intbuf_tab%LNSV,intbuf_tab%NSV,intbuf_tab%MSR,
317 1 intbuf_tab%ILOCM,intbuf_tab%IRTLS,intbuf_tab%NSEGS,nmn,nrts)
318 IF(nmn>0)THEN
319 WRITE(iout,2200)
320 CALL i3pen2
321 1 (x ,intbuf_tab%IRECTM ,intbuf_tab%MSR,intbuf_tab%NSV,intbuf_tab%ILOCS,
322 2 intbuf_tab%IRTLM,nsn ,intbuf_tab%CSTS,intbuf_tab%IRTLOM,intbuf_tab%FRICOS,
323 3 intbuf_tab%VARIABLES(1),intbuf_tab%VARIABLES(2),iwpene,itab ,id,titr)
324 WRITE(iout,2300)
325 CALL i3pen2
326 1 (x ,intbuf_tab%IRECTS ,intbuf_tab%NSV,intbuf_tab%MSR,intbuf_tab%ILOCM,
327 2 intbuf_tab%IRTLS,nmn ,intbuf_tab%CSTM,intbuf_tab%IRTLOS,intbuf_tab%FRICOM,
328 3 intbuf_tab%VARIABLES(1),intbuf_tab%VARIABLES(2),iwpene,itab ,id,titr)
329 ENDIF
330 CALL i9bcs_check(icode, sicode, nsn, intbuf_tab%NSV, intbuf_tab%S_ILOCS, intbuf_tab%ILOCS )
331
332 ENDIF !NTY
333
334 IF(iwpene/=0) THEN
335 CALL ancmsg(msgid=342,msgtype=msgwarning,anmode=aninfo_blind_1,i1=id,c1=titr,i2=iwpene)
336 ENDIF
337C
338 RETURN
339
340 2100 FORMAT(//
341 . ,5x,'INTERFACE NUMBER. . . . . . . . . . . . . .',i8/
342 . ,5x,'SLIDE LINE TYPE . . . . . . . . . . . . . .',i5/
343 . ,5x,'NUMBER OF SECONDARY SEGMENTS . . . . . . .',i5/
344 . ,5x,'NUMBER OF MAIN SEGMENTS . . . . . . . . . .',i5/
345 . ,5x,'NUMBER OF SECONDARY NODES. . . . . . . . .',i5/
346 . ,5x,'NUMBER OF MAIN NODES. . . . . . . . . . . .',i5/)
347 2200 FORMAT(//' SECONDARY NEAREST NEAREST MAIN S '
348 . / ' NODE MAIN SEGMENT NODES ' )
349 2300 FORMAT(//' MAIN NEAREST NEAREST SECONDARY S '
350 . / ' NODE SECONDARY SEGMENT NODES ' )
351
352C-----------------------------------------------
353 END
my_real
#define my_real
Definition cppsort.cpp:32
i1chk2
subroutine i1chk2(x, irect, ixq, nrt, nint, nsn, nsv, noint, id, titr)
Definition i1chk2.F:35
i1tid2
subroutine i1tid2(x, irect, crst, msr, nsv, iloc, irtl, nsn, itab, id, titr, numnod)
Definition i1tid2.F:35
i2main
subroutine i2main(nsv, msr, irectm, ipari, tag, msru, intbuf_tab)
Definition i2master.F:33
i3pen2
subroutine i3pen2(x, irect, msr, nsv, iloc, irtl, nsn, cst, irtlo, fric0, fric, gap, iwpene, itab, id, titr)
Definition i3pen2.F:37
i3sti2
subroutine i3sti2(x, irect, stf, ixq, pm, nrt, stfn, nseg, lnsv, nint, nsn, nsv, slsfac, noint, ipm, id, titr, areas, knod2elq, nod2elq, nty, nsns, nsvs, segquadfr)
Definition i3sti2.F:43
i9sti2
subroutine i9sti2(x, irect, ixq, nrt, nint, nsn, nsv, noint, iele, id, titr)
Definition i9sti2.F:40
inint0
subroutine inint0(x, irect, nseg, nod2seg, nsv, msr, iloc, nmn, nsn, nrt, sirect, s_n2seg)
Definition inint0.F:32
inint2
subroutine inint2(intbuf_tab, inscr, x, ixq, sinscr, pm, geo, ipari, nint, itab, itabm1, numnod, ikine, mwa, ipm, id, titr, knod2elq, nod2elq, segquadfr, nummat, ninter, sitab, sitabm1, sicode, icode)
Definition inint2.F:50
min
#define min(a, b)
Definition macros.h:20
max
#define max(a, b)
Definition macros.h:21
message_mod
Definition message_mod.F:1257
names_and_titles_mod
Definition names_and_titles_mod.F:1002
names_and_titles_mod::nchartitle
integer, parameter nchartitle
Definition names_and_titles_mod.F:1008
invoi2
subroutine invoi2(x, irect, lmsr, msr, nsv, iloc, irtl, nseg, nsn, nrt)
Definition invoi2.F:30
ancmsg
subroutine ancmsg(msgid, msgtype, anmode, i1, i2, i3, i4, i5, i6, i7, i8, i9, i10, i11, i12, i13, i14, i15, i16, i17, i18, i19, i20, r1, r2, r3, r4, r5, r6, r7, r8, r9, c1, c2, c3, c4, c5, c6, c7, c8, c9, prmode)
Definition message.F:895
starter
program starter
Definition starter.F:39