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

Go to the source code of this file.

Functions/Subroutines

subroutine cdkcoor3 (elbuf_str, jft, jlt, mat, pid, ngl, x, v, r, ixtg, offg, off, r11, r12, r13, r21, r22, r23, r31, r32, r33, xl2, yl2, xl3, yl3, smstr, area, area2, cdet, vlx, vly, vlz, rlx, rly, ismstr, irep, nlay, dir_a, dir_b, f11, f12, f13, f21, f22, f23, f32, f33, m11, m12, m13, m21, m22, m23, nel)
subroutine clskew3 (jft, jlt, irep, rx, ry, rz, sx, sy, sz, e1x, e2x, e3x, e1y, e2y, e3y, e1z, e2z, e3z, det, off)

Function/Subroutine Documentation

◆ cdkcoor3()

subroutine cdkcoor3 ( type(elbuf_struct_) elbuf_str,
integer jft,
integer jlt,
integer, dimension(*) mat,
integer, dimension(*) pid,
integer, dimension(*) ngl,
x,
v,
r,
integer, dimension(nixtg,*) ixtg,
offg,
off,
r11,
r12,
r13,
r21,
r22,
r23,
r31,
r32,
r33,
xl2,
yl2,
xl3,
yl3,
double precision, dimension(*) smstr,
area,
area2,
cdet,
vlx,
vly,
vlz,
rlx,
rly,
integer ismstr,
integer irep,
integer nlay,
dir_a,
dir_b,
f11,
f12,
f13,
f21,
f22,
f23,
f32,
f33,
m11,
m12,
m13,
m21,
m22,
m23,
integer nel )

Definition at line 33 of file cdkcoor3.F.

