Commit bb510313 authored by Gregor Michalicek's avatar Gregor Michalicek

Introduction of first usage of potden%mmpMat

...also in this commit: Replace multiple definitions of lmaxb by a single constant lmaxU_const.
parent 4ee714a9
......@@ -17,7 +17,7 @@ CONTAINS
! nmat, nbasfcn including LO's
! g. bihlmayer '96
!**********************************************************************
USE m_constants, ONLY : pi_const,sfp_const
USE m_constants
USE m_types
USE m_lodpot
USE m_tlmplm
......@@ -83,13 +83,11 @@ CONTAINS
! ..
! .. Local Arrays ..
INTEGER, PARAMETER :: lmaxb=3
INTEGER, ALLOCATABLE :: matind(:,:),kveclo(:)
INTEGER, ALLOCATABLE :: nv2(:)
REAL, ALLOCATABLE :: bkpt(:)
REAL, ALLOCATABLE :: eig(:)
COMPLEX, ALLOCATABLE :: vs_mmp(:,:,:,:)
TYPE(t_tlmplm) :: td
TYPE(t_usdus) :: ud
TYPE(t_lapw) :: lapw
......@@ -203,7 +201,10 @@ CONTAINS
matsize = ((DIMENSION%nbasfcn+1)/2)*DIMENSION%nbasfcn
ENDIF
ENDIF
IF (matsize<2) CALL judft_error("Wrong size of matrix",calledby="eigen",hint="Your basis might be too large or the parallelization fail or ??")
IF (matsize<2) THEN
CALL judft_error("Wrong size of matrix",calledby="eigen",&
hint="Your basis might be too large or the parallelization fail or ??")
END IF
ne = DIMENSION%neigd
eig_id=open_eig(&
......@@ -248,10 +249,10 @@ CONTAINS
! ..
! LDA+U
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)
ALLOCATE( v%mmpMat(-lmaxU_const:lmaxU_const,-lmaxU_const:lmaxU_const,atoms%n_u,input%jspins) )
CALL u_setup(sym,atoms,sphhar,input, enpara%el0(0:,:,:),v,mpi,results)
ELSE
ALLOCATE( vs_mmp(-lmaxb:-lmaxb,-lmaxb:-lmaxb,1,2) )
ALLOCATE( v%mmpMat(-lmaxU_const:-lmaxU_const,-lmaxU_const:-lmaxU_const,1,2) )
ENDIF
!
!---> loop over k-points: each can be a separate task
......@@ -281,7 +282,7 @@ CONTAINS
ENDIF
lh0=1
CALL tlmplm(sphhar,atoms,DIMENSION,enpara, jsp,1,mpi, v%mt(1,0,1,jsp),lh0,input, td,ud)
IF (input%l_f) CALL write_tlmplm(td,vs_mmp,atoms%n_u>0,1,jsp,input%jspins)
IF (input%l_f) CALL write_tlmplm(td,v%mmpMat,atoms%n_u>0,1,jsp,input%jspins)
CALL timestop("tlmplm")
!---> pk non-collinear
......@@ -292,7 +293,7 @@ CONTAINS
isp = 2
CALL timestart("tlmplm")
CALL tlmplm(sphhar,atoms,DIMENSION,enpara,isp,isp,mpi, v%mt(1,0,1,isp),lh0,input, td,ud)
IF (input%l_f) CALL write_tlmplm(td,vs_mmp,atoms%n_u>0,2,2,input%jspins)
IF (input%l_f) CALL write_tlmplm(td,v%mmpMat,atoms%n_u>0,2,2,input%jspins)
CALL timestop("tlmplm")
ENDIF
!
......@@ -331,7 +332,7 @@ CONTAINS
IF (.NOT.l_wu) THEN
CALL timestart("MT Hamiltonian&Overlap")
CALL hsmt(DIMENSION,atoms,sphhar,sym,enpara, mpi%SUB_COMM,mpi%n_size,mpi%n_rank,jsp,input,mpi,&
lmaxb, noco,cell, lapw, bkpt,v%mt, vs_mmp, oneD,ud, kveclo,td,l_real,hamOvlp)
lmaxU_const, noco,cell, lapw, bkpt,v%mt,v%mmpMat, oneD,ud, kveclo,td,l_real,hamOvlp)
CALL timestop("MT Hamiltonian&Overlap")
ENDIF
!
......@@ -422,7 +423,7 @@ ENDIF
DEALLOCATE (td%ind,td%tuulo,td%tdulo)
DEALLOCATE (td%tuloulo)
END DO ! spin loop ends
DEALLOCATE( vs_mmp )
DEALLOCATE(v%mmpMat)
DEALLOCATE (matind)
IF (l_real) THEN
DEALLOCATE(hamOvlp%a_r,hamOvlp%b_r)
......
......@@ -54,7 +54,6 @@ CONTAINS
COMPLEX, INTENT (IN) :: cveccof(3,-atoms%llod:atoms%llod,nobd,atoms%nlod,atoms%nat)
! ..
! .. Local Scalars ..
INTEGER, PARAMETER :: lmaxb=3
COMPLEX dtd,dtu,utd,utu
INTEGER lo, mlotot, mlolotot, mlot_d, mlolot_d
INTEGER i,ie,im,in,l1,l2,ll1,ll2,lm1,lm2,m1,m2,n,natom,m,i_u
......@@ -88,7 +87,7 @@ CONTAINS
a21(3,atoms%nat),b4(3,atoms%nat),tlmplm%ind(0:DIMENSION%lmd,0:DIMENSION%lmd,atoms%ntype,1) )
!
IF(atoms%n_u.GT.0) THEN
ALLOCATE(v_mmp(-lmaxb:lmaxb,-lmaxb:lmaxb,atoms%n_u))
ALLOCATE(v_mmp(-lmaxU_const:lmaxU_const,-lmaxU_const:lmaxU_const,atoms%n_u))
v_mmp = CMPLX(0.0,0.0)
CALL read_tlmplm_vs_mmp(jsp,atoms%n_u,v_mmp)
END IF
......@@ -197,7 +196,7 @@ CONTAINS
cveccof, tlmplm,usdus, a21)
IF ((atoms%n_u.GT.0).AND.(i_u.LE.atoms%n_u)) THEN
CALL force_a21_U(nobd,atoms,lmaxb,i_u,n,jsp,we,ne,&
CALL force_a21_U(nobd,atoms,i_u,n,jsp,we,ne,&
usdus,v_mmp,acof,bcof,ccof,&
aveccof,bveccof,cveccof, a21)
END IF
......
MODULE m_forcea21U
CONTAINS
SUBROUTINE force_a21_U(nobd,atoms,lmaxb,i_u,itype,isp,we,ne,&
SUBROUTINE force_a21_U(nobd,atoms,i_u,itype,isp,we,ne,&
usdus,v_mmp, acof,bcof,ccof,aveccof,bveccof,cveccof, a21)
!
!***********************************************************************
......@@ -9,6 +9,7 @@ CONTAINS
! Comp.Phys.Comm. 179 (2008) 784-790
!***********************************************************************
!
USE m_constants
USE m_types
IMPLICIT NONE
......@@ -17,13 +18,13 @@ CONTAINS
! ..
! .. Scalar Arguments ..
INTEGER, INTENT (IN) :: nobd
INTEGER, INTENT (IN) :: itype,isp,ne,lmaxb
INTEGER, INTENT (IN) :: itype,isp,ne
INTEGER, INTENT (INOUT) :: i_u ! on input: index for the first U for atom type "itype or higher"
! on exit: index for the first U for atom type "itype+1 or higher"
! ..
! .. Array Arguments ..
REAL, INTENT (IN) :: we(nobd)
COMPLEX, INTENT (IN) :: v_mmp(-lmaxb:lmaxb,-lmaxb:lmaxb,atoms%n_u)
COMPLEX, INTENT (IN) :: v_mmp(-lmaxU_const:lmaxU_const,-lmaxU_const:lmaxU_const,atoms%n_u)
COMPLEX, INTENT (IN) :: acof(:,0:,:)!(nobd,0:dimension%lmd,atoms%nat)
COMPLEX, INTENT (IN) :: bcof(:,0:,:)!(nobd,0:dimension%lmd,atoms%nat)
COMPLEX, INTENT (IN) :: ccof(-atoms%llod:atoms%llod,nobd,atoms%nlod,atoms%nat)
......
......@@ -10,6 +10,7 @@
INTEGER, PARAMETER :: noState_const = 0
INTEGER, PARAMETER :: coreState_const = 1
INTEGER, PARAMETER :: valenceState_const = 2
INTEGER, PARAMETER :: lmaxU_const = 3
REAL, PARAMETER :: pi_const=3.1415926535897932
REAL, PARAMETER :: tpi_const=2.*3.1415926535897932
REAL, PARAMETER :: fpi_const=4.*3.1415926535897932
......
......@@ -906,7 +906,7 @@ MODULE m_types
COMPLEX, ALLOCATABLE :: cdomvxy(:,:,:)
! For density matrix and associated potential matrix
COMPLEX, ALLOCATABLE :: mmp_Mat(:,:,:,:)
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
......
......@@ -17,12 +17,13 @@ MODULE m_usetup
! Extension to multiple U per atom type G.M. 2017 |
!-------------------------------------------------------------------+
CONTAINS
SUBROUTINE u_setup(sym,atoms,lmaxb,sphhar, input,el,vr,mpi, vs_mmp,results,number)
SUBROUTINE u_setup(sym,atoms,sphhar, input,el,pot,mpi,results)
USE m_umtx
USE m_uj2f
USE m_nmat_rot
USE m_vmmp
USE m_types
USE m_constants
IMPLICIT NONE
TYPE(t_sym),INTENT(IN) :: sym
TYPE(t_results),INTENT(INOUT) :: results
......@@ -30,14 +31,9 @@ CONTAINS
TYPE(t_input),INTENT(IN) :: input
TYPE(t_sphhar),INTENT(IN) :: sphhar
TYPE(t_atoms),INTENT(INOUT) :: atoms !n_u might be modified if no density matrix is found
TYPE(t_potden),INTENT(INOUT) :: pot
! ... Arguments ...
INTEGER, INTENT (IN) :: lmaxb
REAL, INTENT (IN) :: el(0:,:,:) !(0:atoms%lmaxd,ntype,jspd)
REAL, INTENT (IN) :: vr(:,0:,:,:) !(atoms%jmtd,0:sphhar%nlhd,ntype,jspd)
COMPLEX,INTENT (OUT)::vs_mmp(-lmaxb:lmaxb,-lmaxb:lmaxb,atoms%n_u,input%jspins)
INTEGER,INTENT(IN),OPTIONAL::number
REAL, INTENT(IN) :: el(0:,:,:) !(0:atoms%lmaxd,ntype,jspd)
! ... Local Variables ...
INTEGER itype,ispin,j,k,l,jspin,urec,i_u
INTEGER noded,nodeu,ios,lty(atoms%n_u)
......@@ -53,9 +49,6 @@ CONTAINS
! look, whether density matrix exists already:
!
filename="n_mmp_mat"
IF (PRESENT(number)) THEN
WRITE(filename,"('n_mmp_mat.',i0)") number
ENDIF
INQUIRE (file=filename,exist=n_mmp_exist)
IF (n_mmp_exist.AND.atoms%n_u>0) THEN
!
......@@ -66,21 +59,21 @@ CONTAINS
!
! set up e-e- interaction matrix
!
ALLOCATE ( u(-lmaxb:lmaxb,-lmaxb:lmaxb,&
-lmaxb:lmaxb,-lmaxb:lmaxb,atoms%n_u,input%jspins) )
ALLOCATE (u(-lmaxU_const:lmaxU_const,-lmaxU_const:lmaxU_const,&
-lmaxU_const:lmaxU_const,-lmaxU_const:lmaxU_const,atoms%n_u,input%jspins))
DO ispin = 1, 1 ! input%jspins
f0(:,1) = (f0(:,1) + f0(:,input%jspins) ) / 2
f2(:,1) = (f2(:,1) + f2(:,input%jspins) ) / 2
f4(:,1) = (f4(:,1) + f4(:,input%jspins) ) / 2
f6(:,1) = (f6(:,1) + f6(:,input%jspins) ) / 2
CALL umtx(atoms,lmaxb,f0(1,ispin),&
CALL umtx(atoms,f0(1,ispin),&
f2(1,ispin),f4(1,ispin),f6(1,ispin),&
u(-lmaxb,-lmaxb,-lmaxb,-lmaxb,1,ispin) )
u(-lmaxU_const,-lmaxU_const,-lmaxU_const,-lmaxU_const,1,ispin) )
END DO
!
! read density matrix
!
ALLOCATE (ns_mmp(-lmaxb:lmaxb,-lmaxb:lmaxb,atoms%n_u,input%jspins))
ALLOCATE (ns_mmp(-lmaxU_const:lmaxU_const,-lmaxU_const:lmaxU_const,atoms%n_u,input%jspins))
OPEN (69,file=filename,status='unknown',form='formatted')
READ (69,9000) ns_mmp
9000 FORMAT(7f20.13)
......@@ -110,8 +103,8 @@ CONTAINS
!
! calculate potential matrix and total energy correction
!
CALL v_mmp(sym,atoms,input%jspins,lmaxb,ns_mmp,u,f0,f2,&
vs_mmp,results)
CALL v_mmp(sym,atoms,input%jspins,ns_mmp,u,f0,f2,&
pot%mmpMat,results)
IF (mpi%irank.EQ.0) THEN
DO jspin = 1,input%jspins
WRITE (6,'(a7,i3)') 'spin #',jspin
......@@ -128,7 +121,7 @@ CONTAINS
ELSE
WRITE (6,*) 'using the atomic limit of LDA+U '
ENDIF
WRITE (6,l_form) ((vs_mmp(k,j,i_u,jspin),k=-l,l),j=-l,l)
WRITE (6,l_form) ((pot%mmpMat(k,j,i_u,jspin),k=-l,l),j=-l,l)
END DO
END DO
WRITE (6,*) results%e_ldau
......@@ -139,7 +132,7 @@ CONTAINS
WRITE (*,*) 'no density matrix found ... skipping LDA+U'
WRITE(*,*) "File:",filename
ENDIF
vs_mmp(:,:,:,:) = CMPLX(0.0,0.0)
pot%mmpMat(:,:,:,:) = CMPLX(0.0,0.0)
results%e_ldau = 0.0
ENDIF
......
......@@ -6,7 +6,7 @@ MODULE m_umtx
!* Extension to multiple U per atom type by G.M. 2017 *
!*********************************************************************
CONTAINS
SUBROUTINE umtx(atoms,lmaxb,f0,f2,f4,f6,&
SUBROUTINE umtx(atoms,f0,f2,f4,f6,&
u)
USE m_constants
......@@ -14,16 +14,17 @@ CONTAINS
USE m_types
IMPLICIT NONE
INTEGER, PARAMETER :: lmaxw=3,lmmaxw1=(2*lmaxw+2)**2
TYPE(t_atoms), INTENT(IN) :: atoms
INTEGER, INTENT (IN) :: lmaxb
REAL, INTENT (IN) :: f0(atoms%n_u),f2(atoms%n_u),f4(atoms%n_u),f6(atoms%n_u)
REAL, INTENT (OUT) :: u(-lmaxb:lmaxb,-lmaxb:lmaxb,-lmaxb:lmaxb,-lmaxb:lmaxb,atoms%n_u)
TYPE(t_atoms), INTENT(IN) :: atoms
REAL, INTENT(IN) :: f0(atoms%n_u),f2(atoms%n_u),f4(atoms%n_u),f6(atoms%n_u)
REAL, INTENT(OUT) :: u(-lmaxU_const:lmaxU_const,-lmaxU_const:lmaxU_const,&
-lmaxU_const:lmaxU_const,-lmaxU_const:lmaxU_const,atoms%n_u)
INTEGER, PARAMETER :: lmaxw=3,lmmaxw1=(2*lmaxw+2)**2
INTEGER i,j,k,l,m,mk,nfk,itype,i_u
INTEGER m1,m2,m3,m4,lm1,lm2,lm3,lm4,kf
REAL uk,uq,avu,avj,cgk1,cgk2,tol
REAL fk(lmaxb+1,atoms%n_u)
REAL fk(lmaxU_const+1,atoms%n_u)
REAL, ALLOCATABLE :: c(:,:,:)
!
tol = 1.0e-14
......@@ -54,7 +55,7 @@ CONTAINS
END DO
END DO
CALL sgaunt(lmaxw,lmmaxw1,lmaxb,c)
CALL sgaunt(lmaxw,lmmaxw1,lmaxU_const,c)
DO i_u = 1, atoms%n_u !!! over U parameters
l = atoms%lda_u(i_u)%l
......
......@@ -19,7 +19,7 @@ MODULE m_vmmp
! Extension to multiple U per atom type G.M. 2017
! ************************************************************
CONTAINS
SUBROUTINE v_mmp(sym,atoms,jspins,lmaxb,ns_mmp,u,f0,f2, vs_mmp,results)
SUBROUTINE v_mmp(sym,atoms,jspins,ns_mmp,u,f0,f2, vs_mmp,results)
USE m_types
USE m_constants
......@@ -29,13 +29,14 @@ CONTAINS
TYPE(t_atoms),INTENT(IN) :: atoms
!
! .. Arguments ..
INTEGER, INTENT (IN) :: lmaxb,jspins
REAL, INTENT (IN) :: u(-lmaxb:lmaxb,-lmaxb:lmaxb, -lmaxb:lmaxb,-lmaxb:lmaxb,atoms%n_u)
REAL, INTENT (IN) :: f0(atoms%n_u),f2(atoms%n_u)
INTEGER, INTENT(IN) :: jspins
REAL, INTENT(IN) :: u(-lmaxU_const:lmaxU_const,-lmaxU_const:lmaxU_const,&
-lmaxU_const:lmaxU_const,-lmaxU_const:lmaxU_const,atoms%n_u)
REAL, INTENT(IN) :: f0(atoms%n_u),f2(atoms%n_u)
COMPLEX, INTENT(OUT) :: vs_mmp(-lmaxU_const:lmaxU_const,-lmaxU_const:lmaxU_const,atoms%n_u,jspins)
COMPLEX :: ns_mmp(-lmaxU_const:lmaxU_const,-lmaxU_const:lmaxU_const,atoms%n_u,jspins)
COMPLEX :: ns_mmp(-lmaxb:lmaxb,-lmaxb:lmaxb,atoms%n_u,jspins)
COMPLEX,INTENT(OUT)::vs_mmp(-lmaxb:lmaxb,-lmaxb:lmaxb,atoms%n_u,jspins)
!
! .. Local Variables ..
INTEGER ispin,jspin,l ,mp,p,q,itype,m,i_u
REAL rho_tot,u_htr,j_htr,e_ee,ns_sum,spin_deg,e_dc,e_dcc
......
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