*
* $Id: fowlpr.F,v 1.1.1.1 1996/03/22 16:42:47 mclareni Exp $
*
* $Log: fowlpr.F,v $
* Revision 1.1.1.1  1996/03/22 16:42:47  mclareni
* Phtools
*
*
      SUBROUTINE FOWLPR
C--       CALLED FROM FOWLMP.  CONTROLS OUTPUT OF HISTOGRAMS, CARDS,ETC.
      COMMON / / NDIMEN,BINS(100)
      COMMON/UTIL/BINOUT(150),ERROUT(150)
     +/CONTRL/ NEVTOT    ,TLIMIT   ,TLIM2    ,NDUMP    ,IEVENT
     +        ,DAT1      ,DAT2     ,IPAGE
     +/HISTR / NHIST     ,NGRP     ,NHDIM    ,LTITLE   ,LOCP(150)
     +/TAPES / NTPNCH   ,NTPBIN   ,KONSOL
     +/ADDHIS/ NADD      ,LOCADD   ,LPUN1    ,LPUN2    ,MAZOUT
     +/SHUFFL/ RNO(50)   ,NTNM4    ,NTM2     ,NTM1     ,QQCONS(50) ,TIR
      DIMENSION TOTWT(10), IBINS(10)
      EQUIVALENCE (BINS(1),IBINS(1))
      DATA Q1,Q2/4HPLCE,4H SUM/
      DATA  IP, IS, IA  / 1HP, 1HS, 1HA /
      CALL TIMEX(TIME)
      TIME = TIME/60.
#if !defined(CERNLIB_CDC)
      CALL NRANUT(ITIR)
      WRITE(6,5005)IEVENT,ITIR,TIME
 5005 FORMAT('0'/'0PROGRAM ENTERING OUTPUT PHASE',/
     +  34X,'TOTAL NUMBER OF EVENTS GENERATED',I10,/
     +  30X,'RANDOM NUMBER FOR RESTARTING HERE IS',I15,/
     +  34X,'TOTAL ELAPSED TIME IN MINUTES IS',F10.3/)
#endif
#if defined(CERNLIB_CDC)
      WRITE(6,5005)IEVENT,TIR,TIME
 5005 FORMAT('0'/'0PROGRAM ENTERING OUTPUT PHASE',/
     +  34X,'TOTAL NUMBER OF EVENTS GENERATED',I10,/
     +  30X,'RANDOM NUMBER GENERATOR QQRNDM IS AT',F10.0/
     +  34X,'TOTAL ELAPSED TIME IN MINUTES IS',F10.3/)
#endif
C--       PRINT AND 'PUNCH' HISTOGRAMS
      DO 200  IDO= 1, NHIST
      K = LOCP(IDO)
      IF(K.EQ.0) GOTO 200
      IF(IDO.EQ.1) GOTO 60
      IDOM = IDO - 1
      DO 50 IK= 1, IDOM
      IF(LOCP(IK).EQ.K) GOTO 200
   50 CONTINUE
   60 XLO1 = BINS(K+1)
      XINT1 = BINS(K+2)
      MXBIN1 = IBINS(K+3)
      MXBIN2 = MXBIN1 + 2
      TOTAL = 0.0
      SUMSQ = 0.
      SUMWT = 0.0
      DO 100  IK= 1, MXBIN2
      IK2 = 2*IK + K + 2
      SUMWT = SUMWT + BINS(IK2)
      SUMSQ = SUMSQ + BINS(IK2+1)
  100 TOTAL = TOTAL + ABS(BINS(IK2))
      IF(SUMSQ.LE.0.) SUMSQ = 1.
      EQUIV = TOTAL**2/SUMSQ
      IK2 = IK2 + 2
      IK3 = IK2 + LTITLE - 1
      WRITE(6,5000)IPAGE,Q1,IDO,(BINS(I),I=IK2,IK3),DAT1,DAT2
      IDOP = IDO + 1
      DO 103 IK= IDOP,NHIST
      IF(LOCP(IK).EQ.K) WRITE(6,5007)Q1,IK
  103 CONTINUE
      WRITE(6,5006)BINS(K),SUMWT,EQUIV,TOTAL
      IF(TOTAL.LE.0.) GOTO 200
      CALL UZERO(BINOUT,1,NHDIM)
      TOTAL1 = 1.0/TOTAL
      DO 120  IK= 1, MXBIN2
      IK4 = 2*IK + K + 2
      BINOUT(IK) = BINS(IK4) * TOTAL1
  120 ERROUT(IK) = SQRT(BINS(IK4+1)) * TOTAL1
      CALL HISTEY(XLO1, MXBIN1, XINT1, BINOUT, ERROUT)
C--       PUNCH HISTOGRAM
      IF(LPUN1) 200,150,140
  140 IF(IDO.LT.LPUN1 .OR. IDO.GT.LPUN2) GOTO 200
  150 LET = IP
      WRITE(7,5003) (BINS(I),I=IK2,IK3)
      L = 1
      WRITE(7,5004) IDO,MXBIN1,XLO1,XINT1,BINS(K),SUMWT,TOTAL,DAT1,DAT2,
     +            LET,IDO,L
      L2 = (MXBIN1+11)/6
      L3 = -4
      DO 160 L= 2, L2
      L3 = L3 + 6
      L4 = L3 + 5
  160 WRITE(7,5008) (BINOUT(I),I=L3,L4), DAT1,DAT2,LET,IDO,L
  200 CONTINUE
