OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
ig3duforc3.F File Reference
#include "implicit_f.inc"
#include "comlock.inc"
#include "mvsiz_p.inc"
#include "com01_c.inc"
#include "com04_c.inc"
#include "com08_c.inc"
#include "scr19_c.inc"
#include "param_c.inc"
#include "timeri_c.inc"
#include "scr18_c.inc"
#include "ige3d_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine ig3duforc3 (timers, output, elbuf_tab, ng, lft, llt, nft, nel, ixs, pm, geo, ipm, igeo, x, a, ar, v, vr, w, d, ms, in, tf, npf, bufmat, iparg, iparts, partsav, nloc_dmg, fsky, fr_wave, iads, eani, stifn, stifr, fx, fy, fz, ifailure, mtn, igtyp, npt, jsms, mssa, dmels, kxig3d, ixig3d, knot, nctrl, wige, flux, flu1, dt2t, neltst, ityptst, offset, table, iexpan, ale_connect, fv, itask, ioutprt, px, py, pz, knotlocpc, knotlocel, gresav, grth, igrth, mat_elem, h3d_strain, ismstr, jale, jeul, jlag, jcvt, jplasol, jsph, snpc, stf, sbufmat, svis, nsvois, idtmins, iresp, idel7ng, idel7nok, userl_avail, impl_s, idyna, dt, glob_therm, sensors)

Function/Subroutine Documentation

◆ ig3duforc3()

subroutine ig3duforc3 ( type(timer_), intent(inout) timers,
type(output_), intent(inout) output,
type (elbuf_struct_), dimension(ngroup), target elbuf_tab,
integer ng,
integer lft,
integer llt,
integer nft,
integer nel,
integer, dimension(nixs,*) ixs,
pm,
geo,
integer, dimension(npropmi,*) ipm,
integer, dimension(npropgi,*) igeo,
x,
a,
ar,
v,
vr,
w,
d,
ms,
in,
tf,
integer, dimension(*) npf,
bufmat,
integer, dimension(nparg,*) iparg,
integer, dimension(*) iparts,
partsav,
type (nlocal_str_), target nloc_dmg,
fsky,
fr_wave,
integer, dimension(8,*) iads,
eani,
stifn,
stifr,
fx,
fy,
fz,
integer ifailure,
integer mtn,
integer igtyp,
integer npt,
integer jsms,
mssa,
dmels,
integer, dimension(nixig3d,*) kxig3d,
integer, dimension(*) ixig3d,
knot,
integer nctrl,
wige,
integer, dimension(6,*) flux,
integer, dimension(*) flu1,
dt2t,
integer neltst,
integer ityptst,
integer offset,
type(ttable), dimension(*) table,
integer iexpan,
type(t_ale_connectivity), intent(in) ale_connect,
fv,
integer itask,
integer ioutprt,
integer px,
integer py,
integer pz,
knotlocpc,
knotlocel,
gresav,
integer, dimension(*) grth,
integer, dimension(*) igrth,
type (mat_elem_), intent(inout) mat_elem,
integer h3d_strain,
integer, intent(in) ismstr,
integer, intent(in) jale,
integer, intent(in) jeul,
integer, intent(in) jlag,
integer, intent(in) jcvt,
integer, intent(inout) jplasol,
integer, intent(inout) jsph,
integer, intent(in) snpc,
integer, intent(in) stf,
integer, intent(in) sbufmat,
intent(inout) svis,
integer, intent(in) nsvois,
integer, intent(in) idtmins,
integer, intent(in) iresp,
integer, intent(in) idel7ng,
integer, intent(inout) idel7nok,
integer, intent(in) userl_avail,
integer, intent(in) impl_s,
integer, intent(in) idyna,
type(dt_), intent(in) dt,
type (glob_therm_), intent(inout) glob_therm,
type (sensors_), intent(inout) sensors )

Definition at line 60 of file ig3duforc3.F.

