/* comprs.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_

/*<       subroutine comprs(icode,limit) >*/
/* Subroutine */ int comprs_(icode, limit)
integer *icode, *limit;
{
    static integer madr, nblk, mspc, morg, muse, mslp, msiz, ltab1, ltab2, 
	    madr2, morg2, muse2;
    extern /* Subroutine */ int copy4_();
    static integer muser, iwsize;
    extern integer nxtevn_();

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

/*      this routine compresses all available memory into a single block. 
*/
/* if *icode* is zero, compression of memory from word 1 to *limit* is */
/* done;  otherwise, compression from *ldval* down to *limit* is done. */

/* 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 >*/
/*<       if (icode.ne.0) go to 100 >*/
    if (*icode != 0) {
	goto L100;
    }
/*<       nblk=numblk >*/
    nblk = memmgr_1.numblk;
/*<       ltab2=loctab >*/
    ltab2 = memmgr_1.loctab;
/*<    10 ltab1=ltab2 >*/
L10:
    ltab1 = ltab2;
/*<       if (ltab1.ge.limit) go to 200 >*/
    if (ltab1 >= *limit) {
	goto L200;
    }
/*<       if (nblk.eq.1) go to 200 >*/
    if (nblk == 1) {
	goto L200;
    }
/*<       nblk=nblk-1 >*/
    --nblk;
/*<       ltab2=ltab1+ntab >*/
    ltab2 = ltab1 + memmgr_1.ntab;
/*<       morg=istack(ltab1+1) >*/
    morg = memmgr_1.istack[ltab1];
/*<       msiz=istack(ltab1+2) >*/
    msiz = memmgr_1.istack[ltab1 + 1];
/*<       muse=nxtevn(istack(ltab1+3)) >*/
    muse = nxtevn_(&memmgr_1.istack[ltab1 + 2]);
/*<       mslp=istack(ltab1+6) >*/
    mslp = memmgr_1.istack[ltab1 + 5];
/*<       if ((msiz-muse).le.mslp) go to 10 >*/
    if (msiz - muse <= mslp) {
	goto L10;
    }
/*<       muse=muse+mslp >*/
    muse += mslp;
/* ...  move succeeding block down */
/*<       morg2=istack(ltab2+1) >*/
    morg2 = memmgr_1.istack[ltab2];
/*<       muse2=istack(ltab2+3) >*/
    muse2 = memmgr_1.istack[ltab2 + 2];
/*<       madr2=istack(ltab2+4) >*/
    madr2 = memmgr_1.istack[ltab2 + 3];
/*<       iwsize=istack(ltab2+5) >*/
    iwsize = memmgr_1.istack[ltab2 + 4];
/*<       if (madr2.ne.0) go to 15 >*/
    if (madr2 != 0) {
	goto L15;
    }
/*<       if (muse2.eq.0) go to 20 >*/
    if (muse2 == 0) {
	goto L20;
    }
/*<    15 cpyknt=cpyknt+dble(muse2) >*/
L15:
    memmgr_1.cpyknt += (doublereal) muse2;
/*<       call copy4(istack(nwoff+morg2+1),istack(nwoff+morg+muse+1),muse2) >*/
    copy4_(&memmgr_1.istack[memmgr_1.nwoff + morg2], &memmgr_1.istack[
	    memmgr_1.nwoff + morg + muse], &muse2);
/*<       istack(lorg+madr2)=(morg+muse)/iwsize >*/
    memmgr_1.istack[memmgr_1.lorg + madr2 - 1] = (morg + muse) / iwsize;
/*<    20 istack(ltab1+2)=muse >*/
L20:
    memmgr_1.istack[ltab1 + 1] = muse;
/*<       istack(ltab2+1)=morg+muse >*/
    memmgr_1.istack[ltab2] = morg + muse;
/*<       istack(ltab2+2)=istack(ltab2+2)+(msiz-muse) >*/
    memmgr_1.istack[ltab2 + 1] += msiz - muse;
/*<       go to 10 >*/
    goto L10;


/*<   100 nblk=numblk >*/
L100:
    nblk = memmgr_1.numblk;
/*<       ltab2=ldval-ntab >*/
    ltab2 = memmgr_1.ldval - memmgr_1.ntab;
/*<   110 ltab1=ltab2 >*/
L110:
    ltab1 = ltab2;
/*<       if (ltab1.le.limit) go to 200 >*/
    if (ltab1 <= *limit) {
	goto L200;
    }
/*<       if (nblk.eq.1) go to 200 >*/
    if (nblk == 1) {
	goto L200;
    }
/*<       nblk=nblk-1 >*/
    --nblk;
/*<       ltab2=ltab1-ntab >*/
    ltab2 = ltab1 - memmgr_1.ntab;
/*<       morg=istack(ltab1+1) >*/
    morg = memmgr_1.istack[ltab1];
/*<       msiz=istack(ltab1+2) >*/
    msiz = memmgr_1.istack[ltab1 + 1];
/*<       muser=istack(ltab1+3) >*/
    muser = memmgr_1.istack[ltab1 + 2];
/*<       muse=nxtevn(muser) >*/
    muse = nxtevn_(&muser);
/*<       madr=istack(ltab1+4) >*/
    madr = memmgr_1.istack[ltab1 + 3];
/*<       iwsize=istack(ltab1+5) >*/
    iwsize = memmgr_1.istack[ltab1 + 4];
/*<       mslp=istack(ltab1+6) >*/
    mslp = memmgr_1.istack[ltab1 + 5];
/*<       if ((msiz-muse).le.mslp) go to 110 >*/
    if (msiz - muse <= mslp) {
	goto L110;
    }
/*<       muse=muse+mslp >*/
    muse += mslp;
/*<       mspc=msiz-muse >*/
    mspc = msiz - muse;
/*<       cpyknt=cpyknt+dble(muser) >*/
    memmgr_1.cpyknt += (doublereal) muser;
/*<       call copy4(istack(nwoff+morg+1),istack(nwoff+morg+mspc+1),muser) >*/
    copy4_(&memmgr_1.istack[memmgr_1.nwoff + morg], &memmgr_1.istack[
	    memmgr_1.nwoff + morg + mspc], &muser);
/*<       istack(ltab1+1)=morg+mspc >*/
    memmgr_1.istack[ltab1] = morg + mspc;
/*<       istack(ltab1+2)=muse >*/
    memmgr_1.istack[ltab1 + 1] = muse;
/*<       istack(ltab2+2)=istack(ltab2+2)+mspc >*/
    memmgr_1.istack[ltab2 + 1] += mspc;
/*<       if (madr.eq.0) go to 110 >*/
    if (madr == 0) {
	goto L110;
    }
/*<       istack(lorg+madr)=(morg+mspc)/iwsize >*/
    memmgr_1.istack[memmgr_1.lorg + madr - 1] = (morg + mspc) / iwsize;
/*<       go to 110 >*/
    goto L110;
/* ...  all done */
/*<   200 return >*/
L200:
    return 0;
/*<       end >*/
} /* comprs_ */

