OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
sponfro.F
Go to the documentation of this file.
1Copyright> OpenRadioss
2Copyright> Copyright (C) 1986-2025 Altair Engineering Inc.
3Copyright>
4Copyright> This program is free software: you can redistribute it and/or modify
5Copyright> it under the terms of the GNU Affero General Public License as published by
6Copyright> the Free Software Foundation, either version 3 of the License, or
7Copyright> (at your option) any later version.
8Copyright>
9Copyright> This program is distributed in the hope that it will be useful,
10Copyright> but WITHOUT ANY WARRANTY; without even the implied warranty of
11Copyright> MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12Copyright> GNU Affero General Public License for more details.
13Copyright>
14Copyright> You should have received a copy of the GNU Affero General Public License
15Copyright> along with this program. If not, see <https://www.gnu.org/licenses/>.
16Copyright>
17Copyright>
18Copyright> Commercial Alternative: Altair Radioss Software
19Copyright>
20Copyright> As an alternative to this open-source version, Altair also offers Altair Radioss
21Copyright> software under a commercial license. Contact Altair to discuss further if the
22Copyright> commercial version may interest you: https://www.altair.com/radioss/.
23!||====================================================================
24!|| sponfro ../engine/source/elements/sph/sponfro.F
25!||--- called by ------------------------------------------------------
26!|| forintp ../engine/source/elements/forintp.F
27!||--- uses -----------------------------------------------------
28!|| sphbox ../engine/share/modules/sphbox.F
29!||====================================================================
30 SUBROUTINE sponfro(X ,V ,A ,MS ,
31 2 SPBUF ,ITAB ,KXSP ,IXSP ,NOD2SP ,
32 3 ISPHIO ,IPART ,IPARTSP ,WASPACT ,WA_EPSD ,
33 4 VNORMAL, WAR2 )
34C-----------------------------------------------
35C M o d u l e s
36C-----------------------------------------------
37 USE sphbox
38C-----------------------------------------------
39C I m p l i c i t T y p e s
40C-----------------------------------------------
41#include "implicit_f.inc"
42C-----------------------------------------------
43C C o m m o n B l o c k s
44C-----------------------------------------------
45#include "com01_c.inc"
46#include "com08_c.inc"
47#include "sphcom.inc"
48#include "scr17_c.inc"
49C-----------------------------------------------
50C D u m m y A r g u m e n t s
51C-----------------------------------------------
52 INTEGER KXSP(NISP,*),IXSP(KVOISPH,*),NOD2SP(*),ITAB(*),
53 . ISPHIO(NISPHIO,*),IPART(LIPART1,*),IPARTSP(*),WASPACT(*)
54 my_real
55 . x(3,*) ,v(3,*) ,a(3,*) ,ms(*) ,spbuf(nspbuf,*) ,
56 . wa_epsd(kwasph,*),vnormal(3,*),war2(9,*)
57C-----------------------------------------------
58C L o c a l V a r i a b l e s
59C-----------------------------------------------
60 INTEGER NS ,N ,IMPOSE ,INOD ,M ,JNOD ,JMPOSE ,
61 . IPPV ,NP, K, NN, JMPOSE2
62 my_real
63 . xi,yi,zi,xj,yj,zj,dmin,dd,
64 . dxx,dxy,dxz,dyx,dyy,dyz,dzx,dzy,dzz,
65 . divv
66 LOGICAL lBOOL
67C-----------------------------------------------
68C general outlets & silent boundary.
69C-------------------------------------------
70 DO ns=1,nsphact
71 n=waspact(ns)
72 impose=kxsp(2,n)/(ngroup+1)
73 lbool=.false.
74 IF(impose /= 0)THEN
75 IF(isphio(1,impose)==2.OR.isphio(1,impose)==3)lbool=.true.
76 ENDIF
77 IF(lbool)THEN
78 inod=kxsp(3,n)
79 xi=x(1,inod)
80 yi=x(2,inod)
81 zi=x(3,inod)
82C-------
83C plus proche voisin en amont de l'outlet.
84 ippv=0
85 dmin=1.e+20
86
87 DO k=1,kxsp(4,n)
88
89 jnod=ixsp(k,n)
90 IF(jnod>0)THEN ! particule locale
91 m=nod2sp(jnod)
92 jmpose=kxsp(2,m)/(ngroup+1)
93 lbool=.false.
94 IF(jmpose == 0)THEN
95 lbool=.true.
96 ELSE
97 IF(isphio(1,jmpose) == 1)lbool=.true.
98 ENDIF
99 IF(lbool)THEN
100 xj =x(1,jnod)
101 yj =x(2,jnod)
102 zj =x(3,jnod)
103 dd =(xi-xj)*(xi-xj)+(yi-yj)*(yi-yj)+(zi-zj)*(zi-zj)
104 IF(dd<dmin)THEN
105 ippv=jnod
106 dmin=dd
107 ENDIF
108 ENDIF
109 ELSE
110 nn = -jnod
111 jmpose = nint(xsphr(12,nn))
112 IF(jmpose>0)THEN
113 jmpose2=isphio(1,jmpose)
114 ELSE
115 jmpose2=0
116 ENDIF
117 IF(jmpose2==0.OR.jmpose2==1)THEN
118 xj =xsphr(3,nn)
119 yj =xsphr(4,nn)
120 zj =xsphr(5,nn)
121 dd =(xi-xj)*(xi-xj)+(yi-yj)*(yi-yj)+(zi-zj)*(zi-zj)
122 IF(dd<dmin)THEN
123 ippv=jnod
124 dmin=dd
125 ENDIF
126 ENDIF
127 ENDIF
128 ENDDO
129C-------
130C d(rho)/dt=- rho * div(V) utilise div(V) calcule en IPPV.
131 IF(ippv>0)THEN
132 np=nod2sp(ippv)
133 dxx =wa_epsd(1,np)
134 dyy =wa_epsd(2,np)
135 dzz =wa_epsd(3,np)
136 dxy =wa_epsd(4,np)
137 dyz =wa_epsd(5,np)
138 dxz =wa_epsd(6,np)
139 dyx =wa_epsd(7,np)
140 dzy =wa_epsd(8,np)
141 dzx =wa_epsd(9,np)
142 ELSE
143c remote neigbourg, get values from SPMD_SPHGETWA
144 dxx =war2(1,-ippv)
145 dyy =war2(2,-ippv)
146 dzz =war2(3,-ippv)
147 dxy =war2(4,-ippv)
148 dyz =war2(5,-ippv)
149 dxz =war2(6,-ippv)
150 dyx =war2(7,-ippv)
151 dzy =war2(8,-ippv)
152 dzx =war2(9,-ippv)
153 ENDIF
154
155 divv=dxx+dyy+dzz
156 spbuf(2,n)=wa_epsd(10,n)*(one - divv*dt1)
157 wa_epsd(1,n) =dxx
158 wa_epsd(2,n) =dyy
159 wa_epsd(3,n) =dzz
160 wa_epsd(4,n) =dxy
161 wa_epsd(5,n) =dyz
162 wa_epsd(6,n) =dxz
163 wa_epsd(7,n) =dyx
164 wa_epsd(8,n) =dzy
165 wa_epsd(9,n) =dzx
166 wa_epsd(13,n)=divv
167 ENDIF
168 ENDDO
169C-------------------------------------------
170 RETURN
171 END
sponfro
subroutine sponfro(x, v, a, ms, spbuf, itab, kxsp, ixsp, nod2sp, isphio, ipart, ipartsp, waspact, wa_epsd, vnormal, war2)
Definition sponfro.F:34