Class fftw3_class
In: SingletMesons_Simple_v1.3/VERYOLD/OLDS/fftw3_class.F90
SingletMesons_Simple_v1.3/VERYOLD/OLD2/fftw3_class.F90
SingletMesons_Simple_v1.3/fftw3_class.F90
comlib lattice_class quark_prop_class print_status_class timer_class wavefunc_class mpi fftw3_class dot/f_103.png

This contains FFT routines using FFTW3.

FFT are parallelized by gathering spatial data in a node and scatterning color, spin and time indexes.

Quark propagator FFT and inverse FFT at all time slice.

  -    fft_qprop
  - invfft_qprop

Wavefunction FFT and inverse FFT at sink (timke slice)

  -    fft_wavefunc
  - invfft_wavefunc

Convoluting a wavefunction and a quark propagator

  - convolution

Methods

convolution   delete   delete   delete   delete   delete   delete   delete   delete   delete   delete   delete   delete   delete   delete   delete   delete   fft_qprop   fft_qprop   fft_qprop   fft_wavefunc   fft_wavefunc   fft_wavefunc   invfft_qprop   invfft_qprop   invfft_qprop   invfft_wavefunc   invfft_wavefunc   invfft_wavefunc   new   new   new   new   new   new   new   new   new   new   new   new   new   new   new   new  

Included Modules

comlib lattice_class quark_prop_class print_status_class timer_class wavefunc_class mpi

Public Instance methods

Subroutine :
wf(NSPACE) :complex(DP), intent(in)
qp(COL,COL,SPIN,SPIN,NSPACE,NT) :complex(DP), intent(inout)

[Source]

subroutine convolution(wf,qp)
  implicit none
  complex(DP), intent(in)    :: wf(NSPACE)
  complex(DP), intent(inout) :: qp(COL,COL,SPIN,SPIN,NSPACE,NT)
  complex(DP) :: ctmp
  integer :: ic,jc,is,js,isp,it

  do it=1,NT
!$OMP PARALLEL DO PRIVATE(isp,ctmp,js,is,jc,ic)
    do isp=1,NSPACE
      ctmp = wf(isp)
      do js=1,SPIN
      do is=1,SPIN
      do jc=1,COL
      do ic=1,COL
        qp(ic,jc,is,js,isp,it) = qp(ic,jc,is,js,isp,it)*ctmp
      enddo
      enddo
      enddo
      enddo
    enddo
  enddo
 
  return
end subroutine
delete( this )
Subroutine :
this :type(lattice_world), intent(inout)

Delete lattice constants, node information (next to nearest node rank etc.)

Original external subprogram is lattice_class#delete

delete( this )
Subroutine :
this :type(qprop_params), intent(inout)

delete quark parameter parameters

Original external subprogram is quark_prop_class#delete

delete( this )
Subroutine :
this :type(qprop_params), intent(inout)

delete quark parameter parameters

Original external subprogram is quark_prop_class#delete

delete( this )
Subroutine :
this :type(quark_prop), intent(inout)

set default values for a quark propagator

Original external subprogram is quark_prop_class#delete

delete( this )
Subroutine :
this :type(quark_prop), intent(inout)

set default values for a quark propagator

Original external subprogram is quark_prop_class#delete

delete( this )
Subroutine :
this :type(quark_prop_obj), intent(inout)

set default values for a quark propagator

Original external subprogram is quark_prop_class#delete

delete( this )
Subroutine :
this :type(quark_prop_obj), intent(inout)

set default values for a quark propagator

Original external subprogram is quark_prop_class#delete

delete( this )
Subroutine :
this :type(quark_prop_parameter_obj), intent(inout)

Original external subprogram is quark_prop_class#delete

delete( this )
Subroutine :
this :type(quark_prop_parameter_obj), intent(inout)

Original external subprogram is quark_prop_class#delete

delete( this )
Subroutine :
this :type(snk_wavefunc_obj), intent(inout)

Original external subprogram is wavefunc_class#delete

delete( this )
Subroutine :
this :type(snk_wavefunc_obj), intent(inout)

Original external subprogram is wavefunc_class#delete

delete( this )
Subroutine :
this :type(src_wavefunc_obj), intent(inout)

