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