      subroutine lireel1(question,iopt,reel1)
c
      character*(*) question
      character*32  c
      real*4 reel1
c
 1000 call print_moi_ca(question,iopt)
c
      read(*,*,err=1000) reel1
      if (iopt.gt.0) then
        call reduitreel1(reel1,c,l,5)
        ll = len(question)
        write(iopt,'(a,a)') c(1:l)//char(9)//'# ',question(1:ll)
      endif
      end
c-----------------------------------------------------------------------
      subroutine reduitreel1(x,c,l,itab)
      character*32 c,cc,blanc
      data blanc / '                               ' /
c
      nc = 18
      xx = abs(x)
      if (xx.gt.1.d-04.and.xx.lt.1.d6) then
        write(cc,'(g18.7)') x
      else
        write(cc,'(g18.7)') x
      endif
      iexp = 0
      ideb = 0
      ideb2 = 0
      do i=1,nc
        ic = ichar(cc(i:i))
        if (ic.eq.32) then
          if (ideb.eq.0) ideb2 = i
        else
          ideb = 1
          if (iexp.eq.0) then
            if ((ic.lt.48.and.ic.ne.45.and.ic.ne.46).or.ic.gt.57)
     &           iexp = i
          endif
        endif
      enddo
      ideb2 = ideb2+1
      izz = 0
      if (iexp.eq.0) then
        izero = 48
      else
        izero = 32
        iz = 0
        do i=iexp-1,1,-1
          if (iz.eq.0) then
            if (cc(i:i).eq.'0') then
              izz = izz+1
            else
              iz = 1
            endif
          endif
        enddo
      endif
      ideb = 0
      ifin = nc+1
      do i=nc,ideb2,-1
        ic = ichar(cc(i:i))
        if (ic.eq.32.or.ic.eq.izero) then
          if (ideb.eq.0) ifin = i
        else
          ideb = 1
        endif
      enddo
      ifin = ifin-1
c
      l = ifin-ideb2+1-izz
      if (iexp.gt.0.and.izz.gt.0) then
        c(1:l) = cc(ideb2:iexp-1-izz)//cc(iexp:ifin)
      else
        c(1:l) = cc(ideb2:ifin)
      endif
c
      if (itab.gt.0) then
        if (l.lt.itab) then
          c(1:itab) = blanc(1:itab-l)//c(1:l)
          l = itab
        elseif(l.gt.itab.and.l.lt.itab*2) then
          c(1:itab*2) = blanc(1:itab*2-l)//c(1:l)
          l = itab*2
        elseif(l.gt.itab*2.and.l.lt.itab*3) then
          c(1:itab*3) = blanc(1:itab*3-l)//c(1:l)
          l = itab*3
        elseif(l.gt.itab*3.and.l.lt.itab*4) then
          c(1:itab*4) = blanc(1:itab*4-l)//c(1:l)
          l = itab*4
        endif
      endif
      end
