SAMPP Subroutine

public subroutine SAMPP(X, N, P, Iwrite, Pp)

NAME

sampp(3f) - [M_datapac:PERCENT_POINT] compute the sample 100P percent
point (i.e., percentile)

SYNOPSIS

   SUBROUTINE SAMPP(X,N,P,Iwrite,Pp)

DESCRIPTION

SAMPP(3f) computes the sample 100p percent point (where p is between
0.0 and 1.0, exclusively) of the data in the input vector X.

the sample 100p percent point = is that point in which 100p percent
of the data in the sample is below.

OPTIONS

 X   description of parameter
 Y   description of parameter

EXAMPLES

Sample program:

program demo_sampp
use M_datapac, only : sampp
implicit none
! call sampp(x,y)
end program demo_sampp

Results:

AUTHOR

The original DATAPAC library was written by James Filliben of the
Statistical Engineering Division, National Institute of Standards
and Technology.

MAINTAINER

John Urban, 2022.05.31

LICENSE

CC0-1.0

REFERENCES

  • Kendall and Stuart, The Advanced Theory of Statistics, Volume 1, Edition 2, 1963, pages 236-239, 243.
  • Mood and Grable, ‘Introduction to the Theory of Statistics, Edition 2, 1963, pages 406-407.
  • Snedecor and Cochran, Statistical Methods, Edition 6, 1967, page 125.

Arguments

Type IntentOptional Attributes Name
real(kind=wp), dimension(:) :: X
integer :: N
real(kind=wp) :: P
integer :: Iwrite
real(kind=wp) :: Pp

Common Blocks

CAUPLT (subroutine)
CHSCDF (subroutine)
CODE (subroutine)
DECOMP (subroutine)
DEMOD (subroutine)
DEXPLT (subroutine)
EV1PLT (subroutine)
EV2PLT (subroutine)
EXPPLT (subroutine)
EXTREM (subroutine)
EXTREM (subroutine)
FREQ (subroutine)
GAMPLT (subroutine)
GEOPLT (subroutine)
HFNPLT (subroutine)
INVXWX (subroutine)
LAMPLT (subroutine)
LGNPLT (subroutine)
LOGPLT (subroutine)
MEDIAN (subroutine)
norout (subroutine)
NORPLT (subroutine)
PARPLT (subroutine)
PLOTU (subroutine)
POIPLT (subroutine)
RUNS (subroutine)
SPCORR (subroutine)
TAIL (subroutine)
TPLT (subroutine)
TRIM (subroutine)
UNIPLT (subroutine)
WEIB (subroutine)
WEIPLT (subroutine)
WIND (subroutine)
"> common /BLOCK2_real32/

Type Attributes Name Initial
real :: WS(15000)

Source Code

SUBROUTINE SAMPP(X,N,P,Iwrite,Pp)
REAL(kind=wp) :: aj , ajint , an , anp1 , hold , hunp , P , Pp , w , WS , X , Y
INTEGER :: i , iupper , Iwrite , j , jp1 , N
!
!     INPUT ARGUMENTS--X      = THE  VECTOR OF
!                                (UNSORTED OR SORTED) OBSERVATIONS.
!                     --N      = THE INTEGER NUMBER OF OBSERVATIONS
!                                IN THE VECTOR X.
!                     --P      = THE  FRACTION VALUE
!                                (BETWEEN 0.0 AND 1.0, EXCLUSIVELY)
!                                WHICH DEFINES THE DESIRED PERCENT
!                                POINT TO BE COMPUTED.
!                     --IWRITE = AN INTEGER FLAG CODE WHICH
!                                (IF SET TO 0) WILL SUPPRESS
!                                THE PRINTING OF THE
!                                SAMPLE 100P PERCENT POINT
!                                AS IT IS COMPUTED;
!                                OR (IF SET TO SOME INTEGER
!                                VALUE NOT EQUAL TO 0),
!                                LIKE, SAY, 1) WILL CAUSE
!                                THE PRINTING OF THE
!                                SAMPLE 100P PERCENT POINT
!                                AT THE TIME IT IS COMPUTED.
!     OUTPUT ARGUMENTS--PP     = THE  VALUE OF THE
!                                COMPUTED SAMPLE 100P PERCENT POINT.
!     OUTPUT--THE COMPUTED  VALUE OF THE
!             SAMPLE 100P PERCENT POINT.
!     PRINTING--NONE, UNLESS IWRITE HAS BEEN SET TO A NON-ZERO
!               INTEGER, OR UNLESS AN INPUT ARGUMENT ERROR
!               CONDITION EXISTS.
!     RESTRICTIONS--THE MAXIMUM ALLOWABLE VALUE OF N
!                   FOR THIS SUBROUTINE IS 15000.
!                 --THE INPUT ARGUMENTS N AND P SHOULD BE SUCH THAT
!                   THE PRODUCT OF N+1 AND P IS NOT SMALLER THAN 1 NOR
!                   LARGER THAN N.  THIS RESTRICTION IS DUE TO THE
!                   INTRINSIC DIFFICULTY OF ESTIMATING
!                   SAMPLE PERCENT POINTS SMALLER THAN THE OBSERVED
!                   SAMPLE MINIMUM OR LARGER THAN THE OBSERVED
!                   SAMPLE MAXIMUM.
!                   IF (N+1)P IS SMALLER THAN 1, AN ERROR MESSAGE WILL
!                   BE PRINTED OUT AND PP WILL BE SET TO -999999999.0
!                   IF(N+1)P IS LARGER THAN N, AN ERROR MESSAGE WILL
!                   BE PRINTED OUT AND PP WILL BE SET TO 999999999.0.
!     MODE OF INTERNAL OPERATIONS--.
!     ORIGINAL VERSION--DECEMBER  1974.
!     UPDATED         --SEPTEMBER 1975.
!     UPDATED         --NOVEMBER  1975.
!     UPDATED         --FEBRUARY  1976.
!
!---------------------------------------------------------------------
!
DIMENSION X(:)
DIMENSION Y(15000)
COMMON /BLOCK2_real32/ WS(15000)
EQUIVALENCE (Y(1),WS(1))
!
      iupper = 15000
