/* setmem.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 value[200000];
} blank_;

#define blank_1 blank_

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__1 = 1;
static integer c__6 = 6;

/*<       subroutine setmem(ipntr,ksize) >*/
/* Subroutine */ int setmem_(ipntr, ksize)
integer *ipntr, *ksize;
{
    /* Local variables */
    extern integer locf_();
    static integer nevn, icheck, ifamwa;
#define cvalue ((complex *)&blank_1)
    extern /* Subroutine */ int errmem_();
    extern integer nxtmem_();
    extern /* Subroutine */ int memory_();
    extern integer nxtevn_();

    /* Parameter adjustments */
    --ipntr;

    /* Function Body */
/*<       implicit double precision (a-h,o-z) >*/

/*     this routine performs dynamic memory management.  it is used in */
/*     spice2, and useable in any program. */

/*     memory is managed within an array selected by the calling program. 
*/
/*     one may either dimension this array to the 'maxmem' size, or more 
*/
/*     desirably, find the address of the first available word of memory 
*/
/*     above your program, and dimension your array to '1'.  passing the 
*/
/*     address of the first data word available permits the manager to */
/*     use 'illegal' indices into the data area. */

/*     this routine must have access to an integer function called 'locf' 
*/
/*    which returns the address of its argument.  addresses as used by 
this*/
/*     program refer to 'integer' addresses, not byte addresses. */

/* entry points: */
/*      setmem - set initial memory */
/*      getm4  - get block for table of integers */
/*      getm8  - get block for table of floating point variables */
/*      getm16 - get block for table of complex variables */
/*      relmem - release part of block */
/*      extmem - extend size of existing block */
/*      sizmem - determine size of existing block */
/*      clrmem - release block */
/*      ptrmem - reset memory pointer */
/*      crunch - force memory compaction */
/*      avlm4  - amount of space available (integers) */
/*      avlm8  - amount of space available (real) */
/*      avlm16 - amount of space available (complex) */

/* calling sequences: */
/*      call setmem(imem(1),maxmem) */
/*      call setmem(imem(1),maxmem,kfamwa)  cdc machines running under */
/*                                         calidoscope kfamwa is the 
address*/
/*                                          of the first available word */

/*      call getm4 (ipntr,blksiz)  where blksize is the number of entries 
*/
/*      call getm8 (ipntr,blksiz) */
/*      call getm16(ipntr,blksiz) */
/*      call relmem(ipntr,relsiz) */
/*     call extmem(ipntr,extsiz)  extsiz is the number of entries to be 
added*/
/*      call sizmem(ipntr,blksiz) */
/*      call clrmem(ipntr) */
/*      call ptrmem(ipntr1,ipntr2) */
/*      call avlm4(ispace) */
/*      call avlm8(ispace) */
/*      call avlm16(ispace) */
/*      call crunch */
/*     call slpmem(ipntr,slpsiz)  express desire for *slpsiz* extra 
entries*/


/* general comments: */
/*     for each block which is allocated, a multi-word entry is 
maintained*/
/* in a table kept in high memory, of the form */

/*        word      contents */
/*        ----      -------- */

/*          1       index of imem(.) into origin of block */
/*                    i.e. contents of pointer (used for error check) */
/*          2       block size (in words) */
/*          3       number of words in use */
/*          4       address of variable containing block origin */
/*          5       number of words used per table entry */
/*          6       slop size (in words) */

/*     all allocated blocks are an 'even' (nxtevn) number of words in 
length,*/
/* where a 'word' is the storage unit required for an 'integer' variable. 
*/
/*      since block repositioning may be necessary, the convention that */

/* only one variable contain a block origin should be observed. */
/*      for *getmem*, *ipntr* is set such that *array(ipntr+1)* is the */
/* first word of the allocated block.  'ipntr' is set to address the 
first */
/* entry of the table when used with the appropriate variable type, i.e., 
*/
/* nodplc(ipntr+1), value(ipntr+1), or cvalue(ipntr+1). */
/*     for *clrmem*, *ipntr* is set to 'invalid' to enable rapid 
detection*/
/* of an attempt to use a cleared block. */
/*      if any fatal errors are found, a message is printed and a flag */
/* set inhibiting further action until *setmem* is called.  (in this */
/* context, insufficient memory is considered a fatal error.) */
/*      throughout this routine, *ldval* always contains the subscript of 
*/
/* the last addressable word of memory, *memavl* always contains the */
/* number of available words of memory, *numblk* always contains the */
/* number of allocated blocks, and istack(*loctab* +1) always contains */
/* the first word of the block table. */

/* spice version 2g.6  sccsid=blank 3/15/83 */
/*<       common /blank/ value(200000) >*/
/* 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 >*/
/*<       dimension ipntr(1) >*/

/*<       logical memptr >*/
/*<       complex cvalue(32) >*/
/*<       equivalence (value(1),cvalue(1)) >*/
/*<       external locf >*/

/* ...  approximate time required to copy *nwords* integer values */

/*  nxtevn rounds the number up to the next 'even' value.  the value */
/*  used for this 'even' number is the smallest number into which one */
/*  can divide nwd4,nwd8,and nwd16. */


/*  nxtmem  returns next higher memory size */



/* ***  setmem - set initial memory */

/*<       nwd4=1 >*/
    memmgr_1.nwd4 = 1;
/*<       nwd8=locf(value(2))-locf(value(1)) >*/
    memmgr_1.nwd8 = locf_(&blank_1.value[1]) - locf_(blank_1.value);
/*<       nwd16=locf(cvalue(2))-locf(cvalue(1)) >*/
    memmgr_1.nwd16 = locf_(&cvalue[1]) - locf_(cvalue);
/*<       memerr=0 >*/
    memmgr_1.memerr = 0;
/*<       nevn=nxtevn(1) >*/
    nevn = nxtevn_(&c__1);
/*     check that nxtevn function returns a number divisible by */
/*     nwd4, nwd8, nwd16; also check that the memory increment */
/*     nxtmem(.) is an integer multiple of nxtevn(1) */
/*<       icheck=mod(nevn,nwd4)+mod(nevn,nwd8)+mod(nevn,nwd16)+ >*/
/*<      1  mod(nxtmem(1),nevn) >*/
    icheck = nevn % memmgr_1.nwd4 + nevn % memmgr_1.nwd8 + nevn % 
	    memmgr_1.nwd16 + nxtmem_(&c__1) % nevn;
/*<       if(icheck.eq.0) go to 2 >*/
    if (icheck == 0) {
	goto L2;
    }
/*<       memerr=1 >*/
    memmgr_1.memerr = 1;
/*<       call errmem(6,memerr,ipntr(1)) >*/
    errmem_(&c__6, &memmgr_1.memerr, &ipntr[1]);
/*<     2 cpyknt=0.0d0 >*/
L2:
    memmgr_1.cpyknt = 0.;
/*<       ifamwa=locf(ipntr(1)) >*/
    ifamwa = locf_(&ipntr[1]);
/*<       maxmem=ksize >*/
    memmgr_1.maxmem = *ksize;
/*<       ntab=nxtevn(6) >*/
    memmgr_1.ntab = nxtevn_(&c__6);
/*... add 'lorg' to an address and you get the 'istack' index to that 
word*/
/*<       lorg=1-locf(istack(1)) >*/
    memmgr_1.lorg = 1 - locf_(memmgr_1.istack);
/*<       ifwa=ifamwa+lorg-1 >*/
    memmgr_1.ifwa = ifamwa + memmgr_1.lorg - 1;
/*<       nwoff=locf(ipntr(1))+lorg-1 >*/
    memmgr_1.nwoff = locf_(&ipntr[1]) + memmgr_1.lorg - 1;
/*<       icore=nxtmem(1) >*/
    memmgr_1.icore = nxtmem_(&c__1);
/* ... don't take chances, back off from 'end of memory' by nxtevn(1) */
/*<       ldval=ifwa+nxtmem(1)-nxtevn(1) >*/
    memmgr_1.ldval = memmgr_1.ifwa + nxtmem_(&c__1) - nxtevn_(&c__1);
/*<       memavl=ldval-ntab-ifwa >*/
    memmgr_1.memavl = memmgr_1.ldval - memmgr_1.ntab - memmgr_1.ifwa;
/*<       maxcor=0 >*/
    memmgr_1.maxcor = 0;
/*<       maxuse=0 >*/
    memmgr_1.maxuse = 0;
/*<       call memory >*/
    memory_();
/*<       if(memerr.ne.0) call errmem(6,memerr,ipntr(1)) >*/
    if (memmgr_1.memerr != 0) {
	errmem_(&c__6, &memmgr_1.memerr, &ipntr[1]);
    }
/*<       numblk=1 >*/
    memmgr_1.numblk = 1;
/*<       loctab=ldval-ntab >*/
    memmgr_1.loctab = memmgr_1.ldval - memmgr_1.ntab;
/*<       istack(loctab+1)=0 >*/
    memmgr_1.istack[memmgr_1.loctab] = 0;
/*<       istack(loctab+2)=memavl >*/
    memmgr_1.istack[memmgr_1.loctab + 1] = memmgr_1.memavl;
/*<       istack(loctab+3)=0 >*/
    memmgr_1.istack[memmgr_1.loctab + 2] = 0;
/*<       istack(loctab+4)=-1 >*/
    memmgr_1.istack[memmgr_1.loctab + 3] = -1;
/*<       istack(loctab+5)=1 >*/
    memmgr_1.istack[memmgr_1.loctab + 4] = 1;
/*<       istack(loctab+6)=0 >*/
    memmgr_1.istack[memmgr_1.loctab + 5] = 0;
/*<       return >*/
    return 0;
/*<       end >*/
} /* setmem_ */

#undef cvalue


