OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
soltosph.F File Reference
#include "implicit_f.inc"
#include "sphcom.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine soltosphx8 (nsphdir, ncell, inod, ids, idmax, x, ixs, kxsp, ipartsp, nod2sp, irst)
subroutine soltosphx4 (nsphdir, ncell, inod, ids, idmax, x, ixs, kxsp, ipartsp, nod2sp, irst)
subroutine soltosphv8 (nsphdir, rho, ncell, x, spbuf, ixs, kxsp, ipartsp, irst)
subroutine soltosphv4 (nsphdir, rho, ncell, x, spbuf, ixs)

Function/Subroutine Documentation

◆ soltosphv4()

subroutine soltosphv4 ( integer nsphdir,
rho,
integer ncell,
x,
spbuf,
integer, dimension(nixs) ixs )

Definition at line 585 of file soltosph.F.

588C-----------------------------------------------
589 USE message_mod
590C-----------------------------------------------
591C I m p l i c i t T y p e s
592C-----------------------------------------------
593#include "implicit_f.inc"
594C-----------------------------------------------
595C C o m m o n B l o c k s
596C-----------------------------------------------
597#include "sphcom.inc"
598C-----------------------------------------------
599C D u m m y A r g u m e n t s
600C-----------------------------------------------
601 INTEGER NSPHDIR, NCELL, IXS(NIXS)
602 my_real
603 . rho, x(3,*), spbuf(nspbuf,*)
604C-----------------------------------------------
605C L o c a l V a r i a b l e s
606C-----------------------------------------------
607 INTEGER IT,IP,N1, N2, N3, N4, NT, NP
608C
609 my_real
610 . x1,x2,x3,x4,
611 . y1,y2,y3,y4,
612 . z1,z2,z3,z4,
613 . vol, det, wi,
614 . jac1 ,jac2 ,jac3 ,
615 . jac4 ,jac5 ,jac6 ,
616 . jac7 ,jac8 ,jac9 ,
617 . jac_59_68, jac_67_49, jac_48_57
618C-----------------------------------------------
619 np = 0
620 nt = 0
621 DO it=1,nsphdir
622 nt=nt+it
623 np=np+nt
624 END DO
625C-----------------------------------------------
626 n1=ixs(2)
627 x1=x(1,n1)
628 y1=x(2,n1)
629 z1=x(3,n1)
630 n2=ixs(4)
631 x2=x(1,n2)
632 y2=x(2,n2)
633 z2=x(3,n2)
634 n3=ixs(7)
635 x3=x(1,n3)
636 y3=x(2,n3)
637 z3=x(3,n3)
638 n4=ixs(6)
639 x4=x(1,n4)
640 y4=x(2,n4)
641 z4=x(3,n4)
642C
643C Jacobian matrix
644 jac1=x1-x4
645 jac2=y1-y4
646 jac3=z1-z4
647 jac4=x2-x4
648 jac5=y2-y4
649 jac6=z2-z4
650 jac7=x3-x4
651 jac8=y3-y4
652 jac9=z3-z4
653C
654 jac_59_68=jac5*jac9-jac6*jac8
655 jac_67_49=jac6*jac7-jac4*jac9
656 jac_48_57=jac4*jac8-jac5*jac7
657C
658 det=jac1*jac_59_68+jac2*jac_67_49+jac3*jac_48_57
659C-----------------------------------------------
660 DO ip=1,ncell
661C
662 wi = one/(six*np)
663C
664 vol= wi*det
665 IF(det<zero)
666 . CALL ancmsg(msgid=1038,
667 . msgtype=msgerror,
668 . anmode=aninfo,
669 . i1=ixs(nixs))
670C
671C Particle volume will be replaced by particle mass later (spinit3)
672 spbuf(2,ip) =vol*rho
673 spbuf(12,ip)=vol
674C
675 ENDDO
676C-----------------------------------------------
677 RETURN
my_real
#define my_real
Definition cppsort.cpp:32
message_mod
Definition message_mod.F:1249
ancmsg
subroutine ancmsg(msgid, msgtype, anmode, i1, i2, i3, i4, i5, i6, i7, i8, i9, i10, i11, i12, i13, i14, i15, i16, i17, i18, i19, i20, r1, r2, r3, r4, r5, r6, r7, r8, r9, c1, c2, c3, c4, c5, c6, c7, c8, c9, prmode)
Definition message.F:889

