home *** CD-ROM | disk | FTP | other *** search
/ Columbia Kermit / kermit.zip / modcomp / scopy. < prev    next >
Text File  |  2020-01-01  |  4KB  |  120 lines
  1.       SUBROUTINE SCOPY (XFROM,I,XTO,J)
  2. C
  3. C     ****************************************************************
  4. C
  5. C              KERMIT for the MODCOMP MAXIV operating system
  6. C
  7. C        Compliments of:
  8. C
  9. C                         SETPOINT, Inc.
  10. C                      10245 Brecksville Rd.
  11. C                      Brecksville, Ohio 44141
  12. C
  13. C
  14. C      KERMIT is a copyrighted protocol of Columbia Univ. The authors
  15. C      of this version hereby grant permission to copy this software
  16. C      provided that it is not used for an explicitly commercial
  17. C      purpose and that proper credit be given. SETPOINT, Inc. makes
  18. C      no warranty whatsoever regarding the accuracy of this package
  19. C      and will assume no liability resulting from it's use.
  20. C
  21. C     ****************************************************************
  22. C
  23. C     Abstract:
  24. C
  25. C     MODIFICATION HISTORY
  26. C
  27. C     BY            DATE     REASON            PROGRAMS AFFECTED
  28. C
  29. C     ****************************************************************
  30. C
  31. C     Author:  Rick Burke           Version: A.0    Date: Sep-86
  32. C
  33. C     Calling Parameters:
  34. C
  35. C     R    XFROM        - Source array
  36. C     R    I            - Initial index in source array
  37. C     W    XTO          - Destination array
  38. C     R    J            - Initial index in destination array
  39. C
  40. C     ****************************************************************
  41. C
  42. C     Messages generated by this module :  None
  43. C
  44. C     ****************************************************************
  45. C
  46. C     Subroutines called directly :  None
  47. C
  48. C     ****************************************************************
  49. C
  50. C     Files referenced :  None
  51. C
  52. C     ****************************************************************
  53. C
  54. C     Local variable definitions :
  55. C
  56. C     K1           - Index into FROM array
  57. C     K2           - Index into TO array
  58. C
  59. C     ****************************************************************
  60. C
  61. C     Commons referenced :  KERPAR
  62. C
  63. C     ****************************************************************
  64. C
  65. C     (*$END.DOCUMENT*)
  66. C
  67. C     ****************************************************************
  68. C     *                                                              *
  69. C     *         D I M E N S I O N   S T A T E M E N T S              *
  70. C     *                                                              *
  71. C     ****************************************************************
  72. C
  73.       IMPLICIT INTEGER (A-Z)
  74. C
  75.       INTEGER*2   XFROM(1),        XTO(1)
  76. C
  77. C     ****************************************************************
  78. C     *                                                              *
  79. C     *         T Y P E   S T A T E M E N T S                        *
  80. C     *                                                              *
  81. C     ****************************************************************
  82. C
  83. C
  84. C     ****************************************************************
  85. C     *                                                              *
  86. C     *         C O M M O N   S T A T E M E N T S                    *
  87. C     *                                                              *
  88. C     ****************************************************************
  89. C
  90.       INCLUDE USL/KERPMC
  91. C
  92. C     ****************************************************************
  93. C     *                                                              *
  94. C     *         E Q U I V A L E N C E   S T A T E M E N T S          *
  95. C     *                                                              *
  96. C     ****************************************************************
  97. C
  98. C
  99. C     ****************************************************************
  100. C     *                                                              *
  101. C     *         D A T A   S T A T E M E N T S                        *
  102. C     *                                                              *
  103. C     ****************************************************************
  104. C
  105. C
  106. C     ****************************************************************
  107. C
  108. C     Code starts here :
  109. C
  110.       K2 = J
  111.       K1 = I
  112. C
  113.    10 CONTINUE
  114.       XTO(K2) = XFROM(K1)
  115.       K2 = K2 + 1
  116.       K1 = K1 + 1
  117.       IF (XFROM(K1-1) .NE. EOS) GO TO 10
  118.       RETURN
  119.       END
  120.