[u/mrichter/AliRoot.git] / MINICERN / packlib / zebra / rz / rzllok.F

*
* $Id$
*
* $Log$
* Revision 1.2  1996/04/24 17:27:00  mclareni
* Extend the include file cleanup to dzebra, rz and tq, and also add
* dependencies in some cases.
*
* Revision 1.1.1.1  1996/03/06 10:47:25  mclareni
* Zebra
*
*
#include "zebra/pilot.h"
      SUBROUTINE RZLLOK
*
************************************************************************
*
*       Routine to print current active locks
*
*
* Called by RZFILE
*
*  Author  : R.Brun DD/US/PD
*  Written : 08.09.89
*  Last mod: 08.09.89
*
************************************************************************
*
#include "zebra/zunit.inc"
#include "zebra/rzcl.inc"
#include "zebra/rzclun.inc"
#include "zebra/rzdir.inc"
#include "zebra/rzch.inc"
#include "zebra/rzk.inc"
      DIMENSION IDIR(5,10),KHL(2)
*
*-----------------------------------------------------------------------
*

#include "zebra/q_jbyt.inc"

      IQUEST(1)=0
      IF(LQRS.EQ.0)GO TO 99
      IF(LTOP.EQ.0)GO TO 99
*
*           Read locking record
*
      IF(LRIN.EQ.0)THEN
         CALL MZBOOK(JQPDVS,LRIN,LTOP,-7,'RZIN',0,0,LREC+1,2,-1)
         IQ(KQSP+LRIN-5)=IQ(KQSP+LTOP-5)
      ENDIF
      NWL =50
      NTRY=0
  10  CALL RZIODO(LUN,NWL,1,IQ(KQSP+LRIN+1),1)
      IF(IQUEST(1).NE.0)GO TO 90
      IF(IQ(KQSP+LRIN+2).GT.NWL)THEN
         NWL=IQ(KQSP+LRIN+2)
         GO TO 10
      ENDIF
      IQ(KQSP+LTOP+KIRIN)=0
      IF(IQ(KQSP+LRIN+3).NE.0)THEN
         NWL=50
         NTRY=NTRY+1
#if defined(CERNLIB_QMVAX)
         IF(IRELAT.NE.0)UNLOCK(UNIT=LUN)
         CALL LIB$WAIT(0.1)
#endif
         IF(NTRY.LT.100)GO TO 10
         IF(JBYT(IQ(KQSP+LTOP),15,3)-3.GE.-2) WRITE(IQLOG,1000)
 1000    FORMAT(' RZLLOK. Cannot get locking record')
         IQUEST(1)=1
         GO TO 90
      ENDIF
*
      NLOCK=IQ(KQSP+LRIN+1)
      IF(NLOCK.LE.0)GO TO 99
      LL=4
  20  IF(IQ(KQSP+LRIN+LL).NE.0)THEN
         IRD=IQ(KQSP+LRIN+LL+4)
         CALL ZITOH(IQ(KQSP+LRIN+LL+1),KHL,2)
         IDTIME=IQ(KQSP+LRIN+LL+3)
         CALL RZDATE(IDTIME,IDATE,ITIME,1)
         NLEVEL=11
  30     NLEVEL=NLEVEL-1
         CALL RZIODO(LUN,5,IRD,IDIR(1,NLEVEL),1)
         IF(IQUEST(1).NE.0)GO TO 90
         CALL ZITOH(IDIR(1,NLEVEL),IDIR(1,NLEVEL),4)
         IRD=IDIR(5,NLEVEL)
         IF(IRD.GT.0)GO TO 30
*
         NL=11-NLEVEL
         CALL UCOPY2(IDIR(1,NLEVEL),IDIR(1,1),NL*5)
         DO 40 I=1,NL
            CALL UHTOC(IDIR(1,I),4,CHPAT(I),16)
  40     CONTINUE
         CALL RZPAFF(CHPAT,NL,CHL)
         WRITE(IQPRNT,2000)KHL,IDATE,ITIME,CHL(1:70)
 2000    FORMAT(' LOCK-ID < ',2A4,'> on ',I6,'/',I4,' for directory ',A)
*
         LL=LL+IQ(KQSP+LRIN+LL)
         GO TO 20
      ENDIF
  90  CONTINUE
#if defined(CERNLIB_QMVAX)
      IF(IRELAT.NE.0)UNLOCK(UNIT=LUN)
#endif
*
  99  RETURN
      END
Commit	Line	Data
fe4da5cc	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