_FORTRAN & GUIS_
by John L. Bradberry

[LISTING ONE]

C    >**************************************************************
      PROGRAM BELL
C     **************************************************************
C     AUTHOR: JOHN L. BRADBERRY         CREATION DATE: FEB 15,1989
C     UTILITY TO CREATE A BELL CURVE DATA 'PLOT' BY READING IN A SERIES 
C     OF NUMBERS IN THE RANGE OF 0-100. THE NUMBERS ARE USED TO CREATE
C     THE GAUSSIAN DISTRIBUTION CONSTANTS. THE CONSTANTS ARE THEN USED TO
C     CALCULATE A NORMAL DISTRIBUTION FROM 0 TO 100 IN STEPS OF 5. '*' ARE
C     PLOTTED IN HISTOGRAM FORM TO SIMULATE BELL SHAPE.
C     --------------------------------------------------------------
C
      IMPLICIT NONE
C
      INCLUDE 'BELLCOM.INC'
C
C
      INTEGER*2         LU              !LOGICAL UNIT NUMBER
C      
      LU=6
C
C     INITIALIZE BELL CURVE DATA (CONTAINED IN COMMON)...
C
      BCIDX=0
      BCTOT=0
      BCEX=0
      BCEXS=0
      

C     GET BELL CURVE VALUES FROM USER TO BE USED FOR CALCULATIONS...
C
      CALL GET_BELL_DATA(LU)
C
C     CALCULATE CONSTANTS FOR GAUSSIAN DISTRIBUTION AND PLOT BELL CURVE
C     USING THE '*' CHARACTER...
C
      CALL PLOT_BELL_DATA(LU)
C
C
      END
C
C    >**************************************************************
      SUBROUTINE GET_BELL_DATA(LU)
C     **************************************************************
C     SUBROUTINE TO PROMPT USER FOR INTEGER VALUE...
C     --------------------------------------------------------------
C     AUTHOR: JOHN L. BRADBERRY         CREATION DATE: FEB 8,1989
C
      IMPLICIT NONE
C
      INCLUDE 'BELLCOM.INC'
C
C
      INTEGER*2         I               !LOOP INDEX COUNTER
      INTEGER*2         LU              !LOGICAL UNIT NUMBER
      INTEGER*2         BCCOUNT         !BELL CURVE DATA POINT COUNT
C
C
      BCCOUNT=1
      DO WHILE (BCCOUNT.GT.0)
C
        CALL IPROMPT(LU,'Enter Number Of Occurrences Next Data Point '//
     +                  'Value (Or 0 To Exit).',BCCOUNT)
      
        IF (BCCOUNT.GT.0) THEN
          CALL DRPROMPT(LU,'Enter Data Point Value (Range 0-100):',
     +                  BCDAT)
        END IF
C
        IF (BCCOUNT.GT.0) THEN
          DO I=1,BCCOUNT
            BCIDX=BCIDX+1
            BCTOT=BCTOT+BCDAT
          END DO
          BCEX=BCEX+BCCOUNT*BCDAT
          BCEXS=BCEXS+BCCOUNT*BCDAT*BCDAT
        END IF
      END DO
C
C

      RETURN
      END
C
C    >**************************************************************
      SUBROUTINE PLOT_BELL_DATA(LU)
C     **************************************************************
C     SUBROUTINE TO PROMPT USER FOR INTEGER VALUE...
C     --------------------------------------------------------------
C     AUTHOR: JOHN L. BRADBERRY         CREATION DATE: FEB 8,1989
C
      IMPLICIT NONE
C
      INCLUDE 'BELLCOM.INC'
C
C
      INTEGER*2         LU              !LOGICAL UNIT NUMBER
      INTEGER*2         KX              !LOOP INDEX COUNTER
      INTEGER*2         STARCOUNT       !NUMBER OF STARS TO OUTPUT IN BELL
      INTEGER*2         MAXSTARS        !MAXIMUM STARS IN CHARACTER STRING
      
      PARAMETER         (MAXSTARS=51)        
      
      CHARACTER         STARS*51        !STRING 'STAR' ARRAY
            
      REAL*8            RVAL1           !TEMPORARY
      REAL*8            RVAL2           !TEMPORARY
      REAL*8            DEGRAD          !DEGREES TO RADIAN CONVERSION
