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

Go to the source code of this file.

Functions/Subroutines

subroutine tagnod_r2r (ix, nix, nix1, nix2, numel, iparte, tagbuf, npart, flag, idom)
subroutine tagnod_r2r_s (tagbuf)
subroutine tagnods_r2r (ixs, ixs10, ixs20, ixs16, iparts, tagbuf, flag, idom)

Function/Subroutine Documentation

◆ tagnod_r2r()

subroutine tagnod_r2r ( integer, dimension(nix,*) ix,
integer nix,
integer nix1,
integer nix2,
integer numel,
integer, dimension(*) iparte,
integer, dimension(*) tagbuf,
integer npart,
integer flag,
integer idom )

Definition at line 32 of file tagnod_r2r.F.

34 USE message_mod
35C-----------------------------------------------
36C I m p l i c i t T y p e s
37C-----------------------------------------------
38#include "implicit_f.inc"
39C-----------------------------------------------
40C D u m m y A r g u m e n t s
41C-----------------------------------------------
42 INTEGER NIX,IX(NIX,*),NIX1,NIX2,NUMEL,IPARTE(*),
43 1 TAGBUF(*),NPART,FLAG,IDOM,TAG_EL
44C-----------------------------------------------
45C L o c a l V a r i a b l e s
46C-----------------------------------------------
47 INTEGER J,L,NUM_KJ,RES
48C=======================================================================
49
50c-----FLAG = -1 : reset of tag for nodes of the current subdomain------
51
52 IF (flag==-1) THEN
53
54 DO j=1,numel
55 IF (tagbuf(iparte(j))==0) THEN
56 DO l=nix1,nix2
57 IF (tagbuf(ix(l,j)+npart)==1) THEN
58 tagbuf(ix(l,j)+npart)=0
59 ENDIF
60 ENDDO
61 ENDIF
62 ENDDO
63
64c-----FLAG = 0 : tag of the nodes of the domain------
65
66 ELSEIF (flag==0) THEN
67
68 DO j=1,numel
69 IF (tagbuf(iparte(j))==1) THEN
70 DO l=nix1,nix2
71 IF (tagbuf(ix(l,j)+npart)<2) THEN
72 tagbuf(ix(l,j)+npart)=1
73 ENDIF
74 ENDDO
75 ENDIF
76 ENDDO
77
78 ELSEIF (flag==1) THEN
79
80c-----FLAG = 1 : a tagged node on of an untagged part is a node on the multidomains interface------
81
82 DO j=1,numel
83 IF (tagbuf(iparte(j))==0) THEN
84 DO l=nix1,nix2
85 IF (tagbuf(ix(l,j)+npart) == 1) THEN
86 tagbuf(ix(l,j)+npart)=1+idom
87 ELSEIF (tagbuf(ix(l,j)+npart)>1) THEN
88 IF (tagbuf(ix(l,j)+npart)/=(1+idom)) THEN
89C-------------Error - common nodes between domains ----------------
90 CALL ancmsg(msgid=838,
91 . msgtype=msgerror,
92 . anmode=aninfo,
93 . i2=tagbuf(ix(l,j)+npart)-1,
94 . i1=idom,
95 . c1="NODES")
96 ENDIF
97 ELSE
98C-------------Tag of external nodes with the id of their domain------
99 tagbuf(ix(l,j)+npart)=-idom
100 ENDIF
101 ENDDO
102 ENDIF
103 ENDDO
104
105 ELSEIF (flag==2) THEN
106
107C-----FLAG = 2 : tag of nodes of elements tagged for the contacts between domains---------
108
109 DO j=1,numel
110C----------> TAG_EL is transferred to IPARTE-------------
111 tag_el=iparte(j+npart)
112 IF (tag_el>0) THEN
113 DO l=nix1,nix2
114 IF (tagbuf(ix(l,j)+npart)<=2) THEN
115 tagbuf(ix(l,j)+npart)=2*iparte(j+npart)
116 ENDIF
117 ENDDO
118 ELSEIF (tag_el==-1) THEN
119 DO l=nix1,nix2
120 IF (tagbuf(ix(l,j)+npart)<0) THEN
121 tagbuf(ix(l,j)+npart)=0
122 ENDIF
123 ENDDO
124 ENDIF
125 ENDDO
126
127 ELSEIF (flag==3) THEN
128
129C-----FLAG = 3 : tag of additional nodes of springs---------
130
131 DO j=1,numel
132 IF (tagbuf(iparte(j))==1) THEN
133 DO l=nix1,nix2
134 IF (ix(l,j)>0) THEN
135 IF (tagbuf(ix(l,j)+npart)<1) THEN
136 tagbuf(ix(l,j)+npart)=1
137 ENDIF
138 ENDIF
139 ENDDO
140 ENDIF
141 ENDDO
142
143 DO j=1,numel
144 IF (tagbuf(iparte(j))==0) THEN
145 DO l=nix1,nix2
146 IF (ix(l,j)>0) THEN
147 IF (tagbuf(ix(l,j)+npart)==0) THEN
148 tagbuf(ix(l,j)+npart)=-1
149 ENDIF
150 ENDIF
151 ENDDO
152 ENDIF
153 ENDDO
154
155 ELSEIF ((flag==4).AND.(numel>0)) THEN
156
157C-----FLAG = 4 : tag of additional nodes of kjoints----------
158
159 num_kj = ix(1,numel+1)
160
161 DO j=1,num_kj
162 res = ix(5,j)
163 IF (tagbuf(iparte(res))==1) THEN
164 DO l=nix1,nix2
165 IF (ix(l,j)>0) THEN
166 IF (tagbuf(ix(l,j)+npart)<1) THEN
167 tagbuf(ix(l,j)+npart)=1
168 ENDIF
169 ENDIF
170 ENDDO
171 ENDIF
172 ENDDO
173
174 DO j=1,num_kj
175 res = ix(5,j)
176 IF (tagbuf(iparte(res))==0) THEN
177 DO l=nix1,nix2
178 IF (ix(l,j)>0) THEN
179 IF (tagbuf(ix(l,j)+npart)==0) THEN
180 tagbuf(ix(l,j)+npart)= -1
181 ENDIF
182 ENDIF
183 ENDDO
184 ENDIF
185 ENDDO
186
187 ENDIF
188C-----------
189 RETURN
message_mod
Definition message_mod.F:1257
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:895

