	PROGRAM FRAGMENT

C	LINK THIS PROGRAM WITH /NOTRACEBACK
C	David Deley  GRC/SB 27-MAY-1988  Created

	IMPLICIT NONE
	INCLUDE '($RMSDEF)'
	integer*4	maxblk,
	1		findstatus,
	2		context,
	3		lib$find_file,
	4		msglen,
	5		file_number,
	6		outputfile_len,
	7		I,K
	character*32256	inline
	character*255 	inputfile, outputfile, outfilespec, errmsg
	character*5	ctrstr /'.!3ZL'/
	character*4	ftype

20	FORMAT (
	1' '/
	2' This program takes a large file consisting of fixed length'/
	3' 32256 byte records and breaks it into a number of smaller files'/
	4' consisting of fixed length 512 byte records.  The smaller files'/
	5' have names of the form filename.001, filename.002, filename.003,'/
	6' etc.  You specify the block size of the output files.  The smaller'/
	7' files can then be transferred via kermit using the SET FILE TYPE'/
	8' FIXED command and wildcard transfer mode.  The original file can'/
	9' then be pieced back together by running the DEFRAG program'/
	1' ')
19	FORMAT (
	1' Here is an example of how to transfer a number of files:'/
	2'   1.  Backup all the files you want to transfer into a backup'/
	3'       save_set using the command:'/
	4'         $ BACKUP [MYDIR]*.* MYSAVSET.BCK/SAVE_SET/BLOCK_SIZE=32256'/
	5' '/
	6'   2.  Run this program.'/
	7'         INPUT FILE: MYSAVSET.BCK'/
	8'         OUTPUT FILE (minus type and version): MYFRAG'/
	9'         OUTPUT FILE BLOCK SIZE: 10'/
	1' ')
18	FORMAT (
	1'   3.  Transfer the files.'/
	2'         Kermit> SET FILE TYPE FIXED  !Set on receiving end'/
	3'         Kermit> SEND MYFRAG.*'/
	4' '/
	5'   4.  Piece back together the original save_set on remote node.'/
	6'         $ RUN DEFRAG'/
	7'         INPUT FILE (minus type and version): MYFRAG'/
	8'         OUTPUT FILE: MYSAVSET.BCK'/
	9' ')

21	format (' INPUT FILE: ',$)
23	format (' OUTPUT FILE (minus type and version): ',$)
24	format (' OUTPUT FILE BLOCK SIZE: ',$)
25	format (' Do you want help? [N] ',$)

31	format (a)
32	format (I)
C------------------------------------------------------------------------------
	write (6,25)
	read  (5,31) inputfile
	if ((inputfile(1:1) .eq. 'Y') .or. (inputfile(1:1) .eq. 'y')) then
		write (6,20)
		write (6,19)
		write (6,18)
	endif
	write (6,21)
	read  (5,31) inputfile
	write (6,23)
	read  (5,31) outfilespec
	write (6,24)
	read  (5,32) maxblk

        open(unit=1,
	1	file=inputfile,
	2	status='OLD',
	3	recl=32256,
	4	carriagecontrol='NONE',
	5	recordtype='FIXED',
	6	readonly)

	read (1,31) inline
	k = 1

	DO FILE_NUMBER = 1, 999
		call sys$fao(ctrstr,,ftype,%VAL(file_number))
		Findstatus = LIB$FIND_FILE( ftype,
	1	                            outputfile,
	2	                            context,
	3	                            outfilespec)
		Call Lib$find_file_end( context )
		IF (findstatus.NE.rms$_normal .AND.
	1	    findstatus.NE.rms$_fnf    .AND.
	2	    findstatus.NE.rms$_nmf)   THEN
			Call Sys$getmsg( %val(Findstatus), msglen, Errmsg, , )
			Write(6,31) Errmsg(1:msglen)
			call exit
		ENDIF

		outputfile_len = index(outputfile,';')
		PRINT*, 'CREATING FILE ', OUTPUTFILE(1:outputfile_len)
		open(unit=2,
	1		file=outputfile(1:outputfile_len),
	2		status='NEW',
	3		recl=512,
	4		carriagecontrol='NONE',
	5		recordtype='FIXED')

		do I = 1, maxblk
			write(2,31) inline(k:k+511)
			k = k + 512
			if (k .gt. 32256) then
				read (1,31,end=1000) inline
				k = 1
			endif
		enddo
		close(unit=2)
	ENDDO

1000	close(unit=2)
	close(unit=1)
	call exit
	end
