OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
parsors.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!|| parsors ../engine/source/output/anim/generate/parsors.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!||====================================================================
32 SUBROUTINE parsors(IADD ,IPARG ,IXS ,MATER ,IPARTS ,
33 2 EL2FA , DD_IAD,
34 3 IADG ,INSPH ,KXSP ,IPARTSP,
35 4 IXS10 ,IXS20 ,IXS16 ,NNSPH ,ISPH3D,
36 5 NODGLOB,SHFT16 ,SHFTSPH ,NNSPHG,IPARTIG3D,
37 6 KXIG3D,IGEO,IG3DSOLID)
38C-----------------------------------------------
39C I m p l i c i t T y p e s
40C-----------------------------------------------
41#include "implicit_f.inc"
42C-----------------------------------------------
43C C o m m o n B l o c k s
44C-----------------------------------------------
45#include "com01_c.inc"
46#include "com04_c.inc"
47#include "sphcom.inc"
48#include "param_c.inc"
49#include "task_c.inc"
50#include "spmd_c.inc"
51C-----------------------------------------------
52C D u m m y A r g u m e n t s
53C-----------------------------------------------
54C REAL
55 INTEGER IADD(*),IPARG(NPARG,*),IXS(NIXS,*),
56 . MATER(*),EL2FA(*),IPARTS(*),
57 . IADG(NSPMD,*),
58 . DD_IAD(NSPMD+1,*),
59 . INSPH,KXSP(NISP,*),IPARTSP(*),
60 . ixs10(6,*) ,ixs16(8,*) ,ixs20(12,*) ,nnsph,
61 . isph3d,nodglob(*),shft16,shftsph ,nnsphg,ipartig3d(*),
62 . kxig3d(nixig3d,*),
63 . igeo(npropgi,*),ig3dsolid(8,27,*)
64C-----------------------------------------------
65C REAL
66 my_real
67 . off
68 INTEGER II(8),IE,NG, ITY, LFT, LLT, KPT, N, I, J,
69 . IPID, NEL, IAD, NPAR, NFT, IPRT,IALEL,MTN,
70 . NN1,NN2,NN3,NN4,NN5,NN6,NN7,NN8,NN9,NN10,
71 . jj, k, inod, isolnod ,nnn,ie1,idbrick,
72 . n9,n10,n11,n12,n13,n14,n15,n16,iprop,px,py,pz
73 INTEGER BUF,BUFP,FIRST_NODE,L,M
74 INTEGER, DIMENSION(:), ALLOCATABLE :: NP
75C-----------------------------------------------
76C
77 ALLOCATE(NP(NUMELS*8+24*NUMELS16+NUMSPH*8))
78 nn1 = 1
79 nn2 = 1
80 nn3 = nn2 + numels
81 nn4 = nn3 + isph3d*(numsph+maxpjet)
82 nn5 = nn4 + numelig3d
83 ie = 0
84C-----------------------------------------------
85C MID
86C-----------------------------------------------
87 npar = 0
88 jj = 0
89C
90 DO 100 iprt = 1 , npart
91C
92 IF(mater(iprt)/=2) GOTO 100
93 npar = npar + 1
94 DO 90 ng=1,ngroup
95c IF(ANIM_K==0.AND.IPARG(8,NG)==1)GOTO 90
96 nel =iparg(2,ng)
97 nft =iparg(3,ng)
98 iad =iparg(4,ng)
99 ity =iparg(5,ng)
100 isolnod = iparg(28,ng)
101 lft=1
102 llt=nel
103C-----------------------------------------------
104C SOLID 16N
105C-----------------------------------------------
106 nnn = insph + isph3d*nnsph
107 IF(ity==1.AND.isolnod==16)THEN
108 DO i=lft,llt
109 n = i + nft
110 j = n - numels8 - numels10 - numels20
111 n9 =ixs16(1,j)
112 IF( n9==0) n9=ixs(2,n)
113 n10=ixs16(2,j)
114 IF(n10==0)n10=ixs(3,n)
115 n11=ixs16(3,j)
116 IF(n11==0)n11=ixs(4,n)
117 n12=ixs16(4,j)
118 IF(n12==0)n12=ixs(5,n)
119 n13=ixs16(5,j)
120 IF(n13==0)n13=ixs(6,n)
121 n14=ixs16(6,j)
122 IF(n14==0)n14=ixs(7,n)
123 n15=ixs16(7,j)
124 IF(n15==0)n15=ixs(8,n)
125 n16=ixs16(8,j)
126 IF(n16==0)n16=ixs(9,n)
127 IF(iparts(n)==iprt) THEN
128 IF (nspmd == 1) THEN
129 ii(1) = ixs(2,n) -1
130 ii(2) = n9 -1
131 ii(3) = nnn + 2*j-1 -1
132 ii(4) = n12 -1
133 ii(5) = ixs(6,n) -1
134 ii(6) = n13 -1
135 ii(7) = nnn + 2*j -1
136 ii(8) = n16 -1
137 CALL write_i_c(ii,8)
138 ii(1) = n9 -1
139 ii(2) = ixs(3,n) -1
140 ii(3) = n10 -1
141 ii(4) = nnn + 2*j-1 -1
142 ii(5) = n13 -1
143 ii(6) = ixs(7,n) -1
144 ii(7) = n14 -1
145 ii(8) = nnn + 2*j -1
146 CALL write_i_c(ii,8)
147 ii(1) = n12 -1
148 ii(2) = nnn + 2*j-1 -1
149 ii(3) = n11 -1
150 ii(4) = ixs(5,n)-1
151 ii(5) = n16 -1
152 ii(6) = nnn + 2*j -1
153 ii(7) = n15 -1
154 ii(8) = ixs(9,n)-1
155 CALL write_i_c(ii,8)
156 ii(1) = nnn + 2*j-1 -1
157 ii(2) = n10 -1
158 ii(3) = ixs(4,n)-1
159 ii(4) = n11 -1
160 ii(5) = nnn + 2*j -1
161 ii(6) = n14 -1
162 ii(7) = ixs(8,n)-1
163 ii(8) = n15 -1
164 CALL write_i_c(ii,8)
165 ELSE
166 np(jj+1) = nodglob(ixs(2,n))-1
167 np(jj+2) = nodglob(n9) -1
168 np(jj+3) = (shft16-1) + 2*j-1 -1
169 np(jj+4) = nodglob(n12) -1
170 np(jj+5) = nodglob(ixs(6,n))-1
171 np(jj+6) = nodglob(n13) -1
172 np(jj+7) = (shft16-1) + 2*j -1
173 np(jj+8) = nodglob(n16)-1
174C
175 np(jj+9) = nodglob(n9) -1
176 np(jj+10) = nodglob(ixs(3,n))-1
177 np(jj+11) = nodglob(n10) -1
178 np(jj+12) = (shft16-1) + 2*j-1 -1
179 np(jj+13) = nodglob(n13) -1
180 np(jj+14) = nodglob(ixs(7,n))-1
181 np(jj+15) = nodglob(n14)-1
182 np(jj+16) = (shft16-1) + 2*j -1
183C
184 np(jj+17) = nodglob(n12) -1
185 np(jj+18) = (shft16-1) + 2*j-1 -1
186 np(jj+19) = nodglob(n11) -1
187 np(jj+20) = nodglob(ixs(5,n)) -1
188 np(jj+21) = nodglob(n16) -1
189 np(jj+22) = (shft16-1) + 2*j -1
190 np(jj+23) = nodglob(n15)-1
191 np(jj+24) = nodglob(ixs(9,n))-1
192C
193 np(jj+25) = (shft16-1) + 2*j-1 -1
194 np(jj+26) = nodglob(n10) -1
195 np(jj+27) = nodglob(ixs(4,n)) -1
196 np(jj+28) = nodglob(n11) -1
197 np(jj+29) = (shft16-1) + 2*j -1
198 np(jj+30) = nodglob(n14)-1
199 np(jj+31) = nodglob(ixs(8,n))-1
200 np(jj+32) = nodglob(n15)-1
201 END IF
202 ie = ie + 1
203 el2fa(nn2+n) = ie
204 ie = ie + 3
205 jj = jj + 32
206 END IF
207 ENDDO
208C-----------------------------------------------
209C SOLID 8N 4N 10N 20N
210C-----------------------------------------------
211 ELSEIF(ity==1)THEN
212 DO 10 i=lft,llt
213 n = i + nft
214 IF(iparts(n)/=iprt) GOTO 10
215 IF (nspmd == 1) THEN
216 ii(1) = ixs(2,n)-1
217 ii(2) = ixs(3,n)-1
218 ii(3) = ixs(4,n)-1
219 ii(4) = ixs(5,n)-1
220 ii(5) = ixs(6,n)-1
221 ii(6) = ixs(7,n)-1
222 ii(7) = ixs(8,n)-1
223 ii(8) = ixs(9,n)-1
224 CALL write_i_c(ii,8)
225 ELSE
226 np(jj+1) = nodglob(ixs(2,n))-1
227 np(jj+2) = nodglob(ixs(3,n))-1
228 np(jj+3) = nodglob(ixs(4,n))-1
229 np(jj+4) = nodglob(ixs(5,n))-1
230 np(jj+5) = nodglob(ixs(6,n))-1
231 np(jj+6) = nodglob(ixs(7,n))-1
232 np(jj+7) = nodglob(ixs(8,n))-1
233 np(jj+8) = nodglob(ixs(9,n))-1
234 END IF
235 ie = ie + 1
236 el2fa(nn2+n) = ie
237 jj = jj + 8
238 10 CONTINUE
239 ELSEIF(isph3d==1.AND.ity==51)THEN
240C-----------------------------------------------
241C TETRAS SPH.
242C-----------------------------------------------
243 DO 20 i=lft,llt
244 n = i + nft
245 IF(ipartsp(n)/=iprt) GOTO 20
246 inod=kxsp(3,n)
247 IF (nspmd == 1) THEN
248 ii(1) = insph+4*(n-1)+1
249 ii(2) = insph+4*(n-1)+2
250 ii(3) = insph+4*(n-1)
251 ii(4) = insph+4*(n-1)+1
252 ii(5) = insph+4*(n-1)+3
253 ii(6) = insph+4*(n-1)+2
254 ii(7) = insph+4*(n-1)+3
255 ii(8) = inod-1
256 CALL write_i_c(ii,8)
257 ELSE
258 np(jj+1) = shftsph-1+4*(n-1)+1
259 np(jj+2) = shftsph-1+4*(n-1)+2
260 np(jj+3) = shftsph-1+4*(n-1)
261 np(jj+4) = shftsph-1+4*(n-1)+1
262 np(jj+5) = shftsph-1+4*(n-1)+3
263 np(jj+6) = shftsph-1+4*(n-1)+2
264 np(jj+7) = shftsph-1+4*(n-1)+3
265 np(jj+8) = nodglob(inod)-1
266 END IF
267 ie = ie + 1
268 el2fa(nn3+n) = ie
269 jj = jj + 8
270 20 CONTINUE
271 ELSEIF(ity==101)THEN
272C-----------------------------------------------
273C ISO GEO ELEMS
274C-----------------------------------------------
275 DO 30 i=lft,llt
276 iprop = kxig3d(2,i+nft)
277 px = igeo(41,iprop)
278 py = igeo(42,iprop)
279 pz = igeo(43,iprop)
280 IF(ipartig3d(i+nft)/=iprt) GOTO 30
281 ie1 = ie + 1
282 idbrick = 0
283 DO l=1,3
284 DO m=0,2
285 DO n=0,2
286 idbrick = idbrick + 1
287 ii(1) = ig3dsolid(1,idbrick,i+nft)
288 ii(2) = ig3dsolid(2,idbrick,i+nft)
289 ii(3) = ig3dsolid(3,idbrick,i+nft)
290 ii(4) = ig3dsolid(4,idbrick,i+nft)
291 ii(5) = ig3dsolid(5,idbrick,i+nft)
292 ii(6) = ig3dsolid(6,idbrick,i+nft)
293 ii(7) = ig3dsolid(7,idbrick,i+nft)
294 ii(8) = ig3dsolid(8,idbrick,i+nft)
295 CALL write_i_c(ii,8)
296 ie = ie + 1
297 jj = jj + 8
298 ENDDO
299 ENDDO
300 ENDDO
301 el2fa(nn4+i+nft) = ie1
302 30 CONTINUE
303 ELSE
304 ENDIF
305 90 CONTINUE
306C-----------------------------------------------
307C PART ADRESS
308C-----------------------------------------------
309 iadd(npar) = ie
310 100 CONTINUE
311C
312 IF (nspmd > 1) THEN
313 IF (ispmd==0) THEN
314 bufp = npart
315 buf = numelsg*8 + 24*numels16g+numsphg*8 +64*numelig3d
316 ELSE
317 bufp = 1
318 buf=1
319 END IF
320
321 CALL spmd_iglob_partn(iadd,npar,iadg,bufp)
322 CALL spmd_iget_partn(8,jj,np,npar,iadg,buf,1)
323 ELSE ! remplissage IADG pour compatibilite mono/multi
324 DO i = 1, npart
325 iadg(1,i) = iadd(i)
326 END DO
327 ENDIF
328C-----------------------------------------------
329 DEALLOCATE(np)
330 RETURN
331 END
my_real
#define my_real
Definition cppsort.cpp:32
parsors
subroutine parsors(iadd, iparg, ixs, mater, iparts, el2fa, dd_iad, iadg, insph, kxsp, ipartsp, ixs10, ixs20, ixs16, nnsph, isph3d, nodglob, shft16, shftsph, nnsphg, ipartig3d, kxig3d, igeo, ig3dsolid)
Definition parsors.F:38
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