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

The data types and routines for writing the schema-compliant XML output 

of pw.x, developed in a distinct branch  are merged to the trunk. 
Work done by: 
Giovanni Borghi, Andrea Ferretti, Pietro Delugas  

N.B. The feature is still experimental. To compile it,
 add in make.sys the manual preprocessing  flag   
              -D __XSD   

  


git-svn-id: http://qeforge.qe-forge.org/svn/q-e/trunk/espresso@12372 c92efa57-630b-4861-b058-cf58834340f0
This commit is contained in:
pietrodelugas 2016-04-29 17:19:28 +00:00
parent 4e16fc451e
commit 0213240c44
26 changed files with 10641 additions and 4828 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
Modules/Makefile
View File

@ -67,7 +67,6 @@ plugin_variables.o \
pseudo_types.o \
pw_dot.o \
qexml.o \
qexml_xsd.o \
qmmm.o \
radial_grids.o \
random_numbers.o \
@ -105,6 +104,11 @@ xc_vdW_DF.o \
xc_rVV10.o \
xml_input.o \
xml_io_base.o \
qes_module.o \
qes_types.o \
qes_libs.o \
qexsd.o \
qexsd_input.o \
xsf.o \
wypos.o \
zdotc_wrapper.o \
@ -137,6 +141,7 @@ rgen.o \
recips.o \
remove_tot_torque.o \
set_hubbard_l.o \
set_hubbard_n.o \
simpsn.o \
sort.o \
sph_bes.o \

16
Modules/bfgs_module.f90
View File

@ -56,7 +56,7 @@ MODULE bfgs_module
!
! ... public methods
!
PUBLIC :: bfgs, terminate_bfgs
PUBLIC :: bfgs, terminate_bfgs, bfgs_get_n_iter
!
! ... public variables
!
@ -941,4 +941,18 @@ CONTAINS
!
END SUBROUTINE terminate_bfgs
!
FUNCTION bfgs_get_n_iter (what) RESULT(n_iter)
!
IMPLICIT NONE
INTEGER :: n_iter
CHARACTER(10),INTENT(IN) :: what
SELECT CASE (TRIM(what))
CASE ('bfgs_iter')
n_iter = bfgs_iter
CASE ( 'scf_iter')
n_iter = scf_iter
CASE default
n_iter = -1
END SELECT
END FUNCTION bfgs_get_n_iter
END MODULE bfgs_module

7
Modules/control_flags.f90
View File

@ -173,9 +173,12 @@ MODULE control_flags
niter, &! the maximum number of iteration
nmix, &! the number of iteration kept in the history
imix ! the type of mixing (0=plain,1=TF,2=local-TF)
REAL(DP), PUBLIC :: &
INTEGER, PUBLIC :: &
n_scf_steps ! number of scf iterations to reach convergence
REAL(DP), PUBLIC :: &
mixing_beta, &! the mixing parameter
tr2 ! the convergence threshold for potential
tr2, &! the convergence threshold for potential
scf_error=0.0 ! actual convergence reached
LOGICAL, PUBLIC :: &
conv_elec ! if .TRUE. electron convergence has been reached

11
Modules/funct.f90
View File

@ -45,7 +45,8 @@ module funct
! subroutines/functions managing dft name and indices
PUBLIC :: set_dft_from_indices, set_dft_from_name
PUBLIC :: enforce_input_dft, write_dft_name
PUBLIC :: get_dft_name, get_dft_short, get_dft_long
PUBLIC :: get_dft_name, get_dft_short, get_dft_long,&
get_nonlocc_name
PUBLIC :: get_iexch, get_icorr, get_igcx, get_igcc, get_meta, get_inlc
PUBLIC :: dft_is_gradient, dft_is_meta, dft_is_hybrid, dft_is_nonlocc, igcc_is_lyp
@ -856,6 +857,12 @@ CONTAINS
get_inlc = inlc
return
end function get_inlc
!-----------------------------------------------------------------------
function get_nonlocc_name ()
character(10) get_nonlocc_name
get_nonlocc_name = TRIM(nonlocc(inlc))
return
end function get_nonlocc_name
!-----------------------------------------------------------------------
function dft_is_nonlocc ()
logical :: dft_is_nonlocc
@ -953,7 +960,7 @@ CONTAINS
call set_auxiliary_flags
return
end subroutine set_dft_from_indices
!---------------------------------------------------------------------
!-------------------------------------------------------------------------------
function get_dft_short ( )
!---------------------------------------------------------------------
!

32
Modules/make.depend
View File

@ -211,14 +211,36 @@ pw_dot.o : kind.o
pw_dot.o : mp.o
pw_dot.o : mp_global.o
pw_dot.o : recvec.o
qes_libs.o : ../iotk/src/iotk_module.o
qes_libs.o : qes_types.o
qes_module.o : ../iotk/src/iotk_module.o
qes_module.o : qes_libs.o
qes_module.o : qes_types.o
qes_types.o : kind.o
qexml.o : ../iotk/src/iotk_module.o
qexml.o : kind.o
qexml.o : wrappers.o
qexml_xsd.o : ../iotk/src/iotk_module.o
qexml_xsd.o : input_parameters.o
qexml_xsd.o : io_files.o
qexml_xsd.o : kind.o
qexml_xsd.o : wrappers.o
qexsd.o : ../iotk/src/iotk_base.o
qexsd.o : ../iotk/src/iotk_module.o
qexsd.o : constants.o
qexsd.o : input_parameters.o
qexsd.o : ions_base.o
qexsd.o : kind.o
qexsd.o : mp_bands.o
qexsd.o : mp_images.o
qexsd.o : mp_pools.o
qexsd.o : mp_world.o
qexsd.o : noncol.o
qexsd.o : parameters.o
qexsd.o : qes_module.o
qexsd.o : version.o
qexsd_input.o : ../iotk/src/iotk_base.o
qexsd_input.o : ../iotk/src/iotk_module.o
qexsd_input.o : constants.o
qexsd_input.o : input_parameters.o
qexsd_input.o : kind.o
qexsd_input.o : qes_module.o
qexsd_input.o : qexsd.o
qmmm.o : ../FFTXlib/fft_types.o
qmmm.o : cell_base.o
qmmm.o : constants.o

6476
Modules/qes_libs.f90 Normal file
View File

File diff suppressed because it is too large Load Diff

8
Modules/qes_module.f90 Normal file
View File

@ -0,0 +1,8 @@
MODULE qes_module
USE iotk_module
USE qes_types_module
USE qes_libs_module
END MODULE qes_module

1290
Modules/qes_types.f90 Normal file
View File

File diff suppressed because it is too large Load Diff

4748
Modules/qexml_xsd.f90
View File

File diff suppressed because it is too large Load Diff

1250
Modules/qexsd.f90 Normal file
View File

File diff suppressed because it is too large Load Diff

669
Modules/qexsd_input.f90 Normal file
View File

