GNU Octave: libcruft/ranlib/phrtsd.f Source File

Go to the documentation of this file.
00001       SUBROUTINE phrtsd(phrase,seed1,seed2)
00002 C**********************************************************************
00003 C
00004 C     SUBROUTINE PHRTSD( PHRASE, SEED1, SEED2 )
00005 C               PHRase To SeeDs
00006 C
00007 C
00008 C                              Function
00009 C
00010 C
00011 C     Uses a phrase (character string) to generate two seeds for the RGN
00012 C     random number generator.
00013 C
00014 C
00015 C                              Arguments
00016 C
00017 C
00018 C     PHRASE --> Phrase to be used for random number generation
00019 C                         CHARACTER*(*) PHRASE
00020 C
00021 C     SEED1 <-- First seed for RGN generator
00022 C                         INTEGER SEED1
00023 C
00024 C     SEED2 <-- Second seed for RGN generator
00025 C                         INTEGER SEED2
00026 C
00027 C
00028 C                              Note
00029 C
00030 C
00031 C     Trailing blanks are eliminated before the seeds are generated.
00032 C
00033 C     Generated seed values will fall in the range 1..2^30
00034 C     (1..1,073,741,824)
00035 C
00036 C**********************************************************************
00037 C     .. Parameters ..
00038       CHARACTER*(*) table
00039       PARAMETER (table='abcdefghijklmnopqrstuvwxyz'//
00040      +          'ABCDEFGHIJKLMNOPQRSTUVWXYZ'//'0123456789'//
00041      +          '!@#$%^&*()_+[];:''"<>?,./')
00042       INTEGER twop30
00043       PARAMETER (twop30=1073741824)
00044       INTEGER sixty4
00045       PARAMETER (sixty4=64)
00046 C     ..
00047 C     .. Scalar Arguments ..
00048       INTEGER seed1,seed2
00049       CHARACTER phrase* (*)
00050 C     ..
00051 C     .. Local Scalars ..
00052       INTEGER i,ichr,j,lphr,idxval
00053 C     ..
00054 C     .. Local Arrays ..
00055       INTEGER shift(0:4),values(5)
00056 C     ..
00057 C     .. External Functions ..
00058       INTEGER lennob
00059       EXTERNAL lennob
00060 C     ..
00061 C     .. Intrinsic Functions ..
00062       INTRINSIC index,mod
00063 C     ..
00064 C     JJV added Save statement for variable in Data statement 
00065 C     .. Save statements ..
00066       SAVE shift
00067 C     JJV end addition 
00068 C     .. 
00069 C     .. Data statements ..
00070       DATA shift/1,64,4096,262144,16777216/
00071 C     ..
00072 C     .. Executable Statements ..
00073       seed1 = 1234567890
00074       seed2 = 123456789
00075       lphr = lennob(phrase)
00076       IF (lphr.LT.1) RETURN
00077       DO 30,i = 1,lphr
00078           idxval = index(table,phrase(i:i))
00079           ichr = mod(idxval,sixty4)
00080           IF (ichr.EQ.0) ichr = 63
00081           DO 10,j = 1,5
00082               values(j) = ichr - j
00083               IF (values(j).LT.1) values(j) = values(j) + 63
00084    10     CONTINUE
00085           DO 20,j = 1,5
00086               seed1 = mod(seed1+shift(j-1)*values(j),twop30)
00087               seed2 = mod(seed2+shift(j-1)*values(6-j),twop30)
00088    20     CONTINUE
00089    30 CONTINUE
00090       RETURN
00091 
00092       END