OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
soltosph_on1.F File Reference
#include "implicit_f.inc"
#include "comlock.inc"
#include "com01_c.inc"
#include "com04_c.inc"
#include "com06_c.inc"
#include "param_c.inc"
#include "parit_c.inc"
#include "scr17_c.inc"
#include "sphcom.inc"
#include "task_c.inc"
#include "units_c.inc"
#include "vect01_c.inc"
#include "lockon.inc"
#include "lockoff.inc"

Go to the source code of this file.

Functions/Subroutines

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)
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)

Function/Subroutine Documentation

◆ soltosph_on1()

subroutine soltosph_on1 ( x,
spbuf,
integer, dimension(nisp,*) kxsp,
integer, dimension(kvoisph,*) ixsp,
integer, dimension(*) ipartsp,
integer, dimension(nparg,*) iparg,
integer ngrounc,
integer, dimension(*) igrounc,
type (elbuf_struct_), dimension(ngroup), target elbuf_tab,
integer itask,
integer, dimension(*) nod2sp,
integer, dimension(2,*) sol2sph,
integer, dimension(*) sph2sol,
integer, dimension(nixs,*) ixs,
ms,
pm,
integer, dimension(8,*) iads,
integer, dimension(*) addcne,
fskyd,
dmsph,
v,
integer, dimension(*) icontact )

Definition at line 37 of file soltosph_on1.F.

