LCOV - code coverage report
Current view: top level - hybrid - hf_setup.F90 (source / functions) Hit Total Coverage
Test: FLEUR test coverage Lines: 48 51 94.1 %
Date: 2024-04-26 04:44:34 Functions: 1 1 100.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             : 
       8             : MODULE m_hf_setup
       9             : 
      10             : CONTAINS
      11             : 
      12          16 :    SUBROUTINE hf_setup(mpdata, fi, fmpi,nococonv, results, jsp, enpara, &
      13          16 :                        hybdat, vr0, eig_irr)
      14             :       USE m_types
      15             :       USE m_constants
      16             :       USE m_eig66_io
      17             :       USE m_util
      18             :       USE m_intgrf
      19             :       USE m_checkolap
      20             :       USE m_hybrid_core
      21             :       USE m_gen_wavf
      22             :       use m_types_hybdat
      23             : 
      24             :       IMPLICIT NONE
      25             : 
      26             :       type(t_fleurinput), intent(in)    :: fi
      27             :       TYPE(t_mpdata), INTENT(inout)   :: mpdata
      28             :       TYPE(t_mpi), INTENT(IN)    :: fmpi
      29             :       TYPE(t_nococonv), INTENT(IN)    :: nococonv
      30             :       TYPE(t_enpara), INTENT(IN)    :: enpara
      31             :       TYPE(t_results), INTENT(INOUT) :: results
      32             :       TYPE(t_hybdat), INTENT(INOUT) :: hybdat
      33             : 
      34             :       INTEGER, INTENT(IN)    :: jsp
      35             :       REAL, INTENT(IN)    :: vr0(:, :, :)
      36             : 
      37             :       REAL, ALLOCATABLE, INTENT(INOUT)   :: eig_irr(:, :)
      38             : 
      39             :       ! local type variables
      40          16 :       TYPE(t_lapw)             :: lapw
      41             : 
      42             :       ! local scalars
      43             :       INTEGER :: ok, nk, nrec1, i, j, l1, l2, ng, itype, n, l, n1, n2, nn
      44             :       INTEGER :: nbasfcn, n_dim
      45             : 
      46             :       ! local arrays
      47             : 
      48          16 :       REAL, ALLOCATABLE :: basprod(:)
      49             :       INTEGER           :: degenerat(merge(fi%input%neig*2,fi%input%neig,fi%noco%l_soc) + 1, fi%kpts%nkpt)
      50             : 
      51             : 
      52          16 :       call timestart("HF_setup")
      53          16 :       call hybdat%set_nobd(fi, results)
      54          16 :       call hybdat%set_nbands(fi, fmpi, results)
      55          16 :       IF (hybdat%l_calhf) THEN
      56             :          ! Preparations for HF and hybinp functional calculation
      57          16 :          CALL timestart("gen_bz and gen_wavf")
      58             : 
      59             :          ! Reading the eig file
      60          16 :          call timestart("eig stuff")
      61          64 :          DO nk = 1, fi%kpts%nkpt
      62          48 :             nrec1 = fi%kpts%nkpt*(jsp - 1) + nk
      63          48 :             CALL lapw%init(fi%input, fi%noco, nococonv,fi%kpts, fi%atoms, fi%sym, nk, fi%cell)
      64          16 :             nbasfcn = MERGE(lapw%nv(1) + lapw%nv(2) + 2*fi%atoms%nlotot, lapw%nv(1) + fi%atoms%nlotot, fi%noco%l_noco)
      65             : 
      66             :          END DO
      67        3320 :          eig_irr = results%eig(:, :, jsp)
      68          16 :          call timestop("eig stuff")
      69             : 
      70             : 
      71             :          ! generate eigenvectors z and MT coefficients from the previous iteration at all k-points
      72             :          CALL gen_wavf(fi%kpts, fi%sym, fi%atoms, enpara%el0(:, :, jsp), enpara%ello0(:, :, jsp), fi%cell,  &
      73          16 :                        mpdata, vr0, hybdat, fi%noco, nococonv, fmpi, fi%input, jsp)
      74             : 
      75             :          ! generate core wave functions (-> core1/2(jmtd,hybdat%nindxc,0:lmaxc,ntype) )
      76             :          CALL corewf(fi%atoms, jsp, fi%input,  vr0, hybdat%lmaxcd, hybdat%maxindxc, fmpi, &
      77          16 :                      hybdat%lmaxc, hybdat%nindxc, hybdat%core1, hybdat%core2, hybdat%eig_c)
      78             : 
      79             :          ! setup dimension of pntgpt
      80          16 :          IF(ALLOCATED(hybdat%pntgptd)) DEALLOCATE(hybdat%pntgptd) ! for spinpolarized systems
      81          16 :          ALLOCATE (hybdat%pntgptd(3))
      82          64 :          hybdat%pntgptd = 0
      83         144 :          DO nk = 1, fi%kpts%nkptf
      84         128 :             CALL lapw%init(fi%input, fi%noco, nococonv,fi%kpts, fi%atoms, fi%sym, nk, fi%cell)
      85         528 :             do n_dim = 1,3
      86      110096 :                hybdat%pntgptd(n_dim) = MAXVAL([(ABS(lapw%gvec(n_dim,i,jsp)), i=1, lapw%nv(jsp)), hybdat%pntgptd(n_dim)])
      87             :             end do
      88             :          END DO
      89             : 
      90          16 :          IF(ALLOCATED(hybdat%pntgpt)) DEALLOCATE(hybdat%pntgpt) ! for spinpolarized systems
      91             :          ALLOCATE (hybdat%pntgpt(-hybdat%pntgptd(1):hybdat%pntgptd(1), -hybdat%pntgptd(2):hybdat%pntgptd(2), &
      92          96 :                                  -hybdat%pntgptd(3):hybdat%pntgptd(3), fi%kpts%nkptf), stat=ok)
      93          16 :          IF (ok /= 0) call judft_error('eigen_hf: failure allocation pntgpt')
      94       78096 :          hybdat%pntgpt = 0
      95         144 :          DO nk = 1, fi%kpts%nkptf
      96         128 :             CALL lapw%init(fi%input, fi%noco, nococonv,fi%kpts, fi%atoms, fi%sym, nk, fi%cell)
      97       18280 :             DO i = 1, lapw%nv(jsp)
      98       18264 :                hybdat%pntgpt(lapw%gvec(1,i,jsp), lapw%gvec(2,i,jsp), lapw%gvec(3,i,jsp), nk) = i
      99             :             END DO
     100             :          END DO
     101             : 
     102       12688 :          allocate(basprod(fi%atoms%jmtd), stat=ok, source=0.0)
     103          16 :          IF (ok /= 0) call judft_error('eigen_hf: failure allocation basprod')
     104          16 :          IF(ALLOCATED(hybdat%prodm)) DEALLOCATE(hybdat%prodm)
     105         264 :          allocate(hybdat%prodm(maxval(mpdata%num_radbasfn), mpdata%max_indx_p_1, 0:maxval(fi%hybinp%lcutm1), fi%atoms%ntype), stat=ok)
     106          16 :          IF (ok /= 0) call judft_error('eigen_hf: failure allocation hybdat%prodm')
     107             : 
     108      363008 :          hybdat%prodm = 0; mpdata%l1 = 0; mpdata%l2 = 0
     109       59264 :          mpdata%n1 = 0; mpdata%n2 = 0
     110          16 :          IF(ALLOCATED(hybdat%nindxp1)) DEALLOCATE(hybdat%nindxp1) ! for spinpolarized systems
     111          88 :          ALLOCATE (hybdat%nindxp1(0:maxval(fi%hybinp%lcutm1), fi%atoms%ntype))
     112         160 :          hybdat%nindxp1 = 0
     113             : 
     114             :          !$OMP PARALLEL DO default(none) schedule(dynamic)&
     115             :          !$OMP private(itype, ng, l2, l1, n1, l, nn, n, basprod) &
     116          16 :          !$OMP shared(fi, mpdata, hybdat)
     117             :          DO itype = 1, fi%atoms%ntype
     118             :             ng = fi%atoms%jri(itype)
     119             :             DO l2 = 0, MIN(fi%atoms%lmax(itype), fi%hybinp%lcutwf(itype))
     120             :                DO l1 = 0, l2
     121             :                   IF (ABS(l1 - l2) <= fi%hybinp%lcutm1(itype)) THEN
     122             :                      DO n2 = 1, mpdata%num_radfun_per_l(l2, itype)
     123             :                         nn = mpdata%num_radfun_per_l(l1, itype)
     124             :                         IF (l1 == l2) nn = n2
     125             :                         DO n1 = 1, nn
     126             :                            ! Calculate all basis-function hybdat%products to obtain
     127             :                            ! the overlaps with the hybdat%product-basis functions (hybdat%prodm)
     128             :                            basprod(:ng) = (hybdat%bas1(:ng, n1, l1, itype)*hybdat%bas1(:ng, n2, l2, itype) + &
     129             :                                            hybdat%bas2(:ng, n1, l1, itype)*hybdat%bas2(:ng, n2, l2, itype))/fi%atoms%rmsh(:ng, itype)
     130             :                            DO l = ABS(l1 - l2), MIN(fi%hybinp%lcutm1(itype), l1 + l2)
     131             :                               IF (MOD(l1 + l2 + l, 2) == 0) THEN
     132             :                                  hybdat%nindxp1(l, itype) = hybdat%nindxp1(l, itype) + 1
     133             :                                  n = hybdat%nindxp1(l, itype)
     134             :                                  mpdata%l1(n,l,itype) = l1
     135             :                                  mpdata%l2(n,l,itype) = l2
     136             :                                  mpdata%n1(n,l,itype) = n1
     137             :                                  mpdata%n2(n,l,itype) = n2
     138             :                                  DO i = 1, mpdata%num_radbasfn(l, itype)
     139             :                                     hybdat%prodm(i, n, l, itype) = intgrf(basprod(:ng)*mpdata%radbasfn_mt(:ng, i, l, itype), &
     140             :                                                                           fi%atoms, itype, hybdat%gridf)
     141             :                                  END DO
     142             :                               END IF
     143             :                            END DO
     144             :                         END DO
     145             :                      END DO
     146             :                   END IF
     147             :                END DO
     148             :             END DO
     149             :          END DO
     150             :          !$OMP END PARALLEL DO
     151          16 :          deallocate(basprod)
     152          16 :          CALL timestop("gen_bz and gen_wavf")
     153             : 
     154           0 :       ELSE IF (fi%hybinp%l_hybrid) THEN ! hybdat%l_calhf is false
     155           0 :          hybdat%maxlmindx = MAXVAL([(SUM([(mpdata%num_radfun_per_l(l, itype)*(2*l + 1), l=0, fi%atoms%lmax(itype))]), itype=1, fi%atoms%ntype)])
     156           0 :          hybdat%nbands = MIN(fi%hybinp%bands1, fi%input%neig)
     157             : 
     158             :       ENDIF ! hybdat%l_calhf
     159             : 
     160          16 :       call timestop("HF_setup")
     161          16 :    END SUBROUTINE hf_setup
     162             : 
     163             : END MODULE m_hf_setup

Generated by: LCOV version 1.14