OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
ig3duforc3.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!|| ig3duforc3 ../engine/source/elements/ige3d/ig3duforc3.F
25!||--- called by ------------------------------------------------------
26!|| forint ../engine/source/elements/forint.F
27!||--- calls -----------------------------------------------------
28!|| ancmsg ../engine/source/output/message/message.F
29!|| arret ../engine/source/system/arret.F
30!|| ig3daverage ../engine/source/elements/ige3d/ig3daverage.F
31!|| ig3dcumu3 ../engine/source/elements/ige3d/ig3dcumu3.F
32!|| ig3dderishap ../engine/source/elements/ige3d/ig3dderishap.F
33!|| ig3dfint ../engine/source/elements/ige3d/ig3dfint.F
34!|| ig3donederiv ../engine/source/elements/ige3d/ig3donederiv.F
35!|| ige3daire ../engine/source/elements/ige3d/ig3daire.F
36!|| ige3dbilan ../engine/source/elements/ige3d/ige3dbilan.F
37!|| ige3ddefo ../engine/source/elements/ige3d/ige3ddefo.F
38!|| ige3dzero ../engine/source/elements/ige3d/ige3dzero.F
39!|| mmain ../engine/source/materials/mat_share/mmain.F90
40!|| smallb3 ../engine/source/elements/solid/solide/smallb3.F
41!|| srho3 ../engine/source/elements/solid/solide/srho3.F
42!|| srota3 ../engine/source/elements/solid/solide/srota3.F
43!|| sstra3 ../engine/source/elements/solid/solide/sstra3.F
44!|| startime ../engine/source/system/timer_mod.F90
45!|| stoptime ../engine/source/system/timer_mod.F90
46!||--- uses -----------------------------------------------------
47!|| ale_connectivity_mod ../common_source/modules/ale/ale_connectivity_mod.F
48!|| dt_mod ../engine/source/modules/dt_mod.F
49!|| elbufdef_mod ../common_source/modules/mat_elem/elbufdef_mod.F90
50!|| element_mod ../common_source/modules/elements/element_mod.F90
51!|| glob_therm_mod ../common_source/modules/mat_elem/glob_therm_mod.F90
52!|| mat_elem_mod ../common_source/modules/mat_elem/mat_elem_mod.F90
53!|| message_mod ../engine/share/message_module/message_mod.F
54!|| mmain_mod ../engine/source/materials/mat_share/mmain.F90
55!|| nlocal_reg_mod ../common_source/modules/nlocal_reg_mod.F
56!|| output_mod ../common_source/modules/output/output_mod.F90
57!|| sensor_mod ../common_source/modules/sensor_mod.F90
58!|| table_mod ../engine/share/modules/table_mod.F
59!|| timer_mod ../engine/source/system/timer_mod.F90
60!||====================================================================
61 SUBROUTINE ig3duforc3(TIMERS, OUTPUT,
62 1 ELBUF_TAB, NG, LFT, LLT,
63 2 NFT, NEL, IXS, PM,
64 3 GEO, IPM, IGEO, X,
65 4 A, AR, V, VR,
66 5 W, D, MS, IN,
67 6 TF, NPF, BUFMAT, IPARG,
68 7 IPARTS, PARTSAV, NLOC_DMG, FSKY,
69 8 FR_WAVE, IADS, EANI, STIFN,
70 9 STIFR, FX, FY, FZ,
71 A IFAILURE, MTN, IGTYP, NPT,
72 B JSMS, MSSA, DMELS, KXIG3D,
73 C IXIG3D, KNOT, NCTRL, WIGE,
74 D FLUX, FLU1, DT2T, NELTST,
75 E ITYPTST, OFFSET, TABLE, IEXPAN,
76 F ALE_CONNECT, FV, ITASK, IOUTPRT,
77 G PX, PY, PZ, KNOTLOCPC,
78 H KNOTLOCEL, GRESAV, GRTH, IGRTH,
79 I MAT_ELEM, H3D_STRAIN, ISMSTR, JALE,
80 J JEUL, JLAG, JCVT, JPLASOL,
81 K JSPH, SNPC, STF, SBUFMAT,
82 L SVIS, NSVOIS, IDTMINS, IRESP,
83 . IDEL7NG, IDEL7NOK, USERL_AVAIL,
84 . impl_s, idyna, DT , GLOB_THERM,
85 . SENSORS)
86C-----------------------------------------------
87C M o d u l e s
88C-----------------------------------------------
89 USE output_mod, only : output_
90 USE timer_mod
91 USE mmain_mod
92 USE table_mod
93 USE mat_elem_mod
94 USE message_mod
95 USE nlocal_reg_mod
96 USE ale_connectivity_mod
97 USE elbufdef_mod
98 USE dt_mod
99 use glob_therm_mod
100 USE sensor_mod
101 use element_mod , only : nixs
102C-----------------------------------------------
103C I m p l i c i t T y p e s
104C-----------------------------------------------
105#include "implicit_f.inc"
106#include "comlock.inc"
107C-----------------------------------------------
108C G l o b a l P a r a m e t e r s
109C-----------------------------------------------
110#include "mvsiz_p.inc"
111C-----------------------------------------------
112C C o m m o n B l o c k s
113C-----------------------------------------------
114#include "com01_c.inc"
115#include "com04_c.inc"
116#include "com08_c.inc"
117#include "scr19_c.inc"
118#include "param_c.inc"
119#include "timeri_c.inc"
120#include "scr18_c.inc"
121#include "ige3d_c.inc"
122C-----------------------------------------------
123C D u m m y A r g u m e n t s
124C-----------------------------------------------
125 TYPE(timer_) ,INTENT(INOUT) :: TIMERS
126 TYPE(OUTPUT_), INTENT(INOUT) :: OUTPUT
127 INTEGER, INTENT(INOUT) :: JPLASOL
128 INTEGER, INTENT(INOUT) :: JSPH
129 INTEGER, INTENT(IN) :: JCVT
130 INTEGER, INTENT(IN) :: ISMSTR
131 INTEGER, INTENT(IN) :: JALE
132 INTEGER, INTENT(IN) :: JEUL
133 INTEGER, INTENT(IN) :: JLAG
134 INTEGER, INTENT(IN) :: SNPC
135 INTEGER, INTENT(IN) :: STF
136 INTEGER, INTENT(IN) :: SBUFMAT
137 INTEGER, INTENT(IN) :: IDTMINS
138 INTEGER, INTENT(IN) :: NSVOIS
139 INTEGER, INTENT(IN) :: IRESP
140 INTEGER ,INTENT(IN) :: IDEL7NG
141 INTEGER ,INTENT(INOUT) :: IDEL7NOK
142 INTEGER, INTENT(IN) :: IMPL_S
143 INTEGER, INTENT(IN) :: IDYNA
144 INTEGER, INTENT(IN) :: USERL_AVAIL
145
146 INTEGER LFT,LLT,NEL,NFT,MTN,IGTYP,IFAILURE,NPT,JSMS,
147 . NCTRL,NG,NELTST,ITYPTST,OFFSET,IEXPAN,ITASK,H3D_STRAIN
148 INTEGER IXS(NIXS,*), IPARG(NPARG,*), NPF(*),IADS(8,*),
149 . iparts(*), igeo(npropgi,*), ipm(npropmi,*),
150 . kxig3d(nixig3d,*),ixig3d(*),flux(6,*),flu1(*),
151 . ioutprt,px,py,pz,grth(*),igrth(*)
152 my_real
153 . pm(npropm,*), geo(npropg,*),x(3,*),a(3,*),v(3,*),ms(*),w(*),
154 . ar(3,*), vr(3,*), in(3,*),d(3,*),tf(*), bufmat(*),fr_wave(*),
155 . partsav(*),stifn(*), stifr(*), fsky(*),eani(*),
156 . fx(mvsiz,*),fy(mvsiz,*),fz(mvsiz,*),
157 . mssa(*), dmels(*),knot(*),wige(*),dt2t, fv(*),knotlocpc(deg_max,3,*),
158 . knotlocel(2,3,*),gresav(*)
159 my_real, DIMENSION(MVSIZ,6), INTENT(INOUT) :: svis
160 TYPE (ELBUF_STRUCT_), TARGET, DIMENSION(NGROUP) :: ELBUF_TAB
161 TYPE(ttable) TABLE(*)
162 TYPE (NLOCAL_STR_) , TARGET :: NLOC_DMG
163 TYPE(t_ale_connectivity), INTENT(IN) :: ALE_CONNECT
164 TYPE (MAT_ELEM_) ,INTENT(INOUT) :: MAT_ELEM
165 TYPE(DT_) ,INTENT(IN) :: DT
166 type (glob_therm_) ,intent(inout) :: glob_therm
167 type (sensors_),INTENT(INOUT) :: SENSORS
168C-----------------------------------------------
169C L o c a l V a r i a b l e s
170C-----------------------------------------------
171 INTEGER I, J, NF1, IFLAG, NUPARAM,
172 . nuvar,imat,n1,n2,n3,nknot1,nknot2,nknot3,
173 . idx(mvsiz),idy(mvsiz),idz(mvsiz),ifunc(maxfunc),nfunc,iadbuf,
174 . ibid,istrain,ibidv(1),ilay,ierror,iad_knot,idfrstlocknt,
175 . idx2(mvsiz),idy2(mvsiz),idz2(mvsiz)
176C-----
177 INTEGER IPROP
178 my_real
179 .
180 . STI(MVSIZ) ,RHO0(MVSIZ)
181 my_real
182 . OFF(MVSIZ) ,
183 . xx(nctrl,nel),yy(nctrl,nel),zz(nctrl,nel),
184 . dx(nctrl,nel),dy(nctrl,nel),dz(nctrl,nel),
185 .
186 . vx(nctrl,nel),vy(nctrl,nel),vz(nctrl,nel),
187 .
188 . ww(nctrl,nel),rbid, zr, zs, zt
189
190 TYPE(g_bufel_) ,POINTER :: GBUF
191 TYPE(l_bufel_) ,POINTER :: LBUF
192
193 my_real,
194 . DIMENSION(:),POINTER :: UVAR
195 INTEGER MXT(MVSIZ),NGL(MVSIZ),NGEO(MVSIZ)
196 my_real
197 . VOLN(MVSIZ), VD2(MVSIZ) , DVOL(MVSIZ),DELTAX(MVSIZ),
198 . VIS(MVSIZ) , QVIS(MVSIZ), CXX(MVSIZ) ,
199 . S1(MVSIZ) , S2(MVSIZ) , S3(MVSIZ) ,
200 . S4(MVSIZ) , S5(MVSIZ) , S6(MVSIZ) ,
201 . d4(mvsiz) , d5(mvsiz) , d6(mvsiz) ,
202 .
203 .
204 .
205 . aj1(mvsiz) , aj2(mvsiz) , aj3(mvsiz) ,
206 . aj4(mvsiz) , aj5(mvsiz) , aj6(mvsiz),
207 . wxx(mvsiz) , wyy(mvsiz) , wzz(mvsiz),
208 . vdx(mvsiz) , vdy(mvsiz) , vdz(mvsiz),
209 . muvoid(mvsiz),ssp_eq(mvsiz),aire(mvsiz),
210 . sigy(mvsiz),et(mvsiz),r1_free(mvsiz),
211 . r3_free(mvsiz),defp(mvsiz),
212 . mfxx(mvsiz),mfxy(mvsiz),mfyx(mvsiz),
213 . mfyy(mvsiz),mfyz(mvsiz),mfzy(mvsiz),
214 . mfzz(mvsiz),mfzx(mvsiz),mfxz(mvsiz),
215 . gama(mvsiz,6),bid(mvsiz),tempel(mvsiz),die(mvsiz),
216 . stig(mvsiz,nctrl)
217C
218 my_real
219 . dxx(mvsiz), dyy(mvsiz), dzz(mvsiz),
220 . dxy(mvsiz), dxz(mvsiz), dyx(mvsiz),
221 . dyz(mvsiz), dzx(mvsiz), dzy(mvsiz),divde(mvsiz)
222
223 INTEGER ITEL, ITNCTRL, K, N, INCTRL
224 my_real,
225 . DIMENSION(NCTRL) :: R
226 my_real,
227 . DIMENSION(NCTRL,3) :: DRDXI
228 my_real,
229 . DIMENSION(NCTRL,MVSIZ) :: MATN
230 my_real,
231 . DIMENSION(3*NCTRL,MVSIZ) :: MATB
232 my_real,
233 . DIMENSION(MVSIZ) :: MATDET
234 my_real
235 . DETJAC, PGAUSS, VOLG(MVSIZ)
236 my_real
237 . BtDBAloc(3*NCTRL,MVSIZ),
238 . BA(6,MVSIZ),DBA(6,MVSIZ), Aloc(3*NCTRL,MVSIZ),
239 . MASS(NCTRL,MVSIZ),MMUNK(MVSIZ),KNOTLOCX(PX+1,NCTRL,MVSIZ),
240 . KNOTLOCY(PY+1,NCTRL,MVSIZ),KNOTLOCZ(PZ+1,NCTRL,MVSIZ),
241 . KNOTLOCELX(2,MVSIZ),
242 . knotlocely(2,mvsiz),knotlocelz(2,mvsiz)
243 my_real
244 . airenurbs(3), aface(6,mvsiz), tc,
245 . vmin(mvsiz), smax(mvsiz), sumv,amu(mvsiz)
246 my_real varnl(nel)
247 my_real,
248 . ALLOCATABLE, DIMENSION(:,:) :: vgauss
249 INTEGER SZ_IX
250C----------------------------------------------------------
251 double precision
252 . w_gauss(9,9),a_gauss(9,9),voldp(mvsiz)
253 DATA w_gauss /
254 1 2.d0 ,0.d0 ,0.d0 ,
255 1 0.d0 ,0.d0 ,0.d0 ,
256 1 0.d0 ,0.d0 ,0.d0 ,
257 2 1.d0 ,1.d0 ,0.d0 ,
258 2 0.d0 ,0.d0 ,0.d0 ,
259 2 0.d0 ,0.d0 ,0.d0 ,
260 3 0.555555555555556d0,0.888888888888889d0,0.555555555555556d0,
261 3 0.d0 ,0.d0 ,0.d0 ,
262 3 0.d0 ,0.d0 ,0.d0 ,
263 4 0.347854845137454d0,0.652145154862546d0,0.652145154862546d0,
264 4 0.347854845137454d0,0.d0 ,0.d0 ,
265 4 0.d0 ,0.d0 ,0.d0 ,
266 5 0.236926885056189d0,0.478628670499366d0,0.568888888888889d0,
267 5 0.478628670499366d0,0.236926885056189d0,0.d0 ,
268 5 0.d0 ,0.d0 ,0.d0 ,
269 6 0.171324492379170d0,0.360761573048139d0,0.467913934572691d0,
270 6 0.467913934572691d0,0.360761573048139d0,0.171324492379170d0,
271 6 0.d0 ,0.d0 ,0.d0 ,
272 7 0.129484966168870d0,0.279705391489277d0,0.381830050505119d0,
273 7 0.417959183673469d0,0.381830050505119d0,0.279705391489277d0,
274 7 0.129484966168870d0,0.d0 ,0.d0 ,
275 8 0.101228536290376d0,0.222381034453374d0,0.313706645877887d0,
276 8 0.362683783378362d0,0.362683783378362d0,0.313706645877887d0,
277 8 0.222381034453374d0,0.101228536290376d0,0.d0 ,
278 9 0.081274388361574d0,0.180648160694857d0,0.260610696402935d0,
279 9 0.312347077040003d0,0.330239355001260d0,0.312347077040003d0,
280 9 0.260610696402935d0,0.180648160694857d0,0.081274388361574d0/
281 DATA a_gauss /
282 1 0.d0 ,0.d0 ,0.d0 ,
283 1 0.d0 ,0.d0 ,0.d0 ,
284 1 0.d0 ,0.d0 ,0.d0 ,
285 2 -.577350269189625d0,0.577350269189625d0,0.d0 ,
286 2 0.d0 ,0.d0 ,0.d0 ,
287 2 0.d0 ,0.d0 ,0.d0 ,
288 3 -.774596669241483d0,0.d0 ,0.774596669241483d0,
289 3 0.d0 ,0.d0 ,0.d0 ,
290 3 0.d0 ,0.d0 ,0.d0 ,
291 4 -.861136311594053d0,-.339981043584856d0,0.339981043584856d0,
292 4 0.861136311594053d0,0.d0 ,0.d0 ,
293 4 0.d0 ,0.d0 ,0.d0 ,
294 5 -.906179845938664d0,-.538469310105683d0,0.d0 ,
295 5 0.538469310105683d0,0.906179845938664d0,0.d0 ,
296 5 0.d0 ,0.d0 ,0.d0 ,
297 6 -.932469514203152d0,-.661209386466265d0,-.238619186083197d0,
298 6 0.238619186083197d0,0.661209386466265d0,0.932469514203152d0,
299 6 0.d0 ,0.d0 ,0.d0 ,
300 7 -.949107912342759d0,-.741531185599394d0,-.405845151377397d0,
301 7 0.d0 ,0.405845151377397d0,0.741531185599394d0,
302 7 0.949107912342759d0,0.d0 ,0.d0 ,
303 8 -.960289856497536d0,-.796666477413627d0,-.525532409916329d0,
304 8 -.183434642495650d0,0.183434642495650d0,0.525532409916329d0,
305 8 0.796666477413627d0,0.960289856497536d0,0.d0 ,
306 9 -.968160239507626d0,-.836031107326636d0,-.613371432700590d0,
307 9 -.324253423403809d0,0.d0 ,0.324253423403809d0,
308 9 0.613371432700590d0,0.836031107326636d0,0.968160239507626d0/
309C-----------------------------------------------
310C S o u r c e L i n e s
311C=======================================================================
312 sz_ix=numelq+numels+nsvois ! Size of IX array (either IXS+NSVOIS or IXQ)
313 ibid = 0
314 ibidv = 0
315 istrain = 1
316 bid = zero
317 rbid = zero
318 gbuf => elbuf_tab(ng)%GBUF
319 uvar => elbuf_tab(ng)%BUFLY(1)%MAT(1,1,1)%VAR
320 iprop = iparg(62,ng)
321 ilay = 1
322 nf1=nft+1
323 knotlocx = zero
324 knotlocy = zero
325 knotlocz = zero
326 knotlocelx = zero
327 knotlocely = zero
328 knotlocelz = zero
329c a modifier
330 off = one
331 DO i=lft,llt
332 imat = kxig3d(1,i+nft)
333 ngeo(i)=kxig3d(2,i+nft)
334 mxt(i)=imat
335 vis(i)=zero
336 qvis(i)=zero
337 vdx(i)=zero
338 vdy(i)=zero
339 vdz(i)=zero
340 vd2(i)=zero
341c
342 DO j=1,nctrl
343 IF( j <= kxig3d(3,i+nft) ) THEN
344 xx(j,i)=x(1,ixig3d(kxig3d(4,i+nft)+j-1))
345 yy(j,i)=x(2,ixig3d(kxig3d(4,i+nft)+j-1))
346 zz(j,i)=x(3,ixig3d(kxig3d(4,i+nft)+j-1))
347 dx(j,i)=d(1,ixig3d(kxig3d(4,i+nft)+j-1))
348 dy(j,i)=d(2,ixig3d(kxig3d(4,i+nft)+j-1))
349 dz(j,i)=d(3,ixig3d(kxig3d(4,i+nft)+j-1))
350 vx(j,i)=v(1,ixig3d(kxig3d(4,i+nft)+j-1))
351 vy(j,i)=v(2,ixig3d(kxig3d(4,i+nft)+j-1))
352 vz(j,i)=v(3,ixig3d(kxig3d(4,i+nft)+j-1))
353 ww(j,i)=1!WIGE(IXIG3D(KXIG3D(4,I+NFT)+J-1))
354 DO k=1,px+1
355 knotlocx(k,j,i)=knotlocpc(k,1,(ngeo(i)-1)*numnod+ixig3d(kxig3d(4,i+nft)+j-1))
356 ENDDO
357 DO k=1,py+1
358 knotlocy(k,j,i)=knotlocpc(k,2,(ngeo(i)-1)*numnod+ixig3d(kxig3d(4,i+nft)+j-1))
359 ENDDO
360 DO k=1,pz+1
361 knotlocz(k,j,i)=knotlocpc(k,3,(ngeo(i)-1)*numnod+ixig3d(kxig3d(4,i+nft)+j-1))
362 ENDDO
363 ENDIF
364 ENDDO
365 ngl(i) = kxig3d(5,i+nft)
366 idx(i) = kxig3d(6,i+nft)
367 idy(i) = kxig3d(7,i+nft)
368 idz(i) = kxig3d(8,i+nft)
369 idx2(i) = kxig3d(9,i+nft)
370 idy2(i) = kxig3d(10,i+nft)
371 idz2(i) = kxig3d(11,i+nft)
372 knotlocelx(1,i) = knotlocel(1,1,i+nft)
373 knotlocely(1,i) = knotlocel(1,2,i+nft)
374 knotlocelz(1,i) = knotlocel(1,3,i+nft)
375 knotlocelx(2,i) = knotlocel(2,1,i+nft)
376 knotlocely(2,i) = knotlocel(2,2,i+nft)
377 knotlocelz(2,i) = knotlocel(2,3,i+nft)
378 rho0(i)= pm(1,imat)
379 ENDDO
380 iad_knot = igeo(40,iprop)
381 n1 = igeo(44,iprop)
382 n2 = igeo(45,iprop)
383 n3 = igeo(46,iprop)
384 idfrstlocknt = igeo(47,iprop)
385 nknot1 = n1+px
386 nknot2 = n2+py
387 nknot3 = n3+pz
388C-----------
389 iadbuf = ipm(7,imat)
390 nuvar = ipm(8,imat)
391 nuparam = ipm(9,imat)
392 nfunc = ipm(10,imat)
393 DO i=1,nfunc
394 ifunc(i) = ipm(10+i,imat)
395 ENDDO
396
397C-----------AMU for SP is not really implemented
398 IF (tt==zero) THEN
399 DO i=1,px
400 DO j=1,py
401 DO k=1,pz
402 lbuf => elbuf_tab(ng)%BUFLY(1)%LBUF(i,j,k)
403 lbuf%VOL0DP(lft:llt) = lbuf%VOL(lft:llt)
404 ENDDO
405 ENDDO
406 ENDDO ! END OF LOOP OVER INTEGRATION POINTS
407 END IF
408C------------------------------------------------------
409C INITIALIZATION OF VARIABLES
410C------------------------------------------------------
411
412 deltax=ep20
413 bid = zero
414 ibid = 0
415 tc = ep10
416 smax(:)=zero
417
418 ALLOCATE(vgauss(px*py*pz,mvsiz),stat=ierror)
419 IF(ierror/=0)THEN
420 CALL ancmsg(msgid=246,anmode=aninfo)
421 CALL arret(2)
422 END IF
423 vgauss(:,:)=zero
424
425 CALL ige3dzero(
426 1 nctrl, volg, gbuf%SIG, gbuf%EINT,
427 2 gbuf%RHO, gbuf%QVIS, fx, fy,
428 3 fz, btdbaloc, stig, mass,
429 4 mmunk, aface, vmin, gbuf%PLA,
430 5 gbuf%EPSD, gbuf%G_PLA, gbuf%G_EPSD,nel)
431
432 n=0
433 DO i=1,px
434 DO j=1,py
435 DO k=1,pz
436
437 n=n+1
438 zr = a_gauss(i,px)
439 zs = a_gauss(j,py)
440 zt = a_gauss(k,pz)
441 pgauss = w_gauss(i,px)*w_gauss(j,py)*w_gauss(k,pz)
442
443 lbuf => elbuf_tab(ng)%BUFLY(1)%LBUF(i,j,k)
444
445C------------------------------------------------------
446C CALCULATION OF SHAPE FUNCTIONS AND DERIVATIVES
447C------------------------------------------------------
448
449 DO itel=lft,llt
450
451c CALL IGE3DDERIV(
452c . ITEL ,N ,XX(:,ITEL),YY(:,ITEL),ZZ(:,ITEL),WW(:,ITEL),
453c . IDX(ITEL), IDY(ITEL), IDZ(ITEL), DRDXI, R, DETJAC,
454c . NCTRL, ZR, ZS, ZT, KNOT(IAD_KNOT+1), KNOT(IAD_KNOT+NKNOT1+1),
455c . KNOT(IAD_KNOT+NKNOT1+NKNOT2+1), PX-1, PY-1, PZ-1, 1)
456
457 CALL ig3donederiv(
458 1 itel ,n ,xx(:,itel) ,yy(:,itel),
459 2 zz(:,itel),ww(:,itel) ,idx(itel) ,idy(itel) ,
460 3 idz(itel) ,knotlocx(:,:,itel) ,knotlocy(:,:,itel),knotlocz(:,:,itel) ,
461 4 drdxi ,r ,detjac ,nctrl ,
462 5 zr ,zs ,zt ,knot(iad_knot+1),
463 6 knot(iad_knot+nknot1+1),knot(iad_knot+nknot1+nknot2+1),px-1,
464 7 py-1 ,pz-1 ,1 ,
465 8 idx2(itel),idy2(itel) ,idz2(itel) ,
466 9 knotlocelx(:,itel),knotlocely(:,itel),knotlocelz(:,itel))
467
468 voln(itel) = pgauss*detjac
469 vgauss(n,itel) = pgauss*detjac
470 volg(itel) = volg(itel) + voln(itel)
471
472 IF(idtmin(101)==1)THEN
473 DO itnctrl=1,nctrl
474 mass(itnctrl,itel)=mass(itnctrl,itel)+pm(89,mxt(itel))*r(itnctrl)*lbuf%VOL(itel)
475 ENDDO
476 ENDIF
477
478C------------------------------------------------------
479C ASSEMBLY OF THE MATB, MATN, MATDET MATRIX
480C------------------------------------------------------
481
482 CALL ig3dderishap(
483 . itel ,nctrl ,r ,drdxi ,
484 . detjac,matn ,matb ,matdet)
485
486 ENDDO
487
488C------------------------------------------------------
489C STRAIN RATE
490C------------------------------------------------------
491
492 CALL ige3ddefo(
493 1 vx, vy, vz, matb,
494 2 nctrl, wxx, wyy, wzz,
495 3 dxx, dyy, dzz, dxy,
496 4 dyx, dyz, dzy, dxz,
497 5 dzx, d4, d5, d6,
498 6 ba, aloc, nel)
499
500C------------------------------------------------------
501C RIGID BODY ROTATION OF PAST STRESSES
502C------------------------------------------------------
503
504 CALL srota3(
505 1 lbuf%SIG,s1, s2, s3,
506 2 s4, s5, s6, wxx,
507 3 wyy, wzz, nel, mtn,
508 4 iparg(9,ng))
509
510C------------------------------------------------------
511C CALCULATION OF CURRENT DENSITY
512C------------------------------------------------------
513 voldp(lft:llt) = voln(lft:llt)
514 divde(1:nel) = dt1*(dxx(1:nel)+ dyy(1:nel)+ dzz(1:nel))
515
516 CALL srho3(
517 1 pm, lbuf%VOL, lbuf%RHO, lbuf%EINT,
518 2 divde, flux(1,nf1), flu1(nf1), voln,
519 3 dvol, ngl, mxt, off,
520 4 iparg(64,ng),gbuf%TAG22, voldp, lbuf%VOL0DP,
521 5 amu, gbuf%OFF, nel, mtn,
522 6 jale, ismstr, jeul, jlag)
523
524c CALL SMALL3(GBUF%SMSTR,GBUF%OFF,OFF,WXX,WYY,
525c . WZZ,DXX,DYY,DZZ,GBUF%RHO,RHO0,
526c . DVOL,VOLN)
527
528C------------------------------------------------------
529C CALCULATION OF STRESSES
530C------------------------------------------------------
531
532 IF ((itask==0).AND.(imon_mat==1)) CALL startime(timers,35)
533 CALL mmain(timers, output,
534 1 elbuf_tab, ng, pm, geo,
535 2 ale_connect, ixs, iparg,
536 3 v, tf, npf, bufmat,
537 4 sti, x, dt2t, neltst,
538 5 ityptst, offset, nel, w,
539 6 off, ngeo, mxt, ngl,
540 7 voln, vd2, dvol, deltax,
541 8 vis, qvis, cxx, s1,
542 9 s2, s3, s4, s5,
543 a s6, dxx, dyy, dzz,
544 b d4, d5, d6, wxx,
545 c wyy, wzz, aj1, aj2,
546 d aj3, aj4, aj5, aj6,
547 e vdx, vdy, vdz, muvoid,
548 f ssp_eq, aire, sigy, et,
549 g r1_free, defp, r3_free, amu,
550 h mfxx, mfxy, mfxz, mfyx,
551 i mfyy, mfyz, mfzx, mfzy,
552 j mfzz, ipm, gama, bid,
553 k dxy, dyx, dyz, dzy,
554 l dzx, dxz, istrain, tempel,
555 m die, iexpan, ilay, mssa,
556 n dmels, i, j, k,
557 o table, bid, bid, bid,
558 p bid, iparg(1,ng), igeo, bid,
559 q itask, nloc_dmg, varnl, mat_elem,
560 r h3d_strain, jplasol, jsph, mvsiz,
561 s snpc, stf, sbufmat, glob_therm,
562 * svis, sz_ix, iresp,
563 t n2d, th_strain, ngroup, tt,
564 . dt1, ntable, numelq, nummat,
565 . numgeo, numnod, numels,
566 . idel7nok, idtmin, maxfunc,
567 . imon_mat, userl_avail, impl_s,
568 . idyna, dt ,bid ,sensors)
569
570 CALL sstra3(
571 1 dxx, dyy, dzz, d4,
572 2 d5, d6, lbuf%STRA,wxx,
573 3 wyy, wzz, off, nel,
574 4 jcvt)
575
576 IF ((itask==0).AND.(imon_mat==1)) CALL stoptime(timers,35)
577
578C------------------------------------------------------
579C FORCES INTERNES
580C------------------------------------------------------
581
582 CALL ig3dfint(
583 1 pm, mxt, kxig3d, lbuf%SIG,
584 2 nctrl, matb, fx, fy,
585 3 fz, voln, btdbaloc,dba,
586 4 ssp_eq, stig, nel, nft)
587
588 ENDDO
589 ENDDO
590 ENDDO ! END OF LOOP OVER INTEGRATION POINTS
591
592C-----------------------------
593C SMALL STRAIN
594C-----------------------------
595
596 CALL smallb3(
597 1 gbuf%OFF,off, nel, ismstr)
598
599C------------------------------------------------------
600c
601 n=0
602 DO i=1,px
603 DO j=1,py
604 DO k=1,pz
605
606 n=n+1
607 lbuf => elbuf_tab(ng)%BUFLY(1)%LBUF(i,j,k)
608
609 CALL ig3daverage(
610 1 lbuf%SIG, gbuf%SIG, lbuf%VOL, gbuf%VOL,
611 2 lbuf%RHO, lbuf%EINT, gbuf%EINT, gbuf%RHO,
612 3 vgauss(n,:),volg, lbuf%PLA, gbuf%PLA,
613 4 gbuf%G_PLA, lbuf%EPSD, gbuf%EPSD, nel,
614 5 iparg(40,ng))
615
616 ENDDO
617 ENDDO
618 ENDDO ! END OF LOOP OVER INTEGRATION POINTS
619c
620C------------------------------------------------------
621C BALANCES BY MATERIAL
622C------------------------------------------------------
623 iflag=mod(ncycle,ncpri)
624 IF (ioutprt>0)THEN
625 CALL ige3dbilan(partsav,gbuf%EINT,gbuf%RHO,volg,
626 . vx, vy, vz,iparts,gbuf%VOL,
627 . gresav,grth,igrth,
628 . xx, yy, zz, nctrl,itask,iparg(1,ng),
629 . sensors)
630 ENDIF
631
632C--------------------------------------------
633C CUMUL
634C--------------------------------------------
635
636 CALL ig3dcumu3(
637 1 ixig3d, kxig3d, nctrl, gbuf%OFF,
638 2 a, fx, fy, fz,
639 3 btdbaloc,stig, stifn, nel,
640 4 nft)
641
642
643
644C------------------------------------------------------
645C ELEMENT TIME STEP : NATURAL FREQUENCY PER ELEMENT
646C------------------------------------------------------
647
648 IF(idtmin(101)==1)THEN
649 DO i=lft,llt
650 DO j=1,nctrl
651 IF( j <= kxig3d(3,i+nft) ) THEN
652 mmunk(i) = min(mmunk(i),mass(j,i)/stig(i,j))
653 ENDIF
654 ENDDO
655 tc = sqrt(2*mmunk(i))
656 tc = dtfac1(101)*tc
657 IF(tc<dt2t)THEN
658 dt2t =tc
659 ityptst=101
660 neltst =ngl(i)
661 ENDIF
662 ENDDO
663
664C------------------------------------------------------
665C CALCULATION OF ELEMENT FACE AREAS
666C------------------------------------------------------
667
668 ELSEIF(idtmin(101)==2)THEN
669
670 n=0
671 DO i=1,px
672 DO j=1,py
673 n=n+1
674 zr = a_gauss(i,px)
675 zs = a_gauss(j,py)
676 zt = -one
677 pgauss = w_gauss(i,px)*w_gauss(j,py)
678
679 DO itel=lft,llt
680
681 CALL ige3daire(
682 . itel ,n ,xx(:,itel),yy(:,itel),zz(:,itel),ww(:,itel),
683 . idx(itel), idy(itel), idz(itel), airenurbs,
684 . nctrl, zr, zs, zt, knot(iad_knot+1), knot(iad_knot+nknot1+1),
685 . knot(iad_knot+nknot1+nknot2+1), px-1, py-1, pz-1)
686
687 aface(1,itel) = aface(1,itel) + airenurbs(1)*pgauss
688
689 ENDDO
690
691 zt = one
692
693 DO itel=lft,llt
694 CALL ige3daire(
695 . itel ,n ,xx(:,itel),yy(:,itel),zz(:,itel),ww(:,itel),
696 . idx(itel), idy(itel), idz(itel), airenurbs,
697 . nctrl, zr, zs, zt, knot(iad_knot+1), knot(iad_knot+nknot1+1),
698 . knot(iad_knot+nknot1+nknot2+1), px-1, py-1, pz-1)
699
700 aface(2,itel) = aface(2,itel) + airenurbs(1)*pgauss
701 ENDDO
702 ENDDO
703 ENDDO
704
705 n=0
706 DO i=1,px
707 DO k=1,pz
708 n=n+1
709 zs = -one
710 zr = a_gauss(i,px)
711 zt = a_gauss(k,pz)
712 pgauss = w_gauss(i,px)*w_gauss(k,pz)
713
714 DO itel=lft,llt
715 CALL ige3daire(
716 . itel ,n ,xx(:,itel),yy(:,itel),zz(:,itel),ww(:,itel),
717 . idx(itel), idy(itel), idz(itel), airenurbs,
718 . nctrl, zr, zs, zt, knot(iad_knot+1), knot(iad_knot+nknot1+1),
719 . knot(iad_knot+nknot1+nknot2+1), px-1, py-1, pz-1)
720
721 aface(3,itel) = aface(3,itel) + airenurbs(2)*pgauss
722 ENDDO
723
724 zs = one
725
726 DO itel=lft,llt
727 CALL ige3daire(
728 . itel ,n ,xx(:,itel),yy(:,itel),zz(:,itel),ww(:,itel),
729 . idx(itel), idy(itel), idz(itel), airenurbs,
730 . nctrl, zr, zs, zt, knot(iad_knot+1), knot(iad_knot+nknot1+1),
731 . knot(iad_knot+nknot1+nknot2+1), px-1, py-1, pz-1)
732
733 aface(4,itel) = aface(4,itel) + airenurbs(2)*pgauss
734 ENDDO
735 ENDDO
736 ENDDO
737
738 n=0
739 DO j=1,py
740 DO k=1,pz
741 n=n+1
742 zr = -one
743 zs = a_gauss(j,py)
744 zt = a_gauss(k,pz)
745 pgauss = w_gauss(j,py)*w_gauss(k,pz)
746
747 DO itel=lft,llt
748 CALL ige3daire(
749 . itel ,n ,xx(:,itel),yy(:,itel),zz(:,itel),ww(:,itel),
750 . idx(itel), idy(itel), idz(itel), airenurbs,
751 . nctrl, zr, zs, zt, knot(iad_knot+1), knot(iad_knot+nknot1+1),
752 . knot(iad_knot+nknot1+nknot2+1), px-1, py-1, pz-1)
753
754 aface(5,itel) = aface(5,itel) + airenurbs(3)*pgauss
755 ENDDO
756
757 zr = one
758
759 DO itel=lft,llt
760 CALL ige3daire(
761 . itel ,n ,xx(:,itel),yy(:,itel),zz(:,itel),ww(:,itel),
762 . idx(itel), idy(itel), idz(itel), airenurbs,
763 . nctrl, zr, zs, zt, knot(iad_knot+1), knot(iad_knot+nknot1+1),
764 . knot(iad_knot+nknot1+nknot2+1), px-1, py-1, pz-1)
765
766 aface(6,itel) = aface(6,itel) + airenurbs(3)*pgauss
767 ENDDO
768 ENDDO
769 ENDDO
770
771C------------------------------------------------------
772C PAS DE TEMPS ELEMENTAIRE : LONGUEUR CARACTERISTIQUE
773C------------------------------------------------------
774
775 DO itel=lft,llt
776 DO i=1,px
777 DO j=1,py
778 sumv=zero
779 DO k=1,pz
780 sumv=sumv+vgauss((j-1)*pz+(i-1)*pz*py+k,itel)
781 ENDDO
782 vmin(itel)=min(vmin(itel),sumv)
783 ENDDO
784 ENDDO
785
786 deltax(itel)=min(deltax(itel),px*py*vmin(itel)/max(aface(1,itel),aface(2,itel)))
787 vmin(itel)=ep10
788 sumv=zero
789
790 DO i=1,px
791 DO j=1,pz
792 sumv=zero
793 DO k=1,py
794 sumv=sumv+vgauss(j+(i-1)*py*pz+(k-1)*pz,itel)
795 ENDDO
796 vmin(itel)=min(vmin(itel),sumv)
797 ENDDO
798 ENDDO
799
800 deltax(itel)=min(deltax(itel),px*pz*vmin(itel)/max(aface(3,itel),aface(4,itel)))
801 vmin(itel)=ep10
802
803 DO i=1,py
804 DO j=1,pz
805 sumv=zero
806 DO k=1,px
807 sumv=sumv+vgauss(j+(i-1)*pz+(k-1)*py*pz,itel)
808 ENDDO
809 vmin(itel)=min(vmin(itel),sumv)
810 ENDDO
811 ENDDO
812
813 deltax(itel)=min(deltax(itel),pz*py*vmin(itel)/max(aface(5,itel),aface(6,itel)))
814 vmin(itel)=ep10
815 sumv=zero
816
817 ENDDO
818
819 DEALLOCATE(vgauss)
820 ENDIF
821
822C----------------------------
823
824C-----------
825 RETURN
826 END
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
ig3duforc3
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)
Definition ig3duforc3.F:86
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:225
dt_mod
Definition dt_mod.F:80
message_mod
Definition message_mod.F:1257
nlocal_reg_mod
Definition nlocal_reg_mod.F:119
table_mod
Definition table_mod.F:113
smallb3
subroutine smallb3(offg, off, nel, ismstr)
Definition smallb3.F:45
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:47
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:895
arret
subroutine arret(nn)
Definition arret.F:86
startime
subroutine startime(event, itask)
Definition timer.F:93
stoptime
subroutine stoptime(event, itask)
Definition timer.F:135
ale_connectivity_mod::t_ale_connectivity
Definition ale_connectivity_mod.F:256
table_mod::ttable
Definition table_mod.F:126