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!||====================================================================
33 SUBROUTINE cdkcoor3(ELBUF_STR,
34 . JFT,JLT,MAT,PID,NGL,X,V,R,IXTG,OFFG,OFF,
35 . R11,R12,R13,R21,R22,R23,R31,R32,R33,
36 . XL2,YL2,XL3,YL3,SMSTR,
37 . AREA,AREA2,CDET,VLX,VLY,VLZ,RLX,RLY,
38 . ISMSTR,IREP,NLAY,DIR_A,DIR_B,
39 . F11,F12,F13,F21,F22,F23,F32,F33,
40 . M11,M12,M13,M21,M22,M23,NEL)
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
273 END
274c
275!||====================================================================
276!|| clskew3 ../engine/source/elements/sh3n/coquedk/cdkcoor3.F
277!||--- called by ------------------------------------------------------
278!|| c3coork3 ../engine/source/elements/sh3n/coque3n/c3coork3.F
279!|| c3evec3 ../engine/source/elements/sh3n/coque3n/c3evec3.F
280!|| cbacoor ../engine/source/elements/shell/coqueba/cbacoor.F
281!|| cbacoork ../engine/source/elements/shell/coqueba/cbacoork.F
282!|| cbacoort ../engine/source/elements/shell/coqueba/cbacoor.F
283!|| cdk6coor3 ../engine/source/elements/sh3n/coquedk6/cdk6coor3.F
284!|| cdkcoor3 ../engine/source/elements/sh3n/coquedk/cdkcoor3.F
285!|| czcoork3 ../engine/source/elements/shell/coquez/czcoork3.F
286!|| czcorc1 ../engine/source/elements/shell/coquez/czcorc.F
287!|| czcorcht ../engine/source/elements/shell/coquez/czcorc.F
288!|| czcorct ../engine/source/elements/shell/coquez/czcorc.F
289!|| enrichc_ini ../engine/source/elements/xfem/enrichc_ini.F
290!|| enrichtg_ini ../engine/source/elements/xfem/enrichtg_ini.F
291!|| get_q4l ../engine/source/output/sta/stat_c_strafg.F
292!|| get_q4lsys ../engine/source/output/sta/sta_c_get_q4lsys.F
293!|| get_t3l ../engine/source/output/sta/stat_c_strafg.F
294!|| get_t3lsys ../engine/source/output/sta/sta_c_get_t3lsys.F
295!|| scoor43 ../engine/source/elements/solid/sconnect/scoor43.F
296!|| shell_loc_cor ../engine/source/tools/seatbelts/shell_loc_cor.F
297!|| shell_local_frame ../engine/source/output/dynain/shell_rota.F
298!|| shlrotg ../engine/source/output/anim/generate/tensor6.F
299!|| tens3dto2d ../engine/source/output/h3d/h3d_results/h3d_skin_tensor.F
300!||====================================================================
301 SUBROUTINE clskew3(JFT,JLT,IREP,
302 . RX, RY, RZ, SX, SY, SZ,
303 . E1X, E2X, E3X, E1Y, E2Y, E3Y, E1Z, E2Z, E3Z,
304 . DET,OFF )
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
397 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:41
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
min
#define min(a, b)
Definition macros.h:20
max
#define max(a, b)
Definition macros.h:21