◆ tagnod_r2r_s()

subroutine tagnod_r2r_s ( integer, dimension(*) tagbuf)

Definition at line 200 of file tagnod_r2r.F.

201C-----------------------------------------------
202C M o d u l e s
203C-----------------------------------------------
204 USE restmod
205 USE r2r_mod
206C-----------------------------------------------
207C I m p l i c i t T y p e s
208C-----------------------------------------------
209#include "implicit_f.inc"
210C-----------------------------------------------
211C C o m m o n B l o c k s
212C-----------------------------------------------
213#include "com04_c.inc"
214#include "param_c.inc"
215C-----------------------------------------------
216C D u m m y A r g u m e n t s
217C-----------------------------------------------
218 INTEGER TAGBUF(*)
219C-----------------------------------------------
220C L o c a l V a r i a b l e s
221C-----------------------------------------------
222 INTEGER J,K,OFF
223C=======================================================================
224
225c-----tag of the nodes of the skews ------
226
227 DO j=1,numskw
228 DO k=1,3
229 IF (iskwn(liskn*j+k)>0) THEN
230 IF (tagbuf(iskwn(liskn*j+k)+npart)<=2) THEN
231 tagbuf(iskwn(liskn*j+k)+npart) = 2
232 ENDIF
233 ENDIF
234 END DO
235 ENDDO
236
237c-----tag of the nodes of the frames ------
238
239 off = liskn*(numskw+1)
240 DO j=1,numfram
241 DO k=1,3
242 IF (iskwn(off+liskn*j+k)>0) THEN
243 IF (tagbuf(iskwn(off+liskn*j+k)+npart)<=2)THEN
244 tagbuf(iskwn(off+liskn*j+k)+npart) = 2
245 ENDIF
246 ENDIF
247 END DO
248 ENDDO
249
250C-----------
251 RETURN
r2r_mod
Definition r2r_mod.F:125
restmod::iskwn
integer, dimension(:), allocatable, target iskwn
Definition restart_mod.F:60

