SUBROUTINE WIND(X,N,P1,P2,IWRITE,XWIND)
C
C     PURPOSE--THIS SUBROUTINE COMPUTES THE
C              SAMPLE WINDSORIZED MEAN
C              OF THE DATA IN THE INPUT VECTOR X. 
C              THE WINDSORIZING IS SUCH THAT
C              THE LOWER 100*P1 % OF THE DATA IS
C              REPLACED BY THE SMALLEST NON-WINDSORIZED VALUE,
C              AND THE UPPER 100*P2 % OF THE DATA IS WINDSORIZED.
C              REPLACED BY THE LARGEST NON-WINDSORIZED VALUE.
C     INPUT  ARGUMENTS--X      = THE SINGLE PRECISION VECTOR OF
C                                (UNSORTED OR SORTED) OBSERVATIONS.
C                     --N      = THE INTEGER NUMBER OF OBSERVATIONS
C                                IN THE VECTOR X. 
C                     --P1     = THE SINGLE PRECISION VALUE 
C                                (BETWEEN 0.0 AND 1.0)
C                                WHICH DEFINES WHAT FRACTION
C                                OF THE LOWER ORDER STATISTICS
C                                IS TO BE WINDSORIZED
C                                BEFORE COMPUTING THE WINDSORIZED MEAN.
C                     --P2     = THE SINGLE PRECISION VALUE 
C                                (BETWEEN 0.0 AND 1.0)
C                                WHICH DEFINES WHAT FRACTION
C                                OF THE UPPER ORDER STATISTICS
C                                IS TO BE WINDSORIZED
C                                BEFORE COMPUTING THE WINDSORIZED MEAN.
C                     --IWRITE = AN INTEGER FLAG CODE WHICH 
C                                (IF SET TO 0) WILL SUPPRESS
C                                THE PRINTING OF THE
C                                SAMPLE WINDSORIZED MEAN
C                                AS IT IS COMPUTED;
C                                OR (IF SET TO SOME INTEGER 
C                                VALUE NOT EQUAL TO 0),
C                                LIKE, SAY, 1) WILL CAUSE
C                                THE PRINTING OF THE
C                                SAMPLE WINDSORIZED MEAN
C                                AT THE TIME IT IS COMPUTED.
C     OUTPUT ARGUMENTS--XWIND  = THE SINGLE PRECISION VALUE OF THE
C                                COMPUTED SAMPLE WINDSORIZED MEAN
C                                WHERE 100*P1 % OF THE SMALLEST
C                                AND 100*P2 % OF THE LARGEST
C                                ORDERED OBSERVATIONS HAVE BEEN
C                                WINSORIZED BEFORE COMPUTING THE
C                                MEAN.
C     OUTPUT--THE COMPUTED SINGLE PRECISION VALUE OF THE
C             SAMPLE WINDSORIZED MEAN
C             WHERE 100*P1 % OF THE SMALLEST
C             AND   100*P2 % OF THE LARGEST
C             ORDERED OBSERVATIONS HAVE BEEN WINDSORIZED.
C     PRINTING--NONE, UNLESS IWRITE HAS BEEN SET TO A NON-ZERO
C               INTEGER, OR UNLESS AN INPUT ARGUMENT ERROR
C               CONDITION EXISTS.
C     RESTRICTIONS--THE MAXIMUM ALLOWABLE VALUE OF N
C                   FOR THIS SUBROUTINE IS 15000. 
C                 --P1 SHOULD BE NON-NEGATIVE.
C                 --P1 SHOULD BE SMALLER THAN 1.0 
C                 --P2 SHOULD BE NON-NEGATIVE.
C                 --P2 SHOULD BE SMALLER THAN 1.0 
C                 --THE SUM OF P1 AND P2 SHOULD BE
C                   SMALLER THAN 1.0.
C     OTHER DATAPAC   SUBROUTINES NEEDED--SORT.
C     FORTRAN LIBRARY SUBROUTINES NEEDED--NONE.
C     MODE OF INTERNAL OPERATIONS--SINGLE PRECISION.
C     LANGUAGE--ANSI FORTRAN. 
C     REFERENCES--DAVID, ORDER STATISTICS, 1970, PAGES 126-130, 136.
C               --CROW AND SIDDIQUI, 'ROBUST ESTIMATION OF LOCATION', 
C                 JOURNAL OF THE AMERICAN STATISTICAL ASSOCIATION,
C                 1967, PAGES 357, 387. 
C               --FILLIBEN, SIMPLE AND ROBUST LINEAR ESTIMATION
C                 OF THE LOCATION PARAMETER OF A SYMMETRIC
C                 DISTRIBUTION (UNPUBLISHED PH.D. DISSERTATION,
C                 PRINCETON UNIVERSITY, 1969).
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING LABORATORY (205.03)
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE:  301-921-2315
C     ORIGINAL VERSION--NOVEMBER  1975. 
C     UPDATED         --FEBRUARY  1976. 
C
C---------------------------------------------------------------------
C
      DIMENSION X(1)
      DIMENSION Y(15000)
      COMMON /BLOCK2/ WS(15000)
      EQUIVALENCE (Y(1),WS(1))
C
      IPR=6
      IUPPER=15000
