subroutine aptvlim (au, av, aw, np, tolu, tolv, tolw, vlen, nerr) ccbeg. cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc c c SUBROUTINE APTVLIM c c call aptvlim (au, av, aw, np, tolu, tolv, tolw, vlen, nerr) c c Version: aptvlim Updated 1990 January 18 16:40. c aptvlim Originated 1989 December 19 13:40. c c Author: Arthur L. Edwards, LLNL, L-298, Telephone (925) 422-4123. c c c Purpose: To adjust the np vectors a = (au, av, aw), by imposing the lower c limits tolu, tolv, and tolw on the magnitudes of the components c au, av, and aw, 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, aw, np, tolu, tolv, tolw. c c Output: au, av, aw, vlen, nerr. c c Glossary: c c au,av,aw Input The u, v, w components of input vector "a". Size np. c c au,av,aw Output The u, v, w components of output vector "a". Size np. c Magnitudes will be at least tolu, tolv, tolw, 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, aw, 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 tolw Input Numerical tolerance limit for component aw. 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---- Component w of vector "a". dimension aw (1) c---- Magnitude of vector "a". dimension vlen (1) c.... Local variables. c---- Temporary magnitude of vector "a". common /laptvlim/ vlens c---- A very small number. common /laptvlim/ fuz c---- Index, 1 to np. common /laptvlim/ n cbugc***DEBUG begins. cbug 9901 format (/ 'aptvlim limiting vectors with' / cbug & ' tolu,v,w= ',1p3e22.14) cbug 9902 format (i3,' au,av,aw=',1p3e22.14) cbug write ( 3, 9901) tolu, tolv, tolw cbug write ( 3, 9902) (n, au(n), av(n), aw(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 + aw(n)**2) au(n) = sign (amax1 (tolu, abs (au(n))), au(n)) av(n) = sign (amax1 (tolv, abs (av(n))), av(n)) aw(n) = sign (amax1 (tolw, abs (aw(n))), aw(n)) vlens = sqrt (au(n)**2 + av(n)**2 + aw(n)**2) au(n) = au(n) * vlen(n) / (vlens + fuz) av(n) = av(n) * vlen(n) / (vlens + fuz) aw(n) = aw(n) * vlen(n) / (vlens + fuz) c---- End of loop over vectors. 110 continue cbugc***DEBUG begins. cbug 9903 format (/ 'aptvlim results:' / cbug & (i3,' au,av,aw=',1p3e22.14 / cbug & ' vlen= ',1pe22.14)) cbug write ( 3, 9903) (n, au(n), av(n), aw(n), vlen(n), n = 1, np) cbugc***DEBUG ends. 210 return c.... End of subroutine aptvlim. (+1 line.) end UCRL-WEB-209832