From d3b31c3cc3c14502360fe584d89722836d62ec88 Mon Sep 17 00:00:00 2001 From: dalcorso Date: Wed, 23 Jul 2008 08:46:48 +0000 Subject: [PATCH] A tentative to improve the phonon recover. Introduced four new input variables: start_q, last_q Makes the phonon calculation for a subset of the q points. From start_q to last_q. start_irr, last_irr Makes the phonon calculation for a subset of the irreducible representations. Removed the input variable maxirr. Starting k points now written in the punch file. git-svn-id: http://qeforge.qe-forge.org/svn/q-e/trunk/espresso@5066 c92efa57-630b-4861-b058-cf58834340f0 --- Modules/xml_io_base.f90 | 93 ++++- PH/Makefile | 4 + PH/addnlcc.f90 | 3 +- PH/allocate_part.f90 | 5 +- PH/allocate_phq.f90 | 2 + PH/bcast_ph_input.f90 | 8 +- PH/check_restart_recover.f90 | 37 ++ PH/deallocate_part.f90 | 1 - PH/deallocate_phq.f90 | 5 + PH/drhodv.f90 | 1 + PH/drhodvus.f90 | 6 +- PH/dynmat0.f90 | 6 +- PH/dynmatrix.f90 | 18 +- PH/make.depend | 34 +- PH/ph_restart.f90 | 717 +++++++++++++++++++++++++++++++++++ PH/phcom.f90 | 26 +- PH/phonon.f90 | 261 ++++++------- PH/phq_readin.f90 | 39 +- PH/phq_recover.f90 | 109 +++--- PH/phq_setup.f90 | 197 ++++++---- PH/phq_summary.f90 | 18 +- PH/phqscf.f90 | 18 +- PH/raman.f90 | 2 +- PH/save_ph_input.f90 | 84 ++++ PH/set_irr.f90 | 114 +++--- PH/solve_e.f90 | 40 +- PH/solve_e2.f90 | 34 +- PH/solve_e_fpol.f90 | 4 +- PH/solve_linter.f90 | 105 ++--- PH/write_rec.f90 | 54 +++ PW/pw_restart.f90 | 34 +- PW/pwcom.f90 | 16 + PW/set_defaults_pw.f90 | 9 + PW/setup.f90 | 11 + doc-def/INPUT_PH.def | 84 +++- 35 files changed, 1668 insertions(+), 531 deletions(-) create mode 100644 PH/check_restart_recover.f90 create mode 100644 PH/ph_restart.f90 create mode 100644 PH/save_ph_input.f90 create mode 100644 PH/write_rec.f90 diff --git a/Modules/xml_io_base.f90 b/Modules/xml_io_base.f90 index 6ae902fea..c8d826337 100644 --- a/Modules/xml_io_base.f90 +++ b/Modules/xml_io_base.f90 @@ -45,7 +45,8 @@ MODULE xml_io_base restart_dir, check_restartfile, check_file_exst, & pp_check_file, save_history, save_print_counter, & read_print_counter, set_kpoints_vars, & - write_header, write_control, & + write_header, write_control, write_control_ph, & + write_status_ph, write_q, & write_cell, write_ions, write_symmetry, write_planewaves, & write_efield, write_spin, write_magnetization, write_xc, & write_occ, write_bz, & @@ -65,6 +66,7 @@ MODULE xml_io_base CHARACTER(LEN=*), INTENT(IN) :: dirname ! INTEGER :: ierr + INTEGER(i4b), EXTERNAL :: c_mkdir CHARACTER(LEN=6), EXTERNAL :: int_to_char ! @@ -695,6 +697,49 @@ MODULE xml_io_base ! END SUBROUTINE write_control ! + + SUBROUTINE write_control_ph( ldisp, lnscf, epsil, trans, elph, zue, & + lraman, elop ) + !------------------------------------------------------------------------ + ! + IMPLICIT NONE + LOGICAL, INTENT(IN) :: ldisp, lnscf, epsil, trans, elph, zue, & + lraman, elop + + + CALL iotk_write_begin( iunpun, "CONTROL" ) + ! + CALL iotk_write_dat( iunpun, "DISPERSION_RUN", ldisp ) + CALL iotk_write_dat( iunpun, "BANDS_REQUIRED", lnscf ) + CALL iotk_write_dat( iunpun, "ELECTRIC_FIELD", epsil ) + CALL iotk_write_dat( iunpun, "PHONON_RUN", trans ) + CALL iotk_write_dat( iunpun, "ELECTRON_PHONON", elph ) + CALL iotk_write_dat( iunpun, "EFFECTIVE_CHARGE_PH", zue ) + CALL iotk_write_dat( iunpun, "RAMAN_TENSOR", lraman ) + CALL iotk_write_dat( iunpun, "ELECTRO_OPTIC", elop ) + ! + CALL iotk_write_end( iunpun, "CONTROL" ) + ! + RETURN + END SUBROUTINE write_control_ph + + SUBROUTINE write_status_ph(current_iq, xml_not_of_pw, done_bands) + !------------------------------------------------------------------------ + ! + IMPLICIT NONE + INTEGER, INTENT(IN) :: current_iq + LOGICAL, INTENT(IN) :: xml_not_of_pw, done_bands + + CALL iotk_write_begin( iunpun, "STATUS_PH" ) + ! + CALL iotk_write_dat( iunpun, "XML_NOT_OF_PW", xml_not_of_pw ) + CALL iotk_write_dat( iunpun, "DONE_BANDS", done_bands ) + CALL iotk_write_dat( iunpun, "CURRENT_Q", current_iq ) + ! + CALL iotk_write_end( iunpun, "STATUS_PH" ) + ! + RETURN + END SUBROUTINE write_status_ph ! !------------------------------------------------------------------------ SUBROUTINE write_cell( ibrav, symm_type, & @@ -1237,11 +1282,14 @@ MODULE xml_io_base END SUBROUTINE write_occ ! !------------------------------------------------------------------------ - SUBROUTINE write_bz( num_k_points, xk, wk, k1, k2, k3, nk1, nk2, nk3 ) + SUBROUTINE write_bz( num_k_points, xk, wk, k1, k2, k3, nk1, nk2, nk3, & + nks_start, xk_start, wk_start) !------------------------------------------------------------------------ ! - INTEGER, INTENT(IN) :: num_k_points, k1, k2, k3, nk1, nk2, nk3 + INTEGER, INTENT(IN) :: num_k_points, k1, k2, k3, nk1, nk2, nk3 REAL(DP), INTENT(IN) :: xk(:,:), wk(:) + INTEGER, INTENT(IN), OPTIONAL :: nks_start + REAL(DP), INTENT(IN), OPTIONAL :: xk_start(:,:), wk_start(:) ! INTEGER :: ik ! @@ -1273,6 +1321,21 @@ MODULE xml_io_base ! END DO ! + IF (present(nks_start).and.present(xk_start).and.present(wk_start)) THEN + CALL iotk_write_dat( iunpun, "STARTING_K-POINTS", nks_start ) + ! + DO ik = 1, nks_start + ! + CALL iotk_write_attr( attr, "XYZ", xk_start(:,ik), FIRST = .TRUE. ) + ! + CALL iotk_write_attr( attr, "WEIGHT", wk_start(ik) ) + ! + CALL iotk_write_empty( iunpun, "K-POINT_START" // & + & TRIM( iotk_index(ik) ), attr ) + ! + END DO + ENDIF + ! CALL iotk_write_end( iunpun, "BRILLOUIN_ZONE" ) ! END SUBROUTINE write_bz @@ -1297,6 +1360,30 @@ MODULE xml_io_base CALL iotk_write_end( iunpun, "PHONON" ) ! END SUBROUTINE write_phonon + + SUBROUTINE write_q( nqs, x_q, done_iq ) + !------------------------------------------------------------------------ + ! + INTEGER, INTENT(IN) :: nqs + REAL(DP), INTENT(IN) :: x_q(3,nqs) + INTEGER, INTENT(IN) :: done_iq(nqs) + ! + CALL iotk_write_begin( iunpun, "Q_POINTS" ) + ! + CALL iotk_write_dat( iunpun, "NUMBER_OF_Q_POINTS", nqs ) + ! + CALL iotk_write_attr( attr, "UNITS", "2 pi / a", FIRST = .TRUE. ) + ! + CALL iotk_write_empty( iunpun, "UNITS_FOR_Q-POINT", attr ) + ! + CALL iotk_write_dat( iunpun, "Q-POINT_COORDINATES", x_q(:,:), COLUMNS=3 ) + ! + CALL iotk_write_dat( iunpun, "Q-POINT_DONE", done_iq(:) ) + ! + CALL iotk_write_end( iunpun, "Q_POINTS" ) + ! + RETURN + END SUBROUTINE write_q ! ! ... methods to write and read charge_density ! diff --git a/PH/Makefile b/PH/Makefile index 6610187d2..142ff022d 100644 --- a/PH/Makefile +++ b/PH/Makefile @@ -26,6 +26,7 @@ cg_psi.o \ ccg_psi.o \ cgsolve_all.o \ ch_psi_all.o \ +check_restart_recover.o \ cch_psi_all.o \ clinear.o \ close_phq.o \ @@ -79,6 +80,7 @@ localdos.o \ newdq.o \ openfilq.o \ phcom.o \ +ph_restart.o \ phq_init.o \ phq_readin.o \ phq_recover.o \ @@ -98,6 +100,7 @@ q_points.o \ q2qstar_ph.o \ random_matrix.o \ rotate_and_add_dyn.o \ +save_ph_input.o \ set_asr_c.o \ set_drhoc.o \ set_int12_nc.o \ @@ -134,6 +137,7 @@ xk_wk_collect.o \ write_dyn_on_file.o \ write_epsilon_and_zeu.o \ write_matrix.o \ +write_rec.o \ zstar_eu.o \ zstar_eu_us.o diff --git a/PH/addnlcc.f90 b/PH/addnlcc.f90 index 591f4a356..e385a69da 100644 --- a/PH/addnlcc.f90 +++ b/PH/addnlcc.f90 @@ -26,7 +26,7 @@ subroutine addnlcc (imode0, drhoscf, npe) integer :: imode0, npe ! input: the starting mode ! input: the number of perturbations - ! input: the change of density due to perturbatio + ! input: the change of density due to perturbation complex(DP) :: drhoscf (nrxx, nspin, npertx) @@ -117,6 +117,7 @@ subroutine addnlcc (imode0, drhoscf, npe) call mp_sum ( dyn1, intra_pool_comm ) #endif dyn (:,:) = dyn(:,:) + dyn1(:,:) + dyn_rec(:,:)=dyn_rec(:,:)+dyn1(:,:) deallocate (dvaux) deallocate (drhoc) return diff --git a/PH/allocate_part.f90 b/PH/allocate_part.f90 index 9b5e17edf..18e949f16 100644 --- a/PH/allocate_part.f90 +++ b/PH/allocate_part.f90 @@ -24,9 +24,8 @@ implicit none ! ! allocate space for several arrays which control the run ! -allocate (comp_irr ( 3 * nat)) -allocate (ifat ( nat)) -allocate (done_irr ( 3 * nat)) +allocate (comp_irr ( 0:3 * nat)) +allocate (done_irr ( 0:3 * nat)) allocate (list ( 3 * nat)) allocate (atomo ( nat)) return diff --git a/PH/allocate_phq.f90 b/PH/allocate_phq.f90 index 6a1cf4c50..be789145a 100644 --- a/PH/allocate_phq.f90 +++ b/PH/allocate_phq.f90 @@ -55,6 +55,7 @@ subroutine allocate_phq allocate (u ( 3 * nat, 3 * nat)) allocate (ubar ( 3 * nat)) allocate (dyn ( 3 * nat, 3 * nat)) + allocate (dyn_rec ( 3 * nat, 3 * nat)) allocate (dyn00 ( 3 * nat, 3 * nat)) allocate (w2 ( 3 * nat)) allocate (t (max_irr_dim, max_irr_dim, 48,3 * nat)) @@ -64,6 +65,7 @@ subroutine allocate_phq allocate (zstareu0 (3, 3 * nat)) allocate (zstarue (3 , nat, 3)) allocate (zstarue0 (3 * nat, 3)) + zstarue0=(0.0_DP,0.0_DP) if (okvan) then allocate (int1 ( nhm, nhm, 3, nat, nspin)) allocate (int2 ( nhm , nhm , 3 , nat , nat)) diff --git a/PH/bcast_ph_input.f90 b/PH/bcast_ph_input.f90 index b5572ff5a..0f0b6c338 100644 --- a/PH/bcast_ph_input.f90 +++ b/PH/bcast_ph_input.f90 @@ -9,7 +9,7 @@ subroutine bcast_ph_input ( ) !----------------------------------------------------------------------- ! - ! In this routine the first processor sends the input to all + ! In this routine the first processor sends the phonon input to all ! the other processors ! ! @@ -40,6 +40,7 @@ subroutine bcast_ph_input ( ) call mp_bcast (ldisp, ionode_id) call mp_bcast (lraman, ionode_id) call mp_bcast (elop, ionode_id) + call mp_bcast (fpol, ionode_id) call mp_bcast (recover, ionode_id) call mp_bcast (asr, ionode_id) call mp_bcast (lrpa, ionode_id) @@ -47,9 +48,12 @@ subroutine bcast_ph_input ( ) ! ! integers ! + call mp_bcast (start_irr, ionode_id) + call mp_bcast (last_irr, ionode_id) + call mp_bcast (start_q, ionode_id) + call mp_bcast (last_q, ionode_id) call mp_bcast (niter_ph, ionode_id) call mp_bcast (nmix_ph, ionode_id) - call mp_bcast (maxirr, ionode_id) call mp_bcast (iverbosity, ionode_id) call mp_bcast (modenum, ionode_id) ! diff --git a/PH/check_restart_recover.f90 b/PH/check_restart_recover.f90 new file mode 100644 index 000000000..96edc37b1 --- /dev/null +++ b/PH/check_restart_recover.f90 @@ -0,0 +1,37 @@ +! +! Copyright (C) 2008 Quantum-ESPRESSO group +! This file is distributed under the terms of the +! GNU General Public License. See the file `License' +! in the root directory of the present distribution, +! or http://www.gnu.org/copyleft/gpl.txt . +! +SUBROUTINE check_restart_recover(iq_start,start_q,current_iq) +IMPLICIT NONE +INTEGER, INTENT(IN) :: start_q, current_iq +INTEGER, INTENT(OUT) :: iq_start +INTEGER :: iunrec, iunres +LOGICAL :: exst, exst1 + +iunrec = 99 +iunres = 98 +CALL seqopn (iunrec, 'recover', 'unformatted', exst) +CALL seqopn( iunres, 'restart', 'UNFORMATTED', exst1 ) +IF (.not.exst.and..not.exst1) THEN + close (unit = iunrec, status = 'delete') + close (unit = iunres, status = 'delete') + iq_start=start_q +ELSE + IF (exst) THEN + close (unit = iunrec, status = 'keep') + ELSE + close (unit = iunrec, status = 'delete') + ENDIF + IF (exst1) THEN + close (unit = iunres, status = 'keep') + ELSE + close (unit = iunres, status = 'delete') + ENDIF + iq_start=current_iq +ENDIF +RETURN +END SUBROUTINE check_restart_recover diff --git a/PH/deallocate_part.f90 b/PH/deallocate_part.f90 index d5b7d9a5d..847ecddc9 100644 --- a/PH/deallocate_part.f90 +++ b/PH/deallocate_part.f90 @@ -12,7 +12,6 @@ subroutine deallocate_part() use phcom if (allocated(comp_irr)) deallocate (comp_irr) - if (allocated(ifat)) deallocate (ifat) if (allocated(done_irr)) deallocate (done_irr) if (allocated(list)) deallocate (list) if (allocated(atomo)) deallocate (atomo) diff --git a/PH/deallocate_phq.f90 b/PH/deallocate_phq.f90 index 5dc91e33d..39d6253ce 100644 --- a/PH/deallocate_phq.f90 +++ b/PH/deallocate_phq.f90 @@ -38,6 +38,7 @@ subroutine deallocate_phq if(associated(u)) deallocate (u) if(associated(ubar)) deallocate (ubar) if(allocated(dyn)) deallocate (dyn) + if(allocated(dyn_rec)) deallocate (dyn_rec) if(allocated(dyn00)) deallocate (dyn00) if(allocated(w2)) deallocate (w2) if(associated(t)) deallocate (t) @@ -90,6 +91,10 @@ subroutine deallocate_phq if(allocated(vsgga)) deallocate (vsgga) if(allocated(gmag)) deallocate (gmag) + IF (allocated(has_equivalent)) DEALLOCATE(has_equivalent) + IF (allocated(with_symmetry)) DEALLOCATE(with_symmetry) + IF (allocated(n_equiv_atoms)) DEALLOCATE(n_equiv_atoms) + IF (allocated(equiv_atoms)) DEALLOCATE(equiv_atoms) return end subroutine deallocate_phq diff --git a/PH/drhodv.f90 b/PH/drhodv.f90 index 7ce6c5491..69cd854ec 100644 --- a/PH/drhodv.f90 +++ b/PH/drhodv.f90 @@ -145,6 +145,7 @@ subroutine drhodv (nu_i0, nper, drhoscf) ! call tra_write_matrix('drhodv wdyn',wdyn,u,nat) dyn (:,:) = dyn (:,:) + wdyn (:,:) + dyn_rec(:,:) = dyn_rec(:,:) + wdyn(:,:) deallocate (aux) IF (noncolin) THEN diff --git a/PH/drhodvus.f90 b/PH/drhodvus.f90 index 3a492d1fc..aa3a0b0fb 100644 --- a/PH/drhodvus.f90 +++ b/PH/drhodvus.f90 @@ -46,7 +46,10 @@ subroutine drhodvus (irr, imode0, dvscfin, npe) ! the change of the charge complex(DP), external :: ZDOTC - if (.not.okvan) return + if (.not.okvan) then + dyn_rec=(0.0_DP,0.0_DP) + return + endif nspin0=nspin if (nspin==4.and..not.domag) nspin0=1 call start_clock ('drhodvus') @@ -85,6 +88,7 @@ subroutine drhodvus (irr, imode0, dvscfin, npe) ! call tra_write_matrix('drhodvus dyn',dyn,u,nat) ! call stop_ph(.true.) dyn (:,:) = dyn (:,:) + dyn1 (:,:) + dyn_rec(:,:) = dyn1(:,:) call stop_clock ('drhodvus') return diff --git a/PH/dynmat0.f90 b/PH/dynmat0.f90 index 59f9bf762..4dc76e6e8 100644 --- a/PH/dynmat0.f90 +++ b/PH/dynmat0.f90 @@ -25,6 +25,7 @@ subroutine dynmat0 USE symme, ONLY: irt, s USE control_flags, ONLY : modenum USE kinds, ONLY : DP + USE ph_restart, ONLY : ph_writefile use phcom implicit none @@ -75,9 +76,12 @@ subroutine dynmat0 dyn (nu_i, nu_j) = wrk enddo enddo - call ZCOPY (9 * nat * nat, dyn, 1, dyn00, 1) endif ! call tra_write_matrix('dynmat0 dyn',dyn,u,nat) + dyn_rec(:,:)=dyn(:,:) + done_irr(0)=1 + CALL ph_writefile('data_dyn',0) + call stop_clock ('dynmat0') return end subroutine dynmat0 diff --git a/PH/dynmatrix.f90 b/PH/dynmatrix.f90 index 1c61acba6..43318cff9 100644 --- a/PH/dynmatrix.f90 +++ b/PH/dynmatrix.f90 @@ -1,5 +1,5 @@ ! -! Copyright (C) 2001 PWSCF group +! Copyright (C) 2001-2008 QUANTUM-ESPRESSO group ! This file is distributed under the terms of the ! GNU General Public License. See the file `License' ! in the root directory of the present distribution, @@ -86,6 +86,7 @@ subroutine dynmatrix endif enddo endif + ! ! Symmetrizes the dynamical matrix w.r.t. the small group of q ! @@ -108,6 +109,21 @@ subroutine dynmatrix enddo call stop_ph (.true.) endif + + DO irr=0,nirr + IF (done_irr(irr)==0.and..not.ldisp) THEN + WRITE(stdout,& + '(/,5x,"Stopping because representation", i5, " is not done")') irr + CALL close_phq(.TRUE.) + CALL stop_ph(.TRUE.) + ENDIF + IF (done_irr(irr)==0.and.ldisp) THEN + WRITE(stdout, '(/5x,"Not diagonalizing because representation", & + & i5, " is not done")') irr + DEALLOCATE ( irt_, rtau_ ) + RETURN + ENDIF + ENDDO ! ! Generates the star of q ! diff --git a/PH/make.depend b/PH/make.depend index b41858964..6f90d6e23 100644 --- a/PH/make.depend +++ b/PH/make.depend @@ -117,7 +117,6 @@ bcast_ph_input.o : phcom.o bcast_ph_input.o : ramanm.o bcast_ph_input1.o : ../Modules/io_global.o bcast_ph_input1.o : ../Modules/mp.o -bcast_ph_input1.o : ../PW/pwcom.o bcast_ph_input1.o : phcom.o ccg_psi.o : ../Modules/kind.o cch_psi_all.o : ../Modules/kind.o @@ -363,6 +362,7 @@ dynmat0.o : ../Modules/control_flags.o dynmat0.o : ../Modules/ions_base.o dynmat0.o : ../Modules/kind.o dynmat0.o : ../PW/pwcom.o +dynmat0.o : ph_restart.o dynmat0.o : phcom.o dynmat_us.o : ../Modules/cell_base.o dynmat_us.o : ../Modules/constants.o @@ -527,20 +527,33 @@ pcgreen.o : ../Modules/mp_global.o pcgreen.o : ../Modules/wavefunctions.o pcgreen.o : ../PW/pwcom.o pcgreen.o : phcom.o +ph_restart.o : ../Modules/io_files.o +ph_restart.o : ../Modules/io_global.o +ph_restart.o : ../Modules/kind.o +ph_restart.o : ../Modules/mp.o +ph_restart.o : ../Modules/mp_global.o +ph_restart.o : ../Modules/parser.o +ph_restart.o : ../Modules/version.o +ph_restart.o : ../Modules/xml_io_base.o +ph_restart.o : ../iotk/src/iotk_module.o +ph_restart.o : phcom.o +ph_restart.o : ramanm.o phcom.o : ../Modules/kind.o phcom.o : ../Modules/parameters.o phonon.o : ../Modules/check_stop.o phonon.o : ../Modules/control_flags.o +phonon.o : ../Modules/input_parameters.o phonon.o : ../Modules/io_files.o phonon.o : ../Modules/io_global.o phonon.o : ../Modules/ions_base.o phonon.o : ../Modules/kind.o -phonon.o : ../Modules/mp.o phonon.o : ../Modules/version.o phonon.o : ../PW/noncol.o phonon.o : ../PW/pwcom.o +phonon.o : ph_restart.o phonon.o : phcom.o phonon.o : ramanm.o +phonon.o : save_ph_input.o phq_init.o : ../Modules/atom.o phq_init.o : ../Modules/constants.o phq_init.o : ../Modules/io_files.o @@ -573,11 +586,9 @@ phq_readin.o : ../PW/pwcom.o phq_readin.o : phcom.o phq_readin.o : ramanm.o phq_recover.o : ../Modules/io_global.o -phq_recover.o : ../Modules/ions_base.o phq_recover.o : ../Modules/kind.o -phq_recover.o : ../Modules/uspp.o +phq_recover.o : ph_restart.o phq_recover.o : phcom.o -phq_recover.o : ramanm.o phq_setup.o : ../Modules/cell_base.o phq_setup.o : ../Modules/constants.o phq_setup.o : ../Modules/control_flags.o @@ -591,7 +602,9 @@ phq_setup.o : ../Modules/uspp.o phq_setup.o : ../PW/noncol.o phq_setup.o : ../PW/pwcom.o phq_setup.o : ../PW/scf_mod.o +phq_setup.o : ph_restart.o phq_setup.o : phcom.o +phq_setup.o : ramanm.o phq_summary.o : ../Modules/cell_base.o phq_summary.o : ../Modules/constants.o phq_summary.o : ../Modules/control_flags.o @@ -694,6 +707,9 @@ rigid.o : ../Modules/constants.o rigid.o : ../Modules/kind.o rotate_and_add_dyn.o : ../Modules/constants.o rotate_and_add_dyn.o : ../Modules/kind.o +save_ph_input.o : ../Modules/ions_base.o +save_ph_input.o : ../Modules/kind.o +save_ph_input.o : phcom.o set_asr_c.o : ../Modules/kind.o set_drhoc.o : ../Modules/atom.o set_drhoc.o : ../Modules/cell_base.o @@ -786,7 +802,6 @@ solve_linter.o : ../PW/becmod.o solve_linter.o : ../PW/noncol.o solve_linter.o : ../PW/pwcom.o solve_linter.o : phcom.o -solve_linter.o : ramanm.o star_q.o : ../Modules/io_global.o star_q.o : ../Modules/kind.o star_q.o : ../PW/noncol.o @@ -878,6 +893,11 @@ write_ramtns.o : ../Modules/cell_base.o write_ramtns.o : ../Modules/constants.o write_ramtns.o : ../Modules/ions_base.o write_ramtns.o : ../Modules/kind.o +write_rec.o : ../Modules/kind.o +write_rec.o : ../Modules/uspp.o +write_rec.o : ../PW/pwcom.o +write_rec.o : ph_restart.o +write_rec.o : phcom.o xk_wk_collect.o : ../Modules/io_global.o xk_wk_collect.o : ../Modules/kind.o xk_wk_collect.o : ../Modules/mp.o @@ -972,6 +992,7 @@ localdos.o : ../include/f_defs.h matdyn.o : ../include/f_defs.h newdq.o : ../include/f_defs.h pcgreen.o : ../include/f_defs.h +ph_restart.o : ../include/f_defs.h phq_init.o : ../include/f_defs.h phq_readin.o : ../include/f_defs.h phq_recover.o : ../include/f_defs.h @@ -994,6 +1015,7 @@ raman_mat.o : ../include/f_defs.h random_matrix.o : ../include/f_defs.h rigid.o : ../include/f_defs.h rotate_and_add_dyn.o : ../include/f_defs.h +save_ph_input.o : ../include/f_defs.h set_asr_c.o : ../include/f_defs.h set_drhoc.o : ../include/f_defs.h set_dvscf.o : ../include/f_defs.h diff --git a/PH/ph_restart.f90 b/PH/ph_restart.f90 new file mode 100644 index 000000000..0fe4199ff --- /dev/null +++ b/PH/ph_restart.f90 @@ -0,0 +1,717 @@ +! +! Copyright (C) 2008 Quantum-ESPRESSO group +! This file is distributed under the terms of the +! GNU General Public License. See the file `License' +! in the root directory of the present distribution, +! or http://www.gnu.org/copyleft/gpl.txt . +! +#include "f_defs.h" +! +!---------------------------------------------------------------------------- +MODULE ph_restart + !---------------------------------------------------------------------------- + ! + ! ... this module contains methods to read and write data saved by the + ! phonon code to restart smoothly + ! + USE iotk_module + ! + USE kinds, ONLY : DP + USE io_files, ONLY : tmp_dir, prefix, iunpun, xmlpun, & + qexml_version, qexml_version_init + USE io_global, ONLY : ionode, ionode_id + USE mp_global, ONLY : intra_image_comm + USE mp, ONLY : mp_bcast + ! + IMPLICIT NONE + ! + SAVE + ! + PRIVATE + ! + PUBLIC :: ph_writefile, ph_readfile + ! + INTEGER, PRIVATE :: iunout + ! + LOGICAL :: lheader = .FALSE., & + lstatus_read = .FALSE., & + lcontrol_ph_read = .FALSE., & + lq_read = .FALSE., & + lu_read = .FALSE., & + lpartial_dyn_read = .FALSE. + ! + ! variables to describe qexml current version + ! and back compatibility + ! + LOGICAL :: qexml_version_before_1_4_0 = .FALSE. + ! + ! + CONTAINS + ! + !------------------------------------------------------------------------ + SUBROUTINE ph_writefile( what, irr ) + !------------------------------------------------------------------------ + ! + USE global_version, ONLY : version_number + USE control_ph, ONLY : current_iq, xml_not_of_pw, done_bands, & + ldisp, lnscf, epsil, trans, elph, zue + USE ramanm, ONLY : lraman, elop + USE disp, ONLY : nqs, x_q, done_iq + USE xml_io_base, ONLY : write_header, write_status_ph, & + write_control_ph, write_q, create_directory + ! + IMPLICIT NONE + ! + CHARACTER(LEN=*), INTENT(IN) :: what + INTEGER, INTENT(IN) :: irr + ! + CHARACTER(LEN=256) :: dirname, filename + INTEGER :: ierr + CHARACTER(LEN=6), EXTERNAL :: int_to_char + ! + IF ( ionode ) THEN + ! + ! ... look for an empty unit (only ionode needs it) + ! + CALL iotk_free_unit( iunpun, ierr ) + ! + END IF + ! + CALL mp_bcast( ierr, ionode_id, intra_image_comm ) + ! + CALL errore( 'ph_writefile ', & + 'no free units to write ', ierr ) + ! + dirname = TRIM( tmp_dir ) // TRIM( prefix ) // '.phsave' + ! + ! ... create the main restart directory + ! + CALL create_directory( dirname ) + ! + ! ... open the ph_recover file + ! + IF ( ionode ) THEN + ! + ! ... open XML descriptor + ! + ierr=0 + IF (what=='init') THEN + CALL iotk_open_write( iunpun, FILE = TRIM( dirname ) // '/' // & + & TRIM( xmlpun ), BINARY = .FALSE., IERR = ierr ) + ELSEIF (what=='data' .OR. what=='data_dyn') THEN + filename= TRIM( dirname ) // '/' // & + & TRIM( xmlpun ) // '.' // TRIM(int_to_char(current_iq)) + IF (what=='data') & + CALL iotk_open_write( iunpun, FILE = TRIM( filename ), & + BINARY = .FALSE., IERR = ierr ) + ELSE + CALL errore('ph_writefile','unknown what',1) + ENDIF + ! + END IF + ! + CALL mp_bcast( ierr, ionode_id, intra_image_comm ) + ! + CALL errore( 'ph_writefile ', & + 'cannot open xml_recover file for writing', ierr ) + ! + IF ( ionode ) THEN + ! + ! ... here we start writing the ph-punch-file + ! +!------------------------------------------------------------------------------- +! ... HEADER +!------------------------------------------------------------------------------- + ! + IF (what=='init') THEN + ! + CALL write_header( "PH", TRIM(version_number) ) + ! +!------------------------------------------------------------------------------- +! ... STATUS +!------------------------------------------------------------------------------- + CALL write_status_ph(current_iq, xml_not_of_pw, done_bands) +!------------------------------------------------------------------------------- +! ... CONTROL +!------------------------------------------------------------------------------- + ! + CALL write_control_ph( ldisp, lnscf, epsil, trans, elph, zue, & + lraman, elop ) + ! +!------------------------------------------------------------------------------- +! ... Q AND K POINTS +!------------------------------------------------------------------------------ + ! + CALL write_q( nqs, x_q, done_iq ) + ! + CALL iotk_close_write( iunpun ) + ELSEIF (what=='data') THEN + ! +!------------------------------------------------------------------------------- +! ... PARTIAL ITEMS +!------------------------------------------------------------------------------- + ! + CALL write_partial_ph() + ! + ! + CALL iotk_close_write( iunpun ) + ELSEIF (what=='data_dyn') THEN + + CALL write_ph_dyn(filename,irr) + + END IF + + END IF + + + RETURN + ! + CONTAINS + + SUBROUTINE write_partial_ph() + USE modes, ONLY : nirr, npert, u + USE partial, ONLY : done_irr + USE control_ph, ONLY : current_iq, epsil, trans, elph, zue, lgamma,& + where_rec, rec_code + USE ramanm, ONLY : lraman, elop, ramtns, eloptns + USE efield_mod, ONLY : zstareu, zstarue0, epsilon + + IMPLICIT NONE + INTEGER :: imode0, imode, irr, ipert, iq, iunout + CHARACTER(LEN=256) :: filename, filename1 + + CALL iotk_write_begin( iunpun, "PARTIAL_PH" ) + ! + CALL iotk_write_dat(iunpun,"STOPPED_IN",where_rec) + ! + CALL iotk_write_dat(iunpun,"RECOVER_CODE",rec_code) + ! + CALL iotk_write_dat(iunpun,"QPOINT_NUMBER",current_iq) + ! + IF (trans) THEN + ! + CALL iotk_write_dat(iunpun,"NUMBER_IRR_REP",nirr) + ! + imode0=0 + DO irr=1,nirr + CALL iotk_write_dat(iunpun,"NUMBER_OF_PERTURBATIONS",& + npert(irr)) + DO ipert=1,npert(irr) + imode=imode0+ipert + CALL iotk_write_dat(iunpun,"DISPLACEMENT_PATTERN",& + u(:,imode)) + ENDDO + imode0=imode0+npert(irr) + ENDDO + ENDIF + IF (epsil.AND.lgamma) THEN + CALL iotk_write_dat(iunpun,"DIELECTRIC_CONSTANT",epsilon) + CALL iotk_write_dat(iunpun,"EFFECTIVE_CHARGES_EU",zstareu) + ENDIF + IF (zue.AND.lgamma) & + CALL iotk_write_dat(iunpun,"EFFECTIVE_CHARGES_UE",zstarue0) + IF (lraman.AND.lgamma) & + CALL iotk_write_dat(iunpun,"RAMAN_TNS",ramtns) + IF (elop.AND.lgamma) & + CALL iotk_write_dat(iunpun,"ELOP_TNS",eloptns) + ! + CALL iotk_write_end(iunpun, "PARTIAL_PH" ) + RETURN + END SUBROUTINE write_partial_ph + + SUBROUTINE write_ph_dyn(filename, irr) + USE partial, ONLY : done_irr + USE dynmat, ONLY : dyn_rec + USE control_ph, ONLY : trans + + IMPLICIT NONE + INTEGER :: irr, iunout + CHARACTER(LEN=256) :: filename, filename1 + CHARACTER(LEN=6), EXTERNAL :: int_to_char + + IF (trans) THEN + IF (done_irr(irr)) THEN + ! + CALL iotk_free_unit( iunout, ierr ) + ! + filename1= TRIM(filename) // "." // TRIM(int_to_char(irr)) + ! + CALL iotk_open_write(iunout, FILE = TRIM(filename1), & + BINARY = .FALSE., IERR = ierr ) + + CALL iotk_write_begin(iunout, "PARTIAL_MATRIX") + CALL iotk_write_dat(iunout, "DONE_IRR", done_irr(irr)) + CALL iotk_write_dat(iunout, "PARTIAL_DYN", dyn_rec(:,:)) + CALL iotk_write_end(iunout, "PARTIAL_MATRIX") + CALL iotk_close_write(iunout) + ENDIF + ENDIF + RETURN + END SUBROUTINE write_ph_dyn + + END SUBROUTINE ph_writefile + ! + ! + !------------------------------------------------------------------------ + SUBROUTINE ph_readfile( what, ierr ) + !------------------------------------------------------------------------ + ! + IMPLICIT NONE + ! + CHARACTER(LEN=*), INTENT(IN) :: what + INTEGER, INTENT(OUT) :: ierr + ! + CHARACTER(LEN=256) :: dirname + ! + ierr = 0 + ! + dirname = TRIM( tmp_dir ) // TRIM( prefix ) // '.phsave' + ! + ! ... look for an empty unit + ! + IF (ionode) THEN + CALL iotk_free_unit( iunout, ierr ) + ENDIF + CALL mp_bcast(ierr,ionode_id,intra_image_comm) + ! + CALL errore( 'ph_readfile', & + 'no free units to read wavefunctions', ierr ) + ! + lheader = .FALSE. + lstatus_read = .FALSE. + lcontrol_ph_read = .FALSE. + lq_read = .FALSE. + lpartial_dyn_read = .FALSE. + lu_read = .FALSE. + ! + SELECT CASE( what ) + CASE( 'init' ) + ! + lheader = .TRUE. + lstatus_read=.TRUE. + lq_read=.TRUE. + lcontrol_ph_read=.TRUE. + ! + CASE( 'data' ) + ! + lpartial_dyn_read = .TRUE. + ! + CASE( 'data_u' ) + ! + lu_read = .TRUE. + ! + CASE( 'reset' ) + ! + lheader = .FALSE. + lstatus_read = .FALSE. + lcontrol_ph_read = .FALSE. + lq_read = .FALSE. + lpartial_dyn_read = .FALSE. + lu_read = .FALSE. + ! + RETURN + ! + END SELECT + ! + IF ( lheader ) THEN + ! + CALL read_header( dirname, ierr ) + IF (ierr /= 0 ) RETURN + ! + ENDIF + IF ( lstatus_read ) THEN + ! + CALL read_status_ph( dirname, ierr ) + IF ( ierr /= 0 ) RETURN + ! + END IF + IF ( lcontrol_ph_read ) THEN + ! + CALL read_control_ph( dirname, ierr ) + IF ( ierr /= 0 ) RETURN + ! + END IF + IF ( lq_read ) THEN + ! + CALL read_q( dirname, ierr ) + IF ( ierr /= 0 ) RETURN + ! + END IF + IF ( lpartial_dyn_read ) THEN + ! + CALL read_partial_ph( dirname, ierr ) + IF ( ierr /= 0 ) RETURN + ! + END IF + IF ( lu_read ) THEN + ! + CALL read_u( dirname, ierr ) + IF ( ierr /= 0 ) RETURN + ! + END IF + ! + RETURN + ! + END SUBROUTINE ph_readfile + ! + !------------------------------------------------------------------------ + SUBROUTINE read_header( dirname, ierr ) + !------------------------------------------------------------------------ + ! + ! ... this routine reads the format version of the current xml datafile + ! + USE parser, ONLY : version_compare + USE xml_io_base + IMPLICIT NONE + ! + CHARACTER(LEN=*), INTENT(IN) :: dirname + INTEGER, INTENT(OUT) :: ierr + + ierr = 0 + IF ( qexml_version_init ) RETURN + ! + IF ( ionode ) & + CALL iotk_open_read( iunpun, FILE = TRIM( dirname ) // '/' // & + & TRIM( xmlpun ), IERR = ierr ) + ! + CALL mp_bcast( ierr, ionode_id, intra_image_comm ) + ! + IF ( ierr /=0 ) RETURN + ! + IF ( ionode ) THEN + ! + CALL iotk_scan_begin( iunpun, "HEADER" ) + ! + CALL iotk_scan_empty( iunpun, "FORMAT", ATTR=attr ) + ! + CALL iotk_scan_attr( attr, "VERSION", qexml_version ) + ! + qexml_version_init = .TRUE. + ! + CALL iotk_scan_end( iunpun, "HEADER" ) + ! + ! + CALL iotk_close_read( iunpun ) + ! + ENDIF + ! + CALL mp_bcast( qexml_version, ionode_id, intra_image_comm ) + CALL mp_bcast( qexml_version_init, ionode_id, intra_image_comm ) + + ! + ! init logical variables for versioning + ! + qexml_version_before_1_4_0 = .FALSE. + ! + IF ( TRIM( version_compare( qexml_version, "1.4.0" )) == "older" ) & + qexml_version_before_1_4_0 = .TRUE. + ! + RETURN + END SUBROUTINE read_header + !------------------------------------------------------------------------ + SUBROUTINE read_status_ph( dirname, ierr ) + !------------------------------------------------------------------------ + ! + USE control_ph, ONLY : current_iq, xml_not_of_pw, done_bands + ! + IMPLICIT NONE + ! + CHARACTER(LEN=*), INTENT(IN) :: dirname + INTEGER, INTENT(OUT) :: ierr + ! + ! + IF ( ionode ) THEN + ! + CALL iotk_open_read( iunpun, FILE = TRIM( dirname ) // '/' // & + & TRIM( xmlpun ), IERR = ierr ) + ! + END IF + ! + CALL mp_bcast( ierr, ionode_id, intra_image_comm ) + ! + IF ( ierr > 0 ) RETURN + ! + ! ... then selected tags are read from the other sections + ! + IF ( ionode ) THEN + ! + CALL iotk_scan_begin( iunpun, "STATUS_PH" ) + ! + CALL iotk_scan_dat( iunpun, "XML_NOT_OF_PW", xml_not_of_pw ) + ! + CALL iotk_scan_dat( iunpun, "DONE_BANDS", done_bands ) + ! + CALL iotk_scan_dat( iunpun, "CURRENT_Q", current_iq ) + ! + CALL iotk_scan_end( iunpun, "STATUS_PH" ) + ! + CALL iotk_close_read( iunpun ) + END IF + ! + CALL mp_bcast( xml_not_of_pw, ionode_id, intra_image_comm ) + CALL mp_bcast( done_bands, ionode_id, intra_image_comm ) + CALL mp_bcast( current_iq, ionode_id, intra_image_comm ) + ! + RETURN + ! + END SUBROUTINE read_status_ph + ! + !------------------------------------------------------------------------ + SUBROUTINE read_control_ph( dirname, ierr ) + !------------------------------------------------------------------------ + USE control_ph, ONLY : ldisp, lnscf, epsil, trans, elph, zue + USE ramanm, ONLY : lraman, elop + + ! + IMPLICIT NONE + ! + CHARACTER(LEN=*), INTENT(IN) :: dirname + INTEGER, INTENT(OUT) :: ierr + ! + IF ( ionode ) THEN + ! + CALL iotk_open_read( iunpun, FILE = TRIM( dirname ) // '/' // & + & TRIM( xmlpun ), IERR = ierr ) + ! + END IF + ! + CALL mp_bcast( ierr, ionode_id, intra_image_comm ) + ! + IF ( ierr > 0 ) RETURN + ! + IF ( ionode ) THEN + CALL iotk_scan_begin( iunpun, "CONTROL" ) + ! + CALL iotk_scan_dat( iunpun, "DISPERSION_RUN", ldisp ) + CALL iotk_scan_dat( iunpun, "BANDS_REQUIRED", lnscf ) + CALL iotk_scan_dat( iunpun, "ELECTRIC_FIELD", epsil ) + CALL iotk_scan_dat( iunpun, "PHONON_RUN", trans ) + CALL iotk_scan_dat( iunpun, "ELECTRON_PHONON", elph ) + CALL iotk_scan_dat( iunpun, "EFFECTIVE_CHARGE_PH", zue ) + CALL iotk_scan_dat( iunpun, "RAMAN_TENSOR", lraman ) + CALL iotk_scan_dat( iunpun, "ELECTRO_OPTIC", elop ) + ! + CALL iotk_scan_end( iunpun, "CONTROL" ) + ! + CALL iotk_close_read( iunpun ) + END IF + CALL mp_bcast( ldisp, ionode_id, intra_image_comm ) + CALL mp_bcast( lnscf, ionode_id, intra_image_comm ) + CALL mp_bcast( epsil, ionode_id, intra_image_comm ) + CALL mp_bcast( trans, ionode_id, intra_image_comm ) + CALL mp_bcast( elph, ionode_id, intra_image_comm ) + CALL mp_bcast( zue, ionode_id, intra_image_comm ) + CALL mp_bcast( lraman, ionode_id, intra_image_comm ) + CALL mp_bcast( elop, ionode_id, intra_image_comm ) + + ! + RETURN + ! + END SUBROUTINE read_control_ph + ! + !------------------------------------------------------------------------ + SUBROUTINE read_q( dirname, ierr ) + !------------------------------------------------------------------------ + ! + USE disp, ONLY : nqs, x_q, done_iq + ! + IMPLICIT NONE + ! + CHARACTER(LEN=*), INTENT(IN) :: dirname + INTEGER, INTENT(OUT) :: ierr + ! + IF ( ionode ) THEN + ! + CALL iotk_open_read( iunpun, FILE = TRIM( dirname ) // '/' // & + & TRIM( xmlpun ), IERR = ierr ) + ! + END IF + ! + CALL mp_bcast( ierr, ionode_id, intra_image_comm ) + ! + IF ( ierr > 0 ) RETURN + ! + IF (ionode) THEN + CALL iotk_scan_begin( iunpun, "Q_POINTS" ) + ! + CALL iotk_scan_dat( iunpun, "NUMBER_OF_Q_POINTS", nqs ) + ! + ALLOCATE(x_q(3,nqs)) + ALLOCATE(done_iq(nqs)) + CALL iotk_scan_dat( iunpun, "Q-POINT_COORDINATES", x_q(1:3,1:nqs) ) + ! + CALL iotk_scan_dat( iunpun, "Q-POINT_DONE", done_iq(1:nqs) ) + ! + CALL iotk_scan_end( iunpun, "Q_POINTS" ) + ! + CALL iotk_close_read( iunpun ) + ENDIF + + CALL mp_bcast( nqs, ionode_id, intra_image_comm ) + + IF (.NOT. ionode) THEN + ALLOCATE(x_q(3,nqs)) + ALLOCATE(done_iq(nqs)) + ENDIF + + CALL mp_bcast( x_q, ionode_id, intra_image_comm ) + CALL mp_bcast( done_iq, ionode_id, intra_image_comm ) + + RETURN + ! + END SUBROUTINE read_q + + SUBROUTINE read_partial_ph( dirname, ierr ) + + USE modes, ONLY : nirr + USE partial, ONLY : done_irr + USE disp, ONLY : done_iq + USE dynmat, ONLY : dyn_rec, dyn + USE control_ph, ONLY : current_iq, trans + + IMPLICIT NONE + + CHARACTER(LEN=*), INTENT(IN) :: dirname + INTEGER, INTENT(OUT) :: ierr + INTEGER :: irr, iunout + + CHARACTER(LEN=256) :: filename, filename1 + CHARACTER(LEN=6), EXTERNAL :: int_to_char + + IF ( ionode ) THEN + ! + filename= TRIM( dirname ) // '/' // & + & TRIM( xmlpun ) // '.' // TRIM(int_to_char(current_iq)) + + CALL iotk_open_read( iunpun, FILE = TRIM( filename ), IERR = ierr ) + ! + END IF + ! + CALL mp_bcast( ierr, ionode_id, intra_image_comm ) + ! + IF ( ierr > 0 ) RETURN + ! + IF (ionode) THEN + IF (trans) THEN + done_irr=0 + dyn=(0.0_DP,0.0_DP) + dyn_rec=(0.0_DP,0.0_DP) + DO irr=0,nirr + CALL iotk_free_unit( iunout, ierr ) + filename1=TRIM(filename) // "." // TRIM(int_to_char(irr)) + CALL iotk_open_read(iunout, FILE = TRIM(filename1), & + BINARY = .FALSE., IERR = ierr ) + + IF (ierr == 0 ) then + CALL iotk_scan_begin( iunout, "PARTIAL_MATRIX" ) + CALL iotk_scan_dat(iunout,"DONE_IRR",done_irr(irr)) + CALL iotk_scan_dat(iunout,"PARTIAL_DYN",& + dyn_rec(:,:)) + dyn(:,:)=dyn(:,:) + dyn_rec(:,:) + CALL iotk_scan_end( iunout, "PARTIAL_MATRIX" ) + CALL iotk_close_read( iunout ) + ELSE + done_iq(current_iq)=0 + ierr=0 + END IF + ENDDO + ENDIF + ENDIF + IF (trans) THEN + CALL mp_bcast( done_irr, ionode_id, intra_image_comm ) + CALL mp_bcast( dyn_rec, ionode_id, intra_image_comm ) + CALL mp_bcast( dyn, ionode_id, intra_image_comm ) + ENDIF + + RETURN + END SUBROUTINE read_partial_ph + + SUBROUTINE read_u( dirname, ierr ) + + USE modes, ONLY : nirr, npert, u + USE control_ph, ONLY : current_iq, epsil, trans, elph, zue, lgamma, & + where_rec, rec_code + USE ramanm, ONLY : lraman, elop, ramtns, eloptns + USE efield_mod, ONLY : zstareu, zstarue0, epsilon + + IMPLICIT NONE + + CHARACTER(LEN=*), INTENT(IN) :: dirname + INTEGER, INTENT(OUT) :: ierr + INTEGER :: imode0, imode, irr, ipert, iq, iunout + + CHARACTER(LEN=256) :: filename, filename1 + CHARACTER(LEN=6), EXTERNAL :: int_to_char + + IF ( ionode ) THEN + ! + filename= TRIM( dirname ) // '/' // & + & TRIM( xmlpun ) // '.' // TRIM(int_to_char(current_iq)) + + CALL iotk_open_read( iunpun, FILE = TRIM( filename ), IERR = ierr ) + ! + END IF + ! + CALL mp_bcast( ierr, ionode_id, intra_image_comm ) + ! + IF ( ierr > 0 ) RETURN + ! + IF (ionode) THEN + CALL iotk_scan_begin( iunpun, "PARTIAL_PH" ) + ! + CALL iotk_scan_dat(iunpun,"STOPPED_IN",where_rec) + ! + CALL iotk_scan_dat(iunpun,"RECOVER_CODE",rec_code) + ! + CALL iotk_scan_dat(iunpun,"QPOINT_NUMBER",iq) + IF (iq /= current_iq) CALL errore('read_partial_ph', & + 'problems with current_iq', 1 ) + IF (trans) THEN + CALL iotk_scan_dat(iunpun,"NUMBER_IRR_REP",nirr) + imode0=0 + DO irr=0,nirr + IF (irr > 0) THEN + CALL iotk_scan_dat(iunpun,"NUMBER_OF_PERTURBATIONS", npert(irr)) + DO ipert=1,npert(irr) + imode=imode0+ipert + CALL iotk_scan_dat(iunpun,"DISPLACEMENT_PATTERN",u(:,imode)) + ENDDO + imode0=imode0+npert(irr) + ENDIF + ENDDO + ENDIF + IF (epsil.and.lgamma) THEN + CALL iotk_scan_dat(iunpun,"DIELECTRIC_CONSTANT",epsilon) + CALL iotk_scan_dat(iunpun,"EFFECTIVE_CHARGES_EU",zstareu) + ENDIF + IF (zue.and.lgamma) & + CALL iotk_scan_dat(iunpun,"EFFECTIVE_CHARGES_UE",zstarue0) + IF (lraman.and.lgamma) & + CALL iotk_scan_dat(iunpun,"RAMAN_TNS",ramtns) + IF (elop) & + CALL iotk_scan_dat(iunpun,"ELOP_TNS",eloptns) + CALL iotk_scan_end( iunpun, "PARTIAL_PH" ) + ! + CALL iotk_close_read( iunpun ) + ENDIF + + CALL mp_bcast( where_rec, ionode_id, intra_image_comm ) + CALL mp_bcast( rec_code, ionode_id, intra_image_comm ) + IF (trans) THEN + CALL mp_bcast( nirr, ionode_id, intra_image_comm ) + CALL mp_bcast( npert, ionode_id, intra_image_comm ) + CALL mp_bcast( u, ionode_id, intra_image_comm ) + ENDIF + + IF (epsil.and.lgamma) THEN + CALL mp_bcast( epsilon, ionode_id, intra_image_comm ) + CALL mp_bcast( zstareu, ionode_id, intra_image_comm ) + ENDIF + IF (zue.and.lgamma) CALL mp_bcast( zstarue0, ionode_id, intra_image_comm ) + IF (lraman.and.lgamma) CALL mp_bcast( ramtns, ionode_id, intra_image_comm ) + IF (elop.and.lgamma) CALL mp_bcast( eloptns, ionode_id, intra_image_comm ) + + RETURN + END SUBROUTINE read_u + ! +END MODULE ph_restart diff --git a/PH/phcom.f90 b/PH/phcom.f90 index 5fd0a4176..bd6fba53a 100644 --- a/PH/phcom.f90 +++ b/PH/phcom.f90 @@ -59,9 +59,11 @@ MODULE dynmat ! COMPLEX (DP), ALLOCATABLE :: & dyn00(:,:), &! 3 * nat, 3 * nat), - dyn(:,:) ! 3 * nat, 3 * nat) + dyn(:,:), &! 3 * nat, 3 * nat) + dyn_rec(:,:) ! 3 * nat, 3 * nat) ! the initial dynamical matrix ! the dynamical matrix + ! the contribution of each representation to the dynamical matrix REAL (DP), ALLOCATABLE :: & w2(:) ! 3 * nat) ! omega^2 @@ -229,15 +231,13 @@ MODULE partial ! INTEGER, ALLOCATABLE :: & comp_irr(:), &! 3 * nat ), - ifat(:), &! nat), done_irr(:), &! 3 * nat), & list(:), &! 3 * nat), atomo(:) ! nat) ! if 1 this representation has to be computed - ! if 1 this matrix element is computed ! if 1 this representation has been done - ! a list of representations - ! which atom + ! a list of representations (optionally read in input) + ! list of the atoms that moves INTEGER :: nat_todo, nrapp ! number of atoms to compute ! The representation to do @@ -249,6 +249,7 @@ END MODULE partial MODULE gamma_gamma INTEGER, ALLOCATABLE :: & has_equivalent(:), & ! 0 if the atom has to be calculated + with_symmetry(:), & ! calculated by symmetry n_equiv_atoms(:), & ! number of equivalent atoms equiv_atoms(:,:) ! which atoms are equivalent @@ -269,18 +270,24 @@ MODULE control_ph ! INTEGER, PARAMETER :: maxter = 100 ! maximum number of iterations - INTEGER :: niter_ph, nmix_ph, nbnd_occ(npk), irr0, maxirr + INTEGER :: niter_ph, nmix_ph, nbnd_occ(npk), & + start_irr, last_irr, current_iq, start_q, last_q ! maximum number of iterations (read from input) ! mixing type ! occupated bands in metals ! starting representation - ! maximum number of representation + ! initial representation + ! last representation of this run + ! current q point + ! initial q in the list, last_q in the list real(DP) :: tr2_ph ! threshold for phonon calculation REAL (DP) :: alpha_mix(maxter), time_now, alpha_pv ! the mixing parameter ! CPU time up to now ! the alpha value for shifting the bands + CHARACTER(LEN=10) :: where_rec='no_recover'! where the ph run recovered + INTEGER :: rec_code ! code for recover LOGICAL :: lgamma, &! if .TRUE. this is a q=0 computation lgamma_gamma,&! if .TRUE. this is a q=0 computation with k=0 only convt, &! if .TRUE. the phonon has converged @@ -295,7 +302,9 @@ MODULE control_ph search_sym, &! if .TRUE. search the mode symmetry lnscf, &! if .TRUE. the run makes first a nscf calculation ldisp, &! if .TRUE. the run calculates full phonon dispersion - reduce_io ! if .TRUE. reduces needed I/O + reduce_io, &! if .TRUE. reduces needed I/O + done_bands, &! if .TRUE. the bands have been calculated + xml_not_of_pw ! if .TRUE. the xml file has been written by ph. ! END MODULE control_ph ! @@ -383,6 +392,7 @@ MODULE disp ! number of q points to be calculated REAL (DP), ALLOCATABLE :: x_q(:,:) ! coordinates of the q points + INTEGER, ALLOCATABLE :: done_iq(:) ! END MODULE disp ! diff --git a/PH/phonon.f90 b/PH/phonon.f90 index aa956a5dd..5d41d42f2 100644 --- a/PH/phonon.f90 +++ b/PH/phonon.f90 @@ -16,42 +16,43 @@ PROGRAM phonon ! ... charges are computed. ! USE kinds, ONLY : DP - USE io_global, ONLY : stdout, ionode, ionode_id - USE control_flags, ONLY : gamma_only - USE klist, ONLY : xk, wk, xqq, lgauss, nks, nkstot + USE io_global, ONLY : stdout, ionode + USE control_flags, ONLY : conv_ions + USE klist, ONLY : xqq, lgauss, nks USE basis, ONLY : startingwfc, startingpot, startingconfig USE force_mod, ONLY : force - USE io_files, ONLY : prefix, tmp_dir, nd_nmbr, delete_if_present - USE mp, ONLY : mp_bcast + USE io_files, ONLY : prefix, tmp_dir, nd_nmbr + USE input_parameters, ONLY: pseudo_dir USE ions_base, ONLY : nat - USE lsda_mod, ONLY : nspin USE noncollin_module, ONLY : noncolin - USE gvect, ONLY : nrx1, nrx2, nrx3 - USE control_flags, ONLY : restart, lphonon, tr2, ethr, imix, nmix, & - mixing_beta, lscf, lbands, david, isolve + USE start_k, ONLY : xk_start, wk_start, nks_start + USE control_flags, ONLY : restart, lphonon, tr2, ethr, & + mixing_beta, david, isolve USE qpoint, ONLY : xq, nksq - USE disp, ONLY : nqs, x_q, iq1, iq2, iq3 + USE modes, ONLY : nirr + USE partial, ONLY : done_irr, comp_irr + USE disp, ONLY : nqs, x_q, done_iq USE control_ph, ONLY : ldisp, lnscf, lgamma, lgamma_gamma, convt, & - epsil, trans, elph, zue, recover, maxirr, irr0, & - lnoloc, lrpa + epsil, trans, elph, zue, recover, rec_code, & + lnoloc, lrpa, done_bands, xml_not_of_pw, & + start_q,last_q,start_irr,last_irr,current_iq,& + reduce_io USE freq_ph USE output, ONLY : fildyn, fildrho USE global_version, ONLY : version_number USE ramanm, ONLY : lraman, elop USE check_stop, ONLY : check_stop_init + USE ph_restart, ONLY : ph_readfile, ph_writefile + USE save_ph, ONLY : save_ph_input_variables, & + restore_ph_input_variables, clean_input_variables ! IMPLICIT NONE ! - INTEGER :: iq, iq_start, iustat, ierr, iu - INTEGER :: nks_start - ! number of initial k points - REAL(DP), ALLOCATABLE :: wk_start(:) - ! initial weight of k points - REAL(DP), ALLOCATABLE :: xk_start(:,:) - ! initial coordinates of k points - LOGICAL :: exst + INTEGER :: iq, iq_start, ierr, iu + INTEGER :: irr + LOGICAL :: exst, do_band CHARACTER (LEN=9) :: code = 'PHONON' - CHARACTER (LEN=256) :: auxdyn, filname, filint + CHARACTER (LEN=256) :: auxdyn CHARACTER(LEN=6), EXTERNAL :: int_to_char ! #if defined __INTEL @@ -64,8 +65,6 @@ PROGRAM phonon ! CALL start_clock( 'PHONON' ) ! - gamma_only = .FALSE. - ! CALL startup( nd_nmbr, code, version_number ) ! WRITE( stdout, '(/5x,"Ultrasoft (Vanderbilt) Pseudopotentials")' ) @@ -74,116 +73,86 @@ PROGRAM phonon ! CALL phq_readin() ! + CALL save_ph_input_variables() + ! CALL check_stop_init() ! ! ... Checking the status of the calculation ! - iustat = 98 - ! - IF ( ionode ) THEN + IF (recover) THEN + CALL ph_readfile('init',ierr) + CALL check_restart_recover(iq_start,start_q,current_iq) + IF ( .NOT.(ldisp .OR. lnscf )) THEN + last_q=1 + ELSEIF (ierr == 0) THEN + IF (last_q<1.OR.last_q>nqs) last_q=nqs + IF (ldisp) auxdyn = fildyn + ENDIF + IF (ierr /= 0) recover=.FALSE. + ELSE + ierr=1 + ENDIF + IF (ierr /= 0) THEN ! - CALL seqopn( iustat, 'stat', 'FORMATTED', exst ) + ! recover file not found or not looked for ! - IF ( exst ) THEN + done_bands=.FALSE. + xml_not_of_pw=.FALSE. + iq_start=start_q + IF (ldisp) THEN ! - READ( UNIT = iustat, FMT = *, IOSTAT = ierr ) iq_start + ! ... Calculate the q-points for the dispersion ! - IF ( ierr /= 0 ) THEN - ! - iq_start = 1 - ! - ELSE IF ( iq_start > 0 ) THEN - ! - WRITE( UNIT = stdout, FMT = "(/,5X,'starting from an old run')") - ! - WRITE( UNIT = stdout, & - FMT = "(5X,'Doing now the calculation ', & - & 'for q point nr ',I3)" ) iq_start - ! - ELSE - ! - iq_start = 1 - ! - END IF + CALL q_points() + ! + ! ... Store the name of the matdyn file in auxdyn + ! + auxdyn = fildyn + ! + ! ... do always a non-scf calculation + ! + lnscf = .TRUE. + ! + IF (last_q<1.or.last_q>nqs) last_q=nqs + ! + ALLOCATE(done_iq(nqs)) + done_iq=0 + ! + ELSE IF ( lnscf ) THEN + ! + ! ... xq is the q-point for phonon calculation (read from input) + ! ... xqq is the q-point for the nscf calculation (read from data file) + ! ... if the nscf calculation is to be performed, discard the latter + ! + xqq = xq + nqs = 1 + last_q = 1 + ALLOCATE(x_q(3,1)) + x_q(:,1)=xqq(:) + ALLOCATE(done_iq(1)) + done_iq=0 ! ELSE ! - iq_start = 1 + nqs = 1 + last_q = 1 + ALLOCATE(x_q(3,1)) + x_q(:,1)=xq(:) + ALLOCATE(done_iq(1)) + done_iq=0 ! END IF - ! - CLOSE( UNIT = iustat, STATUS = 'KEEP' ) - ! END IF - ! - CALL mp_bcast( iq_start, ionode_id ) ! - IF ( ldisp .OR. lnscf ) THEN - ! - ! ... Save the starting k points - ! - nks_start = nkstot - ! - IF ( .NOT. ALLOCATED( xk_start ) ) ALLOCATE( xk_start( 3, nks_start ) ) - IF ( .NOT. ALLOCATED( wk_start ) ) ALLOCATE( wk_start( nks_start ) ) - ! -#ifdef __PARA - CALL xk_wk_collect( xk_start, wk_start, xk, wk, nkstot, nks ) -#else - xk_start(:,1:nks_start) = xk(:,1:nks_start) - wk_start(1:nks_start) = wk(1:nks_start) -#endif - ENDIF - - IF (ldisp) THEN - ! - ! ... Calculate the q-points for the dispersion - ! - CALL q_points() - ! - ! ... Store the name of the matdyn file in auxdyn - ! - auxdyn = fildyn - ! - ! ... do always a non-scf calculation - ! - lnscf = .TRUE. - ! - ELSE IF ( lnscf ) THEN - ! - ! ... xq is the q-point for phonon calculation (read from input) - ! ... xqq is the q-point for the nscf calculation (read from data file) - ! ... if the nscf calculation is to be performed, discard the latter - ! - xqq = xq - nqs = 1 - ! - ! ... in LSDA case k-points are already doubled to account for - ! ... spin polarization: restore the original number of k-points - ! - IF ( nspin==2 ) nkstot = nkstot/2 - ! - ELSE - ! - nqs = 1 - ! - END IF + IF (nks_start==0) CALL errore('phonon','wrong starting k',1) ! IF ( lnscf ) CALL start_clock( 'PWSCF' ) ! - DO iq = iq_start, nqs + DO iq = iq_start, last_q ! - IF ( ionode ) THEN - ! - CALL seqopn( iustat, 'stat', 'FORMATTED', exst ) - ! - REWIND( iustat ) - ! - WRITE( iustat, * ) iq - ! - CLOSE( UNIT = iustat, STATUS = 'KEEP' ) - ! - END IF + IF (done_iq(iq)==1) CYCLE + ! + current_iq=iq ! IF ( ldisp ) THEN ! @@ -231,18 +200,15 @@ PROGRAM phonon END IF ENDIF ! + ! Save the current status of the run + ! + CALL ph_writefile('init',0) + ! ! ... In the case of q != 0, we make first a non selfconsistent run ! - IF ( lnscf .AND. .NOT. lgamma ) THEN - ! - IF ( nspin==2) THEN - nkstot = nks_start/2 - ELSE - nkstot = nks_start - END IF - ! - xk(:,1:nkstot) = xk_start(:,1:nkstot) - wk(1:nkstot) = wk_start(1:nkstot) + do_band=(start_irr /= 0).OR.(last_irr /= 0) + IF ( lnscf .AND.(.NOT.lgamma.OR.xml_not_of_pw) & + .AND..NOT. done_bands.and.do_band) THEN ! ! WRITE( stdout, '(/,5X,"Calculation of q = ",3F12.7)') xqq @@ -255,22 +221,21 @@ PROGRAM phonon ! CALL set_defaults_pw() lphonon = .TRUE. - lscf = .FALSE. - lbands = .FALSE. - restart = .FALSE. startingconfig = 'input' startingpot = 'file' startingwfc = 'atomic' + restart = recover + pseudo_dir= TRIM( tmp_dir ) // TRIM( prefix ) // '.save' + CALL restart_from_file() + conv_ions=.true. ! ! ... the threshold for diagonalization ethr is calculated via ! ... the threshold on self-consistency tr2 - the value used ! ... here should be good enough for all cases ! - tr2 = 1.D-8 + tr2 = 1.D-9 ethr = 0.d0 mixing_beta = 0.d0 - imix = 0 - nmix = 0 ! ! ... Assume davidson diagonalization ! @@ -283,6 +248,17 @@ PROGRAM phonon ! CALL electrons() ! + IF (.NOT.reduce_io) THEN + write(6,*) 'call punch' + CALL punch( 'all' ) + write(6,*) 'done punch' + done_bands=.TRUE. + xml_not_of_pw=.TRUE. + ENDIF + ! + CALL seqopn( 4, 'restart', 'UNFORMATTED', exst ) + CLOSE( UNIT = 4, STATUS = 'DELETE' ) + ! CALL close_files() ! END IF @@ -299,11 +275,16 @@ PROGRAM phonon ! END IF ! + CALL ph_writefile('init',0) + ! ! ... Calculation of the dispersion: do all modes ! - maxirr = 0 - ! CALL allocate_phq() + ! + ! read the displacement patterns if available in the recover file + ! + rec_code=0 + IF (recover) CALL ph_readfile('data_u',ierr) CALL phq_setup() CALL phq_recover() CALL phq_summary() @@ -314,9 +295,9 @@ PROGRAM phonon ! CALL print_clock( 'PHONON' ) ! - IF ( trans .AND. .NOT. recover ) CALL dynmat0() + IF ( trans .AND. (done_irr(0)==0.AND.comp_irr(0)==1) ) CALL dynmat0() ! - IF ( epsil .AND. irr0 <= 0 ) THEN + IF ( epsil .AND. rec_code <= 0 ) THEN ! IF (fpol) THEN ! calculate freq. dependent polarizability ! @@ -389,6 +370,11 @@ PROGRAM phonon ! ! ... cleanup of the variables ! + done_bands=.FALSE. + done_iq(iq)=1 + DO irr=1,nirr + IF (done_irr(irr)==0) done_iq(iq)=0 + ENDDO CALL clean_pw( .FALSE. ) CALL deallocate_phq() ! @@ -396,9 +382,12 @@ PROGRAM phonon ! CALL close_phq( .TRUE. ) ! + CALL restore_ph_input_variables() + ! END DO - ! - IF ( ionode ) CALL delete_if_present( TRIM(tmp_dir)//TRIM(prefix)//".stat" ) + + CALL ph_writefile('init',0) + CALL clean_input_variables() ! IF ( ALLOCATED( xk_start ) ) DEALLOCATE( xk_start ) IF ( ALLOCATED( wk_start ) ) DEALLOCATE( wk_start ) diff --git a/PH/phq_readin.f90 b/PH/phq_readin.f90 index d069cf81d..b82acab59 100644 --- a/PH/phq_readin.f90 +++ b/PH/phq_readin.f90 @@ -26,15 +26,16 @@ SUBROUTINE phq_readin() USE input_parameters, ONLY : max_seconds USE ions_base, ONLY : amass, pmass, atm USE klist, ONLY : xqq, xk, nks, nkstot, lgauss, two_fermi_energies - USE control_flags, ONLY : gamma_only, tqr + USE control_flags, ONLY : gamma_only, tqr, restart, lkpoint_dir USE uspp, ONLY : okvan USE fixed_occ, ONLY : tfixed_occ USE lsda_mod, ONLY : lsda, nspin USE printout_base, ONLY : title USE control_ph, ONLY : maxter, alpha_mix, lgamma, lgamma_gamma, epsil, & zue, trans, reduce_io, & - elph, tr2_ph, niter_ph, nmix_ph, maxirr, lnscf, & - ldisp, recover, lrpa, lnoloc + elph, tr2_ph, niter_ph, nmix_ph, lnscf, & + ldisp, recover, lrpa, lnoloc, start_irr, & + last_irr, start_q, last_q USE gamma_gamma, ONLY : asr USE qpoint, ONLY : nksq, xq USE partial, ONLY : atomo, list, nat_todo, nrapp @@ -74,18 +75,18 @@ SUBROUTINE phq_readin() ! NAMELIST / INPUTPH / tr2_ph, amass, alpha_mix, niter_ph, nmix_ph, & - maxirr, nat_todo, iverbosity, outdir, epsil, & + nat_todo, iverbosity, outdir, epsil, & trans, elph, zue, nrapp, max_seconds, reduce_io, & modenum, prefix, fildyn, fildvscf, fildrho, & lnscf, ldisp, nq1, nq2, nq3, iq1, iq2, iq3, & eth_rps, eth_ns, lraman, elop, dek, recover, & - fpol, asr, lrpa, lnoloc + fpol, asr, lrpa, lnoloc, start_irr, last_irr, & + start_q, last_q ! tr2_ph : convergence threshold ! amass : atomic masses ! alpha_mix : the mixing parameter ! niter_ph : maximum number of iterations ! nmix_ph : number of previous iterations used in mixing - ! maxirr : the number of irreducible representations ! nat_todo : number of atom to be displaced ! iverbosity : verbosity control ! outdir : directory where input, output, temporary files reside @@ -108,6 +109,11 @@ SUBROUTINE phq_readin() ! dek : delta_xk used for wavefunctions derivation (Raman) ! recover : recover=.true. to restart from an interrupted run ! asr : in the gamma_gamma case apply acoustic sum rule + ! start_q : in q list does the q points from start_q to last_q + ! last_q : + ! start_irr : does the irred. representation from start_irr to last_irr + ! last_irr : + ! IF ( .NOT. ionode ) GOTO 400 ! @@ -131,7 +137,6 @@ SUBROUTINE phq_readin() alpha_mix(1) = 0.7D0 niter_ph = maxter nmix_ph = 4 - maxirr = 0 nat_todo = 0 modenum = 0 nrapp = 0 @@ -164,6 +169,10 @@ SUBROUTINE phq_readin() dek = 1.0d-3 recover = .FALSE. asr = .FALSE. + start_irr = 0 + last_irr = -1000 + start_q = 1 + last_q =-1000 ! ! ... reading the namelist inputph ! @@ -198,8 +207,6 @@ SUBROUTINE phq_readin() IF (dek <= 0.d0) CALL errore ( 'phq_readin', ' Wrong dek ', 1) epsil = epsil .OR. lraman .OR. elop IF ( (lraman.OR.elop) .AND. fildrho == ' ') fildrho = 'drho' - IF (noncolin.and.fpol) & - CALL errore('phonon','noncolinear and fpol not programed',1) ! ! reads the q point (just if ldisp = .false.) ! @@ -233,7 +240,6 @@ SUBROUTINE phq_readin() ! 400 CONTINUE CALL bcast_ph_input ( ) - call mp_bcast ( fpol, ionode_id ) xqq(:) = xq(:) ! ! Here we finished the reading of the input file. @@ -272,6 +278,17 @@ SUBROUTINE phq_readin() IF (tqr) CALL errore('phq_readin',& 'The phonon code with Q in real space not available',1) + + IF (start_irr < 0 ) CALL errore('phq_readin', 'wrong start_irr',1) + ! + IF (noncolin.and.fpol) & + CALL errore('phonon','noncolinear and fpol not programed',1) + ! + ! If a band structure calculation needs to be done do not open a file + ! for k point + ! + IF (lnscf.or.ldisp) lkpoint_dir=.FALSE. + restart = recover ! ! set masses to values read from input, if available; ! leave values read from file otherwise @@ -337,8 +354,6 @@ SUBROUTINE phq_readin() IF (epsil.AND.lgauss) & CALL errore ('phq_readin', 'no elec. field with metals', 1) - IF (maxirr.LT.0.OR.maxirr.GT.3 * nat) CALL errore ('phq_readin', ' & - &Wrong maxirr ', ABS (maxirr) ) IF (MOD (nkstot, 2) .NE.0.AND..NOT.lgamma.and..not.lnscf) & CALL errore ('phq_readin', 'k-points are odd', nkstot) IF (modenum > 0) THEN diff --git a/PH/phq_recover.f90 b/PH/phq_recover.f90 index 94571a43b..ba2cecd6f 100644 --- a/PH/phq_recover.f90 +++ b/PH/phq_recover.f90 @@ -9,24 +9,28 @@ subroutine phq_recover !----------------------------------------------------------------------- ! - ! This subroutine tests if a restart file exists for the phonon run, - ! reads data in the header of the file, writes the appropriate message + ! This subroutine tests if a xml restart file and an unformatted + ! data file exist for the phonon run, reads data in the xml file, + ! writes the appropriate message ! - ! The restart file is unit "iunrec" (unformatted). Contents: - ! irr + ! The unformatted file is unit "iunrec". The xml file is in the + ! directory prefix.phsave. The xml file contains + ! where_rec a string with information of the point where the calculation + ! stopped + ! rec_code ! integer, state of the calculation - ! irr > 0 irrep up to irr done - ! irr =-10 to -19 Raman - ! irr =-20 Electric Field - ! dyn, dyn00, epsilon, zstareu, zstarue, zstareu0, zstarue0 + ! rec_code > 0 phonon (solve_linter 10 or phqscf 20) + ! rec_code =-10 to -19 Raman + ! rec_code =-20 Electric Field + ! dyn, epsilon, zstareu, zstarue0 ! arrays containing partial results: dyn - ! or calculated in dynmat0 (not called after restart): dyn00 ! or calculated in dielec or in zstar_eu: epsilon, zstar* ! (not called after a restart if irr>0) - ! if (irr>0) done_irr, comp_irr, ifat + ! if (rec_code>0) done_irr, comp_irr ! info on calculated irreps - overrides initialization in phq_setup ! - ! phq_readin reads up to here. The following data are read by + ! phq_recover reads up to here. The following data are in the + ! unformatted file and are read by ! routines solve_e, solve_e2, solve_linter: ! iter, dr2 ! info on status of linear-response calculation for a given irrep. @@ -36,7 +40,7 @@ subroutine phq_recover ! convergence is achieved, files containing information needed for ! restarting may be lost (files opened by mix_pot for instance) ! or overwritten at the subsequent interation (files containing - ! dvpsi and dpsi). While not efficient in soem specific case, this + ! dvpsi and dpsi). While not efficient in some specific case, this ! is the only safe way to restart without trouble. ! dvscfin ! self-consistent potential for current iteration and irrep @@ -46,70 +50,53 @@ subroutine phq_recover ! ! If a valid restart file is found: ! - dynmat0 is not called in any case - ! - if irr = -20 the electric field calculation (solve_e) restarts from - ! the saved value of the potential - ! - if -10 < irr < -20 solve_e does nothing, the Raman calculation + ! - if rec_code = -20 the electric field calculation (solve_e) + ! restarts from the saved value of the potential + ! - if -10 < rec_code < -20 solve_e does nothing, the Raman calculation ! (solve_e2), restarts from the saved value of the pot. - ! - if irr > 0 the entire electric field and Raman section is not + ! - if rec_code > 0 the entire electric field and Raman section is not ! called, the phonon calculation restarts from irrep irr ! and from the saved value of the potential ! #include "f_defs.h" ! USE kinds, ONLY : DP - USE ions_base, ONLY : nat USE io_global, ONLY : stdout - USE uspp, ONLY : okvan - USE ramanm, ONLY : lraman, elop, ramtns, eloptns USE phcom + USE ph_restart, ONLY : ph_readfile + ! implicit none ! - integer :: irr, na + integer :: irr, ierr ! counter on representations - ! counter on atoms - logical :: exst + ! error code + logical :: exst, recover_file + character(len=256) :: filename + IF (recover) THEN + CALL ph_readfile('data_u',ierr) + IF (ierr==0) CALL ph_readfile('data',ierr) + IF (where_rec=='solve_e...') THEN + WRITE( stdout, '(/,4x," Restart in Electric Field calculation")') + ELSEIF (where_rec=='solve_e2..') then + WRITE( stdout, '(/,4x," Restart in Raman calculation")') + ELSEIF (where_rec=='solve_lint'.OR.where_rec=='done_drhod') then + WRITE( stdout, '(/,4x," Restart in Phonon calculation")') + ELSE + call errore ('phq_recover', 'wrong restart data file', -1) + ierr=1 + ENDIF + ENDIF +! +! open the recover file +! iunrec = 99 call seqopn (iunrec, 'recover', 'unformatted', exst) - irr0 = 0 - zstarue0 (:,:) = (0.d0, 0.d0) - recover = recover .AND. exst - if (recover) then - ! - read (iunrec) irr0 - ! - ! partially calculated results - ! - read (iunrec) dyn, dyn00 - read (iunrec) epsilon, zstareu, zstarue, zstareu0, zstarue0 - IF (irr0>0 .and. lraman) read (iunrec) ramtns - IF (irr0>0 .and. elop) read (iunrec) eloptns - ! - if (irr0 > 0) then - read (iunrec) done_irr, comp_irr, ifat - nat_todo = 0 - do na = 1, nat - if (ifat (na) == 1) then - nat_todo = nat_todo + 1 - atomo (nat_todo) = na - endif - enddo - all_comp = ( nat_todo == nat ) - end if + recover_file = recover .AND. exst .AND. ierr==0 + if (.not.recover_file) close (unit = iunrec, status = 'delete') - if (irr0 == -20) then - WRITE( stdout, '(/,4x," Restart in Electric Field calculation")') - elseif (irr0 > -20 .AND. irr0 <= -10) then - WRITE( stdout, '(/,4x," Restart in Raman calculation")') - elseif (irr0 > 0 .AND. irr0 <= nirr) then - WRITE( stdout, '(/,4x," Restart in Phonon calculation")') - else - call errore ('phq_recover', 'wrong restart file', 1) - endif - else - close (unit = iunrec, status = 'delete') - endif + recover=recover_file - return -end subroutine phq_recover + RETURN +END SUBROUTINE phq_recover diff --git a/PH/phq_setup.f90 b/PH/phq_setup.f90 index 04770221b..7502348b0 100644 --- a/PH/phq_setup.f90 +++ b/PH/phq_setup.f90 @@ -64,11 +64,14 @@ subroutine phq_setup char_mat, name_rap, gname, name_class, ir_ram USE rap_point_group_is, ONLY : code_group_is, gname_is use phcom - USE ramanm, ONLY : lraman, elop + USE control_ph, ONLY : rec_code + USE ph_restart, ONLY : ph_writefile USE control_flags, ONLY : iverbosity, modenum USE funct, ONLY : dmxc, dmxc_spin, dmxc_nc, dft_is_gradient USE mp, ONLY : mp_max, mp_min USE mp_global, ONLY : inter_pool_comm + USE ramanm, ONLY : lraman, elop, ramtns, eloptns + implicit none real(DP) :: rhotot, rhoup, rhodw, target, small, fac, xmax, emin, emax @@ -83,7 +86,7 @@ subroutine phq_setup real(DP) :: sr(3,3,48), sr_is(3,3,48) integer :: ir, table (48, 48), isym, jsym, irot, ik, ibnd, ipol, & - mu, nu, imode0, irr, ipert, na, it, nt, is, js, nsym_is + mu, nu, imode0, irr, ipert, na, it, nt, is, js, nsym_is, last_irr_eff ! counter on mesh points ! the multiplication table of the point g ! counter on symmetries @@ -103,13 +106,14 @@ subroutine phq_setup logical :: sym (48), is_symmorphic ! the symmetry operations + integer, allocatable :: ifat(:) call start_clock ('phq_setup') - ! ! 0) A few checks ! IF (dft_is_gradient().and.(lraman.or.elop)) call errore('phq_setup', & - 'third order derivatives not implemented with GGA', 1) + 'third order derivatives not implemented with GGA', 1) + ! ! ! 1) Computes the total local potential (external+scf) on the smooth grid ! @@ -281,7 +285,7 @@ subroutine phq_setup if (nsym > 1.and..not.lgamma_gamma) then call set_irr (nat, at, bg, xq, s, invs, nsym, rtau, irt, & irgq, nsymq, minus_q, irotmq, t, tmq, max_irr_dim, u, npert, & - nirr, gi, gimq, iverbosity) + nirr, gi, gimq, iverbosity,rec_code) else call set_irr_nosym (nat, at, bg, xq, s, invs, nsym, rtau, irt, & irgq, nsymq, minus_q, irotmq, t, tmq, max_irr_dim, u, npert, & @@ -324,6 +328,7 @@ subroutine phq_setup IF (lgamma_gamma) THEN ALLOCATE(has_equivalent(nat)) + ALLOCATE(with_symmetry(3*nat)) ALLOCATE(n_equiv_atoms(nat)) ALLOCATE(equiv_atoms(nat,nat)) CALL find_equiv_sites (nat,nat,nsym,irt,has_equivalent,n_diff_sites, & @@ -349,11 +354,9 @@ subroutine phq_setup if (fildrho.ne.' ') call io_pattern (fildrho,nirr,npert,u,+1) - ! - ! set maxirr if not already set - ! - if (maxirr.le.0.or.maxirr.gt.nirr) maxirr = nirr + 1 - if (niter_ph.lt.maxter) maxirr = 1 + if (start_irr < 0) call errore('phq_setup', 'wrong start_irr', 1) + last_irr_eff=last_irr + if (last_irr > nirr.or.last_irr<0) last_irr_eff=nirr ! ! set the alpha_mix parameter ! @@ -373,48 +376,36 @@ subroutine phq_setup ! ubar(5)=(1.d0,0.d0) ! ubar(6)=(1.d0,0.d0) ! - ! 9) set the variables needed for the partial computation - ! - if (nrapp.eq.0) then - if (nat_todo.eq.0) then - ! - ! The partial computation option is not used, compute all atoms - ! - do na = 1, nat - atomo (na) = na - enddo - nat_todo = nat - endif + ! 9) set the variables needed for the partial computation: + ! nat_todo, atomo, comp_irr + ALLOCATE(ifat(nat)) + comp_irr = 0 + comp_irr(0)=1 + IF (nrapp==0 .AND. nat_todo==0) THEN ! - ! Sets the atoms which must be computed: the requested atoms and all - ! the symmetry related atoms + ! Case 1) The partial computation option is not used, make all + ! representation between start_irr and last_irr ! - do na = 1, nat - ifat (na) = 0 - enddo - do na = 1, nat_todo + IF (start_irr <= last_irr_eff) comp_irr(start_irr: last_irr_eff) = 1 + ! + ELSEIF (nat_todo /= 0) THEN + ! + ! Case 2) Sets the atoms which must be computed: the requested + ! atoms and all the symmetry related atoms + ! + ifat = 0 + DO na = 1, nat_todo ifat (atomo (na) ) = 1 - do isym = 1, nsymq + DO isym = 1, nsymq irot = irgq (isym) ifat (irt (irot, atomo (na) ) ) = 1 - enddo - enddo + ENDDO + ENDDO ! - ! Computes again nat_todo, prepare the list atomo and sets all_comp - ! - nat_todo = 0 - do na = 1, nat - if (ifat (na) .eq.1) then - nat_todo = nat_todo + 1 - atomo (nat_todo) = na - endif - enddo - ! - ! Find the irreducible representations to be computed + ! Find the irreducible representations where the required atoms moves ! imode0 = 0 do irr = 1, nirr - comp_irr (irr) = 0 do ipert = 1, npert (irr) mu = imode0 + ipert do na = 1, nat @@ -428,64 +419,108 @@ subroutine phq_setup enddo imode0 = imode0 + npert (irr) enddo - else + ELSEIF (nrapp /= 0) THEN + ! + ! Case 3) The representation which must be computed are given + ! as input + ! if (nrapp > nirr) call errore ('phq_setup', 'too many representations', 1) do irr = 1, nirr - comp_irr (irr) = 0 do mu = 1, nrapp if (list (mu) == irr) comp_irr (irr) = 1 enddo enddo - do na = 1, nat - ifat (na) = 0 - enddo - imode0 = 0 - do irr = 1, nirr - if (comp_irr (irr) .eq.1) then - do ipert = 1, npert (irr) - do na = 1, nat - do ipol = 1, 3 - mu = 3 * (na - 1) + ipol - if (abs (u (mu, imode0+ipert) ) > 1.d-12) ifat (na) = 1 - enddo - enddo - enddo - endif - imode0 = imode0 + npert (irr) - enddo - nat_todo = 0 - do na = 1, nat - if (ifat (na) == 1) then - nat_todo = nat_todo + 1 - atomo (nat_todo) = na - endif - enddo - endif + ELSE + call errore('phq_setup','nat_todo or nrap wrong',1) + ENDIF ! - ! Initialize done_irr, find max dimension of the irreps + ! The gamma_gamma case needs a different treatment ! if (lgamma_gamma) then - comp_irr=0 + with_symmetry=1 + comp_irr = 0 + comp_irr(0)=1 do na=1,nat if (has_equivalent(na)==0) then do ipol=1,3 comp_irr(3*(na-1)+ipol)=1 + with_symmetry(3*(na-1)+ipol)=0 enddo endif enddo if (nasr>0) then do ipol=1,3 comp_irr(3*(nasr-1)+ipol)=0 + with_symmetry(3*(nasr-1)+ipol)=0 enddo endif + IF (start_irr <= last_irr_eff) THEN + DO irr=1,start_irr-1 + comp_irr(irr) = 0 + ENDDO + DO irr=last_irr_eff+1,3*nat + comp_irr(irr) = 0 + ENDDO + ENDIF endif - all_comp = nat_todo.eq.nat - npertx = 0 - do irr = 1, nirr - done_irr (irr) = 0 - npertx = max (npertx, npert (irr) ) - enddo + ! + ! Compute how many atoms moves and set the list atomo + ! + ifat = 0 + imode0 = 0 + DO irr = 1, nirr + if (comp_irr (irr) .eq.1) then + do ipert = 1, npert (irr) + do na = 1, nat + do ipol = 1, 3 + mu = 3 * (na - 1) + ipol + if (abs (u (mu, imode0+ipert) ) > 1.d-12) ifat (na) = 1 + enddo + enddo + enddo + endif + imode0 = imode0 + npert (irr) + ENDDO + nat_todo = 0 + DO na = 1, nat + IF (ifat (na) == 1) THEN + nat_todo = nat_todo + 1 + atomo (nat_todo) = na + ENDIF + ENDDO - call stop_clock ('phq_setup') - return -end subroutine phq_setup + DEALLOCATE(ifat) + ! + ! Initialize done_irr, find max dimension of the irreps + ! + all_comp = nat_todo.eq.nat.or.lgamma_gamma + npertx = 0 + done_irr = 0 + DO irr = 1, nirr + npertx = max (npertx, npert (irr) ) + ENDDO +! +! set to zero the variable written on file +! + dyn=(0.0_DP,0.0_DP) + dyn00=(0.0_DP,0.0_DP) + dyn_rec=(0.0_DP,0.0_DP) + IF (epsil.and.lgamma) THEN + epsilon=0.0_DP + zstareu=0.0_DP + ENDIF + IF (zue.and.lgamma) zstarue0=(0.0_DP,0.0_DP) + IF (lraman.and.lgamma) ramtns=0.0_DP + IF (elop.and.lgamma) eloptns=0.0_DP +! +! if this was not a recover run, save the displacement pattern found here +! + IF (.NOT. recover) THEN + where_rec='setup' + rec_code=0 + CALL ph_writefile('data',0) + ENDIF + + CALL stop_clock ('phq_setup') + RETURN +END SUBROUTINE phq_setup diff --git a/PH/phq_summary.f90 b/PH/phq_summary.f90 index dcf00b981..a46e89570 100644 --- a/PH/phq_summary.f90 +++ b/PH/phq_summary.f90 @@ -269,16 +269,20 @@ subroutine phq_summary & " modes - To be done")') irr, npert (irr) ELSEIF (comp_irr (irr) .eq.0) THEN IF (lgamma_gamma) THEN - IF ((irr-1)/3+1==nasr) THEN - WRITE( stdout, '(/, 5x,"Representation ",i5,i7, & + IF ((irr-1)/3+1==nasr) THEN + WRITE( stdout, '(/, 5x,"Representation ",i5,i7, & & " modes - Calculated using asr")') irr, npert (irr) - ELSE - WRITE( stdout, '(/, 5x,"Representation ",i5,i7, & + done_irr(irr) = 1 + ELSEIF (with_symmetry(irr)==1) THEN + WRITE( stdout, '(/, 5x,"Representation ",i5,i7, & & " modes - Calculated using symmetry")') irr, npert (irr) - ENDIF - done_irr(irr) = 1 + done_irr(irr) = 1 + ELSE + WRITE( stdout, '(/, 5x,"Representation ",i5,i7, & + & " modes - Not done in this run")') irr, npert (irr) + ENDIF ELSE - WRITE( stdout, '(/, 5x,"Representation ",i5,i7, & + WRITE( stdout, '(/, 5x,"Representation ",i5,i7, & & " modes - Not done in this run")') irr, npert (irr) ENDIF ENDIF diff --git a/PH/phqscf.f90 b/PH/phqscf.f90 index 1b0c82c75..abdbaa013 100644 --- a/PH/phqscf.f90 +++ b/PH/phqscf.f90 @@ -24,10 +24,9 @@ SUBROUTINE phqscf IMPLICIT NONE - INTEGER :: irr, irr1, irrc, imode0 + INTEGER :: irr, irr1, imode0 ! counter on the representations ! counter on the representations - ! number of representation computed ! counter on the modes REAL(DP) :: tcpu, get_clock @@ -46,12 +45,9 @@ SUBROUTINE phqscf ! For each irreducible representation we compute the change ! of the wavefunctions ! - irrc = 0 - ALLOCATE (drhoscf( nrxx , nspin, npertx)) DO irr = 1, nirr IF ( (comp_irr (irr) == 1) .AND. (done_irr (irr) == 0) ) THEN - irrc = irrc + 1 imode0 = 0 DO irr1 = 1, irr - 1 imode0 = imode0 + npert (irr1) @@ -87,19 +83,11 @@ SUBROUTINE phqscf WRITE( stdout, '(/,5x,"No convergence has been achieved ")') CALL stop_ph (.FALSE.) ENDIF + rec_code=20 + CALL write_rec('done_drhod',irr,0.0_DP,-1000,.false.,drhoscf,npert(irr)) ! tcpu = get_clock ('PHONON') ! - ! We test here if we have done the appropriate number of - ! representation - ! - IF (irrc >= maxirr) THEN - WRITE( stdout, '(/,5x,"Stopping at Representation #",i6)') irr -#ifdef DEBUG - IF ( ionode ) CLOSE (6) -#endif - CALL stop_ph (.FALSE.) - ENDIF ENDIF ENDDO diff --git a/PH/raman.f90 b/PH/raman.f90 index bd8322913..34a412044 100644 --- a/PH/raman.f90 +++ b/PH/raman.f90 @@ -26,7 +26,7 @@ subroutine raman ! ! Computes Pc [DH,Drho] |psi> ! - IF (irr0 == -10) THEN + IF (rec_code == -10) THEN ! restart from a previous calculation write (6,'(/,5x,''Skipping computation of Pc [DH,Drho] |psi> '')') ELSE diff --git a/PH/save_ph_input.f90 b/PH/save_ph_input.f90 new file mode 100644 index 000000000..dda720358 --- /dev/null +++ b/PH/save_ph_input.f90 @@ -0,0 +1,84 @@ +! +! Copyright (C) 2008 Quantum-ESPRESSO group +! This file is distributed under the terms of the +! GNU General Public License. See the file `License' +! in the root directory of the present distribution, +! or http://www.gnu.org/copyleft/gpl.txt . +! +#include "f_defs.h" +! +!---------------------------------------------------------------------------- +MODULE save_ph + !---------------------------------------------------------------------------- + ! + ! ... this module contains methods to read and write data saved by the + ! phonon code to restart smoothly + ! + ! + USE kinds, ONLY : DP + ! + IMPLICIT NONE + ! + SAVE + ! + PRIVATE + ! + PUBLIC :: save_ph_input_variables, restore_ph_input_variables, & + clean_input_variables + ! + INTEGER, PRIVATE :: nat_todo_save, nrapp_save + INTEGER, ALLOCATABLE, PRIVATE :: list_save(:), atomo_save(:) + LOGICAL, PRIVATE :: recover_save + ! + ! + CONTAINS + ! + !------------------------------------------------------------------------ + SUBROUTINE save_ph_input_variables() + !------------------------------------------------------------------------ + ! + USE ions_base, ONLY : nat + USE partial, ONLY : list, atomo, nat_todo, nrapp + USE control_ph, ONLY : recover + ! + IMPLICIT NONE + ! + ALLOCATE(list_save(3*nat)) + ALLOCATE(atomo_save(nat)) + nat_todo_save=nat_todo + nrapp_save=nrapp + list_save=list + atomo_save=atomo + recover_save=recover + + RETURN + END SUBROUTINE save_ph_input_variables + ! + SUBROUTINE restore_ph_input_variables( ) + !------------------------------------------------------------------------ + ! + USE ions_base, ONLY : nat + USE partial, ONLY : list, atomo, nat_todo, nrapp + USE control_ph, ONLY : recover + ! + IMPLICIT NONE + ! + nat_todo=nat_todo_save + nrapp=nrapp_save + list=list_save + atomo=atomo_save + recover=recover_save + + RETURN + END SUBROUTINE restore_ph_input_variables + + SUBROUTINE clean_input_variables() + IMPLICIT NONE + + DEALLOCATE(list_save) + DEALLOCATE(atomo_save) + + RETURN + END SUBROUTINE clean_input_variables + ! +END MODULE save_ph diff --git a/PH/set_irr.f90 b/PH/set_irr.f90 index 2e174a45b..6924497c7 100644 --- a/PH/set_irr.f90 +++ b/PH/set_irr.f90 @@ -10,7 +10,7 @@ !--------------------------------------------------------------------- subroutine set_irr (nat, at, bg, xq, s, invs, nsym, rtau, irt, & irgq, nsymq, minus_q, irotmq, t, tmq, max_irr_dim, u, npert, & - nirr, gi, gimq, iverbosity) + nirr, gi, gimq, iverbosity, rec_code) !--------------------------------------------------------------------- ! ! This subroutine computes a basis for all the irreducible @@ -44,7 +44,8 @@ subroutine set_irr (nat, at, bg, xq, s, invs, nsym, rtau, irt, & ! integer :: nat, nsym, s (3, 3, 48), invs (48), irt (48, nat), & - iverbosity, npert (3 * nat), irgq (48), nsymq, irotmq, nirr, max_irr_dim + iverbosity, npert (3 * nat), irgq (48), nsymq, irotmq, nirr, & + max_irr_dim, rec_code ! input: the number of atoms ! input: the number of symmetries ! input: the symmetry matrices @@ -56,6 +57,8 @@ subroutine set_irr (nat, at, bg, xq, s, invs, nsym, rtau, irt, & ! output: the order of the small group ! output: the symmetry sending q -> -q+ ! output: the number of irr. representa +! input: if rec_code > 0 u, nirr, and npert are read from the recover file +! and are not recalculated here real(DP) :: xq (3), rtau (3, 48, nat), at (3, 3), bg (3, 3), & gi (3, 48), gimq (3) @@ -105,96 +108,97 @@ subroutine set_irr (nat, at, bg, xq, s, invs, nsym, rtau, irt, & ! find the small group of q ! call smallgq (xq,at,bg,s,nsym,irgq,nsymq,irotmq,minus_q,gi,gimq) + + IF (rec_code <= 0) THEN ! ! then we generate a random hermitean matrix ! - call set_rndm_seed(1) - call random_matrix (irt,irgq,nsymq,minus_q,irotmq,nat,wdyn,lgamma) + call set_rndm_seed(1) + call random_matrix (irt,irgq,nsymq,minus_q,irotmq,nat,wdyn,lgamma) !call write_matrix('random matrix',wdyn,nat) ! ! symmetrize the random matrix with the little group of q ! - call symdynph_gq (xq,wdyn,s,invs,rtau,irt,irgq,nsymq,nat,irotmq,minus_q) + call symdynph_gq (xq,wdyn,s,invs,rtau,irt,irgq,nsymq,nat,irotmq,minus_q) !call write_matrix('symmetrized matrix',wdyn,nat) ! ! Diagonalize the symmetrized random matrix. ! Transform the symmetryzed matrix, currently in crystal coordinates, ! in cartesian coordinates. ! - do na = 1, nat - do nb = 1, nat - call trntnsc( wdyn(1,1,na,nb), at, bg, 1 ) + do na = 1, nat + do nb = 1, nat + call trntnsc( wdyn(1,1,na,nb), at, bg, 1 ) + enddo enddo - enddo ! ! We copy the dynamical matrix in a bidimensional array ! - do na = 1, nat - do nb = 1, nat - do ipol = 1, 3 - imode = ipol + 3 * (na - 1) - do jpol = 1, 3 - jmode = jpol + 3 * (nb - 1) - phi (imode, jmode) = wdyn (ipol, jpol, na, nb) - + do na = 1, nat + do nb = 1, nat + do ipol = 1, 3 + imode = ipol + 3 * (na - 1) + do jpol = 1, 3 + jmode = jpol + 3 * (nb - 1) + phi (imode, jmode) = wdyn (ipol, jpol, na, nb) + enddo enddo enddo enddo - enddo ! ! Diagonalize ! - call cdiagh (3 * nat, phi, 3 * nat, eigen, u) + call cdiagh (3 * nat, phi, 3 * nat, eigen, u) ! ! We adjust the phase of each mode in such a way that the first ! non zero element is real ! - do imode = 1, 3 * nat - do na = 1, 3 * nat - modul = abs (u(na, imode) ) - if (modul.gt.1d-9) then - fase = u (na, imode) / modul - goto 110 - endif + do imode = 1, 3 * nat + do na = 1, 3 * nat + modul = abs (u(na, imode) ) + if (modul.gt.1d-9) then + fase = u (na, imode) / modul + goto 110 + endif + enddo + call errore ('set_irr', 'one mode is zero', imode) +110 do na = 1, 3 * nat + u (na, imode) = - u (na, imode) * CONJG(fase) + enddo enddo - call errore ('set_irr', 'one mode is zero', imode) -110 do na = 1, 3 * nat - u (na, imode) = - u (na, imode) * CONJG(fase) - enddo - enddo ! ! We have here a test which writes eigenvectors and eigenvalues ! - if (iverbosity.eq.1) then - do imode=1,3*nat - WRITE( stdout, '(2x,"autoval = ", e10.4)') eigen(imode) - WRITE( stdout, '(2x,"Real(aut_vet)= ( ",6f10.5,")")') & - ( DBLE(u(na,imode)), na=1,3*nat ) - WRITE( stdout, '(2x,"Imm(aut_vet)= ( ",6f10.5,")")') & - ( AIMAG(u(na,imode)), na=1,3*nat ) - end do - end if + if (iverbosity.eq.1) then + do imode=1,3*nat + WRITE( stdout, '(2x,"autoval = ", e10.4)') eigen(imode) + WRITE( stdout, '(2x,"Real(aut_vet)= ( ",6f10.5,")")') & + ( DBLE(u(na,imode)), na=1,3*nat ) + WRITE( stdout, '(2x,"Imm(aut_vet)= ( ",6f10.5,")")') & + ( AIMAG(u(na,imode)), na=1,3*nat ) + end do + end if ! ! Here we count the irreducible representations and their dimensions - do imode = 1, 3 * nat + do imode = 1, 3 * nat ! initialization - npert (imode) = 0 - enddo - nirr = 1 - npert (1) = 1 - do imode = 2, 3 * nat - if (abs (eigen (imode) - eigen (imode-1) ) / (abs (eigen (imode) ) & + npert (imode) = 0 + enddo + nirr = 1 + npert (1) = 1 + do imode = 2, 3 * nat + if (abs (eigen (imode) - eigen (imode-1) ) / (abs (eigen (imode) ) & + abs (eigen (imode-1) ) ) .lt.1.d-4) then - npert (nirr) = npert (nirr) + 1 - if (npert (nirr) .gt. max_irr_dim) call errore & + npert (nirr) = npert (nirr) + 1 + if (npert (nirr) .gt. max_irr_dim) call errore & ('set_irr', 'npert > max_irr_dim ', nirr) - else - nirr = nirr + 1 - npert (nirr) = 1 - endif - - enddo + else + nirr = nirr + 1 + npert (nirr) = 1 + endif + enddo + endif ! ! And we compute the matrices which represent the symmetry transformat ! in the basis of the displacements diff --git a/PH/solve_e.f90 b/PH/solve_e.f90 index 83bf1d081..d30e672d9 100644 --- a/PH/solve_e.f90 +++ b/PH/solve_e.f90 @@ -31,7 +31,7 @@ subroutine solve_e USE uspp_param, ONLY : upf, nhm USE noncollin_module, ONLY : noncolin, npol use phcom - USE control_ph, ONLY : reduce_io + USE control_ph, ONLY : reduce_io, recover USE mp_global, ONLY : inter_pool_comm, intra_pool_comm USE mp, ONLY : mp_sum @@ -93,7 +93,7 @@ subroutine solve_e ps (:,:) = (0.d0, 0.d0) allocate (h_diag(npwx*npol, nbnd)) allocate (eprec(nbnd)) - if (irr0 == -20) then + if (rec_code == -20.and.recover) then ! restarting in Electric field calculation read (iunrec) iter0, dr2 read (iunrec) dvscfin @@ -113,7 +113,7 @@ subroutine solve_e enddo endif convt=.false. - else if (irr0 > -20 .AND. irr0 <= -10) then + else if (rec_code > -20 .AND. rec_code <= -10) then ! restarting in Raman: proceed convt = .true. else @@ -145,6 +145,7 @@ subroutine solve_e do kter = 1, niter_ph ! write(6,*) 'kter', kter + CALL flush_unit( stdout ) iter = kter + iter0 ltaver = 0 lintercall = 0 @@ -447,35 +448,14 @@ subroutine solve_e ! CALL flush_unit( stdout ) ! - call seqopn (iunrec, 'recover', 'unformatted', exst) + ! rec_code: state of the calculation + ! rec_code=-20 Electric Field ! - ! irr: state of the calculation - ! irr=-20 Electric Field - ! - irr = -20 - ! - write (iunrec) irr - ! - ! partially calculated results - ! - write (iunrec) dyn, dyn00 - write (iunrec) epsilon, zstareu, zstarue, zstareu0, zstarue0 - ! - ! info on current iteration (iter=0 if potential mixing not available) - ! - if (reduce_io.or.convt) then - write (iunrec) 0, dr2 - else - write (iunrec) iter, dr2 - end if - write (iunrec) dvscfin - if (okvan) write (iunrec) int1, int2, int3 + rec_code=-20 + CALL write_rec('solve_e...', irr, dr2, iter, convt, dvscfin, 3) + + if (check_stop_now().and..not.convt) call stop_ph (.false.) - close (unit = iunrec, status = 'keep') - if (check_stop_now()) then - call stop_ph (.false.) - goto 155 - endif if (convt) goto 155 enddo diff --git a/PH/solve_e2.f90 b/PH/solve_e2.f90 index b851116d7..59b63d09f 100644 --- a/PH/solve_e2.f90 +++ b/PH/solve_e2.f90 @@ -83,7 +83,7 @@ subroutine solve_e2 allocate (dvscfout( nrxx , nspin, 6)) allocate (dbecsum( nhm*(nhm+1)/2, nat)) allocate (aux1( nrxxs)) - if (irr0 == -10) then + if (rec_code == -10) then ! restarting in Raman read (iunrec) iter0, dr2 read (iunrec) dvscfin @@ -234,34 +234,12 @@ subroutine solve_e2 ! CALL flush_unit( stdout ) ! - call seqopn (iunrec, 'recover', 'unformatted', exst) - ! - ! irr: state of the calculation - ! irr=-10 to -19 Raman - irr = -10 - ! - write (iunrec) irr - ! - ! partially calculated results - ! - write (iunrec) dyn, dyn00 - write (iunrec) epsilon, zstareu, zstarue, zstareu0, zstarue0 - ! - ! info on current iteration (iter=0 potential mixing not available) - ! - if (reduce_io.or.convt) then - write (iunrec) 0, dr2 - else - write (iunrec) iter, dr2 - end if - write (iunrec) dvscfin - if (okvan) write (iunrec) int1, int2, int3 - close (unit = iunrec, status = 'keep') + ! rec_code: state of the calculation + ! rec_code=-10 to -19 Raman + rec_code=-10 + CALL write_rec('solve_e2..', irr, dr2, iter, convt, dvscfin, 6) - if ( check_stop_now() ) then - call stop_ph (.false.) - goto 155 - endif + if ( check_stop_now() ) call stop_ph (.false.) if ( convt ) goto 155 enddo diff --git a/PH/solve_e_fpol.f90 b/PH/solve_e_fpol.f90 index 0e51ed3f3..c2160b3db 100644 --- a/PH/solve_e_fpol.f90 +++ b/PH/solve_e_fpol.f90 @@ -101,7 +101,7 @@ subroutine solve_e_fpol ( iw ) ! restart NOT IMPLEMENTED - if (irr0 == -20) then + if (rec_code == -20) then !read (iunrec) iter0, convt, dr2 !read (iunrec) dvscfin !if (okvan) read (iunrec) int3 @@ -113,7 +113,7 @@ subroutine solve_e_fpol ( iw ) ! enddo ! enddo !endif - else if (irr0 > -20 .AND. irr0 <= -10) then + else if (rec_code > -20 .AND. rec_code <= -10) then ! restarting in Raman: proceed convt = .true. else diff --git a/PH/solve_linter.f90 b/PH/solve_linter.f90 index 079396a54..bc54d1351 100644 --- a/PH/solve_linter.f90 +++ b/PH/solve_linter.f90 @@ -33,9 +33,10 @@ subroutine solve_linter (irr, imode0, npe, drhoscf) use pwcom USE uspp_param, ONLY : upf, nhm USE noncollin_module, ONLY : noncolin, npol - USE control_ph, ONLY : irr0, niter_ph, nmix_ph, elph, tr2_ph, & + USE control_ph, ONLY : rec_code, niter_ph, nmix_ph, elph, tr2_ph, & alpha_pv, lgamma, lgamma_gamma, convt, & - nbnd_occ, alpha_mix, ldisp, reduce_io + nbnd_occ, alpha_mix, ldisp, reduce_io, & + recover, where_rec USE nlcc_ph, ONLY : nlcc_any USE units_ph, ONLY : iudrho, lrdrho, iudwf, lrdwf, iubar, lrbar, & iuwfc, lrwfc, iunrec, iudvscf @@ -43,12 +44,8 @@ subroutine solve_linter (irr, imode0, npe, drhoscf) USE phus, ONLY : int1, int2, int3 USE eqv, ONLY : dvpsi, dpsi, evq USE qpoint, ONLY : npwq, igkq, nksq - USE partial, ONLY : comp_irr, done_irr, ifat USE modes, ONLY : npert, u ! used oly to write the restart file - USE efield_mod, ONLY : epsilon, zstareu, zstarue, zstareu0, zstarue0 - USE dynmat, ONLY : dyn, dyn00 - USE ramanm, ONLY : lraman, elop, ramtns, eloptns USE mp_global, ONLY : inter_pool_comm, intra_pool_comm USE mp, ONLY : mp_sum ! @@ -139,7 +136,7 @@ subroutine solve_linter (irr, imode0, npe, drhoscf) allocate (h_diag ( npwx*npol, nbnd)) allocate (eprec ( nbnd)) ! - if (irr0 > 0) then + if (rec_code > 0.and.recover) then ! restart from Phonon calculation read (iunrec) iter0, dr2 read (iunrec) dvscfin @@ -151,8 +148,8 @@ subroutine solve_linter (irr, imode0, npe, drhoscf) end if end if close (unit = iunrec, status = 'keep') - ! reset irr0 to avoid trouble at next irrep - irr0 = 0 + ! reset rec_code to avoid trouble at next irrep + rec_code = 0 if (doublegrid) then do is = 1, nspin do ipert = 1, npe @@ -184,7 +181,13 @@ subroutine solve_linter (irr, imode0, npe, drhoscf) INQUIRE (UNIT = iudrho, OPENED = exst) IF (exst) CLOSE (UNIT = iudrho, STATUS='keep') CALL DIROPN (iudrho, TRIM(fildrho)//'.u', lrdrho, exst) - end if + END IF + ! + ! In this case it has recovered after computing the contribution + ! to the dynamical matrix. This is a new iteration that has to + ! start from the beginning. + ! + IF (iter0==-1000) iter0=0 ! ! The outside loop is over the iterations ! @@ -248,23 +251,11 @@ subroutine solve_linter (irr, imode0, npe, drhoscf) ! ! and now adds the contribution of the self consistent term ! - if (iter == 1) then - ! - ! At the first iteration dvbare_q*psi_kpoint is calculated - ! and written to file - ! - call dvqpsi_us (ik, mode, u (1, mode),.false. ) - call davcio (dvpsi, lrbar, iubar, nrec, 1) - else + if (where_rec =='solve_lint'.or.iter>1) then ! ! After the first iteration dvbare_q*psi_kpoint is read from file ! - if (ldisp.and.kter==1) then - call dvqpsi_us (ik, mode, u (1, mode), .false. ) - call davcio (dvpsi, lrbar, iubar, nrec, 1) - else - call davcio (dvpsi, lrbar, iubar, nrec, - 1) - endif + call davcio (dvpsi, lrbar, iubar, nrec, - 1) ! ! calculates dvscf_q*psi_k in G_space, for all bands, k=kpoint ! dvscf_q from previous iteration (mix_potential) @@ -306,6 +297,13 @@ subroutine solve_linter (irr, imode0, npe, drhoscf) ! V_{eff} on the bare change of the potential ! call adddvscf (ipert, ik) + else + ! + ! At the first iteration dvbare_q*psi_kpoint is calculated + ! and written to file + ! + call dvqpsi_us (ik, mode, u (1, mode),.false. ) + call davcio (dvpsi, lrbar, iubar, nrec, 1) endif ! ! Ortogonalize dvpsi to valence states: ps = @@ -398,17 +396,7 @@ subroutine solve_linter (irr, imode0, npe, drhoscf) END IF call stop_clock ('ortho') ! - if (iter == 1) then - ! - ! At the first iteration dpsi and dvscfin are set to zero - ! - dpsi(:,:) = (0.d0, 0.d0) - dvscfin (:, :, ipert) = (0.d0, 0.d0) - ! - ! starting threshold for iterative solution of the linear system - ! - thresh = 1.0d-2 - else + if (where_rec=='solve_lint'.or.iter > 1) then ! ! starting value for delta_psi is read from iudwf ! @@ -418,6 +406,16 @@ subroutine solve_linter (irr, imode0, npe, drhoscf) ! threshold for iterative solution of the linear system ! thresh = min (1.d-1 * sqrt (dr2), 1.d-2) + else + ! + ! At the first iteration dpsi and dvscfin are set to zero + ! + dpsi(:,:) = (0.d0, 0.d0) + dvscfin (:, :, ipert) = (0.d0, 0.d0) + ! + ! starting threshold for iterative solution of the linear system + ! + thresh = 1.0d-2 endif ! @@ -604,41 +602,10 @@ subroutine solve_linter (irr, imode0, npe, drhoscf) ! CALL flush_unit( stdout ) ! - call start_clock ('write_rec') - call seqopn (iunrec, 'recover', 'unformatted', exst) - ! - ! irr: state of the calculation - ! irr > 0: irrep up to irr done - ! - write (iunrec) irr - ! - ! partially calculated results - ! - write (iunrec) dyn, dyn00 - write (iunrec) epsilon, zstareu, zstarue, zstareu0, zstarue0 - IF (lraman) write (iunrec) ramtns - IF (elop) write (iunrec) eloptns - ! - ! info on what to do with various irreps (only if irr > 0) - ! - write (iunrec) done_irr, comp_irr, ifat - ! - ! info on current iteration (iter=0 potential mixing not available) - ! - if (reduce_io.or.convt) then - write (iunrec) 0, dr2 - else - write (iunrec) iter, dr2 - endif - write (iunrec) dvscfin - if (okvan) write (iunrec) int1, int2, int3 - close (unit = iunrec, status = 'keep') + rec_code=10 + CALL write_rec('solve_lint', irr, dr2, iter, convt, dvscfin, npe) - call stop_clock ('write_rec') - if (check_stop_now()) then - call stop_ph (.false.) - goto 155 - endif + if (check_stop_now()) call stop_ph (.false.) if (convt) goto 155 enddo 155 iter0=0 diff --git a/PH/write_rec.f90 b/PH/write_rec.f90 new file mode 100644 index 000000000..515c5c9d8 --- /dev/null +++ b/PH/write_rec.f90 @@ -0,0 +1,54 @@ +! +! Copyright (C) 2008 Quantum-ESPRESSO group +! This file is distributed under the terms of the +! GNU General Public License. See the file `License' +! in the root directory of the present distribution, +! or http://www.gnu.org/copyleft/gpl.txt . +! +!----------------------------------------------------------------------- +SUBROUTINE write_rec(where, irr, dr2, iter, convt, dvscfin, npe) +!----------------------------------------------------------------------- +! +! This routine saves the information needed to recover the phonon +! +USE kinds, ONLY : DP +USE lsda_mod, ONLY : nspin +USE units_ph, ONLY : iunrec +USE gvect, ONLY : nrxx +USE uspp, ONLY : okvan +USE phus, ONLY : int1, int2, int3 +USE control_ph, ONLY : where_rec, rec_code, reduce_io +USE ph_restart, ONLY : ph_writefile + + +IMPLICIT NONE +CHARACTER(LEN=10), INTENT(IN) :: where +INTEGER, INTENT(IN) :: irr, iter, npe +LOGICAL, INTENT(IN) :: convt +REAL(DP), INTENT(IN) :: dr2 +COMPLEX(DP), INTENT(IN) :: dvscfin(nrxx,nspin,npe) + +LOGICAL :: exst +CALL start_clock ('write_rec') +where_rec=where +CALL ph_writefile('data',0) +IF (where_rec=='done_drhod') CALL ph_writefile('data_dyn',irr) +CALL seqopn (iunrec, 'recover', 'unformatted', exst) +! +! info on current iteration (iter=0 potential mixing not available) +! +IF (reduce_io.or.convt) THEN + WRITE (iunrec) 0, dr2 +ELSE + WRITE (iunrec) iter, dr2 +ENDIF +WRITE (iunrec) dvscfin +IF (okvan) WRITE (iunrec) int1, int2, int3 + +CLOSE (UNIT = iunrec, STATUS = 'keep') + +rec_code = 0 +CALL stop_clock ('write_rec') + +RETURN +END SUBROUTINE write_rec diff --git a/PW/pw_restart.f90 b/PW/pw_restart.f90 index 6fc7c9553..d3dd705d7 100644 --- a/PW/pw_restart.f90 +++ b/PW/pw_restart.f90 @@ -108,6 +108,7 @@ MODULE pw_restart emaxpos, eopreg, eamp USE io_rho_xml, ONLY : write_rho USE mp_global, ONLY : kunit, nproc, nproc_pool, me_pool + USE start_k, ONLY : nks_start, xk_start, wk_start ! IMPLICIT NONE ! @@ -382,7 +383,8 @@ MODULE pw_restart ! ... BRILLOUIN_ZONE !------------------------------------------------------------------------------- ! - CALL write_bz( num_k_points, xk, wk, k1, k2, k3, nk1, nk2, nk3 ) + CALL write_bz( num_k_points, xk, wk, k1, k2, k3, nk1, nk2, nk3, & + nks_start, xk_start, wk_start ) ! !------------------------------------------------------------------------------- ! ... PHONON @@ -2209,6 +2211,7 @@ MODULE pw_restart USE lsda_mod, ONLY : lsda USE klist, ONLY : nkstot, xk, wk USE ktetra, ONLY : nk1, nk2, nk3, k1, k2, k3 + USE start_k, ONLY : nks_start, xk_start, wk_start ! IMPLICIT NONE ! @@ -2216,6 +2219,7 @@ MODULE pw_restart INTEGER, INTENT(OUT) :: ierr ! INTEGER :: ik, num_k_points + LOGICAL :: found ! ierr = 0 IF ( lbz_read ) RETURN @@ -2233,6 +2237,7 @@ MODULE pw_restart CALL iotk_scan_begin( iunpun, "BRILLOUIN_ZONE" ) ! CALL iotk_scan_dat( iunpun, "NUMBER_OF_K-POINTS", num_k_points ) + ! nkstot = num_k_points ! @@ -2265,6 +2270,23 @@ MODULE pw_restart END IF ! END DO + CALL iotk_scan_dat( iunpun, "STARTING_K-POINTS", nks_start, & + FOUND = found ) + IF (.NOT. found) nks_start=0 + IF (nks_start > 0 ) THEN + IF (.NOT.ALLOCATED(xk_start)) ALLOCATE(xk_start(3,nks_start)) + IF (.NOT.ALLOCATED(wk_start)) ALLOCATE(wk_start(nks_start)) + END IF + DO ik = 1, nks_start + ! + CALL iotk_scan_empty( iunpun, "K-POINT_START" // & + & TRIM( iotk_index( ik ) ), attr ) + ! + CALL iotk_scan_attr( attr, "XYZ", xk_start(:,ik) ) + ! + CALL iotk_scan_attr( attr, "WEIGHT", wk_start(ik) ) + ! + END DO ! CALL iotk_scan_end( iunpun, "BRILLOUIN_ZONE" ) ! @@ -2281,6 +2303,16 @@ MODULE pw_restart CALL mp_bcast( k1, ionode_id, intra_image_comm ) CALL mp_bcast( k2, ionode_id, intra_image_comm ) CALL mp_bcast( k3, ionode_id, intra_image_comm ) + + CALL mp_bcast( nks_start, ionode_id, intra_image_comm ) + IF (nks_start>0.and..NOT.ionode) THEN + IF (.NOT.ALLOCATED(xk_start)) ALLOCATE(xk_start(3,nks_start)) + IF (.NOT.ALLOCATED(wk_start)) ALLOCATE(wk_start(nks_start)) + ENDIF + IF (nks_start>0) THEN + CALL mp_bcast( xk_start, ionode_id, intra_image_comm ) + CALL mp_bcast( wk_start, ionode_id, intra_image_comm ) + ENDIF ! lbz_read = .TRUE. ! diff --git a/PW/pwcom.f90 b/PW/pwcom.f90 index 77612f269..300d17bec 100644 --- a/PW/pwcom.f90 +++ b/PW/pwcom.f90 @@ -580,6 +580,21 @@ MODULE bp ! END MODULE bp ! +MODULE start_k + ! + USE kinds, ONLY: DP + ! + SAVE + + INTEGER :: nks_start=0 + ! number of initial k points + REAL(DP), ALLOCATABLE :: wk_start(:) + ! initial weight of k points + REAL(DP), ALLOCATABLE :: xk_start(:,:) + ! initial coordinates of k points + +END MODULE start_k +! MODULE pwcom ! USE constants, ONLY : e2, rytoev, amconv, pi, tpi, fpi @@ -612,5 +627,6 @@ MODULE pwcom USE fixed_occ USE spin_orb USE bp + USE start_k ! END MODULE pwcom diff --git a/PW/set_defaults_pw.f90 b/PW/set_defaults_pw.f90 index 2ffe51e2d..7366c7489 100644 --- a/PW/set_defaults_pw.f90 +++ b/PW/set_defaults_pw.f90 @@ -73,6 +73,8 @@ SUBROUTINE set_defaults_pw w_2 USE us, ONLY : spline_ps USE a2F, ONLY : la2F + USE klist, ONLY : nkstot, wk, xk + USE start_k, ONLY : xk_start, wk_start, nks_start ! IMPLICIT NONE @@ -156,6 +158,13 @@ SUBROUTINE set_defaults_pw crystal = ' ' calc = ' ' ! + ! Reset the k points + ! + nkstot = nks_start + ! + xk(:,1:nkstot) = xk_start(:,1:nkstot) + wk(1:nkstot) = wk_start(1:nkstot) + ! RETURN ! END SUBROUTINE set_defaults_pw diff --git a/PW/setup.f90 b/PW/setup.f90 index d983c7fec..7a5b084bd 100644 --- a/PW/setup.f90 +++ b/PW/setup.f90 @@ -87,6 +87,7 @@ SUBROUTINE setup() #endif USE funct, ONLY : dft_is_meta, dft_is_hybrid, dft_is_gradient USE paw_variables, ONLY : okpaw + USE start_k, ONLY : nks_start, xk_start, wk_start ! DCC USE ee_mod, ONLY : do_coarse, do_mltgrid @@ -553,6 +554,16 @@ SUBROUTINE setup() ! END IF ! + ! Save the initial k point for phonon calculation + ! + IF (nks_start==0) THEN + nks_start=nkstot + IF ( .NOT. ALLOCATED( xk_start ) ) ALLOCATE( xk_start( 3, nks_start ) ) + IF ( .NOT. ALLOCATED( wk_start ) ) ALLOCATE( wk_start( nks_start ) ) + xk_start(:,:)=xk(:,1:nkstot) + wk_start(:)=wk(1:nkstot) + ENDIF + ! ! ... allocate space for irt ! ALLOCATE( irt( 48, nat ) ) diff --git a/doc-def/INPUT_PH.def b/doc-def/INPUT_PH.def index e79f43f49..4aeb9438b 100644 --- a/doc-def/INPUT_PH.def +++ b/doc-def/INPUT_PH.def @@ -282,14 +282,55 @@ input_description -distribution {Quantum Espresso} -package PWscf -program ph.x } } - var maxirr -type INTEGER { - default { 0, i.e. use all irreps } + var start_irr -type INTEGER { + default { 1 } info { - Perform calculations only up to the first "maxirr" irreps. + Perform calculations only from start_irr to last_irr + irreducible representations. IMPORTANT: - * maxirr must be <= 3*nat - * do not specify "nat_todo" or "nrapp" together with "maxirr" + * start_irr must be <= 3*nat + * do not specify "nat_todo" or "nrapp" together with + "start_irr", "last_irr" + } + } + + var last_irr -type INTEGER { + default { 3*nat } + info { + Perform calculations only from start_irr to last_irr + irreducible representations. + + IMPORTANT: + * start_irr must be <= 3*nat + * do not specify "nat_todo" or "nrapp" together with + "start_irr", "last_irr" + } + } + + var start_q -type INTEGER { + default { 1 } + info { + Used only when ldisp=.true.. + Computes only the q points from start_q to last_q. + + IMPORTANT: + * start_q must be <= nqs (number of q points found) + * do not specify "nat_todo" or "nrapp" together with + "start_q", "last_q" + } + } + + var last_q -type INTEGER { + default { number of q points } + info { + Used only when ldisp=.true.. + Computes only the q points from start_q to last_q. + + IMPORTANT: + * last_q must be <= nqs (number of q points) + * do not specify "nat_todo" or "nrapp" together with + "start_q", "last_q" } } @@ -315,6 +356,7 @@ input_description -distribution {Quantum Espresso} -package PWscf -program ph.x } } + group { linecard { list xq_list -type REAL { @@ -351,5 +393,35 @@ input_description -distribution {Quantum Espresso} -package PWscf -program ph.x } } } - } + } + text { +NB: The program ph.x writes on the tmp_dir/prefix.phsave directory +a file for each representation of each q point. This file is called +data-file.xml.#iq.#irr where #iq is the number of the q point and #irr is +the number of the representation. These files contain the contribution to +the dynamical matrix of the irr representation for the iq point. +If recover=.true. ph.x does not recalculate the representations +already saved in the tmp_dir/prefix.phsave directory. + +This mechanism allows: + +1) To recover the ph.x calculation even if the recover file is corrupted. +You just remove the recover files from the tmp_dir directory. + +2) To split a phonon calculation in several machines (or set of nodes). +Each machine calculates a subset of the representations and saves its +data-file.xml.#iq.#irr files on its tmp_dir/prefix.phsave directory. +Then you collect all the data-file.xml.#iq.#irr files in one directory +and run ph.x. + +NB: If you split the q points in different machines, just use start_q and +last_q variables. If you plan to split also the irreducible representations +use start_irr, last_irr. If different machines generate +different displacement patterns the splitting on the representations +will not work. In order to force ph.x to use the same patterns +run ph.x with start_irr=0, last_irr=0. This will produce a +set of files data-file.xml.#iq and the file data-file.xml. Copy these files in +all the tmp_dir/prefix.phsave directories where you plan to run ph.x and +then run ph.x with different start_irr, last_irr. + } }