OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
c3coor3.F File Reference
#include "implicit_f.inc"
#include "mvsiz_p.inc"
#include "com08_c.inc"
#include "scr05_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine c3coor3 (jft, jlt, x, ixtg, offg, off, dt1c, v, vr, vl1, vl2, vl3, vrl1, vrl2, vrl3, sigy, x1, x2, x3, y1, y2, y3, z1, z2, z3, xdp)
subroutine c3coort3 (jft, jlt, x, ixtg, offg, dr, xl2, xl3, yl2, yl3, e1x, e1y, e1z, e2x, e2y, e2z, e3x, e3y, e3z, nel, v21x, v31x, v21y, v31y, rz13, rz23, x2_t, x3_t, y2_t, y3_t, area, smstr, isrot)

Function/Subroutine Documentation

◆ c3coor3()

subroutine c3coor3 ( integer jft,
integer jlt,
x,
integer, dimension(nixtg,*) ixtg,
offg,
off,
dt1c,
v,
vr,
vl1,
vl2,
vl3,
vrl1,
vrl2,
vrl3,
sigy,
real(kind=8), dimension(mvsiz), intent(out) x1,
real(kind=8), dimension(mvsiz), intent(out) x2,
real(kind=8), dimension(mvsiz), intent(out) x3,
real(kind=8), dimension(mvsiz), intent(out) y1,
real(kind=8), dimension(mvsiz), intent(out) y2,
real(kind=8), dimension(mvsiz), intent(out) y3,
real(kind=8), dimension(mvsiz), intent(out) z1,
real(kind=8), dimension(mvsiz), intent(out) z2,
real(kind=8), dimension(mvsiz), intent(out) z3,
real(kind=8), dimension(3,*), intent(in) xdp )

Definition at line 30 of file c3coor3.F.

