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 32 of file alefvm_tfext.F.

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