Commit 621a75d5 authored by paulatto's avatar paulatto

A few changes to have example 3 and 5 working again. The el-ph with wannier...

A few changes to have example 3 and 5 working again. The el-ph with wannier code (the Calandra one) is not working yet, I'll fix it in the next few days.




git-svn-id: http://qeforge.qe-forge.org/svn/q-e/trunk/[email protected] c92efa57-630b-4861-b058-cf58834340f0
parent e070fdc0
......@@ -10,7 +10,7 @@
MODULE dfile_autoname
!----------------------------------------------------------------------
!
PUBLIC :: dfile_choose_name, dfile_generate_name
PUBLIC :: dfile_choose_name, dfile_generate_name, dfile_get_qlist
!
PRIVATE
CHARACTER(len=12),PARAMETER :: dfile_directory_basename='.dfile_dir'
......@@ -173,6 +173,53 @@ END FUNCTION dfile_choose_name
!----------------------------------------------------------------------
!
!----------------------------------------------------------------------
SUBROUTINE dfile_get_qlist(xqs, nqs, name, prefix)
!----------------------------------------------------------------------
! automatically generate a name for fildrho file
USE kinds, ONLY : DP
USE io_global, ONLY : ionode
IMPLICIT NONE
! input variables:
INTEGER,INTENT(in) :: nqs ! max number of points
REAL(DP),INTENT(out) :: xqs(3,nqs)! the q point in cartesian axes
CHARACTER(len=*),INTENT(in) :: prefix ! directory where to operate
CHARACTER(len=*),INTENT(in) :: name ! input fildrho
!
INTEGER :: iunit = -1, ios, iq
CHARACTER(len=256) :: basename
!
! Only ionode scans for the filename, and does NOT broadcast. The broadcast
! must be done outside, because here we do not know which processors are
! calling this subroutine!
!
IF (.not. ionode) THEN
xqs = 0._dp
RETURN
ENDIF
!
IF(name(1:5) == 'auto:') THEN
basename = TRIM(name(6:))
ELSE
basename = TRIM(name)
ENDIF
!
iunit = open_dfile_directory(basename, prefix)
!
GET_Q_LOOP : &
DO iq = 1,nqs
READ(iunit,*,iostat=ios) xqs(:,iq)
IF(ios/=0) THEN
CALL errore('dfile_get_qlist', 'Error while reading q point', iq)
ENDIF
ENDDO &
GET_Q_LOOP
RETURN
!----------------------------------------------------------------------
END SUBROUTINE dfile_get_qlist
!----------------------------------------------------------------------
!
!----------------------------------------------------------------------
FUNCTION dfile_generate_name(xq, name, atx)
!----------------------------------------------------------------------
! automatically generate a name for fildrho file
......@@ -212,7 +259,9 @@ END FUNCTION dfile_generate_name
! 0.25 --> "1o4"
! -1.66666666667 -> "-5/3"
!
!----------------------------------------------------------------------
FUNCTION real2frac(r) RESULT (f)
!----------------------------------------------------------------------
USE kinds, ONLY : DP
IMPLICIT NONE
REAL(DP),INTENT(in) :: r
......@@ -251,57 +300,9 @@ FUNCTION real2frac(r) RESULT (f)
!
RETURN
!
END FUNCTION real2frac
!
#define dfile_generate_name dfile_generate_name2
!----------------------------------------------------------------------
FUNCTION dfile_generate_name(xq, name)
!----------------------------------------------------------------------
! automatically generate a name for fildrho file
USE kinds, ONLY : DP
USE cell_base, ONLY : at
IMPLICIT NONE
! function:
CHARACTER(len=256) :: dfile_generate_name
! input variables:
REAL(DP),INTENT(in) :: xq(3) ! the q point in cartesian axes
CHARACTER(len=*),INTENT(in) :: name ! input fildrho
! local variables:
REAL(DP):: aq(3) ! xq in crystal axes
INTEGER :: iq(3) ! aq*max_finesse, expressed as integers
CHARACTER(len=16) :: n1, n2, n3 ! aux
! parameters:
INTEGER,PARAMETER :: max_finesse = 2**6 * 3**3 * 5**2 * 7 ! = 302400
REAL(DP),PARAMETER :: accep = 1.e-5_dp
! this constants allows grids up to 64*64*64, or 27*27*27 or ... or combinations
! this works as long as max_finesse is a multiple of nq1, nq2 and nq3 (separately)
! IF(name(1:5) /= 'auto:') THEN
! dfile_generate_name = name
! RETURN
! ENDIF
!
! take xq to crystalline coordinates
aq(:) = xq(1)*at(1,:) + xq(2)*at(2,:) + xq(3)*at(3,:)
!
iq(:) = NINT(max_finesse * aq(:))
IF(SUM(ABS(DBLE(iq)-aq*max_finesse)) > DBLE(max_finesse)*accep ) THEN
WRITE(*,*) iq, aq*max_finesse, DBLE(max_finesse)*accep
CALL errore('dfile_generate_name', 'Your grid is too fine for dfile_generate_name: '//&
'increase max_finesse in PH/dfile_autoname.f90', 1)
ENDIF
!
WRITE(n1, '(i16)') iq(1)
WRITE(n2, '(i16)') iq(2)
WRITE(n3, '(i16)') iq(3)
!
WRITE(dfile_generate_name, '(a,".{",a,"}{",a,"}{",a,"}")') TRIM(name), &
TRIM(ADJUSTL(n1)), TRIM(ADJUSTL(n2)), TRIM(ADJUSTL(n3))
!
RETURN
!----------------------------------------------------------------------
END FUNCTION dfile_generate_name
END FUNCTION real2frac
!----------------------------------------------------------------------
#undef dfile_generate_name
!
!----------------------------------------------------------------------
END MODULE dfile_autoname
......
......@@ -256,7 +256,6 @@ SUBROUTINE write_dfile_star(descr, source, nsym, xq, u, nq, sxq, isq, s, sr, inv
USE lsda_mod, ONLY : nspin
USE modes, ONLY : nirr, npert, npertx, rtau
USE units_ph, ONLY : lrdrho
USE output, ONLY : fildrho
USE io_global, ONLY : stdout , ionode, ionode_id
use io_files, ONLY : find_free_unit, diropn, prefix
USE constants, ONLY : tpi
......@@ -421,7 +420,7 @@ SUBROUTINE write_dfile_star(descr, source, nsym, xq, u, nq, sxq, isq, s, sr, inv
! Now I rotate the dvscf
!
ALLOCATE(phase_sxq(nat))
IF (descr%basis == 'modes') CALL allocate_rotated_pattern_repr(rpat, nat, npertx)
CALL allocate_rotated_pattern_repr(rpat, nat, npertx)
!
Q_IN_THE_STAR : &
DO iq=1,nq
......@@ -563,7 +562,7 @@ SUBROUTINE write_dfile_star(descr, source, nsym, xq, u, nq, sxq, isq, s, sr, inv
! Also store drho(-q) if necessary
MINUS_Q : &
IF (dfile_minus_q .and. xq(1)**2+xq(2)**2+xq(3)**2 > 1.d-5 ) THEN
dfile_rot_name = dfile_choose_name(-sxq(:,iq), TRIM(fildrho), &
dfile_rot_name = dfile_choose_name(-sxq(:,iq), TRIM(descr%basename), &
TRIM(descr%directory)//prefix, generate=.true.)
iudfile_rot = find_free_unit()
CALL diropn (iudfile_rot, TRIM(dfile_rot_name), lrdrho, exst, descr%directory)
......@@ -591,7 +590,7 @@ SUBROUTINE write_dfile_star(descr, source, nsym, xq, u, nq, sxq, isq, s, sr, inv
!
DEALLOCATE(dfile_rot, dfile_rot_scr, dfile_at)
DEALLOCATE(phase_sxq)
IF (descr%basis == 'modes') CALL deallocate_rotated_pattern_repr(rpat)
CALL deallocate_rotated_pattern_repr(rpat)
!
RETURN
!----------------------------------------------------------------------------
......
......@@ -40,9 +40,9 @@ subroutine dynmatrix
USE noncollin_module, ONLY : m_loc, nspin_mag
USE output, ONLY : fildyn, fildrho, fildvscf
USE io_dyn_mat, ONLY : write_dyn_mat_header
USE ramanm, ONLY: lraman, ramtns
USE ramanm, ONLY : lraman, ramtns
USE dfile_star, ONLY : write_dfile_star, drho_star, dvscf_star !write_dfile_mq
USE units_ph, ONLY : iudrho
USE units_ph, ONLY : iudrho, iudvscf
implicit none
! local variables
......@@ -166,12 +166,17 @@ subroutine dynmatrix
nq, sxq, isq, imq, iudyn)
! Rotates and write drho_q* (to be improved)
IF (nsym>1) THEN
IF(drho_star%open) THEN
INQUIRE (UNIT = iudrho, OPENED = opnd)
IF (opnd) CLOSE(UNIT = iudrho, STATUS='keep')
CALL write_dfile_star(drho_star, fildrho, nsym, xq, u, nq, sxq, isq, s, sr, invs, irt, ntyp, ityp,(imq==0) )
ELSE
! CALL write_drho_mq(xq, u)
IF (opnd) CLOSE(UNIT = iudrho, STATUS='keep')
CALL write_dfile_star(drho_star, fildrho, nsym, xq, u, nq, sxq, isq, &
s, sr, invs, irt, ntyp, ityp,(imq==0) )
ENDIF
IF(dvscf_star%open) THEN
INQUIRE (UNIT = iudvscf, OPENED = opnd)
IF (opnd) CLOSE(UNIT = iudvscf, STATUS='keep')
CALL write_dfile_star(dvscf_star, fildvscf, nsym, xq, u, nq, sxq, isq, &
s, sr, invs, irt, ntyp, ityp,(imq==0) )
ENDIF
!
! Writes (if the case) results for quantities involving electric field
......
......@@ -155,25 +155,25 @@ SUBROUTINE openfilq()
!
! An optional file for electron-phonon calculations containing deltaVscf
!
400 IF (fildvscf.NE.' ') THEN
400 IF (trim(fildvscf).NE.' ') THEN
iudvscf = 27
IF ( me_pool == 0 ) THEN
IF(dvscf_dir.NE.' ') then
write(stdout,*) 'Reading dvscf file ',trim(adjustl(fildvscf))
write(stdout,*) 'in directory ',trim(adjustl(dvscf_dir))
CALL diropn (iudvscf, fildvscf, lrdrho, exst, dvscf_dir)
ELSE
! IF(trim(dvscf_dir).NE.' ') then
! write(stdout,*) 'Reading dvscf file ',trim(adjustl(fildvscf))
! write(stdout,*) 'in directory ',trim(adjustl(dvscf_dir))
! CALL diropn (iudvscf, fildvscf, lrdrho, exst, dvscf_dir)
! ELSE
CALL diropn (iudvscf, fildvscf, lrdrho, exst )
ENDIF
! ENDIF
IF (okpaw) THEN
filint=TRIM(fildvscf)//'_paw'
lint3paw = 2 * nhm * nhm * 3 * nat * nspin_mag
iuint3paw=34
IF(dvscf_dir.NE.' ') then
CALL diropn (iuint3paw, filint, lint3paw, exst, dvscf_dir)
ELSE
! IF(dvscf_dir.NE.' ') then
! CALL diropn (iuint3paw, filint, lint3paw, exst, dvscf_dir)
! ELSE
CALL diropn (iuint3paw, filint, lint3paw, exst)
ENDIF
! ENDIF
ENDIF
END IF
END IF
......
......@@ -125,7 +125,7 @@ PROGRAM phonon
! calculates dvscf_q' for q' belonging to star{q}
! where q is in the IBZ.
!
IF( dvscf_star ) call open_dvscf_star_q(iq)
!IF( dvscf_star ) call open_dvscf_star_q(iq)
!
! electron-phonon interaction
!
......
......@@ -267,8 +267,8 @@ SUBROUTINE phq_readin()
!
IF (ionode) tmp_dir = trimcheck (outdir)
dvscf_star%directory=trim(dvscf_star%directory)
drho_star%directory=trim(drho_star%directory)
dvscf_star%directory=trim(dvscf_star%directory)
CALL bcast_ph_input ( )
CALL mp_bcast(nogg, ionode_id )
......
......@@ -71,6 +71,14 @@ SUBROUTINE prepare_q(auxdyn, do_band, do_iq, setup_pw, iq)
tmp_dir_phq=tmp_dir_ph
!
IF ( ldisp ) THEN
!
! ... set the q point
!
xq(1:3) = x_q(1:3,iq)
!
! Check if it is lgamma
!
lgamma = ( xq(1) == 0.D0 .AND. xq(2) == 0.D0 .AND. xq(3) == 0.D0 )
!
! ... set the name for the output file
!
......@@ -81,14 +89,6 @@ SUBROUTINE prepare_q(auxdyn, do_band, do_iq, setup_pw, iq)
fildyn = TRIM( auxdyn ) // TRIM( int_to_char( iq ) )
endif
!
! ... set the q point
!
xq(1:3) = x_q(1:3,iq)
!
! Check if it is lgamma
!
lgamma = ( xq(1) == 0.D0 .AND. xq(2) == 0.D0 .AND. xq(3) == 0.D0 )
!
! ... each q /= gamma is saved on a different directory
!
IF (.NOT.lgamma.AND.lqdir) &
......
......@@ -16,6 +16,8 @@ SUBROUTINE q_points_wannier ( )
USE output, ONLY : fildyn
USE control_ph, ONLY : dvscf_dir
USE el_phon, ONLY : wan_index_dyn
USE dfile_autoname, ONLY : dfile_get_qlist
USE dfile_star, ONLY : dvscf_star
implicit none
......@@ -40,17 +42,18 @@ SUBROUTINE q_points_wannier ( )
allocate (x_q(3,nqmax))
allocate(wan_index_dyn(nqs))
!here read q_points
IF (ionode) inquire (file =TRIM(dvscf_dir)//'Q_POINTS.D', exist = exst)
if(.not.exst) call errore('q_points_wannier','Q_POINTS.D not existing in dvscf_dir ',1)
! !here read q_points
CALL dfile_get_qlist(x_q, nqs, dvscf_star%basename, dvscf_star%directory)
! IF (ionode) inquire (file =TRIM(dvscf_dir)//'Q_POINTS.D', exist = exst)
! if(.not.exst) call errore('q_points_wannier','Q_POINTS.D not existing in dvscf_dir ',1)
iq_unit = find_free_unit()
OPEN (unit = iq_unit, file = trim(dvscf_dir)//'Q_POINTS.D', status = 'unknown')
rewind(iq_unit)
do i=1,nqs
read(iq_unit,*) x_q(1,i), x_q(2,i), x_q(3,i), idum, wan_index_dyn(i)
enddo
! iq_unit = find_free_unit()
! OPEN (unit = iq_unit, file = trim(dvscf_dir)//'Q_POINTS.D', status = 'unknown')
! rewind(iq_unit)
! do i=1,nqs
! read(iq_unit,*) x_q(1,i), x_q(2,i), x_q(3,i), idum, wan_index_dyn(i)
! enddo
close(iq_unit)
!
......
Markdown is supported
0%
or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment