/* getmx.f -- translated by f2c (version of 3 February 1990  3:36:42).
   You must link the resulting object file with the libraries:
	-lF77 -lI77 -lm -lc   (in that order)
*/

#include "f2c.h"

/* Common Block Declarations */

struct {
    doublereal cpyknt;
    integer istack[1], lorg, icore, maxcor, maxuse, memavl, ldval, numblk, 
	    loctab, ltab, ifwa, nwoff, ntab, maxmem, memerr, nwd4, nwd8, 
	    nwd16;
} memmgr_;

#define memmgr_1 memmgr_

/* Table of constant values */

static integer c__3 = 3;
static integer c__0 = 0;

/*<       subroutine getmx(ipntr,ksize,iwsize) >*/
/* Subroutine */ int getmx_(ipntr, ksize, iwsize)
integer *ipntr, *ksize, *iwsize;
{
    static integer need, madr;
    extern integer locf_();
    static integer morg, muse, msiz, ltab1;
    extern /* Subroutine */ int copy4_();
    static integer isize, jsize;
    extern /* Subroutine */ int memadj_(), errmem_(), comprs_();
    extern logical memptr_();
    extern integer nxtmem_();
    extern /* Subroutine */ int memory_();
    static integer nwords;
    extern integer nxtevn_();

    /* Parameter adjustments */
    --ipntr;

    /* Function Body */
/*<       implicit double precision (a-h,o-z) >*/
/* spice version 2g.6  sccsid=memmgr 3/15/83 */
/*<       common /memmgr/ cpyknt,istack(1),lorg,icore,maxcor,maxuse,memavl, >*/
/*<      1   ldval,numblk,loctab,ltab,ifwa,nwoff,ntab,maxmem,memerr,nwd4, >*/
/*<      2   nwd8,nwd16 >*/
/*<       logical memptr >*/
/*<       dimension ipntr(1) >*/

/* ***  getmem - get block */


/*<       isize=ksize*iwsize >*/
    isize = *ksize * *iwsize;
/* ...  check for valid size */
/*<       if (isize.ge.0) go to 5 >*/
    if (isize >= 0) {
	goto L5;
    }
/*<       memerr=2 >*/
    memmgr_1.memerr = 2;
/*<       call errmem(3,memerr,ipntr(1)) >*/
    errmem_(&c__3, &memmgr_1.memerr, &ipntr[1]);
/* ...  check for attempt to reallocate existing block */
/*<     5 if (.not.memptr(ipntr(1))) go to 8 >*/
L5:
    if (! memptr_(&ipntr[1])) {
	goto L8;
    }
/*<       memerr=3 >*/
    memmgr_1.memerr = 3;
/*<       call errmem(3,memerr,ipntr(1)) >*/
    errmem_(&c__3, &memmgr_1.memerr, &ipntr[1]);
/*<     8 jsize=nxtevn(isize) >*/
L8:
    jsize = nxtevn_(&isize);
/*<       call comprs(0,ldval) >*/
    comprs_(&c__0, &memmgr_1.ldval);
/* ...  check if enough space already there */
/*<       need=jsize+ntab-memavl >*/
    need = jsize + memmgr_1.ntab - memmgr_1.memavl;
/*<       if (need.le.0) go to 10 >*/
    if (need <= 0) {
	goto L10;
    }
/* ...  insufficient space -- bump memory size */
/*<       need=nxtmem(need) >*/
    need = nxtmem_(&need);
/*<       icore=icore+need >*/
    memmgr_1.icore += need;
/*<       call memory >*/
    memory_();
/*<       if(memerr.ne.0) call errmem(3,memerr,ipntr(1)) >*/
    if (memmgr_1.memerr != 0) {
	errmem_(&c__3, &memmgr_1.memerr, &ipntr[1]);
    }
/*<       ltab1=ldval-ntab >*/
    ltab1 = memmgr_1.ldval - memmgr_1.ntab;
/*<       istack(ltab1+2)=istack(ltab1+2)+need >*/
    memmgr_1.istack[ltab1 + 1] += need;
/* ...  relocate block entry table */
/*<       nwords=numblk*ntab >*/
    nwords = memmgr_1.numblk * memmgr_1.ntab;
/*<       cpyknt=cpyknt+dble(nwords) >*/
    memmgr_1.cpyknt += (doublereal) nwords;
/*<       call copy4(istack(loctab+1),istack(loctab+need+1),nwords) >*/
    copy4_(&memmgr_1.istack[memmgr_1.loctab], &memmgr_1.istack[
	    memmgr_1.loctab + need], &nwords);
/*<       loctab=loctab+need >*/
    memmgr_1.loctab += need;
/*<       ldval=ldval+need >*/
    memmgr_1.ldval += need;
/*<       memavl=memavl+need >*/
    memmgr_1.memavl += need;
/* ...  a block large enough now exists -- allocate it */
/*<    10 ltab1=ldval-ntab >*/
L10:
    ltab1 = memmgr_1.ldval - memmgr_1.ntab;
/*<       morg=istack(ltab1+1) >*/
    morg = memmgr_1.istack[ltab1];
/*<       msiz=istack(ltab1+2) >*/
    msiz = memmgr_1.istack[ltab1 + 1];
/*<       muse=istack(ltab1+3) >*/
    muse = memmgr_1.istack[ltab1 + 2];
/*<       muse=nxtevn(muse) >*/
    muse = nxtevn_(&muse);
/*<       madr=istack(ltab1+4) >*/
    madr = memmgr_1.istack[ltab1 + 3];
/* ...  construct new table entry */
/*<    15 istack(ltab1+2)=muse >*/
/* L15: */
    memmgr_1.istack[ltab1 + 1] = muse;
/*<       loctab=loctab-ntab >*/
    memmgr_1.loctab -= memmgr_1.ntab;
/*<       nwords=numblk*ntab >*/
    nwords = memmgr_1.numblk * memmgr_1.ntab;
/*<       cpyknt=cpyknt+dble(nwords) >*/
    memmgr_1.cpyknt += (doublereal) nwords;
/*<       call copy4(istack(loctab+ntab+1),istack(loctab+1),nwords) >*/
    copy4_(&memmgr_1.istack[memmgr_1.loctab + memmgr_1.ntab], &
	    memmgr_1.istack[memmgr_1.loctab], &nwords);
/*<       numblk=numblk+1 >*/
    ++memmgr_1.numblk;
/*<       memavl=memavl-ntab >*/
    memmgr_1.memavl -= memmgr_1.ntab;
/*<       istack(ltab1+1)=morg+muse >*/
    memmgr_1.istack[ltab1] = morg + muse;
/*<       istack(ltab1+2)=msiz-muse-ntab >*/
    memmgr_1.istack[ltab1 + 1] = msiz - muse - memmgr_1.ntab;
/* ...  set user size into table entry for this block */
/*<    20 istack(ltab1+3)=isize >*/
/* L20: */
    memmgr_1.istack[ltab1 + 2] = isize;
/*<       istack(ltab1+4)=locf(ipntr(1)) >*/
    memmgr_1.istack[ltab1 + 3] = locf_(&ipntr[1]);
/*<       istack(ltab1+5)=iwsize >*/
    memmgr_1.istack[ltab1 + 4] = *iwsize;
/*<       istack(ltab1+6)=0 >*/
    memmgr_1.istack[ltab1 + 5] = 0;
/*<       memavl=memavl-jsize >*/
    memmgr_1.memavl -= jsize;
/*<       ipntr(1)=istack(ltab1+1)/iwsize >*/
    ipntr[1] = memmgr_1.istack[ltab1] / *iwsize;
/*<       call memadj >*/
    memadj_();
/*<       return >*/
    return 0;
/*<       end >*/
} /* getmx_ */

