WIND Subroutine

public subroutine WIND(X, N, P1, P2, Iwrite, Xwind)

NAME

wind(3f) - [M_datapac:STATISTICS] compute the sample Winsorized mean
of a vector of observations

SYNOPSIS

   SUBROUTINE WIND(X,N,P1,P2,Iwrite,Xwind)

DESCRIPTION

WIND(3f) computes the sample windsorized mean of the data in the
input vector X.

The windsorizing is such that the lower 100*p1 % of the data is
replaced by the smallest non-windsorized value, and the upper 100*p2 %
of the data is windsorized. replaced by the largest non-windsorized
value.

OPTIONS

 X   description of parameter
 Y   description of parameter

EXAMPLES

Sample program:

program demo_wind
use M_datapac, only : wind
implicit none
! call wind(x,y)
end program demo_wind

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

  • David, Order Statistics, 1970, pages 126-130, 136.
  • Crow and Siddiqui, ‘Robust Estimation of Location’, Journal of the American Statistical Association, 1967, pages 357, 387.
  • Filliben, Simple and Robust Linear Estimation of the Location Parameter of a Symmetric Distribution (Unpublished PH.D. Dissertation, Princeton University, 1969).

Arguments

Type IntentOptional Attributes Name
real(kind=wp), dimension(:) :: X
integer :: N
real(kind=wp) :: P1
real(kind=wp) :: P2
integer :: Iwrite
real(kind=wp) :: Xwind

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)
SAMPP (subroutine)
SPCORR (subroutine)
TAIL (subroutine)
TPLT (subroutine)
TRIM (subroutine)
UNIPLT (subroutine)
WEIB (subroutine)
WEIPLT (subroutine)
"> common /BLOCK2_real64/

Type Attributes Name Initial
real :: WS(15000)

Source Code

SUBROUTINE WIND(X,N,P1,P2,Iwrite,Xwind)
REAL(kind=wp) :: ak , an , anp1 , anp2 , hold , P1 , P2 , perp1 , perp2 , perp3 , psum , sum , WS , X , Xwind , Y
INTEGER i , istart , istop , iupper , Iwrite , k , N , np1 , np2
!
!     INPUT ARGUMENTS--X      = THE VECTOR OF
!                                (UNSORTED OR SORTED) OBSERVATIONS.
!                     --N      = THE INTEGER NUMBER OF OBSERVATIONS
!                                IN THE VECTOR X.
!                     --P1     = THE VALUE
!                                (BETWEEN 0.0 AND 1.0)
!                                WHICH DEFINES WHAT FRACTION
!                                OF THE LOWER ORDER STATISTICS
!                                IS TO BE WINDSORIZED
!                                BEFORE COMPUTING THE WINDSORIZED MEAN.
!                     --P2     = THE VALUE
!                                (BETWEEN 0.0 AND 1.0)
!                                WHICH DEFINES WHAT FRACTION
!                                OF THE UPPER ORDER STATISTICS
!                                IS TO BE WINDSORIZED
!                                BEFORE COMPUTING THE WINDSORIZED MEAN.
!                     --IWRITE = AN INTEGER FLAG CODE WHICH
!                                (IF SET TO 0) WILL SUPPRESS
!                                THE PRINTING OF THE
!                                SAMPLE WINDSORIZED MEAN
!                                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 WINDSORIZED MEAN
!                                AT THE TIME IT IS COMPUTED.
!     OUTPUT ARGUMENTS--XWIND  = THE VALUE OF THE
!                                COMPUTED SAMPLE WINDSORIZED MEAN
!                                WHERE 100*P1 % OF THE SMALLEST
!                                AND 100*P2 % OF THE LARGEST
!                                ORDERED OBSERVATIONS HAVE BEEN
!                                WINSORIZED BEFORE COMPUTING THE
!                                MEAN.
!     OUTPUT--THE COMPUTED VALUE OF THE
!             SAMPLE WINDSORIZED MEAN
!             WHERE 100*P1 % OF THE SMALLEST
!             AND   100*P2 % OF THE LARGEST
!             ORDERED OBSERVATIONS HAVE BEEN WINDSORIZED.
!     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.
!                 --P1 SHOULD BE NON-NEGATIVE.
!                 --P1 SHOULD BE SMALLER THAN 1.0
!                 --P2 SHOULD BE NON-NEGATIVE.
!                 --P2 SHOULD BE SMALLER THAN 1.0
!                 --THE SUM OF P1 AND P2 SHOULD BE
!                   SMALLER THAN 1.0.
!     OTHER DATAPAC   SUBROUTINES NEEDED--SORT.
!
!---------------------------------------------------------------------
!
      DIMENSION X(:)
      DIMENSION Y(15000)
      COMMON /BLOCK2_real64/ WS(15000)
      EQUIVALENCE (Y(1),WS(1))
!
      iupper = 15000
