CTITLESADBIA -- DEBIASING 00010000 C*********************************************************************** C COPYRIGHT ATLANTIC RICHFIELD COMPANY 1991 * C*********************************************************************** CA AUTHOR RALPH E. MCMILLAN 00020000 CA DESIGNER RALPH E. MCMILLAN 00030000 CA LANGUAGE FORTRAN H 00040000 CA SYSTEM IBM/CRAY 00050000 CA WRITTEN 05-30-78 00060000 C REVISED 04-22-81 REM. ADJUST WINDOW DEBIASING. 00070000 C REVISED 12-02-81 DJP. PERFORM DEBIASING OVER AN ANALYSIS 00080000 C WINDOW. 00090000 C REVISED 12-04-86 RSH. INCORPORATE CRAY. 00100000 C REVISED 11-13-89 RDK. FOR CRAY CFT77 COMPATIBILITY. 00110000 C REVISED 03-03-92 ESN. INTRODUCE CONSTANT AMPLITUDE OPTION. 00120000 CA 00130000 CA 00140000 CA CALL SADBIA (INTR, OTR, NSAMP, SSMPL, ESMPL, WINDL, CONAMP) 00150000 CA 00160000 CA IN/OUT ARGUMENT TYPE DESCRIPTION 00170000 CA 00180000 CA IN INTR R4 INPUT TRACE 00190000 CA OUT OTR R4 OUTPUT TRACE 00200000 CA IN NSAMP I4 NUMBER OF SAMPLES 00210000 CA IN SSMPL I4 STARTING SAMPLE OF THE ANALYSIS WINDOW 00220000 CA IN ESMPL I4 ENDING SAMPLE OF THE ANALYSIS WINDOW 00230000 CA IN WINDL I4 WINDOW LENGTH IN NUMBER OF SAMPLES 00240000 CA IN CONAMP I4 CONSTANT AMPLITUDE VALUE. IF NOT EQUAL 00250000 CA TO ZERO, THIS WILL BE USED INSTEAD OF THE 00260000 CA CALCULATED VALUE. 00270000 CA 00280000 CA 00290000 CA THE FUNCTION OF 'SADBIA' IS TO APPLY DEBIASING TO A TRACE. 00300000 CA 00310000 C EJECT 00320000 C OPERATIONS APPLIED. 00330000 C 00340000 C 1. FIRST THE TRACE IS SCANNED TO FIND THE FIRST LIVE 00350000 C (NON-ZERO) VALUE. 00360000 C 00370000 C 2. THEN THE TRACE IS SCANNED BACKWARDS, IF NOT FOUND KILLED 00380000 C STEP 1, IN ORDER TO FIND THE LAST LIVE(NON-ZERO) SAMPLE. 00390000 C 00400000 C 3. A SET OF DEBIAS FACTORS IS COMPUTED FOR EACH SAMPLE. 00410000 C 00420000 C 4. THE INPUT TRACE IS DEBIASED BY SUBTRACTING EACH DATA 00430000 C SAMPLE BY ITS CORRESPONDING DEBIAS FACTOR, AND STORING 00440000 C IT IN OTR. 00450000 C 00460000 C 00470000 C EJECT 00480000 C LOCAL OR INTERNAL VARIABLES AND CONSTANTS. 00490000 C 00500000 C WH = HALF THE WINDOW LENGTH I4 00510000 C W = WINDOW LENGTH (WH*2 + 1) I4 00520000 C NSAMP = NUMBER OF SAMPLES I4 00530000 C NN = NUMBER OF SAMPLES MINUS ONE I4 00540000 C NW = NUMBER OF LIVE SAMPLES I4 00550000 C IST = INDEX OF THE FIRST LIVE SAMPLE I4 00560000 C IEND = INDEX OF THE LAST LIVE SAMPLE I4 00570000 C 00580000 C EJECT 00590000 SUBROUTINE SADBIA (INTR, OTR, NSAMP, SSMPL, ESMPL, WINDL, 00600001 * CONAMP) 00610001 C 00620000 IMPLICIT INTEGER (A-Z) 00630000 C EXTERNAL S1ATP 00640000 C 00650000 C REAL ARRAYS IN PARAMETER LIST. 00660000 C 00670000 REAL INTR (1) 00680000 REAL OTR (1) 00690000 C 00700000 C REAL VARIABLES -- LOCAL 00710000 C 00720000 REAL SUM 00730000 REAL AMPCON 00740000 C 00750000 IF (1.EQ.2) CALL S1ATP 00760000 C 00770000 WH = WINDL / 2 00780000 W = WH * 2 + 1 00790000 C 00800000 C FIND THE FIRST LIVE VALUE OF THE TRACE 00810000 C 00820000 NN = NSAMP - 1 00830000 C 00840000 DO 10 00850000 * I = 1, NN 00860000 IF (INTR(I) .NE. 0.0) GO TO 20 00870000 C 00880000 10 CONTINUE 00890000 C 00900000 GO TO 70 00910000 C 00920000 20 IST = I 00930000 C 00940000 C FIND THE LAST LIVE VALUE OF THE TRACE 00950000 C 00960000 II = NSAMP 00970000 C 00980000 DO 30 00990000 * I = 1, NN 01000000 IF (INTR(II) .NE. 0.0) GO TO 40 01010000 II = II - 1 01020000 C 01030000 30 CONTINUE 01040000 C 01050000 GO TO 70 01060000 C 01070000 40 IEND = II 01080000 IF (SSMPL .LT. IST) SSMPL = IST 01090000 IF (ESMPL .GT. IEND) ESMPL = IEND 01100000 NW = ESMPL - SSMPL + 1 01110000 IF (W .GE. NSAMP) GO TO 50 01120000 IF (NW .LT. 3) GO TO 70 01130000 C 01140000 C CHECK FOR WINDOW GREATER THAN NUMBER OF LIVE SAMPLES 01150000 C 01160000 IF (W .GE. NW) GO TO 50 01170000 WH = W / 2 01180000 IF (WH .LT. 1) GO TO 70 01190000 C 01200000 C ARMEAN SLIDES A WINDOW OF W POINTS ALONG THE INPUT 01210000 C ARRAY INTR AND WRITES IN ARRAY OTR THE SUM OF THE 01220000 C VALUES DIVIDED BY W. THE OUTPUT LENGTH OF OTR EQUALS 01230000 C NW - W + 1 01240000 C 01250000 CALL ARMEAN (INTR(SSMPL), OTR(SSMPL+WH), NW, W) 01260000 C 01270000 C ARSET SET THE CONTENTS OF (OTR(I),I=SSMPL,SSMPL+WH-1) 01280000 C TO OTR(SSMPL+WH). 01290000 C 01300000 CALL ARSET (OTR(SSMPL), WH, OTR(SSMPL+WH)) 01310000 C 01320000 C ARSET SET THE CONTENTS OF (OTR(I),I=ESMPL-WH+1,ESMPL) 01330000 C TO OTR(ESMPL-WH) 01340000 C 01350000 CALL ARSET (OTR(ESMPL-WH+1), WH, OTR(ESMPL-WH)) 01360000 C 01370000 C DEBIAS THE DATA 01380000 C 01390000 IF (CONAMP .EQ. 0) THEN 01400000 CALL ARSBF (INTR(SSMPL), OTR(SSMPL), OTR(SSMPL), NW) 01410000 ELSE 01420000 AMPCON = CONAMP 01430000 CALL ARSBFC (INTR(SSMPL), OTR(SSMPL), AMPCON, NW) 01440000 ENDIF 01450000 GO TO 60 01460000 C 01470000 50 CONTINUE 01480000 IF (CONAMP .EQ. 0) THEN 01490000 CALL ARSMF (INTR(SSMPL), NW, SUM) 01500000 SUM = SUM / NW 01510000 CALL ARSBFC (INTR(SSMPL), OTR(SSMPL), SUM, NW) 01520000 ELSE 01530000 AMPCON = CONAMP 01540000 CALL ARSBFC (INTR(SSMPL), OTR(SSMPL), AMPCON, NW) 01550000 ENDIF 01560000 C 01570000 C KILL ENDS OF TRACE BEFORE RETURN 01580000 C 01590000 60 CALL ARSET (OTR, IST-1, 0.0) 01600000 CALL ARSET (OTR(IEND+1), NSAMP-IEND, 0.0) 01610000 C 01620000 70 RETURN 01630000 END 01640000