SUBROUTINE DISCRE(X,N,XMIN,XDEL,XMAX,Y)
C
C     PURPOSE--THIS SUBROUTINE 'DISCRETIZES' THE DATA
C              OF THE SINGLE PRECISION VECTOR X.
C              THE FIRST CLASS INTERVAL IS FROM
C              XMIN TO XMIN + XDEL;
C              THE SECOND CLASS INTERVAL IS FROM
C              XMIN+ XDEL TO XMIN + 2*XDEL;
C              ETC. 
C              ALL VALUES IN THE VECTOR X WITHIN A GIVEN CLASS
C              WILL BE MAPPED INTO THE MIDPOINT OF THAT CLASS.
C              ALL VALUES IN THE VECTOR X SMALLER THAN XMIN 
C              WILL BE MAPPED INTO XMIN - (XDEL/2.0).
C              ALL VALUES IN THE VECTOR X LARGER THAN XMAX
C              WILL BE MAPPED INTO XMAX + (XDEL/2.0).
C              THE USE OF THIS SUBROUTINE
C              (AND THE DISCR2 AND DISCR3 SUBROUTINES)
C              GIVES THE DATA ANALYST THE CAPABILITY OF
C              CONSTRUCTING A DISCRETE VARIATE FROM
C              A CONTINUOUS ONE.
C              THE RESULTING DISCRETE VARIATE MIGHT THEN
C              (FOR EXAMPLE) BE ANALYZED IN ITSELF FOR
C              GROSS STRUCTURE, OR FOR ADHERENCE TO SOME
C              THEROETICAL DISCRETE PROBABILITY MODEL,
C              OR THE DISCRETE VARIATE MIGHT BE USED
C              AS A SUBSET DEFINITION VECTOR FOR SOME
C              OTHER VARIATE. 
C     INPUT  ARGUMENTS--X      = THE SINGLE PRECISION VECTOR OF
C                                (UNSORTED OR SORTED) OBSERVATIONS.
C                                TO BE DISCRETIZED.
C                     --N      = THE INTEGER NUMBER OF OBSERVATIONS
C                                IN THE VECTOR X. 
C                     --XMIN   = THE SINGLE PRECISION VALUE 
C                                WHICH DEFINES THE LOWER BOUNDARY
C                                (INCLUSIVELY) OF THE LOWERMOST
C                                CLASS. 
C                     --XDEL   = THE SINGLE PRECISION VALUE 
C                                OF THE CLASS WIDTH.
C                     --XMAX   = THE SINGLE PRECISION VALUE 
C                                WHICH DEFINES THE UPPER BOUNDARY
C                                (INCLUSIVELY) OF THE UPPERMOST
C                                CLASS. 
C     OUTPUT ARGUMENTS--Y      = THE SINGLE PRECISION VECTOR OF
C                                DISCRETIZED VALUES (= CLASS
C                                MIDPOINTS) CORRESPONDING TO
C                                THE CONTINUOUS VALUES IN THE VECTOR X.
C                                THERE WILL RESULT N SUCH DISCRETIZED 
C                                VALUES.
C     OUTPUT--THE SINGLE PRECISION VECTOR Y
C             WHICH CONTAINS N DISCRETIZED VALUES 
C             (= CLASS MIDPOINTS)
C             CORRESPONDING TO THE N
C             CONTINUOUS VALUES IN THE
C             INPUT VECTOR X. 
C             ALSO, A FEW LINES LINES OF SUMMARY INFORMATION
C             WILL BE GENERATED INDICATING
C             1) WHAT THE SAMPLE SIZE IS (N);
C             2) WHAT THE NUMBER OF CLASSES IS (NUMCLA).
C             3) WHAT THE CLASS BOUNDARIES AND
C                THE NUMBER OF OBSERVATIONS
C                FALLING IN EACH CLASS ARE.
C     PRINTING--YES.
C     RESTRICTIONS--THERE IS NO RESTRICTION ON THE MAXIMUM VALUE
C                   OF N FOR THIS SUBROUTINE.
C                 --XDEL SHOULD BE POSITIVE.
C                 --(XMAX-XMIN)/XDEL SHOULD NOT EXCEED 999. 
C     OTHER DATAPAC   SUBROUTINES NEEDED--NONE.
C     FORTRAN LIBRARY SUBROUTINES NEEDED--NONE.
C     MODE OF INTERNAL OPERATIONS--SINGLE PRECISION.
C     LANGUAGE--ANSI FORTRAN. 
C     COMMENT--IT IS SUGGESTED THAT XMIN, XDEL,
C              AND XMAX HAVE AT LEAST 1 MORE
C              DECIMAL PLACE THAN THE DATA VALUES 
C              IN THE VECTOR X SO AS TO HELP ASSURE
C              A UNIQUE DISCRETIZATION MAPPING;
C              THAT IS, TO HELP ASSURE THAT
C              NO DATA VALUE WILL FALL
C              EXACTLY ON THE BOUNDARY POINT
C              BETWEEN 2 ADJACENT CLASSES.
C     COMMENT--IN THE MAIN (CALLING) ROUTINE, IT IS
C              PERMISSABLE (IF THE ANALYST SO DESIRES)
C              TO USE THE SAME VARIABLE NAME
C              IN THE SIXTH ARGUMENT AS USED IN THE FIRST
C              ARGUMENT IN THE CALLING SEQUENCE TO THIS
C              DISCRE SUBROUTINE--NO CONFLICT WILL RESULT
C              IN THE INTERNAL OPERATION OF THE     DISCRE
C              SUBROUTINE.  FOR EXAMPLE, IT IS PERMISSIBLE
C              TO HAVE     CALL DISCRE(X,N,0.5,1.0,20.5,X)
C              IN WHICH THE VARIABLE NAME      X    IS USED 
C              AS BOTH THE FIRST AND SIXTH ARGUMENTS.
C     REFERENCES--NONE.
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  1974. 
C     UPDATED         --NOVEMBER  1975. 
C
C---------------------------------------------------------------------
C
      DIMENSION X(1),Y(1)
      DIMENSION ICOUNT(1000)
      DIMENSION CLASSM(1000)
