MINICERN/packlib/zebra/rz/rzfree.F

   1 *
   2 * $Id$
   3 *
   4 * $Log$
   5 * Revision 1.2  1996/04/24 17:26:50  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:23  mclareni
  10 * Zebra
  11 *
  12 *
  13 #include "zebra/pilot.h"
  14       SUBROUTINE RZFREE(CHLOCK)
  15 *
  16 ************************************************************************
  17 *
  18 *      To free a directory previously locked by RZLOCK
  19 * Input:
  20 *   CHLOCK  Character variable identifying the owner of the lock.
  21 *
  22 * Called by <USER>
  23 *
  24 *  Author  : R.Brun DD/US/PD
  25 *  Written : 02.05.86
  26 *  Last mod: 09.01.91
  27 *
  28 ************************************************************************
  29 #include "zebra/zunit.inc"
  30 #include "zebra/rzcl.inc"
  31 #include "zebra/rzclun.inc"
  32 #include "zebra/rzk.inc"
  33       CHARACTER*(*) CHLOCK
  34       DIMENSION IHL(2)
  35 *
  36 *-----------------------------------------------------------------------
  37 *
  38 #include "zebra/q_jbyt.inc"
  39
  40       IQUEST(1)=0
  41       IF(LQRS.EQ.0)GO TO 99
  42       IF(LTOP.EQ.0)GO TO 99
  43 *
  44       LOGLV=JBYT(IQ(KQSP+LTOP),15,3)-3
  45       NCH=LEN(CHLOCK)
  46       IF(NCH.GT.8)NCH=8
  47       CALL UCTOH(CHLOCK,IHL,4,NCH)
  48       IF(NCH.LT.5)CALL VBLANK(IHL(2),1)
  49       CALL ZHTOI(IHL,IHL,2)
  50 *
  51 *           Check write permission
  52 *
  53 ***      IF(JBIT(IQ(KQSP+LCDIR),1).NE.0)THEN
  54 ***         IQUEST(1)=4
  55 ***         IF(LOGLV.GE.-2) WRITE(IQLOG,9010)
  56 *** 9010    FORMAT(' RZFREE. No authorisation to write in that directory')
  57 ***         GO TO 99
  58 ***      ENDIF
  59 *
  60 *           Lock first record
  61 *
  62       LRIN  = LQ(KQSP+LTOP-7)
  63       LPURG = LQ(KQSP+LTOP-5)
  64       LROUT = LQ(KQSP+LTOP-6)
  65       IF(LRIN.EQ.0)THEN
  66          CALL MZBOOK(JQPDVS,LRIN,LTOP,-7,'RZIN',0,0,LREC+1,2,-1)
  67          IQ(KQSP+LRIN-5)=IQ(KQSP+LTOP-5)
  68       ENDIF
  69       NWL =50
  70       NTRY=0
  71   10  CALL RZIODO(LUN,NWL,1,IQ(KQSP+LRIN+1),1)
  72       IF(IQUEST(1).NE.0)GO TO 99
  73       IF(IQ(KQSP+LRIN+2).GT.NWL)THEN
  74          NWL=IQ(KQSP+LRIN+2)
  75          GO TO 10
  76       ENDIF
  77       NWL=IQ(KQSP+LRIN+2)
  78       IQ(KQSP+LTOP+KIRIN)=0
  79       IF(IQ(KQSP+LRIN+3).NE.0)THEN
  80          NWL=50
  81          NTRY=NTRY+1
  82 #if defined(CERNLIB_QMVAX)
  83          IF(IRELAT.NE.0)UNLOCK(UNIT=LUN)
  84          CALL LIB$WAIT(0.1)
  85 #endif
  86          IF(NTRY.LT.100)GO TO 10
  87          IF(LOGLV.GE.-2) WRITE(IQLOG,1000)
  88  1000    FORMAT(' RZFREE. Cannot lock that directory')
  89          IQUEST(1)=1
  90          GO TO 99
  91       ENDIF
  92       IQ(KQSP+LRIN+3)=1
  93       CALL RZIODO(LUN,MAX(NWL,50),1,IQ(KQSP+LRIN+1),2)
  94 *
  95 *           Read fresh Top directory
  96 *
  97       IF(LTOP.NE.LCDIR)CALL RZRTOP
  98 *
  99 *           Save directories
 100 *
 101       CALL RZSAVE
 102 *
 103       IQ(KQSP+LRIN+3)=0
 104       NLOCK=IQ(KQSP+LRIN+1)
 105       LDC=IQ(KQSP+LCDIR+KLD)
 106       IRD=IQ(KQSP+LCDIR+LDC+1)
 107 *
 108 *           Search lock-id
 109 *
 110       IF(NLOCK.GT.0)THEN
 111          LL=4
 112   20     NLESS=IQ(KQSP+LRIN+LL)
 113          IF(NLESS.NE.0)THEN
 114             IF(IQ(KQSP+LRIN+LL+1).EQ.IHL(1).AND.
 115      +         IQ(KQSP+LRIN+LL+2).EQ.IHL(2).AND.
 116      +         IQ(KQSP+LRIN+LL+4).EQ.IRD)THEN
 117                CALL UCOPY2(IQ(KQSP+LRIN+LL+NLESS),
 118      +                     IQ(KQSP+LRIN+LL),NWL-LL+1)
 119                NWL=NWL-NLESS
 120                IQ(KQSP+LRIN+1)=IQ(KQSP+LRIN+1)-1
 121                IQ(KQSP+LRIN+2)=NWL
 122             ELSE
 123                LL=LL+NLESS
 124                GO TO 20
 125             ENDIF
 126          ENDIF
 127       ENDIF
 128 *
 129 *           Delete list of allocated records
 130 *
 131       IF(LFREE.NE.0)THEN
 132          CALL VZERO(IQ(KQSP+LFREE+1),IQ(KQSP+LFREE-1))
 133       ENDIF
 134 *
 135 *           Write back record 1
 136 *
 137       CALL RZIODO(LUN,MAX(NWL,50),1,IQ(KQSP+LRIN+1),2)
 138       IQUEST(10)=IQ(KQSP+LRIN+1)
 139 *
 140   99  RETURN
 141       END