*AINDMS1FFT -- FAST FOURIER TRANSFORM (COMPLEX) 00000003 C*********************************************************************** C COPYRIGHT ATLANTIC RICHFIELD COMPANY 1991 * C*********************************************************************** *TITLE S1FFT -- FAST FOURIER TRANSFORM (COMPLEX) 00000003 *A AUTHOR H. HOOGSTRAAT 00000004 *A DESIGNER H. HOOGSTRAAT 00000005 *A LANGUAGE S/370 ASSEMBLER 00000006 *A WRITTEN 00000007 * REVISED 00000008 *A 00000009 *A 00000010 *A CALL S1FFT (MAG, X) 00000011 *A INPUT MAG = MAGNITUDE OF TRANSFORM I4 00000012 *A I/O X = BASE ADDRESS OF INPUT/OUTPUT ARRAY C4 00000013 *A 00000014 *A 00000015 *A THIS ROUTINE PERFORMS A DIRECT FAST FOURIER TRANSFORM BY THE 00000016 *A COOLEY-TUKEY METHOD ON THE COMPLEX ARRAY X, WHOSE LENGTH IS 00000017 *A 2**MAG. THE REAL PART OF X CONTAINS ONE TRACE WHILE THE IMAGINARY00000018 *A PART CONTAINS A SECOND TRACE. MAG MUST BE LESS THAN OR EQUAL TO 00000019 *A 11. 00000020 *A 00000030 *A A SINE-COSINE TABLE OF 513 POINTS FROM 0-90 DEGREES MUST BE 00000040 *A PRESENT IN LABELLED COMMON /SCTAB/. IT CAN BE GENERATED BY A 00000050 *A CALL TO S1SCGN. 00000060 *A 00000070 *AEND 00000071 * 00000072 *TITLE S1FFTI -- INVERSE FAST FOURIER TRANSFORM (COMPLEX) 00000073 *A AUTHOR H. HOOGSTRAAT 00000074 *A DESIGNER H. HOOGSTRAAT 00000075 *A LANGUAGE S/370 ASSEMBLER 00000076 *A WRITTEN 00000077 * REVISED 00000081 *A 00000091 *A 00000101 *A CALL S1FFTI (MAG, X) 00000111 *A INPUT MAG = MAGNITUDE OF TRANSFORM I4 00000121 *A I/O X = BASE ADDRESS OF INPUT/OUTPUT ARRAY C4 00000131 *A 00000141 *A 00000151 *A THIS ROUTINE PERFORMS AN INVERSE DIRECT FAST FOURIER TRANSFORM BY 00000161 *A THE COOLEY-TUKEY METHOD ON THE COMPLEX ARRAY X, WHOSE LENGTH IS 00000171 *A 2**MAG. THE REAL PART OF X CONTAINS ONE TRACE WHILE THE IMAGINARY00000181 *A PART CONTAINS A SECOND TRACE. MAG MUST BE LESS THAN OR EQUAL TO 00000191 *A 11. 00000201 *A 00000211 *A A SINE-COSINE TABLE OF 513 POINTS FROM 0-90 DEGREES MUST BE 00000221 *A PRESENT IN LABELLED COMMON /SCTAB/. IT CAN BE GENERATED BY A 00000231 *A CALL TO S1SCGN. 00000241 *A 00000251 *AEND 00000252 * 00000253 *TITLE S1DFT -- FAST FOURIER TRANSFORM (REAL) 00000254 *A AUTHOR H. HOOGSTRAAT 00000255 *A DESIGNER H. HOOGSTRAAT 00000256 *A LANGUAGE S/370 ASSEMBLER 00000257 *A WRITTEN 00000258 * REVISED 00000259 *A 00000260 *A 00000261 *A CALL S1DFT (MAG, X) 00000262 *A INPUT MAG = MAGNITUDE OF TRANSFORM I4 00000263 *A I/O X = BASE ADDRESS OF INPUT/OUTPUT ARRAY R4 00000264 *A 00000265 *A 00000266 *A THIS ROUTINE PERFORMS A DIRECT FAST FOURIER TRANSFORM BY THE 00000267 *A COOLEY-TUKEY METHOD ON THE REAL ARRAY X, WHOSE LENGTH IS 2**MAG. 00000268 *A MAG MUST BE LESS THAN OR EQUAL TO 11. 00000269 *A 00000272 *A A SINE-COSINE TABLE OF 513 POINTS FROM 0-90 DEGREES MUST BE 00000273 *A PRESENT IN LABELLED COMMON /SCTAB/. IT CAN BE GENERATED BY A 00000274 *A CALL TO S1SCGN. 00000275 *A 00000276 *AEND 00000277 * 00000278 *TITLE S1DFTI -- INVERSE FAST FOURIER TRANSFORM (REAL) 00000279 *A AUTHOR H. HOOGSTRAAT 00000280 *A DESIGNER H. HOOGSTRAAT 00000281 *A LANGUAGE S/370 ASSEMBLER 00000282 *A WRITTEN 00000283 * REVISED 00000284 *A 00000285 *A 00000286 *A CALL S1DFTI (MAG, X) 00000287 *A INPUT MAG = MAGNITUDE OF TRANSFORM I4 00000288 *A I/O X = BASE ADDRESS OF INPUT/OUTPUT ARRAY R4 00000289 *A 00000290 *A 00000291 *A THIS ROUTINE PERFORMS AN INVERSE DIRECT FAST FOURIER TRANSFORM 00000292 *A BY THE COOLEY-TUKEY METHOD ON THE REAL ARRAY X, WHOSE LENGTH IS 00000293 *A 2**MAG. MAG MUST BE LESS THAN OR EQUAL TO 11. 00000294 *A 00000295 *A A SINE-COSINE TABLE OF 513 POINTS FROM 0-90 DEGREES MUST BE 00000296 *A PRESENT IN LABELLED COMMON /SCTAB/. IT CAN BE GENERATED BY A 00000297 *A CALL TO S1SCGN. 00000298 *A 00000299 *AEND 00000300 * 00000301 * 00000370 * ALL SIGN CONVENTIONS AND SCALING OF RESULTS IS HANDLED WITHIN 00000380 * THE INDIVIDUAL ROUTINES. 00000390 * 00000400 * ****** TIMING ****** 00000410 * -------------------- 00000420 * TIME FOR 2-WAY SINGLE TRACE FFT 00000430 * 00000440 * MAG TIME MAG TIME 00000450 * --- ---- --- ---- 00000460 * 370-135 370-165 00000470 * 8 256 MS 8 10.25 MS 00000480 * 9 640 MS 9 22.22 MS 00000490 * 10 1400 MS 10 47.91 MS 00000500 * 11 2960 MS 11 102.54 MS 00000510 * 00000520 * TIME FOR 2-WAY DOUBLE TRACE FFT 00000530 * 00000540 * MAG TIME MAG TIME 00000550 * --- ---- --- ---- 00000560 * 370-135 370-165 00000570 * 8 540 MS 8 19.88 MS 00000580 * 9 1220 MS 9 43.04 MS 00000590 * 10 2600 MS 10 92.27 MS 00000600 * 11 6120 MS 11 218.10 MS 00000610 * 00000620 * 00000630 * ====================================================== 00000640 * * PROGRAM DEVELOPED BY 00000650 * * H * HOOGSTRAAT PROGRAMMING SERVICES LTD. 00000660 * * P S * BOX 20, SITE 7, SS #1 00000670 * * * * * * * * CALGARY, ALTA. CANADA PH 288-8088 00000680 * ====================================================== 00000690 * 00000700 S1FFT CSECT 00000710 ENTRY S1FFTI 00000720 ENTRY S1FFT 00000730 ENTRY S1DFT 00000740 ENTRY S1DFTI 00000750 COPY S1REG 00000751 * 00000752 X EQU R1 00000753 Y EQU R2 00000754 BASER EQU R15 00000755 * 00000760 USING *,BASER 00000770 BASEADD STM R14,R12,12(R13) SAVE CALLING ROUTINES REGISTERS 00000780 * 00000790 LA R3,1 00000800 LA R2,0 INDICATE SINGLE TRACE TRANSFORM 00000810 * 00000820 FOUR00 ST R3,SIGN 00000830 ST R2,DOUBLE 00000840 LM R5,R6,0(R1) GET CALLING SEQUENCE PARAMETERS 00000850 LR X,R6 00000860 LA Y,4(X) 00000870 * 00000880 L R9,0(R5) 00000890 L R7,DOUBLE 00000900 LTR R7,R7 00000910 BZ FOUR02 00000920 S R9,=F'1' 00000930 FOUR02 ST R9,MAG 00000940 * 00000950 LA R7,1 00000960 SLA R7,3(R9) 00000970 ST R7,LENG LENG=2**MAG 00000980 * 00000990 S R7,=F'1' 00001000 ST R7,LENGM1 00001010 * 00001020 LTR R3,R3 00001030 BP FOUR05 00001040 * 00001050 BAL R14,REALTR 00001060 * 00001070 LA R5,0 FLIP SIGN OF IMAGINARY PART ON 00001080 LA R6,8 INVERSE TRANSFORM 00001090 L R7,LENGM1 00001100 * 00001110 FOUR03 LE FR0,0(Y,R5) 00001120 LCER FR0,FR0 00001130 STE FR0,0(Y,R5) 00001140 BXLE R5,R6,FOUR03 00001150 * 00001160 FOUR05 L R9,MAG 00001170 LA R9,1(R9) 00001180 ST R9,MAGP1 MAGP1=MAG+1 00001190 * 00001200 LA R3,2 00001210 FOUR10 L R8,LENG DO 400 K = 2, MAG, 2 00001220 SRA R8,0(R3) M=2**(MAG-K) 00001230 ST R8,M 00001240 * 00001250 LR R10,R8 00001260 S R10,=F'1' 00001270 ST R10,MM1 MM1 = M - 1 00001280 * 00001290 SLA R8,2 00001300 ST R8,M4 M4=M*4 00001310 * 00001320 LA R12,0 DO 300 J = 1, M 00001330 LA R4,9 00001340 S R4,MAG 00001350 AR R4,R3 00001360 LA R11,1 COMPUTE INCREMENT INDEX THRU SIN 00001370 SLA R11,2(R4) -COS TABLE 00001380 ST R11,INC 00001390 ST R12,ARG 00001400 * 00001410 * SINE-COSINE TRIGNOMETRIC IDENTITIES USED 00001420 * ---------------------------------------- 00001430 * 00001440 * SIN(A+PI/2) = COS(A) (1) 00001450 * COS(A+PI/2) =-SIN(A) (2) 00001460 * SIN(A+ PI) =-SIN(A) (3) 00001470 * COS(A+ PI) =-COS(A) (4) 00001480 * SIN(A+PI*2) = SIN(A) (5) 00001490 * COS(A+PI*2) = COS(A) (6) 00001500 * 00001510 FOUR20 L R9,=V(SCTAB) 00001520 L R10,ARG 00001530 LE FR0,0(R9,R10) 00001540 STE FR0,S1 S1=SIN(ARG) 00001550 * 00001560 LCR R7,R10 00001570 LE FR0,2048(R9,R7) 00001580 STE FR0,C1 C1=COS(ARG) 00001590 * 00001600 LA R7,0(R10,R10) COMPUTE ARG*2 00001610 C R7,=F'2048' CHECK WHICH QUARDRANT 00001620 BL FOUR40 CHECK FOR ARG*2>PI/2 00001630 * 00001640 S R7,=F'2048' 00001650 LCR R6,R7 00001660 LE FR0,2048(R9,R6) 00001670 STE FR0,S2 S2=COS(ARG*2) 00001680 * 00001690 LE FR0,0(R9,R7) 00001700 LCER FR0,FR0 C2=-SIN(ARG*2) 00001710 STE FR0,C2 00001720 B FOUR50 00001730 * 00001740 FOUR40 LE FR0,0(R9,R7) 00001750 STE FR0,S2 S2=SIN(ARG*2) 00001760 * 00001770 LCR R7,R7 00001780 LE FR0,2048(R9,R7) 00001790 STE FR0,C2 C2=COS(ARG*2) 00001800 * 00001810 FOUR50 LA R7,0(R10,R10) COMPUTE ARG*3 00001820 LA R7,0(R10,R7) 00001830 C R7,=F'4096' CHECK WHICH QUARDRANT 00001840 BNL FOUR70 00001850 * 00001860 C R7,=F'2048' 00001870 BL FOUR60 00001880 * 00001890 S R7,=F'2048' 00001900 * 00001910 LCR R6,R7 00001920 LE FR0,2048(R9,R6) 00001930 STE FR0,S3 S3=COS(ARG*3) 00001940 * 00001950 LE FR0,0(R9,R7) 00001960 LCER FR0,FR0 00001970 STE FR0,C3 C3=-SIN(ARG*3) 00001980 B FOUR80 00001990 * 00002000 FOUR60 LE FR0,0(R9,R7) 00002010 STE FR0,S3 S3=SIN(ARG*3) 00002020 * 00002030 LCR R7,R7 00002040 LE FR0,2048(R9,R7) 00002050 STE FR0,C3 C3=COS(ARG*3) 00002060 B FOUR80 00002070 * 00002080 FOUR70 S R7,=F'4096' 00002090 LE FR0,0(R9,R7) 00002100 LCER FR0,FR0 00002110 STE FR0,S3 S3=-SIN(ARG*3) 00002120 * 00002130 LCR R7,R7 00002140 LE FR0,2048(R9,R7) 00002150 LCER FR0,FR0 00002160 STE FR0,C3 C3=-COS(ARG*3) 00002170 * 00002180 FOUR80 A R10,INC 00002190 ST R10,ARG 00002200 * 00002210 L R5,M4 00002220 FOUR90 LR R7,R5 DO 200 I= M4, N, M4 00002230 AR R7,R12 00002240 S R7,M4 00002250 * 00002260 L R11,M 00002270 LR R8,R7 J1=I+J-M4 00002280 LA R9,0(R8,R11) J2=J1+M 00002290 LA R10,0(R9,R11) J3=J2+M 00002300 LA R11,0(R10,R11) J4=J3+M 00002310 * 00002320 LE FR0,0(R8,X) 00002330 LE FR2,0(R10,X) 00002340 LER FR4,FR0 00002350 AER FR0,FR2 00002360 STE FR0,H1 H1=X(J1)+X(J3) 00002370 * 00002380 SER FR4,FR2 00002390 STE FR4,H2 H2=X(J1)-X(J3) 00002400 * 00002410 LE FR0,0(R8,Y) 00002420 LE FR2,0(R10,Y) 00002430 LER FR4,FR0 00002440 AER FR0,FR2 00002450 STE FR0,H3 H3=Y(J1)+Y(J3) 00002460 * 00002470 SER FR4,FR2 00002480 STE FR4,H4 H4=Y(J1)-Y(J3) 00002490 * 00002500 LE FR0,0(R9,X) 00002510 LE FR2,0(R11,X) 00002520 LER FR4,FR0 00002530 AER FR0,FR2 00002540 STE FR0,H5 H5=X(J2)+X(J4) 00002550 * 00002560 SER FR4,FR2 00002570 STE FR4,H6 H6=X(J2)-X(J4) 00002580 * 00002590 LE FR0,0(R9,Y) 00002600 LE FR2,0(R11,Y) 00002610 LER FR4,FR0 00002620 AER FR0,FR2 00002630 STE FR0,H7 H7=Y(J2)+Y(J4) 00002640 * 00002650 SER FR4,FR2 00002660 STE FR4,H8 H8=Y(J2)-Y(J4) 00002670 * 00002680 LE FR0,H1 00002690 AE FR0,H5 00002700 STE FR0,0(R8,X) X(J1)=H1+H5 00002710 * 00002720 LE FR0,H3 00002730 AE FR0,H7 00002740 STE FR0,0(R8,Y) Y(J1)=H3+H7 00002750 * 00002760 LTR R12,R12 IF(ARG.EQ.0) GO TO FOUR100 00002770 BZ FOUR100 00002780 * 00002790 LE FR0,H2 00002800 AE FR0,H8 00002810 LER FR2,FR0 HOLD2=H2+H8 00002820 * 00002830 ME FR0,C1 00002840 LER FR4,FR0 HOLD1=HOLD2*C1 00002850 * 00002860 LE FR0,H4 00002870 SE FR0,H6 00002880 LER FR6,FR0 HOLD3=H4-H6 00002890 * 00002900 ME FR0,S1 00002910 AER FR0,FR4 00002920 STE FR0,0(R10,X) X(J3)=(H2+H8)*C1+(H4-H6)*S1 00002930 * 00002940 LCER FR0,FR2 00002950 ME FR0,S1 00002960 LER FR4,FR0 00002970 LER FR0,FR6 00002980 ME FR0,C1 00002990 AER FR0,FR4 00003000 STE FR0,0(R10,Y) Y(J3)=(H4-H6)*C1-(H2+H8)*S1 00003010 * 00003020 LE FR0,H1 00003030 SE FR0,H5 00003040 LER FR2,FR0 HOLD2=H1-H5 00003050 ME FR0,C2 00003060 LER FR4,FR0 HOLD1=HOLD2*C2 00003070 * 00003080 LE FR0,H3 00003090 SE FR0,H7 00003100 LER FR6,FR0 HOLD3=H3-H7 00003110 ME FR0,S2 00003120 AER FR0,FR4 00003130 STE FR0,0(R9,X) X(J2)=(H1-H5)*C2+(H3-H7)*S2 00003140 * 00003150 LCER FR0,FR2 00003160 ME FR0,S2 00003170 LER FR4,FR0 00003180 LER FR0,FR6 00003190 ME FR0,C2 00003200 AER FR0,FR4 00003210 STE FR0,0(R9,Y) Y(J2)=(H3-H7)*C2-(H1-H5)*S2 00003220 * 00003230 LE FR0,H2 00003240 SE FR0,H8 00003250 LER FR2,FR0 HOLD2=H2-H8 00003260 ME FR0,C3 00003270 LER FR4,FR0 HOLD1=HOLD2*C3 00003280 * 00003290 LE FR0,H4 00003300 AE FR0,H6 00003310 LER FR6,FR0 HOLD3=H4+H6 00003320 ME FR0,S3 00003330 AER FR0,FR4 00003340 STE FR0,0(R11,X) X(J4)=(H2-H8)*C3+(H4+H6)*S3 00003350 * 00003360 LCER FR0,FR2 00003370 ME FR0,S3 00003380 LER FR4,FR0 HOLD1=-(H2-H8)*S3 00003390 LER FR0,FR6 00003400 ME FR0,C3 00003410 AER FR0,FR4 00003420 STE FR0,0(R11,Y) Y(J4)=(H4+H6)*C3-(H2-H8)*S3 00003430 B FOUR110 00003440 * 00003450 FOUR100 LE FR0,H2 00003460 AE FR0,H8 00003470 STE FR0,0(R10,X) X(J3)=H2+H8 00003480 * 00003490 LE FR0,H4 00003500 SE FR0,H6 00003510 STE FR0,0(R10,Y) Y(J3)=H4-H6 00003520 * 00003530 LE FR0,H1 00003540 SE FR0,H5 00003550 STE FR0,0(R9,X) X(J2)=H1-H5 00003560 * 00003570 LE FR0,H3 00003580 SE FR0,H7 00003590 STE FR0,0(R9,Y) Y(J2)=H3-H7 00003600 * 00003610 LE FR0,H2 00003620 SE FR0,H8 00003630 STE FR0,0(R11,X) X(J4)=H2-H8 00003640 * 00003650 LE FR0,H4 00003660 AE FR0,H6 00003670 STE FR0,0(R11,Y) Y(J4)=H4+H6 00003680 * 00003690 FOUR110 A R5,M4 00003700 C R5,LENG 00003710 BNH FOUR90 END OF DO 200 00003720 * 00003730 LA R12,8(R12) J=J+1 00003740 C R12,MM1 00003750 BL FOUR20 END OF DO 300 00003760 * 00003770 LA R3,2(R3) K=K+2 00003780 C R3,MAGP1 00003790 BL FOUR10 END OF DO 400 00003800 * 00003810 FOUR120 L R7,MAG 00003820 L R11,LENGM1 00003830 N R7,=F'1' 00003840 BZ FOUR135 00003850 * 00003860 LA R5,0 00003870 LA R10,16 00003880 * 00003890 FOUR130 LE FR0,0(R5,X) DO 600 I = 1, LENG, 2 00003900 LER FR2,FR0 00003910 LE FR4,8(R5,X) 00003920 SER FR0,FR4 00003930 STE FR0,8(R5,X) X(I+1)=X(I)-X(I+1) 00003940 * 00003950 AER FR4,FR2 00003960 STE FR4,0(R5,X) X(I)=X(I)+X(I+1) 00003970 * 00003980 LE FR0,0(R5,Y) 00003990 LER FR2,FR0 00004000 LE FR4,8(R5,Y) 00004010 SER FR0,FR4 00004020 STE FR0,8(R5,Y) Y(I+1)=Y(I)-Y(I+1) 00004030 * 00004040 AER FR4,FR2 00004050 STE FR4,0(R5,Y) Y(I)=Y(I)+Y(I+1) 00004060 * 00004070 BXLE R5,R10,FOUR130 00004080 * 00004090 FOUR135 L R9,MAG NORMALIZE THE ARRAYS BY 00004100 SLA R9,2 1.0/SQRT(2**MAG) 00004110 LE FR2,NRMTAB(R9) 00004120 LA R5,0 00004130 LA R10,8 00004140 * 00004150 L R4,DOUBLE 00004160 LTR R4,R4 00004170 BZ FOUR140 00004180 * 00004190 HER FR2,FR2 00004200 * 00004210 FOUR140 LE FR0,0(R5,X) 00004220 MER FR0,FR2 00004230 STE FR0,0(R5,X) 00004240 * 00004250 LE FR4,0(R5,Y) 00004260 MER FR4,FR2 00004270 STE FR4,0(R5,Y) 00004280 BXLE R5,R10,FOUR140 00004290 * 00004300 LA R2,0 00004310 LA R4,8 00004320 LR R5,R11 00004330 L R3,MAG 00004340 * 00004350 FFT80 LA R6,0 S = 0 00004360 LR R8,R2 00004370 SRA R8,3 00004380 LA R10,0 00004390 * 00004400 FFT90 LA R9,0 00004410 SRDA R8,5 00004420 SRL R9,25 00004430 SLA R10,5 00004440 A R10,SORTAB(R9) 00004450 LA R6,5(R6) 00004460 CR R6,R3 00004470 BL FFT90 00004480 * 00004490 SR R6,R3 00004500 SLA R10,3 00004510 SRA R10,0(R6) 00004520 CR R2,R10 00004530 BNL FFT110 00004540 * 00004550 LD FR0,0(X,R2) 00004560 LD FR4,0(X,R10) 00004570 STD FR0,0(X,R10) 00004580 STD FR4,0(X,R2) 00004590 * 00004600 FFT110 BXLE R2,R4,FFT80 00004610 * 00004620 L R3,SIGN 00004630 LTR R3,R3 00004640 BM FOUR170 00004650 BAL R14,REALTR 00004660 B FOUR190 00004670 * 00004680 FOUR170 L R5,DOUBLE CHECK IF SINGLE TRANSFORM 00004690 LTR R5,R5 00004700 BNZ FOUR190 00004710 * 00004720 LA Y,4(X) 00004730 LA R5,0 REVERSE SIGN OF DATA SERIES 00004740 LA R6,8 (Y PART ONLY) ON INVERSE TRANS. 00004750 L R7,LENGM1 00004760 * 00004770 FOUR180 LE FR0,0(Y,R5) 00004780 LCER FR0,FR0 00004790 STE FR0,0(Y,R5) 00004800 BXLE R5,R6,FOUR180 00004810 * 00004820 FOUR190 LM R14,R12,12(R13) RESTORE REGISTERS 00004830 BR R14 RETURN TO CALLING PROGRAM 00004840 * 00004850 S1FFTI STM R14,R12,12(R13) 00004860 LA R2,S1FFTI-BASEADD 00004870 SR BASER,R2 00004880 * 00004890 L R3,=F'-1' 00004900 LA R2,0 INDICATE SINGLE TRACE TRANSFORM 00004910 B FOUR00 00004920 * 00004930 REALTR L R4,DOUBLE EXIT IF NOT SINGLE TRACE TRANSF 00004940 LTR R4,R4 00004950 BCR 8,R14 00004960 * 00004970 LA R4,10 00004980 S R4,MAG 00004990 LA R5,1 00005000 SLA R5,2(R4) 00005010 ST R5,INC 00005020 * 00005030 LA Y,4(X) 00005040 LA R5,0 00005050 LA R6,8 00005060 L R7,LENG 00005070 LR R10,R7 00005080 SRA R7,1 00005090 * 00005100 L R8,=V(SCTAB) 00005110 LA R12,0 00005120 * 00005130 LTR R3,R3 00005140 BM REALTR20 00005150 LD FR0,0(X) 00005160 STD FR0,0(X,R10) 00005170 * 00005180 REALTR20 C R12,=F'2048' 00005190 BH REALTR25 00005200 * 00005210 LE FR0,0(R8,R12) 00005220 LCR R11,R12 00005230 LE FR2,2048(R8,R11) 00005240 B REALTR50 00005250 * 00005260 REALTR25 C R12,=F'4096' 00005270 BH REALTR30 00005280 * 00005290 LR R9,R12 00005300 S R9,=F'2048' 00005310 LE FR2,0(R8,R9) 00005320 LCER FR2,FR2 00005330 LCR R11,R9 00005340 LE FR0,2048(R8,R11) 00005350 B REALTR50 00005360 * 00005370 REALTR30 C R12,=F'6144' 00005380 BH REALTR40 00005390 * 00005400 LR R9,R12 00005410 S R9,=F'4096' 00005420 LE FR0,0(R8,R9) 00005430 LCER FR0,FR0 00005440 LCR R11,R9 00005450 LE FR2,2048(R8,R11) 00005460 LCER FR2,FR2 00005470 B REALTR50 00005480 * 00005490 REALTR40 LR R9,R12 00005500 S R9,=F'6144' 00005510 LE FR2,0(R8,R9) 00005520 LCR R11,R9 00005530 LE FR0,2048(R8,R11) 00005540 LCER FR0,FR0 00005550 * 00005560 REALTR50 LTR R3,R3 00005570 BM REALTR60 00005580 LCER FR0,FR0 00005590 * 00005600 REALTR60 STE FR0,S1 00005610 STE FR2,C1 00005620 * 00005630 LE FR0,0(X,R5) 00005640 LER FR2,FR0 00005650 AE FR0,0(X,R10) 00005660 SE FR2,0(X,R10) 00005670 STE FR2,AB 00005680 * 00005690 LE FR4,0(Y,R5) 00005700 LER FR6,FR4 00005710 AE FR4,0(Y,R10) 00005720 STE FR4,BA 00005730 SE FR6,0(Y,R10) 00005740 * 00005750 ME FR4,S1 00005760 ME FR2,C1 00005770 SER FR4,FR2 00005780 LER FR2,FR4 00005790 SER FR4,FR6 00005800 STE FR4,0(Y,R10) 00005810 AER FR2,FR6 00005820 STE FR2,0(Y,R5) 00005830 * 00005840 LE FR2,BA 00005850 ME FR2,C1 00005860 LE FR4,AB 00005870 ME FR4,S1 00005880 AER FR2,FR4 00005890 LER FR6,FR0 00005900 SER FR0,FR2 00005910 STE FR0,0(X,R10) 00005920 AER FR6,FR2 00005930 STE FR6,0(X,R5) 00005940 A R12,INC 00005950 SR R10,R6 00005960 BXLE R5,R6,REALTR20 00005970 * 00005980 BR R14 00005990 * 00006000 S1DFT STM R14,R12,12(R13) 00006010 LA R2,S1DFT-BASEADD 00006020 SR BASER,R2 00006030 * 00006040 LA R3,1 00006050 LA R2,1 INDICATE DOUBLE TRANSFORM 00006060 B FOUR00 00006070 * 00006080 S1DFTI STM R14,R12,12(R13) 00006090 LA R2,S1DFTI-BASEADD 00006100 SR BASER,R2 00006110 * 00006120 L R3,=F'-1' 00006130 LA R2,1 INDICATE DOUBLE TRANSFORM 00006140 B FOUR00 00006150 * 00006160 * CONSTANT AREA 00006170 * ------------- 00006180 * 00006190 DS 0F 00006200 SORTAB DC F'0,16,8,24,4,20,12,28,2,18,10,26,6,22,14,30' 00006210 DC F'1,17,9,25,5,21,13,29,3,19,11,27,7,23,15,31' 00006220 DOUBLE DS F 00006230 INC DS F 00006240 AB DS F 00006250 BA DS F 00006260 MAG DS F 00006270 LENG DS F 00006280 M4 DS F 00006290 M DS F 00006300 H1 DS F 00006310 H2 DS F 00006320 H3 DS F 00006330 H4 DS F 00006340 H5 DS F 00006350 H6 DS F 00006360 H7 DS F 00006370 H8 DS F 00006380 ARG DS F 00006390 MAGP1 DS F 00006400 SIGN DS F 00006410 LENGM1 DS F 00006420 MM1 DS F 00006430 S1 DS F 00006440 S2 DS F 00006450 S3 DS F 00006460 C1 DS F 00006470 C2 DS F 00006480 C3 DS F 00006490 NRMTAB DC E'1.0' MAG=0 00006500 DC E'0.7071070' MAG=1 00006510 DC E'0.5' MAG=2 00006520 DC E'0.3535534' MAG=3 00006530 DC E'0.25' MAG=4 00006540 DC E'0.1767767' MAG=5 00006550 DC E'0.125' MAG=6 00006560 DC E'0.08838841' MAG=7 00006570 DC E'0.0625' MAG=8 00006580 DC E'0.04419418' MAG=9 00006590 DC E'0.03125' MAG=10 00006600 DC E'0.02209708' MAG=11 00006610 DD DS 2F 00006620 * 00006630 LTORG 00006640 END 00006650