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 ../starter/source/output/anim/parsors.F
25!||--- called by ------------------------------------------------------
26!|| genani1 ../starter/source/output/anim/genani1.F
27!||--- calls -----------------------------------------------------
28!||====================================================================
29 SUBROUTINE parsors(IADD ,IPARG ,IXS ,MATER ,IPARTS ,
30 2 EL2FA ,
31 3 INSPH ,KXSP ,IPARTSP,
32 4 IXS10 ,IXS20 ,IXS16 ,NNSPH ,ISPH3D,
33 5 SHFT16 ,SHFTSPH ,NNSPHG)
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
207 END
my_real
#define my_real
Definition cppsort.cpp:32
parsors
subroutine parsors(iadd, iparg, ixs, mater, iparts, el2fa, insph, kxsp, ipartsp, ixs10, ixs20, ixs16, nnsph, isph3d, shft16, shftsph, nnsphg)
Definition parsors.F:34
write_i_c
void write_i_c(int *w, int *len)
Definition write_routtines.c:645