Kompletní program pro elektroakustickou počítačovou skladbu ARCANUM
 
 
C ***********************************************************
C *       PROGRAM FOR ELECTRONIC COMPUTER COMPOSITION       *
C *                                                         *
C *                    A  R  C  A  N  U  M                  *
C *                                                         *
C *                    Computer: PDP 11/34                  *
C *       Programming language: FORTRAN IV - VO2.2-5        *
C ***********************************************************

      REAL ZAKL (2, 10), TISK (10, 20)
      BYTE IFFA (20), IZA (20)
      DATA IFFA / 1,1,1,1,2,2,3,3,4,4,5,5,6,6,7,7,8,8,9,9 /
      DATA IZA  / 1,2,2,2,1,2,1,2,1,2,1,2,1,2,1,2,1,2,1,2 /

100   FORMAT (2I5)
110   FORMAT ('$pocet skupin bloku = ')
120   FORMAT ('01 ', 4F7.1, '     2<', 2F7.1, '     2>',
     . 2F7.1, '     3<', 2F7.1, '     3>', 2F7.1)
121   FORMAT (3X, 4F7.1, 4 (7X, 2F7.1))
130   FORMAT ('0', 35X, '4<', 2F7.1, '     4>', 2F7.1,
     . '     5<', 2F7.1, '     5>', 2F7.1)
131   FORMAT (38X, 2F7.1, 3 (7X, 2F7.1))
140   FORMAT ('$random parametry IR1,IR2 = ')

      TYPE 110
      ACCEPT 100, N
      TYPE 140
      ACCEPT 100, IR1, IR2

      DO 700 INDEX = 1, N
      SEK = ALOG10 (2.) / 12.
      OKT3 = ALOG10 (8.) / 2.

200   A = RAN (IR1, IR2)
      B = RAN (IR1, IR2)

      IF (B - A .LT. SEK .OR. B - A .GT. OKT3) GOTO 200

      DO 300 I = 1, 10
300   ZAKL (1, I) = (I - 1.) / 9.
      ZAKL (2, 1) = 0.
      ZAKL (2, 10) = 1.
      AA = 50. * (100. ** A)
      BB = 50. * (100. ** B) / AA

      DO 600 K = 1, 20
      IFF = IFFA (K)
      IZ = IZA (K)
      IF (IZ .EQ. 1) GOTO 490
      ZAKL (2, 2) = RAN (IR1, IR2)
      DO 440 I = 3, 9
      ZAKL (2, I) = RAN (IR1, IR2)
      DO 430 J = I - 1, 2, -1
      IF (ZAKL (2, J + 1) .GE. ZAKL (2, J)) GOTO 440
      POM = ZAKL (2, J)
      ZAKL (2, J) = ZAKL (2, J + 1)
      ZAKL (2, J + 1) = POM
430   CONTINUE
440   CONTINUE

490   DO 500 I = 1, 10
      TISK (I, K) = (BB ** FCE (IFF, ZAKL (IZ, I))) * AA
500   CONTINUE
600   CONTINUE

      WRITE (1, 120) (TISK (1, I), I = 1, 12)
      DO 610 J = 2, 10
610   WRITE (1, 121) (TISK (J, I), I = 1, 12)
      WRITE (1, 130) (TISK (1, I), I = 13, 20)
      DO 620 J = 2, 10
620   WRITE (1, 131) (TISK (J, I), I = 13, 20)
      WRITE (1, 100)
      WRITE (1, 100)
700   CONTINUE

      STOP
      END

      REAL FUNCTION FCE (I, X)
100   FORMAT (' NEDEF.FCE')
      Z = 9. * X
      GOTO (201, 202, 203, 204, 205, 206, 207, 208, 209) I
      Y = -1.
      TYPE 100
      GOTO 900

201   Y = X
      GOTO 900
202   Y = X * (Z + 1.) / 10.
      GOTO 900
203   Y = X * (19. - Z) / 10.
      GOTO 900
204   Y = X * (Z * Z + 5.) / 86.
      GOTO 900
205   Y = X * ((Z - 27.) * Z + 248.) / 86.
      GOTO 900
206   Y = X * (14. + Z * (11. + Z * (Z - 2.))) / 680.
      GOTO 900
207   Y = X * (2642. + Z * (-443. + Z * (34. - Z))) / 680.
      GOTO 900
208   Y = (2. ** Z - 1.) / 511.
      GOTO 900
209   Y = (512. - 2. ** (9 - Z)) / 511.
      GOTO 900
900   FCE = Y
      RETURN
      END
 

zpět