OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
nodalvfrac.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!|| nodalvfrac ../engine/source/output/anim/generate/nodalvfrac.F
25!||--- called by ------------------------------------------------------
26!|| genani ../engine/source/output/anim/generate/genani.F
27!||--- uses -----------------------------------------------------
28!|| elbufdef_mod ../common_source/modules/mat_elem/elbufdef_mod.F90
29!|| i22bufbric_mod ../common_source/modules/interfaces/cut-cell-search_mod.F
30!|| i22edge_mod ../common_source/modules/interfaces/cut-cell-buffer_mod.F
31!|| i22tri_mod ../common_source/modules/interfaces/cut-cell-search_mod.F
32!|| initbuf_mod ../engine/share/resol/initbuf.F
33!|| multimat_param_mod ../common_source/modules/multimat_param_mod.F90
34!||====================================================================
35 SUBROUTINE nodalvfrac(IFUNC , WA4, IFLOW, RFLOW, IPARG,
36 . ELBUF_TAB, IX , NIX , ITAB , NV46 )
37C-----------------------------------------------
38C D e s c r i p t i o n
39C-----------------------------------------------
40C This suroutine computes nodal volumetric fraction for
41C ALE elements. In case of CEL coupling (inter22)
42C result is also calculated from cut cells.
43C Aim is to expand centroid values to nodal positions
44C-----------------------------------------------
45C P r e - C o n d i t i o n s
46C-----------------------------------------------
47C Tested below during NG LOOP : IALEL > 0
48C where IALEL =IPARG(7,NG)+IPARG(11,NG)
49C-----------------------------------------------
50C M o d u l e s
51C-----------------------------------------------
52 USE initbuf_mod
53 USE elbufdef_mod
55 USE i22edge_mod
56 USE i22tri_mod
57 USE multimat_param_mod , ONLY : m51_n0phas, m51_nvphas
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 "vect01_c.inc"
68#include "param_c.inc"
69#include "inter22.inc"
70C-----------------------------------------------
71C D u m m y A r g u m e n t s
72C-----------------------------------------------
73 INTEGER,INTENT(IN) :: IFUNC, IFLOW(*),IPARG(NPARG,*),IX(NIX,*),ITAB(*),NIX,NV46
74 my_real,INTENT(IN) :: rflow(*)
75 REAL,INTENT(INOUT) :: WA4(*)
76
77 TYPE (ELBUF_STRUCT_), DIMENSION(NGROUP), TARGET :: ELBUF_TAB
78 TYPE(buf_mat_),POINTER :: MBUF
79C-----------------------------------------------
80C L o c a l V a r i a b l e s
81C-----------------------------------------------
82 INTEGER :: IADI, IADR, I, ITYP, NINOUT, NNO, NEL, II1, II2,K1,K,
83 . ir1, ir2, j, jj, nno_l, nni_l, ii3, ii4, jjj, nni,
84 . ialel,nnod,ipos,iv,ngv,j1,j2,ibv, mlw,numnodcell,
85 . ng, kcvt, ii, nbf, nbl, ib, icell, nin, mcell,
86 . iphase
87 TYPE(g_bufel_) ,POINTER :: GBUF,GBUFv
88 my_real, ALLOCATABLE, DIMENSION(:) :: count_vol
89 my_real :: p,vf,d,v
90 INTEGER,DIMENSION(:,:), POINTER :: pAdjBRICK
91C-----------------------------------------------
92C D e s c r i p t i o n
93C-----------------------------------------------
94C This subroutine writes nodal VFRAC
95C /INTER/TYPE22 (only).
96C
97C-----------------------------------------------
98C S o u r c e L i n e s
99C-----------------------------------------------
100
101
102 nnod = nix-3 !8-node brick or 4-node quad
103 iphase = ifunc-19
104
105 IF(int22==0)THEN
106 !---------------------------------------------------------!
107 ! ALE STANDARD FORMULATION !
108 !---------------------------------------------------------!
109 !1. COMPUTE NODAL VALUE !
110 !---------------------------------------------------------!
111 !---1. COMPUTE NODAL VFRAC---!
112 ALLOCATE(count_vol(numnod))
113 count_vol(:) = 0
114 DO ng = 1, ngroup
115 mlw = iparg(1,ng)
116 nel = iparg(2,ng)
117 nft = iparg(3,ng)
118 ityp = iparg(5,ng)
119 ialel = iparg(7,ng)+iparg(11,ng)
120 IF(ityp/=1 .AND. ityp/=2)cycle
121 IF(ialel==0)cycle
122 IF(mlw/=37.AND.mlw/=51)cycle
123 gbuf => elbuf_tab(ng)%GBUF
124 mbuf => elbuf_tab(ng)%BUFLY(1)%MAT(1,1,1)
125 IF(mlw==37)THEN
126 DO i=1,nel
127 vf = mbuf%VAR(nel*(3+iphase-1)+i) !liquid or gas in uvar(I,4:5)
128 v = gbuf%VOL(i)
129 DO j=2,nnod+1
130 jj = ix(j,nft+i)
131 wa4(jj) = wa4(jj)+vf*v*one_over_8
132 count_vol(jj) = count_vol(jj) + v * one_over_8
133 ENDDO !next J
134 enddo! next I
135 ELSEIF(mlw==51)THEN
136 DO i=1,nel
137 ipos = 1
138 k1 = m51_n0phas + (iphase-1)*m51_nvphas +ipos-1 ! example : IPOS=1 => VFRAC {UVAR(I,ADD)=UVAR(K+I)}
139 k = k1 * nel
140 vf = mbuf%VAR(k+i)
141 v = gbuf%VOL(i)
142 DO j=2,nnod+1
143 jj = ix(j,nft+i)
144 wa4(jj) = wa4(jj)+vf*v*one_over_8
145 count_vol(jj) = count_vol(jj) + v * one_over_8
146 ENDDO !next J
147 enddo! next I
148 ENDIF
149 enddo!next NG
150 !applying weight factor
151 DO i=1,numnod
152 IF(count_vol(i)/=zero)THEN
153 wa4(i)=wa4(i)/count_vol(i)
154 ENDIF
155 ENDDO
156 DEALLOCATE(count_vol)
157 ELSEIF(int22>0)THEN
158 !---------------------------------------------------------!
159 ! /INTER/TYPE22 !
160 !---------------------------------------------------------!
161 !1. TAG FOR CUT CELL !
162 !2. COMPUTE NODAL VALUE !
163 ! NOT INTERSECTED : NODAL Val COMPUTED FROM GLOBAL BUF !
164 !---------------------------------------------------------!
165 !---1. TAG FOR INTERSECTED BRICKS---!
166 !NBF = 1+ITASK*NB/NTHREAD
167 !NBL = (ITASK+1)*NB/NTHREAD
168 nbf = 1
169 nbl = nb
170 nin = 1
171 !---1. COMPUTE NODAL PRESSURE---!
172 ALLOCATE(count_vol(numnod))
173 count_vol = 0
174 DO ng = 1, ngroup
175 mlw = iparg(1,ng)
176 nel = iparg(2,ng)
177 nft = iparg(3,ng)
178 ityp = iparg(5,ng)
179 ialel = iparg(7,ng)+iparg(11,ng)
180 IF(ityp/=1 .AND. ityp/=2)cycle
181 IF(ialel==0)cycle
182 IF(mlw/=37.AND.mlw/=51)cycle
183 gbuf => elbuf_tab(ng)%GBUF
184 mbuf => elbuf_tab(ng)%BUFLY(1)%MAT(1,1,1)
185 DO i=1,nel
186 ib = nint(gbuf%TAG22(i))
187 !---------------------------!
188 ! NOT A CUT CELL !
189 !---------------------------!
190 IF(ib==0)THEN
191 IF(mlw==37)THEN
192 vf = mbuf%VAR(nel*(3+iphase-1)+i) !liquid or gas in uvar(I,4:5)
193 v = gbuf%VOL(i)
194 DO j=2,nnod+1
195 jj = ix(j,nft+i)
196 wa4(jj) = wa4(jj)+vf*v*one_over_8
197 count_vol(jj) = count_vol(jj) + v * one_over_8 !cumulated volume
198 ENDDO !next J
199 ELSEIF(mlw==51)THEN
200 ipos = 1
201 k1 = m51_n0phas + (iphase-1)*m51_nvphas +ipos-1 ! example : IPOS=1 => VFRAC {UVAR(I,ADD)=UVAR(K+I)}
202 k = k1 * nel
203 vf = mbuf%VAR(k+i)
204 v = gbuf%VOL(i)
205 DO j=2,nnod+1
206 jj = ix(j,nft+i)
207 wa4(jj) = wa4(jj)+vf*v*one_over_8
208 count_vol(jj) = count_vol(jj) + v * one_over_8
209 ENDDO !next J
210 ENDIF
211 !---------------------------!
212 ! CUT CELL !
213 !---------------------------!
214 ELSE
215 nin = 1
216 DO j=2,nnod+1
217 jj = ix(j,nft+i)
218 icell = brick_list(nin,ib)%NODE(j-1)%WhichCell
219 vf = brick_list(nin,ib)%POLY(icell)%VFRACm(iphase)
220 ! if(vf<zero .or. vf>un)then
221 ! print *,"**inter22, cell vfrac warning", vf
222 ! endif
223 numnodcell = brick_list(nin,ib)%POLY(icell)%NumNOD
224 v = brick_list(nin,ib)%POLY(icell)%Vnew
225 wa4(jj) = wa4(jj)+vf*v/numnodcell
226 count_vol(jj) = count_vol(jj) + v / numnodcell
227 ENDDO !next J
228 ENDIF
229 enddo!next I
230 enddo!next NG
231 DO i=1,numnod
232 IF(count_vol(i)/=zero)THEN
233 wa4(i)=wa4(i)/count_vol(i)
234 ENDIF
235 ENDDO
236 DEALLOCATE(count_vol)
237
238 endif!INT22
239
240
241C-----------------------------------------------
242 RETURN
243 END
#define my_real
Definition cppsort.cpp:32
type(brick_entity), dimension(:,:), allocatable, target brick_list
subroutine nodalvfrac(ifunc, wa4, iflow, rflow, iparg, elbuf_tab, ix, nix, itab, nv46)
Definition nodalvfrac.F:37