CTITLESAMD14 -- COMPUTES MDS14 AND MDS16 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 00050001 CA SYSTEM IBM AND CRAY 00060001 CA WRITTEN 07-22-85 00070000 C REVISED 12-06-85 ESN. COSMETIC UPGRADES FOR PRODUCTION 00080000 C RELEASE. 00090000 C REVISED 12-15-86 ESN. COMPREHEND FLO=8 FOR MD16 AND 00100001 C CONVERTED TO THE CRAY. 00110001 CA 00120000 CA CALL SAMD14 (NY,DF,IT,FLO,RLO,FHI,FNF,NFLAG,RESP,FREQ) 00130000 CA 00140000 CA IN NY NUMBER OF POINTS INFREQUENCY RESPONSE I4 00150000 CA IN DF FREQUENCY INCREMENT R4 00160000 CA IN IT DATA TYPE FLAG FROM SPINST I4 00170000 CA IN FLO LOWCUT FILTER FREQUENCY I4 00180000 CA IN RLO LOWCUT FILTER ROLLOFF I4 00190000 CA IN FHI HIGHCUT FILTER FREQUENCY I4 00200000 CA IN FNF NOTCH FILTER FREQUENCY I4 00210000 CA IN NFLAG NOTCH FILTER FLAG I4 00220000 CA IN/OUT RESP DFS5 FREQUENCY RESPONSE (BASE ADDRESS) C8 00230000 CA IN FREQ FREQ WORK BUFFER (2050 WORDS) R4 00240000 CA 00250000 CA 00260000 CA THIS SUBROUTINE COMPUTES DFS5 FREQUENCY RESPONSE 00270000 CA 00280000 CA 00290000 CA EXTERNAL: SARESP 00300000 CA 00310000 CAEND 00320000 C 00330000 SUBROUTINE SAMD14(NY,DF,IT,FLO,RLO,FHI,FNF,NFLAG,RESP,FREQ) 00340000 C 00350000 IMPLICIT INTEGER (A-Z) 00360000 C 00370000 C=================================================================== 00380000 C 00390000 C LOCAL ARRAYS (INTERNAL TO SUBROUTINE) 00400000 C 00410000 C FA ( 10) = CORNER FREQUENCIES OF AMPLIFIER FILTERS R4 00420000 C FH ( 10) = CORNER FREQUENCIES OF HI-CUT FILTERS R4 00430000 C FL ( 10) = CORNER FREQUENCIES OF LO-CUT FILTERS R4 00440000 C NA ( 10) = ORDER OF THE AMPLIFIER FILTERS I4 00450000 C NH ( 10) = ORDER OF THE HI-CUT FILTERS I4 00460000 C NL ( 10) = ORDER OF THE LO-CUT FILTERS I4 00470000 C 00480000 C=================================================================== 00490000 C 00500000 C LOCAL VARIABLES (INTERNAL TO SUBROUTINE) 00510000 C 00520000 C BW = BANDWIDTH OF NOTCH FILTER AT AMPLITUDE DB R4 00530000 C DB = AMPLITUDE ASSOCIATED WITH BW R4 00540000 C N1 = NUMBER OF FILTER SECTIONS IN AMPLIFIER FILTER I4 00550000 C N2 = NUMBER OF FILTER SECTIONS IN LO-CUT FILTER I4 00560000 C N3 = NUMBER OF FILTER SECTIONS IN HI-CUT FILTER I4 00570000 C 00580000 C=================================================================== 00590000 C 00600000 C COMPLEX ARRAY (THRU ARGUMENT LIST) 00610000 C 00620000 COMPLEX RESP(1) 00630000 C 00640000 C==================================================================== 00650000 C 00660000 C REAL ARRAYS (THRU ARGUMENT LIST) 00670000 C 00680000 REAL FREQ (1) 00690000 C 00700000 C==================================================================== 00710000 C 00720000 C REAL ARRAYS (LOCAL) 00730000 C 00740000 REAL FA (10) 00750001 REAL FH (10) 00760001 REAL FL (10) 00770001 C 00780000 C================================================================= 00790000 C 00800000 C INTEGER ARRAYS (LOCAL) 00810000 C 00820000 INTEGER NA (10) 00830001 INTEGER NH (10) 00840001 INTEGER NL (10) 00850001 C 00860000 C==================================================================== 00870000 C 00880000 C COMPLEX VARIABLES 00890000 C 00900000 COMPLEX PH 00910000 C 00920000 C==================================================================== 00930000 C 00940000 C REAL VARIABLES 00950000 C 00960000 REAL BW 00970001 REAL DB 00980001 REAL DF 00990001 REAL E 01000000 REAL FCOR 01010000 REAL FI 01020000 REAL FNFR 01030000 REAL G 01040001 REAL W 01050000 C 01060000 C===================================================================== 01070000 C 01080000 C DATA STATEMENTS 01090001 C 01100000 DATA FA /10*0./ 01110001 DATA FH /10*0./ 01120001 DATA FL /10*0./ 01130001 DATA NA /10*0/ 01140001 DATA NH /10*0/ 01150001 DATA NL /10*0/ 01160001 DATA N1 /0/ 01170001 DATA N2 /0/ 01180001 DATA N3 /0/ 01190001 C 01200000 C===================================================================== 01210000 C 01220000 C INITIALIZATION 01230000 C 01240000 DO 10 I = 1,NY 01250000 FREQ(I) = FLOAT(I-1)*DF 01260000 10 CONTINUE 01270000 C 01280000 IF (NFLAG .EQ. 1) GO TO 240 01290000 C 01300000 C ESTABLISH THE AMPLIFIER CHARACTERISTICS 01310000 C 01320000 C 01330000 FA(1) = 0.015 01340000 FA(2) = 3.250 01350000 NA(1) = 2 01360000 NA(2) = 1 01370000 N1 = 2 01380000 C 01390000 C ESTABLISH THE LOWCUT PARAMETERS 01400000 C 01410000 IF (FLO .EQ. 8 .AND. RLO .EQ. 24) GO TO 90 01420000 IF (FLO .EQ.10 .AND. RLO .EQ. 24) GO TO 80 01430000 IF (FLO .EQ.15 .AND. RLO .EQ. 24) GO TO 100 01440000 IF (FLO .EQ.21 .AND. RLO .EQ. 24) GO TO 40 01450000 IF (FLO .EQ.25 .AND. RLO .EQ. 24) GO TO 60 01460000 C 01470000 DO 30 I = 1, 10 01480000 NL(I) = 0 01490000 FL(I) = 0. 01500000 30 CONTINUE 01510000 C 01520000 N2 = 0 01530000 GO TO 160 01540000 C 01550000 40 NL(1) = 4 01560000 FL(1) = 22.624 01570000 N2 = 1 01580000 GO TO 160 01590000 C 01600000 60 NL(1) = 4 01610000 FL(1) = 25.317 01620000 N2 = 1 01630000 GO TO 160 01640000 C 01650000 80 NL(1) = 4 01660000 FL(1) = 10.417 01670000 N2 = 1 01680000 GO TO 160 01690000 C 01700000 90 NL(1) = 4 01710000 FL(1) = 8.528 01720000 N2 = 1 01730000 GO TO 160 01740000 C 01750000 100 NL(1) = 4 01760000 FL(1) = 14.938 01770000 N2 = 1 01780000 C 01790000 C ESTABLISH THE HIGHCUT PARAMETERS 01800000 C 01810000 160 CONTINUE 01820000 IF (FHI .EQ. 93) GO TO 190 01830000 IF (FHI .EQ. 109) GO TO 170 01840000 IF (FHI .EQ. 125) GO TO 180 01850000 C 01860000 170 NH(1) = 10 01870000 NH(2) = 5 01880000 FH(1) = 109.00 01890000 FH(2) = 110.97 01900000 N3 = 2 01910000 FCOR = 2.050 01920000 GO TO 230 01930000 C 01940000 180 NH(1) = 12 01950000 NH(2) = 2 01960000 FH(1) = 123.046 01970000 FH(2) = 112.174 01980000 N3 = 2 01990000 FCOR = 1.838 02000000 GO TO 230 02010000 C 02020000 190 NH(1) = 10 02030000 NH(2) = 5 02040000 FH(1) = 94.672 02050000 FH(2) = 99.266 02060000 N3 = 2 02070000 FCOR = 2.202 02080000 C 02090000 230 NN = N1+N2+N3 02100000 C 02110000 C ESTABLISH THE NOTCH PARAMETERS (IF ANY) 02120000 C 02130000 IF (FNF .NE. 50 .AND. FNF .NE. 60) GO TO 310 02140000 240 IF (FNF .EQ. 50) GO TO 250 02150000 C 02160000 DB = -10.0 02170000 BW = 5.00 02180000 GO TO 260 02190000 C 02200000 250 DB = -10.00 02210000 BW = 5.00 02220000 C 02230000 260 CONTINUE 02240000 C 02250000 C********************************************************************** 02260000 C* * 02270000 C* COMPUTE THE RECORDING SYSTEM RESPONSE * 02280000 C* * 02290000 C********************************************************************** 02300000 C 02310000 C COMPUTE THE NOTCH FILTER CONTRIBUTION 02320000 C TO THE OVERAL SYSTEM RESPONSE. 02330000 C 02340000 FNFR = FLOAT(FNF) 02350000 G = EXP(-0.2302585 * ABS(DB)) 02360000 E = 0.5 * BW * SQRT((1.0 - G) / G) 02370000 C 02380000 IF (IT .EQ. 1) GO TO 280 02390000 C 02400000 DO 270 I=1,NY 02410000 FI = FREQ(I) 02420000 RESP(I) = RESP(I) * (FI - FNFR) * (FI + FNFR) / 02430000 * (CMPLX(FI - FNFR, -E) * CMPLX(FI + FNFR, -E)) 02440000 C 02450000 270 CONTINUE 02460000 C 02470000 GO TO 300 02480000 C 02490000 280 CONTINUE 02500000 C 02510000 DO 290 I=1,NY 02520000 FI = FREQ(I) 02530000 RESP(I) = RESP(I) *((FI - FNFR) * (FI + FNFR))**2 / 02540000 * (((FI-FNFR)*(FI+FNFR)-E*E)**2 + 4.*E*E*FI*FI) 02550000 C 02560000 290 CONTINUE 02570000 C 02580000 300 CONTINUE 02590000 IF (NFLAG .EQ. 1) GO TO 330 02600000 C 02610000 C COMPUTE THE AMPLIFIER, HIGH-CUT, 02620000 C AND LOW CUT FILTER CONTRIBUTIONS 02630000 C TO THE OVERALL SYSTEM RESPONSE. 02640000 C 02650000 310 CALL SARESP ( NY, IT, FA, NA, FL, NL, FH, NH, N1, N2, N3, 02660000 * NN,FREQ, RESP) 02670000 C 02680000 C ADD THE REQUIRED LINEAR PHASE SHIFT 02690000 C 02700000 DO 320 I=1,NY 02710000 W = FCOR * FREQ(I) * 0.017453 02720000 PH = CMPLX(COS(W), SIN(W)) 02730000 RESP(I) = PH * RESP(I) 02740000 320 CONTINUE 02750000 C 02760000 330 RETURN 02770000 C 02780000 END 02790000