	SUBROUTINE DFT2D(L2PRV,L2CUR,L2REM,ISGN,WORK,L2NEL,NELEM,
     *  NRECT,IRECO)
C	DISCRETE FOURIER TRANSFORM OF LENGTH N.  IN-PLACE COOLEY-TUKEY
C	ALGORITHM, BIT-REVERSED TO NORMAL ORDER, SANDE-TUKEY PHASE SHIFTS.
C	DEFINING NPREV = 2**L2PRV, N = 2**L2CUR, NREM = 2**L2REM, WE HAVE
C	DIMENSION DATA(NPREV,N,NREM)
C	COMPLEX DATA
C	DATA(J1,K4,J5) = SUM(DATA(J1,J4,J5)*EXP(ISGN*2*PI*I*(J4-1)*
C	(K4-1)/N)), SUMMED OVER J4 = 1 TO N FOR ALL J1 FROM 1 TO NPREV,
C	K4 FROM 1 TO N AND J5 FROM 1 TO NREM.  METHOD-- LET IPREV = 1, 2,
C	4, ..., N/2, N.  LET IREM = N/(2*IPREV).  THEN EFFECTIVELY
C	DIMENSION DATA(NPREV,IPREV,2,IREM,NREM)
C	MULTIPLY DATA(J1,J2,J3,J4,J5) BY EXP(ISGN*2*PI*I*(J2-1)/
C	(2*IPREV)), AND DO A FOURIER TRANSFORM OF LENGTH 2 ALONG THE
C	MIDDLE DIMENSION IN PLACE.
	DIMENSION WORK(1)
	TWOPI=6.2831853071795865D0*DBLE(ISGN)
	IP0=2
	NWORD=IP0*NELEM
	IF (L2PRV-L2NEL) 10,20,40
C	CHECK IF DFT2R WAS ALREADY CALLED FROM BTRVD.
10	IF (2*(L2NEL-L2PRV)-L2CUR) 20,40,40
C
C	NELEM IS GREATER THAN OR EQUAL TO NPREV.  READ IN TWO ADJACENT
C	RECORDS AND DO AS MANY PASSES AS POSSIBLE.
C	EFFECTIVELY WE HAVE
C	DIMENSION DATA(2*NELEM,(NPREV*N*NREM)/(2*NELEM))
20	DO 30 IREC=1,NRECT,2
	CALL DREAD(IREC+IRECO,WORK,2,NELEM)
	CALL DFT2R(WORK,L2PRV,L2CUR,ISGN,L2NEL,NELEM)
30	CALL DWRITE(IREC+IRECO,WORK,2,NELEM)
C
C	DO ALL PASSES FROM IPREV JUST LARGER THAN NELEM TO THE END.
40	IF (L2PRV-L2NEL+L2CUR-2) 150,50,50
50	IF (L2PRV-L2NEL) 60,60,70
C	EFFECTIVELY WE HAVE
C	DIMENSION DATA(NPREV,NELEM/NPREV,(NPREV*N)/NELEM,NREM)
60	IP2Q=2
	IWMAX=1
	I1LIM=IP0*2**L2PRV
	THETA=TWOPI/2.**(L2NEL-L2PRV+2)
	GO TO 80
C	DIMENSION DATA(NELEM,NPREV/NELEM,N,NREM)
70	IP2Q=2**(L2PRV-L2NEL)
	IWMAX=IP2Q
	I1LIM=NWORD
	THETA=TWOPI/2.
80	IP3Q=2*IP2Q
	IP3QM=2**(L2PRV-L2NEL+L2CUR)
	SINTH=SIN(THETA)
	IF (IP3Q-IP3QM) 90,90,150
90	THETA=THETA/2.
	WSTPI=SINTH
	SINTH=SIN(THETA)
	WSTPR=-2.*SINTH*SINTH
	DO 140 IRMIN=1,NRECT,IP3Q
	IRMAX=IRMIN+IP2Q-1
	WR=1.
	WI=0.
	IW=0
	DO 130 IREC=IRMIN,IRMAX
	IRECA=IREC+IRECO
	CALL DREAD(IRECA,WORK,1,NELEM)
	IRECB=IRECA+IP2Q
	CALL DREAD(IRECB,WORK(NWORD+1),1,NELEM)
	DO 120 I2=1,NWORD,I1LIM
	I1MAX=I2+I1LIM-IP0
	DO 100 I1=I2,I1MAX,IP0
	I3A=I1
	I3B=I3A+NWORD
	TEMPR=WR*WORK(I3B)-WI*WORK(I3B+1)
	TEMPI=WR*WORK(I3B+1)+WI*WORK(I3B)
	WORK(I3B)=WORK(I3A)-TEMPR
	WORK(I3B+1)=WORK(I3A+1)-TEMPI
	WORK(I3A)=WORK(I3A)+TEMPR
100	WORK(I3A+1)=WORK(I3A+1)+TEMPI
	IW=IW+1
	IF (IW-IWMAX) 120,110,110
110	TEMP=WR
	WR=TEMP*WSTPR-WI*WSTPI+TEMP
	WI=TEMP*WSTPI+WI*WSTPR+WI
C	OMIT THE NEXT THREE CARDS IF ROUNDED ARITHMETIC IS USED.
	FACTR=1.5-.5*(WR*WR+WI*WI)
	WR=WR*FACTR
	WI=WI*FACTR
	IW=0
120	CONTINUE
	CALL DWRITE(IRECA,WORK,1,NELEM)
130	CALL DWRITE(IRECB,WORK(NWORD+1),1,NELEM)
140	CONTINUE
	IP2Q=IP3Q
	GO TO 80
150	RETURN
	END
