kcsr1idx.f File Reference

Go to the source code of this file.

Functions/Subroutines
subroutine	kcsr1idx (a, nrec, idx, ad)

Function/Subroutine Documentation

kcsr1idx()

subroutine kcsr1idx	(	real*8, dimension(nrec)	a,
		integer	nrec,
		integer, dimension(nrec)	idx,
		character*(*)	ad
	)

Definition at line 42 of file kcsr1idx.f.

References false, and true.

      implicit none

      integer nrec
      real*8  a(nrec)    ! input. unchagned
      integer idx(nrec)  ! outut. a(k) is to be moved idx(k)-th  position.
                         ! ,that is, a(idx(k)) is the k-th largest or
                         !  smallest among  a.
      character*(*) ad

      integer j, k, gap, imax, i
      real*8  x, sf/1.30/
      logical exch, more

      gap=nrec
      more=.true.
      do i = 1, nrec
         idx(i) = i
      enddo

      do while( more )
         gap=float(gap)/sf
         if(gap .le. 0) then
              gap=1
         elseif(gap .eq. 9 .or. gap .eq. 10) then
              gap=11
         endif
         imax=nrec - gap
         exch = .false.
         do j=1, imax
              k=j+gap
              if(ad .eq. 'a') then
                   if(a(idx(j))  .gt. a(idx(k))) then
                                x =idx(j)
                                idx(j) = idx(k)
                                idx(k) = x
                                exch = .true.
                   endif
              else
                   if(a(idx(j)) .lt. a(idx(k))) then
                            x = idx(j)
                            idx(j) = idx(k)
                            idx(k) = x
                            exch = .true.
                   endif
              endif     
         enddo
         more=exch .or. gap .ne. 1
      enddo