Commit a4c80806 authored by sponce's avatar sponce

Additional level of parallelization possible in EPW: band parallelism.

Only available to create the .epb file but can be easily extended. 
Can be accessed using the -nimage parallelization. 


git-svn-id: http://qeforge.qe-forge.org/svn/q-e/trunk/espresso@13171 c92efa57-630b-4861-b058-cf58834340f0
parent a39c166c
......@@ -25,7 +25,7 @@
USE wavefunctions_module, ONLY: evc
USE spin_orb, ONLY : lspinorb
USE control_lr, ONLY : lgamma, nbnd_occ
USE phcom, ONLY : evq, dvpsi, dpsi, vlocq,&
USE phcom, ONLY : evq, dpsi, vlocq,&
dmuxc, npertx
USE phus, ONLY : int1, int1_nc, int2, int2_so, &
int4, int4_nc, int5, int5_so, becsum_nc, &
......@@ -65,9 +65,7 @@
ALLOCATE (evq ( npwx*npol, nbnd))
ENDIF
!
ALLOCATE (dvpsi ( npwx*npol, nbnd))
ALLOCATE ( dpsi ( npwx*npol, nbnd))
!
ALLOCATE (vlocq ( ngm, ntyp))
! SP: nrxx is not used in QE 5 ==> tg_nnr is the maximum among nnr
! This SHOULD have the same dim as nrxx had.
......
This diff is collapsed.
......@@ -24,9 +24,10 @@
USE kfold, ONLY : g0vec_all, ng0vec, shift, g0vec_all_r
! SP: iverbosity cannot be tested here. Generates Tb of data ...
! USE control_flags, ONLY : iverbosity
USE io_global, ONLY : meta_ionode
USE mp_global, ONLY : inter_pool_comm
USE mp, ONLY : mp_barrier
USE mp_world, ONLY : mpime
USE mp_world, ONLY : mpime, world_comm
USE elph2, ONLY : xkq
implicit none
!
......@@ -74,7 +75,7 @@
!
IF (.not. ALLOCATED(xkq) ) ALLOCATE(xkq (3, nkstot) )
!
IF (mpime == 0) THEN
IF (meta_ionode) THEN
!
! the first proc keeps a copy of all kpoints !
!
......@@ -261,7 +262,7 @@
CLOSE ( unit = iukmap )
!
ENDIF
CALL mp_barrier(inter_pool_comm)
CALL mp_barrier(world_comm)
!
END SUBROUTINE createkmap
......@@ -419,7 +420,7 @@
USE pwcom, ONLY : at,bg
USE start_k, ONLY : nk1, nk2, nk3
USE epwcom, ONLY : xk_cryst
USE io_global, ONLY : stdout
USE io_global, ONLY : stdout, meta_ionode
USE io_files, ONLY : prefix
USE gvecs, ONLY : ngms, gcutms, ngms_g
USE gvect, ONLY : gg, ngm, ngm_g, gcutm,&
......@@ -431,9 +432,9 @@
#if defined(__NAG)
USE f90_unix_io, ONLY : flush
#endif
USE mp_global, ONLY : inter_pool_comm
USE mp_global, ONLY : inter_pool_comm, inter_image_comm
USE mp, ONLY : mp_barrier
USE mp_world, ONLY : mpime
USE mp_world, ONLY : mpime, world_comm
!
IMPLICIT NONE
!
......@@ -465,7 +466,8 @@
INTEGER :: nl_2(ngm)
INTEGER :: m1,m2,mc
!
IF (mpime==0) THEN
!IF (mpime==0) THEN
IF (meta_ionode) THEN
eps = 1.d-5
!
iukmap=97 ! unit for the file prefix.kmap
......@@ -599,6 +601,7 @@
END IF
CALL mp_barrier(inter_pool_comm)
CALL mp_barrier(inter_image_comm)
! below are the routines previously found in the modified ggen.f90 code
......@@ -805,6 +808,7 @@ ngms = 0
CALL refold( ngm_g, mill_g, itoj, jtoi )
!
CALL mp_barrier(inter_pool_comm)
CALL mp_barrier(inter_image_comm)
!
DEALLOCATE(ig_l2g,mill_g,igsrt,g2sort_g,jtoi,itoj)
!
......
......@@ -24,8 +24,8 @@
USE kinds, ONLY : DP
USE ions_base, ONLY : nat, ityp
USE cell_base, ONLY : tpiba
USE fft_base, ONLY: dfftp, dffts
USE fft_interfaces, ONLY: fwfft, invfft
USE fft_base, ONLY : dfftp, dffts
USE fft_interfaces, ONLY : fwfft, invfft
USE gvect, ONLY : eigts1, eigts2, eigts3, mill, g, nl, &
ngm
USE gvecs, ONLY : ngms, doublegrid, nls
......@@ -39,7 +39,7 @@
USE eqv, ONLY : dvpsi, dmuxc, vlocq
USE qpoint, ONLY : eigqts, npwq !, ikks
USE klist, ONLY : ngk
USE elph2, ONLY : igkq, igk
USE elph2, ONLY : igkq, igk, lower_band, upper_band
implicit none
!
......@@ -171,7 +171,7 @@
! Now we compute dV_loc/dtau in real space
!
CALL invfft ('Smooth', aux1, dffts)
DO ibnd = 1, nbnd
DO ibnd = lower_band, upper_band
DO ip = 1, npol
aux2(:) = (0.d0, 0.d0)
IF ( ip == 1 ) THEN
......
......@@ -35,7 +35,7 @@
USE phus, ONLY : int1, int1_nc, int2, int2_so, alphap
USE lrus, ONLY : becp1
USE eqv, ONLY : dvpsi
USE elph2, ONLY : igkq
USE elph2, ONLY : igkq, lower_band, upper_band
implicit none
!
......@@ -94,12 +94,12 @@
call start_clock ('dvqpsi_us_on')
if (noncolin) then
allocate (ps1_nc(nkb , npol, nbnd))
allocate (ps2_nc(nkb , npol, nbnd , 3))
allocate (ps1_nc(nkb , npol, lower_band: upper_band))
allocate (ps2_nc(nkb , npol, lower_band: upper_band , 3))
allocate (deff_nc(nhm, nhm, nat, nspin))
else
allocate (ps1 ( nkb , nbnd))
allocate (ps2 ( nkb , nbnd , 3))
allocate (ps1 ( nkb , lower_band: upper_band))
allocate (ps2 ( nkb , lower_band: upper_band , 3))
allocate (deff(nhm, nhm, nat))
end if
allocate (aux ( npwx))
......@@ -114,7 +114,7 @@
ps1(:,:) = (0.d0, 0.d0)
ps2(:,:,:) = (0.d0, 0.d0)
end if
do ibnd = 1, nbnd
do ibnd = lower_band, upper_band
IF (noncolin) THEN
CALL compute_deff_nc(deff_nc,et(ibnd,ik))
ELSE
......@@ -217,10 +217,10 @@
!
if (nkb.gt.0) then
if (noncolin) then
call zgemm ('N', 'N', npwq, nbnd*npol, nkb, &
call zgemm ('N', 'N', npwq, (upper_band-lower_band+1)*npol, nkb, &
(1.d0, 0.d0), vkb, npwx, ps1_nc, nkb, (1.d0, 0.d0) , dvpsi, npwx)
else
call zgemm ('N', 'N', npwq, nbnd, nkb, &
call zgemm ('N', 'N', npwq, (upper_band-lower_band+1), nkb, &
(1.d0, 0.d0) , vkb, npwx, ps1, nkb, (1.d0, 0.d0) , dvpsi, npwx)
end if
end if
......@@ -231,12 +231,12 @@
do ipol = 1, 3
ok = .false.
IF (noncolin) THEN
do ibnd = 1, nbnd
do ibnd = lower_band, upper_band
ok = ok.or.(abs (ps2_nc (ikb, 1, ibnd, ipol) ).gt.eps).or. &
(abs (ps2_nc (ikb, 2, ibnd, ipol) ).gt.eps)
end do
ELSE
do ibnd = 1, nbnd
do ibnd = lower_band, upper_band
ok = ok.or. (abs (ps2 (ikb, ibnd, ipol) ) .gt.eps)
enddo
ENDIF
......@@ -246,7 +246,7 @@
!aux (ig) = vkb(ig, ikb) * (xk(ipol,ikq) + g(ipol, igg) )
aux (ig) = vkb(ig, ikb) * (xxk(ipol) + g(ipol, igg) )
enddo
do ibnd = 1, nbnd
do ibnd = lower_band, upper_band
IF (noncolin) THEN
call zaxpy(npwq,ps2_nc(ikb,1,ibnd,ipol),aux,1,dvpsi(1,ibnd),1)
call zaxpy(npwq,ps2_nc(ikb,2,ibnd,ipol),aux,1, &
......
......@@ -81,7 +81,9 @@
nrr_k, &! number of wigner-seitz points for electrons
nrr_q, &! number of wigner-seitz points for phonons
ibndmin, &! band bounds for slimming down electron-phonon matrix
ibndmax !
ibndmax, &!
lower_band, &! Lower band index for image (band) parallelization
upper_band ! Upper band index for image (band) parallelization
INTEGER, ALLOCATABLE :: &
irvec(:,:), &! crys coordinates of wigner-seitz vectors (both elec and phon)
ndegen(:), &! corresponding degeneragy, electrons (old version)
......
......@@ -56,7 +56,7 @@
!
USE mp_global, ONLY : my_pool_id, nproc_pool, &
intra_pool_comm, &
inter_pool_comm
inter_pool_comm, inter_image_comm, world_comm
USE mp, ONLY : mp_barrier, mp_bcast, mp_put,mp_sum
USE kinds, ONLY : DP
USE io_global, ONLY : stdout
......@@ -78,7 +78,7 @@
USE becmod, ONLY : calbec
USE elph2, ONLY : shift, gmap, el_ph_mat, umat, umatq, igk_k_all, &
umat_all, xk_all, et_all, xkq, etq, igkq, igk, &
ngk_all
ngk_all, lower_band, upper_band
USE fft_base, ONLY : dffts
USE constants_epw, ONLY : czero, cone, ci
USE control_flags, ONLY : iverbosity
......@@ -120,7 +120,7 @@
!! Variables for folding of k+q grid
REAL(kind=DP) :: zero_vect(3)
!!
COMPLEX(kind=DP), ALLOCATABLE :: aux1 (:,:), elphmat (:,:,:), eptmp (:,:), aux2(:,:)
COMPLEX(kind=DP), ALLOCATABLE :: aux1 (:,:), elphmat (:,:,:), eptmp (:,:), aux2(:,:), aux3(:,:)
!DBSP - NAG complains ...
COMPLEX(DP),EXTERNAL :: ZDOTC
!DBSP
......@@ -146,6 +146,11 @@
! find the bounds of k-dependent arrays in the parallel case in each pool
CALL fkbounds( nkstot, lower_bnd, upper_bnd )
!
! SP: Bound for band parallelism
CALL fkbounds_bnd( nbnd, lower_band, upper_band )
!
IF ( .not. ALLOCATED (aux3) ) ALLOCATE ( aux3( npwx*npol, lower_band:upper_band) )
IF ( .not. ALLOCATED (dvpsi) ) ALLOCATE ( dvpsi( npwx*npol, lower_band:upper_band) )
! setup for k+q folding
!
CALL kpointdivision ( ik0 )
......@@ -164,7 +169,8 @@
!
DO ik = 1, nks
!
!DBSP
elphmat(:,:,:) = (0.d0,0.d0)
!DBSP
! c = 0
! b = 0
!END
......@@ -351,24 +357,27 @@
!
! calculate dvscf_q*psi_k
!
aux2=(0.0_DP,0.0_DP)
DO ibnd = 1, nbnd !, incr
CALL start_clock ('dvscf_q*psi_k')
!
aux3=(0.0_DP,0.0_DP)
DO ibnd = lower_band, upper_band
CALL invfft_wave (npw, igk, evc(:, ibnd), aux1)
IF (timerev) THEN
CALL apply_dpot(dffts%nnr, aux1, CONJG(dvscfins(:,:,ipert)),current_spin)
ELSE
CALL apply_dpot(dffts%nnr, aux1, dvscfins(:,:,ipert),current_spin)
ENDIF
CALL fwfft_wave (npwq, igkq, aux2(:, ibnd), aux1)
CALL fwfft_wave (npwq, igkq, aux3(:, ibnd), aux1)
ENDDO
dvpsi=dvpsi+aux2
!DBSP
! c = c+SUM((REAL(REAL(dvpsi(:,:))))**2)+SUM((REAL(AIMAG(dvpsi(:,:))))**2)
dvpsi=dvpsi+aux3
!BSP
!c = c+SUM((REAL(REAL(dvpsi(:,:))))**2)+SUM((REAL(AIMAG(dvpsi(:,:))))**2)
!END
!
! calculate elphmat(j,i)=<psi_{k+q,j}|dvscf_q*psi_{k,i}> for this pertur
!
DO ibnd =1, nbnd
!
DO ibnd =lower_band, upper_band
DO jbnd = 1, nbnd
elphmat (jbnd, ibnd, ipert) = &
ZDOTC (npwq, evq(1, jbnd), 1, dvpsi(1, ibnd), 1)
......@@ -378,6 +387,10 @@
ENDDO
ENDDO
ENDDO
!
CALL mp_sum(elphmat, intra_pool_comm)
CALL mp_sum(elphmat, inter_image_comm)
!DBSP
! if (ik==2)then
! write(*,*)'SUM dvpsi b ', b
......@@ -421,7 +434,7 @@
!
CALL diropn (iuwfc, 'wfc', lrwfc, exst)
! never remove this barrier - > insures that wfcs are restored to each pool before moving on
CALL mp_barrier(inter_pool_comm)
CALL mp_barrier(world_comm)
!
DEALLOCATE (elphmat, eptmp, aux1, aux2)
DEALLOCATE (gmap, shift)
......
......@@ -20,10 +20,12 @@
!-----------------------------------------------------------------------
!
USE mp_global, ONLY : my_pool_id, inter_pool_comm, root_pool, &
intra_pool_comm,npool
intra_pool_comm,npool, inter_image_comm,&
world_comm
USE mp_images, ONLY : my_image_id, nimage
USE mp_world, ONLY : mpime
USE mp, ONLY : mp_barrier, mp_bcast
USE io_global, ONLY : ionode_id
USE io_global, ONLY : meta_ionode, meta_ionode_id
USE us, ONLY : nqxq, dq, qrad
USE gvect, ONLY : gcutm
USE cellmd, ONLY : cell_factor
......@@ -32,7 +34,7 @@
USE wavefunctions_module, ONLY: evc
USE ions_base, ONLY : nat, nsp, tau, ityp
USE control_flags, ONLY : iverbosity
USE io_global, ONLY : stdout, ionode
USE io_global, ONLY : stdout
USE io_epw, ONLY : iuepb
USE kinds, ONLY : DP
USE pwcom, ONLY : et, xk, nks, nbnd, nkstot, ngm
......@@ -189,19 +191,17 @@
!
! READ qpoint list from stdin
!
IF (mpime.eq.ionode_id) READ(5,*) nqc_irr
CALL mp_bcast (nqc_irr, ionode_id, inter_pool_comm)
CALL mp_bcast (nqc_irr, root_pool, intra_pool_comm)
IF (meta_ionode) READ(5,*) nqc_irr
CALL mp_bcast (nqc_irr, meta_ionode_id, world_comm)
allocate ( xqc_irr(3,nqc_irr), wqlist_irr(nqc_irr) )
allocate ( xqc(3,nq1*nq2*nq3), wqlist(nq1*nq2*nq3) )
!
IF (mpime.eq.ionode_id) then
IF (meta_ionode) then
DO iq = 1, nqc_irr
READ (5,*) xqc_irr (:,iq), wqlist_irr (iq)
ENDDO
ENDIF
CALL mp_bcast (xqc_irr, ionode_id, inter_pool_comm)
CALL mp_bcast (xqc_irr, root_pool, intra_pool_comm)
CALL mp_bcast (xqc_irr, meta_ionode_id, world_comm)
!
! fix for uspp
maxvalue = nqxq
......@@ -231,7 +231,7 @@
et_ks(:,:) = 0.d0
et_mb(:,:) = 0.d0
IF (eig_read) then
IF (mpime.eq.ionode_id) THEN
IF (meta_ionode) THEN
WRITE (stdout,'(5x,a,i5,a,i5,a)') "Reading external electronic eigenvalues (", &
nbnd, ",", nkstot,")"
tempfile=trim(prefix)//'.eig'
......@@ -248,8 +248,7 @@
! from eV to Ryd
et_tmp = et_tmp / ryd2ev
ENDIF
CALL mp_bcast (et_tmp, ionode_id, inter_pool_comm)
CALL mp_bcast (et_tmp, root_pool, intra_pool_comm)
CALL mp_bcast (et_tmp, meta_ionode_id, world_comm)
!
CALL ckbounds(ik_start, ik_stop)
et_ks(:,:) = et(:,1:nks)
......@@ -288,6 +287,7 @@
ENDIF
!
CALL mp_barrier(inter_pool_comm)
CALL mp_barrier(inter_image_comm)
!
! Do not do symmetry stuff
IF ( epwread .and. .not. epbread ) then
......@@ -348,7 +348,7 @@
!
IF (u_from_file) THEN
ierr=0
IF ( ionode ) THEN
IF ( meta_ionode ) THEN
!
! ... look for an empty unit (only ionode needs it)
!
......@@ -365,7 +365,7 @@
BINARY = .FALSE., IERR = ierr )
CALL read_modes(iunpun,iq_irr, ierr )
IF (ierr /= 0) CALL errore('epw_setup', 'problem with modes file',1)
IF (ionode) CALL iotk_close_read( iunpun )
IF (meta_ionode) CALL iotk_close_read( iunpun )
ENDIF
!
WRITE(stdout,'(//5x,a)') repeat('=',67)
......@@ -426,20 +426,14 @@
CALL sgam_ph_new (at, bg, nsym, s, irt, tau, rtau, nat)
!
IF ( .not. allocated(sumr) ) allocate ( sumr(2,3,nat,3) )
IF (mpime.eq.ionode_id) THEN
IF (meta_ionode) THEN
CALL readmat_shuffle2 ( iq_irr, nqc_irr, nq, iq_first, sxq, imq,isq,&
invs, s, irt, rtau)
ENDIF
CALL mp_barrier(inter_pool_comm)
CALL mp_barrier(intra_pool_comm)
CALL mp_bcast (zstar, ionode_id, inter_pool_comm)
CALL mp_bcast (zstar, root_pool, intra_pool_comm)
CALL mp_bcast (epsi, ionode_id, inter_pool_comm)
CALL mp_bcast (epsi, root_pool, intra_pool_comm)
CALL mp_bcast (dynq, ionode_id, inter_pool_comm)
CALL mp_bcast (dynq, root_pool, intra_pool_comm)
CALL mp_bcast (sumr, ionode_id, inter_pool_comm)
CALL mp_bcast (sumr, root_pool, intra_pool_comm)
CALL mp_bcast (zstar, meta_ionode_id, world_comm)
CALL mp_bcast (epsi, meta_ionode_id, world_comm)
CALL mp_bcast (dynq, meta_ionode_id, world_comm)
CALL mp_bcast (sumr, meta_ionode_id, world_comm)
!
! now dynq is the cartesian dyn mat (NOT divided by the masses)
!
......@@ -622,6 +616,8 @@
! write(*,*)'epmatq(:,:,2,:,nqc)',SUM(epmatq(:,:,2,:,nqc))
! write(*,*)'epmatq(:,:,2,:,nqc)**2',SUM((REAL(REAL(epmatq(:,:,2,:,nqc))))**2)+&
! SUM((REAL(AIMAG(epmatq(:,:,2,:,nqc))))**2)
! print*,'dynq ', SUM(dynq(:,:,nqc))
! print*,'et ',et(:,2)
!END
! SP: Now we treat separately the case imq == 0
IF (imq .eq. 0) then
......@@ -684,35 +680,46 @@
!
ENDIF
!
IF ( epbread .or. epbwrite ) THEN
!
! write the e-ph matrix elements and other info in the Bloch representation
! (coarse mesh)
! in .epb files (one for each pool)
!
tempfile = trim(tmp_dir) // trim(prefix) // '.epb'
CALL set_ndnmbr (0,my_pool_id+1,1,npool,filelab)
tempfile = trim(tmp_dir) // trim(prefix) // '.epb' // filelab
!
IF (epbread) THEN
inquire(file = tempfile, exist=exst)
IF (.not. exst ) CALL errore( 'elphon_shuffle_wrap', 'epb files not found ', 1)
OPEN (iuepb, file = tempfile, form = 'unformatted')
WRITE(stdout,'(/5x,"Reading epmatq from .epb files"/)')
READ (iuepb) nqc, xqc, et, dynq, epmatq, zstar, epsi
CLOSE (iuepb)
WRITE(stdout,'(/5x,"The .epb files have been correctly read"/)')
ENDIF
!
IF (epbwrite) THEN
OPEN (iuepb, file = tempfile, form = 'unformatted')
WRITE(stdout,'(/5x,"Writing epmatq on .epb files"/)')
WRITE (iuepb) nqc, xqc, et, dynq, epmatq, zstar, epsi
CLOSE (iuepb)
WRITE(stdout,'(/5x,"The .epb files have been correctly written"/)')
!DBSP
IF (my_image_id == 0 ) THEN
IF ( epbread .or. epbwrite ) THEN
!
! write the e-ph matrix elements and other info in the Bloch representation
! (coarse mesh)
! in .epb files (one for each pool)
!
tempfile = trim(tmp_dir) // trim(prefix) // '.epb'
CALL set_ndnmbr (0,my_pool_id+1,1,npool,filelab)
tempfile = trim(tmp_dir) // trim(prefix) // '.epb' // filelab
!
IF (epbread) THEN
inquire(file = tempfile, exist=exst)
IF (.not. exst ) CALL errore( 'elphon_shuffle_wrap', 'epb files not found ', 1)
OPEN (iuepb, file = tempfile, form = 'unformatted')
WRITE(stdout,'(/5x,"Reading epmatq from .epb files"/)')
READ (iuepb) nqc, xqc, et, dynq, epmatq, zstar, epsi
CLOSE (iuepb)
WRITE(stdout,'(/5x,"The .epb files have been correctly read"/)')
ENDIF
!
IF (epbwrite) THEN
OPEN (iuepb, file = tempfile, form = 'unformatted')
WRITE(stdout,'(/5x,"Writing epmatq on .epb files"/)')
WRITE (iuepb) nqc, xqc, et, dynq, epmatq, zstar, epsi
CLOSE (iuepb)
WRITE(stdout,'(/5x,"The .epb files have been correctly written"/)')
ENDIF
ENDIF
ENDIF
!
! In case of image parallelization we want to stop after writing the .epb file
IF (nimage > 1 ) THEN
WRITE(stdout,'(/5x,"Image parallelization. The code will stop now. "/)')
WRITE(stdout,'(/5x,"You need to restart a calculation by reading the .epb "/)')
WRITE(stdout,'(/5x," with pool parallelization only. "/)')
CALL stop_epw
ENDIF
!
IF ( .not.epbread .and. epwread ) THEN
! CV: need dummy nqc, xqc for the ephwann_shuffle call
nqc=1
......@@ -721,7 +728,8 @@
!
ENDIF
!
CALL mp_barrier(inter_pool_comm)
!CALL mp_barrier(inter_pool_comm)
CALL mp_barrier(world_comm)
!
! now dynq is the cartesian dyn mat ( NOT divided by the masses)
! and epmatq is the epmat in cartesian representation (rotation in elphon_shuffle)
......@@ -810,9 +818,9 @@
USE lr_symm_base, ONLY : minus_q, nsymq
USE iotk_module, ONLY : iotk_index, iotk_scan_dat, iotk_scan_begin, &
iotk_scan_end
USE io_global, ONLY : ionode, ionode_id
USE mp_images, ONLY : intra_image_comm
USE io_global, ONLY : meta_ionode, meta_ionode_id
USE mp, ONLY : mp_bcast
USE mp_global, ONLY : world_comm
IMPLICIT NONE
......@@ -821,16 +829,16 @@
INTEGER :: imode0, imode, irr, ipert, iq
!
ierr=0
IF (ionode) THEN
IF (meta_ionode) THEN
CALL iotk_scan_begin( iunpun, "IRREPS_INFO" )
!
CALL iotk_scan_dat(iunpun,"QPOINT_NUMBER",iq)
ENDIF
CALL mp_bcast( iq, ionode_id, intra_image_comm )
CALL mp_bcast( iq, meta_ionode_id, world_comm )
IF (iq /= current_iq) CALL errore('read_modes', &
'problems with current_iq', 1 )
IF (ionode) THEN
IF (meta_ionode) THEN
CALL iotk_scan_dat(iunpun, "QPOINT_GROUP_RANK", nsymq)
CALL iotk_scan_dat(iunpun, "MINUS_Q_SYM", minus_q)
......@@ -860,13 +868,13 @@
!
ENDIF
CALL mp_bcast( nirr, ionode_id, intra_image_comm )
CALL mp_bcast( npert, ionode_id, intra_image_comm )
CALL mp_bcast( nsymq, ionode_id, intra_image_comm )
CALL mp_bcast( minus_q, ionode_id, intra_image_comm )
CALL mp_bcast( u, ionode_id, intra_image_comm )
CALL mp_bcast( name_rap_mode, ionode_id, intra_image_comm )
CALL mp_bcast( num_rap_mode, ionode_id, intra_image_comm )
CALL mp_bcast( nirr, meta_ionode_id, world_comm )
CALL mp_bcast( npert, meta_ionode_id, world_comm )
CALL mp_bcast( nsymq, meta_ionode_id, world_comm )
CALL mp_bcast( minus_q, meta_ionode_id, world_comm )
CALL mp_bcast( u, meta_ionode_id, world_comm )
CALL mp_bcast( name_rap_mode, meta_ionode_id, world_comm )
CALL mp_bcast( num_rap_mode, meta_ionode_id, world_comm )
RETURN
END SUBROUTINE read_modes
......@@ -47,7 +47,7 @@
!
gamma_only = .FALSE.
!
CALL mp_startup()
CALL mp_startup(start_images=.true.)
!
! Display the logo
IF (mpime.eq.ionode_id) then
......
......@@ -16,8 +16,10 @@
!! A second routine readfile reads the variables saved on a file
!! by the self-consistent program.
!!
!! @Note:
!! SP: Image parallelization added
!!
USE ions_base, ONLY : nat, ntyp => nsp
USE io_global, ONLY : ionode_id
USE mp, ONLY : mp_bcast
USE pwcom, ONLY : xqq
USE wvfct, ONLY : nbnd
......@@ -28,8 +30,7 @@
USE qpoint, ONLY : xq
USE disp, ONLY : nq1, nq2, nq3
USE output, ONLY : fildvscf, fildrho
USE epwcom, ONLY : delta_smear, &
nsmear, dis_win_min, dis_win_max, wannierize, &
USE epwcom, ONLY : delta_smear, nsmear, dis_win_min, dis_win_max, wannierize, &
ngaussw, dvscf_dir, eptemp, wdata, &
num_iter, dis_froz_max, fsthick, dis_froz_min, &
vme, degaussw, epexst, eig_read, kmaps, &
......@@ -55,8 +56,6 @@
title, int_mob, scissor, iterative_bte, scattering, &
ncarrier, carrier, scattering_serta, &
scattering_0rta, longrange, shortrange
! USE epwcom, ONLY : tphases, fildvscf0
USE elph2, ONLY : elph
USE start_k, ONLY : nk1, nk2, nk3
USE constants_epw, ONLY : ryd2mev, ryd2ev, ev2cmm1, kelvin2eV
......@@ -68,6 +67,7 @@
USE constants, ONLY : AMU_RY
USE control_lr, ONLY : lgamma
USE mp_global, ONLY : my_pool_id, me_pool
USE io_global, ONLY : meta_ionode, meta_ionode_id, ionode, ionode_id, stdout
#if defined(__NAG)
USE F90_UNIX_ENV, ONLY : iargc, getarg
#endif
......@@ -93,6 +93,7 @@
!! temp vars for saving kgrid info
INTEGER :: nk3tmp
!! temp vars for saving kgrid info
LOGICAL, EXTERNAL :: imatches
character(len=256) :: outdir
namelist / inputepw / &
amass, outdir, prefix, iverbosity, time_max, fildvscf, &
......@@ -259,35 +260,33 @@
nk1tmp = 0
nk2tmp = 0
nk3tmp = 0
IF (me_pool /=0 .or. my_pool_id /=0) goto 400
!
IF (meta_ionode) THEN
!
! ... Input from file ?
CALL input_from_file ( )
!
nargs = iargc()
!
DO iiarg = 1, ( nargs - 1 )
!
CALL getarg( iiarg, input_file )
IF ( TRIM( input_file ) == '-input' .OR. &
TRIM( input_file ) == '-inp' .OR. &
TRIM( input_file ) == '-in' ) THEN
!
CALL getarg( ( iiarg + 1 ) , input_file )
OPEN ( UNIT = 5, FILE = input_file, FORM = 'FORMATTED', &
STATUS = 'OLD', IOSTAT = ierr )
CALL errore( 'iosys', 'input file ' // TRIM( input_file ) // &
& ' not found' , ierr )
!
END IF
!
END DO
! ... Read the first line of the input file
!
READ( 5, '(A)', IOSTAT = ios ) title
!
! Read the first line of the input file
ENDIF
!
CALL mp_bcast(ios, meta_ionode_id, world_comm )
CALL errore( 'epw_readin', 'reading title ', ABS( ios ) )
CALL mp_bcast(title, meta_ionode_id, world_comm )
!
! Rewind the input if the title is actually the beginning of inputph namelist
!
IF( imatches("&inputepw", title) ) THEN
WRITE(*, '(6x,a)') "Title line not specified: using 'default'."
title='default'
IF (meta_ionode) REWIND(5, iostat=ios)
CALL mp_bcast(ios, meta_ionode_id, world_comm )
CALL errore('epw_readin', 'Title line missing from input.', abs(ios))
ENDIF
!
READ (5, '(a)', err = 100, iostat = ios) title
100 CALL errore ('epw_readin', 'reading title ', abs (ios) )
IF (.NOT. meta_ionode) goto 400
!
! set default values for variables in namelist
!
......@@ -433,7 +432,7 @@
ios = 0
#else
!
READ (5, inputepw, err = 200, iostat = ios)