C;+
C - F S U B
C****NAME:   FILE FSUB
C    IDENT:  /26JAN0/
C    FILE:   [201,13]FSUB.FTN
C    TKB:    
C
C****PURPOSE:  FORTRAN SUBROUTINE SUPPORT FOR FLECS TRANSLATOR
C
C****RESTRICTIONS:  
C
C SYSTEM:     RSX11M V3.2
C LANGUAGE:   FORTRAN
C AUTHOR:     TERRY BEYER
C DATE:       20-NOV-74
C REVISIONS:
C 26-JAN-80 (MAO) ADD DOCUMENTATION
C
C****CALLING SEQUENCE:  	SEE INDIVIDUAL ROUTINES
C
C       CMN BLOCK I/O:  NONE
C
C****DIALOG: NONE
C
C	    RESOURCES:
C LIBRARIES:   NONE
C OTHER SUBR:  
C DISK FILES:  NONE
C DEVICES:     NONE
C SGAS:        NONE
C EVENT FLAGS: NONE
C SYSTEM DIR:  NONE
C LENGTH/PAR:  
C
C****NOTES:  
C	1.  THESE ROUTINES WERE SUPPLIED TO SUPPORT THE FLECS TRANSLATOR.
C FOR FURTHER DETAILS SEE THE FLECS SYSTEM MODIFICATION GUIDE.
C
C;-
C;+
C - C A T N U M
C****NAME:   SUBROUTINE CATNUM
C    IDENT:  /26JAN0/
C    FILE:   [201,13]FSUB.FTN
C    TKB:    
C
C****PURPOSE:  CONCATINATE NUMBER TO END OF STRING
C
C****RESTRICTIONS:  
C
C SYSTEM:     RSX11M V3.2
C LANGUAGE:   FORTRAN
C AUTHOR:     TERRY BEYER
C DATE:       20-NOV-74
C REVISIONS:
C 26-JAN-80 (MAO) ADD DOCUMENTATION
C
C****CALLING SEQUENCE:  CALL CATNUM(A,N)
C
C		INPUT:  
C
C A	=STRING TO BE APPENDED TO
C N	=(I*2) NUMBER TO APPEND TO A, 0-99999
C 
C	       OUTPUT:  
C
C A	=STRING WITH N APPENDED TO IT IN ASCII
C
C       CMN BLOCK I/O:  NONE
C
C****DIALOG: NONE
C
C	    RESOURCES:
C LIBRARIES:   NONE
C OTHER SUBR:  [201,13]CATSTR,PUTNUM
C DISK FILES:  NONE
C DEVICES:     NONE
C SGAS:        NONE
C EVENT FLAGS: NONE
C SYSTEM DIR:  NONE
C LENGTH/PAR:  
C
C****NOTES:  
C	1.  THESE ROUTINES WERE SUPPLIED TO SUPPORT THE FLECS TRANSLATOR.
C FOR FURTHER DETAILS SEE THE FLECS SYSTEM MODIFICATION GUIDE.
C
C;-
      SUBROUTINE CATNUM(STRING,NUM)
      INTEGER STRING,HOLD(4)
      DATA HOLD/5,0,0,0/
      CALL PUTNUM(HOLD,NUM)
      CALL CATSTR(STRING,HOLD)
      RETURN
      END
C;+
C - C A T S T R
C****NAME:   SUBROUTINE CATSTR
C    IDENT:  /26JAN0/
C    FILE:   [201,13]FSUB.FTN
C    TKB:    
C
C****PURPOSE:  CONCATINATE ONE STRING TO ANOTHER
C
C****RESTRICTIONS:  
C
C SYSTEM:     RSX11M V3.2
C LANGUAGE:   FORTRAN
C AUTHOR:     TERRY BEYER
C DATE:       20-NOV-74
C REVISIONS:
C 26-JAN-80 (MAO) ADD DOCUMENTATION
C
C****CALLING SEQUENCE:  CALL CATSTR(A,B)
C
C		INPUT:  
C
C A	=STRING TO BE APPENDED TO
C B	=STRING TO APPEND TO A
C 
C	       OUTPUT:  
C
C A	=STRING RESULTING FROM APPENDING B TO A
C
C       CMN BLOCK I/O:  NONE
C
C****DIALOG: NONE
C
C	    RESOURCES:
C LIBRARIES:   NONE
C OTHER SUBR:  [201,13]CATSUB
C DISK FILES:  NONE
C DEVICES:     NONE
C SGAS:        NONE
C EVENT FLAGS: NONE
C SYSTEM DIR:  NONE
C LENGTH/PAR:  
C
C****NOTES:  
C	1.  THESE ROUTINES WERE SUPPLIED TO SUPPORT THE FLECS TRANSLATOR.
C FOR FURTHER DETAILS SEE THE FLECS SYSTEM MODIFICATION GUIDE.
C
C;-
C
      SUBROUTINE CATSTR(A,B)
      CALL CATSUB(A,B,1,B)
      RETURN
      END
