OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
cdkcoor3.F
Go to the documentation of this file.
1Copyright> OpenRadioss
2Copyright> Copyright (C) 1986-2025 Altair Engineering Inc.
3Copyright>
4Copyright> This program is free software: you can redistribute it and/or modify
5Copyright> it under the terms of the GNU Affero General Public License as published by
6Copyright> the Free Software Foundation, either version 3 of the License, or
7Copyright> (at your option) any later version.
8Copyright>
9Copyright> This program is distributed in the hope that it will be useful,
10Copyright> but WITHOUT ANY WARRANTY; without even the implied warranty of
11Copyright> MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12Copyright> GNU Affero General Public License for more details.
13Copyright>
14Copyright> You should have received a copy of the GNU Affero General Public License
15Copyright> along with this program. If not, see <https://www.gnu.org/licenses/>.
16Copyright>
17Copyright>
18Copyright> Commercial Alternative: Altair Radioss Software
19Copyright>
20Copyright> As an alternative to this open-source version, Altair also offers Altair Radioss
21Copyright> software under a commercial license. Contact Altair to discuss further if the
22Copyright> commercial version may interest you: https://www.altair.com/radioss/.
23!||====================================================================
24!|| cdkcoor3 ../engine/source/elements/sh3n/coquedk/cdkcoor3.F
25!||--- called by ------------------------------------------------------
26!|| cdkforc3 ../engine/source/elements/sh3n/coquedk/cdkforc3.F
27!||--- calls -----------------------------------------------------
28!|| clskew3 ../engine/source/elements/sh3n/coquedk/cdkcoor3.F
29!|| cortdir3 ../engine/source/elements/shell/coque/cortdir3.F
30!||--- uses -----------------------------------------------------
31!|| elbufdef_mod ../common_source/modules/mat_elem/elbufdef_mod.F90
32!|| element_mod ../common_source/modules/elements/element_mod.F90
33!||====================================================================
34 SUBROUTINE cdkcoor3(ELBUF_STR,
35 . JFT,JLT,MAT,PID,NGL,X,V,R,IXTG,OFFG,OFF,
36 . R11,R12,R13,R21,R22,R23,R31,R32,R33,
37 . XL2,YL2,XL3,YL3,SMSTR,
38 . AREA,AREA2,CDET,VLX,VLY,VLZ,RLX,RLY,
39 . ISMSTR,IREP,NLAY,DIR_A,DIR_B,
40 . F11,F12,F13,F21,F22,F23,F32,F33,
41 . M11,M12,M13,M21,M22,M23,NEL)
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
275 END
276c
277!||====================================================================
278!|| clskew3 ../engine/source/elements/sh3n/coquedk/cdkcoor3.F
279!||--- called by ------------------------------------------------------
280!|| c3coork3 ../engine/source/elements/sh3n/coque3n/c3coork3.F
281!|| c3evec3 ../engine/source/elements/sh3n/coque3n/c3evec3.F
282!|| cbacoor ../engine/source/elements/shell/coqueba/cbacoor.F
283!|| cbacoork ../engine/source/elements/shell/coqueba/cbacoork.F
284!|| cbacoort ../engine/source/elements/shell/coqueba/cbacoor.F
285!|| cdk6coor3 ../engine/source/elements/sh3n/coquedk6/cdk6coor3.F
286!|| cdkcoor3 ../engine/source/elements/sh3n/coquedk/cdkcoor3.F
287!|| czcoork3 ../engine/source/elements/shell/coquez/czcoork3.F
288!|| czcorc1 ../engine/source/elements/shell/coquez/czcorc.F
289!|| czcorcht ../engine/source/elements/shell/coquez/czcorc.F
290!|| czcorct ../engine/source/elements/shell/coquez/czcorc.F
291!|| enrichc_ini ../engine/source/elements/xfem/enrichc_ini.F
292!|| enrichtg_ini ../engine/source/elements/xfem/enrichtg_ini.F
293!|| get_q4l ../engine/source/output/sta/stat_c_strafg.F
294!|| get_q4lsys ../engine/source/output/sta/sta_c_get_q4lsys.F
295!|| get_t3l ../engine/source/output/sta/stat_c_strafg.F
296!|| get_t3lsys ../engine/source/output/sta/sta_c_get_t3lsys.F
297!|| scoor43 ../engine/source/elements/solid/sconnect/scoor43.F
298!|| shell_loc_cor ../engine/source/tools/seatbelts/shell_loc_cor.F
299!|| shell_local_frame ../engine/source/output/dynain/shell_rota.F
300!|| shlrotg ../engine/source/output/anim/generate/tensor6.F
301!|| tens3dto2d ../engine/source/output/h3d/h3d_results/h3d_skin_tensor.F
302!||====================================================================
303 SUBROUTINE clskew3(JFT,JLT,IREP,
304 . RX, RY, RZ, SX, SY, SZ,
305 . E1X, E2X, E3X, E1Y, E2Y, E3Y, E1Z, E2Z, E3Z,
306 . DET,OFF )
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
399 END
cdkcoor3
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)
Definition cdkcoor3.F:42
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
min
#define min(a, b)
Definition macros.h:20
max
#define max(a, b)
Definition macros.h:21