Mercurial > octave-nkf

comparison libcruft/ranlib/phrtsd.f @ 6567:e82cb026b893

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
[project @ 2007-04-24 20:40:23 by jwe]
author jwe
date Tue, 24 Apr 2007 20:40:24 +0000
parents 7e9a548e8ddf
children
comparison
equal deleted inserted replaced
6566:e9612a33cd1a 6567:e82cb026b893
47 C .. Scalar Arguments .. 47 C .. Scalar Arguments ..
48 INTEGER seed1,seed2 48 INTEGER seed1,seed2
49 CHARACTER phrase* (*) 49 CHARACTER phrase* (*)
50 C .. 50 C ..
51 C .. Local Scalars .. 51 C .. Local Scalars ..
52 INTEGER i,ichr,j,lphr 52 INTEGER i,ichr,j,lphr,idxval
53 C .. 53 C ..
54 C .. Local Arrays .. 54 C .. Local Arrays ..
55 INTEGER shift(0:4),values(5) 55 INTEGER shift(0:4),values(5)
56 C .. 56 C ..
57 C .. External Functions .. 57 C .. External Functions ..
73 seed1 = 1234567890 73 seed1 = 1234567890
74 seed2 = 123456789 74 seed2 = 123456789
75 lphr = lennob(phrase) 75 lphr = lennob(phrase)
76 IF (lphr.LT.1) RETURN 76 IF (lphr.LT.1) RETURN
77 DO 30,i = 1,lphr 77 DO 30,i = 1,lphr
78 ichr = mod(index(table,phrase(i:i)),sixty4) 78 idxval = index(table,phrase(i:i))
79 ichr = mod(idxval,sixty4)
79 IF (ichr.EQ.0) ichr = 63 80 IF (ichr.EQ.0) ichr = 63
80 DO 10,j = 1,5 81 DO 10,j = 1,5
81 values(j) = ichr - j 82 values(j) = ichr - j
82 IF (values(j).LT.1) values(j) = values(j) + 63 83 IF (values(j).LT.1) values(j) = values(j) + 63
83 10 CONTINUE 84 10 CONTINUE