CTITLESAFLTA -- AP SIMULATOR FOR FILTER APPLICATION FOR LA3D C*********************************************************************** C COPYRIGHT ATLANTIC RICHFIELD COMPANY 1991 * C*********************************************************************** CA AUTHOR T. J. TRULOCK CA DESIGNER T. J. TRULOCK CA LANGUAGE VS FORTRAN CA SYSTEM IBM CA WRITTEN 06-29-89 C REVISED 09-20-89 TJT - FIX POINTER PROBLEMS IN FILTER. C REVISED XX-XX-XX CA CA CA CALL SAFLTA (DLOCAL, BULK, ZBULK, IBULK, W, LW, KPRTF, KPPRNT) CA CA INPUT DLOCAL = PARAMETER ARRAY FROM CALLING ROUTINE I8 CA WORK BULK = ARRAY USED TO IMAGE 3838 BULK STORAGE R8 CA WORK ZBULK = ARRAY USED TO IMAGE 3838 BULK STORAGE R8 CA WORK IBULK = ARRAY USED TO IMAGE 3838 BULK STORAGE I4 CA WORK W = WORK ARRAY FOR SIMULATION R8 CA INPUT LW = LENGTH OF W (WORDS) I8 CA CA THIS SUBROUTINE PERFORMS THE COMPUTATIONS NECESSARY FOR CA APPLYING A FILTER OPERATOR TO THE AREAL PILOT. CA C EJECT C C LOCAL OR INTERNAL ARRAYS. C C COM ( 1) = COMMON ARRAY I8 C C LOCAL OR INTERNAL VARIABLES AND CONSTANTS. C C NXARRV = ADDRESS OF X OPERAND I8 C NICTX = LENGTH OF X OPERAND I8 C NYARRV = ADDRESS OF Y OPERAND I8 C NICTY = LENGTH OF Y OPERAND I8 C NUARRV = ADDRESS OF U OPERAND I8 C NICTU = LENGTH OF U OPERAND I8 C SUBROUTINE SAFLTA . (DLOCAL, BULK, ZBULK, IBULK, W, LW, KPRTF, KPPRNT ) C IMPLICIT INTEGER (A-Z) C COMMON /SYSTEM/ SYSTEM C COMMON COM (1) C C INTEGER ARRAYS C INTEGER DLOCAL (90) INTEGER IBULK ( 2) INTEGER R (15) C C REAL ARRAYS AND VARIABLES C REAL BULK ( 2) REAL W ( 2) REAL ZBULK ( 2) REAL CVMGZ REAL SCALE REAL UVPSS C EQUIVALENCE ( R( 1), R1 ) EQUIVALENCE ( R( 2), R2 ) EQUIVALENCE ( R( 3), R3 ) EQUIVALENCE ( R( 4), R4 ) EQUIVALENCE ( R( 5), R5 ) EQUIVALENCE ( R( 6), R6 ) EQUIVALENCE ( R( 7), R7 ) EQUIVALENCE ( R( 8), R8 ) EQUIVALENCE ( R( 9), R9 ) EQUIVALENCE ( R(10), R10) EQUIVALENCE ( R(11), R11) EQUIVALENCE ( R(12), R12) EQUIVALENCE ( R(13), R13) EQUIVALENCE ( R(14), R14) EQUIVALENCE ( R(15), R15) C C FLOWCHART FOR FILTER APPLICATION C C TRANSFER OPERATORS TO 3838 AS ONE BLOCK: C 3838 ADDRESS 0. # OF OPERATORS C 1-4. FFT LENGTHS OF EACH OPERATOR C 5. 1.0 C 6. 0.5 C 7-10. RESERVED FOR OPERATOR FLAGS C 11-14. FOR FUTURE USE C 15- . OPERATORS IN FREQUENCY DOMAIN C ^ C ^ C R5 = TOTAL # OF ELEMENTS TRANSMITTED ABOVE C ^ C ^ C TRANSFER TIME GATES AS ONE BLOCK TO LOCATION 0 C INDEXED BY R5 C ^ C ^ C R8 = # OF ELEMENTS TRANSMITTED ABOVE C ^ C ^ C R1 = # OF OPERATORS C ^ C ^ C R2 = 0 (TO BE USED AS INDEX FOR GETTING FFT LENGTH) C ^ C ^ C R3 = 15 (TO BE USED AS INDEX FOR START OF OPERATORS) C ^ C ^ C R4 = R5 (TO BE USED AS INDEX FOR TIME GATES) C ^ C ^ C R8 = R8 + R5 C ^ C LUP2 --> ^ C R2 = R2 + 1 C ^ C ^ C R6 = LENGTH OF FFT (AT LOCATION IN R2) C ^ C ^ C R7 = R6 / 2 + 1 (LENGTH OF FFT RESULT) C ^ C ^ C PERFORM FFT ON TRACE AT LOCATION IN R4 C PUTTING RESULT AT LOCATION IN R8 C ^ C ^ C PERFORM CMCO BETWEEN LOCATION IN R8 AND OPERATOR C IN R3 PUTTING RESULT BACK AT LOCATION IN R8 C ^ C ^ C PERFORM IFTR ON LOCATION IN R8 PUTTING RESULT C AT LOCATION IN R4 AND SCALE RESULT FOR FFT C ^ C ^ C SET INDEXES FOR NEXT FFT C (R7 = R7 * 2; R4 = R4 + R7; R3 = R3 + R7) C ^ C ^ C R1 = R1 - 1 C ^ C NO ^ C GO TO LUP2 <---- R1 = 0? C ^ C ^ C TRANSFER TRACE BACK TO 370 C C C****C****C****C****C****C****C****C****C****C****C****C******* C C COMMANDS FOR 3838 ARRAY PROCESSOR TO TAKE THE FOUR C FILTER TIME GATES AND APPLY THE OPERATORS DEVELOPED C ABOVE C ==================================================================== C NUMOP = DLOCAL(11) TGATE = DLOCAL(12) NWORDS = DLOCAL(13) NWDM15 = DLOCAL(14) MTFLG = DLOCAL(83) APMUT = DLOCAL(90) NXARRV = 0 CALL ARMVE (COM(NUMOP), BULK(NXARRV), NWORDS) R5 = NWORDS NXARRV = R5 CALL ARMVE (COM(TGATE), BULK(NXARRV), NWDM15) R8 = NWDM15 C MOVE # OF OPERATORS TO R1 NYARRV = 0 R1 = IBULK(NYARRV) C LOAD INDEXING REGISTERS R2 = 0 R3 = 15 R4 = R5 R8 = R8 + R5 C DEVELOPE MUTE OPERATOR NYARRV = APMUT NICTY = NWDM15 NXARRV = R4 CDIR$ IVDEP IF (S1CPCH(SYSTEM,1,'CRAY',1,4) .EQ. 0) THEN DO 100 IVPSS = 1, NICTY 100 BULK(IVPSS-1 + NYARRV) = CVMGZ(0.0, 1.0, BULK(IVPSS-1 + NXARRV)) ELSE CDIR$ IVDEP DO 101 IVPSS = 1, NICTY BULK(IVPSS - 1 + NYARRV) = 1.0 IF(ZBULK(IVPSS-1+NXARRV) .EQ. 0.0) BULK(IVPSS-1+NYARRV) = 0.0 101 CONTINUE ENDIF 200 CONTINUE C GET FFT LENGTH R2 = R2 + 1 NYARRV = R2 R6 = IBULK(NYARRV) R7 = R6 R7 = R7 / 2 R7 = R7 + 1 C NOW DO FFT NYARRV = R8 NICTY = R7 NXARRV = R4 NICTX = R6 C CALL ARMVE (BULK(NXARRV), BULK(NYARRV), NICTX) CALL S1FMAG (NICTX, MAG, LFOUR) CALL S2DFT2 (MAG, BULK(NYARRV), *9010) NP2 = NICTX + 2 SCALE = SQRT(NICTX*2.0) DO 75031 I = 1, NP2, 2 75031 BULK(NYARRV+I-1) = SCALE * BULK(NYARRV+I-1) DO 75032 I = 2, NP2, 2 75032 BULK(NYARRV+I-1) = - SCALE * BULK(NYARRV+I-1) C MULTIPLY BY OPERATOR NYARRV = R8 NICTY = R7 NXARRV = R8 NUARRV = R3 CALL ARMPC (BULK(NXARRV), BULK(NUARRV), BULK(NYARRV), NICTY) C MOVE TAKE INVERSE FFT NYARRV = R4 NICTY = R6 NXARRV = R8 NICTX = R7 IF (LW. LT. (NICTX+2)) GO TO 9000 NP2 = NICTY + 2 DO 75042 I = 1, NP2, 2 75042 W(I) = BULK(NXARRV+I-1) DO 75043 I = 2, NP2, 2 75043 W(I) = -BULK(NXARRV+I-1) CALL S1FMAG (NICTY, MAG, LFOUR) CALL S2DFI2 (MAG, W, *9010) SCALE = SQRT(NICTY*2.0) DO 75044 I = 1, NICTY 75044 BULK(NYARRV+I-1) = SCALE * W(I) C SCALE RESULT BULK( R8 +1) = IBULK( R2) C GET VALUE OF 0.5/N NYARRV = 1 + R8 NXARRV = 1 + R8 NUARRV = 6 UVPSS = BULK(NUARRV) BULK(NYARRV) = UVPSS / BULK(NXARRV) C SCALE BY 0.5/N NYARRV = R4 NICTY = R6 NXARRV = R4 NUARRV = 1 + R8 UVPSS = BULK(NUARRV) CDIR$ IVDEP DO 500 IVPSS = 1, NICTY 500 BULK(IVPSS - 1 + NYARRV) = UVPSS * ZBULK(IVPSS - 1 + NXARRV) C SET UP INDEXES FOR NEXT FFT R7 = R7 * 2 R4 = R4 + R7 R3 = R3 + R7 C NOW GO BACK TO LOOP2 IF THERE ARE ANYMORE TIME GATES R1 = R1 - 1 IF (R1 .GT. 0) GO TO 200 C APPLY MUTE OPERATOR IF (MTFLG.NE.1) GO TO 700 NYARRV = R5 NICTY = NWDM15 NXARRV = R5 NUARRV = APMUT CDIR$ IVDEP DO 600 IVPSS = 1, NICTY 600 BULK(IVPSS-1+NYARRV) = ZBULK(IVPSS-1+NXARRV)*ZBULK(IVPSS-1+NUARRV) 700 NXARRV = R5 CALL ARMVE (BULK(NXARRV), COM(TGATE), NWDM15) C RETURN C ERROR DIAGNOSTICS AND EXIT 9000 WRITE (KPPRNT, 9900) IF (LW.GE.0) LW = -LW - 1000000 GO TO 9470 C 9010 WRITE (KPPRNT, 9910) C 9470 KPRTF = -1 RETURN C 9900 FORMAT (/5X,'*** NOT ENOUGH MEMORY AVAILABLE IN SAFLTA***') C 9910 FORMAT (/5X,'*** ERROR IN FFT -- CONTACT USER SUPPORT ***') END