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.
104 lines
3.4 KiB
104 lines
3.4 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
|
||
|
|
|
||
|
|
SUBROUTINE MASSPR (A, TIME, ITMSEL, DENS, MAT, DISP,
|
||
|
|
* NQUAD, LABEL)
|
||
|
|
|
||
|
|
DIMENSION A(*), TIME(*), DENS(*), MAT(6,*),
|
||
|
|
* DISP(NUMNP,*)
|
||
|
|
LOGICAL ITMSEL(*), ISABRT
|
||
|
|
CHARACTER*16 LABEL(32)
|
||
|
|
include 'nu_ptim.blk'
|
||
|
|
include 'nu_numg.blk'
|
||
|
|
include 'nu_mass.blk'
|
||
|
|
include 'nu_logs.blk'
|
||
|
|
|
||
|
|
DIMENSION XI2(2,4), XI3(3,8)
|
||
|
|
LOGICAL FIRST, HAVDEN
|
||
|
|
DATA FIRST / .TRUE. /
|
||
|
|
DATA XI2/ -1.,-1., 1.,-1., 1.,1., -1.,1./
|
||
|
|
DATA XI3/ 1.,-1.,-1., -1.,-1.,-1., -1.,-1.,1., 1.,-1.,1.,
|
||
|
|
* 1.,1.,-1., -1.,1.,-1., -1.,1.,1., 1.,1.,1./
|
||
|
|
|
||
|
|
save
|
||
|
|
|
||
|
|
IF (FIRST) THEN
|
||
|
|
FIRST = .FALSE.
|
||
|
|
CALL MDRSRV ('MASS' , IS, NELBLK)
|
||
|
|
CALL MDRSRV ('VOLUME', IV, NELBLK)
|
||
|
|
CALL MDRSRV ('CENTER', IC, 3)
|
||
|
|
CALL MDRSRV ('INERTA', IZ, 6)
|
||
|
|
NNODES = 2**NDIM
|
||
|
|
NQMAX = 2**NDIM
|
||
|
|
CALL MDRSRV ('XXX' , IXXX, (NDIM+1)*NNODES*NQMAX)
|
||
|
|
CALL MDRSRV ('XG' , IXG, NDIM*NQMAX)
|
||
|
|
CALL MDRSRV ('XINI' , IXINI, NDIM)
|
||
|
|
C ... 'JACOB' conflicts with jacob in command.f, renamed to jacob1
|
||
|
|
CALL MDRSRV ('JACOB1', IAJ, NDIM*NDIM)
|
||
|
|
CALL MDRSRV ('VOL' , IVM, 4*NELBLK)
|
||
|
|
CALL MDRSRV ('IEL' , IEM, 4*NELBLK)
|
||
|
|
CALL MDSTAT (NERRS, NUSED)
|
||
|
|
IF (NERRS .GT. 0) THEN
|
||
|
|
CALL MEMERR
|
||
|
|
STOP
|
||
|
|
END IF
|
||
|
|
END IF
|
||
|
|
|
||
|
|
HAVDEN = .FALSE.
|
||
|
|
DO 20 I=1,NELBLK
|
||
|
|
IF (DENS(I) .NE. 0.0) HAVDEN = .TRUE.
|
||
|
|
20 CONTINUE
|
||
|
|
|
||
|
|
IF (.NOT. HAVDEN) CALL GETDEN (MAT, DENS, NELBLK, LABEL)
|
||
|
|
|
||
|
|
IF (EXODUS .AND. ISDIS) THEN
|
||
|
|
CALL GETDSP (A(IR), DISP, NDIM, NUMNP, TIME, ITMSEL,
|
||
|
|
* 'R', ISTAT)
|
||
|
|
IF (ISTAT .NE. 0) GO TO 40
|
||
|
|
|
||
|
|
30 CONTINUE
|
||
|
|
IF (ISABRT()) RETURN
|
||
|
|
CALL GETDSP (A(IR), DISP, NDIM, NUMNP, TIME, ITMSEL,
|
||
|
|
* 'A', ISTAT)
|
||
|
|
IF (ISTAT .NE. 0) GO TO 40
|
||
|
|
IF (NDIM .EQ. 2) THEN
|
||
|
|
CALL CGCAL2 (DISP,A(IX),MAT,A(IS),VOL,A(ID),
|
||
|
|
* A(IV),A(IC),A(IZ),A(IXXX),A(IXG),XI2,
|
||
|
|
* A(IXINI),A(IAJ),NNODES,NDIM,NQUAD,
|
||
|
|
* A(IVM),A(IEM),NELBLK,AXI,NUMNP)
|
||
|
|
ELSE IF (NDIM .EQ. 3) THEN
|
||
|
|
CALL CGCAL3 (DISP,A(IX),MAT,A(IS),VOL,A(ID),
|
||
|
|
* A(IV),A(IC),A(IZ),A(IXXX),A(IXG),XI3,
|
||
|
|
* A(IXINI),A(IAJ),NNODES,NDIM,NQUAD,
|
||
|
|
* A(IVM),A(IEM),NELBLK,NUMNP)
|
||
|
|
END IF
|
||
|
|
|
||
|
|
CALL OUTPUT (A(IS), A(ID), A(IV), A(IC), A(IZ), MAT,
|
||
|
|
* NDIM,NELBLK, VOL, A(IVM), A(IEM),
|
||
|
|
* NQUAD, LABEL, AXI, TREAD)
|
||
|
|
|
||
|
|
GO TO 30
|
||
|
|
40 CONTINUE
|
||
|
|
ELSE
|
||
|
|
IF (NDIM .EQ. 2) THEN
|
||
|
|
CALL CGCAL2 (A(IR),A(IX),MAT,A(IS),VOL,A(ID),
|
||
|
|
* A(IV),A(IC),A(IZ),A(IXXX),A(IXG),XI2,
|
||
|
|
* A(IXINI),A(IAJ),NNODES,NDIM,NQUAD,
|
||
|
|
* A(IVM),A(IEM),NELBLK,AXI,NUMNP)
|
||
|
|
ELSE
|
||
|
|
CALL CGCAL3 (A(IR),A(IX),MAT,A(IS),VOL,A(ID),
|
||
|
|
* A(IV),A(IC),A(IZ),A(IXXX),A(IXG),XI3,
|
||
|
|
* A(IXINI),A(IAJ),NNODES,NDIM,NQUAD,
|
||
|
|
* A(IVM),A(IEM),NELBLK,NUMNP)
|
||
|
|
END IF
|
||
|
|
CALL OUTPUT (A(IS), A(ID), A(IV), A(IC), A(IZ), MAT,
|
||
|
|
* NDIM,NELBLK, VOL, A(IVM), A(IEM), NQUAD, LABEL,
|
||
|
|
* AXI, TREAD)
|
||
|
|
|
||
|
|
END IF
|
||
|
|
RETURN
|
||
|
|
END
|