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

projwfc: wfcs are longer read in collected format, re-written in distributed 

one. Routine read_collected_to evc deleted; routine read_file replaced by a
wrapper that has exactly the same functionalities as before. Routine projwave
in projwfc.x, using serial diagonalization, deleted: can be replaced in all
cases by the version using parallel linear algebra. Files make.depend updated.
This commit is contained in:
Paolo Giannozzi 2019-11-01 21:53:41 +01:00
parent f8e5811fdb
commit 5f4e65c5eb
6 changed files with 183 additions and 354 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
PP/src/make.depend
View File

@ -523,6 +523,7 @@ projwfc.o : ../../Modules/run_info.o
projwfc.o : ../../Modules/uspp.o
projwfc.o : ../../Modules/wavefunctions.o
projwfc.o : ../../PW/src/atomic_wfc_mod.o
projwfc.o : ../../PW/src/pw_restart_new.o
projwfc.o : ../../PW/src/pwcom.o
projwfc.o : ../../PW/src/start_k.o
projwfc.o : ../../PW/src/symm_base.o

250
PP/src/projwfc.f90
View File

@ -50,7 +50,7 @@ PROGRAM do_projwfc
REAL (DP), allocatable :: xk_collect(:,:)
REAL (DP) :: Emin, Emax, DeltaE, degauss1, ef_0
INTEGER :: nks2, ngauss1, ios
LOGICAL :: lwrite_overlaps, lbinary_data
LOGICAL :: lwrite_overlaps, lbinary_data, wfc_is_collected
LOGICAL :: lsym, kresolveddos, tdosinboxes, plotboxes, pawproj
INTEGER, PARAMETER :: N_MAX_BOXES = 999
INTEGER :: n_proj_boxes, irmin(3,N_MAX_BOXES), irmax(3,N_MAX_BOXES)
@ -139,7 +139,9 @@ PROGRAM do_projwfc
!
! Now allocate space for pwscf variables, read and check them.
!
CALL read_file ( )
CALL read_file_new ( wfc_is_collected )
IF ( .NOT. wfc_is_collected ) &
CALL errore ('projwfc','wavefunctions not available?!?',1)
!
IF(lgww) CALL get_et_from_gww ( nbnd, et )
!
@ -153,10 +155,6 @@ PROGRAM do_projwfc
END IF
IF ( lforcet .AND. tdosinboxes ) CALL errore ('projwfc','incompatible options',3)
!
! More initializations
!
CALL openfil_pp ( )
!
! Tetrahedron method
!
IF ( ltetra ) THEN
@ -218,7 +216,7 @@ PROGRAM do_projwfc
IF ( lforcet .OR. noncolin ) THEN
CALL projwave_nc(filproj, lsym, lwrite_overlaps, lbinary_data,ef_0)
ELSE
CALL pprojwave (filproj, lsym, lwrite_overlaps, lbinary_data )
CALL projwave (filproj, lsym, lwrite_overlaps, lbinary_data )
ENDIF
ENDIF
!
@ -393,219 +391,6 @@ SUBROUTINE write_lowdin ( filproj, nat, lmax_wfc, nspin, charges, charges_lm )
END SUBROUTINE
!
!-----------------------------------------------------------------------
SUBROUTINE projwave( filproj, lsym, lwrite_ovp, lbinary )
!-----------------------------------------------------------------------
!
USE io_global, ONLY : stdout, ionode
USE ions_base, ONLY : zv, tau, nat, ntyp => nsp, ityp, atm
USE basis, ONLY : natomwfc, swfcatom
USE fft_base, ONLY : dfftp
USE klist, ONLY : xk, nks, nkstot, nelec, ngk, igk_k
USE lsda_mod, ONLY : nspin
USE wvfct, ONLY : npwx, nbnd, et
USE uspp, ONLY : nkb, vkb
USE becmod, ONLY : bec_type, becp, calbec, allocate_bec_type, deallocate_bec_type
USE io_files, ONLY : prefix, tmp_dir, nwordwfc, iunwfc
USE control_flags, ONLY: gamma_only
USE wavefunctions, ONLY: evc
!
USE projections
!
IMPLICIT NONE
!
CHARACTER (len=*) :: filproj
LOGICAL :: lwrite_ovp, lbinary
INTEGER :: npw, ik, ibnd, i, j, k, na, nb, nt, isym, n, m, l, nwfc,&
lmax_wfc, is
REAL(DP), ALLOCATABLE :: e (:)
COMPLEX(DP), ALLOCATABLE :: wfcatom (:,:), proj0(:,:)
! Some workspace for gamma-point calculation ...
REAL (DP), ALLOCATABLE :: rproj0(:,:)
COMPLEX(DP), ALLOCATABLE :: overlap(:,:), work(:,:)
REAL (DP), ALLOCATABLE ::roverlap(:,:)
!
INTEGER :: nksinit, nkslast
LOGICAL :: lsym
LOGICAL :: freeswfcatom
!
!
IF ( natomwfc <= 0 ) CALL errore &
('projwave', 'Cannot project on zero atomic wavefunctions!', 1)
WRITE( stdout, '(/5x,"Calling projwave .... ")')
IF ( gamma_only ) &
WRITE( stdout, '(5x,"gamma-point specific algorithms are used")')
!
! fill structure nlmchi
!
CALL fill_nlmchi ( natomwfc, nwfc, lmax_wfc )
!
ALLOCATE( proj (natomwfc, nbnd, nkstot) )
!
ALLOCATE( proj_aux (natomwfc, nbnd, nkstot) )
!
IF ( lwrite_ovp ) THEN
ALLOCATE( ovps_aux(natomwfc, natomwfc, nkstot) )
ELSE
ALLOCATE( ovps_aux(1,1,1) )
ENDIF
ovps_aux = (0.d0, 0.d0)
!
IF (.not. ALLOCATED(swfcatom)) THEN
ALLOCATE(swfcatom (npwx , natomwfc ) )
freeswfcatom = .true.
ELSE
freeswfcatom = .false.
ENDIF
ALLOCATE(wfcatom (npwx, natomwfc) )
ALLOCATE(e (natomwfc) )
!
ALLOCATE(overlap (natomwfc, natomwfc) )
overlap= (0.d0,0.d0)
IF ( gamma_only ) THEN
ALLOCATE(roverlap (natomwfc, natomwfc) )
roverlap= 0.d0
ENDIF
!
! loop on k points
!
DO ik = 1, nks
npw = ngk(ik)
CALL davcio (evc, 2*nwordwfc, iunwfc, ik, - 1)
CALL atomic_wfc (ik, wfcatom)
CALL allocate_bec_type (nkb, natomwfc, becp )
!
CALL init_us_2 (npw, igk_k(1,ik), xk (1, ik), vkb)
CALL calbec ( npw, vkb, wfcatom, becp)
CALL s_psi (npwx, npw, natomwfc, wfcatom, swfcatom)
!
CALL deallocate_bec_type (becp)
!
! wfcatom = |phi_i> , swfcatom = \hat S |phi_i>
! calculate overlap matrix O_ij = <phi_i|\hat S|\phi_j>
!
IF ( gamma_only ) THEN
CALL calbec ( npw, wfcatom, swfcatom, roverlap )
overlap(:,:)=cmplx(roverlap(:,:),0.0_dp, kind=dp)
! TEMP: diagonalization routine for real matrix should be used instead
ELSE
CALL calbec ( npw, wfcatom, swfcatom, overlap )
ENDIF
!
! save the overlap matrix
!
IF ( lwrite_ovp ) THEN
!
ovps_aux(1:natomwfc,1:natomwfc,ik) = overlap(1:natomwfc,1:natomwfc)
!
ENDIF
!
! calculate O^{-1/2}
!
ALLOCATE(work (natomwfc, natomwfc) )
CALL cdiagh (natomwfc, overlap, natomwfc, e, work)
DO i = 1, natomwfc
e (i) = 1.d0 / dsqrt (e (i) )
ENDDO
DO i = 1, natomwfc
DO j = i, natomwfc
overlap (i, j) = (0.d0, 0.d0)
DO k = 1, natomwfc
overlap (i, j) = overlap (i, j) + e (k) * work (j, k) * conjg (work (i, k) )
ENDDO
IF (j /= i) overlap (j, i) = conjg (overlap (i, j))
ENDDO
ENDDO
DEALLOCATE (work)
!
! calculate wfcatom = O^{-1/2} \hat S | phi>
!
IF ( gamma_only ) THEN
roverlap(:,:)=REAL(overlap(:,:),DP)
! TEMP: diagonalization routine for real matrix should be used instead
CALL DGEMM ('n', 't', 2*npw, natomwfc, natomwfc, 1.d0 , &
swfcatom, 2*npwx, roverlap, natomwfc, 0.d0, wfcatom, 2*npwx)
ELSE
CALL ZGEMM ('n', 't', npw, natomwfc, natomwfc, (1.d0, 0.d0) , &
swfcatom, npwx, overlap, natomwfc, (0.d0, 0.d0), wfcatom, npwx)
ENDIF
!
! make the projection <psi_i| O^{-1/2} \hat S | phi_j>,
! symmetrize the projections if required
!
IF ( gamma_only ) THEN
!
ALLOCATE( rproj0(natomwfc,nbnd) )
CALL calbec ( npw, wfcatom, evc, rproj0)
proj_aux(:,:,ik) = cmplx( rproj0(:,:), 0.0_dp, kind=dp )
IF (lsym) THEN
CALL sym_proj_g (rproj0, proj(:,:,ik))
ELSE
proj(:,:,ik)=abs(rproj0(:,:))**2
ENDIF
DEALLOCATE (rproj0)
!
ELSE
!
ALLOCATE( proj0(natomwfc,nbnd) )
CALL calbec ( npw, wfcatom, evc, proj0)
proj_aux(:,:,ik) = proj0(:,:)
IF (lsym) THEN
CALL sym_proj_k (proj0, proj(:,:,ik))
ELSE
proj(:,:,ik)=abs(proj0(:,:))**2
ENDIF
DEALLOCATE (proj0)
!
ENDIF
! on k-points
ENDDO
!
DEALLOCATE (e)
DEALLOCATE (wfcatom)
IF (freeswfcatom) DEALLOCATE (swfcatom)
IF ( gamma_only ) THEN
DEALLOCATE (roverlap)
ENDIF
DEALLOCATE (overlap)
!
! vectors et and proj are distributed across the pools
! collect data for all k-points to the first pool
!
CALL poolrecover (et, nbnd, nkstot, nks)
CALL poolrecover (proj, nbnd * natomwfc, nkstot, nks)
!
CALL poolrecover (proj_aux, 2 * nbnd * natomwfc, nkstot, nks)
IF ( lwrite_ovp ) THEN
CALL poolrecover (ovps_aux, 2 * natomwfc * natomwfc, nkstot, nks)
ENDIF
!
IF ( ionode ) THEN
!
! write on the file filproj
!
CALL write_proj_file ( filproj, proj )
!
! write projections to file using iotk
!
CALL write_proj_iotk( "atomic_proj", lbinary, proj_aux, lwrite_ovp, &
ovps_aux )
!
DEALLOCATE( proj_aux, ovps_aux )
!
! write to standard output
!
CALL write_proj( lmax_wfc, filproj, proj )
!
ENDIF
!
RETURN
!
END SUBROUTINE projwave
!
!-----------------------------------------------------------------------
SUBROUTINE sym_proj_g (rproj0, proj_out)
!-----------------------------------------------------------------------
!
@ -1129,7 +914,8 @@ SUBROUTINE projwave_nc(filproj, lsym, lwrite_ovp, lbinary, ef_0 )
USE uspp, ONLY: nkb, vkb
USE uspp_param, ONLY: upf
USE becmod, ONLY: bec_type, becp, calbec, allocate_bec_type, deallocate_bec_type
USE io_files, ONLY: prefix, nwordwfc, iunwfc
USE io_files, ONLY : restart_dir
USE pw_restart_new,ONLY : read_this_wfc
USE wavefunctions, ONLY: evc
USE mp, ONLY : mp_sum
USE mp_pools, ONLY : inter_pool_comm, intra_pool_comm
@ -1215,7 +1001,7 @@ SUBROUTINE projwave_nc(filproj, lsym, lwrite_ovp, lbinary, ef_0 )
swfcatom= (0.d0,0.d0)
npw = ngk(ik)
CALL davcio (evc, 2*nwordwfc, iunwfc, ik, - 1)
CALL read_this_wfc ( restart_dir() , ik, evc )
!---- AlexS
! To project on real harmonics, not on spinors.
@ -1425,7 +1211,8 @@ SUBROUTINE projwave_paw( filproj)
USE uspp, ONLY: nkb, vkb
USE uspp_param, ONLY : upf
USE becmod, ONLY: bec_type, becp, calbec, allocate_bec_type, deallocate_bec_type
USE io_files, ONLY: prefix, nwordwfc, iunwfc
USE io_files, ONLY : restart_dir
USE pw_restart_new,ONLY : read_this_wfc
USE wavefunctions, ONLY: evc
!
USE projections
@ -1489,7 +1276,7 @@ SUBROUTINE projwave_paw( filproj)
! loop on k points
!
DO ik = 1, nks
CALL davcio (evc, 2*nwordwfc, iunwfc, ik, - 1)
CALL read_this_wfc ( restart_dir() , ik, evc )
npw = ngk(ik)
CALL init_us_2 (npw, igk_k(1,ik), xk (1, ik), vkb)
@ -1785,7 +1572,7 @@ END SUBROUTINE write_proj_file
! projwave with distributed matrixes
!
!-----------------------------------------------------------------------
SUBROUTINE pprojwave( filproj, lsym, lwrite_ovp, lbinary )
SUBROUTINE projwave( filproj, lsym, lwrite_ovp, lbinary )
!-----------------------------------------------------------------------
!
USE io_global, ONLY : stdout, ionode
@ -1797,9 +1584,10 @@ SUBROUTINE pprojwave( filproj, lsym, lwrite_ovp, lbinary )
USE wvfct, ONLY : npwx, nbnd, et
USE uspp, ONLY : nkb, vkb
USE becmod, ONLY : bec_type, becp, calbec, allocate_bec_type, deallocate_bec_type
USE io_files, ONLY : prefix, tmp_dir, nwordwfc, iunwfc
USE control_flags, ONLY: gamma_only
USE wavefunctions, ONLY: evc
USE io_files, ONLY : prefix, restart_dir, tmp_dir
USE control_flags, ONLY : gamma_only
USE pw_restart_new,ONLY : read_this_wfc
USE wavefunctions, ONLY : evc
!
USE projections
!
@ -1875,7 +1663,7 @@ SUBROUTINE pprojwave( filproj, lsym, lwrite_ovp, lbinary )
! Open file as temporary storage
!
iunaux = find_free_unit()
auxname = TRIM(tmp_dir) // TRIM(ADJUSTL(prefix)) // '.AUX' // TRIM(nd_nmbr)
auxname = TRIM( restart_dir() ) // 'AUX' // TRIM(nd_nmbr)
OPEN( unit=iunaux, file=trim(auxname), status='unknown', form='unformatted')
!
ALLOCATE( desc_ip( np_ortho(1), np_ortho(2) ) )
@ -1902,7 +1690,7 @@ SUBROUTINE pprojwave( filproj, lsym, lwrite_ovp, lbinary )
DO ik = 1, nks
!
npw = ngk(ik)
CALL davcio (evc, 2*nwordwfc, iunwfc, ik, - 1)
CALL read_this_wfc ( restart_dir() , ik, evc )
CALL atomic_wfc (ik, wfcatom)
@ -2378,5 +2166,5 @@ CONTAINS
END SUBROUTINE wf_times_roverlap
!
END SUBROUTINE pprojwave
END SUBROUTINE projwave
!

