MINICERN/packlib/zebra/rz/rzallo.F

   1 *
   2 * $Id$
   3 *
   4 * $Log$
   5 * Revision 1.2  1996/04/24 17:26:38  mclareni
   6 * Extend the include file cleanup to dzebra, rz and tq, and also add
   7 * dependencies in some cases.
   8 *
   9 * Revision 1.1.1.1  1996/03/06 10:47:22  mclareni
  10 * Zebra
  11 *
  12 *
  13 #include "zebra/pilot.h"
  14       SUBROUTINE RZALLO(CHROUT,N,IALLOC)
  15 *
  16 ***********************************************************************
  17 *
  18 *       Returns the first N consecutive records free starting at IALLOC
  19 * Input:
  20 *   CHROUT Name of the calling routine
  21 *   N      Number of consecutive records requested
  22 * Output:
  23 *   IALLOC first of the N records available
  24 *
  25 * Called by RZOUT,RZVOUT,RZMDIR,RZEXPD
  26 *
  27 *  Author  : R.Brun DD/US/PD
  28 *  Written : 01.04.86
  29 *  Last mod: 26.10.93 JDS. Unique IQUEST(1) codes
  30 *
  31 *  IQUEST(1) = 1 : request exceeds quota
  32 *            = 2 : cannot find the requested number of free records
  33 *
  34 ***********************************************************************
  35 #include "zebra/zunit.inc"
  36 #include "zebra/rzcl.inc"
  37 #include "zebra/rzk.inc"
  38       CHARACTER*6 CHROUT
  39 *
  40 *-----------------------------------------------------------------------
  41 *
  42
  43 #include "zebra/q_jbyt.inc"
  44
  45       LOGLV=JBYT(IQ(KQSP+LTOP),15,3)-3
  46       IF(LFREE.EQ.0)GO TO 90
  47       NFREE=IQ(KQSP+LFREE+1)
  48       IF(NFREE.EQ.0)GO TO 90
  49 *
  50       DO 10 I=1,NFREE
  51          IR1=IQ(KQSP+LFREE+2*I)
  52          IRL=IQ(KQSP+LFREE+2*I+1)
  53          IF(IR1+N-1.LE.IRL)THEN
  54             IALLOC=IR1
  55             GO TO 20
  56          ENDIF
  57   10  CONTINUE
  58       GO TO 90
  59 *
  60 *           Check if allocation is not above quota
  61 *
  62   20  IF((IQ(KQSP+LCDIR+KRUSED)+N.GT.IQ(KQSP+LCDIR+KQUOTA)-3).OR.
  63      +   (IALLOC.GT.IQ(KQSP+LFREE+2*NFREE+1)-3))THEN
  64          IF(LOGLV.GE.-2) WRITE(IQLOG,1000)CHROUT
  65  1000    FORMAT(1X,A,'. Request exceeds quota')
  66          IALLOC=0
  67          IQUEST(1)=1
  68          IQUEST(10)=IQ(KQSP+LCDIR+KQUOTA)-3
  69          IQUEST(11)=IQ(KQSP+LFREE+2*NFREE+1)-3
  70          IQUEST(12)=N
  71       ENDIF
  72       GO TO 99
  73 *
  74 *           Error
  75 *
  76   90  IF(LOGLV.GE.-2) WRITE(IQLOG,2000)CHROUT,N
  77  2000 FORMAT(1X,A,'. Cannot find the ',I3,' records requested')
  78       IALLOC    =0
  79       IQUEST(1) =2
  80       IQUEST(10)=N
  81 *
  82   99  RETURN
  83       END