36 use element_mod , only : nixtg
37C-----------------------------------------------
38C I m p l i c i t T y p e s
39C-----------------------------------------------
40#include "implicit_f.inc"
41C-----------------------------------------------
42C G l o b a l P a r a m e t e r s
43C-----------------------------------------------
44#include "mvsiz_p.inc"
45C-----------------------------------------------
46C C o m m o n B l o c k s
47C-----------------------------------------------
48#include "com08_c.inc"
49#include "scr05_c.inc"
50C-----------------------------------------------
51C D u m m y A r g u m e n t s
52C-----------------------------------------------
53 INTEGER JFT, JLT
54 INTEGER IXTG(NIXTG,*)
56 . offg(*), off(*),dt1c(*),x(3,*),
57 . v(3,*),vr(3,*),vl1(mvsiz,3),vl2(mvsiz,3),vl3(mvsiz,3),
58 . vrl1(mvsiz,3),vrl2(mvsiz,3),vrl3(mvsiz,3),sigy(*)
59! SP issue :
60 REAL(kind=8), dimension(3,*), INTENT(in) :: xdp
61 REAL(kind=8), dimension(mvsiz), INTENT(out) ::x1,x2,x3
62 REAL(kind=8), dimension(mvsiz), INTENT(out) ::y1,y2,y3
63 REAL(kind=8), dimension(mvsiz), INTENT(out) ::z1,z2,z3
64
65
66C-----------------------------------------------
67C L o c a l V a r i a b l e s
68C-----------------------------------------------
69 INTEGER I, NC1, NC2, NC3
70 my_real off_l
71C=======================================================================
72 IF(iresp == 1)THEN
73 DO i=jft,jlt
74 nc1 = ixtg(2,i)
75 nc2 = ixtg(3,i)
76 nc3 = ixtg(4,i)
77C----------------------------
78C COORDONNEES
79C----------------------------
80 x1(i)=xdp(1,nc1)
81 y1(i)=xdp(2,nc1)
82 z1(i)=xdp(3,nc1)
83 x2(i)=xdp(1,nc2)
84 y2(i)=xdp(2,nc2)
85 z2(i)=xdp(3,nc2)
86 x3(i)=xdp(1,nc3)
87 y3(i)=xdp(2,nc3)
88 z3(i)=xdp(3,nc3)
89 vl1(i,1)=v(1,nc1)
90 vl1(i,2)=v(2,nc1)
91 vl1(i,3)=v(3,nc1)
92 vl2(i,1)=v(1,nc2)
93 vl2(i,2)=v(2,nc2)
94 vl2(i,3)=v(3,nc2)
95 vl3(i,1)=v(1,nc3)
96 vl3(i,2)=v(2,nc3)
97 vl3(i,3)=v(3,nc3)
98 vrl1(i,1)=vr(1,nc1)
99 vrl1(i,2)=vr(2,nc1)
100 vrl1(i,3)=vr(3,nc1)
101 vrl2(i,1)=vr(1,nc2)
102 vrl2(i,2)=vr(2,nc2)
103 vrl2(i,3)=vr(3,nc2)
104 vrl3(i,1)=vr(1,nc3)
105 vrl3(i,2)=vr(2,nc3)
106 vrl3(i,3)=vr(3,nc3)
107 ENDDO
108 ELSE
109 DO i=jft,jlt
110 nc1 = ixtg(2,i)
111 nc2 = ixtg(3,i)
112 nc3 = ixtg(4,i)
113C----------------------------
114C COORDONNEES
115C----------------------------
116 x1(i)=x(1,nc1)
117 y1(i)=x(2,nc1)
118 z1(i)=x(3,nc1)
119 x2(i)=x(1,nc2)
120 y2(i)=x(2,nc2)
121 z2(i)=x(3,nc2)
122 x3(i)=x(1,nc3)
123 y3(i)=x(2,nc3)
124 z3(i)=x(3,nc3)
125 vl1(i,1)=v(1,nc1)
126 vl1(i,2)=v(2,nc1)
127 vl1(i,3)=v(3,nc1)
128 vl2(i,1)=v(1,nc2)
129 vl2(i,2)=v(2,nc2)
130 vl2(i,3)=v(3,nc2)
131 vl3(i,1)=v(1,nc3)
132 vl3(i,2)=v(2,nc3)
133 vl3(i,3)=v(3,nc3)
134 vrl1(i,1)=vr(1,nc1)
135 vrl1(i,2)=vr(2,nc1)
136 vrl1(i,3)=vr(3,nc1)
137 vrl2(i,1)=vr(1,nc2)
138 vrl2(i,2)=vr(2,nc2)
139 vrl2(i,3)=vr(3,nc2)
140 vrl3(i,1)=vr(1,nc3)
141 vrl3(i,2)=vr(2,nc3)
142 vrl3(i,3)=vr(3,nc3)
143 ENDDO
144 END if!(IRESP == 1)THEN
145C
146 off_l = zero
147 DO i=jft,jlt
148 dt1c(i) = dt1
149 off(i) = min(one,abs(offg(i)))
150 off_l = min(off_l,offg(i))
151 sigy(i) = ep30
152 ENDDO
153 IF (off_l < zero) THEN
154 DO i=jft,jlt
155 IF (offg(i) < zero) THEN
156 vl1(i,1)=zero
157 vl1(i,2)=zero
158 vl1(i,3)=zero
159 vl2(i,1)=zero
160 vl2(i,2)=zero
161 vl2(i,3)=zero
162 vl3(i,1)=zero
163 vl3(i,2)=zero
164 vl3(i,3)=zero
165 vrl1(i,1)=zero
166 vrl1(i,2)=zero
167 vrl1(i,3)=zero
168 vrl2(i,1)=zero
169 vrl2(i,2)=zero
170 vrl2(i,3)=zero
171 vrl3(i,1)=zero
172 vrl3(i,2)=zero
173 vrl3(i,3)=zero
174 ENDIF
175 ENDDO
176 ENDIF
177C-----------
178 RETURN
#define my_real
Definition cppsort.cpp:32
if(complex_arithmetic) id
#define min(a, b)
Definition macros.h:20

◆ c3coort3()

subroutine c3coort3 ( integer jft,
integer jlt,
x,
integer, dimension(nixtg,*) ixtg,
offg,
dr,
xl2,
xl3,
yl2,
yl3,
e1x,
e1y,
e1z,
e2x,
e2y,
e2z,
e3x,
e3y,
e3z,
integer nel,
v21x,
v31x,
v21y,
v31y,
rz13,
rz23,
x2_t,
x3_t,
y2_t,
y3_t,
area,
double precision, dimension(*) smstr,
integer isrot )

Definition at line 187 of file c3coor3.F.