Original external subprogram is wavefunc_class#delete

delete( this )
Subroutine :
this :type(src_wavefunc_obj), intent(inout)

Original external subprogram is wavefunc_class#delete

delete( this )
Subroutine :
this :type(timer), intent(inout)

delete timer

Original external subprogram is timer_class#delete

delete( this )
Subroutine :
this :type(wavefunc_param_obj), intent(inout)

Original external subprogram is wavefunc_class#delete

delete( this )
Subroutine :
this :type(wavefunc_param_obj), intent(inout)

Original external subprogram is wavefunc_class#delete

Subroutine :
q(COL,COL,SPIN,SPIN,NSPACE,NT) :complex(DP), intent(inout)

fft quark propagator

[Source]

subroutine fft_qprop(q)
!
! fft quark propagator
!
  implicit none
  complex(DP), intent(inout) :: q(COL,COL,SPIN,SPIN,NSPACE,NT)
  complex(DP), allocatable :: wf(:,:,:,:)
  integer :: iqp
  type(timer) :: timer1,timer2,timer3
  real(DP) :: etime1,etime2,etime3

  call new(timer1)
  call new(timer2)
  call new(timer3)

  call tic(timer1)

  if (.not.m_is_initialized) call new_fft()

  allocate(wf(NTZ,NTY,NTX,NUM_QPROP_NL))

  call tic(timer2)
  call gather_qprop(q,wf)
  call toc(timer2)

  call    fft_qprop_internal(wf,NUM_QPROP_NL)

  call tic(timer3)
  call scatter_qprop(wf,q)
  call toc(timer3)

  deallocate(wf)

  call toc(timer1)

  etime1 = get_elapse(timer1)
  etime2 = get_elapse(timer2)
  etime3 = get_elapse(timer3)
  if (nodeid==0) write(*,'("%FFT_ETIME_QPROP: ALL=",F15.6," SCATTER_QPROP=",F15.6," GATHER_QPROP=",F15.6)') etime1,etime2,etime3
  return
end subroutine
Subroutine :
qp :type(quark_prop_obj), intent(inout)

[Source]

subroutine fft_qprop(qp)
  implicit none
  type(quark_prop_obj), intent(inout) :: qp
  complex(8), allocatable :: wf(:,:,:,:)
  allocate(wf(NTZ,NTY,NTX,NUM_WF_NL))
  call gather_wavefunc(qp,wf)
  call fft_wavefunc(wf)
  call scatter_wavefunc(wf,qp)
  deallocate(wf)
  return
end subroutine
Subroutine :
qp :type(quark_prop_obj), intent(inout)

[Source]

subroutine fft_qprop(qp)
  implicit none
  type(quark_prop_obj), intent(inout) :: qp
  complex(8), allocatable :: wf(:,:,:,:)
  allocate(wf(NTZ,NTY,NTX,NUM_WF_NL))
  call gather_wavefunc(qp,wf)
  call fft_wavefunc(wf)
  call scatter_wavefunc(wf,qp)
  deallocate(wf)
  return
end subroutine
Subroutine :
af(NTZ,NTY,NTX) :complex(8), intent(inout)

[Source]

subroutine fft_wavefunc(af)
  implicit none
  complex(8), intent(inout) :: af(NTZ,NTY,NTX)
  integer(8) :: plan
  call dfftw_plan_dft_3d(plan,NTZ,NTY,NTX,af,af,FFTW_FORWARD,FFTW_ESTIMATE)
  call dfftw_execute(plan)
  call dfftw_destroy_plan(plan)
  return
end subroutine
Subroutine :
af(NTZ,NTY,NTX) :complex(8), intent(inout)

[Source]

subroutine fft_wavefunc(af)
  implicit none
  complex(8), intent(inout) :: af(NTZ,NTY,NTX)
  integer(8) :: plan
  call dfftw_plan_dft_3d(plan,NTZ,NTY,NTX,af,af,FFTW_FORWARD,FFTW_ESTIMATE)
  call dfftw_execute(plan)
  call dfftw_destroy_plan(plan)
  return
end subroutine
Subroutine :
wf :type(snk_wavefunc_obj), intent(inout)

fft sink wave function

[Source]

