CTITLESAIED1 -- CALCULATE AVERAGES FOR ATTRIBUTES IN ONE FILE FOR AIED 00010000 C*********************************************************************** C COPYRIGHT ATLANTIC RICHFIELD COMPANY 1991 * C*********************************************************************** CA AUTHOR RANDY PROBST 00020000 CA DESIGNER RANDY PROBST 00030000 CA LANGUAGE FORTRAN 00040000 CA SYSTEM IBM AND CRAY 00050000 CA WRITTEN 09-19-86 00060000 C REVISED 12-21-87 REP. ADD NKILL PARM TO ARG LIST AND KILL LOGIC. 00070001 CA 00080000 CA CALL SAIED1 (AT, AV, NKILL, NTA, NWA, NTF, NWT, NTAT, NWAT, 00090001 CA CTAT, CWAT, TE, TEW, FQ, TFN1, TFX1) 00100000 CA IN AT = ARRAY OF ATTRIBUTES R/I4 00110000 CA OUT AV = ARRAY OF AVERAGES WITHIN A FILE R4 00120000 CA OUT NKILL = # OF TRACES KILLED DUE TO FREQ RANGE I4 00130001 CA IN NTA = # TRACES TO AVERAGE I4 00140000 CA IN NWA = # WINDOWS TO AVERAGE I4 00150000 CA IN NTF = # TRACES PER FILE I4 00160000 CA IN NWT = # WINDOWS PER TRACE I4 00170000 CA IN NTAT = # AVERAGED TRACE ATTRIBUTES I4 00180000 CA IN NWAT = # AVERAGED WINDOW ATTRIBUTES I4 00190000 CA IN CTAT = # NON-AVERAGED TRACE ATTRIBUTES I4 00200000 CA IN CWAT = # NON-AVERAGED WINDOW ATTRIBUTES I4 00210000 CA IN TE = # WORDS FOR EACH TRACE IN TABLE I4 00220000 CA IN TEW = # WORDS FOR EACH WINDOW IN TABLE I4 00230000 CA IN FQ = OFFSET OF FREQUENCY ATTRIBUTE IN TABLE I4 00240000 CA IN TFN1 = MINIMUM AVERAGE FREQUENCY R4 00250000 CA IN TFX1 = MAXIMUM AVERAGE FREQUENCY R4 00260000 CA 00270000 CA 00280000 CA THIS ROUTINE CALCULATES THE AVERAGES AND RMS VARIATIONS FOR THE 00290000 CA ATTRIBUTES WITHIN A FILE FOR NTA & NWA. IT WILL ALSO KILL A TRACE00300001 CA IF HALF THE TRACES IN THE AVERAGING ARE OUT OF THE FREQUENCY 00310001 CA RANGE. THEY MUST BE CONSECUTIVE AND CENTERED ON THE KILLED TRACE.00320001 CA 00330001 CA 00340001 SUBROUTINE SAIED1 (AT, AV, NKILL, NTA, NWA, NTF, NWT, NTAT, NWAT, 00350001 + CTAT, CWAT , TE, TEW, FQ, TFN1, TFX1) 00360000 IMPLICIT INTEGER (A-Z) 00370000 C 00380000 C REAL ARRAYS IN PARAMETER LIST. 00390000 REAL AT (1) 00400000 REAL AV (1) 00410000 C 00420000 C REAL VARIABLES IN PARAMETER LIST. 00430000 REAL TFN1 00440000 REAL TFX1 00450000 C 00460000 C LOCAL VARIABLES 00470000 REAL RTMP1 00480000 REAL RTMP2 00490000 REAL RTMP3 00500000 REAL MIN 00510000 REAL MAX 00520000 C 00530000 REAL RTRKF 00540000 INTEGER TRKF 00550000 EQUIVALENCE (TRKF, RTRKF) 00560000 C 00570000 REAL RPFBW 00580000 INTEGER TPFBW 00590000 EQUIVALENCE (TPFBW, RPFBW) 00600000 C 00610000 C LOCAL CONSTANTS 00620000 INTEGER FQKIL 00630006 INTEGER KILL 00640002 INTEGER PFBW 00650000 REAL NOCCC 00660000 INTEGER KF 00670000 INTEGER WKF 00680000 C 00690000 C KILL / Z40000000 / 00700000 DATA KILL / 1073741824 / 00710000 C FQKIL / Z40010000 / 00720006 DATA FQKIL / 1073807360 / 00730006 C PFBW / Z10000000 / 00740000 DATA PFBW / 268435456 / 00750000 DATA NOCCC / -99999.0 / 00760000 DATA KF / 1 / 00770000 DATA WKF / 0 / 00780000 C 00790000 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 00800000 C WRITE(6,99990) 00810000 C + NTA,NWA,NTF,NWT,NTAT,NWAT,CTAT,CWAT,TE,TEW,FQ,TFN1,TFX1 00820000 C9990 FORMAT(' NTA,NWA,NTF,NWT,NTAT,NWAT,CTAT,CWAT,TE,TEW,FQ,TFN1,TFX1',00830000 C + /11I6,2F4.1) 00840000 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 00850000 C 00860000 NKILL = 0 00870001 C 00880001 C LOOP ON ALL THE TRACES IN THIS FILE 00890000 C 00900000 DO 3100 NT = 1, NTF 00910000 T = (NT-1) * TE + 1 00920000 S = ((NT-1) * (NTAT*2 + (NWT * NWAT*2))) + 1 00930000 C 00940003 C SET RANGE OF TRACES TO SEARCH FOR GOOD TRACES TO DETERMINE KILL 00950001 C 00960000 N = NTA/2 00970001 IF (N/2*2 .EQ. N) N = N + 1 00980001 T1 = NT - N/2 00990001 T2 = NT + N/2 01000001 IF (T1 .LT. 1) THEN 01010000 T1 = 1 01020000 T2 = N 01030001 END IF 01040000 IF (T2 .GT. NTF) THEN 01050000 T2 = NTF 01060000 T1 = T2 - N + 1 01070001 IF (T1 .LT. 1) T1 = 1 01080000 END IF 01090000 T1 = (T1-1) * TE + 1 01100000 T2 = (T2-1) * TE + 1 01110000 C 01120001 C COUNT GOOD TRACES IN HALF THE RANGE TO BE AVERAGED ON, 01130001 C IF NONE ARE FOUND THEN SET KILL FLAG FOR THIS TRACE. 01140001 C 01150001 RTRKF = AT(T+KF) 01160003 IF (TRKF .GE. KILL) GO TO 3015 01170003 GOOD = 0 01180005 DO 3010 TT = T1, T2, TE 01190001 RTRKF = AT(TT+KF) 01200001 IF (TRKF .GE. KILL) GO TO 3010 01210001 IF (AT(TT+XX) .EQ. NOCCC) GO TO 3010 01220001 IF (AT(TT+FQ) .LT. TFN1 .OR. 01230001 + AT(TT+FQ) .GT. TFX1 ) GO TO 3010 01240003 GOOD = GOOD + 1 01250001 3010 CONTINUE 01260001 IF (GOOD .EQ. 0) THEN 01270001 RTRKF = AT(T+KF) 01280003 TRKF = TRKF + FQKIL 01290006 AT(T+KF) = RTRKF 01300001 NKILL = NKILL + 1 01310001 END IF 01310108 CDEBUG------------ 01311007 C WRITE(6,99999) NT,AT(T),TT,T1,T2,GOOD,NKILL 01340011 C9999 FORMAT(' SAIED1 -NT,AT(T),TT,T1,T2,GOOD,NKILL-',8I8) 01350011 CDEBUG------------ 01360004 3015 CONTINUE 01370003 C-------------------------------------------------------------------- 01380001 C SET RANGE OF TRACES TO AVERAGE ON FOR THIS TRACE 01390001 C 01400001 T1 = NT - NTA/2 01410001 T2 = NT + NTA/2 01420001 IF (T1 .LT. 1) THEN 01430001 T1 = 1 01440001 T2 = NTA 01450001 END IF 01460001 IF (T2 .GT. NTF) THEN 01470001 T2 = NTF 01480001 T1 = T2 - NTA + 1 01490001 IF (T1 .LT. 1) T1 = 1 01500001 END IF 01510001 T1 = (T1-1) * TE + 1 01520001 T2 = (T2-1) * TE + 1 01530001 C 01540000 C DO TRACE ATTRIBUTES FIRST 01550000 C (LOOPING ON EACH ATTRIBUTE TO BE AVERAGED) 01560000 C 01570000 DO 3040 I = 1, NTAT 01580000 XX = (I-1) + CTAT 01590000 XS = (I-1) * 2 01600000 RTRKF = AT(T+KF) 01610006 IF ( TRKF .GE. KILL .OR. 01620006 + AT(T+XX) .EQ. NOCCC ) THEN 01630006 C AV(S+XS ) = 0.0 01640000 C AV(S+XS+1) = 0.0 01650000 CDEBUG---------- 01660010 C WRITE(6,99991) NT, T1, T2, T, S, XX, XS 01670010 C9991 FORMAT(' KILLED -NT, T1, T2, T, S, XX, XS', 7I6) 01680010 CDEBUG---------- 01681010 C GO TO 3040 01700000 END IF 01710009 C 01720000 C MAKE 2 PASSES AVERAGING (THROWING OUT BAD VALUES ON 2ND) 01730000 C 01740000 DO 3030 J = 1, 2 01750000 CNT = 0 01760000 RTMP1 = 0.0 01770000 RTMP2 = 0.0 01780000 C 01790000 DO 3025 TT = T1, T2, TE 01800000 RTRKF = AT(TT+KF) 01810000 IF (TRKF .GE. KILL) GO TO 3025 01820000 IF (AT(TT+XX) .EQ. NOCCC) GO TO 3025 01830000 IF (AT(TT+FQ) .LT. TFN1 .OR. 01840000 + AT(TT+FQ) .GT. TFX1 ) GO TO 3025 01850000 IF (J .EQ. 2) THEN 01860000 IF (AT(TT+XX) .LT. MIN ) GO TO 3025 01870000 IF (AT(TT+XX) .GT. MAX ) GO TO 3025 01880000 END IF 01890000 CNT = CNT + 1 01900000 RTMP1 = RTMP1 + AT(TT+XX) 01910000 RTMP2 = RTMP2 + (AT(TT+XX) * AT(TT+XX)) 01920000 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 01930000 C WRITE(6,99992) NT,T,S,TT,J,CNT,RTMP1,RTMP2,MIN,MAX,AT(TT+FQ) 01940000 C9992 FORMAT(' 3025 -NT,T,S,TT,J,CNT,RTMP1,RTMP2,MIN,MAX'/6I6,5E13.5) 01950000 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 01960000 3025 CONTINUE 01970000 C 01980000 IF (CNT .GT. 0) THEN 01990000 RTMP1 = RTMP1 / CNT 02000000 RTMP2 = RTMP2 / CNT 02010000 RTMP2 = ABS (RTMP2-(RTMP1*RTMP1)) 02020000 RTMP3 = SQRT (RTMP2) 02030000 MIN = RTMP1 - (2 * RTMP3) 02040000 MAX = RTMP1 + (2 * RTMP3) 02050000 ELSE 02060000 IF (J .EQ. 2) GO TO 3040 02070000 END IF 02080000 AV(S+XS ) = RTMP1 02090000 AV(S+XS+1) = RTMP2 02100000 3030 CONTINUE 02110000 3040 CONTINUE 02120000 C 02130000 C LOOP ON EACH WINDOW IN TRACE 02140000 C 02150000 IF (NWT .LE. 0) GO TO 3100 02160000 DO 3080 W = 1, NWT 02170000 TW = ((W-1) * TEW) + (CTAT + NTAT) + T 02180000 SW = ((W-1) * NWAT*2) + (NTAT*2) + S 02190000 C 02200000 C SET RANGE OF WINDOWS TO AVERAGE ON FOR THIS WINDOW 02210000 C 02220000 W1 = W - NWA/2 02230000 W2 = W + NWA/2 02240000 IF (W1 .LT. 1) W1 = 1 02250000 IF (W2 .GT. NWT) W2 = NWT 02260000 C 02270000 C DO WINDOWED ATTRIBUTES NOW 02280000 C 02290000 DO 3070 I = 1, NWAT 02300000 XX = (I-1) + CWAT 02310000 XS = ((I-1) * 2) 02320000 CCC RPFBW = AT(TW+WKF) 02330000 C IF (TPFBW .GE. PFBW .OR. 02340000 C + AT(TW+XX) .EQ. NOCCC ) THEN 02350000 C AV(SW+XS ) = 0.0 02360000 C AV(SW+XS+1) = 0.0 02370000 C GO TO 3070 02380000 CCC END IF 02390000 C 02400000 C MAKE 2 PASSES AVERAGING (THROWING OUT BAD VALUES ON 2ND) 02410000 C 02420000 DO 3060 J = 1, 2 02430000 CNT = 0 02440000 RTMP1 = 0.0 02450000 RTMP2 = 0.0 02460000 C 02470000 DO 3057 TT = T1, T2, TE 02480000 RTRKF = AT(TT+KF) 02490000 IF (TRKF .GE. KILL) GO TO 3057 02500000 IF (AT(TT+FQ) .LT. TFN1 .OR. 02510000 + AT(TT+FQ) .GT. TFX1 ) GO TO 3057 02520000 WW1 = (W1-1) * TEW + (CTAT + NTAT) + TT 02530000 WW2 = (W2-1) * TEW + (CTAT + NTAT) + TT 02540000 C 02550000 DO 3055 WW = WW1, WW2, TEW 02560000 RPFBW = AT(WW+WKF) 02570000 IF (TPFBW .GE. PFBW) GO TO 3055 02580000 IF (AT(WW+XX) .EQ. NOCCC) GO TO 3055 02590000 IF (J .EQ. 2) THEN 02600000 IF (AT(WW+XX) .LT. MIN ) GO TO 3055 02610000 IF (AT(WW+XX) .GT. MAX ) GO TO 3055 02620000 END IF 02630000 CNT = CNT + 1 02640000 RTMP1 = RTMP1 + AT(WW+XX) 02650000 RTMP2 = RTMP2 + (AT(WW+XX) * AT(WW+XX)) 02660000 3055 CONTINUE 02670000 3057 CONTINUE 02680000 C 02690000 IF (CNT .GT. 0) THEN 02700000 RTMP1 = RTMP1 / CNT 02710000 RTMP2 = RTMP2 / CNT 02720000 RTMP2 = ABS (RTMP2-(RTMP1*RTMP1)) 02730000 RTMP3 = SQRT (RTMP2) 02740000 MIN = RTMP1 - (2 * RTMP3) 02750000 MAX = RTMP1 + (2 * RTMP3) 02760000 ELSE 02770000 IF (J .EQ. 2) GO TO 3070 02780000 END IF 02790000 AV(SW+XS ) = RTMP1 02800000 AV(SW+XS+1) = RTMP2 02810000 3060 CONTINUE 02820000 3070 CONTINUE 02830000 3080 CONTINUE 02840000 3100 CONTINUE 02850000 RETURN 02860000 END 02870000