CTITLESAMD10 -- COMPUTES MDS10 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 00050002 CA SYSTEM IBM AND CRAY 00060002 CA WRITTEN 07-22-85 00070000 C REVISED 10-27-86 ESN. COPIED FROM SAMD14 TO INCORPORATE 00080000 C MDS10 RESPONSE. 00090000 C REVISED 12-15-86 ESN. FOR THE CRAY. 00100002 CA 00110000 CA CALL SAMD10 (NY,DF,IT,FLO,RLO,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 RLO LOWCUT FILTER ROLLOFF I4 00180000 CA IN FHI HIGHCUT FILTER FREQUENCY I4 00190000 CA IN FNF NOTCH FILTER FREQUENCY I4 00200000 CA IN NFLAG NOTCH FILTER FLAG I4 00210000 CA IN/OUT RESP DFS5 FREQUENCY RESPONSE (BASE ADDRESS) C8 00220000 CA IN FREQ FREQ WORK BUFFER (2050 WORDS) R4 00230000 CA 00240000 CA 00250000 CA THIS SUBROUTINE COMPUTES DFS5 FREQUENCY RESPONSE 00260000 CA 00270000 CA 00280000 CA EXTERNAL: SARESP 00290000 CA 00300000 CAEND 00310000 C 00320000 SUBROUTINE SAMD10(NY,DF,IT,FLO,RLO,FHI,FNF,NFLAG,RESP,FREQ) 00330000 C 00340000 IMPLICIT INTEGER (A-Z) 00350000 C 00360000 C=================================================================== 00370000 C 00380000 C LOCAL ARRAYS (INTERNAL TO SUBROUTINE) 00390000 C 00400000 C FA ( 10) = CORNER FREQUENCIES OF AMPLIFIER FILTERS R4 00410000 C FH ( 10) = CORNER FREQUENCIES OF HI-CUT FILTERS R4 00420000 C FL ( 10) = CORNER FREQUENCIES OF LO-CUT FILTERS R4 00430000 C NA ( 10) = ORDER OF THE AMPLIFIER FILTERS I4 00440000 C NH ( 10) = ORDER OF THE HI-CUT FILTERS I4 00450000 C NL ( 10) = ORDER OF THE LO-CUT FILTERS I4 00460000 C 00470000 C=================================================================== 00480000 C 00490000 C LOCAL VARIABLES (INTERNAL TO SUBROUTINE) 00500000 C 00510000 C BW = BANDWIDTH OF NOTCH FILTER AT AMPLITUDE DB R4 00520000 C DB = AMPLITUDE ASSOCIATED WITH BW R4 00530000 C N1 = NUMBER OF FILTER SECTIONS IN AMPLIFIER FILTER I4 00540000 C N2 = NUMBER OF FILTER SECTIONS IN LO-CUT FILTER I4 00550000 C N3 = NUMBER OF FILTER SECTIONS IN HI-CUT FILTER I4 00560000 C 00570000 C=================================================================== 00580000 C 00590000 C COMPLEX ARRAY (THRU ARGUMENT LIST) 00600000 C 00610000 COMPLEX RESP(1) 00620000 C 00630000 C==================================================================== 00640000 C 00650000 C REAL ARRAYS (THRU ARGUMENT LIST) 00660000 C 00670000 REAL FREQ (1) 00680000 C 00690000 C==================================================================== 00700000 C 00710000 C REAL ARRAYS (LOCAL) 00720000 C 00730000 REAL FA (10) 00740002 REAL FH (10) 00750002 REAL FL (10) 00760002 C 00770000 C================================================================= 00780000 C 00790000 C INTEGER ARRAYS (LOCAL) 00800000 C 00810000 INTEGER NA (10) 00820002 INTEGER NH (10) 00830002 INTEGER NL (10) 00840002 C 00850000 C==================================================================== 00860000 C 00870000 C COMPLEX VARIABLES 00880000 C 00890000 COMPLEX PH 00900000 C 00910000 C==================================================================== 00920000 C 00930000 C REAL VARIABLES 00940000 C 00950000 REAL BW 00960002 REAL DB 00970002 REAL DF 00980002 REAL E 00990000 REAL FCOR 01000000 REAL FI 01010000 REAL FNFR 01020000 REAL G 01030002 REAL W 01040000 C 01050000 C===================================================================== 01060000 C 01070000 C DATA STATEMENTS 01080002 C 01090000 DATA FA /10*0./ 01100002 DATA FH /10*0./ 01110002 DATA FL /10*0./ 01120002 DATA NA /10*0/ 01130002 DATA NH /10*0/ 01140002 DATA NL /10*0/ 01150002 DATA N1 /0/ 01160002 DATA N2 /0/ 01170002 DATA N3 /0/ 01180002 C 01190000 C===================================================================== 01200000 C 01210000 C INITIALIZATION 01220000 C 01230000 DO 10 I = 1,NY 01240000 FREQ(I) = FLOAT(I-1)*DF 01250000 10 CONTINUE 01260000 C 01270000 IF (NFLAG .EQ. 1) GO TO 240 01280000 C 01290000 C ESTABLISH THE AMPLIFIER CHARACTERISTICS 01300000 C 01310000 C 01320000 FA(1) = 1.402 01330001 NA(1) = 1 01340001 N1 = 1 01350001 C 01360000 C ESTABLISH THE LOWCUT PARAMETERS 01370000 C 01380000 DO 30 I = 1, 10 01390000 NL(I) = 0 01400000 FL(I) = 0. 01410000 30 CONTINUE 01420000 C 01430000 IF (FLO .EQ. 9) THEN 01440000 NL(1) = 3 01450000 NL(2) = 1 01460001 FL(1) = 8.864 01470000 FL(1) = 0.880 01480001 N2 = 2 01490001 ENDIF 01500000 C 01510000 IF (FLO .EQ. 12) THEN 01520000 NL(1) = 3 01530000 FL(1) = 11.900 01540000 N2 = 1 01550000 ENDIF 01560000 C 01570000 IF (FLO .EQ. 15) THEN 01580000 NL(1) = 3 01590000 FL(1) = 14.913 01600000 N2 = 1 01610000 ENDIF 01620000 C 01630000 IF (FLO .EQ. 18) THEN 01640000 NL(1) = 3 01650000 FL(1) = 17.885 01660000 N2 = 1 01670000 ENDIF 01680000 C 01690000 IF (FLO .EQ. 24) THEN 01700000 NL(1) = 3 01710000 FL(1) = 24.241 01720000 N2 = 1 01730000 ENDIF 01740000 C 01750000 IF (FLO .EQ. 30) THEN 01760000 NL(1) = 3 01770000 FL(1) = 29.900 01780000 N2 = 1 01790000 ENDIF 01800000 C 01810000 C ESTABLISH THE HIGHCUT PARAMETERS 01820000 C 01830000 IF (FHI .EQ. 125) THEN 01840000 NH(1) = 14 01850000 FH(1) = 126.500 01860000 N3 = 1 01870000 FCOR = 1.536 01880000 ENDIF 01890000 C 01900000 NN = N1+N2+N3 01910000 C 01920000 C ESTABLISH THE NOTCH PARAMETERS (IF ANY) 01930000 C 01940000 IF (FNF .NE. 60) GO TO 310 01950001 240 CONTINUE 01960001 C 01970000 DB = -10.00 01980001 BW = 5.90 01990001 C 02000000 C********************************************************************** 02010000 C* * 02020000 C* COMPUTE THE RECORDING SYSTEM RESPONSE * 02030000 C* * 02040000 C********************************************************************** 02050000 C 02060000 C COMPUTE THE NOTCH FILTER CONTRIBUTION 02070000 C TO THE OVERALL SYSTEM RESPONSE. 02080000 C 02090000 FNFR = FLOAT(FNF) 02100000 G = EXP(-0.2302585 * ABS(DB)) 02110000 E = 0.5 * BW * SQRT((1.0 - G) / G) 02120000 C 02130000 IF (IT .EQ. 1) GO TO 280 02140000 C 02150000 DO 270 I=1,NY 02160000 FI = FREQ(I) 02170000 RESP(I) = RESP(I) * (FI - FNFR) * (FI + FNFR) / 02180000 * (CMPLX(FI - FNFR, -E) * CMPLX(FI + FNFR, -E)) 02190000 C 02200000 270 CONTINUE 02210000 C 02220000 GO TO 300 02230000 C 02240000 280 CONTINUE 02250000 C 02260000 DO 290 I=1,NY 02270000 FI = FREQ(I) 02280000 RESP(I) = RESP(I) *((FI - FNFR) * (FI + FNFR))**2 / 02290000 * (((FI-FNFR)*(FI+FNFR)-E*E)**2 + 4.*E*E*FI*FI) 02300000 C 02310000 290 CONTINUE 02320000 C 02330000 300 CONTINUE 02340000 IF (NFLAG .EQ. 1) GO TO 330 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 310 CALL SARESP ( NY, IT, FA, NA, FL, NL, FH, NH, N1, N2, N3, 02410000 * NN,FREQ, RESP) 02420000 C 02430000 C ADD THE REQUIRED LINEAR PHASE SHIFT 02440000 C 02450000 DO 320 I=1,NY 02460000 W = FCOR * FREQ(I) * 0.017453 02470000 PH = CMPLX(COS(W), SIN(W)) 02480000 RESP(I) = PH * RESP(I) 02490000 320 CONTINUE 02500000 C 02510000 330 RETURN 02520000 C 02530000 END 02540000