CTITLESARESP -- AMPLIFIER AND FILTER CONTRIBUTIONS TO SYSTEM RESPONSE 00010000 C*********************************************************************** C COPYRIGHT ATLANTIC RICHFIELD COMPANY 1991 * C*********************************************************************** CA AUTHOR J. SHELTON 00020000 CA DESIGNER J. SHELTON 00030000 CA LANGUAGE FORTRAN 00040000 CA SYSTEM IBM AND CRAY 00050000 CA WRITTEN 04-10-82 00060000 C REVISED 10-08-82 SAS. COSMETIC UPGRADES FOR PRODUCTION 00070000 C RELEASE. 00080000 C REVISED 12-16-86 ESN. FOR THE CRAY. 00090000 C 00100000 CA 00110000 CA CALL SUBROUTINE SARESP ( NF, IT, FA, NA, FL, NL, FH, NH, 00120000 CA CNNA, NNL, NNH, NN, F, R ) 00130000 CA 00140000 CA 00150000 CA IN NF = NUMBER OF FREQUENCIES IN RESPONSE I4 00160000 CA IN IT = DATA TYPE FLAG. IF 1, THE MAGNITUDE I4 00170000 CA SQUARED OF THE FILTER RESPONSE IS 00180000 CA COMPUTED. 00190000 CA IN FA ( 10) = AMPLIFIER CORNER FREQUENCIES R4 00200000 CA IN NA ( 10) = ORDER OF AMPLIFIER FILTER SECTIONS I4 00210000 CA IN FL ( 10) = LOCUT CORNER FREQUENCIES R4 00220000 CA IN NL ( 10) = ORDER OF LOCUT FILTER SECTIONS I4 00230000 CA IN FH ( 10) = HICUT CORNER FREQUENCIES R4 00240000 CA IN NH ( 10) = ORDER OF HICUT FILTER SECTIONS I4 00250000 CA IN NNA = NUMBER OF AMPLIFIER FILTER SECTIONS I4 00260000 CA IN NNL = NUMBER OF LOCUT FILTER SECTIONS I4 00270000 CA IN NNH = NUMBER OF HICUT FILTER SECTIONS I4 00280000 CA IN NN = TOTAL NUMBER OF FILTER SECTIONS I4 00290000 CA IN F = FREQUENCY ARRAY I4 00300000 CA IN/OUT R = SYSTEM RESPONSE C8 00310000 C 00320000 SUBROUTINE SARESP ( NF, IT, FA, NA, FL, NL, FH, NH, 00330000 * NNA, NNL, NNH, NN, F, R ) 00340000 C 00350000 C=======================================================================00360000 C 00370000 C COMPLEX ARRAY 00380000 C 00390000 COMPLEX R (1) 00400000 C 00410000 C=======================================================================00420000 C 00430000 C REAL ARRAYS IN PARAMETER LIST 00440000 C 00450000 REAL F (2050) 00460000 REAL FA (10) 00470000 REAL FH (10) 00480000 REAL FL (10) 00490000 C 00500000 C=======================================================================00510000 C 00520000 C INTEGER ARRAYS IN PARAMETER LIST 00530000 C 00540000 INTEGER NA (10) 00550000 INTEGER NH (10) 00560000 INTEGER NL (10) 00570000 C 00580000 C=======================================================================00590000 C 00600000 C INTEGER CONSTANTS IN PARAMETER LIST 00610000 C 00620000 INTEGER NF 00630000 INTEGER NN 00640000 INTEGER NNA 00650000 INTEGER NNH 00660000 INTEGER NNL 00670000 C 00680000 C=======================================================================00690000 C 00700000 C COMPLEX ARRAYS - LOCAL 00710000 C 00720000 COMPLEX A (12,10) 00730000 COMPLEX B (12,10) 00740000 COMPLEX C (12,10) 00750000 C 00760000 C=======================================================================00770000 C 00780000 C INTEGER ARRAYS - LOCAL 00790000 C 00800000 INTEGER NA0 (10) 00810000 INTEGER NH0 (10) 00820000 INTEGER NL0 (10) 00830000 C 00840000 C=======================================================================00850000 C 00860000 C COMPLEX CONSTANTS - LOCAL 00870000 C 00880000 COMPLEX RI 00890000 COMPLEX Z 00900000 C 00910000 C=======================================================================00920000 C 00930000 C REAL CONSTANTS - LOCAL 00940000 C 00950000 REAL FI 00960000 REAL G 00970000 REAL PI 00980000 REAL R1 00990000 REAL R2 01000000 REAL W 01010000 REAL WI 01020000 C 01030000 C=======================================================================01040000 C 01050000 C DATA STATEMENTS 01060000 C 01070000 DATA NA0 / 10*0 / 01080000 DATA NH0 / 10*0 / 01090000 DATA NL0 / 10*0 / 01100000 DATA PI / 3.14159265 / 01110000 C 01120000 C=======================================================================01130000 C 01140000 C INITIALIZATION 01150000 C 01160000 C AMPLIFIER COEFFICIENTS 01170000 C 01180000 IF(NNA.EQ.0) GO TO 40 01190000 C 01200000 DO 30 K=1,NNA 01210000 N=NA(K) 01220000 IF (N.EQ.0 .OR. N.EQ.NA0(K)) GO TO 30 01230000 G=PI*0.5/N 01240000 C 01250000 DO 20 I=1,N 01260000 Z=1.0 01270000 C 01280000 DO 10 J=1,I 01290000 10 Z=Z*CMPLX(0.,-COS((J-1)*G)/SIN(J*G)) 01300000 C 01310000 20 A(I,K)=Z 01320000 C 01330000 30 NA0(K)=N 01340000 C 01350000 C LOW CUT COEFFICIENTS 01360000 C 01370000 40 IF(NNL.EQ.0) GO TO 80 01380000 C 01390000 DO 70 K=1,NNL 01400000 N=NL(K) 01410000 IF (N.EQ.0 .OR. N.EQ.NL0(K)) GO TO 70 01420000 G=PI*0.5/N 01430000 C 01440000 DO 60 I=1,N 01450000 Z=1.0 01460000 C 01470000 DO 50 J=1,I 01480000 50 Z=Z*CMPLX(0.,-COS((J-1)*G)/SIN(J*G)) 01490000 C 01500000 60 B(I,K)=Z 01510000 C 01520000 70 NL0(K)=N 01530000 C 01540000 C HIGH CUT COEFFICIENTS 01550000 C 01560000 80 IF(NNH.EQ.0) GO TO 120 01570000 C 01580000 DO 110 K=1,NNH 01590000 N=NH(K) 01600000 IF (N.EQ.0 .OR. N.EQ.NH0(K)) GO TO 110 01610000 G=PI*0.5/N 01620000 C 01630000 DO 100 I=1,N 01640000 Z=1.0 01650000 C 01660000 DO 90 J=1,I 01670000 90 Z=Z*CMPLX(0.,COS((J-1)*G)/SIN(J*G)) 01680000 C 01690000 100 C(I,K)=Z 01700000 C 01710000 110 NH0(K)=N 01720000 C 01730000 C COMPUTE RESPONSE VS. FREQUENCY 01740000 C 01750000 120 DO 230 IF=1,NF 01760000 FI=F(IF) 01770000 IF (FI .NE. 0.) GO TO 130 01780000 RI=0. 01790000 GO TO 230 01800000 C 01810000 130 RI=1.0 01820000 C 01830000 C COMPUTE AMPLIFIER RESPONSE 01840000 C 01850000 IF(NNA.EQ.0) GO TO 160 01860000 C 01870000 DO 150 K=1,NNA 01880000 N=NA(K) 01890000 IF (N.EQ.0) GO TO 150 01900000 W=FA(K)/FI 01910000 WI=W 01920000 Z=1. 01930000 C 01940000 DO 140 I=1,N 01950000 Z=A(I,K)*WI+Z 01960000 140 WI=WI*W 01970000 C 01980000 RI=RI/Z 01990000 C 02000000 150 CONTINUE 02010000 C 02020000 C COMPUTE LOW CUT RESPONSE 02030000 C 02040000 160 IF(NNL.EQ.0) GO TO 190 02050000 C 02060000 DO 180 K=1,NNL 02070000 N=NL(K) 02080000 IF (N.EQ.0) GO TO 180 02090000 W=FL(K)/FI 02100000 WI=W 02110000 Z=1. 02120000 C 02130000 DO 170 I=1,N 02140000 Z=B(I,K)*WI+Z 02150000 170 WI=WI*W 02160000 C 02170000 RI=RI/Z 02180000 C 02190000 180 CONTINUE 02200000 C 02210000 C COMPUTE HIGH CUT RESPONSE 02220000 C 02230000 190 IF(NNH.EQ.0) GO TO 220 02240000 C 02250000 DO 210 K=1,NNH 02260000 N=NH(K) 02270000 IF (N.EQ.0) GO TO 210 02280000 W=FI/FH(K) 02290000 WI=W 02300000 Z=1. 02310000 C 02320000 DO 200 I=1,N 02330000 Z=C(I,K)*WI+Z 02340000 200 WI=WI*W 02350000 C 02360000 RI=RI/Z 02370000 C 02380000 210 CONTINUE 02390000 C 02400000 C IF IT=1, COMPUTE THE MAGNITUDE SQUARED. 02410000 C 02420000 220 IF (IT .EQ. 1) RI = RI * CONJG(RI) 02430000 C 02440000 230 R(IF) = R(IF) * RI 02450000 C 02460000 RETURN 02470000 C 02480000 END 02490000