home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
kermit.columbia.edu
/
kermit.columbia.edu.tar
/
kermit.columbia.edu
/
archives
/
modcomp.zip
/
fxfile.
< prev
next >
Wrap
Text File
|
1987-01-26
|
5KB
|
164 lines
SUBROUTINE FXFILE(INNAM,OUTNAM,NCHRFX,IND)
C
C ****************************************************************
C
C KERMIT for the MODCOMP MAXIV operating system
C
C Compliments of:
C
C SETPOINT, Inc.
C 10245 Brecksville Rd.
C Brecksville, Ohio 44141
C
C
C KERMIT is a copyrighted protocol of Columbia Univ. The authors
C of this version hereby grant permission to copy this software
C provided that it is not used for an explicitly commercial
C purpose and that proper credit be given. SETPOINT, Inc. makes
C no warranty whatsoever regarding the accuracy of this package
C and will assume no liability resulting from it's use.
C
C ****************************************************************
C
C Abstract: FXFILE TRUNCATES THE FILE TO 8 CHARACTERS AND
C REPLACES ANY NON CAN-CODABLE CHARACTER WITH A "$".
C
C MODIFICATION HISTORY
C
C BY DATE REASON PROGRAMS AFFECTED
C
C ****************************************************************
C
C Author: BOB BORGESON Version: A.0 Date: Oct-86
C
C Calling Parameters:
C
C R INNAM - UNPACKED NAME TO BE FIXED
C W OUTNAM - UNPACKED FIXED FILE NAME
C R NCHRFX - # OF CHARACTERS TO CHECK (MAX = 8)
C W IND - THE # OF CHARACTERS CONVERTED TO $
C
C ****************************************************************
C
C Messages generated by this module : None
C
C ****************************************************************
C
C Subroutines called directly : None
C
C ****************************************************************
C
C Files referenced : None
C
C
C ****************************************************************
C
C Local variable definitions :
C
C CHAR - FLAG INDICATES AT LEAST 1 CHARACTER FOUND
C
C ****************************************************************
C
C Commons referenced : KER local common
C
C ****************************************************************
C
C (*$END.DOCUMENT*)
C
C ****************************************************************
C * *
C * D I M E N S I O N S T A T E M E N T S *
C * *
C ****************************************************************
C
IMPLICIT INTEGER (A-Z)
C
INTEGER*2 INNAM(1), OUTNAM(1)
C
C ****************************************************************
C * *
C * T Y P E S T A T E M E N T S *
C * *
C ****************************************************************
C
C ****************************************************************
C * *
C * C O M M O N S T A T E M E N T S *
C * *
C ****************************************************************
C
INCLUDE USL/KERCOM
INCLUDE USL/KERPMC
C
C ****************************************************************
C * *
C * E Q U I V A L E N C E S T A T E M E N T S *
C * *
C ****************************************************************
C
C
C ****************************************************************
C * *
C * D A T A S T A T E M E N T S *
C * *
C ****************************************************************
C
C
C ****************************************************************
C
C Code starts here :
C
IND = 0
C
C FILL OUTNAM WITH BLANKS
C
DO 100 I = 1,8
C
OUTNAM(I) = 4Z0020
C
100 CONTINUE
C
C CHECK FOR CAN CODE CHARCTERS AND
C REPLACE NASTY ONES WITH "$"
C
CHAR = 0
C
IF(NCHRFX .GT. 8)NCHRFX = 8
C
NCRFX1 = NCHRFX + 1
C
DO 1000 J = 1,NCHRFX
C
I = NCRFX1 - J
C
IF((INNAM(I) .EQ. BLANK) .AND. (CHAR .EQ. 0))GO TO 300
C
IF(((INNAM(I) .GE. BIGA) .AND. (INNAM(I) .LE. BIGZ)) .OR.
> ((INNAM(I) .GE. DIG0) .AND. (INNAM(I) .LE. DIG9)) .OR.
> (INNAM(I) .EQ. COLON) .OR.
> (INNAM(I) .EQ. PERIOD) .OR.
> (INNAM(I) .EQ. DOLLAR))GO TO 200
C
OUTNAM(I) = DOLLAR
IND = IND + 1
CHAR = 1
C
GO TO 1000
C
200 CONTINUE
C
OUTNAM(I) = INNAM(I)
CHAR = 1
GO TO 1000
C
300 CONTINUE
C
OUTNAM(I) = INNAM(I)
C
1000 CONTINUE
C
1100 CONTINUE
C
RETURN
END