◆ soltosphv8()

subroutine soltosphv8 ( integer nsphdir,
rho,
integer ncell,
x,
spbuf,
integer, dimension(nixs) ixs,
integer, dimension(nisp,*) kxsp,
integer, dimension(*) ipartsp,
integer, dimension(3,*) irst )

Definition at line 333 of file soltosph.F.

336C-----------------------------------------------
337C M o d u l e s
338C-----------------------------------------------
339 USE message_mod
340C-----------------------------------------------
341C I m p l i c i t T y p e s
342C-----------------------------------------------
343#include "implicit_f.inc"
344C-----------------------------------------------
345C G l o b a l P a r a m e t e r s
346C-----------------------------------------------
347C C o m m o n B l o c k s
348C-----------------------------------------------
349#include "sphcom.inc"
350C-----------------------------------------------
351C D u m m y A r g u m e n t s
352C-----------------------------------------------
353 INTEGER NSPHDIR, NCELL, IXS(NIXS), KXSP(NISP,*),
354 . IPARTSP(*), IRST(3,*)
355 my_real
356 . rho, x(3,*), spbuf(nspbuf,*)
357C-----------------------------------------------
358C L o c a l V a r i a b l e s
359C-----------------------------------------------
360 INTEGER I, J, IR, IS, IT, IP,
361 . N1, N2, N3, N4, N5, N6, N7, N8, NP
362C
363 my_real
364 . x1,x2,x3,x4,x5,x6,x7,x8,
365 . y1,y2,y3,y4,y5,y6,y7,y8,
366 . z1,z2,z3,z4,z5,z6,z7,z8,
367 . x17 , x28 , x35 , x46 ,
368 . y17 , y28 , y35 , y46 ,
369 . z17 , z28 , z35 , z46 ,
370 . vol, hx(4), hy(4), hz(4), det,
371 . jac1 ,jac2 ,jac3 ,
372 . jac4 ,jac5 ,jac6 ,
373 . jac7 ,jac8 ,jac9 ,
374 . cj1 ,cj2 ,cj3 ,
375 . cj4 ,cj5 ,cj6 ,
376 . cj7 ,cj8 ,cj9 ,
377 . jac_59_68, jac_67_49, jac_48_57,
378 . jac_38_29, jac_19_37, jac_27_18,
379 . jac_26_35, jac_34_16, jac_15_24,
380 . x_17_46 , x_28_35 ,
381 . y_17_46 , y_28_35 ,
382 . z_17_46 , z_28_35 ,
383 . ksi, eta, zeta, wi,
384 . xi, yi, zi
385C-----------------------------------------------
386 my_real
387 . w_gauss(9,9),a_gauss(9,9)
388 DATA w_gauss /
389 1 2. ,0. ,0. ,
390 1 0. ,0. ,0. ,
391 1 0. ,0. ,0. ,
392 2 1. ,1. ,0. ,
393 2 0. ,0. ,0. ,
394 2 0. ,0. ,0. ,
395 3 0.555555555555556,0.888888888888889,0.555555555555556,
396 3 0. ,0. ,0. ,
397 3 0. ,0. ,0. ,
398 4 0.347854845137454,0.652145154862546,0.652145154862546,
399 4 0.347854845137454,0. ,0. ,
400 4 0. ,0. ,0. ,
401 5 0.236926885056189,0.478628670499366,0.568888888888889,
402 5 0.478628670499366,0.236926885056189,0. ,
403 5 0. ,0. ,0. ,
404 6 0.171324492379170,0.360761573048139,0.467913934572691,
405 6 0.467913934572691,0.360761573048139,0.171324492379170,
406 6 0. ,0. ,0. ,
407 7 0.129484966168870,0.279705391489277,0.381830050505119,
408 7 0.417959183673469,0.381830050505119,0.279705391489277,
409 7 0.129484966168870,0. ,0. ,
410 8 0.101228536290376,0.222381034453374,0.313706645877887,
411 8 0.362683783378362,0.362683783378362,0.313706645877887,
412 8 0.222381034453374,0.101228536290376,0. ,
413 9 0.081274388361574,0.180648160694857,0.260610696402935,
414 9 0.312347077040003,0.330239355001260,0.312347077040003,
415 9 0.260610696402935,0.180648160694857,0.081274388361574/
416 DATA a_gauss /
417 1 0. ,0. ,0. ,
418 1 0. ,0. ,0. ,
419 1 0. ,0. ,0. ,
420 2 -.5 ,0.5 ,0. ,
421 2 0. ,0. ,0. ,
422 2 0. ,0. ,0. ,
423 3 -.666666666666666,0. ,0.666666666666666,
424 3 0. ,0. ,0. ,
425 3 0. ,0. ,0. ,
426 4 -.75 ,-.25 ,0.25 ,
427 4 0.75 ,0. ,0. ,
428 4 0. ,0. ,0. ,
429 5 -.8 ,-.4 ,0. ,
430 5 0.4 ,0.8 ,0. ,
431 5 0. ,0. ,0. ,
432 6 -.833333333333333,-.5 ,-.166666666666666,
433 6 0.166666666666666,0.5 ,0.833333333333333,
434 6 0. ,0. ,0. ,
435 7 -.857142857142857,-.571428571428571,-.285714285714285,
436 7 0. ,0.285714285714285,0.571428571428571,
437 7 0.857142857142857,0. ,0. ,
438 8 -.875 ,-.625 ,-.375 ,
439 8 -.125 ,0.125 ,0.375,
440 8 0.625 ,0.875 ,0. ,
441 9 -.888888888888888,-.666666666666666,-.444444444444444,
442 9 -.222222222222222,0. ,0.222222222222222,
443 9 0.444444444444444,0.666666666666666,0.888888888888888/
444C-----------------------------------------------
445 np = nsphdir*nsphdir*nsphdir
446C
447 n1=ixs(2)
448 x1=x(1,n1)
449 y1=x(2,n1)
450 z1=x(3,n1)
451 n2=ixs(3)
452 x2=x(1,n2)
453 y2=x(2,n2)
454 z2=x(3,n2)
455 n3=ixs(4)
456 x3=x(1,n3)
457 y3=x(2,n3)
458 z3=x(3,n3)
459 n4=ixs(5)
460 x4=x(1,n4)
461 y4=x(2,n4)
462 z4=x(3,n4)
463 n5=ixs(6)
464 x5=x(1,n5)
465 y5=x(2,n5)
466 z5=x(3,n5)
467 n6=ixs(7)
468 x6=x(1,n6)
469 y6=x(2,n6)
470 z6=x(3,n6)
471 n7=ixs(8)
472 x7=x(1,n7)
473 y7=x(2,n7)
474 z7=x(3,n7)
475 n8=ixs(9)
476 x8=x(1,n8)
477 y8=x(2,n8)
478 z8=x(3,n8)
479C
480 x17=x7-x1
481 x28=x8-x2
482 x35=x5-x3
483 x46=x6-x4
484 y17=y7-y1
485 y28=y8-y2
486 y35=y5-y3
487 y46=y6-y4
488 z17=z7-z1
489 z28=z8-z2
490 z35=z5-z3
491 z46=z6-z4
492C
493C Jacobian matrix
494 cj4=x17+x28-x35-x46
495 cj5=y17+y28-y35-y46
496 cj6=z17+z28-z35-z46
497 x_17_46=x17+x46
498 x_28_35=x28+x35
499 y_17_46=y17+y46
500 y_28_35=y28+y35
501 z_17_46=z17+z46
502 z_28_35=z28+z35
503C
504 cj7=x_17_46+x_28_35
505 cj8=y_17_46+y_28_35
506 cj9=z_17_46+z_28_35
507 cj1=x_17_46-x_28_35
508 cj2=y_17_46-y_28_35
509 cj3=z_17_46-z_28_35
510C Hourglass
511C mode 1
512C 1 1 -1 -1 -1 -1 1 1
513 hx(1)=(x1+x2-x3-x4-x5-x6+x7+x8)
514 hy(1)=(y1+y2-y3-y4-y5-y6+y7+y8)
515 hz(1)=(z1+z2-z3-z4-z5-z6+z7+z8)
516C mode 2
517C 1 -1 -1 1 -1 1 1 -1
518 hx(2)=(x1-x2-x3+x4-x5+x6+x7-x8)
519 hy(2)=(y1-y2-y3+y4-y5+y6+y7-y8)
520 hz(2)=(z1-z2-z3+z4-z5+z6+z7-z8)
521C mode 3
522C 1 -1 1 -1 1 -1 1 -1
523 hx(3)=(x1-x2+x3-x4+x5-x6+x7-x8)
524 hy(3)=(y1-y2+y3-y4+y5-y6+y7-y8)
525 hz(3)=(z1-z2+z3-z4+z5-z6+z7-z8)
526C mode 4
527C -1 1 -1 1 1 -1 1 -1
528 hx(4)=(-x1+x2-x3+x4+x5-x6+x7-x8)
529 hy(4)=(-y1+y2-y3+y4+y5-y6+y7-y8)
530 hz(4)=(-z1+z2-z3+z4+z5-z6+z7-z8)
531C-----------------------------------------------
532 DO ip=1,ncell
533 ir=irst(1,ip)
534 is=irst(2,ip)
535 it=irst(3,ip)
536C
537 ksi = a_gauss(it,nsphdir)
538 eta = a_gauss(ir,nsphdir)
539 zeta = a_gauss(is,nsphdir)
540C
541 wi = eight/np
542C
543C Jacobian matrix
544 jac1=cj1+hx(3)*eta+(hx(2)+hx(4)*eta)*zeta
545 jac2=cj2+hy(3)*eta+(hy(2)+hy(4)*eta)*zeta
546 jac3=cj3+hz(3)*eta+(hz(2)+hz(4)*eta)*zeta
547C
548 jac4=cj4+hx(1)*zeta+(hx(3)+hx(4)*zeta)*ksi
549 jac5=cj5+hy(1)*zeta+(hy(3)+hy(4)*zeta)*ksi
550 jac6=cj6+hz(1)*zeta+(hz(3)+hz(4)*zeta)*ksi
551C
552 jac7=cj7+hx(2)*ksi+(hx(1)+hx(4)*ksi)*eta
553 jac8=cj8+hy(2)*ksi+(hy(1)+hy(4)*ksi)*eta
554 jac9=cj9+hz(2)*ksi+(hz(1)+hz(4)*ksi)*eta
555C
556 jac_59_68=jac5*jac9-jac6*jac8
557 jac_67_49=jac6*jac7-jac4*jac9
558 jac_48_57=jac4*jac8-jac5*jac7
559C
560 det=one_over_512*(jac1*jac_59_68+jac2*jac_67_49+jac3*jac_48_57)
561 vol= wi*det
562 IF(det<zero)
563 . CALL ancmsg(msgid=1038,
564 . msgtype=msgerror,
565 . anmode=aninfo,
566 . i1=ixs(nixs))
567C
568C Particle volume will be replaced by particle mass later (spinit3)
569 spbuf(2,ip) =vol*rho
570 spbuf(12,ip)=vol
571C
572 ENDDO
573C-----------------------------------------------
574 RETURN

