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

Go to the source code of this file.

Functions/Subroutines

subroutine i9wal2 (x, v, w, a, crst, nsv, iloc, irtl, icode, iskew, skew, msr, lmsr, nseg, irects, irect, upw, ixq, elbuf_tab, iparg, pm, nale, ee, ieles, ielem, tstif, intth, ieult, stens, isizes, isizem, nrts, nrtm, nsn, nmn)

Function/Subroutine Documentation

◆ i9wal2()

subroutine i9wal2 ( x,
v,
w,
a,
crst,
integer, dimension(nsn) nsv,
integer, dimension(*) iloc,
integer, dimension(nsn) irtl,
integer, dimension(*) icode,
integer, dimension(*) iskew,
skew,
integer, dimension(*) msr,
integer, dimension(*) lmsr,
integer, dimension(*) nseg,
integer, dimension(4,*) irects,
integer, dimension(4,*) irect,
upw,
integer, dimension(nixq,*) ixq,
type (elbuf_struct_), dimension(ngroup), target elbuf_tab,
integer, dimension(nparg,*) iparg,
pm,
integer, dimension(*) nale,
ee,
integer, dimension(*) ieles,
integer, dimension(*) ielem,
tstif,
integer intth,
integer ieult,
stens,
integer isizes,
integer isizem,
integer, intent(in) nrts,
integer, intent(in) nrtm,
integer, intent(in) nsn,
integer, intent(in) nmn )

Definition at line 38 of file i9wal2.F.

