*
* $Id$
*
* $Log$
* Revision 1.1  1996/01/16 17:08:07  mclareni
* Initial revision
*
*
#include "hbook/pilot.h"
*CMZ :  4.22/14 06/10/94  15.43.19  by  Fons Rademakers
*-- Author :
      SUBROUTINE HRIN(IDD,ICYCLE,KOFSET)
*.==========>
*.           Read histogram IDD from current directory (RZ or GLOBAL)
*.           The histogram stored in memory will be IDD+IOFSET
*..=========> ( R.Brun )
#include "hbook/hcntpar.inc"
#include "hbook/hntcur.inc"
#include "hbook/hcbook.inc"
#include "hbook/hcflag.inc"
#include "hbook/hcdire.inc"
*
      COMMON/QUEST/IQUEST(100)
      CHARACTER*128 CHWOLD
      INTEGER       KEYS(2)
      DATA KHIDE,KHID1,KHID2,KHCO1,KHCO2/4HHIDE,4HHID1,4HHID2,
     +                                   4hHCO1,4HHCO2/
*.___________________________________________
*
*          Check if directory in GLOBAL SECTION
*
      IOFSET=KOFSET
      IF(ICHTOP(ICDIR).LT.0)THEN
         IF(INDEX(HFNAME(ICDIR),'memory').NE.0)THEN
            LOCQ=1-LOCF(IQUEST(1))-ICHTOP(ICDIR)
            CALL HCOPYU(IDD,IQUEST(LOCQ),IOFSET)
         ELSE
            LOCQ=1-LOCF(IQUEST(1))-ICHTOP(ICDIR)
            CALL HCOPYM(IDD,IQUEST(LOCQ),IOFSET)
         ENDIF
         CALL SBIT1(IQ(LCID),5)
         GO TO 80
      ENDIF
      IF(ICYCLE.GT.1000.AND.IDD.EQ.0)THEN
         CALL HPAFF(CHCDIR,NLCDIR,CHWOLD)
         LQ(LHBOOK-NLPAT-10)=LCDIR
      ENDIF
*
      NRHIST=IQ(LCDIR+KNRH)
      IF(KOFSET.EQ.99999.AND.NRHIST.GT.0)THEN
         IF(IQ(LTAB+NRHIST).GE.KOFSET)IOFSET=IQ(LTAB+NRHIST)+1000000
      ENDIF
      KEYS(2) = 0
      IQ42=0
*
*          If IDD=0 find first ID in the RZ directory
*
      IDN=IDD
      IF(IDD.EQ.0)THEN
         KEYS(1) = 1
         CALL HRZIN(IHDIV,0,0,KEYS,9999,'SC')
         IDN=IQUEST(21)
         IQ42=IQUEST(22)
      ENDIF
 
*             Check if ID already in the table
*
   10 ID=IDN+IOFSET
      NRHIST=IQ(LCDIR+KNRH)
      IDPOS=LOCATI(IQ(LTAB+1),NRHIST,ID)
      INMEM=0
      IF(IDPOS.GT.0)THEN
         LC=LQ(LTAB-IDPOS)
         IF(JBIT(IQ(LC),5).EQ.0)THEN
            INMEM=1
         ELSE
            CALL HBUG('+Already existing histogram replaced','HRIN',ID)
            CALL HDELET(ID)
            NRHIST=IQ(LCDIR+KNRH)
            IDPOS=-IDPOS+1
         ENDIF
      ENDIF
*
*             Enough space left ?
*
      KEYS(1) = IDN
      KEYS(2) = IQ42
      CALL HRZIN(IHDIV,0,0,KEYS,ICYCLE,'NC')
      IF(IQUEST(1).NE.0)GO TO 70
      IQ40=IQUEST(40)
      IQ41=IQUEST(41)
      IQ42=IQUEST(42)
      NWORDS=IQUEST(12)
      IOPTA=JBIT(IQUEST(14),4)
      IF(IOPTA.NE.0)GO TO 60
      IF(INMEM.NE.0)GO TO 60
      CALL HSPACE(NWORDS+1000,'HRIN  ',IDD)
      IF(IERR.NE.0)                    GO TO 70
