OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
dxwals.F File Reference
#include "implicit_f.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine dxwals (x, rwl, msr)

Function/Subroutine Documentation

◆ dxwals()

subroutine dxwals ( x,
rwl,
integer msr )

Definition at line 29 of file dxwals.F.

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
38C REAL
40 . x(3,*), rwl(*)
41C-----------------------------------------------
42C L o c a l V a r i a b l e s
43C-----------------------------------------------
44 INTEGER I,J,L
45C REAL
47 . xwl, ywl, zwl,xn,yn,zn,d,dx,dy,dz,xx,yy,zz,r,xx0,yy0,zz0,
48 . x0(6),y0(6),z0(6),dx0(6),dy0(6),dz0(6),dx1(6),dy1(6),dz1(6)
49 REAL R4
50 DATA dx0/ 0., 0., 0., 0., 0., 0./
51 DATA dy0/ 1.,-1., 0., 0., 0., 0./
52 DATA dz0/ 0., 0.,-1., 1., 1.,-1./
53 DATA dx1/ 1., 1., 1., 1., 0., 0./
54 DATA dy1/ 0., 0., 0., 0., 1., 1./
55 DATA dz1/ 0., 0., 0., 0., 0., 0./
56 DATA x0 /-3.,-3.,-3.,-3.,-3., 3./
57 DATA y0 /-3., 3.,-3., 3.,-3.,-3./
58 DATA z0 /-3., 3., 3.,-3.,-3., 3./
59C-----------------------------------------------
60C
61 xn =rwl(1)
62 yn =rwl(2)
63 zn =rwl(3)
64 IF(msr==0)THEN
65 xwl=rwl(4)
66 ywl=rwl(5)
67 zwl=rwl(6)
68 ELSE
69 xwl=x(1,msr)
70 ywl=x(2,msr)
71 zwl=x(3,msr)
72 ENDIF
73C
74 r = half*rwl(7)
75C
76 DO i = 1,6
77 xx0 = x0(i)
78 yy0 = y0(i)
79 zz0 = z0(i)
80 DO j = 1,7
81 xx = xx0
82 yy = yy0
83 zz = zz0
84 DO l = 1,7
85 d = r/sqrt(xx*xx+yy*yy+zz*zz)
86 r4 = d*xx + xwl
87 CALL write_r_c(r4,1)
88 r4 = d*yy + ywl
89 CALL write_r_c(r4,1)
90 r4 = d*zz + zwl
91 CALL write_r_c(r4,1)
92 xx = xx + dx0(i)
93 yy = yy + dy0(i)
94 zz = zz + dz0(i)
95 ENDDO
96 xx0 = xx0 + dx1(i)
97 yy0 = yy0 + dy1(i)
98 zz0 = zz0 + dz1(i)
99 ENDDO
100 ENDDO
101C
102 RETURN
#define my_real
Definition cppsort.cpp:32
void write_r_c(float *w, int *len)