C
C     CHECK THE INPUT ARGUMENTS FOR ERRORS
C
      AN=N
      IF(N.LT.1.OR.N.GT.IUPPER)GOTO50
      IF(N.EQ.1)GOTO55
      HOLD=X(1)
      DO60I=2,N
      IF(X(I).NE.HOLD)GOTO65
   60 CONTINUE
      WRITE(IPR, 9)HOLD
      XWIND=X(1)
      GOTO201
   50 WRITE(IPR,17)IUPPER
      WRITE(IPR,47)N
      RETURN
   55 WRITE(IPR,18) 
      XWIND=X(1)
      GOTO201
   65 IF(P1.LT.0.0.OR.P1.GE.1.0)GOTO66
      GOTO70
   66 WRITE(IPR,27) 
      WRITE(IPR,48)P1
      XWIND=0.0
      RETURN
   70 IF(P2.LT.0.0.OR.P2.GE.1.0)GOTO71
      GOTO75
   71 WRITE(IPR,37) 
      WRITE(IPR,48)P2
      XWIND=0.0
      RETURN
   75 PSUM=P1+P2
      IF(PSUM.LT.0.0.OR.PSUM.GE.1.0)GOTO76
      GOTO90
   76 WRITE(IPR,42) 
      WRITE(IPR,43)P1
      WRITE(IPR,44)P2
      WRITE(IPR,45)PSUM
      XWIND=0.0
      RETURN
   90 CONTINUE
    9 FORMAT(1H ,109H***** NON-FATAL DIAGNOSTIC--THE FIRST  INPUT ARGUME
     1NT (A VECTOR) TO THE WIND   SUBROUTINE HAS ALL ELEMENTS = ,E15.8,6
     1H *****)
   17 FORMAT(1H , 98H***** FATAL ERROR--THE SECOND INPUT ARGUMENT TO THE
     1 WIND   SUBROUTINE IS OUTSIDE THE ALLOWABLE (1,,I6,16H) INTERVAL *
     1****)
   18 FORMAT(1H ,100H***** NON-FATAL DIAGNOSTIC--THE SECOND INPUT ARGUME
     1NT TO THE WIND   SUBROUTINE HAS THE VALUE 1 *****)
   27 FORMAT(1H ,121H***** FATAL ERROR--THE THIRD  INPUT ARGUMENT TO THE
     1 WIND   SUBROUTINE IS OUTSIDE THE ALLOWABLE (0.0,1.0)   INTERVAL *
     1****)
   37 FORMAT(1H ,121H***** FATAL ERROR--THE FOURTH INPUT ARGUMENT TO THE
     1 WIND   SUBROUTINE IS OUTSIDE THE ALLOWABLE (0.0,1.0)   INTERVAL *
     1****)
   42 FORMAT(1H , 46H***** FATAL ERROR--THE SUM OF INPUT ARGUMENTS ,
     1 58H3 AND 4 TO THE WIND   SUBROUTINE IS OUTSIDE THE ALLOWABLE , 
     1 24H(0.0,1.0) INTERVAL *****)
   43 FORMAT(1H ,37H                  INPUT ARGUMENT 3   ,
     1 19H                 = ,E15.8)
   44 FORMAT(1H ,37H                  INPUT ARGUMENT 4   ,
     1 19H                 = ,E15.8)
   45 FORMAT(1H ,37H                  INPUT ARGUMENT 3 + ,
     1 19HINPUT ARGUMENT 4 = ,E15.8)
   47 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,I8   ,6H *****)
   48 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,E15.8,6H *****)
C
C-----START POINT-----------------------------------------------------
C
      CALL SORT(X,N,Y)
C
      AN=N
      NP1=P1*AN+0.0001
      ISTART=NP1+1
      NP2=P2*AN+0.0001
      ISTOP=N-NP2
      SUM=0.0
      K=0 
      IF(ISTART.GT.ISTOP)GOTO150
      DO100I=ISTART,ISTOP
      K=K+1
      SUM=SUM+X(I)
  100 CONTINUE
      AK=K
      ANP1=NP1
      ANP2=NP2
      SUM=SUM+ANP1*X(ISTART)
      SUM=SUM+ANP2*X(ISTOP)
      XWIND=SUM/AN
      GOTO170
  150 WRITE(IPR,155)
  155 FORMAT(1H ,37HINTERNAL ERROR IN WIND   SUBROUTINE--,
     1 45HTHE START INDEX IS HIGHER THAN THE STOP INDEX)
      XWIND=0.0
      RETURN
  170 CONTINUE
C
  201 IF(IWRITE.EQ.0)RETURN
      PERP1=100.0*P1
      PERP2=100.0*P2
      PERP3=100.0-PERP1-PERP2 
      WRITE(IPR,999)
      WRITE(IPR,105)N,XWIND
      WRITE(IPR,110)PERP1,NP1 
      WRITE(IPR,115)PERP2,NP2 
      WRITE(IPR,120)PERP3,K
  105 FORMAT(1H ,35HTHE SAMPLE WINDSORIZED MEAN OF THE ,I6, 
     1 17H OBSERVATIONS IS ,E15.8)
  110 FORMAT(1H ,8X,F10.4,12H PERCENT (= ,I6, 15H OBSERVATIONS) ,
     1 34HOF THE DATA WERE WINDSORIZED BELOW)
  115 FORMAT(1H ,8X,F10.4,12H PERCENT (= ,I6, 15H OBSERVATIONS) ,
     1 34HOF THE DATA WERE WINDSORIZED ABOVE)
  120 FORMAT(1H ,8X,F10.4,12H PERCENT (= ,I6, 15H OBSERVATIONS) ,
     1 45H OF THE DATA WERE UNWINDSORIZED IN THE MIDDLE)
  999 FORMAT(1H )
C
      RETURN
      END