hsmt.F90 5.67 KB
Newer Older
1 2 3 4
MODULE m_hsmt
  USE m_juDFT
  IMPLICIT NONE
CONTAINS
Daniel Wortmann's avatar
Daniel Wortmann committed
5 6 7 8 9 10 11 12 13 14 15 16 17 18 19
  !> 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)
20
    USE m_types
21 22
    USE m_hsmt_nonsph
    USE m_hsmt_sph
Daniel Wortmann's avatar
Daniel Wortmann committed
23 24
    use m_hsmt_lo
    USE m_hsmt_distspins
25
    USE m_hsmt_fjgj
Daniel Wortmann's avatar
Daniel Wortmann committed
26 27 28
    USE m_hsmt_spinor
    USE m_hsmt_soc_offdiag
    USE m_hsmt_offdiag
29
    IMPLICIT NONE
30 31 32 33 34 35 36
    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
37 38 39 40
    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(:,:)
41 42
    !     ..
    !     .. Scalar Arguments ..
Daniel Wortmann's avatar
Daniel Wortmann committed
43 44 45
    INTEGER, INTENT (IN) :: ispin  
    
    !locals
46 47 48
#ifdef CPP_GPU
    REAL, ALLOCATABLE,MANAGED    :: fj(:,:,:,:),gj(:,:,:,:)
#else
49
    REAL, ALLOCATABLE    :: fj(:,:,:,:),gj(:,:,:,:)
50
#endif
51

Daniel Wortmann's avatar
Daniel Wortmann committed
52 53
    INTEGER :: iintsp,jintsp,n
    COMPLEX :: chi(2,2),chi_one
54

Daniel Wortmann's avatar
Daniel Wortmann committed
55
    TYPE(t_mat)::smat_tmp,hmat_tmp
56 57

    !
Daniel Wortmann's avatar
Daniel Wortmann committed
58 59 60
    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)
61
    ENDIF
Daniel Wortmann's avatar
Daniel Wortmann committed
62
    
63 64
    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
65 66 67 68 69 70 71 72 73

    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
74
             CALL hsmt_sph(n,atoms,mpi,ispin,input,noco,cell,1,1,chi_one,lapw,enpara%el0,&
75
                           td%e_shift(n,ispin),usdus,fj(:,0:,ispin,:),gj(:,0:,ispin,:),smat(1,1),hmat(1,1))
76 77 78 79
             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
80 81 82 83 84 85
          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()
86
             CALL hsmt_sph(n,atoms,mpi,ispin,input,noco,cell,1,1,chi_one,lapw,enpara%el0,td%e_shift(n,ispin),&
87 88 89 90 91
                           usdus,fj(:,0:,ispin,:),gj(:,0:,ispin,:),smat_tmp,hmat_tmp)
             CALL hsmt_nonsph(n,mpi,sym,atoms,ispin,1,1,chi_one,noco,cell,lapw,td,&
                              fj(:,0:,ispin,:),gj(:,0:,ispin,:),hmat_tmp)
             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_tmp,smat_tmp)
Daniel Wortmann's avatar
Daniel Wortmann committed
92 93 94 95 96
             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
             IF (ispin==1.and.noco%l_soc) &
97
                  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
98
             IF (noco%l_constr) &
99
                  CALL hsmt_offdiag(n,atoms,mpi,ispin,noco,lapw,td,usdus,fj(:,0:,ispin,:),gj(:,0:,ispin,:),hmat)
100
          ELSE
Daniel Wortmann's avatar
Daniel Wortmann committed
101 102 103 104 105
             !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
106
                   CALL hsmt_sph(n,atoms,mpi,ispin,input,noco,cell,iintsp,jintsp,chi(iintsp,jintsp),&
107
                                 lapw,enpara%el0,td%e_shift(n,ispin),usdus,fj(:,0:,ispin,:),gj(:,0:,ispin,:),&
108 109 110
                                 smat(iintsp,jintsp),hmat(iintsp,jintsp))
                   CALL hsmt_nonsph(n,mpi,sym,atoms,ispin,iintsp,jintsp,chi(iintsp,jintsp),noco,cell,&
                                    lapw,td,fj(:,0:,ispin,:),gj(:,0:,ispin,:),hmat(iintsp,jintsp))
111
                   CALL hsmt_lo(input,atoms,sym,cell,mpi,noco,lapw,usdus,td,fj(:,0:,ispin,:),gj(:,0:,ispin,:),&
112
                          n,chi(iintsp,jintsp),ispin,iintsp,jintsp,hmat(iintsp,jintsp),smat(iintsp,jintsp))
Daniel Wortmann's avatar
Daniel Wortmann committed
113 114
                ENDDO
             ENDDO
115
          ENDIF
Daniel Wortmann's avatar
Daniel Wortmann committed
116 117
          
    END DO
118

Daniel Wortmann's avatar
Daniel Wortmann committed
119
    
120 121 122
    RETURN
  END SUBROUTINE hsmt
END MODULE m_hsmt