◆ soltosphx4()

subroutine soltosphx4 ( integer nsphdir,
integer ncell,
integer inod,
integer ids,
integer idmax,
x,
integer, dimension(nixs) ixs,
integer, dimension(nisp,*) kxsp,
integer, dimension(*) ipartsp,
integer, dimension(*) nod2sp,
integer, dimension(3,*) irst )

Definition at line 185 of file soltosph.F.

189C-----------------------------------------------
190C M o d u l e s
191C-----------------------------------------------
192 USE message_mod
193C-----------------------------------------------
194C I m p l i c i t T y p e s
195C-----------------------------------------------
196#include "implicit_f.inc"
197C-----------------------------------------------
198C G l o b a l P a r a m e t e r s
199C-----------------------------------------------
200C C o m m o n B l o c k s
201C-----------------------------------------------
202#include "sphcom.inc"
203C-----------------------------------------------
204C D u m m y A r g u m e n t s
205C-----------------------------------------------
206 INTEGER NSPHDIR, NCELL, INOD, IDS, IDMAX, IXS(NIXS),
207 . KXSP(NISP,*), IPARTSP(*), NOD2SP(*), IRST(3,*)
208 my_real
209 . x(3,*)
210C-----------------------------------------------
211C L o c a l V a r i a b l e s
212C-----------------------------------------------
213 INTEGER IR, IS, IT,N1,N2,N3,N4
214C
215 my_real
216 . x1,x2,x3,x4,y1,y2,y3,y4,
217 . z1,z2,z3,z4,phi1,phi2,phi3,phi4,ksi,
218 . eta,zeta,xi,yi,zi,a_gauss_tetra(9,9)
219C-----------------------------------------------
220C E x t e r n a l F u n c t i o n s
221C-----------------------------------------------
222 my_real
223 . checkvolume_4n
224C-----------------------------------------------
225C A_GAUSS Generated with (2*IR-1)/(2(NSPHDIR+1))
226C-----------------------------------------------
227 DATA a_gauss_tetra /
228 1 0.250000000000000,0.000000000000000,0.000000000000000,
229 1 0.000000000000000,0.000000000000000,0.000000000000000,
230 1 0.000000000000000,0.000000000000000,0.000000000000000,
231 2 0.166666666666667,0.500000000000000,0.000000000000000,
232 2 0.000000000000000,0.000000000000000,0.000000000000000,
233 2 0.000000000000000,0.000000000000000,0.000000000000000,
234 3 0.125000000000000,0.375000000000000,0.625000000000000,
235 3 0.000000000000000,0.000000000000000,0.000000000000000,
236 3 0.000000000000000,0.000000000000000,0.000000000000000,
237 4 0.100000000000000,0.300000000000000,0.500000000000000,
238 4 0.700000000000000,0.000000000000000,0.000000000000000,
239 4 0.000000000000000,0.000000000000000,0.000000000000000,
240 5 0.083333333333333,0.250000000000000,0.416666666666667,
241 5 0.583333333333333,0.750000000000000,0.000000000000000,
242 5 0.000000000000000,0.000000000000000,0.000000000000000,
243 6 0.071428571428571,0.214285714285714,0.357142857142857,
244 6 0.500000000000000,0.642857142857143,0.785714285714286,
245 6 0.000000000000000,0.000000000000000,0.000000000000000,
246 7 0.062500000000000,0.187500000000000,0.312500000000000,
247 7 0.437500000000000,0.562500000000000,0.687500000000000,
248 7 0.812500000000000,0.000000000000000,0.000000000000000,
249 8 0.055555555555556,0.166666666666667,0.277777777777778,
250 8 0.388888888888889,0.500000000000000,0.611111111111111,
251 8 0.722222222222222,0.833333333333333,0.000000000000000,
252 9 0.050000000000000,0.150000000000000,0.250000000000000,
253 9 0.350000000000000,0.450000000000000,0.550000000000000,
254 9 0.650000000000000,0.750000000000000,0.850000000000000/
255C-----------------------------------------------
256C---- KSI - R - N4->N1
257C---- ETA - S - N4->N2
258C---- ZETA- T - N4->N3
259C-----------------------------------------------
260 n1=ixs(2)
261 x1=x(1,n1)
262 y1=x(2,n1)
263 z1=x(3,n1)
264 n2=ixs(4)
265 x2=x(1,n2)
266 y2=x(2,n2)
267 z2=x(3,n2)
268 n3=ixs(7)
269 x3=x(1,n3)
270 y3=x(2,n3)
271 z3=x(3,n3)
272 n4=ixs(6)
273 x4=x(1,n4)
274 y4=x(2,n4)
275 z4=x(3,n4)
276
277C------------------------------------------------
278C Renumber tetrahedron in case of negative volume
279 IF (checkvolume_4n(x ,ixs(1)) < zero) THEN
280 n2=ixs(6)
281 n4=ixs(4)
282 ENDIF
283C-----------------------------------------------
284 DO ir=1,nsphdir
285 DO is=1,nsphdir-ir+1
286 DO it=1,nsphdir-is-ir+2
287C
288 ksi = a_gauss_tetra(ir,nsphdir)
289 eta = a_gauss_tetra(is,nsphdir)
290 zeta = a_gauss_tetra(it,nsphdir)
291C
292 phi1=ksi
293 phi2=eta
294 phi3=zeta
295 phi4=one-ksi-eta-zeta
296C
297 xi=phi1*x1+phi2*x2+phi3*x3+phi4*x4
298 yi=phi1*y1+phi2*y2+phi3*y3+phi4*y4
299 zi=phi1*z1+phi2*z2+phi3*z3+phi4*z4
300C
301 ncell=ncell+1
302 ipartsp(ncell)=ids
303 inod =inod+1
304 kxsp(3,ncell) =inod
305 x(1,inod)=xi
306 x(2,inod)=yi
307 x(3,inod)=zi
308 nod2sp(inod) =ncell
309 kxsp(2,ncell)=-1
310 idmax=idmax+1
311 kxsp(nisp,ncell)=idmax
312 irst(1,ncell-first_sphsol+1)=ir
313 irst(2,ncell-first_sphsol+1)=is
314 irst(3,ncell-first_sphsol+1)=it
315C
316 ENDDO
317 ENDDO
318 ENDDO
319C
320C-----------------------------------------------
321 RETURN
checkvolume_4n
function checkvolume_4n(x, ixs)
Definition checksvolume.F:212

