1! 2! Copyright (C) 2016-2019 Quantum ESPRESSO foundation 3! This file is distributed under the terms of the 4! GNU General Public License. See the file `License' 5! in the root directory of the present distribution, 6! or http://www.gnu.org/copyleft/gpl.txt . 7! 8!--------------------------------------------------------- 9MODULE qexsd_input 10!-------------------------------------------------------- 11 ! This module contains the data structures for the XML input of pw.x 12 ! and the routines neeeded to initialise it 13 !---------------------------------------------------------------------------- 14 ! First version March 2016, modified Aug. 2019 15 !----------- ------------- --------------------------------------------------- 16 USE kinds, ONLY : dp 17 ! 18 USE qes_types_module 19 USE qes_libs_module 20 ! 21 IMPLICIT NONE 22 ! 23 PRIVATE 24 SAVE 25 !! input data structure 26 TYPE(input_type) :: qexsd_input_obj 27 PUBLIC :: qexsd_input_obj 28 !! routines for input data structure initialization 29 !! note that the data structure is passed as argument 30 PUBLIC :: & 31 qexsd_init_control_variables, & 32 qexsd_init_spin, & 33 qexsd_init_bands, & 34 qexsd_init_basis, & 35 qexsd_init_electron_control, & 36 qexsd_init_k_points_ibz, & 37 qexsd_init_ion_control, & 38 qexsd_init_cell_control, & 39 qexsd_init_symmetry_flags, & 40 qexsd_init_boundary_conditions, & 41 qexsd_init_ekin_functional, & 42 qexsd_init_external_atomic_forces, & 43 qexsd_init_free_positions, & 44 qexsd_init_starting_atomic_velocities, & 45 qexsd_init_spin_constraints, & 46 qexsd_init_electric_field_input, & 47 qexsd_init_atomic_constraints, & 48 qexsd_init_occupations, & 49 qexsd_init_smearing 50 ! 51 CONTAINS 52 !-------------------------------------------------------------------------------------------------------------------- 53 SUBROUTINE qexsd_init_control_variables(obj,title,calculation,restart_mode,& 54 prefix,pseudo_dir,outdir,stress,forces,wf_collect,disk_io, & 55 max_seconds,etot_conv_thr,forc_conv_thr,press_conv_thr,verbosity, & 56 iprint, nstep) 57 !--------------------------------------------------------------------------------------------------------------------- 58 ! 59 TYPE(control_variables_type) :: obj 60 CHARACTER(LEN=*),INTENT(IN) :: title,calculation,restart_mode,prefix,& 61 pseudo_dir,outdir,disk_io,verbosity 62 LOGICAL,INTENT(IN) :: stress,forces,wf_collect 63 REAL(DP),INTENT(IN) :: max_seconds,etot_conv_thr,forc_conv_thr,& 64 press_conv_thr 65 INTEGER,INTENT(IN) :: iprint, nstep 66 OPTIONAL :: nstep 67 ! 68 ! 69 CHARACTER(LEN=*),PARAMETER :: TAGNAME='control_variables' 70 CHARACTER(LEN=256) :: verbosity_value, disk_io_value 71 INTEGER :: int_max_seconds 72 LOGICAL :: nstep_ispresent 73 74 int_max_seconds=nint(max_seconds) 75 IF ( TRIM( verbosity ) .EQ. 'default' ) THEN 76 verbosity_value = "low" 77 ELSE 78 verbosity_value=TRIM(verbosity) 79 END IF 80 IF ( TRIM(disk_io) .EQ. 'default' ) THEN 81 disk_io_value="low" 82 ELSE 83 disk_io_value=TRIM(disk_io) 84 END IF 85 ! 86 ! 87 CALL qes_init (obj,tagname,title=TRIM(title),calculation=TRIM(calculation),& 88 restart_mode=TRIM(restart_mode),prefix=TRIM(prefix), & 89 pseudo_dir=TRIM(pseudo_dir),outdir=TRIM(outdir),disk_io=TRIM(disk_io_value),& 90 verbosity=TRIM(verbosity_value),stress=stress,forces=forces, & 91 wf_collect=wf_collect,max_seconds=int_max_seconds, & 92 etot_conv_thr=etot_conv_thr,forc_conv_thr=forc_conv_thr, & 93 press_conv_thr=press_conv_thr,print_every=iprint, NSTEP = nstep ) 94 95 END SUBROUTINE qexsd_init_control_variables 96 ! 97 ! 98 !---------------------------------------------------------------------------------------- 99 SUBROUTINE qexsd_init_spin(obj,lsda,noncolin,spinorbit) 100 ! 101 IMPLICIT NONE 102 ! 103 TYPE(spin_type) :: obj 104 LOGICAL,INTENT(IN) :: lsda,noncolin,spinorbit 105 ! 106 CHARACTER(LEN=*),PARAMETER :: TAGNAME="spin" 107 108 CALL qes_init (obj,TAGNAME,lsda=lsda,noncolin=noncolin,spinorbit=spinorbit) 109 110 END SUBROUTINE qexsd_init_spin 111 ! 112 ! 113 !------------------------------------------------------------------------------------- 114 SUBROUTINE qexsd_init_bands(obj, nbnd, smearing, degauss, occupations, tot_charge, nspin, & 115 input_occupations, input_occupations_minority, tot_mag) 116 ! 117 IMPLICIT NONE 118 ! 119 TYPE ( bands_type) :: obj 120 INTEGER,OPTIONAL, INTENT(IN) :: nbnd 121 INTEGER,INTENT(IN) :: nspin 122 CHARACTER(LEN=*),INTENT(IN) :: occupations,smearing 123 REAL(DP),INTENT(IN) :: degauss 124 REAL(DP),DIMENSION(:),OPTIONAL,INTENT(IN) :: input_occupations, input_occupations_minority 125 REAL(DP),OPTIONAL,INTENT(IN) :: tot_mag, tot_charge 126 ! 127 INTEGER :: spin_degeneracy, inpOcc_size = 0 128 CHARACTER(LEN=*),PARAMETER :: TAGNAME="bands" 129 TYPE(smearing_type),POINTER :: smearing_obj => NULL() 130 TYPE(occupations_type) :: occup_obj 131 TYPE(inputoccupations_type),ALLOCATABLE :: inpOcc_objs(:) 132 LOGICAL :: tot_mag_ispresent = .FALSE., & 133 inp_occ_arepresent = .FALSE. 134 ! 135 IF (TRIM(occupations) .EQ. "smearing") THEN 136 ALLOCATE(smearing_obj) 137 CALL qes_init (smearing_obj,"smearing",degauss=degauss,smearing=smearing) 138 END IF 139 CALL qes_init (occup_obj, "occupations", occupations = TRIM(occupations)) 140 ! 141 IF (PRESENT(input_occupations) ) THEN 142 SELECT CASE ( nspin) 143 CASE (2) 144 inpOcc_size=2 145 CASE default 146 inpOcc_size=1 147 END SELECT 148 ALLOCATE (inpOcc_objs(inpOcc_size)) 149 IF ( inpOcc_size .GT. 1) THEN 150 CALL qes_init ( inpOcc_objs(1),"input_occupations", ISPIN = 1, & 151 SPIN_FACTOR = 1._DP, INPUTOCCUPATIONS = input_occupations(2:nbnd) ) 152 CALL qes_init ( inpOcc_objs(2),"input_occupations", 2, & 153 SPIN_FACTOR = 1._DP , INPUTOCCUPATIONS = input_occupations_minority(2:nbnd)) 154 ELSE 155 CALL qes_init ( inpOcc_objs(1),"input_occupations", ISPIN = 1, SPIN_FACTOR = 2._DP , & 156 INPUTOCCUPATIONS = input_occupations(2:nbnd) ) 157 END IF 158 END IF 159 ! 160 CALL qes_init (obj, TAGNAME, NBND = nbnd, SMEARING = smearing_obj, TOT_CHARGE = tot_charge, & 161 TOT_MAGNETIZATION = tot_mag, OCCUPATIONS=occup_obj, INPUTOCCUPATIONS = inpOcc_objs ) 162 IF (ASSOCIATED(smearing_obj)) THEN 163 CALL qes_reset (smearing_obj) 164 DEALLOCATE ( smearing_obj) 165 END IF 166 CALL qes_reset (occup_obj) 167 IF (ALLOCATED(inpOcc_objs)) THEN 168 CALL qes_reset (inpocc_objs(1)) 169 IF (inpOcc_size .GT. 1 ) CALL qes_reset (inpocc_objs(2)) 170 DEALLOCATE (inpocc_objs) 171 END IF 172 ! 173 END SUBROUTINE qexsd_init_bands 174 ! 175 ! 176 !-------------------------------------------------------------------------------------------------------------------- 177 SUBROUTINE qexsd_init_basis(obj,k_points,ecutwfc,ecutrho,nr,nrs,nrb) 178 !-------------------------------------------------------------------------------------------------------------------- 179 ! 180 IMPLICIT NONE 181 ! 182 TYPE (basis_type) :: obj 183 CHARACTER(LEN=*),INTENT(IN) :: k_points 184 REAL(DP),INTENT(IN) :: ecutwfc 185 REAL(DP),OPTIONAL,INTENT(IN) :: ecutrho 186 INTEGER,OPTIONAL,INTENT(IN) :: nr(:), nrs(:), nrb(:) 187 ! 188 TYPE(basisSetItem_type),POINTER :: grid_obj => NULL(), smooth_grid_obj => NULL(), box_obj => NULL() 189 CHARACTER(LEN=*),PARAMETER :: TAGNAME="basis",FFT_GRID="fft_grid",FFT_SMOOTH="fft_smooth", FFT_BOX="fft_box" 190 LOGICAL :: gamma_only=.FALSE. 191 ! 192 IF ( PRESENT(nr)) THEN 193 ALLOCATE(grid_obj) 194 CALL qes_init (grid_obj,FFT_GRID,nr(1),nr(2),nr(3),"grid set in input") 195 END IF 196 ! 197 IF( PRESENT(nrs)) THEN 198 ALLOCATE(smooth_grid_obj) 199 CALL qes_init (smooth_grid_obj,FFT_SMOOTH,nrs(1),nrs(2),nrs(3),"grid set in input") 200 END IF 201 ! 202 IF( PRESENT(nrb)) THEN 203 ALLOCATE(box_obj) 204 CALL qes_init (box_obj,FFT_BOX,nrb(1),nrb(2),nrb(3),"grid set in input") 205 END IF 206 ! 207 IF (TRIM(k_points) .EQ. "gamma" ) gamma_only=.TRUE. 208 209 CALL qes_init (obj,TAGNAME, GAMMA_ONLY=gamma_only,ECUTWFC=ecutwfc, ECUTRHO=ecutrho, FFT_GRID=grid_obj, & 210 FFT_SMOOTH=smooth_grid_obj, FFT_BOX=box_obj) 211 ! 212 IF (ASSOCIATED(grid_obj)) CALL qes_reset( grid_obj ) 213 IF (ASSOCIATED(smooth_grid_obj)) CALL qes_reset( smooth_grid_obj ) 214 IF (ASSOCIATED(box_obj)) CALL qes_reset( box_obj ) 215 ! 216 ! 217 ! 218 END SUBROUTINE qexsd_init_basis 219 !------------------------------------------------------------------------------------------- 220 SUBROUTINE qexsd_init_electron_control( obj,diagonalization,mixing_mode,mixing_beta,& 221 conv_thr, mixing_ndim, max_nstep, tqr, real_space, & 222 tq_smoothing, tbeta_smoothing, & 223 diago_thr_init, diago_full_acc, & 224 diago_cg_maxiter, diago_ppcg_maxiter, diago_david_ndim) 225 !------------------------------------------------------------------------------------------- 226 ! 227 IMPLICIT NONE 228 ! 229 TYPE(electron_control_type) :: obj 230 CHARACTER(LEN=*),INTENT(IN) :: diagonalization,mixing_mode 231 REAL(DP),INTENT(IN) :: mixing_beta, conv_thr, diago_thr_init 232 INTEGER,INTENT(IN) :: mixing_ndim,max_nstep, diago_cg_maxiter, & 233 diago_ppcg_maxiter, diago_david_ndim 234 LOGICAL,OPTIONAL,INTENT(IN) :: diago_full_acc,tqr, real_space, tq_smoothing, tbeta_smoothing 235 ! 236 CHARACTER(LEN=*),PARAMETER :: TAGNAME="electron_control" 237 ! 238 CALL qes_init (obj,TAGNAME, DIAGONALIZATION=diagonalization,& 239 MIXING_MODE=mixing_mode,MIXING_BETA=mixing_beta,& 240 CONV_THR=conv_thr,MIXING_NDIM=mixing_ndim,MAX_NSTEP=max_nstep,& 241 TQ_SMOOTHING= tq_smoothing, TBETA_SMOOTHING = tbeta_smoothing,& 242 REAL_SPACE_Q=tqr, REAL_SPACE_BETA = real_space, DIAGO_THR_INIT=diago_thr_init,& 243 DIAGO_FULL_ACC=diago_full_acc,DIAGO_CG_MAXITER=diago_cg_maxiter, & 244 DIAGO_PPCG_MAXITER=diago_ppcg_maxiter) 245 ! 246 END SUBROUTINE qexsd_init_electron_control 247 ! 248 ! 249 !------------------------------------------------------------------------------------------------- 250 SUBROUTINE qexsd_init_k_points_ibz(obj,k_points,calculation,nk1,nk2,nk3,s1,s2,s3,nk,xk,wk,alat,a1, ibrav_lattice) 251 ! 252 IMPLICIT NONE 253 ! 254 TYPE (k_points_IBZ_type) :: obj 255 CHARACTER(LEN=*),INTENT(IN) :: k_points,calculation 256 INTEGER,INTENT(IN) :: nk1,nk2,nk3,s1,s2,s3,nk 257 REAL(DP),INTENT(IN) :: xk(:,:),wk(:) 258 REAL(DP),INTENT(IN) :: alat,a1(3) 259 LOGICAL,INTENT(IN) :: ibrav_lattice 260 ! 261 CHARACTER(LEN=*),PARAMETER :: TAGNAME="k_points_IBZ" 262 TYPE(monkhorst_pack_type),POINTER :: mpack_obj_pt => NULL() 263 TYPE(monkhorst_pack_type),TARGET :: mpack_obj_ 264 TYPE(k_point_type),ALLOCATABLE :: kp_obj(:) 265 LOGICAL :: mpack_ispresent,kp_ispresent 266 CHARACTER(LEN=100) :: kind_of_grid 267 INTEGER :: ik,jk,kcount 268 REAL(DP),DIMENSION(3) :: my_xk 269 REAL(DP) :: scale_factor 270 INTEGER, POINTER :: kdim_opt => NULL() 271 INTEGER, TARGET :: kdim 272 ! 273 274 IF (TRIM(k_points).EQ."automatic") THEN 275 ! 276 IF ((s1+s2+s3).EQ.0) THEN 277 kind_of_grid="Monkhorst-Pack" 278 ELSE 279 kind_of_grid="Uniform grid with offset" 280 END IF 281 CALL qes_init (mpack_obj_,"monkhorst_pack",nk1,nk2,nk3, s1,s2,s3,kind_of_grid) 282 mpack_obj_pt => mpack_obj_ 283 ELSE 284 kdim_opt => kdim 285 IF ( ibrav_lattice ) THEN 286 scale_factor = 1.d0 287 ELSE 288 scale_factor=alat/sqrt(a1(1)*a1(1)+a1(2)*a1(2)+a1(3)*a1(3)) 289 END IF 290 ! 291 IF (TRIM(calculation).NE.'bands' .AND. (TRIM(k_points).EQ.'tpiba_b' .OR. & 292 TRIM(k_points) .EQ. 'crystal_b')) THEN 293 kdim=NINT(sum(wk(1:nk-1)))+1 294 ALLOCATE (kp_obj(kdim)) 295 kcount=1 296 CALL qes_init (kp_obj(kcount),"k_point", WEIGHT = 1.d0, K_POINT = xk(:,1)) 297 kcount=kcount+1 298 DO ik=1,nk-1 299 DO jk=1,NINT(wk(ik)) 300 my_xk=xk(:,ik)+(DBLE(jk)/wk(ik))*(xk(:,ik+1)-xk(:,ik)) 301 my_xk=my_xk*scale_factor 302 CALL qes_init (kp_obj(kcount),"k_point",WEIGHT = 1.d0, K_POINT = my_xk) 303 kcount=kcount+1 304 END DO 305 END DO 306 ELSE 307 kdim=nk 308 ALLOCATE (kp_obj(kdim)) 309 DO ik=1,kdim 310 my_xk=xk(:,ik)*scale_factor 311 CALL qes_init (kp_obj(ik),"k_point", WEIGHT = wk(ik),K_POINT=my_xk) 312 END DO 313 END IF 314 END IF 315 CALL qes_init (obj, TAGNAME, MONKHORST_PACK = mpack_obj_pt, NK = kdim_opt , K_POINT = kp_obj) 316 IF (ASSOCIATED (mpack_obj_pt)) THEN 317 CALL qes_reset (mpack_obj_) 318 mpack_obj_pt => NULL() 319 ELSE IF (ALLOCATED(kp_obj)) THEN 320 DO ik = 1, kdim 321 CALL qes_reset(kp_obj(ik)) 322 END DO 323 DEALLOCATE (kp_obj) ! this line is redundant because kp_obj is a local allocatable 324 END IF 325 326 END SUBROUTINE qexsd_init_k_points_ibz 327 ! 328 ! 329 !-------------------------------------------------------------------------------------------------- 330 SUBROUTINE qexsd_init_ion_control(obj,ion_dynamics,upscale,remove_rigid_rot,& 331 refold_pos,pot_extrapolation,wfc_extrapolation,& 332 ion_temperature,tempw,tolp,delta_t,nraise,dt,& 333 bfgs_ndim,trust_radius_min,trust_radius_max,& 334 trust_radius_init,w_1,w_2) 335 !-------------------------------------------------------------------------------------------------- 336 ! 337 IMPLICIT NONE 338 ! 339 TYPE (ion_control_type) :: obj 340 CHARACTER(LEN=*),INTENT(IN) :: ion_dynamics,pot_extrapolation,wfc_extrapolation,& 341 ion_temperature 342 REAL(DP),OPTIONAL,INTENT(IN) :: upscale, tempw,tolp,delta_t,trust_radius_min,trust_radius_max,& 343 trust_radius_init,w_1,w_2 344 INTEGER,INTENT(IN) :: nraise,bfgs_ndim 345 REAL(DP),INTENT(IN) :: dt 346 LOGICAL,OPTIONAL,INTENT(IN) :: remove_rigid_rot,refold_pos 347 ! 348 ! 349 TYPE(md_type),POINTER :: md_obj =>NULL() 350 TYPE(bfgs_type),POINTER :: bfgs_obj => NULL() 351 CHARACTER(LEN=*),PARAMETER :: TAGNAME="ion_control" 352 LOGICAL :: bfgs_ispresent,md_ispresent 353 ! 354 ! 355 IF (TRIM(ion_dynamics)=="bfgs") THEN 356 ALLOCATE (bfgs_obj) 357 CALL qes_init (bfgs_obj,"bfgs",ndim=bfgs_ndim,trust_radius_min=trust_radius_min,& 358 trust_radius_max=trust_radius_max,trust_radius_init=trust_radius_init,& 359 w1=w_1,w2=w_2) 360 ELSE IF(TRIM(ion_dynamics)=="verlet" .OR. TRIM(ion_dynamics)=="langevin" .OR. & 361 TRIM(ion_dynamics) == "langevin-smc" ) THEN 362 ALLOCATE(md_obj) 363 CALL qes_init (md_obj,"md",pot_extrapolation=pot_extrapolation,& 364 wfc_extrapolation=wfc_extrapolation,ion_temperature=ion_temperature,& 365 tolp=tolp,timestep=dt,deltaT=delta_t,nraise=nraise,tempw=tempw) 366 END IF 367 CALL qes_init (obj,TAGNAME,ion_dynamics=TRIM(ion_dynamics), UPSCALE=upscale, REMOVE_RIGID_ROT=remove_rigid_rot,& 368 REFOLD_POS=refold_pos, BFGS=bfgs_obj, MD=md_obj) 369 IF (ASSOCIATED(bfgs_obj)) THEN 370 CALL qes_reset (bfgs_obj) 371 DEALLOCATE(bfgs_obj) 372 END IF 373 IF (ASSOCIATED(md_obj)) THEN 374 CALL qes_reset (md_obj) 375 DEALLOCATE (md_obj) 376 END IF 377 ! 378 END SUBROUTINE qexsd_init_ion_control 379 ! 380 ! 381 !------------------------------------------------------------------------------------------ 382 SUBROUTINE qexsd_init_cell_control(obj,cell_dynamics, pressure, wmass,cell_factor,cell_dofree,iforceh) 383 !------------------------------------------------------------------------------------------ 384 ! 385 IMPLICIT NONE 386 ! 387 TYPE (cell_control_type) :: obj 388 CHARACTER(LEN=*),INTENT(IN) :: cell_dynamics, cell_dofree 389 REAL(DP),INTENT(IN) :: pressure, wmass, cell_factor 390 INTEGER,DIMENSION(3,3),INTENT(IN) :: iforceh 391 ! 392 CHARACTER(LEN=*),PARAMETER :: TAGNAME="cell_control" 393 INTEGER,DIMENSION(3,3) :: my_forceh 394 ! 395 LOGICAL :: fix_volume=.FALSE.,& 396 fix_area=.FALSE.,& 397 isotropic=.FALSE. 398 INTEGER :: i,j 399 TYPE(integerMatrix_type),TARGET :: free_cell_obj 400 TYPE(integerMatrix_type),POINTER :: free_cell_ptr => NULL() 401 ! 402 IF (ANY(iforceh /= 1)) THEN 403 free_cell_ptr => free_cell_obj 404 FORALL (i=1:3,j=1:3) my_forceh(i,j) = iforceh(i,j) 405 END IF 406 SELECT CASE (TRIM(cell_dofree)) 407 CASE ('all') 408 my_forceh = 1 409 CASE ('shape') 410 fix_volume = .TRUE. 411 CASE ('2Dshape') 412 fix_area = .TRUE. 413 CASE ('volume') 414 isotropic = .TRUE. 415 !CASE default 416 !NULLIFY ( free_cell_ptr) 417 END SELECT 418 IF (ASSOCIATED (free_cell_ptr)) CALL qes_init (free_cell_obj,"free_cell",[3,3],my_forceh, ORDER = 'F' ) 419 ! 420 CALL qes_init (obj,TAGNAME, PRESSURE = pressure, CELL_DYNAMICS=cell_dynamics, WMASS=wmass, CELL_FACTOR=cell_factor,& 421 FIX_VOLUME=fix_volume, FIX_AREA=fix_area, ISOTROPIC=isotropic, FREE_CELL=free_cell_ptr) 422 IF( ASSOCIATED(free_cell_ptr)) CALL qes_reset (free_cell_obj) 423 END SUBROUTINE qexsd_init_cell_control 424 ! 425 ! 426 !------------------------------------------------------------------------------------------- 427 SUBROUTINE qexsd_init_symmetry_flags(obj,nosym,nosym_evc,noinv,no_t_rev,force_symmorphic,& 428 use_all_frac) 429 !------------------------------------------------------------------------------------------- 430 ! 431 IMPLICIT NONE 432 ! 433 TYPE ( symmetry_flags_type) :: obj 434 LOGICAL,INTENT(IN) :: nosym,nosym_evc,noinv,no_t_rev,& 435 force_symmorphic,use_all_frac 436 ! 437 CHARACTER(LEN=*),PARAMETER :: TAGNAME="symmetry_flags" 438 CALL qes_init (obj,TAGNAME,nosym=nosym,nosym_evc=nosym_evc,noinv=noinv,& 439 no_t_rev=no_t_rev,force_symmorphic=force_symmorphic,& 440 use_all_frac=use_all_frac) 441 ! 442 END SUBROUTINE qexsd_init_symmetry_flags 443 ! 444 ! 445 !-------------------------------------------------------------------------------------------- 446 SUBROUTINE qexsd_init_boundary_conditions(obj,assume_isolated,esm_bc, fcp_opt, fcp_mu, esm_nfit,esm_w, esm_efield) 447 !-------------------------------------------------------------------------------------------- 448 ! 449 IMPLICIT NONE 450 ! 451 TYPE (boundary_conditions_type) :: obj 452 CHARACTER(LEN=*),INTENT(IN) :: assume_isolated 453 CHARACTER(LEN=*),OPTIONAL,INTENT(IN) :: esm_bc 454 LOGICAL,OPTIONAL,INTENT(IN) :: fcp_opt 455 REAL(DP),OPTIONAL,INTENT(IN) :: fcp_mu 456 INTEGER,OPTIONAL,INTENT(IN) :: esm_nfit 457 REAL(DP),OPTIONAL,INTENT(IN) :: esm_w,esm_efield 458 ! 459 TYPE (esm_type),POINTER :: esm_obj => NULL() 460 LOGICAL :: esm_ispresent = .FALSE. 461 CHARACTER(LEN=*),PARAMETER :: TAGNAME="boundary_conditions" 462 ! 463 IF ( TRIM(assume_isolated) .EQ. "esm" ) THEN 464 esm_ispresent = .TRUE. 465 ALLOCATE(esm_obj) 466 CALL qes_init (esm_obj,"esm",bc=TRIM(esm_bc),nfit=esm_nfit,w=esm_w,efield=esm_efield) 467 END IF 468 CALL qes_init (obj,TAGNAME,ASSUME_ISOLATED =assume_isolated, FCP_OPT= fcp_opt, FCP_MU = fcp_mu, ESM = esm_obj) 469 IF ( esm_ispresent ) THEN 470 CALL qes_reset (esm_obj) 471 DEALLOCATE(esm_obj) 472 END IF 473 END SUBROUTINE qexsd_init_boundary_conditions 474 ! 475 ! 476 !-------------------------------------------------------------------------------------- 477 SUBROUTINE qexsd_init_ekin_functional(obj,ecfixed,qcutz,q2sigma) 478 !-------------------------------------------------------------------------------------- 479 ! 480 IMPLICIT NONE 481 ! 482 TYPE (ekin_functional_type) :: obj 483 REAL(DP),INTENT(IN) :: ecfixed,qcutz,q2sigma 484 ! 485 CHARACTER(LEN=*),PARAMETER :: TAGNAME="ekin_functional" 486 CALL qes_init (obj,TAGNAME,ecfixed=ecfixed,qcutz=qcutz,q2sigma=q2sigma) 487 END SUBROUTINE qexsd_init_ekin_functional 488 ! 489 ! 490 !--------------------------------------------------------------------------------- 491 SUBROUTINE qexsd_init_external_atomic_forces(obj,extfor,nat) 492 ! 493 TYPE(matrix_type) :: obj 494 REAL(DP),DIMENSION(:,:),INTENT(IN) :: extfor 495 INTEGER,INTENT(IN) :: nat 496 ! 497 CHARACTER(LEN=*),PARAMETER :: TAGNAME="external_atomic_forces" 498 ! 499 CALL qes_init (obj,TAGNAME,[3,nat],mat=extfor, order = 'F' ) 500 END SUBROUTINE qexsd_init_external_atomic_forces 501 ! 502 ! 503 !------------------------------------------------------------------------------- 504 SUBROUTINE qexsd_init_free_positions(obj,if_pos,nat) 505 ! 506 IMPLICIT NONE 507 ! 508 TYPE(integerMatrix_type) :: obj 509 INTEGER,DIMENSION(:,:),INTENT(IN) :: if_pos 510 INTEGER,INTENT(IN) :: nat 511 ! 512 CHARACTER(LEN=*),PARAMETER :: TAGNAME = "free_positions" 513 REAL(DP),DIMENSION(:,:),ALLOCATABLE :: free_positions 514 ! 515 CALL qes_init (obj,TAGNAME,DIMS = [3,nat], MAT = if_pos, ORDER = 'F' ) 516 END SUBROUTINE qexsd_init_free_positions 517 ! 518 !---------------------------------------------------------------------------------- 519 SUBROUTINE qexsd_init_starting_atomic_velocities(obj,tv0rd,rd_vel,nat) 520 !---------------------------------------------------------------------------------- 521 ! 522 IMPLICIT NONE 523 ! 524 TYPE (matrix_type) :: obj 525 LOGICAL,INTENT(IN) :: tv0rd 526 REAL(DP),DIMENSION(:,:),INTENT(IN) :: rd_vel 527 INTEGER,INTENT(IN) :: nat 528 ! 529 CHARACTER(LEN=*),PARAMETER :: TAGNAME="starting_atomic_velocities" 530 INTEGER :: xdim=0,ydim=0 531 IF (tv0rd) THEN 532 xdim=3 533 ydim=nat 534 END IF 535 CALL qes_init (obj,TAGNAME,[xdim,ydim],rd_vel ) 536 END SUBROUTINE qexsd_init_starting_atomic_velocities 537 ! 538 !------------------------------------------------------------------------------------- 539 SUBROUTINE qexsd_init_spin_constraints(obj,constrained_magnetization,lambda,& 540 fixed_magnetization) 541 !------------------------------------------------------------------------------------- 542 ! 543 IMPLICIT NONE 544 ! 545 TYPE(spin_constraints_type) :: obj 546 CHARACTER(LEN=*),INTENT(IN) :: constrained_magnetization 547 REAL(DP),INTENT(IN) :: lambda 548 REAL(DP),DIMENSION(3),OPTIONAL,INTENT(IN) :: fixed_magnetization 549 ! 550 CHARACTER(LEN=*),PARAMETER :: TAGNAME="spin_constraints" 551 REAL(DP),DIMENSION(3) :: target_magnetization=0.d0 552 ! 553 IF (PRESENT(fixed_magnetization)) target_magnetization=fixed_magnetization 554 CALL qes_init (obj,TAGNAME,SPIN_CONSTRAINTS=TRIM(constrained_magnetization),& 555 TARGET_MAGNETIZATION=fixed_magnetization ,LAGRANGE_MULTIPLIER=lambda) 556 END SUBROUTINE qexsd_init_spin_constraints 557 ! 558 ! 559 !------------------------------------------------------------------------------------------------- 560 SUBROUTINE qexsd_init_electric_field_input (obj,tefield,dipfield,lelfield,lberry,edir,gdir,emaxpos,eopreg,eamp, & 561 efield,efield_cart,nberrycyc,nppstr, gate, zgate, relaxz, block, block_1, block_2, block_height ) 562 !--------------------------------------------------------------------------------------------------- 563 ! 564 IMPLICIT NONE 565 ! 566 TYPE (electric_field_type) :: obj 567 LOGICAL,INTENT(IN) :: tefield,lelfield, lberry 568 LOGICAL,OPTIONAL,INTENT(IN) :: dipfield 569 INTEGER,INTENT(IN),OPTIONAL :: edir,gdir,nberrycyc,nppstr 570 REAL(DP),INTENT(IN),OPTIONAL :: emaxpos,eopreg,eamp 571 REAL(DP),INTENT(IN),OPTIONAL :: efield 572 REAL(DP),INTENT(IN),OPTIONAL,DIMENSION(3) :: efield_cart 573 LOGICAL,INTENT(IN),OPTIONAL :: gate, block,relaxz 574 REAL(DP),INTENT(IN),OPTIONAL :: zgate,block_1, block_2, block_height 575 ! 576 CHARACTER(LEN=*),PARAMETER :: TAGNAME="electric_field",& 577 SAWTOOTH="sawtooth_potential",& 578 HOMOGENEOUS="homogenous_field",& 579 BERRYPHASE="Berry_Phase" 580 REAL(DP),POINTER :: efield_cart_loc(:)=>NULL(), electric_field_amplitude=>NULL() 581 INTEGER,POINTER :: electric_field_direction => NULL() 582 CHARACTER(LEN=256) :: electric_potential 583 LOGICAL :: gate_, block_ 584 REAL(DP) :: block_1_, block_2_, block_3_ 585 TYPE(gate_settings_type),TARGET :: gata_settings_obj 586 TYPE(gate_settings_type),POINTER :: gata_settings_ptr => NULL() 587 TARGET :: eamp, edir, efield, gdir 588 ! 589 electric_potential = "none" 590 IF (tefield) THEN 591 electric_potential=SAWTOOTH 592 electric_field_amplitude=>eamp 593 electric_field_direction=>edir 594 ELSE IF (lelfield) THEN 595 electric_potential=HOMOGENEOUS 596 IF (PRESENT(efield)) electric_field_amplitude => efield 597 IF ( gdir .GT. 0 ) electric_field_direction => gdir 598 ELSE IF (lberry) THEN 599 electric_potential=BERRYPHASE 600 IF ( gdir .GT. 0) electric_field_direction => gdir 601 END IF 602 IF (PRESENT (gate)) THEN 603 gata_settings_ptr => gata_settings_obj 604 CALL qes_init (gata_settings_obj, "gate_settings", gate, zgate, relaxz,& 605 block, block_1, block_2, block_height ) 606 END IF 607 CALL qes_init ( obj, TAGNAME, electric_potential=electric_potential, dipole_correction = dipfield, & 608 electric_field_direction=electric_field_direction, potential_max_position = emaxpos, & 609 potential_decrease_width = eopreg, electric_field_amplitude=electric_field_amplitude,& 610 electric_field_vector = efield_cart, n_berry_cycles=nberrycyc, nk_per_string=nppstr, & 611 gate_settings = gata_settings_obj) 612 END SUBROUTINE qexsd_init_electric_field_input 613 ! 614 !---------------------------------------------------------------------------------------------------------- 615 SUBROUTINE qexsd_init_atomic_constraints(obj,ion_dynamics,lconstrain,nconstr,constr_type,constr_tol, & 616 constr_target,constr) 617 !---------------------------------------------------------------------------------------------------------- 618 ! 619 IMPLICIT NONE 620 ! 621 TYPE (atomic_constraints_type) :: obj 622 CHARACTER(LEN=*),INTENT(IN) :: ion_dynamics 623 LOGICAL,INTENT(IN) :: lconstrain 624 INTEGER,OPTIONAL,INTENT(IN) :: nconstr 625 REAL(DP),OPTIONAL,INTENT(IN) :: constr(:,:) 626 CHARACTER(LEN=*),OPTIONAL,INTENT(IN) :: constr_type(:) 627 REAL(DP),OPTIONAL,INTENT(IN) :: constr_target(:),constr_tol 628 ! 629 CHARACTER(LEN=*),PARAMETER :: TAGNAME="atomic_constraints" 630 TYPE(atomic_constraint_type),ALLOCATABLE :: constr_objs(:) 631 INTEGER :: iconstr 632 ! 633 ! 634 ALLOCATE (constr_objs(nconstr)) 635 DO iconstr=1,nconstr 636 CALL qes_init (constr_objs(iconstr),"atomic_constraint", constr_parms=constr(:,iconstr),& 637 constr_type=TRIM(constr_type(iconstr)),constr_target=constr_target(iconstr)) 638 END DO 639 CALL qes_init (obj,TAGNAME, num_of_constraints=nconstr, atomic_constraint=constr_objs,tolerance=constr_tol) 640 DO iconstr=1,nconstr 641 CALL qes_reset (constr_objs(iconstr)) 642 END DO 643 DEALLOCATE (constr_objs) 644 END SUBROUTINE qexsd_init_atomic_constraints 645 ! 646 !------------------------------------------------------------------------------------------------------------ 647 SUBROUTINE qexsd_init_occupations(obj, occupations, nspin) 648 !------------------------------------------------------------------------------------------------------------ 649 ! 650 IMPLICIT NONE 651 TYPE(occupations_type),INTENT(OUT) :: obj 652 CHARACTER(LEN=*),INTENT(IN) :: occupations 653 INTEGER,INTENT(IN) :: nspin 654 ! 655 INTEGER :: spin_degeneracy 656 ! 657 IF (nspin .GT. 1) THEN 658 spin_degeneracy = 1 659 ELSE 660 spin_degeneracy = 2 661 END IF 662 CALL qes_init (obj, "occupations", occupations = TRIM(occupations)) 663 END SUBROUTINE qexsd_init_occupations 664 ! 665 !--------------------------------------------------------- 666 SUBROUTINE qexsd_init_smearing(obj, smearing, degauss) 667 !--------------------------------------------------------- 668 ! 669 IMPLICIT NONE 670 TYPE(smearing_type),INTENT(OUT) :: obj 671 CHARACTER(LEN = * ), INTENT(IN) :: smearing 672 REAL(DP),INTENT(IN) :: degauss 673 ! 674 CALL qes_init (obj,"smearing",degauss=degauss,smearing=smearing) 675 ! 676 END SUBROUTINE qexsd_init_smearing 677 !-------------------------------------------------------------------------------------------- 678 ! 679END MODULE qexsd_input 680 681