1C--- 4/2007 Modified by J Ren
2C--- 8 June 1999 Chris S.  modified to read a file with the first argument
3C--- being a generator type
4C--- added 'integer gentype'
5C--- added 'Reading in a generator type' and   'read *, gentype'
6C--- added 'gtype' and 'integer gtype' to 'check_gen' and 'check_errors'
7
8
9#define YES 1
10#define NO  0
11#define NULL 0
12#define PARAM 0
13#define SIMPLE_SPRNG
14
15        program test_simple_generator
16
17	implicit none
18#include "sprng_f.h"
19
20        integer check_simple_gen
21        integer check_simple_errors
22        integer result, temp
23        integer seed1, seed2
24	integer gentype
25        gentype = 1
26
27        result = YES
28        seed1 = make_sprng_seed()
29        seed2 = make_sprng_seed()
30
31        if( seed1 .eq. seed2 ) then
32          print *, 'ERROR: make_sprng_seed does not return unique seeds'
33	  result = NO
34        end if
35
36C--- Reading in a generator type
37C--- read *, gentype
38
39        temp = check_simple_gen(gentype)
40        if(temp .ne. YES) then
41          result = NO
42        end if
43
44        temp = check_simple_errors()
45        if(temp .ne. YES) then
46          result = NO
47        end if
48
49	print *, '  '
50        if(result .eq. YES) then
51          print *, 'Result:  PASSED'
52        else
53          print *, 'Result:  FAILED'
54        end if
55	print *, '  '
56
57        end
58
59
60        integer function check_simple_gen(gtype)
61
62	implicit none
63#include "sprng_f.h"
64
65	integer gtype
66        SPRNG_POINTER gen
67	integer tempi1, tempi2, seed, size, dblmult
68	real tempf1
69	real*8 tempd1
70        integer i, correct, result, fltmult
71        character s(MAX_PACKED_LENGTH)
72
73	correct = YES
74	result = YES
75	seed = 985456376
76	fltmult = 2**20
77	dblmult = 2**30
78
79        gen = init_sprng(seed,PARAM,gtype)
80	if (gen .eq. NULL) then
81	  result = NO
82	  print *, ' FAILED: SPRNG unable to initialize the generator.'
83	endif
84
85C -- check default generator
86
87        do 100 i = 1,200
88          tempi2 = isprng()
89          read *, tempi1
90          if(tempi2 .ne. tempi1) then
91            result = NO
92            correct = NO
93          end if
94 100    continue
95
96  	if(correct .eq. NO) then
97    	   print *, 'ERROR: Integer generator incorrect.'
98	else
99c 	   print *, 'PASSED: Integer generator passed reproducibility test.'
100	endif
101
102        correct = YES
103	do 200 i = 1,50
104          tempf1 = fget_rn_flt_sim()
105	  tempd1 = tempf1
106	  read *, tempi1
107	  tempi1 = tempi1 / (2**11)
108	  tempi2 = tempd1 * fltmult
109
110	  if ( abs(tempi1-tempi2) .gt. 1) then
111	    result = NO
112	    correct = NO
113          end if
114 200    continue
115        if(correct .eq. NO) then
116	   print *, 'ERROR: Float generator incorrect.'
117	else
118c 	   print *, 'PASSED: Float generator passed reproducibility test.'
119	endif
120
121        correct = YES
122        do 300 i = 1,50
123	  tempd1 = sprng()
124          read *, tempi2
125	  tempi1 = tempd1 * dblmult
126	  if ( abs(tempi2/2-tempi1) .gt. 1) then
127            result = NO
128            correct = NO
129          end if
130 300    continue
131  	if(correct .eq. NO) then
132    	   print *, 'ERROR: Double generator incorrect stream.'
133	else
134c  	   print *, 'PASSED: Double generator passed reproducibility test.'
135	endif
136
137C --  Pack and unpack generator --
138
139  	size = pack_sprng(s(1))
140
141	if (size .eq. 0) then
142	  result = NO
143          print *, 'FAILED: SPRNG was unable to pack the generator.'
144        end if
145        do 400 i = 1,100
146          tempi1 = isprng()
147 400    continue
148
149	gen = unpack_sprng(s(1), 1)
150
151	if (gen .eq. NULL) then
152	  result = NO
153	  print *, 'FAILED: SPRNG was unable to unpack the generator.'
154	endif
155
156  	correct = YES
157        do 500 i = 1,100
158          read *, tempi2
159          tempi1 = isprng()
160          if(tempi1 .ne. tempi2) then
161            result = NO
162            correct = NO
163          end if
164 500    continue
165
166        if(correct .eq. NO) then
167	   print *, 'ERROR: Incorrect stream produced after pack/unpack.'
168        else
169c 	   print *, 'PASSED: Generator packs and unpacks correctly.'
170	end if
171
172	check_simple_gen = result
173	return
174	end
175
176	integer function check_simple_errors()
177
178C  -- Check if generator meets specifications in handling errors --
179
180	implicit none
181#include "sprng_f.h"
182
183	SPRNG_POINTER gen1
184	integer i, tempi1, tempi2, correct, result, seed
185	character s(MAX_PACKED_LENGTH)
186
187        result = YES
188        seed = 985456376
189
190	correct = YES
191
192        do 100 i = 1, MAX_PACKED_LENGTH
193           s(i) = '0'
194 100    continue
195	print *, ' Expect SPRNG ERROR: packed string invalid.'
196
197	gen1 = unpack_sprng(s(1),1)
198	if (gen1 .ne. NULL) then
199	  print *, 'FAILED: Generator unpacks invalid string.'
200	else
201c	  print *, 'PASSED: Generator detected invalid string while unpacking.'
202	endif
203
204	correct = YES
205	do 200 i = 1,50
206          tempi2 = isprng()
207          read *, tempi1
208          if(tempi2 .ne. tempi1) then
209            result = NO
210            correct = NO
211          end if
212 200    continue
213
214        if(correct .eq. 0) then
215           print *, 'FAILED: Original stream not maintained '
216           print *, '    ... when unpacked stream is invalid.'
217        else
218c	   print *, 'PASSED: Generator OK with invalid unpacked stream.'
219        end if
220
221        check_simple_errors = result
222        return
223        end
224
225
226
227
228
229