Cms	Program to read the spacial data from a OFPP "stored" image.
Cms  Originally the Cameca function IMGREC.
Cms
c
c	IMAGDAT8 is my frst attempt at reading data from AQXE generated
c  image files.  Future programs will write this data in a label.PCX format
c  or possibly TIF, but the latter is will be a PC program written in c.
c  IMAGDAT8 reads data from the OFPP 'stored' image file as well as
c  from the label.DES file, calculates the gain and offset for reaining
c  original numbers, reads the x and y resolution from the DES file.
c
c	Use this program as an example of reading such files, as the file
c  itcurrently write isn't of much use 'cept to compress data.
c
Cms	Michael Shaffer, University of Oregon, July 1991.
c
c	Read "stored" image, write spacial data to file
c
c	link with the option: MAXBUF=1536
c	I.E., type	LINK/OP IMAGDAT8 [return]
c			OPTION: MAXBUF=1536 [return]
c			OPTION: [return]
c
c
c
	program imagdat8

	parameter IORVB="21*"400

	character*1 fnam*13,type*3
	BYTE dat8(1024)
	integer*2 iopar(6),ofset(2,6),iost(2),reclO
	integer*2 lut(256), yatx0
	real slope

	equivalence (dat8(7),lut(1))

common
	include 'IMGCOM.INC'		
c
common

c	local_data
c
	data fnam/'             '/
c
c	Inquire for label name
c
99	write(5,102)
102	format(/1x,'Input label for stored image file [9 char. max] : ',$)
	read(5,5000,err=99)nchar,(label(i:i),i=1,9)
c	if(nchar.lt.1.or.nch.gt.9)goto 99
c
c
c	Open descriptor file
c

c	nchar=index(LABEL,' ')-1
	if(nchar.lt.1.or.nchar.gt.9)nchar=9
	fnam(1:nchar)=LABEL(1:nchar)
	fnam(nchar+1:nchar+4)='.DES'
	write(5,1001) fnam(1:nchar+4)
1001	format(/1x,'Opening DES(cripter) file: ',a13)
	open(unit=3,file=fnam(1:nchar+4),status='OLD',
     .	carriagecontrol='LIST',err=910)

c	and get relevant info
c
c	Recall label, comments and date
c

	read(3,5001,end=910,err=910)LABEL(1:9),(COMMEN(i),i=1,20),
     .	(DAT(i),i=1,9)

c
c	Recall column condition
c

	read(3,5040,end=910,err=910)BC,HV,COND(1:4)

c
c	Recall number of spectros, blocs configuration and stage position
c

	read(3,5100,end=910,err=910)NSPC,BLOC(1:10),(STGPOS(i),i=1,3)

c
c	Recall stage offset and limits
c

	read(3,5120,end=910,err=910)(OFFSET(i),i=1,3),
     .	((STGLIM(i,j),i=1,2),j=1,3)

c
c	Recall Z_update positions
c

	do 105 j=1,4
105	read(3,5200,end=910,err=910)(STGFOC(i,j),i=1,3)

c
c	Recall crystals names and configuration
c

	read(3,5300,end=910,err=910)(XNAM(i),i=1,20)
	do 205 isp=1,NSPC
205	read(3,5320,end=910,err=910)(NXT(i,isp),i=1,6)

c
c	Recall acquisition parameters
c

	read(3,5400,end=910,err=910)NPTX,NPTY,STEP,CTIM,SCMOD
	read(3,5500,end=910,err=910)ADJUST,IROT,IBMSZ,IPAPC,IUPDZ
	write(5,1006)nptx,npty
1006	format(/1x,'DES info: x and y resolution = ',i4,i4)
c
	close(3)
	write(5,1007)
1007	format(/1x,'DES(cripter) file closed ...')
c
c
c	Inquire for image file extension to recall
c
	fnam(1:13)='             '
100	write(5,101)
101	format(/1x,'Input image file extension [3 char. max] : ',$)
	read(5,5002,err=100)nch,(type(i:i),i=1,3)
	if(nch.lt.1.or.nch.gt.3)goto 100
C	nchar=index(LABEL,' ')-1
C	if(nchar.lt.1.or.nchar.gt.9)nchar=9
	fnam(1:nchar)=LABEL(1:nchar)
	fnam(nchar+1:nchar+1)='.'
	ncharm=nchar+nch+1
	fnam(nchar+2:ncharm)=type(1:nch)

