OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
rgwath.F File Reference
#include "implicit_f.inc"
#include "com01_c.inc"
#include "com04_c.inc"
#include "com08_c.inc"
#include "param_c.inc"
#include "task_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine rgwath (x, v, w, rwl, nsw, nsn, msr, ms, fsav, ixs, ixq, elbuf_tab, iparg, pm, ntag, nelw, ne, temp, tstif, e, a, itied, weight, iad_elem, fr_elem, fr_wall)

Function/Subroutine Documentation

◆ rgwath()

subroutine rgwath ( x,
v,
w,
rwl,
integer, dimension(*) nsw,
integer nsn,
integer msr,
ms,
fsav,
integer, dimension(nixs,*) ixs,
integer, dimension(nixq,*) ixq,
type(elbuf_struct_), dimension(ngroup) elbuf_tab,
integer, dimension(nparg,*) iparg,
pm,
integer, dimension(*) ntag,
integer, dimension(*) nelw,
integer ne,
temp,
tstif,
e,
a,
integer itied,
integer, dimension(*) weight,
integer, dimension(*) iad_elem,
integer, dimension(*) fr_elem,
integer, dimension(*) fr_wall )

Definition at line 36 of file rgwath.F.

43C-----------------------------------------------
44C M o d u l e s
45C-----------------------------------------------
46 USE elbufdef_mod
47 use element_mod , only : nixs,nixq
48C-----------------------------------------------
49C I m p l i c i t T y p e s
50C-----------------------------------------------
51#include "implicit_f.inc"
52C-----------------------------------------------
53C C o m m o n B l o c k s
54C-----------------------------------------------
55#include "com01_c.inc"
56#include "com04_c.inc"
57#include "com08_c.inc"
58#include "param_c.inc"
59#include "task_c.inc"
60C-----------------------------------------------
61C D u m m y A r g u m e n t s
62C-----------------------------------------------
63 INTEGER NSN, ITIED, MSR, NE
64 INTEGER IPARG(NPARG,*), NSW(*) ,IXS(NIXS,*),IXQ(NIXQ,*),
65 . NTAG(*), NELW(*), WEIGHT(*),
66 . IAD_ELEM(*), FR_ELEM(*), FR_WALL(*)
67 my_real
68 . pm(npropm,*), x(*), rwl(*), ms(*), fsav(*), v(*), w(*),
69 . e(*), a(*),
70 . temp,tstif,fheat
71 TYPE(ELBUF_STRUCT_), DIMENSION(NGROUP) :: ELBUF_TAB
72C-----------------------------------------------
73C L o c a l V a r i a b l e s
74C-----------------------------------------------
75 INTEGER M3, M2, M1, I, N, N3, N2, N1, K, PMAIN
76 my_real
77 . xwl, ywl, zwl, vxw, vyw, vzw, fxn, fyn, fzn, fxt, fyt, fzt,
78 . vx, vy, vz, ux, uy, uz, xc, yc, zc, dp, dv, dvt,
79 . fnxn,fnyn, fnzn, fnxt, fnyt, fnzt, fndfn, ftdft, fric, fric2,
80 . fcoe,
81 . f1(nsn), f2(nsn), f3(nsn), f4(nsn), f5(nsn), f6(nsn)
82 DOUBLE PRECISION
83 . FRWL6(6,6)
84C
85 m1 = 0
86 m2 = 0
87 m3 = 0
88 i = 0
89 n = 0
90 n1 = 0
91 n2 = 0
92 n3 = 0
93 IF(msr==0)THEN
94 xwl=rwl(4)
95 ywl=rwl(5)
96 zwl=rwl(6)
97 vxw=zero
98 vyw=zero
99 vzw=zero
100 ELSE
101 m3=3*msr
102 m2=m3-1
103 m1=m2-1
104 vxw=v(m1)
105 vyw=v(m2)
106 vzw=v(m3)
107 xwl=x(m1)+vxw*dt2
108 ywl=x(m2)+vyw*dt2
109 zwl=x(m3)+vzw*dt2
110 ENDIF
111C-----------------------
112C material and grid velocity
113C-----------------------
114C
115 DO 10 n=1,numnod
116 ntag(n) = 0
117 e(n) = zero
118 10 CONTINUE
119C
120c FXN = ZERO
121c FYN = ZERO
122c FZN = ZERO
123c FXT = ZERO
124c FYT = ZERO
125c FZT = ZERO
126C
127 DO 20 i=1,nsn
128 n=iabs(nsw(i))
129 n3=3*n
130 n2=n3-1
131 n1=n2-1
132 vx=v(n1)
133 vy=v(n2)
134 vz=v(n3)
135 ux=x(n1)+vx*dt2
136 uy=x(n2)+vy*dt2
137 uz=x(n3)+vz*dt2
138 xc=ux-xwl
139 yc=uy-ywl
140 zc=uz-zwl
141 dp=xc*rwl(1)+yc*rwl(2)+zc*rwl(3)
142 nsw(i) = n
143 IF(dp>zero)GOTO 20
144 ntag(n) = 1
145 dv=(v(n1)-vxw)*rwl(1)+(v(n2)-vyw)*rwl(2)+(v(n3)-vzw)*rwl(3)
146 dvt=dv
147 fnxn=dvt*rwl(1)*ms(n)
148 fnyn=dvt*rwl(2)*ms(n)
149 fnzn=dvt*rwl(3)*ms(n)
150 f1(i) = fnxn*weight(n)
151 f2(i) = fnyn*weight(n)
152 f3(i) = fnzn*weight(n)
153c FXN=FXN+FNXN*WEIGHT(N)
154c FYN=FYN+FNYN*WEIGHT(N)
155c FZN=FZN+FNZN*WEIGHT(N)
156 IF(itied/=0)THEN
157 fnxt=((v(n1)-vxw))*ms(n)-fnxn
158 fnyt=((v(n2)-vyw))*ms(n)-fnyn
159 fnzt=((v(n3)-vzw))*ms(n)-fnzn
160 fndfn=fnxn**2+fnyn**2+fnzn**2
161 ftdft=fnxt**2+fnyt**2+fnzt**2
162 fheat=rwl(12)
163 fric =rwl(13)
164 fric2=fric**2
165 IF(ftdft<=fric2*fndfn.OR.itied==1) THEN
166C SECONDARY NODE TIED
167 v(n1)=vxw
168 v(n2)=vyw
169 v(n3)=vzw
170 ELSE
171C SECONDARY NODE SLIDING
172 fcoe=fric*sqrt(fndfn/ftdft)
173 fnxt=fcoe*fnxt
174 fnyt=fcoe*fnyt
175 fnzt=fcoe*fnzt
176 v(n1)=v(n1)-dv*rwl(1)-fnxt/ms(n)
177 v(n2)=v(n2)-dv*rwl(2)-fnyt/ms(n)
178 v(n3)=v(n3)-dv*rwl(3)-fnzt/ms(n)
179 e(n) = fheat *
180 . ((v(n1)-vxw)*fnxt+(v(n2)-vyw)*fnyt+(v(n3)-vzw)*fnzt)
181 ENDIF
182 f4(i) = fnxt*weight(n)
183 f5(i) = fnyt*weight(n)
184 f6(i) = fnzt*weight(n)
185c FXT=FXT+FNXT*WEIGHT(N)
186c FYT=FYT+FNYT*WEIGHT(N)
187c FZT=FZT+FNZT*WEIGHT(N)
188 ELSE
189c FXT=ZERO
190c FYT=ZERO
191c FZT=ZERO
192 f4(i) = zero
193 f5(i) = zero
194 f6(i) = zero
195 v(n1)=v(n1)-dv*rwl(1)
196 v(n2)=v(n2)-dv*rwl(2)
197 v(n3)=v(n3)-dv*rwl(3)
198 ENDIF
199 dv=(w(n1)-vxw)*rwl(1)+(w(n2)-vyw)*rwl(2)+(w(n3)-vzw)*rwl(3)
200 w(n1)=w(n1)-dv*rwl(1)
201 w(n2)=w(n2)-dv*rwl(2)
202 w(n3)=w(n3)-dv*rwl(3)
203 20 CONTINUE
204C
205C Parith/ON processing
206C
207 IF (msr/=0) THEN
208 DO k = 1, 6
209 frwl6(1,k) = zero
210 frwl6(2,k) = zero
211 frwl6(3,k) = zero
212 frwl6(4,k) = zero
213 frwl6(5,k) = zero
214 frwl6(6,k) = zero
215 END DO
216 CALL sum_6_float(1, nsn, f1, frwl6(1,1), 6)
217 CALL sum_6_float(1, nsn, f2, frwl6(2,1), 6)
218 CALL sum_6_float(1, nsn, f3, frwl6(3,1), 6)
219 CALL sum_6_float(1, nsn, f4, frwl6(4,1), 6)
220 CALL sum_6_float(1, nsn, f5, frwl6(5,1), 6)
221 CALL sum_6_float(1, nsn, f6, frwl6(6,1), 6)
222
223 IF(nspmd > 1) THEN
224C if processor is concerned by rgwall
225 IF(fr_wall(ispmd+1)/=0) THEN
226 CALL spmd_exch_fr6(fr_wall,frwl6,6*6)
227 ENDIF
228 pmain = fr_wall(nspmd+2)
229 ELSE
230 pmain = 1
231 ENDIF
232
233 fxn = frwl6(1,1)+frwl6(1,2)+frwl6(1,3)+
234 . frwl6(1,4)+frwl6(1,5)+frwl6(1,6)
235 fyn = frwl6(2,1)+frwl6(2,2)+frwl6(2,3)+
236 . frwl6(2,4)+frwl6(2,5)+frwl6(2,6)
237 fzn = frwl6(3,1)+frwl6(3,2)+frwl6(3,3)+
238 . frwl6(3,4)+frwl6(3,5)+frwl6(3,6)
239 fxt = frwl6(4,1)+frwl6(4,2)+frwl6(4,3)+
240 . frwl6(4,4)+frwl6(4,5)+frwl6(4,6)
241 fyt = frwl6(5,1)+frwl6(5,2)+frwl6(5,3)+
242 . frwl6(5,4)+frwl6(5,5)+frwl6(5,6)
243 fzt = frwl6(6,1)+frwl6(6,2)+frwl6(6,3)+
244 . frwl6(6,4)+frwl6(6,5)+frwl6(6,6)
245 IF(ms(msr)/=zero)THEN
246 a(m1)=(fxt+fxn) / dt12
247 a(m2)=(fyt+fyn) / dt12
248 a(m3)=(fzt+fzn) / dt12
249 ENDIF
250
251 IF(ispmd+1==pmain)THEN
252
253 fsav(1)=fsav(1)+fxn
254 fsav(2)=fsav(2)+fyn
255 fsav(3)=fsav(3)+fzn
256 fsav(4)=fsav(4)+fxt
257 fsav(5)=fsav(5)+fyt
258 fsav(6)=fsav(6)+fzt
259 ENDIF
260 ENDIF ! fin si MSR /= 0
261
262C----------------------
263C PONT THERMIQUE
264C----------------------
265 IF(n2d==0)THEN
266 CALL rgwat3(
267 1 x ,nelw ,ne ,ixs ,
268 4 elbuf_tab,iparg,pm ,ntag ,temp ,
269 5 tstif ,e ,iad_elem,fr_elem )
270 ELSE
271 CALL rgwat2(
272 1 x ,nelw ,ne ,ixq ,
273 4 elbuf_tab,iparg,pm ,ntag ,temp ,
274 5 tstif ,e ,iad_elem,fr_elem )
275 ENDIF
276C-----------
277 RETURN
my_real
#define my_real
Definition cppsort.cpp:32
sum_6_float
subroutine sum_6_float(jft, jlt, f, f6, n)
Definition parit.F:65
rgwat2
subroutine rgwat2(x, nelw, ne, ixq, elbuf_tab, iparg, pm, ntag, temp, tstif, e, iad_elem, fr_elem)
Definition rgwat2.F:39
rgwat3
subroutine rgwat3(x, nelw, ne, ixs, elbuf_tab, iparg, pm, ntag, temp, tstif, e, iad_elem, fr_elem)
Definition rgwat3.F:39
spmd_exch_fr6
subroutine spmd_exch_fr6(fr, fs6, len)
Definition spmd_exch_fr6.F:52