CTITLESAPGPT -- PAGE PLOT OF AUTOCORRELATION 00000010 C*********************************************************************** C COPYRIGHT ATLANTIC RICHFIELD COMPANY 1991 * C*********************************************************************** CA AUTHOR D. D. THOMPSON 00000020 CA DESIGNER D. D. THOMPSON 00000030 CA LANGUAGE FORTRAN 77 00000040 CA SYSTEM IBM & CRAY 00000041 CA WRITTEN 10/01/76 00000050 C REVISED MO-DA-YR 00000060 C REVISED 05-20-85 TWH. REMOVED VS FORTRAN WARN- 00000061 C ING MESSAGES AND ADAPTED TO 00000062 C RUN ON IBM & CRAY SYSTEMS. 00000063 C REVISED 11-13-89 RDK. CRAY CFT77 COMPATIBILITY 00000061 C 00000070 CA 00000080 CA 00000090 CA CALL SAPGPT (X, N, NA, NB, IFLAG, IPR) 00000100 CA INPUT X = DATA ARRAY R4 00000110 CA INPUT N = NUMBER OF SAMPLES (IF MORE THAN I4 00000120 CA 500 ONLY FIRST 500 PLOTTED) 00000130 CA IN/OUT NA = NUMBER OF FRONT-END SAMPLES TO PLOT I4 00000140 CA UP TO FULL SCALE (NA=0 OK) 00000150 CA IN/OUT NB = NUMBER OF TAIL-END SAMPLES TO I4 00000160 CA PLOT UP TO FULL SCALE (NB=0 OK) 00000170 CA INPUT IFLAG = -1 PHASE PLOT BETWEEN -PI TO +PI I4 00000180 CA = 0 ORDINARY PLOT OF PLUS AND MINUS 00000190 CA VALUES 00000200 CA = +1 AMPLITUDE PLOT--PLUS VALUES ONLY 00000210 CA INPUT IPR = PRINTER UNIT NUMBER I4 00000220 CA 00000230 CA 00000240 CA THIS ROUTINE PRODUCES A PRINTER PAGE PLOT OF THE 00000250 CA AUTOCORRELATION. 00000260 CA 00000270 CAEND 00000280 C 00000290 C SUBROUTINES CALLED: NONE 00000300 C 00000310 C EJECT 00000320 C 00000330 SUBROUTINE SAPGPT (X, N, NA, NB, IFLAG, IPR) 00000340 C 00000350 DIMENSION X(1) 00000360 INTEGER Y(101,7) 00000361 CHARACTER*2 CHAR(7),B,H,V,BUF(101) 00000370 DATA PI/3.141593/ 00000380 DATA TPI/6.283185/ 00000381 DATA B/' '/ 00000390 DATA H/'--'/ 00000391 DATA V/'II'/ 00000392 DATA CHAR/'11','22','33','44','55','AA','BB'/ 00000400 C 00000410 C ***SPECIAL PRINT LABEL PECULIAR TO DDLOG 00000420 C APPLICATION*** 00000430 WRITE(IPR, 9000 ) 00000440 C ***END SPECIAL PRINT*** 00000450 C 00000460 NN=N 00000470 IF (N.GT.500) NN=500 00000480 C 00000490 DO 10 00000500 * I=1,101 00000510 C 00000520 DO 10 00000530 * J=1,7 00000540 C 00000550 10 Y(I,J)=0 00000560 C 00000570 PK=PI 00000580 IF(IFLAG.LT.0) GO TO 30 00000590 PK=0. 00000600 C 00000610 DO 20 00000620 * I=1,NN 00000630 Q= ABS (X(I)) 00000640 IF (Q.GT.PK) PK=Q 00000650 C 00000660 20 CONTINUE 00000670 C 00000680 IF(IFLAG.GT.0) PK=.5*PK 00000690 IF(PK.EQ.0.) PK=1. 00000700 C 00000710 30 IF(NA.LE.0) GO TO 50 00000720 NNA=NA 00000730 IF(NA.GT.101) NA=101 00000740 PKA=0. 00000750 C 00000760 DO 40 00000770 * I=1,NNA 00000780 Q= ABS(X(I)) 00000790 IF (Q.GT.PKA)PKA=Q 00000800 C 00000810 40 CONTINUE 00000820 C 00000830 IF(IFLAG.GT.0)PKA=.5*PKA 00000840 IF(PKA.EQ.0.)PKA=1. 00000850 C 00000860 50 IF(NB.LE.0) GO TO 70 00000870 NNB=NB 00000880 IF(NB.GT.101) NB=101 00000890 PKB=0. 00000900 C 00000910 DO 60 00000920 * I=1,NNB 00000930 Q=ABS(X(N-I+1)) 00000940 IF (Q.GT.PKB)PKB=Q 00000950 C 00000960 60 CONTINUE 00000970 C 00000980 IF(IFLAG.GT.0) PKB=.5*PKB 00000990 IF(PKB.EQ.0.)PK=1. 00001000 C 00001010 70 K=(NN+99)/100 00001020 C 00001030 DO 80 00001040 * I=1,K 00001050 M=NN-(I-1)*100 00001060 IF(M.GT.101)M=101 00001070 C 00001080 DO 80 00001090 * J=1,M 00001100 QQ= X((I-1)*100+J) 00001110 Q=ABS(QQ) 00001120 IF(IFLAG.LT.0)Q=AMOD(Q+PI,TPI)-PI 00001130 IF(QQ.LT.0.)Q=-Q 00001140 IF(IFLAG.GT.0)Q=Q-PK 00001150 C 00001160 80 Y(J,I)=INT(31.5-30.*Q/PK) 00001170 C 00001180 IF(NA.EQ.0) GO TO 100 00001190 C 00001200 DO 90 00001210 * J=1,NNA 00001220 Q =X(J) 00001230 IF(IFLAG.GT.0)Q=Q-PKA 00001240 C 00001250 90 Y(J,6)=INT(31.5-30.*Q/PKA) 00001260 C 00001270 100 IF(NB.EQ.0) GO TO 120 00001280 C 00001290 DO 110 00001300 * J=1,NNB 00001310 Q=X(N-J+1) 00001320 IF(IFLAG.GT.0) Q=Q-PKB 00001330 C 00001340 110 Y(102-J,7)=INT(31.5-30.*Q/PKB) 00001350 C 00001360 120 DO 180 00001370 * I=1,61 00001380 IF(I.NE.1.AND.(I.NE.31.OR.IFLAG.GT.0).AND.I.NE.61) 00001390 * GO TO 140 00001400 C 00001410 DO 130 00001420 * J=2,100 00001430 C 00001440 130 BUF(J)=H 00001450 C 00001460 GO TO 160 00001470 C 00001480 140 DO 150 00001490 * J=2,100 00001500 C 00001510 150 BUF(J)=B 00001520 C 00001530 160 BUF(1)=V 00001540 BUF(101)=V 00001550 C 00001560 DO 170 00001570 * J=1,101 00001580 C 00001590 DO 170 00001600 * K=1,7 00001610 C 00001620 170 IF(Y(J,K).EQ.I)BUF(J)=CHAR(K) 00001630 C 00001640 180 WRITE(IPR, 9010 )(BUF(L),L=1,101) 00001650 RETURN 00001660 C 00001670 9000 FORMAT('0'/'0 ...AUTOCORRELATION FOR THIS TRACE...'/'0') 00001680 C 00001690 9010 FORMAT(10X,101A1) 00001700 END 00001710