CTITLESAFANR -- FAN FILTER REJECT APPLICATION 00000100 C*********************************************************************** C COPYRIGHT ATLANTIC RICHFIELD COMPANY 1991 * C*********************************************************************** CA AUTHOR RALPH E. MCMILLAN 00000200 CA DESIGNER RALPH E. MCMILLAN 00000300 CA LANGUAGE FORTRAN 00000400 CA SYSTEM IBM AND CRAY. 00000500 CA WRITTEN 04-10-80 00000600 C REVISED MO/DA/YR 00000700 C 12/11/83 NTS CHANGE INDEXES SO THAT AT THE EDGE,BACK- 00000800 C GROUND PERCENTAGE ARE NOT APPLIED TWICE. 00000900 C 03/21/84 ESN FOR THE CRAY. 00001000 C 12/05/84 LBL MADE SURE THIS CODE RAN ON IBM AND CRAY. 00001100 C 04/06/87 RDK CONTINUE TO FILTER BEYOND ONSET OF ALIAS 00001110 C OF RIGHT/LEFT LOW REJECT EDGE TO RIGHT/ 00001120 C LEFT LOW ROLLOFF EDGE. 00001130 CA 00001200 CA CALL SAFANR (X, INDEX, LLSLP, LHSLP, RLSLP, RHSLP, LFOURX, 00001300 CA LFOURY, LLROLL, LHROLL, RLROLL, RHROLL, BACK, 00001400 CA ALIFLG) 00001500 CA 00001600 CA I/O X = COMPLEX TRANFORM C4 00001700 CA INPUT INDEX = HORIZONTAL FREQUENCY INDEX I4 00001800 CA INPUT LLSLP = LEFT LOW DIP SLOPE R4 00001900 CA INPUT LHSLP = LEFT HIGH DIP SLOPE R4 00002000 CA INPUT RLSLP = RIGHT LOW DIP SLOPE R4 00002100 CA INPUT RHSLP = RIGHT HIGH DIP SLOPE R4 00002200 CA INPUT LFOURX = LENGTH OF VERTICAL TRANSFORM I4 00002300 CA INPUT LFOURY = LENGTH OF HORIZONTAL TRANSFORM I4 00002400 CA INPUT LLROLL = LEFT LOW ROLL-OFF AS A SLOPE R4 00002500 CA INPUT LHROLL = LEFT HIGH ROLL-OFF AS A SLOPE R4 00002600 CA INPUT RLROLL = RIGHT LOW ROLL-OFF AS A SLOPE R4 00002700 CA INPUT RHROLL = RIGHT HIGH ROLL-OFF AS A SLOPE R4 00002800 CA INPUT BACKG = BACKGROUND PERCENTAGE R4 00002900 CA INPUT ALIFLG = 0 - DO NOT FILTER ALIAS I4 00003000 CA = 1 - APPLY FILTER TO ALIASED DATA 00003100 CA 00003200 CA 00003300 CA SAFANR APPLIES A REJECT FAN FILTER TO THE TRANSFORM IN X. 00003400 C 00003500 C 00003600 C LOCAL VARIABLES AND CONSTANTS (INTERNAL TO SUBROUTINE). 00003700 C 00003800 C BOUND = LIMIT FOR FILTERING - DEPENDS ON ALIASING FLAG I4 00003900 C FACT = FACTOR USED IN ROLL-OFF R4 00004000 C FACT1 = FACTOR USED IN ROLL-OFF R4 00004100 C FOURX = VERITCAL TRANSFORM LENGTH CONVERTED TO REAL R4 00004200 C FOURY = HORIZONTAL TRANSFORM LENGTH CONVERTED TO REAL R4 00004300 C LF2 = LF21 + 1 I4 00004400 C LF21 = ONE HALF HORIZONTAL TRANSFORM LENGTH I4 00004500 C NN = USED AS INDEX TO ARRAY X I4 00004600 C RATIO = USED TO CALCULATE INDICIES FOR FILTER R4 00004700 C RR = USED TO CALCULATE BACKGROUND FACTOR FOR ROLL-OFF R4 00004800 C XNDEX = HORIZONTAL FREQUENCY INDEX CONVERTED TO REAL R4 00004900 C 00005000 C 00005100 SUBROUTINE SAFANR (X, INDEX, LLSLP, LHSLP, RLSLP, RHSLP, LFOURX, 00005200 * LFOURY, LLROLL, LHROLL, RLROLL, RHROLL, 00005300 * BACK, ALIFLG) 00005400 C 00005500 IMPLICIT INTEGER (A-Z) 00005600 C 00005700 C 00005800 C REAL VARIABLES IN PARAMETER LIST. 00005900 REAL BACK 00006000 REAL LHROLL 00006100 REAL LHSLP 00006200 REAL LLROLL 00006300 REAL LLSLP 00006400 REAL RHROLL 00006500 REAL RHSLP 00006600 REAL RLROLL 00006700 REAL RLSLP 00006800 REAL X (1) 00006900 C 00007000 C 00007100 C REAL VARIABLES AND CONSTANTS--LOCAL (INTERNAL TO SUBROUTINE). 00007200 REAL FACT 00007300 REAL FACT1 00007400 REAL FOURX 00007500 REAL FOURY 00007600 REAL RATIO 00007700 REAL RR 00007800 REAL XNDEX 00007900 C 00008000 C 00008100 FOURY = LFOURY 00008200 FOURX = LFOURX 00008300 XNDEX = INDEX 00008400 RATIO = XNDEX * FOURY / FOURX 00008500 IF (RATIO.LE.0.) RATIO = 1. / 1000. 00008600 C 00008700 LF21 = LFOURY / 2 00008800 LF2 = LF21 + 1 00008900 BOUND = LFOURY 00009000 IF (ALIFLG .EQ. 0) BOUND = LF21 00009100 IF (LHROLL .LE. 0) GO TO 240 00009200 C 00009300 C APPLY TOTAL REJECT ON LEFT DIP 00009400 C 00009500 I1 = LLROLL * RATIO + 0.5 00009600 I2 = LHROLL * RATIO + 0.5 00009700 C 00009800 IF (I1 .LE. 0) I1 = 1 00009900 IF (I2 .LE. 0) I2 = 1 00010000 IF (I1 .GT. BOUND .AND. ALIFLG .EQ. 0) GO TO 80 00010100 C 00010200 10 IF (I1 .LE. LFOURY) GO TO 20 00010300 I1 = I1 - LFOURY 00010400 I2 = I2 - LFOURY 00010500 GO TO 10 00010600 C 00010700 20 IF (ALIFLG .EQ. 0 .AND. I2 .GT. BOUND) I2 = BOUND 00010800 IF (I2 .LE. LFOURY) GO TO 60 00010900 C 00011000 DO 30 I = I1, BOUND 00011100 NN = I + I - 1 00011200 X(NN ) = X(NN ) * BACK 00011300 X(NN+1) = X(NN+1) * BACK 00011400 C 00011500 30 CONTINUE 00011600 C 00011700 IF (ALIFLG .EQ. 0) GO TO 80 00011800 C 00011900 40 I2 = I2 - LFOURY 00012000 IF (I2 .GT. LFOURY) GO TO 40 00012100 C 00012200 DO 50 I = 1, I2 00012300 NN = I + I - 1 00012400 X(NN ) = X(NN ) * BACK 00012500 X(NN+1) = X(NN+1) * BACK 00012600 C 00012700 50 CONTINUE 00012800 C 00012900 GO TO 80 00013000 C 00013100 60 DO 70 I = I1, I2 00013200 NN = I + I - 1 00013300 X(NN ) = X(NN ) * BACK 00013400 X(NN+1) = X(NN+1) * BACK 00013500 C 00013600 70 CONTINUE 00013700 C 00013800 C APPLY ROLL-OFF ON LEFT LOW SIDE 00013900 C 00014000 80 I1 = LLSLP * RATIO + 0.5 00014100 I2 = LLROLL * RATIO + 0.5 00014200 RR = 1. / (I2 - I1 + 1) 00014300 FACT = 1. - RR 00014400 IF (I1 .LE. 0) I1 = 1 00014500 IF (I2 .LE. 0) I2 = 1 00014600 IF (I1 .GT. BOUND .AND. ALIFLG .EQ. 0) GO TO 160 00014700 C 00014800 90 IF (I1 .LE. LFOURY) GO TO 100 00014900 I1 = I1 - LFOURY 00015000 I2 = I2 - LFOURY 00015100 GO TO 90 00015200 C 00015300 100 IF (ALIFLG .EQ. 0 .AND. I2 .GT. BOUND) I2 = BOUND 00015400 IF (I2 .LE. LFOURY) GO TO 140 00015500 C 00015600 DO 110 I = I1, BOUND 00015700 IF (FACT .LT. BACK) FACT = BACK 00015800 NN = I + I - 3 00015900 IF ( NN .LT. 0 ) GO TO 110 00016000 X(NN ) = X(NN ) * FACT 00016100 X(NN+1) = X(NN+1) * FACT 00016200 FACT = FACT - RR 00016300 C 00016400 110 CONTINUE 00016500 C 00016600 IF (ALIFLG .EQ. 0) GO TO 160 00016700 C 00016800 120 I2 = I2 - LFOURY 00016900 IF (I2 .GT. LFOURY) GO TO 120 00017000 C 00017100 DO 130 I = 1, I2 00017200 IF (FACT .LT. BACK) FACT = BACK 00017300 NN = I + I - 1 00017400 X(NN ) = X(NN ) * FACT 00017500 X(NN+1) = X(NN+1) * FACT 00017600 FACT = FACT - RR 00017700 C 00017800 130 CONTINUE 00017900 C 00018000 GO TO 160 00018100 C 00018200 140 DO 150 I = I1, I2 00018300 IF (FACT .LT. BACK) FACT = BACK 00018400 NN = I + I - 3 00018500 IF ( NN .LT. 0 ) GO TO 150 00018600 X(NN ) = X(NN ) * FACT 00018700 X(NN+1) = X(NN+1) * FACT 00018800 FACT = FACT - RR 00018900 C 00019000 150 CONTINUE 00019100 C 00019200 C APPLY ROLL-OFF ON LEFT HIGH SIDE 00019300 C 00019400 160 I1 = LHROLL * RATIO + 0.5 00019500 I2 = LHSLP * RATIO + 0.5 00019600 RR = 1. / (I2 - I1 + 1) 00019700 FACT = RR 00019800 IF (I1 .LE. 0) I1 = 1 00019900 IF (I2 .LE. 0) I2 = 1 00020000 IF (I1 .GT. BOUND .AND. ALIFLG .EQ. 0) GO TO 240 00020100 C 00020200 170 IF (I1 .LE. LFOURY) GO TO 180 00020300 I1 = I1 - LFOURY 00020400 I2 = I2 - LFOURY 00020500 GO TO 170 00020600 C 00020700 180 IF (ALIFLG .EQ. 0 .AND. I2 .GT. BOUND) I2 = BOUND 00020800 IF (I2 .LE. LFOURY) GO TO 220 00020900 C 00021000 DO 190 I = I1, BOUND 00021100 FACT1 = FACT 00021200 IF (FACT .LT. BACK) FACT1 = BACK 00021300 NN = I + I - 3 00021400 IF ( NN .LT. 0 ) GO TO 190 00021500 X(NN ) = X(NN ) * FACT1 00021600 X(NN+1) = X(NN+1) * FACT1 00021700 FACT = FACT + RR 00021800 C 00021900 190 CONTINUE 00022000 C 00022100 IF (ALIFLG .EQ. 0) GO TO 240 00022200 C 00022300 200 I2 = I2 - LFOURY 00022400 IF (I2 .GT. LFOURY) GO TO 200 00022500 C 00022600 DO 210 I = 1, I2 00022700 FACT1 = FACT 00022800 IF (FACT .LT. BACK) FACT1 = BACK 00022900 NN = I + I - 1 00023000 X(NN ) = X(NN ) * FACT1 00023100 X(NN+1) = X(NN+1) * FACT1 00023200 FACT = FACT + RR 00023300 C 00023400 210 CONTINUE 00023500 C 00023600 GO TO 240 00023700 C 00023800 220 DO 230 I = I1, I2 00023900 FACT1 = FACT 00024000 IF (FACT .LT. BACK) FACT1 = BACK 00024100 NN = I + I - 3 00024200 IF ( NN .LT. 0 ) GO TO 230 00024300 X(NN ) = X(NN ) * FACT1 00024400 X(NN+1) = X(NN+1) * FACT1 00024500 FACT = FACT + RR 00024600 C 00024700 230 CONTINUE 00024800 C 00024900 240 IF (RHROLL .LE. 0) GO TO 480 00025000 C 00025100 C APPLY TOTAL REJECT ON RIGHT DIP 00025200 C 00025300 I1 = RLROLL * RATIO + 0.5 00025400 I2 = RHROLL * RATIO + 0.5 00025500 C 00025600 IF (I1 .LE. 0) I1 = 1 00025700 IF (I2 .LE. 0) I2 = 1 00025800 IF (I1 .GT. BOUND .AND. ALIFLG .EQ. 0) GO TO 320 00025900 C 00026000 250 IF (I1 .LE. LFOURY) GO TO 260 00026100 I1 = I1 - LFOURY 00026200 I2 = I2 - LFOURY 00026300 GO TO 250 00026400 C 00026500 260 IF (ALIFLG .EQ. 0 .AND. I2 .GT. BOUND) I2 = BOUND 00026600 IF (I2 .LE. LFOURY) GO TO 300 00026700 C 00026800 DO 270 I = I1, BOUND 00026900 K = LFOURY + 1 - I 00027000 NN = K + K - 1 00027100 X(NN ) = X(NN ) * BACK 00027200 X(NN+1) = X(NN+1) * BACK 00027300 C 00027400 270 CONTINUE 00027500 C 00027600 IF (ALIFLG .EQ. 0) GO TO 320 00027700 C 00027800 280 I2 = I2 - LFOURY 00027900 IF (I2 .GT. LFOURY) GO TO 280 00028000 C 00028100 DO 290 I = 1, I2 00028200 K = LFOURY + 1 - I 00028300 NN = K + K - 1 00028400 X(NN ) = X(NN ) * BACK 00028500 X(NN+1) = X(NN+1) * BACK 00028600 C 00028700 290 CONTINUE 00028800 C 00028900 GO TO 320 00029000 C 00029100 300 DO 310 I = I1, I2 00029200 K = LFOURY + 1 - I 00029300 NN = K + K - 1 00029400 X(NN ) = X(NN ) * BACK 00029500 X(NN+1) = X(NN+1) * BACK 00029600 C 00029700 310 CONTINUE 00029800 C 00029900 C APPLY ROLL-OFF ON RIGHT LOW SIDE 00030000 C 00030100 320 I1 = RLSLP * RATIO + 0.5 00030200 I2 = RLROLL * RATIO + 0.5 00030300 RR = 1. / (I2 - I1 + 1) 00030400 FACT = 1. - RR 00030500 IF (I1 .LE. 0) I1 = 1 00030600 IF (I2 .LE. 0) I2 = 1 00030700 IF (I1 .GT. BOUND .AND. ALIFLG .EQ. 0) GO TO 400 00030800 C 00030900 330 IF (I1 .LE. LFOURY) GO TO 340 00031000 I1 = I1 - LFOURY 00031100 I2 = I2 - LFOURY 00031200 GO TO 330 00031300 C 00031400 340 IF (ALIFLG .EQ. 0 .AND. I2 .GT. BOUND) I2 = BOUND 00031500 IF (I2 .LE. LFOURY) GO TO 380 00031600 C 00031700 DO 350 I = I1, BOUND 00031800 IF (FACT .LT. BACK) FACT = BACK 00031900 K = LFOURY + 2 - I 00032000 IF ( K .GT. LFOURY ) GO TO 350 00032100 NN = K + K - 1 00032200 X(NN ) = X(NN ) * FACT 00032300 X(NN+1) = X(NN+1) * FACT 00032400 FACT = FACT - RR 00032500 C 00032600 350 CONTINUE 00032700 C 00032800 IF (ALIFLG .EQ. 0) GO TO 400 00032900 C 00033000 360 I2 = I2 - LFOURY 00033100 IF (I2 .GT. LFOURY) GO TO 360 00033200 C 00033300 DO 370 I = 1, I2 00033400 IF (FACT .LT. BACK) FACT = BACK 00033500 K = LFOURY + 2 - I 00033600 IF ( K .GT. LFOURY ) GO TO 370 00033700 NN = K + K - 1 00033800 X(NN ) = X(NN ) * FACT 00033900 X(NN+1) = X(NN+1) * FACT 00034000 FACT = FACT - RR 00034100 C 00034200 370 CONTINUE 00034300 C 00034400 GO TO 400 00034500 C 00034600 380 CONTINUE 00034700 DO 390 I = I1, I2 00034800 IF (FACT .LT. BACK) FACT = BACK 00034900 K = LFOURY + 2 - I 00035000 IF ( K .GT. LFOURY ) GO TO 390 00035100 NN = K + K - 1 00035200 X(NN ) = X(NN ) * FACT 00035300 X(NN+1) = X(NN+1) * FACT 00035400 FACT = FACT - RR 00035500 C 00035600 390 CONTINUE 00035700 C 00035800 C APPLY ROLL-OFF ON RIGHT HIGH SIDE 00035900 C 00036000 400 I1 = RHROLL * RATIO + 0.5 00036100 I2 = RHSLP * RATIO + 0.5 00036200 RR = 1. / (I2 - I1 + 1) 00036300 FACT = RR 00036400 IF (I1 .LE. 0) I1 = 1 00036500 IF (I2 .LE. 0) I2 = 1 00036600 IF (I1 .GT. BOUND .AND. ALIFLG .EQ. 0) GO TO 480 00036700 C 00036800 410 IF (I1 .LE. LFOURY) GO TO 420 00036900 I1 = I1 - LFOURY 00037000 I2 = I2 - LFOURY 00037100 GO TO 410 00037200 C 00037300 420 IF (ALIFLG .EQ. 0 .AND. I2 .GT. BOUND) I2 = BOUND 00037400 IF (I2 .LE. LFOURY) GO TO 460 00037500 C 00037600 DO 430 I = I1, BOUND 00037700 FACT1 = FACT 00037800 IF (FACT .LT. BACK) FACT1 = BACK 00037900 K = LFOURY + 2 - I 00038000 IF ( K .GT. LFOURY ) GO TO 430 00038100 NN = K + K - 1 00038200 X(NN ) = X(NN ) * FACT1 00038300 X(NN+1) = X(NN+1) * FACT1 00038400 FACT = FACT + RR 00038500 C 00038600 430 CONTINUE 00038700 C 00038800 IF (ALIFLG .EQ. 0) GO TO 480 00038900 C 00039000 440 I2 = I2 - LFOURY 00039100 IF (I2 .GT. LFOURY) GO TO 440 00039200 C 00039300 DO 450 I = 1, I2 00039400 FACT1 = FACT 00039500 IF (FACT .LT. BACK) FACT1 = BACK 00039600 K = LFOURY + 2 - I 00039700 IF ( K .GT. LFOURY ) GO TO 450 00039800 NN = K + K - 1 00039900 X(NN ) = X(NN ) * FACT1 00040000 X(NN+1) = X(NN+1) * FACT1 00040100 FACT = FACT + RR 00040200 C 00040300 450 CONTINUE 00040400 C 00040500 GO TO 480 00040600 C 00040700 460 CONTINUE 00040800 DO 470 I = I1, I2 00040900 FACT1 = FACT 00041000 IF (FACT .LT. BACK) FACT1 = BACK 00041100 K = LFOURY + 2 - I 00041200 IF ( K .GT. LFOURY ) GO TO 470 00041300 NN = K + K - 1 00041400 X(NN ) = X(NN ) * FACT1 00041500 X(NN+1) = X(NN+1) * FACT1 00041600 FACT = FACT + RR 00041700 C 00041800 470 CONTINUE 00041900 C 00042000 480 CONTINUE 00042100 RETURN 00042200 END 00042300