	subroutine wrpic
#
# schreibt ein Grauwertbild aus Bank 1 ab Adresse adrb
# in einen Bild-File (Extension .PIC) auf Diskette.
#
# Externe Routinen:	loadb	liest ein Byte aus Bank 1
#
define	LUN	6		# Logical Unit No.
define	DRIVE	2		# Drive B:
#
byte	rep(3),fmti(10)	# Eingabe-Format
byte	g		# Grauwert
#
integer	adrb,adr	# Adresse in Bank 1
integer	xanz,yanz,	# Bildgrenzen
	gwmax		# max.Grauwert (<32)
integer	adrb,adr	# Adresse in Bank 1
integer	i,j,k		# Laufindizes
#
double precision fname(2)	# Filename + Extension
#
common	/bild/adrb,xanz,yanz,gwmax
#
data	fmti/'(','1','X',',','.','.','.','I','3',')'/
data	fname/'        ','PIC     '/
#
write(1,10)
10 format(' Disk in Drive B. Name des Bild-Files ')
read(1,12) fname(1)
12 format(a8)
write(1,14) fname
14 format(' Bild-File ',2a8)
call open(LUN,fname,DRIVE)
i=1
write(LUN,20) xanz,yanz,i,i,gwmax
20 format('+',5i3)		# + fuehrendes Blank
for(i=1; i<=gwmax+1; i=i+1)
	write(LUN,22) i		# Dummy Output Grauwerte
write(LUN,22) i			# - Schwellwert
22 format(i3)
do i=1,yanz
[	for (j=1; j<=xanz; j=j+2)
	[	adr=adrb+(j-1)*yanz+i-1
		call loadb(g,adr)
		k=g*256
		adr=adr+yanz
		call loadb(g,adr)
		k=k+g
		write(LUN,30) k
		30 format(i6)
]	]
write(1,40)
40 format(' geschrieben.')
endfile LUN
return
end

