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!|| groupdef_mod ../common_source/modules/groupdef_mod.F
35!||====================================================================
36 SUBROUTINE eloff(IXS ,IXQ ,IXC ,IXP ,IXT ,
37 . IXR ,IXTG ,IPARG ,
38 . IACTIV ,TIME ,IFLAG ,NN ,ELBUF_TAB,
39 . X ,TEMP ,MCP ,PM ,IGROUPS ,
40 . MCP_OFF ,IGRBRIC ,IGRQUAD ,IGRSH4N ,IGRSH3N ,
41 . IGRTRUSS,IGRBEAM ,IGRSPRING,ITHERM_FE)
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.OR. IF (MLW == 0 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.AND. IF(ISOLNOD == 4 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.OR. IF (MLW == 0 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.AND. IF(ITHERM_FE > 0 IFORM == 2) THEN
419 FACVOL=ONE
420.AND. IF(ISOLNOD == 4 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.OR. IF (MLW == 0 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.OR. IF(IFLAG == 1 IFLAG == 0) DEALLOCATE(INDEX2)
622C----------
623 RETURN
624 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:42
groupdef_mod
Definition groupdef_mod.F:662