C INIREE    SOURCE    PV        13/09/30    21:15:01     7828           
      SUBROUTINE INIREE
c*************************************************************
c  evalue xpetit et xgrand pour la machine
c  on veut pouvoir prendre l 'inverse de xpetit et xgrand
c*************************************************************
      IMPLICIT INTEGER(I-N)
      real*8 xre1,xre2, xzauxi,xii
      real *4 xsre1,xsre2,xsre3,xsauxi
      common/cinire/xre1,xre2,xzauxi,xsre1,xsre2,xsre3,xsauxi
-INC CCOPTIO
-INC CCREEL
-INC CCTRACE
c calcul xpetit
      xre1 = 1.
      do nexpo = 1,10000
        xre2 = xre1/10. 
        call gibtem(xii)
        if (xre2.eq.0.) goto 110
        xre1 = xre2 
      enddo
      moterr(1:6) = 'XPETIT'
      call erreur(907)
*      write(6,*) ' pas marche ', nexpo,xre1
      return

 110  continue
*     write(6,*) 'nexpo' , nexpo, xre1
      xpetit = xre1 * 1.e3
*     write(6,*) 'xpetit', xpetit

c calcul xgrand
      xre1 = 1.
      do nexpo = 1,10000
        xre2=xre1*10
        call gibtem(xii)
        if (.NOT.(xre2*10..gt.xre2)) goto 120
        xre1 = xre2
      enddo
*      write(6,*) ' pas marche ', nexpo,xre1
      moterr(1:6) = 'XGRAND'
      call erreur(907)
      return

 120  continue
*      write(6,*) 'nexpo' , nexpo, xre1
      xgrand = xre1 / 1.d3
*      write(6,*) 'xgrand', xgrand
c
c  pour pouvoir inverser  
      xzauxi = min(abs(log(xgrand)),abs(log(xpetit)))
*      write(6,*) xzauxi, abs(log(xgrand)) , abs(log(xpetit))
      if (abs(xzauxi - abs(log(xgrand))).lt.0.5) then
        xpetit = 1./xgrand
*        write(6,*) 'xpetit', xpetit, 1/xpetit, 1/xgrand
      else
        xgrand = 1./xpetit
*        write(6,*) 'xgrand ' , xgrand, 1/xpetit, 1/xgrand
      endif

c calcul xspeti
      xsre1 = 1.
      do nexpo = 1,315
          xsre2 = xsre1/10. 
          xsre3 = xsre2/10.
          call gibtem(xii)
*         if (nexpo.gt.40) write(6,*) (b/a)
         if (xsre2/xsre3.gt.9.999) then
          xsre1=xsre2
         else
           goto 130
         endif
      enddo
       goto 130
*      write(6,*) ' pas marche ', nexpo,xsre1
      moterr(1:6) = 'XSPETI'
      call erreur(907)
      return

 130  continue
*      write(6,*) 'nexpo' , nexpo, xsre1
      xspeti = xsre1 * 100
*      write(6,*) 'xspeti', xspeti

c calcul xsgran
      xsre1 = 1.
      do nexpo = 1,315
          xsre2 = xsre1*10.
          xsre3 = xsre2*10.
          call gibtem(xii)
*          if (nexpo.gt.30) write(6,*) a, (b.gt.a)
        if (xsre3.gt.xsre2) then
        xsre1 = xsre2
          else
        goto 140
       endif
      enddo
      goto 140
      moterr(1:6) = 'XSGRAN'
      call erreur(907)
*      write(6,*) ' pas marche ', nexpo,xsre1
      return

 140  continue
*       write(6,*) 'nexpo' , nexpo, xsre1
       xsgran = xsre1/1000 
*       write(6,*) 'xsgran', xsgran
       amplit=xsgran
c  pour pouvoir inverser  
      xsauxi = min(abs(log(xsgran)),abs(log(xspeti)))
*       write(6,*) xsauxi, abs(log(xsgran)) , abs(log(xspeti))
      if (abs(xsauxi - abs(log(xsgran))).lt.0.5) then
        xspeti = 1./xsgran
*         write(6,*) 'xspeti', xspeti, 1/xspeti, 1/xsgran
      else
        xsgran = 1./xspeti
*        write(6,*) 'xsgran ' , xsgran, 1/xspeti, 1/xsgran
      endif

c calcul xzprec , 
      xre1 = 1.
      do nexpol = 1,10000
        xre2=1.d0+xre1/10.
        call gibtem(xii)
        if (xre2.le.1.) goto 150
        xre1 = xre2-1.d0
      enddo
      moterr(1:6) = 'XZPREC'
      call erreur(907)
*      write(6,*) ' pas marche ', nexpo,xre1
      return

 150  continue
*      write(6,*) 'nexpo' , nexpo, xre1
      xzprec = xre1 
*      write(6,*) 'xzprec', xzprec

c calcul xszpre , 
      xsre1 = 1.
      do nexpo = 1,10000
        xsre2=1.e0+xsre1/10. 
        call gibtem(xii)
        if (xsre2.le.1.) goto 160
        xsre1 = xsre2-1e0
      enddo
      moterr(1:6) = 'XSZPRE'
      call erreur(907)
*      write(6,*) ' pas marche ', nexpo,xsre1
      return

 160  continue
*      write(6,*) 'nexpo' , nexpo, xsre1
      xszpre = xsre1
*      write(6,*) 'xszpre', xszpre
      return
     
      END