array dummy arguments in initialization routines are now declared explicitely with their dimensions. The missing assignement of array dimensions have been added to the initialization routines of vectors, matrices and similar. ecutwfc and ecutrho are now correctly written in Hartree units, instead of Ry. Other minor corrections

git-svn-id: http://qeforge.qe-forge.org/svn/q-e/trunk/espresso@12583 c92efa57-630b-4861-b058-cf58834340f0
This commit is contained in:
pietrodelugas 2016-07-18 17:14:17 +00:00
parent 67a337a3c0
commit 1dedf42bb8
7 changed files with 135 additions and 77 deletions

View File

@ -702,9 +702,9 @@ SUBROUTINE qes_init_BerryPhaseOutput(obj, tagname, polarization, totalPhase, &
TYPE(polarization_type) :: polarization
TYPE(phase_type) :: totalPhase
INTEGER :: ndim_ionicPolarization
TYPE(ionicPolarization_type), DIMENSION(:) :: ionicPolarization
TYPE(ionicPolarization_type ), DIMENSION( ndim_ionicPolarization ) :: ionicPolarization
INTEGER :: ndim_electronicPolarization
TYPE(electronicPolarization_type), DIMENSION(:) :: electronicPolarization
TYPE(electronicPolarization_type ), DIMENSION( ndim_electronicPolarization ) :: electronicPolarization
obj%tagname = TRIM(tagname)
obj%polarization = polarization
@ -772,11 +772,12 @@ SUBROUTINE qes_init_vector(obj, tagname, ndim_vec, vec)
CHARACTER(len=*) :: tagname
INTEGER :: i
INTEGER :: ndim_vec
REAL(DP), DIMENSION(:) :: vec
REAL(DP), DIMENSION(ndim_vec) :: vec
obj%tagname = TRIM(tagname)
ALLOCATE(obj%vec(ndim_vec))
obj%vec(:) = vec(:)
obj%ndim_vec = ndim_vec
END SUBROUTINE qes_init_vector
@ -834,17 +835,19 @@ SUBROUTINE qes_init_ks_energies(obj, tagname, k_point, npw, ndim_eigenvalues, ei
TYPE(k_point_type) :: k_point
INTEGER :: npw
INTEGER :: ndim_eigenvalues
REAL(DP), DIMENSION(:) :: eigenvalues
REAL(DP), DIMENSION(ndim_eigenvalues) :: eigenvalues
INTEGER :: ndim_occupations
REAL(DP), DIMENSION(:) :: occupations
REAL(DP), DIMENSION(ndim_occupations) :: occupations
obj%tagname = TRIM(tagname)
obj%k_point = k_point
obj%npw = npw
ALLOCATE(obj%eigenvalues(ndim_eigenvalues))
obj%eigenvalues(:) = eigenvalues(:)
obj%ndim_eigenvalues = ndim_eigenvalues
ALLOCATE(obj%occupations(ndim_occupations))
obj%occupations(:) = occupations(:)
obj%ndim_occupations = ndim_occupations
END SUBROUTINE qes_init_ks_energies
@ -1087,7 +1090,7 @@ SUBROUTINE qes_init_equivalent_atoms(obj, tagname, nat, ndim_index_list, index_l
INTEGER :: i
INTEGER :: nat
INTEGER :: ndim_index_list
INTEGER, DIMENSION(:) :: index_list
INTEGER, DIMENSION(ndim_index_list) :: index_list
obj%tagname = TRIM(tagname)
@ -1095,6 +1098,7 @@ SUBROUTINE qes_init_equivalent_atoms(obj, tagname, nat, ndim_index_list, index_l
ALLOCATE(obj%index_list(ndim_index_list))
obj%index_list(:) = index_list(:)
obj%ndim_index_list = ndim_index_list
END SUBROUTINE qes_init_equivalent_atoms
@ -1226,6 +1230,8 @@ SUBROUTINE qes_init_matrix(obj, tagname, ndim1_mat, ndim2_mat, mat)
obj%tagname = TRIM(tagname)
ALLOCATE(obj%mat(ndim1_mat,ndim2_mat))
obj%mat(:,:) = mat(:,:)
obj%ndim1_mat = ndim1_mat
obj%ndim2_mat = ndim2_mat
END SUBROUTINE qes_init_matrix
@ -2129,7 +2135,7 @@ SUBROUTINE qes_init_atomic_constraints(obj, tagname, num_of_constraints, toleran
INTEGER :: num_of_constraints
REAL(DP) :: tolerance
INTEGER :: ndim_atomic_constraint
TYPE(atomic_constraint_type), DIMENSION(:) :: atomic_constraint
TYPE(atomic_constraint_type ), DIMENSION( ndim_atomic_constraint ) :: atomic_constraint
obj%tagname = TRIM(tagname)
obj%num_of_constraints = num_of_constraints
@ -2413,7 +2419,7 @@ SUBROUTINE qes_init_symmetries(obj, tagname, nsym, nrot, space_group, ndim_symme
INTEGER :: nrot
INTEGER :: space_group
INTEGER :: ndim_symmetry
TYPE(symmetry_type), DIMENSION(:) :: symmetry
TYPE(symmetry_type ), DIMENSION( ndim_symmetry ) :: symmetry
obj%tagname = TRIM(tagname)
obj%nsym = nsym
@ -2738,11 +2744,13 @@ SUBROUTINE qes_init_integerMatrix(obj, tagname, ndim1_int_mat, ndim2_int_mat, in
INTEGER :: i
INTEGER :: ndim1_int_mat
INTEGER :: ndim2_int_mat
INTEGER, DIMENSION(:,:) :: int_mat
INTEGER, DIMENSION(ndim1_int_mat,ndim2_int_mat) :: int_mat
obj%tagname = TRIM(tagname)
ALLOCATE(obj%int_mat(ndim1_int_mat,ndim2_int_mat))
obj%int_mat(:,:) = int_mat(:,:)
obj%ndim1_int_mat = ndim1_int_mat
obj%ndim2_int_mat = ndim2_int_mat
END SUBROUTINE qes_init_integerMatrix
@ -3298,10 +3306,10 @@ SUBROUTINE qes_init_band_structure(obj, tagname, lsda, noncolin, spinorbit, nbnd
REAL(DP) :: highestOccupiedLevel
LOGICAL :: two_fermi_energies_ispresent
INTEGER :: ndim_two_fermi_energies
REAL(DP), DIMENSION(:) :: two_fermi_energies
REAL(DP), DIMENSION(ndim_two_fermi_energies) :: two_fermi_energies
INTEGER :: nks
INTEGER :: ndim_ks_energies
TYPE(ks_energies_type), DIMENSION(:) :: ks_energies
TYPE(ks_energies_type ), DIMENSION( ndim_ks_energies ) :: ks_energies
obj%tagname = TRIM(tagname)
obj%lsda = lsda
@ -3329,6 +3337,7 @@ SUBROUTINE qes_init_band_structure(obj, tagname, lsda, noncolin, spinorbit, nbnd
IF(obj%two_fermi_energies_ispresent) THEN
ALLOCATE(obj%two_fermi_energies(ndim_two_fermi_energies))
obj%two_fermi_energies(:) = two_fermi_energies(:)
obj%ndim_two_fermi_energies = ndim_two_fermi_energies
ENDIF
obj%nks = nks
ALLOCATE(obj%ks_energies(SIZE(ks_energies)))
@ -3490,7 +3499,7 @@ SUBROUTINE qes_init_k_points_IBZ(obj, tagname, monkhorst_pack_ispresent, monkhor
INTEGER :: nk
LOGICAL :: k_point_ispresent
INTEGER :: ndim_k_point
TYPE(k_point_type), DIMENSION(:) :: k_point
TYPE(k_point_type ), DIMENSION( ndim_k_point ) :: k_point
obj%tagname = TRIM(tagname)
obj%monkhorst_pack_ispresent = monkhorst_pack_ispresent
@ -3748,8 +3757,8 @@ SUBROUTINE qes_write_basis_set(iun, obj)
!
CALL qes_write_basisSetItem(iun, obj%fft_grid)
!
IF(obj%fft_smoooth_ispresent) THEN
CALL qes_write_basisSetItem(iun, obj%fft_smoooth)
IF(obj%fft_smooth_ispresent) THEN
CALL qes_write_basisSetItem(iun, obj%fft_smooth)
!
ENDIF
!
@ -3777,8 +3786,8 @@ SUBROUTINE qes_write_basis_set(iun, obj)
END SUBROUTINE qes_write_basis_set
SUBROUTINE qes_init_basis_set(obj, tagname, gamma_only_ispresent, gamma_only, ecutwfc, &
ecutrho_ispresent, ecutrho, fft_grid, fft_smoooth_ispresent, &
fft_smoooth, fft_box_ispresent, fft_box, ngm, ngms_ispresent, &
ecutrho_ispresent, ecutrho, fft_grid, fft_smooth_ispresent, &
fft_smooth, fft_box_ispresent, fft_box, ngm, ngms_ispresent, &
ngms, npwx, reciprocal_lattice)
IMPLICIT NONE
@ -3791,8 +3800,8 @@ SUBROUTINE qes_init_basis_set(obj, tagname, gamma_only_ispresent, gamma_only, ec
LOGICAL :: ecutrho_ispresent
REAL(DP) :: ecutrho
TYPE(basisSetItem_type) :: fft_grid
LOGICAL :: fft_smoooth_ispresent
TYPE(basisSetItem_type) :: fft_smoooth
LOGICAL :: fft_smooth_ispresent
TYPE(basisSetItem_type) :: fft_smooth
LOGICAL :: fft_box_ispresent
TYPE(basisSetItem_type) :: fft_box
INTEGER :: ngm
@ -3812,9 +3821,9 @@ SUBROUTINE qes_init_basis_set(obj, tagname, gamma_only_ispresent, gamma_only, ec
obj%ecutrho = ecutrho
ENDIF
obj%fft_grid = fft_grid
obj%fft_smoooth_ispresent = fft_smoooth_ispresent
IF(obj%fft_smoooth_ispresent) THEN
obj%fft_smoooth = fft_smoooth
obj%fft_smooth_ispresent = fft_smooth_ispresent
IF(obj%fft_smooth_ispresent) THEN
obj%fft_smooth = fft_smooth
ENDIF
obj%fft_box_ispresent = fft_box_ispresent
IF(obj%fft_box_ispresent) THEN
@ -3844,9 +3853,9 @@ SUBROUTINE qes_reset_basis_set(obj)
obj%ecutrho_ispresent = .FALSE.
ENDIF
CALL qes_reset_basisSetItem(obj%fft_grid)
IF(obj%fft_smoooth_ispresent) THEN
CALL qes_reset_basisSetItem(obj%fft_smoooth)
obj%fft_smoooth_ispresent = .FALSE.
IF(obj%fft_smooth_ispresent) THEN
CALL qes_reset_basisSetItem(obj%fft_smooth)
obj%fft_smooth_ispresent = .FALSE.
ENDIF
IF(obj%fft_box_ispresent) THEN
CALL qes_reset_basisSetItem(obj%fft_box)
@ -4015,7 +4024,7 @@ SUBROUTINE qes_init_inputOccupations(obj, tagname, ispin, spin_factor, ndim_vec,
INTEGER :: ispin
REAL(DP) :: spin_factor
INTEGER :: ndim_vec
REAL(DP), DIMENSION(:) :: vec
REAL(DP), DIMENSION(ndim_vec) :: vec
obj%tagname = TRIM(tagname)
@ -4026,6 +4035,7 @@ SUBROUTINE qes_init_inputOccupations(obj, tagname, ispin, spin_factor, ndim_vec,
ALLOCATE(obj%vec(ndim_vec))
obj%vec(:) = vec(:)
obj%ndim_vec = ndim_vec
END SUBROUTINE qes_init_inputOccupations
@ -4211,7 +4221,7 @@ SUBROUTINE qes_init_bands(obj, tagname, nbnd_ispresent, nbnd, smearing_ispresent
TYPE(occupations_type) :: occupations
LOGICAL :: inputOccupations_ispresent
INTEGER :: ndim_inputOccupations
TYPE(inputOccupations_type), DIMENSION(:) :: inputOccupations
TYPE(inputOccupations_type ), DIMENSION( ndim_inputOccupations ) :: inputOccupations
obj%tagname = TRIM(tagname)
obj%nbnd_ispresent = nbnd_ispresent
@ -4470,7 +4480,7 @@ SUBROUTINE qes_init_Hubbard_ns(obj, tagname, specie, label, spin, index, &
INTEGER :: index
INTEGER :: ndim1_mat
INTEGER :: ndim2_mat
REAL(DP), DIMENSION(:,:) :: mat
REAL(DP), DIMENSION(ndim1_mat,ndim2_mat) :: mat
obj%tagname = TRIM(tagname)
@ -4487,6 +4497,8 @@ SUBROUTINE qes_init_Hubbard_ns(obj, tagname, specie, label, spin, index, &
ALLOCATE(obj%mat(ndim1_mat,ndim2_mat))
obj%mat(:,:) = mat(:,:)
obj%ndim1_mat = ndim1_mat
obj%ndim2_mat = ndim2_mat
END SUBROUTINE qes_init_Hubbard_ns
@ -4534,7 +4546,7 @@ SUBROUTINE qes_init_starting_ns(obj, tagname, specie, label, spin, ndim_vec, vec
CHARACTER(len=*) :: label
INTEGER :: spin
INTEGER :: ndim_vec
REAL(DP), DIMENSION(:) :: vec
REAL(DP), DIMENSION(ndim_vec) :: vec
obj%tagname = TRIM(tagname)
@ -4548,6 +4560,7 @@ SUBROUTINE qes_init_starting_ns(obj, tagname, specie, label, spin, ndim_vec, vec
ALLOCATE(obj%vec(ndim_vec))
obj%vec(:) = vec(:)
obj%ndim_vec = ndim_vec
END SUBROUTINE qes_init_starting_ns
@ -4716,7 +4729,7 @@ SUBROUTINE qes_init_vdW(obj, tagname, vdw_corr, non_local_term_ispresent, non_lo
REAL(DP) :: xdm_a2
LOGICAL :: london_c6_ispresent
INTEGER :: ndim_london_c6
TYPE(HubbardCommon_type), DIMENSION(:) :: london_c6
TYPE(HubbardCommon_type ), DIMENSION( ndim_london_c6 ) :: london_c6
obj%tagname = TRIM(tagname)
obj%vdw_corr = vdw_corr
@ -4894,25 +4907,25 @@ SUBROUTINE qes_init_dftU(obj, tagname, lda_plus_u_kind_ispresent, lda_plus_u_kin
INTEGER :: lda_plus_u_kind
LOGICAL :: Hubbard_U_ispresent
INTEGER :: ndim_Hubbard_U
TYPE(HubbardCommon_type), DIMENSION(:) :: Hubbard_U
TYPE(HubbardCommon_type ), DIMENSION( ndim_Hubbard_U ) :: Hubbard_U
LOGICAL :: Hubbard_J0_ispresent
INTEGER :: ndim_Hubbard_J0
TYPE(HubbardCommon_type), DIMENSION(:) :: Hubbard_J0
TYPE(HubbardCommon_type ), DIMENSION( ndim_Hubbard_J0 ) :: Hubbard_J0
LOGICAL :: Hubbard_alpha_ispresent
INTEGER :: ndim_Hubbard_alpha
TYPE(HubbardCommon_type), DIMENSION(:) :: Hubbard_alpha
TYPE(HubbardCommon_type ), DIMENSION( ndim_Hubbard_alpha ) :: Hubbard_alpha
LOGICAL :: Hubbard_beta_ispresent
INTEGER :: ndim_Hubbard_beta
TYPE(HubbardCommon_type), DIMENSION(:) :: Hubbard_beta
TYPE(HubbardCommon_type ), DIMENSION( ndim_Hubbard_beta ) :: Hubbard_beta
LOGICAL :: Hubbard_J_ispresent
INTEGER :: ndim_Hubbard_J
TYPE(HubbardJ_type), DIMENSION(:) :: Hubbard_J
TYPE(HubbardJ_type ), DIMENSION( ndim_Hubbard_J ) :: Hubbard_J
LOGICAL :: starting_ns_ispresent
INTEGER :: ndim_starting_ns
TYPE(starting_ns_type), DIMENSION(:) :: starting_ns
TYPE(starting_ns_type ), DIMENSION( ndim_starting_ns ) :: starting_ns
LOGICAL :: Hubbard_ns_ispresent
INTEGER :: ndim_Hubbard_ns
TYPE(Hubbard_ns_type), DIMENSION(:) :: Hubbard_ns
TYPE(Hubbard_ns_type ), DIMENSION( ndim_Hubbard_ns ) :: Hubbard_ns
LOGICAL :: U_projection_type_ispresent
CHARACTER(len=*) :: U_projection_type
@ -5445,7 +5458,7 @@ SUBROUTINE qes_init_wyckoff_positions(obj, tagname, space_group, more_options, m
LOGICAL :: more_options_ispresent
CHARACTER(len=*), OPTIONAL :: more_options
INTEGER :: ndim_atom
TYPE(atom_type), DIMENSION(:) :: atom
TYPE(atom_type ), DIMENSION( ndim_atom ) :: atom
obj%tagname = TRIM(tagname)
@ -5508,7 +5521,7 @@ SUBROUTINE qes_init_atomic_positions(obj, tagname, ndim_atom, atom)
CHARACTER(len=*) :: tagname
INTEGER :: i
INTEGER :: ndim_atom
TYPE(atom_type), DIMENSION(:) :: atom
TYPE(atom_type ), DIMENSION( ndim_atom ) :: atom
obj%tagname = TRIM(tagname)
ALLOCATE(obj%atom(SIZE(atom)))
@ -5748,7 +5761,7 @@ SUBROUTINE qes_init_atomic_species(obj, tagname, ntyp, ndim_species, species)
INTEGER :: i
INTEGER :: ntyp
INTEGER :: ndim_species
TYPE(species_type), DIMENSION(:) :: species
TYPE(species_type ), DIMENSION( ndim_species ) :: species
obj%tagname = TRIM(tagname)

View File

@ -755,8 +755,8 @@ TYPE :: basis_set_type
LOGICAL :: ecutrho_ispresent
REAL(DP) :: ecutrho
TYPE(basisSetItem_type) :: fft_grid
LOGICAL :: fft_smoooth_ispresent
TYPE(basisSetItem_type) :: fft_smoooth
LOGICAL :: fft_smooth_ispresent
TYPE(basisSetItem_type) :: fft_smooth
LOGICAL :: fft_box_ispresent
TYPE(basisSetItem_type) :: fft_box
INTEGER :: ngm

View File

@ -1,4 +1,3 @@
!
! Copyright (C) 2003-2015 Quantum ESPRESSO group
! This file is distributed under the terms of the
! GNU General Public License. See the file `License'
@ -516,38 +515,54 @@ CONTAINS
TYPE(info_type) :: info
TYPE(matrix_type) :: matrix
CHARACTER(LEN=15) :: classname
CHARACTER(LEN=256) :: la_info
LOGICAL :: class_ispresent = .FALSE., time_reversal_ispresent = .FALSE.
INTEGER :: i
ALLOCATE(symm(nsym))
ALLOCATE(symm(nrot))
!
IF ( TRIM(verbosity) .EQ. 'high' .OR. TRIM(verbosity) .EQ. 'medium') class_ispresent= .TRUE.
IF ( noncolin ) time_reversal_ispresent = .TRUE.
DO i = 1, nsym
DO i = 1, nrot
!
classname = class_names(i)
IF ( i .LE. nsym ) THEN
la_info = "crystal_symmetry"
ELSE
la_info = "lattice_symmetry"
END IF
CALL qes_init_info(info, "info", name=sname(i), name_ispresent=.TRUE., &
class=classname, class_ispresent = class_ispresent, &
time_reversal=(t_rev(i)==1), time_reversal_ispresent = time_reversal_ispresent, &
info= '')
INFO= TRIM(la_info) )
!
CALL qes_init_matrix(matrix, "rotation", ndim1_mat=3, ndim2_mat=3, mat=real(s(:,:,i),DP))
!
CALL qes_init_equivalent_atoms(equiv_atm, "equivalent_atoms", nat=nat, ndim_index_list=nat, &
IF ( i .LE. nsym ) THEN
CALL qes_init_equivalent_atoms(equiv_atm, "equivalent_atoms", nat=nat, ndim_index_list=nat, &
index_list=irt(i,1:nat) )
!
CALL qes_init_symmetry(symm(i),"symmetry", info=info, rotation=matrix, &
CALL qes_init_symmetry(symm(i),"symmetry", info=info, rotation=matrix, &
fractional_translation_ispresent=.TRUE., fractional_translation=ft(:,i), &
equivalent_atoms_ispresent=.TRUE., equivalent_atoms=equiv_atm)
ELSE
CALL qes_init_symmetry ( symm(i), "symmetry", INFO = info, ROTATION = matrix, &
FRACTIONAL_TRANSLATION_ISPRESENT = .FALSE., FRACTIONAL_TRANSLATION=ft(:,i), &
EQUIVALENT_ATOMS_ISPRESENT = .FALSE., EQUIVALENT_ATOMS=equiv_atm)
END IF
!
CALL qes_reset_info(info)
CALL qes_reset_matrix(matrix)
CALL qes_reset_equivalent_atoms(equiv_atm)
IF ( i .LT. nsym ) THEN
CALL qes_reset_equivalent_atoms( equiv_atm )
ELSE IF ( i .EQ. nrot ) THEN
CALL qes_reset_equivalent_atoms( equiv_atm )
END IF
!
ENDDO
!
CALL qes_init_symmetries(obj,"symmetries",nsym=nsym, nrot=nrot, space_group=space_group, &
ndim_symmetry=SIZE(symm), symmetry=symm )
CALL qes_init_symmetries(obj,"symmetries",NSYM = nsym, NROT=nrot, SPACE_GROUP = space_group, &
NDIM_SYMMETRY=SIZE(symm), SYMMETRY=symm )
!
DO i = 1, nsym
CALL qes_reset_symmetry(symm(i))
@ -587,7 +602,7 @@ CONTAINS
CALL qes_init_basis_set(obj, "basis_set", gamma_only_ispresent=.TRUE., gamma_only=gamma_only, &
ecutwfc=ecutwfc, ecutrho_ispresent=.TRUE., ecutrho=ecutrho, fft_grid=fft_grid, &
fft_smoooth_ispresent=.TRUE., fft_smoooth=fft_smooth, &
fft_smooth_ispresent=.TRUE., fft_smooth=fft_smooth, &
fft_box_ispresent=fft_box_ispresent, fft_box=fft_box, ngm=ngm, &
ngms_ispresent=.TRUE., ngms=ngms, npwx=npwx, reciprocal_lattice=recipr_latt)
!
@ -987,7 +1002,7 @@ CONTAINS
CALL qes_reset_k_point(kp_obj)
END DO
!
CALL qes_init_band_structure(obj,TAGNAME,lsda,noncolin,lspinorb,nbnd_tot,nbnd_up_ispresent,&
CALL qes_init_band_structure(obj,TAGNAME,lsda,noncolin,lspinorb, nbnd , nbnd_up_ispresent,&
nbnd_up,nbnd_dw_ispresent,nbnd_dw,nelec,fermi_energy_ispresent,&
fermi_energy/e2, HOL_ispresent, fermi_energy/e2, two_fermi_energies, 2, ef_updw/e2, &
ndim_ks_energies,ndim_ks_energies,ks_objs)

View File

@ -268,7 +268,7 @@ MODULE qexsd_input
!
!
!-------------------------------------------------------------------------------------------------
SUBROUTINE qexsd_init_k_points_ibz(obj,k_points,calculation,nk1,nk2,nk3,s1,s2,s3,nk,xk,wk,alat,a1)
SUBROUTINE qexsd_init_k_points_ibz(obj,k_points,calculation,nk1,nk2,nk3,s1,s2,s3,nk,xk,wk,alat,a1, ibrav_lattice)
!
IMPLICIT NONE
!
@ -277,6 +277,7 @@ MODULE qexsd_input
INTEGER,INTENT(IN) :: nk1,nk2,nk3,s1,s2,s3,nk
REAL(DP),INTENT(IN) :: 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) :: mpack_obj
@ -302,7 +303,11 @@ MODULE qexsd_input
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 ( 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

View File

@ -323,6 +323,10 @@ SUBROUTINE electrons_scf ( printout, exxen )
restart, io_level, do_makov_payne, &
gamma_only, iverbosity, textfor, &
llondon, scf_must_converge, lxdm, ts_vdw
#ifdef __XSD
USE control_flags, ONLY : n_scf_steps, scf_error
#endif
USE io_files, ONLY : iunmix, output_drho, &
iunres, iunefield, seqopn
USE ldaU, ONLY : eth, Hubbard_U, Hubbard_lmax, &
@ -678,6 +682,13 @@ SUBROUTINE electrons_scf ( printout, exxen )
WRITE( stdout, 9000 ) get_clock( 'PWSCF' )
!
IF ( conv_elec ) WRITE( stdout, 9101 )
#ifdef __XSD
IF ( conv_elec ) THEN
scf_error = dr2
n_scf_steps = iter
END IF
#endif
!
IF ( conv_elec .OR. MOD( iter, iprint ) == 0 ) THEN
!
@ -1064,6 +1075,7 @@ SUBROUTINE electrons_scf ( printout, exxen )
USE constants, ONLY : eps8
INTEGER, INTENT (IN) :: printout
!
IF ( printout == 0 ) RETURN
IF ( ( conv_elec .OR. MOD(iter,iprint) == 0 ) .AND. printout > 1 ) THEN
!

View File

@ -55,7 +55,7 @@
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
tf_inp, ip_ibrav => ibrav
!
USE fixed_occ, ONLY: f_inp
@ -84,7 +84,7 @@
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.
LOGICAL :: lsda,dft_is_hybrid,dft_is_nonlocc,is_hubbard(ntypx)=.FALSE., ibrav_lattice
INTEGER :: Hubbard_l=0,Hubbard_lmax=0
INTEGER :: iexch, icorr, igcx, igcc, imeta, my_vec(6)
INTEGER,EXTERNAL :: set_hubbard_l
@ -96,6 +96,11 @@
!
!
obj%tagname=TRIM(obj_tagname)
IF ( ABS(ip_ibrav) .GT. 0 ) THEN
ibrav_lattice = .TRUE.
ELSE
ibrav_lattice = .FALSE.
END IF
!
!------------------------------------------------------------------------------------------------------------------------
! CONTROL VARIABLES ELEMENT
@ -126,9 +131,14 @@
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 , ibrav = 0 )
!
IF ( ibrav_lattice ) THEN
CALL qexsd_init_atomic_structure (obj%atomic_structure, ntyp, atm, ip_ityp, ip_nat, tau, tau_units = tau_units, &
ALAT = alat, a1 = a1, a2 = a2, a3 = a3 , ibrav = ip_ibrav )
ELSE
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 , IBRAV = 0 )
END IF
DEALLOCATE ( tau )
!
!--------------------------------------------------------------------------------------------------------------------------
@ -219,7 +229,7 @@
!----------------------------------------------------------------------------------------------------------------------------
! 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,&
CALL qexsd_init_basis(obj%basis, ip_k_points, ecutwfc/e2, ip_ecutrho/e2, ip_nr1, ip_nr2, ip_nr3, ip_nr1s, ip_nr2s, ip_nr3s,&
ip_nr1b, ip_nr2b,ip_nr3b)
!-----------------------------------------------------------------------------------------------------------------------------
! ELECTRON CONTROL
@ -239,11 +249,11 @@
gamma_xk(:,1)=[0._DP, 0._DP, 0._DP]
gamma_wk(1)=1._DP
CALL qexsd_init_k_points_ibz( obj%k_points_ibz, ip_k_points, calculation, nk1, nk2, nk3, k1, k2, k3, 1, &
gamma_xk, gamma_wk ,alat,a1)
gamma_xk, gamma_wk ,alat,a1,ibrav_lattice)
ELSE
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)
ip_xk, ip_wk,alat,a1, ibrav_lattice)
END IF
!--------------------------------------------------------------------------------------------------------------------------------

View File

@ -75,7 +75,7 @@ USE io_files, ONLY : tmp_dir, prefix, iunpun, xmlpun, delete_if_present, &
!
PUBLIC :: pw_writefile, pw_readfile
#ifdef __XSD
PUBLIC :: pw_write_schema
PUBLIC :: pw_write_schema
#endif
!
INTEGER, PRIVATE :: iunout
@ -104,7 +104,7 @@ USE io_files, ONLY : tmp_dir, prefix, iunpun, xmlpun, delete_if_present, &
USE control_flags, ONLY : istep, twfcollect, conv_ions, &
lscf, lkpoint_dir, gamma_only, &
tqr, noinv, do_makov_payne, smallmem, &
llondon, lxdm, ts_vdw, scf_error, n_scf_steps
llondon, lxdm, ts_vdw, n_scf_steps, scf_error
USE realus, ONLY : real_space
USE uspp, ONLY : okvan
USE paw_variables, ONLY : okpaw
@ -257,10 +257,6 @@ USE io_files, ONLY : tmp_dir, prefix, iunpun, xmlpun, delete_if_present, &
!-------------------------------------------------------------------------------
! ... 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.
@ -295,10 +291,11 @@ USE io_files, ONLY : tmp_dir, prefix, iunpun, xmlpun, delete_if_present, &
!
IF (noncolin) THEN
CALL qexsd_init_atomic_species(output%atomic_species, nsp, atm, psfile, &
amass, angle1=angle1,angle2=angle2)
amass, STARTING_MAGNETIZATION = starting_magnetization, &
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)
amass, STARTING_MAGNETIZATION=starting_magnetization)
ELSE
CALL qexsd_init_atomic_species(output%atomic_species, nsp, atm,psfile, &
amass)
@ -309,7 +306,7 @@ USE io_files, ONLY : tmp_dir, prefix, iunpun, xmlpun, delete_if_present, &
!-------------------------------------------------------------------------------
!
CALL qexsd_init_atomic_structure(output%atomic_structure, nsp, atm, ityp, &
nat, tau, 'Bohr', alat, at(:,1), at(:,2), at(:,3), ibrav )
nat, tau, 'Bohr', alat, alat*at(:,1), alat*at(:,2), alat*at(:,3), ibrav)
!
!-------------------------------------------------------------------------------
! ... SYMMETRIES
@ -318,7 +315,7 @@ USE io_files, ONLY : tmp_dir, prefix, iunpun, xmlpun, delete_if_present, &
symop_2_class="not found"
IF (TRIM (verbosity) == 'medium' .OR. TRIM(verbosity) == 'high') THEN
IF ( noncolin ) THEN
symmetries_so_loop:DO isym = 1, nsym
symmetries_so_loop:DO isym = 1, nrot
classes_so_loop:DO iclass = 1, 24
elements_so_loop:DO ielem=1, nelem_so(iclass)
IF ( elem_so(ielem,iclass) == isym) THEN
@ -330,7 +327,7 @@ USE io_files, ONLY : tmp_dir, prefix, iunpun, xmlpun, delete_if_present, &
END DO symmetries_so_loop
!
ELSE
symmetries_loop:DO isym = 1, nsym
symmetries_loop:DO isym = 1, nrot
classes_loop:DO iclass = 1, 12
elements_loop:DO ielem=1, nelem (iclass)
IF ( elem(ielem,iclass) == isym) THEN
@ -343,14 +340,14 @@ USE io_files, ONLY : tmp_dir, prefix, iunpun, xmlpun, delete_if_present, &
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, &
s, ft, sname, t_rev, nat, irt,symop_2_class(1:nrot), verbosity, &
noncolin)
!
!-------------------------------------------------------------------------------
! ... BASIS SET
!-------------------------------------------------------------------------------
!
CALL qexsd_init_basis_set(output%basis_set, gamma_only, ecutwfc, ecutwfc*dual, &
CALL qexsd_init_basis_set(output%basis_set, gamma_only, ecutwfc/e2, ecutwfc*dual/e2, &
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) )
@ -419,7 +416,13 @@ USE io_files, ONLY : tmp_dir, prefix, iunpun, xmlpun, delete_if_present, &
! ... FORCES
!----------------------------------------------------------------------------------------------
!
CALL qexsd_init_forces(output%forces,nat,force,lforce)
IF ( lforce ) THEN
output%forces_ispresent = .TRUE.
CALL qexsd_init_forces(output%forces,nat,force,lforce)
ELSE
output%forces_ispresent = .FALSE.
output%forces%lwrite = .FALSE.
END IF
!
!------------------------------------------------------------------------------------------------
! ... STRESS
@ -477,7 +480,7 @@ USE io_files, ONLY : tmp_dir, prefix, iunpun, xmlpun, delete_if_present, &
USE control_flags, ONLY : twfcollect, conv_ions, &
lscf, lkpoint_dir, gamma_only, &
tqr, noinv, do_makov_payne, smallmem, &
llondon, lxdm, ts_vdw
llondon, lxdm, ts_vdw
USE realus, ONLY : real_space
USE global_version, ONLY : version_number
USE cell_base, ONLY : at, bg, alat, tpiba, tpiba2, &