eigenso.F90 6.36 KB
Newer Older
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22
MODULE m_eigenso
  !
  !*********************************************************************
  !     sets ur and solves the spin-orbit eigenvalue problem in the
  !     second variation procedure.
  !
  !     way: takes e.v. and e.f. from previous scalar-rel. calc.
  !     makes spin-orbit matrix elements solves e.v. and put it on 'eig'
  !
  !     Tree:  eigenso-|- readPotential
  !                    |- spnorb  : sets up s-o parameters 
  !                    |    |- soinit - sorad  : radial part
  !                    |    |- sgml            : diagonal angular parts
  !                    |    |- anglso          : non-diagonal -"-
  !                    |
  !                    |- alineso : sets up and solves e.v. problem
  !                         |- hsohelp
  !                         |- hsoham
  !
  !**********************************************************************
  !
CONTAINS
23
  SUBROUTINE eigenso(eig_id,mpi,DIMENSION,stars,vacuum,atoms,sphhar,&
24
                     obsolete,sym,cell,noco,input,kpts,oneD,vTot,enpara,results)
25

26
    USE m_types
27 28 29
    USE m_eig66_io, ONLY : read_eig,write_eig
    USE m_spnorb 
    USE m_alineso
30
    USE m_judft
Daniel Wortmann's avatar
Daniel Wortmann committed
31 32 33
#ifdef CPP_MPI
    USE m_mpi_bc_pot
#endif
34 35
    IMPLICIT NONE

36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51
    TYPE(t_mpi),INTENT(IN)        :: mpi
    TYPE(t_dimension),INTENT(IN)  :: DIMENSION
    TYPE(t_oneD),INTENT(IN)       :: oneD
    TYPE(t_obsolete),INTENT(IN)   :: obsolete
    TYPE(t_input),INTENT(IN)      :: input
    TYPE(t_vacuum),INTENT(IN)     :: vacuum
    TYPE(t_noco),INTENT(IN)       :: noco
    TYPE(t_sym),INTENT(IN)        :: sym
    TYPE(t_stars),INTENT(IN)      :: stars
    TYPE(t_cell),INTENT(IN)       :: cell
    TYPE(t_kpts),INTENT(IN)       :: kpts
    TYPE(t_sphhar),INTENT(IN)     :: sphhar
    TYPE(t_atoms),INTENT(IN)      :: atoms
    TYPE(t_potden),INTENT(IN)     :: vTot
    TYPE(t_enpara),INTENT(IN)     :: enpara
    TYPE(t_results),INTENT(INOUT) :: results
52 53 54 55 56

#ifdef CPP_MPI
    INCLUDE 'mpif.h'
#endif

57 58 59 60 61 62
    !     ..
    !     .. Scalar Arguments ..
    INTEGER, INTENT (IN) :: eig_id       
    !     ..
    !     ..
    !     .. Local Scalars ..
63
    INTEGER i,j,nk,nk_i,jspin,n ,l
64
    ! INTEGER n_loc,n_plus,i_plus,
65
    INTEGER nsz,nmat,n_stride
66
    LOGICAL l_socvec   !,l_all
67
    INTEGER wannierspin
68
    TYPE(t_usdus)        :: usdus
69 70 71 72
    !     ..
    !     .. Local Arrays..
    CHARACTER*3 chntype

73
    TYPE(t_rsoc) :: rsoc
74 75
    INTEGER, ALLOCATABLE :: neigBuffer(:,:)
    REAL,    ALLOCATABLE :: eig_so(:), eigBuffer(:,:,:)
76
    COMPLEX, ALLOCATABLE :: zso(:,:,:)
77

Daniel Wortmann's avatar
Daniel Wortmann committed
78 79
    TYPE(t_mat)::zmat
    TYPE(t_lapw)::lapw
80 81 82 83 84 85 86 87 88 89 90 91 92

    INTEGER :: ierr
    
    !  ..

    INQUIRE (4649,opened=l_socvec)

    ! To be consistent with angles should be redefined here!
    !noco%theta= -noco%theta
    !noco%phi=   noco%phi+pi_const
    ! now the definition of rotation matrices
    ! is equivalent to the def in the noco-routines

93 94 95 96 97
    ALLOCATE(  usdus%us(0:atoms%lmaxd,atoms%ntype,input%jspins), usdus%dus(0:atoms%lmaxd,atoms%ntype,input%jspins),&
         usdus%uds(0:atoms%lmaxd,atoms%ntype,input%jspins),usdus%duds(0:atoms%lmaxd,atoms%ntype,input%jspins),&
         usdus%ddn(0:atoms%lmaxd,atoms%ntype,input%jspins),&
         usdus%ulos(atoms%nlod,atoms%ntype,input%jspins),usdus%dulos(atoms%nlod,atoms%ntype,input%jspins),&
         usdus%uulon(atoms%nlod,atoms%ntype,input%jspins),usdus%dulon(atoms%nlod,atoms%ntype,input%jspins))
98
   