@ -0,0 +1,669 @@
!
! Copyright (C) 2003-2015 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 .
!
#ifdef __XSD
!---------------------------------------------------------
MODULE qexsd_input
!--------------------------------------------------------
! This module contains the routines needed to initialise the data-structures
! contained in the PW XML input
!----------------------------------------------------------------------------
! First version March 2016
!----------- ------------- ---------------------------------------------------
USE kinds, ONLY : DP
USE input_parameters, ONLY : input_xml_schema_file
!
USE iotk_base, ONLY : iotk_indent, iotk_maxindent
USE constants, ONLY : e2,bohr_radius_angs
USE iotk_module
USE qes_module
USE qexsd_module, ONLY : qexsd_init_atomic_species,qexsd_init_atomic_structure,qexsd_init_dft
!
IMPLICIT NONE
!
PUBLIC
SAVE
!
TYPE(input_type) :: input
CONTAINS
!--------------------------------------------------------------------------------------------------------------------
SUBROUTINE qexsd_init_control_variables(obj,title,calculation,restart_mode,&
prefix,pseudo_dir,outdir,stress,forces,wf_collect,disk_io, &
max_seconds,etot_conv_thr,forc_conv_thr,press_conv_thr,verbosity, &
iprint)
!---------------------------------------------------------------------------------------------------------------------
!
TYPE(control_variables_type) :: obj
CHARACTER(LEN=*),INTENT(IN) :: title,calculation,restart_mode,prefix,&
pseudo_dir,outdir,disk_io,verbosity
LOGICAL,INTENT(IN) :: stress,forces,wf_collect
REAL(DP),INTENT(IN) :: max_seconds,etot_conv_thr,forc_conv_thr,&
press_conv_thr
INTEGER,INTENT(IN) :: iprint
!
!
CHARACTER(LEN=*),PARAMETER :: TAGNAME='control_variables'
CHARACTER(LEN=256) :: verbosity_value, disk_io_value
INTEGER :: int_max_seconds
int_max_seconds=nint(max_seconds)
IF ( TRIM( verbosity ) .EQ. 'default' ) THEN
verbosity_value = "low"
ELSE
verbosity_value=TRIM(verbosity)
END IF
IF ( TRIM(disk_io) .EQ. 'default' ) THEN
disk_io_value="low"
ELSE
disk_io_value=TRIM(disk_io)
END IF
CALL qes_init_control_variables(obj,tagname,title=title,calculation=calculation,&
restart_mode=restart_mode,prefix=prefix, &
pseudo_dir=pseudo_dir,outdir=outdir,disk_io=disk_io_value,&
verbosity=TRIM(verbosity_value),stress=stress,forces=forces, &
wf_collect=wf_collect,max_seconds=int_max_seconds, &
etot_conv_thr=etot_conv_thr,forc_conv_thr=forc_conv_thr, &
press_conv_thr=press_conv_thr,print_every=iprint)
END SUBROUTINE qexsd_init_control_variables
!
!
!----------------------------------------------------------------------------------------
SUBROUTINE qexsd_init_spin(obj,lsda,noncolin,spinorbit)
!
IMPLICIT NONE
!
TYPE(spin_type) :: obj
LOGICAL,INTENT(IN) :: lsda,noncolin,spinorbit
!
CHARACTER(LEN=*),PARAMETER :: TAGNAME="spin"
CALL qes_init_spin(obj,TAGNAME,lsda=lsda,noncolin=noncolin,spinorbit=spinorbit)
END SUBROUTINE qexsd_init_spin
!
!
!-------------------------------------------------------------------------------------
SUBROUTINE qexsd_init_bands(obj, nbnd, smearing, degauss, occupations, tot_charge, nspin, &
input_occupations, input_occupations_minority)
!
IMPLICIT NONE
!
TYPE ( bands_type) :: obj
INTEGER,INTENT(IN) :: nbnd,nspin
CHARACTER(LEN=*),INTENT(IN) :: occupations,smearing
REAL(DP),INTENT(IN) :: degauss,tot_charge
REAL(DP),DIMENSION(:),OPTIONAL,INTENT(IN) :: input_occupations, input_occupations_minority
!
CHARACTER(25) :: smearing_local
INTEGER :: spin_degeneracy, inpOcc_size = 0
CHARACTER(LEN=*),PARAMETER :: TAGNAME="bands"
TYPE(smearing_type) :: smearing_obj
TYPE(occupations_type) :: occup_obj
TYPE(inputoccupations_type),ALLOCATABLE :: inpOcc_objs(:)
LOGICAL :: inp_occ_arepresent = .FALSE.
!
IF (TRIM(occupations) .NE. "smearing") THEN
CALL qes_init_smearing ( smearing_obj, "smearing", degauss=0.d0, smearing="")
smearing_obj%lread = .FALSE.
smearing_obj%lwrite = .FALSE.
ELSE
SELECT CASE (TRIM (smearing))
CASE ("gaussian", "gauss")
smearing_local="gaussian"
CASE ('methfessel-paxton', 'm-p', 'mp')
smearing_local="mp"
CASE ( 'marzari-vanderbilt', 'cold', 'm-v', 'mv')
smearing_local="mv"
CASE ('fermi-dirac', 'f-d', 'fd')
smearing_local="fd"
END SELECT
CALL qes_init_smearing(smearing_obj,"smearing",degauss=degauss,smearing=smearing_local)
END IF
IF (nspin .GT. 1) THEN
spin_degeneracy = 1
ELSE
spin_degeneracy = 2
END IF
CALL qes_init_occupations(occup_obj, "occupations", spin_degeneracy, occupations = TRIM(occupations))
!
IF (PRESENT(input_occupations) ) THEN
inp_occ_arepresent = .TRUE.
SELECT CASE ( nspin)
CASE (2)
inpOcc_size=2
CASE default
inpOcc_size=1
END SELECT
ALLOCATE (inpOcc_objs(inpOcc_size))
IF ( inpOcc_size .GT. 1) THEN
CALL qes_init_inputOccupations( inpOcc_objs(1),"input_occupations", 1, &
REAL(spin_degeneracy,KIND=DP),nbnd-1, input_occupations(2:nbnd) )
CALL qes_init_inputOccupations( inpOcc_objs(2),"input_occupations", 2, &
REAL(spin_degeneracy,KIND=DP) , nbnd-1,input_occupations_minority(2:nbnd))
ELSE
CALL qes_init_inputOccupations( inpOcc_objs(1),"input_occupations", 1, &
REAL(spin_degeneracy,KIND=DP) , nbnd-1, input_occupations(2:nbnd) )
END IF
END IF
CALL qes_init_bands(obj,TAGNAME,nbnd_ispresent=(nbnd .GT. 0), nbnd = nbnd,&
smearing_ispresent = smearing_obj%lread, smearing = smearing_obj,&
tot_charge_ispresent=.TRUE., tot_charge = tot_charge, occupations=occup_obj, &
inputoccupations_ispresent=inp_occ_arepresent, ndim_inputOccupations= inpOcc_size, &
inputOccupations = inpOcc_objs)
CALL qes_reset_smearing(smearing_obj)
CALL qes_reset_occupations(occup_obj)
IF (inp_occ_arepresent) THEN
CALL qes_reset_inputoccupations(inpocc_objs(1))
IF (inpOcc_size .GT. 1 ) CALL qes_reset_inputoccupations(inpocc_objs(2))
DEALLOCATE (inpocc_objs)
END IF
!
END SUBROUTINE qexsd_init_bands
!
!
!--------------------------------------------------------------------------------------------------------------------
SUBROUTINE qexsd_init_basis(obj,k_points,ecutwfc,ecutrho,nr1,nr2,nr3,nr1s,nr2s,nr3s,nr1b,nr2b,nr3b)
!--------------------------------------------------------------------------------------------------------------------
!
IMPLICIT NONE
!
TYPE (basis_type) :: obj
CHARACTER(LEN=*),INTENT(IN) :: k_points
REAL(DP),INTENT(IN) :: ecutwfc,ecutrho
INTEGER,INTENT(IN) :: nr1,nr2,nr3,nr1s,nr2s,nr3s,nr1b,nr2b,nr3b
!
TYPE(basisSetItem_type) :: grid_obj,smooth_grid_obj,box_obj
CHARACTER(LEN=*),PARAMETER :: TAGNAME="basis",FFT_GRID="fft_grid",FFT_SMOOTH="fft_smooth",&
FFT_BOX="fft_box"
LOGICAL :: fft_grid_ispresent=.FALSE.,&
fft_smooth_ispresent=.FALSE.,&
fft_box_ispresent = .FALSE., &
gamma_only=.FALSE., ecutrho_ispresent=.FALSE.
IF( ( nr1 .NE. 0 ) .AND. ( nr2 .NE. 0 ) .AND. ( nr3 .NE. 0 )) THEN
fft_grid_ispresent=.TRUE.
CALL qes_init_basisSetItem(grid_obj,FFT_GRID,nr1,nr2,nr3,"grid set in input")
END IF
!
IF( ( nr1s .NE. 0 ) .AND. ( nr2s .NE. 0 ) .AND. ( nr3s .NE. 0 )) THEN
fft_smooth_ispresent=.TRUE.
CALL qes_init_basisSetItem(smooth_grid_obj,FFT_SMOOTH,nr1s,nr2s,nr3s,"grid set in input")
END IF
!
IF( ( nr1b .NE. 0 ) .AND. ( nr2b .NE. 0 ) .AND. ( nr3b .NE. 0 )) THEN
fft_box_ispresent=.TRUE.
CALL qes_init_basisSetItem(box_obj,FFT_BOX,nr1b,nr2b,nr3b,"grid set in input")
END IF
!
IF (TRIM(k_points) .EQ. "gamma" ) gamma_only=.TRUE.
IF (ecutrho .GT. 4.d0*ecutwfc) ecutrho_ispresent=.TRUE.
CALL qes_init_basis(obj,TAGNAME,gamma_only_ispresent=gamma_only,gamma_only=gamma_only,ecutwfc=ecutwfc, &
ecutrho=ecutrho,ecutrho_ispresent=ecutrho_ispresent,fft_grid_ispresent=fft_grid_ispresent, &
fft_grid=grid_obj,fft_smooth_ispresent=fft_smooth_ispresent,fft_smooth=smooth_grid_obj, &
fft_box=box_obj,fft_box_ispresent=fft_box_ispresent)
!
IF (fft_grid_ispresent) CALL qes_reset_basisSetItem( grid_obj )
IF (fft_smooth_ispresent) CALL qes_reset_basisSetItem( smooth_grid_obj )
IF ( fft_box_ispresent ) CALL qes_reset_basisSetItem( box_obj )
!
!
!
END SUBROUTINE qexsd_init_basis
!-------------------------------------------------------------------------------------------
SUBROUTINE qexsd_init_electron_control( obj,diagonalization,mixing_mode,mixing_beta,&
conv_thr, mixing_ndim, max_nstep, tqr,&
diago_thr_init, diago_full_acc, diago_cg_maxiter,&
diago_david_ndim)
!-------------------------------------------------------------------------------------------
!
IMPLICIT NONE
!
TYPE(electron_control_type) :: obj
CHARACTER(LEN=*),INTENT(IN) :: diagonalization,mixing_mode
REAL(DP),INTENT(IN) :: mixing_beta, conv_thr, diago_thr_init
INTEGER,INTENT(IN) :: mixing_ndim,max_nstep,diago_cg_maxiter,&
diago_david_ndim
LOGICAL,INTENT(IN) :: diago_full_acc,tqr
!
CHARACTER(LEN=*),PARAMETER :: TAGNAME="electron_control"
!
CALL qes_init_electron_control(obj,TAGNAME,diagonalization=diagonalization,&
mixing_mode=mixing_mode,mixing_beta=mixing_beta,&
conv_thr=conv_thr,mixing_ndim=mixing_ndim,max_nstep=max_nstep,&
real_space_q=tqr,diago_thr_init=diago_thr_init,&
diago_full_acc=diago_full_acc,diago_cg_maxiter=diago_cg_maxiter)
!
END SUBROUTINE qexsd_init_electron_control
!
!
!-------------------------------------------------------------------------------------------------
SUBROUTINE qexsd_init_k_points_ibz(obj,k_points,calculation,nk1,nk2,nk3,s1,s2,s3,nk,xk,wk,alat,a1)
!
IMPLICIT NONE
!
TYPE (k_points_IBZ_type) :: obj
CHARACTER(LEN=*),INTENT(IN) :: k_points,calculation
INTEGER,INTENT(IN) :: nk1,nk2,nk3,s1,s2,s3,nk
REAL(DP),INTENT(IN) :: xk(:,:),wk(:)
REAL(DP),INTENT(IN) :: alat,a1(3)
!
CHARACTER(LEN=*),PARAMETER :: TAGNAME="k_points_IBZ"
TYPE(monkhorst_pack_type) :: mpack_obj
TYPE(k_point_type),ALLOCATABLE :: kp_obj(:)
LOGICAL :: mpack_ispresent,kp_ispresent
CHARACTER(LEN=100) :: kind_of_grid
INTEGER :: kdim,ik,jk,kcount
REAL(DP),DIMENSION(3) :: my_xk
REAL(DP) :: scale_factor
!
IF (TRIM(k_points).EQ."automatic") THEN
!
IF ((s1+s2+s3).EQ.0) THEN
kind_of_grid="Monkhorst-Pack"
ELSE
kind_of_grid="Uniform grid with offset"
END IF
CALL qes_init_monkhorst_pack(mpack_obj,"monkhorst_pack",nk1,nk2,nk3,&
s1,s2,s3,kind_of_grid)
CALL qes_init_k_points_IBZ(obj,TAGNAME,monkhorst_pack_ispresent=.TRUE.,&
monkhorst_pack=mpack_obj,nk_ispresent=.FALSE.,&
nk=0,k_point_ispresent=.FALSE.,ndim_k_point=0,k_point=kp_obj)
CALL qes_reset_monkhorst_pack(mpack_obj)
ELSE
scale_factor=alat/sqrt(a1(1)*a1(1)+a1(2)*a1(2)+a1(3)*a1(3))
!
IF (TRIM(calculation).NE.'bands' .AND. (TRIM(k_points).EQ.'tpiba_b' .OR. &
TRIM(k_points) .EQ. 'crystal_b')) THEN
kdim=NINT(sum(wk(1:nk-1)))+1
ALLOCATE (kp_obj(kdim))
kcount=1
CALL qes_init_k_point(kp_obj(kcount),"k_point",1.d0,.TRUE.,xk(:,1))
kcount=kcount+1
DO ik=1,nk-1
DO jk=1,NINT(wk(ik))
my_xk=xk(:,ik)+(DBLE(jk)/wk(ik))*(xk(:,ik+1)-xk(:,ik))
my_xk=my_xk*scale_factor
CALL qes_init_k_point(kp_obj(kcount),"k_point",1.d0,.TRUE.,my_xk)
kcount=kcount+1
END DO
END DO
ELSE
kdim=nk
ALLOCATE (kp_obj(kdim))
DO ik=1,kdim
my_xk=xk(:,ik)*scale_factor
CALL qes_init_k_point(kp_obj(ik),"k_point",wk(ik),.TRUE.,my_xk)
END DO
END IF
CALL qes_init_k_points_IBZ(obj,TAGNAME,monkhorst_pack_ispresent=.FALSE.,&
monkhorst_pack=mpack_obj,nk_ispresent=.TRUE.,nk=kdim,&
k_point_ispresent=.TRUE.,ndim_k_point=kdim,k_point=kp_obj)
DO ik = 1,kdim
CALL qes_reset_k_point(kp_obj(ik))
END DO
DEALLOCATE (kp_obj)
END IF
END SUBROUTINE qexsd_init_k_points_ibz
!
!
!--------------------------------------------------------------------------------------------------
SUBROUTINE qexsd_init_ion_control(obj,ion_dynamics,upscale,remove_rigid_rot,&
refold_pos,pot_extrapolation,wfc_extrapolation,&
ion_temperature,tempw,tolp,delta_t,nraise,dt,&
bfgs_ndim,trust_radius_min,trust_radius_max,&
trust_radius_init,w_1,w_2)
!--------------------------------------------------------------------------------------------------
!
IMPLICIT NONE
!
TYPE (ion_control_type) :: obj
CHARACTER(LEN=*),INTENT(IN) :: ion_dynamics,pot_extrapolation,wfc_extrapolation,&
ion_temperature
REAL(DP),INTENT(IN) :: upscale,tempw,tolp,delta_t,trust_radius_min,trust_radius_max,&
trust_radius_init,w_1,w_2
INTEGER,INTENT(IN) :: nraise,bfgs_ndim
REAL(DP),INTENT(IN) :: dt
LOGICAL,INTENT(IN) :: remove_rigid_rot,refold_pos
!
!
TYPE(md_type) :: md_obj
TYPE(bfgs_type) :: bfgs_obj
CHARACTER(LEN=*),PARAMETER :: TAGNAME="ion_control"
LOGICAL :: bfgs_ispresent,md_ispresent
!
!
IF (TRIM(ion_dynamics)=="bfgs") THEN
bfgs_ispresent=.TRUE.
md_ispresent= .FALSE.
CALL qes_init_bfgs(bfgs_obj,"bfgs",ndim=bfgs_ndim,trust_radius_min=trust_radius_min,&
trust_radius_max=trust_radius_max,trust_radius_init=trust_radius_init,&
w1=w_1,w2=w_2)
ELSE IF(TRIM(ion_dynamics)=="verlet" .OR. TRIM(ion_dynamics)=="langevin" .OR. &
TRIM(ion_dynamics) == "langevin-smc" ) THEN
bfgs_ispresent=.FALSE.
md_ispresent=.TRUE.
CALL qes_init_md(md_obj,"md",pot_extrapolation=pot_extrapolation,&
wfc_extrapolation=wfc_extrapolation,ion_temperature=ion_temperature,&
tolp=tolp,timestep=dt,deltaT=delta_t,nraise=nraise,tempw=tempw)
ELSE
bfgs_ispresent=.FALSE.
md_ispresent =.FALSE.
END IF
CALL qes_init_ion_control(obj,TAGNAME,ion_dynamics=TRIM(ion_dynamics),upscale_ispresent=bfgs_ispresent,&
upscale=upscale,remove_rigid_rot_ispresent=.true.,&
remove_rigid_rot=remove_rigid_rot,refold_pos_ispresent=.TRUE.,&
refold_pos=refold_pos,bfgs_ispresent=bfgs_ispresent,bfgs=bfgs_obj,&
md_ispresent=md_ispresent,md=md_obj)
IF (bfgs_ispresent) CALL qes_reset_bfgs(bfgs_obj)
IF (md_ispresent) CALL qes_reset_md(md_obj)
!
END SUBROUTINE qexsd_init_ion_control
!
!
!------------------------------------------------------------------------------------------
SUBROUTINE qexsd_init_cell_control(obj,cell_dynamics,wmass,cell_factor,cell_dofree,iforceh)
!------------------------------------------------------------------------------------------
!
IMPLICIT NONE
!
TYPE (cell_control_type) :: obj
CHARACTER(LEN=*),INTENT(IN) :: cell_dynamics,cell_dofree
REAL(DP),INTENT(IN) :: wmass,cell_factor
INTEGER,DIMENSION(3,3),INTENT(IN) :: iforceh
!
CHARACTER(LEN=*),PARAMETER :: TAGNAME="cell_control"
INTEGER,DIMENSION(3,3) :: my_forceh
!
LOGICAL :: fix_volume=.FALSE.,&
fix_volume_ispresent=.FALSE.,&
fix_area=.FALSE.,&
fix_area_ispresent=.FALSE.,&
isotropic=.FALSE.,&
isotropic_ispresent=.FALSE.,&
free_cell_ispresent=.TRUE.
INTEGER :: i,j
TYPE(integerMatrix_type) :: free_cell_obj
!
FORALL (i=1:3,j=1:3) my_forceh(i,j) = iforceh(i,j)
IF (TRIM(cell_dofree)=='default') THEN
free_cell_ispresent=.FALSE.
my_forceh=1
ELSE IF (TRIM(cell_dofree)=='all' ) THEN
my_forceh=1
ELSE IF (TRIM(cell_dofree)=='shape') THEN
fix_volume=.TRUE.
fix_volume_ispresent=.TRUE.
ELSE IF ( TRIM(cell_dofree)=='2Dshape') THEN
fix_area = .TRUE.
fix_area_ispresent=.TRUE.
ELSE IF (TRIM(cell_dofree)=='volume') THEN
isotropic=.TRUE.
isotropic_ispresent=.TRUE.
END IF
IF (free_cell_ispresent) CALL qes_init_integerMatrix(free_cell_obj,"free_cell",3,3,my_forceh)
!
CALL qes_init_cell_control(obj,TAGNAME,cell_dynamics=cell_dynamics,wmass_ispresent=.TRUE.,&
wmass=wmass,cell_factor_ispresent=.TRUE.,cell_factor=cell_factor,&
fix_volume_ispresent=fix_volume_ispresent,fix_volume=fix_volume,&
fix_area_ispresent=fix_area_ispresent,fix_area=fix_area,&
isotropic_ispresent=isotropic_ispresent,isotropic=isotropic,&
free_cell_ispresent=free_cell_ispresent,free_cell=free_cell_obj)
IF( free_cell_ispresent ) CALL qes_reset_integerMatrix(free_cell_obj)
END SUBROUTINE qexsd_init_cell_control
!
!
!-------------------------------------------------------------------------------------------
SUBROUTINE qexsd_init_symmetry_flags(obj,nosym,nosym_evc,noinv,no_t_rev,force_symmorphic,&
use_all_frac)
!-------------------------------------------------------------------------------------------
!
IMPLICIT NONE
!
TYPE ( symmetry_flags_type) :: obj
LOGICAL,INTENT(IN) :: nosym,nosym_evc,noinv,no_t_rev,&
force_symmorphic,use_all_frac
!
CHARACTER(LEN=*),PARAMETER :: TAGNAME="symmetry_flags"
CALL qes_init_symmetry_flags(obj,TAGNAME,nosym=nosym,nosym_evc=nosym_evc,noinv=noinv,&
no_t_rev=no_t_rev,force_symmorphic=force_symmorphic,&
use_all_frac=use_all_frac)
!
END SUBROUTINE qexsd_init_symmetry_flags
!
!
!--------------------------------------------------------------------------------------------
SUBROUTINE qexsd_init_boundary_conditions(obj,assume_isolated,esm_bc,esm_nfit,esm_w,&
esm_efield)
!--------------------------------------------------------------------------------------------
!
IMPLICIT NONE
!
TYPE (boundary_conditions_type) :: obj
CHARACTER(LEN=*),INTENT(IN) :: assume_isolated,esm_bc
INTEGER,INTENT(IN) :: esm_nfit
REAL(DP),INTENT(IN) :: esm_w,esm_efield
!
TYPE (esm_type) :: esm_obj
CHARACTER(LEN=*),PARAMETER :: TAGNAME="boundary_conditions"
!
CALL qes_init_esm(esm_obj,"esm",bc=TRIM(esm_bc),nfit=esm_nfit,w=esm_w,efield=esm_efield)
CALL qes_init_boundary_conditions(obj,TAGNAME,assume_isolated=assume_isolated,&
esm=esm_obj)
CALL qes_reset_esm(esm_obj)
END SUBROUTINE qexsd_init_boundary_conditions
!
!
!--------------------------------------------------------------------------------------
SUBROUTINE qexsd_init_ekin_functional(obj,ecfixed,qcutz,q2sigma)
!--------------------------------------------------------------------------------------
!
IMPLICIT NONE
!
TYPE (ekin_functional_type) :: obj
REAL(DP),INTENT(IN) :: ecfixed,qcutz,q2sigma
!
CHARACTER(LEN=*),PARAMETER :: TAGNAME="ekin_functional"
CALL qes_init_ekin_functional(obj,TAGNAME,ecfixed=ecfixed,qcutz=qcutz,q2sigma=q2sigma)
END SUBROUTINE qexsd_init_ekin_functional
!
!
!---------------------------------------------------------------------------------
SUBROUTINE qexsd_init_external_atomic_forces(obj,extfor,nat)
!
TYPE(matrix_type) :: obj
REAL(DP),DIMENSION(:,:),INTENT(IN) :: extfor
INTEGER,INTENT(IN) :: nat
!
CHARACTER(LEN=*),PARAMETER :: TAGNAME="external_atomic_forces"
!
CALL qes_init_matrix(obj,TAGNAME,ndim1_mat=3,ndim2_mat=nat,mat=extfor)
END SUBROUTINE qexsd_init_external_atomic_forces
!
!
!-------------------------------------------------------------------------------
SUBROUTINE qexsd_init_free_positions(obj,if_pos,nat)
!
IMPLICIT NONE
!
TYPE(integerMatrix_type) :: obj
INTEGER,DIMENSION(:,:),INTENT(IN) :: if_pos
INTEGER,INTENT(IN) :: nat
!
CHARACTER(LEN=*),PARAMETER :: TAGNAME = "free_positions"
REAL(DP),DIMENSION(:,:),ALLOCATABLE :: free_positions
!
CALL qes_init_integerMatrix(obj,TAGNAME,ndim1_int_mat=3,ndim2_int_mat=nat,int_mat=if_pos(:,1:nat))
END SUBROUTINE qexsd_init_free_positions
!
!----------------------------------------------------------------------------------
SUBROUTINE qexsd_init_starting_atomic_velocities(obj,tv0rd,rd_vel,nat)
!----------------------------------------------------------------------------------
!
IMPLICIT NONE
!
TYPE (matrix_type) :: obj
LOGICAL,INTENT(IN) :: tv0rd
REAL(DP),DIMENSION(:,:),INTENT(IN) :: rd_vel
INTEGER,INTENT(IN) :: nat
!
CHARACTER(LEN=*),PARAMETER :: TAGNAME="starting_atomic_velocities"
INTEGER :: xdim=0,ydim=0
IF (tv0rd) THEN
xdim=3
ydim=nat
END IF
CALL qes_init_matrix(obj,TAGNAME,xdim,ydim,rd_vel)
END SUBROUTINE qexsd_init_starting_atomic_velocities
!
!-------------------------------------------------------------------------------------
SUBROUTINE qexsd_init_spin_constraints(obj,constrained_magnetization,lambda,&
fixed_magnetization)
!-------------------------------------------------------------------------------------
!
IMPLICIT NONE
!
TYPE(spin_constraints_type) :: obj
CHARACTER(LEN=*),INTENT(IN) :: constrained_magnetization
REAL(DP),INTENT(IN) :: lambda
REAL(DP),DIMENSION(3),OPTIONAL,INTENT(IN) :: fixed_magnetization
!
CHARACTER(LEN=*),PARAMETER :: TAGNAME="spin_constraints"
REAL(DP),DIMENSION(3) :: target_magnetization=0.d0
!
IF (PRESENT(fixed_magnetization)) target_magnetization=fixed_magnetization
CALL qes_init_spin_constraints(obj,TAGNAME,spin_constraints=TRIM(constrained_magnetization),&
target_magnetization_ispresent=PRESENT(fixed_magnetization), &
target_magnetization=target_magnetization,lagrange_multiplier=lambda)
END SUBROUTINE qexsd_init_spin_constraints
!
!
!-------------------------------------------------------------------------------------------------
SUBROUTINE qexsd_init_electric_field_input (obj,tefield,dipfield,lelfield,lberry,edir,gdir,emaxpos,eopreg,eamp, &
efield,efield_cart,nberrycyc,nppstr)
!---------------------------------------------------------------------------------------------------
!
IMPLICIT NONE
!
TYPE (electric_field_type) :: obj
LOGICAL,INTENT(IN) :: tefield,lelfield,dipfield,lberry
INTEGER,INTENT(IN),OPTIONAL :: edir,gdir,nberrycyc,nppstr
REAL(DP),INTENT(IN),OPTIONAL :: emaxpos,eopreg,eamp
REAL(DP),INTENT(IN),OPTIONAL :: efield
REAL(DP),INTENT(IN),OPTIONAL,DIMENSION(3) :: efield_cart
!
CHARACTER(LEN=*),PARAMETER :: TAGNAME="electric_field",&
SAWTOOTH="sawtooth_potential",&
HOMOGENEOUS="homogenous_electric_field",&
BERRYPHASE="Berry_Phase"
REAL(DP) :: emaxpos_loc=0.d0,eopreg_loc=0.d0,electric_field_amplitude=0.d0
REAL(DP),DIMENSION(3) :: efield_cart_loc=0.d0
INTEGER :: electric_field_direction,nberrycyc_loc=0,nppstr_loc=0
CHARACTER(LEN=256) :: electric_potential
LOGICAL :: dir_ispresent=.FALSE., amp_ispresent= .FALSE.,&
nberrycyc_ispresent=.FALSE.,nppstr_ispresent=.FALSE., &
electric_field_ispresent = .FALSE.
!
IF (tefield) THEN
electric_potential=SAWTOOTH
emaxpos_loc=emaxpos
eopreg_loc=eopreg
electric_field_amplitude=eamp
electric_field_direction=edir
dir_ispresent=.TRUE.
amp_ispresent=.TRUE.
ELSE IF (lelfield) THEN
electric_potential=HOMOGENEOUS
nberrycyc_loc = nberrycyc
nberrycyc_ispresent = .TRUE.
nppstr_loc = nppstr
nppstr_ispresent = .TRUE.
IF (PRESENT(efield_cart)) THEN
efield_cart_loc=efield_cart
electric_field_ispresent = .TRUE.
END IF
IF (PRESENT(efield)) THEN
electric_field_amplitude = efield
amp_ispresent = .TRUE.
END IF
IF ( gdir .GT. 0 ) THEN
dir_ispresent = .TRUE.
electric_field_direction = gdir
END IF
ELSE IF (lberry) THEN
electric_potential=BERRYPHASE
nberrycyc_loc=nberrycyc
nppstr_ispresent = .TRUE.
nppstr_loc = nppstr
IF ( gdir .GT. 0) THEN
dir_ispresent=.TRUE.
electric_field_direction = gdir
END IF
END IF
CALL qes_init_electric_field( obj, TAGNAME, electric_potential=electric_potential, &
dipole_correction_ispresent=dipfield, dipole_correction = dipfield, &
electric_field_direction_ispresent= dir_ispresent, &
electric_field_direction=electric_field_direction,&
potential_max_position_ispresent=tefield, potential_max_position=emaxpos_loc, &
potential_decrease_width = eopreg_loc, potential_decrease_width_ispresent=tefield, &
electric_field_amplitude=electric_field_amplitude, &
electric_field_amplitude_ispresent=amp_ispresent, &
electric_field_vector = efield_cart_loc, &
electric_field_vector_ispresent= electric_field_ispresent, &
n_berry_cycles_ispresent=nberrycyc_ispresent,n_berry_cycles=nberrycyc_loc,&
nk_per_string_ispresent=nppstr_ispresent,nk_per_string=nppstr_loc )
END SUBROUTINE qexsd_init_electric_field_input
!
!----------------------------------------------------------------------------------------------------------
SUBROUTINE qexsd_init_atomic_constraints(obj,ion_dynamics,lconstrain,nconstr,constr_type,constr_tol, &
constr_target,constr)
!----------------------------------------------------------------------------------------------------------
!
IMPLICIT NONE
!
TYPE (atomic_constraints_type) :: obj
CHARACTER(LEN=*),INTENT(IN) :: ion_dynamics
LOGICAL,INTENT(IN) :: lconstrain
INTEGER,OPTIONAL,INTENT(IN) :: nconstr
REAL(DP),OPTIONAL,INTENT(IN) :: constr(:,:)
CHARACTER(LEN=*),OPTIONAL,INTENT(IN) :: constr_type(:)
REAL(DP),OPTIONAL,INTENT(IN) :: constr_target(:),constr_tol
!
CHARACTER(LEN=*),PARAMETER :: TAGNAME="atomic_constraints"
TYPE(atomic_constraint_type),ALLOCATABLE :: constr_objs(:)
INTEGER :: iconstr
!
!
ALLOCATE (constr_objs(nconstr))
DO iconstr=1,nconstr
CALL qes_init_atomic_constraint(constr_objs(iconstr),"atomic_constraint", constr_parms=constr(:,iconstr),&
constr_type=TRIM(constr_type(iconstr)),constr_target=constr_target(iconstr))
END DO
CALL qes_init_atomic_constraints(obj,TAGNAME,num_of_constraints=nconstr,ndim_atomic_constraint=nconstr, &
atomic_constraint=constr_objs,tolerance=constr_tol)
DO iconstr=1,nconstr
CALL qes_reset_atomic_constraint(constr_objs(iconstr))
END DO
DEALLOCATE (constr_objs)
END SUBROUTINE qexsd_init_atomic_constraints
!
!------------------------------------------------------------------------------------------------------------
END MODULE qexsd_input
#else
!
MODULE qexsd_input
IMPLICIT NONE
INTEGER :: dummy__
END MODULE qexsd_input
!
#endif

