OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
r2def3.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!|| r2def3 ../engine/source/elements/spring/r2def3.F
25!||--- called by ------------------------------------------------------
26!|| rforc3 ../engine/source/elements/spring/rforc3.F
27!||--- calls -----------------------------------------------------
28!|| redef3 ../engine/source/elements/spring/redef3.F90
29!|| repla3 ../engine/source/elements/spring/repla3.F
30!||--- uses -----------------------------------------------------
31!|| python_funct_mod ../common_source/modules/python_mod.F90
32!|| redef3_mod ../engine/source/elements/spring/redef3.F90
33!||====================================================================
34 SUBROUTINE r2def3(PYTHON,
35 1 SKEW, GEO, FX, FY,
36 2 FZ, E, DX, DY,
37 3 DZ, NPF, TF, OFF,
38 4 DPX, DPY, DPZ, DPX2,
39 5 DPY2, DPZ2, FXEP, FYEP,
40 6 FZEP, X0, Y0, Z0,
41 7 XMOM, YMOM, ZMOM, RX,
42 8 RY, RZ, RPX, RPY,
43 9 RPZ, XMEP, YMEP, ZMEP,
44 A RPX2, RPY2, RPZ2, ANIM,
45 B IPOSX, IPOSY, IPOSZ, IPOSXX,
46 C IPOSYY, IPOSZZ, V,
47 D IGEO, E6, CRITNEW, NEL,
48 E X0_ERR, X1DP, X2DP, YIELDX,
49 F YIELDY, YIELDZ, YIELDX2, YIELDY2,
50 G YIELDZ2, NGL, XKR, MGN,
51 H EXX, EYX, EZX, EXY,
52 I EYY, EZY, EXZ, EYZ,
53 J EZZ, XCR, RX1, RY1,
54 K RZ1, RX2, RY2, RZ2,
55 L XIN, AK, XM, XKM,
56 M XCM, NC1, NC2, NUVAR,
57 N UVAR, DX0, DY0, DZ0,
58 O RX0, RY0, RZ0, IEQUIL,
59 P SKEW_ID, NFT, STF, SANIN,
60 Q IRESP, SNPC)
61 USE python_funct_mod
62 USE redef3_mod
63C-----------------------------------------------
64C I m p l i c i t T y p e s
65C-----------------------------------------------
66#include "implicit_f.inc"
67#include "comlock.inc"
68C-----------------------------------------------
69C G l o b a l P a r a m e t e r s
70C-----------------------------------------------
71#include "mvsiz_p.inc"
72C-----------------------------------------------
73C C o m m o n B l o c k s
74C-----------------------------------------------
75#include "param_c.inc"
76#include "com04_c.inc"
77#include "com08_c.inc"
78#include "scr14_c.inc"
79#include "scr17_c.inc"
80#include "units_c.inc"
81#include "com01_c.inc"
82#include "impl1_c.inc"
83C-----------------------------------------------
84C D u m m y A r g u m e n t s
85C-----------------------------------------------
86 type(python_), intent(inout) :: PYTHON
87 INTEGER, INTENT(IN) :: STF !< Size of tf
88 INTEGER, INTENT(IN) :: SANIN !< Size of ANIM
89 INTEGER, INTENT(IN) :: IRESP !< Single precision flag
90 INTEGER, INTENT(IN) :: SNPC !< Size of NPF
91 INTEGER, INTENT(IN) :: NFT
92 INTEGER NPF(SNPC), IGEO(NPROPGI,*),NEL,NGL(*),MGN(*),NC1(*),NC2(*),NUVAR,IEQUIL(*),SKEW_ID(*)
93C REAL
94 my_real
95 . SKEW(LSKEW,*), GEO(NPROPG,*), FX(*), FY(*), FZ(*), E(*), DX(*),
96 . DY(*), DZ(*), TF(STF), OFF(*), DPX(*), DPY(*), DPZ(*), FXEP(*),
97 . FYEP(*), FZEP(*), X0(*), Y0(*), Z0(*), XMOM(*), YMOM(*),
98 . ZMOM(*), RX(*), RY(*), RZ(*), RPX(*), RPY(*), RPZ(*), XMEP(*),
99 . YMEP(*), ZMEP(*), DPX2(*), DPY2(*), DPZ2(*), RPX2(*), RPY2(*),
100 . RPZ2(*), ANIM(SANIN),IPOSX(*),IPOSY(*),IPOSZ(*),IPOSXX(*),
101 . IPOSYY(*),IPOSZZ(*),V(3,*),
102 . CRITNEW(*),E6(NEL,6),X0_ERR(3,*),YIELDX(*),YIELDY(*) ,
103 . YIELDZ(*),YIELDX2(*),YIELDY2(*),YIELDZ2(*),
104 . EXX(MVSIZ), EYX(MVSIZ), EZX(MVSIZ),
105 . EXY(MVSIZ), EYY(MVSIZ), EZY(MVSIZ),
106 . EXZ(MVSIZ), EYZ(MVSIZ), EZZ(MVSIZ),
107 . XCR(MVSIZ),RX1(MVSIZ),RX2(MVSIZ),RY1(MVSIZ),
108 . RY2(MVSIZ),RZ1(MVSIZ),RZ2(MVSIZ),XIN(MVSIZ),
109 . AK(MVSIZ),XM(MVSIZ),XKM(MVSIZ),XCM(MVSIZ),XKR(MVSIZ),
110 . UVAR(NUVAR,*),DX0(*),DY0(*),DZ0(*),RX0(*),RY0(*),RZ0(*)
111 DOUBLE PRECISION X1DP(3,*),X2DP(3,*)
112 TARGET :: uvar
113C-----------------------------------------------
114C L o c a l V a r i a b l e s
115C-----------------------------------------------
116 INTEGER IFUNC2(MVSIZ),
117 . iecrou(mvsiz), ifunc(mvsiz), ifv(mvsiz),
118 . indx(mvsiz),ifunc3(mvsiz),
119 . i,j,isk, kk,nindx,ifail(mvsiz),ifail2(mvsiz),israte
120C REAL
121 my_real
122 . xk(mvsiz), yk(mvsiz), zk(mvsiz),
123 . xc(mvsiz), yc(mvsiz), zc(mvsiz),
124 . xhr(mvsiz),xh(mvsiz),
125 . dxold(mvsiz), dyold(mvsiz), dzold(mvsiz),dv(mvsiz),
126 . epla(mvsiz),xl0(mvsiz),rscale(mvsiz),
127 . b(mvsiz), d(mvsiz),dmn(mvsiz),dmx(mvsiz),crit(mvsiz),
128 . x21(mvsiz), y21(mvsiz), z21(mvsiz),lscale(mvsiz),ee(mvsiz),
129 . gf3(mvsiz),hx(mvsiz), hy(mvsiz), hz(mvsiz),
130 . x0_ini(mvsiz),y0_ini(mvsiz),z0_ini(mvsiz)
131 my_real
132 . sx,sy,sz,xx,yy,zz,xka,yka,zka,aa,bb,cc,x21phi,y21phi,z21phi,
133 . asrate,dlim,not_used,not_used2(2)
134 DOUBLE PRECISION X21DP(MVSIZ),Y21DP(MVSIZ),Z21DP(MVSIZ),
135 . X0DP(MVSIZ),Y0DP(MVSIZ),Z0DP(MVSIZ)
136 my_real ,DIMENSION(:), POINTER :: XX_OLD
137 TARGET :: not_used2
138C-----------------------------------------------
139C
140 not_used = zero
141 not_used2 = zero
142C
143 DO i=1,nel
144 epla(i)=zero
145 xm(i)=geo(1,mgn(i))
146 xk(i)=geo(3,mgn(i))
147 xc(i)=geo(4,mgn(i))
148 yk(i)=geo(10,mgn(i))
149 yc(i)=geo(11,mgn(i))
150 zk(i)=geo(15,mgn(i))
151 zc(i)=geo(16,mgn(i))
152 ifail(i) = nint(geo(79, mgn(i)))
153 ifail2(i) = nint(geo(95, mgn(i)))
154 xka=xk(i)*geo(41,mgn(i))
155 yka=yk(i)*geo(45,mgn(i))
156 zka=zk(i)*geo(49,mgn(i))
157 xkm(i)= max(xka,yka,zka)
158 hx(i) = geo(141,mgn(i))
159 hy(i) = geo(142,mgn(i))
160 hz(i) = geo(143,mgn(i))
161 xh(i)= max(hx(i),hy(i),hz(i))
162 xcm(i)= max(xc(i),yc(i),zc(i))
163 xcm(i)= xcm(i)+xh(i)
164
165 isk=skew_id(i)
166 exx(i)=skew(1,isk)
167 eyx(i)=skew(2,isk)
168 ezx(i)=skew(3,isk)
169 exy(i)=skew(4,isk)
170 eyy(i)=skew(5,isk)
171 ezy(i)=skew(6,isk)
172 exz(i)=skew(7,isk)
173 eyz(i)=skew(8,isk)
174 ezz(i)=skew(9,isk)
175 xl0(i)=one
176 iequil(i) = nint(geo(94,mgn(i)))
177 ENDDO
178C---------------------
179C TRANSLATIONS
180C---------------------
181 DO i=1,nel
182 dxold(i)=dx(i)
183 dyold(i)=dy(i)
184 dzold(i)=dz(i)
185 ENDDO
186C
187 IF (inispri /= 0 .and. tt == zero) THEN
188 DO i=1,nel
189 dxold(i)=dx0(i)
190 dyold(i)=dy0(i)
191 dzold(i)=dz0(i)
192 ENDDO
193 ENDIF
194C
195 IF (inispri /= 0 .and. tt == zero) THEN
196 DO i=1,nel
197 x0_ini(i)=x0(i)
198 y0_ini(i)=y0(i)
199 z0_ini(i)=z0(i)
200 ENDDO
201 ENDIF
202C
203 DO i=1,nel
204 x21dp(i)= x2dp(1,i)-x1dp(1,i)
205 y21dp(i)= x2dp(2,i)-x1dp(2,i)
206 z21dp(i)= x2dp(3,i)-x1dp(3,i)
207 x21(i)= x21dp(i)
208 y21(i)= y21dp(i)
209 z21(i)= z21dp(i)
210 ENDDO
211C
212 IF (tt == zero) THEN
213 DO i=1,nel
214 x0dp(i)= x21dp(i)*exx(i)+y21dp(i)*eyx(i)+z21dp(i)*ezx(i)
215 y0dp(i)= x21dp(i)*exy(i)+y21dp(i)*eyy(i)+z21dp(i)*ezy(i)
216 z0dp(i)= x21dp(i)*exz(i)+y21dp(i)*eyz(i)+z21dp(i)*ezz(i)
217 x0(i)= x0dp(i) ! cast double to My_real
218 y0(i)= y0dp(i) ! cast double to My_real
219 z0(i)= z0dp(i) ! cast double to My_real
220 ENDDO
221!
222 IF (inispri /= 0) THEN
223! condition nedeed for spring type 8, which are not concerned by /INISPRI,
224! and having initial length /= 0
225 DO i=1,nel
226 IF (x0_ini(i) == zero .and. dx0(i) == zero) x0_ini(i) = x0dp(i)
227 IF (y0_ini(i) == zero .and. dy0(i) == zero) y0_ini(i) = y0dp(i)
228 IF (z0_ini(i) == zero .and. dz0(i) == zero) z0_ini(i) = z0dp(i)
229 ENDDO
230 ENDIF
231!
232 ENDIF ! IF (TT == ZERO)
233C
234 IF (scodver >= 101) THEN
235 IF (tt == zero) THEN
236 DO i=1,nel
237 x0_err(1,i)= x0dp(i)-x0(i) ! difference between double and my_real
238 x0_err(2,i)= y0dp(i)-y0(i) ! difference between double and my_real
239 x0_err(3,i)= z0dp(i)-z0(i) ! difference between double and my_real
240 ENDDO
241 ENDIF
242 ENDIF
243C
244 IF (inispri /= 0 .and. tt == zero) THEN
245 DO i=1,nel
246 x0(i)=x0_ini(i)
247 y0(i)=y0_ini(i)
248 z0(i)=z0_ini(i)
249 ENDDO
250 ENDIF
251C
252 DO i=1,nel
253 x0dp(i)= x0(i) ! cast My_real en double
254 y0dp(i)= y0(i) ! cast My_real en double
255 z0dp(i)= z0(i) ! cast My_real en double
256 ENDDO
257C
258 IF (scodver >= 101) THEN
259 DO i=1,nel
260 x0dp(i)= x0dp(i) + x0_err(1,i) ! AL_DP must be recomputed to be sure of absolute consistency between AL0_DP and AL_DP
261 y0dp(i)= y0dp(i) + x0_err(2,i) ! AL_DP must be recomputed to be sure of absolute consistency between AL0_DP and AL_DP
262 z0dp(i)= z0dp(i) + x0_err(3,i) ! AL_DP must be recomputed to be sure of absolute consistency between AL0_DP and AL_DP
263 ENDDO
264 ENDIF
265C
266 IF (ismdisp > 0) THEN
267 DO i=1,nel
268 IF (iequil(i) == 1) THEN
269 sx= half*(rx2(i)+rx1(i))
270 sy= half*(ry2(i)+ry1(i))
271 sz= half*(rz2(i)+rz1(i))
272 xx = y21(i)*sz - z21(i)*sy
273 yy = z21(i)*sx - x21(i)*sz
274 zz = x21(i)*sy - y21(i)*sx
275 xx= (v(1,nc2(i)) - v(1,nc1(i)) + xx)*dt1
276 yy= (v(2,nc2(i)) - v(2,nc1(i)) + yy)*dt1
277 zz= (v(3,nc2(i)) - v(3,nc1(i)) + zz)*dt1
278 ELSE
279 xx= (v(1,nc2(i)) - v(1,nc1(i)))*dt1
280 yy= (v(2,nc2(i)) - v(2,nc1(i)))*dt1
281 zz= (v(3,nc2(i)) - v(3,nc1(i)))*dt1
282 ENDIF
283 dx(i) = dxold(i)+xx*exx(i)+yy*eyx(i)+zz*ezx(i)
284 dy(i) = dyold(i)+xx*exy(i)+yy*eyy(i)+zz*ezy(i)
285 dz(i) = dzold(i)+xx*exz(i)+yy*eyz(i)+zz*ezz(i)
286C
287 crit(i) = zero
288 ENDDO
289 ELSE
290 DO i=1,nel
291 IF (iequil(i) == 1) THEN
292 sx= half*(rx2(i)+rx1(i))
293 sy= half*(ry2(i)+ry1(i))
294 sz= half*(rz2(i)+rz1(i))
295 xx = y21(i)*sz - z21(i)*sy
296 yy = z21(i)*sx - x21(i)*sz
297 zz = x21(i)*sy - y21(i)*sx
298 xx= (v(1,nc2(i)) - v(1,nc1(i)) + xx)*dt1
299 yy= (v(2,nc2(i)) - v(2,nc1(i)) + yy)*dt1
300 zz= (v(3,nc2(i)) - v(3,nc1(i)) + zz)*dt1
301 dx(i)= dxold(i) + xx*exx(i)+yy*eyx(i)+zz*ezx(i)
302 dy(i)= dyold(i) + xx*exy(i)+yy*eyy(i)+zz*ezy(i)
303 dz(i)= dzold(i) + xx*exz(i)+yy*eyz(i)+zz*ezz(i)
304 ELSE
305 dx(i)= x21dp(i)*exx(i)+y21dp(i)*eyx(i)+z21dp(i)*ezx(i)-x0dp(i)
306 dy(i)= x21dp(i)*exy(i)+y21dp(i)*eyy(i)+z21dp(i)*ezy(i)-y0dp(i)
307 dz(i)= x21dp(i)*exz(i)+y21dp(i)*eyz(i)+z21dp(i)*ezz(i)-z0dp(i)
308 ENDIF
309 crit(i) = zero
310 ENDDO
311 ENDIF !(ISMDISP > 0) THEN
312C-------------------------------
313 nindx = 0
314 DO i=1,nel
315 ifunc(i) = igeo(101,mgn(i))
316 ifv(i) = igeo(102,mgn(i))
317 ifunc2(i)= igeo(103,mgn(i))
318 ifunc3(i)= igeo(119,mgn(i))
319 iecrou(i)= nint(geo(7,mgn(i)))
320 ak(i) = geo(41,mgn(i))
321 b(i) = geo(42,mgn(i))
322 d(i) = geo(43,mgn(i))
323 ee(i) = geo(40 ,mgn(i))
324 gf3(i) = geo(132,mgn(i))
325 rscale(i)= geo(44,mgn(i))
326 lscale(i)= geo(39 ,mgn(i))
327 dmn(i) = geo(65,mgn(i))
328 dmx(i) = geo(66,mgn(i))
329 ENDDO
330 IF (nuvar > 0) THEN
331 xx_old => uvar(1,1:nel)
332 ELSE
333 xx_old => not_used2
334 ENDIF
335 CALL redef3(python,
336 1 fx, xk, dx, fxep,
337 2 dxold, dpx, tf, npf,
338 3 xc, off, e6(1,1), dpx2,
339 4 anim, anim_fe(11),iposx,
340 5 xl0, dmn, dmx, dv,
341 6 rscale, lscale, ee, gf3,
342 7 ifunc3, yieldx, x0dp, ak,
343 8 b, d, iecrou, ifunc,
344 9 ifv, ifunc2, epla, xx_old,
345 a nel, nft, stf, sanin,
346 b dt1, iresp, impl_s, idyna,
347 c snpc)
348 DO i=1,nel
349 dlim = zero
350 IF (ifail2(i) == 0) THEN
351 IF (dx(i) > zero) THEN
352 dlim = dx(i) / dmx(i)
353 ELSE
354 dlim = dx(i) / dmn(i)
355 ENDIF
356 ELSEIF (ifail2(i) == 1) THEN
357 IF (fx(i) > zero) THEN
358 dlim = fx(i) / dmx(i)
359 ELSE
360 dlim = fx(i) / dmn(i)
361 ENDIF
362 ELSEIF (ifail2(i) == 2) THEN
363 dlim = max(zero, e6(i,1)) / dmx(i)
364 ENDIF
365 IF (off(i) == one .AND. dmx(i) /= zero .AND. dmn(i) /= zero) THEN
366 IF( ifail(i) == 0 ) THEN
367! Uniaxial failure
368 crit(i) = max(crit(i),dlim)
369 ELSE
370! Multiaxial failure
371 crit(i) = crit(i) + dlim**2
372 ENDIF
373 ENDIF
374 ENDDO
375 DO i=1,nel
376 ifunc(i) = igeo(104,mgn(i))
377 ifv(i) = igeo(105,mgn(i))
378 ifunc2(i)= igeo(106,mgn(i))
379 ifunc3(i)= igeo(120,mgn(i))
380 iecrou(i)= nint(geo(14,mgn(i)))
381 ak(i) = geo(45,mgn(i))
382 b(i) = geo(46,mgn(i))
383 d(i) = geo(47,mgn(i))
384 dmn(i) = geo(67,mgn(i))
385 dmx(i) = geo(68,mgn(i))
386 ee(i) =geo(180,mgn(i))
387 gf3(i) =geo(133,mgn(i))
388 rscale(i)= geo(48,mgn(i))
389 lscale(i)= geo(174,mgn(i))
390 ENDDO
391 kk = 1 + numelr * anim_fe(11)
392 IF (nuvar > 0) xx_old => uvar(2,1:nel)
393 CALL redef3(python,
394 1 fy, yk, dy, fyep,
395 2 dyold, dpy, tf, npf,
396 3 yc, off, e6(1,2), dpy2,
397 4 anim(kk), anim_fe(12),iposy,
398 5 xl0, dmn, dmx, dv,
399 6 rscale, lscale, ee, gf3,
400 7 ifunc3, yieldy, y0dp, ak,
401 8 b, d, iecrou, ifunc,
402 9 ifv, ifunc2, epla, xx_old,
403 a nel, nft, stf, sanin,
404 b dt1, iresp, impl_s, idyna,
405 c snpc)
406 DO i=1,nel
407 dlim = zero
408 IF (ifail2(i) == 0 ) THEN
409 IF (dy(i) > zero) THEN
410 dlim = dy(i) / dmx(i)
411 ELSE
412 dlim = dy(i) / dmn(i)
413 ENDIF
414 ELSEIF (ifail2(i) == 1) THEN
415 IF (fy(i) > zero) THEN
416 dlim = fy(i) / dmx(i)
417 ELSE
418 dlim = fy(i) / dmn(i)
419 ENDIF
420 ELSEIF (ifail2(i) == 2) THEN
421 dlim = max(zero, e6(i,2)) / dmx(i)
422 ENDIF
423 IF (off(i) == one .AND. dmx(i) /= zero .AND. dmn(i) /= zero) THEN
424 IF (ifail(i) == 0) THEN
425! Uniaxial failure
426 crit(i) = max(crit(i),dlim)
427 ELSE
428! Multiaxial failure
429 crit(i) = crit(i) + dlim**2
430 ENDIF
431 ENDIF
432 ENDDO
433 DO i=1,nel
434 ifunc(i) = igeo(107,mgn(i))
435 ifv(i) = igeo(108,mgn(i))
436 ifunc2(i)= igeo(109,mgn(i))
437 ifunc3(i)= igeo(121,mgn(i))
438 iecrou(i)=nint(geo(18,mgn(i)))
439 ak(i) =geo(49,mgn(i))
440 b(i) =geo(50,mgn(i))
441 d(i) =geo(51,mgn(i))
442 ee(i) =geo(181,mgn(i))
443 gf3(i) =geo(134,mgn(i))
444 rscale(i)= geo(52,mgn(i))
445 lscale(i)=geo(175,mgn(i))
446 dmn(i) =geo(69,mgn(i))
447 dmx(i) =geo(77,mgn(i))
448 ENDDO
449 kk = 1 + numelr * (anim_fe(11)+anim_fe(12))
450 IF (nuvar > 0) xx_old => uvar(3,1:nel)
451 CALL redef3(python,
452 1 fz, zk, dz, fzep,
453 2 dzold, dpz, tf, npf,
454 3 zc, off, e6(1,3), dpz2,
455 4 anim(kk), anim_fe(13),iposz,
456 5 xl0, dmn, dmx, dv,
457 6 rscale, lscale, ee, gf3,
458 7 ifunc3, yieldz, z0dp, ak,
459 8 b, d, iecrou, ifunc,
460 9 ifv, ifunc2, epla, xx_old,
461 a nel, nft, stf, sanin,
462 b dt1, iresp, impl_s, idyna,
463 c snpc)
464 DO i=1,nel
465 dlim = zero
466 IF (ifail2(i) == 0) THEN
467 IF (dz(i) > zero) THEN
468 dlim = dz(i) / dmx(i)
469 ELSE
470 dlim = dz(i) / dmn(i)
471 ENDIF
472 ELSEIF (ifail2(i) == 1) THEN
473 IF (fz(i) > zero) THEN
474 dlim = fz(i) / dmx(i)
475 ELSE
476 dlim = fz(i) / dmn(i)
477 ENDIF
478 ELSEIF (ifail2(i) == 2) THEN
479 dlim = max(zero, e6(i,3)) / dmx(i)
480 ENDIF
481 IF (off(i) == one .AND. dmx(i) /= zero .AND. dmn(i) /= zero) THEN
482 IF (ifail(i) == 0) THEN
483! Uniaxial failure
484 crit(i) = max(crit(i),dlim)
485 ELSE
486! Multiaxial failure
487 crit(i) = crit(i) + dlim**2
488 ENDIF
489 ENDIF
490 ENDDO
491C---------------------
492C ROTATIONS
493C---------------------
494 DO i=1,nel
495 xin(i)=geo(9,mgn(i))
496 xk(i)=geo(19,mgn(i))
497 xc(i)=geo(20,mgn(i))
498 yk(i)=geo(23,mgn(i))
499 yc(i)=geo(24,mgn(i))
500 zk(i)=geo(27,mgn(i))
501 zc(i)=geo(28,mgn(i))
502 hx(i) = geo(144,mgn(i))
503 hy(i) = geo(145,mgn(i))
504 hz(i) = geo(146,mgn(i))
505
506 xhr(i)= max(hx(i),hy(i),hz(i))
507 xkr(i)= max(xk(i)*geo(53,mgn(i)),
508 . yk(i)*geo(57,mgn(i)),
509 . zk(i)*geo(61,mgn(i)))
510 xcr(i)= max(xc(i),yc(i),zc(i)) + xhr(i)
511 ENDDO
512C
513 DO i=1,nel
514 dxold(i)=rx(i)
515 dyold(i)=ry(i)
516 dzold(i)=rz(i)
517 ENDDO
518C
519 IF (inispri /= 0 .and. tt == zero) THEN
520 DO i=1,nel
521 dxold(i)=rx0(i)
522 dyold(i)=ry0(i)
523 dzold(i)=rz0(i)
524 ENDDO
525 ENDIF
526C
527 DO i=1,nel
528 x21(i)= (rx2(i)-rx1(i))*dt1
529 y21(i)= (ry2(i)-ry1(i))*dt1
530 z21(i)= (rz2(i)-rz1(i))*dt1
531 rx(i)= dxold(i)+x21(i)*exx(i)+y21(i)*eyx(i)+z21(i)*ezx(i)
532 ry(i)= dyold(i)+x21(i)*exy(i)+y21(i)*eyy(i)+z21(i)*ezy(i)
533 rz(i)= dzold(i)+x21(i)*exz(i)+y21(i)*eyz(i)+z21(i)*ezz(i)
534 ENDDO
535C-------------------------------
536 DO i=1,nel
537 ifunc(i) = igeo(110,mgn(i))
538 ifv(i) = igeo(111,mgn(i))
539 ifunc2(i)= igeo(112,mgn(i))
540 ifunc3(i)= igeo(122,mgn(i))
541 iecrou(i)=nint(geo(22,mgn(i)))
542 ak(i) =geo(53,mgn(i))
543 b(i) =geo(54,mgn(i))
544 d(i) =geo(55,mgn(i))
545 ee(i) =geo(182,mgn(i))
546 gf3(i) =geo(135,mgn(i))
547 rscale(i)= geo(56,mgn(i))
548 lscale(i)= geo(176,mgn(i))
549 dmn(i) =geo(71,mgn(i))
550 dmx(i) =geo(72,mgn(i))
551 ENDDO
552 IF (nuvar > 0) xx_old => uvar(4,1:nel)
553 CALL redef3(python,
554 1 xmom, xk, rx, xmep,
555 2 dxold, rpx, tf, npf,
556 3 xc, off, e6(1,4), rpx2,
557 4 anim, 0, iposxx,
558 5 xl0, dmn, dmx, dv,
559 6 rscale, lscale, ee, gf3,
560 7 ifunc3, yieldx2, x0dp, ak,
561 8 b, d, iecrou, ifunc,
562 9 ifv, ifunc2, epla, xx_old,
563 a nel, nft, stf, sanin,
564 b dt1, iresp, impl_s, idyna,
565 c snpc)
566 DO i=1,nel
567 dlim = zero
568 IF (ifail2(i) == 0) THEN
569 IF (rx(i) > zero) THEN
570 dlim = rx(i) / dmx(i)
571 ELSE
572 dlim = rx(i) / dmn(i)
573 ENDIF
574 ELSEIF (ifail2(i) == 1) THEN
575 IF (xmom(i) > zero) THEN
576 dlim = xmom(i) / dmx(i)
577 ELSE
578 dlim = xmom(i) / dmn(i)
579 ENDIF
580 ELSEIF (ifail2(i) == 2) THEN
581 dlim = max(zero, e6(i,4)) / dmx(i)
582 ENDIF
583 IF (off(i) == one .AND. dmx(i) /= zero .AND. dmn(i) /= zero) THEN
584 IF (ifail(i) == 0) THEN
585! Uniaxial failure
586 crit(i) = max(crit(i),dlim)
587 ELSE
588! Multiaxial failure
589 crit(i) = crit(i) + dlim**2
590 ENDIF
591 ENDIF
592 ENDDO
593C-------------------------------------
594 DO i=1,nel
595 ifunc(i) = igeo(113,mgn(i))
596 ifv(i) = igeo(114,mgn(i))
597 ifunc2(i)= igeo(115,mgn(i))
598 ifunc3(i)= igeo(123,mgn(i))
599 iecrou(i)=nint(geo(26,mgn(i)))
600 ak(i) =geo(57,mgn(i))
601 b(i) =geo(58,mgn(i))
602 d(i) =geo(59,mgn(i))
603 ee(i)= geo(183,mgn(i))
604 gf3(i)= geo(136,mgn(i))
605 rscale(i)= geo(60,mgn(i))
606 lscale(i)= geo(177,mgn(i))
607 dmn(i) =geo(73,mgn(i))
608 dmx(i) =geo(74,mgn(i))
609 ENDDO
610 IF (nuvar > 0) xx_old => uvar(5,1:nel)
611 CALL redef3(python,
612 1 ymom, yk, ry, ymep,
613 2 dyold, rpy, tf, npf,
614 3 yc, off, e6(1,5), rpy2,
615 4 anim, 0, iposyy,
616 5 xl0, dmn, dmx, dv,
617 6 rscale, lscale, ee, gf3,
618 7 ifunc3, yieldy2, y0dp, ak,
619 8 b, d, iecrou, ifunc,
620 9 ifv, ifunc2, epla, xx_old,
621 a nel, nft, stf, sanin,
622 b dt1, iresp, impl_s, idyna,
623 c snpc)
624 DO i=1,nel
625 dlim = zero
626 IF (ifail2(i) == 0) THEN
627 IF (ry(i) > zero) THEN
628 dlim = ry(i) / dmx(i)
629 ELSE
630 dlim = ry(i) / dmn(i)
631 ENDIF
632 ELSEIF (ifail2(i) == 1) THEN
633 IF (ymom(i) > zero) THEN
634 dlim = ymom(i) / dmx(i)
635 ELSE
636 dlim = ymom(i) / dmn(i)
637 ENDIF
638 ELSEIF (ifail2(i) == 2) THEN
639 dlim = max(zero,e6(i,5)) / dmx(i)
640 ENDIF
641 IF (off(i) == one .AND. dmx(i) /= zero .AND. dmn(i) /= zero) THEN
642 IF (ifail(i) == 0) THEN
643! Uniaxial failure
644 crit(i) = max(crit(i),dlim)
645 ELSE
646! Multiaxial failure
647 crit(i) = crit(i) + dlim**2
648 ENDIF
649 ENDIF
650 ENDDO
651C-----------------------------------
652 DO i=1,nel
653 ifunc(i) = igeo(116,mgn(i))
654 ifv(i) = igeo(117,mgn(i))
655 ifunc2(i)= igeo(118,mgn(i))
656 ifunc3(i)= igeo(124,mgn(i))
657 iecrou(i)=nint(geo(30,mgn(i)))
658 ak(i) =geo(61,mgn(i))
659 b(i) =geo(62,mgn(i))
660 d(i) =geo(63,mgn(i))
661 ee(i) =geo(184,mgn(i))
662 gf3(i) =geo(137,mgn(i))
663 rscale(i)= geo(64,mgn(i))
664 lscale(i)= geo(178,mgn(i))
665 dmn(i) =geo(75,mgn(i))
666 dmx(i) =geo(76,mgn(i))
667 ENDDO
668 IF (nuvar > 0) xx_old => uvar(6,1:nel)
669 CALL redef3(python,
670 1 zmom, zk, rz, zmep,
671 2 dzold, rpz, tf, npf,
672 3 zc, off, e6(1,6), rpz2,
673 4 anim, 0, iposzz,
674 5 xl0, dmn, dmx, dv,
675 6 rscale, lscale, ee, gf3,
676 7 ifunc3, yieldz2, z0dp, ak,
677 8 b, d, iecrou, ifunc,
678 9 ifv, ifunc2, epla, xx_old,
679 a nel, nft, stf, sanin,
680 b dt1, iresp, impl_s, idyna,
681 c snpc)
682 DO i=1,nel
683 dlim = zero
684 IF (ifail2(i) == 0) THEN
685 IF (rz(i) > zero) THEN
686 dlim = rz(i) / dmx(i)
687 ELSE
688 dlim = rz(i) / dmn(i)
689 ENDIF
690 ELSEIF (ifail2(i) == 1) THEN
691 IF (zmom(i) > zero) THEN
692 dlim = zmom(i) / dmx(i)
693 ELSE
694 dlim = zmom(i) / dmn(i)
695 ENDIF
696 ELSEIF (ifail2(i) == 2) THEN
697 dlim = max(zero,e6(i,6)) / dmx(i)
698 ENDIF
699 IF (off(i) == one .AND. dmx(i) /= zero .AND. dmn(i) /= zero) THEN
700 IF (ifail(i) == 0) THEN
701! Uniaxial failure
702 crit(i) = max(crit(i),dlim)
703 ELSE
704! Multiaxial failure
705 crit(i) = crit(i) + dlim**2
706 ENDIF
707 ENDIF
708 ENDDO
709C
710C-------------------------------
711C COUPLED FAILURE
712C-------------------------------
713 DO i=1,nel
714 israte = nint(geo(96, mgn(i)))
715C---- smoothing factor alpha = 2PI*fc*dt/(2PI*fc*dt+1) ---
716 asrate = (2*pi*geo(97,mgn(i))*dt1)/(one+2*pi*geo(97,mgn(i))*dt1)
717 IF (israte /= 0) THEN
718 IF (critnew(i) < one) THEN
719 crit(i) = min(crit(i),one+em3)
720 crit(i) = asrate*crit(i) + (one - asrate)*critnew(i)
721 critnew(i) = min(crit(i),one)
722 ELSE
723 critnew(i) = one
724 ENDIF
725 ELSE
726 IF (critnew(i) < one) THEN
727 critnew(i) = min(crit(i),one)
728 ELSE
729 critnew(i) = one
730 ENDIF
731 ENDIF
732 IF (off(i) == one .AND. crit(i) >= one) THEN
733 off(i)=zero
734 nindx = nindx + 1
735 indx(nindx) = i
736 idel7nok = 1
737 ENDIF
738 ENDDO
739C
740 DO j=1,nindx
741 i = indx(j)
742#include "lockon.inc"
743 WRITE(iout, 1000) ngl(i)
744 WRITE(istdo,1100) ngl(i),tt
745#include "lockoff.inc"
746 ENDDO
747C-------------------------------
748C COUPLED PLASTICITY
749C-------------------------------
750 CALL repla3(
751 1 xk, rpx, tf, npf,
752 2 iecrou, ifunc, ifv, epla,
753 3 nel)
754 CALL repla3(
755 1 yk, rpy, tf, npf,
756 2 iecrou, ifunc, ifv, epla,
757 3 nel)
758 CALL repla3(
759 1 zk, rpz, tf, npf,
760 2 iecrou, ifunc, ifv, epla,
761 3 nel)
762C
763 DO i=1,nel
764 xk(i)=geo(3,mgn(i))
765 yk(i)=geo(10,mgn(i))
766 zk(i)=geo(15,mgn(i))
767 e(i) = e6(i,1)+e6(i,2)+e6(i,3)+e6(i,4)+e6(i,5)+e6(i,6)
768 ENDDO
769C
770 CALL repla3(
771 1 xk, dpx, tf, npf,
772 2 iecrou, ifunc, ifv, epla,
773 3 nel)
774 CALL repla3(
775 1 yk, dpy, tf, npf,
776 2 iecrou, ifunc, ifv, epla,
777 3 nel)
778 CALL repla3(
779 1 zk, dpz, tf, npf,
780 2 iecrou, ifunc, ifv, epla,
781 3 nel)
782C---
783 1000 FORMAT(1x,'-- RUPTURE OF SPRING ELEMENT NUMBER ',i10)
784 1100 FORMAT(1x,'-- RUPTURE OF SPRING ELEMENT :',i10,' AT TIME :',g11.4)
785C---
786 RETURN
787 END
min
#define min(a, b)
Definition macros.h:20
max
#define max(a, b)
Definition macros.h:21
r2def3
subroutine r2def3(python, skew, geo, fx, fy, fz, e, dx, dy, dz, npf, tf, off, dpx, dpy, dpz, dpx2, dpy2, dpz2, fxep, fyep, fzep, x0, y0, z0, xmom, ymom, zmom, rx, ry, rz, rpx, rpy, rpz, xmep, ymep, zmep, rpx2, rpy2, rpz2, anim, iposx, iposy, iposz, iposxx, iposyy, iposzz, v, igeo, e6, critnew, nel, x0_err, x1dp, x2dp, yieldx, yieldy, yieldz, yieldx2, yieldy2, yieldz2, ngl, xkr, mgn, exx, eyx, ezx, exy, eyy, ezy, exz, eyz, ezz, xcr, rx1, ry1, rz1, rx2, ry2, rz2, xin, ak, xm, xkm, xcm, nc1, nc2, nuvar, uvar, dx0, dy0, dz0, rx0, ry0, rz0, iequil, skew_id, nft, stf, sanin, iresp, snpc)
Definition r2def3.F:61
repla3
subroutine repla3(xk, dpx, tf, npf, iecrou, ifunc, ifv, epla, nel)
Definition repla3.F:39