scnc
/
quantum-espresso
mirror of https://gitlab.com/QEF/q-e.git
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

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
This commit is contained in:
dalcorso 2008-07-23 08:46:48 +00:00
parent afc7d6eb2c
commit d3b31c3cc3
35 changed files with 1668 additions and 531 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

93
Modules/xml_io_base.f90
View File

@ -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
!

4
PH/Makefile
View File

@ -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

3
PH/addnlcc.f90
View File

@ -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

5
PH/allocate_part.f90
View File

@ -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

2
PH/allocate_phq.f90
View File

@ -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))

8
PH/bcast_ph_input.f90
View File

@ -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)
!

37
PH/check_restart_recover.f90 Normal file
View File

@ -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

1
PH/deallocate_part.f90
View File

@ -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)

5
PH/deallocate_phq.f90
View File

@ -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

1
PH/drhodv.f90
View File

@ -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

6
PH/drhodvus.f90
View File

@ -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

6
PH/dynmat0.f90
View File

@ -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

18
PH/dynmatrix.f90
View File

@ -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
!

34
PH/make.depend
View File

@ -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

717
PH/ph_restart.f90 Normal file
View File

@ -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

26
PH/phcom.f90
View File

@ -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
!

261
PH/phonon.f90
View File

@ -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 )

39
PH/phq_readin.f90
View File

@ -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

109
PH/phq_recover.f90
View File

@ -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

197
PH/phq_setup.f90
View File

@ -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

18
PH/phq_summary.f90
View File

@ -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

18
PH/phqscf.f90
View File

@ -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

2
PH/raman.f90
View File

@ -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

84
PH/save_ph_input.f90 Normal file
View File

@ -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

114
PH/set_irr.f90
View File

@ -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

40
PH/solve_e.f90
View File

@ -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

34
PH/solve_e2.f90
View File

@ -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

4
PH/solve_e_fpol.f90
View File

@ -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

105
PH/solve_linter.f90
View File

@ -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 = <evq|dvpsi>
@ -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

54
PH/write_rec.f90 Normal file
View File

@ -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

34
PW/pw_restart.f90
View File

@ -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.
!

16
PW/pwcom.f90
View File

@ -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

9
PW/set_defaults_pw.f90
View File

@ -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

11
PW/setup.f90
View File

@ -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 ) )

84
doc-def/INPUT_PH.def
View File

@ -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.
}
}