DIMENSION ARRAY(6000),IN(7),NX(5)
	DIMENSION NFAC(11),NP(209)
	DIMENSION AT(23),CK(23),BT(23),SK(23)
	DIMENSION NA(100)
	DATA IN(1),IN(2),IN(3),IN(4),IN(5),IN(6),IN(7)/
     +  2HSY,2H0:,2HRD,2HX4,2H  ,2H.M,2HAC/
	DATA NX(1),NX(2),NX(3),NX(4),NX(5)/
     +  2H01,2H02,2H03,2H04,2H05/
	EQUIVALENCE (I,II)
C
	WRITE(7,8000)
8000	FORMAT(1X,'ENTER M FOR 4**M POINTS, 2<M<5')
	READ(7,8001)MX
8001	FORMAT(I1)
	N=4**MX
	NTOT=N
	NSPAN=N
	N1TEST=N/16
	N2TEST=N/8
	N3TEST=(3*N)/16
	NSPAN4=NSPAN/4
	IBASE=0
	ISN=1
	MAXF=23
	MAXP=209
	IF(N.LT.2) STOP
	INC=ISN
	RAD=8.0*ATAN(1.0)
	S72=RAD/5.0
	C72=COS(S72)
	S72=SIN(S72)
	S120=SQRT(0.75)
	IF(ISN.GE.0) GO TO 10
	S72=-S72
	S120=-S120
	RAD=-RAD
	INC=-INC
10	NT=INC*NTOT
	KS=INC*NSPAN
	KSPAN=KS
	KSBYTE=8*KSPAN
	NN=NT-INC
	JC=KS/N
	RADF=RAD*FLOAT(JC)*.5
	I=0
	JF=0
C	DETERMINE THE FACTORS OF N
C	ALL FACTORS MUST BE 4 FOR THIS VERSION
	M=0
	K=N
	GO TO 20
15	M=M+1
	NFAC(M)=4
	K=K/16
20	IF(K-(K/16)*16.EQ.0) GO TO 15
	J=3
	JJ=9
	GO TO 30
25	M=M+1
	NFAC(M)=J
	K=K/JJ
30	IF(MOD(K,JJ).EQ.0) GO TO 25
	J=J+2
	JJ=J**2
	IF(JJ.LE.K) GO TO 30
	IF(K.GT.4) GO TO 40
	KT=M
	NFAC(M+1)=K
	IF(K.NE.1) M=M+1
	GO TO 80
40	IF(K-(K/4)*4.NE.0)GO TO 50
	M=M+1
	NFAC(M)=2
	K=K/4
50	KT=M
	J=2
60	IF(MOD(K,J).NE.0) GO TO 70
	M=M+1
	NFAC(M)=J
	K=K/J
70	J=((J+1)/2)*2+1
	IF(J.LT.K) GO TO 60
80	IF(KT.EQ.0) GO TO 100
	J=KT
90	M=M+1
	NFAC(M)=NFAC(J)
	J=J-1
	IF(J.NE.0)GO TO 90
	KSPAN0=KSPAN
	NTYPL=0
	NCOUNT=1
	NWRITE=0
C
	IUNIT=5
	IN(5)=NX(M)
	CALL ASSIGN (IUNIT,IN(1),14)
	WRITE(5,7000) (IN(IV), IV=3,5)
7000	FORMAT(9X,'.TITLE ',3A2)
	WRITE(5,7001) (IN(IV), IV=3,5)
7001	FORMAT(9X,'.GLOBL ',3A2,' ABE S924 S707 S383 ABC',
     +        /9X,'.GLOBL OFFSET ')
	WRITE(5,7002) (IN(IV), IV=3,5),KSBYTE
7002	FORMAT(9X,'.PSECT XX',/9X,'A=.',/9X,'.PSECT',
     +        /9X,'.IRPC X,012345',/9X,'R''X=%''X',
     +        /9X,'AC''X=%''X',/9X,'.ENDM',
     +        /9X,'SP=%6',/9X,'PC=%7',/1X,3A2,':',
     +        /9X,'MOV #',O6,',R4',/9X,'SETF',
     +        /9X,'MOV #ARRAY,R5',/9X,'JMP @(R5)+',
     +        /1X,'ARRAY:')
100	NDELTA=KSPAN0/KSPAN
	INDEX=0
	SD=RADF/FLOAT(KSPAN)
	CD=2.0*SIN(SD)**2
	SD=SIN(SD+SD)
	KK=1
	I=I+1
C	TRANSFORM FOR A FACTOR OF 4
400	IF(NFAC(I).NE.4) GO TO 600
	KSPNN=KSPAN
	KSPAN=KSPAN/4
	WRITE(5,5020)
5020	FORMAT(1X,3X,'OFFSET')
410	C1=1.0
	S1=0.0
420	K1=KK+KSPAN
	K2=K1+KSPAN
	K3=K2+KSPAN
