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:1249
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

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