194 use element_mod , only : nixtg
195C-----------------------------------------------
196C I m p l i c i t T y p e s
197C-----------------------------------------------
198#include "implicit_f.inc"
199C-----------------------------------------------
200C G l o b a l P a r a m e t e r s
201C-----------------------------------------------
202#include "mvsiz_p.inc"
203C-----------------------------------------------
204C D u m m y A r g u m e n t s
205C-----------------------------------------------
206 INTEGER JFT, JLT,ISROT,NEL
207 INTEGER IXTG(NIXTG,*)
208 my_real
209 . x(3,*), offg(*), dr(3,*),
210 . e1x(*), e1y(*), e1z(*),
211 . e2x(*), e2y(*), e2z(*),e3x(*), e3y(*), e3z(*),
212 . xl2(*),xl3(*),yl2(*),yl3(*),area(*),
213 . v21x(*),v31x(*),v21y(*),v31y(*),rz13(*),rz23(*),
214 . x2_t(*),x3_t(*),y2_t(*),y3_t(*)
215 DOUBLE PRECISION
216 . SMSTR(*)
217C-----------------------------------------------
218C L o c a l V a r i a b l e s
219C-----------------------------------------------
220 INTEGER I,II(6),NN(3)
221 my_real
222 . x0g2(mvsiz),x0g3(mvsiz),y0g2(mvsiz),y0g3(mvsiz),off_l,
223 . z0g2(mvsiz),z0g3(mvsiz),axyz(mvsiz,3,3),
224 . e01x(mvsiz), e01y(mvsiz), e01z(mvsiz),
225 . e02x(mvsiz), e02y(mvsiz), e02z(mvsiz),e03x(mvsiz),
226 . e03y(mvsiz), e03z(mvsiz),x0l2(mvsiz), x0l3(mvsiz),
227 . y0l2(mvsiz),y0l3(mvsiz),sum(mvsiz),norm,xl,yl,vr1_12,vr1_21,
228 . rlz1,rlz2,rlz3,areai,x0g32,y0g32,z0g32,dirz(mvsiz,2)
229C-----------------------------------------------
230 DO i=1,6
231 ii(i) = nel*(i-1)
232 ENDDO
233C
234 DO i=jft,jlt
235 IF(abs(offg(i))==one)offg(i)=sign(two,offg(i))
236 axyz(i,1:3,1:3)= zero
237C
238 IF (isrot > 0 ) THEN
239 nn(1) = ixtg(2,i)
240 nn(2) = ixtg(3,i)
241 nn(3) = ixtg(4,i)
242 axyz(i,1,1) = dr(1,nn(1))
243 axyz(i,2,1) = dr(2,nn(1))
244 axyz(i,3,1) = dr(3,nn(1))
245 axyz(i,1,2) = dr(1,nn(2))
246 axyz(i,2,2) = dr(2,nn(2))
247 axyz(i,3,2) = dr(3,nn(2))
248 axyz(i,1,3) = dr(1,nn(3))
249 axyz(i,2,3) = dr(2,nn(3))
250 axyz(i,3,3) = dr(3,nn(3))
251 END IF !(ISROT > 0 ) THEN
252
253 x0g2(i) = smstr(ii(1)+i)
254 y0g2(i) = smstr(ii(2)+i)
255 z0g2(i) = smstr(ii(3)+i)
256 x0g3(i) = smstr(ii(4)+i)
257 y0g3(i) = smstr(ii(5)+i)
258 z0g3(i) = smstr(ii(6)+i)
259 ENDDO
260C-- normal in initial conf.
261 DO i=jft,jlt
262 e01x(i)= x0g2(i)
263 e01y(i)= y0g2(i)
264 e01z(i)= z0g2(i)
265 sum(i) = sqrt(e01x(i)*e01x(i)+e01y(i)*e01y(i)+e01z(i)*e01z(i))
266 e01x(i)=e01x(i)/sum(i)
267 e01y(i)=e01y(i)/sum(i)
268 e01z(i)=e01z(i)/sum(i)
269 ENDDO
270C
271 DO i=jft,jlt
272 x0g32=x0g3(i)-x0g2(i)
273 y0g32=y0g3(i)-y0g2(i)
274 z0g32=z0g3(i)-z0g2(i)
275 e03x(i)=y0g3(i)*z0g32-z0g3(i)*y0g32
276 e03y(i)=z0g3(i)*x0g32-x0g3(i)*z0g32
277 e03z(i)=x0g3(i)*y0g32-y0g3(i)*x0g32
278 sum(i) = sqrt(e03x(i)*e03x(i)+e03y(i)*e03y(i)+e03z(i)*e03z(i))
279 e03x(i)=e03x(i)/sum(i)
280 e03y(i)=e03y(i)/sum(i)
281 e03z(i)=e03z(i)/sum(i)
282 area(i) = half * sum(i)
283 ENDDO
284C
285 DO i=jft,jlt
286 e02x(i)=e03y(i)*e01z(i)-e03z(i)*e01y(i)
287 e02y(i)=e03z(i)*e01x(i)-e03x(i)*e01z(i)
288 e02z(i)=e03x(i)*e01y(i)-e03y(i)*e01x(i)
289 sum(i) = sqrt(e02x(i)*e02x(i)+e02y(i)*e02y(i)+e02z(i)*e02z(i))
290 e02x(i)=e02x(i)/sum(i)
291 e02y(i)=e02y(i)/sum(i)
292 e02z(i)=e02z(i)/sum(i)
293 ENDDO
294C----------------------------
295C xl =VR1^t x0l; VR1^t=(VQ0^t*VQ)^t---extract Rzl of VR1
296C----------------------------
297 DO i=jft,jlt
298 vr1_12=e01x(i)*e2x(i)+e01y(i)*e2y(i)+e01z(i)*e2z(i)
299 vr1_21=e02x(i)*e1x(i)+e02y(i)*e1y(i)+e02z(i)*e1z(i)
300 dirz(i,2) = half*(vr1_12-vr1_21)
301 norm = one-dirz(i,2)*dirz(i,2)
302 dirz(i,1) = sqrt(max(zero,norm))
303 ENDDO
304 DO i=jft,jlt
305 x0l2(i)=e01x(i)*x0g2(i)+e01y(i)*y0g2(i)+e01z(i)*z0g2(i)
306 y0l2(i)=e02x(i)*x0g2(i)+e02y(i)*y0g2(i)+e02z(i)*z0g2(i)
307 x0l3(i)=e01x(i)*x0g3(i)+e01y(i)*y0g3(i)+e01z(i)*z0g3(i)
308 y0l3(i)=e02x(i)*x0g3(i)+e02y(i)*y0g3(i)+e02z(i)*z0g3(i)
309 ENDDO
310C----------------------------
311C Rotate x0l of Rz1
312C----------------------------
313 DO i=jft,jlt
314 xl= x0l2(i)*dirz(i,1)-y0l2(i)*dirz(i,2)
315 yl= x0l2(i)*dirz(i,2)+y0l2(i)*dirz(i,1)
316 x0l2(i)=xl
317 y0l2(i)=yl
318 xl= x0l3(i)*dirz(i,1)-y0l3(i)*dirz(i,2)
319 yl= x0l3(i)*dirz(i,2)+y0l3(i)*dirz(i,1)
320 x0l3(i)=xl
321 y0l3(i)=yl
322 ENDDO
323C------U21,U31 in actual local system
324 DO i=jft,jlt
325 v21x(i)=xl2(i)-x0l2(i)
326 v31x(i)=xl3(i)-x0l3(i)
327 v21y(i)=yl2(i)-y0l2(i)
328 v31y(i)=yl3(i)-y0l3(i)
329 ENDDO
330 DO i=jft,jlt
331 x2_t(i) = x0l2(i)
332 x3_t(i) = x0l3(i)
333 y2_t(i) = y0l2(i)
334 y3_t(i) = y0l3(i)
335 ENDDO
336 IF (isrot>0) THEN
337C------RZ13,RZ23 in actual local system
338 DO i=jft,jlt
339 areai=half/max(em20,area(i))
340 rlz1 =e3x(i)*axyz(i,1,1)+e3y(i)*axyz(i,2,1)+e3z(i)*axyz(i,3,1)
341 rlz2 =e3x(i)*axyz(i,1,2)+e3y(i)*axyz(i,2,2)+e3z(i)*axyz(i,3,2)
342 rlz3 =e3x(i)*axyz(i,1,3)+e3y(i)*axyz(i,2,3)+e3z(i)*axyz(i,3,3)
343 rz13(i)=(rlz1-rlz3)*areai
344 rz23(i)=(rlz2-rlz3)*areai
345 ENDDO
346 END IF !(ISROT>0) THEN
347C
348 off_l = zero
349 DO i=jft,jlt
350 off_l = min(off_l,offg(i))
351 ENDDO
352 IF (off_l < zero) THEN
353 DO i=jft,jlt
354 IF (offg(i) < zero) THEN
355 v21x(i) = zero
356 v31x(i) = zero
357 v21y(i) = zero
358 v31y(i) = zero
359 rz13(i) = zero
360 rz23(i) = zero
361 ENDIF
362 ENDDO
363 ENDIF
364C-----------
365 RETURN
norm(diag(diag(diag(inv(mat))) -id.SOL), 2) % destroy mumps instance id.JOB
subroutine area(d1, x, x2, y, y2, eint, stif0)
#define max(a, b)
Definition macros.h:21