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.
301 lines
11 KiB
301 lines
11 KiB
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=======================================================================
|
|
*DECK,INTRPE
|
|
SUBROUTINE INTRPE (ICONA,SOLENA,IELPT,STRPT,
|
|
& SOLEB,IDBLK,XB,YB,ZB,
|
|
& ICONB,ITT,IBLK, TIMES,
|
|
& CENTER,ISTP,IST,INSUB,ICOMPL,DUME)
|
|
|
|
C ******************************************************************
|
|
|
|
C SUBROUTINE TO CONTROL INTERPOLATION OF ELEMENT TRANSFORMED
|
|
C INTO NODAL RESULTS FROM MESH-A TO MESH-B
|
|
C INTERPOLATED SOLUTION IS PASSED OUT TO BE RETRANSFORMED
|
|
C INTO ELEMENT RESULTS AND THEN WRITTEN TO MESH-C EXODUS FILE
|
|
|
|
C Calls subroutines SHAPEF
|
|
|
|
C Called by MAPVAR
|
|
|
|
C ******************************************************************
|
|
|
|
C ICONA INT Connectivity of Mesh-A (1:nelnda,1:numeba)
|
|
C SOLENA REAL Element variables at nodes for Mesh-A
|
|
C IELPT INT The element in Mesh-A within which the point
|
|
C (node in Mesh-B) is found
|
|
C STRPT REAL The isoparametric coords of point in IELPT element
|
|
C SOLEB REAL Element variables for Mesh-B
|
|
C SOLN REAL SOLENA vector local to each Mesh-A element
|
|
C TIMES REAL Array of times - passed through to PNF
|
|
C CENTER REAL Coordinates of element centroid - passed through to PNF
|
|
C ISTP INT Time step
|
|
C INSUB INT Entry into subroutine; 1-first time in; >1-second,etc
|
|
C ICOMPL INT Map completion; 0-incomplete; 1-complete
|
|
|
|
C ******************************************************************
|
|
|
|
include 'aexds1.blk'
|
|
include 'aexds2.blk'
|
|
include 'amesh.blk'
|
|
include 'bmesh.blk'
|
|
include 'ebbyeb.blk'
|
|
include 'ex2tp.blk'
|
|
include 'tapes.blk'
|
|
|
|
DIMENSION TIMES(*), CENTER(NUMEBB,*)
|
|
DIMENSION ICONA(NELNDA,*), SOLENA(NODESA,NVAREL)
|
|
DIMENSION ITT(NVAREL,*)
|
|
DIMENSION SOLEB(NUMEBB,*), XB(*), YB(*), ZB(*)
|
|
DIMENSION IELPT(*), STRPT(3,NODESB), ICONB(NELNDB,*)
|
|
DIMENSION SOLN(27), XX(27), YY(27), ZZ(27), DUME(*)
|
|
|
|
C ******************************************************************
|
|
|
|
IROT = 0
|
|
IROTF = 0
|
|
DO 40 IVAR=1,NVAREL
|
|
IF (ITT(IVAR,IBLK) .EQ. 0)GO TO 40
|
|
|
|
C Initialize SOLEB if first time in subroutine for this element block
|
|
C After first time into subroutine
|
|
C retrieve SOLEB from storage in EXODUS
|
|
|
|
IF (INSUB .EQ. 1) THEN
|
|
CALL INIELT(SOLEB,IVAR,TIMES,ISTP,IDBLK,CENTER,DUME)
|
|
ELSE
|
|
CALL EXGEV(NTP4EX,IST,IVAR,IDBLK,NUMEBB,SOLEB(1,IVAR),IERR)
|
|
END IF
|
|
|
|
C Loop on centroids in recipient mesh
|
|
|
|
DO 30 I=1,NUMEBB
|
|
IF (IELPT(I) .NE. 0)THEN
|
|
|
|
C Set parameters for element in donor mesh
|
|
|
|
S=STRPT(1,I)
|
|
T=STRPT(2,I)
|
|
R=0.
|
|
IF (NDIMB.EQ.3) R=STRPT(3,I)
|
|
C NNODES=NNELM(ITYPE)
|
|
NNODES = NELNDB
|
|
IF (ITYPE .EQ. 6) NNODES = 4
|
|
DO 20 J=1,NNODES
|
|
INODE=ICONA(J,IELPT(I))
|
|
SOLN(J)=SOLENA(INODE,IVAR)
|
|
20 CONTINUE
|
|
|
|
C Shape function to evaluate interpolation
|
|
|
|
CALL SHAPEF (ITYPE,S,T,R,SOLN,BVALUE)
|
|
SOLEB(I,IVAR) = BVALUE
|
|
END IF
|
|
30 CONTINUE
|
|
|
|
C If there is more searching to do (i.e. many blocks to one)
|
|
C use EXODUS as temporary storage
|
|
C don't bother to perform needed adjustments yet
|
|
|
|
IF (ICOMPL .NE. 1)THEN
|
|
CALL EXPEV(NTP4EX,IST,IVAR,IDBLK,NUMEBB,SOLEB(1,IVAR),IERR)
|
|
ELSE
|
|
|
|
C write element vars out to EXODUS data base (now is convenient)
|
|
|
|
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
|
|
C ELMASS is special
|
|
|
|
IF (NAMVAR(nvargp+IVAR)(1:6) .EQ. 'ELMASS')THEN
|
|
|
|
C ELMASS was changed to nodal density prior to processing.
|
|
C need to go back from density to element mass now
|
|
|
|
C NNODES=NNELM(ITYPE)
|
|
NNODES = NELNDB
|
|
IF (ITYPE .EQ. 6) NNODES = 4
|
|
DO 100 IEL = 1, NUMEBB
|
|
DO 105 I = 1, NNODES
|
|
XX(I) = XB(ICONB(I,IEL))
|
|
YY(I) = YB(ICONB(I,IEL))
|
|
IF (NDIMB .EQ. 3)THEN
|
|
ZZ(I) = ZB(ICONB(I,IEL))
|
|
ELSE
|
|
ZZ(I) = 0.
|
|
END IF
|
|
105 CONTINUE
|
|
CALL VOL(ITYPE,XX,YY,ZZ,VOLUME)
|
|
SOLEB(IEL,IVAR) = SOLEB(IEL,IVAR) * VOLUME
|
|
100 CONTINUE
|
|
END IF
|
|
|
|
C****************************************************************
|
|
C apply constraints to variables here as applicable
|
|
|
|
C Plastic strain (EQPS) must greater than or equal to 0.
|
|
|
|
IF (NAMVAR(nvargp+IVAR)(1:4) .EQ. 'EQPS')THEN
|
|
DO 110 IEL = 1, NUMEBB
|
|
IF (SOLEB(IEL,IVAR) .LT. 0.)THEN
|
|
SOLEB(IEL,IVAR) = 0.
|
|
END IF
|
|
110 CONTINUE
|
|
|
|
C Hourglass forces and bulk viscosity have no meaning other than on
|
|
C the mesh from which they originated, just set them to zero.
|
|
|
|
ELSE IF (NAMVAR(nvargp+IVAR)(1:2) .EQ. 'HG' .OR.
|
|
& NAMVAR(nvargp+IVAR)(1:5) .EQ. 'BULKQ')THEN
|
|
DO 120 IEL = 1, NUMEBB
|
|
SOLEB(IEL,IVAR) = 0.
|
|
120 CONTINUE
|
|
ELSE IF (NAMVAR(NVARGP+IVAR)(1:7) .EQ. 'TEARING')THEN
|
|
DO 130 IEL = 1, NUMEBB
|
|
IF (SOLEB(IEL,IVAR) .LT. 0.)THEN
|
|
SOLEB(IEL,IVAR) = 0.
|
|
END IF
|
|
130 CONTINUE
|
|
END IF
|
|
C ELSE IF (NAMVAR(NVARGP+IVAR)(1:?) .EQ. ?????)THEN
|
|
C DO ??? IEL = 1, NUMEBB
|
|
C IF (SOLEB(IEL,IVAR) .??. ?.)THEN
|
|
C SOLEB(IEL,IVAR) = ?.
|
|
C END IF
|
|
C ??? CONTINUE
|
|
c************************************************************************
|
|
|
|
c########################################################################
|
|
c the rotation tensor is special
|
|
|
|
c just store pointers to the rotation tensor components for later
|
|
c processing. do nothing here
|
|
|
|
IF (NAMVAR(NVARGP+IVAR)(1:8) .EQ. 'COSTHETA')THEN
|
|
ICOS = IVAR
|
|
IROT = IROT + 1
|
|
GO TO 10
|
|
ELSE IF (NAMVAR(NVARGP+IVAR)(1:8) .EQ. 'SINTHETA')THEN
|
|
ISIN = IVAR
|
|
IROT = IROT + 1
|
|
GO TO 10
|
|
ELSE IF (NAMVAR(NVARGP+IVAR)(1:3) .EQ. 'R11')THEN
|
|
IR11 = IVAR
|
|
IROT = IROT + 1
|
|
GO TO 10
|
|
ELSE IF (NAMVAR(NVARGP+IVAR)(1:3) .EQ. 'R21')THEN
|
|
IR21 = IVAR
|
|
IROT = IROT + 1
|
|
GO TO 10
|
|
ELSE IF (NAMVAR(NVARGP+IVAR)(1:3) .EQ. 'R31')THEN
|
|
IR31 = IVAR
|
|
IROT = IROT + 1
|
|
GO TO 10
|
|
ELSE IF (NAMVAR(NVARGP+IVAR)(1:3) .EQ. 'R12')THEN
|
|
IR12 = IVAR
|
|
IROT = IROT + 1
|
|
GO TO 10
|
|
ELSE IF (NAMVAR(NVARGP+IVAR)(1:3) .EQ. 'R22')THEN
|
|
IR22 = IVAR
|
|
IROT = IROT + 1
|
|
GO TO 10
|
|
ELSE IF (NAMVAR(NVARGP+IVAR)(1:3) .EQ. 'R32')THEN
|
|
IR32 = IVAR
|
|
IROT = IROT + 1
|
|
GO TO 10
|
|
ELSE IF (NAMVAR(NVARGP+IVAR)(1:3) .EQ. 'R13')THEN
|
|
IR13 = IVAR
|
|
IROT = IROT + 1
|
|
GO TO 10
|
|
ELSE IF (NAMVAR(NVARGP+IVAR)(1:3) .EQ. 'R23')THEN
|
|
IR23 = IVAR
|
|
IROT = IROT + 1
|
|
GO TO 10
|
|
ELSE IF (NAMVAR(NVARGP+IVAR)(1:3) .EQ. 'R33')THEN
|
|
IR33 = IVAR
|
|
IROT = IROT + 1
|
|
GO TO 10
|
|
END IF
|
|
c########################################################################
|
|
|
|
C write element variables
|
|
|
|
CALL EXPEV(NTP4EX,IST,IVAR,IDBLK,NUMEBB,SOLEB(1,IVAR),IERR)
|
|
10 CONTINUE
|
|
|
|
c########################################################################
|
|
c now fix-up rotations - rotation matrix must have mag=1
|
|
|
|
c some simple error checking
|
|
|
|
IF (NDIMB .EQ. 2)THEN
|
|
IF (IROT .EQ. 2 .AND.
|
|
& ICOS .NE. 0 .AND. ISIN .NE. 0) THEN
|
|
DO 230 IEL = 1, NUMEBB
|
|
RMAG = SQRT(SOLEB(IEL,ICOS)*SOLEB(IEL,ICOS)
|
|
& + SOLEB(IEL,ISIN)*SOLEB(IEL,ISIN))
|
|
SOLEB(IEL,ICOS) = SOLEB(IEL,ICOS) / RMAG
|
|
SOLEB(IEL,ISIN) = SOLEB(IEL,ISIN) / RMAG
|
|
230 CONTINUE
|
|
CALL EXPEV(NTP4EX,IST,ICOS,IDBLK,NUMEBB,SOLEB(1,ICOS),
|
|
& IERR)
|
|
CALL EXPEV(NTP4EX,IST,ISIN,IDBLK,NUMEBB,SOLEB(1,ISIN),
|
|
& IERR)
|
|
IROTF = 1
|
|
END IF
|
|
|
|
ELSE IF (IROT .EQ. 9 .AND. IROTF .EQ. 0 .AND. IR11 .NE. 0
|
|
& .AND. IR21 .NE. 0 .AND. IR31 .NE. 0 .AND. IR12 .NE. 0
|
|
& .AND. IR22 .NE. 0 .AND. IR32 .NE. 0 .AND. IR13 .NE. 0
|
|
& .AND. IR23 .NE. 0 .AND. IR33 .NE. 0)THEN
|
|
|
|
C compute magnitude of matrix
|
|
|
|
DO 280 IEL = I, NUMEBB
|
|
RMAG=SQRT(SOLEB(IEL,IR11)*SOLEB(IEL,IR22)*SOLEB(IEL,IR33)
|
|
& + SOLEB(IEL,IR21)*SOLEB(IEL,IR32)*SOLEB(IEL,IR13)
|
|
& + SOLEB(IEL,IR31)*SOLEB(IEL,IR12)*SOLEB(IEL,IR23)
|
|
& - SOLEB(IEL,IR11)*SOLEB(IEL,IR23)*SOLEB(IEL,IR32)
|
|
& - SOLEB(IEL,IR12)*SOLEB(IEL,IR21)*SOLEB(IEL,IR33)
|
|
& - SOLEB(IEL,IR13)*SOLEB(IEL,IR22)*SOLEB(IEL,IR31))
|
|
|
|
SOLEB(IEL,IR11) = SOLEB(IEL,IR11) / RMAG
|
|
SOLEB(IEL,IR21) = SOLEB(IEL,IR21) / RMAG
|
|
SOLEB(IEL,IR31) = SOLEB(IEL,IR31) / RMAG
|
|
SOLEB(IEL,IR12) = SOLEB(IEL,IR12) / RMAG
|
|
SOLEB(IEL,IR22) = SOLEB(IEL,IR22) / RMAG
|
|
SOLEB(IEL,IR32) = SOLEB(IEL,IR32) / RMAG
|
|
SOLEB(IEL,IR13) = SOLEB(IEL,IR13) / RMAG
|
|
SOLEB(IEL,IR23) = SOLEB(IEL,IR23) / RMAG
|
|
SOLEB(IEL,IR33) = SOLEB(IEL,IR33) / RMAG
|
|
|
|
280 CONTINUE
|
|
CALL EXPEV(NTP4EX,IST,IR11,IDBLK,NUMEBB,SOLEB(1,IR11),
|
|
& IERR)
|
|
CALL EXPEV(NTP4EX,IST,IR21,IDBLK,NUMEBB,SOLEB(1,IR21),
|
|
& IERR)
|
|
CALL EXPEV(NTP4EX,IST,IR31,IDBLK,NUMEBB,SOLEB(1,IR31),
|
|
& IERR)
|
|
CALL EXPEV(NTP4EX,IST,IR12,IDBLK,NUMEBB,SOLEB(1,IR12),
|
|
& IERR)
|
|
CALL EXPEV(NTP4EX,IST,IR22,IDBLK,NUMEBB,SOLEB(1,IR22),
|
|
& IERR)
|
|
CALL EXPEV(NTP4EX,IST,IR32,IDBLK,NUMEBB,SOLEB(1,IR32),
|
|
& IERR)
|
|
CALL EXPEV(NTP4EX,IST,IR13,IDBLK,NUMEBB,SOLEB(1,IR13),
|
|
& IERR)
|
|
CALL EXPEV(NTP4EX,IST,IR23,IDBLK,NUMEBB,SOLEB(1,IR23),
|
|
& IERR)
|
|
CALL EXPEV(NTP4EX,IST,IR33,IDBLK,NUMEBB,SOLEB(1,IR33),
|
|
& IERR)
|
|
IROTF = 1
|
|
END IF
|
|
END IF
|
|
40 CONTINUE
|
|
c########################################################################
|
|
|
|
RETURN
|
|
END
|
|
|