43C-----------------------------------------------
44C M o d u l e s
45C-----------------------------------------------
46 USE sphbox
47 USE elbufdef_mod
48 USE message_mod
49 use element_mod , only : nixs
50C-----------------------------------------------
51C I m p l i c i t T y p e s
52C-----------------------------------------------
53#include "implicit_f.inc"
54#include "comlock.inc"
55C-----------------------------------------------
56C C o m m o n B l o c k s
57C-----------------------------------------------
58#include "com01_c.inc"
59#include "com04_c.inc"
60#include "com06_c.inc"
61#include "param_c.inc"
62#include "parit_c.inc"
63#include "scr17_c.inc"
64#include "sphcom.inc"
65#include "task_c.inc"
66#include "units_c.inc"
67#include "vect01_c.inc"
68C-----------------------------------------------
69C D u m m y A r g u m e n t s
70C-----------------------------------------------
71 INTEGER KXSP(NISP,*),
72 . IPARTSP(*), IPARG(NPARG,*), NGROUNC,
73 . IGROUNC(*), ITASK, IXSP(KVOISPH,*), NOD2SP(*),
74 . SOL2SPH(2,*), SPH2SOL(*), IXS(NIXS,*),
75 . IADS(8,*), ADDCNE(*), ICONTACT(*)
76 my_real
77 . x(3,*), spbuf(nspbuf,*), ms(*), pm(npropm,*), fskyd(*),
78 . dmsph(*), v(3,*)
79 TYPE (ELBUF_STRUCT_), TARGET, DIMENSION(NGROUP) :: ELBUF_TAB
80C-----------------------------------------------
81C L o c a l V a r i a b l e s
82C-----------------------------------------------
83 INTEGER I, N, KP, NG, MG, NP, KFT, IG, NELEM,
84 . NEL, OFFSET, INOD, IMAT,
85 . N1, N2, N3, N4, N5, N6, N7, N8,
86 . K1, K2, K3, K4, K5, K6, K7, K8,
87 . NODFT, NODLT
88 my_real
89 . dm, rho0, ehourt, ek, vi2, vxi, vyi, vzi,
90 . vx1, vx2, vx3, vx4, vx5, vx6, vx7, vx8,
91 . vy1, vy2, vy3, vy4, vy5, vy6, vy7, vy8,
92 . vz1, vz2, vz3, vz4, vz5, vz6, vz7, vz8
93C
94C-----
95 TYPE(G_BUFEL_) ,POINTER :: GBUF, GBUFSP
96 TYPE(L_BUFEL_) ,POINTER :: LBUF
97 TYPE(BUF_MAT_) ,POINTER :: MBUF
98C-----------------------------------------------
99!$OMP DO SCHEDULE(DYNAMIC,1)
100 DO ig = 1, ngrounc
101 ng = igrounc(ig)
102 IF(iparg(8,ng)==1)GOTO 50
103 IF (iddw>0) CALL startimeg(ng)
104 DO nelem = 1,iparg(2,ng),nvsiz
105 offset = nelem - 1
106 nel =iparg(2,ng)
107 nft =iparg(3,ng) + offset
108 iad =iparg(4,ng)
109 ity =iparg(5,ng)
110 ipartsph=iparg(69,ng)
111 lft=1
112 llt=min(nvsiz,nel-nelem+1)
113 IF(ity==1.AND.ipartsph/=0) THEN
114C-----------
115 gbuf => elbuf_tab(ng)%GBUF
116 lbuf => elbuf_tab(ng)%BUFLY(1)%LBUF(1,1,1)
117 mbuf => elbuf_tab(ng)%BUFLY(1)%MAT(1,1,1)
118C-----
119 DO i=lft,llt
120 IF(gbuf%OFF(i)/=zero) THEN
121 n=nft+i
122 DO kp=1,sol2sph(2,n)-sol2sph(1,n)
123 np=sol2sph(1,n)+kp
124 inod=kxsp(3,np)
125 IF(icontact(inod)/=0)THEN
126C
127C Solid will be deleted at next cycle
128 gbuf%OFF(i)=four_over_5
129 idel7nok=1
130#include "lockon.inc"
131 WRITE(iout,*)
132 .' -- PARTICLE INTO CONTACT => DELETE SOLID ELEMENT AT NEXT CYCLE',
133 . ixs(nixs,n)
134 WRITE(istdo,*)
135 .' -- PARTICLE INTO CONTACT => DELETE SOLID ELEMENT AT NEXT CYCLE',
136 . ixs(nixs,n)
137#include "lockoff.inc"
138 EXIT
139 END IF
140 END DO
141 END IF
142 ENDDO
143 END IF
144 END DO
145 IF (iddw>0) CALL stoptimeg(ng)
146C--------
147 50 CONTINUE
148 END DO
149!$OMP END DO
150C-----------------------------------------------
151 ehourt=zero
152 IF(iparit==0)THEN
153C-----------------------------------------------
154C PARITH/OFF
155C-----------------------------------------------
156!$OMP DO SCHEDULE(DYNAMIC,1)
157 DO ig = 1, ngrounc
158 ng = igrounc(ig)
159 IF(iparg(8,ng)==1)GOTO 100
160 IF (iddw>0) CALL startimeg(ng)
161 DO nelem = 1,iparg(2,ng),nvsiz
162 offset = nelem - 1
163 nel =iparg(2,ng)
164 nft =iparg(3,ng) + offset
165 iad =iparg(4,ng)
166 ity =iparg(5,ng)
167 ipartsph=iparg(69,ng)
168 lft=1
169 llt=min(nvsiz,nel-nelem+1)
170 IF(ity==1.AND.ipartsph/=0) THEN
171C-----------
172 gbuf => elbuf_tab(ng)%GBUF
173 lbuf => elbuf_tab(ng)%BUFLY(1)%LBUF(1,1,1)
174 mbuf => elbuf_tab(ng)%BUFLY(1)%MAT(1,1,1)
175C-----
176 DO i=lft,llt
177 IF(gbuf%OFF(i)==zero) THEN
178C
179C SOL2SPH(1,N)+1<=I<=SOLSPH(2,N) <=> N==SPH2SOL(I)
180 n=nft+i
181 np=sol2sph(1,n)+1
182 IF(kxsp(2,np)<0)THEN
183C
184C Solid must have passed to deleted within THIS cycle !
185 ek=zero
186 DO kp=1,sol2sph(2,n)-sol2sph(1,n)
187 np=sol2sph(1,n)+kp
188 mg =mod(-kxsp(2,np),ngroup+1)
189 kft=iparg(3,mg)
190 gbufsp => elbuf_tab(mg)%GBUF
191 kxsp(2,np) =abs(kxsp(2,np))
192 gbufsp%OFF(np-kft)=one
193 sph2sol(np) =0
194C
195 inod=kxsp(3,np)
196 vi2= v(1,inod)*v(1,inod)
197 . +v(2,inod)*v(2,inod)
198 . +v(3,inod)*v(3,inod)
199 ek=ek+half*ms(inod)*vi2
200 ENDDO
201 n1=ixs(2,n)
202 n2=ixs(3,n)
203 n3=ixs(4,n)
204 n4=ixs(5,n)
205 n5=ixs(6,n)
206 n6=ixs(7,n)
207 n7=ixs(8,n)
208 n8=ixs(9,n)
209 imat=ixs(1,n)
210 rho0=pm(1,imat)
211 dm=one_over_8*gbuf%VOL(i)*rho0
212C lockon.. & echange spmd
213 dmsph(n1)=dmsph(n1)+dm
214 dmsph(n2)=dmsph(n2)+dm
215 dmsph(n3)=dmsph(n3)+dm
216 dmsph(n4)=dmsph(n4)+dm
217 dmsph(n5)=dmsph(n5)+dm
218 dmsph(n6)=dmsph(n6)+dm
219 dmsph(n7)=dmsph(n7)+dm
220 dmsph(n8)=dmsph(n8)+dm
221C----
222 n1=ixs(2,n)
223 vx1=v(1,n1)
224 vy1=v(2,n1)
225 vz1=v(3,n1)
226 n2=ixs(3,n)
227 vx2=v(1,n2)
228 vy2=v(2,n2)
229 vz2=v(3,n2)
230 n3=ixs(4,n)
231 vx3=v(1,n3)
232 vy3=v(2,n3)
233 vz3=v(3,n3)
234 n4=ixs(5,n)
235 vx4=v(1,n4)
236 vy4=v(2,n4)
237 vz4=v(3,n4)
238 n5=ixs(6,n)
239 vx5=v(1,n5)
240 vy5=v(2,n5)
241 vz5=v(3,n5)
242 n6=ixs(7,n)
243 vx6=v(1,n6)
244 vy6=v(2,n6)
245 vz6=v(3,n6)
246 n7=ixs(8,n)
247 vx7=v(1,n7)
248 vy7=v(2,n7)
249 vz7=v(3,n7)
250 n8=ixs(9,n)
251 vx8=v(1,n8)
252 vy8=v(2,n8)
253 vz8=v(3,n8)
254 vxi=vx1+vx2+vx3+vx4+vx5+vx6+vx7+vx8
255 vyi=vy1+vy2+vy3+vy4+vy5+vy6+vy7+vy8
256 vzi=vz1+vz2+vz3+vz4+vz5+vz6+vz7+vz8
257 vi2=vx1*vx1+vx2*vx2+vx3*vx3+vx4*vx4
258 1 +vx5*vx5+vx6*vx6+vx7*vx7+vx8*vx8
259 2 +vy1*vy1+vy2*vy2+vy3*vy3+vy4*vy4
260 3 +vy5*vy5+vy6*vy6+vy7*vy7+vy8*vy8
261 4 +vz1*vz1+vz2*vz2+vz3*vz3+vz4*vz4
262 5 +vz5*vz5+vz6*vz6+vz7*vz7+vz8*vz8
263C
264C absorbed energy due to remeshing
265 ehourt=ehourt+half*dm*vi2-ek
266 END IF
267 END IF
268 ENDDO
269 END IF
270 END DO
271 IF (iddw>0) CALL stoptimeg(ng)
272C--------
273 100 CONTINUE
274 END DO
275!$OMP END DO
276 ELSE ! IPARIT==0
277C-----------------------------------------------
278C PARITH/ON
279C-----------------------------------------------
280 nodft = 1+itask*numnod/ nthread
281 nodlt = (itask+1)*numnod/nthread
282 DO n = nodft, nodlt
283 fskyd(addcne(n):addcne(n+1)-1)=zero
284 ENDDO
285C
286 CALL my_barrier
287C
288!$OMP DO SCHEDULE(DYNAMIC,1)
289 DO ig = 1, ngrounc
290 ng = igrounc(ig)
291 IF(iparg(8,ng)==1)GOTO 200
292 IF (iddw>0) CALL startimeg(ng)
293 DO nelem = 1,iparg(2,ng),nvsiz
294 offset = nelem - 1
295 nel =iparg(2,ng)
296 nft =iparg(3,ng) + offset
297 iad =iparg(4,ng)
298 ity =iparg(5,ng)
299 ipartsph=iparg(69,ng)
300 lft=1
301 llt=min(nvsiz,nel-nelem+1)
302 IF(ity==1.AND.ipartsph/=0) THEN
303C-----------
304 gbuf => elbuf_tab(ng)%GBUF
305 lbuf => elbuf_tab(ng)%BUFLY(1)%LBUF(1,1,1)
306 mbuf => elbuf_tab(ng)%BUFLY(1)%MAT(1,1,1)
307C-----
308 DO i=lft,llt
309 IF(gbuf%OFF(i)==zero) THEN
310C
311C SOL2SPH(1,N)+1<=I<=SOLSPH(2,N) <=> N==SPH2SOL(I)
312 n=nft+i
313 np=sol2sph(1,n)+1
314 IF(kxsp(2,np)<0)THEN
315C
316C Solid must have passed to deleted within THIS cycle !
317 ek=zero
318 DO kp=1,sol2sph(2,n)-sol2sph(1,n)
319 np=sol2sph(1,n)+kp
320 mg =mod(-kxsp(2,np),ngroup+1)
321 kft=iparg(3,mg)
322 gbufsp => elbuf_tab(mg)%GBUF
323 kxsp(2,np) =abs(kxsp(2,np))
324 gbufsp%OFF(np-kft)=one
325 sph2sol(np) =0
326C
327 inod=kxsp(3,np)
328 vi2= v(1,inod)*v(1,inod)
329 . +v(2,inod)*v(2,inod)
330 . +v(3,inod)*v(3,inod)
331 ek=ek+half*ms(inod)*vi2
332 ENDDO
333 imat=ixs(1,n)
334 rho0=pm(1,imat)
335 dm=one_over_8*gbuf%VOL(i)*rho0
336C lockon.. & echange spmd
337 k1=iads(1,n)
338 fskyd(k1)=dm
339 k2=iads(2,n)
340 fskyd(k2)=dm
341 k3=iads(3,n)
342 fskyd(k3)=dm
343 k4=iads(4,n)
344 fskyd(k4)=dm
345 k5=iads(5,n)
346 fskyd(k5)=dm
347 k6=iads(6,n)
348 fskyd(k6)=dm
349 k7=iads(7,n)
350 fskyd(k7)=dm
351 k8=iads(8,n)
352 fskyd(k8)=dm
353C----
354 n1=ixs(2,n)
355 vx1=v(1,n1)
356 vy1=v(2,n1)
357 vz1=v(3,n1)
358 n2=ixs(3,n)
359 vx2=v(1,n2)
360 vy2=v(2,n2)
361 vz2=v(3,n2)
362 n3=ixs(4,n)
363 vx3=v(1,n3)
364 vy3=v(2,n3)
365 vz3=v(3,n3)
366 n4=ixs(5,n)
367 vx4=v(1,n4)
368 vy4=v(2,n4)
369 vz4=v(3,n4)
370 n5=ixs(6,n)
371 vx5=v(1,n5)
372 vy5=v(2,n5)
373 vz5=v(3,n5)
374 n6=ixs(7,n)
375 vx6=v(1,n6)
376 vy6=v(2,n6)
377 vz6=v(3,n6)
378 n7=ixs(8,n)
379 vx7=v(1,n7)
380 vy7=v(2,n7)
381 vz7=v(3,n7)
382 n8=ixs(9,n)
383 vx8=v(1,n8)
384 vy8=v(2,n8)
385 vz8=v(3,n8)
386 vxi=vx1+vx2+vx3+vx4+vx5+vx6+vx7+vx8
387 vyi=vy1+vy2+vy3+vy4+vy5+vy6+vy7+vy8
388 vzi=vz1+vz2+vz3+vz4+vz5+vz6+vz7+vz8
389 vi2=vx1*vx1+vx2*vx2+vx3*vx3+vx4*vx4
390 1 +vx5*vx5+vx6*vx6+vx7*vx7+vx8*vx8
391 2 +vy1*vy1+vy2*vy2+vy3*vy3+vy4*vy4
392 3 +vy5*vy5+vy6*vy6+vy7*vy7+vy8*vy8
393 4 +vz1*vz1+vz2*vz2+vz3*vz3+vz4*vz4
394 5 +vz5*vz5+vz6*vz6+vz7*vz7+vz8*vz8
395C
396C absorbed energy due to remeshing
397 ehourt=ehourt+half*dm*vi2-ek
398 END IF
399 END IF
400 ENDDO
401 END IF
402 END DO
403 IF (iddw>0) CALL stoptimeg(ng)
404C--------
405 200 CONTINUE
406 END DO
407!$OMP END DO
408C--------
409 END IF
410C-----------------------------------------------
411#include "lockon.inc"
412 ehour=ehour+ehourt
413#include "lockoff.inc"
414C-----------------------------------------------
415 RETURN
my_real
#define my_real
Definition cppsort.cpp:32
startimeg
subroutine startimeg(ng)
Definition timer.F:1371
stoptimeg
subroutine stoptimeg(ng)
Definition timer.F:1419
min
#define min(a, b)
Definition macros.h:20
message_mod
Definition message_mod.F:1257
my_barrier
subroutine my_barrier
Definition machine.F:31

