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 34 of file cdkcoor3.F.

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

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