OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
fxbsgmaj.F File Reference
#include "implicit_f.inc"
#include "mvsiz_p.inc"
#include "com01_c.inc"
#include "com04_c.inc"
#include "param_c.inc"
#include "units_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine fxbsgmaj (elbuf, fxbelm, fxbsig, fxbdep, fxbipm, eiel, partsav, rt, itn, iparg, nfx, lvsig, ircs, elbuf_tab)
subroutine schrep (nel, sig, sigl, r)

Function/Subroutine Documentation

◆ fxbsgmaj()

subroutine fxbsgmaj ( elbuf,
integer, dimension(*) fxbelm,
fxbsig,
fxbdep,
integer, dimension(*) fxbipm,
eiel,
partsav,
rt,
integer itn,
integer, dimension(nparg,*) iparg,
integer nfx,
integer lvsig,
integer ircs,
type (elbuf_struct_), dimension (ngroup), target elbuf_tab )

Definition at line 32 of file fxbsgmaj.F.

35C-----------------------------------------------
36C M o d u l e s
37C-----------------------------------------------
38 USE elbufdef_mod
39C-----------------------------------------------
40C I m p l i c i t T y p e s
41C-----------------------------------------------
42#include "implicit_f.inc"
43C-----------------------------------------------
44C G l o b a l P a r a m e t e r s
45C-----------------------------------------------
46#include "mvsiz_p.inc"
47C-----------------------------------------------
48C C o m m o n B l o c k s
49C-----------------------------------------------
50#include "com01_c.inc"
51#include "com04_c.inc"
52#include "param_c.inc"
53#include "units_c.inc"
54C-----------------------------------------------
55C D u m m y A r g u m e n t s
56C-----------------------------------------------
57 INTEGER FXBELM(*), FXBIPM(*), ITN, IPARG(NPARG,*), NFX, LVSIG,
58 . IRCS
59 my_real
60 . elbuf(*), fxbsig(*), fxbdep(*), eiel ,
61 . partsav(npsav,*), rt(*)
62 TYPE (ELBUF_STRUCT_), DIMENSION (NGROUP), TARGET :: ELBUF_TAB
63C-----------------------------------------------
64C L o c a l V a r i a b l e s
65C-----------------------------------------------
66 INTEGER NELS, NELC, NELTG, NML, NME, IM, IG, OFFSET, NFT, NFS,
67 . LAST, IAD1, IAD2, IAD3, I, MX, NFT1, II, OFF, NG,
68 . IGOF, IFILE, NFS2, J, IAD, NELT, NELP,IEL,JJ(6),NEL,AELM
69 my_real
70 . fac,fac2,sigl(mvsiz,6),sig(mvsiz,6),
71 . eielc(npart),eielp(npart), vsig(lvsig)
72 TYPE(G_BUFEL_) ,POINTER :: GBUF
73C=======================================================================
74 nml=fxbipm(4)
75 nme=fxbipm(17)
76 nels=fxbipm(21)
77 nelc=fxbipm(22)
78 nelt=fxbipm(34)
79 nelp=fxbipm(35)
80 neltg=fxbipm(23)
81C
82 aelm=fxbipm(19)
83C
84 nft=aelm-1
85 nfs=0
86 DO i=1,npart
87 eielc(i)=zero
88 eielp(i)=zero
89 ENDDO
90 eiel=zero
91 DO ig=1,nels,nvsiz
92 offset=ig-1
93 last=min(nvsiz,nels-offset)
94 DO i=1,last
95 ng =fxbelm(nft+1)
96 iel=fxbelm(nft+2)
97 gbuf => elbuf_tab(ng)%GBUF
98 igof=iparg(8,ng)
99 off= abs(igof-1)
100 mx = fxbelm(nft+13)
101 nel = iparg(2,ng)
102!
103 DO j=1,6
104 jj(j) = nel*(j-1)
105 ENDDO
106!
107 gbuf%SIG(jj(1)+iel)=zero
108 gbuf%SIG(jj(2)+iel)=zero
109 gbuf%SIG(jj(3)+iel)=zero
110 gbuf%SIG(jj(4)+iel)=zero
111 gbuf%SIG(jj(5)+iel)=zero
112 gbuf%SIG(jj(6)+iel)=zero
113 eielp(mx) = eielp(mx) + gbuf%EINT(iel)*off
114 gbuf%EINT(iel)=zero
115 nft=nft+13
116 ENDDO
117 ENDDO
118 DO ig=1,nelc,nvsiz
119 offset=ig-1
120 last=min(nvsiz,nelc-offset)
121 DO i=1,last
122 ng=fxbelm(nft+1)
123 iel=fxbelm(nft+2)
124 gbuf => elbuf_tab(ng)%GBUF
125 igof=iparg(8,ng)
126 off=abs(igof-1)
127 mx=fxbelm(nft+10)
128 nel = iparg(2,ng)
129!
130 DO j=1,6
131 jj(j) = nel*(j-1)
132 ENDDO
133!
134 gbuf%FOR(jj(1)+iel)=zero
135 gbuf%FOR(jj(2)+iel)=zero
136 gbuf%FOR(jj(3)+iel)=zero
137 gbuf%FOR(jj(4)+iel)=zero
138 gbuf%FOR(jj(5)+iel)=zero
139!
140 gbuf%MOM(jj(1)+iel)=zero
141 gbuf%MOM(jj(2)+iel)=zero
142 gbuf%MOM(jj(3)+iel)=zero
143!
144 eielp(mx) = eielp(mx)+
145 . (gbuf%EINT(iel)+gbuf%EINT(iel+nel))*off
146 gbuf%EINT(iel)=zero
147 gbuf%EINT(iel+nel)=zero
148 nft=nft+10
149 ENDDO
150 ENDDO
151 DO ig=1,nelt,nvsiz
152 offset=ig-1
153 last=min(nvsiz,nelt-offset)
154 DO i=1,last
155 ng=fxbelm(nft+1)
156 iel=fxbelm(nft+2)
157 gbuf => elbuf_tab(ng)%GBUF
158 igof=iparg(8,ng)
159 off=abs(igof-1)
160 mx=fxbelm(nft+7)
161 gbuf%FOR(iel)=zero
162 eielp(mx)=eielp(mx)+gbuf%EINT(iel)*off
163 gbuf%EINT(iel)=zero
164 nft=nft+7
165 ENDDO
166 ENDDO
167 DO ig=1,nelp,nvsiz
168 offset=ig-1
169 last=min(nvsiz,nelp-offset)
170 DO i=1,last
171 ng=fxbelm(nft+1)
172 iel=fxbelm(nft+2)
173 gbuf => elbuf_tab(ng)%GBUF
174 igof=iparg(8,ng)
175 off=abs(igof-1)
176 mx=fxbelm(nft+9)
177 nel = iparg(2,ng)
178!
179 DO j=1,3
180 jj(j) = nel*(j-1)
181 ENDDO
182!
183 gbuf%FOR(jj(1)+iel)=zero
184 gbuf%FOR(jj(2)+iel)=zero
185 gbuf%FOR(jj(3)+iel)=zero
186!
187 gbuf%MOM(jj(1)+iel)=zero
188 gbuf%MOM(jj(2)+iel)=zero
189 gbuf%MOM(jj(3)+iel)=zero
190!
191 eielp(mx)=eielp(mx)+(gbuf%EINT(iel)+gbuf%EINT(iel+nel))*off
192 gbuf%EINT(iel)=zero
193 gbuf%EINT(iel+nel)=zero
194 nft=nft+9
195 ENDDO
196 ENDDO
197 DO ig=1,neltg,nvsiz
198 offset=ig-1
199 last=min(nvsiz,neltg-offset)
200 DO i=1,last
201 ng=fxbelm(nft+1)
202 iel=fxbelm(nft+2)
203 gbuf => elbuf_tab(ng)%GBUF
204 igof=iparg(8,ng)
205 off=abs(igof-1)
206 mx=fxbelm(nft+9)
207 nel = iparg(2,ng)
208!
209 DO j=1,5
210 jj(j) = nel*(j-1)
211 ENDDO
212!
213 gbuf%FOR(jj(1)+iel)=zero
214 gbuf%FOR(jj(2)+iel)=zero
215 gbuf%FOR(jj(3)+iel)=zero
216 gbuf%FOR(jj(4)+iel)=zero
217 gbuf%FOR(jj(5)+iel)=zero
218!
219 gbuf%MOM(jj(1)+iel)=zero
220 gbuf%MOM(jj(2)+iel)=zero
221 gbuf%MOM(jj(3)+iel)=zero
222!
223 eielp(mx) = eielp(mx)+(gbuf%EINT(iel)+gbuf%EINT(iel+nel))*off
224 gbuf%EINT(iel)=zero
225 gbuf%EINT(iel+nel)=zero
226 nft=nft+9
227 ENDDO
228 ENDDO
229 IF (itn/=0) GOTO 100
230C
231 ifile=fxbipm(29)
232 nfs=0
233 DO im=1,nml
234 IF (ifile==0) THEN
235 DO i=1,lvsig
236 vsig(i)=fxbsig(nfs+i)
237 ENDDO
238 ELSEIF (ifile==1) THEN
239 iad=0
240 DO i=1,lvsig/6
241 ircs=ircs+1
242 READ(ifxs,rec=ircs) (vsig(iad+j),j=1,6)
243 iad=iad+6
244 ENDDO
245 ii=lvsig-(lvsig/6)*6
246 IF (ii/=0) THEN
247 ircs=ircs+1
248 READ(ifxs,rec=ircs) (vsig(iad+j),j=1,ii)
249 ENDIF
250 ENDIF
251 fac=fxbdep(nme+im)
252 fac2=fac*fac
253 nft=aelm-1
254 nfs2=0
255 DO ig=1,nels,nvsiz
256 offset=ig-1
257 last=min(nvsiz,nels-offset)
258 DO i=1,last
259 ng=fxbelm(nft+1)
260 iel=fxbelm(nft+2)
261 gbuf => elbuf_tab(ng)%GBUF
262 mx=fxbelm(nft+13)
263 nel = iparg(2,ng)
264!
265 DO j=1,6
266 jj(j) = nel*(j-1)
267 ENDDO
268!
269 gbuf%SIG(jj(1)+iel)=gbuf%SIG(jj(1)+iel)+fac*vsig(nfs2+1)
270 gbuf%SIG(jj(2)+iel)=gbuf%SIG(jj(2)+iel)+fac*vsig(nfs2+2)
271 gbuf%SIG(jj(3)+iel)=gbuf%SIG(jj(3)+iel)+fac*vsig(nfs2+3)
272 gbuf%SIG(jj(4)+iel)=gbuf%SIG(jj(4)+iel)+fac*vsig(nfs2+4)
273 gbuf%SIG(jj(5)+iel)=gbuf%SIG(jj(5)+iel)+fac*vsig(nfs2+5)
274 gbuf%SIG(jj(6)+iel)=gbuf%SIG(jj(6)+iel)+fac*vsig(nfs2+6)
275 gbuf%EINT(iel) =gbuf%EINT(iel)+fac2*vsig(nfs2+7)
276 eielc(mx) = eielc(mx) + fac2*vsig(nfs2+7)
277 nft=nft+13
278 nfs=nfs+7
279 nfs2=nfs2+7
280 ENDDO
281 ENDDO
282 DO ig=1,nelc,nvsiz
283 offset=ig-1
284 last=min(nvsiz,nelc-offset)
285 DO i=1,last
286 ng=fxbelm(nft+1)
287 iel=fxbelm(nft+2)
288 mx=fxbelm(nft+10)
289 gbuf => elbuf_tab(ng)%GBUF
290 nel = iparg(2,ng)
291!
292 DO j=1,5
293 jj(j) = nel*(j-1)
294 ENDDO
295!
296 gbuf%FOR(jj(1)+iel)=gbuf%FOR(jj(1)+iel)+fac*vsig(nfs2+1)
297 gbuf%FOR(jj(2)+iel)=gbuf%FOR(jj(2)+iel)+fac*vsig(nfs2+2)
298 gbuf%FOR(jj(3)+iel)=gbuf%FOR(jj(3)+iel)+fac*vsig(nfs2+3)
299 gbuf%FOR(jj(4)+iel)=gbuf%FOR(jj(4)+iel)+fac*vsig(nfs2+4)
300 gbuf%FOR(jj(5)+iel)=gbuf%FOR(jj(5)+iel)+fac*vsig(nfs2+5)
301!
302 gbuf%MOM(jj(1)+iel)=gbuf%MOM(jj(1)+iel)+fac*vsig(nfs2+6)
303 gbuf%MOM(jj(2)+iel)=gbuf%MOM(jj(2)+iel)+fac*vsig(nfs2+7)
304 gbuf%MOM(jj(3)+iel)=gbuf%MOM(jj(3)+iel)+fac*vsig(nfs2+8)
305!
306 gbuf%EINT(iel)=gbuf%EINT(iel)+fac2*vsig(nfs2+9)
307 gbuf%EINT(iel+nel)=gbuf%EINT(iel+nel)+fac2*vsig(nfs2+10)
308 eielc(mx)=eielc(mx)+fac2*(vsig(nfs2+9)+vsig(nfs2+10))
309 nft=nft+10
310 nfs=nfs+10
311 nfs2=nfs2+10
312 ENDDO
313 ENDDO
314 DO ig=1,nelt,nvsiz
315 offset=ig-1
316 last=min(nvsiz,nelt-offset)
317 DO i=1,last
318 ng=fxbelm(nft+1)
319 iel=fxbelm(nft+2)
320 mx=fxbelm(nft+7)
321 gbuf => elbuf_tab(ng)%GBUF
322 gbuf%FOR(iel)=gbuf%FOR(iel)+fac*vsig(nfs2+1)
323 gbuf%EINT(iel)=gbuf%EINT(iel)+fac2*vsig(nfs2+2)
324 eielc(mx)=eielc(mx)+fac2*vsig(nfs2+2)
325 nft=nft+7
326 nfs=nfs+2
327 nfs2=nfs2+2
328 ENDDO
329 ENDDO
330 DO ig=1,nelp,nvsiz
331 offset=ig-1
332 last=min(nvsiz,nelp-offset)
333 DO i=1,last
334 ng=fxbelm(nft+1)
335 mx=fxbelm(nft+9)
336 iel=fxbelm(nft+2)
337 gbuf => elbuf_tab(ng)%GBUF
338 nel = iparg(2,ng)
339!
340 DO j=1,3
341 jj(j) = nel*(j-1)
342 ENDDO
343!
344 gbuf%FOR(jj(1)+iel)=gbuf%FOR(jj(1)+iel)+fac*vsig(nfs2+1)
345 gbuf%FOR(jj(2)+iel)=gbuf%FOR(jj(2)+iel)+fac*vsig(nfs2+2)
346 gbuf%FOR(jj(3)+iel)=gbuf%FOR(jj(3)+iel)+fac*vsig(nfs2+3)
347!
348 gbuf%MOM(jj(1)+iel)=gbuf%MOM(jj(1)+iel)+fac*vsig(nfs2+4)
349 gbuf%MOM(jj(2)+iel)=gbuf%MOM(jj(2)+iel)+fac*vsig(nfs2+5)
350 gbuf%MOM(jj(3)+iel)=gbuf%MOM(jj(3)+iel)+fac*vsig(nfs2+6)
351!
352 gbuf%EINT(iel)=gbuf%EINT(iel)+fac2*vsig(nfs2+7)
353 gbuf%EINT(iel+nel)=gbuf%EINT(iel+nel)+fac2*vsig(nfs2+8)
354 eielc(mx)=eielc(mx)+fac2*(vsig(nfs2+7)+vsig(nfs2+8))
355 nft=nft+9
356 nfs=nfs+8
357 nfs2=nfs2+8
358 ENDDO
359 ENDDO
360 DO ig=1,neltg,nvsiz
361 offset=ig-1
362 last=min(nvsiz,neltg-offset)
363 DO i=1,last
364 mx=fxbelm(nft+9)
365 ng=fxbelm(nft+1)
366 iel=fxbelm(nft+2)
367 gbuf => elbuf_tab(ng)%GBUF
368 nel = iparg(2,ng)
369!
370 DO j=1,5
371 jj(j) = nel*(j-1)
372 ENDDO
373!
374 gbuf%FOR(jj(1)+iel)=gbuf%FOR(jj(1)+iel)+fac*vsig(nfs2+1)
375 gbuf%FOR(jj(2)+iel)=gbuf%FOR(jj(2)+iel)+fac*vsig(nfs2+2)
376 gbuf%FOR(jj(3)+iel)=gbuf%FOR(jj(3)+iel)+fac*vsig(nfs2+3)
377 gbuf%FOR(jj(4)+iel)=gbuf%FOR(jj(4)+iel)+fac*vsig(nfs2+4)
378 gbuf%FOR(jj(5)+iel)=gbuf%FOR(jj(5)+iel)+fac*vsig(nfs2+5)
379!
380 gbuf%MOM(jj(1)+iel)=gbuf%MOM(jj(1)+iel)+fac*vsig(nfs2+6)
381 gbuf%MOM(jj(2)+iel)=gbuf%MOM(jj(2)+iel)+fac*vsig(nfs2+7)
382 gbuf%MOM(jj(3)+iel)=gbuf%MOM(jj(3)+iel)+fac*vsig(nfs2+8)
383!
384 gbuf%EINT(iel)=gbuf%EINT(iel)+fac2*vsig(nfs2+9)
385 gbuf%EINT(iel+nel)=gbuf%EINT(iel+nel)+fac2*vsig(nfs2+10)
386 eielc(mx)=eielc(mx)+fac2*(vsig(nfs2+9)+vsig(nfs2+10))
387 nft=nft+9
388 nfs=nfs+10
389 nfs2=nfs2+10
390 ENDDO
391 ENDDO
392 ENDDO
393C
394 nft=aelm-1
395 DO ig=1,nels,nvsiz
396 offset=ig-1
397 last=min(nvsiz,nels-offset)
398 nft1=nft
399 DO i=1,last
400 ng=fxbelm(nft+1)
401 iel=fxbelm(nft+2)
402 gbuf => elbuf_tab(ng)%GBUF
403 nel = iparg(2,ng)
404!
405 DO j=1,6
406 jj(j) = nel*(j-1)
407 ENDDO
408!
409 sigl(i,1)=elbuf_tab(ng)%GBUF%SIG(jj(1)+iel)
410 sigl(i,2)=elbuf_tab(ng)%GBUF%SIG(jj(2)+iel)
411 sigl(i,3)=elbuf_tab(ng)%GBUF%SIG(jj(3)+iel)
412 sigl(i,4)=elbuf_tab(ng)%GBUF%SIG(jj(4)+iel)
413 sigl(i,5)=elbuf_tab(ng)%GBUF%SIG(jj(5)+iel)
414 sigl(i,6)=elbuf_tab(ng)%GBUF%SIG(jj(6)+iel)
415 nft=nft+13
416 ENDDO
417 CALL schrep(last,sigl,sig,rt)
418 nft=nft1
419 DO i=1,last
420 ng=fxbelm(nft+1)
421 iel=fxbelm(nft+2)
422 nel = iparg(2,ng)
423!
424 DO j=1,6
425 jj(j) = nel*(j-1)
426 ENDDO
427!
428 elbuf_tab(ng)%GBUF%SIG(jj(1)+iel)=sig(i,1)
429 elbuf_tab(ng)%GBUF%SIG(jj(2)+iel)=sig(i,2)
430 elbuf_tab(ng)%GBUF%SIG(jj(3)+iel)=sig(i,3)
431 elbuf_tab(ng)%GBUF%SIG(jj(4)+iel)=sig(i,4)
432 elbuf_tab(ng)%GBUF%SIG(jj(5)+iel)=sig(i,5)
433 elbuf_tab(ng)%GBUF%SIG(jj(6)+iel)=sig(i,6)
434 nft=nft+13
435 ENDDO
436 ENDDO
437C
438 100 CONTINUE
439 DO i=1,npart
440 partsav(1,i)=partsav(1,i)-eielp(i)+eielc(i)
441 eiel=eiel+eielc(i)
442 ENDDO
443C
444 RETURN
my_real
#define my_real
Definition cppsort.cpp:32
schrep
subroutine schrep(nel, sig, sigl, r)
Definition fxbsgmaj.F:452
min
#define min(a, b)
Definition macros.h:20

