OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
parsorf.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!|| parsorf ../engine/source/output/anim/generate/parsorf.F
25!||--- called by ------------------------------------------------------
26!|| genani ../engine/source/output/anim/generate/genani.F
27!||--- calls -----------------------------------------------------
28!|| spmd_iget_partn ../engine/source/mpi/anim/spmd_iget_partn.F
29!|| spmd_iglob_partn ../engine/source/mpi/anim/spmd_iglob_partn.F
30!|| write_i_c ../common_source/tools/input_output/write_routines.c
31!||--- uses -----------------------------------------------------
32!|| elbufdef_mod ../common_source/modules/mat_elem/elbufdef_mod.F90
33!|| element_mod ../common_source/modules/elements/element_mod.F90
34!||====================================================================
35 SUBROUTINE parsorf(ELBUF_TAB,
36 . X ,D ,IADD ,CDG ,IPARG ,
37 . IXT ,IXP ,IXR ,MATER ,EL2FA ,
38 . DD_IAD ,IADG ,IPARTT ,IPARTP,IPARTR ,
39 . NFACPTX,IXEDGE,NODGLOB,NB1D ,NANIM1D_L,
40 . IPART ,IGEO ,IADG_TPR,SIADG)
41C-----------------------------------------------
42C M o d u l e s
43C-----------------------------------------------
44 USE elbufdef_mod
45 use element_mod , only : nixt,nixr,nixp
46C-----------------------------------------------
47C I m p l i c i t T y p e s
48C-----------------------------------------------
49#include "implicit_f.inc"
50C-----------------------------------------------
51C C o m m o n B l o c k s
52C-----------------------------------------------
53#include "com01_c.inc"
54#include "com04_c.inc"
55#include "param_c.inc"
56#include "scr17_c.inc"
57#include "task_c.inc"
58#include "spmd_c.inc"
59C-----------------------------------------------
60C D u m m y A r g u m e n t s
61C-----------------------------------------------
62C REAL
63 my_real
64 . x(*),d(*),cdg(*)
65 INTEGER IADD(*),IPARG(NPARG,*),
66 . IXT(NIXT,*),IXP(NIXP,*),IXR(NIXR,*),
67 . MATER(*),EL2FA(*),
68 . iadg(nspmd,*),
69 . dd_iad(nspmd+1,*),
70 . ipartt(*),ipartp(*),ipartr(*),
71 . nfacptx(3,*),ixedge(2,*),ipart(lipart1,*),
72 . igeo(npropgi,*)
73 INTEGER NODGLOB(*),NB1D,NANIM1D_L,SIADG
74 INTEGER, DIMENSION(NSPMD,*), INTENT(INOUT) :: IADG_TPR
75C
76 TYPE (ELBUF_STRUCT_), DIMENSION(NGROUP) :: ELBUF_TAB
77C-----------------------------------------------
78C REAL
79 my_real
80 . off
81 INTEGER II(4),IE,NG, ITY, LFT, LLT, N, I, J,
82 . IPRT, NEL, IAD, NPAR, NFT,MTN,
83 . NN1,NN2,NN3,NN4,NN5,NN6,NN7,NN8,NN9,NN10,
84 . jj,k,nax1d
85 INTEGER NP((NB1D+NANIM1D_L)*2),BUF,GBUF
86C-----------------------------------------------
87 ie = 0
88C
89 nn1 = 1
90 nn2 = 1
91 nn3 = 1
92 nn4 = nn3
93 nn5 = nn4
94 nn6 = nn5
95 nn7 = nn6 + numelt
96 nn8 = nn7 + numelp
97 nn9 = nn8 + numelr
98 nn10= nn9
99C-----------------------------------------------
100 npar = 0
101 jj = 0
102C-----------------------------------------------
103C PART
104C-----------------------------------------------
105C In SPMD you must send the info even qd we have 0 local elem
106 IF (numelp + numelt + numelr /= 0 .OR. nspmd > 1) THEN
107 DO iprt=1,npart
108 IF (mater(iprt) /= 3) cycle
109C Scinde car test because nfacptx (1, iprt) can be "out of core".
110 IF (numelxg > 0 . and. igeo(11,ipart(2,iprt)) == 28) cycle
111C
112 npar = npar + 1
113 DO ng=1,ngroup
114 mtn =iparg(1,ng)
115 nel =iparg(2,ng)
116 nft =iparg(3,ng)
117 iad =iparg(4,ng)
118 ity =iparg(5,ng)
119 lft=1
120 llt=nel
121C-----------------------------------------------
122C TRUSS
123C-----------------------------------------------
124 IF (ity == 4) THEN
125 DO i=lft,llt
126 n = i + nft
127 IF (ipartt(n) /= iprt) cycle
128 off = elbuf_tab(ng)%GBUF%OFF(i)
129 IF (nspmd == 1) THEN
130 ii(1) = ixt(2,n)-1
131 ii(2) = ixt(3,n)-1
132 CALL write_i_c(ii,2)
133 ELSE
134 np(jj+1) = nodglob(ixt(2,n))-1
135 np(jj+2) = nodglob(ixt(3,n))-1
136 ENDIF
137 ie = ie + 1
138 el2fa(nn6+n) = ie
139 jj = jj + 2
140 ENDDO ! DO I=LFT,LLT
141C-----------------------------------------------
142C POUTRES
143C-----------------------------------------------
144 ELSEIF (ity == 5) THEN
145 DO i=lft,llt
146 n = i + nft
147 IF (ipartp(n) /= iprt) cycle
148 off = elbuf_tab(ng)%GBUF%OFF(i)
149 IF (nspmd == 1) THEN
150 ii(1) = ixp(2,n)-1
151 ii(2) = ixp(3,n)-1
152 CALL write_i_c(ii,2)
153 ELSE
154 np(jj+1) = nodglob(ixp(2,n))-1
155 np(jj+2) = nodglob(ixp(3,n))-1
156 ENDIF
157 ie = ie + 1
158 el2fa(nn7+n) = ie
159 jj = jj + 2
160 ENDDO ! DO I=LFT,LLT
161C-----------------------------------------------
162C RESSORTS
163C-----------------------------------------------
164 ELSEIF (ity == 6) THEN
165 DO i=lft,llt
166 n = i + nft
167 IF (ipartr(n) /= iprt) cycle
168 off = elbuf_tab(ng)%GBUF%OFF(i)
169 IF (nspmd == 1) THEN
170 ii(1) = ixr(2,n)-1
171 ii(2) = ixr(3,n)-1
172 CALL write_i_c(ii,2)
173 ELSE
174 np(jj+1) = nodglob(ixr(2,n))-1
175 np(jj+2) = nodglob(ixr(3,n))-1
176 ENDIF
177 ie = ie + 1
178 el2fa(nn8+n) = ie
179 jj = jj + 2
180 IF (mtn == 3) THEN
181 IF (nspmd == 1) THEN
182 ii(1) = ixr(3,n)-1
183 ii(2) = ixr(4,n)-1
184 CALL write_i_c(ii,2)
185 ELSE
186 np(jj+1) = nodglob(ixr(3,n))-1
187 np(jj+2) = nodglob(ixr(4,n))-1
188 ENDIF
189 ie = ie + 1
190C EL2FA(NN8+N) = IE
191 jj = jj + 2
192 ENDIF ! IF (MTN == 3)
193 ENDDO ! DO I=LFT,LLT
194 ENDIF ! IF (ITY)
195 ENDDO ! DO NG=1,NGROUP
196C-----------------------------------------------
197C PART ADRESS
198C-----------------------------------------------
199 iadd(npar) = ie
200 ENDDO ! DO IPRT=1,NPART
201 ENDIF ! IF (NUMELP + NUMELT + NUMELR /= 0 .OR. NSPMD > 1)
202C-----------------------------------------------
203C X-ELEMENTS PARTS ARE WRITTEN AFTER ALL (BUT RBODIES) 1D PARTS.
204C-----------------------------------------------
205 IF (nanim1d > 0) THEN
206 nax1d=0
207 DO iprt=1,npart
208 IF (mater(iprt) /= 3) cycle
209 IF (igeo(11,ipart(2,iprt)) == 28) THEN
210 npar = npar + 1
211 DO j=1,nfacptx(1,iprt)
212 IF (nspmd == 1) THEN
213 ii(1)=ixedge(1,nax1d+j)-1
214 ii(2)=ixedge(2,nax1d+j)-1
215 CALL write_i_c(ii,2)
216 ELSE
217 np(jj+1)=nodglob(ixedge(1,nax1d+j))-1
218 np(jj+2)=nodglob(ixedge(2,nax1d+j))-1
219 ENDIF
220 jj = jj+2
221 ENDDO
222 nax1d=nax1d+nfacptx(1,iprt)
223 ie=ie+nfacptx(1,iprt)
224 iadd(npar)=-ie
225 ENDIF ! IF (IGEO(11,IPART(2,IPRT)) == 28)
226 ENDDO ! DO IPRT=1,NPART
227 ENDIF ! IF (NANIM1D > 0)
228C-----------------------------------------------
229
230 IF (nspmd > 1) THEN
231 IF (ispmd == 0) THEN
232 gbuf = npart
233 buf = (nb1dg+nanim1d)*2
234 ELSE
235 gbuf = 1
236 buf = 1
237 ENDIF
238 IF(siadg>0) iadg_tpr(1:nspmd,1:npar) = 0
239C
240 CALL spmd_iglob_partn(iadd,npar,iadg,gbuf)
241 IF(siadg>0) THEN
242 IF(ispmd==0) THEN
243! ----------------
244 DO k=1,nspmd
245! ----------------
246 n = 1
247 IF(iadg(k,n)<=0) THEN
248 iadg_tpr(k,n) = 0
249 ELSE
250 iadg_tpr(k,n) = iadg(k,n)
251 ENDIF
252 iadg(k,n) = abs(iadg(k,n))
253! ----------------
254 DO n = 2, npar
255 IF(iadg(k,n)<=0) THEN
256 iadg_tpr(k,n) = iadg_tpr(k,n-1)
257 ELSE
258 iadg_tpr(k,n) = iadg(k,n)
259 ENDIF
260 iadg(k,n) = abs(iadg(k,n))
261 ENDDO
262! ----------------
263 ENDDO
264! ----------------
265 ENDIF
266 ENDIF
267
268 CALL spmd_iget_partn(2,jj,np,npar,iadg,buf,1)
269 ELSE ! IADG filling for mono/multi compatibility
270 IF(siadg>0) THEN
271 DO i = 1, npart
272 IF(iadg(1,i)<=0) THEN
273 iadg_tpr(1,i) = 0
274 ELSE
275 iadg_tpr(1,i) = iadd(i)
276 ENDIF
277 iadg(1,i) = abs(iadd(i))
278 END DO
279 ENDIF
280 ENDIF ! IF (NSPMD > 1)
281
282
283
284C-----------------------------------------------
285 RETURN
286 END
my_real
#define my_real
Definition cppsort.cpp:32
parsorf
subroutine parsorf(elbuf_tab, x, d, iadd, cdg, iparg, ixt, ixp, ixr, mater, el2fa, dd_iad, iadg, ipartt, ipartp, ipartr, nfacptx, ixedge, nodglob, nb1d, nanim1d_l, ipart, igeo, iadg_tpr, siadg)
Definition parsorf.F:41
spmd_iget_partn
subroutine spmd_iget_partn(size, nbf_l, np, nbpart, iadg, srbuf, iflag)
Definition spmd_iget_partn.F:50
spmd_iglob_partn
subroutine spmd_iglob_partn(iad, nbpart, iadg, sbuf)
Definition spmd_iglob_partn.F:39
write_i_c
void write_i_c(int *w, int *len)
Definition write_routines.c:645