◆ tagnods_r2r()

subroutine tagnods_r2r ( integer, dimension(nixs,*) ixs,
integer, dimension(6,*) ixs10,
integer, dimension(12,*) ixs20,
integer, dimension(8,*) ixs16,
integer, dimension(*) iparts,
integer, dimension(*) tagbuf,
integer flag,
integer idom )

Definition at line 263 of file tagnod_r2r.F.

265 USE message_mod
266 use element_mod , only : nixs
267C-----------------------------------------------
268C I m p l i c i t T y p e s
269C-----------------------------------------------
270#include "implicit_f.inc"
271C-----------------------------------------------
272C C o m m o n B l o c k s
273C-----------------------------------------------
274#include "com04_c.inc"
275C-----------------------------------------------
276C D u m m y A r g u m e n t s
277C-----------------------------------------------
278 INTEGER IXS(NIXS,*),IPARTS(*),IXS10(6,*),IXS20(12,*),IXS16(8,*),
279 1 TAGBUF(*),FLAG,IDOM
280C-----------------------------------------------
281C L o c a l V a r i a b l e s
282C-----------------------------------------------
283 INTEGER I,J,L,NP
284C=======================================================================
285
286 np = npart
287
288C-----------------------------------------------------------------------------------------------
289c-----FLAG = -1 : reset of tag for nodes of the current subdomain-------------------------------
290C-----------------------------------------------------------------------------------------------
291
292 IF (flag==-1) THEN
293
294 DO j=1,numels8
295 IF (tagbuf(iparts(j)) == 0)THEN
296 DO l=2,9
297 IF (tagbuf(ixs(l,j)+np)<2) tagbuf(ixs(l,j)+np)=0
298 ENDDO
299 ENDIF
300 ENDDO
301C-----------
302 DO i=1,numels10
303 j = i + numels8
304 IF (tagbuf(iparts(j)) == 0)THEN
305 DO l=2,9
306 IF (tagbuf(ixs(l,j)+np)<2) tagbuf(ixs(l,j)+np)=0
307 ENDDO
308 DO l=1,6
309 IF (ixs10(l,i) /= 0) THEN
310 IF (tagbuf(ixs10(l,i)+np)<2) tagbuf(ixs10(l,i)+np)=0
311 ENDIF
312 ENDDO
313 ENDIF
314 ENDDO
315C-----------
316 DO i=1,numels20
317 j = i + numels8 + numels10
318 IF (tagbuf(iparts(j)) == 0)THEN
319 DO l=2,9
320 IF (tagbuf(ixs(l,j)+np)<2) tagbuf(ixs(l,j)+np)=0
321 ENDDO
322 DO l=1,12
323 IF (ixs20(l,i) /= 0) THEN
324 IF (tagbuf(ixs20(l,i)+np)<2) tagbuf(ixs20(l,i)+np)=0
325 ENDIF
326 ENDDO
327 ENDIF
328 ENDDO
329C-----------
330 DO i=1,numels16
331 j = i + numels8 + numels10 + numels20
332 IF (tagbuf(iparts(j)) == 0) THEN
333 DO l=2,9
334 IF (tagbuf(ixs(l,j)+np)<2) tagbuf(ixs(l,j)+np)=0
335 ENDDO
336 DO l=1,8
337 IF (ixs16(l,i) /= 0) THEN
338 IF (tagbuf(ixs16(l,i)+np)<2) tagbuf(ixs16(l,i)+np)=0
339 ENDIF
340 ENDDO
341 ENDIF
342 ENDDO
343
344C-----------------------------------------------------------------------------------------------
345c-----FLAG = 0 : tag of all nodes --------------------------------------------------------------
346C-----------------------------------------------------------------------------------------------
347
348 ELSEIF (flag==0) THEN
349
350 DO j=1,numels8
351 IF (tagbuf(iparts(j)) == 1)THEN
352 DO l=2,9
353 IF (tagbuf(ixs(l,j)+np)<2) tagbuf(ixs(l,j)+np)=1
354 ENDDO
355 ENDIF
356 ENDDO
357C-----------
358 DO i=1,numels10
359 j = i + numels8
360 IF (tagbuf(iparts(j)) == 1)THEN
361 DO l=2,9
362 IF (tagbuf(ixs(l,j)+np)<2) tagbuf(ixs(l,j)+np)=1
363 ENDDO
364 DO l=1,6
365 IF (ixs10(l,i) /= 0) THEN
366 IF (tagbuf(ixs10(l,i)+np)<2) tagbuf(ixs10(l,i)+np)=1
367 ENDIF
368 ENDDO
369 ENDIF
370 ENDDO
371C-----------
372 DO i=1,numels20
373 j = i + numels8 + numels10
374 IF (tagbuf(iparts(j)) == 1)THEN
375 DO l=2,9
376 IF (tagbuf(ixs(l,j)+np)<2) tagbuf(ixs(l,j)+np)=1
377 ENDDO
378 DO l=1,12
379 IF (ixs20(l,i) /= 0) THEN
380 IF (tagbuf(ixs20(l,i)+np)<2) tagbuf(ixs20(l,i)+np)=1
381 ENDIF
382 ENDDO
383 ENDIF
384 ENDDO
385C-----------
386 DO i=1,numels16
387 j = i + numels8 + numels10 + numels20
388 IF (tagbuf(iparts(j)) == 1) THEN
389 DO l=2,9
390 IF (tagbuf(ixs(l,j)+np)<2) tagbuf(ixs(l,j)+np)=1
391 ENDDO
392 DO l=1,8
393 IF (ixs16(l,i) /= 0) THEN
394 IF (tagbuf(ixs16(l,i)+np)<2) tagbuf(ixs16(l,i)+np)=1
395 ENDIF
396 ENDDO
397 ENDIF
398 ENDDO
399
400C-----------------------------------------------------------------------------------------------
401c-----FLAG = 1 : a tagged node on of an untagged part is a node on the multidomains interface---
402C-----------------------------------------------------------------------------------------------
403
404 ELSEIF (flag==1) THEN
405
406 DO j=1,numels8
407 IF (tagbuf(iparts(j)) == 0)THEN
408 DO l=2,9
409 IF (tagbuf(ixs(l,j)+np)==1) tagbuf(ixs(l,j)+np)=1+idom
410 IF (tagbuf(ixs(l,j)+np)>1) THEN
411 IF (tagbuf(ixs(l,j)+np)/=(1+idom)) THEN
412C-------------Error - common nodes between domains -----------------
413 CALL ancmsg(msgid=838,
414 . msgtype=msgerror,
415 . anmode=aninfo,
416 . i2=tagbuf(ixs(l,j)+np)-1,
417 . i1=idom,
418 . c1="NODES")
419 ENDIF
420 ENDIF
421 IF (tagbuf(ixs(l,j)+np)<1) tagbuf(ixs(l,j)+np)=-idom
422 ENDDO
423 ENDIF
424 ENDDO
425
426C--------------------------------------------------------------------------------------
427 DO i=1,numels10
428 j = i + numels8
429 IF (tagbuf(iparts(j)) == 0)THEN
430 DO l=2,9
431 IF (tagbuf(ixs(l,j)+np)==1) tagbuf(ixs(l,j)+np)=1+idom
432 IF (tagbuf(ixs(l,j)+np)>1) THEN
433 IF (tagbuf(ixs(l,j)+np)/=(1+idom)) THEN
434C-------------Error - common nodes between domains ----------------
435 CALL ancmsg(msgid=838,
436 . msgtype=msgerror,
437 . anmode=aninfo,
438 . i2=tagbuf(ixs(l,j)+np)-1,
439 . i1=idom,
440 . c1="NODES")
441 ENDIF
442 ENDIF
443 IF (tagbuf(ixs(l,j)+np)<1) tagbuf(ixs(l,j)+np)=-idom
444 ENDDO
445 DO l=1,6
446 IF (ixs10(l,i) /= 0) THEN
447 IF (tagbuf(ixs10(l,i)+np)==1) tagbuf(ixs10(l,i)+np)=1+idom
448 IF (tagbuf(ixs10(l,i)+np)>1) THEN
449 IF (tagbuf(ixs10(l,i)+np)/=(1+idom)) THEN
450C-------------Error - common nodes between domains -----------------
451 CALL ancmsg(msgid=838,
452 . msgtype=msgerror,
453 . anmode=aninfo,
454 . i2=tagbuf(ixs10(l,i)+np)-1,
455 . i1=idom,
456 . c1="NODES")
457 ENDIF
458 ENDIF
459 IF (tagbuf(ixs10(l,i)+np)<1) tagbuf(ixs10(l,i)+np)=-idom
460 ENDIF
461 ENDDO
462 ENDIF
463 ENDDO
464
465C--------------------------------------------------------------------------------------
466 DO i=1,numels20
467 j = i + numels8 + numels10
468 IF (tagbuf(iparts(j)) == 0)THEN
469 DO l=2,9
470 IF (tagbuf(ixs(l,j)+np)==1) tagbuf(ixs(l,j)+np)=1+idom
471 IF (tagbuf(ixs(l,j)+np)>1) THEN
472 IF (tagbuf(ixs(l,j)+np)/=(1+idom)) THEN
473C-------------Error - common nodes between domains -----------------
474 CALL ancmsg(msgid=838,
475 . msgtype=msgerror,
476 . anmode=aninfo,
477 . i2=tagbuf(ixs(l,j)+np)-1,
478 . i1=idom,
479 . c1="NODES")
480 ENDIF
481 ENDIF
482 IF (tagbuf(ixs(l,j)+np)<1) tagbuf(ixs(l,j)+np)=-idom
483 ENDDO
484 DO l=1,12
485 IF (ixs20(l,i) /= 0) THEN
486 IF (tagbuf(ixs20(l,i)+np)==1) tagbuf(ixs20(l,i)+np)=1+idom
487 IF (tagbuf(ixs20(l,i)+np)>1) THEN
488 IF (tagbuf(ixs20(l,i)+np)/=(1+idom)) THEN
489C-------------Error - common nodes between domains ----------------
490 CALL ancmsg(msgid=838,
491 . msgtype=msgerror,
492 . anmode=aninfo,
493 . i2=tagbuf(ixs20(l,i)+np)-1,
494 . i1=idom,
495 . c1="NODES")
496 ENDIF
497 ENDIF
498 IF (tagbuf(ixs20(l,i)+np)<1) tagbuf(ixs20(l,i)+np)=-idom
499 ENDIF
500 ENDDO
501 ENDIF
502 ENDDO
503
504C--------------------------------------------------------------------------------------
505 DO i=1,numels16
506 j = i + numels8 + numels10 + numels20
507 IF (tagbuf(iparts(j)) == 0) THEN
508 DO l=2,9
509 IF (tagbuf(ixs(l,j)+np)==1) tagbuf(ixs(l,j)+np)=1+idom
510 IF (tagbuf(ixs(l,j)+np)>1) THEN
511 IF (tagbuf(ixs(l,j)+np)/=(1+idom)) THEN
512C-------------Error - common nodes between domains -----------------
513 CALL ancmsg(msgid=838,
514 . msgtype=msgerror,
515 . anmode=aninfo,
516 . i2=tagbuf(ixs(l,j)+np)-1,
517 . i1=idom,
518 . c1="NODES")
519 ENDIF
520 ENDIF
521 IF (tagbuf(ixs(l,j)+np)<1) tagbuf(ixs(l,j)+np)=-idom
522 ENDDO
523 DO l=1,8
524 IF (ixs16(l,i) /= 0) THEN
525 IF (tagbuf(ixs16(l,i)+np)==1) tagbuf(ixs16(l,i)+np)=1+idom
526 IF (tagbuf(ixs16(l,i)+np)>1) THEN
527 IF (tagbuf(ixs16(l,i)+np)/=(1+idom)) THEN
528C-------------Error - common nodes between domains -----------------
529 CALL ancmsg(msgid=838,
530 . msgtype=msgerror,
531 . anmode=aninfo,
532 . i2=tagbuf(ixs16(l,i)+np)-1,
533 . i1=idom,
534 . c1="NODES")
535 ENDIF
536 ENDIF
537 IF (tagbuf(ixs16(l,i)+np)<1) tagbuf(ixs16(l,i)+np)=-idom
538 ENDIF
539 ENDDO
540 ENDIF
541 ENDDO
542
543
544C-----------------------------------------------------------------------------------------------
545c-----si FLAG = 2 : tag of nodes of tagged elements (treatment for interfaces TYPE2) -----------
546C-----------------------------------------------------------------------------------------------
547
548 ELSEIF (flag==2) THEN
549
550 DO j=1,numels8
551 IF (iparts(j+np)/=0)THEN
552 DO l=2,9
553 IF (tagbuf(ixs(l,j)+np)<3) tagbuf(ixs(l,j)+np)=2*iparts(j+np)
554 ENDDO
555 ENDIF
556 ENDDO
557C-----------
558 DO i=1,numels10
559 j = i + numels8
560 IF (iparts(j+np)/=0)THEN
561 DO l=2,9
562 IF (tagbuf(ixs(l,j)+np)<3) tagbuf(ixs(l,j)+np)=2*iparts(j+np)
563 ENDDO
564 DO l=1,6
565 IF (ixs10(l,i) /= 0) THEN
566 IF (tagbuf(ixs10(l,i)+np)<3) tagbuf(ixs10(l,i)+np)=2*iparts(j+np)
567 ENDIF
568 ENDDO
569 ENDIF
570 ENDDO
571C-----------
572 DO i=1,numels20
573 j = i + numels8 + numels10
574 IF (iparts(j+np)/=0)THEN
575 DO l=2,9
576 IF (tagbuf(ixs(l,j)+np)<3) tagbuf(ixs(l,j)+np)=2*iparts(j+np)
577 ENDDO
578 DO l=1,12
579 IF (ixs20(l,i) /= 0) THEN
580 IF (tagbuf(ixs20(l,i)+np)<3) tagbuf(ixs20(l,i)+np)=2*iparts(j+np)
581 ENDIF
582 ENDDO
583 ENDIF
584 ENDDO
585C-----------
586 DO i=1,numels16
587 j = i + numels8 + numels10 + numels20
588 IF (iparts(j+np)/=0)THEN
589 DO l=2,9
590 IF (tagbuf(ixs(l,j)+np)<3) tagbuf(ixs(l,j)+np)=2*iparts(j+np)
591 ENDDO
592 DO l=1,8
593 IF (ixs16(l,i) /= 0) THEN
594 IF (tagbuf(ixs16(l,i)+np)<3) tagbuf(ixs16(l,i)+np)=2*iparts(j+np)
595 ENDIF
596 ENDDO
597 ENDIF
598 ENDDO
599
600 ENDIF
601
602 RETURN
603