Skip to content

GitLab

fleur
fleur
Commit d53442bd authored by Matthias Redies's avatar Matthias Redies
Browse files
Options

Merge branch 'develop' into MetaGGA

parents 150ef126 873645c9
Hide whitespace changes
Inline Side-by-side
Showing with 119 additions and 101 deletions
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
......
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