#ifdef ibm_sp subroutine rsearch(km1,z1,km2,z2,l2) !$$$ subprogram documentation block ! . . . . ! subprogram: rsearch search for a surrounding real interval ! prgmmr: iredell org: np23 date: 1998-05-01 ! ! abstract: This subprogram searches a monotonic sequences of real numbers ! for intervals that surround a given search set of real numbers. ! The sequences may be monotonic in either direction; the real numbers ! may be single or double precision. ! ! IBM version of routine ! ! program history log: ! 1999-01-05 mark iredell ! 2004-06-16 russ treadon - update documentation ! ! input argument list: ! km1 integer number of points in the sequence ! z1 real (km1) sequence values to search ! (z1 must be monotonic in either direction) ! km2 integer number of points to search for ! z2 real (km2) set of values to search for ! (z2 need not be monotonic) ! ! output argument list: ! l2 integer (km2) interval locations from 0 to km1 ! (z2 will be between z1(l2) and z1(l2+1)) ! ! subprograms called: ! sbsrch essl binary search ! dbsrch essl binary search ! ! remarks: ! Returned values of 0 or km1 indicate that the given search value ! is outside the range of the sequence. ! ! Tf a search value is identical to one of the sequence values ! then the location returned points to the identical value. ! If the sequence is not strictly monotonic and a search value is ! identical to more than one of the sequence values, then the ! location returned may point to any of the identical values. ! ! If l2(k)=0, then z2(k) is less than the start point z1(1) ! for ascending sequences (or greater than for descending sequences). ! If l2(k)=km1, then z2(k) is greater than or equal to the end point ! z1(km1) for ascending sequences (or less than or equal to for ! descending sequences). otherwise z2(k) is between the values ! z1(l2(k)) and z1(l2(k+1)) and may equal the former. ! ! attributes: ! language: f90 ! machine: ibm RS/6000 SP ! !$$$ end documentation block use kinds, only: r_kind,r_double,i_kind,i_long use constants, only: one implicit none integer(i_kind),intent(in ) :: km1,km2 real(r_kind) ,intent(in ) :: z1(km1),z2(km2) integer(i_kind),intent( out) :: l2(km2) real(r_double) oned integer(i_long) incx,n,incy,m,indx(km2),rc(km2),iopt integer(i_kind) k2 oned=1._r_double ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ! Find the surrounding input interval for each output point. if(z1(1)<=z1(km1)) then ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ! Input coordinate is monotonically ascending. incx=1_i_long n=km2 incy=1_i_long m=km1 iopt=1_i_long ! Use the appropriate ESSL function based on numerical precision of compiled code if(digits(one)z1(1+(i-1)*ixz1+l*kxz1)) exit l=l+1 if(l==km1) exit enddo l2(1+(i-1)*ixl2+(k2-1)*kxl2)=l enddo endif enddo end subroutine rsearch #endif