Line data    Source code

       1             : !--------------------------------------------------------------------------------
       2             : ! Copyright (c) 2016 Peter Grünberg Institut, Forschungszentrum Jülich, Germany
       3             : ! This file is part of FLEUR and available as free software under the conditions
       4             : ! of the MIT license as expressed in the LICENSE file in more detail.
       5             : !--------------------------------------------------------------------------------
       6             : 
       7             : MODULE m_orthoglo
       8             :   USE m_juDFT
       9             :   !*********************************************************************
      10             :   ! Each G-vector corresponds to a vector of C-coeff. These vectors must
      11             :   ! be linearly independent. This is checked by this soubroutine for an
      12             :   ! atom that doesn't have an inversion partner.
      13             :   ! Philipp Kurz 99/04
      14             :   !*********************************************************************
      15             : CONTAINS
      16       98442 :   SUBROUTINE orthoglo(l_real,atoms, nkvec,lo,l,linindq,l_lo2, cwork, linind)
      17             :     !
      18             :     !*************** ABBREVIATIONS ***************************************
      19             :     ! cwork   : contains the vectors of C-coeff.
      20             :     ! l_lo2   : changes this routine to old 'orthoglo2': same as orthoglo, 
      21             :     !           but for a pair of atoms that can be mapped onto eachother 
      22             :     !           by inversion.
      23             :     ! CF Replaced (unstable) Gram-Schmidt by diagonalization.
      24             :     !*********************************************************************
      25             : 
      26             :     USE m_types_fleurinput
      27             :     IMPLICIT NONE
      28             :     TYPE(t_atoms),INTENT(IN)   :: atoms
      29             :     !     ..
      30             :     !     .. Scalar Arguments ..
      31             :     INTEGER, INTENT (IN) :: l,lo,nkvec
      32             :     REAL,    INTENT (IN) :: linindq
      33             :     LOGICAL, INTENT (IN) :: l_lo2,l_real
      34             :     LOGICAL, INTENT (OUT) :: linind
      35             :     !     ..
      36             :     !     .. Array Arguments ..
      37             :     COMPLEX,INTENT (INOUT):: cwork(-2*atoms%llod:2*atoms%llod+1,2*(2*atoms%llod+1) ,atoms%nlod)
      38             :     !     ..
      39             :     !     .. Local Scalars ..
      40             :     INTEGER dim,low,i,j
      41             :     !     ..
      42             :     !     .. Local Arrays ..
      43       98442 :     REAL eig(nkvec),rwork(3*nkvec)
      44       98442 :     REAL olap_r(nkvec,nkvec)
      45             :     EXTERNAL dsyev
      46       98442 :     COMPLEX olap_c(nkvec,nkvec),work(2*nkvec)
      47             :     EXTERNAL zheev
      48             : 
      49       98442 :     IF (l_lo2) THEN
      50        1202 :        dim = 2* (2*l+1)
      51        1202 :        low = -2*l
      52             :     ELSE
      53       97240 :        dim = 2*l+1
      54       97240 :        low = -l
      55             :     ENDIF
      56             : 
      57      304974 :     DO i = 1,nkvec
      58      845130 :        DO j = 1,nkvec
      59      746688 :           IF (l_real) THEN
      60      775846 :              olap_r(i,j) = DOT_PRODUCT(cwork(low:low+dim-1,i,lo), cwork(low:low+dim-1,j,lo))
      61             :           ELSE
      62     1730732 :              olap_c(i,j) = DOT_PRODUCT(cwork(low:low+dim-1,i,lo), cwork(low:low+dim-1,j,lo))
      63             :           ENDIF
      64             :        ENDDO
      65             :     ENDDO
      66       98442 :     IF (l_real) THEN
      67       37400 :        CALL dsyev('N','U',nkvec,olap_r,nkvec,eig, rwork,3*nkvec,i)
      68       37400 :        IF(i/=0)  CALL juDFT_error("(S,D)SYEV failed.","orthoglo")
      69             :     ELSE
      70       61042 :        CALL zheev('N','U',nkvec,olap_c,nkvec,eig, work,2*nkvec,rwork,i)
      71       61042 :        IF(i/=0)  CALL juDFT_error("(C,Z)HEEV failed.","orthoglo")
      72             :     ENDIF
      73       98442 :     IF(eig(1).LT.linindq) THEN
      74        9518 :        linind = .FALSE.
      75             :     ELSE
      76       88924 :        linind = .TRUE.
      77             :     ENDIF
      78       98442 :     RETURN
      79             : 
      80             :   END SUBROUTINE orthoglo
      81             : END MODULE m_orthoglo