*
* $Id: redat2.F,v 1.1.1.1 1996/03/22 16:42:47 mclareni Exp $
*
* $Log: redat2.F,v $
* Revision 1.1.1.1  1996/03/22 16:42:47  mclareni
* Phtools
*
*
      SUBROUTINE REDAT2
C--       CALLED FROM REDATA.  READS VARIABLE-PURPOSE DATA CARDS
      COMMON/UTIL/PLACE(150),WEIGHT(150),NP,TECM,AMASS(18),PCM(5,18),WT
      COMMON / / NDIMEN,BINS(100)
     +/CONTRL/ NEVTOT    ,TLIMIT   ,TLIM2    ,NDUMP    ,IEVENT
     +        ,DAT1      ,DAT2     ,IPAGE
     +/HISTR / NHIST     ,NGRP     ,NHDIM    ,LTITLE   ,LOCP(150)
     +/TAPES / NTPNCH   ,NTPBIN   ,KONSOL
     +/SCATR / IPL1(20)  ,IPL2(20) ,IWTS(20) ,LOCS(20)
     +/ADDHIS/ NADD      ,LOCADD   ,LPUN1    ,LPUN2    ,MAZOUT
     +/KGENEV/ KGENEV
     +/REDAT / ICRD      ,IDRAPO    ,NGAFF     ,BIGAFF
     +/KAJBYK/ KAJBYK    ,A(18)    ,UCUT(18) ,BCUT(18) ,NN
      DIMENSION KONWD(20), IBINS(10), WTADD(8), HISTIT(8), WORD7(7)
#if !defined(CERNLIB_CDC)
      DIMENSION IADWD(5)
#endif
      EQUIVALENCE (WORD7(1), XLO1) ,(WORD7(2), XUP1) , (WORD7(3), XINT1)
      EQUIVALENCE (BLANK,KONWD(1)),(BINS(1),IBINS(1))
#if defined(CERNLIB_CDC)
      DATA KONWD /  5H       ,5HSCAT   ,5H SCAT  ,5HADD    ,5H  ADD
     +             ,5HNADD   ,5H NADD  ,5HAHIST  ,5HEXP    ,5HPUNCH
     +             ,5HRANIN  ,5HUCUT   ,5H UCUT  ,5HLCUT   ,5H LCUT
     +             ,5HDIFFR  ,5HGENEV  ,5HASCAT  ,5HSPACE  ,5H      /
#endif
#if !defined(CERNLIB_CDC)
      DATA KONWD /4H    ,4HSCAT,4HADD ,4HNADD,4HAHIS,4HEXP ,4HPUNC,
     +            4HRANI,4HUCUT,4HLCUT,4HDIFF,4HGENE,4HASCA,4HSPAC,
     +            4H    ,4H    ,4H    ,4H    ,4H    ,4H    /
#endif
      KGENEV = 0
      IHSAV = 0
      NGAFF = 0
      NHIST = 0
      NADD = 0
      LOCADD = 0
      NSCAT = 0
      LAST = 20 * IBINS(1)  + 1
      LPUN1 = -1
      ISPACE = 0
      IRNO = 0
      MAZOUT = -1
      CALL UZERO(LOCP,1,NHDIM)
      CALL UZERO(IPL1,1,80)
      CALL UZERO(KAJBYK,1,55)
      DO 140 IDO= 1, 500
      IGAFF = 0
      READ 5011,IADWD,IHIST,WORD7
      JONG=0
      ICRD = ICRD + 1
#if !defined(CERNLIB_CDC)
C         SQUEEZE COMMAND WORD LEFT DELETING BLANKS
      ISQUZ = KONWD(1)
      IPOS = 1
      DO 15 I= 1, 5
      IF(IPOS.GT.4) GOTO 15
      IF(IADWD(I).EQ.KONWD(1)) GOTO 15
      CALL CHMOVE(IADWD(I),1,ISQUZ,IPOS,1)
      IPOS = IPOS + 1
   15 CONTINUE
