OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
parsor.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!|| parsor ../starter/source/output/anim/parsor.F
25!||--- called by ------------------------------------------------------
26!|| dd_ani ../starter/source/output/anim/dd_ani.F
27!||--- calls -----------------------------------------------------
28!|| facnor ../starter/source/output/anim/facnor.F
29!|| facnor2 ../starter/source/output/anim/facnor.F
30!||====================================================================
31 SUBROUTINE parsor(X ,D ,XNORM ,IADD ,CDG ,
32 . BUFEL,IPARG,IXS ,IXQ ,IXC ,
33 . IXTG ,IXT ,IXP ,IXR ,INVERT,
34 . KXSP ,IXSP )
35C-----------------------------------------------
36C I m p l i c i t T y p e s
37C-----------------------------------------------
38#include "implicit_f.inc"
39C-----------------------------------------------
40C C o m m o n B l o c k s
41C-----------------------------------------------
42#include "com01_c.inc"
43#include "com04_c.inc"
44#include "param_c.inc"
45#include "sphcom.inc"
46C-----------------------------------------------
47C D u m m y A r g u m e n t s
48C-----------------------------------------------
49C REAL
50 my_real
51 . x(*),d(*),xnorm(3,*),cdg(*),bufel(*)
52 INTEGER IADD(*),IPARG(NPARG,*),
53 . ixs(nixs,*),ixq(nixq,*),ixc(nixc,*),ixtg(nixtg,*),
54 . ixt(nixt,*),ixp(nixp,*),ixr(nixr,*),
55 . invert(*),kxsp(nisp,*), ixsp(kvoisph,*)
56C-----------------------------------------------
57C REAL
58 my_real
59 . off
60 INTEGER II(4),IE,NG, ITY, LFT, LLT, KPT, N, I, J, N1, N2,
61 . ipid, nel, iad, npar, nft, imid,ialel, mtn
62 INTEGER ANIM_K, PROC, P, jj
63C-----------------------------------------------
64C NORMALE
65C-----------------------------------------------
66 DO 5 i=1,numnod
67 DO 5 j=1,3
68 xnorm(j,i) = zero
69 5 CONTINUE
70 ie = 0
71C-----------------------------------------------
72C MID
73C-----------------------------------------------
74 npar = 0
75C
76C-----------------------------------------------
77C PART DU DOMAINE DECOMPOSITION
78C-----------------------------------------------
79C
80 DO proc = 1, nspmd
81 npar = npar + 1
82 DO 800 ng=1,ngroup
83 mtn =iparg(1,ng)
84 nel =iparg(2,ng)
85 nft =iparg(3,ng)
86 iad =iparg(4,ng)
87 ity =iparg(5,ng)
88 p =iparg(32,ng)+1
89 lft=1
90 llt=nel
91C test si proc doit traiter ce groupe
92 IF (p/=proc) GOTO 790
93C-----------------------------------------------
94C SOLID 8N
95C-----------------------------------------------
96 IF(ity==1)THEN
97 ialel=iparg(7,ng)+iparg(11,ng)
98 IF(ialel==0)THEN
99 DO 610 i=lft,llt
100 n = i + nft
101C OFF = BUFEL(IAD+I-1)
102C IF(OFF==0.)GOTO 610
103 ii(1) = ixs(3,n)
104 ii(2) = ixs(2,n)
105 ii(3) = ixs(5,n)
106 ii(4) = ixs(4,n)
107 CALL facnor2(x,ii,xnorm,invert(n))
108 ii(1) = ii(1)-1
109 ii(2) = ii(2)-1
110 ii(3) = ii(3)-1
111 ii(4) = ii(4)-1
112 CALL write_i_c(ii,4)
113 ii(1) = ixs(6,n)
114 ii(2) = ixs(7,n)
115 ii(3) = ixs(8,n)
116 ii(4) = ixs(9,n)
117 CALL facnor2(x,ii,xnorm,invert(n))
118 ii(1) = ii(1)-1
119 ii(2) = ii(2)-1
120 ii(3) = ii(3)-1
121 ii(4) = ii(4)-1
122 CALL write_i_c(ii,4)
123 ii(1) = ixs(2,n)
124 ii(2) = ixs(3,n)
125 ii(3) = ixs(7,n)
126 ii(4) = ixs(6,n)
127 CALL facnor2(x,ii,xnorm,invert(n))
128 ii(1) = ii(1)-1
129 ii(2) = ii(2)-1
130 ii(3) = ii(3)-1
131 ii(4) = ii(4)-1
132 CALL write_i_c(ii,4)
133 ii(1) = ixs(4,n)
134 ii(2) = ixs(5,n)
135 ii(3) = ixs(9,n)
136 ii(4) = ixs(8,n)
137 CALL facnor2(x,ii,xnorm,invert(n))
138 ii(1) = ii(1)-1
139 ii(2) = ii(2)-1
140 ii(3) = ii(3)-1
141 ii(4) = ii(4)-1
142 CALL write_i_c(ii,4)
143 ii(1) = ixs(3,n)
144 ii(2) = ixs(4,n)
145 ii(3) = ixs(8,n)
146 ii(4) = ixs(7,n)
147 CALL facnor2(x,ii,xnorm,invert(n))
148 ii(1) = ii(1)-1
149 ii(2) = ii(2)-1
150 ii(3) = ii(3)-1
151 ii(4) = ii(4)-1
152 CALL write_i_c(ii,4)
153 ii(1) = ixs(6,n)
154 ii(2) = ixs(9,n)
155 ii(3) = ixs(5,n)
156 ii(4) = ixs(2,n)
157 CALL facnor2(x,ii,xnorm,invert(n))
158 ii(1) = ii(1)-1
159 ii(2) = ii(2)-1
160 ii(3) = ii(3)-1
161 ii(4) = ii(4)-1
162 CALL write_i_c(ii,4)
163 ie = ie + 6
164 610 CONTINUE
165 ENDIF
166C-----------------------------------------------
167C QUAD
168C-----------------------------------------------
169 ELSEIF(ity==2)THEN
170 DO 620 i=lft,llt
171 n = i + nft
172C OFF = BUFEL(IAD+I-1)
173C IF(OFF==0.)GOTO 620
174 ii(1) = ixq(2,n)
175 ii(2) = ixq(3,n)
176 ii(3) = ixq(4,n)
177 ii(4) = ixq(5,n)
178 xnorm(1,ii(1)) = one
179 xnorm(2,ii(1)) = zero
180 xnorm(3,ii(1)) = zero
181 ii(1) = ii(1)-1
182 ii(2) = ii(2)-1
183 ii(3) = ii(3)-1
184 ii(4) = ii(4)-1
185 invert(n) = 1
186 CALL write_i_c(ii,4)
187 ie = ie + 1
188 620 CONTINUE
189C-----------------------------------------------
190C COQUES
191C-----------------------------------------------
192 ELSEIF(ity==3)THEN
193 kpt =iparg(6,ng)
194 DO 630 i=lft,llt
195 n = i + nft
196C OFF = BUFEL(IAD+I+16*NEL-1)
197C IF(OFF==0.)GOTO 630
198 ii(1) = ixc(2,n)
199 ii(2) = ixc(3,n)
200 ii(3) = ixc(4,n)
201 ii(4) = ixc(5,n)
202 CALL facnor(x,d,ii,xnorm,cdg,invert(n))
203 ii(1) = ii(1)-1
204 ii(2) = ii(2)-1
205 ii(3) = ii(3)-1
206 ii(4) = ii(4)-1
207 CALL write_i_c(ii,4)
208 ie = ie + 1
209 630 CONTINUE
210C-----------------------------------------------
211C TRUSS
212C-----------------------------------------------
213 ELSEIF(ity==4)THEN
214 DO 640 i=lft,llt
215 n = i + nft
216C OFF = BUFEL(IAD+I-1)
217C IF(OFF==0.)GOTO 640
218 ii(1) = ixt(2,n)-1
219 ii(2) = ixt(3,n)-1
220 ii(3) = ixt(3,n)-1
221 ii(4) = ixt(2,n)-1
222 invert(n) = 0
223 CALL write_i_c(ii,4)
224 ie = ie + 1
225 640 CONTINUE
226C-----------------------------------------------
227C POUTRES
228C-----------------------------------------------
229 ELSEIF(ity==5)THEN
230 DO 650 i=lft,llt
231 n = i + nft
232C OFF = BUFEL(IAD+I-1)
233C IF(OFF==0.)GOTO 650
234 ii(1) = ixp(2,n)-1
235 ii(2) = ixp(3,n)-1
236 ii(3) = ixp(3,n)-1
237 ii(4) = ixp(2,n)-1
238 invert(n) = 0
239 CALL write_i_c(ii,4)
240 ie = ie + 1
241 650 CONTINUE
242C-----------------------------------------------
243C RESSORTS
244C-----------------------------------------------
245 ELSEIF(ity==6)THEN
246 DO 660 i=lft,llt
247 n = i + nft
248C OFF = BUFEL(IAD+I-1)
249C IF(OFF==0.)GOTO 660
250 ii(1) = ixr(2,n)-1
251 ii(2) = ixr(3,n)-1
252 IF(mtn==3)THEN
253 ii(3) = ixr(4,n)-1
254 ii(4) = ixr(3,n)-1
255 ELSE
256 ii(3) = ixr(3,n)-1
257 ii(4) = ixr(2,n)-1
258 ENDIF
259 invert(n) = 0
260 CALL write_i_c(ii,4)
261 ie = ie + 1
262 660 CONTINUE
263C-----------------------------------------------
264C COQUES 3 NOEUDS
265C-----------------------------------------------
266 ELSEIF(ity==7)THEN
267 kpt =iparg(6,ng)
268 DO 670 i=lft,llt
269 n = i + nft
270C OFF = BUFEL(IAD+I+16*NEL-1)
271C IF(OFF==0.)GOTO 670
272 ii(1) = ixtg(2,n)
273 ii(2) = ixtg(3,n)
274 ii(3) = ixtg(4,n)
275 ii(4) = ii(3)
276 CALL facnor(x,d,ii,xnorm,cdg,invert(n+numelc))
277 ii(1) = ii(1)-1
278 ii(2) = ii(2)-1
279 ii(3) = ii(3)-1
280 ii(4) = ii(4)-1
281 CALL write_i_c(ii,4)
282 ie = ie + 1
283 670 CONTINUE
284C-----------------------------------------------
285C SPH Particules
286C-----------------------------------------------
287 ELSEIF(ity==51)THEN
288C idem poutre pour visualisation domdec SPH
289 DO i=lft,llt
290 n = i + nft
291 n1 = kxsp(3,n)
292C on prend les 12 premieres cellules voisines
293 DO jj = 1,min(12,kxsp(4,n))
294 n2 = ixsp(jj,n)
295 IF(n1<n2)THEN
296 ii(1) = n1-1
297 ii(2) = n2-1
298 ii(3) = n2-1
299 ii(4) = n1-1
300 invert(n) = 0
301 CALL write_i_c(ii,4)
302 ie = ie + 1
303 ENDIF
304 ENDDO
305 END DO
306 ELSE
307 ENDIF
308 790 CONTINUE
309 800 CONTINUE
310C-----------------------------------------------
311C PART ADRESS
312C-----------------------------------------------
313 iadd(npar) = ie
314 END DO
315C
316 RETURN
317 END
my_real
#define my_real
Definition cppsort.cpp:32
invert
subroutine invert(matrix, inverse, n, errorflag)
Definition hm_read_rbe3.F:1354
min
#define min(a, b)
Definition macros.h:20
parsor
subroutine parsor(x, d, xnorm, iadd, cdg, bufel, iparg, ixs, ixq, ixc, ixtg, ixt, ixp, ixr, invert, kxsp, ixsp)
Definition parsor.F:35
facnor2
subroutine facnor2(x, ii, xnorm, invert)
Definition facnor.F:110
facnor
subroutine facnor(x, d, ii, xnorm, cdg, invert)
Definition facnor.F:30
write_i_c
void write_i_c(int *w, int *len)
Definition write_routtines.c:645