CTITLESAAVOPA -- UNIFORM RESAMPLING USING POLYNOMIAL FITTING 00010002 C*********************************************************************** C COPYRIGHT ATLANTIC RICHFIELD COMPANY 1991 * C*********************************************************************** CA 00020000 CA AUTHOR DAVE D. THOMPSON 00030000 CA DESIGNER DAVE D. THOMPSON 00040000 CA LANGUAGE FORTRAN IV 00050000 CA SYSTEM IBM 00051001 C WRITTEN WHEN 00060000 C REVISED 00070000 C REVISED 09-10-89 JJC - CHANGED PROCESS NAME TO AVOP. 00071002 CA 00080000 CA 00090000 CA CALLING SEQUENCE: 00100000 CA 00110000 CA CALL SAAVOPA (X,Y,NX,ID,TA,S,YY,NYY) 00120002 CA 00130000 CA IN X R4 INDEPENDENT VARIABLE WITH NX VALUES. 00140000 CA IN Y R4 DEPENDENT VARIABLE 00150000 CA IN NX I4 NUMBER OF SAMPLES IN X AND Y 00160000 CA IN ID I4 DEGREE OF POLYNOMIAL 00170000 CA IN TA R4 X VALUE OF FIRST INTERPOLATION POSITION 00180000 CA IN S R4 SAMPLE PERIOD OF UNIFORM INTERPOLATION 00190000 CA OUT YY R4 OUTPUT WITH NYY VALUES 00200000 CA OUT NYY I4 THE NUMBER OF SAMPLES TO RETURN IN YY 00210000 CA 00220000 CA THIS SUBROUTINE DOES UNIFORM RESAMPLING USING POLYNOMIAL FITTING. 00230000 CA YOU MUST SPECIFY THE DEGREE OF POLYNOMIAL YOU ARE USING. IT 00240000 CA RESAMPLES USING UNIFORMED SPACING. 00250000 CA 00260000 CA 00270000 C 00280000 SUBROUTINE SAAVOPA(X,Y,NX,ID,TA,S,YY,NYY) 00290002 IMPLICIT INTEGER (A-Z) 00300000 C 00310000 REAL P 00320000 REAL PP 00330000 REAL P1 00340000 REAL S 00350000 REAL T 00360000 REAL TA 00370000 REAL X 00380000 REAL Y 00390000 REAL YY 00400000 C 00410000 DIMENSION X(1),Y(1),YY(1) 00420000 C 00430000 IDD=ID 00440000 IF(NX.LT.ID+1) IDD=NX-1 00450000 J=1 00460000 NNX=NX-IDD 00470000 T=TA 00480000 C 00490000 DO 100 I=1,NYY 00500000 10 IF(J.EQ.NNX) GO TO 20 00510000 P=(X(J)+X(J+ID))*.5 00520000 PP=(X(J+1)+X(J+ID+1))*.5 00530000 IF(ABS(T-P).LE.ABS(T-PP)) GO TO 20 00540000 J=J+1 00550000 GO TO 10 00560000 C 00570000 20 CONTINUE 00580000 IF(T.GE.X(J)) GO TO 30 00590000 YY(I)=Y(J) 00600000 IC=1 00610000 GO TO 70 00620000 C 00630000 30 IF(T.LE.X(J+IDD)) GO TO 40 00640000 YY(I)=Y(J+IDD) 00650000 IC=2 00660000 GO TO 70 00670000 C 00680000 40 N1=IDD+1 00690000 YY(I)=0. 00700000 DO 60 I1=J-1+1,J-1+N1 00710000 P1=Y(I1) 00720000 DO 50 J1=J-1+1,J-1+N1 00730000 IF(J1.EQ.I1) GO TO 50 00740000 P1=P1*(T-X(J1))/(X(I1)-X(J1)) 00750000 50 CONTINUE 00760000 60 YY(I)=YY(I)+P1 00770000 IC=3 00780000 C 00790000 70 CONTINUE 00800000 T=T+S 00810000 100 CONTINUE 00820000 RETURN 00830000 END 00840000