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.
305 lines
11 KiB
305 lines
11 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=======================================================================
|
||
|
|
*DECK,INTRPE
|
||
|
|
SUBROUTINE INTRP3 (CNTRA,CNTRB,IELPT,SOLEB,SOLEA,SOLGRA,IDBLK,
|
||
|
|
& ITT,iblk,TIMES,ISTP,IST,INSUB,ICOMPL,
|
||
|
|
& XB,YB,ZB,ICONB,DUME)
|
||
|
|
|
||
|
|
C ******************************************************************
|
||
|
|
|
||
|
|
C SUBROUTINE TO CONTROL INTERPOLATION OF ELEMENT VARIABLES
|
||
|
|
C FROM MESH-A TO MESH-B FOR SCHEME 3, A ELEMENT CENTROID BASED
|
||
|
|
C INTERPOLATION SCHEME. PHYSICAL CONSTRAINTS ARE APPLIED TO
|
||
|
|
C THE INTERPOLATED RESULTS AND THEN THEY ARE WRITTEN TO MESH-C
|
||
|
|
|
||
|
|
C Called by MAPVAR
|
||
|
|
|
||
|
|
C ******************************************************************
|
||
|
|
|
||
|
|
C CNTRA REAL Centroidal coords for Mesh-A
|
||
|
|
C CNTRB REAL Centroidal coords for Mesh-B
|
||
|
|
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 SOLEA REAL Element variables for Mesh-A
|
||
|
|
C SOLGRA REAL Gradient in element variables for Mesh-A
|
||
|
|
C IDBLK INT Element block ID for mesh-B
|
||
|
|
C ITT INT Truth table
|
||
|
|
C IM INT Element block being processed (not block ID)
|
||
|
|
C TIMES REAL Array of times - passed through to PNF
|
||
|
|
C ISTP INT Time step
|
||
|
|
C IST INT Time step if multiple time steps are in use
|
||
|
|
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 CNTRB(NUMEBB,*), CNTRA(NUMEBA,*), IELPT(*)
|
||
|
|
DIMENSION SOLEB(NUMEBB,*), SOLEA(NUMEBA,*)
|
||
|
|
DIMENSION SOLGRA(NDIMA,NUMEBA,*)
|
||
|
|
DIMENSION ITT(NVAREL,*), ICONB(NELNDB,*)
|
||
|
|
DIMENSION XX(27), YY(27), ZZ(27), XB(*), YB(*), ZB(*)
|
||
|
|
DIMENSION 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 elements in recipient mesh
|
||
|
|
|
||
|
|
DO 30 I=1,NUMEBB
|
||
|
|
IF (IELPT(I) .NE. 0)THEN
|
||
|
|
|
||
|
|
C Distance in cartesian coordinates between mesh-A and mesh-B centroid
|
||
|
|
|
||
|
|
XC = CNTRB(I,1) - CNTRA(IELPT(I),1)
|
||
|
|
YC = CNTRB(I,2) - CNTRA(IELPT(I),2)
|
||
|
|
ZC = 0.
|
||
|
|
IF (NDIMB .EQ. 3)ZC = CNTRB(I,3) - CNTRA(IELPT(I),3)
|
||
|
|
|
||
|
|
C Evaluate interpolation
|
||
|
|
|
||
|
|
SOLEB(I,IVAR) = SOLEA(IELPT(I),IVAR)
|
||
|
|
& + SOLGRA(1,IELPT(I),IVAR) * XC
|
||
|
|
& + SOLGRA(2,IELPT(I),IVAR) * YC
|
||
|
|
& + SOLGRA(3,IELPT(I),IVAR) * ZC
|
||
|
|
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
|
||
|
|
IF (IROTF .NE. 1) THEN
|
||
|
|
CALL ERROR('INTRPE',
|
||
|
|
& 'ROTATION MATRIX NORMALLY REQUIRED FOR RESTART',
|
||
|
|
& 'DIMENSION ',NDIMB,
|
||
|
|
& 'NUMBER OF ROTATION MATRIX COMPONENTS FOUND',IROT,
|
||
|
|
& 'THIS IS ONLY A WARNING',' ',0)
|
||
|
|
END IF
|
||
|
|
c########################################################################
|
||
|
|
|
||
|
|
RETURN
|
||
|
|
END
|