OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
sptrivox.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!||====================================================================
25!|| sptrivox ../engine/source/elements/sph/sptrivox.F
26!||--- called by ------------------------------------------------------
27!|| spbuc3 ../engine/source/elements/sph/spbuc3.F
28!||--- calls -----------------------------------------------------
29!|| my_barrier ../engine/source/system/machine.F
30!|| spmd_sphgetdk ../engine/source/mpi/elements/spmd_sph.f
31!|| sppro3 ../engine/source/elements/sph/sppro3.F
32!||--- uses -----------------------------------------------------
33!|| sphbox ../engine/share/modules/sphbox.F
34!|| tri7box ../engine/share/modules/tri7box.F
35!||====================================================================
36 SUBROUTINE sptrivox(
37 1 NSN ,NSNR ,X ,BMINMA ,NOD2SP ,
38 2 NBX ,NBY ,NBZ ,MARGE ,ITASK ,
39 3 NLIST ,SPBUF ,JVOIS ,JSTOR ,JPERM ,
40 4 DVOIS ,IREDUCE ,NSP2SORTF,NSP2SORTL,VOXEL ,
41 5 KXSP ,IXSP ,KREDUCE ,LGAUGE ,GAUGE ,
42 6 KXSPR ,IXSPR )
43C============================================================================
44C M o d u l e s
45C-----------------------------------------------
46 USE tri7box
47 USE sphbox
48C-----------------------------------------------
49C I m p l i c i t T y p e s
50C-----------------------------------------------
51#include "implicit_f.inc"
52C-----------------------------------------------
53C G l o b a l P a r a m e t e r s
54C-----------------------------------------------
55#include "mvsiz_p.inc"
56c parameter setting the size for the vector (orig version is 128)
57 INTEGER NVECSZ ,NSP2SORTF, NSP2SORTL
58 PARAMETER (NVECSZ = mvsiz)
59C-----------------------------------------------
60C C o m m o n B l o c k s
61C-----------------------------------------------
62#include "com01_c.inc"
63#include "com04_c.inc"
64#include "param_c.inc"
65#include "task_c.inc"
66#include "sphcom.inc"
67C-----------------------------------------------
68C ROLE DE LA ROUTINE:
69C ===================
70C CLASSE LES NOEUDS DANS DES BOITES
71C RECHERCHE POUR CHAQUE FACETTE DES BOITES CONCERNES
72C RECHERCHE DES CANDIDATS
73C-----------------------------------------------
74C D u m m y A r g u m e n t s
75C
76C NOM DESCRIPTION E/S
77C
78C X(3,*) COORDONNEES NODALES E
79C XMAX plus grande abcisse existante E
80C XMAX plus grande ordonn. existante E
81C XMAX plus grande cote existante E
82C VOXEL(ix,iy,iz) contient le numero local du premier noeud de
83C la boite
84C NEXT_NOD(i) noeud suivant dans la meme boite (si /= 0)
85C LAST_NOD(i) dernier noeud dans la meme boite (si /= 0)
86C utilise uniquement pour aller directement du premier
87C noeud au dernier
88C-----------------------------------------------
89C D u m m y A r g u m e n t s
90C-----------------------------------------------
91 INTEGER NSN,ITASK,NSNR,NBX,NBY,NBZ,
92 . NLIST(*),NOD2SP(*) ,
93 . VOXEL(NBX+2,NBY+2,NBZ+2),JVOIS(*) ,JSTOR(*), JPERM(*) ,
94 . IREDUCE,KXSP(NISP,*), IXSP(KVOISPH,*), KREDUCE(*),
95 . LGAUGE(3,*),KXSPR(*),IXSPR(KVOISPH,*)
96C REAL
97 my_real
98 . x(3,*),bminma(12),
99 . marge ,spbuf(nspbuf,*), dvois(*), gauge(llgauge,*)
100C-----------------------------------------------
101C L o c a l V a r i a b l e s
102C-----------------------------------------------
103 INTEGER NB_NCN,NB_NCN1,NB_ECN,I,J,DIR,NB_NC,NB_EC,
104 . N1,N2,N3,N4,NN,NE,K,L,II,JJ,JS,NS,N,
105 . NSNF, NSNL,NVOIS, IG, IL
106C REAL
107 my_real
108 . DX,DY,DZ,XS,YS,ZS,XX,SX,SY,SZ,S2,XN,YN,ZN,
109 . xmin, xmax,ymin, ymax,zmin, zmax, tz,
110 . d1x,d1y,d1z,d2,a2,alpha_marge,distmax
111 my_real, DIMENSION(:), ALLOCATABLE :: tab_dk
112c provisoire
113 INTEGER LAST_NOD(NSN+NSNR)
114 INTEGER IX,IY,IZ,NEXT,
115 . IX1,IY1,IZ1,IX2,IY2,IZ2
116 INTEGER, DIMENSION(:),ALLOCATABLE :: IIX,IIY,IIZ
117 my_real
118 . xminb,yminb,zminb,xmaxb,ymaxb,zmaxb,
119 . xmine,ymine,zmine,xmaxe,ymaxe,zmaxe,aaa,bbb,
120 . aaa2
121 INTEGER FIRST,NEW,LAST,REQ_RECV(NSPMD)
122 SAVE iix,iiy,iiz,distmax,tab_dk
123 INTEGER, DIMENSION(:), ALLOCATABLE, SAVE :: NEXT_NOD_LOCAL
124 INTEGER, DIMENSION(:,:,:), ALLOCATABLE, SAVE :: VOXEL_LOCAL
125C-----------------------------------------------
126 IF(ITASK == 0)then
127 ALLOCATE(next_nod(nsn+nsnr))
128 ALLOCATE(iix(nsn+nsnr))
129 ALLOCATE(iiy(nsn+nsnr))
130 ALLOCATE(iiz(nsn+nsnr))
131 ALLOCATE(tab_dk(numsph))
132 ALLOCATE(next_nod_local(nsn))
133 ALLOCATE( voxel_local(nbx+2,nby+2,nbz+2) )
134 END IF
135C Barrier to wait init voxel and allocation NEX_NOD
136 CALL my_barrier
137C Phase initiale de construction de BPE et BPN deplacee de I7BUCE => I7TRI
138C
139 alpha_marge = sqrt(one +spasort)
140
141 xmin = bminma(4)
142 ymin = bminma(5)
143 zmin = bminma(6)
144 xmax = bminma(1)
145 ymax = bminma(2)
146 zmax = bminma(3)
147
148 xminb = bminma(10)
149 yminb = bminma(11)
150 zminb = bminma(12)
151 xmaxb = bminma(7)
152 ymaxb = bminma(8)
153 zmaxb = bminma(9)
154
155C=======================================================================
156C 1 mise des noeuds dans les boites
157C=======================================================================
158 IF(itask == 0)THEN
159
160 distmax = zero
161
162 DO i=1,nsn
163 iix(i)=0
164 iiy(i)=0
165 iiz(i)=0
166
167 j=nlist(i)
168 nn = kxsp(3,j)
169
170 distmax = max(distmax,spbuf(1,j))
171C Optimisation // recherche les noeuds compris dans xmin xmax des
172C elements du processeur
173 IF(x(1,nn) < xmin) cycle
174 IF(x(1,nn) > xmax) cycle
175 IF(x(2,nn) < ymin) cycle
176 IF(x(2,nn) > ymax) cycle
177 IF(x(3,nn) < zmin) cycle
178 IF(x(3,nn) > zmax) cycle
179
180 iix(i)=int(nbx*(x(1,nn)-xminb)/(xmaxb-xminb))
181 iiy(i)=int(nby*(x(2,nn)-yminb)/(ymaxb-yminb))
182 iiz(i)=int(nbz*(x(3,nn)-zminb)/(zmaxb-zminb))
183
184 iix(i)=max(1,2+min(nbx,iix(i)))
185 iiy(i)=max(1,2+min(nby,iiy(i)))
186 iiz(i)=max(1,2+min(nbz,iiz(i)))
187
188 first = voxel(iix(i),iiy(i),iiz(i))
189 IF(first == 0)THEN
190c empty cell
191 voxel(iix(i),iiy(i),iiz(i)) = i ! first
192 next_nod(i) = 0 ! last one
193 last_nod(i) = 0 ! no last
194 ELSEIF(last_nod(first) == 0)THEN
195c cell containing one node
196c add as next node
197 next_nod(first) = i ! next
198 last_nod(first) = i ! last
199 next_nod(i) = 0 ! last one
200 ELSE
201c
202c jump to the last node of the cell
203 last = last_nod(first) ! last node in this voxel
204 next_nod(last) = i ! next
205 last_nod(first) = i ! last
206 next_nod(i) = 0 ! last one
207 ENDIF
208 ENDDO
209 voxel_local(1:nbx+2,1:nby+2,1:nbz+2) = voxel(1:nbx+2,1:nby+2,1:nbz+2)
210 next_nod_local(1:nsn) = next_nod(1:nsn)
211C=======================================================================
212C 2 mise des noeuds dans les boites
213C candidats non locaux en SPMD
214C=======================================================================
215 DO j = 1, nsnr
216 i = j+nsn
217 n = nlist(i)-numsph
218 distmax = max(distmax,xsphr(2,n))
219 iix(i)=int(nbx*(xsphr(3,n)-xminb)/(xmaxb-xminb))
220 iiy(i)=int(nby*(xsphr(4,n)-yminb)/(ymaxb-yminb))
221 iiz(i)=int(nbz*(xsphr(5,n)-zminb)/(zmaxb-zminb))
222 iix(i)=max(1,2+min(nbx,iix(i)))
223 iiy(i)=max(1,2+min(nby,iiy(i)))
224 iiz(i)=max(1,2+min(nbz,iiz(i)))
225
226 first = voxel(iix(i),iiy(i),iiz(i))
227 IF(first == 0)THEN
228c empty cell
229 voxel(iix(i),iiy(i),iiz(i)) = i ! first
230 next_nod(i) = 0 ! last one
231 last_nod(i) = 0 ! no last
232 ELSEIF(last_nod(first) == 0)THEN
233c cell containing one node
234c add as next node
235 next_nod(first) = i ! next
236 last_nod(first) = i ! last
237 next_nod(nsn+j) = 0 ! last one
238 ELSE
239c
240c jump to the last node of the cell
241 last = last_nod(first) ! last node in this voxel
242 next_nod(last) = i ! next
243 last_nod(first) = i ! last
244 next_nod(nsn+j) = 0 ! last one
245 ENDIF
246 ENDDO
247 END IF
248C ==============================================================
249C Prepare reception of DK after reduction to remotes
250C ==============================================================
251 CALL my_barrier
252 IF(itask == 0 ) THEN
253 CALL spmd_sphgetdk(tab_dk,1,req_recv)
254 ENDIF
255 CALL my_barrier
256
257C=======================================================================
258C 3 recherche des boites concernant chaque facette
259C et creation des candidats
260C=======================================================================
261 DO ne = nsp2sortf,nsp2sortl
262C on ne retient pas les facettes detruites
263c IF(STF(NE) == ZERO)CYCLE
264
265 j=nlist(ne)
266 nn = kxsp(3,j)
267
268c a revoir !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
269 aaa = two*spbuf(1,j)* alpha_marge
270
271c indice des voxels occupes par la facette
272
273 ix1=int(nbx*(x(1,nn)-aaa-xminb)/(xmaxb-xminb))
274 iy1=int(nby*(x(2,nn)-aaa-yminb)/(ymaxb-yminb))
275 iz1=int(nbz*(x(3,nn)-aaa-zminb)/(zmaxb-zminb))
276
277 ix1=max(1,2+min(nbx,ix1))
278 iy1=max(1,2+min(nby,iy1))
279 iz1=max(1,2+min(nbz,iz1))
280
281 ix2=int(nbx*(x(1,nn)+aaa-xminb)/(xmaxb-xminb))
282 iy2=int(nby*(x(2,nn)+aaa-yminb)/(ymaxb-yminb))
283 iz2=int(nbz*(x(3,nn)+aaa-zminb)/(zmaxb-zminb))
284
285 ix2=max(1,2+min(nbx,ix2))
286 iy2=max(1,2+min(nby,iy2))
287 iz2=max(1,2+min(nbz,iz2))
288
289cc nbpelem = 0
290cc nnpelem = 0
291cc nnr0pelem = 0
292cc nnrpelem = 0
293
294 DO iz = iz1,iz2
295 DO iy = iy1,iy2
296 DO ix = ix1,ix2
297
298cc nbpelem = nbpelem + 1
299
300 jj = voxel(ix,iy,iz)
301
302 DO WHILE(jj /= 0)
303
304cc nnpelem = nnpelem + 1
305
306 js=nlist(jj)
307 IF(jj<=nsn)THEN
308 IF(spbuf(1,js) > spbuf(1,j) .OR.
309 . (spbuf(1,js) == spbuf(1,j) .AND. kxsp(8,js)>=kxsp(8,j)))GOTO 200
310
311 ns=kxsp(3,js)
312 xs = x(1,ns)
313 ys = x(2,ns)
314 zs = x(3,ns)
315
316 aaa = spbuf(1,j)+spbuf(1,js)
317 ELSE
318 n = nlist(jj)-numsph
319 IF(xsphr(2,n) > spbuf(1,j).OR.
320 . (xsphr(2,n) == spbuf(1,j) .AND.(nint(xsphr(6,n))>=kxsp(8,j) ) ) ) GOTO 200
321
322 xs = xsphr(3,n)
323 ys = xsphr(4,n)
324 zs = xsphr(5,n)
325 aaa = spbuf(1,j)+xsphr(2,n)
326 ENDIF
327
328 bbb = aaa * alpha_marge
329
330 IF(xs<=x(1,nn)-bbb)GOTO 200
331 IF(xs>=x(1,nn)+bbb)GOTO 200
332 IF(ys<=x(2,nn)-bbb)GOTO 200
333 IF(ys>=x(2,nn)+bbb)GOTO 200
334 IF(zs<=x(3,nn)-bbb)GOTO 200
335 IF(zs>=x(3,nn)+bbb)GOTO 200
336
337cc nnr0pelem = nnr0pelem + 1
338
339C symetrie parfaite <=> XJ-XI
340 d1x = xs - x(1,nn)
341 d1y = ys - x(2,nn)
342 d1z = zs - x(3,nn)
343 d2 = d1x*d1x+d1y*d1y+d1z*d1z
344 a2 = bbb*bbb
345 IF(d2 > a2)GOTO 200
346
347cc nnrpelem = nnrpelem + 1
348 aaa2 = aaa*aaa
349 nvois=kxsp(5,j)+1
350 jvois(nvois)=js
351 dvois(nvois)=d2/aaa2
352
353 kxsp(5,j) =nvois
354
355 200 CONTINUE
356
357 jj = next_nod(jj)
358
359 ENDDO ! WHILE(JJ /= 0)
360
361 ENDDO
362 ENDDO
363 ENDDO
364
365cc nbpelg = nbpelg + nbpelem
366cc nnpelg = nnpelg + nnpelem
367cc nnrpelg = nnrpelg + nnrpelem
368cc nnr0pelg = nnr0pelg + nnr0pelem
369 CALL sppro3(j ,kxsp ,ixsp ,nod2sp,jvois,
370 . jstor,jperm ,dvois,ireduce,kreduce,
371 . kxspr,ixspr,tab_dk)
372
373 ENDDO
374
375C ==============================================================
376C Communicate DK after reduction to remotes
377C ==============================================================
378 CALL my_barrier
379 IF(itask == 0 ) THEN
380 CALL spmd_sphgetdk(tab_dk,2,req_recv)
381 ENDIF
382 CALL my_barrier
383
384C=======================================================================
385C 3 recherche des boites concernant chaque facette
386C et creation des candidats wrt particules remote (sym trie)
387C=======================================================================
388 DO j = itask+1, nsnr, nthread
389
390 i = j+nsn
391 n = nlist(i)-numsph
392
393 aaa = two * xsphr(2,n) * alpha_marge
394
395c indice des voxels occupes par la facette
396
397 ix1=int(nbx*(xsphr(3,n)-aaa-xminb)/(xmaxb-xminb))
398 iy1=int(nby*(xsphr(4,n)-aaa-yminb)/(ymaxb-yminb))
399 iz1=int(nbz*(xsphr(5,n)-aaa-zminb)/(zmaxb-zminb))
400
401 ix1=max(1,2+min(nbx,ix1))
402 iy1=max(1,2+min(nby,iy1))
403 iz1=max(1,2+min(nbz,iz1))
404
405 ix2=int(nbx*(xsphr(3,n)+aaa-xminb)/(xmaxb-xminb))
406 iy2=int(nby*(xsphr(4,n)+aaa-yminb)/(ymaxb-yminb))
407 iz2=int(nbz*(xsphr(5,n)+aaa-zminb)/(zmaxb-zminb))
408
409 ix2=max(1,2+min(nbx,ix2))
410 iy2=max(1,2+min(nby,iy2))
411 iz2=max(1,2+min(nbz,iz2))
412
413cc nbpelem = 0
414cc nnpelem = 0
415cc nnr0pelem = 0
416cc nnrpelem = 0
417
418 DO iz = iz1,iz2
419 DO iy = iy1,iy2
420 DO ix = ix1,ix2
421
422cc nbpelem = nbpelem + 1
423
424 jj = voxel_local(ix,iy,iz)
425
426 DO WHILE(jj /= 0)
427
428cc nnpelem = nnpelem + 1
429
430 js=nlist(jj)
431 IF(jj<=nsn)THEN
432 IF(xsphr(2,n) < spbuf(1,js).OR.
433 . (xsphr(2,n)==spbuf(1,js).AND.nint(xsphr(6,n))<kxsp(8,js)) )GOTO 250
434
435 ns=kxsp(3,js)
436 xs = x(1,ns)
437 ys = x(2,ns)
438 zs = x(3,ns)
439
440 aaa = xsphr(2,n)+spbuf(1,js)
441
442
443 bbb = aaa * alpha_marge
444
445 IF(xs<=xsphr(3,n)-bbb)GOTO 250
446 IF(xs>=xsphr(3,n)+bbb)GOTO 250
447 IF(ys<=xsphr(4,n)-bbb)GOTO 250
448 IF(ys>=xsphr(4,n)+bbb)GOTO 250
449 IF(zs<=xsphr(5,n)-bbb)GOTO 250
450 IF(zs>=xsphr(5,n)+bbb)GOTO 250
451
452cc nnr0pelem = nnr0pelem + 1
453
454C symetrie parfaite <=> XI-XJ
455 d1x = xsphr(3,n) - xs
456 d1y = xsphr(4,n) - ys
457 d1z = xsphr(5,n) - zs
458 d2 = d1x*d1x+d1y*d1y+d1z*d1z
459 a2 = bbb*bbb
460 IF(d2 > a2)GOTO 250
461
462cc nnrpelem = nnrpelem + 1
463 aaa2 = aaa*aaa
464 nvois=kxspr(j)+1
465 jvois(nvois)=js
466 dvois(nvois)=d2/aaa2
467
468 kxspr(j) =nvois
469
470 250 CONTINUE
471 END IF
472
473 jj = next_nod_local(jj)
474
475 ENDDO ! WHILE(JJ /= 0)
476
477 ENDDO
478 ENDDO
479 ENDDO
480
481cc nbpelg = nbpelg + nbpelem
482cc nnpelg = nnpelg + nnpelem
483cc nnrpelg = nnrpelg + nnrpelem
484cc nnr0pelg = nnr0pelg + nnr0pelem
485 CALL sppro3(j+numsph,kxsp ,ixsp ,nod2sp,jvois,
486 . jstor,jperm ,dvois,ireduce,kreduce,
487 . kxspr,ixspr,tab_dk)
488
489 ENDDO
490C-------------------------------------------------------------------------
491C GAUGES
492C-------------------------------------------------------------------------
493
494!$OMP DO SCHEDULE(DYNAMIC,1)
495 DO ig = 1,nbgauge
496
497 IF(lgauge(1,ig) > -(numels+1))cycle
498
499 j = numsph+ig
500 xn=gauge(2,ig)
501 yn=gauge(3,ig)
502 zn=gauge(4,ig)
503c a revoir !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
504 aaa = (two*distmax)* alpha_marge
505
506c indice des voxels occupes par la facette
507
508 ix1=int(nbx*(xn-aaa-xminb)/(xmaxb-xminb))
509 iy1=int(nby*(yn-aaa-yminb)/(ymaxb-yminb))
510 iz1=int(nbz*(zn-aaa-zminb)/(zmaxb-zminb))
511
512 ix1=max(1,2+min(nbx,ix1))
513 iy1=max(1,2+min(nby,iy1))
514 iz1=max(1,2+min(nbz,iz1))
515
516 ix2=int(nbx*(xn+aaa-xminb)/(xmaxb-xminb))
517 iy2=int(nby*(yn+aaa-yminb)/(ymaxb-yminb))
518 iz2=int(nbz*(zn+aaa-zminb)/(zmaxb-zminb))
519
520 ix2=max(1,2+min(nbx,ix2))
521 iy2=max(1,2+min(nby,iy2))
522 iz2=max(1,2+min(nbz,iz2))
523
524cc nbpelem = 0
525cc nnpelem = 0
526cc nnr0pelem = 0
527cc nnrpelem = 0
528
529 DO iz = iz1,iz2
530 DO iy = iy1,iy2
531 DO ix = ix1,ix2
532
533cc nbpelem = nbpelem + 1
534
535 jj = voxel_local(ix,iy,iz)
536
537 DO WHILE(jj /= 0)
538
539cc nnpelem = nnpelem + 1
540
541 js=nlist(jj)
542 IF(jj<=nsn)THEN
543 ns=kxsp(3,js)
544 xs = x(1,ns)
545 ys = x(2,ns)
546 zs = x(3,ns)
547
548 aaa = two*spbuf(1,js)
549 ELSE
550 GOTO 300
551 ENDIF
552
553 bbb = aaa * alpha_marge
554
555 IF(xs<=xn-bbb)GOTO 300
556 IF(xs>=xn+bbb)GOTO 300
557 IF(ys<=yn-bbb)GOTO 300
558 IF(ys>=yn+bbb)GOTO 300
559 IF(zs<=zn-bbb)GOTO 300
560 IF(zs>=zn+bbb)GOTO 300
561
562cc nnr0pelem = nnr0pelem + 1
563
564 d1x = xs - xn
565 d1y = ys - yn
566 d1z = zs - zn
567 d2 = d1x*d1x+d1y*d1y+d1z*d1z
568 a2 = bbb*bbb
569 IF(d2 > a2)GOTO 300
570
571cc nnrpelem = nnrpelem + 1
572 aaa2 = aaa*aaa
573 nvois=kxsp(5,j)+1
574 jvois(nvois)=js
575 dvois(nvois)=d2/aaa2
576
577 kxsp(5,j) =nvois
578
579 300 CONTINUE
580
581 jj = next_nod_local(jj)
582
583 ENDDO ! WHILE(JJ /= 0)
584
585 ENDDO
586 ENDDO
587 ENDDO
588
589cc nbpelg = nbpelg + nbpelem
590cc nnpelg = nnpelg + nnpelem
591cc nnrpelg = nnrpelg + nnrpelem
592cc nnr0pelg = nnr0pelg + nnr0pelem
593 il=-j
594 CALL sppro3(il ,kxsp ,ixsp ,nod2sp,jvois,
595 . jstor,jperm ,dvois,ireduce,kreduce,
596 . kxspr,ixspr, tab_dk)
597
598 ENDDO
599!$OMP END DO
600
601C-------------------------------------------------------------------------
602C FIN DU TRI
603C-------------------------------------------------------------------------
604C=======================================================================
605C 4 remise a zero des noeuds dans les boites
606C=======================================================================
607 100 CONTINUE
608
609C Barrier to avoid reinitialization before end of sorting
610 CALL my_barrier
611
612 DO i=nsp2sortf,nsp2sortl
613 IF(iix(i)/=0)THEN
614 voxel(iix(i),iiy(i),iiz(i))=0
615 ENDIF
616 ENDDO
617C=======================================================================
618C 5 remise a zero des noeuds dans les boites
619C candidats non locaux en SPMD
620C================================================================
621 nsnf = 1 + itask*nsnr / nthread
622 nsnl = (itask+1)*nsnr / nthread
623 DO j = nsnf, nsnl
624 voxel(iix(nsn+j),iiy(nsn+j),iiz(nsn+j))=0
625 ENDDO
626
627C
628 CALL my_barrier()
629 IF(itask == 0)THEN
630 DEALLOCATE(next_nod)
631 DEALLOCATE(iix)
632 DEALLOCATE(iiy)
633 DEALLOCATE(iiz)
634 DEALLOCATE(tab_dk)
635 DEALLOCATE( next_nod_local )
636 DEALLOCATE( voxel_local )
637 ENDIF
638
639 RETURN
640 END
641
my_real
#define my_real
Definition cppsort.cpp:32
sptrivox
subroutine sptrivox(nsn, nsnr, x, bminma, nod2sp, nbx, nby, nbz, marge, itask, nlist, spbuf, jvois, jstor, jperm, dvois, ireduce, nsp2sortf, nsp2sortl, voxel, kxsp, ixsp, kreduce, lgauge, gauge, kxspr, ixspr)
Definition sptrivox.F:43
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
spmd_sphgetdk
subroutine spmd_sphgetdk(tab_dk, act, req_recv)
Definition spmd_sph.F:205
sppro3
subroutine sppro3(il, kxsp, ixsp, nod2sp, jvois, jstor, jperm, dvois, ireduce, kreduce, kxspr, ixspr, tab_dk)
Definition sppro3.F:35
my_barrier
subroutine my_barrier
Definition machine.F:31