1! 2! Copyright (C) 2001-2009 Quantum ESPRESSO group 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! 8MODULE qes_write_module 9 ! 10 ! Auto-generated code: don't edit this file 11 ! 12 ! Quantum Espresso XSD namespace: http://www.quantum-espresso.org/ns/qes/qes-1.0 13 ! 14 USE qes_types_module 15 USE FoX_wxml 16 ! 17 IMPLICIT NONE 18 ! 19 PUBLIC 20 ! 21 INTERFACE qes_write 22 MODULE PROCEDURE qes_write_espresso 23 MODULE PROCEDURE qes_write_general_info 24 MODULE PROCEDURE qes_write_parallel_info 25 MODULE PROCEDURE qes_write_input 26 MODULE PROCEDURE qes_write_step 27 MODULE PROCEDURE qes_write_output 28 MODULE PROCEDURE qes_write_timing 29 MODULE PROCEDURE qes_write_clock 30 MODULE PROCEDURE qes_write_control_variables 31 MODULE PROCEDURE qes_write_xml_format 32 MODULE PROCEDURE qes_write_creator 33 MODULE PROCEDURE qes_write_created 34 MODULE PROCEDURE qes_write_atomic_species 35 MODULE PROCEDURE qes_write_species 36 MODULE PROCEDURE qes_write_atomic_structure 37 MODULE PROCEDURE qes_write_atomic_positions 38 MODULE PROCEDURE qes_write_atom 39 MODULE PROCEDURE qes_write_wyckoff_positions 40 MODULE PROCEDURE qes_write_cell 41 MODULE PROCEDURE qes_write_dft 42 MODULE PROCEDURE qes_write_hybrid 43 MODULE PROCEDURE qes_write_qpoint_grid 44 MODULE PROCEDURE qes_write_dftU 45 MODULE PROCEDURE qes_write_HubbardCommon 46 MODULE PROCEDURE qes_write_HubbardJ 47 MODULE PROCEDURE qes_write_starting_ns 48 MODULE PROCEDURE qes_write_Hubbard_ns 49 MODULE PROCEDURE qes_write_HubbardBack 50 MODULE PROCEDURE qes_write_backL 51 MODULE PROCEDURE qes_write_vdW 52 MODULE PROCEDURE qes_write_spin 53 MODULE PROCEDURE qes_write_bands 54 MODULE PROCEDURE qes_write_smearing 55 MODULE PROCEDURE qes_write_occupations 56 MODULE PROCEDURE qes_write_basis 57 MODULE PROCEDURE qes_write_basis_set 58 MODULE PROCEDURE qes_write_basisSetItem 59 MODULE PROCEDURE qes_write_reciprocal_lattice 60 MODULE PROCEDURE qes_write_electron_control 61 MODULE PROCEDURE qes_write_k_points_IBZ 62 MODULE PROCEDURE qes_write_monkhorst_pack 63 MODULE PROCEDURE qes_write_k_point 64 MODULE PROCEDURE qes_write_ion_control 65 MODULE PROCEDURE qes_write_bfgs 66 MODULE PROCEDURE qes_write_md 67 MODULE PROCEDURE qes_write_cell_control 68 MODULE PROCEDURE qes_write_symmetry_flags 69 MODULE PROCEDURE qes_write_boundary_conditions 70 MODULE PROCEDURE qes_write_esm 71 MODULE PROCEDURE qes_write_ekin_functional 72 MODULE PROCEDURE qes_write_spin_constraints 73 MODULE PROCEDURE qes_write_electric_field 74 MODULE PROCEDURE qes_write_gate_settings 75 MODULE PROCEDURE qes_write_atomic_constraints 76 MODULE PROCEDURE qes_write_atomic_constraint 77 MODULE PROCEDURE qes_write_inputOccupations 78 MODULE PROCEDURE qes_write_outputElectricField 79 MODULE PROCEDURE qes_write_BerryPhaseOutput 80 MODULE PROCEDURE qes_write_dipoleOutput 81 MODULE PROCEDURE qes_write_finiteFieldOut 82 MODULE PROCEDURE qes_write_polarization 83 MODULE PROCEDURE qes_write_ionicPolarization 84 MODULE PROCEDURE qes_write_electronicPolarization 85 MODULE PROCEDURE qes_write_phase 86 MODULE PROCEDURE qes_write_gateInfo 87 MODULE PROCEDURE qes_write_convergence_info 88 MODULE PROCEDURE qes_write_scf_conv 89 MODULE PROCEDURE qes_write_opt_conv 90 MODULE PROCEDURE qes_write_algorithmic_info 91 MODULE PROCEDURE qes_write_symmetries 92 MODULE PROCEDURE qes_write_symmetry 93 MODULE PROCEDURE qes_write_equivalent_atoms 94 MODULE PROCEDURE qes_write_info 95 MODULE PROCEDURE qes_write_outputPBC 96 MODULE PROCEDURE qes_write_magnetization 97 MODULE PROCEDURE qes_write_total_energy 98 MODULE PROCEDURE qes_write_band_structure 99 MODULE PROCEDURE qes_write_ks_energies 100 MODULE PROCEDURE qes_write_closed 101 MODULE PROCEDURE qes_write_vector 102 MODULE PROCEDURE qes_write_integerVector 103 MODULE PROCEDURE qes_write_matrix 104 MODULE PROCEDURE qes_write_integerMatrix 105 MODULE PROCEDURE qes_write_scalarQuantity 106 END INTERFACE qes_write 107 ! 108 CONTAINS 109 ! 110 111 SUBROUTINE qes_write_espresso(xp, obj) 112 !----------------------------------------------------------------- 113 IMPLICIT NONE 114 TYPE (xmlf_t),INTENT(INOUT) :: xp 115 TYPE(espresso_type),INTENT(IN) :: obj 116 ! 117 INTEGER :: i 118 ! 119 IF ( .NOT. obj%lwrite ) RETURN 120 ! 121 CALL xml_NewElement(xp, TRIM(obj%tagname)) 122 IF (obj%Units_ispresent) CALL xml_addAttribute(xp, 'Units', TRIM(obj%Units) ) 123 IF (obj%general_info_ispresent) THEN 124 CALL qes_write_general_info (xp, obj%general_info) 125 END IF 126 IF (obj%parallel_info_ispresent) THEN 127 CALL qes_write_parallel_info (xp, obj%parallel_info) 128 END IF 129 CALL qes_write_input (xp, obj%input) 130 IF (obj%step_ispresent) THEN 131 DO i = 1, obj%ndim_step 132 CALL qes_write_step(xp, obj%step(i) ) 133 END DO 134 END IF 135 IF (obj%output_ispresent) THEN 136 CALL qes_write_output (xp, obj%output) 137 END IF 138 IF (obj%status_ispresent) THEN 139 CALL xml_NewElement(xp, "status") 140 CALL xml_addCharacters(xp, obj%status) 141 CALL xml_EndElement(xp, "status") 142 END IF 143 IF (obj%cputime_ispresent) THEN 144 CALL xml_NewElement(xp, "cputime") 145 CALL xml_addCharacters(xp, obj%cputime) 146 CALL xml_EndElement(xp, "cputime") 147 END IF 148 IF (obj%timing_info_ispresent) THEN 149 CALL qes_write_timing (xp, obj%timing_info) 150 END IF 151 IF (obj%closed_ispresent) THEN 152 CALL qes_write_closed (xp, obj%closed) 153 END IF 154 CALL xml_EndElement(xp, TRIM(obj%tagname)) 155 END SUBROUTINE qes_write_espresso 156 157 SUBROUTINE qes_write_general_info(xp, obj) 158 !----------------------------------------------------------------- 159 IMPLICIT NONE 160 TYPE (xmlf_t),INTENT(INOUT) :: xp 161 TYPE(general_info_type),INTENT(IN) :: obj 162 ! 163 INTEGER :: i 164 ! 165 IF ( .NOT. obj%lwrite ) RETURN 166 ! 167 CALL xml_NewElement(xp, TRIM(obj%tagname)) 168 CALL qes_write_xml_format (xp, obj%xml_format) 169 CALL qes_write_creator (xp, obj%creator) 170 CALL qes_write_created (xp, obj%created) 171 CALL xml_NewElement(xp, 'job') 172 CALL xml_addCharacters(xp, TRIM(obj%job)) 173 CALL xml_EndElement(xp, 'job') 174 CALL xml_EndElement(xp, TRIM(obj%tagname)) 175 END SUBROUTINE qes_write_general_info 176 177 SUBROUTINE qes_write_parallel_info(xp, obj) 178 !----------------------------------------------------------------- 179 IMPLICIT NONE 180 TYPE (xmlf_t),INTENT(INOUT) :: xp 181 TYPE(parallel_info_type),INTENT(IN) :: obj 182 ! 183 INTEGER :: i 184 ! 185 IF ( .NOT. obj%lwrite ) RETURN 186 ! 187 CALL xml_NewElement(xp, TRIM(obj%tagname)) 188 CALL xml_NewElement(xp, 'nprocs') 189 CALL xml_addCharacters(xp, obj%nprocs) 190 CALL xml_EndElement(xp, 'nprocs') 191 CALL xml_NewElement(xp, 'nthreads') 192 CALL xml_addCharacters(xp, obj%nthreads) 193 CALL xml_EndElement(xp, 'nthreads') 194 CALL xml_NewElement(xp, 'ntasks') 195 CALL xml_addCharacters(xp, obj%ntasks) 196 CALL xml_EndElement(xp, 'ntasks') 197 CALL xml_NewElement(xp, 'nbgrp') 198 CALL xml_addCharacters(xp, obj%nbgrp) 199 CALL xml_EndElement(xp, 'nbgrp') 200 CALL xml_NewElement(xp, 'npool') 201 CALL xml_addCharacters(xp, obj%npool) 202 CALL xml_EndElement(xp, 'npool') 203 CALL xml_NewElement(xp, 'ndiag') 204 CALL xml_addCharacters(xp, obj%ndiag) 205 CALL xml_EndElement(xp, 'ndiag') 206 CALL xml_EndElement(xp, TRIM(obj%tagname)) 207 END SUBROUTINE qes_write_parallel_info 208 209 SUBROUTINE qes_write_input(xp, obj) 210 !----------------------------------------------------------------- 211 IMPLICIT NONE 212 TYPE (xmlf_t),INTENT(INOUT) :: xp 213 TYPE(input_type),INTENT(IN) :: obj 214 ! 215 INTEGER :: i 216 ! 217 IF ( .NOT. obj%lwrite ) RETURN 218 ! 219 CALL xml_NewElement(xp, TRIM(obj%tagname)) 220 CALL qes_write_control_variables (xp, obj%control_variables) 221 CALL qes_write_atomic_species (xp, obj%atomic_species) 222 CALL qes_write_atomic_structure (xp, obj%atomic_structure) 223 CALL qes_write_dft (xp, obj%dft) 224 CALL qes_write_spin (xp, obj%spin) 225 CALL qes_write_bands (xp, obj%bands) 226 CALL qes_write_basis (xp, obj%basis) 227 CALL qes_write_electron_control (xp, obj%electron_control) 228 CALL qes_write_k_points_IBZ (xp, obj%k_points_IBZ) 229 CALL qes_write_ion_control (xp, obj%ion_control) 230 CALL qes_write_cell_control (xp, obj%cell_control) 231 IF (obj%symmetry_flags_ispresent) THEN 232 CALL qes_write_symmetry_flags (xp, obj%symmetry_flags) 233 END IF 234 IF (obj%boundary_conditions_ispresent) THEN 235 CALL qes_write_boundary_conditions (xp, obj%boundary_conditions) 236 END IF 237 IF (obj%ekin_functional_ispresent) THEN 238 CALL qes_write_ekin_functional (xp, obj%ekin_functional) 239 END IF 240 IF (obj%external_atomic_forces_ispresent) THEN 241 CALL qes_write_matrix (xp, obj%external_atomic_forces) 242 END IF 243 IF (obj%free_positions_ispresent) THEN 244 CALL qes_write_integerMatrix (xp, obj%free_positions) 245 END IF 246 IF (obj%starting_atomic_velocities_ispresent) THEN 247 CALL qes_write_matrix (xp, obj%starting_atomic_velocities) 248 END IF 249 IF (obj%electric_field_ispresent) THEN 250 CALL qes_write_electric_field (xp, obj%electric_field) 251 END IF 252 IF (obj%atomic_constraints_ispresent) THEN 253 CALL qes_write_atomic_constraints (xp, obj%atomic_constraints) 254 END IF 255 IF (obj%spin_constraints_ispresent) THEN 256 CALL qes_write_spin_constraints (xp, obj%spin_constraints) 257 END IF 258 CALL xml_EndElement(xp, TRIM(obj%tagname)) 259 END SUBROUTINE qes_write_input 260 261 SUBROUTINE qes_write_step(xp, obj) 262 !----------------------------------------------------------------- 263 IMPLICIT NONE 264 TYPE (xmlf_t),INTENT(INOUT) :: xp 265 TYPE(step_type),INTENT(IN) :: obj 266 ! 267 INTEGER :: i 268 ! 269 IF ( .NOT. obj%lwrite ) RETURN 270 ! 271 CALL xml_NewElement(xp, TRIM(obj%tagname)) 272 CALL xml_addAttribute(xp, 'n_step', obj%n_step ) 273 CALL qes_write_scf_conv (xp, obj%scf_conv) 274 CALL qes_write_atomic_structure (xp, obj%atomic_structure) 275 CALL qes_write_total_energy (xp, obj%total_energy) 276 CALL qes_write_matrix (xp, obj%forces) 277 IF (obj%stress_ispresent) THEN 278 CALL qes_write_matrix (xp, obj%stress) 279 END IF 280 IF (obj%FCP_force_ispresent) THEN 281 CALL xml_NewElement(xp, "FCP_force") 282 CALL xml_addCharacters(xp, obj%FCP_force, fmt='s16') 283 CALL xml_EndElement(xp, "FCP_force") 284 END IF 285 IF (obj%FCP_tot_charge_ispresent) THEN 286 CALL xml_NewElement(xp, "FCP_tot_charge") 287 CALL xml_addCharacters(xp, obj%FCP_tot_charge, fmt='s16') 288 CALL xml_EndElement(xp, "FCP_tot_charge") 289 END IF 290 CALL xml_EndElement(xp, TRIM(obj%tagname)) 291 END SUBROUTINE qes_write_step 292 293 SUBROUTINE qes_write_output(xp, obj) 294 !----------------------------------------------------------------- 295 IMPLICIT NONE 296 TYPE (xmlf_t),INTENT(INOUT) :: xp 297 TYPE(output_type),INTENT(IN) :: obj 298 ! 299 INTEGER :: i 300 ! 301 IF ( .NOT. obj%lwrite ) RETURN 302 ! 303 CALL xml_NewElement(xp, TRIM(obj%tagname)) 304 IF (obj%convergence_info_ispresent) THEN 305 CALL qes_write_convergence_info (xp, obj%convergence_info) 306 END IF 307 CALL qes_write_algorithmic_info (xp, obj%algorithmic_info) 308 CALL qes_write_atomic_species (xp, obj%atomic_species) 309 CALL qes_write_atomic_structure (xp, obj%atomic_structure) 310 IF (obj%symmetries_ispresent) THEN 311 CALL qes_write_symmetries (xp, obj%symmetries) 312 END IF 313 CALL qes_write_basis_set (xp, obj%basis_set) 314 CALL qes_write_dft (xp, obj%dft) 315 IF (obj%boundary_conditions_ispresent) THEN 316 CALL qes_write_outputPBC (xp, obj%boundary_conditions) 317 END IF 318 CALL qes_write_magnetization (xp, obj%magnetization) 319 CALL qes_write_total_energy (xp, obj%total_energy) 320 CALL qes_write_band_structure (xp, obj%band_structure) 321 IF (obj%forces_ispresent) THEN 322 CALL qes_write_matrix (xp, obj%forces) 323 END IF 324 IF (obj%stress_ispresent) THEN 325 CALL qes_write_matrix (xp, obj%stress) 326 END IF 327 IF (obj%electric_field_ispresent) THEN 328 CALL qes_write_outputElectricField (xp, obj%electric_field) 329 END IF 330 IF (obj%FCP_force_ispresent) THEN 331 CALL xml_NewElement(xp, "FCP_force") 332 CALL xml_addCharacters(xp, obj%FCP_force, fmt='s16') 333 CALL xml_EndElement(xp, "FCP_force") 334 END IF 335 IF (obj%FCP_tot_charge_ispresent) THEN 336 CALL xml_NewElement(xp, "FCP_tot_charge") 337 CALL xml_addCharacters(xp, obj%FCP_tot_charge, fmt='s16') 338 CALL xml_EndElement(xp, "FCP_tot_charge") 339 END IF 340 CALL xml_EndElement(xp, TRIM(obj%tagname)) 341 END SUBROUTINE qes_write_output 342 343 SUBROUTINE qes_write_timing(xp, obj) 344 !----------------------------------------------------------------- 345 IMPLICIT NONE 346 TYPE (xmlf_t),INTENT(INOUT) :: xp 347 TYPE(timing_type),INTENT(IN) :: obj 348 ! 349 INTEGER :: i 350 ! 351 IF ( .NOT. obj%lwrite ) RETURN 352 ! 353 CALL xml_NewElement(xp, TRIM(obj%tagname)) 354 CALL qes_write_clock (xp, obj%total) 355 IF (obj%partial_ispresent) THEN 356 DO i = 1, obj%ndim_partial 357 CALL qes_write_clock(xp, obj%partial(i) ) 358 END DO 359 END IF 360 CALL xml_EndElement(xp, TRIM(obj%tagname)) 361 END SUBROUTINE qes_write_timing 362 363 SUBROUTINE qes_write_clock(xp, obj) 364 !----------------------------------------------------------------- 365 IMPLICIT NONE 366 TYPE (xmlf_t),INTENT(INOUT) :: xp 367 TYPE(clock_type),INTENT(IN) :: obj 368 ! 369 INTEGER :: i 370 ! 371 IF ( .NOT. obj%lwrite ) RETURN 372 ! 373 CALL xml_NewElement(xp, TRIM(obj%tagname)) 374 CALL xml_addAttribute(xp, 'label', TRIM(obj%label) ) 375 IF (obj%calls_ispresent) CALL xml_addAttribute(xp, 'calls', obj%calls ) 376 CALL xml_NewElement(xp, 'cpu') 377 CALL xml_addCharacters(xp, obj%cpu, fmt='s16') 378 CALL xml_EndElement(xp, 'cpu') 379 CALL xml_NewElement(xp, 'wall') 380 CALL xml_addCharacters(xp, obj%wall, fmt='s16') 381 CALL xml_EndElement(xp, 'wall') 382 CALL xml_EndElement(xp, TRIM(obj%tagname)) 383 END SUBROUTINE qes_write_clock 384 385 SUBROUTINE qes_write_control_variables(xp, obj) 386 !----------------------------------------------------------------- 387 IMPLICIT NONE 388 TYPE (xmlf_t),INTENT(INOUT) :: xp 389 TYPE(control_variables_type),INTENT(IN) :: obj 390 ! 391 INTEGER :: i 392 ! 393 IF ( .NOT. obj%lwrite ) RETURN 394 ! 395 CALL xml_NewElement(xp, TRIM(obj%tagname)) 396 CALL xml_NewElement(xp, 'title') 397 CALL xml_addCharacters(xp, TRIM(obj%title)) 398 CALL xml_EndElement(xp, 'title') 399 CALL xml_NewElement(xp, 'calculation') 400 CALL xml_addCharacters(xp, TRIM(obj%calculation)) 401 CALL xml_EndElement(xp, 'calculation') 402 CALL xml_NewElement(xp, 'restart_mode') 403 CALL xml_addCharacters(xp, TRIM(obj%restart_mode)) 404 CALL xml_EndElement(xp, 'restart_mode') 405 CALL xml_NewElement(xp, 'prefix') 406 CALL xml_addCharacters(xp, TRIM(obj%prefix)) 407 CALL xml_EndElement(xp, 'prefix') 408 CALL xml_NewElement(xp, 'pseudo_dir') 409 CALL xml_addCharacters(xp, TRIM(obj%pseudo_dir)) 410 CALL xml_EndElement(xp, 'pseudo_dir') 411 CALL xml_NewElement(xp, 'outdir') 412 CALL xml_addCharacters(xp, TRIM(obj%outdir)) 413 CALL xml_EndElement(xp, 'outdir') 414 CALL xml_NewElement(xp, 'stress') 415 CALL xml_addCharacters(xp, obj%stress) 416 CALL xml_EndElement(xp, 'stress') 417 CALL xml_NewElement(xp, 'forces') 418 CALL xml_addCharacters(xp, obj%forces) 419 CALL xml_EndElement(xp, 'forces') 420 CALL xml_NewElement(xp, 'wf_collect') 421 CALL xml_addCharacters(xp, obj%wf_collect) 422 CALL xml_EndElement(xp, 'wf_collect') 423 CALL xml_NewElement(xp, 'disk_io') 424 CALL xml_addCharacters(xp, TRIM(obj%disk_io)) 425 CALL xml_EndElement(xp, 'disk_io') 426 CALL xml_NewElement(xp, 'max_seconds') 427 CALL xml_addCharacters(xp, obj%max_seconds) 428 CALL xml_EndElement(xp, 'max_seconds') 429 IF (obj%nstep_ispresent) THEN 430 CALL xml_NewElement(xp, "nstep") 431 CALL xml_addCharacters(xp, obj%nstep) 432 CALL xml_EndElement(xp, "nstep") 433 END IF 434 CALL xml_NewElement(xp, 'etot_conv_thr') 435 CALL xml_addCharacters(xp, obj%etot_conv_thr, fmt='s16') 436 CALL xml_EndElement(xp, 'etot_conv_thr') 437 CALL xml_NewElement(xp, 'forc_conv_thr') 438 CALL xml_addCharacters(xp, obj%forc_conv_thr, fmt='s16') 439 CALL xml_EndElement(xp, 'forc_conv_thr') 440 CALL xml_NewElement(xp, 'press_conv_thr') 441 CALL xml_addCharacters(xp, obj%press_conv_thr, fmt='s16') 442 CALL xml_EndElement(xp, 'press_conv_thr') 443 CALL xml_NewElement(xp, 'verbosity') 444 CALL xml_addCharacters(xp, TRIM(obj%verbosity)) 445 CALL xml_EndElement(xp, 'verbosity') 446 CALL xml_NewElement(xp, 'print_every') 447 CALL xml_addCharacters(xp, obj%print_every) 448 CALL xml_EndElement(xp, 'print_every') 449 CALL xml_EndElement(xp, TRIM(obj%tagname)) 450 END SUBROUTINE qes_write_control_variables 451 452 SUBROUTINE qes_write_xml_format(xp, obj) 453 !----------------------------------------------------------------- 454 IMPLICIT NONE 455 TYPE (xmlf_t),INTENT(INOUT) :: xp 456 TYPE(xml_format_type),INTENT(IN) :: obj 457 ! 458 INTEGER :: i 459 ! 460 IF ( .NOT. obj%lwrite ) RETURN 461 ! 462 CALL xml_NewElement(xp, TRIM(obj%tagname)) 463 CALL xml_addAttribute(xp, 'NAME', TRIM(obj%NAME) ) 464 CALL xml_addAttribute(xp, 'VERSION', TRIM(obj%VERSION) ) 465 CALL xml_AddCharacters(xp, TRIM(obj%xml_format)) 466 CALL xml_EndElement(xp, TRIM(obj%tagname)) 467 END SUBROUTINE qes_write_xml_format 468 469 SUBROUTINE qes_write_creator(xp, obj) 470 !----------------------------------------------------------------- 471 IMPLICIT NONE 472 TYPE (xmlf_t),INTENT(INOUT) :: xp 473 TYPE(creator_type),INTENT(IN) :: obj 474 ! 475 INTEGER :: i 476 ! 477 IF ( .NOT. obj%lwrite ) RETURN 478 ! 479 CALL xml_NewElement(xp, TRIM(obj%tagname)) 480 CALL xml_addAttribute(xp, 'NAME', TRIM(obj%NAME) ) 481 CALL xml_addAttribute(xp, 'VERSION', TRIM(obj%VERSION) ) 482 CALL xml_AddCharacters(xp, TRIM(obj%creator)) 483 CALL xml_EndElement(xp, TRIM(obj%tagname)) 484 END SUBROUTINE qes_write_creator 485 486 SUBROUTINE qes_write_created(xp, obj) 487 !----------------------------------------------------------------- 488 IMPLICIT NONE 489 TYPE (xmlf_t),INTENT(INOUT) :: xp 490 TYPE(created_type),INTENT(IN) :: obj 491 ! 492 INTEGER :: i 493 ! 494 IF ( .NOT. obj%lwrite ) RETURN 495 ! 496 CALL xml_NewElement(xp, TRIM(obj%tagname)) 497 CALL xml_addAttribute(xp, 'DATE', TRIM(obj%DATE) ) 498 CALL xml_addAttribute(xp, 'TIME', TRIM(obj%TIME) ) 499 CALL xml_AddCharacters(xp, TRIM(obj%created)) 500 CALL xml_EndElement(xp, TRIM(obj%tagname)) 501 END SUBROUTINE qes_write_created 502 503 SUBROUTINE qes_write_atomic_species(xp, obj) 504 !----------------------------------------------------------------- 505 IMPLICIT NONE 506 TYPE (xmlf_t),INTENT(INOUT) :: xp 507 TYPE(atomic_species_type),INTENT(IN) :: obj 508 ! 509 INTEGER :: i 510 ! 511 IF ( .NOT. obj%lwrite ) RETURN 512 ! 513 CALL xml_NewElement(xp, TRIM(obj%tagname)) 514 CALL xml_addAttribute(xp, 'ntyp', obj%ntyp ) 515 IF (obj%pseudo_dir_ispresent) CALL xml_addAttribute(xp, 'pseudo_dir', TRIM(obj%pseudo_dir) ) 516 DO i = 1, obj%ndim_species 517 CALL qes_write_species(xp, obj%species(i) ) 518 END DO 519 CALL xml_EndElement(xp, TRIM(obj%tagname)) 520 END SUBROUTINE qes_write_atomic_species 521 522 SUBROUTINE qes_write_species(xp, obj) 523 !----------------------------------------------------------------- 524 IMPLICIT NONE 525 TYPE (xmlf_t),INTENT(INOUT) :: xp 526 TYPE(species_type),INTENT(IN) :: obj 527 ! 528 INTEGER :: i 529 ! 530 IF ( .NOT. obj%lwrite ) RETURN 531 ! 532 CALL xml_NewElement(xp, TRIM(obj%tagname)) 533 CALL xml_addAttribute(xp, 'name', TRIM(obj%name) ) 534 IF (obj%mass_ispresent) THEN 535 CALL xml_NewElement(xp, "mass") 536 CALL xml_addCharacters(xp, obj%mass, fmt='s16') 537 CALL xml_EndElement(xp, "mass") 538 END IF 539 CALL xml_NewElement(xp, 'pseudo_file') 540 CALL xml_addCharacters(xp, TRIM(obj%pseudo_file)) 541 CALL xml_EndElement(xp, 'pseudo_file') 542 IF (obj%starting_magnetization_ispresent) THEN 543 CALL xml_NewElement(xp, "starting_magnetization") 544 CALL xml_addCharacters(xp, obj%starting_magnetization, fmt='s16') 545 CALL xml_EndElement(xp, "starting_magnetization") 546 END IF 547 IF (obj%spin_teta_ispresent) THEN 548 CALL xml_NewElement(xp, "spin_teta") 549 CALL xml_addCharacters(xp, obj%spin_teta, fmt='s16') 550 CALL xml_EndElement(xp, "spin_teta") 551 END IF 552 IF (obj%spin_phi_ispresent) THEN 553 CALL xml_NewElement(xp, "spin_phi") 554 CALL xml_addCharacters(xp, obj%spin_phi, fmt='s16') 555 CALL xml_EndElement(xp, "spin_phi") 556 END IF 557 CALL xml_EndElement(xp, TRIM(obj%tagname)) 558 END SUBROUTINE qes_write_species 559 560 SUBROUTINE qes_write_atomic_structure(xp, obj) 561 !----------------------------------------------------------------- 562 IMPLICIT NONE 563 TYPE (xmlf_t),INTENT(INOUT) :: xp 564 TYPE(atomic_structure_type),INTENT(IN) :: obj 565 ! 566 INTEGER :: i 567 ! 568 IF ( .NOT. obj%lwrite ) RETURN 569 ! 570 CALL xml_NewElement(xp, TRIM(obj%tagname)) 571 CALL xml_addAttribute(xp, 'nat', obj%nat ) 572 IF (obj%alat_ispresent) CALL xml_addAttribute(xp, 'alat', obj%alat ) 573 IF (obj%bravais_index_ispresent) CALL xml_addAttribute(xp, 'bravais_index', obj%bravais_index ) 574 IF (obj%alternative_axes_ispresent) CALL xml_addAttribute(xp, 'alternative_axes', TRIM(obj%alternative_axes) ) 575 IF (obj%atomic_positions_ispresent) THEN 576 CALL qes_write_atomic_positions (xp, obj%atomic_positions) 577 END IF 578 IF (obj%wyckoff_positions_ispresent) THEN 579 CALL qes_write_wyckoff_positions (xp, obj%wyckoff_positions) 580 END IF 581 IF (obj%crystal_positions_ispresent) THEN 582 CALL qes_write_atomic_positions (xp, obj%crystal_positions) 583 END IF 584 CALL qes_write_cell (xp, obj%cell) 585 CALL xml_EndElement(xp, TRIM(obj%tagname)) 586 END SUBROUTINE qes_write_atomic_structure 587 588 SUBROUTINE qes_write_atomic_positions(xp, obj) 589 !----------------------------------------------------------------- 590 IMPLICIT NONE 591 TYPE (xmlf_t),INTENT(INOUT) :: xp 592 TYPE(atomic_positions_type),INTENT(IN) :: obj 593 ! 594 INTEGER :: i 595 ! 596 IF ( .NOT. obj%lwrite ) RETURN 597 ! 598 CALL xml_NewElement(xp, TRIM(obj%tagname)) 599 DO i = 1, obj%ndim_atom 600 CALL qes_write_atom(xp, obj%atom(i) ) 601 END DO 602 CALL xml_EndElement(xp, TRIM(obj%tagname)) 603 END SUBROUTINE qes_write_atomic_positions 604 605 SUBROUTINE qes_write_atom(xp, obj) 606 !----------------------------------------------------------------- 607 IMPLICIT NONE 608 TYPE (xmlf_t),INTENT(INOUT) :: xp 609 TYPE(atom_type),INTENT(IN) :: obj 610 ! 611 INTEGER :: i 612 ! 613 IF ( .NOT. obj%lwrite ) RETURN 614 ! 615 CALL xml_NewElement(xp, TRIM(obj%tagname)) 616 CALL xml_addAttribute(xp, 'name', TRIM(obj%name) ) 617 IF (obj%position_ispresent) CALL xml_addAttribute(xp, 'position', TRIM(obj%position) ) 618 IF (obj%index_ispresent) CALL xml_addAttribute(xp, 'index', obj%index ) 619 CALL xml_AddCharacters(xp, obj%atom, fmt='s16') 620 CALL xml_EndElement(xp, TRIM(obj%tagname)) 621 END SUBROUTINE qes_write_atom 622 623 SUBROUTINE qes_write_wyckoff_positions(xp, obj) 624 !----------------------------------------------------------------- 625 IMPLICIT NONE 626 TYPE (xmlf_t),INTENT(INOUT) :: xp 627 TYPE(wyckoff_positions_type),INTENT(IN) :: obj 628 ! 629 INTEGER :: i 630 ! 631 IF ( .NOT. obj%lwrite ) RETURN 632 ! 633 CALL xml_NewElement(xp, TRIM(obj%tagname)) 634 CALL xml_addAttribute(xp, 'space_group', obj%space_group ) 635 IF (obj%more_options_ispresent) CALL xml_addAttribute(xp, 'more_options', TRIM(obj%more_options) ) 636 DO i = 1, obj%ndim_atom 637 CALL qes_write_atom(xp, obj%atom(i) ) 638 END DO 639 CALL xml_EndElement(xp, TRIM(obj%tagname)) 640 END SUBROUTINE qes_write_wyckoff_positions 641 642 SUBROUTINE qes_write_cell(xp, obj) 643 !----------------------------------------------------------------- 644 IMPLICIT NONE 645 TYPE (xmlf_t),INTENT(INOUT) :: xp 646 TYPE(cell_type),INTENT(IN) :: obj 647 ! 648 INTEGER :: i 649 ! 650 IF ( .NOT. obj%lwrite ) RETURN 651 ! 652 CALL xml_NewElement(xp, TRIM(obj%tagname)) 653 CALL xml_NewElement(xp, 'a1') 654 CALL xml_addCharacters(xp, obj%a1, fmt='s16') 655 CALL xml_EndElement(xp, 'a1') 656 CALL xml_NewElement(xp, 'a2') 657 CALL xml_addCharacters(xp, obj%a2, fmt='s16') 658 CALL xml_EndElement(xp, 'a2') 659 CALL xml_NewElement(xp, 'a3') 660 CALL xml_addCharacters(xp, obj%a3, fmt='s16') 661 CALL xml_EndElement(xp, 'a3') 662 CALL xml_EndElement(xp, TRIM(obj%tagname)) 663 END SUBROUTINE qes_write_cell 664 665 SUBROUTINE qes_write_dft(xp, obj) 666 !----------------------------------------------------------------- 667 IMPLICIT NONE 668 TYPE (xmlf_t),INTENT(INOUT) :: xp 669 TYPE(dft_type),INTENT(IN) :: obj 670 ! 671 INTEGER :: i 672 ! 673 IF ( .NOT. obj%lwrite ) RETURN 674 ! 675 CALL xml_NewElement(xp, TRIM(obj%tagname)) 676 CALL xml_NewElement(xp, 'functional') 677 CALL xml_addCharacters(xp, TRIM(obj%functional)) 678 CALL xml_EndElement(xp, 'functional') 679 IF (obj%hybrid_ispresent) THEN 680 CALL qes_write_hybrid (xp, obj%hybrid) 681 END IF 682 IF (obj%dftU_ispresent) THEN 683 CALL qes_write_dftU (xp, obj%dftU) 684 END IF 685 IF (obj%vdW_ispresent) THEN 686 CALL qes_write_vdW (xp, obj%vdW) 687 END IF 688 CALL xml_EndElement(xp, TRIM(obj%tagname)) 689 END SUBROUTINE qes_write_dft 690 691 SUBROUTINE qes_write_hybrid(xp, obj) 692 !----------------------------------------------------------------- 693 IMPLICIT NONE 694 TYPE (xmlf_t),INTENT(INOUT) :: xp 695 TYPE(hybrid_type),INTENT(IN) :: obj 696 ! 697 INTEGER :: i 698 ! 699 IF ( .NOT. obj%lwrite ) RETURN 700 ! 701 CALL xml_NewElement(xp, TRIM(obj%tagname)) 702 IF (obj%qpoint_grid_ispresent) THEN 703 CALL qes_write_qpoint_grid (xp, obj%qpoint_grid) 704 END IF 705 IF (obj%ecutfock_ispresent) THEN 706 CALL xml_NewElement(xp, "ecutfock") 707 CALL xml_addCharacters(xp, obj%ecutfock, fmt='s16') 708 CALL xml_EndElement(xp, "ecutfock") 709 END IF 710 IF (obj%exx_fraction_ispresent) THEN 711 CALL xml_NewElement(xp, "exx_fraction") 712 CALL xml_addCharacters(xp, obj%exx_fraction, fmt='s16') 713 CALL xml_EndElement(xp, "exx_fraction") 714 END IF 715 IF (obj%screening_parameter_ispresent) THEN 716 CALL xml_NewElement(xp, "screening_parameter") 717 CALL xml_addCharacters(xp, obj%screening_parameter, fmt='s16') 718 CALL xml_EndElement(xp, "screening_parameter") 719 END IF 720 IF (obj%exxdiv_treatment_ispresent) THEN 721 CALL xml_NewElement(xp, "exxdiv_treatment") 722 CALL xml_addCharacters(xp, TRIM(obj%exxdiv_treatment)) 723 CALL xml_EndElement(xp, "exxdiv_treatment") 724 END IF 725 IF (obj%x_gamma_extrapolation_ispresent) THEN 726 CALL xml_NewElement(xp, "x_gamma_extrapolation") 727 CALL xml_addCharacters(xp, obj%x_gamma_extrapolation) 728 CALL xml_EndElement(xp, "x_gamma_extrapolation") 729 END IF 730 IF (obj%ecutvcut_ispresent) THEN 731 CALL xml_NewElement(xp, "ecutvcut") 732 CALL xml_addCharacters(xp, obj%ecutvcut, fmt='s16') 733 CALL xml_EndElement(xp, "ecutvcut") 734 END IF 735 IF (obj%localization_threshold_ispresent) THEN 736 CALL xml_NewElement(xp, "localization_threshold") 737 CALL xml_addCharacters(xp, obj%localization_threshold, fmt='s16') 738 CALL xml_EndElement(xp, "localization_threshold") 739 END IF 740 CALL xml_EndElement(xp, TRIM(obj%tagname)) 741 END SUBROUTINE qes_write_hybrid 742 743 SUBROUTINE qes_write_qpoint_grid(xp, obj) 744 !----------------------------------------------------------------- 745 IMPLICIT NONE 746 TYPE (xmlf_t),INTENT(INOUT) :: xp 747 TYPE(qpoint_grid_type),INTENT(IN) :: obj 748 ! 749 INTEGER :: i 750 ! 751 IF ( .NOT. obj%lwrite ) RETURN 752 ! 753 CALL xml_NewElement(xp, TRIM(obj%tagname)) 754 CALL xml_addAttribute(xp, 'nqx1', obj%nqx1 ) 755 CALL xml_addAttribute(xp, 'nqx2', obj%nqx2 ) 756 CALL xml_addAttribute(xp, 'nqx3', obj%nqx3 ) 757 CALL xml_AddCharacters(xp, TRIM(obj%qpoint_grid)) 758 CALL xml_EndElement(xp, TRIM(obj%tagname)) 759 END SUBROUTINE qes_write_qpoint_grid 760 761 SUBROUTINE qes_write_dftU(xp, obj) 762 !----------------------------------------------------------------- 763 IMPLICIT NONE 764 TYPE (xmlf_t),INTENT(INOUT) :: xp 765 TYPE(dftU_type),INTENT(IN) :: obj 766 ! 767 INTEGER :: i 768 ! 769 IF ( .NOT. obj%lwrite ) RETURN 770 ! 771 CALL xml_NewElement(xp, TRIM(obj%tagname)) 772 IF (obj%lda_plus_u_kind_ispresent) THEN 773 CALL xml_NewElement(xp, "lda_plus_u_kind") 774 CALL xml_addCharacters(xp, obj%lda_plus_u_kind) 775 CALL xml_EndElement(xp, "lda_plus_u_kind") 776 END IF 777 IF (obj%Hubbard_U_ispresent) THEN 778 DO i = 1, obj%ndim_Hubbard_U 779 CALL qes_write_HubbardCommon(xp, obj%Hubbard_U(i) ) 780 END DO 781 END IF 782 IF (obj%Hubbard_J0_ispresent) THEN 783 DO i = 1, obj%ndim_Hubbard_J0 784 CALL qes_write_HubbardCommon(xp, obj%Hubbard_J0(i) ) 785 END DO 786 END IF 787 IF (obj%Hubbard_alpha_ispresent) THEN 788 DO i = 1, obj%ndim_Hubbard_alpha 789 CALL qes_write_HubbardCommon(xp, obj%Hubbard_alpha(i) ) 790 END DO 791 END IF 792 IF (obj%Hubbard_beta_ispresent) THEN 793 DO i = 1, obj%ndim_Hubbard_beta 794 CALL qes_write_HubbardCommon(xp, obj%Hubbard_beta(i) ) 795 END DO 796 END IF 797 IF (obj%Hubbard_J_ispresent) THEN 798 DO i = 1, obj%ndim_Hubbard_J 799 CALL qes_write_HubbardJ(xp, obj%Hubbard_J(i) ) 800 END DO 801 END IF 802 IF (obj%starting_ns_ispresent) THEN 803 DO i = 1, obj%ndim_starting_ns 804 CALL qes_write_starting_ns(xp, obj%starting_ns(i) ) 805 END DO 806 END IF 807 IF (obj%Hubbard_ns_ispresent) THEN 808 DO i = 1, obj%ndim_Hubbard_ns 809 CALL qes_write_Hubbard_ns(xp, obj%Hubbard_ns(i) ) 810 END DO 811 END IF 812 IF (obj%U_projection_type_ispresent) THEN 813 CALL xml_NewElement(xp, "U_projection_type") 814 CALL xml_addCharacters(xp, TRIM(obj%U_projection_type)) 815 CALL xml_EndElement(xp, "U_projection_type") 816 END IF 817 IF (obj%Hubbard_back_ispresent) THEN 818 DO i = 1, obj%ndim_Hubbard_back 819 CALL qes_write_HubbardBack(xp, obj%Hubbard_back(i) ) 820 END DO 821 END IF 822 IF (obj%Hubbard_U_back_ispresent) THEN 823 DO i = 1, obj%ndim_Hubbard_U_back 824 CALL qes_write_HubbardCommon(xp, obj%Hubbard_U_back(i) ) 825 END DO 826 END IF 827 IF (obj%Hubbard_alpha_back_ispresent) THEN 828 DO i = 1, obj%ndim_Hubbard_alpha_back 829 CALL qes_write_HubbardCommon(xp, obj%Hubbard_alpha_back(i) ) 830 END DO 831 END IF 832 IF (obj%Hubbard_ns_nc_ispresent) THEN 833 DO i = 1, obj%ndim_Hubbard_ns_nc 834 CALL qes_write_Hubbard_ns(xp, obj%Hubbard_ns_nc(i) ) 835 END DO 836 END IF 837 CALL xml_EndElement(xp, TRIM(obj%tagname)) 838 END SUBROUTINE qes_write_dftU 839 840 SUBROUTINE qes_write_HubbardCommon(xp, obj) 841 !----------------------------------------------------------------- 842 IMPLICIT NONE 843 TYPE (xmlf_t),INTENT(INOUT) :: xp 844 TYPE(HubbardCommon_type),INTENT(IN) :: obj 845 ! 846 INTEGER :: i 847 ! 848 IF ( .NOT. obj%lwrite ) RETURN 849 ! 850 CALL xml_NewElement(xp, TRIM(obj%tagname)) 851 CALL xml_addAttribute(xp, 'specie', TRIM(obj%specie) ) 852 IF (obj%label_ispresent) CALL xml_addAttribute(xp, 'label', TRIM(obj%label) ) 853 CALL xml_AddCharacters(xp, obj%HubbardCommon, fmt='s16') 854 CALL xml_EndElement(xp, TRIM(obj%tagname)) 855 END SUBROUTINE qes_write_HubbardCommon 856 857 SUBROUTINE qes_write_HubbardJ(xp, obj) 858 !----------------------------------------------------------------- 859 IMPLICIT NONE 860 TYPE (xmlf_t),INTENT(INOUT) :: xp 861 TYPE(HubbardJ_type),INTENT(IN) :: obj 862 ! 863 INTEGER :: i 864 ! 865 IF ( .NOT. obj%lwrite ) RETURN 866 ! 867 CALL xml_NewElement(xp, TRIM(obj%tagname)) 868 CALL xml_addAttribute(xp, 'specie', TRIM(obj%specie) ) 869 CALL xml_addAttribute(xp, 'label', TRIM(obj%label) ) 870 CALL xml_AddCharacters(xp, obj%HubbardJ, fmt='s16') 871 CALL xml_EndElement(xp, TRIM(obj%tagname)) 872 END SUBROUTINE qes_write_HubbardJ 873 874 SUBROUTINE qes_write_starting_ns(xp, obj) 875 !----------------------------------------------------------------- 876 IMPLICIT NONE 877 TYPE (xmlf_t),INTENT(INOUT) :: xp 878 TYPE(starting_ns_type),INTENT(IN) :: obj 879 ! 880 INTEGER :: i 881 ! 882 IF ( .NOT. obj%lwrite ) RETURN 883 ! 884 CALL xml_NewElement(xp, TRIM(obj%tagname)) 885 CALL xml_addAttribute(xp, 'specie', TRIM(obj%specie) ) 886 CALL xml_addAttribute(xp, 'label', TRIM(obj%label) ) 887 CALL xml_addAttribute(xp, 'spin', obj%spin ) 888 CALL xml_addAttribute(xp, 'size', obj%size ) 889 CALL xml_addNewLine(xp) 890 DO i = 1, obj%size, 5 891 CALL xml_AddCharacters(xp, obj%starting_ns(i:MIN(i+5-1,obj%size)), fmt='s16') 892 CALL xml_AddNewLine(xp) 893 END DO 894 CALL xml_EndElement(xp, TRIM(obj%tagname)) 895 END SUBROUTINE qes_write_starting_ns 896 897 SUBROUTINE qes_write_Hubbard_ns(xp, obj) 898 !----------------------------------------------------------------- 899 IMPLICIT NONE 900 TYPE (xmlf_t),INTENT(INOUT) :: xp 901 TYPE(Hubbard_ns_type),INTENT(IN) :: obj 902 ! 903 INTEGER :: i 904 ! 905 IF ( .NOT. obj%lwrite ) RETURN 906 ! 907 CALL xml_NewElement(xp, TRIM(obj%tagname)) 908 CALL xml_addAttribute(xp, 'specie', TRIM(obj%specie) ) 909 CALL xml_addAttribute(xp, 'label', TRIM(obj%label) ) 910 CALL xml_addAttribute(xp, 'spin', obj%spin ) 911 CALL xml_addAttribute(xp, 'index', obj%index ) 912 CALL xml_addAttribute(xp, 'rank', obj%rank ) 913 CALL xml_addAttribute(xp, 'dims', obj%dims ) 914 CALL xml_addAttribute(xp, 'order', TRIM(obj%order) ) 915 CALL xml_addNewLine(xp) 916 DO i = 1, obj%dims(2) 917 CALL xml_AddCharacters(xp, obj%Hubbard_ns((i-1)*obj%dims(1)+1: i*obj%dims(1)), fmt ='s16') 918 CALL xml_addNewLine(xp) 919 END DO 920 CALL xml_EndElement(xp, TRIM(obj%tagname)) 921 END SUBROUTINE qes_write_Hubbard_ns 922 923 SUBROUTINE qes_write_HubbardBack(xp, obj) 924 !----------------------------------------------------------------- 925 IMPLICIT NONE 926 TYPE (xmlf_t),INTENT(INOUT) :: xp 927 TYPE(HubbardBack_type),INTENT(IN) :: obj 928 ! 929 INTEGER :: i 930 ! 931 IF ( .NOT. obj%lwrite ) RETURN 932 ! 933 CALL xml_NewElement(xp, TRIM(obj%tagname)) 934 CALL xml_addAttribute(xp, 'species', TRIM(obj%species) ) 935 CALL xml_NewElement(xp, 'background') 936 CALL xml_addCharacters(xp, TRIM(obj%background)) 937 CALL xml_EndElement(xp, 'background') 938 DO i = 1, obj%ndim_l_number 939 CALL qes_write_backL(xp, obj%l_number(i) ) 940 END DO 941 CALL xml_EndElement(xp, TRIM(obj%tagname)) 942 END SUBROUTINE qes_write_HubbardBack 943 944 SUBROUTINE qes_write_backL(xp, obj) 945 !----------------------------------------------------------------- 946 IMPLICIT NONE 947 TYPE (xmlf_t),INTENT(INOUT) :: xp 948 TYPE(backL_type),INTENT(IN) :: obj 949 ! 950 INTEGER :: i 951 ! 952 IF ( .NOT. obj%lwrite ) RETURN 953 ! 954 CALL xml_NewElement(xp, TRIM(obj%tagname)) 955 CALL xml_addAttribute(xp, 'l_index', obj%l_index ) 956 CALL xml_AddCharacters(xp, obj%backL) 957 CALL xml_EndElement(xp, TRIM(obj%tagname)) 958 END SUBROUTINE qes_write_backL 959 960 SUBROUTINE qes_write_vdW(xp, obj) 961 !----------------------------------------------------------------- 962 IMPLICIT NONE 963 TYPE (xmlf_t),INTENT(INOUT) :: xp 964 TYPE(vdW_type),INTENT(IN) :: obj 965 ! 966 INTEGER :: i 967 ! 968 IF ( .NOT. obj%lwrite ) RETURN 969 ! 970 CALL xml_NewElement(xp, TRIM(obj%tagname)) 971 IF (obj%vdw_corr_ispresent) THEN 972 CALL xml_NewElement(xp, "vdw_corr") 973 CALL xml_addCharacters(xp, TRIM(obj%vdw_corr)) 974 CALL xml_EndElement(xp, "vdw_corr") 975 END IF 976 IF (obj%dftd3_version_ispresent) THEN 977 CALL xml_NewElement(xp, "dftd3_version") 978 CALL xml_addCharacters(xp, obj%dftd3_version) 979 CALL xml_EndElement(xp, "dftd3_version") 980 END IF 981 IF (obj%dftd3_threebody_ispresent) THEN 982 CALL xml_NewElement(xp, "dftd3_threebody") 983 CALL xml_addCharacters(xp, obj%dftd3_threebody) 984 CALL xml_EndElement(xp, "dftd3_threebody") 985 END IF 986 IF (obj%non_local_term_ispresent) THEN 987 CALL xml_NewElement(xp, "non_local_term") 988 CALL xml_addCharacters(xp, TRIM(obj%non_local_term)) 989 CALL xml_EndElement(xp, "non_local_term") 990 END IF 991 IF (obj%functional_ispresent) THEN 992 CALL xml_NewElement(xp, "functional") 993 CALL xml_addCharacters(xp, TRIM(obj%functional)) 994 CALL xml_EndElement(xp, "functional") 995 END IF 996 IF (obj%total_energy_term_ispresent) THEN 997 CALL xml_NewElement(xp, "total_energy_term") 998 CALL xml_addCharacters(xp, obj%total_energy_term, fmt='s16') 999 CALL xml_EndElement(xp, "total_energy_term") 1000 END IF 1001 IF (obj%london_s6_ispresent) THEN 1002 CALL xml_NewElement(xp, "london_s6") 1003 CALL xml_addCharacters(xp, obj%london_s6, fmt='s16') 1004 CALL xml_EndElement(xp, "london_s6") 1005 END IF 1006 IF (obj%ts_vdw_econv_thr_ispresent) THEN 1007 CALL xml_NewElement(xp, "ts_vdw_econv_thr") 1008 CALL xml_addCharacters(xp, obj%ts_vdw_econv_thr, fmt='s16') 1009 CALL xml_EndElement(xp, "ts_vdw_econv_thr") 1010 END IF 1011 IF (obj%ts_vdw_isolated_ispresent) THEN 1012 CALL xml_NewElement(xp, "ts_vdw_isolated") 1013 CALL xml_addCharacters(xp, obj%ts_vdw_isolated) 1014 CALL xml_EndElement(xp, "ts_vdw_isolated") 1015 END IF 1016 IF (obj%london_rcut_ispresent) THEN 1017 CALL xml_NewElement(xp, "london_rcut") 1018 CALL xml_addCharacters(xp, obj%london_rcut, fmt='s16') 1019 CALL xml_EndElement(xp, "london_rcut") 1020 END IF 1021 IF (obj%xdm_a1_ispresent) THEN 1022 CALL xml_NewElement(xp, "xdm_a1") 1023 CALL xml_addCharacters(xp, obj%xdm_a1, fmt='s16') 1024 CALL xml_EndElement(xp, "xdm_a1") 1025 END IF 1026 IF (obj%xdm_a2_ispresent) THEN 1027 CALL xml_NewElement(xp, "xdm_a2") 1028 CALL xml_addCharacters(xp, obj%xdm_a2, fmt='s16') 1029 CALL xml_EndElement(xp, "xdm_a2") 1030 END IF 1031 IF (obj%london_c6_ispresent) THEN 1032 DO i = 1, obj%ndim_london_c6 1033 CALL qes_write_HubbardCommon(xp, obj%london_c6(i) ) 1034 END DO 1035 END IF 1036 CALL xml_EndElement(xp, TRIM(obj%tagname)) 1037 END SUBROUTINE qes_write_vdW 1038 1039 SUBROUTINE qes_write_spin(xp, obj) 1040 !----------------------------------------------------------------- 1041 IMPLICIT NONE 1042 TYPE (xmlf_t),INTENT(INOUT) :: xp 1043 TYPE(spin_type),INTENT(IN) :: obj 1044 ! 1045 INTEGER :: i 1046 ! 1047 IF ( .NOT. obj%lwrite ) RETURN 1048 ! 1049 CALL xml_NewElement(xp, TRIM(obj%tagname)) 1050 CALL xml_NewElement(xp, 'lsda') 1051 CALL xml_addCharacters(xp, obj%lsda) 1052 CALL xml_EndElement(xp, 'lsda') 1053 CALL xml_NewElement(xp, 'noncolin') 1054 CALL xml_addCharacters(xp, obj%noncolin) 1055 CALL xml_EndElement(xp, 'noncolin') 1056 CALL xml_NewElement(xp, 'spinorbit') 1057 CALL xml_addCharacters(xp, obj%spinorbit) 1058 CALL xml_EndElement(xp, 'spinorbit') 1059 CALL xml_EndElement(xp, TRIM(obj%tagname)) 1060 END SUBROUTINE qes_write_spin 1061 1062 SUBROUTINE qes_write_bands(xp, obj) 1063 !----------------------------------------------------------------- 1064 IMPLICIT NONE 1065 TYPE (xmlf_t),INTENT(INOUT) :: xp 1066 TYPE(bands_type),INTENT(IN) :: obj 1067 ! 1068 INTEGER :: i 1069 ! 1070 IF ( .NOT. obj%lwrite ) RETURN 1071 ! 1072 CALL xml_NewElement(xp, TRIM(obj%tagname)) 1073 IF (obj%nbnd_ispresent) THEN 1074 CALL xml_NewElement(xp, "nbnd") 1075 CALL xml_addCharacters(xp, obj%nbnd) 1076 CALL xml_EndElement(xp, "nbnd") 1077 END IF 1078 IF (obj%smearing_ispresent) THEN 1079 CALL qes_write_smearing (xp, obj%smearing) 1080 END IF 1081 IF (obj%tot_charge_ispresent) THEN 1082 CALL xml_NewElement(xp, "tot_charge") 1083 CALL xml_addCharacters(xp, obj%tot_charge, fmt='s16') 1084 CALL xml_EndElement(xp, "tot_charge") 1085 END IF 1086 IF (obj%tot_magnetization_ispresent) THEN 1087 CALL xml_NewElement(xp, "tot_magnetization") 1088 CALL xml_addCharacters(xp, obj%tot_magnetization, fmt='s16') 1089 CALL xml_EndElement(xp, "tot_magnetization") 1090 END IF 1091 CALL qes_write_occupations (xp, obj%occupations) 1092 IF (obj%inputOccupations_ispresent) THEN 1093 DO i = 1, obj%ndim_inputOccupations 1094 CALL qes_write_inputOccupations(xp, obj%inputOccupations(i) ) 1095 END DO 1096 END IF 1097 CALL xml_EndElement(xp, TRIM(obj%tagname)) 1098 END SUBROUTINE qes_write_bands 1099 1100 SUBROUTINE qes_write_smearing(xp, obj) 1101 !----------------------------------------------------------------- 1102 IMPLICIT NONE 1103 TYPE (xmlf_t),INTENT(INOUT) :: xp 1104 TYPE(smearing_type),INTENT(IN) :: obj 1105 ! 1106 INTEGER :: i 1107 ! 1108 IF ( .NOT. obj%lwrite ) RETURN 1109 ! 1110 CALL xml_NewElement(xp, TRIM(obj%tagname)) 1111 CALL xml_addAttribute(xp, 'degauss', obj%degauss ) 1112 CALL xml_AddCharacters(xp, TRIM(obj%smearing)) 1113 CALL xml_EndElement(xp, TRIM(obj%tagname)) 1114 END SUBROUTINE qes_write_smearing 1115 1116 SUBROUTINE qes_write_occupations(xp, obj) 1117 !----------------------------------------------------------------- 1118 IMPLICIT NONE 1119 TYPE (xmlf_t),INTENT(INOUT) :: xp 1120 TYPE(occupations_type),INTENT(IN) :: obj 1121 ! 1122 INTEGER :: i 1123 ! 1124 IF ( .NOT. obj%lwrite ) RETURN 1125 ! 1126 CALL xml_NewElement(xp, TRIM(obj%tagname)) 1127 IF (obj%spin_ispresent) CALL xml_addAttribute(xp, 'spin', obj%spin ) 1128 CALL xml_AddCharacters(xp, TRIM(obj%occupations)) 1129 CALL xml_EndElement(xp, TRIM(obj%tagname)) 1130 END SUBROUTINE qes_write_occupations 1131 1132 SUBROUTINE qes_write_basis(xp, obj) 1133 !----------------------------------------------------------------- 1134 IMPLICIT NONE 1135 TYPE (xmlf_t),INTENT(INOUT) :: xp 1136 TYPE(basis_type),INTENT(IN) :: obj 1137 ! 1138 INTEGER :: i 1139 ! 1140 IF ( .NOT. obj%lwrite ) RETURN 1141 ! 1142 CALL xml_NewElement(xp, TRIM(obj%tagname)) 1143 IF (obj%gamma_only_ispresent) THEN 1144 CALL xml_NewElement(xp, "gamma_only") 1145 CALL xml_addCharacters(xp, obj%gamma_only) 1146 CALL xml_EndElement(xp, "gamma_only") 1147 END IF 1148 CALL xml_NewElement(xp, 'ecutwfc') 1149 CALL xml_addCharacters(xp, obj%ecutwfc, fmt='s16') 1150 CALL xml_EndElement(xp, 'ecutwfc') 1151 IF (obj%ecutrho_ispresent) THEN 1152 CALL xml_NewElement(xp, "ecutrho") 1153 CALL xml_addCharacters(xp, obj%ecutrho, fmt='s16') 1154 CALL xml_EndElement(xp, "ecutrho") 1155 END IF 1156 IF (obj%fft_grid_ispresent) THEN 1157 CALL qes_write_basisSetItem (xp, obj%fft_grid) 1158 END IF 1159 IF (obj%fft_smooth_ispresent) THEN 1160 CALL qes_write_basisSetItem (xp, obj%fft_smooth) 1161 END IF 1162 IF (obj%fft_box_ispresent) THEN 1163 CALL qes_write_basisSetItem (xp, obj%fft_box) 1164 END IF 1165 CALL xml_EndElement(xp, TRIM(obj%tagname)) 1166 END SUBROUTINE qes_write_basis 1167 1168 SUBROUTINE qes_write_basis_set(xp, obj) 1169 !----------------------------------------------------------------- 1170 IMPLICIT NONE 1171 TYPE (xmlf_t),INTENT(INOUT) :: xp 1172 TYPE(basis_set_type),INTENT(IN) :: obj 1173 ! 1174 INTEGER :: i 1175 ! 1176 IF ( .NOT. obj%lwrite ) RETURN 1177 ! 1178 CALL xml_NewElement(xp, TRIM(obj%tagname)) 1179 IF (obj%gamma_only_ispresent) THEN 1180 CALL xml_NewElement(xp, "gamma_only") 1181 CALL xml_addCharacters(xp, obj%gamma_only) 1182 CALL xml_EndElement(xp, "gamma_only") 1183 END IF 1184 CALL xml_NewElement(xp, 'ecutwfc') 1185 CALL xml_addCharacters(xp, obj%ecutwfc, fmt='s16') 1186 CALL xml_EndElement(xp, 'ecutwfc') 1187 IF (obj%ecutrho_ispresent) THEN 1188 CALL xml_NewElement(xp, "ecutrho") 1189 CALL xml_addCharacters(xp, obj%ecutrho, fmt='s16') 1190 CALL xml_EndElement(xp, "ecutrho") 1191 END IF 1192 CALL qes_write_basisSetItem (xp, obj%fft_grid) 1193 IF (obj%fft_smooth_ispresent) THEN 1194 CALL qes_write_basisSetItem (xp, obj%fft_smooth) 1195 END IF 1196 IF (obj%fft_box_ispresent) THEN 1197 CALL qes_write_basisSetItem (xp, obj%fft_box) 1198 END IF 1199 CALL xml_NewElement(xp, 'ngm') 1200 CALL xml_addCharacters(xp, obj%ngm) 1201 CALL xml_EndElement(xp, 'ngm') 1202 IF (obj%ngms_ispresent) THEN 1203 CALL xml_NewElement(xp, "ngms") 1204 CALL xml_addCharacters(xp, obj%ngms) 1205 CALL xml_EndElement(xp, "ngms") 1206 END IF 1207 CALL xml_NewElement(xp, 'npwx') 1208 CALL xml_addCharacters(xp, obj%npwx) 1209 CALL xml_EndElement(xp, 'npwx') 1210 CALL qes_write_reciprocal_lattice (xp, obj%reciprocal_lattice) 1211 CALL xml_EndElement(xp, TRIM(obj%tagname)) 1212 END SUBROUTINE qes_write_basis_set 1213 1214 SUBROUTINE qes_write_basisSetItem(xp, obj) 1215 !----------------------------------------------------------------- 1216 IMPLICIT NONE 1217 TYPE (xmlf_t),INTENT(INOUT) :: xp 1218 TYPE(basisSetItem_type),INTENT(IN) :: obj 1219 ! 1220 INTEGER :: i 1221 ! 1222 IF ( .NOT. obj%lwrite ) RETURN 1223 ! 1224 CALL xml_NewElement(xp, TRIM(obj%tagname)) 1225 CALL xml_addAttribute(xp, 'nr1', obj%nr1 ) 1226 CALL xml_addAttribute(xp, 'nr2', obj%nr2 ) 1227 CALL xml_addAttribute(xp, 'nr3', obj%nr3 ) 1228 CALL xml_AddCharacters(xp, TRIM(obj%basisSetItem)) 1229 CALL xml_EndElement(xp, TRIM(obj%tagname)) 1230 END SUBROUTINE qes_write_basisSetItem 1231 1232 SUBROUTINE qes_write_reciprocal_lattice(xp, obj) 1233 !----------------------------------------------------------------- 1234 IMPLICIT NONE 1235 TYPE (xmlf_t),INTENT(INOUT) :: xp 1236 TYPE(reciprocal_lattice_type),INTENT(IN) :: obj 1237 ! 1238 INTEGER :: i 1239 ! 1240 IF ( .NOT. obj%lwrite ) RETURN 1241 ! 1242 CALL xml_NewElement(xp, TRIM(obj%tagname)) 1243 CALL xml_NewElement(xp, 'b1') 1244 CALL xml_addCharacters(xp, obj%b1, fmt='s16') 1245 CALL xml_EndElement(xp, 'b1') 1246 CALL xml_NewElement(xp, 'b2') 1247 CALL xml_addCharacters(xp, obj%b2, fmt='s16') 1248 CALL xml_EndElement(xp, 'b2') 1249 CALL xml_NewElement(xp, 'b3') 1250 CALL xml_addCharacters(xp, obj%b3, fmt='s16') 1251 CALL xml_EndElement(xp, 'b3') 1252 CALL xml_EndElement(xp, TRIM(obj%tagname)) 1253 END SUBROUTINE qes_write_reciprocal_lattice 1254 1255 SUBROUTINE qes_write_electron_control(xp, obj) 1256 !----------------------------------------------------------------- 1257 IMPLICIT NONE 1258 TYPE (xmlf_t),INTENT(INOUT) :: xp 1259 TYPE(electron_control_type),INTENT(IN) :: obj 1260 ! 1261 INTEGER :: i 1262 ! 1263 IF ( .NOT. obj%lwrite ) RETURN 1264 ! 1265 CALL xml_NewElement(xp, TRIM(obj%tagname)) 1266 CALL xml_NewElement(xp, 'diagonalization') 1267 CALL xml_addCharacters(xp, TRIM(obj%diagonalization)) 1268 CALL xml_EndElement(xp, 'diagonalization') 1269 CALL xml_NewElement(xp, 'mixing_mode') 1270 CALL xml_addCharacters(xp, TRIM(obj%mixing_mode)) 1271 CALL xml_EndElement(xp, 'mixing_mode') 1272 CALL xml_NewElement(xp, 'mixing_beta') 1273 CALL xml_addCharacters(xp, obj%mixing_beta, fmt='s16') 1274 CALL xml_EndElement(xp, 'mixing_beta') 1275 CALL xml_NewElement(xp, 'conv_thr') 1276 CALL xml_addCharacters(xp, obj%conv_thr, fmt='s16') 1277 CALL xml_EndElement(xp, 'conv_thr') 1278 CALL xml_NewElement(xp, 'mixing_ndim') 1279 CALL xml_addCharacters(xp, obj%mixing_ndim) 1280 CALL xml_EndElement(xp, 'mixing_ndim') 1281 CALL xml_NewElement(xp, 'max_nstep') 1282 CALL xml_addCharacters(xp, obj%max_nstep) 1283 CALL xml_EndElement(xp, 'max_nstep') 1284 IF (obj%real_space_q_ispresent) THEN 1285 CALL xml_NewElement(xp, "real_space_q") 1286 CALL xml_addCharacters(xp, obj%real_space_q) 1287 CALL xml_EndElement(xp, "real_space_q") 1288 END IF 1289 IF (obj%real_space_beta_ispresent) THEN 1290 CALL xml_NewElement(xp, "real_space_beta") 1291 CALL xml_addCharacters(xp, obj%real_space_beta) 1292 CALL xml_EndElement(xp, "real_space_beta") 1293 END IF 1294 CALL xml_NewElement(xp, 'tq_smoothing') 1295 CALL xml_addCharacters(xp, obj%tq_smoothing) 1296 CALL xml_EndElement(xp, 'tq_smoothing') 1297 CALL xml_NewElement(xp, 'tbeta_smoothing') 1298 CALL xml_addCharacters(xp, obj%tbeta_smoothing) 1299 CALL xml_EndElement(xp, 'tbeta_smoothing') 1300 CALL xml_NewElement(xp, 'diago_thr_init') 1301 CALL xml_addCharacters(xp, obj%diago_thr_init, fmt='s16') 1302 CALL xml_EndElement(xp, 'diago_thr_init') 1303 CALL xml_NewElement(xp, 'diago_full_acc') 1304 CALL xml_addCharacters(xp, obj%diago_full_acc) 1305 CALL xml_EndElement(xp, 'diago_full_acc') 1306 IF (obj%diago_cg_maxiter_ispresent) THEN 1307 CALL xml_NewElement(xp, "diago_cg_maxiter") 1308 CALL xml_addCharacters(xp, obj%diago_cg_maxiter) 1309 CALL xml_EndElement(xp, "diago_cg_maxiter") 1310 END IF 1311 IF (obj%diago_ppcg_maxiter_ispresent) THEN 1312 CALL xml_NewElement(xp, "diago_ppcg_maxiter") 1313 CALL xml_addCharacters(xp, obj%diago_ppcg_maxiter) 1314 CALL xml_EndElement(xp, "diago_ppcg_maxiter") 1315 END IF 1316 IF (obj%diago_david_ndim_ispresent) THEN 1317 CALL xml_NewElement(xp, "diago_david_ndim") 1318 CALL xml_addCharacters(xp, obj%diago_david_ndim) 1319 CALL xml_EndElement(xp, "diago_david_ndim") 1320 END IF 1321 CALL xml_EndElement(xp, TRIM(obj%tagname)) 1322 END SUBROUTINE qes_write_electron_control 1323 1324 SUBROUTINE qes_write_k_points_IBZ(xp, obj) 1325 !----------------------------------------------------------------- 1326 IMPLICIT NONE 1327 TYPE (xmlf_t),INTENT(INOUT) :: xp 1328 TYPE(k_points_IBZ_type),INTENT(IN) :: obj 1329 ! 1330 INTEGER :: i 1331 ! 1332 IF ( .NOT. obj%lwrite ) RETURN 1333 ! 1334 CALL xml_NewElement(xp, TRIM(obj%tagname)) 1335 IF (obj%monkhorst_pack_ispresent) THEN 1336 CALL qes_write_monkhorst_pack (xp, obj%monkhorst_pack) 1337 END IF 1338 IF (obj%nk_ispresent) THEN 1339 CALL xml_NewElement(xp, "nk") 1340 CALL xml_addCharacters(xp, obj%nk) 1341 CALL xml_EndElement(xp, "nk") 1342 END IF 1343 IF (obj%k_point_ispresent) THEN 1344 DO i = 1, obj%ndim_k_point 1345 CALL qes_write_k_point(xp, obj%k_point(i) ) 1346 END DO 1347 END IF 1348 CALL xml_EndElement(xp, TRIM(obj%tagname)) 1349 END SUBROUTINE qes_write_k_points_IBZ 1350 1351 SUBROUTINE qes_write_monkhorst_pack(xp, obj) 1352 !----------------------------------------------------------------- 1353 IMPLICIT NONE 1354 TYPE (xmlf_t),INTENT(INOUT) :: xp 1355 TYPE(monkhorst_pack_type),INTENT(IN) :: obj 1356 ! 1357 INTEGER :: i 1358 ! 1359 IF ( .NOT. obj%lwrite ) RETURN 1360 ! 1361 CALL xml_NewElement(xp, TRIM(obj%tagname)) 1362 CALL xml_addAttribute(xp, 'nk1', obj%nk1 ) 1363 CALL xml_addAttribute(xp, 'nk2', obj%nk2 ) 1364 CALL xml_addAttribute(xp, 'nk3', obj%nk3 ) 1365 CALL xml_addAttribute(xp, 'k1', obj%k1 ) 1366 CALL xml_addAttribute(xp, 'k2', obj%k2 ) 1367 CALL xml_addAttribute(xp, 'k3', obj%k3 ) 1368 CALL xml_AddCharacters(xp, TRIM(obj%monkhorst_pack)) 1369 CALL xml_EndElement(xp, TRIM(obj%tagname)) 1370 END SUBROUTINE qes_write_monkhorst_pack 1371 1372 SUBROUTINE qes_write_k_point(xp, obj) 1373 !----------------------------------------------------------------- 1374 IMPLICIT NONE 1375 TYPE (xmlf_t),INTENT(INOUT) :: xp 1376 TYPE(k_point_type),INTENT(IN) :: obj 1377 ! 1378 INTEGER :: i 1379 ! 1380 IF ( .NOT. obj%lwrite ) RETURN 1381 ! 1382 CALL xml_NewElement(xp, TRIM(obj%tagname)) 1383 IF (obj%weight_ispresent) CALL xml_addAttribute(xp, 'weight', obj%weight ) 1384 IF (obj%label_ispresent) CALL xml_addAttribute(xp, 'label', TRIM(obj%label) ) 1385 CALL xml_AddCharacters(xp, obj%k_point, fmt='s16') 1386 CALL xml_EndElement(xp, TRIM(obj%tagname)) 1387 END SUBROUTINE qes_write_k_point 1388 1389 SUBROUTINE qes_write_ion_control(xp, obj) 1390 !----------------------------------------------------------------- 1391 IMPLICIT NONE 1392 TYPE (xmlf_t),INTENT(INOUT) :: xp 1393 TYPE(ion_control_type),INTENT(IN) :: obj 1394 ! 1395 INTEGER :: i 1396 ! 1397 IF ( .NOT. obj%lwrite ) RETURN 1398 ! 1399 CALL xml_NewElement(xp, TRIM(obj%tagname)) 1400 CALL xml_NewElement(xp, 'ion_dynamics') 1401 CALL xml_addCharacters(xp, TRIM(obj%ion_dynamics)) 1402 CALL xml_EndElement(xp, 'ion_dynamics') 1403 IF (obj%upscale_ispresent) THEN 1404 CALL xml_NewElement(xp, "upscale") 1405 CALL xml_addCharacters(xp, obj%upscale, fmt='s16') 1406 CALL xml_EndElement(xp, "upscale") 1407 END IF 1408 IF (obj%remove_rigid_rot_ispresent) THEN 1409 CALL xml_NewElement(xp, "remove_rigid_rot") 1410 CALL xml_addCharacters(xp, obj%remove_rigid_rot) 1411 CALL xml_EndElement(xp, "remove_rigid_rot") 1412 END IF 1413 IF (obj%refold_pos_ispresent) THEN 1414 CALL xml_NewElement(xp, "refold_pos") 1415 CALL xml_addCharacters(xp, obj%refold_pos) 1416 CALL xml_EndElement(xp, "refold_pos") 1417 END IF 1418 IF (obj%bfgs_ispresent) THEN 1419 CALL qes_write_bfgs (xp, obj%bfgs) 1420 END IF 1421 IF (obj%md_ispresent) THEN 1422 CALL qes_write_md (xp, obj%md) 1423 END IF 1424 CALL xml_EndElement(xp, TRIM(obj%tagname)) 1425 END SUBROUTINE qes_write_ion_control 1426 1427 SUBROUTINE qes_write_bfgs(xp, obj) 1428 !----------------------------------------------------------------- 1429 IMPLICIT NONE 1430 TYPE (xmlf_t),INTENT(INOUT) :: xp 1431 TYPE(bfgs_type),INTENT(IN) :: obj 1432 ! 1433 INTEGER :: i 1434 ! 1435 IF ( .NOT. obj%lwrite ) RETURN 1436 ! 1437 CALL xml_NewElement(xp, TRIM(obj%tagname)) 1438 CALL xml_NewElement(xp, 'ndim') 1439 CALL xml_addCharacters(xp, obj%ndim) 1440 CALL xml_EndElement(xp, 'ndim') 1441 CALL xml_NewElement(xp, 'trust_radius_min') 1442 CALL xml_addCharacters(xp, obj%trust_radius_min, fmt='s16') 1443 CALL xml_EndElement(xp, 'trust_radius_min') 1444 CALL xml_NewElement(xp, 'trust_radius_max') 1445 CALL xml_addCharacters(xp, obj%trust_radius_max, fmt='s16') 1446 CALL xml_EndElement(xp, 'trust_radius_max') 1447 CALL xml_NewElement(xp, 'trust_radius_init') 1448 CALL xml_addCharacters(xp, obj%trust_radius_init, fmt='s16') 1449 CALL xml_EndElement(xp, 'trust_radius_init') 1450 CALL xml_NewElement(xp, 'w1') 1451 CALL xml_addCharacters(xp, obj%w1, fmt='s16') 1452 CALL xml_EndElement(xp, 'w1') 1453 CALL xml_NewElement(xp, 'w2') 1454 CALL xml_addCharacters(xp, obj%w2, fmt='s16') 1455 CALL xml_EndElement(xp, 'w2') 1456 CALL xml_EndElement(xp, TRIM(obj%tagname)) 1457 END SUBROUTINE qes_write_bfgs 1458 1459 SUBROUTINE qes_write_md(xp, obj) 1460 !----------------------------------------------------------------- 1461 IMPLICIT NONE 1462 TYPE (xmlf_t),INTENT(INOUT) :: xp 1463 TYPE(md_type),INTENT(IN) :: obj 1464 ! 1465 INTEGER :: i 1466 ! 1467 IF ( .NOT. obj%lwrite ) RETURN 1468 ! 1469 CALL xml_NewElement(xp, TRIM(obj%tagname)) 1470 CALL xml_NewElement(xp, 'pot_extrapolation') 1471 CALL xml_addCharacters(xp, TRIM(obj%pot_extrapolation)) 1472 CALL xml_EndElement(xp, 'pot_extrapolation') 1473 CALL xml_NewElement(xp, 'wfc_extrapolation') 1474 CALL xml_addCharacters(xp, TRIM(obj%wfc_extrapolation)) 1475 CALL xml_EndElement(xp, 'wfc_extrapolation') 1476 CALL xml_NewElement(xp, 'ion_temperature') 1477 CALL xml_addCharacters(xp, TRIM(obj%ion_temperature)) 1478 CALL xml_EndElement(xp, 'ion_temperature') 1479 CALL xml_NewElement(xp, 'timestep') 1480 CALL xml_addCharacters(xp, obj%timestep, fmt='s16') 1481 CALL xml_EndElement(xp, 'timestep') 1482 CALL xml_NewElement(xp, 'tempw') 1483 CALL xml_addCharacters(xp, obj%tempw, fmt='s16') 1484 CALL xml_EndElement(xp, 'tempw') 1485 CALL xml_NewElement(xp, 'tolp') 1486 CALL xml_addCharacters(xp, obj%tolp, fmt='s16') 1487 CALL xml_EndElement(xp, 'tolp') 1488 CALL xml_NewElement(xp, 'deltaT') 1489 CALL xml_addCharacters(xp, obj%deltaT, fmt='s16') 1490 CALL xml_EndElement(xp, 'deltaT') 1491 CALL xml_NewElement(xp, 'nraise') 1492 CALL xml_addCharacters(xp, obj%nraise) 1493 CALL xml_EndElement(xp, 'nraise') 1494 CALL xml_EndElement(xp, TRIM(obj%tagname)) 1495 END SUBROUTINE qes_write_md 1496 1497 SUBROUTINE qes_write_cell_control(xp, obj) 1498 !----------------------------------------------------------------- 1499 IMPLICIT NONE 1500 TYPE (xmlf_t),INTENT(INOUT) :: xp 1501 TYPE(cell_control_type),INTENT(IN) :: obj 1502 ! 1503 INTEGER :: i 1504 ! 1505 IF ( .NOT. obj%lwrite ) RETURN 1506 ! 1507 CALL xml_NewElement(xp, TRIM(obj%tagname)) 1508 CALL xml_NewElement(xp, 'cell_dynamics') 1509 CALL xml_addCharacters(xp, TRIM(obj%cell_dynamics)) 1510 CALL xml_EndElement(xp, 'cell_dynamics') 1511 CALL xml_NewElement(xp, 'pressure') 1512 CALL xml_addCharacters(xp, obj%pressure, fmt='s16') 1513 CALL xml_EndElement(xp, 'pressure') 1514 IF (obj%wmass_ispresent) THEN 1515 CALL xml_NewElement(xp, "wmass") 1516 CALL xml_addCharacters(xp, obj%wmass, fmt='s16') 1517 CALL xml_EndElement(xp, "wmass") 1518 END IF 1519 IF (obj%cell_factor_ispresent) THEN 1520 CALL xml_NewElement(xp, "cell_factor") 1521 CALL xml_addCharacters(xp, obj%cell_factor, fmt='s16') 1522 CALL xml_EndElement(xp, "cell_factor") 1523 END IF 1524 IF (obj%fix_volume_ispresent) THEN 1525 CALL xml_NewElement(xp, "fix_volume") 1526 CALL xml_addCharacters(xp, obj%fix_volume) 1527 CALL xml_EndElement(xp, "fix_volume") 1528 END IF 1529 IF (obj%fix_area_ispresent) THEN 1530 CALL xml_NewElement(xp, "fix_area") 1531 CALL xml_addCharacters(xp, obj%fix_area) 1532 CALL xml_EndElement(xp, "fix_area") 1533 END IF 1534 IF (obj%isotropic_ispresent) THEN 1535 CALL xml_NewElement(xp, "isotropic") 1536 CALL xml_addCharacters(xp, obj%isotropic) 1537 CALL xml_EndElement(xp, "isotropic") 1538 END IF 1539 IF (obj%free_cell_ispresent) THEN 1540 CALL qes_write_integerMatrix (xp, obj%free_cell) 1541 END IF 1542 CALL xml_EndElement(xp, TRIM(obj%tagname)) 1543 END SUBROUTINE qes_write_cell_control 1544 1545 SUBROUTINE qes_write_symmetry_flags(xp, obj) 1546 !----------------------------------------------------------------- 1547 IMPLICIT NONE 1548 TYPE (xmlf_t),INTENT(INOUT) :: xp 1549 TYPE(symmetry_flags_type),INTENT(IN) :: obj 1550 ! 1551 INTEGER :: i 1552 ! 1553 IF ( .NOT. obj%lwrite ) RETURN 1554 ! 1555 CALL xml_NewElement(xp, TRIM(obj%tagname)) 1556 CALL xml_NewElement(xp, 'nosym') 1557 CALL xml_addCharacters(xp, obj%nosym) 1558 CALL xml_EndElement(xp, 'nosym') 1559 CALL xml_NewElement(xp, 'nosym_evc') 1560 CALL xml_addCharacters(xp, obj%nosym_evc) 1561 CALL xml_EndElement(xp, 'nosym_evc') 1562 CALL xml_NewElement(xp, 'noinv') 1563 CALL xml_addCharacters(xp, obj%noinv) 1564 CALL xml_EndElement(xp, 'noinv') 1565 CALL xml_NewElement(xp, 'no_t_rev') 1566 CALL xml_addCharacters(xp, obj%no_t_rev) 1567 CALL xml_EndElement(xp, 'no_t_rev') 1568 CALL xml_NewElement(xp, 'force_symmorphic') 1569 CALL xml_addCharacters(xp, obj%force_symmorphic) 1570 CALL xml_EndElement(xp, 'force_symmorphic') 1571 CALL xml_NewElement(xp, 'use_all_frac') 1572 CALL xml_addCharacters(xp, obj%use_all_frac) 1573 CALL xml_EndElement(xp, 'use_all_frac') 1574 CALL xml_EndElement(xp, TRIM(obj%tagname)) 1575 END SUBROUTINE qes_write_symmetry_flags 1576 1577 SUBROUTINE qes_write_boundary_conditions(xp, obj) 1578 !----------------------------------------------------------------- 1579 IMPLICIT NONE 1580 TYPE (xmlf_t),INTENT(INOUT) :: xp 1581 TYPE(boundary_conditions_type),INTENT(IN) :: obj 1582 ! 1583 INTEGER :: i 1584 ! 1585 IF ( .NOT. obj%lwrite ) RETURN 1586 ! 1587 CALL xml_NewElement(xp, TRIM(obj%tagname)) 1588 CALL xml_NewElement(xp, 'assume_isolated') 1589 CALL xml_addCharacters(xp, TRIM(obj%assume_isolated)) 1590 CALL xml_EndElement(xp, 'assume_isolated') 1591 IF (obj%esm_ispresent) THEN 1592 CALL qes_write_esm (xp, obj%esm) 1593 END IF 1594 IF (obj%fcp_opt_ispresent) THEN 1595 CALL xml_NewElement(xp, "fcp_opt") 1596 CALL xml_addCharacters(xp, obj%fcp_opt) 1597 CALL xml_EndElement(xp, "fcp_opt") 1598 END IF 1599 IF (obj%fcp_mu_ispresent) THEN 1600 CALL xml_NewElement(xp, "fcp_mu") 1601 CALL xml_addCharacters(xp, obj%fcp_mu, fmt='s16') 1602 CALL xml_EndElement(xp, "fcp_mu") 1603 END IF 1604 CALL xml_EndElement(xp, TRIM(obj%tagname)) 1605 END SUBROUTINE qes_write_boundary_conditions 1606 1607 SUBROUTINE qes_write_esm(xp, obj) 1608 !----------------------------------------------------------------- 1609 IMPLICIT NONE 1610 TYPE (xmlf_t),INTENT(INOUT) :: xp 1611 TYPE(esm_type),INTENT(IN) :: obj 1612 ! 1613 INTEGER :: i 1614 ! 1615 IF ( .NOT. obj%lwrite ) RETURN 1616 ! 1617 CALL xml_NewElement(xp, TRIM(obj%tagname)) 1618 CALL xml_NewElement(xp, 'bc') 1619 CALL xml_addCharacters(xp, TRIM(obj%bc)) 1620 CALL xml_EndElement(xp, 'bc') 1621 CALL xml_NewElement(xp, 'nfit') 1622 CALL xml_addCharacters(xp, obj%nfit) 1623 CALL xml_EndElement(xp, 'nfit') 1624 CALL xml_NewElement(xp, 'w') 1625 CALL xml_addCharacters(xp, obj%w, fmt='s16') 1626 CALL xml_EndElement(xp, 'w') 1627 CALL xml_NewElement(xp, 'efield') 1628 CALL xml_addCharacters(xp, obj%efield, fmt='s16') 1629 CALL xml_EndElement(xp, 'efield') 1630 CALL xml_EndElement(xp, TRIM(obj%tagname)) 1631 END SUBROUTINE qes_write_esm 1632 1633 SUBROUTINE qes_write_ekin_functional(xp, obj) 1634 !----------------------------------------------------------------- 1635 IMPLICIT NONE 1636 TYPE (xmlf_t),INTENT(INOUT) :: xp 1637 TYPE(ekin_functional_type),INTENT(IN) :: obj 1638 ! 1639 INTEGER :: i 1640 ! 1641 IF ( .NOT. obj%lwrite ) RETURN 1642 ! 1643 CALL xml_NewElement(xp, TRIM(obj%tagname)) 1644 CALL xml_NewElement(xp, 'ecfixed') 1645 CALL xml_addCharacters(xp, obj%ecfixed, fmt='s16') 1646 CALL xml_EndElement(xp, 'ecfixed') 1647 CALL xml_NewElement(xp, 'qcutz') 1648 CALL xml_addCharacters(xp, obj%qcutz, fmt='s16') 1649 CALL xml_EndElement(xp, 'qcutz') 1650 CALL xml_NewElement(xp, 'q2sigma') 1651 CALL xml_addCharacters(xp, obj%q2sigma, fmt='s16') 1652 CALL xml_EndElement(xp, 'q2sigma') 1653 CALL xml_EndElement(xp, TRIM(obj%tagname)) 1654 END SUBROUTINE qes_write_ekin_functional 1655 1656 SUBROUTINE qes_write_spin_constraints(xp, obj) 1657 !----------------------------------------------------------------- 1658 IMPLICIT NONE 1659 TYPE (xmlf_t),INTENT(INOUT) :: xp 1660 TYPE(spin_constraints_type),INTENT(IN) :: obj 1661 ! 1662 INTEGER :: i 1663 ! 1664 IF ( .NOT. obj%lwrite ) RETURN 1665 ! 1666 CALL xml_NewElement(xp, TRIM(obj%tagname)) 1667 CALL xml_NewElement(xp, 'spin_constraints') 1668 CALL xml_addCharacters(xp, TRIM(obj%spin_constraints)) 1669 CALL xml_EndElement(xp, 'spin_constraints') 1670 CALL xml_NewElement(xp, 'lagrange_multiplier') 1671 CALL xml_addCharacters(xp, obj%lagrange_multiplier, fmt='s16') 1672 CALL xml_EndElement(xp, 'lagrange_multiplier') 1673 IF (obj%target_magnetization_ispresent) THEN 1674 CALL xml_NewElement(xp, "target_magnetization") 1675 CALL xml_addCharacters(xp, obj%target_magnetization, fmt='s16') 1676 CALL xml_EndElement(xp, "target_magnetization") 1677 END IF 1678 CALL xml_EndElement(xp, TRIM(obj%tagname)) 1679 END SUBROUTINE qes_write_spin_constraints 1680 1681 SUBROUTINE qes_write_electric_field(xp, obj) 1682 !----------------------------------------------------------------- 1683 IMPLICIT NONE 1684 TYPE (xmlf_t),INTENT(INOUT) :: xp 1685 TYPE(electric_field_type),INTENT(IN) :: obj 1686 ! 1687 INTEGER :: i 1688 ! 1689 IF ( .NOT. obj%lwrite ) RETURN 1690 ! 1691 CALL xml_NewElement(xp, TRIM(obj%tagname)) 1692 CALL xml_NewElement(xp, 'electric_potential') 1693 CALL xml_addCharacters(xp, TRIM(obj%electric_potential)) 1694 CALL xml_EndElement(xp, 'electric_potential') 1695 IF (obj%dipole_correction_ispresent) THEN 1696 CALL xml_NewElement(xp, "dipole_correction") 1697 CALL xml_addCharacters(xp, obj%dipole_correction) 1698 CALL xml_EndElement(xp, "dipole_correction") 1699 END IF 1700 IF (obj%gate_settings_ispresent) THEN 1701 CALL qes_write_gate_settings (xp, obj%gate_settings) 1702 END IF 1703 IF (obj%electric_field_direction_ispresent) THEN 1704 CALL xml_NewElement(xp, "electric_field_direction") 1705 CALL xml_addCharacters(xp, obj%electric_field_direction) 1706 CALL xml_EndElement(xp, "electric_field_direction") 1707 END IF 1708 IF (obj%potential_max_position_ispresent) THEN 1709 CALL xml_NewElement(xp, "potential_max_position") 1710 CALL xml_addCharacters(xp, obj%potential_max_position, fmt='s16') 1711 CALL xml_EndElement(xp, "potential_max_position") 1712 END IF 1713 IF (obj%potential_decrease_width_ispresent) THEN 1714 CALL xml_NewElement(xp, "potential_decrease_width") 1715 CALL xml_addCharacters(xp, obj%potential_decrease_width, fmt='s16') 1716 CALL xml_EndElement(xp, "potential_decrease_width") 1717 END IF 1718 IF (obj%electric_field_amplitude_ispresent) THEN 1719 CALL xml_NewElement(xp, "electric_field_amplitude") 1720 CALL xml_addCharacters(xp, obj%electric_field_amplitude, fmt='s16') 1721 CALL xml_EndElement(xp, "electric_field_amplitude") 1722 END IF 1723 IF (obj%electric_field_vector_ispresent) THEN 1724 CALL xml_NewElement(xp, "electric_field_vector") 1725 CALL xml_addCharacters(xp, obj%electric_field_vector, fmt='s16') 1726 CALL xml_EndElement(xp, "electric_field_vector") 1727 END IF 1728 IF (obj%nk_per_string_ispresent) THEN 1729 CALL xml_NewElement(xp, "nk_per_string") 1730 CALL xml_addCharacters(xp, obj%nk_per_string) 1731 CALL xml_EndElement(xp, "nk_per_string") 1732 END IF 1733 IF (obj%n_berry_cycles_ispresent) THEN 1734 CALL xml_NewElement(xp, "n_berry_cycles") 1735 CALL xml_addCharacters(xp, obj%n_berry_cycles) 1736 CALL xml_EndElement(xp, "n_berry_cycles") 1737 END IF 1738 CALL xml_EndElement(xp, TRIM(obj%tagname)) 1739 END SUBROUTINE qes_write_electric_field 1740 1741 SUBROUTINE qes_write_gate_settings(xp, obj) 1742 !----------------------------------------------------------------- 1743 IMPLICIT NONE 1744 TYPE (xmlf_t),INTENT(INOUT) :: xp 1745 TYPE(gate_settings_type),INTENT(IN) :: obj 1746 ! 1747 INTEGER :: i 1748 ! 1749 IF ( .NOT. obj%lwrite ) RETURN 1750 ! 1751 CALL xml_NewElement(xp, TRIM(obj%tagname)) 1752 CALL xml_NewElement(xp, 'use_gate') 1753 CALL xml_addCharacters(xp, obj%use_gate) 1754 CALL xml_EndElement(xp, 'use_gate') 1755 IF (obj%zgate_ispresent) THEN 1756 CALL xml_NewElement(xp, "zgate") 1757 CALL xml_addCharacters(xp, obj%zgate, fmt='s16') 1758 CALL xml_EndElement(xp, "zgate") 1759 END IF 1760 IF (obj%relaxz_ispresent) THEN 1761 CALL xml_NewElement(xp, "relaxz") 1762 CALL xml_addCharacters(xp, obj%relaxz) 1763 CALL xml_EndElement(xp, "relaxz") 1764 END IF 1765 IF (obj%block_ispresent) THEN 1766 CALL xml_NewElement(xp, "block") 1767 CALL xml_addCharacters(xp, obj%block) 1768 CALL xml_EndElement(xp, "block") 1769 END IF 1770 IF (obj%block_1_ispresent) THEN 1771 CALL xml_NewElement(xp, "block_1") 1772 CALL xml_addCharacters(xp, obj%block_1, fmt='s16') 1773 CALL xml_EndElement(xp, "block_1") 1774 END IF 1775 IF (obj%block_2_ispresent) THEN 1776 CALL xml_NewElement(xp, "block_2") 1777 CALL xml_addCharacters(xp, obj%block_2, fmt='s16') 1778 CALL xml_EndElement(xp, "block_2") 1779 END IF 1780 IF (obj%block_height_ispresent) THEN 1781 CALL xml_NewElement(xp, "block_height") 1782 CALL xml_addCharacters(xp, obj%block_height, fmt='s16') 1783 CALL xml_EndElement(xp, "block_height") 1784 END IF 1785 CALL xml_EndElement(xp, TRIM(obj%tagname)) 1786 END SUBROUTINE qes_write_gate_settings 1787 1788 SUBROUTINE qes_write_atomic_constraints(xp, obj) 1789 !----------------------------------------------------------------- 1790 IMPLICIT NONE 1791 TYPE (xmlf_t),INTENT(INOUT) :: xp 1792 TYPE(atomic_constraints_type),INTENT(IN) :: obj 1793 ! 1794 INTEGER :: i 1795 ! 1796 IF ( .NOT. obj%lwrite ) RETURN 1797 ! 1798 CALL xml_NewElement(xp, TRIM(obj%tagname)) 1799 CALL xml_NewElement(xp, 'num_of_constraints') 1800 CALL xml_addCharacters(xp, obj%num_of_constraints) 1801 CALL xml_EndElement(xp, 'num_of_constraints') 1802 CALL xml_NewElement(xp, 'tolerance') 1803 CALL xml_addCharacters(xp, obj%tolerance, fmt='s16') 1804 CALL xml_EndElement(xp, 'tolerance') 1805 DO i = 1, obj%ndim_atomic_constraint 1806 CALL qes_write_atomic_constraint(xp, obj%atomic_constraint(i) ) 1807 END DO 1808 CALL xml_EndElement(xp, TRIM(obj%tagname)) 1809 END SUBROUTINE qes_write_atomic_constraints 1810 1811 SUBROUTINE qes_write_atomic_constraint(xp, obj) 1812 !----------------------------------------------------------------- 1813 IMPLICIT NONE 1814 TYPE (xmlf_t),INTENT(INOUT) :: xp 1815 TYPE(atomic_constraint_type),INTENT(IN) :: obj 1816 ! 1817 INTEGER :: i 1818 ! 1819 IF ( .NOT. obj%lwrite ) RETURN 1820 ! 1821 CALL xml_NewElement(xp, TRIM(obj%tagname)) 1822 CALL xml_NewElement(xp, 'constr_parms') 1823 CALL xml_addCharacters(xp, obj%constr_parms, fmt='s16') 1824 CALL xml_EndElement(xp, 'constr_parms') 1825 CALL xml_NewElement(xp, 'constr_type') 1826 CALL xml_addCharacters(xp, TRIM(obj%constr_type)) 1827 CALL xml_EndElement(xp, 'constr_type') 1828 CALL xml_NewElement(xp, 'constr_target') 1829 CALL xml_addCharacters(xp, obj%constr_target, fmt='s16') 1830 CALL xml_EndElement(xp, 'constr_target') 1831 CALL xml_EndElement(xp, TRIM(obj%tagname)) 1832 END SUBROUTINE qes_write_atomic_constraint 1833 1834 SUBROUTINE qes_write_inputOccupations(xp, obj) 1835 !----------------------------------------------------------------- 1836 IMPLICIT NONE 1837 TYPE (xmlf_t),INTENT(INOUT) :: xp 1838 TYPE(inputOccupations_type),INTENT(IN) :: obj 1839 ! 1840 INTEGER :: i 1841 ! 1842 IF ( .NOT. obj%lwrite ) RETURN 1843 ! 1844 CALL xml_NewElement(xp, TRIM(obj%tagname)) 1845 CALL xml_addAttribute(xp, 'ispin', obj%ispin ) 1846 CALL xml_addAttribute(xp, 'spin_factor', obj%spin_factor ) 1847 CALL xml_addAttribute(xp, 'size', obj%size ) 1848 CALL xml_addNewLine(xp) 1849 DO i = 1, obj%size, 5 1850 CALL xml_AddCharacters(xp, obj%inputOccupations(i:MIN(i+5-1,obj%size)), fmt='s16') 1851 CALL xml_AddNewLine(xp) 1852 END DO 1853 CALL xml_EndElement(xp, TRIM(obj%tagname)) 1854 END SUBROUTINE qes_write_inputOccupations 1855 1856 SUBROUTINE qes_write_outputElectricField(xp, obj) 1857 !----------------------------------------------------------------- 1858 IMPLICIT NONE 1859 TYPE (xmlf_t),INTENT(INOUT) :: xp 1860 TYPE(outputElectricField_type),INTENT(IN) :: obj 1861 ! 1862 INTEGER :: i 1863 ! 1864 IF ( .NOT. obj%lwrite ) RETURN 1865 ! 1866 CALL xml_NewElement(xp, TRIM(obj%tagname)) 1867 IF (obj%BerryPhase_ispresent) THEN 1868 CALL qes_write_BerryPhaseOutput (xp, obj%BerryPhase) 1869 END IF 1870 IF (obj%finiteElectricFieldInfo_ispresent) THEN 1871 CALL qes_write_finiteFieldOut (xp, obj%finiteElectricFieldInfo) 1872 END IF 1873 IF (obj%dipoleInfo_ispresent) THEN 1874 CALL qes_write_dipoleOutput (xp, obj%dipoleInfo) 1875 END IF 1876 IF (obj%gateInfo_ispresent) THEN 1877 CALL qes_write_gateInfo (xp, obj%gateInfo) 1878 END IF 1879 CALL xml_EndElement(xp, TRIM(obj%tagname)) 1880 END SUBROUTINE qes_write_outputElectricField 1881 1882 SUBROUTINE qes_write_BerryPhaseOutput(xp, obj) 1883 !----------------------------------------------------------------- 1884 IMPLICIT NONE 1885 TYPE (xmlf_t),INTENT(INOUT) :: xp 1886 TYPE(BerryPhaseOutput_type),INTENT(IN) :: obj 1887 ! 1888 INTEGER :: i 1889 ! 1890 IF ( .NOT. obj%lwrite ) RETURN 1891 ! 1892 CALL xml_NewElement(xp, TRIM(obj%tagname)) 1893 CALL qes_write_polarization (xp, obj%totalPolarization) 1894 CALL qes_write_phase (xp, obj%totalPhase) 1895 DO i = 1, obj%ndim_ionicPolarization 1896 CALL qes_write_ionicPolarization(xp, obj%ionicPolarization(i) ) 1897 END DO 1898 DO i = 1, obj%ndim_electronicPolarization 1899 CALL qes_write_electronicPolarization(xp, obj%electronicPolarization(i) ) 1900 END DO 1901 CALL xml_EndElement(xp, TRIM(obj%tagname)) 1902 END SUBROUTINE qes_write_BerryPhaseOutput 1903 1904 SUBROUTINE qes_write_dipoleOutput(xp, obj) 1905 !----------------------------------------------------------------- 1906 IMPLICIT NONE 1907 TYPE (xmlf_t),INTENT(INOUT) :: xp 1908 TYPE(dipoleOutput_type),INTENT(IN) :: obj 1909 ! 1910 INTEGER :: i 1911 ! 1912 IF ( .NOT. obj%lwrite ) RETURN 1913 ! 1914 CALL xml_NewElement(xp, TRIM(obj%tagname)) 1915 CALL xml_NewElement(xp, 'idir') 1916 CALL xml_addCharacters(xp, obj%idir) 1917 CALL xml_EndElement(xp, 'idir') 1918 CALL qes_write_scalarQuantity (xp, obj%dipole) 1919 CALL qes_write_scalarQuantity (xp, obj%ion_dipole) 1920 CALL qes_write_scalarQuantity (xp, obj%elec_dipole) 1921 CALL qes_write_scalarQuantity (xp, obj%dipoleField) 1922 CALL qes_write_scalarQuantity (xp, obj%potentialAmp) 1923 CALL qes_write_scalarQuantity (xp, obj%totalLength) 1924 CALL xml_EndElement(xp, TRIM(obj%tagname)) 1925 END SUBROUTINE qes_write_dipoleOutput 1926 1927 SUBROUTINE qes_write_finiteFieldOut(xp, obj) 1928 !----------------------------------------------------------------- 1929 IMPLICIT NONE 1930 TYPE (xmlf_t),INTENT(INOUT) :: xp 1931 TYPE(finiteFieldOut_type),INTENT(IN) :: obj 1932 ! 1933 INTEGER :: i 1934 ! 1935 IF ( .NOT. obj%lwrite ) RETURN 1936 ! 1937 CALL xml_NewElement(xp, TRIM(obj%tagname)) 1938 CALL xml_NewElement(xp, 'electronicDipole') 1939 CALL xml_addCharacters(xp, obj%electronicDipole, fmt='s16') 1940 CALL xml_EndElement(xp, 'electronicDipole') 1941 CALL xml_NewElement(xp, 'ionicDipole') 1942 CALL xml_addCharacters(xp, obj%ionicDipole, fmt='s16') 1943 CALL xml_EndElement(xp, 'ionicDipole') 1944 CALL xml_EndElement(xp, TRIM(obj%tagname)) 1945 END SUBROUTINE qes_write_finiteFieldOut 1946 1947 SUBROUTINE qes_write_polarization(xp, obj) 1948 !----------------------------------------------------------------- 1949 IMPLICIT NONE 1950 TYPE (xmlf_t),INTENT(INOUT) :: xp 1951 TYPE(polarization_type),INTENT(IN) :: obj 1952 ! 1953 INTEGER :: i 1954 ! 1955 IF ( .NOT. obj%lwrite ) RETURN 1956 ! 1957 CALL xml_NewElement(xp, TRIM(obj%tagname)) 1958 CALL qes_write_scalarQuantity (xp, obj%polarization) 1959 CALL xml_NewElement(xp, 'modulus') 1960 CALL xml_addCharacters(xp, obj%modulus, fmt='s16') 1961 CALL xml_EndElement(xp, 'modulus') 1962 CALL xml_NewElement(xp, 'direction') 1963 CALL xml_addCharacters(xp, obj%direction, fmt='s16') 1964 CALL xml_EndElement(xp, 'direction') 1965 CALL xml_EndElement(xp, TRIM(obj%tagname)) 1966 END SUBROUTINE qes_write_polarization 1967 1968 SUBROUTINE qes_write_ionicPolarization(xp, obj) 1969 !----------------------------------------------------------------- 1970 IMPLICIT NONE 1971 TYPE (xmlf_t),INTENT(INOUT) :: xp 1972 TYPE(ionicPolarization_type),INTENT(IN) :: obj 1973 ! 1974 INTEGER :: i 1975 ! 1976 IF ( .NOT. obj%lwrite ) RETURN 1977 ! 1978 CALL xml_NewElement(xp, TRIM(obj%tagname)) 1979 CALL qes_write_atom (xp, obj%ion) 1980 CALL xml_NewElement(xp, 'charge') 1981 CALL xml_addCharacters(xp, obj%charge, fmt='s16') 1982 CALL xml_EndElement(xp, 'charge') 1983 CALL qes_write_phase (xp, obj%phase) 1984 CALL xml_EndElement(xp, TRIM(obj%tagname)) 1985 END SUBROUTINE qes_write_ionicPolarization 1986 1987 SUBROUTINE qes_write_electronicPolarization(xp, obj) 1988 !----------------------------------------------------------------- 1989 IMPLICIT NONE 1990 TYPE (xmlf_t),INTENT(INOUT) :: xp 1991 TYPE(electronicPolarization_type),INTENT(IN) :: obj 1992 ! 1993 INTEGER :: i 1994 ! 1995 IF ( .NOT. obj%lwrite ) RETURN 1996 ! 1997 CALL xml_NewElement(xp, TRIM(obj%tagname)) 1998 CALL qes_write_k_point (xp, obj%firstKeyPoint) 1999 IF (obj%spin_ispresent) THEN 2000 CALL xml_NewElement(xp, "spin") 2001 CALL xml_addCharacters(xp, obj%spin) 2002 CALL xml_EndElement(xp, "spin") 2003 END IF 2004 CALL qes_write_phase (xp, obj%phase) 2005 CALL xml_EndElement(xp, TRIM(obj%tagname)) 2006 END SUBROUTINE qes_write_electronicPolarization 2007 2008 SUBROUTINE qes_write_phase(xp, obj) 2009 !----------------------------------------------------------------- 2010 IMPLICIT NONE 2011 TYPE (xmlf_t),INTENT(INOUT) :: xp 2012 TYPE(phase_type),INTENT(IN) :: obj 2013 ! 2014 INTEGER :: i 2015 ! 2016 IF ( .NOT. obj%lwrite ) RETURN 2017 ! 2018 CALL xml_NewElement(xp, TRIM(obj%tagname)) 2019 IF (obj%ionic_ispresent) CALL xml_addAttribute(xp, 'ionic', obj%ionic ) 2020 IF (obj%electronic_ispresent) CALL xml_addAttribute(xp, 'electronic', obj%electronic ) 2021 IF (obj%modulus_ispresent) CALL xml_addAttribute(xp, 'modulus', TRIM(obj%modulus) ) 2022 CALL xml_AddCharacters(xp, obj%phase, fmt='s16') 2023 CALL xml_EndElement(xp, TRIM(obj%tagname)) 2024 END SUBROUTINE qes_write_phase 2025 2026 SUBROUTINE qes_write_gateInfo(xp, obj) 2027 !----------------------------------------------------------------- 2028 IMPLICIT NONE 2029 TYPE (xmlf_t),INTENT(INOUT) :: xp 2030 TYPE(gateInfo_type),INTENT(IN) :: obj 2031 ! 2032 INTEGER :: i 2033 ! 2034 IF ( .NOT. obj%lwrite ) RETURN 2035 ! 2036 CALL xml_NewElement(xp, TRIM(obj%tagname)) 2037 CALL xml_NewElement(xp, 'pot_prefactor') 2038 CALL xml_addCharacters(xp, obj%pot_prefactor, fmt='s16') 2039 CALL xml_EndElement(xp, 'pot_prefactor') 2040 CALL xml_NewElement(xp, 'gate_zpos') 2041 CALL xml_addCharacters(xp, obj%gate_zpos, fmt='s16') 2042 CALL xml_EndElement(xp, 'gate_zpos') 2043 CALL xml_NewElement(xp, 'gate_gate_term') 2044 CALL xml_addCharacters(xp, obj%gate_gate_term, fmt='s16') 2045 CALL xml_EndElement(xp, 'gate_gate_term') 2046 CALL xml_NewElement(xp, 'gatefieldEnergy') 2047 CALL xml_addCharacters(xp, obj%gatefieldEnergy, fmt='s16') 2048 CALL xml_EndElement(xp, 'gatefieldEnergy') 2049 CALL xml_EndElement(xp, TRIM(obj%tagname)) 2050 END SUBROUTINE qes_write_gateInfo 2051 2052 SUBROUTINE qes_write_convergence_info(xp, obj) 2053 !----------------------------------------------------------------- 2054 IMPLICIT NONE 2055 TYPE (xmlf_t),INTENT(INOUT) :: xp 2056 TYPE(convergence_info_type),INTENT(IN) :: obj 2057 ! 2058 INTEGER :: i 2059 ! 2060 IF ( .NOT. obj%lwrite ) RETURN 2061 ! 2062 CALL xml_NewElement(xp, TRIM(obj%tagname)) 2063 CALL qes_write_scf_conv (xp, obj%scf_conv) 2064 IF (obj%opt_conv_ispresent) THEN 2065 CALL qes_write_opt_conv (xp, obj%opt_conv) 2066 END IF 2067 CALL xml_EndElement(xp, TRIM(obj%tagname)) 2068 END SUBROUTINE qes_write_convergence_info 2069 2070 SUBROUTINE qes_write_scf_conv(xp, obj) 2071 !----------------------------------------------------------------- 2072 IMPLICIT NONE 2073 TYPE (xmlf_t),INTENT(INOUT) :: xp 2074 TYPE(scf_conv_type),INTENT(IN) :: obj 2075 ! 2076 INTEGER :: i 2077 ! 2078 IF ( .NOT. obj%lwrite ) RETURN 2079 ! 2080 CALL xml_NewElement(xp, TRIM(obj%tagname)) 2081 CALL xml_NewElement(xp, 'convergence_achieved') 2082 CALL xml_addCharacters(xp, obj%convergence_achieved) 2083 CALL xml_EndElement(xp, 'convergence_achieved') 2084 CALL xml_NewElement(xp, 'n_scf_steps') 2085 CALL xml_addCharacters(xp, obj%n_scf_steps) 2086 CALL xml_EndElement(xp, 'n_scf_steps') 2087 CALL xml_NewElement(xp, 'scf_error') 2088 CALL xml_addCharacters(xp, obj%scf_error, fmt='s16') 2089 CALL xml_EndElement(xp, 'scf_error') 2090 CALL xml_EndElement(xp, TRIM(obj%tagname)) 2091 END SUBROUTINE qes_write_scf_conv 2092 2093 SUBROUTINE qes_write_opt_conv(xp, obj) 2094 !----------------------------------------------------------------- 2095 IMPLICIT NONE 2096 TYPE (xmlf_t),INTENT(INOUT) :: xp 2097 TYPE(opt_conv_type),INTENT(IN) :: obj 2098 ! 2099 INTEGER :: i 2100 ! 2101 IF ( .NOT. obj%lwrite ) RETURN 2102 ! 2103 CALL xml_NewElement(xp, TRIM(obj%tagname)) 2104 CALL xml_NewElement(xp, 'convergence_achieved') 2105 CALL xml_addCharacters(xp, obj%convergence_achieved) 2106 CALL xml_EndElement(xp, 'convergence_achieved') 2107 CALL xml_NewElement(xp, 'n_opt_steps') 2108 CALL xml_addCharacters(xp, obj%n_opt_steps) 2109 CALL xml_EndElement(xp, 'n_opt_steps') 2110 CALL xml_NewElement(xp, 'grad_norm') 2111 CALL xml_addCharacters(xp, obj%grad_norm, fmt='s16') 2112 CALL xml_EndElement(xp, 'grad_norm') 2113 CALL xml_EndElement(xp, TRIM(obj%tagname)) 2114 END SUBROUTINE qes_write_opt_conv 2115 2116 SUBROUTINE qes_write_algorithmic_info(xp, obj) 2117 !----------------------------------------------------------------- 2118 IMPLICIT NONE 2119 TYPE (xmlf_t),INTENT(INOUT) :: xp 2120 TYPE(algorithmic_info_type),INTENT(IN) :: obj 2121 ! 2122 INTEGER :: i 2123 ! 2124 IF ( .NOT. obj%lwrite ) RETURN 2125 ! 2126 CALL xml_NewElement(xp, TRIM(obj%tagname)) 2127 CALL xml_NewElement(xp, 'real_space_q') 2128 CALL xml_addCharacters(xp, obj%real_space_q) 2129 CALL xml_EndElement(xp, 'real_space_q') 2130 IF (obj%real_space_beta_ispresent) THEN 2131 CALL xml_NewElement(xp, "real_space_beta") 2132 CALL xml_addCharacters(xp, obj%real_space_beta) 2133 CALL xml_EndElement(xp, "real_space_beta") 2134 END IF 2135 CALL xml_NewElement(xp, 'uspp') 2136 CALL xml_addCharacters(xp, obj%uspp) 2137 CALL xml_EndElement(xp, 'uspp') 2138 CALL xml_NewElement(xp, 'paw') 2139 CALL xml_addCharacters(xp, obj%paw) 2140 CALL xml_EndElement(xp, 'paw') 2141 CALL xml_EndElement(xp, TRIM(obj%tagname)) 2142 END SUBROUTINE qes_write_algorithmic_info 2143 2144 SUBROUTINE qes_write_symmetries(xp, obj) 2145 !----------------------------------------------------------------- 2146 IMPLICIT NONE 2147 TYPE (xmlf_t),INTENT(INOUT) :: xp 2148 TYPE(symmetries_type),INTENT(IN) :: obj 2149 ! 2150 INTEGER :: i 2151 ! 2152 IF ( .NOT. obj%lwrite ) RETURN 2153 ! 2154 CALL xml_NewElement(xp, TRIM(obj%tagname)) 2155 CALL xml_NewElement(xp, 'nsym') 2156 CALL xml_addCharacters(xp, obj%nsym) 2157 CALL xml_EndElement(xp, 'nsym') 2158 CALL xml_NewElement(xp, 'nrot') 2159 CALL xml_addCharacters(xp, obj%nrot) 2160 CALL xml_EndElement(xp, 'nrot') 2161 CALL xml_NewElement(xp, 'space_group') 2162 CALL xml_addCharacters(xp, obj%space_group) 2163 CALL xml_EndElement(xp, 'space_group') 2164 DO i = 1, obj%ndim_symmetry 2165 CALL qes_write_symmetry(xp, obj%symmetry(i) ) 2166 END DO 2167 CALL xml_EndElement(xp, TRIM(obj%tagname)) 2168 END SUBROUTINE qes_write_symmetries 2169 2170 SUBROUTINE qes_write_symmetry(xp, obj) 2171 !----------------------------------------------------------------- 2172 IMPLICIT NONE 2173 TYPE (xmlf_t),INTENT(INOUT) :: xp 2174 TYPE(symmetry_type),INTENT(IN) :: obj 2175 ! 2176 INTEGER :: i 2177 ! 2178 IF ( .NOT. obj%lwrite ) RETURN 2179 ! 2180 CALL xml_NewElement(xp, TRIM(obj%tagname)) 2181 CALL qes_write_info (xp, obj%info) 2182 CALL qes_write_matrix (xp, obj%rotation) 2183 IF (obj%fractional_translation_ispresent) THEN 2184 CALL xml_NewElement(xp, "fractional_translation") 2185 CALL xml_addCharacters(xp, obj%fractional_translation, fmt='s16') 2186 CALL xml_EndElement(xp, "fractional_translation") 2187 END IF 2188 IF (obj%equivalent_atoms_ispresent) THEN 2189 CALL qes_write_equivalent_atoms (xp, obj%equivalent_atoms) 2190 END IF 2191 CALL xml_EndElement(xp, TRIM(obj%tagname)) 2192 END SUBROUTINE qes_write_symmetry 2193 2194 SUBROUTINE qes_write_equivalent_atoms(xp, obj) 2195 !----------------------------------------------------------------- 2196 IMPLICIT NONE 2197 TYPE (xmlf_t),INTENT(INOUT) :: xp 2198 TYPE(equivalent_atoms_type),INTENT(IN) :: obj 2199 ! 2200 INTEGER :: i 2201 ! 2202 IF ( .NOT. obj%lwrite ) RETURN 2203 ! 2204 CALL xml_NewElement(xp, TRIM(obj%tagname)) 2205 CALL xml_addAttribute(xp, 'nat', obj%nat ) 2206 CALL xml_addAttribute(xp, 'size', obj%size ) 2207 CALL xml_addNewLine(xp) 2208 DO i = 1, obj%size, 8 2209 CALL xml_AddCharacters(xp, obj%equivalent_atoms(i:MIN(i+8-1, obj%size))) 2210 CALL xml_AddNewLine(xp) 2211 END DO 2212 CALL xml_EndElement(xp, TRIM(obj%tagname)) 2213 END SUBROUTINE qes_write_equivalent_atoms 2214 2215 SUBROUTINE qes_write_info(xp, obj) 2216 !----------------------------------------------------------------- 2217 IMPLICIT NONE 2218 TYPE (xmlf_t),INTENT(INOUT) :: xp 2219 TYPE(info_type),INTENT(IN) :: obj 2220 ! 2221 INTEGER :: i 2222 ! 2223 IF ( .NOT. obj%lwrite ) RETURN 2224 ! 2225 CALL xml_NewElement(xp, TRIM(obj%tagname)) 2226 IF (obj%name_ispresent) CALL xml_addAttribute(xp, 'name', TRIM(obj%name) ) 2227 IF (obj%class_ispresent) CALL xml_addAttribute(xp, 'class', TRIM(obj%class) ) 2228 IF (obj%time_reversal_ispresent) CALL xml_addAttribute(xp, 'time_reversal', obj%time_reversal ) 2229 CALL xml_AddCharacters(xp, TRIM(obj%info)) 2230 CALL xml_EndElement(xp, TRIM(obj%tagname)) 2231 END SUBROUTINE qes_write_info 2232 2233 SUBROUTINE qes_write_outputPBC(xp, obj) 2234 !----------------------------------------------------------------- 2235 IMPLICIT NONE 2236 TYPE (xmlf_t),INTENT(INOUT) :: xp 2237 TYPE(outputPBC_type),INTENT(IN) :: obj 2238 ! 2239 INTEGER :: i 2240 ! 2241 IF ( .NOT. obj%lwrite ) RETURN 2242 ! 2243 CALL xml_NewElement(xp, TRIM(obj%tagname)) 2244 CALL xml_NewElement(xp, 'assume_isolated') 2245 CALL xml_addCharacters(xp, TRIM(obj%assume_isolated)) 2246 CALL xml_EndElement(xp, 'assume_isolated') 2247 CALL xml_EndElement(xp, TRIM(obj%tagname)) 2248 END SUBROUTINE qes_write_outputPBC 2249 2250 SUBROUTINE qes_write_magnetization(xp, obj) 2251 !----------------------------------------------------------------- 2252 IMPLICIT NONE 2253 TYPE (xmlf_t),INTENT(INOUT) :: xp 2254 TYPE(magnetization_type),INTENT(IN) :: obj 2255 ! 2256 INTEGER :: i 2257 ! 2258 IF ( .NOT. obj%lwrite ) RETURN 2259 ! 2260 CALL xml_NewElement(xp, TRIM(obj%tagname)) 2261 CALL xml_NewElement(xp, 'lsda') 2262 CALL xml_addCharacters(xp, obj%lsda) 2263 CALL xml_EndElement(xp, 'lsda') 2264 CALL xml_NewElement(xp, 'noncolin') 2265 CALL xml_addCharacters(xp, obj%noncolin) 2266 CALL xml_EndElement(xp, 'noncolin') 2267 CALL xml_NewElement(xp, 'spinorbit') 2268 CALL xml_addCharacters(xp, obj%spinorbit) 2269 CALL xml_EndElement(xp, 'spinorbit') 2270 CALL xml_NewElement(xp, 'total') 2271 CALL xml_addCharacters(xp, obj%total, fmt='s16') 2272 CALL xml_EndElement(xp, 'total') 2273 CALL xml_NewElement(xp, 'absolute') 2274 CALL xml_addCharacters(xp, obj%absolute, fmt='s16') 2275 CALL xml_EndElement(xp, 'absolute') 2276 IF (obj%do_magnetization_ispresent) THEN 2277 CALL xml_NewElement(xp, "do_magnetization") 2278 CALL xml_addCharacters(xp, obj%do_magnetization) 2279 CALL xml_EndElement(xp, "do_magnetization") 2280 END IF 2281 CALL xml_EndElement(xp, TRIM(obj%tagname)) 2282 END SUBROUTINE qes_write_magnetization 2283 2284 SUBROUTINE qes_write_total_energy(xp, obj) 2285 !----------------------------------------------------------------- 2286 IMPLICIT NONE 2287 TYPE (xmlf_t),INTENT(INOUT) :: xp 2288 TYPE(total_energy_type),INTENT(IN) :: obj 2289 ! 2290 INTEGER :: i 2291 ! 2292 IF ( .NOT. obj%lwrite ) RETURN 2293 ! 2294 CALL xml_NewElement(xp, TRIM(obj%tagname)) 2295 CALL xml_NewElement(xp, 'etot') 2296 CALL xml_addCharacters(xp, obj%etot, fmt='s16') 2297 CALL xml_EndElement(xp, 'etot') 2298 IF (obj%eband_ispresent) THEN 2299 CALL xml_NewElement(xp, "eband") 2300 CALL xml_addCharacters(xp, obj%eband, fmt='s16') 2301 CALL xml_EndElement(xp, "eband") 2302 END IF 2303 IF (obj%ehart_ispresent) THEN 2304 CALL xml_NewElement(xp, "ehart") 2305 CALL xml_addCharacters(xp, obj%ehart, fmt='s16') 2306 CALL xml_EndElement(xp, "ehart") 2307 END IF 2308 IF (obj%vtxc_ispresent) THEN 2309 CALL xml_NewElement(xp, "vtxc") 2310 CALL xml_addCharacters(xp, obj%vtxc, fmt='s16') 2311 CALL xml_EndElement(xp, "vtxc") 2312 END IF 2313 IF (obj%etxc_ispresent) THEN 2314 CALL xml_NewElement(xp, "etxc") 2315 CALL xml_addCharacters(xp, obj%etxc, fmt='s16') 2316 CALL xml_EndElement(xp, "etxc") 2317 END IF 2318 IF (obj%ewald_ispresent) THEN 2319 CALL xml_NewElement(xp, "ewald") 2320 CALL xml_addCharacters(xp, obj%ewald, fmt='s16') 2321 CALL xml_EndElement(xp, "ewald") 2322 END IF 2323 IF (obj%demet_ispresent) THEN 2324 CALL xml_NewElement(xp, "demet") 2325 CALL xml_addCharacters(xp, obj%demet, fmt='s16') 2326 CALL xml_EndElement(xp, "demet") 2327 END IF 2328 IF (obj%efieldcorr_ispresent) THEN 2329 CALL xml_NewElement(xp, "efieldcorr") 2330 CALL xml_addCharacters(xp, obj%efieldcorr, fmt='s16') 2331 CALL xml_EndElement(xp, "efieldcorr") 2332 END IF 2333 IF (obj%potentiostat_contr_ispresent) THEN 2334 CALL xml_NewElement(xp, "potentiostat_contr") 2335 CALL xml_addCharacters(xp, obj%potentiostat_contr, fmt='s16') 2336 CALL xml_EndElement(xp, "potentiostat_contr") 2337 END IF 2338 IF (obj%gatefield_contr_ispresent) THEN 2339 CALL xml_NewElement(xp, "gatefield_contr") 2340 CALL xml_addCharacters(xp, obj%gatefield_contr, fmt='s16') 2341 CALL xml_EndElement(xp, "gatefield_contr") 2342 END IF 2343 IF (obj%vdW_term_ispresent) THEN 2344 CALL xml_NewElement(xp, "vdW_term") 2345 CALL xml_addCharacters(xp, obj%vdW_term, fmt='s16') 2346 CALL xml_EndElement(xp, "vdW_term") 2347 END IF 2348 CALL xml_EndElement(xp, TRIM(obj%tagname)) 2349 END SUBROUTINE qes_write_total_energy 2350 2351 SUBROUTINE qes_write_band_structure(xp, obj) 2352 !----------------------------------------------------------------- 2353 IMPLICIT NONE 2354 TYPE (xmlf_t),INTENT(INOUT) :: xp 2355 TYPE(band_structure_type),INTENT(IN) :: obj 2356 ! 2357 INTEGER :: i 2358 ! 2359 IF ( .NOT. obj%lwrite ) RETURN 2360 ! 2361 CALL xml_NewElement(xp, TRIM(obj%tagname)) 2362 CALL xml_NewElement(xp, 'lsda') 2363 CALL xml_addCharacters(xp, obj%lsda) 2364 CALL xml_EndElement(xp, 'lsda') 2365 CALL xml_NewElement(xp, 'noncolin') 2366 CALL xml_addCharacters(xp, obj%noncolin) 2367 CALL xml_EndElement(xp, 'noncolin') 2368 CALL xml_NewElement(xp, 'spinorbit') 2369 CALL xml_addCharacters(xp, obj%spinorbit) 2370 CALL xml_EndElement(xp, 'spinorbit') 2371 IF (obj%nbnd_ispresent) THEN 2372 CALL xml_NewElement(xp, "nbnd") 2373 CALL xml_addCharacters(xp, obj%nbnd) 2374 CALL xml_EndElement(xp, "nbnd") 2375 END IF 2376 IF (obj%nbnd_up_ispresent) THEN 2377 CALL xml_NewElement(xp, "nbnd_up") 2378 CALL xml_addCharacters(xp, obj%nbnd_up) 2379 CALL xml_EndElement(xp, "nbnd_up") 2380 END IF 2381 IF (obj%nbnd_dw_ispresent) THEN 2382 CALL xml_NewElement(xp, "nbnd_dw") 2383 CALL xml_addCharacters(xp, obj%nbnd_dw) 2384 CALL xml_EndElement(xp, "nbnd_dw") 2385 END IF 2386 CALL xml_NewElement(xp, 'nelec') 2387 CALL xml_addCharacters(xp, obj%nelec, fmt='s16') 2388 CALL xml_EndElement(xp, 'nelec') 2389 IF (obj%num_of_atomic_wfc_ispresent) THEN 2390 CALL xml_NewElement(xp, "num_of_atomic_wfc") 2391 CALL xml_addCharacters(xp, obj%num_of_atomic_wfc) 2392 CALL xml_EndElement(xp, "num_of_atomic_wfc") 2393 END IF 2394 CALL xml_NewElement(xp, 'wf_collected') 2395 CALL xml_addCharacters(xp, obj%wf_collected) 2396 CALL xml_EndElement(xp, 'wf_collected') 2397 IF (obj%fermi_energy_ispresent) THEN 2398 CALL xml_NewElement(xp, "fermi_energy") 2399 CALL xml_addCharacters(xp, obj%fermi_energy, fmt='s16') 2400 CALL xml_EndElement(xp, "fermi_energy") 2401 END IF 2402 IF (obj%highestOccupiedLevel_ispresent) THEN 2403 CALL xml_NewElement(xp, "highestOccupiedLevel") 2404 CALL xml_addCharacters(xp, obj%highestOccupiedLevel, fmt='s16') 2405 CALL xml_EndElement(xp, "highestOccupiedLevel") 2406 END IF 2407 IF (obj%lowestUnoccupiedLevel_ispresent) THEN 2408 CALL xml_NewElement(xp, "lowestUnoccupiedLevel") 2409 CALL xml_addCharacters(xp, obj%lowestUnoccupiedLevel, fmt='s16') 2410 CALL xml_EndElement(xp, "lowestUnoccupiedLevel") 2411 END IF 2412 IF (obj%two_fermi_energies_ispresent) THEN 2413 CALL xml_NewElement(xp, "two_fermi_energies") 2414 CALL xml_addCharacters(xp, obj%two_fermi_energies, fmt='s16') 2415 CALL xml_EndElement(xp, "two_fermi_energies") 2416 END IF 2417 CALL qes_write_k_points_IBZ (xp, obj%starting_k_points) 2418 CALL xml_NewElement(xp, 'nks') 2419 CALL xml_addCharacters(xp, obj%nks) 2420 CALL xml_EndElement(xp, 'nks') 2421 CALL qes_write_occupations (xp, obj%occupations_kind) 2422 IF (obj%smearing_ispresent) THEN 2423 CALL qes_write_smearing (xp, obj%smearing) 2424 END IF 2425 DO i = 1, obj%ndim_ks_energies 2426 CALL qes_write_ks_energies(xp, obj%ks_energies(i) ) 2427 END DO 2428 CALL xml_EndElement(xp, TRIM(obj%tagname)) 2429 END SUBROUTINE qes_write_band_structure 2430 2431 SUBROUTINE qes_write_ks_energies(xp, obj) 2432 !----------------------------------------------------------------- 2433 IMPLICIT NONE 2434 TYPE (xmlf_t),INTENT(INOUT) :: xp 2435 TYPE(ks_energies_type),INTENT(IN) :: obj 2436 ! 2437 INTEGER :: i 2438 ! 2439 IF ( .NOT. obj%lwrite ) RETURN 2440 ! 2441 CALL xml_NewElement(xp, TRIM(obj%tagname)) 2442 CALL qes_write_k_point (xp, obj%k_point) 2443 CALL xml_NewElement(xp, 'npw') 2444 CALL xml_addCharacters(xp, obj%npw) 2445 CALL xml_EndElement(xp, 'npw') 2446 CALL qes_write_vector (xp, obj%eigenvalues) 2447 CALL qes_write_vector (xp, obj%occupations) 2448 CALL xml_EndElement(xp, TRIM(obj%tagname)) 2449 END SUBROUTINE qes_write_ks_energies 2450 2451 SUBROUTINE qes_write_closed(xp, obj) 2452 !----------------------------------------------------------------- 2453 IMPLICIT NONE 2454 TYPE (xmlf_t),INTENT(INOUT) :: xp 2455 TYPE(closed_type),INTENT(IN) :: obj 2456 ! 2457 INTEGER :: i 2458 ! 2459 IF ( .NOT. obj%lwrite ) RETURN 2460 ! 2461 CALL xml_NewElement(xp, TRIM(obj%tagname)) 2462 CALL xml_addAttribute(xp, 'DATE', TRIM(obj%DATE) ) 2463 CALL xml_addAttribute(xp, 'TIME', TRIM(obj%TIME) ) 2464 CALL xml_AddCharacters(xp, TRIM(obj%closed)) 2465 CALL xml_EndElement(xp, TRIM(obj%tagname)) 2466 END SUBROUTINE qes_write_closed 2467 2468 SUBROUTINE qes_write_vector(xp, obj) 2469 !----------------------------------------------------------------- 2470 IMPLICIT NONE 2471 TYPE (xmlf_t),INTENT(INOUT) :: xp 2472 TYPE(vector_type),INTENT(IN) :: obj 2473 ! 2474 INTEGER :: i 2475 ! 2476 IF ( .NOT. obj%lwrite ) RETURN 2477 ! 2478 CALL xml_NewElement(xp, TRIM(obj%tagname)) 2479 CALL xml_addAttribute(xp, 'size', obj%size ) 2480 CALL xml_addNewLine(xp) 2481 DO i = 1, obj%size, 5 2482 CALL xml_AddCharacters(xp, obj%vector(i:MIN(i+5-1,obj%size)), fmt='s16') 2483 CALL xml_AddNewLine(xp) 2484 END DO 2485 CALL xml_EndElement(xp, TRIM(obj%tagname)) 2486 END SUBROUTINE qes_write_vector 2487 2488 SUBROUTINE qes_write_integerVector(xp, obj) 2489 !----------------------------------------------------------------- 2490 IMPLICIT NONE 2491 TYPE (xmlf_t),INTENT(INOUT) :: xp 2492 TYPE(integerVector_type),INTENT(IN) :: obj 2493 ! 2494 INTEGER :: i 2495 ! 2496 IF ( .NOT. obj%lwrite ) RETURN 2497 ! 2498 CALL xml_NewElement(xp, TRIM(obj%tagname)) 2499 CALL xml_addAttribute(xp, 'size', obj%size ) 2500 CALL xml_addNewLine(xp) 2501 DO i = 1, obj%size, 8 2502 CALL xml_AddCharacters(xp, obj%integerVector(i:MIN(i+8-1, obj%size))) 2503 CALL xml_AddNewLine(xp) 2504 END DO 2505 CALL xml_EndElement(xp, TRIM(obj%tagname)) 2506 END SUBROUTINE qes_write_integerVector 2507 2508 SUBROUTINE qes_write_matrix(xp, obj) 2509 !----------------------------------------------------------------- 2510 IMPLICIT NONE 2511 TYPE (xmlf_t),INTENT(INOUT) :: xp 2512 TYPE(matrix_type),INTENT(IN) :: obj 2513 ! 2514 INTEGER :: i 2515 ! 2516 IF ( .NOT. obj%lwrite ) RETURN 2517 ! 2518 CALL xml_NewElement(xp, TRIM(obj%tagname)) 2519 CALL xml_addAttribute(xp, 'rank', obj%rank ) 2520 CALL xml_addAttribute(xp, 'dims', obj%dims ) 2521 CALL xml_addAttribute(xp, 'order', TRIM(obj%order) ) 2522 CALL xml_addNewLine(xp) 2523 DO i = 1, obj%dims(2) 2524 CALL xml_AddCharacters(xp, obj%matrix((i-1)*obj%dims(1)+1: i*obj%dims(1)), fmt ='s16') 2525 CALL xml_addNewLine(xp) 2526 END DO 2527 CALL xml_EndElement(xp, TRIM(obj%tagname)) 2528 END SUBROUTINE qes_write_matrix 2529 2530 SUBROUTINE qes_write_integerMatrix(xp, obj) 2531 !----------------------------------------------------------------- 2532 IMPLICIT NONE 2533 TYPE (xmlf_t),INTENT(INOUT) :: xp 2534 TYPE(integerMatrix_type),INTENT(IN) :: obj 2535 ! 2536 INTEGER :: i 2537 ! 2538 IF ( .NOT. obj%lwrite ) RETURN 2539 ! 2540 CALL xml_NewElement(xp, TRIM(obj%tagname)) 2541 CALL xml_addAttribute(xp, 'rank', obj%rank ) 2542 CALL xml_addAttribute(xp, 'dims', obj%dims ) 2543 CALL xml_addAttribute(xp, 'order', TRIM(obj%order) ) 2544 CALL xml_addNewLine(xp) 2545 DO i = 1, obj%dims(2) 2546 CALL xml_AddCharacters(xp, obj%integerMatrix((i-1)*obj%dims(1)+1: i*obj%dims(1)) ) 2547 CALL xml_addNewLine(xp) 2548 END DO 2549 CALL xml_EndElement(xp, TRIM(obj%tagname)) 2550 END SUBROUTINE qes_write_integerMatrix 2551 2552 SUBROUTINE qes_write_scalarQuantity(xp, obj) 2553 !----------------------------------------------------------------- 2554 IMPLICIT NONE 2555 TYPE (xmlf_t),INTENT(INOUT) :: xp 2556 TYPE(scalarQuantity_type),INTENT(IN) :: obj 2557 ! 2558 INTEGER :: i 2559 ! 2560 IF ( .NOT. obj%lwrite ) RETURN 2561 ! 2562 CALL xml_NewElement(xp, TRIM(obj%tagname)) 2563 CALL xml_addAttribute(xp, 'Units', TRIM(obj%Units) ) 2564 CALL xml_AddCharacters(xp, obj%scalarQuantity, fmt='s16') 2565 CALL xml_EndElement(xp, TRIM(obj%tagname)) 2566 END SUBROUTINE qes_write_scalarQuantity 2567 2568 ! 2569END MODULE qes_write_module