mirror of https://gitlab.com/QEF/q-e.git
Some cleanup in ggen, __OLD_GGEN stuff removed,
same code (almost) for PW and Gamma versions version number updated, manual updated Lahey installation git-svn-id: http://qeforge.qe-forge.org/svn/q-e/trunk/espresso@203 c92efa57-630b-4861-b058-cf58834340f0
This commit is contained in:
parent
7ec278895a
commit
5772acd872
|
@ -1,5 +1,5 @@
|
|||
!
|
||||
! Copyright (C) 2001 PWSCF group
|
||||
! Copyright (C) 2001-2003 PWSCF 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,
|
||||
|
@ -16,12 +16,9 @@ program d3toten
|
|||
use d3com
|
||||
use io
|
||||
implicit none
|
||||
#ifdef __PARA
|
||||
include 'mpif.h'
|
||||
#endif
|
||||
character :: cdate * 9, ctime * 9, version * 12
|
||||
integer :: nu_i, nu_i0, irecv
|
||||
real (8) :: t0, t1, get_clock
|
||||
real (kind=DP) :: t0, t1, get_clock
|
||||
|
||||
external date_and_tim
|
||||
! call sigcatch( )
|
||||
|
@ -31,7 +28,7 @@ program d3toten
|
|||
|
||||
call init_clocks (.true.)
|
||||
call start_clock ('D3TOTEN')
|
||||
version = 'D3TOTEN1.2.0'
|
||||
version = 'D3TOTEN1.2.1'
|
||||
call startup (nd_nmbr, version)
|
||||
write (6, '(/5x,"UltraSoft (Vanderbilt) ", &
|
||||
& "Pseudopotentials")')
|
||||
|
@ -52,8 +49,8 @@ program d3toten
|
|||
!
|
||||
if (wraux) call write_aux (1)
|
||||
|
||||
call setv (54 * nat * nat * nat, 0.d0, d3dyn, 1)
|
||||
!cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
|
||||
d3dyn(:,:,:) = (0.d0, 0.d0)
|
||||
!
|
||||
nu_i0 = 1
|
||||
if (recv) then
|
||||
!
|
||||
|
|
257
Gamma/ggen.f90
257
Gamma/ggen.f90
|
@ -1,11 +1,10 @@
|
|||
!
|
||||
! Copyright (C) 2003 PWSCF group
|
||||
! Copyright (C) 2001-2003 PWSCF 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 .
|
||||
!
|
||||
!
|
||||
!-----------------------------------------------------------------------
|
||||
subroutine ggen
|
||||
!----------------------------------------------------------------------
|
||||
|
@ -16,8 +15,12 @@ subroutine ggen
|
|||
! between the fft mesh points and the array of g vectors.
|
||||
!
|
||||
#include "machine.h"
|
||||
use pwcom
|
||||
use gamma
|
||||
use parameters, only: DP
|
||||
use brilz
|
||||
use gvect
|
||||
use gsmooth
|
||||
use wvfct, only : gamma_only
|
||||
use cellmd, only: lmovecell
|
||||
#ifdef __PARA
|
||||
use para
|
||||
#endif
|
||||
|
@ -35,7 +38,8 @@ subroutine ggen
|
|||
real(kind=DP), allocatable :: g2sort_g(:)
|
||||
! array containing all g vectors, on all processors: replicated data
|
||||
integer, allocatable :: mill_g(:,:)
|
||||
! array containing all g vectors generators, on all processors: replicated data
|
||||
! array containing all g vectors generators, on all processors:
|
||||
! replicated data
|
||||
integer, allocatable :: igsrt(:)
|
||||
!
|
||||
#ifdef __PARA
|
||||
|
@ -51,8 +55,6 @@ subroutine ggen
|
|||
! vectors after computing them.
|
||||
!
|
||||
gg(:) = gcutm + 1.d0
|
||||
allocate(esort(ngm) )
|
||||
esort(:) = 1.0d20
|
||||
!
|
||||
! set d vector for unique ordering
|
||||
!
|
||||
|
@ -66,10 +68,10 @@ subroutine ggen
|
|||
!
|
||||
! and computes all the g vectors inside a sphere
|
||||
!
|
||||
allocate( igsrt( ngm_g ) )
|
||||
allocate( g2sort_g( ngm_g ) )
|
||||
g2sort_g(:) = 1.0d20
|
||||
allocate( mill_g( 3, ngm_g ) )
|
||||
allocate( igsrt( ngm_g ) )
|
||||
allocate( ig_l2g( ngm_l ) )
|
||||
!
|
||||
n1 = nr1 + 1
|
||||
|
@ -83,44 +85,44 @@ subroutine ggen
|
|||
ngm = 0
|
||||
ngms = 0
|
||||
do i = - n1, n1
|
||||
!
|
||||
! exclude space with x < 0
|
||||
!
|
||||
if ( gamma_only .and. i < 0) go to 10
|
||||
do j = - n2, n2
|
||||
!
|
||||
! exclude plane with x = 0, y < 0
|
||||
!
|
||||
if ( gamma_only .and. i == 0 .and. j < 0) go to 11
|
||||
do k = - n3, n3
|
||||
!
|
||||
! exclude line with x = 0, y = 0, z < 0
|
||||
!
|
||||
if ( gamma_only .and. i == 0 .and. j == 0 .and. k < 0) go to 12
|
||||
tt = 0.d0
|
||||
do ipol = 1, 3
|
||||
t (ipol) = i * bg (ipol, 1) + j * bg (ipol, 2) + k * bg (ipol, 3)
|
||||
tt = tt + t (ipol) * t (ipol)
|
||||
enddo
|
||||
if (tt <= gcutm) then
|
||||
ngm = ngm + 1
|
||||
if (tt <= gcutms) ngms = ngms + 1
|
||||
if (ngm > ngm_g) call errore ('ggen', 'too many g-vectors', ngm)
|
||||
mill_g( 1, ngm ) = i
|
||||
mill_g( 2, ngm ) = j
|
||||
mill_g( 3, ngm ) = k
|
||||
if ( tt > eps ) then
|
||||
g2sort_g(ngm) = 1.d4 * tt + &
|
||||
(t (1) * d (1) + t (2) * d (2) + t (3) * d (3) ) / sqrt (tt)
|
||||
else
|
||||
g2sort_g(ngm) = 0.d0
|
||||
end if
|
||||
end if
|
||||
12 continue
|
||||
enddo
|
||||
11 continue
|
||||
enddo
|
||||
10 continue
|
||||
!
|
||||
! Gamma-only: exclude space with x < 0
|
||||
!
|
||||
if ( gamma_only .and. i < 0) go to 10
|
||||
do j = - n2, n2
|
||||
!
|
||||
! exclude plane with x = 0, y < 0
|
||||
!
|
||||
if ( gamma_only .and. i == 0 .and. j < 0) go to 11
|
||||
do k = - n3, n3
|
||||
!
|
||||
! exclude line with x = 0, y = 0, z < 0
|
||||
!
|
||||
if ( gamma_only .and. i == 0 .and. j == 0 .and. k < 0) go to 12
|
||||
tt = 0.d0
|
||||
do ipol = 1, 3
|
||||
t (ipol) = i * bg (ipol, 1) + j * bg (ipol, 2) + k * bg (ipol, 3)
|
||||
tt = tt + t (ipol) * t (ipol)
|
||||
enddo
|
||||
if (tt <= gcutm) then
|
||||
ngm = ngm + 1
|
||||
if (tt <= gcutms) ngms = ngms + 1
|
||||
if (ngm > ngm_g) call errore ('ggen', 'too many g-vectors', ngm)
|
||||
mill_g( 1, ngm ) = i
|
||||
mill_g( 2, ngm ) = j
|
||||
mill_g( 3, ngm ) = k
|
||||
if ( tt > eps ) then
|
||||
g2sort_g(ngm) = 1.d4 * tt + &
|
||||
(t(1) * d(1) + t(2) * d(2) + t(3) * d(3) ) / sqrt (tt)
|
||||
else
|
||||
g2sort_g(ngm) = 0.d0
|
||||
endif
|
||||
end if
|
||||
12 continue
|
||||
enddo
|
||||
11 continue
|
||||
enddo
|
||||
10 continue
|
||||
enddo
|
||||
|
||||
if (ngm /= ngm_g ) &
|
||||
|
@ -149,10 +151,12 @@ subroutine ggen
|
|||
END IF
|
||||
END DO
|
||||
|
||||
#ifndef __OLD_GGEN_LOOP
|
||||
deallocate( igsrt )
|
||||
|
||||
! write(6, fmt="(//,' --- Executing new GGEN Loop ---',//)" )
|
||||
|
||||
allocate(esort(ngm) )
|
||||
esort(:) = 1.0d20
|
||||
ngm = 0
|
||||
ngms = 0
|
||||
do ng = 1, ngm_g
|
||||
|
@ -176,7 +180,7 @@ subroutine ggen
|
|||
enddo
|
||||
|
||||
ngm = ngm + 1
|
||||
if (tt.le.gcutms) ngms = ngms + 1
|
||||
if (tt <= gcutms) ngms = ngms + 1
|
||||
if (ngm > ngmx) call errore ('ggen', 'too many g-vectors', ngm)
|
||||
!
|
||||
! Here map local and global g index !!!
|
||||
|
@ -186,7 +190,7 @@ subroutine ggen
|
|||
g (1:3, ngm) = t (1:3)
|
||||
gg (ngm) = tt
|
||||
|
||||
if (tt.gt.eps) then
|
||||
if (tt > eps) then
|
||||
esort (ngm) = 1.d4 * tt + (t (1) * d (1) + t (2) * d (2) &
|
||||
+ t (3) * d (3) ) / sqrt (tt)
|
||||
else
|
||||
|
@ -196,63 +200,6 @@ subroutine ggen
|
|||
1 continue
|
||||
enddo
|
||||
|
||||
deallocate( g2sort_g )
|
||||
deallocate( igsrt )
|
||||
deallocate( mill_g )
|
||||
|
||||
#else
|
||||
!
|
||||
! and computes all the g vectors inside a sphere
|
||||
!
|
||||
n1 = nr1 + 1
|
||||
n2 = nr2 + 1
|
||||
n3 = nr3 + 1
|
||||
ngmx = ngm
|
||||
ngm = 0
|
||||
ngms = 0
|
||||
do i = - n1, n1
|
||||
#ifdef __PARA
|
||||
m1 = mod (i, nr1) + 1
|
||||
if (m1.lt.1) m1 = m1 + nr1
|
||||
do j = - n2, n2
|
||||
m2 = mod (j, nr2) + 1
|
||||
if (m2.lt.1) m2 = m2 + nr2
|
||||
mc = m1 + (m2 - 1) * nrx1
|
||||
if (ipc (mc) .eq.0) goto 1
|
||||
#else
|
||||
do j = - n2, n2
|
||||
#endif
|
||||
do k = - n3, n3
|
||||
tt = 0.d0
|
||||
do ipol = 1, 3
|
||||
t (ipol) = i * bg (ipol, 1) + &
|
||||
j * bg (ipol, 2) + &
|
||||
k * bg (ipol, 3)
|
||||
tt = tt + t (ipol) * t (ipol)
|
||||
enddo
|
||||
if (tt.le.gcutm) then
|
||||
ngm = ngm + 1
|
||||
if (tt.le.gcutms) ngms = ngms + 1
|
||||
if (ngm > ngmx) call errore ('ggen', 'too many g-vectors', ngm)
|
||||
do ipol = 1, 3
|
||||
g (ipol, ngm) = t (ipol)
|
||||
enddo
|
||||
gg (ngm) = tt
|
||||
if (tt.gt.eps) then
|
||||
esort (ngm) = 1.d4 * tt + (t (1) * d (1) + t (2) * d (2) &
|
||||
+ t (3) * d (3) ) / sqrt (tt)
|
||||
else
|
||||
esort (ngm) = 0.d0
|
||||
endif
|
||||
endif
|
||||
enddo
|
||||
1 continue
|
||||
enddo
|
||||
|
||||
enddo
|
||||
|
||||
#endif
|
||||
|
||||
if (ngm.ne.ngmx) &
|
||||
call errore ('ggen', 'g-vectors missing !', abs(ngm - ngmx))
|
||||
!
|
||||
|
@ -263,7 +210,8 @@ subroutine ggen
|
|||
|
||||
nl (1) = 0
|
||||
call hpsort (ngm, esort, nl)
|
||||
deallocate (esort)
|
||||
!
|
||||
deallocate( esort )
|
||||
!
|
||||
! reorder also the g vectors, and nl
|
||||
!
|
||||
|
@ -279,7 +227,6 @@ subroutine ggen
|
|||
gg (indsw) = gg (nl (indsw) )
|
||||
gg (nl (indsw) ) = swap
|
||||
|
||||
#ifndef __OLD_GGEN_LOOP
|
||||
!
|
||||
! Remember: ig_l2g is the index of a given G vectors in the
|
||||
! sorted global array containing all G vectors, it is used to
|
||||
|
@ -288,7 +235,6 @@ subroutine ggen
|
|||
iswap = ig_l2g( indsw )
|
||||
ig_l2g( indsw ) = ig_l2g( nl(indsw) )
|
||||
ig_l2g( nl(indsw) ) = iswap
|
||||
#endif
|
||||
|
||||
iswap = nl (ng)
|
||||
nl (ng) = nl (indsw)
|
||||
|
@ -342,35 +288,6 @@ subroutine ggen
|
|||
call errore('ggen','Mesh too small?',ng)
|
||||
endif
|
||||
enddo
|
||||
if (gamma_only) then
|
||||
do ng = 1, ngm
|
||||
n1 = -ig1 (ng) + 1
|
||||
n1s = n1
|
||||
if (n1 < 1) n1 = n1 + nr1
|
||||
if (n1s < 1) n1s = n1s + nr1s
|
||||
n2 = -ig2 (ng) + 1
|
||||
n2s = n2
|
||||
if (n2 < 1) n2 = n2 + nr2
|
||||
if (n2s < 1) n2s = n2s + nr2s
|
||||
n3 = -ig3 (ng) + 1
|
||||
n3s = n3
|
||||
if (n3 < 1) n3 = n3 + nr3
|
||||
if (n3s < 1) n3s = n3s + nr3s
|
||||
if (n1.le.nr1.and.n2.le.nr2.and.n3.le.nr3) then
|
||||
#ifdef __PARA
|
||||
nlm(ng) = n3 + (ipc (n1 + (n2 - 1) * nrx1) - 1) * nrx3
|
||||
if (ng.le.ngms) nlsm(ng) = n3s + (ipcs (n1s + (n2s - 1) &
|
||||
* nrx1s) - 1) * nrx3s
|
||||
#else
|
||||
nlm(ng) = n1 + (n2 - 1) * nrx1 + (n3 - 1) * nrx1 * nrx2
|
||||
if (ng.le.ngms) nlsm(ng) = n1s + (n2s - 1) * nrx1s + (n3s - 1) &
|
||||
* nrx1s * nr2s
|
||||
#endif
|
||||
else
|
||||
call errore('ggen','Mesh too small?',ng)
|
||||
endif
|
||||
enddo
|
||||
end if
|
||||
!
|
||||
! calculate number of G shells: ngl
|
||||
!
|
||||
|
@ -392,7 +309,7 @@ subroutine ggen
|
|||
ngl = 1
|
||||
igtongl (1) = 1
|
||||
do ng = 2, ngm
|
||||
if (gg (ng) .gt.gg (ng - 1) + eps) then
|
||||
if (gg (ng) > gg (ng - 1) + eps) then
|
||||
ngl = ngl + 1
|
||||
endif
|
||||
igtongl (ng) = ngl
|
||||
|
@ -403,7 +320,7 @@ subroutine ggen
|
|||
gl (1) = gg (1)
|
||||
igl = 1
|
||||
do ng = 2, ngm
|
||||
if (gg (ng) .gt.gg (ng - 1) + eps) then
|
||||
if (gg (ng) > gg (ng - 1) + eps) then
|
||||
igl = igl + 1
|
||||
gl (igl) = gg (ng)
|
||||
endif
|
||||
|
@ -413,6 +330,66 @@ subroutine ggen
|
|||
if (igl.ne.ngl) call errore ('setup', 'igl <> ngl', ngl)
|
||||
|
||||
endif
|
||||
|
||||
|
||||
deallocate( g2sort_g )
|
||||
deallocate( mill_g )
|
||||
|
||||
call index_minusg
|
||||
|
||||
return
|
||||
end subroutine ggen
|
||||
|
||||
!
|
||||
!-----------------------------------------------------------------------
|
||||
subroutine index_minusg
|
||||
!----------------------------------------------------------------------
|
||||
!
|
||||
! compute indices nlm and nlms giving the correspondence
|
||||
! between the fft mesh points and -G (for gamma-only calculations)
|
||||
!
|
||||
#include "machine.h"
|
||||
use gvect
|
||||
use gsmooth
|
||||
use gamma
|
||||
use wvfct, only : gamma_only
|
||||
#ifdef __PARA
|
||||
use para, only: ipc, ipcs
|
||||
#endif
|
||||
implicit none
|
||||
!
|
||||
integer :: n1, n2, n3, n1s, n2s, n3s, ng
|
||||
!
|
||||
!
|
||||
if (gamma_only) then
|
||||
do ng = 1, ngm
|
||||
n1 = -ig1 (ng) + 1
|
||||
n1s = n1
|
||||
if (n1 < 1) n1 = n1 + nr1
|
||||
if (n1s < 1) n1s = n1s + nr1s
|
||||
n2 = -ig2 (ng) + 1
|
||||
n2s = n2
|
||||
if (n2 < 1) n2 = n2 + nr2
|
||||
if (n2s < 1) n2s = n2s + nr2s
|
||||
n3 = -ig3 (ng) + 1
|
||||
n3s = n3
|
||||
if (n3 < 1) n3 = n3 + nr3
|
||||
if (n3s < 1) n3s = n3s + nr3s
|
||||
if (n1.le.nr1 .and. n2.le.nr2 .and. n3.le.nr3) then
|
||||
#ifdef __PARA
|
||||
nlm(ng) = n3 + (ipc (n1 + (n2 - 1) * nrx1) - 1) * nrx3
|
||||
if (ng.le.ngms) nlsm(ng) = n3s + (ipcs (n1s + (n2s - 1) &
|
||||
* nrx1s) - 1) * nrx3s
|
||||
#else
|
||||
nlm(ng) = n1 + (n2 - 1) * nrx1 + (n3 - 1) * nrx1 * nrx2
|
||||
if (ng.le.ngms) nlsm(ng) = n1s + (n2s - 1) * nrx1s + (n3s - 1) &
|
||||
* nrx1s * nr2s
|
||||
#endif
|
||||
else
|
||||
call errore('index_minusg','Mesh too small?',ng)
|
||||
endif
|
||||
enddo
|
||||
end if
|
||||
return
|
||||
end subroutine index_minusg
|
||||
|
||||
|
|
|
@ -33,7 +33,7 @@ program phonon
|
|||
|
||||
call init_clocks (.true.)
|
||||
call start_clock ('PHONON')
|
||||
version = 'PHONON 1.2.0'
|
||||
version = 'PHONON 1.2.1'
|
||||
call startup (nd_nmbr, version)
|
||||
write (6, '(/5x,"Ultrasoft (Vanderbilt) Pseudopotentials")')
|
||||
!
|
||||
|
|
|
@ -25,7 +25,7 @@ subroutine start_postproc (nodenumber)
|
|||
|
||||
|
||||
character :: filin * 80, nodenumber * 3, version * 12
|
||||
version = 'POSTPROC-120'
|
||||
version = 'POSTPROC-121'
|
||||
filin = ' '
|
||||
nodenumber = ' '
|
||||
!
|
||||
|
|
|
@ -20,17 +20,9 @@ subroutine allocate_locpot
|
|||
allocate (vloc( ngl, ntyp))
|
||||
allocate (strf( ngm, ntyp))
|
||||
|
||||
allocate (eigts1( (2 * nr1 + 1), nat))
|
||||
deallocate(eigts1)
|
||||
allocate( eigts1(-nr1:nr1,nat) )
|
||||
allocate (eigts2( (2 * nr2 + 1), nat))
|
||||
deallocate(eigts2)
|
||||
allocate( eigts2(-nr2:nr2,nat) )
|
||||
allocate (eigts3( (2 * nr3 + 1), nat))
|
||||
deallocate(eigts3)
|
||||
allocate( eigts3(-nr3:nr3,nat) )
|
||||
! The above workaround is needed in order to cast the shape of eigts*
|
||||
! (from (2*n+1,nat) --> (-n:n,nat))
|
||||
|
||||
return
|
||||
end subroutine allocate_locpot
|
||||
|
|
159
PW/ggen.f90
159
PW/ggen.f90
|
@ -1,5 +1,5 @@
|
|||
!
|
||||
! Copyright (C) 2001 PWSCF group
|
||||
! Copyright (C) 2001-2003 PWSCF 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,
|
||||
|
@ -16,7 +16,12 @@ subroutine ggen
|
|||
! between the fft mesh points and the array of g vectors.
|
||||
!
|
||||
#include "machine.h"
|
||||
use pwcom
|
||||
use parameters, only: DP
|
||||
use brilz
|
||||
use gvect
|
||||
use gsmooth
|
||||
use wvfct, only : gamma_only
|
||||
use cellmd, only: lmovecell
|
||||
#ifdef __PARA
|
||||
use para
|
||||
#endif
|
||||
|
@ -34,7 +39,8 @@ subroutine ggen
|
|||
real(kind=DP), allocatable :: g2sort_g(:)
|
||||
! array containing all g vectors, on all processors: replicated data
|
||||
integer, allocatable :: mill_g(:,:)
|
||||
! array containing all g vectors generators, on all processors: replicated data
|
||||
! array containing all g vectors generators, on all processors:
|
||||
! replicated data
|
||||
integer, allocatable :: igsrt(:)
|
||||
!
|
||||
#ifdef __PARA
|
||||
|
@ -50,8 +56,6 @@ subroutine ggen
|
|||
! vectors after computing them.
|
||||
!
|
||||
gg(:) = gcutm + 1.d0
|
||||
allocate(esort(ngm) )
|
||||
esort(:) = 1.0d20
|
||||
!
|
||||
! set d vector for unique ordering
|
||||
!
|
||||
|
@ -82,33 +86,50 @@ subroutine ggen
|
|||
ngm = 0
|
||||
ngms = 0
|
||||
do i = - n1, n1
|
||||
do j = - n2, n2
|
||||
do k = - n3, n3
|
||||
tt = 0.d0
|
||||
do ipol = 1, 3
|
||||
t (ipol) = i * bg (ipol, 1) + j * bg (ipol, 2) + k * bg (ipol, 3)
|
||||
tt = tt + t (ipol) * t (ipol)
|
||||
!
|
||||
! Gamma-only: exclude space with x < 0
|
||||
!
|
||||
if ( gamma_only .and. i < 0) go to 10
|
||||
do j = - n2, n2
|
||||
!
|
||||
! exclude plane with x = 0, y < 0
|
||||
!
|
||||
if ( gamma_only .and. i == 0 .and. j < 0) go to 11
|
||||
do k = - n3, n3
|
||||
!
|
||||
! exclude line with x = 0, y = 0, z < 0
|
||||
!
|
||||
if ( gamma_only .and. i == 0 .and. j == 0 .and. k < 0) go to 12
|
||||
tt = 0.d0
|
||||
do ipol = 1, 3
|
||||
t (ipol) = i * bg (ipol, 1) + j * bg (ipol, 2) + k * bg (ipol, 3)
|
||||
tt = tt + t (ipol) * t (ipol)
|
||||
enddo
|
||||
if (tt <= gcutm) then
|
||||
ngm = ngm + 1
|
||||
if (tt <= gcutms) ngms = ngms + 1
|
||||
if (ngm > ngm_g) call errore ('ggen', 'too many g-vectors', ngm)
|
||||
mill_g( 1, ngm ) = i
|
||||
mill_g( 2, ngm ) = j
|
||||
mill_g( 3, ngm ) = k
|
||||
if ( tt > eps ) then
|
||||
g2sort_g(ngm) = 1.d4 * tt + &
|
||||
(t(1) * d(1) + t(2) * d(2) + t(3) * d(3) ) / sqrt (tt)
|
||||
else
|
||||
g2sort_g(ngm) = 0.d0
|
||||
endif
|
||||
end if
|
||||
12 continue
|
||||
enddo
|
||||
if (tt <= gcutm) then
|
||||
ngm = ngm + 1
|
||||
if (tt <= gcutms) ngms = ngms + 1
|
||||
if (ngm > ngm_g) call errore ('ggen', 'too many g-vectors', ngm)
|
||||
mill_g( 1, ngm ) = i
|
||||
mill_g( 2, ngm ) = j
|
||||
mill_g( 3, ngm ) = k
|
||||
if ( tt > eps ) then
|
||||
g2sort_g(ngm) = 1.d4 * tt + &
|
||||
(t (1) * d (1) + t (2) * d (2) + t (3) * d (3) ) / sqrt (tt)
|
||||
else
|
||||
g2sort_g(ngm) = 0.d0
|
||||
endif
|
||||
end if
|
||||
enddo
|
||||
enddo
|
||||
11 continue
|
||||
enddo
|
||||
10 continue
|
||||
enddo
|
||||
|
||||
if (ngm /= ngm_g ) call errore ('ggen', 'g-vectors missing !', abs(ngm - ngm_g))
|
||||
if (ngms /= ngms_g) call errore ('ggen', 'smooth g-vectors missing !', abs(ngms - ngms_g))
|
||||
if (ngm /= ngm_g ) &
|
||||
call errore ('ggen', 'g-vectors missing !', abs(ngm - ngm_g))
|
||||
if (ngms /= ngms_g) &
|
||||
call errore ('ggen', 'smooth g-vectors missing !', abs(ngms - ngms_g))
|
||||
|
||||
igsrt(1) = 0
|
||||
call hpsort(ngm_g, g2sort_g, igsrt)
|
||||
|
@ -131,10 +152,12 @@ subroutine ggen
|
|||
END IF
|
||||
END DO
|
||||
|
||||
#ifndef __OLD_GGEN_LOOP
|
||||
deallocate( igsrt )
|
||||
|
||||
! write(6, fmt="(//,' --- Executing new GGEN Loop ---',//)" )
|
||||
|
||||
allocate(esort(ngm) )
|
||||
esort(:) = 1.0d20
|
||||
ngm = 0
|
||||
ngms = 0
|
||||
do ng = 1, ngm_g
|
||||
|
@ -158,7 +181,7 @@ subroutine ggen
|
|||
enddo
|
||||
|
||||
ngm = ngm + 1
|
||||
if (tt.le.gcutms) ngms = ngms + 1
|
||||
if (tt <= gcutms) ngms = ngms + 1
|
||||
if (ngm > ngmx) call errore ('ggen', 'too many g-vectors', ngm)
|
||||
!
|
||||
! Here map local and global g index !!!
|
||||
|
@ -168,7 +191,7 @@ subroutine ggen
|
|||
g (1:3, ngm) = t (1:3)
|
||||
gg (ngm) = tt
|
||||
|
||||
if (tt.gt.eps) then
|
||||
if (tt > eps) then
|
||||
esort (ngm) = 1.d4 * tt + (t (1) * d (1) + t (2) * d (2) &
|
||||
+ t (3) * d (3) ) / sqrt (tt)
|
||||
else
|
||||
|
@ -178,66 +201,8 @@ subroutine ggen
|
|||
1 continue
|
||||
enddo
|
||||
|
||||
! ... Uncomment to make tests and comparisons with other codes
|
||||
! DO ng=1,ngm_g
|
||||
! WRITE( 202, fmt="( I6, 3I4, 2D25.16 )" ) &
|
||||
! ng, mill_g(1,ng), mill_g(2,ng), mill_g(3,ng), gg( ng ), g2sort_g( ng )
|
||||
! END DO
|
||||
! CLOSE( 202 )
|
||||
|
||||
#else
|
||||
!
|
||||
! and computes all the g vectors inside a sphere
|
||||
!
|
||||
n1 = nr1 + 1
|
||||
n2 = nr2 + 1
|
||||
n3 = nr3 + 1
|
||||
ngmx = ngm
|
||||
ngm = 0
|
||||
ngms = 0
|
||||
|
||||
do i = - n1, n1
|
||||
#ifdef __PARA
|
||||
m1 = mod (i, nr1) + 1
|
||||
if (m1.lt.1) m1 = m1 + nr1
|
||||
do j = - n2, n2
|
||||
m2 = mod (j, nr2) + 1
|
||||
if (m2.lt.1) m2 = m2 + nr2
|
||||
mc = m1 + (m2 - 1) * nrx1
|
||||
if (ipc (mc) .eq.0) goto 1
|
||||
#else
|
||||
do j = - n2, n2
|
||||
#endif
|
||||
do k = - n3, n3
|
||||
tt = 0.d0
|
||||
do ipol = 1, 3
|
||||
t (ipol) = i * bg (ipol, 1) + j * bg (ipol, 2) + k * bg (ipol, 3)
|
||||
tt = tt + t (ipol) * t (ipol)
|
||||
enddo
|
||||
if (tt.le.gcutm) then
|
||||
ngm = ngm + 1
|
||||
if (tt.le.gcutms) ngms = ngms + 1
|
||||
if (ngm.gt.ngmx) call errore ('ggen', 'too many g-vectors', ngm)
|
||||
do ipol = 1, 3
|
||||
g (ipol, ngm) = t (ipol)
|
||||
enddo
|
||||
gg (ngm) = tt
|
||||
if (tt.gt.eps) then
|
||||
esort (ngm) = 1.d4 * tt + (t (1) * d (1) + t (2) * d (2) &
|
||||
+ t (3) * d (3) ) / sqrt (tt)
|
||||
else
|
||||
esort (ngm) = 0.d0
|
||||
endif
|
||||
endif
|
||||
enddo
|
||||
1 continue
|
||||
enddo
|
||||
|
||||
enddo
|
||||
|
||||
#endif
|
||||
|
||||
if (ngm.ne.ngmx) call errore ('ggen', 'g-vectors missing !', abs(ngm - ngmx))
|
||||
if (ngm.ne.ngmx) &
|
||||
call errore ('ggen', 'g-vectors missing !', abs(ngm - ngmx))
|
||||
!
|
||||
! reorder the g's in order of increasing magnitude. On exit
|
||||
! from hpsort esort is ordered, and nl contains the new order.
|
||||
|
@ -247,6 +212,8 @@ subroutine ggen
|
|||
nl (1) = 0
|
||||
call hpsort (ngm, esort, nl)
|
||||
!
|
||||
deallocate( esort )
|
||||
!
|
||||
! reorder also the g vectors, and nl
|
||||
!
|
||||
do ng = 1, ngm - 1
|
||||
|
@ -261,7 +228,6 @@ subroutine ggen
|
|||
gg (indsw) = gg (nl (indsw) )
|
||||
gg (nl (indsw) ) = swap
|
||||
|
||||
#ifndef __OLD_GGEN_LOOP
|
||||
!
|
||||
! Remember: ig_l2g is the index of a given G vectors in the
|
||||
! sorted global array containing all G vectors, it is used to
|
||||
|
@ -270,7 +236,6 @@ subroutine ggen
|
|||
iswap = ig_l2g( indsw )
|
||||
ig_l2g( indsw ) = ig_l2g( nl(indsw) )
|
||||
ig_l2g( nl(indsw) ) = iswap
|
||||
#endif
|
||||
|
||||
iswap = nl (ng)
|
||||
nl (ng) = nl (indsw)
|
||||
|
@ -345,7 +310,7 @@ subroutine ggen
|
|||
ngl = 1
|
||||
igtongl (1) = 1
|
||||
do ng = 2, ngm
|
||||
if (gg (ng) .gt.gg (ng - 1) + eps) then
|
||||
if (gg (ng) > gg (ng - 1) + eps) then
|
||||
ngl = ngl + 1
|
||||
endif
|
||||
igtongl (ng) = ngl
|
||||
|
@ -356,7 +321,7 @@ subroutine ggen
|
|||
gl (1) = gg (1)
|
||||
igl = 1
|
||||
do ng = 2, ngm
|
||||
if (gg (ng) .gt.gg (ng - 1) + eps) then
|
||||
if (gg (ng) > gg (ng - 1) + eps) then
|
||||
igl = igl + 1
|
||||
gl (igl) = gg (ng)
|
||||
endif
|
||||
|
@ -368,10 +333,8 @@ subroutine ggen
|
|||
endif
|
||||
|
||||
|
||||
deallocate( esort )
|
||||
deallocate( g2sort_g )
|
||||
deallocate( mill_g )
|
||||
deallocate( igsrt )
|
||||
|
||||
return
|
||||
end subroutine ggen
|
||||
|
|
2
TODO
2
TODO
|
@ -63,8 +63,6 @@ PW
|
|||
|
||||
- output should be more informative and less confused
|
||||
|
||||
- merge "scalar pencils" with "sticks"
|
||||
|
||||
POSTPROCESSING
|
||||
|
||||
- bands.x must either be finished or removed
|
||||
|
|
|
@ -47,7 +47,7 @@
|
|||
|
||||
#endif
|
||||
|
||||
#if defined __SGI | defined __FUJITSU | defined __SX4 | defined __INTEL
|
||||
#if defined __SGI | defined __FUJITSU | defined __SX4 | defined __INTEL | defined __LAHEY
|
||||
|
||||
# define FFTW_INPLACE_DRV_1D fftw_inplace_drv_1d_
|
||||
# define FFTW_INPLACE_DRV_2D fftw_inplace_drv_2d_
|
||||
|
|
|
@ -17,7 +17,7 @@ CPP = /usr/local/lf9560/lib/cpp
|
|||
FFTW_INC_DIR=/usr/local/src/fftw-2.1.3/fftw
|
||||
FFTW_LIB_DIR=/usr/local/src/fftw-2.1.3/fftw/.libs
|
||||
#
|
||||
CPPFLAGS = -P -traditional -I$(OSHOME)/include -D__LINUX -DLAHEY -D__FFTW \
|
||||
CPPFLAGS = -P -traditional -I$(OSHOME)/include -D__LINUX -D__LAHEY -D__FFTW \
|
||||
-D"FFTWND_F77_ONE=fftwnd_f77_one_" \
|
||||
-D"FFTW3D_F77_CREATE_PLAN=fftw3d_f77_create_plan_" \
|
||||
-D"FFTW_F77=fftw_f77_" \
|
||||
|
@ -30,7 +30,7 @@ F90 = lf95
|
|||
F90FLAGS = --staticlink --dbl -O -I$(OSHOME)
|
||||
F77 = lf95
|
||||
|
||||
CCFLAGS = -O -I$(FFTW_INC_DIR)
|
||||
CCFLAGS = -O -$(CPPFLAGS)
|
||||
#
|
||||
# This is needed to tell the compiler where modules are
|
||||
#
|
||||
|
|
Loading…
Reference in New Issue