c create by Jiang 1990,12,26
	subroutine pgxchinese(x,y,ch,n,j1,j2)
c x,y position 		! world coordination
c integer ch(n)		! n chinese_char. 
c integer j1		! 1~6, size
c integer j2		! 0, 90, -90, direct
	include 'grpckg1.inc'
	integer ch(n)
	integer b(128*1151)
	character chr
	byte a(512,1151)
	real rbuf(6)
	byte b24(24,24)
	equivalence (a,b)
	data ip/0/
	if(ip.ne.0)goto 10
	ip=1
	call grglun(lun)
	open(lun,file='/home/primefocus/jiang/vega2/pgplot/han.24',
     *  status='old',access='direct',recl=512*1151)
5	read(lun,rec=1)a
	close (lun)
c get abs. position and resolution
10	call pg_size(sizex,sizey)
	call grtxy0(.false.,x,y,abx,aby)
	abx=nint(abx)
	aby=nint(aby)
	call grexec(grgtyp,3,rbuf,nbuf,chr,lchr)
	is_x=nint(300./rbuf(1))
	is_y=nint(300./rbuf(2))
	rx=1./is_x
	ry=1./is_y
	ij=j1
	if(ij.le.0.or.ij.gt.6)ij=max(2,is_x,is_y)
c write n chinese word.
	if(j2.eq.0)then
	do 20 k=1,n
	m=(n_lib(ch(k))-1)*18+1
	call t_ch_24(b(m),b24)
	do 30 j=1,24
	do 30 i=1,24
	if(b24(i,25-j).eq.0)goto 30
	do 40 jj=0,ij-1,is_y
	yy=aby+((j-1)*ij+jj)*ry
	do 40 ii=0,ij-1,is_x
	xx=abx+((i-1)*ij+ii)*rx
40	call pg_dot(xx,yy,sizex,sizey)
30	continue
	call pgebuf
20	abx=nint(abx+25*ij*rx)
	endif
c 90 degree
	if(j2.gt.0)then
	do 120 k=1,n
	m=(n_lib(ch(k))-1)*18+1
	call t_ch_24(b(m),b24)
	do 130 j=1,24
	do 130 i=1,24
	if(b24(j,i).eq.0)goto 130
	do 140 jj=0,ij-1,is_y
	yy=aby+((j-1)*ij+jj)*ry
	do 140 ii=0,ij-1,is_x
	xx=abx+((i-1)*ij+ii)*rx
140	call pg_dot(xx,yy,sizex,sizey)
130	continue
	call pgebuf
120	aby=aby+25*ij*ry
	endif
c -90 degree
	if(j2.lt.0)then
	do 220 k=1,n
	m=(n_lib(ch(k))-1)*18+1
	call t_ch_24(b(m),b24)
	do 230 j=1,24
	do 230 i=1,24
	if(b24(i,j).eq.0)goto 230
	do 240 jj=0,ij-1,is_y
	yy=aby-((j-1)*ij+jj)*ry
	do 240 ii=0,ij-1,is_x
	xx=abx+((i-1)*ij+ii)*rx
240	call pg_dot(xx,yy,sizex,sizey)
230	continue
	call pgebuf
220	aby=aby-25*ij*ry
	endif
	end

	subroutine pg_size(sizex,sizey)
	include 'grpckg1.inc'
	real rbuf(6)
	character chr	
	call grexec(grgtyp,6,rbuf,nbuf,chr,lchr)
	sizex=rbuf(2)
	sizey=rbuf(4)
	end

	subroutine pg_dot(abx,aby,sizex,sizey)
	include 'grpckg1.inc'
	real rbuf(6)
	character chr	
 	if(abx.lt.0..or.abx.gt.sizex)return
	if(aby.lt.0..or.aby.gt.sizey)return
	rbuf(1)=abx
	rbuf(2)=aby
	call grexec(grgtyp,13,rbuf,nbuf,chr,lchr)
	end

	function n_lib(n)
	n_lib=0
	k=mod(n,100)
	if(k.gt.94)return
	k=(n/100-1)*94+k
	if(k.lt.0.or.k.gt.8178)return
	n_lib=k
	end

	function n_code(n)
	n_code=((n-1)/94+1)*100+mod(n-1,94)+1
	end

        subroutine t_ch_24(a,c)
        byte a(3,24),c(24,24)
        integer*2 b
        do 10 j=1,24
        l=0
        do 10 i=1,3
        b=a(i,j)
	if(b.lt.0)b=b+256
	l=l+8
        do 10 k=0,7
	m=l-k
        c(m,j)=mod(b,2)
