OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
sdlen8.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 sdlen8 (deltax, volg, ixs, 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

◆ sdlen8()

subroutine sdlen8 ( deltax,
volg,
integer, dimension(nixs,*) ixs,
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 34 of file sdlen8.F.

42 use element_mod , only : nixs
43C-----------------------------------------------
44C I m p l i c i t T y p e s
45C-----------------------------------------------
46#include "implicit_f.inc"
47C-----------------------------------------------
48C G l o b a l P a r a m e t e r s
49C-----------------------------------------------
50#include "mvsiz_p.inc"
51C-----------------------------------------------
52C D u m m y A r g u m e n t s
53C-----------------------------------------------
54 INTEGER, INTENT(IN) :: NEL
55 INTEGER IXS(NIXS,*)
56C REAL
58 . deltax(*),volg(*),
59 . x1(*), x2(*), x3(*), x4(*), x5(*), x6(*), x7(*), x8(*),
60 . y1(*), y2(*), y3(*), y4(*), y5(*), y6(*), y7(*), y8(*),
61 . z1(*), z2(*), z3(*), z4(*), z5(*), z6(*), z7(*), z8(*)
62C-----------------------------------------------
63C C o m m o n B l o c k s
64C-----------------------------------------------
65#include "scr17_c.inc"
66C-----------------------------------------------
67C L o c a l V a r i a b l e s
68C-----------------------------------------------
69 INTEGER I, IPT, IDEGE(MVSIZ)
70C REAL
72 . aj11, aj12, aj13, aj21,
73 . aj22, aj23, aj31, aj32,
74 . aj33, ai11,
75 . ai21, ai31
76C REAL
78 . x12(mvsiz), x34(mvsiz), x56(mvsiz),
79 . x78(mvsiz), y12(mvsiz), y34(mvsiz), y56(mvsiz), y78(mvsiz),
80 . z12(mvsiz), z34(mvsiz), z56(mvsiz), z78(mvsiz), x14(mvsiz),
81 . x23(mvsiz), x58(mvsiz), x67(mvsiz), y14(mvsiz), y23(mvsiz),
82 . y58(mvsiz), y67(mvsiz), z14(mvsiz), z23(mvsiz), z58(mvsiz),
83 . z67(mvsiz), x15(mvsiz), x26(mvsiz), x37(mvsiz), x48(mvsiz),
84 . y15(mvsiz), y26(mvsiz), y37(mvsiz), y48(mvsiz), z15(mvsiz),
85 . z26(mvsiz), z37(mvsiz), z48(mvsiz), h(8),
86 . xx1,yy1,zz1,xx2,yy2,zz2,xx3,yy3,zz3,smax(mvsiz),vmin,
87 . p1(8), p2(8), p3(8),vlinc(mvsiz,8)
88C-----------------------------------------------
89C
90 IF (idts6>0) THEN
91 CALL sdlen_dege(
92 1 volg, deltax, x1, x2,
93 2 x3, x4, x5, x6,
94 3 x7, x8, y1, y2,
95 4 y3, y4, y5, y6,
96 5 y7, y8, z1, z2,
97 6 z3, z4, z5, z6,
98 7 z7, z8, ixs, idege,
99 8 nel)
100 ELSE
101 idege(1:nel)=0
102 END IF
103C
104 DO i=1,nel
105 x12(i)=x1(i)-x2(i)
106 y12(i)=y1(i)-y2(i)
107 z12(i)=z1(i)-z2(i)
108 x34(i)=x3(i)-x4(i)
109 y34(i)=y3(i)-y4(i)
110 z34(i)=z3(i)-z4(i)
111 x56(i)=x5(i)-x6(i)
112 y56(i)=y5(i)-y6(i)
113 z56(i)=z5(i)-z6(i)
114 x78(i)=x7(i)-x8(i)
115 y78(i)=y7(i)-y8(i)
116 z78(i)=z7(i)-z8(i)
117 x14(i)=x1(i)-x4(i)
118 y14(i)=y1(i)-y4(i)
119 z14(i)=z1(i)-z4(i)
120 x23(i)=x2(i)-x3(i)
121 y23(i)=y2(i)-y3(i)
122 z23(i)=z2(i)-z3(i)
123 x58(i)=x5(i)-x8(i)
124 y58(i)=y5(i)-y8(i)
125 z58(i)=z5(i)-z8(i)
126 x67(i)=x6(i)-x7(i)
127 y67(i)=y6(i)-y7(i)
128 z67(i)=z6(i)-z7(i)
129 x15(i)=x1(i)-x5(i)
130 y15(i)=y1(i)-y5(i)
131 z15(i)=z1(i)-z5(i)
132 x26(i)=x2(i)-x6(i)
133 y26(i)=y2(i)-y6(i)
134 z26(i)=z2(i)-z6(i)
135 x37(i)=x3(i)-x7(i)
136 y37(i)=y3(i)-y7(i)
137 z37(i)=z3(i)-z7(i)
138 x48(i)=x4(i)-x8(i)
139 y48(i)=y4(i)-y8(i)
140 z48(i)=z4(i)-z8(i)
141 END DO
142C
143 DO ipt=1,8
144 CALL basisf (h,p1,p2,p3,ipt)
145C
146 DO i=1,nel
147 aj11=p1(1)*x12(i)+p1(3)*x34(i)+p1(5)*x56(i)+p1(7)*x78(i)
148 aj12=p1(1)*y12(i)+p1(3)*y34(i)+p1(5)*y56(i)+p1(7)*y78(i)
149 aj13=p1(1)*z12(i)+p1(3)*z34(i)+p1(5)*z56(i)+p1(7)*z78(i)
150 aj21=p2(1)*x14(i)+p2(2)*x23(i)+p2(5)*x58(i)+p2(6)*x67(i)
151 aj22=p2(1)*y14(i)+p2(2)*y23(i)+p2(5)*y58(i)+p2(6)*y67(i)
152 aj23=p2(1)*z14(i)+p2(2)*z23(i)+p2(5)*z58(i)+p2(6)*z67(i)
153 aj31=p3(1)*x15(i)+p3(2)*x26(i)+p3(3)*x37(i)+p3(4)*x48(i)
154 aj32=p3(1)*y15(i)+p3(2)*y26(i)+p3(3)*y37(i)+p3(4)*y48(i)
155 aj33=p3(1)*z15(i)+p3(2)*z26(i)+p3(3)*z37(i)+p3(4)*z48(i)
156
157 ai11= aj22*aj33-aj23*aj32
158 ai21=-aj21*aj33+aj23*aj31
159 ai31= aj21*aj32-aj22*aj31
160 vlinc(i,ipt)=aj11*ai11+aj12*ai21+aj13*ai31
161 ENDDO
162 END DO ! IPT=1,8
163C
164 DO i=1,nel
165c mediane * 4
166 xx1 = x1(i) + x2(i) + x3(i) + x4(i)
167 . - x5(i) - x6(i) - x7(i) - x8(i)
168 yy1 = y1(i) + y2(i) + y3(i) + y4(i)
169 . - y5(i) - y6(i) - y7(i) - y8(i)
170 zz1 = z1(i) + z2(i) + z3(i) + z4(i)
171 . - z5(i) - z6(i) - z7(i) - z8(i)
172 xx2 = x1(i) + x2(i) + x5(i) + x6(i)
173 . - x3(i) - x4(i) - x7(i) - x8(i)
174 yy2 = y1(i) + y2(i) + y5(i) + y6(i)
175 . - y3(i) - y4(i) - y7(i) - y8(i)
176 zz2 = z1(i) + z2(i) + z5(i) + z6(i)
177 . - z3(i) - z4(i) - z7(i) - z8(i)
178 xx3 = x1(i) + x4(i) + x5(i) + x8(i)
179 . - x3(i) - x2(i) - x7(i) - x6(i)
180 yy3 = y1(i) + y4(i) + y5(i) + y8(i)
181 . - y3(i) - y2(i) - y7(i) - y6(i)
182 zz3 = z1(i) + z4(i) + z5(i) + z8(i)
183 . - z3(i) - z2(i) - z7(i) - z6(i)
184C surface * 16
185 smax(i) = (yy1 * zz2 - yy2 * zz1)**2
186 . + (zz1 * xx2 - zz2 * xx1)**2
187 . + (xx1 * yy2 - xx2 * yy1)**2
188 smax(i) = max(smax(i),(yy1 * zz3 - yy3 * zz1)**2
189 . + (zz1 * xx3 - zz3 * xx1)**2
190 . + (xx1 * yy3 - xx3 * yy1)**2)
191 smax(i) = max(smax(i),(yy3 * zz2 - yy2 * zz3)**2
192 . + (zz3 * xx2 - zz2 * xx3)**2
193 . + (xx3 * yy2 - xx2 * yy3)**2)
194 ENDDO
195C volume / 8
196 IF (idts6>0) THEN
197 DO i=1,nel
198 IF(idege(i)==0)THEN
199 vmin = min(vlinc(i,1),vlinc(i,2),vlinc(i,3),vlinc(i,4),
200 . vlinc(i,5),vlinc(i,6),vlinc(i,7),vlinc(i,8))
201C
202 deltax(i)=hundred28*vmin/sqrt(smax(i))
203 ENDIF
204 ENDDO
205 ELSE
206 DO i=1,nel
207 vmin = min(vlinc(i,1),vlinc(i,2),vlinc(i,3),vlinc(i,4),
208 . vlinc(i,5),vlinc(i,6),vlinc(i,7),vlinc(i,8))
209C
210 deltax(i)=hundred28*vmin/sqrt(smax(i))
211 ENDDO
212 ENDIF
213
214
215C-----------
216 RETURN
#define my_real
Definition cppsort.cpp:32
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
#define min(a, b)
Definition macros.h:20
#define max(a, b)
Definition macros.h:21
subroutine sdlen_dege(volg, lat, x1, x2, x3, x4, x5, x6, x7, x8, y1, y2, y3, y4, y5, y6, y7, y8, z1, z2, z3, z4, z5, z6, z7, z8, ixs, idege, nel)
Definition sdlen_dege.F:47
subroutine basisf(h, p1, p2, p3, ipt)
Definition basisf.F:32