Commit 337e9427 authored by Daniel Wortmann's avatar Daniel Wortmann

Merge branch 'develop' of iffgit.fz-juelich.de:fleur/fleur into develop

Conflicts:
	main/fleur_init.F90
parents 598c51a1 41c649b8
......@@ -16,7 +16,7 @@ build-gfortran-hdf5:
paths:
- build
script:
- cd /builds/fleur/fleur; ./configure.sh GITLAB; cd build; make
- cd /builds/fleur/fleur; ./configure.sh GITLAB; cd build; make -j 4
# only:
# - schedules
# - triggers
......@@ -100,7 +100,7 @@ build-intel:
- build.intel
script:
- set +e && source compilervars.sh intel64 && set -e ; ulimit -s unlimited
- cd /builds/fleur/fleur; FC=mpiifort FLEUR_LIBRARIES="-lmkl_scalapack_lp64;-lmkl_blacs_intelmpi_lp64" ./configure.sh -t -l intel INTEL_MPI ; cd build.intel; make
- cd /builds/fleur/fleur; FC=mpiifort FLEUR_LIBRARIES="-lmkl_scalapack_lp64;-lmkl_blacs_intelmpi_lp64" ./configure.sh -t -l intel INTEL_MPI ; cd build.intel; make -j 4
only:
- schedules
- triggers
......@@ -133,7 +133,7 @@ gfortran-coverage:
paths:
- build
script:
- cd /builds/fleur/fleur; ./configure.sh -l coverage -flags --coverage GITLAB; cd build.coverage; make
- cd /builds/fleur/fleur; ./configure.sh -l coverage -flags --coverage GITLAB; cd build.coverage; make -j 4
- lcov --capture --initial -d CMakeFiles -o baseline.info
- ulimit -s unlimited ;export juDFT_MPI="mpirun -n 2 --allow-run-as-root ";ctest
- lcov --capture -d CMakeFiles -o after.info
......
......@@ -62,7 +62,6 @@ CONTAINS
ENDIF
!$OMP PARALLEL DEFAULT(none) &
!$OMP SHARED(usdus,rho,moments,qmtl) &
!$OMP SHARED(atoms,jsp_start,jsp_end,enpara,vr,denCoeffs,sphhar)&
!$OMP SHARED(orb,noco,denCoeffsOffdiag,jspd)&
......
This diff is collapsed.
......@@ -66,6 +66,7 @@ CONTAINS
USE m_types_gpumat
USE m_matrix_copy
USE m_cusolver_diag
USE m_judft_usage
IMPLICIT NONE
#ifdef CPP_MPI
include 'mpif.h'
......@@ -108,6 +109,7 @@ CONTAINS
CALL timestart("Diagonalization")
!Select the solver
CALL add_usage_data("diag-solver", priv_select_solver(parallel))
SELECT CASE (priv_select_solver(parallel))
CASE (diag_elpa)
CALL elpa_diag(hmat,smat,ne,eig,ev)
......
......@@ -88,7 +88,6 @@ CONTAINS
#else
CALL get_elpa_row_col_comms(hmat%blacsdata%mpi_com, hmat%blacsdata%myrow, hmat%blacsdata%mycol,mpi_comm_rows, mpi_comm_cols)
#endif
!print *,"creating ELPA comms -- done"
num2=ne !no of states solved for
......@@ -130,13 +129,16 @@ CONTAINS
print *, "elpa uses " // elpa_int_value_to_string("complex_kernel", kernel) // " kernel"
endif
#endif
!print *,"Before elpa"
!ELPA -start here
! Solive generalized preblem
! Solve generalized problem
!
! 1. Calculate Cholesky factorization of Matrix S = U**T * U
! and invert triangular matrix U
! and invert triangular matrix U.
! Cholesky factorization:
! Only upper triangle needs to be set. On return, the upper triangle contains
! the Cholesky factor and the lower triangle is set to 0.
! invert_triangular:
! Inverts an upper triangular real or complex matrix.
!
! Please note: cholesky_complex/invert_trm_complex are not trimmed for speed.
! The only reason having them is that the Scalapack counterpart
......@@ -183,6 +185,7 @@ CONTAINS
! H is only set in the upper half, solve_evp_real needs a full matrix
! Set lower half from upper half
! Set the lower half of the H matrix to zeros.
DO i=1,hmat%matsize2
! Get global column corresponding to i and number of local rows up to
! and including the diagonal, these are unchanged in H
......@@ -195,7 +198,7 @@ CONTAINS
ENDIF
ENDDO
! Use the ev_dist array to store the calculated values for the lower part.
IF (hmat%l_real) THEN
CALL pdtran(hmat%global_size1,hmat%global_size1,1.d0,hmat%data_r,1,1,&
hmat%blacsdata%blacs_desc,0.d0,ev_dist%data_r,1,1,ev_dist%blacsdata%blacs_desc)
......@@ -204,7 +207,7 @@ CONTAINS
hmat%blacsdata%blacs_desc,cmplx(0.d0,0.d0),ev_dist%data_c,1,1,ev_dist%blacsdata%blacs_desc)
ENDIF
! Copy the calculated values to the lower part of the H matrix
DO i=1,hmat%matsize2
! Get global column corresponding to i and number of local rows up to
! and including the diagonal, these are unchanged in H
......@@ -254,7 +257,7 @@ CONTAINS
ENDIF
#endif
! 2b. tmp2 = eigvec**T
! 2b. tmp2 = ev_dist**T
IF (hmat%l_real) THEN
CALL pdtran(ev_dist%global_size1,ev_dist%global_size1,1.d0,ev_dist%data_r,1,1,&
ev_dist%blacsdata%blacs_desc,0.d0,tmp2_r,1,1,ev_dist%blacsdata%blacs_desc)
......@@ -325,7 +328,7 @@ CONTAINS
ENDDO
! 3. Calculate eigenvalues/eigenvectors of U**-T * A * U**-1
! Eigenvectors go to eigvec
! Eigenvectors go to ev_dist
#if defined (CPP_ELPA_201705003)
IF (hmat%l_real) THEN
CALL elpa_obj%eigenvectors(hmat%data_r, eig2, ev_dist%data_r, err)
......@@ -389,7 +392,7 @@ CONTAINS
#endif
! 4. Backtransform eigenvectors: Z = U**-1 * eigvec
! 4. Backtransform eigenvectors: Z = U**-1 * ev_dist
! mult_ah_b_complex needs the transpose of U**-1, thus tmp2 = (U**-1)**T
IF (hmat%l_real) THEN
......
......@@ -28,6 +28,9 @@ CONTAINS
USE m_types
#ifdef CPP_ELPA_ONENODE
USE elpa
#endif
#ifdef CPP_GPU
USE nvtx
#endif
IMPLICIT NONE
......@@ -45,7 +48,9 @@ CONTAINS
INTEGER :: kernel
CLASS(elpa_t),pointer :: elpa_obj
print*, "ELPA 20180525 started"
#ifdef CPP_GPU
call nvtxStartRange("ELPA",5)
#endif
err = elpa_init(20180525)
elpa_obj => elpa_allocate()
......@@ -65,15 +70,23 @@ CONTAINS
CALL elpa_obj%set("gpu",1,err)
#endif
err = elpa_obj%setup()
call elpa_obj%get("solver", kernel)
print *, "elpa uses " // elpa_int_value_to_string("solver", kernel) // " solver"
CALL hmat%add_transpose(hmat)
CALL smat%add_transpose(smat)
#ifdef CPP_GPU
call nvtxStartRange("EigVec",7)
#endif
IF (hmat%l_real) THEN
CALL elpa_obj%generalized_eigenvectors(hmat%data_r,smat%data_r,eig2, ev_dist%data_r, .FALSE.,err)
ELSE
CALL elpa_obj%generalized_eigenvectors(hmat%data_c,smat%data_c,eig2, ev_dist%data_c, .FALSE., err)
ENDIF
#ifdef CPP_GPU
call nvtxEndRange!("EigVec",8)
#endif
CALL elpa_deallocate(elpa_obj)
CALL elpa_uninit()
......@@ -86,6 +99,9 @@ CONTAINS
CALL ev%alloc(hmat%l_real,hmat%matsize1,ne)
CALL ev%copy(ev_dist,1,1)
#ifdef CPP_GPU
call nvtxEndRange!("ELPA",7)
#endif
#endif
END SUBROUTINE elpa_diag_onenode
......
......@@ -4,7 +4,7 @@ MODULE m_hf_init
! preparations for HF and hybrid functional calculation
!
CONTAINS
SUBROUTINE hf_init(hybrid,kpts,atoms,input,DIMENSION,hybdat,irank2,isize2,l_real)
SUBROUTINE hf_init(hybrid,kpts,atoms,input,DIMENSION,hybdat,l_real)
USE m_types
USE m_read_core
USE m_util
......@@ -15,7 +15,6 @@ CONTAINS
TYPE(t_atoms),INTENT(IN) :: atoms
TYPE(t_input),INTENT(IN) :: input
TYPE(t_dimension),INTENT(IN) :: DIMENSION
INTEGER,INTENT(OUT) :: irank2(:),isize2(:)
TYPE(t_hybdat),INTENT(OUT) :: hybdat
LOGICAL,INTENT(IN) :: l_real
......@@ -81,10 +80,6 @@ CONTAINS
END DO
END DO
irank2 = 0
isize2 = 1
!skip_kpt = .false.
END SUBROUTINE hf_init
......
......@@ -5,7 +5,7 @@
SUBROUTINE checkolap(atoms,hybdat,&
& hybrid,&
& nkpti,kpts,&
& dimension,mpi,irank2,skip_kpt,&
& dimension,mpi,skip_kpt,&
& input,sym,noco,&
& cell,lapw,jsp)
USE m_util , ONLY: intgrf,intgrf_init,chr,sphbessel,harmonicsr
......@@ -33,9 +33,6 @@
! - arrays -
INTEGER, INTENT(IN) :: irank2(nkpti)
LOGICAL, INTENT(IN) :: skip_kpt(nkpti)
! - local scalars -
......@@ -314,11 +311,9 @@
END DO
END DO
rarr = sqrt ( rarr / (4*pi_const) )
! IF ( irank2(ikpt) == 0 ) THEN
! WRITE(outtext,'(I6,4X,F14.12,'' ('',F14.12,'')'')') &
! & ikpt,sum(rarr(:1)**2/nbands(ikpt)),maxval(rarr(:1))
! CALL writeout(outtext,mpi%irank)
! END IF
! IF( iatom .eq. 6 ) THEN
! cdum = exp(2*pi*img*dot_product(bkf(:,ikpt),(/0d0,0d0,1d0/) ))
! lm = 0
......
......@@ -21,7 +21,7 @@ MODULE m_exchange_core
CONTAINS
SUBROUTINE exchange_vccv(nk,atoms, hybrid,hybdat, DIMENSION,jsp,lapw,&
maxbands,mnobd,mpi,irank2, degenerat,symequivalent,results,&
maxbands,mnobd,mpi,degenerat,symequivalent,results,&
ex_vv_r,ex_vv_c,l_real)
......@@ -43,7 +43,6 @@ CONTAINS
! -scalars -
INTEGER,INTENT(IN) :: jsp
INTEGER,INTENT(IN) ::nk ,maxbands, mnobd
INTEGER,INTENT(IN) :: irank2
! - arays -
INTEGER,INTENT(IN) :: degenerat(hybrid%ne_eig(nk))
LOGICAL,INTENT(IN) :: l_real
......@@ -77,10 +76,8 @@ CONTAINS
LOGICAL :: ldum(hybrid%nbands(nk),hybrid%nbands(nk))
IF ( irank2 == 0 ) THEN
WRITE(6,'(A)') new_LINE('n') // new_LINE('n') // '### valence-core-core-valence exchange ###'
WRITE(6,'(A)') new_LINE('n') // ' k-point band exchange (core contribution)'
END IF
WRITE(6,'(A)') new_LINE('n') // new_LINE('n') // '### valence-core-core-valence exchange ###'
WRITE(6,'(A)') new_LINE('n') // ' k-point band exchange (core contribution)'
! read in mt wavefunction coefficients from file cmt
CALL read_cmt(cmt,nk)
......@@ -237,9 +234,7 @@ CONTAINS
results%te_hfex%core = results%te_hfex%core - results%w_iks(n1,nk,jsp)*exchange(n1,n1)
END DO
IF ( irank2 == 0 ) THEN
WRITE(6,'(A,F20.15)') 'sum of the absolut real part of the non diagonal elements',sum_offdia
END IF
WRITE(6,'(A,F20.15)') 'sum of the absolut real part of the non diagonal elements',sum_offdia
END SUBROUTINE exchange_vccv
......
......@@ -58,7 +58,7 @@ CONTAINS
SUBROUTINE exchange_valence_hf(nk,kpts,nkpt_EIBZ,sym,atoms,hybrid,cell,dimension,input,jsp,hybdat,mnobd,lapw,&
eig_irr,results,parent,pointer_EIBZ,n_q,wl_iks,it,xcpot, noco,nsest,indx_sest,&
mpi,irank2,isize2,comm,mat_ex)
mpi,mat_ex)
USE m_types
USE m_wrapper
......@@ -93,7 +93,7 @@ SUBROUTINE exchange_valence_hf(nk,kpts,nkpt_EIBZ,sym,atoms,hybrid,cell,dimension
TYPE(t_mat), INTENT(INOUT) :: mat_ex
! scalars
INTEGER, INTENT(IN) :: it,irank2,isize2,comm
INTEGER, INTENT(IN) :: it
INTEGER, INTENT(IN) :: jsp
INTEGER, INTENT(IN) :: nk,nkpt_EIBZ
INTEGER, INTENT(IN) :: mnobd
......
......@@ -16,7 +16,7 @@ MODULE m_gen_wavf
CONTAINS
SUBROUTINE gen_wavf (nkpti,kpts,it,sym,atoms,el_eig,ello_eig,cell,dimension,hybrid,vr0,&
hybdat,noco,oneD,mpi,irank2,input,jsp,zmat)
hybdat,noco,oneD,mpi,input,jsp,zmat)
! nkpti :: number of irreducible k-points
! nkpt :: number of all k-points
......@@ -49,7 +49,6 @@ CONTAINS
INTEGER, INTENT(IN) :: nkpti, it
INTEGER, INTENT(IN) :: jsp
INTEGER, INTENT(IN) :: irank2(nkpti)
REAL, INTENT(IN) :: vr0(:,:,:)!(jmtd,ntype,jspd)
REAL, INTENT(IN) :: el_eig(0:atoms%lmaxd,atoms%ntype)
REAL, INTENT(IN) :: ello_eig(atoms%nlod,atoms%ntype)
......@@ -179,12 +178,9 @@ CONTAINS
found = .false.
#ifdef CPP_MPI
DO ikpt = 1, nkpti
IF (irank2(ikpt) == 0 .AND. .NOT.found) THEN
IF (.NOT.found) THEN
lower = ikpt
found = .true.
ELSE IF (irank2(ikpt) /= 0 .AND. found) THEN
upper = ikpt-1
EXIT
END IF
END DO
#else
......
......@@ -9,7 +9,7 @@ MODULE m_hf_setup
CONTAINS
SUBROUTINE hf_setup(hybrid,input,sym,kpts,DIMENSION,atoms,mpi,noco,cell,oneD,results,jsp,enpara,eig_id_hf,&
hybdat,irank2,it,l_real,vr0,eig_irr)
hybdat,it,l_real,vr0,eig_irr)
USE m_types
USE m_eig66_io
USE m_util
......@@ -33,7 +33,7 @@ SUBROUTINE hf_setup(hybrid,input,sym,kpts,DIMENSION,atoms,mpi,noco,cell,oneD,res
TYPE(t_results), INTENT(INOUT) :: results
TYPE(t_hybdat), INTENT(INOUT) :: hybdat
INTEGER, INTENT(IN) :: irank2(:),it
INTEGER, INTENT(IN) :: it
INTEGER, INTENT(IN) :: jsp,eig_id_hf
REAL, INTENT(IN) :: vr0(:,:,:)
LOGICAL, INTENT(IN) :: l_real
......@@ -171,11 +171,11 @@ SUBROUTINE hf_setup(hybrid,input,sym,kpts,DIMENSION,atoms,mpi,noco,cell,oneD,res
rcvreqd = rcvreqd + 1
CALL MPI_IRECV(hybrid%nobd(nk),1,MPI_INTEGER4, MPI_ANY_SOURCE,TAG_SNDRCV_HYBDAT%NOBD+nk, mpi,rcvreq(rcvreqd),ierr(1))
ELSE
i = MOD( mpi%irank + isize2(nk), mpi%isize )
DO WHILE ( i < mpi%irank-irank2(nk) .OR. i >= mpi%irank-irank2(nk)+isize2(nk) )
i = MOD( mpi%irank + 1, mpi%isize )
DO WHILE ( i < mpi%irank .OR. i >= mpi%irank+1 )
sndreqd = sndreqd + 1
CALL MPI_ISSEND(hybrid%nobd(nk),1,MPI_INTEGER4,i, TAG_SNDRCV_HYBDAT%NOBD+nk,mpi, sndreq(sndreqd),ierr(1) )
i = MOD( i + isize2(nk), mpi%isize )
i = MOD( i + 1, mpi%isize )
END DO
END IF
END DO
......@@ -194,7 +194,7 @@ SUBROUTINE hf_setup(hybrid,input,sym,kpts,DIMENSION,atoms,mpi,noco,cell,oneD,res
! generate eigenvectors z and MT coefficients from the previous iteration at all k-points
CALL gen_wavf(kpts%nkpt,kpts,it,sym,atoms,enpara%el0(:,:,jsp),enpara%ello0(:,:,jsp),cell,dimension,&
hybrid,vr0,hybdat,noco,oneD,mpi,irank2,input,jsp,zmat)
hybrid,vr0,hybdat,noco,oneD,mpi,input,jsp,zmat)
! generate core wave functions (-> core1/2(jmtd,hybdat%nindxc,0:lmaxc,ntype) )
CALL corewf(atoms,jsp,input,DIMENSION,vr0,hybdat%lmaxcd,hybdat%maxindxc,mpi,&
......@@ -206,7 +206,7 @@ SUBROUTINE hf_setup(hybrid,input,sym,kpts,DIMENSION,atoms,mpi,noco,cell,oneD,res
#endif
! check olap between core-basis/core-valence/basis-basis
CALL checkolap(atoms,hybdat,hybrid,kpts%nkpt,kpts,dimension,mpi,irank2,skip_kpt,&
CALL checkolap(atoms,hybdat,hybrid,kpts%nkpt,kpts,dimension,mpi,skip_kpt,&
input,sym,noco,cell,lapw,jsp)
! set up pointer pntgpt
......
......@@ -45,10 +45,10 @@ MODULE m_hsfock
CONTAINS
SUBROUTINE hsfock(nk,atoms,hybrid,lapw,dimension,kpts,jsp,input,hybdat,eig_irr,sym,cell,noco,&
results,it,mnobd,xcpot,mpi,irank2,isize2,comm)
results,it,mnobd,xcpot,mpi)
USE m_types
USE m_symm_hf ,ONLY: symm_hf
USE m_symm_hf
USE m_util ,ONLY: intgrf,intgrf_init
USE m_exchange_valence_hf
USE m_exchange_core
......@@ -76,7 +76,6 @@ SUBROUTINE hsfock(nk,atoms,hybrid,lapw,dimension,kpts,jsp,input,hybdat,eig_irr,s
! scalars
INTEGER, INTENT(IN) :: jsp
INTEGER, INTENT(IN) :: it
INTEGER, INTENT(IN) :: irank2 ,isize2,comm
INTEGER, INTENT(IN) :: nk
INTEGER, INTENT(IN) :: mnobd
......@@ -89,8 +88,7 @@ SUBROUTINE hsfock(nk,atoms,hybrid,lapw,dimension,kpts,jsp,input,hybdat,eig_irr,s
INTEGER :: ikpt,ikpt0
INTEGER :: irec
INTEGER :: irecl_olap,irecl_z,irecl_vx
INTEGER :: maxndb, nbasfcn
INTEGER :: nddb
INTEGER :: nbasfcn
INTEGER :: nsymop
INTEGER :: nkpt_EIBZ
INTEGER :: ncstd
......@@ -98,12 +96,11 @@ SUBROUTINE hsfock(nk,atoms,hybrid,lapw,dimension,kpts,jsp,input,hybdat,eig_irr,s
REAL :: a_ex
! local arrays
INTEGER :: gpt(3,lapw%nv(jsp))
INTEGER :: degenerat(hybrid%ne_eig(nk))
INTEGER :: nsest(hybrid%nbands(nk)),indx_sest(hybrid%nbands(nk),hybrid%nbands(nk))
INTEGER :: rrot(3,3,sym%nsym)
INTEGER :: psym(sym%nsym) ! Note: psym is only filled up to index nsymop
INTEGER,ALLOCATABLE :: parent(:),symop(:)
INTEGER,ALLOCATABLE :: psym(:)
INTEGER,ALLOCATABLE :: parent(:)
INTEGER,ALLOCATABLE :: pointer_EIBZ(:)
INTEGER,ALLOCATABLE :: n_q(:)
......@@ -112,10 +109,8 @@ SUBROUTINE hsfock(nk,atoms,hybrid,lapw,dimension,kpts,jsp,input,hybdat,eig_irr,s
TYPE(t_mat) :: olap,trafo,invtrafo,ex,tmp,v_x,z
COMPLEX :: exch(dimension%neigd,dimension%neigd)
COMPLEX,ALLOCATABLE :: carr(:)
COMPLEX,ALLOCATABLE :: rep_c(:,:,:,:,:)
CALL timestart("total time hsfock")
CALL timestart("symm_hf")
! preparations
......@@ -125,11 +120,6 @@ SUBROUTINE hsfock(nk,atoms,hybrid,lapw,dimension,kpts,jsp,input,hybdat,eig_irr,s
! initialize weighting factor for HF exchange part
a_ex=xcpot%get_exchange_weight()
! write k1,k2,k3 in gpt
DO i=1,lapw%nv(jsp)
gpt(:,i) = (/lapw%k1(i,jsp),lapw%k2(i,jsp),lapw%k3(i,jsp)/)
END DO
! read in lower triangle part of overlap matrix from direct acces file olap
nbasfcn = MERGE(lapw%nv(1)+lapw%nv(2)+2*atoms%nlotot,lapw%nv(1)+atoms%nlotot,noco%l_noco)
call olap%alloc(sym%invs,nbasfcn)
......@@ -155,14 +145,17 @@ SUBROUTINE hsfock(nk,atoms,hybrid,lapw,dimension,kpts,jsp,input,hybdat,eig_irr,s
IF( nk .eq. 1 .and. jsp .eq. 1 .and. input%imix .gt. 10) CALL system('rm -f broyd*')
! calculate all symmetrie operations, which yield k invariant
ALLOCATE( parent(kpts%nkptf),symop(kpts%nkptf) ,stat=ok)
IF( ok .ne. 0 ) STOP 'mhsfock: failure allocation parent/symop'
parent = 0 ; symop = 0
ALLOCATE(parent(kpts%nkptf), stat=ok)
IF(ok.NE.0) STOP 'mhsfock: failure allocation parent'
parent = 0
CALL symm_hf(kpts,nk,sym,dimension,hybdat,eig_irr,atoms,hybrid,cell,lapw,jsp,gpt,mpi,irank2,&
nsymop,psym,nkpt_EIBZ,n_q,parent,symop,degenerat,pointer_EIBZ,maxndb,nddb,nsest,indx_sest,rep_c)
CALL timestart("symm_hf")
CALL symm_hf_init(sym,kpts,nk,nsymop,rrot,psym)
CALL symm_hf(kpts,nk,sym,dimension,hybdat,eig_irr,atoms,hybrid,cell,lapw,jsp,mpi,&
rrot,nsymop,psym,nkpt_EIBZ,n_q,parent,pointer_EIBZ,nsest,indx_sest)
CALL timestop("symm_hf")
! remove weights(wtkpt) in w_iks
DO ikpt=1,kpts%nkptf
DO iband=1,dimension%neigd
......@@ -174,18 +167,24 @@ SUBROUTINE hsfock(nk,atoms,hybrid,lapw,dimension,kpts,jsp,input,hybdat,eig_irr,s
! calculate contribution from valence electrons to the
! HF exchange
CALL timestart("valence exchange calculation")
ex%l_real=sym%invs
CALL exchange_valence_hf(nk,kpts,nkpt_EIBZ, sym,atoms,hybrid,cell,dimension,input,jsp,hybdat,mnobd,lapw,&
eig_irr,results,parent,pointer_EIBZ,n_q,wl_iks,it,xcpot,noco,nsest,indx_sest,&
mpi,irank2,isize2,comm,ex)
DEALLOCATE (rep_c)
mpi,ex)
CALL timestop("valence exchange calculation")
WRITE(1224,'(a,i7)') 'kpoint: ', nk
DO i = 1, ex%matsize1
DO j = 1, i
IF (ex%l_real) THEN
WRITE(1224,'(2i7,2f15.8)') i, j, ex%data_r(j,i) !ex%data_r(i,j), ex%data_r(j,i)
ELSE
WRITE(1224,'(2i7,4f15.8)') i, j, ex%data_c(j,i) !ex%data_c(i,j), ex%data_c(j,i)
ENDIF
END DO
END DO
CALL timestart("core exchange calculation")
! do the rest of the calculation only on master
IF (irank2 /= 0) RETURN
! calculate contribution from the core states to the HF exchange
IF (xcpot%is_name("hse").OR.xcpot%is_name("vhse")) THEN
......@@ -227,12 +226,45 @@ SUBROUTINE hsfock(nk,atoms,hybrid,lapw,dimension,kpts,jsp,input,hybdat,eig_irr,s
ENDDO
ENDDO
WRITE(1225,'(a,i7)') 'kpoint: ', nk
DO i = 1, ex%matsize1
DO j = 1, i
IF (ex%l_real) THEN
WRITE(1225,'(2i7,2f15.8)') i, j, ex%data_r(i,j), ex%data_r(j,i)
ELSE
WRITE(1225,'(2i7,4f15.8)') i, j, ex%data_c(i,j), ex%data_c(j,i)
ENDIF
END DO
END DO
CALL ex%multiply(invtrafo,tmp)
CALL trafo%multiply(tmp,v_x)
CALL timestop("time for performing T^-1*mat_ex*T^-1*")
CALL symmetrizeh(atoms,kpts%bkf(:,nk),dimension,jsp,lapw,gpt,sym,hybdat%kveclo_eig,cell,nsymop,psym,v_x)
WRITE(1231,'(a,i7)') 'kpoint: ', nk
DO i = 1, v_x%matsize1
DO j = 1, i
IF (v_x%l_real) THEN
WRITE(1231,'(2i7,1f15.8)') i, j, v_x%data_r(i,j)
ELSE
WRITE(1231,'(2i7,2f15.8)') i, j, v_x%data_c(i,j)
ENDIF
END DO
END DO
CALL symmetrizeh(atoms,kpts%bkf(:,nk),dimension,jsp,lapw,sym,hybdat%kveclo_eig,cell,nsymop,psym,v_x)
WRITE(1232,'(a,i7)') 'kpoint: ', nk
DO i = 1, v_x%matsize1
DO j = 1, i
IF (v_x%l_real) THEN
WRITE(1232,'(2i7,1f15.8)') i, j, v_x%data_r(j,i) ! Note the different indices in comparison to points above. This is wanted!
ELSE
WRITE(1232,'(2i7,2f15.8)') i, j, v_x%data_c(j,i) ! Note the different indices in comparison to points above. This is wanted!
ENDIF
END DO
END DO
CALL write_v_x(v_x,kpts%nkpt*(jsp-1) + nk)
END IF ! hybrid%l_calhf
......
......@@ -51,7 +51,6 @@ CONTAINS
LOGICAL :: l_restart=.FALSE.
LOGICAL :: l_zref
INTEGER :: comm(kpts%nkpt),irank2(kpts%nkpt),isize2(kpts%nkpt)
REAL :: bkpt(3)
REAL, ALLOCATABLE :: eig_irr(:,:)
......@@ -119,19 +118,19 @@ CONTAINS
CALL coulombmatrix(mpi,atoms,kpts,cell,sym,hybrid,xcpot,l_restart)
CALL timestop("generation of coulomb matrix")
CALL hf_init(hybrid,kpts,atoms,input,DIMENSION,hybdat,irank2,isize2,sym%invs)
CALL hf_init(hybrid,kpts,atoms,input,DIMENSION,hybdat,sym%invs)
CALL timestop("Preparation for Hybrid functionals")
CALL timestart("Calculation of non-local HF potential")
DO jsp = 1,input%jspins
CALL HF_setup(hybrid,input,sym,kpts,dimension,atoms,mpi,noco,cell,oneD,results,jsp,enpara,eig_id,&
hybdat,irank2,iterHF,sym%invs,v%mt(:,0,:,:),eig_irr)
hybdat,iterHF,sym%invs,v%mt(:,0,:,:),eig_irr)
DO nk = mpi%n_start,kpts%nkpt,mpi%n_stride
CALL lapw%init(input,noco, kpts,atoms,sym,nk,cell,l_zref)
CALL hsfock(nk,atoms,hybrid,lapw,DIMENSION,kpts,jsp,input,hybdat,eig_irr,sym,cell,&
noco,results,iterHF,MAXVAL(hybrid%nobd),xcpot,mpi,irank2(nk),isize2(nk),comm(nk))
noco,results,iterHF,MAXVAL(hybrid%nobd),xcpot,mpi)
END DO
END DO
CALL timestop("Calculation of non-local HF potential")
......
This diff is collapsed.
......@@ -10,7 +10,7 @@ MODULE m_symmetrizeh
CONTAINS
SUBROUTINE symmetrizeh(atoms,bk,DIMENSION,jsp,lapw,gpt,sym,kveclo,cell,nsymop,psym,hmat)
SUBROUTINE symmetrizeh(atoms,bk,DIMENSION,jsp,lapw,sym,kveclo,cell,nsymop,psym,hmat)
USE m_constants
USE m_types
......@@ -28,7 +28,6 @@ SUBROUTINE symmetrizeh(atoms,bk,DIMENSION,jsp,lapw,gpt,sym,kveclo,cell,nsymop,ps
INTEGER, INTENT(IN) :: nsymop, jsp
! arrays
INTEGER, INTENT(IN) :: gpt(:,:)!(3,lapw%nv)
INTEGER, INTENT(IN) :: kveclo(atoms%nlotot)
INTEGER, INTENT(IN) :: psym(nsymop)
REAL, INTENT(IN) :: bk(3)
......@@ -135,23 +134,23 @@ SUBROUTINE symmetrizeh(atoms,bk,DIMENSION,jsp,lapw,gpt,sym,kveclo,cell,nsymop,ps
DO igpt = 1, lapw%nv(jsp)
!rotate G vector corresponding to isym
gpthlp = MATMUL(rrot(:,:,isym),gpt(:,igpt)) + g
gpthlp = MATMUL(rrot(:,:,isym),lapw%gvec(:,igpt,jsp)) + g
! determine number of gpthlp
nrgpt = 0
DO i = 1, lapw%nv(jsp)
IF(MAXVAL( ABS( gpthlp - gpt(:,i) ) ) .LE. 1E-06) THEN
IF(MAXVAL( ABS( gpthlp - lapw%gvec(:,i,jsp) ) ) .LE. 1E-06) THEN
nrgpt = i
EXIT
END IF
END DO
IF(nrgpt.EQ.0) THEN
PRINT *,igpt
PRINT *,gpt(:,igpt)