hsohelp.F90 5.81 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
Daniel Wortmann's avatar
Daniel Wortmann committed
19
  SUBROUTINE hsohelp(DIMENSION,atoms,sym,input,lapw,nsz, cell,&
20
       zmat,usdus, zso,noco,oneD,&
21
       nat_start,nat_stop,nat_l,ahelp,bhelp,chelp)
22
    !
23
    USE m_abcof_soc
24 25
    USE m_types
    IMPLICIT NONE
26 27 28 29
#ifdef CPP_MPI
    INCLUDE 'mpif.h'
    INTEGER ierr(3)
#endif
30 31 32 33 34 35 36 37 38 39 40 41
    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 ..
    !     ..
42
    INTEGER, INTENT (IN) :: nat_start,nat_stop,nat_l
43 44
    !     .. Array Arguments ..
    INTEGER, INTENT (IN) :: nsz(DIMENSION%jspd)  
Daniel Wortmann's avatar
Daniel Wortmann committed
45
    COMPLEX, INTENT (INOUT) :: zso(:,:,:)!DIMENSION%nbasfcn,2*DIMENSION%neigd,DIMENSION%jspd)
46 47 48
    COMPLEX, INTENT (OUT):: ahelp(atoms%lmaxd*(atoms%lmaxd+2),nat_l,DIMENSION%neigd,input%jspins)
    COMPLEX, INTENT (OUT):: bhelp(atoms%lmaxd*(atoms%lmaxd+2),nat_l,DIMENSION%neigd,input%jspins)
    COMPLEX, INTENT (OUT):: chelp(-atoms%llod :atoms%llod, DIMENSION%neigd,atoms%nlod,nat_l,input%jspins)
49
    TYPE(t_mat),INTENT(IN)      :: zmat(:) ! (DIMENSION%nbasfcn,DIMENSION%neigd,DIMENSION%jspd)
50 51 52 53
    !-odim
    !+odim
    !     ..
    !     .. Locals ..
54
    TYPE(t_mat)     :: zMat_local
55 56 57 58 59 60 61 62 63 64 65
    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
    !
    lmd = atoms%lmaxd*(atoms%lmaxd+2)
    !
    ! some praparations to match array sizes
    !
    nv1(1) = lapw%nv(1) ; nv1(DIMENSION%jspd) = lapw%nv(1)
Gregor Michalicek's avatar
Gregor Michalicek committed
66 67 68 69 70 71 72
    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)
73 74 75

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

76
    ALLOCATE ( acof(DIMENSION%neigd,0:lmd,nat_l),bcof(DIMENSION%neigd,0:lmd,nat_l) )
77
    DO ispin = 1, input%jspins
78
       IF (zmat(1)%l_real.AND.noco%l_soc) THEN
79
          zso(:,1:DIMENSION%neigd,ispin) = CMPLX(zmat(ispin)%data_r(:,1:DIMENSION%neigd),0.0)
80
          zMat_local%l_real = .FALSE.
81 82 83 84
          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)
85 86
          CALL abcof_soc(input,atoms,sym,cell,lapw,nsz(ispin),&
               usdus, noco,ispin,oneD,nat_start,nat_stop,nat_l,&
87
               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
94
             DO na = 1, nat_l
95 96 97 98
                DO l = 1, atoms%lmaxd
                   ll1 = l*(l+1)
                   DO m = -l,l
                      lm = ll1 + m
99 100
                      ahelp(lm,na,ie,ispin) = (acof(ie,lm,na))
                      bhelp(lm,na,ie,ispin) = (bcof(ie,lm,na))
101
                   ENDDO
102 103 104
                ENDDO
             ENDDO
          ENDDO
105
       ELSE
106
          zMat_local%l_real = zmat(1)%l_real
107 108 109 110
          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(:,:)
111 112
          CALL abcof_soc(input,atoms,sym,cell,lapw,nsz(ispin),&
               usdus,noco,ispin,oneD,nat_start,nat_stop,nat_l,&
113
               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
119
             DO na = 1, nat_l
120 121 122 123
                DO l = 1, atoms%lmaxd
                   ll1 = l*(l+1)
                   DO m = -l,l
                      lm = ll1 + m
124 125
                      ahelp(lm,na,ie,ispin) = (acof(ie,lm,na))
                      bhelp(lm,na,ie,ispin) = (bcof(ie,lm,na))
126
                   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