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.

117 lines
4.1 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 EXTQ(IGLND,INVCN,MAXLN,NOD,INVLEN,XA,YA,CNTRA,SOLEA,
& SOLENA,ITT,iblk)
C************************************************************************
C Subroutine EXTQ sets up the matrix and vectors for a least squares
C linear interpolation/extrapolation of element variable data to the
C nodes for a 4-node quad element. In the special case of data from
C only 3 elements, the result is not least squares fit but a
C triangularization.
C Calls subroutines FRGE & BS
C Called by ELTON3
C************************************************************************
C IGLND INT The global node number being processed
C INVCN INT The inverse connectivity (1:maxln,1:numnda)
C MAXLN INT The maximum number of elements connected to any node
C NOD INT The node used to get the elements from INVCN
C INVLEN INT The number of elements connected to NOD
C XA,etc REAL Vectors containing nodal coordinates
C CNTRA REAL Array containing the coordinates of the element
C centroids (1:3)
C SOLEA REAL The element variables
C SOLENA REAL Element variables at nodes
C number with the global mesh node number (1:numnda)
C ITT INT truth table
C IM INT element block being processed (not ID)
C S REAL The coefficient matrix for the least squares fit
C L INT Dummy vector - used in FRGE and BS
C X REAL The solution vector - used in BS
C G REAL Dummy vector - used in FRGE
C F REAL The load vector for the least squares fit
C************************************************************************
include 'aexds1.blk'
include 'amesh.blk'
include 'ebbyeb.blk'
include 'tapes.blk'
DIMENSION INVCN(MAXLN,*),XA(*),YA(*)
DIMENSION CNTRA(NUMEBA,*),SOLEA(NUMEBA,*)
DIMENSION SOLENA(NODESA,NVAREL), ITT(NVAREL,*)
DOUBLE PRECISION S(3,3),G(3),F(3),X(3)
INTEGER L(3)
C************************************************************************
C Zero matrix
DO I = 1,3
DO J = 1,3
S(I,J) = 0.D+00
end do
end do
C Set up matrix for linear fit
S(1,1) = DBLE(INVLEN)
DO I = 1, INVLEN
S(1,2) = S(1,2) + DBLE(XA(IGLND) - CNTRA(INVCN(I,NOD),1))
S(1,3) = S(1,3) + DBLE(YA(IGLND) - CNTRA(INVCN(I,NOD),2))
S(2,2) = S(2,2) + DBLE((XA(IGLND) - CNTRA(INVCN(I,NOD),1)) *
& (XA(IGLND) - CNTRA(INVCN(I,NOD),1)))
S(2,3) = S(2,3) + DBLE((YA(IGLND) - CNTRA(INVCN(I,NOD),2)) *
& (XA(IGLND) - CNTRA(INVCN(I,NOD),1)))
S(3,3) = S(3,3) + DBLE((YA(IGLND) - CNTRA(INVCN(I,NOD),2)) *
& (YA(IGLND) - CNTRA(INVCN(I,NOD),2)))
end do
S(2,1) = S(1,2)
S(3,1) = S(1,3)
S(3,2) = S(2,3)
C Forward Gauss elimination (Kincaid pg. 220) (double precision)
CALL FRGE(3,S,L,G)
C Set up load vectors - number of element variables
DO IVAR = 1, NVAREL
IF (ITT(IVAR,iblk) .EQ. 0)GO TO 30
F(1) = 0.D+00
F(2) = 0.D+00
F(3) = 0.D+00
DO I = 1, INVLEN
F(1) = F(1) + DBLE(SOLEA(INVCN(I,NOD),IVAR))
F(2) = F(2) + DBLE(SOLEA(INVCN(I,NOD),IVAR) *
& (XA(IGLND) - CNTRA(INVCN(I,NOD),1)))
F(3) = F(3) + DBLE(SOLEA(INVCN(I,NOD),IVAR) *
& (YA(IGLND) - CNTRA(INVCN(I,NOD),2)))
end do
C Back substitution (Kincaid pg. 223) (double precision)
CALL BS(3,S,F,L,X)
C Fill in nodal element value array (SOLENA)
C Note: X and Y distances in S and F are centered on node being
C interpolated to (IGLND), thus X and Y are zero in the eq.
C Value = X(1) + X(2) * X + X(3) * Y
SOLENA(IGLND,IVAR) = SNGL(X(1))
end do
30 CONTINUE
RETURN
END