ソースコードの所在: /home/kizu/pgplot/samples/pgex07.f

(このプログラムで描ける絵は、こちら)



      PROGRAM PGEX07
C-----------------------------------------------------------------------
C A plot with a large number of symbols; plus test of PGERR1.
C-----------------------------------------------------------------------
      INTEGER I, ISEED, PGOPEN
      REAL XS(300),YS(300), XR(101), YR(101), XP, YP, XSIG, YSIG
      REAL PGRAND, 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 Window and axes.
C
      CALL PGBBUF
      CALL PGSAVE
      CALL PGSCI(1)
      CALL PGENV(0.,5.,-0.3,0.6,0,1)
      CALL PGLAB('\fix', '\fiy', 'PGPLOT Example 7: scatter plot')
C
C Random data points.
C
      ISEED = -45678921
      DO 10 I=1,300
          XS(I) = 5.0*PGRAND(ISEED)
          YS(I) = XS(I)*EXP(-XS(I)) + 0.05*PGRNRM(ISEED)
   10 CONTINUE
      CALL PGSCI(3)
      CALL PGPT(100,XS,YS,3)
      CALL PGPT(100,XS(101),YS(101),17)
      CALL PGPT(100,XS(201),YS(201),21)
C
C Curve defining parent distribution.
C
      DO 20 I=1,101
          XR(I) = 0.05*(I-1)
          YR(I) = XR(I)*EXP(-XR(I))
   20 CONTINUE
      CALL PGSCI(2)
      CALL PGLINE(101,XR,YR)
C
C Test of PGERR1/PGPT1.
C
      XP = XS(101)
      YP = YS(101)
      XSIG = 0.2
      YSIG = 0.1
      CALL PGSCI(5)
      CALL PGSCH(3.0)
      CALL PGERR1(5, XP, YP, XSIG, 1.0)
      CALL PGERR1(6, XP, YP, YSIG, 1.0)
      CALL PGPT1(XP,YP,21)
C
      CALL PGUNSA
      CALL PGEBUF
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