OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
h3d_dxyz_rwall.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!|| h3d_dxyz_rwall ../engine/source/output/h3d/h3d_build_fortran/h3d_dxyz_rwall.F
25!||--- called by ------------------------------------------------------
26!|| genh3d ../engine/source/output/h3d/h3d_results/genh3d.F
27!||--- calls -----------------------------------------------------
28!|| spmd_h3d_getmsr ../engine/source/output/h3d/spmd/spmd_h3d_getmsr.F
29!||====================================================================
30 SUBROUTINE h3d_dxyz_rwall (NSTRF,RWBUF,NPRW ,X ,XMIN ,
31 2 YMIN ,ZMIN ,XMAX ,YMAX , ZMAX,
32 3 FR_SEC,FR_WALL,WEIGHT,ITAB,
33 4 XWL ,YWL , ZWL,
34 5 RWALL_V1, RWALL_V2, RWALL_V3, RWALL_V4, RWALL_V5, RWALL_V6 , RWALL_V7,
35 6 RWALL_V8, RWALL_V9, RWALL_V10)
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
248 END
h3d_dxyz_rwall
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)
Definition h3d_dxyz_rwall.F:36
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