dsphnor.F File Reference

#include "implicit_f.inc"
#include "com01_c.inc"
#include "sphcom.inc"
#include "task_c.inc"

Go to the source code of this file.

Functions/Subroutines
subroutine	dsphnor (kxsp, x, spbuf, nnsph)

Function/Subroutine Documentation

dsphnor()

subroutine dsphnor	(	integer, dimension(nisp,*)	kxsp,
			x,
			spbuf,
		integer	nnsph )

Definition at line 31 of file dsphnor.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      "com01_c.inc"
#include      "sphcom.inc"
#include      "task_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER KXSP(NISP,*),NNSPH
      my_real
     .  x(3,*),spbuf(*)
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I3000,NXX,NYY,NZZ
      INTEGER N, J, INOD
      INTEGER INP(NNSPH*3),CNT,LRECV
      my_real
     3   xi,yi,zi,r,nx,ny,nz,normn,
     4   xq(3)
C-----------------------------------------------
      IF (numsph+maxpjet==0) GOTO 100
C-----------------------------------------------
      i3000 = 3000
      cnt = 0
C
      DO 200 n=1,numsph+maxpjet
        inod=kxsp(3,n)
        xi  =x(1,inod)
        yi  =x(2,inod)
        zi  =x(3,inod)
        nx= one
        ny=-one
        nz=-one         
C        NX= SQRT(2.)
C        NY= SQRT(2.)/SQRT(3.)
C        NZ=-1./SQRT(3.)
        normn=sqrt(nx**2+ny**2+nz**2)
        IF (normn==zero) THEN
         nx=three1000
         ny=three1000
         nz=three1000          
        ELSE
         nx=three1000*nx/normn
         ny=three1000*ny/normn
         nz=three1000*nz/normn          
        ENDIF
        cnt = cnt + 1
        inp(cnt) = nint(nx)
        cnt = cnt + 1
        inp(cnt) = nint(ny)
        cnt = cnt + 1
        inp(cnt) = nint(nz)
        nx=-one
        ny= one
        nz=-one         
        normn=sqrt(nx**2+ny**2+nz**2)
        IF (normn==zero) THEN
          nx=three1000
          ny=three1000
          nz=three1000          
         ELSE
          nx=three1000*nx/normn
          ny=three1000*ny/normn
          nz=three1000*nz/normn          
         ENDIF
         cnt = cnt + 1
         inp(cnt) = nint(nx)
         cnt = cnt + 1
         inp(cnt) = nint(ny)
         cnt = cnt + 1
         inp(cnt) = nint(nz)
         nx=-one
         ny=-one
         nz= one         
         normn=sqrt(nx**2+ny**2+nz**2)
         IF (normn==zero) THEN
          nx=three1000
          ny=three1000
          nz=three1000          
         ELSE
          nx=three1000*nx/normn
          ny=three1000*ny/normn
          nz=three1000*nz/normn          
         ENDIF
         cnt = cnt + 1
         inp(cnt) = nint(nx)
         cnt = cnt + 1
         inp(cnt) = nint(ny)
         cnt = cnt + 1
         inp(cnt) = nint(nz)
         nx= one
         ny= one
         nz= one         
         normn=sqrt(nx**2+ny**2+nz**2)
        IF (normn==zero) THEN
          nx=three1000
          ny=three1000
          nz=three1000          
         ELSE
          nx=three1000*nx/normn
          ny=three1000*ny/normn
          nz=three1000*nz/normn          
         ENDIF
         cnt = cnt + 1
         inp(cnt) = nint(nx)
         cnt = cnt + 1
         inp(cnt) = nint(ny)
         cnt = cnt + 1
         inp(cnt) = nint(nz)
 200   CONTINUE
 100  CONTINUE
      IF (nspmd > 1) THEN
        CALL spmd_igath(inp,cnt,lrecv)
      ELSE
        lrecv = cnt
      END IF
      IF (ispmd==0) THEN
         CALL write_s_c(inp,lrecv)
      ENDIF
 
      RETURN