C
C
      STARS='***************************************************'
C
      DEGRAD=3.141592654D0/180D0
C     
      IF (BCIDX.GT.0) THEN
        BCEX=BCEX/BCIDX
        BCEXS=BCEXS/BCIDX
        BCMEAN=BCEX
        BCVAR=BCEXS-BCEX*BCEX
        BCSIGMA=SQRT(BCVAR)
      END IF
C
C     BELL CURVE FORMULA...
C     
C     1/(SIGMA(SQRT(2PI)))*EXP(-(X-MEAN)**2/(2*SIGMA))
C
      RVAL1=1.0/(BCSIGMA*SQRT(2*3.141592654))
      DO KX=0,100,5
        RVAL2=RVAL1*EXP(-1.0*((KX-BCMEAN)**2)/(2.0*BCSIGMA*BCSIGMA))
        RVAL2=1000*RVAL2

        STARCOUNT=MIN(NINT(RVAL2),MAXSTARS)
        WRITE(LU,*)KX,' |',STARS(1:STARCOUNT)
      END DO
C
      WRITE(LU,'(/,1X,A10,I2,2X,3(A10,F8.3,2X))')
     +      '# POINTS= ',BCIDX,'MEAN= ',BCMEAN,'VARIANCE= ',
     +      BCVAR,'   SIGMA= ',BCSIGMA
C
C
      RETURN
      END
C
C    >**************************************************************
      SUBROUTINE IPROMPT(LU,PROMPT,IVAL)
C     **************************************************************
C     SUBROUTINE TO PROMPT USER FOR INTEGER VALUE...
C     --------------------------------------------------------------
C     AUTHOR: JOHN L. BRADBERRY         CREATION DATE: FEB 8,1989
C
      IMPLICIT NONE
C
      INTEGER*2         IVAL            !INTEGER VALUE RETURNED
      INTEGER*2         LU              !LOGICAL UNIT NUMBER
C
      CHARACTER*(*)     PROMPT          !STRING PROMPT TO BE ISSUED
C
C
      WRITE(LU,*)PROMPT
      READ(LU,*)IVAL
C
C
      RETURN
      END
C
C
C    >**************************************************************
      SUBROUTINE DRPROMPT(LU,PROMPT,DRVAL)
C     **************************************************************
C     SUBROUTINE TO PROMPT USER FOR DOUBLE PRECISION REAL VALUE...
C     --------------------------------------------------------------
C     AUTHOR: JOHN L. BRADBERRY         CREATION DATE: FEB 8,1989
C
      IMPLICIT NONE
C
      INTEGER*2         LU              !LOGICAL UNIT NUMBER
C
      CHARACTER*(*)     PROMPT          !STRING PROMPT TO BE ISSUED

C
      REAL*8            DRVAL           !REAL VALUE RETURNED
C
C
      WRITE(LU,*)PROMPT
      READ(LU,*)DRVAL
C
C
      RETURN
      END
C

[LISTING TWO]


C     -----------------------------------------------------------
C     BELL CURVE CONTROL COMMON ...
C     -----------------------------------------------------------
C
      INTEGER*2         BCIDX           !BELL CURVE INDEX
C      
      REAL*8            BCMEAN          !BELL CURVE MEAN
      REAL*8            BCEX            !BELL CURVE EX TERM
      REAL*8            BCEXS           !BELL CURVE EX TERM SQUARED
      REAL*8            BCTOT           !BELL CURVE TOTAL
      REAL*8            BCDAT           !BELL CURVE DATA
      REAL*8            BCVAR           !BELL CURVE VARIANCE
      REAL*8            BCSIGMA         !BELL CURVE SIGMA
C
C
      COMMON /BELLCURVE/
C
     +BCIDX,
     +BCMEAN,
     +BCEX,
     +BCEXS,
     +BCTOT,
     +BCDAT,
     +BCVAR,
     +BCSIGMA
C



[Example 1]

C
      INTEGER           GLU             !LOGICAL UNIT NUMBER
C
      GLU=10
      OPEN (UNIT=GLU, FILE = 'USER')
.
.     (see listings 1-2 for rest of body)
.
C
      CLOSE (GLU, STATUS = 'KEEP')
C