Skip to content
GitLab
Commit d53442bd authored by Matthias Redies's avatar Matthias Redies
Browse files

Merge branch 'develop' into MetaGGA

parents 150ef126 873645c9
Hide whitespace changes
Inline Side-by-side
cdn/qal_21.f90
View file @ d53442bd
......@@ -41,7 +41,7 @@ CONTAINS
! .. Intrinsic Functions ..
INTRINSIC conjg
qal21=0.0
!---> l-decomposed density for each occupied state
states : DO i = 1, noccbd
nt1 = 1
......
diagonalization/chase_diag.F90
View file @ d53442bd
......@@ -88,7 +88,7 @@ CONTAINS
END SUBROUTINE chase_distance
#ifdef CPP_CHASE
SUBROUTINE init_chase(mpi,DIMENSION,atoms,kpts,noco,l_real)
SUBROUTINE init_chase(mpi,DIMENSION,input,atoms,kpts,noco,l_real)
USE m_types_mpimat
USE m_types
USE m_types_mpi
......@@ -99,6 +99,7 @@ CONTAINS
TYPE(t_mpi), INTENT(IN) :: mpi
TYPE(t_dimension), INTENT(IN) :: dimension
TYPE(t_input), INTENT(IN) :: input
TYPE(t_atoms), INTENT(IN) :: atoms
TYPE(t_kpts), INTENT(IN) :: kpts
TYPE(t_noco), INTENT(IN) :: noco
......
eigen/eigen_hssetup.F90
View file @ d53442bd
......@@ -95,8 +95,10 @@ CONTAINS
! In the parallel case also a redistribution happens
ALLOCATE(smat_final,mold=smat(1,1))
ALLOCATE(hmat_final,mold=smat(1,1))
CALL timestart("Matrix redistribution")
CALL eigen_redist_matrix(mpi,lapw,atoms,smat,smat_final)
CALL eigen_redist_matrix(mpi,lapw,atoms,hmat,hmat_final,smat_final)
CALL timestop("Matrix redistribution")
END SUBROUTINE eigen_hssetup
END MODULE m_eigen_hssetup
......
io/loddop.f90
View file @ d53442bd
......@@ -24,8 +24,9 @@
INTEGER, INTENT (OUT):: it
! ..
! .. Array Arguments ..
COMPLEX, INTENT (OUT):: fpw(stars%ng3,input%jspins),fzxy(vacuum%nmzxyd,stars%ng2-1,2,input%jspins)
REAL, INTENT (OUT):: fr(atoms%jmtd,0:sphhar%nlhd,atoms%ntype,input%jspins),fz(vacuum%nmzd,2,input%jspins)
COMPLEX, INTENT (OUT):: fpw(:,:),fzxy(:,:,:,:)!(stars%ng3,input%jspins),fzxy(vacuum%nmzxyd,stars%ng2-1,2,input%jspins)
REAL, INTENT (OUT):: fr(:,0:,:,:)!(atoms%jmtd,0:sphhar%nlhd,atoms%ntype,input%jspins)
REAL, INTENT (OUT):: fz(:,:,:)!(vacuum%nmzd,2,input%jspins)
CHARACTER(len=8) :: dop,iop,name(10)
! ..
! .. Local Scalars ..
......@@ -48,15 +49,15 @@
fr = 0 ; fzxy = 0 ; fr = 0 ; fz = 0
IF (sym%invs) ALLOCATE ( fpwr(stars%ng3,input%jspins) )
IF (sym%invs2) ALLOCATE ( fzxyr(vacuum%nmzxyd,stars%ng2-1,2,input%jspins) )
IF (sym%invs) ALLOCATE ( fpwr(stars%ng3,SIZE(fpw,2)) )
IF (sym%invs2) ALLOCATE ( fzxyr(vacuum%nmzxyd,stars%ng2-1,2,SIZE(fzxy,4)) )
name = space
READ (nu,END=200,ERR=200) name
! WRITE (*,FMT=8000) name
! 8000 FORMAT (' loddop title:',10a8)
READ (nu,END=200,ERR=200) iop,dop,it
DO jsp = 1,input%jspins
DO jsp = 1,SIZE(fr,4)
READ (nu,END=200,ERR=200) jspdum
READ (nu,END=200,ERR=200) nn
IF (nn/=atoms%ntype) CALL juDFT_error("nn.NE.ntype",calledby =&
......@@ -94,76 +95,81 @@
na = na + atoms%neq(n)
ENDDO
READ (nu,END=200,ERR=200) nq3n
!+gu
IF (nq3n.GT.stars%ng3) THEN
WRITE (*,*) 'nq3n (',nq3n,') reduced to nq3 (',stars%ng3,')'
nq3n = stars%ng3
IF (jsp<=SIZE(fpw,2)) THEN
READ (nu,END=200,ERR=200) nq3n
!+gu
IF (nq3n.GT.stars%ng3) THEN
WRITE (*,*) 'nq3n (',nq3n,') reduced to nq3 (',stars%ng3,')'
nq3n = stars%ng3
ENDIF
!-gu
IF (sym%invs) THEN
READ (nu,END=200,ERR=200) (fpwr(k,jsp),k=1,nq3n)
fpw(:nq3n,jsp) = CMPLX(fpwr(:nq3n,jsp),0.)
ELSE
READ (nu,END=200,ERR=200) (fpw(k,jsp),k=1,nq3n)
END IF
IF (nq3n.LT.stars%ng3) THEN
fpw(nq3n+1:,jsp) = (0.,0.)
END IF
ENDIF
!-gu
IF (sym%invs) THEN
READ (nu,END=200,ERR=200) (fpwr(k,jsp),k=1,nq3n)
fpw(:nq3n,jsp) = CMPLX(fpwr(:nq3n,jsp),0.)
ELSE
READ (nu,END=200,ERR=200) (fpw(k,jsp),k=1,nq3n)
END IF
IF (nq3n.LT.stars%ng3) THEN
fpw(nq3n+1:,jsp) = (0.,0.)
END IF
IF (input%film) THEN
DO ivac = 1,vacuum%nvac
READ (nu,END=200,ERR=200) ivdummy
READ (nu,END=200,ERR=200) nmzn,z1n,delzn
READ (nu,END=200,ERR=200) (fz(i,ivac,jsp),i=1,nmzn)
IF (vacuum%nvac.EQ.1) THEN
DO i=1,nmzn
fz(i,2,jsp)=fz(i,1,jsp)
ENDDO
ENDIF
READ (nu,END=200,ERR=200) nq2n,nmzxyn
!+gu
IF (nq2n.GT.stars%ng2) THEN
WRITE (*,*) 'nq2n (',nq2n,') reduced to nq2 (',stars%ng2,')'
n_diff = nq2n - stars%ng2
nq2n = stars%ng2
ELSE
n_diff = 0
ENDIF
!-gu
DO k = 2,nq2n
IF (sym%invs2) THEN
READ (nu,END=200,ERR=200) &
& (fzxyr(j,k-1,ivac,jsp),j=1,nmzxyn)
fzxy(:nmzxyn,k-1,ivac,jsp) = CMPLX(fzxyr(:nmzxyn,k-1,ivac,&
& jsp),0.)
ELSE
READ (nu,END=200,ERR=200) &
& (fzxy(j,k-1,ivac,jsp),j=1,nmzxyn)
END IF
IF (jsp<=SIZE(fz,3)) THEN
DO ivac = 1,vacuum%nvac
READ (nu,END=200,ERR=200) ivdummy
READ (nu,END=200,ERR=200) nmzn,z1n,delzn
READ (nu,END=200,ERR=200) (fz(i,ivac,jsp),i=1,nmzn)
IF (vacuum%nvac.EQ.1) THEN
IF (sym%invs) THEN
DO j = 1,nmzxyn
fzxy(j,k-1,2,jsp) = CONJG(fzxy(j,k-1,1,jsp))
ENDDO
DO i=1,nmzn
fz(i,2,jsp)=fz(i,1,jsp)
ENDDO
ENDIF
IF (jsp<=SIZE(fzxy,4)) THEN
READ (nu,END=200,ERR=200) nq2n,nmzxyn
!+gu
IF (nq2n.GT.stars%ng2) THEN
WRITE (*,*) 'nq2n (',nq2n,') reduced to nq2 (',stars%ng2,')'
n_diff = nq2n - stars%ng2
nq2n = stars%ng2
ELSE
DO j = 1,nmzxyn
fzxy(j,k-1,2,jsp) = fzxy(j,k-1,1,jsp)
ENDDO
n_diff = 0
ENDIF
!-gu
DO k = 2,nq2n
IF (sym%invs2) THEN
READ (nu,END=200,ERR=200) &
& (fzxyr(j,k-1,ivac,jsp),j=1,nmzxyn)
fzxy(:nmzxyn,k-1,ivac,jsp) = CMPLX(fzxyr(:nmzxyn,k-1,ivac,&
& jsp),0.)
ELSE
READ (nu,END=200,ERR=200) &
& (fzxy(j,k-1,ivac,jsp),j=1,nmzxyn)
END IF
IF (vacuum%nvac.EQ.1) THEN
IF (sym%invs) THEN
DO j = 1,nmzxyn
fzxy(j,k-1,2,jsp) = CONJG(fzxy(j,k-1,1,jsp))
ENDDO
ELSE
DO j = 1,nmzxyn
fzxy(j,k-1,2,jsp) = fzxy(j,k-1,1,jsp)
ENDDO
ENDIF
ENDIF
ENDDO
!+gu
DO k = 1,n_diff
READ (nu,END=200,ERR=200) dummy
ENDDO
!-gu
IF (nq2n.LT.stars%ng2) THEN
fzxy(:nmzxyn,nq2n:,ivac,jsp) = (0.,0.)
END IF
ENDIF
ENDDO
!+gu
DO k = 1,n_diff
READ (nu,END=200,ERR=200) dummy
ENDDO
!-gu
IF (nq2n.LT.stars%ng2) THEN
fzxy(:nmzxyn,nq2n:,ivac,jsp) = (0.,0.)
END IF
ENDDO
END IF
END IF
ENDIF
ENDDO
!
IF (sym%invs) DEALLOCATE (fpwr)
......
io/wrtdop.f90
View file @ d53442bd
......@@ -25,8 +25,9 @@
INTEGER, INTENT (IN) :: it
! ..
! .. Array Arguments ..
COMPLEX, INTENT (IN):: fpw(stars%ng3,input%jspins),fzxy(vacuum%nmzxyd,stars%ng2-1,2,input%jspins)
REAL, INTENT (IN):: fr(atoms%jmtd,0:sphhar%nlhd,atoms%ntype,input%jspins),fz(vacuum%nmzd,2,input%jspins)
COMPLEX, INTENT (IN):: fpw(:,:),fzxy(:,:,:,:) !(stars%ng3,input%jspins),fzxy(vacuum%nmzxyd,stars%ng2-1,2,input%jspins)
REAL, INTENT (IN):: fr(:,0:,:,:)!(atoms%jmtd,0:sphhar%nlhd,atoms%ntype,input%jspins),
REAL, INTENT (IN):: fz(:,:,:)!(vacuum%nmzd,2,input%jspins)
CHARACTER(len=8):: dop,iop,name(10)
! .. Local Scalars ..
INTEGER i,ivac,izn,jsp,k,lh,n,na
......@@ -44,7 +45,7 @@
! WRITE (6,FMT=8000) name
8000 FORMAT (' wrtdop title:',10a8)
WRITE (nu) iop,dop,it
DO jsp = 1,input%jspins
DO jsp = 1,SIZE(fr,4)
WRITE (nu) jsp
WRITE (nu) atoms%ntype
na = 1
......@@ -58,27 +59,33 @@
ENDDO
na = na + atoms%neq (n)
ENDDO
WRITE (nu) stars%ng3
IF (sym%invs) THEN
WRITE (nu) (REAL(fpw(k,jsp)),k=1,stars%ng3)
ELSE
WRITE (nu) (fpw(k,jsp),k=1,stars%ng3)
END IF
IF (jsp<=SIZE(fpw,2)) THEN
WRITE (nu) stars%ng3
IF (sym%invs) THEN
WRITE (nu) (REAL(fpw(k,jsp)),k=1,stars%ng3)
ELSE
WRITE (nu) (fpw(k,jsp),k=1,stars%ng3)
END IF
ENDIF
IF (input%film) THEN
DO ivac = 1,vacuum%nvac
WRITE (nu) ivac
WRITE (nu) vacuum%nmz,vacuum%dvac,vacuum%delz
WRITE (nu) (fz(i,ivac,jsp),i=1,vacuum%nmz)
WRITE (nu) stars%ng2,vacuum%nmzxy
DO k = 2,stars%ng2
IF (sym%invs2) THEN
WRITE (nu) (REAL(fzxy(i,k-1,ivac,jsp)),i=1,vacuum%nmzxy)
ELSE
WRITE (nu) (fzxy(i,k-1,ivac,jsp),i=1,vacuum%nmzxy)
END IF
ENDDO
ENDDO
END IF
IF (jsp<=SIZE(fz,3)) THEN
DO ivac = 1,vacuum%nvac
WRITE (nu) ivac
WRITE (nu) vacuum%nmz,vacuum%dvac,vacuum%delz
WRITE (nu) (fz(i,ivac,jsp),i=1,vacuum%nmz)
IF (jsp<=SIZE(fzxy,4)) THEN
WRITE (nu) stars%ng2,vacuum%nmzxy
DO k = 2,stars%ng2
IF (sym%invs2) THEN
WRITE (nu) (REAL(fzxy(i,k-1,ivac,jsp)),i=1,vacuum%nmzxy)
ELSE
WRITE (nu) (fzxy(i,k-1,ivac,jsp),i=1,vacuum%nmzxy)
END IF
ENDDO
ENDIF
ENDDO
END IF
ENDIF
ENDDO
!
RETURN
......
main/fleur.F90
View file @ d53442bd
......@@ -169,7 +169,7 @@ CONTAINS
noco%l_noco,.TRUE.,l_real,noco%l_soc,.FALSE.,mpi%n_size)
#ifdef CPP_CHASE
CALL init_chase(mpi,dimension,atoms,kpts,noco,sym%invs.AND..NOT.noco%l_noco)
CALL init_chase(mpi,dimension,input,atoms,kpts,noco,sym%invs.AND..NOT.noco%l_noco)
#endif
! Open/allocate eigenvector storage (end)
......
mix/potdis.f90
View file @ d53442bd
......@@ -54,7 +54,7 @@ CONTAINS
REWIND 9
DO io = 1,2
CALL loddop(stars,vacuum,atoms,sphhar, input,sym,&
9, iter,rhsp(1,0,1,1,io),rhpw(1,1,io), rhv0(1,1,1,io),rhv1(1,1,1,1,io))
9, iter,rhsp(:,0:,:,:,io),rhpw(:,:,io), rhv0(:,:,:,io),rhv1(:,:,:,:,io))
ENDDO
CLOSE (9)
IF (input%jspins.EQ.1) THEN
......
vgen/vmts.F90
View file @ d53442bd
......@@ -64,7 +64,7 @@ contains
real :: sbf(0:atoms%lmaxd)
real, allocatable, dimension(:,:) :: il, kl
!$ COMPLEX vtl_loc(0:sphhar%nlhd,atoms%ntype)
!$ complex, allocatable :: vtl_loc(:,:)
#ifdef CPP_MPI
include 'mpif.h'
integer :: ierr(3)
......@@ -91,7 +91,8 @@ contains
!$omp parallel default( none ) &
!$omp& shared( mpi, stars, vpw, oneD, atoms, sym, cell, sphhar, vtl ) &
!$omp& private( k, cp, pylm, nat, n, sbf, nd, lh, sm, jm, m, lm, l ) &
!$omp& private( vtl_loc )
!$omp& private( vtl_loc )
!$ allocate(vtl_loc(0:sphhar%nlhd,atoms%ntype))
!$ vtl_loc(:,:) = cmplx(0.d0,0.d0)
!$omp do
do k = mpi%irank+2, stars%ng3, mpi%isize
......@@ -114,10 +115,10 @@ contains
lm = l * ( l + 1 ) + m + 1
sm = sm + conjg( sphhar%clnu(jm,lh,nd) ) * pylm(lm,n)
end do
!$ if (.false.) then
vtl(lh,n) = vtl(lh,n) + cp * sbf(l) * sm
!$ end if
!$ vtl_loc(lh,n) = vtl_loc(lh,n) + cp * sbf(l) * sm
!$ if (.false.) then
vtl(lh,n) = vtl(lh,n) + cp * sbf(l) * sm
!$ end if
!$ vtl_loc(lh,n) = vtl_loc(lh,n) + cp * sbf(l) * sm
end do
nat = nat + atoms%neq(n)
end do
......@@ -126,6 +127,7 @@ contains
!$omp critical
!$ vtl = vtl + vtl_loc
!$omp end critical
!$ deallocate(vtl_loc)
!$omp end parallel
#ifdef CPP_MPI
n1 = ( sphhar%nlhd + 1 ) * atoms%ntype
......
Supports Markdown
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