OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
stat_truss_spmd.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_truss_spmd ../engine/source/output/sta/stat_truss_spmd.F
25!||--- called by ------------------------------------------------------
26!|| genstat ../engine/source/output/sta/genstat.F
27!||--- calls -----------------------------------------------------
28!|| my_orders ../common_source/tools/sort/my_orders.c
29!|| spmd_iget_partn_sta ../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_truss_spmd(ITAB ,IPART ,IXT ,IPARTT,IPART_STATE,
35 . NODTAG ,STAT_INDXT,LENGT ,IPARG ,ELBUF_TAB ,
36 . IDEL )
37C-----------------------------------------------
38C M o d u l e s
39C-----------------------------------------------
40 USE elbufdef_mod
41 USE my_alloc_mod
42C-----------------------------------------------
43C I m p l i c i t T y p e s
44C-----------------------------------------------
45#include "implicit_f.inc"
46C-----------------------------------------------
47C C o m m o n B l o c k s
48C-----------------------------------------------
49#include "com01_c.inc"
50#include "com04_c.inc"
51#include "param_c.inc"
52#include "scr16_c.inc"
53#include "scr17_c.inc"
54#include "spmd_c.inc"
55#include "task_c.inc"
56#include "units_c.inc"
57C-----------------------------------------------
58C D u m m y A r g u m e n t s
59C-----------------------------------------------
60 INTEGER ITAB(*),IPART(LIPART1,*),IXT(NIXT,*),IPARTT(*),
61 . IPART_STATE(*),NODTAG(*), STAT_INDXT(*),IPARG(NPARG,*)
62 INTEGER LENGT,IDEL
63 TYPE (ELBUF_STRUCT_), DIMENSION(NGROUP), TARGET :: ELBUF_TAB
64C-----------------------------------------------
65C L o c a l V a r i a b l e s
66C-----------------------------------------------
67 INTEGER I,N,JJ,IPRT,BUF,IPRT0,K,II
68 INTEGER NG,NEL,NFT,LFT,LLT,ITY,IOFF
69 INTEGER WORK(70000)
70 INTEGER,DIMENSION(:),ALLOCATABLE :: IADD
71 INTEGER,DIMENSION(:,:),ALLOCATABLE :: IADG
72 INTEGER,DIMENSION(:),ALLOCATABLE :: NP
73 INTEGER,DIMENSION(:),ALLOCATABLE :: NPGLOB
74 INTEGER,DIMENSION(:,:),ALLOCATABLE :: CLEF
75 TYPE(g_bufel_) ,POINTER :: GBUF
76C-----------------------------------------------
77 CALL my_alloc(iadd,npart+1)
78 CALL my_alloc(iadg,nspmd,npart)
79 CALL my_alloc(np,5*numelt)
80 CALL my_alloc(npglob,7*lengt)
81 CALL my_alloc(clef,2,numeltrg)
82C-----------------------------------------------
83C TRUSS
84C-----------------------------------------------
85 iadd = 0
86 npglob(1:7*lengt) = 0
87C
88 jj = 0
89 ii = 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 gbuf => elbuf_tab(ng)%GBUF
96 lft=1
97 llt=nel
98c
99 DO i=lft,llt
100 n = i + nft
101 iprt=ipartt(n)
102 IF (ipart_state(iprt) /= 0) THEN
103c
104 np(jj+1) = ixt(nixt,n)
105 np(jj+2) = itab(ixt(2,n))
106 np(jj+3) = itab(ixt(3,n))
107 np(jj+4) = iprt
108 np(jj+5) = iabs(nint(gbuf%OFF(i)))
109c
110 ii = ii + 1
111c
112 jj = jj + 5
113c
114 stat_numelt = stat_numelt + 1
115c
116 nodtag(ixt(2,n))=1
117 nodtag(ixt(3,n))=1
118 ENDIF ! IF (IPART_STATE(IPRT) == 0)
119 ENDDO ! DO I=LFT,LLT
120 ENDIF ! IF (ITY == 4)
121 ENDDO ! DO NG=1,NGROUP
122C----
123 stat_numelt_g = 0
124 CALL spmd_iget_partn_sta(5,stat_numelt,stat_numelt_g,lengt,np,
125 . iadg,npglob,stat_indxt)
126C----
127 IF (ispmd == 0) THEN
128 DO n=1,stat_numelt_g
129 stat_indxt(n)=n
130 clef(1,n)=npglob(5*(n-1)+5)
131 clef(2,n)=npglob(5*(n-1)+1)
132 ENDDO
133 CALL my_orders(0,work,clef,stat_indxt,stat_numelt_g,2)
134C----
135 iprt0=0
136 DO n=1,stat_numelt_g
137 k=stat_indxt(n)
138 jj=5*(k-1)
139 iprt=npglob(jj+4)
140 ioff=npglob(jj+5)
141 IF (idel==0 .OR. (idel==1 .AND. ioff >= 1)) THEN
142 IF (iprt /= iprt0) THEN
143 WRITE(iugeo,'(A,I10)')'/TRUSS/',ipart(4,iprt)
144 WRITE(iugeo,'(A)')
145 . '#TRUSS_ID NOD1 NOD2'
146 iprt0=iprt
147 ENDIF
148 WRITE(iugeo,'(3I10)') npglob(jj+1),npglob(jj+2),npglob(jj+3)
149 ENDIF !IF (IDEL)
150 ENDDO ! DO N=1,STAT_NUMELT_G
151 ENDIF ! IF (ISPMD == 0)
152C-----------------------------------------------
153 DEALLOCATE(iadd)
154 DEALLOCATE(iadg)
155 DEALLOCATE(np)
156 DEALLOCATE(npglob)
157 DEALLOCATE(clef)
158 RETURN
159 END
my_orders
void my_orders(int *mode, int *iwork, int *data, int *index, int *n, int *irecl)
Definition my_orders.c:82
spmd_iget_partn_sta
subroutine spmd_iget_partn_sta(size, stat_numel, stat_lenelg, leng, np, iadg, npglob, stat_indx)
Definition spmd_stat.F:129
stat_truss_spmd
subroutine stat_truss_spmd(itab, ipart, ixt, ipartt, ipart_state, nodtag, stat_indxt, lengt, iparg, elbuf_tab, idel)
Definition stat_truss_spmd.F:37