subroutine xfft(current_window,nsamps_inwin,sampling_rate,
     #  icomp,wsave,df,nf1,sv,sn,se,nfft,cbuf,ierr) 
c
c driver for fft
c fft routine taken from: FFTPACK, version 4  april 1985,
c by  paul n swarztrauber, national center for atmospheric research,
c boulder, colorado, Usa 80307
c
c 'complex spectrum' already normalized (1/sqrt(2))
c
c a.tento  4/02 v.1.0.
c a.tento  5/03 v.2.0.
c
c
        implicit none
        integer nsamps_inwin,icomp,nf1,nfft,ierr  
        real current_window,sampling_rate,wsave,df,sv,sn,se 
        dimension current_window(nsamps_inwin) 
        dimension sv(nfft), sn(nfft), se(nfft) 
        dimension wsave(*) 
        complex  cbuf
        dimension  cbuf(*)
c
        include 'parameters.h'
c
        character argout(20)*200, sep2*1
        parameter (sep2 = ':')
        integer  i, nw
        real bb
        complex ai
        parameter (ai = (0.0,1.0)) 
c
c
        ierr = 0
c
c
        df = 1.0/(sampling_rate * float(nsamps_inwin))
        nf1 = nsamps_inwin/2 + 1
c
        call split3(merge_type,argout,sep2,nw)
        if ( argout(1)  .eq.  'complex' ) then
c 
          if     (icomp  .eq.  1) then
            do 10 i = 1, nsamps_inwin 
              cbuf(i) = cmplx(current_window(i), 0.0)
10          continue
            call cffti(nsamps_inwin,wsave)
            call cfftf(nsamps_inwin,cbuf,wsave)
            do 11 i = 1, nf1
              sv(i) = cabs(cbuf(i))*sampling_rate
11          continue
c 
          elseif (icomp  .eq.  2) then
            do 12 i = 1, nsamps_inwin 
              cbuf(i) = cmplx(current_window(i), 0.0)
12          continue
c 
          elseif (icomp  .eq.  3) then
            do 13 i = 1, nsamps_inwin 
              cbuf(i) = cbuf(i) + ai*current_window(i)
13          continue
            call cffti(nsamps_inwin,wsave)
            call cfftf(nsamps_inwin,cbuf,wsave)
            bb = sampling_rate/sqrt(2.0)
            do 14 i = 1, nf1
              sn(i)= cabs(cbuf(i))*bb
              se(i)= sn(i)
14          continue
          endif
c 
c 
        else
c 
c 
          do 1 i = 1, nsamps_inwin 
            cbuf(i) = cmplx(current_window(i), 0.0)
1         continue
c 
          call cffti(nsamps_inwin,wsave)
          call cfftf(nsamps_inwin,cbuf,wsave)
c
          if     (icomp  .eq.  1) then
            do 2 i = 1, nf1
              sv(i) = cabs(cbuf(i))*sampling_rate
2           continue
          elseif (icomp  .eq.  2) then
            do 3 i = 1, nf1
              sn(i)= cabs(cbuf(i))*sampling_rate
3           continue
          elseif (icomp  .eq.  3) then
            do 4 i = 1, nf1
              se(i) = cabs(cbuf(i))*sampling_rate
4           continue
          endif
c 
c 
        endif
c
c
        return
c
        end