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.
171 lines
5.4 KiB
171 lines
5.4 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=======================================================================
|
|
SUBROUTINE MOVE(ndbin, A, IA, isnp, X, Y, Z, NDIM, numnp, numel,
|
|
* numess, idess, neess, ixeess, lteess,
|
|
* nelb, idelb, numelb, numlnk, link,
|
|
* issblk, iscrn, iscre)
|
|
C=======================================================================
|
|
|
|
REAL A(*)
|
|
INTEGER IA(*)
|
|
REAL X(*), Y(*), Z(*)
|
|
INTEGER NUMESS
|
|
INTEGER IDESS(*)
|
|
INTEGER NEESS(*)
|
|
INTEGER IXEESS(*)
|
|
INTEGER LTEESS(*)
|
|
INTEGER IDELB(NELB)
|
|
INTEGER NUMELB(NELB)
|
|
INTEGER NUMLNK(NELB)
|
|
INTEGER LINK(*)
|
|
INTEGER ISSBLK(NELB), ISCRN(*), ISCRE(*)
|
|
|
|
INCLUDE 'gp_snap.blk'
|
|
|
|
C -- X,Y,Z -- REAL - IN/OUT - Coordinates of nodes
|
|
C -- NDIM - IN - the number of dimensions
|
|
C -- NUMESS - IN - the number of side sets
|
|
C -- IDESS - IN - the side set ID for each set
|
|
C -- NEESS - IN - the number of elements for each set
|
|
C -- IXEESS - IN - the index of the first element for each set
|
|
C -- LTEESS - IN - the elements for all sets
|
|
|
|
call iniint(numel, 0, iscre)
|
|
call iniint(numnp, 0, iscrn)
|
|
call iniint(nelb, 0, issblk)
|
|
|
|
call mdrsrv('ISCR', KISCR, NUMNP)
|
|
call mdrsrv('VNORM', KVNORM, NUMNP*3)
|
|
call mdrsrv('PLANE', KPLANE, 0)
|
|
|
|
indma = 0
|
|
indsl = 0
|
|
|
|
C ... Find master index
|
|
do 100 i=1, numess
|
|
if (idess(i) .eq. idssma(isnp)) then
|
|
indma = i
|
|
go to 110
|
|
endif
|
|
100 continue
|
|
110 continue
|
|
|
|
C ... Find slave index
|
|
do 120 i=1, numess
|
|
if (idess(i) .eq. idsssl(isnp)) then
|
|
indsl = i
|
|
go to 130
|
|
endif
|
|
120 continue
|
|
130 continue
|
|
|
|
C------------------------------------------------------------------------
|
|
C ... Get the number of nodes on the slave surface
|
|
call exgsp(ndbin, idess(indsl), nssess, nsdess, ierr)
|
|
if (nsdess .eq. 0) then
|
|
C... Distribution factors not stored, estimate max size of node list
|
|
C based on maximum of 9 nodes/face.
|
|
nsdess = nssess * 9
|
|
end if
|
|
C... Allocate storage for sideset node and count list.
|
|
call mdrsrv('NODSLV', islvnd, nsdess)
|
|
call mdrsrv('NNDSLV', islvnn, nssess)
|
|
C... Get the sideset nodes...
|
|
call exgssn(ndbin, idess(indsl), ia(islvnn), ia(islvnd), ierr)
|
|
|
|
C ... Get the number of nodes on the master surface
|
|
call exgsp(ndbin, idess(indma), nmsess, nmdess, ierr)
|
|
if (nmdess .eq. 0) then
|
|
C... Distribution factors not stored, estimate max size of node list
|
|
C based on maximum of 9 nodes/face.
|
|
nmdess = nmsess * 9
|
|
end if
|
|
C... Allocate storage for sideset node and count list.
|
|
call mdrsrv('NODMAS', imasnd, nmdess)
|
|
call mdrsrv('NNDMAS', imasnn, nmsess)
|
|
C... Get the sideset nodes...
|
|
call exgssn(ndbin, idess(indma), ia(imasnn), ia(imasnd), ierr)
|
|
C------------------------------------------------------------------------
|
|
|
|
C ... Find element blocks containing elements in sideset 'indsl'
|
|
C ... First, use the scratch element storage to map element to block
|
|
ibeg = 1
|
|
do 140 iblk = 1, nelb
|
|
call iniint(numelb(iblk), iblk, iscre(ibeg))
|
|
ibeg = ibeg+numelb(iblk)
|
|
140 continue
|
|
|
|
C ... Now, for each element in the sideset, find which block it is in
|
|
C and set 'issblk' equal to 1.
|
|
ibeg = ixeess(indsl)
|
|
do 150 isse = ibeg, ibeg+neess(indsl)-1
|
|
iel = lteess(isse)
|
|
if (iscre(iel) .eq. 1) then
|
|
PRINT *, iel
|
|
end if
|
|
issblk(iscre(iel)) = 1
|
|
150 continue
|
|
|
|
C ... Now, for each block in the sideset, find the nodes contained in
|
|
C that block.
|
|
ielnk = 0
|
|
do 170 iblk = 1, nelb
|
|
ISLNK = IELNK + 1
|
|
IELNK = IELNK + NUMLNK(IBLK) * NUMELB(IBLK)
|
|
if (issblk(iblk) .eq. 1) then
|
|
call exfcon(1, numelb(iblk), numlnk(iblk), link(islnk),
|
|
* iscrn)
|
|
end if
|
|
170 continue
|
|
C ... At this point, iscrn(i) will be 1 if node in block, 0 otherwise
|
|
|
|
C ... Allocate temporary storage
|
|
nummaf = neess(indma)
|
|
call mdlong('PLANE', KPLANE, nummaf*4)
|
|
|
|
call inirea(3*numnp, 0.0, a(kvnorm))
|
|
call inirea(4*nummaf, 0.0, a(kplane))
|
|
|
|
C ... Calculate the slave surface normals
|
|
if (ndim .eq. 3) then
|
|
call setnor(.FALSE., numnp, x, y, z, 3, a(kvnorm),
|
|
* usnorm(isnp), vector(1, isnp),
|
|
* nssess, nsdess, ia(islvnd))
|
|
|
|
C ... Calculate the master surface planes
|
|
call setnor(.TRUE., numnp, x, y, z, 4, a(kplane),
|
|
* 0, vector(1, isnp),
|
|
* nmsess, nmdess, ia(imasnd))
|
|
|
|
call movnod(numnp, ndim, x, y, z,
|
|
* a(kvnorm), nssess, nsdess, ia(islvnd),
|
|
* a(kplane), nmsess, nmdess, ia(imasnd),
|
|
* snptol(isnp), delmax(isnp), iscrn, vector(1,isnp),
|
|
* gap(isnp))
|
|
else
|
|
call setnr2 (.FALSE., numnp, x, y, 3, a(kvnorm),
|
|
* usnorm(isnp), vector(1, isnp),
|
|
* nssess, nsdess, ia(islvnd))
|
|
|
|
call movnd2(numnp, ndim, x, y, a(kvnorm),
|
|
* nmsess, nmdess, ia(imasnd),
|
|
* snptol(isnp), delmax(isnp), iscrn, vector(1,isnp),
|
|
* gap(isnp))
|
|
end if
|
|
|
|
call mddel('NNDMAS')
|
|
call mddel('NODMAS')
|
|
call mddel('NNDSLV')
|
|
call mddel('NODSLV')
|
|
|
|
call mddel('PLANE')
|
|
call mddel('VNORM')
|
|
call mddel('ISCR')
|
|
|
|
RETURN
|
|
END
|
|
|