◆ schrep()

subroutine schrep ( integer nel,
sig,
sigl,
r )

Definition at line 451 of file fxbsgmaj.F.

452C-----------------------------------------------
453C I m p l i c i t T y p e s
454C-----------------------------------------------
455#include "implicit_f.inc"
456C-----------------------------------------------
457C G l o b a l P a r a m e t e r s
458C-----------------------------------------------
459#include "mvsiz_p.inc"
460C-----------------------------------------------
461C D u m m y A r g u m e n t s
462C-----------------------------------------------
463 INTEGER :: NEL
464 my_real
465 . sig(mvsiz,6), sigl(mvsiz,6), r(3,*)
466C-----------------------------------------------
467C L o c a l V a r i a b l e s
468C-----------------------------------------------
469 INTEGER I
470C
471 DO i=1,nel
472 sigl(i,1)=
473 . r(1,1)*(r(1,1)*sig(i,1)+r(2,1)*sig(i,4)+r(3,1)*sig(i,6))
474 . +r(2,1)*(r(1,1)*sig(i,4)+r(2,1)*sig(i,2)+r(3,1)*sig(i,5))
475 . +r(3,1)*(r(1,1)*sig(i,6)+r(2,1)*sig(i,5)+r(3,1)*sig(i,3))
476 sigl(i,2)=
477 . r(1,2)*(r(1,2)*sig(i,1)+r(2,2)*sig(i,4)+r(3,2)*sig(i,6))
478 . +r(2,2)*(r(1,2)*sig(i,4)+r(2,2)*sig(i,2)+r(3,2)*sig(i,5))
479 . +r(3,2)*(r(1,2)*sig(i,6)+r(2,2)*sig(i,5)+r(3,2)*sig(i,3))
480 sigl(i,3)=
481 . r(1,3)*(r(1,3)*sig(i,1)+r(2,3)*sig(i,4)+r(3,3)*sig(i,6))
482 . +r(2,3)*(r(1,3)*sig(i,4)+r(2,3)*sig(i,2)+r(3,3)*sig(i,5))
483 . +r(3,3)*(r(1,3)*sig(i,6)+r(2,3)*sig(i,5)+r(3,3)*sig(i,3))
484 sigl(i,4)=
485 . r(1,1)*(r(1,2)*sig(i,1)+r(2,2)*sig(i,4)+r(3,2)*sig(i,6))
486 . +r(2,1)*(r(1,2)*sig(i,4)+r(2,2)*sig(i,2)+r(3,2)*sig(i,5))
487 . +r(3,1)*(r(1,2)*sig(i,6)+r(2,2)*sig(i,5)+r(3,2)*sig(i,3))
488 sigl(i,5)=
489 . r(1,2)*(r(1,3)*sig(i,1)+r(2,3)*sig(i,4)+r(3,3)*sig(i,6))
490 . +r(2,2)*(r(1,3)*sig(i,4)+r(2,3)*sig(i,2)+r(3,3)*sig(i,5))
491 . +r(3,2)*(r(1,3)*sig(i,6)+r(2,3)*sig(i,5)+r(3,3)*sig(i,3))
492 sigl(i,6)=
493 . r(1,1)*(r(1,3)*sig(i,1)+r(2,3)*sig(i,4)+r(3,3)*sig(i,6))
494 . +r(2,1)*(r(1,3)*sig(i,4)+r(2,3)*sig(i,2)+r(3,3)*sig(i,5))
495 . +r(3,1)*(r(1,3)*sig(i,6)+r(2,3)*sig(i,5)+r(3,3)*sig(i,3))
496 ENDDO
497C
498 RETURN