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

Go to the source code of this file.

Functions/Subroutines

subroutine sldege (x1, x2, x3, x4, x5, x6, x7, x8, y1, y2, y3, y4, y5, y6, y7, y8, z1, z2, z3, z4, z5, z6, z7, z8, area, aream, volg, nel)

Function/Subroutine Documentation

◆ sldege()

subroutine sldege ( x1,
x2,
x3,
x4,
x5,
x6,
x7,
x8,
y1,
y2,
y3,
y4,
y5,
y6,
y7,
y8,
z1,
z2,
z3,
z4,
z5,
z6,
z7,
z8,
area,
aream,
volg,
integer, intent(in) nel )

Definition at line 32 of file sldege.F.

40C-----------------------------------------------
41C I m p l i c i t T y p e s
42C-----------------------------------------------
43#include "implicit_f.inc"
44C-----------------------------------------------
45C G l o b a l P a r a m e t e r s
46C-----------------------------------------------
47#include "mvsiz_p.inc"
48C-----------------------------------------------
49C D u m m y A r g u m e n t s
50C-----------------------------------------------
51 INTEGER, INTENT(IN) :: NEL
52 my_real
53 . x1(*), x2(*), x3(*), x4(*), x5(*), x6(*), x7(*), x8(*),
54 . y1(*), y2(*), y3(*), y4(*), y5(*), y6(*), y7(*), y8(*),
55 . z1(*), z2(*), z3(*), z4(*), z5(*), z6(*), z7(*), z8(*),
56 . area(mvsiz,6),aream(*),volg(*)
57C-----------------------------------------------
58C C o m m o n B l o c k s
59C-----------------------------------------------
60C-----------------------------------------------
61C L o c a l V a r i a b l e s
62C-----------------------------------------------
63 INTEGER I,IDEG(MVSIZ),J,IDET4(MVSIZ),IT(MVSIZ)
64 INTEGER :: N_INDX
65 INTEGER, DIMENSION(MVSIZ) :: INDX
66 my_real fac(mvsiz),v_g
67C-----------------------------------------------
68 ideg(1:mvsiz)=0
69 DO j=1,6
70 DO i=1,nel
71 IF(area(i,j)<em30) ideg(i)=ideg(i)+1
72 ENDDO
73 ENDDO
74C
75 n_indx = 0
76 DO i=1,nel
77C-------due to the fact that AREA_Max*L is far from V for Dege---
78 IF(ideg(i) > 0) THEN
79 aream(i) =em20
80C----tetra 4 ,pyrami
81 IF (ideg(i)>=2) THEN
82 fac(i)=one_over_9
83 ELSE
84 fac(i)=fourth
85 END IF
86 n_indx = n_indx + 1
87 indx(n_indx) = i
88 ENDIF
89 ENDDO
90 idet4(1:mvsiz) = 1
91 it(1:mvsiz) = 0
92 IF(n_indx>0) THEN
93 CALL idege(x1,x2,x3,x4,y1,y2,y3,y4,
94 . z1,z2,z3,z4,area(1,1),aream,fac,idet4,it,indx,n_indx)
95 CALL idege(x5,x6,x7,x8,y5,y6,y7,y8,
96 . z5,z6,z7,z8,area(1,2),aream,fac,idet4,it,indx,n_indx)
97 CALL idege(x1,x2,x6,x5,y1,y2,y6,y5,
98 . z1,z2,z6,z5,area(1,3),aream,fac,idet4,it,indx,n_indx)
99 CALL idege(x2,x3,x7,x6,y2,y3,y7,y6,
100 . z2,z3,z7,z6,area(1,4),aream,fac,idet4,it,indx,n_indx)
101 CALL idege(x3,x4,x8,x7,y3,y4,y8,y7,
102 . z3,z4,z8,z7,area(1,5),aream,fac,idet4,it,indx,n_indx)
103 CALL idege(x4,x1,x5,x8,y4,y1,y5,y8,
104 . z4,z1,z5,z8,area(1,6),aream,fac,idet4,it,indx,n_indx)
105
106#include "vectorize.inc"
107 DO j=1,n_indx
108 i = indx(j)
109C--------suposse here V=0.5*A_max*L for penta =0.333A_max*L for Pyram
110 IF (it(i) ==0 ) aream(i)=fac(i)*aream(i)
111C--------add special treat for tetra4, as V is not right values
112 IF (idet4(i) ==1 ) THEN
113 CALL deges4v(v_g,
114 . x1(i), x2(i), x3(i), x4(i), x5(i), x6(i), x7(i), x8(i),
115 . y1(i), y2(i), y3(i), y4(i), y5(i), y6(i), y7(i), y8(i),
116 . z1(i), z2(i), z3(i), z4(i), z5(i), z6(i), z7(i), z8(i))
117 fac(i)=third*volg(i)/v_g
118 aream(i)=fac(i)*fac(i)*aream(i)
119 END IF
120 ENDDO
121 ENDIF
122C
123 RETURN
my_real
#define my_real
Definition cppsort.cpp:32
deges4v
subroutine deges4v(det, x1, x2, x3, x4, x5, x6, x7, x8, y1, y2, y3, y4, y5, y6, y7, y8, z1, z2, z3, z4, z5, z6, z7, z8)
Definition deges4v.F:37
area
subroutine area(d1, x, x2, y, y2, eint, stif0)
Definition hm_read_prop32.F:567
idege
subroutine idege(x1, x2, x3, x4, y1, y2, y3, y4, z1, z2, z3, z4, a, amax, fac, it4, it, indx, n_indx)
Definition idege.F:30