Skip to main content
  • Home
  • Development
  • Documentation
  • Donate
  • Operational login
  • Browse the archive

swh logo
SoftwareHeritage
Software
Heritage
Archive
Features
  • Search

  • Downloads

  • Save code now

  • Add forge now

  • Help

Revision a137ab8c6d6d0a8110a234da6f4de49aa7b548d9 authored by Roger Koenker on 31 August 2015, 23:25:56 UTC, committed by Gabor Csardi on 31 August 2015, 23:25:56 UTC
version 5.19
1 parent a6e1bd2
  • Files
  • Changes
  • 7636eae
  • /
  • src
  • /
  • dsel05.f
Raw File Download

To reference or cite the objects present in the Software Heritage archive, permalinks based on SoftWare Hash IDentifiers (SWHIDs) must be used.
Select below a type of object currently browsed in order to display its associated SWHID and permalink.

  • revision
  • directory
  • content
revision badge
swh:1:rev:a137ab8c6d6d0a8110a234da6f4de49aa7b548d9
directory badge
swh:1:dir:a58012c164c314abf600da40546b4bba54a556df
content badge
swh:1:cnt:45847063e70f7d54faab62a7a146102e0b370b75

This interface enables to generate software citations, provided that the root directory of browsed objects contains a citation.cff or codemeta.json file.
Select below a type of object currently browsed in order to generate citations for them.

  • revision
  • directory
  • content
Generate software citation in BibTex format (requires biblatex-software package)
Generating citation ...
Generate software citation in BibTex format (requires biblatex-software package)
Generating citation ...
Generate software citation in BibTex format (requires biblatex-software package)
Generating citation ...
dsel05.f
      subroutine dsel05( k, n, x)
      integer            k, n
      double precision   x(n)
c
c     Selects the smallest k elements of the array x[1:n].
c     The input array is permuted so that the smallest k elements of
c     x are x(i), i = 1,...,k, (in arbitrary order) and x(k) is the
c     kth smallest element.
c
c     This is a Fortran 77 version of the Algol 68 procedure from
c
c        R.W. Floyd and R.L. Rivest: "Algorithm 489: The Algorithm
c        SELECT---for Finding the $i$th Smallest of $n$ Elements",
c        Comm. ACM 18, 3 (1975) 173,
c
c     including some modifications suggested in
c
c        T. Brown: "Remark on Algorithm 489", ACM Trans. Math.
c        Software 3, 2 (1976), 301-304.
c
c     Array stack(2,nstack) permits up to nstack levels of recursion.
c     For standard parameters cs <= 1 and cutoff >= 600,
c     nstack = 5 suffices for n up to 2**31-1 (maximum integer*4).
      integer            nstack
      parameter         (nstack=10)
      integer            stack(2,nstack)
c
c     Parameters cutoff, cs and csd are as originally proposed.
      integer            cutoff
      parameter         (cutoff=600)
      double precision   cs, csd
      parameter         (cs=0.5d0, csd=0.5d0)
c     Brown's version
c     parameter         (cs=0.5d0, csd=0.1d0)
c
c     Subprograms called:
      intrinsic          dble, exp, log, max, min, sign
c
c     Written by K.C. Kiwiel, 8 March 2006, kiwiel@ibspan.waw.pl
c
c     Local variables:
      integer            i, j, jstack, l, m, r, s, sd
      double precision   dm, swap, v, z
      l=1
      r=n
      jstack=0
c     entry to SELECT( x, n, l, r, k)
c     SELECT will rearrange the values of the array segment x[l:r] so
c     that x(k) (for some given k; l <= k <= r) will contain the
c     (k-l+1)-th smallest value, l <= i <= k will imply x(i) <= x(k),
c     and k <= i <= r will imply x(k) <= x(i).
c     while r > l do
    1 continue
      if (l.ge.r) goto 6
c        The additional test below prevents stack overflow.
         if (r-l.gt.cutoff .and. jstack.lt.nstack) then
c           Use SELECT recursively on a sample of size s to get an
c           estimate for the (k-l+1)-th smallest element into x(k),
c           biased slightly so that the (k-l+1)-th element is
c           expected to lie in the smaller set after partitioning.
            m=r-l+1
            i=k-l+1
            dm=m
            z=log(dm)
            s=cs*exp(2*z/3)+0.5d0
            sd=csd*sqrt(z*s*(1-s/dm))*sign(1d0,i-dm/2)+0.5d0
            if (i.eq.m/2) sd=0
c           Brown's modification
c           sd=csd*sqrt(z*s*(1-s/dm))*(2*i/dm-1)+0.5d0
c           Push the current l and r on the stack.
            jstack=jstack+1
            stack(1,jstack)=l
            stack(2,jstack)=r
c           Find new l and r for the next recursion.
            l=max(dble(l),k-i*(s/dm)+sd)+0.5d0
            r=min(dble(r),k-i*(s/dm)+sd+s)+0.5d0
c           call SELECT( x, n, l, r, k)
            goto 1
         endif
    2    continue
c        Partition x[l:r] about the pivot v := x(k).
         v=x(k)
c        Initialize pointers for partitioning.
         i=l
         j=r
c        Swap x(l) and x(k).
         x(k)=x(l)
         x(l)=v
         if (v.lt.x(r)) then
c           Swap x(l) and x(r).
            x(l)=x(r)
            x(r)=v
         endif
c        while i < j do
    3    continue
         if (i.lt.j) then
c           Swap x(i) and x(j).
            swap=x(j)
            x(j)=x(i)
            x(i)=swap
            i=i+1
            j=j-1
c           Scan up to find element >= v.
    4       continue
            if (x(i).lt.v) then
               i=i+1
               goto 4
            endif
c           Scan down to find element <= v.
    5       continue
            if (x(j).gt.v) then
               j=j-1
               goto 5
            endif
            goto 3
c           end of while i < j do
         endif
         if (x(l).eq.v) then
c           Swap x(l) and x(j).
            swap=x(j)
            x(j)=v
            x(l)=swap
         else
            j=j+1
c           Swap x(j) and x(r).
            swap=x(j)
            x(j)=x(r)
            x(r)=swap
         endif
c        Now adjust l, r so that they surround the subset containing
c        the (k-l+1)-th smallest element.
         if (j.le.k) l=j+1
         if (k.le.j) r=j-1
         goto 1
c        end of while r > l do
    6 continue
c     Exit if the stack is empty.
      if (jstack.eq.0) return
c     Pop l and r from the stack.
      l=stack(1,jstack)
      r=stack(2,jstack)
      jstack=jstack-1
c     Continue as if after a return from a recursive call.
      goto 2
      end
The diff you're trying to view is too large. Only the first 1000 changed files have been loaded.
Showing with 0 additions and 0 deletions (0 / 0 diffs computed)
swh spinner

Computing file changes ...

back to top

Software Heritage — Copyright (C) 2015–2026, The Software Heritage developers. License: GNU AGPLv3+.
The source code of Software Heritage itself is available on our development forge.
The source code files archived by Software Heritage are available under their own copyright and licenses.
Terms of use: Archive access, API— Content policy— Contact— JavaScript license information— Web API