subroutine apttric (au, av, bu, bv, cu, cv, np, tol,
& dab, dbc, dca, areat, gu, gv, nerr)
ccbeg.
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c
c SUBROUTINE APTTRIC
c
c call apttric (au, av, bu, bv, cu, cv, np, tol,
c & dab, dbc, dca, areat, gu, gv, nerr)
c
c Version: apttric Updated 1990 December 3 16:20.
c apttric Originated 1990 May 8 13:00.
c
c Author: Arthur L. Edwards, LLNL, L-298, Telephone (925) 422-4123.
c
c
c Purpose: To find the edge lengths dab, dbc and dca, the areas areat, and
c the centers of gravity g = (gu, gv) of np triangles with
c vertices a = (au, av), b = (bu, bv), and c = (cu, cv) in
c a major plane. Flag nerr indicates any input error.
c
c Input: au, av, bu, bv, cu, cv, np, tol.
c
c Output: dab, dbc, dca, areat, gu, gv, nerr.
c
c Calls: aptvdic, aptvaxc
c
c
c Glossary:
c
c areat Output Area of the triangle. Size np.
c
c au, av Input The u and v coordinates of vertex "a" of triangle.
c Size np.
c
c bu, bv Input The u and v coordinates of vertex "b" of triangle.
c Size np.
c
c cu, cv Input The u and v coordinates of vertex "c" of triangle.
c Size np.
c
c dab Output The length of edge "ab" of the triangle. Size np.
c
c dbc Output The length of edge "bc" of the triangle. Size np.
c
c dca Output The length of edge "ca" of the triangle. Size np.
c
c gu, gv Output Center of gravity or centroid of triangle. Size np.
c Coordinates may be truncated to zero, if less than
c the estimated error in their calculation, based on
c tol.
c
c nerr Output Indicates an input error, if not 0.
c 1 if np is not positive.
c
c np Input Size of external arrays.
c
c tol Input Numerical tolerance limit.
c On Cray computers, recommend 1.e-5 to 1.e-11.
c
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
ccend.
c.... Dimensioned arguments.
c---- Area of triangle "abc".
dimension areat (1)
c---- Coordinate u of vertex "a".
dimension au (1)
c---- Coordinate v of vertex "a".
dimension av (1)
c---- Coordinate u of vertex "b".
dimension bu (1)
c---- Coordinate v of vertex "b".
dimension bv (1)
c---- Coordinate u of vertex "c".
dimension cu (1)
c---- Coordinate v of vertex "c".
dimension cv (1)
c---- Length of edge "ab".
dimension dab (1)
c---- Length of edge "bc".
dimension dbc (1)
c---- Length of edge "ca".
dimension dca (1)
c---- Cooodinate u of centroid of triangle.
dimension gu (1)
c---- Coordinate v of centroid of triangle.
dimension gv (1)
c.... Local variables.
c---- Component u of edge vector "ab".
common /lapttric/ abu (64)
c---- Component v of edge vector "ab".
common /lapttric/ abv (64)
c---- Component u of edge vector "bc".
common /lapttric/ bcu (64)
c---- Component v of edge vector "bc".
common /lapttric/ bcv (64)
c---- Component u of edge vector "ca".
common /lapttric/ cau (64)
c---- Component v of edge vector "ca".
common /lapttric/ cav (64)
c---- Estimated error in gu.
common /lapttric/ guerr
c---- Estimated error in gv.
common /lapttric/ gverr
c---- Index in local array.
common /lapttric/ n
c---- First index of subset of data.
common /lapttric/ n1
c---- Last index of subset of data.
common /lapttric/ n2
c---- Index in external array.
common /lapttric/ nn
c---- Size of current subset of data.
common /lapttric/ ns
cbugc***DEBUG begins.
cbug 9901 format (/ 'apttric finding triangle data:' /
cbug & (i3,' au,av=',1p2e22.14 /
cbug & ' bu,bv=',1p2e22.14 /
cbug & ' cu,cv=',1p2e22.14))
cbug write (3, 9901) (n, au(n), av(n), bu(n), bv(n),
cbug & cu(n), cv(n), n = 1, np)
cbugc***DEBUG ends.
c.... initialize.
nerr = 0
c.... Test for input errors.
if (np .le. 0) then
nerr = 1
go to 210
endif
c.... Set up the indices of the first subset of data.
n1 = 1
n2 = min (np, 64)
110 ns = n2 - n1 + 1
c.... Find the edge vectors of the triangle, "ab", "bc" and "ca",
c.... and the edge lengths, dab, dbc and dca.
call aptvdic (au(n1), av(n1), bu(n1), bv(n1), ns, tol,
& abu, abv, dab, nerr)
call aptvdic (bu(n1), bv(n1), cu(n1), cv(n1), ns, tol,
& bcu, bcv, dbc, nerr)
call aptvdic (cu(n1), cv(n1), au(n1), av(n1), ns, tol,
& cau, cav, dca, nerr)
c.... Find twice the area of the triangle.
call aptvaxc (abu, abv, bcu, bcv, ns, tol, areat(n1), nerr)
c.... Find the area and the coordinates of the center of gravity.
c---- Loop over subset of data.
do 120 n = 1, ns
nn = n + n1 - 1
areat(nn) = 0.5 * abs (areat(nn))
gu(nn) = (au(nn) + bu(nn) + cu(nn)) / 3.0
gv(nn) = (av(nn) + bv(nn) + cv(nn)) / 3.0
c---- End of loop over subset of data.
120 continue
c.... See if truncation allowed.
c---- Truncation to zero allowed.
if (tol .gt. 0.0) then
c---- Loop over subset of data.
do 130 n = 1, ns
nn = n + n1 - 1
guerr = tol * (abs (au(nn)) + abs (bu(nn)) +
& abs (cu(nn))) / 3.0
gverr = tol * (abs (av(nn)) + abs (bv(nn)) +
& abs (cv(nn))) / 3.0
if (abs (gu(nn)) .lt. guerr) then
gu(nn) = 0.0
endif
if (abs (gv(nn)) .lt. gverr) then
gv(nn) = 0.0
endif
c---- End of loop over subset of data.
130 continue
c---- Tested tol.
endif
c.... See if all data subsets are done.
c---- Do another subset of data.
if (n2 .lt. np) then
n1 = n2 + 1
n2 = min (np, n1 + 63)
go to 110
endif
cbugc***DEBUG begins.
cbug 9902 format (/ 'apttric results:' /
cbug & (i3,' areat= ',1pe22.14 /
cbug & ' d(ab,bc,ca)=',1p3e22.14 /
cbug & ' gu,gv= ',1p2e22.14))
cbug
cbug write ( 3, 9902) (n, areat(n), dab(n), dbc(n), dca(n),
cbug & gu(n), gv(n), n = 1, np)
cbugc***DEBUG ends.
210 return
c.... End of subroutine apttric. (+1 line.)
end
UCRL-WEB-209832