hsohelp.F90 5.93 KB
Newer Older
1 2 3 4 5 6
!--------------------------------------------------------------------------------
! 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.
!--------------------------------------------------------------------------------

7 8 9 10 11 12 13 14 15 16 17 18
MODULE m_hsohelp
  !
  !*********************************************************************
  ! preparation of spin-orbit matrix elements: ahelp, bhelp
  ! ahelp(i,n,l,m,jspin) =Sum_(G) (conj(c(G,i,jspin)*a(G,n,l,m,jspin))
  ! bhelp - same a|->b
  ! Original version replaced by a call to abcof. Maybe not so efficient
  ! but includes now LO's and could also be used for noco
  !                                                        gb`02
  !*********************************************************************
  !
CONTAINS
19 20
  SUBROUTINE hsohelp(DIMENSION,atoms,sym,input,lapw,nsz, cell,&
       zmat,usdus, zso,noco,oneD, ahelp,bhelp,chelp)
21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38
    !
    USE m_abcof
    USE m_types
    IMPLICIT NONE
    TYPE(t_dimension),INTENT(IN)   :: DIMENSION
    TYPE(t_oneD),INTENT(IN)        :: oneD
    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_usdus),INTENT(IN)       :: usdus
    TYPE(t_lapw),INTENT(IN)        :: lapw
    !     ..
    !     .. Scalar Arguments ..
    !     ..
    !     .. Array Arguments ..
    INTEGER, INTENT (IN) :: nsz(DIMENSION%jspd)  
39
    COMPLEX, INTENT (INOUT) :: zso(:,:,:)!DIMENSION%nbasfcn,2*DIMENSION%neigd,DIMENSION%jspd)
Daniel Wortmann's avatar
Daniel Wortmann committed
40 41 42
    COMPLEX, INTENT (OUT):: ahelp(-atoms%lmaxd:atoms%lmaxd,atoms%lmaxd,atoms%nat,DIMENSION%neigd,DIMENSION%jspd)
    COMPLEX, INTENT (OUT):: bhelp(-atoms%lmaxd:atoms%lmaxd,atoms%lmaxd,atoms%nat,DIMENSION%neigd,DIMENSION%jspd)
    COMPLEX, INTENT (OUT):: chelp(-atoms%llod :atoms%llod, DIMENSION%neigd,atoms%nlod,atoms%nat, DIMENSION%jspd)
43
    TYPE(t_mat),INTENT(IN)      :: zmat(:) ! (DIMENSION%nbasfcn,DIMENSION%neigd,DIMENSION%jspd)
44 45 46 47 48
    !-odim
    !+odim
    !     ..
    !     .. Locals ..
    TYPE(t_atoms)   :: atoms_local
49
    TYPE(t_noco)    :: noco_local
50
    TYPE(t_mat)     :: zMat_local
51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66
    INTEGER ispin ,l,n ,na,ie,lm,ll1,nv1(DIMENSION%jspd),m,lmd
    INTEGER, ALLOCATABLE :: g1(:,:),g2(:,:),g3(:,:)
    COMPLEX, ALLOCATABLE :: acof(:,:,:),bcof(:,:,:)
    !
    ! turn off the non-collinear part of abcof
    !
    noco_local=noco
    noco_local%l_ss   = .FALSE.
    lmd = atoms%lmaxd*(atoms%lmaxd+2)
    noco_local%qss(:) = 0.0
    atoms_local=atoms
    atoms_local%ngopr(:) = 1 ! use unrotated coeffs...
    !
    ! some praparations to match array sizes
    !
    nv1(1) = lapw%nv(1) ; nv1(DIMENSION%jspd) = lapw%nv(1)
Gregor Michalicek's avatar
Gregor Michalicek committed
67 68 69 70 71 72 73
    ALLOCATE (g1(DIMENSION%nvd,DIMENSION%jspd))
    ALLOCATE (g2(DIMENSION%nvd,DIMENSION%jspd))
    ALLOCATE (g3(DIMENSION%nvd,DIMENSION%jspd))
    g1 = 0 ; g2 = 0 ; g3 = 0
    g1(:SIZE(lapw%k1,1),1) = lapw%k1(:SIZE(lapw%k1,1),1) ; g1(:SIZE(lapw%k1,1),DIMENSION%jspd) = lapw%k1(:SIZE(lapw%k1,1),1)
    g2(:SIZE(lapw%k1,1),1) = lapw%k2(:SIZE(lapw%k1,1),1) ; g2(:SIZE(lapw%k1,1),DIMENSION%jspd) = lapw%k2(:SIZE(lapw%k1,1),1)
    g3(:SIZE(lapw%k1,1),1) = lapw%k3(:SIZE(lapw%k1,1),1) ; g3(:SIZE(lapw%k1,1),DIMENSION%jspd) = lapw%k3(:SIZE(lapw%k1,1),1)
74 75 76

    chelp(:,:,:,:,input%jspins) = CMPLX(0.0,0.0)

Daniel Wortmann's avatar
Daniel Wortmann committed
77
    ALLOCATE ( acof(DIMENSION%neigd,0:lmd,atoms%nat),bcof(DIMENSION%neigd,0:lmd,atoms%nat) )
78
    DO ispin = 1, input%jspins
79
       IF (zmat(1)%l_real.AND.noco%l_soc) THEN
80
          zso(:,1:DIMENSION%neigd,ispin) = CMPLX(zmat(ispin)%data_r(:,1:DIMENSION%neigd),0.0)
81
          zMat_local%l_real = .FALSE.
82 83 84 85
          zMat_local%matsize1 = zmat(1)%matsize1
          zMat_local%matsize2 = DIMENSION%neigd
          ALLOCATE(zMat_local%data_c(zmat(1)%matsize1,DIMENSION%neigd))
          zMat_local%data_c(:,:) = zso(:,1:DIMENSION%neigd,ispin)
86 87
          CALL abcof(input,atoms_local,sym,cell,lapw,nsz(ispin),&
               usdus, noco_local,ispin,oneD, acof,bcof,chelp(-atoms%llod:,:,:,:,ispin),zMat_local)
88
          DEALLOCATE(zMat_local%data_c)
89 90 91 92 93
          !
          !
          ! transfer (a,b)cofs to (a,b)helps used in hsoham
          !
          DO ie = 1, DIMENSION%neigd
Daniel Wortmann's avatar
Daniel Wortmann committed
94
             DO na = 1, atoms%nat
95 96 97 98 99 100 101
                DO l = 1, atoms%lmaxd
                   ll1 = l*(l+1)
                   DO m = -l,l
                      lm = ll1 + m
                      ahelp(m,l,na,ie,ispin) = (acof(ie,lm,na))
                      bhelp(m,l,na,ie,ispin) = (bcof(ie,lm,na))
                   ENDDO
102 103 104
                ENDDO
             ENDDO
          ENDDO
105 106
          chelp(:,:,:,:,ispin) = (chelp(:,:,:,:,ispin))
       ELSE
107
          zMat_local%l_real = zmat(1)%l_real
108 109 110 111
          zMat_local%matsize1 = zmat(1)%matsize1
          zMat_local%matsize2 = DIMENSION%neigd
          ALLOCATE(zMat_local%data_c(zmat(1)%matsize1,DIMENSION%neigd))
          zMat_local%data_c(:,:) = zmat(ispin)%data_c(:,:)
112 113
          CALL abcof(input,atoms_local,sym,cell,lapw,nsz(ispin),&
               usdus, noco_local,ispin,oneD, acof,bcof,chelp(-atoms%llod:,:,:,:,ispin),zMat_local)
114
          DEALLOCATE(zMat_local%data_c)
115 116 117 118
          !
          ! transfer (a,b)cofs to (a,b)helps used in hsoham
          !
          DO ie = 1, DIMENSION%neigd
Daniel Wortmann's avatar
Daniel Wortmann committed
119
             DO na = 1, atoms%nat
120 121 122 123 124 125 126
                DO l = 1, atoms%lmaxd
                   ll1 = l*(l+1)
                   DO m = -l,l
                      lm = ll1 + m
                      ahelp(m,l,na,ie,ispin) = (acof(ie,lm,na))
                      bhelp(m,l,na,ie,ispin) = (bcof(ie,lm,na))
                   ENDDO
127 128 129
                ENDDO
             ENDDO
          ENDDO
130
       ENDIF
131 132 133 134 135 136 137 138
       !      write(54,'(6f15.8)')(((chelp(m,ie,1,na,1),m=-1,1),ie=1,5),na=1,2)
       !      write(54,'(8f15.8)')(((acof(ie,l,na),l=0,3),ie=1,5),na=1,2)
    ENDDO    ! end of spin loop (ispin)
    !
    DEALLOCATE ( acof,bcof,g1,g2,g3 )
    RETURN
  END SUBROUTINE hsohelp
END MODULE m_hsohelp