subroutine fft_wavefunc(wf)
!
! fft sink wave function
!
  implicit none
  type(snk_wavefunc_obj), intent(inout) :: wf
  complex(DP), allocatable :: twf(:,:,:)
  type(timer) :: fft_time
  real(DP) :: etime

  call new(fft_time)

  call tic(fft_time)

  if (.not.m_is_initialized) call new_fft()

  allocate(twf(NTZ,NTY,NTX))
  call gather_wavefunc(wf,twf)
  call fft_wavefunc_internal(twf)
  call scatter_wavefunc(twf,wf)
  deallocate(twf)

  call toc(fft_time)

  etime = get_elapse(fft_time)
  if (nodeid==0)write(*,'("%FFT_ETIME_WAVEFUNC:",F15.6)')etime

  return
end subroutine
Subroutine :
q(COL,COL,SPIN,SPIN,NSPACE,NT) :complex(DP), intent(inout)

inverse fft quark propagator

[Source]

subroutine invfft_qprop(q)
!
! inverse fft quark propagator
!
  implicit none
  complex(DP), intent(inout) :: q(COL,COL,SPIN,SPIN,NSPACE,NT)
  complex(DP), allocatable :: wf(:,:,:,:)
  integer :: iqp
  type(timer) :: timer1,timer2,timer3
  real(DP) :: etime1,etime2,etime3
  call new(timer1)
  call new(timer2)
  call new(timer3)

  call tic(timer1)

  if (.not.m_is_initialized) call new_fft()

  allocate(wf(NTZ,NTY,NTX,NUM_QPROP_NL))

  call tic(timer2)
  call gather_qprop(q,wf)
  call toc(timer2)

  call invfft_qprop_internal(wf,NUM_QPROP_NL)

  call tic(timer3)
  call scatter_qprop(wf,q)
  call toc(timer3)

  deallocate(wf)
  call toc(timer1)

  etime1 = get_elapse(timer1)
  etime2 = get_elapse(timer2)
  etime3 = get_elapse(timer3)
  if (nodeid==0) write(*,'("%INVFFT_ETIME_QPROP: ALL=",F15.6," SCATTER_QPROP=",F15.6," GATHER_QPROP=",F15.6)') etime1,etime2,etime3

  return
end subroutine
Subroutine :
qp :type(quark_prop_obj), intent(inout)

[Source]

subroutine invfft_qprop(qp)
  implicit none
  type(quark_prop_obj), intent(inout) :: qp
  complex(8), allocatable :: wf(:,:,:,:)
  allocate(wf(NTZ,NTY,NTX,NUM_WF_NL))
  call gather_wavefunc(qp,wf)
  call invfft_wavefunc(wf)
  call scatter_wavefunc(wf,qp)
  deallocate(wf)
  return
end subroutine
Subroutine :
qp :type(quark_prop_obj), intent(inout)

[Source]

subroutine invfft_qprop(qp)
  implicit none
  type(quark_prop_obj), intent(inout) :: qp
  complex(8), allocatable :: wf(:,:,:,:)
  allocate(wf(NTZ,NTY,NTX,NUM_WF_NL))
  call gather_wavefunc(qp,wf)
  call invfft_wavefunc(wf)
  call scatter_wavefunc(wf,qp)
  deallocate(wf)
  return
end subroutine
Subroutine :
af(NTZ,NTY,NTX) :complex(8), intent(inout)

[Source]

subroutine invfft_wavefunc(af)
  implicit none
  complex(8), intent(inout) :: af(NTZ,NTY,NTX)
  integer(8) :: plan
  integer, parameter :: NVOL = (NTZ*NTY*NTX)
  real(8) :: rfac
  integer :: itx,ity,itz
  call dfftw_plan_dft_3d(plan,NTZ,NTY,NTX,af,af,FFTW_BACKWARD,FFTW_ESTIMATE)
  call dfftw_execute(plan)
  call dfftw_destroy_plan(plan)
  rfac = 1.0d0/NVOL
  do itx=1,NTX
  do ity=1,NTY
  do itz=1,NTZ
    af(itz,ity,itx) = af(itz,ity,itx)*rfac
  enddo
  enddo
  enddo
  return
