OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
pres_stackgroup.F File Reference
#include "implicit_f.inc"
#include "com01_c.inc"
#include "scr03_c.inc"
#include "com04_c.inc"
#include "units_c.inc"
#include "warn_c.inc"
#include "param_c.inc"
#include "remesh_c.inc"
#include "sphcom.inc"
#include "drape_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine pre_stackgroup (igrsh3n, igrsh4n, ixc, ixtg, igeo, geo, igeo_stack, iworksh, iwork_t)

Function/Subroutine Documentation

◆ pre_stackgroup()

subroutine pre_stackgroup ( type (group_), dimension(ngrsh3n) igrsh3n,
type (group_), dimension(ngrshel) igrsh4n,
integer, dimension(nixc,numelc) ixc,
integer, dimension(nixtg,numeltg) ixtg,
integer, dimension(npropgi,numgeo) igeo,
geo,
integer, dimension(npropgi,numstack + numply) igeo_stack,
integer, dimension(3,numelc+numeltg) iworksh,
type(drape_work_), dimension(numelc + numeltg), target iwork_t )

Definition at line 35 of file pres_stackgroup.F.

39C-----------------------------------------------
40C M o d u l e s
41C-----------------------------------------------
42 USE submodel_mod
43 USE stack_mod
44 USE message_mod
45 USE groupdef_mod
46 USE drape_mod
47 USE names_and_titles_mod , ONLY : nchartitle
48C-----------------------------------------------
49C I m p l i c i t T y p e s
50C-----------------------------------------------
51#include "implicit_f.inc"
52C-----------------------------------------------
53C C o m m o n B l o c k s
54C-----------------------------------------------
55#include "com01_c.inc"
56#include "scr03_c.inc"
57#include "com04_c.inc"
58#include "units_c.inc"
59#include "warn_c.inc"
60#include "param_c.inc"
61#include "remesh_c.inc"
62#include "sphcom.inc"
63#include "drape_c.inc"
64C-----------------------------------------------
65C D u m m y A r g u m e n t s
66C-----------------------------------------------
67 INTEGER IXC(NIXC,NUMELC),
68 . IXTG(NIXTG,NUMELTG),IGEO(NPROPGI,NUMGEO),IWORKSH(3,NUMELC+NUMELTG),
69 . IGEO_STACK(NPROPGI,NUMSTACK + NUMPLY)
70 my_real
71 . geo(npropg,numgeo)
72C-----------------------------------------------
73 TYPE (GROUP_) , DIMENSION(NGRSH3N) :: IGRSH3N
74 TYPE (GROUP_) , DIMENSION(NGRSHEL) :: IGRSH4N
75 TYPE(DRAPE_WORK_) , DIMENSION(NUMELC + NUMELTG) , TARGET :: IWORK_T
76C-----------------------------------------------
77C L o c a l V a r i a b l e s
78C-----------------------------------------------
79 INTEGER I,J,II,NSTACK,NPLY,IGTYP,ID,JD,IDPLY,NEL,
80 . IAD,ITY,IDSHEL,PID,IS,IDS,NSH,MODE,NS,JJ,NGEO_STACK,
81 . IGRTYP,N1,IIGEO,NSS,IPPOS,NPT,IIS,NP,
82 . JJPID,JSTACK,JPID,ITG,IPMAT_IPLY,ISH3N,J4N,J3N,IPOS,
83 . MAT_LY,NLAY,NPTT,IPIDL,IT,ILAY,IPTHK_NPTT,IPPOS_NPTT,
84 . IINT,IPID_LY,IPDIR ,NS_STACK0 ,NPT_STACK0,IS0,JS,PIDS,IP,
85 . II1,II2,JJ1,JJ2
86
87 INTEGER , DIMENSION(NUMGEO+NUMPLY) :: IPIDPLY,IDGR4N,IDGR3N
88
89 INTEGER :: NBFI,IPPID, NGL,IPID_1,NUMS,IPWEIGHT,IPTHKLY,NSHQ4,NSHT3
90
91 INTEGER, DIMENSION(:,:), ALLOCATABLE :: ITRI
92 INTEGER, DIMENSION (:) ,ALLOCATABLE ::ICSH,INDX
93 CHARACTER(LEN=NCHARTITLE) :: TITR,TITR1
94C----------------------------f-------------------
95C=======================================================================
96C For Shell
97C-----------------------------------------------
98 IF(ipart_stack > 0) THEN
99 nply = 0
100 nstack = 0
101C
102 ipidply = 0
103 idgr4n = 0
104 idgr3n = 0
105 DO i = 1, numgeo
106!! ISUBSTACK(I)= 0
107 igtyp=igeo(11,i)
108 nstack = igeo(42,i) ! number of stack where ply is attached
109 IF (igtyp == 19 .AND. nstack > 0) THEN
110 nply = nply+1
111 ipidply(nply) = i
112 idgr4n(nply) = igeo(40,i) ! groupe shell 4N id
113 idgr3n(nply) = igeo(41,i) ! groupe shell 3n id
114 ENDIF
115 ENDDO
116C transformation d'id groupe
117 DO 10 i=1,nply
118C shell 4N id group
119 id = idgr4n(i)
120 IF(id > 0) THEN
121 DO j=1,ngrshel
122 jd = igrsh4n(j)%ID
123 IF(jd == id)THEN
124 idgr4n(i) = j
125 GOTO 20
126 ENDIF
127 ENDDO
128 ENDIF ! ID > 0
129C !GR T3
130 20 CONTINUE
131 id = idgr3n(i)
132 IF(id > 0) THEN
133 DO j=1,ngrsh3n
134 jd = igrsh3n(j)%ID
135 IF(jd == id)THEN
136 idgr3n(i) = j
137 GOTO 10
138 ENDIF
139 ENDDO
140 ENDIF ! ID > 0
14110 CONTINUE
142C tag o f ply element
143 nshq4 = 0
144 DO i=1,numelc
145 pid = ixc(6,i)
146 igtyp = igeo(11,pid)
147 IF(igtyp == 17 .OR. igtyp == 51)THEN
148 nshq4 = nshq4 + 1
149 ENDIF
150 ENDDO
151C
152 nsht3 = 0
153 DO i=1,numeltg
154 pid = ixtg(5,i)
155 igtyp = igeo(11,pid)
156 IF(igtyp == 17 .OR. igtyp == 51)THEN
157 nsht3 = nsht3 + 1
158 ENDIF
159 ENDDO
160C number of ply belong to the element
161 DO i=1,nply
162 j = idgr4n(i)
163 j4n = j
164 idply = ipidply(i)
165 nstack = igeo(42, idply)
166 IF(j > 0 .AND. nstack > 0 ) THEN
167 nel = igrsh4n(j)%NENTITY
168C eleme nt type Q4 or T3
169 ity = igrsh4n(j)%GRTYPE
170 DO 100 ii = 1,nel
171 idshel = igrsh4n(j)%ENTITY(ii)
172 pid = ixc(6,idshel)
173 igtyp = igeo(11,pid)
174 IF(igtyp == 17 .OR. igtyp == 51) THEN
175 DO is = 1,nstack
176 ids = igeo(200 + is, idply)
177 IF (ids == pid) THEN
178 iworksh(1,idshel) = iworksh(1,idshel) + 1
179 GOTO 100
180 ENDIF
181 ENDDO
182 ENDIF
183 100 CONTINUE
184 ENDIF
185 j = idgr3n(i)
186 j3n = j
187 IF(j > 0 .AND. nstack > 0 ) THEN
188 nel = igrsh3n(j)%NENTITY
189C eleme nt type T3
190 ity = igrsh3n(j)%GRTYPE
191 DO 200 ii = 1,nel
192 ish3n = igrsh3n(j)%ENTITY(ii)
193 pid = ixtg(5,ish3n)
194 igtyp = igeo(11,pid)
195 IF(igtyp == 17 .OR. igtyp == 51) THEN
196 DO is = 1,nstack
197 ids = igeo(200 + is,idply)
198 IF (ids == pid) THEN
199 idshel = ish3n + numelc
200 iworksh(1,idshel) = iworksh(1,idshel ) + 1
201 GOTO 200
202 ENDIF
203 ENDDO
204 ENDIF
205 200 CONTINUE
206 ENDIF
207 IF(j4n == 0 .AND. j3n == 0 .AND. nstack > 0 ) THEN
208C
209 DO 300 ii = 1,numelc
210 pid = ixc(6,ii)
211 igtyp = igeo(11,pid)
212 IF(igtyp == 17 .OR. igtyp == 51) THEN
213 DO is = 1,nstack
214 ids = igeo(200 + is,idply)
215 IF (ids == pid) THEN
216 iworksh(1,ii) = iworksh(1,ii) + 1
217 GOTO 300
218 ENDIF
219 ENDDO
220 ENDIF
221 300 CONTINUE
222 DO 400 ii = 1,numeltg
223 pid = ixtg(5,ii)
224 igtyp = igeo(11,pid)
225 itg = numelc + ii
226 IF(igtyp == 17 .OR. igtyp == 51) THEN
227 DO is = 1,nstack
228 ids = igeo(200 + is,idply)
229 IF (ids == pid) THEN
230 iworksh(1,itg) = iworksh(1,itg) + 1
231 GOTO 400
232 ENDIF
233 ENDDO
234 ENDIF
235 400 CONTINUE
236 ENDIF
237C
238 ENDDO ! iply
239C #####################################################"
240 ! SH4N element
241 DO i=1,numelc
242 pid = ixc(6,i)
243 igtyp = igeo(11,pid)
244 npt = iworksh(1,i)
245 IF(igtyp == 17 .OR. igtyp == 51 .AND. npt > 0) THEN
246 ALLOCATE(iwork_t(i)%PLYID(npt))
247 ALLOCATE(iwork_t(i)%PLYNUM(npt))
248 iwork_t(i)%PLYID = 0
249 iworksh(1,i) = 0
250 iwork_t(i)%PLYNUM = 0
251 ENDIF
252 ENDDO
253 ! sh3n element
254 DO i=1, numeltg
255 pid = ixtg(5,i)
256 igtyp = igeo(11,pid)
257 ii = numelc + i
258 npt = iworksh(1,ii)
259 IF((igtyp == 17 .OR. igtyp == 51) .AND. npt > 0) THEN
260 ALLOCATE(iwork_t(ii)%PLYID(npt))
261 ALLOCATE(iwork_t(ii)%PLYNUM(npt))
262 iwork_t(ii)%PLYID = 0
263 iworksh(1,ii) = 0
264 iwork_t(ii)%PLYNUM = 0
265 ENDIF
266 ENDDO
267! ply to element
268!!
269 DO i=1,nply
270 j = idgr4n(i)
271 j4n = j
272 idply = ipidply(i)
273 nstack = igeo(42, idply)
274 IF(j > 0 .AND. nstack > 0 ) THEN
275 nel = igrsh4n(j)%NENTITY
276C eleme nt type Q4 or T3
277 ity = igrsh4n(j)%GRTYPE
278 DO 101 ii = 1,nel
279 idshel = igrsh4n(j)%ENTITY(ii)
280 pid = ixc(6,idshel)
281 igtyp = igeo(11,pid)
282 IF(igtyp == 17 .OR. igtyp == 51) THEN
283 DO is = 1,nstack
284 ids = igeo(200 + is, idply)
285 IF (ids == pid) THEN
286 iworksh(1,idshel) = iworksh(1,idshel) + 1
287 npt = iworksh(1,idshel)
288 iwork_t(idshel)%PLYID(npt) = idply
289 iwork_t(idshel)%PLYNUM(npt) = i
290 GOTO 101
291 ENDIF
292 ENDDO
293 ENDIF
294 101 CONTINUE
295 ENDIF
296 j = idgr3n(i)
297 j3n = j
298 IF(j > 0 .AND. nstack > 0 ) THEN
299 nel = igrsh3n(j)%NENTITY
300C eleme nt type T3
301 ity = igrsh3n(j)%GRTYPE
302 DO 202 ii = 1,nel
303 ish3n = igrsh3n(j)%ENTITY(ii)
304 pid = ixtg(5,ish3n)
305 igtyp = igeo(11,pid)
306 IF(igtyp == 17 .OR. igtyp == 51) THEN
307 DO is = 1,nstack
308 ids = igeo(200 + is,idply)
309 IF (ids == pid) THEN
310 idshel = ish3n + numelc
311 iworksh(1,idshel) = iworksh(1,idshel ) + 1
312 npt = iworksh(1,idshel)
313 iwork_t(idshel)%PLYID(npt) = idply
314 iwork_t(idshel)%PLYNUM(npt) = i
315 GOTO 202
316 ENDIF
317 ENDDO
318 ENDIF
319 202 CONTINUE
320 ENDIF
321 IF(j4n == 0 .AND. j3n == 0 .AND. nstack > 0 ) THEN
322C
323 DO 333 ii = 1,numelc
324 pid = ixc(6,ii)
325 igtyp = igeo(11,pid)
326 IF(igtyp == 17 .OR. igtyp == 51) THEN
327 DO is = 1,nstack
328 ids = igeo(200 + is,idply)
329 IF (ids == pid) THEN
330 iworksh(1,ii) = iworksh(1,ii) + 1
331 npt = iworksh(1,ii)
332 iwork_t(ii)%PLYID(npt) = idply
333 iwork_t(ii)%PLYNUM(npt) = i
334 GOTO 333
335 ENDIF
336 ENDDO
337 ENDIF
338 333 CONTINUE
339 DO 404 ii = 1,numeltg
340 pid = ixtg(5,ii)
341 igtyp = igeo(11,pid)
342 itg = numelc + ii
343 IF(igtyp == 17 .OR. igtyp == 51) THEN
344 DO is = 1,nstack
345 ids = igeo(200 + is,idply)
346 IF (ids == pid) THEN
347 iworksh(1,itg) = iworksh(1,itg) + 1
348 npt = iworksh(1,itg)
349 iwork_t(itg)%PLYID(npt) = idply
350 iwork_t(itg)%PLYNUM(npt) = i
351 GOTO 404
352 ENDIF
353 ENDDO
354 ENDIF
355 404 CONTINUE
356 ENDIF
357C
358 ENDDO ! iply
359 ENDIF
360C
361C pccommp part
362C
363 IF(ipart_pcompp > 0) THEN
364 nply = 0
365 nstack = 0
366 DO i = 1, numply
367!! Only one stack by ply
368 ids = igeo_stack(42,numstack + i)
369 IF (ids > 0) THEN
370 nply = nply+1
371 ipidply(nply) = numstack + i
372 idgr4n(nply) = igeo_stack(40,numstack + i) ! groupe shell 4N id
373 idgr3n(nply) = igeo_stack(41,numstack + i) ! groupe shell 3N id
374 ENDIF
375 ENDDO
376!
377 DO 11 i=1,nply
378C shell 4N id group
379 id = idgr4n(i)
380 IF(id > 0) THEN
381 DO j=1,ngrshel
382 jd = igrsh4n(j)%ID
383 IF(jd == id)THEN
384 idgr4n(i) = j
385 GOTO 22
386 ENDIF
387 ENDDO
388 ENDIF ! ID > 0
389C !GR T3
390 22 CONTINUE
391 id = idgr3n(i)
392 IF(id > 0) THEN
393 DO j=1,ngrsh3n
394 jd = igrsh3n(j)%ID
395 IF(jd == id)THEN
396 idgr3n(i) = j
397 GOTO 11
398 ENDIF
399 ENDDO
400 ENDIF ! ID > 0
40111 CONTINUE
402C compteur by element
403 iwork_t(1:numelc + numeltg)%IDSTACK = 0
404 DO i= 1,nply
405 j = idgr4n(i)
406 j4n = j
407 idply = ipidply(i)
408 ids = igeo_stack(42, idply)
409 IF(j > 0 .AND. ids > 0 ) THEN
410 nel = igrsh4n(j)%NENTITY
411C element type Q4
412!! ITY = IGRN(4,J)
413 ity = igrsh4n(j)%GRTYPE
414 DO 111 ii = 1,nel
415 idshel = igrsh4n(j)%ENTITY(ii)
416 pid = ixc(6,idshel)
417 igtyp = igeo(11,pid)
418 IF(igtyp == 52) THEN
419 IF(iwork_t(idshel)%IDSTACK == 0) THEN
420 iworksh(1,idshel) = iworksh(1,idshel) + 1
421 iwork_t(idshel)%IDSTACK = ids
422 ELSEIF(iwork_t(idshel)%IDSTACK == ids) THEN
423 iworksh(1,idshel) = iworksh(1,idshel) + 1
424 ELSE
425C message d'erreur
426 ipid_1=igeo_stack(1,iwork_t(idshel)%IDSTACK)
427 ngl =ixc(nixc,idshel)
428 CALL ancmsg(msgid=1152,
429 . msgtype=msgerror,
430 . anmode=aninfo_blind_1,
431 . i1=ngl,
432!! . C2='SHELL',
433 . i2= igeo_stack(1,ids),
434 . i3= igeo_stack(1,ipid_1) )
435 ENDIF
436 ENDIF
437 111 CONTINUE
438 ENDIF
439 j = idgr3n(i)
440 j3n = j
441 IF(j > 0 .AND. ids > 0 ) THEN
442 nel = igrsh3n(j)%NENTITY
443C element type T3
444 ity = igrsh3n(j)%GRTYPE
445 DO 222 ii = 1,nel
446!
447 ish3n = igrsh3n(j)%ENTITY(ii)
448 pid = ixtg(5,ish3n)
449 igtyp = igeo(11,pid)
450 IF(igtyp == 52) THEN
451 idshel = ish3n + numelc
452 IF(iwork_t(idshel)%IDSTACK == 0) THEN
453 iworksh(1,idshel) = iworksh(1,idshel ) + 1
454 iwork_t(idshel)%IDSTACK= ids
455 ELSEIF(iwork_t(idshel)%IDSTACK == ids) THEN
456 iworksh(1,idshel) = iworksh(1,idshel ) + 1
457 ELSE
458C message d'erreur
459 ipid_1=igeo_stack(1,iwork_t(idshel)%IDSTACK)
460 ngl =ixtg(nixtg,idshel)
461 CALL ancmsg(msgid=1152,
462 . msgtype=msgerror,
463 . anmode=aninfo_blind_1,
464 . i1=ngl,
465!! . C2='SHE3N',
466 . i2= igeo_stack(1,ids),
467 . i3= igeo_stack(1,ipid_1) )
468 ENDIF
469 ENDIF
470 222 CONTINUE
471 ENDIF
472 ENDDO ! I ply groupe
473C
474!!!------------------------------------------------
475 DO i=1,numelc
476 pid = ixc(6,i)
477 igtyp = igeo(11,pid)
478 npt = iworksh(1,i)
479 IF(igtyp == 52 .AND. npt > 0) THEN
480 ALLOCATE(iwork_t(i)%PLYID(npt))
481 ALLOCATE(iwork_t(i)%PLYNUM(npt))
482 iwork_t(i)%PLYID = 0
483 iwork_t(i)%IDSTACK = 0
484 iworksh(1,i) = 0
485 iwork_t(i)%PLYNUM = 0
486 ENDIF
487 ENDDO
488 DO i=1, numeltg
489 pid = ixtg(5,i)
490 igtyp = igeo(11,pid)
491 ii = numelc + i
492 npt = iworksh(1,ii)
493 IF(igtyp == 52 .AND. npt > 0) THEN
494 ALLOCATE(iwork_t(ii)%PLYID(npt) )
495 ALLOCATE(iwork_t(ii)%PLYNUM(npt))
496 iwork_t(ii)%PLYID = 0
497 iwork_t(ii)%IDSTACK = 0
498 iworksh(1,ii) = 0
499 iwork_t(ii)%PLYNUM = 0
500 ENDIF
501 ENDDO
502C
503 DO i= 1,nply
504 j = idgr4n(i)
505 j4n = j
506 idply = ipidply(i)
507 ids = igeo_stack(42, idply)
508 IF(j > 0 .AND. ids > 0 ) THEN
509 nel = igrsh4n(j)%NENTITY
510C element type Q4
511!! ITY = IGRN(4,J)
512 ity = igrsh4n(j)%GRTYPE
513 DO ii = 1,nel
514 idshel = igrsh4n(j)%ENTITY(ii)
515 pid = ixc(6,idshel)
516 igtyp = igeo(11,pid)
517 IF(igtyp == 52) THEN
518 IF(iwork_t(idshel)%IDSTACK == 0) THEN
519 iworksh(1,idshel) = iworksh(1,idshel) + 1
520 npt = iworksh(1,idshel)
521 iwork_t(idshel)%PLYID(npt) = idply
522 iwork_t(idshel)%IDSTACK = ids
523 iwork_t(idshel)%PLYNUM(npt) = i
524 ELSEIF(iwork_t(idshel)%IDSTACK == ids) THEN
525 iworksh(1,idshel) = iworksh(1,idshel) + 1
526 npt = iworksh(1,idshel)
527 iwork_t(idshel)%PLYID(npt) = idply
528 iwork_t(idshel)%PLYNUM(npt) = i
529 ELSE
530C message d'erreur
531 ipid_1=igeo_stack(1,iwork_t(idshel)%IDSTACK)
532 ngl =ixc(nixc,idshel)
533 CALL ancmsg(msgid=1152,
534 . msgtype=msgerror,
535 . anmode=aninfo_blind_1,
536 . i1=ngl,
537!! . C2='SHELL',
538 . i2= igeo_stack(1,ids),
539 . i3= igeo_stack(1,ipid_1) )
540 ENDIF
541 ENDIF
542 ENDDO
543 ENDIF
544 j = idgr3n(i)
545 j3n = j
546 IF(j > 0 .AND. ids > 0 ) THEN
547 nel = igrsh3n(j)%NENTITY
548C element type T3
549 ity = igrsh3n(j)%GRTYPE
550 DO ii = 1,nel
551! c a verifier l'id du triangle
552
553 ish3n = igrsh3n(j)%ENTITY(ii)
554 pid = ixtg(5,ish3n)
555 igtyp = igeo(11,pid)
556 IF(igtyp == 52) THEN
557 idshel = ish3n + numelc
558 IF(iwork_t(idshel)%IDSTACK == 0) THEN
559 iworksh(1,idshel) = iworksh(1,idshel ) + 1
560 npt = iworksh(1,idshel)
561 iwork_t(idshel)%PLYID(npt) = idply
562 iwork_t(idshel)%IDSTACK= ids
563 iwork_t(idshel)%PLYNUM(npt) = i
564 ELSEIF(iwork_t(idshel)%IDSTACK == ids) THEN
565 iworksh(1,idshel) = iworksh(1,idshel ) + 1
566 npt = iworksh(1,idshel)
567 iwork_t(idshel)%PLYID(npt) = idply
568 iwork_t(idshel)%PLYNUM(npt) = i
569 ELSE
570C message d'erreur
571 ipid_1=igeo_stack(1,iwork_t(idshel)%IDSTACK)
572 ngl =ixtg(nixtg,idshel)
573 CALL ancmsg(msgid=1152,
574 . msgtype=msgerror,
575 . anmode=aninfo_blind_1,
576 . i1=ngl,
577!! . C2='SHE3N',
578 . i2= igeo_stack(1,ids),
579 . i3= igeo_stack(1,ipid_1) )
580 ENDIF
581 ENDIF
582 ENDDO ! II
583 ENDIF
584 ENDDO ! I ply groupe
585!!!------------------------------------------
586 ENDIF
587C--------
588
589 RETURN
my_real
#define my_real
Definition cppsort.cpp:32
id
initmumps id
Definition multiplerhs_example.m:4
drape_mod
Definition drape_mod.F:54
groupdef_mod
Definition groupdef_mod.F:662
message_mod
Definition message_mod.F:1249
names_and_titles_mod
Definition names_and_titles_mod.F:997
names_and_titles_mod::nchartitle
integer, parameter nchartitle
Definition names_and_titles_mod.F:1003
stack_mod
Definition stack_mod.F:72
submodel_mod
Definition submodel_mod.F:712
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