	PROGRAM CPMIMAGE
	IMPLICIT INTEGER*4 (A-Z)
	COMMON /DY/ICHAN,IDRIVE
	character*80 file
	character*80 filerr
	byte ibuf(128,26)
	parameter (nskew=3)
C
2	TYPE 11
11	FORMAT(/
	1' -------------------------------------------'/
	2' C P M IMAGE . V 1  -   CP/M to VAX Transfer'/
	3' -------------------------------------------'/)
C
3	TYPE 13
13	FORMAT(/'$The CP/M Single density Floppy is in Drive No.: ')
	ACCEPT	*,IAN
	IF ((IAN.NE.0) .AND. (IAN.NE.1)) GOTO 3
	IDRIVE=IAN
	IF (IAN.EQ.0) ISTATUS=SYS$ASSIGN('DYA0:',ICHAN,,)
	IF (IAN.EQ.1) ISTATUS=SYS$ASSIGN('DYA1:',ICHAN,,)
	IF (.NOT.ISTATUS)
	1 STOP '?CPMVAX-F-ASSIGN Error (eg. allocated by other user?)'
C
100	CONTINUE	! MAIN LOOP
	CLOSE (UNIT=1)				! JUST IN CASE .....
C
	TYPE 101
101	FORMAT(/
	1' CPMIMAGE-Commands:'/
	3' 1 = Transfer File from CP/M to VAX'/
	4' 2 = Transfer File from VAX to CP/M'/
	7/' CPMIMAGE Command: '$)
	ACCEPT	1,IAN
1	FORMAT(I7)
	IF (IAN.GT.2.OR.IAN.LT.1) GOTO 100
	TYPE 202
202	FORMAT(1X,'File name of image:',$)
208	ACCEPT 203,file
	do i=80,1,-1
	  if (file(i:i).ne.' ') go to 210
	end do
	go to 208
210	filerr=file(1:i)//'err'
	errs=.false.
203	format(a80)
	GOTO (1000,2000),IAN
1000	open(unit=1,file=file,status='new',form='unformatted',
     1		recl=32*26,access='direct',initialsize=(77*26)/4+1)
	do itrack=0,76
	 do iskew=1,nskew
	  do isect=iskew,26,nskew
	    call ssec(ibuf(1,isect),isect,itrack,0,idrive,0,iERR)
	    if (ierr.ne.0) then
	      if (.not.errs) then
		open(unit=2,file=filerr,status='new')
	        errs=.true.
	      end if
	      write(2,1083) itracK,isect,ierr
	      write(*,1083) itracK,isect,ierr
1083	      format(1X,'track=',i2,' sector=',i2,' error=',i4)
	    end if
	  end do
	 end do
	 write(1,REC=itrack+1) ibuf
	end do

	close(1)
	IF (ERRS) CLOSE(2)

	go to 100


2000	open(unit=1,file=file,status='old',form='unformatted',
     1		recl=32*26,access='direct',initialsize=(77*26)/4+1)
	do itrack=0,76
	 read(1,REC=itrack+1) ibuf
	 do iskew=1,nskew
	  do isect=iskew,26,nskew
	    call ssec(ibuf(1,isect),isect,itrack,1,idrive,0,iERR)
	  end do
	 end do
	end do

	close(1)

	go to 100

	end