79
Modules/set_hubbard_n.f90 Normal file
View File

@ -0,0 +1,79 @@
!
! Copyright (C) 2001-2010 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 .
!
!---------------------------------------------------------------------------
FUNCTION set_hubbard_n( psd ) RESULT( hubbard_n )
!---------------------------------------------------------------------------
!
USE io_global, ONLY : stdout
!
IMPLICIT NONE
!
INTEGER :: hubbard_n
CHARACTER(LEN=2), INTENT(IN) :: psd
!
!
SELECT CASE( TRIM(ADJUSTL(psd)) )
!
! ... transition metals, 4-th row
!
CASE( 'Ti', 'V', 'Cr', 'Mn', 'Fe', 'Co', 'Ni', 'Cu', 'Zn')
hubbard_n=3
!
! ... transition metals, 5-th row
!
CASE( 'Zr', 'Nb', 'Mo', 'Tc', 'Ru', 'Rh', 'Pd', 'Ag', 'Cd')
hubbard_n=4
!
! ... transition metals, 6-th row
!
CASE( 'Hf', 'Ta', 'W', 'Re', 'Os', 'Ir', 'Pt', 'Au', 'Hg' )
!
hubbard_n = 5
!
!
! ... rare earths (lanthanoid)
!
CASE('Ce','Pr','Nd','Pm','Sm','Eu','Gd','Tb','Dy','Ho','Er','Tm','Yb','Lu' )
!
hubbard_n = 4
! ... rare earths (actinoids )
CASE ('Th','Pa','U', 'Np','Pu','Am','Cm','Bk','Cf','Es','Fm','Md','No','Lr' )
!
hubbard_n = 5
!
!
! ... other elements
!
CASE( 'H' )
!
hubbard_n = 1
!
CASE( 'C', 'N', 'O' )
!
hubbard_n = 2
!
CASE( 'As', 'Ga' )
!
hubbard_n = 3
!
CASE ( 'In' )
!
hubbard_n = 4
CASE DEFAULT
!
hubbard_n = -1
!
WRITE( stdout, '(/,"psd = ",A,/)' ) psd
!
CALL errore( 'set_hubbard_l', 'pseudopotential not yet inserted', 1 )
!
END SELECT
!
RETURN
!
END FUNCTION set_Hubbard_n

