OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
i25norm3.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!|| mod_i25norm ../starter/source/interfaces/inter3d1/i25norm3.F
25!||--- called by ------------------------------------------------------
26!|| i25norm ../starter/source/interfaces/inter3d1/i25norm3.F
27!||====================================================================
28 module mod_i25norm
29 implicit none
30 real*4
31 . , DIMENSION(:,:,:), ALLOCATABLE :: wnod_normal
32 END MODULE mod_i25norm
33!||====================================================================
34!|| i25norm ../starter/source/interfaces/inter3d1/i25norm3.F
35!||--- called by ------------------------------------------------------
36!|| inint3 ../starter/source/interfaces/inter3d1/inint3.F
37!||--- uses -----------------------------------------------------
38!|| mod_i25norm ../starter/source/interfaces/inter3d1/i25norm3.F
39!||====================================================================
40 SUBROUTINE i25norm(NRTM,IRECTM,NUMNOD,X ,NOD_NORMAL,
41 . NMN ,MSR ,ITAB ,NRTM0 ,MSEGTYP ,
42 . MVOISIN,EVOISIN,NEDGE,LEDGE,
43 . LBOUND,ADMSR,VTX_BISECTOR,
44 . E2S_NOD_NORMAL,NADMSR,IEDGE,IELEM_M)
45C-----------------------------------------------
46C M o d u l e s
47C-----------------------------------------------
48 USE mod_i25norm
49C-----------------------------------------------
50C I m p l i c i t T y p e s
51C-----------------------------------------------
52#include "implicit_f.inc"
53C-----------------------------------------------
54C G l o b a l P a r a m e t e r s
55C-----------------------------------------------
56#include "mvsiz_p.inc"
57C-----------------------------------------------
58C C o m m o n B l o c k s
59C-----------------------------------------------
60#include "param_c.inc"
61C-----------------------------------------------
62C D u m m y A r g u m e n t s
63C-----------------------------------------------
64 INTEGER NRTM,NUMNOD,NRTM0,NADMSR,IEDGE,IRECTM(4,NRTM),NMN,MSR(*),
65 . MVOISIN(4,NRTM), EVOISIN(4,NRTM),ITAB(*),MSEGTYP(*),
66 . NEDGE, LEDGE(NLEDGE,*), LBOUND(*), ADMSR(4,*)
67C REAL
68 my_real
69 . x(3,numnod)
70 real*4 nod_normal(3,4,nrtm), vtx_bisector(3,2,*),e2s_nod_normal(3,*)
71 INTEGER , INTENT(INOUT) :: IELEM_M(2,NRTM)
72C-----------------------------------------------
73C L o c a l V a r i a b l e s
74C-----------------------------------------------
75 INTEGER I, J, FIRST, LAST, IRM, IEDG, I1, I2, I3, I4
76 INTEGER IX1(MVSIZ), IX2(MVSIZ), IX3(MVSIZ), IX4(MVSIZ),
77 . JRM, JEDG, IS1, IS2, ISH, SOL_EDGE
78C REAL
79 real*4
80 . x0(mvsiz), y0(mvsiz), z0(mvsiz),
81 . x1(mvsiz), x2(mvsiz), x3(mvsiz), x4(mvsiz),
82 . y1(mvsiz), y2(mvsiz), y3(mvsiz), y4(mvsiz),
83 . z1(mvsiz), z2(mvsiz), z3(mvsiz), z4(mvsiz),
84 . x01(mvsiz), x02(mvsiz), x03(mvsiz), x04(mvsiz),
85 . y01(mvsiz), y02(mvsiz), y03(mvsiz), y04(mvsiz),
86 . z01(mvsiz), z02(mvsiz), z03(mvsiz), z04(mvsiz),
87 . xn1(mvsiz),yn1(mvsiz),zn1(mvsiz),
88 . xn2(mvsiz),yn2(mvsiz),zn2(mvsiz),
89 . xn3(mvsiz),yn3(mvsiz),zn3(mvsiz),
90 . xn4(mvsiz),yn4(mvsiz),zn4(mvsiz),
91 . xs(mvsiz),ys(mvsiz),zs(mvsiz),
92 . aaa, xad, s1, s2, s3, s4,
93 . rzero, run, rem30, rep30, rdix,
94 . nx, ny, nz, vx, vy, vz, x12, y12, z12
95C-----------------------------------------------
96 rzero = 0.
97 run = 1.
98 rdix = 10.
99 rep30 = rdix**30
100 rem30 = run/rep30
101C
102 nod_normal(1:3,1:4,1:nrtm) = rzero
103 vtx_bisector(1:3,1:2,1:nadmsr) = rzero
104C optimisable en spmd si ajout flag pour routine de comm, spmd_exchange_n
105 sol_edge = 0
106 IF(iedge/=0) sol_edge =iedge/10 ! solids
107 IF(sol_edge /=0)THEN
108 DO i=1,nadmsr
109 e2s_nod_normal(1,i) = rzero
110 e2s_nod_normal(2,i) = rzero
111 e2s_nod_normal(3,i) = rzero
112 END DO
113 ENDIF
114
115 first=1
116 last =min(nrtm0,mvsiz)
117C
118 100 CONTINUE
119C
120 DO i=1,last-first+1
121 irm=i+first-1
122 IF(ielem_m(2,irm) ==0)THEN
123 ix1(i)=irectm(1,irm)
124 ix2(i)=irectm(2,irm)
125 ix3(i)=irectm(3,irm)
126 ix4(i)=irectm(4,irm)
127 x1(i)=x(1,ix1(i))
128 y1(i)=x(2,ix1(i))
129 z1(i)=x(3,ix1(i))
130 x2(i)=x(1,ix2(i))
131 y2(i)=x(2,ix2(i))
132 z2(i)=x(3,ix2(i))
133 x3(i)=x(1,ix3(i))
134 y3(i)=x(2,ix3(i))
135 z3(i)=x(3,ix3(i))
136 x4(i)=x(1,ix4(i))
137 y4(i)=x(2,ix4(i))
138 z4(i)=x(3,ix4(i))
139 ENDIF
140 END DO
141C
142 DO i=1,last-first+1
143 irm=i+first-1
144 IF(ielem_m(2,irm) ==0)THEN
145 IF(ix3(i)/=ix4(i))THEN
146 x0(i) = fourth*(x1(i)+x2(i)+x3(i)+x4(i))
147 y0(i) = fourth*(y1(i)+y2(i)+y3(i)+y4(i))
148 z0(i) = fourth*(z1(i)+z2(i)+z3(i)+z4(i))
149 ELSE
150 x0(i) = x3(i)
151 y0(i) = y3(i)
152 z0(i) = z3(i)
153 ENDIF
154 ENDIF
155 END DO
156C
157 DO i=1,last-first+1
158 irm=i+first-1
159 IF(ielem_m(2,irm) ==0)THEN
160C
161 x01(i) = x1(i) - x0(i)
162 y01(i) = y1(i) - y0(i)
163 z01(i) = z1(i) - z0(i)
164C
165 x02(i) = x2(i) - x0(i)
166 y02(i) = y2(i) - y0(i)
167 z02(i) = z2(i) - z0(i)
168C
169 x03(i) = x3(i) - x0(i)
170 y03(i) = y3(i) - y0(i)
171 z03(i) = z3(i) - z0(i)
172C
173 x04(i) = x4(i) - x0(i)
174 y04(i) = y4(i) - y0(i)
175 z04(i) = z4(i) - z0(i)
176C
177 ENDIF
178 ENDDO
179C
180 DO i=1,last-first+1
181 irm=i+first-1
182 IF(ielem_m(2,irm) ==0)THEN
183C
184 xn1(i) = y01(i)*z02(i) - z01(i)*y02(i)
185 yn1(i) = z01(i)*x02(i) - x01(i)*z02(i)
186 zn1(i) = x01(i)*y02(i) - y01(i)*x02(i)
187C
188 xn2(i) = y02(i)*z03(i) - z02(i)*y03(i)
189 yn2(i) = z02(i)*x03(i) - x02(i)*z03(i)
190 zn2(i) = x02(i)*y03(i) - y02(i)*x03(i)
191C
192 xn3(i) = y03(i)*z04(i) - z03(i)*y04(i)
193 yn3(i) = z03(i)*x04(i) - x03(i)*z04(i)
194 zn3(i) = x03(i)*y04(i) - y03(i)*x04(i)
195C
196 xn4(i) = y04(i)*z01(i) - z04(i)*y01(i)
197 yn4(i) = z04(i)*x01(i) - x04(i)*z01(i)
198 zn4(i) = x04(i)*y01(i) - y04(i)*x01(i)
199C
200 ENDIF
201 ENDDO
202C
203 DO i=1,last-first+1
204C
205 irm=i+first-1
206 IF(ielem_m(2,irm) ==0)THEN
207 aaa=run/max(rem30,sqrt(xn1(i)*xn1(i)+yn1(i)*yn1(i)+zn1(i)*zn1(i)))
208 xn1(i) = xn1(i)*aaa
209 yn1(i) = yn1(i)*aaa
210 zn1(i) = zn1(i)*aaa
211C
212 aaa=run/max(rem30,sqrt(xn2(i)*xn2(i)+yn2(i)*yn2(i)+zn2(i)*zn2(i)))
213 xn2(i) = xn2(i)*aaa
214 yn2(i) = yn2(i)*aaa
215 zn2(i) = zn2(i)*aaa
216C
217 aaa=run/max(rem30,sqrt(xn3(i)*xn3(i)+yn3(i)*yn3(i)+zn3(i)*zn3(i)))
218 xn3(i) = xn3(i)*aaa
219 yn3(i) = yn3(i)*aaa
220 zn3(i) = zn3(i)*aaa
221C
222 aaa=run/max(rem30,sqrt(xn4(i)*xn4(i)+yn4(i)*yn4(i)+zn4(i)*zn4(i)))
223 xn4(i) = xn4(i)*aaa
224 yn4(i) = yn4(i)*aaa
225 zn4(i) = zn4(i)*aaa
226C
227 ENDIF
228 ENDDO
229C
230 DO i=1,last-first+1
231C
232 irm=i+first-1
233C
234 IF(ielem_m(2,irm) ==0)THEN
235
236 IF(ix4(i)/=ix3(i))THEN
237C
238 nod_normal(1,1,irm)=xn1(i)
239 nod_normal(2,1,irm)=yn1(i)
240 nod_normal(3,1,irm)=zn1(i)
241C
242 nod_normal(1,2,irm)=xn2(i)
243 nod_normal(2,2,irm)=yn2(i)
244 nod_normal(3,2,irm)=zn2(i)
245C
246 nod_normal(1,3,irm)=xn3(i)
247 nod_normal(2,3,irm)=yn3(i)
248 nod_normal(3,3,irm)=zn3(i)
249C
250 nod_normal(1,4,irm)=xn4(i)
251 nod_normal(2,4,irm)=yn4(i)
252 nod_normal(3,4,irm)=zn4(i)
253C
254 ELSE
255C
256 nod_normal(1,1,irm)=xn1(i)
257 nod_normal(2,1,irm)=yn1(i)
258 nod_normal(3,1,irm)=zn1(i)
259C
260 nod_normal(1,2,irm)=xn1(i)
261 nod_normal(2,2,irm)=yn1(i)
262 nod_normal(3,2,irm)=zn1(i)
263C
264 nod_normal(1,4,irm)=xn1(i)
265 nod_normal(2,4,irm)=yn1(i)
266 nod_normal(3,4,irm)=zn1(i)
267C
268 END IF
269C
270 ENDIF
271 ENDDO
272C
273 DO i=1,last-first+1
274C
275 irm=i+first-1
276C
277 IF(ielem_m(2,irm) ==0)THEN
278
279 ish=msegtyp(irm)
280 IF(ish > 0) THEN
281 IF(ish > nrtm)ish=ish-nrtm
282C
283 IF(ix3(i)/=ix4(i))THEN
284C
285 nod_normal(1,1,ish)=-xn1(i)
286 nod_normal(2,1,ish)=-yn1(i)
287 nod_normal(3,1,ish)=-zn1(i)
288C
289 nod_normal(1,4,ish)=-xn2(i)
290 nod_normal(2,4,ish)=-yn2(i)
291 nod_normal(3,4,ish)=-zn2(i)
292C
293 nod_normal(1,3,ish)=-xn3(i)
294 nod_normal(2,3,ish)=-yn3(i)
295 nod_normal(3,3,ish)=-zn3(i)
296C
297 nod_normal(1,2,ish)=-xn4(i)
298 nod_normal(2,2,ish)=-yn4(i)
299 nod_normal(3,2,ish)=-zn4(i)
300C
301 ELSE
302C
303 nod_normal(1,1,ish)=-xn1(i)
304 nod_normal(2,1,ish)=-yn1(i)
305 nod_normal(3,1,ish)=-zn1(i)
306C
307 nod_normal(1,4,ish)=-xn1(i)
308 nod_normal(2,4,ish)=-yn1(i)
309 nod_normal(3,4,ish)=-zn1(i)
310C
311 nod_normal(1,2,ish)=-xn1(i)
312 nod_normal(2,2,ish)=-yn1(i)
313 nod_normal(3,2,ish)=-zn1(i)
314C
315 ENDIF
316 END IF
317 END IF
318
319 ENDDO
320
321
322 IF(sol_edge/=0)THEN
323C
324 DO i=1,last-first+1
325C
326 irm=i+first-1
327C
328 i1=abs(admsr(1,irm))
329 i2=abs(admsr(2,irm))
330 i3=abs(admsr(3,irm))
331 i4=abs(admsr(4,irm))
332C
333 xad=admsr(1,irm)
334 s1=sign(run,xad)
335c s1=ONE
336 xad=admsr(2,irm)
337 s2=sign(run,xad)
338c s2=ONE
339 xad=admsr(3,irm)
340 s3=sign(run,xad)
341c s3=ONE
342 xad=admsr(4,irm)
343 s4=sign(run,xad)
344c s4=ONE
345C
346 IF(i4/=i3)THEN
347C
348 e2s_nod_normal(1,i1)=e2s_nod_normal(1,i1)+s1*(xn4(i)+xn1(i))
349 e2s_nod_normal(2,i1)=e2s_nod_normal(2,i1)+s1*(yn4(i)+yn1(i))
350 e2s_nod_normal(3,i1)=e2s_nod_normal(3,i1)+s1*(zn4(i)+zn1(i))
351C
352 e2s_nod_normal(1,i2)=e2s_nod_normal(1,i2)+s2*(xn1(i)+xn2(i))
353 e2s_nod_normal(2,i2)=e2s_nod_normal(2,i2)+s2*(yn1(i)+yn2(i))
354 e2s_nod_normal(3,i2)=e2s_nod_normal(3,i2)+s2*(zn1(i)+zn2(i))
355C
356 e2s_nod_normal(1,i3)=e2s_nod_normal(1,i3)+s3*(xn2(i)+xn3(i))
357 e2s_nod_normal(2,i3)=e2s_nod_normal(2,i3)+s3*(yn2(i)+yn3(i))
358 e2s_nod_normal(3,i3)=e2s_nod_normal(3,i3)+s3*(zn2(i)+zn3(i))
359C
360 e2s_nod_normal(1,i4)=e2s_nod_normal(1,i4)+s4*(xn3(i)+xn4(i))
361 e2s_nod_normal(2,i4)=e2s_nod_normal(2,i4)+s4*(yn3(i)+yn4(i))
362 e2s_nod_normal(3,i4)=e2s_nod_normal(3,i4)+s4*(zn3(i)+zn4(i))
363C
364 ELSE
365C
366 e2s_nod_normal(1,i1)=e2s_nod_normal(1,i1)+s1*xn1(i)
367 e2s_nod_normal(2,i1)=e2s_nod_normal(2,i1)+s1*yn1(i)
368 e2s_nod_normal(3,i1)=e2s_nod_normal(3,i1)+s1*zn1(i)
369C
370 e2s_nod_normal(1,i2)=e2s_nod_normal(1,i2)+s2*xn1(i)
371 e2s_nod_normal(2,i2)=e2s_nod_normal(2,i2)+s2*yn1(i)
372 e2s_nod_normal(3,i2)=e2s_nod_normal(3,i2)+s2*zn1(i)
373C
374 e2s_nod_normal(1,i3)=e2s_nod_normal(1,i3)+s3*xn1(i)
375 e2s_nod_normal(2,i3)=e2s_nod_normal(2,i3)+s3*yn1(i)
376 e2s_nod_normal(3,i3)=e2s_nod_normal(3,i3)+s3*zn1(i)
377C
378 END IF
379C
380 ENDDO
381
382 ENDIF
383
384
385C
386 IF(last < nrtm0)THEN
387 first=last+1
388 last =min(last+mvsiz,nrtm0)
389 GO TO 100
390 END IF
391C------------------------------------
392 DO irm=1,nrtm
393C
394 IF(ielem_m(2,irm) ==0)THEN
395 DO iedg=1,4
396 IF(mvoisin(iedg,irm)==0)THEN
397 IF(.NOT.(irectm(3,irm)==irectm(4,irm).AND.iedg==3))THEN
398C
399 nx=nod_normal(1,iedg,irm)
400 ny=nod_normal(2,iedg,irm)
401 nz=nod_normal(3,iedg,irm)
402C
403 i1=irectm(iedg,irm)
404 i2=irectm(mod(iedg,4)+1,irm)
405
406 x12=x(1,i2)-x(1,i1)
407 y12=x(2,i2)-x(2,i1)
408 z12=x(3,i2)-x(3,i1)
409
410 vx=y12*nz-z12*ny
411 vy=z12*nx-x12*nz
412 vz=x12*ny-y12*nx
413
414 aaa=run/max(rem30,sqrt(vx*vx+vy*vy+vz*vz))
415 vx=vx*aaa
416 vy=vy*aaa
417 vz=vz*aaa
418
419 nod_normal(1,iedg,irm)=vx
420 nod_normal(2,iedg,irm)=vy
421 nod_normal(3,iedg,irm)=vz
422
423 END IF
424 END IF
425 END DO
426 ENDIF
427 END DO
428C
429 DO irm=1,nrtm
430
431 IF(ielem_m(2,irm) ==0)THEN
432 DO iedg=1,4
433 IF(mvoisin(iedg,irm)==0)THEN
434 IF(.NOT.(irectm(3,irm)==irectm(4,irm).AND.iedg==3))THEN
435
436 vx=nod_normal(1,iedg,irm)
437 vy=nod_normal(2,iedg,irm)
438 vz=nod_normal(3,iedg,irm)
439C
440 is1=admsr(iedg,irm)
441C LBOUND(IS1)=1
442 IF(vtx_bisector(1,1,is1)==rzero.AND.
443 . vtx_bisector(2,1,is1)==rzero.AND.
444 . vtx_bisector(3,1,is1)==rzero)THEN
445 vtx_bisector(1,1,is1)=vx
446 vtx_bisector(2,1,is1)=vy
447 vtx_bisector(3,1,is1)=vz
448 ELSE
449 vtx_bisector(1,2,is1)=vx
450 vtx_bisector(2,2,is1)=vy
451 vtx_bisector(3,2,is1)=vz
452 END IF
453C
454 is2=admsr(mod(iedg,4)+1,irm)
455C LBOUND(IS2)=1
456 IF(vtx_bisector(1,1,is2)==rzero.AND.
457 . vtx_bisector(2,1,is2)==rzero.AND.
458 . vtx_bisector(3,1,is2)==rzero)THEN
459 vtx_bisector(1,1,is2)=vx
460 vtx_bisector(2,1,is2)=vy
461 vtx_bisector(3,1,is2)=vz
462 ELSE
463 vtx_bisector(1,2,is2)=vx
464 vtx_bisector(2,2,is2)=vy
465 vtx_bisector(3,2,is2)=vz
466 END IF
467
468 END IF
469 END IF
470 END DO
471 ENDIF
472 END DO
473C------------------------------------
474 ALLOCATE(wnod_normal(3,4,nrtm))
475C------------------------------------
476 DO irm=1,nrtm
477 IF(ielem_m(2,irm) ==0)THEN
478 DO j=1,4
479 IF(.NOT.(irectm(3,irm)==irectm(4,irm).AND.j==3))THEN
480 jrm =mvoisin(j,irm)
481 jedg=evoisin(j,irm)
482 IF(jrm /= 0)THEN
483 wnod_normal(1,j,irm)=nod_normal(1,jedg,jrm)
484 wnod_normal(2,j,irm)=nod_normal(2,jedg,jrm)
485 wnod_normal(3,j,irm)=nod_normal(3,jedg,jrm)
486 ELSE
487 wnod_normal(1,j,irm)=rzero
488 wnod_normal(2,j,irm)=rzero
489 wnod_normal(3,j,irm)=rzero
490 END IF
491 END IF
492 END DO
493 ENDIF
494 END DO
495C------------------------------------
496 DO irm=1,nrtm
497 IF(ielem_m(2,irm) ==0)THEN
498 DO j=1,4
499 IF(.NOT.(irectm(3,irm)==irectm(4,irm).AND.j==3))THEN
500 jrm =mvoisin(j,irm)
501 IF( jrm /= 0) THEN
502 nx=nod_normal(1,j,irm)+wnod_normal(1,j,irm)
503 ny=nod_normal(2,j,irm)+wnod_normal(2,j,irm)
504 nz=nod_normal(3,j,irm)+wnod_normal(3,j,irm)
505 aaa=run/max(rem30,sqrt(nx*nx+ny*ny+nz*nz))
506 nod_normal(1,j,irm)=nx*aaa
507 nod_normal(2,j,irm)=ny*aaa
508 nod_normal(3,j,irm)=nz*aaa
509 END IF
510 END IF
511 END DO
512 ENDIF
513 END DO
514C------------------------------------
515C Nodal normals
516C------------------------------------
517 IF(sol_edge/=0)THEN
518 DO i=1,nadmsr
519 aaa=run/max(rem30,sqrt(e2s_nod_normal(1,i)*e2s_nod_normal(1,i)+
520 . e2s_nod_normal(2,i)*e2s_nod_normal(2,i)+
521 . e2s_nod_normal(3,i)*e2s_nod_normal(3,i)))
522 e2s_nod_normal(1,i)=e2s_nod_normal(1,i)*aaa
523 e2s_nod_normal(2,i)=e2s_nod_normal(2,i)*aaa
524 e2s_nod_normal(3,i)=e2s_nod_normal(3,i)*aaa
525 END DO
526 ENDIF
527C------------------------------------
528
529 DEALLOCATE(wnod_normal)
530
531 RETURN
532 END
my_real
#define my_real
Definition cppsort.cpp:32
i25norm
subroutine i25norm(nrtm, irectm, numnod, x, nod_normal, nmn, msr, itab, nrtm0, msegtyp, mvoisin, evoisin, nedge, ledge, lbound, admsr, vtx_bisector, e2s_nod_normal, nadmsr, iedge, ielem_m)
Definition i25norm3.F:45
min
#define min(a, b)
Definition macros.h:20
max
#define max(a, b)
Definition macros.h:21
mod_i25norm
Definition i25norm3.F:28
mod_i25norm::wnod_normal
real *4, dimension(:,:,:), allocatable wnod_normal
Definition i25norm3.F:30