OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
stat_spring_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_spring_spmd ../engine/source/output/sta/stat_spring_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!|| element_mod ../common_source/modules/elements/element_mod.F90
33!|| my_alloc_mod ../common_source/tools/memory/my_alloc.F90
34!||====================================================================
35 SUBROUTINE stat_spring_spmd(ITAB ,IPART ,IXR ,IPARTR,IPART_STATE,
36 . NODTAG ,STAT_INDXR,LENGR ,IPARG ,ELBUF_TAB ,
37 . IDEL )
38C-----------------------------------------------
39C M o d u l e s
40C-----------------------------------------------
41 USE elbufdef_mod
42 USE my_alloc_mod
43 use element_mod , only : nixr
44C-----------------------------------------------
45C I m p l i c i t T y p e s
46C-----------------------------------------------
47#include "implicit_f.inc"
48C-----------------------------------------------
49C C o m m o n B l o c k s
50C-----------------------------------------------
51#include "com01_c.inc"
52#include "com04_c.inc"
53#include "param_c.inc"
54#include "scr16_c.inc"
55#include "scr17_c.inc"
56#include "spmd_c.inc"
57#include "task_c.inc"
58#include "units_c.inc"
59C-----------------------------------------------
60C D u m m y A r g u m e n t s
61C-----------------------------------------------
62 INTEGER ITAB(*),IPART(LIPART1,*),IXR(NIXR,*),IPARTR(*),
63 . IPART_STATE(*),NODTAG(*), STAT_INDXR(*),IPARG(NPARG,*)
64 INTEGER LENGR,IDEL
65 TYPE (ELBUF_STRUCT_), DIMENSION(NGROUP), TARGET :: ELBUF_TAB
66C-----------------------------------------------
67C L o c a l V a r i a b l e s
68C-----------------------------------------------
69 INTEGER I,N,JJ,IPRT,IPRT0,K,II
70 INTEGER NG,NEL,NFT,LFT,LLT,ITY,IOFF
71 INTEGER WORK(70000)
72 TYPE(g_bufel_) ,POINTER :: GBUF
73 INTEGER,DIMENSION(:),ALLOCATABLE :: IADD
74 INTEGER,DIMENSION(:,:),ALLOCATABLE :: IADG
75 INTEGER,DIMENSION(:),ALLOCATABLE :: NP
76 INTEGER,DIMENSION(:),ALLOCATABLE :: NPGLOB
77 INTEGER,DIMENSION(:,:),ALLOCATABLE :: CLEF
78C-----------------------------------------------
79C SPRING
80C-----------------------------------------------
81 CALL my_alloc(iadg,nspmd,npart)
82 CALL my_alloc(iadd,npart+1)
83 CALL my_alloc(np,6*numelr)
84 CALL my_alloc(npglob,7*lengr)
85 CALL my_alloc(clef,2,numelrg)
86C-----------------------------------------------
87 iadd = 0
88 npglob(1:7*lengr) = 0
89C
90 jj = 0
91 ii = 0
92 DO ng=1,ngroup
93 ity = iparg(5,ng)
94 IF (ity == 6) THEN
95 nel = iparg(2,ng)
96 nft = iparg(3,ng)
97 gbuf => elbuf_tab(ng)%GBUF
98 lft=1
99 llt=nel
100c
101 DO i=lft,llt
102 n = i + nft
103 iprt=ipartr(n)
104 IF (ipart_state(iprt) == 0) cycle
105c
106 np(jj+1) = ixr(nixr,n)
107 np(jj+2) = itab(ixr(2,n))
108 np(jj+3) = itab(ixr(3,n))
109 IF(ixr(4,n) > 0) THEN
110 np(jj+4) = itab(ixr(4,n))
111 ELSE
112 np(jj+4) = 0
113 ENDIF
114 np(jj+5) = iprt
115 np(jj+6) = iabs(nint(gbuf%OFF(i)))
116c
117 ii = ii + 1
118c
119 jj = jj + 6
120c
121 stat_numelr = stat_numelr + 1
122c
123 nodtag(ixr(2,n))=1
124 nodtag(ixr(3,n))=1
125 IF(ixr(4,n) > 0)nodtag(ixr(4,n))=1
126 ENDDO ! DO I=LFT,LLT
127 ENDIF ! IF (ITY == 6)
128 ENDDO ! DO NG=1,NGROUP
129C----
130 stat_numelr_g = 0
131 CALL spmd_iget_partn_sta(6,stat_numelr,stat_numelr_g,lengr,np,
132 . iadg,npglob,stat_indxr)
133C----
134 IF (ispmd == 0) THEN
135 DO n=1,stat_numelr_g
136 stat_indxr(n)=n
137 clef(1,n)=npglob(6*(n-1)+6)
138 clef(2,n)=npglob(6*(n-1)+1)
139 ENDDO
140 CALL my_orders(0,work,clef,stat_indxr,stat_numelr_g,2)
141C----
142 iprt0=0
143 DO n=1,stat_numelr_g
144 k=stat_indxr(n)
145 jj=6*(k-1)
146 iprt=npglob(jj+5)
147 ioff=npglob(jj+6)
148 IF (idel==0 .OR. (idel==1 .AND. ioff >= 1)) THEN
149 IF (iprt /= iprt0) THEN
150 WRITE(iugeo,'(A,I10)')'/SPRING/',ipart(4,iprt)
151 WRITE(iugeo,'(A)')
152 . '#SPRING_ID NOD1 NOD2 NOD3'
153 iprt0=iprt
154 ENDIF
155 IF (npglob(jj+4) > 0) THEN
156 WRITE(iugeo,'(4I10)') npglob(jj+1),npglob(jj+2),
157 . npglob(jj+3),npglob(jj+4)
158 ELSE
159 WRITE(iugeo,'(3I10)') npglob(jj+1),npglob(jj+2),
160 . npglob(jj+3)
161 ENDIF
162 ENDIF !IF (IDEL)
163 ENDDO ! DO N=1,STAT_NUMELR_G
164 ENDIF ! IF (ISPMD == 0)
165C-----------------------------------------------
166 DEALLOCATE(iadd)
167 DEALLOCATE(iadg)
168 DEALLOCATE(np)
169 DEALLOCATE(npglob)
170 DEALLOCATE(clef)
171 RETURN
172 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_spring_spmd
subroutine stat_spring_spmd(itab, ipart, ixr, ipartr, ipart_state, nodtag, stat_indxr, lengr, iparg, elbuf_tab, idel)
Definition stat_spring_spmd.F:38