OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
eloff.F File Reference
#include "implicit_f.inc"
#include "mvsiz_p.inc"
#include "param_c.inc"
#include "units_c.inc"
#include "com01_c.inc"
#include "com04_c.inc"

Go to the source code of this file.

Functions/Subroutines

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)

Function/Subroutine Documentation

◆ eloff()

subroutine eloff ( integer, dimension(nixs,*) ixs,
integer, dimension(nixq,*) ixq,
integer, dimension(nixc,*) ixc,
integer, dimension(nixp,*) ixp,
integer, dimension(nixt,*) ixt,
integer, dimension(nixr,*) ixr,
integer, dimension(nixtg,*) ixtg,
integer, dimension(nparg,*) iparg,
integer, dimension(lactiv,*) iactiv,
time,
integer iflag,
integer nn,
type(elbuf_struct_), dimension(ngroup), target elbuf_tab,
x,
temp,
mcp,
pm,
integer, dimension(*) igroups,
mcp_off,
type (group_), dimension(ngrbric) igrbric,
type (group_), dimension(ngrquad) igrquad,
type (group_), dimension(ngrshel) igrsh4n,
type (group_), dimension(ngrsh3n) igrsh3n,
type (group_), dimension(ngrtrus) igrtruss,
type (group_), dimension(ngrbeam) igrbeam,
type (group_), dimension(ngrspri) igrspring,
integer, intent(in) itherm_fe )

Definition at line 36 of file eloff.F.

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