mirror of https://gitlab.com/QEF/q-e.git
700 lines
32 KiB
Fortran
700 lines
32 KiB
Fortran
!
|
|
! Copyright (C) 2016-2019 Quantum ESPRESSO foundation
|
|
! 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 .
|
|
!
|
|
!---------------------------------------------------------
|
|
MODULE qexsd_input
|
|
!--------------------------------------------------------
|
|
!! This module contains the data structures for the XML input of pw.x
|
|
!! and the routines neeeded to initialise it
|
|
!----------------------------------------------------------------------------
|
|
!! First version March 2016, modified Aug. 2019
|
|
!----------- ------------- ---------------------------------------------------
|
|
USE kinds, ONLY : dp
|
|
!
|
|
USE qes_types_module
|
|
USE qes_libs_module
|
|
!
|
|
IMPLICIT NONE
|
|
!
|
|
PRIVATE
|
|
SAVE
|
|
!! input data structure
|
|
TYPE(input_type) :: qexsd_input_obj
|
|
PUBLIC :: qexsd_input_obj
|
|
!! routines for input data structure initialization
|
|
!! note that the data structure is passed as argument
|
|
PUBLIC :: &
|
|
qexsd_init_control_variables, &
|
|
qexsd_init_spin, &
|
|
qexsd_init_bands, &
|
|
qexsd_init_basis, &
|
|
qexsd_init_electron_control, &
|
|
qexsd_init_k_points_ibz, &
|
|
qexsd_init_ion_control, &
|
|
qexsd_init_cell_control, &
|
|
qexsd_init_symmetry_flags, &
|
|
qexsd_init_boundary_conditions, &
|
|
qexsd_init_ekin_functional, &
|
|
qexsd_init_external_atomic_forces, &
|
|
qexsd_init_free_positions, &
|
|
qexsd_init_starting_atomic_velocities, &
|
|
qexsd_init_spin_constraints, &
|
|
qexsd_init_electric_field_input, &
|
|
qexsd_init_atomic_constraints, &
|
|
qexsd_init_occupations, &
|
|
qexsd_init_smearing
|
|
!
|
|
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, nstep)
|
|
!---------------------------------------------------------------------------------------------------------------------
|
|
!
|
|
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, nstep
|
|
OPTIONAL :: nstep
|
|
!
|
|
!
|
|
CHARACTER(LEN=*),PARAMETER :: TAGNAME='control_variables'
|
|
CHARACTER(LEN=256) :: verbosity_value, disk_io_value
|
|
INTEGER :: int_max_seconds
|
|
LOGICAL :: nstep_ispresent
|
|
|
|
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 (obj,tagname,title=TRIM(title),calculation=TRIM(calculation),&
|
|
restart_mode=TRIM(restart_mode),prefix=TRIM(prefix), &
|
|
pseudo_dir=TRIM(pseudo_dir),outdir=TRIM(outdir),disk_io=TRIM(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, NSTEP = nstep )
|
|
|
|
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 (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, tot_mag)
|
|
!
|
|
IMPLICIT NONE
|
|
!
|
|
TYPE ( bands_type) :: obj
|
|
INTEGER,OPTIONAL, INTENT(IN) :: nbnd
|
|
INTEGER,INTENT(IN) :: nspin
|
|
CHARACTER(LEN=*),INTENT(IN) :: occupations,smearing
|
|
REAL(DP),INTENT(IN) :: degauss
|
|
REAL(DP),DIMENSION(:),OPTIONAL,INTENT(IN) :: input_occupations, input_occupations_minority
|
|
REAL(DP),OPTIONAL,INTENT(IN) :: tot_mag, tot_charge
|
|
!
|
|
INTEGER :: spin_degeneracy, inpOcc_size = 0
|
|
CHARACTER(LEN=*),PARAMETER :: TAGNAME="bands"
|
|
TYPE(smearing_type),POINTER :: smearing_obj => NULL()
|
|
TYPE(occupations_type) :: occup_obj
|
|
TYPE(inputoccupations_type),ALLOCATABLE :: inpOcc_objs(:)
|
|
LOGICAL :: tot_mag_ispresent = .FALSE., &
|
|
inp_occ_arepresent = .FALSE.
|
|
!
|
|
IF (TRIM(occupations) .EQ. "smearing") THEN
|
|
ALLOCATE(smearing_obj)
|
|
CALL qes_init (smearing_obj,"smearing",degauss=degauss,smearing=smearing)
|
|
END IF
|
|
CALL qes_init (occup_obj, "occupations", occupations = TRIM(occupations))
|
|
!
|
|
IF (PRESENT(input_occupations) ) THEN
|
|
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 ( inpOcc_objs(1),"input_occupations", ISPIN = 1, &
|
|
SPIN_FACTOR = 1._DP, INPUTOCCUPATIONS = input_occupations(2:nbnd) )
|
|
CALL qes_init ( inpOcc_objs(2),"input_occupations", 2, &
|
|
SPIN_FACTOR = 1._DP , INPUTOCCUPATIONS = input_occupations_minority(2:nbnd))
|
|
ELSE
|
|
CALL qes_init ( inpOcc_objs(1),"input_occupations", ISPIN = 1, SPIN_FACTOR = 2._DP , &
|
|
INPUTOCCUPATIONS = input_occupations(2:nbnd) )
|
|
END IF
|
|
END IF
|
|
!
|
|
CALL qes_init (obj, TAGNAME, NBND = nbnd, SMEARING = smearing_obj, TOT_CHARGE = tot_charge, &
|
|
TOT_MAGNETIZATION = tot_mag, OCCUPATIONS=occup_obj, INPUTOCCUPATIONS = inpOcc_objs )
|
|
IF (ASSOCIATED(smearing_obj)) THEN
|
|
CALL qes_reset (smearing_obj)
|
|
DEALLOCATE ( smearing_obj)
|
|
END IF
|
|
CALL qes_reset (occup_obj)
|
|
IF (ALLOCATED(inpOcc_objs)) THEN
|
|
CALL qes_reset (inpocc_objs(1))
|
|
IF (inpOcc_size .GT. 1 ) CALL qes_reset (inpocc_objs(2))
|
|
DEALLOCATE (inpocc_objs)
|
|
END IF
|
|
!
|
|
END SUBROUTINE qexsd_init_bands
|
|
!
|
|
!
|
|
!--------------------------------------------------------------------------------------------------------------------
|
|
SUBROUTINE qexsd_init_basis(obj,k_points,ecutwfc,ecutrho,nr,nrs,nrb)
|
|
!--------------------------------------------------------------------------------------------------------------------
|
|
!
|
|
IMPLICIT NONE
|
|
!
|
|
TYPE (basis_type) :: obj
|
|
CHARACTER(LEN=*),INTENT(IN) :: k_points
|
|
REAL(DP),INTENT(IN) :: ecutwfc
|
|
REAL(DP),OPTIONAL,INTENT(IN) :: ecutrho
|
|
INTEGER,OPTIONAL,INTENT(IN) :: nr(:), nrs(:), nrb(:)
|
|
!
|
|
TYPE(basisSetItem_type),POINTER :: grid_obj => NULL(), smooth_grid_obj => NULL(), box_obj => NULL()
|
|
CHARACTER(LEN=*),PARAMETER :: TAGNAME="basis",FFT_GRID="fft_grid",FFT_SMOOTH="fft_smooth", FFT_BOX="fft_box"
|
|
LOGICAL :: gamma_only=.FALSE.
|
|
!
|
|
IF ( PRESENT(nr)) THEN
|
|
ALLOCATE(grid_obj)
|
|
CALL qes_init (grid_obj,FFT_GRID,nr(1),nr(2),nr(3),"grid set in input")
|
|
END IF
|
|
!
|
|
IF( PRESENT(nrs)) THEN
|
|
ALLOCATE(smooth_grid_obj)
|
|
CALL qes_init (smooth_grid_obj,FFT_SMOOTH,nrs(1),nrs(2),nrs(3),"grid set in input")
|
|
END IF
|
|
!
|
|
IF( PRESENT(nrb)) THEN
|
|
ALLOCATE(box_obj)
|
|
CALL qes_init (box_obj,FFT_BOX,nrb(1),nrb(2),nrb(3),"grid set in input")
|
|
END IF
|
|
!
|
|
IF (TRIM(k_points) .EQ. "gamma" ) gamma_only=.TRUE.
|
|
|
|
CALL qes_init (obj,TAGNAME, GAMMA_ONLY=gamma_only,ECUTWFC=ecutwfc, ECUTRHO=ecutrho, FFT_GRID=grid_obj, &
|
|
FFT_SMOOTH=smooth_grid_obj, FFT_BOX=box_obj)
|
|
!
|
|
IF (ASSOCIATED(grid_obj)) CALL qes_reset( grid_obj )
|
|
IF (ASSOCIATED(smooth_grid_obj)) CALL qes_reset( smooth_grid_obj )
|
|
IF (ASSOCIATED(box_obj)) CALL qes_reset( 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, real_space, &
|
|
tq_smoothing, tbeta_smoothing, &
|
|
diago_thr_init, diago_full_acc, &
|
|
diago_cg_maxiter, diago_ppcg_maxiter, diago_david_ndim, &
|
|
diago_rmm_ndim, diago_rmm_conv, diago_gs_nblock)
|
|
!-------------------------------------------------------------------------------------------
|
|
!
|
|
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_ppcg_maxiter, diago_david_ndim, &
|
|
|
|
diago_rmm_ndim, diago_gs_nblock
|
|
LOGICAL,OPTIONAL,INTENT(IN) :: diago_full_acc,tqr, real_space, tq_smoothing, tbeta_smoothing, &
|
|
diago_rmm_conv
|
|
!
|
|
CHARACTER(LEN=*),PARAMETER :: TAGNAME="electron_control"
|
|
!
|
|
CALL qes_init (obj,TAGNAME, DIAGONALIZATION=diagonalization,&
|
|
MIXING_MODE=mixing_mode,MIXING_BETA=mixing_beta,&
|
|
CONV_THR=conv_thr,MIXING_NDIM=mixing_ndim,MAX_NSTEP=max_nstep,&
|
|
TQ_SMOOTHING= tq_smoothing, TBETA_SMOOTHING = tbeta_smoothing,&
|
|
REAL_SPACE_Q=tqr, REAL_SPACE_BETA = real_space, DIAGO_THR_INIT=diago_thr_init,&
|
|
DIAGO_FULL_ACC=diago_full_acc,DIAGO_CG_MAXITER=diago_cg_maxiter, &
|
|
DIAGO_PPCG_MAXITER=diago_ppcg_maxiter, &
|
|
DIAGO_RMM_NDIM=diago_rmm_ndim, DIAGO_RMM_CONV=diago_rmm_conv, &
|
|
DIAGO_GS_NBLOCK=diago_gs_nblock)
|
|
!
|
|
END SUBROUTINE qexsd_init_electron_control
|
|
!
|
|
!
|
|
!-------------------------------------------------------------------------------------------------
|
|
SUBROUTINE qexsd_init_k_points_ibz(obj,k_points,calculation,nk1,nk2,nk3,s1,s2,s3,nk,alat,a1, ibrav_lattice,xk,wk)
|
|
!
|
|
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), OPTIONAL :: xk(:,:),wk(:)
|
|
REAL(DP),INTENT(IN) :: alat,a1(3)
|
|
LOGICAL,INTENT(IN) :: ibrav_lattice
|
|
!
|
|
CHARACTER(LEN=*),PARAMETER :: TAGNAME="k_points_IBZ"
|
|
TYPE(monkhorst_pack_type),POINTER :: mpack_obj_pt => NULL()
|
|
TYPE(monkhorst_pack_type),TARGET :: mpack_obj_
|
|
TYPE(k_point_type),ALLOCATABLE :: kp_obj(:)
|
|
LOGICAL :: mpack_ispresent,kp_ispresent
|
|
CHARACTER(LEN=100) :: kind_of_grid
|
|
INTEGER :: ik,jk,kcount
|
|
REAL(DP),DIMENSION(3) :: my_xk
|
|
REAL(DP) :: scale_factor
|
|
INTEGER, POINTER :: kdim_opt => NULL()
|
|
INTEGER, TARGET :: kdim
|
|
!
|
|
|
|
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 (mpack_obj_,"monkhorst_pack",nk1,nk2,nk3, s1,s2,s3,kind_of_grid)
|
|
mpack_obj_pt => mpack_obj_
|
|
ELSE
|
|
kdim_opt => kdim
|
|
IF ( ibrav_lattice ) THEN
|
|
scale_factor = 1.d0
|
|
ELSE
|
|
scale_factor=alat/sqrt(a1(1)*a1(1)+a1(2)*a1(2)+a1(3)*a1(3))
|
|
END IF
|
|
!
|
|
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 (kp_obj(kcount),"k_point", WEIGHT = 1.d0, K_POINT = 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 (kp_obj(kcount),"k_point",WEIGHT = 1.d0, K_POINT = 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 (kp_obj(ik),"k_point", WEIGHT = wk(ik),K_POINT=my_xk)
|
|
END DO
|
|
END IF
|
|
END IF
|
|
CALL qes_init (obj, TAGNAME, MONKHORST_PACK = mpack_obj_pt, NK = kdim_opt , K_POINT = kp_obj)
|
|
IF (ASSOCIATED (mpack_obj_pt)) THEN
|
|
CALL qes_reset (mpack_obj_)
|
|
mpack_obj_pt => NULL()
|
|
ELSE IF (ALLOCATED(kp_obj)) THEN
|
|
DO ik = 1, kdim
|
|
CALL qes_reset(kp_obj(ik))
|
|
END DO
|
|
DEALLOCATE (kp_obj) ! this line is redundant because kp_obj is a local allocatable
|
|
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),OPTIONAL,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,OPTIONAL,INTENT(IN) :: remove_rigid_rot,refold_pos
|
|
!
|
|
!
|
|
TYPE(md_type),POINTER :: md_obj =>NULL()
|
|
TYPE(bfgs_type),POINTER :: bfgs_obj => NULL()
|
|
CHARACTER(LEN=*),PARAMETER :: TAGNAME="ion_control"
|
|
LOGICAL :: bfgs_ispresent,md_ispresent
|
|
!
|
|
!
|
|
IF (TRIM(ion_dynamics)=="bfgs") THEN
|
|
ALLOCATE (bfgs_obj)
|
|
CALL qes_init (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
|
|
ALLOCATE(md_obj)
|
|
CALL qes_init (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)
|
|
END IF
|
|
CALL qes_init (obj,TAGNAME,ion_dynamics=TRIM(ion_dynamics), UPSCALE=upscale, REMOVE_RIGID_ROT=remove_rigid_rot,&
|
|
REFOLD_POS=refold_pos, BFGS=bfgs_obj, MD=md_obj)
|
|
IF (ASSOCIATED(bfgs_obj)) THEN
|
|
CALL qes_reset (bfgs_obj)
|
|
DEALLOCATE(bfgs_obj)
|
|
END IF
|
|
IF (ASSOCIATED(md_obj)) THEN
|
|
CALL qes_reset (md_obj)
|
|
DEALLOCATE (md_obj)
|
|
END IF
|
|
!
|
|
END SUBROUTINE qexsd_init_ion_control
|
|
!
|
|
!
|
|
!------------------------------------------------------------------------------------------
|
|
SUBROUTINE qexsd_init_cell_control(obj,cell_dynamics, pressure, 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) :: pressure, 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_area=.FALSE.,&
|
|
isotropic=.FALSE.
|
|
INTEGER :: i,j
|
|
TYPE(integerMatrix_type),TARGET :: free_cell_obj
|
|
TYPE(integerMatrix_type),POINTER :: free_cell_ptr => NULL()
|
|
!
|
|
IF (ANY(iforceh /= 1)) THEN
|
|
free_cell_ptr => free_cell_obj
|
|
FORALL (i=1:3,j=1:3) my_forceh(i,j) = iforceh(i,j)
|
|
END IF
|
|
SELECT CASE (TRIM(cell_dofree))
|
|
CASE ('all')
|
|
my_forceh = 1
|
|
CASE ('shape')
|
|
fix_volume = .TRUE.
|
|
CASE ('2Dshape')
|
|
fix_area = .TRUE.
|
|
CASE ('volume')
|
|
isotropic = .TRUE.
|
|
!CASE default
|
|
!NULLIFY ( free_cell_ptr)
|
|
END SELECT
|
|
IF (ASSOCIATED (free_cell_ptr)) CALL qes_init (free_cell_obj,"free_cell",[3,3],my_forceh, ORDER = 'F' )
|
|
!
|
|
CALL qes_init (obj,TAGNAME, PRESSURE = pressure, CELL_DYNAMICS=cell_dynamics, WMASS=wmass, CELL_FACTOR=cell_factor,&
|
|
CELL_DO_FREE = cell_dofree)
|
|
IF( ASSOCIATED(free_cell_ptr)) CALL qes_reset (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 (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, fcp, fcp_mu)
|
|
!--------------------------------------------------------------------------------------------
|
|
!
|
|
IMPLICIT NONE
|
|
!
|
|
TYPE (boundary_conditions_type) :: obj
|
|
CHARACTER(LEN=*),INTENT(IN) :: assume_isolated
|
|
CHARACTER(LEN=*),OPTIONAL,INTENT(IN) :: esm_bc
|
|
LOGICAL,OPTIONAL,INTENT(IN) :: fcp
|
|
REAL(DP),OPTIONAL,INTENT(IN) :: fcp_mu
|
|
INTEGER,OPTIONAL,INTENT(IN) :: esm_nfit
|
|
REAL(DP),OPTIONAL,INTENT(IN) :: esm_w,esm_efield
|
|
!
|
|
TYPE (esm_type),POINTER :: esm_obj => NULL()
|
|
LOGICAL :: esm_ispresent = .FALSE.
|
|
CHARACTER(LEN=*),PARAMETER :: TAGNAME="boundary_conditions"
|
|
!
|
|
esm_ispresent = .FALSE.
|
|
!
|
|
IF ( TRIM(assume_isolated) .EQ. "esm" ) THEN
|
|
esm_ispresent = .TRUE.
|
|
ALLOCATE(esm_obj)
|
|
CALL qes_init (esm_obj, "esm", BC=TRIM(esm_bc), NFIT=esm_nfit, W=esm_w, EFIELD=esm_efield)
|
|
END IF
|
|
!
|
|
IF (esm_ispresent) THEN
|
|
IF (PRESENT(fcp)) THEN
|
|
CALL qes_init (obj, TAGNAME, ASSUME_ISOLATED=assume_isolated, ESM=esm_obj, FCP_OPT=fcp, FCP_MU=fcp_mu)
|
|
ELSE
|
|
CALL qes_init (obj, TAGNAME, ASSUME_ISOLATED=assume_isolated, ESM=esm_obj)
|
|
END IF
|
|
ELSE
|
|
CALL qes_init (obj, TAGNAME, ASSUME_ISOLATED=assume_isolated)
|
|
END IF
|
|
!
|
|
IF (esm_ispresent) THEN
|
|
CALL qes_reset (esm_obj)
|
|
DEALLOCATE(esm_obj)
|
|
END IF
|
|
!
|
|
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 (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 (obj,TAGNAME,[3,nat],mat=extfor, order = 'F' )
|
|
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 (obj,TAGNAME,DIMS = [3,nat], MAT = if_pos, ORDER = 'F' )
|
|
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 (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 (obj,TAGNAME,SPIN_CONSTRAINTS=TRIM(constrained_magnetization),&
|
|
TARGET_MAGNETIZATION=fixed_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, gate, zgate, relaxz, block, block_1, block_2, block_height )
|
|
!---------------------------------------------------------------------------------------------------
|
|
!
|
|
IMPLICIT NONE
|
|
!
|
|
TYPE (electric_field_type) :: obj
|
|
LOGICAL,INTENT(IN) :: tefield,lelfield, lberry
|
|
LOGICAL,OPTIONAL,INTENT(IN) :: dipfield
|
|
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
|
|
LOGICAL,INTENT(IN),OPTIONAL :: gate, block,relaxz
|
|
REAL(DP),INTENT(IN),OPTIONAL :: zgate,block_1, block_2, block_height
|
|
!
|
|
CHARACTER(LEN=*),PARAMETER :: TAGNAME="electric_field",&
|
|
SAWTOOTH="sawtooth_potential",&
|
|
HOMOGENEOUS="homogenous_field",&
|
|
BERRYPHASE="Berry_Phase"
|
|
REAL(DP),POINTER :: efield_cart_loc(:)=>NULL(), electric_field_amplitude=>NULL()
|
|
INTEGER,POINTER :: electric_field_direction => NULL()
|
|
CHARACTER(LEN=256) :: electric_potential
|
|
LOGICAL :: gate_, block_
|
|
REAL(DP) :: block_1_, block_2_, block_3_
|
|
TYPE(gate_settings_type),TARGET :: gata_settings_obj
|
|
TYPE(gate_settings_type),POINTER :: gata_settings_ptr => NULL()
|
|
TARGET :: eamp, edir, efield, gdir
|
|
!
|
|
electric_potential = "none"
|
|
IF (tefield) THEN
|
|
electric_potential=SAWTOOTH
|
|
electric_field_amplitude=>eamp
|
|
electric_field_direction=>edir
|
|
ELSE IF (lelfield) THEN
|
|
electric_potential=HOMOGENEOUS
|
|
IF (PRESENT(efield)) electric_field_amplitude => efield
|
|
IF ( gdir .GT. 0 ) electric_field_direction => gdir
|
|
ELSE IF (lberry) THEN
|
|
electric_potential=BERRYPHASE
|
|
IF ( gdir .GT. 0) electric_field_direction => gdir
|
|
END IF
|
|
IF (PRESENT (gate)) THEN
|
|
gata_settings_ptr => gata_settings_obj
|
|
CALL qes_init (gata_settings_obj, "gate_settings", gate, zgate, relaxz,&
|
|
block, block_1, block_2, block_height )
|
|
END IF
|
|
CALL qes_init ( obj, TAGNAME, electric_potential=electric_potential, dipole_correction = dipfield, &
|
|
electric_field_direction=electric_field_direction, potential_max_position = emaxpos, &
|
|
potential_decrease_width = eopreg, electric_field_amplitude=electric_field_amplitude,&
|
|
electric_field_vector = efield_cart, n_berry_cycles=nberrycyc, nk_per_string=nppstr, &
|
|
gate_settings = gata_settings_obj)
|
|
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 (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 (obj,TAGNAME, num_of_constraints=nconstr, atomic_constraint=constr_objs,tolerance=constr_tol)
|
|
DO iconstr=1,nconstr
|
|
CALL qes_reset (constr_objs(iconstr))
|
|
END DO
|
|
DEALLOCATE (constr_objs)
|
|
END SUBROUTINE qexsd_init_atomic_constraints
|
|
!
|
|
!------------------------------------------------------------------------------------------------------------
|
|
SUBROUTINE qexsd_init_occupations(obj, occupations, nspin)
|
|
!------------------------------------------------------------------------------------------------------------
|
|
!
|
|
IMPLICIT NONE
|
|
TYPE(occupations_type),INTENT(OUT) :: obj
|
|
CHARACTER(LEN=*),INTENT(IN) :: occupations
|
|
INTEGER,INTENT(IN) :: nspin
|
|
!
|
|
INTEGER :: spin_degeneracy
|
|
!
|
|
IF (nspin .GT. 1) THEN
|
|
spin_degeneracy = 1
|
|
ELSE
|
|
spin_degeneracy = 2
|
|
END IF
|
|
CALL qes_init (obj, "occupations", occupations = TRIM(occupations))
|
|
END SUBROUTINE qexsd_init_occupations
|
|
!
|
|
!---------------------------------------------------------
|
|
SUBROUTINE qexsd_init_smearing(obj, smearing, degauss)
|
|
!---------------------------------------------------------
|
|
!
|
|
IMPLICIT NONE
|
|
TYPE(smearing_type),INTENT(OUT) :: obj
|
|
CHARACTER(LEN = * ), INTENT(IN) :: smearing
|
|
REAL(DP),INTENT(IN) :: degauss
|
|
!
|
|
CALL qes_init (obj,"smearing",degauss=degauss,smearing=smearing)
|
|
!
|
|
END SUBROUTINE qexsd_init_smearing
|
|
!--------------------------------------------------------------------------------------------
|
|
!
|
|
END MODULE qexsd_input
|
|
|