OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
i25norm3.F File Reference
#include "implicit_f.inc"
#include "mvsiz_p.inc"
#include "param_c.inc"

Go to the source code of this file.

Modules

module  mod_i25norm

Functions/Subroutines

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)

Variables

real *4, dimension(:,:,:), allocatable mod_i25norm::wnod_normal

Function/Subroutine Documentation

◆ i25norm()

subroutine i25norm ( integer nrtm,
integer, dimension(4,nrtm) irectm,
integer numnod,
x,
real*4, dimension(3,4,nrtm) nod_normal,
integer nmn,
integer, dimension(*) msr,
integer, dimension(*) itab,
integer nrtm0,
integer, dimension(*) msegtyp,
integer, dimension(4,nrtm) mvoisin,
integer, dimension(4,nrtm) evoisin,
integer nedge,
integer, dimension(nledge,*) ledge,
integer, dimension(*) lbound,
integer, dimension(4,*) admsr,
real*4, dimension(3,2,*) vtx_bisector,
real*4, dimension(3,*) e2s_nod_normal,
integer nadmsr,
integer iedge,
integer, dimension(2,nrtm), intent(inout) ielem_m )

Definition at line 40 of file i25norm3.F.

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 Optimizable in SPMD If Addition Flag for 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 ish=msegtyp(irm)
278 IF(ish > 0) THEN
279 IF(ish > nrtm)ish=ish-nrtm
280C
281 IF(ix3(i)/=ix4(i))THEN
282C
283 nod_normal(1,1,ish)=-xn1(i)
284 nod_normal(2,1,ish)=-yn1(i)
285 nod_normal(3,1,ish)=-zn1(i)
286C
287 nod_normal(1,4,ish)=-xn2(i)
288 nod_normal(2,4,ish)=-yn2(i)
289 nod_normal(3,4,ish)=-zn2(i)
290C
291 nod_normal(1,3,ish)=-xn3(i)
292 nod_normal(2,3,ish)=-yn3(i)
293 nod_normal(3,3,ish)=-zn3(i)
294C
295 nod_normal(1,2,ish)=-xn4(i)
296 nod_normal(2,2,ish)=-yn4(i)
297 nod_normal(3,2,ish)=-zn4(i)
298C
299 ELSE
300C
301 nod_normal(1,1,ish)=-xn1(i)
302 nod_normal(2,1,ish)=-yn1(i)
303 nod_normal(3,1,ish)=-zn1(i)
304C
305 nod_normal(1,4,ish)=-xn1(i)
306 nod_normal(2,4,ish)=-yn1(i)
307 nod_normal(3,4,ish)=-zn1(i)
308C
309 nod_normal(1,2,ish)=-xn1(i)
310 nod_normal(2,2,ish)=-yn1(i)
311 nod_normal(3,2,ish)=-zn1(i)
312C
313 ENDIF
314 END IF
315 ENDDO
316
317
318 IF(sol_edge/=0)THEN
319C
320 DO i=1,last-first+1
321C
322 irm=i+first-1
323C
324 i1=abs(admsr(1,irm))
325 i2=abs(admsr(2,irm))
326 i3=abs(admsr(3,irm))
327 i4=abs(admsr(4,irm))
328C
329 xad=admsr(1,irm)
330 s1=sign(run,xad)
331c s1=ONE
332 xad=admsr(2,irm)
333 s2=sign(run,xad)
334c s2=ONE
335 xad=admsr(3,irm)
336 s3=sign(run,xad)
337c s3=ONE
338 xad=admsr(4,irm)
339 s4=sign(run,xad)
340c s4=ONE
341C
342 IF(i4/=i3)THEN
343C
344 e2s_nod_normal(1,i1)=e2s_nod_normal(1,i1)+s1*(xn4(i)+xn1(i))
345 e2s_nod_normal(2,i1)=e2s_nod_normal(2,i1)+s1*(yn4(i)+yn1(i))
346 e2s_nod_normal(3,i1)=e2s_nod_normal(3,i1)+s1*(zn4(i)+zn1(i))
347C
348 e2s_nod_normal(1,i2)=e2s_nod_normal(1,i2)+s2*(xn1(i)+xn2(i))
349 e2s_nod_normal(2,i2)=e2s_nod_normal(2,i2)+s2*(yn1(i)+yn2(i))
350 e2s_nod_normal(3,i2)=e2s_nod_normal(3,i2)+s2*(zn1(i)+zn2(i))
351C
352 e2s_nod_normal(1,i3)=e2s_nod_normal(1,i3)+s3*(xn2(i)+xn3(i))
353 e2s_nod_normal(2,i3)=e2s_nod_normal(2,i3)+s3*(yn2(i)+yn3(i))
354 e2s_nod_normal(3,i3)=e2s_nod_normal(3,i3)+s3*(zn2(i)+zn3(i))
355C
356 e2s_nod_normal(1,i4)=e2s_nod_normal(1,i4)+s4*(xn3(i)+xn4(i))
357 e2s_nod_normal(2,i4)=e2s_nod_normal(2,i4)+s4*(yn3(i)+yn4(i))
358 e2s_nod_normal(3,i4)=e2s_nod_normal(3,i4)+s4*(zn3(i)+zn4(i))
359C
360 ELSE
361C
362 e2s_nod_normal(1,i1)=e2s_nod_normal(1,i1)+s1*xn1(i)
363 e2s_nod_normal(2,i1)=e2s_nod_normal(2,i1)+s1*yn1(i)
364 e2s_nod_normal(3,i1)=e2s_nod_normal(3,i1)+s1*zn1(i)
365C
366 e2s_nod_normal(1,i2)=e2s_nod_normal(1,i2)+s2*xn1(i)
367 e2s_nod_normal(2,i2)=e2s_nod_normal(2,i2)+s2*yn1(i)
368 e2s_nod_normal(3,i2)=e2s_nod_normal(3,i2)+s2*zn1(i)
369C
370 e2s_nod_normal(1,i3)=e2s_nod_normal(1,i3)+s3*xn1(i)
371 e2s_nod_normal(2,i3)=e2s_nod_normal(2,i3)+s3*yn1(i)
372 e2s_nod_normal(3,i3)=e2s_nod_normal(3,i3)+s3*zn1(i)
373C
374 END IF
375C
376 ENDDO
377
378 ENDIF
379
380
381C
382 IF(last < nrtm0)THEN
383 first=last+1
384 last =min(last+mvsiz,nrtm0)
385 GO TO 100
386 END IF
387C------------------------------------
388 DO irm=1,nrtm
389C
390 IF(ielem_m(2,irm) ==0)THEN
391 DO iedg=1,4
392 IF(mvoisin(iedg,irm)==0)THEN
393 IF(.NOT.(irectm(3,irm)==irectm(4,irm).AND.iedg==3))THEN
394C
395 nx=nod_normal(1,iedg,irm)
396 ny=nod_normal(2,iedg,irm)
397 nz=nod_normal(3,iedg,irm)
398C
399 i1=irectm(iedg,irm)
400 i2=irectm(mod(iedg,4)+1,irm)
401
402 x12=x(1,i2)-x(1,i1)
403 y12=x(2,i2)-x(2,i1)
404 z12=x(3,i2)-x(3,i1)
405
406 vx=y12*nz-z12*ny
407 vy=z12*nx-x12*nz
408 vz=x12*ny-y12*nx
409
410 aaa=run/max(rem30,sqrt(vx*vx+vy*vy+vz*vz))
411 vx=vx*aaa
412 vy=vy*aaa
413 vz=vz*aaa
414
415 nod_normal(1,iedg,irm)=vx
416 nod_normal(2,iedg,irm)=vy
417 nod_normal(3,iedg,irm)=vz
418
419 END IF
420 END IF
421 END DO
422 ENDIF
423 END DO
424C
425 DO irm=1,nrtm
426
427 IF(ielem_m(2,irm) ==0)THEN
428 DO iedg=1,4
429
430 IF(mvoisin(iedg,irm)==0)THEN
431 IF(.NOT.(irectm(3,irm)==irectm(4,irm).AND.iedg==3))THEN
432
433 vx=nod_normal(1,iedg,irm)
434 vy=nod_normal(2,iedg,irm)
435 vz=nod_normal(3,iedg,irm)
436C
437 is1=admsr(iedg,irm)
438C LBOUND(IS1)=1
439 IF(vtx_bisector(1,1,is1)==rzero.AND.
440 . vtx_bisector(2,1,is1)==rzero.AND.
441 . vtx_bisector(3,1,is1)==rzero)THEN
442 vtx_bisector(1,1,is1)=vx
443 vtx_bisector(2,1,is1)=vy
444 vtx_bisector(3,1,is1)=vz
445 ELSE
446 vtx_bisector(1,2,is1)=vx
447 vtx_bisector(2,2,is1)=vy
448 vtx_bisector(3,2,is1)=vz
449 END IF
450C
451 is2=admsr(mod(iedg,4)+1,irm)
452C LBOUND(IS2)=1
453 IF(vtx_bisector(1,1,is2)==rzero.AND.
454 . vtx_bisector(2,1,is2)==rzero.AND.
455 . vtx_bisector(3,1,is2)==rzero)THEN
456 vtx_bisector(1,1,is2)=vx
457 vtx_bisector(2,1,is2)=vy
458 vtx_bisector(3,1,is2)=vz
459 ELSE
460 vtx_bisector(1,2,is2)=vx
461 vtx_bisector(2,2,is2)=vy
462 vtx_bisector(3,2,is2)=vz
463 END IF
464
465 END IF
466 END IF
467 END DO
468 ENDIF
469 END DO
470C------------------------------------
471 ALLOCATE(wnod_normal(3,4,nrtm))
472C------------------------------------
473 DO irm=1,nrtm
474 IF(ielem_m(2,irm) ==0)THEN
475 DO j=1,4
476 IF(.NOT.(irectm(3,irm)==irectm(4,irm).AND.j==3))THEN
477 jrm =mvoisin(j,irm)
478 jedg=evoisin(j,irm)
479 IF(jrm /= 0)THEN
480 wnod_normal(1,j,irm)=nod_normal(1,jedg,jrm)
481 wnod_normal(2,j,irm)=nod_normal(2,jedg,jrm)
482 wnod_normal(3,j,irm)=nod_normal(3,jedg,jrm)
483 ELSE
484 wnod_normal(1,j,irm)=rzero
485 wnod_normal(2,j,irm)=rzero
486 wnod_normal(3,j,irm)=rzero
487 END IF
488 END IF
489 END DO
490 ENDIF
491 END DO
492C------------------------------------
493 DO irm=1,nrtm
494 IF(ielem_m(2,irm) ==0)THEN
495 DO j=1,4
496 IF(.NOT.(irectm(3,irm)==irectm(4,irm).AND.j==3))THEN
497 jrm =mvoisin(j,irm)
498 IF( jrm /= 0) THEN
499 nx=nod_normal(1,j,irm)+wnod_normal(1,j,irm)
500 ny=nod_normal(2,j,irm)+wnod_normal(2,j,irm)
501 nz=nod_normal(3,j,irm)+wnod_normal(3,j,irm)
502 aaa=run/max(rem30,sqrt(nx*nx+ny*ny+nz*nz))
503 nod_normal(1,j,irm)=nx*aaa
504 nod_normal(2,j,irm)=ny*aaa
505 nod_normal(3,j,irm)=nz*aaa
506 END IF
507 END IF
508 END DO
509 ENDIF
510 END DO
511C------------------------------------
512C Nodal normals
513C------------------------------------
514 IF(sol_edge/=0)THEN
515 DO i=1,nadmsr
516 aaa=run/max(rem30,sqrt(e2s_nod_normal(1,i)*e2s_nod_normal(1,i)+
517 . e2s_nod_normal(2,i)*e2s_nod_normal(2,i)+
518 . e2s_nod_normal(3,i)*e2s_nod_normal(3,i)))
519 e2s_nod_normal(1,i)=e2s_nod_normal(1,i)*aaa
520 e2s_nod_normal(2,i)=e2s_nod_normal(2,i)*aaa
521 e2s_nod_normal(3,i)=e2s_nod_normal(3,i)*aaa
522 END DO
523 ENDIF
524C------------------------------------
525
526 DEALLOCATE(wnod_normal)
527
528 RETURN
my_real
#define my_real
Definition cppsort.cpp:32
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