You can not select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
164 lines
4.8 KiB
164 lines
4.8 KiB
2 years ago
|
C Copyright(C) 1999-2020 National Technology & Engineering Solutions
|
||
|
|
C of Sandia, LLC (NTESS). Under the terms of Contract DE-NA0003525 with
|
||
|
|
C NTESS, the U.S. Government retains certain rights in this software.
|
||
|
|
C
|
||
|
|
C See packages/seacas/LICENSE for details
|
||
|
|
|
||
|
|
C=======================================================================
|
||
|
|
SUBROUTINE SUMELM (CRD, DISP, SVAR, MAT, NDIM, NUMNP, INDX,
|
||
|
|
* ELMSEL, NAME, TIME, ITMSEL, AVER, AXI, DOABS, DODENS,
|
||
|
|
& NUMEL, link, nnodes, nelblk, volume, ISEVOK, SUM,
|
||
|
|
& nsel)
|
||
|
|
C=======================================================================
|
||
|
|
|
||
|
|
include 'exodusII.inc'
|
||
|
|
include 'nu_varcnt.blk'
|
||
|
|
|
||
|
|
REAL CRD(NUMNP,*), DISP(NUMNP,*), SVAR(*)
|
||
|
|
INTEGER MAT(6,*)
|
||
|
|
LOGICAL ISEVOK(nvarel,*)
|
||
|
|
CHARACTER*(*) NAME
|
||
|
|
REAL TIME(*)
|
||
|
|
LOGICAL ELMSEL(*), ITMSEL(*), AXI, AVER, DOABS, DODENS
|
||
|
|
integer link(nnodes, *)
|
||
|
|
real volume(*)
|
||
|
|
REAL SUM(*)
|
||
|
|
integer nsel(*)
|
||
|
|
|
||
|
|
CHARACTER*32 STRA
|
||
|
|
CHARACTER*132 STRB
|
||
|
|
include 'nu_io.blk'
|
||
|
|
include 'nu_ptim.blk'
|
||
|
|
include 'nu_ndisp.blk'
|
||
|
|
|
||
|
|
NLAST = 0
|
||
|
|
|
||
|
|
IF (AVER) THEN
|
||
|
|
IF (DOABS) THEN
|
||
|
|
STRA = 'Average absolute value of'
|
||
|
|
ELSE
|
||
|
|
STRA = 'Average'
|
||
|
|
END IF
|
||
|
|
RSEL = DBLE(NUMEQL (.TRUE., NUMEL, SELECT))
|
||
|
|
ELSE
|
||
|
|
IF (DOABS) THEN
|
||
|
|
STRA = 'Absolute value total of'
|
||
|
|
ELSE
|
||
|
|
STRA = 'Total'
|
||
|
|
END IF
|
||
|
|
RSEL = 1.0
|
||
|
|
END IF
|
||
|
|
if (dodens) then
|
||
|
|
strb = '(Multiplied by element volumes)'
|
||
|
|
else
|
||
|
|
strb = ' '
|
||
|
|
end if
|
||
|
|
DO 10 IO=IOMIN, IOMAX
|
||
|
|
IF (NDIM .EQ. 2 .AND. AXI) THEN
|
||
|
|
WRITE (IO,20) STRA(:LENSTR(STRA)), NAME(:LENSTR(NAME)),
|
||
|
|
& strb(:lenstr(strb))
|
||
|
|
ELSE
|
||
|
|
WRITE (IO,30) STRA(:LENSTR(STRA)), NAME(:LENSTR(NAME)),
|
||
|
|
& strb(:lenstr(strb))
|
||
|
|
END IF
|
||
|
|
WRITE (IO, 40) (MAT(1,iblk),iblk=1,nelblk)
|
||
|
|
10 CONTINUE
|
||
|
|
20 FORMAT (/4X,A,' ',A,' on selected elements ',
|
||
|
|
* '(2 PI Radius Multiplier) ',A)
|
||
|
|
30 FORMAT (/4X,A,' ',A,' on selected elements ',A)
|
||
|
|
40 FORMAT (/,4X,'Time Total ',32(I8,4x))
|
||
|
|
|
||
|
|
C ... Determine number of selected elements in each block
|
||
|
|
DO 45 iblk = 1, nelblk
|
||
|
|
if (mat(5, iblk) .eq. 1) then
|
||
|
|
ielbeg = mat(3, iblk)
|
||
|
|
ielend = mat(4, iblk)
|
||
|
|
nsel(iblk) = 0
|
||
|
|
do 44 iel = ielbeg, ielend
|
||
|
|
if (elmsel(iel)) nsel(iblk) = nsel(iblk) + 1
|
||
|
|
44 continue
|
||
|
|
else
|
||
|
|
nsel(iblk) = 0
|
||
|
|
end if
|
||
|
|
45 continue
|
||
|
|
|
||
|
|
50 CONTINUE
|
||
|
|
NLAST = NLAST + 1
|
||
|
|
IF (NLAST .GT. LSTSEL) THEN
|
||
|
|
NLAST = 0
|
||
|
|
GO TO 120
|
||
|
|
ELSE IF (ITMSEL(NLAST)) THEN
|
||
|
|
|
||
|
|
C ... If by density, then calculate volume of elements
|
||
|
|
IF (DODENS) THEN
|
||
|
|
C ... READ THE STEP AND STORE DISPLACEMENTS
|
||
|
|
do 54 i=1, ndim
|
||
|
|
call exgnv(ndb, nlast, ndisp(i), numnp, disp(1,i), ierr)
|
||
|
|
54 continue
|
||
|
|
call elvol(ndim, crd, disp, link, numnp, numel, nnodes,
|
||
|
|
& volume)
|
||
|
|
else
|
||
|
|
call inirea (numel, 1.0, volume)
|
||
|
|
end if
|
||
|
|
|
||
|
|
C ... Zero the volume of all non-selected elements
|
||
|
|
do 55 iel = 1, numel
|
||
|
|
if (.not. elmsel(iel)) volume(iel) = 0.0
|
||
|
|
55 continue
|
||
|
|
|
||
|
|
C ... Read and store the element variable
|
||
|
|
call inirea(numel, 0.0, svar)
|
||
|
|
ioff = 1
|
||
|
|
do 56 i=1, nelblk
|
||
|
|
if (isevok(indx, i)) then
|
||
|
|
call exgev(ndb, nlast, indx, mat(1,i), mat(2,i),
|
||
|
|
& svar(ioff), ierr)
|
||
|
|
end if
|
||
|
|
56 continue
|
||
|
|
TREAD = TIME(NLAST)
|
||
|
|
|
||
|
|
DO 60 I = 1, NELBLK+1
|
||
|
|
SUM(I) = 0.0
|
||
|
|
60 CONTINUE
|
||
|
|
|
||
|
|
neb1 = nelblk + 1
|
||
|
|
do 90 iblk = 1, nelblk
|
||
|
|
if (mat(5, iblk) .ne. 1) goto 80
|
||
|
|
ielbeg = mat(3, iblk)
|
||
|
|
ielend = mat(4, iblk)
|
||
|
|
C ... Note that volume is set to zero for all non-selected elements
|
||
|
|
if (doabs) then
|
||
|
|
do 70 iel = ielbeg, ielend
|
||
|
|
SUM(iblk) = SUM(iblk) + ABS(SVAR(I) * volume(i))
|
||
|
|
70 continue
|
||
|
|
else
|
||
|
|
do 75 iel = ielbeg, ielend
|
||
|
|
SUM(IBLK) = SUM(IBLK) + SVAR(I) * volume(i)
|
||
|
|
75 continue
|
||
|
|
end if
|
||
|
|
sum(neb1) = sum(neb1) + sum(iblk)
|
||
|
|
if (aver) then
|
||
|
|
sum(iblk) = sum(iblk) / nsel(iblk)
|
||
|
|
end if
|
||
|
|
80 continue
|
||
|
|
90 continue
|
||
|
|
if (aver) then
|
||
|
|
sum(neb1) = sum(neb1) / rsel
|
||
|
|
end if
|
||
|
|
|
||
|
|
DO 100 IO=IOMIN,IOMAX
|
||
|
|
WRITE (IO, 110) TREAD, sum(nelblk+1), (SUM(i),i=1, nelblk)
|
||
|
|
100 CONTINUE
|
||
|
|
110 FORMAT (1X,32(1PE15.8,2X))
|
||
|
|
|
||
|
|
END IF
|
||
|
|
GO TO 50
|
||
|
|
|
||
|
|
120 CONTINUE
|
||
|
|
RETURN
|
||
|
|
|
||
|
|
CALL PRTERR ('PROGRAM',
|
||
|
|
* 'Internal code error, contact sponsor')
|
||
|
|
STOP 'SUMIT'
|
||
|
|
END
|