1 SUBROUTINE fouri (grpmn, gsource, amatrix, amatsq, bvec,
4 USE parallel_include_module
10 INTEGER,
INTENT(IN) :: ndim
11 REAL(dp),
DIMENSION(mnpd2,nuv3),
INTENT(IN) :: grpmn
12 REAL(dp),
DIMENSION(nuv),
INTENT(IN) :: gsource
13 REAL(dp),
DIMENSION(mnpd,mnpd,ndim**2),
INTENT(OUT) :: amatrix
14 REAL(dp),
DIMENSION(mnpd2,mnpd2),
INTENT(OUT) :: amatsq
15 REAL(dp),
DIMENSION(mnpd,ndim),
INTENT(INOUT) :: bvec, bvecNS
20 REAL(dp),
PARAMETER :: int_ext = 1
24 INTEGER :: i, j, k, m, mn, mn0, n
25 REAL(dp),
ALLOCATABLE,
DIMENSION(:) :: source
26 REAL(dp) :: ton, toff, tfourion, tfourioff
42 CALL second0(tfourion)
44 ALLOCATE (source(nuv3), stat=i)
45 IF (i .NE. 0) stop
'Allocation error in fouri'
55 source(nuv3min:nuv3max) = onp*gsource(nuv3min:nuv3max)
61 IF (nuv3min.LE.k .AND. k.LE.nuv3max)
THEN
62 source(k) = p5*onp*(gsource(k) - gsource(imirr(k)))
78 nloop2:
DO n = -nf, nf
82 IF (m.EQ.0 .AND. n.LT.0) cycle
83 DO i = nuv3min, nuv3max
85 bvecns(mn,1) = bvecns(mn,1) + sinmni(j,mn)*source(i)
87 amatrix(:,mn,1) = amatrix(:,mn,1)
88 & + sinmni(j,mn)*grpmn(:mnpd,i)
92 bvecns(mn,2) = bvecns(mn,2) + cosmni(j,mn)*source(i)
94 amatrix(:,mn,2) = amatrix(:,mn,2)
95 & + cosmni(j,mn)*grpmn(:mnpd,i)
96 amatrix(:,mn,3) = amatrix(:,mn,3)
97 & + sinmni(j,mn)*grpmn(mnpd+1:,i)
98 amatrix(:,mn,4) = amatrix(:,mn,4)
99 & + cosmni(j,mn)*grpmn(mnpd+1:,i)
106 CALL mpi_allreduce(mpi_in_place, amatrix,
SIZE(amatrix),
107 & mpi_real8, mpi_sum, vac_comm, mpi_err)
109 allreduce_time = allreduce_time + (toff - ton)
116 DEALLOCATE (source, stat=i)
128 amatrix(mn,mn,1) = amatrix(mn,mn,1) + pi3*int_ext
133 amatrix(mn,mn,4) = amatrix(mn,mn,4) + pi3*int_ext
135 amatrix(mn0,mn0,4) = amatrix(mn0,mn0,4) + pi3*int_ext
141 amatsq(:mnpd,:mnpd) = amatrix(:,:,1)
144 amatsq(:mnpd,1+mnpd:mnpd2) = amatrix(:,:,2)
145 amatsq(1+mnpd:mnpd2,:mnpd) = amatrix(:,:,3)
146 amatsq(1+mnpd:mnpd2,1+mnpd:mnpd2) = amatrix(:,:,4)
149 CALL second0(tfourioff)
150 timer_vac(tfouri) = timer_vac(tfouri) + (tfourioff-tfourion)
151 fouri_time = timer_vac(tfouri)