end subroutine
Subroutine :
af(NTZ,NTY,NTX) :complex(8), intent(inout)

[Source]

subroutine invfft_wavefunc(af)
  implicit none
  complex(8), intent(inout) :: af(NTZ,NTY,NTX)
  integer(8) :: plan
  integer, parameter :: NVOL = (NTZ*NTY*NTX)
  real(8) :: rfac
  integer :: itx,ity,itz
  call dfftw_plan_dft_3d(plan,NTZ,NTY,NTX,af,af,FFTW_BACKWARD,FFTW_ESTIMATE)
  call dfftw_execute(plan)
  call dfftw_destroy_plan(plan)
  rfac = 1.0d0/NVOL
  do itx=1,NTX
  do ity=1,NTY
  do itz=1,NTZ
    af(itz,ity,itx) = af(itz,ity,itx)*rfac
  enddo
  enddo
  enddo
  return
end subroutine
Subroutine :
wf :type(snk_wavefunc_obj), intent(inout)

inverse fft sink wave function

[Source]

subroutine invfft_wavefunc(wf)
!
! inverse fft sink wave function
!
  implicit none
  type(snk_wavefunc_obj), intent(inout) :: wf
  complex(DP), allocatable :: twf(:,:,:)
  type(timer) :: fft_time
  real(DP) :: etime

  call new(fft_time)

  call tic(fft_time)

  if (.not.m_is_initialized) call new_fft()

  allocate(twf(NTZ,NTY,NTX))
  call gather_wavefunc(wf,twf)
  call invfft_wavefunc_internal(twf)
  call scatter_wavefunc(twf,wf)
  deallocate(twf)

  call toc(fft_time)

  etime = get_elapse(fft_time)
  if (nodeid==0)write(*,'("%INVFFT_ETIME_WAVEFUNC:",F15.6)')etime

  return
end subroutine
new( this )
Subroutine :
this :type(lattice_world), intent(inout)

Initialize lattice constants, node information (next to nearest node rank etc.)

Original external subprogram is lattice_class#new

new( this )
Subroutine :
this :type(qprop_params), intent(inout)

set default values for a quark propagator parameter

Original external subprogram is quark_prop_class#new

new( this )
Subroutine :
this :type(qprop_params), intent(inout)

set default values for a quark propagator parameter

Original external subprogram is quark_prop_class#new

new( this )
Subroutine :
this :type(quark_prop), intent(inout)

set default values for a quark propagator

Original external subprogram is quark_prop_class#new

new( this )
Subroutine :
this :type(quark_prop), intent(inout)

set default values for a quark propagator

Original external subprogram is quark_prop_class#new

new( this )
Subroutine :
this :type(quark_prop_obj), intent(inout)

set default values for a quark propagator

Original external subprogram is quark_prop_class#new

new( this )
Subroutine :
this :type(quark_prop_obj), intent(inout)

set default values for a quark propagator

Original external subprogram is quark_prop_class#new

new( this )
Subroutine :
this :type(quark_prop_parameter_obj), intent(inout)

set default values for a quark propagator parameter

Original external subprogram is quark_prop_class#new

new( this )
Subroutine :
this :type(quark_prop_parameter_obj), intent(inout)

set default values for a quark propagator parameter

Original external subprogram is quark_prop_class#new

new( this )
Subroutine :
this :type(snk_wavefunc_obj), intent(inout)

Original external subprogram is wavefunc_class#new

new( this )
Subroutine :
this :type(snk_wavefunc_obj), intent(inout)

Original external subprogram is wavefunc_class#new

new( this )
Subroutine :
this :type(src_wavefunc_obj), intent(inout)

Original external subprogram is wavefunc_class#new

new( this )
Subroutine :
this :type(src_wavefunc_obj), intent(inout)

Original external subprogram is wavefunc_class#new

new( this )
Subroutine :
this :type(wavefunc_param_obj), intent(inout)

Original external subprogram is wavefunc_class#new

new( this )
Subroutine :
this :type(wavefunc_param_obj), intent(inout)

Original external subprogram is wavefunc_class#new

new( this, [master_only] )
Subroutine :
this :type(timer), intent(inout)
master_only :logical, optional, intent(in)

initialize timer

Original external subprogram is timer_class#new