OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
parsor.F File Reference
#include "implicit_f.inc"
#include "com01_c.inc"
#include "com04_c.inc"
#include "param_c.inc"
#include "sphcom.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine parsor (x, d, xnorm, iadd, cdg, bufel, iparg, ixs, ixq, ixc, ixtg, ixt, ixp, ixr, invert, kxsp, ixsp)

Function/Subroutine Documentation

◆ parsor()

subroutine parsor ( x,
d,
xnorm,
integer, dimension(*) iadd,
cdg,
bufel,
integer, dimension(nparg,*) iparg,
integer, dimension(nixs,*) ixs,
integer, dimension(nixq,*) ixq,
integer, dimension(nixc,*) ixc,
integer, dimension(nixtg,*) ixtg,
integer, dimension(nixt,*) ixt,
integer, dimension(nixp,*) ixp,
integer, dimension(nixr,*) ixr,
integer, dimension(*) invert,
integer, dimension(nisp,*) kxsp,
integer, dimension(kvoisph,*) ixsp )

Definition at line 32 of file parsor.F.

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