OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
stat_size.F File Reference
#include "implicit_f.inc"
#include "com01_c.inc"
#include "scr16_c.inc"
#include "param_c.inc"
#include "task_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine stat_size_c (iparg, ixc, ixtg, igeo, ipm, p0ars, wasz, ixs, geo, elbuf_tab, ixr, ixp, ixt, output, lipart1, npart, ipart, numsph, ipartsp)

Function/Subroutine Documentation

◆ stat_size_c()

subroutine stat_size_c ( integer, dimension(nparg,*) iparg,
integer, dimension(nixc,*) ixc,
integer, dimension(nixtg,*) ixtg,
integer, dimension(npropgi,*) igeo,
integer, dimension(npropmi,*) ipm,
integer p0ars,
integer wasz,
integer, dimension(nixs,*) ixs,
geo,
type (elbuf_struct_), dimension(ngroup), target elbuf_tab,
integer, dimension(nixr,*) ixr,
integer, dimension(nixp,*) ixp,
integer, dimension(nixt,*) ixt,
type(output_), intent(inout) output,
integer, intent(in) lipart1,
integer, intent(in) npart,
integer, dimension(lipart1,npart), intent(in) ipart,
integer, intent(in) numsph,
integer, dimension(numsph), intent(in) ipartsp )

Definition at line 34 of file stat_size.F.

