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

          Line data    Source code
       1             :       MODULE m_checkolap
       2             : 
       3             :       CONTAINS
       4             : 
       5           0 :          SUBROUTINE checkolap(atoms, hybdat,&
       6             :         &                  hybrid,&
       7             :         &                  nkpti, kpts,&
       8             :         &                  dimension, mpi, skip_kpt,&
       9             :         &                  input, sym, noco,&
      10             :         &                  cell, lapw, jsp)
      11             :             USE m_util, ONLY: intgrf, intgrf_init, chr, sphbessel, harmonicsr
      12             :             USE m_constants
      13             :             USE m_types
      14             :             USE m_io_hybrid
      15             :             IMPLICIT NONE
      16             : 
      17             :             TYPE(t_hybdat), INTENT(IN)   :: hybdat
      18             : 
      19             :             TYPE(t_mpi), INTENT(IN)         :: mpi
      20             :             TYPE(t_dimension), INTENT(IN)   :: dimension
      21             :             TYPE(t_hybrid), INTENT(IN)      :: hybrid
      22             :             TYPE(t_input), INTENT(IN)       :: input
      23             :             TYPE(t_noco), INTENT(IN)        :: noco
      24             :             TYPE(t_sym), INTENT(IN)         :: sym
      25             :             TYPE(t_cell), INTENT(IN)        :: cell
      26             :             TYPE(t_kpts), INTENT(IN)        :: kpts
      27             :             TYPE(t_atoms), INTENT(IN)       :: atoms
      28             :             TYPE(t_lapw), INTENT(INOUT)     :: lapw
      29             : 
      30             :             ! - scalars -
      31             :             INTEGER, INTENT(IN)     :: jsp
      32             :             INTEGER, INTENT(IN)     ::  nkpti
      33             : 
      34             :             ! - arrays -
      35             :             LOGICAL, INTENT(IN)     ::  skip_kpt(nkpti)
      36             : 
      37             :             ! - local scalars -
      38             :             INTEGER                 ::  i, itype, iatom, ikpt, ineq, igpt, iband
      39             :             INTEGER                 ::  irecl_cmt
      40             :             INTEGER                 ::  j, m
      41             :             INTEGER                 ::  l
      42             :             INTEGER                 :: lm, lm1
      43             :             INTEGER                 ::  n, nred, nbasfcn
      44             : 
      45             :             REAL                    ::  rdum, rdum1
      46             :             REAL                    ::  qnorm
      47             : 
      48             :             COMPLEX                 ::  cexp, cdum
      49             :             COMPLEX, PARAMETER     ::  img = (0.0, 1.0)
      50             : 
      51             :             ! -local arrays -
      52             :             INTEGER                 ::  iarr(2), gpt(3)
      53           0 :             INTEGER, ALLOCATABLE   ::  olapcv_loc(:, :, :, :, :)
      54             : 
      55           0 :             REAL                    ::  sphbes(0:atoms%lmaxd)
      56             :             REAL                    ::  q(3)
      57           0 :             REAL                    ::  integrand(atoms%jmtd)
      58             :             REAL                    ::  bkpt(3)
      59           0 :             REAL                    ::  rarr(maxval(hybrid%nbands))
      60             :             REAL                    ::  rtaual(3)
      61           0 :             REAL, ALLOCATABLE   ::  olapcb(:)
      62           0 :             REAL, ALLOCATABLE   :: olapcv_avg(:, :, :, :), olapcv_max(:, :, :, :)
      63           0 :             TYPE(t_mat), ALLOCATABLE :: z(:)
      64             : 
      65           0 :             COMPLEX                 ::  cmt(dimension%neigd, hybrid%maxlmindx, atoms%nat, nkpti)
      66           0 :             COMPLEX                 ::  y((atoms%lmaxd + 1)**2)
      67           0 :             COMPLEX, ALLOCATABLE   ::  olapcv(:, :), olapww(:, :)
      68           0 :             COMPLEX, ALLOCATABLE   ::  carr1(:, :), carr2(:, :), carr3(:, :)
      69             : 
      70             :             CHARACTER, PARAMETER    ::  lchar(0:38) =&
      71             :            &          (/'s', 'p', 'd', 'f', 'g', 'h', 'i', 'j', 'k', 'l', 'm', 'n', 'o',&
      72             :            &            'x', 'x', 'x', 'x', 'x', 'x', 'x', 'x', 'x', 'x', 'x', 'x', 'x',&
      73             :            &            'x', 'x', 'x', 'x', 'x', 'x', 'x', 'x', 'x', 'x', 'x', 'x', 'x'/)
      74             :             LOGICAL                 ::  l_mism = .true.
      75             : 
      76           0 :             ALLOCATE (z(nkpti))
      77           0 :             DO ikpt = 1, nkpti
      78           0 :                CALL lapw%init(input, noco, kpts, atoms, sym, ikpt, cell, sym%zrfs)
      79           0 :                nbasfcn = MERGE(lapw%nv(1) + lapw%nv(2) + 2*atoms%nlotot, lapw%nv(1) + atoms%nlotot, noco%l_noco)
      80           0 :                call z(ikpt)%alloc(sym%invs, nbasfcn, dimension%neigd)
      81             :             ENDDO
      82             : 
      83           0 :             IF (mpi%irank == 0) WRITE (6, '(//A)') '### checkolap ###'
      84             : 
      85           0 :             cmt = 0
      86             : 
      87             :             ! initialize gridf -> was done in eigen_HF_init
      88             :             !CALL intgrf_init(atoms%ntype,atoms%jmtd,atoms%jri,atoms%dx,atoms%rmsh,hybdat%gridf)
      89             : 
      90             :             ! read in cmt
      91           0 :             DO ikpt = 1, nkpti
      92           0 :                call read_cmt(cmt(:, :, :, ikpt), ikpt)
      93             :             END DO
      94             : 
      95           0 :             IF (mpi%irank == 0) WRITE (6, '(/A)') ' Overlap <core|core>'
      96           0 :             DO itype = 1, atoms%ntype
      97           0 :                IF (atoms%ntype > 1 .AND. mpi%irank == 0) &
      98           0 :             &     WRITE (6, '(A,I3)') ' Atom type', itype
      99           0 :                DO l = 0, hybdat%lmaxc(itype)
     100           0 :                   DO i = 1, hybdat%nindxc(l, itype)
     101           0 :                      IF (mpi%irank == 0)&
     102           0 :               &        WRITE (6, '(1x,I1,A,2X)', advance='no') i + l, lchar(l)
     103           0 :                      DO j = 1, i
     104             :                         integrand = hybdat%core1(:, i, l, itype)*hybdat%core1(:, j, l, itype)&
     105           0 :                &                  + hybdat%core2(:, i, l, itype)*hybdat%core2(:, j, l, itype)
     106           0 :                         IF (mpi%irank == 0) WRITE (6, '(F10.6)', advance='no')&
     107           0 :                &           intgrf(integrand, atoms%jri, atoms%jmtd, atoms%rmsh, atoms%dx, atoms%ntype, itype, hybdat%gridf)
     108             :                      END DO
     109           0 :                      IF (mpi%irank == 0) WRITE (6, *)
     110             :                   END DO
     111             :                END DO
     112             :             END DO
     113             : 
     114           0 :             IF (mpi%irank == 0) WRITE (6, '(/A)') ' Overlap <core|basis>'
     115             :             ALLOCATE (olapcb(hybrid%maxindx), olapcv(maxval(hybrid%nbands), nkpti),&
     116             :            &          olapcv_avg(-hybdat%lmaxcd:hybdat%lmaxcd, hybdat%maxindxc, 0:hybdat%lmaxcd, atoms%ntype),&
     117             :            &          olapcv_max(-hybdat%lmaxcd:hybdat%lmaxcd, hybdat%maxindxc, 0:hybdat%lmaxcd, atoms%ntype),&
     118           0 :            &          olapcv_loc(2, -hybdat%lmaxcd:hybdat%lmaxcd, hybdat%maxindxc, 0:hybdat%lmaxcd, atoms%ntype))
     119             : 
     120           0 :             DO itype = 1, atoms%ntype
     121           0 :                IF (atoms%ntype > 1 .AND. mpi%irank == 0) &
     122           0 :             &     WRITE (6, '(A,I3)') ' Atom type', itype
     123           0 :                DO l = 0, hybdat%lmaxc(itype)
     124           0 :                   IF (l > atoms%lmax(itype)) EXIT ! very improbable case
     125           0 :                   IF (mpi%irank == 0) &
     126             :              &        WRITE (6, "(9X,'u(',A,')',4X,'udot(',A,')',:,3X,'ulo(',A,"//&
     127           0 :              &                "') ...')") (lchar(l), i=1, min(3, hybrid%nindx(l, itype)))
     128           0 :                   DO i = 1, hybdat%nindxc(l, itype)
     129           0 :                      IF (mpi%irank == 0)&
     130           0 :               &        WRITE (6, '(1x,I1,A,2X)', advance='no') i + l, lchar(l)
     131           0 :                      DO j = 1, hybrid%nindx(l, itype)
     132             : 
     133             :                         integrand = hybdat%core1(:, i, l, itype)*hybdat%bas1(:, j, l, itype)&
     134           0 :                &                  + hybdat%core2(:, i, l, itype)*hybdat%bas2(:, j, l, itype)
     135             : 
     136             :                         olapcb(j) = &
     137           0 :                &              intgrf(integrand, atoms%jri, atoms%jmtd, atoms%rmsh, atoms%dx, atoms%ntype, itype, hybdat%gridf)
     138             : 
     139           0 :                         IF (mpi%irank == 0)&
     140           0 :                &          WRITE (6, '(F10.6)', advance='no') olapcb(j)
     141             :                      END DO
     142             : 
     143           0 :                      lm = sum((/(hybrid%nindx(j, itype)*(2*j + 1), j=0, l - 1)/))
     144           0 :                      iatom = sum(atoms%neq(1:itype - 1)) + 1 ! take first of group of equivalent atoms
     145           0 :                      DO m = -l, l
     146           0 :                         olapcv = 0
     147           0 :                         DO j = 1, hybrid%nindx(l, itype)
     148           0 :                            lm = lm + 1
     149             :                            olapcv(:, :) = olapcv(:, :) + &
     150           0 :                 &                        olapcb(j)*cmt(:maxval(hybrid%nbands), lm, iatom, :nkpti)
     151             :                         END DO
     152           0 :                         rdum = sum(abs(olapcv(:, :))**2)
     153           0 :                         rdum1 = maxval(abs(olapcv(:, :)))
     154           0 :                         iarr = maxloc(abs(olapcv(:, :)))
     155             :                         olapcv_avg(m, i, l, itype) = &
     156           0 :                &                sqrt(rdum/nkpti/sum(hybrid%nbands(:nkpti))*nkpti)
     157           0 :                         olapcv_max(m, i, l, itype) = rdum1
     158           0 :                         olapcv_loc(:, m, i, l, itype) = iarr
     159             :                      END DO
     160           0 :                      IF (mpi%irank == 0) WRITE (6, *)
     161             : 
     162             :                   END DO
     163             :                END DO
     164             :             END DO
     165             : 
     166           0 :             IF (mpi%irank == 0) THEN
     167           0 :                WRITE (6, '(/A)') ' Average overlap <core|val>'
     168           0 :                DO itype = 1, atoms%ntype
     169           0 :                   IF (atoms%ntype > 1) write (6, '(A,I3)') ' Atom type', itype
     170           0 :                   DO l = 0, hybdat%lmaxc(itype)
     171           0 :                      DO i = 1, hybdat%nindxc(l, itype)
     172           0 :                         WRITE (6, '(1x,I1,A,2X)', advance='no') i + l, lchar(l)
     173             :                         WRITE (6, '('//chr(2*l + 1)//'F10.6)') &
     174           0 :                &                                        olapcv_avg(-l:l, i, l, itype)
     175             :                      END DO
     176             :                   END DO
     177             :                END DO
     178             : 
     179           0 :                WRITE (6, '(/A)') ' Maximum overlap <core|val> at (band/kpoint)'
     180           0 :                DO itype = 1, atoms%ntype
     181           0 :                   IF (atoms%ntype > 1) write (6, '(A,I3)') ' Atom type', itype
     182           0 :                   DO l = 0, hybdat%lmaxc(itype)
     183           0 :                      DO i = 1, hybdat%nindxc(l, itype)
     184           0 :                         WRITE (6, '(1x,I1,A,2X)', advance='no') i + l, lchar(l)
     185             :                         WRITE (6, '('//chr(2*l + 1)//&
     186             :                &                 '(F10.6,'' ('',I3.3,''/'',I4.3,'')''))')&
     187           0 :                &                          (olapcv_max(m, i, l, itype),&
     188           0 :                &                           olapcv_loc(:, m, i, l, itype), m=-l, l)
     189             :                      END DO
     190             :                   END DO
     191             :                END DO
     192             :             END IF ! mpi%irank == 0
     193             : 
     194           0 :             DEALLOCATE (olapcb, olapcv, olapcv_avg, olapcv_max, olapcv_loc)
     195             : 
     196           0 :             IF (mpi%irank == 0) WRITE (6, '(/A)') ' Overlap <basis|basis>'
     197             : 
     198           0 :             DO itype = 1, atoms%ntype
     199           0 :                IF (atoms%ntype > 1 .AND. mpi%irank == 0) &
     200           0 :             &     WRITE (6, '(A,I3)') ' Atom type', itype
     201           0 :                DO l = 0, atoms%lmax(itype)
     202           0 :                   DO i = 1, hybrid%nindx(l, itype)
     203           0 :                      IF (mpi%irank == 0) THEN
     204           0 :                         SELECT CASE (i)
     205             :                         CASE (1)
     206           0 :                            WRITE (6, '(1x,''   u('',A,'')'')', advance='no') lchar(l)
     207             :                         CASE (2)
     208           0 :                            WRITE (6, '(1x,''udot('',A,'')'')', advance='no') lchar(l)
     209             :                         CASE DEFAULT
     210           0 :                            WRITE (6, '(1x,'' ulo('',A,'')'')', advance='no') lchar(l)
     211             :                         END SELECT
     212             :                      END IF
     213           0 :                      DO j = 1, i
     214             :                         integrand = hybdat%bas1(:, i, l, itype)*hybdat%bas1(:, j, l, itype)&
     215           0 :                &                  + hybdat%bas2(:, i, l, itype)*hybdat%bas2(:, j, l, itype)
     216             : 
     217           0 :                         IF (mpi%irank == 0) WRITE (6, '(F10.6)', advance='no')&
     218           0 :                &              intgrf(integrand, atoms%jri, atoms%jmtd, atoms%rmsh, atoms%dx, atoms%ntype, itype, hybdat%gridf)
     219             :                      END DO
     220           0 :                      IF (mpi%irank == 0) WRITE (6, *)
     221             :                   END DO
     222             :                END DO
     223             :             END DO
     224             : 
     225           0 :             IF (.not. l_mism) RETURN
     226             : 
     227           0 :             IF (mpi%irank == 0) WRITE (6, '(/A)') &
     228           0 :            &          'Mismatch of wave functions at the MT-sphere boundaries'
     229           0 :             ALLOCATE (carr1(maxval(hybrid%nbands), (atoms%lmaxd + 1)**2))
     230           0 :             ALLOCATE (carr2(maxval(hybrid%nbands), (atoms%lmaxd + 1)**2))
     231           0 :             ALLOCATE (carr3(maxval(hybrid%nbands), (atoms%lmaxd + 1)**2))
     232           0 :             DO ikpt = 1, nkpti
     233           0 :                call read_z(z(ikpt), ikpt)
     234             :             END DO
     235             : 
     236           0 :             iatom = 0
     237           0 :             DO itype = 1, atoms%ntype
     238           0 :                DO ineq = 1, atoms%neq(itype)
     239           0 :                   iatom = iatom + 1
     240           0 :                   IF (mpi%irank == 0) THEN
     241           0 :                      if (atoms%nat > 1) WRITE (6, '(2X,A,I3)') 'Atom', iatom
     242           0 :                      WRITE (6, '(2X,A)') 'k-point    average      (   maximum    )'
     243             :                   END IF
     244             : 
     245           0 :                   DO ikpt = 1, nkpti
     246           0 :                      carr1 = 0; carr2 = 0; carr3 = 0
     247             : 
     248             :                      ! calculate k1,k2,k3
     249           0 :                      CALL lapw%init(input, noco, kpts, atoms, sym, ikpt, cell, sym%zrfs)
     250             : 
     251             :                      ! PW part
     252           0 :                      DO igpt = 1, lapw%nv(jsp)
     253           0 :                         gpt(1) = lapw%k1(igpt, jsp)
     254           0 :                         gpt(2) = lapw%k2(igpt, jsp)
     255           0 :                         gpt(3) = lapw%k3(igpt, jsp)
     256             : 
     257             :                         cexp = exp(img*2*pi_const* &
     258           0 :                &                   dot_product(kpts%bkf(:, ikpt) + gpt, atoms%taual(:, iatom)))
     259           0 :                         q = matmul(kpts%bkf(:, ikpt) + gpt, cell%bmat)
     260             : 
     261           0 :                         qnorm = sqrt(sum(q**2))
     262           0 :                         call sphbessel(sphbes, atoms%rmt(itype)*qnorm, atoms%lmax(itype))
     263           0 :                         call harmonicsr(y, q, atoms%lmax(itype))
     264           0 :                         y = conjg(y)
     265           0 :                         lm = 0
     266           0 :                         DO l = 0, atoms%lmax(itype)
     267           0 :                            cdum = 4*pi_const*img**l/sqrt(cell%omtil)*sphbes(l)*cexp
     268           0 :                            DO m = -l, l
     269           0 :                               lm = lm + 1
     270           0 :                               DO iband = 1, hybrid%nbands(ikpt)
     271           0 :                                  if (z(1)%l_real) THEN
     272           0 :                                     carr2(iband, lm) = carr2(iband, lm) + cdum*z(ikpt)%data_r(igpt, iband)*y(lm)
     273             :                                  Else
     274           0 :                                     carr2(iband, lm) = carr2(iband, lm) + cdum*z(ikpt)%data_c(igpt, iband)*y(lm)
     275             :                                  END if
     276             :                               end DO
     277             :                            END DO
     278             :                         END DO
     279             :                      END DO
     280             : 
     281             :                      ! MT
     282           0 :                      lm = 0
     283           0 :                      lm1 = 0
     284           0 :                      DO l = 0, atoms%lmax(itype)
     285           0 :                         DO m = -l, l
     286           0 :                            lm = lm + 1
     287           0 :                            DO n = 1, hybrid%nindx(l, itype)
     288           0 :                               lm1 = lm1 + 1
     289           0 :                               rdum = hybdat%bas1(atoms%jri(itype), n, l, itype)/atoms%rmt(itype)
     290           0 :                               DO iband = 1, hybrid%nbands(ikpt)
     291           0 :                                  carr3(iband, lm) = carr3(iband, lm) + cmt(iband, lm1, iatom, ikpt)*rdum
     292             :                               END DO
     293             :                            END DO
     294             :                         END DO
     295             :                      END DO
     296           0 :                      carr1 = carr2 - carr3
     297             : 
     298           0 :                      rarr = 0
     299           0 :                      lm = 0
     300           0 :                      DO l = 0, atoms%lmax(itype)
     301           0 :                         DO m = -l, l
     302           0 :                            lm = lm + 1
     303           0 :                            rarr = rarr + abs(carr1(:, lm))**2
     304             :                         END DO
     305             :                      END DO
     306           0 :                      rarr = sqrt(rarr/(4*pi_const))
     307             :                      !             WRITE(outtext,'(I6,4X,F14.12,''  ('',F14.12,'')'')') &
     308             :                      !    &              ikpt,sum(rarr(:1)**2/nbands(ikpt)),maxval(rarr(:1))
     309             :                      !             CALL writeout(outtext,mpi%irank)
     310             : !             IF( iatom .eq. 6 ) THEN
     311             : !               cdum = exp(2*pi*img*dot_product(bkf(:,ikpt),(/0.0,0.0,1.0/) ))
     312             : !               lm = 0
     313             : !               DO l = 0,lmax(itype)
     314             : !                 DO m = -l,l
     315             : !                   lm = lm + 1
     316             : !                   DO iband = 1,nbands(ikpt)
     317             : !                     WRITE(700+ikpt,'(3i4,6f15.10)') iband,l,m,carr2(iband,lm),carr3(iband,lm),
     318             : !      &                                              carr2(iband,lm)/(carr3(iband,lm))
     319             : !                   END DO
     320             : !                 END DO
     321             : !               END DO
     322             : !             END IF
     323             : 
     324             :                   END DO
     325             :                END DO
     326             :             END DO
     327             : 
     328           0 :          END SUBROUTINE checkolap
     329             : 
     330             :       END MODULE m_checkolap

Generated by: LCOV version 1.13