OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
inter_nodal_areas.F File Reference
#include "implicit_f.inc"
#include "comlock.inc"
#include "com01_c.inc"
#include "com04_c.inc"
#include "scr14_c.inc"
#include "scr16_c.inc"
#include "tabsiz_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine inter_nodal_areas (ixs, ixc, ixtg, fasolfr, x, iad_elem, fr_elem, weight, ixq, segquadfr, ixs10, intarean)

Function/Subroutine Documentation

◆ inter_nodal_areas()

subroutine inter_nodal_areas ( integer, dimension(nixs,numels), intent(in) ixs,
integer, dimension(nixc,numelc), intent(in) ixc,
integer, dimension(nixtg,numeltg), intent(in) ixtg,
integer, dimension(2,nfasolfr), intent(in) fasolfr,
dimension(3,numnod), intent(in) x,
integer, dimension(2,nspmd+1), intent(in) iad_elem,
integer, dimension(sfr_elem), intent(in) fr_elem,
integer, dimension(*), intent(in) weight,
integer, dimension(nixq,numelq), intent(in) ixq,
integer, dimension(2,nsegquadfr), intent(in) segquadfr,
integer, dimension(6,numels10), intent(in) ixs10,
dimension(numnod), intent(inout) intarean )

Definition at line 32 of file inter_nodal_areas.F.

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