diff --git a/eigen/hsmt.F90 b/eigen/hsmt.F90 index d6084575589cc683e54e7a28491b92699b2f1b2b..96ece625b5ba89bf39cedb81b07c5ff8158a5881 100644 --- a/eigen/hsmt.F90 +++ b/eigen/hsmt.F90 @@ -68,7 +68,7 @@ CONTAINS !This is for collinear calculations: the (1,1) element of the matrices is all !that is needed and allocated CALL hsmt_sph(n,atoms,mpi,ispin,input,noco,cell,1,1,chi_one,lapw,enpara%el0,& - td%e_shift,usdus,fj(:,0:,ispin,:),gj(:,0:,ispin,:),smat(1,1),hmat(1,1)) + td%e_shift(n,ispin),usdus,fj(:,0:,ispin,:),gj(:,0:,ispin,:),smat(1,1),hmat(1,1)) CALL hsmt_nonsph(n,mpi,sym,atoms,ispin,1,1,chi_one,noco,cell,lapw,td,& fj(:,0:,ispin,:),gj(:,0:,ispin,:),hmat(1,1)) CALL hsmt_lo(input,atoms,sym,cell,mpi,noco,lapw,usdus,td,fj(:,0:,ispin,:),gj(:,0:,ispin,:),& @@ -79,7 +79,7 @@ CONTAINS !stored in tmp-variables. Then these are distributed (rotated) into the 2x2 !global spin-matrices. CALL hmat_tmp%clear();CALL smat_tmp%clear() - CALL hsmt_sph(n,atoms,mpi,ispin,input,noco,cell,1,1,chi_one,lapw,enpara%el0,td%e_shift,& + CALL hsmt_sph(n,atoms,mpi,ispin,input,noco,cell,1,1,chi_one,lapw,enpara%el0,td%e_shift(n,ispin),& usdus,fj(:,0:,ispin,:),gj(:,0:,ispin,:),smat_tmp,hmat_tmp) CALL hsmt_nonsph(n,mpi,sym,atoms,ispin,1,1,chi_one,noco,cell,lapw,td,& fj(:,0:,ispin,:),gj(:,0:,ispin,:),hmat_tmp) @@ -100,7 +100,7 @@ CONTAINS DO iintsp=1,2 DO jintsp=1,2 CALL hsmt_sph(n,atoms,mpi,ispin,input,noco,cell,iintsp,jintsp,chi(iintsp,jintsp),& - lapw,enpara%el0,td%e_shift,usdus,fj(:,0:,ispin,:),gj(:,0:,ispin,:),& + lapw,enpara%el0,td%e_shift(n,ispin),usdus,fj(:,0:,ispin,:),gj(:,0:,ispin,:),& smat(iintsp,jintsp),hmat(iintsp,jintsp)) CALL hsmt_nonsph(n,mpi,sym,atoms,ispin,iintsp,jintsp,chi(iintsp,jintsp),noco,cell,& lapw,td,fj(:,0:,ispin,:),gj(:,0:,ispin,:),hmat(iintsp,jintsp)) diff --git a/eigen/hsmt_sph.F90 b/eigen/hsmt_sph.F90 index 6ef7682be6e55174f963c8af449eac7983230fdb..075cb12a6f42386610d56c253f80c373eda10042 100644 --- a/eigen/hsmt_sph.F90 +++ b/eigen/hsmt_sph.F90 @@ -27,7 +27,7 @@ CONTAINS ! .. ! .. Array Arguments .. REAL, INTENT (IN) :: el(0:atoms%lmaxd,atoms%ntype,input%jspins) - REAL, INTENT (IN) :: e_shift(input%jspins) + REAL, INTENT (IN) :: e_shift!(atoms%ntype,input%jspins) REAL, INTENT (IN) :: fj(:,0:,:),gj(:,0:,:) ! .. ! .. Local Scalars .. @@ -103,7 +103,7 @@ CONTAINS ENDIF ddnln = usdus%ddn(l,n,isp) elall = el(l,n,isp) - IF (l<=atoms%lnonsph(n)) elall=elall-e_shift(isp) + IF (l<=atoms%lnonsph(n)) elall=elall-e_shift!(isp) IF (smat%l_real) THEN DO kj = 1,ki fct = plegend(kj,l)*fl2p1(l)*& diff --git a/eigen/tlmplm_cholesky.F90 b/eigen/tlmplm_cholesky.F90 index 9c117be35256e8d7491decadc4ecd35b61a87253..3bd5edc82c31ef3c5d44bbd0ed4ecb3588543a41 100644 --- a/eigen/tlmplm_cholesky.F90 +++ b/eigen/tlmplm_cholesky.F90 @@ -64,7 +64,7 @@ MODULE m_tlmplm_cholesky vr0=v%mt(:,:,:,jsp) vr0(:,0,:)=0.0 ! ..e_shift - td%e_shift(jsp)=e_shift_min + td%e_shift(:,jsp)=e_shift_min OK=.FALSE. @@ -85,7 +85,7 @@ MODULE m_tlmplm_cholesky ! !---> generate the wavefunctions for each l ! - l_write=mpi%irank==0 + l_write = mpi%irank==0 !!\$ l_write=.false. !!\$ call gaunt2(atoms%lmaxd) !!\$OMP PARALLEL DO DEFAULT(NONE)& @@ -93,7 +93,7 @@ MODULE m_tlmplm_cholesky !!\$OMP PRIVATE(cil,temp,wronk,i,l,l2,lamda,lh,lm,lmin,lmin0,lmp,lmpl)& !!\$OMP PRIVATE(lmplm,lmx,lmxx,lp,lp1,lpl,m,mem,mems,mp,mu,n,nh,noded)& !!\$OMP PRIVATE(nodeu,nsym,na)& -!!\$OMP SHARED(atoms,jspin,jsp,sphhar,enpara,td,ud,l_write,ci,v,mpi,input) +!!\$OMP SHARED(atoms,jspin,jsp,sphhar,enpara,td,ud,l_write,v,mpi,input) DO n = 1,atoms%ntype na=sum(atoms%neq(:n-1))+1 @@ -299,8 +299,8 @@ MODULE m_tlmplm_cholesky DO lp = 0,atoms%lnonsph(n) DO mp = -lp,lp lmp = lp* (lp+1) + mp - td%h_loc(lmp,lmp,n,jsp)=td%e_shift(jsp)+td%h_loc(lmp,lmp,n,jsp) - td%h_loc(lmp+s,lmp+s,n,jsp)=td%e_shift(jsp)*ud%ddn(lp,n,jsp)+td%h_loc(lmp+s,lmp+s,n,jsp) + td%h_loc(lmp,lmp,n,jsp)=td%e_shift(n,jsp)+td%h_loc(lmp,lmp,n,jsp) + td%h_loc(lmp+s,lmp+s,n,jsp)=td%e_shift(n,jsp)*ud%ddn(lp,n,jsp)+td%h_loc(lmp+s,lmp+s,n,jsp) END DO END DO IF (lmp+1.ne.s) call judft_error("BUG in tlmpln_cholesky") @@ -316,13 +316,13 @@ MODULE m_tlmplm_cholesky ENDDO IF (info.NE.0) THEN - td%e_shift(jsp)=td%e_shift(jsp)*2.0 - PRINT *,"Potential shift to small, increasing the value to:",td%e_shift(jsp) - IF (td%e_shift(jsp)>e_shift_max) THEN + td%e_shift(n,jsp)=td%e_shift(n,jsp)*2.0 + PRINT *,"Potential shift to small, increasing the value to:",td%e_shift(n,jsp) + IF (td%e_shift(n,jsp)>e_shift_max) THEN CALL judft_error("Potential shift at maximum") - ENDIF - OK=.FALSE. - CYCLE cholesky_loop + ENDIF + OK=.FALSE. + CYCLE cholesky_loop ENDIF ! diff --git a/types/types_tlmplm.F90 b/types/types_tlmplm.F90 index 1cb10ed3f1231a377259548b43d70d54b839710f..bf28cdb33ef87a9bd7b03f8df22a34bc09031270 100644 --- a/types/types_tlmplm.F90 +++ b/types/types_tlmplm.F90 @@ -30,7 +30,7 @@ MODULE m_types_tlmplm !(-llod:llod,-llod:llod,mlolotot,tspin) COMPLEX,ALLOCATABLE :: h_loc(:,:,:,:) COMPLEX,ALLOCATABLE :: h_off(:,:,:,:) - REAL,ALLOCATABLE :: e_shift(:) + REAL,ALLOCATABLE :: e_shift(:,:) TYPE(t_rsoc) :: rsoc CONTAINS PROCEDURE,PASS :: init => tlmplm_init @@ -56,7 +56,7 @@ CONTAINS ALLOCATE(td%tuloulo(-llod:llod,-llod:llod,MAX(mlolotot,1),jspins), stat=err) ALLOCATE(td%ind(0:lmd,0:lmd,ntype,jspins),stat=err ) ALLOCATE(td%h_loc(0:2*lmaxd*(lmaxd+2)+1,0:2*lmaxd*(lmaxd+2)+1,ntype,jspins)) - ALLOCATE(td%e_shift(jspins)) + ALLOCATE(td%e_shift(ntype,jspins)) IF (l_offdiag) THEN ALLOCATE(td%h_off(0:2*lmaxd+1,0:2*lmaxd+1,ntype,2)) ELSE