	Subroutine FTP$READ
c
	Include 'FTP$DEVINFO.FOR'
c
c	*** FTP error messages
c
	External	FTP$_FILCNT
	External	FTP$_NOFILPRC
c
	Character*256	Output_File,	Cmd
c
	Integer		Output_Length,	Buffer_Address
	Integer		Byt,		Rec,		Block_Size
	Integer		FTP$Set_Tape,	CLI$Get_Value,	Output_Present
	Integer		FTP$Read_Special
c
	Output_Present = CLI$Get_Value
	1			(	'OUTPUT_FILE'	! entity_desc
	1			,	Output_File	! retdesc
	1			,	Output_Length	! retlength
	1			)
c
c	*** Set tape block and record sizes
c
	I = 0
c
	If ( FTP$Set_Tape() .and. FTP$Read_Special() ) Then
c
c	    *** DYNAMICALLY allocate enough memory for a tape block
c
	    Call FTP$GET_MEMORY( Buffer_Address, 65535 )
c
	    Byt = FTP$RECSIZ
	    Rec = FTP$BUFSIZ / FTP$RECSIZ
c
c	    *** Read the tape
c
	    Call FTP$Read_Tape( Output_File( : Output_Length), I,
	1			%Val( Buffer_Address ), Byt, Rec )
c
c	    *** Release the buffer memory
c
	    Call FTP$RELEASE_MEMORY( Buffer_Address, 65535 )
c
	End If
c
	If ( I .eq. 0 ) Then
	    Call Lib$Signal( FTP$_NOFILPRC )
	Else
	    Call Lib$Signal( FTP$_FILCNT, %Val( 1 ), %Val( I ) )
	End If
c
	Return
	End



	Integer Function FTP$READ_SPECIAL
c
	Include 'FTP$DEVINFO.FOR'
	Include 'FTP$FLAGS.FOR'
c
	Character*15	String
c
	Integer		CLI$Present,		SLen
c
10	Format( I15 )
c
	FTP$Read_Special = .True.
c
	If ( CLI$Present('FILE_COUNT') ) Then
	    Call CLI$Get_Value( 'FILE_COUNT', String, SLen )
	    Read(String(:SLen),10) FTP$FILCNT
	    FTP$READALL_FLG = .False.
	Else If ( CLI$Present('READ_ALL') ) Then
	    FTP$READALL_FLG = .True.
	Else
	    FTP$READALL_FLG = .False.
	    FTP$FILCNT = 1
	End If
c
	If ( CLI$Present( 'INDIRECT_FLAG' ) ) Then
	    FTP$INDIRECT_FLG = .True.
	Else
	    FTP$INDIRECT_FLG = .False.
	End If
c
	If ( CLI$Present( 'TRIM_FLAG' ) ) Then
	    If (CLI$Present('TRIM_FLAG.BLOCK')) Then
		FTP$TRMBLK_FLG = .True.
	    Else
		FTP$TRMBLK_FLG = .False.
	    End If
	    If (CLI$Present('TRIM_FLAG.RECORD')) Then
		FTP$TRMREC_FLG = .True.
	    Else
		FTP$TRMREC_FLG = .False.
	    End If
	    If (CLI$Present('TRIM_FLAG.NONE')) Then
		FTP$TRMBLK_FLG = .False.
	    	FTP$TRMREC_FLG = .False.
	    End If
	Else
	    FTP$TRMBLK_FLG = .False.
	    FTP$TRMREC_FLG = .False.
	End If
c
	If (CLI$Present( 'FIXED_FLAG' )) Then
	    FTP$TRMREC_FLG = .False.
	    FTP$RECORD_TYPE = 'FIXED   '
	Else
	    FTP$RECORD_TYPE = 'VARIABLE'
	End If
