spnorb.f90 6.03 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
MODULE m_spnorb
  !*********************************************************************
  !     calls soinit to calculate the radial spin-orbit matrix elements:
  !     rsopp,rsopdpd,rsoppd,rsopdp
  !     and sets up the so - angular matrix elements (soangl)
  !     using the functions anglso and sgml.
  !*********************************************************************
CONTAINS
15
  SUBROUTINE spnorb(atoms,noco,input,mpi, enpara, vr, usdus, rsoc,l_angles)
16 17 18

    USE m_anglso
    USE m_sgml
19
    USE m_sorad 
20 21 22
    USE m_types
    IMPLICIT NONE

23
    TYPE(t_mpi),INTENT(IN)      :: mpi
24 25 26 27
    TYPE(t_enpara),INTENT(IN)   :: enpara
    TYPE(t_input),INTENT(IN)    :: input
    TYPE(t_noco),INTENT(IN)     :: noco
    TYPE(t_atoms),INTENT(IN)    :: atoms
28 29 30
    TYPE(t_usdus),INTENT(INOUT) :: usdus
    TYPE(t_rsoc),INTENT(OUT)    :: rsoc
    LOGICAL,INTENT(IN)          :: l_angles
31 32 33
    !     ..
    !     ..
    !     .. Array Arguments ..
Daniel Wortmann's avatar
Daniel Wortmann committed
34
    REAL,    INTENT (IN) :: vr(:,0:,:,:) !(atoms%jmtd,0:sphhar%nlhd,atoms%ntype,dimension%jspd)
35 36
    !     ..
    !     .. Local Scalars ..
37
    INTEGER is1,is2,jspin1,jspin2,l,l1,l2,m1,m2,n
38
    LOGICAL, SAVE :: first_k = .TRUE.
39 40 41 42 43 44 45
    !     ..
    !     .. Local Arrays ..
    INTEGER ispjsp(2)
    !     ..
    !     ..
    DATA ispjsp/1,-1/

46 47 48 49 50 51 52 53 54 55 56
    !Allocate space for SOC matrix elements; set to zero at the same time
    ALLOCATE(rsoc%rsopp  (atoms%ntype,atoms%lmaxd,2,2));rsoc%rsopp =0.0
    ALLOCATE(rsoc%rsoppd (atoms%ntype,atoms%lmaxd,2,2));rsoc%rsoppd=0.0
    ALLOCATE(rsoc%rsopdp (atoms%ntype,atoms%lmaxd,2,2));rsoc%rsopdp=0.0
    ALLOCATE(rsoc%rsopdpd(atoms%ntype,atoms%lmaxd,2,2));rsoc%rsopdpd=0.0
    ALLOCATE(rsoc%rsoplop (atoms%ntype,atoms%nlod,2,2));rsoc%rsoplop=0.0
    ALLOCATE(rsoc%rsoplopd(atoms%ntype,atoms%nlod,2,2));rsoc%rsoplopd=0.0
    ALLOCATE(rsoc%rsopdplo(atoms%ntype,atoms%nlod,2,2));rsoc%rsopdplo=0.0
    ALLOCATE(rsoc%rsopplo (atoms%ntype,atoms%nlod,2,2));rsoc%rsopplo=0.0
    ALLOCATE(rsoc%rsoploplop(atoms%ntype,atoms%nlod,atoms%nlod,2,2));rsoc%rsoploplop=0.0
    IF (l_angles) ALLOCATE(rsoc%soangl(atoms%lmaxd,-atoms%lmaxd:atoms%lmaxd,2,&
57
         atoms%lmaxd,-atoms%lmaxd:atoms%lmaxd,2))
58 59 60 61 62 63

    !Calculate radial soc-matrix elements
    DO n = 1,atoms%ntype
       CALL sorad(atoms,input,n,vr(:atoms%jri(n),0,n,:),enpara,noco%l_spav,rsoc,usdus)
    END DO
    
64
    !
