OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
spbuc31.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!|| spbuc31 ../starter/source/elements/sph/spbuc31.F
25!||--- called by ------------------------------------------------------
26!|| sptri ../starter/source/elements/sph/sptri.F
27!||--- calls -----------------------------------------------------
28!|| sptrivox ../starter/source/elements/sph/sptrivox.F
29!||--- uses -----------------------------------------------------
30!|| tri7box ../starter/share/modules1/tri7box.F
31!||====================================================================
32 SUBROUTINE spbuc31(X ,KXSP ,IXSP ,NOD2SP,
33 2 SPBUF ,MA ,JVOIS ,JSTOR ,JPERM ,
34 3 DVOIS ,IREDUCE,KREDUCE,BMINMA,IPARTSP ,
35 . SZ_INTP_DIST,MAX_INTP_DIST_PART,PRE_SEARCH)
36C-----------------------------------------------
37C M o d u l e s
38C-----------------------------------------------
39 USE tri7box
40C-----------------------------------------------
41C I m p l i c i t T y p e s
42C-----------------------------------------------
43#include "implicit_f.inc"
44C-----------------------------------------------
45C C o m m o n B l o c k s
46C-----------------------------------------------
47#include "sphcom.inc"
48C-----------------------------------------------
49C PRE_SEARCH = 0 -> full search of neigbours
50C PRE_SEARCH = 1 -> pre-search of neigbours for computation of max interparticle dist
51C-----------------------------------------------
52C D u m m y A r g u m e n t s
53C-----------------------------------------------
54C REAL
55 INTEGER KXSP(NISP,*), IXSP(KVOISPH,*), NOD2SP(*),
56 . JVOIS(*), JSTOR(*), JPERM(*), IREDUCE, MA(NSPHACT),
57 . KREDUCE(*)
58 INTEGER ,INTENT(IN) :: IPARTSP(NUMSPH),PRE_SEARCH,SZ_INTP_DIST
59C REAL
60 my_real
61 . x(3,*),spbuf(nspbuf,*),dvois(*), bminma(6)
62 my_real ,INTENT(INOUT) :: max_intp_dist_part(sz_intp_dist)
63C-----------------------------------------------
64C L o c a l V a r i a b l e s
65C-----------------------------------------------
66 INTEGER I, NSPHACTF, NSPHACTL
67C REAL
68 my_real
69 . aaa
70 INTEGER NBX,NBY,NBZ
71 INTEGER (KIND=8) :: NBX8,NBY8,NBZ8,RES8,LVOXEL8
72C-----------------------------------------------
73
74 aaa = sqrt(nsphact /
75 . ((bminma(1)-bminma(4))*(bminma(2)-bminma(5))
76 . +(bminma(2)-bminma(5))*(bminma(3)-bminma(6))
77 . +(bminma(3)-bminma(6))*(bminma(1)-bminma(4))))
78
79 aaa = 0.75*aaa
80
81 nbx = nint(aaa*(bminma(1)-bminma(4)))
82 nby = nint(aaa*(bminma(2)-bminma(5)))
83 nbz = nint(aaa*(bminma(3)-bminma(6)))
84 nbx = max(nbx,1)
85 nby = max(nby,1)
86 nbz = max(nbz,1)
87
88 nbx8=nbx
89 nby8=nby
90 nbz8=nbz
91 res8=(nbx8+2)*(nby8+2)*(nbz8+2)
92 lvoxel8 = lvoxel
93
94 IF(res8 > lvoxel8) THEN
95 aaa = lvoxel
96 aaa = aaa/((nbx8+2)*(nby8+2)*(nbz8+2))
97 aaa = aaa**(third)
98 nbx = int((nbx+2)*aaa)-2
99 nby = int((nby+2)*aaa)-2
100 nbz = int((nbz+2)*aaa)-2
101 nbx = max(nbx,1)
102 nby = max(nby,1)
103 nbz = max(nbz,1)
104 ENDIF
105
106 nbx8=nbx
107 nby8=nby
108 nbz8=nbz
109 res8=(nbx8+2)*(nby8+2)*(nbz8+2)
110
111 IF(res8 > lvoxel8) stop 678
112
113C initialisation complete de VOXEL
114C (en // SMP il y a possibilite de redondance de traitement mais no pb)
115 DO i=inivoxel,(nbx+2)*(nby+2)*(nbz+2)
116 voxel1(i)=0
117 ENDDO
118 inivoxel = max(inivoxel,(nbx+2)*(nby+2)*(nbz+2)+1)
119
120c CALL MY_BARRIER fait dans SPTRIVOX
121C--------------------------------------------------
122C VOXEL SORT
123C--------------------------------------------------
124 nsphactf=1
125 nsphactl=nsphact
126 CALL sptrivox(
127 1 nsphact ,x ,bminma ,nod2sp ,
128 2 nbx ,nby ,nbz ,
129 3 ma ,spbuf ,jvois ,jstor ,jperm ,
130 4 dvois ,ireduce,nsphactf,nsphactl,voxel1 ,
131 5 kxsp ,ixsp ,kreduce ,ipartsp ,sz_intp_dist,
132 6 max_intp_dist_part,pre_search)
133C
134 RETURN
135 END
136C
137!||====================================================================
138!|| sppro31 ../starter/source/elements/sph/spbuc31.F
139!||--- called by ------------------------------------------------------
140!|| sptrivox ../starter/source/elements/sph/sptrivox.F
141!||--- calls -----------------------------------------------------
142!||====================================================================
143 SUBROUTINE sppro31(IL ,KXSP ,IXSP ,NOD2SP,JVOIS,
144 . JSTOR,JPERM ,DVOIS,IREDUCE,KREDUCE)
145C-----------------------------------------------
146C I m p l i c i t T y p e s
147C-----------------------------------------------
148#include "implicit_f.inc"
149C-----------------------------------------------
150C G l o b a l P a r a m e t e r s
151C-----------------------------------------------
152#include "mvsiz_p.inc"
153C-----------------------------------------------
154C C o m m o n B l o c k s
155C-----------------------------------------------
156#include "sphcom.inc"
157C-----------------------------------------------
158C D u m m y A r g u m e n t s
159C-----------------------------------------------
160 INTEGER KXSP(NISP,*), IXSP(KVOISPH,*), NOD2SP(*),
161 . JVOIS(*),JSTOR(*), JPERM(*), IREDUCE, KREDUCE(*)
162C REAL
163 my_real
164 . dvois(*)
165C-----------------------------------------------
166C L o c a l V a r i a b l e s
167C-----------------------------------------------
168 INTEGER J, KB, JB, NSBT, IB, IL, MM1, MM2, KM, MM, MG,
169 . JJL, NFT, LLT, JL, JG, JLO, LL1, LL2, LL, LG, N, NN,
170 . NVOIS, KL, K, JK, L, NVOIS1, NVOIS2, IERROR , ig
171C REAL
172 my_real
173 . xjj, yjj, zjj,dk, dl
174
175
176C-----------------
177C TRI DE LA LISTE, GARDE LES KVOISPH PREMIERS
178C (COEF DE SECURITE CROISSANT).
179C-----------------
180 nvois=kxsp(5,il)
181 IF(nvois>kvoisph)THEN
182
183 ireduce =1
184 kreduce(il)=1
185 CALL myqsort(nvois,dvois,jperm,ierror)
186 DO k=1,nvois
187 jstor(k)=jvois(k)
188 ENDDO
189 DO k=1,kvoisph
190 jvois(k)=jstor(jperm(k))
191 ENDDO
192
193 dk=dvois(kvoisph)
194
195C-----------------
196C Choix des cellules a conserver tq distance < DK pour eviter pb de parith/on
197 nvois=0
198 DO k=1,kxsp(5,il)
199 IF(dvois(k)<dk)THEN
200 nvois=nvois+1
201 END IF
202 END DO
203
204 ENDIF
205C-----------------
206 nvois=min(nvois,kvoisph)
207 kxsp(5,il)=nvois
208 nvois1=0
209 nvois2=nvois
210 DO k=1,nvois
211 jk =jvois(k)
212 dk =dvois(k)
213
214 jg =kxsp(3,jk)
215
216 IF(dk<one)THEN
217 nvois1=nvois1+1
218 ixsp(nvois1,il)=jg
219 ELSE
220 ixsp(nvois2,il)=jg
221 nvois2=nvois2-1
222 ENDIF
223 ENDDO
224 kxsp(4,il)=nvois1
225C
226 IF(nvois1>lvoisph)ireduce=1
227C-----------------------------------------------------------
228C
229 RETURN
230 END
231C
my_real
#define my_real
Definition cppsort.cpp:32
min
#define min(a, b)
Definition macros.h:20
max
#define max(a, b)
Definition macros.h:21
myqsort
subroutine myqsort(n, a, perm, error)
Definition myqsort.F:51
tri7box::voxel1
integer, dimension(lvoxel) voxel1
Definition tri7box.F:53
tri7box::inivoxel
integer inivoxel
Definition tri7box.F:53
tri7box::lvoxel
integer lvoxel
Definition tri7box.F:51
sppro31
subroutine sppro31(il, kxsp, ixsp, nod2sp, jvois, jstor, jperm, dvois, ireduce, kreduce)
Definition spbuc31.F:145
spbuc31
subroutine spbuc31(x, kxsp, ixsp, nod2sp, spbuf, ma, jvois, jstor, jperm, dvois, ireduce, kreduce, bminma, ipartsp, sz_intp_dist, max_intp_dist_part, pre_search)
Definition spbuc31.F:36
sptrivox
subroutine sptrivox(nsn, x, bminma, nod2sp, nbx, nby, nbz, nlist, spbuf, jvois, jstor, jperm, dvois, ireduce, nsphactf, nsphactl, voxel, kxsp, ixsp, kreduce, ipartsp, sz_intp_dist, max_intp_dist_part, pre_search)
Definition sptrivox.F:40