        SUBROUTINE lhDRIV(IFUNC,RBUF,NBUF,CHR,LCHR)
        integer IFUNC, NBUF,LCHR
        REAL      RBUF(*)
        CHARACTER*45 CHR
        integer ixdim,iydim,lenbuf,ICOL

        data ixdim,iydim,lenbuf,lun,ICOL/2336, 400, 934400,99,0/
	include "driv.inc"
	if(ifunc.eq.28)goto 280
	if(ifunc.eq.29)goto 290
        GOTO( 10, 20, 30, 40, 50, 60, 70,999, 90,100,
     &       110,120,130,140,150) IFUNC
        GOTO 999
C--- IFUNC= 1, Return device name.
10      CHR='LHP      (jiang, landscape for hp_printer)'
        NBUF=0
        LCHR=LEN(CHR)
        RETURN
C--- IFUNC= 2, Return Physical min and max for plot device.
20      RBUF(1)=0
        RBUF(4)=2335                    !
        RBUF(3)=0
        RBUF(2)=3199                    !
        RBUF(5)=0
        RBUF(6)=1
        NBUF=6
	LCHR = 0
        RETURN
C--- IFUNC= 3, Return device (X and Y) resolution in pixels per inch as
30      RBUF(1)=300.0
        RBUF(2)=300.0
        RBUF(3)=1
        NBUF=3
        LCHR=0
        RETURN
C--- IFUNC= 4, Return misc device info.
40      CHR='HNNNNNNNNN'
	NBUF =0
        LCHR=10
        RETURN
C--- IFUNC= 5, Return default file name.
50      CHR='pgplot.lh'
	NBUF=0
        LCHR=LEN(CHR)
        RETURN
C--- IFUNC= 6, Return default physical size of plot.
60      RBUF(1)=0
        RBUF(4)=2335                    !
        RBUF(3)=0
        RBUF(2)=3199                    !
	NBUF=4
	LCHR=0
        RETURN
C--- IFUNC= 7, Return misc defaults.
70      RBUF(1)=1
        NBUF=1
	LCHR=0
        RETURN