45C-----------------------------------------------
46C M o d u l e s
47C-----------------------------------------------
48 USE elbufdef_mod
49 use element_mod , only : nixq
50C-----------------------------------------------
51C I m p l i c i t T y p e s
52C-----------------------------------------------
53#include "implicit_f.inc"
54C-----------------------------------------------
55C C o m m o n B l o c k s
56C-----------------------------------------------
57#include "com01_c.inc"
58#include "com08_c.inc"
59#include "scr08_a_c.inc"
60#include "param_c.inc"
61#include "task_c.inc"
62C-----------------------------------------------
63C D u m m y A r g u m e n t s
64C-----------------------------------------------
65 INTEGER, INTENT(IN) :: NRTS, NRTM,NSN,NMN
66 INTEGER IRECT(4,*), NSV(NSN), ILOC(*), IRTL(NSN), ICODE(*), ISKEW(*),
67 . MSR(*), IRECTS(4,*), LMSR(*), NSEG(*),IXQ(NIXQ,*),
68 . IPARG(NPARG,*), IELES(*), IELEM(*),NALE(*) ,
69 . INTTH, IEULT, ISIZES, ISIZEM
70C REAL
71 my_real
72 . upw, tstif,ttt, stens,
73 . x(3,*), v(3,*), w(3,*), a(3,*), crst(2,*), skew(lskew,*),
74 . pm(npropm,*),ee(*)
75 TYPE (ELBUF_STRUCT_), TARGET, DIMENSION(NGROUP) :: ELBUF_TAB
76C-----------------------------------------------
77C L o c a l V a r i a b l e s
78C-----------------------------------------------
79 INTEGER II, N, L, JJ, NN, LL, LL1, LL2, LG, KK, KKK, K1,
80 . I1, IERR, IGROU, IELN,
81 . IXX(4), IPERM(2), JPERM(2),
82 . ITEMP(2), IS, IM, ILEN,
83 . TAGS(ISIZES),TAGM(ISIZEM), LISTS(ISIZES),LISTM(ISIZEM),
84 . ICOMERR(ISIZEM+ISIZES),ICOMNGR(ISIZEM+ISIZES),
85 . ICOMNEL(ISIZEM+ISIZES)
86C REAL
87 my_real h(2),
88 . vmy, vmz, vy, vz, vv, ny, nz, vt,
89 . nny, nnz, fac, p, ty, tz,
90 . efric, vols, volm, ts, tm ,tstifm, tstifs, dvn,
91 . tstift, phi, areas, aream, vn, wn, stensy, stensz,
92 . comarea(isizem+isizes),comstf(isizem+isizes),
93 . comt(isizem+isizes),comvol(isizem+isizes),combuf(isizem+isizes)
94
95c
96 DATA iperm/ 2, 1/,jperm/ 1, -1/
97C-----------------------------------------------
98C
99C preparation phase for spmd
100C
101 IF(intth/=zero) THEN
102 IF(ispmd==0) THEN
103 DO ii = 1, nrts
104 tags(ii) = 0
105 ENDDO
106 DO ii = 1, nrtm
107 tagm(ii) = 0
108 ENDDO
109 is = 0
110 im = 0
111 DO ii = 1, nsn
112 l = irtl(ii)
113 IF(iloc(ii)>0.AND.nmn>0)THEN
114 IF(tagm(l)==0)THEN
115 im = im + 1
116 listm(im) = l
117 tagm(l) = im
118 END IF
119 ll1=nseg(ii)
120 ll2=nseg(ii+1)-1
121 DO ll=ll1,ll2
122 lg = lmsr(ll)
123 IF(tags(lg)==0) THEN
124 is = is + 1
125 lists(is) = lg
126 tags(lg) = is
127 ENDIF
128 ENDDO
129 ENDIF
130 ENDDO
131C
132C Elem lists compacting
133C
134 itemp(1) = is
135 itemp(2) = im
136 ENDIF
137C
138C Sending second/mains facet list in contact
139C
140 IF(nspmd > 1) THEN
141 CALL spmd_ibcast(itemp,itemp,1,2,0,2)
142 is = itemp(1)
143 im = itemp(2)
144 ilen = im+is
145 CALL spmd_ibcast(listm,listm,1,im,0,2)
146 CALL spmd_ibcast(lists,lists,1,is,0,2)
147 END IF
148 DO ii = 1, im
149 l = listm(ii)
150 ix(1) = msr(irect(1,l))
151 ix(2) = msr(irect(2,l))
152 IF(ielem(l)>0) THEN
153 CALL i9grd2(
154 1 ierr ,comarea(ii),comstf(ii),comt(ii),comvol(ii),
155 2 ielem(l) ,x ,ixq(1,ielem(l)),ix ,
156 3 iparg,pm ,elbuf_tab , igrou ,ieln )
157 icomerr(ii) = ierr
158 icomngr(ii) = igrou
159 icomnel(ii) = ieln
160 ELSE
161 comarea(ii) = zero
162 comstf(ii) = zero
163 comt(ii) = zero
164 comvol(ii) = zero
165 icomerr(ii) = 0
166 icomngr(ii) = 0
167 icomnel(ii) = 0
168 ENDIF
169 combuf(ii) = zero
170 ENDDO
171C
172 DO ii = 1, is
173 l = lists(ii)
174 ixx(1)=nsv(irects(1,l))
175 ixx(2)=nsv(irects(2,l))
176 IF(ieles(l)>0) THEN
177 CALL i9grd2(
178 1 ierr ,comarea(im+ii),comstf(im+ii),comt(im+ii),comvol(im+ii),
179 2 ieles(l) ,x ,ixq(1,ieles(l)) ,ixx ,
180 3 iparg,pm ,elbuf_tab ,igrou ,ieln )
181 icomerr(im+ii) = ierr
182 icomngr(im+ii) = igrou
183 icomnel(im+ii) = ieln
184 ELSE
185 comarea(im+ii) = zero
186 comstf(im+ii) = zero
187 comt(im+ii) = zero
188 comvol(im+ii) = zero
189 icomerr(im+ii) = 0
190 icomngr(im+ii) = 0
191 icomnel(im+ii) = 0
192 ENDIF
193 combuf(im+ii) = zero
194 ENDDO
195C
196 IF (nspmd > 1) THEN
197C
198C gather values
199C
200 CALL spmd_glob_dsum9(comarea,ilen)
201 CALL spmd_glob_dsum9(comstf,ilen)
202 CALL spmd_glob_dsum9(comt,ilen)
203 CALL spmd_glob_dsum9(comvol,ilen)
204 CALL spmd_glob_isum9(icomerr,ilen)
205 CALL spmd_glob_isum9(icomngr,ilen)
206 CALL spmd_glob_isum9(icomnel,ilen)
207C node part on P0 only
208 IF(ispmd/=0) GOTO 900
209 END IF
210C interface processed by p0
211 ELSE
212 IF(ispmd/=0) RETURN
213 ENDIF
214C
215 DO 800 ii=1,nsn
216 ll1=nseg(ii)
217 ll2=nseg(ii+1)-1
218 n=nsv(ii)
219 IF(iloc(ii)>0.AND.nmn>0)THEN
220C---------------------------------
221C CONTACT
222C---------------------------------
223 l=irtl(ii)
224 DO 10 jj=1,2
225 nn=irect(jj,l)
226 10 ix(jj)=msr(nn)
227C
228 h(1) = half*(one - crst(1,ii))
229 h(2) = half*(one + crst(1,ii))
230C---------------------------------
231C mesh velocity
232C---------------------------------
233 vmy=zero
234 vmz=zero
235C
236 DO jj=1,2
237 vmy=vmy+w(2,ix(jj))*h(jj)
238 vmz=vmz+w(3,ix(jj))*h(jj)
239 ENDDO
240C
241 w(2,n)=vmy
242 w(3,n)=vmz
243C---------------------------------
244C PONT THERMIQUE
245C---------------------------------
246 IF(intth/=zero)THEN
247 kk = tagm(l)
248 efric = half * ee(ii) / (ll2-ll1+1)
249 ierr = icomerr(kk)
250 aream = comarea(kk)
251 tstifm = comstf(kk)
252 tm = comt(kk)
253 volm = comvol(kk)
254 IF(ierr==0) THEN
255 DO ll = ll1,ll2
256 lg = lmsr(ll)
257 jj = tags(lg) + im
258 ierr = icomerr(jj)
259 areas = comarea(jj)
260 tstifs = comstf(jj)
261 ts = comt(jj)
262 vols = comvol(jj)
263 IF(ierr==0) THEN
264 tstift = tstifm + tstifs + tstif
265 phi = areas * dt1 * (tm-ts) / tstift
266 combuf(jj) = combuf(jj)
267 + + (efric+phi)/vols
268 combuf(kk) = combuf(kk)
269 + + (efric-phi)/volm
270 ENDIF
271 ENDDO
272 ENDIF
273c ENDIF
274 ENDIF
275C
276 ELSEIF(iloc(ii)<0.OR.nmn==0)THEN
277C---------------------------------------
278C PAS DE CONTACT => SURFACE LIBRE
279C---------------------------------------
280 iloc(ii) = -iloc(ii)
281C
282 vy = v(2,n) - w(2,n)
283 vz = v(3,n) - w(3,n)
284 vv = max(em30,sqrt(vy**2+vz**2))
285 nny = zero
286 nnz = zero
287C------------------------------------------------------
288C loop over facets connected to node ii
289C------------------------------------------------------
290 DO 300 ll=ll1,ll2
291 lg=lmsr(ll)
292 DO 200 kkk=1,2
293 kk=kkk
294 200 IF(irects(kk,lg)==ii) GO TO 250
295 250 CONTINUE
296C------------------------------------------------------
297C calculation of the normal with upwind on the upstream side
298C------------------------------------------------------
299 k1 = iperm(kk)
300 i1 = nsv(irects(k1,lg))
301 ty = x(2,i1) - x(2,n)
302 tz = x(3,i1) - x(3,n)
303 ttt = max(em30,sqrt(ty**2+tz**2))
304C VT = VY*TY + VZ*TZ
305 vt = v(2,n)*ty + v(3,n)*tz
306 p = onep0001 - upw*(half + sign(half,vt))
307 ny = tz
308 nz =-ty
309C FAC = P / MAX(EM30,SQRT(NY**2+NZ**2))
310 fac = p * jperm(kk)
311 nny = nny + ny*fac
312 nnz = nnz + nz*fac
313C-------------------------------------
314C surface tension
315C-------------------------------------
316 stensy = stens * ty / ttt
317 stensz = stens * tz / ttt
318 a(2,n) = a(2,n) + stensy
319 a(3,n) = a(3,n) + stensz
320 300 CONTINUE
321 fac = max(em30,sqrt(nny**2+nnz**2))
322 nny = nny/fac
323 nnz = nnz/fac
324C---------------------------------
325C grid boundary conditions
326C---------------------------------
327 IF(icode(n)/=0)THEN
328C---------------------------------
329C W LAGRANGIEN ACCORDING TO N
330C---------------------------------
331 dvn = vy * nny + vz * nnz
332 w(2,n) = w(2,n) + dvn * nny
333 w(3,n) = w(3,n) + dvn * nnz
334 CALL bcs2(w(1,n),skew(1,iskew(n)),iskew(n),icode(n))
335 vn = v(2,n)*nny + v(3,n)*nnz
336 wn = w(2,n)*nny + w(3,n)*nnz
337C-------------------------------------
338C W LAGRANGIEN ACCORDING TO N + BCS
339C-------------------------------------
340 IF(abs(wn)>em30)THEN
341 fac = vn / wn
342 w(2,n) = w(2,n) * fac
343 w(3,n) = w(3,n) * fac
344 ENDIF
345 ELSEIF(ieult/=0)THEN
346C-------------------------------------
347C W LAGRANGIEN ACCORDING TO N
348C W EULERIEN ACCORDING TO T
349C---------------------------------
350 vn = v(2,n) * nny + v(3,n) * nnz
351 w(2,n) = vn * nny
352 w(3,n) = vn * nnz
353 ELSE
354C-------------------------------------
355C W LAGRANGIEN ACCORDING TO N
356C LIBRE ACCORDING TO T
357C---------------------------------
358 dvn = vy * nny + vz * nnz
359 w(2,n) = w(2,n) + dvn * nny
360 w(3,n) = w(3,n) + dvn * nnz
361 ENDIF
362 ENDIF
363C
364 800 CONTINUE
365C
366C finalization phase for spmd
367C
368 900 CONTINUE
369 IF(intth/=zero) THEN
370 IF(nspmd > 1) THEN
371C
372C Envoi buffer elements updates
373C
374 CALL spmd_rbcast(combuf,combuf,1,ilen,0,2)
375 END IF
376C
377C Local Elbuf update
378C
379 DO ii = 1, im
380 l = listm(ii)
381 IF(ielem(l)>0) THEN
382 igrou = icomngr(ii)
383 ieln = icomnel(ii)
384 elbuf_tab(igrou)%GBUF%EINT(ieln) =
385 . elbuf_tab(igrou)%GBUF%EINT(ieln) + combuf(ii)
386 ENDIF
387 ENDDO
388C
389 DO ii = 1, is
390 l = lists(ii)
391 IF(ieles(l)>0) THEN
392 igrou = icomngr(im+ii)
393 ieln = icomnel(im+ii)
394 elbuf_tab(igrou)%GBUF%EINT(ieln) =
395 . elbuf_tab(igrou)%GBUF%EINT(ieln) + combuf(im+ii)
396 ENDIF
397 ENDDO
398 ENDIF
399C
400 RETURN
bcs2
subroutine bcs2(a, b, j, k)
Definition bcs2.F:32
my_real
#define my_real
Definition cppsort.cpp:32
i9grd2
subroutine i9grd2(ierr, area, tstif, t, vol, ii, x, ixq, ix, iparg, pm, elbuf_tab, igrou, ieln)
Definition i9grd2.F:37
max
#define max(a, b)
Definition macros.h:21
spmd_ibcast
subroutine spmd_ibcast(tabi, tabr, n1, n2, from, add)
Definition spmd_ibcast.F:57
spmd_rbcast
subroutine spmd_rbcast(tabi, tabr, n1, n2, from, add)
Definition spmd_rbcast.F:62
spmd_glob_dsum9
subroutine spmd_glob_dsum9(v, len)
Definition spmd_th.F:379
spmd_glob_isum9
subroutine spmd_glob_isum9(v, len)
Definition spmd_th.F:520