*
* $Id: putbst.F,v 1.1.1.1 1996/04/01 15:03:19 mclareni Exp $
*
* $Log: putbst.F,v $
* Revision 1.1.1.1  1996/04/01 15:03:19  mclareni
* Mathlib gen
*
*
#include "sys/CERNLIB_machine.h"
#include "_gen/pilot.h"
      SUBROUTINE PUTBST(A,L,N)
C--- STORES AN ARRAY IN LCM
C--- INPUT
C   A = FIRST WORD OF ARRAY TO BE STORED
C   L = NO. OF WORDS TO BE STORED
C--- OUTPUT
C   N = -1   ROUTINE WAS CALLED WITH ZERO OR NEGATIVE LENGTH
C   N = 0    NOT ENOUGH SPACE AVAILABLE IN LCM
C   N GT 0 = ADDRESS OF FIRST WORD OF FIRST BLOCK IN LCM
C            (THIS ADDRESS HAS TO BE GIVEN TO GETBST FOR RETURNING A).
      COMMON/AUXBST/LSTBST,LBLBST,LB2BST,MAXBST,NLMBST,LFRBST,LOWBST
#if !defined(CERNLIB_NOSBE)
      COMMON/LCMBST/LCMBST(8)
#endif
#if defined(CERNLIB_NOSBE)
      COMMON/LCMBST/LCMBST(8)
#endif
#if defined(CERNLIB_F4)
      LEVEL 2,LCMBST
#endif
#if !defined(CERNLIB_F4)
      LEVEL 2,/LCMBST/
#endif
      DIMENSION A(2)
C--- NO. OF BLOCKS NEEDED
      IF(L.LE.0) GOTO 48
      LBL=(L-1)/LBLBST+1
      IF(LBL.LE.LFRBST) GOTO 2
C--- REQUEST MORE LCM
      CALL INTBST(L,IERR)
      IF(IERR.NE.0) GOTO 49
C--- ZERO NEW CONTROL WORDS
      DO 4  I=NLMBST,MAXBST,LB2BST
    4 LCMBST(I)=0
    2 CONTINUE
C--- STORE
      LADD=1
      LEFT=L
      DO 1  I=LOWBST,MAXBST,LB2BST
      IF(LCMBST(I).NE.0) GOTO 1
      IF(LEFT.EQ.L) N=I
      IF(LEFT.NE.L) LCMBST(IL+1)=I
      IL=I
      LFRBST=LFRBST-1
      LL=MIN(LEFT,LBLBST)
      CALL MOVLEV(A(LADD),LCMBST(I+2),LL)
      LEFT=LEFT-LL
      LCMBST(I)=LL
      LCMBST(I+1)=0
      IF(LEFT.EQ.0) GOTO 3
      LADD=LADD+LL
    1 CONTINUE
    3 CONTINUE
      LOWBST=IL+LB2BST
   50 RETURN
   48 CONTINUE
C--- NEGATIVE OR ZERO LENGTH IN CALL
      N=-1
      GOTO 50
   49 CONTINUE
C--- NOT ENOUGH SPACE
      N=-IERR
      GOTO 50
      END