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