C	AKP=A(KK)+A(K2)
C	AKM=A(KK)-A(K2)
C	AJP=A(K1)+A(K3)
C	AJM=A(K1)-A(K3)
C	A(KK)=AKP+AJP
C	AJP=AKP-AJP
C	BKP=B(KK)+B(K2)
C	BKM=B(KK)-B(K2)
C	BJP=B(K1)+B(K3)
C	BJM=B(K1)-B(K3)
C	B(KK)=BKP+BJP
C	BJP=BKP-BJP
	IF(ISN.LT.0) GO TO 450
C	AKP=AKM-BJM
C	AKM=AKM+BJM
C	BKP=BKM+AJM
C	BKM=BKM-AJM
	IF(S1.EQ.0.0) GO TO 460
430	CONTINUE
C	A(K1)=AKP*C1-BKP*S1
C	B(K1)=AKP*S1+BKP*C1
C	A(K2)=AJP*C2-BJP*S2
C	B(K2)=AJP*S2+BJP*C2
C	A(K3)=AKM*C3-BKM*S3
C	B(K3)=AKM*S3+BKM*C3
	IF(KSPAN.NE.NSPAN4) GO TO 431
	ARRAY(IBASE+5)=S1+C1
	ARRAY(IBASE+6)=C1
	ARRAY(IBASE+4)=S1-C1
	ARRAY(IBASE+8)=S2+C2
	ARRAY(IBASE+9)=C2
	ARRAY(IBASE+7)=S2-C2
	ARRAY(IBASE+2)=S3+C3
	ARRAY(IBASE+3)=C3
	ARRAY(IBASE+1)=S3-C3
	IBASE=IBASE+9
431	CONTINUE
C
	KKP=(KK-1)*8
	IF(INDEX.NE.N1TEST) GO TO 150
	NTYPE=1
	IF(NTYPE.EQ.NTYPL) GO TO 145
	NOFF=NWRITE*2
	WRITE(5,4031) NOFF
4031	FORMAT(6X,'S924,LOOPB+',O4)
	WRITE(5,6031) KKP
6031	FORMAT(25X,'A+',O6)
	NWRITE=NWRITE+1
	NA(NWRITE)=NCOUNT
	NCOUNT=1
	NTYPL=NTYPE
	GO TO 5035
145	NCOUNT=NCOUNT+1
	WRITE(5,6031) KKP
	GO TO 5035
C
150	IF(INDEX.NE.N2TEST) GO TO 160
	NTYPE=2
	IF(NTYPE.EQ.NTYPL) GO TO 155
	NOFF=NWRITE*2
	WRITE(5,4032) NOFF
4032	FORMAT(6X,'S707,LOOPB+',O4)
	WRITE(5,6031) KKP
	NWRITE=NWRITE+1
	NA(NWRITE)=NCOUNT
	NCOUNT=1
	NTYPL=NTYPE
	GO TO 5035
155	NCOUNT=NCOUNT+1
	WRITE(5,6031) KKP
	GO TO 5035
C
160	IF(INDEX.NE.N3TEST) GO TO 170
	NTYPE=3
	IF(NTYPE.EQ.NTYPL) GO TO 165
	NOFF=NWRITE*2
	WRITE(5,4033) NOFF
4033	FORMAT(6X,'S383,LOOPB+',O4)
	WRITE(5,6031) KKP
	NWRITE=NWRITE+1
	NA(NWRITE)=NCOUNT
	NCOUNT=1
	NTYPL=NTYPE
	GO TO 5035
165	NCOUNT=NCOUNT+1
	WRITE(5,6031) KKP
	GO TO 5035
C
170	NTYPE=4
	IF(NTYPE.EQ.NTYPL) GO TO 175
	NOFF=NWRITE*2
	WRITE(5,4034) NOFF
4034	FORMAT(6X,' ABC,LOOPB+',O4)
	INDEXP=(INDEX-1)*36
	WRITE(5,6032) KKP,INDEXP
6032	FORMAT(25X,'A+',O6,',TRIG+',I6,'.')
	NWRITE=NWRITE+1
	NA(NWRITE)=NCOUNT
	NCOUNT=1
	NTYPL=NTYPE
	GO TO 5035
175	NCOUNT=NCOUNT+1
	INDEXP=(INDEX-1)*36
	WRITE(5,6032) KKP,INDEXP
5035	KK=K3+KSPAN
	IF(KK.LE.NT) GO TO 420
440	CONTINUE
	INDEX=INDEX+NDELTA
	C2=C1-(CD*C1+SD*S1)
	S1=(SD*C1-CD*S1)+S1
	C1=C2
	C2=C1*C1-S1*S1
	S2=C1*S1+C1*S1
	C3=C2*C1-S2*S1
	S3=C2*S1+S2*C1
	KK=KK-NT+JC
	IF(KK.LE.KSPAN) GO TO 420
	KK=KK-KSPAN+INC
	IF(KK.LE.JC) GO TO 410
	IF(KSPAN.EQ.JC) GO TO 800
	GO TO 100
450	WRITE(5,5040)
5040	FORMAT('AT 450, ERROR')
C	AKP=AKM+BJM
C	AKM=AKM-BJM
C	BKP=BKM-AJM
C	BKM=BKM+AJM
	IF(S1.NE.0.0) GO TO 430
