OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
w_ibvel.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_ibvel (ibvel, lbvel, nodlocal, proc, llbvel_l, len_ia)

Function/Subroutine Documentation

◆ w_ibvel()

subroutine w_ibvel ( integer, dimension(nbvelp,*) ibvel,
integer, dimension(*) lbvel,
integer, dimension(*) nodlocal,
integer proc,
integer llbvel_l,
integer len_ia )

Definition at line 31 of file w_ibvel.F.

33C-----------------------------------------------
34C M o d u l e s
35C-----------------------------------------------
36
37C-----------------------------------------------
38C I m p l i c i t T y p e s
39C-----------------------------------------------
40#include "implicit_f.inc"
41C-----------------------------------------------
42C C o m m o n B l o c k s
43C-----------------------------------------------
44#include "com04_c.inc"
45#include "param_c.inc"
46C-----------------------------------------------
47C D u m m y A r g u m e n t s
48C-----------------------------------------------
49 INTEGER PROC, LLBVEL_L, LEN_IA,
50 . IBVEL(NBVELP,*), LBVEL(*), NODLOCAL(*)
51C-----------------------------------------------
52C F u n c t i o n
53C-----------------------------------------------
54 INTEGER NLOCAL
55 EXTERNAL nlocal
56C-----------------------------------------------
57C L o c a l V a r i a b l e s
58C-----------------------------------------------
59 INTEGER I, J, K, KL, NSNL, NSN, ILP, NLL, NN, M, N,
60 . IBVTMP(NBVELP,NIBVEL), LBVTMP(LLBVEL_L)
61C
62 k = 0
63 kl = 0
64 DO i = 1, nibvel
65 nsn = ibvel(3,i)
66 DO j = 1, nbvelp
67 ibvtmp(j,i) = ibvel(j,i)
68 ENDDO
69 nsnl = 0
70 DO j = 1, nsn
71 n = lbvel(k+j)
72 IF (nlocal(n,proc+1)==1)THEN
73 nsnl = nsnl + 1
74 lbvtmp(kl+nsnl) = nodlocal(n)
75 ENDIF
76 ENDDO
77 ibvtmp(3,i) = nsnl
78 m = ibvel(4,i)
79Coptimisation pour ne pas traiter les rb mous sans main et sans noeud secnd
80 IF(nlocal(m,proc+1)==0.AND.nsnl==0)THEN
81 ibvtmp(4,i) = -m
82 ELSE
83 ibvtmp(4,i) = nodlocal(m)
84 ENDIF
85 kl = kl+nsnl
86 k = k + nsn
87 ENDDO
88C
89 CALL write_i_c(ibvtmp,nbvelp*nibvel)
90 CALL write_i_c(lbvtmp,llbvel_l)
91 len_ia = len_ia + nbvelp*nibvel + llbvel_l
92C
93 RETURN
integer function nlocal(n, p)
Definition ddtools.F:349
void write_i_c(int *w, int *len)