      SUBROUTINE TRANFQ(Q,TQ,NQ,KD,XNU,GG,FF,ST,MODE,FREMAX)
      DIMENSION Q(NQ),XNU(*)   
      DIMENSION FF(*),GG(*),ST(*)   
      DOUBLE PRECISION TQ(NQ),ARG,ARGINC,TWOPI,A,B,DF,DFDF
      DOUBLE PRECISION XNUMAX,F
      REAL NEWCOS,NEWSIN
      PI=3.141592653    
      TWOPI=2.0D0*PI    
      X=NQ
      X=X*X
      AMAX=0.0    
C     
C     THIS ROUTINE CALCULATES THE DISCRETE FOURIER TRANSFORM OF   
C     DEEMING,T.J. IN ASTROPHYSICS AND SPACE SCIENCE (1975) 
C     ACCORDING TO THE SHORT-CUT PROPOSED BY KURTZ TO BE PUBLISHED
C     IN MON.NOT.R.ASTR.SOC. PROBABLY IN 1985.  
C     
C     MODE=0 : CALCULATE THE POWER SPECTRUM     
C     MODE=1 : CALCULATE THE SPECTRAL WINDOW    
C     MODE=2 : AS FOR 0 EXCEPT DUMP THE SINE AND COSINE SUMS
C              TO A FILE
C     MODE=3 : AS FOR 1 EXCEPT DUMP THE SINE AND COSINE SUMS OF   
C              THE WINDOW TO A FILE 
C     MODE=4 : AS FOR 0 EXCEPT DUMP THE AMPLITUDE SPECTRUM
C              TO A FILE
C     MODE=5 : AS FOR 1 EXCEPT DUMP THE WINDOW TO A FILE 
C     
      DO 1 K=1,KD 
        ST(K)=0.0 
        IF(MODE.EQ.0.OR.MODE.EQ.2.OR.MODE.EQ.4)FF(K)=0.0
        IF(MODE.EQ.1.OR.MODE.EQ.3.OR.MODE.EQ.5)GG(K)=0.0     
    1 CONTINUE    
      DF=XNU(2)-XNU(1)  
      IF(MODE.EQ.1.OR.MODE.EQ.3.OR.MODE.EQ.5)GO TO 50  
      DO 3 I=1,NQ 
        ARGINC=DF*TWOPI*TQ(I) 
        ARGINC=DMOD(ARGINC,TWOPI)   
        FARG=ARGINC     
        SININC=SIN(FARG)
        COSINC=COS(FARG)
        DO 2 K=1,KD     
          IF(MOD(K-1,100).EQ.0)THEN 
            FARG=DMOD(XNU(K)*TWOPI*TQ(I),TWOPI) 
            NEWCOS=COS(FARG)  
            NEWSIN=SIN(FARG)  
          ELSE    
            NEWCOS=OLDCOS*COSINC-OLDSIN*SININC  
            NEWSIN=OLDSIN*COSINC+OLDCOS*SININC  
          END IF  
          FF(K)=FF(K)+Q(I)*NEWCOS   
          ST(K)=ST(K)+Q(I)*NEWSIN   
          OLDCOS=NEWCOS 
          OLDSIN=NEWSIN 
    2   CONTINUE  
    3 CONTINUE    
      IF(MODE.EQ.2.OR.MODE.EQ.4)THEN 
