OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
dnwalc.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!|| dnwalc ../starter/source/output/anim/dnwalc.F
25!||--- called by ------------------------------------------------------
26!|| dsecnor ../starter/source/output/anim/dsecnor.F
27!||--- calls -----------------------------------------------------
28!||====================================================================
29 SUBROUTINE dnwalc(X ,RWL ,MSR )
30C-----------------------------------------------
31C I m p l i c i t T y p e s
32C-----------------------------------------------
33#include "implicit_f.inc"
34C-----------------------------------------------
35C D u m m y A r g u m e n t s
36C-----------------------------------------------
37 INTEGER MSR
38 my_real
39 . x(3,*), rwl(*)
40C-----------------------------------------------
41C L o c a l V a r i a b l e s
42C-----------------------------------------------
43 INTEGER I,J
44 my_real
45 . xwl, ywl, zwl,xn,yn,zn,d,dx,dy,dz,xl, v1, v2, v3, vv1,
46 . vv2, vv3, vv,s,c,xx,yy,zz,alpha,x0,y0,z0
47 REAL R4
48C-----------------------------------------------
49C
50 xn =rwl(1)
51 yn =rwl(2)
52 zn =rwl(3)
53 IF(msr==0)THEN
54 xwl=rwl(4)
55 ywl=rwl(5)
56 zwl=rwl(6)
57 ELSE
58 xwl=x(1,msr)
59 ywl=x(2,msr)
60 zwl=x(3,msr)
61 ENDIF
62C
63 v1 = zero
64 v2 = zep707
65 v3 = zep707
66
67 vv1 = v2 * zn - v3 * yn
68 vv2 = v3 * xn - v1 * zn
69 vv3 = v1 * yn - v2 * xn
70 vv = sqrt(vv1*vv1 + vv2*vv2 + vv3*vv3)
71 IF(vv<=half)THEN
72 v1 = zero
73 v2 = -zep707
74 v3 = zep707
75 vv1 = v2 * zn - v3 * yn
76 vv2 = v3 * xn - v1 * zn
77 vv3 = v1 * yn - v2 * xn
78 vv = sqrt(vv1*vv1 + vv2*vv2 + vv3*vv3)
79 ENDIF
80 vv1 = vv1/vv
81 vv2 = vv2/vv
82 vv3 = vv3/vv
83 v1 = vv2 * zn - vv3 * yn
84 v2 = vv3 * xn - vv1 * zn
85 v3 = vv1 * yn - vv2 * xn
86C
87 alpha = zero
88 DO i=1,24
89 s = sin(alpha)
90 c = cos(alpha)
91 xx = vv1 * s + v1 * c
92 yy = vv2 * s + v2 * c
93 zz = vv3 * s + v3 * c
94 d = three1000
95 DO j=1,2
96 CALL write_s_c(nint(xx*d),1)
97 CALL write_s_c(nint(yy*d),1)
98 CALL write_s_c(nint(zz*d),1)
99 ENDDO
100 alpha = alpha + pi*one_over_12
101 ENDDO
102C
103 RETURN
104 END
my_real
#define my_real
Definition cppsort.cpp:32
alpha
#define alpha
Definition eval.h:35
dnwalc
subroutine dnwalc(x, rwl, msr)
Definition dnwalc.F:30
write_s_c
void write_s_c(int *w, int *len)
Definition write_routtines.c:687