home *** CD-ROM | disk | FTP | other *** search
/ CP/M / CPM_CDROM.iso / simtel / cpmug / cpmug091.ark / WIND.FOR < prev   
Encoding:
Text File  |  1984-04-29  |  4.0 KB  |  168 lines
  1. C***************************************************************
  2. C
  3. C WINDOW FUNCTIONS
  4. C
  5. C Written by Victor De Pinto
  6. C Revised Jan. 22, 1982
  7. C
  8.       SUBROUTINE WIND ( DAT )
  9.       LOGICAL FN1(11), FN2(11)
  10.       DIMENSION DAT(2,1024)
  11. 1     WRITE (1,4)
  12. 4     FORMAT (' -- WINDOW MENU --'/
  13.      X  ' This routine performs a window function on the'/
  14.      X  ' source file and puts the result in the destination'/
  15.      X  ' file. Select the desired window.'/
  16.      X  ' 1  RECTANGLE'/
  17.      X  ' 2  EXTENDED COSINE BELL'/
  18.      X  ' 3  HALF CYCLE SINE'/
  19.      X  ' 4  TRIANGLE (Bartlett)'/
  20.      X  ' 5  COSINE (Hanning)'/
  21.      X  ' 6  HALF CYCLE SINE CUBED'/
  22.      X  ' 7  HAMMING'/
  23.      X  ' 8  COSINE SQUARED'/
  24.      X  ' 9  PARZEN'/
  25.      X  ' 10 BACK TO MAIN MENU >> ')
  26.       READ (1,5) ISEL
  27. 5     FORMAT (I2)
  28.       GO TO (7,7,7,7,7,7,7,7,7,6), ISEL
  29.       GO TO 1
  30. 6     RETURN
  31. 7     WRITE (1,10)
  32. 10    FORMAT (' Source filename,')
  33.       CALL NAME ( FN1 )
  34.       WRITE (1,12)
  35. 12    FORMAT (' Destination filename,')
  36.       CALL NAME ( FN2 )
  37.       WRITE (1,20)
  38. 20    FORMAT (' Enter first data point of window (0-1023): ')
  39.       READ (1,22) IFIRST
  40. 22    FORMAT (I4)
  41.       WRITE (1,25)
  42. 25    FORMAT ('+Enter last data point of window (0-1023): ')
  43.       READ (1,22) LAST
  44. C Compute the width of the window
  45.       WIDTH = LAST - IFIRST
  46. C Read the source file
  47.       CALL OPEN (3, FN1, 0)
  48.       READ (3) DAT
  49.       ENDFILE 3
  50. C
  51. C Do the window operation.
  52. C All points outside the range of the window are zeroed.
  53. C
  54.       DO 200 J=0,1023
  55. C If point is outside the range, the amplitude is zero.
  56.       IF (J .LT. IFIRST .OR. J .GT. LAST) GO TO 120
  57. C The point is in range, so compute the amplitude.
  58. C TIME varies from 0.0 to 1.0
  59.       TIME = (J - IFIRST) / WIDTH
  60.       GO TO (101,102,103,104,105,106,107,108,109), ISEL
  61. 101   CALL RECTAN (AMP, TIME)
  62.       GO TO 130
  63. 102   CALL COSBEL (AMP, TIME)
  64.       GO TO 130
  65. 103   CALL HAFSIN (AMP, TIME)
  66.       GO TO 130
  67. 104   CALL TRIANG (AMP, TIME)
  68.       GO TO 130
  69. 105   CALL HANNIN (AMP, TIME)
  70.       GO TO 130
  71. 106   CALL HFSIN3 (AMP, TIME)
  72.       GO TO 130
  73. 107   CALL HAMMIN (AMP, TIME)
  74.       GO TO 130
  75. 108   CALL COSSQR (AMP, TIME)
  76.       GO TO 130
  77. 109   CALL PARZEN (AMP, TIME)
  78.       GO TO 130
  79. 120   AMP = 0.0
  80. 130   DAT (1,J+1) = DAT(1,J+1) * AMP
  81. 200   DAT (2,J+1) = DAT(2,J+1) * AMP
  82. C
  83. C Windowing is complete. Write to output file.
  84. C
  85.       CALL OPEN (4, FN2, 0)
  86.       WRITE (4) DAT
  87.       ENDFILE 4
  88.       GO TO 1
  89.       END
  90. C
  91. C RECTANGULAR WINDOW
  92. C
  93.       SUBROUTINE RECTAN (AMP, TIME)
  94.       AMP = 1.0
  95.       RETURN
  96.       END
  97. C
  98. C EXTENDED COSINE BELL WINDOW
  99. C
  100.       SUBROUTINE COSBEL (AMP, TIME)
  101.       DATA TENPI / 31.41592654 /
  102.       IF (TIME .LE. 0.1 .OR. TIME .GE. 0.9) GOTO 10
  103.       AMP = 1.0
  104.       RETURN
  105. 10    AMP = 0.5 * (1.0 - COS(TENPI*TIME) )
  106.       RETURN
  107.       END
  108. C
  109. C HALF CYCLE SINE WINDOW
  110. C
  111.       SUBROUTINE HAFSIN (AMP, TIME)
  112.       DATA PI / 3.141592654 /
  113.       AMP = SIN (PI * TIME)
  114.       RETURN
  115.       END
  116. C
  117. C TRIANGLE WINDOW
  118. C
  119.       SUBROUTINE TRIANG (AMP, TIME)
  120.       IF (TIME .LE. 0.5) AMP = 2.0 * TIME
  121.       IF (TIME .GT. 0.5) AMP = 2.0 - 2.0 * TIME
  122.       RETURN
  123.       END
  124. C
  125. C COSINE (HANNING) WINDOW
  126. C
  127.       SUBROUTINE HANNIN (AMP, TIME)
  128.       DATA TWOPI / 6.283185307 /
  129.       AMP = 0.5 * (1.0-COS(TWOPI*TIME))
  130.       RETURN
  131.       END
  132. C
  133. C HALF CYCLE SINE CUBED WINDOW
  134. C
  135.       SUBROUTINE HFSIN3 (AMP, TIME)
  136.       CALL HAFSIN (AMP, TIME)
  137.       AMP = AMP**3
  138.       RETURN
  139.       END
  140. C
  141. C HAMMING WINDOW
  142. C
  143.       SUBROUTINE HAMMIN (AMP, TIME)
  144.       CALL HANNIN (AMP, TIME)
  145.       AMP = 0.08 + 0.92 * AMP
  146.       RETURN
  147.       END
  148. C
  149. C COSINE SQUARED WINDOW
  150. C
  151.       SUBROUTINE COSSQR (AMP, TIME)
  152.       CALL HANNIN (AMP, TIME)
  153.       AMP = AMP**2
  154.       RETURN
  155.       END
  156. C
  157. C PARZEN WINDOW
  158. C
  159.       SUBROUTINE PARZEN (AMP, TIME)
  160.       A = 2.0 * TIME - 1.0
  161.       IF (TIME .GT. 0.25 .AND. TIME .LT. 0.75) GO TO 7
  162.       AMP = 2.0 * (1.0- ABS(A))**3
  163.       RETURN
  164. 7     AMP = 1.0 - 6.0 * A**2 + 6.0 * ABS(A)**3
  165.       RETURN
  166.       END
  167. C
  168.