◆ soltosph_on12()

subroutine soltosph_on12 ( x,
spbuf,
integer, dimension(nisp,*) kxsp,
integer, dimension(kvoisph,*) ixsp,
integer, dimension(*) ipartsp,
integer, dimension(nparg,*) iparg,
integer ngrounc,
integer, dimension(*) igrounc,
type (elbuf_struct_), dimension(ngroup), target elbuf_tab,
integer itask,
integer, dimension(*) nod2sp,
integer, dimension(2,*) sol2sph,
integer, dimension(*) sph2sol,
integer, dimension(nixs,*) ixs,
ms,
pm,
integer, dimension(8,*) iads,
integer, dimension(*) addcne,
fskyd,
dmsph,
v,
integer, dimension(*) icontact,
integer, dimension(lipart1,*) ipart )

Definition at line 430 of file soltosph_on1.F.

436C-----------------------------------------------
437C M o d u l e s
438C-----------------------------------------------
439 USE sphbox
440 USE elbufdef_mod
441 USE message_mod
442 use element_mod , only : nixs
443C-----------------------------------------------
444C I m p l i c i t T y p e s
445C-----------------------------------------------
446#include "implicit_f.inc"
447#include "comlock.inc"
448C-----------------------------------------------
449C C o m m o n B l o c k s
450C-----------------------------------------------
451#include "com01_c.inc"
452#include "com04_c.inc"
453#include "param_c.inc"
454#include "scr17_c.inc"
455#include "sphcom.inc"
456#include "task_c.inc"
457#include "units_c.inc"
458#include "vect01_c.inc"
459C-----------------------------------------------
460C D u m m y A r g u m e n t s
461C-----------------------------------------------
462 INTEGER KXSP(NISP,*),
463 . IPARTSP(*), IPARG(NPARG,*), NGROUNC,
464 . IGROUNC(*), ITASK, IXSP(KVOISPH,*), NOD2SP(*),
465 . SOL2SPH(2,*), SPH2SOL(*), IXS(NIXS,*),
466 . IADS(8,*), ADDCNE(*), ICONTACT(*), IPART(LIPART1,*)
467 my_real
468 . x(3,*), spbuf(nspbuf,*), ms(*), pm(npropm,*), fskyd(*),
469 . dmsph(*), v(3,*)
470 TYPE (ELBUF_STRUCT_), TARGET, DIMENSION(NGROUP) :: ELBUF_TAB
471C-----------------------------------------------
472C L o c a l V a r i a b l e s
473C-----------------------------------------------
474 INTEGER I, N, KP, NG, J, NP, IG, NELEM,
475 . NEL, OFFSET, NVOIS, M, INOD, JNOD, NN
476C
477C-----
478 TYPE(G_BUFEL_) ,POINTER :: GBUF
479 TYPE(L_BUFEL_) ,POINTER :: LBUF
480 TYPE(BUF_MAT_) ,POINTER :: MBUF
481C-----------------------------------------------
482!$OMP DO SCHEDULE(DYNAMIC,1)
483 DO ig = 1, ngrounc
484 ng = igrounc(ig)
485 IF(iparg(8,ng)==1)GOTO 50
486 IF (iddw>0) CALL startimeg(ng)
487 DO nelem = 1,iparg(2,ng),nvsiz
488 offset = nelem - 1
489 nel =iparg(2,ng)
490 nft =iparg(3,ng) + offset
491 iad =iparg(4,ng)
492 ity =iparg(5,ng)
493 ipartsph=iparg(69,ng)
494 lft=1
495 llt=min(nvsiz,nel-nelem+1)
496 IF(ity==1.AND.ipartsph/=0) THEN
497C-----------
498 gbuf => elbuf_tab(ng)%GBUF
499 lbuf => elbuf_tab(ng)%BUFLY(1)%LBUF(1,1,1)
500 mbuf => elbuf_tab(ng)%BUFLY(1)%MAT(1,1,1)
501C-----
502 IF ((itsol2sph==1).OR.(nsubs==0)) THEN
503C Deactivation of solid element if id of sph part is different
504C-----
505 DO i=lft,llt
506 IF(gbuf%OFF(i)/=zero) THEN
507 n=nft+i
508 DO kp=1,sol2sph(2,n)-sol2sph(1,n)
509 np=sol2sph(1,n)+kp
510 inod=kxsp(3,np)
511 nvois=kxsp(4,np)
512 DO j=1,nvois
513 jnod=ixsp(j,np)
514 IF(jnod>0)THEN
515 m=nod2sp(jnod)
516 IF(ipartsp(m)/=ipartsp(np))THEN
517C
518C Solid will be deleted at next cycle
519 gbuf%OFF(i)=four_over_5
520 idel7nok=1
521#include "lockon.inc"
522 WRITE(iout,5000) ixs(nixs,n)
523 WRITE(istdo,5000) ixs(nixs,n)
524#include "lockoff.inc"
525 GOTO 100
526 END IF
527 ELSE
528 nn = -jnod
529 IF(nint(xsphr(14,nn))/=ipartsp(np))THEN
530C
531C Solid will be deleted at next cycle
532 gbuf%OFF(i)=four_over_5
533 idel7nok=1
534#include "lockon.inc"
535 WRITE(iout,5000) ixs(nixs,n)
536 WRITE(istdo,5000) ixs(nixs,n)
537#include "lockoff.inc"
538 GOTO 100
539 END IF
540 END IF
541 END DO
542 END DO
543 END IF
544 100 CONTINUE
545 ENDDO
546C-----
547 ELSEIF (itsol2sph==2) THEN
548C Deactivation of solid element if id of subset is different
549C-----
550 DO i=lft,llt
551 IF(gbuf%OFF(i)/=zero) THEN
552 n=nft+i
553 DO kp=1,sol2sph(2,n)-sol2sph(1,n)
554 np=sol2sph(1,n)+kp
555 inod=kxsp(3,np)
556 nvois=kxsp(4,np)
557 DO j=1,nvois
558 jnod=ixsp(j,np)
559 IF(jnod>0)THEN
560 m=nod2sp(jnod)
561 IF((ipart(3,ipartsp(m))/=ipart(3,ipartsp(np))).OR.
562 . (((ipart(3,ipartsp(m))+ipart(3,ipartsp(np)))==2*nsubs).
563 . and.(ipartsp(m)/=ipartsp(np)))) THEN
564C
565C Solid will be deleted at next cycle
566 gbuf%OFF(i)=four_over_5
567 idel7nok=1
568#include "lockon.inc"
569 WRITE(iout,6000) ixs(nixs,n)
570 WRITE(istdo,6000) ixs(nixs,n)
571#include "lockoff.inc"
572 GOTO 200
573 END IF
574 ELSE
575 nn = -jnod
576 IF((ipart(3,nint(xsphr(14,nn)))/=ipart(3,ipartsp(np))).OR.
577 . (((ipart(3,ipartsp(np))+ipart(3,nint(xsphr(14,nn)))==2*nsubs).
578 . and.(nint(xsphr(14,nn))/=ipartsp(np))))) THEN
579C
580C Solid will be deleted at next cycle
581 gbuf%OFF(i)=four_over_5
582 idel7nok=1
583#include "lockon.inc"
584 WRITE(iout,6000) ixs(nixs,n)
585 WRITE(istdo,6000) ixs(nixs,n)
586#include "lockoff.inc"
587 GOTO 200
588 END IF
589 END IF
590 END DO
591 END DO
592 END IF
593 200 CONTINUE
594 ENDDO
595C-----
596 ENDIF
597C-----
598 END IF
599 END DO
600 IF (iddw>0) CALL stoptimeg(ng)
601C--------
602 50 CONTINUE
603 END DO
604!$OMP END DO
605C-----------------------------------------------
606 5000 FORMAT(
607 & ' -- PARTICLE INTERACTING W/OTHER SPH PART',
608 . ' => DELETE SOLID ELEMENT AT NEXT CYCLE',i10)
609 6000 FORMAT(
610 & ' -- PARTICLE INTERACTING W/OTHER SPH PART OR SUBSET',
611 . ' => DELETE SOLID ELEMENT AT NEXT CYCLE',i10)
612C-----------------------------------------------
613 RETURN