OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
suser43.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!|| suser43 ../engine/source/elements/solid/sconnect/suser43.F
25!||--- called by ------------------------------------------------------
26!|| suforc3 ../engine/source/user_interface/suforc3.F
27!||--- calls -----------------------------------------------------
28!|| fail_connect ../engine/source/materials/fail/connect/fail_connect.F
29!|| fail_snconnect ../engine/source/materials/fail/snconnect/fail_snconnect.f
30!|| sbilan43 ../engine/source/elements/solid/sconnect/sbilan43.F
31!|| sconnect_off ../engine/source/elements/solid/sconnect/sconnect_off.F
32!|| scoor43 ../engine/source/elements/solid/sconnect/scoor43.F
33!|| sdef43 ../engine/source/elements/solid/sconnect/sdef43.F
34!|| sfint43 ../engine/source/elements/solid/sconnect/sfint43.F
35!|| sigeps116 ../engine/source/materials/mat/mat116/sigeps116.F
36!|| sigeps117 ../engine/source/materials/mat/mat117/sigeps117.F
37!|| sigeps120_connect_main ../engine/source/materials/mat/mat120/sigeps120_connect_main.F
38!|| sigeps169_connect ../engine/source/materials/mat/mat169/sigeps169_connect.F90
39!|| sigeps59 ../engine/source/materials/mat/mat059/sigeps59.f
40!|| sigeps83 ../engine/source/materials/mat/mat083/sigeps83.F
41!|| smom43 ../engine/source/elements/solid/sconnect/smom43.F
42!|| srrota3 ../engine/source/elements/solid/solide/srrota3.F
43!|| startime ../engine/source/system/timer_mod.F90
44!|| stoptime ../engine/source/system/timer_mod.F90
45!||--- uses -----------------------------------------------------
46!|| elbufdef_mod ../common_source/modules/mat_elem/elbufdef_mod.F90
47!|| law_userso ../engine/source/user_interface/law_userso.F
48!|| mat_elem_mod ../common_source/modules/mat_elem/mat_elem_mod.F90
49!|| sigeps169_connect_mod ../engine/source/materials/mat/mat169/sigeps169_connect.F90
50!|| table_mod ../engine/share/modules/table_mod.F
51!|| timer_mod ../engine/source/system/timer_mod.F90
52!||====================================================================
53 SUBROUTINE suser43(TIMERS,
54 1 ELBUF_STR,IOUT ,IPROP ,IMAT ,NGL ,TIME ,TIMESTEP,FR_WAVE,
55 2 XX1 ,XX2 ,XX3 ,XX4 ,XX5 ,XX6 ,XX7 ,XX8 ,
56 3 YY1 ,YY2 ,YY3 ,YY4 ,YY5 ,YY6 ,YY7 ,YY8 ,
57 4 ZZ1 ,ZZ2 ,ZZ3 ,ZZ4 ,ZZ5 ,ZZ6 ,ZZ7 ,ZZ8 ,
58 5 UX1 ,UX2 ,UX3 ,UX4 ,UX5 ,UX6 ,UX7 ,UX8 ,
59 6 UY1 ,UY2 ,UY3 ,UY4 ,UY5 ,UY6 ,UY7 ,UY8 ,
60 7 UZ1 ,UZ2 ,UZ3 ,UZ4 ,UZ5 ,UZ6 ,UZ7 ,UZ8 ,
61 8 VX1 ,VX2 ,VX3 ,VX4 ,VX5 ,VX6 ,VX7 ,VX8 ,
62 9 VY1 ,VY2 ,VY3 ,VY4 ,VY5 ,VY6 ,VY7 ,VY8 ,
63 A VZ1 ,VZ2 ,VZ3 ,VZ4 ,VZ5 ,VZ6 ,VZ7 ,VZ8 ,
64 B FX1 ,FX2 ,FX3 ,FX4 ,FX5 ,FX6 ,FX7 ,FX8 ,
65 F FY1 ,FY2 ,FY3 ,FY4 ,FY5 ,FY6 ,FY7 ,FY8 ,
66 G FZ1 ,FZ2 ,FZ3 ,FZ4 ,FZ5 ,FZ6 ,FZ7 ,FZ8 ,
67 H STIFM ,STIFR ,VISCM ,VISCR ,PARTSAV,IPARTS ,BUFMAT ,IOUTPRT,
68 L IFAILURE ,NPF ,TF ,IPM ,IGEO ,NPG ,NEL ,JSMS ,
69 M DMELS ,PM ,GEO ,ITASK ,JTHE ,TABLE ,MAT_PARAM,
70 N IDTMINS ,DTFACS,DTMINS)
71C-----------------------------------------------
72C M o d u l e s
73C-----------------------------------------------
74 USE timer_mod
75 USE table_mod
76 USE mat_elem_mod
77 USE law_userso
78 USE sigeps169_connect_mod
79 USE elbufdef_mod
80C-------------------------------------------------------------------------
81C This subroutine compute user 8 nodes solids forces and moments.
82C----------+---------+---+---+--------------------------------------------
83C VAR | SIZE |TYP| RW| DEFINITION
84C----------+---------+---+---+--------------------------------------------
85C NEL | 1 | I | R | NUMBER OF ELEMENTS IN CURRENT GROUP
86C NUVAR | 1 | I | R | NUMBER OF USER ELEMENT VARIABLES
87C IOUT | 1 | I | R | OUTPUT FILE UNIT (L01 file)
88C IPROP | 1 | I | R | PROPERTY NUMBER
89C IMAT | 1 | I | R | MATERIAL NUMBER
90C NGL | NEL | I | R | SOLID ELEMENT ID
91C----------+---------+---+---+--------------------------------------------
92C TIME | 1 | F | R | CURRENT TIME
93C TIMESTEP | 1 | F | R | CURRENT TIME STEP
94C----------+---------+---+---+--------------------------------------------
95C EINT | NEL | F | R | TOTAL INTERNAL ENERGY at t=TIME-TIMESTEP
96C | | | | Internal energy is automatically recomputed
97C | | | | at each cycle.
98C VOL | NEL | F | R | INITIAL VOLUME
99C----------+---------+---+---+--------------------------------------------
100C UVAR |NEL*NUVAR| F |R/W| USER ELEMENT VARIABLES
101C |*NPG | | | NUVAR IS DEFINED IN LECG29 (not in LECMAT29)
102C FR_WAVE | NEL | F |R/W| COMMUNICATION ARRAY TO ELEMENTS CONNECTED
103C | | | | TO COMMON NODES
104C----------+---------+---+---+--------------------------------------------
105C OFF | NEL | F |R/W| DELETE FLAG (=1. ON =0. OFF)
106C RHO | NEL | F |R/W| DENSITY
107C SIG | 6*NEL | F |R/W| STRESS TENSOR SX,SY,SZ,SXY,SYZ,SZX
108C | | | | RHO and SIG can be used for post processing
109C | | | | in TH++ or ModAnim
110C | | | | The modification of these variables has only
111C | | | | effect on output. If these value are not
112C | | | | modified RHO and SIG are initial values
113C----------+---------+---+---+--------------------------------------------
114C XX1 | NEL | F | R | X COORDINATE NODE 1 in global frame at time TIME
115C YY1 | NEL | F | R | Y COORDINATE NODE 1 in global frame at time TIME
116C ZZ1 | NEL | F | R | Z COORDINATE NODE 1 in global frame at time TIME
117C XX2..ZZ8 | NEL | F | R | SAME FOR NODE 2 TO 8
118C UX1 | NEL | F | R | X DISPLACEMENT NODE 1,global frame, time TIME
119C UY1 | NEL | F | R | Y DISPLACEMENT NODE 1,global frame, time TIME
120C UZ1 | NEL | F | R | Z DISPLACEMENT NODE 1,global frame, time TIME
121C VX1 | NEL | F | R | X VELOCITY NODE 1,glob f, time TIME-TIMESTEP/2
122C VY1 | NEL | F | R | Y VELOCITY NODE 1,glob f, time TIME-TIMESTEP/2
123C VZ1 | NEL | F | R | Z VELOCITY NODE 1,glob f, time TIME-TIMESTEP/2
124C | | | | displacement increment from t=TIME-TIMESTEP
125C | | | | to t=TIME is given by DUX1 = VX1(I)*TIMESTEP
126C VRX1 | NEL | F | R | X ROTATIONAL VELOCITY NODE 1 ...
127C VRY1 | NEL | F | R | Y ROTATIONAL VELOCITY NODE 1 ...
128C VRZ1 | NEL | F | R | Z ROTATIONAL VELOCITY NODE 1 ...
129C-------------------------------------------------------------------------
130C FX1 | NEL | F | W | X FORCE NODE 1
131C FY1 | NEL | F | W | Y FORCE NODE 1
132C FZ1 | NEL | F | W | Z FORCE NODE 1
133C ....
134C MX1 | NEL | F | W | X MOMENT NODE 1
135C MY1 | NEL | F | W | Y MOMENT NODE 1
136C MZ1 | NEL | F | W | Z MOMENT NODE 1
137C STIFM | NEL | F | W | TRANSLATIONAL STIFNESS OVERESTIMATION
138C STIFR | NEL | F | W | ROTATIONAL STIFNESS OVERESTIMATION
139C VISCM | NEL | F | W | TRANSLATIONAL VISCOSITY OVERESTIMATION
140C VISCR | NEL | F | W | ROTATIONAL VISCOSITY OVERESTIMATION
141C | | | | STIFM,STIFR,VISCM,VISCR are needed to compute
142C | | | | element or nodal time step.
143C-------------------------------------------------------------------------
144C I m p l i c i t T y p e s
145C-----------------------------------------------
146#include "implicit_f.inc"
147#include "param_c.inc"
148#include "com01_c.inc"
149#include "com04_c.inc"
150#include "scr19_c.inc"
151#include "task_c.inc"
152#include "userlib.inc"
153#include "timeri_c.inc"
154C----------------------------------------------------------
155C D u m m y A r g u m e n t s
156C----------------------------------------------------------
157 TYPE(timer_), INTENT(INOUT) :: TIMERS
158 INTEGER NEL,IOUT,IPROP,IMAT,IOUTPRT,IFAILURE,NPG, JSMS,JTHE
159 INTEGER NGL(NEL),IPARTS(*),NPF(*),IPM(NPROPMI,*),
160 . IGEO(NPROPGI,*),ITASK
161 TARGET :: IPM
162 INTEGER,INTENT(IN) :: IDTMINS
163 my_real,INTENT(IN) :: DTFACS
164 my_real,INTENT(IN) :: DTMINS
165 my_real
166 . TIME,TIMESTEP,PARTSAV(NPSAV,*),DMELS(*),PM(NPROPM,*),
167 . STIFM(*) ,STIFR(*) , VISCM(*) ,VISCR(*) ,FR_WAVE(*),TF(*),
168 . XX1(*),XX2(*),XX3(*),XX4(*),XX5(*),XX6(*),XX7(*),XX8(*),
169 . YY1(*),YY2(*),YY3(*),YY4(*),YY5(*),YY6(*),YY7(*),YY8(*),
170 . ZZ1(*),ZZ2(*),ZZ3(*),ZZ4(*),ZZ5(*),ZZ6(*),ZZ7(*),ZZ8(*),
171 . UX1(*),UX2(*),UX3(*),UX4(*),UX5(*),UX6(*),UX7(*),UX8(*),
172 . UY1(*),UY2(*),UY3(*),UY4(*),UY5(*),UY6(*),UY7(*),UY8(*),
173 . UZ1(*),UZ2(*),UZ3(*),UZ4(*),UZ5(*),UZ6(*),UZ7(*),UZ8(*),
174 . vx1(*),vx2(*),vx3(*),vx4(*),vx5(*),vx6(*),vx7(*),vx8(*),
175 . vy1(*),vy2(*),vy3(*),vy4(*),vy5(*),vy6(*),vy7(*),vy8(*),
176 . vz1(*),vz2(*),vz3(*),vz4(*),vz5(*),vz6(*),vz7(*),vz8(*),
177 . fx1(*),fx2(*),fx3(*),fx4(*),fx5(*),fx6(*),fx7(*),fx8(*),
178 . fy1(*),fy2(*),fy3(*),fy4(*),fy5(*),fy6(*),fy7(*),fy8(*),
179 . fz1(*),fz2(*),fz3(*),fz4(*),fz5(*),fz6(*),fz7(*),fz8(*),
180 . geo(npropg,*)
181 TYPE (ELBUF_STRUCT_) ,TARGET :: ELBUF_STR
182 my_real ,DIMENSION(*) ,TARGET :: bufmat
183 TYPE (MATPARAM_STRUCT_) ,DIMENSION(NUMMAT) ,INTENT(IN) :: MAT_PARAM
184C-----------------------------------------------
185C L O C A L V A R I A B L E S
186C-----------------------------------------------
187 INTEGER I,I1,I2,II,JJ(6),J,J1,J2,IC,IR,IPG,JPT,IUV,IEL,ISRATE,
188 . NPAR,NPARF,NVARF,NFUNC,NFUNCR,NFAILS,ISMSTR,ILAW_USER,IPTR,IPTS,IPTT,
189 . IADBUF,IFAIL,NUVAR,MTN,NDAMF,ISOLID,ISOLIDF,NUMTABL,NVARTMP,LF_DAMMX
190 INTEGER IFUNC(MAXFUNC),IFUNCR(MAXFUNC)
191 my_real :: A,B,C,EPSP,ASRATE,ALPHA,TTHICK,OFF_EL
192 my_real
193 . HH(NPG,NPG),AREAP(MVSIZ,NPG),AREAT(MVSIZ),
194 . UXLOC(MVSIZ,8),UYLOC(MVSIZ,8),UZLOC(MVSIZ,8),
195 . VXLOC(MVSIZ,8),VYLOC(MVSIZ,8),VZLOC(MVSIZ,8),
196 . VXZ(MVSIZ,NPG),VYZ(MVSIZ,NPG),VZZ(MVSIZ,NPG),
197 . VGXA(MVSIZ),VGYA(MVSIZ),VGZA(MVSIZ), VGA2(MVSIZ),
198 . r1x(mvsiz),r2x(mvsiz),r3x(mvsiz),r4x(mvsiz),
199 . r5x(mvsiz),r6x(mvsiz),r7x(mvsiz),r8x(mvsiz),
200 . r1y(mvsiz),r2y(mvsiz),r3y(mvsiz),r4y(mvsiz),
201 . r5y(mvsiz),r6y(mvsiz),r7y(mvsiz),r8y(mvsiz),
202 . r1z(mvsiz),r2z(mvsiz),r3z(mvsiz),r4z(mvsiz),
203 . r5z(mvsiz),r6z(mvsiz),r7z(mvsiz),r8z(mvsiz),
204 . rxx(mvsiz),ryy(mvsiz),rzz(mvsiz),ep1(mvsiz),ep2(mvsiz),
205 . ep3(mvsiz),sig0zz(mvsiz),sig0yz(mvsiz),sig0zx(mvsiz),
206 . dein(mvsiz),deit(mvsiz),sym(mvsiz),ssp(mvsiz),rho0(mvsiz),
207 . e1x(mvsiz),e2x(mvsiz),e3x(mvsiz),e1y(mvsiz),e2y(mvsiz),
208 . e3y(mvsiz),e1z(mvsiz),e2z(mvsiz),e3z(mvsiz),viscmax(mvsiz),
209 . bid(mvsiz),dpla(mvsiz),sigy(mvsiz),epszz(mvsiz),epsyz(mvsiz),
210 . epszx(mvsiz),depszz(mvsiz),depsyz(mvsiz),depszx(mvsiz),
211 . signzz(mvsiz),signyz(mvsiz),signzx(mvsiz),soft(nel),deltae(nel),
212 . user_pla(mvsiz),user_off(mvsiz),user_eint(mvsiz),user_rho(mvsiz),user_vol(mvsiz)
213 TYPE(g_bufel_) ,POINTER :: GBUF
214 TYPE(L_BUFEL_) ,POINTER :: LBUF
215 TYPE(BUF_MAT_) ,POINTER :: MATBUF
216 TYPE(FAIL_LOC_) ,POINTER :: FLOC
217 TARGET :: AREAP
218 TYPE(BUF_FAIL_), POINTER :: FBUF
219 TYPE(ULAWINTBUF) :: USERBUF
220 TYPE (TTABLE) , DIMENSION(NTABLE) :: TABLE
221 INTEGER, DIMENSION(:) ,POINTER :: ITABLE,VARTMP
222 my_real, DIMENSION(:),POINTER :: EPLASN,EPLAST,EPSD,UPARAM,UVAR,AREA,AREAN,OFFI
223
224C=======================================================================
225 GBUF => elbuf_str%GBUF
226
227 i7kglo = 1
228 isolid = 4 ! All Gauss points must fail before deleting the element
229 iadbuf = ipm(7,imat)
230 nuvar = ipm(8,imat)
231 npar = ipm(9,imat)
232 nfunc = ipm(10,imat)
233 numtabl= ipm(226,imat)
234
235 mtn = ipm(2,imat)
236 DO i=1,nfunc
237 ifunc(i)=ipm(10+i,imat)
238 ENDDO
239
240 itable => ipm(226+1:226+numtabl,imat)
241
242 israte = ipm(3,imat)
243 asrate = pm(9,imat) ! 2*PI*FCUT
244 alpha = min(one,asrate*timestep)
245
246 ismstr = igeo(5,iprop)
247 tthick = geo(41,iprop)
248 isolidf = 4
249c
250 uparam => bufmat(iadbuf:iadbuf+npar-1)
251!
252 DO i=1,6
253 jj(i) = nel*(i-1)
254 ENDDO
255!
256C
257 CALL scoor43(
258 . gbuf%OFF ,nel ,ioutprt ,gbuf%GAMA ,
259 . xx1 ,xx2 ,xx3 ,xx4 ,xx5 ,xx6 ,xx7 ,xx8 ,
260 . yy1 ,yy2 ,yy3 ,yy4 ,yy5 ,yy6 ,yy7 ,yy8 ,
261 . zz1 ,zz2 ,zz3 ,zz4 ,zz5 ,zz6 ,zz7 ,zz8 ,
262 . vx1 ,vx2 ,vx3 ,vx4 ,vx5 ,vx6 ,vx7 ,vx8 ,
263 . vy1 ,vy2 ,vy3 ,vy4 ,vy5 ,vy6 ,vy7 ,vy8 ,
264 . vz1 ,vz2 ,vz3 ,vz4 ,vz5 ,vz6 ,vz7 ,vz8 ,
265 . r1x ,r2x ,r3x ,r4x ,r5x ,r6x ,r7x ,r8x ,
266 . r1y ,r2y ,r3y ,r4y ,r5y ,r6y ,r7y ,r8y ,
267 . r1z ,r2z ,r3z ,r4z ,r5z ,r6z ,r7z ,r8z ,
268 . rxx ,ryy ,rzz ,vxloc,vyloc,vzloc,
269 . e1x ,e1y ,e1z ,e2x ,e2y ,e2z ,e3x ,e3y ,e3z ,
270 . areap,time ,timestep,ngl,
271 . vgxa ,vgya ,vgza ,vga2, sym , ipm, imat)
272c
273 CALL sdef43(nel ,npg ,hh ,
274 . vxz ,vyz ,vzz ,vxloc,vyloc,vzloc)
275c-----------------------------------------------------------------------
276 DO i=1,nel
277 areat(i) = zero
278 viscm(i) = zero
279 viscr(i) = zero
280 stifm(i) = zero
281 stifr(i) = zero
282 gbuf%SIG(jj(3)+i) = zero
283 gbuf%SIG(jj(5)+i) = zero
284 gbuf%SIG(jj(6)+i) = zero
285 ep1(i) = zero
286 ep2(i) = zero
287 ep3(i) = zero
288 fx1(i) = zero
289 fx2(i) = zero
290 fx3(i) = zero
291 fx4(i) = zero
292 fy1(i) = zero
293 fy2(i) = zero
294 fy3(i) = zero
295 fy4(i) = zero
296 fz1(i) = zero
297 fz2(i) = zero
298 fz3(i) = zero
299 fz4(i) = zero
300 fx5(i) = zero
301 fx6(i) = zero
302 fx7(i) = zero
303 fx8(i) = zero
304 fy5(i) = zero
305 fy6(i) = zero
306 fy7(i) = zero
307 fy8(i) = zero
308 fz5(i) = zero
309 fz6(i) = zero
310 fz7(i) = zero
311 fz8(i) = zero
312 ENDDO
313 IF (gbuf%G_PLA > 0) gbuf%PLA(:nel) = zero
314 IF (ismstr == 1 .AND. time == zero) THEN
315 DO ipg = 1,npg
316 elbuf_str%BUFLY(1)%LBUF(ipg,1,1)%VOL(1:nel)=areap(1:nel,ipg)
317 ENDDO
318 ENDIF
319C-------------------
320C MEAN STRAIN RATE
321C-------------------
322 IF (mtn == 116 .or. mtn == 83 .or. mtn == 120) THEN
323 gbuf%EPSD(1:nel) = zero
324 ELSE
325 DO ipg=1,npg
326 DO i=1,nel
327 ep1(i) = ep1(i) + vxz(i,ipg)
328 ep2(i) = ep2(i) + vyz(i,ipg)
329 ep3(i) = ep3(i) + vzz(i,ipg)
330 ENDDO
331 ENDDO
332 DO i=1,nel
333 ep1(i) = ep1(i)*fourth
334 ep2(i) = ep2(i)*fourth
335 ep3(i) = ep3(i)*fourth
336 epsp = sqrt(ep1(i)**2 + ep2(i)**2 + ep3(i)**2)
337 IF (israte > 0) THEN
338 epsp = alpha*epsp + (one - alpha)*gbuf%EPSD(i)
339 ENDIF
340 gbuf%EPSD(i) = epsp
341 ENDDO
342 END IF
343C--------------------------------------------------
344 deltae(1:nel) = zero
345c--------------------------------------------------
346 IF ((itask==0).AND.(imon_mat==1)) CALL startime(timers,35)
347c--------------------------------------------------
348c BOUCLE SUR LES POINTS DE GAUSS
349c--------------------------------------------------
350 DO ipg = 1,npg
351 lbuf => elbuf_str%BUFLY(1)%LBUF(ipg,1,1)
352 uvar => elbuf_str%BUFLY(1)%MAT(ipg,1,1)%VAR
353
354 nvartmp = elbuf_str%BUFLY(1)%NVARTMP
355 vartmp => elbuf_str%BUFLY(1)%MAT(ipg,1,1)%VARTMP
356
357 epsd(1:nel) => lbuf%EPSD(1:nel)
358c
359 arean(1:nel) => areap(1:nel,ipg)
360
361 IF (ismstr == 1) THEN ! read in property
362 area(1:nel) => elbuf_str%BUFLY(1)%LBUF(ipg,1,1)%VOL(1:nel)
363 ELSE
364 area(1:nel) => areap(1:nel,ipg)
365 ENDIF
366C
367 DO iel=1,nel
368 off_el = lbuf%OFF(iel)
369 depszz(iel) = vzz(iel,ipg)*timestep * off_el
370 depsyz(iel) = vyz(iel,ipg)*timestep * off_el
371 depszx(iel) = vxz(iel,ipg)*timestep * off_el
372 sig0zz(iel) = lbuf%SIG(jj(3)+iel)
373 sig0yz(iel) = lbuf%SIG(jj(5)+iel)
374 sig0zx(iel) = lbuf%SIG(jj(6)+iel)
375 signzz(iel) = zero
376 signyz(iel) = zero
377 signzx(iel) = zero
378 dein(iel) = zero
379 deit(iel) = zero
380 ENDDO
381 IF (elbuf_str%BUFLY(1)%L_EPE > 0) THEN
382 DO iel=1,nel
383 epszz(iel) = lbuf%EPE(jj(1)+iel) + depszz(iel)
384 epsyz(iel) = lbuf%EPE(jj(2)+iel) + depsyz(iel)
385 epszx(iel) = lbuf%EPE(jj(3)+iel) + depszx(iel)
386 ENDDO
387 END IF
388c--------------------------------------------------
389c material laws
390c--------------------------------------------------
391 IF ((itask==0).AND.(imon_mat==1)) CALL startime(timers,35)
392c--------------------------------------------------
393 SELECT CASE(mtn)
394c---
395 CASE (59)
396c
397 eplasn => lbuf%PLA(1:nel)
398 eplast => lbuf%PLA(nel+1:nel*2)
399c
400 CALL sigeps59(
401 1 nel ,time ,timestep,uparam ,gbuf%OFF ,
402 2 gbuf%EPSD,stifm ,npar ,
403 3 ifunc ,maxfunc ,npf ,tf ,area ,
404 4 epszz ,epsyz ,epszx ,depszz ,depsyz ,depszx ,
405 5 sig0zz ,sig0yz ,sig0zx ,signzz ,signyz ,signzx ,
406 6 eplasn ,eplast ,jsms ,dmels )
407C
408c-------
409 CASE (83)
410c
411 CALL sigeps83(
412 1 nel ,time ,timestep ,uparam ,gbuf%OFF ,
413 2 lbuf%EPSD,stifm ,ifunc ,maxfunc ,npf ,tf ,
414 3 area ,depszz ,depsyz ,depszx ,npar ,epszz ,
415 4 sig0zz ,sig0yz ,sig0zx ,signzz ,signyz ,signzx ,
416 5 lbuf%PLA ,jsms ,dmels ,sym ,uvar ,nuvar ,
417 6 lbuf%DMG ,alpha )
418c mean Gauss point values for element output
419 DO iel=1,nel
420 gbuf%PLA(iel) = gbuf%PLA(iel) + fourth*lbuf%PLA(iel)
421 gbuf%EPSD(iel) = gbuf%EPSD(iel) + fourth*lbuf%EPSD(iel)
422 ENDDO
423c-------
424 CASE (116)
425c
426 eplasn => lbuf%PLA(1:nel)
427 eplast => lbuf%PLA(nel+1:nel*2)
428c
429 CALL sigeps116(
430 1 nel ,npar ,nuvar ,jsms ,time ,timestep ,
431 2 uparam ,uvar ,area ,epsd ,gbuf%OFF ,lbuf%OFF ,
432 3 epszz ,epsyz ,epszx ,depszz ,depsyz ,depszx ,
433 4 signzz ,signyz ,signzx ,stifm ,dmels ,lbuf%DMG ,
434 5 eplasn ,eplast ,ipg ,isolidf ,ngl )
435
436 gbuf%EPSD(1:nel) = gbuf%EPSD(1:nel) + fourth*lbuf%EPSD(1:nel)
437c
438 CASE (117)
439c
440c
441 CALL sigeps117(
442 1 nel ,npar ,nuvar ,jsms ,time ,timestep ,
443 2 uparam ,uvar ,area ,gbuf%OFF ,lbuf%OFF ,
444 3 epszz ,epsyz ,epszx ,depszz ,depsyz ,depszx ,
445 4 signzz ,signyz ,signzx ,stifm ,dmels ,lbuf%DMG ,
446 5 ipg ,isolidf ,ngl ,nfunc ,ifunc ,npf ,tf)
447
448 CASE (120) ! TAPO model
450 1 nel ,ngl ,time ,timestep ,uparam ,gbuf%OFF ,
451 2 lbuf%EPSD,stifm ,jthe ,
452 3 area ,depszz ,depsyz ,depszx ,epszz ,npar ,
453 4 sig0zz ,sig0yz ,sig0zx ,signzz ,signyz ,signzx ,
454 5 lbuf%PLA ,jsms ,dmels ,uvar ,nuvar ,
455 6 numtabl ,itable ,table ,nvartmp ,vartmp ,lbuf%TEMP,
456 7 lbuf%DMG)
457c mean Gauss point values for element output
458 DO iel=1,nel
459 gbuf%PLA(iel) = gbuf%PLA(iel) + fourth*lbuf%PLA(iel)
460 gbuf%EPSD(iel) = gbuf%EPSD(iel) + fourth*lbuf%EPSD(iel)
461 ENDDO
462C-----------------------------------------------
463 CASE (169) ! MAT_ARUP_ADHESIVE
464
465 CALL sigeps169_connect(
466 1 nel ,time ,mat_param(imat)%IPARAM, mat_param(imat)%UPARAM ,
467 2 mat_param(imat)%NIPARAM ,mat_param(imat)%NUPARAM ,stifm ,
468 3 area ,gbuf%OFF ,nuvar ,uvar ,ipg ,
469 4 depszz ,depsyz ,depszx ,epszz ,epsyz ,epszx ,
470 5 sig0zz ,sig0yz ,sig0zx ,signzz ,signyz ,signzx ,
471 6 lbuf%PLA ,iout ,jsms ,lbuf%DMG ,ngl ,dmels ,
472 7 idtmins ,dtfacs ,dtmins ,gbuf%THK)
473
474C-----------------------------------------------
475 CASE (99)
476c
477 IF (userl_avail>0) THEN
478 iptr = ipg
479 ipts = 1
480 iptt = 1
481 DO iel=1,nel
482 bid(iel) = zero
483 rho0(iel) = pm(1,imat)
484 user_pla(iel) = lbuf%PLA(iel)
485 user_off(iel) = gbuf%OFF(iel)
486 user_eint(iel) = gbuf%EINT(iel)
487 user_rho(iel) = gbuf%RHO(iel)
488 user_vol(iel) = gbuf%VOL(iel)
489 ENDDO
490 ilaw_user = ipm(217, imat)
491 nuvar = elbuf_str%BUFLY(1)%NVAR_MAT
492c
493C Fill Structure in dynamical library
494 CALL eng_userlib_get_law_var(
495 * ncycle, imat,iptr, ipts,iptt,
496 * e1x ,e1y ,e1z ,e2x ,e2y ,e2z ,e3x ,e3y ,e3z ,
497 . bid ,bid, sig0zz, bid, sig0yz,
498 * sig0zx, bid, bid, ep1, bid, ep2, ep3,
499 * bid, bid, bid, bid, bid, bid, bid,
500 * bid, depszz, bid, depsyz, depszx, rho0, bid,
501 * bid, signzz, bid, signyz, signzx, bid, bid,
502 * bid, bid, bid, bid )
503c
504c Call user law in dynamical user library
505 CALL eng_userlib_sigeps99(
506 * nel ,npar ,nuvar ,ilaw_user,nfunc,
507 * ifunc ,npf ,tf ,time ,timestep,
508 * bufmat(iadbuf) ,user_rho,user_vol,user_eint,ngl,
509 * ssp ,viscmax ,uvar ,user_off ,sigy ,
510 * user_pla )
511c
512C Get back results from user library structure
513 CALL eng_userlib_set_law_var(
514 * bid ,bid ,signzz ,bid ,signyz ,signzx ,
515 * bid ,bid ,bid ,bid ,bid ,bid ,
516 * dpla )
517c
518 DO iel=1,nel
519 lbuf%PLA(iel) = user_pla(iel)
520 gbuf%OFF(iel) = user_off(iel)
521 gbuf%EINT(iel) = user_eint(iel)
522 gbuf%RHO(iel) = user_rho(iel)
523 gbuf%VOL(iel) = user_vol(iel)
524 stifm(iel) = ssp(iel)*ssp(iel)*area(iel)*gbuf%RHO(iel)
525 ENDDO
526 ENDIF
527c-------
528 END SELECT ! MTN
529c--------------------------------------------------
530 DO iel=1,nel
531 dein(iel) = lbuf%OFF(iel)*half*
532 . depszz(iel)*(sig0zz(iel) + signzz(iel))
533 deit(iel) = lbuf%OFF(iel)*half*(
534 . depsyz(iel)*(sig0yz(iel) + signyz(iel))+
535 . depszx(iel)*(sig0zx(iel) + signzx(iel)) )
536 ENDDO
537c--------------------------------------------------
538 IF ((itask==0).AND.(imon_mat==1)) CALL stoptime(timers,35)
539c--------------------------------------------------
540c Failure Models
541c--------------------------------------------------
542 IF ((itask==0).AND.(imon_mat==1))CALL startime(timers,121)
543c--------------------------------------------------
544 soft(1:nel) = one
545c
546 IF (ifailure == 1) THEN
547 nfails = mat_param(imat)%NFAIL
548
549 DO ir = 1,nfails
550 ifail = mat_param(imat)%FAIL(ir)%IRUPT
551 nparf = mat_param(imat)%FAIL(ir)%NUPARAM
552 nvarf = mat_param(imat)%FAIL(ir)%NUVAR
553 nfuncr = mat_param(imat)%FAIL(ir)%NFUNC
554 DO i=1,nfuncr
555 ifuncr(i) = mat_param(imat)%FAIL(ir)%IFUNC(i)
556 ENDDO
557C
558 floc => elbuf_str%BUFLY(1)%FAIL(ipg,1,1)%FLOC(ir)
559 lf_dammx = floc%LF_DAMMX
560c
561 IF (ifail == 20)THEN
562C
563 CALL fail_connect(
564 1 nel ,nparf ,nvarf ,nfuncr ,ifuncr ,
565 2 npf ,tf ,time ,timestep ,mat_param(imat)%FAIL(ir)%UPARAM,
566 3 floc%VAR ,ngl ,epszz ,epszx ,epsyz ,
567 4 gbuf%EPSD ,gbuf%OFF ,lbuf%OFF,ipg ,isolidf ,
568 5 signzz ,signyz ,signzx ,dein ,deit ,
569 6 floc%DAMMX,lf_dammx ,floc%TDEL,arean ,soft )
570c
571 ELSEIF (ifail == 26)THEN
572C
573 ndamf = floc%LF_DAM
574 CALL fail_snconnect(
575 1 nel ,nparf ,nvarf ,nfuncr ,ifuncr ,
576 2 npf ,tf ,time ,timestep ,mat_param(imat)%FAIL(ir)%UPARAM,
577 3 floc%VAR ,ngl ,ipg ,npg ,ndamf ,
578 4 lbuf%EPSD ,lbuf%PLA ,gbuf%OFF ,lbuf%OFF ,isolidf ,
579 5 signzz ,signyz ,signzx ,sym ,arean ,
580 6 lbuf%DMG ,floc%DAM ,floc%DAMMX,floc%TDEL )
581
582 ENDIF
583c
584 ENDDO ! IR = 1,NFAILS
585 ENDIF ! Failure
586c
587c--------------------------------------------------
588 isolid = min(isolid, isolidf)
589c--------------------------------------------------
590 IF (itask==0 .and. imon_mat==1) CALL stoptime(timers,121)
591c--------------------------------------------------
592c global element constraints in local frame (for output)
593c
594 DO iel=1,nel
595 soft(iel) = soft(iel)*gbuf%OFF(iel)
596 gbuf%SIG(jj(3)+iel) = gbuf%SIG(jj(3)+iel) + signzz(iel)*fourth*soft(iel)
597 gbuf%SIG(jj(5)+iel) = gbuf%SIG(jj(5)+iel) + signyz(iel)*fourth*soft(iel)
598 gbuf%SIG(jj(6)+iel) = gbuf%SIG(jj(6)+iel) + signzx(iel)*fourth*soft(iel)
599 ENDDO
600c
601c internal forces
602c
603 CALL sfint43(ipg ,npg ,nel ,hh ,area ,soft ,
604 . fx1 ,fx2 ,fx3 ,fx4 ,fx5 ,fx6 ,fx7 ,fx8 ,
605 . fy1 ,fy2 ,fy3 ,fy4 ,fy5 ,fy6 ,fy7 ,fy8 ,
606 . fz1 ,fz2 ,fz3 ,fz4 ,fz5 ,fz6 ,fz7 ,fz8 ,
607 . signzz,signyz,signzx)
608c
609c energy
610c
611 DO iel=1,nel
612 areat(iel) = areat(iel) + area(iel)
613 deltae(iel) = deltae(iel) + (dein(iel) + deit(iel))*area(iel)*soft(iel)
614 ENDDO
615c--------------------------------------------------
616c save current strain and stress
617 DO iel=1,nel
618 lbuf%SIG(jj(3)+iel) = signzz(iel)*lbuf%OFF(iel)
619 lbuf%SIG(jj(5)+iel) = signyz(iel)*lbuf%OFF(iel)
620 lbuf%SIG(jj(6)+iel) = signzx(iel)*lbuf%OFF(iel)
621 ENDDO
622 IF (elbuf_str%BUFLY(1)%L_EPE > 0) THEN
623 DO iel=1,nel
624 lbuf%EPE(jj(1)+iel) = epszz(iel)
625 lbuf%EPE(jj(2)+iel) = epsyz(iel)
626 lbuf%EPE(jj(3)+iel) = epszx(iel)
627 ENDDO
628 END IF
629c
630C----
631 ENDDO ! IPG=1,NPG
632c--------------------------------------------------
633c FIN BOUCLE SUR LES POINTS DE GAUSS
634c--------------------------------------------------
635c element suppression
636c--------------------------------------------------
637 CALL sconnect_off(elbuf_str ,gbuf%OFF ,nel ,npg ,ngl ,
638 . isolid ,time )
639c--------------------------------------------------
640c
641 DO iel=1,nel
642 gbuf%EINT(iel) = gbuf%EINT(iel) + deltae(iel) ! / AREAT(IEL)
643 ENDDO
644c
645 IF (ioutprt/=0)
646 . CALL sbilan43(nel ,iparts ,partsav,gbuf%EINT,gbuf%RHO,
647 . areat ,vgxa ,vgya ,vgza ,vga2 ,
648 . gbuf%FILL)
649C Add forces for moment equilibrium
650 CALL smom43(nel ,
651 . fx1 ,fx2 ,fx3 ,fx4 ,fx5 ,fx6 ,fx7 ,fx8 ,
652 . fy1 ,fy2 ,fy3 ,fy4 ,fy5 ,fy6 ,fy7 ,fy8 ,
653 . fz1 ,fz2 ,fz3 ,fz4 ,fz5 ,fz6 ,fz7 ,fz8 ,
654 . r1x ,r2x ,r3x ,r4x ,r5x ,r6x ,r7x ,r8x ,
655 . r1y ,r2y ,r3y ,r4y ,r5y ,r6y ,r7y ,r8y ,
656 . r1z ,r2z ,r3z ,r4z ,r5z ,r6z ,r7z ,r8z ,
657 . rxx ,ryy ,rzz ,tthick )
658C Nodal forces : corotationnal --> global
659 CALL srrota3(
660 1 e1x, e1y, e1z, e2x,
661 2 e2y, e2z, e3x, e3y,
662 3 e3z, fx1, fx2, fx3,
663 4 fx4, fx5, fx6, fx7,
664 5 fx8, fy1, fy2, fy3,
665 6 fy4, fy5, fy6, fy7,
666 7 fy8, fz1, fz2, fz3,
667 8 fz4, fz5, fz6, fz7,
668 9 fz8, nel)
669c-----------
670 RETURN
671 END
672
subroutine fail_connect(nel, nuparam, nuvar, nfunc, ifunc, npf, tf, time, timestep, uparam, uvar, ngl, eps1, eps2, eps3, epsp, offg, offl, ipg, isolid, signzz, signyz, signzx, dein, deit, dfmax, lf_dammx, tdele, area, soft)
subroutine fail_snconnect(nel, nuparam, nuvar, nfunc, ifunc, npf, tf, time, timestep, uparam, uvar, ngl, ipg, npg, ndamf, epsd, pla, offg, offl, isolid, signzz, signyz, signzx, sym, area, dmg, damt, dfmax, tdele)
#define min(a, b)
Definition macros.h:20
subroutine sbilan43(nel, iparts, partsav, eint, rho, areat, vxa, vya, vza, va2, fill)
Definition sbilan43.F:31
subroutine sconnect_off(elbuf_str, offg, nel, npg, ngl, isolid, time)
subroutine scoor43(offg, nel, ioutprt, q, x1, x2, x3, x4, x5, x6, x7, x8, y1, y2, y3, y4, y5, y6, y7, y8, z1, z2, z3, z4, z5, z6, z7, z8, vx1, vx2, vx3, vx4, vx5, vx6, vx7, vx8, vy1, vy2, vy3, vy4, vy5, vy6, vy7, vy8, vz1, vz2, vz3, vz4, vz5, vz6, vz7, vz8, r1x, r2x, r3x, r4x, r5x, r6x, r7x, r8x, r1y, r2y, r3y, r4y, r5y, r6y, r7y, r8y, r1z, r2z, r3z, r4z, r5z, r6z, r7z, r8z, rxx, ryy, rzz, vxloc, vyloc, vzloc, e1x, e1y, e1z, e2x, e2y, e2z, e3x, e3y, e3z, areap, time, dt, solid_id, vgax, vgay, vgaz, vga2, sym, ipm, imat)
Definition scoor43.F:45
subroutine sdef43(nel, npg, hh, dzx, dyz, dzz, vxloc, vyloc, vzloc)
Definition sdef43.F:31
subroutine sfint43(ipg, npg, nel, hh, areapg, soft, fx1, fx2, fx3, fx4, fx5, fx6, fx7, fx8, fy1, fy2, fy3, fy4, fy5, fy6, fy7, fy8, fz1, fz2, fz3, fz4, fz5, fz6, fz7, fz8, signzz, signyz, signzx)
Definition sfint43.F:33
subroutine sigeps116(nel, nuparam, nuvar, jsms, time, timestep, uparam, uvar, area, epsd, off, offl, epszz, epsyz, epszx, depszz, depsyz, depszx, signzz, signyz, signzx, stifm, dmels, dmg, pla_n, pla_t, ipg, nfail, ngl)
Definition sigeps116.F:34
subroutine sigeps117(nel, nuparam, nuvar, jsms, time, timestep, uparam, uvar, area, off, offl, epszz, epsyz, epszx, depszz, depsyz, depszx, signzz, signyz, signzx, stifm, dmels, dmg, ipg, nfail, ngl, nfunc, ifunc, npf, tf)
Definition sigeps117.F:36
subroutine sigeps120_connect_main(nel, ngl, time, timestep, uparam, off, epsd, stifm, jthe, area, depszz, depsyz, depszx, epszz, nuparam, sigozz, sigoyz, sigozx, signzz, signyz, signzx, pla, jsms, dmels, uvar, nuvar, numtabl, itable, table, nvartmp, vartmp, temp, dmg)
subroutine sigeps59(nel, time, timestep, uparam, off, epsd, stifm, nuparam, ifunc, maxfunc, npf, tf, area, epszz, epsyz, epszx, depszz, depsyz, depszx, sigozz, sigoyz, sigozx, signzz, signyz, signzx, eplasn, eplast, jsms, dmels)
Definition sigeps59.F:37
subroutine sigeps83(nel, time, timestep, uparam, off, epsd, stifm, ifunc, maxfunc, npf, tf, area, depszz, depsyz, depszx, nuparam, epszz, sigozz, sigoyz, sigozx, signzz, signyz, signzx, pla, jsms, dmels, sym, uvar, nuvar, dmg, asrate)
Definition sigeps83.F:37
subroutine smom43(nel, f1x, f2x, f3x, f4x, f5x, f6x, f7x, f8x, f1y, f2y, f3y, f4y, f5y, f6y, f7y, f8y, f1z, f2z, f3z, f4z, f5z, f6z, f7z, f8z, r1x, r2x, r3x, r4x, r5x, r6x, r7x, r8x, r1y, r2y, r3y, r4y, r5y, r6y, r7y, r8y, r1z, r2z, r3z, r4z, r5z, r6z, r7z, r8z, rxx, ryy, rzz, tthick)
Definition smom43.F:36
subroutine srrota3(r11, r12, r13, r21, r22, r23, r31, r32, r33, x1, x2, x3, x4, x5, x6, x7, x8, y1, y2, y3, y4, y5, y6, y7, y8, z1, z2, z3, z4, z5, z6, z7, z8)
Definition srrota3.F:33
subroutine startime(event, itask)
Definition timer.F:93
subroutine stoptime(event, itask)
Definition timer.F:135
subroutine suser43(timers, elbuf_str, iout, iprop, imat, ngl, time, timestep, fr_wave, xx1, xx2, xx3, xx4, xx5, xx6, xx7, xx8, yy1, yy2, yy3, yy4, yy5, yy6, yy7, yy8, zz1, zz2, zz3, zz4, zz5, zz6, zz7, zz8, ux1, ux2, ux3, ux4, ux5, ux6, ux7, ux8, uy1, uy2, uy3, uy4, uy5, uy6, uy7, uy8, uz1, uz2, uz3, uz4, uz5, uz6, uz7, uz8, vx1, vx2, vx3, vx4, vx5, vx6, vx7, vx8, vy1, vy2, vy3, vy4, vy5, vy6, vy7, vy8, vz1, vz2, vz3, vz4, vz5, vz6, vz7, vz8, fx1, fx2, fx3, fx4, fx5, fx6, fx7, fx8, fy1, fy2, fy3, fy4, fy5, fy6, fy7, fy8, fz1, fz2, fz3, fz4, fz5, fz6, fz7, fz8, stifm, stifr, viscm, viscr, partsav, iparts, bufmat, ioutprt, ifailure, npf, tf, ipm, igeo, npg, nel, jsms, dmels, pm, geo, itask, jthe, table, mat_param, idtmins, dtfacs, dtmins)
Definition suser43.F:71