OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
inintsub_11.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_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)

Function/Subroutine Documentation

◆ inintsub_11()

subroutine inintsub_11 ( integer, dimension(*) itab,
type (surf_), dimension(nslin) igrslin,
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(*) nod2rtms,
integer, dimension(*) nod2rtmm,
integer, dimension(*) kad,
integer, dimension(*) taglins,
integer, dimension(*) taglinm,
integer, dimension(*) iadd,
integer nt19,
integer maxrtms,
integer nrts,
integer nty )

Definition at line 34 of file inintsub_11.F.

39
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 "scr17_c.inc"
55#include "com04_c.inc"
56C-----------------------------------------------
57C D u m m y A r g u m e n t s
58C-----------------------------------------------
59 INTEGER ITAB(*) , NOD2RTMS(*), NOD2RTMM(*), KAD(*), TAGLINS(*), TAGLINM(*), IADD(*)
60 INTEGER NRTM, NRTM0, NSN, NISUBS, NISUBM, NOINT, NI, NT19, NRTS, NTY, MAXRTMS
61 INTEGER NOM_OPT(LNOPT1,*)
62 TYPE(INTBUF_STRUCT_) INTBUF_TAB(*)
63C-----------------------------------------------
64C L o c a l V a r i a b l e s
65C-----------------------------------------------
66 INTEGER I,J,K,JGRN,ISU,ISU1,ISU2,
67 . JSUB, KSUB, NNE, IS, ISV, CUR, ID1,
68 . NEXT, IM, KM, JAD, IN, II, N,STAT,K1,K2,INOD,IFNRT
69 CHARACTER(LEN=NCHARTITLE) :: TITR,TITR1
70 INTEGER ISLIN1,ISLIN2,FOUND,FOUND_LINE
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
84 intbuf_tab(ni)%ADDSUBS(1:nrts+1) = 0 ! address of different subinter related to secondary line
85 intbuf_tab(ni)%ADDSUBM(1:nrtm+1) = 0 ! address of different subinter related to main line
86
87 intbuf_tab(ni)%INFLG_SUBS(1:nisubs)=0 ! Flags for determining what is surface Surf1 or Surf2
88 intbuf_tab(ni)%INFLG_SUBM(1:nisubm)=0
89
90
91 IF ((nty==11).AND.(nt19==0)) THEN
92C----------------------------------------
93C TAG nodes second calculate addresses
94C---------------------------------------------
95
96C
97 iadd(1:numnod+1) = 0
98 DO is=1,nrts
99 in =intbuf_tab(ni)%IRECTS(2*(is-1)+1)
100 iadd(in) =iadd(in)+1
101 in =intbuf_tab(ni)%IRECTS(2*(is-1)+2)
102 iadd(in) =iadd(in)+1
103 END DO
104C
105 cur=1
106 DO i=1,numnod
107 next =cur+iadd(i)
108 iadd(i) =cur
109 cur =next
110 END DO
111 iadd(numnod+1)=cur
112C
113 DO i=1,numnod
114 kad(i)=iadd(i)
115 END DO
116C
117 DO is=1,nrts
118 in =intbuf_tab(ni)%IRECTS(2*(is-1)+1)
119 nod2rtms(kad(in)) = is
120 kad(in) = kad(in) + 1
121 in =intbuf_tab(ni)%IRECTS(2*(is-1)+2)
122 nod2rtms(kad(in)) = is
123 kad(in) = kad(in) + 1
124 ENDDO
125C
126 ksub=0
127 DO jsub=1,nintsub
128 id1=nom_opt(1,ninter+jsub)
129 CALL fretitl2(titr1,nom_opt(lnopt1-ltitr+1,ninter+jsub),ltitr)
130 IF(nom_opt(2,ninter+jsub) == noint .AND. nom_opt(5,ninter+jsub) == 1)THEN
131 ksub=ksub+1
132C LISUB(KSUB)=JSUB no interne de la sous-interface
133 intbuf_tab(ni)%LISUB(ksub) = jsub
134 intbuf_tab(ni)%TYPSUB(ksub) = 1
135C
136 islin1 =nom_opt(4,ninter+jsub)
137 nne =igrslin(islin1)%NSEG
138C
139 DO i=1,nne
140 in=igrslin(islin1)%NODES(i,1)
141 km=0
142C
143 DO jad=iadd(in),iadd(in+1)-1
144 is = nod2rtms(jad)
145 found_line = 0
146 DO j=1,2
147 ii=igrslin(islin1)%NODES(i,j)
148 found=0
149 DO k=1,2
150 IF(intbuf_tab(ni)%IRECTS(2*(is-1)+k)==ii) found=1
151 END DO
152 found_line = found_line + found
153 END DO
154 IF (found_line==2) THEN
155 km=is
156 EXIT
157 ENDIF
158 ENDDO
159C
160 IF(km==0)THEN
161 CALL ancmsg(msgid=1188,
162 . msgtype=msgerror,
163 . anmode=aninfo_blind_1,
164 . i1=id1,
165 . c1=titr1,
166 . i2=itab(igrslin(islin1)%NODES(i,1)),
167 . i3=itab(igrslin(islin1)%NODES(i,2)),
168 . i4=noint)
169 ELSE
170 intbuf_tab(ni)%ADDSUBS(km)=intbuf_tab(ni)%ADDSUBS(km)+1
171 END IF
172 END DO
173
174C
175C---------Case of subinter defined with inter 0 -------------
176C
177 ELSEIF(nom_opt(2,ninter+jsub) == 0
178 . .AND. nom_opt(5,ninter+jsub) == 1) THEN
179
180 ksub=ksub+1
181C
182C LISUB(KSUB)=JSUB no interne de la sous-interface
183 intbuf_tab(ni)%LISUB (ksub) = jsub
184C
185C prepare ADDSUBS , LISUBS (K31) :
186C LISUBS(ADDSUBS(IS):ADDSUBS(IS+1)-1) SS. INTERF CONTENANT LE ND SECOND. IS
187C
188 taglins(1:maxrtms) = 0
189
190 isu2 =nom_opt(6,ninter+jsub) ! SURFACE ID 2
191 IF(isu2/=0)THEN
192 intbuf_tab(ni)%TYPSUB(ksub) = 2
193 DO i=1,igrsurf(isu2)%NSEG
194
195 DO inod=1,2
196 in=igrsurf(isu2)%NODES(i,2*inod)
197 DO jad=iadd(in),iadd(in+1)-1
198 is = nod2rtms(jad)
199 found_line = 0
200 DO j=1,2
201 ii=intbuf_tab(ni)%IRECTS(2*(is-1)+j)
202 found=0
203 DO k=1,4
204 IF(igrsurf(isu2)%NODES(i,k)==ii) found=1
205 END DO
206 found_line = found_line + found
207 END DO
208 IF ((found_line==2).AND.(taglins(is)==0)) THEN
209 intbuf_tab(ni)%ADDSUBS(is)=intbuf_tab(ni)%ADDSUBS(is)+1
210C Line must be taken into account only one time for one subinterface
211 taglins(is) = 1
212 ENDIF
213 ENDDO
214 ENDDO
215
216 ENDDO
217 ENDIF
218
219 isu1 =nom_opt(3,ninter+jsub) ! SURFACE ID 1
220 IF(isu1/=0)THEN
221 intbuf_tab(ni)%TYPSUB(ksub) = 3
222 DO i=1,igrsurf(isu1)%NSEG
223
224 DO inod=1,2
225 in=igrsurf(isu1)%NODES(i,2*inod)
226 DO jad=iadd(in),iadd(in+1)-1
227 is = nod2rtms(jad)
228 found_line = 0
229 DO j=1,2
230 ii=intbuf_tab(ni)%IRECTS(2*(is-1)+j)
231 found=0
232 DO k=1,4
233 IF(igrsurf(isu1)%NODES(i,k)==ii) found=1
234 END DO
235 found_line = found_line + found
236 END DO
237 IF ((found_line==2).AND.(taglins(is)==0)) THEN
238 intbuf_tab(ni)%ADDSUBS(is)=intbuf_tab(ni)%ADDSUBS(is)+1
239C Line must be taken into account only one time for one subinterface
240 taglins(is) = 1
241 ENDIF
242 ENDDO
243 ENDDO
244
245 ENDDO
246 ENDIF
247C
248C
249
250 END IF
251 END DO
252C
253C --------Skyline tabs ADDSUBS-----------
254C
255 cur=1
256 DO is=1,nrts
257 next =cur+intbuf_tab(ni)%ADDSUBS(is)
258 intbuf_tab(ni)%ADDSUBS(is)=cur
259 cur =next
260 END DO
261 intbuf_tab(ni)%ADDSUBS(nrts+1)=cur
262C
263C utilise KAD(1:NRTM)
264 DO is=1,nrts
265 kad(is)=intbuf_tab(ni)%ADDSUBS(is)
266 END DO
267C
268C prepare LISUBS :
269C
270 ksub=0
271 DO jsub=1,nintsub
272 IF(nom_opt(2,ninter+jsub)==noint
273 . .AND.nom_opt(5,ninter+jsub)==1)THEN
274 ksub=ksub+1
275C
276 islin1 =nom_opt(4,ninter+jsub)
277 nne =igrslin(islin1)%NSEG
278C
279 DO i=1,nne
280 in=igrslin(islin1)%NODES(i,1)
281 km=0
282C
283 DO jad=iadd(in),iadd(in+1)-1
284 is = nod2rtms(jad)
285 found_line = 0
286 DO j=1,2
287 ii=igrslin(islin1)%NODES(i,j)
288 found=0
289 DO k=1,2
290 IF(intbuf_tab(ni)%IRECTS(2*(is-1)+k)==ii) found=1
291 END DO
292 found_line = found_line + found
293 END DO
294 IF (found_line==2) THEN
295 km=is
296 EXIT
297 ENDIF
298 ENDDO
299C
300 IF(km/=0)THEN
301 intbuf_tab(ni)%LISUBS(kad(is))=ksub
302 kad(is)=kad(is)+1
303 END IF
304 END DO
305C
306C---------Case of subinter defined with inter 0 -------------
307C
308 ELSEIF(nom_opt(2,ninter+jsub) == 0
309 . .AND. nom_opt(5,ninter+jsub) == 1) THEN
310
311 ksub=ksub+1
312C
313C LISUB(KSUB)=JSUB no interne de la sous-interface
314 intbuf_tab(ni)%LISUB (ksub) = jsub
315C
316C prepare ADDSUBS , LISUBS (K31) :
317C LISUBS(ADDSUBS(IS):ADDSUBS(IS+1)-1) SS. INTERF CONTENANT LE ND SECOND. IS
318C
319 taglins(1:maxrtms) = 0
320
321 isu2 =nom_opt(6,ninter+jsub) ! SURFACE ID 2
322 IF(isu2/=0)THEN
323 DO i=1,igrsurf(isu2)%NSEG
324
325 DO inod=1,2
326 in=igrsurf(isu2)%NODES(i,2*inod)
327 DO jad=iadd(in),iadd(in+1)-1
328 is = nod2rtms(jad)
329 found_line = 0
330 DO j=1,2
331 ii=intbuf_tab(ni)%IRECTS(2*(is-1)+j)
332 found=0
333 DO k=1,4
334 IF(igrsurf(isu2)%NODES(i,k)==ii) found=1
335 END DO
336 found_line = found_line + found
337 END DO
338
339 IF (found_line==2)THEN
340 IF(taglins(is)==0) THEN
341 intbuf_tab(ni)%INFLG_SUBS(kad(is))=
342 . bitset(intbuf_tab(ni)%INFLG_SUBS(kad(is)),0)
343 intbuf_tab(ni)%LISUBS(kad(is))=ksub
344 kad(is)=kad(is)+1
345C Line must be taken into account only one time for one subinterface
346 taglins(is) = 1
347 ELSE
348 intbuf_tab(ni)%INFLG_SUBS(kad(is)-1)=
349 . bitset(intbuf_tab(ni)%INFLG_SUBS(kad(is)-1),0)
350 ENDIF
351 ENDIF
352 ENDDO
353 ENDDO
354
355 ENDDO
356 ENDIF
357C
358 isu1 =nom_opt(3,ninter+jsub) ! SURFACE ID 1
359 IF(isu1/=0)THEN
360 DO i=1,igrsurf(isu1)%NSEG
361
362 DO inod=1,2
363 in=igrsurf(isu1)%NODES(i,2*inod)
364 DO jad=iadd(in),iadd(in+1)-1
365 is = nod2rtms(jad)
366 found_line = 0
367 DO j=1,2
368 ii=intbuf_tab(ni)%IRECTS(2*(is-1)+j)
369 found=0
370 DO k=1,4
371 IF(igrsurf(isu1)%NODES(i,k)==ii) found=1
372 END DO
373 found_line = found_line + found
374 END DO
375 IF (found_line==2)THEN
376 IF(taglins(is)==0) THEN
377 intbuf_tab(ni)%INFLG_SUBS(kad(is))=
378 . bitset(intbuf_tab(ni)%INFLG_SUBS(kad(is)),1)
379 intbuf_tab(ni)%LISUBS(kad(is))=ksub
380 kad(is)=kad(is)+1
381C Line must be taken into account only one time for one subinterface
382 taglins(is) = 1
383 ELSE
384 intbuf_tab(ni)%INFLG_SUBS(kad(is)-1)=
385 . bitset(intbuf_tab(ni)%INFLG_SUBS(kad(is)-1),1)
386 ENDIF
387 ENDIF
388 ENDDO
389
390 ENDDO
391
392 ENDDO
393 ENDIF
394C
395
396 END IF
397 END DO
398C
399C--- MAIN Side--
400C
401 iadd(1:numnod+1) = 0
402 DO im=1,nrtm
403 in =intbuf_tab(ni)%IRECTM(2*(im-1)+1)
404 iadd(in) =iadd(in)+1
405 in =intbuf_tab(ni)%IRECTM(2*(im-1)+2)
406 iadd(in) =iadd(in)+1
407 END DO
408C
409 cur=1
410 DO i=1,numnod
411 next =cur+iadd(i)
412 iadd(i) =cur
413 cur =next
414 END DO
415 iadd(numnod+1)=cur
416C
417 DO i=1,numnod
418 kad(i)=iadd(i)
419 END DO
420C
421 DO im=1,nrtm
422 in =intbuf_tab(ni)%IRECTM(2*(im-1)+1)
423 nod2rtmm(kad(in)) = im
424 kad(in) = kad(in) + 1
425 in =intbuf_tab(ni)%IRECTM(2*(im-1)+2)
426 nod2rtmm(kad(in)) = im
427 kad(in) = kad(in) + 1
428 ENDDO
429C
430 ksub=0
431 DO jsub=1,nintsub
432 id1=nom_opt(1,ninter+jsub)
433 CALL fretitl2(titr1,
434 . nom_opt(lnopt1-ltitr+1,ninter+jsub),ltitr)
435 IF(nom_opt(2,ninter+jsub)==noint
436 . .AND.nom_opt(5,ninter+jsub)==1)THEN
437 ksub=ksub+1
438C
439 islin2 =nom_opt(3,ninter+jsub)
440 nne =igrslin(islin2)%NSEG
441C
442 DO i=1,nne
443 in=igrslin(islin2)%NODES(i,1)
444 km=0
445C
446 DO jad=iadd(in),iadd(in+1)-1
447 im = nod2rtmm(jad)
448 found_line = 0
449 DO j=1,2
450 ii=igrslin(islin2)%NODES(i,j)
451 found=0
452 DO k=1,2
453 IF(intbuf_tab(ni)%IRECTM(2*(im-1)+k)==ii) found=1
454 END DO
455 found_line = found_line + found
456 END DO
457 IF (found_line==2) THEN
458 km=im
459 EXIT
460 ENDIF
461 ENDDO
462C
463 IF(km==0)THEN
464 CALL ancmsg(msgid=1189,
465 . msgtype=msgerror,
466 . anmode=aninfo_blind_1,
467 . i1=id1,
468 . c1=titr1,
469 . i2=itab(igrslin(islin2)%NODES(i,1)),
470 . i3=itab(igrslin(islin2)%NODES(i,2)),
471 . i4=noint)
472 ELSE
473 intbuf_tab(ni)%ADDSUBM(km)=intbuf_tab(ni)%ADDSUBM(km)+1
474 END IF
475 END DO
476
477C
478C---------Case of subinter defined with inter 0 -------------
479C
480 ELSEIF(nom_opt(2,ninter+jsub) == 0
481 . .AND. nom_opt(5,ninter+jsub) == 1) THEN
482
483 ksub=ksub+1
484C
485C LISUB(KSUB)=JSUB no interne de la sous-interface
486 intbuf_tab(ni)%LISUB (ksub) = jsub
487C
488C prepare ADDSUBS , LISUBS (K31) :
489C LISUBS(ADDSUBS(IS):ADDSUBS(IS+1)-1) SS. INTERF CONTENANT LE ND SECOND. IS
490C
491 taglinm(1:maxrtms) = 0
492
493 isu1 =nom_opt(3,ninter+jsub) ! SURFACE ID 1
494 IF(isu1/=0)THEN
495 DO i=1,igrsurf(isu1)%NSEG
496
497 DO inod=1,2
498 in=igrsurf(isu1)%NODES(i,2*inod)
499 DO jad=iadd(in),iadd(in+1)-1
500 im = nod2rtmm(jad)
501 found_line = 0
502 DO j=1,2
503 ii=intbuf_tab(ni)%IRECTM(2*(is-1)+j)
504 found=0
505 DO k=1,4
506 IF(igrsurf(isu1)%NODES(i,k)==ii) found=1
507 END DO
508 found_line = found_line + found
509 END DO
510 IF ((found_line==2).AND.(taglinm(im)==0)) THEN
511 intbuf_tab(ni)%ADDSUBM(im)=intbuf_tab(ni)%ADDSUBM(im)+1
512C Line must be taken into account only one time for one subinterface
513 taglinm(im) = 1
514 ENDIF
515 ENDDO
516 ENDDO
517
518 ENDDO
519
520 ENDIF
521C
522 isu2 =nom_opt(6,ninter+jsub) ! SURFACE ID 2
523 IF(isu2/=0)THEN
524 DO i=1,igrsurf(isu2)%NSEG
525
526 DO inod=1,2
527 in=igrsurf(isu2)%NODES(i,2*inod)
528 DO jad=iadd(in),iadd(in+1)-1
529 im = nod2rtmm(jad)
530 found_line = 0
531 DO j=1,2
532 ii=intbuf_tab(ni)%IRECTM(2*(is-1)+j)
533 found=0
534 DO k=1,4
535 IF(igrsurf(isu2)%NODES(i,k)==ii) found=1
536 END DO
537 found_line = found_line + found
538 END DO
539 IF ((found_line==2).AND.(taglinm(im)==0)) THEN
540 intbuf_tab(ni)%ADDSUBM(im)=intbuf_tab(ni)%ADDSUBM(im)+1
541C Line must be taken into account only one time for one subinterface
542 taglinm(im) = 1
543 ENDIF
544 ENDDO
545 ENDDO
546
547 ENDDO
548
549 ENDIF
550C
551
552 END IF
553 END DO
554C
555 cur=1
556 DO im=1,nrtm
557 next =cur+intbuf_tab(ni)%ADDSUBM(im)
558 intbuf_tab(ni)%ADDSUBM(im)=cur
559 cur =next
560 END DO
561 intbuf_tab(ni)%ADDSUBM(nrtm+1)=cur
562C
563C utilise KAD(1:NRTM)
564 DO im=1,nrtm
565 kad(im)=intbuf_tab(ni)%ADDSUBM(im)
566 END DO
567C
568C prepare LISUBM :
569C
570 ksub=0
571 DO jsub=1,nintsub
572 IF(nom_opt(2,ninter+jsub)==noint
573 . .AND.nom_opt(5,ninter+jsub)==1)THEN
574 ksub=ksub+1
575C
576 islin2 =nom_opt(3,ninter+jsub)
577 nne =igrslin(islin2)%NSEG
578C
579 DO i=1,nne
580 in=igrslin(islin2)%NODES(i,1)
581 km=0
582C
583 DO jad=iadd(in),iadd(in+1)-1
584 im = nod2rtmm(jad)
585 found_line = 0
586 DO j=1,2
587 ii=igrslin(islin2)%NODES(i,j)
588 found=0
589 DO k=1,2
590 IF(intbuf_tab(ni)%IRECTM(2*(im-1)+k)==ii) found=1
591 END DO
592 found_line = found_line + found
593 END DO
594 IF (found_line==2) THEN
595 km=im
596 EXIT
597 ENDIF
598 ENDDO
599C
600 IF(km/=0)THEN
601 intbuf_tab(ni)%LISUBM(kad(im))=ksub
602 kad(im)=kad(im)+1
603 END IF
604 END DO
605
606
607C
608C---------Case of subinter defined with inter 0 -------------
609C
610 ELSEIF(nom_opt(2,ninter+jsub) == 0
611 . .AND. nom_opt(5,ninter+jsub) == 1) THEN
612
613 ksub=ksub+1
614C
615C LISUB(KSUB)=JSUB no interne de la sous-interface
616 intbuf_tab(ni)%LISUB (ksub) = jsub
617C
618C prepare ADDSUBS , LISUBS (K31) :
619C LISUBS(ADDSUBS(IS):ADDSUBS(IS+1)-1) SS. INTERF CONTENANT LE ND SECOND. IS
620C
621 taglinm(1:maxrtms) = 0
622
623 isu1 =nom_opt(3,ninter+jsub) ! SURFACE ID 1
624 IF(isu1/=0)THEN
625 DO i=1,igrsurf(isu1)%NSEG
626
627 DO inod=1,2
628 in=igrsurf(isu1)%NODES(i,2*inod)
629 DO jad=iadd(in),iadd(in+1)-1
630 im = nod2rtmm(jad)
631 found_line = 0
632 DO j=1,2
633 ii=intbuf_tab(ni)%IRECTM(2*(is-1)+j)
634 found=0
635 DO k=1,4
636 IF(igrsurf(isu1)%NODES(i,k)==ii) found=1
637 END DO
638 found_line = found_line + found
639 END DO
640
641 IF (found_line==2)THEN
642 IF(taglinm(im)==0) THEN
643 intbuf_tab(ni)%INFLG_SUBM(kad(im))=
644 . bitset(intbuf_tab(ni)%INFLG_SUBM(kad(im)),1)
645 intbuf_tab(ni)%LISUBM(kad(im))=ksub
646 kad(im)=kad(im)+1
647C Line must be taken into account only one time for one subinterface
648 taglinm(im) = 1
649 ELSE
650 intbuf_tab(ni)%INFLG_SUBM(kad(im)-1)=
651 . bitset(intbuf_tab(ni)%INFLG_SUBM(kad(im)-1),1)
652 ENDIF
653 ENDIF
654 ENDDO
655 ENDDO
656
657 ENDDO
658 ENDIF
659
660 isu2 =nom_opt(6,ninter+jsub) ! SURFACE ID 1
661 IF(isu2/=0)THEN
662 DO i=1,igrsurf(isu2)%NSEG
663
664 DO inod=1,2
665 in=igrsurf(isu2)%NODES(i,2*inod)
666 DO jad=iadd(in),iadd(in+1)-1
667 im = nod2rtmm(jad)
668 found_line = 0
669 DO j=1,2
670 ii=intbuf_tab(ni)%IRECTM(2*(is-1)+j)
671 found=0
672 DO k=1,4
673 IF(igrsurf(isu2)%NODES(i,k)==ii) found=1
674 END DO
675 found_line = found_line + found
676 END DO
677
678 IF (found_line==2)THEN
679 IF(taglinm(im)==0) THEN
680 intbuf_tab(ni)%INFLG_SUBM(kad(im))=
681 . bitset(intbuf_tab(ni)%INFLG_SUBM(kad(im)),0)
682 intbuf_tab(ni)%LISUBM(kad(im))=ksub
683 kad(im)=kad(im)+1
684C Line must be taken into account only one time for one subinterface
685 taglinm(im) = 1
686 ELSE
687 intbuf_tab(ni)%INFLG_SUBM(kad(im)-1)=
688 . bitset(intbuf_tab(ni)%INFLG_SUBM(kad(im)-1),0)
689 ENDIF
690 ENDIF
691 ENDDO
692 ENDDO
693
694 ENDDO
695 ENDIF
696C
697C
698 END IF
699 END DO
700C
701
702C
703 ELSEIF ((nty==11).AND.(nt19>0)) THEN
704C interface type11 of interface type19 - subinterface input by surfaces
705C
706C
707C--- SECONDARY Side--
708C
709 iadd(1:numnod+1) = 0
710 DO is=1,nrts
711 in =intbuf_tab(ni)%IRECTS(2*(is-1)+1)
712 iadd(in) =iadd(in)+1
713 in =intbuf_tab(ni)%IRECTS(2*(is-1)+2)
714 iadd(in) =iadd(in)+1
715 END DO
716C
717 cur=1
718 DO i=1,numnod
719 next =cur+iadd(i)
720 iadd(i) =cur
721 cur =next
722 END DO
723 iadd(numnod+1)=cur
724C
725 DO i=1,numnod
726 kad(i)=iadd(i)
727 END DO
728C
729 DO is=1,nrts
730 in =intbuf_tab(ni)%IRECTS(2*(is-1)+1)
731 nod2rtms(kad(in)) = is
732 kad(in) = kad(in) + 1
733 in =intbuf_tab(ni)%IRECTS(2*(is-1)+2)
734 nod2rtms(kad(in)) = is
735 kad(in) = kad(in) + 1
736 ENDDO
737C
738 ksub=0
739 DO jsub=1,nintsub
740 id1=nom_opt(1,ninter+jsub)
741 CALL fretitl2(titr1,
742 . nom_opt(lnopt1-ltitr+1,ninter+jsub),ltitr)
743 IF(nom_opt(2,ninter+jsub)==noint
744 . .AND.nom_opt(5,ninter+jsub)==1)THEN
745 ksub=ksub+1
746C LISUB(KSUB)=JSUB no interne de la sous-interface
747 intbuf_tab(ni)%LISUB(ksub) = jsub
748 intbuf_tab(ni)%TYPSUB(ksub) = 1
749C
750 isu =nom_opt(4,ninter+jsub)
751 nne =igrsurf(isu)%NSEG
752 taglins(1:maxrtms) = 0
753C
754 DO i=1,nne
755 DO inod=1,2
756 in=igrsurf(isu)%NODES(i,2*inod)
757 DO jad=iadd(in),iadd(in+1)-1
758 is = nod2rtms(jad)
759 found_line = 0
760 DO j=1,2
761 ii=intbuf_tab(ni)%IRECTS(2*(is-1)+j)
762 found=0
763 DO k=1,4
764 IF(igrsurf(isu)%NODES(i,k)==ii) found=1
765 END DO
766 found_line = found_line + found
767 END DO
768 IF ((found_line==2).AND.(taglins(is)==0)) THEN
769 intbuf_tab(ni)%ADDSUBS(is)=intbuf_tab(ni)%ADDSUBS(is)+1
770C Line must be taken into account only one time for one subinterface
771 taglins(is) = 1
772 ENDIF
773 ENDDO
774 ENDDO
775 END DO
776C
777C---------Case of subinter defined with inter 0 -------------
778C
779 ELSEIF(nom_opt(2,ninter+jsub) == 0
780 . .AND. nom_opt(5,ninter+jsub) == 1) THEN
781
782 ksub=ksub+1
783C
784C LISUB(KSUB)=JSUB no interne de la sous-interface
785 intbuf_tab(ni)%LISUB (ksub) = jsub
786C
787C prepare ADDSUBS , LISUBS (K31) :
788C LISUBS(ADDSUBS(IS):ADDSUBS(IS+1)-1) SS. INTERF CONTENANT LE ND SECOND. IS
789C
790 taglins(1:maxrtms) = 0
791
792 isu2 =nom_opt(6,ninter+jsub) ! SURFACE ID 2
793 IF(isu2/=0)THEN
794 intbuf_tab(ni)%TYPSUB(ksub) = 2
795 DO i=1,igrsurf(isu2)%NSEG
796
797 DO inod=1,2
798 in=igrsurf(isu2)%NODES(i,2*inod)
799 DO jad=iadd(in),iadd(in+1)-1
800 is = nod2rtms(jad)
801 found_line = 0
802 DO j=1,2
803 ii=intbuf_tab(ni)%IRECTS(2*(is-1)+j)
804 found=0
805 DO k=1,4
806 IF(igrsurf(isu2)%NODES(i,k)==ii) found=1
807 END DO
808 found_line = found_line + found
809 END DO
810 IF ((found_line==2).AND.(taglins(is)==0)) THEN
811 intbuf_tab(ni)%ADDSUBS(is)=intbuf_tab(ni)%ADDSUBS(is)+1
812C Line must be taken into account only one time for one subinterface
813 taglins(is) = 1
814 ENDIF
815 ENDDO
816 ENDDO
817
818 ENDDO
819
820 ENDIF
821
822 isu1 =nom_opt(3,ninter+jsub) ! SURFACE ID 1
823 IF(isu1/=0)THEN
824 intbuf_tab(ni)%TYPSUB(ksub) = 3
825 DO i=1,igrsurf(isu1)%NSEG
826
827 DO inod=1,2
828 in=igrsurf(isu1)%NODES(i,2*inod)
829 DO jad=iadd(in),iadd(in+1)-1
830 is = nod2rtms(jad)
831 found_line = 0
832 DO j=1,2
833 ii=intbuf_tab(ni)%IRECTS(2*(is-1)+j)
834 found=0
835 DO k=1,4
836 IF(igrsurf(isu1)%NODES(i,k)==ii) found=1
837 END DO
838 found_line = found_line + found
839 END DO
840 IF ((found_line==2).AND.(taglins(is)==0)) THEN
841 intbuf_tab(ni)%ADDSUBS(is)=intbuf_tab(ni)%ADDSUBS(is)+1
842C Line must be taken into account only one time for one subinterface
843 taglins(is) = 1
844 ENDIF
845 ENDDO
846 ENDDO
847
848 ENDDO
849
850 ENDIF
851C
852C
853
854 END IF
855 END DO
856C
857 cur=1
858 DO is=1,nrts
859 next =cur+intbuf_tab(ni)%ADDSUBS(is)
860 intbuf_tab(ni)%ADDSUBS(is)=cur
861 cur =next
862 END DO
863 intbuf_tab(ni)%ADDSUBS(nrts+1)=cur
864C
865C utilise KAD(1:NRTM)
866 DO is=1,nrts
867 kad(is)=intbuf_tab(ni)%ADDSUBS(is)
868 END DO
869C
870C prepare LISUBS :
871C
872 ksub=0
873 DO jsub=1,nintsub
874 IF(nom_opt(2,ninter+jsub)==noint
875 . .AND.nom_opt(5,ninter+jsub)==1)THEN
876 ksub=ksub+1
877C
878 isu =nom_opt(4,ninter+jsub)
879 nne =igrsurf(isu)%NSEG
880 taglins(1:maxrtms) = 0
881C
882 DO i=1,nne
883 DO inod=1,2
884 in=igrsurf(isu)%NODES(i,2*inod)
885 DO jad=iadd(in),iadd(in+1)-1
886 is = nod2rtms(jad)
887 found_line = 0
888 DO j=1,2
889 ii=intbuf_tab(ni)%IRECTS(2*(is-1)+j)
890 found=0
891 DO k=1,4
892 IF(igrsurf(isu)%NODES(i,k)==ii) found=1
893 END DO
894 found_line = found_line + found
895 END DO
896 IF ((found_line==2).AND.(taglins(is)==0)) THEN
897 intbuf_tab(ni)%LISUBS(kad(is))=ksub
898 kad(is)=kad(is)+1
899C Line must be taken into account only one time for one subinterface
900 taglins(is) = 1
901 ENDIF
902 ENDDO
903 ENDDO
904 END DO
905C---------Case of subinter defined with inter 0 -------------
906C
907 ELSEIF(nom_opt(2,ninter+jsub) == 0
908 . .AND. nom_opt(5,ninter+jsub) == 1) THEN
909
910 ksub=ksub+1
911C
912C LISUB(KSUB)=JSUB no interne de la sous-interface
913 intbuf_tab(ni)%LISUB (ksub) = jsub
914C
915C prepare ADDSUBS , LISUBS (K31) :
916C LISUBS(ADDSUBS(IS):ADDSUBS(IS+1)-1) SS. INTERF CONTENANT LE ND SECOND. IS
917C
918 taglins(1:maxrtms) = 0
919
920 isu2 =nom_opt(6,ninter+jsub) ! SURFACE ID 2
921 IF(isu2/=0)THEN
922 DO i=1,igrsurf(isu2)%NSEG
923
924 DO inod=1,2
925 in=igrsurf(isu2)%NODES(i,2*inod)
926 DO jad=iadd(in),iadd(in+1)-1
927 is = nod2rtms(jad)
928 found_line = 0
929 DO j=1,2
930 ii=intbuf_tab(ni)%IRECTS(2*(is-1)+j)
931 found=0
932 DO k=1,4
933 IF(igrsurf(isu2)%NODES(i,k)==ii) found=1
934 END DO
935 found_line = found_line + found
936 END DO
937
938 IF (found_line==2)THEN
939 IF(taglins(is)==0) THEN
940 intbuf_tab(ni)%INFLG_SUBS(kad(is))=
941 . bitset(intbuf_tab(ni)%INFLG_SUBS(kad(is)),0)
942 intbuf_tab(ni)%LISUBS(kad(is))=ksub
943 kad(is)=kad(is)+1
944C Line must be taken into account only one time for one subinterface
945 taglins(is) = 1
946 ELSE
947 intbuf_tab(ni)%INFLG_SUBS(kad(is)-1)=
948 . bitset(intbuf_tab(ni)%INFLG_SUBS(kad(is)-1),0)
949 ENDIF
950 ENDIF
951 ENDDO
952 ENDDO
953
954 ENDDO
955
956 ENDIF
957C
958 isu1 =nom_opt(3,ninter+jsub) ! SURFACE ID 1
959 IF(isu1/=0)THEN
960 DO i=1,igrsurf(isu1)%NSEG
961
962 DO inod=1,2
963 in=igrsurf(isu1)%NODES(i,2*inod)
964 DO jad=iadd(in),iadd(in+1)-1
965 is = nod2rtms(jad)
966 found_line = 0
967 DO j=1,2
968 ii=intbuf_tab(ni)%IRECTS(2*(is-1)+j)
969 found=0
970 DO k=1,4
971 IF(igrsurf(isu1)%NODES(i,k)==ii) found=1
972 END DO
973 found_line = found_line + found
974 END DO
975
976 IF (found_line==2)THEN
977 IF(taglins(is)==0) THEN
978 intbuf_tab(ni)%INFLG_SUBS(kad(is))=
979 . bitset(intbuf_tab(ni)%INFLG_SUBS(kad(is)),1)
980 intbuf_tab(ni)%LISUBS(kad(is))=ksub
981 kad(is)=kad(is)+1
982C Line must be taken into account only one time for one subinterface
983 taglins(is) = 1
984 ELSE
985 intbuf_tab(ni)%INFLG_SUBS(kad(is)-1)=
986 . bitset(intbuf_tab(ni)%INFLG_SUBS(kad(is)-1),1)
987 ENDIF
988 ENDIF
989 ENDDO
990 ENDDO
991
992 ENDDO
993
994 ENDIF
995 END IF
996 END DO
997C
998C--- MAIN Side--
999C
1000 iadd(1:numnod+1) = 0
1001 DO im=1,nrtm
1002 in =intbuf_tab(ni)%IRECTM(2*(im-1)+1)
1003 iadd(in) =iadd(in)+1
1004 in =intbuf_tab(ni)%IRECTM(2*(im-1)+2)
1005 iadd(in) =iadd(in)+1
1006 END DO
1007C
1008 cur=1
1009 DO i=1,numnod
1010 next =cur+iadd(i)
1011 iadd(i) =cur
1012 cur =next
1013 END DO
1014 iadd(numnod+1)=cur
1015C
1016 DO i=1,numnod
1017 kad(i)=iadd(i)
1018 END DO
1019C
1020 DO im=1,nrtm
1021 in =intbuf_tab(ni)%IRECTM(2*(im-1)+1)
1022 nod2rtmm(kad(in)) = im
1023 kad(in) = kad(in) + 1
1024 in =intbuf_tab(ni)%IRECTM(2*(im-1)+2)
1025 nod2rtmm(kad(in)) = im
1026 kad(in) = kad(in) + 1
1027 ENDDO
1028C
1029 ksub=0
1030 DO jsub=1,nintsub
1031 id1=nom_opt(1,ninter+jsub)
1032 CALL fretitl2(titr1,
1033 . nom_opt(lnopt1-ltitr+1,ninter+jsub),ltitr)
1034 IF(nom_opt(2,ninter+jsub)==noint
1035 . .AND.nom_opt(5,ninter+jsub)==1)THEN
1036 ksub=ksub+1
1037C
1038 isu =nom_opt(3,ninter+jsub)
1039 nne =igrsurf(isu)%NSEG
1040 taglinm(1:maxrtms) = 0
1041C
1042 DO i=1,nne
1043 DO inod=1,2
1044 in=igrsurf(isu)%NODES(i,2*inod)
1045 DO jad=iadd(in),iadd(in+1)-1
1046 im = nod2rtmm(jad)
1047 found_line = 0
1048 DO j=1,2
1049 ii=intbuf_tab(ni)%IRECTM(2*(im-1)+j)
1050 found=0
1051 DO k=1,4
1052 IF(igrsurf(isu)%NODES(i,k)==ii) found=1
1053 END DO
1054 found_line = found_line + found
1055 END DO
1056 IF ((found_line==2).AND.(taglinm(im)==0)) THEN
1057 intbuf_tab(ni)%ADDSUBM(im)=intbuf_tab(ni)%ADDSUBM(im)+1
1058C Line must be taken into account only one time for one subinterface
1059 taglinm(im) = 1
1060 ENDIF
1061 ENDDO
1062 ENDDO
1063 END DO
1064C---------Case of subinter defined with inter 0 -------------
1065C
1066 ELSEIF(nom_opt(2,ninter+jsub) == 0
1067 . .AND. nom_opt(5,ninter+jsub) == 1) THEN
1068
1069 ksub=ksub+1
1070C
1071C LISUB(KSUB)=JSUB no interne de la sous-interface
1072 intbuf_tab(ni)%LISUB (ksub) = jsub
1073C
1074C prepare ADDSUBS , LISUBS (K31) :
1075C LISUBS(ADDSUBS(IS):ADDSUBS(IS+1)-1) SS. INTERF CONTENANT LE ND SECOND. IS
1076C
1077 taglinm(1:maxrtms) = 0
1078
1079 isu1 =nom_opt(3,ninter+jsub) ! SURFACE ID 1
1080 IF(isu1/=0)THEN
1081 DO i=1,igrsurf(isu1)%NSEG
1082
1083 DO inod=1,2
1084 in=igrsurf(isu1)%NODES(i,2*inod)
1085 DO jad=iadd(in),iadd(in+1)-1
1086 im = nod2rtmm(jad)
1087 found_line = 0
1088 DO j=1,2
1089 ii=intbuf_tab(ni)%IRECTM(2*(is-1)+j)
1090 found=0
1091 DO k=1,4
1092 IF(igrsurf(isu1)%NODES(i,k)==ii) found=1
1093 END DO
1094 found_line = found_line + found
1095 END DO
1096 IF ((found_line==2).AND.(taglinm(im)==0)) THEN
1097 intbuf_tab(ni)%ADDSUBM(im)=intbuf_tab(ni)%ADDSUBM(im)+1
1098C Line must be taken into account only one time for one subinterface
1099 taglinm(im) = 1
1100 ENDIF
1101
1102 ENDDO
1103 ENDDO
1104
1105 ENDDO
1106
1107 ENDIF
1108
1109
1110 isu2 =nom_opt(6,ninter+jsub) ! SURFACE ID 2
1111 IF(isu2/=0)THEN
1112 DO i=1,igrsurf(isu2)%NSEG
1113
1114 DO inod=1,2
1115 in=igrsurf(isu2)%NODES(i,2*inod)
1116 DO jad=iadd(in),iadd(in+1)-1
1117 im = nod2rtmm(jad)
1118 found_line = 0
1119 DO j=1,2
1120 ii=intbuf_tab(ni)%IRECTM(2*(is-1)+j)
1121 found=0
1122 DO k=1,4
1123 IF(igrsurf(isu2)%NODES(i,k)==ii) found=1
1124 END DO
1125 found_line = found_line + found
1126 END DO
1127 IF ((found_line==2).AND.(taglinm(im)==0)) THEN
1128 intbuf_tab(ni)%ADDSUBM(im)=intbuf_tab(ni)%ADDSUBM(im)+1
1129C Line must be taken into account only one time for one subinterface
1130 taglinm(im) = 1
1131 ENDIF
1132 ENDDO
1133 ENDDO
1134
1135 ENDDO
1136
1137 ENDIF
1138C
1139C
1140 END IF
1141 END DO
1142C
1143 cur=1
1144 DO im=1,nrtm
1145 next =cur+intbuf_tab(ni)%ADDSUBM(im)
1146 intbuf_tab(ni)%ADDSUBM(im)=cur
1147 cur =next
1148 END DO
1149 intbuf_tab(ni)%ADDSUBM(nrtm+1)=cur
1150C
1151 DO im=1,nrtm
1152 kad(im)=intbuf_tab(ni)%ADDSUBM(im)
1153 END DO
1154C
1155C prepare LISUBM :
1156C
1157 ksub=0
1158 DO jsub=1,nintsub
1159 IF(nom_opt(2,ninter+jsub)==noint
1160 . .AND.nom_opt(5,ninter+jsub)==1)THEN
1161 ksub=ksub+1
1162C
1163 isu =nom_opt(3,ninter+jsub)
1164 nne =igrsurf(isu)%NSEG
1165 taglinm(1:maxrtms) = 0
1166C
1167 DO i=1,nne
1168 DO inod=1,2
1169 in=igrsurf(isu)%NODES(i,2*inod)
1170 DO jad=iadd(in),iadd(in+1)-1
1171 im = nod2rtmm(jad)
1172 found_line = 0
1173 DO j=1,2
1174 ii=intbuf_tab(ni)%IRECTM(2*(im-1)+j)
1175 found=0
1176 DO k=1,4
1177 IF(igrsurf(isu)%NODES(i,k)==ii) found=1
1178 END DO
1179 found_line = found_line + found
1180 END DO
1181 IF ((found_line==2).AND.(taglinm(im)==0)) THEN
1182 intbuf_tab(ni)%LISUBM(kad(im))=ksub
1183 kad(im)=kad(im)+1
1184C Line must be taken into account only one time for one subinterface
1185 taglinm(im) = 1
1186 ENDIF
1187 ENDDO
1188 ENDDO
1189 END DO
1190C
1191C---------Case of subinter defined with inter 0 -------------
1192C
1193 ELSEIF(nom_opt(2,ninter+jsub) == 0
1194 . .AND. nom_opt(5,ninter+jsub) == 1) THEN
1195
1196 ksub=ksub+1
1197C
1198C LISUB(KSUB)=JSUB no interne de la sous-interface
1199 intbuf_tab(ni)%LISUB (ksub) = jsub
1200C
1201C prepare ADDSUBS , LISUBS (K31) :
1202C LISUBS(ADDSUBS(IS):ADDSUBS(IS+1)-1) SS. INTERF CONTENANT LE ND SECOND. IS
1203C
1204 taglinm(1:maxrtms) = 0
1205
1206 isu1 =nom_opt(3,ninter+jsub) ! SURFACE ID 1
1207 IF(isu1/=0)THEN
1208 intbuf_tab(ni)%TYPSUB(ksub) = 3
1209 DO i=1,igrsurf(isu1)%NSEG
1210
1211 DO inod=1,2
1212 in=igrsurf(isu1)%NODES(i,2*inod)
1213 DO jad=iadd(in),iadd(in+1)-1
1214 im = nod2rtmm(jad)
1215 found_line = 0
1216 DO j=1,2
1217 ii=intbuf_tab(ni)%IRECTM(2*(is-1)+j)
1218 found=0
1219 DO k=1,4
1220 IF(igrsurf(isu1)%NODES(i,k)==ii) found=1
1221 END DO
1222 found_line = found_line + found
1223 END DO
1224 IF (found_line==2)THEN
1225 IF(taglinm(im)==0) THEN
1226 intbuf_tab(ni)%INFLG_SUBM(kad(im))=
1227 . bitset(intbuf_tab(ni)%INFLG_SUBM(kad(im)),1)
1228 intbuf_tab(ni)%LISUBM(kad(im))=ksub
1229 kad(im)=kad(im)+1
1230C Line must be taken into account only one time for one subinterface
1231 taglinm(im) = 1
1232 ELSE
1233 intbuf_tab(ni)%INFLG_SUBM(kad(im)-1)=
1234 . bitset(intbuf_tab(ni)%INFLG_SUBM(kad(im)-1),1)
1235 ENDIF
1236 ENDIF
1237 ENDDO
1238 ENDDO
1239
1240 ENDDO
1241 ENDIF
1242C
1243 isu2 =nom_opt(6,ninter+jsub) ! SURFACE ID 2
1244 IF(isu2/=0)THEN
1245 intbuf_tab(ni)%TYPSUB(ksub) = 3
1246 DO i=1,igrsurf(isu2)%NSEG
1247
1248 DO inod=1,2
1249 in=igrsurf(isu2)%NODES(i,2*inod)
1250 DO jad=iadd(in),iadd(in+1)-1
1251 im = nod2rtmm(jad)
1252 found_line = 0
1253 DO j=1,2
1254 ii=intbuf_tab(ni)%IRECTM(2*(is-1)+j)
1255 found=0
1256 DO k=1,4
1257 IF(igrsurf(isu2)%NODES(i,k)==ii) found=1
1258 END DO
1259 found_line = found_line + found
1260 END DO
1261 IF (found_line==2)THEN
1262 IF(taglinm(im)==0) THEN
1263 intbuf_tab(ni)%INFLG_SUBM(kad(im))=
1264 . bitset(intbuf_tab(ni)%INFLG_SUBM(kad(im)),0)
1265 intbuf_tab(ni)%LISUBM(kad(im))=ksub
1266 kad(im)=kad(im)+1
1267C Line must be taken into account only one time for one subinterface
1268 taglinm(im) = 1
1269 ELSE
1270 intbuf_tab(ni)%INFLG_SUBM(kad(im)-1)=
1271 . bitset(intbuf_tab(ni)%INFLG_SUBM(kad(im)-1),0)
1272 ENDIF
1273 ENDIF
1274 ENDDO
1275 ENDDO
1276
1277 ENDDO
1278 ENDIF
1279C
1280 END IF
1281 END DO
1282
1283 ENDIF
1284
1285C-------------------------------------
1286 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