home *** CD-ROM | disk | FTP | other *** search
/ Usenet 1994 January / usenetsourcesnewsgroupsinfomagicjanuary1994.iso / sources / misc / volume1 / 8710 / 14 / scale.f < prev    next >
Encoding:
Text File  |  1990-07-13  |  1.2 KB  |  51 lines
  1.       subroutine scale (array,axlen,npts,inc)
  2.     save
  3. c
  4. c               compute minimun and delta for line routine
  5. c
  6.       dimension  array(1),tst(7)
  7.       data tst / 1.0, 2.0, 4.0, 5.0, 8.0,  10.0, 20.0 /
  8.       fad = 0.01
  9.       k   = iabs(inc)
  10.       n   = npts*k
  11.       y0  = array(1)
  12.       yn  = y0
  13.       do 20 i = 1,n,k
  14.       ys = array(i)
  15.       if (y0.le.ys) go to 10
  16.       y0 = ys
  17.       go to 20
  18.    10 if (ys.gt.yn)  yn=ys
  19.    20 continue
  20.       firstv = y0
  21.       if (y0.lt.0.0) fad=fad-1.0
  22.       deltav =(yn-firstv)/ axlen
  23.       if (deltav.le.0.0) go to 70
  24.       i= alog10(deltav)+1000.0
  25.       p= 10.0**(i-1000)
  26.       deltav= deltav/p - 0.01
  27.       do 30 i = 1,6
  28.       is= i
  29.       if (tst(i).ge.deltav) go to 40
  30.    30 continue
  31.    40 deltav= tst(is)*p
  32.       firstv= deltav* aint(y0/deltav+fad)
  33.       t=firstv + (axlen+0.01)*deltav
  34.       if (t.ge.yn) go to 50
  35.       is= is+1
  36.       go to 40
  37.    50 firstv= firstv-aint((axlen+(firstv-yn)/deltav)/2.0) * deltav
  38.       if((y0*firstv).le.0.0)   firstv=0.0
  39.       if (inc.gt.0) go to 60
  40.       firstv= firstv + axlen*deltav
  41.       deltav= -deltav
  42.    60 n=n+1
  43.       array(n)= firstv
  44.       n= n+k
  45.       array(n)= deltav
  46.       return
  47.    70 deltav=1.0
  48.       firstv= firstv-0.5
  49.       go to 60
  50.       end
  51.