1! Copyright (C) 2002-2015 Quantum ESPRESSO group 2! This file is distributed under the terms of the 3! GNU General Public License. See the file `License' 4! in the root directory of the present distribution, 5! or http://www.gnu.org/copyleft/gpl.txt . 6! 7! 8 !-------------------------------------------------------------------------------------------------------------------- 9 SUBROUTINE pw_init_qexsd_input(obj,obj_tagname) 10 !-------------------------------------------------------------------------------------------------------------------- 11 ! This routine builds an XML input file, taking the values from the variables 12 ! contained in input_parameters MODULE. To work correctly it must be called before 13 ! the iosys routine deallocates the input parameters. As the data contained 14 ! in XML input are organized differently from those in provided by namelist 15 ! input, for some values we need some information from other PW modules. 16 !--------------------------------------------------------------------------- 17 ! first version march 2016 18 !--------------------------------------------------------------------------- 19 USE input_parameters, ONLY: title, calculation, restart_mode, prefix, pseudo_dir, outdir, tstress, tprnfor, & 20 wf_collect, disk_io, max_seconds, conv_thr, etot_conv_thr, forc_conv_thr, & 21 press, press_conv_thr,verbosity, iprint, ntyp, & 22 atm => atom_label, psfile => atom_pfile, amass => atom_mass, starting_magnetization, & 23 angle1, angle2, ip_nat => nat, ip_nspin => nspin, ip_ityp => sp_pos, ip_tau => rd_pos,& 24 ip_atomic_positions => atomic_positions, lspinorb, ip_nqx1 => nqx1, ip_nqx2 => nqx2, & 25 ip_nqx3 => nqx3, ip_ecutfock => ecutfock, ip_ecutvcut => ecutvcut, localization_thr, & 26 screening_parameter, exx_fraction, x_gamma_extrapolation, exxdiv_treatment, & 27 ip_lda_plus_u=>lda_plus_u, ip_lda_plus_u_kind => lda_plus_u_kind, & 28 ip_hubbard_u => hubbard_u, ip_hubbard_u_back => hubbard_u_back, lback, l1back, & 29 ip_hubbard_j0 => hubbard_j0, ip_hubbard_beta => hubbard_beta, ip_backall => backall, & 30 ip_hubbard_alpha => hubbard_alpha, ip_Hubbard_alpha_back => hubbard_alpha_back, & 31 ip_hubbard_j => hubbard_j, starting_ns_eigenvalue, u_projection_type, & 32 vdw_corr, london, london_s6, london_c6, london_rcut, london_c6, xdm_a1, xdm_a2, & 33 ts_vdw_econv_thr, ts_vdw_isolated, dftd3_threebody,dftd3_version, & 34 ip_noncolin => noncolin, ip_spinorbit => lspinorb, & 35 nbnd, smearing, degauss, ip_occupations=>occupations, tot_charge, tot_magnetization, & 36 ip_k_points => k_points, ecutwfc, ip_ecutrho => ecutrho, ip_nr1 => nr1, ip_nr2=>nr2, & 37 ip_nr3 => nr3, ip_nr1s => nr1s, ip_nr2s => nr2s,ip_nr3s => nr3s, ip_nr1b=>nr1b, & 38 ip_nr2b=>nr2b, ip_nr3b => nr3b, & 39 ip_diagonalization=>diagonalization, mixing_mode, mixing_beta, & 40 mixing_ndim, tqr, tq_smoothing, tbeta_smoothing, electron_maxstep, & 41 diago_thr_init, diago_full_acc, & 42 diago_cg_maxiter, diago_ppcg_maxiter, diago_david_ndim, & 43 nk1, nk2, nk3, k1, k2, k3, nkstot, ip_xk => xk, ip_wk => wk, & 44 ion_dynamics, upscale, remove_rigid_rot, refold_pos, pot_extrapolation, & 45 wfc_extrapolation, ion_temperature, tempw, tolp, delta_t, nraise, ip_dt => dt, & 46 bfgs_ndim, trust_radius_min, trust_radius_max, trust_radius_ini, w_1, w_2, & 47 cell_dynamics, wmass, cell_dofree, cell_factor, & 48 ip_nosym => nosym, ip_noinv => noinv, ip_nosym_evc => nosym_evc, & 49 ip_no_t_rev => no_t_rev, ip_force_symmorphic => force_symmorphic, & 50 ip_use_all_frac=>use_all_frac, assume_isolated, esm_bc, esm_w, esm_nfit, esm_efield, & 51 ip_lfcpopt => lfcpopt, ip_fcp_mu => fcp_mu, & 52 ecfixed, qcutz, q2sigma, & 53 tforces, rd_for, & 54 rd_if_pos, & 55 tionvel, rd_vel, & 56 tefield, lelfield, dipfield, edir, emaxpos, eamp, eopreg, efield, efield_cart,gdir, & 57 lberry,nppstr,nberrycyc, & 58 nconstr_inp, nc_fields, constr_type_inp, constr_target_inp, constr_inp, tconstr, & 59 constr_tol_inp, constrained_magnetization, lambda, fixed_magnetization, input_dft, & 60 tf_inp, ip_ibrav => ibrav, & 61 gate, zgate, relaxz, block, block_1, block_2, block_height, real_space 62! 63 USE fixed_occ, ONLY: f_inp 64! 65 USE kinds, ONLY: DP 66 USE parameters, ONLY: ntypx 67 USE constants, ONLY: e2,bohr_radius_angs 68 USE ions_base, ONLY: iob_tau=>tau 69 USE cell_base, ONLY: cb_at => at, cb_alat => alat, cb_iforceh => iforceh 70 USE funct, ONLY: get_dft_is_hybrid => dft_is_hybrid, & 71 get_dft_is_nonlocc => dft_is_nonlocc, get_nonlocc_name, get_dft_short 72 USE uspp_param, ONLY: upf 73 USE control_flags, ONLY: cf_nstep => nstep 74 USE qes_types_module 75 USE qes_libs_module 76 USE qexsd_init, ONLY: qexsd_init_atomic_species, qexsd_init_atomic_structure, qexsd_init_dft, & 77 qexsd_init_hybrid, qexsd_init_vdw, qexsd_init_dftU 78 USE qexsd_input 79 IMPLICIT NONE 80 ! 81 TYPE (input_type),INTENT(OUT) :: obj 82 CHARACTER(len=*),INTENT(IN) :: obj_tagname 83 ! 84 CHARACTER(80) :: dft_name, diagonalization 85 CHARACTER(256) :: tagname 86 REAL(DP),ALLOCATABLE :: tau(:,:) 87 REAL(DP) :: alat, a1(3), a2(3), a3(3), gamma_xk(3,1), gamma_wk(1) 88 INTEGER :: nt 89 LOGICAL :: lsda,dft_is_hybrid, dft_is_nonlocc, is_hubbard(ntypx)=.FALSE.,& 90 is_hubbard_back(ntypx) = .FALSE., ibrav_lattice 91 INTEGER :: Hubbard_l=0,hublmax=0 92 INTEGER :: iexch, icorr, igcx, igcc, imeta, my_vec(6) 93 INTEGER,EXTERNAL :: set_hubbard_l, set_hubbard_l_back 94 INTEGER :: lung,l 95 CHARACTER(LEN=8), EXTERNAL :: schema_smearing 96 CHARACTER(LEN=8) :: smearing_loc 97 CHARACTER(len=20) :: dft_shortname 98 CHARACTER(len=25) :: dft_longname 99 CHARACTER(LEN=80),TARGET :: vdw_corr_, vdw_nonlocc_ 100 CHARACTER(LEN=80),POINTER :: vdw_corr_pointer => NULL(), vdw_nonlocc_pt=>NULL() 101 LOGICAL,TARGET :: gate_tgt, block_tgt, relaxz_tgt 102 LOGICAL,POINTER :: gate_ptr, block_ptr, relaxz_ptr 103 REAL(DP),TARGET :: block_1_tgt, block_2_tgt, block_height_tgt, zgate_tgt 104 REAL(DP),POINTER :: block_1_ptr, block_2_ptr, block_height_ptr, zgate_ptr 105 TYPE(hybrid_type),POINTER :: hybrid_ 106 TYPE(dftU_type),POINTER :: dftU_ 107 TYPE(vdW_type),POINTER :: vdW_ 108 REAL(DP),TARGET :: xdm_a1_, xdm_a2_, lond_s6_, lond_rcut_, ts_vdw_econv_thr_,& 109 scr_par_, exx_frc_, ecutvcut_, ecut_fock_, loc_thr_ 110 REAL(DP),POINTER :: xdm_a1_pt=>NULL(), xdm_a2_pt=>NULL(), lond_s6_pt=>NULL(), & 111 lond_rcut_pt=>NULL(), ts_vdw_econv_thr_pt=>NULL(),& 112 ecut_fock_opt=>NULL(), scr_par_opt=>NULL(), exx_frc_opt=>NULL(), & 113 ecutvcut_opt=>NULL(), loc_thr_p => NULL() 114 LOGICAL,TARGET :: empirical_vdw, ts_vdw_isolated_, dftd3_threebody_ 115 LOGICAL,POINTER :: ts_vdw_isolated_pt=>NULL(), dftd3_threebody_pt=>NULL() 116 INTEGER,TARGET :: dftd3_version_, spin_ns, nbnd_tg, nq1_tg, nq2_tg, nq3_tg 117 INTEGER,POINTER :: dftd3_version_pt=>NULL(), nbnd_pt => NULL(), nq1_pt=>NULL(),& 118 nq2_pt=>NULL(), nq3_pt=>NULL() 119 REAL(DP),ALLOCATABLE :: london_c6_(:), hubbard_U_(:), hubbard_U_back_(:), hubbard_alpha_(:), & 120 hubbard_alpha_back_(:), hubbard_J_(:,:), hubbard_J0_(:), hubbard_beta_(:), & 121 starting_ns_(:,:,:) 122 LOGICAL, ALLOCATABLE :: backall_(:) 123 INTEGER, ALLOCATABLE :: Hubbard_l_back_(:), Hubbard_l1_back_(:) 124 CHARACTER(LEN=3),ALLOCATABLE :: species_(:) 125 INTEGER, POINTER :: nr_1,nr_2, nr_3, nrs_1, nrs_2, nrs_3, nrb_1, nrb_2, nrb_3 126 INTEGER,ALLOCATABLE :: nr_(:), nrs_(:), nrb_(:) 127 CHARACTER,EXTERNAL :: capital 128 INTEGER :: i 129 ! 130 ! 131 NULLIFY (gate_ptr, block_ptr, relaxz_ptr, block_1_ptr, block_2_ptr, block_height_ptr, zgate_ptr, dftU_, vdW_, hybrid_) 132 NULLIFY (nr_1,nr_2,nr_3, nrs_1, nrs_2, nrs_3, nrb_1, nrb_2, nrb_3) 133 134 obj%tagname=TRIM(obj_tagname) 135 IF ( ABS(ip_ibrav) .GT. 0 ) THEN 136 ibrav_lattice = .TRUE. 137 ELSE 138 ibrav_lattice = .FALSE. 139 END IF 140 ! 141 !------------------------------------------------------------------------------------------------------------------------ 142 ! CONTROL VARIABLES ELEMENT 143 !------------------------------------------------------------------------------------------------------------------------ 144 CALL qexsd_init_control_variables(obj%control_variables,title=title,calculation=calculation, & 145 restart_mode=restart_mode,prefix=prefix,pseudo_dir=pseudo_dir,outdir=outdir, & 146 stress=tstress,forces=tprnfor, wf_collect=wf_collect,disk_io=disk_io, & 147 max_seconds=max_seconds,etot_conv_thr=etot_conv_thr/e2,forc_conv_thr=forc_conv_thr/e2, & 148 press_conv_thr=press_conv_thr,verbosity=verbosity,iprint=iprint, NSTEP = cf_nstep ) 149 !------------------------------------------------------------------------------------------------------------------------ 150 ! ATOMIC SPECIES 151 !------------------------------------------------------------------------------------------------------------------------ 152 IF ( ip_noncolin ) THEN 153 CALL qexsd_init_atomic_species(obj%atomic_species, ntyp,atm, psfile, amass, starting_magnetization, angle1, angle2) 154 ELSE IF (ip_nspin == 1 ) THEN 155 CALL qexsd_init_atomic_species(obj%atomic_species, ntyp,atm, psfile, amass) 156 ELSE IF (ip_nspin == 2 ) THEN 157 CALL qexsd_init_atomic_species(obj%atomic_species, ntyp,atm, psfile, amass, starting_magnetization) 158 END IF 159 !------------------------------------------------------------------------------------------------------------------------ 160 ! ATOMIC STRUCTURE 161 !------------------------------------------------------------------------------------------------------------------------ 162 ALLOCATE (tau(3, ip_nat)) 163 alat = cb_alat !*bohr_radius_angs 164 a1 = cb_at(:,1)*alat 165 a2 = cb_at(:,2)*alat 166 a3 = cb_at(:,3)*alat 167 tau(1:3,1:ip_nat) = iob_tau(1:3,1:ip_nat)*alat 168 ! 169 IF ( ibrav_lattice ) THEN 170 CALL qexsd_init_atomic_structure (obj%atomic_structure, ntyp, atm, ip_ityp, ip_nat, tau, & 171 ALAT = alat, a1 = a1, a2 = a2, a3 = a3 , ibrav = ip_ibrav ) 172 ELSE 173 CALL qexsd_init_atomic_structure (obj%atomic_structure, ntyp, atm, ip_ityp, ip_nat, tau, & 174 alat = sqrt(sum(a1(1:3)*a1(1:3))), A1 = a1, A2 = a2, A3 = a3 , IBRAV = 0 ) 175 END IF 176 DEALLOCATE ( tau ) 177 ! 178 !-------------------------------------------------------------------------------------------------------------------------- 179 ! DFT ELEMENT 180 !--------------------------------------------------------------------------------------------------------------------------- 181 IF ( TRIM(input_dft) .NE. "none" ) THEN 182 dft_name=TRIM(input_dft) 183 DO i=1, LEN(dft_name) 184 dft_name(i:i) = capital(dft_name(i:i)) 185 END DO 186 ELSE 187 dft_shortname = get_dft_short() 188 dft_name=TRIM(dft_shortname) 189 END IF 190 191 dft_is_hybrid=get_dft_is_hybrid() 192 IF ( dft_is_hybrid) THEN 193 ALLOCATE(hybrid_) 194 IF (screening_parameter > 0.0_DP) THEN 195 scr_par_ = screening_parameter 196 scr_par_opt => scr_par_ 197 END IF 198 IF ( exx_fraction > 0.0_DP) THEN 199 exx_frc_ = exx_fraction 200 exx_frc_opt => exx_frc_ 201 END IF 202 IF ( ip_ecutfock > 0.0_DP) THEN 203 ecut_fock_ = ip_ecutvcut/e2 204 ecut_fock_opt => ecut_fock_ 205 END IF 206 IF ( ip_ecutvcut > 0.0_DP) THEN 207 ecutvcut_ = ip_ecutvcut/e2 208 ecutvcut_opt => ecutvcut_ 209 END IF 210 IF (ANY([ip_nqx1, ip_nqx2, ip_nqx3] /= 0)) THEN 211 nq1_tg = ip_nqx1 212 nq2_tg = ip_nqx2 213 nq3_tg = ip_nqx3 214 nq1_pt => nq1_tg 215 nq2_pt => nq2_tg 216 nq3_pt => nq3_tg 217 END IF 218 IF (localization_thr .GT. 0._DP) THEN 219 loc_thr_ = localization_thr 220 loc_thr_p => loc_thr_ 221 END IF 222 CALL qexsd_init_hybrid(hybrid_, dft_is_hybrid, NQ1 = ip_nqx1, NQ2= ip_nqx2, NQ3=ip_nqx3,& 223 ECUTFOCK = ecut_fock_opt, EXX_FRACTION = exx_frc_opt, & 224 SCREENING_PARAMETER = scr_par_opt, EXXDIV_TREATMENT = exxdiv_treatment,& 225 X_GAMMA_EXTRAPOLATION = x_gamma_extrapolation, ECUTVCUT = ecutvcut_opt, & 226 LOCAL_THR = loc_thr_p ) 227 END IF 228 dft_is_nonlocc=get_dft_is_nonlocc() 229 vdw_corr_ = vdw_corr 230 IF (london) vdw_corr_ = 'grimme-d2' 231 empirical_vdw = .NOT. ( TRIM(vdw_corr_) == 'none') 232 IF (empirical_vdw .OR. dft_is_nonlocc) THEN 233 ALLOCATE (vdW_) 234 IF ( empirical_vdw ) THEN 235 vdw_corr_pointer => vdw_corr_ 236 SELECT CASE ( TRIM(vdw_corr_)) 237 CASE ('grimme-d2', 'Grimme-D2', 'DFT-D', 'dft-d') 238 IF ( london_s6 .NE. 0.75_DP .OR. london_rcut .NE. 200._DP ) THEN 239 lond_s6_ = london_s6 240 lond_s6_pt => lond_s6_ 241 lond_rcut_ = london_rcut 242 lond_rcut_pt => lond_rcut_ 243 END IF 244 IF (ANY( london_c6(1:ntyp) .NE. -1._DP )) THEN 245 ALLOCATE (london_c6_(ntyp), species_(ntyp)) 246 london_c6_(1:ntyp) = london_c6(1:ntyp) 247 species_(1:ntyp) = atm(1:ntyp) 248 END IF 249 CASE ('TS', 'ts', 'ts-vdw', 'ts-vdW', 'tkatchenko-scheffler') 250 ts_vdw_isolated_ = ts_vdw_isolated 251 ts_vdw_isolated_pt => ts_vdw_isolated_ 252 ts_vdw_econv_thr_ = ts_vdw_econv_thr 253 ts_vdw_econv_thr_pt => ts_vdw_econv_thr_ 254 CASE ('XDM' , 'xdm') 255 xdm_a1_ = xdm_a1 256 xdm_a1_pt => xdm_a1_ 257 xdm_a2_ = xdm_a2 258 xdm_a2_pt => xdm_a2_ 259 CASE ('grimme-d3', 'Grimme-D3', 'DFT-D3', 'dft-d3') 260 dftd3_version_ = dftd3_version 261 dftd3_version_pt => dftd3_version_ 262 dftd3_threebody_ = dftd3_threebody 263 dftd3_threebody_pt => dftd3_threebody_ 264 END SELECT 265 ELSE 266 vdw_corr_ = 'none' 267 vdw_corr_pointer => vdw_corr_ 268 END IF 269 IF (dft_is_nonlocc) THEN 270 vdw_nonlocc_ = TRIM(get_nonlocc_name()) 271 vdw_nonlocc_pt => vdw_nonlocc_ 272 END IF 273 CALL qexsd_init_vdw(vdW_, NON_LOCAL_TERM = vdw_nonlocc_pt, VDW_CORR = vdw_corr_pointer, & 274 TS_THR = ts_vdw_econv_thr_pt, TS_ISOL = ts_vdw_isolated_pt, & 275 LONDON_S6 = lond_s6_pt, LONDON_RCUT = lond_rcut_pt, SPECIES = species_, & 276 XDM_A1 = xdm_a1_pt, XDM_A2 = xdm_a2_pt, DFTD3_VERSION = dftd3_version_pt, & 277 DFTD3_THREEBODY = dftd3_threebody_pt) 278 END IF 279 ! 280 IF (ip_lda_plus_u) THEN 281 ALLOCATE (dftU_) 282 ! 283 DO nt = 1, ntyp 284 ! 285 is_hubbard(nt) = ip_Hubbard_U(nt)/= 0.0_dp .OR. & 286 ip_Hubbard_U_back(nt) /= 0.0_DP .OR. & 287 ip_Hubbard_alpha(nt) /= 0.0_dp .OR. & 288 ip_Hubbard_alpha_back(nt) /= 0.0_DP .OR. & 289 ip_Hubbard_J0(nt) /= 0.0_dp .OR. & 290 ip_Hubbard_beta(nt)/= 0.0_dp .OR. & 291 ANY(ip_Hubbard_J(:,nt) /= 0.0_DP) 292 IF (is_hubbard(nt)) hublmax = MAX (hublmax, set_hubbard_l(upf(nt)%psd)) 293 ! 294 is_hubbard_back(nt) = ip_Hubbard_U_back(nt) /= 0.0_DP .OR. & 295 ip_Hubbard_alpha_back(nt) /= 0.0_DP 296 ! 297 END DO 298 IF ( ANY(ip_hubbard_u(1:ntyp) /=0.0_DP)) THEN 299 ALLOCATE(hubbard_U_(ntyp)) 300 hubbard_U_(1:ntyp) = ip_hubbard_u(1:ntyp) 301 END IF 302 IF ( ANY(ip_hubbard_u_back(1:ntyp) /=0.0_DP)) THEN 303 ALLOCATE(hubbard_U_back_(ntyp)) 304 hubbard_U_back_(1:ntyp) = ip_hubbard_u_back(1:ntyp) 305 END IF 306 IF (ANY (ip_hubbard_J0 /=0.0_DP)) THEN 307 ALLOCATE(hubbard_J0_(ntyp)) 308 hubbard_J0_ (1:ntyp) = ip_hubbard_J0(1:ntyp) 309 END IF 310 IF (ANY (ip_hubbard_alpha /=0.0_DP)) THEN 311 ALLOCATE(hubbard_alpha_(ntyp)) 312 hubbard_alpha_ (1:ntyp) = ip_hubbard_alpha(1:ntyp) 313 END IF 314 IF (ANY (ip_hubbard_alpha_back /=0.0_DP)) THEN 315 ALLOCATE(hubbard_alpha_back_(ntyp)) 316 hubbard_alpha_back_ (1:ntyp) = ip_hubbard_alpha_back(1:ntyp) 317 END IF 318 IF (ANY (ip_hubbard_beta /=0.0_DP)) THEN 319 ALLOCATE(hubbard_beta_(ntyp)) 320 hubbard_beta_ (1:ntyp) = ip_hubbard_beta(1:ntyp) 321 END IF 322 IF (ANY (ip_hubbard_J(:,1:ntyp) /=0.0_DP )) THEN 323 ALLOCATE(hubbard_J_(3,ntyp)) 324 hubbard_J_(1:3,1:ntyp) = ip_hubbard_J(1:3,1:ntyp) 325 END IF 326 ! 327 IF (ANY(starting_ns_eigenvalue /= -1.0_DP)) THEN 328 IF (lsda) THEN 329 spin_ns = 2 330 ELSE 331 spin_ns = 1 332 END IF 333 ALLOCATE (starting_ns_(2*hublmax+1, spin_ns, ntyp)) 334 starting_ns_ (1:2*hublmax+1, 1:spin_ns, 1:ntyp) = & 335 starting_ns_eigenvalue(1:2*hublmax+1, 1:spin_ns, 1:ntyp) 336 END IF 337 ! 338 IF (ANY(is_hubbard_back(1:ntyp))) THEN 339 ALLOCATE (Hubbard_l_back_(ntyp)) 340 IF (ANY(lback>=0)) THEN 341 Hubbard_l_back_(1:ntyp) = lback(1:ntyp) 342 ELSE 343 DO nt = 1, ntyp 344 Hubbard_l_back_(nt) = set_hubbard_l_back(upf(nt)%psd) 345 END DO 346 END IF 347 IF (ANY(ip_backall) ) THEN 348 ALLOCATE(backall_(ntyp)) 349 backall_ (1:ntyp) = ip_backall(1:ntyp) 350 IF (ANY(l1back >=0)) THEN 351 ALLOCATE(Hubbard_l1_back_(ntyp)) 352 Hubbard_l1_back_ (1:ntyp) = l1back(1:ntyp) 353 ENDIF 354 END IF 355 END IF 356 ! 357 CALL qexsd_init_dftU(dftU_, NSP = ntyp, PSD = upf(1:ntyp)%psd, SPECIES = atm(1:ntyp), ITYP = ip_ityp(1:ntyp), & 358 IS_HUBBARD = is_hubbard(1:ntyp), IS_HUBBARD_BACK= is_hubbard_back(1:ntyp), & 359 NONCOLIN=ip_noncolin, LDA_PLUS_U_KIND = ip_lda_plus_u_kind, & 360 U_PROJECTION_TYPE=u_projection_type, & 361 U=hubbard_U_, U_back=hubbard_U_back_, HUBB_L_BACK = Hubbard_l_back_, & 362 HUBB_L1_BACK= Hubbard_l1_back_, J0=hubbard_J0_, J = hubbard_J_, & 363 ALPHA = hubbard_alpha_, BETA = hubbard_beta_, ALPHA_BACK = hubbard_alpha_back_, & 364 STARTING_NS = starting_ns_, BACKALL = backall_ ) 365 END IF 366 CALL qexsd_init_dft(obj%dft, TRIM(dft_name), hybrid_, vdW_, dftU_) 367 IF (ASSOCIATED(hybrid_)) THEN 368 CALL qes_reset(hybrid_) 369 DEALLOCATE(hybrid_) 370 END IF 371 IF (ASSOCIATED(vdW_)) THEN 372 CALL qes_reset(vdW_) 373 DEALLOCATE(vdW_) 374 END IF 375 IF (ASSOCIATED(dftU_)) THEN 376 CALL qes_reset(dftU_) 377 DEALLOCATE(dftU_) 378 END IF 379 380 ! 381 !------------------------------------------------------------------------------------------------------------------------ 382 ! SPIN ELEMENT 383 !------------------------------------------------------------------------------------------------------------------------- 384 IF (ip_nspin == 2) THEN 385 lsda=.TRUE. 386 ELSE 387 lsda=.FALSE. 388 END IF 389 CALL qexsd_init_spin(obj%spin, lsda, ip_noncolin, ip_spinorbit) 390 !------------------------------------------------------------------------------------------------------------------------- 391 ! BANDS ELEMENT 392 !------------------------------------------------------------------------------------------------------------------------- 393 IF (nbnd /= 0) THEN 394 nbnd_tg = nbnd 395 nbnd_pt => nbnd_tg 396 END IF 397 smearing_loc = schema_smearing(smearing) 398 IF (tf_inp) THEN 399 SELECT CASE (ip_nspin) 400 CASE (2) 401 CALL qexsd_init_bands(obj%bands, nbnd_pt, smearing_loc, degauss/e2, & 402 ip_occupations, tot_charge, ip_nspin, & 403 input_occupations=f_inp(:,1),input_occupations_minority=f_inp(:,2)) 404 CASE default 405 CALL qexsd_init_bands(obj%bands, nbnd_pt, smearing_loc, degauss/e2, & 406 ip_occupations, tot_charge, ip_nspin, input_occupations=f_inp(:,1) ) 407 END SELECT 408 ELSE 409 IF ( tot_magnetization .LT. 0 ) THEN 410 CALL qexsd_init_bands(obj%bands, nbnd_pt, smearing_loc, degauss/e2, ip_occupations, tot_charge, ip_nspin) 411 ELSE 412 CALL qexsd_init_bands(obj%bands, nbnd_pt, smearing_loc, degauss/e2, ip_occupations, tot_charge, ip_nspin, & 413 TOT_MAG = tot_magnetization) 414 END IF 415 END IF 416 !---------------------------------------------------------------------------------------------------------------------------- 417 ! BASIS ELEMENT 418 !--------------------------------------------------------------------------------------------------------------------------- 419 IF (ANY([ip_nr1,ip_nr2,ip_nr3] /=0)) THEN 420 ALLOCATE (nr_(3)) 421 nr_ = [ip_nr1,ip_nr2,ip_nr3] 422 END IF 423 IF (ANY([ip_nr1s,ip_nr2s,ip_nr3s] /=0)) THEN 424 ALLOCATE (nrs_(3)) 425 nrs_ = [ip_nr1s,ip_nr2s,ip_nr3s] 426 END IF 427 IF (ANY([ip_nr1b,ip_nr2b,ip_nr3b] /=0)) THEN 428 ALLOCATE(nrb_(3)) 429 nrb_ = [ip_nr1b,ip_nr2b,ip_nr3b] 430 END IF 431 432 CALL qexsd_init_basis(obj%basis, ip_k_points, ecutwfc/e2, ip_ecutrho/e2, nr_ , nrs_, nrb_ ) 433 !----------------------------------------------------------------------------------------------------------------------------- 434 ! ELECTRON CONTROL 435 !------------------------------------------------------------------------------------------------------------------------------ 436 IF (TRIM(ip_diagonalization) == 'david') THEN 437 diagonalization = 'davidson' 438 ELSE 439 diagonalization = ip_diagonalization 440 END IF 441 CALL qexsd_init_electron_control(obj%electron_control, diagonalization, mixing_mode, mixing_beta, conv_thr/e2, & 442 mixing_ndim, electron_maxstep, tqr, real_space, tq_smoothing, tbeta_smoothing, diago_thr_init, & 443 diago_full_acc, diago_cg_maxiter, diago_ppcg_maxiter, diago_david_ndim ) 444 !-------------------------------------------------------------------------------------------------------------------------------- 445 ! K POINTS IBZ ELEMENT 446 !------------------------------------------------------------------------------------------------------------------------------ 447 IF (TRIM(ip_k_points) .EQ. 'gamma' ) THEN 448 gamma_xk(:,1)=[0._DP, 0._DP, 0._DP] 449 gamma_wk(1)=1._DP 450 CALL qexsd_init_k_points_ibz( obj%k_points_ibz, ip_k_points, calculation, nk1, nk2, nk3, k1, k2, k3, 1, & 451 gamma_xk, gamma_wk ,alat,a1,ibrav_lattice) 452 453 ELSE 454 CALL qexsd_init_k_points_ibz(obj%k_points_ibz, ip_k_points, calculation, nk1, nk2, nk3, k1, k2, k3, nkstot, & 455 ip_xk, ip_wk,alat,a1, ibrav_lattice) 456 457 END IF 458 !-------------------------------------------------------------------------------------------------------------------------------- 459 ! ION CONTROL ELEMENT 460 !-------------------------------------------------------------------------------------------------------------------------------- 461 CALL qexsd_init_ion_control(obj%ion_control, ion_dynamics, upscale, remove_rigid_rot, refold_pos, & 462 pot_extrapolation, wfc_extrapolation, ion_temperature, tempw, tolp, delta_t, nraise, & 463 ip_dt, bfgs_ndim, trust_radius_min, trust_radius_max, trust_radius_ini, w_1, w_2) 464 !-------------------------------------------------------------------------------------------------------------------------------- 465 ! CELL CONTROL ELEMENT 466 !------------------------------------------------------------------------------------------------------------------------------- 467 CALL qexsd_init_cell_control(obj%cell_control, cell_dynamics, press, wmass, cell_factor, cell_dofree, cb_iforceh) 468 !--------------------------------------------------------------------------------------------------------------------------------- 469 ! SYMMETRY FLAGS 470 !------------------------------------------------------------------------------------------------------------------------ 471 obj%symmetry_flags_ispresent = .TRUE. 472 CALL qexsd_init_symmetry_flags(obj%symmetry_flags, ip_nosym,ip_nosym_evc, ip_noinv, ip_no_t_rev, & 473 ip_force_symmorphic, ip_use_all_frac) 474 !------------------------------------------------------------------------------------------------------------------------ 475 ! BOUNDARY CONDITIONS 476 !---------------------------------------------------------------------------------------------------------------------------- 477 IF (TRIM( assume_isolated ) .EQ. "none" ) THEN 478 obj%boundary_conditions_ispresent=.FALSE. 479 ELSE 480 obj%boundary_conditions_ispresent = .TRUE. 481 IF ( TRIM ( assume_isolated) .EQ. "esm") THEN 482 SELECT CASE (TRIM(esm_bc)) 483 CASE ('pbc', 'bc1' ) 484 CALL qexsd_init_boundary_conditions(obj%boundary_conditions, assume_isolated, esm_bc,& 485 ESM_NFIT = esm_nfit, ESM_W = esm_w,ESM_EFIELD = esm_efield) 486 CASE ('bc2', 'bc3' ) 487 CALL qexsd_init_boundary_conditions(obj%boundary_conditions, assume_isolated, esm_bc, & 488 FCP_OPT = ip_lfcpopt, FCP_MU = ip_fcp_mu, & 489 ESM_NFIT = esm_nfit, ESM_W = esm_w,ESM_EFIELD = esm_efield) 490 END SELECT 491 ELSE 492 CALL qexsd_init_boundary_conditions(obj%boundary_conditions, assume_isolated) 493 END IF 494 END IF 495 !---------------------------------------------------------------------------------------------------------------------------- 496 ! EKIN FUNCTIONAL 497 !------------------------------------------------------------------------------------------------------------------------------- 498 IF (ecfixed .GT. 1.d-3) THEN 499 obj%ekin_functional_ispresent = .TRUE. 500 CALL qexsd_init_ekin_functional ( obj%ekin_functional, ecfixed, qcutz, q2sigma) 501 ELSE 502 obj%ekin_functional_ispresent = .FALSE. 503 END IF 504 !----------------------------------------------------------------------------------------------------------------------------- 505 ! EXTERNAL FORCES 506 !------------------------------------------------------------------------------------------------------------------------------ 507 IF ( tforces ) THEN 508 obj%external_atomic_forces_ispresent = .TRUE. 509 CALL qexsd_init_external_atomic_forces (obj%external_atomic_forces, rd_for,ip_nat) 510 ELSE 511 obj%external_atomic_forces_ispresent= .FALSE. 512 END IF 513 !------------------------------------------------------------------------------------------------------------------------------- 514 ! FREE POSITIONS 515 !---------------------------------------------------------------------------------------------------------------------------- 516 IF ( TRIM(calculation) .NE. "scf" .AND. TRIM(calculation) .NE. "nscf" .AND. & 517 TRIM(calculation) .NE. "bands") THEN 518 obj%free_positions_ispresent=.TRUE. 519 CALL qexsd_init_free_positions( obj%free_positions, rd_if_pos, ip_nat) 520 ELSE 521 obj%free_positions_ispresent = .FALSE. 522 END IF 523 !---------------------------------------------------------------------------------------------------------------------------- 524 ! STARTING IONIC VELOCITIES 525 !----------------------------------------------------------------------------------------------------------------------------- 526 IF (tionvel) THEN 527 obj%starting_atomic_velocities_ispresent=.TRUE. 528 CALL qexsd_init_starting_atomic_velocities(obj%starting_atomic_velocities,tionvel,rd_vel,ip_nat) 529 ELSE 530 obj%starting_atomic_velocities_ispresent=.FALSE. 531 END IF 532 !------------------------------------------------------------------------------------------------------------------------------- 533 ! ELECTRIC FIELD 534 !--------------------------------------------------------------------------------------------------------------------------- 535 IF (tefield .OR. lelfield .OR. lberry .or. gate ) THEN 536 obj%electric_field_ispresent=.TRUE. 537 IF ( gate ) THEN 538 gate_tgt = gate 539 gate_ptr => gate_tgt 540 zgate_tgt = zgate 541 zgate_ptr => zgate_tgt 542 block_tgt = block 543 block_ptr => block_tgt 544 block_1_tgt = block_1 545 block_1_ptr => block_1_tgt 546 block_2_tgt = block_2 547 block_2_ptr => block_2_tgt 548 block_height_tgt = block_height 549 block_height_ptr => block_height_tgt 550 relaxz_tgt = relaxz 551 relaxz_ptr => relaxz_tgt 552 END IF 553 CALL qexsd_init_electric_field_input(obj%electric_field, tefield, dipfield, lelfield, lberry, & 554 edir, gdir, emaxpos, eopreg, eamp, efield, efield_cart, nberrycyc, nppstr, & 555 GATE = gate_ptr, ZGATE = zgate_ptr, RELAXZ = relaxz_ptr, BLOCK = block_ptr,& 556 BLOCK_1 = block_1_ptr, BLOCK_2 = block_2_ptr, BLOCK_HEIGHT = block_height_ptr) 557 ELSE 558 obj%electric_field_ispresent=.FALSE. 559 END IF 560 !----------------------------------------------------------------------------------------------------------------------- 561 ! ATOMIC CONSTRAINTS 562 !------------------------------------------------------------------------------------------------------------------------ 563 IF (tconstr) THEN 564 obj%atomic_constraints_ispresent=.TRUE. 565 CALL qexsd_init_atomic_constraints( obj%atomic_constraints, ion_dynamics, tconstr, nconstr_inp,constr_type_inp, & 566 constr_tol_inp, constr_target_inp, constr_inp) 567 ELSE 568 obj%atomic_constraints_ispresent=.FALSE. 569 END IF 570 !----------------------------------------------------------------------------------------------------------------------------- 571 ! SPIN CONSTRAINTS 572 !------------------------------------------------------------------------------------------------------------------------------ 573 574 SELECT CASE (TRIM( constrained_magnetization )) 575 576 CASE ("total","total direction") 577 obj%spin_constraints_ispresent=.TRUE. 578 CALL qexsd_init_spin_constraints(obj%spin_constraints, constrained_magnetization,lambda,& 579 fixed_magnetization) 580 CASE ("atomic", "atomic direction") 581 obj%spin_constraints_ispresent=.TRUE. 582 CALL qexsd_init_spin_constraints(obj%spin_constraints, constrained_magnetization, lambda ) 583 CASE default 584 obj%spin_constraints_ispresent=.FALSE. 585 END SELECT 586 587 588 obj%lread=.TRUE. 589 obj%lwrite=.TRUE. 590 ! 591 ! 592 END SUBROUTINE pw_init_qexsd_input 593 ! 594