CTITLEARABM -- MEAN OF ABSOLUTE VALUES 00010001 C*********************************************************************** C COPYRIGHT ATLANTIC RICHFIELD COMPANY 1991 * C*********************************************************************** CA AUTHOR FRANCIS COLLINS 00020000 CA DESIGNER H. HOOGSTRAAT 00030000 CA LANGUAGE FORTRAN 00040002 CA SYSTEM IBM AND CRAY 00050002 CA WRITTEN 00060000 C REVISED 07-11-86 BY ESN. FOR USE OF CRAY ROUTINE ON IBM. 00070002 CA 00080000 CA CALL ARABM (A, B, N, L) 00090000 CA INPUT A = REAL ARRAY R4 00100000 CA OUTPUT B = REAL ARRAY R4 00110000 CA INPUT N = NUMBER OF ELEMENTS IN A I4 00120000 CA INPUT L = WINDOW LENGTH IN POINTS I4 00130000 CA 00140000 CA 00150000 CA ARABM SLIDES A WINDOW OF L POINTS ALONG THE INPUT ARRAY A 00160000 CA AND WRITES IN ARRAY B THE SUM OF ABSOLUTE VALUES DIVIDED BY 00170000 CA THE NUMBER OF VALUES IN THE WINDOW, NOT COUNTING TWO OR MORE 00180000 CA ZEROS. THE OUTPUT LENGTH OF B WILL BE EQUAL TO N - L + 1. 00190000 CAEND 00200000 SUBROUTINE ARABM (A, B, N, L) 00210000 C 00220000 REAL A (N) 00230000 REAL B (N) 00240000 LOGICAL Z1 00250000 LOGICAL Z2 00260000 C 00270000 C PRELIMINARY OPERATIONS. 00280000 F = FLOAT (L) 00290000 S = 0.0 00300000 Z1 = .FALSE. 00310000 Z2 = .FALSE. 00320000 C 00330000 C STARTING LOOP. CALCULATE B(1) WITH WINDOW IN INITIAL POSITION. 00340000 C AT EACH A(I), THERE ARE FOUR CASES. 00350000 C NOTE ZERO FLAG IS OFF WHEN I = 1. 00360000 C FLAG Z2 IS USED IN THIS LOOP TO ESTABLISH VALUE 00370000 C TO BE USED AT START OF GENERAL LOOP. 00380000 C CASE 1. A(I) .NE. 0. 00390000 C A(I) NOT IN A SEQUENCE OF CONSECUTIVE ZEROS. 00400000 C TURN OFF ZERO INDICATOR FLAG (Z2). 00410000 C ADD ABS A(I) TO SUM S. 00420000 C CASE 2. A(I) = 0 AND ZERO FLAG ON. 00430000 C A(I-1) AND A(I) ARE CONSECUTIVE ZEROS. 00440000 C SUBTRACT ONE FROM WINDOW LENGTH (DIVISOR). 00450000 C NOT NECESSARY TO ADD ABS A(I) TO SUM S. 00460000 C CASE 3. A(I) = 0, ZERO FLAG OFF, AND A(I+1) .EQ. 0. 00470000 C A(I) AND A(I+1) ARE CONSECUTIVE ZEROS. 00480000 C TURN ON ZERO FLAG. 00490000 C SUBTRACT ONE FROM WINDOW LENGTH (DIVISOR). 00500000 C NOT NECESSARY TO ADD ABS A(I) TO SUM S. 00510000 C CASE 4. A(I) = 0, ZERO FLAG OFF, AND A(I+1) .NE. 0. 00520000 C NO ZERO BEFORE OR AFTER A(I). 00530000 C NOT NECESSARY TO ADD ABS A(I) TO SUM S. 00540000 C NO ACTION REQUIRED. 00550000 C 00560000 DO 150 I = 1, L 00570000 IF (A(I) .NE. 0) GO TO 110 00580000 IF (Z2) GO TO 120 00590000 IF (A(I+1) .EQ. 0.0) GO TO 130 00600000 GO TO 140 00610000 C 00620000 C CASE 1. A(I) .NE. 0 00630000 110 Z2 = .FALSE. 00640000 S = S + ABS (A(I)) 00650000 GO TO 150 00660000 C 00670000 C CASE 2. A(I) = 0 AND ZERO FLAG ON. 00680000 120 F = F - 1.0 00690000 GO TO 150 00700000 C 00710000 C CASE 3. A(I) = 0, ZERO FLAG OFF, AND A(I+1) .EQ. 0. 00720000 130 Z2 = .TRUE. 00730000 F = F - 1.0 00740000 GO TO 150 00750000 C 00760000 C CASE 4. A(I) = 0, ZERO FLAG OFF, AND A(I+1) .NE. 0. 00770000 140 CONTINUE 00780000 C 00790000 150 CONTINUE 00800000 B(1) = 0.0 00810000 IF (F .GT. 0.0) B(1) = S/F 00820000 C 00830000 C GENERAL LOOP FOR ALL POSITIONS OF WINDOW EXCEPT THE FIRST. 00840000 C THE SUM IS ADJUSTED BY SUBTRACTING AND ADDING AS THE WINDOW 00850000 C IS MOVED ALONG THE DATA. 00860000 C POSITION OF WINDOW: A(I+1) TO A(I+L). 00870000 C SUBTRACT: CONTRIBUTION OF A(I), LOST WHEN WINDOW MOVED. 00880000 C ADD: CONTRIBUTION OF A(I+L), GAINED WHEN WINDOW MOVED. 00890000 C AT BOTH ENDS OF WINDOW, ADJUST WINDOW LENGTH (DIVISOR) FOR 00900000 C CONSECUTIVE ZEROS. 00910000 C OUTPUT: B(I+1), I = 1, N-L. B(2) TO B(N-L+1). 00920000 C 00930000 C AT START (LEFT) OF WINDOW, 00940000 C A(I) IS NOW OUTSIDE WINDOW, A(I+1) IS FIRST POINT OF WINDOW. 00950000 C THERE ARE FOUR CASES. 00960000 C CASE 1. A(I) .NE. 0. 00970000 C NO REASON TO INCREASE WINDOW LENGTH (DIVISOR). 00980000 C TURN OFF ZERO INDICATOR FLAG (Z1). 00990000 C SUBTRACT ABS A(I) FROM SUM S. 01000000 C CASE 2. A(I) = 0 AND ZERO FLAG ON. 01010000 C A(I-1) AND A(I) ARE CONSECUTIVE ZEROS. 01020000 C A(I) HAS JUST MOVED OUT OF WINDOW. 01030000 C ADD ONE TO WINDOW LENGTH (DIVISOR). 01040000 C NOT NECESSARY TO SUBTRACT ABS A(I) FROM SUM S. 01050000 C CASE 3. A(I) = 0, ZERO FLAG OFF, AND A(I+1) .EQ. 0. 01060000 C A(I) AND A(I+1) ARE CONSECUTIVE ZEROS. 01070000 C A(I) HAS JUST MOVED OUT OF WINDOW. 01080000 C TURN ON ZERO FLAG. 01090000 C SUBTRACT ONE FROM WINDOW LENGTH (DIVISOR). 01100000 C NOT NECESSARY TO SUBTRACT ABS A(I) FROM SUM S. 01110000 C CASE 4. A(I) = 0, ZERO FLAG OFF, AND A(I+1) .NE. 0. 01120000 C NO ZERO BEFORE OR AFTER A(I). 01130000 C NOT NECESSARY TO SUBTRACT ABS A(I) FROM SUM S. 01140000 C NO ACTION REQUIRED. 01150000 C 01160000 M = N - L 01170000 DO 360 I = 1, M 01180000 IF (A(I) .NE. 0) GO TO 210 01190000 IF (Z1) GO TO 220 01200000 IF (A(I+1) .EQ. 0.0) GO TO 230 01210000 GO TO 240 01220000 C 01230000 C CASE 1. A(I) .NE. 0 01240000 210 Z1 = .FALSE. 01250000 S = S - ABS (A(I)) 01260000 IF (S .LT. 0.0) S = 0.0 01270000 GO TO 250 01280000 C 01290000 C CASE 2. A(I) = 0 AND ZERO FLAG ON. 01300000 220 F = F + 1.0 01310000 GO TO 250 01320000 C 01330000 C CASE 3. A(I) = 0, ZERO FLAG OFF, AND A(I+1) .EQ. 0. 01340000 230 Z1 = .TRUE. 01350000 F = F + 1.0 01360000 GO TO 250 01370000 C 01380000 C CASE 4. A(I) = 0, ZERO FLAG OFF, AND A(I+1) .NE. 0. 01390000 240 CONTINUE 01400000 C 01410000 250 CONTINUE 01420000 C 01430000 C AT END (RIGHT) OF WINDOW, 01440000 C A(I+L) IS NOW WITHIN WINDOW. 01450000 C THERE ARE FOUR CASES. 01460000 C CASE 1. A(I+L) .NE. 0. 01470000 C NO REASON TO DECREASE WINDOW LENGTH (DIVISOR). 01480000 C TURN OFF ZERO INDICATOR FLAG (Z2). 01490000 C ADD ABS A(I+L) TO SUM S. 01500000 C CASE 2. A(I+L) = 0 AND ZERO FLAG ON. 01510000 C A(I+L-1) AND A(I+L) ARE CONSECUTIVE ZEROS. 01520000 C A(I+L) HAS JUST MOVED INTO WINDOW. 01530000 C SUBTRACT ONE FROM WINDOW LENGTH (DIVISOR). 01540000 C NOT NECESSARY TO ADD ABS A(I+L) TO SUM S. 01550000 C CASE 3. A(I+L) = 0, ZERO FLAG OFF, AND A(I+L+1) .EQ. 0. 01560000 C A(I+L) AND A(I+L+1) ARE CONSECUTIVE ZEROS. 01570000 C A(I+L) HAS JUST MOVED INTO WINDOW. 01580000 C TURN ON ZERO FLAG. 01590000 C SUBTRACT ONE FROM WINDOW LENGTH (DIVISOR). 01600000 C NOT NECESSARY TO ADD ABS A(I+L) TO SUM S. 01610000 C CASE 4. A(I+L) = 0, ZERO FLAG OFF, AND A(I+L+1) .NE. 0. 01620000 C NO ZERO BEFORE OR AFTER A(I+L). 01630000 C NOT NECESSARY TO ADD ABS A(I+L) TO SUM S. 01640000 C NO ACTION REQUIRED. 01650000 C 01660000 IF (A(I+L) .NE. 0) GO TO 310 01670000 IF (Z2) GO TO 320 01680000 IF (I .EQ. M) GO TO 350 01690000 IF (A(I+L+1) .EQ. 0.0) GO TO 330 01700000 GO TO 340 01710000 C 01720000 C CASE 1. A(I+L) .NE. 0 01730000 310 Z2 = .FALSE. 01740000 S = S + ABS (A(I+L)) 01750000 GO TO 350 01760000 C 01770000 C CASE 2. A(I+L) = 0 AND ZERO FLAG ON. 01780000 320 F = F - 1.0 01790000 GO TO 350 01800000 C 01810000 C CASE 3. A(I+L) = 0, ZERO FLAG OFF, AND A(I+L+1) .EQ. 0. 01820000 330 Z2 = .TRUE. 01830000 F = F - 1.0 01840000 GO TO 350 01850000 C 01860000 C CASE 4. A(I+L) = 0, ZERO FLAG OFF, AND A(I+L+1) .NE. 0. 01870000 340 CONTINUE 01880000 C 01890000 350 B(I+1) = 0.0 01900000 IF (F .GT. 0.0) B(I+1) = S/F 01910000 C 01920000 360 CONTINUE 01930000 C 01940000 RETURN 01950000 END 01960000