C--- IFUNC= 9, Open workstation.
90      CALL grglun(lun)
	call unlink(CHR(:LCHR))
        OPEN(UNIT=lun,FILE=CHR(:LCHR),STATUS='NEW',IOSTAT=IER)
        IF(IER.NE.0) THEN
            CALL GRWARN('Cannot open graphics device '//CHR(:LCHR))
            RBUF(1)=lun
            RBUF(2)=0
	    close (lun)
		goto 999
        ELSE
            RBUF(1)=0
            RBUF(2)=1
        END IF
	call lhbuf0(934400,PIXMAP)
        RETURN
C--- IFUNC=10, Close workstation.
100	close (lun)
        RETURN
C--- IFUNC=11, Begin Picture.  Note, IXMIN=0 and IXMAX=RBUF(1) so,
C--- IXDIM=IXMAX-IXMIN+1=RBUF(1)+1
110     IxDIM=RBUF(1)+1  
        IyDIM=int(RBUF(2)/8.)+1           
        LENBUF=IxDIM*IyDIM
        call grlh02(PIXMAP,lenbuf)
        RETURN
C--- IFUNC=12, Draw line.
120     CALL GRlh01(1,RBUF,ICOL,IxDIM,PIXMAP)
        RETURN
C--- IFUNC=13, Draw dot.
130     CALL GRlh01(0,RBUF,ICOL,IxDIM,PIXMAP)
        RETURN
C--- IFUNC=14, End picture.
140     CALL GRlh04(LUN,PIXMAP,IxDIM,IyDIM)
	IER=GRFMEM(934400,buf)
        RETURN
C--- IFUNC=15, Select pen.  Save pen number (up to 11) for
C--- possible use in pattern interior.
150     ICOL=MAX(0,MIN(NINT(RBUF(1)),11))
        RBUF(1)=MAX(0,MIN(ICOL,1))
        RETURN
C--- Flag function not implemented.
999     NBUF=-1
        RETURN

c      for gray scale raster
280	call grlh03(rbuf,ixdim,PIXMAP)
	return

c      for gray scale raster clear
290     call grlh09(rbuf,ixdim,PIXMAP)
        return
        END


	subroutine lhbuf0(k,buf)
	byte buf(1)
	do i=1,k
	buf(i)=0
	enddo
	end

        SUBROUTINE GRlh01(LINE,RBUF,ICOL,IXDIM,QXYBUF)         !
	integer*2 qxybuf(0:*),qmask(0:15),qtmp
        REAL   RBUF(4)  
        DATA   QMASK /'8000'x,'4000'x,'2000'x,'1000'x,
     *                 '800'x, '400'x, '200'x, '100'x,
     *                  '80'x,  '40'x,  '20'x,  '10'x,
     *                   '8'x,   '4'x,   '2'x,   '1'x/
	ixd2=ixdim/2
        IF(LINE.GT.0) THEN
          LENGTH=NINT(MAX(ABS(RBUF(3)-RBUF(1)),
     &                    ABS(RBUF(4)-RBUF(2))))
          D = MAX(1,LENGTH)
          XINC = (RBUF(3)-RBUF(1))/D
          YINC = (RBUF(4)-RBUF(2))/D
        ELSE
            LENGTH=0
            XINC=0.
            YINC=0.
        END IF
        XP = RBUF(1)
        YP = RBUF(2)
        IF (ICOL.GT.0) THEN
            DO K=0,LENGTH
                KX = NINT(XP)
                KY = NINT(YP)
		kk=ky/8*ixd2+kx/2
		qtmp=mod(ky,8)+mod(kx,2)*8
                QXYBUF(kk) = IOR(QXYBUF(kk),QMASK(qtmp))
                XP = XP + XINC
                YP = YP + YINC
            END DO
        ELSE
            DO K=0,LENGTH
                KX = NINT(XP)
                KY = NINT(YP)
		kk=ky/8*ixd2+kx/2
		qtmp=mod(ky,8)+mod(kx,2)*8
	        qtmp= nnot(QMASK(qtmp))
                QXYBUF(kk) = IAND(QXYBUF(kk),qtmp)
                XP = XP + XINC
                YP = YP + YINC
            END DO
        END IF
        RETURN
        END

	subroutine grlh02(buf,n)
	integer*2 buf(*)
	do 10 i=1,n/2
10	buf(i)=0
	end

	subroutine grlh03(rbuf,ixdim,qxybuf)
	integer*2 qxybuf(0:*),qmask(0:15),qtmp
	integer*2 ii(18),jj(18),ix,iy
        REAL    RBUF(*)  
        DATA   QMASK /'8000'x,'4000'x,'2000'x,'1000'x,
     *                 '800'x, '400'x, '200'x, '100'x,
     *                  '80'x,  '40'x,  '20'x,  '10'x,
     *                   '8'x,   '4'x,   '2'x,   '1'x/
	data ii/0,0,1,0,-1,1,1,2,-1,-1,-2,0,0,2,-2,1,-1,0/
	data jj/0,1,0,-1,0,1,-1,0,1,-1,0,2,-2,1,1,2,2,3/
	ixd2=ixdim/2
        ix= rbuf(1)
        iy= rbuf(2)
	kz= nint(rbuf(3))
	if(kz.lt.1)return
	is=nint(rbuf(4))
	if(kz.gt.is)kz=is
	do 10 i=1,kz
	kx=ix+ii(i)
	ky=iy+jj(i)
	kk=ky/8*ixd2+kx/2
	qtmp=mod(ky,8)+mod(kx,2)*8
10      QXYBUF(kk) = IOR(QXYBUF(kk),QMASK(qtmp))
        END

	subroutine grlh09(rbuf,ixdim,qxybuf)
	integer*2 qxybuf(0:*)
        REAL    RBUF(*)  
	ixd2=ixdim/2
        ix= rbuf(1)
        iy= rbuf(2)
	kx= nint(rbuf(3))
	kz= nint(rbuf(4))
	if(kz.lt.1)return
	do 10 j=1,kz
	ky=iy+j
	do 10 i=1,kx,2
	kk=ky/8*ixd2+(ix+i)/2
10      QXYBUF(kk) =0
        END

        SUBROUTINE GRlh04(LUN,QBUF,IXDIM,IYDIM)
        BYTE QBUF(ixdim,iydim),a(300)
	character c*300,c_line*9,c_row*5,c_head*12,c_end*4
	byte init_hp(17),end_hp(5),v_line(9),
     *       h_row(5),line_head(12),line_end(4)
	equivalence (c,a),(c_line,v_line),(c_row,h_row),
     *              (c_head,line_head),(c_end,line_end)
	data init_hp/32,32,27,69,27,42,112,43,49,89, ! init & .5 inch from top
     *               27,42,116,51,48,48,82/	! 300 dots/inch
	data v_line/27,42,112,43,5*0/		! down # pixel
	data h_row /5*0/			! right_shift # pixel
	data line_head/27,42,114,49,65,		! current curcor
     *                 27,42,98,3*0,87/		! raster nnn bytes
	data line_end/27,42,114,66/		! end line's raster
	data end_hp/27,38,108,48,72/	 	! eject paper
	call swap2(qbuf,ixdim*iydim)
c	call toscan(qbuf,ixdim,iydim)
	write(lun,'(17a1,$)')init_hp
	ii=0
	do 10 i=1,ixdim
	do 15 j=1,iydim
	if(qbuf(i,j).ne.0)goto 16
15	continue
16	jj=j-1
	l=5
	j=jj*8
	if(j.lt.1000)l=4
	if(j.lt.100)l=3
	if(j.lt.10)l=2
c       write(c_row(1:),'(i<l-1>)')j
        if(l.eq.5)write(c_row(1:),'(i4)')j
        if(l.eq.4)write(c_row(1:),'(i3)')j
        if(l.eq.3)write(c_row(1:),'(i2)')j
        if(l.eq.2)write(c_row(1:),'(i1)')j
	h_row(l)=88
	do 20 j=1,iydim-jj
20	a(j)=qbuf(i,j+jj)	
	do 30 j=iydim-jj,1,-1
	if(a(j).ne.0)goto 40
30	continue
40	k=j
	if(k.ne.0)then
	write(c_head(9:),'(i3.3)')k
	line_head(12)=87
	m=9
	if(ii.lt.1000)m=8
	if(ii.lt.100)m=7
	if(ii.lt.10)m=6
c       write(c_line(5:),'(i<m-5>)')ii
        if(m.eq.9)write(c_line(5:),'(i4)')ii
        if(m.eq.8)write(c_line(5:),'(i3)')ii
        if(m.eq.7)write(c_line(5:),'(i2)')ii
        if(m.eq.6)write(c_line(5:),'(i1)')ii
	v_line(m)=121
	write(lun,'(5a,$)')c_line(1:m),c_row(1:l),c_head,c(1:k),c_end
	ii=0
	else
	ii=ii+1
	endif
10	continue
	write(lun,'(5a1,$)')end_hp
        END

c	subroutine toscan(a,ix,iy)
c	byte a(ix,iy)
c	character*292 c
c	byte b(292)
c	equivalence (c,b)
c	open(59,file='tmp.img',status='unknown')
c	i=iy+ix*65536
c	write(59,'(a4,$)')i
c	do 10 i=ix,1,-1
c	do 20 j=1,iy
c20	b(j)=a(i,j)
c10	write(59,'(a,$)')c
c	close(59)
c	call system('tobmp124 tmp.img pgplot.bmp')
c	call system('rm tmp.img')
c	end
