OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
inintsub_7.F File Reference
#include "implicit_f.inc"
#include "scr17_c.inc"
#include "com04_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine inintsub_7 (itab, igrnod, igrsurf, nom_opt, intbuf_tab, nrtm, nrtm0, nsn, nisubs, nisubm, noint, ni, nod2nsv, nod2rtm, kad, tagnod, tagrtm, iadd, nt19)

Function/Subroutine Documentation

◆ inintsub_7()

subroutine inintsub_7 ( integer, dimension(*) itab,
type (group_), dimension(ngrnod) igrnod,
type (surf_), dimension(nsurf) igrsurf,
integer, dimension(lnopt1,*) nom_opt,
type(intbuf_struct_), dimension(*) intbuf_tab,
integer nrtm,
integer nrtm0,
integer nsn,
integer nisubs,
integer nisubm,
integer noint,
integer ni,
integer, dimension(*) nod2nsv,
integer, dimension(*) nod2rtm,
integer, dimension(*) kad,
integer, dimension(*) tagnod,
integer, dimension(*) tagrtm,
integer, dimension(*) iadd,
integer nt19 )

Definition at line 34 of file inintsub_7.F.

38
39C-----------------------------------------------
40C M o d u l e s
41C-----------------------------------------------
42 USE message_mod
43 USE intbufdef_mod
44 USE groupdef_mod
45 USE names_and_titles_mod , ONLY : nchartitle
46C-----------------------------------------------
47C I m p l i c i t T y p e s
48C-----------------------------------------------
49#include "implicit_f.inc"
50C-----------------------------------------------
51C C o m m o n B l o c k s
52C-----------------------------------------------
53#include "scr17_c.inc"
54#include "com04_c.inc"
55C-----------------------------------------------
56C D u m m y A r g u m e n t s
57C-----------------------------------------------
58 INTEGER ITAB(*), NOD2NSV(*), NOD2RTM(*), KAD(*), TAGNOD(*), TAGRTM(*),
59 . IADD(*)
60 INTEGER NRTM, NRTM0, NSN, NISUBS, NISUBM, NOINT, NI, NT19
61 INTEGER NOM_OPT(LNOPT1,*)
62
63 TYPE(INTBUF_STRUCT_) INTBUF_TAB(*)
64C-----------------------------------------------
65C L o c a l V a r i a b l e s
66C-----------------------------------------------
67 INTEGER I,J,K,JGRN,ISU,ISU1,ISU2,
68 . JSUB, KSUB, NNE, IS, ISV, CUR, ID1,
69 . NEXT, IM, KM, JAD, IN, II, N,STAT,K1,K2,INOD,IFNRT
70 CHARACTER(LEN=NCHARTITLE) :: TITR,TITR1
71C-----------------------------------------------
72 TYPE (GROUP_) , DIMENSION(NGRNOD) :: IGRNOD
73 TYPE (SURF_) , DIMENSION(NSURF) :: IGRSURF
74 TYPE (SURF_) , DIMENSION(NSLIN) :: IGRSLIN
75C-----------------------------------------------
76C E x t e r n a l F u n c t i o n s
77C-----------------------------------------------
78 INTEGER BITSET
79 EXTERNAL bitset
80C=======================================================================
81
82C
83 intbuf_tab(ni)%ADDSUBS(1:nsn+1) = 0 ! address of different subinter related to secondary node
84 intbuf_tab(ni)%ADDSUBM(1:nrtm+1) = 0 ! address of different subinter related to main segment
85
86 intbuf_tab(ni)%INFLG_SUBS(1:nisubs)=0 ! Flags for determining what is surface Surf1 or Surf2
87 intbuf_tab(ni)%INFLG_SUBM(1:nisubm)=0
88
89C----------------------------------------
90C TAG nodes secondary calculate addresses
91C---------------------------------------------
92
93 nod2nsv(1:numnod) = 0
94 DO is=1,nsn
95 isv = intbuf_tab(ni)%NSV(is)
96 IF (isv>numnod) cycle
97 nod2nsv(isv)=is
98 END DO
99C
100 ksub=0
101 DO jsub=1,nintsub
102 id1=nom_opt(1,ninter+jsub)
103 CALL fretitl2(titr1, nom_opt(lnopt1-ltitr+1,ninter+jsub),ltitr)
104 IF(nom_opt(2,ninter+jsub)==noint
105 . .AND.nom_opt(5,ninter+jsub)==1)THEN
106 ksub=ksub+1
107C
108C LISUB(KSUB)=JSUB no interne de la sous-interface
109 intbuf_tab(ni)%LISUB(ksub) = jsub
110 intbuf_tab(ni)%TYPSUB(ksub) = 1
111C
112C prepare ADDSUBS (K29), LISUBS (K31) :
113C LISUBS(ADDSUBS(IS):ADDSUBS(IS+1)-1) SS. INTERF CONTENANT LE ND SECOND. IS
114C
115 IF (nt19==0) THEN
116C-- Interface type7
117 jgrn =nom_opt(4,ninter+jsub)
118 nne =igrnod(jgrn)%NENTITY
119C
120 DO i=1,nne
121 isv=igrnod(jgrn)%ENTITY(i)
122 is =nod2nsv(isv)
123 IF(is==0)THEN
124 CALL ancmsg(msgid=580,
125 . msgtype=msgerror,
126 . anmode=aninfo_blind_1,
127 . i1=id1,
128 . c1=titr1,
129 . i2=itab(isv),
130 . i3=noint)
131 ELSE
132 intbuf_tab(ni)%ADDSUBS(is) =
133 . intbuf_tab(ni)%ADDSUBS(is)+1
134 END IF
135 END DO
136C
137 ELSE
138C-- Interface type7 of type19 - based on input SECONDARY surface
139 IF (nt19==-1) THEN
140 isu =nom_opt(4,ninter+jsub)
141 ELSE
142C sym type7 of type19
143 isu =nom_opt(3,ninter+jsub)
144 ENDIF
145C
146 tagnod(1:numnod) = 0
147 nne =igrsurf(isu)%NSEG
148C
149 DO i=1,nne
150 km=1
151 DO j=1,4
152 in = igrsurf(isu)%NODES(i,j)
153 is = nod2nsv(in)
154 IF (is==0) THEN
155 km = 0
156 ELSE
157 IF (tagnod(in)==0) THEN
158 intbuf_tab(ni)%ADDSUBS(is) = intbuf_tab(ni)%ADDSUBS(is)+1
159 tagnod(in) = 1
160 ENDIF
161 ENDIF
162 END DO
163C
164 IF ((km==0).AND.(nt19==-1)) THEN
165 CALL ancmsg(msgid=1198,
166 . msgtype=msgerror,
167 . anmode=aninfo_blind_1,
168 . i1=id1,
169 . c1=titr1,
170 . i2=itab(igrsurf(isu)%NODES(i,1)),
171 . i3=itab(igrsurf(isu)%NODES(i,2)),
172 . i4=itab(igrsurf(isu)%NODES(i,3)),
173 . i5=itab(igrsurf(isu)%NODES(i,4)),
174 . i6=noint)
175 END IF
176 END DO
177C
178 ENDIF
179C
180C---------Case of subinter defined with inter 0 -------------
181C
182 ELSEIF(nom_opt(2,ninter+jsub) == 0
183 . .AND. nom_opt(5,ninter+jsub) == 1) THEN
184
185 ksub=ksub+1
186C
187C LISUB(KSUB)=JSUB no interne de la sous-interface
188 intbuf_tab(ni)%LISUB (ksub) = jsub
189C
190C prepare ADDSUBS , LISUBS (K31) :
191C LISUBS(ADDSUBS(IS):ADDSUBS(IS+1)-1) SS. INTERF CONTENANT LE ND SECOND. IS
192C
193 tagnod(1:numnod) = 0
194
195 isu2 =nom_opt(6,ninter+jsub) ! SURFACE ID 2
196 IF(isu2/=0)THEN
197 intbuf_tab(ni)%TYPSUB(ksub) = 2
198
199 DO i=1,igrsurf(isu2)%NSEG
200 DO k=1,4
201 in=igrsurf(isu2)%NODES(i,k)
202 is =nod2nsv(in)
203 IF(is/=0.AND.tagnod(in)==0) THEN
204 intbuf_tab(ni)%ADDSUBS(is) =
205 . intbuf_tab(ni)%ADDSUBS(is)+1
206 tagnod(in) = 1
207 END IF
208 ENDDO
209 ENDDO
210 ENDIF
211
212 isu1 =nom_opt(3,ninter+jsub) ! SURFACE ID 1
213 IF(isu1/=0)THEN
214 intbuf_tab(ni)%TYPSUB(ksub) = 3
215
216 DO i=1,igrsurf(isu1)%NSEG
217 DO k=1,4
218 in=igrsurf(isu1)%NODES(i,k)
219 is =nod2nsv(in)
220 IF(is/=0.AND.tagnod(in)==0) THEN
221 intbuf_tab(ni)%ADDSUBS(is) =
222 . intbuf_tab(ni)%ADDSUBS(is)+1
223 tagnod(in) = 1
224 END IF
225 ENDDO
226 ENDDO
227 ENDIF
228C
229C
230 END IF
231
232
233 END DO
234C
235C --------Skyline tabs ADDSUBS-----------
236C
237 cur=1
238 DO is=1,nsn
239 next = cur+intbuf_tab(ni)%ADDSUBS(is)
240 intbuf_tab(ni)%ADDSUBS(is)= cur
241 cur = next
242 END DO
243 intbuf_tab(ni)%ADDSUBS(1+nsn)=cur
244C
245C utilise KAD(1:NSN)
246 DO is=1,nsn
247 kad(is)=intbuf_tab(ni)%ADDSUBS(is)
248 END DO
249
250C----------------------------------------
251C Secondary side : After ADRESS STORE SUBINTER in INTBUF_TAB(NI)%LISUBS
252C---------------------------------------------
253 ksub=0
254 DO jsub=1,nintsub
255 IF(nom_opt(2,ninter+jsub)==noint
256 . .AND.nom_opt(5,ninter+jsub)==1)THEN
257 ksub=ksub+1
258C
259C prepare LISUBS (K31) :
260C LISUBS(ADDSUBS(IS):ADDSUBS(IS+1)-1) SS. INTERF CONTENANT LE ND SECOND. IS
261C
262 IF (nt19==0) THEN
263C-- Interface type7
264 jgrn =nom_opt(4,ninter+jsub)
265 nne =igrnod(jgrn)%NENTITY
266 DO i=1,nne
267 isv=igrnod(jgrn)%ENTITY(i)
268 is =nod2nsv(isv)
269 IF(is/=0)THEN
270 intbuf_tab(ni)%LISUBS(kad(is))=ksub
271 kad(is)=kad(is)+1
272 END IF
273 END DO
274C
275 ELSE
276C-- Interface type7 of type19 - based on input SECONDARY surface
277 IF (nt19==-1) THEN
278 isu =nom_opt(4,ninter+jsub)
279 ELSE
280C sym type7 of type19
281 isu =nom_opt(3,ninter+jsub)
282 ENDIF
283C
284 tagnod(1:numnod) = 0
285 nne =igrsurf(isu)%NSEG
286 DO i=1,nne
287 DO j=1,4
288 in = igrsurf(isu)%NODES(i,j)
289 is = nod2nsv(in)
290 IF ((is/=0).AND.(tagnod(in)==0)) THEN
291 intbuf_tab(ni)%LISUBS(kad(is))=ksub
292 kad(is)=kad(is)+1
293 tagnod(in) = 1
294 ENDIF
295 END DO
296 ENDDO
297C
298 ENDIF
299C
300C---------Case of subinter defined with inter 0 -------------
301C
302 ELSEIF(nom_opt(2,ninter+jsub) == 0
303 . .AND. nom_opt(5,ninter+jsub) == 1) THEN
304
305 ksub=ksub+1
306C
307C prepare ADDSUBS , LISUBS (K31) :
308C LISUBS(ADDSUBS(IS):ADDSUBS(IS+1)-1) SS. INTERF CONTENANT LE ND SECOND. IS
309C
310 tagnod(1:numnod) = 0
311
312 isu2 =nom_opt(6,ninter+jsub) ! SURFACE ID 2
313 IF(isu2/=0)THEN
314
315 DO i=1,igrsurf(isu2)%NSEG
316 DO k=1,4
317 in=igrsurf(isu2)%NODES(i,k)
318 is =nod2nsv(in)
319 IF (is/=0)THEN
320 IF(tagnod(in)==0) THEN
321 intbuf_tab(ni)%INFLG_SUBS(kad(is))=
322 . bitset(intbuf_tab(ni)%INFLG_SUBS(kad(is)),0)
323 intbuf_tab(ni)%LISUBS(kad(is))=ksub
324 kad(is)=kad(is)+1
325 tagnod(in) = 1
326 ELSE
327 intbuf_tab(ni)%INFLG_SUBS(kad(is)-1)=
328 . bitset(intbuf_tab(ni)%INFLG_SUBS(kad(is)-1),0)
329 ENDIF
330 ENDIF
331 ENDDO
332 ENDDO
333 ENDIF
334
335
336 isu1 =nom_opt(3,ninter+jsub) ! SURFACE ID 1
337 IF(isu1/=0)THEN
338
339 DO i=1,igrsurf(isu1)%NSEG
340 DO k=1,4
341 in=igrsurf(isu1)%NODES(i,k)
342 is =nod2nsv(in)
343 IF (is/=0)THEN
344 IF(tagnod(in)==0) THEN
345 intbuf_tab(ni)%INFLG_SUBS(kad(is))=
346 . bitset(intbuf_tab(ni)%INFLG_SUBS(kad(is)),1)
347 intbuf_tab(ni)%LISUBS(kad(is))=ksub
348 kad(is)=kad(is)+1
349 tagnod(in) = 1
350 ELSE
351 intbuf_tab(ni)%INFLG_SUBS(kad(is)-1)=
352 . bitset(intbuf_tab(ni)%INFLG_SUBS(kad(is)-1),1)
353 ENDIF
354 ENDIF
355 ENDDO
356 ENDDO
357 ENDIF
358C
359 END IF
360 END DO
361
362C----------------------------------------
363C TAG main segments calculate addresses
364C---------------------------------------------
365C
366C utilise IADD(1:NUMNOD+1)
367 iadd(1:numnod+1) = 0
368 DO im=1,nrtm0
369 in =intbuf_tab(ni)%IRECTM(4*(im-1)+1)
370 iadd(in) =iadd(in)+1
371 in =intbuf_tab(ni)%IRECTM(4*(im-1)+2)
372 iadd(in) =iadd(in)+1
373 in =intbuf_tab(ni)%IRECTM(4*(im-1)+3)
374 iadd(in) =iadd(in)+1
375 in =intbuf_tab(ni)%IRECTM(4*(im-1)+4)
376 iadd(in) =iadd(in)+1
377 END DO
378C
379 cur=1
380 DO i=1,numnod
381 next =cur+iadd(i)
382 iadd(i) =cur
383 cur =next
384 END DO
385 iadd(numnod+1)=cur
386C
387C utilise KAD(NUMNOD)
388 DO i=1,numnod
389 kad(i)=iadd(i)
390 END DO
391C
392C utilise NOD2RTM(4*NRTM0)
393 DO im=1,nrtm0
394 in =intbuf_tab(ni)%IRECTM(4*(im-1)+1)
395 nod2rtm(kad(in)) = im
396 kad(in) = kad(in) + 1
397 in =intbuf_tab(ni)%IRECTM(4*(im-1)+2)
398 nod2rtm(kad(in)) = im
399 kad(in) = kad(in) + 1
400 in =intbuf_tab(ni)%IRECTM(4*(im-1)+3)
401 nod2rtm(kad(in)) = im
402 kad(in) = kad(in) + 1
403 in =intbuf_tab(ni)%IRECTM(4*(im-1)+4)
404 nod2rtm(kad(in)) = im
405 kad(in) = kad(in) + 1
406 ENDDO
407C
408C prepare ADDSUBM (K30) :
409 ksub=0
410 DO jsub=1,nintsub
411
412 id1=nom_opt(1,ninter+jsub)
413 CALL fretitl2(titr1,
414 . nom_opt(lnopt1-ltitr+1,ninter+jsub),ltitr)
415
416 IF(nom_opt(2,ninter+jsub)==noint
417 . .AND.nom_opt(5,ninter+jsub)==1)THEN
418 ksub=ksub+1
419C
420 tagrtm(1:nrtm0) = 0
421C
422 IF (nt19<1) THEN
423 isu =nom_opt(3,ninter+jsub)
424 ELSE
425C sym type7 of type19
426 isu =nom_opt(4,ninter+jsub)
427 ENDIF
428 nne =igrsurf(isu)%NSEG
429C
430 DO i=1,nne
431C
432 in=igrsurf(isu)%NODES(i,1)
433 km=0
434 DO 110 jad=iadd(in),iadd(in+1)-1
435 im = nod2rtm(jad)
436 DO 100 j=1,4
437 ii=igrsurf(isu)%NODES(i,j)
438 IF(j==4.AND.ii==0)THEN
439 GO TO 100
440 ELSE
441 DO k=1,4
442 IF(intbuf_tab(ni)%IRECTM(4*(im-1)+k)==ii) GOTO 100
443 END DO
444 GOTO 110
445 END IF
446 100 CONTINUE
447 km=im
448 GO TO 120
449 110 CONTINUE
450 120 CONTINUE
451 IF(km==0)THEN
452 IF (nt19==0) THEN
453 CALL ancmsg(msgid=581,
454 . msgtype=msgerror,
455 . anmode=aninfo_blind_1,
456 . i1=id1,
457 . c1=titr1,
458 . i2=itab(igrsurf(isu)%NODES(i,1)),
459 . i3=itab(igrsurf(isu)%NODES(i,2)),
460 . i4=itab(igrsurf(isu)%NODES(i,3)),
461 . i5=itab(igrsurf(isu)%NODES(i,4)),
462 . i6=noint)
463 ELSEIF (nt19==-1) THEN
464 CALL ancmsg(msgid=1198,
465 . msgtype=msgerror,
466 . anmode=aninfo_blind_1,
467 . i1=id1,
468 . c1=titr1,
469 . i2=itab(igrsurf(isu)%NODES(i,1)),
470 . i3=itab(igrsurf(isu)%NODES(i,2)),
471 . i4=itab(igrsurf(isu)%NODES(i,3)),
472 . i5=itab(igrsurf(isu)%NODES(i,4)),
473 . i6=noint)
474 ENDIF
475 ELSEIF(tagrtm(km)==0)THEN
476 intbuf_tab(ni)%ADDSUBM(km)=intbuf_tab(ni)%ADDSUBM(km)+1
477 tagrtm(km)=1
478 END IF
479 END DO
480
481
482C
483C---------Case of subinter defined with inter 0 -------------
484C
485 ELSEIF(nom_opt(2,ninter+jsub) == 0
486 . .AND. nom_opt(5,ninter+jsub) == 1) THEN
487
488 ksub=ksub+1
489C
490 tagrtm(1:nrtm0) = 0
491C
492 isu1 =nom_opt(3,ninter+jsub)
493
494 IF(isu1 > 0 ) THEN
495 intbuf_tab(ni)%TYPSUB(ksub) = 3
496
497 nne =igrsurf(isu1)%NSEG
498 DO i=1,nne
499 in=igrsurf(isu1)%NODES(i,1)
500 km=0
501
502 DO jad=iadd(in),iadd(in+1)-1
503 im = nod2rtm(jad)
504 ifnrt = 0
505 DO j=1,4
506 ii=igrsurf(isu1)%NODES(i,j)
507 IF(j/=4.OR.ii/=0)THEN
508 DO k=1,4
509 IF(intbuf_tab(ni)%IRECTM(4*(im-1)+k)==ii) ifnrt = ifnrt + 1
510 END DO
511 ENDIF
512 ENDDO
513
514 IF(ifnrt >= 3) THEN
515 km=im
516 EXIT
517 ENDIF
518
519 ENDDO
520
521 IF(km/=0.AND.tagrtm(km)==0)THEN
522 intbuf_tab(ni)%ADDSUBM(km)=intbuf_tab(ni)%ADDSUBM(km)+1
523 tagrtm(km)=1
524 END IF
525
526 END DO
527
528 ENDIF
529C
530 isu2 =nom_opt(6,ninter+jsub)
531
532 IF(isu2 > 0 ) THEN
533
534 nne =igrsurf(isu2)%NSEG
535 DO i=1,nne
536 in=igrsurf(isu2)%NODES(i,1)
537 km=0
538
539 DO jad=iadd(in),iadd(in+1)-1
540 im = nod2rtm(jad)
541 ifnrt = 0
542 DO j=1,4
543 ii=igrsurf(isu2)%NODES(i,j)
544 IF(j/=4.OR.ii/=0)THEN
545 DO k=1,4
546 IF(intbuf_tab(ni)%IRECTM(4*(im-1)+k)==ii) ifnrt = ifnrt + 1
547 END DO
548 ENDIF
549 ENDDO
550
551 IF(ifnrt >= 3) THEN
552 km=im
553 EXIT
554 ENDIF
555
556 ENDDO
557
558 IF(km/=0)THEN
559 IF(tagrtm(km)==0)THEN
560 intbuf_tab(ni)%ADDSUBM(km)=intbuf_tab(ni)%ADDSUBM(km)+1
561 tagrtm(km)=1
562 ENDIF
563 END IF
564
565 END DO
566
567 ENDIF
568C
569
570
571 END IF
572 END DO
573C
574 cur=1
575 DO im=1,nrtm0
576 next =cur+intbuf_tab(ni)%ADDSUBM(im)
577 intbuf_tab(ni)%ADDSUBM(im)=cur
578 cur =next
579 END DO
580 intbuf_tab(ni)%ADDSUBM(nrtm0+1:nrtm+1)=cur
581C
582C utilise KAD(1:NRTM0)
583 DO im=1,nrtm0
584 kad(im)=intbuf_tab(ni)%ADDSUBM(im)
585 END DO
586C
587C prepare LISUBM (K32) :
588C LISUBM(ADDSUBM(IM):ADDSUBM(IM+1)-1) SS. INTERF CONTENANT LE SEG.MAIN IM
589 ksub=0
590 DO jsub=1,nintsub
591
592 IF(nom_opt(2,ninter+jsub)==noint
593 . .AND.nom_opt(5,ninter+jsub)==1)THEN
594
595 ksub=ksub+1
596C
597 tagrtm(1:nrtm0) = 0
598C
599 IF (nt19<1) THEN
600 isu =nom_opt(3,ninter+jsub)
601 ELSE
602C sym type7 of type19
603 isu =nom_opt(4,ninter+jsub)
604 ENDIF
605 nne =igrsurf(isu)%NSEG
606 DO i=1,nne
607 in=igrsurf(isu)%NODES(i,1)
608 km=0
609 DO 210 jad=iadd(in),iadd(in+1)-1
610 im = nod2rtm(jad)
611 DO 200 j=1,4
612 ii=igrsurf(isu)%NODES(i,j)
613 IF(j==4.AND.ii==0)THEN
614 GO TO 200
615 ELSE
616 DO k=1,4
617 IF(intbuf_tab(ni)%IRECTM(4*(im-1)+k)==ii) GOTO 200
618 END DO
619 GOTO 210
620 END IF
621 200 CONTINUE
622 km=im
623 GOTO 220
624 210 CONTINUE
625 220 CONTINUE
626 IF(km/=0.AND.tagrtm(im)==0)THEN
627 intbuf_tab(ni)%LISUBM(kad(im))=ksub
628 kad(im)=kad(im)+1
629 tagrtm(im)=1
630 END IF
631 END DO
632
633C
634C---------Case of subinter defined with inter 0 -------------
635C
636 ELSEIF(nom_opt(2,ninter+jsub) == 0
637 . .AND. nom_opt(5,ninter+jsub) == 1) THEN
638
639 ksub=ksub+1
640C
641 tagrtm(1:nrtm0) = 0
642C
643 isu1 =nom_opt(3,ninter+jsub)
644 IF(isu1 > 0 ) THEN
645
646 nne =igrsurf(isu1)%NSEG
647 DO i=1,nne
648 in=igrsurf(isu1)%NODES(i,1)
649 km=0
650
651 DO jad=iadd(in),iadd(in+1)-1
652 im = nod2rtm(jad)
653 ifnrt = 0
654 DO j=1,4
655 ii=igrsurf(isu1)%NODES(i,j)
656 IF(j/=4.OR.ii/=0)THEN
657 DO k=1,4
658 IF(intbuf_tab(ni)%IRECTM(4*(im-1)+k)==ii) ifnrt = ifnrt + 1
659 END DO
660 ENDIF
661 ENDDO
662 IF(ifnrt >= 3) THEN
663 km=im
664 EXIT
665 ENDIF
666 ENDDO
667
668 IF(km/=0)THEN
669 IF(tagrtm(im)==0)THEN
670 intbuf_tab(ni)%INFLG_SUBM(kad(im))=
671 . bitset(intbuf_tab(ni)%INFLG_SUBM(kad(im)),1)
672 intbuf_tab(ni)%LISUBM(kad(im))=ksub
673 kad(im)=kad(im)+1
674 tagrtm(im)=1
675 ENDIF
676 END IF
677 END DO
678C
679 ENDIF
680
681 isu2 =nom_opt(6,ninter+jsub)
682
683 IF(isu2 > 0 ) THEN
684
685 nne =igrsurf(isu2)%NSEG
686 DO i=1,nne
687 in=igrsurf(isu2)%NODES(i,1)
688 km=0
689
690 DO jad=iadd(in),iadd(in+1)-1
691 im = nod2rtm(jad)
692 ifnrt = 0
693 DO j=1,4
694 ii=igrsurf(isu2)%NODES(i,j)
695 IF(j/=4.OR.ii/=0)THEN
696 DO k=1,4
697 IF(intbuf_tab(ni)%IRECTM(4*(im-1)+k)==ii) ifnrt = ifnrt + 1
698 END DO
699 ENDIF
700 ENDDO
701 IF(ifnrt >= 3) THEN
702 km=im
703 EXIT
704 ENDIF
705 ENDDO
706
707 IF(km/=0)THEN
708 IF(tagrtm(im)==0)THEN
709 intbuf_tab(ni)%INFLG_SUBM(kad(im))=
710 . bitset(intbuf_tab(ni)%INFLG_SUBM(kad(im)),0)
711 intbuf_tab(ni)%LISUBM(kad(im))=ksub
712 kad(im)=kad(im)+1
713 tagrtm(im)=1
714 ELSE
715 intbuf_tab(ni)%INFLG_SUBM(kad(im)-1)=
716 . bitset(intbuf_tab(ni)%INFLG_SUBM(kad(im)-1),0)
717 END IF
718 END IF
719 END DO
720C
721 ENDIF
722 END IF
723 END DO
724
725
726C-------------------------------------
727 RETURN
bitset
integer function bitset(i, n)
Definition bitget.F:66
groupdef_mod
Definition groupdef_mod.F:662
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
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
fretitl2
subroutine fretitl2(titr, iasc, l)
Definition freform.F:804
tagnod
subroutine tagnod(ix, nix, nix1, nix2, numel, iparte, tagbuf, npart)
Definition tagnod.F:29