dxyzsph.F File Reference

#include "implicit_f.inc"
#include "sphcom.inc"

Go to the source code of this file.

Functions/Subroutines
subroutine	dxyzsph (nesph, kxsp, x, spbuf, snnsphg, nnsph)

Function/Subroutine Documentation

dxyzsph()

subroutine dxyzsph	(	integer	nesph,
		integer, dimension(nisp,*)	kxsp,
			x,
			spbuf,
		integer	snnsphg,
		integer	nnsph )

Definition at line 29 of file dxyzsph.F.

C-----------------------------------------------
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include      "implicit_f.inc"
C-----------------------------------------------
C   C o m m o n   B l o c k s
C-----------------------------------------------
#include      "sphcom.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER NESPH, KXSP(NISP,*),SNNSPHG,NNSPH
      my_real
     .  x(3,*),spbuf(nspbuf,*)
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER N, J, INOD,CNT,BUF
      my_real
     3   xi,yi,zi,r,
     4   xq(3),fact
      REAL R4,R4NP(3*NNSPH)
C-----------------------------------------------
      IF (numsph+maxpjet==0) GOTO 100
C-----------------------------------------------
      cnt = 0
      fact =(three/(four*sqrt(two)))**third
      DO 200 n=1,numsph+maxpjet
         inod=kxsp(3,n)
         xi  =x(1,inod)
         yi  =x(2,inod)
         zi  =x(3,inod)
           r   = spbuf(1,n)*fact
           xq(1) =xi+r
           xq(2) =yi-r
           xq(3) =zi-r
           DO j=1,3
            r4 = xq(j)
            CALL write_r_c(r4,1)
           ENDDO
           xq(1) =xi-r
           xq(2) =yi+r
           xq(3) =zi-r
           DO j=1,3
             r4 = xq(j)
           CALL write_r_c(r4,1)
           ENDDO
           xq(1) =xi-r
           xq(2) =yi-r
           xq(3) =zi+r
           DO j=1,3
            r4 = xq(j)
            CALL write_r_c(r4,1)
           ENDDO
          xq(1) =xi+r
          xq(2) =yi+r
          xq(3) =zi+r
           DO j=1,3
            r4 = xq(j)
            CALL write_r_c(r4,1)
           ENDDO
 200   CONTINUE
 100  CONTINUE
C-------------------------------------------------------
      RETURN