OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
h3d_dxyz_rwall.F File Reference
#include "implicit_f.inc"
#include "param_c.inc"
#include "com04_c.inc"
#include "task_c.inc"
#include "com01_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine h3d_dxyz_rwall (nstrf, rwbuf, nprw, x, xmin, ymin, zmin, xmax, ymax, zmax, fr_sec, fr_wall, weight, itab, xwl, ywl, zwl, rwall_v1, rwall_v2, rwall_v3, rwall_v4, rwall_v5, rwall_v6, rwall_v7, rwall_v8, rwall_v9, rwall_v10)

Function/Subroutine Documentation

◆ h3d_dxyz_rwall()

subroutine h3d_dxyz_rwall ( integer, dimension(*) nstrf,
rwbuf,
integer, dimension(*) nprw,
x,
xmin,
ymin,
zmin,
xmax,
ymax,
zmax,
integer, dimension(nspmd+1,*) fr_sec,
integer, dimension(nspmd+2,*) fr_wall,
integer, dimension(*) weight,
integer, dimension(*) itab,
xwl,
ywl,
zwl,
rwall_v1,
rwall_v2,
rwall_v3,
rwall_v4,
rwall_v5,
rwall_v6,
rwall_v7,
rwall_v8,
rwall_v9,
rwall_v10 )

Definition at line 30 of file h3d_dxyz_rwall.F.