10      b=b/2
        end

c create by Jiang 1999,8
	subroutine pg4chinese(x,y,ch,n,j1,j2)
c x,y position 		! world coordination
c integer ch(n)		! n chinese_char. 
c integer j1		! 1~6, size
c integer j2		! 0, 90, -90, direct
	include 'grpckg1.inc'
	integer ch(n)
	integer b(128*1150*4)
	character chr
	byte a(512,1150*4)
	real rbuf(6)
	byte b48(48,48)
	equivalence (a,b)
	data ip/0/
	if(ip.ne.0)goto 10
	ip=1
	call grglun(lun)
        open(lun,file='/home/primefocus/jiang/vega2/pgplot/han.48',
     *  status='old',access='direct',recl=512*1150*4)
5	read(lun,rec=1)a
	close (lun)
c get abs. position and resolution
10	call pg_size(sizex,sizey)
	call grtxy0(.false.,x,y,abx,aby)
	abx=nint(abx)
	aby=nint(aby)
	call grexec(grgtyp,3,rbuf,nbuf,chr,lchr)
	is_x=nint(300./rbuf(1))
	is_y=nint(300./rbuf(2))
	ij=j1
	if(ij.lt.0)ij=-ij
	if(ij.eq.0)ij=1
	rx=1./is_x*ij
	ry=1./is_y*ij
	
c write n chinese word.
	if(j2.eq.0)then
	do 20 k=1,n
	m=(n_lib(ch(k))-1)*72+1
	call t_ch_48(b(m),b48)
	do 30 j=1,48
	do 30 i=1,48
	if(b48(i,49-j).eq.0)goto 30
	yy=aby+(j-1)*ry
	xx=abx+(i-1)*rx
	call pg_dot(xx,yy,sizex,sizey)
30	continue
	call pgebuf
20	abx=nint(abx+49*rx)
	endif
c 90 degree
	if(j2.gt.0)then
	do 120 k=1,n
	m=(n_lib(ch(k))-1)*72+1
	call t_ch_48(b(m),b48)
	do 130 j=1,48
	do 130 i=1,48
	if(b48(j,i).eq.0)goto 130
	yy=aby+(j-1)*ry
	xx=abx+(i-1)*rx
	call pg_dot(xx,yy,sizex,sizey)
130	continue
	call pgebuf
120	aby=aby+49*ry
	endif
c -90 degree
	if(j2.lt.0)then
	do 220 k=1,n
	m=(n_lib(ch(k))-1)*72+1
	call t_ch_48(b(m),b48)
	do 230 j=1,48
	do 230 i=1,48
	if(b48(i,j).eq.0)goto 230
	yy=aby-(j-1)*ry
	xx=abx+(i-1)*rx
	call pg_dot(xx,yy,sizex,sizey)
230	continue
	call pgebuf
220	aby=aby-49*ry
	endif
	end

        subroutine t_ch_48(a,c)
        byte a(48,6),c(48,48)
	integer b
	integer b8(8)
	data b8/128,64,32,16,8,4,2,1/
        do 10 j=1,48
        l=0
        do 10 i=1,6
        b=a(j,i)
	if(b.lt.0)b=b+256
        do 10 k=1,8
	l=l+1
	c(l,j)=0
10	if(iand(b,b8(k)).ne.0)c(l,j)=1
        end