#endif
      DO 25 I= 1, 20
#if defined(CERNLIB_CDC)
      IF(IADWD.EQ.KONWD(I)) GOTO 28
#endif
#if !defined(CERNLIB_CDC)
      IF(ISQUZ.EQ.KONWD(I)) GOTO 28
#endif
   25 CONTINUE
      GOTO 4000
#if defined(CERNLIB_CDC)
   28 GOTO(66, 59,59, 80,80, 79,79, 50,200,270, 250, 210,210, 220,220,
     +       200, 290,    4000, 295,4000)  ,  I
#endif
#if !defined(CERNLIB_CDC)
   28 GOTO(66, 59, 80, 79, 50, 200, 270, 250, 210, 220, 200, 290,
     +           4000, 295, 4000, 4000)  ,  I
#endif
C--       AHIST CARDS
   50 LOCPQ = WORD7(1) + 0.5
      WRITE(6,5018)IADWD,IHIST,LOCPQ
      IF(IHIST.GT.NHDIM .OR. LOCPQ.GT.NHDIM) GOTO 4000
      IP = LOCP(IHIST)
      IQ = LOCP(LOCPQ)
      IF(IP.NE.0) GOTO 52
      IF(IQ.EQ.0) GOTO 4000
      LOCP(IHIST) = IQ
      NHIST = MAX(NHIST,IHIST)
      GOTO 100
   52 IF(IQ.NE.0) GOTO 4000
      LOCP(LOCPQ) = IP
      NHIST = MAX(NHIST,LOCPQ)
      GOTO 100
C--       SCAT CARDS
   59 K1 = LOCP(IHIST)
      IH2 = WORD7(1) + 0.5
      IW = WORD7(2) + 0.5
      IF(IW.LT.1) IW = IHIST
      K2 = LOCP(IH2)
      IBK12 = IBINS(K1+3) + 2
      LS = 0
      IF(K1*K2.LE.0) GOTO 60
      LS = IBK12 * (IBINS(K2+3) + 2) + 1
      IF(IBK12.GT.60 .OR. NSCAT.GE.20) GOTO 60
      IF(LAST + LS.LT.NDIMEN) GOTO 61
   60 WRITE(6,5010)
      WRITE(6,5018)IADWD,IHIST,IH2,IW,LS
      IGAFF = 1
      GOTO 100
   61 NSCAT = NSCAT + 1
      WRITE(6,5018)IADWD,IHIST,IH2,IW,LS
      IPL1(NSCAT) = IHIST
      IPL2(NSCAT) = IH2
      IWTS(NSCAT)= IW
      LOCS(NSCAT) = LAST + 1
      IBINS(LAST+1) = IBK12
      LAST = LAST + LS
      GOTO 100
C--       HISTOGRAM CARDS
   66 IF(IHIST.LT.-1 .OR. IHIST.GT.NHDIM) GOTO 4000
      IF(IHIST.LE.0) GOTO 150
      IF(XLO1-XUP1) 70,70,69
   69 SAVE = XUP1
      XUP1 = XLO1
      XLO1 = SAVE
   70 CONTINUE
      IF(LOCP(IHIST)) 4000,71,4000
   71 LNEXT = LAST + 1
      LOCP(IHIST) = LNEXT
