Commit 472101ce authored by ccavazzoni's avatar ccavazzoni

- task groups module not used, removed

- more helper functions 


git-svn-id: http://qeforge.qe-forge.org/svn/q-e/trunk/espresso@13735 c92efa57-630b-4861-b058-cf58834340f0
parent 50ca8c12
......@@ -6,7 +6,6 @@ include ../make.inc
#MODFLAGS= $(MOD_FLAG)../iotk/src $(MOD_FLAG).
FFTX = \
task_groups.o \
scatter_mod.o \
fft_fwinv.o \
fft_scalar.o \
......
......@@ -3,9 +3,93 @@ MODULE fft_helper_subroutines
IMPLICIT NONE
SAVE
INTERFACE tg_reduce_rho
MODULE PROCEDURE tg_reduce_rho_1,tg_reduce_rho_2,tg_reduce_rho_3
END INTERFACE
CONTAINS
SUBROUTINE tg_reduce_rho( rhos, tmp_rhos, desc )
SUBROUTINE tg_reduce_rho_1( rhos, tg_rho_nc, tg_rho, ispin, noncolin, domag, desc )
USE fft_param
USE fft_types, ONLY : fft_type_descriptor
TYPE(fft_type_descriptor), INTENT(in) :: desc
INTEGER, INTENT(IN) :: ispin
LOGICAL, INTENT(IN) :: noncolin, domag
REAL(DP), INTENT(INOUT) :: tg_rho(:)
REAL(DP), INTENT(INOUT) :: tg_rho_nc(:,:)
REAL(DP), INTENT(OUT) :: rhos(:,:)
INTEGER :: ierr, ioff, idx, ir3, ir, ipol, ioff_tg, nxyp, npol_
#ifdef __MPI
IF( noncolin) THEN
CALL MPI_ALLREDUCE( MPI_IN_PLACE, tg_rho_nc, SIZE(tg_rho_nc), MPI_DOUBLE_PRECISION, MPI_SUM, desc%comm2, ierr )
ELSE
CALL MPI_ALLREDUCE( MPI_IN_PLACE, tg_rho, SIZE(tg_rho), MPI_DOUBLE_PRECISION, MPI_SUM, desc%comm2, ierr )
END IF
#endif
!
! copy the charge back to the proper processor location
!
nxyp = desc%nr1x * desc%my_nr2p
IF (noncolin) THEN
npol_ = 1 ; if (domag) npol_ = 4
endif
DO ir3=1,desc%my_nr3p
ioff = desc%nr1x * desc%my_nr2p * (ir3-1)
ioff_tg = desc%nr1x * desc%nr2x * (ir3-1) + desc%nr1x * desc%my_i0r2p
IF (noncolin) THEN
!$omp parallel do
DO ipol=1, npol_
DO ir = 1, nxyp
rhos(ir+ioff,ipol) = rhos(ir+ioff,ipol) + tg_rho_nc(ir+ioff_tg,ipol)
END DO
END DO
!$omp end parallel do
ELSE
!$omp parallel do
DO ir = 1, nxyp
rhos(ir+ioff,ispin) = rhos(ir+ioff,ispin) + tg_rho(ir+ioff_tg)
END DO
!$omp end parallel do
END IF
END DO
END SUBROUTINE
SUBROUTINE tg_reduce_rho_2( rhos, tmp_rhos, ispin, desc )
USE fft_param
USE fft_types, ONLY : fft_type_descriptor
TYPE(fft_type_descriptor), INTENT(in) :: desc
INTEGER, INTENT(IN) :: ispin
REAL(DP), INTENT(INOUT) :: tmp_rhos(:)
REAL(DP), INTENT(OUT) :: rhos(:,:)
INTEGER :: ierr, ioff, idx, ir3, nxyp, ioff_tg
IF ( desc%nproc2 > 1 ) THEN
#ifdef __MPI
CALL MPI_ALLREDUCE( MPI_IN_PLACE, tmp_rhos, SIZE(tmp_rhos), MPI_DOUBLE_PRECISION, MPI_SUM, desc%comm2, ierr )
#endif
ENDIF
!
!BRING CHARGE DENSITY BACK TO ITS ORIGINAL POSITION
!
nxyp = desc%nr1x * desc%my_nr2p
DO ir3 = 1, desc%my_nr3p
ioff = desc%nr1x * desc%my_nr2p * (ir3-1)
ioff_tg = desc%nr1x * desc%nr2x * (ir3-1) + desc%nr1x * desc%my_i0r2p
rhos(ioff+1:ioff+nxyp,ispin) = rhos(ioff+1:ioff+nxyp,ispin) + tmp_rhos(ioff_tg+1:ioff_tg+nxyp)
END DO
END SUBROUTINE
SUBROUTINE tg_reduce_rho_3( rhos, tmp_rhos, desc )
USE fft_param
USE fft_types, ONLY : fft_type_descriptor
......@@ -50,6 +134,14 @@ CONTAINS
val = desc%my_nr3p
END SUBROUTINE
SUBROUTINE tg_get_group_nr3( desc, val )
USE fft_param
USE fft_types, ONLY : fft_type_descriptor
TYPE(fft_type_descriptor), INTENT(in) :: desc
INTEGER, INTENT(OUT) :: val
val = desc%my_nr3p
END SUBROUTINE
SUBROUTINE tg_get_recip_inc( desc, val )
USE fft_param
USE fft_types, ONLY : fft_type_descriptor
......
......@@ -40,7 +40,6 @@ test.o : fft_param.o
test.o : fft_support.o
test.o : fft_types.o
test.o : stick_base.o
test.o : task_groups.o
test0.o : fft_interfaces.o
test0.o : fft_parallel.o
test0.o : fft_param.o
......
!
! Copyright (C) Quantum ESPRESSO group
!
! This file is distributed under the terms of the
! GNU General Public License. See the file `License'
! in the root directory of the present distribution,
! or http://www.gnu.org/copyleft/gpl.txt .
!
!=----------------------------------------------------------------------=
MODULE task_groups
!=----------------------------------------------------------------------=
! ... Distribute G-vectors across processors as sticks and planes,
! ... initialize FFT descriptors for both dense and smooth grids
IMPLICIT NONE
INTEGER, PARAMETER :: DP = selected_real_kind(14,200)
TYPE task_groups_descriptor
!
! task groups logical
!
LOGICAL :: have_task_groups = .FALSE.
!
END TYPE
SAVE
!=----------------------------------------------------------------------=
END MODULE task_groups
!=----------------------------------------------------------------------=
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