spnorb.f90 4.98 KB
Newer Older
1 2 3 4 5 6 7 8
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
9
  SUBROUTINE spnorb(atoms,noco,input,mpi, enpara, vr, rsopp,rsoppd,rsopdp,rsopdpd,&
10 11 12 13 14 15 16 17 18 19 20 21 22 23
       usdus, rsoplop,rsoplopd,rsopdplo,rsopplo,rsoploplop, soangl)

    USE m_anglso
    USE m_sgml
    USE m_soinit 
    USE m_types
    IMPLICIT NONE

    TYPE(t_mpi),INTENT(IN)   :: mpi

    TYPE(t_enpara),INTENT(IN)   :: enpara
    TYPE(t_input),INTENT(IN)    :: input
    TYPE(t_noco),INTENT(IN)     :: noco
    TYPE(t_atoms),INTENT(IN)    :: atoms
24
    TYPE(t_usdus),INTENT(INOUT)   :: usdus
25 26 27
    !     ..
    !     ..
    !     .. Array Arguments ..
Daniel Wortmann's avatar
Daniel Wortmann committed
28 29 30 31 32 33 34 35 36 37
    REAL,    INTENT (IN) :: vr(:,0:,:,:) !(atoms%jmtd,0:sphhar%nlhd,atoms%ntype,dimension%jspd)
    REAL,    INTENT (OUT) :: rsopp  (atoms%ntype,atoms%lmaxd,2,2)
    REAL,    INTENT (OUT) :: rsoppd (atoms%ntype,atoms%lmaxd,2,2)
    REAL,    INTENT (OUT) :: rsopdp (atoms%ntype,atoms%lmaxd,2,2)
    REAL,    INTENT (OUT) :: rsopdpd(atoms%ntype,atoms%lmaxd,2,2)
    REAL,    INTENT (OUT) :: rsoplop (atoms%ntype,atoms%nlod,2,2)
    REAL,    INTENT (OUT) :: rsoplopd(atoms%ntype,atoms%nlod,2,2)
    REAL,    INTENT (OUT) :: rsopdplo(atoms%ntype,atoms%nlod,2,2)
    REAL,    INTENT (OUT) :: rsopplo (atoms%ntype,atoms%nlod,2,2)
    REAL,    INTENT (OUT) :: rsoploplop(atoms%ntype,atoms%nlod,atoms%nlod,2,2)
38 39 40 41 42 43 44 45 46 47 48 49
    COMPLEX, INTENT (OUT) :: soangl(atoms%lmaxd,-atoms%lmaxd:atoms%lmaxd,2,&
         atoms%lmaxd,-atoms%lmaxd:atoms%lmaxd,2)
    !     ..
    !     .. Local Scalars ..
    INTEGER is1,is2,jspin1,jspin2,l,l1,l2,m1,m2,n
    !     ..
    !     .. Local Arrays ..
    INTEGER ispjsp(2)
    !     ..
    !     ..
    DATA ispjsp/1,-1/

50 51 52
    CALL soinit(atoms,input,enpara, vr,noco%soc_opt(atoms%ntype+2), &
         rsopp,rsoppd,rsopdp,rsopdpd, usdus,rsoplop,rsoplopd,rsopdplo,&
         rsopplo,rsoploplop)
53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145
    !
    IF (mpi%irank.EQ.0) THEN
       DO n = 1,atoms%ntype
          WRITE (6,FMT=8000)
          WRITE (6,FMT=9000)
          WRITE (6,FMT=8001) (2*rsopp(n,l,1,1),l=1,3)
          WRITE (6,FMT=8001) (2*rsopp(n,l,2,2),l=1,3)
          WRITE (6,FMT=8001) (2*rsopp(n,l,2,1),l=1,3)
          WRITE (6,FMT=8000)
          WRITE (6,FMT=9000)
          WRITE (6,FMT=8001) (2*rsoppd(n,l,1,1),l=1,3)
          WRITE (6,FMT=8001) (2*rsoppd(n,l,2,2),l=1,3)
          WRITE (6,FMT=8001) (2*rsoppd(n,l,2,1),l=1,3)
          WRITE (6,FMT=8000)
          WRITE (6,FMT=9000)
          WRITE (6,FMT=8001) (2*rsopdp(n,l,1,1),l=1,3)
          WRITE (6,FMT=8001) (2*rsopdp(n,l,2,2),l=1,3)
          WRITE (6,FMT=8001) (2*rsopdp(n,l,2,1),l=1,3)
          WRITE (6,FMT=8000)
          WRITE (6,FMT=9000)
          WRITE (6,FMT=8001) (2*rsopdpd(n,l,1,1),l=1,3)
          WRITE (6,FMT=8001) (2*rsopdpd(n,l,2,2),l=1,3)
          WRITE (6,FMT=8001) (2*rsopdpd(n,l,2,1),l=1,3)
       ENDDO
    ENDIF
8000 FORMAT (' spin - orbit parameter HR  ')
8001 FORMAT (8f8.4)
9000 FORMAT (5x,' p ',5x,' d ', 5x, ' f ')
    !

    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
          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
                         soangl(l1,m1,jspin1,l2,m2,jspin2) =&
                              CMPLX(sgml(l1,m1,is1,l2,m2,is2),0.0)
                      ENDDO
                   ENDDO
                ENDDO
             ENDDO
          ENDDO
       ENDDO

    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
                         soangl(l1,m1,jspin1,l2,m2,jspin2) =&
                              anglso(noco%theta,noco%phi,l1,m1,is1,l2,m2,is2)
                      ENDDO
                   ENDDO
                   !
                ENDDO
             ENDDO
          ENDDO
       ENDDO
       !
    ENDIF

    IF (mpi%irank.EQ.0) THEN
       WRITE (6,FMT=8002)
       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)
             WRITE (6,FMT=8003) (m2, (soangl(3,m1,jspin1,3,m2,jspin2),&
                  m1=-3,3,1),m2=-3,3,1)
          ENDDO
       ENDDO
    ENDIF

8002 FORMAT (' so - angular matrix elements ')
8003 FORMAT (i8,14f8.4)

  END SUBROUTINE spnorb
END MODULE m_spnorb