OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
stat_t_full.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!|| stat_t_full ../engine/source/output/sta/stat_t_full.F
25!||--- called by ------------------------------------------------------
26!|| genstat ../engine/source/output/sta/genstat.F
27!||--- calls -----------------------------------------------------
28!|| spmd_rgather9_dp ../engine/source/mpi/interfaces/spmd_outp.F
29!|| spmd_stat_pgather ../engine/source/mpi/output/spmd_stat.F
30!||--- uses -----------------------------------------------------
31!|| elbufdef_mod ../common_source/modules/mat_elem/elbufdef_mod.F90
32!|| element_mod ../common_source/modules/elements/element_mod.F90
33!|| my_alloc_mod ../common_source/tools/memory/my_alloc.F90
34!||====================================================================
35 SUBROUTINE stat_t_full(
36 1 ELBUF_TAB ,IPARG ,GEO ,IGEO ,IXT ,
37 2 WA ,WAP0 ,IPARTT ,IPART_STATE ,STAT_INDXT,
38 3 SIZP0 )
39C-----------------------------------------------
40C M o d u l e s
41C-----------------------------------------------
42 USE elbufdef_mod
43 USE my_alloc_mod
44 use element_mod , only : nixt
45C-----------------------------------------------
46C I m p l i c i t T y p e s
47C-----------------------------------------------
48#include "implicit_f.inc"
49C-----------------------------------------------
50C C o m m o n B l o c k s
51C-----------------------------------------------
52#include "com01_c.inc"
53#include "param_c.inc"
54#include "units_c.inc"
55#include "task_c.inc"
56#include "scr16_c.inc"
57C-----------------------------------------------
58C D u m m y A r g u m e n t s
59C-----------------------------------------------
60 INTEGER SIZP0
61 INTEGER IXT(NIXT,*),IPARG(NPARG,*),IGEO(NPROPGI,*),
62 . IPARTT(*),IPART_STATE(*),STAT_INDXT(*)
63 my_real
64 . geo(npropg,*)
65 TYPE (ELBUF_STRUCT_), DIMENSION(NGROUP), TARGET :: ELBUF_TAB
66 double precision WA(*),WAP0(*)
67C-----------------------------------------------
68C L o c a l V a r i a b l e s
69C-----------------------------------------------
70 INTEGER I,J,K,N,JJ,LEN,IOFF,IE,NG,NEL,NFT,LFT,
71 . LLT,ITY,ID,IPRT0,IPRT,IGTYP,IPROP
72 INTEGER,DIMENSION(:),ALLOCATABLE :: PTWA
73 INTEGER,DIMENSION(:),ALLOCATABLE :: PTWA_P0
74 CHARACTER*100 DELIMIT
75 TYPE(g_bufel_) ,POINTER :: GBUF
76C-----------------------------------------------
77 DATA delimit(1:60)
78 ./'#---1----|----2----|----3----|----4----|----5----|----6----|'/
79 DATA delimit(61:100)
80 ./'----7----|----8----|----9----|----10---|'/
81C=======================================================================
82C TRUSS
83C-----------------------------------------------
84 CALL my_alloc(ptwa,stat_numelt)
85 ALLOCATE(ptwa_p0(0:max(1,stat_numels_g)))
86C-----------------------------------------------
87 jj = 0
88!
89 IF (stat_numelt /= 0) THEN
90!
91 ie=0
92 DO ng=1,ngroup
93 ity = iparg(5,ng)
94 IF (ity == 4) THEN
95 nel = iparg(2,ng)
96 nft = iparg(3,ng)
97 iprop = ixt(4,nft+1)
98 igtyp = igeo(11,iprop)
99 lft=1
100 llt=nel
101!
102 gbuf => elbuf_tab(ng)%GBUF
103!
104 DO i=lft,llt
105 n = i + nft
106 iprt=ipartt(n)
107 IF (ipart_state(iprt) /= 0) THEN
108 wa(jj + 1) = gbuf%OFF(i)
109 wa(jj + 2) = iprt
110 wa(jj + 3) = ixt(nixt,n)
111 wa(jj + 4) = igtyp
112 jj = jj + 4
113!
114 wa(jj + 1) = gbuf%EINT(i)
115 wa(jj + 2) = gbuf%FOR(i)
116 IF (gbuf%G_PLA > 0) THEN
117 wa(jj + 3) = gbuf%PLA(i)
118 ELSE
119 wa(jj + 3) = zero
120 ENDIF
121 wa(jj + 4) = gbuf%AREA(i)
122!
123 jj = jj + 4
124!---
125 ie=ie+1
126!end-of-zone pointer in wa
127 ptwa(ie)=jj
128 ENDIF ! IF (ipart_state(iprt) /= 0)
129 ENDDO ! DO I=LFT,LLT
130c------- end loop over truss elements
131 ENDIF ! ITY == 4
132 ENDDO ! NG = 1, NGROUP
133 ENDIF ! IF (STAT_NUMELT == 0) THEN
134!-----------------------------------------------------------------------
135! TRUSS - WRITE
136!-----------------------------------------------------------------------
137 IF (nspmd == 1) THEN
138! unnecessary copies for code simplification
139 ptwa_p0(0)=0
140 DO n=1,stat_numelt
141 ptwa_p0(n)=ptwa(n)
142 ENDDO
143 len=jj
144 DO j=1,len
145 wap0(j)=wa(j)
146 ENDDO
147 ELSE
148! builds the pointers in the global array wap0
149 CALL spmd_stat_pgather(ptwa,stat_numelt,ptwa_p0,stat_numelt_g)
150 len = 0
151 CALL spmd_rgather9_dp(wa,jj,wap0,sizp0,len)
152 ENDIF
153!-------------------------------------
154 IF (ispmd == 0 .AND. len > 0) THEN
155 iprt0 = 0
156 DO n=1,stat_numelt_g
157! find the nieme elt in the order of an increasing id
158 k=stat_indxt(n)
159! Find the address in WAP0
160 j=ptwa_p0(k-1)
161!
162 ioff = nint(wap0(j + 1))
163!! IF (IOFF >= 1) THEN
164 IF (ioff /= 0) THEN
165 iprt = nint(wap0(j + 2))
166 id = nint(wap0(j + 3))
167 igtyp = nint(wap0(j + 4))
168 j = j + 4
169!--------------------------------------
170 IF (igtyp == 2) THEN
171!--------------------------------------
172 IF (iprt /= iprt0) THEN
173 WRITE(iugeo,'(A)') delimit
174 WRITE(iugeo,'(A)')'/INITRUSS/FULL'
175 WRITE(iugeo,'(A)')
176 . '#----------------------------------------------------------'
177 WRITE(iugeo,'(A)')'#TRUSS_ID PROP_TYPE'
178 WRITE(iugeo,'(A)')'#FORMAT:(1P4E20.13) #(EIN(I),FOR(I),EPSP(I),AREA(I),I=TRUSS_ID)'
179 WRITE(iugeo,'(A)')
180 . '#----------------------------------------------------------'
181!
182 iprt0=iprt
183 ENDIF ! IF (IPRT /= IPRT0)
184!
185 WRITE(iugeo,'(I10,10X,I10)') id,igtyp
186 WRITE(iugeo,'(1P4E20.13)')(wap0(j+k),k=1,4) ! EINT,FOR,EPSP,AREA
187!--------------------------------------
188 ENDIF ! IF (IGTYP)
189!--------------------------------------
190 ENDIF ! IF (IOFF >= 1)
191 ENDDO ! DO N=1,STAT_NUMELT_G
192 ENDIF ! IF (ISPMD == 0.AND.LEN > 0)
193!---
194 DEALLOCATE(ptwa)
195 DEALLOCATE(ptwa_p0)
196c-----------
197 RETURN
198 END
my_real
#define my_real
Definition cppsort.cpp:32
max
#define max(a, b)
Definition macros.h:21
spmd_rgather9_dp
subroutine spmd_rgather9_dp(v, len, vp0, lenp0, iad)
Definition spmd_outp.F:1019
spmd_stat_pgather
subroutine spmd_stat_pgather(ptv, ptlen, ptv_p0, ptlen_p0)
Definition spmd_stat.F:53
stat_t_full
subroutine stat_t_full(elbuf_tab, iparg, geo, igeo, ixt, wa, wap0, ipartt, ipart_state, stat_indxt, sizp0)
Definition stat_t_full.F:39