home *** CD-ROM | disk | FTP | other *** search
/ ftp.barnyard.co.uk / 2015.02.ftp.barnyard.co.uk.tar / ftp.barnyard.co.uk / cpm / walnut-creek-CDROM / SIMTEL / CPMUG / CPMUG091.ARK / UTIL.FOR < prev    next >
Text File  |  1984-04-29  |  5KB  |  188 lines
  1. C*********************************************************************
  2. C
  3. C 1024 point signal processing utility program.
  4. C
  5. C Written by Victor De Pinto, 1979, 1980, 1981, 1982.
  6. C Revised Jan. 27, 1982
  7. C
  8.       PROGRAM UTIL
  9.       LOGICAL FN1(11), FN2(11), FLG
  10.       DIMENSION DAT(2,1024)
  11.       DATA FLG / .FALSE. /
  12.       WRITE (1,2)
  13. 2     FORMAT (' Signal Processing Utility.  By Victor De Pinto.
  14.      X  Jan. 27, 1982'//)
  15. 1     WRITE (1,100)
  16. 100   FORMAT (' --MAIN MENU--  Select function:'/
  17.      X ' 1  WRITE FILE TO CRT'/
  18.      X ' 2  CREATE REAL PULSE FILE'/
  19.      X ' 3  WINDOW FUNCTIONS (MENU)'/
  20.      X ' 4  ARITHMETIC FUNCTIONS (MENU)'/
  21.      X ' 5  PRINT FILE ON PRINTER'/
  22.      X ' 6  RMS VALUE OF REAL PARTS OF FILE'/
  23.      X ' 7  MODIFY FILE'/
  24.      X ' 8  TRANSLATE'/
  25.      X ' 9  PLOT FUNCTIONS (MENU)'/
  26.      X ' 10 RETURN TO OPERATING SYSTEM >> ' )
  27.       READ (1,111) J
  28. 111   FORMAT (I2)
  29.       GO TO (200,300,650,700,205,800,850,450,250,9999),J
  30.       GO TO 1
  31. C
  32. C WRITE FILE TO CONSOLE
  33. C
  34. 200   L = 1
  35.       GO TO 209
  36. C
  37. C WRITE FILE TO LIST DEVICE
  38. C
  39. 205   L = 2
  40. C
  41. 209   WRITE (1,210)
  42. 210   FORMAT (' Data is printed point by point: Real and imaginary.'/
  43.      x        ' To abort printout, type "Q" on console.'/
  44.      x        ' ENTER INDEX OF FIRST POINT TO BE PRINTED: ')
  45.       READ (1,211) IFIRST
  46. 211   FORMAT (I4)
  47.       CALL READ ( DAT )
  48.       DO 220 J=IFIRST,1023,3
  49.       IF ( FLG ) GO TO 220
  50.       IF (J .EQ. 1022) GO TO 212
  51.       IF (J .EQ. 1023) GO TO 213
  52.       WRITE (L,221) J, DAT(1,J+1), DAT(2,J+1), DAT(1,J+2), DAT(2,J+2),
  53.      x DAT(1,J+3), DAT(2,J+3)
  54.       GO TO 215
  55. 212   WRITE (L,221) J, DAT(1,J+1), DAT(2,J+1), DAT(1,J+2), DAT(2,J+2)
  56.       GO TO 215
  57. 213   WRITE (L,221) J, DAT(1,J+1), DAT(2,J+1)
  58. 215   CALL QCHEK ( FLG )
  59. 220   CONTINUE
  60.       FLG = .FALSE.
  61. 221   FORMAT (' ', I4, ': ', 6G12.4)
  62.       IF (L .EQ. 2) GO TO 225
  63.       WRITE (1,222)
  64. 222   FORMAT (' HIT RETURN FOR MENU')
  65.       READ (1,111) J
  66.       GO TO 1
  67. 225   WRITE (L,226)
  68. 226   FORMAT (' ')
  69.       WRITE (1,226)
  70.       GO TO 1
  71. C
  72. C CREATE A PULSE FILE
  73. C
  74. 300   WRITE (1,10)
  75. 10    FORMAT (' This routine creates a file containing a real
  76.      X pulse function.'/
  77.      X        ' Index values range from 0 through 1023.')
  78.       WRITE (1,7)
  79. 7     FORMAT (' ENTER FIRST INDEX OF PULSE: ')
  80.       READ (1,8) ISTART
  81. 8     FORMAT (I4)
  82.       WRITE (1,9)
  83. 9     FORMAT ('+ENTER LAST INDEX OF PULSE: ')
  84.       READ (1,8) IEND
  85.       WRITE (1,13)
  86. 13    FORMAT ('+ENTER AMPLITUDE: ')
  87.       READ (1,6) SCALE
  88. 6     FORMAT (F10.0)
  89.       DO 14 J=1,ISTART
  90.       DAT(1,J) = 0.0
  91. 14    DAT(2,J) = 0.0
  92.       DO 15 J=IEND,1024
  93.       DAT(1,J) = 0.0
  94. 15    DAT(2,J) = 0.0
  95.       DO 11 J=ISTART,IEND
  96.       DAT(2,J+1) = 0.0
  97. 11    DAT(1,J+1) = SCALE
  98.       WRITE (1,852)
  99.       CALL NAME ( FN1 )
  100.       CALL OPEN (3, FN1, 0)
  101.       WRITE (3) DAT
  102.       ENDFILE 3
  103.       GO TO 1
  104. C
  105. C WINDOW
  106. C
  107. 650   CALL WIND ( DAT )
  108.       GO TO 1
  109. C
  110. C ARITHMETIC OPERATIONS TO FILES
  111. C
  112. 700   CALL FCHAIN ( 'ARIT    COM', 0 )
  113.       GO TO 1
  114. C
  115. C PLOTTING FUNCTIONS
  116. C
  117. 250   CALL PLOT ( DAT )
  118.       GO TO 1
  119. C
  120. C COMPUTE THE RMS LEVEL OF REAL PART OF A FILE
  121. C
  122. 800   WRITE (1,801)
  123. 801   FORMAT (' THIS ROUTINE COMPUTES THE R.M.S. LEVEL
  124.      X OF THE REAL PARTS OF A FILE.')
  125.       CALL READ ( DAT )
  126.       SUM=0.0
  127.       DO 810 J=1,1024
  128. 810   SUM=SUM+DAT(1,J)**2
  129.       RMS=SQRT( SUM/1024.0)
  130.       WRITE (1,815) RMS
  131. 815   FORMAT (//' ** THE RMS LEVEL IS ', G14.7,' **'/)
  132.       GO TO 1
  133. C
  134. C MODIFY CONTENTS OF A FILE
  135. C
  136. 850   WRITE (1,851)
  137. 851   FORMAT (' Source filename,')
  138.       CALL NAME ( FN1 )
  139.       WRITE (1,852)
  140. 852   FORMAT (' Destination filename,')
  141.       CALL NAME ( FN2 )
  142.       CALL OPEN (3, FN1, 0)
  143.       READ (3) DAT
  144.       ENDFILE 3
  145. 854   WRITE (1,855)
  146. 855   FORMAT (' What point? (Back to menu if negative) ')
  147.       READ (1,860) J
  148. 860   FORMAT (I4)
  149.       IF (J.LT.0) GO TO 870
  150.       WRITE (1,862) DAT(1,J+1), DAT(2,J+1)
  151. 862   FORMAT (' Present value is', 2G15.7)
  152.       WRITE (1,865)
  153. 865   FORMAT (' ENTER REAL PART <CR> IMAGINARY PART:'/)
  154.       READ (1,6) DAT(1,J+1), DAT(2,J+1)
  155.       GO TO 854
  156. 870   CALL OPEN (3, FN2, 0)
  157.       WRITE (3) DAT
  158.       ENDFILE 3
  159.       GO TO 1
  160. C
  161. C TRANSLATE
  162. C
  163. 450   WRITE (1,455)
  164. 455   FORMAT (' Each data point is shifted circularly by N points.
  165.      X Enter N:'/)
  166.       READ (1,211) NX
  167.       WRITE (1,851)
  168.       CALL NAME ( FN1 )
  169.       WRITE (1,852)
  170.       CALL NAME ( FN2 )
  171.       CALL OPEN (3, FN1, 0)
  172.       READ (3) DAT
  173.       ENDFILE 3
  174.       DO 470 J=1,NX
  175.       T1 = DAT(1,1024)
  176.       T2 = DAT(2,1024)
  177.       DO 465 K=1,1023
  178.       INDEX = 1024 - K
  179.       DAT(1,INDEX+1) = DAT(1,INDEX)
  180. 465   DAT(2,INDEX+1) = DAT(2,INDEX)
  181.       DAT(1,1) = T1
  182. 470   DAT(2,1) = T2
  183.       CALL OPEN (3, FN2, 0)
  184.       WRITE (3) DAT
  185.       ENDFILE 3
  186.       GO TO 1
  187. 9999  E  N  D
  188.