OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
eloff.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!|| eloff ../engine/source/elements/eloff.F
25!||--- called by ------------------------------------------------------
26!|| desacti ../engine/source/elements/desacti.F
27!||--- calls -----------------------------------------------------
28!|| s10nxt4 ../engine/source/elements/solid/solide10/s10nxt4.F
29!|| s4volume ../engine/source/elements/solid/solide4/s4volume.F
30!|| s8etemper ../engine/source/elements/solid/solide8e/s8etemper.F
31!|| s8evolume ../engine/source/elements/solid/solide8e/s8evolume.F
32!||--- uses -----------------------------------------------------
33!|| elbufdef_mod ../common_source/modules/mat_elem/elbufdef_mod.F90
34!|| element_mod ../common_source/modules/elements/element_mod.F90
35!|| groupdef_mod ../common_source/modules/groupdef_mod.F
36!||====================================================================
37 SUBROUTINE eloff(IXS ,IXQ ,IXC ,IXP ,IXT ,
38 . IXR ,IXTG ,IPARG ,
39 . IACTIV ,TIME ,IFLAG ,NN ,ELBUF_TAB,
40 . X ,TEMP ,MCP ,PM ,IGROUPS ,
41 . MCP_OFF ,IGRBRIC ,IGRQUAD ,IGRSH4N ,IGRSH3N ,
42 . IGRTRUSS,IGRBEAM ,IGRSPRING,ITHERM_FE)
43C-----------------------------------------------
44C M o d u l e s
45C-----------------------------------------------
46 USE elbufdef_mod
47 USE groupdef_mod
48 use element_mod , only : nixs,nixq,nixc,nixt,nixr,nixp,nixtg
49C-----------------------------------------------
50C I m p l i c i t T y p e s
51C-----------------------------------------------
52#include "implicit_f.inc"
53C-----------------------------------------------
54C G l o b a l P a r a m e t e r s
55C-----------------------------------------------
56#include "mvsiz_p.inc"
57C-----------------------------------------------
58C C o m m o n B l o c k s
59C-----------------------------------------------
60#include "param_c.inc"
61#include "units_c.inc"
62#include "com01_c.inc"
63#include "com04_c.inc"
64C-----------------------------------------------
65C D u m m y A r g u m e n t s
66C-----------------------------------------------
67 INTEGER ,INTENT(IN) :: ITHERM_FE
68 INTEGER IACTIV(LACTIV,*),IPARG(NPARG,*),
69 . IXS(NIXS,*), IXQ(NIXQ,*),IXC(NIXC,*),
70 . IXT(NIXT,*),IXP(NIXP,*), IXR(NIXR,*), IXTG(NIXTG,*),
71 . IGROUPS(*)
72 INTEGER IFLAG, NN
73 my_real time, x(3,*), temp(*), mcp(*), pm(npropm,*),mcp_off(*)
74 TYPE(elbuf_struct_), DIMENSION(NGROUP), TARGET :: ELBUF_TAB
75C IFLAG==0 : activation
76C IFLAG==1 : deactivation
77C IFLAG==-1 : set MCP_OFF(i) = 0 to all nodes that belong only to
78C deactiavted solids
79C-----------------------------------------------
80 TYPE (GROUP_) , DIMENSION(NGRBRIC) :: IGRBRIC
81 TYPE (GROUP_) , DIMENSION(NGRQUAD) :: IGRQUAD
82 TYPE (GROUP_) , DIMENSION(NGRSHEL) :: IGRSH4N
83 TYPE (GROUP_) , DIMENSION(NGRSH3N) :: IGRSH3N
84 TYPE (GROUP_) , DIMENSION(NGRTRUS) :: IGRTRUSS
85 TYPE (GROUP_) , DIMENSION(NGRBEAM) :: IGRBEAM
86 TYPE (GROUP_) , DIMENSION(NGRSPRI) :: IGRSPRING
87C-----------------------------------------------
88C L o c a l V a r i a b l e s
89C-----------------------------------------------
90 INTEGER I,II,J,NG,NEL,MLW,NFT,ITY,IGOF,
91 . igsh,igsh3,igbr,igqu,igbm,igtr,igsp,
92 . jthe, iform, isolnod, itetra4
93 INTEGER NELA,NPTR,NPTS,NPTT,IR,IS,IT,IP,K,KK
94 INTEGER INDEX(MVSIZ)
95 INTEGER NC1(MVSIZ), NC2(MVSIZ), NC3(MVSIZ), NC4(MVSIZ),
96 . NC5(MVSIZ), NC6(MVSIZ), NC7(MVSIZ), NC8(MVSIZ)
97 my_real VOLGN(MVSIZ), VOLPN(MVSIZ,8), TEMPN(MVSIZ,8), MCPS, RHOCP
98 my_real nxt4(mvsiz,4,4), facvol
99 my_real, DIMENSION(:), POINTER :: offg
100 my_real, DIMENSION(:), POINTER :: volg
101 my_real, DIMENSION(:), POINTER :: volp
102 my_real, DIMENSION(:), POINTER :: teip
103 INTEGER, DIMENSION(:,:), ALLOCATABLE :: INDEX2
104C======================================================================|
105 IF( iflag == 0 .OR. iflag == 1) THEN
106 igbr = iactiv(3,nn)
107 igqu = iactiv(4,nn)
108 igsh = iactiv(5,nn)
109 igtr = iactiv(6,nn)
110 igbm = iactiv(7,nn)
111 igsp = iactiv(8,nn)
112 igsh3 = iactiv(9,nn)
113 iform = iactiv(10,nn)
114
115 ALLOCATE(index2(1+mvsiz,ngroup))
116 index2=0
117 ENDIF
118C
119 IF (iflag==0) THEN
120C------------------------------
121C ELEMENT ACTIVATION
122C------------------------------
123
124 IF (igbr /= 0) THEN
125 DO j=1,igrbric(igbr)%NENTITY
126 ii = igrbric(igbr)%ENTITY(j)
127 ng = igroups(ii)
128 nft= iparg(3,ng)
129 mlw=iparg(1,ng)
130 IF (mlw == 0 .OR. mlw == 13) cycle ! law0, no off
131 i = ii - nft
132 index2(1,ng) = index2(1,ng) + 1
133 nela = index2(1,ng)
134 index2(nela+1,ng) = i
135 WRITE(iout,'(A,I10,A,G13.5)')' BRICK ACTIVATION:',ixs(11,ii),' AT TIME:',time
136 offg => elbuf_tab(ng)%GBUF%OFF
137 offg(i) = one
138 ENDDO
139 ENDIF
140
141 DO ng=1,ngroup
142 mlw=iparg(1,ng)
143 nel=iparg(2,ng)
144 nft=iparg(3,ng)
145 ity=iparg(5,ng)
146 jthe=iparg(13,ng)
147 IF (mlw == 0 .OR. mlw == 13) cycle ! law0, no off
148C
149 IF(ity==1)THEN
150C--- ELEMENTS SOLIDES
151 isolnod=iparg(28,ng)
152 itetra4=iparg(41,ng)
153 offg => elbuf_tab(ng)%GBUF%OFF
154 nela = index2(1,ng)
155 index(1:nela) = index2(2:nela+1,ng)
156
157 IF(nela == 0) cycle
158C
159 IF(itherm_fe > 0) THEN
160 volg => elbuf_tab(ng)%GBUF%VOL
161 nptr = elbuf_tab(ng)%NPTR
162 npts = elbuf_tab(ng)%NPTS
163 nptt = elbuf_tab(ng)%NPTT
164 facvol=one
165 IF(isolnod == 4 .AND. itetra4 == 1) facvol=four
166
167 DO i=1,nela
168 j=index(i)+nft
169 nc1(i)=ixs(2,j)
170 nc2(i)=ixs(3,j)
171 nc3(i)=ixs(4,j)
172 nc4(i)=ixs(5,j)
173 nc5(i)=ixs(6,j)
174 nc6(i)=ixs(7,j)
175 nc7(i)=ixs(8,j)
176 nc8(i)=ixs(9,j)
177
178 mcp_off(nc1(i)) = one
179 mcp_off(nc2(i)) = one
180 mcp_off(nc3(i)) = one
181 mcp_off(nc4(i)) = one
182 mcp_off(nc5(i)) = one
183 mcp_off(nc6(i)) = one
184 mcp_off(nc7(i)) = one
185 mcp_off(nc8(i)) = one
186 ENDDO
187
188 IF(iform == 2) THEN
189 rhocp=pm(69,ixs(1,1+nft))
190 DO i=1,nela
191 j=index(i)
192 mcps=one_over_8*rhocp*volg(j)*facvol
193 mcp(nc1(i)) = mcp(nc1(i)) + mcps
194 mcp(nc2(i)) = mcp(nc2(i)) + mcps
195 mcp(nc3(i)) = mcp(nc3(i)) + mcps
196 mcp(nc4(i)) = mcp(nc4(i)) + mcps
197 mcp(nc5(i)) = mcp(nc5(i)) + mcps
198 mcp(nc6(i)) = mcp(nc6(i)) + mcps
199 mcp(nc7(i)) = mcp(nc7(i)) + mcps
200 mcp(nc8(i)) = mcp(nc8(i)) + mcps
201 ENDDO
202 ENDIF
203
204C--- VOLUME AT ACTIVATION TIME IS UPDATED TO CURRENT VOLUME
205C--- TEMPERATURE AT ACTIVATION TIME
206 IF(isolnod == 4) THEN
207 DO i=1,nela
208 j=index(i)+nft
209 nc1(i)=ixs(2,j)
210 nc2(i)=ixs(4,j)
211 nc3(i)=ixs(7,j)
212 nc4(i)=ixs(6,j)
213 ENDDO
214 CALL s4volume(x, volgn, nela, nc1, nc2, nc3, nc4)
215
216 IF(itetra4 == 1) THEN
217 IF(jthe < 0) CALL s10nxt4(nxt4,nela)
218 DO ip=1,nptr
219 DO i=1,nela
220 volpn(i,ip) = fourth*volgn(i)
221 IF(jthe >= 0 ) cycle
222 tempn(i,ip) = nxt4(i,1,ip)*temp(nc1(i))+nxt4(i,2,ip)*temp(nc2(i))+
223 . nxt4(i,3,ip)*temp(nc3(i))+nxt4(i,4,ip)*temp(nc4(i))
224 ENDDO
225 ENDDO
226 ELSE
227 DO i=1,nela
228 volpn(i,1) = volgn(i)
229 IF(jthe >= 0 ) cycle
230 tempn(i,1) = fourth*(temp(nc1(i))+temp(nc2(i))+temp(nc3(i))+temp(nc4(i)))
231 ENDDO
232 ENDIF
233 ELSE
234 CALL s8evolume(x, volgn, volpn, nela, nptr, npts, nptt,
235 . nc1, nc2, nc3, nc4, nc5, nc6, nc7, nc8 )
236 IF(jthe < 0 ) THEN
237 CALL s8etemper(temp, tempn, nela, nptr, npts, nptt,
238 . nc1, nc2, nc3, nc4, nc5, nc6, nc7, nc8 )
239 ENDIF
240 ENDIF
241C
242 DO i=1,nela
243 j=index(i)
244 volg(j) = volgn(i)/facvol
245 ENDDO
246C
247 DO ir=1,nptr
248 DO is=1,npts
249 DO it=1,nptt
250 ip = ir + ( (is-1) + (it-1)*npts )*nptr
251 volp => elbuf_tab(ng)%BUFLY(1)%LBUF(ir,is,it)%VOL
252 IF(jthe < 0 ) teip => elbuf_tab(ng)%BUFLY(1)%LBUF(ir,is,it)%TEMP
253 DO i=1,nela
254 j=index(i)
255 volp(j) = volpn(i,ip)
256 IF(jthe < 0 ) teip(j) = tempn(i,ip)
257 ENDDO
258 ENDDO
259 ENDDO
260 ENDDO
261 ENDIF
262
263C--- TEST POUR L'ACTIVATION D'ONE GROUPE
264 igof = 1
265 DO i = 1,nel
266 IF (offg(i) /= zero) igof=0
267 ENDDO
268 iparg(8,ng) = igof
269
270
271 ELSEIF(ity==2) THEN
272C--- ELEMENTS QUADS
273 offg => elbuf_tab(ng)%GBUF%OFF
274 DO i=1,nel
275 ii=i+nft
276 IF (igqu /= 0) THEN
277 DO j=1,igrquad(igqu)%NENTITY
278 IF (ii == igrquad(igqu)%ENTITY(j)) THEN
279 offg(i) = one
280 WRITE(iout,'(A,I10,A,G13.5)')' QUAD ACTIVATION:',ixq(7,ii),' AT TIME:',time
281 ENDIF
282 ENDDO
283 ENDIF
284 ENDDO
285C--- TEST POUR L'ACTIVATION D'ONE GROUPE
286 igof = 1
287 DO i = 1,nel
288 IF (offg(i) /= zero) igof=0
289 ENDDO
290 iparg(8,ng) = igof
291
292 ELSEIF(ity==3)THEN
293C--- ELEMENTS COQUES
294 offg => elbuf_tab(ng)%GBUF%OFF
295 DO i=1,nel
296 ii=i+nft
297 IF (igsh /= 0) THEN
298 DO j=1,igrsh4n(igsh)%NENTITY
299 IF (ii == igrsh4n(igsh)%ENTITY(j)) THEN
300 offg(i) = abs(offg(i))
301 WRITE(iout,'(A,I10,A,G13.5)')' SHELL ACTIVATION:',ixc(7,ii),' AT TIME:',time
302 ENDIF
303 ENDDO
304 ENDIF
305 ENDDO
306C--- TEST POUR L'ACTIVATION D'ONE GROUPE
307 igof = 1
308 DO i = 1,nel
309 IF (offg(i) > zero) igof=0
310 ENDDO
311 iparg(8,ng) = igof
312
313 ELSEIF(ity==4) THEN
314C--- ELEMENTS TRUSS
315 offg => elbuf_tab(ng)%GBUF%OFF
316 DO i=1,nel
317 ii=i+nft
318 IF (igtr /= 0) THEN
319 DO j=1,igrtruss(igtr)%NENTITY
320 IF (ii == igrtruss(igtr)%ENTITY(j)) THEN
321 offg(i)= one
322 WRITE(iout,'(A,I10,A,G13.5)')' TRUSS ACTIVATION:',ixt(5,ii),' AT TIME:',time
323 ENDIF
324 ENDDO
325 ENDIF
326 ENDDO
327C--- TEST POUR L'ACTIVATION D'ONE GROUPE
328 igof = 1
329 DO i = 1,nel
330 IF (offg(i) /= zero) igof=0
331 ENDDO
332 iparg(8,ng) = igof
333
334 ELSEIF(ity==5) THEN
335C--- ELEMENTS POUTRES
336 offg => elbuf_tab(ng)%GBUF%OFF
337 DO i=1,nel
338 ii=i+nft
339 IF (igbm /= 0) THEN
340 DO j=1,igrbeam(igbm)%NENTITY
341 IF (ii == igrbeam(igbm)%ENTITY(j)) THEN
342 offg(i)= one
343 WRITE(iout,'(A,I10,A,G13.5)')' BEAM ACTIVATION:',ixp(6,ii),' AT TIME:',time
344 ENDIF
345 ENDDO
346 ENDIF
347 ENDDO
348C--- TEST POUR L'ACTIVATION D'ONE GROUPE
349 igof = 1
350 DO i = 1,nel
351 IF(offg(i) > zero) igof=0
352 ENDDO
353 iparg(8,ng) = igof
354
355 ELSEIF(ity==6) THEN
356C--- ELEMENTS RESSORTS
357 offg => elbuf_tab(ng)%GBUF%OFF
358! *-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*
359! We need to compute the local referentiel for spring
360! --> even if off(1:mvsiz)=1, IPARG(8) = 0
361! *-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*
362 DO i=1,nel
363 ii=i+nft
364 IF (igsp /= 0) THEN
365 DO j=1,igrspring(igsp)%NENTITY
366 IF (ii == igrspring(igsp)%ENTITY(j)) THEN
367 offg(i)= one
368 WRITE(iout,'(A,I10,A,G13.5)')' SPRING ACTIVATION:',ixr(nixr,ii),' AT TIME:',time
369 ENDIF
370 ENDDO
371 ENDIF
372 ENDDO
373 igof = 0
374 iparg(8,ng) = igof
375
376 ELSEIF(ity==7)THEN
377C--- ELEMENTS COQUES 3N
378 offg => elbuf_tab(ng)%GBUF%OFF
379 DO i=1,nel
380 ii=i+nft
381 IF (igsh3 /= 0) THEN
382 DO j=1,igrsh3n(igsh3)%NENTITY
383 IF (ii == igrsh3n(igsh3)%ENTITY(j)) THEN
384 offg(i) = one
385 WRITE(iout,'(A,I10,A,G13.5)')' SH_3N ACTIVATION:',ixtg(6,ii),' AT TIME:',time
386 ENDIF
387 ENDDO
388 ENDIF
389 ENDDO
390C--- TEST POUR L'ACTIVATION D'ONE GROUPE
391 igof = 1
392 DO i = 1,nel
393 IF (offg(i) /= zero) igof=0
394 ENDDO
395 iparg(8,ng) = igof
396C
397 ENDIF
398 ENDDO
399 ELSE IF (iflag == 1) THEN
400C-----------------------
401C ELEMENT DEACTIVATION
402C-----------------------
403! Solids
404 IF (igbr /= 0) THEN
405 DO j=1,igrbric(igbr)%NENTITY
406 ii = igrbric(igbr)%ENTITY(j)
407 ng = igroups(ii)
408 offg => elbuf_tab(ng)%GBUF%OFF
409 volg => elbuf_tab(ng)%GBUF%VOL
410 mlw=iparg(1,ng)
411 nel=iparg(2,ng)
412 nft=iparg(3,ng)
413 ity=iparg(5,ng)
414 isolnod=iparg(28,ng)
415 itetra4=iparg(41,ng)
416 IF (mlw == 0 .OR. mlw == 13) cycle ! law0, no off
417 i = ii - nft
418 offg(i) = zero
419 WRITE(iout,'(A,I10,A,G13.5)')' BRICK DEACTIVATION:',ixs(11,ii),' AT TIME:',time
420 IF(itherm_fe > 0 .AND. iform == 2) THEN
421 facvol=one
422 IF(isolnod == 4 .AND. itetra4 == 1) facvol=four
423 rhocp=pm(69,ixs(1,ii))
424 mcps=one_over_8*rhocp*volg(i)*facvol
425 DO k=2,9
426 kk = ixs(k,ii)
427 mcp(kk) = mcp(kk) - mcps
428 ENDDO
429 ENDIF
430 ENDDO
431 ENDIF
432
433 DO ng=1,ngroup
434 mlw=iparg(1,ng)
435 nel=iparg(2,ng)
436 nft=iparg(3,ng)
437 ity=iparg(5,ng)
438 IF (mlw == 0 .OR. mlw == 13) cycle ! law0, no off
439 IF(ity==1) THEN
440C--- ELEMENTS SOLIDES
441 offg => elbuf_tab(ng)%GBUF%OFF
442 volg => elbuf_tab(ng)%GBUF%VOL
443C--- TEST POUR L'ELIMINATION D'ONE GROUPE
444 igof = 1
445 DO i = 1,nel
446 IF (offg(i) > zero) igof=0
447 ENDDO
448 iparg(8,ng) = igof
449
450 ELSEIF(ity==2) THEN
451C--- ELEMENTS QUADS
452 offg => elbuf_tab(ng)%GBUF%OFF
453 DO i=1,nel
454 ii=i+nft
455 IF (igqu /= 0) THEN
456 DO j=1,igrquad(igqu)%NENTITY
457 IF (ii == igrquad(igqu)%ENTITY(j)) THEN
458 offg(i) = zero
459 WRITE(iout,'(A,I10,A,G13.5)')' QUAD DEACTIVATION:',ixq(7,ii),' AT TIME:',time
460 ENDIF
461 ENDDO
462 ENDIF
463 ENDDO
464C--- TEST POUR L'ELIMINATION D'ONE GROUPE
465 igof = 1
466 DO i = 1,nel
467 IF (offg(i) /= zero) igof=0
468 ENDDO
469 iparg(8,ng) = igof
470
471 ELSEIF(ity==3) THEN
472C--- ELEMENTS COQUES
473 offg => elbuf_tab(ng)%GBUF%OFF
474 DO i=1,nel
475 ii=i+nft
476 IF (igsh /= 0) THEN
477 DO j=1,igrsh4n(igsh)%NENTITY
478 IF (ii == igrsh4n(igsh)%ENTITY(j)) THEN
479 offg(i) = -abs(offg(i))
480C
481 WRITE(iout,'(A,I10,A,G13.5)')' SHELL DEACTIVATION:',ixc(7,ii),' AT TIME:',time
482 ENDIF
483 ENDDO
484 ENDIF
485 ENDDO
486C--- TEST POUR L'ELIMINATION D'ONE GROUPE
487 igof = 1
488 DO i = 1,nel
489 IF (offg(i) > zero) igof=0
490 ENDDO
491 iparg(8,ng) = igof
492
493 ELSEIF(ity==4) THEN
494C--- ELEMENTS TRUSS
495 offg => elbuf_tab(ng)%GBUF%OFF
496 DO i=1,nel
497 ii=i+nft
498 IF (igtr /= 0) THEN
499 DO j=1,igrtruss(igtr)%NENTITY
500 IF (ii == igrtruss(igtr)%ENTITY(j)) THEN
501 offg(i)= zero
502 WRITE(iout,'(A,I10,A,G13.5)')' TRUSS DEACTIVATION:',ixt(5,ii),' AT TIME:',time
503 ENDIF
504 ENDDO
505 ENDIF
506 ENDDO
507C--- TEST POUR L'ELIMINATION D'ONE GROUPE
508 igof = 1
509 DO i = 1,nel
510 IF(offg(i) /= zero) igof=0
511 ENDDO
512 iparg(8,ng) = igof
513
514 ELSEIF(ity==5) THEN
515C--- ELEMENTS POUTRES
516 offg => elbuf_tab(ng)%GBUF%OFF
517 DO i=1,nel
518 ii=i+nft
519 IF (igbm /= 0) THEN
520 DO j=1,igrbeam(igbm)%NENTITY
521 IF (ii == igrbeam(igbm)%ENTITY(j)) THEN
522 offg(i)= zero
523 WRITE(iout,'(A,I10,A,G13.5)')' BEAM DEACTIVATION:',ixp(6,ii),' AT TIME:',time
524 ENDIF
525 ENDDO
526 ENDIF
527 ENDDO
528C--- TEST POUR L'ELIMINATION D'ONE GROUPE
529 igof = 1
530 DO i = 1,nel
531 IF(offg(i) > zero) igof=0
532 ENDDO
533 iparg(8,ng) = igof
534
535 ELSEIF(ity==6) THEN
536C--- ELEMENTS RESSORTS
537 offg => elbuf_tab(ng)%GBUF%OFF
538! *-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*
539! We need to compute the local referentiel for spring
540! --> even if off(1:mvsiz)=1, IPARG(8) = 0
541! *-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*
542 DO i=1,nel
543 ii=i+nft
544 IF (igsp /= 0) THEN
545 DO j=1,igrspring(igsp)%NENTITY
546 IF (ii == igrspring(igsp)%ENTITY(j)) THEN
547 offg(i)= zero
548 WRITE(iout,'(A,I10,A,G13.5)')' SPRING DEACTIVATION:',ixr(nixr,ii),' AT TIME:',time
549 ENDIF
550 ENDDO
551 ENDIF
552 ENDDO
553C---
554 igof = 0
555 iparg(8,ng) = igof
556
557 ELSEIF(ity==7) THEN
558C--- ELEMENTS COQUES 3N
559 offg => elbuf_tab(ng)%GBUF%OFF
560 DO i=1,nel
561 ii=i+nft
562 IF (igsh3 /= 0) THEN
563 DO j=1,igrsh3n(igsh3)%NENTITY
564 IF (ii == igrsh3n(igsh3)%ENTITY(j)) THEN
565 offg(i) = zero
566 WRITE(iout,'(A,I10,A,G13.5)')' SH_3N DEACTIVATION:',ixtg(6,ii),' AT TIME:',time
567 ENDIF
568 ENDDO
569 ENDIF
570 ENDDO
571C--- TEST POUR L'ELIMINATION D'ONE GROUPE
572 igof = 1
573 DO i = 1,nel
574 IF (offg(i) /= zero) igof=0
575 ENDDO
576 iparg(8,ng) = igof
577C----------------------------------------
578 ENDIF
579 ENDDO
580 ELSE ! IFLAG == -1
581 IF(itherm_fe > 0 ) THEN
582C Set MCP_OFF(i) == 0 if all solids connected to i are deactivated
583 mcp_off(1:numnod) = one
584 DO ii = 1,numels
585 ng = igroups(ii)
586 offg => elbuf_tab(ng)%GBUF%OFF
587 mlw=iparg(1,ng)
588 nel=iparg(2,ng)
589 nft=iparg(3,ng)
590 ity=iparg(5,ng)
591 i = ii - nft
592 IF(offg(i) == 0) THEN
593 ! put 0 to nodes that belong to at least one
594 ! deactivated element
595 DO k=2,9
596 kk = ixs(k,ii)
597 mcp_off(kk) = 0.0
598 ENDDO
599 ENDIF
600 ENDDO
601 DO ii = 1,numels
602 ng = igroups(ii)
603 offg => elbuf_tab(ng)%GBUF%OFF
604 mlw=iparg(1,ng)
605 nel=iparg(2,ng)
606 nft=iparg(3,ng)
607 ity=iparg(5,ng)
608 i = ii - nft
609 IF(offg(i) /= 0) THEN
610 ! put one to all nodes that belong to at least one
611 ! activated element
612 DO k=2,9
613 kk = ixs(k,ii)
614 mcp_off(kk) = one
615 ENDDO
616 ENDIF
617 ENDDO
618 ENDIF ! ITHERM_FE
619
620 ENDIF
621
622
623 IF(iflag == 1 .OR. iflag == 0) DEALLOCATE(index2)
624C----------
625 RETURN
626 END
my_real
#define my_real
Definition cppsort.cpp:32
eloff
subroutine eloff(ixs, ixq, ixc, ixp, ixt, ixr, ixtg, iparg, iactiv, time, iflag, nn, elbuf_tab, x, temp, mcp, pm, igroups, mcp_off, igrbric, igrquad, igrsh4n, igrsh3n, igrtruss, igrbeam, igrspring, itherm_fe)
Definition eloff.F:43
groupdef_mod
Definition groupdef_mod.F:668
s10nxt4
subroutine s10nxt4(nx, nel)
Definition s10nxt4.F:30
s4volume
subroutine s4volume(x, vol, nel, nc1, nc2, nc3, nc4)
Definition s4volume.F:30
s8etemper
subroutine s8etemper(temp, tempel, nela, nptr, npts, nptt, nc1, nc2, nc3, nc4, nc5, nc6, nc7, nc8)
Definition s8etemper.F:30
s8evolume
subroutine s8evolume(x, volg, volp, nela, nptr, npts, nptt, nc1, nc2, nc3, nc4, nc5, nc6, nc7, nc8)
Definition s8evolume.F:31