LCOV - code coverage report
Current view: top level - hybrid - olap.F90 (source / functions) Hit Total Coverage
Test: combined.info Lines: 0 185 0.0 %
Date: 2019-09-08 04:53:50 Functions: 0 9 0.0 %

          Line data    Source code
       1             : MODULE m_olap
       2             : 
       3             : CONTAINS
       4             : 
       5             : !     Calculates plane-wave overlap matrix olap defined by GPT(1:3,1:NGPT).
       6             : !     (Muffin-tin spheres are cut out.)
       7             : !     olap_pw calculates full overlap matrix
       8             : 
       9           0 :    SUBROUTINE olap_pw(olap, gpt, ngpt, atoms, cell)
      10             : 
      11             :       USE m_constants
      12             :       USE m_types
      13             :       IMPLICIT NONE
      14             :       TYPE(t_cell), INTENT(IN)   :: cell
      15             :       TYPE(t_atoms), INTENT(IN)   :: atoms
      16             : 
      17             : !     - scalars -
      18             :       INTEGER, INTENT(IN)       :: ngpt
      19             : !     - arrays -
      20             :       INTEGER, INTENT(IN)       :: gpt(3, ngpt)
      21             :       TYPE(t_mat)              :: olap
      22             : !     - local -
      23             :       INTEGER                  :: i, j, itype, icent, ineq
      24             :       REAL                     :: g, r, fgr
      25             :       COMPLEX, PARAMETER        :: img = (0.0, 1.0)
      26             :       INTEGER                  :: dg(3)
      27             : 
      28           0 :       DO i = 1, ngpt
      29           0 :          DO j = 1, i
      30           0 :             dg = gpt(:, j) - gpt(:, i)
      31           0 :             g = gptnorm(dg, cell%bmat)
      32           0 :             IF (g == 0) THEN
      33           0 :                DO itype = 1, atoms%ntype
      34           0 :                   r = atoms%rmt(itype)
      35           0 :                   if (olap%l_real) THEN
      36           0 :                      olap%data_r(i, j) = olap%data_r(i, j) - atoms%neq(itype)*fpi_const*r**3/3/cell%omtil
      37             :                   else
      38           0 :                      olap%data_c(i, j) = olap%data_c(i, j) - atoms%neq(itype)*fpi_const*r**3/3/cell%omtil
      39             :                   endif
      40             :                END DO
      41             :             ELSE
      42           0 :                icent = 0
      43           0 :                DO itype = 1, atoms%ntype
      44           0 :                   r = g*atoms%rmt(itype)
      45           0 :                   fgr = fpi_const*(sin(r) - r*cos(r))/g**3/cell%omtil
      46           0 :                   DO ineq = 1, atoms%neq(itype)
      47           0 :                      icent = icent + 1
      48           0 :                      if (olap%l_real) THEN
      49           0 :                         olap%data_r(i, j) = olap%data_r(i, j) - fgr*exp(img*tpi_const*dot_product(dg, atoms%taual(:, icent)))
      50             :                      else
      51           0 :                         olap%data_c(i, j) = olap%data_c(i, j) - fgr*exp(img*tpi_const*dot_product(dg, atoms%taual(:, icent)))
      52             :                      endif
      53             :                   END DO
      54             :                END DO
      55             :             END IF
      56           0 :             if (olap%l_real) THEN
      57           0 :                IF (i == j) olap%data_r(i, j) = olap%data_r(i, j) + 1
      58           0 :                olap%data_r(j, i) = olap%data_r(i, j)
      59             :             else
      60           0 :                IF (i == j) olap%data_c(i, j) = olap%data_c(i, j) + 1
      61           0 :                olap%data_c(j, i) = conjg(olap%data_c(i, j))
      62             :             endif
      63             :          END DO
      64             :       END DO
      65             : 
      66           0 :    END SUBROUTINE olap_pw
      67             : 
      68             : ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
      69             : 
      70             : !     olap_pwp  calculates upper triangular part of overlap matrix
      71             : 
      72           0 :    SUBROUTINE olap_pwp(l_real, olap_r, olap_c, gpt, ngpt, atoms, cell)
      73             : 
      74             :       USE m_constants
      75             :       USE m_types
      76             :       IMPLICIT NONE
      77             :       TYPE(t_cell), INTENT(IN)   :: cell
      78             :       TYPE(t_atoms), INTENT(IN)   :: atoms
      79             : 
      80             : !     - scalars -
      81             :       INTEGER, INTENT(IN)       :: ngpt
      82             : !     - arrays -
      83             :       INTEGER, INTENT(IN)       :: gpt(3, ngpt)
      84             : 
      85             :       LOGICAL, INTENT(IN)       :: l_real
      86             :       REAL, INTENT(OUT)         ::  olap_r(ngpt*(ngpt + 1)/2)
      87             :       COMPLEX, INTENT(OUT)      ::  olap_c(ngpt*(ngpt + 1)/2)
      88             : !     - local -
      89             :       INTEGER                  :: i, j, k, itype, icent, ineq
      90             :       REAL                     :: g, r, fgr
      91             :       COMPLEX, PARAMETER        :: img = (0.0, 1.0)
      92             :       INTEGER                  :: dg(3)
      93             : 
      94           0 :       if (l_real) THEN
      95             :          k = 0
      96           0 :          DO i = 1, ngpt
      97           0 :             DO j = 1, i
      98           0 :                k = k + 1
      99           0 :                dg = gpt(:, i) - gpt(:, j)
     100           0 :                g = gptnorm(dg, cell%bmat)
     101           0 :                olap_r(k) = 0
     102           0 :                IF (g == 0) THEN
     103           0 :                   DO itype = 1, atoms%ntype
     104           0 :                      r = atoms%rmt(itype)
     105           0 :                      olap_r(k) = olap_r(k) - atoms%neq(itype)*fpi_const*r**3/3/cell%omtil
     106             :                   END DO
     107             :                ELSE
     108           0 :                   icent = 0
     109           0 :                   DO itype = 1, atoms%ntype
     110           0 :                      r = g*atoms%rmt(itype)
     111           0 :                      fgr = fpi_const*(sin(r) - r*cos(r))/g**3/cell%omtil
     112           0 :                      DO ineq = 1, atoms%neq(itype)
     113           0 :                         icent = icent + 1
     114             :                         olap_r(k) = olap_r(k) - fgr* &
     115           0 :              &               exp(img*tpi_const*dot_product(dg, atoms%taual(:, icent)))
     116             :                      END DO
     117             :                   END DO
     118             :                END IF
     119           0 :                IF (i == j) olap_r(k) = olap_r(k) + 1
     120             :             END DO
     121             :          END DO
     122             :       else
     123             :          k = 0
     124           0 :          DO i = 1, ngpt
     125           0 :             DO j = 1, i
     126           0 :                k = k + 1
     127           0 :                dg = gpt(:, i) - gpt(:, j)
     128           0 :                g = gptnorm(dg, cell%bmat)
     129           0 :                olap_c(k) = 0
     130           0 :                IF (g == 0) THEN
     131           0 :                   DO itype = 1, atoms%ntype
     132           0 :                      r = atoms%rmt(itype)
     133           0 :                      olap_c(k) = olap_c(k) - atoms%neq(itype)*fpi_const*r**3/3/cell%omtil
     134             :                   END DO
     135             :                ELSE
     136           0 :                   icent = 0
     137           0 :                   DO itype = 1, atoms%ntype
     138           0 :                      r = g*atoms%rmt(itype)
     139           0 :                      fgr = fpi_const*(sin(r) - r*cos(r))/g**3/cell%omtil
     140           0 :                      DO ineq = 1, atoms%neq(itype)
     141           0 :                         icent = icent + 1
     142             :                         olap_c(k) = olap_c(k) - fgr* &
     143           0 :              &               exp(img*tpi_const*dot_product(dg, atoms%taual(:, icent)))
     144             :                      END DO
     145             :                   END DO
     146             :                END IF
     147           0 :                IF (i == j) olap_c(k) = olap_c(k) + 1
     148             :             END DO
     149             :          END DO
     150             : 
     151             :       endif
     152           0 :    END SUBROUTINE olap_pwp
     153             : 
     154           0 :    PURE FUNCTION gptnorm(gpt, bmat)
     155             :       IMPLICIT NONE
     156             :       REAL                :: gptnorm
     157             :       INTEGER, INTENT(IN)  :: gpt(3)
     158             :       REAL, INTENT(IN)     :: bmat(3, 3)
     159             : 
     160           0 :       gptnorm = sqrt(sum(matmul(gpt(:), bmat(:, :))**2))
     161             : 
     162           0 :    END FUNCTION gptnorm
     163             : 
     164             : ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
     165             : 
     166           0 :    SUBROUTINE wfolap_init(olappw, olapmt, gpt,&
     167             :   &                       atoms, hybrid, cell,&
     168           0 :   &                       bas1, bas2)
     169             : 
     170             :       USE m_util, ONLY: intgrf, intgrf_init
     171             :       USE m_types
     172             :       IMPLICIT NONE
     173             :       TYPE(t_hybrid), INTENT(IN)   :: hybrid
     174             :       TYPE(t_cell), INTENT(IN)   :: cell
     175             :       TYPE(t_atoms), INTENT(IN)   :: atoms
     176             : 
     177             : !     - arrays -
     178             :       INTEGER, INTENT(IN)       :: gpt(:, :)!(3,ngpt)
     179             :       REAL, INTENT(IN)         ::  bas1(atoms%jmtd, hybrid%maxindx, 0:atoms%lmaxd, atoms%ntype),&
     180             :      &                            bas2(atoms%jmtd, hybrid%maxindx, 0:atoms%lmaxd, atoms%ntype)
     181             :       REAL, INTENT(OUT)         :: olapmt(hybrid%maxindx, hybrid%maxindx, 0:atoms%lmaxd, atoms%ntype)
     182             :       TYPE(t_mat), INTENT(INOUT):: olappw
     183             : 
     184             : !     - local -
     185             :       INTEGER                  :: itype, l, nn, n1, n2
     186             : 
     187           0 :       REAL, ALLOCATABLE         :: gridf(:, :)
     188             : 
     189           0 :       CALL intgrf_init(atoms%ntype, atoms%jmtd, atoms%jri, atoms%dx, atoms%rmsh, gridf)
     190           0 :       olapmt = 0
     191           0 :       DO itype = 1, atoms%ntype
     192           0 :          DO l = 0, atoms%lmax(itype)
     193           0 :             nn = hybrid%nindx(l, itype)
     194           0 :             DO n2 = 1, nn
     195           0 :                DO n1 = 1, nn!n2
     196             :                   !IF( n1 .gt. 2 .or. n2 .gt. 2) CYCLE
     197             :                   olapmt(n1, n2, l, itype) = intgrf( &
     198             :          &                            bas1(:, n1, l, itype)*bas1(:, n2, l, itype)&
     199             :          &                           + bas2(:, n1, l, itype)*bas2(:, n2, l, itype),&
     200           0 :          &                            atoms%jri, atoms%jmtd, atoms%rmsh, atoms%dx, atoms%ntype, itype, gridf)
     201             : !               olapmt(n2,n1,l,itype) = olapmt(n1,n2,l,itype)
     202             :                END DO
     203             :             END DO
     204             :          END DO
     205             :       END DO
     206             : 
     207           0 :       CALL olap_pw(olappw, gpt, size(gpt, 2), atoms, cell)
     208             : 
     209           0 :    END SUBROUTINE wfolap_init
     210             : 
     211           0 :    FUNCTION wfolap_inv(cmt1, cpw1, cmt2, cpw2, ngpt1, ngpt2, olappw, olapmt, atoms, hybrid)
     212             : 
     213             :       USE m_wrapper
     214             :       USE m_types
     215             :       IMPLICIT NONE
     216             :       TYPE(t_hybrid), INTENT(IN)   :: hybrid
     217             :       TYPE(t_atoms), INTENT(IN)   :: atoms
     218             : 
     219             : !     - scalars -
     220             :       COMPLEX                :: wfolap_inv
     221             :       INTEGER, INTENT(IN)     :: ngpt1, ngpt2
     222             : !     - arrays -
     223             :       COMPLEX, INTENT(IN)     :: cmt1(hybrid%maxlmindx, atoms%nat),&
     224             :      &                          cmt2(hybrid%maxlmindx, atoms%nat)
     225             :       REAL, INTENT(IN)        :: cpw1(ngpt1)
     226             :       COMPLEX, INTENT(IN)     :: cpw2(ngpt2)
     227             :       REAL, INTENT(IN)        :: olappw(ngpt1, ngpt2)
     228             :       REAL, INTENT(IN)        :: olapmt(hybrid%maxindx, hybrid%maxindx, 0:atoms%lmaxd, atoms%ntype)
     229             : !     - local -
     230             :       INTEGER                :: itype, ieq, iatom, l, m, lm, nn
     231             :       COMPLEX                :: carr(ngpt1), cdum
     232             :       REAL                   :: rarr1(ngpt1), rarr2(ngpt1), rdum1, rdum2
     233             : 
     234           0 :       wfolap_inv = 0
     235           0 :       iatom = 0
     236           0 :       DO itype = 1, atoms%ntype
     237           0 :          DO ieq = 1, atoms%neq(itype)
     238           0 :             iatom = iatom + 1
     239           0 :             lm = 0
     240           0 :             DO l = 0, atoms%lmax(itype)
     241           0 :                DO M = -l, l
     242           0 :                   nn = hybrid%nindx(l, itype)
     243             :                   wfolap_inv = wfolap_inv + &
     244             :          &                 dot_product(cmt1(lm + 1:lm + nn, iatom),&
     245             :          &                               matmul(olapmt(:nn, :nn, l, itype),&
     246           0 :          &                                       cmt2(lm + 1:lm + nn, iatom)))
     247           0 :                   lm = lm + nn
     248             :                END DO
     249             :             END DO
     250             :          END DO
     251             :       END DO
     252             : 
     253           0 :       wfolap_inv = wfolap_inv + dot_product(cpw1, matmul(olappw, cpw2))
     254             : 
     255             : !       CALL dgemv('N',ngpt1,ngpt2,1.0,olappw,ngpt1,real(cpw2),1,0.0,rarr1,1)
     256             : !       CALL dgemv('N',ngpt1,ngpt2,1.0,olappw,ngpt1,aimag(cpw2),1,0.0,rarr2,1)
     257             : !
     258             : !       rdum1 = dotprod(cpw1,rarr1)
     259             : !       rdum2 = dotprod(cpw1,rarr2)
     260             : !       cdum  = cmplx( rdum1, rdum2 )
     261             : 
     262             : !       wfolap = wfolap + cdum
     263             : 
     264           0 :    END FUNCTION wfolap_inv
     265           0 :    FUNCTION wfolap_noinv(cmt1, cpw1, cmt2, cpw2, ngpt1, ngpt2, olappw, olapmt, atoms, hybrid)
     266             : 
     267             :       USE m_wrapper
     268             :       USE m_types
     269             :       IMPLICIT NONE
     270             :       TYPE(t_hybrid), INTENT(IN)   :: hybrid
     271             :       TYPE(t_atoms), INTENT(IN)   :: atoms
     272             : 
     273             : !     - scalars -
     274             :       COMPLEX                :: wfolap_noinv
     275             :       INTEGER, INTENT(IN)     :: ngpt1, ngpt2
     276             : !     - arrays -
     277             :       COMPLEX, INTENT(IN)     :: cmt1(hybrid%maxlmindx, atoms%nat),&
     278             :      &                          cmt2(hybrid%maxlmindx, atoms%nat)
     279             :       COMPLEX, INTENT(IN)     :: cpw1(ngpt1)
     280             :       COMPLEX, INTENT(IN)     :: cpw2(ngpt2)
     281             :       COMPLEX, INTENT(IN)     :: olappw(ngpt1, ngpt2)
     282             :       REAL, INTENT(IN)        :: olapmt(hybrid%maxindx, hybrid%maxindx, 0:atoms%lmaxd, atoms%ntype)
     283             : !     - local -
     284             :       INTEGER                :: itype, ieq, iatom, l, m, lm, nn
     285             :       COMPLEX                :: carr(ngpt1), cdum
     286             :       REAL                   :: rarr1(ngpt1), rarr2(ngpt1), rdum1, rdum2
     287             : 
     288           0 :       wfolap_noinv = 0
     289           0 :       iatom = 0
     290           0 :       DO itype = 1, atoms%ntype
     291           0 :          DO ieq = 1, atoms%neq(itype)
     292           0 :             iatom = iatom + 1
     293           0 :             lm = 0
     294           0 :             DO l = 0, atoms%lmax(itype)
     295           0 :                DO M = -l, l
     296           0 :                   nn = hybrid%nindx(l, itype)
     297             :                   wfolap_noinv = wfolap_noinv + &
     298             :          &                 dot_product(cmt1(lm + 1:lm + nn, iatom),&
     299             :          &                               matmul(olapmt(:nn, :nn, l, itype),&
     300           0 :          &                                       cmt2(lm + 1:lm + nn, iatom)))
     301           0 :                   lm = lm + nn
     302             :                END DO
     303             :             END DO
     304             :          END DO
     305             :       END DO
     306             : 
     307           0 :       wfolap_noinv = wfolap_noinv + dot_product(cpw1, matmul(olappw, cpw2))
     308             : 
     309             : !       CALL dgemv('N',ngpt1,ngpt2,1.0,olappw,ngpt1,real(cpw2),1,0.0,rarr1,1)
     310             : !       CALL dgemv('N',ngpt1,ngpt2,1.0,olappw,ngpt1,aimag(cpw2),1,0.0,rarr2,1)
     311             : !
     312             : !       rdum1 = dotprod(cpw1,rarr1)
     313             : !       rdum2 = dotprod(cpw1,rarr2)
     314             : !       cdum  = cmplx( rdum1, rdum2 )
     315             : 
     316             : !       wfolap = wfolap + cdum
     317             : 
     318           0 :    END FUNCTION wfolap_noinv
     319             : 
     320           0 :    FUNCTION wfolap1(cmt1, cpw1, cmt2, cpw2, ngpt1, ngpt2, olappw, olapmt,&
     321             :   &                atoms, hybrid)
     322             : 
     323             :       USE m_types
     324             :       IMPLICIT NONE
     325             : 
     326             :       TYPE(t_hybrid), INTENT(IN)   :: hybrid
     327             :       TYPE(t_atoms), INTENT(IN)   :: atoms
     328             : 
     329             : !     -scalars -
     330             :       COMPLEX                :: wfolap1
     331             :       INTEGER, INTENT(IN)     :: ngpt1, ngpt2
     332             : !     - arrays -
     333             :       COMPLEX, INTENT(IN)     :: cmt1(hybrid%maxlmindx, atoms%nat),&
     334             :      &                          cmt2(hybrid%maxlmindx, atoms%nat)
     335             : #if ( defined(CPP_INVERSION) )
     336             :       REAL, INTENT(IN)        :: cpw1(ngpt1), cpw2(ngpt2)
     337             : #else
     338             :       COMPLEX, INTENT(IN)     :: cpw1(ngpt1), cpw2(ngpt2)
     339             : #endif
     340             : #if ( defined(CPP_INVERSION) )
     341             :       REAL, INTENT(IN)        :: olappw(ngpt1, ngpt2)
     342             : #else
     343             :       COMPLEX, INTENT(IN)     :: olappw(ngpt1, ngpt2)
     344             : #endif
     345             :       REAL, INTENT(IN)        :: olapmt(hybrid%maxindx, hybrid%maxindx, 0:atoms%lmaxd, atoms%ntype)
     346             : 
     347             : !     - local -
     348             :       INTEGER                :: itype, ieq, iatom, l, m, lm, nn
     349             : 
     350           0 :       wfolap1 = 0
     351           0 :       iatom = 0
     352           0 :       DO itype = 1, atoms%ntype
     353           0 :          DO ieq = 1, atoms%neq(itype)
     354           0 :             iatom = iatom + 1
     355           0 :             lm = 0
     356           0 :             DO l = 0, atoms%lmax(itype)
     357           0 :                DO M = -l, l
     358           0 :                   nn = hybrid%nindx(l, itype)
     359             :                   wfolap1 = wfolap1 + &
     360             :          &                  dot_product(cmt1(lm + 1:lm + nn, iatom),&
     361             :          &                                matmul(olapmt(:nn, :nn, l, itype),&
     362           0 :          &                                        cmt2(lm + 1:lm + nn, iatom)))
     363           0 :                   lm = lm + nn
     364             :                END DO
     365             :             END DO
     366             :          END DO
     367             :       END DO
     368             : 
     369           0 :       wfolap1 = wfolap1 + dot_product(cpw1, matmul(olappw, cpw2))
     370             : 
     371           0 :    END FUNCTION wfolap1
     372             : 
     373           0 :    FUNCTION wfolap2(cmt1, cpw1, cmt2, cpw2, ngpt1, ngpt2, olappw, olapmt,&
     374             :   &                atoms, hybrid)
     375             :       USE m_types
     376             :       IMPLICIT NONE
     377             : 
     378             :       TYPE(t_hybrid), INTENT(IN)   :: hybrid
     379             :       TYPE(t_atoms), INTENT(IN)   :: atoms
     380             : 
     381             : !     - scalars -
     382             :       COMPLEX                :: wfolap2
     383             :       INTEGER, INTENT(IN)     :: ngpt1, ngpt2
     384             : !     - arrays -
     385             :       COMPLEX, INTENT(IN)     :: cmt1(hybrid%maxlmindx, atoms%nat),&
     386             :      &                          cmt2(hybrid%maxlmindx, atoms%nat)
     387             : ! #if ( defined(CPP_INVERSION) )
     388             : !       REAL,INTENT(IN)        :: cpw1(ngpt1)
     389             : ! #else
     390             :       COMPLEX, INTENT(IN)     :: cpw1(ngpt1)
     391             : ! #endif
     392             :       COMPLEX, INTENT(IN)     :: cpw2(ngpt2)
     393             : #if ( defined(CPP_INVERSION) )
     394             :       REAL, INTENT(IN)        :: olappw(ngpt1, ngpt2)
     395             : #else
     396             :       COMPLEX, INTENT(IN)     :: olappw(ngpt1, ngpt2)
     397             : #endif
     398             :       REAL, INTENT(IN)        :: olapmt(hybrid%maxindx, hybrid%maxindx, 0:atoms%lmaxd, atoms%ntype)
     399             : !     - local -
     400             :       INTEGER                :: itype, ieq, ic, l, m, lm, nn
     401             : 
     402           0 :       wfolap2 = 0
     403           0 :       ic = 0
     404           0 :       DO itype = 1, atoms%ntype
     405           0 :          DO ieq = 1, atoms%neq(itype)
     406           0 :             ic = ic + 1
     407           0 :             lm = 0
     408           0 :             DO l = 0, atoms%lmax(itype)
     409           0 :                DO M = -l, l
     410           0 :                   nn = hybrid%nindx(l, itype)
     411             :                   wfolap2 = wfolap2 + &
     412             :          &                 dot_product(cmt1(lm + 1:lm + nn, ic),&
     413             :          &                               matmul(olapmt(:nn, :nn, l, itype),&
     414           0 :          &                                       cmt2(lm + 1:lm + nn, ic)))
     415           0 :                   lm = lm + nn
     416             :                END DO
     417             :             END DO
     418             :          END DO
     419             :       END DO
     420             : 
     421           0 :       wfolap2 = wfolap2 + dot_product(cpw1, matmul(olappw, cpw2))
     422             : 
     423           0 :    END FUNCTION wfolap2
     424             : 
     425             : ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
     426             : 
     427             : !     Calculates overlap between core and valence wavefunctions
     428             : 
     429           0 :    SUBROUTINE olap_cv(hybrid, kpts, maxlcutc, maxindxc, atoms,&
     430           0 :   &                   lmaxc, lmaxcd, nindxc,&
     431           0 :   &                   core1, core2, bas1, bas2, cmt, dimension,&
     432             :   &                   gridf)
     433             : 
     434             :       USE m_util, ONLY: intgrf, intgrf_init, chr
     435             :       USE m_types
     436             :       IMPLICIT NONE
     437             :       TYPE(t_dimension), INTENT(IN)   :: dimension
     438             :       TYPE(t_hybrid), INTENT(IN)   :: hybrid
     439             :       TYPE(t_kpts), INTENT(IN)   :: kpts
     440             :       TYPE(t_atoms), INTENT(IN)   :: atoms
     441             : 
     442             : !     - scalars -
     443             :       INTEGER, INTENT(IN)    :: maxlcutc, maxindxc, lmaxcd
     444             : 
     445             : !     - arrays -
     446             :       INTEGER, INTENT(IN)    ::  lmaxc(atoms%ntype)
     447             :       INTEGER, INTENT(IN)    ::  nindxc(0:maxlcutc, atoms%ntype)
     448             :       REAL, INTENT(IN)       ::  core1(atoms%jmtd, 0:lmaxcd, maxindxc, atoms%ntype),&
     449             :      &                          core2(atoms%jmtd, 0:lmaxcd, maxindxc, atoms%ntype)
     450             :       REAL, INTENT(IN)       ::  bas1(atoms%jmtd, hybrid%maxindx, 0:atoms%lmaxd, atoms%ntype),&
     451             :      &                          bas2(atoms%jmtd, hybrid%maxindx, 0:atoms%lmaxd, atoms%ntype)
     452             :       COMPLEX, INTENT(IN)    ::  cmt(dimension%neigd, kpts%nkpt, hybrid%maxlmindx, atoms%nat)
     453             : 
     454             : !     - local scalars -
     455             :       INTEGER               :: itype, icent, l, m, lm, i, j
     456             : 
     457             : !     - local arrays -
     458           0 :       INTEGER, ALLOCATABLE   :: olapcv_loc(:, :, :, :, :)
     459             :       REAL, ALLOCATABLE      :: gridf(:, :)
     460           0 :       REAL, ALLOCATABLE      :: olapcb(:)
     461           0 :       REAL, ALLOCATABLE      :: olapcv_avg(:, :, :, :), olapcv_max(:, :, :, :)
     462           0 :       COMPLEX, ALLOCATABLE   :: olapcv(:, :)
     463             :       CHARACTER, PARAMETER  :: lchar(0:38) =&
     464             :      &          (/'s', 'p', 'd', 'f', 'g', 'h', 'i', 'j', 'k', 'l', 'm', 'n', 'o',&
     465             :      &            'x', 'x', 'x', 'x', 'x', 'x', 'x', 'x', 'x', 'x', 'x', 'x', 'x',&
     466             :      &            'x', 'x', 'x', 'x', 'x', 'x', 'x', 'x', 'x', 'x', 'x', 'x', 'x'/)
     467             : 
     468             : !      CALL intgrf_init(ntype,jmtd,jri,dx,rmsh,gridf)
     469           0 :       WRITE (6, '(/A)') 'Overlap <core|basis>'
     470             :       ALLOCATE (olapcb(hybrid%maxindx), olapcv(dimension%neigd, kpts%nkpt),&
     471             :      &     olapcv_avg(-maxlcutc:maxlcutc, maxindxc, 0:maxlcutc, atoms%ntype),&
     472             :      &     olapcv_max(-maxlcutc:maxlcutc, maxindxc, 0:maxlcutc, atoms%ntype),&
     473           0 :      &     olapcv_loc(2, -maxlcutc:maxlcutc, maxindxc, 0:maxlcutc, atoms%ntype))
     474             : 
     475           0 :       DO itype = 1, atoms%ntype
     476           0 :          IF (atoms%ntype > 1) WRITE (6, '(A,I3)') 'Atom type', itype
     477           0 :          DO l = 0, lmaxc(itype)
     478           0 :             IF (l > atoms%lmax(itype)) THEN
     479           0 :                WRITE (*, *) 'l greater then atoms%lmax(itype)'
     480           0 :                EXIT ! very improbable case
     481             :             END IF
     482             : !          WRITE(6,8001) (lchar(l),i=1,min(3,nindx(l,itype)))
     483           0 :             DO i = 1, nindxc(l, itype)
     484           0 :                WRITE (6, '(I1,A,2X)', advance='no') i + l, lchar(l)
     485           0 :                DO j = 1, hybrid%nindx(l, itype)
     486             :                   olapcb(j) = intgrf(core1(:, l, i, itype)*bas1(:, j, l, itype) +&
     487             :          &                            core2(:, l, i, itype)*bas2(:, j, l, itype),&
     488           0 :          &                            atoms%jri, atoms%jmtd, atoms%rmsh, atoms%dx, atoms%ntype, itype, gridf)
     489           0 :                   WRITE (6, '(F10.6)', advance='no') olapcb(j)
     490             :                ENDDO
     491             : 
     492           0 :                lm = sum((/(hybrid%nindx(j, itype)*(2*j + 1), j=0, l - 1)/))
     493           0 :                icent = sum(atoms%neq(1:itype - 1)) + 1 ! take first of group of equivalent atoms
     494           0 :                DO M = -l, l
     495           0 :                   olapcv = 0
     496           0 :                   DO j = 1, hybrid%nindx(l, itype)
     497           0 :                      lm = lm + 1
     498           0 :                      olapcv(:, :) = olapcv(:, :) + olapcb(j)*cmt(:, :, lm, icent)
     499             :                   END DO
     500             :                   olapcv_avg(M, i, l, itype) = sqrt(sum(abs(olapcv(:, :))**2)&
     501           0 :          &                                          /kpts%nkpt/dimension%neigd)
     502           0 :                   olapcv_max(M, i, l, itype) = maxval(abs(olapcv(:, :)))
     503           0 :                   olapcv_loc(:, M, i, l, itype) = maxloc(abs(olapcv(:, :)))
     504             :                END DO
     505           0 :                WRITE (6, *)
     506             : 
     507             :             END DO
     508             :          END DO
     509             :       END DO
     510             : 
     511           0 :       WRITE (6, '(/A)') 'Average overlap <core|val>'
     512             : 
     513           0 :       DO itype = 1, atoms%ntype
     514           0 :          IF (atoms%ntype > 1) write (6, '(A,I3)') 'Atom type', itype
     515           0 :          DO l = 0, lmaxc(itype)
     516           0 :             DO i = 1, nindxc(l, itype)
     517           0 :                WRITE (6, '(I1,A,2X)', advance='no') i + l, lchar(l)
     518           0 :                WRITE (6, '('//chr(2*l + 1)//'F10.6)') olapcv_avg(-l:l, i, l, itype)
     519             :             END DO
     520             :          END DO
     521             :       END DO
     522             : 
     523           0 :       WRITE (6, '(/A)') 'Maximum overlap <core|val> at (band/kpoint)'
     524           0 :       DO itype = 1, atoms%ntype
     525           0 :          IF (atoms%ntype > 1) write (6, '(A,I3)') 'Atom type', itype
     526           0 :          DO l = 0, lmaxc(itype)
     527           0 :             DO i = 1, nindxc(l, itype)
     528           0 :                WRITE (6, '(I1,A,2X)', advance='no') i + l, lchar(l)
     529             :                WRITE (6, '('//chr(2*l + 1)//&
     530             :         &               '(F10.6,'' ('',I3.3,''/'',I4.3,'')''))')&
     531           0 :         &                      (olapcv_max(M, i, l, itype),&
     532           0 :         &                      olapcv_loc(:, M, i, l, itype), M=-l, l)
     533             :             END DO
     534             :          END DO
     535             :       END DO
     536             : 
     537           0 :       DEALLOCATE (olapcb, olapcv, olapcv_avg, olapcv_max, olapcv_loc)
     538             : 
     539           0 :    END SUBROUTINE olap_cv
     540             : 
     541             : END MODULE m_olap

Generated by: LCOV version 1.13