Ok. The coding was easy.
Code: Select all
diff --git a/ypp/interface/QP_DBs_initialize.F b/ypp/interface/QP_DBs_initialize.F
index acf24f36e..575957ec3 100644
--- a/ypp/interface/QP_DBs_initialize.F
+++ b/ypp/interface/QP_DBs_initialize.F
@@ -26,6 +26,7 @@ subroutine QP_DBs_initialize()
! QPDB_states -> input file
!
use QP_m, ONLY:QP_t,QP_reset
+ use electrons, ONLY:spin
use parser_m, ONLY:PARSER_array
use IO_int, ONLY:io_control
use IO_m, ONLY:OP_RD_CL,DUMP,NONE
@@ -38,7 +39,7 @@ subroutine QP_DBs_initialize()
! Work Space
!
type(QP_t) :: qp
- integer :: i_qp,io_QP_and_GF_err,ID,n_user_qp_corrections
+ integer :: i_qp,io_QP_and_GF_err,ID,n_user_qp_corrections,n_lines
integer, external :: io_QP_and_GF
!
! If there are already the DB lines or there's not the input file todo return
@@ -51,29 +52,31 @@ subroutine QP_DBs_initialize()
!
! QP corrections
!
- call PARSER_array(mode="REAL dimensions",VAR="QP_user_corrections",N=n_user_qp_corrections,M=7)
+ n_lines=8
+ call PARSER_array(mode="REAL dimensions",VAR="QP_user_corrections",N=n_user_qp_corrections,M=n_lines)
if (n_user_qp_corrections>0) then
- YAMBO_ALLOC(QP_user_corrections,(n_user_qp_corrections,7))
- call PARSER_array(mode="read",VAR="QP_user_corrections",N=n_user_qp_corrections,M=7,R_v=QP_user_corrections)
+ YAMBO_ALLOC(QP_user_corrections,(n_user_qp_corrections,n_lines))
+ call PARSER_array(mode="read",VAR="QP_user_corrections",N=n_user_qp_corrections,M=n_lines,R_v=QP_user_corrections)
else if (io_QP_and_GF_err==0) then
n_user_qp_corrections=qp%n_states
- YAMBO_ALLOC(QP_user_corrections,(n_user_qp_corrections,7))
+ YAMBO_ALLOC(QP_user_corrections,(n_user_qp_corrections,n_lines))
do i_qp=1,qp%n_states
- QP_user_corrections(i_qp,1:2)=qp%table(i_qp,3)
- QP_user_corrections(i_qp,3:4)=qp%table(i_qp,1)
- QP_user_corrections(i_qp,5) =real(qp%E(i_qp)-qp%E_bare(i_qp))*HA2EV
- QP_user_corrections(i_qp,6) =aimag(qp%E(i_qp))*HA2EV
- QP_user_corrections(i_qp,7) =real(qp%Z(i_qp))
+ QP_user_corrections(i_qp,1) =spin(qp%table(i_qp,:))
+ QP_user_corrections(i_qp,2:3)=qp%table(i_qp,3)
+ QP_user_corrections(i_qp,4:5)=qp%table(i_qp,1)
+ QP_user_corrections(i_qp,6) =real(qp%E(i_qp)-qp%E_bare(i_qp))*HA2EV
+ QP_user_corrections(i_qp,7) =aimag(qp%E(i_qp))*HA2EV
+ QP_user_corrections(i_qp,8) =real(qp%Z(i_qp))
enddo
else
n_user_qp_corrections=1
- YAMBO_ALLOC(QP_user_corrections,(n_user_qp_corrections,7))
- QP_user_corrections(1,:)=(/-1,-1,-1,-1,0,0,0/)
+ YAMBO_ALLOC(QP_user_corrections,(n_user_qp_corrections,n_lines))
+ QP_user_corrections(1,:)=(/-1,-1,-1,-1,-1,0,0,0/)
endif
!
call PARSER_array(mode="write",VAR="QP_user_corrections",&
-& DESC="[QPDB] Correction( kp1| kp2| bnd1| bnd2| E-Eo[eV]| Img(E)[eV]| Re[Z] |)",&
-& N=n_user_qp_corrections,M=7,R_v=QP_user_corrections,Kn=(/"i","i","i","i","r","r","r"/))
+& DESC="[QPDB] Correction( spin | kp1| kp2| bnd1| bnd2| E-Eo[eV]| Img(E)[eV]| Re[Z] |)",&
+& N=n_user_qp_corrections,M=n_lines,R_v=QP_user_corrections,Kn=(/"i","i","i","i","i","r","r","r"/))
!
else if (l_QP_DBs_manipulate) then
!
diff --git a/ypp/qp/QP_DBs_create_and_modify.F b/ypp/qp/QP_DBs_create_and_modify.F
index 03c1fbd00..0238c49d6 100644
--- a/ypp/qp/QP_DBs_create_and_modify.F
+++ b/ypp/qp/QP_DBs_create_and_modify.F
@@ -39,7 +39,7 @@ subroutine QP_DBs_create_and_modify(en,k)
!
! Work Space
!
- integer :: io_QP_and_GF_err,ID,i_u,ib,ik,ic,is
+ integer :: io_QP_and_GF_err,ID,i_u,ib,ik,ic,is,ik_qp,nk_lim(2),nb_lim(2)
integer, external :: io_QP_and_GF
logical, allocatable :: QP_done(:,:,:,:)
type(QP_t) :: qp
@@ -47,6 +47,9 @@ subroutine QP_DBs_create_and_modify(en,k)
call section("=",'QP databases creation')
!========================================
!
+ nk_lim=(/minval(QP_user_corrections(:,2)),maxval(QP_user_corrections(:,3))/)
+ nb_lim=(/minval(QP_user_corrections(:,4)),maxval(QP_user_corrections(:,5))/)
+ !
! ...resets
!
call QP_reset(qp)
@@ -59,28 +62,30 @@ subroutine QP_DBs_create_and_modify(en,k)
! ...mark the states to correct
!
do i_u=1,size(QP_user_corrections,1)
- do is=1,n_sp_pol
- do ik=int(QP_user_corrections(i_u,1)),int(QP_user_corrections(i_u,2))
- do ib=int(QP_user_corrections(i_u,3)),int(QP_user_corrections(i_u,4))
- QP_state(ib,ik)=.TRUE.
- QP_nb=max(QP_nb,ib)
- QP_nk=max(QP_nk,ib)
- enddo
+ do ik=int(QP_user_corrections(i_u,2)),int(QP_user_corrections(i_u,3))
+ do ib=int(QP_user_corrections(i_u,4)),int(QP_user_corrections(i_u,5))
+ QP_state(ib,ik)=.TRUE.
enddo
enddo
enddo
!
- ! ... not turn QP_state into QP_table
+ QP_nk=nk_lim(2)
+ QP_nb=nb_lim(2)
+ !
+ ! ... now turn QP_state into QP_table
!
call QP_state_table_setup(en)
!
+ QP_nk=nk_lim(2)-nk_lim(1)+1
+ QP_nb=nb_lim(2)-nb_lim(1)+1
+ !
qp%n_states=QP_n_states
qp%nb =QP_nb
qp%nk =QP_nk
!
call QP_alloc(qp)
!
- YAMBO_ALLOC(QP_done,(QP_nb,QP_nb,QP_nk,n_sp_pol))
+ YAMBO_ALLOC(QP_done,(nb_lim(1):nb_lim(2),nb_lim(1):nb_lim(2),nk_lim(1):nk_lim(2),n_sp_pol))
QP_done=.FALSE.
!
! ...let's fill now
@@ -88,20 +93,21 @@ subroutine QP_DBs_create_and_modify(en,k)
ic=1
do i_u=1,size(QP_user_corrections,1)
!
- if (QP_user_corrections(i_u,7)<epsilon(1._SP)) QP_user_corrections(i_u,7)=1.
+ if (QP_user_corrections(i_u,8)<epsilon(1._SP)) QP_user_corrections(i_u,8)=1._SP
!
- do is=1,n_sp_pol
- do ik=int(QP_user_corrections(i_u,1)),int(QP_user_corrections(i_u,2))
- do ib=int(QP_user_corrections(i_u,3)),int(QP_user_corrections(i_u,4))
+ do is=int(QP_user_corrections(i_u,1)),int(QP_user_corrections(i_u,1))
+ do ik=int(QP_user_corrections(i_u,2)),int(QP_user_corrections(i_u,3))
+ ik_qp=ik-QP_user_corrections(i_u,2)+1
+ do ib=int(QP_user_corrections(i_u,4)),int(QP_user_corrections(i_u,5))
!
qp%E_bare(ic) =en%E(ib,ik,is)
- qp%E(ic) =cmplx(QP_user_corrections(i_u,5)/HA2EV+en%E(ib,ik,is),QP_user_corrections(i_u,6)/HA2EV,kind=SP)
- qp%Z(ic) =cmplx(QP_user_corrections(i_u,7),0.,kind=SP)
+ qp%E(ic) =cmplx(QP_user_corrections(i_u,6)/HA2EV+en%E(ib,ik,is),QP_user_corrections(i_u,7)/HA2EV,kind=SP)
+ qp%Z(ic) =cmplx(QP_user_corrections(i_u,8),0._SP,kind=SP)
qp%table(ic,1)=ib
qp%table(ic,2)=ib
qp%table(ic,3)=ik
if(n_sp_pol==2) qp%table(ic,4)=is
- qp%k(qp%table(ic,3),:) =k%pt(qp%table(ic,3),:)
+ qp%k(ik_qp,:) =k%pt(ik,:)
!
if(QP_done(ib,ib,ik,is)) call error("Duplicated quasi-particle index found")
!
Please let me know if it works.
D.