CTITLESAGUSB -- COMPUTES GUSB FREQUENCY RESONSE 00010000 C*********************************************************************** C COPYRIGHT ATLANTIC RICHFIELD COMPANY 1991 * C*********************************************************************** CA 00020000 CA AUTHOR JOHN SHELTON 00030000 CA DESIGNER JOHN SHELTON 00040000 CA LANGUAGE FORTRAN 00050000 CA SYSTEM IBM AND CRAY 00060000 CA WRITTEN 10-07-83 00070000 C REVISED 12-06-85 ESN. COSMETIC UPGRADES FOR PRODUCTION 00080000 C RELEASE. 00090000 C REVISED 12-15-86 ESN. FOR THE CRAY. 00100000 CA 00110000 CA CALL SAGUSB (NY,DF,IT,FLO,FHI,FNF,NFLAG,RESP,FREQ) 00120000 CA 00130000 CA IN NY NUMBER OF POINTS INFREQUENCY RESPONSE I4 00140000 CA IN DF FREQUENCY INCREMENT R4 00150000 CA IN IT DATA TYPE FLAG FROM SPINST I4 00160000 CA IN FLO LOWCUT FILTER FREQUENCY I4 00170000 CA IN FHI HIGHCUT FILTER FREQUENCY I4 00180000 CA IN FNF NOTCH FILTER FREQUENCY I4 00190000 CA IN NFLAG NOTCH FILTER FLAG I4 00200000 CA IN/OUT RESP GUSB FREQUENCY RESPONSE (BASE ADDRESS) C8 00210000 CA IN FREQ FREQ WORK BUFFER (2050 WORDS) R4 00220000 CA 00230000 CA 00240000 CA THIS SUBROUTINE COMPUTES DFS5 FREQUENCY RESPONSE 00250000 CA 00260000 CA 00270000 CA EXTERNAL: SARESP 00280000 CA 00290000 CAEND 00300000 C 00310000 SUBROUTINE SAGUSB(NY,DF,IT,FLO,FHI,FNF,NFLAG,RESP,FREQ) 00320000 C 00330000 IMPLICIT INTEGER (A-Z) 00340000 C 00350000 C=================================================================== 00360000 C 00370000 C LOCAL ARRAYS (INTERNAL TO SUBROUTINE) 00380000 C 00390000 C FA ( 10) = CORNER FREQUENCIES OF AMPLIFIER FILTERS R4 00400000 C FH ( 10) = CORNER FREQUENCIES OF HI-CUT FILTERS R4 00410000 C FL ( 10) = CORNER FREQUENCIES OF LO-CUT FILTERS R4 00420000 C NA ( 10) = ORDER OF THE AMPLIFIER FILTERS I4 00430000 C NH ( 10) = ORDER OF THE HI-CUT FILTERS I4 00440000 C NL ( 10) = ORDER OF THE LO-CUT FILTERS I4 00450000 C 00460000 C=================================================================== 00470000 C 00480000 C LOCAL VARIABLES (INTERNAL TO SUBROUTINE) 00490000 C 00500000 C BW = BANDWIDTH OF NOTCH FILTER AT AMPLITUDE DB R4 00510000 C DB = AMPLITUDE ASSOCIATED WITH BW R4 00520000 C N1 = NUMBER OF FILTER SECTIONS IN AMPLIFIER FILTER I4 00530000 C N2 = NUMBER OF FILTER SECTIONS IN LO-CUT FILTER I4 00540000 C N3 = NUMBER OF FILTER SECTIONS IN HI-CUT FILTER I4 00550000 C 00560000 C=================================================================== 00570000 C 00580000 C COMPLEX ARRAY (THRU ARGUMENT LIST) 00590000 C 00600000 COMPLEX RESP(1) 00610000 C 00620000 C==================================================================== 00630000 C 00640000 C REAL ARRAYS (THRU ARGUMENT LIST) 00650000 C 00660000 REAL FREQ (1) 00670000 C 00680000 C==================================================================== 00690000 C 00700000 C REAL ARRAYS (LOCAL) 00710000 C 00720000 REAL FA (10) 00730000 REAL FH (10) 00740000 REAL FL (10) 00750000 C 00760000 C================================================================= 00770000 C 00780000 C INTEGER ARRAYS (LOCAL) 00790000 C 00800000 INTEGER NA (10) 00810000 INTEGER NH (10) 00820000 INTEGER NL (10) 00830000 C 00840000 C==================================================================== 00850000 C 00860000 C COMPLEX VARIABLES 00870000 C 00880000 COMPLEX PH 00890000 C 00900000 C==================================================================== 00910000 C 00920000 C REAL VARIABLES 00930000 C 00940000 REAL BW 00950000 REAL DB 00960000 REAL DF 00970000 REAL E 00980000 REAL FCOR 00990000 REAL FI 01000000 REAL FNFR 01010000 REAL G 01020000 REAL W 01030000 C 01040000 C===================================================================== 01050000 C 01060000 C DATA STATEMENTS 01070000 C 01080000 DATA FA /10*0./ 01090000 DATA FH /10*0./ 01100000 DATA FL /10*0./ 01110000 DATA NA /10*0/ 01120000 DATA NH /10*0/ 01130000 DATA NL /10*0/ 01140000 DATA N1 /0/ 01150000 DATA N2 /0/ 01160000 DATA N3 /0/ 01170000 C 01180000 C===================================================================== 01190000 C 01200000 C INITIALIZATION 01210000 C 01220000 DO 10 I = 1,NY 01230000 FREQ(I) = FLOAT(I-1)*DF 01240000 10 CONTINUE 01250000 C 01260000 IF (NFLAG .EQ. 1) GO TO 200 01270000 C 01280000 C ESTABLISH THE AMPLIFIER CHARACTERISTICS 01290000 C 01300000 DO 15 01310000 * I = 1, 10 01320000 NA(I) = 0 01330000 15 FA(I) = 0.0 01340000 C 01350000 FA(1) = 1.04 01360000 NA(1) = 1 01370000 N1 = 1 01380000 C 01390000 C ESTABLISH THE LOWCUT PARAMETERS 01400000 C 01410000 DO 20 01420000 * I = 1, 10 01430000 NL(I) = 0 01440000 20 FL(I) = 0.0 01450000 C 01460000 IF (FLO .EQ. 8 ) GO TO 30 01470000 IF (FLO .EQ. 12 ) GO TO 40 01480000 IF (FLO .EQ. 26 ) GO TO 50 01490000 IF (FLO .EQ. 30 ) GO TO 60 01500000 C 01510000 N2 = 0 01520000 GO TO 90 01530000 C 01540000 30 NL(1) = 4 01550000 FL(1) = 7.9162 01560000 N2 = 1 01570000 GO TO 90 01580000 C 01590000 40 NL(1) = 4 01600000 FL(1) = 11.944 01610000 N2 = 1 01620000 GO TO 90 01630000 C 01640000 50 NL(1) = 4 01650000 FL(1) = 25.996 01660000 N2 = 1 01670000 GO TO 90 01680000 C 01690000 60 NL(1) = 4 01700000 FL(1) = 29.304 01710000 N2 = 1 01720000 C 01730000 C ESTABLISH THE HIGHCUT PARAMETERS 01740000 C 01750000 90 CONTINUE 01760000 C 01770000 DO 100 01780000 * I = 1, 10 01790000 FH(I) = 0.0 01800000 100 NH(I) = 0 01810000 C 01820000 IF (FHI .EQ. 80) GO TO 110 01830000 IF (FHI .EQ. 160) GO TO 120 01840000 C 01850000 NH(1) = 12 01860000 FH(1) = 353.16 01870000 N3 = 1 01880000 FCOR = 0.6500 01890000 GO TO 130 01900000 C 01910000 110 NH(1) = 12 01920000 FH(1) = 88.887 01930000 N3 = 1 01940000 FCOR = 2.4156 01950000 GO TO 130 01960000 C 01970000 120 NH(1) = 12 01980000 FH(1) = 169.63 01990000 N3 = 1 02000000 FCOR = 1.4575 02010000 C 02020000 130 NN = N1+N2+N3 02030000 C 02040000 C ESTABLISH THE NOTCH PARAMETERS (IF ANY) 02050000 C 02060000 IF (FNF .NE. 60) GO TO 240 02070000 200 CONTINUE 02080000 C 02090000 DB = -6.0 02100000 BW = 3.9 02110000 C 02120000 C********************************************************************** 02130000 C* * 02140000 C* COMPUTE THE RECORDING SYSTEM RESPONSE * 02150000 C* * 02160000 C********************************************************************** 02170000 C 02180000 C COMPUTE THE NOTCH FILTER CONTRIBUTION 02190000 C TO THE OVERAL SYSTEM RESPONSE. 02200000 C 02210000 FNFR = FLOAT(FNF) 02220000 G = EXP(-0.2302585 * ABS(DB)) 02230000 E = 0.5 * BW * SQRT((1.0 - G) / G) 02240000 C 02250000 DO 230 I=1,NY 02260000 FI = FREQ(I) 02270000 IF(IT.NE.1) RESP(I) = RESP(I) * (FI - FNFR) * (FI + FNFR) / 02280000 * (CMPLX(FI - FNFR, -E) * CMPLX(FI + FNFR, -E)) 02290000 IF(IT.EQ.1) RESP(I) = RESP(I) * ((FI-FNFR)*(FI+FNFR))**2 / 02300000 * SQRT(((FI-FNFR)*(FI+FNFR)-E*E)**2 + 4.*E*E*FI*FI) 02310000 C 02320000 230 CONTINUE 02330000 C 02340000 IF (NFLAG .EQ. 1) GO TO 260 02350000 C 02360000 C COMPUTE THE AMPLIFIER, HIGH-CUT, 02370000 C AND LOW CUT FILTER CONTRIBUTIONS 02380000 C TO THE OVERALL SYSTEM RESPONSE. 02390000 C 02400000 240 CALL SARESP ( NY, IT, FA, NA, FL, NL, FH, NH, N1, N2, N3, 02410000 * NN,FREQ, RESP) 02420000 C 02430000 C APPLY THE REQUIRED LINEAR PHASE SHIFT 02440000 C 02450000 DO 250 I=1,NY 02460000 W = FCOR * FREQ(I) * 0.017453 02470000 PH = CMPLX(COS(W), SIN(W)) 02480000 RESP(I) = PH * RESP(I) 02490000 250 CONTINUE 02500000 C 02510000 260 CONTINUE 02520000 C 02530000 RETURN 02540000 END 02550000