C
C--       ADDITIONS OF HISTOGRAMS
      KK = LOCADD
      IDO = 0
  210 IF(KK.EQ.0) GOTO 700
      KADD = IBINS(KK+1)
      IH = IBINS(KK+2)
      K = LOCP(IH)
      MXBIN1 = IBINS(K+3) + 2
      XLO1 = BINS(K+1)
      XINT1 = BINS(K+2)
      CALL UZERO(BINOUT,1,2*NHDIM)
      IK2 = KK + KADD*2 + 2
      IK3 = IK2 + LTITLE - 1
      IDO = IDO + 1
      WRITE(6,5000)IPAGE,Q2,IDO,(BINS(I),I=IK2,IK3),DAT1,DAT2
      WRITE(6,5001)
      SUMTOT = 0.0
      EVTOT = 0.0
      DO 240 I= 1, KADD
      IH = KK + 2*I
      WTT = BINS(IH+1)
      IH = IBINS(IH)
      K = LOCP(IH) + 2
      EVTOT = EVTOT + BINS(K-2)
      TOTWT(I) = 0.0
      DO 230 I2= 1, MXBIN1
      K = K + 2
  230 TOTWT(I) = TOTWT(I) + BINS(K)
      K1 = K + 2
      K2 = K + LTITLE   +1
      WRITE(6,5002)WTT,IH,(BINS(I2),I2=K1,K2),TOTWT(I)
  240 SUMTOT = SUMTOT + TOTWT(I)
      SUMWT = 0.
      DO 260 I= 1, KADD
      IH = KK + 2*I
      WTT = BINS(IH+1)
      IH = IBINS(IH)
      K = LOCP(IH) + 2
      IF(WTT.NE.0.) GOTO 244
C         THE FOLLOWING SHOULD BE USED TO NORMALIZE AFTER ADDING
      FACTOR = 1.0/SUMTOT
      SUMWT = 1.0
      GOTO 246
C         THE FOLLOWING SHOULD BE USED TO NORMALIZE BEFORE ADDING
  244 FACTOR = WTT /  TOTWT(I)
      SUMWT = SUMWT + WTT
  246 FACTO2 = FACTOR**2
      DO 250 I2= 1, MXBIN1
      K = K + 2
      BINOUT(I2) = BINOUT(I2) + BINS(K)*FACTOR
  250 ERROUT(I2) = ERROUT(I2) + BINS(K+1)*FACTO2
  260 CONTINUE
      SUMSQ = 0.
      DO 270 I2= 1, MXBIN1
      SUMSQ = SUMSQ + ERROUT(I2)
  270 ERROUT(I2) = SQRT(ERROUT(I2))
      IF(SUMSQ.LE.0.) SUMSQ = 1.
      EQUIV = SUMWT**2/SUMSQ
      WRITE(6,5006)EVTOT,SUMTOT,EQUIV,SUMTOT
      MXBIN1 = MXBIN1 - 2
      CALL HISTEY (XLO1, MXBIN1, XINT1, BINOUT, ERROUT)
      KK = IBINS(KK)
      GOTO 210
  700 CALL SCOUT
C--
      DO 800 I= 1, NHDIM
      BINOUT(I) = 0.0
  800 ERROUT(I) = 1.0
C*UL 1000 RETURN
      RETURN
#if defined(CERNLIB_CDC)
 5000 FORMAT(I1//A6,I3,',  ',8A10,10X,'DATE ',2A6)
 5001 FORMAT('0   SUM OF THE FOLLOWING PLACES-')
 5002 FORMAT(3X,F10.5,' * PLACE',I3,',  ',8A10,E13.5)
 5003 FORMAT(8A10)
 5004 FORMAT(2I5,5E10.3,2A6,1X,A1,2I3)
 5006 FORMAT(/50X,'TOTAL NUMBER OF EVENTS IN PLOT=',F7.0,5X,
     + 'SUM OF WEIGHTS=',E12.4/52X,'EQUIVALENT',
     + ' UNWEIGHTED EVENTS=',F7.0,5X,'NORMALIZATION=',E12.4)
 5007 FORMAT(A6,I3)
 5008 FORMAT(6E10.3,2A6,1X,A1,2I3)
#endif
#if !defined(CERNLIB_CDC)
 5000 FORMAT(I1//2X,A4,I3,',  ',8A4,10X,2A4)
 5001 FORMAT('0   SUM OF THE FOLLOWING PLACES-')
 5002 FORMAT(3X,F10.5,' * PLACE',I3,',  ',8A4,E13.5)
 5003 FORMAT(8A4)
 5004 FORMAT(2I5,5E10.3,1X,2A4,2X,2X,A1,2I3)
 5006 FORMAT(/50X,'TOTAL NUMBER OF EVENTS IN PLOT=',F8.0,5X,'SUM OF W',
     +'EIGHTS=',E12.4/52X,'EQUIVALENT UNWEIGHTED EVENTS=',F8.0,6X,
     +'NORMALIZATION=',E12.4)
 5007 FORMAT(2X,A4,I3)
 5008 FORMAT(6E10.3,1X,2A4,4X,A1,2I3)
#endif
      END
