OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
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!|| velvecz22 ../engine/source/output/anim/generate/velvecz22.F
25!||--- called by ------------------------------------------------------
26!|| genani ../engine/source/output/anim/generate/genani.F
27!||--- calls -----------------------------------------------------
28!|| write_r_c ../common_source/tools/input_output/write_routtines.c
29!||--- uses -----------------------------------------------------
30!|| elbufdef_mod ../common_source/modules/mat_elem/elbufdef_mod.F90
31!|| groupdef_mod ../common_source/modules/groupdef_mod.F
32!|| i22bufbric_mod ../common_source/modules/interfaces/cut-cell-search_mod.F
33!|| i22edge_mod ../common_source/modules/interfaces/cut-cell-buffer_mod.F
34!|| i22tri_mod ../common_source/modules/interfaces/cut-cell-search_mod.F
35!|| initbuf_mod ../engine/share/resol/initbuf.F
36!||====================================================================
37 SUBROUTINE velvecz22(ELBUF_TAB,IPARG ,IPARI ,IGRNOD , X,
38 . IXS ,IXQ ,ITAB ,IFLG )
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
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 my_real, INTENT(INOUT) :: x(3,numnod)
71 REAL R4
72 TYPE (ELBUF_STRUCT_), DIMENSION(NGROUP), TARGET :: ELBUF_TAB
73 TYPE (GROUP_) , DIMENSION(NGRNOD) :: IGRNOD
74C-----------------------------------------------
75C L o c a l A r g u m e n t s
76C-----------------------------------------------
77 INTEGER :: ICELLM,NCELL,NBF,NBL,ICELL,NIN,NODE_ID,IB,NG,I
78 INTEGER :: IAD0, NNODES, II, NFACE, J, K, IE,IGR
79 my_real :: rho_cell, rho(4)
80 REAL,DIMENSION(:,:),ALLOCATABLE :: BUFFER
81 LOGICAL :: lStillNode
82C-----------------------------------------------
83C P r e - C o n d i t i o n s
84C-----------------------------------------------
85 nin = 1
86 IF(int22==0) RETURN
87 IF(ipari(82,nin)==0)RETURN
88C-----------------------------------------------
89C S o u r c e C o d e
90C-----------------------------------------------
91 !---------------------------------------------------------!
92 nbf = 1
93 nbl = nb
94 ALLOCATE(buffer(3,numnod))
95 buffer(:,:) = zero
96 !---------------------------------------------------------!
97
98 lstillnode = .true.
99 igr = ipari(82,nin)
100 nnodes = igrnod(igr)%NENTITY
101 IF(nnodes==0)RETURN
102 ii = 1 ! start with the first node of the group
103 DO ib=nbf,nbl
104 ie = brick_list(nin,ib)%ID
105 icell = 0
106 ncell = brick_list(nin,ib)%NBCUT
107 DO WHILE (icell<=ncell) ! loop on polyhedron {1:NCELL} U {9}
108 icell = icell +1
109 IF (icell>ncell .AND. ncell/=0)icell=9
110 IF(.NOT.lstillnode) cycle
111 ! nFACE = BRICK_LIST(NIN,IB)%NFACE_Cell(ICELL)
112 DO j=1, 6
113 IF(ii>nnodes)THEN
114 lstillnode = .false.
115 print *, "** Warning inter22 : no more node in group to mark cell center"
116 EXIT
117 ENDIF
118 node_id = igrnod(igr)%ENTITY(ii)
119 IF(iflg==1)THEN
120 !velocity at faces
121 buffer(1,node_id) = brick_list(nin,ib)%POLY(icell)%FACE(j)%Vel(1)
122 buffer(2,node_id) = brick_list(nin,ib)%POLY(icell)%FACE(j)%Vel(2)
123 buffer(3,node_id) = brick_list(nin,ib)%POLY(icell)%FACE(j)%Vel(3)
124 ELSEIF(iflg==2)THEN
125 !internal forces at face int(P.dS)
126 buffer(1,node_id) = -brick_list(nin,ib)%POLY(icell)%FACE(j)%F_FACE(1)
127 buffer(2,node_id) = -brick_list(nin,ib)%POLY(icell)%FACE(j)%F_FACE(2)
128 buffer(3,node_id) = -brick_list(nin,ib)%POLY(icell)%FACE(j)%F_FACE(3)
129 ELSE
130 buffer(1,node_id) = zero
131 buffer(2,node_id) = zero
132 buffer(3,node_id) = zero
133 ENDIF
134 ii = ii + 1 !next node
135 ENDDO
136 ENDDO !next ICELL
137 enddo!next IB
138
139 DO ii=1,nnodes
140 node_id = igrnod(igr)%ENTITY(ii)
141 x(1:3,node_id) = zero
142 ENDDO
143
144 DO i=1,numnod
145 r4 = buffer(1,i)
146 CALL write_r_c(r4,1)
147 r4 = buffer(2,i)
148 CALL write_r_c(r4,1)
149 r4 = buffer(3,i)
150 CALL write_r_c(r4,1)
151 enddo!next I
152
153 DEALLOCATE(buffer)
154
155C-----------------------------------------------
156 RETURN
157 END
#define my_real
Definition cppsort.cpp:32
type(brick_entity), dimension(:,:), allocatable, target brick_list
subroutine velvecz22(elbuf_tab, iparg, ipari, igrnod, x, ixs, ixq, itab, iflg)
Definition velvecz22.F:39
void write_r_c(float *w, int *len)