2
PW/src/Makefile
View File

@ -162,6 +162,8 @@ print_clock_pw.o \
print_ks_energies.o \
punch.o \
pw_restart.o \
add_qexsd_step.o \
pw_init_qexsd_input.o \
pwcom.o \
pw2blip.o \
pw2casino.o \

40
PW/src/add_efield.f90
View File

@ -256,3 +256,43 @@ SUBROUTINE add_efield(vpoten,etotefield,rho,iflag)
RETURN
END SUBROUTINE add_efield
!
!------------------------------------------------------------------------------------------------
SUBROUTINE init_dipole_info (dipole_info, rho)
!------------------------------------------------------------------------------------------------
!
USE kinds, ONLY : DP
USE constants, ONLY : e2, fpi
USE qes_types_module,ONLY : dipoleOutput_type, scalarQuantity_type
USE qes_libs_module, ONLY : qes_init_scalarQuantity, qes_reset_scalarQuantity
USE extfield, ONLY : edir, eamp, emaxpos, eopreg
USE fft_base, ONLY : dfftp
USE lsda_mod, ONLY : nspin
USE cell_base, ONLY : alat, at, omega
!
IMPLICIT NONE
!
TYPE ( dipoleOutput_type ), INTENT(OUT) :: dipole_info
REAL(DP),INTENT(IN) :: rho(dfftp%nnr,nspin)
!
REAL(DP) :: ion_dipole, el_dipole, tot_dipole, length, vamp, fac
TYPE ( scalarQuantity_type) :: temp_qobj
!
CALL compute_ion_dip (emaxpos, eopreg, edir, ion_dipole)
CALL compute_el_dip ( emaxpos, eopreg, edir, rho, el_dipole )
tot_dipole = -el_dipole+ion_dipole
!
dipole_info%idir = edir
fac=omega/fpi
CALL qes_init_scalarQuantity(dipole_info%ion_dipole,"ion_dipole" , units="Atomic Units", scalarQuantity= ion_dipole*fac)
CALL qes_init_scalarQuantity(dipole_info%elec_dipole,"elec_dipole" , units="Atomic Units", scalarQuantity= el_dipole*fac)
CALL qes_init_scalarQuantity(dipole_info%dipole,"dipole" , units="Atomic Units", scalarQuantity= tot_dipole*fac)
CALL qes_init_scalarQuantity(dipole_info%dipoleField,"dipoleField" , units="Atomic Units", scalarQuantity= tot_dipole)
!
length=(1._DP-eopreg)*(alat*SQRT(at(1,edir)**2+at(2,edir)**2+at(3,edir)**2))
vamp=e2*(eamp-tot_dipole)*length
!
CALL qes_init_scalarQuantity(dipole_info%potentialAmp,"potentialAmp" , units="Atomic Units", scalarQuantity= vamp)
CALL qes_init_scalarQuantity(dipole_info%totalLength, "totalLength", units = "Bohr", scalarQuantity = length )
END SUBROUTINE init_dipole_info

54
PW/src/add_qexsd_step.f90 Normal file
View File

@ -0,0 +1,54 @@
!
! Copyright (C) 2013 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 .
!
! This routine just calls the routint qexsd_step_addstep which adds a new xml
! element to to the list of step run by pw. In this way the addstep routine in
! the qexsd_step_addstep routine does not depend on global variables.
! P. Delugas April 2016
!----------------------------------------------------------------
SUBROUTINE add_qexsd_step(i_step)
!-----------------------------------------------------------------
!
!------------------------------------------------------------------------
! START_GLOBAL_VARIABLES ( INTENT (IN) )
!--------------------------------------------------------------------------
USE ions_base, ONLY: tau, nat, nsp, atm, ityp
USE cell_base, ONLY: alat, at
USE ener, ONLY: etot, eband, ehart, etxc, vtxc, ewld, demet
USE klist, ONLY: degauss
USE force_mod, ONLY: force, sigma
USE control_flags,ONLY: nstep, n_scf_steps, scf_error
!-----------------------------------------------------------------------------
! END_GLOBAL_VARIABLES
!-----------------------------------------------------------------------------
!
!-------------------------------------------------------------------------------
! SUBROUTINES FROM MODULES
!-------------------------------------------------------------------------------
#ifdef __XSD
USE qexsd_module, ONLY: qexsd_step_addstep
#endif
!-------------------------------------------------------------------------------
!------------------------------------------------------------------------------
IMPLICIT NONE
!
!-------------------------------------------------------------------------------
! START_INPUT_VARIABLES
!-------------------------------------------------------------------------------
INTEGER,INTENT(IN) :: i_step
!-------------------------------------------------------------------------------
! END_INPUT_VARIABLES
!--------------------------------------------------------------------------------
!
#ifdef __XSD
CALL qexsd_step_addstep ( i_step, nstep, nsp, atm, ityp, nat, tau, alat, at(:,1), &
at(:,2), at(:,3), etot, eband, ehart, vtxc, etxc, &
ewld, degauss, demet, force, sigma, n_scf_steps, &
scf_error)
#endif
END SUBROUTINE add_qexsd_step

16
PW/src/bp_c_phase.f90
View File

