OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
alefvm_tfext.F File Reference
#include "implicit_f.inc"
#include "mvsiz_p.inc"
#include "vect01_c.inc"
#include "com01_c.inc"
#include "com06_c.inc"
#include "com08_c.inc"
#include "param_c.inc"
#include "comlock.inc"
#include "lockon.inc"
#include "lockoff.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine alefvm_tfext (ixs, nv46, sig, ale_connect, n1x, n2x, n3x, n4x, n5x, n6x, n1y, n2y, n3y, n4y, n5y, n6y, n1z, n2z, n3z, n4z, n5z, n6z, x, ipm, nale, w, p, nel, wfext)

Function/Subroutine Documentation

◆ alefvm_tfext()

subroutine alefvm_tfext ( integer, dimension(nixs,*) ixs,
integer nv46,
sig,
type(t_ale_connectivity), intent(in) ale_connect,
n1x,
n2x,
n3x,
n4x,
n5x,
n6x,
n1y,
n2y,
n3y,
n4y,
n5y,
n6y,
n1z,
n2z,
n3z,
n4z,
n5z,
n6z,
x,
integer, dimension(npropmi,*) ipm,
integer, dimension(*) nale,
w,
p,
integer nel,
double precision, intent(inout) wfext )

Definition at line 31 of file alefvm_tfext.F.

