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
  • /
  • srtpai.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:081f18383fe952b1deb118bcad6c1a9f7e0fc203

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 ...
srtpai.f
      SUBROUTINE SRTPAI ( A, SA, P, SP, N )
C
C     SRTPAI SETS P(1) = 1, P(SP+1) = 2, ..., P((N-1)*SP+1) = N
C     AND THEN REARRANGES P(1), P(SP+1), ..., P((N-1)*SP+1) SO THAT
C     A( (P(I)-1)*SA+1 ) .LE. A( (P(J)-1)*SA+1 ) IF AND ONLY IF
C     I .LT. J, WHERE I AND J SUBSCRIPT PROPER ELEMENTS OF P
C
      INTEGER SP, P(SP, *), SA, H, PIH, PI
      INTEGER A(SA, *)
C
C     CHECK INPUT PARAMETERS AND INITIALIZE H
C
      CALL I1SRT( SA, SP, N )
      IF ( I0SRT( 1, N, H ) .LT. 1 ) RETURN
C
C     INITIALIZE P
C
      DO 10 I = 1, N
 10     P(1, I) = I
C
C       CHECK IF DONE WITH SORT
C
 20     IF ( H .LT. 1 ) RETURN
        K = N - H
C
C       COMPARE
C
        DO 40 J = 1, K
          I = J
 30         IH = I + H
            PI = P(1, I)
            PIH = P(1, IH)
            IF ( A(1, PI) .LE. A(1, PIH) ) GOTO 40
C
C           EXCHANGE
C
            P(1, I) = PIH
            P(1, IH) = PI
C
C           PERCOLATE EXCHANGED LIST ELEMENT UP TO PROPER PLACE
C
            I = I - H
            IF ( I .GE. 1 ) GOTO 30
 40       CONTINUE
C
        H = ( H - 1 ) / 3
        GOTO 20
C
      END    
      SUBROUTINE I1SRT ( SA, SP, N )
C
C     I1SRT CHECKS LEGALITY OF VALUES OF SA, SP, N
C
      INTEGER SA, SP
C
C/6S
C     IF ( N .LT. 0 )
C    1   CALL SETERR( 27HSRTXXX - ILLEGAL VALUE OF N, 27, 1, 2 )
C     IF ( SA .LE. 0 )
C    1   CALL SETERR( 28HSRTXXX - ILLEGAL VALUE OF SA, 28, 2, 2 )
C     IF ( SP .LE. 0 )
C    1   CALL SETERR( 28HSRTXXX - ILLEGAL VALUE OF SP, 28, 3, 2 )
C/7S
C     IF ( N .LT. 0 )
C    1   CALL SETERR( 'SRTXXX - ILLEGAL VALUE OF N', 27, 1, 2 )
C     IF ( SA .LE. 0 )
C    1   CALL SETERR( 'SRTXXX - ILLEGAL VALUE OF SA', 28, 2, 2 )
C     IF ( SP .LE. 0 )
C    1   CALL SETERR( 'SRTXXX - ILLEGAL VALUE OF SP', 28, 3, 2 )
C/
C
      RETURN
C
      END


      INTEGER FUNCTION I0SRT ( SA, N, H )
C
C     I0SRT CHECKS INPUT PARAMETERS N, SA AND CALCULATES H
C     RETURNS H = 0 IF NO SORTING NECESSARY, ELSE
C     RETURNS SPACING, H, FOR FIRST INSERTION SORT.
C     I0SRT RETURNS TOTAL NUMBER OF ELEMENTS IN ARRAY = N * SA
C
      INTEGER SA, H
C
C/6S
C     IF ( N .LT. 0 )
C    1   CALL SETERR( 27HSRTXXX - ILLEGAL VALUE OF N, 27, 1, 2 )
C     IF ( SA .LE. 0 )
C    1   CALL SETERR( 28HSRTXXX - ILLEGAL VALUE OF SA, 28, 2, 2 )
C/7S  
C     IF ( N .LT. 0 )
C    1   CALL SETERR( 'SRTXXX - ILLEGAL VALUE OF N', 27, 1, 2 )
C     IF ( SA .LE. 0 )
C    1   CALL SETERR( 'SRTXXX - ILLEGAL VALUE OF SA', 28, 2, 2 )
C/
C
C     CHECK IF SORTING IS NECESSARY
C
      H = 0
      I0SRT = N * SA
      IF ( N .LE. 1 ) RETURN
C
C     CALCULATE H USING H NEW = 3 * H OLD + SA
C
      H = 4 * SA
C
 10     H = 3 * H + SA
        IF ( H .LT. I0SRT ) GOTO 10
C
      H = ( H - 4 * SA ) / 9
C
      RETURN
C
      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