99
    IF (input%l_wann.OR.l_socvec) THEN
100 101 102 103 104 105 106
       wannierspin = 2
    ELSE
       wannierspin = input%jspins
    ENDIF

    !
    !---> set up and solve the eigenvalue problem
107
    ! --->    radial k-idp s-o matrix elements calc. and storage
108 109 110 111 112 113 114 115
    !
#if defined(CPP_MPI)
    !RMA synchronization
    CALL MPI_BARRIER(mpi%MPI_COMM,ierr)
#endif
    CALL timestart("eigenso: spnorb")
    !  ..

116 117
    !Get spin-orbit coupling matrix elements
    CALL spnorb( atoms,noco,input,mpi, enpara,vTot%mt,usdus,rsoc,.TRUE.)
118 119 120
    !


121 122 123 124 125 126 127
    ALLOCATE (eig_so(2*DIMENSION%neigd))
    ALLOCATE (eigBuffer(2*DIMENSION%neigd,kpts%nkpt,wannierspin))
    ALLOCATE (neigBuffer(kpts%nkpt,wannierspin))
    results%eig = 1.0e300
    eigBuffer = 1.0e300
    results%neig = 0
    neigBuffer = 0
128
    rsoc%soangl(:,:,:,:,:,:) = CONJG(rsoc%soangl(:,:,:,:,:,:))
129 130 131
    CALL timestop("eigenso: spnorb")
    !
    !--->    loop over k-points: each can be a separate task
132 133 134
    !DO nk_i=1,SIZE(mpi%k_list)
        nk=mpi%k_list(nk_i)
     !DO nk = mpi%n_start,n_end,n_stride
Daniel Wortmann's avatar
Daniel Wortmann committed
135 136 137
       CALL lapw%init(input,noco, kpts,atoms,sym,nk,cell,.FALSE., mpi)
       ALLOCATE( zso(lapw%nv(1)+atoms%nlotot,2*DIMENSION%neigd,wannierspin))
       zso(:,:,:) = CMPLX(0.0,0.0)
138
       CALL timestart("eigenso: alineso")
139
       CALL alineso(eig_id,lapw, mpi,DIMENSION,atoms,sym,kpts,&
140
            input,noco,cell,oneD,nk,usdus,rsoc,nsz,nmat, eig_so,zso)
141 142
       CALL timestop("eigenso: alineso")
       IF (mpi%irank.EQ.0) THEN
143 144
          WRITE (6,FMT=8010) nk,nsz
          WRITE (6,FMT=8020) (eig_so(i),i=1,nsz)
145 146 147 148 149
       ENDIF
8010   FORMAT (1x,/,/,' #k=',i6,':',/,&
            ' the',i4,' SOC eigenvalues are:')
8020   FORMAT (5x,5f12.6)

150 151 152
       IF (mpi%n_rank==0) THEN
          IF (input%eonly) THEN
             CALL write_eig(eig_id, nk,jspin,neig=nsz,neig_total=nsz, eig=eig_so(:nsz))
153 154 155 156
             STOP 'jspin is undefined here (eigenso - eonly branch)'
             eigBuffer(:nsz,nk,jspin) = eig_so(:nsz)
             neigBuffer(nk,jspin) = nsz
          ELSE
157 158 159 160 161
             CALL zmat%alloc(.FALSE.,SIZE(zso,1),nsz)
             DO jspin = 1,wannierspin
                CALL timestart("eigenso: write_eig")  
                zmat%data_c=zso(:,:nsz,jspin)
                CALL write_eig(eig_id, nk,jspin,neig=nsz,neig_total=nsz, eig=eig_so(:nsz),zmat=zmat)
162 163 164
                eigBuffer(:nsz,nk,jspin) = eig_so(:nsz)
                neigBuffer(nk,jspin) = nsz
                CALL timestop("eigenso: write_eig")
165 166 167 168
             ENDDO
          ENDIF ! (input%eonly) ELSE
       ENDIF ! n_rank == 0
       DEALLOCATE (zso)
169
    ENDDO ! DO nk 
170 171

#ifdef CPP_MPI
172 173 174 175 176 177 178
    CALL MPI_ALLREDUCE(neigBuffer,results%neig,kpts%nkpt*wannierspin,MPI_INTEGER,MPI_SUM,mpi%mpi_comm,ierr)
    CALL MPI_ALLREDUCE(eigBuffer(:2*dimension%neigd,:,:),results%eig(:2*dimension%neigd,:,:),&
                       2*dimension%neigd*kpts%nkpt*wannierspin,MPI_DOUBLE_PRECISION,MPI_MIN,mpi%mpi_comm,ierr)
    CALL MPI_BARRIER(mpi%MPI_COMM,ierr)
#else
    results%neig(:,:) = neigBuffer(:,:)
    results%eig(:2*dimension%neigd,:,:) = eigBuffer(:2*dimension%neigd,:,:)
179 180
#endif

181 182 183
    RETURN
  END SUBROUTINE eigenso
END MODULE m_eigenso