scnc
/
quantum-espresso
mirror of https://gitlab.com/QEF/q-e.git
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

Miller indices for k+G stored in the (collected) wavefunction file, so that 

one has the (almost) full information on wavefunctions in a single file.
'gkvect.dat' files deleted from new format. 
NOTE: the new format is incompatible with both the old one and with previous
versions of the new one, and this is not yet the final version.


git-svn-id: http://qeforge.qe-forge.org/svn/q-e/trunk/espresso@13520 c92efa57-630b-4861-b058-cf58834340f0
This commit is contained in:
giannozz 2017-05-18 19:23:33 +00:00
parent 58c119c128
commit d53d404221
4 changed files with 257 additions and 114 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

19
CPV/src/cp_restart_new.f90
View File

@ -406,14 +406,14 @@ MODULE cp_restart_new
nb = nupdwn(iss)
! wavefunctions at time t
filename = TRIM(dirname) // 'wfc' // TRIM(int_to_char(ik_eff))
CALL write_wfc( iunpun, ik_eff, nk, iss, nspin, &
CALL write_wfc( iunpun, filename, ik_eff, nk, iss, nspin, &
c02(:,ib:ib+nb-1), ngw_g, gamma_only, nb, ig_l2g, ngw, &
filename, scalef, ionode, root_pool, intra_pool_comm )
mill, scalef, ionode, root_pool, intra_pool_comm )
! wavefunctions at time t-dt
filename = TRIM(dirname) // 'wfcm' // TRIM(int_to_char(ik_eff))
CALL write_wfc( iunpun, ik_eff, nk, iss, nspin, &
CALL write_wfc( iunpun, filename, ik_eff, nk, iss, nspin, &
cm2(:,ib:ib+nb-1), ngw_g, gamma_only, nb, ig_l2g, ngw, &
filename, scalef, ionode, root_pool, intra_pool_comm )
mill, scalef, ionode, root_pool, intra_pool_comm )
! matrix of orthogonality constrains lambda at time t
filename = TRIM(dirname) // 'lambda' // TRIM(int_to_char(ik_eff))
CALL cp_write_lambda( filename, iunpun, iss, nspin, nudx, &
@ -1363,6 +1363,7 @@ MODULE cp_restart_new
INTEGER, OPTIONAL, INTENT(OUT) :: ierr
!
INTEGER :: ib, nb, nbnd, is_, ns_
INTEGER,ALLOCATABLE:: mill_k(:,:)
CHARACTER(LEN=320) :: filename
REAL(DP) :: scalef
!
@ -1378,15 +1379,17 @@ MODULE cp_restart_new
! next two lines workaround for bogus complaint due to intent(in)
is_= iss
ns_= nspin
ALLOCATE ( mill_k(3,ngw) )
IF ( PRESENT(ierr) ) THEN
CALL read_wfc( iunpun, is_, nk, is_, ns_, &
CALL read_wfc( iunpun, filename, is_, nk, is_, ns_, &
c2(:,ib:ib+nb-1), ngw_g, nbnd, ig_l2g, ngw, &
filename, scalef, ionode, root_pool, intra_pool_comm, ierr )
mill_k, scalef, ionode, root_pool, intra_pool_comm, ierr )
ELSE
CALL read_wfc( iunpun, is_, nk, is_, ns_, &
CALL read_wfc( iunpun, filename, is_, nk, is_, ns_, &
c2(:,ib:ib+nb-1), ngw_g, nbnd, ig_l2g, ngw, &
filename, scalef, ionode, root_pool, intra_pool_comm )
mill_k, scalef, ionode, root_pool, intra_pool_comm )
END IF
DEALLOCATE ( mill_k)
!
END SUBROUTINE cp_read_wfc
!

38
Modules/io_base.f90
View File

@ -22,12 +22,12 @@ MODULE io_base
CONTAINS
!
!------------------------------------------------------------------------
SUBROUTINE write_wfc( iuni, ik, nk, ispin, nspin, wfc, ngw, &
gamma_only, nbnd, igl, ngwl, filename, scalef, &
SUBROUTINE write_wfc( iuni, filename, ik, nk, ispin, nspin, wfc, ngw, &
gamma_only, nbnd, igl, ngwl, mill_k, scalef, &
ionode_in_group, root_in_group, intra_group_comm)
!------------------------------------------------------------------------
!
USE mp_wave, ONLY : mergewf
USE mp_wave, ONLY : mergewf, mergekg
USE mp, ONLY : mp_size, mp_rank, mp_max
!
#if defined(__HDF5)
@ -39,6 +39,7 @@ MODULE io_base
IMPLICIT NONE
!
INTEGER, INTENT(IN) :: iuni
CHARACTER(LEN=*), INTENT(IN) :: filename
INTEGER, INTENT(IN) :: ik, nk, ispin, nspin
COMPLEX(DP), INTENT(IN) :: wfc(:,:)
INTEGER, INTENT(IN) :: ngw
@ -46,7 +47,7 @@ MODULE io_base
INTEGER, INTENT(IN) :: nbnd
INTEGER, INTENT(IN) :: ngwl
INTEGER, INTENT(IN) :: igl(:)
CHARACTER(LEN=*), INTENT(IN) :: filename
INTEGER, INTENT(IN) :: mill_k(:,:)
REAL(DP), INTENT(IN) :: scalef
! scale factor, usually 1.0 for pw and 1/SQRT( omega ) for CP
LOGICAL, INTENT(IN) :: ionode_in_group
@ -55,6 +56,7 @@ MODULE io_base
INTEGER :: j, ierr
INTEGER :: igwx, npwx, npol
INTEGER :: me_in_group, nproc_in_group, my_group
INTEGER, ALLOCATABLE :: itmp(:,:)
COMPLEX(DP), ALLOCATABLE :: wtmp(:)
!
#if defined(__HDF5)
@ -101,6 +103,13 @@ MODULE io_base
!
END IF
!
ALLOCATE( itmp( 3, MAX (igwx,1) ) )
itmp (:,:) = 0
CALL mergekg( mill_k, itmp, ngwl, igl, me_in_group, &
nproc_in_group, root_in_group, intra_group_comm )
IF ( ionode_in_group ) WRITE(iuni) itmp(1:3,1:igwx)
DEALLOCATE( itmp )
!
DO j = 1, nbnd
!
IF ( npol == 2 ) THEN
@ -143,14 +152,14 @@ MODULE io_base
END SUBROUTINE write_wfc
!
!------------------------------------------------------------------------
SUBROUTINE read_wfc( iuni, ik, nk, ispin, nspin, wfc, ngw, nbnd, &
igl, ngwl, filename, scalef, &
SUBROUTINE read_wfc( iuni, filename, ik, nk, ispin, nspin, wfc, ngw, nbnd, &
igl, ngwl, mill_k, scalef, &
ionode_in_group, root_in_group, intra_group_comm, &
ierr )
! if ierr is present, return 0 if everything is ok, /= 0 if not
!------------------------------------------------------------------------
!
USE mp_wave, ONLY : splitwf
USE mp_wave, ONLY : splitwf, splitkg
USE mp, ONLY : mp_bcast, mp_size, mp_rank, mp_max
!
#if defined __HDF5
@ -161,19 +170,21 @@ MODULE io_base
IMPLICIT NONE
!
INTEGER, INTENT(IN) :: iuni
CHARACTER(LEN=*), INTENT(IN) :: filename
COMPLEX(DP), INTENT(OUT) :: wfc(:,:)
INTEGER, INTENT(IN) :: ik, nk
INTEGER, INTENT(INOUT) :: ngw, nbnd, ispin, nspin
INTEGER, INTENT(IN) :: ngwl
INTEGER, INTENT(IN) :: igl(:)
CHARACTER(LEN=*), INTENT(IN) :: filename
REAL(DP), INTENT(OUT) :: scalef
INTEGER, INTENT(OUT) :: mill_k(:,:)
LOGICAL, INTENT(IN) :: ionode_in_group
INTEGER, INTENT(IN) :: root_in_group, intra_group_comm
INTEGER, OPTIONAL, INTENT(OUT) :: ierr
!
INTEGER :: j
COMPLEX(DP), ALLOCATABLE :: wtmp(:)
INTEGER, ALLOCATABLE :: itmp(:,:)
INTEGER :: ierr_
INTEGER :: igwx, igwx_, npwx, npol, ik_, nk_
INTEGER :: me_in_group, nproc_in_group
@ -243,6 +254,17 @@ MODULE io_base
ALLOCATE( wtmp( npol*MAX( igwx_, igwx ) ) )
npwx = SIZE( wfc, 1 ) / npol
!
ALLOCATE( itmp( 3,MAX( igwx_, igwx ) ) )
IF ( ionode_in_group ) THEN
READ(iuni) itmp(1:3,1:igwx_)
IF ( igwx > igwx_ ) itmp(1:3,igwx_+1:igwx) = 0
ELSE
itmp (:,:) = 0
END IF
CALL splitkg( mill_k(:,:), itmp, ngwl, igl, me_in_group, &
nproc_in_group, root_in_group, intra_group_comm )
DEALLOCATE (itmp)
!
DO j = 1, nbnd
!
IF ( j <= SIZE( wfc, 2 ) ) THEN

197
Modules/mp_wave.f90
View File

@ -117,6 +117,111 @@
RETURN
END SUBROUTINE mergewf
!=----------------------------------------------------------------------------=!
SUBROUTINE mergekg ( mill, millt, ngwl, ig_l2g, mpime, nproc, root, comm )
! ... Same logic as for mergewf, for Miller indices:
!... mill = distributed input, millt = collected output
USE kinds
USE parallel_include
IMPLICIT NONE
INTEGER, intent(in) :: mill(:,:)
INTEGER, intent(out):: millt(:,:)
INTEGER, INTENT(IN) :: mpime ! index of the calling processor ( starting from 0 )
INTEGER, INTENT(IN) :: nproc ! number of processors
INTEGER, INTENT(IN) :: root ! root processor ( the one that should receive the data )
INTEGER, INTENT(IN) :: comm ! communicator
INTEGER, INTENT(IN) :: ig_l2g(:)
INTEGER, INTENT(IN) :: ngwl
INTEGER, ALLOCATABLE :: ig_ip(:)
INTEGER, ALLOCATABLE :: mill_ip(:,:)
INTEGER :: ierr, i, ip, ngw_ip, ngw_lmax, itmp, igwx, gid
#if defined __MPI
INTEGER :: istatus(MPI_STATUS_SIZE)
#endif
!
! ... Subroutine Body
!
igwx = MAXVAL( ig_l2g(1:ngwl) )
#if defined __MPI
gid = comm
! ... Get local and global wavefunction dimensions
CALL MPI_ALLREDUCE( ngwl, ngw_lmax, 1, MPI_INTEGER, MPI_MAX, gid, IERR )
CALL MPI_ALLREDUCE( igwx, itmp, 1, MPI_INTEGER, MPI_MAX, gid, IERR )
igwx = itmp
#endif
IF( igwx > SIZE( millt, 2 ) ) &
CALL errore(' mergekgf',' wrong size for millt ',SIZE(millt,2) )
#if defined __MPI
DO ip = 1, nproc
IF( (ip-1) /= root ) THEN
! ... In turn each processors send to root the wave components and their indexes in the
! ... global array
IF ( mpime == (ip-1) ) THEN
CALL MPI_SEND( ig_l2g, ngwl, MPI_INTEGER, ROOT, IP, gid, IERR )
CALL MPI_SEND( mill,3*ngwl, MPI_INTEGER, ROOT, IP+NPROC, gid, IERR )
END IF
IF ( mpime == root) THEN
ALLOCATE(ig_ip(ngw_lmax))
ALLOCATE(mill_ip(3,ngw_lmax))
CALL MPI_RECV( ig_ip, ngw_lmax, MPI_INTEGER, (ip-1), IP, gid, istatus, IERR )
CALL MPI_GET_COUNT( istatus, MPI_INTEGER, ngw_ip, ierr )
CALL MPI_RECV( mill_ip,3*ngw_lmax, MPI_INTEGER, (ip-1), IP+NPROC, gid, istatus, IERR )
DO I = 1,ngw_ip
millt(:,ig_ip(i)) = mill_ip(:,i)
END DO
DEALLOCATE(ig_ip)
DEALLOCATE(mill_ip)
END IF
ELSE
IF(mpime == root) THEN
DO I = 1, ngwl
millt(:,ig_l2g(i)) = mill(:,i)
END DO
END IF
END IF
CALL MPI_BARRIER( gid, IERR )
END DO
#elif ! defined __MPI
DO I = 1, ngwl
! WRITE( stdout,*) 'MW ', ig_l2g(i), i
millt(:,ig_l2g(i) ) = mill(:,i)
END DO
#else
CALL errore(' mergekg ',' no communication protocol ',0)
#endif
RETURN
END SUBROUTINE mergekg
!=----------------------------------------------------------------------------=!
SUBROUTINE splitwf ( pw, pwt, ngwl, ig_l2g, mpime, nproc, root, comm )
@ -212,7 +317,99 @@
RETURN
END SUBROUTINE splitwf
!=----------------------------------------------------------------------------=!
SUBROUTINE splitkg ( mill, millt, ngwl, ig_l2g, mpime, nproc, root, comm )
! ... Same logic as for splitwf, for Miller indices:
!... mill = distributed output, millt = collected input
USE kinds
USE parallel_include
IMPLICIT NONE
INTEGER, INTENT(OUT):: mill(:,:)
INTEGER, INTENT(IN) :: millt(:,:)
INTEGER, INTENT(IN) :: mpime, nproc, root
INTEGER, INTENT(IN) :: comm ! communicator
INTEGER, INTENT(IN) :: ig_l2g(:)
INTEGER, INTENT(IN) :: ngwl
INTEGER, ALLOCATABLE :: ig_ip(:)
INTEGER, ALLOCATABLE :: mill_ip(:,:)
INTEGER ierr, i, ngw_ip, ip, ngw_lmax, gid, igwx, itmp
#if defined __MPI
integer istatus(MPI_STATUS_SIZE)
#endif
!
! ... Subroutine Body
!
igwx = MAXVAL( ig_l2g(1:ngwl) )
#if defined __MPI
gid = comm
! ... Get local and global wavefunction dimensions
CALL MPI_ALLREDUCE(ngwl, ngw_lmax, 1, MPI_INTEGER, MPI_MAX, gid, IERR )
CALL MPI_ALLREDUCE(igwx, itmp , 1, MPI_INTEGER, MPI_MAX, gid, IERR )
igwx = itmp
#endif
IF( igwx > SIZE( millt,2 ) ) &
CALL errore(' splitwf ',' wrong size for milltt ',SIZE(millt,2) )
#if defined __MPI
DO ip = 1, nproc
! ... In turn each processor send to root the the indexes of its wavefunction conponents
! ... Root receive the indexes and send the componens of the wavefunction read from the disk (pwt)
IF ( (ip-1) /= root ) THEN
IF ( mpime == (ip-1) ) THEN
CALL MPI_SEND( ig_l2g, ngwl, MPI_INTEGER, ROOT, IP, gid,IERR)
CALL MPI_RECV( mill(1,1),3*ngwl, MPI_INTEGER, ROOT, IP+NPROC, gid, istatus, IERR )
END IF
IF ( mpime == root ) THEN
ALLOCATE(ig_ip(ngw_lmax))
ALLOCATE(mill_ip(3,ngw_lmax))
CALL MPI_RECV( ig_ip, ngw_lmax, MPI_INTEGER, (ip-1), IP, gid, istatus, IERR )
CALL MPI_GET_COUNT(istatus, MPI_INTEGER, ngw_ip, ierr)
DO i = 1, ngw_ip
mill_ip(:,i) = millt(:,ig_ip(i))
END DO
CALL MPI_SEND( mill_ip, 3*ngw_ip, MPI_INTEGER, (ip-1), IP+NPROC, gid, IERR )
DEALLOCATE(ig_ip)
DEALLOCATE(mill_ip)
END IF
ELSE
IF ( mpime == root ) THEN
DO i = 1, ngwl
mill(:,i) = millt(:,ig_l2g(i))
END DO
END IF
END IF
CALL MPI_BARRIER(gid, IERR)
END DO
#elif ! defined __MPI
DO I = 1, ngwl
mill(:,i) = millt(:,ig_l2g(i))
END DO
#else
CALL errore(' SPLITWF ',' no communication protocol ',0)
#endif
RETURN
END SUBROUTINE splitkg
SUBROUTINE mergeig(igl, igtot, ngl, mpime, nproc, root, comm)

117
PW/src/pw_restart_new.f90
View File

@ -458,7 +458,7 @@ MODULE pw_restart_new
INTEGER :: i, ig, ngg, ipol, ispin
INTEGER :: ik, ik_g, ike, iks, npw_g, npwx_g
INTEGER, EXTERNAL :: global_kpoint_index
INTEGER, ALLOCATABLE :: ngk_g(:)
INTEGER, ALLOCATABLE :: ngk_g(:), mill_k(:,:)
INTEGER, ALLOCATABLE :: igk_l2g(:), igk_l2g_kdip(:)
CHARACTER(LEN=2), DIMENSION(2) :: updw = (/ 'up', 'dw' /)
CHARACTER(LEN=256) :: dirname
@ -503,6 +503,8 @@ MODULE pw_restart_new
!
ALLOCATE ( igk_l2g_kdip( npwx_g ) )
!
ALLOCATE ( mill_k( 3, npwx ) )
!
k_points_loop: DO ik = 1, nks
!
! ik_g is the index of k-point ik in the global list
@ -526,7 +528,11 @@ MODULE pw_restart_new
CALL gk_l2gmap_kdip( npw_g, ngk_g(ik_g), ngk(ik), igk_l2g, &
igk_l2g_kdip )
!
IF ( .NOT.smallmem ) CALL write_gk( iunpun, ionode_k, ik, ik_g )
! ... mill_k(:,i) contains Miller indices for (k+G)_i
!
DO ig = 1, ngk (ik)
mill_k(:,ig) = mill(:,igk_k(ig,ik))
END DO
!
! ... read wavefunctions - do not read if already in memory (nsk==1)
!
@ -548,107 +554,19 @@ MODULE pw_restart_new
!
ENDIF
!
CALL write_wfc( iunpun, ik_g, nkstot, ispin, nspin, &
evc, npw_g, gamma_only, nbnd, igk_l2g_kdip(:), &
ngk(ik), filename, 1.D0, &
ionode_k, root_pool, intra_pool_comm )
CALL write_wfc( iunpun, filename, ik_g, nkstot, ispin, nspin, &
evc, npw_g, gamma_only, nbnd, igk_l2g_kdip(:), ngk(ik), &
mill_k, 1.D0, ionode_k, root_pool, intra_pool_comm )
!
END DO k_points_loop
!
DEALLOCATE ( mill_k )
DEALLOCATE ( igk_l2g_kdip )
DEALLOCATE ( igk_l2g )
DEALLOCATE( ngk_g )
DEALLOCATE ( ngk_g )
!
RETURN
!
CONTAINS
!
!--------------------------------------------------------------------
SUBROUTINE write_gk( iun, ionode_k_, ik, ik_g )
!--------------------------------------------------------------------
!
#if defined(__HDF5)
USE hdf5_qe, ONLY : prepare_for_writing_final, write_gkhdf5, &
h5fclose_f, hdf5_type, add_attributes_hdf5
#endif
IMPLICIT NONE
!
INTEGER, INTENT(IN) :: iun, ik, ik_g
LOGICAL, INTENT(IN) :: ionode_k_
!
INTEGER, ALLOCATABLE :: igwk(:)
INTEGER, ALLOCATABLE :: itmp(:)
INTEGER :: ierr
#if defined (__HDF5)
TYPE (hdf5_type),ALLOCATABLE :: h5_desc
!
ALLOCATE (h5_desc)
#endif
!
!
ALLOCATE( itmp( npw_g ))
itmp = 0
DO ig = 1, ngk(ik)
itmp(igk_l2g(ig)) = igk_l2g(ig)
END DO
CALL mp_sum( itmp, intra_pool_comm )
!
ALLOCATE( igwk( npwx_g ) )
igwk(:) = 0
!
ngg = 0
DO ig = 1, npw_g
!
if ( itmp(ig) == ig ) THEN
!
ngg = ngg + 1
igwk(ngg) = ig
!
END IF
!
END DO
!
DEALLOCATE( itmp )
!
filename = TRIM(dirname) // 'gkvectors' // TRIM(int_to_char(ik_g))
IF ( ionode_k_ ) THEN
!
#if defined(__HDF5)
CALL prepare_for_writing_final ( h5_desc, 0,&
TRIM(filename)//'.hdf5',ik_g, ADD_GROUP = .false.)
CALL add_attributes_hdf5(h5_desc, ngk_g(ik_g), "number_of_gk_vectors")
CALL add_attributes_hdf5(h5_desc, npwx_g, "max_number_of_gk_vectors")
CALL add_attributes_hdf5(h5_desc, gamma_only, "gamma_only")
CALL add_attributes_hdf5(h5_desc, "2pi/a", "units")
! CALL write_gkhdf5(h5_desc,xk(:,ik),igwk(1:ngk_g(ik)), &
! mill_g(1:3,igwk(1:ngk_g(ik_g))),ik_g)
CALL h5fclose_f(h5_desc%file_id, ierr )
DEALLOCATE (h5_desc)
#else
!
CALL iotk_open_write( iun, FILE = TRIM(filename)//'.dat', &
BINARY = .TRUE. )
!
CALL iotk_write_dat( iun, "NUMBER_OF_GK-VECTORS", ngk_g(ik_g) )
CALL iotk_write_dat( iun, "MAX_NUMBER_OF_GK-VECTORS", npwx_g )
CALL iotk_write_dat( iun, "GAMMA_ONLY", gamma_only )
!
CALL iotk_write_attr ( attr, "UNITS", "2 pi / a", FIRST = .TRUE. )
CALL iotk_write_dat( iun, "K-POINT_COORDS", xk(:,ik), ATTR = attr )
!
CALL iotk_write_dat( iun, "INDEX", igwk(1:ngk_g(ik_g)) )
! CALL iotk_write_dat( iun, "GRID", mill_g(1:3,igwk(1:ngk_g(ik_g))),&
! COLUMNS = 3 )
!
CALL iotk_close_write( iun )
#endif
!
END IF
!
DEALLOCATE( igwk )
!
END SUBROUTINE write_gk
!
END SUBROUTINE pw_write_binaries
!
!-----------------------------------------------------------------------
@ -1964,7 +1882,7 @@ MODULE pw_restart_new
INTEGER :: nspin_, npwx_g
INTEGER :: nupdwn(2), ike, iks, npw_g, ispin
INTEGER, EXTERNAL :: global_kpoint_index
INTEGER, ALLOCATABLE :: ngk_g(:)
INTEGER, ALLOCATABLE :: ngk_g(:), mill_k(:,:)
INTEGER, ALLOCATABLE :: igk_l2g(:), igk_l2g_kdip(:)
LOGICAL :: opnd, ionode_k
REAL(DP) :: scalef
@ -2001,6 +1919,8 @@ MODULE pw_restart_new
!
ALLOCATE ( igk_l2g_kdip( npwx_g ) )
!
ALLOCATE( mill_k ( 3,npwx ) )
!
k_points_loop: DO ik = 1, nks
!
! index of k-point ik in the global list
@ -2041,9 +1961,9 @@ MODULE pw_restart_new
!
ENDIF
!
CALL read_wfc( iunpun, ik_g, nkstot, ispin, nspin_, &
CALL read_wfc( iunpun, filename, ik_g, nkstot, ispin, nspin_, &
evc, npw_g, nbnd, igk_l2g_kdip(:), &
ngk(ik), filename, scalef, &
ngk(ik), mill_k, scalef, &
ionode_k, root_pool, intra_pool_comm )
!
! ... here one should check for consistency between what is read
@ -2053,6 +1973,7 @@ MODULE pw_restart_new
!
END DO k_points_loop
!
DEALLOCATE ( mill_k )
DEALLOCATE ( igk_l2g )
DEALLOCATE ( igk_l2g_kdip )
!