1! 2! Copyright (C) 2008-2012 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! 8! 9!---------------------------------------------------------------------------- 10MODULE ph_restart 11 !---------------------------------------------------------------------------- 12 ! 13 ! ... this module contains methods to read and write data saved by the 14 ! phonon code to restart smoothly 15 ! 16 USE xmltools 17 ! 18 USE kinds, ONLY : DP 19 USE io_files, ONLY : prefix 20 USE control_ph,ONLY : tmp_dir_ph 21 USE io_global, ONLY : ionode, ionode_id 22 USE mp_images, ONLY : intra_image_comm 23 USE mp, ONLY : mp_bcast 24 ! 25 IMPLICIT NONE 26 ! 27 SAVE 28 ! 29 PRIVATE 30 ! 31 PUBLIC :: ph_writefile, ph_readfile, allocate_grid_variables, & 32 check_directory_phsave, destroy_status_run, check_available_bands, & 33 read_disp_pattern_only 34 ! 35 INTEGER :: iunpun 36 ! 37 ! FIXME: obsolete variables? 38 CHARACTER(len=256) :: qexml_version = ' ' 39 LOGICAL :: qexml_version_init = .FALSE. 40 ! 41 CONTAINS 42 ! 43 !------------------------------------------------------------------------ 44 SUBROUTINE ph_writefile( what, iq, irr, ierr ) 45 !------------------------------------------------------------------------ 46 ! 47 USE global_version, ONLY : version_number 48 USE control_ph, ONLY : ldisp, epsil, trans, zue, zeu 49 USE el_phon, ONLY : elph 50 USE freq_ph, ONLY : fpol, nfs, fiu, current_iu 51 USE ramanm, ONLY : lraman, elop 52 USE disp, ONLY : nqs, x_q, nq1, nq2, nq3 53 ! 54 IMPLICIT NONE 55 ! 56 CHARACTER(LEN=*), INTENT(IN) :: what 57 INTEGER, INTENT(IN) :: iq, irr 58 ! 59 INTEGER, INTENT(OUT) :: ierr 60 ! 61 CALL ph_restart_set_filename( what, irr, iq, 1, ierr) 62 ! 63 IF ( ionode ) THEN 64 ! 65 ! ... here we start writing the ph-punch-file 66 ! 67!------------------------------------------------------------------------------- 68! ... HEADER 69!------------------------------------------------------------------------------- 70 ! 71 IF (what=='init') THEN 72 ! 73 CALL write_header_ph( "PH", TRIM(version_number) ) 74 ! 75! 76! With what='init' the routine writes the main variables that 77! control the main flow of the dispersion calculation: 78! The main flags of the phonon code, the mesh of q point, the 79! number of q points and their coordinates. 80! 81!------------------------------------------------------------------------------- 82! ... CONTROL 83!------------------------------------------------------------------------------- 84 ! 85 CALL write_control_ph( ldisp, epsil, trans, elph, zue, zeu, & 86 lraman, elop, fpol ) 87 ! 88!------------------------------------------------------------------------------- 89! ... Q POINTS AND FREQUENCY POINTS 90!------------------------------------------------------------------------------ 91 ! 92 CALL write_qu( nqs, nq1, nq2, nq3, x_q, nfs, fiu, fpol ) 93 ! 94 ELSEIF (what=='status_ph') THEN 95! 96! In this case we save the information on the status of the calculation. 97! The current q point, the current frequency, the label and the 98! code with the point where the code arrived so far. 99! The former is easy to read in the xml file, 100! the latter is simpler to use in the code. 101! 102 CALL write_status_ph(iq, current_iu) 103 ! 104 ELSEIF (what=='data_u') THEN 105! 106! with what='data_u' this routine writes the information on the irreducible 107! representations. Number of irreducible representations, number of modes 108! for each representation and displacements u. 109! 110 CALL write_modes(iq) 111 ! 112 ELSEIF (what=='polarization') THEN 113! 114! With what='polarization' this routine saves the tensors that contain the 115! polarization as a function of frequency. 116! 117 CALL write_polarization(irr) 118 ! 119 ELSEIF (what=='tensors') THEN 120! 121! With what='tensors' this routine saves the tensors that contain the 122! result of the calculations done so far: epsilon, zstareu, ramtns, eloptns, 123! dyn, zstarue. 124! 125 CALL write_tensors() 126 ! 127 ELSEIF (what=='data_dyn') THEN 128! 129! with what='data_dyn' this routine writes the information calculated 130! separately for each irreducible representation. The contributions 131! of the representation to the dynamical matrix and to the Born effective 132! charges dP/du. 133! 134 CALL write_ph_dyn(irr) 135 136 ELSEIF (what=='el_phon') THEN 137! with what='data_dyn' this routine writes the information calculated 138! for this irreducible representation to the electron phonon 139! 140 CALL write_el_phon(irr) 141 142 END IF 143 CALL xmlw_closetag ( ) ! Root 144 CALL xml_closefile ( ) 145 END IF 146 147 148 RETURN 149 ! 150 CONTAINS 151 152 SUBROUTINE write_polarization(iu) 153! 154 USE freq_ph, ONLY : polar, done_iu, fpol, done_fpol, fiu 155 156 IMPLICIT NONE 157 INTEGER :: iu 158 159 IF (.NOT.fpol) RETURN 160 CALL xmlw_opentag( "POLARIZ_IU" ) 161! 162! Save the current flags 163! 164 CALL xmlw_writetag( "DONE_POLARIZ_IU", done_fpol ) 165! 166! Here we save the frequency dependent polarization at this iu 167! 168 CALL xmlw_writetag( "FREQUENCY_IN_RY", fiu(iu) ) 169 CALL xmlw_writetag( "CALCULATED_FREQUENCY", done_iu(iu) ) 170 IF ( done_iu(iu) ) & 171 CALL xmlw_writetag( "POLARIZATION_IU", polar(:,:,iu) ) 172 ! 173 CALL xmlw_closetag( ) 174 RETURN 175 END SUBROUTINE write_polarization 176 177 SUBROUTINE write_tensors() 178! 179 USE control_ph, ONLY : done_epsil, done_start_zstar, done_zeu, done_zue 180 USE ramanm, ONLY : lraman, elop, ramtns, eloptns, done_lraman, & 181 done_elop 182 USE efield_mod, ONLY : zstareu0, zstareu, zstarue, epsilon 183 USE ions_base, ONLY : nat 184 185 IMPLICIT NONE 186 INTEGER :: na 187 ! 188 CALL xmlw_opentag( "EF_TENSORS" ) 189! 190! Save the current flags 191! 192 CALL xmlw_writetag( "DONE_ELECTRIC_FIELD",done_epsil ) 193 CALL xmlw_writetag( "DONE_START_EFFECTIVE_CHARGE",done_start_zstar ) 194 CALL xmlw_writetag( "DONE_EFFECTIVE_CHARGE_EU",done_zeu ) 195 CALL xmlw_writetag( "DONE_EFFECTIVE_CHARGE_PH",done_zue ) 196 CALL xmlw_writetag( "DONE_RAMAN_TENSOR",done_lraman ) 197 CALL xmlw_writetag( "DONE_ELECTRO_OPTIC",done_elop ) 198! 199! save all calculated tensors 200! 201 IF (done_epsil) & 202 CALL xmlw_writetag( "DIELECTRIC_CONSTANT", epsilon ) 203 IF (done_start_zstar) & 204 CALL xmlw_writetag( "START_EFFECTIVE_CHARGES", zstareu0) 205 IF (done_zeu) & 206 CALL xmlw_writetag( "EFFECTIVE_CHARGES_EU", zstareu ) 207 IF (done_lraman) THEN 208 DO na = 1, nat 209 CALL add_attr("atom", na) 210 CALL xmlw_writetag( "RAMAN_TNS",ramtns(:,:,:,na) ) 211 END DO 212 END IF 213 IF (done_elop) & 214 CALL xmlw_writetag( "ELOP_TNS", eloptns) 215 216 IF (done_zue) & 217 CALL xmlw_writetag( "EFFECTIVE_CHARGES_UE", zstarue ) 218 ! 219 CALL xmlw_closetag( ) 220 RETURN 221 END SUBROUTINE write_tensors 222 223 SUBROUTINE write_modes(iq) 224 USE modes, ONLY : nirr, npert, u, name_rap_mode, num_rap_mode 225 226 USE lr_symm_base, ONLY : nsymq, minus_q 227 ! Workaround 228 use ions_base, only: nat 229 230 IMPLICIT NONE 231 ! Workaround 232 INTEGER :: imode0, imode, irr, ipert, iq 233 234 CALL xmlw_opentag( "IRREPS_INFO" ) 235 ! 236 CALL xmlw_writetag( "QPOINT_NUMBER",iq) 237 ! 238 CALL xmlw_writetag( "QPOINT_GROUP_RANK",nsymq) 239 ! 240 CALL xmlw_writetag( "MINUS_Q_SYM",minus_q) 241 ! 242 CALL xmlw_writetag( "NUMBER_IRR_REP",nirr) 243 ! 244 imode0=0 245 DO irr=1,nirr 246 CALL xmlw_opentag( "REPRESENTION."//i2c(irr) ) 247 CALL xmlw_writetag( "NUMBER_OF_PERTURBATIONS", npert(irr) ) 248 DO ipert=1,npert(irr) 249 imode=imode0+ipert 250 CALL xmlw_opentag( "PERTURBATION."//i2c(ipert) ) 251 !CALL xmlw_writetag( "SYMMETRY_TYPE_CODE", num_rap_mode(imode)) 252 !CALL xmlw_writetag( "SYMMETRY_TYPE", name_rap_mode(imode) ) 253 CALL xmlw_writetag( "DISPLACEMENT_PATTERN", u(:,imode) ) 254 CALL xmlw_closetag( ) 255 ENDDO 256 imode0=imode0+npert(irr) 257 CALL xmlw_closetag( ) 258 ENDDO 259 ! 260 CALL xmlw_closetag( ) 261 RETURN 262 END SUBROUTINE write_modes 263 264 SUBROUTINE write_ph_dyn(irr) 265 USE partial, ONLY : done_irr 266 USE dynmat, ONLY : dyn_rec 267 USE efield_mod, ONLY : zstarue0_rec 268 USE control_ph, ONLY : trans, zue 269 270 IMPLICIT NONE 271 INTEGER, INTENT(IN) :: irr 272 273 IF (trans.OR.zeu) THEN 274 IF (done_irr(irr)) THEN 275 ! 276 CALL xmlw_opentag( "PM_HEADER") 277 CALL xmlw_writetag( "DONE_IRR", done_irr(irr)) 278 CALL xmlw_closetag( ) 279 CALL xmlw_opentag( "PARTIAL_MATRIX") 280 CALL xmlw_writetag( "PARTIAL_DYN", dyn_rec(:,:)) 281 IF ( zue .and. irr>0 ) & 282 CALL xmlw_writetag( "PARTIAL_ZUE", zstarue0_rec(:,:)) 283 CALL xmlw_closetag( ) 284 ENDIF 285 ENDIF 286 RETURN 287 END SUBROUTINE write_ph_dyn 288 289 SUBROUTINE write_el_phon(irr) 290 USE el_phon, ONLY : done_elph, el_ph_mat_rec_col, elph 291 USE modes, ONLY : npert 292 USE klist, ONLY : nks 293 USE wvfct, ONLY: nbnd 294 USE qpoint, ONLY : nksqtot, xk_col 295 USE control_lr, ONLY : lgamma 296 IMPLICIT NONE 297 INTEGER, INTENT(IN) :: irr 298 INTEGER :: ik, ikk, np 299 300 IF (.NOT. elph .OR. .NOT. done_elph(irr)) RETURN 301 ! 302 CALL xmlw_opentag ( "EL_PHON_HEADER") 303 CALL xmlw_writetag( "DONE_ELPH", done_elph(irr)) 304 CALL xmlw_closetag( ) ! el_phon_header 305 CALL xmlw_writetag( "NUMBER_OF_K", nksqtot) 306 CALL xmlw_writetag( "NUMBER_OF_BANDS", nbnd) 307 DO ik=1,nksqtot 308 ikk = 2 * ik - 1 309 IF (lgamma) ikk = ik 310 CALL xmlw_opentag( "K_POINT." // i2c(ik) ) 311 CALL xmlw_writetag( "COORDINATES_XK", xk_col(:,ikk) ) 312 DO np = 1, npert(irr) 313 CALL add_attr("perturbation",np) 314 CALL xmlw_writetag( "PARTIAL_ELPH", el_ph_mat_rec_col(:,:,ik,np) ) 315 END DO 316 CALL xmlw_closetag( ) 317 ENDDO 318 CALL xmlw_closetag( ) 319 RETURN 320 END SUBROUTINE write_el_phon 321 322 END SUBROUTINE ph_writefile 323 324 !------------------------------------------------------------------------ 325 SUBROUTINE write_header_ph( creator_name, creator_version ) 326 !------------------------------------------------------------------------ 327 ! 328 IMPLICIT NONE 329 CHARACTER(LEN=*), INTENT(IN) :: creator_name, creator_version 330 CHARACTER(5), PARAMETER :: fmt_name = "QEXML" 331 CHARACTER(5), PARAMETER :: fmt_version = "1.4.0" 332 333 CALL xmlw_opentag( "HEADER" ) 334 ! 335 CALL add_attr( "NAME", fmt_name ) 336 CALL add_attr( "VERSION", fmt_version ) 337 CALL xmlw_writetag( "FORMAT", "" ) 338 ! 339 CALL add_attr( "NAME", creator_name ) 340 CALL add_attr( "VERSION", creator_version ) 341 CALL xmlw_writetag( "CREATOR", "") 342 ! 343 CALL xmlw_closetag( ) 344 ! 345 END SUBROUTINE write_header_ph 346 ! 347 ! 348 SUBROUTINE write_control_ph( ldisp, epsil, trans, elph, zue, zeu, & 349 lraman, elop, fpol) 350 !------------------------------------------------------------------------ 351 ! 352 IMPLICIT NONE 353 LOGICAL, INTENT(IN) :: ldisp, epsil, trans, elph, zue, zeu, & 354 lraman, elop, fpol 355 356 CALL xmlw_opentag( "CONTROL" ) 357 ! 358 CALL xmlw_writetag( "DISPERSION_RUN", ldisp ) 359 CALL xmlw_writetag( "ELECTRIC_FIELD", epsil ) 360 CALL xmlw_writetag( "PHONON_RUN", trans ) 361 CALL xmlw_writetag( "ELECTRON_PHONON", elph ) 362 CALL xmlw_writetag( "EFFECTIVE_CHARGE_EU", zeu ) 363 CALL xmlw_writetag( "EFFECTIVE_CHARGE_PH", zue ) 364 CALL xmlw_writetag( "RAMAN_TENSOR", lraman ) 365 CALL xmlw_writetag( "ELECTRO_OPTIC", elop ) 366 CALL xmlw_writetag( "FREQUENCY_DEP_POL", fpol ) 367 ! 368 CALL xmlw_closetag( ) 369 ! 370 RETURN 371 END SUBROUTINE write_control_ph 372 373 SUBROUTINE write_status_ph(current_iq, current_iu) 374 !------------------------------------------------------------------------ 375 ! 376 USE control_ph, ONLY : where_rec, rec_code 377 IMPLICIT NONE 378 INTEGER, INTENT(IN) :: current_iq, current_iu 379 380 CALL xmlw_opentag ( "STATUS_PH" ) 381 CALL xmlw_writetag( "STOPPED_IN", where_rec ) 382 CALL xmlw_writetag( "RECOVER_CODE", rec_code ) 383 CALL xmlw_writetag( "CURRENT_Q", current_iq ) 384 CALL xmlw_writetag( "CURRENT_IU", current_iu ) 385 CALL xmlw_closetag( ) 386 ! 387 RETURN 388 END SUBROUTINE write_status_ph 389 ! 390 391 SUBROUTINE write_qu( nqs, nq1, nq2, nq3, x_q, nfs, fiu, fpol) 392 !------------------------------------------------------------------------ 393 ! 394 INTEGER, INTENT(IN) :: nqs, nfs, nq1, nq2, nq3 395 REAL(DP), INTENT(IN) :: x_q(3,nqs), fiu(nfs) 396 LOGICAL, INTENT(IN) :: fpol 397 INTEGER :: dim(3) 398 ! 399 CALL xmlw_opentag( "Q_POINTS" ) 400 ! 401 dim(1) = nqs ! FIXME: workaround for pp.py 402 CALL xmlw_writetag( "NUMBER_OF_Q_POINTS", dim(1:1) ) 403 IF (nqs > 1) THEN 404 dim(1) = nq1; dim(2) = nq2; dim(3) = nq3 405 CALL xmlw_writetag( "MESH_DIMENSIONS", dim ) 406 ENDIF 407 CALL add_attr( "UNITS", "2 pi / a" ) 408 CALL xmlw_writetag( "UNITS_FOR_Q-POINT", "" ) 409 CALL xmlw_writetag( "Q-POINT_COORDINATES", x_q(:,:) ) 410 ! 411 CALL xmlw_closetag( ) 412 ! 413 IF (fpol) THEN 414 ! 415 CALL xmlw_opentag( "FREQUENCIES" ) 416 CALL xmlw_writetag( "NUMBER_OF_FREQUENCIES", nfs ) 417 CALL xmlw_writetag( "FREQUENCY_VALUES", fiu(:) ) 418 CALL xmlw_closetag( ) 419 ! 420 ENDIF 421 ! 422 RETURN 423 END SUBROUTINE write_qu 424 ! 425 ! 426 !------------------------------------------------------------------------ 427 SUBROUTINE ph_readfile( what, iq, irr, ierr ) 428 !------------------------------------------------------------------------ 429 ! 430 IMPLICIT NONE 431 ! 432 CHARACTER(LEN=*), INTENT(IN) :: what 433 INTEGER, INTENT(IN) :: irr, iq 434 ! 435 ! irreducible representation and q point 436 ! 437 INTEGER, INTENT(OUT) :: ierr 438 ! 439 CALL ph_restart_set_filename( what, irr, iq, -1, ierr) 440 IF (ierr /= 0) RETURN 441 ! 442 SELECT CASE( what ) 443 CASE( 'init' ) 444 ! 445 CALL read_header( ierr ) 446 IF (ierr /= 0 ) RETURN 447 CALL read_control_ph( ierr ) 448 IF ( ierr /= 0 ) RETURN 449 CALL read_qu( ierr ) 450 IF ( ierr /= 0 ) RETURN 451 ! 452 CASE( 'status_ph') 453 ! 454 CALL read_status_ph( ierr ) 455 IF ( ierr /= 0 ) RETURN 456 ! 457 CASE( 'data_u' ) 458 ! 459 CALL read_disp_pattern( iunpun, iq, ierr ) 460 IF ( ierr /= 0 ) RETURN 461 ! 462 CASE( 'polarization' ) 463 ! 464 CALL read_polarization( irr, ierr ) 465 IF ( ierr /= 0 ) RETURN 466 ! 467 CASE( 'tensors' ) 468 ! 469 CALL read_tensors( ierr ) 470 IF ( ierr /= 0 ) RETURN 471 ! 472 CASE( 'data_dyn' ) 473 ! 474 CALL read_partial_ph( irr, ierr ) 475 IF ( ierr /= 0 ) RETURN 476 ! 477 CASE( 'el_phon' ) 478 ! 479 CALL read_el_phon( irr, ierr ) 480 IF ( ierr /= 0 ) RETURN 481 ! 482 CASE DEFAULT 483 ! 484 CALL errore('ph_readfile','called with the wrong what',1) 485 ! 486 END SELECT 487 ! 488 IF (ionode) THEN 489 CALL xmlr_closetag ( ) ! Root 490 CALL xml_closefile( ) 491 END IF 492 ! 493 RETURN 494 ! 495 END SUBROUTINE ph_readfile 496 ! 497 !------------------------------------------------------------------------ 498 SUBROUTINE read_header( ierr ) 499 !------------------------------------------------------------------------ 500 ! 501 ! ... this routine reads the format version of the current xml datafile 502 ! 503 IMPLICIT NONE 504 INTEGER, INTENT(OUT) :: ierr 505 CHARACTER(LEN=1) :: dummy 506 507 ierr = 0 508 IF ( qexml_version_init ) RETURN 509 ! 510 IF ( ionode ) THEN 511 ! 512 CALL xmlr_opentag( "HEADER" ) 513 CALL xmlr_readtag( "FORMAT", dummy ) 514 CALL get_attr( "VERSION", qexml_version ) 515 qexml_version_init = .TRUE. 516 CALL xmlr_closetag( ) 517 ! 518 ENDIF 519 ! 520 CALL mp_bcast( qexml_version, ionode_id, intra_image_comm ) 521 CALL mp_bcast( qexml_version_init, ionode_id, intra_image_comm ) 522 523 RETURN 524 END SUBROUTINE read_header 525 !------------------------------------------------------------------------ 526 SUBROUTINE read_status_ph( ierr ) 527 !------------------------------------------------------------------------ 528 ! 529 ! This routine reads the status of ph. It tells where the code stopped 530 ! There is both a number, to be used within the code, and a label 531 ! that is easier to read within the recover file. 532 ! 533 ! The convention is the following: 534 ! 535 ! rec_code where_rec status description 536 ! 537 ! -1000 Nothing has been read. There is no recover file. 538 ! -40 phq_setup Only the displacements u have been read from file 539 ! -30 phq_init u and dyn(0) read from file 540 ! -25 not yet active. Restart in solve_e_fpol 541 ! -20 solve_e all previous. Stopped within solve_e. There 542 ! should be a recover file. 543 ! -10 solve_e2 epsilon and zstareu are available if requested. 544 ! Within solve_e2. There should be a recover file. 545 ! 2 phescf all previous, raman tenson and elop tensor are 546 ! available if required. 547 ! 10 solve_linter all previous, within solve linter. Recover file 548 ! should be present. 549 ! 20 phqscf all previous dyn_rec(irr) and zstarue0(irr) are 550 ! available. 551 ! 30 dynmatrix all previous, dyn and zstarue are available. 552 ! 553 ! 554 USE control_ph, ONLY : current_iq, where_rec, rec_code_read 555 USE freq_ph, ONLY : current_iu 556 ! 557 IMPLICIT NONE 558 ! 559 INTEGER, INTENT(OUT) :: ierr 560 ! 561 ! ... then selected tags are read from the other sections 562 ! 563 ierr=0 564 IF ( ionode ) THEN 565 ! 566 CALL xmlr_opentag( "STATUS_PH" ) 567 CALL xmlr_readtag( "STOPPED_IN", where_rec ) 568 CALL xmlr_readtag( "RECOVER_CODE", rec_code_read ) 569 CALL xmlr_readtag( "CURRENT_Q", current_iq ) 570 CALL xmlr_readtag( "CURRENT_IU", current_iu ) 571 CALL xmlr_closetag( ) 572 ! 573 END IF 574 ! 575 CALL mp_bcast( where_rec, ionode_id, intra_image_comm ) 576 CALL mp_bcast( rec_code_read, ionode_id, intra_image_comm ) 577 CALL mp_bcast( current_iq, ionode_id, intra_image_comm ) 578 CALL mp_bcast( current_iu, ionode_id, intra_image_comm ) 579 ! 580 RETURN 581 ! 582 END SUBROUTINE read_status_ph 583 ! 584 !------------------------------------------------------------------------ 585 SUBROUTINE read_control_ph( ierr ) 586 !------------------------------------------------------------------------ 587 USE control_ph, ONLY : ldisp, epsil, trans, zue, zeu 588 USE el_phon, ONLY : elph 589 USE ramanm, ONLY : lraman, elop 590 USE freq_ph, ONLY : fpol 591 ! 592 IMPLICIT NONE 593 ! 594 INTEGER, INTENT(OUT) :: ierr 595 LOGICAL :: ldisp_, epsil_, trans_, zue_, zeu_, elph_, lraman_, elop_, & 596 fpol_ 597 ! 598 ierr=0 599 IF ( ionode ) THEN 600 CALL xmlr_opentag( "CONTROL" ) 601 ! 602 CALL xmlr_readtag( "DISPERSION_RUN", ldisp_ ) 603 CALL xmlr_readtag( "ELECTRIC_FIELD", epsil_ ) 604 CALL xmlr_readtag( "PHONON_RUN", trans_ ) 605 CALL xmlr_readtag( "ELECTRON_PHONON", elph_ ) 606 CALL xmlr_readtag( "EFFECTIVE_CHARGE_EU", zeu_ ) 607 CALL xmlr_readtag( "EFFECTIVE_CHARGE_PH", zue_ ) 608 CALL xmlr_readtag( "RAMAN_TENSOR", lraman_ ) 609 CALL xmlr_readtag( "ELECTRO_OPTIC", elop_ ) 610 CALL xmlr_readtag( "FREQUENCY_DEP_POL", fpol_ ) 611 ! 612 CALL xmlr_closetag( ) 613 ! 614 END IF 615 CALL mp_bcast( ldisp_, ionode_id, intra_image_comm ) 616 CALL mp_bcast( epsil_, ionode_id, intra_image_comm ) 617 CALL mp_bcast( trans_, ionode_id, intra_image_comm ) 618 CALL mp_bcast( elph_, ionode_id, intra_image_comm ) 619 CALL mp_bcast( zeu_, ionode_id, intra_image_comm ) 620 CALL mp_bcast( zue_, ionode_id, intra_image_comm ) 621 CALL mp_bcast( lraman_, ionode_id, intra_image_comm ) 622 CALL mp_bcast( elop_, ionode_id, intra_image_comm ) 623 CALL mp_bcast( fpol_, ionode_id, intra_image_comm ) 624 ! 625 IF (ldisp_ .neqv. ldisp) CALL errore('read_control_ph','wrong ldisp',1) 626 IF (epsil_ .neqv. epsil) CALL errore('read_control_ph','wrong epsil',1) 627 IF (trans_ .neqv. trans) CALL errore('read_control_ph','wrong trans',1) 628 IF (elph_ .neqv. elph) CALL errore('read_control_ph','wrong elph',1) 629 IF (zeu_ .neqv. zeu) CALL errore('read_control_ph','wrong zeu',1) 630 IF (zue_ .neqv. zue) CALL errore('read_control_ph','wrong zue',1) 631 IF (lraman_ .neqv. lraman) CALL errore('read_control_ph','wrong lraman',1) 632 IF (elop_ .neqv. elop) CALL errore('read_control_ph','wrong elop',1) 633 IF (fpol_ .neqv. fpol) CALL errore('read_control_ph','wrong fpol',1) 634 ! 635 RETURN 636 ! 637 END SUBROUTINE read_control_ph 638 ! 639 !------------------------------------------------------------------------ 640 SUBROUTINE read_qu( ierr ) 641 !------------------------------------------------------------------------ 642 ! 643 USE disp, ONLY : nqs, x_q, nq1, nq2, nq3, lgamma_iq 644 USE freq_ph, ONLY : fpol, nfs, fiu 645 ! 646 IMPLICIT NONE 647 ! 648 INTEGER, INTENT(OUT) :: ierr 649 INTEGER :: nfs_, nq1_, nq2_, nq3_, iq 650 LOGICAL :: exst 651 INTEGER :: dim(3) 652 ! 653 ierr=0 654 IF (ionode) THEN 655 CALL xmlr_opentag( "Q_POINTS" ) 656 ! 657 CALL xmlr_readtag( "NUMBER_OF_Q_POINTS", nqs ) 658 dim(3) = 0 659 IF (nqs > 1) CALL xmlr_readtag( "MESH_DIMENSIONS", dim ) 660 ! 661 ALLOCATE(x_q(3,nqs)) 662 CALL xmlr_readtag( "Q-POINT_COORDINATES", x_q(1:3,1:nqs) ) 663 ! 664 CALL xmlr_closetag( ) 665 ! 666 IF (fpol) THEN 667 ! 668 CALL xmlr_opentag( "FREQUENCIES" ) 669 ! 670 CALL xmlr_readtag( "NUMBER_OF_FREQUENCIES", nfs_ ) 671 ! 672 CALL xmlr_readtag( "FREQUENCY_VALUES", fiu(1:nfs_) ) 673 ! 674 CALL xmlr_closetag( ) 675 ! 676 ENDIF 677 ENDIF 678 679 CALL mp_bcast( nqs, ionode_id, intra_image_comm ) 680 681 IF (nqs > 1) THEN 682 CALL mp_bcast( dim, ionode_id, intra_image_comm ) 683 nq1_ = dim(1); nq2_ = dim(2); nq3_ = dim(3) 684 IF ( (nq1_ /= nq1 ) .OR. (nq2_ /= nq2) .OR. (nq3_ /= nq3 ) ) & 685 CALL errore('read_qu','nq1, nq2, or nq3 do not match',1) 686 ! 687 ENDIF 688 689 IF (.NOT. ionode) ALLOCATE(x_q(3,nqs)) 690 CALL mp_bcast( x_q, ionode_id, intra_image_comm ) 691 692 ALLOCATE(lgamma_iq(nqs)) 693 DO iq=1,nqs 694 lgamma_iq(iq)=(x_q(1,iq)==0.D0.AND.x_q(2,iq)==0.D0.AND.x_q(3,iq)==0.D0) 695 END DO 696 697 IF (fpol) THEN 698 CALL mp_bcast( nfs_, ionode_id, intra_image_comm ) 699 IF (nfs_ /= nfs) & 700 CALL errore('read_qu','wrong number of frequencies',1) 701 702 CALL mp_bcast( fiu, ionode_id, intra_image_comm ) 703 END IF 704 705 RETURN 706 ! 707 END SUBROUTINE read_qu 708 709 SUBROUTINE read_partial_ph( irr, ierr ) 710 711 USE partial, ONLY : done_irr 712 USE efield_mod, ONLY : zstarue0_rec 713 USE dynmat, ONLY : dyn_rec 714 USE control_ph, ONLY : trans, zue 715 716 IMPLICIT NONE 717 718 INTEGER, INTENT(OUT) :: ierr 719 INTEGER, INTENT(IN) :: irr 720 721 ! 722 ierr=0 723 IF (ionode) THEN 724 IF (trans) THEN 725 CALL xmlr_opentag( "PM_HEADER" ) 726 CALL xmlr_readtag( "DONE_IRR",done_irr(irr) ) 727 CALL xmlr_closetag( ) 728 CALL xmlr_opentag( "PARTIAL_MATRIX" ) 729 CALL xmlr_readtag( "PARTIAL_DYN", dyn_rec(:,:) ) 730 IF ( zue .AND. irr>0 ) & 731 CALL xmlr_readtag( "PARTIAL_ZUE", zstarue0_rec(:,:) ) 732 CALL xmlw_closetag( ) 733 ENDIF 734 ENDIF 735 IF (trans) THEN 736 CALL mp_bcast( done_irr(irr), ionode_id, intra_image_comm ) 737 CALL mp_bcast( dyn_rec, ionode_id, intra_image_comm ) 738 IF (zue) CALL mp_bcast( zstarue0_rec, ionode_id, intra_image_comm ) 739 ENDIF 740 741 RETURN 742 END SUBROUTINE read_partial_ph 743 744 SUBROUTINE read_el_phon(irr, ierr) 745 USE qpoint, ONLY : nksq, nksqtot 746 USE el_phon, ONLY : el_ph_mat_rec, el_ph_mat_rec_col, done_elph, elph 747 USE modes, ONLY : npert 748 USE wvfct, ONLY : nbnd 749 USE mp_pools, ONLY : npool 750 751 IMPLICIT NONE 752 INTEGER, INTENT(in) :: irr 753 INTEGER, INTENT(OUT) :: ierr 754 REAL(DP) :: xkdum(3) 755 INTEGER :: ik, np, np_, npe, idum 756 ! 757 ierr=0 758 IF (.NOT. elph) RETURN 759 npe=npert(irr) 760 761 IF (npool>1) THEN 762 ALLOCATE(el_ph_mat_rec_col(nbnd,nbnd,nksqtot,npe)) 763 ELSE 764 el_ph_mat_rec_col => el_ph_mat_rec 765 ENDIF 766 767 IF (ionode) THEN 768 CALL xmlr_opentag( "EL_PHON_HEADER") 769 CALL xmlr_readtag( "DONE_ELPH", done_elph(irr) ) 770 CALL xmlr_closetag( ) 771 CALL xmlr_opentag( "PARTIAL_EL_PHON" ) 772 CALL xmlr_readtag( "NUMBER_OF_K", idum ) 773 CALL xmlr_readtag( "NUMBER_OF_BANDS", idum ) 774 DO ik=1,nksqtot 775 CALL xmlr_opentag( "K_POINT." // i2c(ik) ) 776 CALL xmlr_readtag( "COORDINATES_XK", xkdum(:) ) 777 DO np = 1, npert(irr) 778 CALL xmlr_readtag( "PARTIAL_ELPH", el_ph_mat_rec_col(:,:,ik,np) ) 779 CALL get_attr("perturbation", np_) 780 END DO 781 CALL xmlr_closetag( ) 782 ENDDO 783 CALL xmlr_closetag( ) 784 ENDIF 785 786 CALL mp_bcast(done_elph(irr), ionode_id, intra_image_comm) 787 CALL mp_bcast(el_ph_mat_rec_col, ionode_id, intra_image_comm) 788 789 IF (npool > 1) THEN 790 CALL el_ph_distribute(npe,el_ph_mat_rec,el_ph_mat_rec_col,& 791 nksqtot,nksq) 792 DEALLOCATE(el_ph_mat_rec_col) 793 ENDIF 794 795 RETURN 796 END SUBROUTINE read_el_phon 797 ! 798 !--------------------------------------------------------------------------- 799 SUBROUTINE read_disp_pattern_only(iunpun, filename, current_iq, ierr) 800 !--------------------------------------------------------------------------- 801 !! 802 !! Wrapper routine used by EPW: open file, calls read_disp_pattern 803 !! 804 ! 805 IMPLICIT NONE 806 ! 807 INTEGER, INTENT(in) :: iunpun 808 !! Unit 809 INTEGER, INTENT(in) :: current_iq 810 !! Current q-point 811 CHARACTER(LEN=*), INTENT(in) :: filename 812 !! self-explanatory 813 INTEGER, INTENT(out) :: ierr 814 !! Error code 815 INTEGER :: iun 816 ! 817 iun = xml_openfile (filename) 818 IF ( iun == -1 ) then 819 ierr = 1 820 return 821 end if 822 CALL xmlr_opentag ( 'Root' ) 823 CALL read_disp_pattern(iun, current_iq, ierr) 824 CALL xmlr_closetag () ! Root 825 CALL xml_closefile () 826 ! 827 END SUBROUTINE read_disp_pattern_only 828 ! 829 !--------------------------------------------------------------------------- 830 SUBROUTINE read_disp_pattern(iunpun, current_iq, ierr) 831 !--------------------------------------------------------------------------- 832 !! 833 !! This routine reads the displacement patterns. 834 !! 835 USE modes, ONLY : nirr, npert, u, name_rap_mode, num_rap_mode 836 USE lr_symm_base, ONLY : minus_q, nsymq 837 USE io_global, ONLY : ionode, ionode_id 838 USE mp, ONLY : mp_bcast 839 ! 840 IMPLICIT NONE 841 ! 842 INTEGER, INTENT(in) :: current_iq 843 !! Current q-point 844 INTEGER, INTENT(in) :: iunpun 845 !! Current q-point 846 INTEGER, INTENT(out) :: ierr 847 !! Error 848 ! 849 ! Local variables 850 INTEGER :: imode0, imode 851 !! Counter on modes 852 INTEGER :: irr 853 !! Counter on irreducible representations 854 INTEGER :: ipert 855 !! Counter on perturbations at each irr 856 INTEGER :: iq 857 !! Current q-point 858 ! 859 ierr = 0 860 IF (ionode) THEN 861 CALL xmlr_opentag( "IRREPS_INFO" ) 862 CALL xmlr_readtag( "QPOINT_NUMBER",iq ) 863 ENDIF 864 CALL mp_bcast(iq, ionode_id, intra_image_comm) 865 IF (iq /= current_iq) CALL errore('read_disp_pattern', ' Problems with current_iq', 1) 866 ! 867 IF (ionode) THEN 868 ! 869 CALL xmlr_readtag( "QPOINT_GROUP_RANK", nsymq ) 870 CALL xmlr_readtag( "MINUS_Q_SYM", minus_q ) 871 CALL xmlr_readtag( "NUMBER_IRR_REP", nirr ) 872 imode0 = 0 873 DO irr = 1, nirr 874 CALL xmlr_opentag( "REPRESENTION."// i2c(irr) ) 875 CALL xmlr_readtag( "NUMBER_OF_PERTURBATIONS", npert(irr) ) 876 DO ipert = 1, npert(irr) 877 imode = imode0 + ipert 878 CALL xmlr_opentag( "PERTURBATION."// i2c(ipert) ) 879 ! not sure why these two lines break epw 880 !CALL xmlr_readtag( "SYMMETRY_TYPE_CODE", num_rap_mode(imode) ) 881 !CALL xmlr_readtag( "SYMMETRY_TYPE", name_rap_mode(imode) ) 882 CALL xmlr_readtag( "DISPLACEMENT_PATTERN", u(:,imode) ) 883 CALL xmlr_closetag( ) 884 ENDDO 885 imode0 = imode0 + npert(irr) 886 CALL xmlr_closetag( ) 887 ENDDO 888 ! 889 CALL xmlr_closetag( ) 890 ! 891 ENDIF 892 ! 893 CALL mp_bcast(nirr , ionode_id, intra_image_comm) 894 CALL mp_bcast(npert , ionode_id, intra_image_comm) 895 CALL mp_bcast(nsymq , ionode_id, intra_image_comm) 896 CALL mp_bcast(minus_q, ionode_id, intra_image_comm) 897 CALL mp_bcast(u , ionode_id, intra_image_comm) 898 !CALL mp_bcast(name_rap_mode, ionode_id, intra_image_comm) 899 !CALL mp_bcast(num_rap_mode, ionode_id, intra_image_comm) 900 ! 901 RETURN 902 ! 903 END SUBROUTINE read_disp_pattern 904 ! 905 !--------------------------------------------------------------------------- 906 SUBROUTINE read_tensors( ierr ) 907 !--------------------------------------------------------------------------- 908! 909! This routine reads the tensors that have been already calculated 910! 911 USE ions_base, ONLY : nat 912 USE control_ph, ONLY : done_epsil, done_start_zstar, done_zeu, done_zue 913 USE ramanm, ONLY : lraman, elop, ramtns, eloptns, done_lraman, done_elop 914 USE efield_mod, ONLY : zstareu, zstarue, zstarue0, zstareu0, epsilon 915 916 IMPLICIT NONE 917 918 INTEGER, INTENT(OUT) :: ierr 919 INTEGER :: imode0, imode, ipol, irr, ipert, iq, iu, na, na_ 920 ! 921 ierr=0 922 IF (ionode) THEN 923 CALL xmlr_opentag( "EF_TENSORS" ) 924 ! 925 CALL xmlr_readtag( "DONE_ELECTRIC_FIELD", done_epsil ) 926 CALL xmlr_readtag( "DONE_START_EFFECTIVE_CHARGE", done_start_zstar ) 927 CALL xmlr_readtag( "DONE_EFFECTIVE_CHARGE_EU", done_zeu ) 928 CALL xmlr_readtag( "DONE_EFFECTIVE_CHARGE_PH", done_zue ) 929 CALL xmlr_readtag( "DONE_RAMAN_TENSOR", done_lraman ) 930 CALL xmlr_readtag( "DONE_ELECTRO_OPTIC", done_elop ) 931 932 IF (done_epsil) & 933 CALL xmlr_readtag( "DIELECTRIC_CONSTANT",epsilon ) 934 IF (done_start_zstar) & 935 CALL xmlr_readtag( "START_EFFECTIVE_CHARGES",zstareu0 ) 936 IF (done_zeu) & 937 CALL xmlr_readtag( "EFFECTIVE_CHARGES_EU",zstareu ) 938 IF (done_lraman) THEN 939 DO na = 1, nat 940 CALL xmlr_readtag( "RAMAN_TNS",ramtns(:,:,:,na) ) 941 CALL get_attr("atom", na_) 942 END DO 943 END IF 944 IF (done_elop) CALL xmlr_readtag( "ELOP_TNS",eloptns ) 945 IF (done_zue) CALL xmlr_readtag( "EFFECTIVE_CHARGES_UE", zstarue ) 946 ! 947 CALL xmlr_closetag( ) 948 ! 949 ENDIF 950 951 CALL mp_bcast( done_epsil, ionode_id, intra_image_comm ) 952 CALL mp_bcast( done_start_zstar, ionode_id, intra_image_comm ) 953 CALL mp_bcast( done_zeu, ionode_id, intra_image_comm ) 954 CALL mp_bcast( done_zue, ionode_id, intra_image_comm ) 955 CALL mp_bcast( done_lraman, ionode_id, intra_image_comm ) 956 CALL mp_bcast( done_elop, ionode_id, intra_image_comm ) 957 IF (done_epsil) CALL mp_bcast( epsilon, ionode_id, intra_image_comm ) 958 IF (done_start_zstar) THEN 959 CALL mp_bcast( zstareu0, ionode_id, intra_image_comm ) 960 DO ipol=1,3 961 DO imode=1,3*nat 962 zstarue0(imode,ipol)=zstareu0(ipol,imode) 963 ENDDO 964 ENDDO 965 ENDIF 966 IF (done_zeu) CALL mp_bcast( zstareu, ionode_id, intra_image_comm ) 967 IF (done_zue) CALL mp_bcast( zstarue, ionode_id, intra_image_comm ) 968 IF (done_lraman) CALL mp_bcast( ramtns, ionode_id, intra_image_comm ) 969 IF (done_elop) CALL mp_bcast( eloptns, ionode_id, intra_image_comm ) 970 971 RETURN 972 END SUBROUTINE read_tensors 973 974 !---------------------------------------------------------------------------- 975 SUBROUTINE read_polarization( iu, ierr ) 976! 977! This routine reads the tensors that have been already calculated 978! 979 USE ions_base, ONLY : nat 980 USE freq_ph, ONLY : fpol, done_iu, fiu, polar 981 982 IMPLICIT NONE 983 984 INTEGER, INTENT(IN) :: iu 985 INTEGER, INTENT(OUT) :: ierr 986 ! 987 ierr=0 988 IF ( .NOT.fpol ) RETURN 989 IF (ionode) THEN 990 CALL xmlr_opentag( "POLARIZ_IU" ) 991 ! 992 CALL xmlr_readtag( "FREQUENCY_IN_RY", fiu(iu) ) 993 CALL xmlr_readtag( "CALCULATED_FREQUENCY", & 994 done_iu(iu)) 995 IF (done_iu(iu)) & 996 CALL xmlr_readtag( "POLARIZATION_IU", polar(:,:,iu) ) 997 ! 998 CALL xmlr_closetag( ) 999 ! 1000 ENDIF 1001 1002 CALL mp_bcast( fiu(iu), ionode_id, intra_image_comm ) 1003 CALL mp_bcast( done_iu(iu), ionode_id, intra_image_comm ) 1004 IF ( done_iu(iu) ) & 1005 CALL mp_bcast( polar(:,:,iu), ionode_id, intra_image_comm ) 1006 1007 RETURN 1008 END SUBROUTINE read_polarization 1009 1010 !---------------------------------------------------------------------------- 1011 SUBROUTINE check_directory_phsave( ) 1012 !---------------------------------------------------------------------------- 1013 ! ... 1014 ! ... This routine sets the situation of the grid according to 1015 ! ... the files that it finds on the directory .phsave. 1016 ! ... Check if representation files exist and which representations 1017 ! ... have been already calculated. 1018 ! ... set the initial information on the grid 1019 ! ... it sets done_irr_iq to .true. for the q and the 1020 ! ... representations that have already been done. 1021 ! ... Moreover it sets irr_iq, the number of representations for each q, 1022 ! ... nsymq_iq the size of the small group of each q and npert_irr_iq 1023 ! ... the number of perturbations for each irr and q. 1024 ! 1025 USE kinds, ONLY : DP 1026 USE disp, ONLY : nqs, done_iq 1027 USE grid_irr_iq, ONLY : comp_irr_iq, done_irr_iq, irr_iq, done_elph_iq 1028 USE control_ph, ONLY : trans, current_iq, low_directory_check 1029 USE el_phon, ONLY : elph 1030 ! 1031 IMPLICIT NONE 1032 ! 1033 CHARACTER(LEN=256) :: dirname, filename, filename1 1034 CHARACTER(LEN=256), EXTERNAL :: trimcheck 1035 INTEGER :: iunout, iq, irr, ierr 1036 CHARACTER(LEN=6), EXTERNAL :: int_to_char 1037 LOGICAL :: exst 1038 ! 1039 dirname = trimcheck ( TRIM( tmp_dir_ph ) // TRIM( prefix ) // '.phsave' ) 1040 ierr=0 1041 DO iq=1, nqs 1042 IF ( ionode ) THEN 1043 IF (trans.OR.elph) THEN 1044! 1045! NB: the representation 0 is the initial dynamical matrix calculated by 1046! dyn0. If it finds the file read the relevant information 1047! 1048 filename= TRIM( dirname ) // 'dynmat.' // & 1049 TRIM(int_to_char(iq)) // '.' 1050 1051 DO irr=0,irr_iq(iq) 1052 IF (comp_irr_iq(irr,iq).AND..NOT.low_directory_check) THEN 1053 filename1=TRIM(filename) // TRIM(int_to_char(irr)) // '.xml' 1054 INQUIRE(FILE=TRIM(filename1), EXIST=exst) 1055 IF (.NOT.exst) CYCLE 1056 iunout = xml_openfile( filename1 ) 1057 IF (iunout == -1 ) THEN 1058 ierr = 1 1059 GOTO 100 1060 end if 1061 CALL xmlr_opentag( "Root" ) 1062 CALL xmlr_opentag( "PM_HEADER" ) 1063 CALL xmlr_readtag( "DONE_IRR", done_irr_iq(irr,iq) ) 1064 CALL xmlr_closetag( ) ! PM_HEADER 1065 CALL xmlr_closetag( ) ! Root 1066 CALL xml_closefile( ) 1067 ENDIF 1068 END DO 1069! 1070! Check for the electron phonon files 1071! 1072 IF (elph) THEN 1073 filename= TRIM( dirname ) // 'elph.' // & 1074 TRIM(int_to_char(iq)) // '.' 1075 1076 DO irr=1,irr_iq(iq) 1077 IF (comp_irr_iq(irr,iq).OR..NOT.low_directory_check) THEN 1078 filename1=TRIM(filename) // TRIM(int_to_char(irr)) // '.xml' 1079 INQUIRE(FILE=TRIM(filename1), EXIST=exst) 1080 IF (.NOT.exst) CYCLE 1081 iunout = xml_openfile( filename1 ) 1082 IF (iunout == -1 ) THEN 1083 ierr = 1 1084 GOTO 100 1085 END IF 1086 CALL xmlr_opentag( "Root") 1087 CALL xmlr_opentag( "EL_PHON_HEADER") 1088 CALL xmlr_readtag( "DONE_ELPH", done_elph_iq(irr,iq)) 1089 CALL xmlr_closetag( ) ! EL_PHON_HEADER 1090 CALL xmlr_closetag( ) ! Root 1091 CALL xml_closefile( ) 1092 ENDIF 1093 ENDDO 1094 END IF 1095 END IF 1096 done_iq(iq)=.TRUE. 1097 DO irr=1,irr_iq(iq) 1098 IF (comp_irr_iq(irr,iq).AND..NOT.done_irr_iq(irr,iq)) & 1099 done_iq(iq)=.FALSE. 1100 IF (elph) THEN 1101 IF (comp_irr_iq(irr,iq).AND..NOT.done_elph_iq(irr,iq)) & 1102 done_iq(iq)=.FALSE. 1103 ENDIF 1104 ENDDO 1105 IF (comp_irr_iq(0,iq).AND..NOT.done_irr_iq(0,iq)) done_iq(iq)=.FALSE. 1106 END IF 1107 END DO 1108100 CALL mp_bcast( ierr, ionode_id, intra_image_comm ) 1109 IF (ierr /= 0) CALL errore('check_directory_phsave','opening file',1) 1110 ! 1111 CALL mp_bcast( done_iq, ionode_id, intra_image_comm ) 1112 CALL mp_bcast( done_irr_iq, ionode_id, intra_image_comm ) 1113 IF (elph) CALL mp_bcast( done_elph_iq, ionode_id, intra_image_comm ) 1114 ! 1115 RETURN 1116 ! 1117 END SUBROUTINE check_directory_phsave 1118 1119 !---------------------------------------------------------------------------- 1120 SUBROUTINE check_available_bands( ) 1121 !---------------------------------------------------------------------------- 1122 ! ... 1123 ! ... This routine checks which bands are available on disk and 1124 ! ... sets the array done_bands(iq) to .true. for each q point 1125 ! ... for which the bands are present. 1126 ! ... If lqdir is .false. only the bands corresponding to current_iq 1127 ! ... can be present, whereas if lqdir is .true. several q points 1128 ! ... might have calculated the bands and saved them on disk. 1129 ! 1130 USE kinds, ONLY : DP 1131 USE disp, ONLY : nqs, x_q, lgamma_iq 1132 USE io_files, ONLY : tmp_dir, postfix, xmlpun_schema 1133 USE control_ph, ONLY : tmp_dir_ph, lqdir, current_iq, newgrid 1134 USE grid_irr_iq, ONLY : done_bands 1135 ! 1136 IMPLICIT NONE 1137 ! 1138 CHARACTER(LEN=256) :: dirname, filename, dir_phq, tmp_dir_save 1139 CHARACTER(LEN=256), EXTERNAL :: trimcheck 1140 CHARACTER(LEN=6 ), EXTERNAL :: int_to_char 1141 INTEGER :: iq 1142 LOGICAL :: lgamma, exst, exst_restart, exst_recover 1143 ! 1144 ! We check if the xml data file (data-file-schema.xml) is present 1145 ! in the directory where it should be. If lqdir=.false. only the bands 1146 ! of current_iq might be present, otherwise we have to check all q points. 1147 ! If the file is present and there is a restart file, the bands are not 1148 ! done yet. 1149 ! For the gamma point done_bands might be false only with newgrid. 1150 ! 1151 done_bands=.FALSE. 1152 dirname = TRIM( tmp_dir_ph ) // TRIM( prefix ) // postfix 1153 tmp_dir_save=tmp_dir 1154 1155 DO iq=1, nqs 1156 IF ( iq == current_iq .OR. lqdir) THEN 1157 IF (lqdir .AND. .NOT. lgamma_iq(iq)) THEN 1158 dir_phq= trimcheck ( TRIM (tmp_dir_ph) // TRIM(prefix) // & 1159 & '.q_' // int_to_char(iq) ) 1160 dirname= TRIM (dir_phq) // TRIM(prefix) // postfix 1161 tmp_dir=dir_phq 1162 ELSE 1163 tmp_dir=tmp_dir_ph 1164 ENDIF 1165 ! 1166 filename=TRIM(dirname) // xmlpun_schema 1167 ! 1168 IF (ionode) inquire (file =TRIM(filename), exist = exst) 1169 ! 1170 CALL mp_bcast( exst, ionode_id, intra_image_comm ) 1171 ! 1172 exst_restart=.FALSE. 1173 IF (exst) CALL check_restart_recover(exst_recover, exst_restart) 1174 ! 1175 IF (exst.AND..NOT.exst_restart) done_bands(iq)=.TRUE. 1176 END IF 1177 IF (lgamma_iq(iq).AND..NOT.newgrid) done_bands(iq) = .TRUE. 1178 END DO 1179 tmp_dir=tmp_dir_save 1180 ! 1181 RETURN 1182 ! 1183 END SUBROUTINE check_available_bands 1184 1185 SUBROUTINE allocate_grid_variables() 1186! 1187! This routine allocates and initializes the grid variables when the 1188! nqs and x_q have been decided, either reading them from file when 1189! recover is .true. or recalculating them from scratch 1190! 1191 USE disp, ONLY : nqs, done_iq, comp_iq, omega_disp 1192 USE grid_irr_iq, ONLY : done_irr_iq, irr_iq, nsymq_iq, & 1193 comp_irr_iq, npert_irr_iq, done_bands, & 1194 done_elph_iq 1195 USE freq_ph, ONLY : done_iu, comp_iu, nfs 1196 USE ions_base, ONLY : nat 1197 USE el_phon, ONLY : elph_simple, gamma_disp, el_ph_nsigma 1198 USE control_ph, ONLY : qplot 1199 1200 IMPLICIT NONE 1201 1202 ALLOCATE(done_iq(nqs)) 1203 ALLOCATE(done_bands(nqs)) 1204 ALLOCATE(comp_iq(nqs)) 1205 ALLOCATE(irr_iq(nqs)) 1206 ALLOCATE(done_irr_iq(0:3*nat,nqs)) 1207 ALLOCATE(done_elph_iq(1:3*nat,nqs)) 1208 ALLOCATE(comp_irr_iq(0:3*nat,nqs)) 1209 ALLOCATE(nsymq_iq(nqs)) 1210 ALLOCATE(npert_irr_iq(3*nat,nqs)) 1211 1212 ALLOCATE(done_iu(nfs)) 1213 ALLOCATE(comp_iu(nfs)) 1214 1215 done_iq=.FALSE. 1216 done_bands=.FALSE. 1217 done_irr_iq=.FALSE. 1218 done_elph_iq=.FALSE. 1219 done_iu=.FALSE. 1220 1221 comp_iu=.TRUE. 1222 comp_iq=.TRUE. 1223 comp_irr_iq=.TRUE. 1224 1225 irr_iq=3*nat 1226 nsymq_iq=0 1227 npert_irr_iq=0 1228 1229 IF (qplot) THEN 1230 ALLOCATE(omega_disp(3*nat,nqs)) 1231 IF (elph_simple) ALLOCATE(gamma_disp(3*nat,el_ph_nsigma,nqs)) 1232 ENDIF 1233 1234 RETURN 1235 END SUBROUTINE allocate_grid_variables 1236 1237 SUBROUTINE destroy_status_run() 1238 USE start_k, ONLY : xk_start, wk_start 1239 USE disp, ONLY : nqs, x_q, done_iq, comp_iq, lgamma_iq, omega_disp 1240 USE grid_irr_iq, ONLY : done_irr_iq, irr_iq, nsymq_iq, & 1241 npert_irr_iq, comp_irr_iq, done_bands, done_elph_iq 1242 USE el_phon, ONLY : gamma_disp 1243 USE freq_ph, ONLY : comp_iu, done_iu, fiu 1244 IMPLICIT NONE 1245 1246 IF (ALLOCATED(x_q)) DEALLOCATE(x_q) 1247 IF (ALLOCATED(lgamma_iq)) DEALLOCATE(lgamma_iq) 1248 IF (ALLOCATED(done_bands)) DEALLOCATE(done_bands) 1249 IF (ALLOCATED(done_iq)) DEALLOCATE(done_iq) 1250 IF (ALLOCATED(comp_iq)) DEALLOCATE(comp_iq) 1251 IF (ALLOCATED(irr_iq)) DEALLOCATE(irr_iq) 1252 IF (ALLOCATED(done_irr_iq)) DEALLOCATE(done_irr_iq) 1253 IF (ALLOCATED(done_elph_iq)) DEALLOCATE(done_elph_iq) 1254 IF (ALLOCATED(comp_irr_iq)) DEALLOCATE(comp_irr_iq) 1255 IF (ALLOCATED(nsymq_iq)) DEALLOCATE(nsymq_iq) 1256 IF (ALLOCATED(npert_irr_iq)) DEALLOCATE(npert_irr_iq) 1257 IF (ALLOCATED(fiu)) DEALLOCATE(fiu) 1258 IF (ALLOCATED(done_iu)) DEALLOCATE(done_iu) 1259 IF (ALLOCATED(comp_iu)) DEALLOCATE(comp_iu) 1260 IF (ALLOCATED(omega_disp)) DEALLOCATE(omega_disp) 1261 IF (ALLOCATED(gamma_disp)) DEALLOCATE(gamma_disp) 1262! 1263! Note that these two variables are allocated by read_file. 1264! They cannot be deallocated by clean_pw because the starting xk and wk 1265! points must be known at each q point. 1266! The logic of these two variables must be improved. 1267! 1268 IF (ALLOCATED( xk_start )) DEALLOCATE( xk_start ) 1269 IF (ALLOCATED( wk_start )) DEALLOCATE( wk_start ) 1270 1271 END SUBROUTINE destroy_status_run 1272 1273 SUBROUTINE ph_restart_set_filename( what, irr, current_iq, iflag, ierr) 1274! 1275! This subroutine sets the filename for each action required by what 1276! and opens the appropriate file for reading or writing 1277! 1278 USE io_global, ONLY : ionode, ionode_id 1279 USE io_files, ONLY : create_directory, xmlpun_schema 1280 USE freq_ph, ONLY : fpol 1281 USE mp_images, ONLY : intra_image_comm 1282 USE mp, ONLY : mp_bcast 1283 1284 IMPLICIT NONE 1285 INTEGER, INTENT(IN) :: irr, current_iq, iflag 1286 INTEGER, INTENT(OUT) :: ierr 1287 CHARACTER(LEN=*), INTENT(IN) :: what 1288 1289 CHARACTER(LEN=256) :: dirname, filename 1290 CHARACTER(LEN=256), EXTERNAL :: trimcheck 1291 CHARACTER(LEN=6 ), EXTERNAL :: int_to_char 1292 LOGICAL :: exst 1293 1294 ierr=0 1295 ! 1296 dirname = trimcheck ( TRIM( tmp_dir_ph ) // TRIM( prefix ) // '.phsave' ) 1297 ! 1298 ! ... create the main restart directory 1299 ! 1300 IF (ionode) inquire (file = TRIM(dirname) // xmlpun_schema, exist = exst) 1301 CALL mp_bcast( exst, ionode_id, intra_image_comm ) 1302 ! 1303 IF (.NOT. exst) CALL create_directory( dirname ) 1304 ! 1305 ! ... open the ph_recover file 1306 ! 1307 IF ( ionode ) THEN 1308 ! 1309 ! ... open XML descriptor 1310 ! 1311 ierr=0 1312 IF (what=='init') THEN 1313 filename = TRIM( dirname ) // 'control_ph.xml' 1314 ELSEIF (what=='status_ph') THEN 1315 filename=TRIM( dirname ) //'status_run.xml' 1316 ELSEIF (what=='data_u') THEN 1317 filename= TRIM( dirname ) // 'patterns.' // & 1318 TRIM(int_to_char(current_iq)) // '.xml' 1319 ELSEIF (what=='data_dyn') THEN 1320 filename= TRIM( dirname ) // 'dynmat.' // & 1321 TRIM(int_to_char(current_iq)) // '.' // & 1322 TRIM(int_to_char(irr)) // '.xml' 1323 ELSEIF (what=='tensors') THEN 1324 filename= TRIM( dirname ) // 'tensors.xml' 1325 ELSEIF (what=='polarization') THEN 1326 IF (.NOT. fpol) RETURN 1327 filename= TRIM( dirname ) // 'polarization.'// & 1328 TRIM(int_to_char(irr)) // '.xml' 1329 ELSEIF (what=='el_phon') THEN 1330 filename= TRIM( dirname ) // 'elph.' // & 1331 TRIM(int_to_char(current_iq)) // '.' // & 1332 TRIM(int_to_char(irr)) // '.xml' 1333 ELSE 1334 CALL errore( 'ph_restart_set_filename ', & 1335 'no filename', 1 ) 1336 ENDIF 1337 ! 1338 IF (iflag/=1) THEN 1339 INQUIRE( FILE=TRIM(filename), EXIST=exst ) 1340 IF (.NOT.exst) GOTO 100 1341 ENDIF 1342 1343 iunpun = xml_openfile( filename ) 1344 ! 1345 exst = (iunpun /= -1) 1346 IF (.NOT.exst) GOTO 100 1347 ! 1348 IF ( iflag == 1 ) THEN 1349 call add_attr( 'version','1.0') 1350 call add_attr( 'encoding','UTF-8') 1351 CALL xmlw_writetag ( 'xml', '?' ) 1352 CALL xmlw_opentag ( 'Root' ) 1353 ELSE 1354 CALL xmlr_opentag ( 'Root' ) 1355 END IF 1356 ! 1357 END IF 1358100 CALL mp_bcast( exst, ionode_id, intra_image_comm ) 1359 ! 1360 ! If the file does not exist and we must read from it, we return with 1361 ! or if it cannot be opened, we return with an error message. 1362 ! 1363 IF (.NOT.exst) THEN 1364 CALL infomsg( 'ph_restart_set_filename ', & 1365 'cannot open file for reading or writing' ) 1366 ierr=100 1367 ENDIF 1368 ! 1369 END SUBROUTINE ph_restart_set_filename 1370 ! 1371END MODULE ph_restart 1372