c
	If (CLI$Present( 'CARRIAGE_CONTROL.LIST' )) Then
	    FTP$CARRIAGE_CONTROL = 'LIST    '
	Else If (CLI$Present( 'CARRIAGE_CONTROL.FORTRAN' )) Then
	    FTP$CARRIAGE_CONTROL = 'FORTRAN '
	Else If (CLI$Present( 'CARRIAGE_CONTROL.NONE' )) Then
	    FTP$CARRIAGE_CONTROL = 'NONE    '
	End If
c
	Return
	End



	Subroutine FTP$READ_TAPE ( Output_File, File_Cnt, Buffer,
	1			   Byt, Rec )
c
	Integer		File_Cnt,	Byt,		Rec
c
	Byte		Buffer
c
	Character	Output_File*(*)
c
	Include 'FTP$DEVINFO.FOR'
	Include 'FTP$FLAGS.FOR'
c
	Character*256	File_Name
c
	Integer		EOT_FLAG,	Success_Flag
c
10	Format	( Q, A )
c
	Success_Flag = .True.
c
	If ( FTP$INDIRECT_FLG ) Then
	    Open	(	Unit		= 1
	1		,	Name		= Output_File
	1		,	Status		= 'OLD'
	1		,	READONLY
	1		,	SHARED
	1		)
	Else
	    File_Name = Output_File
	    IQ = Len(Output_File)
	End If
c
	File_Cnt = 0
	EOT_FLAG = .False.
c
	Do While ((( File_Cnt .lt. FTP$FILCNT ) .or.
	1	   ( FTP$READALL_FLG )) .and. ( .not. EOT_FLAG ) .and.
	1	   ( .not. FTP$EOT_FLG ) .and. ( Success_Flag ))
c
	    If ( FTP$INDIRECT_FLG ) Read(1,10,End=200) IQ, File_Name(:IQ)
	    File_Cnt = File_Cnt + 1
	    Call FTP$WRITE_FILE(File_Name(:IQ), Buffer, Byt, Rec,
	1			EOT_FLAG, Success_Flag)
c
	End Do
c
200	If ( FTP$INDIRECT_FLG ) Close( Unit=1 )
	If ((FTP$EOT_FLG) .or. (EOT_FLAG)) File_Cnt = File_Cnt - 1
c
	Return
	End



	Subroutine FTP$WRITE_FILE( Output_File, Buffer, Byt, Rec,
	1			   Flag, Success_Flag )
c
	Character	Output_File*(*)
c
	Integer		Byt,	Rec,	Flag,	Success_Flag
c
	Byte		Buffer
c
	Include 'FTP$DEVINFO.FOR'
	Include 'FTP$FLAGS.FOR'
	Include '($SSDEF)'
c
	External	FTP$_INCNTS
c
	Character*512	File_Name
c
	Integer		BlkSiz,		Trn_Stat,	Length
	Integer		FinRec,		Block_Cnt,	Record_Cnt
	Integer		Status,		QIO_Status
c
	Open	(	Unit		= 2
	1	,	Name		= Output_File
	1	,	Status		= 'NEW'
	1	,	CarriageControl	= FTP$CARRIAGE_CONTROL
	1	,	RecordType	= FTP$RECORD_TYPE
	1	,	RecL		= Byt
	1	)
c
	Inquire	(	Unit		= 2
	1	,	Name		= File_Name
	1	)
c
	Flag = .True.
	Record_Cnt = 0
	Block_Cnt = 0
c
	QIO_Status = FTP$READ_QIOW( Buffer, 65535, BlkSiz, Status, )
c
	If ( Status ) Call FTP$Show_FileName( File_Name, Length )
c
	Do While ( Status )
c
	    Call FTP$Translate ( Buffer, BlkSiz )
	    Call FTP$Trim_Block ( Buffer, Byt, BlkSiz, FinRec )
	    Call FTP$Write_Record( Buffer, Byt, FinRec )
c
	    Block_Cnt = Block_Cnt + 1
	    Record_Cnt = Record_Cnt + FinRec
	    Flag = .False.
