************************************************************************ * polyphi - an interface to polyph ************************************************************************ * I/O List *_Name______________Type______________I/O____Description________________ * drum[0:15] LOGICAL in indicates drum channel(s) * e_t[e] REAL in times of events * e_k[e] INTEGER in event kinds * e_c[e] INTEGER in event channels (unused?) * e_p1[e] INTEGER in event data part 1 * e_p2[e] INTEGER in event data part 2 * e_p3[e] REAL in event data (duration or tempo) * e_v[e] INTEGER in note-off velocities * e_g[e] INTEGER in portamento prefixes * e_f[e] INTEGER in event source file * e_r[e] INTEGER in event track * e_u[e] REAL out event metrical times (in tactus) * ind[e] INTEGER work permutation vector * RSW[3@e] Real work for merge sort * JSW[3@e] Integer work for merge and radix sorts * e INTEGER in length of event list * opt_V Logical in dump NL and analysis * score REAL out total log probability * ierr INTEGER out error code *----------------------------------------------------------------------- SUBROUTINE POLYPHI (drum, e_t, e_k, e_c, e_p1, e_p2, e_p3, e_v, & e_g, e_f, e_r, e_u, ind, RSW, JSW, e, opt_v, score, IERR) IMPLICIT NONE INTEGER e_k, e_c, e_p1, e_p2, e_v, e_g, & e_f, e_r, ind, JSW, e, ierr REAL e_t, e_p3, e_u, RSW, score LOGICAL drum, opt_v DIMENSION drum(0:15), e_t(e), e_k(e), e_c(e), e_p1(e), e_p2(e), & e_p3(e), e_v(e), e_g(e), e_f(e), e_r(e), e_u(e), RSW(3*e), & JSW(3*e), ind(e) * local variables INTEGER j, L, ! counters & ioff, ion, ! last off, on & no, ! Note-Ons & pitch ! MIDI note number * constants INTEGER IOU CHARACTER*80 fname, oname CHARACTER*256 cmd, line PARAMETER (IOU = 4) * external function INTEGER LTRIM ! same as LEN_TRIM SAVE fname, oname DATA fname, oname / 'file_to_analyze.notes', 'melisma2.out' / ************************************************************************ * begin ************************************************************************ * mark drum events DO J = 1, e IF (drum(e_c(J))) THEN IF (e_k(J) .EQ. 0 .OR. e_k(J) .EQ. 1) THEN e_k(J) = e_k(J) - 2 ! thus {0,1} becomes {-2,-1} END IF END IF END DO * sort note events to the front DO J = 1, e ind(J) = J END DO CALL RSORTI (e_k, ind, e, -7, JSW) CALL RORDER (e_t, ind, e) CALL IORDER (e_c, ind, e) CALL IORDER (e_p1, ind, e) CALL IORDER (e_p2, ind, e) CALL RORDER (e_p3, ind, e) CALL IORDER (e_v, ind, e) CALL IORDER (e_g, ind, e) CALL IORDER (e_r, ind, e) CALL RORDER (e_u, ind, e) CALL IBSLE(e_k, e, 0, ioff) ! last Note-Off CALL IBSLE(e_k, e, 1, ion) ! last Note-On no = ion - ioff ! Note-Ons sans drums L = ioff + 1 * sort Note On's by time DO j = 1, no ind(j) = j END DO CALL MSORTR (e_t(L), ind, no, RSW, JSW) CALL IORDER (e_k(L), ind, no) CALL IORDER (e_c(L), ind, no) CALL IORDER (e_p1(L), ind, no) CALL IORDER (e_p2(L), ind, no) CALL RORDER (e_p3(L), ind, no) CALL IORDER (e_v(L), ind, no) CALL IORDER (e_g(L), ind, no) CALL IORDER (e_r(L), ind, no) CALL RORDER (e_u(L), ind, no) ************************************************************************ * open notelist file ************************************************************************ OPEN (FILE=fname, UNIT=IOU, STATUS='NEW', IOSTAT=IERR) IF (IERR .NE. 0) THEN PRINT *, 'polyphi: trouble opening input file!' RETURN END IF 10 FORMAT ('Note', I9, I9, I4) DO J = L, L+no-1 ION = NINT(1000. * E_T(J)) IOFF = NINT(1000. * (E_T(J) + E_P3(J))) PITCH = E_P1(J) WRITE (UNIT=IOU, FMT=10, IOSTAT=IERR) ION, IOFF, PITCH IF (opt_V) WRITE (UNIT=*, FMT=10, IOSTAT=IERR) ION, IOFF, PITCH IF (IERR .NE. 0) THEN PRINT *, 'polyphi: trouble writing to file!' RETURN END IF END DO CLOSE (UNIT=IOU, IOSTAT=IERR) IF (IERR .NE. 0) PRINT *, 'polyphi: trouble closing file!' ************************************************************************ * Call program MELISMA2 ************************************************************************ L = LTRIM(fname) cmd = 'polyph ' // fname(1:L) // ' > ' // oname !! PRINT *, 'using command ', CMD CALL SYSTEM (cmd) ************************************************************************ * Retrieve results ************************************************************************ OPEN (FILE=oname, UNIT=IOU, STATUS='OLD', IOSTAT=IERR) IF (IERR .NE. 0) THEN PRINT *, 'polyphi: trouble opening results file!' RETURN END IF DO 30 WHILE (.TRUE.) 20 FORMAT (A) READ (UNIT=IOU, FMT=20, END=40, IOSTAT=IERR) LINE IF (opt_v) WRITE (UNIT=*, FMT=20) LINE IF (IERR .NE. 0) PRINT *, 'polyphi: trouble reading results!' J = INDEX(LINE, 'Total final score =') !!! PRINT *, 'read line: ', LINE, ' index returns: ', J IF (J .EQ. 0) GO TO 30 L = LTRIM(LINE) !!! PRINT *, 'attempting to interpret: ', LINE(20:L) READ (UNIT=LINE(20:L), FMT=*, IOSTAT=IERR) SCORE GO TO 40 30 END DO 40 CLOSE (UNIT=IOU, IOSTAT=IERR) IF (IERR .NE. 0) PRINT *, & 'polyphi: trouble closing results file!' * delete work files CALL UNLINK (fname, ierr) IF (ierr .NE. 0) PRINT *, 'trouble deleting ', fname CALL UNLINK (oname, ierr) IF (ierr .NE. 0) PRINT *, 'trouble deleting ', oname RETURN ! success END