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 32 of file sdlen8.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 INTEGER IXS(NIXS,*)
53C REAL
55 . deltax(*),volg(*),
56 . x1(*), x2(*), x3(*), x4(*), x5(*), x6(*), x7(*), x8(*),
57 . y1(*), y2(*), y3(*), y4(*), y5(*), y6(*), y7(*), y8(*),
58 . z1(*), z2(*), z3(*), z4(*), z5(*), z6(*), z7(*), z8(*)
59C-----------------------------------------------
60C C o m m o n B l o c k s
61C-----------------------------------------------
62#include "scr17_c.inc"
63C-----------------------------------------------
64C L o c a l V a r i a b l e s
65C-----------------------------------------------
66 INTEGER I, J, IPT, IDEGE(MVSIZ)
67C REAL
69 . aj11, aj12, aj13, aj21,
70 . aj22, aj23, aj31, aj32,
71 . aj33, ai11, ai12, ai13,
72 . ai21, ai22, ai23, ai31,
73 . ai32, ai33
74C REAL
76 . x12(mvsiz), x34(mvsiz), x56(mvsiz),
77 . x78(mvsiz), y12(mvsiz), y34(mvsiz), y56(mvsiz), y78(mvsiz),
78 . z12(mvsiz), z34(mvsiz), z56(mvsiz), z78(mvsiz), x14(mvsiz),
79 . x23(mvsiz), x58(mvsiz), x67(mvsiz), y14(mvsiz), y23(mvsiz),
80 . y58(mvsiz), y67(mvsiz), z14(mvsiz), z23(mvsiz), z58(mvsiz),
81 . z67(mvsiz), x15(mvsiz), x26(mvsiz), x37(mvsiz), x48(mvsiz),
82 . y15(mvsiz), y26(mvsiz), y37(mvsiz), y48(mvsiz), z15(mvsiz),
83 . z26(mvsiz), z37(mvsiz), z48(mvsiz), h(8), vlinv,
84 . delta1,delta2,delta3,
85 . spx1,spx2,spx3,spx4,spx5,spx6,spx7,spx8,
86 . spy1,spy2,spy3,spy4,spy5,spy6,spy7,spy8,
87 . spz1,spz2,spz3,spz4,spz5,spz6,spz7,spz8,
88 . xx1,yy1,zz1,xx2,yy2,zz2,xx3,yy3,zz3,smax(mvsiz),vmin,
89 . p1(8), p2(8), p3(8),vlinc(mvsiz,8)
90C-----------------------------------------------
91C
92 IF (idts6>0) THEN
93 CALL sdlen_dege(
94 1 volg, deltax, x1, x2,
95 2 x3, x4, x5, x6,
96 3 x7, x8, y1, y2,
97 4 y3, y4, y5, y6,
98 5 y7, y8, z1, z2,
99 6 z3, z4, z5, z6,
100 7 z7, z8, ixs, idege,
101 8 nel)
102 ELSE
103 idege(1:nel)=0
104 END IF
105C
106 DO i=1,nel
107 x12(i)=x1(i)-x2(i)
108 y12(i)=y1(i)-y2(i)
109 z12(i)=z1(i)-z2(i)
110 x34(i)=x3(i)-x4(i)
111 y34(i)=y3(i)-y4(i)
112 z34(i)=z3(i)-z4(i)
113 x56(i)=x5(i)-x6(i)
114 y56(i)=y5(i)-y6(i)
115 z56(i)=z5(i)-z6(i)
116 x78(i)=x7(i)-x8(i)
117 y78(i)=y7(i)-y8(i)
118 z78(i)=z7(i)-z8(i)
119 x14(i)=x1(i)-x4(i)
120 y14(i)=y1(i)-y4(i)
121 z14(i)=z1(i)-z4(i)
122 x23(i)=x2(i)-x3(i)
123 y23(i)=y2(i)-y3(i)
124 z23(i)=z2(i)-z3(i)
125 x58(i)=x5(i)-x8(i)
126 y58(i)=y5(i)-y8(i)
127 z58(i)=z5(i)-z8(i)
128 x67(i)=x6(i)-x7(i)
129 y67(i)=y6(i)-y7(i)
130 z67(i)=z6(i)-z7(i)
131 x15(i)=x1(i)-x5(i)
132 y15(i)=y1(i)-y5(i)
133 z15(i)=z1(i)-z5(i)
134 x26(i)=x2(i)-x6(i)
135 y26(i)=y2(i)-y6(i)
136 z26(i)=z2(i)-z6(i)
137 x37(i)=x3(i)-x7(i)
138 y37(i)=y3(i)-y7(i)
139 z37(i)=z3(i)-z7(i)
140 x48(i)=x4(i)-x8(i)
141 y48(i)=y4(i)-y8(i)
142 z48(i)=z4(i)-z8(i)
143 END DO
144C
145 DO ipt=1,8
146 CALL basisf (h,p1,p2,p3,ipt)
147C
148 DO i=1,nel
149 aj11=p1(1)*x12(i)+p1(3)*x34(i)+p1(5)*x56(i)+p1(7)*x78(i)
150 aj12=p1(1)*y12(i)+p1(3)*y34(i)+p1(5)*y56(i)+p1(7)*y78(i)
151 aj13=p1(1)*z12(i)+p1(3)*z34(i)+p1(5)*z56(i)+p1(7)*z78(i)
152 aj21=p2(1)*x14(i)+p2(2)*x23(i)+p2(5)*x58(i)+p2(6)*x67(i)
153 aj22=p2(1)*y14(i)+p2(2)*y23(i)+p2(5)*y58(i)+p2(6)*y67(i)
154 aj23=p2(1)*z14(i)+p2(2)*z23(i)+p2(5)*z58(i)+p2(6)*z67(i)
155 aj31=p3(1)*x15(i)+p3(2)*x26(i)+p3(3)*x37(i)+p3(4)*x48(i)
156 aj32=p3(1)*y15(i)+p3(2)*y26(i)+p3(3)*y37(i)+p3(4)*y48(i)
157 aj33=p3(1)*z15(i)+p3(2)*z26(i)+p3(3)*z37(i)+p3(4)*z48(i)
158
159 ai11= aj22*aj33-aj23*aj32
160 ai21=-aj21*aj33+aj23*aj31
161 ai31= aj21*aj32-aj22*aj31
162 vlinc(i,ipt)=aj11*ai11+aj12*ai21+aj13*ai31
163 ENDDO
164 END DO ! IPT=1,8
165C
166 DO i=1,nel
167c mediane * 4
168 xx1 = x1(i) + x2(i) + x3(i) + x4(i)
169 . - x5(i) - x6(i) - x7(i) - x8(i)
170 yy1 = y1(i) + y2(i) + y3(i) + y4(i)
171 . - y5(i) - y6(i) - y7(i) - y8(i)
172 zz1 = z1(i) + z2(i) + z3(i) + z4(i)
173 . - z5(i) - z6(i) - z7(i) - z8(i)
174 xx2 = x1(i) + x2(i) + x5(i) + x6(i)
175 . - x3(i) - x4(i) - x7(i) - x8(i)
176 yy2 = y1(i) + y2(i) + y5(i) + y6(i)
177 . - y3(i) - y4(i) - y7(i) - y8(i)
178 zz2 = z1(i) + z2(i) + z5(i) + z6(i)
179 . - z3(i) - z4(i) - z7(i) - z8(i)
180 xx3 = x1(i) + x4(i) + x5(i) + x8(i)
181 . - x3(i) - x2(i) - x7(i) - x6(i)
182 yy3 = y1(i) + y4(i) + y5(i) + y8(i)
183 . - y3(i) - y2(i) - y7(i) - y6(i)
184 zz3 = z1(i) + z4(i) + z5(i) + z8(i)
185 . - z3(i) - z2(i) - z7(i) - z6(i)
186C surface * 16
187 smax(i) = (yy1 * zz2 - yy2 * zz1)**2
188 . + (zz1 * xx2 - zz2 * xx1)**2
189 . + (xx1 * yy2 - xx2 * yy1)**2
190 smax(i) = max(smax(i),(yy1 * zz3 - yy3 * zz1)**2
191 . + (zz1 * xx3 - zz3 * xx1)**2
192 . + (xx1 * yy3 - xx3 * yy1)**2)
193 smax(i) = max(smax(i),(yy3 * zz2 - yy2 * zz3)**2
194 . + (zz3 * xx2 - zz2 * xx3)**2
195 . + (xx3 * yy2 - xx2 * yy3)**2)
196 ENDDO
197C volume / 8
198 IF (idts6>0) THEN
199 DO i=1,nel
200 IF(idege(i)==0)THEN
201 vmin = min(vlinc(i,1),vlinc(i,2),vlinc(i,3),vlinc(i,4),
202 . vlinc(i,5),vlinc(i,6),vlinc(i,7),vlinc(i,8))
203C
204 deltax(i)=hundred28*vmin/sqrt(smax(i))
205 ENDIF
206 ENDDO
207 ELSE
208 DO i=1,nel
209 vmin = min(vlinc(i,1),vlinc(i,2),vlinc(i,3),vlinc(i,4),
210 . vlinc(i,5),vlinc(i,6),vlinc(i,7),vlinc(i,8))
211C
212 deltax(i)=hundred28*vmin/sqrt(smax(i))
213 ENDDO
214 ENDIF
215
216
217C-----------
218 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:45
subroutine basisf(h, p1, p2, p3, ipt)
Definition basisf.F:32