OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
inintsub.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!|| inintsub ../starter/source/interfaces/interf1/inintsub.F
25!||--- called by ------------------------------------------------------
26!|| lectur ../starter/source/starter/lectur.F
27!||--- calls -----------------------------------------------------
28!|| bitset ../starter/source/interfaces/inter3d1/bitget.F
29!|| fretitl2 ../starter/source/starter/freform.F
30!|| inintsub_11 ../starter/source/output/subinterface/inintsub_11.F
31!|| inintsub_25 ../starter/source/output/subinterface/inintsub_25.F
32!|| inintsub_7 ../starter/source/output/subinterface/inintsub_7.F
33!||--- uses -----------------------------------------------------
34!|| message_mod ../starter/share/message_module/message_mod.F
35!||====================================================================
36 SUBROUTINE inintsub(ITAB ,IGRNOD ,IGRSURF ,
37 . IPARI ,MAXRTM ,NOM_OPT ,
38 . INTBUF_TAB,MAXRTMS,IGRSLIN ,
39 . MAXNSNE)
40C-----------------------------------------------
41C M o d u l e s
42C-----------------------------------------------
43 USE message_mod
44 USE intbufdef_mod
45 USE groupdef_mod
46 USE names_and_titles_mod , ONLY : nchartitle
47C-----------------------------------------------
48C I m p l i c i t T y p e s
49C-----------------------------------------------
50#include "implicit_f.inc"
51C-----------------------------------------------
52C C o m m o n B l o c k s
53C-----------------------------------------------
54#include "scr03_c.inc"
55#include "scr17_c.inc"
56#include "com04_c.inc"
57#include "units_c.inc"
58#include "param_c.inc"
59C-----------------------------------------------
60C D u m m y A r g u m e n t s
61C-----------------------------------------------
62 INTEGER ITAB(*),IPARI(NPARI,*)
63 INTEGER MAXRTM,MAXRTMS
64 INTEGER NOM_OPT(LNOPT1,*)
65 INTEGER ,INTENT(IN) :: MAXNSNE
66
67 TYPE(intbuf_struct_) INTBUF_TAB(*)
68C-----------------------------------------------
69C L o c a l V a r i a b l e s
70C-----------------------------------------------
71 INTEGER, DIMENSION(:), ALLOCATABLE :: NOD2NSV,NOD2RTM,NOD2RTMS,NOD2RTMM,KAD,TAGNOD,TAGRTM
72 INTEGER, DIMENSION(:), ALLOCATABLE :: TAGLINS,TAGLINM
73 TARGET NOD2NSV
74 INTEGER, DIMENSION(:), POINTER :: IADD
75 INTEGER IOK(NINTER)
76 INTEGER I,J,K,JGRN,ISU,ISU1,ISU2,
77 . ni,noint,nty,nrts,nrtm,nsn,nmn,multimp,ifq,nrtm_sh,nrtm0,
78 . nisub, nisubs, nisubm, jsub, ksub, nne, is, isv, cur,
79 . next, im, km, jad, in, ii, n,stat,k1,k2,nt19,inod,s_kad,nsne,nrtse
80 CHARACTER MESS*40
81 INTEGER ID,ID1
82 CHARACTER(LEN=NCHARTITLE) :: TITR,TITR1
83C-----------------------------------------------
84 TYPE (GROUP_) , DIMENSION(NGRNOD) :: IGRNOD
85 TYPE (SURF_) , DIMENSION(NSURF) :: IGRSURF
86 TYPE (SURF_) , DIMENSION(NSLIN) :: IGRSLIN
87C-----------------------------------------------
88C D a t a
89C-----------------------------------------------
90 DATA mess/'SUB-INTERFACES FOR TH INITIALIZATIONS '/
91C-----------------------------------------------
92C E x t e r n a l F u n c t i o n s
93C-----------------------------------------------
94 INTEGER BITSET
95 EXTERNAL BITSET
96C=======================================================================
97 ALLOCATE (nod2nsv(numnod+1) ,stat=stat)
98 ALLOCATE (nod2rtm(4*maxrtm) ,stat=stat)
99 ALLOCATE (nod2rtms(2*maxrtms) ,stat=stat)
100 ALLOCATE (nod2rtmm(2*maxrtms) ,stat=stat)
101 ALLOCATE (kad(max(numnod+maxnsne,maxrtm,maxrtms)),stat=stat)
102 ALLOCATE (tagnod(numnod) ,stat=stat)
103 ALLOCATE (tagrtm(maxrtm) ,stat=stat)
104 ALLOCATE (taglins(maxrtms) ,stat=stat)
105 ALLOCATE (taglinm(maxrtms) ,stat=stat)
106C
107 iadd => nod2nsv(1:numnod+1)
108 DO ni=1,ninter
109 nty =ipari(7,ni)
110 noint=ipari(15,ni)
111 nt19 =ipari(71,ni)
112 id=nom_opt(1,ni)
113C
114 CALL fretitl2(titr,nom_opt(lnopt1-ltitr+1,ni),ltitr)
115C
116C------------------------------------------
117C Interface type 25 + 24
118C------------------------------------------
119 IF (nty==25.OR.nty==24)THEN
120C
121 nrts =ipari(3,ni)
122 nrtm =ipari(4,ni)
123 nsn =ipari(5,ni)
124 nmn =ipari(6,ni)
125 multimp=ipari(23,ni)
126 ifq =ipari(31,ni)
127 nisub =ipari(36,ni)
128 nisubs =ipari(37,ni)
129 nisubm =ipari(38,ni)
130 nrtm_sh=ipari(42,ni)
131 nrtm0 =nrtm-nrtm_sh
132 nsne = 0
133 nrtse = 0
134 IF(nty==24) THEN
135 nsne = ipari(55,ni)
136 nrtse = ipari(55,ni)
137 ENDIF
138C
139 IF(nisub/=0)THEN
140 CALL inintsub_25(itab ,igrnod ,igrsurf ,nom_opt ,intbuf_tab,
141 . nrtm ,nrtm0 ,nsn ,nisubs ,nisubm ,
142 . noint ,ni ,nod2nsv ,nod2rtm ,kad ,
143 . tagnod ,tagrtm ,iadd ,nsne ,nty ,
144 . nrtse )
145 END IF
146
147C------------------------------------------
148C Interface type 7, 24
149C------------------------------------------
150 ELSEIF (nty==7.OR.nty==10.OR.nty==22)THEN
151C
152 nrts =ipari(3,ni)
153 nrtm =ipari(4,ni)
154 nsn =ipari(5,ni)
155 nmn =ipari(6,ni)
156 multimp=ipari(23,ni)
157 ifq =ipari(31,ni)
158 nisub =ipari(36,ni)
159 nisubs =ipari(37,ni)
160 nisubm =ipari(38,ni)
161 IF(nty == 24 ) THEN
162 nrtm_sh=ipari(42,ni)
163 nrtm0 =nrtm-nrtm_sh
164 ELSE
165 nrtm0 =nrtm
166 ENDIF
167C
168 IF(nisub/=0)THEN
169C
170 CALL inintsub_7 (itab ,igrnod ,igrsurf ,nom_opt ,intbuf_tab,
171 . nrtm ,nrtm0 ,nsn ,nisubs ,nisubm ,
172 . noint ,ni ,nod2nsv ,nod2rtm ,kad ,
173 . tagnod ,tagrtm ,iadd ,nt19 )
174C
175 END IF
176C
177C------------------------------------------
178C Interface type 11
179C------------------------------------------
180 ELSEIF (nty==11) THEN
181C interface type11 - subinterface input by lines
182C
183 nrts =ipari(3,ni)
184 nrtm =ipari(4,ni)
185 nsn =ipari(5,ni)
186 nmn =ipari(6,ni)
187 multimp=ipari(23,ni)
188 ifq =ipari(31,ni)
189 nisub =ipari(36,ni)
190 nisubs =ipari(37,ni)
191 nisubm =ipari(38,ni)
192C
193 IF(nisub/=0)THEN
194
195 CALL inintsub_11 (itab ,igrslin ,igrsurf ,nom_opt ,intbuf_tab,
196 . nrtm ,nrtm0 ,nsn ,nisubs ,nisubm ,
197 . noint ,ni ,nod2rtms,nod2rtmm ,kad ,
198 . taglins ,taglinm,iadd ,nt19 ,maxrtms ,
199 . nrts ,nty )
200
201 ENDIF
202C
203 END IF
204 END DO
205C-------------------------------------
206 IF(ipri<6) RETURN
207C
208 WRITE(iout,1000)
209 DO ni=1,ninter
210 nty = 0
211 IF (ipari(71,ni)==0) THEN
212 nty =ipari(7,ni)
213 ELSEIF (ipari(71,ni)==-1) THEN
214 nty = 19
215 ENDIF
216C
217 noint=ipari(15,ni)
218 IF (nty==7.OR.nty==10.OR.nty==22.OR.
219 . nty==24.OR.nty==25)THEN
220C
221 nrts =ipari(3,ni)
222 nrtm =ipari(4,ni)
223 nsn =ipari(5,ni)
224 nmn =ipari(6,ni)
225 multimp=ipari(23,ni)
226 ifq =ipari(31,ni)
227 nisub =ipari(36,ni)
228 nisubs =ipari(37,ni)
229 nisubm =ipari(38,ni)
230 IF(nisub/=0)THEN
231C
232C SUR LES ENTIERS ON ECONOMISE +- 2NSN+2NMN+NST / AUTRES TYPES
233C K14 = ELEMENTS CANDIDATES A L'IMPACT...
234C K15 = CANDIDATE NODES FOR IMPACT + ADDRESS OF CORRESPONDING ELEMENTS.
235C
236 WRITE(iout,1010)noint
237 WRITE(iout,'(10I10)')
238 . (nom_opt(1,ninter+intbuf_tab(ni)%LISUB(jsub)),jsub=1,nisub)
239 WRITE(iout,1030)
240 DO is=1,nsn
241 jsub=intbuf_tab(ni)%ADDSUBS(is)
242 n =intbuf_tab(ni)%ADDSUBS(is+1)-intbuf_tab(ni)%ADDSUBS(is)
243 IF(n>0)THEN
244 WRITE(iout,'(2I10)')is,itab(intbuf_tab(ni)%NSV(is))
245 WRITE(iout,'(20X,8I10)')
246 . (intbuf_tab(ni)%LISUBS(jsub-1+k),k=1,n)
247 END IF
248 END DO
249 WRITE(iout,1040)
250 DO im=1,nrtm
251 jsub=intbuf_tab(ni)%ADDSUBM(im)
252 n =intbuf_tab(ni)%ADDSUBM(im+1)-intbuf_tab(ni)%ADDSUBM(im)
253 IF(n>0)THEN
254 WRITE(iout,'(5I10)')im,
255 . (itab(intbuf_tab(ni)%IRECTM(4*(im-1)+j)),j=1,4)
256 WRITE(iout,'(50X,5I10)')
257 . (intbuf_tab(ni)%LISUBM(jsub-1+k),k=1,n)
258 END IF
259 END DO
260 END IF
261C
262 ELSEIF (nty==11)THEN
263C
264 nrts =ipari(3,ni)
265 nrtm =ipari(4,ni)
266 nsn =ipari(5,ni)
267 nmn =ipari(6,ni)
268 multimp=ipari(23,ni)
269 ifq =ipari(31,ni)
270 nisub =ipari(36,ni)
271 nisubs =ipari(37,ni)
272 nisubm =ipari(38,ni)
273 IF(nisub/=0)THEN
274C
275 WRITE(iout,1010)noint
276 WRITE(iout,'(10I10)')
277 . (nom_opt(1,ninter+intbuf_tab(ni)%LISUB(jsub)),jsub=1,nisub)
278 WRITE(iout,1050)
279 DO is=1,nrts
280 jsub=intbuf_tab(ni)%ADDSUBS(is)
281 n =intbuf_tab(ni)%ADDSUBS(is+1)-intbuf_tab(ni)%ADDSUBS(is)
282 IF(n>0)THEN
283 WRITE(iout,'(5I10)')is,
284 . (itab(intbuf_tab(ni)%IRECTS(2*(is-1)+j)),j=1,2)
285 WRITE(iout,'(50X,5I10)')
286 . (intbuf_tab(ni)%LISUBS(jsub-1+k),k=1,n)
287 END IF
288 END DO
289 WRITE(iout,1060)
290 DO im=1,nrtm
291 jsub=intbuf_tab(ni)%ADDSUBM(im)
292 n =intbuf_tab(ni)%ADDSUBM(im+1)-intbuf_tab(ni)%ADDSUBM(im)
293 IF(n>0)THEN
294 WRITE(iout,'(5I10)')im,
295 . (itab(intbuf_tab(ni)%IRECTM(2*(im-1)+j)),j=1,2)
296 WRITE(iout,'(50X,5I10)')
297 . (intbuf_tab(ni)%LISUBM(jsub-1+k),k=1,n)
298 END IF
299 END DO
300 END IF
301C
302 ELSEIF (nty==19)THEN
303C
304 nrts =ipari(3,ni)
305 nrtm =ipari(4,ni)
306 nsn =ipari(5,ni)
307 nmn =ipari(6,ni)
308 multimp=ipari(23,ni)
309 ifq =ipari(31,ni)
310 nisub =ipari(36,ni)
311 nisubs =ipari(37,ni)
312 nisubm =ipari(38,ni)
313 IF(nisub/=0)THEN
314C
315 WRITE(iout,1010)noint
316 WRITE(iout,'(10I10)')
317 . (nom_opt(1,ninter+intbuf_tab(ni)%LISUB(jsub)),jsub=1,nisub)
318C
319 WRITE(iout,1030)
320 DO is=1,nsn
321 jsub=intbuf_tab(ni)%ADDSUBS(is)
322 n =intbuf_tab(ni)%ADDSUBS(is+1)-intbuf_tab(ni)%ADDSUBS(is)
323 IF(n>0)THEN
324 WRITE(iout,'(2I10)')is,itab(intbuf_tab(ni)%NSV(is))
325 WRITE(iout,'(20X,8I10)')
326 . (intbuf_tab(ni)%LISUBS(jsub-1+k),k=1,n)
327 END IF
328 END DO
329 WRITE(iout,1040)
330 DO im=1,nrtm
331 jsub=intbuf_tab(ni)%ADDSUBM(im)
332 n =intbuf_tab(ni)%ADDSUBM(im+1)-intbuf_tab(ni)%ADDSUBM(im)
333 IF(n>0)THEN
334 WRITE(iout,'(5I10)')im,
335 . (itab(intbuf_tab(ni)%IRECTM(4*(im-1)+j)),j=1,4)
336 WRITE(iout,'(50X,5I10)')
337 . (intbuf_tab(ni)%LISUBM(jsub-1+k),k=1,n)
338 END IF
339 END DO
340 END IF
341C
342 END IF
343C
344 END DO
345C
346 DEALLOCATE (kad)
347 DEALLOCATE (nod2rtm)
348 DEALLOCATE (nod2rtms)
349 DEALLOCATE (nod2nsv)
350 DEALLOCATE (tagrtm)
351 DEALLOCATE (tagnod)
352 DEALLOCATE (taglins,taglinm)
353C
354C-------------------------------------
355 1000 FORMAT( /1x,' STRUCTURE OF SUB-INTERFACES OUTPUT TO TH'/
356 . 1x,' ----------------------------------------'// )
357 1010 FORMAT( /1x,' INTERFACE ID . . . . . . . . . . . . . .',i10/,
358 . ' -> LIST OF SUB-INTERFACES IDS : ')
359 1030 FORMAT(/,' SECONDARY SECONDARY '/
360 . ' NODE NODE '/
361 . ' NUMBER ID '/
362 . ' ',
363 . ' -> LIST OF SUB-INTERFACES (LOCAL NUMBERS IN INTERFACE)'/)
364 1040 FORMAT(' MAIN MAIN '/
365 . ' SEGMENT SEGMENT '/
366 . ' NUMBER NODES '/
367 . ' ',
368 . ' -> LIST OF SUB-INTERFACES (LOCAL NUMBERS IN INTERFACE)'/)
369C
370 1050 FORMAT(' SECONDARY SECONDARY '/
371 . ' LINE LINE '/
372 . ' NUMBER NODES '/
373 . ' ',
374 . ' -> LIST OF SUB-INTERFACES (LOCAL NUMBERS IN INTERFACE)'/)
375 1060 FORMAT(' MAIN MAIN '/
376 . ' LINE LINE '/
377 . ' NUMBER NODES '/
378 . ' ',
379 . ' -> LIST OF SUB-INTERFACES (LOCAL NUMBERS IN INTERFACE)'/)
380C-------------------------------------
381 RETURN
382 END
inintsub
subroutine inintsub(itab, igrnod, igrsurf, ipari, maxrtm, nom_opt, intbuf_tab, maxrtms, igrslin, maxnsne)
Definition inintsub.F:40
inintsub_11
subroutine inintsub_11(itab, igrslin, igrsurf, nom_opt, intbuf_tab, nrtm, nrtm0, nsn, nisubs, nisubm, noint, ni, nod2rtms, nod2rtmm, kad, taglins, taglinm, iadd, nt19, maxrtms, nrts, nty)
Definition inintsub_11.F:39
inintsub_25
subroutine inintsub_25(itab, igrnod, igrsurf, nom_opt, intbuf_tab, nrtm, nrtm0, nsn, nisubs, nisubm, noint, ni, nod2nsv, nod2rtm, kad, tagnod, tagrtm, iadd, nsne, nty, nrtse)
Definition inintsub_25.F:42
inintsub_7
subroutine inintsub_7(itab, igrnod, igrsurf, nom_opt, intbuf_tab, nrtm, nrtm0, nsn, nisubs, nisubm, noint, ni, nod2nsv, nod2rtm, kad, tagnod, tagrtm, iadd, nt19)
Definition inintsub_7.F:38
max
#define max(a, b)
Definition macros.h:21
groupdef_mod
Definition groupdef_mod.F:668
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
fretitl2
subroutine fretitl2(titr, iasc, l)
Definition freform.F:799