c
	    QIO_Status = FTP$READ_QIOW( Buffer, 65535, BlkSiz, Status, )
c
	End Do
c
	Call FTP$GETDVI( FTP$FULLDEVNAM(:FTP$FULLDEVNAM_LEN) )
c
	If ( Flag ) Then
	    Close( Unit = 2, Disp='DELETE' )
	Else
	    Close( Unit = 2 )
	    If ( Status .ne. SS$_ENDOFFILE )
	1	Call Lib$Signal( %Val(Status) )
	    If ( FTP$LOG_FLG )
	1	Call Lib$Signal ( FTP$_INCNTS, %Val( 2 ),
	1			  %Val( Record_Cnt ), %Val( Block_Cnt ) )
	End If
c
	Return
	End



	Subroutine FTP$TRIM_BLOCK ( Block, Byt, BlkSiz, FinRec )
c
	Integer		Byt,		BlkSiz,		FinRec
c
	Byte		Block( BlkSiz )
c
	Include 'FTP$FLAGS.FOR'
c
	Integer		More_Flag,	Rec,		FinByt
c
	If ( FTP$TRMBLK_FLG ) Then
	    FinByt = BlkSiz
	    More_Flag = .True.
	    Do While (	( FinByt .gt. 0 ) .and.
	1		( Block(FinByt) .eq. FTP$BLK_PADCHAR) )
		FinByt = FinByt - 1
	    End Do
	    FinRec = FinByt / Byt
	    If ( (FinRec * Byt) .ne. FinByt ) Then
		FinRec = FinRec + 1
		Do I = FinByt, (FinRec*Byt)
		    Block( I ) = FTP$REC_PADCHAR
		End Do
	    End If
	Else
	    FinRec = BlkSiz / Byt
	    If ( (FinRec * Byt) .ne. BlkSiz ) Then
		FinRec = FinRec + 1
		Do I = BlkSiz, (FinRec*Byt)
		    Block( I ) = FTP$REC_PADCHAR
		End Do
	    End If
	End If
c
	Return
	End



	Subroutine FTP$TRIM_RECORD ( Buffer, RecSiz, RecLen )
c
	Integer		RecSiz,		RecLen
c
	Byte		Buffer( RecSiz )
c	
	Include 'FTP$FLAGS.FOR'
c
	RecLen = RecSiz
c
	If ( FTP$TRMREC_FLG ) Then
	    Do While (( RecLen .gt. 0 ) .and.
	1		  ( Buffer(RecLen) .eq. FTP$REC_PADCHAR ))
		RecLen = RecLen - 1
	    End Do
	End If
c
	Return
	End



	Subroutine FTP$WRITE_RECORD ( Buffer, Byt, RecCnt )
c
	Integer		Byt,	RecCnt
c
	Byte		Buffer( Byt, RecCnt )
c
	Integer		I,	RecLen
c
10	Format ( <RecLen>A1 )
c
	Do I = 1, RecCnt
	    Call FTP$TRIM_RECORD ( Buffer(1,I), Byt, RecLen )
	    Write(2,10) (Buffer(J,I), J=1,RecLen)
	End Do
c
	Return
	End



	Subroutine FTP$TRANSLATE( Buffer, BufSiz )
c
	Integer		BufSiz
c
	Byte		Buffer( BufSiz )
c
	Include 'FTP$FLAGS.FOR'
	Include 'FTP$TRANSTBL.FOR'
c
	Integer		LIB$MOVTC
	Integer		Trans_Status
c
	If ( FTP$TRANSLATE_FLG ) Then
	    Trans_Status = LIB$MOVTC( %DESCR(Buffer), ' ',
	1			      %DESCR(FTP$TRANS_TABLE),
	1			      %DESCR(Buffer) )
	    If ( .not. Trans_Status ) Call LIB$SIGNAL( %Val(Trans_Status) )
	End If
c
	Return
	End
