2003-03-15 01:01:59 +08:00
|
|
|
!
|
2010-12-29 04:25:38 +08:00
|
|
|
! Copyright (C) 2002-2010 Quantum ESPRESSO group
|
2003-03-15 01:01:59 +08:00
|
|
|
! 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 stick_base
|
|
|
|
!=----------------------------------------------------------------------=
|
|
|
|
|
|
|
|
USE kinds
|
|
|
|
USE io_global, ONLY: ionode
|
|
|
|
|
|
|
|
IMPLICIT NONE
|
|
|
|
PRIVATE
|
|
|
|
SAVE
|
|
|
|
|
2003-03-31 16:42:59 +08:00
|
|
|
PUBLIC :: sticks_maps, sticks_sort, sticks_countg, sticks_dist, sticks_pairup
|
2011-01-06 00:04:54 +08:00
|
|
|
PUBLIC :: sticks_owner, sticks_deallocate, sticks_maps_scalar
|
2010-02-22 16:13:22 +08:00
|
|
|
|
2003-07-11 00:59:11 +08:00
|
|
|
! ... sticks_owner : stick owner, sticks_owner( i, j ) is the index of the processor
|
|
|
|
! ... (starting from 1) owning the stick whose x and y coordinate are i and j.
|
|
|
|
|
2010-02-22 16:13:22 +08:00
|
|
|
INTEGER, ALLOCATABLE, TARGET :: sticks_owner( : , : )
|
2003-03-15 01:01:59 +08:00
|
|
|
|
|
|
|
!=----------------------------------------------------------------------=
|
|
|
|
CONTAINS
|
|
|
|
!=----------------------------------------------------------------------=
|
|
|
|
|
2011-01-20 06:13:34 +08:00
|
|
|
SUBROUTINE sticks_maps( tk, ub, lb, b1, b2, b3, gcut, gcutw, gcuts, st, stw, sts, me, nproc, comm )
|
2003-03-15 01:01:59 +08:00
|
|
|
|
|
|
|
USE mp, ONLY: mp_sum
|
|
|
|
|
2010-02-22 16:13:22 +08:00
|
|
|
LOGICAL, INTENT(in) :: tk ! if true use the full space grid
|
|
|
|
INTEGER, INTENT(in) :: ub(:) ! upper bounds for i-th grid dimension
|
|
|
|
INTEGER, INTENT(in) :: lb(:) ! lower bounds for i-th grid dimension
|
|
|
|
REAL(DP) , INTENT(in) :: b1(:), b2(:), b3(:) ! reciprocal space base vectors
|
|
|
|
REAL(DP) , INTENT(in) :: gcut ! cut-off for potentials
|
|
|
|
REAL(DP) , INTENT(in) :: gcutw ! cut-off for plane waves
|
|
|
|
REAL(DP) , INTENT(in) :: gcuts ! cut-off for smooth mesh
|
|
|
|
INTEGER, INTENT(out) :: st( lb(1): ub(1), lb(2):ub(2) ) ! stick map for potential
|
|
|
|
INTEGER, INTENT(out) :: stw(lb(1): ub(1), lb(2):ub(2) ) ! stick map for wave functions
|
|
|
|
INTEGER, INTENT(out) :: sts(lb(1): ub(1), lb(2):ub(2) ) ! stick map for smooth mesh
|
2011-01-20 06:13:34 +08:00
|
|
|
INTEGER, INTENT(in) :: me ! my proc id (starting from 0)
|
|
|
|
INTEGER, INTENT(in) :: nproc ! number of proc in the g-vec group
|
|
|
|
INTEGER, INTENT(in) :: comm ! communicator of the g-vec group
|
2003-03-15 01:01:59 +08:00
|
|
|
|
|
|
|
INTEGER :: i, j, k, kip
|
2005-08-28 22:09:42 +08:00
|
|
|
REAL(DP) :: gsq
|
2003-03-15 01:01:59 +08:00
|
|
|
|
|
|
|
stw = 0
|
|
|
|
st = 0
|
|
|
|
sts = 0
|
|
|
|
|
2003-03-31 16:42:59 +08:00
|
|
|
! ... Here find the basic maps of sticks st, stw and sts for the potential
|
|
|
|
! ... cut-off gcut, wavefunction cut-off gcutw, and smooth mesh cut-off gcuts
|
|
|
|
|
|
|
|
! ... st(i,j) will contain the number of G vectors of the stick whose
|
2010-02-22 16:13:22 +08:00
|
|
|
! ... indices are (i,j).
|
|
|
|
|
2006-07-27 21:11:51 +08:00
|
|
|
#if defined (__EKO)
|
2010-02-22 16:13:22 +08:00
|
|
|
WRITE(*,*) ! Workaround for EKOPath compiler bug
|
2006-07-27 21:11:51 +08:00
|
|
|
#endif
|
2010-02-22 16:13:22 +08:00
|
|
|
IF( .not. tk ) THEN
|
2003-03-15 01:01:59 +08:00
|
|
|
|
2010-02-22 16:13:22 +08:00
|
|
|
kip = 0 + abs(lb(3)) + 1
|
2011-01-20 06:13:34 +08:00
|
|
|
IF( mod( kip, nproc ) == me ) THEN
|
2003-03-15 01:01:59 +08:00
|
|
|
st (0,0) = st (0,0) + 1
|
|
|
|
stw(0,0) = stw(0,0) + 1
|
2003-04-28 15:23:04 +08:00
|
|
|
sts(0,0) = sts(0,0) + 1
|
2010-02-22 16:13:22 +08:00
|
|
|
ENDIF
|
2003-03-15 01:01:59 +08:00
|
|
|
|
2010-02-22 16:13:22 +08:00
|
|
|
DO i= 0, 0
|
|
|
|
DO j= 0, 0
|
2003-03-15 01:01:59 +08:00
|
|
|
DO k= 1, ub(3)
|
2010-02-22 16:13:22 +08:00
|
|
|
kip = k + abs(lb(3)) + 1
|
2011-01-20 06:13:34 +08:00
|
|
|
IF( mod( kip, nproc ) == me ) THEN
|
2010-02-22 16:13:22 +08:00
|
|
|
gsq= (dble(i)*b1(1)+dble(j)*b2(1)+dble(k)*b3(1) )**2
|
|
|
|
gsq=gsq+(dble(i)*b1(2)+dble(j)*b2(2)+dble(k)*b3(2) )**2
|
|
|
|
gsq=gsq+(dble(i)*b1(3)+dble(j)*b2(3)+dble(k)*b3(3) )**2
|
|
|
|
IF(gsq.le.gcut ) THEN
|
2003-03-15 01:01:59 +08:00
|
|
|
st(i,j) = st(i,j) + 1
|
2010-02-22 16:13:22 +08:00
|
|
|
IF(gsq.le.gcutw) THEN
|
2003-03-15 01:01:59 +08:00
|
|
|
stw(i,j) = stw(i,j) + 1
|
2010-02-22 16:13:22 +08:00
|
|
|
ENDIF
|
|
|
|
IF(gsq.le.gcuts) THEN
|
2003-03-15 01:01:59 +08:00
|
|
|
sts(i,j) = sts(i,j) + 1
|
2010-02-22 16:13:22 +08:00
|
|
|
ENDIF
|
|
|
|
ENDIF
|
|
|
|
ENDIF
|
|
|
|
ENDDO
|
|
|
|
ENDDO
|
|
|
|
ENDDO
|
2003-03-15 01:01:59 +08:00
|
|
|
|
|
|
|
DO i = 0, 0
|
|
|
|
DO j = 1, ub(2)
|
|
|
|
DO k = lb(3), ub(3)
|
2010-02-22 16:13:22 +08:00
|
|
|
kip = k + abs(lb(3)) + 1
|
2011-01-20 06:13:34 +08:00
|
|
|
IF( mod( kip, nproc) == me ) THEN
|
2010-02-22 16:13:22 +08:00
|
|
|
gsq= (dble(i)*b1(1)+dble(j)*b2(1)+dble(k)*b3(1) )**2
|
|
|
|
gsq=gsq+(dble(i)*b1(2)+dble(j)*b2(2)+dble(k)*b3(2) )**2
|
|
|
|
gsq=gsq+(dble(i)*b1(3)+dble(j)*b2(3)+dble(k)*b3(3) )**2
|
|
|
|
IF(gsq.le.gcut ) THEN
|
2003-03-15 01:01:59 +08:00
|
|
|
st(i,j) = st(i,j) + 1
|
2010-02-22 16:13:22 +08:00
|
|
|
IF(gsq.le.gcutw) THEN
|
2003-03-15 01:01:59 +08:00
|
|
|
stw(i,j) = stw(i,j) + 1
|
2010-02-22 16:13:22 +08:00
|
|
|
ENDIF
|
|
|
|
IF(gsq.le.gcuts) THEN
|
2003-03-15 01:01:59 +08:00
|
|
|
sts(i,j) = sts(i,j) + 1
|
2010-02-22 16:13:22 +08:00
|
|
|
ENDIF
|
|
|
|
ENDIF
|
|
|
|
ENDIF
|
|
|
|
ENDDO
|
|
|
|
ENDDO
|
|
|
|
ENDDO
|
2003-03-15 01:01:59 +08:00
|
|
|
|
|
|
|
DO i = 1, ub(1)
|
|
|
|
DO j = lb(2), ub(2)
|
|
|
|
DO k = lb(3), ub(3)
|
2010-02-22 16:13:22 +08:00
|
|
|
kip = k + abs(lb(3)) + 1
|
2011-01-20 06:13:34 +08:00
|
|
|
IF( mod( kip, nproc) == me ) THEN
|
2010-02-22 16:13:22 +08:00
|
|
|
gsq= (dble(i)*b1(1)+dble(j)*b2(1)+dble(k)*b3(1) )**2
|
|
|
|
gsq=gsq+(dble(i)*b1(2)+dble(j)*b2(2)+dble(k)*b3(2) )**2
|
|
|
|
gsq=gsq+(dble(i)*b1(3)+dble(j)*b2(3)+dble(k)*b3(3) )**2
|
|
|
|
IF(gsq.le.gcut ) THEN
|
2003-03-15 01:01:59 +08:00
|
|
|
st(i,j) = st(i,j) + 1
|
2010-02-22 16:13:22 +08:00
|
|
|
IF(gsq.le.gcutw) THEN
|
2003-03-15 01:01:59 +08:00
|
|
|
stw(i,j) = stw(i,j) + 1
|
2010-02-22 16:13:22 +08:00
|
|
|
ENDIF
|
|
|
|
IF(gsq.le.gcuts) THEN
|
2003-03-15 01:01:59 +08:00
|
|
|
sts(i,j) = sts(i,j) + 1
|
2010-02-22 16:13:22 +08:00
|
|
|
ENDIF
|
|
|
|
ENDIF
|
|
|
|
ENDIF
|
|
|
|
ENDDO
|
|
|
|
ENDDO
|
|
|
|
ENDDO
|
2003-03-15 01:01:59 +08:00
|
|
|
|
|
|
|
ELSE
|
|
|
|
|
|
|
|
DO i= lb(1), ub(1)
|
|
|
|
DO j= lb(2), ub(2)
|
|
|
|
DO k= lb(3), ub(3)
|
2010-02-22 16:13:22 +08:00
|
|
|
kip = k + abs(lb(3)) + 1
|
2011-01-20 06:13:34 +08:00
|
|
|
IF( mod( kip, nproc ) == me ) THEN
|
2010-02-22 16:13:22 +08:00
|
|
|
gsq= (dble(i)*b1(1)+dble(j)*b2(1)+dble(k)*b3(1) )**2
|
|
|
|
gsq=gsq+(dble(i)*b1(2)+dble(j)*b2(2)+dble(k)*b3(2) )**2
|
|
|
|
gsq=gsq+(dble(i)*b1(3)+dble(j)*b2(3)+dble(k)*b3(3) )**2
|
|
|
|
IF(gsq.le.gcut ) THEN
|
2003-03-15 01:01:59 +08:00
|
|
|
st(i,j) = st(i,j) + 1
|
2010-02-22 16:13:22 +08:00
|
|
|
ENDIF
|
|
|
|
IF(gsq.le.gcutw) THEN
|
2003-03-31 16:42:59 +08:00
|
|
|
stw(i,j) = stw(i,j) + 1
|
2010-02-22 16:13:22 +08:00
|
|
|
ENDIF
|
|
|
|
IF(gsq.le.gcuts) THEN
|
2003-03-31 16:42:59 +08:00
|
|
|
sts(i,j) = sts(i,j) + 1
|
2010-02-22 16:13:22 +08:00
|
|
|
ENDIF
|
|
|
|
ENDIF
|
|
|
|
ENDDO
|
|
|
|
ENDDO
|
|
|
|
ENDDO
|
2003-03-15 01:01:59 +08:00
|
|
|
|
2010-02-22 16:13:22 +08:00
|
|
|
ENDIF
|
2003-03-15 01:01:59 +08:00
|
|
|
|
2011-01-20 06:13:34 +08:00
|
|
|
CALL mp_sum(st , comm )
|
|
|
|
CALL mp_sum(stw , comm )
|
|
|
|
CALL mp_sum(sts , comm )
|
2003-03-15 01:01:59 +08:00
|
|
|
|
2007-09-04 20:58:11 +08:00
|
|
|
#if defined __STICKS_DEBUG
|
2003-03-15 01:01:59 +08:00
|
|
|
! Test sticks
|
2007-09-04 20:58:11 +08:00
|
|
|
WRITE( 6,*) 'testtesttesttesttesttesttesttesttesttest'
|
|
|
|
WRITE( 6,*) 'lb = ', lb(1), lb(2)
|
|
|
|
WRITE( 6,*) 'ub = ', ub(1), ub(2)
|
2010-02-22 16:13:22 +08:00
|
|
|
WRITE( 6,*) 'counts = ', count( st > 0 ), count( stw > 0 ), count( sts > 0 )
|
2007-09-04 20:58:11 +08:00
|
|
|
WRITE( 6,*) 'cut-offs = ', gcut, gcutw, gcuts
|
|
|
|
WRITE( 6,*) 'b1 = ', b1(1:3)
|
|
|
|
WRITE( 6,*) 'b2 = ', b2(1:3)
|
|
|
|
WRITE( 6,*) 'b3 = ', b3(1:3)
|
|
|
|
DO i = lb(1), ub(1)
|
|
|
|
DO j = lb(2), ub(2)
|
|
|
|
WRITE( 6,'(2I4,3I6)') i,j,st(i,j),stw(i,j),sts(i,j)
|
2010-02-22 16:13:22 +08:00
|
|
|
ENDDO
|
|
|
|
ENDDO
|
2007-09-04 20:58:11 +08:00
|
|
|
WRITE( 6,*) 'testtesttesttesttesttesttesttesttesttest'
|
2003-03-15 01:01:59 +08:00
|
|
|
! Test sticks
|
2007-09-04 20:58:11 +08:00
|
|
|
#endif
|
2003-03-15 01:01:59 +08:00
|
|
|
|
|
|
|
RETURN
|
2005-05-18 22:02:51 +08:00
|
|
|
END SUBROUTINE sticks_maps
|
2003-03-15 01:01:59 +08:00
|
|
|
|
2005-01-15 18:53:46 +08:00
|
|
|
!=----------------------------------------------------------------------=
|
|
|
|
|
2005-05-18 22:02:51 +08:00
|
|
|
SUBROUTINE sticks_maps_scalar( lgamma, ub, lb, b1, b2, b3, gcutm, gkcut, gcutms, stw, ngm, ngms )
|
2005-01-15 18:53:46 +08:00
|
|
|
|
2010-02-22 16:13:22 +08:00
|
|
|
LOGICAL, INTENT(in) :: lgamma ! if true use gamma point simmetry
|
|
|
|
INTEGER, INTENT(in) :: ub(:) ! upper bounds for i-th grid dimension
|
|
|
|
INTEGER, INTENT(in) :: lb(:) ! lower bounds for i-th grid dimension
|
|
|
|
REAL(DP) , INTENT(in) :: b1(:), b2(:), b3(:) ! reciprocal space base vectors
|
|
|
|
REAL(DP) , INTENT(in) :: gcutm ! cut-off for potentials
|
|
|
|
REAL(DP) , INTENT(in) :: gkcut ! cut-off for plane waves
|
|
|
|
REAL(DP) , INTENT(in) :: gcutms ! cut-off for smooth mesh
|
2005-01-15 18:53:46 +08:00
|
|
|
!
|
2010-02-22 16:13:22 +08:00
|
|
|
INTEGER, INTENT(out) :: ngm, ngms
|
2005-01-15 18:53:46 +08:00
|
|
|
!
|
|
|
|
! stick map for wave functions, note that map is taken in YZ plane
|
|
|
|
!
|
2010-02-22 16:13:22 +08:00
|
|
|
INTEGER, INTENT(out) :: stw( lb(2) : ub(2), lb(3) : ub(3) )
|
2005-01-15 18:53:46 +08:00
|
|
|
|
|
|
|
INTEGER :: i1, i2, i3, n1, n2, n3
|
2005-08-28 22:09:42 +08:00
|
|
|
REAL(DP) :: amod
|
2005-01-15 18:53:46 +08:00
|
|
|
|
|
|
|
ngm = 0
|
|
|
|
ngms = 0
|
2010-04-14 21:45:43 +08:00
|
|
|
stw = 0
|
2005-01-15 18:53:46 +08:00
|
|
|
|
2010-02-22 16:13:22 +08:00
|
|
|
n1 = max( abs( lb(1) ), abs( ub(1) ) )
|
|
|
|
n2 = max( abs( lb(2) ), abs( ub(2) ) )
|
|
|
|
n3 = max( abs( lb(3) ), abs( ub(3) ) )
|
2005-01-15 18:53:46 +08:00
|
|
|
|
2010-02-22 16:13:22 +08:00
|
|
|
loop1: DO i1 = - n1, n1
|
2005-01-15 18:53:46 +08:00
|
|
|
!
|
|
|
|
! Gamma-only: exclude space with x<0
|
|
|
|
!
|
2010-02-22 16:13:22 +08:00
|
|
|
IF (lgamma .and. i1 < 0) CYCLE loop1
|
2005-01-15 18:53:46 +08:00
|
|
|
!
|
2010-02-22 16:13:22 +08:00
|
|
|
loop2: DO i2 = - n2, n2
|
2005-01-15 18:53:46 +08:00
|
|
|
!
|
|
|
|
! Gamma-only: exclude plane with x=0, y<0
|
|
|
|
!
|
2010-02-22 16:13:22 +08:00
|
|
|
IF(lgamma .and. i1 == 0.and. i2 < 0) CYCLE loop2
|
2005-01-15 18:53:46 +08:00
|
|
|
!
|
2010-02-22 16:13:22 +08:00
|
|
|
loop3: DO i3 = - n3, n3
|
2005-01-15 18:53:46 +08:00
|
|
|
!
|
|
|
|
! Gamma-only: exclude line with x=0, y=0, z<0
|
|
|
|
!
|
2010-02-22 16:13:22 +08:00
|
|
|
IF(lgamma .and. i1 == 0 .and. i2 == 0 .and. i3 < 0) CYCLE loop3
|
2005-01-15 18:53:46 +08:00
|
|
|
!
|
|
|
|
amod = (i1 * b1 (1) + i2 * b2 (1) + i3 * b3 (1) ) **2 + &
|
|
|
|
(i1 * b1 (2) + i2 * b2 (2) + i3 * b3 (2) ) **2 + &
|
|
|
|
(i1 * b1 (3) + i2 * b2 (3) + i3 * b3 (3) ) **2
|
2010-02-22 16:13:22 +08:00
|
|
|
IF (amod <= gcutm) ngm = ngm + 1
|
|
|
|
IF (amod <= gcutms) ngms = ngms + 1
|
|
|
|
IF (amod <= gkcut ) THEN
|
2005-01-15 18:53:46 +08:00
|
|
|
stw( i2, i3 ) = 1
|
2010-02-22 16:13:22 +08:00
|
|
|
IF (lgamma) stw( -i2, -i3 ) = 1
|
|
|
|
ENDIF
|
|
|
|
ENDDO loop3
|
|
|
|
ENDDO loop2
|
|
|
|
ENDDO loop1
|
2005-01-15 18:53:46 +08:00
|
|
|
|
|
|
|
RETURN
|
2005-05-18 22:02:51 +08:00
|
|
|
END SUBROUTINE sticks_maps_scalar
|
2005-01-15 18:53:46 +08:00
|
|
|
|
|
|
|
|
2003-03-17 07:02:31 +08:00
|
|
|
!=----------------------------------------------------------------------=
|
|
|
|
|
2011-01-20 06:13:34 +08:00
|
|
|
SUBROUTINE sticks_sort( ngc, ngcw, ngcs, nct, idx, nproc )
|
2003-03-31 16:42:59 +08:00
|
|
|
|
2010-02-22 16:13:22 +08:00
|
|
|
! ... This subroutine sorts the sticks indexes, according to
|
2009-08-04 22:34:32 +08:00
|
|
|
! ... the length and type of the sticks, wave functions sticks
|
2003-03-31 16:42:59 +08:00
|
|
|
! ... first, then smooth mesh sticks, and finally potential
|
|
|
|
! ... sticks
|
|
|
|
|
2009-08-04 22:34:32 +08:00
|
|
|
! lengths of sticks, ngc for potential mesh, ngcw for wave functions mesh
|
2003-03-31 16:42:59 +08:00
|
|
|
! and ngcs for smooth mesh
|
|
|
|
|
2010-02-22 16:13:22 +08:00
|
|
|
INTEGER, INTENT(in) :: ngc(:), ngcw(:), ngcs(:)
|
2011-01-20 06:13:34 +08:00
|
|
|
INTEGER, INTENT(in) :: nproc ! number of proc in the g-vec group
|
2003-03-31 16:42:59 +08:00
|
|
|
|
|
|
|
! nct, total number of sticks
|
|
|
|
|
2010-02-22 16:13:22 +08:00
|
|
|
INTEGER, INTENT(in) :: nct
|
2003-03-31 16:42:59 +08:00
|
|
|
|
|
|
|
! index, on output, new sticks indexes
|
|
|
|
|
2010-02-22 16:13:22 +08:00
|
|
|
INTEGER, INTENT(out) :: idx(:)
|
2003-03-17 07:02:31 +08:00
|
|
|
|
2007-09-04 20:58:11 +08:00
|
|
|
INTEGER :: mc, nr3x, ic
|
2009-02-17 22:51:24 +08:00
|
|
|
REAL(DP) :: dn3
|
2005-08-28 22:09:42 +08:00
|
|
|
REAL(DP), ALLOCATABLE :: aux(:)
|
2003-03-17 07:02:31 +08:00
|
|
|
|
2010-02-22 16:13:22 +08:00
|
|
|
nr3x = maxval( ngc(1:nct) ) + 1
|
2009-02-17 22:51:24 +08:00
|
|
|
dn3 = REAL( nr3x )
|
2003-04-28 15:23:04 +08:00
|
|
|
|
2011-01-20 06:13:34 +08:00
|
|
|
IF( nproc > 1 ) THEN
|
2003-04-28 15:23:04 +08:00
|
|
|
ALLOCATE( aux( nct ) )
|
|
|
|
DO mc = 1, nct
|
2007-09-04 20:58:11 +08:00
|
|
|
aux(mc) = ngcw(mc)
|
|
|
|
aux(mc) = dn3 * aux(mc) + ngcs(mc)
|
|
|
|
aux(mc) = dn3 * aux(mc) + ngc(mc)
|
|
|
|
aux(mc) = -aux(mc)
|
2006-11-27 23:06:51 +08:00
|
|
|
idx(mc) = 0
|
2010-02-22 16:13:22 +08:00
|
|
|
ENDDO
|
2006-11-27 23:06:51 +08:00
|
|
|
CALL hpsort( nct, aux(1), idx(1))
|
2003-04-28 15:23:04 +08:00
|
|
|
DEALLOCATE( aux )
|
|
|
|
ELSE
|
|
|
|
ic = 0
|
2010-02-22 16:13:22 +08:00
|
|
|
DO mc = 1, nct
|
|
|
|
IF( ngcw(mc) > 0 ) THEN
|
2003-04-28 15:23:04 +08:00
|
|
|
ic = ic + 1
|
2006-11-27 23:06:51 +08:00
|
|
|
idx(ic) = mc
|
2010-02-22 16:13:22 +08:00
|
|
|
ENDIF
|
|
|
|
ENDDO
|
|
|
|
DO mc = 1, nct
|
|
|
|
IF( ngcs(mc) > 0 .and. ngcw(mc) == 0 ) THEN
|
2003-04-28 15:23:04 +08:00
|
|
|
ic = ic + 1
|
2006-11-27 23:06:51 +08:00
|
|
|
idx(ic) = mc
|
2010-02-22 16:13:22 +08:00
|
|
|
ENDIF
|
|
|
|
ENDDO
|
|
|
|
DO mc = 1, nct
|
|
|
|
IF( ngc(mc) > 0 .and. ngcs(mc) == 0 .and. ngcw(mc) == 0 ) THEN
|
2003-04-28 15:23:04 +08:00
|
|
|
ic = ic + 1
|
2006-11-27 23:06:51 +08:00
|
|
|
idx(ic) = mc
|
2010-02-22 16:13:22 +08:00
|
|
|
ENDIF
|
|
|
|
ENDDO
|
|
|
|
ENDIF
|
2003-03-17 07:02:31 +08:00
|
|
|
|
2007-09-04 20:58:11 +08:00
|
|
|
#if defined __STICKS_DEBUG
|
|
|
|
WRITE( 6,*) '-----------------'
|
|
|
|
WRITE( 6,*) 'STICKS_SORT DEBUG'
|
|
|
|
DO mc = 1, nct
|
|
|
|
WRITE( 6, fmt="(4I10)" ) idx(mc), ngcw( idx(mc) ), ngcs( idx(mc) ), ngc( idx(mc) )
|
2010-02-22 16:13:22 +08:00
|
|
|
ENDDO
|
2007-09-04 20:58:11 +08:00
|
|
|
WRITE( 6,*) '-----------------'
|
|
|
|
#endif
|
2003-03-31 16:42:59 +08:00
|
|
|
|
2003-03-17 07:02:31 +08:00
|
|
|
RETURN
|
2005-05-18 22:02:51 +08:00
|
|
|
END SUBROUTINE sticks_sort
|
2003-03-17 07:02:31 +08:00
|
|
|
|
|
|
|
!=----------------------------------------------------------------------=
|
|
|
|
|
2003-03-31 16:42:59 +08:00
|
|
|
SUBROUTINE sticks_countg( tk, ub, lb, st, stw, sts, in1, in2, ngc, ngcw, ngcs )
|
2003-03-17 07:02:31 +08:00
|
|
|
|
2010-02-22 16:13:22 +08:00
|
|
|
INTEGER, INTENT(in) :: ub(:), lb(:)
|
|
|
|
INTEGER, INTENT(in) :: st( lb(1): ub(1), lb(2):ub(2) ) ! stick map for potential
|
|
|
|
INTEGER, INTENT(in) :: stw(lb(1): ub(1), lb(2):ub(2) ) ! stick map for wave functions
|
|
|
|
INTEGER, INTENT(in) :: sts(lb(1): ub(1), lb(2):ub(2) ) ! stick map for smooth mesh
|
|
|
|
LOGICAL, INTENT(in) :: tk
|
2003-03-17 07:02:31 +08:00
|
|
|
|
2010-02-22 16:13:22 +08:00
|
|
|
INTEGER, INTENT(out) :: in1(:), in2(:)
|
|
|
|
INTEGER, INTENT(out) :: ngc(:), ngcw(:), ngcs(:)
|
2003-03-17 07:02:31 +08:00
|
|
|
|
2003-03-31 16:42:59 +08:00
|
|
|
INTEGER :: j1, j2, i1, i2, nct, min_size
|
2003-03-17 07:02:31 +08:00
|
|
|
|
|
|
|
!
|
|
|
|
! ... initialize the sticks indexes array ist
|
|
|
|
! ... nct counts columns containing G-vectors for the dense grid
|
|
|
|
! ... ncts counts columns contaning G-vectors for the smooth grid
|
|
|
|
!
|
|
|
|
nct = 0
|
|
|
|
|
|
|
|
ngc = 0
|
|
|
|
ngcs = 0
|
|
|
|
ngcw = 0
|
|
|
|
|
2010-02-22 16:13:22 +08:00
|
|
|
min_size = min( size( in1 ), size( in2 ), size( ngc ), size( ngcw ), size( ngcs ) )
|
2003-03-17 07:02:31 +08:00
|
|
|
|
2003-03-31 16:42:59 +08:00
|
|
|
DO j2 = 0, ( ub(2) - lb(2) )
|
|
|
|
DO j1 = 0, ( ub(1) - lb(1) )
|
|
|
|
|
|
|
|
i1 = j1
|
2010-02-22 16:13:22 +08:00
|
|
|
IF( i1 > ub(1) ) i1 = lb(1) + ( i1 - ub(1) ) - 1
|
2003-03-31 16:42:59 +08:00
|
|
|
|
|
|
|
i2 = j2
|
2010-02-22 16:13:22 +08:00
|
|
|
IF( i2 > ub(2) ) i2 = lb(2) + ( i2 - ub(2) ) - 1
|
2003-03-17 07:02:31 +08:00
|
|
|
|
2003-03-31 16:42:59 +08:00
|
|
|
IF( st( i1, i2 ) > 0 ) THEN
|
2003-03-17 07:02:31 +08:00
|
|
|
|
2003-03-31 16:42:59 +08:00
|
|
|
! this sticks contains G-vectors
|
2003-03-17 07:02:31 +08:00
|
|
|
|
|
|
|
nct = nct + 1
|
|
|
|
IF( nct > min_size ) &
|
|
|
|
CALL errore(' sticks_countg ',' too many sticks ', nct )
|
|
|
|
|
|
|
|
in1(nct) = i1
|
|
|
|
in2(nct) = i2
|
2003-03-31 16:42:59 +08:00
|
|
|
|
2003-03-17 07:02:31 +08:00
|
|
|
ngc(nct) = st( i1 , i2)
|
2010-02-22 16:13:22 +08:00
|
|
|
IF( stw( i1, i2 ) .gt. 0 ) ngcw(nct) = stw( i1 , i2)
|
|
|
|
IF( sts( i1, i2 ) .gt. 0 ) ngcs(nct) = sts( i1 , i2)
|
2003-03-17 07:02:31 +08:00
|
|
|
|
2010-02-22 16:13:22 +08:00
|
|
|
ENDIF
|
2003-03-17 07:02:31 +08:00
|
|
|
|
|
|
|
! WRITE(7,fmt="(5I5)") i1, i2, nct, ngc(nct), ngcw( nct )
|
|
|
|
|
2010-02-22 16:13:22 +08:00
|
|
|
ENDDO
|
|
|
|
ENDDO
|
2003-03-17 07:02:31 +08:00
|
|
|
|
|
|
|
RETURN
|
2005-05-18 22:02:51 +08:00
|
|
|
END SUBROUTINE sticks_countg
|
2003-03-17 07:02:31 +08:00
|
|
|
|
|
|
|
!=----------------------------------------------------------------------=
|
|
|
|
|
2011-01-06 00:04:54 +08:00
|
|
|
SUBROUTINE sticks_dist( tk, ub, lb, idx, in1, in2, ngc, ngcw, ngcs, nct, &
|
2011-01-20 06:13:34 +08:00
|
|
|
ncp, ncpw, ncps, ngp, ngpw, ngps, stown, stownw, stowns, nproc )
|
2003-03-17 07:02:31 +08:00
|
|
|
|
2010-02-22 16:13:22 +08:00
|
|
|
LOGICAL, INTENT(in) :: tk
|
2003-03-31 16:42:59 +08:00
|
|
|
|
2010-02-22 16:13:22 +08:00
|
|
|
INTEGER, INTENT(in) :: ub(:), lb(:), idx(:)
|
|
|
|
INTEGER, INTENT(out) :: stown( lb(1): ub(1), lb(2):ub(2) ) ! stick map for potential
|
|
|
|
INTEGER, INTENT(out) :: stownw(lb(1): ub(1), lb(2):ub(2) ) ! stick map for wave functions
|
|
|
|
INTEGER, INTENT(out) :: stowns(lb(1): ub(1), lb(2):ub(2) ) ! stick map for smooth mesh
|
2003-03-17 07:02:31 +08:00
|
|
|
|
2010-02-22 16:13:22 +08:00
|
|
|
INTEGER, INTENT(in) :: in1(:), in2(:)
|
|
|
|
INTEGER, INTENT(in) :: ngc(:), ngcw(:), ngcs(:)
|
|
|
|
INTEGER, INTENT(in) :: nct
|
|
|
|
INTEGER, INTENT(out) :: ncp(:), ncpw(:), ncps(:)
|
|
|
|
INTEGER, INTENT(out) :: ngp(:), ngpw(:), ngps(:)
|
2011-01-20 06:13:34 +08:00
|
|
|
INTEGER, INTENT(in) :: nproc ! number of proc in the g-vec group
|
2003-03-17 07:02:31 +08:00
|
|
|
|
|
|
|
INTEGER :: mc, i1, i2, i, j, jj
|
|
|
|
|
|
|
|
ncp = 0
|
|
|
|
ncps = 0
|
|
|
|
ncpw = 0
|
|
|
|
ngp = 0
|
|
|
|
ngps = 0
|
|
|
|
ngpw = 0
|
|
|
|
|
2003-03-31 16:42:59 +08:00
|
|
|
stown = 0
|
|
|
|
stownw = 0
|
|
|
|
stowns = 0
|
|
|
|
|
2003-03-17 07:02:31 +08:00
|
|
|
DO mc = 1, nct
|
|
|
|
|
2006-11-27 23:06:51 +08:00
|
|
|
i = idx( mc )
|
2003-03-17 07:02:31 +08:00
|
|
|
!
|
2003-03-31 16:42:59 +08:00
|
|
|
! index contains the desired ordering of sticks (see above)
|
2003-03-17 07:02:31 +08:00
|
|
|
!
|
2003-03-31 16:42:59 +08:00
|
|
|
i1 = in1( i )
|
|
|
|
i2 = in2( i )
|
2003-03-17 07:02:31 +08:00
|
|
|
!
|
2010-02-22 16:13:22 +08:00
|
|
|
IF ( ( .not. tk ) .and. ( (i1 < 0) .or. ( (i1 == 0) .and. (i2 < 0) ) ) ) GOTO 30
|
2003-03-17 07:02:31 +08:00
|
|
|
!
|
2003-03-31 16:42:59 +08:00
|
|
|
jj = 1
|
|
|
|
|
2010-02-22 16:13:22 +08:00
|
|
|
IF ( ngcw(i) > 0 ) THEN
|
2003-03-17 07:02:31 +08:00
|
|
|
!
|
2003-03-31 16:42:59 +08:00
|
|
|
! this is an active sticks: find which processor has currently
|
2003-03-17 07:02:31 +08:00
|
|
|
! the smallest number of plane waves
|
|
|
|
!
|
2011-01-20 06:13:34 +08:00
|
|
|
DO j = 1, nproc
|
2010-02-22 16:13:22 +08:00
|
|
|
IF ( ngpw(j) < ngpw(jj) ) THEN
|
2003-03-31 16:42:59 +08:00
|
|
|
jj = j
|
2010-02-22 16:13:22 +08:00
|
|
|
ELSEIF ( ( ngpw(j) == ngpw(jj) ) .and. ( ncpw(j) < ncpw(jj) ) ) THEN
|
2003-03-31 16:42:59 +08:00
|
|
|
jj = j
|
2010-02-22 16:13:22 +08:00
|
|
|
ENDIF
|
|
|
|
ENDDO
|
2003-03-31 16:42:59 +08:00
|
|
|
|
2010-02-22 16:13:22 +08:00
|
|
|
ELSE
|
2003-03-17 07:02:31 +08:00
|
|
|
!
|
2003-03-31 16:42:59 +08:00
|
|
|
! this is an inactive sticks: find which processor has currently
|
2003-03-17 07:02:31 +08:00
|
|
|
! the smallest number of G-vectors
|
|
|
|
!
|
2011-01-20 06:13:34 +08:00
|
|
|
DO j = 1, nproc
|
2010-02-22 16:13:22 +08:00
|
|
|
IF ( ngp(j) < ngp(jj) ) jj = j
|
|
|
|
ENDDO
|
2003-03-31 16:42:59 +08:00
|
|
|
|
2010-02-22 16:13:22 +08:00
|
|
|
ENDIF
|
2003-03-17 07:02:31 +08:00
|
|
|
!
|
2003-03-31 16:42:59 +08:00
|
|
|
! potential mesh
|
|
|
|
|
2003-03-17 07:02:31 +08:00
|
|
|
ncp(jj) = ncp(jj) + 1
|
|
|
|
ngp(jj) = ngp(jj) + ngc(i)
|
2003-03-31 16:42:59 +08:00
|
|
|
stown(i1,i2) = jj
|
|
|
|
|
|
|
|
! smooth mesh
|
|
|
|
|
2010-02-22 16:13:22 +08:00
|
|
|
IF ( ngcs(i) > 0 ) THEN
|
2003-03-31 16:42:59 +08:00
|
|
|
ncps(jj) = ncps(jj) + 1
|
|
|
|
ngps(jj) = ngps(jj) + ngcs(i)
|
|
|
|
stowns(i1,i2) = jj
|
2010-02-22 16:13:22 +08:00
|
|
|
ENDIF
|
2003-03-31 16:42:59 +08:00
|
|
|
|
|
|
|
! wave functions mesh
|
|
|
|
|
2010-02-22 16:13:22 +08:00
|
|
|
IF ( ngcw(i) > 0 ) THEN
|
2003-03-31 16:42:59 +08:00
|
|
|
ncpw(jj) = ncpw(jj) + 1
|
|
|
|
ngpw(jj) = ngpw(jj) + ngcw(i)
|
|
|
|
stownw(i1,i2) = jj
|
2010-02-22 16:13:22 +08:00
|
|
|
ENDIF
|
2003-03-17 07:02:31 +08:00
|
|
|
|
2010-02-22 16:13:22 +08:00
|
|
|
30 CONTINUE
|
2003-03-17 07:02:31 +08:00
|
|
|
|
2010-02-22 16:13:22 +08:00
|
|
|
ENDDO
|
2003-03-17 07:02:31 +08:00
|
|
|
|
|
|
|
RETURN
|
2011-01-06 00:04:54 +08:00
|
|
|
END SUBROUTINE sticks_dist
|
2003-03-17 07:02:31 +08:00
|
|
|
|
|
|
|
!=----------------------------------------------------------------------=
|
2010-02-22 16:13:22 +08:00
|
|
|
|
2006-11-27 23:06:51 +08:00
|
|
|
SUBROUTINE sticks_pairup( tk, ub, lb, idx, in1, in2, ngc, ngcw, ngcs, nct, &
|
2011-01-20 06:13:34 +08:00
|
|
|
ncp, ncpw, ncps, ngp, ngpw, ngps, stown, stownw, stowns, nproc )
|
2003-03-17 07:02:31 +08:00
|
|
|
|
2010-02-22 16:13:22 +08:00
|
|
|
LOGICAL, INTENT(in) :: tk
|
2003-03-31 16:42:59 +08:00
|
|
|
|
2010-02-22 16:13:22 +08:00
|
|
|
INTEGER, INTENT(in) :: ub(:), lb(:), idx(:)
|
|
|
|
INTEGER, INTENT(inout) :: stown( lb(1): ub(1), lb(2):ub(2) ) ! stick map for potential
|
|
|
|
INTEGER, INTENT(inout) :: stownw(lb(1): ub(1), lb(2):ub(2) ) ! stick map for wave functions
|
|
|
|
INTEGER, INTENT(inout) :: stowns(lb(1): ub(1), lb(2):ub(2) ) ! stick map for wave functions
|
2003-03-17 07:02:31 +08:00
|
|
|
|
2010-02-22 16:13:22 +08:00
|
|
|
INTEGER, INTENT(in) :: in1(:), in2(:)
|
|
|
|
INTEGER, INTENT(in) :: ngc(:), ngcw(:), ngcs(:)
|
|
|
|
INTEGER, INTENT(in) :: nct
|
|
|
|
INTEGER, INTENT(out) :: ncp(:), ncpw(:), ncps(:)
|
|
|
|
INTEGER, INTENT(out) :: ngp(:), ngpw(:), ngps(:)
|
2011-01-20 06:13:34 +08:00
|
|
|
INTEGER, INTENT(in) :: nproc ! number of proc in the g-vec group
|
2003-03-17 07:02:31 +08:00
|
|
|
|
2006-11-27 23:06:51 +08:00
|
|
|
INTEGER :: mc, i1, i2, i, jj
|
2003-03-17 07:02:31 +08:00
|
|
|
|
2010-02-22 16:13:22 +08:00
|
|
|
IF ( .not. tk ) THEN
|
2003-03-17 07:02:31 +08:00
|
|
|
|
2003-07-21 23:59:32 +08:00
|
|
|
! when gamma symmetry is used only the sticks of half reciprocal space
|
|
|
|
! are generated, then here we pair-up the sticks with those of the other
|
2003-09-20 02:47:23 +08:00
|
|
|
! half of the space, using the gamma symmetry relation
|
2003-07-21 23:59:32 +08:00
|
|
|
! Note that the total numero of stick "nct" is not modified
|
|
|
|
|
2003-03-31 16:42:59 +08:00
|
|
|
DO mc = 1, nct
|
2006-11-27 23:06:51 +08:00
|
|
|
i = idx(mc)
|
2003-03-31 16:42:59 +08:00
|
|
|
i1 = in1(i)
|
|
|
|
i2 = in2(i)
|
2003-04-28 15:23:04 +08:00
|
|
|
IF( i1 == 0 .and. i2 == 0 ) THEN
|
|
|
|
jj = stown( i1, i2 )
|
2010-02-22 16:13:22 +08:00
|
|
|
IF( jj > 0 ) ngp( jj ) = ngp( jj ) + ngc( i ) - 1
|
2003-04-28 15:23:04 +08:00
|
|
|
jj = stowns( i1, i2 )
|
2010-02-22 16:13:22 +08:00
|
|
|
IF( jj > 0 ) ngps( jj ) = ngps( jj ) + ngcs( i ) - 1
|
2003-04-28 15:23:04 +08:00
|
|
|
jj = stownw( i1, i2 )
|
2010-02-22 16:13:22 +08:00
|
|
|
IF( jj > 0 ) ngpw( jj ) = ngpw( jj ) + ngcw( i ) - 1
|
2003-04-28 15:23:04 +08:00
|
|
|
ELSE
|
|
|
|
jj = stown( i1, i2 )
|
2010-02-22 16:13:22 +08:00
|
|
|
IF( jj > 0 ) THEN
|
2003-04-28 15:23:04 +08:00
|
|
|
stown( -i1, -i2 ) = jj
|
|
|
|
ncp( jj ) = ncp( jj ) + 1
|
|
|
|
ngp( jj ) = ngp( jj ) + ngc( i )
|
2010-02-22 16:13:22 +08:00
|
|
|
ENDIF
|
2003-04-28 15:23:04 +08:00
|
|
|
jj = stowns( i1, i2 )
|
2010-02-22 16:13:22 +08:00
|
|
|
IF( jj > 0 ) THEN
|
2003-04-28 15:23:04 +08:00
|
|
|
stowns( -i1, -i2 ) = jj
|
|
|
|
ncps( jj ) = ncps( jj ) + 1
|
|
|
|
ngps( jj ) = ngps( jj ) + ngcs( i )
|
2010-02-22 16:13:22 +08:00
|
|
|
ENDIF
|
2003-04-28 15:23:04 +08:00
|
|
|
jj = stownw( i1, i2 )
|
2010-02-22 16:13:22 +08:00
|
|
|
IF( jj > 0 ) THEN
|
2003-04-28 15:23:04 +08:00
|
|
|
stownw( -i1, -i2 ) = jj
|
|
|
|
ncpw( jj ) = ncpw( jj ) + 1
|
|
|
|
ngpw( jj ) = ngpw( jj ) + ngcw( i )
|
2010-02-22 16:13:22 +08:00
|
|
|
ENDIF
|
|
|
|
ENDIF
|
|
|
|
ENDDO
|
2003-04-28 15:23:04 +08:00
|
|
|
|
2010-02-22 16:13:22 +08:00
|
|
|
ENDIF
|
2003-03-17 07:02:31 +08:00
|
|
|
|
2010-02-22 16:13:22 +08:00
|
|
|
IF( allocated( sticks_owner ) ) DEALLOCATE( sticks_owner )
|
2003-07-11 00:59:11 +08:00
|
|
|
ALLOCATE( sticks_owner( lb(1): ub(1), lb(2):ub(2) ) )
|
|
|
|
|
2010-02-22 16:13:22 +08:00
|
|
|
sticks_owner( :, : ) = abs( stown( :, :) )
|
2003-07-11 00:59:11 +08:00
|
|
|
|
2003-03-17 07:02:31 +08:00
|
|
|
RETURN
|
2005-05-18 22:02:51 +08:00
|
|
|
END SUBROUTINE sticks_pairup
|
2003-03-17 07:02:31 +08:00
|
|
|
|
2004-11-02 00:43:29 +08:00
|
|
|
!=----------------------------------------------------------------------=
|
|
|
|
|
2003-07-11 00:59:11 +08:00
|
|
|
SUBROUTINE sticks_deallocate
|
2010-02-22 16:13:22 +08:00
|
|
|
IF( allocated( sticks_owner ) ) DEALLOCATE( sticks_owner )
|
2003-07-11 00:59:11 +08:00
|
|
|
RETURN
|
2005-05-18 22:02:51 +08:00
|
|
|
END SUBROUTINE sticks_deallocate
|
2010-02-22 16:13:22 +08:00
|
|
|
|
2003-07-11 00:59:11 +08:00
|
|
|
|
2003-03-15 01:01:59 +08:00
|
|
|
!=----------------------------------------------------------------------=
|
|
|
|
END MODULE stick_base
|
|
|
|
!=----------------------------------------------------------------------=
|