OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
soltosph_on1.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!|| soltosph_on1 ../engine/source/elements/sph/soltosph_on1.F
25!||--- called by ------------------------------------------------------
26!|| sphprep ../engine/source/elements/sph/sphprep.F
27!||--- calls -----------------------------------------------------
28!|| my_barrier ../engine/source/system/machine.f
29!|| startimeg ../engine/source/system/timer.F
30!|| stoptimeg ../engine/source/system/timer.F
31!||--- uses -----------------------------------------------------
32!|| elbufdef_mod ../common_source/modules/mat_elem/elbufdef_mod.f90
33!|| message_mod ../engine/share/message_module/message_mod.F
34!|| sphbox ../engine/share/modules/sphbox.F
35!||====================================================================
36 SUBROUTINE soltosph_on1(
37 . X ,SPBUF ,KXSP ,IXSP ,IPARTSP ,
38 . IPARG ,NGROUNC ,IGROUNC ,ELBUF_TAB,ITASK ,
39 . NOD2SP ,SOL2SPH ,SPH2SOL ,IXS ,MS ,
40 . PM ,IADS ,ADDCNE ,FSKYD ,DMSPH ,
41 . V ,ICONTACT)
42C-----------------------------------------------
43C M o d u l e s
44C-----------------------------------------------
45 USE sphbox
46 USE elbufdef_mod
47 USE message_mod
48C-----------------------------------------------
49C I m p l i c i t T y p e s
50C-----------------------------------------------
51#include "implicit_f.inc"
52#include "comlock.inc"
53C-----------------------------------------------
54C C o m m o n B l o c k s
55C-----------------------------------------------
56#include "com01_c.inc"
57#include "com04_c.inc"
58#include "com06_c.inc"
59#include "param_c.inc"
60#include "parit_c.inc"
61#include "scr17_c.inc"
62#include "sphcom.inc"
63#include "task_c.inc"
64#include "units_c.inc"
65#include "vect01_c.inc"
66C-----------------------------------------------
67C D u m m y A r g u m e n t s
68C-----------------------------------------------
69 INTEGER KXSP(NISP,*),
70 . IPARTSP(*), IPARG(NPARG,*), NGROUNC,
71 . IGROUNC(*), ITASK, IXSP(KVOISPH,*), NOD2SP(*),
72 . SOL2SPH(2,*), SPH2SOL(*), IXS(NIXS,*),
73 . IADS(8,*), ADDCNE(*), ICONTACT(*)
74 my_real
75 . x(3,*), spbuf(nspbuf,*), ms(*), pm(npropm,*), fskyd(*),
76 . dmsph(*), v(3,*)
77 TYPE (ELBUF_STRUCT_), TARGET, DIMENSION(NGROUP) :: ELBUF_TAB
78C-----------------------------------------------
79C L o c a l V a r i a b l e s
80C-----------------------------------------------
81 INTEGER I, N, IP, KP, NG, MG, J, NP, KFT, IG, NELEM,
82 . nel, offset, nvois, m, inod, jnod, nn, iprt, imat,
83 . n1, n2, n3, n4, n5, n6, n7, n8,
84 . k1, k2, k3, k4, k5, k6, k7, k8, ierror,
85 . nodft, nodlt
86 my_real
87 . dm, rho0, ehourt, ek, vi2, vxi, vyi, vzi,
88 . vx1, vx2, vx3, vx4, vx5, vx6, vx7, vx8,
89 . vy1, vy2, vy3, vy4, vy5, vy6, vy7, vy8,
90 . vz1, vz2, vz3, vz4, vz5, vz6, vz7, vz8
91C
92C-----
93 TYPE(g_bufel_) ,POINTER :: GBUF, GBUFSP
94 TYPE(L_BUFEL_) ,POINTER :: LBUF
95 TYPE(BUF_MAT_) ,POINTER :: MBUF
96C-----------------------------------------------
97!$OMP DO SCHEDULE(DYNAMIC,1)
98 DO ig = 1, ngrounc
99 ng = igrounc(ig)
100 IF(iparg(8,ng)==1)GOTO 50
101 IF (iddw>0) CALL startimeg(ng)
102 DO nelem = 1,iparg(2,ng),nvsiz
103 offset = nelem - 1
104 nel =iparg(2,ng)
105 nft =iparg(3,ng) + offset
106 iad =iparg(4,ng)
107 ity =iparg(5,ng)
108 ipartsph=iparg(69,ng)
109 lft=1
110 llt=min(nvsiz,nel-nelem+1)
111 IF(ity==1.AND.ipartsph/=0) THEN
112C-----------
113 gbuf => elbuf_tab(ng)%GBUF
114 lbuf => elbuf_tab(ng)%BUFLY(1)%LBUF(1,1,1)
115 mbuf => elbuf_tab(ng)%BUFLY(1)%MAT(1,1,1)
116C-----
117 DO i=lft,llt
118 IF(gbuf%OFF(i)/=zero) THEN
119 n=nft+i
120 DO kp=1,sol2sph(2,n)-sol2sph(1,n)
121 np=sol2sph(1,n)+kp
122 inod=kxsp(3,np)
123 IF(icontact(inod)/=0)THEN
124C
125C Solid will be deleted at next cycle
126 gbuf%OFF(i)=four_over_5
127 idel7nok=1
128#include "lockon.inc"
129 WRITE(iout,*)
130 .' -- PARTICLE INTO CONTACT => DELETE SOLID ELEMENT AT NEXT CYCLE',
131 . ixs(nixs,n)
132 WRITE(istdo,*)
133 .' -- PARTICLE INTO CONTACT => DELETE SOLID ELEMENT AT NEXT CYCLE',
134 . ixs(nixs,n)
135#include "lockoff.inc"
136 EXIT
137 END IF
138 END DO
139 END IF
140 ENDDO
141 END IF
142 END DO
143 IF (iddw>0) CALL stoptimeg(ng)
144C--------
145 50 CONTINUE
146 END DO
147!$OMP END DO
148C-----------------------------------------------
149 ehourt=zero
150 IF(iparit==0)THEN
151C-----------------------------------------------
152C PARITH/OFF
153C-----------------------------------------------
154!$OMP DO SCHEDULE(DYNAMIC,1)
155 DO ig = 1, ngrounc
156 ng = igrounc(ig)
157 IF(iparg(8,ng)==1)GOTO 100
158 IF (iddw>0) CALL startimeg(ng)
159 DO nelem = 1,iparg(2,ng),nvsiz
160 offset = nelem - 1
161 nel =iparg(2,ng)
162 nft =iparg(3,ng) + offset
163 iad =iparg(4,ng)
164 ity =iparg(5,ng)
165 ipartsph=iparg(69,ng)
166 lft=1
167 llt=min(nvsiz,nel-nelem+1)
168 IF(ity==1.AND.ipartsph/=0) THEN
169C-----------
170 gbuf => elbuf_tab(ng)%GBUF
171 lbuf => elbuf_tab(ng)%BUFLY(1)%LBUF(1,1,1)
172 mbuf => elbuf_tab(ng)%BUFLY(1)%MAT(1,1,1)
173C-----
174 DO i=lft,llt
175 IF(gbuf%OFF(i)==zero) THEN
176C
177C SOL2SPH(1,N)+1<=I<=SOLSPH(2,N) <=> N==SPH2SOL(I)
178 n=nft+i
179 np=sol2sph(1,n)+1
180 IF(kxsp(2,np)<0)THEN
181C
182C Solid must have passed to deleted within THIS cycle !
183 ek=zero
184 DO kp=1,sol2sph(2,n)-sol2sph(1,n)
185 np=sol2sph(1,n)+kp
186 mg =mod(-kxsp(2,np),ngroup+1)
187 kft=iparg(3,mg)
188 gbufsp => elbuf_tab(mg)%GBUF
189 kxsp(2,np) =abs(kxsp(2,np))
190 gbufsp%OFF(np-kft)=one
191 sph2sol(np) =0
192C
193 inod=kxsp(3,np)
194 vi2= v(1,inod)*v(1,inod)
195 . +v(2,inod)*v(2,inod)
196 . +v(3,inod)*v(3,inod)
197 ek=ek+half*ms(inod)*vi2
198 ENDDO
199 n1=ixs(2,n)
200 n2=ixs(3,n)
201 n3=ixs(4,n)
202 n4=ixs(5,n)
203 n5=ixs(6,n)
204 n6=ixs(7,n)
205 n7=ixs(8,n)
206 n8=ixs(9,n)
207 imat=ixs(1,n)
208 rho0=pm(1,imat)
209 dm=one_over_8*gbuf%VOL(i)*rho0
210C lockon.. & echange spmd
211 dmsph(n1)=dmsph(n1)+dm
212 dmsph(n2)=dmsph(n2)+dm
213 dmsph(n3)=dmsph(n3)+dm
214 dmsph(n4)=dmsph(n4)+dm
215 dmsph(n5)=dmsph(n5)+dm
216 dmsph(n6)=dmsph(n6)+dm
217 dmsph(n7)=dmsph(n7)+dm
218 dmsph(n8)=dmsph(n8)+dm
219C----
220 n1=ixs(2,n)
221 vx1=v(1,n1)
222 vy1=v(2,n1)
223 vz1=v(3,n1)
224 n2=ixs(3,n)
225 vx2=v(1,n2)
226 vy2=v(2,n2)
227 vz2=v(3,n2)
228 n3=ixs(4,n)
229 vx3=v(1,n3)
230 vy3=v(2,n3)
231 vz3=v(3,n3)
232 n4=ixs(5,n)
233 vx4=v(1,n4)
234 vy4=v(2,n4)
235 vz4=v(3,n4)
236 n5=ixs(6,n)
237 vx5=v(1,n5)
238 vy5=v(2,n5)
239 vz5=v(3,n5)
240 n6=ixs(7,n)
241 vx6=v(1,n6)
242 vy6=v(2,n6)
243 vz6=v(3,n6)
244 n7=ixs(8,n)
245 vx7=v(1,n7)
246 vy7=v(2,n7)
247 vz7=v(3,n7)
248 n8=ixs(9,n)
249 vx8=v(1,n8)
250 vy8=v(2,n8)
251 vz8=v(3,n8)
252 vxi=vx1+vx2+vx3+vx4+vx5+vx6+vx7+vx8
253 vyi=vy1+vy2+vy3+vy4+vy5+vy6+vy7+vy8
254 vzi=vz1+vz2+vz3+vz4+vz5+vz6+vz7+vz8
255 vi2=vx1*vx1+vx2*vx2+vx3*vx3+vx4*vx4
256 1 +vx5*vx5+vx6*vx6+vx7*vx7+vx8*vx8
257 2 +vy1*vy1+vy2*vy2+vy3*vy3+vy4*vy4
258 3 +vy5*vy5+vy6*vy6+vy7*vy7+vy8*vy8
259 4 +vz1*vz1+vz2*vz2+vz3*vz3+vz4*vz4
260 5 +vz5*vz5+vz6*vz6+vz7*vz7+vz8*vz8
261C
262C absorbed energy due to remeshing
263 ehourt=ehourt+half*dm*vi2-ek
264 END IF
265 END IF
266 ENDDO
267 END IF
268 END DO
269 IF (iddw>0) CALL stoptimeg(ng)
270C--------
271 100 CONTINUE
272 END DO
273!$OMP END DO
274 ELSE ! IPARIT==0
275C-----------------------------------------------
276C PARITH/ON
277C-----------------------------------------------
278 nodft = 1+itask*numnod/ nthread
279 nodlt = (itask+1)*numnod/nthread
280 DO n = nodft, nodlt
281 fskyd(addcne(n):addcne(n+1)-1)=zero
282 ENDDO
283C
284 CALL my_barrier
285C
286!$OMP DO SCHEDULE(DYNAMIC,1)
287 DO ig = 1, ngrounc
288 ng = igrounc(ig)
289 IF(iparg(8,ng)==1)GOTO 200
290 IF (iddw>0) CALL startimeg(ng)
291 DO nelem = 1,iparg(2,ng),nvsiz
292 offset = nelem - 1
293 nel =iparg(2,ng)
294 nft =iparg(3,ng) + offset
295 iad =iparg(4,ng)
296 ity =iparg(5,ng)
297 ipartsph=iparg(69,ng)
298 lft=1
299 llt=min(nvsiz,nel-nelem+1)
300 IF(ity==1.AND.ipartsph/=0) THEN
301C-----------
302 gbuf => elbuf_tab(ng)%GBUF
303 lbuf => elbuf_tab(ng)%BUFLY(1)%LBUF(1,1,1)
304 mbuf => elbuf_tab(ng)%BUFLY(1)%MAT(1,1,1)
305C-----
306 DO i=lft,llt
307 IF(gbuf%OFF(i)==zero) THEN
308C
309C SOL2SPH(1,N)+1<=I<=SOLSPH(2,N) <=> N==SPH2SOL(I)
310 n=nft+i
311 np=sol2sph(1,n)+1
312 IF(kxsp(2,np)<0)THEN
313C
314C Solid must have passed to deleted within THIS cycle !
315 ek=zero
316 DO kp=1,sol2sph(2,n)-sol2sph(1,n)
317 np=sol2sph(1,n)+kp
318 mg =mod(-kxsp(2,np),ngroup+1)
319 kft=iparg(3,mg)
320 gbufsp => elbuf_tab(mg)%GBUF
321 kxsp(2,np) =abs(kxsp(2,np))
322 gbufsp%OFF(np-kft)=one
323 sph2sol(np) =0
324C
325 inod=kxsp(3,np)
326 vi2= v(1,inod)*v(1,inod)
327 . +v(2,inod)*v(2,inod)
328 . +v(3,inod)*v(3,inod)
329 ek=ek+half*ms(inod)*vi2
330 ENDDO
331 imat=ixs(1,n)
332 rho0=pm(1,imat)
333 dm=one_over_8*gbuf%VOL(i)*rho0
334C lockon.. & echange spmd
335 k1=iads(1,n)
336 fskyd(k1)=dm
337 k2=iads(2,n)
338 fskyd(k2)=dm
339 k3=iads(3,n)
340 fskyd(k3)=dm
341 k4=iads(4,n)
342 fskyd(k4)=dm
343 k5=iads(5,n)
344 fskyd(k5)=dm
345 k6=iads(6,n)
346 fskyd(k6)=dm
347 k7=iads(7,n)
348 fskyd(k7)=dm
349 k8=iads(8,n)
350 fskyd(k8)=dm
351C----
352 n1=ixs(2,n)
353 vx1=v(1,n1)
354 vy1=v(2,n1)
355 vz1=v(3,n1)
356 n2=ixs(3,n)
357 vx2=v(1,n2)
358 vy2=v(2,n2)
359 vz2=v(3,n2)
360 n3=ixs(4,n)
361 vx3=v(1,n3)
362 vy3=v(2,n3)
363 vz3=v(3,n3)
364 n4=ixs(5,n)
365 vx4=v(1,n4)
366 vy4=v(2,n4)
367 vz4=v(3,n4)
368 n5=ixs(6,n)
369 vx5=v(1,n5)
370 vy5=v(2,n5)
371 vz5=v(3,n5)
372 n6=ixs(7,n)
373 vx6=v(1,n6)
374 vy6=v(2,n6)
375 vz6=v(3,n6)
376 n7=ixs(8,n)
377 vx7=v(1,n7)
378 vy7=v(2,n7)
379 vz7=v(3,n7)
380 n8=ixs(9,n)
381 vx8=v(1,n8)
382 vy8=v(2,n8)
383 vz8=v(3,n8)
384 vxi=vx1+vx2+vx3+vx4+vx5+vx6+vx7+vx8
385 vyi=vy1+vy2+vy3+vy4+vy5+vy6+vy7+vy8
386 vzi=vz1+vz2+vz3+vz4+vz5+vz6+vz7+vz8
387 vi2=vx1*vx1+vx2*vx2+vx3*vx3+vx4*vx4
388 1 +vx5*vx5+vx6*vx6+vx7*vx7+vx8*vx8
389 2 +vy1*vy1+vy2*vy2+vy3*vy3+vy4*vy4
390 3 +vy5*vy5+vy6*vy6+vy7*vy7+vy8*vy8
391 4 +vz1*vz1+vz2*vz2+vz3*vz3+vz4*vz4
392 5 +vz5*vz5+vz6*vz6+vz7*vz7+vz8*vz8
393C
394C absorbed energy due to remeshing
395 ehourt=ehourt+half*dm*vi2-ek
396 END IF
397 END IF
398 ENDDO
399 END IF
400 END DO
401 IF (iddw>0) CALL stoptimeg(ng)
402C--------
403 200 CONTINUE
404 END DO
405!$OMP END DO
406C--------
407 END IF
408C-----------------------------------------------
409#include "lockon.inc"
410 ehour=ehour+ehourt
411#include "lockoff.inc"
412C-----------------------------------------------
413 RETURN
414 END SUBROUTINE soltosph_on1
415!||====================================================================
416!|| soltosph_on12 ../engine/source/elements/sph/soltosph_on1.F
417!||--- called by ------------------------------------------------------
418!|| sphprep ../engine/source/elements/sph/sphprep.F
419!||--- calls -----------------------------------------------------
420!|| startimeg ../engine/source/system/timer.f
421!|| stoptimeg ../engine/source/system/timer.F
422!||--- uses -----------------------------------------------------
423!|| elbufdef_mod ../common_source/modules/mat_elem/elbufdef_mod.F90
424!|| message_mod ../engine/share/message_module/message_mod.F
425!|| sphbox ../engine/share/modules/sphbox.F
426!||====================================================================
427 SUBROUTINE soltosph_on12(
428 . X ,SPBUF ,KXSP ,IXSP ,IPARTSP ,
429 . IPARG ,NGROUNC ,IGROUNC ,ELBUF_TAB,ITASK ,
430 . NOD2SP ,SOL2SPH ,SPH2SOL ,IXS ,MS ,
431 . PM ,IADS ,ADDCNE ,FSKYD ,DMSPH ,
432 . V ,ICONTACT,IPART)
433C-----------------------------------------------
434C M o d u l e s
435C-----------------------------------------------
436 USE sphbox
437 USE elbufdef_mod
438 USE message_mod
439C-----------------------------------------------
440C I m p l i c i t T y p e s
441C-----------------------------------------------
442#include "implicit_f.inc"
443#include "comlock.inc"
444C-----------------------------------------------
445C C o m m o n B l o c k s
446C-----------------------------------------------
447#include "com01_c.inc"
448#include "com04_c.inc"
449#include "param_c.inc"
450#include "scr17_c.inc"
451#include "sphcom.inc"
452#include "task_c.inc"
453#include "units_c.inc"
454#include "vect01_c.inc"
455C-----------------------------------------------
456C D u m m y A r g u m e n t s
457C-----------------------------------------------
458 INTEGER KXSP(NISP,*),
459 . IPARTSP(*), IPARG(NPARG,*), NGROUNC,
460 . IGROUNC(*), ITASK, IXSP(KVOISPH,*), NOD2SP(*),
461 . SOL2SPH(2,*), SPH2SOL(*), IXS(NIXS,*),
462 . IADS(8,*), ADDCNE(*), ICONTACT(*), IPART(LIPART1,*)
463 my_real
464 . X(3,*), SPBUF(NSPBUF,*), MS(*), PM(NPROPM,*), FSKYD(*),
465 . DMSPH(*), V(3,*)
466 TYPE (ELBUF_STRUCT_), TARGET, DIMENSION(NGROUP) :: ELBUF_TAB
467C-----------------------------------------------
468C L o c a l V a r i a b l e s
469C-----------------------------------------------
470 INTEGER I, N, IP, KP, NG, MG, J, NP, KFT, IG, NELEM,
471 . NEL, OFFSET, NVOIS, M, INOD, JNOD, NN, IPRT, IMAT
472C
473C-----
474 TYPE(g_bufel_) ,POINTER :: GBUF
475 TYPE(L_BUFEL_) ,POINTER :: LBUF
476 TYPE(buf_mat_) ,POINTER :: MBUF
477C-----------------------------------------------
478!$OMP DO SCHEDULE(DYNAMIC,1)
479 DO IG = 1, ngrounc
480 ng = igrounc(ig)
481 IF(iparg(8,ng)==1)GOTO 50
482 IF (iddw>0) CALL startimeg(ng)
483 DO nelem = 1,iparg(2,ng),nvsiz
484 offset = nelem - 1
485 nel =iparg(2,ng)
486 nft =iparg(3,ng) + offset
487 iad =iparg(4,ng)
488 ity =iparg(5,ng)
489 ipartsph=iparg(69,ng)
490 lft=1
491 llt=min(nvsiz,nel-nelem+1)
492 IF(ity==1.AND.ipartsph/=0) THEN
493C-----------
494 gbuf => elbuf_tab(ng)%GBUF
495 lbuf => elbuf_tab(ng)%BUFLY(1)%LBUF(1,1,1)
496 mbuf => elbuf_tab(ng)%BUFLY(1)%MAT(1,1,1)
497C-----
498 IF ((itsol2sph==1).OR.(nsubs==0)) THEN
499C Deactivation of solid element if id of sph part is different
500C-----
501 DO i=lft,llt
502 IF(gbuf%OFF(i)/=zero) THEN
503 n=nft+i
504 DO kp=1,sol2sph(2,n)-sol2sph(1,n)
505 np=sol2sph(1,n)+kp
506 inod=kxsp(3,np)
507 nvois=kxsp(4,np)
508 DO j=1,nvois
509 jnod=ixsp(j,np)
510 IF(jnod>0)THEN
511 m=nod2sp(jnod)
512 IF(ipartsp(m)/=ipartsp(np))THEN
513C
514C Solid will be deleted at next cycle
515 gbuf%OFF(i)=four_over_5
516 idel7nok=1
517#include "lockon.inc"
518 WRITE(iout,5000) ixs(nixs,n)
519 WRITE(istdo,5000) ixs(nixs,n)
520#include "lockoff.inc"
521 GOTO 100
522 END IF
523 ELSE
524 nn = -jnod
525 IF(nint(xsphr(14,nn))/=ipartsp(np))THEN
526C
527C Solid will be deleted at next cycle
528 gbuf%OFF(i)=four_over_5
529 idel7nok=1
530#include "lockon.inc"
531 WRITE(iout,5000) ixs(nixs,n)
532 WRITE(istdo,5000) ixs(nixs,n)
533#include "lockoff.inc"
534 GOTO 100
535 END IF
536 END IF
537 END DO
538 END DO
539 END IF
540 100 CONTINUE
541 ENDDO
542C-----
543 ELSEIF (itsol2sph==2) THEN
544C Deactivation of solid element if id of subset is different
545C-----
546 DO i=lft,llt
547 IF(gbuf%OFF(i)/=zero) THEN
548 n=nft+i
549 DO kp=1,sol2sph(2,n)-sol2sph(1,n)
550 np=sol2sph(1,n)+kp
551 inod=kxsp(3,np)
552 nvois=kxsp(4,np)
553 DO j=1,nvois
554 jnod=ixsp(j,np)
555 IF(jnod>0)THEN
556 m=nod2sp(jnod)
557 IF((ipart(3,ipartsp(m))/=ipart(3,ipartsp(np))).OR.
558 . (((ipart(3,ipartsp(m))+ipart(3,ipartsp(np)))==2*nsubs).
559 . and.(ipartsp(m)/=ipartsp(np)))) THEN
560C
561C Solid will be deleted at next cycle
562 gbuf%OFF(i)=four_over_5
563 idel7nok=1
564#include "lockon.inc"
565 WRITE(iout,6000) ixs(nixs,n)
566 WRITE(istdo,6000) ixs(nixs,n)
567#include "lockoff.inc"
568 GOTO 200
569 END IF
570 ELSE
571 nn = -jnod
572 IF((ipart(3,nint(xsphr(14,nn)))/=ipart(3,ipartsp(np))).OR.
573 . (((ipart(3,ipartsp(np))+ipart(3,nint(xsphr(14,nn)))==2*nsubs).
574 . and.(nint(xsphr(14,nn))/=ipartsp(np))))) THEN
575C
576C Solid will be deleted at next cycle
577 gbuf%OFF(i)=four_over_5
578 idel7nok=1
579#include "lockon.inc"
580 WRITE(iout,6000) ixs(nixs,n)
581 WRITE(istdo,6000) ixs(nixs,n)
582#include "lockoff.inc"
583 GOTO 200
584 END IF
585 END IF
586 END DO
587 END DO
588 END IF
589 200 CONTINUE
590 ENDDO
591C-----
592 ENDIF
593C-----
594 END IF
595 END DO
596 IF (iddw>0) CALL stoptimeg(ng)
597C--------
598 50 CONTINUE
599 END DO
600!$OMP END DO
601C-----------------------------------------------
602 5000 FORMAT(
603 & ' -- PARTICLE INTERACTING W/OTHER SPH PART',
604 . ' => DELETE SOLID ELEMENT AT NEXT CYCLE',i10)
605 6000 FORMAT(
606 & ' -- PARTICLE INTERACTING W/OTHER SPH PART OR SUBSET',
607 . ' => DELETE SOLID ELEMENT AT NEXT CYCLE',i10)
608C-----------------------------------------------
609 RETURN
610 END SUBROUTINE soltosph_on12
my_real
#define my_real
Definition cppsort.cpp:32
startimeg
subroutine startimeg(ng)
Definition timer.F:1487
stoptimeg
subroutine stoptimeg(ng)
Definition timer.F:1535
min
#define min(a, b)
Definition macros.h:20
message_mod
Definition message_mod.F:1249
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
my_barrier
subroutine my_barrier
Definition machine.F:31