Commit 4872fe93 authored by Matthias Redies's avatar Matthias Redies

Merge branch 'develop' into RMA_olap

parents d3aaf02c 2fcd9279
......@@ -64,8 +64,6 @@ CONTAINS
!
INTEGER :: idxeig(SIZE(results%w_iks)),idxjsp(SIZE(results%w_iks)),idxkpt(SIZE(results%w_iks)),INDEX(SIZE(results%w_iks))
REAL :: e(SIZE(results%w_iks)),we(SIZE(results%w_iks))
REAL, ALLOCATABLE :: eig(:,:,:)
INTEGER ne(kpts%nkpt,SIZE(results%w_iks,3))
CHARACTER(LEN=20) :: attributes(5)
!--- J constants
......@@ -98,8 +96,6 @@ CONTAINS
! .. Data statements ..
DATA del/1.0e-6/
ALLOCATE (eig(SIZE(results%w_iks,1),SIZE(results%w_iks,2),SIZE(results%w_iks,3)))
! initiliaze e
e = 0
......@@ -126,10 +122,9 @@ CONTAINS
DO jsp = 1,nspins
DO k = 1,kpts%nkpt
IF (mpi%irank == 0) THEN
CALL read_eig(eig_id,k,jsp,neig=ne(k,jsp),eig=eig(:,k,jsp))
WRITE (oUnit,'(a2,3f10.5,f12.6)') 'at',kpts%bk(:,k),kpts%wtkpt(k)
WRITE (oUnit,'(i5,a14)') ne(k,jsp),' eigenvalues :'
WRITE (oUnit,'(8f12.6)') (eig(i,k,jsp),i=1,ne(k,jsp))
WRITE (oUnit,'(i5,a14)') results%neig(k,jsp),' eigenvalues :'
WRITE (oUnit,'(8f12.6)') (results%eig(i,k,jsp),i=1,results%neig(k,jsp))
IF(.NOT.judft_was_argument("-minimalOutput")) THEN
attributes = ''
WRITE(attributes(1),'(i0)') jsp
......@@ -137,7 +132,7 @@ CONTAINS
WRITE(attributes(3),'(f15.8)') kpts%bk(1,k)
WRITE(attributes(4),'(f15.8)') kpts%bk(2,k)
WRITE(attributes(5),'(f15.8)') kpts%bk(3,k)
CALL writeXMLElementPoly('eigenvaluesAt',(/'spin','ikpt','k_x ','k_y ','k_z '/),attributes,eig(1:ne(k,jsp),k,jsp))
CALL writeXMLElementPoly('eigenvaluesAt',(/'spin','ikpt','k_x ','k_y ','k_z '/),attributes,results%eig(1:results%neig(k,jsp),k,jsp))
END IF
END IF
#ifdef CPP_MPI
......@@ -173,15 +168,15 @@ CONTAINS
!---> STORE EIGENVALUES AND WEIGHTS IN A LINEAR LIST. AND MEMORIZE
!---> CONECTION TO THE ORIGINAL ARRAYS
!
DO j = 1,ne(k,jsp)
e(n+j) = eig(j,k,jsp)
DO j = 1,results%neig(k,jsp)
e(n+j) = results%eig(j,k,jsp)
we(n+j) = kpts%wtkpt(k)
idxeig(n+j) = j+n_help
idxkpt(n+j) = k
idxjsp(n+j) = jsp
END DO
!---> COUNT THE NUMBER OF EIGENVALUES
n = n + ne(k,jsp)
n = n + results%neig(k,jsp)
END DO
END DO
......@@ -244,14 +239,14 @@ CONTAINS
results%bandgap = 0.0
IF(input%bz_integration==0) THEN
CALL ferhis(input,kpts,mpi,index,idxeig,idxkpt,idxjsp,nspins, n,&
nstef,ws,spindg,weight,e,ne(:,sslice(1):sslice(2)),we, noco,cell,results%ef,results%seigv,results%w_iks(:,:,sslice(1):sslice(2)),results)
nstef,ws,spindg,weight,e,results%neig(:,sslice(1):sslice(2)),we, noco,cell,results%ef,results%seigv,results%w_iks(:,:,sslice(1):sslice(2)),results)
ELSE IF (input%bz_integration==1) THEN
CALL fergwt(kpts,input,mpi,ne(:,sslice(1):sslice(2)), eig(:,:,sslice(1):sslice(2)),results%ef,results%w_iks(:,:,sslice(1):sslice(2)),results%seigv)
CALL fergwt(kpts,input,mpi,results%neig(:,sslice(1):sslice(2)), results%eig(:,:,sslice(1):sslice(2)),results%ef,results%w_iks(:,:,sslice(1):sslice(2)),results%seigv)
ELSE IF (input%bz_integration==2) THEN
CALL fertri(input,kpts,mpi%irank, ne(:,sslice(1):sslice(2)),nspins,zc,eig(:,:,sslice(1):sslice(2)),spindg,&
CALL fertri(input,kpts,mpi%irank, results%neig(:,sslice(1):sslice(2)),nspins,zc,results%eig(:,:,sslice(1):sslice(2)),spindg,&
results%ef,results%seigv,results%w_iks(:,:,sslice(1):sslice(2)))
ELSE IF (input%bz_integration==3) THEN
CALL fertetra(input,noco,kpts,mpi,ne(:,sslice(1):sslice(2)), eig(:,:,sslice(1):sslice(2)),&
CALL fertetra(input,noco,kpts,mpi,results%neig(:,sslice(1):sslice(2)), results%eig(:,:,sslice(1):sslice(2)),&
results%ef,results%w_iks(:,:,sslice(1):sslice(2)),results%seigv)
ENDIF
results%seigscv = results%seigsc + results%seigv
......@@ -264,7 +259,6 @@ CONTAINS
ENDIF
efermi = results%ef
enddo
DEALLOCATE (eig)
IF (m_spins == 2) nspins = 2
......
......@@ -25,13 +25,11 @@ MODULE m_symMMPmat
LOGICAL,OPTIONAL, INTENT(IN) :: phase !multiply spin-offdiagonal phase
!(if the full matrix is not given)
COMPLEX, ALLOCATABLE :: mmpmatSym(:,:,:)
COMPLEX :: mmpmatSym(-lmaxU_const:lmaxU_const,-lmaxU_const:lmaxU_const,SIZE(mmpmat,3))
REAL :: symFac
INTEGER :: it,is,isi
COMPLEX :: offdPhase
IF(.NOT.ALLOCATED(mmpmatSym)) ALLOCATE(mmpmatSym,mold=mmpmat)
mmpmatSym = cmplx_0
symFac = 1.0/sym%invarind(natom)
......@@ -60,7 +58,7 @@ MODULE m_symMMPmat
LOGICAL,OPTIONAL, INTENT(IN) :: phase
INTEGER :: ilow(2),iup(2)
COMPLEX, ALLOCATABLE :: mmpmatSym(:,:)
COMPLEX :: mmpmatSym(-lmaxU_const:lmaxU_const,-lmaxU_const:lmaxU_const)
COMPLEX, ALLOCATABLE :: mmpmatOut2(:,:,:),mmpmatIn(:,:,:)
!Add "extra spin dimension"
......@@ -72,7 +70,6 @@ MODULE m_symMMPmat
ALLOCATE(mmpmatOut2,mold=mmpMatIn)
mmpmatOut2 = symMMPmatFull(mmpmatIn,sym,natom,l,phase=phase)
IF(.NOT.ALLOCATED(mmpmatSym)) ALLOCATE(mmpmatSym,mold=mmpmat)
mmpmatSym = mmpmatOut2(:,:,1)
END FUNCTION symMMPmatoneSpin
......
......@@ -204,10 +204,14 @@ MODULE m_greensfCalcRealPart
CALL timestop("Green's Function: Kramer-Kronigs-Integration")
ENDDO
#ifdef CPP_MPI
CALL timestart("Green's Function: Collect")
!Collect all the greensFuntions
DO i_gf = 1, gfinp%n
CALL g(i_gf)%collect(mpi%mpi_comm)
ENDDO
CALL timestop("Green's Function: Collect")
#endif
END SUBROUTINE greensfCalcRealPart
END MODULE m_greensfCalcRealPart
\ No newline at end of file
......@@ -26,10 +26,12 @@ MODULE m_greensfSym
INTEGER imat,iBand
COMPLEX, ALLOCATABLE :: imSym(:,:,:)
!$OMP parallel do default(none) &
!$OMP parallel default(none) &
!$OMP shared(ikpt_i,i_elem,natom,l,l_onsite,l_sphavg)&
!$OMP shared(spin_start,spin_end,sym,atomFactor,phase,im,greensfBZintCoeffs)&
!$OMP private(imat,iBand,imSym) collapse(2)
!$OMP private(imat,iBand,imSym)
ALLOCATE(imSym(-lmaxU_const:lmaxU_const,-lmaxU_const:lmaxU_const,spin_start:spin_end),source=cmplx_0)
!$OMP do collapse(2)
DO imat = 1, SIZE(im,4)
DO iBand = 1, SIZE(im,3)
IF(l_onsite) THEN !These rotations are only available for the onsite elements
......@@ -55,7 +57,8 @@ MODULE m_greensfSym
ENDIF
ENDDO
ENDDO
!$OMP end parallel do
!$OMP end do
!$OMP end parallel
END SUBROUTINE greensfSym
......
......@@ -103,13 +103,13 @@ MODULE m_kkintgr
CALL timestart("kkintgr: integration")
!$OMP parallel do default(none) &
!$OMP shared(nz,ne,method,del,eb,l_conjg) &
!$OMP shared(g,ez,im,smoothed,smoothInd) &
!$OMP shared(g,ez,eMesh,im,smoothed,smoothInd) &
!$OMP private(iz,n1,n2,re_n1,re_n2,im_n1,im_n2)
DO iz = 1, nz
SELECT CASE(method)
CASE(method_direct)
g(iz) = kk_direct(im,ne,MERGE(conjg(ez(iz)),ez(iz),l_conjg),del,eb)
g(iz) = kk_direct(im,eMesh,MERGE(conjg(ez(iz)),ez(iz),l_conjg))
CASE(method_maclaurin, method_deriv)
!Use the previously smoothed version and interpolate after
!Next point to the left
......@@ -150,29 +150,21 @@ MODULE m_kkintgr
END SUBROUTINE kkintgr
COMPLEX FUNCTION kk_direct(im,ne,z,del,eb)
PURE COMPLEX FUNCTION kk_direct(im,eMesh,z)
USE m_trapz
REAL, INTENT(IN) :: im(:)
INTEGER, INTENT(IN) :: ne
REAL, INTENT(IN) :: eMesh(:)
COMPLEX, INTENT(IN) :: z
REAL, INTENT(IN) :: del
REAL, INTENT(IN) :: eb
COMPLEX :: integrand(ne)
INTEGER :: i
COMPLEX :: integrand(SIZE(eMesh))
integrand = 0.0
DO i = 1, ne
integrand(i) = 1.0/(z-(i-1)*del-eb) * im(i)
ENDDO
kk_direct = -1/pi_const *( trapz(REAL(integrand(:)),del,ne) &
+ ImagUnit * trapz(AIMAG(integrand(:)),del,ne))
integrand = 1.0/(z-eMesh) * im
kk_direct = -1/pi_const *trapz(integrand,eMesh(2)-eMesh(1),SIZE(eMesh))
END FUNCTION kk_direct
REAL FUNCTION kk_num(im,ne,ire,method)
PURE REAL FUNCTION kk_num(im,ne,ire,method)
REAL, INTENT(IN) :: im(:) !Imaginary part
INTEGER, INTENT(IN) :: ne !Dimension of the energy grid
......@@ -194,14 +186,10 @@ MODULE m_kkintgr
!Calculate the real part on the same energy points as the imaginary part
!regardless of the contour
!If i is odd skip the odd points and the other way around and use the trapezian method
DO j = 1, INT(ne/2.0)
IF(MOD(ire,2).EQ.0) THEN
i = 2*j-1
ELSE
i = 2*j
ENDIF
DO i = MERGE(1,2,MOD(ire,2)==0), ne, 2
y = - 1/pi_const * 2.0 * im(i)/REAL(ire-i)
IF(j.EQ.1 .OR. j.EQ.INT(ne/2.0)) y = y/2.0
IF(i.EQ.1 .OR. i.EQ.2 .OR.&
j.EQ.ne .OR. j.EQ.ne-1) y = y/2.0
kk_num = kk_num + y
ENDDO
......@@ -223,7 +211,6 @@ MODULE m_kkintgr
kk_num = kk_num + y
ENDDO
CASE default
CALL juDFT_error("No valid method for KK-integration chosen",calledby="kkintgr")
END SELECT
END FUNCTION kk_num
......
......@@ -5,26 +5,49 @@ MODULE m_trapz
IMPLICIT NONE
INTERFACE trapz
PROCEDURE :: trapzr, trapzc
END INTERFACE
CONTAINS
PURE REAL FUNCTION trapz(y,h,n)
PURE REAL FUNCTION trapzr(y,h,n)
REAL, INTENT(IN) :: y(:)
INTEGER, INTENT(IN) :: n
REAL, INTENT(IN) :: h
INTEGER i
trapzr = y(1)
DO i = 2, n-1
trapzr = trapzr + 2*y(i)
ENDDO
trapzr = trapzr + y(n)
trapzr = trapzr*h/2.0
END FUNCTION trapzr
PURE COMPLEX FUNCTION trapzc(y,h,n)
COMPLEX, INTENT(IN) :: y(:)
INTEGER, INTENT(IN) :: n
REAL, INTENT(IN) :: h
INTEGER i
trapz = y(1)
trapzc = y(1)
DO i = 2, n-1
trapz = trapz + 2*y(i)
trapzc = trapzc + 2*y(i)
ENDDO
trapz = trapz + y(n)
trapzc = trapzc + y(n)
trapzc = trapzc*h/2.0
trapz = trapz*h/2.0
END FUNCTION trapzc
END FUNCTION trapz
END MODULE m_trapz
\ No newline at end of file
......@@ -129,29 +129,28 @@ MODULE m_types_greensf
#ifdef CPP_MPI
include 'mpif.h'
#include"cpp_double.h"
INTEGER:: ierr,irank,n
INTEGER:: ierr,n
COMPLEX,ALLOCATABLE::ctmp(:)
CALL MPI_COMM_RANK(mpi_comm,irank,ierr)
IF(ALLOCATED(this%gmmpMat)) THEN
n = SIZE(this%gmmpMat)
ALLOCATE(ctmp(n))
CALL MPI_REDUCE(this%gmmpMat,ctmp,n,CPP_MPI_COMPLEX,MPI_SUM,0,MPI_COMM_WORLD,ierr)
IF(irank.EQ.0) CALL CPP_BLAS_ccopy(n,ctmp,1,this%gmmpMat,1)
CALL MPI_ALLREDUCE(this%gmmpMat,ctmp,n,CPP_MPI_COMPLEX,MPI_SUM,mpi_comm,ierr)
CALL CPP_BLAS_ccopy(n,ctmp,1,this%gmmpMat,1)
DEALLOCATE(ctmp)
ELSE
n = SIZE(this%gmmpMat)
n = SIZE(this%uu)
ALLOCATE(ctmp(n))
CALL MPI_REDUCE(this%uu,ctmp,n,CPP_MPI_COMPLEX,MPI_SUM,0,MPI_COMM_WORLD,ierr)
IF(irank.EQ.0) CALL CPP_BLAS_ccopy(n,ctmp,1,this%uu,1)
CALL MPI_REDUCE(this%ud,ctmp,n,CPP_MPI_COMPLEX,MPI_SUM,0,MPI_COMM_WORLD,ierr)
IF(irank.EQ.0) CALL CPP_BLAS_ccopy(n,ctmp,1,this%ud,1)
CALL MPI_REDUCE(this%du,ctmp,n,CPP_MPI_COMPLEX,MPI_SUM,0,MPI_COMM_WORLD,ierr)
IF(irank.EQ.0) CALL CPP_BLAS_ccopy(n,ctmp,1,this%du,1)
CALL MPI_REDUCE(this%dd,ctmp,n,CPP_MPI_COMPLEX,MPI_SUM,0,MPI_COMM_WORLD,ierr)
IF(irank.EQ.0) CALL CPP_BLAS_ccopy(n,ctmp,1,this%dd,1)
CALL MPI_ALLREDUCE(this%uu,ctmp,n,CPP_MPI_COMPLEX,MPI_SUM,mpi_comm,ierr)
CALL CPP_BLAS_ccopy(n,ctmp,1,this%uu,1)
CALL MPI_ALLREDUCE(this%ud,ctmp,n,CPP_MPI_COMPLEX,MPI_SUM,mpi_comm,ierr)
CALL CPP_BLAS_ccopy(n,ctmp,1,this%ud,1)
CALL MPI_ALLREDUCE(this%du,ctmp,n,CPP_MPI_COMPLEX,MPI_SUM,mpi_comm,ierr)
CALL CPP_BLAS_ccopy(n,ctmp,1,this%du,1)
CALL MPI_ALLREDUCE(this%dd,ctmp,n,CPP_MPI_COMPLEX,MPI_SUM,mpi_comm,ierr)
CALL CPP_BLAS_ccopy(n,ctmp,1,this%dd,1)
DEALLOCATE(ctmp)
ENDIF
DEALLOCATE(ctmp)
#endif
END SUBROUTINE collect_greensf
......
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