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

Go to the source code of this file.

Functions/Subroutines

subroutine w_fixvel (vel, nc, ibfv, nfxvel_l, len_am, proc)

Function/Subroutine Documentation

◆ w_fixvel()

subroutine w_fixvel ( vel,
integer nc,
integer, dimension(nifv,*) ibfv,
integer nfxvel_l,
integer len_am,
integer proc )

Definition at line 31 of file w_fixvel.F.

32C-----------------------------------------------
33C M o d u l e s
34C-----------------------------------------------
35
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 "param_c.inc"
44C-----------------------------------------------
45C D u m m y A r g u m e n t s
46C-----------------------------------------------
47 INTEGER NC, LEN_AM, PROC, NFXVEL_L,
48 . IBFV(NIFV,*)
50 . vel(lfxvelr,nc)
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, N_L, N,NCUR
61 . veltmp(lfxvelr,nfxvel_l)
62C
63 n_l = 0
64 DO i = 1, nc
65 n = iabs(ibfv(1,i))
66 ncur = ibfv(3,i)
67 IF(nlocal(n,proc+1)==1 .AND. ncur>0 )THEN
68 n_l = n_l + 1
69 DO j = 1, lfxvelr
70 veltmp(j,n_l) = vel(j,i)
71 ENDDO
72 ENDIF
73 ENDDO
74C
75 CALL write_db(veltmp,lfxvelr*nfxvel_l)
76 len_am = len_am + lfxvelr*nfxvel_l
77C
78 RETURN
#define my_real
Definition cppsort.cpp:32
integer function nlocal(n, p)
Definition ddtools.F:349
subroutine write_db(a, n)
Definition write_db.F:140