* * $Id: hp1rot.F,v 1.1.1.1 1996/01/16 17:07:45 mclareni Exp $ * * $Log: hp1rot.F,v $ * Revision 1.1.1.1 1996/01/16 17:07:45 mclareni * First import * * #include "hbook/pilot.h" *CMZ : 4.22/11 23/08/94 14.17.45 by Rene Brun *-- Author : SUBROUTINE HP1ROT(C,E,F,IDME,XMIN,XMAX,X0,XSIZE,ISIGNE,IEXP1, +IEXP2,D,B) *.==========> *. THIS ROUTINE PRINTS ONE LINE OF A 1-DIM HISTOGRAM *. IF THE USER HAS CALLED HROTAT . *. PRINTS ALSO AXIS AND LABELS AT BEGINNING AND END *..=========> ( R.Brun ) #include "hbook/hcbits.inc" #include "hbook/hcprin.inc" COMMON/HFORM/IA(127),IDU DIMENSION A(127),B(1),D(1) EQUIVALENCE (A(1),IA(1)) SAVE AL10,ICONT,MLOW,XLOW,MST,XINTEG,PAS SAVE CLAST,ELAST,FLAST,IOLD,ICHAN,ITERM,ICASE,NCOL,NLINE SAVE XMINI,XFIRST,IICHAN,IERMIN,IERMAX DATA AL10/2.30259/ *.___________________________________________ IF(IDME.GE.0)GO TO 120 IF(I17.EQ.0)MSTEP=1 MST=MSTEP/2+1 IF(MOD(MSTEP,2).EQ.0)MST=MST-1 ITERM=0 * * ICONT=0 IF CONTOUR TO BE PRINTED * I27=I27*(1-I34) I28=I28*(1-I34) ICONT=I34+I27+I28 IF(ICONT.NE.0)ITERM=1 IOLD=0 ICASE=1 IF(I17.NE.0)ICASE=ICASE+4 IF(I27.NE.0)ICASE=ICASE+1 IF(I28.NE.0)ICASE=ICASE+2 IF(I34.NE.0)ICASE=ICASE+3 * * ICASE=1 CONTOUR HISTOGRAM ICASE=5 CONTOUR HISTOGRAM B * 2 BLACK 6 BLACK WITH BIGBIN * 3 STAR 7 STAR * 4 ERRORS 8 ERRORS * CLAST=C ELAST=E FLAST=F * * PRINTING OF LONGITUDINAL AXIS AND SCALE * NCOL=10*(3+I22+I31+I14-I29-I30-I15) NLINE=NCOLPA-NCOL * * DEFINITION OF CHARACTERS TO BE PRINTED (HBLACK,HCROSS) * * 5 CONTINUE IF(IDME.EQ.1)CALL HFORMA(2) CALL VZERO(A,NCOLPA) MLOW=0 XINTEG=0. IF(I26.NE.0)GO TO 20 * * DEFINITION SCALE LINEAR CASE * IF(IDME.EQ.1)GO TO 7 PAS=(XMAX-XMIN)/FLOAT(NLINE) XMINI=XMIN XMAXI=XMAX CALL HBIN(XMIN,XMAX,NLINE,XMIN,XMAX,NLINE,PAS) IF(I24.EQ.0)GO TO 7 IF(PAS.GT.1.)GO TO 7 PAS=1. XMIN=XMINI XMAX=XMAXI NLINE=XMAX-XMIN+1. 7 N=0 DO 10 I=1,NLINE,4 N=N+1 10 A(N)=XMIN+FLOAT(I-1)*PAS GO TO 40 * * DEFINITION SCALE LOGAR CASE * 20 IF(IDME.NE.1)THEN XFIRST=LOG10(XMIN) XLAST=LOG10(XMAX) PAS=LOG10(XMAX/XMIN)/FLOAT(NLINE) CALL HBIN(XFIRST,XLAST,NLINE,XFIRST,XLAST,NLINE,PAS) XMIN=EXP(AL10*XFIRST) XMAX=EXP(AL10*XLAST) ENDIF N=0 DO 30 I=1,NLINE,4 N=N+1 XLAST=XFIRST+FLOAT(I-1)*PAS A(N)=EXP(AL10*XLAST) 30 CONTINUE * 40 ICHAN=4*N N=NCOL-7 IMF=MSTEP XMAMI=XMAX IF(ABS(XMIN).GT.ABS(XMAX))XMAMI=XMIN CALL HPCONT(' ',A,ICHAN,7,XMAMI,D,N,B,ISIGNE, + IEXP1,IEXP2) MSTEP=IMF ICHAN=7 IF(IDME.EQ.1)RETURN * * PRINT AXIS WITH LABELS * 45 N=1 CALL VBLANK(IA,NCOLPA) * * LOW EDGE * IF(I15.NE.0)GO TO 50 CALL UCTOH('LOW EDGE',IA(N+1),1,8) N=N+10 * * INTEGRATION * 50 IF(I22.EQ.0)GO TO 60 CALL UCTOH('INTEGRAT',IA(N+1),1,8) N=N+10 * * FUNCTION * 60 IF(I14.EQ.0)GO TO 70 IF(I12.EQ.0)GO TO 70 CALL UCTOH('FUNCTION',IA(N+1),1,8) N=N+10 * * ERRORS * 70 IF(I31.EQ.0)GO TO 80 CALL UCTOH('ERRORS',IA(N+2),1,6) N=N+10 * * CONTENTS * 80 IF(I30.NE.0)GO TO 90 CALL UCTOH('CONTENTS',IA(N+1),1,8) N=N+10 * * CHANNELS * 90 IF(I29.NE.0)GO TO 100 CALL UCTOH('CHANNELS',IA(N+1),1,8) N=N+10 100 CONTINUE * ICHAN=N * DO 110 I=1,NLINE N=N+1 110 IA(N)=IDG(39) * DO 115 I=1,NLINE,4 IA(ICHAN)=IDG(19) 115 ICHAN=ICHAN+4 * CALL HFORMA(1) IF(IDME.EQ.1)GO TO 5 * * * LOW EDGE * 120 CONTINUE IF(ICONT.EQ.0)THEN IF(IDME.EQ.-1)RETURN GO TO 122 ENDIF * * 121 CLAST=C ELAST=E FLAST=F 122 MLOW=MLOW+1 CALL VBLANK(IA,NCOLPA) N=0 IF(I15.NE.0)GO TO 150 IF(MSTEP.EQ.1)GO TO 125 IF(MOD(MLOW,MSTEP).NE.1)GO TO 140 125 XLOW=X0 IF(ITERM.EQ.1)XLOW=XLOW+XSIZE CALL HBCDF(XLOW,9,IA(N+1)) IF(ABS(XLOW).LT.0.001)IA(N+5)=IDG(1) 140 N=N+10 * 150 ICHAN=MLOW-MST IF(MOD(ICHAN,MSTEP).NE.0)GO TO 250 * * INTEGRATION * IF(I22.EQ.0)GO TO 170 XINTEG=XINTEG+CLAST CALL HBCDF(XINTEG,9,IA(N+1)) N=N+10 * * FUNCTION * 170 IF(I14.EQ.0)GO TO 190 IF(I12.EQ.0)GO TO 190 CALL HBCDF(FLAST,9,IA(N+1)) N=N+10 * * ERRORS * 190 IF(I31.EQ.0)GO TO 210 CALL HBCDF(ELAST,9,IA(N+1)) N=N+10 * * CONTENTS * 210 IF(I30.NE.0)GO TO 230 CALL HBCDF(CLAST,9,IA(N+1)) N=N+10 * * CHANNELS * 230 IF(I29.NE.0)GO TO 260 N=N+3 ICHAN=(MLOW+MST-1)/MSTEP IF(MOD(MSTEP,2).EQ.0)ICHAN=(MLOW+MST)/MSTEP CALL HBCDI(ICHAN,4,IA(N+1)) N=N+7 GO TO 260 * 250 N=N+10*(2+I14+I22+I31-I29-I30) * * CALCULATION OF FUNCTION CHANNEL * 260 IFUNC=0 IF(I12.EQ.0)GO TO 280 IF(I26.NE.0)GO TO 270 IFUNC=(FLAST-XMINI)/PAS GO TO 280 270 IF(FLAST/XMIN.LT.1.)GO TO 280 IFUNC=LOG10(FLAST/XMIN)/PAS * * CALCULATION OF HISTOGRAM CHANNEL * 280 ICHAN=0 XCHAN=0. INEW=0 IF(IFUNC.LT.0)IFUNC=0 IF(IFUNC.NE.0)IFUNC=IFUNC+2-I26 IF(I26.EQ.0)THEN XCHAN=(CLAST-XMINI)/PAS ICHAN=XCHAN YCHAN=ICHAN IF(YCHAN.EQ.0.)YCHAN=1. IICHAN=10.*MOD(XCHAN,YCHAN)+1.0001 IF(IICHAN.EQ.1)IICHAN=41 INEW=(C-XMINI)/PAS IF(XMINI.NE.0..AND.INEW.EQ.0)INEW=INEW+1 IF(XMINI.NE.0..AND.ICHAN.EQ.0)ICHAN=ICHAN+1 IF(ICHAN.LT.0)ICHAN=0 IF(INEW.LT.0)INEW=0 ELSE IF(CLAST/XMIN.GE.1.)THEN XCHAN=LOG10(CLAST/XMIN)/PAS ICHAN=XCHAN YCHAN=ICHAN IF(YCHAN.EQ.0.)YCHAN=1. IICHAN=10.*MOD(XCHAN,YCHAN)+1.0001 IF(IICHAN.EQ.1)IICHAN=41 IF(CLAST.EQ.XMIN)ICHAN=1 IF(CLAST.EQ.XMIN)IICHAN=34 IF(C/XMIN.LT.1.)GO TO 300 INEW=LOG10(C/XMIN)/PAS ENDIF ENDIF * 300 CONTINUE IF(XCHAN.GT.0.)ICHAN=ICHAN+2-I26 IF(INEW.NE.0)INEW=INEW+2-I26 * * NUMBER OF CHANNELS PRINTED FOR ERROR * IF(I34.EQ.0)GO TO 500 IERMIN=0 IERMAX=0 IF(I26.NE.0)GO TO 350 IF(ICHAN.EQ.0)GO TO 4500 IERMIN=(CLAST-E-XMINI)/PAS+2. IERMAX=(CLAST+E-XMINI)/PAS+2. ICHAN=(IERMIN+IERMAX)/2 GO TO 400 350 XCHAN=(CLAST-E)/XMIN IF(XCHAN.LE.1.)GO TO 360 IERMIN=LOG10(XCHAN)/PAS +1. 360 YCHAN=(CLAST+E)/XMIN IF(YCHAN.LE.1.)GO TO 400 IERMAX=LOG10(YCHAN)/PAS +1. * 400 IF(IERMIN.LE.0)IERMIN=1 IF(IERMAX.LE.0)IERMAX=1 * 500 IF(IFUNC.GT.NLINE)IFUNC=NLINE IF(ICHAN.GT.NLINE)ICHAN=NLINE IF(INEW.GT.NLINE)INEW=NLINE IF(IERMIN.GT.NLINE)IERMIN=NLINE IF(IERMAX.GT.NLINE)IERMAX=NLINE IF(ICHAN.LE.0)GO TO 8500 * * GO TO(1000,2000,3000,4000,1000,6000,7000,8000),ICASE * * * 1000 I=2 J=2 K=2 IF(IOLD.LT.ICHAN)I=1 IF(IOLD.GT.ICHAN)I=3 IF(INEW.LT.ICHAN)K=1 IF(INEW.GT.ICHAN)K=3 I=10*I+J+K-2 K=MOD(I,10) J=MOD(I,100)-K J=J/10 J=2*J-1 IF(J.EQ.1)J=0 IF(J.EQ.5)J=6 I=J+K IF(I.EQ.1.AND.INEW.LT.IOLD)I=4 * GO TO (1121,1121,1121,1221,1222,1222,1221,1222,1222),I * 1121 I=IOLD IF(I.EQ.0)I=1 CALL VFILL(IA(N+I),ICHAN-I+1,IDG(39)) IA(N+ICHAN)=IDG(19) GO TO 8500 1221 I=INEW IF(I.EQ.0)I=1 CALL VFILL(IA(N+I),ICHAN-I+1,IDG(39)) 1222 IA(N+ICHAN)=IDG(19) * GO TO 8500 * * 2000 CONTINUE * BLACK HISTOGRAM * CALL VFILL(IA(N+1),ICHAN,ICBLAC) IA(N+ICHAN)=IDG(IICHAN) GO TO 4500 * * STAR HISTOGRAM * 3000 IA(N+ICHAN)=ICSTAR GO TO 4500 * 4000 CONTINUE * * HISTOGRAM WITH ERRORS * CALL VFILL(IA(N+IERMIN),IERMAX-IERMIN+1,IDG(39)) IA(N+IERMIN)=IDG(19) IA(N+IERMAX)=IDG(19) IA(N+ICHAN)=IDG(25) * 4500 IF(I12.EQ.0)GO TO 9000 IF(IFUNC.NE.0)IA(N+IFUNC)=ICFUNC GO TO 9000 * * SAME FOR HISTOGRAM WITH BIGBIN * * 6000 CONTINUE CALL VFILL(IA(N+1),ICHAN,IDG(34)) IA(N+ICHAN)=IDG(IICHAN) GO TO 8500 * 7000 CONTINUE IA(N+ICHAN)=ICSTAR GO TO 8500 * 8000 IF(MOD(MLOW-MST,MSTEP).NE.0)GO TO 9000 CALL VFILL(IA(N+IERMIN),IERMAX-IERMIN+1,IDG(39)) IA(N+IERMIN)=IDG(19) IA(N+IERMAX)=IDG(19) IA(N+ICHAN)=IDG(25) * 8500 IF(I12.EQ.0)GO TO 9000 IF(MOD(MLOW-MST,MSTEP).NE.0)GO TO 9000 IF(IFUNC.NE.0)IA(N+IFUNC)=ICFUNC * 9000 CALL HFORMA(1) * IOLD=ICHAN CLAST=C ELAST=E FLAST=F IF(IDME.NE.1)RETURN IF(ITERM.EQ.1)GO TO 45 ITERM=1 GO TO 121 * END