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

Go to the source code of this file.

Functions/Subroutines

subroutine inist3 (n1, n2, n3, ssc, ttc, ier, alp, xx1, xx2, xx3, xs1, ys1, zs1, xc, yc, zc)

Function/Subroutine Documentation

◆ inist3()

subroutine inist3 ( intent(inout) n1,
intent(inout) n2,
intent(inout) n3,
intent(inout) ssc,
intent(inout) ttc,
integer, intent(inout) ier,
intent(in) alp,
dimension(4), intent(inout) xx1,
dimension(4), intent(inout) xx2,
dimension(4), intent(inout) xx3,
intent(inout) xs1,
intent(inout) ys1,
intent(inout) zs1,
intent(inout) xc,
intent(inout) yc,
intent(inout) zc )

Definition at line 32 of file inist3.F.

33C-----------------------------------------------
34C I m p l i c i t T y p e s
35C-----------------------------------------------
36#include "implicit_f.inc"
37C-----------------------------------------------
38C D u m m y A r g u m e n t s
39C-----------------------------------------------
40 INTEGER,INTENT(INOUT) :: IER
41 my_real, INTENT(INOUT) :: n1, n2, n3, ssc, ttc
42 my_real, INTENT(IN) :: alp
43 my_real,INTENT(INOUT) :: xx1(4), xx2(4),xx3(4),xs1,ys1,zs1,xc,yc,zc
44C-----------------------------------------------
45C L o c a l V a r i a b l e s
46C-----------------------------------------------
48 . h(4), x0, y0, z0, xl1, xl2, xl3, xl4, yy1, yy2, yy3, yy4,
49 . zz1, zz2, zz3, zz4, xi1, xi2, xi3, xi4, yi1, yi2, yi3, yi4,
50 . zi1, zi2, zi3, zi4, xn1, yn1, zn1, xn2, yn2, zn2, xn3, yn3,
51 . zn3, xn4, yn4, zn4, an, area, a12, a23, a34, a41, b12, b23,
52 . b34, b41, ab1, ab2, tp, tm, sp, sm, x1,x2,x3,x4,
53 . y1,y2,y3,y4,z1,z2,z3,z4,xi,yi,zi
54C-----------------------------------------------
55C S o u r c e L i n e s
56C-----------------------------------------------
57 !SECONDARY node coordinates
58 xi = xs1
59 yi = ys1
60 zi = zs1
61
62 !MAIN segment coordinates
63 x1 = xx1(1)
64 x2 = xx1(2)
65 x3 = xx1(3)
66 x4 = xx1(4)
67 y1 = xx2(1)
68 y2 = xx2(2)
69 y3 = xx2(3)
70 y4 = xx2(4)
71 z1 = xx3(1)
72 z2 = xx3(2)
73 z3 = xx3(3)
74 z4 = xx3(4)
75 !MAIN segment centroid
76 x0 = fourth*(x1+x2+x3+x4)
77 y0 = fourth*(y1+y2+y3+y4)
78 z0 = fourth*(z1+z2+z3+z4)
79 !length from centroid
80 xl1 = x1-x0
81 xl2 = x2-x0
82 xl3 = x3-x0
83 xl4 = x4-x0
84 yy1 = y1-y0
85 yy2 = y2-y0
86 yy3 = y3-y0
87 yy4 = y4-y0
88 zz1 = z1-z0
89 zz2 = z2-z0
90 zz3 = z3-z0
91 zz4 = z4-z0
92 !length from SECONDARY node
93 xi1 = x1-xi
94 xi2 = x2-xi
95 xi3 = x3-xi
96 xi4 = x4-xi
97 yi1 = y1-yi
98 yi2 = y2-yi
99 yi3 = y3-yi
100 yi4 = y4-yi
101 zi1 = z1-zi
102 zi2 = z2-zi
103 zi3 = z3-zi
104 zi4 = z4-zi
105
106 !1st mater triangle
107 xn1 = yy1*zz2 - yy2*zz1
108 yn1 = zz1*xl2 - zz2*xl1
109 zn1 = xl1*yy2 - xl2*yy1
110 n1 = xn1
111 n2 = yn1
112 n3 = zn1
113 !2nd MAIN triangle
114 xn2 = yy2*zz3 - yy3*zz2
115 yn2 = zz2*xl3 - zz3*xl2
116 zn2 = xl2*yy3 - xl3*yy2
117 n1 = n1+xn2
118 n2 = n2+yn2
119 n3 = n3+zn2
120 !3rd MAIN triangle
121 xn3 = yy3*zz4 - yy4*zz3
122 yn3 = zz3*xl4 - zz4*xl3
123 zn3 = xl3*yy4 - xl4*yy3
124 n1 = n1+xn3
125 n2 = n2+yn3
126 n3 = n3+zn3
127 !4th MAIN triangle
128 xn4 = yy4*zz1 - yy1*zz4
129 yn4 = zz4*xl1 - zz1*xl4
130 zn4 = xl4*yy1 - xl1*yy4
131 n1 = n1+xn4
132 n2 = n2+yn4
133 n3 = n3+zn4
134 !average normal of MAIN segment
135 an = max(em20,sqrt(n1*n1+n2*n2+n3*n3))
136 n1 = n1/an
137 n2 = n2/an
138 n3 = n3/an
139 !in case of degenerated segment
140 IF(an<=em19) THEN
141 ier=-1
142 RETURN
143 ENDIF
144 area=half*an
145 a12 = (n1*xn1+n2*yn1+n3*zn1)
146 a23 = (n1*xn2+n2*yn2+n3*zn2)
147 a34 = (n1*xn3+n2*yn3+n3*zn3)
148 a41 = (n1*xn4+n2*yn4+n3*zn4)
149
150 !1st triangle based on SECONDARY node
151 xn1 = yi1*zi2 - yi2*zi1
152 yn1 = zi1*xi2 - zi2*xi1
153 zn1 = xi1*yi2 - xi2*yi1
154 b12 = (n1*xn1+n2*yn1+n3*zn1)
155 !2nd triangle based on SECONDARY node
156 xn2 = yi2*zi3 - yi3*zi2
157 yn2 = zi2*xi3 - zi3*xi2
158 zn2 = xi2*yi3 - xi3*yi2
159 b23 = (n1*xn2+n2*yn2+n3*zn2)
160 !3rd triangle based on SECONDARY node
161 xn3 = yi3*zi4 - yi4*zi3
162 yn3 = zi3*xi4 - zi4*xi3
163 zn3 = xi3*yi4 - xi4*yi3
164 b34 = (n1*xn3+n2*yn3+n3*zn3)
165 !4th triangle based on SECONDARY node
166 xn4 = yi4*zi1 - yi1*zi4
167 yn4 = zi4*xi1 - zi1*xi4
168 zn4 = xi4*yi1 - xi1*yi4
169 b41 = (n1*xn4+n2*yn4+n3*zn4)
170 !SSC
171 ab1 = a23*b41
172 ab2 = b23*a41
173 IF(abs(ab1+ab2)/area>em10)THEN
174 ssc = (ab1-ab2)/(ab1+ab2)
175 ELSE
176 ssc = zero
177 ENDIF
178 !TTC
179 IF(abs(a34/area)>em10)THEN
180 ab1 = b12*a34
181 ab2 = b34*a12
182 ttc = (ab1-ab2)/(ab1+ab2)
183 ELSE
184 ttc = (b12-a12)/a12
185 IF(b23<=zero .AND. b41<=zero)THEN
186 IF(-b23/a12<=alp.AND.-b41/a12<=alp)ssc=zero
187 ELSEIF(b23<=zero)THEN
188 IF(-b23/a12<=alp)ssc=one
189 ELSEIF(b41<=zero)THEN
190 IF(-b41/a12<=alp)ssc=-one
191 ENDIF
192 ENDIF
193 !lecipari : GAP=TWO*EM02 GAP->FRIGAP(2)->ALP (hardcoded tolerance)
194
195 IF(abs(ssc)>one+alp.OR.abs(ttc)>one+alp) THEN
196 ier = 1 !SECONDARY node not on MAIN segment
197 ELSE
198 ier = 0
199 IF(abs(ssc)>one)ssc=ssc/abs(ssc)
200 IF(abs(ttc)>one)ttc=ttc/abs(ttc)
201 ENDIF
202
203 tp = fourth*(one+ttc)
204 tm = fourth*(one-ttc)
205 sp = one+ssc
206 sm = one-ssc
207 h(1) = tm*sm
208 h(2) = tm*sp
209 h(3) = tp*sp
210 h(4) = tp*sm
211 xc = h(1)*x1+h(2)*x2+h(3)*x3+h(4)*x4
212 yc = h(1)*y1+h(2)*y2+h(3)*y3+h(4)*y4
213 zc = h(1)*z1+h(2)*z2+h(3)*z3+h(4)*z4
214
215 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