mirror of https://gitlab.com/QEF/q-e.git
865 lines
28 KiB
Fortran
865 lines
28 KiB
Fortran
!
|
|
! Copyright (C) 2001-2014 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 .
|
|
!
|
|
!
|
|
|
|
!
|
|
! Original version by Andrea Ferretti
|
|
! Modified mainly by Layla Martin-Samos
|
|
! Modified by Joe Stenuit
|
|
! Modified by Joshua David Elliott November 2020 as JDE
|
|
!
|
|
!=----------------------------------------------------------------------------=!
|
|
MODULE io_base_export
|
|
!=----------------------------------------------------------------------------=!
|
|
|
|
USE kinds
|
|
|
|
IMPLICIT NONE
|
|
SAVE
|
|
|
|
INTEGER, PARAMETER :: file_version = 202
|
|
INTEGER :: restart_module_verbosity = 0
|
|
|
|
END MODULE
|
|
|
|
!-----------------------------------------------------------------------
|
|
program gwl_punch
|
|
!-----------------------------------------------------------------------
|
|
!
|
|
! read in PWSCF data in XML format using IOTK lib
|
|
! then prepare matrices for GWL calculation
|
|
!
|
|
! input: namelist "&inputpp", with variables
|
|
! prefix prefix of input files saved by program pwscf
|
|
! outdir temporary directory where files resides
|
|
! pp_file output file. If it is omitted, a directory
|
|
! "prefix.export/" is created in outdir and
|
|
! some output files are put there. Anyway all the data
|
|
! are accessible through the "prefix.export/index.xml" file which
|
|
! contains implicit pointers to all the other files in the
|
|
! export directory. If reading is done by the IOTK library
|
|
! all data appear to be in index.xml even if physically it
|
|
! is not.
|
|
! uspp_spsi using US PP if set .TRUE. writes S | psi >
|
|
! and | psi > separately in the output file
|
|
! single_file one-file output is produced
|
|
! ascii ....
|
|
!
|
|
! pseudo_dir pseudopotential directory
|
|
! psfile(:) name of the pp file for each species
|
|
!
|
|
|
|
USE kinds, ONLY : i4b
|
|
USE gvecs, ONLY : doublegrid
|
|
USE gvect, ONLY : mill
|
|
use pwcom
|
|
USE constants, ONLY : rytoev
|
|
use io_global, ONLY : stdout, ionode, ionode_id
|
|
use io_files, ONLY : psfile, pseudo_dir
|
|
use io_files, ONLY : prefix, tmp_dir
|
|
use ions_base, ONLY : ntype => nsp
|
|
use mp_pools, ONLY : kunit
|
|
use mp, ONLY: mp_bcast
|
|
use mp_world, ONLY: world_comm, mpime
|
|
use control_flags, ONLY : gamma_only
|
|
use uspp, ONLY : okvan
|
|
use ldaU, ONLY : lda_plus_u
|
|
use scf, only : vrs, vltot, v, kedtau
|
|
USE klist, ONLY : xk, wk, nks, nkstot
|
|
USE fft_base, ONLY : dfftp
|
|
USE wannier_gw, ONLY : lwannier, &
|
|
num_nbndv, &
|
|
num_nbnds, &
|
|
nset, &
|
|
l_truncated_coulomb, &
|
|
truncation_radius, &
|
|
remainder, &
|
|
restart_gww, &
|
|
numw_prod, &
|
|
l_gram,&
|
|
l_head,&
|
|
n_gauss,&
|
|
omega_gauss, &
|
|
l_exchange, &
|
|
l_zero, &
|
|
l_wing, &
|
|
grid_type, &
|
|
nset_overlap, &
|
|
nspace,&
|
|
ecutoff_global, &
|
|
maxiter2,&
|
|
diago_thr2, &
|
|
l_plot_mlwf,&
|
|
l_pmatrix,&
|
|
npcol,&
|
|
nprow,&
|
|
n_pola_lanczos,&
|
|
n_self_lanczos,&
|
|
nsteps_lanczos_pola,&
|
|
nsteps_lanczos_self,&
|
|
s_pola_lanczos,&
|
|
s_self_lanczos,&
|
|
s_g_lanczos,&
|
|
l_pmat_diago,&
|
|
pmat_ethr, &
|
|
pmat_cutoff,&
|
|
pmat_type,&
|
|
lanczos_restart,&
|
|
n_pola_lanczos_eff,&
|
|
n_self_lanczos_eff,&
|
|
n_pmat,&
|
|
s_pmat,&
|
|
n_fast_pmat,&
|
|
off_fast_pmat,&
|
|
l_fast_pola,&
|
|
l_v_basis,&
|
|
v_cutoff,&
|
|
l_iter_algorithm,&
|
|
dual_pb, &
|
|
l_t_wannier,&
|
|
dual_vt,&
|
|
dual_vs,&
|
|
wannier_thres,&
|
|
s_first_state,&
|
|
s_last_state,&
|
|
l_selfconsistent,&
|
|
l_whole_s,&
|
|
l_ts_eigen,&
|
|
l_frac_occ,&
|
|
num_nbndv_min,&
|
|
l_cond_pol_base,&
|
|
l_semicore,&
|
|
n_semicore,&
|
|
l_semicore_read,&
|
|
l_verbose,&
|
|
l_contour,&
|
|
l_real,&
|
|
l_bse,&
|
|
s_bse,&
|
|
dual_bse,&
|
|
l_big_system,&
|
|
extra_pw_cutoff,&
|
|
l_list,&
|
|
l_scissor,&
|
|
scissor,&
|
|
l_full,&
|
|
n_full,&
|
|
l_simple,&
|
|
l_no_GW_just_screening,& ! JDE
|
|
l_no_GW_bare_Coulomb,& ! JDE
|
|
no_GW_cg_maxit,& ! JDE
|
|
no_GW_cg_threshold,& ! JDE
|
|
l_easy, &
|
|
l_easy_lanczos_g, &
|
|
easy_grid_type, &
|
|
easy_grid_param, &
|
|
easy_average_type, &
|
|
easy_psi_thrs,&
|
|
l_easy_update_basis_w, &
|
|
l_easy_dielectric_constant, &
|
|
easy_w_update_alpha, &
|
|
easy_w_update_lanczos, &
|
|
easy_w_thrs, &
|
|
s_first_spin,&
|
|
s_last_spin, &
|
|
easy_split_calc_n, &
|
|
easy_split_calc_i, &
|
|
l_easy_w_disk
|
|
|
|
|
|
|
|
USE exchange_custom, ONLY : exchange_fast_dual
|
|
|
|
!
|
|
implicit none
|
|
integer :: i, kunittmp, ios
|
|
|
|
character(len=200) :: pp_file
|
|
logical :: found, uspp_spsi, ascii, single_file, raw
|
|
! INTEGER(i4b), EXTERNAL :: C_MKDIR
|
|
CHARACTER(LEN=256), EXTERNAL :: trimcheck
|
|
CHARACTER(LEN=256) :: outdir
|
|
|
|
NAMELIST /inputpw4gww/ prefix, outdir, pp_file, uspp_spsi, ascii, single_file, raw, &
|
|
psfile, pseudo_dir, &
|
|
lwannier, num_nbndv, &
|
|
nset,num_nbnds, &
|
|
l_truncated_coulomb, &
|
|
truncation_radius, &
|
|
remainder, restart_gww, numw_prod, &
|
|
l_gram, l_head, n_gauss, omega_gauss, l_exchange, &
|
|
l_zero, l_wing, grid_type, &
|
|
nset_overlap, nspace, &
|
|
ecutoff_global,&
|
|
maxiter2,diago_thr2,l_plot_mlwf,&
|
|
l_pmatrix, npcol,nprow,&
|
|
n_pola_lanczos, nsteps_lanczos_pola,nsteps_lanczos_self,&
|
|
s_pola_lanczos,s_self_lanczos,n_self_lanczos,s_g_lanczos,&
|
|
l_pmat_diago,pmat_ethr,pmat_cutoff, pmat_type, lanczos_restart,&
|
|
n_pola_lanczos_eff,n_self_lanczos_eff,n_pmat,s_pmat,n_fast_pmat,&
|
|
off_fast_pmat,l_fast_pola,l_v_basis,v_cutoff,l_iter_algorithm,&
|
|
dual_pb, l_t_wannier, dual_vt, dual_vs,wannier_thres,s_first_state,&
|
|
s_last_state,l_selfconsistent,l_whole_s,l_ts_eigen,l_frac_occ,num_nbndv_min,&
|
|
l_cond_pol_base,l_semicore,n_semicore,l_semicore_read, l_verbose, l_contour,&
|
|
l_real,exchange_fast_dual,l_bse,s_bse,dual_bse,l_big_system,extra_pw_cutoff,&
|
|
l_list,l_scissor,scissor,l_full,n_full,l_simple,&
|
|
l_no_GW_just_screening, l_no_GW_bare_Coulomb, no_GW_cg_maxit, no_GW_cg_threshold,&
|
|
l_easy, easy_grid_type, easy_grid_param,easy_average_type, easy_psi_thrs,&
|
|
l_easy_lanczos_g, &
|
|
l_easy_update_basis_w, l_easy_dielectric_constant, easy_w_update_alpha, &
|
|
easy_w_update_lanczos, easy_w_thrs, s_first_spin, s_last_spin, easy_split_calc_n,&
|
|
easy_split_calc_i, l_easy_w_disk
|
|
|
|
|
|
|
|
!
|
|
call start_pw4gww( )
|
|
!
|
|
! set default values for variables in namelist
|
|
!
|
|
prefix='export'
|
|
CALL get_environment_variable( 'ESPRESSO_TMPDIR', outdir )
|
|
IF ( TRIM( outdir ) == ' ' ) outdir = './'
|
|
pp_file= ' '
|
|
uspp_spsi = .FALSE.
|
|
ascii = .FALSE.
|
|
single_file = .FALSE.
|
|
raw = .FALSE.
|
|
!
|
|
! nppstr = 1
|
|
!
|
|
lwannier = .false.
|
|
wannier_thres=0.d0
|
|
num_nbndv(1:2) = 1
|
|
num_nbnds = 1
|
|
nset = 250
|
|
l_truncated_coulomb = .false.
|
|
truncation_radius = 10.d0
|
|
remainder=-1
|
|
restart_gww=-1
|
|
numw_prod=1
|
|
l_gram=.false.
|
|
l_head=.false.
|
|
l_exchange=.false.
|
|
n_gauss=79
|
|
omega_gauss=20.d0
|
|
l_zero=.true.
|
|
l_wing=.false.
|
|
grid_type=3
|
|
nset_overlap=250
|
|
nspace=1
|
|
ecutoff_global = 400.d0
|
|
maxiter2=0
|
|
diago_thr2=0.d0
|
|
l_plot_mlwf=.false.
|
|
l_pmatrix=.false.
|
|
npcol=1
|
|
nprow=1
|
|
n_pola_lanczos=400
|
|
n_self_lanczos=600
|
|
nsteps_lanczos_pola=20
|
|
nsteps_lanczos_self=40
|
|
s_pola_lanczos=0.5d0
|
|
s_self_lanczos=1d-12
|
|
s_g_lanczos=0.d0
|
|
l_pmat_diago=.true.
|
|
pmat_ethr=1d-5
|
|
pmat_cutoff=3.d0
|
|
pmat_type=4
|
|
lanczos_restart=0
|
|
n_pola_lanczos_eff=0
|
|
n_self_lanczos_eff=0
|
|
n_pmat=100
|
|
s_pmat=0.01d0
|
|
n_fast_pmat=0
|
|
off_fast_pmat=0.d0
|
|
l_fast_pola=.false.
|
|
l_v_basis=.false.
|
|
v_cutoff=0.01d0
|
|
l_iter_algorithm=.true.
|
|
dual_pb=1.d0
|
|
dual_vt=1.d0
|
|
dual_vs=1.d0
|
|
l_t_wannier=.true.
|
|
s_first_state=0
|
|
s_last_state=0
|
|
l_selfconsistent=.false.
|
|
l_whole_s=.false.
|
|
l_ts_eigen=.true.
|
|
l_frac_occ=.false.
|
|
num_nbndv_min(1:2)=1
|
|
l_cond_pol_base=.false.
|
|
l_semicore=.false.
|
|
n_semicore=1
|
|
l_semicore_read=.false.
|
|
l_verbose=.false.
|
|
l_contour=.false.
|
|
l_real=.false.
|
|
exchange_fast_dual=4.d0
|
|
l_bse=.false.
|
|
s_bse=0.d0
|
|
dual_bse=1.d0
|
|
l_big_system=.false.
|
|
l_list=.false.
|
|
extra_pw_cutoff=0.d0
|
|
l_scissor=.false.
|
|
scissor=0.d0
|
|
l_full=.false.
|
|
n_full=0
|
|
l_simple=.false.
|
|
l_no_GW_just_screening=.false. ! JDE
|
|
l_no_GW_bare_coulomb=.false. ! JDE
|
|
no_GW_cg_maxit=30 ! JDE
|
|
no_GW_cg_threshold=1.d-10 ! JDE
|
|
l_easy=.false.
|
|
l_easy_lanczos_g=.false.
|
|
easy_grid_type=0
|
|
easy_grid_param(1)=0
|
|
easy_grid_param(2)=0
|
|
easy_grid_param(3)=0
|
|
easy_grid_param(4)=5
|
|
easy_grid_param(5)=100000
|
|
easy_average_type=0
|
|
easy_psi_thrs=0.d0
|
|
l_easy_update_basis_w=.false.
|
|
l_easy_dielectric_constant=.false.
|
|
easy_w_update_alpha=0.1d0
|
|
easy_w_update_lanczos=0.5
|
|
easy_w_thrs=1d-20
|
|
s_first_spin=0
|
|
s_last_spin=0
|
|
easy_split_calc_n=1
|
|
easy_split_calc_i=1
|
|
l_easy_w_disk=.false.
|
|
|
|
|
|
!
|
|
! Reading input file
|
|
!
|
|
IF ( ionode ) THEN
|
|
!
|
|
CALL input_from_file ( )
|
|
!
|
|
READ(5,inputpw4gww,IOSTAT=ios)
|
|
!
|
|
! call read_namelists( 'PW4GWW' )
|
|
!
|
|
IF (ios /= 0) CALL errore ('pw4gww', 'reading inputpw4gww namelist', ABS(ios) )
|
|
!
|
|
!-----------------------------------------------------------------------
|
|
! IF( pp_file == ' ' ) THEN
|
|
!
|
|
! pp_file = TRIM(prefix)//".export/index.xml"
|
|
!
|
|
! if(ionode) ios = C_MKDIR( TRIM(outdir)//"/"//TRIM(prefix)// &
|
|
! ".export" , LEN(TRIM(outdir)//"/"//TRIM(prefix)//".export") )
|
|
! ENDIF
|
|
!
|
|
ENDIF
|
|
#if !defined(__MPI)
|
|
dual_pb=4.d0
|
|
dual_vs=4.d0
|
|
dual_vt=4.d0
|
|
#endif
|
|
!-------------------------------------------------------------------------
|
|
! ... Broadcasting variables
|
|
!------------------------------------------------------------------------
|
|
tmp_dir = trimcheck( outdir )
|
|
CALL mp_bcast( tmp_dir, ionode_id, world_comm )
|
|
CALL mp_bcast( prefix, ionode_id, world_comm )
|
|
CALL mp_bcast( pp_file, ionode_id, world_comm )
|
|
CALL mp_bcast( uspp_spsi, ionode_id, world_comm )
|
|
CALL mp_bcast( ascii, ionode_id, world_comm )
|
|
CALL mp_bcast( single_file, ionode_id, world_comm )
|
|
CALL mp_bcast( raw, ionode_id, world_comm )
|
|
CALL mp_bcast( pseudo_dir, ionode_id, world_comm )
|
|
CALL mp_bcast( psfile, ionode_id, world_comm )
|
|
CALL mp_bcast( lwannier, ionode_id, world_comm )
|
|
CALL mp_bcast( wannier_thres, ionode_id, world_comm)
|
|
CALL mp_bcast( num_nbndv, ionode_id, world_comm )
|
|
CALL mp_bcast( num_nbnds, ionode_id, world_comm )
|
|
CALL mp_bcast( nset, ionode_id, world_comm )
|
|
CALL mp_bcast(l_truncated_coulomb, ionode_id, world_comm)
|
|
CALL mp_bcast(truncation_radius, ionode_id, world_comm)
|
|
CALL mp_bcast(remainder, ionode_id, world_comm)
|
|
CALL mp_bcast(restart_gww, ionode_id, world_comm)
|
|
call mp_bcast(numw_prod, ionode_id, world_comm)
|
|
CALL mp_bcast(l_gram, ionode_id, world_comm)
|
|
CALL mp_bcast(l_head, ionode_id, world_comm)
|
|
CALL mp_bcast(n_gauss, ionode_id, world_comm)
|
|
CALL mp_bcast(omega_gauss, ionode_id, world_comm)
|
|
CALL mp_bcast(l_exchange, ionode_id, world_comm)
|
|
CALL mp_bcast(l_zero, ionode_id, world_comm)
|
|
CALL mp_bcast(l_wing, ionode_id, world_comm)
|
|
CALL mp_bcast(grid_type, ionode_id, world_comm)
|
|
CALL mp_bcast(nset_overlap, ionode_id, world_comm)
|
|
CALL mp_bcast(nspace, ionode_id, world_comm)
|
|
CALL mp_bcast(ecutoff_global, ionode_id, world_comm)
|
|
CALL mp_bcast(maxiter2, ionode_id, world_comm)
|
|
CALL mp_bcast(diago_thr2, ionode_id, world_comm)
|
|
CALL mp_bcast(l_plot_mlwf, ionode_id, world_comm)
|
|
CALL mp_bcast(l_pmatrix, ionode_id, world_comm)
|
|
CALL mp_bcast(npcol, ionode_id, world_comm)
|
|
CALL mp_bcast(nprow, ionode_id, world_comm)
|
|
CALL mp_bcast(n_pola_lanczos, ionode_id, world_comm)
|
|
CALL mp_bcast(n_self_lanczos, ionode_id, world_comm)
|
|
CALL mp_bcast(nsteps_lanczos_pola, ionode_id, world_comm)
|
|
CALL mp_bcast(nsteps_lanczos_self, ionode_id, world_comm)
|
|
CALL mp_bcast(s_pola_lanczos, ionode_id, world_comm)
|
|
CALL mp_bcast(s_self_lanczos, ionode_id, world_comm)
|
|
CALL mp_bcast(s_g_lanczos, ionode_id, world_comm)
|
|
CALL mp_bcast(l_pmat_diago, ionode_id, world_comm)
|
|
CALL mp_bcast(pmat_ethr, ionode_id, world_comm)
|
|
CALL mp_bcast(pmat_cutoff, ionode_id, world_comm)
|
|
CALL mp_bcast(pmat_type, ionode_id, world_comm)
|
|
CALL mp_bcast(lanczos_restart, ionode_id, world_comm)
|
|
CALL mp_bcast(n_pola_lanczos_eff, ionode_id, world_comm)
|
|
CALL mp_bcast(n_self_lanczos_eff, ionode_id, world_comm)
|
|
CALL mp_bcast(n_pmat, ionode_id, world_comm)
|
|
CALL mp_bcast(s_pmat, ionode_id, world_comm)
|
|
CALL mp_bcast(n_fast_pmat, ionode_id, world_comm)
|
|
CALL mp_bcast(off_fast_pmat, ionode_id, world_comm)
|
|
CALL mp_bcast(l_fast_pola, ionode_id, world_comm)
|
|
CALL mp_bcast(l_v_basis, ionode_id, world_comm)
|
|
CALL mp_bcast(v_cutoff, ionode_id, world_comm)
|
|
CALL mp_bcast(l_iter_algorithm, ionode_id, world_comm)
|
|
CALL mp_bcast(dual_pb, ionode_id, world_comm)
|
|
CALL mp_bcast(dual_vt, ionode_id, world_comm)
|
|
CALL mp_bcast(dual_vs, ionode_id, world_comm)
|
|
CALL mp_bcast(l_t_wannier, ionode_id, world_comm)
|
|
CALL mp_bcast(s_first_state, ionode_id, world_comm)
|
|
CALL mp_bcast(s_last_state, ionode_id, world_comm)
|
|
CALL mp_bcast(l_selfconsistent, ionode_id, world_comm)
|
|
CALL mp_bcast(l_whole_s, ionode_id, world_comm)
|
|
CALL mp_bcast(l_ts_eigen, ionode_id, world_comm)
|
|
CALL mp_bcast(l_frac_occ, ionode_id, world_comm)
|
|
CALL mp_bcast(num_nbndv_min, ionode_id, world_comm)
|
|
CALL mp_bcast(l_cond_pol_base, ionode_id, world_comm)
|
|
CALL mp_bcast(l_semicore, ionode_id, world_comm)
|
|
CALL mp_bcast(n_semicore, ionode_id, world_comm)
|
|
CALL mp_bcast(l_semicore_read, ionode_id, world_comm)
|
|
CALL mp_bcast(l_verbose, ionode_id, world_comm)
|
|
CALL mp_bcast(l_contour, ionode_id, world_comm)
|
|
CALL mp_bcast(l_real, ionode_id, world_comm)
|
|
CALL mp_bcast(exchange_fast_dual, ionode_id, world_comm)
|
|
CALL mp_bcast(l_bse, ionode_id, world_comm)
|
|
CALL mp_bcast(s_bse, ionode_id, world_comm)
|
|
CALL mp_bcast(dual_bse, ionode_id, world_comm)
|
|
CALL mp_bcast(l_big_system, ionode_id, world_comm)
|
|
CALL mp_bcast(extra_pw_cutoff, ionode_id, world_comm)
|
|
CALL mp_bcast(l_list, ionode_id, world_comm)
|
|
CALL mp_bcast(l_scissor, ionode_id, world_comm)
|
|
CALL mp_bcast(scissor, ionode_id, world_comm)
|
|
CALL mp_bcast(l_full, ionode_id, world_comm)
|
|
CALL mp_bcast(n_full, ionode_id, world_comm)
|
|
CALL mp_bcast(l_simple, ionode_id, world_comm)
|
|
CALL mp_bcast(l_no_GW_just_screening, ionode_id, world_comm) ! JDE
|
|
CALL mp_bcast(l_no_GW_bare_coulomb, ionode_id, world_comm) ! JDE
|
|
CALL mp_bcast(no_GW_cg_maxit, ionode_id, world_comm) ! JDE
|
|
CALL mp_bcast(no_GW_cg_threshold, ionode_id, world_comm) ! JDE
|
|
CALL mp_bcast(l_easy, ionode_id, world_comm)
|
|
CALL mp_bcast(l_easy_lanczos_g, ionode_id, world_comm)
|
|
CALL mp_bcast(easy_grid_type, ionode_id, world_comm)
|
|
CALL mp_bcast(easy_grid_param, ionode_id, world_comm)
|
|
CALL mp_bcast(easy_average_type, ionode_id, world_comm)
|
|
CALL mp_bcast(easy_psi_thrs, ionode_id, world_comm)
|
|
CALL mp_bcast(l_easy_update_basis_w, ionode_id,world_comm)
|
|
CALL mp_bcast(l_easy_dielectric_constant, ionode_id,world_comm)
|
|
CALL mp_bcast(easy_w_update_alpha, ionode_id,world_comm)
|
|
CALL mp_bcast(easy_w_update_lanczos , ionode_id,world_comm)
|
|
CALL mp_bcast(easy_w_thrs, ionode_id,world_comm)
|
|
CALL mp_bcast(s_first_spin, ionode_id, world_comm)
|
|
CALL mp_bcast(s_last_spin, ionode_id, world_comm)
|
|
CALL mp_bcast(easy_split_calc_n, ionode_id, world_comm)
|
|
CALL mp_bcast(easy_split_calc_i, ionode_id, world_comm)
|
|
CALL mp_bcast( l_easy_w_disk, ionode_id, world_comm)
|
|
if(s_first_spin==0) s_first_spin=1
|
|
if(s_last_spin==0) s_first_spin=nspin
|
|
|
|
|
|
call read_file
|
|
|
|
|
|
#if defined __MPI
|
|
kunittmp = kunit
|
|
#else
|
|
kunittmp = 1
|
|
#endif
|
|
|
|
!
|
|
|
|
|
|
call openfil_pw4gww
|
|
|
|
|
|
! read wave functions (direct access)
|
|
call read_export(pp_file,kunittmp,uspp_spsi, ascii, single_file, raw)
|
|
!
|
|
|
|
! after read_file everything is known
|
|
! realy?
|
|
|
|
call summary()
|
|
|
|
|
|
!
|
|
! init some quantities ...
|
|
!
|
|
CALL hinit0()
|
|
if(lda_plus_u) then
|
|
CALL init_ns()
|
|
endif
|
|
|
|
CALL set_vrs(vrs, vltot, v%of_r, kedtau, v%kin_r, dfftp%nnr, nspin, doublegrid )
|
|
|
|
!-------------------------------------------------
|
|
! allocating wannier stuff (from init_run.f90)
|
|
!-----------------------------------------------------
|
|
CALL allocate_wannier()
|
|
|
|
! This is something from hinit0.f90, qpointlist ????
|
|
|
|
!
|
|
|
|
!
|
|
! -----------------------------------------------------
|
|
! now calculating the first wannier stuff (first in non_scf.f90)
|
|
! -----------------------------------------------------
|
|
|
|
if(l_verbose) write(stdout,*) 'To check, we print the KS eigenvalues:'
|
|
FLUSH( stdout )
|
|
!
|
|
CALL print_ks_energies()
|
|
!
|
|
|
|
! IF(l_head .and. .not.gamma_only) THEN
|
|
! write(stdout,*) 'BEFORE calculate_head'
|
|
! FLUSH( stdout )
|
|
! CALL calculate_head
|
|
! write(stdout,*) 'AFTER calculate_head'
|
|
! FLUSH( stdout )
|
|
! ENDIF
|
|
!
|
|
|
|
IF(l_exchange) THEN
|
|
IF(gamma_only) THEN
|
|
call dft_exchange(num_nbndv(1),num_nbnds,nset)
|
|
ELSE
|
|
!!! add this, since wk are used in dft_exchange_k
|
|
!
|
|
CALL weights ( )
|
|
!
|
|
if(l_verbose) write(stdout,*) 'BEFORE dft_exchange_k'
|
|
FLUSH( stdout )
|
|
!call dft_exchange_k(num_nbndv,num_nbnds,ecutoff_global)
|
|
if(l_verbose) write(stdout,*) 'AFTER dft_exchange_k'
|
|
FLUSH( stdout )
|
|
ENDIF
|
|
ENDIF
|
|
|
|
|
|
if(l_easy) then
|
|
CALL easy_gw()
|
|
else
|
|
CALL produce_wannier_gamma
|
|
endif
|
|
|
|
|
|
!
|
|
!
|
|
!deallocate wannier stuff (clean_pw.f90)
|
|
!
|
|
CALL deallocate_wannier()
|
|
|
|
|
|
call stop_pp
|
|
stop
|
|
end program gwl_punch
|
|
!
|
|
!-----------------------------------------------------------------------
|
|
subroutine read_export (pp_file,kunit,uspp_spsi, ascii, single_file, raw)
|
|
!-----------------------------------------------------------------------
|
|
!
|
|
use kinds, ONLY : DP
|
|
use pwcom
|
|
USE gvect, ONLY : ngm, ngm_g, mill, ig_l2g, g
|
|
use gvecw, ONLY : gcutw
|
|
use control_flags, ONLY : gamma_only
|
|
use becmod, ONLY : bec_type, becp, calbec, &
|
|
allocate_bec_type, deallocate_bec_type
|
|
! use symme, ONLY : nsym, s, invsym, sname, irt, ftau
|
|
! use symme, ONLY : nsym, s, invsym, irt, ftau
|
|
! use char, ONLY : sname
|
|
! occhio sname is in symme which is now outside pwcom
|
|
use uspp, ONLY : nkb, vkb
|
|
use wavefunctions, ONLY : evc
|
|
use io_files, ONLY : prefix, iunwfc, nwordwfc, iunsat, nwordatwfc
|
|
use io_files, ONLY : pseudo_dir, psfile
|
|
use io_global, ONLY : ionode, stdout
|
|
USE ions_base, ONLY : atm, nat, ityp, tau, nsp
|
|
use cell_base, ONLY : bg
|
|
use mp_pools, ONLY : nproc_pool, my_pool_id, intra_pool_comm, &
|
|
inter_pool_comm
|
|
use mp, ONLY : mp_sum, mp_max
|
|
use mp_world, ONLY : world_comm, nproc, mpime
|
|
use ldaU, ONLY : lda_plus_u
|
|
USE basis, ONLY : swfcatom
|
|
USE uspp_init, ONLY : init_us_2
|
|
|
|
implicit none
|
|
|
|
CHARACTER(5), PARAMETER :: fmt_name="QEXPT"
|
|
CHARACTER(5), PARAMETER :: fmt_version="1.1.0"
|
|
|
|
integer, intent(in) :: kunit
|
|
character(80), intent(in) :: pp_file
|
|
logical, intent(in) :: uspp_spsi, ascii, single_file, raw
|
|
|
|
integer :: i, j, k, ig, ik, ibnd, na, ngg,ig_, ierr
|
|
integer, allocatable :: kisort(:)
|
|
real(DP) :: xyz(3), tmp(3)
|
|
integer :: ike, iks, npw_g, npwx_g, ispin, local_pw
|
|
integer, allocatable :: ngk_g( : )
|
|
integer, allocatable :: itmp_g( :, : )
|
|
real(DP),allocatable :: rtmp_g( :, : )
|
|
real(DP),allocatable :: rtmp_gg( : )
|
|
integer, allocatable :: itmp1( : )
|
|
integer, allocatable :: igwk( :, : )
|
|
integer, allocatable :: l2g_new( : )
|
|
integer, allocatable :: igk_l2g( :, : )
|
|
integer, external :: global_kpoint_index
|
|
|
|
real(DP) :: wfc_scal
|
|
logical :: twf0, twfm
|
|
complex(DP), allocatable :: sevc (:,:)
|
|
|
|
write(stdout,*) "nkstot=", nkstot
|
|
|
|
IF( nkstot > 0 ) THEN
|
|
|
|
IF( ( kunit < 1 ) .OR. ( MOD( nkstot, kunit ) /= 0 ) ) &
|
|
CALL errore( ' write_export ',' wrong kunit ', 1 )
|
|
|
|
IF( ( nproc_pool > nproc ) .OR. ( MOD( nproc, nproc_pool ) /= 0 ) ) &
|
|
CALL errore( ' write_export ',' nproc_pool ', 1 )
|
|
|
|
iks = global_kpoint_index (nkstot, 1)
|
|
ike = iks + nks - 1
|
|
|
|
END IF
|
|
|
|
write(stdout,*) "after first init"
|
|
|
|
! find out the global number of G vectors: ngm_g
|
|
ngm_g = ngm
|
|
call mp_sum( ngm_g , intra_pool_comm )
|
|
|
|
! collect all G vectors across processors within the pools
|
|
! and compute their modules
|
|
!
|
|
allocate( itmp_g( 3, ngm_g ) )
|
|
allocate( rtmp_g( 3, ngm_g ) )
|
|
allocate( rtmp_gg( ngm_g ) )
|
|
|
|
itmp_g = 0
|
|
do ig = 1, ngm
|
|
itmp_g( 1, ig_l2g( ig ) ) = mill(1, ig )
|
|
itmp_g( 2, ig_l2g( ig ) ) = mill(2, ig )
|
|
itmp_g( 3, ig_l2g( ig ) ) = mill(3, ig )
|
|
end do
|
|
call mp_sum( itmp_g , intra_pool_comm )
|
|
!
|
|
! here we are in crystal units
|
|
rtmp_g(1:3,1:ngm_g) = REAL( itmp_g(1:3,1:ngm_g) )
|
|
!
|
|
! go to cartesian units (tpiba)
|
|
call cryst_to_cart( ngm_g, rtmp_g, bg , 1 )
|
|
!
|
|
! compute squared moduli
|
|
do ig = 1, ngm_g
|
|
rtmp_gg(ig) = rtmp_g(1,ig)**2 + rtmp_g(2,ig)**2 + rtmp_g(3,ig)**2
|
|
enddo
|
|
deallocate( rtmp_g )
|
|
|
|
! build the G+k array indexes
|
|
allocate ( igk_l2g ( npwx, nks ) )
|
|
allocate ( kisort( npwx ) )
|
|
do ik = 1, nks
|
|
kisort = 0
|
|
npw = npwx
|
|
call gk_sort (xk (1, ik+iks-1), ngm, g, gcutw, npw, kisort(1), g2kin)
|
|
!
|
|
! mapping between local and global G vector index, for this kpoint
|
|
!
|
|
DO ig = 1, npw
|
|
!
|
|
igk_l2g(ig,ik) = ig_l2g( kisort(ig) )
|
|
!
|
|
END DO
|
|
!
|
|
igk_l2g( npw+1 : npwx, ik ) = 0
|
|
!
|
|
ngk (ik) = npw
|
|
end do
|
|
deallocate (kisort)
|
|
|
|
! compute the global number of G+k vectors for each k point
|
|
allocate( ngk_g( nkstot ) )
|
|
ngk_g = 0
|
|
ngk_g( iks:ike ) = ngk( 1:nks )
|
|
CALL mp_sum( ngk_g, world_comm )
|
|
|
|
! compute the Maximum G vector index among all G+k and processors
|
|
npw_g = MAXVAL( igk_l2g(:,:) )
|
|
CALL mp_max( npw_g, world_comm )
|
|
|
|
! compute the Maximum number of G vector among all k points
|
|
npwx_g = MAXVAL( ngk_g( 1:nkstot ) )
|
|
|
|
deallocate(rtmp_gg)
|
|
|
|
allocate( igwk( npwx_g,nkstot ) )
|
|
|
|
write(stdout,*) "after g stuff"
|
|
|
|
! wfc grids
|
|
|
|
DO ik = 1, nkstot
|
|
igwk(:,ik) = 0
|
|
!
|
|
ALLOCATE( itmp1( npw_g ), STAT= ierr )
|
|
IF ( ierr/=0 ) CALL errore('pw_export','allocating itmp1', ABS(ierr) )
|
|
itmp1 = 0
|
|
!
|
|
IF( ik >= iks .AND. ik <= ike ) THEN
|
|
DO ig = 1, ngk( ik-iks+1 )
|
|
itmp1( igk_l2g( ig, ik-iks+1 ) ) = igk_l2g( ig, ik-iks+1 )
|
|
END DO
|
|
END IF
|
|
!
|
|
CALL mp_sum( itmp1, world_comm )
|
|
!
|
|
ngg = 0
|
|
DO ig = 1, npw_g
|
|
IF( itmp1( ig ) == ig ) THEN
|
|
ngg = ngg + 1
|
|
igwk( ngg , ik) = ig
|
|
END IF
|
|
END DO
|
|
IF( ngg /= ngk_g( ik ) ) THEN
|
|
WRITE( stdout,*) ' ik, ngg, ngk_g = ', ik, ngg, ngk_g( ik )
|
|
END IF
|
|
!
|
|
DEALLOCATE( itmp1 )
|
|
!
|
|
ENDDO
|
|
!
|
|
deallocate( itmp_g )
|
|
|
|
write(stdout,*)"after wfc waves"
|
|
|
|
#if defined(__MPI)
|
|
call poolrecover (et, nbnd, nkstot, nks)
|
|
#endif
|
|
|
|
wfc_scal = 1.0d0
|
|
twf0 = .true.
|
|
twfm = .false.
|
|
|
|
do ik = 1, nkstot
|
|
local_pw = 0
|
|
IF( (ik >= iks) .AND. (ik <= ike) ) THEN
|
|
|
|
call davcio (evc, 2*nwordwfc, iunwfc, (ik-iks+1), - 1)
|
|
IF ( lda_plus_u ) CALL davcio( swfcatom, nwordatwfc, iunsat, (ik-iks+1), -1 )
|
|
local_pw = ngk(ik-iks+1)
|
|
|
|
ENDIF
|
|
|
|
|
|
allocate(l2g_new(local_pw))
|
|
|
|
l2g_new = 0
|
|
do ig = 1, local_pw
|
|
ngg = igk_l2g(ig,ik-iks+1)
|
|
do ig_ = 1, ngk_g(ik)
|
|
if(ngg == igwk(ig_,ik)) then
|
|
l2g_new(ig) = ig_
|
|
exit
|
|
end if
|
|
end do
|
|
end do
|
|
|
|
|
|
ispin = isk( ik )
|
|
! WRITE(0,*) ' ### ', ik,nkstot,iks,ike,kunit,nproc,nproc_pool
|
|
deallocate(l2g_new)
|
|
end do
|
|
!
|
|
|
|
write(stdout,*) "after davcio"
|
|
|
|
! If specified and if USPP are used the wfcs S_psi are written
|
|
! | spsi_nk > = \hat S | psi_nk >
|
|
! where S is the overlap operator of US PP
|
|
!
|
|
IF ( uspp_spsi .AND. nkb > 0 ) THEN
|
|
|
|
ALLOCATE( sevc(npwx,nbnd), STAT=ierr )
|
|
IF (ierr/=0) CALL errore( ' read_export ',' Unable to allocate SEVC ', ABS(ierr) )
|
|
|
|
call errore('pw4gww','init_us_1 incorrectly called',1)
|
|
CALL init_us_1
|
|
|
|
CALL allocate_bec_type (nkb,nbnd,becp)
|
|
|
|
do ik = 1, nkstot
|
|
|
|
local_pw = 0
|
|
IF( (ik >= iks) .AND. (ik <= ike) ) THEN
|
|
|
|
CALL davcio (evc, 2*nwordwfc, iunwfc, (ik-iks+1), - 1)
|
|
CALL init_us_2(npw, igk_k(1,ik-iks+1), xk(1, ik), vkb)
|
|
local_pw = ngk(ik-iks+1)
|
|
|
|
IF ( gamma_only ) THEN
|
|
if(nkb>0) CALL calbec ( ngk_g(ik), vkb, evc, becp )
|
|
ELSE
|
|
CALL calbec ( npw, vkb, evc, becp )
|
|
ENDIF
|
|
CALL s_psi(npwx, npw, nbnd, evc, sevc)
|
|
ENDIF
|
|
|
|
ALLOCATE(l2g_new(local_pw))
|
|
|
|
l2g_new = 0
|
|
DO ig = 1, local_pw
|
|
ngg = igk_l2g(ig,ik-iks+1)
|
|
DO ig_ = 1, ngk_g(ik)
|
|
IF(ngg == igwk(ig_,ik)) THEN
|
|
l2g_new(ig) = ig_
|
|
EXIT
|
|
ENDIF
|
|
ENDDO
|
|
ENDDO
|
|
|
|
ispin = isk( ik )
|
|
DEALLOCATE(l2g_new)
|
|
ENDDO
|
|
|
|
DEALLOCATE( sevc, STAT=ierr )
|
|
IF ( ierr/= 0 ) CALL errore('read_export','Unable to deallocate SEVC',ABS(ierr))
|
|
CALL deallocate_bec_type ( becp )
|
|
ENDIF
|
|
|
|
DEALLOCATE( igk_l2g )
|
|
DEALLOCATE( igwk )
|
|
DEALLOCATE ( ngk_g )
|
|
|
|
end subroutine read_export
|