41C-----------------------------------------------
42C M o d u l e s
43C-----------------------------------------------
44 USE elbufdef_mod
45C-----------------------------------------------
46C I m p l i c i t T y p e s
47C-----------------------------------------------
48#include "implicit_f.inc"
49C-----------------------------------------------
50C G l o b a l P a r a m e t e r s
51C-----------------------------------------------
52#include "mvsiz_p.inc"
53C-----------------------------------------------
54C C o m m o n B l o c k s
55C-----------------------------------------------
56#include "com08_c.inc"
57#include "scr17_c.inc"
58C-----------------------------------------------
59C D u m m y A r g u m e n t s
60C-----------------------------------------------
61 INTEGER JFT, JLT,ISMSTR,IREP,NLAY,NEL
62 INTEGER IXTG(NIXTG,*),MAT(*),PID(*),NGL(*)
63 my_real
64 . x(3,*),v(3,*),r(3,*), offg(*), off(*),
65 . r11(*),r12(*),r13(*),r21(*),r22(*),r23(*),
66 . r31(*),r32(*),r33(*),area(*),area2(*),cdet(*),
67 . vlx(mvsiz,2),vly(mvsiz,2),vlz(mvsiz,2),rlx(mvsiz,3),rly(mvsiz,3),
68 . xl2(*),xl3(*),yl2(*),yl3(*),
69 . f11(*), f12(*), f13(*),
70 . f21(*), f22(*), f23(*), f32(*), f33(*),
71 . m11(*), m12(*), m13(*),
72 . m21(*), m22(*), m23(*),
73 . dir_a(nel,*),dir_b(nel,*)
74 double precision
75 . smstr(*)
76 TYPE(ELBUF_STRUCT_) :: ELBUF_STR
77C-----------------------------------------------
78C L o c a l V a r i a b l e s
79C-----------------------------------------------
80 INTEGER NC1, NC2, NC3,I, J,I1, I2, I3, N, NLYMAX,II(4),IBID,MAT_1
81 my_real
82 . vx2(mvsiz), vx3(mvsiz),vy2(mvsiz), vy3(mvsiz),
83 . vz2(mvsiz), vz3(mvsiz),
84 . rx1(mvsiz), rx2(mvsiz), rx3(mvsiz), ry1(mvsiz),
85 . ry2(mvsiz), ry3(mvsiz), rz1(mvsiz), rz2(mvsiz),rz3(mvsiz),
86 . x1(mvsiz), x2(mvsiz), x3(mvsiz), y1(mvsiz),
87 . y2(mvsiz), y3(mvsiz), z1(mvsiz), z2(mvsiz),
88 . z3(mvsiz), rx(mvsiz), ry(mvsiz), rz(mvsiz),
89 . sx(mvsiz), sy(mvsiz), sz(mvsiz),det(mvsiz),
90 . vx1, vy1,vz1,off_l,dt05,exz,eyz,ddrx,ddry,v21x,v31x,
91 . ddrz1,ddrz2
92C-----------------------------------------------
93 DO i=1,4
94 ii(i) = nel*(i-1)
95 ENDDO
96C
97 ibid = 0
98C
99 mat_1 = ixtg(1,jft)
100 DO i=jft,jlt
101 mat(i) = mat_1
102 nc1 = ixtg(2,i)
103 nc2 = ixtg(3,i)
104 nc3 = ixtg(4,i)
105 pid(i) = ixtg(5,i)
106 ngl(i) = ixtg(6,i)
107C----------------------------
108C COORDINATES
109C----------------------------
110 x1(i)=x(1,nc1)
111 y1(i)=x(2,nc1)
112 z1(i)=x(3,nc1)
113 x2(i)=x(1,nc2)
114 y2(i)=x(2,nc2)
115 z2(i)=x(3,nc2)
116 x3(i)=x(1,nc3)
117 y3(i)=x(2,nc3)
118 z3(i)=x(3,nc3)
119C----------------------------
120C VELOCITY
121C----------------------------
122 vx1=v(1,nc1)
123 vy1=v(2,nc1)
124 vz1=v(3,nc1)
125 vx2(i)=v(1,nc2)-vx1
126 vy2(i)=v(2,nc2)-vy1
127 vz2(i)=v(3,nc2)-vz1
128 vx3(i)=v(1,nc3)-vx1
129 vy3(i)=v(2,nc3)-vy1
130 vz3(i)=v(3,nc3)-vz1
131 rx1(i)=r(1,nc1)
132 ry1(i)=r(2,nc1)
133 rz1(i)=r(3,nc1)
134 rx2(i)=r(1,nc2)
135 ry2(i)=r(2,nc2)
136 rz2(i)=r(3,nc2)
137 rx3(i)=r(1,nc3)
138 ry3(i)=r(2,nc3)
139 rz3(i)=r(3,nc3)
140 ENDDO
141C-----------------------------------------------
142 DO i=jft,jlt
143 f12(i) =zero
144 f13(i) =zero
145 f22(i) =zero
146 f23(i) =zero
147 f32(i) =zero
148 f33(i) =zero
149 m11(i) =zero
150 m12(i) =zero
151 m13(i) =zero
152 m21(i) =zero
153 m22(i) =zero
154 m23(i) =zero
155 ENDDO
156 DO i=jft,jlt
157 rx(i)=x2(i)-x1(i)
158 ry(i)=y2(i)-y1(i)
159 rz(i)=z2(i)-z1(i)
160 sx(i)=x3(i)-x1(i)
161 sy(i)=y3(i)-y1(i)
162 sz(i)=z3(i)-z1(i)
163 ENDDO
164C----------------------------
165C LOCAL SYSTEM
166C----------------------------
167 i1 = 0
168 CALL clskew3(jft,jlt,i1,
169 . rx, ry, rz,
170 . sx, sy, sz,
171 . r11,r12,r13,r21,r22,r23,r31,r32,r33,area2,offg)
172C
173 DO i=jft,jlt
174 xl2(i)=r11(i)*rx(i)+r21(i)*ry(i)+r31(i)*rz(i)
175 yl2(i)=r12(i)*rx(i)+r22(i)*ry(i)+r32(i)*rz(i)
176 xl3(i)=r11(i)*sx(i)+r21(i)*sy(i)+r31(i)*sz(i)
177 yl3(i)=r12(i)*sx(i)+r22(i)*sy(i)+r32(i)*sz(i)
178 area(i)=half*area2(i)
179 cdet(i)=third*area(i)
180 ENDDO
181 DO i=jft,jlt
182 vlx(i,1)=r11(i)*vx2(i)+r21(i)*vy2(i)+r31(i)*vz2(i)
183 vlx(i,2)=r11(i)*vx3(i)+r21(i)*vy3(i)+r31(i)*vz3(i)
184 vly(i,1)=r12(i)*vx2(i)+r22(i)*vy2(i)+r32(i)*vz2(i)
185 vly(i,2)=r12(i)*vx3(i)+r22(i)*vy3(i)+r32(i)*vz3(i)
186 vlz(i,1)=r13(i)*vx2(i)+r23(i)*vy2(i)+r33(i)*vz2(i)
187 vlz(i,2)=r13(i)*vx3(i)+r23(i)*vy3(i)+r33(i)*vz3(i)
188 rlx(i,1)=r11(i)*rx1(i)+r21(i)*ry1(i)+r31(i)*rz1(i)
189 rlx(i,2)=r11(i)*rx2(i)+r21(i)*ry2(i)+r31(i)*rz2(i)
190 rlx(i,3)=r11(i)*rx3(i)+r21(i)*ry3(i)+r31(i)*rz3(i)
191 rly(i,1)=r12(i)*rx1(i)+r22(i)*ry1(i)+r32(i)*rz1(i)
192 rly(i,2)=r12(i)*rx2(i)+r22(i)*ry2(i)+r32(i)*rz2(i)
193 rly(i,3)=r12(i)*rx3(i)+r22(i)*ry3(i)+r32(i)*rz3(i)
194 ENDDO
195C----------------------------
196C SMALL STRAIN
197C----------------------------
198 IF (ismstr == 1 .OR. ismstr == 2) THEN
199 DO i=jft,jlt
200 IF (abs(offg(i)) == two) THEN
201 xl2(i)=smstr(ii(1)+i)
202 yl2(i)=smstr(ii(2)+i)
203 xl3(i)=smstr(ii(3)+i)
204 yl3(i)=smstr(ii(4)+i)
205 area2(i)=xl2(i)*yl3(i)-xl3(i)*yl2(i)
206 area(i)=half*area2(i)
207 ELSE
208 smstr(ii(1)+i)=xl2(i)
209 smstr(ii(2)+i)=yl2(i)
210 smstr(ii(3)+i)=xl3(i)
211 smstr(ii(4)+i)=yl3(i)
212 ENDIF
213 ENDDO
214 ENDIF
215 IF (ismstr ==1) THEN
216 DO i=jft,jlt
217 IF (offg(i) == one) offg(i)=two
218 ENDDO
219 ENDIF
220C----------------------------
221C ORTHOTROPY/ANISOTHROPY
222C----------------------------
223 CALL cortdir3(elbuf_str,dir_a ,dir_b ,jft ,jlt ,
224 . nlay ,irep ,rx ,ry ,rz ,
225 . sx ,sy ,sz ,r11 ,r21 ,
226 . r31 ,r12 ,r22 ,r32 ,nel )
227C--------------------------
228C-------Correction 2nd order rigid rotation due a V(t+dt/2),X(t+dt)----
229C--------------------------
230 dt05 = half*dt1
231 DO i=jft,jlt
232 exz = yl3(i)*vlz(i,1)-yl2(i)*vlz(i,2)
233 eyz = -xl3(i)*vlz(i,1)+xl2(i)*vlz(i,2)
234 ddry=dt05*exz/area2(i)
235 ddrx=dt05*eyz/area2(i)
236 v21x = vlx(i,1)
237 v31x = vlx(i,2)
238 ddrz1=dt05*vly(i,1)/xl2(i)
239 ddrz2=dt05*v31x/yl3(i)
240 vlx(i,1) = vlx(i,1)-ddry*vlz(i,1)-ddrz1*vly(i,1)
241 vlx(i,2) = vlx(i,2)-ddry*vlz(i,2)-ddrz1*vly(i,2)
242 vly(i,1) = vly(i,1)-ddrx*vlz(i,1)-ddrz2*v21x
243 vly(i,2) = vly(i,2)-ddrx*vlz(i,2)-ddrz2*v31x
244 ENDDO
245C----------------------------
246C OFF
247C----------------------------
248 off_l = zero
249 DO i=jft,jlt
250 off(i) = min(one,abs(offg(i)))
251 off_l = min(off_l,offg(i))
252 ENDDO
253 IF(off_l < zero)THEN
254 DO i=jft,jlt
255 IF(offg(i) < zero)THEN
256 vlx(i,1)=zero
257 vlx(i,2)=zero
258 vly(i,1)=zero
259 vly(i,2)=zero
260 vlz(i,1)=zero
261 vlz(i,2)=zero
262 rlx(i,1)=zero
263 rlx(i,2)=zero
264 rlx(i,3)=zero
265 rly(i,1)=zero
266 rly(i,2)=zero
267 rly(i,3)=zero
268 ENDIF
269 ENDDO
270 ENDIF
271C----------------------------
272 RETURN
clskew3
subroutine clskew3(jft, jlt, irep, rx, ry, rz, sx, sy, sz, e1x, e2x, e3x, e1y, e2y, e3y, e1z, e2z, e3z, det, off)
Definition cdkcoor3.F:305
cortdir3
subroutine cortdir3(elbuf_str, dir_a, dir_b, jft, jlt, nlay, irep, rx, ry, rz, sx, sy, sz, e1x, e1y, e1z, e2x, e2y, e2z, nel)
Definition cortdir3.F:45
my_real
#define my_real
Definition cppsort.cpp:32
area
subroutine area(d1, x, x2, y, y2, eint, stif0)
Definition hm_read_prop32.F:567
min
#define min(a, b)
Definition macros.h:20

