Commit 7daa5595 authored by Samuel Poncé's avatar Samuel Poncé

More cleaning of EPW.

parent b3fba695
......@@ -31,7 +31,7 @@
USE start_k, ONLY : nk1, nk2, nk3
USE ions_base, ONLY : nat, amass, ityp, tau
USE phcom, ONLY : nq1, nq2, nq3, nmodes
USE epwcom, ONLY : nbndsub, lrepmatf, fsthick, epwread, longrange, &
USE epwcom, ONLY : nbndsub, fsthick, epwread, longrange, &
epwwrite, ngaussw, degaussw, lpolar, lifc, lscreen, &
nbndskip, parallel_k, parallel_q, etf_mem, scr_typ, &
elecselfen, phonselfen, nest_fn, a2f, specfun_ph, &
......@@ -42,7 +42,7 @@
nqf2, nqf3, mp_mesh_k, restart, ncarrier, plselfen, &
specfun_pl
USE noncollin_module, ONLY : noncolin
USE constants_epw, ONLY : ryd2ev, ryd2mev, one, two, eps2, eps4, zero, czero, &
USE constants_epw, ONLY : ryd2ev, ryd2mev, one, two, eps2, zero, czero, &
twopi, ci, kelvin2eV
USE io_files, ONLY : prefix, diropn, tmp_dir
USE io_global, ONLY : stdout, ionode
......@@ -54,7 +54,7 @@
wkf, dynq, nqtotf, nkqf, epf17, nkf, nqf, et_ks, &
ibndmin, ibndmax, lambda_all, dmec, dmef, vmef, &
sigmai_all, sigmai_mode, gamma_all, epsi, zstar, &
efnew, ifc, sigmar_all, zi_all, nkqtotf, eps_rpa, &
efnew, sigmar_all, zi_all, nkqtotf, eps_rpa, &
nkqtotf, sigmar_all, zi_allvb, inv_tau_all, Fi_all, &
F_current, F_SERTA, inv_tau_allcb, zi_allcb
USE transportcom, ONLY : transp_temp, mobilityh_save, mobilityel_save, lower_bnd, &
......@@ -83,8 +83,6 @@
!! Skipping band during the Wannierization
LOGICAL :: exst
!! If the file exist
LOGICAL :: opnd
!! Check whether the file is open.
LOGICAL :: first_cycle
!! Check wheter this is the first cycle after a restart.
LOGICAL :: first_time
......@@ -92,8 +90,6 @@
!
CHARACTER (len=256) :: filint
!! Name of the file to write/read
CHARACTER (len=256) :: nameF
!! Name of the file
CHARACTER (len=30) :: myfmt
!! Variable used for formatting output
!
......@@ -129,12 +125,8 @@
!! counter on mode
INTEGER :: fermicount
!! Number of states at the Fermi level
INTEGER :: nrec
!! record index when reading file
INTEGER :: lrepmatw
!! record length while reading file
INTEGER :: i
!! Index when writing to file
INTEGER :: ikx
!! Counter on the coase k-grid
INTEGER :: ikfx
......@@ -397,6 +389,7 @@
ALLOCATE (epmatwp ( nbndsub, nbndsub, nrr_k, nmodes, nrr_q))
ELSE
ALLOCATE(epmatwe_mem ( nbndsub, nbndsub, nrr_k, nmodes))
epmatwe_mem(:,:,:,:) = czero
ENDIF
!
! Hamiltonian
......@@ -856,13 +849,13 @@
IF (int_mob .OR. (ncarrier < 1E5)) THEN
IF ( error_h < eps2 ) WRITE(stdout,'(5x,a)') repeat('=',67)
IF ( error_h < eps2 ) &
WRITE( stdout,'(5x,"IBTE is converged with value for hole mobility of",1E18.6," "/)'), mobilityh_save
WRITE( stdout,'(5x,"IBTE is converged with value for hole mobility of",1E18.6," "/)') mobilityh_save
IF ( error_h < eps2 ) WRITE(stdout,'(5x,a)') repeat('=',67)
ENDIF
IF (int_mob .OR. (ncarrier > 1E5)) THEN
IF ( error_el < eps2 ) WRITE(stdout,'(5x,a)') repeat('=',67)
IF ( error_el < eps2 ) &
WRITE( stdout,'(5x,"IBTE is converged with value for electron mobility of",1E18.6," "/)'), mobilityel_save
WRITE( stdout,'(5x,"IBTE is converged with value for electron mobility of",1E18.6," "/)') mobilityel_save
IF ( error_el < eps2 ) WRITE(stdout,'(5x,a)') repeat('=',67)
ENDIF
!
......@@ -887,7 +880,7 @@
WRITE(stdout,'(5x,"Start solving iterative Boltzmann Transport Equation")')
WRITE(stdout,'(5x,a/)') repeat('=',67)
ENDIF
WRITE(stdout,'(/5x,"Iteration number:", i10," "/)'), iter
WRITE(stdout,'(/5x,"Iteration number:", i10," "/)') iter
!
IF (nstemp > 1) CALL errore('ephwann_shuffle', &
'Iterative BTE can only be done at 1 temperature, nstemp = 1.',1)
......@@ -1538,8 +1531,6 @@
!
IF (a2f) CALL eliashberg_a2f
!
! If scattering_read continue here
700 continue
! if scattering is read then Fermi level and scissor have not been computed.
IF (scatread) THEN
IF (ABS(scissor) > 0.000001) THEN
......@@ -1595,7 +1586,6 @@
SUBROUTINE epw_write
!-------------------------------------------
!
USE kinds, ONLY : DP
USE epwcom, ONLY : nbndsub, vme, eig_read, etf_mem
USE pwcom, ONLY : ef, nelec, isk
USE elph2, ONLY : nrr_k, nrr_q, chw, rdw, cdmew, cvmew, chw_ks, &
......@@ -1614,7 +1604,7 @@
!
implicit none
LOGICAL :: exst
INTEGER :: ibnd, jbnd, jmode, imode, irk, irq, ipol, i, lrepmatw
INTEGER :: ibnd, jbnd, jmode, imode, irk, irq, ipol, lrepmatw
CHARACTER (len=256) :: filint
!
WRITE(6,'(/5x,"Writing Hamiltonian, Dynamical matrix and EP vertex in Wann rep to file"/)')
......@@ -1694,10 +1684,9 @@
!---------------------------------
SUBROUTINE epw_read()
!---------------------------------
USE kinds, ONLY : DP
USE epwcom, ONLY : nbndsub, vme, eig_read, etf_mem, lifc
USE pwcom, ONLY : ef
USE elph2, ONLY : nrr_k, nrr_q, chw, rdw, ifc, epmatwp, &
USE elph2, ONLY : nrr_k, nrr_q, chw, rdw, epmatwp, &
cdmew, cvmew, chw_ks, zstar, epsi
USE ions_base, ONLY : nat
USE phcom, ONLY : nmodes
......@@ -1718,7 +1707,7 @@
LOGICAL :: exst
CHARACTER (len=256) :: filint
INTEGER :: ibnd, jbnd, jmode, imode, irk, irq, &
ipol, ios, i, lrepmatw
ipol, ios, lrepmatw
!
WRITE(stdout,'(/5x,"Reading Hamiltonian, Dynamical matrix and EP vertex in Wann rep from file"/)')
call flush(6)
......@@ -2128,16 +2117,14 @@
USE cell_base, ONLY : omega, alat, at
USE kinds, ONLY : DP
USE io_global, ONLY : stdout
USE elph2, ONLY : ibndmax, ibndmin, etf, nkf, wkf
USE elph2, ONLY : etf, nkf, wkf
USE constants_epw, ONLY : ryd2ev, bohr2ang, ang2cm
USE noncollin_module, ONLY : noncolin
USE pwcom, ONLY : nelec
USE epwcom, ONLY : int_mob, nbndsub, nbndskip, scissor, ncarrier, &
USE epwcom, ONLY : int_mob, nbndsub, ncarrier, &
system_2d, carrier
USE mp, ONLY : mp_barrier, mp_sum, mp_max, mp_min
USE mp_global, ONLY : inter_pool_comm
USE mp_world, ONLY : mpime
USE io_global, ONLY : ionode_id
!
IMPLICIT NONE
!
......@@ -2193,6 +2180,8 @@
REAL(DP), PARAMETER :: eps= 1.0d-5
!! Tolerence to be converged [relative]
!
Ef = 0.0d0
!
inv_cell = 1.0d0/omega
! for 2d system need to divide by area (vacuum in z-direction)
IF ( system_2d ) &
......
......@@ -33,7 +33,7 @@
USE start_k, ONLY : nk1, nk2, nk3
USE ions_base, ONLY : nat, amass, ityp, tau
USE phcom, ONLY : nq1, nq2, nq3, nmodes
USE epwcom, ONLY : nbndsub, lrepmatf, fsthick, epwread, longrange, &
USE epwcom, ONLY : nbndsub, fsthick, epwread, longrange, &
epwwrite, ngaussw, degaussw, lpolar, lifc, lscreen, &
nbndskip, parallel_k, parallel_q, scr_typ, &
elecselfen, phonselfen, nest_fn, a2f, specfun_ph, &
......@@ -44,7 +44,7 @@
nqf2, nqf3, mp_mesh_k, restart, ncarrier, plselfen, &
specfun_pl
USE noncollin_module, ONLY : noncolin
USE constants_epw, ONLY : ryd2ev, ryd2mev, one, two, eps2, eps4, zero, czero, &
USE constants_epw, ONLY : ryd2ev, ryd2mev, one, two, eps2, zero, czero, &
twopi, ci, kelvin2eV
USE io_files, ONLY : prefix, diropn, tmp_dir
USE io_global, ONLY : stdout, ionode
......@@ -52,11 +52,11 @@
iunepmatwp, crystal, iunepmatwp2
USE elph2, ONLY : nrr_k, nrr_q, cu, cuq, lwin, lwinq, irvec, ndegen_k,&
ndegen_q, wslen, chw, chw_ks, cvmew, cdmew, rdw, &
epmatwp, epmatq, wf, etf, etf_k, etf_ks, xqf, xkf, &
epmatq, wf, etf, etf_k, etf_ks, xqf, xkf, &
wkf, dynq, nqtotf, nkqf, epf17, nkf, nqf, et_ks, &
ibndmin, ibndmax, lambda_all, dmec, dmef, vmef, &
sigmai_all, sigmai_mode, gamma_all, epsi, zstar, &
efnew, ifc, sigmar_all, zi_all, nkqtotf, eps_rpa, &
efnew, sigmar_all, zi_all, nkqtotf, eps_rpa, &
nkqtotf, sigmar_all, zi_allvb, inv_tau_all, Fi_all, &
F_current, F_SERTA, inv_tau_allcb, zi_allcb
USE transportcom, ONLY : transp_temp, mobilityh_save, mobilityel_save, lower_bnd, &
......@@ -85,8 +85,6 @@
!! Skipping band during the Wannierization
LOGICAL :: exst
!! If the file exist
LOGICAL :: opnd
!! Check whether the file is open.
LOGICAL :: first_cycle
!! Check wheter this is the first cycle after a restart.
LOGICAL :: first_time
......@@ -94,8 +92,6 @@
!
CHARACTER (len=256) :: filint
!! Name of the file to write/read
CHARACTER (len=256) :: nameF
!! Name of the file
CHARACTER (len=30) :: myfmt
!! Variable used for formatting output
!
......@@ -125,12 +121,8 @@
!! counter on mode
INTEGER :: fermicount
!! Number of states at the Fermi level
INTEGER :: nrec
!! record index when reading file
INTEGER :: lrepmatw
!! record length while reading file
INTEGER :: i
!! Index when writing to file
INTEGER :: ikx
!! Counter on the coase k-grid
INTEGER :: ikfx
......@@ -796,13 +788,13 @@
IF (int_mob .OR. (ncarrier < 1E5)) THEN
IF ( error_h < eps2 ) WRITE(stdout,'(5x,a)') repeat('=',67)
IF ( error_h < eps2 ) &
WRITE( stdout,'(5x,"IBTE is converged with value for hole mobility of",1E18.6," "/)'), mobilityh_save
WRITE( stdout,'(5x,"IBTE is converged with value for hole mobility of",1E18.6," "/)') mobilityh_save
IF ( error_h < eps2 ) WRITE(stdout,'(5x,a)') repeat('=',67)
ENDIF
IF (int_mob .OR. (ncarrier > 1E5)) THEN
IF ( error_el < eps2 ) WRITE(stdout,'(5x,a)') repeat('=',67)
IF ( error_el < eps2 ) &
WRITE( stdout,'(5x,"IBTE is converged with value for electron mobility of",1E18.6," "/)'), mobilityel_save
WRITE( stdout,'(5x,"IBTE is converged with value for electron mobility of",1E18.6," "/)') mobilityel_save
IF ( error_el < eps2 ) WRITE(stdout,'(5x,a)') repeat('=',67)
ENDIF
!
......@@ -827,7 +819,7 @@
WRITE(stdout,'(5x,"Start solving iterative Boltzmann Transport Equation")')
WRITE(stdout,'(5x,a/)') repeat('=',67)
ENDIF
WRITE(stdout,'(/5x,"Iteration number:", i10," "/)'), iter
WRITE(stdout,'(/5x,"Iteration number:", i10," "/)') iter
!
IF (nstemp > 1) CALL errore('ephwann_shuffle', &
'Iterative BTE can only be done at 1 temperature, nstemp = 1.',1)
......@@ -1312,8 +1304,6 @@
!
IF (a2f) CALL eliashberg_a2f
!
! If scattering_read continue here
700 continue
! if scattering is read then Fermi level and scissor have not been computed.
IF (scatread) THEN
IF (ABS(scissor) > 0.000001) THEN
......
......@@ -25,7 +25,6 @@
USE constants, ONLY : tpi
USE cell_base, ONLY : tpiba2, tpiba, bg, omega
USE klist, ONLY : ngk, igk_k, nkstot
USE constants_epw, ONLY : zero
USE gvecw, ONLY : ecutwfc
USE gvect, ONLY : eigts1, eigts2, eigts3, g, ngm
USE atom, ONLY : msh, rgrid
......
......@@ -68,7 +68,7 @@
USE partial, ONLY : atomo, nat_todo
USE constants, ONLY : AMU_RY
USE mp_global, ONLY : my_pool_id, me_pool
USE io_global, ONLY : meta_ionode, meta_ionode_id, ionode, ionode_id, stdout
USE io_global, ONLY : meta_ionode, meta_ionode_id
#if defined(__NAG)
USE F90_UNIX_ENV, ONLY : iargc, getarg
#endif
......@@ -279,9 +279,6 @@
! meff : Density of state effective mass (in unit of the electron mass)
! epsiHEG : Dielectric constant at zero doping
!
CHARACTER (LEN=80) :: input_file
INTEGER :: nargs, iiarg, ierr
!
nk1tmp = 0
nk2tmp = 0
nk3tmp = 0
......@@ -727,7 +724,6 @@
IF (nat_todo.NE.0) THEN
IF (meta_ionode)read (5, *, iostat = ios) (atomo (na), na = 1, nat_todo)
CALL mp_bcast(ios, meta_ionode_id, world_comm )
700 CALL errore ('epw_readin', 'reading atomo', abs (ios) )
CALL mp_bcast(atomo, meta_ionode_id, world_comm )
ENDIF
800 continue
......
......@@ -43,7 +43,6 @@
USE control_lr, ONLY : alpha_pv, nbnd_occ
USE gamma_gamma, ONLY : has_equivalent, asr, nasr, n_diff_sites, &
equiv_atoms, n_equiv_atoms, with_symmetry
USE partial, ONLY : done_irr
USE modes, ONLY : u, npertx, npert, nirr, nmodes, num_rap_mode
USE lr_symm_base, ONLY : gi, gimq, irotmq, minus_q, nsymq, invsymq, rtau
USE qpoint, ONLY : xq
......@@ -78,12 +77,8 @@
!! counter on k points
INTEGER :: ipol
!! counter on bands
INTEGER :: mu
!! counter on polarizations
INTEGER :: irr
!! the starting mode
INTEGER :: ipert
!! counter on representation and perturbat
INTEGER :: na
!! counter on atoms
INTEGER :: it
......@@ -429,7 +424,6 @@
!! Setup in the case of a restart
!!
! ----------------------------------------------------------------------
USE kinds, ONLY : DP
USE constants_epw, ONLY : zero
USE io_global, ONLY : ionode_id
USE mp_global, ONLY : world_comm
......
......@@ -28,7 +28,7 @@
!--------------------------------------------------------------------------
!
USE kinds, ONLY : DP
USE constants_epw, ONLY : twopi, ci, czero, cone
USE constants_epw, ONLY : czero, cone
!
implicit none
!
......
......@@ -18,7 +18,77 @@
USE io_global, ONLY : ionode_id
USE elph2, ONLY : F_current, ibndmax, ibndmin
USE transportcom, ONLY : lower_bnd, upper_bnd, mobilityh_save, mobilityel_save
USE constants_epw, ONLY : upper_bnd < nktotf ) F_current(:,:,upper_bnd+1:nktotf) = zero
USE constants_epw, ONLY : zero
!
IMPLICIT NONE
!
INTEGER, INTENT(IN) :: iter
!! Iteration number
INTEGER, INTENT(INOUT) :: iq
!! Current q-point
INTEGER, INTENT(IN) :: nqtotf
!! Total number of q-points
INTEGER, INTENT(IN) :: nktotf
!! Total number of k-points
REAL(kind=DP), INTENT(IN) :: error_h
!! Error in the hole mobility
REAL(kind=DP), INTENT(IN) :: error_el
!! Error in the electron mobility
!
! Local variable
LOGICAL :: exst
!!
INTEGER :: i
!! Running index for the vector
INTEGER :: lfi_all
!! Length of the vector
INTEGER :: ik
!! k-point index
INTEGER :: ibnd
!! band index
INTEGER :: idir
!! Direction index
!
REAL(KIND=DP) :: aux ( 3 * (ibndmax-ibndmin+1) * nktotf + 7 )
!! Vector to store the array
!
!WRITE(stdout,'(/5x,"Writing F_current to F_restart file"/)')
!
IF (mpime.eq.ionode_id) THEN
!
lfi_all = 3* (ibndmax-ibndmin+1) * nktotf +3
! First element is the iteration number
aux(1) = iter
! Current q-point number
aux(2) = iq -1 ! -1 because we will start at the next one.
! Total number of q-points
aux(3) = nqtotf
! Value of the previous h mobility (used for error evaluation)
aux(4) = mobilityh_save
! Value of the previous el mobility (used for error evaluation)
aux(5) = mobilityel_save
! Error in the hole mobility
aux(6) = error_h
! Error in the electron mobility
aux(7) = error_el
!
i = 7
DO ik=1, nktotf
DO ibnd=1, (ibndmax-ibndmin+1)
DO idir=1,3
i = i +1
aux(i) = F_current(idir,ibnd, ik)
ENDDO
ENDDO
ENDDO
CALL diropn (iufilFi_all, 'F_restart', lfi_all, exst)
CALL davcio ( aux, lfi_all, iufilFi_all, 1, +1 )
CLOSE(iufilFi_all)
ENDIF
!
! Make everythin 0 except the range of k-points we are working on
IF (lower_bnd > 1 ) F_current(:,:,1:lower_bnd-1) = zero
IF (upper_bnd < nktotf ) F_current(:,:,upper_bnd+1:nktotf) = zero
!
!----------------------------------------------------------------------------
END SUBROUTINE F_write
......@@ -280,7 +350,7 @@
!! Temperature in Ry (this includes division by kb)
REAL(KIND=DP), INTENT(IN) :: ef0
!! Fermi level for the temperature itemp
REAL(KIND=DP), INTENT(out) :: etf_all(bndsub, nkqtotf/2)
REAL(KIND=DP), INTENT(out) :: etf_all(nbndsub, nkqtotf/2)
!! Eigen-energies on the fine grid collected from all pools in parallel case
! REAL(KIND=DP), INTENT(out) :: inv_tau_all(nstemp,ibndmax-ibndmin+1, nkqtotf/2)
!! Total scattering rate on all k-points collected from all pools in parallel case
......
......@@ -122,8 +122,7 @@
!! lower_bnd= 11 and upper_bnd=19 for the second pool
!-----------------------------------------------------------------------
!
USE mp_global, ONLY: my_pool_id, npool
USE mp_images, ONLY: nimage, nproc_image, me_image, my_image_id
USE mp_images, ONLY: nimage, my_image_id
! number of images, number of processor within an image, index of the proc within an image
!
IMPLICIT NONE
......
......@@ -187,7 +187,6 @@
USE mp_images, ONLY : nproc_image
USE mp, ONLY : mp_barrier, mp_bcast
!
USE mp_world, ONLY : mpime
! m
implicit none
!
......
......@@ -27,7 +27,6 @@
USE io_global, ONLY : ionode_id, meta_ionode
USE mp_global, ONLY : inter_pool_comm
USE mp, ONLY : mp_sum, mp_barrier, mp_bcast
USE mp_world, ONLY : mpime
implicit none
!
INTEGER, INTENT (in) :: nbnd
......
......@@ -28,7 +28,7 @@
USE elph2, ONLY : ibndmax, ibndmin, etf, &
wkf, xqf, wqf, nkqf, &
nkf, nkqtotf, xqf
USE constants_epw, ONLY : ryd2ev, two, pi
USE constants_epw, ONLY : ryd2ev, two
#if defined(__NAG)
USE f90_unix_io, ONLY : flush
#endif
......@@ -50,10 +50,6 @@
!! Counter on bands
INTEGER :: jbnd
!! Counter on bands
INTEGER :: imode
!! Counter on mode
INTEGER :: nrec
!! Record index for reading the e-f matrix
INTEGER :: fermicount
!! Number of states on the Fermi surface
INTEGER :: ismear
......@@ -209,7 +205,7 @@
USE elph2, ONLY : ibndmax, ibndmin, etf, etf_k, &
wkf, xqf, wqf, nkqf, nqf, nqtotf, &
nkqtotf, xqf, gamma_nest
USE constants_epw, ONLY : ryd2ev, two, pi, zero
USE constants_epw, ONLY : ryd2ev, two, zero
#if defined(__NAG)
USE f90_unix_io, ONLY : flush
#endif
......@@ -234,8 +230,6 @@
!! Counter on bands
INTEGER :: jbnd
!! Counter on bands
INTEGER :: imode
!! Counter on mode
INTEGER :: fermicount
!! Number of states on the Fermi surface
INTEGER :: ismear
......
......@@ -18,7 +18,6 @@
!! Imported the noncolinear case implemented by xlzhang
!!
!-----------------------------------------------------------------------
use mp_global, ONLY : me_pool
use io_files, ONLY : prefix, diropn, seqopn
use units_ph, ONLY : iuwfc
! nwordwfc is the record length for the direct-access file containing
......
......@@ -82,7 +82,7 @@
!
ar = real(a(p))
ai = aimag(a(p))
if ( ( ar .ne. ar ) .or. ( ai .ne. ai ) ) then
if ( ISNAN(ar) .or. ISNAN(ai) ) then
! write(6,*) (z(i),i=1,N)
! write(6,*) (u(i),i=1,N)
! write(6,*) (a(i),i=1,N)
......
......@@ -127,7 +127,6 @@
USE kinds, ONLY : DP
USE mp_global, ONLY : my_pool_id, inter_pool_comm, npool
USE mp, ONLY : mp_barrier, mp_bcast,mp_sum
USE mp_world, ONLY : mpime
implicit none
!
INTEGER, INTENT (in) :: nsize1
......@@ -182,7 +181,6 @@
!! define rest and nbase as in loadkmesh_para subroutine
!!
!--------------------------------------------------------------------
USE kinds, ONLY : DP
USE mp_global, ONLY : my_pool_id, &
inter_pool_comm, kunit,npool, my_pool_id
USE mp, ONLY : mp_barrier, mp_bcast,mp_sum
......@@ -231,7 +229,6 @@
!! define rest and nbase as in loadkmesh_para subroutine
!!
!--------------------------------------------------------------------
USE kinds, ONLY : DP
USE mp_global, ONLY : my_pool_id, &
inter_pool_comm, kunit,npool, my_pool_id
USE mp, ONLY : mp_barrier, mp_bcast,mp_sum
......
......@@ -17,9 +17,8 @@
USE io_global, ONLY : stdout
USE phcom, ONLY : nmodes
USE epwcom, ONLY : nbndsub
USE pwcom, ONLY : ef !, nelec, isk
USE elph2, ONLY : etf, ibndmin, ibndmax, nkqf, xqf, nqf, &
nkf, epf17, nqtotf, xkf, nkqtotf, wf
USE elph2, ONLY : etf, ibndmin, ibndmax, nkqf, xqf, &
nkf, epf17, xkf, nkqtotf, wf
USE constants_epw, ONLY : ryd2mev, ryd2ev, two, zero
USE mp, ONLY : mp_barrier, mp_sum
USE mp_global, ONLY : inter_pool_comm
......
......@@ -17,8 +17,7 @@
!--------------------------------------------------------------
USE mp_global,ONLY : inter_pool_comm, world_comm
USE mp, ONLY : mp_bcast,mp_max,mp_min
USE mp_world, ONLY : mpime
use io_global,ONLY : ionode_id, meta_ionode, meta_ionode_id
use io_global,ONLY : meta_ionode, meta_ionode_id
USE kinds, ONLY : DP
use io_epw, ONLY : iukgmap, iukmap
use pwcom, ONLY : nks
......@@ -78,7 +77,6 @@
ngxx = nint (tmp)
#endif
!
!IF (mpime.eq.ionode_id) then
IF (meta_ionode) then
!
open ( unit = iukgmap, file = trim(prefix)//'.kgmap', form = 'formatted',status='old',iostat=ios)
......
......@@ -633,7 +633,6 @@
USE phcom, ONLY : nq1, nq2, nq3
USE io_global, ONLY : stdout
USE io_epw, ONLY : iunifc
USE constants_epw, ONLY : czero
USE noncollin_module, ONLY : noncolin, nspin_mag
USE io_dyn_mat2, ONLY : read_dyn_mat_param, read_dyn_mat_header,&
read_dyn_mat, read_ifc_xml, read_ifc_param
......@@ -647,18 +646,16 @@
!
implicit none
!
LOGICAL :: exst, lpolar_, has_zstar
LOGICAL :: lpolar_, has_zstar
CHARACTER (len=80) :: line
CHARACTER(len=256) :: tempfile
INTEGER :: ipol, ios, i, j, m1,m2,m3, na,nb, &
INTEGER :: ios, i, j, m1,m2,m3, na,nb, &
idum, ibid, jbid, nabid, nbbid, m1bid, m2bid, m3bid, &
ntyp_, nat_, ibrav_, ityp_(nat), nqs
INTEGER, parameter :: ntypx = 10
REAL(kind=DP) :: tau_(3,nat), alat, amass2(ntypx)
CHARACTER(LEN=3), ALLOCATABLE :: atm(:)
REAL(DP), ALLOCATABLE :: m_loc(:,:)
!! he magnetic moments of each atom
COMPLEX(kind=DP) :: sumasr
!
WRITE(stdout,'(/5x,"Reading interatomic force constants"/)')
CALL FLUSH(6)
......
......@@ -33,12 +33,11 @@
! SP: Sucidal. Produce too much data. Only use for debugging.
! USE control_flags, ONLY : iverbosity
USE kfold
USE mp_global, ONLY : my_pool_id,me_pool
!
implicit none
integer :: ngm_g, mill_g( 3, ngm_g ), ig0, ig1, ig2, ig2_guess, i, j, k, &
INTEGER :: ngm_g, mill_g( 3, ngm_g ), ig0, ig1, ig2, ig2_guess, i, j, k, &
notfound, indold, indnew, guess_skip,itoj(ngm_g),jtoi(ngm_g),ig1_use,ig2_use
logical :: tfound
LOGICAL :: tfound
!
! IF (iverbosity.eq.1) then
! WRITE(stdout,*) ' There are ',ng0vec,'inequivalent folding G_0 vectors'
......
......@@ -35,7 +35,7 @@ SUBROUTINE rgd_blk_epw_fine_mem(imode,nq1,nq2,nq3,q,uq,epmat,nmodes,epsil,zeu,bm
USE kinds, ONLY : dp
USE cell_base, ONLY : bg, omega, alat
USE ions_base, ONLY : tau, nat
USE constants_epw, ONLY : twopi, fpi, e2, ci, czero, cone, two, ryd2mev
USE constants_epw, ONLY : twopi, fpi, e2, ci, czero
USE epwcom, ONLY : shortrange, nbndsub
!
implicit none
......@@ -69,8 +69,8 @@ SUBROUTINE rgd_blk_epw_fine_mem(imode,nq1,nq2,nq3,q,uq,epmat,nmodes,epsil,zeu,bm
!
REAL(kind=DP) :: qeq, &! <q+G| epsil | q+G>
arg, zaq, g1, g2, g3, gmax, alph, geg
INTEGER :: na, ipol, im, m1,m2,m3, nrx1,nrx2,nrx3, imode
COMPLEX(kind=DP) :: fac, facqd, facq, matsq
INTEGER :: na, ipol, m1,m2,m3, imode
COMPLEX(kind=DP) :: fac, facqd, facq
COMPLEX(kind=DP) :: epmatl(nbndsub,nbndsub)
!
IF (abs(signe) /= 1.0) &
......
......@@ -195,7 +195,7 @@ SUBROUTINE rgd_blk_epw(nq1,nq2,nq3,q,uq,epmat,nmodes,epsil,zeu,bmat,signe)
USE kinds, ONLY : dp
USE cell_base, ONLY : bg, omega, alat
USE ions_base, ONLY : tau, nat
USE constants_epw, ONLY : twopi, fpi, e2, ci, czero, cone, two, ryd2mev
USE constants_epw, ONLY : twopi, fpi, e2, ci, czero, eps12
USE epwcom, ONLY : shortrange
!
implicit none
......@@ -230,10 +230,10 @@ SUBROUTINE rgd_blk_epw(nq1,nq2,nq3,q,uq,epmat,nmodes,epsil,zeu,bmat,signe)
real(DP) :: qeq, &! <q+G| epsil | q+G>
arg, zaq, &
g1, g2, g3, gmax, alph, geg
integer :: na, ipol, im, m1,m2,m3!, nrx1,nrx2,nrx3
complex(dp) :: fac, facqd, facq, epmatl(nmodes), matsq
integer :: na, ipol, m1,m2,m3!, nrx1,nrx2,nrx3
complex(dp) :: fac, facqd, facq, epmatl(nmodes)
!
IF (abs(signe) /= 1.0) &
IF ( ( abs(signe) - 1.0 ) < eps12 ) &
CALL errore ('rgd_blk',' wrong value for signe ',1)
!
gmax= 14.d0
......@@ -343,7 +343,7 @@ SUBROUTINE rgd_blk_epw_fine(nq1,nq2,nq3,q,uq,epmat,nmodes,epsil,zeu,bmat,signe)
USE kinds, ONLY : dp
USE cell_base, ONLY : bg, omega, alat
USE ions_base, ONLY : tau, nat
USE constants_epw, ONLY : twopi, fpi, e2, ci, czero, cone, two, ryd2mev
USE constants_epw, ONLY : twopi, fpi, e2, ci, czero
USE epwcom, ONLY : shortrange, nbndsub
!
implicit none
......@@ -377,11 +377,11 @@ SUBROUTINE rgd_blk_epw_fine(nq1,nq2,nq3,q,uq,epmat,nmodes,epsil,zeu,bmat,signe)
!
REAL(kind=DP) :: qeq, &! <q+G| epsil | q+G>
arg, zaq, g1, g2, g3, gmax, alph, geg
INTEGER :: na, ipol, im, m1,m2,m3, nrx1,nrx2,nrx3, imode
COMPLEX(kind=DP) :: fac, facqd, facq, matsq
INTEGER :: na, ipol, m1,m2,m3, imode
COMPLEX(kind=DP) :: fac, facqd, facq
COMPLEX(kind=DP) :: epmatl(nbndsub,nbndsub,nmodes)
!
IF (abs(signe) /= 1.0) &
IF ( ( abs(signe) - 1.0 ) < eps12 ) &
CALL errore ('rgd_blk',' wrong value for signe ',1)
!
gmax= 14.d0
......@@ -579,7 +579,7 @@ SUBROUTINE tf_epsilon (q, nmodes, epsil, eps_tf)
USE kinds, ONLY : dp
USE cell_base, ONLY : at, bg, omega, alat
</