1C MUSIC V, Max Mathews 2C 3C typed in from old XGP output 4C file last written 19Jun75 MUSIC5[M5,GM] (I believe GM = George McKee) 5C SAIL 6C 7C The main typos are 'I' vs 1 -- the printout is so old and faded that 8C I can barely make out which is correct sometimes. And there are space 9C characters that were dropped by the printer. Also I haven't used 10C fortran since the early '80s -- I scarcely remember how this is supposed 11C to look. 12C 13C Mus11 says ifile(n,rnam) is the same as open(n,rnam,0,'RDO',,,'UNF') 14C 15C Bill Schottstaedt, 26-Apr-08 16C 17C [page 1-1] -- these are the original XGP pages to help me find my place 18 19 20C PASS1 PASS 1 MAIN PROGRAM 21C PASS1 *** MUSIC V *** THIS VERSION RUNS ON THE PDP10, JULY 14,1971 22 COMMON P(100),IP(10),D(2000),IPDP 23 DATA IPDP/0/ 24C*****PDP ***** IPDP WAS ADDED TO COMMON LIST IN PLACE OF ENTRY FEATURE. 25 99 FORMAT(' TYPE FILE NAME'/) 26 999 FORMAT(A5) 27 TYPE 99 28 ACCEPT 999,FLNM 29 CALL IFILE(1,FLNM) 30C*****ABOVE 5 LINES FOR PDP10 ******** 31 32C INITIALIZATION 33C NOMINAL SAMPLING RATE. 34 D(4) = 10000.0 35C ERROR FLAG 36 IP(2)=0 37 P(2)=0.0 38C C NWRITE = 2 39 NWRITE=20 40C**** PDP DSK0=DEVICE 20 ****** 41CC REWIND NWRITE 42CC CALL READ0 43 CALL READ1 44C********PDP ******** 45C MAIN LOOP 46 100 CALL READ1 47 I1=P(1) 48 IF (I1.GE.1.AND.I1.LE.12) GO TO 103 49 IP(2)=1 50CC WRITE (6,200) 51 PRINT 200 52C********PDP ******** 53 200 FORMAT(' NON-EXISTENT OPCODE ON DATA STATEMENT') 54 GO TO 100 55 103 GO TO (1,1,1,1,5,6,7,1,9,1,1,12),I1 56 1 CALL WRITE1 (NWRITE) 57 GO TO 100 58 5 PRINT 110 59CC 5 WRITE (6, 110) 60C********PDP ******** 61 110 FORMAT(' END OF SECTION IN PASS 1') 62 GO TO 1 63 6 CALL WRITE1 (NWRITE) 64C C WRITE (6, 111) 65 PRINT 111 66C********PDP ******** 67 111 FORMAT (' END OF PASS 1') 68 IF(IP(2).EQ.1) CALL HARVEY 69 CALL EXIT 70C SET VARIABLES IN PASS 1 71 7 I2=P(3) 72 I3=I2+IP(1)-4 73 DO 104 I4=I2,I3 74 104 D(14)=P(14-I2+4) 75 GO TO 100 76 9 I6=P(3) 77 IF (I6.GE.1.AND.I6.LE.5) GO TO 107 78 IP(2)=1 79CC WRITE (6,201) 80 81C [page 1-2] 82 83 PRINT 201 84C********PDP ******** 85 201 FORMAT(' NON-EXISTENT PLF SUBROUTINE CALLED') 86 GO TO 100 87 12 CALL WRITE1 (NWRITE) 88 GO TO 7 89 107 GO TO (21,22,23,24,25),I6 90 21 CALL PLF1 91 GO TO 100 92 22 CALL PLF2 93 GO TO 100 94 23 CALL PLF3 95 GO TO 100 96 24 CALL PLF4 97 GO TO 100 98 25 CALL PLF5 99 GO TO 100 100 END 101C WRITE1 PASS 1 DATA-WRITING ROUTINE 102C *** MUSIC V *** 103 SUBROUTINE WRITE1(N) 104 COMMON P(100),IP(10) 105 K=IP(1) 106 WRITE(N )K,(P(J),J=1,K) 107 RETURN 108 END 109 SUBROUTINE PLF 110 COMMON P(100),IP(10),D(2000) 111CC ENTRY PLF1 112CC ENTRY PLF2 113CC ENTRY PLF3 114CC ENTRY PLF4 115CC ENTRY PLF5 116 END 117C ERRO1 GENERAL ERROR ROUTINE 118C ***MUSIC V *** 119 SUBROUTINE ERROR(I) 120 PRINT 100,I 121 100 FORMAT(13HERROR OF TYPEI5) 122 RETURN 123 END 124 SUBROUTINE HARVEY 125CC WRITE (6,1) 126 PRINT 1 127C********PDP ********* 128 1 FORMAT(' WHERE IS HARVEY') 129 CALL EXIT 130 END 131 SUBROUTINE MOVR(IBCD,LA,LB) 132 DIMENSION IBCD(300) 133 DO 1 J=LA,LB 134CC 1 IBCD(J)=I5-(IBCD(J))/16777216 135C********PDP ******** 136 1 IBCD(J)=IBCD(J)/536870912-48 137 2 DUMMY=0 138C TO SET BREAKPOINT. 139 RETURN 140 END 141 142 143C [page 2-1] 144 145C READ1 INTERPRETATIVE READING ROUTINE 146C**** MUSIC V **** 147 SUBROUTINE READ1 148 COMMON P(100),IP(10),D(2000),IPDP 149C*****PDP ***** IPDP WAS ADDED TO COMMON LIST IN PLACE OF ENTRY FEATURE 150 DIMENSION CARD(129),ICAR(128),IBCD(300),LOP(3,30) 151 DIMENSION BCD(300) 152 DIMENSION IBC(12),IVT(4) 153 EQUIVALENCE(CARD,ICAR) 154 EQUIVALENCE(BCD,IBCD) 155 DATA NOPS,NBC,NC/26,3,72/ 156 DATA IDEC,ISTAR/'.','*'/ 157CCC DATA IBC(1),IBC(2),IBC(3),IBC(4)/'=',' ',',','-'/ 158 DATA IBC(1),IBC(2),IBC(3),IBC(4)/';',' ',',','-'/ 159C********NO!!!!! THE CHARACTER = HAS BEEN SUBSTITUTED FOR 160C THE SEMICOLON AS THE END OF STATEMENT DELIMITER 161 DATA IVT/'P','F','B','V'/ 162 DATA LOP/'N','O','T','I','N','S','G','E','N','S','V','3', 163 1 'S','E','C','T','E','R','S','V','1','S','V','2','P','L','F', 164 2 'P','L','S','S','I','3','S','I','A','C','O','M','E','N','D', 165 3 'O','U','T','O','S','C','A','D','2','R','A','N','E','N','V', 166 4 'S','T','R','A','D','3','A','D','4','M','L','T','F','L','T', 167 5 'R','A','H','S','E','T',0,0,0,0,0,0,0,0,0,0,0,0/ 168C********LAST 12 LOCATIONS NOT YET USED. **** PDP ******** 169 EQUIVALENCE (JSEMI,IBC(1)), (JBLANK,IBC(2)) 170 171C TO SCAN INPUT DATA TO #, ORGANIZE FIELDS AND PRINT 172 IF(IPDP.EQ.0) GO TO 99 173C********PDP ******** 174 IF (END+SNA8-1.) 10,10,90 175 10 IBK=2 176 END=0 177 ERR=0 178 NUMU=0 179 ISEMI=1 180 L=3 181 J=0 182 11 I=I+1 183 IF(I.GT.NC) GO TO 15 184 IF(J.EQ.299) GO TO 21 185 DO 13 N=1,NBC 186 IF(ICAR(I)-IBC(N)) 13,12,13 187 12 GO TO (20,16,18),N 188C ; BLA , 189 13 CONTINUE 190 J=J+1 191 IBCD(J)=ICAR(I) 192 IBK=1 193 GO TO 11 194 14 IBK=N 195 GO TO 11 196CC 15 READ (5,1,ERR=95,END=95) (CARD(I),I=1,NC) 197C********PDP ******** 198 15 READ (1,1,ERR=95,END=95) I, (CARD(I),I=1,NC) 199C*****PDP ***** FIRST 'I' IS FOR PDP LINE NUMBERS! 200 1 FORMAT(I,128A1) 201CC 1 FORMAT(128A1) 202 PRINT 2,(CARD(I),I=1,NC) 203 2 FORMAT(1H 128A1) 204 I=0 205 206C [page 2-2] 207 208 GO TO 11 209 16 GO TO (17,11,11),IBK 210 17 IBK=N 211 J=J+1 212 IBCD(J)=JBLANK 213 GO TO (11,21),ISEMI 214 18 GO TO (17,14,19),IBK 215 19 J=J+1 216 IBCD(J)=0 217 GO TO 17 218 20 ISEMI=2 219 GO TO (17,21,19),IBK 220 21 J=J+1 221 IBCD(J)=JSEMI 222C TO SCAN FOR OP CODE 223 DO 24 N=1,NOPS 224 M=N 225 DO 23 K=1,3 226 IF (IBCD(K)-LOP(K,N)) 24,23,24 227 23 CONTINUE 228 GO TO 26 229 24 CONTINUE 230 GO TO 40 231 26 NP=1 232 27 L=L+1 233 IF (IBCD(L)-JBLANK) 27,29,27 234 29 GO TO (100,200,300,400,500,600,700,800,900,10000,1100,1200,1300, 235 1217 ,201,202,203,204,205,206,207,208,209,210,211,212),M 236C OP CODE 1 TO PLAY NOTE 237 100 P(1)=1. 238 GO TO 30 239C OP CODE 2 TO DEFINE INSTRUMENT 240 200 P(1)=2. 241 IDEF=1 242 N1=1 243 GO TO 70 244 2000 P(2)=XN 245 N1=2 246 GO TO 70 247 2001 P(3)=XN 248 IP(1)=3 249 GO TO 50 250C OUT BOX 251 201 P(3)=101. 252 NPW=2 253 IF (STER) 220,220,2011 254 2011 SNA8=1. 255 STER=0 256 GO TO 220 257C OSCILLATOR 258 202 P(3)=102. 259 NPW=5 260 GO TO 220 261C ADD 2 262 203 P(3)=103. 263 NPW=3 264 GO TO 220 265C RANDOM AND INTERPOLATE 266 204 P(3)=104. 267 NPW=6 268 269C [page 2-3] 270 271 GO TO 220 272C LINEAR ENVELOPE GENERATOR 273 205 P(3)=105. 274 NPW=7 275 GO TO 220 276C STEREO OUT BOX 277 206 P(3)=106. 278 NPW=3 279 IF(STER)220,2061,220 280 2061 SNA8=1. 281 STER=1. 282 GO TO 220 283C THREE INPUT ADDER 284 207 P(3)=107. 285 NPW=4 286 GO TO 220 287C FOUR INPUT ADDER 288 208 P(3)=108. 289 NPW=5 290 GO TO 220 291C MULTIPLIER 292 209 P(3)=109. 293 NPW=3 294 GO TO 220 295C FILTER 296 210 P(3)=112. 297 NPW=4 298 GO TO 220 299C RANDOM AND HOLD 300 211 P(3)=111. 301 NPW=5 302 GO TO 220 303C SET NEW FUNCTION 304 212 P(3)=110. 305 NPW=1 306 GO TO 220 307C END OF INSTRUMENT 308 217 IP(1)=2 309 IDEF=0 310 END=1. 311 GO TO 50 312C UNNAMED UNIT - NUMERICAL NAME ASSUMED 313 218 N1=8 314 NUMU=1 315 L=0 316 GO TO 70 317 219 M=XN+14. 318 IF(XN.LT.11.)GO TO 29 319 P(3)=XN 320C TO INTERPRET VARS IN UNIT DEFS 321 220 NP=3 322 221 IF(IBCD(L+1)-JSEMI) 222,240,222 323 222 NP=NP+1 324 L=L+1 325 DO 223 N=1,4 326 IF(IBCD(L)-IVT(N))223,225,223 327 223 CONTINUE 328 224 L=L+1 329 IF(IBCD(L).EQ.JBLANK)GO TO 46 330 GO TO 224 331 332C [page 2-4] 333 334 225 GO TO (231,232,233,234),N 335C P TYPE 336 231 N1=3 337 GO TO 70 338 2311 P(NP)=XN 339 GO TO 221 340C F TYPE 341 232 N1=4 342 GO TO 70 343 2321 P(NP)=-(XN+100.) 344 GO TO 221 345C B TYPE 346 233 N1=5 347 GO TO 70 348 2331 P(NP)=-XN 349 GO TO 221 350C V TYPE 351 234 N1=6 352 GO TO 70 353 2341 P(NP)=XN+100. 354 GO TO 221 355 240 IF(NUMU.EQ.1)GO TO 242 356 241 IF(NPW+3-NP)42,242,42 357 242 IP(1)=NP 358 GO TO 50 359C OP CODE 3 - TO GENERATE FUNCTION 360 300 P(1)=3. 361 GO TO 30 362C OP CODE 4 -- TO SET PARAM 3RD PASS 363 400 P(1)=4. 364 GO TO 30 365C OP CODE 5 TO END SEC 366 500 P(1)=5. 367 GO TO 30 368C OP CODE 6 TO TERMINATE PIECE 369 600 P(1)=6. 370 GO TO 30 371C OP CODE 7 TO SET PARAM 1ST PASS 372 700 P(1)=7. 373 GO T0 30 374C OP CODE 8 TO SET PARAM 2ND PASS 375 800 P(1)=8. 376 GO TO 30 377C OP CODE 9 TO EXECUTE SUB 1ST PASS 378 900 P(1)=9. 379 GO TO 30 380C OP CODE 10 TO EXECUTE SUB 2ND PASS 381 1000 P(1)=10. 382 GO TO 30 383C OP CODE 11 TO SET INTEGER 3RD PASS 384 1100 P(1)=11. 385 GO TO 30 386C OP CODE 12 TO SET INTEGER ALL PASSES 387 1200 P(1)=12. 388 GO TO 30 389C OP CODE 13 FOR COMMENTS 390 1300 IF(IBCD(L)-JSEMI)1301,10,1301 391 1301 L=L+1 392 GO TO 1300 393C TO STORE PFIELDS 394 395C [page 2-5] 396 397 30 IF(IDEF)32,32,43 398 32 IF(IBCD(L+1)-JSEMI)33,34,33 399 33 NP=NP+1 400 N1=7 401 GO TO 70 402 331 P(NP)=XN 403 GO TO 32 404 34 IP(1)=NP 405 IF(NP-1)47,47,50 406C ERRORS 407 40 IF(IDEF)41,41,218 408 41 L=L+1 409 IF(IBCD(L).NE.JSEMI)GO TO 41 410 PRINT 3 411 3 FORMAT(26H OP CODE NOT UNDERSTOOD) 412 GO TO 49 413 42 PRINT 4 414 4 FORMAT(44H UNIT CONTAINS WRONG NUMBER OF PARAMETERS) 415 GO TO 49 416 43 PRINT 5 417 5 FORMAT(36H INSTRUMENT DEFINITION INCOMPLETE) 418 ERR=1. 419 IDEF=0 420 GO TO 32 421 44 PRINT 6 422 6 FORMAT(25H ERROR IN NUMERIC DATA) 423 ERR=1. 424 IF(NUMU.EQ.1)GO TO 45 425 GO TO 30 426 45 PRINT 7 427 7 FORMAT(46H+ FOR UNIT DESIGNATION) 428 P(3)=0. 429 GO TO 220 430 46 PRINT 8 431 8 FORMAT(40H IMPROPER VARIABLE IN UNIT DEFINITION) 432 ERR=1. 433 GO TO 221 434 47 PRINT 9 435 9 FORMAT(24H STATEMENT INCOMPLETE) 436 49 IP(2)=1 437 GO TO 10 438 50 IF(ERR.EQ.1.) GO TO 49 439 RETURN 440C CONVERSION OF NUMERIC FIELD TO FLOATING POINT 441 70 SGN=1. 442 IF (IBCD(L+1).NE.IBC(4)) GO TO 79 443 SGN=-1. 444 L=L+1 445 79 L1=L+1 446 LD=L1 447 XN=0. 448 71 L=L+1 449C *** I DON'T UNDERSTAND THIS PART OF THE SCANNER! 450CC IF(IBCD(L).EQ.JBLANK) GO TO 77 451 IF (IBCD(L)-JBLANK)72,77,72 452C THIS LOOKS FOR #S, LETTERS, BLANKS, DECI.PTS, & *S. OTHERWISE=ERROR!? 453C ******** PDP ******** 454 72 IF(IBCD(L).LT.10)GO TO 71 455 IF(IBCD(L)-IDEC)74,71,74 456 74 IF(IBCD(L)-ISTAR)76,71,76 457 458C [page 2-6] 459 460 76 GO TO 71 461C ERROR CHECK IS REMOVED! 462C** NEXT 2 LINES BY-PASSED*** 76 L=L+1 463 IF(IBCD(L).EQ.JBLANK) GO TO 44 464 GO TO 76 465 77 IF(IBCD(L1)-ISTAR)80,78,80 466 78 XN=P(NP) 467 GO TO 89 468 80 DO 81 LL=L1,L 469 LD=LL 470 IF (IBCD(LL)-IDEC)81,82,81 471 81 CONTINUE 472 82 IEX=0 473 LA=L1 474 LB=LD-1 475 IF(LD-L1)86,86,83 476 83 IEX=LD-LA 477 84 CALL MOVR (IBCD,LA,LB) 478 DO 85 LL=LA,LB 479 IEX=IEX-1 480 X1=IBCD(LL) 481 85 XN=XN+XI*10.**IEX 482 86 IF(L-LB-2)88,88,87 483 87 LA=LD+1 484 LB=L-1 485 GO TO 84 486 88 XN=XN*SGN 487 89 GO TO (2000,2001,2311,2321,2331,2341,331,219),N1 488C TO WRITE S1A8 FOR MONO STEREO CONTROL 489 90 P(1)=12. 490 P(3)=8. 491 P(4)=STER 492 IP(1)=4 493 END=0. 494 SNA8=0. 495 GO TO 50 496C FOR PREMATURE END OF FILE ON INPUT 497 95 NP=2 498 IP(2)=1 499 L=0 500 IBCD(1)=JSEMI 501 GO TO 600 502C TO INITIALIZE 503CC ENTRY READ0 504CC READ (5,1,ERR=95,END=95) (CARD(I),I=1,NC) 505C********PDP ******** 506 99 READ (1,1,ERR=95,END=95) I,(CARD(I),I=1,NC) 507C*****PDP ***** FIRST 'I' IS FOR PDP LINE NUMBERS! 508CC WRITE (6,2) (CARD(I),I=1,NC) 509 PRINT 2,(CARD(I),I=1,NC) 510C********PDP ******** 511 IPDP=1 512 I=0 513 IDEF=0 514 IBK=2 515 STER=0. 516 END=0. 517 SNA8=0. 518 RETURN 519 END 520 521C [page 3-1] 522 523C PASS 2 MAIN PROGRAM 524C *** MUSIC V *** 525 DIMENSION G(1000),I(1000),T(1000),D(10000),P(100),IP(10) 526 COMMON IP,P,G,I,T,D,IXJQ,TLAST,BLAST 527C INITIALIZING PROGRAM 528C NOMINAL SAMPLING RATE, NOTE PARAMETER LENGTH, NUMBER OF CARDS 529C NO OF OP CODES, PASS 11 REPORT PRINT PARAMETER 530 G(1)=0. 531 G(2)=0. 532 G(4)=10000.0 533 NPAR=10000 534 NCAR=1000 535 NOPC=12 536 IXJQ=0 537 IEND=0 538C C***** NREAD=2 539C C***** NWRITE=3 540 NREAD=20 541 NWRITE=21 542 REWIND NREAD 543 REWIND NWRITE 544C INITIALIZE SECTION 545 150 ID=1 546 IN=1 547 TLAST=0. 548 BLAST=0. 549C READ SECTION OF DATA 550 106 CALL READ2 (NREAD) 551 I1=IP(1) 552 D(ID)=I1 553 I(IN)=ID 554 T(IN)=P(2) 555 DO 100 I2=1,I1 556 I3=ID+I2 557 100 D(I3)=P(I2) 558 ID=ID+I1+1 559 IF(ID-NPAR)102,102,101 560 101 CALL ERROR(20) 561 STOP 562 102 IN=IN+1 563 IF (IN-NCAR)103,103,101 564 103 IF (P(1)-5.0)104,110,104 565 104 IF (P(1)-6.0)106,105,106 566 105 IEND=1 567 GO TO 110 568C SORT SECTION 569C*** NOT USED ****** 110 CALL SORTFL 570 110 IN=IN-1 571 CALL SORT(T(1),T(2),IN,I) 572C EXECUTE OP CODES M SECTION 573 120 DO 1 I4=1,IN 574 I5=I(I4) 575 I6=D(I5+1) 576 IF(I6)121,121,122 577 121 CALL ERROR(21) 578 GO TO 1 579 122 IF (I6-NOPC)123,123,121 580 123 GO TO (2,2,2,2,2,2,7,8,7,10,2,8),I6 581 7 CALL ERROR(22) 582 GO TO 1 583 584C [page 3-2] 585 586 8 I7=D(I5) 587 I8=I5+4 588 I9=I5+I7 589 I10=IFIX(D(15+3))-I8 590 DO 124 I11=I8,I9 591 I12=I10+I11 592 124 G(I12)=D(I11) 593 IF(I6-I2)1,2,1 594 10 I13=D(I5+3) 595 IP(2)=I5 596 IF(I13)125,125,126 597 125 CALL ERROR(23) 598 GO TO 1 599 126 IF(I13-5)127,127,125 600 127 GO TO (21,22,23,24,25),I13 601 21 CALL PLS1 602 GO TO 1 603 22 CALL PLS2 604 GO TO 1 605 23 CALL PLS3 606 GO TO 1 607 24 CALL PLS4 608 GO TO 1 609 25 CALL PLS5 610 GO TO 1 611C WRITE OUT SECTION 612 2 IP(1)=D(I5) 613 I18=IP(1) 614 DO 133 I19=1,I18 615 I20=I19+I5 616 133 P(I19)=D(I20) 617 CALL WRITE2 (NWRITE) 618 1 CONTINUE 619C END OF SECTION OR PASS 620 140 IF(IEND)141,141,143 621 141 PRINT 142 622 142 FORMAT (' END OF SECTION PASS II') 623 GO TO 150 624 143 PRINT 144 625 144 FORMAT (' END OF PASS II') 626 STOP 627 END 628C READ2 PASS 2 DATA INPUT ROUTINE 629C *** MUSIC V *** 630 SUBROUTINE READ2(N) 631 DIMENSION IP(10),P(100) 632 COMMON IP,P 633 READ(N)K,(P(J),J=1,K) 634 IP(1)=K 635 RETURN 636 END 637C SORT SORTING PROGRAM 638C *** MUSIC V *** 639 SUBROUTINE SORT(A,B,N,L) 640 DIMENSION A(N),L(N) 641C 642C SORT SORTS THE A ARRAY INTO ASCENDING NUMERICAL ORDER, PERFORMING 643C THE SAME OPERATIONS ON ARRAY L AS ON A 644C 645 N1=N-1 646 647C [page 3-3] 648 649 DO 10 I=1,N1 650 IN=I+1 651 DO 20 J=IN,N 652 IF(A(I).LE.A(J))GO TO 20 653 T=A(I) 654 A(I)=A(J) 655 A(J)=T 656 NT=L(I) 657 L(I)=L(J) 658 L(J)=NT 659 20 CONTINUE 660 10 CONTINUE 661 RETURN 662C C*********** ENTRY SORTFL 663C C*********** RETURN 664 END 665C WRIT2 DATA OUTPUTING ROUTINE FOR PASS 2 666C *** MUSIC V *** 667 SUBROUTINE WRITE2(N) 668 COMMON IP(10),P(100),G(1000),I(1000),T(1000),D(10000),IXJQ,TLAST,BLAST 669 IF(G(2).EQ.0.)GO TO 150 670 X=P(2) 671 Y=P(4) 672 ILOC=G(2) 673 IF(P(1).NE.1.)GO TO 50 674 P(4)=P(4)*60./CON(G,ILOC,P(2)) 675 50 P(2)=TLAST+(P(2)-BLAST)*60./CON(G,ILOC,P(2)) 676 TLAST=P(2) 677 BLAST=X 678 150 CALL CONVT 679 K=IP(1) 680 WRITE(N)K,(P(J),J=1,K) 681C *** PASS II REPORT IS OPTIONAL *** 682 IF(G(1).NE.0.) RETURN 683 IF(IXJQ.EQ.0) PRINT 100 684 IXJQ=10 685 100 FORMAT(15H1PASS II REPORT/11H0(WORD CNT)) 686 PRINT 101,K,(P(J),J=1,K) 687 IF(G(2).NE.0.) PRINT 102,X,Y 688 101 FORMAT(I8,10(F9.3)) 689 102 FORMAT(1H+,110X,2HB=,F7.4,2HD=,F7.4) 690 RETURN 691 END 692C CON2 PASS 2 FUNCTION INTERPOLATOR 693C *** MUSIC V *** 694 FUNCTION CON(G,I,T) 695 DIMENSION G(1) 696 DO 10 J=1,1000,2 697 IF (G(J)-T) 10,20,30 698 30 CON = G(J-1)+((T-G(J-2))/(G(J)-G(J-2)))*(G(J+1)-G(J-1)) 699 RETURN 700 10 CONTINUE 701 20 CON = G(J+1) 702 RETURN 703 END 704C CONVT FOR UNIT GENERATORS CHECK 705C 706C DUMMY NO OPERATION ACTUALLY PERFORMED 707C******WHEN DUMMY IS REMOVED ANOTHER CONVT MUST!!!! BE LOADED!!!***** 708 709C [page 3-4] 710 711C*** SUBROUTINE CONVT 712C*** COMMON IP(10),P(100),G(1000) 713C*** RETURN 714C*** END 715C ERRO1 GENERAL ERROR ROUTINE 716C *** MUSIC V *** 717 SUBROUTINE ERROR(I) 718 PRINT 100,I 719 100 FORMAT(' ERROR OF TYPE',I5) 720 RETURN 721 END 722C C***** SUBROUTINE PLS 723C C***** ENTRY PLS1 724C C***** ENTRY PLS2 725C C***** ENTRY PLS3 726C C***** ENTRY PLS4 727C C***** ENTRY PLS5 728 SUBROUTINE PLS1 729 RETURN 730 END 731 SUBROUTINE PLS2 732 RETURN 733 END 734 SUBROUTINE PLS3 735 RETURN 736 END 737 SUBROUTINE PLS4 738 RETURN 739 END 740 SUBROUTINE PLS5 741 RETURN 742 END 743 744C [page 4-1] 745 746C PASS3 PASS 3 MAIN PROGRAM 747C *** MUSIC V *** 748C DATA SPECIFICATION 749 INTEGER PEAK 750 DIMENSION T(50),TI(50),ITI(50) 751 COMMON I(15000),P(100)/PARM/IP(20)/FINOUT/PEAK,NRSOR 752C C******** DATA IIIRD/Z5EECE66D/ 753 DATA IIIRD/976545367/ 754C SET I ARRAY =0 (7/10/69) 755 DATA I/15000*0/ 756C***************** 757C INITIALIZATION OF PIECE 758C ARBITRARY STARTING NUMBER FOR SUBROUTINE RANDU 759 I(7)=IIIRD 760 IP9=IP(9) 761 PEAK=0 762 NRSOR=0 763C********NREAD=3 764C********NWRITE=2 765 NREAD=21 766C PDP DSK1=DEV.21 767 NWRITE=1 768C PDP DSK=DEV.1 769 REWIND NREAD 770 REWIND NWRITE 771 TYPE 10001 772 ACCEPT 10002,FLNM,IDSK 773C TYPE 'PASS2' OR FILENAME + ANY POS.NUMB. TO WRITE SMPLS ON DSK. 774 IF(FLNM.EQ.' '.OR.FLNM.EQ.'PASS2')FLNM='FOR21' 775 CALL IFILE(21,FLNM) 776 IF(IDSK.LE.0) GO TO 10003 777 J='MUSAA' 778 CALL PUTFILE(J) 779C IF IDSK>=1, SAMPLES WILL BE WRITTEN ON DSK (MUSAA.DMD) 780 IDSK=0 781 GO TO 10002 78210003 IDSK=-1 78310001 FORMAT(' TYPE FILE NAME'/) 78410002 FORMAT(A5,I) 785C**** ABOVE FOR PDP 10 ****** 786 SCLFT=IP(12) 787 I(2)=IP(4) 788 MS1=IP(7) 789 MS3=MS1+(IP(8)*IP(9))-1 790 MS2=IP(8) 791 I(4)=IP(3) 792 MOUT=IP(10) 793C INITIALIZATION OF SECTION 794 5 T(1)=0.0 795 DO 220 N1=MS1,MS3,MS2 796 220 I(N1)=-1 797 DO 221 N1=1,IP9 798 221 TI(N1)=1000000. 799C MAIN CARD READING LOOP 800 204 CALL DATA (NREAD) 801 IF(P(2)-T(1))200,200,244 802 200 IOP=P(1) 803 IF(IOP)201,201,202 804 201 CALL ERROR(1) 805 GO TO 204 806 807C [page 4-2] 808 809 202 IF(IP(1)-IOP)201,203,203 810 203 GO TO (1,2,3,4,5,6,201,201,201,201,11,11),IOP 811 11 IVAR=P(3) 812 IVARE=IVAR+I(1)-4 813 DO 297 N1=IVAR,IVARE 814 IVARP=N1-IVAR+4 815 297 I(N1)=P(IVARP) 816 GO TO 204 817 3 IGEN=P(3) 818 GO TO (281,282,283,284,285),IGEN 819 281 CALL GEN1 820 GO TO 204 821 282 CALL GEN2 822 GO TO 204 823 283 CALL GEN3 824 GO TO 204 825 284 CALL GEN4 826 GO TO 204 827 285 CALL GEN5 828 GO TO 204 829 4 IVAR=P(3) 830 IVARE=IVAR+I(1)-4 831 DO 296 N1=IVAR,IVARE 832 IVARP=N1-IVAR+4 833 296 I(N1+100)=P(IVARP)*SCLFT 834 GO TO 204 835 6 CALL FROUT3(IDSK) 836 STOP 837C ENTER NOTE TO BE PLAYED 838 1 DO 230 N1=MS1,MS3,MS2 839 IF(I(N1)+1)230,231,230 840 230 CONTINUE 841 CALL ERROR(2) 842 GO TO 204 843 231 M1=N1 844 M2=N1+I(1)-1 845 M3=M2+1 846 M4=N1+IP(8)-1 847 DO 232 N1=M1,M2 848 M5=N1-M1+1 849 232 I(N1)=P(M5)*SCLFT 850 I(M1)=P(3) 851 DO 233 N1=M3,M4 852 233 I(N1)=0 853 DO 235 N1=1,IP9 854 IF(TI(N1)-1000000.)235,234,235 855 234 TI(N1)=P(2)+P(4) 856 ITI(N1)=M1 857 GO TO 204 858 235 CONTINUE 859 CALL ERROR(3) 860 GO TO 204 861C DEFINE INSTRUMENT 862 2 M1=I(2) 863 M2=IP(5)+IFIX(P(3)) 864 I(M2)=M1 865 218 CALL DATA (NREAD) 866 IF(I(1)-2)210,210,211 867 210 I(M1)=0 868 I(2)=M1+1 869 870C [page 4-3] 871 872 GO TO 204 873 211 I(M1)=P(3) 874 M3=I(1) 875 I(M1+1)=M1+M3-1 876 M1=M1+2 877 DO 217 N1=4,M3 878 M5=P(N1) 879 IF(M5)212,213,213 880 212 IF(M5+100)300,301,301 881 300 I(M1)=-IP(2)+(M5+101)*IP(6) 882 GO TO 216 883 301 I(M1)=-IP(13)+(M5+1)*IP(14) 884 GO TO 216 885 213 IF(M5-100)214,214,215 886 214 I(M1)=M5 887 GO TO 216 888 215 I(M1)=M5+262144 889 216 M1=M1+1 890 217 CONTINUE 891 GO TO 218 892C PLAY TO ACTION TIME 893 244 T(2)=P(2) 894 250 TMIN=1000000. 895 IREST=1 896 DO 241 N1=1,IP9 897 IF(TMIN-TI(N1))241,241,240 898 240 TMIN=TI(N1) 899 MNOTE=N1 900 241 CONTINUE 901 IF(1000000.-TMIN)251,251,243 902 243 IF(TMIN-T(2))245,245,246 903 245 T(3)=TMIN 904 GO TO 260 905 246 T(3)=T(2) 906 GO TO 260 907 247 IF(T(1)-T(2))249,200,200 908 249 TI(MNOTE)=1000000. 909 M2=ITI(MNOTE) 910 I(M2)=-1 911 GO TO 250 912C SETUP REST 913 251 T(3)=T(2) 914 IREST=2 915 GO TO 260 916C PLAY 917 260 ISAM=(T(3)-T(1))*FLOAT(I(4))+.5 918 T(1)=T(3) 919 IF(ISAM)247,247,266 920 266 IF(ISAM-IP(14))262,262,263 921 262 I(5)=ISAM 922 ISAM=0 923 GO TO 264 924 263 I(5)=IP(14) 925 ISAM=ISAM-IP(14) 926 264 IF(I(8))290,290,291 927 290 M3=MOUT+I(5)-1 928 MSAMP=I(5) 929 GO TO 292 930 291 M3=MOUT+(2*I(5))-1 931 MSAMP=2*I(5) 932 933C [page 4-4] 934 935 292 DO 267 N1=MOUT,M3 936 267 I(N1)=0 937 GO TO (268,265),IREST 938 268 DO 270 NS1=MS1,MS3,MS2 939 IF(I(NS1)+1)271,270,271 940C GO THROUGH UNIT GENERATORS IN INSTRUMENT 941 271 I(3)=NS1 942 IGEN=IP(5)+I(NS1) 943 IGEN=I(IGEN) 944 272 I(6)=IGEN 945CC***** IF((IGEN)-101)293,294,294 946CC***** 293 CALL SAMGEN(I) 947CC***** ABOVE FOR MACHINE LANG. UNIT GENERATORS ****** 948CC***** GO TO 295 949 294 CALL FORSAM 950 295 IGEN=I(IGEN+1) 951 IF(I(IGEN))270,270,272 952 270 CONTINUE 953 265 CALL SAMOUT(IDSK,MSAMP) 954 IF(ISAM)247,247,266 955 END 956 957 958C [page 5-1] 959 960C FORS3 FORTRAN UNIT GENERATOR ROUTINE 961C *** MUSIC V *** 962 SUBROUTINE FORSAM 963 DIMENSION I(15000),P(100),IP(20),L(8),M(8) 964 COMMON I,P/PARM/IP 965 EQUIVALENCE (M1,M(1)),(M2,M(2)),(M3,M(3)),(M4,M(4)),(M5,M(5)),(M6,M(6)),(M7,M(7)),(M8,M(8)),(L1,L(1)),(L2,L(2)),(L3,L(3)),(L4,L(4)),(L5,L(5)),(L6,L(6)),(L7,L(7)),(L8,L(8)),(RN1,IRN1),(RN3,IRN3),(RN,IRN) 966C C***** DATA IMULT/Z5EECE66D/ 967 DATA IIIRD/976545367/ 968 SFI=1./FLOAT(IP(12)) 969 SFF=1./FLOAT(IP(15)) 970 SFID=FLOAT(IP(12)) 971 SFXX=FLOAT(IP(12))/FLOAT(IP(15)) 972 XNFUN=IP(6)-1 973C COMMON INITIALIZATION OF GENERATORS 974 N1=I(6)+2 975 N2=I(N1-1)-1 976 DO 204 J1=N1,N2 977 J2=J1-N1+1 978 IF(I(J1))200,201,201 979 200 L(J2)=-I(J1) 980 M(J2)=1 981 GO TO 204 982 201 M(J2)=0 983 IF(I(J1)-262144)202,202,203 984C*****WHAT DOES THE BIG NUMBER DO????? 985 202 L(J2)=I(J1)+I(3)-1 986 GO TO 204 987 203 L(J2)=I(J1)-262144 988 204 CONTINUE 989 NSAM=I(5) 990 N3=I(N1-2) 991 NGEN=N3-100 992 GO TO (101,102,103,104,105,106,107,108,109,110,111,112),NGEN 993 112 RETURN 994C UNIT GENERATORS 995C OUTPUT BOX 996 101 IF(M1)260,260,261 997 260 IN1=I(L1) 998 261 CONTINUE 999 DO 270 J3=1,NSAM 1000 IF(M1)265,265,264 1001 264 J4=L1+J3-1 1002 IN1=I(J4) 1003 265 J5=L2+J3-1 1004 I(J5)=IN1+I(J5) 1005 270 CONTINUE 1006 RETURN 1007C OSCILLATOR 1008 102 SUM=FLOAT(I(L5))*SFI 1009 IF(M1)280,280,281 1010 280 AMP=FLOAT(I(L1))*SFI 1011 281 IF(M2)282,282,283 1012 282 FREQ=FLOAT(I(L2))*SFI 1013 283 CONTINUE 1014 DO 293 J3=1,NSAM 1015 J4=INT(SUM)+L4 1016 F=FLOAT(I(J4)) 1017 1018C [page 5-2] 1019 1020 IF(M2)285,285,286 1021 285 SUM=SUM+FREQ 1022 GO TO 290 1023 286 J4=L2+J3-1 1024 SUM=SUM+FLOAT(I(J4))*SFI 1025CC 290 IF(SUM-XNFUN)288,287,287 1026 290 IF(SUM.GE.XNFUN)GO TO 287 1027CC 287 SUM=SUM-XNFUN 1028 IF(SUM.LT.0.0)GO TO 289 1029 288 J5=L3+J3-1 1030 IF(M1)291,291,292 1031 291 I(J5)=IFIX(AMP*F*SFXX) 1032 GO TO 293 1033C************ 1034 287 SUM=SUM-XNFUN 1035 GO TO 288 1036 289 SUM=SUM+XNFUN 1037 GO TO 288 1038C**********ABOVE FOR FM (NEG. FREQ. TO OSCIL) 1039 292 J6=L1+J3-1 1040 I(J5)=IFIX(FLOAT(I(J6))*F*SFF) 1041 293 CONTINUE 1042 I(L5)=IFIX(SUM*SFID) 1043 RETURN 1044C ADD TWO BOX 1045 103 IF(M1)250,250,251 1046 250 IN1=I(L1) 1047 251 IF(M2)252,252,253 1048 252 IN2=I(L2) 1049 253 DO 258 J3=1,NSAM 1050 IF(M1)255,255,254 1051 254 J4=L1+J3-1 1052 IN1=I(J4) 1053 255 IF(M2)257,257,256 1054 256 J5=L2+J3-1 1055 IN2=I(J5) 1056 257 J6=L3+J3-1 1057 I(J6)=IN1+IN2 1058 258 CONTINUE 1059 RETURN 1060C RANDOM INTERPOLATING GENERATOR 1061 104 SUM=FLOAT(I(L4))*SFI 1062 IF(M1)310,310,311 1063 310 XIN1=FLOAT(I(L1))*SFI 1064 311 IF(M2)312,312,313 1065 312 XIN2=FLOAT(I(L2))*SFI 1066 313 IRN1=I(L5) 1067 IRN3=I(L6) 1068 DO 340 J3=1,NSAM 1069 IF(M1)316,316,315 1070 315 J4=L1+J3-1 1071 XIN1=FLOAT(I(J4))*SFI 1072 316 IF(M2)318,318,317 1073 317 J5=L2+J3-1 1074 XIN2=FLOAT(I(J5))*SFI 1075 318 IF(SUM-XNFUN)320,319,319 1076 319 SUM=SUM-XNFUN 1077 I(7)=IABS(I(7)*IMULT) 1078 RN4=(2.*FLOAT(I(7))*SFF-1.) 1079 RN2=RN4-RN3 1080 1081C [page 5-3] 1082 1083 RN1=RN3 1084 RN3=RN4 1085 GO TO 321 1086 320 RN2=RN3-RN1 1087 321 J7=L3+J3-1 1088 I(J7)=XIN1*(RN1+(RN2*SUM)/XNFUN)*SFID 1089 SUM=SUM+XIN2 1090 340 CONTINUE 1091 I(L4)=IFIX(SUM*SFID) 1092 I(L5)=IRN1 1093 I(L6)=IRN3 1094 RETURN 1095C ENVELOPE GENERATOR 1096 105 SUM=FLOAT(I(L7))*SFI 1097 IF(M1)380,380,381 1098 380 XIN1=FLOAT(I(L1))*SFI 1099 381 IF(M4)382,382,383 1100 382 XIN4=FLOAT(I(L4))*SFI 1101 383 IF(M5)384,384,385 1102 384 XIN5=FLOAT(I(L5))*SFI 1103 385 IF(M6)386,386,387 1104 386 XIN6=FLOAT(I(L6))*SFI 1105 387 X1=XNFUN/4. 1106 X2=2.*X1 1107 X3=3.*X1 1108 DO 403 J3=1,NSAM 1109 J4=INT(SUM)+L2 1110 F=FLOAT(I(J4)) 1111 IF(M1)405,405,404 1112 404 J8=L1+J3-1 1113 XIN1=FLOAT(I(J8))*SFI 1114 405 IF(SUM-XNFUN)389,388,388 1115 388 SUM=SUM-XNFUN 1116 389 IF(SUM-X1)390,390,393 1117 390 IF(M4)392,392,391 1118 391 J4=L4+J3-1 1119 XIN4=FLOAT(I(J4))*SFI 1120 392 SUM=SUM+XIN4 1121 GO TO 402 1122 393 IF(SUM-X2)394,394,397 1123 394 IF(M5)396,396,395 1124 395 J5=L5+J3-1 1125 XIN5=FLOAT(I(J5))*SFI 1126 396 SUM=SUM+XIN5 1127 GO TO 402 1128 397 IF(M6)400,400,399 1129 399 J6=L6+J3-1 1130 XIN6=FLOAT(I(J6))*SFI 1131 400 SUM=SUM+XIN6 1132 402 J7=L3+J3-1 1133 I(J7)=IFIX(XIN1*F*SFXX) 1134 403 CONTINUE 1135 I(L7)=IFIX(SUM*SFID) 1136 RETURN 1137C STEREO OUTPUT BOX 1138 106 IF(M1)500,500,501 1139 500 IN1=I(L1) 1140 501 IF(M2)502,502,503 1141 502 IN2=I(L2) 1142 503 NSSAM=2*NSAM 1143 1144C [page 5-4] 1145 1146C 6/29/70 L.C.SMITH 1147 ICT=0 1148 DO 510 J3=1,NSSAM,2 1149 IF(M1) 505,505,504 1150C C*** 504 J4=L1+J3-1 1151 504 J4=L1+ICT 1152 IN1=I(J4) 1153 505 J5=L3+J3-1 1154 I(J5)=IN1+I(J5) 1155 IF(M2)507,507,506 1156C C*** 506 J4=L2+J3-1 1157 506 J4=L2+ICT 1158 IN2=I(J4) 1159 507 J5=L3+J3 1160 I(J5)=IN2+I(J5) 1161 510 CONTINUE 1162 RETURN 1163C ADD 3 BOX 1164 107 IF(M1)750,750,751 1165 750 IN1=I(L1) 1166 751 IF(M2)752,752,753 1167 752 IN2=I(L2) 1168 753 IF(M3)754,754,755 1169 754 IN3=I(L3) 1170 755 DO 780 J3=1,NSAM 1171 IF(M1)757,757,756 1172 756 J4=L1+J3-1 1173 IN1=I(J4) 1174 757 IF(M2)759,759,758 1175 758 J5=L2+J3-1 1176 IN2=I(J5) 1177 759 IF(M3)761,761,760 1178 760 J6=L3+J3-1 1179 IN3=I(J6) 1180 761 J7=L4+J3-1 1181 I(J7)=IN1+IN2+IN3 1182 780 CONTINUE 1183 RETURN 1184C ADD 4 BOX 1185 108 IF(M1)850,850,851 1186 850 IN1=I(L1) 1187 851 IF(M2)852,852,853 1188 852 IN2=I(L2) 1189 853 IF(M3)854,854,855 1190 854 IN3=I(L3) 1191 855 IF(M4)856,856,857 1192 856 IN4=I(L4) 1193 857 DO 880 J3=1,NSAM 1194 IF(M1)859,859,858 1195 858 J4=L1+J3-1 1196 IN1=I(J4) 1197 859 IF(M2)861,861,860 1198 860 J5=L2+J3-1 1199 IN2=I(J5) 1200 861 IF(M3)863,863,862 1201 862 J6=L3+J3-1 1202 IN3=I(J6) 1203 863 IF(M4)865,865,864 1204 864 J7=L4+J3-1 1205 IN4=I(J7) 1206 1207C [page 5-5] 1208 1209 865 J8=L5+J3-1 1210 I(J8)=IN1+IN2+IN3+IN4 1211 880 CONTINUE 1212 RETURN 1213C MULTIPLIER 1214 109 IF(M1)900,900,901 1215 900 XIN1=FLOAT(I(L1))*SFI 1216 901 IF(M2)902,902,903 1217 902 XIN2=FLOAT(I(L2))*SFI 1218 903 DO 908 J=1,NSAM 1219 IF(M1)905,905,904 1220 904 J4=L1+J3-1 1221 XIN1=FLOAT(I(J4))*SFI 1222 905 IF(M2)907,907,906 1223 906 J5=L2+J3-1 1224 XIN2=FLOAT(I(J5))*SFI 1225 907 J6=L3+J3-1 1226 I(J6)=XIN1*XIN2*SFID 1227 908 CONTINUE 1228 RETURN 1229C SET NEW FUNCTION IN OSC OR ENV 1230 110 ILOC=N1+6 1231 IF(I(N1+1).EQ.105) ILOC=N1+4 1232 IN1=I(3)+I(N1)-1 1233 IIN1=I(IN1)/IP(12) 1234 IF(IIN1)960,960,955 1235 955 I(ILOC)=-IP(2)-(IIN1-1)*IP(6) 1236 960 RETURN 1237C RANDOM AND HOLD GENERATOR 1238 111 SUM=FLOAT(I(L4))*SFI 1239 IF(M1)910,910,911 1240 910 XIN1=FLOAT(I(L1))*SFI 1241 911 IF(M2)912,912,913 1242 912 XIN2=FLOAT(I(L2))*SFI 1243 913 IRN=I(L5) 1244 DO 940 J3=1,NSAM 1245 IF(M1)916,916,915 1246 915 J4=L1+J3-1 1247 XIN1=FLOAT(I(J4))*SFI 1248 916 IF(M2)918,918,917 1249 917 J5=L2+J3-1 1250 XIN2=FLOAT(I(J5))*SFI 1251 918 IF(SUM-XNFUN)920,919,919 1252 919 SUM=SUM-XNFUN 1253 I(7)=IABS(I(7)*IMULT) 1254 RN=(2.*FLOAT(I(7))*SFF-1.) 1255 920 J7=L3+J3-1 1256 I(J7)=XIN1*RN*SFID 1257 SUM=SUM+XIN2 1258 940 CONTINUE 1259 I(L4)=IFIX(SUM*SFID) 1260 I(L5)=IRN 1261 RETURN 1262 END 1263 1264C [page 6-1] 1265 1266C GEN1 FUNCTION GENERATOR 1 1267C *** MUSIC V *** 1268 SUBROUTINE GEN1 1269 DIMENSION I(15000),P(100),IP(20) 1270 COMMON I,P/PARM/IP 1271 N1=IP(2)+(IFIX(P(4))-1)*IP(6) 1272 M1=7 1273 SCLFT=IP(15) 1274 102 IF(P(M1+1))103,103,100 1275 100 V1=P(M1-2)*SCLFT 1276 V2=(P(M1)-P(M1-2))/(P(M1+1)-P(M1-1))*SCLFT 1277 MA=N1+IFIX(P(M1-1)) 1278 MB=N1+IFIX(P(M1+1))-1 1279 DO 101 J=MA,MB 1280 XJ=J-MA 1281 101 I(J)=V1+V2*XJ 1282 IF(IFIX(P(M1+1)).EQ.(IP(6)-1))GO TO 103 1283 M1=M1+2 1284 GO TO 102 1285 103 I(MB+1)=P(M1)*SCLFT 1286 RETURN 1287 END 1288C GEN2 FUNCTION GENERATOR 2 1289c *** MUSIC V *** 1290 SUBROUTINE GEN2 1291 DIMENSION I(15000),P(100),IP(20),A(7000) 1292 COMMON I,P/PARM/IP 1293 EQUIVALENCE(I,A) 1294 SCLFT=IP(15) 1295 N1=IP(2)+(IFIX(P(4))-1)*IP(6) 1296 N2=N1+IP(6)-1 1297 DO 101 K1=N1,N2 1298 101 A(K1)=0.0 1299 FAC=6.283185/(FLOAT(IP(6))-1.0) 1300 NMAX=I(1) 1301 N3=5+INT(ABS(P(NMAX)))-1 1302 IF(N3-5)104,100,100 1303 100 DO 103 J=5,N3 1304 FACK=FAC*FLOAT(J-4) 1305 DO 102 K=N1,N2 1306 102 A(K)=A(K)+SIN(FACK*FLOAT(K-N1))*P(J) 1307 103 CONTINUE 1308 104 N4=N3+1 1309 N5=I(1)-1 1310 IF(N5-N4)114,105,105 1311 105 DO 107 J1=N4,N5 1312 FACK=FAC*FLOAT(J1-N4) 1313 DO 106 K1=N1,N2 1314 106 A(K1)=A(K1)+COS(FACK*FLOAT(K1-N1))*P(J1) 1315 107 CONTINUE 1316 114 CONTINUE 1317 IF(P(NMAX))112,112,108 1318 108 FMAX=0.0 1319 DO 110 K2=N1,N2 1320 IF(ABS(A(K2))-FMAX)110,110,109 1321 109 FMAX=ABS(A(K2)) 1322 110 CONTINUE 1323 113 DO 111 K3=N1,N2 1324 111 I(K3)=(A(K3)*SCLFT*.99999)/FMAX 1325 RETURN 1326 1327C [page 6-2] 1328 1329 112 FMAX=.99999 1330 GO TO 113 1331 END 1332C GEN3 FUNCTION GENERATOR 3 1333C *** MUSIC V *** 1334C ASSUMPTIONS--P(4) = THE NUMBER OF THE FUNCTION TO BE GENERATED, 1335C I(1) = WORD COUNT FOR CURRENT DATA RECORD 1336C P(5) = THE BEGINNING THE THE LIST OF DESCRIPTION NUMBERS 1337C IP(2) = THE BEGINNING SUBSCRIPT FOR FUNCTIONS IN THE I ARRAY, 1338C IP(6) = THE LENGTH OF THE FUNCTIONS 1339C IP(15) = SCALE FACTOR FOR STORED FUNCTIONS 1340C 1341 SUBROUTINE GEN3 1342 COMMON I(15000),P(100) /PARM/ IP(20) 1343 N=I(1)-5 1344 NL=5 1345 SCLFT=IP(15) 1346 LL=IP(6) 1347 RMIN=0 1348 RMAX=0 1349 NR=NL+N 1350 DO 10 J=NL,NR 1351 IF(P(J).GT.RMAX) RMAX=P(J) 1352 10 IF(P(J).LT.RMIN) RMIN=P(J) 1353 DIV=AMAX1(ABS(RMIN),ABS(RMAX)) 1354 N1 = IP(2) + (IFIX(P(4))-1)*IP(6) 1355 I(N1)=(P(NL)/DIV)*SCLFT 1356 LAST=N1 1357 DO 100 J=1,N 1358 LL = LL-LL/(N-J+1) 1359 IX = N1+IP(6)-LL-1 1360 IX2 = NL+J 1361 I(IX)=(P(IX2)/DIV)*SCLFT 1362 DELTA=FLOAT(I(IX))-FLOAT(I(LAST)) 1363 NR = IX-LAST-1 1364 SEG = NR+1 1365 HNCR=DELTA/SEG 1366 DO 50 K=1,NR 1367 IX2 = LAST+K 1368 50 I(IX2)=FLOAT(I(IX2-1))+HNCR 1369 100 LAST=IX 1370 RETURN 1371 END 1372C DATA3 PASS 3 DATA INPUTING ROUTINE 1373C *** MUSIC V *** 1374 SUBROUTINE DATA(N) 1375 COMMON I(15000),P(100) 1376 READ(N) K,(P(J),J=1,K) 1377 I(1)=K 1378 RETURN 1379 END 1380C PARM CONTROL DATA SPECIFICATION FOR PASS 3 1381C *** MUSIC V *** 1382C 1383C IP(1) = NUMBER OF OP CODES 1384C IP(2) = BEGINNING SUBSCRIPT OF FIRST FUNCTION 1385C IP(3) = STANDARD SAMPLING RATE 1386C IP(4) = BEGINNING SUBSCRIPT OF INSTRUMENT DEFINITIONS 1387C IP(5) = BEGINNING OF LOCATION TABLE FOR INSTRUMENT DEFINITIONS 1388C IP(6) = LENGTH OF FUNCTIONS 1389 1390C [page 6-3] 1391 1392C IP(7) = BEGINNING OF NOTE CARD PARAMETERS 1393C IP(8) = LENGTH OF NOTE CARD PARAMETER BLOCKS 1394C IP(9) = NUMBER OF NOTE CARD PARAMETER BLOCKS 1395C IP(10) = BEGINNING OF OUTPUT DATA BLOCK 1396C IP(11) = SOUND ZERO (SILENCE VALUE) 1397C IP(12) = SCALE FACTOR FOR NOTE CARD PARAMETERS 1398C IP(13) = BEGINNING OF GENERATOR INPUT-OUTPUT BLOCKS 1399C IP(14) = LENGTH OF GENERATOR INPUT-OUTPUT BLOCKS 1400C IP(15) = SCALE FACTOR FOR FUNCTIONS 1401C 1402 BLOCK DATA 1403 COMMON /PARM/IP(20) 1404 DATA IP/12,512,10000,14500,14400,512,13000,35,40,6657,2048, 1405 1 "1000000,6657,512,"377777777777,5*0/ 1406C**** BIG NUMB. IS IBM360'S BIGGEST. 1 65536,6657,512,Z7FFFFFFF/ 1407 END 1408C**** SUBROUTINE DUM 1409C**** ENTRY SAMGEN 1410C**** ENTRY GEN4 1411C**** ENTRY GEN5 1412C**** END 1413 SUBROUTINE SAMGEN 1414 RETURN 1415 END 1416 SUBROUTINE GEN4 1417 END 1418 SUBROUTINE GEN5 1419 END 1420C **** DUMMY SUBROUTINES **** 1421 1422 1423 SUBROUTINE FROUT3(IDSK) 1424C TERMINATE OUTPUT 1425 INTEGER PEAK 1426 COMMON I(15000),P(100)/PARM/IP(20)/FINOUT/PEAK,NRSOR 1427 K=IP(10) 1428 L=IP(10)+IP(14)-1 1429 DO 1 J=K,L 1430 1 I(J)=0 1431 CALL SAMOUT(IDSK,IP(14)) 1432C REWIND NWRITE 1433C WRITE(6,10) PEAK,NRSOR 1434 TYPE 10,PEAK,NRSOR 1435C CALL EXIT 1436 IF(IDSK.LT.0)CALL EXIT 1437 J=IP(10) 1438 L=J+1024 1439 DO 2 K=J,L 1440 2 I(K)=0 1441C WILL WRITE 1024 0'S ON DSK. 1442 CALL FASTOUT(I(J),1024) 1443 CALL FINFILE 1444 CALL EXIT 1445 10 FORMAT ('0PEAK AMPLITUDE WAS',I8/'0NUMBER OF SAMPLES OUT OF RANGE WAS',I8) 1446 END 1447 1448 1449C DSMOUT DEBUG SAMOUT 1450C *** MUSIC V *** 1451 1452C [page 6-4] 1453 1454C DEBUG SAMOUT 1455 SUBROUTINE SAMOUT(IDSK,N) 1456 DIMENSION IDBUF(2000),MS(3) 1457C*** IDSK IS FLAG TO WRITE SAMPLES ON DSK -- PDP **** 1458C*** IDBUF WILL STORE PACKED SAMPLES. **** 1459 DIMENSION I(15000),T(10),P(100),IP(20) 1460 COMMON I,P/PARM/IP/FINOUT/PEAK,NRSOR 1461 INTEGER PEAK 1462 IF(IDSK.GE.0) GO TO 99 1463 N1=N 1464 PRINT 100,N1 1465 100 FORMAT(7H OUTPUTI6,8H SAMPLES) 1466 N2=IP(10)-1 1467 N3=10 1468 GO TO 104 1469 106 DO 101 L=1,10 1470 J=N2+L 1471 101 T(L)=FLOAT(I(J))/FLOAT(IP(12)) 1472 PRINT 102, (T(K),K=1,N3) 1473 102 FORMAT(1H 10F11.4) 1474 N2=N2+10 1475 N1=N1-10 1476 IF(N1)103,103,104 1477 103 RETURN 1478 104 IF(N1-10)105,106,106 1479 105 N3=N1 1480 GO TO 106 1481 1482 99 J=IDSK+1 1483 M1=IP(10) 1484 M2=0 1485 ISC=IP(12) 1486 IDSK=IDSK+N 1487C COUNTS SAMPLES TO DATE 1488 DO 1 K=J,IDSK 1489 N1=I(M1+M2)/ISC 1490 IF(N1.GT.PEAK)PEAK=N1 1491 IDBUF(K)=N1 1492 1 M2=M2+1 1493 IF(IDSK.LT.768)RETURN 1494 1495 KL=0 1496 DO 2 K=1,768,3 1497 KL=KL+1 1498 KJ=K-1 1499 MS(1)=IDBUF(K) 1500 IF(MS(1).EQ.2048) MS(1)=2047 1501C A 2048 IN THE 12 LEFT HAND BITS CREATES PROBLEMS 1502 DO 3 L=2,3 1503 MS(L)=IDBUF(KJ+L) 1504 3 IF(MS(L).LT.0) MS(L)=4096+MS(L) 1505 2 IDBUF(KL)=MS(3)+MS(2)*4096+MS(1)*16777216 1506C PACKS 3 SMPLS TO A 36-BIT WORD. 4096=2**12, 16---=2**24. 1507C MS(1) HAS LEFT HAND 12 BITS; MS(2), MIDDLE 12 BITS; MS(3), RIGHT 12. 1508C NEGATIVE NUMBERS RUN FROM 4096(I.E. -1) TO 2049(I.E. -2048). 1509 CALL FASTOUT(IDBUF(1),256) 1510 J=IDSK-768 1511 IF(J.LT.1) GO TO 4 1512 DO 5 K=1,J 1513 5 IDBUF(K)=IDBUF(768+K) 1514 1515C [page 6-5] 1516 1517 4 IDSK=J 1518 RETURN 1519 END 1520 1521C ERROR1 GENERAL ERROR ROUTINE 1522C *** MUSIC V *** 1523 SUBROUTINE ERROR(I) 1524 PRINT 100,I 1525 100 FORMAT(' ERROR OF TYPE',I5) 1526 RETURN 1527 END 1528 1529 1530 1531 1532 1533