C     
C       WRITE THE SINE AND COSINE SUMS OUT TO A FILE  - MODE = 2
C       WRITE THE AMPLITUDE SPECTRUM   OUT TO A FILE  - MODE = 4
C     
        DO 5 K=1,KD     
          IF(MODE.EQ.2)WRITE(11,4)K,XNU(K),FF(K),ST(K) 
          IF(MODE.EQ.4)WRITE(11,4)K,XNU(K),
     *                 2.0*SQRT(FF(K)*FF(K)+ST(K)*ST(K))/NQ
    4     FORMAT(I10,1P3E20.8)
    5   CONTINUE  
        CLOSE(11) 
      END IF
      DO 7 K=1,KD 
        FF(K)=2.0*SQRT(FF(K)*FF(K)+ST(K)*ST(K))/NQ    
        IF(FF(K).GT.AMAX)THEN 
          IMAX=K  
          AMAX=FF(K)    
        END IF    
    7 CONTINUE    
      IF(MODE.NE.1.AND.FREMAX.NE.-1.0)THEN
        PRINT 8   
    8   FORMAT(/14X,'DETERMINATION OF PRECISE MAXIMUM FREQUENCY', 
     *         ' FROM A FINER GRID AROUND THE ROUGH MAXIMUM'//    
     *         16X,'I',7X,'FREQUENCY',8X,'PERIOD',8X,'AMPLIT',5X, 
     *         '    PHASE'/12X,63('='))   
        AMAX=0.0  
        DFDF=DF/10.0
        XNUMAX=XNU(IMAX)
        DO 15 K=1,21    
          FRFR=0.0
          FIFI=0.0
          F=XNUMAX-(11.0D0-K)*DFDF
          A=F*TWOPI     
          DO 10 I=1,NQ  
            B=A*TQ(I)   
            RB=DMOD(B,TWOPI)  
            C=COS(RB)   
            S=SIN(RB)   
            FRFR=FRFR+C*Q(I)  
            FIFI=FIFI+S*Q(I)  
   10     CONTINUE
          FFFF=2.0*SQRT(FRFR**2+FIFI**2)/NQ    
          IF(FFFF.GT.AMAX)FREMAX=F  
          IF(FFFF.GT.AMAX)AMAX=FFFF 
          IF(FIFI.NE.0.0.OR.FRFR.NE.0.0)PHI=ATAN2(-FIFI,FRFR)     
          IF(FIFI.EQ.0.0.AND.FRFR.EQ.0.0)PHI=0.0
          PRINT 12,K,F,DMIN1(1.0D0/F,1000000.0D0),FFFF,PHI     
   12     FORMAT(13X,I4,1PE16.8,0PF14.6,1P2E14.5)     
   15   CONTINUE  
        PRINT 16  
   16   FORMAT(12X,63('='))   
        PRINT 18,FREMAX 
   18   FORMAT(/12X,'FREQUENCY OF MAXIMUM IS ',1PE14.6/)    
      END IF
      RETURN
C     
C     THIS CALCULATES THE SPECTRAL WINDOW 
C     
   50 DO 100 I=1,NQ     
        ARGINC=DF*TWOPI*TQ(I) 
        ARGINC=DMOD(ARGINC,TWOPI)   
        FARG=ARGINC     
        SININC=SIN(FARG)
        COSINC=COS(FARG)
        DO 70 K=1,KD    
          IF(MOD(K-1,100).EQ.0)THEN 
            FARG=DMOD(XNU(K)*TWOPI*TQ(I),TWOPI) 
            NEWCOS=COS(FARG)  
            NEWSIN=SIN(FARG)  
          ELSE    
            NEWCOS=OLDCOS*COSINC-OLDSIN*SININC  
            NEWSIN=OLDSIN*COSINC+OLDCOS*SININC  
          END IF  
          GG(K)=GG(K)+NEWCOS  
          ST(K)=ST(K)+NEWSIN  
          OLDCOS=NEWCOS 
          OLDSIN=NEWSIN 
   70   CONTINUE  
  100 CONTINUE    
      IF(MODE.EQ.3.OR.MODE.EQ.5)THEN 
C     
C       WRITE THE SINE AND COSINE SUMS TO FILE 11 - MODE = 3
C       WRITE THE SPECTRAL WINDOW OUT TO  FILE 11 - MODE = 5
C     
        IF(MODE.EQ.3)THEN
          DO 105 K=1,KD   
            WRITE(11,4)K,XNU(K),GG(K),ST(K) 
  105     CONTINUE  
          CLOSE(11) 
        END IF
        IF(MODE.EQ.5)THEN
          DO 110 K=KD,2,-1
            WRITE(11,4)-K,-XNU(K),SQRT(GG(K)*GG(K)+ST(K)*ST(K))/NQ
  110     CONTINUE
          DO 120 K=1,KD
            WRITE(11,4)K,XNU(K),SQRT(GG(K)*GG(K)+ST(K)*ST(K))/NQ
  120     CONTINUE
          CLOSE(11)
        END IF
      END IF
      DO 130 K=1,KD     
        GG(K)=SQRT(GG(K)*GG(K)+ST(K)*ST(K))/NQ  
  130 CONTINUE    
      RETURN
      END   
