[135] | 1 | SUBROUTINE ini36 |
---|
| 2 | Ccray IMPLICIT NONE |
---|
| 3 | IMPLICIT NONE |
---|
| 4 | c==================================================================== |
---|
| 5 | c-- cette routine fait l'initialisation pour le codage sur base 36 |
---|
| 6 | c-- de la routine to36. on peut utiliser soit 1 soit 2 soit 3 cases |
---|
| 7 | INTEGER i,j,k,l, ijk, jk |
---|
| 8 | c==================================================================== |
---|
| 9 | INTEGER ibase, ifact1, ifact2, ifact3 |
---|
| 10 | PARAMETER (ibase=36) |
---|
| 11 | PARAMETER (ifact1 = ibase-1) |
---|
| 12 | PARAMETER (ifact2 = ibase*ibase-1) |
---|
| 13 | PARAMETER (ifact3 = ibase*ibase*ibase-1) |
---|
| 14 | c==================================================================== |
---|
| 15 | CHARACTER*1 word1(0:ifact1) |
---|
| 16 | COMMON /elbat1/ word1 |
---|
| 17 | CHARACTER*2 word2(0:ifact2) |
---|
| 18 | COMMON /elbat2/ word2 |
---|
| 19 | CHARACTER*3 word3(0:ifact3) |
---|
| 20 | COMMON /elbat3/ word3 |
---|
| 21 | c==================================================================== |
---|
| 22 | CHARACTER*1 base(ibase) |
---|
| 23 | DATA (base(l),l=1,ibase) |
---|
| 24 | . /'0','1','2','3','4','5','6','7','8','9', |
---|
| 25 | . 'A','B','C','D','E','F','G','H','I','J', |
---|
| 26 | . 'K','L','M','N','O','P','Q','R','S','T', |
---|
| 27 | . 'U','V','W','X','Y','Z'/ |
---|
| 28 | c=================================================================== |
---|
| 29 | DO 30 i = 1, ibase |
---|
| 30 | DO 30 j = 1, ibase |
---|
| 31 | DO 30 k = 1, ibase |
---|
| 32 | ijk = ( (i-1)*ibase + j-1 )*ibase + k-1 |
---|
| 33 | word3(ijk) = base(i)//base(j)//base(k) |
---|
| 34 | 30 CONTINUE |
---|
| 35 | DO 20 j = 1, ibase |
---|
| 36 | DO 20 k = 1, ibase |
---|
| 37 | jk = (j-1)*ibase + k-1 |
---|
| 38 | word2(jk) = base(j)//base(k) |
---|
| 39 | 20 CONTINUE |
---|
| 40 | DO 10 k = 1, ibase |
---|
| 41 | word1(k-1) = base(k) |
---|
| 42 | 10 CONTINUE |
---|
| 43 | c=================================================================== |
---|
| 44 | RETURN |
---|
| 45 | END |
---|
| 46 | |
---|