7
PW/src/make.depend
View File

@ -1573,10 +1573,13 @@ read_conf_from_file.o : ../../Modules/io_files.o
read_conf_from_file.o : ../../Modules/io_global.o
read_conf_from_file.o : ../../Modules/ions_base.o
read_conf_from_file.o : ../../Modules/kind.o
read_conf_from_file.o : ../../Modules/mp_images.o
read_conf_from_file.o : ../../Modules/qes_bcast_module.o
read_conf_from_file.o : ../../Modules/qes_libs_module.o
read_conf_from_file.o : ../../Modules/qes_types_module.o
read_conf_from_file.o : ../../Modules/qexsd.o
read_conf_from_file.o : ../../Modules/qexsd_copy.o
read_conf_from_file.o : ../../UtilXlib/mp.o
read_file_new.o : ../../Modules/cell_base.o
read_file_new.o : ../../Modules/constants.o
read_file_new.o : ../../Modules/control_flags.o
@ -1604,6 +1607,7 @@ read_file_new.o : ../../Modules/recvec.o
read_file_new.o : ../../Modules/recvec_subs.o
read_file_new.o : ../../Modules/tsvdw.o
read_file_new.o : ../../Modules/uspp.o
read_file_new.o : ../../Modules/wavefunctions.o
read_file_new.o : ../../UtilXlib/mp.o
read_file_new.o : Coul_cut_2D.o
read_file_new.o : atomic_wfc_mod.o
@ -1821,6 +1825,7 @@ setup.o : ../../Modules/io_global.o
setup.o : ../../Modules/ions_base.o
setup.o : ../../Modules/kind.o
setup.o : ../../Modules/mp_bands.o
setup.o : ../../Modules/mp_images.o
setup.o : ../../Modules/mp_pools.o
setup.o : ../../Modules/noncol.o
setup.o : ../../Modules/parameters.o
@ -1831,6 +1836,7 @@ setup.o : ../../Modules/qexsd.o
setup.o : ../../Modules/qexsd_copy.o
setup.o : ../../Modules/recvec.o
setup.o : ../../Modules/uspp.o
setup.o : ../../UtilXlib/mp.o
setup.o : atomic_wfc_mod.o
setup.o : bp_mod.o
setup.o : extfield.o
@ -2270,6 +2276,7 @@ wfcinit.o : ../../Modules/io_files.o
wfcinit.o : ../../Modules/io_global.o
wfcinit.o : ../../Modules/kind.o
wfcinit.o : ../../Modules/mp_bands.o
wfcinit.o : ../../Modules/mp_images.o
wfcinit.o : ../../Modules/noncol.o
wfcinit.o : ../../Modules/qes_libs_module.o
wfcinit.o : ../../Modules/qes_types_module.o

