OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
h3d_velvecc22.F
Go to the documentation of this file.
1Copyright> OpenRadioss
2Copyright> Copyright (C) 1986-2025 Altair Engineering Inc.
3Copyright>
4Copyright> This program is free software: you can redistribute it and/or modify
5Copyright> it under the terms of the GNU Affero General Public License as published by
6Copyright> the Free Software Foundation, either version 3 of the License, or
7Copyright> (at your option) any later version.
8Copyright>
9Copyright> This program is distributed in the hope that it will be useful,
10Copyright> but WITHOUT ANY WARRANTY; without even the implied warranty of
11Copyright> MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12Copyright> GNU Affero General Public License for more details.
13Copyright>
14Copyright> You should have received a copy of the GNU Affero General Public License
15Copyright> along with this program. If not, see <https://www.gnu.org/licenses/>.
16Copyright>
17Copyright>
18Copyright> Commercial Alternative: Altair Radioss Software
19Copyright>
20Copyright> As an alternative to this open-source version, Altair also offers Altair Radioss
21Copyright> software under a commercial license. Contact Altair to discuss further if the
22Copyright> commercial version may interest you: https://www.altair.com/radioss/.
23!||====================================================================
24!|| h3d_velvecc22 ../engine/source/output/h3d/h3d_results/h3d_velvecc22.F
25!||--- called by ------------------------------------------------------
26!|| h3d_nodal_vector ../engine/source/output/h3d/h3d_results/h3d_nodal_vector.f
27!||--- calls -----------------------------------------------------
28!|| h3d_write_vector ../engine/source/output/h3d/h3d_results/h3d_write_vector.F
29!||--- uses -----------------------------------------------------
30!|| elbufdef_mod ../common_source/modules/mat_elem/elbufdef_mod.F90
31!|| i22bufbric_mod ../common_source/modules/interfaces/cut-cell-search_mod.F
32!|| i22edge_mod ../common_source/modules/interfaces/cut-cell-buffer_mod.F
33!|| i22tri_mod ../common_source/modules/interfaces/cut-cell-search_mod.F
34!|| initbuf_mod ../engine/share/resol/initbuf.F
35!||====================================================================
36 SUBROUTINE h3d_velvecc22(ELBUF_TAB,IPARG,IFLG,IXS,IXQ,ITAB,
37 . IOK_PART,IS_WRITTEN_NODE,NODAL_VECTOR)
38C-----------------------------------------------
39C D e s c r i p t i o n
40C-----------------------------------------------
41C This subroutines writes at polyedra centroids :
42C velocities (IFLG=1),
43C momentum density (IFLG=2)
44C internal forces (IFLG=3),
45C for coupling interface 22. Free nodes are used
46C as marker to plot centroid vectors
47C(see input card for grnod_id)
48C-----------------------------------------------
49C M o d u l e s
50C-----------------------------------------------
51 USE initbuf_mod
52 USE elbufdef_mod
54 USE i22edge_mod
55 USE i22tri_mod
56C-----------------------------------------------
57C I m p l i c i t T y p e s
58C-----------------------------------------------
59#include "implicit_f.inc"
60C-----------------------------------------------
61C C o m m o n B l o c k s
62C-----------------------------------------------
63#include "com01_c.inc"
64#include "com04_c.inc"
65#include "param_c.inc"
66C-----------------------------------------------
67C D u m m y A r g u m e n t s
68C-----------------------------------------------
69 INTEGER, INTENT(IN) :: IPARG(NPARG,*), IFLG,IXS(NIXS,NUMELS),IXQ(NIXQ,NUMELQ),ITAB(NUMNOD)
70 INTEGER, INTENT(IN) :: IOK_PART(*)
71 INTEGER, INTENT(INOUT) :: IS_WRITTEN_NODE(*)
72 my_real, INTENT(INOUT) :: nodal_vector(3,*)
73 REAL R4
74 TYPE (ELBUF_STRUCT_), DIMENSION(NGROUP), TARGET :: ELBUF_TAB
75 TYPE(buf_mat_),POINTER :: MBUF
76 TYPE(g_bufel_),POINTER :: GBUF
77C-----------------------------------------------
78C L o c a l A r g u m e n t s
79C-----------------------------------------------
80 INTEGER :: NGM, IDLOCM, IBM,ICELLM,MLW,NCELL,NELm,NBF,NBL,ICELL,NIN,NODE_ID,IB,NG,I
81 my_real :: rho_cell, rho(4), vfrac(4)
82 REAL,DIMENSION(:,:),ALLOCATABLE :: BUFFER
83 my_real value(3)
84C-----------------------------------------------
85
86 !---------------------------------------------------------!
87 nbf = 1
88 nbl = nb
89 nin = 1
90 !---------------------------------------------------------!
91 ALLOCATE(buffer(3,numnod))
92 buffer(:,:) = zero
93
94 DO ib=nbf,nbl
95 icell = 0
96 ncell = brick_list(nin,ib)%NBCUT
97 DO WHILE (icell<=ncell) ! loop on polyhedron {1:NCELL} U {9}
98 icell = icell +1
99 IF (icell>ncell .AND. ncell/=0)icell=9
100 ibm = brick_list(nin,ib)%POLY(icell)%WhereIsMain(4)
101 icellm = brick_list(nin,ibm)%mainID
102 IF(ibm==0)THEN
103 ibm = ib
104 icellm = 1
105 ENDIF
106 ngm = brick_list(nin,ibm)%NG
107 idlocm = brick_list(nin,ibm)%IDLOC
108 gbuf =>elbuf_tab(ngm)%GBUF
109 mbuf =>elbuf_tab(ngm)%BUFLY(1)%MAT(1,1,1)
110 nelm = iparg(2,ngm)
111 mlw = iparg(1,ngm)
112 IF(mlw==37)THEN
113 !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)
114 !UVAR(I,2) : density of gas
115 !uvar(i,3) : density of liquid
116 !UVAR(I,4) : volumetric fraction of liquid
117 !UVAR(I,5) : volumetric fraction of gas
118 rho(1) = mbuf%VAR((3-1)*nelm+idlocm)
119 rho(2) = mbuf%VAR((2-1)*nelm+idlocm)
120 vfrac(1) = mbuf%VAR((4-1)*nelm+idlocm)
121 vfrac(2) = mbuf%VAR((5-1)*nelm+idlocm)
122 rho_cell = rho(1)*vfrac(1) + rho(2)*vfrac(2)
123 ELSEIF(mlw==51)THEN
124 rho(1) = zero
125 rho(2) = zero
126 rho_cell = zero
127 ELSE
128 rho_cell = gbuf%RHO(idlocm)
129 ENDIF
130 node_id = brick_list(nin,ib)%POLY(icell)%ID_FREE_NODE
131 IF(node_id<=0)cycle ! not enough nodes in the group or SMP disabling
132 IF(iflg==1)THEN
133 !velocity vector : U
134 buffer(1,node_id) = gbuf%MOM(nelm*(1-1) + idlocm) / rho_cell
135 buffer(2,node_id) = gbuf%MOM(nelm*(2-1) + idlocm) / rho_cell
136 buffer(3,node_id) = gbuf%MOM(nelm*(3-1) + idlocm) / rho_cell
137 ELSEIF(iflg==2)THEN
138 !momentum density vector : rho.U
139 buffer(1,node_id) = gbuf%MOM(nelm*(1-1) + idlocm)
140 buffer(2,node_id) = gbuf%MOM(nelm*(2-1) + idlocm)
141 buffer(3,node_id) = gbuf%MOM(nelm*(3-1) + idlocm)
142 ELSEIF(iflg==3)THEN
143 !internal force at centroid = sum(integral(P.dS))
144 buffer(1,node_id) = brick_list(nin,ibm)%FCELL(1)
145 buffer(2,node_id) = brick_list(nin,ibm)%FCELL(2)
146 buffer(3,node_id) = brick_list(nin,ibm)%FCELL(3)
147 ELSE
148 buffer(1,node_id) = zero
149 buffer(2,node_id) = zero
150 buffer(3,node_id) = zero
151 ENDIF
152 ENDDO !next icell
153 enddo!next IB
154
155 DO i=1,numnod
156 value(1)=buffer(1,i)
157 value(2)=buffer(2,i)
158 value(3)=buffer(3,i)
159 CALL h3d_write_vector(iok_part,is_written_node,nodal_vector,i,0,0,
160 . VALUE)
161 ENDDO
162
163 DEALLOCATE(buffer)
164 !---------------------------------------------------------!
165
166 RETURN
167 END
#define my_real
Definition cppsort.cpp:32
subroutine h3d_nodal_vector(elbuf_tab, nodal_vector, ifunc, iparg, geo, mass, pm, anin, itab, node_id, info1, info2, is_written_node, h3d_part, ipartc, iparttg, ixc, ixtg, temp, iflow, rflow, ixs, ixq, nv46, monvol, diag_sms, ms, pdama2, x, volmon, stifr, stifn, a, d, v, cont, fcontg, fint, fext, keyword, fncont, fncontg, ftcont, ftcontg, fncont2, dr, dxancg, fanreac, fcluster, mcluster, vr, fopt, npby, vgaz, ipari, igrnod, weight, nodglob, fcont_max, fncontp2, ftcontp2, ar, ipartsp, ipartr, ipartp, ipartt, iparts, ipartq, kxsp, ixr, ixp, ixt, n_h3d_part_list, nodal_vector_fvm, is_written_node_fvm, airbags_total_fvm_in_h3d, smonvol, svolmon, ispmd, fvdata_p, airbags_node_id_shift, w, sw, x_c)
subroutine h3d_velvecc22(elbuf_tab, iparg, iflg, ixs, ixq, itab, iok_part, is_written_node, nodal_vector)
subroutine h3d_write_vector(iok_part, is_written, vector, i, offset, nft, value)
type(brick_entity), dimension(:,:), allocatable, target brick_list