GNU Octave  6.2.0
A high-level interpreted language, primarily intended for numerical computations, mostly compatible with Matlab
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
subroutine getsd(iseed1, iseed2)
Definition: getsd.f:2
integer *4 function ignlgi()
Definition: ignlgi.f:2
subroutine initgn(isdtyp)
Definition: initgn.f:2
subroutine setall(iseed1, iseed2)
Definition: setall.f:2
program tstbot
Definition: tstbot.for:1