OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
h3d_velvecz22.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_velvecz22 ../engine/source/output/h3d/h3d_results/h3d_velvecz22.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!|| element_mod ../common_source/modules/elements/element_mod.F90
32!|| groupdef_mod ../common_source/modules/groupdef_mod.F
33!|| i22bufbric_mod ../common_source/modules/interfaces/cut-cell-search_mod.F
34!|| i22edge_mod ../common_source/modules/interfaces/cut-cell-buffer_mod.F
35!|| i22tri_mod ../common_source/modules/interfaces/cut-cell-search_mod.F
36!|| initbuf_mod ../engine/share/resol/initbuf.F
37!||====================================================================
38 SUBROUTINE h3d_velvecz22(ELBUF_TAB,IPARG,IPARI,IGRNOD,X,IXS,IXQ,ITAB,IFLG,
39 . IOK_PART,IS_WRITTEN_NODE,NODAL_VECTOR)
40C-----------------------------------------------
41C D e s c r i p t i o n
42C-----------------------------------------------
43C This subroutines writes velocities & internal forces at face
44C centers for coupling interface 22. Free nodes are used as
45C marker to plot centroid vectors (see input card for grnod_id)
46C-----------------------------------------------
47C M o d u l e s
48C-----------------------------------------------
49 USE initbuf_mod
50 USE elbufdef_mod
51 USE i22bufbric_mod
52 USE i22edge_mod
53 USE i22tri_mod
54 USE groupdef_mod
55 use element_mod , only : nixs,nixq
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"
66#include "inter22.inc"
67C-----------------------------------------------
68C D u m m y A r g u m e n t s
69C-----------------------------------------------
70 INTEGER, INTENT(IN) :: IPARG(NPARG,*), IPARI(NPARI,*),IXS(NIXS,*),IXQ(NIXQ,*)
71 INTEGER, INTENT(IN) :: ITAB(NUMNOD),IFLG
72 INTEGER, INTENT(IN) :: IOK_PART(*),IS_WRITTEN_NODE(*)
73 my_real, INTENT(INOUT) :: x(3,numnod)
74 my_real, INTENT(INOUT) :: nodal_vector(3,*)
75
76 TYPE (ELBUF_STRUCT_), DIMENSION(NGROUP), TARGET :: ELBUF_TAB
77 TYPE (GROUP_) , DIMENSION(NGRNOD) :: IGRNOD
78C-----------------------------------------------
79C L o c a l A r g u m e n t s
80C-----------------------------------------------
81 INTEGER :: NCELL, NBF, NBL, ICELL, NIN, NODE_ID, IB, I
82 INTEGER :: NNODES, II, J, IE, IGR
83
84 REAL,DIMENSION(:,:),ALLOCATABLE :: BUFFER
85 LOGICAL :: lStillNode
86 my_real value(3)
87C-----------------------------------------------
88C P r e - C o n d i t i o n s
89C-----------------------------------------------
90 nin = 1
91 IF(int22==0) RETURN
92 IF(ipari(82,nin)==0)RETURN
93C-----------------------------------------------
94C S o u r c e C o d e
95C-----------------------------------------------
96 !---------------------------------------------------------!
97 nbf = 1
98 nbl = nb
99 ALLOCATE(buffer(3,numnod))
100 buffer(:,:) = zero
101 !---------------------------------------------------------!
102
103 lstillnode = .true.
104 igr = ipari(82,nin)
105 nnodes = igrnod(igr)%NENTITY
106 IF(nnodes==0)RETURN
107 ii = 1 ! start with the first node of the group
108 DO ib=nbf,nbl
109 ie = brick_list(nin,ib)%ID
110 icell = 0
111 ncell = brick_list(nin,ib)%NBCUT
112 DO WHILE (icell<=ncell) ! loop on polyhedron {1:NCELL} U {9}
113 icell = icell +1
114 IF (icell>ncell .AND. ncell/=0)icell=9
115 IF(.NOT.lstillnode) cycle
116 ! nFACE = BRICK_LIST(NIN,IB)%NFACE_Cell(ICELL)
117 DO j=1, 6
118 IF(ii>nnodes)THEN
119 lstillnode = .false.
120 print *, "** Warning inter22 : no more node in group to mark cell center"
121 EXIT
122 ENDIF
123 node_id = igrnod(igr)%ENTITY(ii)
124 IF(iflg==1)THEN
125 !velocity at faces
126 buffer(1,node_id) = brick_list(nin,ib)%POLY(icell)%FACE(j)%Vel(1)
127 buffer(2,node_id) = brick_list(nin,ib)%POLY(icell)%FACE(j)%Vel(2)
128 buffer(3,node_id) = brick_list(nin,ib)%POLY(icell)%FACE(j)%Vel(3)
129 ELSEIF(iflg==2)THEN
130 !internal forces at face int(P.dS)
131 buffer(1,node_id) = -brick_list(nin,ib)%POLY(icell)%FACE(j)%F_FACE(1)
132 buffer(2,node_id) = -brick_list(nin,ib)%POLY(icell)%FACE(j)%F_FACE(2)
133 buffer(3,node_id) = -brick_list(nin,ib)%POLY(icell)%FACE(j)%F_FACE(3)
134 ELSE
135 buffer(1,node_id) = zero
136 buffer(2,node_id) = zero
137 buffer(3,node_id) = zero
138 ENDIF
139 ii = ii + 1 !next node
140 ENDDO
141 ENDDO !next ICELL
142 enddo!next IB
143
144 DO ii=1,nnodes
145 node_id = igrnod(igr)%ENTITY(ii)
146 x(1:3,node_id) = zero
147 ENDDO
148
149 DO i=1,numnod
150 value(1)=buffer(1,i)
151 value(2)=buffer(2,i)
152 value(3)=buffer(3,i)
153 CALL h3d_write_vector(iok_part,is_written_node,nodal_vector,i,0,0,
154 . VALUE)
155 ENDDO
156
157 DEALLOCATE(buffer)
158
159C-----------------------------------------------
160 RETURN
161 END
my_real
#define my_real
Definition cppsort.cpp:32
h3d_nodal_vector
subroutine h3d_nodal_vector(elbuf_tab, nodal_vector, ifunc, iparg, geo, mass, pm, 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)
Definition h3d_nodal_vector.F:58
h3d_velvecz22
subroutine h3d_velvecz22(elbuf_tab, iparg, ipari, igrnod, x, ixs, ixq, itab, iflg, iok_part, is_written_node, nodal_vector)
Definition h3d_velvecz22.F:40
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:668
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