THIS SHOULD DO THE TRICK. YOU SPECIFY ON A DATA CARD, WITH ANY NUMBER OF DATA CARDS, IN 2I6 FORMAT, TWO GOOD FRAMES, AND THE PROGRAM WILL REPLACE ALL INTERVENING FRAMES. IN OTHER WORDS IF YOU SAY 100 102 THE PROGRAM WILL REPLACE FRAME 101. YOU LOAD THE LPC DATA SET AS FT97. THERE ARE SOME SAMPLE FRAMES BELOW. // JOB F62 D0430.SCHOOL REG=250 T=.1 R=Y P=99 N=REPLACE //*FORMAT PR,DEST=VM370,DDNAME= // EXEC FORTHCLG //FORT.SYSPRINT DD DUMMY //FORT.SYSIN DD * SUBROUTINE INTERS(BOLD,BNEW,DELTB,NPOLS,B) DIMENSION B(18),BOLD(18),BNEW(18) REAL*8 AOLD(18,18),ANEW(18,18),A(18,18), C ROLD(19),RNEW(19),R(19),DELTA DELTA=DELTB NCOM1=NPOLS+1 DO 10 I=1,NPOLS NCOM2=NCOM1-I AOLD(NPOLS,I)=BOLD(NCOM2) 10 ANEW(NPOLS,I)=BNEW(NCOM2) NPOLSM=NPOLS-1 NPOLSP=NPOLS+1 DO 20 K=1,NPOLSM I=NPOLS-K DO 20 J=1,I AOLD(I,J)=(AOLD(I+1,J)+AOLD(I+1,I+1)*AOLD(I+1,I+1-J))/ C (1.-AOLD(I+1,I+1)**2) 20 ANEW(I,J)=(ANEW(I+1,J)+ANEW(I+1,I+1)*ANEW(I+1,I+1-J))/ C (1.-ANEW(I+1,I+1)**2) C......COMPUTE AUTOCORRELATION COEFFICIENTS RTEMP(I) WITH R(0) = 1 ROLD(1)=1. RNEW(1)=1. DO 30 I=1,NPOLS SUM1=0. SUM2=0. DO 40 J=1,I SUM1=SUM1+AOLD(I,J)*ROLD(I+1-J) 40 SUM2=SUM2+ANEW(I,J)*RNEW(I+1-J) ROLD(I+1)=SUM1 30 RNEW(I+1)=SUM2 C......COMPUTE R(0) FROM RTEMP(I) DO 60 I=1,NPOLS ROLD(1)=ROLD(1)-AOLD(NPOLS,I)*ROLD(I+1) 60 RNEW(1)=RNEW(1)-ANEW(NPOLS,I)*RNEW(I+1) ROLD(1)=1.D0/ROLD(1) RNEW(1)=1.D0/RNEW(1) C......COMPUTE AUTOCORRELATION COEFFICIENTS R(I) WITH CORRECT R(0) DO 50 I=2,NPOLSP ROLD(I)=ROLD(1)*ROLD(I) 50 RNEW(I)=RNEW(1)*RNEW(I) C......INTERPOLATE AUTOCORRELATION COEFFICIENTS DO 70 I=1,NPOLSP 70 R(I)=DELTA*(RNEW(I)-ROLD(I))+ROLD(I) C......INSERT TEST FOR SINGULARITY OF NEW AUTOCORRELATION MATRIX C......COMPUTE NEW PREDICTOR COEFFICIENTS A(1,1)=R(2)/R(1) DO 80 I=2,NPOLS SUM1=R(1) SUM2=R(I+1) IMINUS=I-1 DO 90 J=1,IMINUS SUM1=SUM1-R(J+1)*A(I-1,J) 90 SUM2=SUM2-R(I-J+1)*A(I-1,J) A(I,I)=SUM2/SUM1 DO 100 J=1,IMINUS 100 A(I,J)=A(I-1,J)-A(I,I)*A(I-1,I-J) 80 CONTINUE DO 110 I=1,NPOLS NCOM2=NCOM1-I 110 B(I)=A(NPOLS,NCOM2) RETURN END C DEFINE FILE 97(532,484,U,NST) DIMENSION A(22),B(22),C(22),OLD(22) COMMON LANSKY CALL BDOPEN(LANSKY,'FT97F001') IF(LANSKY.LT.0) GOTO 901 1 READ(5,10,END=100) IFR1,IFR2 10 FORMAT(2I6) C...........WILL REPLACE ALL FRAMES -->BETWEEN<-- IFR2 AND IFR1 CALL GETFR(IFR1,A) CALL GETFR(IFR2,B) NFRS=IFR2-IFR1-1 AINTRP=1./FLOAT(IFR2-IFR1) X=AINTRP DO 111 M=1,NFRS CALL GETFR(IFR1+M,OLD) CALL INTERS(A(5),B(5),X,18,C(5)) DO 11 JJ=1,3 C...........LEAVE PITCH ALONE C(JJ)=(1.-X)*A(JJ)+X*B(JJ) C WRITE(6,1001) A(JJ),B(JJ),C(JJ) C1001 FORMAT ( 3F10.4) 11 CONTINUE C(4)=OLD(4) X=X+AINTRP 714 CALL REPLAC(IFR1+M,C) MMM=IFR1+M WRITE(6,1234) MMM 1234 FORMAT( ' REPLACED FRAME # ',I8) 111 CONTINUE GOTO 1 100 STOP 901 WRITE(6,902) 902 FORMAT( ' SHIT') STOP END SUBROUTINE GETFR(IFR,A) COMMON LANSKY DIMENSION FRAME(484),A(22) IREC=((IFR-1)/22)+1 C READ(97'IREC) FRAME CALL BDREAD(LANSKY,IREC,FRAME) CALL BDCHEK(LANSKY,NSENSE) IF(NSENSE.LT.0) GOTO 901 ILOC=(MOD(IFR-1,22)+1)*22-21 ILOC2=ILOC+21 N=0 DO 1 M=ILOC,ILOC2 N=N+1 1 A(N)=FRAME(M) C WRITE(6,1001) ILOC,ILOC2,IREC C1001 FORMAT ( 'ILOC,ILOC2,IREC',3I8) RETURN 901 WRITE(6,903) 903 FORMAT( ' FUCK') STOP END SUBROUTINE REPLAC(IFR,A) COMMON LANSKY DIMENSION FRAME(484),A(22) IREC=((IFR-1)/22)+1 C READ(97'IREC) FRAME CALL BDREAD(LANSKY,IREC,FRAME) CALL BDCHEK(LANSKY,NSENSE) IF(NSENSE.LT.0) GOTO 901 ILOC=(MOD(IFR-1,22)+1)*22-21 ILOC2=ILOC+21 N=0 DO 1 M=ILOC,ILOC2 N=N+1 FRAME(M)=A(N) 1 CONTINUE C WRITE(6,1001) ILOC,ILOC2,IREC C1001 FORMAT ( 'ILOC,ILOC2,IREC ( IN REPLAC)',3I8) C WRITE(97'IREC) FRAME CALL BDWRIT(LANSKY,IREC,FRAME) CALL BDCHEK(LANSKY,NSENSE) IF(NSENSE.LT.0) GOTO 903 RETURN 901 WRITE(6,910) 910 FORMAT( ' SUCK') STOP 903 WRITE(6,911) 911 FORMAT( 'DAMN') STOP END //LKED.SYSPRINT DD DUMMY //LKED.SYSIN DD * ENTRY MAIN //GO.FT97F001 DD DSN=U.GARTON.BARK,DISP=SHR //GO.SYSIN DD * 404 408 422 428 451 454 463 466 478 481