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!||--- uses -----------------------------------------------------
29!||====================================================================
30 SUBROUTINE parsors(IADD ,IPARG ,IXS ,MATER ,IPARTS ,
31 2 EL2FA ,
32 3 INSPH ,KXSP ,IPARTSP,
33 4 IXS10 ,IXS20 ,IXS16 ,NNSPH ,ISPH3D,
34 5 SHFT16 ,SHFTSPH ,NNSPHG)
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
209 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:35
write_i_c
void write_i_c(int *w, int *len)
Definition write_routines.c:645