LCOV - code coverage report
Current view: top level - eigen - hsmt_offdiag.F90 (source / functions) Hit Total Coverage
Test: combined.info Lines: 0 46 0.0 %
Date: 2019-09-08 04:53:50 Functions: 0 2 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_hsmt_offdiag
       8             :   USE m_juDFT
       9             :   IMPLICIT NONE
      10             : CONTAINS
      11           0 :   SUBROUTINE hsmt_offdiag(n,atoms,mpi,isp,noco,lapw,td,usdus,fj,gj,hmat)
      12             :     USE m_constants, ONLY : fpi_const,tpi_const
      13             :     USE m_types
      14             :     USE m_hsmt_spinor
      15             :     IMPLICIT NONE
      16             :     TYPE(t_mpi),INTENT(IN)        :: mpi
      17             :     TYPE(t_noco),INTENT(IN)       :: noco
      18             :     TYPE(t_atoms),INTENT(IN)      :: atoms
      19             :     TYPE(t_lapw),INTENT(IN)       :: lapw
      20             :     TYPE(t_usdus),INTENT(IN)      :: usdus
      21             :     TYPE(t_tlmplm),INTENT(IN)     :: td
      22             :     CLASS(t_mat),INTENT(INOUT)    :: hmat(:,:)!(2,2)
      23             :     !     ..
      24             :     !     .. Scalar Arguments ..
      25             :     INTEGER, INTENT (IN) :: n,isp
      26             :     !     ..
      27             :     !     .. Array Arguments ..
      28             :     REAL,    INTENT (IN) :: fj(:,0:,:),gj(:,0:,:)
      29             :     !     ..
      30             :     !     .. Local Scalars ..
      31             :     REAL tnn(3),ski(3)
      32             :     INTEGER kii,ki,kj,l,nn,iintsp,jintsp,s
      33             :     COMPLEX :: fct
      34             :     !     ..
      35             :     !     .. Local Arrays ..
      36           0 :     REAL fleg1(0:atoms%lmaxd),fleg2(0:atoms%lmaxd),fl2p1(0:atoms%lmaxd)     
      37           0 :     REAL fl2p1bt(0:atoms%lmaxd)
      38             :     REAL qssbti(3),qssbtj(3)
      39             :     COMPLEX:: chi(2,2,2,2)
      40           0 :     REAL, ALLOCATABLE :: plegend(:,:)
      41           0 :     COMPLEX, ALLOCATABLE :: cph(:)
      42             : 
      43           0 :     CALL timestart("offdiagonal setup")
      44             : 
      45           0 :     CALL hsmt_spinor_soc(n,1,noco,lapw,chi)
      46             : 
      47           0 :     IF (isp==1) THEN
      48             :        iintsp=2;jintsp=1
      49             :     ELSE
      50           0 :        iintsp=1;jintsp=2
      51             :     ENDIF
      52             :     
      53           0 :     DO l = 0,atoms%lmaxd
      54           0 :        fleg1(l) = REAL(l+l+1)/REAL(l+1)
      55           0 :        fleg2(l) = REAL(l)/REAL(l+1)
      56           0 :        fl2p1(l) = REAL(l+l+1)/fpi_const
      57           0 :        fl2p1bt(l) = fl2p1(l)*0.5
      58             :     END DO
      59             :     !$OMP PARALLEL DEFAULT(SHARED)&
      60             :     !$OMP PRIVATE(kii,ki,ski,kj,plegend,l)&
      61             :     !$OMP PRIVATE(cph,nn,tnn)&
      62           0 :     !$OMP PRIVATE(fct,s)
      63           0 :     ALLOCATE(cph(MAXVAL(lapw%nv)))
      64           0 :     ALLOCATE(plegend(MAXVAL(lapw%nv),0:atoms%lmaxd))
      65           0 :     plegend=0.0
      66           0 :     plegend(:,0)=1.0
      67           0 :     qssbti=MERGE(- noco%qss/2,+ noco%qss/2,iintsp.EQ.1)
      68           0 :     qssbtj=MERGE(- noco%qss/2,+ noco%qss/2,jintsp.EQ.1)
      69           0 :     !$OMP  DO SCHEDULE(DYNAMIC,1)
      70             :     DO  ki =  mpi%n_rank+1, lapw%nv(iintsp), mpi%n_size
      71           0 :        kii=(ki-1)/mpi%n_size+1
      72             :        !--->       legendre polynomials
      73           0 :        DO kj = 1,ki
      74           0 :           plegend(kj,1) = DOT_PRODUCT(lapw%gk(:,kj,jintsp),lapw%gk(:,ki,iintsp))
      75             :        END DO
      76           0 :        DO l = 1,atoms%lmax(n) - 1
      77           0 :           plegend(:ki,l+1) = fleg1(l)*plegend(:ki,1)*plegend(:ki,l) - fleg2(l)*plegend(:ki,l-1)
      78             :        END DO
      79             :        !--->             set up phase factors
      80           0 :        cph = 0.0
      81           0 :        ski = lapw%gvec(:,ki,iintsp) + qssbti
      82           0 :        DO nn = SUM(atoms%neq(:n-1))+1,SUM(atoms%neq(:n))
      83           0 :           tnn = tpi_const*atoms%taual(:,nn)
      84           0 :           DO kj = 1,ki
      85             :              cph(kj) = cph(kj) +&
      86             :                   CMPLX(COS(DOT_PRODUCT(ski-lapw%gvec(:,kj,jintsp)+qssbtj,tnn)),&
      87           0 :                   SIN(DOT_PRODUCT(lapw%gvec(:,kj,jintsp)+qssbtj-ski,tnn)))
      88             :           END DO
      89             :        END DO
      90             : 
      91             :        !--->          update overlap and l-diagonal hamiltonian matrix
      92           0 :        s=atoms%lnonsph(n)+1
      93           0 :        DO  l = 0,atoms%lnonsph(n)
      94           0 :           DO kj = 1,ki
      95             :              fct  =cph(kj) * plegend(kj,l)*fl2p1(l)*(&
      96             :                   fj(ki,l,iintsp)*fj(kj,l,jintsp) *td%h_off(l,l,n,isp) + &
      97             :                   fj(ki,l,iintsp)*gj(kj,l,jintsp) *td%h_off(l,l+s,n,isp) + &
      98             :                   gj(ki,l,iintsp)*fj(kj,l,jintsp) *td%h_off(l+s,l,n,isp) + &
      99           0 :                   gj(ki,l,iintsp)*gj(kj,l,jintsp) *td%h_off(l+s,l+s,n,isp)* usdus%ddn(l,n,isp))
     100           0 :              hmat(1,1)%data_c(kj,kii)=hmat(1,1)%data_c(kj,kii) + chi(1,1,iintsp,jintsp)*fct 
     101           0 :              hmat(1,2)%data_c(kj,kii)=hmat(1,2)%data_c(kj,kii) + chi(1,2,iintsp,jintsp)*fct 
     102           0 :              hmat(2,1)%data_c(kj,kii)=hmat(2,1)%data_c(kj,kii) + chi(2,1,iintsp,jintsp)*fct 
     103           0 :              hmat(2,2)%data_c(kj,kii)=hmat(2,2)%data_c(kj,kii) + chi(2,2,iintsp,jintsp)*fct 
     104             :           ENDDO
     105             :           !--->          end loop over l
     106             :        ENDDO
     107             :        !--->    end loop over ki
     108             :     ENDDO
     109             :     !$OMP END DO
     110             :     !--->       end loop over atom types (ntype)
     111           0 :     DEALLOCATE(plegend)
     112           0 :     DEALLOCATE(cph)
     113             :     !$OMP END PARALLEL
     114           0 :     CALL timestop("offdiagonal setup")
     115             : 
     116           0 :     RETURN
     117           0 :   END SUBROUTINE hsmt_offdiag
     118             : END MODULE m_hsmt_offdiag

Generated by: LCOV version 1.13