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