@ -174,7 +174,9 @@ SUBROUTINE c_phase
USE spin_orb, ONLY : lspinorb
USE mp_bands, ONLY : intra_bgrp_comm, nproc_bgrp
USE mp, ONLY : mp_sum
#ifdef __XSD
USE qexsd_module, ONLY : qexsd_init_berryPhaseOutput, qexsd_bp_obj
#endif
! --- Avoid implicit definitions ---
IMPLICIT NONE
@ -954,7 +956,17 @@ SUBROUTINE c_phase
! --- End of information relative to polarization calculation ---
WRITE( stdout,"(/,/,15X,50('=')/,/)")
!------------------------------------------------------------------------------
! INITIALIZE QEXSD OUTPUT ELEMENT
! Here we write all output information in a berry_phase_type variable to print
! them in the XML output P.D. april 2016
!------------------------------------------------------------------------------
#ifdef __XSD
CALL qexsd_init_berryPhaseOutput(qexsd_bp_obj, gpar, gvec, nppstr, nkort, xk, pdl_ion, mod_ion, &
pdl_ion_tot, mod_ion_tot, nstring, pdl_elec , mod_elec, wstring, &
pdl_elec_up, mod_elec_up, pdl_elec_dw, mod_elec_dw, pdl_elec_tot,&
mod_elec_tot, pdl_tot, mod_tot, upol, rmod)
#endif
! ------------------------------------------------------------------------- !
! finalization !
! ------------------------------------------------------------------------- !

18
PW/src/input.f90
View File

@ -291,9 +291,24 @@ SUBROUTINE iosys()
!
USE input_parameters, ONLY : deallocate_input_parameters
USE wyckoff, ONLY : nattot, sup_spacegroup
#ifdef __XSD
USE qexsd_module, ONLY : input
USE qes_types_module, ONLY: input_type
!
IMPLICIT NONE
!
INTERFACE
SUBROUTINE pw_init_qexsd_input(obj,obj_tagname)
IMPORT :: input_type
TYPE(input_type) :: obj
CHARACTER(LEN=*),INTENT(IN) :: obj_tagname
END SUBROUTINE
END INTERFACE
#else
!
IMPLICIT NONE
!
#endif
CHARACTER(LEN=256), EXTERNAL :: trimcheck
INTEGER, EXTERNAL :: read_config_from_file
!
@ -1523,6 +1538,9 @@ SUBROUTINE iosys()
!
! ... End of reading input parameters
!
#ifdef __XSD
CALL pw_init_qexsd_input(input,obj_tagname="input")
#endif
CALL deallocate_input_parameters ()
!
! ... Initialize temporary directory(-ies)

9
PW/src/make.depend
View File

@ -1353,6 +1353,7 @@ pw2casino_write.o : ldaU.o
pw2casino_write.o : pw2blip.o
pw2casino_write.o : pwcom.o
pw2casino_write.o : scf_mod.o
pw_restart.o : ../../Modules/bfgs_module.o
pw_restart.o : ../../Modules/cell_base.o
pw_restart.o : ../../Modules/constants.o
pw_restart.o : ../../Modules/control_flags.o
@ -1360,6 +1361,7 @@ pw_restart.o : ../../Modules/electrons_base.o
pw_restart.o : ../../Modules/fft_base.o
pw_restart.o : ../../Modules/funct.o
pw_restart.o : ../../Modules/gvecw.o
pw_restart.o : ../../Modules/input_parameters.o
pw_restart.o : ../../Modules/io_files.o
pw_restart.o : ../../Modules/io_global.o
pw_restart.o : ../../Modules/ions_base.o
@ -1375,17 +1377,21 @@ pw_restart.o : ../../Modules/mp_pools.o
pw_restart.o : ../../Modules/mp_world.o
pw_restart.o : ../../Modules/noncol.o
pw_restart.o : ../../Modules/parser.o
pw_restart.o : ../../Modules/paw_variables.o
pw_restart.o : ../../Modules/qes_module.o
pw_restart.o : ../../Modules/qexml.o
pw_restart.o : ../../Modules/qexml_xsd.o
pw_restart.o : ../../Modules/qexsd.o
pw_restart.o : ../../Modules/recvec.o
pw_restart.o : ../../Modules/run_info.o
pw_restart.o : ../../Modules/tsvdw.o
pw_restart.o : ../../Modules/uspp.o
pw_restart.o : ../../Modules/version.o
pw_restart.o : ../../Modules/wavefunctions.o
pw_restart.o : ../../Modules/xml_io_base.o
pw_restart.o : ../../iotk/src/iotk_module.o
pw_restart.o : acfdt_in_pw.o
pw_restart.o : atomic_wfc_mod.o
pw_restart.o : bp_mod.o
pw_restart.o : buffers.o
pw_restart.o : esm.o
pw_restart.o : exx.o
@ -1397,6 +1403,7 @@ pw_restart.o : realus.o
pw_restart.o : scf_mod.o
pw_restart.o : start_k.o
pw_restart.o : symm_base.o
pw_restart.o : xdm_dispersion.o
pwcom.o : ../../Modules/cell_base.o
pwcom.o : ../../Modules/constants.o
pwcom.o : ../../Modules/kind.o

341
PW/src/pw_init_qexsd_input.f90 Normal file
View File