C
      IPR=6
C
C     CHECK THE INPUT ARGUMENTS FOR ERRORS
C
      IF(N.LT.1)GOTO50
      IF(N.EQ.1)GOTO55
      IF(XDEL.LE.0.0)GOTO70
      IF(XMIN.EQ.XMAX)GOTO80
      HOLD=X(1)
      DO60I=2,N
      IF(X(I).NE.HOLD)GOTO90
   60 CONTINUE
      WRITE(IPR, 9)HOLD
      DO65I=1,N
      Y(I)=X(I)
   65 CONTINUE
      RETURN
   50 WRITE(IPR,15) 
      WRITE(IPR,47)N
      RETURN
   55 WRITE(IPR,18) 
      Y(1)=X(1)
      RETURN
   70 WRITE(IPR,35) 
      WRITE(IPR,48)XDEL
      DO71I=1,N
      Y(I)=0.0
   71 CONTINUE
      RETURN
   80 WRITE(IPR,26) 
      WRITE(IPR,49)XMIN
      DO81I=1,N
      Y(I)=0.0
   81 CONTINUE
      RETURN
   90 CONTINUE
    9 FORMAT(1H ,108H***** NON-FATAL DIAGNOSTIC--THE FIRST  INPUT ARGUME
     1NT (A VECTOR) TO THE DISCRE SUBROUTINE HAS ALL ELEMENTS = ,E15.8,6
     1H *****)
   15 FORMAT(1H , 91H***** FATAL ERROR--THE SECOND INPUT ARGUMENT TO THE
     1 DISCRE SUBROUTINE IS NON-POSITIVE *****)
   18 FORMAT(1H ,100H***** NON-FATAL DIAGNOSTIC--THE SECOND INPUT ARGUME
     1NT TO THE DISCRE SUBROUTINE HAS THE VALUE 1 *****)
   26 FORMAT(1H ,45H***** FATAL ERROR--THE THIRD AND FIFTH INPUT ,
     1 48HARGUMENTS TO THE DISCRE SUBROUTINE ARE IDENTICAL) 
   35 FORMAT(1H , 91H***** FATAL ERROR--THE FOURTH INPUT ARGUMENT TO THE
     1 DISCRE SUBROUTINE IS NON-POSITIVE *****)
   47 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,I8   ,6H *****)
   48 FORMAT(1H , 35H***** THE VALUE OF THE ARGUMENT IS ,E15.7   ,6H ***
     1**) 
   49 FORMAT(1H , 37H***** THE VALUE OF THE ARGUMENTS ARE ,E15.7   ,6H *
     1****)
