OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
c3coor3.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!|| c3coor3 ../engine/source/elements/sh3n/coque3n/c3coor3.F
25!||--- called by ------------------------------------------------------
26!|| c3forc3 ../engine/source/elements/sh3n/coque3n/c3forc3.F
27!||====================================================================
28 SUBROUTINE c3coor3(JFT ,JLT ,X ,IXTG ,
29 . OFFG ,OFF ,DT1C ,
30 . V ,VR ,VL1 ,VL2 ,VL3 ,
31 . VRL1 ,VRL2 ,VRL3 ,SIGY ,
32 . X1 ,X2 ,X3 ,Y1 ,Y2 ,
33 . Y3 ,Z1 ,Z2 ,Z3 ,XDP )
34C-----------------------------------------------
35C I m p l i c i t T y p e s
36C-----------------------------------------------
37#include "implicit_f.inc"
38C-----------------------------------------------
39C G l o b a l P a r a m e t e r s
40C-----------------------------------------------
41#include "mvsiz_p.inc"
42C-----------------------------------------------
43C C o m m o n B l o c k s
44C-----------------------------------------------
45#include "com08_c.inc"
46#include "scr05_c.inc"
47C-----------------------------------------------
48C D u m m y A r g u m e n t s
49C-----------------------------------------------
50 INTEGER JFT, JLT
51 INTEGER IXTG(NIXTG,*)
52 my_real
53 . OFFG(*), OFF(*),DT1C(*),X(3,*),
54 . V(3,*),VR(3,*),VL1(MVSIZ,3),VL2(MVSIZ,3),VL3(MVSIZ,3),
55 . vrl1(mvsiz,3),vrl2(mvsiz,3),vrl3(mvsiz,3),sigy(*)
56! SP issue :
57 REAL(kind=8), dimension(3,*), INTENT(in) :: xdp
58 REAL(kind=8), dimension(mvsiz), INTENT(out) ::x1,x2,x3
59 REAL(kind=8), dimension(mvsiz), INTENT(out) ::y1,y2,y3
60 REAL(kind=8), dimension(mvsiz), INTENT(out) ::z1,z2,z3
61
62
63C-----------------------------------------------
64C L o c a l V a r i a b l e s
65C-----------------------------------------------
66 INTEGER I, J, NC1, NC2, NC3
67 my_real OFF_L
68C=======================================================================
69 IF(IRESP == 1)then
70 DO i=jft,jlt
71 nc1 = ixtg(2,i)
72 nc2 = ixtg(3,i)
73 nc3 = ixtg(4,i)
74C----------------------------
75C COORDONNEES
76C----------------------------
77 x1(i)=xdp(1,nc1)
78 y1(i)=xdp(2,nc1)
79 z1(i)=xdp(3,nc1)
80 x2(i)=xdp(1,nc2)
81 y2(i)=xdp(2,nc2)
82 z2(i)=xdp(3,nc2)
83 x3(i)=xdp(1,nc3)
84 y3(i)=xdp(2,nc3)
85 z3(i)=xdp(3,nc3)
86 vl1(i,1)=v(1,nc1)
87 vl1(i,2)=v(2,nc1)
88 vl1(i,3)=v(3,nc1)
89 vl2(i,1)=v(1,nc2)
90 vl2(i,2)=v(2,nc2)
91 vl2(i,3)=v(3,nc2)
92 vl3(i,1)=v(1,nc3)
93 vl3(i,2)=v(2,nc3)
94 vl3(i,3)=v(3,nc3)
95 vrl1(i,1)=vr(1,nc1)
96 vrl1(i,2)=vr(2,nc1)
97 vrl1(i,3)=vr(3,nc1)
98 vrl2(i,1)=vr(1,nc2)
99 vrl2(i,2)=vr(2,nc2)
100 vrl2(i,3)=vr(3,nc2)
101 vrl3(i,1)=vr(1,nc3)
102 vrl3(i,2)=vr(2,nc3)
103 vrl3(i,3)=vr(3,nc3)
104 ENDDO
105 ELSE
106 DO i=jft,jlt
107 nc1 = ixtg(2,i)
108 nc2 = ixtg(3,i)
109 nc3 = ixtg(4,i)
110C----------------------------
111C COORDONNEES
112C----------------------------
113 x1(i)=x(1,nc1)
114 y1(i)=x(2,nc1)
115 z1(i)=x(3,nc1)
116 x2(i)=x(1,nc2)
117 y2(i)=x(2,nc2)
118 z2(i)=x(3,nc2)
119 x3(i)=x(1,nc3)
120 y3(i)=x(2,nc3)
121 z3(i)=x(3,nc3)
122 vl1(i,1)=v(1,nc1)
123 vl1(i,2)=v(2,nc1)
124 vl1(i,3)=v(3,nc1)
125 vl2(i,1)=v(1,nc2)
126 vl2(i,2)=v(2,nc2)
127 vl2(i,3)=v(3,nc2)
128 vl3(i,1)=v(1,nc3)
129 vl3(i,2)=v(2,nc3)
130 vl3(i,3)=v(3,nc3)
131 vrl1(i,1)=vr(1,nc1)
132 vrl1(i,2)=vr(2,nc1)
133 vrl1(i,3)=vr(3,nc1)
134 vrl2(i,1)=vr(1,nc2)
135 vrl2(i,2)=vr(2,nc2)
136 vrl2(i,3)=vr(3,nc2)
137 vrl3(i,1)=vr(1,nc3)
138 vrl3(i,2)=vr(2,nc3)
139 vrl3(i,3)=vr(3,nc3)
140 ENDDO
141 END if!(IRESP == 1)THEN
142C
143 off_l = zero
144 DO i=jft,jlt
145 dt1c(i) = dt1
146 off(i) = min(one,abs(offg(i)))
147 off_l = min(off_l,offg(i))
148 sigy(i) = ep30
149 ENDDO
150 IF (off_l < zero) THEN
151 DO i=jft,jlt
152 IF (offg(i) < zero) THEN
153 vl1(i,1)=zero
154 vl1(i,2)=zero
155 vl1(i,3)=zero
156 vl2(i,1)=zero
157 vl2(i,2)=zero
158 vl2(i,3)=zero
159 vl3(i,1)=zero
160 vl3(i,2)=zero
161 vl3(i,3)=zero
162 vrl1(i,1)=zero
163 vrl1(i,2)=zero
164 vrl1(i,3)=zero
165 vrl2(i,1)=zero
166 vrl2(i,2)=zero
167 vrl2(i,3)=zero
168 vrl3(i,1)=zero
169 vrl3(i,2)=zero
170 vrl3(i,3)=zero
171 ENDIF
172 ENDDO
173 ENDIF
174C-----------
175 RETURN
176 END
177!||====================================================================
178!|| c3coort3 ../engine/source/elements/sh3n/coque3n/c3coor3.F
179!||--- called by ------------------------------------------------------
180!|| c3forc3 ../engine/source/elements/sh3n/coque3n/c3forc3.f
181!||====================================================================
182 SUBROUTINE c3coort3(JFT ,JLT ,X ,IXTG ,OFFG ,
183 1 DR ,XL2 ,XL3 ,YL2 ,YL3 ,
184 2 E1X ,E1Y ,E1Z ,E2X ,E2Y ,
185 3 E2Z ,E3X ,E3Y ,E3Z ,NEL ,
186 5 V21X ,V31X ,V21Y ,V31Y ,RZ13 ,
187 6 RZ23 ,X2_T ,X3_T ,Y2_T ,Y3_T ,
188 7 AREA ,SMSTR ,ISROT )
189C-----------------------------------------------
190C I m p l i c i t T y p e s
191C-----------------------------------------------
192#include "implicit_f.inc"
193C-----------------------------------------------
194C G l o b a l P a r a m e t e r s
195C-----------------------------------------------
196#include "mvsiz_p.inc"
197C-----------------------------------------------
198C D u m m y A r g u m e n t s
199C-----------------------------------------------
200 INTEGER JFT, JLT,ISROT,NEL
201 INTEGER IXTG(NIXTG,*)
202 my_real
203 . X(3,*), OFFG(*), DR(3,*),
204 . E1X(*), E1Y(*), E1Z(*),
205 . E2X(*), E2Y(*), E2Z(*),E3X(*), E3Y(*), E3Z(*),
206 . XL2(*),XL3(*),YL2(*),YL3(*),AREA(*),
207 . V21X(*),V31X(*),V21Y(*),V31Y(*),RZ13(*),RZ23(*),
208 . X2_T(*),X3_T(*),Y2_T(*),Y3_T(*)
209 DOUBLE PRECISION
210 . SMSTR(*)
211C-----------------------------------------------
212C L o c a l V a r i a b l e s
213C-----------------------------------------------
214 INTEGER I, J, NC1, NC2, NC3,II(6),NN(3)
215 my_real
216 . X0G2(MVSIZ),X0G3(MVSIZ),Y0G2(MVSIZ),Y0G3(MVSIZ),OFF_L,
217 . Z0G2(MVSIZ),Z0G3(MVSIZ),AXYZ(MVSIZ,3,3),
218 . E01X(MVSIZ), E01Y(MVSIZ), E01Z(MVSIZ),
219 . E02X(MVSIZ), E02Y(MVSIZ), E02Z(MVSIZ),E03X(MVSIZ),
220 . e03y(mvsiz), e03z(mvsiz),x0l2(mvsiz), x0l3(mvsiz),
221 . y0l2(mvsiz),y0l3(mvsiz),sum(mvsiz),norm,xl,yl,vr1_12,vr1_21,
222 . rlz1,rlz2,rlz3,areai,x0g32,y0g32,z0g32,dirz(mvsiz,2)
223C-----------------------------------------------
224 DO i=1,6
225 ii(i) = nel*(i-1)
226 ENDDO
227C
228 DO i=jft,jlt
229 IF(abs(offg(i))==one)offg(i)=sign(two,offg(i))
230 axyz(i,1:3,1:3)= zero
231C
232 IF (isrot > 0 ) THEN
233 nn(1) = ixtg(2,i)
234 nn(2) = ixtg(3,i)
235 nn(3) = ixtg(4,i)
236 axyz(i,1,1) = dr(1,nn(1))
237 axyz(i,2,1) = dr(2,nn(1))
238 axyz(i,3,1) = dr(3,nn(1))
239 axyz(i,1,2) = dr(1,nn(2))
240 axyz(i,2,2) = dr(2,nn(2))
241 axyz(i,3,2) = dr(3,nn(2))
242 axyz(i,1,3) = dr(1,nn(3))
243 axyz(i,2,3) = dr(2,nn(3))
244 axyz(i,3,3) = dr(3,nn(3))
245 END IF !(ISROT > 0 ) THEN
246
247 x0g2(i) = smstr(ii(1)+i)
248 y0g2(i) = smstr(ii(2)+i)
249 z0g2(i) = smstr(ii(3)+i)
250 x0g3(i) = smstr(ii(4)+i)
251 y0g3(i) = smstr(ii(5)+i)
252 z0g3(i) = smstr(ii(6)+i)
253 ENDDO
254C-- normal in initial conf.
255 DO i=jft,jlt
256 e01x(i)= x0g2(i)
257 e01y(i)= y0g2(i)
258 e01z(i)= z0g2(i)
259 sum(i) = sqrt(e01x(i)*e01x(i)+e01y(i)*e01y(i)+e01z(i)*e01z(i))
260 e01x(i)=e01x(i)/sum(i)
261 e01y(i)=e01y(i)/sum(i)
262 e01z(i)=e01z(i)/sum(i)
263 ENDDO
264C
265 DO i=jft,jlt
266 x0g32=x0g3(i)-x0g2(i)
267 y0g32=y0g3(i)-y0g2(i)
268 z0g32=z0g3(i)-z0g2(i)
269 e03x(i)=y0g3(i)*z0g32-z0g3(i)*y0g32
270 e03y(i)=z0g3(i)*x0g32-x0g3(i)*z0g32
271 e03z(i)=x0g3(i)*y0g32-y0g3(i)*x0g32
272 sum(i) = sqrt(e03x(i)*e03x(i)+e03y(i)*e03y(i)+e03z(i)*e03z(i))
273 e03x(i)=e03x(i)/sum(i)
274 e03y(i)=e03y(i)/sum(i)
275 e03z(i)=e03z(i)/sum(i)
276 area(i) = half * sum(i)
277 ENDDO
278C
279 DO i=jft,jlt
280 e02x(i)=e03y(i)*e01z(i)-e03z(i)*e01y(i)
281 e02y(i)=e03z(i)*e01x(i)-e03x(i)*e01z(i)
282 e02z(i)=e03x(i)*e01y(i)-e03y(i)*e01x(i)
283 sum(i) = sqrt(e02x(i)*e02x(i)+e02y(i)*e02y(i)+e02z(i)*e02z(i))
284 e02x(i)=e02x(i)/sum(i)
285 e02y(i)=e02y(i)/sum(i)
286 e02z(i)=e02z(i)/sum(i)
287 ENDDO
288C----------------------------
289C xl =VR1^t x0l; VR1^t=(VQ0^t*VQ)^t---extract Rzl of VR1
290C----------------------------
291 DO i=jft,jlt
292 vr1_12=e01x(i)*e2x(i)+e01y(i)*e2y(i)+e01z(i)*e2z(i)
293 vr1_21=e02x(i)*e1x(i)+e02y(i)*e1y(i)+e02z(i)*e1z(i)
294 dirz(i,2) = half*(vr1_12-vr1_21)
295 norm = one-dirz(i,2)*dirz(i,2)
296 dirz(i,1) = sqrt(max(zero,norm))
297 ENDDO
298 DO i=jft,jlt
299 x0l2(i)=e01x(i)*x0g2(i)+e01y(i)*y0g2(i)+e01z(i)*z0g2(i)
300 y0l2(i)=e02x(i)*x0g2(i)+e02y(i)*y0g2(i)+e02z(i)*z0g2(i)
301 x0l3(i)=e01x(i)*x0g3(i)+e01y(i)*y0g3(i)+e01z(i)*z0g3(i)
302 y0l3(i)=e02x(i)*x0g3(i)+e02y(i)*y0g3(i)+e02z(i)*z0g3(i)
303 ENDDO
304C----------------------------
305C Rotate x0l of Rz1
306C----------------------------
307 DO i=jft,jlt
308 xl= x0l2(i)*dirz(i,1)-y0l2(i)*dirz(i,2)
309 yl= x0l2(i)*dirz(i,2)+y0l2(i)*dirz(i,1)
310 x0l2(i)=xl
311 y0l2(i)=yl
312 xl= x0l3(i)*dirz(i,1)-y0l3(i)*dirz(i,2)
313 yl= x0l3(i)*dirz(i,2)+y0l3(i)*dirz(i,1)
314 x0l3(i)=xl
315 y0l3(i)=yl
316 ENDDO
317C------U21,U31 in actual local system
318 DO i=jft,jlt
319 v21x(i)=xl2(i)-x0l2(i)
320 v31x(i)=xl3(i)-x0l3(i)
321 v21y(i)=yl2(i)-y0l2(i)
322 v31y(i)=yl3(i)-y0l3(i)
323 ENDDO
324 DO i=jft,jlt
325 x2_t(i) = x0l2(i)
326 x3_t(i) = x0l3(i)
327 y2_t(i) = y0l2(i)
328 y3_t(i) = y0l3(i)
329 ENDDO
330 IF (isrot>0) THEN
331C------RZ13,RZ23 in actual local system
332 DO i=jft,jlt
333 areai=half/max(em20,area(i))
334 rlz1 =e3x(i)*axyz(i,1,1)+e3y(i)*axyz(i,2,1)+e3z(i)*axyz(i,3,1)
335 rlz2 =e3x(i)*axyz(i,1,2)+e3y(i)*axyz(i,2,2)+e3z(i)*axyz(i,3,2)
336 rlz3 =e3x(i)*axyz(i,1,3)+e3y(i)*axyz(i,2,3)+e3z(i)*axyz(i,3,3)
337 rz13(i)=(rlz1-rlz3)*areai
338 rz23(i)=(rlz2-rlz3)*areai
339 ENDDO
340 END IF !(ISROT>0) THEN
341C
342 off_l = zero
343 DO i=jft,jlt
344 off_l = min(off_l,offg(i))
345 ENDDO
346 IF (off_l < zero) THEN
347 DO i=jft,jlt
348 IF (offg(i) < zero) THEN
349 v21x(i) = zero
350 v31x(i) = zero
351 v21y(i) = zero
352 v31y(i) = zero
353 rz13(i) = zero
354 rz23(i) = zero
355 ENDIF
356 ENDDO
357 ENDIF
358C-----------
359 RETURN
360 END
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)
Definition c3coor3.F:34
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)
Definition c3coor3.F:189
subroutine c3forc3(timers, elbuf_str, jft, jlt, pm, ixtg, x, f, m, v, r, failwave, nvc, mtn, geo, tf, npf, bufmat, pmsav, dt2t, neltst, ityptst, stifn, stifr, fsky, iadtg, itab, epsdot, offset, iparttg, thke, f11, f12, f13, f21, f22, f23, f31, f32, f33, m11, m12, m13, m21, m22, m23, m31, m32, m33, group_param, mat_elem, nel, istrain, ish3n, xedge3n, ithk, iofc, ipla, nft, ismstr, npt, kfts, fzero, igeo, ipm, ifailure, itask, jthe, temp, fthe, fthesky, iexpan, gresav, grth, igrth, mstg, dmeltg, jsms, table, iparg, ixfem, sensors, ptg, ibordnode, elcutc, inod_crk, iel_crk, nodenr, iadtg_crk, nodedge, crknodiad, knod2elc, condn, condnsky, stack, isubstack, xfem_str, crkedge, drape_sh3n, ipri, nloc_dmg, xdp, indx_drape, igre, jtur, dt, snpc, stf, glob_therm, idel7nok, userl_avail, maxfunc, sbufmat)
Definition c3forc3.F:112
if(complex_arithmetic) id
norm(diag(diag(diag(inv(mat))) -id.SOL), 2) % destroy mumps instance id.JOB
#define min(a, b)
Definition macros.h:20
#define max(a, b)
Definition macros.h:21