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 36 of file soltosph_on1.F.

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
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
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 427 of file soltosph_on1.F.

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