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"

Go to the source code of this file.

Functions/Subroutines

subroutine parsors (iadd, iparg, ixs, mater, iparts, el2fa, insph, kxsp, ipartsp, ixs10, ixs20, ixs16, nnsph, isph3d, shft16, shftsph, nnsphg)

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 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 shft16,
integer shftsph,
integer nnsphg )

Definition at line 29 of file parsors.F.

34C-----------------------------------------------
35C I m p l i c i t T y p e s
36C-----------------------------------------------
37#include "implicit_f.inc"
38C-----------------------------------------------
39C C o m m o n B l o c k s
40C-----------------------------------------------
41#include "com01_c.inc"
42#include "com04_c.inc"
43#include "sphcom.inc"
44#include "param_c.inc"
45C-----------------------------------------------
46C D u m m y A r g u m e n t s
47C-----------------------------------------------
48C REAL
49 INTEGER IADD(*),IPARG(NPARG,*),IXS(NIXS,*),
50 . MATER(*),EL2FA(*),IPARTS(*),
51 . INSPH,KXSP(NISP,*),IPARTSP(*),
52 . IXS10(6,*) ,IXS16(8,*) ,IXS20(12,*) ,NNSPH,
53 . ISPH3D,SHFT16,SHFTSPH ,NNSPHG
54C-----------------------------------------------
55C REAL
56 my_real
57 . off
58 INTEGER II(8),IE,NG, ITY, LFT, LLT, KPT, N, I, J,
59 . IPID, NEL, IAD, NPAR, NFT, IPRT,IALEL,MTN,
60 . NN1,NN2,NN3,NN4,NN5,NN6,NN7,NN8,NN9,NN10,
61 . JJ, K, INOD, ISOLNOD ,NNN,
62 . N9,N10,N11,N12,N13,N14,N15,N16
63C-----------------------------------------------
64C
65 nn1 = 1
66 nn2 = 1
67 nn3 = nn2 + numels
68 nn4 = nn3 + isph3d*(numsph+maxpjet)
69 ie = 0
70C-----------------------------------------------
71C MID
72C-----------------------------------------------
73 npar = 0
74 jj = 0
75C
76 DO 100 iprt = 1 , npart
77C
78 IF(mater(iprt)/=2) GOTO 100
79 npar = npar + 1
80 DO 90 ng=1,ngroup
81 nel =iparg(2,ng)
82 nft =iparg(3,ng)
83 iad =iparg(4,ng)
84 ity =iparg(5,ng)
85 isolnod = iparg(28,ng)
86 lft=1
87 llt=nel
88C-----------------------------------------------
89C SOLID 16N
90C-----------------------------------------------
91 nnn = insph + isph3d*nnsph
92 IF(ity==1.AND.isolnod==16)THEN
93 DO i=lft,llt
94 n = i + nft
95 j = n - numels8 - numels10 - numels20
96 n9 =ixs16(1,j)
97 IF( n9==0) n9=ixs(2,n)
98 n10=ixs16(2,j)
99 IF(n10==0)n10=ixs(3,n)
100 n11=ixs16(3,j)
101 IF(n11==0)n11=ixs(4,n)
102 n12=ixs16(4,j)
103 IF(n12==0)n12=ixs(5,n)
104 n13=ixs16(5,j)
105 IF(n13==0)n13=ixs(6,n)
106 n14=ixs16(6,j)
107 IF(n14==0)n14=ixs(7,n)
108 n15=ixs16(7,j)
109 IF(n15==0)n15=ixs(8,n)
110 n16=ixs16(8,j)
111 IF(n16==0)n16=ixs(9,n)
112 IF(iparts(n)==iprt) THEN
113 ii(1) = ixs(2,n) -1
114 ii(2) = n9 -1
115 ii(3) = nnn + 2*j-1 -1
116 ii(4) = n12 -1
117 ii(5) = ixs(6,n) -1
118 ii(6) = n13 -1
119 ii(7) = nnn + 2*j -1
120 ii(8) = n16 -1
121 CALL write_i_c(ii,8)
122 ii(1) = n9 -1
123 ii(2) = ixs(3,n) -1
124 ii(3) = n10 -1
125 ii(4) = nnn + 2*j-1 -1
126 ii(5) = n13 -1
127 ii(6) = ixs(7,n) -1
128 ii(7) = n14 -1
129 ii(8) = nnn + 2*j -1
130 CALL write_i_c(ii,8)
131 ii(1) = n12 -1
132 ii(2) = nnn + 2*j-1 -1
133 ii(3) = n11 -1
134 ii(4) = ixs(5,n)-1
135 ii(5) = n16 -1
136 ii(6) = nnn + 2*j -1
137 ii(7) = n15 -1
138 ii(8) = ixs(9,n)-1
139 CALL write_i_c(ii,8)
140 ii(1) = nnn + 2*j-1 -1
141 ii(2) = n10 -1
142 ii(3) = ixs(4,n)-1
143 ii(4) = n11 -1
144 ii(5) = nnn + 2*j -1
145 ii(6) = n14 -1
146 ii(7) = ixs(8,n)-1
147 ii(8) = n15 -1
148 CALL write_i_c(ii,8)
149 ie = ie + 1
150 el2fa(nn2+n) = ie
151 ie = ie + 3
152 jj = jj + 32
153 END IF
154 ENDDO
155C-----------------------------------------------
156C SOLID 8N 4N 10N 20N
157C-----------------------------------------------
158 ELSEIF(ity==1)THEN
159 DO 10 i=lft,llt
160 n = i + nft
161 IF(iparts(n)/=iprt) GOTO 10
162 ii(1) = ixs(2,n)-1
163 ii(2) = ixs(3,n)-1
164 ii(3) = ixs(4,n)-1
165 ii(4) = ixs(5,n)-1
166 ii(5) = ixs(6,n)-1
167 ii(6) = ixs(7,n)-1
168 ii(7) = ixs(8,n)-1
169 ii(8) = ixs(9,n)-1
170 CALL write_i_c(ii,8)
171 ie = ie + 1
172 el2fa(nn2+n) = ie
173 jj = jj + 8
174 10 CONTINUE
175 ELSEIF(isph3d==1.AND.ity==51)THEN
176C-----------------------------------------------
177C TETRAS SPH.
178C-----------------------------------------------
179 DO 20 i=lft,llt
180 n = i + nft
181 IF(ipartsp(n)/=iprt) GOTO 20
182 inod=kxsp(3,n)
183 ii(1) = insph+4*(n-1)+1
184 ii(2) = insph+4*(n-1)+2
185 ii(3) = insph+4*(n-1)
186 ii(4) = insph+4*(n-1)+1
187 ii(5) = insph+4*(n-1)+3
188 ii(6) = insph+4*(n-1)+2
189 ii(7) = insph+4*(n-1)+3
190 ii(8) = inod-1
191 CALL write_i_c(ii,8)
192 ie = ie + 1
193 el2fa(nn3+n) = ie
194 jj = jj + 8
195 20 CONTINUE
196 ELSE
197 ENDIF
198 90 CONTINUE
199C-----------------------------------------------
200C PART ADRESS
201C-----------------------------------------------
202 iadd(npar) = ie
203 100 CONTINUE
204C
205C-----------------------------------------------
206 RETURN
my_real
#define my_real
Definition cppsort.cpp:32
write_i_c
void write_i_c(int *w, int *len)
Definition write_routtines.c:645