OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
inter_nodal_areas.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!|| inter_nodal_areas ../engine/source/output/inter_nodal_areas.F
25!||--- called by ------------------------------------------------------
26!|| resol ../engine/source/engine/resol.F
27!||--- calls -----------------------------------------------------
28!|| spmd_exch_nodarea ../engine/source/mpi/anim/spmd_exch_nodarea.F
29!||====================================================================
30 SUBROUTINE inter_nodal_areas(IXS ,IXC ,IXTG ,FASOLFR ,X ,
31 . IAD_ELEM,FR_ELEM ,WEIGHT ,IXQ ,SEGQUADFR,
32 . IXS10 ,INTAREAN)
33C-----------------------------------------------
34C M o d u l e s
35C-----------------------------------------------
36C-----------------------------------------------
37C I m p l i c i t T y p e s
38C-----------------------------------------------
39#include "implicit_f.inc"
40#include "comlock.inc"
41C-----------------------------------------------
42C C o m m o n B l o c k s
43C-----------------------------------------------
44#include "com01_c.inc"
45#include "com04_c.inc"
46#include "scr14_c.inc"
47#include "scr16_c.inc"
48#include "tabsiz_c.inc"
49C-----------------------------------------------
50C D u m m y A r g u m e n t s
51C-----------------------------------------------
52 INTEGER , INTENT(IN) ::
53 . IXS(NIXS,NUMELS) , IXC(NIXC,NUMELC) , IXTG(NIXTG,NUMELTG), FASOLFR(2,NFASOLFR),
54 . iad_elem(2,nspmd+1), fr_elem(sfr_elem), weight(*) ,ixq(nixq,numelq),segquadfr(2,nsegquadfr),
55 . ixs10(6,numels10)
56 my_real, INTENT(IN) ::
57 . x(3,numnod)
58 my_real, INTENT(INOUT) :: intarean(numnod)
59C-----------------------------------------------
60C L o c a l V a r i a b l e s
61C-----------------------------------------------
62 INTEGER N1, N2, N3, N4, NN1, NN2, NN3, J, I, N, IFAC, ILINE,
63 . LENR, NI
65 . area,
66 . x1,y1,z1,x2,y2,z2,x3,y3,z3,x4,y4,z4,
67 . x31,y31,z31,x42,y42,z42,x32,y32,z32,e3x,e3y,e3z,
68 . fs2, fs3, ft2, ft3, e, f, g, rayon,ay1,ay2,ay3,ay4
69 INTEGER FACES(4,6),LINES(2,4),FACES10(3,24)
70C REAL
71 DATA faces/1,2,3,4,
72 . 2,1,5,6,
73 . 1,5,8,4,
74 . 5,6,7,8,
75 . 3,4,8,7,
76 . 2,6,7,3/
77 DATA lines/1,2,
78 . 2,3,
79 . 3,4,
80 . 4,1/
81 DATA faces10/0,0,0,
82 . 0,0,0,
83 . 0,0,0,
84 . 0,0,0,
85 . 1,13,14,
86 . 5,14,16,
87 . 6,13,16,
88 . 13,14,16,
89 . 1,11,13,
90 . 3,11,15,
91 . 5,14,15,
92 . 11,14,15,
93 . 0,0,0,
94 . 0,0,0,
95 . 0,0,0,
96 . 0,0,0,
97 . 3,12,15,
98 . 5,15,16,
99 . 6,12,16,
100 . 12,15,16,
101 . 1,11,13,
102 . 3,11,12,
103 . 6,12,13,
104 . 11,12,13/
105C-----------------------------------------------
106C
107 DO n=1,numnod
108 intarean(n)=zero
109 END DO
110C
111 DO i=1,nfasolfr
112 n =fasolfr(1,i)
113 ifac=fasolfr(2,i)
114C
115 IF( n <= numels8 ) THEN
116
117 n1=ixs(faces(1,ifac)+1,n)
118 n2=ixs(faces(2,ifac)+1,n)
119 n3=ixs(faces(3,ifac)+1,n)
120 n4=ixs(faces(4,ifac)+1,n)
121 x1=x(1,n1)
122 y1=x(2,n1)
123 z1=x(3,n1)
124 x2=x(1,n2)
125 y2=x(2,n2)
126 z2=x(3,n2)
127 x3=x(1,n3)
128 y3=x(2,n3)
129 z3=x(3,n3)
130 x4=x(1,n4)
131 y4=x(2,n4)
132 z4=x(3,n4)
133C
134 x31=x3-x1
135 y31=y3-y1
136 z31=z3-z1
137 x42=x4-x2
138 y42=y4-y2
139 z42=z4-z2
140C
141 e3x=y31*z42-z31*y42
142 e3y=z31*x42-x31*z42
143 e3z=x31*y42-y31*x42
144C
145 IF( n4/=n3
146 . .AND.n3/=n2
147 . .AND.n2/=n1
148 . .AND.n1/=n4)THEN
149 area=one_over_8*sqrt(e3x*e3x+e3y*e3y+e3z*e3z)
150 intarean(n1)=intarean(n1)+area
151 intarean(n2)=intarean(n2)+area
152 intarean(n3)=intarean(n3)+area
153 intarean(n4)=intarean(n4)+area
154 ELSE
155 area=one_over_6*sqrt(e3x*e3x+e3y*e3y+e3z*e3z)
156 IF(n4==n3)THEN
157 IF(n2/=n1) THEN
158 intarean(n1)=intarean(n1)+area
159 intarean(n2)=intarean(n2)+area
160 intarean(n3)=intarean(n3)+area
161 ENDIF
162 ELSEIF(n3==n2)THEN
163 IF(n4/=n1) THEN
164 intarean(n1)=intarean(n1)+area
165 intarean(n2)=intarean(n2)+area
166 intarean(n4)=intarean(n4)+area
167 ENDIF
168 ELSEIF(n2==n1)THEN
169 IF(n4/=n3) THEN
170 intarean(n2)=intarean(n2)+area
171 intarean(n3)=intarean(n3)+area
172 intarean(n4)=intarean(n4)+area
173 ENDIF
174 ELSEIF(n1==n4)THEN
175 IF(n2/=n3) THEN
176 intarean(n2)=intarean(n2)+area
177 intarean(n3)=intarean(n3)+area
178 intarean(n4)=intarean(n4)+area
179 ENDIF
180 END IF
181 END IF
182
183 ELSEIF( n <= numels8+numels10 ) THEN
184
185C SubFac1
186 DO j=1,4
187 nn1=faces10(1,4*(ifac-1)+j)
188 nn2=faces10(2,4*(ifac-1)+j)
189 nn3=faces10(3,4*(ifac-1)+j)
190
191 IF(nn1 > 0 ) THEN
192 IF(nn1 >0.AND.nn1 < 10) THEN
193 n1=ixs(nn1+1,n)
194 ELSE
195 n1=ixs10(nn1-10,n-numels8)
196 ENDIF
197 ENDIF
198
199 IF(nn2 > 0 ) THEN
200 IF(nn2 < 10) THEN
201 n2=ixs(nn2+1,n)
202 ELSE
203 n2=ixs10(nn2-10,n-numels8)
204 ENDIF
205 ENDIF
206
207 IF(nn3 > 0 ) THEN
208 IF(nn3 < 10) THEN
209 n3=ixs(nn3+1,n)
210 ELSE
211 n3=ixs10(nn3-10,n-numels8)
212 ENDIF
213 ENDIF
214
215
216 IF(nn1 > 0 .AND. nn2 > 0 .AND.nn3 > 0) THEN
217 x1=x(1,n1)
218 y1=x(2,n1)
219 z1=x(3,n1)
220 x2=x(1,n2)
221 y2=x(2,n2)
222 z2=x(3,n2)
223 x3=x(1,n3)
224 y3=x(2,n3)
225 z3=x(3,n3)
226C
227 x31=x3-x1
228 y31=y3-y1
229 z31=z3-z1
230 x32=x3-x2
231 y32=y3-y2
232 z32=z3-z2
233C
234 e3x=y31*z32-z31*y32
235 e3y=z31*x32-x31*z32
236 e3z=x31*y32-y31*x32
237C
238 area=one_over_6*sqrt(e3x*e3x+e3y*e3y+e3z*e3z)
239
240 intarean(n1)=intarean(n1)+area
241 intarean(n2)=intarean(n2)+area
242 intarean(n3)=intarean(n3)+area
243 ENDIF
244 ENDDO
245 ENDIF
246 END DO
247C
248 DO n=1,numelc
249 n1=ixc(2,n)
250 n2=ixc(3,n)
251 n3=ixc(4,n)
252 n4=ixc(5,n)
253 IF(n4/=n3)THEN
254 x1=x(1,n1)
255 y1=x(2,n1)
256 z1=x(3,n1)
257 x2=x(1,n2)
258 y2=x(2,n2)
259 z2=x(3,n2)
260 x3=x(1,n3)
261 y3=x(2,n3)
262 z3=x(3,n3)
263 x4=x(1,n4)
264 y4=x(2,n4)
265 z4=x(3,n4)
266C
267 x31=x3-x1
268 y31=y3-y1
269 z31=z3-z1
270 x42=x4-x2
271 y42=y4-y2
272 z42=z4-z2
273C
274 e3x=y31*z42-z31*y42
275 e3y=z31*x42-x31*z42
276 e3z=x31*y42-y31*x42
277C
278 area=one_over_8*sqrt(e3x*e3x+e3y*e3y+e3z*e3z)
279 intarean(n1)=intarean(n1)+area
280 intarean(n2)=intarean(n2)+area
281 intarean(n3)=intarean(n3)+area
282 intarean(n4)=intarean(n4)+area
283C
284 ELSE
285 x1=x(1,n1)
286 y1=x(2,n1)
287 z1=x(3,n1)
288 x2=x(1,n2)
289 y2=x(2,n2)
290 z2=x(3,n2)
291 x3=x(1,n3)
292 y3=x(2,n3)
293 z3=x(3,n3)
294 x31=x3-x1
295 y31=y3-y1
296 z31=z3-z1
297 x32=x3-x2
298 y32=y3-y2
299 z32=z3-z2
300C
301 e3x=y31*z32-z31*y32
302 e3y=z31*x32-x31*z32
303 e3z=x31*y32-y31*x32
304C
305 area=one_over_6*sqrt(e3x*e3x+e3y*e3y+e3z*e3z)
306 intarean(n1)=intarean(n1)+area
307 intarean(n2)=intarean(n2)+area
308 intarean(n3)=intarean(n3)+area
309 END IF
310 END DO
311C
312 DO n=1,numeltg
313 n1=ixtg(2,n)
314 n2=ixtg(3,n)
315 n3=ixtg(4,n)
316 x1=x(1,n1)
317 y1=x(2,n1)
318 z1=x(3,n1)
319 x2=x(1,n2)
320 y2=x(2,n2)
321 z2=x(3,n2)
322 x3=x(1,n3)
323 y3=x(2,n3)
324 z3=x(3,n3)
325 x31=x3-x1
326 y31=y3-y1
327 z31=z3-z1
328 x32=x3-x2
329 y32=y3-y2
330 z32=z3-z2
331C
332 e3x=y31*z32-z31*y32
333 e3y=z31*x32-x31*z32
334 e3z=x31*y32-y31*x32
335C
336 area=one_over_6*sqrt(e3x*e3x+e3y*e3y+e3z*e3z)
337 intarean(n1)=intarean(n1)+area
338 intarean(n2)=intarean(n2)+area
339 intarean(n3)=intarean(n3)+area
340 END DO
341C
342 DO i=1,nsegquadfr
343 n =segquadfr(1,i)
344 iline=segquadfr(2,i)
345
346 n1=ixq(lines(1,iline)+1,n)
347 n2=ixq(lines(2,iline)+1,n)
348
349 y1=x(2,n1)
350 z1=x(3,n1)
351 y2=x(2,n2)
352 z2=x(3,n2)
353
354 area = sqrt((y2-y1)*(y2-y1)+(z2-z1)*(z2-z1))
355 area = area*half
356
357
358 intarean(n1)=intarean(n1)+area
359 intarean(n2)=intarean(n2)+area
360
361 ENDDO
362C
363 IF(nspmd > 1)THEN
364 lenr = iad_elem(1,nspmd+1)-iad_elem(1,1)
365 CALL spmd_exch_nodarea(intarean,iad_elem,fr_elem,lenr,weight)
366 END IF
367C
368 RETURN
369 END SUBROUTINE inter_nodal_areas
370
#define my_real
Definition cppsort.cpp:32
subroutine area(d1, x, x2, y, y2, eint, stif0)
subroutine inter_nodal_areas(ixs, ixc, ixtg, fasolfr, x, iad_elem, fr_elem, weight, ixq, segquadfr, ixs10, intarean)
subroutine spmd_exch_nodarea(nodarea, iad_elem, fr_elem, lenr, weight)