subroutine aptvlic (au, av, np, tolu, tolv, vlen, nerr) ccbeg. cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc c c SUBROUTINE APTVLIC c c call aptvlic (au, av, np, tolu, tolv, vlen, nerr) c c Version: aptvlic Updated 1990 January 18 14:20. c aptvlic Originated 1990 January 3 13:40. c c Author: Arthur L. Edwards, LLNL, L-298, Telephone (925) 422-4123. c c c Purpose: To adjust the np 2-D vectors a = (au, av), by imposing the lower c limits tolu and tolv on the magnitudes of the components c au and av, respectively, while retaining the initial c magnitude of the vector "a". If all are initially zero, the c output vector "a" will be zero, and vlen will be zero. c Flag nerr indicates any input error. c c Input: au, av, np, tolu, tolv. c c Output: au, av, vlen, nerr. c c Glossary: c c au, av Input The u and v components of input vector "a". Size np. c Directions u, v and w are orthogonal. c c au, av Output The u and v components of output vector "a". Size np. c Magnitudes will be at least tolu, tolv, c respectively, subject to the requirement that the c final magnitude of vector "a" be the same as the c initial magnitude. c c nerr Output Indicates an input error, it not 0. c 1 if np is not positive. c c np Input Size of arrays au, av, vlen. c c tolu Input Numerical tolerance limit for component au. c On Cray computers, recommend 1.e-5 to 1.e-11. c c tolv Input Numerical tolerance limit for component av. c On Cray computers, recommend 1.e-5 to 1.e-11. c c vlen Output Magnitude of vector "a". Size np. c cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc ccend. c.... Dimensioned arguments. c---- Component u of vector "a". dimension au (1) c---- Component v of vector "a". dimension av (1) c---- Magnitude of vector "a". dimension vlen (1) c.... Local variables. c---- Temporary magnitude of vector "a". common /laptvlic/ vlens c---- A very small number. common /laptvlic/ fuz c---- Index, 1 to np. common /laptvlic/ n cbugc***DEBUG begins. cbug 9901 format (/ 'aptvlic limiting vectors with' / cbug & ' tolu,v=',1p2e13.5) cbug 9902 format (i3,' au,av= ',1p2e22.14) cbug write ( 3, 9901) tolu, tolv cbug write ( 3, 9902) (n, au(n), av(n), n = 1, np) cbugc***DEBUG ends. c.... Initialize. c---- A very small number. fuz = 1.e-99 nerr = 0 c.... Test for input errors. if (np .le. 0) then nerr = 1 go to 210 endif c.... Impose the lower limits on the magnitudes of the vector components. c---- Loop over vectors. do 110 n = 1, np vlen(n) = sqrt (au(n)**2 + av(n)**2) au(n) = sign (amax1 (tolu, abs (au(n))), au(n)) av(n) = sign (amax1 (tolv, abs (av(n))), av(n)) vlens = sqrt (au(n)**2 + av(n)**2) au(n) = au(n) * vlen(n) / (vlens + fuz) av(n) = av(n) * vlen(n) / (vlens + fuz) c---- End of loop over vectors. 110 continue cbugc***DEBUG begins. cbug 9903 format (/ 'aptvlic results:' / cbug & (i3,' au,av,len=',1p3e22.14)) cbug write ( 3, 9903) (n, au(n), av(n), vlen(n), n = 1, np) cbugc***DEBUG ends. 210 return c.... End of subroutine aptvlic. (+1 line.) end UCRL-WEB-209832