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

Go to the source code of this file.

Functions/Subroutines

subroutine h3d_velvecc22 (elbuf_tab, iparg, iflg, ixs, ixq, itab, iok_part, is_written_node, nodal_vector)

Function/Subroutine Documentation

◆ h3d_velvecc22()

subroutine h3d_velvecc22 ( type (elbuf_struct_), dimension(ngroup), target elbuf_tab,
integer, dimension(nparg,*), intent(in) iparg,
integer, intent(in) iflg,
integer, dimension(nixs,numels), intent(in) ixs,
integer, dimension(nixq,numelq), intent(in) ixq,
integer, dimension(numnod), intent(in) itab,
integer, dimension(*), intent(in) iok_part,
integer, dimension(*), intent(inout) is_written_node,
dimension(3,*), intent(inout) nodal_vector )

Definition at line 37 of file h3d_velvecc22.F.

39C-----------------------------------------------
40C D e s c r i p t i o n
41C-----------------------------------------------
42C This subroutines writes at polyedra centroids :
43C velocities (IFLG=1),
44C momentum density (IFLG=2)
45C internal forces (IFLG=3),
46C for coupling interface 22. Free nodes are used
47C as marker to plot centroid vectors
48C(see input card for grnod_id)
49C-----------------------------------------------
50C M o d u l e s
51C-----------------------------------------------
52 USE initbuf_mod
53 USE elbufdef_mod
54 USE i22bufbric_mod
55 USE i22edge_mod
56 USE i22tri_mod
57 use element_mod , only : nixs,nixq
58C-----------------------------------------------
59C I m p l i c i t T y p e s
60C-----------------------------------------------
61#include "implicit_f.inc"
62C-----------------------------------------------
63C C o m m o n B l o c k s
64C-----------------------------------------------
65#include "com01_c.inc"
66#include "com04_c.inc"
67#include "param_c.inc"
68C-----------------------------------------------
69C D u m m y A r g u m e n t s
70C-----------------------------------------------
71 INTEGER, INTENT(IN) :: IPARG(NPARG,*), IFLG,IXS(NIXS,NUMELS),IXQ(NIXQ,NUMELQ),ITAB(NUMNOD)
72 INTEGER, INTENT(IN) :: IOK_PART(*)
73 INTEGER, INTENT(INOUT) :: IS_WRITTEN_NODE(*)
74 my_real, INTENT(INOUT) :: nodal_vector(3,*)
75 TYPE (ELBUF_STRUCT_), DIMENSION(NGROUP), TARGET :: ELBUF_TAB
76 TYPE(BUF_MAT_),POINTER :: MBUF
77 TYPE(G_BUFEL_),POINTER :: GBUF
78C-----------------------------------------------
79C L o c a l A r g u m e n t s
80C-----------------------------------------------
81 INTEGER :: NGM, IDLOCM, IBM,ICELLM,MLW,NCELL,NELm,NBF,NBL,ICELL,NIN,NODE_ID,IB,I
82 my_real :: rho_cell, rho(4), vfrac(4)
83 REAL,DIMENSION(:,:),ALLOCATABLE :: BUFFER
84 my_real value(3)
85C-----------------------------------------------
86
87 !---------------------------------------------------------!
88 nbf = 1
89 nbl = nb
90 nin = 1
91 !---------------------------------------------------------!
92 ALLOCATE(buffer(3,numnod))
93 buffer(:,:) = zero
94
95 DO ib=nbf,nbl
96 icell = 0
97 ncell = brick_list(nin,ib)%NBCUT
98 DO WHILE (icell<=ncell) ! loop on polyhedron {1:NCELL} U {9}
99 icell = icell +1
100 IF (icell>ncell .AND. ncell/=0)icell=9
101 ibm = brick_list(nin,ib)%POLY(icell)%WhereIsMain(4)
102 icellm = brick_list(nin,ibm)%mainID
103 IF(ibm==0)THEN
104 ibm = ib
105 icellm = 1
106 ENDIF
107 ngm = brick_list(nin,ibm)%NG
108 idlocm = brick_list(nin,ibm)%IDLOC
109 gbuf =>elbuf_tab(ngm)%GBUF
110 mbuf =>elbuf_tab(ngm)%BUFLY(1)%MAT(1,1,1)
111 nelm = iparg(2,ngm)
112 mlw = iparg(1,ngm)
113 IF(mlw==37)THEN
114 !UVAR(I,1) : massic percentage of liquid * global density (rho1*V1/V : it needs to give liquid mass multiplying by element volume in aleconve.F)
115 !UVAR(I,2) : density of gas
116 !UVAR(I,3) : density of liquid
117 !UVAR(I,4) : volumetric fraction of liquid
118 !UVAR(I,5) : volumetric fraction of gas
119 rho(1) = mbuf%VAR((3-1)*nelm+idlocm)
120 rho(2) = mbuf%VAR((2-1)*nelm+idlocm)
121 vfrac(1) = mbuf%VAR((4-1)*nelm+idlocm)
122 vfrac(2) = mbuf%VAR((5-1)*nelm+idlocm)
123 rho_cell = rho(1)*vfrac(1) + rho(2)*vfrac(2)
124 ELSEIF(mlw==51)THEN
125 rho(1) = zero
126 rho(2) = zero
127 rho_cell = zero
128 ELSE
129 rho_cell = gbuf%RHO(idlocm)
130 ENDIF
131 node_id = brick_list(nin,ib)%POLY(icell)%ID_FREE_NODE
132 IF(node_id<=0)cycle ! not enough nodes in the group or SMP disabling
133 IF(iflg==1)THEN
134 !velocity vector : U
135 buffer(1,node_id) = gbuf%MOM(nelm*(1-1) + idlocm) / rho_cell
136 buffer(2,node_id) = gbuf%MOM(nelm*(2-1) + idlocm) / rho_cell
137 buffer(3,node_id) = gbuf%MOM(nelm*(3-1) + idlocm) / rho_cell
138 ELSEIF(iflg==2)THEN
139 !momentum density vector : rho.U
140 buffer(1,node_id) = gbuf%MOM(nelm*(1-1) + idlocm)
141 buffer(2,node_id) = gbuf%MOM(nelm*(2-1) + idlocm)
142 buffer(3,node_id) = gbuf%MOM(nelm*(3-1) + idlocm)
143 ELSEIF(iflg==3)THEN
144 !internal force at centroid = sum(integral(P.dS))
145 buffer(1,node_id) = brick_list(nin,ibm)%FCELL(1)
146 buffer(2,node_id) = brick_list(nin,ibm)%FCELL(2)
147 buffer(3,node_id) = brick_list(nin,ibm)%FCELL(3)
148 ELSE
149 buffer(1,node_id) = zero
150 buffer(2,node_id) = zero
151 buffer(3,node_id) = zero
152 ENDIF
153 ENDDO !next ICELL
154 enddo!next IB
155
156 DO i=1,numnod
157 value(1)=buffer(1,i)
158 value(2)=buffer(2,i)
159 value(3)=buffer(3,i)
160 CALL h3d_write_vector(iok_part,is_written_node,nodal_vector,i,0,0,
161 . VALUE)
162 ENDDO
163
164 DEALLOCATE(buffer)
165 !---------------------------------------------------------!
166
167 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
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