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 34 of file parsors.F.

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