| 1 | SUBROUTINE from36(x,nbre,iunit) |
|---|
| 2 | IMPLICIT NONE |
|---|
| 3 | c==================================================================== |
|---|
| 4 | INTEGER iunit, nbre |
|---|
| 5 | REAL x(nbre) |
|---|
| 6 | c==================================================================== |
|---|
| 7 | INTEGER i, l |
|---|
| 8 | INTEGER nbreok, ibaseok, icase |
|---|
| 9 | REAL xmax, xmin, errcod |
|---|
| 10 | c==================================================================== |
|---|
| 11 | INTEGER lbord |
|---|
| 12 | PARAMETER (lbord=255) |
|---|
| 13 | REAL conv(0:lbord) |
|---|
| 14 | c==================================================================== |
|---|
| 15 | INTEGER ibase, maxcas, maxnbr, ifact1, ifact2, ifact3 |
|---|
| 16 | PARAMETER (ibase=36, maxcas=3, maxnbr=100000) |
|---|
| 17 | PARAMETER(ifact1=ibase**1-1) |
|---|
| 18 | PARAMETER(ifact2=ibase**2-1) |
|---|
| 19 | PARAMETER(ifact3=ibase**3-1) |
|---|
| 20 | CHARACTER*1 base(ibase), fac(maxcas,maxnbr) |
|---|
| 21 | INTEGER inte(maxcas) |
|---|
| 22 | DATA (base(l),l=1,ibase) |
|---|
| 23 | . /'0','1','2','3','4','5','6','7','8','9', |
|---|
| 24 | . 'A','B','C','D','E','F','G','H','I','J', |
|---|
| 25 | . 'K','L','M','N','O','P','Q','R','S','T', |
|---|
| 26 | . 'U','V','W','X','Y','Z'/ |
|---|
| 27 | c==================================================================== |
|---|
| 28 | IF (nbre .GT. maxnbr) THEN |
|---|
| 29 | PRINT*, 'Verifier maxnbr dans from36 (trop petite)' |
|---|
| 30 | STOP |
|---|
| 31 | ENDIF |
|---|
| 32 | DO 10 i = 0, lbord |
|---|
| 33 | 10 conv(i) = 1.0e+33 |
|---|
| 34 | c 34 c 10 conv(i) = 1.0e+49 |
|---|
| 35 | DO 20 i = 1, ibase |
|---|
| 36 | l = ICHAR(base(i)) |
|---|
| 37 | 20 conv(l) = FLOAT(i-1) |
|---|
| 38 | c==================================================================== |
|---|
| 39 | READ (iunit,*) nbreok, ibaseok, icase |
|---|
| 40 | IF (nbre .NE. nbreok) THEN |
|---|
| 41 | PRINT*, 'Incoherence (Nombre elements)', nbreok, nbre |
|---|
| 42 | STOP |
|---|
| 43 | ENDIF |
|---|
| 44 | IF (ibase .NE. ibaseok) THEN |
|---|
| 45 | PRINT*, 'Incoherence (Nombre base)', ibaseok, ibase |
|---|
| 46 | STOP |
|---|
| 47 | ENDIF |
|---|
| 48 | IF (icase.NE.1 .AND. icase.NE.2 .AND. icase.NE.3) THEN |
|---|
| 49 | PRINT*, 'Verifier icase (1,2,3) dans le fichier a lire', |
|---|
| 50 | . icase |
|---|
| 51 | STOP |
|---|
| 52 | ENDIF |
|---|
| 53 | c==================================================================== |
|---|
| 54 | READ (iunit,*) xmin |
|---|
| 55 | READ (iunit,*) xmax |
|---|
| 56 | PRINT*,'Xmin et Xmax=', xmin, xmax |
|---|
| 57 | c==================================================================== |
|---|
| 58 | IF (xmin .EQ. xmax) THEN |
|---|
| 59 | READ(iunit,'(a)') |
|---|
| 60 | PRINT*, 'Ce champ est constant' |
|---|
| 61 | DO 30 i = 1, nbre |
|---|
| 62 | 30 x(i) = xmin |
|---|
| 63 | GO TO 123 |
|---|
| 64 | END IF |
|---|
| 65 | c==================================================================== |
|---|
| 66 | IF (icase .EQ. 1) THEN |
|---|
| 67 | errcod = (xmax-xmin) / FLOAT(ifact1) |
|---|
| 68 | PRINT*,'La precision du codage est entre + / - ', errcod |
|---|
| 69 | READ(iunit,91)((fac(l,i),l=1,icase),i=1,nbre) |
|---|
| 70 | DO 190 i = 1, nbre |
|---|
| 71 | x(i) = 0.0 |
|---|
| 72 | DO 191 l = 1, icase |
|---|
| 73 | inte(l) = ICHAR( fac(l,i) ) |
|---|
| 74 | x(i) = x(i) + conv ( inte(l) ) * FLOAT( ibase**(icase-l) ) |
|---|
| 75 | 191 CONTINUE |
|---|
| 76 | x(i) = xmin + x(i)/FLOAT(ifact1)*(xmax-xmin) |
|---|
| 77 | 190 CONTINUE |
|---|
| 78 | ELSE IF (icase .EQ. 2) THEN |
|---|
| 79 | errcod = (xmax-xmin) / FLOAT(ifact2) |
|---|
| 80 | PRINT*,'La precision du codage est entre + / - ', errcod |
|---|
| 81 | READ(iunit,92)((fac(l,i),l=1,icase),i=1,nbre) |
|---|
| 82 | DO 290 i = 1, nbre |
|---|
| 83 | x(i) = 0.0 |
|---|
| 84 | DO 291 l = 1, icase |
|---|
| 85 | inte(l) = ICHAR( fac(l,i) ) |
|---|
| 86 | x(i) = x(i) + conv ( inte(l) ) * FLOAT( ibase**(icase-l) ) |
|---|
| 87 | 291 CONTINUE |
|---|
| 88 | x(i) = xmin + x(i)/float(ifact2)*(xmax-xmin) |
|---|
| 89 | 290 CONTINUE |
|---|
| 90 | ELSE IF (icase .EQ. 3) THEN |
|---|
| 91 | errcod = (xmax-xmin) / FLOAT(ifact3) |
|---|
| 92 | PRINT*,'La precision du codage est entre + / - ', errcod |
|---|
| 93 | READ(iunit,93)((fac(l,i),l=1,icase),i=1,nbre) |
|---|
| 94 | DO 390 i = 1, nbre |
|---|
| 95 | x(i) = 0.0 |
|---|
| 96 | DO 391 l = 1, icase |
|---|
| 97 | inte(l) = ICHAR( fac(l,i) ) |
|---|
| 98 | x(i) = x(i) + conv ( inte(l) ) * FLOAT( ibase**(icase-l) ) |
|---|
| 99 | 391 CONTINUE |
|---|
| 100 | x(i) = xmin + x(i)/FLOAT(ifact3)*(xmax-xmin) |
|---|
| 101 | 390 CONTINUE |
|---|
| 102 | ELSE |
|---|
| 103 | PRINT*, 'Verfier icase (1, 2 ou 3)' |
|---|
| 104 | STOP |
|---|
| 105 | ENDIF |
|---|
| 106 | 91 FORMAT(120a1) |
|---|
| 107 | 92 FORMAT(64(2a1)) |
|---|
| 108 | 93 FORMAT(40(3a1)) |
|---|
| 109 | c==================================================================== |
|---|
| 110 | 123 RETURN |
|---|
| 111 | END |
|---|
