mnplot.f

Go to the documentation of this file.

*
* $Id: mnplot.F,v 1.1.1.1 1996/03/07 14:31:31 mclareni Exp $
*
* $Log: mnplot.F,v $
* Revision 1.1.1.1  1996/03/07 14:31:31  mclareni
* Minuit
*
*
      SUBROUTINE mnplot(XPT,YPT,CHPT,NXYPT,NUNIT,NPAGWD,NPAGLN)
*
* $Id: d506dp.inc,v 1.1.1.1 1996/03/07 14:31:32 mclareni Exp $
*
* $Log: d506dp.inc,v $
* Revision 1.1.1.1  1996/03/07 14:31:32  mclareni
* Minuit
*
*
*
*
* d506dp.inc
*
C ************ DOUBLE PRECISION VERSION *************
      IMPLICIT DOUBLE PRECISION (a-h,o-z)
CC        plots points in array xypt onto one page with labelled axes
CC        NXYPT is the number of points to be plotted
CC        XPT(I) = x-coord. of ith point
CC        YPT(I) = y-coord. of ith point
CC        CHPT(I) = character to be plotted at this position
CC        the input point arrays XPT, YPT, CHPT are destroyed.
CC
      dimension   xpt(*), ypt(*)
      CHARACTER*1 CHPT(*) ,  CHSAV,  CHBEST, CDOT, CSLASH, CBLANK
      parameter(maxwid=100)
      CHARACTER CLINE*100, CHMESS*30
      dimension xvalus(12)
      LOGICAL OVERPR
      DATA cdot,cslash,cblank/ '.' , '/' , ' '/
      maxnx = min(npagwd-20,maxwid)
      IF (maxnx .LT. 10)  maxnx = 10
      maxny = npagln
      IF (maxny .LT. 10)  maxny = 10
      IF (nxypt .LE. 1)  RETURN
      xbest = xpt(1)
      ybest = ypt(1)
      chbest = chpt(1)
C         order the points by decreasing y
      km1 = nxypt - 1
      DO 150 i= 1, km1
      iquit = 0
      ni = nxypt - i
      DO 140 j= 1, ni
      IF (ypt(j) .GT. ypt(j+1)) GO TO 140
        savx = xpt(j)
        xpt(j) = xpt(j+1)
        xpt(j+1) = savx
        savy = ypt(j)
        ypt(j) = ypt(j+1)
        ypt(j+1) = savy
        chsav = chpt(j)
        chpt(j) = chpt(j+1)
        chpt(j+1) = chsav
      iquit = 1
  140 CONTINUE
      IF (iquit .EQ. 0) GO TO 160
  150 CONTINUE
  160 CONTINUE
C         find extreme values
      xmax = xpt(1)
      xmin = xmax
      DO 200 i= 1, nxypt
        IF (xpt(i) .GT. xmax)  xmax = xpt(i)
        IF (xpt(i) .LT. xmin)  xmin = xpt(i)
  200 CONTINUE
      dxx = 0.001*(xmax-xmin)
      xmax = xmax + dxx
      xmin = xmin - dxx
      CALL mnbins(xmin,xmax,maxnx,xmin,xmax,nx,bwidx)
      ymax = ypt(1)
      ymin = ypt(nxypt)
      IF (ymax .EQ. ymin)  ymax=ymin+1.0
      dyy = 0.001*(ymax-ymin)
      ymax = ymax + dyy
      ymin = ymin - dyy
      CALL mnbins(ymin,ymax,maxny,ymin,ymax,ny,bwidy)
      any = ny
C         if first point is blank, it is an 'origin'
      IF (chbest .EQ. cblank)  GO TO 50
      xbest = 0.5 * (xmax+xmin)
      ybest = 0.5 * (ymax+ymin)
   50 CONTINUE
C         find scale constants
      ax = 1.0/bwidx
      ay = 1.0/bwidy
      bx = -ax*xmin + 2.0
      by = -ay*ymin - 2.0
C         convert points to grid positions
      DO 300 i= 1, nxypt
      xpt(i) = ax*xpt(i) + bx
  300 ypt(i) = any-ay*ypt(i) - by
      nxbest = ax*xbest + bx
      nybest = any  - ay*ybest - by
C         print the points
      ny = ny + 2
      nx = nx + 2
      isp1 = 1
      linodd = 1
      overpr=.false.
      DO 400 i= 1, ny
      DO 310 ibk= 1, nx
  310 cline(ibk:ibk) = cblank
      cline(1:1) = cdot
      cline(nx:nx) = cdot
      cline(nxbest:nxbest) = cdot
      IF (i.NE.1 .AND. i.NE.nybest .AND. i.NE.ny)  GO TO 320
      DO 315 j= 1, nx
  315 cline(j:j) = cdot
  320 CONTINUE
      yprt = ymax - float(i-1)*bwidy
      IF (isp1 .GT. nxypt)  GO TO 350
C         find the points to be plotted on this line
        DO 341 k= isp1,nxypt
      ks = ypt(k)
      IF (ks .GT. i)  GO TO 345
      ix = xpt(k)
      IF (cline(ix:ix) .EQ.   cdot)  GO TO 340
      IF (cline(ix:ix) .EQ. cblank)  GO TO 340
      IF (cline(ix:ix) .EQ.chpt(k))  GO TO 341
      overpr = .true.
C         OVERPR is true if one or more positions contains more than
C            one point
      cline(ix:ix) = '&'
      GO TO 341
  340 cline(ix:ix) = chpt(k)
  341 CONTINUE
        isp1 = nxypt + 1
        GO TO 350
  345   isp1 = k
  350 CONTINUE
      IF (linodd .EQ. 1 .OR. i .EQ. ny)  GO TO 380
      linodd = 1
      WRITE (nunit, '(18X,A)')       cline(:nx)
      GO TO 400
  380 WRITE (nunit,'(1X,G14.7,A,A)') yprt, ' ..', cline(:nx)
      linodd = 0
  400 CONTINUE
C         print labels on x-axis every ten columns
      DO 410 ibk= 1, nx
      cline(ibk:ibk) = cblank
      IF (mod(ibk,10) .EQ. 1)  cline(ibk:ibk) = cslash
  410 CONTINUE
      WRITE (nunit, '(18X,A)')       cline(:nx)
C
      DO 430 ibk= 1, 12
  430 xvalus(ibk) = xmin + float(ibk-1)*10.*bwidx
      iten = (nx+9) / 10
      WRITE (nunit,'(12X,12G10.4)')  (xvalus(ibk), ibk=1,iten)
      chmess = ' '
      IF (overpr) chmess='   Overprint character is &'
      WRITE (nunit,'(25X,A,G13.7,A)') 'ONE COLUMN=',bwidx, chmess
  500 RETURN
      END