home *** CD-ROM | disk | FTP | other *** search
/ CP/M / CPM_CDROM.iso / simtel / sigm / vols000 / vol013 / util.for < prev    next >
Encoding:
Text File  |  1984-04-29  |  1.2 KB  |  43 lines
  1.     SUBROUTINE UTIL(IOPTN,ITEST,IDATA,LBLNK,
  2.      +                  ISTRT,ISTOP,LMOVE,IMOVE,IGOTO)
  3.     DIMENSION    LBLNK(32)
  4.     DIMENSION    LMOVE(32)
  5. C
  6. C    1) ITEST AND I/P
  7. C    2) INSERT DATA
  8. C    3) MOVE DATA FROM ARRAYS
  9. C    4) LOOK FOR MATCH DATA STATEMENTS
  10. C    5) LOOK AND BLANK
  11. C    6) CONVERT I5 TO 5I5 ARRAY
  12. C    7) LOOK FOR GREATER
  13. C    8) ARRAY ADD
  14. C    9) SWAP ARRAYS
  15. C    10) REVERSE ARRAYS
  16. C
  17.     ITYPE = IOPTN
  18.     ISAVE = IMOVE
  19.     NDATA = IDATA
  20.     IDIVD = 10 ** (ISTOP-ISTRT)
  21.     DO 900    IGOTO = ISTRT,ISTOP
  22.     IF (LBLNK(IGOTO) -ITEST) 100,200,300
  23. 100    GOTO (999,800,400,900,900,700,900,500,400,400), ITYPE
  24. C           1   2   3   4   5   6   7   8   9   10
  25. 200    GOTO (800,800,400,999,800,700,900,500,400,400), ITYPE
  26. C           1   2   3   4   5   6   7   8   9   10
  27. 300    GOTO (999,800,400,900,900,700,999,500,400,400), ITYPE
  28. C           1   2   3   4   5   6   7   8   9   10
  29. 400    NDATA = LMOVE(ISAVE)
  30.     IF (ITYPE - 9) 410,405,405
  31. 405    LMOVE(ISAVE) = LBLNK(IGOTO)
  32. 410    ISAVE = ISAVE + 1 - (2 * (ITYPE/10))
  33.     GOTO 800
  34. 500    NDATA = LBLNK(IGOTO) + LMOVE(ISAVE)
  35.     GOTO 410
  36. 700    NDATA = ISAVE/IDIVD
  37.     ISAVE = ISAVE - ISAVE/IDIVD * IDIVD
  38.     IDIVD = IDIVD/10
  39. 800    LBLNK(IGOTO) = NDATA
  40. 900    CONTINUE
  41. 999    RETURN
  42.     END
  43.