C--       IF LIMITS ARE NOT SPECIIFED, TAKE THE PREVIOUS ONES
      IF(XLO1) 75,72,75
   72 IF(XUP1) 75,74,75
   74 IF(IHSAV.EQ.0) GOTO 4000
      LSAV = LOCP(IHSAV)
      XLO1 = BINS(LSAV+1)
      XINT1 = BINS(LSAV+2)
      XUP1 = XUP2
   75 XUP2 = XUP1
      IHSAV = IHIST
      IF(XINT1.LE. 0.) XINT1 = ABS(XUP1-XLO1)/50.0
      IF(XINT1.LE.0.) GOTO 4000
      BINS(LNEXT+1) = XLO1
      BINS(LNEXT+2) = XINT1
      KK = (XUP1-XLO1)/XINT1 + 0.999
      IBINS(LNEXT+3) = KK
      LS = 2*KK + LTITLE + 8
      LAST = LNEXT + LS - 1
      READ 5007,(HISTIT(I),I= 1,LTITLE)
      ICRD = ICRD + 1
      IF(KK.GT.NHDIM-2) GOTO 175
      IF(LAST.LE.NDIMEN) GOTO 76
  175 LOCP(IHIST) = 0
      LAST = LNEXT - 1
      IGAFF = 1
      WRITE(6,5010)
      GOTO 78
   76 CONTINUE
      LML = LAST - LTITLE
      DO 77 I= 1, LTITLE
      LMLI = LML + I
#if defined(CERNLIB_CDC)
      IF(HISTIT(I).EQ.BLANK) CALL UCOPY(10H..........,HISTIT(I),1)
#endif
#if !defined(CERNLIB_CDC)
      IF(HISTIT(I).EQ.BLANK) CALL UCOPY(4H....,HISTIT(I),1)
#endif
   77 BINS(LMLI) = HISTIT(I)
      NHIST = MAX(NHIST,IHIST)
   78 WRITE(6,5008)IHIST,XLO1,XUP1,XINT1,LS,(HISTIT(I),I=1,LTITLE)
      GOTO 100
C--       HISTOGRAM ADDITION CARDS
   79 JONG=1
   80 CONTINUE
      DO 81 I= 1, 8
   81 WTADD(I) = 0.
      IF(JONG.EQ.1) READ 5016,WTADD
      READ 5007,HISTIT
      ICRD = ICRD + 1 + JONG
      IF(NDIMEN-LAST.LT.30) GOTO 88
      NADD = NADD + 1
      LNEXT = LAST + 1
      IF(NADD.GT.1) GOTO 82
      LOCADD = LNEXT
      IBINS(LOCADD) = 0
      LASTAD = LOCADD
      GOTO 83
   82 IBINS(LASTAD) = LNEXT
      IBINS(LNEXT) = 0
      LASTAD = LNEXT
   83 CONTINUE
      IBINS(LNEXT+2) = IHIST
      BINS (LNEXT+3) = WTADD(1)
      LNEXT = LNEXT + 4
      DO 86 I= 2, 8
      KADD = WORD7(I-1) + 0.5
      IF(KADD.LE.0) GOTO 87
      IBINS(LNEXT) = KADD
      BINS (LNEXT+1) = WTADD(I)
   86 LNEXT = LNEXT + 2
      I = 9
   87 KADD = I - 1
      IBINS(LAST+2) = KADD
      LS = LNEXT + LTITLE - LAST - 1
      LAST = LAST + LS
      DO 187 I= 1, LTITLE
#if defined(CERNLIB_CDC)
      IF(HISTIT(I).EQ.BLANK) CALL UCOPY(10H..........,HISTIT(I),1)
#endif
#if !defined(CERNLIB_CDC)
      IF(HISTIT(I).EQ.BLANK) CALL UCOPY(4H....,HISTIT(I),1)
#endif
  187 BINS(LNEXT+I-1) = HISTIT(I)
      GOTO 89
   88 WRITE(6,5010)
      IGAFF = 1
      LS = 0
   89 WRITE(6,5013)IADWD,IHIST,WORD7,LS,HISTIT
      GOTO 100