C
C-----START POINT-----------------------------------------------------
C
C     DETERMINE THE TRUE INTERVAL MIN AND MAX;
C     THEN DETERMINE THE NUMBER OF CLASSES
C     WITHIN THE SPECIFIED MIN AND MAX. 
C
      POINTL=XMIN
      POINTU=XMAX
      IF(XMIN.GT.XMAX)POINTL=XMAX
      IF(XMIN.GT.XMAX)POINTU=XMIN
      TOTDEL=POINTU-POINTL
      NUMCLA=(TOTDEL/XDEL)+0.999
C
C     ZERO OUT THE COUNT VECTOR (ICOUNT)
C     AND THE LOWER AND UPPER COUNT VARIABLES.
C
      DO100I=1,NUMCLA
      ICOUNT(I)=0
  100 CONTINUE
      ICOUNL=0
      ICOUNU=0
C
C     COMPUTE THE CLASS MIDPOINT FOR EACH CLASS.
C
      DO200I=1,NUMCLA
      AI=I
      CMIN=XMIN+(AI-1.0)*XDEL 
      CMAX=XMIN+AI*XDEL
      CLASSM(I)=(CMIN+CMAX)/2.0
  200 CONTINUE
      CMAX=POINTU
      CLASSM(NUMCLA)=(CMIN+CMAX)/2.0
C
C     PERFORM THE DISCRETIZING TRANSFORMATION.
C
      DO300I=1,N
      IF(X(I).GE.POINTL.AND.X(I).LE.POINTU)GOTO350
      IF(X(I).LT.POINTL)GOTO370
      IF(X(I).GT.POINTU)GOTO390
      GOTO300
  350 IP=(X(I)-POINTL)/XDEL
      IP=IP+1
      IF(IP.GT.NUMCLA)IP=NUMCLA
      Y(I)=CLASSM(IP)
      ICOUNT(IP)=ICOUNT(IP)+1 
      GOTO300
  370 CLASML=POINTL-(XDEL/2.0)
      Y(I)=CLASML
      ICOUNL=ICOUNL+1
      GOTO300
  390 CLASMU=POINTU+(XDEL/2.0)
      Y(I)=CLASMU
      ICOUNU=ICOUNU+1
  300 CONTINUE
C
C     COMPUTE CLASS LIMITS AND WRITE OUT SUMMARY INFORMATION.
C
      WRITE(IPR,999)
      WRITE(IPR,501)
      WRITE(IPR,999)
      WRITE(IPR,502)N
      WRITE(IPR,503)XMIN
      WRITE(IPR,504)XDEL
      WRITE(IPR,505)XMAX
      WRITE(IPR,508)NUMCLA
      WRITE(IPR,999)
      WRITE(IPR,510)
      WRITE(IPR,997)
      IF(ICOUNL.GE.1)WRITE(IPR,511)CLASML,POINTL,ICOUNL
      DO500I=1,NUMCLA
      AI=I
      CMIN=POINTL+(AI-1.0)*XDEL
      CMAX=POINTL+AI*XDEL
      IF(CMAX.GT.POINTU)CMAX=POINTU
      WRITE(IPR,520)I,CMIN,CLASSM(I),CMAX,ICOUNT(I)
  500 CONTINUE
      IF(ICOUNU.GE.1)WRITE(IPR,512)POINTU,CLASMU,ICOUNU
C
  501 FORMAT(1H ,35HOUTPUT FROM THE DISCRE SUBROUTINE--)
  502 FORMAT(1H ,7X,36HNUMBER OF OBSERVATIONS            = ,I8)
  503 FORMAT(1H ,7X,36HSPECIFIED LOWER BOUND OF INTERVAL = ,F15.7)
  504 FORMAT(1H ,7X,36HSPECIFIED CLASS WIDTH             = ,F15.7)
  505 FORMAT(1H ,7X,36HSPECIFIED UPPER BOUND OF INTERVAL = ,F15.7)
  508 FORMAT(1H ,7X,36HCOMPUTED  NUMBER OF LEVELS        = ,I8)
  510 FORMAT(1H ,52H       CLASS     MINIMUM       MIDPOINT      MAXIMUM
     1,11H      COUNT)
  511 FORMAT(1H ,4X,22H   BELOW     -INFINITY,2F14.7,I8)
  512 FORMAT(1H ,4X,8H   ABOVE,2F14.7,14H     +INFINITY,I8) 
  520 FORMAT(1H ,4X,I6,2X,3F14.7,I8)
  997 FORMAT(1H ,50H       -------------------------------------------,
     1 13H-------------)
  999 FORMAT(1H )
C
      RETURN
      END