@ -0,0 +1,341 @@
! Copyright (C) 2002-2015 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 .
!
!
#ifdef __XSD
!--------------------------------------------------------------------------------------------------------------------
SUBROUTINE pw_init_qexsd_input(obj,obj_tagname)
!--------------------------------------------------------------------------------------------------------------------
! This routine builds an XML input file, taking the values from the variables
! contained in input_parameters MODULE. To work correctly it must be called before
! the iosys routine deallocates the input parameters. As the data contained
! in XML input are organized differently from those in provided by namelist
! input, for some values we need some information from other PW modules.
!---------------------------------------------------------------------------
! first version march 2016
!---------------------------------------------------------------------------
USE input_parameters, ONLY: title, calculation, restart_mode, prefix, pseudo_dir, outdir, tstress, tprnfor, &
wf_collect, disk_io, max_seconds, conv_thr, etot_conv_thr, forc_conv_thr, &
press_conv_thr,verbosity, iprint, ntyp, &
atm => atom_label, psfile => atom_pfile, amass => atom_mass, starting_magnetization, &
angle1, angle2, ip_nat => nat, ip_nspin => nspin, ip_ityp => sp_pos, ip_tau => rd_pos,&
ip_atomic_positions => atomic_positions, lspinorb, ip_nqx1 => nqx1, ip_nqx2 => nqx2, &
ip_nqx3 => nqx3, ip_ecutfock => ecutfock, ip_ecutvcut => ecutvcut, &
screening_parameter, exx_fraction, x_gamma_extrapolation, exxdiv_treatment, &
ip_lda_plus_u=>lda_plus_u, ip_lda_plus_u_kind => lda_plus_u_kind, &
ip_hubbard_u => hubbard_u, ip_hubbard_j0 => hubbard_j0, &
ip_hubbard_beta => hubbard_beta, ip_hubbard_alpha => hubbard_alpha, &
ip_hubbard_j => hubbard_j, starting_ns_eigenvalue, u_projection_type, &
london_s6, london_rcut, london_c6, xdm_a1, xdm_a2, &
ip_noncolin => noncolin, ip_spinorbit => lspinorb, &
nbnd, smearing, degauss, ip_occupations=>occupations, tot_charge, &
ip_k_points => k_points, ecutwfc, ip_ecutrho => ecutrho, ip_nr1 => nr1, ip_nr2=>nr2, &
ip_nr3 => nr3, ip_nr1s => nr1s, ip_nr2s => nr2s,ip_nr3s => nr3s, ip_nr1b=>nr1b, &
ip_nr2b=>nr2b, ip_nr3b => nr3b, &
ip_diagonalization=>diagonalization, mixing_mode, mixing_beta, &
mixing_ndim, tqr, electron_maxstep, diago_thr_init, diago_full_acc, diago_cg_maxiter, &
diago_david_ndim, &
nk1, nk2, nk3, k1, k2, k3, nkstot, ip_xk => xk, ip_wk => wk, &
ion_dynamics, upscale, remove_rigid_rot, refold_pos, pot_extrapolation, &
wfc_extrapolation, ion_temperature, tempw, tolp, delta_t, nraise, ip_dt => dt, &
bfgs_ndim, trust_radius_min, trust_radius_max, trust_radius_ini, w_1, w_2, &
cell_dynamics, wmass, cell_dofree, cell_factor, &
ip_nosym => nosym, ip_noinv => noinv, ip_nosym_evc => nosym_evc, &
ip_no_t_rev => no_t_rev, ip_force_symmorphic => force_symmorphic, &
ip_use_all_frac=>use_all_frac, assume_isolated, esm_bc, esm_w, esm_nfit, esm_efield, &
ecfixed, qcutz, q2sigma, &
tforces, rd_for, &
if_pos, &
tionvel, rd_vel, &
tefield, lelfield, dipfield, edir, emaxpos, eamp, eopreg, efield, efield_cart,gdir, &
lberry,nppstr,nberrycyc, &
nconstr_inp, nc_fields, constr_type_inp, constr_target_inp, constr_inp, tconstr, &
constr_tol_inp, constrained_magnetization, lambda, fixed_magnetization, input_dft, &
tf_inp
!
USE fixed_occ, ONLY: f_inp
!
USE kinds, ONLY: DP
USE parameters, ONLY: ntypx
USE constants, ONLY: e2,bohr_radius_angs
USE ions_base, ONLY: iob_tau=>tau
USE cell_base, ONLY: cb_at => at, cb_alat => alat, cb_iforceh => iforceh
USE funct, ONLY: get_dft_is_hybrid => dft_is_hybrid, get_inlc, get_dft_index, &
get_dft_is_nonlocc => dft_is_nonlocc, get_nonlocc_name, get_dft_short
USE uspp_param, ONLY: upf
USE qes_module
USE qexsd_module, ONLY: qexsd_init_atomic_species, qexsd_init_atomic_structure, qexsd_init_dft
USE qexsd_input
IMPLICIT NONE
!
TYPE (input_type),INTENT(OUT) :: obj
CHARACTER(len=*),INTENT(IN) :: obj_tagname
!
CHARACTER(80) :: tau_units,dft_name, diagonalization
CHARACTER(256) :: tagname
REAL(DP),ALLOCATABLE :: tau(:,:)
REAL(DP) :: alat,a1(3),a2(3),a3(3)
INTEGER :: inlc,nt
REAL(DP),POINTER :: ns_null(:,:,:,:)=>NULL()
COMPLEX(DP),POINTER :: ns_nc_null(:,:,:,:)=>NULL()
LOGICAL :: lsda,dft_is_hybrid,dft_is_nonlocc,is_hubbard(ntypx)=.FALSE.
INTEGER :: Hubbard_l=0,Hubbard_lmax=0
INTEGER :: iexch, icorr, igcx, igcc, imeta, my_vec(6)
INTEGER,EXTERNAL :: set_hubbard_l
INTEGER :: lung,l
CHARACTER,EXTERNAL :: capital
CHARACTER(len=20) :: dft_shortname
CHARACTER(len=25) :: dft_longname
!
!
obj%tagname=TRIM(obj_tagname)
!
!------------------------------------------------------------------------------------------------------------------------
! CONTROL VARIABLES ELEMENT
!------------------------------------------------------------------------------------------------------------------------
CALL qexsd_init_control_variables(obj%control_variables,title=title,calculation=calculation, &
restart_mode=restart_mode,prefix=prefix,pseudo_dir=pseudo_dir,outdir=outdir, &
stress=tstress,forces=tprnfor, wf_collect=wf_collect,disk_io=disk_io, &
max_seconds=max_seconds,etot_conv_thr=etot_conv_thr,forc_conv_thr=forc_conv_thr, &
press_conv_thr=press_conv_thr,verbosity=verbosity,iprint=iprint)
!------------------------------------------------------------------------------------------------------------------------
! ATOMIC SPECIES
!------------------------------------------------------------------------------------------------------------------------
IF ( ip_noncolin ) THEN
CALL qexsd_init_atomic_species(obj%atomic_species, ntyp,atm, psfile, amass, starting_magnetization, angle1, angle2)
ELSE IF (ip_nspin == 1 ) THEN
CALL qexsd_init_atomic_species(obj%atomic_species, ntyp,atm, psfile, amass)
ELSE IF (ip_nspin == 2 ) THEN
CALL qexsd_init_atomic_species(obj%atomic_species, ntyp,atm, psfile, amass, starting_magnetization)
END IF
!------------------------------------------------------------------------------------------------------------------------
! ATOMIC STRUCTURE
!------------------------------------------------------------------------------------------------------------------------
ALLOCATE (tau(3, ip_nat))
alat = cb_alat !*bohr_radius_angs
a1 = cb_at(:,1)*alat
a2 = cb_at(:,2)*alat
a3 = cb_at(:,3)*alat
tau(1:3,1:ip_nat) = iob_tau(1:3,1:ip_nat)*alat
tau_units="Bohr"
!tau=tau*bohr_radius_angs
!
CALL qexsd_init_atomic_structure (obj%atomic_structure, ntyp, atm, ip_ityp, ip_nat, tau, tau_units = tau_units, &
alat = sqrt(sum(a1(1:3)*a1(1:3))), a1 = a1,a2 = a2, a3 = a3)
DEALLOCATE ( tau )
!
!--------------------------------------------------------------------------------------------------------------------------
! DFT ELEMENT
!---------------------------------------------------------------------------------------------------------------------------
IF ( TRIM(input_dft) .NE. "none" ) THEN
dft_name=TRIM(input_dft)
ELSE
dft_shortname = get_dft_short()
dft_name=TRIM(dft_shortname)
END IF
dft_is_hybrid=get_dft_is_hybrid()
dft_is_nonlocc=get_dft_is_nonlocc()
!
IF (ip_lda_plus_u) THEN
IF ( ip_lda_plus_u .AND. ip_lda_plus_u_kind == 0 ) then
!
DO nt = 1, ntyp
!
is_hubbard(nt) = ip_Hubbard_U(nt)/= 0.0_dp .OR. &
ip_Hubbard_alpha(nt) /= 0.0_dp .OR. &
ip_Hubbard_J0(nt) /= 0.0_dp .OR. &
ip_Hubbard_beta(nt)/= 0.0_dp
!
IF ( is_hubbard(nt) ) THEN
Hubbard_l = set_Hubbard_l( upf(nt)%psd )
Hubbard_lmax = MAX( Hubbard_lmax, Hubbard_l )
END IF
!
END DO
!
ELSE IF ( ip_lda_plus_u_kind == 1 ) THEN
!
DO nt = 1, ntyp
is_hubbard(nt) = ip_Hubbard_U(nt)/= 0.0_dp .OR. &
ANY( ip_Hubbard_J(:,nt) /= 0.0_dp )
!
IF ( is_hubbard(nt) ) THEN
!
Hubbard_l = set_Hubbard_l( upf(nt)%psd )
Hubbard_lmax = MAX( Hubbard_lmax, Hubbard_l )
!
END IF
!
END DO
END IF
END IF
!
CALL qexsd_init_dft (obj%dft,TRIM(dft_name),dft_is_hybrid,ip_nqx1,ip_nqx2,ip_nqx3,ip_ecutfock,exx_fraction, &
screening_parameter,exxdiv_treatment, x_gamma_extrapolation, ip_ecutvcut, &
ip_lda_plus_U,ip_lda_plus_u_kind,2*hubbard_lmax+1,ip_nspin,ntyp,0,ip_nat,atm, &
ip_ityp,ip_hubbard_u,ip_hubbard_j0,ip_hubbard_alpha,ip_hubbard_beta,ip_hubbard_j, &
starting_ns_eigenvalue,ns_null,ns_nc_null,u_projection_type,dft_is_nonlocc, &
TRIM(get_nonlocc_name()),london_s6,london_rcut,xdm_a1,xdm_a2,is_hubbard,upf(1:ntyp)%psd)
!------------------------------------------------------------------------------------------------------------------------
! SPIN ELEMENT
!-------------------------------------------------------------------------------------------------------------------------
IF (ip_nspin == 2) THEN
lsda=.TRUE.
ELSE
lsda=.FALSE.
END IF
CALL qexsd_init_spin(obj%spin, lsda, ip_noncolin, ip_spinorbit)
!-------------------------------------------------------------------------------------------------------------------------
! BANDS ELEMENT
!-------------------------------------------------------------------------------------------------------------------------
IF (tf_inp) THEN
print '("le occupazioni da input sono",20f10.6)',f_inp
SELECT CASE (ip_nspin)
CASE (2)
CALL qexsd_init_bands(obj%bands, nbnd, smearing, degauss, ip_occupations, tot_charge, ip_nspin, &
input_occupations=f_inp(:,1),input_occupations_minority=f_inp(:,2))
CASE default
CALL qexsd_init_bands(obj%bands, nbnd, smearing, degauss, ip_occupations, tot_charge, ip_nspin, &
input_occupations=f_inp(:,1) )
END SELECT
ELSE
CALL qexsd_init_bands(obj%bands, nbnd, smearing, degauss, ip_occupations, tot_charge, ip_nspin)
END IF
!----------------------------------------------------------------------------------------------------------------------------
! BASIS ELEMENT
!---------------------------------------------------------------------------------------------------------------------------
CALL qexsd_init_basis(obj%basis, ip_k_points, ecutwfc, ip_ecutrho, ip_nr1, ip_nr2, ip_nr3, ip_nr1s, ip_nr2s, ip_nr3s,&
ip_nr1b, ip_nr2b,ip_nr3b)
!-----------------------------------------------------------------------------------------------------------------------------
! ELECTRON CONTROL
!------------------------------------------------------------------------------------------------------------------------------
IF (TRIM(ip_diagonalization) == 'david') THEN
diagonalization = 'davidson'
ELSE
diagonalization = ip_diagonalization
END IF
CALL qexsd_init_electron_control(obj%electron_control, diagonalization, mixing_mode, mixing_beta, conv_thr, &
mixing_ndim, electron_maxstep, tqr, diago_thr_init, diago_full_acc, &
diago_cg_maxiter, diago_david_ndim )
!--------------------------------------------------------------------------------------------------------------------------------
! K POINTS IBZ ELEMENT
!------------------------------------------------------------------------------------------------------------------------------
CALL qexsd_init_k_points_ibz( obj%k_points_ibz, ip_k_points, calculation, nk1, nk2, nk3, k1, k2, k3, nkstot, ip_xk, &
ip_wk,alat,a1)
!--------------------------------------------------------------------------------------------------------------------------------
! ION CONTROL ELEMENT
!--------------------------------------------------------------------------------------------------------------------------------
CALL qexsd_init_ion_control(obj%ion_control, ion_dynamics, upscale, remove_rigid_rot, refold_pos, &
pot_extrapolation, wfc_extrapolation, ion_temperature, tempw, tolp, delta_t, nraise, &
ip_dt, bfgs_ndim, trust_radius_min, trust_radius_max, trust_radius_ini, w_1, w_2)
!--------------------------------------------------------------------------------------------------------------------------------
! CELL CONTROL ELEMENT
!-------------------------------------------------------------------------------------------------------------------------------
CALL qexsd_init_cell_control(obj%cell_control, cell_dynamics, wmass, cell_factor, cell_dofree, cb_iforceh)
!---------------------------------------------------------------------------------------------------------------------------------
! SYMMETRY FLAGS
!------------------------------------------------------------------------------------------------------------------------
obj%symmetry_flags_ispresent = .TRUE.
CALL qexsd_init_symmetry_flags(obj%symmetry_flags, ip_nosym,ip_nosym_evc, ip_noinv, ip_no_t_rev, &
ip_force_symmorphic, ip_use_all_frac)
!------------------------------------------------------------------------------------------------------------------------
! BOUNDARY CONDITIONS
!----------------------------------------------------------------------------------------------------------------------------
IF (TRIM( assume_isolated ) .EQ. "none" ) THEN
obj%boundary_conditions_ispresent=.FALSE.
ELSE
obj%boundary_conditions_ispresent = .TRUE.
CALL qexsd_init_boundary_conditions(obj%boundary_conditions, assume_isolated, esm_bc,esm_nfit, esm_w,esm_efield)
END IF
!----------------------------------------------------------------------------------------------------------------------------
! EKIN FUNCTIONAL
!-------------------------------------------------------------------------------------------------------------------------------
IF (ecfixed .GT. 1.d-3) THEN
obj%ekin_functional_ispresent = .TRUE.
CALL qexsd_init_ekin_functional ( obj%ekin_functional, ecfixed, qcutz, q2sigma)
ELSE
obj%ekin_functional_ispresent = .FALSE.
END IF
!-----------------------------------------------------------------------------------------------------------------------------
! EXTERNAL FORCES
!------------------------------------------------------------------------------------------------------------------------------
IF ( tforces ) THEN
obj%external_atomic_forces_ispresent = .TRUE.
CALL qexsd_init_external_atomic_forces (obj%external_atomic_forces, rd_for,ip_nat)
ELSE
obj%external_atomic_forces_ispresent= .FALSE.
END IF
!-------------------------------------------------------------------------------------------------------------------------------
! FREE POSITIONS
!----------------------------------------------------------------------------------------------------------------------------
IF ( TRIM(calculation) .NE. "scf" .AND. TRIM(calculation) .NE. "nscf" .AND. &
TRIM(calculation) .NE. "bands") THEN
obj%free_positions_ispresent=.TRUE.
CALL qexsd_init_free_positions( obj%free_positions, if_pos, ip_nat)
ELSE
obj%free_positions_ispresent = .FALSE.
END IF
!----------------------------------------------------------------------------------------------------------------------------
! STARTING IONIC VELOCITIES
!-----------------------------------------------------------------------------------------------------------------------------
IF (tionvel) THEN
obj%starting_atomic_velocities_ispresent=.TRUE.
CALL qexsd_init_starting_atomic_velocities(obj%starting_atomic_velocities,tionvel,rd_vel,ip_nat)
ELSE
obj%starting_atomic_velocities_ispresent=.FALSE.
END IF
!-------------------------------------------------------------------------------------------------------------------------------
! ELECTRIC FIELD
!---------------------------------------------------------------------------------------------------------------------------
IF (tefield .OR. lelfield .OR. lberry ) THEN
obj%electric_field_ispresent=.TRUE.
CALL qexsd_init_electric_field_input(obj%electric_field, tefield, dipfield, lelfield, lberry, edir, gdir, &
emaxpos, eopreg, eamp, efield, efield_cart, nberrycyc, nppstr )
ELSE
obj%electric_field_ispresent=.FALSE.
END IF
!-----------------------------------------------------------------------------------------------------------------------
! ATOMIC CONSTRAINTS
!------------------------------------------------------------------------------------------------------------------------
IF (tconstr) THEN
obj%atomic_constraints_ispresent=.TRUE.
CALL qexsd_init_atomic_constraints( obj%atomic_constraints, ion_dynamics, tconstr, nconstr_inp,constr_type_inp, &
constr_tol_inp, constr_target_inp, constr_inp)
ELSE
obj%atomic_constraints_ispresent=.FALSE.
END IF
!-----------------------------------------------------------------------------------------------------------------------------
! SPIN CONSTRAINTS
!------------------------------------------------------------------------------------------------------------------------------
SELECT CASE (TRIM( constrained_magnetization ))
CASE ("total","total direction")
obj%spin_constraints_ispresent=.TRUE.
CALL qexsd_init_spin_constraints(obj%spin_constraints, constrained_magnetization,lambda,&
fixed_magnetization)
CASE ("atomic", "atomic direction")
obj%spin_constraints_ispresent=.TRUE.
CALL qexsd_init_spin_constraints(obj%spin_constraints, constrained_magnetization, lambda )
CASE default
obj%spin_constraints_ispresent=.FALSE.
END SELECT
obj%lread=.TRUE.
obj%lwrite=.TRUE.
!
!
END SUBROUTINE pw_init_qexsd_input
!
#else
!
SUBROUTINE pw_init_qexsd_input()
print *,"This is just a stub"
END SUBROUTINE
#endif

