lib
/
EXODUS
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity
Cloned SEACAS for EXODUS library with extra build files for internal package management.
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.
4 Commits
1 Branch
0 Tags
19 MiB
 
 
 
 
 
 
Tag: Branch: Tree: 77bd7563eb
Branches Tags
${ item.name }
Create tag ${ searchTerm }
Create branch ${ searchTerm }
from '77bd7563eb'
${ noResults }
EXODUS/packages/seacas/libraries/mapvarlib/elton1.f

548 lines
22 KiB
Raw Blame History

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, ELTON1
SUBROUTINE ELTON1(CNTRA,SOLEA,SOLENA,IDBLK,
& XA,YA,ZA,ICONA,NDLSTA,
& INVLN,INVCN,MAXLN,ISTP,
& ITT, iblk)
C *********************************************************************
C Subroutine ELTON1 extracts nodal values of element variables by
C c performing a weighted least squares fit (4 or more elements) or
C c a triangulation (3 elements) over the centroids of the elements
C c attached to the current node.
C Each element block must be processed independently in order to
C avoid averaging element variables across material boundaries.
C Note: the last set of DO loops acts over all nodes; to make sense
C one element block must be completely processed before another
C element block is sent into this subroutine.
C Calls subroutines CNTR, VOL, EXTQ, AVG, EXTH, ERROR
C Called by MAPVAR
C *********************************************************************
C CNTRA a list of element centroid coordinates for all elements
C in the current element block (1:ndima,1:numeba)
C SOLEA element variables (1:numeba,1:nvarel)
C SOLENA element variables at nodes (1:nodesa,1:nvarel)
C IDBLK current element block I.D.
C XA,YA,ZA coordinates
C ICONA mesh-A connectivity (1:nelnda,1:numeba)
C NDLSTA list of nodes in element block - from RDA2 (1:numnda)
C INVLN number of elements per node (1:numnda)
C INVCN inverse connectivity (1:nelnda,1:numnda)
C MAXLN maximum number of elements connected to any node
C ITT truth table
C iblk element block being processed (not ID)
C** RELATIONSHIP BETWEEN NODAL IDENTIFICATIONS **
C IGLND = NDLSTA(INOD) = ICONA(NOWLND,INVCN(1,IGLND))
C *********************************************************************
include 'aexds1.blk'
include 'aexds2.blk'
include 'amesh.blk'
include 'ebbyeb.blk'
include 'ex2tp.blk'
include 'tapes.blk'
DIMENSION CNTRA(NUMEBA,*), SOLEA(NUMEBA,*)
DIMENSION SOLENA(NODESA,NVAREL)
DIMENSION XX(27), YY(27), ZZ(27), IFCLND(4), IEGLND(2)
DIMENSION XA(*), YA(*), ZA(*), ICONA(NELNDA,*), NDLSTA(*)
DIMENSION INVCN(MAXLN,*), INVLN(*), ITT(NVAREL,*)
C *********************************************************************
NXTLND = 0
IF (ITYPE .EQ. 4 .OR. ITYPE .EQ. 5)THEN
CALL ERROR('ELTON1','ELEMENT TYPE',' ',ITYPE,
& 'ELEMENT VARIABLE PROCESSING NOT YET IMPLEMENTED',
& 0,' ',' ',1)
END IF
DO I = 1, NODESA
DO J = 1, NVAREL
SOLENA(I,J) = 0.
end do
end do
C load up CNTRA array - coordinates of mesh-A element centroids
C NNODES = NNELM(ITYPE)
NNODES = NELNDA
IF (ITYPE .EQ. 6) NNODES = 4
IF (NDIMA .EQ. 2) THEN
DO 40 IEL = 1, NUMEBA
DO 50 I = 1, NNODES
INODE = ICONA(I,IEL)
XX(I) = XA(INODE)
YY(I) = YA(INODE)
ZZ(I) = 0.
50 CONTINUE
CALL CNTR(ITYPE,XX,YY,ZZ,CNTRA(IEL,1),CNTRA(IEL,2),DUMMY)
40 CONTINUE
ELSE
DO 60 IEL = 1, NUMEBA
DO 70 I = 1, NNODES
INODE = ICONA(I,IEL)
XX(I) = XA(INODE)
YY(I) = YA(INODE)
ZZ(I) = ZA(INODE)
70 CONTINUE
CALL CNTR(ITYPE,XX,YY,ZZ,CNTRA(IEL,1),CNTRA(IEL,2),
& CNTRA(IEL,3))
60 CONTINUE
END IF
C put element variables into SOLEA array
DO 80 IVAR = 1, NVAREL
IF (ITT(IVAR,iblk) .EQ. 0)GO TO 80
CALL EXGEV(NTP2EX,ISTP,IVAR,IDBLK,NUMEBA,SOLEA(1,IVAR),IERR)
IF (NAMVAR(nvargp+IVAR)(1:6) .EQ. 'ELMASS') THEN
C replace element mass with density
DO 90 IEL = 1, NUMEBA
DO 100 I = 1, NNODES
XX(I) = XA(ICONA(I,IEL))
YY(I) = YA(ICONA(I,IEL))
IF (NDIMA .EQ. 3)THEN
ZZ(I) = ZA(ICONA(I,IEL))
ELSE
ZZ(I) = 0.
END IF
100 CONTINUE
CALL VOL(ITYPE,XX,YY,ZZ,VOLUME)
SOLEA(IEL,IVAR) = SOLEA(IEL,IVAR) / VOLUME
90 CONTINUE
END IF
80 CONTINUE
C start least squares extrapolation
c First check element type
c 3 = 4-node quad (2d)
c 10 = 8-node hex (3d)
c*******
IF (ITYPE .EQ. 3)THEN
C Find the elements connected to the node. If fewer than 3 elements,
C adjust search to find additional elements. If unable to get at
C least 3 elements, must be treated as special case (just average
C element values at node)(see below).
DO 110 INOD = 1, NUMNDA
IGLND = NDLSTA(INOD)
C Process special case of only 1 element attached to node
IF (INVLN(IGLND) .EQ. 1)THEN
C Get node number diagonally across element, in most cases this
C node will have 4 elements attached.
NXTLND = 0
DO 120 I = 1, NNODES
IF (IGLND .EQ. ICONA(I,INVCN(1,IGLND))) THEN
NXTLND = I + 2
END IF
120 CONTINUE
IF (NXTLND .GT. NNODES) NXTLND = NXTLND - NNODES
NXGLND = ICONA(NXTLND,INVCN(1,IGLND))
C If 3 or more elements perform least
c squares extrapolation to original node. If 2 or less elements,
c average original element variables at original node
IF (INVLN(NXGLND) .GT. 2)THEN
CALL EXTQ(IGLND,INVCN,MAXLN,NXGLND,INVLN(NXGLND),
$ XA,YA, CNTRA,SOLEA,SOLENA,ITT,iblk)
ELSE
CALL AVG(IGLND,INVCN,MAXLN,INVLN(IGLND),
$ SOLEA,SOLENA,ITT,iblk)
END IF
C Process special case of only 2 elements attached to node
ELSE IF (INVLN(IGLND) .EQ. 2)THEN
c get second node that is shared by both elements. That is the
c node on the other end of the shared element side.
DO I = 1, NNODES
DO J = 1, NNODES
IF(ICONA(I,INVCN(1,IGLND)) .NE. IGLND .AND.
& ICONA(I,INVCN(1,IGLND)) .EQ.
$ ICONA(J,INVCN(2,IGLND))) THEN
NXGLND = ICONA(I,INVCN(1,IGLND))
END IF
end do
end do
c If this second node has more than 2 elements, extrapolate. Otherwise
c average. (at original node)
IF (INVLN(NXGLND) .GT. 2)THEN
CALL EXTQ(IGLND,INVCN,MAXLN,NXGLND,
$ INVLN(NXGLND), XA,YA,CNTRA,
$ SOLEA,SOLENA,ITT,iblk)
ELSE
CALL AVG(IGLND,INVCN,MAXLN,INVLN(IGLND),
$ SOLEA,SOLENA,ITT,iblk)
END IF
ELSE
CALL EXTQ(IGLND,INVCN,MAXLN,IGLND,INVLN(IGLND),
$ XA,YA,CNTRA,SOLEA,SOLENA,ITT,iblk)
END IF
110 CONTINUE
c*****
ELSE IF (ITYPE .EQ. 10)THEN
c Do for 8-node hex in 3D, similar to 4-node quad in 2D above
DO 200 INOD = 1, NUMNDA
IGLND = NDLSTA(INOD)
c First find elements connected to node - inverse connectivity
C Similar to 2D, process special cases
NOWLND = 0
DO 210 I = 1, NNODES
IF (IGLND .EQ. ICONA(I,INVCN(1,IGLND)))THEN
NOWLND = I
GO TO 220
END IF
210 CONTINUE
220 CONTINUE
C Only 1 element connected to node, find node diagonally across hex
IF (INVLN(IGLND) .EQ. 1)THEN
IF (NOWLND .EQ. 1 .OR. NOWLND .EQ. 2)THEN
NXTLND = NOWLND + 6
ELSE IF (NOWLND .EQ. 3 .OR. NOWLND .EQ. 4)THEN
NXTLND = NOWLND + 2
ELSE IF (NOWLND .EQ. 5 .OR. NOWLND .EQ. 6)THEN
NXTLND = NOWLND - 2
ELSE IF (NOWLND .EQ. 7 .OR. NOWLND .EQ. 8)THEN
NXTLND = NOWLND - 6
END IF
NXGLND = ICONA(NXTLND,INVCN(1,IGLND))
IF (INVLN(NXGLND) .GT. 5)THEN
CALL EXTH(IGLND,INVCN,MAXLN,NXGLND,
$ INVLN(NXGLND),XA,YA,ZA,CNTRA,
$ SOLEA,SOLENA,ITT,iblk)
ELSE
CALL AVG(IGLND,INVCN,MAXLN,INVLN(IGLND),
$ SOLEA,SOLENA,ITT,iblk)
END IF
go to 200
C Only 2 elements connected to node, find node diagonally across
C shared face of 2 elements
ELSE IF (INVLN(IGLND) .EQ. 2)THEN
DO 250 J = 1, NNODES
IF (NOWLND .EQ. 1)THEN
IF (ICONA(3,INVCN(1,IGLND)) .EQ.
& ICONA(J,INVCN(2,IGLND)))THEN
NXTLND = 3
GO TO 260
ELSE IF (ICONA(6,INVCN(1,IGLND)) .EQ.
& ICONA(J,INVCN(2,IGLND)))THEN
NXTLND = 6
GO TO 260
ELSE IF (ICONA(8,INVCN(1,IGLND)) .EQ.
& ICONA(J,INVCN(2,IGLND)))THEN
NXTLND = 8
GO TO 260
END IF
ELSE IF (NOWLND .EQ. 2)THEN
IF (ICONA(4,INVCN(1,IGLND)) .EQ.
& ICONA(J,INVCN(2,IGLND)))THEN
NXTLND = 4
GO TO 260
ELSE IF (ICONA(5,INVCN(1,IGLND)) .EQ.
& ICONA(J,INVCN(2,IGLND)))THEN
NXTLND = 5
GO TO 260
ELSE IF (ICONA(7,INVCN(1,IGLND)) .EQ.
& ICONA(J,INVCN(2,IGLND)))THEN
NXTLND = 7
GO TO 260
END IF
ELSE IF (NOWLND .EQ. 3)THEN
IF (ICONA(1,INVCN(1,IGLND)) .EQ.
& ICONA(J,INVCN(2,IGLND)))THEN
NXTLND = 1
GO TO 260
ELSE IF (ICONA(6,INVCN(1,IGLND)) .EQ.
& ICONA(J,INVCN(2,IGLND)))THEN
NXTLND = 6
GO TO 260
ELSE IF (ICONA(8,INVCN(1,IGLND)) .EQ.
& ICONA(J,INVCN(2,IGLND)))THEN
NXTLND = 8
GO TO 260
END IF
ELSE IF (NOWLND .EQ. 4)THEN
IF (ICONA(2,INVCN(1,IGLND)) .EQ.
& ICONA(J,INVCN(2,IGLND)))THEN
NXTLND = 2
GO TO 260
ELSE IF (ICONA(5,INVCN(1,IGLND)) .EQ.
& ICONA(J,INVCN(2,IGLND)))THEN
NXTLND = 5
GO TO 260
ELSE IF (ICONA(7,INVCN(1,IGLND)) .EQ.
& ICONA(J,INVCN(2,IGLND)))THEN
NXTLND = 7
GO TO 260
END IF
ELSE IF (NOWLND .EQ. 5)THEN
IF (ICONA(2,INVCN(1,IGLND)) .EQ.
& ICONA(J,INVCN(2,IGLND)))THEN
NXTLND = 2
GO TO 260
ELSE IF (ICONA(4,INVCN(1,IGLND)) .EQ.
& ICONA(J,INVCN(2,IGLND)))THEN
NXTLND = 4
GO TO 260
ELSE IF (ICONA(7,INVCN(1,IGLND)) .EQ.
& ICONA(J,INVCN(2,IGLND)))THEN
NXTLND = 7
GO TO 260
END IF
ELSE IF (NOWLND .EQ. 6)THEN
IF (ICONA(1,INVCN(1,IGLND)) .EQ.
& ICONA(J,INVCN(2,IGLND)))THEN
NXTLND = 1
GO TO 260
ELSE IF (ICONA(3,INVCN(1,IGLND)) .EQ.
& ICONA(J,INVCN(2,IGLND)))THEN
NXTLND = 3
GO TO 260
ELSE IF (ICONA(8,INVCN(1,IGLND)) .EQ.
& ICONA(J,INVCN(2,IGLND)))THEN
NXTLND = 8
GO TO 260
END IF
ELSE IF (NOWLND .EQ. 7)THEN
IF (ICONA(2,INVCN(1,IGLND)) .EQ.
& ICONA(J,INVCN(2,IGLND)))THEN
NXTLND = 2
GO TO 260
ELSE IF (ICONA(4,INVCN(1,IGLND)) .EQ.
& ICONA(J,INVCN(2,IGLND)))THEN
NXTLND = 4
GO TO 260
ELSE IF (ICONA(5,INVCN(1,IGLND)) .EQ.
& ICONA(J,INVCN(2,IGLND)))THEN
NXTLND = 5
GO TO 260
END IF
ELSE IF (NOWLND .EQ. 8)THEN
IF (ICONA(1,INVCN(1,IGLND)) .EQ.
& ICONA(J,INVCN(2,IGLND)))THEN
NXTLND = 1
GO TO 260
ELSE IF (ICONA(3,INVCN(1,IGLND)) .EQ.
& ICONA(J,INVCN(2,IGLND)))THEN
NXTLND = 3
GO TO 260
ELSE IF (ICONA(6,INVCN(1,IGLND)) .EQ.
& ICONA(J,INVCN(2,IGLND)))THEN
NXTLND = 6
GO TO 260
END IF
ELSE
CALL ERROR('ELTON1',
$ 'IN 3-D, LEAST-SQUARES, 2 ELEMENTS',
& 'NEXT NODE - DIAGONALLY ACROSS FACE NOT FOUND',
$ 0,' ',0,' ',' ',1)
END IF
250 CONTINUE
260 CONTINUE
NXGLND = ICONA(NXTLND,INVCN(1,IGLND))
IF (INVLN(NXGLND) .GT. 5)THEN
CALL EXTH(IGLND,INVCN,MAXLN,NXGLND,
$ INVLN(NXGLND),XA,YA,ZA,CNTRA,
$ SOLEA,SOLENA,ITT,iblk)
ELSE
CALL AVG(IGLND,INVCN,MAXLN,INVLN(IGLND),
$ SOLEA,SOLENA,ITT,iblk)
END IF
go to 200
ELSE IF (INVLN(IGLND) .LT. 8)THEN
C If 3 to 7 elements are connected to a node, check for shared edge.
C If all elements share an edge, transfer to other end of that edge.
C Otherwise, extrapolate/average with what you have.
C Step-1 find shared face or edge between element-1 and element-2
K = 0
DO 300 I = 1, NNODES
DO 310 J = 1, NNODES
IF (ICONA(I,INVCN(1,IGLND)) .EQ.
& ICONA(J,INVCN(2,IGLND)))THEN
K = K + 1
IFCLND(K) = I
GO TO 300
END IF
310 CONTINUE
300 CONTINUE
C If K=4, shared face, process element 3 to determine shared edge
C If K=6, or K=8, then there is a degenerate hex in the mesh -
C don't worry how it is processed
C If K=2, shared edge
C IF K=1, no shared edge, extrapolate/average with elements you got
KC = 0
IF (K .EQ. 6 .OR. K .EQ. 8)THEN
GO TO 380
ELSE IF (K .EQ. 4)THEN
DO 320 IC = 1, K
DO 330 JC = 1, NNODES
IF (ICONA(IFCLND(IC),INVCN(1,IGLND)) .EQ.
& ICONA(JC,INVCN(3,IGLND)))THEN
KC = KC + 1
IEGLND(KC) = IFCLND(IC)
GO TO 320
END IF
330 CONTINUE
320 CONTINUE
ELSE IF (K .EQ. 2) THEN
KC = 2
IEGLND(1) = IFCLND(1)
IEGLND(2) = IFCLND(2)
ELSE IF (K .EQ. 1)THEN
GO TO 380
ELSE
CALL ERROR('ELTON1',
$ 'IN 3-D, LEAST-SQUARES, <8 ELEMENTS',
$ 'EDGE CHECKING - K MUST BE EVEN NO., OR 1 K= ',
$ K,' ',0,' ',' ',1)
END IF
DO 340 IL = 1, INVLN(IGLND)
IEDGCT = 0
DO 350 JJ = 1, NNODES
IF ( KC .GE. 2) THEN
IF (ICONA(IEGLND(1),INVCN(1,IGLND)) .EQ.
& ICONA(JJ,INVCN(IL,IGLND)) .OR.
& ICONA(IEGLND(2),INVCN(1,IGLND)) .EQ.
& ICONA(JJ,INVCN(IL,IGLND)))THEN
IEDGCT = IEDGCT + 1
END IF
ELSE IF ( KC .EQ. 1) THEN
IF (ICONA(IEGLND(1),INVCN(1,IGLND)) .EQ.
& ICONA(JJ,INVCN(IL,IGLND)))THEN
IEDGCT = IEDGCT + 1
END IF
ELSE
GO TO 380
END IF
350 CONTINUE
IF (IEDGCT .LT. 2)GO TO 380
340 CONTINUE
IF (NOWLND .EQ. IEGLND(1))THEN
IF ( KC .LT. 2) GO TO 380
NXTLND = IEGLND(2)
NXGLND = ICONA(NXTLND,INVCN(1,IGLND))
ELSE
NXTLND = IEGLND(1)
NXGLND = ICONA(NXTLND,INVCN(1,IGLND))
END IF
IF (INVLN(NXGLND) .LT. INVLN(IGLND))GO TO 380
IF (INVLN(NXGLND) .LT. 5)THEN
CALL AVG(IGLND,INVCN,MAXLN,INVLN(IGLND),
$ SOLEA,SOLENA,ITT,iblk)
ELSE
CALL EXTH(IGLND,INVCN,MAXLN,NXGLND,
$ INVLN(NXGLND),XA,YA,ZA,CNTRA,
$ SOLEA,SOLENA,ITT,iblk)
END IF
GO TO 200
END IF
380 CONTINUE
IF (INVLN(IGLND) .LT. 5)THEN
CALL AVG(IGLND,INVCN,MAXLN,INVLN(IGLND),
$ SOLEA,SOLENA,ITT,iblk)
ELSE
CALL EXTH(IGLND,INVCN,MAXLN,IGLND,INVLN(IGLND),
& XA,YA,ZA,CNTRA,SOLEA,SOLENA,ITT,iblk)
END IF
200 CONTINUE
c*****
ELSE IF (ITYPE .EQ. 6)THEN
c Do for tet what you do for hex just not the same way
DO 500 INOD = 1, NUMNDA
IGLND = NDLSTA(INOD)
c First find elements connected to node - inverse connectivity
C [NOTE: THIS DOES NOT SEEM TO BE USED...NOWLND?]
DO 510 I = 1, NNODES
IF (IGLND .EQ. ICONA(I,INVCN(1,IGLND)))THEN
NOWLND = I
GO TO 520
END IF
510 CONTINUE
520 CONTINUE
C Less than 12 elements sharing IGLND, find the node of the
C 12 elements that connects with the maximum number of elements
C...Still not sure if this is correct for tets...
NDMAX = IGLND
IF (INVLN(IGLND) .LE. 12) THEN
DO 530 I = 1, INVLN(IGLND)
IEL = INVCN(I,IGLND)
DO 540 J = 1, NNODES
NOWNOD = ICONA(J,IEL)
IF (INVLN(NOWNOD) .GT. INVLN(NDMAX)) THEN
NDMAX = NOWNOD
END IF
540 CONTINUE
530 CONTINUE
ELSE
CALL EXTH(IGLND,INVCN,MAXLN,NDMAX,INVLN(NDMAX),
& XA,YA,ZA,CNTRA,SOLEA,SOLENA,ITT,iblk)
END IF
IF (INVLN(NDMAX) .GT. 12 .and.
$ INVLN(IGLND) .GT. 4) THEN
CALL EXTH(IGLND,INVCN,MAXLN,IGLND,INVLN(IGLND),
& XA,YA,ZA,CNTRA,SOLEA,SOLENA,ITT,iblk)
ELSE
CALL AVG(IGLND,INVCN,MAXLN,INVLN(IGLND),
$ SOLEA,SOLENA, ITT,iblk)
END IF
500 CONTINUE
END IF
RETURN
END