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 35 of file rgwath.F.

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