c      post script graphics test
       parameter(ier0=1)
c      parameter(nx=50,ny=75,nx1=nx+1,ny1=ny+1)
       parameter(nx=44,ny=64,nx1=nx+1,ny1=ny+1)
       character chr*30/"This is an example symbol TEST"/
       call xyopen(x,y,ier)
       ino=0
       do 300 jj=1,1
       ier=jj
       ino=ino+1
       call plots(x,y,ier,ino)
       call factor(1.00)
c
       x1=50.0
       y1=50.0
       x2=550.0
       y2=800.0
       x1=36.0
       y1=36.0
       x2=564.0
       y2=804.0
c
       dx=(x2-x1)/float(nx)
       dy=(y2-y1)/float(ny)
c
       call newpen(3)
       call newpe1(3)
c
       do 10 j=1,ny1
       y=y1+dy*(j-1)
       call plot(x1,y,3)
       call plot(x2,y,2)
   10  continue
c
       do 20 i=1,nx1
       x=x1+dx*(i-1)
       call plot(x,y1,3)
       call plot(x,y2,2)
   20  continue
c
       call linee
       call plote
  300  continue
       stop
       end
c       subroutine xyopen(x,y,ier)
       subroutine xyopen(x,y,ier)
       write(6,10)
   10  format( "%!")
       write(6,*) "%%Page: 1 1"
       write(6,*) "/l { lineto} def"
       write(6,*) "/m { moveto} def"
       write(6,*) "/s { show} def"
       write(6,*) "/sl { setlinewidth} def"
       write(6,*) "/sn {stroke newpath} def" 
       write(6,*) "/tr {/Times-Roman findfont} def"
       write(6,*) "/sf { scalefont} def"
       write(6,*) "/se {setfont} def"
       write(6,*) "/ro { rotate} def"
       write(6,*) "/sd { setdash} def"
       write(6,*) "/st {stroke} def"
       write(6,*) "/sp {stroke showpage} def"
       write(6,*) "/tl { translate} def"
       write(6,*) "/sc { scale} def"
       write(6,*) "/ftr /Times-Roman findfont 20 scalefont def"
       write(6,*) "/fnr /Helvetica findfont 20 scalefont def"
       write(6,*) "/fni /Helvetica-Oblique findfont 20 scalefont def"
       write(6,*) "/fnb /Helvetica-Bold findfont 30 scalefont def"
       write(6,*) "/shtr {moveto ftr setfont show} def"
       write(6,*) "/shnr {moveto fnr setfont show} def"
       write(6,*) "/shni {moveto fni setfont show} def"
       write(6,*) "/shnb {moveto fnb setfont show} def"
       write(6,*) "/c {setrgbcolor 1 0 translate newpath 0 0 moveto
     1              0 1 lineto 1 1 lineto 1 0 lineto closepath
     2              fill} def"
       write(6,*) "/ch {sethsbcolor 1 0 translate newpath 0 0 moveto
     1              0 1 lineto 1 1 lineto 1 0 lineto closepath
     2              fill} def"
       write(6,*) "/gs {gsave} def"
       write(6,*) "/gr {grestore 0.0 0.0 0.0 setrgbcolor} def"
       write(6,*) "/crg {setrgbcolor} def"
       write(6,*) "/chs {sethsbcolor} def"
       write(6,*) "/sg { setgray} def"
       return
       end
       subroutine plots(x,y,ir,ino)
c*       write(6,*) "%!"
       if(ino.ge.2) write(6,10) ino,ino
   10  format("%%Page:",1x,i2,1x,i2)
       if(ir.eq.2) then
       il=0
       x=90.0
       y=-600.0
       write(6,*) "90.0 ro"
       write(6,*) "0.0 -600.0 tl"
c       write(6,*) "newpath"
       endif
       return
       end
       subroutine plote
       write(6,*) "sp"
       return
       end
       subroutine linee
       write(6,*) "st"
       return
       end
       subroutine plot(x1,y1,im)
       if(im.eq.3) then 
       write(6,10) x1,y1
   10  format(f5.1,1x,f5.1," m")
       else
       write(6,20) x1,y1
   20  format(f5.1,1x,f5.1," l")
       endif
