Commit ca9cb630 authored by Marco Govoni's avatar Marco Govoni
Browse files

Spin-polarized

parent fe479930
......@@ -62,7 +62,7 @@ MODULE dfpt_module
!
! Workspace
!
INTEGER :: ipert, ig, ir, ibnd, iks, ikqs, ik, is
INTEGER :: ipert, ig, ir, ibnd, iks, ikqs, ikq, ik, is
INTEGER :: i, j, k
INTEGER :: nbndval, ierr
INTEGER :: npwkq
......@@ -145,7 +145,10 @@ MODULE dfpt_module
!
! ... Find G0 and compute phase
!
CALL k_grid%find( k_grid%p_cart(:,ik) - q_grid%p_cart(:,iq), is, 'cart', ikqs, g0 )
!CALL k_grid%find( k_grid%p_cart(:,ik) - q_grid%p_cart(:,iq), is, 'cart', ikqs, g0 ) !MATTEO
CALL k_grid%find( k_grid%p_cart(:,ik) - q_grid%p_cart(:,iq), 'cart', ikq, g0 ) !MARCO
ikqs = k_grid%ipis2ips(ikq,is) !MARCO
!
CALL compute_phase( g0, 'cart', phase )
!
! ... Number of G vectors for PW expansion of wfs at [k-q]
......
......@@ -50,13 +50,14 @@ MODULE wfreq_db
REAL(DP) :: time_spent(2)
CHARACTER(20),EXTERNAL :: human_readable_time
INTEGER :: iunout,global_j,local_j
INTEGER :: ierr, iks, ib
INTEGER :: ierr, iks, ik, is, ib
CHARACTER(LEN=6) :: my_label_k, my_label_b
!
TYPE(json_file) :: json
INTEGER :: iunit, i
INTEGER :: iunit, i, counter
INTEGER,ALLOCATABLE :: ilist(:)
LOGICAL :: l_generate_plot, l_optics
CHARACTER(LEN=10) :: ccounter
!
! MPI BARRIER
!
......@@ -84,35 +85,60 @@ MODULE wfreq_db
DO ib = qp_bandrange(1),qp_bandrange(2)
ilist(ib) = ib
ENDDO
CALL json%add('output.Q.bandmap',ilist(qp_bandrange(1):qp_bandrange(2)))
!CALL json%add('output.Q.bandmap',ilist(qp_bandrange(1):qp_bandrange(2)))
DEALLOCATE(ilist)
IF( l_generate_plot ) CALL json%add('output.P.freqlist',sigma_freq(1:n_spectralf)*rytoev)
!
counter = 0
DO iks = 1, k_grid%nps
ik = k_grid%ip(iks)
is = k_grid%is(iks)
DO ib = qp_bandrange(1), qp_bandrange(2)
counter = counter + 1
WRITE( ccounter, '(i10)') counter
CALL json%add('output.Q('//TRIM(ADJUSTL(ccounter))//').ksb',(/ik,is,ib/))
CALL json%add('output.Q('//TRIM(ADJUSTL(ccounter))//').sigmax',sigma_exx(ib,iks)*rytoev)
CALL json%add('output.Q('//TRIM(ADJUSTL(ccounter))//').vxcl' ,sigma_vxcl(ib,iks)*rytoev)
CALL json%add('output.Q('//TRIM(ADJUSTL(ccounter))//').vxcnl' ,sigma_vxcnl(ib,iks)*rytoev)
CALL json%add('output.Q('//TRIM(ADJUSTL(ccounter))//').hf' ,sigma_hf(ib,iks)*rytoev)
CALL json%add('output.Q('//TRIM(ADJUSTL(ccounter))//').z' ,sigma_z(ib,iks)*rytoev)
CALL json%add('output.Q('//TRIM(ADJUSTL(ccounter))//').eks' ,et(ib,iks)*rytoev)
CALL json%add('output.Q('//TRIM(ADJUSTL(ccounter))//').eqpLin',sigma_eqplin(ib,iks)*rytoev)
CALL json%add('output.Q('//TRIM(ADJUSTL(ccounter))//').eqpSec',sigma_eqpsec(ib,iks)*rytoev)
CALL json%add('output.Q('//TRIM(ADJUSTL(ccounter))//').sigmac_eks',&
(/DBLE(sigma_sc_eks(ib,iks)*rytoev),AIMAG(sigma_sc_eks(ib,iks)*rytoev)/) )
CALL json%add('output.Q('//TRIM(ADJUSTL(ccounter))//').sigmac_eqpLin',&
(/DBLE(sigma_sc_eqplin(ib,iks)*rytoev),AIMAG(sigma_sc_eqplin(ib,iks)*rytoev)/) )
CALL json%add('output.Q('//TRIM(ADJUSTL(ccounter))//').sigmac_eqpSec',&
(/DBLE(sigma_sc_eqpsec(ib,iks)*rytoev),AIMAG(sigma_sc_eqpsec(ib,iks)*rytoev)/) )
ENDDO
ENDDO
!
DO iks = 1, k_grid%nps
!
WRITE(my_label_k,'(i6.6)') iks_l2g(iks)
!
CALL json%add('output.Q.K'//TRIM(my_label_k)//'.sigmax', sigma_exx(qp_bandrange(1):qp_bandrange(2),iks)*rytoev)
CALL json%add('output.Q.K'//TRIM(my_label_k)//'.vxcl', sigma_vxcl(qp_bandrange(1):qp_bandrange(2),iks)*rytoev)
CALL json%add('output.Q.K'//TRIM(my_label_k)//'.vxcnl', sigma_vxcnl(qp_bandrange(1):qp_bandrange(2),iks)*rytoev)
CALL json%add('output.Q.K'//TRIM(my_label_k)//'.hf', sigma_hf(qp_bandrange(1):qp_bandrange(2),iks)*rytoev)
CALL json%add('output.Q.K'//TRIM(my_label_k)//'.z', sigma_z(qp_bandrange(1):qp_bandrange(2),iks))
CALL json%add('output.Q.K'//TRIM(my_label_k)//'.eks', et(qp_bandrange(1):qp_bandrange(2),iks)*rytoev)
CALL json%add('output.Q.K'//TRIM(my_label_k)//'.eqpLin', sigma_eqplin(qp_bandrange(1):qp_bandrange(2),iks)*rytoev)
CALL json%add('output.Q.K'//TRIM(my_label_k)//'.eqpSec', sigma_eqpsec(qp_bandrange(1):qp_bandrange(2),iks)*rytoev)
CALL json%add('output.Q.K'//TRIM(my_label_k)//'.sigmac_eks.re', &
& DBLE(sigma_sc_eks(qp_bandrange(1):qp_bandrange(2),iks)*rytoev))
CALL json%add('output.Q.K'//TRIM(my_label_k)//'.sigmac_eks.im', &
& AIMAG(sigma_sc_eks(qp_bandrange(1):qp_bandrange(2),iks)*rytoev))
CALL json%add('output.Q.K'//TRIM(my_label_k)//'.sigmac_eqpLin.re', &
& DBLE(sigma_sc_eqplin(qp_bandrange(1):qp_bandrange(2),iks)*rytoev))
CALL json%add('output.Q.K'//TRIM(my_label_k)//'.sigmac_eqpLin.im', &
& AIMAG(sigma_sc_eqplin(qp_bandrange(1):qp_bandrange(2),iks)*rytoev))
CALL json%add('output.Q.K'//TRIM(my_label_k)//'.sigmac_eqpSec.re', &
& DBLE(sigma_sc_eqpsec(qp_bandrange(1):qp_bandrange(2),iks)*rytoev))
CALL json%add('output.Q.K'//TRIM(my_label_k)//'.sigmac_eqpSec.im', &
& AIMAG(sigma_sc_eqpsec(qp_bandrange(1):qp_bandrange(2),iks)*rytoev))
CALL json%add('output.Q.K'//TRIM(my_label_k)//'.sigma_diff', sigma_diff(qp_bandrange(1):qp_bandrange(2),iks)*rytoev)
! !
! CALL json%add('output.Q.K'//TRIM(my_label_k)//'.sigmax', sigma_exx(qp_bandrange(1):qp_bandrange(2),iks)*rytoev)
! CALL json%add('output.Q.K'//TRIM(my_label_k)//'.vxcl', sigma_vxcl(qp_bandrange(1):qp_bandrange(2),iks)*rytoev)
! CALL json%add('output.Q.K'//TRIM(my_label_k)//'.vxcnl', sigma_vxcnl(qp_bandrange(1):qp_bandrange(2),iks)*rytoev)
! CALL json%add('output.Q.K'//TRIM(my_label_k)//'.hf', sigma_hf(qp_bandrange(1):qp_bandrange(2),iks)*rytoev)
! CALL json%add('output.Q.K'//TRIM(my_label_k)//'.z', sigma_z(qp_bandrange(1):qp_bandrange(2),iks))
! CALL json%add('output.Q.K'//TRIM(my_label_k)//'.eks', et(qp_bandrange(1):qp_bandrange(2),iks)*rytoev)
! CALL json%add('output.Q.K'//TRIM(my_label_k)//'.eqpLin', sigma_eqplin(qp_bandrange(1):qp_bandrange(2),iks)*rytoev)
! CALL json%add('output.Q.K'//TRIM(my_label_k)//'.eqpSec', sigma_eqpsec(qp_bandrange(1):qp_bandrange(2),iks)*rytoev)
! CALL json%add('output.Q.K'//TRIM(my_label_k)//'.sigmac_eks.re', &
! & DBLE(sigma_sc_eks(qp_bandrange(1):qp_bandrange(2),iks)*rytoev))
! CALL json%add('output.Q.K'//TRIM(my_label_k)//'.sigmac_eks.im', &
! & AIMAG(sigma_sc_eks(qp_bandrange(1):qp_bandrange(2),iks)*rytoev))
! CALL json%add('output.Q.K'//TRIM(my_label_k)//'.sigmac_eqpLin.re', &
! & DBLE(sigma_sc_eqplin(qp_bandrange(1):qp_bandrange(2),iks)*rytoev))
! CALL json%add('output.Q.K'//TRIM(my_label_k)//'.sigmac_eqpLin.im', &
! & AIMAG(sigma_sc_eqplin(qp_bandrange(1):qp_bandrange(2),iks)*rytoev))
! CALL json%add('output.Q.K'//TRIM(my_label_k)//'.sigmac_eqpSec.re', &
! & DBLE(sigma_sc_eqpsec(qp_bandrange(1):qp_bandrange(2),iks)*rytoev))
! CALL json%add('output.Q.K'//TRIM(my_label_k)//'.sigmac_eqpSec.im', &
! & AIMAG(sigma_sc_eqpsec(qp_bandrange(1):qp_bandrange(2),iks)*rytoev))
! CALL json%add('output.Q.K'//TRIM(my_label_k)//'.sigma_diff', sigma_diff(qp_bandrange(1):qp_bandrange(2),iks)*rytoev)
!
IF( l_generate_plot ) THEN
DO ib = qp_bandrange(1), qp_bandrange(2)
......
......@@ -37,6 +37,7 @@ MODULE class_bz_grid
!
PROCEDURE :: init => k_or_q_grid_init
PROCEDURE :: find => findp
PROCEDURE :: ipis2ips => from_ip_and_is_to_ips ! MARCO
!
END TYPE bz_grid
!
......@@ -90,7 +91,8 @@ MODULE class_bz_grid
!
ALLOCATE ( this%p_cryst (3,this%np) )
this%p_cryst(:,:) = this%p_cart(:,:)
CALL cryst_to_cart( this%nps, this%p_cryst, at, -1 )
!CALL cryst_to_cart( this%nps, this%p_cryst, at, -1 ) !MATTEO
CALL cryst_to_cart( this%np, this%p_cryst, at, -1 ) !MARCO
!
! set weights
!
......@@ -168,7 +170,8 @@ MODULE class_bz_grid
!
!
!FUNCTION findp(this,p,unit_type) RESULT(ip)
SUBROUTINE findp( this, p, is, unit_type, ip, g0 )
!SUBROUTINE findp( this, p, is, unit_type, ip, g0 ) !MATTEO
SUBROUTINE findp( this, p, unit_type, ip, g0 ) !MARCO
!
! ... ip is the index of p (unit_type = [ "cryst", "cart"])
! ... if on exit ip == 0 --> p is not commensurate with this grid
......@@ -183,7 +186,7 @@ MODULE class_bz_grid
!
CLASS(bz_grid), INTENT(IN) :: this
REAL(DP), INTENT(IN) :: p(3)
INTEGER, INTENT(IN) :: is
!INTEGER, INTENT(IN) :: is !MATTEO
CHARACTER(LEN=*), INTENT(IN) :: unit_type
INTEGER, INTENT(OUT) :: ip
REAL(DP), INTENT(OUT) :: g0(3)
......@@ -203,15 +206,23 @@ MODULE class_bz_grid
!
IF ( unit_type == "cart" ) CALL cryst_to_cart( 1, p, at, -1 )
!
ip = 0
DO i = 1, this%np
deltap(:) = p(:) - this%p_cryst(:,i) - NINT( p(:) - this%p_cryst(:,i) )
IF ( ALL ( ABS ( deltap ) .LT. eps8 ) ) THEN
ip = i + (is-1) * this%np
g0(:) = p(:) - this%p_cryst(:,ip)
EXIT
ENDIF
ENDDO
ip = 0
!DO i = 1, this%np !MATTEO
! deltap(:) = p(:) - this%p_cryst(:,i) - NINT( p(:) - this%p_cryst(:,i) ) !MATTEO
! IF ( ALL ( ABS ( deltap ) .LT. eps8 ) ) THEN !MATTEO
! ip = i + (is-1) * this%np !MATTEO
! g0(:) = p(:) - this%p_cryst(:,ip) !MATTEO
! EXIT !MATTEO
! ENDIF !MATTEO
!ENDDO !MATTEO
DO i = 1, this%np !MARCO
deltap(:) = p(:) - this%p_cryst(:,i) - NINT( p(:) - this%p_cryst(:,i) ) !MARCO
IF ( ALL ( ABS ( deltap ) .LT. eps8 ) ) THEN !MARCO
g0(:) = p(:) - this%p_cryst(:,i) !MARCO
ip=i !MARCO
EXIT !MARCO
ENDIF !MARCO
ENDDO !MARCO
!
! Tranform g0 back to cartesian coordinates if needed
!
......@@ -241,6 +252,21 @@ MODULE class_bz_grid
END SUBROUTINE
!
!
FUNCTION from_ip_and_is_to_ips(this,ip,is) RESULT(ips) !MARCO
! !MARCO
IMPLICIT NONE !MARCO
! !MARCO
! I/O !MARCO
! !MARCO
CLASS(bz_grid), INTENT(IN) :: this !MARCO
INTEGER, INTENT(IN) :: ip,is !MARCO
INTEGER :: ips !MARCO
! !MARCO
ips = ip + (is-1) * this%np ! CI MANCHI MATTEO !MARCO
! !MARCO
END FUNCTION !MARCO
!
!
!SUBROUTINE addp( this, pin1, pin2, pout, g0, unit_type )
! !
! ! ... out : pout and g0
......
......@@ -28,7 +28,7 @@ SUBROUTINE do_setup
USE constants, ONLY : rytoev
USE control_flags, ONLY : gamma_only
USE noncollin_module, ONLY : noncolin,npol
USE cell_base, ONLY : omega,celldm,at
USE cell_base, ONLY : omega,celldm,at,bg,tpiba
USE fft_base, ONLY : dfftp,dffts
USE gvecs, ONLY : ngms_g, ngms
USE gvect, ONLY : ngm_g, ngm, ecutrho
......@@ -43,7 +43,7 @@ SUBROUTINE do_setup
TYPE(json_file) :: json
INTEGER :: iunit
INTEGER :: auxi,ib
INTEGER :: ipol,ik,iq,npwx_g, nkbl, nkl, nkr, iks, ike, spin, ip
INTEGER :: ipol,ik,iq,npwx_g, nkbl, nkl, nkr, iks, ike, spin, ip, is
INTEGER,ALLOCATABLE :: ngm_i(:), npw_i(:)
INTEGER, ALLOCATABLE :: ngk_g(:)
! REAL(DP) :: xkg(3)
......@@ -182,60 +182,53 @@ SUBROUTINE do_setup
!
alat = celldm(1)
!
WRITE( stdout, '(/5x,"sFFT : (",i4,",",i4,",",i4,")")') dffts%nr1, dffts%nr2, dffts%nr3
WRITE( stdout, '(/5x,"pFFT : (",i4,",",i4,",",i4,")")') dfftp%nr1, dfftp%nr2, dfftp%nr3
WRITE( stdout, '(/5x,"Cell [a.u.] = ",3f14.6)') alat*at(1,1:3)
WRITE( stdout, '( 5x," = ",3f14.6)') alat*at(2,1:3)
WRITE( stdout, '( 5x," = ",3f14.6)') alat*at(3,1:3)
WRITE( stdout, '(/5x,"3DFFT grid")')
WRITE( stdout, '( 8x,"s : (",i4,",",i4,",",i4,")")') dffts%nr1, dffts%nr2, dffts%nr3
WRITE( stdout, '( 8x,"p : (",i4,",",i4,",",i4,")")') dfftp%nr1, dfftp%nr2, dfftp%nr3
WRITE( stdout, '(/5x,"Direct Lattice Cell [a.u.]")')
WRITE( stdout, '( 8x,"a1 = (",3f14.7,")")') alat*at(1:3,1)
WRITE( stdout, '( 8x,"a2 = (",3f14.7,")")') alat*at(1:3,2)
WRITE( stdout, '( 8x,"a3 = (",3f14.7,")")') alat*at(1:3,3)
WRITE( stdout, '(/5x,"Reciprocal Lattice Cell [a.u.]")')
WRITE( stdout, '( 8x,"b1 = (",3f14.7,")")') tpiba*bg(1:3,1)
WRITE( stdout, '( 8x,"b2 = (",3f14.7,")")') tpiba*bg(1:3,2)
WRITE( stdout, '( 8x,"b3 = (",3f14.7,")")') tpiba*bg(1:3,3)
WRITE( stdout, '( 5x," ")')
IF( mpime == root ) THEN
CALL json%add('system.basis.sFFT',(/ dffts%nr1, dffts%nr2, dffts%nr3 /) )
CALL json%add('system.basis.pFFT',(/ dfftp%nr1, dfftp%nr2, dfftp%nr3 /) )
CALL json%add('system.3dfft.s',(/ dffts%nr1, dffts%nr2, dffts%nr3 /) )
CALL json%add('system.3dfft.p',(/ dfftp%nr1, dfftp%nr2, dfftp%nr3 /) )
CALL json%add('system.cell.a1',alat*at(1:3,1))
CALL json%add('system.cell.a2',alat*at(1:3,2))
CALL json%add('system.cell.a3',alat*at(1:3,3))
CALL json%add('system.cell.b1',tpiba*bg(1:3,1))
CALL json%add('system.cell.b2',tpiba*bg(1:3,2))
CALL json%add('system.cell.b3',tpiba*bg(1:3,3))
CALL json%add('system.cell.alat',alat)
CALL json%add('system.cell.tpiba',tpiba)
ENDIF
!
WRITE( stdout, '(5x,"number of ks points = ",i6)') k_grid%nps
IF( mpime == root ) CALL json%add('system.kpt.nkstot',k_grid%nps)
WRITE( stdout, '(23x,"cart. coord. in units 2pi/alat")')
DO iks = 1, k_grid%nps
ik = k_grid%ip(iks)
WRITE( stdout, '(/5x,"Brillouin Zone sampling [cryst. coord.]")')
WRITE( stdout, * )
DO ik = 1, k_grid%np
WRITE( cik, '(i6)') ik
WRITE( stdout, '(8x,"k(",i5,") = (",3f12.7,"), wk =",f12.7)') iks, &
(k_grid%p_cart(ipol,ik) , ipol = 1, 3) , k_grid%weight(iks)
IF( mpime == root ) CALL json%add('system.kpt.k('//TRIM(ADJUSTL(cik))//').cartcoord:tpiba',k_grid%p_cart(1:3,ik))
IF( mpime == root ) CALL json%add('system.kpt.k('//TRIM(ADJUSTL(cik))//').weight',k_grid%weight(iks))
ENDDO
WRITE( stdout, '(/23x,"cryst. coord.")')
DO iks = 1, k_grid%nps
ik = k_grid%ip(iks)
WRITE( cik, '(i6)') ik
WRITE( stdout, '(8x,"k(",i5,") = (",3f12.7,"), wk =",f12.7)') &
ik, (k_grid%p_cryst(ipol,ik) , ipol = 1, 3) , k_grid%weight(iks)
IF( mpime == root ) CALL json%add('system.kpt.k('//TRIM(ADJUSTL(cik))//').crystcoord',k_grid%p_cryst(1:3,ik))
WRITE( stdout, '(8x,"k(",i6.6,") = (",3f14.7,")")') ik, k_grid%p_cryst(1:3,ik)
IF( mpime == root ) THEN
CALL json%add('system.bzsamp.k('//TRIM(ADJUSTL(cik))//').id',ik)
CALL json%add('system.bzsamp.k('//TRIM(ADJUSTL(cik))//').crystcoord',k_grid%p_cryst(1:3,ik))
ENDIF
ENDDO
!
! q-point grid
!
IF (.NOT. gamma_only ) THEN
WRITE( stdout, * )
WRITE( stdout, '(5x,"number of q points = ",i6)') q_grid%np
IF( mpime == root ) CALL json%add('system.qpt.nqtot',q_grid%np)
WRITE( stdout, '(23x,"cart. coord. in units 2pi/alat")')
DO iq = 1, q_grid%np
WRITE( ciq, '(i6)') iq
WRITE( stdout, '(8x,"q(",i5,") = (",3f12.7,")")') iq, &
(q_grid%p_cart(ipol, iq) , ipol = 1, 3)
IF( mpime == root ) CALL json%add('system.qpt.q('//TRIM(ADJUSTL(ciq))//').cartcoord:tpiba',q_grid%p_cart(1:3,iq))
ENDDO
WRITE( stdout, '(/23x,"cryst. coord.")')
WRITE( stdout, * )
DO iq = 1, q_grid%np
WRITE( ciq, '(i6)') iq
WRITE( stdout, '(8x,"q(",i5,") = (",3f12.7,")")') &
iq, (q_grid%p_cryst(ipol,iq) , ipol = 1, 3)
IF( mpime == root ) CALL json%add('system.qpt.q('//TRIM(ADJUSTL(ciq))//').crystcoord',q_grid%p_cryst(1:3,iq))
WRITE( stdout, '(8x,"q(",i6.6,") = (",3f14.7,")")') iq, q_grid%p_cryst(1:3,iq)
IF( mpime == root ) THEN
CALL json%add('system.bzsamp.q('//TRIM(ADJUSTL(ciq))//').id',iq)
CALL json%add('system.bzsamp.q('//TRIM(ADJUSTL(ciq))//').crystcoord',q_grid%p_cryst(1:3,iq))
ENDIF
ENDDO
ENDIF
!
......
......@@ -46,7 +46,7 @@ SUBROUTINE do_sxx ( )
!
! ... LOCAL variables
!
INTEGER :: ir, ip, ig, iks, ib, iv, ip_glob, ik, is, ikqs, iq, nbndval, npwkq
INTEGER :: ir, ip, ig, iks, ib, iv, ip_glob, ik, is, ikqs, ikq, iq, nbndval, npwkq
COMPLEX(DP),ALLOCATABLE :: pertg(:),pertr(:),pertr_nc(:,:)
COMPLEX(DP), ALLOCATABLE :: evckmq(:,:), phase(:)
LOGICAL :: l_gammaq
......@@ -147,7 +147,9 @@ SUBROUTINE do_sxx ( )
!
l_gammaq = q_grid%l_pIsGamma(iq)
!
CALL k_grid%find( k_grid%p_cart(:,ik) - q_grid%p_cart(:,iq), is, 'cart', ikqs, g0 )
!CALL k_grid%find( k_grid%p_cart(:,ik) - q_grid%p_cart(:,iq), is, 'cart', ikqs, g0 ) !MATTEO
CALL k_grid%find( k_grid%p_cart(:,ik) - q_grid%p_cart(:,iq), 'cart', ikq, g0 ) !MARCO
ikqs = k_grid%ipis2ips(ikq,is) !MARCO
CALL compute_phase( g0, 'cart', phase )
!
nbndval = nbnd_occ(ikqs)
......
......@@ -298,7 +298,8 @@ SUBROUTINE calc_corr_k( sigma_corr, energy, l_verbose)
!
ikk = k_grid%ip(ikks)
!
CALL k_grid%find( k_grid%p_cart(:,ik) - k_grid%p_cart(:,ikk), 1, 'cart', iq, g0 )
!CALL k_grid%find( k_grid%p_cart(:,ik) - k_grid%p_cart(:,ikk), 1, 'cart', iq, g0 ) !MATTEO
CALL k_grid%find( k_grid%p_cart(:,ik) - k_grid%p_cart(:,ikk), 'cart', iq, g0 ) !MARCO
l_gammaq = q_grid%l_pIsGamma(iq)
nbndval = nbnd_occ(ikks)
!
......@@ -384,7 +385,8 @@ SUBROUTINE calc_corr_k( sigma_corr, energy, l_verbose)
!
ikk = k_grid%ip(ikks)
!
CALL k_grid%find( k_grid%p_cart(:,ik) - k_grid%p_cart(:,ikk), 1, 'cart', iq, g0 )
!CALL k_grid%find( k_grid%p_cart(:,ik) - k_grid%p_cart(:,ikk), 1, 'cart', iq, g0 ) !MATTEO
CALL k_grid%find( k_grid%p_cart(:,ik) - k_grid%p_cart(:,ikk), 'cart', iq, g0 ) !MARCO
l_gammaq = q_grid%l_pIsGamma(iq)
nbndval = nbnd_occ(ikks)
!
......
......@@ -61,7 +61,7 @@ SUBROUTINE calc_exx2( sigma_exx, nb1, nb2 )
COMPLEX(DP), ALLOCATABLE :: evckmq(:,:), phase(:)
REAL(DP), EXTERNAL :: DDOT
COMPLEX(DP), EXTERNAL :: ZDOTC
INTEGER :: ib,iv,i1,ir,iks,ik,is,ig,iv_glob,iq,ikqs
INTEGER :: ib,iv,i1,ir,iks,ik,is,ig,iv_glob,iq,ikqs,ikq
INTEGER :: nbndval
INTEGER :: npwkq
TYPE(idistribute) :: vband
......@@ -167,7 +167,9 @@ SUBROUTINE calc_exx2( sigma_exx, nb1, nb2 )
l_gammaq = q_grid%l_pIsGamma(iq)
CALL pot3D%init('Dense',.FALSE.,'gb',iq)
!
CALL k_grid%find( k_grid%p_cart(:,ik) - q_grid%p_cart(:,iq), is, 'cart', ikqs, g0 )
!CALL k_grid%find( k_grid%p_cart(:,ik) - q_grid%p_cart(:,iq), is, 'cart', ikqs, g0 ) !MATTEO
CALL k_grid%find( k_grid%p_cart(:,ik) - q_grid%p_cart(:,iq), 'cart', ikq, g0 ) !MARCO
ikqs = k_grid%ipis2ips(ikq,is) !MARCO
CALL compute_phase( g0, 'cart', phase )
!
nbndval = nbnd_occ(ikqs)
......
......@@ -469,7 +469,8 @@ SUBROUTINE solve_gfreq_k(l_read_restart)
!
time_spent(1) = get_clock( 'glanczos' )
!
CALL q_grid%find( k_grid%p_cart(:,ikk) - k_grid%p_cart(:,ik), 1, 'cart', iq, g0 )
!CALL q_grid%find( k_grid%p_cart(:,ikk) - k_grid%p_cart(:,ik), 1, 'cart', iq, g0 ) !MARCO
CALL q_grid%find( k_grid%p_cart(:,ikk) - k_grid%p_cart(:,ik), 'cart', iq, g0 ) !MATTEO
!
CALL preallocate_solvegfreq_q( iks_l2g(ikks), iks_l2g(iks), qp_bandrange(1), qp_bandrange(2), pert)
!
......
......@@ -703,7 +703,8 @@ SUBROUTINE solve_qp_k(l_secant,l_generate_plot)
!
ikk = k_grid%ip(ikks)
!
CALL q_grid%find( k_grid%p_cart(:,ik) - k_grid%p_cart(:,ikk), 1, 'cart', iq, g0 )
!CALL q_grid%find( k_grid%p_cart(:,ik) - k_grid%p_cart(:,ikk), 1, 'cart', iq, g0 ) !MATTEO
CALL q_grid%find( k_grid%p_cart(:,ik) - k_grid%p_cart(:,ikk), 'cart', iq, g0 ) !MARCO
!
IF(ALLOCATED(overlap)) DEALLOCATE(overlap)
ALLOCATE(overlap(pert%nglob, nbnd ) )
......@@ -1152,27 +1153,44 @@ SUBROUTINE output_eqp_report(iteration,en1,en2,sc1)
CHARACTER(LEN=9) :: prefisso
INTEGER :: contatore
REAL(DP) :: out_tabella(k_grid%nps*(qp_bandrange(2)-qp_bandrange(1)+1),7)
INTEGER :: ib, iks
CHARACTER(LEN=4) :: symb
INTEGER :: ib, iks, ik, is
CHARACTER(LEN=4) :: symb(2)
TYPE(json_file) :: json
CHARACTER(LEN=6) :: my_label_k,my_label_b,citr
INTEGER :: secitr, iunit
LOGICAL :: found
LOGICAL :: lnospin
CHARACTER(LEN=10) :: ccounter, csecitr
INTEGER :: counter
!
! STDOUT
!
lnospin = ( k_grid%nps == k_grid%np )
WRITE(stdout,"(5X)")
CALL io_push_bar()
IF( iteration >= 0 ) WRITE(stdout,"(5X,'Iter: ',i6.6)") iteration
WRITE(stdout,"(5X,a,1X,a,1X,a,1X,a)") 'K ', 'B ', 'QP energ. [eV]', 'conv'
CALL io_push_bar()
DO iks = 1, k_grid%nps
DO ib = qp_bandrange(1), qp_bandrange(2)
symb=' no'
IF( (iteration .NE. 0) .AND. (ABS(en2(ib,iks)-en1(ib,iks)) < trev_secant) ) symb=' yes'
WRITE(stdout,"(5X,i6.6,1X,i6.6,1X,1f14.6,1X,a)") iks, ib, en2(ib,iks) * rytoev, symb
ENDDO
IF (k_grid%nps>1.AND.iks<k_grid%nps) WRITE(stdout,"(5X, 33(a))") '---------------------------------'
IF( iteration >= 0 ) WRITE(stdout,"(5X,'Iter: ',i6.6)") iteration
DO ik = 1, k_grid%np
WRITE( stdout, '(5x,"k(",i6.6,") = (",3f12.7,") cryst. coord.")') ik, k_grid%p_cryst(1:3,ik)
IF( lnospin ) THEN
WRITE(stdout,"(5X,a,1X,a,1X,a)") 'band ', ' QP en. [eV]', 'conv'
DO ib = qp_bandrange(1), qp_bandrange(2)
symb(1)=' no'
IF( (iteration .NE. 0) .AND. (ABS(en2(ib,iks)-en1(ib,iks)) < trev_secant) ) symb(1)=' yes'
WRITE(stdout,"(5X,i6.6,1X,1f14.6,1X,a)") ib, en2(ib,iks)*rytoev, symb(1)
ENDDO
ELSE
WRITE(stdout,"(5X,a,1X,a,1X,a,1X,a,1X,a)") 'band ', ' QP en. [eV]', 'conv', ' QP en. [eV]', 'conv'
DO ib = qp_bandrange(1), qp_bandrange(2)
symb(1:2)=' no'
IF( (iteration .NE. 0) .AND. (ABS(en2(ib,k_grid%ipis2ips(ik,1))-en1(ib,k_grid%ipis2ips(ik,1))) &
& < trev_secant) ) symb(1)=' yes'
IF( (iteration .NE. 0) .AND. (ABS(en2(ib,k_grid%ipis2ips(ik,2))-en1(ib,k_grid%ipis2ips(ik,2))) &
& < trev_secant) ) symb(2)=' yes'
WRITE(stdout,"(5X,i6.6,1X,1f14.6,1X,a,1f14.6,1X,a)") ib, en2(ib,k_grid%ipis2ips(ik,1))*rytoev, symb(1), &
& en2(ib,k_grid%ipis2ips(ik,2))*rytoev, symb(2)
ENDDO
ENDIF
IF (k_grid%np>1.AND.ik<k_grid%np) WRITE(stdout,"(5X, 33(a))") '---------------------------------'
ENDDO
CALL io_push_bar()
!
......@@ -1215,20 +1233,22 @@ SUBROUTINE output_eqp_report(iteration,en1,en2,sc1)
secitr = 1
ENDIF
!
WRITE(citr,'(i6)') secitr
WRITE(csecitr,'(i10)') secitr
!
CALL json%update('exec.Q.secitr', secitr, found )
!
counter = 0
DO iks = 1, k_grid%nps
WRITE( my_label_k, '(i6.6)') iks_l2g(iks)
DO ib = qp_bandrange(1), qp_bandrange(2)
WRITE( my_label_b, '(i6.6)') ib
CALL json%add('exec.Q.K'//TRIM(my_label_k)//'.B'//TRIM(my_label_b)//'.ein('//TRIM(ADJUSTL(citr))//')',&
& en1(ib,iks)*rytoev)
CALL json%add('exec.Q.K'//TRIM(my_label_k)//'.B'//TRIM(my_label_b)//'.eout('//TRIM(ADJUSTL(citr))//')',&
& en2(ib,iks)*rytoev)
CALL json%add('exec.Q.K'//TRIM(my_label_k)//'.B'//TRIM(my_label_b)//'.sc_ein('//TRIM(ADJUSTL(citr))//')',&
& REAL(sc1(ib,iks))*rytoev)
ik = k_grid%ip(iks)
is = k_grid%is(iks)
DO ib = qp_bandrange(1), qp_bandrange(2)
counter = counter + 1
WRITE( ccounter, '(i10)') counter
CALL json%add('exec.Q.en('//TRIM(ADJUSTL(ccounter))//').ksb',(/ik,is,ib/))
CALL json%add('exec.Q.en('//TRIM(ADJUSTL(ccounter))//').ein('//TRIM(ADJUSTL(csecitr))//')',en1(ib,iks)*rytoev)
CALL json%add('exec.Q.en('//TRIM(ADJUSTL(ccounter))//').eout('//TRIM(ADJUSTL(csecitr))//')',en2(ib,iks)*rytoev)
CALL json%add('exec.Q.en('//TRIM(ADJUSTL(ccounter))//').sc_ein('//TRIM(ADJUSTL(csecitr))//')',&
&(/DBLE(sc1(ib,iks)*rytoev),AIMAG(sc1(ib,iks)*rytoev)/))
ENDDO
ENDDO
!
......
......@@ -624,7 +624,7 @@ SUBROUTINE solve_wfreq_k(l_read_restart,l_generate_plot)
!
! Workspace
!
INTEGER :: i1,i2,i3,im,ip,ig,glob_ip,ir,iv,iks,ik,is,iq,ikqs,ipol,m
INTEGER :: i1,i2,i3,im,ip,ig,glob_ip,ir,iv,iks,ik,is,iq,ikqs,ikq,ipol,m
CHARACTER(LEN=512) :: fname
CHARACTER(LEN=6) :: my_label_b
CHARACTER(LEN=5) :: my_label_q
......@@ -791,7 +791,9 @@ SUBROUTINE solve_wfreq_k(l_read_restart,l_generate_plot)
!ikqs = kpq_grid%index_kq(iks,iq)
!npwkq = ngk(ikqs)
!
CALL k_grid%find( k_grid%p_cart(:,ik) + q_grid%p_cart(:,iq), is, 'cart', ikqs, g0 )
!CALL k_grid%find( k_grid%p_cart(:,ik) + q_grid%p_cart(:,iq), is, 'cart', ikqs, g0 ) !MATTEO
CALL k_grid%find( k_grid%p_cart(:,ik) + q_grid%p_cart(:,iq), 'cart', ikq, g0 ) !MARCO
ikqs = k_grid%ipis2ips(ikq,is) !MARCO
!
npwkq = ngk(ikqs)
!
......
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