OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
sptrivox.F File Reference
#include "implicit_f.inc"
#include "sphcom.inc"

Go to the source code of this file.

Functions/Subroutines

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)

Function/Subroutine Documentation

◆ sptrivox()

subroutine sptrivox ( integer nsn,
x,
bminma,
integer, dimension(*) nod2sp,
integer nbx,
integer nby,
integer nbz,
integer, dimension(*) nlist,
spbuf,
integer, dimension(*) jvois,
integer, dimension(*) jstor,
integer, dimension(*) jperm,
dvois,
integer ireduce,
integer nsphactf,
integer nsphactl,
integer, dimension(nbx+2,nby+2,nbz+2) voxel,
integer, dimension(nisp,*) kxsp,
integer, dimension(kvoisph,*) ixsp,
integer, dimension(*) kreduce,
integer, dimension(numsph), intent(in) ipartsp,
integer, intent(in) sz_intp_dist,
dimension(sz_intp_dist), intent(inout) max_intp_dist_part,
integer, intent(in) pre_search )

Definition at line 33 of file sptrivox.F.

40C============================================================================
41C M o d u l e s
42C-----------------------------------------------
43 USE tri7box
44C-----------------------------------------------
45C I m p l i c i t T y p e s
46C-----------------------------------------------
47#include "implicit_f.inc"
48C-----------------------------------------------
49C G l o b a l P a r a m e t e r s
50C-----------------------------------------------
51 INTEGER NSPHACTF, NSPHACTL
52C-----------------------------------------------
53C C o m m o n B l o c k s
54C-----------------------------------------------
55#include "sphcom.inc"
56C-----------------------------------------------
57C PRE_SEARCH = 0 -> full search of neigbours
58C PRE_SEARCH = 1 -> pre-search of neigbours for computation of max interparticle dist
59C-----------------------------------------------
60C ROLE DE LA ROUTINE:
61C ===================
62C CLASSE LES NOEUDS DANS DES BOITES
63C RECHERCHE POUR CHAQUE FACETTE DES BOITES CONCERNES
64C RECHERCHE DES CANDIDATS
65C-----------------------------------------------
66C D u m m y A r g u m e n t s
67C
68C NOM DESCRIPTION E/S
69C
70C X(3,*) COORDONNEES NODALES E
71C XMAX plus grande abcisse existante E
72C XMAX plus grande ordonn. existante E
73C XMAX plus grande cote existante E
74C VOXEL(ix,iy,iz) contient le numero local du premier noeud de
75C la boite
76C NEXT_NOD(i) noeud suivant dans la meme boite (si /= 0)
77C LAST_NOD(i) dernier noeud dans la meme boite (si /= 0)
78C utilise uniquement pour aller directement du premier
79C noeud au dernier
80C-----------------------------------------------
81C D u m m y A r g u m e n t s
82C-----------------------------------------------
83 INTEGER NSN,NBX,NBY,NBZ,
84 . NLIST(*),NOD2SP(*) ,
85 . VOXEL(NBX+2,NBY+2,NBZ+2),JVOIS(*) ,JSTOR(*), JPERM(*) ,
86 . IREDUCE,KXSP(NISP,*), IXSP(KVOISPH,*), KREDUCE(*)
87 INTEGER ,INTENT(IN) :: IPARTSP(NUMSPH),PRE_SEARCH,SZ_INTP_DIST
88C REAL
89 my_real
90 . x(3,*),bminma(6),
91 . spbuf(nspbuf,*),dvois(*)
92 my_real ,INTENT(INOUT) :: max_intp_dist_part(sz_intp_dist)
93C-----------------------------------------------
94C L o c a l V a r i a b l e s
95C-----------------------------------------------
96 INTEGER NB_NCN,NB_NCN1,NB_ECN,I,J,DIR,NB_NC,NB_EC,
97 . N1,N2,N3,N4,NN,NE,K,L,II,JJ,JS,NS,N,
98 . NSNF, NSNL,NVOIS, IG, IL,NVOIMAX
99C REAL
100 my_real
101 . dx,dy,dz,xs,ys,zs,xx,sx,sy,sz,s2,xn,yn,zn,
102 . xmin, xmax,ymin, ymax,zmin, zmax, tz,
103 . d1x,d1y,d1z,d2,a2,alpha_marge,distmax
104c provisoire
105 INTEGER LAST_NOD(NSN)
106 INTEGER IX,IY,IZ,NEXT,
107 . IX1,IY1,IZ1,IX2,IY2,IZ2
108 INTEGER, DIMENSION(:),ALLOCATABLE :: IIX,IIY,IIZ
109 my_real
110 . xminb,yminb,zminb,xmaxb,ymaxb,zmaxb,
111 . xmine,ymine,zmine,xmaxe,ymaxe,zmaxe,aaa,bbb,
112 . aaa2,min_dist
113 INTEGER FIRST,NEW,LAST
114 INTEGER IPART_I,IPART_JS
115 SAVE iix,iiy,iiz,distmax
116C-----------------------------------------------
117C IF(ITASK == 0)THEN
118 ALLOCATE(next_nod(nsn))
119 ALLOCATE(iix(nsn))
120 ALLOCATE(iiy(nsn))
121 ALLOCATE(iiz(nsn))
122C END IF
123C Barrier to wait init voxel and allocation NEX_NOD
124C CALL MY_BARRIER
125C Phase initiale de construction de BPE et BPN deplacee de I7BUCE => I7TRI
126C
127 alpha_marge = sqrt(one +spasort)
128
129 xmax = bminma(1)
130 ymax = bminma(2)
131 zmax = bminma(3)
132 xmin = bminma(4)
133 ymin = bminma(5)
134 zmin = bminma(6)
135
136c dev future: xminb plus grand que xmin...
137 xminb = xmin
138 yminb = ymin
139 zminb = zmin
140 xmaxb = xmax
141 ymaxb = ymax
142 zmaxb = zmax
143
144C=======================================================================
145C 1 mise des noeuds dans les boites
146C=======================================================================
147C IF(ITASK == 0)THEN
148
149 distmax = zero
150
151 DO i=1,nsn
152 iix(i)=0
153 iiy(i)=0
154 iiz(i)=0
155
156 j=nlist(i)
157 nn = kxsp(3,j)
158
159 distmax = max(distmax,spbuf(1,j))
160C Optimisation // recherche les noeuds compris dans xmin xmax des
161C elements du processeur
162 IF(x(1,nn) < xmin) cycle
163 IF(x(1,nn) > xmax) cycle
164 IF(x(2,nn) < ymin) cycle
165 IF(x(2,nn) > ymax) cycle
166 IF(x(3,nn) < zmin) cycle
167 IF(x(3,nn) > zmax) cycle
168
169 iix(i)=int(nbx*(x(1,nn)-xminb)/(xmaxb-xminb))
170 iiy(i)=int(nby*(x(2,nn)-yminb)/(ymaxb-yminb))
171 iiz(i)=int(nbz*(x(3,nn)-zminb)/(zmaxb-zminb))
172
173 iix(i)=max(1,2+min(nbx,iix(i)))
174 iiy(i)=max(1,2+min(nby,iiy(i)))
175 iiz(i)=max(1,2+min(nbz,iiz(i)))
176
177 first = voxel(iix(i),iiy(i),iiz(i))
178 IF(first == 0)THEN
179c empty cell
180 voxel(iix(i),iiy(i),iiz(i)) = i ! first
181 next_nod(i) = 0 ! last one
182 last_nod(i) = 0 ! no last
183 ELSEIF(last_nod(first) == 0)THEN
184c cell containing one node
185c add as next node
186 next_nod(first) = i ! next
187 last_nod(first) = i ! last
188 next_nod(i) = 0 ! last one
189 ELSE
190c
191c jump to the last node of the cell
192 last = last_nod(first) ! last node in this voxel
193 next_nod(last) = i ! next
194 last_nod(first) = i ! last
195 next_nod(i) = 0 ! last one
196 ENDIF
197 ENDDO
198C END IF
199C Barrier to wait task0 treatment
200C CALL MY_BARRIER
201C=======================================================================
202C 3 recherche des boites concernant chaque facette
203C et creation des candidats
204C=======================================================================
205 nvoimax = 0
206 DO ne = nsphactf,nsphactl
207C on ne retient pas les facettes detruites
208c IF(STF(NE) == ZERO)CYCLE
209
210 j=nlist(ne)
211 nn = kxsp(3,j)
212c
213 min_dist = ep30
214 ipart_i=ipartsp(j)
215
216c a revoir !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
217 aaa = (spbuf(1,j)+distmax)* alpha_marge
218
219c indice des voxels occupes par la facette
220
221 ix1=int(nbx*(x(1,nn)-aaa-xminb)/(xmaxb-xminb))
222 iy1=int(nby*(x(2,nn)-aaa-yminb)/(ymaxb-yminb))
223 iz1=int(nbz*(x(3,nn)-aaa-zminb)/(zmaxb-zminb))
224
225 ix1=max(1,2+min(nbx,ix1))
226 iy1=max(1,2+min(nby,iy1))
227 iz1=max(1,2+min(nbz,iz1))
228
229 ix2=int(nbx*(x(1,nn)+aaa-xminb)/(xmaxb-xminb))
230 iy2=int(nby*(x(2,nn)+aaa-yminb)/(ymaxb-yminb))
231 iz2=int(nbz*(x(3,nn)+aaa-zminb)/(zmaxb-zminb))
232
233 ix2=max(1,2+min(nbx,ix2))
234 iy2=max(1,2+min(nby,iy2))
235 iz2=max(1,2+min(nbz,iz2))
236
237cc nbpelem = 0
238cc nnpelem = 0
239cc nnr0pelem = 0
240cc nnrpelem = 0
241
242 DO iz = iz1,iz2
243 DO iy = iy1,iy2
244 DO ix = ix1,ix2
245
246cc nbpelem = nbpelem + 1
247
248 jj = voxel(ix,iy,iz)
249
250 DO WHILE(jj /= 0)
251
252cc nnpelem = nnpelem + 1
253
254 js=nlist(jj)
255 ns=kxsp(3,js)
256 ipart_js=ipartsp(js)
257 IF(jj == ne)GOTO 200
258 xs = x(1,ns)
259 ys = x(2,ns)
260 zs = x(3,ns)
261
262 aaa = spbuf(1,j)+spbuf(1,js)
263
264 bbb = aaa * alpha_marge
265
266 IF(xs<=x(1,nn)-bbb)GOTO 200
267 IF(xs>=x(1,nn)+bbb)GOTO 200
268 IF(ys<=x(2,nn)-bbb)GOTO 200
269 IF(ys>=x(2,nn)+bbb)GOTO 200
270 IF(zs<=x(3,nn)-bbb)GOTO 200
271 IF(zs>=x(3,nn)+bbb)GOTO 200
272
273cc nnr0pelem = nnr0pelem + 1
274
275 d1x = xs - x(1,nn)
276 d1y = ys - x(2,nn)
277 d1z = zs - x(3,nn)
278 d2 = d1x*d1x+d1y*d1y+d1z*d1z
279 a2 = bbb*bbb
280 IF(js==j.or.d2 > a2)GOTO 200
281
282cc nnrpelem = nnrpelem + 1
283 aaa2 = aaa*aaa
284 nvois=kxsp(5,j)+1
285 jvois(nvois)=js
286 dvois(nvois)=d2/aaa2
287
288cc Distance to closest neigbhour of the same part
289 IF (ipart_i==ipart_js) min_dist = min(min_dist,sqrt(d2))
290
291 kxsp(5,j) =nvois
292
293 200 CONTINUE
294
295 jj = next_nod(jj)
296
297 ENDDO ! WHILE(JJ /= 0)
298
299 ENDDO
300 ENDDO
301 ENDDO
302
303 IF (pre_search==0) THEN
304cc nbpelg = nbpelg + nbpelem
305cc nnpelg = nnpelg + nnpelem
306cc nnrpelg = nnrpelg + nnrpelem
307cc nnr0pelg = nnr0pelg + nnr0pelem
308 CALL sppro31(j ,kxsp ,ixsp ,nod2sp,jvois,
309 . jstor,jperm ,dvois,ireduce,kreduce)
310 ELSE
311cc Pre-search - computation of max interpaticle distance per part (maximum of dist to closest neigbhour)
312 max_intp_dist_part(ipart_i) = max(max_intp_dist_part(ipart_i),min_dist)
313 nvoimax = max(nvoimax,nvois)
314 ENDIF
315
316 ENDDO
317
318C-------------------------------------------------------------------------
319C FIN DU TRI
320C-------------------------------------------------------------------------
321C=======================================================================
322C 4 remise a zero des noeuds dans les boites
323C=======================================================================
324 100 CONTINUE
325
326C Barrier to avoid reinitialization before end of sorting
327C CALL MY_BARRIER
328
329 DO i=nsphactf,nsphactl
330 IF(iix(i)/=0)THEN
331 voxel(iix(i),iiy(i),iiz(i))=0
332 ENDIF
333 ENDDO
334C=======================================================================
335C
336C CALL MY_BARRIER()
337C IF(ITASK == 0)THEN
338 DEALLOCATE(next_nod)
339 DEALLOCATE(iix)
340 DEALLOCATE(iiy)
341 DEALLOCATE(iiz)
342C ENDIF
343
344 RETURN
my_real
#define my_real
Definition cppsort.cpp:32
ymax
subroutine ymax(idn, fac, npc, pld, stiffmin, stiffmax, stiffini, stiffavg)
Definition law100_upd.F:272
min
#define min(a, b)
Definition macros.h:20
max
#define max(a, b)
Definition macros.h:21
tri7box::next_nod
integer, dimension(:), allocatable next_nod
Definition tri7box.F:48
sppro31
subroutine sppro31(il, kxsp, ixsp, nod2sp, jvois, jstor, jperm, dvois, ireduce, kreduce)
Definition spbuc31.F:145