*
* $Id: scout.F,v 1.1.1.1 1996/03/22 16:42:47 mclareni Exp $
*
* $Log: scout.F,v $
* Revision 1.1.1.1  1996/03/22 16:42:47  mclareni
* Phtools
*
*
      SUBROUTINE SCOUT
C--       CALLED FROM FOWLPR.  PRINTS SCATTERGRAMS.
      COMMON / / NDIMEN,BINS(100)
      COMMON/UTIL/PLACE(150),WEIGHT(150),NP,TECM,AMASS(18),PCM(5,18),WT
     +/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)
      DIMENSION KOUT(150),IBINS(100) , LETTER(10) , NETTER(10)
      EQUIVALENCE (KOUT(1),PLACE(1)),(BINS(1),IBINS(1))
      DATA LETTER/2H .,2H 1,2H 2,2H 3,2H 4,2H 5,2H 6,2H 7,2H 8,2H 9/
      DATA NETTER/2H -,2H-1,2H-2,2H-3,2H-4,2H-5,2H-6,2H-7,2H-8,2H-9/
      DATA IBLANK, BLIP / 1H  , 1HI /
      DO 500 I= 1, 20
      K = LOCS(I)
      IF(K) 510,510,100
  100 IP1 = IPL1(I)
      IP2 = IPL2(I)
      IW = IWTS(I)
      K1 = LOCP(IP1)
      K2 = LOCP(IP2)
      XLO1 = BINS(K1+1)
      XLO2 = BINS(K2+1)
      XINT1 = BINS(K1+2)
      XINT2 = BINS(K2+2)
      MX1 = IBINS(K1+3) + 2
      MX2 = IBINS(K2+3) + 2
      MX3 = MX1*MX2
      YPR = XLO2 + (MX2-2)*XINT2
      BMAX = 0.
      XSUM = 0.0
      I3 = K + 1
      I4 = K + MX3
      DO 200 I2= I3, I4
      XSUM = XSUM + BINS(I2)
  200 BMAX = MAX(BMAX,ABS(BINS(I2)))
      L1 = K1 + 2*MX1 + 4
      L2 = L1 + LTITLE - 1
      L3 = K2 + 2*MX2 + 4
      L4 = L3 + LTITLE - 1
      WRITE(6,5003)I,DAT1,DAT2,IP1,(BINS(I2),I2=L1,L2)
      WRITE(6,5004)IP2,(BINS(I2),I2=L3,L4),IW
      WRITE(6,5009)XSUM,BMAX
      IF(BMAX.EQ.0.) GOTO 500
      FACTOR = 9.99/BMAX
      I2 = 1
      IBLIP = MX1/5 + 1
      Q = XLO1
      IF(MX1.LE.40) GOTO 350
C         BIG SCATTERGRAM
      WRITE(6,5006)(BLIP,I3=1,IBLIP)
  270 INDEX = K + MX1*(MX2-I2)
      DO 280 I3= 1, MX1
      INDEX = INDEX +1
      B = BINS(INDEX)
      ILET = ABS(B*FACTOR) + 1.0
      IF(B) 272, 275, 277
  272 KOUT(I3) = NETTER(ILET)
      GOTO 280
  275 KOUT(I3) = IBLANK
      GOTO 280
  277 KOUT(I3) = LETTER(ILET)
  280 CONTINUE
      WRITE(6,5001)(KOUT(I3),I3=1,MX1)
      IF(I2.GE.MX2) GOTO 300
      WRITE(6,5002)YPR
      YPR = YPR - XINT2
      I2 = I2 + 1
      GOTO 270
  300 CONTINUE
      WRITE(6,5006)(BLIP,I3=1,IBLIP)
      DO 310 J= 1, IBLIP
      PLACE(J) = Q
  310 Q = Q + XINT1* 5.0
      WRITE(6,5007)(PLACE(J),J=1,IBLIP)
      GOTO 500
C         SMALL SCATTERGRAM
  350 FACTOR = FACTOR * 10.
      WRITE(6,5005)(BLIP,I3=1,IBLIP)
  370 INDEX = K + MX1*(MX2-I2)
      DO 380 I3= 1, MX1
      INDEX = INDEX + 1
  380 KOUT(I3) = BINS(INDEX)*FACTOR
      WRITE(6,5011)(KOUT(I3),I3=1,MX1)
      IF(I2.GE.MX2) GOTO 400
      WRITE(6,5002)YPR
      YPR = YPR - XINT2
      I2 = I2 + 1
      GOTO 370
  400 CONTINUE
      WRITE(6,5005)(BLIP,I3=1,IBLIP)
      DO 410 J= 1, IBLIP
      PLACE(J) = Q
  410 Q = Q + XINT1* 5.0
      WRITE(6,5008)(PLACE(J),J=1,IBLIP)
  500 CONTINUE
  510 CONTINUE
      RETURN
 5001 FORMAT(8X,60A2)
 5011 FORMAT(8X,40I3)
 5002 FORMAT(1H ,F8.4,1H-)
#if defined(CERNLIB_CDC)
 5003 FORMAT(6H1 SCAT,I4,91X,2A6/10X,17HHORIZONTAL, PLACE,I4,2X,8A10)
 5004 FORMAT(12X,15HVERTICAL, PLACE,I4,2X,8A10/21X,6HWEIGHT,I4)
#endif
#if !defined(CERNLIB_CDC)
 5003 FORMAT(6H1 SCAT,I4,91X,2A4/10X,17HHORIZONTAL, PLACE,I4,2X,8A4)
 5004 FORMAT(12X,15HVERTICAL, PLACE,I4,2X,8A4 /21X,6HWEIGHT,I4)
#endif
 5005 FORMAT(11X,7(A1,14X),A1)
 5006 FORMAT(11X,11(A1,9X),A1)
 5007 FORMAT(6X,12F10.4)
 5008 FORMAT(3X,8F15.6)
 5009 FORMAT(85X,17HSUM OF WEIGHTS IS ,E12.4/82X,20HHIGHEST BIN CONTAINS
     +,E12.4//)
      END