38C-----------------------------------------------
39C M o d u l e s
40C-----------------------------------------------
41 USE elbufdef_mod
42 USE output_mod
43 use element_mod , only : nixs,nixq,nixc,nixt,nixr,nixp,nixtg
44C-----------------------------------------------
45C I m p l i c i t T y p e s
46C-----------------------------------------------
47#include "implicit_f.inc"
48C-----------------------------------------------
49C C o m m o n B l o c k s
50C-----------------------------------------------
51#include "com01_c.inc"
52#include "scr16_c.inc"
53#include "param_c.inc"
54#include "task_c.inc"
55C-----------------------------------------------
56C D u m m y A r g u m e n t s
57C-----------------------------------------------
58 INTEGER IXC(NIXC,*),IXTG(NIXTG,*),
59 . IPARG(NPARG,*),IPM(NPROPMI,*),IGEO(NPROPGI,*),
60 . WASZ,P0ARS,IXS(NIXS,*),IXR(NIXR,*),IXP(NIXP,*),
61 . IXT(NIXT,*)
62 my_real
63 . geo(npropg,*)
64 TYPE (ELBUF_STRUCT_), DIMENSION(NGROUP), TARGET :: ELBUF_TAB
65 TYPE(OUTPUT_),INTENT(INOUT) :: OUTPUT
66 INTEGER, INTENT(IN) :: LIPART1
67 INTEGER, INTENT(IN) :: NPART
68 INTEGER, INTENT(IN) :: NUMSPH
69 INTEGER, INTENT(IN) :: IPARTSP(NUMSPH)
70 INTEGER, INTENT(IN) :: IPART(LIPART1,NPART)
71C-----------------------------------------------
72C L o c a l V a r i a b l e s
73C-----------------------------------------------
74 INTEGER ITY,NFT,LFT,LLT,NPT,NPTM,ISTRAIN,IHBE,
75 . NUVAR,MLW,NG,NEL,I,NPG,MPT,ISROT,
76 . RWASZ,WASZ2,P0ARSZ2,RWASZ2,ISOLNOD,
77 . NLAY,NPTR,NPTS,NPTT,IGTYP,
78 . NUVARR,NVARF,IL,NPT_ALL,IPROP,
79 . EL_FIX,EL_VAR,ISMSTR,NFAIL,IPRT,MT
80 TYPE(BUF_FAIL_) ,POINTER :: FBUF
81C======================================================================|
82 p0ars = 0
83 wasz = 0
84C
85 IF (stat_c(1) == 1.OR.stat_c(2) == 1.OR.stat_r(1) == 1.OR.
86 . stat_p(1) == 1.OR.stat_p(3) == 1.OR.stat_t(1) == 1.OR.
87 . output%STATE%STAT_SPH(3) == 1 ) THEN
88C 1: off, 2: thk
89 wasz = 3*max(stat_numelc,stat_numeltg,stat_numelr,stat_numelp,stat_numelt)
90 wasz = max(wasz,4*output%STATE%STAT_NUMELSPH)
91
92 rwasz = 3*max(stat_numelc_g,stat_numeltg_g,stat_numelr_g,stat_numelp_g,stat_numelt_g)
93 rwasz= max(rwasz,4*output%STATE%STAT_NUMELSPH_G)
94 IF (ispmd == 0) p0ars = rwasz
95 ENDIF
96C
97 p0arsz2 = 0
98 wasz2 = 0
99C
100 IF (stat_c(3) == 1) THEN
101C------------------------------
102C 3: epsp/full
103C------------------------------
104 DO ng=1,ngroup
105 ity = iparg(5,ng)
106 nel = iparg(2,ng)
107 igtyp = iparg(38,ng)
108 IF (ity == 3 .OR. ity == 7) THEN
109 npt = iparg(6,ng)
110 ihbe = iparg(23,ng)
111 nptm = max(1,iabs(npt))
112 nlay = elbuf_tab(ng)%NLAY
113 nptr = elbuf_tab(ng)%NPTR
114 npts = elbuf_tab(ng)%NPTS
115c NPTT = ELBUF_TAB(NG)%NPTT
116 npg = nptr*npts
117 IF (ity==3 .AND. ihbe==23) npg=4
118C
119C pre counting of all NPTT (especially for PID_51)
120C
121 IF (igtyp == 51 .OR. igtyp == 52) THEN
122 npt_all = 0
123 DO il=1,nlay
124 npt_all = npt_all + elbuf_tab(ng)%BUFLY(il)%NPTT
125 ENDDO
126 nptm = max(1,npt_all)
127 ENDIF
128 wasz2 = wasz2+(6+nptm*npg)*nel
129 ENDIF
130 ENDDO
131C
132 rwasz2= wasz2
133 IF (nspmd > 1) CALL spmd_glob_isum9(rwasz2,1)
134 IF (ispmd == 0) p0arsz2 = rwasz2
135 ENDIF ! IF (STAT_C(3) == 1)
136C
137 p0ars= max(p0ars,p0arsz2)+6
138 wasz = max(wasz,wasz2)
139C
140 p0arsz2 = 0
141 wasz2 = 0
142C
143 IF (stat_c(4) == 1) THEN
144C------------------------------
145C 4: stress/full
146C------------------------------
147 DO ng=1,ngroup
148 ity = iparg(5,ng)
149 nel = iparg(2,ng)
150 igtyp = iparg(38,ng)
151 IF (ity == 3 .OR. ity == 7) THEN
152 npt =iparg(6,ng)
153 mpt =iabs(npt)
154 mlw =iparg(1,ng)
155 ihbe = iparg(23,ng)
156 nlay = elbuf_tab(ng)%NLAY
157 nptr = elbuf_tab(ng)%NPTR
158 npts = elbuf_tab(ng)%NPTS
159c NPTT = ELBUF_TAB(NG)%NPTT
160 npg = nptr*npts
161 IF (ity==3.AND.ihbe==23) npg=4
162C
163C pre counting of all NPTT (especially for PID_51)
164C
165 IF (igtyp == 51 .OR. igtyp == 52) THEN
166 npt_all = 0
167 DO il=1,nlay
168 npt_all = npt_all + elbuf_tab(ng)%BUFLY(il)%NPTT
169 ENDDO
170 mpt = max(1,npt_all)
171 ENDIF
172 IF (mlw == 1 .OR. mlw == 3 .OR. mlw == 23) mpt=0
173C
174 wasz2 = wasz2 + 5*nel
175 IF (mpt == 0) THEN
176 wasz2 = wasz2 + (9*npg+7)*nel
177 ELSE
178 wasz2 = wasz2 + (6*npg*mpt+7)*nel
179 ENDIF
180 ENDIF
181 ENDDO
182C
183 rwasz2= wasz2
184 IF (nspmd > 1) CALL spmd_glob_isum9(rwasz2,1)
185 IF (ispmd == 0) p0arsz2 = rwasz2
186 ENDIF ! IF (STAT_C(4) == 1)
187C
188 p0ars= max(p0ars,p0arsz2)+6
189 wasz = max(wasz,wasz2)
190C
191 p0arsz2 = 0
192 wasz2 = 0
193C
194 IF (stat_c(10) == 1) THEN
195C------------------------------
196C 10: stress/globfull
197C------------------------------
198 DO ng=1,ngroup
199 ity = iparg(5,ng)
200 nel = iparg(2,ng)
201 igtyp = iparg(38,ng)
202 IF (ity == 3 .OR. ity == 7) THEN
203 npt =iparg(6,ng)
204 mpt =iabs(npt)
205 mlw =iparg(1,ng)
206 ihbe = iparg(23,ng)
207 nlay = elbuf_tab(ng)%NLAY
208 nptr = elbuf_tab(ng)%NPTR
209 npts = elbuf_tab(ng)%NPTS
210c NPTT = ELBUF_TAB(NG)%NPTT
211 npg = nptr*npts
212 IF (ihbe==23) npg=4
213C
214C pre counting of all NPTT (especially for PID_51)
215C
216 npt_all = 0
217 DO il=1,nlay
218 npt_all = npt_all + elbuf_tab(ng)%BUFLY(il)%NPTT
219 ENDDO
220 mpt = max(1,npt_all)
221 IF (mlw == 1 .OR. mlw == 3 .OR. mlw == 23) mpt=0
222C
223 wasz2 = wasz2 + 5*nel
224 IF (mpt == 0) THEN
225 wasz2 = wasz2 + (13*npg+7)*nel
226 ELSE
227 wasz2 = wasz2 + (8*npg*mpt+7)*nel
228 ENDIF
229 ENDIF
230 ENDDO
231C
232 rwasz2= wasz2
233 IF (nspmd > 1) CALL spmd_glob_isum9(rwasz2,1)
234 IF (ispmd == 0) p0arsz2 = rwasz2
235 ENDIF ! IF (STAT_C(4) == 1)
236C
237 p0ars= max(p0ars,p0arsz2)+6
238 wasz = max(wasz,wasz2)
239C
240 p0arsz2 = 0
241 wasz2 = 0
242C
243 IF (stat_c(11) == 1) THEN
244C------------------------------
245C 1: strain/globfull shells
246C------------------------------
247 DO ng=1,ngroup
248 ity = iparg(5,ng)
249 nel = iparg(2,ng)
250 IF (ity == 3.OR.ity == 7) THEN
251 npt =iparg(6,ng)
252 mpt =iabs(npt)
253 mlw =iparg(1,ng)
254 nlay = elbuf_tab(ng)%NLAY
255 npt_all = 0
256 DO il=1,nlay
257 npt_all = npt_all + elbuf_tab(ng)%BUFLY(il)%NPTT
258 ENDDO
259 mpt = max(1,npt_all)
260 IF (npt==0) mpt=2
261C
262 ihbe =iparg(23,ng)
263 npg =iparg(48,ng)
264 IF (ihbe==23) npg=4
265C
266 wasz2 = wasz2 + (7*npg*mpt+6)*nel
267 ENDIF
268 ENDDO
269C
270 rwasz2= wasz2
271 IF (nspmd > 1) CALL spmd_glob_isum9(rwasz2,1)
272 IF (ispmd == 0) p0arsz2 = rwasz2
273 ENDIF
274C
275 p0ars= max(p0ars,p0arsz2)+6
276 wasz = max(wasz,wasz2)
277C
278 p0arsz2 = 0
279 wasz2 = 0
280C
281 IF (stat_c(5) == 1) THEN
282C------------------------------
283C 5: strain/full shells
284C------------------------------
285 DO ng=1,ngroup
286 ity = iparg(5,ng)
287 nel = iparg(2,ng)
288 IF (ity == 3.OR.ity == 7) THEN
289 npt =iparg(6,ng)
290 mpt =iabs(npt)
291 mlw =iparg(1,ng)
292 IF (mlw == 1.OR.mlw == 3.OR.mlw == 23) mpt=0
293C
294 ihbe =iparg(23,ng)
295 npg =iparg(48,ng)
296CC IF(ITY==3.AND.IHBE==23) NPG=4
297C
298 wasz2 = wasz2 + 5*nel
299 wasz2 = wasz2 + (8*npg+1)*nel
300 ENDIF
301 ENDDO
302C
303 rwasz2= wasz2
304 IF (nspmd > 1) CALL spmd_glob_isum9(rwasz2,1)
305 IF (ispmd == 0) p0arsz2 = rwasz2
306 ENDIF
307C
308 p0ars= max(p0ars,p0arsz2)+6
309 wasz = max(wasz,wasz2)
310C
311 p0arsz2 = 0
312 wasz2 = 0
313 IF (stat_c(6) == 1) THEN
314C------------------------------
315C 6: /inishe/aux/full
316C------------------------------
317 DO ng=1,ngroup
318 ity = iparg(5,ng)
319 nel = iparg(2,ng)
320 nft = iparg(3,ng)
321C
322 IF (ity == 3.OR.ity == 7) THEN
323 lft=1
324 llt=nel
325 mlw = iparg(1,ng)
326 npt = iparg(6,ng)
327 ihbe = iparg(23,ng)
328 igtyp = iparg(38,ng)
329 istrain= iparg(44,ng)
330 nlay = elbuf_tab(ng)%NLAY
331 nptr = elbuf_tab(ng)%NPTR
332 npts = elbuf_tab(ng)%NPTS
333 npg = nptr*npts
334 IF (mlw == 25.OR.mlw == 27.OR.mlw == 32) istrain=1
335C
336 nuvar = 0
337 IF (ity == 3) THEN
338 DO i=lft,llt
339 nuvar = max(nuvar,ipm(8,ixc(1,i+nft)))
340 ENDDO
341 ELSE
342 DO i=lft,llt
343 nuvar = max(nuvar,ipm(8,ixtg(1,i+nft)))
344 ENDDO
345 ENDIF
346 IF (mlw == 78) THEN
347 nuvar = nuvar + 18 ! backstress will be printed in /AUX
348 ELSEIF (mlw == 87) THEN
349 nuvar = elbuf_tab(ng)%BUFLY(1)%NVAR_MAT + 12 ! backstress will be printed in /AUX
350 ELSEIF (mlw == 112) THEN
351 nuvar = 3
352 ELSE IF (mlw == 36) THEN
353 nuvar = 6 ! backstress will be printed in /AUX
354 END IF
355C
356 mpt = iabs(npt)
357C
358C pre counting of all NPTT (especially for PID_51)
359C
360 IF (igtyp == 51 .OR. igtyp == 52) THEN
361 npt_all = 0
362 DO il=1,nlay
363 npt_all = npt_all + elbuf_tab(ng)%BUFLY(il)%NPTT
364 ENDDO
365 mpt = max(1,npt_all)
366 ENDIF
367C
368 nptm = max(1,mpt)
369 wasz2 = wasz2 + nel*(6+npg*nptm*nuvar)
370 ENDIF
371 ENDDO
372C
373 rwasz2= wasz2
374 IF (nspmd > 1) CALL spmd_glob_isum9(rwasz2,1)
375 IF (ispmd == 0) p0arsz2 = rwasz2
376 ENDIF
377C
378 p0ars= max(p0ars,p0arsz2)+6
379 wasz = max(wasz,wasz2)
380C
381 p0arsz2 = 0
382 wasz2 = 0
383C
384 IF (stat_c(7) == 1) THEN
385C------------------------------
386C 7: orth_loc shells
387C------------------------------
388 DO ng=1,ngroup
389 ity = iparg(5,ng)
390 nel = iparg(2,ng)
391 nft = iparg(3,ng)
392C
393 IF (ity == 3.OR.ity == 7) THEN
394 lft=1
395 llt=nel
396 npt =iparg(6,ng)
397 istrain=iparg(44,ng)
398 ihbe =iparg(23,ng)
399cc WASZ2 = WASZ2 + NEL*(8+NPT*4)
400 wasz2 = wasz2 + nel*(9+npt*5)
401 END IF
402 ENDDO
403C
404 rwasz2= wasz2
405 IF (nspmd > 1) CALL spmd_glob_isum9(rwasz2,1)
406 IF (ispmd == 0) p0arsz2 = rwasz2
407 ENDIF
408C
409 p0ars= max(p0ars,p0arsz2)+6
410 wasz = max(wasz,wasz2)
411C
412 p0arsz2 = 0
413 wasz2 = 0
414C
415 IF (stat_c(8) == 1) THEN
416C------------------------------
417C 8: fail
418C------------------------------
419 DO ng=1,ngroup
420 ity =iparg(5,ng)
421 nel =iparg(2,ng)
422 nft =iparg(3,ng)
423
424 IF (ity == 3.OR.ity == 7) THEN
425 lft=1
426 llt=nel
427 mlw = iparg(1,ng)
428 npt = iparg(6,ng)
429 igtyp = iparg(38,ng)
430 istrain= iparg(44,ng)
431 ihbe = iparg(23,ng)
432 nptr = elbuf_tab(ng)%NPTR
433 npts = elbuf_tab(ng)%NPTS
434 npg = nptr*npts
435 IF (mlw == 25.OR.mlw == 27.OR.mlw == 32) istrain=1
436C
437 nuvarr = 0
438 IF (ity == 3) THEN
439 DO i=lft,llt
440 nuvarr = max(nuvarr,ipm(221,ixc(1,i+nft)) + 1)
441 ENDDO
442 ELSE
443 DO i=lft,llt
444 nuvarr = max(nuvarr,ipm(221,ixtg(1,i+nft)) + 1)
445 ENDDO
446 ENDIF
447C
448 mpt=iabs(npt)
449C
450C
451C pre counting of all NPTT (especially for PID_51)
452C
453 IF (igtyp == 51 .OR. igtyp == 52) THEN
454 npt_all = 0
455 DO il=1,nlay
456 npt_all = npt_all + elbuf_tab(ng)%BUFLY(il)%NPTT
457 ENDDO
458 mpt = max(1,npt_all)
459 ENDIF
460C
461 nptm=max(1,mpt)
462 wasz2 = wasz2 + nel*(7 + npg*(3+npt * max(1,nuvarr)* 15))
463 END IF
464 ENDDO
465C
466 rwasz2= wasz2
467 IF (nspmd > 1) CALL spmd_glob_isum9(rwasz2,1)
468 IF (ispmd == 0) p0arsz2 = rwasz2
469 ENDIF
470C
471 p0ars= max(p0ars,p0arsz2)+6
472 wasz = max(wasz,wasz2)
473C
474 p0arsz2 = 0
475 wasz2 = 0
476C------------------------------
477C 8: /inibri/stres/full
478C------------------------------
479 IF (stat_s(4)==1 .OR. stat_s(8)==1) THEN
480 DO ng=1,ngroup
481 ity =iparg(5,ng)
482 IF(ity==1) THEN
483 nel =iparg(2,ng)
484 nlay = elbuf_tab(ng)%NLAY
485 nptr = elbuf_tab(ng)%NPTR
486 npts = elbuf_tab(ng)%NPTS
487 nptt = elbuf_tab(ng)%NPTT
488 npt = nlay*nptr*npts*nptt
489c
490 wasz2 = wasz2 + nel * (12 + 9 * npt)
491 ENDIF
492 ENDDO
493 rwasz2= wasz2
494 IF(nspmd > 1)CALL spmd_glob_isum9(rwasz2,1)
495 IF (ispmd== 0) p0arsz2 = rwasz2
496 ENDIF
497
498 p0ars= max(p0ars,p0arsz2)+8
499 wasz = max(wasz,wasz2)
500 p0arsz2 = 0
501 wasz2 = 0
502C------------------------------
503C 9: /inibri/strai/full
504C------------------------------
505 IF (stat_s(5)==1 .OR. stat_s(9)==1) THEN
506 DO ng=1,ngroup
507 ity =iparg(5,ng)
508 IF(ity==1) THEN
509 nel =iparg(2,ng)
510 nlay = elbuf_tab(ng)%NLAY
511 nptr = elbuf_tab(ng)%NPTR
512 npts = elbuf_tab(ng)%NPTS
513 nptt = elbuf_tab(ng)%NPTT
514 npt = nlay*nptr*npts*nptt
515c
516 wasz2 = wasz2 + nel * (11 + 6 * npt)
517 ENDIF
518 ENDDO
519 rwasz2= wasz2
520 IF(nspmd > 1)CALL spmd_glob_isum9(rwasz2,1)
521 IF (ispmd==0 ) p0arsz2 = rwasz2
522 ENDIF
523
524 p0ars= max(p0ars,p0arsz2)+6
525 wasz = max(wasz,wasz2)
526 p0arsz2 = 0
527 wasz2 = 0
528 nuvar = 0
529C------------------------------
530C 10:/INIBRI/AUX/FULL
531C------------------------------
532 IF (stat_s(6)==1) THEN
533 DO ng=1,ngroup
534 mlw =iparg(1,ng)
535 ity =iparg(5,ng)
536 IF(ity==1) THEN
537 nel =iparg(2,ng)
538 nft =iparg(3,ng)
539 nlay = elbuf_tab(ng)%NLAY
540 nptr = elbuf_tab(ng)%NPTR
541 npts = elbuf_tab(ng)%NPTS
542 nptt = elbuf_tab(ng)%NPTT
543 npt = nlay*nptr*npts*nptt
544c
545 IF (mlw == 112) THEN
546 nuvar = 3
547 ELSE
548 DO i=1,nel
549 nuvar = max(nuvar,ipm(8,ixs(1,i+nft)))
550 ENDDO
551 ENDIF
552 wasz2 = wasz2 + nel * (11 + npt * nuvar)
553 ENDIF
554 ENDDO
555 rwasz2= wasz2
556 IF(nspmd > 1)CALL spmd_glob_isum9(rwasz2,1)
557 IF (ispmd==0 ) p0arsz2 = rwasz2
558 ENDIF
559
560 p0ars= max(p0ars,p0arsz2)+6
561 wasz = max(wasz,wasz2)
562
563 p0arsz2 = 0
564 wasz2 = 0
565C------------------------------
566C 11: /inibri/ortho
567C------------------------------
568 IF (stat_s(7)==1.OR.stat_s(10)==1) THEN
569 DO ng=1,ngroup
570 ity =iparg(5,ng)
571 IF(ity==1) THEN
572 nel =iparg(2,ng)
573 nlay = elbuf_tab(ng)%NLAY
574 nptr = elbuf_tab(ng)%NPTR
575 npts = elbuf_tab(ng)%NPTS
576 nptt = elbuf_tab(ng)%NPTT
577 npt = nlay*nptr*npts*nptt
578c
579 wasz2 = wasz2 + nel * (11 + nlay * 6)
580 ENDIF
581 ENDDO
582 rwasz2= wasz2
583 IF(nspmd > 1)CALL spmd_glob_isum9(rwasz2,1)
584 IF (ispmd ==0) p0arsz2 = rwasz2
585 ENDIF
586
587 p0ars= max(p0ars,p0arsz2)+14
588 wasz = max(wasz,wasz2)
589
590 p0arsz2 = 0
591 wasz2 = 0
592C------------------------------
593C 12: /inibri/fail
594C------------------------------
595 IF (stat_s(11)==1) THEN
596 nvarf = 0
597 nfail = 0
598 DO ng=1,ngroup
599 nfail = max(nfail,elbuf_tab(ng)%BUFLY(1)%NFAIL)
600 ENDDO
601!
602 IF (nfail > 0) THEN
603 DO ng=1,ngroup
604 IF (elbuf_tab(ng)%BUFLY(1)%NFAIL > 0) THEN
605 fbuf => elbuf_tab(ng)%BUFLY(1)%FAIL(1,1,1)
606 nvarf = max(nvarf,fbuf%FLOC(1)%NVAR)
607 END IF
608 ENDDO
609 ENDIF ! IF (NFAIL > 0)
610!
611 DO ng=1,ngroup
612 ity =iparg(5,ng)
613 IF(ity==1) THEN
614 nel =iparg(2,ng)
615 nft =iparg(3,ng)
616 nlay = elbuf_tab(ng)%NLAY
617 nptr = elbuf_tab(ng)%NPTR
618 npts = elbuf_tab(ng)%NPTS
619 nptt = elbuf_tab(ng)%NPTT
620 npt = nlay*nptr*npts*nptt
621c
622 wasz2 = wasz2 + nel * (10 + 5 * (npt * (nvarf+1) + 4) )
623 ENDIF
624 ENDDO
625 rwasz2= wasz2
626 IF(nspmd > 1)CALL spmd_glob_isum9(rwasz2,1)
627 IF (ispmd==0 ) p0arsz2 = rwasz2
628 ENDIF
629
630 p0ars= max(p0ars,p0arsz2)+6
631 wasz = max(wasz,wasz2)
632
633 p0arsz2 = 0
634 wasz2 = 0
635C------------------------------
636C 13: /state/spring/full
637C------------------------------
638 IF (stat_r(1) == 1) THEN
639 DO ng=1,ngroup
640 el_var = 0
641 ity = iparg(5,ng)
642 IF (ity == 6) THEN
643 nel = iparg(2,ng)
644 nft = iparg(3,ng)
645 iprop = ixr(1,nft+1)
646 igtyp = igeo(11,iprop)
647 el_fix = 5
648C
649 IF (igtyp == 4) THEN
650 el_var = 7 + el_fix
651 ELSEIF (igtyp == 12) THEN
652 el_var = 8 + el_fix
653 ELSEIF (igtyp == 8 .OR. igtyp == 13 .OR. igtyp == 25
654 . .OR. igtyp == 23 ) THEN
655 el_var = 40 + el_fix
656 ELSEIF (igtyp == 26) THEN
657 el_var = 6 + el_fix
658 ELSEIF (igtyp == 29 .OR. igtyp == 30 .OR. igtyp == 31 .OR.
659 . igtyp == 32 .OR. igtyp == 33 .OR. igtyp == 35 .OR.
660 . igtyp == 36 .OR. igtyp == 44 .OR. igtyp == 45 .OR.
661 . igtyp == 46) THEN
662 el_var = 13 + el_fix
663!! IF (IGTYP /= 32 .AND. IGTYP /= 33 .AND. IGTYP /= 45) THEN
664!! EL_VAR = EL_VAR + 2 ! MOM1Y, MOM1Z
665!! ENDIF
666 nuvar = nint(geo(25,iprop))
667 el_var = el_var + nuvar
668 ENDIF ! IF(IGTYP)
669C
670 wasz2 = wasz2 + nel * el_var
671 ENDIF ! IF (ITY)
672 ENDDO
673 rwasz2= wasz2
674 IF (nspmd > 1) CALL spmd_glob_isum9(rwasz2,1)
675 IF (ispmd == 0) p0arsz2 = rwasz2
676 ENDIF
677
678 p0ars= max(p0ars,p0arsz2)+6
679 wasz = max(wasz,wasz2)
680
681 p0arsz2 = 0
682 wasz2 = 0
683C------------------------------
684C 14: /state/beam/full
685C------------------------------
686 IF (stat_p(1) == 1) THEN
687 DO ng=1,ngroup
688 el_var = 0
689 ity = iparg(5,ng)
690 npt = iparg(6,ng)
691 IF (ity == 5) THEN
692 nel = iparg(2,ng)
693 nft = iparg(3,ng)
694 iprop = ixp(5,nft+1)
695 igtyp = igeo(11,iprop)
696 el_fix = 13
697!
698 IF (igtyp == 3) THEN
699 el_var = 1 + el_fix
700 ELSEIF (igtyp == 18) THEN
701 el_var = 4*npt + el_fix
702 nuvar = iparg(46,ng)
703 el_var = el_var + nuvar
704 ENDIF ! IF(IGTYP)
705!
706 wasz2 = wasz2 + nel * el_var
707 ENDIF ! IF (ITY)
708 ENDDO
709 rwasz2= wasz2
710 IF (nspmd > 1) CALL spmd_glob_isum9(rwasz2,1)
711 IF (ispmd == 0) p0arsz2 = rwasz2
712 ENDIF ! IF (STAT_P(1) == 1)
713!
714 p0ars= max(p0ars,p0arsz2)+6
715 wasz = max(wasz,wasz2)
716!
717 p0arsz2 = 0
718 wasz2 = 0
719C------------------------------
720C 15: /state/beam/aux
721C------------------------------
722 IF (stat_p(3) == 1) THEN
723 DO ng=1,ngroup
724 ity = iparg(5,ng)
725 nel = iparg(2,ng)
726 nft = iparg(3,ng)
727 IF (ity == 5) THEN
728 lft=1
729 llt=nel
730 mlw = iparg(1,ng)
731 npt = iparg(6,ng)
732 igtyp = iparg(38,ng)
733!
734 nuvar = 0
735 IF (igtyp == 18 .AND. mlw == 36) THEN
736 DO i=lft,llt
737 nuvar = max(nuvar,ipm(8,ixp(1,i+nft)))
738 ENDDO
739 ENDIF
740!
741 wasz2 = wasz2 + nel*(6+npt*nuvar)
742 ENDIF
743 ENDDO
744!
745 rwasz2= wasz2
746 IF (nspmd > 1) CALL spmd_glob_isum9(rwasz2,1)
747 IF (ispmd == 0) p0arsz2 = rwasz2
748 ENDIF ! IF (STAT_P(3) == 1)
749!
750 p0ars= max(p0ars,p0arsz2)+6
751 wasz = max(wasz,wasz2)
752!
753 p0arsz2 = 0
754 wasz2 = 0
755C------------------------------
756C 16: /state/truss/full
757C------------------------------
758 IF (stat_t(1) == 1) THEN
759 DO ng=1,ngroup
760 el_fix = 0
761 ity = iparg(5,ng)
762 IF (ity == 4) THEN
763 nel = iparg(2,ng)
764!
765 el_fix = 8
766!
767 wasz2 = wasz2 + nel * el_fix
768 ENDIF ! IF (ITY)
769 ENDDO
770 rwasz2= wasz2
771 IF (nspmd > 1) CALL spmd_glob_isum9(rwasz2,1)
772 IF (ispmd == 0) p0arsz2 = rwasz2
773 ENDIF ! IF (STAT_T(1) == 1)
774!
775 p0ars= max(p0ars,p0arsz2)+6
776 wasz = max(wasz,wasz2)
777!
778 p0arsz2 = 0
779 wasz2 = 0
780C------------------------------
781C 17: /inibri/eref
782C------------------------------
783 IF (stat_s(13)==1) THEN
784 DO ng=1,ngroup
785 ity =iparg(5,ng)
786 isolnod=iparg(28,ng)
787 ismstr =iparg(9,ng)
788 isrot =iparg(41,ng)
789 IF(ity==1) THEN
790 nel =iparg(2,ng)
791c
792 wasz2 = wasz2 + nel * 7
793 IF (ismstr==1.OR.ismstr>=10) THEN
794 wasz2 = wasz2 + nel * isolnod*3
795 IF (isolnod==4 .AND. isrot>0) wasz2 = wasz2 + nel * isolnod*10
796 END IF
797 ENDIF
798 ENDDO
799 rwasz2= wasz2
800 IF(nspmd > 1)CALL spmd_glob_isum9(rwasz2,1)
801 IF (ispmd==0 ) p0arsz2 = rwasz2
802 ENDIF
803
804 p0ars= max(p0ars,p0arsz2)+6
805 wasz = max(wasz,wasz2)
806 p0arsz2 = 0
807 wasz2 = 0
808C
809 IF (output%STATE%STAT_SPH(3) == 1) THEN
810C------------------------------
811C 18: full
812C------------------------------
813 DO ng=1,ngroup
814 ity = iparg(5,ng)
815 nel = iparg(2,ng)
816 nuvar = 0
817 DO i=1,nel
818 iprt = ipartsp(i)
819 mt = ipart(1,iprt)
820 nuvar = max(nuvar,ipm(8,mt))
821 ENDDO
822 wasz2 = wasz2+(nuvar+12)*nel
823 ENDDO
824C
825 rwasz2= wasz2
826 IF (nspmd > 1) CALL spmd_glob_isum9(rwasz2,1)
827 IF (ispmd == 0) p0arsz2 = rwasz2
828 ENDIF ! IF (OUTPUT%STATE%STAT_SPH(3) == 1)
829C
830 p0ars= max(p0ars,p0arsz2)+6
831 wasz = max(wasz,wasz2)
832!-----------
833 RETURN
my_real
#define my_real
Definition cppsort.cpp:32
max
#define max(a, b)
Definition macros.h:21
spmd_glob_isum9
subroutine spmd_glob_isum9(v, len)
Definition spmd_th.F:520