Commit 2f7924c5 authored by Daniel Wortmann's avatar Daniel Wortmann

Mixing for fully-fully noco implemented. I guess it is time for testing now...

parent f060ae98
......@@ -141,7 +141,7 @@ CONTAINS
IF (mpi%irank.EQ.0) CALL openXMLElementNoAttributes('scfLoop')
! Initialize and load inDen density (start)
CALL inDen%init(stars,atoms,sphhar,vacuum,input%jspins,noco%l_noco,POTDEN_TYPE_DEN)
CALL inDen%init(stars,atoms,sphhar,vacuum,noco,input%jspins,POTDEN_TYPE_DEN)
archiveType = CDN_ARCHIVE_TYPE_CDN1_const
IF (noco%l_noco) archiveType = CDN_ARCHIVE_TYPE_NOCO_const
IF(mpi%irank.EQ.0) THEN
......@@ -156,10 +156,10 @@ CONTAINS
! Initialize and load inDen density (end)
! Initialize potentials (start)
CALL vTot%init(stars,atoms,sphhar,vacuum,input%jspins,noco%l_noco,POTDEN_TYPE_POTTOT)
CALL vCoul%init(stars,atoms,sphhar,vacuum,input%jspins,noco%l_noco,POTDEN_TYPE_POTCOUL)
CALL vx%init(stars,atoms,sphhar,vacuum,input%jspins,.FALSE.,POTDEN_TYPE_POTCOUL)
CALL vTemp%init(stars,atoms,sphhar,vacuum,input%jspins,noco%l_noco,POTDEN_TYPE_POTTOT)
CALL vTot%init(stars,atoms,sphhar,vacuum,noco,input%jspins,POTDEN_TYPE_POTTOT)
CALL vCoul%init(stars,atoms,sphhar,vacuum,noco,input%jspins,POTDEN_TYPE_POTCOUL)
CALL vx%init(stars,atoms,sphhar,vacuum,noco,input%jspins,POTDEN_TYPE_POTCOUL)
CALL vTemp%init(stars,atoms,sphhar,vacuum,noco,input%jspins,POTDEN_TYPE_POTTOT)
! Initialize potentials (end)
! Open/allocate eigenvector storage (start)
......@@ -344,7 +344,7 @@ CONTAINS
! charge density generation
CALL timestart("generation of new charge density (total)")
CALL outDen%init(stars,atoms,sphhar,vacuum,input%jspins,noco%l_noco,POTDEN_TYPE_DEN)
CALL outDen%init(stars,atoms,sphhar,vacuum,noco,input%jspins,POTDEN_TYPE_DEN)
outDen%iter = inDen%iter
CALL cdngen(eig_id,mpi,input,banddos,sliceplot,vacuum,DIMENSION,kpts,atoms,sphhar,stars,sym,&
enpara,cell,noco,vTot,results,oneD,coreSpecInput,archiveType,outDen)
......
......@@ -110,7 +110,8 @@ contains
!complex independ of invs and invs2.
if ( noco%l_noco ) then
mmap = mmap + 2 * stars%ng3 + 2 * vacuum%nmzxyd * ( oneD%odi%n2d - 1 ) * vacuum%nvac + &
2 * vacuum%nmzd * vacuum%nvac
2 * vacuum%nmzd * vacuum%nvac
IF (noco%l_mtnocopot) mmap= mmap+ 2*atoms%ntype * ( sphhar%nlhd + 1 ) * atoms%jmtd
end if
! LDA+U (start)
......@@ -231,8 +232,8 @@ contains
! KERKER PRECONDITIONER
if( input%preconditioning_param /= 0 ) then
call resDen%init( stars, atoms, sphhar, vacuum, input%jspins, noco%l_noco, POTDEN_TYPE_DEN )
call vYukawa%init( stars, atoms, sphhar, vacuum, input%jspins, noco%l_noco, 4 )
CALL resDen%init( stars, atoms, sphhar, vacuum, noco, input%jspins, POTDEN_TYPE_DEN )
CALL vYukawa%init( stars, atoms, sphhar, vacuum, noco, input%jspins, 4 )
MPI0_b: if( mpi%irank == 0 ) then
call resDen%subPotDen( outDen, inDen )
if( input%jspins == 2 ) call resDen%SpinsToChargeAndMagnetisation()
......
......@@ -70,7 +70,7 @@ CONTAINS
#endif
ALLOCATE(vCoul%pw_w(SIZE(den%pw,1),1))
CALL workDen%init(stars,atoms,sphhar,vacuum,input%jspins,noco%l_noco,0)
CALL workDen%init(stars,atoms,sphhar,vacuum,noco,input%jspins,noco%l_noco,0)
!sum up both spins in den into workden
CALL den%sum_both_spin(workden)
......@@ -81,7 +81,7 @@ CONTAINS
vCoul%mt(:,:,:,input%jspins)=vCoul%mt(:,:,:,1)
IF (noco%l_noco) THEN
CALL denRot%init(stars,atoms,sphhar,vacuum,input%jspins,noco%l_noco,0)
CALL denRot%init(stars,atoms,sphhar,vacuum,noco,input%jspins,noco%l_noco,0)
denRot=den
CALL rotate_int_den_to_local(DIMENSION,sym,stars,atoms,sphhar,vacuum,cell,input,noco,oneD,denRot)
IF (noco%l_mtnocoPot) CALL rotate_mt_den_to_local(atoms,sphhar,sym,denrot)
......
......@@ -100,6 +100,7 @@ CONTAINS
j = j + 1
sout(j) = AIMAG(den%pw(i,3))
END DO
IF (input%film) THEN
DO iv = 1,vacuum%nvac
DO k = 1,vacuum%nmz
......@@ -139,6 +140,21 @@ CONTAINS
CALL juDFT_error("brysh1:# of vacuum coeff. inconsistent" ,calledby ="brysh1")
ENDIF
END IF
!MT part
IF (noco%l_mtnocopot) THEN
na = 1
DO n = 1,atoms%ntype
DO l = 0,sphhar%nlh(atoms%ntypsy(na))
DO i = 1,atoms%jri(n)
j = j + 1
sout(j) = den%mt(i,l,n,3)
j = j + 1
sout(j) = den%mt(i,l,n,4)
END DO
END DO
na = na + atoms%neq(n)
END DO
END IF
ENDIF ! noco
IF (atoms%n_u > 0 ) THEN ! lda+U
......
......@@ -114,6 +114,21 @@ CONTAINS
END DO
END DO
END IF
!MT part
IF (noco%l_mtnocopot) THEN
na = 1
DO n = 1,atoms%ntype
DO l = 0,sphhar%nlh(atoms%ntypsy(na))
DO i = 1,atoms%jri(n)
j = j + 1
den%mt(i,l,n,3)=s_in(j)
j = j + 1
den%mt(i,l,n,4)=s_in(j)
END DO
END DO
na = na + atoms%neq(n)
END DO
END IF
ENDIF
IF ( atoms%n_u > 0 ) THEN
......
......@@ -34,7 +34,7 @@ CONTAINS
REAL, INTENT (OUT) :: sout(mmap)
! Local Scalars
INTEGER :: imap,ivac,iz,j,js,k2,l,n,iv2c,iv2,na,ioff
INTEGER :: imap,ivac,iz,j,js,k2,l,n,iv2c,iv2,na,ioff,i
REAL :: dvol,dxn,dxn2,dxn4,volnstr2
LOGICAL :: l_pot
......@@ -198,6 +198,24 @@ CONTAINS
END DO
END DO
END IF
!mt offdiagonal part
imap=2*nmaph + 2*stars%ng3 + mapvac2/2*(js-1) + imap-1
ioff=MERGE(stars%ng3,2*stars%ng2,sym%invs)+1
j=0
IF (noco%l_mtnocopot) THEN
na = 1
DO n = 1,atoms%ntype
DO l = 0,sphhar%nlh(atoms%ntypsy(na))
DO i = 1,atoms%jri(n)
j = j + 1
sout(imap+j) = g(ioff+(j-1)/2)*s_in(imap+j)
j = j + 1
sout(imap+j) = g(ioff+(j-1)/2)*s_in(imap+j)
END DO
END DO
na = na + atoms%neq(n)
END DO
END IF
END IF
! density matrix
......
......@@ -74,8 +74,8 @@ SUBROUTINE rdmft(eig_id,mpi,input,kpts,banddos,cell,atoms,enpara,stars,vacuum,di
CALL regCharges%init(input,atoms)
CALL dos%init(input,atoms,dimension,kpts,vacuum)
CALL moments%init(input,atoms)
CALL overallDen%init(stars,atoms,sphhar,vacuum,input%jspins,noco%l_noco,POTDEN_TYPE_DEN)
CALL overallVCoul%init(stars,atoms,sphhar,vacuum,input%jspins,noco%l_noco,POTDEN_TYPE_POTCOUL)
CALL overallDen%init(stars,atoms,sphhar,vacuum,noco,input%jspins,POTDEN_TYPE_DEN)
CALL overallVCoul%init(stars,atoms,sphhar,vacuum,noco,input%jspins,POTDEN_TYPE_POTCOUL)
ALLOCATE(overallVCoul%pw_w(SIZE(overallDen%pw,1),1))
IF (ALLOCATED(vTot%pw_w)) DEALLOCATE (vTot%pw_w)
ALLOCATE(vTot%pw_w(SIZE(overallDen%pw,1),1))
......@@ -116,7 +116,7 @@ SUBROUTINE rdmft(eig_id,mpi,input,kpts,banddos,cell,atoms,enpara,stars,vacuum,di
! Call cdnval to construct density
WRITE(*,*) 'Note: some optional flags may have to be reset in rdmft before the cdnval call'
WRITE(*,*) 'This is not yet implemented!'
CALL singleStateDen%init(stars,atoms,sphhar,vacuum,input%jspins,noco%l_noco,POTDEN_TYPE_DEN)
CALL singleStateDen%init(stars,atoms,sphhar,vacuum,noco,input%jspins,POTDEN_TYPE_DEN)
CALL cdnval(eig_id,mpi,kpts,jsp,noco,input,banddos,cell,atoms,enpara,stars,vacuum,dimension,&
sphhar,sym,vTot,oneD,cdnvalJob,singleStateDen,regCharges,dos,results,moments)
......
......@@ -171,7 +171,7 @@ CONTAINS
end subroutine
SUBROUTINE init_potden_types(pd,stars,atoms,sphhar,vacuum,jspins,nocoExtraDim,potden_type)
SUBROUTINE init_potden_types(pd,stars,atoms,sphhar,vacuum,noco,jspins,potden_type)
USE m_judft
USE m_types_setup
IMPLICIT NONE
......@@ -180,21 +180,21 @@ 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
INTEGER,INTENT(IN) :: jspins, potden_type
LOGICAL,INTENT(IN) :: nocoExtraDim
CALL init_potden_simple(pd,stars%ng3,atoms%jmtd,sphhar%nlhd,atoms%ntype,&
atoms%n_u,jspins,nocoExtraDim,potden_type,&
vacuum%nmzd,vacuum%nmzxyd,stars%ng2)
atoms%n_u,jspins,noco%l_noco,noco%l_mtnocopot,potden_type,&
vacuum%nmzd,vacuum%nmzxyd,stars%ng2)
END SUBROUTINE init_potden_types
SUBROUTINE init_potden_simple(pd,ng3,jmtd,nlhd,ntype,n_u,jspins,nocoExtraDim,potden_type,nmzd,nmzxyd,n2d)
SUBROUTINE init_potden_simple(pd,ng3,jmtd,nlhd,ntype,n_u,jspins,nocoExtraDim,nocoExtraMTDim,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,n_u,jspins,potden_type
LOGICAL,INTENT(IN) :: nocoExtraDim
LOGICAL,INTENT(IN) :: nocoExtraDim,nocoExtraMTDim
INTEGER,INTENT(IN) :: nmzd,nmzxyd,n2d
INTEGER:: err(4)
......@@ -208,7 +208,7 @@ CONTAINS
IF(ALLOCATED(pd%vacxy)) DEALLOCATE (pd%vacxy)
IF(ALLOCATED(pd%mmpMat)) DEALLOCATE (pd%mmpMat)
ALLOCATE (pd%pw(ng3,MERGE(3,jspins,nocoExtraDim)),stat=err(1))
ALLOCATE (pd%mt(jmtd,0:nlhd,ntype,jspins),stat=err(2))
ALLOCATE (pd%mt(jmtd,0:nlhd,ntype,MERGE(4,jspins,nocoExtraMTDim)),stat=err(2))
ALLOCATE (pd%vacz(nmzd,2,MERGE(4,jspins,nocoExtraDim)),stat=err(3))
ALLOCATE (pd%vacxy(nmzxyd,n2d-1,2,MERGE(3,jspins,nocoExtraDim)),stat=err(4))
......@@ -221,7 +221,180 @@ CONTAINS
pd%vacxy=CMPLX(0.0,0.0)
pd%mmpMat = CMPLX(0.0,0.0)
END SUBROUTINE init_potden_simple
!!$#CPP_TODO_copy !code from brysh1,brysh2...
!!$ SUBROUTINE get_combined_vector(input,stars,atoms,sphhar,noco,vacuum,sym,oneD,&
!!$ den,nmap,nmaph,mapmt,mapvac2,sout)
!!$ !This was brysh1 before
!!$ USE m_types
!!$ IMPLICIT NONE
!!$ TYPE(t_oneD),INTENT(IN) :: oneD
!!$ TYPE(t_input),INTENT(IN) :: input
!!$ TYPE(t_vacuum),INTENT(IN) :: vacuum
!!$ TYPE(t_noco),INTENT(IN) :: noco
!!$ TYPE(t_sym),INTENT(IN) :: sym
!!$ TYPE(t_stars),INTENT(IN) :: stars
!!$ TYPE(t_sphhar),INTENT(IN) :: sphhar
!!$ TYPE(t_atoms),INTENT(IN) :: atoms
!!$ TYPE(t_potden),INTENT(IN) :: den
!!$
!!$ ! Scalar Arguments
!!$ INTEGER, INTENT (OUT) :: mapmt,mapvac2,nmap,nmaph
!!$
!!$ ! Array Arguments
!!$ REAL,ALLOCATABLE,INTENT (OUT) :: sout(:)
!!$
!!$ ! Local Scalars
!!$ INTEGER i,iv,j,js,k,l,n,na,nvaccoeff,nvaccoeff2,mapmtd
!!$
!!$ !Calculation of size
!!$ i=SIZE(den%mt)+MERGE(SIZE(den%pw),2*SIZE(den%pw),sym%invs)+SIZE(den%vacxz)+MERGE(SIZE(den%vacz)*2,SIZE(den%vacz),sym%invs)
!!$ IF (noco%l_mtnocopot.AND.sym%invs) i=i+
!!$
!!$
!!$
!!$ !---> put input into arrays sout
!!$ ! in the spin polarized case the arrays consist of
!!$ ! spin up and spin down densities
!!$
!!$ j=0
!!$ DO js = 1,input%jspins
!!$ DO i = 1,stars%ng3
!!$ j = j + 1
!!$ sout(j) = REAL(den%pw(i,js))
!!$ END DO
!!$ IF (.NOT.sym%invs) THEN
!!$ DO i = 1,stars%ng3
!!$ j = j + 1
!!$ sout(j) = AIMAG(den%pw(i,js))
!!$ END DO
!!$ ENDIF
!!$ mapmt=0
!!$ na = 1
!!$ DO n = 1,atoms%ntype
!!$ DO l = 0,sphhar%nlh(atoms%ntypsy(na))
!!$ DO i = 1,atoms%jri(n)
!!$ mapmt = mapmt +1
!!$ j = j + 1
!!$ sout(j) = den%mt(i,l,n,js)
!!$ END DO
!!$ END DO
!!$ na = na + atoms%neq(n)
!!$ END DO
!!$ IF (input%film) THEN
!!$ DO iv = 1,vacuum%nvac
!!$ DO k = 1,vacuum%nmz
!!$ j = j + 1
!!$ sout(j) = den%vacz(k,iv,js)
!!$ END DO
!!$ DO k = 1,stars%ng2-1
!!$ DO i = 1,vacuum%nmzxy
!!$ j = j + 1
!!$ sout(j) = REAL(den%vacxy(i,k,iv,js))
!!$ END DO
!!$ END DO
!!$ IF (.NOT.sym%invs2) THEN
!!$ DO k = 1,stars%ng2-1
!!$ DO i = 1,vacuum%nmzxy
!!$ j = j + 1
!!$ sout(j) = AIMAG(den%vacxy(i,k,iv,js))
!!$ END DO
!!$ END DO
!!$ END IF
!!$ END DO
!!$ END IF
!!$ IF (js .EQ. 1) nmaph = j
!!$ ENDDO
!!$
!!$ mapvac2=0
!!$ IF (noco%l_noco) THEN
!!$ !---> off-diagonal part of the density matrix
!!$ DO i = 1,stars%ng3
!!$ j = j + 1
!!$ sout(j) = REAL(den%pw(i,3))
!!$ END DO
!!$ DO i = 1,stars%ng3
!!$ j = j + 1
!!$ sout(j) = AIMAG(den%pw(i,3))
!!$ END DO
!!$ IF (input%film) THEN
!!$ DO iv = 1,vacuum%nvac
!!$ DO k = 1,vacuum%nmz
!!$ mapvac2 = mapvac2 + 1
!!$ j = j + 1
!!$ sout(j) = den%vacz(k,iv,3)
!!$ END DO
!!$ DO k = 1,stars%ng2-1
!!$ DO i = 1,vacuum%nmzxy
!!$ mapvac2 = mapvac2 + 1
!!$ j = j + 1
!!$ sout(j) = REAL(den%vacxy(i,k,iv,3))
!!$ END DO
!!$ END DO
!!$ END DO
!!$ DO iv = 1,vacuum%nvac
!!$ DO k = 1,vacuum%nmz
!!$ mapvac2 = mapvac2 + 1
!!$ j = j + 1
!!$ sout(j) = den%vacz(k,iv,4)
!!$ END DO
!!$ DO k = 1,stars%ng2-1
!!$ DO i = 1,vacuum%nmzxy
!!$ mapvac2 = mapvac2 + 1
!!$ j = j + 1
!!$ sout(j) = AIMAG(den%vacxy(i,k,iv,3))
!!$ END DO
!!$ END DO
!!$ END DO
!!$ nvaccoeff2 = 2*vacuum%nmzxy*(stars%ng2-1)*vacuum%nvac + 2*vacuum%nmz*vacuum%nvac
!!$ IF (mapvac2 .NE. nvaccoeff2) THEN
!!$ WRITE (6,*)'The number of vaccum coefficients off the'
!!$ WRITE (6,*)'off-diagonal part of the density matrix is'
!!$ WRITE (6,*)'inconsitent:'
!!$ WRITE (6,8000) mapvac2,nvaccoeff2
!!$8000 FORMAT ('mapvac2= ',i12,'nvaccoeff2= ',i12)
!!$ CALL juDFT_error("brysh1:# of vacuum coeff. inconsistent" ,calledby ="brysh1")
!!$ ENDIF
!!$ END IF
!!$ ENDIF ! noco
!!$
!!$ IF (atoms%n_u > 0 ) THEN ! lda+U
!!$ DO js = 1,input%jspins
!!$ DO n = 1, atoms%n_u
!!$ DO k = -3, 3
!!$ DO i = -3, 3
!!$ j = j + 1
!!$ sout(j) = REAL(den%mmpMat(i,k,n,js))
!!$ j = j + 1
!!$ sout(j) = AIMAG(den%mmpMat(i,k,n,js))
!!$ ENDDO
!!$ ENDDO
!!$ ENDDO
!!$ ENDDO
!!$ ENDIF
!!$
!!$ mapmtd = atoms%ntype*(sphhar%nlhd+1)*atoms%jmtd
!!$ IF (mapmt .GT. mapmtd) THEN
!!$ WRITE(6,*)'The number of mt coefficients is larger than the'
!!$ WRITE(6,*)'dimensions:'
!!$ WRITE (6,8040) mapmt,mapmtd
!!$8040 FORMAT ('mapmt= ',i12,' > mapmtd= ',i12)
!!$ CALL juDFT_error("brysh1: mapmt > mapmtd (dimensions)",calledby ="brysh1")
!!$ ENDIF
!!$
!!$ nmap = j
!!$ IF (nmap.GT.SIZE(sout)) THEN
!!$ WRITE(6,*)'The total number of charge density coefficients is'
!!$ WRITE(6,*)'larger than the dimensions:'
!!$ WRITE (6,8030) nmap,SIZE(sout)
!!$8030 FORMAT ('nmap= ',i12,' > size(sout)= ',i12)
!!$ CALL juDFT_error("brysh1: nmap > mmap (dimensions)",calledby ="brysh1")
!!$ ENDIF
!!$
!!$ END SUBROUTINE get_combined_vector
!!$#endif
SUBROUTINE resetPotDen(pd)
IMPLICIT NONE
......
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