subroutine aptmnlg (x, ibeg, iend, int, ndec, imin, imax,
& xmin, xmax, nerr)
ccbeg.
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c
c SUBROUTINE APTMNLG
c
c call aptmnlg (x, ibeg, iend, int, ndec, imin, imax, xmin, xmax,
c & nerr)
c
c Version: aptmnlg Updated 1993 May 18 13:10.
c aptmnlg Originated 1993 May 18 13:10.
c
c Author: Arthur L. Edwards, LLNL, L-298, Telephone (925) 422-4123.
c
c
c Purpose: To find the log-scale minimum and maximum values xmin and xmax
c in array x, starting at x(ibeg) and testing every int'th value
c of x up to x(iend), and the indices imin and imax at which they
c occur. The maximum xmax is restricted to positive values.
c The minimum xmin is restricted to positive values no less than
c 0.1**ndec * xmax.
c Note that ibeg, iend, imin and imax are based on the input
c argument x being at x(1). For example, if the dimension of
c x is (-10:40), call aptmnlg with x(1), ibeg = -10, iend = 40,
c int = 1, to search the entire array, and to get the correct
c absolute indices for imin and imax.
c Flag nerr indicates any input errors.
c
c Input: x, ibeg, iend, int, ndec.
c
c Output: imin, imax, xmin, xmax, nerr.
c
c Glossary:
c
c nerr Output Indicates an input error, if not 0.
c 1 if int is zero, or does not have the same sign
c as iend - ibeg.
c 2 if ndec is not positive.
c
c ibeg Input The index of the first value of x to be tested.
c
c iend Input The index of the last value of x to be tested.
c Must be within the range of indices of x.
c
c imax Output The index in x at which xmax occurs.
c xmax = x(imax)
c
c imin Output The index in x at which xmin occurs.
c xmin = x(imin)
c
c int Input The interval between the indices of x to be tested.
c I.e., the indices ibeg, ibeg + int, ibeg + 2*int,
c etc, up to ibeg + n*int =< iend will be tested.
c
c ndec Input The number of decimal decades allowed between xmax and
c xmin.
c
c x Input Word x(1), in the array to be tested, from x(ibeg) to
c x(iend), at intervals int, to find minimum xmin,
c greater than 0.1**ndec, and maximum xmax, and the
c indices imin and imax of xmin and xmax.
c
c xmax Output Maximum positive value of x found. Returned as 1.e-99,
c if all tested x values are negative, or less than
c 1.e-99.
c
c xmin Output Minimum positive value of x found, that is no less than
c 0.1**ndec * xmax.
c
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
ccend.
c.... Dimensioned arguments.
c---- Array to be tested to find minimum and maximum.
dimension x (1)
c.... Local variables.
c---- A small number
common /laptmnlg/ small
c---- Limiting xmin, 0.1**ndec * xmax.
common /laptmnlg/ xminlim
c---- Index in array x.
common /laptmnlg/ n
c---- Index in array x.
common /laptmnlg/ nn
c---- Temporary value of x.
common /laptmnlg/ xtemp
cbugc***DEBUG begins.
cbug 9901 format (/ 'aptmnlg finding log-scale minimum and maximum.' /
cbug & 'ibeg=',i8,' iend=',i8,' int=',i8,' ndec=',i4)
cbug write ( 3, 9901) ibeg, iend, int, ndec
cbugc***DEBUG ends.
c.... initialize.
small = 1.e-99
xmin = small
xmax = small
nerr = 0
c.... Test for input errors.
if (iend .ge. ibeg) then
if (int .le. 0) then
nerr = 1
go to 210
endif
else
if (int .ge. 0) then
nerr = 1
go to 210
endif
endif
cbugc***DEBUG begins.
cbug 9902 format (i8,' x=',1pe22.14)
cbug write ( 3, 9902) (n, x(n), n = ibeg, iend, int)
cbugc***DEBUG ends.
if (ndec .le. 0) then
nerr = 2
go to 210
endif
c.... Find the minimum value of x.
c---- Loop over array x.
do 110 n = ibeg, iend, int
if (x(n) .gt. xmax) then
imax = n
xmax = x(n)
endif
c---- End of loop over array x.
110 continue
if (xmax .eq. small) go to 210
xminlim = 0.1**ndec * xmax
xmin = xmax
c---- Loop over array x.
do 120 n = ibeg, iend, int
if (x(n) .lt. xminlim) go to 120
if (x(n) .lt. xmin) then
imin = n
xmin = x(n)
endif
c---- End of loop over array x.
120 continue
210 continue
cbugc***DEBUG begins.
cbug 9903 format (/ 'aptmnlg results: nerr=',i3 /
cbug & 'imin=',i8,' xmin=',1pe22.14 /
cbug & 'imax=',i8,' xmax=',1pe22.14)
cbug write ( 3, 9903) nerr, imin, xmin, imax, xmax
cbugc***DEBUG ends.
return
c.... End of subroutine aptmnlg. (+1 line.)
end
UCRL-WEB-209832