module viewm
   ! provides subroutine viewr for NJOY2016
   use locale
   implicit none
   private
   public viewr

   ! common variables

   ! setup1
   real(kr)::xpage,ypage,wline,csize
   integer::lori,istyle,ipcol

   ! setup2
   real(kr)::xll,yll,ww,wh,wr,xg,yg
   integer::iwcol

   ! setup3
   real(kr)::hlab
   integer::n1,n2,nx,ny,nr
   character(80)::t1,t2,xl,yl,rl

   ! setup4
   real(kr)::xmin,xmax,xstp
   real(kr)::ymin,ymax,ystp
   real(kr)::zmin,zmax,zstp
   integer::itype,jtype,igrid,ileg

   ! setup5
   integer::icon,isym,idash,ithick,ishade,iccol

   ! setup6
   real(kr)::xtag,ytag,xpoint,xpt,ypt,hleg
   integer::nleg
   character(80)::aleg

   ! setup7
   real(kr)::x3,y3,z3,xv,yv,zv

contains

   subroutine viewr
   !--------------------------------------------------------------------
   !
   ! View plots generated by plotr, covr, or dtfr.
   ! Postscript version.
   !
   ! Character specifications are similar to DISSPLA, except that
   ! the default case is lower instead of upper.  This allows
   ! mixed-case strings to be used in Postscript mode.  The
   ! following shift characters are used:
   !     < = upper-case standard
   !     > = lower-case or mixed-case standard
   !     [ = upper-case greek
   !     ] = lower-case or mixed-case greek
   !     # = instructions
   ! Give one of the shift characters twice to get it instead of
   ! its action.  The following instructions are supported:
   !     Ev = elevate by v as a fraction of the height
   !           if v is missing or D is given, use .5
   !     Lv = lower by v as a fraction of the height
   !           if v is missing or D is given, use .5
   !     Hv = change height by v as a fraction of the height
   !           if v is missing or D is given, use .5
   !     Fi = change to font number i
   !     Mi = change mode number, where mode 0 is the lower 128
   !           postscript characters and mode 1 is the upper 128
   !     X  = reset E, L, or H.  Font and Mode must be
   !           reset explicitly.
   !     c is a real number, i is an integer.
   !
   !---input--------------------------------------------------------
   !
   !  card 1
   !     infile        input file
   !     nps           postscript output file
   !
   !---data file format---------------------------------------------
   !
   !  card 1
   !     lori          page orientation (def=1)
   !                    0  portrait (7.5x10in)
   !                    1  landscape (10x7.5in)
   !     istyle        character style (def=2)
   !                     1  roman
   !                     2  swiss
   !     size          character size option
   !                     pos = height in page units
   !                     neg = height as fraction of subplot size
   !                       (default=.30)
   !     ipcol         page color (def=white)
   !                    0=white
   !                    1=navajo white
   !                    2=blanched almond
   !                    3=antique white
   !                    4=very pale yellow
   !                    5=very pale rose
   !                    6=very pale green
   !                    7=very pale blue
   !
   ! -----repeat cards 2 through 13 for each curve-----
   !
   !  card 2
   !     iplot         plot index
   !                     99 = terminate plotting job
   !                      1 = new axes, new page
   !                     -1 = new axes, existing page
   !                      n = nth additional plot on existing axes
   !                     -n = start a new set of curves using
   !                          the alternate y axis
   !                     default = 1
   !     iwcol         window color (def=white)
   !                    color list same as for ipcol above
   !     factx         factor for energies (default=1.)
   !     facty         factor for cross-sections (default=1.)
   !     xll,yll       lower-left corner of plot area
   !     ww,wh,wr      window width, height, and rotation angle
   !                   (plot area defaults to one plot per page)
   !
   ! -----cards 3 thru 7 for iplot = 1 or -1 only-----
   !
   !  card 3
   !     t1            first line of title
   !                   80 characters allowed.
   !                   default=none
   !
   !  card 3a
   !     t2            second line of title
   !                   80 characters allowed.
   !                   default=none
   !
   !  card 4
   !     itype         type for primary axes
   !                     1 = linear x - linear y
   !                     2 = linear x - log y
   !                     3 = log x - linear y
   !                     4 = log x - log y
   !                     set negative for 3d axes
   !                     0 = no plot, titles only
   !                     default=4
   !     jtype         type for alternate y axis or z axis
   !                     0 = none
   !                     1 = linear
   !                     2 = log
   !                     default=0
   !     igrid         grid and tic mark control
   !                     0 = no grid lines or tic marks
   !                     1 = grid lines
   !                     2 = tic marks on outside
   !                     3 = tic marks on inside
   !                     default=2
   !     ileg          option to write a legend.
   !                     0 = none
   !                     1 = write a legend block with upper left
   !                         corner at xtag,ytag (see below)
   !                     2 = use tag labels on each curve with
   !                         a vector from the tag to the curve
   !                     default=0
   !     xtag          x coordinate of upper left corner
   !                   of legend block
   !     ytag          y coord of upper left corner
   !                   default=upper left corner of plot
   !
   !  card 5
   !     xmin          lowest energy to be plotted
   !     xmax          highest energy to be plotted
   !     xstep         x axis step
   !                   default = automatic scales
   !                   (for linear, give all 3, or none)
   !                   (for log, give first 2, or none)
   !
   !  card 5a
   !     xlabl         label for x axis
   !                   80 characters allowed.
   !                   (default = no label, no numbering)
   !
   !  card 6
   !     ymin          lowest value of y axis.
   !     ymax          highest value of y axis.
   !     ystep         step for y ayis (linear scales only)
   !                   default = automatic scales
   !                   (for linear, give all 3, or none)
   !                   (for log, give first 2, or none)
   !
   !  card 6a
   !     ylabl         label for y axis
   !                   80 characters allowed.
   !                   (default = no label, no numbering)
   !
   !  card 7   (jtype.gt.0 only)
   !     rmin          lowest value of secondary y axis or z axis
   !     rmax          highest value of secondary y axis or z axis
   !     rstep         step for secondary y axis or z axis
   !                   (default = automatic scale)
   !                   (for linear, give all 3, or none)
   !                   (for log, give first 2, or none)
   !
   !  card 7a  (jtype.gt.0 only)
   !     rl            label for alternate y axis or z axis
   !                   80 characters allowed.
   !                   (default = no label, no numbering)
   !
   !   card 8  -- dummy input card for consistency with plotr
   !               it always should be 0/
   !
   ! -----cards 9 and 10 for 2d plots only-----
   !
   !   card 9
   !     icon          symbol and connection option
   !                     0 = points connected, no symbols
   !                    -i = points not connected, symbol at every
   !                         ith point
   !                     i = points connected, symbol at every ith
   !                         points
   !                     default=0
   !     isym          no. of symbol to be used
   !                     0 = square
   !                     1 = octagon
   !                     2 = triangle
   !                     3 = cross
   !                     4 = ex
   !                     5 = diamond
   !                     6 = inverted triangle
   !                     7 = exed square
   !                     8 = crossed ex
   !                     9 = crossed diamond
   !                     10 = crossed octagon
   !                     11 = double triangle
   !                     12 = crossed square
   !                     13 = exed octagon
   !                     14 = triangle and square
   !                     15 = filled circle
   !                     16 = open circle
   !                     17 = open square
   !                     18 = filled square
   !                     19 = filled diamond
   !                     20 = filled triangle
   !                     21 = filled inverted triangle
   !                     22 = crossed circle
   !                     23 = exed circle
   !                     24 = exed diamond
   !                     default=0
   !     idash         type of line to plot
   !                     0 = solid
   !                     1 = dashed
   !                     2 = chain dash
   !                     3 = chain dot
   !                     4 = dot
   !                     5 = invisible
   !                     default=0
   !     iccol         curve color (def=black)
   !                     0=black
   !                     1=red
   !                     2=green
   !                     3=blue
   !                     4=magenta
   !                     5=cyan
   !                     6=brown
   !                     7=purple
   !                     8=orange
   !     ithick        controls thickness of curve
   !                     0 = invisible (for shaded areas)
   !                     (default=1)
   !     ishade        shade pattern
   !                     0 = none
   !                     1 to 10 = 10% to 100% gray
   !                     11 to 20 = 45 deg right hatching
   !                     21 to 30 = 45 deg left hatching
   !                     31 to 40 = 45 deg cross hatching
   !                     41 to 50 = shades of green
   !                     51 to 60 = shades of red
   !                     61 to 70 = shades of brown
   !                     71 to 80 = shades of blue
   !                     default=0
   !
   !   card 10   ---ileg.ne.0 only---
   !     aleg          title for curve tag or legend block
   !                   80 characters allowed.
   !                   default=blank
   !
   !   card 10a  ---ileg.eq.2 only---
   !     xtag          x position of tag title
   !     ytag          y position of tag title
   !     xpoint        x coordinate of vector point
   !                    (.le.0 to omit vector)
   !
   ! -----card 11 for 3d plots only-----
   !
   !   card 11
   !     xv,yv,zv      abs. coords of view point
   !                   defaults= 15.,-15.,15.
   !     x3,y3,z3      abs. sides of work box volume
   !                   defaults=2.5,6.5,2.5
   !
   !          set x3 negative to flip the order of the axis on
   !          that side of the box (secondary energy, cosine).
   !
   !   card 12
   !     nform          format code for input data
   !                    0 = free format input with
   !                        optional x and y error bars
   !                    1 = free format input for a
   !                        3d family of curves z(x) vs y
   !
   !   card 13   ---nform = 0 only---   2-d data
   !     xdata          independent value
   !                    terminate with empty card (/)
   !     ydata          dependent value
   !     yerr1          lower y error limit
   !                    no y error bar if zero
   !     yerr2          upper y error limit
   !                    if zero, equals yerr1
   !     xerr1          x left error limit
   !                    no x error bar if zero
   !     xerr2          x right error limit
   !                    if zero, equals xerr1
   !
   !   card 14   ---nform = 1 only---   3-d data
   !     y              y value for curve
   !                    repeat cards 13 and 13a for each curve
   !                    terminate with empty card (/)
   !
   !   card14a   ---nform = 1 only---
   !     x              x value
   !     z              z value
   !                    repeat card 13a for each point in curve
   !                    terminate with empty card (/)
   !                    disspla version requires same x grid
   !                    for each value of y.
   !
   !--------------------------------------------------------------------
   use mainio ! provides nsysi,nsyso
   use util ! provides timer,openz,mess,closz
   use graph ! provides gplot,endp,endw,gdone
   ! internals
   integer::infile,nps,nplot,i3d,iplot,ierrb
   integer::i,idone,j,n,l,iskip,nform,ll,nn,inside,naa
   real(kr)::time,zz1,zz2,flag
   real(kr)::factx,facty
   real(kr)::xx,yy,zz
   character(80)::text
   integer,parameter::mmax=20000   !same in plotr and viewr
   integer,parameter::maxaa=500000
   real(kr),dimension(15)::z
   real(kr),dimension(maxaa)::aa
   real(kr),dimension(mmax)::x,y,b,dxm,dxp,dym,dyp
   equivalence (x(1),aa(1)),(y(1),aa(mmax+1)),(b(1),aa(2*mmax+1))
   equivalence (dxm(1),aa(3*mmax+1)),(dxp(1),aa(4*mmax+1))
   equivalence (dym(1),aa(5*mmax+1)),(dyp(1),aa(6*mmax+1))
   real(kr),parameter::zero=0
   integer,parameter::mxc=80

   ! default paper size is us letter size.
   ! default margin is 0.5in all around.
   ! default character size is 0.3 in.
   ! default line width is .0134 in.
   ! see similar statements in plotr.
   real(kr),parameter::xpaper=8.5e0_kr
   real(kr),parameter::ypaper=11.0e0_kr
   real(kr),parameter::xmarg=1.0e0_kr
   real(kr),parameter::ymarg=1.0e0_kr
   real(kr),parameter::dsize=.3e0_kr
   real(kr),parameter::dline=.0134e0_kr
   ! default viewpoint and workbox
   real(kr),parameter::dxv=15.e0_kr
   real(kr),parameter::dyv=-15.e0_kr
   real(kr),parameter::dzv=15.e0_kr
   real(kr),parameter::dx3=2.5e0_kr
   real(kr),parameter::dy3=6.5e0_kr
   real(kr),parameter::dz3=2.5e0_kr

   !--start up the module
   call timer(time)
   write(nsyso,&
     '(/'' viewr...display plots'',47x,f8.1,''s'')') time
   write(nsyse,'(/'' viewr...'',60x,f8.1,''s'')') time
   read(nsysi,*) infile,nps
   call openz(infile,0)
   lori=1
   istyle=2
   csize=dsize
   ipcol=0
   call repoz(infile)
   read(infile,*) lori,istyle,csize,ipcol
   ! default page size is paper size with 0.5in margin all around
   if (lori.eq.1) then
      xpage=ypaper-ymarg
      ypage=xpaper-xmarg
   else
      xpage=xpaper-xmarg
      ypage=ypaper-ymarg
   endif
   wline=dline
   write(nsyso,'(/&
     &'' lori ................................. '',i10/&
     &'' xpage ................................ '',f10.3/&
     &'' ypage ................................ '',f10.3/&
     &'' istyle ............................... '',i10/&
     &'' size ................................. '',f10.3/&
     &'' ipcol ................................ '',i10)')&
     lori,xpage,ypage,istyle,csize,ipcol

   !--initialize plotting
   call gplot(lori,xpage,ypage,nps)

   !--loop over plots
   nplot=0
   i3d=0
   iplot=1
   do while (iplot.ne.99)
      iplot=1
      iwcol=0
      factx=1
      facty=1
      xll=0
      yll=0
      ww=xpage
      wh=ypage
      wr=0
      read(infile,*) iplot,iwcol,factx,facty,xll,yll,ww,wh,wr
      if (iplot.ne.99) then
         write(nsyso,'(/&
           &'' -------------------------------------------------''//&
           &'' iplot ................................ '',i10/&
           &'' iwcol ................................ '',i10/&
           &'' factx ................................ '',1p,e10.2/&
           &'' facty ................................ '',e10.2/&
           &'' xll .................................. '',0p,f10.3/&
           &'' yll .................................. '',f10.3/&
           &'' ww ................................... '',f10.3/&
           &'' wh ................................... '',f10.3/&
           &'' wa ................................... '',f10.3)')&
           iplot,iwcol,factx,facty,xll,yll,ww,wh,wr
         ierrb=0

         !--if this is first plot on these axes
         !--read in title lines
         if (iabs(iplot).eq.1) then
            text=' '
            read(infile,*) text
            n1=0
            do i=1,mxc
               if (text(i:i).ne.' ') n1=i
            enddo
            t1=' '
            if (n1.gt.0) t1=text(1:n1)
            text=' '
            read(infile,*) text
            n2=0
            do i=1,mxc
               if (text(i:i).ne.' ') n2=i
            enddo
            t2=' '
            if (n2.gt.0) t2=text(1:n2)
            write(nsyso,'(/12x,a/12x,a)') t1,t2

            !--set up plot type and grids
            itype=4
            jtype=0
            igrid=2
            ileg=0
            xtag=0
            ytag=0
            read(infile,*) itype,jtype,igrid,ileg,xtag,ytag
            write(nsyso,'(/&
              &'' itype ................................ '',i10/&
              &'' jtype ................................ '',i10/&
              &'' igrid ................................ '',i10/&
              &'' ileg ................................. '',i10)')&
              itype,jtype,igrid,ileg
            if (ileg.eq.1) write(nsyso,'(/&
              &'' xtag ................................. '',1p,e10.2/&
              &'' ytag ................................. '',e10.2)')&
              xtag,ytag

            !--no more input needed if itype=0
            if (itype.ne.0) then
               i3d=0
               if (itype.le.0) then
                  i3d=1
                  itype=-itype
               endif

               !--read in x-axis limits and label
               xmin=0
               xmax=0
               xstp=0
               read(infile,*) xmin,xmax,xstp
               if ((itype.eq.3.or.itype.eq.4)&
                 .and.(xmin.ne.zero.or.xmax.ne.zero)) xstp=1
               text=' '
               read(infile,*) text
               nx=0
               do i=1,mxc
                  if (text(i:i).ne.' ') nx=i
               enddo
               xl=' '
               if (nx.gt.0) xl=text(1:nx)
               write(nsyso,'(/&
                 &'' xlo .................................. '',&
                 &1p,e10.2/&
                 &'' xhi .................................. '',&
                 &e10.2/&
                 &'' xstep ................................ '',&
                 &e10.2/&
                 &'' xlabel ... '',a)') xmin,xmax,xstp,xl

               !--read in y-axis limits and label
               ymin=0
               ymax=0
               ystp=0
               read(infile,*) ymin,ymax,ystp
               if ((itype.eq.2.or.itype.eq.4)&
                  .and.(ymin.ne.zero.or.ymax.ne.zero)) ystp=1
               text=' '
               read(infile,*) text
               ny=0
               do i=1,mxc
                  if (text(i:i).ne.' ') ny=i
               enddo
               yl=' '
               if (ny.gt.0) yl=text(1:ny)
               write(nsyso,'(/&
                 &'' ylo .................................. '',&
                 &1p,e10.2/&
                 &'' yhi .................................. '',&
                 &e10.2/&
                 &'' ystep ................................ '',&
                 &e10.2/&
                 &'' ylabel ... '',a)')&
                 ymin,ymax,ystp,yl

               !--read in data for alternate y axis or z axis
               if (jtype.ne.0) then
                  zmin=0
                  zmax=0
                  zstp=0
                  read(infile,*) zmin,zmax,zstp
                  if (jtype.eq.2.and.(zmin.ne.zero.or.zmax.ne.zero))&
                    zstp=1
                  text=' '
                  read(infile,*) text
                  nr=0
                  do i=1,mxc
                     if (text(i:i).ne.' ') nr=i
                  enddo
                  rl=' '
                  if (nr.gt.0) rl=text(1:nr)
                  write(nsyso,'(/&
                    &'' rlo .................................. '',&
                    &1p,e10.2/&
                    &'' rhi .................................. '',&
                    &e10.2/&
                    &'' rstep ................................ '',&
                    &e10.2/&
                    &'' rlabel ... '',a)')&
                    zmin,zmax,zstp,rl
               endif
            endif
         endif

         !--additional input for real plots
         if (itype.ne.0) then

            !--read dummy card for consistency with plotr input
            read(infile,*)

            !--read plotting parameters for next 2d curve
            if (i3d.eq.0) then
               icon=0
               isym=0
               idash=0
               iccol=0
               ithick=1
               ishade=0
               read(infile,*) icon,isym,idash,iccol,ithick,ishade
               write(nsyso,'(/&
                 &'' icon ................................. '',i10/&
                 &'' isym ................................. '',i10/&
                 &'' idash ................................ '',i10/&
                 &'' iccol ................................ '',i10/&
                 &'' ithick ............................... '',i10/&
                 &'' ishade ............................... '',i10)')&
                 icon,isym,idash,iccol,ithick,ishade

               !--read in legend or tag title lines
               if (ileg.ne.0) then
                  text=' '
                  read(infile,*) text
                  nleg=0
                  do i=1,mxc
                     if (text(i:i).ne.' ') nleg=i
                  enddo
                  aleg=' '
                  if (nleg.gt.0) aleg=text(1:nleg)
                  if (ileg.eq.1) write(nsyso,&
                    '(/'' legend ... '',a)') aleg
                  if (ileg.eq.2) then
                     xtag=0
                     ytag=0
                     xpoint=0
                     read(infile,*) xtag,ytag,xpoint
                     write(nsyso,'(/&
                       &'' tag ...... '',a/&
                       &'' xtag ................................. '',&
                       &1p,e10.2/&
                       &'' ytag ................................. '',&
                       &e10.2/&
                       &'' xpoint ............................... '',&
                       &e10.2)')&
                       aleg,xtag,ytag,xpoint
                     endif
               endif

            !--read parameters for plotting 3d surface
            else
               xv=dxv
               yv=dyv
               zv=dzv
               x3=dx3
               y3=dy3
               z3=dz3
               read(infile,*) xv,yv,zv,x3,y3,z3
               write(nsyso,'(/&
                 &'' 3d viewpoint ......................... '',f10.3/&
                 &''                                        '',f10.3/&
                 &''                                        '',f10.3/&
                 &'' 3d workbox ........................... '',f10.3/&
                 &''                                        '',f10.3/&
                 &''                                        '',f10.3&
                 &)')&
                 xv,yv,zv,x3,y3,z3
            endif

            !--determine input type
            nform=0
            read(infile,*) nform
            write(nsyso,&
              &'(/'' data nform ........................... '',i10)')&
              nform

            !--for format zero -- 2d data
            !--loop thru input lines until xdata.lt.0
            if (nform.eq.0) then
               i=0
               ierrb=0
               idone=0
               do while (idone.eq.0)
                  i=i+1
                  flag=-99
                  z(1)=flag
                  z(2)=flag
                  z(3)=0
                  z(4)=0
                  z(5)=0
                  z(6)=0
                  read(infile,*) (z(j),j=1,6)
                  zz1=z(1)
                  zz2=z(2)
                  if (zz1.eq.flag.and.zz2.eq.flag) then
                     idone=1
                  else
                     x(i)=z(1)*factx
                     y(i)=z(2)*facty
                     dym(i)=z(3)*facty
                     dyp(i)=z(4)*facty
                     if (dyp(i).eq.zero) dyp(i)=dym(i)
                     dxm(i)=z(5)*factx
                     dxp(i)=z(6)*factx
                     if (dxp(i).eq.zero) dxp(i)=dxm(i)
                     if (dym(i).ne.zero) ierrb=1
                     if (dxm(i).ne.zero) ierrb=2
                     if (dym(i).ne.zero.and.dxm(i).ne.zero) ierrb=3
                  endif
               enddo
               n=i-1

            !--format 1 for 3-d data
            !--assume same x grids for each value of y
            else if (nform.eq.1) then
               l=0
               iskip=0
               flag=-99
               idone=0
               do while (idone.eq.0)
                  yy=flag
                  read(infile,*) yy
                  if (yy.eq.flag) then
                     idone=1
                  else
                     if (iskip.eq.0) then
                       if (l+5000.ge.maxaa) then
                           call mess('viewr','too much 3d data',&
                             'data truncated')
                           iskip=1
                        endif
                        l=l+1
                        aa(l)=yy
                        l=l+1
                        aa(l)=0
                        ll=l
                     endif
                     nn=0
                     inside=0
                     do while (inside.eq.0)
                        xx=flag
                        zz=flag
                        read(infile,*) xx,zz
                        if (xx.eq.flag.and.zz.eq.flag) then
                           inside=1
                        else
                           if (iskip.eq.0) then
                              nn=nn+1
                              l=l+1
                              aa(l)=xx
                              l=l+1
                              aa(l)=zz
                           endif
                        endif
                     enddo
                     if (iskip.eq.0) aa(ll)=nn
                  endif
               enddo
               l=l+1
               aa(l)=0
               l=l+1
               aa(l)=0
               naa=l
            endif
         endif

         !--do plot
         if (nplot.ne.0.and.iplot.eq.1) call endp
         if (iplot.eq.-1) call endw
         if (nform.eq.0) then
            call set2d(iplot,x,y,dxm,dxp,dym,dyp,n,ierrb)
         else
            call set3d(iplot,aa,naa)
         endif
         nplot=1
      endif

   !--loop back for next curve
   enddo

   !--viewr is finished
   call endw
   call endp
   call gdone
   call closz(infile)
   call timer(time)
   write(nsyso,&
     '(/69x,f8.1,''s''/1x,7(''**********''),''*******'')')&
     time
   end subroutine viewr

   subroutine set2d(iplot,x,y,dxm,dxp,dym,dyp,n,ierrb)
   !--------------------------------------------------------------------
   ! Set up 2-dimensional multi-curve plots.
   ! ------------------------
   ! input variables
   !   iplot            curve number
   !                      1 = first plot, new axes, new page
   !                     -1 = first plot, new axes, existing page
   !                      n = nth plot on existing axes
   !                          (set n negative to start a new set of
   !                            curves with an alternate y axis)
   !   x,y              data to be plotted
   !   dxm,dxp          x error bar limits
   !   dym,dyp          y error bar limits
   !   n                number of data points
   !   ierrb            error bar control
   ! setup1 variables
   !   lori             page orientation (0=portrait, 1=landscape)
   !   xpage,ypage      definition of absolute coordinates
   !   istyle           character style (1=roman, 2=helvetica)
   !   size             character size control
   !                      positive for abs. coordinates
   !                      negative for fraction of subplot size
   !   ipcol           page color
   !   wline            base line width (inches)
   ! setup2 variables
   !   iwcol           window color
   !   xll,yll          abs. coords of lower-left corner of window
   !   ww,wh            window width and height
   !   wr               window rotation angle
   !   xg,yg            lengths of x and y axes in abs. coords.
   ! setup3 variables
   !   t1,n1            title line 1 and character count
   !   t2,n2            title line 2 and character count
   !   xl,nx            x-axis label and count
   !   yl,ny            y-axis label and count
   !   rl,nr            right-axis label and count
   !   hlab             size for labels and titles (abs. coords)
   ! setup4 variables
   !   xmin,xmax        limits on x axis
   !   xstp             step size on x axis
   !                    zero triggers automatic scaling
   !                    value is ignored for log axis
   !   ymin,ymax        limits on y axis
   !   ystp             step size on y axis
   !                    zero triggers automatic scaling
   !                    value is ignored for log axis
   !   rmin,rmax        limits on right axis
   !   rstp             step size on r axis
   !                    zero triggers automatic scaling
   !                    value is ignored for log axis
   !   itype            plot type
   !                      1 = lin-lin
   !                      2 = lin-log
   !                      3 = log-lin
   !                      4 = log-log
   !   jtype            type for right axis
   !                      0 = none
   !                      1 = lin
   !                      2 = log
   !   igrid            control grid lines and tick marks
   !                      0 = no grid lines or tic marks
   !                      1 = grid lines
   !                      2 = tic marks on outside
   !                      3 = tic marks on inside
   !   ileg             legend or tag option
   !                      0 = none
   !                      1 = legend block at xtag,ytag
   !                      2 = curve tag at xtag,ytag with vector
   !                            to xpoint
   ! setup5 variables
   !   icon             controls symbols and connection
   !                      0 = points connected, no symbols
   !                      i = points connected, symbol every ith point
   !                     -i = not connected, symbol every ith point
   !   isym             selects plotting symbol
   !                      0 = square
   !                      1 = circle
   !                      2 = triangle
   !                      3 = cross
   !                      4 = ex
   !                      5 = diamond
   !                      6 = inverted triangle
   !                      7 = filled square
   !                      8 = filled circle
   !   idash            type of connecting line
   !                      0 = solid
   !                      1 = dashed
   !                      2 = chain dash
   !                      3 = chain dot
   !                      4 = dot
   !   ithick           controls thickness of line
   !                      0 = invisible
   !   ishade           shading pattern
   !   iccol           curve color
   ! setup6 variables
   !   aleg,nleg        tag or legend string and char count
   !   xtag,ytag        location of legend block or curve tag
   !                     in units of x and y coordinates
   !   xpoint           x coordinate where vector from tag
   !                     touches the tagged curve
   !   xpt,ypt          abs. location of legend block, if any
   !   hleg             height for legend lines
   !--------------------------------------------------------------------
   use graph ! provides initp,window,init2,axis2,grid2
             ! xscale,yscale,frame2,curv2,endfr
   ! externals
   integer::iplot,n,ierrb
   real(kr)::xpos,ypos
   real(kr)::x(n),y(n),dxm(n),dxp(n),dym(n),dyp(n)
   ! internals
   integer::i,major,minor,ixlft,ibot,itic
   real(kr)::wt,xstep,ystep,top,xlft,bot,xop,yop,rstep,rop
   real(kr)::bar,w,ssym,rmin,rmax
   real(kr),parameter::shade=.99e0_kr
   real(kr),parameter::bard=.03e0_kr
   real(kr),parameter::small=1.e-15_kr
   real(kr),parameter::twenty=20e6_kr
   real(kr),parameter::grace=0
   real(kr),parameter::zero=0
   real(kr),parameter::one=1
   real(kr),parameter::ten=10
   save itic
   wt=wline

   !--initial settings
   if (iplot.eq.1) then
      if (csize.gt.zero) hlab=csize
      if (csize.lt.zero) hlab=-csize*wh
      hleg=2*hlab/3
      call initp(lori,xpage,ypage,istyle,hlab,wline,0,ipcol)
   endif

   !--set up subplot area for current axes
   if (iabs(iplot).eq.1) then
      call window(xll,yll,ww,wh,wr,t1,n1,t2,n2,0)
      if (itype.eq.0) return
      call init2(xpos,ypos,xg,yg,jtype,iwcol)
   endif

   !--set up regular axes
   !--or alternate y scale
   if (iplot.le.1) then
      if (iplot.lt.-1) then
         ymin=zmin
         ymax=zmax
         ystp=zstp
      endif

      !--check for automatic scaling
      xstep=xstp
      ystep=ystp
      if (xstp.eq.zero.or.ystp.eq.zero) then

         !--search for min and max values
         if (xstp.eq.zero) then
            xmin=x(1)
            xmax=x(1)
         endif
         if (ystp.eq.zero.or.iplot.ge.-1) then
            if (ystp.eq.zero) then
               ymax=y(1)
               ymin=y(1)
            endif
            do i=2,n
               if (xstp.eq.zero.and.iplot.ge.-1) then
                  if (x(i).lt.xmin) xmin=x(i)
                  if (x(i).gt.xmax) xmax=x(i)
               endif
               if (ystp.eq.zero) then
                  if (y(i).lt.ymin.and.y(i).ne.small) ymin=y(i)
                  if (y(i).gt.ymax) ymax=y(i)
               endif
            enddo

            !--choose limits and step sizes
            !--for linear axes, if any
            if (itype.le.2.and.iplot.ge.-1) then
               if (xstp.eq.zero) then
                  call ascalv(4,xmin,xmax,major,minor)
                  xstep=(xmax-xmin)/major
               endif
            endif
            if (iplot.lt.-1.or.itype.eq.1.or.itype.eq.3) then
               if (iplot.ge.-1.or.jtype.eq.1) then
                  if (ystp.eq.zero) then
                     call ascalv(4,ymin,ymax,major,minor)
                     ystep=(ymax-ymin)/major
                  endif
               endif
            endif
         endif
      endif

      !--adjust limits for log scales
      !--limit number of x and y decades
      if (iplot.ge.-1.and.itype.ge.3.and.xstp.eq.zero) then
         top=log10(xmax)
         if (xmax.ne.twenty) then
            if (top.ge.zero) xmax=ten**int(top+shade)
            if (top.lt.zero) xmax=ten**int(top)
         endif
         xlft=log10(xmin)
         ixlft=int(xlft)
         if (xlft.gt.zero) xmin=ten**ixlft
         if (xlft.lt.zero) xmin=ten**(ixlft-1)
         if (xmax/xmin.gt.ten**13) xmin=ten**int(top-13)
      endif
      if (iplot.lt.-1.or.itype.eq.2.or.itype.eq.4) then
         if (iplot.ge.-1.or.jtype.eq.2) then
            if (ystp.eq.zero) then
               top=log10(ymax)
               if (top.ge.zero) ymax=ten**int(top+shade)
               if (top.lt.zero) ymax=ten**int(top)
               bot=log10(ymin)
               ibot=int(bot)
               if (bot.gt.zero) ymin=ten**ibot
               if (bot.lt.zero) ymin=ten**(ibot-1)
               if (ymax/ymin.gt.ten**8) ymin=ten**int(top-8)
            endif
         endif
      endif

      !--set up the axes and grid
      if (iplot.ge.-1) then
         itic=0
         if (igrid.eq.2) itic=-1
         if (igrid.eq.3) itic=1
         xop=xstep
         yop=ystep
         if (itype.eq.3.or.itype.eq.4) xop=0
         if (itype.eq.2.or.itype.eq.4) yop=0
         call axis2(xmin,xmax,xop,xl,-nx,itic,0,xg,&
           zero,zero,one,zero,zero,one,0)
         call axis2(xmin,xmax,xop,' ',0,-itic,0,xg,&
           zero,yg,one,zero,zero,one,0)
         call axis2(ymin,ymax,yop,yl,ny,-itic,0,yg,&
           zero,zero,zero,one,-one,zero,1)
         call axis2(ymin,ymax,yop,' ',0,itic,0,yg,&
           xg,zero,zero,one,-one,zero,1)
         if (igrid.eq.1) call grid2(1,1)

      !--alternate y axis
      else
         rmin=ymin
         rmax=ymax
         rstep=ystep
         rop=rstep
         if (jtype.eq.2) rop=0
         call axis2(rmin,rmax,rop,rl,-nr,-itic,0,yg,&
           xg,zero,zero,one,-one,zero,1)
         call axis2(rmin,rmax,rop,' ',0,itic,0,yg,&
           zero,zero,zero,one,-one,zero,1)
      endif

      !--locate legend block, if any
      if (ileg.eq.1) then
         if (xtag.eq.zero.and.ytag.eq.zero) then
            xpt=xscale(xmin)+hleg
            ypt=yscale(ymax)-3*hleg/2
         else
            xpt=xscale(xtag)
            ypt=yscale(ytag)
         endif
      endif
   endif

   !--draw the curves on the new or existing frame
   !--using a clipping path just outside of the frame.
   call frame2(xg,yg,grace,iccol)
   bar=bard
   if (ierrb.gt.0) call erbar(x,y,n,dxm,dxp,dym,dyp,ierrb,bar)
   w=ithick*wt
   ssym=3*hleg/10
   call curv2(x,y,n,idash,w,icon,isym,ssym,ishade)

   !--add curves tags or legend lines
   if (ileg.eq.1) call legndb(iplot)
   if (ileg.eq.2) call tagit(x,y,n,itype)

   !--finished with this call to setup
   call endfr
   return
   end subroutine set2d

   subroutine erbar(xx,yy,n,dxm,dxp,dym,dyp,ixy,w)
   !--------------------------------------------------------------------
   ! Put error bars on previously drawn plot.
   ! Companion routine for set2d.
   ! --------------------------------
   !   xx,yy,nn           arrays of centers and count
   !   dxm,dxp            left & right error bars
   !   dym,dyp            bottom & top error bars
   !   w                  cap size for error bars (in)
   !                       (w=0 defaults to .02)
   !   ixy                option for x, y, or both
   !--------------------------------------------------------------------
   use graph ! provides xscale,yscale,vect3
   ! externals
   integer::n,ixy
   real(kr)::xx(n),yy(n),dxm(n),dxp(n),dym(n),dyp(n),w
   ! internals
   integer::np
   real(kr)::wt,wd,xn,yn,x1,x2,y1,y2
   real(kr),parameter::capd=.02e0_kr
   real(kr),parameter::zero=0
   wt=wline

   !--set up cap size
   wd=w
   if (wd.eq.zero) wd=capd

   !--loop over data points
   do np=1,n
      xn=xscale(xx(np))
      yn=yscale(yy(np))

      !--draw x error bars, if any
      if (ixy.gt.1) then
         if (dxm(np).ne.zero.or.dxp(np).ne.zero) then
            x1=xscale(xx(np)-dxm(np))
            x2=xscale(xx(np)+dxp(np))
            call vect3(x1,yn,zero,x2,yn,zero,wt,0)
            call vect3(x1,yn+wd,zero,x1,yn-wd,zero,wt,0)
            call vect3(x2,yn+wd,zero,x2,yn-wd,zero,wt,0)
         endif
      endif

      !--draw y error bars, if any
      if (ixy.ne.0.and.ixy.ne.2) then
         if (xx(np).ge.xmin.and.xx(np).le.xmax) then
            if (yy(np).ge.ymin.and.yy(np).le.ymax) then
               if (dym(np).ne.zero.or.dyp(np).ne.zero) then
                  y1=yscale(yy(np)-dym(np))
                  y2=yscale(yy(np)+dyp(np))
                  call vect3(xn,y1,zero,xn,y2,zero,wt,0)
                  call vect3(xn-wd,y1,zero,xn+wd,y1,zero,wt,0)
                  call vect3(xn-wd,y2,zero,xn+wd,y2,zero,wt,0)
               endif
            endif
         endif
      endif

   !--continue loop over data points
   enddo
   return
   end subroutine erbar

   subroutine legndb(iplot)
   !--------------------------------------------------------------------
   ! Write the legend, a line at a time.
   ! Companion routine for set2d.
   ! -----------------------------------
   !   iplot              curve number
   !   icon               symbol and connection flag
   !   hleg               height for legend lines
   !   imk                marker (symbol)
   !   xpt,ypt            abs. position of the upper left
   !                       corner of the legend block
   !   leg,nleg           legend line and character count
   !--------------------------------------------------------------------
   use graph ! provides txtlen,trans3,xinvrs,yinvrs,poly2,curv2,dsym
   ! externals
   integer::iplot
   ! internals
   real(kr)::wt,x,y,xta,yta,wleg,w,ssym,u,v
   real(kr)::xc(2),yc(2)
   real(kr)::xb(5),yb(5)
   real(kr),parameter::wd=.005e0_kr
   real(kr),parameter::zero=0
   real(kr),parameter::one=1
   real(kr),parameter::backgr=1
   save x,y
   wt=wline

   if (iabs(iplot).eq.1) then
      x=xpt
      y=ypt
      call trans3(x,y,zero,xta,yta)
      wleg=txtlen(aleg,nleg,istyle,hleg)
      xb(1)=xta-2*hleg/10
      yb(1)=yta-3*hleg/10
      xb(2)=xta+wleg+7*one/10+4*hleg/10
      yb(2)=yta-3*hleg/10
      xb(3)=xta+wleg+7*one/10+4*hleg/10
      yb(3)=yta
      xb(4)=xta-2*hleg/10
      yb(4)=yta
      xb(5)=xta-2*hleg/10
      yb(5)=yta-3*hleg/10
      w=wd
      call poly2(xb,yb,5,-w,backgr)
   endif
   xc(1)=xinvrs(x)
   yc(1)=yinvrs(y-7*hleg/10)
   xc(2)=xinvrs(x+5*one/10)
   yc(2)=yinvrs(y-7*hleg/10)
   call trans3(x,y,zero,xta,yta)
   wleg=txtlen(aleg,nleg,istyle,hleg)
   xb(1)=xta-2*hleg/10
   yb(1)=yta-14*hleg/10
   xb(2)=xta+wleg+7*one/10+4*hleg/10
   yb(2)=yta-14*hleg/10
   xb(3)=xta+wleg+7*one/10+4*hleg/10
   yb(3)=yta-3*hleg/10
   xb(4)=xta-2*hleg/10
   yb(4)=yta-3*hleg/10
   xb(5)=xta-2*hleg/10
   yb(5)=yta-14*hleg/10
   w=wd
   call poly2(xb,yb,5,-w,backgr)
   w=ithick*wt
   if (icon.ge.0) call curv2(xc,yc,2,idash,w,0,0,zero,0)
   ssym=3*hleg/10
   call trans3(x+one/4,y-7*hleg/10,zero,u,v)
   if (icon.ne.0) call dsym(u,v,isym,ssym)
   call text3(aleg,nleg,istyle,hleg,x+7*one/10,y-11*hleg/10,zero,&
     one,zero,zero,zero,one,zero)
   y=y-11*hleg/10
   return
   end subroutine legndb

   subroutine tagit(x,y,n,it)
   !--------------------------------------------------------------------
   ! Places a tag string at xtag,ytag and
   ! draws a vector to meet the curve at xpoint.
   ! -----------------------------------
   !   x,y,n              array of data points and count
   !   it                 interpolation law
   !   xpoint             x value where arrow touches curve
   !                       (.le.0 to omit vector)
   !   xtag,ytag          position of tag in curve coordinates
   !   aleg,nleg          tag message and count
   !   ivec               style code for arrow head
   !   hleg               size of tag characters
   !--------------------------------------------------------------------
   use endf ! provides terp1
   use graph ! provides txtlen,xscale,yscale,trans3
   ! externals
   integer::n,it
   real(kr)::x(n),y(n)
   ! internals
   integer::j,jt
   real(kr)::wt,ypoint,xtp,ytp,xta,yta,wleg,w,backgr,xpp,ypp
   real(kr)::xxx,yyy
   real(kr)::xb(5),yb(5)
   real(kr),parameter::wd=.005e0_kr
   integer::ivec=1021
   real(kr),parameter::zero=0
   real(kr),parameter::one=1
   wt=wline
   backgr=0

   !--search curve for xpoint,ypoint
   if (xpoint.gt.zero) then
      j=1
      do while (x(j).lt.xpoint.and.j.lt.n)
         j=j+1
      enddo
      if (j.eq.1) j=2
      jt=it+1
      call terp1(x(j-1),y(j-1),x(j),y(j),xpoint,ypoint,jt)
   endif

   !--write tag (with a blanked background) and draw vector
   xtp=xscale(xtag)
   ytp=yscale(ytag)
   call trans3(xtp,ytp,zero,xta,yta)
   wleg=txtlen(aleg,nleg,istyle,hleg)
   xb(1)=xta-2*hleg/10
   yb(1)=yta-2*hleg/10
   xb(2)=xta+wleg+4*hleg/10
   yb(2)=yta-2*hleg/10
   xb(3)=xta+wleg+4*hleg/10
   yb(3)=yta+12*hleg/10
   xb(4)=xta-2*hleg/10
   yb(4)=yta+12*hleg/10
   xb(5)=xta-2*hleg/10
   yb(5)=yta-2*hleg/10
   w=wd
   call poly2(xb,yb,5,-w,backgr)
   call text3(aleg,nleg,istyle,hleg,xtp,ytp,&
     zero,one,zero,zero,zero,one,zero)
   if (xpoint.le.zero) return
   xpp=xscale(xpoint)
   ypp=yscale(ypoint)
   xxx=xtp-hleg/2
   yyy=ytp+hleg/2
   call vect3(xxx,yyy,zero,xpp,ypp,zero,wt,ivec)
   return
   end subroutine tagit

   subroutine set3d(iplot,xyz,nxyz)
   !--------------------------------------------------------------------
   ! Set up 3-dimensional surface plots.
   ! ---------------------------------
   ! input variables
   !   iplot            curve number
   !                      1 = first plot, new axes, new page
   !                     -1 = first plot, new axes, existing page
   !                      n = nth plot on existing axes
   !   xyz              packed data array of curves
   !   nxyz             length of data array
   !   a                scratch area (not used for ps)
   ! common variables
   !   x3,y3,z3         abs. sides of work box volume
   !   xv,yv,zv         abs. coordinates of view point
   !                set x3 negative to verse direction of axis
   !--------------------------------------------------------------------
   use util ! provides mess
   use graph ! provides initp,window,init3,curv3
   ! externals
   integer::iplot,nxyz
   real(kr)::xyz(nxyz)
   ! internals
   integer,parameter::length=2000
   integer::i,j,nn,k,ncurv,major,minor,itop,ibot,l,n
   real(kr)::wt,xlo,xhi,ylo,yhi,zlo,zhi,xn,yn,zn,yy
   real(kr)::top,bot,xop,yop,zop
   integer::lll(length)
   real(kr)::x(2000),y(2000),z(2000)
   real(kr),parameter::big=1.e10_kr
   real(kr),parameter::d0=.001e0_kr
   real(kr),parameter::d3=.301e0_kr
   real(kr),parameter::d7=.699e0_kr
   integer::kmax=1999
   real(kr),parameter::zero=0
   real(kr),parameter::one=1
   real(kr),parameter::ten=10
   wt=wline

   !--set up the window and titles
   if (csize.gt.zero) hlab=csize
   if (csize.lt.zero) hlab=-csize*wh
   if (iplot.eq.1)&
     call initp(lori,xpage,ypage,istyle,hlab,wline,0,ipcol)
   call window(xll,yll,ww,wh,wr,t1,n1,t2,n2,0)

   !--set up the 3-d perspective projection
   call init3(x3,y3,z3,xv,yv,zv,iwcol)

   !--locate the different curves in the family
   !--find lo and hi limits for each axis
   xlo=big
   xhi=-big
   ylo=big
   yhi=-big
   zlo=big
   zhi=-big
   i=1
   j=1
   nn=1
   do while (nn.ne.0)
      lll(j)=i
      yn=xyz(i)
      nn=nint(xyz(i+1))
      if (nn.ne.0) then
         if (yn.lt.ylo) ylo=yn
         if (yn.gt.yhi) yhi=yn
         do k=1,nn
            xn=xyz(i+2*k)
            if (xn.lt.xlo) xlo=xn
            if (xn.gt.xhi) xhi=xn
            zn=xyz(i+2*k+1)
            if (zn.lt.zlo) zlo=zn
            if (zn.gt.zhi) zhi=zn
         enddo
         i=i+2+2*nn
         j=j+1
         if (j.gt.length) then
            call error('set3d','array overflow, increase the length parameter',' ')
         endif
      endif
   enddo
   ncurv=j-1

   !--choose z axis limits and step sizes
   if (zstp.eq.zero) then
      zmin=zlo
      zmax=zhi
      if (jtype.eq.1) then
         call ascalv(2,zmin,zmax,major,minor)
         zstp=(zmax-zmin)/major
      else
         top=log10(zmax)
         itop=int(top)
         if (top.lt.zero) itop=itop-1
         zmax=itop+1
         if (top.le.itop+d7+d0) zmax=itop+d7
         if (top.le.itop+d3+d0) zmax=itop+d3
         if (top.le.itop+d0) zmax=itop
         zmax=ten**zmax
         bot=log10(zmin)
         ibot=int(bot)
         if (bot.lt.zero) ibot=ibot-1
         zmin=ibot
         if (bot.ge.ibot+d3-d0) zmin=ibot+d3
         if (bot.ge.ibot+d7-d0) zmin=ibot+d7
         if (bot.ge.ibot+1-d0) zmin=ibot+1
         zmin=ten**zmin
         if (zmax/zmin.gt.ten**13) zmin=ten**(itop-13)
      endif
   endif

   !--choose y axis limits and step sizes
   if (ystp.eq.zero) then
      ymin=ylo
      ymax=yhi
      if (itype.eq.1.or.itype.eq.3) then
         call ascalv(2,ymin,ymax,major,minor)
         ystp=(ymax-ymin)/major
      else
         top=log10(ymax)
         itop=int(top)
         if (top.lt.zero) itop=itop-1
         ymax=itop+1
         if (top.le.itop+d7+d0) ymax=itop+d7
         if (top.le.itop+d3+d0) ymax=itop+d3
         if (top.le.itop+d0) ymax=itop
         ymax=ten**ymax
         bot=log10(ymin)
         ibot=int(bot)
         if (bot.lt.zero) ibot=ibot-1
         ymin=ibot
         if (bot.ge.ibot+d3-d0) ymin=ibot+d3
         if (bot.ge.ibot+d7-d0) ymin=ibot+d7
         if (bot.ge.ibot+1-d0) ymin=ibot+1
         ymin=ten**ymin
         if (ymax/ymin.gt.ten**13) ymin=ten**(itop-13)
      endif
   endif

   !--chose x axis limits and step sizes
   if (xstp.eq.zero) then
      xmin=xlo
      xmax=xhi
      if (itype.eq.1.or.itype.eq.2) then
         call ascalv(2,xmin,xmax,major,minor)
         xstp=(xmax-xmin)/major
      else
         top=log10(xmax)
         itop=int(top)
         if (top.lt.zero) itop=itop-1
         xmax=itop+1
         if (top.le.itop+d7+d0) xmax=itop+d7
         if (top.le.itop+d3+d0) xmax=itop+d3
         if (top.le.itop+d0) xmax=itop
         xmax=ten**xmax
         bot=log10(xmin)
         ibot=int(bot)
         if (bot.lt.zero) ibot=ibot-1
         xmin=ibot
         if (bot.ge.ibot+d3-d0) xmin=ibot+d3
         if (bot.ge.ibot+d7-d0) xmin=ibot+d7
         if (bot.ge.ibot+1-d0) xmin=ibot+1
         xmin=ten**xmin
         if (xmax/xmin.gt.ten**13) xmin=ten**(itop-13)
      endif
   endif

   !--draw 3d z axis, which uses 2d right axis parameters
   zop=zstp
   if (jtype.eq.2) zop=0
   if (x3.gt.zero) then
      call axis3(zmin,zmax,zop,rl,nr,1,1,z3,zero,zero,zero,&
        zero,zero,one,zero,-one,zero,1)
   else
      call axis3(zmin,zmax,zop,rl,nr,1,1,z3,x3,zero,zero,&
        zero,zero,one,zero,-one,zero,1)
   endif

   !--draw 3d x axis
   xop=xstp
   if (itype.eq.3.or.itype.eq.4) xop=0
   call axis3(xmin,xmax,xop,xl,-nx,-1,0,x3,zero,zero,zero,&
     one,zero,zero,zero,one,zero,0)

   !--draw 3d y axis
   yop=ystp
   if (itype.eq.2.or.itype.eq.4) yop=0
   if (x3.gt.zero) then
      call axis3(ymin,ymax,yop,yl,-ny,-1,0,y3,&
        x3,zero,zero,zero,one,zero,-one,zero,zero,0)
   else
      call axis3(ymin,ymax,yop,yl,-ny,-1,0,y3,&
        zero,zero,zero,zero,one,zero,-one,zero,zero,0)
   endif

   !--draw extra axes to complete the 3-d frame
   if (x3.gt.zero) then
      call axis3(ymin,ymax,yop,' ',0,0,0,y3,&
        zero,zero,zero,zero,one,zero,-one,zero,zero,0)
   else
      call axis3(ymin,ymax,yop,' ',0,0,0,y3,&
        x3,zero,zero,zero,one,zero,-one,zero,zero,0)
   endif
   if (x3.gt.zero) then
      call axis3(ymin,ymax,yop,' ',0,0,0,y3,&
        zero,zero,z3,zero,one,zero,-one,zero,zero,0)
   else
      call axis3(ymin,ymax,yop,' ',0,0,0,y3,&
        x3,zero,z3,zero,one,zero,-one,zero,zero,0)
   endif
   if (x3.gt.zero) then
      call axis3(zmin,zmax,zop,' ',0,0,0,z3,&
        zero,y3,zero,zero,zero,one,zero,-one,zero,0)
   else
      call axis3(zmin,zmax,zop,' ',0,0,0,z3,&
        x3,y3,zero,zero,zero,one,zero,-one,zero,0)
   endif
   if (x3.gt.zero) then
      call axis3(zmin,zmax,zop,' ',0,0,0,z3,&
        x3,y3,zero,zero,zero,one,zero,-one,zero,0)
   else
      call axis3(zmin,zmax,zop,' ',0,0,0,z3,&
        zero,y3,zero,zero,zero,one,zero,-one,zero,0)
   endif
   call axis3(xmin,xmax,xop,' ',0,0,0,x3,&
     zero,y3,zero,one,zero,zero,zero,one,zero,0)
   call axis3(xmin,xmax,xop,' ',0,0,0,x3,&
     zero,y3,z3,one,zero,zero,zero,one,zero,0)

   !--add the base-plane grids if requested
   if (igrid.eq.1) then
      call grid3(1,1,0)
      if (x3.gt.zero) then
         call grid3(0,1,1)
      else
         call grid3(-1,1,1)
      endif
      call grid3(1,-1,1)
   endif

   !--draw the curves
   do j=1,ncurv
      l=lll(ncurv-j+1)
      yy=xyz(l)
      if (yy.ge.ymin.and.yy.le.ymax) then
         n=nint(xyz(l+1))
         x(1)=xyz(l+2)
         y(1)=yy
         z(1)=zmin
         k=2
         do i=1,n
            if (k.lt.kmax) then
               x(k)=xyz(l+2*i)
               if (x(k).lt.xmin) x(k)=xmin
               if (x(k).gt.xmax) x(k)=xmax
               y(k)=yy
               z(k)=xyz(l+2*i+1)
               if (z(k).lt.zmin) z(k)=zmin
               if (z(k).gt.zmax) z(k)=zmax
               k=k+1
            endif
         enddo
         if (k.ge.kmax) then
            call mess('set3d','curve truncated',' ')
         endif
         x(k)=xyz(l+2*n)
         y(k)=yy
         z(k)=zmin
         call curv3(x,y,z,k,wt)
      endif
   enddo

   !--finished.
   return
   end subroutine set3d

   subroutine ascalv(m,z1,z2,major,minor)
   !--------------------------------------------------------------------
   ! Automatic scaling routine for a linear axis
   ! borrowed from Los Alamos SC4020 library (with modifications).
   ! on input------------
   !   m              minimum number of major divisions desired
   !   z1,z2          min and max values of data to be plotted
   ! on output-----------
   !   z1,z2          min and max limits of axis
   !   major          number of major division on axis
   !   minor          number of minor divisions on axis
   !--------------------------------------------------------------------
   ! externals
   integer::m,major,minor
   real(kr)::z1,z2
   ! internals
   integer::iflag,k,nm,n1,n2
   real(kr)::zmin,zmax,fm,zbar,z,p,tenk,test,dz,fn
   real(kr),parameter::zero=0
   real(kr),parameter::one=1
   real(kr),parameter::ten=10
   real(kr),parameter::tentho=10000

   !--check input
   !--exit if parameters are unreasonable
   zmin=z1
   zmax=z2
   if (zmax.le.zmin.or.m.le.0.or.m.gt.20) then
      major=1
      minor=0
      z1=0
      z2=2*z2
      return
   endif

   !--find minimum span per interval
   fm=m
   if (zmax.eq.zero.or.zmin.eq.zero) then
      zmax=zmax-abs(zmax)/1000000
      zmin=zmin+abs(zmin)/1000000
   else
      zbar=zmax/zmin
      if (abs(zbar)/1000.ge.one) zmin=0
      if (abs(zbar)*1000.le.one) then
         zmax=0
         zmax=zmax-abs(zmax)/1000000
         zmin=zmin+abs(zmin)/1000000
      else
         if ((abs(zbar-1)-5*fm/100000).gt.zero) then
            zmax=zmax-abs(zmax)/1000000
            zmin=zmin+abs(zmin)/1000000
         else
            zbar=(zmax+zmin)/2
            z=26*fm*abs(zbar)/1000000
            zmax=zbar+z
            zmin=zbar-z
         endif
      endif
   endif
   p=(zmax-zmin)/fm

   !--determine k such that
   !--    10**k.le.p.lt.10**(k+1)
   iflag=0
   tenk=1
   k=0
   if (p.lt.one) then
      iflag=1
      p=1/p
   endif
   do while (p.ge.tentho)
      p=p/10000
      tenk=tenk*10000
      k=k+4
   enddo
   do while (p.ge.ten)
      p=p/10
      tenk=tenk*10
      k=k+1
   enddo
   if (iflag.ne.0) then
      p=10/p
      tenk=one/10/tenk
      k=k-1
   endif

   !--determine dz such that
   !--    dz = 1*10**k, or
   !--    dz = 2*10**k, or
   !--    dz = 5*10**k.
   test=2+one/100
   if (p.le.test) then
      test=2-one/100
      if (p.le.test) then
         p=1
         nm=5
      else
         p=2
         nm=4
      endif
   else
      test=5-one/100
      if (p.lt.test) then
         p=2
         nm=4
      else
         p=5
         nm=5
      endif
   endif
   dz=p*tenk

   !--find integers n1 and n2 such that
   !--    n1*dz.le.zmin.lt.(n1+1)*dz, and
   !--    (n2-1)*dz.lt.zmax.le.n2*dz
   !--the new zmin and zmax become
   !--    zmin = n1*dz
   !--    zmax = n2*dz
   n1=int(zmin/dz)
   fn=n1
   z=fn*dz
   if (z.gt.zmin) then
      z=z-dz
      n1=n1-1
   endif
   zmin=z
   z1=zmin
   n2=int(zmax/dz)
   fn=n2
   z=fn*dz
   if (z.lt.zmax) then
      n2=n2+1
      z=z+dz
   endif
   zmax=z
   z2=zmax

   !--the values of major and minor can be set
   major=n2-n1
   minor=nm*major
   return
   end subroutine ascalv

end module viewm
