OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
inintr2.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!|| inintr2 ../starter/source/interfaces/inter3d1/inintr2.F
25!||--- called by ------------------------------------------------------
26!|| lectur ../starter/source/starter/lectur.F
27!||--- calls -----------------------------------------------------
28!|| ancmsg ../starter/source/output/message/message.F
29!|| fretitl2 ../starter/source/starter/freform.F
30!|| i20sta ../starter/source/interfaces/inter3d1/inintr2.F
31!|| i24surf_pxfem ../starter/source/interfaces/inter3d1/inintr2.f
32!|| i2_dtn ../starter/source/interfaces/inter3d1/i2_dtn.F
33!|| i2_dtn_27 ../starter/source/interfaces/inter3d1/i2_dtn_27.F
34!|| i2_dtn_28 ../starter/source/interfaces/inter3d1/i2_dtn_28.F
35!|| iniend ../starter/source/interfaces/inter3d1/iniend.F
36!|| iniend2d ../starter/source/interfaces/inter3d1/iniend.F
37!|| int2cy_chk ../starter/source/constraints/general/bcs/lecbcscyc.f
38!|| int2modif_nd ../starter/source/elements/solid/solide10/dim_s10edg.F
39!|| itagsl12 ../starter/source/interfaces/inter3d1/inintr2.F
40!|| itagsl2 ../starter/source/interfaces/inter3d1/itagsl2.F
41!|| remn_i2_edgop ../starter/source/interfaces/inter3d1/i7remnode.F
42!|| remn_i2op ../starter/source/interfaces/inter3d1/i7remnode.F
43!|| remn_self24 ../starter/source/interfaces/inter3d1/remn_self24.F
44!|| ri2_int24p_ini ../starter/source/interfaces/inter3d1/i7remnode.F
45!||--- uses -----------------------------------------------------
46!|| intbufscratch_mod ../starter/source/interfaces/interf1/intbufscratch_mod.F
47!|| message_mod ../starter/share/message_module/message_mod.F
48!||====================================================================
49 SUBROUTINE inintr2(IPARI ,INSCR ,X ,
50 . IXS ,IXQ ,IXC ,PM ,GEO ,
51 . INTC ,ITAB ,MS ,NPBY ,LPBY ,
52 . MWA ,IKINE ,I2NSNT ,IN ,
53 . STIFN ,STIFINT,NOM_OPT,INOD_PXFEM,MS_PLY,
54 . INTBUF_TAB,STIFINTR,ITAGND,ICNDS10,MS_B,IN_B,
55 . NSTRF ,ITAGCYC,IRBE2 ,IRBE3 ,LRBE3 ,
56 . KNOD2ELS ,NOD2ELS,IXS10 ,IXS16 ,IXS20,
57 . S_NOD2ELS)
58C-----------------------------------------------
59C M o d u l e s
60C-----------------------------------------------
61 USE message_mod
62 USE intbufdef_mod
63 USE intbufscratch_mod
64 USE names_and_titles_mod , ONLY : nchartitle
65C============================================================================
66C I m p l i c i t T y p e s
67C-----------------------------------------------
68#include "implicit_f.inc"
69#include "param_c.inc"
70C-----------------------------------------------
71C C o m m o n B l o c k s
72C-----------------------------------------------
73#include "com01_c.inc"
74#include "com04_c.inc"
75#include "scr17_c.inc"
76#include "tabsiz_c.inc"
77C-----------------------------------------------
78C D u m m y A r g u m e n t s
79C-----------------------------------------------
80 INTEGER, DIMENSION(6,NUMELS10) ,INTENT(IN) :: IXS10
81 INTEGER, DIMENSION(8,NUMELS16) ,INTENT(IN) :: IXS16
82 INTEGER, DIMENSION(12,NUMELS20) ,INTENT(IN) :: IXS20
83 INTEGER, DIMENSION(NUMNOD+1) ,INTENT(IN) :: KNOD2ELS
84 INTEGER, INTENT(IN) :: S_NOD2ELS
85 INTEGER, DIMENSION(S_NOD2ELS) ,INTENT(IN) :: NOD2ELS
86 INTEGER, DIMENSION(NRBE2L,NRBE2), INTENT(IN) :: IRBE2
87 INTEGER, DIMENSION(NRBE3L,NRBE3), INTENT(IN) :: IRBE3
88 INTEGER, DIMENSION(SLRBE3), INTENT(IN) :: LRBE3
89 INTEGER IPARI(NPARI,*), IXS(*), IXQ(*),
90 . ixc(*), intc(*), itab(*), npby(*), lpby(*), mwa(*),
91 . ikine(*), i2nsnt,inod_pxfem(*),itagnd(*),icnds10(3,*),
92 . nstrf(*),itagcyc(*)
93 my_real x(*), pm(*), geo(*), ms(*), in(*), stifn(*),stifint(*),ms_ply(*),stifintr(*),ms_b(*),in_b(*)
94 INTEGER NOM_OPT(LNOPT1,*)
95
96 TYPE(intbuf_struct_) INTBUF_TAB(*)
97 TYPE(scratch_struct_) INSCR(*)
98
99C-----------------------------------------------
100C L o c a l V a r i a b l e s
101C-----------------------------------------------
102 INTEGER N, JINSCR, NINT, NTY,NRTM,NRTM0,NRTM_SH,INTPLY,KFI,ILEV,SWITCH,NSN,NREMN(NINTER),NINT2
103 INTEGER ID,I,K,J1,J2
104 CHARACTER(LEN=NCHARTITLE) :: TITR
105 INTEGER :: FLAG_OUTPUT !< flag for output
106 INTEGER :: SKIP_TYPE25_EDGE_2_EDGE !< flag to activate only the computation of interface type 25 with edge to edge
107C=======================================================================
108C
109C SWITCH OF INTERF2 SPOTFLAG26 TO SPOTFLAG25 IF POSSIBLE
110C
111 nint2 = 0
112 DO n=1,ninter
113 nint=n
114 id=nom_opt(1,nint)
115 nty = ipari(7,n)
116 IF (nty == 2) nint2=nint2+1
117 ilev =ipari(20,n)
118 nsn =ipari(5,n)
119 CALL fretitl2(titr,nom_opt(lnopt1-ltitr+1,nint),ltitr)
120 switch = 1
121 IF ((nty==2).AND.(ilev==26)) THEN
122 IF (iroddl==1) THEN
123 DO i=1,nsn
124 IF (in(intbuf_tab(n)%NSV(i))>zero) switch=0
125 ENDDO
126 ENDIF
127 IF (switch==1) THEN
128 ipari(20,n) = 25
129 CALL ancmsg(msgid=1177,
130 . msgtype=msgwarning,
131 . anmode=aninfo_blind_1,
132 . i1=id,
133 . c1=titr)
134 ELSE
135 CALL ancmsg(msgid=1178,
136 . msgtype=msgwarning,
137 . anmode=aninfo_blind_1,
138 . i1=id,
139 . c1=titr)
140 ENDIF
141 ENDIF
142 END DO
143C
144C
145 DO n=1,ninter
146 nty = ipari(7,n)
147C-- deactivated interface
148 IF (nty==0) cycle
149C
150 jinscr=ipari(10,n)
151 nint=n
152
153 id=nom_opt(1,nint)
154 CALL fretitl2(titr, nom_opt(lnopt1-ltitr+1,nint),ltitr)
155 IF (n2d == 0) THEN
156 CALL iniend(
157 1 inscr(n)%WA ,x ,ixs ,
158 2 ixc ,pm ,geo ,ipari(1,n),nint ,
159 3 intc ,itab ,ms ,npby ,lpby ,
160 4 mwa ,ikine ,in ,stifint,
161 5 id ,titr ,intbuf_tab(n),stifintr )
162 ELSE
163 CALL iniend2d(
164 1 ipari(1,n),nint, ms, intbuf_tab(n) )
165 ENDIF
166 ENDDO
167C
168C TAGAGE DESACTIVATION SECONDARY INTERF 12 AVEC CONDITION CINEMATIQUE
169C
170 DO n=1,ninter
171 nty = ipari(7,n)
172 IF (nty == 12) THEN
173 CALL itagsl12(ipari(1,n),itab,ikine,intbuf_tab(n))
174 ELSEIF(nty==2)THEN
175 i2nsnt = i2nsnt + ipari(5,n)
176 ENDIF
177 ENDDO
178C
179C SWITCH INTERF 2 AVEC CONDITION CINEMATIQUE => METHODE PENALITE
180C
181 CALL itagsl2(ipari ,nom_opt,itab ,ikine ,intbuf_tab,
182 . itagnd,icnds10,nstrf ,itagcyc,irbe2 ,
183 . irbe3 ,lrbe3 )
184C
185C LIMITATION RIGIDITE ANCRAGE
186C
187 DO n=1,ninter
188 nty=ipari(7,n)
189 IF(nty==20)THEN
190 CALL i20sta(ipari(1,n),stifn,intbuf_tab(n))
191 ENDIF
192 ENDDO
193C Xgement ply xfem
194!! IF(IPLYXFEM > 0) THEN
195
196 IF(intplyxfem > 0) THEN
197 DO n=1,ninter
198 nty=ipari(7,n)
199 intply = ipari(66,n)
200 IF(nty == 24 .AND. intply > 0 )THEN
201 nrtm_sh = ipari(42,n)
202 nrtm = ipari(4,n)
203 nrtm0 = nrtm - nrtm_sh
204 CALL i24surf_pxfem(nrtm,intbuf_tab(n)%IRECTM,inod_pxfem,intply,
205 . intbuf_tab(n)%NVOISIN,intbuf_tab(n)%MSEGTYP24,ms_ply ,
206 . intbuf_tab(n)%ISEG_PXFEM,intbuf_tab(n)%ISEG_PLY)
207 ENDIF
208 ENDDO
209 ENDIF
210C
211C DYNAMIC CONDENSATION FOR TETRA10 - MIDDLE NODES REMOVED FROM INTERFACE
212C
213 IF (ns10e>0) CALL int2modif_nd(ipari,intbuf_tab,itagnd,icnds10,itab)
214C /BCS/CYCLIC
215 IF (nbcscyc>0) CALL int2cy_chk(ipari,intbuf_tab,itagcyc,itab)
216C
217C UPDATE OF NODAL TIME STEP FOR ADDED MASS ESTIMATION
218C
219 DO n=1,ninter
220 nty = ipari(7,n)
221 ilev =ipari(20,n)
222 nsn =ipari(5,n)
223 IF (nty==2) THEN
224 IF (ilev==27) THEN
225 CALL i2_dtn_27(x,intbuf_tab,ipari,stifn,ms_b,in_b,n,nsn)
226 ELSEIF (ilev==28) THEN
227 CALL i2_dtn_28(x,intbuf_tab,ipari,stifn,ms_b,in_b,n,nsn)
228 ELSEIF ((ilev==0).OR.(ilev==1).OR.(ilev==25)) THEN
229 CALL i2_dtn(x,intbuf_tab,ipari,stifn,ms_b,in_b,n,ilev)
230 ENDIF
231 ENDIF
232 END DO
233C
234 IF (n2d==0 ) THEN
235 nremn(1:ninter) = 0
236 flag_output = 1
237 skip_type25_edge_2_edge = 0
238 IF (nint2 >0) CALL remn_i2op(1,ninter,ipari ,intbuf_tab ,itab, nom_opt,nremn,flag_output,skip_type25_edge_2_edge)
239 CALL remn_self24(x ,ixs ,ixs10 ,ixs16,ixs20 ,
240 . knod2els,nod2els,ipari ,intbuf_tab ,
241 . itab , nom_opt,nremn, s_nod2els,flag_output)
242 CALL remn_i2_edgop(ipari ,intbuf_tab ,itab, nremn)
243 CALL ri2_int24p_ini(ipari ,intbuf_tab ,itab, nom_opt,nremn )
244 END IF !(NINT2 >0) THEN
245C-----------
246 RETURN
247 END
248C
249!||====================================================================
250!|| itagsl12 ../starter/source/interfaces/inter3d1/inintr2.F
251!||--- called by ------------------------------------------------------
252!|| inintr2 ../starter/source/interfaces/inter3d1/inintr2.F
253!||--- calls -----------------------------------------------------
254!|| kinset ../starter/source/constraints/general/kinset.F
255!||--- uses -----------------------------------------------------
256!|| message_mod ../starter/share/message_module/message_mod.F
257!||====================================================================
258 SUBROUTINE itagsl12(IPARI,ITAB,IKINE,INTBUF_TAB)
259C-----------------------------------------------
260C M o d u l e s
261C-----------------------------------------------
262 USE message_mod
263 USE intbufdef_mod
264C-----------------------------------------------
265C I m p l i c i t T y p e s
266C-----------------------------------------------
267#include "implicit_f.inc"
268C-----------------------------------------------
269C C o m m o n B l o c k s
270C-----------------------------------------------
271#include "units_c.inc"
272#include "com04_c.inc"
273#include "kincod_c.inc"
274C-----------------------------------------------
275C D u m m y A r g u m e n t s
276C-----------------------------------------------
277 INTEGER IPARI(*),ITAB(*),IKINE(*)
278C-----------------------------------------------
279C L o c a l V a r i a b l e s
280C-----------------------------------------------
281 INTEGER NRTS,NRTM,NSN,NMN,NST,MST,I,NSV,NOINT,
282 . JWARN,KWARNO,CAS1,CAS2,
283 . IKINE1(3*NUMNOD)
284
285 TYPE(intbuf_struct_) INTBUF_TAB
286C
287C=======================================================================
288
289 nrts =ipari(3)
290 nrtm =ipari(4)
291 nsn =ipari(5)
292 nmn =ipari(6)
293 nst =ipari(8)
294 mst =ipari(9)
295 noint =ipari(15)
296 jwarn=0
297 kwarno=kwarn
298C
299 DO i=1,3*numnod
300 ikine1(i) = 0
301 ENDDO
302C
303 WRITE(iout,2000)noint
304 DO i=1,nsn
305 nsv=intbuf_tab%NSV(i)
306C Cas1 corps rigide ou interface 2
307C Cas3 Condition au limite en translation
308 cas1=itf(ikine(nsv))+irb(ikine(nsv))
309 cas2=cas1+
310 . ibc(ikine(nsv))+ikine(nsv+numnod) - 10*ikine(nsv+numnod)/10
311c IF(ITF(IKINE(NSV))/=0 .OR. IRB(IKINE(NSV))/=0 )THEN
312c
313c si SECONDARY d'une autre interface 2 ou 9 ou 12 ou rby on tag le SECONDARY pour dsactivation
314c
315 IF( (ipari(11)==3 .AND. cas2/=0)
316 . .OR. (ipari(11)==2 .AND. cas1/=0) )THEN
317 jwarn=1
318 intbuf_tab%FCOUNT(i)=-abs(intbuf_tab%FCOUNT(i))
319 WRITE(iout,1000)itab(nsv),noint
320 ELSE
321 CALL kinset(2,itab(nsv),ikine(nsv),1,0,ikine1(nsv))
322 CALL kinset(2,itab(nsv),ikine(nsv),2,0,ikine1(nsv))
323 CALL kinset(2,itab(nsv),ikine(nsv),3,0,ikine1(nsv))
324 ENDIF
325 ENDDO
326 IF(jwarn>0)THEN
327 IF(ipari(11)==2)WRITE(iout,1010)noint
328 IF(ipari(11)==3)WRITE(iout,1011)noint
329 iwarn=iwarn+1
330 ENDIF
331 IF(kwarn-kwarno ==0) THEN
332 WRITE(iout,2010)noint
333 ELSE
334 WRITE(iout,'(//)')
335 ENDIF
336C-----------
337 RETURN
338C-----------------------------------------------------------------------
339 1000 FORMAT(' SECONDARY NODE ',i10,
340 + ' IS DEACTIVATED FROM FLUID INTERFACE ',i8)
341 1010 FORMAT(' *** WARNING SOME NODES'
342 + ' BELONGING TO ANOTHER INTERFACE TYPE 2, 9 or 12,',
343 + ' OR TO A RIGID BODY',
344 + ' WERE DEACTIVATED FROM FLUID INTERFACE ',i8)
345 1011 FORMAT(' *** WARNING SOME NODES'
346 + ' BELONGING TO ANOTHER INTERFACE TYPE 2, 9 or 12,',
347 + ' OR TO A RIGID BODY OR WITH A TRANSLATIONAL B.C.',
348 + ' WERE DEACTIVATED FROM FLUID INTERFACE ',i8)
349 2000 FORMAT(//,
350 + ' CHECKING KINEMATIC CONDITIONS ON INTERFACE TYPE 12',i8)
351 2010 FORMAT(' NO PROBLEM FOUND IN INTERFACE',i10,/)
352C-----------------------------------------------------------------------
353 END
354!||====================================================================
355!|| i20sta ../starter/source/interfaces/inter3d1/inintr2.f
356!||--- called by ------------------------------------------------------
357!|| inintr2 ../starter/source/interfaces/inter3d1/inintr2.F
358!||--- calls -----------------------------------------------------
359!|| i20stab ../starter/source/interfaces/inter3d1/inintr2.F
360!||--- uses -----------------------------------------------------
361!||====================================================================
362 SUBROUTINE i20sta(IPARI,STIFN,INTBUF_TAB)
363C-----------------------------------------------
364C M o d u l e s
365C-----------------------------------------------
366 USE intbufdef_mod
367C-----------------------------------------------
368C I m p l i c i t T y p e s
369C-----------------------------------------------
370#include "implicit_f.inc"
371C-----------------------------------------------
372C D u m m y A r g u m e n t s
373C-----------------------------------------------
374 INTEGER IPARI(*)
375 my_real
376 . STIFN(*)
377
378 TYPE(INTBUF_STRUCT_) INTBUF_TAB
379C-----------------------------------------------
380C L o c a l V a r i a b l e s
381C-----------------------------------------------
382 INTEGER NLN
383C
384 nln = ipari(35)
385C
386 CALL i20stab(nln,intbuf_tab%NLG,intbuf_tab%STFA,stifn)
387
388 RETURN
389C-----------------------------------------------------------------------
390 END
391!||====================================================================
392!|| i20stab ../starter/source/interfaces/inter3d1/inintr2.F
393!||--- called by ------------------------------------------------------
394!|| i20sta ../starter/source/interfaces/inter3d1/inintr2.F
395!||====================================================================
396 SUBROUTINE i20stab(NLN,NLG,STFA,STIFN)
397C-----------------------------------------------
398C I m p l i c i t T y p e s
399C-----------------------------------------------
400#include "implicit_f.inc"
401C-----------------------------------------------
402C C o m m o n B l o c k s
403C-----------------------------------------------
404#include "com04_c.inc"
405C-----------------------------------------------
406C D u m m y A r g u m e n t s
407C-----------------------------------------------
408 INTEGER NLN,NLG(*)
409 my_real
410 . STIFN(NUMNOD),STFA(*)
411C-----------------------------------------------
412C L o c a l V a r i a b l e s
413C-----------------------------------------------
414 INTEGER I
415C
416 DO i=1,nln
417 IF(stifn(nlg(i)) /= em20.and.stifn(nlg(i))<stfa(i))
418 . stfa(i) = stifn(nlg(i))
419 ENDDO
420C-----------
421 RETURN
422C-----------------------------------------------------------------------
423 END
424!||====================================================================
425!|| i24surf_pxfem ../starter/source/interfaces/inter3d1/inintr2.F
426!||--- called by ------------------------------------------------------
427!|| inintr2 ../starter/source/interfaces/inter3d1/inintr2.F
428!||--- calls -----------------------------------------------------
429!|| usr2sys ../starter/source/system/sysfus.F
430!||--- uses -----------------------------------------------------
431!|| message_mod ../starter/share/message_module/message_mod.F
432!||====================================================================
433 SUBROUTINE i24surf_pxfem(NRTM ,IRECT,INOD_PXFEM,INTPLY,
434 . NVOISIN, MSEGTYP ,MS_PLY , ISEG_PXFEM,
435 . ISEG_PLY)
436C
437 USE message_mod
438C-----------------------------------------------------------------------
439C LECTURE DES SURFACES ET DECOMPTE DES SEGMENTS
440C ENTREE :
441C NRT NOMBRE DE RENSEIGNEMENTS A LIRE
442C SORTIE :
443C IRECT
444C-----------------------------------------------
445C I m p l i c i t T y p e s
446C-----------------------------------------------
447#include "implicit_f.inc"
448C-----------------------------------------------
449C C o m m o n B l o c k s
450C-----------------------------------------------
451#include "param_c.inc"
452C-----------------------------------------------
453C D u m m y A r g u m e n t s
454C-----------------------------------------------
455 INTEGER NRTM, INTPLY
456 INTEGER IRECT(4,*), INOD_PXFEM(*),ISEG_PXFEM(*),NVOISIN(8,*),
457 . ISEG_PLY(12,*),MSEGTYP(*)
458 my_real
459 . MS_PLY(NPLYXFE,*)
460C-----------------------------------------------
461C L o c a l V a r i a b l e s
462C-----------------------------------------------
463 INTEGER I, J,K,J1,J2,J3,J4,J5,J6,J7,J8,J9,J10,J11,J12,NN,ILY
464 INTEGER IXX(NRTM,12)
465
466C-----------------------------------------------
467C E x t e r n a l F u n c t i o n s
468C-----------------------------------------------
469 INTEGER USR2SYS
470C=======================================================================
471 DO J=1,nrtm
472 iseg_pxfem(j) = 0
473 DO k=1,4
474 ixx(j,k) = irect(k,j)
475 IF(inod_pxfem(irect(k,j)) > 0) THEN
476 intply = 1
477 iseg_pxfem(j) = 1
478 ENDIF
479 ENDDO
480
481
482C voisin
483 ixx(j,5) = iabs(nvoisin(1,j))
484 ixx(j,6) = iabs(nvoisin(2,j))
485 ixx(j,7) = iabs(nvoisin(3,j))
486 ixx(j,8) = iabs(nvoisin(4,j))
487 ixx(j,9) = iabs(nvoisin(5,j))
488 ixx(j,10)= iabs(nvoisin(6,j))
489 ixx(j,11)= iabs(nvoisin(7,j))
490 ixx(j,12)= iabs(nvoisin(8,j))
491
492 ENDDO
493C Impacted ply node
494 DO i=1,nrtm
495 iseg_ply(1,i) = 0
496 iseg_ply(2,i) = 0
497 iseg_ply(3,i) = 0
498 iseg_ply(4,i) = 0
499
500 iseg_ply(5,i) = 0
501 iseg_ply(6,i) = 0
502 iseg_ply(7,i) = 0
503 iseg_ply(8,i) = 0
504 iseg_ply(9,i) = 0
505 iseg_ply(10,i) = 0
506 iseg_ply(11,i) = 0
507 iseg_ply(12,i) = 0
508 IF(iseg_pxfem(i) == 0) cycle
509C or by node segment if it needed
510 !! ISEG(I) = 0
511
512 IF(msegtyp(i) == zero) cycle
513C
514 IF(msegtyp(i) > 0) THEN
515
516!! ISEG(I) = 1
517 j1 = ixx(i,1)
518 IF(j1 > 0) THEN
519 nn = inod_pxfem(j1)
520 IF(nn > 0) THEN
521 ily = nplymax
522 DO WHILE(ms_ply(nn,ily) == zero)
523 ily = ily - 1
524 ENDDO
525 iseg_ply(1,i) = ily
526 ENDIF
527 ENDIF
528 j1 = ixx(i,2)
529 IF(j1 > 0) THEN
530 nn = inod_pxfem(j1)
531 IF(nn > 0) THEN
532 ily = nplymax
533 DO WHILE(ms_ply(nn,ily) == zero)
534 ily = ily - 1
535 ENDDO
536 iseg_ply(2,i) = ily
537 ENDIF
538 ENDIF
539 j1 = ixx(i,3)
540 IF(j1 > 0) THEN
541 nn = inod_pxfem(j1)
542 IF(nn > 0) THEN
543 ily = nplymax
544 DO WHILE(ms_ply(nn,ily) == zero)
545 ily = ily - 1
546 ENDDO
547 iseg_ply(3,i) = ily
548 ENDIF
549 ENDIF
550 j1= ixx(i,4)
551 IF(j1 > 0) THEN
552 nn = inod_pxfem(j1)
553 IF(nn > 0) THEN
554 ily = nplymax
555 DO WHILE(ms_ply(nn,ily) == zero)
556 ily = ily - 1
557 ENDDO
558 iseg_ply(4,i) = ily
559 ENDIF
560 ENDIF
561C voisin
562 j5 = ixx(i,5)
563 IF(j5 > 0) THEN
564 nn = inod_pxfem(j5)
565 IF(nn > 0) THEN
566 ily = nplymax
567 DO WHILE(ms_ply(nn,ily) == zero)
568 ily = ily - 1
569 ENDDO
570 iseg_ply(5,i) = ily
571 ENDIF
572 ENDIF
573 j6 = ixx(i,6)
574 IF(j6 > 0) THEN
575 nn = inod_pxfem(j6)
576 IF(nn > 0) THEN
577 ily = nplymax
578 DO WHILE(ms_ply(nn,ily) == zero)
579 ily = ily - 1
580 ENDDO
581 iseg_ply(6,i) = ily
582 ENDIF
583 ENDIF
584C
585 j7 = ixx(i,7)
586 IF(j7 > 0) THEN
587 nn = inod_pxfem(j7)
588 IF(nn > 0) THEN
589 ily = nplymax
590 DO WHILE(ms_ply(nn,ily) == zero)
591 ily = ily - 1
592 ENDDO
593 iseg_ply(7,i) = ily
594 ENDIF
595 ENDIF
596 j8 = ixx(i,8)
597 IF(j8 > 0) THEN
598 nn = inod_pxfem(j8)
599 IF(nn > 0) THEN
600 ily = nplymax
601 DO WHILE(ms_ply(nn,ily) == zero)
602 ily = ily - 1
603 ENDDO
604 iseg_ply(8,i) = ily
605 ENDIF
606 ENDIF
607 j9 = ixx(i,9)
608 IF(j9 > 0) THEN
609 nn = inod_pxfem(j9)
610 IF(nn > 0) THEN
611 ily = nplymax
612 DO WHILE(ms_ply(nn,ily) == zero)
613 ily = ily - 1
614 ENDDO
615 iseg_ply(9,i) = ily
616 ENDIF
617 ENDIF
618 j10 = ixx(i,10)
619 IF(j10 > 0) THEN
620 nn = inod_pxfem(j10)
621 IF(nn > 0) THEN
622 ily = nplymax
623 DO WHILE(ms_ply(nn,ily) == zero)
624 ily = ily - 1
625 ENDDO
626 iseg_ply(10,i) = ily
627 ENDIF
628 ENDIF
629 j11 = ixx(i,11)
630 IF(j11 > 0) THEN
631 nn = inod_pxfem(j11)
632 IF(nn > 0) THEN
633 ily = nplymax
634 DO WHILE(ms_ply(nn,ily) == zero)
635 ily = ily - 1
636 ENDDO
637 iseg_ply(11,i) = ily
638 ENDIF
639 ENDIF
640 j12 = ixx(i,12)
641 IF(j12 > 0) THEN
642 nn = inod_pxfem(j12)
643 IF(nn > 0) THEN
644 ily = nplymax
645 DO WHILE(ms_ply(nn,ily) == zero)
646 ily = ily - 1
647 ENDDO
648 iseg_ply(12,i) = ily
649 ENDIF
650 ENDIF
651 ELSE !
652
653!! ISEG(I) = 2
654 j1= ixx(i,1)
655 IF(j1 > 0) THEN
656 nn = inod_pxfem(j1)
657 IF(nn > 0) THEN
658 ily = 1
659 DO WHILE(ms_ply(nn,ily) == zero)
660 ily = ily + 1
661 ENDDO
662 iseg_ply(1,i) = ily
663 ENDIF
664 ENDIF
665C
666 j1= ixx(i,2)
667 IF(j1 > 0) THEN
668 nn = inod_pxfem(j1)
669 IF(nn > 0) THEN
670 ily = 1
671 DO WHILE(ms_ply(nn,ily) == zero)
672 ily = ily + 1
673 ENDDO
674 iseg_ply(2,i) = ily
675 ENDIF
676 ENDIF
677C
678 j1= ixx(i,3)
679 IF(j1 > 0) THEN
680 nn = inod_pxfem(j1)
681 IF(nn > 0) THEN
682 ily = 1
683 DO WHILE(ms_ply(nn,ily) == zero)
684 ily = ily + 1
685 ENDDO
686 iseg_ply(3,i) = ily
687 ENDIF
688 ENDIF
689 j1= ixx(i,4)
690 IF(j1 > 0) THEN
691 nn = inod_pxfem(j1)
692 IF(nn > 0) THEN
693 ily = 1
694 DO WHILE(ms_ply(nn,ily) == zero)
695 ily = ily + 1
696 ENDDO
697 iseg_ply(4,i) = ily
698 ENDIF
699 ENDIF
700C
701C voisin
702 j5 = ixx(i,5)
703 IF(j5 > 0) THEN
704 nn = inod_pxfem(j5)
705 IF(nn > 0) THEN
706 ily = 1
707 DO WHILE(ms_ply(nn,ily) == zero)
708 ily = ily + 1
709 ENDDO
710 iseg_ply(5,i) = ily
711 ENDIF
712 ENDIF
713 j6 = ixx(i,6)
714 IF(j6 > 0) THEN
715 nn = inod_pxfem(j6)
716 IF(nn > 0) THEN
717 ily = 1
718 DO WHILE(ms_ply(nn,ily) == zero)
719 ily = ily + 1
720 ENDDO
721 iseg_ply(6,i) = ily
722 ENDIF
723 ENDIF
724C
725 j7 = ixx(i,7)
726 IF(j7 > 0) THEN
727 nn = inod_pxfem(j7)
728 IF(nn > 0) THEN
729 ily = 1
730 DO WHILE(ms_ply(nn,ily) == zero)
731 ily = ily + 1
732 ENDDO
733 iseg_ply(7,i) = ily
734 ENDIF
735 ENDIF
736 j8 = ixx(i,8)
737 IF(j8 > 0) THEN
738 nn = inod_pxfem(j8)
739 IF(nn > 0) THEN
740 ily = 1
741 DO WHILE(ms_ply(nn,ily) == zero)
742 ily = ily + 1
743 ENDDO
744 iseg_ply(8,i) = ily
745 ENDIF
746 ENDIF
747 j9 = ixx(i,9)
748 IF(j9 > 0) THEN
749 nn = inod_pxfem(j9)
750 IF(nn > 0) THEN
751 ily = 1
752 DO WHILE(ms_ply(nn,ily) == zero)
753 ily = ily + 1
754 ENDDO
755 iseg_ply(9,i) = ily
756 ENDIF
757 ENDIF
758 j10 = ixx(i,10)
759 IF(j10 > 0) THEN
760 nn = inod_pxfem(j10)
761 IF(nn > 0) THEN
762 ily = 1
763 DO WHILE(ms_ply(nn,ily) == zero)
764 ily = ily + 1
765 ENDDO
766 iseg_ply(10,i) = ily
767 ENDIF
768 ENDIF
769 j11 = ixx(i,11)
770 IF(j11 > 0) THEN
771 nn = inod_pxfem(j11)
772 IF(nn > 0) THEN
773 ily = 1
774 DO WHILE(ms_ply(nn,ily) == zero)
775 ily = ily + 1
776 ENDDO
777 iseg_ply(11,i) = ily
778 ENDIF
779 ENDIF
780 j12 = ixx(i,12)
781 IF(j12 > 0) THEN
782 nn = inod_pxfem(j12)
783 IF(nn > 0) THEN
784 ily = 1
785 DO WHILE(ms_ply(nn,ily) == zero)
786 ily = ily + 1
787 ENDDO
788 iseg_ply(12,i) = ily
789 ENDIF
790 ENDIF
791C
792 ENDIF
793 ENDDO
794C
795C------------------------------------------------------------
796 RETURN
797 END
798
799
800
801
my_real
#define my_real
Definition cppsort.cpp:32
int2modif_nd
subroutine int2modif_nd(ipari, intbuf_tab, itagnd, icnds10, itab)
Definition dim_s10edg.F:864
i2_dtn
subroutine i2_dtn(x, intbuf_tab, ipari, stifn, ms, in, n, ilev)
Definition i2_dtn.F:34
i2_dtn_27
subroutine i2_dtn_27(x, intbuf_tab, ipari, stifn, ms, in, n, nsn)
Definition i2_dtn_27.F:33
i2_dtn_28
subroutine i2_dtn_28(x, intbuf_tab, ipari, stifn, ms, in, n, nsn)
Definition i2_dtn_28.F:33
remn_i2_edgop
subroutine remn_i2_edgop(ipari, intbuf_tab, itab, nremov)
Definition i7remnode.F:1420
remn_i2op
subroutine remn_i2op(lower_bound, upper_bound, ipari, intbuf_tab, itab, nom_opt, nremov, iddlevel, skip_type25_edge_2_edge)
Definition i7remnode.F:675
ri2_int24p_ini
subroutine ri2_int24p_ini(ipari, intbuf_tab, itab, nom_opt, nremov)
Definition i7remnode.F:1741
iniend2d
subroutine iniend2d(ipari, noin, ms, intbuf_tab)
Definition iniend.F:358
iniend
subroutine iniend(inscr, x, ixs, ixc, pm, geo, ipari, noin, intc, itab, ms, npby, lpby, mwa, ikine, in, stifint, id, titr, intbuf_tab, stifintr)
Definition iniend.F:44
i20sta
subroutine i20sta(ipari, stifn, intbuf_tab)
Definition inintr2.F:363
inintr2
subroutine inintr2(ipari, inscr, x, ixs, ixq, ixc, pm, geo, intc, itab, ms, npby, lpby, mwa, ikine, i2nsnt, in, stifn, stifint, nom_opt, inod_pxfem, ms_ply, intbuf_tab, stifintr, itagnd, icnds10, ms_b, in_b, nstrf, itagcyc, irbe2, irbe3, lrbe3, knod2els, nod2els, ixs10, ixs16, ixs20, s_nod2els)
Definition inintr2.F:58
itagsl12
subroutine itagsl12(ipari, itab, ikine, intbuf_tab)
Definition inintr2.F:259
i20stab
subroutine i20stab(nln, nlg, stfa, stifn)
Definition inintr2.F:397
i24surf_pxfem
subroutine i24surf_pxfem(nrtm, irect, inod_pxfem, intply, nvoisin, msegtyp, ms_ply, iseg_pxfem, iseg_ply)
Definition inintr2.F:436
itagsl2
subroutine itagsl2(ipari, nom_opt, itab, ikine, intbuf_tab, itagnd, icnds10, nstrf, itagcyc, irbe2, irbe3, lrbe3)
Definition itagsl2.F:38
kinset
subroutine kinset(ik, node, ikine, idir, isk, ikine1)
Definition kinset.F:57
int2cy_chk
subroutine int2cy_chk(ipari, intbuf_tab, itagcyc, itab)
Definition lecbcscyc.F:425
intbufscratch_mod
Definition intbufscratch_mod.F:33
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
remn_self24
subroutine remn_self24(x, ixs, ixs10, ixs16, ixs20, knod2els, nod2els, ipari, intbuf_tab, itab, nom_opt, nremov, s_nod2els, iddlevel)
Definition remn_self24.F:40
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
starter
program starter
Definition starter.F:39
intbufscratch_mod::scratch_struct_
Definition intbufscratch_mod.F:34