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

Go to the source code of this file.

Functions/Subroutines

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

Function/Subroutine Documentation

◆ sdlensh()

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

Definition at line 30 of file sdlensh.F.

38C-----------------------------------------------
39C I m p l i c i t T y p e s
40C-----------------------------------------------
41#include "implicit_f.inc"
42C-----------------------------------------------
43C G l o b a l P a r a m e t e r s
44C-----------------------------------------------
45#include "mvsiz_p.inc"
46C-----------------------------------------------
47C C o m m o n B l o c k s
48C-----------------------------------------------
49#include "scr17_c.inc"
50C-----------------------------------------------
51C D u m m y A r g u m e n t s
52C-----------------------------------------------
53 INTEGER, INTENT(IN) :: NEL
54 my_real, DIMENSION(MVSIZ) , INTENT(OUT) :: area
55 my_real
56 . voln(*),llsh(*),
57 . x1(*), x2(*), x3(*), x4(*), x5(*), x6(*), x7(*), x8(*),
58 . y1(*), y2(*), y3(*), y4(*), y5(*), y6(*), y7(*), y8(*),
59 . z1(*), z2(*), z3(*), z4(*), z5(*), z6(*), z7(*), z8(*)
60C-----------------------------------------------
61C L o c a l V a r i a b l e s
62C-----------------------------------------------
63 INTEGER I, J, N
64 my_real
65 . rx(mvsiz),ry(mvsiz),rz(mvsiz),sx(mvsiz),sy(mvsiz),sz(mvsiz),
66 . vq(3,3,mvsiz), lxyz0(3),deta1(mvsiz),xx,yy,zz,
67 . xl2(mvsiz),xl3(mvsiz),xl4(mvsiz),yl2(mvsiz),
68 . yl3(mvsiz),yl4(mvsiz),zl1(mvsiz),
69 . xn(4,mvsiz) , yn(4,mvsiz) , zn(4,mvsiz)
70 my_real
71 . al1,al2,ll(mvsiz),corel(2,4)
72 my_real
73 . x13,x24,y13,y24,l13,l24,c1,c2,thkly,posly,
74 . fac,visce,rx1,ry1,sx1,sy1,s1,fac1,fac2,faci,fac11,facdt
75C=======================================================================
76 DO i=1,nel
77 xn(1,i) = half*(x1(i)+x5(i))
78 yn(1,i) = half*(y1(i)+y5(i))
79 zn(1,i) = half*(z1(i)+z5(i))
80 xn(2,i) = half*(x2(i)+x6(i))
81 yn(2,i) = half*(y2(i)+y6(i))
82 zn(2,i) = half*(z2(i)+z6(i))
83 xn(3,i) = half*(x3(i)+x7(i))
84 yn(3,i) = half*(y3(i)+y7(i))
85 zn(3,i) = half*(z3(i)+z7(i))
86 xn(4,i) = half*(x4(i)+x8(i))
87 yn(4,i) = half*(y4(i)+y8(i))
88 zn(4,i) = half*(z4(i)+z8(i))
89 ENDDO
90C------g1,g2 :
91 DO i=1,nel
92 rx(i)=xn(2,i)+xn(3,i)-xn(1,i)-xn(4,i)
93 ry(i)=yn(2,i)+yn(3,i)-yn(1,i)-yn(4,i)
94 rz(i)=zn(2,i)+zn(3,i)-zn(1,i)-zn(4,i)
95 sx(i)=xn(3,i)+xn(4,i)-xn(1,i)-xn(2,i)
96 sy(i)=yn(3,i)+yn(4,i)-yn(1,i)-yn(2,i)
97 sz(i)=zn(3,i)+zn(4,i)-zn(1,i)-zn(2,i)
98 ENDDO
99C------Local elem. base:
100 CALL clsys3(rx, ry, rz, sx, sy, sz,
101 . vq, deta1,nel)
102C------ Global -> Local Coordinate FOURTH=0.25 ;
103 DO i=1,nel
104 lxyz0(1)=fourth*(xn(1,i)+xn(2,i)+xn(3,i)+xn(4,i))
105 lxyz0(2)=fourth*(yn(1,i)+yn(2,i)+yn(3,i)+yn(4,i))
106 lxyz0(3)=fourth*(zn(1,i)+zn(2,i)+zn(3,i)+zn(4,i))
107 xx=xn(2,i)-xn(1,i)
108 yy=yn(2,i)-yn(1,i)
109 zz=zn(2,i)-zn(1,i)
110 xl2(i)=vq(1,1,i)*xx+vq(2,1,i)*yy+vq(3,1,i)*zz
111 yl2(i)=vq(1,2,i)*xx+vq(2,2,i)*yy+vq(3,2,i)*zz
112 xx=xn(2,i)-lxyz0(1)
113 yy=yn(2,i)-lxyz0(2)
114 zz=zn(2,i)-lxyz0(3)
115 zl1(i)=vq(1,3,i)*xx+vq(2,3,i)*yy+vq(3,3,i)*zz
116C
117 xx=xn(3,i)-xn(1,i)
118 yy=yn(3,i)-yn(1,i)
119 zz=zn(3,i)-zn(1,i)
120 xl3(i)=vq(1,1,i)*xx+vq(2,1,i)*yy+vq(3,1,i)*zz
121 yl3(i)=vq(1,2,i)*xx+vq(2,2,i)*yy+vq(3,2,i)*zz
122C
123 xx=xn(4,i)-xn(1,i)
124 yy=yn(4,i)-yn(1,i)
125 zz=zn(4,i)-zn(1,i)
126 xl4(i)=vq(1,1,i)*xx+vq(2,1,i)*yy+vq(3,1,i)*zz
127 yl4(i)=vq(1,2,i)*xx+vq(2,2,i)*yy+vq(3,2,i)*zz
128 area(i)=fourth*deta1(i)
129 ENDDO
130 fac = two
131 facdt = five_over_4
132C-------same than QBAT
133 IF (idt1sol>0) facdt =four_over_3
134C---- compute COREL(2,4) mean surface and area
135 DO i=1,nel
136 lxyz0(1)=fourth*(xl2(i)+xl3(i)+xl4(i))
137 lxyz0(2)=fourth*(yl2(i)+yl3(i)+yl4(i))
138 corel(1,1)=-lxyz0(1)
139 corel(1,2)=xl2(i)-lxyz0(1)
140 corel(1,3)=xl3(i)-lxyz0(1)
141 corel(1,4)=xl4(i)-lxyz0(1)
142 corel(2,1)=-lxyz0(2)
143 corel(2,2)=yl2(i)-lxyz0(2)
144 corel(2,3)=yl3(i)-lxyz0(2)
145 corel(2,4)=yl4(i)-lxyz0(2)
146 x13=(corel(1,1)-corel(1,3))*half
147 x24=(corel(1,2)-corel(1,4))*half
148 y13=(corel(2,1)-corel(2,3))*half
149 y24=(corel(2,2)-corel(2,4))*half
150C
151 l13=x13*x13+y13*y13
152 l24=x24*x24+y24*y24
153 al1=max(l13,l24)
154 c1 =corel(1,2)*corel(2,4)-corel(2,2)*corel(1,4)
155 c2 =corel(1,1)*corel(2,3)-corel(2,1)*corel(1,3)
156 al2 =max(abs(c1),abs(c2))/area(i)
157 rx1=x24-x13
158 ry1=y24-y13
159 sx1=-x24-x13
160 sy1=-y24-y13
161 c1=sqrt(rx1*rx1+ry1*ry1)
162 c2=sqrt(sx1*sx1+sy1*sy1)
163 s1=fourth*(max(c1,c2)/min(c1,c2)-one)
164 fac1=min(half,s1)+one
165 fac2=area(i)/(c1*c2)
166 fac2=3.413*max(zero,fac2-0.7071)
167 fac2=0.78+0.22*fac2*fac2*fac2
168 faci=two*fac1*fac2
169 s1 = sqrt(faci*(facdt+al2)*al1)
170 s1 = max(s1,em20)
171 llsh(i) = area(i)/s1
172 ENDDO
173C
174 RETURN
my_real
#define my_real
Definition cppsort.cpp:32
area
subroutine area(d1, x, x2, y, y2, eint, stif0)
Definition hm_read_prop32.F:567
min
#define min(a, b)
Definition macros.h:20
max
#define max(a, b)
Definition macros.h:21
clsys3
subroutine clsys3(rx, ry, rz, sx, sy, sz, vq, det, nel, mvsiz)
Definition scinit3.F:715