*
* $Id: hpr1v.F,v 1.1.1.1 1996/01/16 17:07:46 mclareni Exp $
*
* $Log: hpr1v.F,v $
* Revision 1.1.1.1 1996/01/16 17:07:46 mclareni
* First import
*
*
#include "hbook/pilot.h"
*CMZ : 4.22/11 23/08/94 14.17.45 by Rene Brun
*-- Author :
SUBROUTINE HPR1V(C,E,F,A,W,ICAS,NCX,NUM,XX0,XXSIZE,XMIN,XMAX)
*.==========>
*. CONTROL ROUTINE TO PRINT A 1-DIM HIST VERTICAL
*..=========> ( R.Brun )
DIMENSION C(3),E(1),F(1),A(1),W(1)
#include "hbook/hcbook.inc"
#include "hbook/hcbits.inc"
#include "hbook/hcprin.inc"
*.___________________________________________
* NO ENTRIES CASE
*
IF(IQ(LCONT+KNOENT).EQ.0)THEN
NOENT=2
NH=NH+1
CALL HPTIT(ICAS,NUM,0.,0.)
RETURN
ENDIF
*
IF(I1.EQ.0)THEN
I20=0
I21=0
ENDIF
NOLD=4
I34=NOENT
NH=NH+1
IF(I11.NE.0)I34=1
X0=XX0
XSIZE=XXSIZE
MSTEP=1
NHT=1
IH=1
NC=NCX-2
ICN=NC
NHT=NCOLPA-16
IF(NHT.GT.100)NHT=100
NHT=(NC+NHT-1)/NHT
ALLCHA=0.
ICMAX=0
XMAXI=-BIGP
XMINI=-XMAXI
IF(NHT.NE.1)THEN
DO 5 I=1,NC
C(1)=HCX(I,1)
ALLCHA=ALLCHA+C(1)
XMAXI=MAX(XMAXI,C(1))
IF(I26.NE.0.AND.C(1).EQ.0.)GO TO 5
XMINI=MIN(XMINI,C(1))
5 CONTINUE
FACTOR=ALLCHA
IF(I18.NE.0)THEN
FACTOR=Q(LCID+KNORM)
IF(ALLCHA.NE.0.)FACTOR=FACTOR/ALLCHA
ENDIF
IF(FACTOR.EQ.ALLCHA)FACTOR=1.
C(1)=XMAXI*FACTOR
IF(I20.NE.0)THEN
XMAX20=Q(LCID+KMAX1)*FACTOR
IF(XMAX20.GT.C(1))C(1)=XMAX20
ENDIF
CALL HFACT(C,1,ISIGNE,IEXP1,IEXP2,FACT)
XMAXI=C(1)
XMINI=XMINI*FACTOR*FACT
IF(I20.NE.0)XMAXI=Q(LCID+KMAX1)*FACT
IF(I21.NE.0)XMINI=Q(LCID+KMIN1)*FACT
ENDIF
*
XMAXX=XMAXI
XMINX=XMINI
XINT=0.
*
DO 100 IH=1,NHT
*
XMINI=XMINX
XMAXI=XMAXX
ICMIN=ICMAX+1
ICMAX=ICMIN+NCOLPA-29
IF(ICMAX.GT.NC)ICMAX=NC
*
J=0
ICN=ICMAX-ICMIN+1
IF(I34.NE.0)CALL VZERO(E,ICN)
IF(I12.NE.0)CALL VZERO(F,ICN)
*
DO 10 ICX=ICMIN,ICMAX
J=J+1
C(J)=HCX(ICX,1)
IF(I11.NE.0)THEN
E(J)=SQRT(ABS(C(J)))
ELSE
IF(NOENT.NE.0)E(J)=HCX(ICX,2)
ENDIF
IF(I12.NE.0)F(J)=HCX(ICX,3)
IF(NHT.NE.1)THEN
C(J)=C(J)*FACTOR*FACT
IF(I34.NE.0)E(J)=E(J)*FACTOR*FACT
IF(I12.NE.0)F(J)=F(J)*FACT
ELSE
ALLCHA=ALLCHA+C(J)
ENDIF
10 CONTINUE
IF(NHT.NE.1)GO TO 25
*
FACTOR=ALLCHA
IF(I18.NE.0)THEN
FACTOR=Q(LCID+KNORM)
IF(ALLCHA.NE.0.)FACTOR=FACTOR/ALLCHA
ENDIF
IF(FACTOR.EQ.ALLCHA)FACTOR=1.
DO 15 J=1,ICN
C(J)=C(J)*FACTOR
IF(I34.NE.0)E(J)=E(J)*FACTOR
15 CONTINUE
IF(I20.EQ.0)THEN
CALL HFACT(C,ICN,ISIGNE,IEXP1,IEXP2,FACT)
ELSE
C(ICN+1)=Q(LCID+KMAX1)
CALL HFACT(C,ICN+1,ISIGNE,IEXP1,IEXP2,FACT)
ENDIF
XMAXI=VMAX(C,ICN)
XMINI=BIGP
DO 20 J=1,ICN
IF(I34.NE.0)E(J)=E(J)*FACT
IF(I12.NE.0)F(J)=F(J)*FACT
IF(I26.NE.0.AND.C(J).LE.0.)GO TO 20
XMINI=MIN(XMINI,C(J))
20 CONTINUE
IF(I20.NE.0)XMAXI=Q(LCID+KMAX1)*FACT
IF(I21.NE.0)XMINI=Q(LCID+KMIN1)*FACT
*
* DEFINITION OF STEP WHEN HBIGBI
*
IF(I17.NE.0)THEN
MSTEP=JBYT(IQ(LCID),1,4)
IF(MSTEP.EQ.0)MSTEP=NCOLMA/ICN
IF(MSTEP.GT.NCOLMA/ICN)MSTEP=1
IF(MSTEP.EQ.0)MSTEP=1
K=0
DO 22 I=1,ICN
DO 22 J=1,MSTEP
K=K+1
A(K)=C(I)
22 CONTINUE
CALL UCOPY2(A,C,ICN*MSTEP)
*
IF(I34.NE.0)THEN
K=0
DO 23 I=1,ICN
DO 23 J=1,MSTEP
K=K+1
A(K)=E(I)
23 CONTINUE
CALL UCOPY2(A,E,ICN*MSTEP)
ENDIF
*
IF(I12.NE.0)THEN
K=0
DO 24 I=1,ICN
DO 24 J=1,MSTEP
K=K+1
A(K)=F(I)
24 CONTINUE
CALL UCOPY2(A,F,ICN*MSTEP)
ENDIF
ENDIF
*
* PRINT TITLE AND HISTOGRAM
*
25 ICN=ICN*MSTEP
NLTIT=1
IF(LGTIT.NE.0)NLTIT=NLTIT+3
NLCONT=3*(1-I29)+5*(2+I14+I31+I22-I30-I15)
NLSTAT=I25*(2+I12)
NLINE=NLINPA-NLTIT-NLCONT-NLSTAT+NLINPA*I23
*
CALL HPTIT(ICAS,NUM,XMIN,XMAX)
*
IF(I16.EQ.0)THEN
CALL HP1DIM(C,E,F,ICN,XMINI,XMAXI,NLINE)
ENDIF
CALL HFORMA(2)
MST=-1
*
*
* PRINT CHANNELS
*
IF(I29.EQ.0)THEN
NLTIT=IDG(41)
IF(I17.NE.0)NLTIT=IDG(37)
NLCONT=ICMAX*MSTEP
CALL HPCHAN(NLTIT,ICMIN,NLCONT,ICN,A)
CALL HFORMA(2)
ENDIF
*
* PRINT CONTENTS
*
IF(I30.EQ.0)THEN
K=0
DO 35 I=MSTEP,ICN,MSTEP
K=K+1
C(K)=C(I)
35 CONTINUE
XMAXI=VMAX(C,ICN)
XMAXI=ABS(XMAXI)
XMINI=VMIN(C,ICN)
IF(ABS(XMINI).GT.XMAXI)XMAXI=XMINI
CALL HPCONT('CONTENTS',C,ICN,1,XMAXI,A,MST+3,W,ISIGNE,
+ IEXP1,IEXP2)
ENDIF
*
* PRINT ERRORS
*
IF(I31*I34.NE.0)THEN
K=0
DO 45 I=MSTEP,ICN,MSTEP
K=K+1
E(K)=E(I)
45 CONTINUE
XMAXI=VMAX(E,ICN)
CALL HPCONT('ERROR ',E,ICN,2,XMAXI,A,MST+3,W,ISIGNE,
+ IEXP1,IEXP2)
ENDIF
*
* PRINT FUNCTION
*
IF(I14.NE.0.AND.I12.NE.0)THEN
K=0
DO 55 I=MSTEP,ICN,MSTEP
K=K+1
F(K)=F(I)
55 CONTINUE
XMAXI=VMAX(F,ICN)
XMINI=VMIN(F,ICN)
IF(ABS(XMINI).GT.XMAXI)XMAXI=XMINI
CALL HPCONT('FUNCTION',F,ICN,3,XMAXI,A,MST+3,W,ISIGNE,
+ IEXP1,IEXP2)
ENDIF
*
* PRINT INTEGRATED CONTENTS
*
IF(I22.NE.0)THEN
CALL VZERO(A,ICN)
A(1)=XINT+C(1)
DO 70 I=2,ICN
A(I)=A(I-1)+C(I)
70 CONTINUE
XINT=A(ICN)
CALL UCOPY2(A,C,ICN)
CALL HFACT(C,ICN,IL1,IL2,IL3,CHI)
XMAXI=ABS(VMAX(C,ICN))
XMINI= VMIN(C,ICN)
IF(ABS(XMINI).GT.XMAXI) XMAXI=XMINI
CALL HPCONT('INTEGRAT',C,ICN,4,XMAXI,A,MST+3,W,IL1,IL2,IL3)
ENDIF
*
* PRINT LOW-EDGE
*
IF(I15.EQ.0)THEN
C(1)=X0
DO 90 I=2,ICN
IF(I6.EQ.0)THEN
C(I)=C(I-1)+XSIZE
ELSE
LBINS=LQ(LCID-2)
C(I)=Q(LBINS+I)
ENDIF
90 CONTINUE
X0=C(ICN)+XSIZE
CALL HFACT(C,ICN,IL1,IL2,IL3,CHI)
MST=2
XMAXI=ABS(C(ICN))
IF(ABS(C(1)).GT.XMAXI)XMAXI=C(1)
CALL HPCONT('LOW-EDGE',C,ICN,5,XMAXI,A,MST,W,IL1,IL2,IL3)
ENDIF
100 CONTINUE
IEXP2=IDG(41)
IEXPL2=IDG(41)
*
* PRINT STATISTICS
*
IF(I25.EQ.0)THEN
ICN=ICMAX
CHI=-1.
IF(I12.NE.0)THEN
CHI=0.
DO 110 I=1,ICN
C(1)=HCX(I,1)
C(2)=HCX(I,3)/FACTOR
C(3)=C(1)
IF(NOENT.NE.0)C(3)=HCX(I,2)**2
IF(C(3).EQ.0.)GO TO 110
CHI=CHI+((C(1)-C(2))**2)/C(3)
110 CONTINUE
ENDIF
*
CALL HPRST(ALLCHA,ISIGNE,ISIGNL,IEXP1,IEXP2,
+ IEXPL1,IEXPL2,CHI)
ENDIF
*
END