home *** CD-ROM | disk | FTP | other *** search
/ Complete Linux / Complete Linux.iso / docs / apps / circuits / spice2g6.z / spice2g6 / spice / Fortran / getmx.f < prev    next >
Encoding:
Text File  |  1989-02-03  |  2.0 KB  |  68 lines
  1.       subroutine getmx(ipntr,ksize,iwsize)
  2.       implicit double precision (a-h,o-z)
  3. c spice version 2g.6  sccsid=memmgr 3/15/83
  4.       common /memmgr/ cpyknt,istack(1),lorg,icore,maxcor,maxuse,memavl,
  5.      1   ldval,numblk,loctab,ltab,ifwa,nwoff,ntab,maxmem,memerr,nwd4,
  6.      2   nwd8,nwd16
  7.       logical memptr
  8.       dimension ipntr(1)
  9. c
  10. c***  getmem - get block
  11. c
  12. c
  13.       isize=ksize*iwsize
  14. c...  check for valid size
  15.       if (isize.ge.0) go to 5
  16.       memerr=2
  17.       call errmem(3,memerr,ipntr(1))
  18. c...  check for attempt to reallocate existing block
  19.     5 if (.not.memptr(ipntr(1))) go to 8
  20.       memerr=3
  21.       call errmem(3,memerr,ipntr(1))
  22.     8 jsize=nxtevn(isize)
  23.       call comprs(0,ldval)
  24. c...  check if enough space already there
  25.       need=jsize+ntab-memavl
  26.       if (need.le.0) go to 10
  27. c...  insufficient space -- bump memory size
  28.       need=nxtmem(need)
  29.       icore=icore+need
  30.       call memory
  31.       if(memerr.ne.0) call errmem(3,memerr,ipntr(1))
  32.       ltab1=ldval-ntab
  33.       istack(ltab1+2)=istack(ltab1+2)+need
  34. c...  relocate block entry table
  35.       nwords=numblk*ntab
  36.       cpyknt=cpyknt+dble(nwords)
  37.       call copy4(istack(loctab+1),istack(loctab+need+1),nwords)
  38.       loctab=loctab+need
  39.       ldval=ldval+need
  40.       memavl=memavl+need
  41. c...  a block large enough now exists -- allocate it
  42.    10 ltab1=ldval-ntab
  43.       morg=istack(ltab1+1)
  44.       msiz=istack(ltab1+2)
  45.       muse=istack(ltab1+3)
  46.       muse=nxtevn(muse)
  47.       madr=istack(ltab1+4)
  48. c...  construct new table entry
  49.    15 istack(ltab1+2)=muse
  50.       loctab=loctab-ntab
  51.       nwords=numblk*ntab
  52.       cpyknt=cpyknt+dble(nwords)
  53.       call copy4(istack(loctab+ntab+1),istack(loctab+1),nwords)
  54.       numblk=numblk+1
  55.       memavl=memavl-ntab
  56.       istack(ltab1+1)=morg+muse
  57.       istack(ltab1+2)=msiz-muse-ntab
  58. c...  set user size into table entry for this block
  59.    20 istack(ltab1+3)=isize
  60.       istack(ltab1+4)=locf(ipntr(1))
  61.       istack(ltab1+5)=iwsize
  62.       istack(ltab1+6)=0
  63.       memavl=memavl-jsize
  64.       ipntr(1)=istack(ltab1+1)/iwsize
  65.       call memadj
  66.       return
  67.       end
  68.