OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
dsphnor.F File Reference
#include "implicit_f.inc"
#include "sphcom.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 29 of file dsphnor.F.

30C-----------------------------------------------
31C I m p l i c i t T y p e s
32C-----------------------------------------------
33#include "implicit_f.inc"
34C-----------------------------------------------
35C C o m m o n B l o c k s
36C-----------------------------------------------
37#include "sphcom.inc"
38C-----------------------------------------------
39C D u m m y A r g u m e n t s
40C-----------------------------------------------
41 INTEGER KXSP(NISP,*),NNSPH
42 my_real
43 . x(3,*),spbuf(*)
44C-----------------------------------------------
45C L o c a l V a r i a b l e s
46C-----------------------------------------------
47 INTEGER I3000,NXX,NYY,NZZ
48 INTEGER N, J, INOD
49 INTEGER INP(NNSPH*3),CNT,LRECV
50 my_real
51 3 xi,yi,zi,r,nx,ny,nz,normn,
52 4 xq(3)
53C-----------------------------------------------
54 IF (numsph+maxpjet==0) GOTO 100
55C-----------------------------------------------
56 i3000 = 3000
57 cnt = 0
58C
59 DO 200 n=1,numsph+maxpjet
60 inod=kxsp(3,n)
61 xi =x(1,inod)
62 yi =x(2,inod)
63 zi =x(3,inod)
64 nx= one
65 ny=-one
66 nz=-one
67 normn=sqrt(nx**2+ny**2+nz**2)
68 IF (normn==zero) THEN
69 nx=three1000
70 ny=three1000
71 nz=three1000
72 ELSE
73 nx=three1000*nx/normn
74 ny=three1000*ny/normn
75 nz=three1000*nz/normn
76 ENDIF
77 CALL write_s_c(nint(nx),1)
78 CALL write_s_c(nint(ny),1)
79 CALL write_s_c(nint(nz),1)
80 nx=-one
81 ny= one
82 nz=-one
83 normn=sqrt(nx**2+ny**2+nz**2)
84 IF (normn==zero) THEN
85 nx=three1000
86 ny=three1000
87 nz=three1000
88 ELSE
89 nx=three1000*nx/normn
90 ny=three1000*ny/normn
91 nz=three1000*nz/normn
92 ENDIF
93 CALL write_s_c(nint(nx),1)
94 CALL write_s_c(nint(ny),1)
95 CALL write_s_c(nint(nz),1)
96 nx=-one
97 ny=-one
98 nz= one
99 normn=sqrt(nx**2+ny**2+nz**2)
100 IF (normn==zero) THEN
101 nx=three1000
102 ny=three1000
103 nz=three1000
104 ELSE
105 nx=three1000*nx/normn
106 ny=three1000*ny/normn
107 nz=three1000*nz/normn
108 ENDIF
109 CALL write_s_c(nint(nx),1)
110 CALL write_s_c(nint(ny),1)
111 CALL write_s_c(nint(nz),1)
112 nx= one
113 ny= one
114 nz= one
115 normn=sqrt(nx**2+ny**2+nz**2)
116 IF (normn==zero) THEN
117 nx=three1000
118 ny=three1000
119 nz=three1000
120 ELSE
121 nx=three1000*nx/normn
122 ny=three1000*ny/normn
123 nz=three1000*nz/normn
124 ENDIF
125 CALL write_s_c(nint(nx),1)
126 CALL write_s_c(nint(ny),1)
127 CALL write_s_c(nint(nz),1)
128 200 CONTINUE
129 100 CONTINUE
130C
131 RETURN
my_real
#define my_real
Definition cppsort.cpp:32
write_s_c
void write_s_c(int *w, int *len)
Definition write_routtines.c:687