!
!     CHECK THE INPUT ARGUMENTS FOR ERRORS
!
      an = N
      IF ( N<1 .OR. N>iupper ) THEN
         WRITE (G_IO,99001) iupper
         99001    FORMAT (' ',&
         & '***** FATAL ERROR--THE SECOND INPUT ARGUMENT TO WIND(3f) IS OUTSIDE THE ALLOWABLE (1,',I0,') INTERVAL *****')
         WRITE (G_IO,99002) N
         99002 FORMAT (' ','***** THE VALUE OF THE ARGUMENT IS ',I0,' *****')
         RETURN
      ELSE
         IF ( N==1 ) THEN
            WRITE (G_IO,99003)
            99003 FORMAT (' ***** NON-FATAL DIAGNOSTIC--THE SECOND INPUT ARGUMENT TO WIND(3f) HAS THE VALUE 1 *****')
            Xwind = X(1)
         ELSE
            hold = X(1)
            DO i = 2 , N
               IF ( X(i)/=hold ) GOTO 50
            ENDDO
            WRITE (G_IO,99004) hold
            99004 FORMAT (' ***** NON-FATAL DIAGNOSTIC--THE FIRST  INPUT ARGUMENT (A VECTOR) TO WIND(3f) HAS ALL ELEMENTS = ',&
            & E15.8,' *****')
            Xwind = X(1)
         ENDIF
         GOTO 100
 50      IF ( P1<0.0_wp .OR. P1>=1.0_wp ) THEN
            WRITE (G_IO,99005)
            99005 FORMAT (&
            & ' ***** FATAL ERROR--THE THIRD  INPUT ARGUMENT TO WIND(3f) IS OUTSIDE THE ALLOWABLE (0.0,1.0) INTERVAL *****')
            WRITE (G_IO,99017) P1
            Xwind = 0.0_wp
            RETURN
         ELSEIF ( P2<0.0_wp .OR. P2>=1.0_wp ) THEN
            WRITE (G_IO,99006)
99006       FORMAT (' ',                                                &
     &'***** FATAL ERROR--THE FOURTH INPUT ARGUMENT TO THE WIND   SUBROU&
     &TINE IS OUTSIDE THE ALLOWABLE (0.0,1.0)   INTERVAL *****')
            WRITE (G_IO,99017) P2
            Xwind = 0.0_wp
            RETURN
         ELSE
            psum = P1 + P2
            IF ( psum<0.0_wp .OR. psum>=1.0_wp ) THEN
               WRITE (G_IO,99007)
99007          FORMAT (' ',                                             &
     &                 '***** FATAL ERROR--THE SUM OF INPUT ARGUMENTS ',&
     &      '3 AND 4 TO THE WIND   SUBROUTINE IS OUTSIDE THE ALLOWABLE '&
     &      ,'(0.0,1.0) INTERVAL *****')
               WRITE (G_IO,99008) P1
99008          FORMAT (' ','                  INPUT ARGUMENT 3   ',     &
     &                 '                 = ',E15.8)
               WRITE (G_IO,99009) P2
99009          FORMAT (' ','                  INPUT ARGUMENT 4   ',     &
     &                 '                 = ',E15.8)
               WRITE (G_IO,99010) psum
99010          FORMAT (' ','                  INPUT ARGUMENT 3 + ',     &
     &                 'INPUT ARGUMENT 4 = ',E15.8)
               Xwind = 0.0_wp
               RETURN
            ELSE
!
!-----START POINT-----------------------------------------------------
!
               CALL SORT(X,N,Y)
!
               an = N
               np1 = P1*an + 0.0001_wp
               istart = np1 + 1
               np2 = P2*an + 0.0001_wp
               istop = N - np2
               sum = 0.0_wp
               k = 0
               IF ( istart>istop ) THEN
                  WRITE (G_IO,99011)
99011             FORMAT (' ','INTERNAL ERROR IN WIND   SUBROUTINE--',  &
     &                   'THE START INDEX IS HIGHER THAN THE STOP INDEX'&
     &                   )
                  Xwind = 0.0_wp
                  RETURN
               ELSE
                  DO i = istart , istop
                     k = k + 1
                     sum = sum + X(i)
                  ENDDO
                  ak = k
                  anp1 = np1
                  anp2 = np2
                  sum = sum + anp1*X(istart)
                  sum = sum + anp2*X(istop)
                  Xwind = sum/an
               ENDIF
            ENDIF
         ENDIF
      ENDIF
!
 100  IF ( Iwrite==0 ) RETURN
      perp1 = 100.0_wp*P1
      perp2 = 100.0_wp*P2
      perp3 = 100.0_wp - perp1 - perp2
      WRITE (G_IO,99012)
      99012 FORMAT (' ')
      WRITE (G_IO,99013) N , Xwind
      99013 FORMAT (' ','THE SAMPLE WINDSORIZED MEAN OF THE ',I0, ' OBSERVATIONS IS ',E15.8)
      WRITE (G_IO,99014) perp1 , np1
      99014 FORMAT (' ',8X,F10.4,' PERCENT (= ',I0,' OBSERVATIONS) OF THE DATA WERE WINDSORIZED BELOW')
      WRITE (G_IO,99015) perp2 , np2
      99015 FORMAT (' ',8X,F10.4,' PERCENT (= ',I0,' OBSERVATIONS) OF THE DATA WERE WINDSORIZED ABOVE')
      WRITE (G_IO,99016) perp3 , k
      99016 FORMAT (' ',8X,F10.4,' PERCENT (= ',I0,' OBSERVATIONS)  OF THE DATA WERE UNWINDSORIZED IN THE MIDDLE')
      99017 FORMAT (' ','***** THE VALUE OF THE ARGUMENT IS ',E15.8,' *****')
!
END SUBROUTINE WIND