Commit 3626151b authored by Matthias Redies's avatar Matthias Redies

Merge branch 'develop' into MetaGGA

parents af642504 c3a9cb13
......@@ -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)&
......
......@@ -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,7 +45,7 @@ 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
......@@ -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
......@@ -151,9 +150,9 @@ SUBROUTINE hsfock(nk,atoms,hybrid,lapw,dimension,kpts,jsp,input,hybdat,eig_irr,s
parent = 0
CALL timestart("symm_hf")
CALL symm_hf_init(sym,kpts,nk,irank2,nsymop,rrot,psym)
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,irank2,&
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")
......@@ -171,7 +170,7 @@ SUBROUTINE hsfock(nk,atoms,hybrid,lapw,dimension,kpts,jsp,input,hybdat,eig_irr,s
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)
mpi,ex)
CALL timestop("valence exchange calculation")
WRITE(1224,'(a,i7)') 'kpoint: ', nk
......@@ -186,8 +185,6 @@ SUBROUTINE hsfock(nk,atoms,hybrid,lapw,dimension,kpts,jsp,input,hybdat,eig_irr,s
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
......
......@@ -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")
......
......@@ -15,7 +15,7 @@ MODULE m_symm_hf
CONTAINS
SUBROUTINE symm_hf_init(sym,kpts,nk,irank2,nsymop,rrot,psym)
SUBROUTINE symm_hf_init(sym,kpts,nk,nsymop,rrot,psym)
USE m_types
USE m_util ,ONLY: modulo1
......@@ -25,7 +25,6 @@ SUBROUTINE symm_hf_init(sym,kpts,nk,irank2,nsymop,rrot,psym)
TYPE(t_sym), INTENT(IN) :: sym
TYPE(t_kpts), INTENT(IN) :: kpts
INTEGER, INTENT(IN) :: nk
INTEGER, INTENT(IN) :: irank2
INTEGER, INTENT(OUT) :: nsymop
INTEGER, INTENT(INOUT) :: rrot(3,3,sym%nsym)
INTEGER, INTENT(INOUT) :: psym(sym%nsym) ! Note: psym is only filled up to index nsymop
......@@ -62,16 +61,14 @@ SUBROUTINE symm_hf_init(sym,kpts,nk,irank2,nsymop,rrot,psym)
END IF
END DO
IF (irank2 == 0) THEN
WRITE(6,'(A,i3)') ' nk',nk
WRITE(6,'(A,3f10.5)') ' kpts%bkf(:,nk):',kpts%bkf(:,nk)
WRITE(6,'(A,i3)') ' Number of elements in the little group:',nsymop
END IF
WRITE(6,'(A,i3)') ' nk',nk
WRITE(6,'(A,3f10.5)') ' kpts%bkf(:,nk):',kpts%bkf(:,nk)
WRITE(6,'(A,i3)') ' Number of elements in the little group:',nsymop
END SUBROUTINE symm_hf_init
SUBROUTINE symm_hf(kpts,nk,sym,dimension,hybdat,eig_irr,atoms,hybrid,cell,&
lapw,jsp,mpi,irank2,rrot,nsymop,psym,nkpt_EIBZ,n_q,parent,&
lapw,jsp,mpi,rrot,nsymop,psym,nkpt_EIBZ,n_q,parent,&
pointer_EIBZ,nsest,indx_sest)
USE m_constants
......@@ -96,7 +93,6 @@ SUBROUTINE symm_hf(kpts,nk,sym,dimension,hybdat,eig_irr,atoms,hybrid,cell,&
! - scalars -
INTEGER,INTENT(IN) :: nk
INTEGER,INTENT(IN) :: jsp
INTEGER,INTENT(IN) :: irank2
INTEGER,INTENT(OUT) :: nkpt_EIBZ
INTEGER,INTENT(IN) :: nsymop
......@@ -148,9 +144,7 @@ SUBROUTINE symm_hf(kpts,nk,sym,dimension,hybdat,eig_irr,atoms,hybrid,cell,&
COMPLEX,ALLOCATABLE :: rep_d(:,:,:)
LOGICAL,ALLOCATABLE :: symequivalent(:,:)
IF ( irank2 == 0 ) THEN
WRITE(6,'(A)') new_line('n') // new_line('n') // '### subroutine: symm ###'
END IF
WRITE(6,'(A)') new_line('n') // new_line('n') // '### subroutine: symm ###'
! determine extented irreducible BZ of k ( EIBZ(k) ), i.e.
! those k-points, which can generate the whole BZ by
......@@ -212,9 +206,7 @@ SUBROUTINE symm_hf(kpts,nk,sym,dimension,hybdat,eig_irr,atoms,hybrid,cell,&
END IF
END DO
IF ( irank2 == 0 ) THEN
WRITE(6,'(A,i5)') ' Number of k-points in the EIBZ',nkpt_EIBZ
END IF
WRITE(6,'(A,i5)') ' Number of k-points in the EIBZ',nkpt_EIBZ
! determine the factor n_q, that means the number of symmetrie operations of the little group of bk(:,nk)
......@@ -252,9 +244,8 @@ SUBROUTINE symm_hf(kpts,nk,sym,dimension,hybdat,eig_irr,atoms,hybrid,cell,&
tolerance = 1E-07 !0.00001
degenerat = 1
IF ( irank2 == 0 ) THEN
WRITE(6,'(A,f10.8)') ' Tolerance for determining degenerate states=', tolerance
END IF
WRITE(6,'(A,f10.8)') ' Tolerance for determining degenerate states=', tolerance
DO i=1,hybrid%nbands(nk)
DO j=i+1,hybrid%nbands(nk)
......@@ -277,13 +268,10 @@ SUBROUTINE symm_hf(kpts,nk,sym,dimension,hybdat,eig_irr,atoms,hybrid,cell,&
! number of different degenerate bands/states
nddb = count( degenerat .ge. 1)
IF ( irank2 == 0 ) THEN
WRITE(6,*) ' Degenerate states:'
DO iband = 1,hybrid%nbands(nk)/5+1
WRITE(6,'(5i5)')degenerat(iband*5-4:min(iband*5,hybrid%nbands(nk)))
END DO
END IF
WRITE(6,*) ' Degenerate states:'
DO iband = 1,hybrid%nbands(nk)/5+1
WRITE(6,'(5i5)')degenerat(iband*5-4:min(iband*5,hybrid%nbands(nk)))
END DO
IF( irreps ) THEN
! calculate representation, i.e. the action of an element of
......
......@@ -45,6 +45,7 @@ MODULE m_xmlOutput
SUBROUTINE startXMLOutput()
USE m_juDFT_args
USE m_juDFT_usage
USE m_constants
USE m_utility
USE m_compile_descr
......@@ -91,6 +92,7 @@ MODULE m_xmlOutput
CALL get_compile_desc(gitdesc,githash,gitbranch,compile_date,compile_user,compile_host,compile_flags,link_flags)
gitdescTemp = gitdesc
githashTemp = githash
CALL add_usage_data("githash", githash)
gitbranchTemp = gitbranch
compile_dateTemp = compile_date
compile_userTemp = compile_user
......
......@@ -4,97 +4,110 @@
! of the MIT license as expressed in the LICENSE file in more detail.
!--------------------------------------------------------------------------------
MODULE m_judft_usage
IMPLICIT NONE
PRIVATE
CHARACTER(LEN=99),PARAMETER:: URL_STRING="www.flapw.de/collect.pl"
INTEGER,PARAMETER :: MAX_NO_KEYS=20
CHARACTER(LEN=20) :: keys(MAX_NO_KEYS)
CHARACTER(LEN=20) :: values(MAX_NO_KEYS)
INTEGER :: no_keys=0
IMPLICIT NONE
PRIVATE
CHARACTER(LEN=99),PARAMETER:: URL_STRING="www.flapw.de/collect.pl"
INTEGER,PARAMETER :: MAX_NO_KEYS=20
CHARACTER(LEN=200) :: keys(MAX_NO_KEYS)
CHARACTER(LEN=200) :: values(MAX_NO_KEYS)
INTEGER :: no_keys=0
INTERFACE add_usage_data
MODULE PROCEDURE add_usage_data_s,add_usage_data_i,add_usage_data_l
END INTERFACE add_usage_data
INTERFACE add_usage_data
MODULE PROCEDURE add_usage_data_s,add_usage_data_i,add_usage_data_l
END INTERFACE add_usage_data
PUBLIC :: add_usage_data,send_usage_data
PUBLIC :: add_usage_data,send_usage_data
CONTAINS
SUBROUTINE add_usage_data_s(key,VALUE)
IMPLICIT NONE
CHARACTER(len=*),INTENT(IN)::key,VALUE
no_keys=no_keys+1
IF (no_keys>MAX_NO_KEYS) STOP "BUG, too many keys in usage_data"
keys(no_keys) =key
values(no_keys)=VALUE
END SUBROUTINE add_usage_data_s
SUBROUTINE add_usage_data_i(key,VALUE)
IMPLICIT NONE
CHARACTER(len=*),INTENT(IN):: key
INTEGER,intent(in) :: value
SUBROUTINE add_usage_data_s(key,VALUE)
IMPLICIT NONE
CHARACTER(len=*),INTENT(IN)::key,VALUE
no_keys=no_keys+1
IF (no_keys>MAX_NO_KEYS) STOP "BUG, too many keys in usage_data"
keys(no_keys) =key
values(no_keys)=VALUE
END SUBROUTINE add_usage_data_s
SUBROUTINE add_usage_data_i(key,VALUE)
IMPLICIT NONE
CHARACTER(len=*),INTENT(IN):: key
INTEGER,intent(in) :: value
CHARACTER(len=20)::txt
WRITE(txt,*) VALUE
CALL add_usage_data_s(key,txt)
END SUBROUTINE add_usage_data_i
CHARACTER(len=20)::txt
WRITE(txt,*) VALUE
CALL add_usage_data_s(key,txt)
END SUBROUTINE add_usage_data_i
SUBROUTINE add_usage_data_l(key,VALUE)
IMPLICIT NONE
CHARACTER(len=*),INTENT(IN):: key
LOGICAL,INTENT(in) :: VALUE
SUBROUTINE add_usage_data_l(key,VALUE)
IMPLICIT NONE
CHARACTER(len=*),INTENT(IN):: key
LOGICAL,INTENT(in) :: VALUE
CHARACTER(len=20)::txt
txt=MERGE("TRUE ","FALSE",value)
CALL add_usage_data_s(key,txt)
END SUBROUTINE add_usage_data_l
CHARACTER(len=20)::txt
txt=MERGE("TRUE ","FALSE",value)
CALL add_usage_data_s(key,txt)
END SUBROUTINE add_usage_data_l
SUBROUTINE send_usage_data()
IMPLICIT NONE
INTEGER :: i,ierr,pid,dt(8)
INTEGER*8 :: r
SUBROUTINE send_usage_data()
IMPLICIT NONE
INTEGER :: i,ierr,pid,dt(8)
INTEGER*8 :: r
#ifdef CPP_MPI
INCLUDE 'mpif.h'