c       write(6,*) "st
       return
       end
       subroutine factor(fct)
       write(6,10) fct,fct
   10  format(f6.2,1x,f6.2," sc")
       return
       end 
       subroutine newpen(ip)
       i1=(ip-1)/2
       i2=ip-2*i1
       write(6,*) "sn"
       pi1=0.40*float(i1-1)
       write(6,30) pi1
   30  format(f3.1," sl")
       if(i2.ne.1) then
       write(6,*) "[2 2] 0 sd"
       endif
       return
       end
       subroutine newpe1(ip)
       i1=ip
       write(6,*) "sn"
       pi1=0.4*float(i1-1)
       write(6,30) pi1
   30  format(f3.1," sl")
       return
       end
       subroutine symbol(x,y,h,isymb,ang,n)
       character isymb*80,ica*80,ich(80)*1
       equivalence (ica,ich)
       ica=isymb 
       write(6,*) "tr"
       write(6,10) h
   10  format(f5.1," sf")
       write(6,*) "se"
       write(6,20) x,y
   20  format(f5.1,1x,f5.1," m")
       write(6,30) ang
   30  format(f5.1," ro")
c*       write(6,*) "(",isymb,") s" 
       write(6,*) "(",(ich(i),i=1,n),") s" 
       return
       end
       subroutine number(x,y,h,anu,ang,n)
       character isymb*9 
       write(6,*) "tr"
       write(6,10) h
   10  format(f5.1," sf")
       write(6,*) "se"
       write(6,20) x,y
   20  format(f5.1,1x,f5.1," m")
       write(6,30) ang
   30  format(f5.1," ro")
       write(isymb,40) anu
   40  format(1pe9.2)
       write(6,*) "(",isymb,") s" 
       return
       end
       subroutine color1(nx,ny,xb,yb,xl,yl,u,ico)
       dimension u(1)
       dx=xl/float(nx)
       dy=yl/float(ny)
c
       write(6,*) "gs"
       write(6,20) dx,dy
   20  format(f6.2,1x,f6.2," sc")
c
       y=yb/dy-1.0
       x=xb/dx-1.0+float(nx)
       write(6,22) x,y
       do 100 j=1,ny
       y=1.0
       x=-float(nx)
       xx=x
       yy=y
       write(6,22) xx,yy
   22  format(f6.2,1x,f6.2," tl")
       do 100 i=1,nx
       i1=i+nx*(j-1)
       x1=u(i1)
       if(ico.eq.2) go to 32
       if(ico.eq.3) go to 33
       x1=1.0*x1
       r=x1
       g=1.0
       b=1.0
       go to 40
   32  continue
       r=x1
       g=x1
       b=1.0
       go to 40
   33  continue
       x1=1.0*x1
       r=x1
       g=1.0
       b=x1
c
   40  continue
       r=amax1(r,0.0)
       g=amax1(g,0.0)
       b=amax1(b,0.0)
       r=amin1(r,1.0)
       g=amin1(g,1.0)
       b=amin1(b,1.0)
       write(6,24) r,g,b
c*   24  format(f4.2,1x,f4.2,1x,f4.2," c")
   24  format(f4.2,1x,f4.2,1x,f4.2," ch")
  100  continue
       write(6,*) "gr"
       return
       end
       subroutine chrgb(r,g,b)
       write(6,10) r,g,b
   10  format(f4.2,1x,f4.2,1x,f4.2," crg")
       return
       end
       subroutine chhsb(h,s,b)
       write(6,10) h,s,b
   10  format(f4.2,1x,f4.2,1x,f4.2," chs")
       return
       end
       subroutine chgry(g)
       write(6,10) g,g,g
   10  format(f4.2,1x,f4.2,1x,f4.2," crg")
       return
       end
       subroutine chgr(g)
       write(6,10) g
   10  format(f4.2," sg")
       return
       end