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

Go to the source code of this file.

Functions/Subroutines

subroutine i8cst3 (x1, y1, z1, x2, y2, z2, x3, y3, z3, x4, y4, z4, xi, yi, zi, n1, n2, n3, ans, ssc, ttc, xface, x0, y0, z0, xx1, yy1, zz1, xx2, yy2, zz2, xx3, yy3, zz3, xx4, yy4, zz4, xi1, yi1, zi1, xi2, yi2, zi2, xi3, yi3, zi3, xi4, yi4, zi4, xn1, yn1, zn1, xn2, yn2, zn2, xn3, yn3, zn3, xn4, yn4, zn4, area, lft, llt)

Function/Subroutine Documentation

◆ i8cst3()

subroutine i8cst3 ( x1,
y1,
z1,
x2,
y2,
z2,
x3,
y3,
z3,
x4,
y4,
z4,
xi,
yi,
zi,
n1,
n2,
n3,
ans,
ssc,
ttc,
xface,
x0,
y0,
z0,
xx1,
yy1,
zz1,
xx2,
yy2,
zz2,
xx3,
yy3,
zz3,
xx4,
yy4,
zz4,
xi1,
yi1,
zi1,
xi2,
yi2,
zi2,
xi3,
yi3,
zi3,
xi4,
yi4,
zi4,
xn1,
yn1,
zn1,
xn2,
yn2,
zn2,
xn3,
yn3,
zn3,
xn4,
yn4,
zn4,
area,
integer, intent(inout) lft,
integer, intent(inout) llt )

Definition at line 28 of file i8cst3.F.

