*=*=*=*= from36.html =*=*=*=*
SUBROUTINE from36

SUBROUTINE from36


      SUBROUTINE from36(x,nbre,iunit)
      IMPLICIT NONE
c====================================================================
      INTEGER iunit, nbre
      REAL x(nbre)
c====================================================================
      INTEGER i, l
      INTEGER nbreok, ibaseok, icase
      REAL xmax, xmin, errcod
c====================================================================
      INTEGER lbord
      PARAMETER (lbord=255)
      REAL conv(0:lbord)
c====================================================================
      INTEGER ibase, maxcas, maxnbr, ifact1, ifact2, ifact3
      PARAMETER (ibase=36, maxcas=3, maxnbr=100000)
      PARAMETER(ifact1=ibase**1-1)
      PARAMETER(ifact2=ibase**2-1)
      PARAMETER(ifact3=ibase**3-1)
      CHARACTER*1 base(ibase), fac(maxcas,maxnbr)
      INTEGER inte(maxcas)
      DATA (base(l),l=1,ibase)
     .     /'0','1','2','3','4','5','6','7','8','9',
     .      'A','B','C','D','E','F','G','H','I','J',
     .      'K','L','M','N','O','P','Q','R','S','T',
     .      'U','V','W','X','Y','Z'/
c====================================================================
      IF (nbre .GT. maxnbr) THEN
      PRINT*, 'Verifier maxnbr dans from36 (trop petite)'
      STOP
      ENDIF
      DO 10 i = 0, lbord
   10 conv(i) = 1.0e+33
c    34  c  10 conv(i) = 1.0e+49
      DO 20 i = 1, ibase
      l = ICHAR(base(i))
   20 conv(l) = FLOAT(i-1)
c====================================================================
      READ (iunit,*) nbreok, ibaseok, icase
        IF (nbre .NE. nbreok) THEN
          PRINT*, 'Incoherence (Nombre elements)', nbreok, nbre
          STOP
        ENDIF
        IF (ibase .NE. ibaseok) THEN
          PRINT*, 'Incoherence (Nombre base)', ibaseok, ibase
          STOP
        ENDIF
        IF (icase.NE.1 .AND. icase.NE.2 .AND. icase.NE.3) THEN
          PRINT*, 'Verifier icase (1,2,3) dans le fichier a lire',
     .             icase
          STOP
        ENDIF
c====================================================================
      READ (iunit,*) xmin
      READ (iunit,*) xmax
        PRINT*,'Xmin et Xmax=', xmin, xmax
c====================================================================
      IF (xmin .EQ. xmax) THEN
        READ(iunit,'(a)')
        PRINT*, 'Ce champ est constant'
        DO 30 i = 1, nbre
   30   x(i) = xmin
        GO TO 123
      END IF
c====================================================================
      IF (icase .EQ. 1) THEN
        errcod = (xmax-xmin) / FLOAT(ifact1)
        PRINT*,'La precision du codage est entre + / - ', errcod
        READ(iunit,91)((fac(l,i),l=1,icase),i=1,nbre)
        DO 190 i = 1, nbre
        x(i) = 0.0
        DO 191 l = 1, icase
        inte(l) = ICHAR( fac(l,i) )
        x(i) = x(i) + conv ( inte(l) ) * FLOAT( ibase**(icase-l) )
  191   CONTINUE
        x(i) = xmin + x(i)/FLOAT(ifact1)*(xmax-xmin)
  190   CONTINUE
      ELSE IF (icase .EQ. 2) THEN
        errcod = (xmax-xmin) / FLOAT(ifact2)
        PRINT*,'La precision du codage est entre + / - ', errcod
        READ(iunit,92)((fac(l,i),l=1,icase),i=1,nbre)
        DO 290 i = 1, nbre
        x(i) = 0.0
        DO 291 l = 1, icase
        inte(l) = ICHAR( fac(l,i) )
        x(i) = x(i) + conv ( inte(l) ) * FLOAT( ibase**(icase-l) )
  291   CONTINUE
        x(i) = xmin + x(i)/float(ifact2)*(xmax-xmin)
  290   CONTINUE
      ELSE IF (icase .EQ. 3) THEN
        errcod = (xmax-xmin) / FLOAT(ifact3)
        PRINT*,'La precision du codage est entre + / - ', errcod
        READ(iunit,93)((fac(l,i),l=1,icase),i=1,nbre)
        DO 390 i = 1, nbre
        x(i) = 0.0
        DO 391 l = 1, icase
        inte(l) = ICHAR( fac(l,i) )
        x(i) = x(i) + conv ( inte(l) ) * FLOAT( ibase**(icase-l) )
  391   CONTINUE
        x(i) = xmin + x(i)/FLOAT(ifact3)*(xmax-xmin)
  390   CONTINUE
      ELSE
        PRINT*, 'Verfier icase (1, 2 ou 3)'
        STOP
      ENDIF
   91 FORMAT(120a1)
   92 FORMAT(64(2a1))
   93 FORMAT(40(3a1))
c====================================================================
  123 RETURN
      END