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

Go to the source code of this file.

Functions/Subroutines

subroutine h3d_velvecz22 (elbuf_tab, iparg, ipari, igrnod, x, ixs, ixq, itab, iflg, iok_part, is_written_node, nodal_vector)

Function/Subroutine Documentation

◆ h3d_velvecz22()

subroutine h3d_velvecz22 ( type (elbuf_struct_), dimension(ngroup), target elbuf_tab,
integer, dimension(nparg,*), intent(in) iparg,
integer, dimension(npari,*), intent(in) ipari,
type (group_), dimension(ngrnod) igrnod,
dimension(3,numnod), intent(inout) x,
integer, dimension(nixs,*), intent(in) ixs,
integer, dimension(nixq,*), intent(in) ixq,
integer, dimension(numnod), intent(in) itab,
integer, intent(in) iflg,
integer, dimension(*), intent(in) iok_part,
integer, dimension(*), intent(in) is_written_node,
dimension(3,*), intent(inout) nodal_vector )

Definition at line 37 of file h3d_velvecz22.F.

39C-----------------------------------------------
40C D e s c r i p t i o n
41C-----------------------------------------------
42C This subroutines writes velocities & internal forces at face
43C centers for coupling interface 22. Free nodes are used as
44C marker to plot centroid vectors (see input card for grnod_id)
45C-----------------------------------------------
46C M o d u l e s
47C-----------------------------------------------
48 USE initbuf_mod
49 USE elbufdef_mod
50 USE i22bufbric_mod
51 USE i22edge_mod
52 USE i22tri_mod
53 USE groupdef_mod
54C-----------------------------------------------
55C I m p l i c i t T y p e s
56C-----------------------------------------------
57#include "implicit_f.inc"
58C-----------------------------------------------
59C C o m m o n B l o c k s
60C-----------------------------------------------
61#include "com01_c.inc"
62#include "com04_c.inc"
63#include "param_c.inc"
64#include "inter22.inc"
65C-----------------------------------------------
66C D u m m y A r g u m e n t s
67C-----------------------------------------------
68 INTEGER, INTENT(IN) :: IPARG(NPARG,*), IPARI(NPARI,*),IXS(NIXS,*),IXQ(NIXQ,*)
69 INTEGER, INTENT(IN) :: ITAB(NUMNOD),IFLG
70 INTEGER, INTENT(IN) :: IOK_PART(*),IS_WRITTEN_NODE(*)
71 my_real, INTENT(INOUT) :: x(3,numnod)
72 my_real, INTENT(INOUT) :: nodal_vector(3,*)
73 REAL R4
74 TYPE (ELBUF_STRUCT_), DIMENSION(NGROUP), TARGET :: ELBUF_TAB
75 TYPE (GROUP_) , DIMENSION(NGRNOD) :: IGRNOD
76C-----------------------------------------------
77C L o c a l A r g u m e n t s
78C-----------------------------------------------
79 INTEGER :: ICELLM,NCELL,NBF,NBL,ICELL,NIN,NODE_ID,IB,NG,I
80 INTEGER :: IAD0, NNODES, II, NFACE, J, K, IE,IGR
81 my_real :: rho_cell, rho(4)
82 REAL,DIMENSION(:,:),ALLOCATABLE :: BUFFER
83 LOGICAL :: lStillNode
84 my_real value(3)
85C-----------------------------------------------
86C P r e - C o n d i t i o n s
87C-----------------------------------------------
88 nin = 1
89 IF(int22==0) RETURN
90 IF(ipari(82,nin)==0)RETURN
91C-----------------------------------------------
92C S o u r c e C o d e
93C-----------------------------------------------
94 !---------------------------------------------------------!
95 nbf = 1
96 nbl = nb
97 ALLOCATE(buffer(3,numnod))
98 buffer(:,:) = zero
99 !---------------------------------------------------------!
100
101 lstillnode = .true.
102 igr = ipari(82,nin)
103 nnodes = igrnod(igr)%NENTITY
104 IF(nnodes==0)RETURN
105 ii = 1 ! start with the first node of the group
106 DO ib=nbf,nbl
107 ie = brick_list(nin,ib)%ID
108 icell = 0
109 ncell = brick_list(nin,ib)%NBCUT
110 DO WHILE (icell<=ncell) ! loop on polyhedron {1:NCELL} U {9}
111 icell = icell +1
112 IF (icell>ncell .AND. ncell/=0)icell=9
113 IF(.NOT.lstillnode) cycle
114 ! nFACE = BRICK_LIST(NIN,IB)%NFACE_Cell(ICELL)
115 DO j=1, 6
116 IF(ii>nnodes)THEN
117 lstillnode = .false.
118 print *, "** Warning inter22 : no more node in group to mark cell center"
119 EXIT
120 ENDIF
121 node_id = igrnod(igr)%ENTITY(ii)
122 IF(iflg==1)THEN
123 !velocity at faces
124 buffer(1,node_id) = brick_list(nin,ib)%POLY(icell)%FACE(j)%Vel(1)
125 buffer(2,node_id) = brick_list(nin,ib)%POLY(icell)%FACE(j)%Vel(2)
126 buffer(3,node_id) = brick_list(nin,ib)%POLY(icell)%FACE(j)%Vel(3)
127 ELSEIF(iflg==2)THEN
128 !internal forces at face int(P.dS)
129 buffer(1,node_id) = -brick_list(nin,ib)%POLY(icell)%FACE(j)%F_FACE(1)
130 buffer(2,node_id) = -brick_list(nin,ib)%POLY(icell)%FACE(j)%F_FACE(2)
131 buffer(3,node_id) = -brick_list(nin,ib)%POLY(icell)%FACE(j)%F_FACE(3)
132 ELSE
133 buffer(1,node_id) = zero
134 buffer(2,node_id) = zero
135 buffer(3,node_id) = zero
136 ENDIF
137 ii = ii + 1 !next node
138 ENDDO
139 ENDDO !next ICELL
140 enddo!next IB
141
142 DO ii=1,nnodes
143 node_id = igrnod(igr)%ENTITY(ii)
144 x(1:3,node_id) = zero
145 ENDDO
146
147 DO i=1,numnod
148 value(1)=buffer(1,i)
149 value(2)=buffer(2,i)
150 value(3)=buffer(3,i)
151 CALL h3d_write_vector(iok_part,is_written_node,nodal_vector,i,0,0,
152 . VALUE)
153 ENDDO
154
155 DEALLOCATE(buffer)
156
157C-----------------------------------------------
158 RETURN
my_real
#define my_real
Definition cppsort.cpp:32
h3d_write_vector
subroutine h3d_write_vector(iok_part, is_written, vector, i, offset, nft, value)
Definition h3d_write_vector.F:36
groupdef_mod
Definition groupdef_mod.F:662
i22bufbric_mod
Definition cut-cell-search_mod.F:95
i22bufbric_mod::brick_list
type(brick_entity), dimension(:,:), allocatable, target brick_list
Definition cut-cell-search_mod.F:105
i22edge_mod
Definition cut-cell-buffer_mod.F:48
i22tri_mod
Definition cut-cell-search_mod.F:212
i22tri_mod::nb
integer nb
Definition cut-cell-search_mod.F:487
initbuf_mod
Definition initbuf.F:160