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.
58 lines
1.5 KiB
58 lines
1.5 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
|
||
|
|
subroutine centroid(x, y , z, xcent, ycent, zcent,
|
||
|
|
* nelblk, numelb, numlnk, link, ndim)
|
||
|
|
real x(*), y(*), z(*)
|
||
|
|
real xcent(*), ycent(*), zcent(*)
|
||
|
|
integer numelb(*), numlnk(*), link(*)
|
||
|
|
|
||
|
|
IELNK = 0
|
||
|
|
IE = 0
|
||
|
|
DO 100 IELB = 1, nelblk
|
||
|
|
IS = IE + 1
|
||
|
|
IE = IE + NUMELB(IELB)
|
||
|
|
ISLNK = IELNK + 1
|
||
|
|
IELNK = IELNK + NUMLNK(IELB) * NUMELB(IELB)
|
||
|
|
|
||
|
|
CALL cent1(x, y, z, xcent(is), ycent(is), zcent(is),
|
||
|
|
* NUMELB(IELB), NUMLNK(IELB), LINK(ISLNK), NDIM)
|
||
|
|
100 CONTINUE
|
||
|
|
|
||
|
|
RETURN
|
||
|
|
END
|
||
|
|
|
||
|
|
subroutine cent1(x, y, z, xcent, ycent, zcent,
|
||
|
|
* numelb, numlnk, link, ndim)
|
||
|
|
|
||
|
|
real x(*), y(*), z(*)
|
||
|
|
real xcent(*), ycent(*), zcent(*)
|
||
|
|
integer numelb, numlnk
|
||
|
|
integer link(numlnk,*)
|
||
|
|
integer ndim
|
||
|
|
|
||
|
|
do 20 ne=1, numelb
|
||
|
|
xc = 0.0
|
||
|
|
yc = 0.0
|
||
|
|
zc = 0.0
|
||
|
|
do 10 j=1, numlnk
|
||
|
|
xc = xc + x(link(j,ne))
|
||
|
|
yc = yc + y(link(j,ne))
|
||
|
|
if (ndim .eq. 3) then
|
||
|
|
zc = zc + z(link(j,ne))
|
||
|
|
end if
|
||
|
|
10 continue
|
||
|
|
|
||
|
|
rnodes = numlnk
|
||
|
|
xcent(ne) = xc / rnodes
|
||
|
|
ycent(ne) = yc / rnodes
|
||
|
|
if (ndim .eq. 3) then
|
||
|
|
zcent(ne) = zc / rnodes
|
||
|
|
end if
|
||
|
|
|
||
|
|
20 continue
|
||
|
|
return
|
||
|
|
end
|