OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
dsphnor.F
Go to the documentation of this file.
1Copyright> OpenRadioss
2Copyright> Copyright (C) 1986-2025 Altair Engineering Inc.
3Copyright>
4Copyright> This program is free software: you can redistribute it and/or modify
5Copyright> it under the terms of the GNU Affero General Public License as published by
6Copyright> the Free Software Foundation, either version 3 of the License, or
7Copyright> (at your option) any later version.
8Copyright>
9Copyright> This program is distributed in the hope that it will be useful,
10Copyright> but WITHOUT ANY WARRANTY; without even the implied warranty of
11Copyright> MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12Copyright> GNU Affero General Public License for more details.
13Copyright>
14Copyright> You should have received a copy of the GNU Affero General Public License
15Copyright> along with this program. If not, see <https://www.gnu.org/licenses/>.
16Copyright>
17Copyright>
18Copyright> Commercial Alternative: Altair Radioss Software
19Copyright>
20Copyright> As an alternative to this open-source version, Altair also offers Altair Radioss
21Copyright> software under a commercial license. Contact Altair to discuss further if the
22Copyright> commercial version may interest you: https://www.altair.com/radioss/.
23!||====================================================================
24!|| dsphnor ../starter/source/output/anim/dsphnor.F
25!||--- called by ------------------------------------------------------
26!|| genani1 ../starter/source/output/anim/genani1.F
27!||--- calls -----------------------------------------------------
28!||====================================================================
29 SUBROUTINE dsphnor(KXSP,X,SPBUF,NNSPH)
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
132 END
my_real
#define my_real
Definition cppsort.cpp:32
dsphnor
subroutine dsphnor(kxsp, x, spbuf, nnsph)
Definition dsphnor.F:30
write_s_c
void write_s_c(int *w, int *len)
Definition write_routtines.c:687