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

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