36C-----------------------------------------------
37C I m p l i c i t T y p e s
38C-----------------------------------------------
39#include "implicit_f.inc"
40C-----------------------------------------------
41C C o m m o n B l o c k s
42C-----------------------------------------------
43#include "param_c.inc"
44#include "com04_c.inc"
45#include "task_c.inc"
46#include "com01_c.inc"
47C-----------------------------------------------
48C D u m m y A r g u m e n t s
49C-----------------------------------------------
50 INTEGER NSTRF(*),NPRW(*),ITAB(*)
51 my_real
52 . rwbuf(nrwlp,*),x(3,*),xmin ,ymin ,zmin ,xmax ,ymax, zmax
53 my_real
54 . xwl(*), ywl(*), zwl(*), rwall_v1(*), rwall_v2(*), rwall_v3(*),
55 . rwall_v4(*), rwall_v5(*), rwall_v6(*), rwall_v7(*),
56 . rwall_v8(*), rwall_v9(*), rwall_v10(*)
57 integer
58 . fr_sec(nspmd+1,*),fr_wall(nspmd+2,*),weight(*)
59C-----------------------------------------------
60C L o c a l V a r i a b l e s
61C-----------------------------------------------
62 INTEGER J, I, K, K0, K1, N, NSEG, N1, N2, N3, N4,MSR, ITYP
63 my_real
64 . xx1, yy1, zz1, xx2, yy2, zz2, xx3, yy3, zz3,
65 . xx4, yy4, zz4, d13, xxc, yyc, zzc, al4,
66 . pmain,loc_proc, v1, v2, v3, vv1, vv2,
67 . vv3, r, xn,yn,zn,d,dx,dy,dz, vv, xl
68
69 my_real
70 . xsec(3,3,nsect)
71 REAL R4,SBUF(3*NSECT)
72CC-----------------------------------------------
73 loc_proc=ispmd+1
74C
75C
76 k=1
77 DO n=1,nrwall
78 n2=n +nrwall
79 n3=n2+nrwall
80 n4=n3+nrwall
81 msr = nprw(n3)
82 IF (nspmd == 1) THEN
83 IF(msr==0)THEN
84 xwl(n)=rwbuf(4,n)
85 ywl(n)=rwbuf(5,n)
86 zwl(n)=rwbuf(6,n)
87 ELSE
88C verifier que ce noeud est sur proc0 !
89 xwl(n)=x(1,msr)
90 ywl(n)=x(2,msr)
91 zwl(n)=x(3,msr)
92 ENDIF
93 ELSE
94 CALL spmd_h3d_getmsr(fr_wall(1,n),x,msr,xwl(n),ywl(n),zwl(n),rwbuf(1,n))
95 END IF
96 ENDDO
97C
98 k=1
99 DO n=1,nrwall
100 n2=n +nrwall
101 n3=n2+nrwall
102 n4=n3+nrwall
103 ityp= nprw(n4)
104
105 IF(iabs(ityp)==1)THEN
106C
107 xn =rwbuf(1,n)
108 yn =rwbuf(2,n)
109 zn =rwbuf(3,n)
110 IF (ispmd==0) THEN
111 dx = xmax - xmin
112 dy = ymax - ymin
113 dz = zmax - zmin
114C
115 r = zep707*max(dx,dy,dz)
116 IF (xn == zero .AND. yn == zero .AND. zn /= zero ) THEN
117 v1 = zep707
118 v2 = zep707
119 v3 = zero
120 ELSE
121 v1 = zero
122 v2 = zep707
123 v3 = zep707
124 ENDIF
125 vv1 = v2 * zn - v3 * yn
126 vv2 = v3 * xn - v1 * zn
127 vv3 = v1 * yn - v2 * xn
128 vv = sqrt(vv1*vv1 + vv2*vv2 + vv3*vv3)
129 IF(vv<=half)THEN
130 IF (xn == zero .AND. yn == zero .AND. zn /= zero ) THEN
131 v1 = -zep707
132 v2 = zep707
133 v3 = zero
134 ELSE
135 v1 = zero
136 v2 = -zep707
137 v3 = zep707
138 ENDIF
139 vv1 = v2 * zn - v3 * yn
140 vv2 = v3 * xn - v1 * zn
141 vv3 = v1 * yn - v2 * xn
142 vv = sqrt(vv1*vv1 + vv2*vv2 + vv3*vv3)
143 ENDIF
144 vv1 = r*vv1/vv
145 vv2 = r*vv2/vv
146 vv3 = r*vv3/vv
147 v1 = vv2 * zn - vv3 * yn
148 v2 = vv3 * xn - vv1 * zn
149 v3 = vv1 * yn - vv2 * xn
150c
151 rwall_v1(n) = v1
152 rwall_v2(n) = v2
153 rwall_v3(n) = v3
154 rwall_v4(n) = vv1
155 rwall_v5(n) = vv2
156 rwall_v6(n) = vv3
157 rwall_v7(n) = zero
158 rwall_v8(n) = zero
159 rwall_v9(n) = zero
160 rwall_v10(n) = zero
161 ENDIF
162c
163 ELSEIF(ityp==2)THEN
164 xn = rwbuf(1,n)
165 yn = rwbuf(2,n)
166 zn = rwbuf(3,n)
167
168 dx = xmax - xmin
169 dy = ymax - ymin
170 dz = zmax - zmin
171
172 r = half*rwbuf(7,n)
173 xl = half*max(dx,dy,dz)
174 v1 = zero
175 v2 = zep707
176 v3 = zep707
177 vv1 = v2 * zn - v3 * yn
178 vv2 = v3 * xn - v1 * zn
179 vv3 = v1 * yn - v2 * xn
180 vv = sqrt(vv1*vv1 + vv2*vv2 + vv3*vv3)
181 IF(vv<=half)THEN
182 v1 = zero
183 v2 = -zep707
184 v3 = zep707
185 vv1 = v2 * zn - v3 * yn
186 vv2 = v3 * xn - v1 * zn
187 vv3 = v1 * yn - v2 * xn
188 vv = sqrt(vv1*vv1 + vv2*vv2 + vv3*vv3)
189 ENDIF
190 vv1 = r*vv1/vv
191 vv2 = r*vv2/vv
192 vv3 = r*vv3/vv
193 v1 = vv2 * zn - vv3 * yn
194 v2 = vv3 * xn - vv1 * zn
195 v3 = vv1 * yn - vv2 * xn
196
197 rwall_v1(n) = v1
198 rwall_v2(n) = v2
199 rwall_v3(n) = v3
200 rwall_v4(n) = vv1
201 rwall_v5(n) = vv2
202 rwall_v6(n) = vv3
203 rwall_v7(n) = xl
204 rwall_v8(n) = xn
205 rwall_v9(n) = yn
206 rwall_v10(n) = zn
207
208 ELSEIF(ityp==3)THEN
209 xn = rwbuf(1,n)
210 yn = rwbuf(2,n)
211 zn = rwbuf(3,n)
212
213 rwall_v1(n) = half*rwbuf(7,n)
214 rwall_v2(n) = zero
215 rwall_v3(n) = zero
216 rwall_v4(n) = zero
217 rwall_v5(n) = zero
218 rwall_v6(n) = zero
219 rwall_v7(n) = zero
220 rwall_v8(n) = zero
221 rwall_v9(n) = zero
222 rwall_v10(n) = zero
223c
224 ELSEIF(ityp==4)THEN
225 xn =rwbuf(1,n)
226 yn =rwbuf(2,n)
227 zn =rwbuf(3,n)
228 IF (ispmd==0) THEN
229C
230 rwall_v1(n)=rwbuf(7,n)
231 rwall_v2(n)=rwbuf(8,n)
232 rwall_v3(n)=rwbuf(9,n)
233 rwall_v4(n)=rwbuf(10,n)
234 rwall_v5(n)=rwbuf(11,n)
235 rwall_v6(n)=rwbuf(12,n)
236 rwall_v7(n) = zero
237 rwall_v8(n) = zero
238 rwall_v9(n) = zero
239 rwall_v10(n) = zero
240 ENDIF
241
242 ENDIF
243 k=k+nprw(n)
244 IF(nprw(n4)==-1)k=k+nint(rwbuf(8,n))
245 ENDDO
246C
247 RETURN
my_real
#define my_real
Definition cppsort.cpp:32
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
spmd_h3d_getmsr
subroutine spmd_h3d_getmsr(fr_wall, x, msr, xwl, ywl, zwl, rwl)
Definition spmd_h3d_getmsr.F:32