Commit 02e8940e authored by Daniel Wortmann's avatar Daniel Wortmann

Finished merge with hsmt_simple branch. At least some tests run already.

Cleanup and bugfixes are required.
parent da2884ab
......@@ -336,8 +336,6 @@ CONTAINS
IF(l_cs.AND.jspin.EQ.1) CALL corespec_gaunt()
! calculation of core spectra (EELS) initializations -end-
ALLOCATE ( kveclo(atoms%nlotot) )
IF (mpi%irank==0) THEN
WRITE (6,FMT=8000) jspin
......@@ -570,7 +568,7 @@ CONTAINS
ikpt,jspin,zmat%nbasfcn,noco%l_ss,noco%l_noco,&
noccbd,n_start,n_end,&
ello,evdu,epar,&
lapw,wk,nbands,eig,zMat)
wk,nbands,eig,zMat)
#ifdef CPP_MPI
! Sinchronizes the RMA operations
if (l_evp) CALL MPI_BARRIER(mpi%mpi_comm,ie)
......
......@@ -19,7 +19,7 @@ CONTAINS
!>@author D. Wortmann
SUBROUTINE eigen(mpi,stars,sphhar,atoms,obsolete,xcpot,&
sym,kpts,DIMENSION, vacuum, input, cell, enpara_in,banddos, noco,jij, oneD,hybrid,&
it,eig_id,results,v,vx)
it,eig_id,results,inden,v,vx)
USE m_constants, ONLY : pi_const,sfp_const
USE m_types
USE m_lodpot
......@@ -61,6 +61,7 @@ CONTAINS
TYPE(t_kpts),INTENT(IN) :: kpts
TYPE(t_sphhar),INTENT(IN) :: sphhar
TYPE(t_atoms),INTENT(INOUT) :: atoms!in u_setup n_u might be modified
TYPE(t_potden),INTENT(IN) :: inden
TYPE(t_potden),INTENT(INOUT) :: v,vx
#ifdef CPP_MPI
INCLUDE 'mpif.h'
......@@ -143,7 +144,7 @@ CONTAINS
!---> loop over spins
!---> set up k-point independent t(l'm',lm) matrices
!
CALL mt_setup(atoms,sym,sphhar,input,noco,enpara,v,mpi,results,DIMENSION,td,ud)
CALL mt_setup(atoms,sym,sphhar,input,noco,enpara,inden,v,mpi,results,DIMENSION,td,ud)
DO jsp = 1,MERGE(1,input%jspins,noco%l_noco)
k_loop:DO nk = mpi%n_start,kpts%nkpt,mpi%n_stride
......
......@@ -130,98 +130,7 @@ CONTAINS
COMPLEX,ALLOCATABLE:: ab(:,:),ab1(:,:),ab_select1(:,:),ab_select(:,:)
real :: rchi
<<<<<<< HEAD
!
!---> update hamiltonian and overlap matrices
nc = 0
IF ( noco%l_noco .AND. (n_size>1) ) THEN
lapw%nv_tot = lapw%nv(1) + lapw%nv(2)
ELSE
lapw%nv_tot = lapw%nv(iintsp)
ENDIF
kii=n_rank
DO WHILE(kii<lapw%nv_tot)
!DO kii = n_rank, nv_tot-1, n_size
ki = MOD(kii,lapw%nv(iintsp)) + 1
bsize=MIN(SIZE(aa_block,1),(lapw%nv(iintsp)-ki)/n_size+1) !Either use maximal blocksize or number of rows left to calculate
IF (bsize<1) EXIT !nothing more to do here
bsize2=bsize*n_size
bsize2=min(bsize2,lapw%nv(iintsp)-ki+1)
!aa_block(:bsize,:ki+bsize2-1)=matmul(a(ki:ki+bsize2-1:n_size,0:lmp,iintsp),conjg(transpose(ax(:ki+bsize2-1,0:lmp))))+ &
! matmul(b(ki:ki+bsize2-1:n_size,0:lmp,iintsp),conjg(transpose(bx(:ki+bsize2-1,0:lmp))))
IF (n_size==1) THEN !Make this a special case to avoid copy-in of a array
call zgemm("N","C",bsize,ki+bsize2-1,lmp+1,one,a(ki,0,iintsp),SIZE(a,1),ax(1,0),SIZE(ax,1),zero,aa_block,SIZE(aa_block,1))
call zgemm("N","C",bsize,ki+bsize2-1,lmp+1,one,b(ki,0,iintsp),SIZE(a,1),bx(1,0),SIZE(ax,1),one ,aa_block,SIZE(aa_block,1))
ELSE
CALL zgemm("N","C",bsize,ki+bsize2-1,lmp+1,one,a(ki:ki+bsize2-1:n_size,0:lmp,iintsp),SIZE(a(ki:ki+bsize2-1:n_size,0:lmp,iintsp),1),ax(1,0),SIZE(ax,1),zero,aa_block,SIZE(aa_block,1))
CALL zgemm("N","C",bsize,ki+bsize2-1,lmp+1,one,b(ki:ki+bsize2-1:n_size,0:lmp,iintsp),SIZE(a(ki:ki+bsize2-1:n_size,0:lmp,iintsp),1),bx(1,0),SIZE(ax,1),one,aa_block,SIZE(aa_block,1))
ENDIF
DO kb=1,bsize
IF ( noco%l_noco .AND. (.NOT. noco%l_ss) ) THEN
nc = 1+kii/n_size
ii = nc*(nc-1)/2*n_size-(nc-1)*(n_size-n_rank-1)
IF ( (n_size==1).OR.(kii+1<=lapw%nv(1)) ) THEN !
aahlp(ii+1:ii+ki) = aahlp(ii+1:ii+ki)+MATMUL(CONJG(ax(:ki,:lmp)),a(ki,:lmp,iintsp))+MATMUL(CONJG(bx(:ki,:lmp)),b(ki,:lmp,iintsp))
ELSE ! components for <2||2> block unused
aa_tmphlp(:ki) = MATMUL(CONJG(ax(:ki,:lmp)),a(ki,:lmp,iintsp))+MATMUL(CONJG(bx(:ki,:lmp)),b(ki,:lmp,iintsp))
!---> spin-down spin-down part
ij = ii + lapw%nv(1)
aa_c(ij+1:ij+ki)=aa_c(ij+1:ij+ki)+chi22*aa_tmphlp(:ki)
!---> spin-down spin-up part, lower triangle
ij = ii
aa_c(ij+1:ij+ki)=aa_c(ij+1:ij+ki)+chi21*aa_tmphlp(:ki)
ENDIF
!-||
ELSEIF ( noco%l_noco .AND. noco%l_ss ) THEN
IF ( iintsp==1 .AND. jintsp==1 ) THEN
!---> spin-up spin-up part
kjmax = ki
chihlp = chi11
ii = (ki-1)*(ki)/2
ELSEIF ( iintsp==2 .AND. jintsp==2 ) THEN
!---> spin-down spin-down part
kjmax = ki
chihlp = chi22
ii = (lapw%nv(1)+atoms%nlotot+ki-1)*(lapw%nv(1)+atoms%nlotot+ki)/2+&
lapw%nv(1)+atoms%nlotot
ELSE
!---> spin-down spin-up part
kjmax = lapw%nv(1)
chihlp = chi21
ii = (lapw%nv(1)+atoms%nlotot+ki-1)*(lapw%nv(1)+atoms%nlotot+ki)/2
ENDIF
aa_c(ii+1:ii+kjmax) = aa_c(ii+1:ii+kjmax) + chihlp*&
(MATMUL(CONJG(ax(:kjmax,:lmp)),a(ki,:lmp,iintsp))+MATMUL(CONJG(bx(:kjmax,:lmp)),b(ki,:lmp,iintsp)))
ELSE
nc = 1+kii/n_size
ii = nc*(nc-1)/2*n_size- (nc-1)*(n_size-n_rank-1)
if (l_real) THEN
aa_r(ii+1:ii+ki) = aa_r(ii+1:ii+ki) + aa_block(kb,:ki)
ELSE
aa_c(ii+1:ii+ki) = aa_c(ii+1:ii+ki) + aa_block(kb,:ki)
endif
!print*,ii,ki,kb
! IF (.not.apw(l)) THEN
!aa(ii+1:ii+ki) = aa(ii+1:ii+ki) + b(ki,lmp,iintsp)*bx(:ki)
! ENDIF
ENDIF
ki=ki+n_size
kii=kii+n_size
ENDDO
!---> end loop over ki
END DO
!---> end loops over interstitial spin
ENDDO
ENDDO
ENDIF ! atoms%invsat(na) = 0 or 1
!---> end loop over equivalent atoms
END DO
IF ( noco%l_noco .AND. (.NOT. noco%l_ss) ) CALL hsmt_hlptomat(atoms%nlotot,lapw%nv,sub_comm,chi11,chi21,chi22,aahlp,aa_c)
!---> end loop over atom types (ntype)
ENDDO ntyploop
=======
ALLOCATE(ab(MAXVAL(lapw%nv),2*atoms%lnonsph(n)*(atoms%lnonsph(n)+2)+2),ab1(lapw%nv(iintsp),2*atoms%lnonsph(n)*(atoms%lnonsph(n)+2)+2),ab_select(lapw%num_local_cols(jintsp),2*atoms%lnonsph(n)*(atoms%lnonsph(n)+2)+2))
>>>>>>> hsmt_simple
IF (iintsp.NE.jintsp) ALLOCATE(ab_select1(lapw%num_local_cols(jintsp),2*atoms%lnonsph(n)*(atoms%lnonsph(n)+2)+2))
......
This diff is collapsed.
......@@ -7,7 +7,7 @@
MODULE m_mt_setup
CONTAINS
SUBROUTINE mt_setup(atoms,sym,sphhar,input,noco,enpara,v,mpi,results,DIMENSION,td,ud)
SUBROUTINE mt_setup(atoms,sym,sphhar,input,noco,enpara,inden,v,mpi,results,DIMENSION,td,ud)
USE m_usetup
USE m_tlmplm_cholesky
USE m_tlmplm_store
......@@ -23,7 +23,8 @@ CONTAINS
TYPE(t_sym),INTENT(IN) :: sym
TYPE(t_sphhar),INTENT(IN) :: sphhar
TYPE(t_atoms),INTENT(IN) :: atoms
TYPE(t_potden),INTENT(IN) :: v
TYPE(t_potden),INTENT(IN) :: inDen
TYPE(t_potden),INTENT(INOUT) :: v
TYPE(t_tlmplm),INTENT(INOUT) :: td
TYPE(t_usdus),INTENT(INOUT) :: ud
......@@ -34,7 +35,7 @@ CONTAINS
IF ((atoms%n_u.GT.0)) THEN
ALLOCATE( vs_mmp(-lmaxb:lmaxb,-lmaxb:lmaxb,atoms%n_u,input%jspins) )
CALL u_setup(sym,atoms,lmaxb,sphhar,input, enpara%el0(0:,:,:),v%mt,mpi, vs_mmp,results)
CALL u_setup(sym,atoms,sphhar,input, enpara%el0(0:,:,:),inDen,v,mpi,results)
ELSE
ALLOCATE( vs_mmp(-lmaxb:-lmaxb,-lmaxb:-lmaxb,1,2) )
ENDIF
......@@ -46,7 +47,7 @@ CONTAINS
DO jsp=1,input%jspins
!CALL tlmplm_cholesky(sphhar,atoms,DIMENSION,enpara, jsp,1,mpi,v%mt(:,0,1,jsp),input,vs_mmp, td,ud)
CALL tlmplm_cholesky(sphhar,atoms,noco,enpara, jsp,jsp,mpi,v%mt,input,vs_mmp, td,ud)
CALL tlmplm_cholesky(sphhar,atoms,noco,enpara, jsp,jsp,mpi,v,input, td,ud)
IF (input%l_f) CALL write_tlmplm(td,vs_mmp,atoms%n_u>0,1,jsp,input%jspins)
END DO
CALL timestop("tlmplm")
......
......@@ -9,7 +9,7 @@ MODULE m_tlmplm_cholesky
!*********************************************************************
CONTAINS
SUBROUTINE tlmplm_cholesky(sphhar,atoms,noco,enpara,&
jspin,jsp,mpi,vr,input, vs_mmp,td,ud)
jspin,jsp,mpi,v,input,td,ud)
USE m_intgr, ONLY : intgr3
USE m_radflo
......@@ -29,9 +29,7 @@ MODULE m_tlmplm_cholesky
! .. Scalar Arguments ..
INTEGER, INTENT (IN) :: jspin,jsp !physical spin&spin index for data
! ..
! .. Array Arguments ..
COMPLEX,INTENT(IN) :: vs_mmp(:,:,:,:)
REAL, INTENT (IN) :: vr(atoms%jmtd,0:sphhar%nlhd,atoms%ntype,input%jspins) ! this is for the
TYPE(t_potden),INTENT(IN) :: v
TYPE(t_tlmplm),INTENT(INOUT) :: td
TYPE(t_usdus),INTENT(INOUT) :: ud
......@@ -45,7 +43,7 @@ MODULE m_tlmplm_cholesky
LOGICAL l_write,ok
! ..
! .. Local Arrays ..
REAL vr0(size(vr,1),0:size(vr,2)-1,size(vr,3))
REAL vr0(size(v%mt,1),0:size(v%mt,2)-1,size(v%mt,3))
REAL dvd(0:atoms%lmaxd*(atoms%lmaxd+3)/2,0:sphhar%nlhd )
REAL dvu(0:atoms%lmaxd*(atoms%lmaxd+3)/2,0:sphhar%nlhd )
REAL uvd(0:atoms%lmaxd*(atoms%lmaxd+3)/2,0:sphhar%nlhd )
......@@ -63,7 +61,7 @@ MODULE m_tlmplm_cholesky
REAL,PARAMETER:: e_shift_min=0.2
REAL,PARAMETER:: e_shift_max=65.0
vr0=vr(:,:,:,jsp)
vr0=v%mt(:,:,:,jsp)
vr0(:,0,:)=0.0
! ..e_shift
td%e_shift(jsp)=e_shift_min
......@@ -73,7 +71,7 @@ MODULE m_tlmplm_cholesky
IF (noco%l_constr) THEN
ALLOCATE(uun21(0:atoms%lmaxd,atoms%ntype),udn21(0:atoms%lmaxd,atoms%ntype),&
dun21(0:atoms%lmaxd,atoms%ntype),ddn21(0:atoms%lmaxd,atoms%ntype) )
CALL rad_ovlp(atoms,ud,input,vr,enpara%el0, uun21,udn21,dun21,ddn21)
CALL rad_ovlp(atoms,ud,input,v%mt,enpara%el0, uun21,udn21,dun21,ddn21)
ENDIF
cholesky_loop:DO WHILE(.NOT.OK)
......@@ -95,13 +93,13 @@ 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,vr,mpi,input)
!!$OMP SHARED(atoms,jspin,jsp,sphhar,enpara,td,ud,l_write,ci,v,mpi,input)
DO n = 1,atoms%ntype
na=sum(atoms%neq(:n-1))+1
IF (l_write) WRITE (6,FMT=8000) n
DO l = 0,atoms%lmax(n)
CALL radfun(l,n,jspin,enpara%el0(l,n,jspin),vr(:,0,n,jsp),atoms,&
CALL radfun(l,n,jspin,enpara%el0(l,n,jspin),v%mt(:,0,n,jsp),atoms,&
f(1,1,l),g(1,1,l),ud,nodeu,noded,wronk)
IF (l_write) WRITE (6,FMT=8010) l,enpara%el0(l,n,jspin),ud%us(l,n,jspin),&
ud%dus(l,n,jspin),nodeu,ud%uds(l,n,jspin),ud%duds(l,n,jspin),noded,ud%ddn(l,n,jspin),wronk
......@@ -117,7 +115,7 @@ MODULE m_tlmplm_cholesky
!---> if there are any.
!
IF (atoms%nlo(n).GE.1) THEN
CALL radflo(atoms,n,jspin,enpara%ello0(1,1,jspin), vr(:,0,n,jsp), f,g,mpi,&
CALL radflo(atoms,n,jspin,enpara%ello0(1,1,jspin), v%mt(:,0,n,jsp), f,g,mpi,&
ud, uuilon,duilon,ulouilopn,flo)
END IF
......@@ -278,8 +276,8 @@ MODULE m_tlmplm_cholesky
lm = l* (l+1) + m
DO mp = -lp,lp
lmp = lp* (lp+1) + mp
td%h_loc(lm,lmp,n,jsp) =td%h_loc(lm,lmp,n,jsp) + vs_mmp(l,lp,i_u,jsp)
td%h_loc(lm+s,lmp+s,n,jsp) =td%h_loc(lm+s,lmp+s,n,jsp)+ vs_mmp(l,lp,i_u,jsp)*ud%ddn(lp,n,jsp)
td%h_loc(lm,lmp,n,jsp) =td%h_loc(lm,lmp,n,jsp) + v%mmpMat(l,lp,i_u,jsp)
td%h_loc(lm+s,lmp+s,n,jsp) =td%h_loc(lm+s,lmp+s,n,jsp)+ v%mmpMat(l,lp,i_u,jsp)*ud%ddn(lp,n,jsp)
ENDDO
ENDDO
END DO
......@@ -331,7 +329,7 @@ MODULE m_tlmplm_cholesky
!---> set up the t-matrices for the local orbitals,
!---> if there are any
IF (atoms%nlo(n).GE.1) THEN
CALL tlo(atoms,sphhar,jspin,jsp,n,enpara,1,input,vr(1,0,n,jsp),&
CALL tlo(atoms,sphhar,jspin,jsp,n,enpara,1,input,v%mt(1,0,n,jsp),&
na,flo,f,g,ud, uuilon,duilon,ulouilopn, td)
ENDIF
......
......@@ -17,7 +17,7 @@
> eig_id,
> irank,isize,jspin,jspins,
> l_noco,
< ello,evac,epar,bkpt,wk,n_bands,n_size)
< ello,evac,epar,wk,n_bands,n_size)
USE m_eig66_io, ONLY : read_eig
IMPLICIT NONE
!
......@@ -32,7 +32,6 @@
REAL, INTENT (INOUT) :: wk
INTEGER, INTENT (OUT) :: n_bands(0:) !n_bands(0:neigd)
REAL, INTENT (INOUT) :: bkpt(:) !bkpt(3)
REAL, INTENT (INOUT) :: ello(:,:,:),evac(:,:) !ello(nlod,ntypd,jspd),evac(2,jspd)
REAL, INTENT (INOUT) :: epar(0:,:,:) !epar(0:lmaxd,ntypd,jspd)
......@@ -68,8 +67,8 @@ c
> eig_id,nvd,jspd,irank,isize,
> ikpt,jspin,nbasfcn,l_ss,l_noco,
> noccbd,n_start,n_end,
< nmat,nv,ello,evdu,epar,kveclo,
< k1,k2,k3,bkpt,wk,nbands,eig,zmat)
< ello,evdu,epar,
< wk,nbands,eig,zmat)
USE m_eig66_io, ONLY : read_eig
USE m_types
......@@ -82,12 +81,10 @@ c
INTEGER, INTENT (IN) :: nvd,jspd,jspin
INTEGER, INTENT (IN) :: noccbd,n_start,n_end
LOGICAL, INTENT (IN) :: l_ss,l_noco
INTEGER, INTENT (OUT) :: nbands,nmat
INTEGER, INTENT (OUT) :: nbands
REAL, INTENT (OUT) :: wk
INTEGER, INTENT (INOUT) :: k1(:,:),k2(:,:),k3(:,:) !k1(nvd,jspd),k2(nvd,jspd),k3(nvd,jspd)
INTEGER, INTENT (OUT) :: nv(:),kveclo(:) !nv(jspd),kveclo(nlotot)
REAL, INTENT (OUT) :: bkpt(:),eig(:) !bkpt(3),eig(neigd)
REAL, INTENT (OUT) :: eig(:) !bkpt(3),eig(neigd)
REAL, INTENT (INOUT) :: ello(:,:,:),evdu(:,:) !ello(nlod,ntypd,jspd),evdu(2,jspd)
REAL, INTENT (INOUT) :: epar(0:,:,:) !epar(0:lmaxd,ntypd,jspd)
......@@ -95,7 +92,7 @@ c
!
! Local variables ...
!
INTEGER :: iv,j,isp
INTEGER :: iv,j,isp,nmat
#ifdef CPP_MPI
INCLUDE 'mpif.h'
INTEGER mpiierr
......@@ -107,11 +104,10 @@ c
CALL timestart("cdn_read")
IF (l_ss) THEN
CALL read_eig(eig_id,ikpt,1,
< bk=bkpt,wk=wk,neig=nbands)
< wk=wk,neig=nbands)
DO isp = jspd,1,-1
CALL read_eig(eig_id,ikpt,isp,
< nmat=nmat,nv=nv(isp),k1=k1(:,isp),
< k2=k2(:,isp),k3=k3(:,isp),kveclo=kveclo)
< nmat=nmat)
! write(*,*) kveclo
ENDDO
CALL read_eig(
......@@ -123,19 +119,12 @@ c
ELSEIF (l_noco) THEN
CALL read_eig(
> eig_id,ikpt,1,
< bk=bkpt,wk=wk,neig=nbands,
< nmat=nmat,nv=nv(1),k1=k1(:,1),
< k2=k2(:,1),k3=k3(:,1),kveclo=kveclo)
< wk=wk,neig=nbands,
< nmat=nmat)
CALL read_eig(
> eig_id,ikpt,1,n_start=n_start,n_end=n_end,
< eig=eig,nmat=nmat,zmat=zmat)
nv(jspd) = nv(1)
DO iv = 1,nv(1)
k1(iv,jspd) = k1(iv,1)
k2(iv,jspd) = k2(iv,1)
k3(iv,jspd) = k3(iv,1)
ENDDO
!
!
! For Collinear
!
ELSE
......@@ -151,10 +140,8 @@ c
CALL read_eig(
> eig_id,ikpt,jspin,n_start=n_start,n_end=n_end,
< bk=bkpt,wk=wk,
< neig=nbands,eig=eig,
< nv=nv(jspin),k1=k1(:,jspin),
< k2=k2(:,jspin),k3=k3(:,jspin),kveclo=kveclo,
< wk=wk,
< neig=nbands,eig=eig,
< zmat=zmat)
ENDIF
......@@ -162,8 +149,6 @@ c
! IF (nbands>neigd) CALL juDFT_error("nbands.GT.neigd",calledby
! + ="cdn_read")
IF (nv(jspin)>nvd) CALL juDFT_error("nv.GT.nvd",calledby
+ ="cdn_read")
IF (nmat>nbasfcn) CALL juDFT_error("nmat.GT.nbasfcn",calledby
+ ="cdn_read")
......
This diff is collapsed.
......@@ -376,7 +376,7 @@ CONTAINS
vTemp = vTot
CALL eigen(mpi,stars,sphhar,atoms,obsolete,xcpot,&
sym,kpts,DIMENSION,vacuum,input,cell,enpara,banddos,noco,jij,oneD,hybrid,&
it,eig_id,inDen,results,vTemp,vx)
it,eig_id,results,inDen,vTemp,vx)
vTot%mmpMat = vTemp%mmpMat
eig_idList(pc) = eig_id
CALL timestop("eigen")
......
......@@ -539,6 +539,7 @@ MODULE m_types_misc
LOGICAL:: tria
LOGICAL:: integ
LOGICAL:: pallst
LOGICAL:: l_coreSpec
LOGICAL:: l_wann
LOGICAL:: secvar
LOGICAL:: evonly(2)
......@@ -546,6 +547,10 @@ MODULE m_types_misc
LOGICAL:: sso_opt(2)
LOGICAL:: total
LOGICAL:: l_inpXML
REAL :: scaleCell
REAL :: scaleA1
REAL :: scaleA2
REAL :: scaleC
REAL :: ellow
REAL :: elup
REAL :: rkmax
......@@ -553,7 +558,10 @@ MODULE m_types_misc
CHARACTER(LEN=8) :: comment(10)
TYPE(t_efield)::efield
LOGICAL :: l_core_confpot
LOGICAL :: l_useapw
LOGICAL :: l_useapw
LOGICAL :: ldauLinMix
REAL :: ldauMixParam
REAL :: ldauSpinf
END TYPE t_input
TYPE t_sliceplot
......@@ -717,6 +725,18 @@ MODULE m_types_misc
REAL, ALLOCATABLE :: a_r(:), b_r(:)
COMPLEX, ALLOCATABLE :: a_c(:), b_c(:)
END TYPE t_hamOvlp
! type for the input to the calculation of the core spectrum (EELS)
TYPE t_coreSpecInput
integer :: verb ! output verbosity
integer :: atomType ! atomic type used for calculation of core spectra
character(LEN=1) :: edge ! edge character (K,L,M,N,O,P)
integer :: edgeidx(11) ! l-j edges
integer :: lx ! maximum lmax considered in spectra calculation
real :: ek0 ! kinetic energy of incoming electrons
real :: emn ! energy spectrum lower bound
real :: emx ! energy spectrum upper bound
real :: ein ! energy spectrum increment
END TYPE t_coreSpecInput
!
......@@ -844,17 +864,27 @@ MODULE m_types_misc
TYPE t_potden
INTEGER :: iter
INTEGER :: iter
INTEGER :: potdenType
COMPLEX,ALLOCATABLE :: pw(:,:)
REAL,ALLOCATABLE :: mt(:,:,:,:)
REAL,ALLOCATABLE :: vacz(:,:,:)
COMPLEX,ALLOCATABLE :: vacxy(:,:,:,:)
! For density only (noco case)
COMPLEX, ALLOCATABLE :: cdom(:)
COMPLEX, ALLOCATABLE :: cdomvz(:,:)
COMPLEX, ALLOCATABLE :: cdomvxy(:,:,:)
! For density matrix and associated potential matrix
COMPLEX, ALLOCATABLE :: mmpMat(:,:,:,:)
!this type contains two init routines that should be used to allocate
!memory. You can either specify the datatypes or give the dimensions as integers
!See implementation below!
CONTAINS
PROCEDURE :: init_potden_types
PROCEDURE :: init_potden_simple
PROCEDURE :: resetpotden
GENERIC :: init=>init_potden_types,init_potden_simple
END TYPE t_potden
CONTAINS
......@@ -880,8 +910,7 @@ CONTAINS
IF (ANY(err>0)) CALL judft_error("Not enough memory allocating usdus datatype")
END SUBROUTINE usdus_init
SUBROUTINE init_potden_types(pd,stars,atoms,sphhar,vacuum,oneD,jsp,l_noco)
SUBROUTINE init_potden_types(pd,stars,atoms,sphhar,vacuum,noco,oneD,jsp,nocoExtraDim,potden_type)
USE m_judft
IMPLICIT NONE
CLASS(t_potden),INTENT(OUT):: pd
......@@ -889,38 +918,78 @@ CONTAINS
TYPE(t_stars),INTENT(IN) :: stars
TYPE(t_sphhar),INTENT(IN):: sphhar
TYPE(t_vacuum),INTENT(IN):: vacuum
TYPE(t_noco),INTENT(IN) :: noco
TYPE(t_oneD),INTENT(IN) :: oneD
INTEGER,INTENT(IN) :: jsp
LOGICAL,INTENT(IN) :: l_noco
CALL init_potden_simple(pd,stars%ng3,atoms%jmtd,sphhar%nlhd,atoms%ntype,jsp,l_noco,vacuum%nmzd,vacuum%nmzxyd,oneD%odi%n2d)
INTEGER,INTENT(IN) :: jsp, potden_type
LOGICAL,INTENT(IN) :: nocoExtraDim
CALL init_potden_simple(pd,stars%ng3,atoms%jmtd,sphhar%nlhd,atoms%ntype,&
atoms%n_u,noco%l_noco,jsp,nocoExtraDim,potden_type,&
vacuum%nmzd,vacuum%nmzxyd,stars%ng2)
END SUBROUTINE init_potden_types
SUBROUTINE init_potden_simple(pd,ng3,jmtd,nlhd,ntype,jsp,l_noco,nmzd,nmzxyd,n2d)
SUBROUTINE init_potden_simple(pd,ng3,jmtd,nlhd,ntype,n_u,l_noco,jsp,nocoExtraDim,potden_type,nmzd,nmzxyd,n2d)
USE m_constants
USE m_judft
IMPLICIT NONE
CLASS(t_potden),INTENT(OUT) :: pd
INTEGER,INTENT(IN) :: ng3,jmtd,nlhd,ntype,jsp
LOGICAL,INTENT(IN) :: l_noco
INTEGER,INTENT(IN),OPTIONAL :: nmzd,nmzxyd,n2d
INTEGER,INTENT(IN) :: ng3,jmtd,nlhd,ntype,n_u,jsp,potden_type
LOGICAL,INTENT(IN) :: l_noco,nocoExtraDim
INTEGER,INTENT(IN) :: nmzd,nmzxyd,n2d
INTEGER:: err(4)
err=0
pd%iter=0
ALLOCATE(pd%pw(ng3,MERGE(3,jsp,l_noco)),stat=err(1))
ALLOCATE(pd%mt(jmtd,0:nlhd,ntype,jsp),stat=err(2))
IF (PRESENT(nmzd)) THEN
ALLOCATE(pd%vacz(nmzd,2,MERGE(4,jsp,l_noco)),stat=err(3))
ALLOCATE(pd%vacxy(nmzxyd,n2d-1,2,jsp),stat=err(4))
ENDIF
pd%potdenType=potden_type
IF(ALLOCATED(pd%pw)) DEALLOCATE (pd%pw)
IF(ALLOCATED(pd%mt)) DEALLOCATE (pd%mt)
IF(ALLOCATED(pd%vacz)) DEALLOCATE (pd%vacz)
IF(ALLOCATED(pd%vacxy)) DEALLOCATE (pd%vacxy)
IF(ALLOCATED(pd%cdom)) DEALLOCATE (pd%cdom)
IF(ALLOCATED(pd%cdomvz)) DEALLOCATE (pd%cdomvz)
IF(ALLOCATED(pd%cdomvxy)) DEALLOCATE (pd%cdomvxy)
IF(ALLOCATED(pd%mmpMat)) DEALLOCATE (pd%mmpMat)
ALLOCATE (pd%pw(ng3,jsp),stat=err(1))
ALLOCATE (pd%mt(jmtd,0:nlhd,ntype,jsp),stat=err(2))
ALLOCATE (pd%vacz(nmzd,2,MERGE(4,jsp,nocoExtraDim)),stat=err(3))
ALLOCATE (pd%vacxy(nmzxyd,n2d-1,2,jsp),stat=err(4))
IF (l_noco) THEN
ALLOCATE (pd%cdom(ng3))
ALLOCATE (pd%cdomvz(nmzd,2))
ALLOCATE (pd%cdomvxy(nmzxyd,n2d-1,2))
ELSE
ALLOCATE (pd%cdom(1))
ALLOCATE (pd%cdomvz(1,1),pd%cdomvxy(1,1,1))
END IF
ALLOCATE (pd%mmpMat(-lmaxU_const:lmaxU_const,-lmaxU_const:lmaxU_const,MAX(1,n_u),jsp))
IF (ANY(err>0)) CALL judft_error("Not enough memory allocating potential or density")
pd%pw=0.0
pd%pw=CMPLX(0.0,0.0)
pd%mt=0.0
IF (PRESENT(nmzd)) THEN
pd%vacz=0.0
pd%vacxy=0.0
ENDIF
pd%vacz=0.0
pd%vacxy=CMPLX(0.0,0.0)
pd%cdom = CMPLX(0.0,0.0)
pd%cdomvz = CMPLX(0.0,0.0)
pd%cdomvxy = CMPLX(0.0,0.0)
pd%mmpMat = CMPLX(0.0,0.0)
END SUBROUTINE init_potden_simple
SUBROUTINE resetPotDen(pd)
IMPLICIT NONE
CLASS(t_potden),INTENT(INOUT) :: pd
pd%pw=CMPLX(0.0,0.0)
pd%mt=0.0
pd%vacz=0.0
pd%vacxy=CMPLX(0.0,0.0)
pd%cdom = CMPLX(0.0,0.0)
pd%cdomvz = CMPLX(0.0,0.0)
pd%cdomvxy = CMPLX(0.0,0.0)
pd%mmpMat = CMPLX(0.0,0.0)
END SUBROUTINE resetPotDen
END MODULE m_types_misc
......@@ -788,7 +788,7 @@ cccccccccccc read in the eigenvalues and vectors cccccc
if(.not.l_noco) nrec5 = (jspin5-1)*nkpts
call cdn_read0(eig_id,irank,isize,jspin5,wannierspin,l_noco,
< ello,evac,epar,bkpt,wk,n_bands,n_size)
< ello,evac,epar,wk,n_bands,n_size)
enddo
......@@ -964,12 +964,12 @@ c if (mod(i_rec-1,isize).eq.irank) then
ALLOCATE (zzMat%z_c(zzMat%nbasfcn,zzMat%nbands))
END IF
CALL cdn_read(
> eig_id,
> nvd,jspd,irank,isize,kptibz,jspin,nbasfcn, !wannierspin instead of jspd?
> l_ss,l_noco,neigd,n_start,n_end,
< nmat,nv,ello,evdu,epar,kveclo,
< k1,k2,k3,bkpt,wk,nbands,eigg,zzMat)
! CALL cdn_read(
! > eig_id,
! > nvd,jspd,irank,isize,kptibz,jspin,nbasfcn, !wannierspin instead of jspd?
! > l_ss,l_noco,neigd,n_start,n_end,
! < nmat,nv,ello,evdu,epar,
! < wk,nbands,eigg,zzMat)
call cpu_time(t1)
t_eig = t_eig + t1 - t0
......@@ -1003,13 +1003,13 @@ c if (mod(i_rec-1,isize).eq.irank) then
eigg = 0.
call cpu_time(t0)
CALL cdn_read(
> eig_id,
> nvd,jspd,irank,isize,kptibz_b,jspin,nbasfcn, !wannierspin instead of jspd?
> l_ss,l_noco,neigd,n_start,n_end,
< nmat_b,nv_b,ello,evdu,epar,kveclo_b,
< k1_b,k2_b,k3_b,bkpt_b,wk_b,nbands_b,eigg,zzMat)
call judft_error("BUG not implement")
! CALL cdn_read(
! > eig_id,
! > nvd,jspd,irank,isize,kptibz_b,jspin,nbasfcn, !wannierspin instead of jspd?
! > l_ss,l_noco,neigd,n_start,n_end,
! < nmat_b,nv_b,ello,evdu,epar,
! < wk_b,nbands_b,eigg,zzMat)
nslibd_b = 0
......@@ -1055,19 +1055,20 @@ c***********************************************************
c Rotate the wavefunction of next neighbor.
c***********************************************************
if (wann%l_bzsym .and. (oper_b.ne.1) ) then
call wann_kptsrotate(
> natd,nlod,llod,
> ntypd,nlo,llo,invsat,
> l_noco,l_soc,
> ntype,neq,nlotot,
> kveclo_b,jspin,
> oper_b,nop,mrot,nvd,
> nv_b,
> shiftkpt(:,bpt(ikpt_b,ikpt)),
> tau,
x bkpt_b,k1_b(:,:),
x k2_b(:,:),k3_b(:,:),
x zMat_b,nsfactor_b)
! TODO
! call wann_kptsrotate(
! > natd,nlod,llod,
! > ntypd,nlo,llo,invsat,
! > l_noco,l_soc,
! > ntype,neq,nlotot,
! > kveclo_b,jspin,
! > oper_b,nop,mrot,nvd,
! > nv_b,
! > shiftkpt(:,bpt(ikpt_b,ikpt)),
! > tau,
! x bkpt_b,k1_b(:,:),
! x k2_b(:,:),k3_b(:,:),
! x zMat_b,nsfactor_b)
else
nsfactor_b=cmplx(1.0,0.0)
endif
......@@ -1094,10 +1095,10 @@ c***********************************************************
lapw_b%nmat = nmat_b
lapw_b%nv = nv_b
! I think the other variables of lapw are not needed here.
CALL abcof(input,atoms,noccbd_b,sym,cell,bkpt_b,lapw_b,
+ noccbd_b,usdus,noco,jspin,kveclo_b,oneD,
+ acof_b,bcof_b,ccof_b,zMat_b)
!TODO
! CALL abcof(input,atoms,noccbd_b,sym,cell,bkpt_b,lapw_b,
! + noccbd_b,usdus,noco,jspin,kveclo_b,oneD,
! + acof_b,bcof_b,ccof_b,zMat_b)
DEALLOCATE(lapw_b%k1,lapw_b%k2,lapw_b%k3)
......@@ -1123,13 +1124,13 @@ c***********************************************************
WRITE(*,*) 'Here probably the wrong record is read in'
WRITE(*,*) 'Should eig_id not be dependent on iqpt_b?'
WRITE(*,*) '(in wann_uHu)'
CALL cdn_read(
> eig_id,
> nvd,jspd,irank,isize,kptibz_b2,jspin,nbasfcn, !wannierspin instead of jspd?
> l_ss,l_noco,neigd,n_start,n_end,
< nmat_b2,nv_b2,ello,evdu,epar,kveclo_b2,
< k1_b2,k2_b2,k3_b2,bkpt_b2,wk_b2,nbands_b2,
< eigg,zzMat)
! CALL cdn_read(
! > eig_id,
! > nvd,jspd,irank,isize,kptibz_b2,jspin,nbasfcn, !wannierspin instead of jspd?
! > l_ss,l_noco,neigd,n_start,n_end,