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 33 of file stat_size.F.

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