CTITLESARMSS -- AUTOMATIC GAIN CONTROL SCALING 00000010 C*********************************************************************** C COPYRIGHT ATLANTIC RICHFIELD COMPANY 1991 * C*********************************************************************** CA AUTHOR W.J.BROWN 00000020 CA DESIGNER W.J.BROWN 00000030 CA LANGUAGE S/370 FORTRAN H 00000040 C WRITTEN 07-11-75 00000050 C REVISED 09-01-77 BY PC TO INCLUDE TIME VARYING 00000060 C SCALAR OPTIONS. 00000070 C REVISED 03-06-78 BY PC IGNORE ZEROS IN CALCULATION 00000080 C OF THE WINDOW LENGTH. 00000090 C REVISED 03-08-78 BY PC CORRECT COMPUTATION OF NW 00000093 C AND IEND. 00000096 C REVISED 03-17-78 BY PC CORRECT INTERPOLATION OF 00000097 C OF TVS AND MULTIPLIER OPTIONS. 00000098 CA 00000100 CA 00000110 CA CALL SARMSS (INTR,OTR,TYPSC,NSAMP,WINDL,WINDI,RMSOUD) 00000120 CA INPUT INTR = INPUT TRACE R4 00000130 CA INPUT OTR = OUTPUT TRACE R4 00000140 CA INPUT TYPSC = INPUT FOR TYPE OF SCALING I4 00000150 CA INPUT NSAMP = NUMBER OF SAMPLES I4 00000160 CA INPUT WINDL = WINDOW LENGTH I4 00000170 CA INPUT WINDI = ARRAY OF INPUT VALUES I4 00000180 CA INPUT RMSOUD = REFERENCE MEAN FOR SCALING I4 00000190 CA 00000200 CA 00000210 CA WINDL CONTAINS: 00000220 CA 1)WINDOW LENGTH FOR NORMAL AGCS, 00000230 CA 2)STARTING WINDOW LENGTH FOR AGCS USING A MULTIPLIER, 00000240 CA 3)TWO FOR WINDOWS THAT ARE INPUT THROUGH WINDI. 00000250 CA 00000260 CA WINDI CONTAINS: 00000270 CA 1)ZEROS FOR NORMAL AGCS, 00000280 CA 2)THREE TIMES THE NUMBER OF WINDOWS, THE MULTIPLIER, 00000290 CA THE ENDING WINDOW LENGTH AND THE FIRST CENTER TIME, 00000300 CA 3)WINDOW SPECIFICATIONS FOR INPUT WINDOWS, IN TRIPLETS 00000310 CA OF REFERENCE MEAN, WINDOW LENGTH AND CENTER TIME OF 00000320 CA THE WINDOW. 00000330 CA 00000340 CA RMSOUD CONTAINS: 00000350 CA 1)REFERENCE MEAN, 00000360 CA 2)NEGATIVE ONE, USED AS A FLAG TO INDICATE THAT THE 00000370 CA WINDOWS ARE INPUT THROUGH WINDI. 00000380 CA 00000390 CA 00000400 CA THE FUNCTION OF 'SARMSS' IS TO APPLY AUTO TIME VARIANT 00000410 CA AGC SCALING TO A TRACE. 00000420 CA 00000430 C EJECT 00000440 C OPERATIONS APPLIED. 00000450 C 00000460 C 1. FIRST THE TRACE IS SCANNED TO FIND THE 00000470 C FIRST LIVE VALUE.(NON-ZERO) 00000480 C 00000490 C 2. THEN THE TRACE IS SCANNED BACKWARDS, IF NOT 00000500 C KILLED BY STEP.1, IN ORDER TO FIND THE LAST LIVE 00000510 C SAMPLES. (NON-ZERO) 00000520 C 00000530 C 3. A SET OF SCALE FACTORS IS COMPUTED FOR EACH SAMPLE 00000540 C IN ONE OF THREE WAYS; 00000550 C 00000560 C EITHER: 00000570 C IST = INDEX OF FIRST LIVE SAMPLE. 00000580 C IEND = INDEX OF LAST LIVE SAMPLE. 00000590 C WL = RMS OR ABS SCALE WINDOW LENGTH IN SAMPLES. 00000600 C RMSOUT = DESIRED OUTPUT RMS LEVEL. 00000610 C 00000620 C A CONSTANT SCALE FACTOR FOR 00000630 C SAMPLE(I,I=IST,IST+WL/2) WHICH IS EQUAL TO 00000640 C RMSOUT/RMS(SAMPLE(K),K=IST,IST+WL). 00000650 C 00000660 C TIME VARYING SCALE FACTORS FOR 00000670 C SAMPLE(I,I=IST+WL/2,IEND-WL/2) WHICH ARE EQUAL TO 00000680 C RMSOUT/RMS(SAMPLE(K),K=I-WL/2,I+WL/2). 00000690 C 00000700 C A CONSTANT SCALE FACTOR FOR 00000710 C SAMPLE(I,I=IEND-WL/2,IEND) WHICH IS EQUAL TO 00000720 C RMSOUT/RMS(SAMPLE(K),K=IEND-WL,IEND). 00000730 C 00000740 C ALL THE SCALE FACTORS WILL BE WRITTEN IN THE 00000750 C OUTPUT TRACE AREA FROM OTR(1) TO OTR(NOSAMP). 00000760 C 00000770 C OR: 00000780 C STARTING AT A GIVEN TIME WITH A GIVEN WINDOW LENGTH 00000790 C A SCALE FACTOR IS COMPUTED. THEN THE WINDOW LENGTH 00000800 C IS MULTIPLE BY A GIVEN MULTIPLIER, AND ANOTHER SCALE 00000810 C FACTOR IS COMPUTED. THEN INTERPOLATION OCCURS BETWEEN 00000820 C THE TWO FACTORS. THIS CONTINUES UNTIL THE WINDOW LENGTH 00000830 C IS GREATER THAN A GIVEN ENDING WINDOW LENGTH, THEN THE 00000840 C ENDING WINDOW LENGTH IS APPLIED TO THE END OF THE RECORD. 00000850 C 00000860 C OR: 00000870 C EACH WINDOW IS INPUT SEPARATELY, AS A REFERENCE MEAN, 00000880 C WINDOW LENGTH, CENTER TIME TRIPLET. USING THESE WINDOWS 00000890 C SCALE FACTORS ARE COMPUTED, AND INTERPOLATION DONE BETWEEN00000900 C THEM. 00000910 C 00000920 C 4. THE INPUT TRACE IS SCALED BY MULTIPLYING EACH DATA 00000930 C SAMPLE BY ITS CORRESPONDING SCALE FACTOR, AND STORING 00000940 C IT IN OTR. 00000950 C 00000960 C 00000970 C EJECT 00000980 C LOCAL OR INTERNAL ARRAYS. 00000990 C 00001000 C INTR ( 1) = TRACE AREA FOR THE INPUT R4 00001010 C OTR ( 1) = TRACE AREA FOR THE SCRATCH AND OUTPUT R4 00001020 C WINDI ( 97) = ARRAY OF INPUT VARIABLES I4 00001030 C 00001040 C LOCAL OR INTERNAL VARIABLES AND CONSTANTS. 00001050 C 00001060 C AABS = AGC SCALING BY ABSOLUTE VALUE I4 00001070 C ARMS = AGC SCALING BY ROOT MEAN SQUARE I4 00001080 C RMSOUT = REFERENCE MEAN FOR SCALING R4 00001090 C WINDL = WORK ARRAY R4 00001100 C WINDLN = WINDOW LENGTH IN SAMPLES I4 00001110 C WH = HALF THE WINDOW LENGTH I4 00001120 C W = WINDOW LENGTH (WH*2 + 1) I4 00001130 C NSAMP = NUMBER OF SAMPLES I4 00001140 C NN = NUMBER OF SAMPLES MINUS ONE I4 00001150 C IST = INDEX OF THE FIRST LIVE SAMPLE I4 00001160 C IEND = INDEX OF THE LAST LIVE SAMPLE I4 00001170 C 00001180 C EJECT 00001190 SUBROUTINE SARMSS (INTR,OTR,TYPSC,NSAMP,WINDL,WINDI,RMSOUD) 00001200 IMPLICIT INTEGER (A-Z) 00001210 EXTERNAL S1ATP 00001220 REAL INTR (1) 00001230 REAL OTR (1) 00001240 REAL WINDL (1) 00001250 INTEGER WINDI (97) 00001260 INTEGER AABS /'AABS'/ 00001270 INTEGER ARMS /'ARMS'/ 00001280 REAL OLD1 00001290 REAL OLD2 00001300 REAL RMSOUT 00001310 REAL DIFF 00001320 REAL SUMSQ 00001330 REAL NEWW 00001340 REAL FAVM 00001350 REAL NONZRO 00001360 REAL TEMP1 00001370 REAL TEMP2 00001380 REAL TEMP 00001390 EQUIVALENCE (TEMP,WINDLN) 00001400 RMSOUT = RMSOUD 00001410 TEMP = WINDL (1) 00001420 FUDGEF = 1 00001430 CD 00001440 C DEBUG PRINT 00001450 C 00001460 C WRITE (6, 9010) TYPSC,NSAMP,WINDL,RMSOUD,WINDI(1),WINDLN 00001470 C9010 FORMAT (/1X,'TYPSC =',A6,' NSAMP =',I6,' WINDL =',I6,' RMSOUD =', 00001480 C * I6,' WINDI(1) =',I6,' WINDLN =',I6/) 00001490 C ENDWRT = WINDI(1) + 3 00001500 C WRITE (6, 9020) (WINDI(I),I=2,ENDWRT) 00001510 C9020 FORMAT (1X,12I10) 00001520 CD 00001530 WH = WINDLN / 2 00001540 W = WH * 2 + 1 00001550 IF (W .EQ. WINDLN) FUDGEF = 0 00001560 CALL ARSET (OTR,NSAMP,0.) 00001570 C 00001580 C FIND THE FIRST LIVE VALUE OF THE TRACE 00001590 C 00001600 NN = NSAMP - 1 00001610 C 00001620 DO 10 00001630 * I = 1, NN 00001640 IF (INTR(I).NE.0.) GO TO 20 00001650 C 00001660 10 CONTINUE 00001670 C 00001680 GO TO 290 00001690 C 00001700 20 IST = I 00001710 C 00001720 C FIND THE LAST LIVE VALUE OF THE TRACE 00001730 C 00001740 II = NSAMP 00001750 C 00001760 DO 30 00001770 * I = 1, NN 00001780 IF (INTR(II).NE.0.) GO TO 40 00001790 II = II - 1 00001800 C 00001810 30 CONTINUE 00001820 C 00001830 GO TO 290 00001840 C 00001850 40 IEND = II 00001860 NW = IEND - IST + 1 00001870 NW = (( NW / 2 ) * 2 ) - 1 00001880 IF (NW.LT.3) GO TO 290 00001890 IEND = IST + NW - 1 00001900 C 00001910 C CHECK FOR WINDOW GREATER THAN NUMBER OF SAMPLES 00001920 C 00001930 IF (W.GT.NW) W = NW 00001940 WH = W / 2 00001950 IF ( WH .LT. 1 ) GO TO 290 00001960 C 00001970 C SCALE TRACE DOWN TO PREVENT OVERFLOW IN THE 00001980 C NEXT OPERATION 00001990 C 00002000 C CHECK FOR RMS OR ABS TYPE AGC 00002010 C 00002020 IF ( TYPSC .EQ. ARMS ) GO TO 50 00002030 IF ( TYPSC .EQ. AABS ) GO TO 150 00002040 C 00002050 C DEVELOP ENERGY TRACE BY RMS METHOD 00002060 C 00002070 50 IF ( WINDI(1) .EQ. 0 ) GO TO 140 00002080 SUMSQ = 0. 00002090 C 00002100 C CHECK FOR INPUT TRIPLETS. 00002110 C 00002120 IF (RMSOUT .EQ. -1.0) WH = WINDI(3) / 2 00002130 W = WH * 2 + 1 00002140 NEWW = W 00002150 C 00002160 C L IS RELATED TO THE NUMBER OF WINDOWS. 00002170 C I IS THE START OF THE WINDOWS. 00002180 C 00002190 L = WINDI (1) 00002200 I = WINDI (4) - WH 00002210 CD 00002220 CD WRITE (6, 9040 ) RMSOUT,WH,W,L,I 00002230 C9040 FORMAT(' RMSOUTR=',F8.2,' WH =',I6,' W =',I6,' L =',I5,' I =',I6/)00002240 CD 00002250 C 00002260 C COMPUTE RMS AGC SCALAR. 00002270 C 00002280 DO 100 00002290 * K = 1, L, 3 00002300 CD 00002310 CD WRITE (6, 9050 ) K,W,WH,I 00002320 C9050 FORMAT(1X,' K =',I6,' W =',I6,' WH =',I6,' I =',I6) 00002330 CD 00002340 C 00002350 C ARSMFS SUMS THE SQUARES OF THE ELEMENTS OF INTR, 00002360 C FROM I TO I+W AND PUTS THE SUM IN SUMSQ. 00002370 C 00002380 CALL ARSMFS (INTR(I),W,SUMSQ) 00002390 C 00002400 ENDDO = I + W - 1 00002410 NONZRO = 0.0 00002420 ZROFLG = 0 00002430 C 00002440 DO 55 00002450 * M = I, ENDDO 00002460 IF (INTR(M) .NE. 0.0) GO TO 52 00002470 IF (ZROFLG .EQ. 1) GO TO 55 00002480 IF (M+1 .GT. ENDDO) GO TO 58 00002490 IF (INTR(M+1) .NE. 0.0) GO TO 52 00002500 ZROFLG = 1 00002510 GO TO 55 00002520 C 00002530 52 NONZRO = NONZRO + 1 00002540 ZROFLG = 0 00002550 C 00002560 55 CONTINUE 00002570 C 00002580 58 IF (NONZRO .EQ. 0.0) NONZRO = 1.0 00002590 C 00002600 OTR( I+WH ) = SQRT ( SUMSQ / NONZRO ) 00002610 CD 00002620 CD WRITE (6, 9050) NONZRO, W, SUMSQ, OTR(I+WH), I, WH 00002630 C9050 FORMAT (1X,'NONZRO =',F5.1,' W =',I3,' SUMSQ =',F5.1, 00002640 CD * ' OTR(I+WH) =',F4.1,' I =',I4,' WH =',I3) 00002650 C 00002660 C SAVE VALUES FOR USE IN INTERPOLATION. 00002670 C 00002680 OLD2 = OLD1 00002690 OLD1 = OTR(I+WH) 00002700 IOLDI2 = IOLDI1 + 2 00002710 IOLDI1 = I + WH - 1 00002720 C 00002730 C NO UPDATING NECESSARY IF LAST TIME THROUGH. 00002740 C 00002750 IF (RMSOUT .EQ. -1.0) GO TO 60 00002760 IF (K .EQ. L) GO TO 70 00002770 C 00002780 C IF A MULTIPLIER IS USED, UPDATE I (START TIME) 00002790 C AND W (WINDOW LENGTH) AND CONTINUE. 00002800 C 00002810 C IF THE WINDOW EXTENDS BEYOND THE END OF THE 00002820 C RECORD, THEN GO TO THE FINAL INTERPOLATION. 00002830 C 00002840 W = W - (1 * FUDGEF) 00002850 I = I + W 00002860 NEWW = NEWW * (WINDI(2) / 10000.0) 00002870 INEWW = NEWW 00002880 WH = INEWW / 2 00002890 IF (INEWW .GT. WINDI(3)) WH = WINDI(3) / 2 00002900 W = WH * 2 + 1 00002910 FUDGEF = 1 00002920 IF (W .EQ. INEWW) FUDGEF = 0 00002930 IF (W .EQ. WINDI(3)) FUDGEF = 0 00002940 ENDW = I + W 00002950 IF (ENDW .GT. NSAMP) GO TO 110 00002960 C 00002970 GO TO 70 00002980 C 00002990 C IF TRIPLETS, UPDATE VALUES AND CONTINUE. 00003000 C 00003010 60 WINDL(I+WH) = WINDI(1+K) 00003020 OLDM2 = OLDM1 00003030 OLDM1 = WINDL(I+WH) 00003040 C 00003050 IF (K .EQ. L) GO TO 70 00003060 C 00003070 WH = WINDI(5+K) / 2 00003080 W = WH * 2 + 1 00003090 I = WINDI(6+K) - WH 00003100 C 00003110 ENDW = I + W 00003120 IF (ENDW .LE. NSAMP) GO TO 70 00003130 W = NSAMP - I 00003140 WH = W / 2 00003150 IF (WH .LT. 1) GO TO 110 00003160 C 00003170 C NO INTERPOLATION IF FIRST TIME THROUGH. 00003180 C 00003190 70 IF (K .EQ. 1) GO TO 100 00003200 CD 00003210 CD WRITE (6, 9060 ) OLD1,OLD2,IOLDI1,IOLDI2,W,WH,K,NEWW 00003220 C9060 FORMAT(1X,'OLD1 =',F6.2,' OLD2 =',F6.2,' IOLDI1 =',I6,' IOLDI2 =',00003230 CD * I6,' W =',I6,' WH =',I6,' K =',I6,' NEWW =',F8.4) 00003240 CD 00003250 C 00003260 C INTERPOLATE BETWEEN LAST TWO COMPUTED VALUES. 00003270 C 00003280 75 DIFF = IOLDI1 - IOLDI2 + 2 00003290 IF (RMSOUT .NE. -1.0) GO TO 80 00003300 DIFFM = (OLDM1 - OLDM2) / DIFF 00003310 C 00003320 80 TEMP1 = OLD1 00003330 TEMP2 = OLD2 00003340 IF (OLD1 .NE. 0.0) GO TO 83 00003350 TEMP1 = OLD2 00003352 OTR(IOLDI1+1) = OLD2 00003354 C 00003356 83 IF (OLD2 .NE. 0.0) GO TO 86 00003360 TEMP2 = OLD1 00003363 OTR(IOLDI2-1) = OLD1 00003366 C 00003370 86 DIFF = (TEMP1 - TEMP2) / DIFF 00003380 C 00003390 DO 90 00003400 * J = IOLDI2, IOLDI1 00003410 OTR(J) = OTR(J-1) + DIFF 00003420 C 00003430 IF (RMSOUT .NE. -1.0) GO TO 90 00003440 WINDL(J) = WINDL(J-1) + DIFFM 00003450 C 00003460 90 CONTINUE 00003470 C 00003480 100 CONTINUE 00003490 C 00003500 GO TO 130 00003510 C 00003520 C INTERPOLATE BETWEEN LAST TWO POINTS. 00003530 C 00003540 110 DIFF = IOLDI1 - IOLDI2 + 2 00003550 IF (RMSOUT .NE. -1.0) GO TO 115 00003560 DIFFM = (OLDM1 - OLDM2) / DIFF 00003570 C 00003580 115 TEMP1 = OLD1 00003590 TEMP2 = OLD2 00003600 IF (OLD1 .NE. 0.0) GO TO 117 00003610 TEMP1 = OLD2 00003612 OTR(IOLDI1+1) = OLD2 00003614 C 00003616 117 IF (OLD2 .NE. 0.0) GO TO 118 00003620 TEMP2 = OLD1 00003623 OTR(IOLDI2-1) = OLD1 00003626 C 00003630 CD WRITE(6,9060) TEMP1, TEMP2, DIFF, IOLDI2, IOLDI1 00003640 C9060 FORMAT (1X,'TEMP1 =',F4.1,' TEMP2 =',F4.1,' DIFF =',F4.1, 00003650 CD * ' IOLDI2 =',I4,' IOLDI1 =',I4) 00003660 CD 00003670 118 DIFF = (TEMP1 - TEMP2) / DIFF 00003680 C 00003690 DO 120 00003700 * J = IOLDI2, IOLDI1 00003710 OTR(J) = OTR(J-1) + DIFF 00003720 C 00003730 IF (RMSOUT .NE. -1.0) GO TO 120 00003740 WINDL(J) = WINDL(J-1) + DIFFM 00003750 C 00003760 120 CONTINUE 00003770 C 00003780 C EXTEND SCALAR FACTOR STRAIGHT OUT ON ENDS. 00003790 C 00003800 130 W1 = IEND - (IOLDI1 + 1) 00003810 CD 00003820 CD WRITE (6,9070) IST,IEND,IOLDI1,W1 00003830 C9070 FORMAT(1X,'IST =',I6,' IEND =',I6,' IOLDI1 =',I6, 00003840 CD * ' W1 =',I6//) 00003850 CD 00003860 IF (W1 .LE. 0) GO TO 135 00003870 CALL ARSET(OTR(IOLDI1+2),W1,OTR(IOLDI1+1)) 00003880 IF (RMSOUT .NE. -1.0) GO TO 135 00003890 CALL ARSET(WINDL(IOLDI1+2),W1,WINDL(IOLDI1+1)) 00003900 C 00003910 135 IF (IST .GT. WINDI(4)) GO TO 250 00003920 J = WINDI(4) - IST 00003930 CALL ARSET(OTR(IST),J,OTR(WINDI(4))) 00003940 IF (RMSOUT .NE. -1.0) GO TO 250 00003950 CALL ARSET(WINDL(IST),J,WINDL(WINDI(4))) 00003960 C 00003970 GO TO 250 00003980 C 00003990 C ARSQM SLIDES A WINDOW OF W POINTS ALONG THE 00004000 C INPUT ARRAY INTR AND WRITES IN ARRAY OTR THE SUM 00004010 C OF THE SQUARES DIVIDED BY W. THE OUTPUT LENGTH 00004020 C OF OTR EQUAL NW-W+1. 00004030 C 00004040 140 CALL ARSQM (INTR(IST),OTR(IST+WH),NW,W) 00004050 C 00004060 CC WRITE (6,9020) IST, WH, NW, W, NSAMP 00004070 C9020 FORMAT(1X,'IST =',I3,' WH =',I3,' NW =',I5,' W =',I3, 00004080 CC * ' NSAMP =',I5) 00004090 CC WRITE (6,9010) (INTR(IJ),IJ=1,NSAMP) 00004100 C9010 FORMAT(5X,5E20.10,/,5X,5E20.10,/) 00004110 CC WRITE (6,9010) (OTR (IJ),IJ=1,NSAMP) 00004120 C 00004130 C ARSQRT TAKE THE SQUARE ROOT OF OTR AND 00004140 C STORES IT IN OTR FOR (NW-W+1) POINTS 00004150 C 00004160 CALL ARSQRT (OTR(IST+WH),OTR(IST+WH),NW-W+1) 00004170 C 00004180 C ARSET SET THE CONTENTS OF (ORT(I),I=IST,1+WH) 00004190 C TO WHATS IN ORT(IST+WH) 00004200 C 00004210 CALL ARSET (OTR(IST),WH,OTR(IST+WH)) 00004220 C 00004230 C ARSET SET THE CONTENTS OF 00004240 C (OTR(I),I=IEND-WH+1,IEND) 00004250 C TO WHATS IN OTR(IEND-WH) 00004260 C 00004270 CALL ARSET (OTR(IEND-WH+1),WH,OTR(IEND-WH)) 00004280 GO TO 250 00004290 C 00004300 C DEVELOP ENERGY TRACE BY ABSOLUTE VALUE MEAN 00004310 C METHOD 00004320 C 00004330 150 IF ( WINDI(1) .EQ. 0 ) GO TO 240 00004340 SUMSQ = 0. 00004350 C 00004360 C CHECK FOR INPUT TRIPLETS. 00004370 C 00004380 IF (RMSOUT .EQ. -1.0) WH = WINDI(3) / 2 00004390 W = WH * 2 + 1 00004400 NEWW = W 00004410 C 00004420 C L IS RELATED TO THE NUMBER OF WINDOWS. 00004430 C I IS THE START OF THE WINDOWS. 00004440 C 00004450 L = WINDI (1) 00004460 I = WINDI (4) - WH 00004470 CD 00004480 C WRITE (6, 9080) RMSOUT,WH,W,L,I 00004490 C9080 FORMAT(' RMSOUTA=',F8.2,' WH =',I6,' W =',I6,' L =',I6,' I=',I6/) 00004500 CD 00004510 C 00004520 C COMPUTE ABS AGC SCALAR. 00004530 C 00004540 DO 200 00004550 * K = 1, L, 3 00004560 CD 00004570 C WRITE(6, 9090) K, W, WH, I 00004580 C9090 FORMAT(1X,' K =',I3,' W =',I5,' WH =',I4,' I =',I5) 00004590 CD 00004600 C 00004610 C ARSMFA RETURNS THE SUM OF THE ABSOUTE VALUES OF INTR, 00004620 C FROM I TO I+W AND PUTS THE SUM IN SUMSQ. 00004630 C 00004640 CALL ARSMFA (INTR(I),W,SUMSQ) 00004650 C 00004660 ENDDO = I + W - 1 00004670 NONZRO = 0.0 00004680 ZROFLG = 0 00004690 C 00004700 DO 155 00004710 * M = I, ENDDO 00004720 IF (INTR(M) .NE. 0.0) GO TO 152 00004730 IF (ZROFLG .EQ. 1) GO TO 155 00004740 IF (M+1 .GT. ENDDO) GO TO 158 00004750 IF (INTR(M+1) .NE. 0.0) GO TO 152 00004760 ZROFLG = 1 00004770 GO TO 155 00004780 C 00004790 152 NONZRO = NONZRO + 1 00004800 ZROFLG = 0 00004810 C 00004820 155 CONTINUE 00004830 C 00004840 158 IF (NONZRO .EQ. 0.0) NONZRO = 1.0 00004850 C 00004860 OTR( I+WH ) = SUMSQ / NONZRO 00004870 C 00004880 C SAVE VALUES FOR USE IN INTERPOLATION. 00004890 C 00004900 OLD2 = OLD1 00004910 OLD1 = OTR(I+WH) 00004920 IOLDI2 = IOLDI1 + 2 00004930 IOLDI1 = I + WH - 1 00004940 C 00004950 C NO UPDATING NECESSARY IF LAST TIME THROUGH. 00004960 C 00004970 IF (RMSOUT .EQ. -1.0) GO TO 160 00004980 IF (K .EQ. L) GO TO 170 00004990 C 00005000 C IF A MULTIPLIER IS USED, UPDATE I (START TIME) 00005010 C AND W (WINDOW LENGTH) AND CONTINUE. 00005020 C 00005030 C IF WINDOW EXTENDS BEYOND THE END OF THE RECORD 00005040 C THEN GO TO THE FINAL INTERPOLATION. 00005050 C 00005060 W = W - (1 * FUDGEF) 00005070 I = I + W 00005080 NEWW = NEWW * (WINDI(2) / 10000.0) 00005090 INEWW = NEWW 00005100 WH = INEWW / 2 00005110 IF (INEWW .GT. WINDI(3)) WH = WINDI(3) / 2 00005120 W = WH * 2 + 1 00005130 FUDGEF = 1 00005140 IF (W .EQ. INEWW) FUDGEF = 0 00005150 IF (W .EQ. WINDI(3)) FUDGEF = 0 00005160 ENDW = I + W 00005170 IF (ENDW .GT. NSAMP) GO TO 210 00005180 C 00005190 GO TO 170 00005200 C 00005210 C IF TRIPLETS, UPDATE VALUES AND CONTINUE. 00005220 C 00005230 160 WINDL(I+WH) = WINDI(1+K) 00005240 CD 00005250 C WRITE (6,9130) WINDL(I+WH),I,WH,OTR(I+WH) 00005260 C9130 FORMAT ('+',50X,'WINDL(I+WH) =',F8.2,' I =',I4,' WH =',I4, 00005270 C * ' OTR(I+WH) =',F8.3) 00005280 CD 00005290 OLDM2 = OLDM1 00005300 OLDM1 = WINDL(I+WH) 00005310 C 00005320 IF (K .EQ. L) GO TO 170 00005330 C 00005340 WH = WINDI(5+K) / 2 00005350 W = WH * 2 + 1 00005360 I = WINDI(6+K) - WH 00005370 C 00005380 ENDW = I + W 00005390 IF (ENDW .LE. NSAMP) GO TO 170 00005400 W = NSAMP - I 00005410 WH = W / 2 00005420 IF (WH .LT. 1) GO TO 210 00005430 C 00005440 C NO INTERPOLATION IF FIRST TIME THROUGH. 00005450 C 00005460 170 IF (K .EQ. 1) GO TO 200 00005470 CD 00005480 CD WRITE (6,9100) OLD1,OLD2,OLDI1,OLDI2,W,WH,K,ENDW 00005490 C9100 FORMAT(1X,'OLD1 =',F5.2,' OLD2 =',F5.2,' OLDI1 =',F5.2, 00005500 CD * ' OLDI2 =',F5.2,' W =',I6,' WH ='I6,' K =',I6,' ENDW =',I6)00005510 C 00005520 C INTERPOLATE BETWEEN LAST TWO COMPUTED VALUES. 00005530 C 00005540 175 DIFF = IOLDI1 - IOLDI2 + 2 00005550 IF (RMSOUT .NE. -1.0) GO TO 180 00005560 DIFFM = (OLDM1 - OLDM2) / DIFF 00005570 C 00005580 180 TEMP1 = OLD1 00005590 TEMP2 = OLD2 00005600 IF (OLD1 .NE. 0.0) GO TO 183 00005610 TEMP1 = OLD2 00005612 OTR(IOLDI1+1) = OLD2 00005614 C 00005616 183 IF (OLD2 .NE. 0.0) GO TO 186 00005620 TEMP2 = OLD1 00005623 OTR(IOLDI2-1) = OLD1 00005626 C 00005630 186 DIFF = (TEMP1 - TEMP2) / DIFF 00005640 C 00005650 DO 190 00005660 * J = IOLDI2, IOLDI1 00005670 OTR(J) = OTR(J-1) + DIFF 00005680 C 00005690 IF (RMSOUT .NE. -1.0) GO TO 190 00005700 WINDL(J) = WINDL(J-1) + DIFFM 00005710 C 00005720 190 CONTINUE 00005730 C 00005740 200 CONTINUE 00005750 C 00005760 GO TO 230 00005770 C 00005780 C INTERPOLATE BETWEEN LAST TWO POINTS. 00005790 C 00005800 210 DIFF = IOLDI1 - IOLDI2 + 2 00005810 IF (RMSOUT .NE. -1.0) GO TO 215 00005820 DIFFM = (OLDM1 - OLDM2) / DIFF 00005830 C 00005840 215 TEMP1 = OLD1 00005850 TEMP2 = OLD2 00005860 IF (OLD1 .NE. 0.0) GO TO 217 00005870 TEMP1 = OLD2 00005872 OTR(IOLDI1+1) = OLD2 00005874 C 00005876 217 IF (OLD2 .NE. 0.0) GO TO 218 00005880 TEMP2 = OLD1 00005883 OTR(IOLDI2-1) = OLD1 00005886 C 00005890 218 DIFF = (TEMP1 - TEMP2) / DIFF 00005900 C 00005910 DO 220 00005920 * J = IOLDI2, IOLDI1 00005930 OTR(J) = OTR(J-1) + DIFF 00005940 C 00005950 IF (RMSOUT .NE. -1.0) GO TO 220 00005960 WINDL(J) = WINDL(J-1) + DIFFM 00005970 C 00005980 220 CONTINUE 00005990 C 00006000 C EXTEND SCALAR FACTOR STRAIGHT OUT ON ENDS. 00006010 C 00006020 230 W1 = IEND - (IOLDI1 + 1) 00006030 CD 00006040 CD WRITE (6,9160) (WINDL(I),I=1,1000) 00006050 C9160 FORMAT (1X,15F8.2,' WINDL') 00006060 CD 00006070 IF (W1 .LE. 0) GO TO 235 00006080 CALL ARSET(OTR(IOLDI1+2),W1,OTR(IOLDI1+1)) 00006090 IF (RMSOUT .NE. -1.0) GO TO 235 00006100 CALL ARSET(WINDL(IOLDI1+2),W1,WINDL(IOLDI1+1)) 00006110 CD 00006120 CD WRITE (6,9120) W1,IEND,IOLDI1,WINDL(IOLDI1+1) 00006130 C9120 FORMAT(1X,'W1 =',I5,' IEND =',I5,' IOLDI1 =',I5,' WINDL(IOLDI1+1',00006140 CD * ') =',F8.2/) 00006150 CD 00006160 235 IF (IST .GT. WINDI(4)) GO TO 250 00006170 J = WINDI(4) - IST 00006180 CALL ARSET(OTR(IST),J,OTR(WINDI(4))) 00006190 IF (RMSOUT .NE. -1.0) GO TO 250 00006200 CALL ARSET(WINDL(IST),J,WINDL(WINDI(4))) 00006210 CD 00006220 C WRITE (6,9140) (OTR(I),I=1,1000) 00006230 C9140 FORMAT (1X,10F12.2,' OTR') 00006240 CD 00006250 C 00006260 GO TO 250 00006270 C 00006280 C ARABM SLIDES A WINDOW OF W POINTS ALONG THE 00006290 C INPUT ARRAY INTR AND WRITE IN ARRAY OTR SUM 00006300 C OF THE ABSOLUTE VALUES DIVIDED BY W. THE 00006310 C OUTPUT LENGTH OF OTR EQUAL NW-W+1. 00006320 C 00006330 240 CALL ARABM (INTR(IST),OTR(IST+WH),NW,W) 00006340 C 00006350 C ARSET SET THE CONTENTS OF (OTR(I),I=IST,1+WH) 00006360 C TO WHATS IN OTR(1+WH) 00006370 C 00006380 CALL ARSET (OTR(IST),WH,OTR(IST+WH)) 00006390 C 00006400 C ARSET SET THE CONTENTS OF 00006410 C (OTR(I),I=IEND-WH+1,IEND) 00006420 C TO WHATS IN ORT(IEND-WH) 00006430 C 00006440 CALL ARSET (OTR(IEND-WH+1),WH,OTR(IEND-WH)) 00006450 C 00006460 C SCALE DATA 00006470 C 00006480 C ARDVF DIVIDES THE ENTRIES IN INTR BY 00006490 C OTR AND STORES THE ANSWER IN OTR. 00006500 C 00006510 250 CALL ARDVF (INTR(IST),OTR(IST),OTR(IST),NW) 00006520 CC WRITE (6,9011) 00006530 C9011 FORMAT ('1') 00006540 CC WRITE (6,9010) (OTR (IJ),IJ=1,NSAMP) 00006550 CCC WRITE (6,9010) (INTR(IJ),IJ=IJ1,IJ2) 00006560 C ARMPF MULTIPLIES ENTRIES IN OTR BY 00006570 C THE ENTRIES IN THE WORK ARRAY 'WINDL' 00006580 C AND STORES THE ANSWER IN OTR. 00006590 C 00006600 IF (RMSOUT .NE. -1.0) GO TO 270 00006610 C 00006620 CALL ARMPF (WINDL(IST),OTR(IST),OTR(IST),NW) 00006630 GO TO 280 00006640 C 00006650 C ARMPFC MULTIPLIES ENTRIES IN OTR BY 00006660 C THE CONSTANT RMSOUT AND STORES THE 00006670 C ANSWER IN OTR. 00006680 C 00006690 270 CALL ARMPFC (OTR(IST),OTR(IST),RMSOUT,NW) 00006700 CCC WRITE (6,9010) (OTR(IJ),IJ=IJ1,IJ2) 00006710 C 00006720 C KILL ENDS OF TRACE BEFORE RETURN 00006730 C 00006740 280 CALL ARSET (OTR,IST-1,0.) 00006750 CALL ARSET (OTR(IEND+1),NSAMP-IEND,0.) 00006760 CD 00006770 C WRITE (6,9110) IST,IEND,NSAMP 00006780 C9110 FORMAT (1X,'IST =',I6,' IEND =',I6,' NSAMP =',I6/) 00006790 CD 00006800 RETURN 00006810 C 00006820 C DEAD TRACE RETURN 00006830 C 00006840 290 CALL ARSET (OTR,NSAMP,0.) 00006850 RETURN 00006860 END 00006870