1
2! Copyright (C) 2017 J. K. Dewhurst, S. Sharma and E. K. U. Gross.
3! This file is distributed under the terms of the GNU General Public License.
4! See the file COPYING for license details.
5
6subroutine zftwfir(ngp,igpig,wfir)
7use modmain
8use modomp
9implicit none
10! arguments
11integer, intent(in) :: ngp(nspnfv),igpig(ngkmax,nspnfv)
12complex(8), intent(inout) :: wfir(ngtc,nspinor,nstsv)
13! local variables
14integer ist,ispn,jspn
15integer igp,ifg,nthd
16real(8) t0
17! automatic arrays
18complex(8) z(ngkmax)
19t0=1.d0/sqrt(omega)
20call holdthd(nstsv,nthd)
21!$OMP PARALLEL DO DEFAULT(SHARED) &
22!$OMP PRIVATE(z,ispn,jspn,igp,ifg) &
23!$OMP NUM_THREADS(nthd)
24do ist=1,nstsv
25  do ispn=1,nspinor
26    jspn=jspnfv(ispn)
27    call zcopy(ngp(jspn),wfir(:,ispn,ist),1,z,1)
28    wfir(:,ispn,ist)=0.d0
29    do igp=1,ngp(jspn)
30      ifg=igfc(igpig(igp,jspn))
31      wfir(ifg,ispn,ist)=t0*z(igp)
32    end do
33    call zfftifc(3,ngdgc,1,wfir(:,ispn,ist))
34  end do
35end do
36!$OMP END PARALLEL DO
37call freethd(nthd)
38end subroutine
39
40