◆ soltosphx8()

subroutine soltosphx8 ( integer nsphdir,
integer ncell,
integer inod,
integer ids,
integer idmax,
x,
integer, dimension(nixs) ixs,
integer, dimension(nisp,*) kxsp,
integer, dimension(*) ipartsp,
integer, dimension(*) nod2sp,
integer, dimension(3,*) irst )

Definition at line 30 of file soltosph.F.

34C-----------------------------------------------
35C M o d u l e s
36C-----------------------------------------------
37 USE message_mod
38C-----------------------------------------------
39C I m p l i c i t T y p e s
40C-----------------------------------------------
41#include "implicit_f.inc"
42C-----------------------------------------------
43C G l o b a l P a r a m e t e r s
44C-----------------------------------------------
45C C o m m o n B l o c k s
46C-----------------------------------------------
47#include "sphcom.inc"
48C-----------------------------------------------
49C D u m m y A r g u m e n t s
50C-----------------------------------------------
51 INTEGER NSPHDIR, NCELL, INOD, IDS, IDMAX, IXS(NIXS),
52 . KXSP(NISP,*), IPARTSP(*), NOD2SP(*), IRST(3,*)
53 my_real
54 . x(3,*)
55C-----------------------------------------------
56C L o c a l V a r i a b l e s
57C-----------------------------------------------
58 INTEGER I, J, IR, IS, IT,
59 . N1, N2, N3, N4, N5, N6, N7, N8
60C 12
61 my_real
62 . x1,x2,x3,x4,x5,x6,x7,x8,
63 . y1,y2,y3,y4,y5,y6,y7,y8,
64 . z1,z2,z3,z4,z5,z6,z7,z8,
65 . phi1,phi2,phi3,phi4,phi5,phi6,phi7,phi8,
66 . ksi, eta, zeta, wi,
67 . xi, yi, zi
68C-----------------------------------------------
69 my_real
70 . a_gauss(9,9)
71 DATA a_gauss /
72 1 0. ,0. ,0. ,
73 1 0. ,0. ,0. ,
74 1 0. ,0. ,0. ,
75 2 -.5 ,0.5 ,0. ,
76 2 0. ,0. ,0. ,
77 2 0. ,0. ,0. ,
78 3 -.666666666666666,0. ,0.666666666666666,
79 3 0. ,0. ,0. ,
80 3 0. ,0. ,0. ,
81 4 -.75 ,-.25 ,0.25 ,
82 4 0.75 ,0. ,0. ,
83 4 0. ,0. ,0. ,
84 5 -.8 ,-.4 ,0. ,
85 5 0.4 ,0.8 ,0. ,
86 5 0. ,0. ,0. ,
87 6 -.833333333333333,-.5 ,-.166666666666666,
88 6 0.166666666666666,0.5 ,0.833333333333333,
89 6 0. ,0. ,0. ,
90 7 -.857142857142857,-.571428571428571,-.285714285714285,
91 7 0. ,0.285714285714285,0.571428571428571,
92 7 0.857142857142857,0. ,0. ,
93 8 -.875 ,-.625 ,-.375 ,
94 8 -.125 ,0.125 ,0.375,
95 8 0.625 ,0.875 ,0. ,
96 9 -.888888888888888,-.666666666666666,-.444444444444444,
97 9 -.222222222222222,0. ,0.222222222222222,
98 9 0.444444444444444,0.666666666666666,0.888888888888888/
99C-----------------------------------------------
100 n1=ixs(2)
101 x1=x(1,n1)
102 y1=x(2,n1)
103 z1=x(3,n1)
104 n2=ixs(3)
105 x2=x(1,n2)
106 y2=x(2,n2)
107 z2=x(3,n2)
108 n3=ixs(4)
109 x3=x(1,n3)
110 y3=x(2,n3)
111 z3=x(3,n3)
112 n4=ixs(5)
113 x4=x(1,n4)
114 y4=x(2,n4)
115 z4=x(3,n4)
116 n5=ixs(6)
117 x5=x(1,n5)
118 y5=x(2,n5)
119 z5=x(3,n5)
120 n6=ixs(7)
121 x6=x(1,n6)
122 y6=x(2,n6)
123 z6=x(3,n6)
124 n7=ixs(8)
125 x7=x(1,n7)
126 y7=x(2,n7)
127 z7=x(3,n7)
128 n8=ixs(9)
129 x8=x(1,n8)
130 y8=x(2,n8)
131 z8=x(3,n8)
132C-----------------------------------------------
133 DO ir=1,nsphdir
134 DO is=1,nsphdir
135 DO it=1,nsphdir
136 ksi = a_gauss(ir,nsphdir)
137 eta = a_gauss(is,nsphdir)
138 zeta = a_gauss(it,nsphdir)
139C
140 phi1=(one-ksi)*(one-eta)*(one-zeta)
141 phi2=(one-ksi)*(one-eta)*(one+zeta)
142 phi3=(one+ksi)*(one-eta)*(one+zeta)
143 phi4=(one+ksi)*(one-eta)*(one-zeta)
144 phi5=(one-ksi)*(one+eta)*(one-zeta)
145 phi6=(one-ksi)*(one+eta)*(one+zeta)
146 phi7=(one+ksi)*(one+eta)*(one+zeta)
147 phi8=(one+ksi)*(one+eta)*(one-zeta)
148 xi=one_over_8*(phi1*x1+phi2*x2+phi3*x3+phi4*x4+
149 . phi5*x5+phi6*x6+phi7*x7+phi8*x8)
150 yi=one_over_8*(phi1*y1+phi2*y2+phi3*y3+phi4*y4+
151 . phi5*y5+phi6*y6+phi7*y7+phi8*y8)
152 zi=one_over_8*(phi1*z1+phi2*z2+phi3*z3+phi4*z4+
153 . phi5*z5+phi6*z6+phi7*z7+phi8*z8)
154C
155 ncell=ncell+1
156 ipartsp(ncell)=ids
157 inod =inod+1
158 kxsp(3,ncell) =inod
159 x(1,inod)=xi
160 x(2,inod)=yi
161 x(3,inod)=zi
162 nod2sp(inod) =ncell
163 kxsp(2,ncell)=-1
164 idmax=idmax+1
165 kxsp(nisp,ncell)=idmax
166 irst(1,ncell-first_sphsol+1)=ir
167 irst(2,ncell-first_sphsol+1)=is
168 irst(3,ncell-first_sphsol+1)=it
169C
170 ENDDO
171 ENDDO
172 ENDDO
173C-----------------------------------------------
174 RETURN