*=*=*=*= from36.html =*=*=*=*
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