SUBROUTINE HIPRPL(LUN,IHS,IZMIN,IZMAX,IXMIN,IXMAX, 1 IYMIN,IYMAX,IHIGH,IWIDE,Iterm) C C SUBROUTINE TO PLOT HISTOGRAMS ON any printer c LUN = Fortran logical unit for output C IHIS = HIST # C C IZMIN,IZMAX = SCALE FOR 1 OR 2 DIM HISTS C 0 = AUTO SCALE C IZMIN = ANY CONTOUR # FOR 2 DIM PLOT c IXMIN,IZMAX = Minimum and max X to print c IYMIN,IYMAX = min + MAX Y to plot c IHIGH = height of paper (max of 100) c IWIDE = width of paper (max of 250) c If any pair of max, min are omitted the scale will be c automatically set. C BYTE IB(155),IPARAM(12),IDIG,ILEV(12),ISNUM(10) INTEGER*4 IN2,IXMIN,IXMAX,IYMIN,IYMAX,IZMIN,IZMAX BYTE IATST(155),ILINE(6),SET100(15) DATA ILINE /'s','r','q','p','o','^'/ DATA SET100/0,27,'(','B',27,')','0',15 ! SET spec. chars 1 ,27,'[','H',27,'[','2','J'/ ! HOME AND ERASE real DIVS(12) REAL JZMIN,JZMAX,JZSTEP,NUMBER COMMON /SCRAT/IA(121),IB,D(121) DATA DIVS/1.,1.E1,1.E2,1.E3,1.E4,1.E5,1.E6,1.E7,1.E8, 1 1.E9,1.E10,1.E11/ DATA ILEV/'-','0','1','2','3','4','5','6','7','8','9','+'/ DATA ISNUM/1,2,3,4,5,6,6,6,6,10/ DATA IHIS /0/ ! Initially no hist C C Now pick up all the parameters if they exist c CALL PARAMS(IPARAM,12) ! Get parameter bits c c zero for IPARAM=no parameter; IPARAM(1)=# of params c IF(IPARAM(2) .eq. 0 .or. IPARAM(3) .eq. 0) ! Bad params ?? 1 STOP 'Bad input params in HIPRPL' IF(IHS .gt. 0) IHIS = IHS ! New hist ? CALL HSTAT(IHIS,IXSIZ,IYSIZ,IXS,IX0,IYS,IY0,ITYPE)! Get sizes,scales IF(IXSIZ .LE. 0) RETURN ! No hist to plot ? IF(IHS .gt. 0) THEN ! New scales ? JZMIN = 0 IF(IPARAM(4) .ne. 0) JZMIN = IZMIN ! Pick up params JZMAX = 0 IF(IPARAM(5) .ne. 0) JZMAX = IZMAX ! Pick up params JXMIN = 0 IF(IPARAM(6) .ne. 0) JXMIN = IXMIN ! Pick up params JXMAX = 0 IF(IPARAM(7) .ne. 0) JXMAX = IXMAX ! Pick up params JYMIN = 0 IF(IPARAM(8) .ne. 0) JYMIN = IYMIN ! Pick up params JYMAX = 0 IF(IPARAM(9) .ne. 0) JYMAX = IYMAX ! Pick up params c c IX,IY are the max number of points on horix + vertical c IXCHAR= Number of plot chars in X direction c total line size = IXCHAR+12 c JXWID = Number of chars/chan in horiz direction c JXSTEP= Number of chans to add together in X c JYSTEP= Number of chans to add in Y c JXMIN,JXMAX,JYMIN,JYMAX will be the min max chan#-1 c IJUMP = Number of 16 bit words/channel in hist c IY = 21 ! Default IF(IPARAM(10).ne. 0) IY = IHIGH-3 ! Paper height IF(IYSIZ .gt. 1) IY = IY - 1 IF(IY .lt. 10) IY = 10 ! Limit height IF(IY .gt. 97) IY = 97 IX = 68 IF(IPARAM(11) .ne. 0) IX = IWIDE-12 ! If width specified! IF(IX .gt. 132) IX = 132 ! Set max width IF(IX .lt. 20) IX = 20 ! Set minimum width Jterm = 0 IF(IPARAM(12) .ne. 0) Jterm = Iterm ! Set default term IXCHAR = IX CALL MGETF(0,MKMAX,TEMP) ! get maximum marker number IN2 = 0 ! START WITH ZERO ITYPE = IAND("3,ITYPE) IJUMP = 2 ! words/channel IF(ITYPE .EQ. 1) IJUMP = 1 C C SECTION TO DETERMINE SCALES + RANGES C JXMIN = (JXMIN-IX0)/IXS ! Minimum x index JXMAX = (JXMAX-IX0)/IXS ! Max x index IF(JYMIN .eq. 0 .and. JYMAX .eq. 0) THEN ! Both Y zero ? JYMAX = IYSIZ-1 JYMIN = 0 ELSE JYMIN = (JYMIN-IY0)/IYS ! Same for y JYMAX = (JYMAX-IY0)/IYS ENDIF IF(JXMIN .LT. 0)JXMIN = 0 ! Min index too small? IF(JYMIN .LT. 0)JYMIN = 0 IF(JXMAX .GE. IXSIZ)JXMAX = IXSIZ-1 ! Max index too big? IF(JYMAX .GE. IYSIZ)JYMAX = IYSIZ-1 IF(JXMIN .lt. JXMAX) GO TO 25 ! Sensible X range ? JXMIN = 0 ! Do whole x axis JXMAX = IXSIZ-1 25 IF(JYMAX .GE. JYMIN) GO TO 30 ! Sensible Y range ? JYMIN = 0 ! Set up to do all Y JYMAX = IYSIZ-1 30 CONTINUE IF(ABS(JZMIN) .GT. 4.0E11) JZMIN = 0. ! Limit Z scale IF(ABS(JZMAX) .GT. 4.0E11) JZMAX = 0. ! Limit Z scale JXSTEP = (JXMAX-JXMIN+IX)/IX ! Points to Sum stepl IF(JXSTEP .LE. 0) JXSTEP = 1 ! Limit it IX = (JXMAX-JXMIN+JXSTEP)/JXSTEP ! Reset Number of cols. JXWID = IXCHAR/IX ! Number of cols/chan IF(JXWID .le. 0) JXWID = 1 IF(JXWID .gt. 10) JXWID = 10 JXWID = ISNUM(JXWID) ! Set up evenly div in 10 IXCHAR = IX*JXWID ENDIF C C SET UP TO OUTPUT TITLES C MAX = 15 IF(IHS .lt. 0) MAX = 11 ! No erase ? IF(JTERM .EQ. 100) WRITE(LUN,1098) (SET100(j),j=1,max) 40 DO 41 J = 1,50 41 IB(J) = ' ' CALL GTITL(0,IB(2),5) ! Experiment title CALL GTITL(IHIS,IB(14),5) ! Hist title CALL TIME(IB(25)) ! GET TIME CALL DATE(IB(34)) ! GET DATE INTO ARRAY IB(50) = ' ' IF(JTERM .EQ. 100) THEN ! VT-100 ? IB(50) = 14 IB(1) = '+' ENDIF IF(JYMAX .gt. JYMIN) go to 400 ! 2 dim hist ? C C DO 1 DIMENSIONAL HIST C DO 45 J = 1,120 45 D(J) = 0. ! Clear array of sums INDEX = 1 ICHAN = (JXMIN+IXSIZ*JYMIN) * IJUMP + 1! First chan number SUMAX = -1.E30 ! Initialize min + max of sum SUMIN = 1.E30 TOT = 0. DO 60 J = JXMIN,JXMAX,JXSTEP SUM = 0. DO 50 JJ= J,J+JXSTEP-1 IF(JJ .GT. JXMAX) GO TO 50 ! Ooutside of X range ? CALL HGET(IHIS,IN2,ICHAN,IJUMP,ISZ) ! Get 1 chan of hist TEMP = IN2 ! Convert integer to float ICHAN = ICHAN + IJUMP ! Next chan number SUM = SUM + TEMP ! Sum up over all samples 50 CONTINUE TOT = TOT + SUM ! Total # counts IF(J .eq. 0 .or. J+JXSTEP .ge. IXSIZ) go to 55 ! Overflow chan ?? IF(SUMIN .gt. SUM) SUMIN = SUM ! Find minimum of sum IF(SUMAX .lt. SUM) SUMAX = SUM ! Find maximum of sum IA(INDEX) = 0 ! Number of digits if 0. IF(SUM .gt. .5) IA(INDEX) = ALOG10(SUM) ! Number of digits > 0 55 D(INDEX)= SUM ! Save the raw data 60 INDEX = INDEX + JXWID ! Next chan with number WRITE(LUN,1021)(IB(J),J=1,45),IHIS,IXSIZ,TOT,IB(50) ! Output a line IF(IYSIZ .gt. 1) WRITE(LUN,1023) JYMIN*IYS+IY0 ! Write Y value DO 61 J = 1,132 61 IB(J) = ' ' ! Clear plot line IF(JZMIN .Ge. JZMAX) THEN ! No scale set ? JZMIN = SUMIN ! Set it to max + min JZMAX = SUMAX DO 63 J = 1,3 JZSTEP = (JZMAX-JZMIN)/IY ! Z step to try JZMIN = SUMIN ! Set it to max + min IF(JZSTEP .le. 1.) JZSTEP = 1 TEMP = JZSTEP ! Get floating JZSTEP ITEMP = ALOG10(TEMP) ! Number of digits-1 in JZSTEP TEMP = TEMP/10.**ITEMP ! Now is number 1 to 10 IF(TEMP .gt. 5.)TEMP = 10. ! Limit it to value 10 ? IF(TEMP .le. 5. .and. TEMP .gt. 2.) TEMP = 5. ! or 5 ? IF(TEMP .le. 2. .and. TEMP .gt. 1.) TEMP = 2. ! or 2 ? IF(TEMP .le. 1.) TEMP = 1. ! or 1 ? JZSTEP = NINT(TEMP*10.**ITEMP) ! Now have final Z step ITEMP = JZMIN/JZSTEP JZMIN = ITEMP*JZSTEP TEMP = ABS(SUMIN) ! smallest Number to print IF(TEMP .lt. JZSTEP) TEMP = JZSTEP ! or step if larger ITEMP = ALOG10(TEMP)+.99999 ! Number of digits in number JZMIN = JZMIN - JZSTEP*ITEMP ! Leave room for number JZMAX = JZMIN + JZSTEP*(IY) IF(JZMAX+JZSTEP .gt. SUMAX) go to 64 ! Adequate scales ? 63 CONTINUE 64 CONTINUE ELSE JZSTEP = (JZMAX-JZMIN)/IY ! Z step IF(JZSTEP .LE. 1) JZSTEP = 1 ! Must be 1 or larger ENDIF DO 65 J = 1,IXCHAR,JXWID ! Now set up hist scale fact TEMP = D(J) SUM = TEMP - JZMIN ! Subtract origin SUM = SUM/ JZSTEP ! Now find line number IF(SUM.LT. 0.) SUM = 0. ! Limit minimum value IF(SUM .GE. IY+1) THEN ! Sum too big ? IDIG = '^' ! Saturated channel ITEMP1 = IY ELSE ITEMP1 = SUM ! Normal chan IF(Jterm .eq. 100) THEN ! VT-100 ? ITEMP = (SUM-ITEMP1)*5. + 1. ! Divide into 5 parts IDIG = ILINE(ITEMP) ! Set up initial line else IDIG = '-' IF(SUM - ITEMP1 .lt. .5) IDIG = '_' ! Bottom half ? IF(SUM .eq. 0) IDIG = '_' ! underscore if zero ENDIF ENDIF DO 65 JJ = J,J+JXWID-1 IATST(JJ) = IDIG IA(JJ) = ITEMP1 ! Save vertical chan to plot 65 CONTINUE DO 66 J = 1,MKMAX CALL MGETF(J,IMK,TEMP) ! get hist # + marker value IF(IMK .eq. IHIS) THEN ! This marker for this hist.? IF(TEMP .LT. IX0) TEMP = IX0 ! TOO SMALL ? IF(TEMP .GT. IX0+IXS*IXSIZ) TEMP=IX0+IXS*IXSIZ ! TOO BIG ? TEMP = (TEMP-IX0)/IXS ! Get chan number ITEMP = 1+JXWID*(TEMP-JXMIN)/JXSTEP ! The index to array IB IF(ITEMP .gt. IXCHAR) ITEMP = IXCHAR ! Larger than max ?? IB(ITEMP+12) = '.' ! Mark cut with decimal pt. ENDIF 66 CONTINUE DO 80 K = IY,0,-1 DENOM = 1.E12 IF(K .LE. 11) DENOM=DIVS(K+1) ! DENOM for conversion NUMBER = JZMIN + K*JZSTEP IF(NUMBER .ge. 0) THEN ENCODE(12,1001,IB) NUMBER IB(12) = '$' ! Border for plot IF(JTERM .EQ. 100) IB(12) = 'x' ! If VT-100 ELSE DO 67 I = 1,132 IF(IATST(I) .ne. 0) IATST(I) = ' ' ! Set up blanks now 67 IB(I) = ' ' ENDIF MAX = 12 DO 75 I = 1,IXCHAR IF(IA(I) .LT. K) GO TO 70 ! Not plottable yet ? IB(I+12) = IATST(I) ! First time insert leading IF(IA(I) .eq. K) THEN ! First time ? IATST(I) = 'X' IF(jTERM .eq. 100) IATST(I) = 'a' ! Fill in hist GO TO 70 ENDIF c c Convert the channel height to a number c IF(K .gt. 12) go to 70 ! No convert ? ITEMP = D(I)/DENOM D(I) = D(I)-ITEMP*DENOM IDIG = '+' - '0' ! Set for overflow IF(ITEMP .le. 9) IDIG = ITEMP ! Not Overflow digit ? IF(IATST(I) .ne. 0.and. IDIG .eq. 0)go to 70 ! Suppress leading 0 ? IB(I+12)='0'+IDIG ! Printable number IATST(I) = 0 70 IF(IB(I+12) .NE. ' ') MAX = I+12 ! Find max printable 75 CONTINUE WRITE(LUN,1099) (IB(JOUT),JOUT=1,MAX) 80 CONTINUE GO TO 600 ! Now do X scale C C DO 2 DIMENSIONAL HISTS HERE C 400 CONTINUE JXWID = 1 IXCHAR = IX JYSTEP = (JYMAX-JYMIN+IY)/IY ! # Y pts to add together IF(JYSTEP .le. 0) JYSTEP = 1 ! Must be > 0 IY = (JYMAX-JYMIN+JYSTEP)/JYSTEP ! Number of lines to plot IF(JZMIN .LT. JZMAX) go to 450 ! No auto scale ? JZMAX = 0 JZMIN = 1.E12 IN2 = 0 K = 1 ! IF 2 D IGNORE OVERFLOW c c Here we hunt through hist for largest value c MIN = JXMIN IF(MIN .eq. 0) MIN = MIN + JXSTEP ! Omit overflow MAX = JXMAX IF(MAX+JXSTEP .ge. IXSIZ) MAX = MAX - JXSTEP ! Omit overflow DO 440 I = JYMIN,JYMAX,JYSTEP ! Hunt over all values DO 410 J = 1,IX 410 D(J) = 0.0 DO 430 II = I,I+JYSTEP-1 IF(II .le. 0 .or. II .ge. IYSIZ) go to 430 ! Skip overflow K = 1 ! Position in D(K) ICHAN = IJUMP*(II*IXSIZ+MIN)+1 ! Initial chan # DO 430 J = MIN,MAX,JXSTEP ! Hunt over X values DO 420 JJ = 1,JXSTEP CALL HGET(IHIS,IN2,ICHAN,IJUMP,ISZ) TEMP = IN2 ! Convert integer to float D(K) = D(K) + TEMP 420 ICHAN = ICHAN + IJUMP ! Next channel to read K = K + 1 430 CONTINUE DO 435 J = 1,IX IF(D(J) .lt. JZMIN.and.D(J) .ne. 0.) JZMIN = D(J) ! Find min value 435 IF(D(J) .gt. JZMAX) JZMAX = D(J) ! Find max value 440 CONTINUE IF(JZMIN .gt. JZMAX) JZMIN = 1 ! No min found ? IF(JZMIN .le. 0) JZMIN = 1 ! Minimum countour IF(JZMAX .le. JZMIN) JZMAX = JZMIN+11 ! min contour 450 WRITE(LUN,1022)(IB(J),J=1,45), 1 IHIS,IXSIZ,IYSIZ,JZMIN,JZMAX,IB(50) ! Write first line ZSTEP = (JZMIN + JZMAX)/10. JYMAX = (JYMAX-JYMIN)/JYSTEP JYMAX = JYMAX*JYSTEP DO 500 I = JYMAX,JYMIN,-JYSTEP DO 460 J = 1,IX IB(J+12) = ' ' ! DEFALUT PLOT BLANK 460 D(J) = 0. ! Clear sum array DO 466 J = 1,MKMAX CALL MGETF(J,IMK,TEMP) ! get hist # + marker value IF(ABS(IMK) .eq. IHIS) THEN ! This marker for this hist.? IF(TEMP .LT. IX0) TEMP = IX0 ! TOO SMALL ? IF(TEMP .GT. IX0+IXS*IXSIZ) TEMP=IX0+IXS*IXSIZ ! TOO BIG ? TEMP = (TEMP-IX0)/IXS ! Get chan number IF(IMK .gt. 0) THEN ! vertical cut ? ITEMP = 1+(TEMP-JXMIN)/JXSTEP ! The index to array IB IF(ITEMP .gt. IX) ITEMP = IX ! Larger than max ?? IF(ITEMP .lt. 1) ITEMP = 1 ! Smaller than lowest ?? IB(ITEMP+12) = '.' ! Mark cut with decimal pt. ELSE ! Horizontal cut!! IF(TEMP .LT. IY0) TEMP = IY0 ! TOO SMALL ? IF(TEMP .GT. IY0+IYS*IYSIZ) TEMP=IY0+IYS*IYSIZ ! TOO BIG ? ITEMP = (TEMP-JYMIN)/JYSTEP+1 IF(ITEMP .lt. 0) ITEMP = 0 IF(ITEMP .gt. IY) ITEMP= IY ! Limit the cut line IF(ITEMP .eq. I) THEN ! Are we at horiz cut line ? DO 465 JJ = 1,IY 465 IB(JJ+12) = '.' ! Put in horiz cut GO TO 467 ! And done with cuts ENDIF ENDIF ENDIF 466 CONTINUE 467 DO 490 II = I,I+JYSTEP-1 IF(II .ge. IYSIZ) go to 490 ! Bad chan #? K = 1 DO 480 J = JXMIN,JXMAX,JXSTEP ICHAN = IJUMP*(II*IXSIZ+J)+1 DO 470 JJ = J,J+JXSTEP-1 IF(JJ .ge. IXSIZ) go to 470 ! Bad X chan# ? CALL HGET(IHIS,IN2,ICHAN,IJUMP,ISZ) TEMP = IN2 ! Convert integer to float D(K) = D(K) + TEMP ICHAN = ICHAN + IJUMP 470 CONTINUE K = K + 1 480 CONTINUE c c Now produce 1 line of plot c NUMBER = IY0 + IYS*I ! Y scale number ENCODE(12,1001,IB) NUMBER ! Into plot line IB(12) = '$' ! Border for plot IF(JTERM .EQ. 100) IB(12) = 'x' ! If VT-100 IF(I .eq. 0) IB(12) = '<' ! Underrange ? IF(I+JYSTEP .ge. IYSIZ) IB(12) = '>' ! Overrange ? MAX = 12 DO 490 J = 1,IX IF(D(J) .LT. JZMIN) GO TO 485 ! Outside limits ? ITEMP = (D(J)-JZMIN)/ZSTEP+2. ! Find the level IF(ITEMP .gt. 12) ITEMP = 12 ! Max level IF(ITEMP .lt. 1) ITEMP = 1 IB(J+12) = ILEV(ITEMP) ! Get Char to plot 485 IF(IB(J+12) .NE. ' ') MAX = J+12 ! Find max printable 490 CONTINUE WRITE(LUN,1099) (IB(J),J=1,MAX) ! Output a plot line 500 CONTINUE C C NOW PUT UP THE X SCALE C 600 CONTINUE ITEST = 10/JXWID ITEST = ITEST*JXWID IF(ITEST .ne. 10) ITEST = 12 ! Cols/number MAX = (IXCHAR-1)/ITEST ! Max x column for scale tic DO 610 J = 0,MAX K = (J*ITEST)/JXWID 610 IA(J+1) = IX0 + IXS* (JXMIN + K*JXSTEP ) ! X value IDIG = '$' IF(JTERM .eq. 100) IDIG = 'x' IF(ITEST .eq. 10) THEN ! 10 char scale ? ENCODE(132,1010,IB) (IA(J),IDIG,J=1,MAX+1) ! Set up scale ELSE ENCODE(132,1011,IB) (IA(J),IDIG,J=1,MAX+1) ! Set up scale ENDIF IF(JXMIN .eq. 0) IB(13) = '<' ! Mark underrange chan IF(JXMAX + JXSTEP .ge. IXSIZ) IB(IXCHAR+12) = '>' ! Mark overrange WRITE(LUN,1099) (IB(J),J=1,IXCHAR+12) ! Output a plot line IF(JTERM .EQ. 100) WRITE(LUN,1098) (SET100(j),j=1,11) ! Home screen 1000 format(I4,1x,10A1) 1001 FORMAT(F12.0) 1010 FORMAT(3X,12(I9,A1) ) 1011 FORMAT(1X,12(I10,' ',A1) ) 1021 FORMAT(45A1,I4' size='I4,' sum=',1p,G12.5,10A1) 1022 FORMAT(45A1,I4' 2d'I4' by'I4' contour=',1p,2G12.5,A1) 1023 FORMAT(1x,'Y = ',I15) 1098 FORMAT(133A1) 1099 FORMAT(1x,132A1) C C HERE THE PLOTTING IS TERMINATED C 900 CONTINUE END !EXIT FROM PROGRAM SUBROUTINE DIS2BR(IHIS,IZMIN,IZMAX,IXMIN,IXMAX,IYMIN,IYMAX) C C SUBROUTINE TO PLOT HISTOGRAMS any TERMINAL (22 lines by 80char) C IHIS = HIST # C C IZMIN,IZMAX = SCALE FOR 1 OR 2 DIM HISTS C 0 = AUTO SCALE c IXMIN,IXMAX,IYMIN,IYMAX determin max + min plot range C BYTE IB(10,5) INTEGER IHA(5) IF(ITERM .eq. 0) THEN ! Terminal not set up ? CALL ASKN('Terminal type?',ITERM,1,255,1) ! Ask for type CALL ASKN('Terminal height?',IHIGH,20,62,24) ! Ask for height CALL ASKN('Terminal width?',IWIDE,20,132,80) ! Ask for width ENDIF CALL HSTAT(0,IXSIZ,MAX) ! Get max hist number IF(MAX .le. 0) RETURN IF(IHIS .ge. 0) IHS = IHIS CALL HSTAT(IHS,IXSIZ) ! GET SIZE of hist IF(IXSIZ .LE. 0) THEN ! No hist to plot? c c Use IZMIN as min hist # and print out list of hists c DO 5 J =1,10 DO 5 K =1,5 5 IB(J,K) = ' ' ! Blank array for formatting CALL GTITL(0,IB,5) CALL DATE(IB(1,2)) ! Get date CALL TIME(IB(1,3)) ! And time WRITE(5,1001) IB ! Write expt + date,time MIN = IZMIN IF(IHS .gt. 0) MIN = IHS-20 ! If wrong hist make this min IF(MIN .le. 0 .or. MIN .gt. MAX) MIN = 1 IF(MAX .gt. MIN+99) MAX = MIN+99 ! Limit max hist DO 100 I= 0,19 DO 90 J= 1,5 IH = MIN + I + (J-1)*20 ! Hist number CALL HSTAT(IH,IXSIZE) ! Check if hist exists IF(IXSIZE .gt. 0) THEN ! Hist exists ? CALL GTITL(IH,IB(1,J),5) ! Get the label ELSE DO 20 K = 1,10 20 IB(K,J) = '-' ! Mark it empty ENDIF 90 IHA(J) = IH KMAX = (MAX-MIN - I+20)/20 IF(KMAX .lt. 1) RETURN WRITE(5,1000)(IHA(K),(IB(J,K),J=1,10),K=1,KMAX) 100 CONTINUE ELSE c c Here we plot the hist on unit 5 c CALL HIPRPL(5,IHIS,IZMIN,IZMAX,IXMIN,IXMAX,IYMIN,IYMAX, 1 IHIGH,IWIDE,ITERM) ! DO THE PLOT ENDIF 1000 FORMAT(5(I5,1x,10A1)) 1001 FORMAT(1x,132A1) END