SUBROUTINE SCOPY (XFROM,I,XTO,J) 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: C C MODIFICATION HISTORY C C BY DATE REASON PROGRAMS AFFECTED C C **************************************************************** C C Author: Rick Burke Version: A.0 Date: Sep-86 C C Calling Parameters: C C R XFROM - Source array C R I - Initial index in source array C W XTO - Destination array C R J - Initial index in destination array 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 Local variable definitions : C C K1 - Index into FROM array C K2 - Index into TO array C C **************************************************************** C C Commons referenced : KERPAR 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 XFROM(1), XTO(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 * C O M M O N S T A T E M E N T S * C * * C **************************************************************** C 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 K2 = J K1 = I C 10 CONTINUE XTO(K2) = XFROM(K1) K2 = K2 + 1 K1 = K1 + 1 IF (XFROM(K1-1) .NE. EOS) GO TO 10 RETURN END