45
46
47C-----------------------------------------------
48C I m p l i c i t T y p e s
49C-----------------------------------------------
50#include "implicit_f.inc"
51C-----------------------------------------------
52C D u m m y A r g u m e n t s
53C-----------------------------------------------
54 INTEGER, INTENT(INOUT) :: LFT
55 INTEGER, INTENT(INOUT) :: LLT
57 . x1(*), x2(*), x3(*), x4(*),
58 . y1(*), y2(*), y3(*), y4(*),
59 . z1(*), z2(*), z3(*), z4(*),
60 . xi(*), yi(*), zi(*), ans(*),
61 . n1(*), n2(*), n3(*), ssc(*), ttc(*),
62 . x0(*), y0(*), z0(*), xface(*)
64 . xx1(*), xx2(*), xx3(*), xx4(*),
65 . yy1(*), yy2(*), yy3(*), yy4(*),
66 . zz1(*), zz2(*), zz3(*), zz4(*),
67 . xi1(*), xi2(*), xi3(*), xi4(*),
68 . yi1(*), yi2(*), yi3(*), yi4(*),
69 . zi1(*), zi2(*), zi3(*), zi4(*),
70 . xn1(*), xn2(*), xn3(*), xn4(*),
71 . yn1(*), yn2(*), yn3(*), yn4(*),
72 . zn1(*), zn2(*), zn3(*), zn4(*),
73 . area(*)
74C-----------------------------------------------
75C C o m m o n B l o c k s
76C-----------------------------------------------
77C-----------------------------------------------
78C L o c a l V a r i a b l e s
79C-----------------------------------------------
80 INTEGER I
81 my_real an
82C=======================================================================
83 DO 100 i=lft,llt
84 x0(i) = fourth*(x1(i)+x2(i)+x3(i)+x4(i))
85 y0(i) = fourth*(y1(i)+y2(i)+y3(i)+y4(i))
86 z0(i) = fourth*(z1(i)+z2(i)+z3(i)+z4(i))
87C
88 xx1(i) = x1(i)-x0(i)
89 xx2(i) = x2(i)-x0(i)
90 xx3(i) = x3(i)-x0(i)
91 xx4(i) = x4(i)-x0(i)
92 yy1(i) = y1(i)-y0(i)
93 yy2(i) = y2(i)-y0(i)
94 yy3(i) = y3(i)-y0(i)
95 yy4(i) = y4(i)-y0(i)
96 zz1(i) = z1(i)-z0(i)
97 zz2(i) = z2(i)-z0(i)
98 zz3(i) = z3(i)-z0(i)
99 zz4(i) = z4(i)-z0(i)
100C
101 xi1(i) = x1(i)-xi(i)
102 xi2(i) = x2(i)-xi(i)
103 xi3(i) = x3(i)-xi(i)
104 xi4(i) = x4(i)-xi(i)
105 yi1(i) = y1(i)-yi(i)
106 yi2(i) = y2(i)-yi(i)
107 yi3(i) = y3(i)-yi(i)
108 yi4(i) = y4(i)-yi(i)
109 zi1(i) = z1(i)-zi(i)
110 zi2(i) = z2(i)-zi(i)
111 zi3(i) = z3(i)-zi(i)
112 zi4(i) = z4(i)-zi(i)
113 100 CONTINUE
114C
115 DO 120 i=lft,llt
116 xn1(i) = yy1(i)*zz2(i) - yy2(i)*zz1(i)
117 yn1(i) = zz1(i)*xx2(i) - zz2(i)*xx1(i)
118 zn1(i) = xx1(i)*yy2(i) - xx2(i)*yy1(i)
119 n1(i)=xn1(i)
120 n2(i)=yn1(i)
121 n3(i)=zn1(i)
122 120 CONTINUE
123C
124 DO 140 i=lft,llt
125 xn2(i) = yy2(i)*zz3(i) - yy3(i)*zz2(i)
126 yn2(i) = zz2(i)*xx3(i) - zz3(i)*xx2(i)
127 zn2(i) = xx2(i)*yy3(i) - xx3(i)*yy2(i)
128 n1(i)=n1(i)+xn2(i)
129 n2(i)=n2(i)+yn2(i)
130 n3(i)=n3(i)+zn2(i)
131 140 CONTINUE
132C
133 DO 160 i=lft,llt
134 xn3(i) = yy3(i)*zz4(i) - yy4(i)*zz3(i)
135 yn3(i) = zz3(i)*xx4(i) - zz4(i)*xx3(i)
136 zn3(i) = xx3(i)*yy4(i) - xx4(i)*yy3(i)
137 n1(i)=n1(i)+xn3(i)
138 n2(i)=n2(i)+yn3(i)
139 n3(i)=n3(i)+zn3(i)
140 160 CONTINUE
141C
142 DO 180 i=lft,llt
143 xn4(i) = yy4(i)*zz1(i) - yy1(i)*zz4(i)
144 yn4(i) = zz4(i)*xx1(i) - zz1(i)*xx4(i)
145 zn4(i) = xx4(i)*yy1(i) - xx1(i)*yy4(i)
146 n1(i)=n1(i)+xn4(i)
147 n2(i)=n2(i)+yn4(i)
148 n3(i)=n3(i)+zn4(i)
149 180 CONTINUE
150C
151 DO 200 i=lft,llt
152 an= max(em20,sqrt(n1(i)*n1(i)+n2(i)*n2(i)+n3(i)*n3(i)))
153 n1(i)=n1(i)/an
154 n2(i)=n2(i)/an
155 n3(i)=n3(i)/an
156 area(i)=half*an
157 200 CONTINUE
158C
159 DO 210 i=lft,llt
160 x0(i)=(n1(i)*xn1(i)+n2(i)*yn1(i)+n3(i)*zn1(i))
161 y0(i)=(n1(i)*xn2(i)+n2(i)*yn2(i)+n3(i)*zn2(i))
162 z0(i)=(n1(i)*xn3(i)+n2(i)*yn3(i)+n3(i)*zn3(i))
163 xx1(i)=(n1(i)*xn4(i)+n2(i)*yn4(i)+n3(i)*zn4(i))
164 210 CONTINUE
165C
166 DO 220 i=lft,llt
167 xn1(i) = yi1(i)*zi2(i) - yi2(i)*zi1(i)
168 yn1(i) = zi1(i)*xi2(i) - zi2(i)*xi1(i)
169 zn1(i) = xi1(i)*yi2(i) - xi2(i)*yi1(i)
170 yy1(i)=(n1(i)*xn1(i)+n2(i)*yn1(i)+n3(i)*zn1(i))
171 220 CONTINUE
172C
173 DO 240 i=lft,llt
174 xn2(i) = yi2(i)*zi3(i) - yi3(i)*zi2(i)
175 yn2(i) = zi2(i)*xi3(i) - zi3(i)*xi2(i)
176 zn2(i) = xi2(i)*yi3(i) - xi3(i)*yi2(i)
177 zz1(i)=(n1(i)*xn2(i)+n2(i)*yn2(i)+n3(i)*zn2(i))
178 240 CONTINUE
179C
180 DO 260 i=lft,llt
181 xn3(i) = yi3(i)*zi4(i) - yi4(i)*zi3(i)
182 yn3(i) = zi3(i)*xi4(i) - zi4(i)*xi3(i)
183 zn3(i) = xi3(i)*yi4(i) - xi4(i)*yi3(i)
184 xx2(i)=(n1(i)*xn3(i)+n2(i)*yn3(i)+n3(i)*zn3(i))
185 260 CONTINUE
186C
187 DO 280 i=lft,llt
188 xn4(i) = yi4(i)*zi1(i) - yi1(i)*zi4(i)
189 yn4(i) = zi4(i)*xi1(i) - zi1(i)*xi4(i)
190 zn4(i) = xi4(i)*yi1(i) - xi1(i)*yi4(i)
191 yy2(i)=(n1(i)*xn4(i)+n2(i)*yn4(i)+n3(i)*zn4(i))
192 280 CONTINUE
193C
194 DO 300 i=lft,llt
195 zz2(i)=y0(i)*yy2(i)
196 xx3(i)=zz1(i)*xx1(i)
197 300 CONTINUE
198C
199 DO 320 i=lft,llt
200 IF(xface(i)==zero)GOTO 320
201 IF(zz2(i)+xx3(i)/=zero)THEN
202 ssc(i)=(zz2(i)-xx3(i))/(zz2(i)+xx3(i))
203 ELSE
204 ssc(i)=zero
205 ENDIF
206 IF(z0(i)/=zero)THEN
207 zz2(i)=yy1(i)*z0(i)
208 xx3(i)=xx2(i)*x0(i)
209 IF(zz2(i)+xx3(i)/=zero)THEN
210 ttc(i)=(zz2(i)-xx3(i))/(zz2(i)+xx3(i))
211 ELSE
212 ttc(i)=zero
213 ENDIF
214 ELSE
215 ttc(i)=(yy1(i)-x0(i))/x0(i)
216 ENDIF
217 320 CONTINUE
218C
219 RETURN
#define my_real
Definition cppsort.cpp:32
subroutine area(d1, x, x2, y, y2, eint, stif0)
#define max(a, b)
Definition macros.h:21