OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
parsors.F File Reference
#include "implicit_f.inc"
#include "com01_c.inc"
#include "com04_c.inc"
#include "sphcom.inc"
#include "param_c.inc"
#include "task_c.inc"
#include "spmd_c.inc"

Go to the source code of this file.

Functions/Subroutines

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)

Function/Subroutine Documentation

◆ parsors()

subroutine parsors ( integer, dimension(*) iadd,
integer, dimension(nparg,*) iparg,
integer, dimension(nixs,*) ixs,
integer, dimension(*) mater,
integer, dimension(*) iparts,
integer, dimension(*) el2fa,
integer, dimension(nspmd+1,*) dd_iad,
integer, dimension(nspmd,*) iadg,
integer insph,
integer, dimension(nisp,*) kxsp,
integer, dimension(*) ipartsp,
integer, dimension(6,*) ixs10,
integer, dimension(12,*) ixs20,
integer, dimension(8,*) ixs16,
integer nnsph,
integer isph3d,
integer, dimension(*) nodglob,
integer shft16,
integer shftsph,
integer nnsphg,
integer, dimension(*) ipartig3d,
integer, dimension(nixig3d,*) kxig3d,
integer, dimension(npropgi,*) igeo,
integer, dimension(8,27,*) ig3dsolid )

Definition at line 32 of file parsors.F.

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
my_real
#define my_real
Definition cppsort.cpp:32
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