ソースコードの所在: /home/kizu/pgplot/samples/pgex04.f
(このプログラムで描ける絵は、こちら)
PROGRAM PGEX4
C-----------------------------------------------------------------------
C Demonstration program for PGPLOT: draw histograms.
C-----------------------------------------------------------------------
REAL PI
PARAMETER (PI=3.14159265359)
INTEGER I, ISEED, PGOPEN
REAL DATA(1000), X(620), Y(620)
REAL PGRNRM
C
C Call PGOPEN to initiate PGPLOT and open the output device; PGOPEN
C will prompt the user to supply the device name and type. Always
C check the return code from PGOPEN.
C
IF (PGOPEN('?') .LE. 0) STOP
C
C Call PGRNRM to obtain 1000 samples from a normal distribution.
C
ISEED = -5678921
DO I=1,1000
DATA(I) = PGRNRM(ISEED)
ENDDO
C
C Draw a histogram of these values.
C
CALL PGSAVE
CALL PGHIST(1000,DATA,-3.1,3.1,31,0)
C
C Samples from another normal distribution.
C
DO I=1,200
DATA(I) = 1.0+0.5*PGRNRM(ISEED)
ENDDO
C
C Draw another histogram (filled) on same axes.
C
CALL PGSCI(15)
CALL PGHIST(200,DATA,-3.1,3.1,31,3)
CALL PGSCI(0)
CALL PGHIST(200,DATA,-3.1,3.1,31,1)
CALL PGSCI(1)
C
C Redraw the box which may have been clobbered by the histogram.
C
CALL PGBOX('BST', 0.0, 0, ' ', 0.0, 0)
C
C Label the plot.
C
CALL PGLAB('Variate', ' ',
$ 'PGPLOT Example 4: Histograms (Gaussian)')
C
C Superimpose the theoretical distribution.
C
DO I=1,620
X(I) = -3.1 + 0.01*(I-1)
Y(I) = 0.2*1000./SQRT(2.0*PI)*EXP(-0.5*X(I)*X(I))
ENDDO
CALL PGLINE(620,X,Y)
CALL PGUNSA
C
C Finally, call PGCLOS to terminate things properly.
C
CALL PGCLOS
C
END
C=======================================================================
REAL FUNCTION PGRNRM (ISEED)
INTEGER ISEED
C-----------------------------------------------------------------------
C Returns a normally distributed deviate with zero mean and unit
C variance. The routine uses the Box-Muller transformation of uniform
C deviates. For a more efficient implementation of this algorithm,
C see Press et al., Numerical Recipes, Sec. 7.2.
C
C Arguments:
C ISEED (in/out) : seed used for PGRAND random-number generator.
C
C Subroutines required:
C PGRAND -- return a uniform random deviate between 0 and 1.
C
C History:
C 1995 Dec 12 - TJP.
C-----------------------------------------------------------------------
REAL R, X, Y, PGRAND
C
10 X = 2.0*PGRAND(ISEED) - 1.0
Y = 2.0*PGRAND(ISEED) - 1.0
R = X**2 + Y**2
IF (R.GE.1.0) GOTO 10
PGRNRM = X*SQRT(-2.0*LOG(R)/R)
C-----------------------------------------------------------------------
END
C=======================================================================
REAL FUNCTION PGRAND(ISEED)
INTEGER ISEED
C-----------------------------------------------------------------------
C Returns a uniform random deviate between 0.0 and 1.0.
C
C NOTE: this is not a good random-number generator; it is only
C intended for exercising the PGPLOT routines.
C
C Based on: Park and Miller's "Minimal Standard" random number
C generator (Comm. ACM, 31, 1192, 1988)
C
C Arguments:
C ISEED (in/out) : seed.
C-----------------------------------------------------------------------
INTEGER IM, IA, IQ, IR
PARAMETER (IM=2147483647)
PARAMETER (IA=16807, IQ=127773, IR= 2836)
REAL AM
PARAMETER (AM=128.0/IM)
INTEGER K
C-
K = ISEED/IQ
ISEED = IA*(ISEED-K*IQ) - IR*K
IF (ISEED.LT.0) ISEED = ISEED+IM
PGRAND = AM*(ISEED/128)
RETURN
END