OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
dxwalc.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!|| dxwalc ../starter/source/output/anim/dxwalc.F
25!||--- called by ------------------------------------------------------
26!|| dxyzsect ../starter/source/output/anim/dxyzsect.F
27!||--- calls -----------------------------------------------------
28!||====================================================================
29 SUBROUTINE dxwalc(X ,RWL ,MSR ,
30 3 XMIN ,YMIN ,ZMIN ,XMAX ,YMAX ,
31 4 ZMAX)
32C-----------------------------------------------
33C I m p l i c i t T y p e s
34C-----------------------------------------------
35#include "implicit_f.inc"
36C-----------------------------------------------
37C D u m m y A r g u m e n t s
38C-----------------------------------------------
39 INTEGER MSR
40C REAL
41 my_real
42 . x(3,*), rwl(*),xmin ,ymin ,zmin ,xmax ,ymax , zmax
43C-----------------------------------------------
44C L o c a l V a r i a b l e s
45C-----------------------------------------------
46 INTEGER I
47C REAL
48 my_real
49 . xwl, ywl, zwl,xn,yn,zn,d,dx,dy,dz,xl, r, v1, v2, v3, vv1,
50 . vv2, vv3, vv, x0, y0, z0, alpha, s, c
51 REAL R4
52C-----------------------------------------------
53 xn =rwl(1)
54 yn =rwl(2)
55 zn =rwl(3)
56 IF(msr==0)THEN
57 xwl=rwl(4)
58 ywl=rwl(5)
59 zwl=rwl(6)
60 ELSE
61 xwl=x(1,msr)
62 ywl=x(2,msr)
63 zwl=x(3,msr)
64 ENDIF
65C
66 dx = xmax - xmin
67 dy = ymax - ymin
68 dz = zmax - zmin
69C
70 r = half*rwl(7)
71 xl = half*max(dx,dy,dz)
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 IF(vv<=half)THEN
80 v1 = zero
81 v2 = -zep707
82 v3 = zep707
83 vv1 = v2 * zn - v3 * yn
84 vv2 = v3 * xn - v1 * zn
85 vv3 = v1 * yn - v2 * xn
86 vv = sqrt(vv1*vv1 + vv2*vv2 + vv3*vv3)
87 ENDIF
88 vv1 = r*vv1/vv
89 vv2 = r*vv2/vv
90 vv3 = r*vv3/vv
91 v1 = vv2 * zn - vv3 * yn
92 v2 = vv3 * xn - vv1 * zn
93 v3 = vv1 * yn - vv2 * xn
94C
95 x0 = xwl
96 y0 = ywl
97 z0 = zwl
98 alpha = zero
99 DO i=1,24
100 s = sin(alpha)
101 c = cos(alpha)
102 r4 = x0 + vv1 * s + v1 * c - xn * xl
103 CALL write_r_c(r4,1)
104 r4 = y0 + vv2 * s + v2 * c - yn * xl
105 CALL write_r_c(r4,1)
106 r4 = z0 + vv3 * s + v3 * c - zn * xl
107 CALL write_r_c(r4,1)
108 r4 = x0 + vv1 * s + v1 * c + xn * xl
109 CALL write_r_c(r4,1)
110 r4 = y0 + vv2 * s + v2 * c + yn * xl
111 CALL write_r_c(r4,1)
112 r4 = z0 + vv3 * s + v3 * c + zn * xl
113 CALL write_r_c(r4,1)
114 alpha = alpha + pi/12
115 ENDDO
116C
117 RETURN
118 END
my_real
#define my_real
Definition cppsort.cpp:32
alpha
#define alpha
Definition eval.h:35
ymax
subroutine ymax(idn, fac, npc, pld, stiffmin, stiffmax, stiffini, stiffavg)
Definition law100_upd.F:272
max
#define max(a, b)
Definition macros.h:21
dxwalc
subroutine dxwalc(x, rwl, msr, xmin, ymin, zmin, xmax, ymax, zmax)
Definition dxwalc.F:32
write_r_c
void write_r_c(float *w, int *len)
Definition write_routtines.c:519