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