subroutine aptinvc (au, av, pu, pv, np, tol, nerr) ccbeg. cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc c c SUBROUTINE APTINVC c c call aptinvc (au, av, pu, pv, np, tol, nerr) c c Version: aptinvc Updated 1990 November 28 10:00. c aptinvc Originated 1990 January 4 13:20. c c Author: Arthur L. Edwards, LLNL, L-298, Telephone (925) 422-4123. c c c Purpose: To invert the np points or vectors p = (pu, pv) through the c point a = (au, av), all in the uv plane. If "p" are c unbound vectors, point a = (au, av) should be at the origin. c The new components of "p" will be truncated to zero if less c than the estimated error in their calculation, based on tol. c Flag nerr indicates any input error. c c Input: itype, au, av, pu, pv, np, tol. c c Output: pu, pv, nerr. c c Glossary: c c au, av Input The u and v components of the inversion point "a". c c nerr Output Indicates an input error, if not 0. c 1 if np is not positive. c c np Input Number of 2-D points or vectors (pu, pv). c c pu, pv In/Out The u and v coordinates of a 2-D point, or c the u and v components of a 2-D vector. Size np. c Truncated to zero if less than the estimated error c in their calculation. See tol. 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 or component pu. Size np. dimension pu (1) c---- Coordinate or component pv. Size np. dimension pv (1) c.... Local variables. c---- Index of point or vector. common /laptinvc/ n c---- Estimated error in pu. common /laptinvc/ puerr c---- Estimated error in pv. common /laptinvc/ pverr cbugc***DEBUG begins. cbug 9901 format (/ 'aptinvc. Inverting through point' / cbug & ' au,av=',1p2e22.14) cbug 9902 format (i3,' pu,pv=',1p2e22.14) cbug write ( 3, 9901) au, av cbug write ( 3, 9902) (n, pu(n), pv(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.... Invert the np points p = (pu, pv) through point a = (au, av). c---- No truncation of (pu, pv). if (tol .le. 0.0) then c---- Loop over points or vectors. do 110 n = 1, np pu(n) = 2.0 * au - pu(n) pv(n) = 2.0 * av - pv(n) c---- End of loop over points or vectors. 110 continue c---- Truncate small components to zero. else c---- Loop over points or vectors. do 120 n = 1, np puerr = tol * (2.0 * abs (au) + abs (pu(n))) pverr = tol * (2.0 * abs (av) + abs (pv(n))) pu(n) = 2.0 * au - pu(n) pv(n) = 2.0 * av - pv(n) if (abs (pu(n)) .lt. puerr) then pu(n) = 0.0 endif if (abs (pv(n)) .lt. pverr) then pv(n) = 0.0 endif c---- End of loop over points or vectors. 120 continue c---- Tested tol. endif cbugc***DEBUG begins. cbug 9903 format (/ 'aptinvc inverted points:') cbug write ( 3, 9903) cbug write ( 3, 9902) (n, pu(n), pv(n), n = 1, np) cbugc***DEBUG ends. 210 return c.... End of subroutine aptinvc. (+1 line.) end UCRL-WEB-209832