var/da/da_tools/da_find_fft_factors.inc

   1 subroutine da_find_fft_factors(n, n_ok, fft_factors)
   2
   3    !---------------------------------------------------------------------------
   4    ! Purpose: Calculates prime factors of input number.
   5    !---------------------------------------------------------------------------
   6
   7    implicit none
   8
   9    integer, intent(in)  :: n
  10    logical, intent(out) :: n_ok
  11    integer, intent(out) :: fft_factors(:)
  12
  13    integer :: i, k, l
  14    integer :: nfax, nu, ifac
  15    integer :: jfax(num_fft_factors)
  16    integer :: lfax(7)
  17
  18    data lfax /6,8,5,4,3,2,1/
  19
  20    ! in da_control
  21    !if (trace_use) call da_trace_entry("da_find_fft_factors")
  22
  23    !---------------------------------------------------------------------------
  24    ! [1.0] Find factors of vector size (8,6,5,4,3,2; only one 8 allowed):
  25    !---------------------------------------------------------------------------
  26
  27    n_ok = .false.
  28    fft_factors(:) = 0
  29
  30    ! look for sixes first, store factors in descending order
  31    nu=n
  32    ifac=6
  33    k=0
  34    l=1
  35
  36 20 continue
  37
  38    if (mod(nu,ifac).ne.0) goto 30
  39
  40    ! 6 is a factor:
  41    k=k+1
  42    jfax(k)=ifac
  43    if (ifac.ne.8) goto 25
  44    if (k.eq.1) goto 25
  45    jfax(1)=8
  46    jfax(k)=6
  47
  48 25 continue
  49    nu=nu/ifac
  50    if (nu.eq.1) goto 50
  51    if (ifac.ne.8) goto 20
  52
  53 30 continue
  54    l=l+1
  55    ifac=lfax(l)
  56    if (ifac .gt. 1) goto 20
  57
  58    ! illegal factors:
  59    ! write (unit=message(1),fmt='(a,i4,a)') 'n = ', n, ' contains illegal factors.'
  60    ! call da_warning(__file__,__line__,message(1:1))
  61
  62    goto 9
  63
  64    ! now reverse order of factors
  65 50 continue
  66    nfax=k
  67    fft_factors(1)=nfax
  68    do i=1,nfax
  69       fft_factors(nfax+2-i)=jfax(i)
  70    end do
  71
  72    n_ok = .true.
  73
  74 9  continue
  75
  76    !if (trace_use) call da_trace_exit("da_find_fft_factors")
  77
  78 end subroutine da_find_fft_factors
  79
  80