93
PW/src/pw_restart_new.f90
View File

@ -37,7 +37,8 @@ MODULE pw_restart_new
!
CHARACTER(LEN=6), EXTERNAL :: int_to_char
PRIVATE
PUBLIC :: pw_write_schema, pw_write_binaries, read_collected_to_evc
PUBLIC :: pw_write_schema, pw_write_binaries
PUBLIC :: read_this_wfc
!
CONTAINS
!------------------------------------------------------------------------
@ -366,6 +367,10 @@ MODULE pw_restart_new
vdw_term_pt => dispersion_energy_term
vdw_corr_ = TRIM(vdw_corr)
vdw_corr_pt => vdw_corr_
NULLIFY (london_rcut_pt, london_s6_pt)
NULLIFY (xdm_a1_pt, xdm_a2_pt)
NULLIFY (dftd3_version_pt, dftd3_threebody_pt)
NULLIFY (ts_vdw_isolated_pt, ts_vdw_econv_thr_pt)
IF (llondon ) THEN
dispersion_energy_term = elondon/e2
lond_s6_ = scal6
@ -685,7 +690,7 @@ MODULE pw_restart_new
USE buffers, ONLY : get_buffer
USE wavefunctions, ONLY : evc
USE klist, ONLY : nks, nkstot, xk, ngk, igk_k, wk
USE klist, ONLY : nks, nkstot, xk, ngk, igk_k
USE gvect, ONLY : ngm, g, mill
USE fft_base, ONLY : dfftp
USE basis, ONLY : natomwfc
@ -885,21 +890,18 @@ MODULE pw_restart_new
END SUBROUTINE gk_l2gmap_kdip
!
!------------------------------------------------------------------------
SUBROUTINE read_collected_to_evc( dirname )
SUBROUTINE read_this_wfc ( dirname, ik, evc )
!------------------------------------------------------------------------
!
! ... This routines reads wavefunctions from the new file format and
! ... writes them into the old format
! ... reads from directory "dirname" (new file format) for k-point "ik"
! ... the wavefunctions into array "evc"
!
USE control_flags, ONLY : gamma_only
USE lsda_mod, ONLY : nspin, isk
USE klist, ONLY : nkstot, wk, nks, xk, ngk, igk_k
USE wvfct, ONLY : npwx, g2kin, et, wg, nbnd
USE wavefunctions, ONLY : evc
USE io_files, ONLY : nwordwfc, iunwfc
USE buffers, ONLY : save_buffer
USE gvect, ONLY : ig_l2g
USE noncollin_module, ONLY : noncolin, npol
USE klist, ONLY : nkstot, nks, xk, ngk, igk_k
USE wvfct, ONLY : npwx, g2kin, et, wg, nbnd
USE gvect, ONLY : ig_l2g
USE mp_bands, ONLY : root_bgrp, intra_bgrp_comm
USE mp_pools, ONLY : me_pool, root_pool, &
intra_pool_comm, inter_pool_comm
@ -909,67 +911,59 @@ MODULE pw_restart_new
IMPLICIT NONE
!
CHARACTER(LEN=*), INTENT(IN) :: dirname
INTEGER, INTENT(IN) :: ik
COMPLEX(dp), INTENT(OUT) :: evc(:,:)
!
CHARACTER(LEN=2), DIMENSION(2) :: updw = (/ 'up', 'dw' /)
CHARACTER(LEN=320) :: filename, msg
INTEGER :: i, ik, ik_g, ig, ipol, ik_s
INTEGER :: i, ik_g, ig, ipol, ik_s
INTEGER :: npol_, nbnd_
INTEGER :: nupdwn(2), ike, iks, npw_g, ispin
INTEGER :: nupdwn(2), ike, iks, ngk_g, npw_g, ispin
INTEGER, EXTERNAL :: global_kpoint_index
INTEGER, ALLOCATABLE :: ngk_g(:), mill_k(:,:)
INTEGER, ALLOCATABLE :: mill_k(:,:)
INTEGER, ALLOCATABLE :: igk_l2g(:), igk_l2g_kdip(:)
LOGICAL :: opnd, ionode_k
REAL(DP) :: scalef, xk_(3), b1(3), b2(3), b3(3)
!
iks = global_kpoint_index (nkstot, 1)
ike = iks + nks - 1
!
! ... ngk_g: global number of k+G vectors for all k points
!
ALLOCATE( ngk_g( nks ) )
ngk_g(1:nks) = ngk(1:nks)
CALL mp_sum( ngk_g, intra_bgrp_comm)
!
! ... the root processor of each pool reads
!
ionode_k = (me_pool == root_pool)
!
! ... The igk_l2g array yields the correspondence between the
! ... local k+G index and the global G index
iks = global_kpoint_index (nkstot, 1)
ike = iks + nks - 1
!
ALLOCATE ( igk_l2g( npwx ) )
! ik_g: index of k-point ik in the global list
!
ik_g = ik + iks - 1
!
! ... the igk_l2g_kdip local-to-global map is needed to read wfcs
!
ALLOCATE ( igk_l2g_kdip( npwx ) )
!
ALLOCATE( mill_k ( 3,npwx ) )
!
k_points_loop: DO ik = 1, nks
!
! index of k-point ik in the global list
!
ik_g = ik + iks - 1
!
! ... Compute the igk_l2g array from previously computed arrays
! ... The igk_l2g array yields the correspondence between the
! ... local k+G index and the global G index - requires arrays
! ... igk_k (k+G indices) and ig_l2g (local to global G index map)
!
ALLOCATE ( igk_l2g( npwx ) )
igk_l2g = 0
DO ig = 1, ngk(ik)
igk_l2g(ig) = ig_l2g(igk_k(ig,ik))
END DO
!
! ... npw_g: the maximum G vector index among all processors
! ... ngk_g: global number of k+G vectors for all k points
!
npw_g = MAXVAL( igk_l2g(1:ngk(ik)) )
CALL mp_max( npw_g, intra_pool_comm )
ngk_g = ngk(ik)
CALL mp_sum( ngk_g, intra_bgrp_comm)
!
! ... now compute the igk_l2g_kdip local-to-global map
!
igk_l2g_kdip = 0
CALL gk_l2gmap_kdip( npw_g, ngk_g(ik), ngk(ik), igk_l2g, &
CALL gk_l2gmap_kdip( npw_g, ngk_g, ngk(ik), igk_l2g, &
igk_l2g_kdip )
!
evc=(0.0_DP, 0.0_DP)
DEALLOCATE ( igk_l2g )
!
IF ( nspin == 2 ) THEN
!
@ -986,30 +980,31 @@ MODULE pw_restart_new
!
ENDIF
!
! ... Miller indices are read from file (but not used)
!
ALLOCATE( mill_k ( 3,npwx ) )
!
evc=(0.0_DP, 0.0_DP)
!
CALL read_wfc( iunpun, filename, root_bgrp, intra_bgrp_comm, &
ik_g, xk_, ispin, npol_, evc, npw_g, gamma_only, nbnd_, &
igk_l2g_kdip(:), ngk(ik), b1, b2, b3, mill_k, scalef )
!
DEALLOCATE ( mill_k )
DEALLOCATE ( igk_l2g_kdip )
!
! ... here one should check for consistency between what is read
! ... and what is expected
!
IF ( nbnd_ < nbnd ) THEN
WRITE (msg,'("The number of bands for this run is",I6,", but only",&
& I6," bands were read from file")') nbnd, nbnd_
CALL errore ('pw_restart - read_collected_to_evc', msg, 1 )
CALL errore ('pw_restart - read_this_wfc', msg, 1 )
END IF
CALL save_buffer ( evc, nwordwfc, iunwfc, ik )
!
END DO k_points_loop
!
DEALLOCATE ( mill_k )
DEALLOCATE ( igk_l2g )
DEALLOCATE ( igk_l2g_kdip )
DEALLOCATE ( ngk_g )
!
RETURN
!
END SUBROUTINE read_collected_to_evc
END SUBROUTINE read_this_wfc
!
!------------------------------------------------------------------------
END MODULE pw_restart_new

89
PW/src/read_file_new.f90
View File

@ -9,16 +9,63 @@
SUBROUTINE read_file()
!----------------------------------------------------------------------------
!
! Read data produced by pw.x or cp.x - new xml file and binary files
! Wrapper routine for backwards compatibility
! Wrapper routine, for backwards compatibility
!
USE io_global, ONLY : stdout
USE io_files, ONLY : nwordwfc, iunwfc, wfc_dir, tmp_dir, restart_dir
USE buffers, ONLY : open_buffer, close_buffer
USE control_flags, ONLY : io_level
USE buffers, ONLY : open_buffer, close_buffer, save_buffer
USE io_files, ONLY : nwordwfc, iunwfc, restart_dir
USE wvfct, ONLY : nbnd, npwx
USE noncollin_module, ONLY : npol
USE pw_restart_new, ONLY : read_collected_to_evc
USE control_flags, ONLY : io_level
USE klist, ONLY : nks
USE wavefunctions, ONLY : evc
USE pw_restart_new, ONLY : read_this_wfc
!
IMPLICIT NONE
!
INTEGER :: ik
LOGICAL :: exst, wfc_is_collected
CHARACTER( LEN=256 ) :: dirname
!
dirname = restart_dir( )
WRITE( stdout, '(/,5x,A,/,5x,A)') &
'Reading data from directory:', TRIM( dirname )
!
CALL read_file_new( wfc_is_collected )
!
! ... Open unit iunwfc, for Kohn-Sham orbitals - we assume that wfcs
! ... have been written to tmp_dir, not to a different directory!
! ... io_level = 1 so that a real file is opened
!
nwordwfc = nbnd*npwx*npol
io_level = 1
CALL open_buffer ( iunwfc, 'wfc', nwordwfc, io_level, exst )
!
! ... read wavefunctions in collected format, write them to file
!
IF ( wfc_is_collected ) THEN
!
DO ik = 1, nks
!
CALL read_this_wfc ( dirname, ik, evc )
CALL save_buffer ( evc, nwordwfc, iunwfc, ik )
!
END DO
!
END IF
!
CALL close_buffer ( iunwfc, 'KEEP' )
!
END SUBROUTINE read_file
!
!----------------------------------------------------------------------------
SUBROUTINE read_file_new ( wfc_is_collected )
!----------------------------------------------------------------------------
!
! Read xml data file produced by pw.x or cp.x, performs some initialization
! DOes not read wfcs but returns in "wfc_is_collected" info on the wfc file
!
USE io_files, ONLY : nwordwfc, iunwfc, wfc_dir, tmp_dir
USE gvect, ONLY : ngm, g
USE gvecw, ONLY : gcutw
USE klist, ONLY : nkstot, nks, xk, wk
@ -26,19 +73,15 @@ SUBROUTINE read_file()
USE wvfct, ONLY : nbnd, et, wg
!
IMPLICIT NONE
INTEGER :: ierr
LOGICAL :: exst, wfc_is_collected
CHARACTER( LEN=256 ) :: dirname
!
LOGICAL, INTENT(OUT) :: wfc_is_collected
!
INTEGER :: ierr
!
ierr = 0
!
! ... Read the contents of the xml data file
!
dirname = restart_dir( )
WRITE( stdout, '(/,5x,A,/,5x,A)') &
'Reading data from directory:', TRIM( dirname )
!
CALL read_xml_file ( wfc_is_collected )
!
! ... more initializations: pseudopotentials / G-vectors / FFT arrays /
@ -48,6 +91,8 @@ SUBROUTINE read_file()
!
! ... initialization of KS orbitals
!
wfc_dir = tmp_dir ! this is likely obsolete and no longer used
!
! ... distribute across pools k-points and related variables.
! ... nks is defined by the following routine as the number
! ... of k-points in the current pool
@ -61,23 +106,7 @@ SUBROUTINE read_file()
!
CALL allocate_wfc_k()
!
! ... Open unit iunwfc, for Kohn-Sham orbitals - we assume that wfcs
! ... have been written to tmp_dir, not to a different directory!
! ... io_level = 1 so that a real file is opened
!
wfc_dir = tmp_dir
nwordwfc = nbnd*npwx*npol
io_level = 1
CALL open_buffer ( iunwfc, 'wfc', nwordwfc, io_level, exst )
!
! ... read wavefunctions in collected format, writes them to file
! ... FIXME: likely not a great idea
!
IF ( wfc_is_collected ) CALL read_collected_to_evc(dirname)
!
CALL close_buffer ( iunwfc, 'KEEP' )
!
END SUBROUTINE read_file
END SUBROUTINE read_file_new
!
!----------------------------------------------------------------------------
SUBROUTINE read_xml_file ( wfc_is_collected )

13
PW/src/wfcinit.f90
View File

@ -29,7 +29,7 @@ SUBROUTINE wfcinit()
USE wavefunctions, ONLY : evc
USE wvfct, ONLY : nbnd, npwx, current_k
USE wannier_new, ONLY : use_wannier
USE pw_restart_new, ONLY : read_collected_to_evc
USE pw_restart_new, ONLY : read_this_wfc
USE mp, ONLY : mp_bcast
USE mp_images, ONLY : intra_image_comm
USE qexsd_module, ONLY : qexsd_readschema
@ -61,13 +61,22 @@ SUBROUTINE wfcinit()
IF (ionode) CALL qexsd_readschema ( xmlfile(), ierr, output_obj )
CALL mp_bcast(ierr, ionode_id, intra_image_comm)
IF ( ierr <= 0 ) THEN
!
IF (ionode) twfcollect_file = output_obj%band_structure%wf_collected
CALL mp_bcast(twfcollect_file, ionode_id, intra_image_comm)
!
IF ( twfcollect_file ) THEN
CALL read_collected_to_evc(dirname )
!
DO ik = 1, nks
CALL read_this_wfc ( dirname, ik, evc )
CALL save_buffer ( evc, nwordwfc, iunwfc, ik )
END DO
!
ELSE IF ( .NOT. exst_file) THEN
! !
WRITE( stdout, '(5X,"Cannot read wfcs: file not found")' )
starting_wfc = 'atomic+random'
!
ELSE
!
! ... wavefunctions are read from file (or buffer) not here but