C;+
C - C P Y S T R
C****NAME:   SUBROUTINE CPYSTR
C    IDENT:  /26JAN0/
C    FILE:   [201,13]FSUB.FTN
C    TKB:    
C
C****PURPOSE:  COPY A STRING INTO A NEW LOCATION
C
C****RESTRICTIONS:  
C
C SYSTEM:     RSX11M V3.2
C LANGUAGE:   FORTRAN
C AUTHOR:     TERRY BEYER
C DATE:       20-NOV-74
C REVISIONS:
C 26-JAN-80 (MAO) ADD DOCUMENTATION
C
C****CALLING SEQUENCE:  CALL CPYSTR(A,B)
C
C		INPUT:  
C
C B	=STRING TO BE COPIED
C 
C	       OUTPUT:  
C
C A	=STRING TO RECEIVE B
C
C       CMN BLOCK I/O:  NONE
C
C****DIALOG: NONE
C
C	    RESOURCES:
C LIBRARIES:   NONE
C OTHER SUBR:  [201,13]CATSUB
C DISK FILES:  NONE
C DEVICES:     NONE
C SGAS:        NONE
C EVENT FLAGS: NONE
C SYSTEM DIR:  NONE
C LENGTH/PAR:  
C
C****NOTES:  
C	1.  THESE ROUTINES WERE SUPPLIED TO SUPPORT THE FLECS TRANSLATOR.
C FOR FURTHER DETAILS SEE THE FLECS SYSTEM MODIFICATION GUIDE.
C
C;-
C
      SUBROUTINE CPYSTR(ISTR,JSTR)
      ISTR=0
      CALL CATSUB(ISTR,JSTR,1,JSTR)
      RETURN
      END
C;+
C - C P Y S U B
C****NAME:   SUBROUTINE CPYSUB
C    IDENT:  /26JAN0/
C    FILE:   [201,13]FSUB.FTN
C    TKB:    
C
C****PURPOSE:  PUT SUBSTRING INTO ANOTHER STRING
C
C****RESTRICTIONS:  
C
C SYSTEM:     RSX11M V3.2
C LANGUAGE:   FORTRAN
C AUTHOR:     TERRY BEYER
C DATE:       20-NOV-74
C REVISIONS:
C 26-JAN-80 (MAO) ADD DOCUMENTATION
C
C****CALLING SEQUENCE:  CALL CPYSUB(A,B,START,LENGTH)
C
C		INPUT:  
C
C B	=STRING FROM WHICH A SUBSTRING IS TO BE EXTRACTED
C START	=(I*2) STRING COORDINATE OF FIRST CHARACTER IN B TO BE EXTRACTED
C LENGTH=(I*2) NUMBER OF CHARACTERS TO EXTRACT
C 
C	       OUTPUT:  
C
C A	=STRING TO RECEIVE SUBSTRING EXTRACTED FROM B
C
C       CMN BLOCK I/O:  NONE
C
C****DIALOG: NONE
C
C	    RESOURCES:
C LIBRARIES:   NONE
C OTHER SUBR:  [201,13]CATSUB
C DISK FILES:  NONE
C DEVICES:     NONE
C SGAS:        NONE
C EVENT FLAGS: NONE
C SYSTEM DIR:  NONE
C LENGTH/PAR:  
C
C****NOTES:  
C	1.  THESE ROUTINES WERE SUPPLIED TO SUPPORT THE FLECS TRANSLATOR.
C FOR FURTHER DETAILS SEE THE FLECS SYSTEM MODIFICATION GUIDE.
C
C;-
C
      SUBROUTINE CPYSUB(ISTR,JSTR,IST,LEN)
      ISTR=0
      CALL CATSUB(ISTR,JSTR,IST,LEN)
      RETURN
      END
C;+
C - H A S H
C****NAME:   FUNCTION HASH
C    IDENT:  /26JAN0/
C    FILE:   [201,13]FSUB.FTN
C    TKB:    
C
C****PURPOSE:  COMPUTE HASH CODE FROM A STRING
C
C****RESTRICTIONS:  
C
C SYSTEM:     RSX11M V3.2
C LANGUAGE:   FORTRAN
C AUTHOR:     TERRY BEYER
C DATE:       20-NOV-74
C REVISIONS:
C 26-JAN-80 (MAO) ADD DOCUMENTATION
C
C****CALLING SEQUENCE:  I=HASH(A,PRIME)
C
C		INPUT:  
C
C A	=STRING
C PRIME	=(I*2) A POSITIVE PRIME NUMBER
C 
C	       OUTPUT:  
C
C HASH	=(I*2) INTEGER IN RANGE 1-(PRIME-1)
C
C       CMN BLOCK I/O:  NONE
C
C****DIALOG: NONE
C
C	    RESOURCES:
C LIBRARIES:   NONE
C OTHER SUBR:  NONE
C DISK FILES:  NONE
C DEVICES:     NONE
C SGAS:        NONE
C EVENT FLAGS: NONE
C SYSTEM DIR:  NONE
C LENGTH/PAR:  
C
C****NOTES:  
C	1.  THESE ROUTINES WERE SUPPLIED TO SUPPORT THE FLECS TRANSLATOR.
C FOR FURTHER DETAILS SEE THE FLECS SYSTEM MODIFICATION GUIDE.
C
C;-
C
      INTEGER FUNCTION HASH(A,PRIME)
      IMPLICIT INTEGER (A-Z)
      INTEGER A(100)
      LEN=(A(1)+3)/2
      HASH=0
      DO 10 I=1,LEN
      HASH = HASH + MOD(A(I),PRIME)
      IF(HASH.GE.PRIME)HASH = HASH - PRIME
   10 CONTINUE
      RETURN
      END