85C-----------------------------------------------
86C M o d u l e s
87C-----------------------------------------------
88 USE output_mod, only : output_
89 USE timer_mod
90 USE mmain_mod
91 USE table_mod
92 USE mat_elem_mod
93 USE message_mod
94 USE nlocal_reg_mod
95 USE ale_connectivity_mod
96 USE elbufdef_mod
97 USE dt_mod
98 use glob_therm_mod
99 USE sensor_mod
100C-----------------------------------------------
101C I m p l i c i t T y p e s
102C-----------------------------------------------
103#include "implicit_f.inc"
104#include "comlock.inc"
105C-----------------------------------------------
106C G l o b a l P a r a m e t e r s
107C-----------------------------------------------
108#include "mvsiz_p.inc"
109C-----------------------------------------------
110C C o m m o n B l o c k s
111C-----------------------------------------------
112#include "com01_c.inc"
113#include "com04_c.inc"
114#include "com08_c.inc"
115#include "scr19_c.inc"
116#include "param_c.inc"
117#include "timeri_c.inc"
118#include "scr18_c.inc"
119#include "ige3d_c.inc"
120C-----------------------------------------------
121C D u m m y A r g u m e n t s
122C-----------------------------------------------
123 TYPE(TIMER_) ,INTENT(INOUT) :: TIMERS
124 TYPE(OUTPUT_), INTENT(INOUT) :: OUTPUT
125 INTEGER, INTENT(INOUT) :: JPLASOL
126 INTEGER, INTENT(INOUT) :: JSPH
127 INTEGER, INTENT(IN) :: JCVT
128 INTEGER, INTENT(IN) :: ISMSTR
129 INTEGER, INTENT(IN) :: JALE
130 INTEGER, INTENT(IN) :: JEUL
131 INTEGER, INTENT(IN) :: JLAG
132 INTEGER, INTENT(IN) :: SNPC
133 INTEGER, INTENT(IN) :: STF
134 INTEGER, INTENT(IN) :: SBUFMAT
135 INTEGER, INTENT(IN) :: IDTMINS
136 INTEGER, INTENT(IN) :: NSVOIS
137 INTEGER, INTENT(IN) :: IRESP
138 INTEGER ,INTENT(IN) :: IDEL7NG
139 INTEGER ,INTENT(INOUT) :: IDEL7NOK
140 INTEGER, INTENT(IN) :: IMPL_S
141 INTEGER, INTENT(IN) :: IDYNA
142 INTEGER, INTENT(IN) :: USERL_AVAIL
143
144 INTEGER LFT,LLT,NEL,NFT,MTN,IGTYP,IFAILURE,NPT,JSMS,
145 . NCTRL,NG,NELTST,ITYPTST,OFFSET,IEXPAN,ITASK,H3D_STRAIN
146 INTEGER IXS(NIXS,*), IPARG(NPARG,*), NPF(*),IADS(8,*),
147 . IPARTS(*), IGEO(NPROPGI,*), IPM(NPROPMI,*),
148 . KXIG3D(NIXIG3D,*),IXIG3D(*),FLUX(6,*),FLU1(*),
149 . IOUTPRT,PX,PY,PZ,GRTH(*),IGRTH(*)
150 my_real
151 . pm(npropm,*), geo(npropg,*),x(3,*),a(3,*),v(3,*),ms(*),w(*),
152 . ar(3,*), vr(3,*), in(3,*),d(3,*),tf(*), bufmat(*),fr_wave(*),
153 . partsav(*),stifn(*), stifr(*), fsky(*),eani(*),
154 . fx(mvsiz,*),fy(mvsiz,*),fz(mvsiz,*),
155 . mssa(*), dmels(*),knot(*),wige(*),dt2t, fv(*),knotlocpc(deg_max,3,*),
156 . knotlocel(2,3,*),gresav(*)
157 my_real, DIMENSION(MVSIZ,6), INTENT(INOUT) :: svis
158 TYPE (ELBUF_STRUCT_), TARGET, DIMENSION(NGROUP) :: ELBUF_TAB
159 TYPE(TTABLE) TABLE(*)
160 TYPE (NLOCAL_STR_) , TARGET :: NLOC_DMG
161 TYPE(t_ale_connectivity), INTENT(IN) :: ALE_CONNECT
162 TYPE (MAT_ELEM_) ,INTENT(INOUT) :: MAT_ELEM
163 TYPE(DT_) ,INTENT(IN) :: DT
164 type (glob_therm_) ,intent(inout) :: glob_therm
165 type (sensors_),INTENT(INOUT) :: SENSORS
166C-----------------------------------------------
167C L o c a l V a r i a b l e s
168C-----------------------------------------------
169 INTEGER I,J,NF1,IFLAG,IG,IGT,NUPARAM,
170 . NUVAR,NUVARP,IMAT,IPID,N1,N2,N3,NKNOT1,NKNOT2,NKNOT3,
171 . IDX(MVSIZ),IDY(MVSIZ),IDZ(MVSIZ),IFUNC(MAXFUNC),NFUNC,IADBUF,
172 . IBID,ISTRAIN,IBIDV(1),IP,ILAY,IERROR,IAD_KNOT,IDFRSTLOCKNT, IDPC,
173 . IDX2(MVSIZ),IDY2(MVSIZ),IDZ2(MVSIZ)
174C-----
175 INTEGER SID(MVSIZ),IPROP,NC(MVSIZ,8),
176 . MAT(MVSIZ)
177 my_real
178 . mx(nel,nctrl),my(nel,nctrl) , mz(nel,nctrl),
179 . sti(mvsiz),stin(mvsiz),stir(mvsiz), viscm(mvsiz) ,viscr(mvsiz),rho0(mvsiz)
180 my_real
181 . off(mvsiz) , rhoo(mvsiz),fr_w_e(mvsiz),
182 . xx(nctrl,nel),yy(nctrl,nel),zz(nctrl,nel),
183 . dx(nctrl,nel),dy(nctrl,nel),dz(nctrl,nel),
184 . ux(nctrl,nel),uy(nctrl,nel),uz(nctrl,nel),
185 . vx(nctrl,nel),vy(nctrl,nel),vz(nctrl,nel),
186 . vrx(nctrl,nel),vry(nctrl,nel),vrz(nctrl,nel),
187 . dte(mvsiz) ,ww(nctrl,nel),rbid, zr, zs, zt
188
189 TYPE(G_BUFEL_) ,POINTER :: GBUF
190 TYPE(L_BUFEL_) ,POINTER :: LBUF
191 TYPE(BUF_MAT_) ,POINTER :: MBUF
192 my_real,
193 . DIMENSION(:),POINTER :: uvar
194 INTEGER MXT(MVSIZ),NGL(MVSIZ),NGEO(MVSIZ)
195 my_real
196 . voln(mvsiz), vd2(mvsiz) , dvol(mvsiz),deltax(mvsiz),
197 . vis(mvsiz) , qvis(mvsiz), cxx(mvsiz) ,
198 . s1(mvsiz) , s2(mvsiz) , s3(mvsiz) ,
199 . s4(mvsiz) , s5(mvsiz) , s6(mvsiz) ,
200 . d4(mvsiz) , d5(mvsiz) , d6(mvsiz) ,
201 . ajc1(mvsiz) , ajc2(mvsiz) , ajc3(mvsiz) ,
202 . ajc4(mvsiz) , ajc5(mvsiz) , ajc6(mvsiz) ,
203 . ajc7(mvsiz) , ajc8(mvsiz) , ajc9(mvsiz) ,
204 . aj1(mvsiz) , aj2(mvsiz) , aj3(mvsiz) ,
205 . aj4(mvsiz) , aj5(mvsiz) , aj6(mvsiz),
206 . wxx(mvsiz) , wyy(mvsiz) , wzz(mvsiz),
207 . vdx(mvsiz) , vdy(mvsiz) , vdz(mvsiz),
208 . muvoid(mvsiz),ssp_eq(mvsiz),aire(mvsiz),
209 . sigy(mvsiz),et(mvsiz),r1_free(mvsiz),
210 . r3_free(mvsiz),r4_free(mvsiz),defp(mvsiz),
211 . mfxx(mvsiz),mfxy(mvsiz),mfyx(mvsiz),
212 . mfyy(mvsiz),mfyz(mvsiz),mfzy(mvsiz),
213 . mfzz(mvsiz),mfzx(mvsiz),mfxz(mvsiz),
214 . gama(mvsiz,6),bid(mvsiz),tempel(mvsiz),die(mvsiz),
215 . stig(mvsiz,nctrl)
216C
217 my_real
218 . dxx(mvsiz), dyy(mvsiz), dzz(mvsiz),
219 . dxy(mvsiz), dxz(mvsiz), dyx(mvsiz),
220 . dyz(mvsiz), dzx(mvsiz), dzy(mvsiz),divde(mvsiz)
221
222 INTEGER ITEL, ITNCTRL, K, N, JJ, INCTRL, L, IFACE
223 my_real,
224 . DIMENSION(NCTRL) :: r
225 my_real,
226 . DIMENSION(NCTRL,3) :: drdxi
227 my_real,
228 . DIMENSION(NCTRL,MVSIZ) :: matn
229 my_real,
230 . DIMENSION(3*NCTRL,MVSIZ) :: matb
231 my_real,
232 . DIMENSION(MVSIZ) :: matdet
233 my_real
234 . detjac, pgauss, volg(mvsiz)
235 my_real
236 . dd,btdbaloc(3*nctrl,mvsiz),
237 . ba(6,mvsiz),dba(6,mvsiz), aloc(3*nctrl,mvsiz),
238 . mass(nctrl,mvsiz),mmunk(mvsiz),knotlocx(px+1,nctrl,mvsiz),
239 . knotlocy(py+1,nctrl,mvsiz),knotlocz(pz+1,nctrl,mvsiz),
240 . knotlocelx(2,mvsiz),
241 . knotlocely(2,mvsiz),knotlocelz(2,mvsiz)
242 my_real
243 . airenurbs(3), aface(6,mvsiz), tc, lc,
244 . vmin(mvsiz), smax(mvsiz), sumv,amu(mvsiz)
245 my_real varnl(nel)
246 my_real,
247 . ALLOCATABLE, DIMENSION(:,:) :: vgauss
248 INTEGER SZ_IX
249C----------------------------------------------------------
250 double precision
251 . w_gauss(9,9),a_gauss(9,9),voldp(mvsiz)
252 DATA w_gauss /
253 1 2.d0 ,0.d0 ,0.d0 ,
254 1 0.d0 ,0.d0 ,0.d0 ,
255 1 0.d0 ,0.d0 ,0.d0 ,
256 2 1.d0 ,1.d0 ,0.d0 ,
257 2 0.d0 ,0.d0 ,0.d0 ,
258 2 0.d0 ,0.d0 ,0.d0 ,
259 3 0.555555555555556d0,0.888888888888889d0,0.555555555555556d0,
260 3 0.d0 ,0.d0 ,0.d0 ,
261 3 0.d0 ,0.d0 ,0.d0 ,
262 4 0.347854845137454d0,0.652145154862546d0,0.652145154862546d0,
263 4 0.347854845137454d0,0.d0 ,0.d0 ,
264 4 0.d0 ,0.d0 ,0.d0 ,
265 5 0.236926885056189d0,0.478628670499366d0,0.568888888888889d0,
266 5 0.478628670499366d0,0.236926885056189d0,0.d0 ,
267 5 0.d0 ,0.d0 ,0.d0 ,
268 6 0.171324492379170d0,0.360761573048139d0,0.467913934572691d0,
269 6 0.467913934572691d0,0.360761573048139d0,0.171324492379170d0,
270 6 0.d0 ,0.d0 ,0.d0 ,
271 7 0.129484966168870d0,0.279705391489277d0,0.381830050505119d0,
272 7 0.417959183673469d0,0.381830050505119d0,0.279705391489277d0,
273 7 0.129484966168870d0,0.d0 ,0.d0 ,
274 8 0.101228536290376d0,0.222381034453374d0,0.313706645877887d0,
275 8 0.362683783378362d0,0.362683783378362d0,0.313706645877887d0,
276 8 0.222381034453374d0,0.101228536290376d0,0.d0 ,
277 9 0.081274388361574d0,0.180648160694857d0,0.260610696402935d0,
278 9 0.312347077040003d0,0.330239355001260d0,0.312347077040003d0,
279 9 0.260610696402935d0,0.180648160694857d0,0.081274388361574d0/
280 DATA a_gauss /
281 1 0.d0 ,0.d0 ,0.d0 ,
282 1 0.d0 ,0.d0 ,0.d0 ,
283 1 0.d0 ,0.d0 ,0.d0 ,
284 2 -.577350269189625d0,0.577350269189625d0,0.d0 ,
285 2 0.d0 ,0.d0 ,0.d0 ,
286 2 0.d0 ,0.d0 ,0.d0 ,
287 3 -.774596669241483d0,0.d0 ,0.774596669241483d0,
288 3 0.d0 ,0.d0 ,0.d0 ,
289 3 0.d0 ,0.d0 ,0.d0 ,
290 4 -.861136311594053d0,-.339981043584856d0,0.339981043584856d0,
291 4 0.861136311594053d0,0.d0 ,0.d0 ,
292 4 0.d0 ,0.d0 ,0.d0 ,
293 5 -.906179845938664d0,-.538469310105683d0,0.d0 ,
294 5 0.538469310105683d0,0.906179845938664d0,0.d0 ,
295 5 0.d0 ,0.d0 ,0.d0 ,
296 6 -.932469514203152d0,-.661209386466265d0,-.238619186083197d0,
297 6 0.238619186083197d0,0.661209386466265d0,0.932469514203152d0,
298 6 0.d0 ,0.d0 ,0.d0 ,
299 7 -.949107912342759d0,-.741531185599394d0,-.405845151377397d0,
300 7 0.d0 ,0.405845151377397d0,0.741531185599394d0,
301 7 0.949107912342759d0,0.d0 ,0.d0 ,
302 8 -.960289856497536d0,-.796666477413627d0,-.525532409916329d0,
303 8 -.183434642495650d0,0.183434642495650d0,0.525532409916329d0,
304 8 0.796666477413627d0,0.960289856497536d0,0.d0 ,
305 9 -.968160239507626d0,-.836031107326636d0,-.613371432700590d0,
306 9 -.324253423403809d0,0.d0 ,0.324253423403809d0,
307 9 0.613371432700590d0,0.836031107326636d0,0.968160239507626d0/
308C-----------------------------------------------
309C S o u r c e L i n e s
310C=======================================================================
311 sz_ix=numelq+numels+nsvois ! Size of IX array (either IXS+NSVOIS or IXQ)
312 ibid = 0
313 ibidv = 0
314 istrain = 1
315 bid = zero
316 rbid = zero
317 gbuf => elbuf_tab(ng)%GBUF
318 uvar => elbuf_tab(ng)%BUFLY(1)%MAT(1,1,1)%VAR
319 iprop = iparg(62,ng)
320 ilay = 1
321 nf1=nft+1
322 knotlocx = zero
323 knotlocy = zero
324 knotlocz = zero
325 knotlocelx = zero
326 knotlocely = zero
327 knotlocelz = zero
328c a modifier
329 off = one
330 DO i=lft,llt
331 imat = kxig3d(1,i+nft)
332 ngeo(i)=kxig3d(2,i+nft)
333 mxt(i)=imat
334 vis(i)=zero
335 qvis(i)=zero
336 vdx(i)=zero
337 vdy(i)=zero
338 vdz(i)=zero
339 vd2(i)=zero
340c
341 DO j=1,nctrl
342 IF( j <= kxig3d(3,i+nft) ) THEN
343 xx(j,i)=x(1,ixig3d(kxig3d(4,i+nft)+j-1))
344 yy(j,i)=x(2,ixig3d(kxig3d(4,i+nft)+j-1))
345 zz(j,i)=x(3,ixig3d(kxig3d(4,i+nft)+j-1))
346 dx(j,i)=d(1,ixig3d(kxig3d(4,i+nft)+j-1))
347 dy(j,i)=d(2,ixig3d(kxig3d(4,i+nft)+j-1))
348 dz(j,i)=d(3,ixig3d(kxig3d(4,i+nft)+j-1))
349 vx(j,i)=v(1,ixig3d(kxig3d(4,i+nft)+j-1))
350 vy(j,i)=v(2,ixig3d(kxig3d(4,i+nft)+j-1))
351 vz(j,i)=v(3,ixig3d(kxig3d(4,i+nft)+j-1))
352 ww(j,i)=1!WIGE(IXIG3D(KXIG3D(4,I+NFT)+J-1))
353 DO k=1,px+1
354 knotlocx(k,j,i)=knotlocpc(k,1,(ngeo(i)-1)*numnod+ixig3d(kxig3d(4,i+nft)+j-1))
355 ENDDO
356 DO k=1,py+1
357 knotlocy(k,j,i)=knotlocpc(k,2,(ngeo(i)-1)*numnod+ixig3d(kxig3d(4,i+nft)+j-1))
358 ENDDO
359 DO k=1,pz+1
360 knotlocz(k,j,i)=knotlocpc(k,3,(ngeo(i)-1)*numnod+ixig3d(kxig3d(4,i+nft)+j-1))
361 ENDDO
362 ENDIF
363 ENDDO
364 ngl(i) = kxig3d(5,i+nft)
365 idx(i) = kxig3d(6,i+nft)
366 idy(i) = kxig3d(7,i+nft)
367 idz(i) = kxig3d(8,i+nft)
368 idx2(i) = kxig3d(9,i+nft)
369 idy2(i) = kxig3d(10,i+nft)
370 idz2(i) = kxig3d(11,i+nft)
371 knotlocelx(1,i) = knotlocel(1,1,i+nft)
372 knotlocely(1,i) = knotlocel(1,2,i+nft)
373 knotlocelz(1,i) = knotlocel(1,3,i+nft)
374 knotlocelx(2,i) = knotlocel(2,1,i+nft)
375 knotlocely(2,i) = knotlocel(2,2,i+nft)
376 knotlocelz(2,i) = knotlocel(2,3,i+nft)
377 rho0(i)= pm(1,imat)
378 ENDDO
379 iad_knot = igeo(40,iprop)
380 n1 = igeo(44,iprop)
381 n2 = igeo(45,iprop)
382 n3 = igeo(46,iprop)
383 idfrstlocknt = igeo(47,iprop)
384 nknot1 = n1+px
385 nknot2 = n2+py
386 nknot3 = n3+pz
387C-----------
388 iadbuf = ipm(7,imat)
389 nuvar = ipm(8,imat)
390 nuparam = ipm(9,imat)
391 nfunc = ipm(10,imat)
392 DO i=1,nfunc
393 ifunc(i) = ipm(10+i,imat)
394 ENDDO
395
396C-----------AMU for SP is not really implemented
397 IF (tt==zero) THEN
398 DO i=1,px
399 DO j=1,py
400 DO k=1,pz
401 lbuf => elbuf_tab(ng)%BUFLY(1)%LBUF(i,j,k)
402 lbuf%VOL0DP(lft:llt) = lbuf%VOL(lft:llt)
403 ENDDO
404 ENDDO
405 ENDDO ! FIN BOUCLE SUR LES POINTS D'INTEGRATION
406 END IF
407C------------------------------------------------------
408C INITIALISATION DES VARIABLES
409C------------------------------------------------------
410
411 deltax=ep20
412 bid = zero
413 ibid = 0
414 tc = ep10
415 smax(:)=zero
416
417 ALLOCATE(vgauss(px*py*pz,mvsiz),stat=ierror)
418 IF(ierror/=0)THEN
419 CALL ancmsg(msgid=246,anmode=aninfo)
420 CALL arret(2)
421 END IF
422 vgauss(:,:)=zero
423
424 CALL ige3dzero(
425 1 nctrl, volg, gbuf%SIG, gbuf%EINT,
426 2 gbuf%RHO, gbuf%QVIS, fx, fy,
427 3 fz, btdbaloc, stig, mass,
428 4 mmunk, aface, vmin, gbuf%PLA,
429 5 gbuf%EPSD, gbuf%G_PLA, gbuf%G_EPSD,nel)
430
431 n=0
432 DO i=1,px
433 DO j=1,py
434 DO k=1,pz
435
436 n=n+1
437 zr = a_gauss(i,px)
438 zs = a_gauss(j,py)
439 zt = a_gauss(k,pz)
440 pgauss = w_gauss(i,px)*w_gauss(j,py)*w_gauss(k,pz)
441
442 lbuf => elbuf_tab(ng)%BUFLY(1)%LBUF(i,j,k)
443
444C------------------------------------------------------
445C CALCUL DES FONCTIONS DE FORME ET DES DERIVEES
446C------------------------------------------------------
447
448 DO itel=lft,llt
449
450c CALL IGE3DDERIV(
451c . ITEL ,N ,XX(:,ITEL),YY(:,ITEL),ZZ(:,ITEL),WW(:,ITEL),
452c . IDX(ITEL), IDY(ITEL), IDZ(ITEL), DRDXI, R, DETJAC,
453c . NCTRL, ZR, ZS, ZT, KNOT(IAD_KNOT+1), KNOT(IAD_KNOT+NKNOT1+1),
454c . KNOT(IAD_KNOT+NKNOT1+NKNOT2+1), PX-1, PY-1, PZ-1, 1)
455
456 CALL ig3donederiv(
457 1 itel ,n ,xx(:,itel) ,yy(:,itel),
458 2 zz(:,itel),ww(:,itel) ,idx(itel) ,idy(itel) ,
459 3 idz(itel) ,knotlocx(:,:,itel) ,knotlocy(:,:,itel),knotlocz(:,:,itel) ,
460 4 drdxi ,r ,detjac ,nctrl ,
461 5 zr ,zs ,zt ,knot(iad_knot+1),
462 6 knot(iad_knot+nknot1+1),knot(iad_knot+nknot1+nknot2+1),px-1,
463 7 py-1 ,pz-1 ,1 ,
464 8 idx2(itel),idy2(itel) ,idz2(itel) ,
465 9 knotlocelx(:,itel),knotlocely(:,itel),knotlocelz(:,itel))
466
467 voln(itel) = pgauss*detjac
468 vgauss(n,itel) = pgauss*detjac
469 volg(itel) = volg(itel) + voln(itel)
470
471 IF(idtmin(101)==1)THEN
472 DO itnctrl=1,nctrl
473 mass(itnctrl,itel)=mass(itnctrl,itel)+pm(89,mxt(itel))*r(itnctrl)*lbuf%VOL(itel)
474 ENDDO
475 ENDIF
476
477C------------------------------------------------------
478C ASSEMBLAGE DE LA MATRICE MATB, MATN, MATDET
479C------------------------------------------------------
480
481 CALL ig3dderishap(
482 . itel ,nctrl ,r ,drdxi ,
483 . detjac,matn ,matb ,matdet)
484
485 ENDDO
486
487C------------------------------------------------------
488C STRAIN RATE
489C------------------------------------------------------
490
491 CALL ige3ddefo(
492 1 vx, vy, vz, matb,
493 2 nctrl, wxx, wyy, wzz,
494 3 dxx, dyy, dzz, dxy,
495 4 dyx, dyz, dzy, dxz,
496 5 dzx, d4, d5, d6,
497 6 ba, aloc, nel)
498
499C------------------------------------------------------
500C ROTATION DE CORPS RIGIDE DES CONTRAINTES PASSEES
501C------------------------------------------------------
502
503 CALL srota3(
504 1 lbuf%SIG,s1, s2, s3,
505 2 s4, s5, s6, wxx,
506 3 wyy, wzz, nel, mtn,
507 4 iparg(9,ng))
508
509C------------------------------------------------------
510C CALCUL DE LA MASSE VOLUMIQUE COURANTE
511C------------------------------------------------------
512 voldp(lft:llt) = voln(lft:llt)
513 divde(1:nel) = dt1*(dxx(1:nel)+ dyy(1:nel)+ dzz(1:nel))
514
515 CALL srho3(
516 1 pm, lbuf%VOL, lbuf%RHO, lbuf%EINT,
517 2 divde, flux(1,nf1), flu1(nf1), voln,
518 3 dvol, ngl, mxt, off,
519 4 iparg(64,ng),gbuf%TAG22, voldp, lbuf%VOL0DP,
520 5 amu, gbuf%OFF, nel, mtn,
521 6 jale, ismstr, jeul, jlag)
522
523c CALL SMALL3(GBUF%SMSTR,GBUF%OFF,OFF,WXX,WYY,
524c . WZZ,DXX,DYY,DZZ,GBUF%RHO,RHO0,
525c . DVOL,VOLN)
526
527C------------------------------------------------------
528C CALCUL DES CONTRAINTES
529C------------------------------------------------------
530
531 IF ((itask==0).AND.(imon_mat==1)) CALL startime(timers,35)
532 CALL mmain(timers, output,
533 1 elbuf_tab, ng, pm, geo,
534 2 ale_connect, ixs, iparg,
535 3 v, tf, npf, bufmat,
536 4 sti, x, dt2t, neltst,
537 5 ityptst, offset, nel, w,
538 6 off, ngeo, mxt, ngl,
539 7 voln, vd2, dvol, deltax,
540 8 vis, qvis, cxx, s1,
541 9 s2, s3, s4, s5,
542 a s6, dxx, dyy, dzz,
543 b d4, d5, d6, wxx,
544 c wyy, wzz, aj1, aj2,
545 d aj3, aj4, aj5, aj6,
546 e vdx, vdy, vdz, muvoid,
547 f ssp_eq, aire, sigy, et,
548 g r1_free, defp, r3_free, amu,
549 h mfxx, mfxy, mfxz, mfyx,
550 i mfyy, mfyz, mfzx, mfzy,
551 j mfzz, ipm, gama, bid,
552 k dxy, dyx, dyz, dzy,
553 l dzx, dxz, istrain, tempel,
554 m die, iexpan, ilay, mssa,
555 n dmels, i, j, k,
556 o table, bid, bid, bid,
557 p bid, iparg(1,ng), igeo, bid,
558 q itask, nloc_dmg, varnl, mat_elem,
559 r h3d_strain, jplasol, jsph, mvsiz,
560 s snpc, stf, sbufmat, glob_therm,
561 * svis, sz_ix, iresp,
562 t n2d, th_strain, ngroup, tt,
563 . dt1, ntable, numelq, nummat,
564 . numgeo, numnod, numels,
565 . idel7nok, idtmin, maxfunc,
566 . imon_mat, userl_avail, impl_s,
567 . idyna, dt ,bid ,sensors)
568
569 CALL sstra3(
570 1 dxx, dyy, dzz, d4,
571 2 d5, d6, lbuf%STRA,wxx,
572 3 wyy, wzz, off, nel,
573 4 jcvt)
574
575 IF ((itask==0).AND.(imon_mat==1)) CALL stoptime(timers,35)
576
577C------------------------------------------------------
578C FORCES INTERNES
579C------------------------------------------------------
580
581 CALL ig3dfint(
582 1 pm, mxt, kxig3d, lbuf%SIG,
583 2 nctrl, matb, fx, fy,
584 3 fz, voln, btdbaloc,dba,
585 4 ssp_eq, stig, nel, nft)
586
587 ENDDO
588 ENDDO
589 ENDDO ! FIN BOUCLE SUR LES POINTS D'INTEGRATION
590
591C-----------------------------
592C SMALL STRAIN
593C-----------------------------
594
595 CALL smallb3(
596 1 gbuf%OFF,off, nel, ismstr)
597
598C------------------------------------------------------
599c
600 n=0
601 DO i=1,px
602 DO j=1,py
603 DO k=1,pz
604
605 n=n+1
606 lbuf => elbuf_tab(ng)%BUFLY(1)%LBUF(i,j,k)
607
608 CALL ig3daverage(
609 1 lbuf%SIG, gbuf%SIG, lbuf%VOL, gbuf%VOL,
610 2 lbuf%RHO, lbuf%EINT, gbuf%EINT, gbuf%RHO,
611 3 vgauss(n,:),volg, lbuf%PLA, gbuf%PLA,
612 4 gbuf%G_PLA, lbuf%EPSD, gbuf%EPSD, nel,
613 5 iparg(40,ng))
614
615 ENDDO
616 ENDDO
617 ENDDO ! FIN BOUCLE SUR LES POINTS D'INTEGRATION
618c
619C------------------------------------------------------
620C BILANS PAR MATERIAU
621C------------------------------------------------------
622 iflag=mod(ncycle,ncpri)
623 IF (ioutprt>0)THEN
624 CALL ige3dbilan(partsav,gbuf%EINT,gbuf%RHO,volg,
625 . vx, vy, vz,iparts,gbuf%VOL,
626 . gresav,grth,igrth,
627 . xx, yy, zz, nctrl,itask,iparg(1,ng),
628 . sensors)
629 ENDIF
630
631C--------------------------------------------
632C CUMUL
633C--------------------------------------------
634
635 CALL ig3dcumu3(
636 1 ixig3d, kxig3d, nctrl, gbuf%OFF,
637 2 a, fx, fy, fz,
638 3 btdbaloc,stig, stifn, nel,
639 4 nft)
640
641
642
643C------------------------------------------------------
644C PAS DE TEMPS ELEMENTAIRE : PULSATION PROPRE PAR ELEMENT
645C------------------------------------------------------
646
647 IF(idtmin(101)==1)THEN
648 DO i=lft,llt
649 DO j=1,nctrl
650 IF( j <= kxig3d(3,i+nft) ) THEN
651 mmunk(i) = min(mmunk(i),mass(j,i)/stig(i,j))
652 ENDIF
653 ENDDO
654 tc = sqrt(2*mmunk(i))
655 tc = dtfac1(101)*tc
656 IF(tc<dt2t)THEN
657 dt2t =tc
658 ityptst=101
659 neltst =ngl(i)
660 ENDIF
661 ENDDO
662
663C------------------------------------------------------
664C CALCUL DES AIRES DES FACES DES ELEMENTS
665C------------------------------------------------------
666
667 ELSEIF(idtmin(101)==2)THEN
668
669 n=0
670 DO i=1,px
671 DO j=1,py
672 n=n+1
673 zr = a_gauss(i,px)
674 zs = a_gauss(j,py)
675 zt = -one
676 pgauss = w_gauss(i,px)*w_gauss(j,py)
677
678 DO itel=lft,llt
679
680 CALL ige3daire(
681 . itel ,n ,xx(:,itel),yy(:,itel),zz(:,itel),ww(:,itel),
682 . idx(itel), idy(itel), idz(itel), airenurbs,
683 . nctrl, zr, zs, zt, knot(iad_knot+1), knot(iad_knot+nknot1+1),
684 . knot(iad_knot+nknot1+nknot2+1), px-1, py-1, pz-1)
685
686 aface(1,itel) = aface(1,itel) + airenurbs(1)*pgauss
687
688 ENDDO
689
690 zt = one
691
692 DO itel=lft,llt
693 CALL ige3daire(
694 . itel ,n ,xx(:,itel),yy(:,itel),zz(:,itel),ww(:,itel),
695 . idx(itel), idy(itel), idz(itel), airenurbs,
696 . nctrl, zr, zs, zt, knot(iad_knot+1), knot(iad_knot+nknot1+1),
697 . knot(iad_knot+nknot1+nknot2+1), px-1, py-1, pz-1)
698
699 aface(2,itel) = aface(2,itel) + airenurbs(1)*pgauss
700 ENDDO
701 ENDDO
702 ENDDO
703
704 n=0
705 DO i=1,px
706 DO k=1,pz
707 n=n+1
708 zs = -one
709 zr = a_gauss(i,px)
710 zt = a_gauss(k,pz)
711 pgauss = w_gauss(i,px)*w_gauss(k,pz)
712
713 DO itel=lft,llt
714 CALL ige3daire(
715 . itel ,n ,xx(:,itel),yy(:,itel),zz(:,itel),ww(:,itel),
716 . idx(itel), idy(itel), idz(itel), airenurbs,
717 . nctrl, zr, zs, zt, knot(iad_knot+1), knot(iad_knot+nknot1+1),
718 . knot(iad_knot+nknot1+nknot2+1), px-1, py-1, pz-1)
719
720 aface(3,itel) = aface(3,itel) + airenurbs(2)*pgauss
721 ENDDO
722
723 zs = one
724
725 DO itel=lft,llt
726 CALL ige3daire(
727 . itel ,n ,xx(:,itel),yy(:,itel),zz(:,itel),ww(:,itel),
728 . idx(itel), idy(itel), idz(itel), airenurbs,
729 . nctrl, zr, zs, zt, knot(iad_knot+1), knot(iad_knot+nknot1+1),
730 . knot(iad_knot+nknot1+nknot2+1), px-1, py-1, pz-1)
731
732 aface(4,itel) = aface(4,itel) + airenurbs(2)*pgauss
733 ENDDO
734 ENDDO
735 ENDDO
736
737 n=0
738 DO j=1,py
739 DO k=1,pz
740 n=n+1
741 zr = -one
742 zs = a_gauss(j,py)
743 zt = a_gauss(k,pz)
744 pgauss = w_gauss(j,py)*w_gauss(k,pz)
745
746 DO itel=lft,llt
747 CALL ige3daire(
748 . itel ,n ,xx(:,itel),yy(:,itel),zz(:,itel),ww(:,itel),
749 . idx(itel), idy(itel), idz(itel), airenurbs,
750 . nctrl, zr, zs, zt, knot(iad_knot+1), knot(iad_knot+nknot1+1),
751 . knot(iad_knot+nknot1+nknot2+1), px-1, py-1, pz-1)
752
753 aface(5,itel) = aface(5,itel) + airenurbs(3)*pgauss
754 ENDDO
755
756 zr = one
757
758 DO itel=lft,llt
759 CALL ige3daire(
760 . itel ,n ,xx(:,itel),yy(:,itel),zz(:,itel),ww(:,itel),
761 . idx(itel), idy(itel), idz(itel), airenurbs,
762 . nctrl, zr, zs, zt, knot(iad_knot+1), knot(iad_knot+nknot1+1),
763 . knot(iad_knot+nknot1+nknot2+1), px-1, py-1, pz-1)
764
765 aface(6,itel) = aface(6,itel) + airenurbs(3)*pgauss
766 ENDDO
767 ENDDO
768 ENDDO
769
770C------------------------------------------------------
771C PAS DE TEMPS ELEMENTAIRE : LONGUEUR CARACTERISTIQUE
772C------------------------------------------------------
773
774 DO itel=lft,llt
775 DO i=1,px
776 DO j=1,py
777 sumv=zero
778 DO k=1,pz
779 sumv=sumv+vgauss((j-1)*pz+(i-1)*pz*py+k,itel)
780 ENDDO
781 vmin(itel)=min(vmin(itel),sumv)
782 ENDDO
783 ENDDO
784
785 deltax(itel)=min(deltax(itel),px*py*vmin(itel)/max(aface(1,itel),aface(2,itel)))
786 vmin(itel)=ep10
787 sumv=zero
788
789 DO i=1,px
790 DO j=1,pz
791 sumv=zero
792 DO k=1,py
793 sumv=sumv+vgauss(j+(i-1)*py*pz+(k-1)*pz,itel)
794 ENDDO
795 vmin(itel)=min(vmin(itel),sumv)
796 ENDDO
797 ENDDO
798
799 deltax(itel)=min(deltax(itel),px*pz*vmin(itel)/max(aface(3,itel),aface(4,itel)))
800 vmin(itel)=ep10
801
802 DO i=1,py
803 DO j=1,pz
804 sumv=zero
805 DO k=1,px
806 sumv=sumv+vgauss(j+(i-1)*pz+(k-1)*py*pz,itel)
807 ENDDO
808 vmin(itel)=min(vmin(itel),sumv)
809 ENDDO
810 ENDDO
811
812 deltax(itel)=min(deltax(itel),pz*py*vmin(itel)/max(aface(5,itel),aface(6,itel)))
813 vmin(itel)=ep10
814 sumv=zero
815
816 ENDDO
817
818 DEALLOCATE(vgauss)
819 ENDIF
820
821C----------------------------
822
823C-----------
824 RETURN
my_real
#define my_real
Definition cppsort.cpp:32
ige3daire
subroutine ige3daire(itel, n, xxi, yyi, zzi, wwi, idx, idy, idz, aire, nctrl, gaussx, gaussy, gaussz, kx, ky, kz, px, py, pz)
Definition ig3daire.F:36
ig3daverage
subroutine ig3daverage(sig, sigg, vol0, vol0g, rho, eint, eintg, rhog, vol, volg, eplas, eplasg, g_pla, epsd, epsdg, nel, israt)
Definition ig3daverage.F:35
ig3dcumu3
subroutine ig3dcumu3(ixig3d, kxig3d, nctrl, offg, e, fx, fy, fz, btdbaloc, stig, stifn, nel, nft)
Definition ig3dcumu3.F:33
ig3dderishap
subroutine ig3dderishap(i, nctrl, r, drdxi, detjac, n, b, det)
Definition ig3dderishap.F:30
ig3dfint
subroutine ig3dfint(pm, mxt, kxig3d, sig, nctrl, matb, fx, fy, fz, vol, btdba, dba, ssp_eq, stig, nel, nft)
Definition ig3dfint.F:33
ige3dbilan
subroutine ige3dbilan(partsav, eint, rho, vol, vx, vy, vz, iparts, vol0, gresav, grth, igrth, x, y, z, ncp, itask, iparg, sensors)
Definition ige3dbilan.F:38
ige3ddefo
subroutine ige3ddefo(vx, vy, vz, matb, nctrl, wxx, wyy, wzz, dxx, dyy, dzz, dxy, dyx, dyz, dzy, dxz, dzx, d4, d5, d6, ba, a, nel)
Definition ige3ddefo.F:35
ige3dzero
subroutine ige3dzero(nctrl, volm, sigm, eintm, rhom, qm, fx, fy, fz, btdba, stig, mass, mmunk, aface, detmin, eplasm, epsdg, g_pla, g_epsd, nel)
Definition ige3dzero.F:34
min
#define min(a, b)
Definition macros.h:20
max
#define max(a, b)
Definition macros.h:21
mmain
subroutine mmain(pm, elbuf_str, ix, nix, x, geo, iparg, nel, skew, bufmat, ipart, ipartel, nummat, matparam, imat, ipm, ngl, pid, npf, tf, mfxx, mfxy, mfxz, mfyx, mfyy, mfyz, mfzx, mfzy, mfzz, rx, ry, rz, sx, sy, sz, gama, voln, dvol, s1, s2, s3, s4, s5, s6, dxx, dyy, dzz, d4, d5, d6, wxx, wyy, wzz)
Definition mmain.F:43
ale_connectivity_mod
Definition ale_connectivity_mod.F:223
dt_mod
Definition dt_mod.F:79
message_mod
Definition message_mod.F:1249
nlocal_reg_mod
Definition nlocal_reg_mod.F:117
table_mod
Definition table_mod.F:112
smallb3
subroutine smallb3(offg, off, nel, ismstr)
Definition smallb3.F:44
srota3
subroutine srota3(sig, s1, s2, s3, s4, s5, s6, wxx, wyy, wzz, nel, mtn, ismstr)
Definition srota3.F:43
sstra3
subroutine sstra3(dxx, dyy, dzz, d4, d5, d6, strain, wxx, wyy, wzz, off, nel, jcvt)
Definition sstra3.F:46
ig3donederiv
subroutine ig3donederiv(itel, n, xxi, yyi, zzi, wwi, idx, idy, idz, knotlocx, knotlocy, knotlocz, drdx, r, detjac, nctrl, gaussx, gaussy, gaussz, kx, ky, kz, px, py, pz, boolg, idx2, idy2, idz2, knotlocelx, knotlocely, knotlocelz)
Definition ig3donederiv.F:43
srho3
subroutine srho3(pm, volo, rhon, eint, dxx, dyy, dzz, voln, dvol, mat)
Definition srho3.F:31
ancmsg
subroutine ancmsg(msgid, msgtype, anmode, i1, i2, i3, i4, i5, i6, i7, i8, i9, i10, i11, i12, i13, i14, i15, i16, i17, i18, i19, i20, r1, r2, r3, r4, r5, r6, r7, r8, r9, c1, c2, c3, c4, c5, c6, c7, c8, c9, prmode)
Definition message.F:889
arret
subroutine arret(nn)
Definition arret.F:87
startime
subroutine startime(event, itask)
Definition timer.F:93
stoptime
subroutine stoptime(event, itask)
Definition timer.F:135