OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
sphprep.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!|| sphprep ../engine/source/elements/sph/sphprep.F
25!||--- called by ------------------------------------------------------
26!|| resol ../engine/source/engine/resol.F
27!||--- calls -----------------------------------------------------
28!|| my_barrier ../engine/source/system/machine.F
29!|| soltosph_on1 ../engine/source/elements/sph/soltosph_on1.F
30!|| soltosph_on12 ../engine/source/elements/sph/soltosph_on1.F
31!|| soltosph_on2 ../engine/source/elements/sph/soltosph_on2.F
32!|| spadasm ../engine/source/elements/sph/spadasm.F
33!|| spadasm0 ../engine/source/elements/sph/spadasm.F
34!|| spclasv ../engine/source/elements/sph/spclasv.F
35!|| spcompl ../engine/source/elements/sph/spcompl.F
36!|| spechan ../engine/source/elements/sph/spechan.F
37!|| sph_crit_voxel ../engine/source/elements/sph/sph_crit_voxel.F90
38!|| sphtri ../engine/source/elements/sph/sphtri.F
39!|| sphtri0 ../engine/source/elements/sph/sphtri0.F
40!|| spmd_allglob_isum9 ../engine/source/mpi/generic/spmd_allglob_isum9.F
41!|| spmd_barrier ../engine/source/mpi/spmd_mod.F90
42!|| spmd_spamaj ../engine/source/mpi/sph/spmd_spamaj.F
43!|| spmd_sphgat ../engine/source/mpi/sph/spmd_sphgat.F
44!|| spmd_sphgetisph ../engine/source/mpi/elements/spmd_sph.F
45!|| spmd_sphgetv ../engine/source/mpi/sph/spmd_sphgetv.F
46!|| spmd_sphgetx ../engine/source/mpi/elements/spmd_sph.F
47!|| sponof1 ../engine/source/elements/sph/sponof1.F
48!|| sponof2 ../engine/source/elements/sph/sponof2.F
49!|| spsym_alloc ../engine/source/elements/sph/spsym_alloc.F
50!|| spsymp ../engine/source/elements/sph/spsym.F
51!|| startime ../engine/source/system/timer_mod.F90
52!|| stoptime ../engine/source/system/timer_mod.F90
53!||--- uses -----------------------------------------------------
54!|| elbufdef_mod ../common_source/modules/mat_elem/elbufdef_mod.F90
55!|| element_mod ../common_source/modules/elements/element_mod.F90
56!|| groupdef_mod ../common_source/modules/groupdef_mod.F
57!|| message_mod ../engine/share/message_module/message_mod.F
58!|| sph_crit_voxel_mod ../engine/source/elements/sph/sph_crit_voxel.F90
59!|| sph_struct_mod ../engine/share/modules/sph_struct_mod.F
60!|| sph_work_mod ../common_source/modules/mat_elem/sph_work.F90
61!|| spmd_mod ../engine/source/mpi/spmd_mod.F90
62!|| timer_mod ../engine/source/system/timer_mod.F90
63!||====================================================================
64 SUBROUTINE sphprep(TIMERS,
65 1 PM ,GEO ,X ,V ,MS ,
66 2 ELBUF_TAB,WA ,PLD ,BUFMAT ,PARTSAV ,
67 3 IPARG ,NPC ,IPART ,ITAB ,BUFGEO ,
68 4 XFRAME ,KXSP ,IXSP ,NOD2SP ,IPARTSP ,
69 5 SPBUF ,ISPCOND ,ISPSYM ,XSPSYM ,VSPSYM ,
70 6 WASPH ,LPRTSPH ,LONFSPH ,WSP2SORT ,
71 7 ISPHIO ,VSPHIO ,IGRSURF ,D ,
72 8 SPHVELN ,ITASK ,XDP, IBUFSSG_IO ,LGAUGE ,
73 9 GAUGE ,NGROUNC ,IGROUNC ,SOL2SPH ,SPH2SOL ,
74 A IXS ,IADS ,ADDCNE ,FSKYD ,DMSPH ,
75 B WASPACT ,ICONTACT,OFF_SPH_R2R,WSMCOMP,IRUNN_BIS,
76 C SPH_IORD1,SPH_WORK,WFEXT)
77C-----------------------------------------------
78C M o d u l e s
79C-----------------------------------------------
80 USE timer_mod
81 USE sph_work_mod
82 USE elbufdef_mod
83 USE message_mod
84 USE groupdef_mod
85 USE sph_struct_mod
86 USE spmd_mod
87 USE sph_crit_voxel_mod
88 use element_mod , only : nixs
89C-----------------------------------------------
90C I m p l i c i t T y p e s
91C-----------------------------------------------
92#include "implicit_f.inc"
93#include "comlock.inc"
94C-----------------------------------------------
95C C o m m o n B l o c k s
96C-----------------------------------------------
97#include "com01_c.inc"
98#include "com04_c.inc"
99#include "com08_c.inc"
100#include "sphcom.inc"
101#include "param_c.inc"
102#include "task_c.inc"
103#include "units_c.inc"
104#include "tabsiz_c.inc"
105#include "scr17_c.inc"
106#include "timeri_c.inc"
107#include "scr07_c.inc"
108
109 COMMON /sphsort/dmax, dbuc, bminma(12)
110C-----------------------------------------------------------------
111C D u m m y A r g u m e n t s
112C-----------------------------------------------
113 TYPE(timer_), INTENT(INOUT) :: TIMERS
114 INTEGER IPART(LIPART1,*),NPC(*),IPARG(NPARG,*),IPARTSP(*),ITAB(*),
115 . KXSP(NISP,*),IXSP(KVOISPH,*),NOD2SP(*),
116 . ISPCOND(NISPCOND,*),ISPSYM(NSPCOND,*),
117 . LPRTSPH(2,0:NPART),LONFSPH(*),WSP2SORT(*),
118 . ISPHIO(NISPHIO,*),ITASK,
119 . IBUFSSG_IO(SIBUFSSG_IO), LGAUGE(3,*),
120 . NGROUNC, IGROUNC(*), SOL2SPH(2,*), SPH2SOL(*), IXS(NIXS,*),
121 . iads(8,*), addcne(*), waspact(*), icontact(*), off_sph_r2r(*),
122 . irunn_bis
123 INTEGER, INTENT(INOUT) :: SPH_IORD1
124C REAL
125 my_real
126 . x(3,*), v(3,*), ms(*),pm(npropm,*),
127 . geo(npropg,*),bufmat(*), bufgeo(*), pld(*),
128 . wa(*), partsav(*), xframe(nxframe,*) ,
129 . spbuf(nspbuf,*),
130 . wasph(*), vsphio(*), d(3,*), sphveln(*), gauge(llgauge,*),
131 . fskyd(*), dmsph(*)
132 double precision
133 . xdp(3,*)
134 TYPE (ELBUF_STRUCT_), DIMENSION (NGROUP) :: ELBUF_TAB
135 TYPE spsym_struct
136 my_real, DIMENSION(:) , POINTER :: buf
137 END TYPE spsym_struct
138 TYPE (SPSYM_STRUCT) :: XSPSYM,VSPSYM,WSMCOMP
139 TYPE (SURF_) , DIMENSION(NSURF) :: IGRSURF
140 TYPE (SPH_WORK_) :: SPH_WORK
141 DOUBLE PRECISION,INTENT(INOUT) :: WFEXT
142C-----------------------------------------------
143C L o c a l V a r i a b l e s
144C-----------------------------------------------
145 INTEGER I,N,NG,JFT,JLT,K,NELEM,NEL,OFFSET,
146 . isortsp,inod,jnod,j,nvois,m,ireduce,ns,
147 . kvnorm,iprt,nsp2sortf,nsp2sortl,
148 . isortspg,ierror,nbk,voxsiz
149 my_real
150 . dx,dy,dz,
151 . dxmin,dxmax,dymin,dymax,dzmin,dzmax,majord,
152 . dxminl,dxmaxl,dyminl,dymaxl,dzminl,dzmaxl,
153 . dsx,dsy,dsz,maxds,majords,spalinr,myspatrue,
154 . xmax,ymax,zmax, dmax, buftmp(6),dbuc, bminma
155 my_real
156 . xmin,ymin,zmin,diam_max,majord_vox,
157 . xminl,yminl,zminl,xmaxl,ymaxl,zmaxl,diam_maxl,
158 . tmp1(13),tmpo(13)
159C-----------------------------------------------
160 SAVE isortspg,dxmin,dxmax,dymin,dymax,dzmin,dzmax,
161 . xmin,ymin,zmin,xmax,ymax,zmax,diam_max
162C=======================================================================
163 kvnorm=16*numsph+1
164C
165 IF(nsphsol/=0)THEN
166C
167C Wake up particles from solids
168 CALL soltosph_on1(
169 . x ,spbuf ,kxsp ,ixsp ,ipartsp ,
170 . iparg ,ngrounc ,igrounc ,elbuf_tab,itask ,
171 . nod2sp ,sol2sph ,sph2sol ,ixs ,ms ,
172 . pm ,iads ,addcne ,fskyd ,dmsph ,
173 . v ,icontact)
174C /---------------/
175 CALL my_barrier
176C /---------------/
177 END IF
178
179 IF(itask==0)THEN
180 IF(.NOT.ALLOCATED(bool_sph_sort)) THEN
181 ALLOCATE( bool_sph_sort(numsph) )
182 bool_sph_sort(1:numsph) = .false.
183 ENDIF
184
185 IF(nsphio==0)THEN
186 nsp2sort=0
187 DO n=1,numsph
188 IF(kxsp(2,n)/=0)THEN
189 nsp2sort=nsp2sort+1
190 wsp2sort(nsp2sort)=n
191 ENDIF
192 ENDDO
193 ELSE
194C Processing of INLETS.
195 CALL sponof1(x ,v ,d ,ms ,spbuf ,
196 2 itab ,kxsp ,ixsp ,nod2sp ,npc ,
197 3 pld ,iparg ,elbuf_tab,isphio ,vsphio ,
198 4 pm ,ipart ,ipartsp ,igrsurf ,
199 5 lprtsph ,lonfsph ,wa ,wa(numsph+1),wasph(kvnorm),
200 6 xdp,ibufssg_io, off_sph_r2r,wfext)
201 nsp2sort=0
202 DO iprt=1,npart
203 DO k=lprtsph(2,iprt-1)+1,lprtsph(1,iprt)
204 nsp2sort=nsp2sort+1
205 wsp2sort(nsp2sort)=lonfsph(k)
206 ENDDO
207 ENDDO
208 ENDIF
209
210C-----------------------------------------------
211C Communication retri in SPMD (end of the previous cycle) on a stain0
212C-----------------------------------------------
213C
214c globalize ISPHBUC
215 IF(nspmd>1)THEN
216 CALL spmd_allglob_isum9(isphbuc,1)
217 IF(isphbuc>1)isphbuc=1
218 END IF
219
220 IF(tt==zero)isphbuc=1
221C
222 dxmin= ep20
223 dymin= ep20
224 dzmin= ep20
225 dxmax=-ep20
226 dymax=-ep20
227 dzmax=-ep20
228C
229 xmin = ep20
230 ymin = ep20
231 zmin = ep20
232 xmax =-ep20
233 ymax =-ep20
234 zmax =-ep20
235 diam_max = -ep20
236 END IF
237C-----------------------------------------------
238C
239 CALL my_barrier
240C
241 nsp2sortf = 1 + itask*nsp2sort / nthread
242 nsp2sortl = (itask+1)*nsp2sort / nthread
243C
244 isortsp=isphbuc
245C
246 IF(isortsp==0)THEN
247C Exchange of real/symmetrical particles if crossed.
248 CALL spechan(
249 1 x ,v ,ms ,spbuf ,itab ,
250 2 kxsp ,ixsp ,nod2sp ,ispcond ,xframe ,
251 3 isortsp ,iparg ,elbuf_tab,wsp2sort,nsp2sortf,
252 4 nsp2sortl )
253 dxminl= ep20
254 dyminl= ep20
255 dzminl= ep20
256 dxmaxl=-ep20
257 dymaxl=-ep20
258 dzmaxl=-ep20
259C
260 xminl = ep20
261 yminl = ep20
262 zminl = ep20
263 xmaxl =-ep20
264 ymaxl =-ep20
265 zmaxl =-ep20
266 diam_maxl = -ep20
267C
268 DO ns=nsp2sortf,nsp2sortl
269 n=wsp2sort(ns)
270 inod=kxsp(3,n)
271 dx =x(1,inod)-spbuf(5,n)
272 dy =x(2,inod)-spbuf(6,n)
273 dz =x(3,inod)-spbuf(7,n)
274 dxminl=min(dxminl,dx)
275 dyminl=min(dyminl,dy)
276 dzminl=min(dzminl,dz)
277 dxmaxl=max(dxmaxl,dx)
278 dymaxl=max(dymaxl,dy)
279 dzmaxl=max(dzmaxl,dz)
280C
281 xminl=min(xminl,x(1,inod))
282 yminl=min(yminl,x(2,inod))
283 zminl=min(zminl,x(3,inod))
284 xmaxl=max(xmaxl,x(1,inod))
285 ymaxl=max(ymaxl,x(2,inod))
286 zmaxl=max(zmaxl,x(3,inod))
287 diam_maxl = max(diam_maxl, spbuf(1,n))
288 ENDDO
289C
290 DO n=itask+1,nbgauge,nthread
291 IF(lgauge(1,n) <= -(numels+1))THEN
292 dx =gauge(2,n)-gauge(6,n)
293 dy =gauge(3,n)-gauge(7,n)
294 dz =gauge(4,n)-gauge(8,n)
295 dxminl=min(dxminl,dx)
296 dyminl=min(dyminl,dy)
297 dzminl=min(dzminl,dz)
298 dxmaxl=max(dxmaxl,dx)
299 dymaxl=max(dymaxl,dy)
300 dzmaxl=max(dzmaxl,dz)
301C
302 xminl=min(xminl,gauge(2,n))
303 yminl=min(yminl,gauge(3,n))
304 zminl=min(zminl,gauge(4,n))
305 xmaxl=max(xmaxl,gauge(2,n))
306 ymaxl=max(ymaxl,gauge(3,n))
307 zmaxl=max(zmaxl,gauge(4,n))
308 diam_maxl = max(diam_maxl, spbuf(1,n))
309 END IF
310 END DO
311C
312#include "lockon.inc"
313 dxmin=min(dxmin,dxminl)
314 dymin=min(dymin,dyminl)
315 dzmin=min(dzmin,dzminl)
316 dxmax=max(dxmax,dxmaxl)
317 dymax=max(dymax,dymaxl)
318 dzmax=max(dzmax,dzmaxl)
319 xmin=min(xmin,xminl)
320 ymin=min(ymin,yminl)
321 zmin=min(zmin,zminl)
322 xmax=max(xmax,xmaxl)
323 ymax=max(ymax,ymaxl)
324 zmax=max(zmax,zmaxl)
325 diam_max=max(diam_max,diam_maxl)
326#include "lockoff.inc"
327C-----------------------------------------------
328C Communication Min/Max en SPMD
329C-----------------------------------------------
330C
331 CALL my_barrier
332C
333 IF(itask==0)THEN
334 IF(nspmd>1)THEN
335 tmp1(1) = -dxmin
336 tmp1(2) = -dymin
337 tmp1(3) = -dzmin
338 tmp1(4) = -xmin
339 tmp1(5) = -ymin
340 tmp1(6) = -zmin
341 tmp1(7) = dxmax
342 tmp1(8) = dymax
343 tmp1(9) = dzmax
344 tmp1(10) = xmax
345 tmp1(11) = ymax
346 tmp1(12) = zmax
347 tmp1(13) = diam_max
348 CALL spmd_allreduce(tmp1,tmpo,13,spmd_max)
349 dxmin = -tmpo(1)
350 dymin = -tmpo(2)
351 dzmin = -tmpo(3)
352 xmin = -tmpo(4)
353 ymin = -tmpo(5)
354 zmin = -tmpo(6)
355 dxmax = tmpo(7)
356 dymax = tmpo(8)
357 dzmax = tmpo(9)
358 xmax = tmpo(10)
359 ymax = tmpo(11)
360 zmax = tmpo(12)
361 diam_max = tmpo(13)
362 END IF
363C
364 dx=dxmax-dxmin
365 dy=dymax-dymin
366 dz=dzmax-dzmin
367 majord=sqrt(dx*dx+dy*dy+dz*dz)*half
368C
369 spalinr=sqrt(one+spatrue)
370 DO ns=1,nsp2sort
371 n=wsp2sort(ns)
372 IF(spalinr*spbuf(8,n)-majord<=spbuf(1,n))THEN
373 isortsp=1
374 GOTO 10
375 ENDIF
376 ENDDO
37710 CONTINUE
378C-----------------------------------------------
379C PTMD RETRI COMMUNICAT
380C-----------------------------------------------
381 IF(nspmd>1)THEN
382 CALL spmd_allglob_isum9(isortsp,1)
383 IF(isortsp>1)isortsp=1
384 END IF
385 isortspg = isortsp
386 ENDIF
387C
388 CALL my_barrier
389 IF (itask/= 0) isortsp = isortspg
390C
391C-----------------------------------------------
392C Use of voxels to improve evaluation of majord for sorting criteria
393C-----------------------------------------------
394 IF (isortsp==1) THEN
395 nbk = sph_work%voxel_nb
396 voxsiz = 7*nbk*nbk*nbk
397 call sph_crit_voxel(xmax ,ymax ,zmax ,xmin ,ymin ,
398 1 zmin ,diam_max ,voxsiz ,majord_vox,nbk ,
399 2 nsp2sortf,nsp2sortl,itask ,nbgauge ,nthread ,
400 3 lgauge ,numels ,spbuf ,wsp2sort ,kxsp ,
401 4 nisp ,nspbuf ,numsph ,x ,numnod ,
402 5 llgauge ,gauge ,nspmd ,sph_work%voxel)
403C
404 IF (itask==0) THEN
405 isortsp=0
406 DO ns=1,nsp2sort
407 n=wsp2sort(ns)
408 IF(spalinr*spbuf(8,n)-majord_vox<=spbuf(1,n))THEN
409 isortsp=1
410 EXIT
411 ENDIF
412 ENDDO
413 IF(nspmd>1)THEN
414 CALL spmd_allglob_isum9(isortsp,1)
415 IF(isortsp>1)isortsp=1
416 END IF
417 ENDIF
418
419 ENDIF
420C
421 ENDIF ! IF(ISORTSP==0)THEN
422C
423 IF(itask==0)THEN
424 isphred=0
425 isortspg = isortsp
426 ENDIF
427C
428 ireduce=0
429C /---------------/
430 CALL my_barrier
431C /---------------/
432
433 IF (itask/= 0) isortsp = isortspg
434
435 sph_work%WREDUCE(1+itask*numsph/nthread:(itask+1)*numsph/nthread)=0
436
437C /---------------/
438 CALL my_barrier
439C /---------------/
440 IF(itask==0)CALL startime(timers,90)
441 IF(isortsp==1)THEN
442 IF(ispmd==0.and.itask == 0)THEN
443 WRITE(istdo,*)
444 . ' ** INFO ** SPH RE-SEARCH FOR NEIGHBOURS'
445 WRITE(iout,1000) tt
446 END IF
447C
448 IF(itask == 0)THEN
449 nsphsym=0
450 nsphsymr=0
451 ENDIF
452C
453 spatrue=spasort
454C
455C init DBUC, MIN/MAX + search remote cell if spmd
456 CALL sphtri0(timers, x ,spbuf,kxsp,wsp2sort,bminma ,dmax,
457 2 nsp2sortf,nsp2sortl,nsp2sort,itask, dbuc)
458C
459C Tri + Recherche des voisins non nuls
460C
461 IF(nsp2sort>0)
462 1 CALL sphtri(x ,spbuf ,kxsp ,ixsp ,nod2sp,
463 2 ireduce ,wsp2sort ,bminma ,nsp2sortf,nsp2sortl,
464 3 itask ,sph_work%WREDUCE ,lgauge ,gauge )
465C barrier at the end of sptrivox (necessary for global IREDUCE)
466
467#include "lockon.inc"
468 isphred=max(isphred,ireduce)
469#include "lockoff.inc"
470C /---------------/
471 CALL my_barrier
472C /---------------/
473
474 IF(nspmd>1)THEN
475 IF(itask==0)THEN
476C
477 IF(imonm == 2)THEN
478 CALL startime(timers,95)
479 CALL spmd_barrier()
480 CALL stoptime(timers,95)
481 END IF
482 CALL startime(timers,91)
483C Compacting of SPMD structures for Cell Remote + Renumerotation IXSP + Maj Ireduce
484C
485 CALL spmd_sphgat(kxsp,ixsp,wsp2sort,isphred,lgauge)
486 CALL stoptime(timers,91)
487 END IF
488 ENDIF
489 ENDIF
490C /---------------/
491 CALL my_barrier
492C /---------------/
493 IF(itask==0)CALL stoptime(timers,90)
494 isphbuc=isortsp
495 ireduce=isphred
496C
497C-----------------------------------------------
4981000 FORMAT(' ** INFO ** SPH RE-SEARCH FOR NEIGHBOURS AT TIME = ',
499 1 e11.4)
500C-----------------------------------------------
501C
502C /---------------/
503 CALL my_barrier
504C /---------------/
505C
506 isortsp=isphbuc
507 IF(isortsp==1)THEN
508C
509 IF(itask==0) CALL startime(timers,90)
510C
511 ireduce =isphred
512 myspatrue=spatrue
513
514 IF(nspmd>1) THEN
515 IF(itask==0)THEN
516 IF(imonm == 2)THEN
517 CALL startime(timers,95)
518 CALL spmd_barrier()
519 CALL stoptime(timers,95)
520 END IF
521 CALL startime(timers,91)
522C
523C Send List of current active Remotes cells and reception V, M, RHO for active remote cells
524C
525 CALL spmd_sphgetv(kxsp ,spbuf, v, ms, isortsp ,ipartsp)
526C
527 CALL stoptime(timers,91)
528 END IF
529 END IF
530C
531 CALL spsym_alloc(
532 1 x , ispcond ,ispsym ,xframe ,xspsym ,
533 2 vspsym ,wsp2sort ,dmax ,itask ,wsmcomp ,
534 3 myspatrue,spbuf ,kxsp)
535
536C Synchro on SPMD and Var Share Ireduce, Myspatrue, NSPHSYM Exchange
537C /---------------/
538 CALL my_barrier
539C /---------------/
540
541 CALL spsymp(
542 1 x ,v ,ms ,spbuf ,itab ,
543 2 kxsp ,ixsp ,nod2sp ,ispcond ,ispsym ,
544 3 xframe ,xspsym%BUF ,vspsym%BUF ,ireduce ,
545 4 wsp2sort ,myspatrue,dmax ,itask ,sph_work%WREDUCE ,
546 5 lgauge ,gauge)
547
548#include "lockon.inc"
549 IF(ireduce>isphred)THEN
550 isphred=ireduce
551 ENDIF
552#include "lockoff.inc"
553
554 IF(nspmd>1)THEN
555C /---------------/
556 CALL my_barrier
557C /---------------/
558
559 IF(itask==0) THEN
560C
561 IF(imonm == 2)THEN
562 CALL startime(timers,95)
563 CALL spmd_barrier()
564 CALL stoptime(timers,95)
565 END IF
566 CALL startime(timers,91)
567C Global majred majred and spatrue after SPSYMP (unnecessary spat)
568C
569 CALL spmd_spamaj(isphred,spatrue)
570C
571 CALL stoptime(timers,91)
572 END IF
573 END IF
574C /---------------/
575 CALL my_barrier
576C /---------------/
577C
578 ireduce =isphred
579 myspatrue=spatrue
580C re-sort neighbors (true neighbors, neighbors in the safety zone).
581 CALL spclasv(x ,spbuf ,kxsp ,ixsp ,nod2sp ,
582 1 ispsym,xspsym%BUF,wsp2sort ,itask ,myspatrue,
583 2 ireduce,sph_work%WREDUCE,lgauge ,gauge ,isortsp)
584C
585C /---------------/
586 CALL my_barrier
587C /---------------/
588C
589 IF(nspmd>1)THEN
590 IF(imonm == 2.AND.itask==0)THEN
591 CALL startime(timers,95)
592 CALL spmd_barrier()
593 CALL stoptime(timers,95)
594 END IF
595 IF(itask==0) THEN
596 CALL startime(timers,91)
597 CALL spmd_sphgetisph()
598 CALL stoptime(timers,91)
599 END IF
600 ENDIF
601C /---------------/
602 CALL my_barrier
603C /---------------/
604
605#include "lockon.inc"
606 IF(myspatrue<spatrue)THEN
607 spatrue=myspatrue
608 ENDIF
609#include "lockoff.inc"
610
611 IF(nspmd>1)THEN
612C /---------------/
613 CALL my_barrier
614C /---------------/
615
616 IF(itask==0) THEN
617C
618 IF(imonm == 2)THEN
619 CALL startime(timers,95)
620 CALL spmd_barrier()
621 CALL stoptime(timers,95)
622 END IF
623 CALL startime(timers,91)
624C Global majred majred and spclasv (isphred useless)
625C
626 CALL spmd_spamaj(isphred,spatrue)
627C
628 CALL stoptime(timers,91)
629 END IF
630 ENDIF
631C /---------------/
632 CALL my_barrier
633C /---------------/
634 IF(itask==0) CALL stoptime(timers,90)
635
636 ELSE
637C
638 IF(itask==0)CALL startime(timers,94)
639C
640 IF(nspmd>1)THEN
641 IF(itask==0) THEN
642C
643 CALL startime(timers,92)
644C Reception x Remotes cells
645C
646 CALL spmd_sphgetx(kxsp, spbuf ,x ,ipartsp)
647C
648 CALL stoptime(timers,92)
649 END IF
650C Synchronization on SPMD exchange
651C /---------------/
652 CALL my_barrier
653C /---------------/
654 END IF
655C
656C Alloc SPSYM arrays in case of RESTART or /RERUN
657 IF ((ncycle==0).OR.(irunn_bis>1).OR.(mcheck/=0)) THEN
658 IF (itask==0) THEN
659 ALLOCATE(xspsym%BUF(3*nsphsym),stat=ierror)
660 IF(ierror==0) xspsym%BUF = 0
661 ALLOCATE(vspsym%BUF(3*nsphsym),stat=ierror)
662 IF(ierror==0) vspsym%BUF = 0
663 ALLOCATE(wsmcomp%BUF(6*nsphsym),stat=ierror)
664 IF(ierror==0) wsmcomp%BUF = 0
665 irunn_bis = 0
666 ENDIF
667C /---------------/
668 CALL my_barrier
669C /---------------/
670 ENDIF
671C
672C MAJ XSPSYM BEFORE SPCLASV but after SPMD_SPHGETX
673C
674 CALL spadasm0(
675 1 x ,v ,ms ,spbuf ,itab ,
676 2 kxsp ,ixsp ,nod2sp ,ispcond ,ispsym ,
677 3 xframe ,xspsym%BUF ,wsp2sort ,itask )
678C Synchronization on XSPSYM
679C /---------------/
680 CALL my_barrier
681C /---------------/
682C re-sort neighbors (true neighbors, neighbors in the safety zone).
683 ireduce =0
684 myspatrue=zero
685 CALL spclasv(x ,spbuf ,kxsp ,ixsp ,nod2sp ,
686 1 ispsym,xspsym%BUF,wsp2sort ,itask ,myspatrue,
687 2 ireduce,sph_work%WREDUCE,lgauge ,gauge ,isortsp)
688C /---------------/
689 CALL my_barrier
690C /---------------/
691C
692 IF(nspmd>1)THEN
693 IF(itask==0) THEN
694C
695 CALL startime(timers,92)
696C Send List of current active Remotes cells and reception V, M, RHO for active remote cells
697C
698 CALL spmd_sphgetv(kxsp ,spbuf, v, ms, isortsp ,ipartsp)
699C
700 CALL stoptime(timers,92)
701 END IF
702C Synchro echange SPMD
703C /---------------/
704 CALL my_barrier
705C /---------------/
706 END IF
707C
708C Updating symmetrical particles: Maj vSpsym after SPMD_SPHGETV
709C
710 CALL spadasm(
711 1 x ,v ,ms ,spbuf ,itab ,
712 2 kxsp ,ixsp ,nod2sp ,ispcond ,ispsym ,
713 3 xframe ,vspsym%BUF ,wsp2sort ,itask)
714C /---------------/
715 CALL my_barrier
716C /---------------/
717C
718 IF(itask==0)CALL stoptime(timers,94)
719C
720 ENDIF
721C
722C-----------------------------------------------
723C Processing of OUTLETS.
724C-----------------------------------------------
725 IF(itask==0)THEN
726 IF(nsphio/=0)THEN
727 CALL sponof2(x ,v ,d ,ms ,spbuf ,
728 2 itab ,kxsp ,ixsp ,nod2sp ,npc ,
729 3 pld ,iparg ,elbuf_tab,isphio ,vsphio ,
730 4 pm ,ipart ,ipartsp ,igrsurf ,
731 5 lprtsph ,lonfsph ,wa ,wa(numsph+1) ,wa(2*numsph+1) ,
732 6 wasph(kvnorm),sphveln,xdp, ibufssg_io, off_sph_r2r,
733 7 wfext)
734 nsp2sort=0
735 DO iprt=1,npart
736 DO k=lprtsph(2,iprt-1)+1,lprtsph(1,iprt)
737 nsp2sort=nsp2sort+1
738 wsp2sort(nsp2sort)=lonfsph(k)
739 ENDDO
740 ENDDO
741 ENDIF
742C
743 isphbuc=0
744 END IF
745
746 IF(nsphsol/=0)THEN
747C
748C Wake up interacting particles
749 CALL soltosph_on12(
750 . x ,spbuf ,kxsp ,ixsp ,ipartsp ,
751 . iparg ,ngrounc ,igrounc ,elbuf_tab,itask ,
752 . nod2sp ,sol2sph ,sph2sol ,ixs ,ms ,
753 . pm ,iads ,addcne ,fskyd ,dmsph ,
754 . v ,icontact,ipart)
755C /---------------/
756 CALL my_barrier
757C /---------------/
758 END IF
759
760 IF(nsphsol/=0)THEN
761C /---------------/
762 CALL my_barrier
763C /---------------/
764C Wake up particles from solids (wake up groups)
765 nsphact=0
766 CALL soltosph_on2(
767 . x ,spbuf ,kxsp ,ipartsp ,elbuf_tab,
768 . iparg ,ngrounc ,igrounc ,itask ,ixsp ,
769 . nod2sp ,sol2sph ,waspact )
770C
771 ELSE
772 nsphact=nsp2sort
773C WASPACT == WSP2SORT !!!
774 END IF
775
776C /---------------/
777 CALL my_barrier
778C /---------------/
779C
780C-----------------------------------------------
781C KERNEL CORRECTION.
782C-----------------------------------------------
783 CALL spcompl(
784 1 x ,v ,ms ,spbuf ,itab ,
785 2 kxsp ,ixsp ,nod2sp ,ispsym ,xspsym%BUF ,
786 3 vspsym%BUF ,iparg ,wasph ,ispcond ,
787 4 xframe ,wsmcomp%BUF,geo,ipart ,ipartsp ,
788 5 waspact ,itask ,sph_iord1,numgeo,ncycle,
789 6 mcheck)
790C-----------------------------------------------
791C
792 RETURN
793 END
my_real
#define my_real
Definition cppsort.cpp:32
ymax
subroutine ymax(idn, fac, npc, pld, stiffmin, stiffmax, stiffini, stiffavg)
Definition law100_upd.F:274
min
#define min(a, b)
Definition macros.h:20
max
#define max(a, b)
Definition macros.h:21
groupdef_mod
Definition groupdef_mod.F:668
message_mod
Definition message_mod.F:1257
sph_struct_mod
Definition sph_struct_mod.F:30
sph_struct_mod::bool_sph_sort
logical, dimension(:), allocatable bool_sph_sort
Definition sph_struct_mod.F:34
soltosph_on12
subroutine soltosph_on12(x, spbuf, kxsp, ixsp, ipartsp, iparg, ngrounc, igrounc, elbuf_tab, itask, nod2sp, sol2sph, sph2sol, ixs, ms, pm, iads, addcne, fskyd, dmsph, v, icontact, ipart)
Definition soltosph_on1.F:436
soltosph_on1
subroutine soltosph_on1(x, spbuf, kxsp, ixsp, ipartsp, iparg, ngrounc, igrounc, elbuf_tab, itask, nod2sp, sol2sph, sph2sol, ixs, ms, pm, iads, addcne, fskyd, dmsph, v, icontact)
Definition soltosph_on1.F:43
soltosph_on2
subroutine soltosph_on2(x, spbuf, kxsp, ipartsp, elbuf_tab, iparg, ngrounc, igrounc, itask, ixsp, nod2sp, sol2sph, waspact)
Definition soltosph_on2.F:43
spadasm0
subroutine spadasm0(x, v, ms, spbuf, itab, kxsp, ixsp, nod2sp, ispcond, ispsym, xframe, xspsym, wsp2sort, itask)
Definition spadasm.F:34
spadasm
subroutine spadasm(x, v, ms, spbuf, itab, kxsp, ixsp, nod2sp, ispcond, ispsym, xframe, vspsym, wsp2sort, itask)
Definition spadasm.F:129
spcompl
subroutine spcompl(x, v, ms, spbuf, itab, kxsp, ixsp, nod2sp, ispsym, xspsym, vspsym, iparg, wacomp, ispcond, xframe, wsmcomp, geo, ipart, ipartsp, waspact, itask, sph_iord1, numgeo, ncycle, mcheck)
Definition spcompl.F:40
spechan
subroutine spechan(x, v, ms, spbuf, itab, kxsp, ixsp, nod2sp, ispcond, xframe, isortsp, iparg, elbuf_tab, wsp2sort, np2sortf, np2sortl)
Definition spechan.F:38
sphprep
subroutine sphprep(timers, pm, geo, x, v, ms, elbuf_tab, wa, pld, bufmat, partsav, iparg, npc, ipart, itab, bufgeo, xframe, kxsp, ixsp, nod2sp, ipartsp, spbuf, ispcond, ispsym, xspsym, vspsym, wasph, lprtsph, lonfsph, wsp2sort, isphio, vsphio, igrsurf, d, sphveln, itask, xdp, ibufssg_io, lgauge, gauge, ngrounc, igrounc, sol2sph, sph2sol, ixs, iads, addcne, fskyd, dmsph, waspact, icontact, off_sph_r2r, wsmcomp, irunn_bis, sph_iord1, sph_work, wfext)
Definition sphprep.F:77
sphtri0
subroutine sphtri0(timers, x, spbuf, kxsp, wsp2sort, bminma, dmax, nsp2sortf, nsp2sortl, nmn, itask, dbuc)
Definition sphtri0.F:42
sphtri
subroutine sphtri(x, spbuf, kxsp, ixsp, nod2sp, ireduce, wsp2sort, bminma, nsp2sortf, nsp2sortl, itask, kreduce, lgauge, gauge)
Definition sphtri.F:35
spmd_allglob_isum9
subroutine spmd_allglob_isum9(v, len)
Definition spmd_allglob_isum9.F:46
spmd_spamaj
subroutine spmd_spamaj(ireduce, spaglob)
Definition spmd_spamaj.F:33
spmd_sphgetx
subroutine spmd_sphgetx(kxsp, spbuf, x, ipartsp)
Definition spmd_sph.F:379
spmd_sphgetisph
subroutine spmd_sphgetisph()
Definition spmd_sph.F:302
spmd_sphgat
subroutine spmd_sphgat(kxsp, ixsp, wsp2sort, ireduce, lgauge)
Definition spmd_sphgat.F:38
spmd_sphgetv
subroutine spmd_sphgetv(kxsp, spbuf, v, ms, isortsp, ipartsp)
Definition spmd_sphgetv.F:35
sponof1
subroutine sponof1(x, v, d, ms, spbuf, itab, kxsp, ixsp, nod2sp, npc, pld, iparg, elbuf_tab, isphio, vsphio, pm, ipart, ipartsp, igrsurf, lprtsph, lonfsph, mwa, wa, vnormal, xdp, ibufssg_io, off_sph_r2r, wfext)
Definition sponof1.F:45
sponof2
subroutine sponof2(x, v, d, ms, spbuf, itab, kxsp, ixsp, nod2sp, npc, pld, iparg, elbuf_tab, isphio, vsphio, pm, ipart, ipartsp, igrsurf, lprtsph, lonfsph, iwa, mwa, wa, vnormal, sphveln, xdp, ibufssg_io, off_sph_r2r, wfext)
Definition sponof2.F:46
spsymp
subroutine spsymp(x, v, ms, spbuf, itab, kxsp, ixsp, nod2sp, ispcond, ispsym, xframe, xspsym, vspsym, ireduce, wsp2sort, myspatrue, dmax, itask, kreduce, lgauge, gauge)
Definition spsym.F:40
spsym_alloc
subroutine spsym_alloc(x, ispcond, ispsym, xframe, xspsym, vspsym, wsp2sort, dmax, itask, wsmcomp, myspatrue, spbuf, kxsp)
Definition spsym_alloc.F:37
spclasv
subroutine spclasv(x, spbuf, kxsp, ixsp, nod2sp, waspact, myspatrue, ireduce, kreduce)
Definition spclasv.F:32
my_barrier
subroutine my_barrier
Definition machine.F:31
startime
subroutine startime(event, itask)
Definition timer.F:93
stoptime
subroutine stoptime(event, itask)
Definition timer.F:135