Esope source files

   1 : C INIREE    SOURCE    PV        13/09/30    21:15:01     7828           
   2 :       SUBROUTINE INIREE
   3 : c*************************************************************
   4 : c  evalue xpetit et xgrand pour la machine
   5 : c  on veut pouvoir prendre l 'inverse de xpetit et xgrand
   6 : c*************************************************************
   7 :       IMPLICIT INTEGER(I-N)
   8 :       real*8 xre1,xre2, xzauxi,xii
   9 :       real *4 xsre1,xsre2,xsre3,xsauxi
  10 :       common/cinire/xre1,xre2,xzauxi,xsre1,xsre2,xsre3,xsauxi
  11 : -INC CCOPTIO
  12 : -INC CCREEL
  13 : -INC CCTRACE
  14 : c calcul xpetit
  15 :       xre1 = 1.
  16 :       do nexpo = 1,10000
  17 :         xre2 = xre1/10. 
  17 :         call gibtem(xii)
  18 :         if (xre2.eq.0.) goto 110
  19 :         xre1 = xre2 
  20 :       enddo
  21 :       moterr(1:6) = 'XPETIT'
  21 :       call erreur(907)
  22 : *      write(6,*) ' pas marche ', nexpo,xre1
  23 :       return
  24 : 
  25 :  110  continue
  26 : *     write(6,*) 'nexpo' , nexpo, xre1
  27 :       xpetit = xre1 * 1.e3
  28 : *     write(6,*) 'xpetit', xpetit
  29 : 
  30 : c calcul xgrand
  31 :       xre1 = 1.
  32 :       do nexpo = 1,10000
  33 :         xre2=xre1*10
  33 :         call gibtem(xii)
  34 :         if (.NOT.(xre2*10..gt.xre2)) goto 120
  35 :         xre1 = xre2
  36 :       enddo
  37 : *      write(6,*) ' pas marche ', nexpo,xre1
  38 :       moterr(1:6) = 'XGRAND'
  38 :       call erreur(907)
  39 :       return
  40 : 
  41 :  120  continue
  42 : *      write(6,*) 'nexpo' , nexpo, xre1
  43 :       xgrand = xre1 / 1.d3
  44 : *      write(6,*) 'xgrand', xgrand
  45 : c
  46 : c  pour pouvoir inverser  
  47 :       xzauxi = min(abs(log(xgrand)),abs(log(xpetit)))
  48 : *      write(6,*) xzauxi, abs(log(xgrand)) , abs(log(xpetit))
  49 :       if (abs(xzauxi - abs(log(xgrand))).lt.0.5) then
  50 :         xpetit = 1./xgrand
  51 : *        write(6,*) 'xpetit', xpetit, 1/xpetit, 1/xgrand
  52 :       else
  53 :         xgrand = 1./xpetit
  54 : *        write(6,*) 'xgrand ' , xgrand, 1/xpetit, 1/xgrand
  55 :       endif
  56 : 
  57 : c calcul xspeti
  58 :       xsre1 = 1.
  59 :       do nexpo = 1,315
  60 :           xsre2 = xsre1/10. 
  61 :           xsre3 = xsre2/10.
  61 :           call gibtem(xii)
  62 : *         if (nexpo.gt.40) write(6,*) (b/a)
  63 :          if (xsre2/xsre3.gt.9.999) then
  64 :           xsre1=xsre2
  65 :          else
  66 :            goto 130
  67 :          endif
  68 :       enddo
  69 :        goto 130
  70 : *      write(6,*) ' pas marche ', nexpo,xsre1
  71 :       moterr(1:6) = 'XSPETI'
  71 :       call erreur(907)
  72 :       return
  73 : 
  74 :  130  continue
  75 : *      write(6,*) 'nexpo' , nexpo, xsre1
  76 :       xspeti = xsre1 * 100
  77 : *      write(6,*) 'xspeti', xspeti
  78 : 
  79 : c calcul xsgran
  80 :       xsre1 = 1.
  81 :       do nexpo = 1,315
  82 :           xsre2 = xsre1*10.
  83 :           xsre3 = xsre2*10.
  83 :           call gibtem(xii)
  84 : *          if (nexpo.gt.30) write(6,*) a, (b.gt.a)
  85 :         if (xsre3.gt.xsre2) then
  86 :         xsre1 = xsre2
  87 :           else
  88 :         goto 140
  89 :        endif
  90 :       enddo
  91 :       goto 140
  92 :       moterr(1:6) = 'XSGRAN'
  92 :       call erreur(907)
  93 : *      write(6,*) ' pas marche ', nexpo,xsre1
  94 :       return
  95 : 
  96 :  140  continue
  97 : *       write(6,*) 'nexpo' , nexpo, xsre1
  98 :        xsgran = xsre1/1000 
  99 : *       write(6,*) 'xsgran', xsgran
 100 :        amplit=xsgran
 101 : c  pour pouvoir inverser  
 102 :       xsauxi = min(abs(log(xsgran)),abs(log(xspeti)))
 103 : *       write(6,*) xsauxi, abs(log(xsgran)) , abs(log(xspeti))
 104 :       if (abs(xsauxi - abs(log(xsgran))).lt.0.5) then
 105 :         xspeti = 1./xsgran
 106 : *         write(6,*) 'xspeti', xspeti, 1/xspeti, 1/xsgran
 107 :       else
 108 :         xsgran = 1./xspeti
 109 : *        write(6,*) 'xsgran ' , xsgran, 1/xspeti, 1/xsgran
 110 :       endif
 111 : 
 112 : c calcul xzprec , 
 113 :       xre1 = 1.
 114 :       do nexpol = 1,10000
 115 :         xre2=1.d0+xre1/10.
 115 :         call gibtem(xii)
 116 :         if (xre2.le.1.) goto 150
 117 :         xre1 = xre2-1.d0
 118 :       enddo
 119 :       moterr(1:6) = 'XZPREC'
 119 :       call erreur(907)
 120 : *      write(6,*) ' pas marche ', nexpo,xre1
 121 :       return
 122 : 
 123 :  150  continue
 124 : *      write(6,*) 'nexpo' , nexpo, xre1
 125 :       xzprec = xre1 
 126 : *      write(6,*) 'xzprec', xzprec
 127 : 
 128 : c calcul xszpre , 
 129 :       xsre1 = 1.
 130 :       do nexpo = 1,10000
 131 :         xsre2=1.e0+xsre1/10. 
 131 :         call gibtem(xii)
 132 :         if (xsre2.le.1.) goto 160
 133 :         xsre1 = xsre2-1e0
 134 :       enddo
 135 :       moterr(1:6) = 'XSZPRE'
 135 :       call erreur(907)
 136 : *      write(6,*) ' pas marche ', nexpo,xsre1
 137 :       return
 138 : 
 139 :  160  continue
 140 : *      write(6,*) 'nexpo' , nexpo, xsre1
 141 :       xszpre = xsre1
 142 : *      write(6,*) 'xszpre', xszpre
 143 :       return
 144 :      
 145 :       END 
 146 :  
 147 : 
 148 :  
 149 :  
 150 :  
 151 :  
 152 :  
 153 :  
 154 :  
 155 :  
 156 :