65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82
    !Scale SOC 
    DO n= 1,atoms%ntype
       IF (ABS(noco%socscale(n)-1)>1E-5) THEN
          IF (mpi%irank==0) WRITE(6,"(a,i0,a,f10.8)") "Scaled SOC for atom ",n," by ",noco%socscale(n)
          rsoc%rsopp(n,:,:,:)    = rsoc%rsopp(n,:,:,:)*noco%socscale(n)
          rsoc%rsopdp(n,:,:,:)   = rsoc%rsopdp(n,:,:,:)*noco%socscale(n)
          rsoc%rsoppd(n,:,:,:)   = rsoc%rsoppd(n,:,:,:)*noco%socscale(n)
          rsoc%rsopdpd(n,:,:,:)  = rsoc%rsopdpd(n,:,:,:)*noco%socscale(n)
          rsoc%rsoplop(n,:,:,:)  = rsoc%rsoplop(n,:,:,:)*noco%socscale(n)
          rsoc%rsoplopd(n,:,:,:) = rsoc%rsoplopd(n,:,:,:)*noco%socscale(n)
          rsoc%rsopdplo(n,:,:,:) = rsoc%rsopdplo(n,:,:,:)*noco%socscale(n)
          rsoc%rsopplo(n,:,:,:)  = rsoc%rsopplo(n,:,:,:)*noco%socscale(n)
          rsoc%rsoploplop(n,:,:,:,:) = rsoc%rsoploplop(n,:,:,:,:)*noco%socscale(n)
       ENDIF
    ENDDO
    
    !DO some IO into out file
      IF ((first_k).AND.(mpi%irank.EQ.0)) THEN
83 84 85
       DO n = 1,atoms%ntype
          WRITE (6,FMT=8000)
          WRITE (6,FMT=9000)
86 87 88
          WRITE (6,FMT=8001) (2*rsoc%rsopp(n,l,1,1),l=1,3)
          WRITE (6,FMT=8001) (2*rsoc%rsopp(n,l,2,2),l=1,3)
          WRITE (6,FMT=8001) (2*rsoc%rsopp(n,l,2,1),l=1,3)
89
       ENDDO
90 91 92 93
       IF (noco%l_spav) THEN
          WRITE(6,fmt='(A)') 'SOC Hamiltonian is constructed by neglecting B_xc.'
       ENDIF
       first_k=.FALSE.
94 95 96 97 98 99
    ENDIF
8000 FORMAT (' spin - orbit parameter HR  ')
8001 FORMAT (8f8.4)
9000 FORMAT (5x,' p ',5x,' d ', 5x, ' f ')
    !

100 101 102
    IF (.NOT.l_angles) RETURN

    
103 104 105 106 107
    IF ((ABS(noco%theta).LT.0.00001).AND.(ABS(noco%phi).LT.0.00001)) THEN
       !
       !       TEST for real function sgml(l1,m1,is1,l2,m2,is2)
       !
       DO l1 = 1,atoms%lmaxd
108 109 110 111 112 113 114
          DO l2 = 1,atoms%lmaxd
             DO jspin1 = 1,2
                DO jspin2 = 1,2
                   is1=ispjsp(jspin1)
                   is2=ispjsp(jspin2)
                   DO m1 = -l1,l1,1
                      DO m2 = -l2,l2,1
115
                         rsoc%soangl(l1,m1,jspin1,l2,m2,jspin2) =&
116 117 118 119 120 121 122
                              CMPLX(sgml(l1,m1,is1,l2,m2,is2),0.0)
                      ENDDO
                   ENDDO
                ENDDO
             ENDDO
          ENDDO
       ENDDO
123
       
124 125 126 127 128 129 130 131 132 133 134 135 136
    ELSE
       !
       !       TEST for complex function anglso(teta,phi,l1,m1,is1,l2,m2,is2)
       ! 
       DO l1 = 1,atoms%lmaxd
          DO l2 = 1,atoms%lmaxd
             DO jspin1 = 1,2
                DO jspin2 = 1,2
                   is1=ispjsp(jspin1)
                   is2=ispjsp(jspin2)
                   !
                   DO m1 = -l1,l1,1
                      DO m2 = -l2,l2,1
137 138
                         rsoc%soangl(l1,m1,jspin1,l2,m2,jspin2) =&
                              anglso(noco%theta,noco%phi,l1,m1,is1,l2,m2,is2)
139 140 141 142 143 144 145 146 147
                      ENDDO
                   ENDDO
                   !
                ENDDO
             ENDDO
          ENDDO
       ENDDO
       !
    ENDIF
148
    
149
    IF (mpi%irank.EQ.0) THEN
150
       WRITE (6,FMT=8002) 
151 152 153 154
       DO jspin1 = 1,2
          DO jspin2 = 1,2
             WRITE (6,FMT=*) 'd-states:is1=',jspin1,',is2=',jspin2
             WRITE (6,FMT='(7x,7i8)') (m1,m1=-3,3,1)
155
             WRITE (6,FMT=8003) (m2, (rsoc%soangl(3,m1,jspin1,3,m2,jspin2),&
156 157 158 159
                  m1=-3,3,1),m2=-3,3,1)
          ENDDO
       ENDDO
    ENDIF
160
8002 FORMAT (' so - angular matrix elements')
161 162 163 164
8003 FORMAT (i8,14f8.4)

  END SUBROUTINE spnorb
END MODULE m_spnorb