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

Go to the source code of this file.

Functions/Subroutines

subroutine anim_nodal_p_elems (ifunc, wa4, iparg, elbuf_tab, ix, nix, numel, itab, nv46, is_written_node)

Function/Subroutine Documentation

◆ anim_nodal_p_elems()

subroutine anim_nodal_p_elems ( integer, intent(in) ifunc,
real, dimension(*), intent(inout) wa4,
integer, dimension(nparg,ngroup), intent(in) iparg,
type (elbuf_struct_), dimension(ngroup), intent(in), target elbuf_tab,
integer, dimension(nix,numel), intent(in) ix,
integer, intent(in) nix,
integer, intent(in) numel,
integer, dimension(numnod), intent(in) itab,
integer, intent(in) nv46,
integer, dimension(numnod), intent(inout) is_written_node )

Definition at line 34 of file anim_nodal_p_elems.F.

35C-----------------------------------------------
36C D e s c r i p t i o n
37C-----------------------------------------------
38C This suroutine computes nodal pressure for
39C ALE elements. In case of CEL coupling (inter22)
40C result is also calculated from cut cells.
41C-----------------------------------------------
42C P r e - C o n d i t i o n s
43C-----------------------------------------------
44C Tested below during NG LOOP : IALEL > 0
45C where IALEL =IPARG(7,NG)+IPARG(11,NG)
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
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 "vect01_c.inc"
64#include "param_c.inc"
65#include "inter22.inc"
66C-----------------------------------------------
67C D u m m y A r g u m e n t s
68C-----------------------------------------------
69 INTEGER,INTENT(IN) :: IFUNC, IPARG(NPARG,NGROUP),IX(NIX,NUMEL),ITAB(NUMNOD),NIX,NV46,NUMEL
70 REAL,INTENT(INOUT) :: WA4(*)
71 TYPE (ELBUF_STRUCT_),INTENT(IN), DIMENSION(NGROUP), TARGET :: ELBUF_TAB
72 INTEGER, INTENT(INOUT) :: IS_WRITTEN_NODE(NUMNOD)
73C-----------------------------------------------
74C L o c a l V a r i a b l e s
75C-----------------------------------------------
76 INTEGER IADI, IADR, I, ITYP, NINOUT, NNO, NEL, NELv,II1, II2,
77 . IR1, IR2, J, JJ, NNO_L, NNI_L, II3, II4, JJJ, NNI,
78 . IALEL,NNOD,IPOS,IV,NGv,IDLOCv,J1,J2,IBV
79 INTEGER MLW, NG, KCVT, II(6), NBF, NBL, IB, ICELL, NIN, MCELL
80 TYPE(G_BUFEL_) ,POINTER :: GBUF,GBUFv
81 my_real, ALLOCATABLE, DIMENSION(:) :: sum_weight
82 my_real p, weight
83 INTEGER,DIMENSION(:,:), POINTER :: pAdjBRICK
84C-----------------------------------------------
85C D e s c r i p t i o n
86C-----------------------------------------------
87C This subroutine is setting nodal pressure requested by Engine keyword /ANIM/NODA/P
88C Several situation are possible. This one is dealing with nodal pressure from adjacent elements.
89C + LOOP OVER ELEM
90C | GET ITS PRESSURE FROM ELEM BUFFER
91C | USE ELEM TO SET MEAN PRESSURE ON ELEM NODES (WEIGHT = VOLUME)
92C-----------------------------------------------
93C S o u r c e L i n e s
94C-----------------------------------------------
95
96 ALLOCATE(sum_weight(numnod))
97 sum_weight = 0
98 nnod = nix-3 !8-node brick or 4-node quad
99
100 IF(int22==0)THEN
101 !---------------------------------------------------------!
102 ! EXPAND ELEM PRESSURE TO NODES !
103 !---------------------------------------------------------!
104 DO ng = 1, ngroup
105 nel =iparg(2,ng)
106 nft =iparg(3,ng)
107 ityp =iparg(5,ng)
108 IF(ityp/=1 .AND. ityp/=2)cycle
109 gbuf => elbuf_tab(ng)%GBUF
110 IF(gbuf%G_SIG > 0)THEN !this may not be allocated (example : /MAT/VOID)
111 DO i=1,nel
112 p = gbuf%SIG(nel*(1-1)+i)+gbuf%SIG(nel*(2-1)+i)+gbuf%SIG(nel*(3-1)+i)
113 p = -p*third
114 weight = gbuf%VOL(i)
115 DO j=2,nnod+1
116 jj=ix(j,nft+i)
117 is_written_node(jj)=1
118 wa4(jj)=wa4(jj)+weight*p
119 sum_weight(jj) = sum_weight(jj) + weight !cumulated volume
120 ENDDO
121 enddo!next I
122 END IF
123 ENDDO
124
125
126 ELSEIF(int22>0)THEN
127 !---------------------------------------------------------!
128 ! /INTER/TYPE22 !
129 ! specific case due to generic polyhedra !
130 !---------------------------------------------------------!
131 !1. TAG FOR CUT CELLS !
132 !2. COMPUTE NODAL PRESSURE !
133 ! NOT INTERSECTED : NODAL P COMPUTED FROM GLOBAL BUF !
134 ! INTERSECTED : NODAL P COMPUTED FROM SUBVOLUME !
135 !---------------------------------------------------------!
136 !---1. TAG FOR INTERSECTED BRICKS---!
137 !NBF = 1+ITASK*NB/NTHREAD
138 !NBL = (ITASK+1)*NB/NTHREAD
139 nbf = 1
140 nbl = nb
141 nin = 1
142 !---1. COMPUTE NODAL PRESSURE---!
143 DO ng = 1, ngroup
144 nel =iparg(2,ng)
145 nft =iparg(3,ng)
146 ityp =iparg(5,ng)
147 ialel =iparg(7,ng)+iparg(11,ng)
148 gbuf => elbuf_tab(ng)%GBUF
149 IF(ityp/=1 .AND. ityp/=2)cycle
150 IF(ialel==0)cycle
151 IF(gbuf%G_SIG==0)cycle
152 DO i=1,nel
153 ib = nint(gbuf%TAG22(i))
154 !---------------------------!
155 ! NOT A CUT CELL !
156 !---------------------------!
157 IF(ib>0)THEN
158 IF(brick_list(nin,ib)%NBCUT==0)ib=0 !in cut cell buffer but not partitioned (because it is adjacent to a cut cell)
159 ENDIF
160 IF(ib==0)THEN
161 p = gbuf%SIG(nel*(1-1)+i)+gbuf%SIG(nel*(2-1)+i)+gbuf%SIG(nel*(3-1)+i)
162 p = -p*third
163 weight = gbuf%VOL(i)
164 DO j=2,nnod+1
165 jj=ix(j,nft+i)
166 is_written_node(jj)=1
167 wa4(jj)=wa4(jj)+ p*weight
168 sum_weight(jj) = sum_weight(jj) + weight !cumulated volume
169 ENDDO
170 !---------------------------!
171 ! CUT CELL !
172 !---------------------------!
173 ELSE
174 nin = 1
175 ib = nint(gbuf%TAG22(i))
176 mcell = brick_list(nin,ib)%MainID
177 nel = iparg(2,ng)
178 DO j=2,nnod+1
179 jj=ix(j,nft+i)
180 is_written_node(jj)=1
181 icell=brick_list(nin,ib)%NODE(j-1)%WhichCell
182 IF(icell == mcell)THEN
183 p = gbuf%SIG(nel*(1-1)+i)+gbuf%SIG(nel*(2-1)+i)+gbuf%SIG(nel*(3-1)+i)
184 p = -p*third
185 weight = gbuf%VOL(i)
186 ELSE
187 padjbrick => brick_list(nin,ib)%Adjacent_Brick(1:6,1:5)
188 ipos = brick_list(nin,ib)%POLY(icell)%WhereIsMain(1)
189 IF(ipos<=nv46)THEN
190 iv = brick_list(nin,ib)%Adjacent_Brick(ipos,1)
191 ngv = brick_list(nin,ib)%Adjacent_Brick(ipos,2)
192 idlocv = brick_list(nin,ib)%Adjacent_Brick(ipos,3)
193 nelv = iparg(2,ngv)
194 ELSE
195 j1 = ipos/10
196 j2 = mod(ipos,10)
197 ibv = brick_list(nin,ib )%Adjacent_Brick(j1,4)
198 iv = brick_list(nin,ibv)%Adjacent_Brick(j2,1)
199 ngv = brick_list(nin,ibv)%Adjacent_Brick(j2,2)
200 idlocv = brick_list(nin,ibv)%Adjacent_Brick(j2,3)
201 nelv = iparg(2,ngv)
202 ENDIF
203 gbufv => elbuf_tab(ngv)%GBUF
204 p = gbufv%SIG(nelv*(1-1)+idlocv)+gbufv%SIG(nelv*(2-1)+idlocv)+gbufv%SIG(nelv*(3-1)+idlocv)
205 p = -p*third
206 weight = gbufv%VOL(idlocv)
207 ENDIF
208 wa4(jj)=wa4(jj)+p*weight
209 sum_weight(jj) = sum_weight(jj) + weight
210 ENDDO
211 ENDIF
212 ENDDO
213 ENDDO
214 ENDIF
215
216C-----------------------------------------------
217 !divinding by sum of weights to get finally weighting factors
218 DO i=1,numnod
219 IF(sum_weight(i)/=zero)THEN
220 wa4(i)=wa4(i)/sum_weight(i)
221 ENDIF
222 ENDDO
223
224 DEALLOCATE(sum_weight)
225C-----------------------------------------------
226
227 RETURN
my_real
#define my_real
Definition cppsort.cpp:32
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