!
!     CHECK THE INPUT ARGUMENTS FOR ERRORS
!
      an = N
      anp1 = N + 1
      aj = P*anp1
      j = aj
      jp1 = j + 1
      IF ( N<1 .OR. N>iupper ) THEN
         WRITE (G_IO,99001) iupper
99001    FORMAT (' ',                                                   &
     &'***** FATAL ERROR--THE SECOND INPUT ARGUMENT TO THE SAMPP  SUBROU&
     &TINE IS OUTSIDE THE ALLOWABLE (1,',I0,') INTERVAL *****')
         WRITE (G_IO,99002) N
99002    FORMAT (' ','***** THE VALUE OF THE ARGUMENT IS ',I0,' *****')
         RETURN
      ELSEIF ( N==1 ) THEN
         WRITE (G_IO,99003)
99003    FORMAT (' ',                                                   &
     &'***** NON-FATAL DIAGNOSTIC--THE SECOND INPUT ARGUMENT TO THE SAMP&
     &P  SUBROUTINE HAS THE VALUE 1 *****')
         Pp = X(1)
         RETURN
      ELSEIF ( j<1 ) THEN
         WRITE (G_IO,99004)
99004    FORMAT (' ','THE THIRD INPUT ARGUMENT IS SMALLER THAN 1/(N+1)',&
     &           ' = 1/(SECOND INPUT ARGUMENT + 1)')
         WRITE (G_IO,99008) N , P
         Pp = -999999999.0_wp
         RETURN
      ELSEIF ( jp1>N ) THEN
         WRITE (G_IO,99005)
99005    FORMAT (' ','THE THIRD INPUT ARGUMENT IS LARGER THAN N/(N+1)', &
     &          ' = (SECOND INPUT ARGUMENT)/(SECOND INPUT ARGUMENT + 1)'&
     &          )
         WRITE (G_IO,99008) N , P
         Pp = 999999999.0_wp
         RETURN
      ELSE
         hold = X(1)
         DO i = 2 , N
            IF ( X(i)/=hold ) GOTO 50
         ENDDO
         WRITE (G_IO,99006) hold
99006    FORMAT (' ',                                                   &
     &'***** NON-FATAL DIAGNOSTIC--THE FIRST  INPUT ARGUMENT (A VECTOR) &
     &TO THE SAMPP  SUBROUTINE HAS ALL ELEMENTS =',E15.8,' *****')
!
!-----START POINT-----------------------------------------------------
!
 50      CALL SORT(X,N,Y)
!
         ajint = j
         w = 1.0_wp - (aj-ajint)
         Pp = w*Y(j) + (1.0_wp-w)*Y(jp1)
!
         hunp = 100.0*P
         IF ( Iwrite==0 ) RETURN
         WRITE (G_IO,99007) hunp , N , Pp
99007    FORMAT (' ','THE EMPIRICAL ',F9.5,' PERCENT POINT OF THE ',I0, &
     &           ' OBSERVATIONS IS ',F16.7)
      ENDIF
99008 FORMAT (' ','*****THE VALUE OF THE SECOND INPUT ARGUMENT = ',I0,  &
     &        '  THE VALUE OF THE THIRD INPUT ARGUMENT = ',E20.10,      &
     &        '*****')
!
END SUBROUTINE SAMPP