OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
suser43.F File Reference
#include "implicit_f.inc"
#include "param_c.inc"
#include "com01_c.inc"
#include "com04_c.inc"
#include "scr19_c.inc"
#include "task_c.inc"
#include "userlib.inc"
#include "timeri_c.inc"

Go to the source code of this file.

Functions/Subroutines

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)

Function/Subroutine Documentation

◆ suser43()

subroutine suser43 ( type(timer_), intent(inout) timers,
type (elbuf_struct_), target elbuf_str,
integer iout,
integer iprop,
integer imat,
integer, dimension(nel) 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,
integer, dimension(*) iparts,
target bufmat,
integer ioutprt,
integer ifailure,
integer, dimension(*) npf,
tf,
integer, dimension(npropmi,*), target ipm,
integer, dimension(npropgi,*) igeo,
integer npg,
integer nel,
integer jsms,
dmels,
pm,
geo,
integer itask,
integer jthe,
type (ttable), dimension(ntable) table,
type (matparam_struct_), dimension(nummat), intent(in) mat_param,
integer, intent(in) idtmins,
intent(in) dtfacs,
intent(in) dtmins )

Definition at line 53 of file suser43.F.

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,J,IR,IPG,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 :: epsp,asrate,alpha,tthick,off_el
192 my_real
193 . hh(npg,npg),areap(mvsiz,npg),areat(mvsiz),
194 .
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(FAIL_LOC_) ,POINTER :: FLOC
216 TARGET :: areap
217 TYPE (TTABLE) , DIMENSION(NTABLE) :: TABLE
218 INTEGER, DIMENSION(:) ,POINTER :: ITABLE,VARTMP
219 my_real, DIMENSION(:),POINTER :: eplasn,eplast,epsd,uparam,uvar,area,arean
220 integer :: JJ(6)
221
222C=======================================================================
223 gbuf => elbuf_str%GBUF
224
225 i7kglo = 1
226 isolid = 4 ! All Gauss points must fail before deleting the element
227 iadbuf = ipm(7,imat)
228 nuvar = ipm(8,imat)
229 npar = ipm(9,imat)
230 nfunc = ipm(10,imat)
231 numtabl= ipm(226,imat)
232
233 mtn = ipm(2,imat)
234 DO i=1,nfunc
235 ifunc(i)=ipm(10+i,imat)
236 ENDDO
237
238 itable => ipm(226+1:226+numtabl,imat)
239
240 israte = ipm(3,imat)
241 asrate = pm(9,imat) ! 2*PI*FCUT
242 alpha = min(one,asrate*timestep)
243
244 ismstr = igeo(5,iprop)
245 tthick = geo(41,iprop)
246 isolidf = 4
247c
248 uparam => bufmat(iadbuf:iadbuf+npar-1)
249!
250 DO i=1,6
251 jj(i) = nel*(i-1)
252 ENDDO
253!
254C
255 CALL scoor43(
256 . gbuf%OFF ,nel ,ioutprt ,gbuf%GAMA ,
257 . xx1 ,xx2 ,xx3 ,xx4 ,xx5 ,xx6 ,xx7 ,xx8 ,
258 . yy1 ,yy2 ,yy3 ,yy4 ,yy5 ,yy6 ,yy7 ,yy8 ,
259 . zz1 ,zz2 ,zz3 ,zz4 ,zz5 ,zz6 ,zz7 ,zz8 ,
260 . vx1 ,vx2 ,vx3 ,vx4 ,vx5 ,vx6 ,vx7 ,vx8 ,
261 . vy1 ,vy2 ,vy3 ,vy4 ,vy5 ,vy6 ,vy7 ,vy8 ,
262 . vz1 ,vz2 ,vz3 ,vz4 ,vz5 ,vz6 ,vz7 ,vz8 ,
263 . r1x ,r2x ,r3x ,r4x ,r5x ,r6x ,r7x ,r8x ,
264 . r1y ,r2y ,r3y ,r4y ,r5y ,r6y ,r7y ,r8y ,
265 . r1z ,r2z ,r3z ,r4z ,r5z ,r6z ,r7z ,r8z ,
266 . rxx ,ryy ,rzz ,vxloc,vyloc,vzloc,
267 . e1x ,e1y ,e1z ,e2x ,e2y ,e2z ,e3x ,e3y ,e3z ,
268 . areap,time ,timestep,ngl,
269 . vgxa ,vgya ,vgza ,vga2, sym , ipm, imat)
270c
271 CALL sdef43(nel ,npg ,hh ,
272 . vxz ,vyz ,vzz ,vxloc,vyloc,vzloc)
273c-----------------------------------------------------------------------
274 DO i=1,nel
275 areat(i) = zero
276 viscm(i) = zero
277 viscr(i) = zero
278 stifm(i) = zero
279 stifr(i) = zero
280 gbuf%SIG(jj(3)+i) = zero
281 gbuf%SIG(jj(5)+i) = zero
282 gbuf%SIG(jj(6)+i) = zero
283 ep1(i) = zero
284 ep2(i) = zero
285 ep3(i) = zero
286 fx1(i) = zero
287 fx2(i) = zero
288 fx3(i) = zero
289 fx4(i) = zero
290 fy1(i) = zero
291 fy2(i) = zero
292 fy3(i) = zero
293 fy4(i) = zero
294 fz1(i) = zero
295 fz2(i) = zero
296 fz3(i) = zero
297 fz4(i) = zero
298 fx5(i) = zero
299 fx6(i) = zero
300 fx7(i) = zero
301 fx8(i) = zero
302 fy5(i) = zero
303 fy6(i) = zero
304 fy7(i) = zero
305 fy8(i) = zero
306 fz5(i) = zero
307 fz6(i) = zero
308 fz7(i) = zero
309 fz8(i) = zero
310 ENDDO
311 IF (gbuf%G_PLA > 0) gbuf%PLA(:nel) = zero
312 IF (ismstr == 1 .AND. time == zero) THEN
313 DO ipg = 1,npg
314 elbuf_str%BUFLY(1)%LBUF(ipg,1,1)%VOL(1:nel)=areap(1:nel,ipg)
315 ENDDO
316 ENDIF
317C-------------------
318C MEAN STRAIN RATE
319C-------------------
320 IF (mtn == 116 .or. mtn == 83 .or. mtn == 120) THEN
321 gbuf%EPSD(1:nel) = zero
322 ELSE
323 DO ipg=1,npg
324 DO i=1,nel
325 ep1(i) = ep1(i) + vxz(i,ipg)
326 ep2(i) = ep2(i) + vyz(i,ipg)
327 ep3(i) = ep3(i) + vzz(i,ipg)
328 ENDDO
329 ENDDO
330 DO i=1,nel
331 ep1(i) = ep1(i)*fourth
332 ep2(i) = ep2(i)*fourth
333 ep3(i) = ep3(i)*fourth
334 epsp = sqrt(ep1(i)**2 + ep2(i)**2 + ep3(i)**2)
335 IF (israte > 0) THEN
336 epsp = alpha*epsp + (one - alpha)*gbuf%EPSD(i)
337 ENDIF
338 gbuf%EPSD(i) = epsp
339 ENDDO
340 END IF
341C--------------------------------------------------
342 deltae(1:nel) = zero
343c--------------------------------------------------
344 IF ((itask==0).AND.(imon_mat==1)) CALL startime(timers,35)
345c--------------------------------------------------
346c loop over gauss points
347c--------------------------------------------------
348 DO ipg = 1,npg
349 lbuf => elbuf_str%BUFLY(1)%LBUF(ipg,1,1)
350 uvar => elbuf_str%BUFLY(1)%MAT(ipg,1,1)%VAR
351
352 nvartmp = elbuf_str%BUFLY(1)%NVARTMP
353 vartmp => elbuf_str%BUFLY(1)%MAT(ipg,1,1)%VARTMP
354
355 epsd(1:nel) => lbuf%EPSD(1:nel)
356c
357 arean(1:nel) => areap(1:nel,ipg)
358
359 IF (ismstr == 1) THEN ! read in property
360 area(1:nel) => elbuf_str%BUFLY(1)%LBUF(ipg,1,1)%VOL(1:nel)
361 ELSE
362 area(1:nel) => areap(1:nel,ipg)
363 ENDIF
364C
365 DO iel=1,nel
366 off_el = lbuf%OFF(iel)
367 depszz(iel) = vzz(iel,ipg)*timestep * off_el
368 depsyz(iel) = vyz(iel,ipg)*timestep * off_el
369 depszx(iel) = vxz(iel,ipg)*timestep * off_el
370 sig0zz(iel) = lbuf%SIG(jj(3)+iel)
371 sig0yz(iel) = lbuf%SIG(jj(5)+iel)
372 sig0zx(iel) = lbuf%SIG(jj(6)+iel)
373 signzz(iel) = zero
374 signyz(iel) = zero
375 signzx(iel) = zero
376 dein(iel) = zero
377 deit(iel) = zero
378 ENDDO
379 IF (elbuf_str%BUFLY(1)%L_EPE > 0) THEN
380 DO iel=1,nel
381 epszz(iel) = lbuf%EPE(jj(1)+iel) + depszz(iel)
382 epsyz(iel) = lbuf%EPE(jj(2)+iel) + depsyz(iel)
383 epszx(iel) = lbuf%EPE(jj(3)+iel) + depszx(iel)
384 ENDDO
385 END IF
386c--------------------------------------------------
387c material laws
388c--------------------------------------------------
389 IF ((itask==0).AND.(imon_mat==1)) CALL startime(timers,35)
390c--------------------------------------------------
391 SELECT CASE(mtn)
392c---
393 CASE (59)
394c
395 eplasn => lbuf%PLA(1:nel)
396 eplast => lbuf%PLA(nel+1:nel*2)
397c
398 CALL sigeps59(
399 1 nel ,time ,timestep,uparam ,gbuf%OFF ,
400 2 gbuf%EPSD,stifm ,npar ,
401 3 ifunc ,maxfunc ,npf ,tf ,area ,
402 4 epszz ,epsyz ,epszx ,depszz ,depsyz ,depszx ,
403 5 sig0zz ,sig0yz ,sig0zx ,signzz ,signyz ,signzx ,
404 6 eplasn ,eplast ,jsms ,dmels )
405C
406c-------
407 CASE (83)
408c
409 CALL sigeps83(
410 1 nel ,time ,timestep ,uparam ,gbuf%OFF ,
411 2 lbuf%EPSD,stifm ,ifunc ,maxfunc ,npf ,tf ,
412 3 area ,depszz ,depsyz ,depszx ,npar ,epszz ,
413 4 sig0zz ,sig0yz ,sig0zx ,signzz ,signyz ,signzx ,
414 5 lbuf%PLA ,jsms ,dmels ,sym ,uvar ,nuvar ,
415 6 lbuf%DMG ,alpha )
416c mean Gauss point values for element output
417 DO iel=1,nel
418 gbuf%PLA(iel) = gbuf%PLA(iel) + fourth*lbuf%PLA(iel)
419 gbuf%EPSD(iel) = gbuf%EPSD(iel) + fourth*lbuf%EPSD(iel)
420 ENDDO
421c-------
422 CASE (116)
423c
424 eplasn => lbuf%PLA(1:nel)
425 eplast => lbuf%PLA(nel+1:nel*2)
426c
427 CALL sigeps116(
428 1 nel ,npar ,nuvar ,jsms ,time ,timestep ,
429 2 uparam ,uvar ,area ,epsd ,gbuf%OFF ,lbuf%OFF ,
430 3 epszz ,epsyz ,epszx ,depszz ,depsyz ,depszx ,
431 4 signzz ,signyz ,signzx ,stifm ,dmels ,lbuf%DMG ,
432 5 eplasn ,eplast ,ipg ,isolidf ,ngl )
433
434 gbuf%EPSD(1:nel) = gbuf%EPSD(1:nel) + fourth*lbuf%EPSD(1:nel)
435c
436 CASE (117)
437c
438c
439 CALL sigeps117(
440 1 nel ,npar ,nuvar ,jsms ,time ,timestep ,
441 2 uparam ,uvar ,area ,gbuf%OFF ,lbuf%OFF ,
442 3 epszz ,epsyz ,epszx ,depszz ,depsyz ,depszx ,
443 4 signzz ,signyz ,signzx ,stifm ,dmels ,lbuf%DMG ,
444 5 ipg ,isolidf ,ngl ,nfunc ,ifunc ,npf ,tf)
445
446 CASE (120) ! TAPO model
447 CALL sigeps120_connect_main(
448 1 nel ,ngl ,time ,timestep ,uparam ,gbuf%OFF ,
449 2 lbuf%EPSD,stifm ,jthe ,
450 3 area ,depszz ,depsyz ,depszx ,epszz ,npar ,
451 4 sig0zz ,sig0yz ,sig0zx ,signzz ,signyz ,signzx ,
452 5 lbuf%PLA ,jsms ,dmels ,uvar ,nuvar ,
453 6 numtabl ,itable ,table ,nvartmp ,vartmp ,lbuf%TEMP,
454 7 lbuf%DMG)
455c mean Gauss point values for element output
456 DO iel=1,nel
457 gbuf%PLA(iel) = gbuf%PLA(iel) + fourth*lbuf%PLA(iel)
458 gbuf%EPSD(iel) = gbuf%EPSD(iel) + fourth*lbuf%EPSD(iel)
459 ENDDO
460C-----------------------------------------------
461 CASE (169) ! MAT_ARUP_ADHESIVE
462
463 CALL sigeps169_connect(
464 1 nel ,time ,mat_param(imat)%IPARAM, mat_param(imat)%UPARAM ,
465 2 mat_param(imat)%NIPARAM ,mat_param(imat)%NUPARAM ,stifm ,
466 3 area ,gbuf%OFF ,nuvar ,uvar ,ipg ,
467 4 depszz ,depsyz ,depszx ,epszz ,epsyz ,epszx ,
468 5 sig0zz ,sig0yz ,sig0zx ,signzz ,signyz ,signzx ,
469 6 lbuf%PLA ,iout ,jsms ,lbuf%DMG ,ngl ,dmels ,
470 7 idtmins ,dtfacs ,dtmins ,gbuf%THK)
471
472C-----------------------------------------------
473 CASE (99)
474c
475 IF (userl_avail>0) THEN
476 iptr = ipg
477 ipts = 1
478 iptt = 1
479 DO iel=1,nel
480 bid(iel) = zero
481 rho0(iel) = pm(1,imat)
482 user_pla(iel) = lbuf%PLA(iel)
483 user_off(iel) = gbuf%OFF(iel)
484 user_eint(iel) = gbuf%EINT(iel)
485 user_rho(iel) = gbuf%RHO(iel)
486 user_vol(iel) = gbuf%VOL(iel)
487 ENDDO
488 ilaw_user = ipm(217, imat)
489 nuvar = elbuf_str%BUFLY(1)%NVAR_MAT
490c
491C Fill Structure in dynamical library
492 CALL eng_userlib_get_law_var(
493 * ncycle, imat,iptr, ipts,iptt,
494 * e1x ,e1y ,e1z ,e2x ,e2y ,e2z ,e3x ,e3y ,e3z ,
495 . bid ,bid, sig0zz, bid, sig0yz,
496 * sig0zx, bid, bid, ep1, bid, ep2, ep3,
497 * bid, bid, bid, bid, bid, bid, bid,
498 * bid, depszz, bid, depsyz, depszx, rho0, bid,
499 * bid, signzz, bid, signyz, signzx, bid, bid,
500 * bid, bid, bid, bid )
501c
502c Call user law in dynamical user library
503 CALL eng_userlib_sigeps99(
504 * nel ,npar ,nuvar ,ilaw_user,nfunc,
505 * ifunc ,npf ,tf ,time ,timestep,
506 * bufmat(iadbuf) ,user_rho,user_vol,user_eint,ngl,
507 * ssp ,viscmax ,uvar ,user_off ,sigy ,
508 * user_pla )
509c
510C Get back results from user library structure
511 CALL eng_userlib_set_law_var(
512 * bid ,bid ,signzz ,bid ,signyz ,signzx ,
513 * bid ,bid ,bid ,bid ,bid ,bid ,
514 * dpla )
515c
516 DO iel=1,nel
517 lbuf%PLA(iel) = user_pla(iel)
518 gbuf%OFF(iel) = user_off(iel)
519 gbuf%EINT(iel) = user_eint(iel)
520 gbuf%RHO(iel) = user_rho(iel)
521 gbuf%VOL(iel) = user_vol(iel)
522 stifm(iel) = ssp(iel)*ssp(iel)*area(iel)*gbuf%RHO(iel)
523 ENDDO
524 ENDIF
525c-------
526 END SELECT ! MTN
527c--------------------------------------------------
528 DO iel=1,nel
529 dein(iel) = lbuf%OFF(iel)*half*
530 . depszz(iel)*(sig0zz(iel) + signzz(iel))
531 deit(iel) = lbuf%OFF(iel)*half*(
532 . depsyz(iel)*(sig0yz(iel) + signyz(iel))+
533 . depszx(iel)*(sig0zx(iel) + signzx(iel)) )
534 ENDDO
535c--------------------------------------------------
536 IF ((itask==0).AND.(imon_mat==1)) CALL stoptime(timers,35)
537c--------------------------------------------------
538c Failure Models
539c--------------------------------------------------
540 IF ((itask==0).AND.(imon_mat==1))CALL startime(timers,121)
541c--------------------------------------------------
542 soft(1:nel) = one
543c
544 IF (ifailure == 1) THEN
545 nfails = mat_param(imat)%NFAIL
546
547 DO ir = 1,nfails
548 ifail = mat_param(imat)%FAIL(ir)%IRUPT
549 nparf = mat_param(imat)%FAIL(ir)%NUPARAM
550 nvarf = mat_param(imat)%FAIL(ir)%NUVAR
551 nfuncr = mat_param(imat)%FAIL(ir)%NFUNC
552 DO i=1,nfuncr
553 ifuncr(i) = mat_param(imat)%FAIL(ir)%IFUNC(i)
554 ENDDO
555C
556 floc => elbuf_str%BUFLY(1)%FAIL(ipg,1,1)%FLOC(ir)
557 lf_dammx = floc%LF_DAMMX
558c
559 IF (ifail == 20)THEN
560C
561 CALL fail_connect(
562 1 nel ,nparf ,nvarf ,nfuncr ,ifuncr ,
563 2 npf ,tf ,time ,timestep ,mat_param(imat)%FAIL(ir)%UPARAM,
564 3 floc%VAR ,ngl ,epszz ,epszx ,epsyz ,
565 4 gbuf%EPSD ,gbuf%OFF ,lbuf%OFF,ipg ,isolidf ,
566 5 signzz ,signyz ,signzx ,dein ,deit ,
567 6 floc%DAMMX,lf_dammx ,floc%TDEL,arean ,soft )
568c
569 ELSEIF (ifail == 26)THEN
570C
571 ndamf = floc%LF_DAM
572 CALL fail_snconnect(
573 1 nel ,nparf ,nvarf ,nfuncr ,ifuncr ,
574 2 npf ,tf ,time ,timestep ,mat_param(imat)%FAIL(ir)%UPARAM,
575 3 floc%VAR ,ngl ,ipg ,npg ,ndamf ,
576 4 lbuf%EPSD ,lbuf%PLA ,gbuf%OFF ,lbuf%OFF ,isolidf ,
577 5 signzz ,signyz ,signzx ,sym ,arean ,
578 6 lbuf%DMG ,floc%DAM ,floc%DAMMX,floc%TDEL )
579
580 ENDIF
581c
582 ENDDO ! IR = 1,NFAILS
583 ENDIF ! Failure
584c
585c--------------------------------------------------
586 isolid = min(isolid, isolidf)
587c--------------------------------------------------
588 IF (itask==0 .and. imon_mat==1) CALL stoptime(timers,121)
589c--------------------------------------------------
590c global element constraints in local frame (for output)
591c
592 DO iel=1,nel
593 soft(iel) = soft(iel)*gbuf%OFF(iel)
594 gbuf%SIG(jj(3)+iel) = gbuf%SIG(jj(3)+iel) + signzz(iel)*fourth*soft(iel)
595 gbuf%SIG(jj(5)+iel) = gbuf%SIG(jj(5)+iel) + signyz(iel)*fourth*soft(iel)
596 gbuf%SIG(jj(6)+iel) = gbuf%SIG(jj(6)+iel) + signzx(iel)*fourth*soft(iel)
597 ENDDO
598c
599c internal forces
600c
601 CALL sfint43(ipg ,npg ,nel ,hh ,area ,soft ,
602 . fx1 ,fx2 ,fx3 ,fx4 ,fx5 ,fx6 ,fx7 ,fx8 ,
603 . fy1 ,fy2 ,fy3 ,fy4 ,fy5 ,fy6 ,fy7 ,fy8 ,
604 . fz1 ,fz2 ,fz3 ,fz4 ,fz5 ,fz6 ,fz7 ,fz8 ,
605 . signzz,signyz,signzx)
606c
607c energy
608c
609 DO iel=1,nel
610 areat(iel) = areat(iel) + area(iel)
611 deltae(iel) = deltae(iel) + (dein(iel) + deit(iel))*area(iel)*soft(iel)
612 ENDDO
613c--------------------------------------------------
614c save current strain and stress
615 DO iel=1,nel
616 lbuf%SIG(jj(3)+iel) = signzz(iel)*lbuf%OFF(iel)
617 lbuf%SIG(jj(5)+iel) = signyz(iel)*lbuf%OFF(iel)
618 lbuf%SIG(jj(6)+iel) = signzx(iel)*lbuf%OFF(iel)
619 ENDDO
620 IF (elbuf_str%BUFLY(1)%L_EPE > 0) THEN
621 DO iel=1,nel
622 lbuf%EPE(jj(1)+iel) = epszz(iel)
623 lbuf%EPE(jj(2)+iel) = epsyz(iel)
624 lbuf%EPE(jj(3)+iel) = epszx(iel)
625 ENDDO
626 END IF
627c
628C----
629 ENDDO ! IPG=1,NPG
630c--------------------------------------------------
631c end of loop over gauss points
632c--------------------------------------------------
633c delete element
634c--------------------------------------------------
635 CALL sconnect_off(elbuf_str ,gbuf%OFF ,nel ,npg ,ngl ,
636 . isolid ,time )
637c--------------------------------------------------
638c
639 DO iel=1,nel
640 gbuf%EINT(iel) = gbuf%EINT(iel) + deltae(iel) ! / AREAT(IEL)
641 ENDDO
642c
643 IF (ioutprt/=0)
644 . CALL sbilan43(nel ,iparts ,partsav,gbuf%EINT,gbuf%RHO,
645 . areat ,vgxa ,vgya ,vgza ,vga2 ,
646 . gbuf%FILL)
647C Add forces for moment equilibrium
648 CALL smom43(nel ,
649 . fx1 ,fx2 ,fx3 ,fx4 ,fx5 ,fx6 ,fx7 ,fx8 ,
650 . fy1 ,fy2 ,fy3 ,fy4 ,fy5 ,fy6 ,fy7 ,fy8 ,
651 . fz1 ,fz2 ,fz3 ,fz4 ,fz5 ,fz6 ,fz7 ,fz8 ,
652 . r1x ,r2x ,r3x ,r4x ,r5x ,r6x ,r7x ,r8x ,
653 . r1y ,r2y ,r3y ,r4y ,r5y ,r6y ,r7y ,r8y ,
654 . r1z ,r2z ,r3z ,r4z ,r5z ,r6z ,r7z ,r8z ,
655 . rxx ,ryy ,rzz ,tthick )
656C Nodal forces : corotationnal --> global
657 CALL srrota3(
658 1 e1x, e1y, e1z, e2x,
659 2 e2y, e2z, e3x, e3y,
660 3 e3z, fx1, fx2, fx3,
661 4 fx4, fx5, fx6, fx7,
662 5 fx8, fy1, fy2, fy3,
663 6 fy4, fy5, fy6, fy7,
664 7 fy8, fz1, fz2, fz3,
665 8 fz4, fz5, fz6, fz7,
666 9 fz8, nel)
667c-----------
668 RETURN
my_real
#define my_real
Definition cppsort.cpp:32
alpha
#define alpha
Definition eval.h:35
fail_connect
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)
Definition fail_connect.F:37
fail_snconnect
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)
Definition fail_snconnect.F:37
area
subroutine area(d1, x, x2, y, y2, eint, stif0)
Definition hm_read_prop32.F:567
min
#define min(a, b)
Definition macros.h:20
law_userso
Definition law_userso.F:29
table_mod
Definition table_mod.F:113
sbilan43
subroutine sbilan43(nel, iparts, partsav, eint, rho, areat, vxa, vya, vza, va2, fill)
Definition sbilan43.F:31
sconnect_off
subroutine sconnect_off(elbuf_str, offg, nel, npg, ngl, isolid, time)
Definition sconnect_off.F:32
scoor43
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
sdef43
subroutine sdef43(nel, npg, hh, dzx, dyz, dzz, vxloc, vyloc, vzloc)
Definition sdef43.F:31
sfint43
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
sigeps116
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
sigeps117
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
sigeps120_connect_main
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)
Definition sigeps120_connect_main.F:44
sigeps59
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
sigeps83
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
smom43
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
srrota3
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
startime
subroutine startime(event, itask)
Definition timer.F:93
stoptime
subroutine stoptime(event, itask)
Definition timer.F:135