subroutine aptqdic (au, av, bu, bv, cu, cv, du, dv, & pu, pv, np, tol, & pab, pbc, pcd, pda, dpmin, nerr) ccbeg. cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc c c SUBROUTINE APTQDIC c c call aptqdic (au, av, bu, bv, cu, cv, du, dv, c & pu, pv, np, tol, c & pab, pbc, pcd, pda, dpmin, nerr) c c Version: aptqdic Updated 1990 April 2 13:20. c aptqdic Originated 1990 February 21 11:00. c c Author: Arthur L. Edwards, LLNL, L-298, Telephone (925) 422-4123. c c c Purpose: To find, for each of the np sets of input data, the distances c pab, pbc, pcd and pda from the point p = (pu, pv) to the sides c of the quadrangle with vertices a = (au, av), b = (bu, bv), c c = (cu, cv), and d = (du, dv), in counterclockwise order in c the uv plane, and the minimum dpmin of pab, pbc, pcd and pda. c The values of pab, pbc, pcd and pda will be truncated to zero, c if less than the estimated error in their calculation, based on c tol. Flag nerr indicates any input error. c c Input: au, av, bu, bv, cu, cv, du, dv, pu, pv, np, tol. c c Output: pab, pbc, pcd, pda, dpmin, nerr. c c Calls: aptptlc c c Glossary: c c au, av Input The u, v coordinates of vertex "a" of the quadrangle. c Size np. c c bu, bv Input The u, v coordinates of vertex "b" of the quadrangle. c Size np. c c cu, cv Input The u, v coordinates of vertex "c" of the quadrangle. c Size np. c c dpmin Output Minimum of absolute values of distances c pab, pbc, pcd and pda. Size np. c c du, dv Input The u, v coordinates of vertex "d" of the quadrangle. c Size np. c c nerr Output Indicates an input error, if not 0. c 1 if np is not positive. c c np Input Size of arrays pu, pv, au, av, bu, bv, cu, cv, du, dv, c pab, pbc, pcd, pda. c c pab Output Distance from point "p" to quadrangle edge "ab". c Truncated to zero, if less than the estimated error c in its calculation, based on tol. Absolute value. c Size np. c c pbc Output Distance from point "p" to quadrangle edge "bc". c Truncated to zero, if less than the estimated error c in its calculation, based on tol. Absolute value. c Size np. c c pcd Output Distance from point "p" to quadrangle edge "cd". c Truncated to zero, if less than the estimated error c in its calculation, based on tol. Absolute value. c Size np. c c pda Output Distance from point "p" to quadrangle edge "da". c Truncated to zero, if less than the estimated error c in its calculation, based on tol. Absolute value. c Size np. c c pu, pv Input The u and v coordinates of point "p" in the uv plane. c Size np. 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---- Coordinate u of quadrangle vertex "a". dimension au (1) c---- Coordinate v of quadrangle vertex "a". dimension av (1) c---- Coordinate u of quadrangle vertex "b". dimension bu (1) c---- Coordinate v of quadrangle vertex "b". dimension bv (1) c---- Coordinate u of quadrangle vertex "c". dimension cu (1) c---- Coordinate v of quadrangle vertex "c". dimension cv (1) c---- Minimum of pab, pbc, pcd, pda. dimension dpmin (1) c---- Coordinate u of quadrangle vertex "d". dimension du (1) c---- Coordinate v of quadrangle vertex "d". dimension dv (1) c---- Distance from point "p" to edge "ab". dimension pab (1) c---- Distance from point "p" to edge "bc". dimension pbc (1) c---- Distance from point "p" to edge "cd". dimension pcd (1) c---- Distance from point "p" to edge "da". dimension pda (1) c---- Coordinate u of point "p". dimension pu (1) c---- Coordinate v of point "p". dimension pv (1) c.... Local variables. c---- Dummy argument. common /laptqdic/ fdmin c---- Truncation error indicator. common /laptqdic/ itrunab (64) c---- Truncation error indicator. common /laptqdic/ itrunbc (64) c---- Truncation error indicator. common /laptqdic/ itruncd (64) c---- Truncation error indicator. common /laptqdic/ itrunda (64) c---- Index in arrays. common /laptqdic/ n c---- First index of subset of data. common /laptqdic/ n1 c---- Last index of subset of data. common /laptqdic/ n2 c---- Dummy argument. common /laptqdic/ nlim c---- Index in external array. common /laptqdic/ nn c---- Size of current subset of data. common /laptqdic/ ns cbugc***DEBUG begins. cbug 9901 format (/ 'aptqdic finding distances from point in quadrangle.') cbug 9902 format (i3,' pu,pv= ',1p2e22.14,' (point)' / cbug & ' au,av= ',1p2e22.14,' (vertices)' / cbug & ' bu,bv= ',1p2e22.14 / cbug & ' cu,cv= ',1p2e22.14 / cbug & ' du,dv= ',1p2e22.14) cbug write ( 3, 9901) cbug do 105 n = 1, np cbug write ( 3, 9902) n, pu(n), pv(n), au(n), av(n), cbug & bu(n), bv(n), cu(n), cv(n), du(n), dv(n) cbug 105 continue 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 distances from point "p" to the sides of the quadrangle "abcd". call aptptlc (pu(n1), pv(n1), au(n1), av(n1), bu(n1), bv(n1), & ns, tol, -1, pab(n1), fdmin, nlim, itrunab, nerr) call aptptlc (pu(n1), pv(n1), bu(n1), bv(n1), cu(n1), cv(n1), & ns, tol, -1, pbc(n1), fdmin, nlim, itrunbc, nerr) call aptptlc (pu(n1), pv(n1), cu(n1), cv(n1), du(n1), dv(n1), & ns, tol, -1, pcd(n1), fdmin, nlim, itruncd, nerr) call aptptlc (pu(n1), pv(n1), du(n1), dv(n1), au(n1), av(n1), & ns, tol, -1, pda(n1), fdmin, nlim, itrunda, nerr) c.... Find the minimum distance from point "p" to an edge of quadrangle "abcd". c---- Loop over subset of data. do 120 nn = n1, n2 dpmin(nn) = amin1 (abs (pab(nn)), abs (pbc(nn)), & abs (pcd(nn)), abs (pda(nn))) c---- End of loop over subset of data. 120 continue 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 9904 format (/ 'aptqdic results:' / cbug & (i3,' pab,pbc=',1p2e22.14 / cbug & ' pcd,pda=',1p2e22.14 / cbug & ' dpmin= ',1pe22.14)) cbug write ( 3, 9904) (n, pab(n), pbc(n), pcd(n), pda(n), cbug & dpmin(n), n = 1, np) cbugc***DEBUG ends. 210 return c.... End of subroutine aptqdic. (+1 line.) end UCRL-WEB-209832