c
c	Get IO parameters and open image file
c

	do 200 ipara=1,6
200	iopar(ipara)=0
	call getadr(iopar(1),dat8)
	nbyt=NPTX			! nbyt = data/line
	ioblk=(nbyt-1)/512+1		! ioblk = 1 for nbyt < 512 (=2)
	iopar(2)=512*ioblk		! iopar(2) = 512 ( or 1024 )
	nrec=NPTY+1			! nrec = number of lines + 1
	jmax=512*ioblk			! jmax = iopar(2)
	isize=ioblk*nrec		! isiz = size of in blocks
	irecl=ioblk*512/4		! recl = (number of 4-byte words)/block
c
	write(5,1010) fnam(1:nchar+4)
1010	format(/1x,'Opening STORED image file: ',a13)
	open(unit=3,file=fnam(1:NCHAR+4),status='OLD',err=930)

c
c	Compute output file characteristics
c

c	nbyto=NPTX*2
	ioblko=1		! standard block 1*512bytes
c	ioparo(2)=512*ioblko
	nreco=NPTY		! number of records
c	jmaxo=512*ioblko
				! record lengthes
c	reclo=nptx/2		! INTEGER DATA = (nptx/512)*ioblko*512/2
	reclo=nptx/4		! BYTE DATA = (nptx/512)*ioblko*512/4

c
c	Open output file
c
	fnam(nchar+4:nchar+4)='8'
	write(5,1008) fnam(1:nchar+4)
1008	format(/1x,'Opening output file: ',a13)

	open(unit=4,file=fnam(1:nchar+4),status='NEW',
     .	recl=reclo,form='UNFORMATTED',access='DIRECT',err=940)

c
c	read first block into lut and calculate y (x=0) and slope
c
	iopar(5)=1
	call qio(IORVB,3,1,,iost,iopar)
	call waitfr(1)
	if(iost(2).eq.0)goto 920
c
	yatx0=lut(1)
	slope=(lut(201)-lut(1))/200.0

	write(5,96) yatx0, slope
96	format(/1x,'The intercept is ',i3,' and the slope is ',f5.2)

c
c	Loop on lines of image
c

	do 300 line=1,NPTY
	iopar(5)=1+line
	call qio(IORVB,3,1,,iost,iopar)
	call waitfr(1)
	if(iost(2).eq.0)goto 920

Cms	DO 251 ii=1,NPTX			! not needed for byte data
Cms	DAT16(ii)=ICHAR(dat8CH(ii))		! not needed for byte data
Cms	dat16(ii)=(dat16(ii)*slope+yatx0)	! not needed for byte data
251	CONTINUE
	write(4'line)(dat8(i),i=1,nptx)

c	write(5,95)((dat16(i)),i=1,NPTX)
c95	format( 16(I5) )

300	continue

	close(unit=3)
	close(unit=4)

	goto 6000

c
c	Error opening image file, return to main
c

910	write(5,911)
911	format(/1x'problem reading label.DES file ...')

	goto 6000

c
c	IO directive error, exit 
c

920	write(5,5920)iost(1)

	goto 6000

c
c	Error opening image file, return to main
c

930	write(5,931)
931	format(/1x'problem opening STORED image file ...')
	goto 6000

c
c	Error opening image file, return to main
c

940	write(5,941)
941	format(/1x'problem opening ouput file ...')
	goto 6000

c
c	Formats
c

5000	format(q,9a1)
5002	format(q,3a1)
5920	format(' QIOW: I/O directive error from "imagdat8"'/
     .	5x,'Status: ',o6)

c
c	label.DES file formats (some not used)
c
5001	format(1x,a9,1x,20a1,1x,9a1)
5040	format(1x,F8.2,1x,F4.1,1x,a4)
5100	format(1x,i1,1x,a10,3(1x,i7))
5120	format(3(1x,i7),6(1x,i7))
5200	format(3(1x,i7))
5300	format(20a4)
5320	format(6(1x,i2))
5400	format(1x,i3,1x,i3,1x,f7.3,1x,f5.1,1x,a1)
5500	format(1x,a1,1x,i3,1x,i3,1x,i1,1x,i1)
5540	format(3(1x,i1),2(1x,i5),1x,f5.2)
5600	format(2(1x,a2),1x,i1,1x,a4,1x,i6,1x,a9)
5640	format(6(1x,i6))
5650	format(5(1x,i6))
5700	format(2(1x,i1),1x,a1)
5740	format(36(1x,i1))


6000	end