OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
w_irbe2.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 w_irbe2 (irbe2, lrbe2, nodlocal, proc, llrbe2_l, itabrbe2m, nbddrbe2, numnod_l, len_ia)

Function/Subroutine Documentation

◆ w_irbe2()

subroutine w_irbe2 ( integer, dimension(nrbe2l,*) irbe2,
integer, dimension(*) lrbe2,
integer, dimension(*) nodlocal,
integer proc,
integer llrbe2_l,
integer, dimension(*) itabrbe2m,
integer nbddrbe2,
integer numnod_l,
integer len_ia )

Definition at line 31 of file w_irbe2.F.

33C-----------------------------------------------
34C M o d u l e s
35C-----------------------------------------------
36C-----------------------------------------------
37C I m p l i c i t T y p e s
38C-----------------------------------------------
39#include "implicit_f.inc"
40C-----------------------------------------------
41C C o m m o n B l o c k s
42C-----------------------------------------------
43#include "com04_c.inc"
44#include "param_c.inc"
45C-----------------------------------------------
46C D u m m y A r g u m e n t s
47C-----------------------------------------------
48 INTEGER PROC, LLRBE2_L, LEN_IA,NBDDRBE2,NUMNOD_L,ITABRBE2M(*),
49 . IRBE2(NRBE2L,*), LRBE2(*), NODLOCAL(*)
50C-----------------------------------------------
51C F u n c t i o n
52C-----------------------------------------------
53 INTEGER NLOCAL
54 EXTERNAL nlocal
55C-----------------------------------------------
56C L o c a l V a r i a b l e s
57C-----------------------------------------------
58 INTEGER I, J, K, KL, NSNL, NSN, ILP, NLL, NN, M, N,
59 . IBVTMP(NRBE2L,NRBE2), LBVTMP(LLRBE2_L),IAD,II
60
61C-----------------------------------------------
62C
63 kl=0
64 nsnl = 0
65 ii = 0
66 DO i = 1, nrbe2
67 k = irbe2(1,i)
68 m = irbe2(3,i)
69 nsn = irbe2(5,i)
70 iad = nsnl
71 IF (nsn > 0) ii = ii +1
72 IF (nsn ==0) cycle
73 DO j = 1, nsn
74 n = lrbe2(k+j)
75 IF (nlocal(n,proc+1)==1)THEN
76 nsnl = nsnl + 1
77 lbvtmp(nsnl) = nodlocal(n)
78 ENDIF
79 ENDDO
80 IF (nlocal(m,proc+1)==1)THEN
81 kl = kl + 1
82 DO j = 1, nrbe2l
83 ibvtmp(j,kl) = irbe2(j,i)
84 ENDDO
85 ibvtmp(1,kl) = iad
86 ibvtmp(5,kl) = nsnl-iad
87 ibvtmp(3,kl) = nodlocal(m)
88C SPMD issue global RBE2 Number
89 ibvtmp(10,kl) = ii
90 ibvtmp(12,kl) = nsn
91C----------IBVTMP(6,KL)-set in engine------------------------------------
92 ENDIF
93 ENDDO
94C----------------
95 CALL write_i_c(ibvtmp,nrbe2l*kl)
96 CALL write_i_c(lbvtmp,llrbe2_l)
97 len_ia = len_ia + nrbe2l*kl + llrbe2_l
98C
99 IF(nbddrbe2>0) THEN
100 itabrbe2m(1:numnod_l) = 0
101 ilp=0
102 DO k = 1, kl
103 n = ibvtmp(3,k)
104 IF(itabrbe2m(n)==0) THEN
105 ilp = ilp + 1
106c ITABRBE2M(N) = ILP
107 itabrbe2m(n) = n
108 ENDIF
109 END DO
110 ENDIF
111C
112 RETURN
integer function nlocal(n, p)
Definition ddtools.F:349
void write_i_c(int *w, int *len)