Commit d91c2769 authored by ccavazzoni's avatar ccavazzoni

- cleanup

- call to fft helper subroutines


git-svn-id: http://qeforge.qe-forge.org/svn/q-e/trunk/espresso@13732 c92efa57-630b-4861-b058-cf58834340f0
parent d12e374b
......@@ -487,6 +487,7 @@
!
!
SUBROUTINE sum_charge( rsumg, rsumr )
!
REAL(DP), INTENT(OUT) :: rsumg( : )
REAL(DP), INTENT(OUT) :: rsumr( : )
......@@ -516,6 +517,7 @@
!
USE parallel_include
USE fft_scalar, ONLY: cfft3ds
USE fft_helper_subroutines
! USE scatter_mod, ONLY: maps_sticks_to_3d
!
! MAIN LOOP OVER THE EIGENSTATES
......@@ -524,7 +526,7 @@
!
IMPLICIT NONE
!
INTEGER :: from, i, eig_index, eig_offset, ii
INTEGER :: from, i, eig_index, eig_offset, ii, right_nnr
!
#if defined(__INTEL_COMPILER)
#if __INTEL_COMPILER >= 1300
......@@ -541,6 +543,8 @@
!
tmp_rhos = 0_DP
CALL tg_get_nnr( dffts, right_nnr )
do i = 1, nbsp_bgrp, 2*dffts%nproc2
!
......@@ -552,6 +556,7 @@
#if defined(__MPI)
aux = (0.d0, 0.d0)
!
! Loop for all local g-vectors (ngw)
! ci_bgrp: stores the Fourier expansion coefficients
......@@ -565,15 +570,8 @@
!
eig_offset = 0
!!$omp parallel
!!$omp single
do eig_index = 1, 2*dffts%nproc2, 2
!
!!$omp task default(none) &
!!$omp firstprivate( i, eig_offset, nbsp_bgrp, ngw, eig_index ) &
!!$omp shared( aux, c_bgrp, dffts )
!
! here we pack 2*nogrp electronic states in the psis array
! note that if nogrp == nproc_bgrp each proc perform a full 3D
! fft and the scatter phase is local (without communication)
......@@ -582,18 +580,15 @@
!
! The eig_index loop is executed only ONCE when NOGRP=1.
!
CALL c2psi( psis(eig_offset*dffts%nnr+1), dffts%nnr, &
CALL c2psi( psis( eig_offset * right_nnr + 1 ), right_nnr, &
c_bgrp( 1, i+eig_index-1 ), c_bgrp( 1, i+eig_index ), ngw, 2 )
!
ENDIF
!!$omp end task
!
eig_offset = eig_offset + 1
!
end do
!!$omp end single
!!$omp end parallel
!
! 2*NOGRP are trasformed at the same time
! psis: holds the fourier coefficients of the current proccesor
......@@ -679,29 +674,12 @@
!
END DO
IF( nbgrp > 1 ) THEN
CALL mp_sum( tmp_rhos, inter_bgrp_comm )
END IF
!ioff = 0
!DO ip = 1, nproc_bgrp
! CALL MPI_REDUCE( rho(1+ioff*nr1*nr2,1), rhos(1,1), dffts%nnr, MPI_DOUBLE_PRECISION, MPI_SUM, ip-1, intra_bgrp_comm, ierr)
! ioff = ioff + dffts%npp( ip )
!END DO
IF ( dffts%nproc2 > 1 ) CALL mp_sum( tmp_rhos, gid = dffts%comm2 )
!
!BRING CHARGE DENSITY BACK TO ITS ORIGINAL POSITION
!
!If the current processor is not the "first" processor in its
!orbital group then does a local copy (reshuffling) of its data
!
nxyp = dffts%nr1x * dffts%my_nr2p
DO ir3 = 1, dffts%my_nr3p
ioff = dffts%nr1x * dffts%my_nr2p * (ir3-1)
ioff_tg = dffts%nr1x * dffts%nr2x * (ir3-1) + dffts%nr1x * dffts%my_i0r2p
rhos(ioff+1:ioff+nxyp,1:nspin) = rhos(ioff+1:ioff+nxyp,1:nspin) + tmp_rhos(ioff_tg+1:ioff_tg+nxyp,1:nspin)
END DO
CALL tg_reduce_rho( rhos, tmp_rhos, dffts )
DEALLOCATE( tmp_rhos )
DEALLOCATE( aux )
......
......@@ -34,12 +34,10 @@
USE funct, ONLY: dft_is_meta, dft_is_hybrid, exx_is_active
USE fft_base, ONLY: dffts
USE fft_interfaces, ONLY: fwfft, invfft
! USE fft_parallel, ONLY: pack_group_sticks, unpack_group_sticks
! USE fft_parallel, ONLY: fw_tg_cft3_z, bw_tg_cft3_z, fw_tg_cft3_xy, bw_tg_cft3_xy
! USE fft_parallel, ONLY: fw_tg_cft3_scatter, bw_tg_cft3_scatter
USE mp_global, ONLY: me_bgrp
USE control_flags, ONLY: lwfpbe0nscf
USE exx_module, ONLY: exx_potential
USE fft_helper_subroutines
!
IMPLICIT NONE
!
......@@ -59,7 +57,7 @@
!
INTEGER :: iv, jv, ia, is, isa, ism, ios, iss1, iss2, ir, ig, inl, jnl
INTEGER :: ivoff, jvoff, igoff, igno, igrp, ierr
INTEGER :: idx, eig_offset, nogrp_
INTEGER :: idx, eig_offset, nogrp_ , inc
REAL(DP) :: fi, fip, dd, dv
COMPLEX(DP) :: fp, fm, ci
#if defined(__INTEL_COMPILER)
......@@ -278,6 +276,7 @@
!$omp single
eig_offset = 0
CALL tg_get_recip_inc( dffts, inc )
igno = 1
DO idx = 1, 2*nogrp_ , 2
......@@ -316,7 +315,7 @@
!$omp end task
igno = igno + ngw
eig_offset = eig_offset + dffts%nnr
eig_offset = eig_offset + inc
! We take into account the number of elements received from other members of the orbital group
......
......@@ -26,7 +26,7 @@
use cell_base, only: ainv, at, omega, alat
use small_box, only: small_box_set
use smallbox_grid_dim, only: smallbox_grid_init,smallbox_grid_info
USE fft_types, ONLY: fft_type_allocate, fft_type_init
USE fft_types, ONLY: fft_type_init
use ions_base, only: nat
USE recvec_subs, ONLY: ggen
USE gvect, ONLY: mill_g, eigts1,eigts2,eigts3, gg, &
......@@ -34,7 +34,7 @@
use gvecs, only: gcutms, gvecs_init
use gvecw, only: gkcut, gvecw_init, g2kin_init
USE smallbox_subs, ONLY: ggenb
USE fft_base, ONLY: dfftp, dffts, dfftb, dfft3d, dtgs, fft_base_info
USE fft_base, ONLY: dfftp, dffts, dfftb, dfft3d, fft_base_info
USE fft_smallbox, ONLY: cft_b_omp_init
USE fft_base, ONLY: smap
USE control_flags, ONLY: gamma_only, smallmem
......@@ -47,7 +47,6 @@
USE input_parameters, ONLY: ref_cell, ref_alat
use cell_base, ONLY: ref_at, ref_bg
USE exx_module, ONLY: h_init
! USE task_groups, ONLY: task_groups_init
implicit none
!
......@@ -142,7 +141,6 @@
! (but only if the axis triplet is right-handed, otherwise
! for a left-handed triplet, ainv is minus the inverse of a)
!
! CALL task_groups_init( dffts, dtgs, ntask_groups )
CALL fft_base_info( ionode, stdout )
ngw_ = dffts%nwl( dffts%mype + 1 )
ngs_ = dffts%ngl( dffts%mype + 1 )
......@@ -452,30 +450,36 @@
USE fft_types, ONLY: fft_type_descriptor
use io_global, only: stdout, ionode
USE fft_helper_subroutines
IMPLICIT NONE
TYPE(fft_type_descriptor), INTENT(IN) :: dfftp, dffts
INTEGER :: i
INTEGER :: i, nr3l
IF(ionode) THEN
CALL tg_get_local_nr3( dfftp, nr3l )
WRITE( stdout,*)
WRITE( stdout,*) ' Real Mesh'
WRITE( stdout,*) ' ---------'
WRITE( stdout,1000) dfftp%nr1, dfftp%nr2, dfftp%nr3, dfftp%nr1, dfftp%nr2, dfftp%my_nr3p, 1, 1, dfftp%nproc
WRITE( stdout,1000) dfftp%nr1, dfftp%nr2, dfftp%nr3, dfftp%nr1, dfftp%nr2, nr3l, 1, 1, dfftp%nproc
WRITE( stdout,1010) dfftp%nr1x, dfftp%nr2x, dfftp%nr3x
WRITE( stdout,1020) dfftp%nnr
WRITE( stdout,*) ' Number of x-y planes for each processors: '
WRITE( stdout, fmt = '( 3X, "nr3l = ", 10I5 )' ) &
( dfftp%nr3p( i ), i = 1, dfftp%nproc3 )
CALL tg_get_local_nr3( dffts, nr3l )
WRITE( stdout,*)
WRITE( stdout,*) ' Smooth Real Mesh'
WRITE( stdout,*) ' ----------------'
WRITE( stdout,1000) dffts%nr1, dffts%nr2, dffts%nr3, dffts%nr1, dffts%nr2, dffts%my_nr3p,1,1, dfftp%nproc
WRITE( stdout,1000) dffts%nr1, dffts%nr2, dffts%nr3, dffts%nr1, dffts%nr2, nr3l,1,1, dfftp%nproc
WRITE( stdout,1010) dffts%nr1x, dffts%nr2x, dffts%nr3x
WRITE( stdout,1020) dffts%nnr
WRITE( stdout,*) ' Number of x-y planes for each processors: '
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment