Quick fix for issue #311

...and some missing irrelevant additional initialization of hybrid%d_wgn2 in main/fleur_init.F90

cdn/cdnval.F90

@@ -227,10 +227,10 @@ SUBROUTINE cdnval(eig_id, mpi,kpts,jspin,noco,input,banddos,cell,atoms,enpara,st
 
          ! perform Brillouin zone integration and summation over the
          ! bands in order to determine the energy parameters for each atom and angular momentum
-         CALL eparas(ispin,atoms,noccbd,mpi,ikpt,noccbd,we,eig,&
+         CALL eparas(ispin,atoms,noccbd,ev_list,mpi,ikpt,noccbd,we,eig,&
                      skip_t,cdnvalJob%l_evp,eigVecCoeffs,usdus,regCharges,dos,banddos%l_mcd,mcd)
 
-         IF (noco%l_mperp.AND.(ispin==jsp_end)) CALL qal_21(dimension,atoms,input,noccbd,noco,eigVecCoeffs,denCoeffsOffdiag,ikpt,dos)
+         IF (noco%l_mperp.AND.(ispin==jsp_end)) CALL qal_21(dimension,atoms,input,noccbd,ev_list,noco,eigVecCoeffs,denCoeffsOffdiag,ikpt,dos)
 
          ! layer charge of each valence state in this k-point of the SBZ from the mt-sphere region of the film
          IF (l_dosNdir) THEN

cdn/eparas.f90

@@ -23,7 +23,7 @@ MODULE m_eparas
   !***********************************************************************
   !
 CONTAINS
-  SUBROUTINE eparas(jsp,atoms,noccbd, mpi,ikpt,ne,we,eig,skip_t,l_evp,eigVecCoeffs,&
+  SUBROUTINE eparas(jsp,atoms,noccbd,ev_list,mpi,ikpt,ne,we,eig,skip_t,l_evp,eigVecCoeffs,&
                     usdus,regCharges,dos,l_mcd,mcd)
     USE m_types
     IMPLICIT NONE
@@ -39,6 +39,7 @@ CONTAINS
     INTEGER, INTENT (IN) :: noccbd,jsp     
     INTEGER, INTENT (IN) :: ne,ikpt  ,skip_t
     LOGICAL, INTENT (IN) :: l_mcd,l_evp
+    INTEGER, INTENT (IN) :: ev_list(noccbd)
     !     ..
     !     .. Array Arguments ..
     REAL,    INTENT (IN)  :: eig(:)!(dimension%neigd),
@@ -107,7 +108,7 @@ CONTAINS
                    ENDDO
                 ENDIF     ! end MCD
              ENDDO
-             dos%qal(l,n,i,ikpt,jsp) = (suma+sumb*usdus%ddn(l,n,jsp))/atoms%neq(n)
+             dos%qal(l,n,ev_list(i),ikpt,jsp) = (suma+sumb*usdus%ddn(l,n,jsp))/atoms%neq(n)
           ENDDO
           nt1 = nt1 + atoms%neq(n)
        ENDDO
@@ -120,8 +121,8 @@ CONTAINS
     DO l = 0,3
        DO n = 1,atoms%ntype
           DO i = (skip_t+1),noccbd
-             regCharges%ener(l,n,jsp) = regCharges%ener(l,n,jsp) + dos%qal(l,n,i,ikpt,jsp)*we(i)*eig(i)
-             regCharges%sqal(l,n,jsp) = regCharges%sqal(l,n,jsp) + dos%qal(l,n,i,ikpt,jsp)*we(i)
+             regCharges%ener(l,n,jsp) = regCharges%ener(l,n,jsp) + dos%qal(l,n,ev_list(i),ikpt,jsp)*we(i)*eig(i)
+             regCharges%sqal(l,n,jsp) = regCharges%sqal(l,n,jsp) + dos%qal(l,n,ev_list(i),ikpt,jsp)*we(i)
           ENDDO
        ENDDO
     ENDDO
@@ -174,7 +175,7 @@ CONTAINS
           ! llo > 3 used for unoccupied states only
           IF( l .GT. 3 ) CYCLE
           DO i = 1,ne
-             dos%qal(l,ntyp,i,ikpt,jsp)= dos%qal(l,ntyp,i,ikpt,jsp)  + ( 1.0/atoms%neq(ntyp) )* (&
+             dos%qal(l,ntyp,ev_list(i),ikpt,jsp)= dos%qal(l,ntyp,ev_list(i),ikpt,jsp)  + ( 1.0/atoms%neq(ntyp) )* (&
                   qaclo(i,lo,ntyp)*usdus%uulon(lo,ntyp,jsp)+qbclo(i,lo,ntyp)*usdus%dulon(lo,ntyp,jsp)     )
           END DO
           DO lop = 1,atoms%nlo(ntyp)
@@ -182,7 +183,7 @@ CONTAINS
                 DO i = 1,ne
                    regCharges%enerlo(lo,ntyp,jsp) = regCharges%enerlo(lo,ntyp,jsp) +qlo(i,lop,lo,ntyp)*we(i)*eig(i)
                    regCharges%sqlo(lo,ntyp,jsp) = regCharges%sqlo(lo,ntyp,jsp) + qlo(i,lop,lo,ntyp)*we(i)
-                   dos%qal(l,ntyp,i,ikpt,jsp)= dos%qal(l,ntyp,i,ikpt,jsp)  + ( 1.0/atoms%neq(ntyp) ) *&
+                   dos%qal(l,ntyp,ev_list(i),ikpt,jsp)= dos%qal(l,ntyp,ev_list(i),ikpt,jsp)  + ( 1.0/atoms%neq(ntyp) ) *&
                         qlo(i,lop,lo,ntyp)*usdus%uloulopn(lop,lo,ntyp,jsp)
                 ENDDO
              ENDIF

cdn/qal_21.f90

@@ -5,7 +5,7 @@ MODULE m_qal21
   !***********************************************************************
   !
 CONTAINS
-  SUBROUTINE qal_21(dimension,atoms,input,noccbd,noco,eigVecCoeffs,denCoeffsOffdiag,ikpt,dos)
+  SUBROUTINE qal_21(dimension,atoms,input,noccbd,ev_list,noco,eigVecCoeffs,denCoeffsOffdiag,ikpt,dos)
 
     USE m_types_setup
     USE m_types_dos
@@ -25,6 +25,8 @@ CONTAINS
     !     .. Scalar Arguments ..
     INTEGER, INTENT (IN) :: noccbd,ikpt
 
+    INTEGER, INTENT (IN) :: ev_list(noccbd)
+
     !     .. Local Scalars ..
     INTEGER i,l,lo,lop ,natom,nn,ntyp
     INTEGER nt1,nt2,lm,n,ll1,ipol,icore,index,m
@@ -152,10 +154,10 @@ CONTAINS
        state : DO i = 1, noccbd
           lls : DO l = 0,3
              CALL rot_den_mat(noco%alph(n),noco%beta(n),&
-                  dos%qal(l,n,i,ikpt,1),dos%qal(l,n,i,ikpt,2),qal21(l,n,i))
+                  dos%qal(l,n,ev_list(i),ikpt,1),dos%qal(l,n,ev_list(i),ikpt,2),qal21(l,n,i))
              IF (.FALSE.) THEN
-                IF (n==1) WRITE(*,'(3i3,4f10.5)') l,n,i,qal21(l,n,i),dos%qal(l,n,i,ikpt,:)
-                q_loc(1,1) = dos%qal(l,n,i,ikpt,1); q_loc(2,2) = dos%qal(l,n,i,ikpt,2)
+                IF (n==1) WRITE(*,'(3i3,4f10.5)') l,n,i,qal21(l,n,i),dos%qal(l,n,ev_list(i),ikpt,:)
+                q_loc(1,1) = dos%qal(l,n,ev_list(i),ikpt,1); q_loc(2,2) = dos%qal(l,n,ev_list(i),ikpt,2)
                 q_loc(1,2) = qal21(l,n,i); q_loc(2,1) = CONJG(q_loc(1,2))
                 q_hlp = MATMUL( TRANSPOSE( CONJG(chi) ) ,q_loc)
                 q_loc = MATMUL(q_hlp,chi)

main/fleur_init.F90

@@ -449,6 +449,7 @@
 
              ! calculate d_wgn
              ALLOCATE (hybrid%d_wgn2(-atoms%lmaxd:atoms%lmaxd,-atoms%lmaxd:atoms%lmaxd,0:atoms%lmaxd,sym%nsym))
+             hybrid%d_wgn2 =  CMPLX(0.0,0.0)
              CALL d_wigner(sym%nop,sym%mrot,cell%bmat,atoms%lmaxd,hybrid%d_wgn2(:,:,1:,:sym%nop))
              hybrid%d_wgn2(:,:,0,:) = 1