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!|| my_alloc_mod ../common_source/tools/memory/my_alloc.F90
33!||====================================================================
34 SUBROUTINE stat_t_full(
35 1 ELBUF_TAB ,IPARG ,GEO ,IGEO ,IXT ,
36 2 WA ,WAP0 ,IPARTT ,IPART_STATE ,STAT_INDXT,
37 3 SIZP0 )
38C-----------------------------------------------
39C M o d u l e s
40C-----------------------------------------------
41 USE elbufdef_mod
42 USE my_alloc_mod
43C-----------------------------------------------
44C I m p l i c i t T y p e s
45C-----------------------------------------------
46#include "implicit_f.inc"
47C-----------------------------------------------
48C C o m m o n B l o c k s
49C-----------------------------------------------
50#include "com01_c.inc"
51#include "param_c.inc"
52#include "units_c.inc"
53#include "task_c.inc"
54#include "scr16_c.inc"
55C-----------------------------------------------
56C D u m m y A r g u m e n t s
57C-----------------------------------------------
58 INTEGER SIZLOC,SIZP0
59 INTEGER IXT(NIXT,*),IPARG(NPARG,*),IGEO(NPROPGI,*),
60 . IPARTT(*),IPART_STATE(*),STAT_INDXT(*)
61 my_real
62 . geo(npropg,*)
63 TYPE (ELBUF_STRUCT_), DIMENSION(NGROUP), TARGET :: ELBUF_TAB
64 double precision WA(*),WAP0(*)
65C-----------------------------------------------
66C L o c a l V a r i a b l e s
67C-----------------------------------------------
68 INTEGER I,J,K,N,JJ,LEN,IOFF,IE,NG,NEL,NFT,LFT,
69 . LLT,ITY,ID,IPRT0,IPRT,IGTYP,IPROP,G_PLA
70 INTEGER,DIMENSION(:),ALLOCATABLE :: PTWA
71 INTEGER,DIMENSION(:),ALLOCATABLE :: PTWA_P0
72 CHARACTER*100 DELIMIT,LINE
73 TYPE(g_bufel_) ,POINTER :: GBUF
74C-----------------------------------------------
75 DATA delimit(1:60)
76 ./'#---1----|----2----|----3----|----4----|----5----|----6----|'/
77 DATA delimit(61:100)
78 ./'----7----|----8----|----9----|----10---|'/
79C=======================================================================
80C TRUSS
81C-----------------------------------------------
82 CALL my_alloc(ptwa,stat_numelt)
83 ALLOCATE(ptwa_p0(0:max(1,stat_numels_g)))
84C-----------------------------------------------
85 jj = 0
86!
87 IF (stat_numelt /= 0) THEN
88!
89 ie=0
90 DO ng=1,ngroup
91 ity = iparg(5,ng)
92 IF (ity == 4) THEN
93 nel = iparg(2,ng)
94 nft = iparg(3,ng)
95 iprop = ixt(4,nft+1)
96 igtyp = igeo(11,iprop)
97 lft=1
98 llt=nel
99!
100 gbuf => elbuf_tab(ng)%GBUF
101!
102 DO i=lft,llt
103 n = i + nft
104 iprt=ipartt(n)
105 IF (ipart_state(iprt) /= 0) THEN
106 wa(jj + 1) = gbuf%OFF(i)
107 wa(jj + 2) = iprt
108 wa(jj + 3) = ixt(nixt,n)
109 wa(jj + 4) = igtyp
110 jj = jj + 4
111!
112 wa(jj + 1) = gbuf%EINT(i)
113 wa(jj + 2) = gbuf%FOR(i)
114 IF (gbuf%G_PLA > 0) THEN
115 wa(jj + 3) = gbuf%PLA(i)
116 ELSE
117 wa(jj + 3) = zero
118 ENDIF
119 wa(jj + 4) = gbuf%AREA(i)
120!
121 jj = jj + 4
122!---
123 ie=ie+1
124!--- pointeur de fin de zone dans WA
125 ptwa(ie)=jj
126 ENDIF ! IF (ipart_state(iprt) /= 0)
127 ENDDO ! DO I=LFT,LLT
128c------- end loop over truss elements
129 ENDIF ! ITY == 4
130 ENDDO ! NG = 1, NGROUP
131 ENDIF ! IF (STAT_NUMELT == 0) THEN
132!-----------------------------------------------------------------------
133! TRUSS - WRITE
134!-----------------------------------------------------------------------
135 IF (nspmd == 1) THEN
136! recopies inutiles pour simplification du code.
137 ptwa_p0(0)=0
138 DO n=1,stat_numelt
139 ptwa_p0(n)=ptwa(n)
140 ENDDO
141 len=jj
142 DO j=1,len
143 wap0(j)=wa(j)
144 ENDDO
145 ELSE
146! construit les pointeurs dans le tableau global WAP0
147 CALL spmd_stat_pgather(ptwa,stat_numelt,ptwa_p0,stat_numelt_g)
148 len = 0
149 CALL spmd_rgather9_dp(wa,jj,wap0,sizp0,len)
150 ENDIF
151!-------------------------------------
152 IF (ispmd == 0 .AND. len > 0) THEN
153 iprt0 = 0
154 DO n=1,stat_numelt_g
155! retrouve le nieme elt dans l'ordre d'id croissant
156 k=stat_indxt(n)
157! retrouve l'adresse dans WAP0
158 j=ptwa_p0(k-1)
159!
160 ioff = nint(wap0(j + 1))
161!! IF (IOFF >= 1) THEN
162 IF (ioff /= 0) THEN
163 iprt = nint(wap0(j + 2))
164 id = nint(wap0(j + 3))
165 igtyp = nint(wap0(j + 4))
166 j = j + 4
167!--------------------------------------
168 IF (igtyp == 2) THEN
169!--------------------------------------
170 IF (iprt /= iprt0) THEN
171 WRITE(iugeo,'(A)') delimit
172 WRITE(iugeo,'(A)')'/INITRUSS/FULL'
173 WRITE(iugeo,'(A)')
174 . '#----------------------------------------------------------'
175 WRITE(iugeo,'(A)')'#TRUSS_ID PROP_TYPE'
176 WRITE(iugeo,'(A)')'#FORMAT:(1P4E20.13) #(EIN(I),FOR(I),EPSP(I),AREA(I),I=TRUSS_ID)'
177 WRITE(iugeo,'(A)')
178 . '#----------------------------------------------------------'
179!
180 iprt0=iprt
181 ENDIF ! IF (IPRT /= IPRT0)
182!
183 WRITE(iugeo,'(i10,10x,i10)') ID,IGTYP
184 WRITE(IUGEO,'(1p4e20.13)')(WAP0(J+K),K=1,4) ! EINT,FOR,EPSP,AREA
185!--------------------------------------
186 ENDIF ! IF (IGTYP)
187!--------------------------------------
188 ENDIF ! IF (IOFF >= 1)
189 ENDDO ! DO N=1,STAT_NUMELT_G
190.AND. ENDIF ! IF (ISPMD == 0LEN > 0)
191!---
192 DEALLOCATE(PTWA)
193 DEALLOCATE(PTWA_P0)
194c-----------
195 RETURN
196 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:1015
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:38