Line data    Source code

       1             : !--------------------------------------------------------------------------------
       2             : ! Copyright (c) 2022 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_dfpt_tlmplm
       8             : 
       9             : CONTAINS
      10           0 :    SUBROUTINE dfpt_tlmplm(atoms,sym,sphhar,input,noco,enpara,hub1inp,hub1data,vTot,fmpi,tdV1,v1real,v1imag,conj_V,iDtype_col)
      11             :       !! Get the (lm) matrix elements for the perturbed potential, which differs slightly from the base
      12             :       !! case of tlmplm for V/H.
      13             :       USE m_types
      14             :       USE m_tlmplm
      15             : 
      16             :       IMPLICIT NONE
      17             : 
      18             :       TYPE(t_mpi),INTENT(IN)       :: fmpi
      19             :       TYPE(t_enpara),INTENT(IN) :: enpara
      20             :       TYPE(t_input),INTENT(IN)     :: input
      21             :       TYPE(t_noco),INTENT(IN)  :: noco
      22             :       TYPE(t_sym),INTENT(IN)       :: sym
      23             :       TYPE(t_sphhar),INTENT(IN)    :: sphhar
      24             :       TYPE(t_atoms),INTENT(IN)     :: atoms
      25             :       TYPE(t_potden),INTENT(IN)    :: vTot
      26             :       TYPE(t_tlmplm),INTENT(INOUT) :: tdV1
      27             :       TYPE(t_hub1inp),INTENT(IN)   :: hub1inp
      28             :       TYPE(t_hub1data),INTENT(INOUT)::hub1data
      29             : 
      30             :       TYPE(t_potden), INTENT(IN) :: v1real, v1imag
      31             : 
      32             :       LOGICAL, INTENT(IN) :: conj_V
      33             : 
      34             :       INTEGER, INTENT(IN), OPTIONAL :: iDtype_col
      35             : 
      36             :       INTEGER :: iSpinV1, iSpinPr, iSpin, iPart, n, offs, nlims(2)
      37             :       COMPLEX :: one
      38             : 
      39           0 :       REAL, ALLOCATABLE :: vr1(:, :)
      40             : 
      41           0 :       TYPE(t_usdus)    :: uddummy
      42           0 :       TYPE(t_potden)   :: vxdummy
      43           0 :       TYPE(t_nococonv) :: nococonvdummy
      44             : 
      45           0 :         ALLOCATE( vr1(SIZE(v1real%mt,1),0:SIZE(v1real%mt,2)-1))
      46             : 
      47           0 :         call uddummy%init(atoms,input%jspins)
      48           0 :         CALL timestart("tlmplm")
      49           0 :         CALL tdV1%init(atoms,input%jspins,.FALSE.)
      50             : 
      51           0 :         nlims(1) = 1
      52           0 :         nlims(2) = atoms%ntype
      53           0 :         IF (PRESENT(iDtype_col)) nlims = [iDtype_col,iDtype_col]
      54             : 
      55             :         !$OMP PARALLEL DO DEFAULT(NONE)&
      56             :         !$OMP PRIVATE(n,one,iSpinV1,iSpinPr,iSpin,vr1,offs)&
      57             :         !$OMP SHARED(noco,nococonvdummy,atoms,sym,sphhar,enpara,tdV1,uddummy,vTot,vxdummy,v1real,v1imag,conj_V,nlims)&
      58           0 :         !$OMP SHARED(fmpi,input,hub1inp,hub1data)
      59             :         DO n = nlims(1), nlims(2)
      60             :             DO iSpinV1 = 1, MERGE(4, input%jspins, any(noco%l_unrestrictMT))
      61             :                 iSpinPr = 1; iSpin = 1
      62             :                 IF (iSpinV1.EQ.2.OR.iSpinV1.EQ.3) iSpinPr = 2
      63             :                 IF (iSpinV1.EQ.2.OR.iSpinV1.EQ.4) iSpin   = 2
      64             :                 DO iPart = 1, 2
      65             :                     IF (.NOT.conj_V) THEN
      66             :                        IF (iPart.EQ.1) one = CMPLX(1.0, 0.0)
      67             :                        IF (iPart.EQ.2) one = CMPLX(0.0, 1.0)
      68             :                        IF (iPart.EQ.1) vr1 = v1real%mt(:, :, n, iSpinV1)
      69             :                        IF (iPart.EQ.2) vr1 = v1imag%mt(:, :, n, iSpinV1)
      70             :                     ELSE
      71             :                        IF (iPart.EQ.1) one = CMPLX(1.0, 0.0)
      72             :                        IF (iPart.EQ.2) one = CMPLX(0.0,-1.0)
      73             :                        IF (iSpinV1==1.OR.iSpinV1==2) THEN
      74             :                           IF (iPart.EQ.1) vr1 = v1real%mt(:, :, n, iSpinV1)
      75             :                           IF (iPart.EQ.2) vr1 = v1imag%mt(:, :, n, iSpinV1)
      76             :                        ELSE IF (iSpinV1==3) THEN
      77             :                           IF (iPart.EQ.1) vr1 = v1real%mt(:, :, n, 4)
      78             :                           IF (iPart.EQ.2) vr1 = v1imag%mt(:, :, n, 4)
      79             :                        ELSE
      80             :                           IF (iPart.EQ.1) vr1 = v1real%mt(:, :, n, 3)
      81             :                           IF (iPart.EQ.2) vr1 = v1imag%mt(:, :, n, 3)
      82             :                        END IF
      83             :                     END IF
      84             :                     CALL tlmplm(n, sphhar, atoms, sym, enpara, nococonvdummy, iSpinPr, iSpin, iSpinV1, fmpi, &
      85             :                               & vTot, vxdummy, input, hub1inp, hub1data, tdV1, uddummy, 0.0, one, .TRUE., vr1)
      86             :                 END DO
      87             :             END DO
      88             : 
      89             :             offs = tdV1%h_loc2_nonsph(n)
      90             :             tdV1%h_loc_nonsph(0:offs-1,0:offs-1,n,:,:)    = tdV1%h_loc(0:offs-1,0:offs-1,n,:,:)
      91             :             tdV1%h_loc_nonsph(offs:offs+offs-1,0:offs-1,n,:,:)  = tdV1%h_loc(tdV1%h_loc2(n):offs+tdV1%h_loc2(n)-1,0:offs-1,n,:,:)
      92             :             tdV1%h_loc_nonsph(0:offs-1,offs:offs+offs-1,n,:,:)  = tdV1%h_loc(0:offs-1,tdV1%h_loc2(n):offs+tdV1%h_loc2(n)-1,n,:,:)
      93             :             tdV1%h_loc_nonsph(offs:offs+offs-1,offs:offs+offs-1,n,:,:)= tdV1%h_loc(tdV1%h_loc2(n):offs+tdV1%h_loc2(n)-1,tdV1%h_loc2(n):offs+tdV1%h_loc2(n)-1,n,:,:)
      94             :         END DO
      95             :         !$OMP END PARALLEL DO
      96           0 :         CALL timestop("tlmplm")
      97             : 
      98           0 :     END SUBROUTINE dfpt_tlmplm
      99             : END MODULE m_dfpt_tlmplm