LCOV - code coverage report
Current view: top level - eigen - hsmt_soc_offdiag.f90 (source / functions) Hit Total Coverage
Test: combined.info Lines: 46 46 100.0 %
Date: 2019-09-08 04:53:50 Functions: 2 2 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             : MODULE m_hsmt_soc_offdiag
       8             :   USE m_juDFT
       9             :   IMPLICIT NONE
      10             : CONTAINS
      11         480 :   SUBROUTINE hsmt_soc_offdiag(n,atoms,mpi,noco,lapw,usdus,td,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
      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,j1,j2
      33             :     COMPLEX :: fct
      34             :     !     ..
      35             :     !     .. Local Arrays ..
      36         960 :     REAL fleg1(0:atoms%lmaxd),fleg2(0:atoms%lmaxd),fl2p1(0:atoms%lmaxd)
      37         480 :     COMPLEX:: chi(2,2,2,2),angso(lapw%nv(1),2,2)
      38         960 :     REAL, ALLOCATABLE :: plegend(:,:),dplegend(:,:)
      39         480 :     COMPLEX, ALLOCATABLE :: cph(:)
      40             :    
      41         480 :     CALL timestart("offdiagonal soc-setup")
      42             :     
      43        4800 :     DO l = 0,atoms%lmaxd
      44        4320 :        fleg1(l) = REAL(l+l+1)/REAL(l+1)
      45        4320 :        fleg2(l) = REAL(l)/REAL(l+1)
      46        4800 :        fl2p1(l) = REAL(l+l+1)/fpi_const
      47             :     END DO
      48             : 
      49             :     !$OMP PARALLEL DEFAULT(NONE)&
      50             :     !$OMP SHARED(n,lapw,atoms,td,fj,gj,noco,fl2p1,fleg1,fleg2,hmat,mpi)&
      51             :     !$OMP PRIVATE(kii,ki,ski,kj,plegend,dplegend,l,j1,j2,angso,chi)&
      52        1440 :     !$OMP PRIVATE(cph,nn,tnn,fct)
      53         480 :     ALLOCATE(cph(MAXVAL(lapw%nv)))
      54        1440 :     ALLOCATE(plegend(MAXVAL(lapw%nv),0:atoms%lmaxd))
      55        1440 :     ALLOCATE(dplegend(MAXVAL(lapw%nv),0:atoms%lmaxd))
      56        9120 :     plegend=0.0
      57       99360 :     plegend(:,0)=1.0
      58       99360 :     dplegend(:,0)=0.e0
      59       49920 :     dplegend(:,1)=1.e0
      60         480 :     !$OMP  DO SCHEDULE(DYNAMIC,1)
      61             :     DO  ki =  mpi%n_rank+1, lapw%nv(1), mpi%n_size
      62       24720 :        kii=(ki-1)/mpi%n_size+1
      63             :        !--->       legendre polynomials
      64     1310720 :        DO kj = 1,ki
      65     5168720 :           plegend(kj,1) = DOT_PRODUCT(lapw%gk(:,kj,1),lapw%gk(:,ki,1))
      66             :        END DO
      67       24720 :        DO l = 1,atoms%lmax(n) - 1
      68     9175040 :           plegend(:ki,l+1) = fleg1(l)*plegend(:ki,1)*plegend(:ki,l) - fleg2(l)*plegend(:ki,l-1)
      69      197760 :           dplegend(:ki,l+1)=REAL(l+1)*plegend(:ki,l)+plegend(:ki,1)*dplegend(:ki,l)
      70             :        END DO
      71             :        !--->             set up phase factors
      72     5119280 :        cph = 0.0
      73       98880 :        ski = lapw%gvec(:,ki,1) 
      74       86520 :        DO nn = SUM(atoms%neq(:n-1))+1,SUM(atoms%neq(:n))
      75       98880 :           tnn = tpi_const*atoms%taual(:,nn)
      76     2621440 :           DO kj = 1,ki
      77             :              cph(kj) = cph(kj) +&
      78             :                   CMPLX(COS(DOT_PRODUCT(ski-lapw%gvec(:,kj,1),tnn)),&
      79     5168720 :                   SIN(DOT_PRODUCT(lapw%gvec(:,kj,1)-ski,tnn)))
      80             :           END DO
      81             :        END DO
      82             :        !Set up spinors...
      83       24720 :        CALL hsmt_spinor_soc(n,ki,noco,lapw,chi,angso)
      84             : 
      85             :        !--->          update overlap and l-diagonal hamiltonian matrix
      86      222480 :        DO  l = 1,atoms%lmax(n)
      87      420240 :           DO j1=1,2
      88     2175360 :              DO j2=1,2
      89             :              !DO j2=j1,j1
      90    83490560 :                 DO kj = 1,ki
      91             :                    fct  =cph(kj) * dplegend(kj,l)*fl2p1(l)*(&
      92             :                         fj(ki,l,j1)*fj(kj,l,j2) *td%rsoc%rsopp(n,l,j1,j2) + &
      93             :                         fj(ki,l,j1)*gj(kj,l,j2) *td%rsoc%rsopdp(n,l,j1,j2) + &
      94             :                         gj(ki,l,j1)*fj(kj,l,j2) *td%rsoc%rsoppd(n,l,j1,j2) + &
      95             :                         gj(ki,l,j1)*gj(kj,l,j2) *td%rsoc%rsopdpd(n,l,j1,j2)) &
      96    41152000 :                         * angso(kj,j1,j2)
      97    41152000 :                    hmat(1,1)%data_c(kj,kii)=hmat(1,1)%data_c(kj,kii) + chi(1,1,j1,j2)*fct 
      98    41152000 :                    hmat(1,2)%data_c(kj,kii)=hmat(1,2)%data_c(kj,kii) + chi(1,2,j1,j2)*fct 
      99    41152000 :                    hmat(2,1)%data_c(kj,kii)=hmat(2,1)%data_c(kj,kii) + chi(2,1,j1,j2)*fct 
     100    41943040 :                    hmat(2,2)%data_c(kj,kii)=hmat(2,2)%data_c(kj,kii) + chi(2,2,j1,j2)*fct
     101             :                 ENDDO
     102             :              ENDDO
     103             :           ENDDO
     104             :           !--->          end loop over l
     105             :        ENDDO
     106             :        !--->    end loop over ki
     107             :     ENDDO
     108             :     !$OMP END DO
     109             :     !--->       end loop over atom types (ntype)
     110         480 :     DEALLOCATE(plegend)
     111         480 :     DEALLOCATE(cph)
     112             :     !$OMP END PARALLEL
     113         480 :     CALL timestop("offdiagonal soc-setup")
     114             : 
     115         480 :     RETURN
     116         960 :   END SUBROUTINE hsmt_soc_offdiag
     117             : END MODULE m_hsmt_soc_offdiag

Generated by: LCOV version 1.13