366
PW/src/pw_restart.f90
View File

@ -18,10 +18,17 @@ MODULE pw_restart
USE iotk_module
!
#ifdef __XSD
USE qexml_xsd_module, ONLY : qexml_init_schema, qexml_openschema, qexml_closeschema, qexml_write_convergence_info, qexml_write_output
USE qexml_xsd_module, ONLY : convergence_info_type, output_type, scf_conv_type
USE qes_module
USE qexsd_module, ONLY: qexsd_init_schema, qexsd_openschema, qexsd_closeschema, &
qexsd_init_convergence_info, qexsd_init_algorithmic_info, &
qexsd_init_atomic_species, qexsd_init_atomic_structure, &
qexsd_init_symmetries, qexsd_init_basis_set, qexsd_init_dft, &
qexsd_init_magnetization,qexsd_init_band_structure, &
qexsd_init_total_energy,qexsd_init_forces,qexsd_init_stress, &
qexsd_init_outputElectricField
#endif
USE qexml_module,ONLY : qexml_init,qexml_openfile, qexml_closefile, &
USE qexml_module, ONLY: qexml_init,qexml_openfile, qexml_closefile, &
qexml_write_header, qexml_write_control , &
qexml_write_cell, qexml_write_moving_cell, &
qexml_write_ions, qexml_write_symmetry, &
@ -38,20 +45,18 @@ MODULE pw_restart
qexml_read_bands_info, qexml_read_bands_pw, qexml_read_symmetry, &
qexml_read_efield, qexml_read_para, qexml_read_exx, qexml_read_esm
!
USE xml_io_base, ONLY : rho_binary,read_wfc, write_wfc, create_directory
USE xml_io_base, ONLY : rho_binary,read_wfc, write_wfc, create_directory
!
!
USE kinds, ONLY : DP
USE constants, ONLY : e2, PI
!
#ifdef __XSD
USE io_files, ONLY : tmp_dir, prefix, iunpun, iunpun_xsd, xmlpun, xmlpun_schema, &
delete_if_present, qexml_version, qexml_version_init, pseudo_dir
#else
USE io_files, ONLY : tmp_dir, prefix, iunpun, xmlpun, delete_if_present, &
qexml_version, qexml_version_init, pseudo_dir
USE io_files, ONLY : iunpun_xsd, xmlpun_schema
#endif
USE io_files, ONLY : tmp_dir, prefix, iunpun, xmlpun, delete_if_present, &
qexml_version, qexml_version_init, pseudo_dir
!
USE io_global, ONLY : ionode, ionode_id
USE mp_images, ONLY : intra_image_comm
USE mp_pools, ONLY : my_pool_id
@ -90,24 +95,27 @@ MODULE pw_restart
!
!
CONTAINS
!
!
#ifdef __XSD
!------------------------------------------------------------------------
SUBROUTINE pw_write_schema( what )
!------------------------------------------------------------------------
!
USE control_flags, ONLY : twfcollect, conv_ions, &
USE control_flags, ONLY : istep, twfcollect, conv_ions, &
lscf, lkpoint_dir, gamma_only, &
tqr, noinv, do_makov_payne, smallmem, &
llondon, lxdm, ts_vdw
llondon, lxdm, ts_vdw, scf_error, n_scf_steps
USE realus, ONLY : real_space
USE uspp, ONLY : okvan
USE paw_variables, ONLY : okpaw
USE uspp_param, ONLY : upf
USE global_version, ONLY : version_number
USE cell_base, ONLY : at, bg, alat, tpiba, tpiba2, &
ibrav, celldm
USE gvect, ONLY : ig_l2g
USE ions_base, ONLY : nsp, ityp, atm, nat, tau, if_pos
USE noncollin_module, ONLY : noncolin, npol
USE io_files, ONLY : nwordwfc, iunwfc, psfile
USE io_files, ONLY : nwordwfc, iunwfc, iunigk, psfile
USE buffers, ONLY : get_buffer
USE wavefunctions_module, ONLY : evc
USE klist, ONLY : nks, nkstot, xk, ngk, wk, qnorm, &
@ -121,23 +129,28 @@ MODULE pw_restart
USE basis, ONLY : natomwfc
USE gvecs, ONLY : ngms_g, dual
USE fft_base, ONLY : dffts
USE wvfct, ONLY : npw, npwx, et, wg, igk, nbnd
USE ener, ONLY : ef, ef_up, ef_dw
USE wvfct, ONLY : npw, npwx, g2kin, et, wg, &
igk, nbnd
USE ener, ONLY : ef, ef_up, ef_dw, vtxc, etxc, ewld, etot, &
ehart, eband, demet
USE gvecw, ONLY : ecutwfc
USE fixed_occ, ONLY : tfixed_occ, f_inp
USE ldaU, ONLY : lda_plus_u, lda_plus_u_kind, U_projection, &
Hubbard_lmax, Hubbard_l, Hubbard_U, Hubbard_J, &
Hubbard_alpha, Hubbard_J0, Hubbard_beta
Hubbard_alpha, Hubbard_J0, Hubbard_beta,&
is_hubbard
USE spin_orb, ONLY : lspinorb, domag
USE symm_base, ONLY : nrot, nsym, invsym, s, ft, irt, &
t_rev, sname, time_reversal, no_t_rev
USE lsda_mod, ONLY : nspin, isk, lsda, starting_magnetization
USE noncollin_module, ONLY : angle1, angle2, i_cons, mcons, bfield, &
USE lsda_mod, ONLY : nspin, isk, lsda, starting_magnetization, magtot, absmag
USE noncollin_module, ONLY : angle1, angle2, i_cons, mcons, bfield, magtot_nc, &
lambda
USE ions_base, ONLY : amass
USE funct, ONLY : get_dft_name, get_inlc
USE funct, ONLY : get_dft_name, get_inlc, get_nonlocc_name, dft_is_nonlocc
USE kernel_table, ONLY : vdw_table_name
USE scf, ONLY : rho
USE extfield, ONLY : tefield, dipfield, edir, &
USE force_mod, ONLY : lforce, sumfor, force, sigma, lstres
USE extfield, ONLY : tefield, dipfield, edir, etotefield, &
emaxpos, eopreg, eamp
USE io_rho_xml, ONLY : write_rho
USE mp_world, ONLY : nproc
@ -157,13 +170,22 @@ MODULE pw_restart
USE esm, ONLY : do_comp_esm, esm_nfit, esm_efield, esm_w, &
esm_a, esm_bc
USE london_module, ONLY : scal6, lon_rcut
USE xdm_module, ONLY : xdm_a1=>a1i, xdm_a2=>a2i
USE tsvdw_module, ONLY : vdw_isolated
USE input_parameters, ONLY : space_group, verbosity, calculation, ion_dynamics, starting_ns_eigenvalue
USE bp, ONLY : lelfield, lberry, bp_mod_el_pol => el_pol, bp_mod_ion_pol => ion_pol
!
USE rap_point_group, ONLY : elem, nelem, name_class
USE rap_point_group_so, ONLY : elem_so, nelem_so, name_class_so
USE bfgs_module, ONLY : bfgs_get_n_iter
USE qexsd_module, ONLY : qexsd_dipol_obj, qexsd_bp_obj
!
IMPLICIT NONE
!
CHARACTER(LEN=*), INTENT(IN) :: what
!
CHARACTER(15) :: subname="pw_write_schema"
CHARACTER(LEN=20) :: dft_name
CHARACTER(LEN=256) :: dirname, filename
INTEGER :: i, ig, ik, ngg, ierr, ipol, num_k_points
@ -173,75 +195,293 @@ MODULE pw_restart
INTEGER, ALLOCATABLE :: igk_l2g(:,:), igk_l2g_kdip(:,:), mill_g(:,:)
LOGICAL :: lwfc, lrho, lxsd
CHARACTER(iotk_attlenx) :: attr
!
! the following variables are just to test the new xml output
INTEGER :: iclass, isym, ielem
CHARACTER(LEN=15) :: symop_2_class(48)
LOGICAL :: opt_conv_ispresent
INTEGER :: n_opt_steps
!
TYPE(output_type) :: output
!
TYPE(convergence_info_type) :: convergence_info
! PW dimensions need to be properly computed
! reducing across MPI tasks
!
TYPE(scf_conv_type) :: scf_conv
!
scf_conv%n_scf_steps=8
scf_conv%scf_error=0.0000001
convergence_info%scf_conv=scf_conv
output%convergence_info=convergence_info
!
IF ( ionode ) THEN
IF ( nkstot > 0 ) THEN
!
! ... look for an empty unit (only ionode needs it)
! ... find out the number of pools
!
CALL iotk_free_unit( iunout, ierr )
npool = nproc_image / nproc_pool
!
! ... find out number of k points blocks
!
nkbl = nkstot / kunit
!
! ... k points per pool
!
nkl = kunit * ( nkbl / npool )
!
! ... find out the reminder
!
nkr = ( nkstot - nkl * npool ) / kunit
!
! ... Assign the reminder to the first nkr pools
!
IF ( my_pool_id < nkr ) nkl = nkl + kunit
!
! ... find out the index of the first k point in this pool
!
iks = nkl*my_pool_id + 1
!
IF ( my_pool_id >= nkr ) iks = iks + nkr*kunit
!
! ... find out the index of the last k point in this pool
!
ike = iks + nkl - 1
!
END IF
ALLOCATE( ngk_g( nkstot ) )
!
CALL mp_bcast( ierr, ionode_id, intra_image_comm )
ngk_g = 0
ngk_g(iks:ike) = ngk(1:nks)
!
CALL errore( 'pw_writefile ', &
'no free units to write wavefunctions', ierr )
CALL mp_sum( ngk_g, inter_pool_comm)
CALL mp_sum( ngk_g, intra_pool_comm)
!
ngk_g = ngk_g / nbgrp
!
! ... compute the maximum number of G vector among all k points
!
npwx_g = MAXVAL( ngk_g(1:nkstot) )
!
!DEALLOCATE( ngk_g )
! do not deallocate ngk_g here, please, I need it for band_structure_init
! P. Delugas
!
! ... find out the global number of G vectors: ngm_g
!
ngm_g = ngm
CALL mp_sum( ngm_g, intra_bgrp_comm )
!
IF (tefield .AND. dipfield ) THEN
CALL init_dipole_info(qexsd_dipol_obj, rho%of_r)
qexsd_dipol_obj%tagname = "dipoleInfo"
END IF
!
!
! XML descriptor
!
dirname = TRIM( tmp_dir ) // TRIM( prefix ) // '.save'
!
! ... create the main restart directory
CALL qexsd_init_schema( iunpun_xsd )
!
!
IF ( ionode ) THEN
!
! ... open XML descriptor
!
CALL qexml_init_schema( iunpun_xsd )
ierr=0
!
END IF
!
!
CALL mp_bcast( ierr, ionode_id, intra_image_comm )
!
CALL errore( 'pw_write_schema ', &
'cannot open restart file for writing', ierr )
!
IF ( ionode ) THEN
!
! ... here we start writing the punch-file
! ... here we init the variables and finally write them to file
!
!-------------------------------------------------------------------------------
! ... HEADER
!-------------------------------------------------------------------------------
!
CALL qexml_openschema(TRIM( dirname ) // '/' // TRIM( xmlpun_schema ))
CALL qexsd_openschema(TRIM( dirname ) // '/' // TRIM( xmlpun_schema ))
output%tagname="output"
!
!-------------------------------------------------------------------------------
! ... CONVERGENCE_INFO
!-------------------------------------------------------------------------------
!
! AF: convergence vars should be better traced
! n_opt_steps var still missing
!
SELECT CASE (TRIM( calculation ))
CASE ( "relax","vc-relax" )
opt_conv_ispresent = .TRUE.
IF (TRIM( ion_dynamics) == 'bfgs' ) THEN
n_opt_steps = bfgs_get_n_iter('bfgs_iter ')
ELSE
n_opt_steps = istep
END IF
CASE default
opt_conv_ispresent = .FALSE.
n_opt_steps = 0
END SELECT
!
call qexsd_init_convergence_info(output%convergence_info, &
n_scf_steps=n_scf_steps, scf_error=scf_error, &
opt_conv_ispresent=lforce, &
n_opt_steps=n_opt_steps, grad_norm=sumfor )
!
!-------------------------------------------------------------------------------
! ... ALGORITHMIC_INFO
!-------------------------------------------------------------------------------
!
CALL qexsd_init_algorithmic_info(output%algorithmic_info, &
real_space_q=real_space, uspp=okvan, paw=okpaw)
!
!-------------------------------------------------------------------------------
! ... ATOMIC_SPECIES
!-------------------------------------------------------------------------------
!
! while amass's are always present, starting_mag should not be passed
! for nspin==1 or contrained magnetization calculations
!
IF (noncolin) THEN
CALL qexsd_init_atomic_species(output%atomic_species, nsp, atm, psfile, &
amass, angle1=angle1,angle2=angle2)
ELSE IF (nspin==2) THEN
CALL qexsd_init_atomic_species(output%atomic_species, nsp, atm, psfile, &
amass,starting_magnetization=starting_magnetization)
ELSE
CALL qexsd_init_atomic_species(output%atomic_species, nsp, atm,psfile, &
amass)
END IF
!
!-------------------------------------------------------------------------------
! ... ATOMIC_STRUCTURE
!-------------------------------------------------------------------------------
!
CALL qexsd_init_atomic_structure(output%atomic_structure, nsp, atm, ityp, &
nat, tau, 'Bohr', alat, at(:,1), at(:,2), at(:,3) )
!
!-------------------------------------------------------------------------------
! ... SYMMETRIES
!-------------------------------------------------------------------------------
!
symop_2_class="not found"
IF (TRIM (verbosity) == 'medium' .OR. TRIM(verbosity) == 'high') THEN
IF ( noncolin ) THEN
symmetries_so_loop:DO isym = 1, nsym
classes_so_loop:DO iclass = 1, 24
elements_so_loop:DO ielem=1, nelem_so(iclass)
IF ( elem_so(ielem,iclass) == isym) THEN
symop_2_class(isym) = name_class_so(iclass)
EXIT symmetries_so_loop
END IF
END DO elements_so_loop
END DO classes_so_loop
END DO symmetries_so_loop
!
ELSE
symmetries_loop:DO isym = 1, nsym
classes_loop:DO iclass = 1, 12
elements_loop:DO ielem=1, nelem (iclass)
IF ( elem(ielem,iclass) == isym) THEN
symop_2_class(isym) = name_class(iclass)
EXIT classes_loop
END IF
END DO elements_loop
END DO classes_loop
END DO symmetries_loop
END IF
END IF
CALL qexsd_init_symmetries(output%symmetries, nsym, nrot, space_group, &
s, ft, sname, t_rev, nat, irt,symop_2_class(1:nsym), verbosity, &
noncolin)
!
!-------------------------------------------------------------------------------
! ... BASIS SET
!-------------------------------------------------------------------------------
!
CALL qexsd_init_basis_set(output%basis_set, gamma_only, ecutwfc, ecutwfc*dual, &
dfftp%nr1, dfftp%nr2, dfftp%nr3, dffts%nr1, dffts%nr2, dffts%nr3, &
.FALSE., dfftp%nr1, dfftp%nr2, dfftp%nr3, ngm_g, ngms_g, npwx_g, &
bg(:,1), bg(:,2), bg(:,3) )
!
!-------------------------------------------------------------------------------
! ... DFT
!-------------------------------------------------------------------------------
!
dft_name = get_dft_name()
inlc = get_inlc()
!
IF ( lda_plus_u .AND. noncolin) CALL errore(subname,"LDA+U and non-collinear case not implemented in qexsd",10)
!
CALL qexsd_init_dft(output%dft, dft_name, &
dft_is_hybrid(), nq1, nq2, nq3, ecutfock, &
get_exx_fraction(), get_screening_parameter(), exxdiv_treatment, &
x_gamma_extrapolation, ecutvcut, &
lda_plus_u, lda_plus_u_kind, 2*Hubbard_lmax+1, nspin, nsp, 2*Hubbard_lmax+1, nat, atm, ityp, &
Hubbard_U, Hubbard_J0, Hubbard_alpha, Hubbard_beta, Hubbard_J, &
starting_ns_eigenvalue, rho%ns, rho%ns_nc, U_projection, &
dft_is_nonlocc(), TRIM(get_nonlocc_name()), scal6, lon_rcut, xdm_a1, xdm_a2,is_hubbard,upf(1:nsp)%psd)
!
!-------------------------------------------------------------------------------
! ... MAGNETIZATION
!-------------------------------------------------------------------------------
!
CALL qexsd_init_magnetization(output%magnetization, lsda, noncolin, lspinorb, &
magtot, magtot_nc, absmag, domag )
!
!--------------------------------------------------------------------------------------
! ... BAND STRUCTURE
!-------------------------------------------------------------------------------------
!
CALL qexsd_init_band_structure(output%band_structure,lsda,noncolin,lspinorb, &
nbnd,nelec,ef,et,wg,nkstot,xk,ngk_g,wk)
!
!-------------------------------------------------------------------------------------------
! ... TOTAL ENERGY
!-------------------------------------------------------------------------------------------
!
IF (tefield) THEN
CALL qexsd_init_total_energy(output%total_energy,etot,eband,ehart,vtxc,etxc, &
ewld,degauss,demet, etotefield)
ELSE
CALL qexsd_init_total_energy(output%total_energy,etot,eband,ehart,vtxc,etxc, &
ewld,degauss,demet)
END IF
!
!---------------------------------------------------------------------------------------------
! ... FORCES
!----------------------------------------------------------------------------------------------
!
CALL qexsd_init_forces(output%forces,nat,force,lforce)
!
!------------------------------------------------------------------------------------------------
! ... STRESS
!------------------------------------------------------------------------------------------------
IF ( lstres) THEN
output%stress_ispresent=.TRUE.
CALL qexsd_init_stress(output%stress, sigma, lstres )
ELSE
output%stress_ispresent=.FALSE.
output%stress%lwrite=.FALSE.
END IF
!-------------------------------------------------------------------------------------------------
! ... ELECTRIC FIELD
!-------------------------------------------------------------------------------------------------
IF ( lelfield ) THEN
output%electric_field_ispresent = .TRUE.
CALL qexsd_init_outputElectricField(output%electric_field, lelfield, tefield, dipfield, &
lberry, el_pol = bp_mod_el_pol, ion_pol = bp_mod_ion_pol)
ELSE IF ( lberry ) THEN
output%electric_field_ispresent = .TRUE.
CALL qexsd_init_outputElectricField(output%electric_field, lelfield, tefield, dipfield, &
lberry, bp_obj=qexsd_bp_obj)
ELSE IF ( tefield .AND. dipfield ) THEN
output%electric_field_ispresent = .TRUE.
CALL qexsd_init_outputElectricField(output%electric_field, lelfield, tefield, dipfield, &
lberry, dipole_obj = qexsd_dipol_obj )
ELSE
output%electric_field_ispresent = .FALSE.
ENDIF
!------------------------------------------------------------------------------------------------
! ... ACTUAL WRITING
!-------------------------------------------------------------------------------
!
CALL qes_write_output(iunpun_xsd,output)
CALL qes_reset_output(output)
!
CALL qexml_write_output(output)
!-------------------------------------------------------------------------------
! ... CLOSING
!-------------------------------------------------------------------------------
!
CALL qexml_closeschema()
!
CALL errore( 'pw_write_schema ', &
'cannot write schema', ierr )
CALL qexsd_closeschema()
!
END IF
DEALLOCATE (ngk_g)
!
RETURN
!

1
PW/src/pwcom.f90
View File

@ -234,6 +234,7 @@ MODULE force_mod
!
REAL(DP), ALLOCATABLE :: &
force(:,:) ! the force on each atom
REAL(DP) :: sumfor ! norm of the force matrix (total force)
REAL(DP) :: &
sigma(3,3) ! the stress acting on the system
LOGICAL :: &

23
PW/src/run_pwscf.f90
View File

@ -40,7 +40,11 @@ SUBROUTINE run_pwscf ( exit_status )
USE fft_base, ONLY : dfftp
USE qmmm, ONLY : qmmm_initialization, qmmm_shutdown, &
qmmm_update_positions, qmmm_update_forces
#ifdef __XSD
USE qexsd_module, ONLY: qexsd_set_status
#endif
!
IMPLICIT NONE
INTEGER, INTENT(OUT) :: exit_status
INTEGER :: idone
@ -81,6 +85,9 @@ SUBROUTINE run_pwscf ( exit_status )
! ... useful for a quick and automated way to check input data
!
IF ( check_stop_now() ) THEN
#ifdef __XSD
CALL qexsd_set_status(255)
#endif
CALL punch( 'config' )
exit_status = 255
RETURN
@ -101,6 +108,9 @@ SUBROUTINE run_pwscf ( exit_status )
IF ( check_stop_now() .OR. .NOT. conv_elec ) THEN
IF ( check_stop_now() ) exit_status = 255
IF ( .NOT. conv_elec ) exit_status = 2
#ifdef __XSD
CALL qexsd_set_status(exit_status)
#endif
! workaround for the case of a single k-point
twfcollect = .FALSE.
CALL punch( 'config' )
@ -151,7 +161,12 @@ SUBROUTINE run_pwscf ( exit_status )
!
! ... then we save restart information for the new configuration
!
IF ( idone <= nstep .AND. .NOT. conv_ions ) CALL punch( 'config' )
IF ( idone <= nstep .AND. .NOT. conv_ions ) THEN
#ifdef __XSD
CALL qexsd_set_status(255)
#endif
CALL punch( 'config' )
END IF
!
END IF
!
@ -174,6 +189,9 @@ SUBROUTINE run_pwscf ( exit_status )
! ... update_pot initializes structure factor array as well
!
CALL update_pot()
#ifdef __XSD
CALL add_qexsd_step(idone)
#endif
!
! ... re-initialize atomic position-dependent quantities
!
@ -189,6 +207,9 @@ SUBROUTINE run_pwscf ( exit_status )
!
! ... save final data file
!
#ifdef __XSD
CALL qexsd_set_status(exit_status)
#endif
CALL punch('all')
!
CALL qmmm_shutdown()

2
test-suite/ENVIRONMENT
View File

@ -18,6 +18,6 @@ export REFERENCE_VERSION=v5.3.0
export ESPRESSO_ROOT=${PWD}/../
export ESPRESSO_PSEUDO=${ESPRESSO_ROOT}/pseudo
export ESPRESSO_TMPDIR=/tmp/save
export ESPRESSO_TMPDIR=./
export NETWORK_PSEUDO=http://www.quantum-espresso.org/wp-content/uploads/upf_files/
export TESTCODE_DIR=${ESPRESSO_ROOT}/test-suite/testcode

2
test-suite/pw_langevin/langevin_smc.in
View File

@ -33,4 +33,4 @@ ATOMIC_SPECIES
ATOMIC_POSITIONS (angstrom)
H 1.500000000 1.500000000 2.898689449 0 0 1
H 1.500000000 1.500000000 2.101310551 0 0 1
K_POINTS {gamma}

1
test-suite/pw_uspp/uspp1-coulomb.in
View File

@ -19,3 +19,4 @@ ATOMIC_POSITIONS (bohr)
O 10.0000 10.0000 10.000
H 11.7325 9.6757 10.000
H 9.6757 11.7325 10.000
K_POINTS Gamma

1
test-suite/pw_uspp/uspp1.in
View File

@ -19,3 +19,4 @@ ATOMIC_POSITIONS (bohr)
O 10.0000 10.0000 10.000
H 11.7325 9.6757 10.000
H 9.6757 11.7325 10.000
K_POINTS Gamma_only