C;+
C - P U T N U M
C****NAME:   SUBROUTINE PUTNUM
C    IDENT:  /26JAN0/
C    FILE:   [201,13]FSUB.FTN
C    TKB:    
C
C****PURPOSE:  INSERT ASCII FOR A NUMBER AT START OF A STRING
C
C****RESTRICTIONS:  
C
C SYSTEM:     RSX11M V3.2
C LANGUAGE:   FORTRAN
C AUTHOR:     TERRY BEYER
C DATE:       20-NOV-74
C REVISIONS:
C 26-JAN-80 (MAO) ADD DOCUMENTATION
C
C****CALLING SEQUENCE:  CALL PUTNUM(A,N)
C
C		INPUT:  
C
C A	=STRING TO HAVE NUMBER PUT IN IT
C N	=(I*2) INTEGER IN RANGE 1-99999
C 
C	       OUTPUT:  
C
C A	=STRING WITH FIRST 5 CHARACTERS REPLACED BY ASCII FOR N
C
C       CMN BLOCK I/O:  NONE
C
C****DIALOG: NONE
C
C	    RESOURCES:
C LIBRARIES:   NONE
C OTHER SUBR:  NONE
C DISK FILES:  NONE
C DEVICES:     NONE
C SGAS:        NONE
C EVENT FLAGS: NONE
C SYSTEM DIR:  NONE
C LENGTH/PAR:  
C
C****NOTES:  
C	1.  THESE ROUTINES WERE SUPPLIED TO SUPPORT THE FLECS TRANSLATOR.
C FOR FURTHER DETAILS SEE THE FLECS SYSTEM MODIFICATION GUIDE.
C
C;-
C
      SUBROUTINE PUTNUM(HOLD,NOM)
      INTEGER HOLD(4),NUM
      IDIG(N) = MOD(NUM/N,10) + 48
      NUM = NOM
      HOLD(2)=NUM/10000+48+IDIG(1000)*256
      HOLD(3)=IDIG(100)+IDIG(10)*256
      HOLD(4)=IDIG(1)+8192
      RETURN
      END
C;+
C -  N E W N O
C****NAME:   FUNCTION NEWNO
C    IDENT:  /26JAN0/
C    FILE:   [201,13]FSUB.FTN
C    TKB:    
C
C****PURPOSE:  RETURN NEW NUMBER IN A SEQUENCE
C
C****RESTRICTIONS:  
C
C SYSTEM:     RSX11M V3.2
C LANGUAGE:   FORTRAN
C AUTHOR:     TERRY BEYER
C DATE:       20-NOV-74
C REVISIONS:
C 26-JAN-80 (MAO) ADD DOCUMENTATION
C
C****CALLING SEQUENCE:  I=NEWNO(N)
C
C		INPUT:  
C
C N	=(I*2) CONTROL NUMBER
C	=0, RETURN NEXT NUMBER IN SEQUENCE
C	.NE.0, INITIALIZE SEQUENCE STARTING AT N
C 
C	       OUTPUT:  
C
C NEWNO	=(I*2) NUMBER GENERATED (1 LESS THAN LAST ONE IF N=0)
C
C       CMN BLOCK I/O:  NONE
C
C****DIALOG: NONE
C
C	    RESOURCES:
C LIBRARIES:   NONE
C OTHER SUBR:  NONE
C DISK FILES:  NONE
C DEVICES:     NONE
C SGAS:        NONE
C EVENT FLAGS: NONE
C SYSTEM DIR:  NONE
C LENGTH/PAR:  
C
C****NOTES:  
C	1.  THESE ROUTINES WERE SUPPLIED TO SUPPORT THE FLECS TRANSLATOR.
C FOR FURTHER DETAILS SEE THE FLECS SYSTEM MODIFICATION GUIDE.
C
C;-
C
      INTEGER FUNCTION NEWNO(N)
      IF(N.NE.0)ITMP=N
      ITMP=ITMP-1
      NEWNO=ITMP
      RETURN
      END