C--       IMPORTANCE SAMPLING FOR KAJANTIE-BYCKLING METHOD
  200 KAJBYK = 1
      IF(IHIST.LT.1 .OR. IHIST.GE.NP) GOTO 221
      A(IHIST) = WORD7(1)
      GOTO 222
  210 KAJBYK = 1
      IF(IHIST.LT.1 .OR. IHIST.GE.NP) GOTO 221
      UCUT(IHIST) = WORD7(1)
      GOTO 222
  220 KAJBYK = 1
      IF(IHIST.LT.1 .OR. IHIST.GE.NP) GOTO 221
      BCUT(IHIST) = WORD7(1)
      GOTO 222
  221 WRITE(6,5010)
      IGAFF = 1
  222 WRITE(6,5023)IADWD,IHIST,WORD7(1)
      GOTO 100
C--       RANDOM NUMBER INPUT FOR RESTARTING
  250 IRNO = IHIST + WORD7(1)
      WRITE(6,5012)IADWD,IRNO
      GOTO 100
C--       PUNCH REQUEST
  270 LS = 0
      LPUN1 = IHIST
      LPUN2 = WORD7(1) + 0.5
      MAZOUT = WORD7(2) + 0.5
      WRITE(6,5018)IADWD,LPUN1,LPUN2,MAZOUT,LS
      GOTO 100
C--       GENEV REQUEST
  290 WRITE(6,5018)IADWD,IHIST
      IF(IHIST.GT.1) KGENEV = 2
      GOTO 100
C--       SPACE REQUEST
  295 WRITE(6,5018)IADWD
      ISPACE = 1
C--       ERROR RETURN
  100 CONTINUE
      IF(IGAFF) 140,140,102
  102 WRITE(6,5013)
      IF(TLIMIT.GT.1.0) TLIMIT = 1.0
      NGAFF = NGAFF + 1
  140 CONTINUE
C--       END OF DATA CARD READING
  150 CONTINUE
      LWAST = NDIMEN - LAST
      WRITE(6,5017)NDIMEN,LAST,LWAST
#if defined(CERNLIB_CDC)
  320 IRNO = IRNO + 1
C*UL+SELF,IF=-CDC.
C*UL  320 CONTINUE
#endif
      CALL QQSTRT(IRNO)
      IF(KAJBYK.GT.0) CALL TEEDIA
  190 RETURN
 4000 BIGAFF = 2.0
      GOTO 190
#if defined(CERNLIB_CDC)
 5007 FORMAT(8A10)
 5008 FORMAT(I9,3E10.2,I4,2X,8A10)
 5010 FORMAT('0******FOLLOWING REQUEST IGNORED****SOME DIMENSION IS E',
     +  'XCEEDED OR REQUEST IS OTHERWISE ILLEGAL*********')
 5011 FORMAT(A5, I5, 7F10.0)
 5012 FORMAT(1X,A5,I7)
 5013 FORMAT(1X,A5,I3,7F4.0,I6,2X,8A10)
 5016 FORMAT(8F10.0)
 5017 FORMAT(/9X,'TOTAL BIN SPACE DIMENSIONED',I7/32X,'USED ',I6/30X,
     +'UNUSED',I6/)
 5018 FORMAT(1X,A5,I3,2I4,21('.'),I5)
 5023 FORMAT(1X,A5,I3,F12.6)
#endif
#if !defined(CERNLIB_CDC)
 5007 FORMAT(8A4)
 5008 FORMAT(I9,3E10.2,I4,2X,8A4)
 5010 FORMAT('0******FOLLOWING REQUEST IGNORED****SOME DIMENSION IS',
     +  ' EXCEEDED OR REQUEST IS OTHERWISE ILLEGAL*********')
 5011 FORMAT(5A1,I5,7F10.0)
 5012 FORMAT(1X,5A1,I11)
 5013 FORMAT(1X,5A1,I3,7F4.0,I6,2X,8A4)
 5016 FORMAT(8F10.0)
 5017 FORMAT(/9X,'TOTAL BIN SPACE DIMENSIONED',I7/32X,'USED ',I6/30X,
     +'UNUSED',I6/)
 5018 FORMAT(1X,5A1,I3,2I4,21('.'),I5)
 5023 FORMAT(1X,5A1,I3,F12.6)
#endif
      END
