LCOV - code coverage report
Current view: top level - eigen - hsvac.F90 (source / functions) Hit Total Coverage
Test: combined.info Lines: 61 68 89.7 %
Date: 2019-09-08 04:53:50 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             : MODULE m_hsvac
       7             :   USE m_juDFT
       8             : CONTAINS
       9             :   !-----------------------------------------------------------
      10             :   !Calculate the vacuum contribution to the Hamiltonian and
      11             :   !Overlap matrix
      12             :   !-----------------------------------------------------------
      13          32 :   SUBROUTINE hsvac(&
      14          32 :        vacuum,stars,DIMENSION, mpi,jsp,input,v,evac,cell,&
      15          64 :        lapw,sym, noco,hmat,smat)
      16             :  
      17             : 
      18             :     USE m_vacfun
      19             :     USE m_types
      20             :     IMPLICIT NONE
      21             :     TYPE(t_dimension),INTENT(IN)  :: DIMENSION
      22             :     TYPE(t_input),INTENT(IN)      :: input
      23             :     TYPE(t_vacuum),INTENT(IN)     :: vacuum
      24             :     TYPE(t_noco),INTENT(IN)       :: noco
      25             :     TYPE(t_sym),INTENT(IN)        :: sym
      26             :     TYPE(t_stars),INTENT(IN)      :: stars
      27             :     TYPE(t_cell),INTENT(IN)       :: cell
      28             :     TYPE(t_lapw),INTENT(IN)       :: lapw
      29             :     TYPE(t_mpi),INTENT(IN)        :: mpi
      30             :     TYPE(t_potden),INTENT(IN)     :: v
      31             :     CLASS(t_mat),INTENT(INOUT)    :: hmat(:,:),smat(:,:)
      32             :     !     ..
      33             :     !     .. Scalar Arguments ..
      34             :     INTEGER, INTENT (IN) :: jsp
      35             :     !     ..
      36             :     !     .. Array Arguments ..
      37             :     REAL,    INTENT (IN) :: evac(2,input%jspins)
      38             :     !     ..
      39             :     !     .. Local Scalars ..
      40             :     COMPLEX hij,sij,apw_lo,c_1
      41             :     REAL d2,gz,sign,th,wronk
      42             :     INTEGER i,i2,ii,jj,ik,j,jk,k,jspin,ii0,i0
      43             :     INTEGER ivac,irec,imz,igvm2,igvm2i,s1,s2
      44             :     INTEGER jspin1,jspin2,jmax,jsp_start,jsp_end
      45             :     INTEGER i_start,nc,nc_0
      46             :     !     ..
      47             :     !     .. Local Arrays ..
      48          64 :     INTEGER:: nv2(input%jspins)
      49          64 :     INTEGER kvac(2,DIMENSION%nv2d,input%jspins)
      50          64 :     INTEGER map2(DIMENSION%nvd,input%jspins)
      51          64 :     COMPLEX tddv(DIMENSION%nv2d,DIMENSION%nv2d),tduv(DIMENSION%nv2d,DIMENSION%nv2d)
      52          64 :     COMPLEX tudv(DIMENSION%nv2d,DIMENSION%nv2d),tuuv(DIMENSION%nv2d,DIMENSION%nv2d)
      53             :     COMPLEX vxy_help(stars%ng2-1)
      54          64 :     COMPLEX a(DIMENSION%nvd,input%jspins),b(DIMENSION%nvd,input%jspins)
      55          64 :     REAL ddnv(DIMENSION%nv2d,input%jspins),dudz(DIMENSION%nv2d,input%jspins)
      56         128 :     REAL duz(DIMENSION%nv2d,input%jspins), udz(DIMENSION%nv2d,input%jspins)
      57          64 :     REAL uz(DIMENSION%nv2d,input%jspins)
      58             :     !     ..
      59             : 
      60             : 
      61          32 :     d2 = SQRT(cell%omtil/cell%area)
      62             : 
      63             :     !--->    set up mapping function from 3d-->2d lapws
      64             : 
      65          84 :     DO jspin = 1,input%jspins
      66          52 :        nv2(jspin) = 0
      67       19868 :        k_loop:DO  k = 1,lapw%nv(jspin)
      68      330608 :           DO  j = 1,nv2(jspin)
      69      330608 :              IF (all(lapw%gvec(1:2,k,jspin)==kvac(1:2,j,jspin))) THEN
      70       17784 :                 map2(k,jspin) = j
      71       17784 :                 CYCLE k_loop
      72             :              END IF
      73             :           ENDDO
      74        2000 :           nv2(jspin) = nv2(jspin) + 1
      75        2000 :           IF (nv2(jspin)>DIMENSION%nv2d)  CALL juDFT_error("hsvac:dimension%nv2d",calledby ="hsvac")
      76        2000 :           kvac(1:2,nv2(jspin),jspin) = lapw%gvec(1:2,k,jspin)
      77        2052 :           map2(k,jspin) = nv2(jspin)
      78             :        ENDDO k_loop
      79             :     ENDDO
      80             :     !--->    loop over the two vacuua (1: upper; 2: lower)
      81          96 :     DO ivac = 1,2
      82          64 :        sign = 3. - 2.*ivac !+/- 1
      83         160 :        DO jspin1=MERGE(1,jsp,noco%l_noco),MERGE(2,jsp,noco%l_noco) !loop over global spin
      84          64 :           s1=MIN(SIZE(hmat,1),jspin1) !in colinear case s1=1
      85         192 :           DO jspin2=MERGE(1,jsp,noco%l_noco),MERGE(2,jsp,noco%l_noco) !loop over global spin
      86          64 :              s2=MIN(SIZE(hmat,1),jspin2) !in colinear case s2=1
      87             :           !--->       get the wavefunctions and set up the tuuv, etc matrices          
      88             :              CALL vacfun(&
      89             :                   vacuum,stars,&
      90             :                   input,noco,jspin1,jspin2,&
      91             :                   sym, cell,ivac,evac,lapw%bkpt,v%vacxy,v%vacz,kvac,nv2,&
      92          64 :                   tuuv,tddv,tudv,tduv,uz,duz,udz,dudz,ddnv,wronk)
      93             :           !
      94             :           !--->       generate a and b coeffficients
      95             :           !
      96         128 :              DO jspin = MIN(jspin1,jspin2),MAX(jspin1,jspin2)
      97       29336 :                 DO k = 1,lapw%nv(jspin)
      98       29208 :                    gz = sign*cell%bmat(3,3)*lapw%k3(k,jspin)
      99       29208 :                    i2 = map2(k,jspin)
     100       29208 :                    th = gz*cell%z1
     101       29208 :                    c_1 = CMPLX( COS(th), SIN(th) )/ (d2*wronk)
     102       29208 :                    a(k,jspin) = - c_1 * CMPLX(dudz(i2,jspin), gz*udz(i2,jspin) )
     103       29272 :                    b(k,jspin) =   c_1 * CMPLX(duz(i2,jspin), gz* uz(i2,jspin) )
     104             :                 ENDDO
     105             :              ENDDO
     106             :           !--->       update hamiltonian and overlap matrices
     107          64 :           IF (jspin1==jspin2) THEN
     108       19912 :              DO  i = mpi%n_rank+1,lapw%nv(jspin2),mpi%n_size
     109       19784 :                 i0=(i-1)/mpi%n_size+1 !local column index
     110       19784 :                 ik = map2(i,jspin2)
     111     5052548 :                 DO j = 1,i - 1 !TODO check noco case
     112             :                    !--->             overlap: only  (g-g') parallel=0       '
     113     5052548 :                    IF (map2(j,jspin1).EQ.ik) THEN
     114             :                       sij = CONJG(a(i,jspin2))*a(j,jspin2) + &
     115      121972 :                            CONJG(b(i,jspin2))*b(j,jspin2)*ddnv(ik,jspin2)
     116             :                       !+APW_LO
     117      121972 :                       IF (input%l_useapw) THEN
     118             :                          apw_lo = CONJG(a(i,jspin1)*  uz(ik,jspin1) + b(i,jspin1)* udz(ik,jspin1) ) &
     119             :                               * (a(j,jspin1)* duz(ik,jspin1) + b(j,jspin1)*dudz(ik,jspin1) )&
     120             :                               +      (a(j,jspin1)*  uz(ik,jspin1) + b(j,jspin1)* udz(ik,jspin1) ) &
     121           0 :                               * CONJG(a(i,jspin1)* duz(ik,jspin1) + b(i,jspin1)*dudz(ik,jspin1) )
     122             :                          !            IF (i.lt.10) write (3,'(2i4,2f20.10)') i,j,apw_lo
     123           0 :                          IF (hmat(1,1)%l_real) THEN
     124           0 :                             hmat(s1,s2)%data_r(j,i0) = hmat(s1,s2)%data_r(j,i0) + 0.25 * REAL(apw_lo) 
     125             :                          ELSE 
     126           0 :                             hmat(s1,s2)%data_c(j,i0) = hmat(s1,s2)%data_c(j,i0) + 0.25 * apw_lo
     127             :                          ENDIF
     128             :                       ENDIF
     129             :                       !Overlapp Matrix
     130      121972 :                       IF (hmat(1,1)%l_real) THEN
     131      121972 :                          smat(s1,s2)%data_r(j,i0) = smat(s1,s2)%data_r(j,i0) + REAL(sij)
     132             :                       ELSE 
     133           0 :                          smat(s1,s2)%data_c(j,i0) = smat(s1,s2)%data_c(j,i0) + sij
     134             :                       ENDIF
     135             :                    END IF
     136             :                 ENDDO
     137             :                 !Diagonal term of Overlapp matrix, Hamiltonian later
     138       19784 :                 sij = CONJG(a(i,jspin2))*a(i,jspin2) + CONJG(b(i,jspin2))*b(i,jspin2)*ddnv(ik,jspin2)
     139       19848 :                 IF (hmat(1,1)%l_real) THEN
     140       19784 :                    smat(s2,s1)%data_r(j,i0) = smat(s1,s2)%data_r(j,i0) + REAL(sij)
     141             :                 ELSE
     142           0 :                    smat(s2,s1)%data_c(j,i0) = smat(s1,s2)%data_c(j,i0) + sij
     143             :                 ENDIF
     144             :              ENDDO
     145             :           ENDIF
     146             : 
     147             :           !--->    hamiltonian update
     148       19976 :           DO  i = mpi%n_rank+1,lapw%nv(jspin1),mpi%n_size
     149       19784 :              i0=(i-1)/mpi%n_size+1 !local column index
     150       19784 :              ik = map2(i,jspin1)
     151     5072396 :              DO j = 1,MERGE(i,lapw%nv(jspin2),jspin1==jspin2)
     152     5052548 :                 jk = map2(j,jspin2)
     153             :                 hij = CONJG(a(i,jspin1))* (tuuv(ik,jk)*a(j,jspin2) +tudv(ik,jk)*b(j,jspin2))&
     154     5052548 :                      + CONJG(b(i,jspin1))* (tddv(ik,jk)*b(j,jspin2) +tduv(ik,jk)*a(j,jspin2))
     155     5072332 :                 IF (hmat(1,1)%l_real) THEN
     156     5052548 :                    hmat(s2,s1)%data_r(j,i0) = hmat(s2,s1)%data_r(j,i0) + REAL(hij)
     157             :                 ELSE
     158           0 :                    hmat(s2,s1)%data_c(j,i0) = hmat(s2,s1)%data_c(j,i0) + hij
     159             :                 ENDIF
     160             :              ENDDO
     161             :           ENDDO
     162             : 
     163             :           !--->    end of loop over different parts of the potential matrix
     164             :        ENDDO
     165             : 
     166             :        !---> end of loop over vacua
     167             :     ENDDO
     168             :  ENDDO
     169             : 
     170          32 :   END SUBROUTINE hsvac
     171             : END MODULE m_hsvac

Generated by: LCOV version 1.13