hsmt.F90 6.21 KB
Newer Older
1 2 3 4 5
!--------------------------------------------------------------------------------
! Copyright (c) 2016 Peter Grünberg Institut, Forschungszentrum Jülich, Germany
! This file is part of FLEUR and available as free software under the conditions
! of the MIT license as expressed in the LICENSE file in more detail.
!--------------------------------------------------------------------------------
6 7 8 9
MODULE m_hsmt
  USE m_juDFT
  IMPLICIT NONE
CONTAINS
Daniel Wortmann's avatar
Daniel Wortmann committed
10 11 12 13 14 15 16 17 18 19 20 21 22 23 24
  !> Setup of MT-part of the Hamiltonian and the overlap matrix
  !!
  !! Here the MT-components are added to the matrices.
  !! 1. The spherical part in hsmt_sph()
  !! 2. The non-spherical part in hsmt_nonsph()
  !! 3. The lo-part in hsmt_lo()
  !!
  !! - In the case of a noco-calculation (but not spin-spiral), first a temporary matrix is set-up
  !! for each atom in its local spin-frame and this matrix is the rotated into the global frame and added to the full matrix
  !! - In the spin-spiral case, a loop over the global spin is performed and the four parts of the matrix are calculated one-by-one
  !! @todo
  !! The off-diagonal contribution in first-variation soc and constraint calculations is still missing
  
  SUBROUTINE hsmt(atoms,sym,enpara,&
       ispin,input,mpi,noco,cell,lapw,usdus,td,smat,hmat)
25
    USE m_types
26 27
    USE m_hsmt_nonsph
    USE m_hsmt_sph
Daniel Wortmann's avatar
Daniel Wortmann committed
28 29
    use m_hsmt_lo
    USE m_hsmt_distspins
30
    USE m_hsmt_fjgj
Daniel Wortmann's avatar
Daniel Wortmann committed
31 32
    USE m_hsmt_spinor
    USE m_hsmt_soc_offdiag
33
    USE m_hsmt_mtNocoPot_offdiag
Daniel Wortmann's avatar
Daniel Wortmann committed
34
    USE m_hsmt_offdiag
35
    IMPLICIT NONE
36 37 38 39 40 41 42
    TYPE(t_mpi),INTENT(IN)        :: mpi
    TYPE(t_input),INTENT(IN)      :: input
    TYPE(t_noco),INTENT(IN)       :: noco
    TYPE(t_sym),INTENT(IN)        :: sym
    TYPE(t_cell),INTENT(IN)       :: cell
    TYPE(t_atoms),INTENT(IN)      :: atoms
    TYPE(t_enpara),INTENT(IN)     :: enpara
Daniel Wortmann's avatar
Daniel Wortmann committed
43 44 45 46
    TYPE(t_lapw),INTENT(IN)       :: lapw 
    TYPE(t_tlmplm),INTENT(IN)     :: td
    TYPE(t_usdus),INTENT(IN)      :: usdus
    CLASS(t_mat),INTENT(INOUT)    :: smat(:,:),hmat(:,:)
47 48
    !     ..
    !     .. Scalar Arguments ..
Daniel Wortmann's avatar
Daniel Wortmann committed
49 50 51
    INTEGER, INTENT (IN) :: ispin  
    
    !locals
52 53 54
#ifdef CPP_GPU
    REAL, ALLOCATABLE,MANAGED    :: fj(:,:,:,:),gj(:,:,:,:)
#else
55
    REAL, ALLOCATABLE    :: fj(:,:,:,:),gj(:,:,:,:)
56
#endif
57

Daniel Wortmann's avatar
Daniel Wortmann committed
58 59
    INTEGER :: iintsp,jintsp,n
    COMPLEX :: chi(2,2),chi_one
60

Daniel Wortmann's avatar
Daniel Wortmann committed
61
    TYPE(t_mat)::smat_tmp,hmat_tmp
62 63

    !
Daniel Wortmann's avatar
Daniel Wortmann committed
64 65 66
    IF (noco%l_noco.AND..NOT.noco%l_ss) THEN
       CALL smat_tmp%alloc(smat(1,1)%l_real,smat(1,1)%matsize1,smat(1,1)%matsize2)
       CALL hmat_tmp%alloc(smat(1,1)%l_real,smat(1,1)%matsize1,smat(1,1)%matsize2)
67
    ENDIF
Daniel Wortmann's avatar
Daniel Wortmann committed
68
    
69 70
    ALLOCATE(fj(MAXVAL(lapw%nv),0:atoms%lmaxd,input%jspins,MERGE(2,1,noco%l_noco)))
    ALLOCATE(gj(MAXVAL(lapw%nv),0:atoms%lmaxd,input%jspins,MERGE(2,1,noco%l_noco)))
Daniel Wortmann's avatar
Daniel Wortmann committed
71 72 73 74 75 76 77 78 79

    iintsp=1;jintsp=1;chi_one=1.0 !Defaults in non-noco case
       DO n=1,atoms%ntype
          CALL timestart("fjgj coefficients")
          CALL hsmt_fjgj(input,atoms,cell,lapw,noco,usdus,n,ispin,fj,gj)
          CALL timestop("fjgj coefficients")
          IF (.NOT.noco%l_noco) THEN
             !This is for collinear calculations: the (1,1) element of the matrices is all
             !that is needed and allocated