*
*             Enter ID in the list of ordered IDs
*
      IDPOS=-IDPOS+1
      IF(NRHIST.GE.IQ(LTAB-1))THEN
         CALL MZPUSH(IHDIV,LTAB,500,500,' ')
      ENDIF
      DO 20 I=NRHIST,IDPOS,-1
         IQ(LTAB+I+1)=IQ(LTAB+I)
         LQ(LTAB-I-1)=LQ(LTAB-I)
   20 CONTINUE
*
*             Read histogram data structure
*
      IF(LIDS.EQ.0)THEN
         KEYS(1) = IDN
         CALL HRZIN(IHDIV,LCDIR,-2,KEYS,ICYCLE,'ND')
         IF(IQUEST(1).NE.0)THEN
            CALL HBUG('Bad sequence for RZ','HRIN',IDN)
            GO TO 70
         ENDIF
         LIDS=LQ(LCDIR-2)
         LCID=LIDS
      ELSE
         LLID=LQ(LCDIR-9)
         KEYS(1) = IDN
         CALL HRZIN(IHDIV,LLID,  0,KEYS,ICYCLE,'ND')
         IF(IQUEST(1).NE.0)THEN
            CALL HBUG('Bad sequence for RZ','HRIN',IDN)
            GO TO 70
         ENDIF
         LCID=LQ(LLID)
      ENDIF
      IQ(LCID-5)=ID
      LQ(LCDIR-9)=LCID
      IQ(LCDIR+KNRH)=IQ(LCDIR+KNRH)+1
      IQ(LTAB+IDPOS)=ID
      LQ(LTAB-IDPOS)=LCID
      CALL SBIT1(IQ(LCID),5)
      IF(JBIT(IQ(LCID+KBITS),1).NE.0)THEN
         IF(IQ(LCID-4).EQ.KHIDE)THEN
            IQ(LCID-4)=KHID1
            L=LQ(LCID-1)
            IF(L.NE.0)IQ(L-4)=KHCO1
         ENDIF
      ENDIF
      IF(JBYT(IQ(LCID+KBITS),2,2).NE.0)THEN
         IF(IQ(LCID-4).EQ.KHIDE)THEN
            IQ(LCID-4)=KHID2
            L=LQ(LCID-1)
            IF(L.NE.0)IQ(L-4)=KHCO2
         ENDIF
*-- check old style convention for KMIN2/KMAX2
***   This code can only be introduced when version 4.19 or later
*     will be largely disseminated
***         IOLD2=0
***         J20=JBIT(IQ(LCID+KBITS),20)
***         J21=JBIT(IQ(LCID+KBITS),21)
***         IF(J20.EQ.0.AND.Q(LCID+KMAX2).NE.0.)IOLD2=1
***         IF(J21.EQ.0.AND.Q(LCID+KMIN2).NE.0.)IOLD2=1
***         IF(IOLD2.NE.0)THEN
***            Q(LCID+KMAX2)=0.
***            Q(LCID+KMIN2)=0.
***            IF(J20.NE.0)Q(LCID+KMAX2)=Q(LCID+KSCAL2)
***            IF(J21.NE.0)Q(LCID+KMIN2)=Q(LCID+KSCAL2)
***         ENDIF
      ENDIF
      IF(JBIT(IQ(LCID+KBITS),4).NE.0)THEN
*
*-- old n-tuple
*
         IF (IQ(LCID-2) .EQ. 2) THEN
