GNU Octave  3.8.0
A high-level interpreted language, primarily intended for numerical computations, mostly compatible with Matlab
 All Classes Namespaces Files Functions Variables Typedefs Enumerations Enumerator Properties Friends Macros Pages
tstbot.for
Go to the documentation of this file.
1  PROGRAM tstbot
2 C**********************************************************************
3 C
4 C A test program for the bottom level routines
5 C
6 C**********************************************************************
7 C Set up the random number generator
8 C .. Local Scalars ..
9  INTEGER ians,iblock,igen,iseed1,iseed2,itmp,ix,ixgen,nbad
10 C ..
11 C .. Local Arrays ..
12  INTEGER answer(10000),genlst(5)
13 C ..
14 C .. External Functions ..
15  INTEGER ignlgi
16  EXTERNAL ignlgi
17 C ..
18 C .. External Subroutines ..
19  EXTERNAL getsd,initgn,setall,setcgn
20 C ..
21 C .. Data statements ..
22  DATA genlst/1,5,10,20,32/
23 C ..
24 C .. Executable Statements ..
25  nbad = 0
26  WRITE (*,9000)
27 
28  9000 FORMAT (' For five virual generators of the 32'/
29  + ' This test generates 10000 numbers then resets the block'/
30  + ' and does it again'/
31  + ' Any disagreements are reported -- there should be none'/)
32 C
33 C Set up Generators
34 C
35  CALL setall(12345,54321)
36 C
37 C For a selected set of generators
38 C
39  DO 60,ixgen = 1,5
40  igen = genlst(ixgen)
41  CALL setcgn(igen)
42  WRITE (*,*) ' Testing generator ',igen
43 C
44 C Use 10 blocks
45 C
46  CALL initgn(-1)
47  CALL getsd(iseed1,iseed2)
48  DO 20,iblock = 1,10
49 C
50 C Generate 1000 numbers
51 C
52  DO 10,ians = 1,1000
53  ix = ians + (iblock-1)*1000
54  answer(ix) = ignlgi()
55  10 CONTINUE
56  CALL initgn(+1)
57  20 CONTINUE
58  CALL initgn(-1)
59 C
60 C Do it again and compare answers
61 C
62  CALL getsd(iseed1,iseed2)
63 C
64 C Use 10 blocks
65 C
66  DO 50,iblock = 1,10
67 C
68 C Generate 1000 numbers
69 C
70  DO 40,ians = 1,1000
71  ix = ians + (iblock-1)*1000
72 C ANSWER( IX ) = IGNLGI()
73  itmp = ignlgi()
74  IF (.NOT. (itmp.NE.answer(ix))) go to 30
75  WRITE (*,9010) iblock,ians,ix,answer(ix),itmp
76 
77  9010 FORMAT (' Disagreement on regeneration of numbers'/
78  + ' Block ',i2,' N within Block ',i2,
79  + ' Index in answer ',i5/
80  + ' Originally Generated ',i10,' Regenerated ',
81  + i10)
82 
83  nbad = nbad + 1
84  IF (nbad.GT.10) stop ' More than 10 mismatches'
85  30 CONTINUE
86  40 CONTINUE
87  CALL initgn(+1)
88  50 CONTINUE
89  WRITE (*,*) ' Finished testing generator ',igen
90  WRITE (*,*) ' Test completed successfully'
91  60 CONTINUE
92  stop
93 
94  END