Uliana Alekseeva's avatar
Uliana Alekseeva committed
80
             CALL hsmt_sph(n,atoms,mpi,ispin,input,noco,1,1,chi_one,lapw,enpara%el0,&
81
                           td%e_shift(n,ispin),usdus,fj(:,0:,ispin,:),gj(:,0:,ispin,:),smat(1,1),hmat(1,1))
82 83 84 85
             CALL hsmt_nonsph(n,mpi,sym,atoms,ispin,1,1,chi_one,noco,cell,lapw,td,&
                              fj(:,0:,ispin,:),gj(:,0:,ispin,:),hmat(1,1))
             CALL hsmt_lo(input,atoms,sym,cell,mpi,noco,lapw,usdus,td,fj(:,0:,ispin,:),gj(:,0:,ispin,:),&
                          n,chi_one,ispin,iintsp,jintsp,hmat(1,1),smat(1,1))
Daniel Wortmann's avatar
Daniel Wortmann committed
86 87 88 89 90 91
          ELSEIF(noco%l_noco.AND..NOT.noco%l_ss) THEN
             !The NOCO but non-spinspiral setup follows:
             !The Matrix-elements are first calculated in the local frame of the atom and
             !stored in tmp-variables. Then these are distributed (rotated) into the 2x2
             !global spin-matrices.
             CALL hmat_tmp%clear();CALL smat_tmp%clear()
Uliana Alekseeva's avatar
Uliana Alekseeva committed
92
             CALL hsmt_sph(n,atoms,mpi,ispin,input,noco,1,1,chi_one,lapw,enpara%el0,td%e_shift(n,ispin),&
93
                  usdus,fj(:,0:,ispin,:),gj(:,0:,ispin,:),smat_tmp,hmat_tmp)
94
             CALL hsmt_nonsph(n,mpi,sym,atoms,ispin,1,1,chi_one,noco,cell,lapw,td,&
95
                  fj(:,0:,ispin,:),gj(:,0:,ispin,:),hmat_tmp)
96
             CALL hsmt_lo(input,atoms,sym,cell,mpi,noco,lapw,usdus,td,fj(:,0:,ispin,:),gj(:,0:,ispin,:),&
97
                  n,chi_one,ispin,iintsp,jintsp,hmat_tmp,smat_tmp)
Daniel Wortmann's avatar
Daniel Wortmann committed
98 99 100 101
             CALL hsmt_spinor(ispin,n,noco,chi)
             CALL hsmt_distspins(chi,smat_tmp,smat)
             CALL hsmt_distspins(chi,hmat_tmp,hmat)
             !Add off-diagonal contributions to Hamiltonian if needed
102
             IF (ispin==1.AND.noco%l_mtNocoPot) THEN
103
                CALL hsmt_mtNocoPot_offdiag(n,mpi,sym,atoms,noco,cell,lapw,td,fj,gj,hmat_tmp,hmat)
104
             ENDIF
Daniel Wortmann's avatar
Daniel Wortmann committed
105
             IF (ispin==1.and.noco%l_soc) &
106
                  CALL hsmt_soc_offdiag(n,atoms,mpi,noco,lapw,usdus,td,fj(:,0:,:,iintsp),gj(:,0:,:,iintsp),hmat)
Daniel Wortmann's avatar
Daniel Wortmann committed
107
             IF (noco%l_constr) &
108
                  CALL hsmt_offdiag(n,atoms,mpi,ispin,noco,lapw,td,usdus,fj(:,0:,ispin,:),gj(:,0:,ispin,:),hmat)
109
          ELSE
Daniel Wortmann's avatar
Daniel Wortmann committed
110 111 112 113 114
             !In the spin-spiral case the loop over the interstitial=global spin has to
             !be performed explicitely
             CALL hsmt_spinor(ispin,n,noco,chi)
             DO iintsp=1,2
                DO jintsp=1,2
115
                   CALL hsmt_sph(n,atoms,mpi,ispin,input,noco,iintsp,jintsp,chi(jintsp,iintsp),&
116
                                 lapw,enpara%el0,td%e_shift(n,ispin),usdus,fj(:,0:,ispin,:),gj(:,0:,ispin,:),&
117
                                 smat(iintsp,jintsp),hmat(iintsp,jintsp))
118
                   CALL hsmt_nonsph(n,mpi,sym,atoms,ispin,iintsp,jintsp,chi(jintsp,iintsp),noco,cell,&
119
                                    lapw,td,fj(:,0:,ispin,:),gj(:,0:,ispin,:),hmat(iintsp,jintsp))
120
                   CALL hsmt_lo(input,atoms,sym,cell,mpi,noco,lapw,usdus,td,fj(:,0:,ispin,:),gj(:,0:,ispin,:),&
121
                          n,chi(jintsp,iintsp),ispin,iintsp,jintsp,hmat(iintsp,jintsp),smat(iintsp,jintsp))
Daniel Wortmann's avatar
Daniel Wortmann committed
122 123
                ENDDO
             ENDDO
124
          ENDIF
Daniel Wortmann's avatar
Daniel Wortmann committed
125 126
          
    END DO
127

Daniel Wortmann's avatar
Daniel Wortmann committed
128
    
129 130 131
    RETURN
  END SUBROUTINE hsmt
END MODULE m_hsmt