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