GNU Octave  6.2.0
A high-level interpreted language, primarily intended for numerical computations, mostly compatible with Matlab
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*4 twop30
43  parameter(twop30=1073741824)
44  INTEGER*4 sixty4
45  parameter(sixty4=64)
46 C ..
47 C .. Scalar Arguments ..
48  INTEGER*4 seed1,seed2
49  CHARACTER phrase* (*)
50 C ..
51 C .. Local Scalars ..
52  INTEGER*4 i,ichr,j,lphr,idxval
53 C ..
54 C .. Local Arrays ..
55  INTEGER*4 shift(0:4),values(5)
56 C ..
57 C .. External Functions ..
58  INTEGER*4 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
octave_int< T > mod(const octave_int< T > &x, const octave_int< T > &y)
Definition: oct-inttypes.h:932
subroutine phrtsd(phrase, seed1, seed2)
Definition: phrtsd.f:2