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

          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_hf_setup
       8             : 
       9             : CONTAINS
      10             : 
      11           0 :    SUBROUTINE hf_setup(hybrid, input, sym, kpts, DIMENSION, atoms, mpi, noco, cell, oneD, results, jsp, enpara, eig_id_hf, &
      12           0 :                        hybdat, it, l_real, vr0, eig_irr)
      13             :       USE m_types
      14             :       USE m_eig66_io
      15             :       USE m_util
      16             :       USE m_checkolap
      17             :       USE m_read_core
      18             :       USE m_gen_wavf
      19             : 
      20             :       IMPLICIT NONE
      21             : 
      22             :       TYPE(t_hybrid), INTENT(INOUT) :: hybrid
      23             :       TYPE(t_kpts), INTENT(IN)    :: kpts
      24             :       TYPE(t_dimension), INTENT(IN)    :: dimension
      25             :       TYPE(t_atoms), INTENT(IN)    :: atoms
      26             :       TYPE(t_mpi), INTENT(IN)    :: mpi
      27             :       TYPE(t_noco), INTENT(IN)    :: noco
      28             :       TYPE(t_cell), INTENT(IN)    :: cell
      29             :       TYPE(t_oneD), INTENT(IN)    :: oneD
      30             :       TYPE(t_input), INTENT(IN)    :: input
      31             :       TYPE(t_sym), INTENT(IN)    :: sym
      32             :       TYPE(t_enpara), INTENT(IN)    :: enpara
      33             :       TYPE(t_results), INTENT(INOUT) :: results
      34             :       TYPE(t_hybdat), INTENT(INOUT) :: hybdat
      35             : 
      36             :       INTEGER, INTENT(IN)    :: it
      37             :       INTEGER, INTENT(IN)    :: jsp, eig_id_hf
      38             :       REAL, INTENT(IN)    :: vr0(:, :, :)
      39             :       LOGICAL, INTENT(IN)    :: l_real
      40             : 
      41             :       REAL, ALLOCATABLE, INTENT(OUT)   :: eig_irr(:, :)
      42             : 
      43             :       ! local type variables
      44           0 :       TYPE(t_lapw)             :: lapw
      45           0 :       TYPE(t_mat), ALLOCATABLE :: zmat(:)
      46             : 
      47             :       ! local scalars
      48             :       INTEGER :: ok, nk, nrec1, i, j, ll, l1, l2, ng, itype, n, l, n1, n2, nn
      49             :       INTEGER :: nbasfcn
      50             : 
      51             :       ! local arrays
      52             : 
      53           0 :       REAL, ALLOCATABLE :: basprod(:)
      54           0 :       INTEGER              :: degenerat(DIMENSION%neigd2 + 1, kpts%nkpt)
      55           0 :       LOGICAL              :: skip_kpt(kpts%nkpt)
      56             :       INTEGER              :: g(3)
      57             : 
      58           0 :       skip_kpt = .FALSE.
      59             : 
      60           0 :       IF (hybrid%l_calhf) THEN
      61             :          ! Preparations for HF and hybrid functional calculation
      62           0 :          CALL timestart("gen_bz and gen_wavf")
      63             : 
      64           0 :          ALLOCATE (zmat(kpts%nkptf), stat=ok)
      65           0 :          IF (ok /= 0) STOP 'eigen_hf: failure allocation z_c'
      66           0 :          ALLOCATE (eig_irr(DIMENSION%neigd2, kpts%nkpt), stat=ok)
      67           0 :          IF (ok /= 0) STOP 'eigen_hf: failure allocation eig_irr'
      68           0 :          ALLOCATE (hybdat%kveclo_eig(atoms%nlotot, kpts%nkpt), stat=ok)
      69           0 :          IF (ok /= 0) STOP 'eigen_hf: failure allocation hybdat%kveclo_eig'
      70           0 :          eig_irr = 0
      71           0 :          hybdat%kveclo_eig = 0
      72             : 
      73             :          ! Reading the eig file
      74           0 :          DO nk = 1, kpts%nkpt
      75           0 :             nrec1 = kpts%nkpt*(jsp - 1) + nk
      76           0 :             CALL lapw%init(input, noco, kpts, atoms, sym, nk, cell, sym%zrfs)
      77           0 :             nbasfcn = MERGE(lapw%nv(1) + lapw%nv(2) + 2*atoms%nlotot, lapw%nv(1) + atoms%nlotot, noco%l_noco)
      78           0 :             CALL zMat(nk)%init(l_real, nbasfcn, dimension%neigd2)
      79           0 :             CALL read_eig(eig_id_hf, nk, jsp, zmat=zMat(nk))
      80           0 :             eig_irr(:, nk) = results%eig(:, nk, jsp)
      81           0 :             hybrid%ne_eig(nk) = results%neig(nk, jsp)
      82             :          END DO
      83             :          !Allocate further space
      84           0 :          DO nk = kpts%nkpt + 1, kpts%nkptf
      85           0 :             nbasfcn = zMat(kpts%bkp(nk))%matsize1
      86           0 :             CALL zMat(nk)%init(l_real, nbasfcn, dimension%neigd2)
      87             :          END DO
      88             : 
      89             :          !determine degenerate states at each k-point
      90             :          !
      91             :          ! degenerat(i) =1  band i  is not degenerat ,
      92             :          ! degenerat(i) =j  band i  has j-1 degenart states ( i, i+1, ..., i+j)
      93             :          ! degenerat(i) =0  band i  is  degenerat, but is not the lowest band
      94             :          !                  of the group of degenerate states
      95           0 :          IF (mpi%irank == 0) THEN
      96           0 :             WRITE (6, *)
      97           0 :             WRITE (6, '(A)') "   k-point      |   number of occupied bands  |   maximal number of bands"
      98             :          END IF
      99           0 :          degenerat = 1
     100           0 :          hybrid%nobd = 0
     101           0 :          DO nk = 1, kpts%nkpt
     102           0 :             DO i = 1, hybrid%ne_eig(nk)
     103           0 :                DO j = i + 1, hybrid%ne_eig(nk)
     104           0 :                   IF (ABS(results%eig(i, nk, jsp) - results%eig(j, nk, jsp)) < 1E-07) THEN !0.015
     105           0 :                      degenerat(i, nk) = degenerat(i, nk) + 1
     106             :                   END IF
     107             :                END DO
     108             :             END DO
     109             : 
     110           0 :             DO i = 1, hybrid%ne_eig(nk)
     111           0 :                IF ((degenerat(i, nk) /= 1) .OR. (degenerat(i, nk) /= 0)) degenerat(i + 1:i + degenerat(i, nk) - 1, nk) = 0
     112             :             END DO
     113             : 
     114             :             ! set the size of the exchange matrix in the space of the wavefunctions
     115             : 
     116           0 :             hybrid%nbands(nk) = hybrid%bands1
     117           0 :             IF (hybrid%nbands(nk) > hybrid%ne_eig(nk)) THEN
     118           0 :                IF (mpi%irank == 0) THEN
     119           0 :                   WRITE (*, *) ' maximum for hybrid%nbands is', hybrid%ne_eig(nk)
     120           0 :                   WRITE (*, *) ' increase energy window to obtain enough eigenvalues'
     121           0 :                   WRITE (*, *) ' set hybrid%nbands equal to hybrid%ne_eig'
     122             :                END IF
     123           0 :                hybrid%nbands(nk) = hybrid%ne_eig(nk)
     124             :             END IF
     125             : 
     126           0 :             DO i = hybrid%nbands(nk) - 1, 1, -1
     127           0 :                IF ((degenerat(i, nk) >= 1) .AND. (degenerat(i, nk) + i - 1 /= hybrid%nbands(nk))) THEN
     128           0 :                   hybrid%nbands(nk) = i + degenerat(i, nk) - 1
     129           0 :                   EXIT
     130             :                END IF
     131             :             END DO
     132             : 
     133           0 :             DO i = 1, hybrid%ne_eig(nk)
     134           0 :                IF (results%w_iks(i, nk, jsp) > 0.0) hybrid%nobd(nk) = hybrid%nobd(nk) + 1
     135             :             END DO
     136             : 
     137           0 :             IF (hybrid%nobd(nk) > hybrid%nbands(nk)) THEN
     138           0 :                WRITE (*, *) 'k-point: ', nk
     139           0 :                WRITE (*, *) 'number of bands:          ', hybrid%nbands(nk)
     140           0 :                WRITE (*, *) 'number of occupied bands: ', hybrid%nobd(nk)
     141           0 :                CALL judft_warn("More occupied bands than total no of bands!?")
     142           0 :                hybrid%nbands(nk) = hybrid%nobd(nk)
     143             :             END IF
     144           0 :             PRINT *, "bands:", nk, hybrid%nobd(nk), hybrid%nbands(nk), hybrid%ne_eig(nk)
     145             :          END DO
     146             : 
     147             :          ! spread hybrid%nobd from IBZ to whole BZ
     148           0 :          DO nk = 1, kpts%nkptf
     149           0 :             i = kpts%bkp(nk)
     150           0 :             hybrid%nobd(nk) = hybrid%nobd(i)
     151             :          END DO
     152             : 
     153             :          ! generate eigenvectors z and MT coefficients from the previous iteration at all k-points
     154             :          CALL gen_wavf(kpts%nkpt, kpts, it, sym, atoms, enpara%el0(:, :, jsp), enpara%ello0(:, :, jsp), cell, dimension, &
     155           0 :                        hybrid, vr0, hybdat, noco, oneD, mpi, input, jsp, zmat)
     156             : 
     157             :          ! generate core wave functions (-> core1/2(jmtd,hybdat%nindxc,0:lmaxc,ntype) )
     158             :          CALL corewf(atoms, jsp, input, DIMENSION, vr0, hybdat%lmaxcd, hybdat%maxindxc, mpi, &
     159           0 :                      hybdat%lmaxc, hybdat%nindxc, hybdat%core1, hybdat%core2, hybdat%eig_c)
     160             : 
     161             :          ! check olap between core-basis/core-valence/basis-basis
     162             :          CALL checkolap(atoms, hybdat, hybrid, kpts%nkpt, kpts, dimension, mpi, skip_kpt, &
     163           0 :                         input, sym, noco, cell, lapw, jsp)
     164             : 
     165             :          ! set up pointer pntgpt
     166             : 
     167             :          ! setup dimension of pntgpt
     168           0 :          ALLOCATE (hybdat%pntgptd(3))
     169           0 :          hybdat%pntgptd = 0
     170           0 :          DO nk = 1, kpts%nkptf
     171           0 :             CALL lapw%init(input, noco, kpts, atoms, sym, nk, cell, sym%zrfs)
     172           0 :             hybdat%pntgptd(1) = MAXVAL((/(ABS(lapw%k1(i, jsp)), i=1, lapw%nv(jsp)), hybdat%pntgptd(1)/))
     173           0 :             hybdat%pntgptd(2) = MAXVAL((/(ABS(lapw%k2(i, jsp)), i=1, lapw%nv(jsp)), hybdat%pntgptd(2)/))
     174           0 :             hybdat%pntgptd(3) = MAXVAL((/(ABS(lapw%k3(i, jsp)), i=1, lapw%nv(jsp)), hybdat%pntgptd(3)/))
     175             :          END DO
     176             : 
     177             :          ALLOCATE (hybdat%pntgpt(-hybdat%pntgptd(1):hybdat%pntgptd(1), -hybdat%pntgptd(2):hybdat%pntgptd(2), &
     178           0 :                                  -hybdat%pntgptd(3):hybdat%pntgptd(3), kpts%nkptf), stat=ok)
     179           0 :          IF (ok /= 0) STOP 'eigen_hf: failure allocation pntgpt'
     180           0 :          hybdat%pntgpt = 0
     181           0 :          DO nk = 1, kpts%nkptf
     182           0 :             CALL lapw%init(input, noco, kpts, atoms, sym, nk, cell, sym%zrfs)
     183           0 :             DO i = 1, lapw%nv(jsp)
     184           0 :                g = (/lapw%k1(i, jsp), lapw%k2(i, jsp), lapw%k3(i, jsp)/)
     185           0 :                hybdat%pntgpt(g(1), g(2), g(3), nk) = i
     186             :             END DO
     187             :          END DO
     188             : 
     189           0 :          ALLOCATE (basprod(atoms%jmtd), stat=ok)
     190           0 :          IF (ok /= 0) STOP 'eigen_hf: failure allocation basprod'
     191           0 :          ALLOCATE (hybdat%prodm(hybrid%maxindxm1, hybrid%maxindxp1, 0:hybrid%maxlcutm1, atoms%ntype), stat=ok)
     192           0 :          IF (ok /= 0) STOP 'eigen_hf: failure allocation hybdat%prodm'
     193           0 :          ALLOCATE (hybdat%prod(hybrid%maxindxp1, 0:hybrid%maxlcutm1, atoms%ntype), stat=ok)
     194           0 :          IF (ok /= 0) STOP 'eigen_hf: failure allocation hybdat%prod'
     195           0 :          basprod = 0; hybdat%prodm = 0; hybdat%prod%l1 = 0; hybdat%prod%l2 = 0
     196           0 :          hybdat%prod%n1 = 0; hybdat%prod%n2 = 0
     197           0 :          ALLOCATE (hybdat%nindxp1(0:hybrid%maxlcutm1, atoms%ntype))
     198           0 :          hybdat%nindxp1 = 0
     199           0 :          DO itype = 1, atoms%ntype
     200           0 :             ng = atoms%jri(itype)
     201           0 :             DO l2 = 0, MIN(atoms%lmax(itype), hybrid%lcutwf(itype))
     202             :                ll = l2
     203           0 :                DO l1 = 0, ll
     204           0 :                   IF (ABS(l1 - l2) <= hybrid%lcutm1(itype)) THEN
     205           0 :                      DO n2 = 1, hybrid%nindx(l2, itype)
     206           0 :                         nn = hybrid%nindx(l1, itype)
     207           0 :                         IF (l1 == l2) nn = n2
     208           0 :                         DO n1 = 1, nn
     209             :                            ! Calculate all basis-function hybdat%products to obtain
     210             :                            ! the overlaps with the hybdat%product-basis functions (hybdat%prodm)
     211             :                            basprod(:ng) = (hybdat%bas1(:ng, n1, l1, itype)*hybdat%bas1(:ng, n2, l2, itype) + &
     212           0 :                                            hybdat%bas2(:ng, n1, l1, itype)*hybdat%bas2(:ng, n2, l2, itype))/atoms%rmsh(:ng, itype)
     213           0 :                            DO l = ABS(l1 - l2), MIN(hybrid%lcutm1(itype), l1 + l2)
     214           0 :                               IF (MOD(l1 + l2 + l, 2) == 0) THEN
     215           0 :                                  hybdat%nindxp1(l, itype) = hybdat%nindxp1(l, itype) + 1
     216           0 :                                  n = hybdat%nindxp1(l, itype)
     217           0 :                                  hybdat%prod(n, l, itype)%l1 = l1
     218           0 :                                  hybdat%prod(n, l, itype)%l2 = l2
     219           0 :                                  hybdat%prod(n, l, itype)%n1 = n1
     220           0 :                                  hybdat%prod(n, l, itype)%n2 = n2
     221           0 :                                  DO i = 1, hybrid%nindxm1(l, itype)
     222             :                                     hybdat%prodm(i, n, l, itype) = intgrf(basprod(:ng)*hybrid%basm1(:ng, i, l, itype), atoms%jri, &
     223           0 :                                                                           atoms%jmtd, atoms%rmsh, atoms%dx, atoms%ntype, itype, hybdat%gridf)
     224             :                                  END DO
     225             :                               END IF
     226             :                            END DO
     227             :                         END DO
     228             :                      END DO
     229             :                   END IF
     230             :                END DO
     231             :             END DO
     232             :          END DO
     233           0 :          DEALLOCATE (basprod)
     234           0 :          CALL timestop("gen_bz and gen_wavf")
     235             : 
     236           0 :       ELSE IF (hybrid%l_hybrid) THEN ! hybrid%l_calhf is false
     237             : 
     238             :          !DO nk = n_start,kpts%nkpt,n_stride
     239           0 :          DO nk = 1, kpts%nkpt, 1
     240           0 :             hybrid%ne_eig(nk) = results%neig(nk, jsp)
     241           0 :             hybrid%nobd(nk) = COUNT(results%w_iks(:hybrid%ne_eig(nk), nk, jsp) > 0.0)
     242             :          END DO
     243             : 
     244           0 :          hybrid%maxlmindx = MAXVAL((/(SUM((/(hybrid%nindx(l, itype)*(2*l + 1), l=0, atoms%lmax(itype))/)), itype=1, atoms%ntype)/))
     245           0 :          hybrid%nbands = MIN(hybrid%bands1, DIMENSION%neigd)
     246             : 
     247             :       ENDIF ! hybrid%l_calhf
     248             : 
     249           0 :    END SUBROUTINE hf_setup
     250             : 
     251             : END MODULE m_hf_setup

Generated by: LCOV version 1.13