OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
stat_quad_mp.F File Reference
#include "implicit_f.inc"
#include "com01_c.inc"
#include "com04_c.inc"
#include "param_c.inc"
#include "scr17_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine stat_quad_mp (itab, ipart, igeo, ixq, ipartq, ipart_state, nodtag, stat_indxq, iparg, elbuf_tab)

Function/Subroutine Documentation

◆ stat_quad_mp()

subroutine stat_quad_mp ( integer, dimension(*) itab,
integer, dimension(lipart1,*) ipart,
integer, dimension(npropgi,*) igeo,
integer, dimension(nixq,*) ixq,
integer, dimension(*) ipartq,
integer, dimension(*) ipart_state,
integer, dimension(*) nodtag,
integer, dimension(*) stat_indxq,
integer, dimension(nparg,*) iparg,
type (elbuf_struct_), dimension(ngroup), target elbuf_tab )

Definition at line 32 of file stat_quad_mp.F.

35C-----------------------------------------------
36C M o d u l e s
37C-----------------------------------------------
38 USE elbufdef_mod
39 USE my_alloc_mod
40C-----------------------------------------------
41C I m p l i c i t T y p e s
42C-----------------------------------------------
43#include "implicit_f.inc"
44C-----------------------------------------------
45C C o m m o n B l o c k s
46C-----------------------------------------------
47#include "com01_c.inc"
48#include "com04_c.inc"
49#include "param_c.inc"
50#include "scr17_c.inc"
51C-----------------------------------------------
52C D u m m y A r g u m e n t s
53C-----------------------------------------------
54 INTEGER ITAB(*), IPART(LIPART1,*),IPARTQ(*),
55 . IGEO(NPROPGI,*), IXQ(NIXQ,*), IPART_STATE(*),
56 . NODTAG(*), STAT_INDXQ(*),
57 . IPARG(NPARG,*)
58 TYPE (ELBUF_STRUCT_), DIMENSION(NGROUP), TARGET :: ELBUF_TAB
59C-----------------------------------------------
60C L o c a l V a r i a b l e s
61C-----------------------------------------------
62 INTEGER I, N, JJ, IPRT0, IPRT, K, STAT_NUMELQ_1,N10,N20,N16
63 INTEGER NG, NEL, NFT, LFT, LLT, ITY, ISOLNOD, IOFF
64 INTEGER,DIMENSION(:),ALLOCATABLE::NP
65 INTEGER,DIMENSION(:,:),ALLOCATABLE:: CLEF
66 INTEGER WORK(70000)
67 TYPE(G_BUFEL_) ,POINTER :: GBUF
68C-----------------------------------------------
69C QUAD
70C-----------------------------------------------
71 CALL my_alloc(np,4*numelq)
72 CALL my_alloc(clef,2,numelq)
73C-----------------------------------------------
74 jj = 0
75 IF(numelq/=0)THEN
76
77 DO ng=1,ngroup
78 ity =iparg(5,ng)
79 nel =iparg(2,ng)
80 nft =iparg(3,ng)
81 gbuf => elbuf_tab(ng)%GBUF
82 lft=1
83 llt=nel
84 IF(ity == 2) THEN
85 DO i=lft,llt
86 n = i + nft
87 iprt=ipartq(n)
88 IF(ipart_state(iprt)==0)cycle
89
90 nodtag(ixq(2,n))=1
91 nodtag(ixq(3,n))=1
92 nodtag(ixq(4,n))=1
93 nodtag(ixq(5,n))=1
94
95
96 END DO
97 END IF
98 END DO
99
100 ENDIF
101C-----------------------------------------------
102 DEALLOCATE(np)
103 DEALLOCATE(clef)
104C-----------------------------------------------
105 RETURN