MINICERN/packlib/zebra/rz/rzllok.F

   1 *
   2 * $Id$
   3 *
   4 * $Log$
   5 * Revision 1.2  1996/04/24 17:27:00  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:25  mclareni
  10 * Zebra
  11 *
  12 *
  13 #include "zebra/pilot.h"
  14       SUBROUTINE RZLLOK
  15 *
  16 ************************************************************************
  17 *
  18 *       Routine to print current active locks
  19 *
  20 *
  21 * Called by RZFILE
  22 *
  23 *  Author  : R.Brun DD/US/PD
  24 *  Written : 08.09.89
  25 *  Last mod: 08.09.89
  26 *
  27 ************************************************************************
  28 *
  29 #include "zebra/zunit.inc"
  30 #include "zebra/rzcl.inc"
  31 #include "zebra/rzclun.inc"
  32 #include "zebra/rzdir.inc"
  33 #include "zebra/rzch.inc"
  34 #include "zebra/rzk.inc"
  35       DIMENSION IDIR(5,10),KHL(2)
  36 *
  37 *-----------------------------------------------------------------------
  38 *
  39
  40 #include "zebra/q_jbyt.inc"
  41
  42       IQUEST(1)=0
  43       IF(LQRS.EQ.0)GO TO 99
  44       IF(LTOP.EQ.0)GO TO 99
  45 *
  46 *           Read locking record
  47 *
  48       IF(LRIN.EQ.0)THEN
  49          CALL MZBOOK(JQPDVS,LRIN,LTOP,-7,'RZIN',0,0,LREC+1,2,-1)
  50          IQ(KQSP+LRIN-5)=IQ(KQSP+LTOP-5)
  51       ENDIF
  52       NWL =50
  53       NTRY=0
  54   10  CALL RZIODO(LUN,NWL,1,IQ(KQSP+LRIN+1),1)
  55       IF(IQUEST(1).NE.0)GO TO 90
  56       IF(IQ(KQSP+LRIN+2).GT.NWL)THEN
  57          NWL=IQ(KQSP+LRIN+2)
  58          GO TO 10
  59       ENDIF
  60       IQ(KQSP+LTOP+KIRIN)=0
  61       IF(IQ(KQSP+LRIN+3).NE.0)THEN
  62          NWL=50
  63          NTRY=NTRY+1
  64 #if defined(CERNLIB_QMVAX)
  65          IF(IRELAT.NE.0)UNLOCK(UNIT=LUN)
  66          CALL LIB$WAIT(0.1)
  67 #endif
  68          IF(NTRY.LT.100)GO TO 10
  69          IF(JBYT(IQ(KQSP+LTOP),15,3)-3.GE.-2) WRITE(IQLOG,1000)
  70  1000    FORMAT(' RZLLOK. Cannot get locking record')
  71          IQUEST(1)=1
  72          GO TO 90
  73       ENDIF
  74 *
  75       NLOCK=IQ(KQSP+LRIN+1)
  76       IF(NLOCK.LE.0)GO TO 99
  77       LL=4
  78   20  IF(IQ(KQSP+LRIN+LL).NE.0)THEN
  79          IRD=IQ(KQSP+LRIN+LL+4)
  80          CALL ZITOH(IQ(KQSP+LRIN+LL+1),KHL,2)
  81          IDTIME=IQ(KQSP+LRIN+LL+3)
  82          CALL RZDATE(IDTIME,IDATE,ITIME,1)
  83          NLEVEL=11
  84   30     NLEVEL=NLEVEL-1
  85          CALL RZIODO(LUN,5,IRD,IDIR(1,NLEVEL),1)
  86          IF(IQUEST(1).NE.0)GO TO 90
  87          CALL ZITOH(IDIR(1,NLEVEL),IDIR(1,NLEVEL),4)
  88          IRD=IDIR(5,NLEVEL)
  89          IF(IRD.GT.0)GO TO 30
  90 *
  91          NL=11-NLEVEL
  92          CALL UCOPY2(IDIR(1,NLEVEL),IDIR(1,1),NL*5)
  93          DO 40 I=1,NL
  94             CALL UHTOC(IDIR(1,I),4,CHPAT(I),16)
  95   40     CONTINUE
  96          CALL RZPAFF(CHPAT,NL,CHL)
  97          WRITE(IQPRNT,2000)KHL,IDATE,ITIME,CHL(1:70)
  98  2000    FORMAT(' LOCK-ID < ',2A4,'> on ',I6,'/',I4,' for directory ',A)
  99 *
 100          LL=LL+IQ(KQSP+LRIN+LL)
 101          GO TO 20
 102       ENDIF
 103   90  CONTINUE
 104 #if defined(CERNLIB_QMVAX)
 105       IF(IRELAT.NE.0)UNLOCK(UNIT=LUN)
 106 #endif
 107 *
 108   99  RETURN
 109       END