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
phrtsd.f
Go to the documentation of this file.
1  SUBROUTINE phrtsd(phrase,seed1,seed2)
2 C**********************************************************************
3 C
4 C SUBROUTINE PHRTSD( PHRASE, SEED1, SEED2 )
5 C PHRase To SeeDs
6 C
7 C
8 C Function
9 C
10 C
11 C Uses a phrase (character string) to generate two seeds for the RGN
12 C random number generator.
13 C
14 C
15 C Arguments
16 C
17 C
18 C PHRASE --> Phrase to be used for random number generation
19 C CHARACTER*(*) PHRASE
20 C
21 C SEED1 <-- First seed for RGN generator
22 C INTEGER SEED1
23 C
24 C SEED2 <-- Second seed for RGN generator
25 C INTEGER SEED2
26 C
27 C
28 C Note
29 C
30 C
31 C Trailing blanks are eliminated before the seeds are generated.
32 C
33 C Generated seed values will fall in the range 1..2^30
34 C (1..1,073,741,824)
35 C
36 C**********************************************************************
37 C .. Parameters ..
38  CHARACTER*(*) table
39  parameter(table='abcdefghijklmnopqrstuvwxyz'//
40  + 'ABCDEFGHIJKLMNOPQRSTUVWXYZ'//'0123456789'//
41  + '!@#$%^&*()_+[];:''"<>?,./')
42  INTEGER twop30
43  parameter(twop30=1073741824)
44  INTEGER sixty4
45  parameter(sixty4=64)
46 C ..
47 C .. Scalar Arguments ..
48  INTEGER seed1,seed2
49  CHARACTER phrase* (*)
50 C ..
51 C .. Local Scalars ..
52  INTEGER i,ichr,j,lphr,idxval
53 C ..
54 C .. Local Arrays ..
55  INTEGER shift(0:4),values(5)
56 C ..
57 C .. External Functions ..
58  INTEGER lennob
59  EXTERNAL lennob
60 C ..
61 C .. Intrinsic Functions ..
62  INTRINSIC index,mod
63 C ..
64 C JJV added Save statement for variable in Data statement
65 C .. Save statements ..
66  SAVE shift
67 C JJV end addition
68 C ..
69 C .. Data statements ..
70  DATA shift/1,64,4096,262144,16777216/
71 C ..
72 C .. Executable Statements ..
73  seed1 = 1234567890
74  seed2 = 123456789
75  lphr = lennob(phrase)
76  IF (lphr.LT.1) RETURN
77  DO 30,i = 1,lphr
78  idxval = index(table,phrase(i:i))
79  ichr = mod(idxval,sixty4)
80  IF (ichr.EQ.0) ichr = 63
81  DO 10,j = 1,5
82  values(j) = ichr - j
83  IF (values(j).LT.1) values(j) = values(j) + 63
84  10 CONTINUE
85  DO 20,j = 1,5
86  seed1 = mod(seed1+shift(j-1)*values(j),twop30)
87  seed2 = mod(seed2+shift(j-1)*values(6-j),twop30)
88  20 CONTINUE
89  30 CONTINUE
90  RETURN
91 
92  END