**            IF(IOFSET.NE.0)THEN
**               CALL HDELET(ID)
**               CALL HBUG('IOFSET must be 0 for ntuples','HRIN',ID)
**               GO TO 60
**            ENDIF
            NCHRZ=IQ(LCID+11)
            IF(NCHRZ.LE.0)GO TO 30
            ITAG1=IQ(LCID+10)
            NW=IQ(LCID-1)-ITAG1+1
            NPLUS=32-ITAG1
            IF(NPLUS.GT.0)THEN
               CALL MZPUSH(IHDIV,LCID,0,NPLUS,' ')
               CALL UCOPY2(IQ(LCID+ITAG1),IQ(LCID+32),NW)
               IQ(LCID+9)=IQ(LCID+9)+NPLUS
               IQ(LCID+10)=32
            ENDIF
            CALL HPAFF(CHCDIR,NLCDIR,CHWOLD)
            NCHRZ=LENOCC(CHWOLD)
            CALL UCTOH(CHWOLD,IQ(LCID+12),4,NCHRZ)
            IQ(LCID+11)=NCHRZ
   30       IQ(LCID)=9999
            LC=LQ(LCID-1)
            CALL SBIT0(IQ(LC),1)
*           If memory-resident Ntuple, compute  pointers to banks
            IF(NCHRZ.LE.0)THEN
               NMORE=IQ(LCID+5)+3-IQ(LCID-3)
               IF(NMORE.GT.0)THEN
                  CALL MZPUSH(IHDIV,LCID,NMORE,0,' ')
               ENDIF
               IF(IQ(LCID+5).GE.1)THEN
                  DO 40 IB=1,IQ(LCID+5)
                     LQ(LCID-3-IB)=LC
                     LC=LQ(LC)
                     IF(LC.EQ.0)THEN
                        LC=LQ(LCID-1)
                        GO TO 60
                     ENDIF
   40             CONTINUE
                  LC=LQ(LCID-1)
               ENDIF
            ELSE
*           If disk-resident Ntuple, compute  pointers to KEYS
               IF(ICHTOP(ICDIR).LT.1000)CALL HRZKEY(IDN)
*           save ID in data structure in case of offset
               IQ(LCID+5)=IDN
            ENDIF
            GO TO 60
*
*-- new n-tuple
*
         ELSE
            NCHRZ=IQ(LCID+ZNCHRZ)
            IF(NCHRZ.LE.0)GO TO 50
            ITIT1=IQ(LCID+ZITIT1)
            NW=IQ(LCID-1)-ITIT1+1
            NPLUS=34-ITIT1
            IF(NPLUS.GT.0)THEN
               CALL MZPUSH(IHDIV,LCID,0,NPLUS,' ')
               CALL UCOPY2(IQ(LCID+ITIT1),IQ(LCID+34),NW)
               IQ(LCID+ZITIT1)=34
            ENDIF
            CALL HPAFF(CHCDIR,NLCDIR,CHWOLD)
            NCHRZ=LENOCC(CHWOLD)
            CALL UCTOH(CHWOLD,IQ(LCID+ZNCHRZ+1),4,NCHRZ)
            IQ(LCID+ZNCHRZ)=NCHRZ
   50       IQ(LCID)=9999
            LC = LQ(LCID-1)
            CALL SBIT0(IQ(LC),1)
            CALL SBIT0(IQ(LC),2)
            CALL SBIT0(IQ(LC),3)
            CALL HNMSET(ID,ZIBANK,0)
            CALL HNMSET(ID,ZITMP,0)
            IQ(LCID+ZIFTMP) = 2
            IQ(LCID+ZID)    = IDN
            NTCUR = 0
            GO TO 60
         ENDIF
      ENDIF
*
*             Add option ?
*
      IF(KOFSET.EQ.99999)THEN
         ID2=ID
         CALL HOPERA(IDN,'+',ID2,IDN,1.,1.)
         CALL HDELET(ID2)
      ENDIF
*
   60 IF(IQ40.EQ.0)GO TO 80
      IDN=IQ41
      IF(IDD.EQ.0)GO TO 10
*
   70 CONTINUE
*
   80 RETURN
      END