◆ clskew3()

subroutine clskew3 ( integer jft,
integer jlt,
integer irep,
rx,
ry,
rz,
sx,
sy,
sz,
e1x,
e2x,
e3x,
e1y,
e2y,
e3y,
e1z,
e2z,
e3z,
det,
off )

Definition at line 301 of file cdkcoor3.F.

305C-----------------------------------------------
306C I m p l i c i t T y p e s
307C-----------------------------------------------
308#include "implicit_f.inc"
309C-----------------------------------------------
310C G l o b a l P a r a m e t e r s
311C-----------------------------------------------
312#include "mvsiz_p.inc"
313#include "scr17_c.inc"
314C-----------------------------------------------
315C D u m m y A r g u m e n t s
316C-----------------------------------------------
317 INTEGER JFT,JLT,IREP
318 my_real
319 . rx(*) , ry(*) , rz(*),
320 . sx(*) , sy(*) , sz(*),
321 . e1x(*), e1y(*), e1z(*),
322 . e2x(*), e2y(*), e2z(*),
323 . e3x(*), e3y(*), e3z(*), det(*), off(*)
324C-----------------------------------------------
325C L o c a l V a r i a b l e s
326C-----------------------------------------------
327 INTEGER I
328 my_real c1,c2,cc,c1c1,c2c2,c1_1(mvsiz),c2_1(mvsiz)
329 my_real :: off_loc
330C~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
331C IREP=0 ->QEPH IREP=1 ->Q4, IREP=2-> E1=R(ISHFRAM=1)
332C~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
333 DO i=jft,jlt
334C---------E3------------
335 e3x(i) = ry(i) * sz(i) - rz(i) * sy(i)
336 e3y(i) = rz(i) * sx(i) - rx(i) * sz(i)
337 e3z(i) = rx(i) * sy(i) - ry(i) * sx(i)
338 det(i) = sqrt(e3x(i)*e3x(i) + e3y(i)*e3y(i) + e3z(i)*e3z(i))
339 IF (det(i) < em20 .AND. off(i) /= zero) THEN
340 off(i)=zero
341 idel7nok = 1
342 ENDIF
343 off_loc = zero
344 IF(abs(off(i))/=zero) off_loc = one
345 det(i)=max(em20,det(i))
346 cc = off_loc/det(i)
347 cc = max(cc,em20)
348 e3x(i) = e3x(i) * cc
349 e3y(i) = e3y(i) * cc
350 e3z(i) = e3z(i) * cc
351 ENDDO
352C~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
353 IF (irep==2) THEN
354 DO i=jft,jlt
355 e1x(i) = rx(i)
356 e1y(i) = ry(i)
357 e1z(i) = rz(i)
358 ENDDO
359 ELSEIF (irep==1) THEN
360 DO i=jft,jlt
361 c2 = sqrt(sx(i)*sx(i) + sy(i)*sy(i) + sz(i)*sz(i))
362 e1x(i) = rx(i)*c2+(sy(i)*e3z(i)-sz(i)*e3y(i))
363 e1y(i) = ry(i)*c2+(sz(i)*e3x(i)-sx(i)*e3z(i))
364 e1z(i) = rz(i)*c2+(sx(i)*e3y(i)-sy(i)*e3x(i))
365 ENDDO
366 ELSE
367 DO i=jft,jlt
368 c1c1 = rx(i)*rx(i) + ry(i)*ry(i) + rz(i)*rz(i)
369 c2c2 = sx(i)*sx(i) + sy(i)*sy(i) + sz(i)*sz(i)
370 IF(c1c1 /= zero) THEN
371 c2_1(i) = sqrt(c2c2/max(em20,c1c1))
372 c1_1(i) = one
373 ELSEIF(c2c2 /= zero)THEN
374 c2_1(i) = one
375 c1_1(i) = sqrt(c1c1/max(em20,c2c2))
376 END IF
377 ENDDO
378 DO i=jft,jlt
379 e1x(i) = rx(i)*c2_1(i)+(sy(i)*e3z(i)-sz(i)*e3y(i))*c1_1(i)
380 e1y(i) = ry(i)*c2_1(i)+(sz(i)*e3x(i)-sx(i)*e3z(i))*c1_1(i)
381 e1z(i) = rz(i)*c2_1(i)+(sx(i)*e3y(i)-sy(i)*e3x(i))*c1_1(i)
382 ENDDO
383 ENDIF
384C~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
385 DO i=jft,jlt
386 c1 = sqrt(e1x(i)*e1x(i) + e1y(i)*e1y(i) + e1z(i)*e1z(i))
387 IF(c1 /= zero) c1 = one / max(em20,c1)
388 e1x(i) = e1x(i)*c1
389 e1y(i) = e1y(i)*c1
390 e1z(i) = e1z(i)*c1
391 e2x(i) = e3y(i) * e1z(i) - e3z(i) * e1y(i)
392 e2y(i) = e3z(i) * e1x(i) - e3x(i) * e1z(i)
393 e2z(i) = e3x(i) * e1y(i) - e3y(i) * e1x(i)
394 ENDDO
395c-----------
396 RETURN
max
#define max(a, b)
Definition macros.h:21