38C-----------------------------------------------
39C D e s c r i p t i o n
40C-----------------------------------------------
41C 'alefvm' is related to a collocated scheme (built from FVM and based on Godunov scheme)
42C which was temporarily introduced for experimental option /INTER/TYPE22 (FSI coupling with cut cell method)
43C This cut cell method is not completed, abandoned, and is not an official option.
44C There is no other use for this scheme which is automatically enabled when /INTER/TYPE22 is defined (INT22>0 => IALEFVM=1).
45C
46C This subroutine is treating an uncut cell.
47C-----------------------------------------------
48C M o d u l e s
49C-----------------------------------------------
50 USE alefvm_mod
51 USE ale_connectivity_mod
52C-----------------------------------------------
53C I m p l i c i t T y p e s
54C-----------------------------------------------
55#include "implicit_f.inc"
56C-----------------------------------------------
57C G l o b a l P a r a m e t e r s
58C-----------------------------------------------
59#include "mvsiz_p.inc"
60C-----------------------------------------------
61C C o m m o n B l o c k s
62C-----------------------------------------------
63#include "vect01_c.inc"
64#include "com01_c.inc"
65#include "com06_c.inc"
66#include "com08_c.inc"
67#include "param_c.inc"
68#include "comlock.inc"
69C-----------------------------------------------
70C D e s c r i p t i o n
71C-----------------------------------------------
72C This subroutines computes External force
73C work for internal energy computation.
74C
75CC WARNING THIS SUBROUTINE CAN BE OPTIMIZED (TEMPORARY ONE)
76C
77C-----------------------------------------------
78C D u m m y A r g u m e n t s
79C-----------------------------------------------
80 INTEGER :: IXS(NIXS,*),NV46,IPM(NPROPMI,*),NALE(*),NEL
81 my_real :: sig(nel,6),x(3,*),w(3,*),p(mvsiz)
82 my_real :: n1x(*), n2x(*), n3x(*), n4x(*), n5x(*), n6x(*),
83 . n1y(*), n2y(*), n3y(*), n4y(*), n5y(*), n6y(*),
84 . n1z(*), n2z(*), n3z(*), n4z(*), n5z(*), n6z(*)
85 TYPE(t_ale_connectivity), INTENT(IN) :: ALE_CONNECT
86 DOUBLE PRECISION,INTENT(INOUT) :: WFEXT
87C-----------------------------------------------
88C L o c a l V a r i a b l e s
89C-----------------------------------------------
90 INTEGER :: I, II, IV, J, MT, IALEFVM_FLG, ICF(4,6),IX(4)
91 INTEGER :: NC1(MVSIZ),NC2(MVSIZ),NC3(MVSIZ),NC4(MVSIZ),NC5(MVSIZ),NC6(MVSIZ),NC7(MVSIZ),NC8(MVSIZ)
92 my_real :: x1(mvsiz), x2(mvsiz), x3(mvsiz) , x4(mvsiz), x5(mvsiz), x6(mvsiz), x7(mvsiz), x8(mvsiz),
93 . y1(mvsiz), y2(mvsiz), y3(mvsiz) , y4(mvsiz), y5(mvsiz), y6(mvsiz), y7(mvsiz), y8(mvsiz),
94 . z1(mvsiz), z2(mvsiz), z3(mvsiz) , z4(mvsiz), z5(mvsiz), z6(mvsiz), z7(mvsiz), z8(mvsiz),
95 . swn(6) , wface(3,6,mvsiz), wfext_add, wfextt
96
97 DATA icf/1,4,3,2,3,4,8,7,5,6,7,8,1,2,6,5,2,3,7,6,1,5,8,4/
98 INTEGER :: IAD2
99C-----------------------------------------------
100C P r e - C o n d i t i o n s
101C-----------------------------------------------
102 IF(alefvm_param%IEnabled==0)RETURN
103 mt = ixs(1,nft+lft)
104 ialefvm_flg = ipm(251,mt)
105 IF(ialefvm_flg <= 1)RETURN
106
107 IF(jale == 0)RETURN
108C-----------------------------------------------
109C S o u r c e L i n e s
110C-----------------------------------------------
111
112 !-------------------------------------------------------------!
113 ! NORMAL VECTOR FOR ALE !
114 !-------------------------------------------------------------!
115 IF(jale==1)THEN
116 DO i=lft,llt
117 ii = i + nft
118 !---8 local node numbers NC1 TO NC8 for solid element I ---!
119 nc1(i)=ixs(2,ii)
120 nc2(i)=ixs(3,ii)
121 nc3(i)=ixs(4,ii)
122 nc4(i)=ixs(5,ii)
123 nc5(i)=ixs(6,ii)
124 nc6(i)=ixs(7,ii)
125 nc7(i)=ixs(8,ii)
126 nc8(i)=ixs(9,ii)
127 !
128 !---Coordinates of the 8 nodes
129 x1(i)=x(1,nc1(i))
130 y1(i)=x(2,nc1(i))
131 z1(i)=x(3,nc1(i))
132 !
133 x2(i)=x(1,nc2(i))
134 y2(i)=x(2,nc2(i))
135 z2(i)=x(3,nc2(i))
136 !
137 x3(i)=x(1,nc3(i))
138 y3(i)=x(2,nc3(i))
139 z3(i)=x(3,nc3(i))
140 !
141 x4(i)=x(1,nc4(i))
142 y4(i)=x(2,nc4(i))
143 z4(i)=x(3,nc4(i))
144 !
145 x5(i)=x(1,nc5(i))
146 y5(i)=x(2,nc5(i))
147 z5(i)=x(3,nc5(i))
148 !
149 x6(i)=x(1,nc6(i))
150 y6(i)=x(2,nc6(i))
151 z6(i)=x(3,nc6(i))
152 !
153 x7(i)=x(1,nc7(i))
154 y7(i)=x(2,nc7(i))
155 z7(i)=x(3,nc7(i))
156 !
157 x8(i)=x(1,nc8(i))
158 y8(i)=x(2,nc8(i))
159 z8(i)=x(3,nc8(i))
160 ENDDO
161 DO i=lft,llt
162 ! Face-1
163 n1x(i)=(y3(i)-y1(i))*(z2(i)-z4(i)) - (z3(i)-z1(i))*(y2(i)-y4(i))
164 n1y(i)=(z3(i)-z1(i))*(x2(i)-x4(i)) - (x3(i)-x1(i))*(z2(i)-z4(i))
165 n1z(i)=(x3(i)-x1(i))*(y2(i)-y4(i)) - (y3(i)-y1(i))*(x2(i)-x4(i))
166 ! Face-2
167 n2x(i)=(y7(i)-y4(i))*(z3(i)-z8(i)) - (z7(i)-z4(i))*(y3(i)-y8(i))
168 n2y(i)=(z7(i)-z4(i))*(x3(i)-x8(i)) - (x7(i)-x4(i))*(z3(i)-z8(i))
169 n2z(i)=(x7(i)-x4(i))*(y3(i)-y8(i)) - (y7(i)-y4(i))*(x3(i)-x8(i))
170 ! Face-3
171 n3x(i)=(y6(i)-y8(i))*(z7(i)-z5(i)) - (z6(i)-z8(i))*(y7(i)-y5(i))
172 n3y(i)=(z6(i)-z8(i))*(x7(i)-x5(i)) - (x6(i)-x8(i))*(z7(i)-z5(i))
173 n3z(i)=(x6(i)-x8(i))*(y7(i)-y5(i)) - (y6(i)-y8(i))*(x7(i)-x5(i))
174 ! Face-4
175 n4x(i)=(y2(i)-y5(i))*(z6(i)-z1(i)) - (z2(i)-z5(i))*(y6(i)-y1(i))
176 n4y(i)=(z2(i)-z5(i))*(x6(i)-x1(i)) - (x2(i)-x5(i))*(z6(i)-z1(i))
177 n4z(i)=(x2(i)-x5(i))*(y6(i)-y1(i)) - (y2(i)-y5(i))*(x6(i)-x1(i))
178 ! Face-5
179 n5x(i)=(y7(i)-y2(i))*(z6(i)-z3(i)) - (z7(i)-z2(i))*(y6(i)-y3(i))
180 n5y(i)=(z7(i)-z2(i))*(x6(i)-x3(i)) - (x7(i)-x2(i))*(z6(i)-z3(i))
181 n5z(i)=(x7(i)-x2(i))*(y6(i)-y3(i)) - (y7(i)-y2(i))*(x6(i)-x3(i))
182 ! Face-6
183 n6x(i)=(y8(i)-y1(i))*(z4(i)-z5(i)) - (z8(i)-z1(i))*(y4(i)-y5(i))
184 n6y(i)=(z8(i)-z1(i))*(x4(i)-x5(i)) - (x8(i)-x1(i))*(z4(i)-z5(i))
185 n6z(i)=(x8(i)-x1(i))*(y4(i)-y5(i)) - (y8(i)-y1(i))*(x4(i)-x5(i))
186 ENDDO
187
188 DO i=lft,llt
189 wface(1,1,i) = fourth*(w(1,nc1(i))+w(1,nc2(i))+w(1,nc3(i))+w(1,nc4(i)))
190 wface(2,1,i) = fourth*(w(2,nc1(i))+w(2,nc2(i))+w(2,nc3(i))+w(2,nc4(i)))
191 wface(3,1,i) = fourth*(w(3,nc1(i))+w(3,nc2(i))+w(3,nc3(i))+w(3,nc4(i)))
192
193 wface(1,2,i) = fourth*(w(1,nc3(i))+w(1,nc4(i))+w(1,nc7(i))+w(1,nc8(i)))
194 wface(2,2,i) = fourth*(w(2,nc3(i))+w(2,nc4(i))+w(2,nc7(i))+w(2,nc8(i)))
195 wface(3,2,i) = fourth*(w(3,nc3(i))+w(3,nc4(i))+w(3,nc7(i))+w(3,nc8(i)))
196
197 wface(1,3,i) = fourth*(w(1,nc5(i))+w(1,nc6(i))+w(1,nc7(i))+w(1,nc8(i)))
198 wface(2,3,i) = fourth*(w(2,nc5(i))+w(2,nc6(i))+w(2,nc7(i))+w(2,nc8(i)))
199 wface(3,3,i) = fourth*(w(3,nc5(i))+w(3,nc6(i))+w(3,nc7(i))+w(3,nc8(i)))
200
201 wface(1,4,i) = fourth*(w(1,nc1(i))+w(1,nc2(i))+w(1,nc5(i))+w(1,nc6(i)))
202 wface(2,4,i) = fourth*(w(2,nc1(i))+w(2,nc2(i))+w(2,nc5(i))+w(2,nc6(i)))
203 wface(3,4,i) = fourth*(w(3,nc1(i))+w(3,nc2(i))+w(3,nc5(i))+w(3,nc6(i)))
204
205 wface(1,5,i) = fourth*(w(1,nc2(i))+w(1,nc3(i))+w(1,nc6(i))+w(1,nc7(i)))
206 wface(2,5,i) = fourth*(w(2,nc2(i))+w(2,nc3(i))+w(2,nc6(i))+w(2,nc7(i)))
207 wface(3,5,i) = fourth*(w(3,nc2(i))+w(3,nc3(i))+w(3,nc6(i))+w(3,nc7(i)))
208
209 wface(1,6,i) = fourth*(w(1,nc1(i))+w(1,nc4(i))+w(1,nc5(i))+w(1,nc8(i)))
210 wface(2,6,i) = fourth*(w(2,nc1(i))+w(2,nc4(i))+w(2,nc5(i))+w(2,nc8(i)))
211 wface(3,6,i) = fourth*(w(3,nc1(i))+w(3,nc4(i))+w(3,nc5(i))+w(3,nc8(i)))
212 ENDDO
213
214 !-------------------------------------------------------------!
215 ! NORMAL VECTOR FOR EULER !
216 !-------------------------------------------------------------!
217 !ELSE
218 ! DO I=LFT,LLT
219 ! II = I+NFT
220 ! N1X(I)=VEUL(14,II)
221 ! N2X(I)=VEUL(15,II)
222 ! N3X(I)=VEUL(16,II)
223 ! N4X(I)=VEUL(17,II)
224 ! N5X(I)=VEUL(18,II)
225 ! N6X(I)=VEUL(19,II)
226 ! N1Y(I)=VEUL(20,II)
227 ! N2Y(I)=VEUL(21,II)
228 ! N3Y(I)=VEUL(22,II)
229 ! N4Y(I)=VEUL(23,II)
230 ! N5Y(I)=VEUL(24,II)
231 ! N6Y(I)=VEUL(25,II)
232 ! N1Z(I)=VEUL(26,II)
233 ! N2Z(I)=VEUL(27,II)
234 ! N3Z(I)=VEUL(28,II)
235 ! N4Z(I)=VEUL(29,II)
236 ! N5Z(I)=VEUL(30,II)
237 ! N6Z(I)=VEUL(31,II)
238 ! ENDDO
239 ! DO I=LFT,LLT
240 ! Wface(1:3,1:6,I) = ZERO
241 ! ENDDO
242
243 ENDIF
244
245 !-------------------------------------------------------------!
246 ! EXTERNAL FORCE WORK !
247 !-------------------------------------------------------------!
248 alefvm_buffer%WFEXT_CELL(lft+nft:llt+nft) = zero
249 wfextt = zero
250 DO i=lft,llt
251 ii = i + nft
252 iad2 = ale_connect%ee_connect%iad_connect(ii)
253 ! < W, 2S.n> = 2S.wn
254 swn(1) = wface(1,1,i)*n1x(i) + wface(2,1,i)*n1y(i) + wface(3,1,i)*n1z(i)
255 swn(2) = wface(1,2,i)*n2x(i) + wface(2,2,i)*n2y(i) + wface(3,2,i)*n2z(i)
256 swn(3) = wface(1,3,i)*n3x(i) + wface(2,3,i)*n3y(i) + wface(3,3,i)*n3z(i)
257 swn(4) = wface(1,4,i)*n4x(i) + wface(2,4,i)*n4y(i) + wface(3,4,i)*n4z(i)
258 swn(5) = wface(1,5,i)*n5x(i) + wface(2,5,i)*n5y(i) + wface(3,5,i)*n5z(i)
259 swn(6) = wface(1,6,i)*n6x(i) + wface(2,6,i)*n6y(i) + wface(3,6,i)*n6z(i)
260 wfext_add = zero
261 Do j=1,nv46
262 iv = ale_connect%ee_connect%connected(iad2 + j - 1)
263 !IF(IV /= 0)CYCLE !domain border only
264 ix(1) = ixs(icf(1,j)+1,ii)
265 ix(2) = ixs(icf(2,j)+1,ii)
266 ix(3) = ixs(icf(3,j)+1,ii)
267 ix(4) = ixs(icf(4,j)+1,ii)
268 IF(sum(iabs(nale(ix(1:4))))==4)cycle !4 lagrangian nodes only
269 !dt * P*S*wn
270 wfext_add = wfext_add - dt1*third*(sig(i,1)+sig(i,2)+sig(i,3))*swn(j)*half !Swn=2S.w.n
271 ENDDO
272 alefvm_buffer%WFEXT_CELL(ii) = wfext_add
273 wfextt = wfextt + wfext_add
274 ENDDO
275
276#include "lockon.inc"
277 wfext = wfext + wfextt
278#include "lockoff.inc"
279
280
281 !DEBUG-OUTPUT---------------!
282 if(alefvm_param%IOUTP_WFEXT == 1)then
283 IF(wfextt /= zero)THEN
284!#!include "lockon.inc"
285 print *, " |----alefvm_tfext.F------|"
286 print *, " | THREAD INFORMATION |"
287 print *, " |------------------------|"
288 print *, " NCYCLE =", ncycle
289 do i=lft,llt
290 ii = nft + i
291 if(alefvm_buffer%WFEXT_CELL(ii)==zero)cycle
292 write(*,fmt='(A,I10,A,F30.16,A,F30.16,A,6F30.16)') " brique=", ixs(11,ii)," Wfext=",
293 . alefvm_buffer%WFEXT_CELL(ii), "P(I)=", p(i), "SWn(1:6)=",swn(1:6)
294 enddo
295 ENDIF
296!#!include "lockoff.inc"
297 endif
298 !-----------------------------------------!
299
300 RETURN
my_real
#define my_real
Definition cppsort.cpp:32
ale_connectivity_mod
Definition ale_connectivity_mod.F:223
alefvm_mod
Definition alefvm_mod.F:88
alefvm_mod::alefvm_buffer
type(alefvm_buffer_), target alefvm_buffer
Definition alefvm_mod.F:120
alefvm_mod::alefvm_param
type(alefvm_param_), target alefvm_param
Definition alefvm_mod.F:121