1
2! Copyright (C) 2018 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 rfirsm(m,rfir)
7use modmain
8implicit none
9! arguments
10integer, intent(in) :: m
11real(8), intent(inout) :: rfir(ngtot)
12! local variables
13integer ig,ifg
14real(8) t0,t1,t2
15! allocatable arrays
16complex(8), allocatable :: zfft(:)
17if (m.le.0) return
18allocate(zfft(ngtot))
19zfft(:)=rfir(:)
20call zfftifc(3,ngridg,-1,zfft)
21t0=dble(2*m)
22t1=1.d0/gmaxvr
23do ig=1,ngtot
24  ifg=igfft(ig)
25  t2=t1*gc(ig)
26  t2=exp(-t0*t2**4)
27  zfft(ifg)=t2*zfft(ifg)
28end do
29call zfftifc(3,ngridg,1,zfft)
30rfir(:)=dble(zfft(:))
31deallocate(zfft)
32end subroutine
33
34