460	CONTINUE
C	A(K1)=AKP
C	B(K1)=BKP
C	A(K2)=AJP
C	B(K2)=BJP
C	A(K3)=AKM
C	B(K3)=BKM
	NTYPE=5
	KKP=(KK-1)*8
	IF(NTYPE.EQ.NTYPL) GO TO 185
	NOFF=NWRITE*2
	WRITE(5,4035) NOFF
4035	FORMAT(6X,' ABE,LOOPB+',O4)
	WRITE(5,6031) KKP
	NWRITE=NWRITE+1
	NA(NWRITE)=NCOUNT
	NCOUNT=1
	NTYPL=NTYPE
	GO TO 5050
185	NCOUNT=NCOUNT+1
	WRITE(5,6031) KKP
5050	KK=K3+KSPAN
	IF(KK.LE.NT) GO TO 420
	GO TO 440
C
800	NA(NWRITE+1)=NCOUNT
	DO 6500 JX=1,NWRITE
6500	NA(JX)=NA(JX+1)
C	PERMUTE THE RESULTS TO NORMAL ORDER
C	DONE IN TWO STEPS
C	PERMUTATION FOR SQUARE FACTORS OF N
	NP(1)=KS
	IF(KT.EQ.0) GO TO 890
	K=KT+KT+1
	IF(M.LT.K) K=K-1
	J=1
	NP(K+1)=JC
810	NP(J+1)=NP(J)/NFAC(J)
	NP(K)=NP(K+1)*NFAC(J)
	J=J+1
	K=K-1
	IF(J.LT.K) GO TO 810
	K3=NP(K+1)
	KSPAN=NP(2)
	KK=JC+1
	K2=KSPAN+1
	J=1
C	PERMUTATION FOR SINGLE VARIATE TRANSFORM
	WRITE(5,818)
818	FORMAT(4X,'BITREV',/1X,'BITREV:',
     +        /9X,'MOV #BITAB,R0',/9X,'MOV NLOOP,R3',
     +        /1X,'LOOPC:',
     +        /9X,'MOV (R0)+,R1',/9X,'MOV (R0)+,R2',
     +        /9X,'LDF (R1),AC0',/9X,'LDF (R2),AC1',
     +        /9X,'STF AC0,(R2)+',/9X,'STF AC1,(R1)+',
     +        /9X,'LDF (R1),AC0',/9X,'LDF (R2),AC1',
     +        /9X,'STF AC0,(R2)',/9X,'STF AC1,(R1)',
     +        /9X,'SOB R3,LOOPC',/9X,'RTS PC')
	NLOOP=0
	WRITE(5,819)
819	FORMAT(1X,'BITAB:')
820	CONTINUE
C	AK=A(KK)
C	A(KK)=A(K2)
C	A(K2)=AK
C
C	BK=B(KK)
C	B(KK)=B(K2)
C	B(K2)=BK
C
	KKP=(KK-1)*8
	K2P=(K2-1)*8
	WRITE(5,822) KKP,K2P
822	FORMAT(9X,'A+',O6,',','A+',O6)
	NLOOP=NLOOP+1
	KK=KK+INC
	K2=KSPAN+K2
	IF(K2.LT.KS) GO TO 820
830	K2=K2-NP(J)
	J=J+1
	K2=NP(J+1)+K2
	IF(K2.GT.NP(J)) GO TO 830
	J=1
840	IF(KK.LT.K2) GO TO 820
	KK=KK+INC
	K2=KSPAN+K2
	IF(K2.LT.KS) GO TO 840
	IF(KK.LT.KS) GO TO 830
	JC=K3
	GO TO 890
C
890	IF(2*KT+1.GE.M) GO TO 2000
600	WRITE(5,1000)
1000	FORMAT(1H ,'SOMETHING IS WRONG')
2000	CONTINUE
	WRITE(5,824) NLOOP
824	FORMAT(1X,'NLOOP:',2X,O6)
	NTIMES=N/4-1
	WRITE(5,4000)
4000	FORMAT(1X,'TRIG:')
	DO 4001	J=1,NTIMES
	IBASE=(J-1)*9
	WRITE(5,4002) (ARRAY(IBASE+KK), KK=1,9)
4002	FORMAT(1X,'.FLT2',E17.9,2(',',E17.9)/,
     +         1X,'.FLT2',E17.9,2(',',E17.9)/,
     +         1X,'.FLT2',E17.9,2(',',E17.9))
4001	CONTINUE
	WRITE(5,4100)
4100	FORMAT(1X,'LOOPB:')
	NTIMES=NWRITE/5
	NREM=NWRITE-5*NTIMES
	DO 4102 I=1,NTIMES
	IBASE=(I-1)*5
	WRITE(5,4101) (NA(J+IBASE), J=1,5)
4101	FORMAT(1X,O6,4(',',O6))
4102	CONTINUE
	IF(NREM.EQ.0) GO TO 4104
	IBASE=NTIMES*5
	WRITE(5,4103) (NA(J+IBASE), J=1,NREM)
4103	FORMAT(1X,4(O6,','))
4104	CONTINUE
	WRITE(5,4003)
4003	FORMAT(1X,7X,'.END',/)
	END FILE 5
	STOP
	END