eigenso.F90 6.2 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
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 57
    !     ..
    !     .. Scalar Arguments ..
    INTEGER, INTENT (IN) :: eig_id       
    !     ..
    !     ..
    !     .. Local Scalars ..
58
    INTEGER i,j,nk,jspin,n ,l
59 60
    ! INTEGER n_loc,n_plus,i_plus,
    INTEGER n_end,nsz,nmat,n_stride
61
    LOGICAL l_socvec   !,l_all
62 63 64 65 66 67
    INTEGER wannierspin
    TYPE(t_usdus):: usdus
    !     ..
    !     .. Local Arrays..
    CHARACTER*3 chntype

68
    TYPE(t_rsoc) :: rsoc
69
    REAL,    ALLOCATABLE :: eig_so(:) 
70
    COMPLEX, ALLOCATABLE :: zso(:,:,:)
71

72 73
    TYPE(t_mat)::zmat
    TYPE(t_lapw)::lapw
74 75 76 77 78 79 80 81 82 83 84 85 86

    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

87 88 89 90 91
    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))
92
   
93
    IF (input%l_wann.OR.l_socvec) THEN
94 95 96 97 98 99 100
       wannierspin = 2
    ELSE
       wannierspin = input%jspins
    ENDIF

    !
    !---> set up and solve the eigenvalue problem
101
    ! --->    radial k-idp s-o matrix elements calc. and storage
102 103 104 105 106 107 108 109
    !
#if defined(CPP_MPI)
    !RMA synchronization
    CALL MPI_BARRIER(mpi%MPI_COMM,ierr)
#endif
    CALL timestart("eigenso: spnorb")
    !  ..

110 111
    !Get spin-orbit coupling matrix elements
    CALL spnorb( atoms,noco,input,mpi, enpara,vTot%mt,usdus,rsoc,.TRUE.)
112 113 114
    !


115
    ALLOCATE( eig_so(2*DIMENSION%neigd) )
116
    rsoc%soangl(:,:,:,:,:,:) = CONJG(rsoc%soangl(:,:,:,:,:,:))
117 118 119 120
    CALL timestop("eigenso: spnorb")
    !
    !--->    loop over k-points: each can be a separate task
    !
121 122 123 124 125 126
    !n_loc = INT(kpts%nkpt/mpi%isize)
    !n_plus = kpts%nkpt - mpi%isize*n_loc
    !i_plus = -1
    !IF (mpi%irank.LT.n_plus) i_plus = 0
    !n_end = (mpi%irank+1)+(n_loc+i_plus)*mpi%isize
    !
127
#if defined(CPP_MPI)
128
     n_stride = kpts%nkpt/mpi%n_groups
129 130 131
#else
     n_stride = 1
#endif
132
     n_end = kpts%nkpt
133
    !write(*,'(4i12)') mpi%irank, mpi%n_groups, n_stride, mpi%n_start
134 135 136
    !
    !--->  start loop k-pts
    !
137 138
    ! DO  nk = mpi%irank+1,n_end,mpi%isize
     DO nk = mpi%n_start,n_end,n_stride
139 140 141
       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)
142
       CALL timestart("eigenso: alineso")
143
       CALL alineso(eig_id,lapw, mpi,DIMENSION,atoms,sym,kpts,&
144
            input,noco,cell,oneD,nk,usdus,rsoc,nsz,nmat, eig_so,zso)
145 146 147 148 149 150 151 152 153
       CALL timestop("eigenso: alineso")
       IF (mpi%irank.EQ.0) THEN
          WRITE (16,FMT=8010) nk,nsz
          WRITE (16,FMT=8020) (eig_so(i),i=1,nsz)
       ENDIF
8010   FORMAT (1x,/,/,' #k=',i6,':',/,&
            ' the',i4,' SOC eigenvalues are:')
8020   FORMAT (5x,5f12.6)

154 155 156 157 158 159 160 161 162 163 164 165 166 167 168
       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))
          ELSE          
             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)
   
                CALL timestop("eigenso: write_eig")  
             ENDDO
          ENDIF ! (input%eonly) ELSE
       ENDIF ! n_rank == 0
       DEALLOCATE (zso)
169
    ENDDO ! DO nk 
170 171 172 173 174 175 176 177 178 179 180 181 182

    ! Sorry for the following strange workaround to fill the results%neig and results%eig arrays.
    ! At some point someone should have a closer look at how the eigenvalues are
    ! distributed and fill the arrays without using the eigenvalue-IO.
    DO jspin = 1, wannierspin
       DO nk = 1,kpts%nkpt
          CALL read_eig(eig_id,nk,jspin,results%neig(nk,jspin),results%eig(:,nk,jspin))
#ifdef CPP_MPI
          CALL MPI_BARRIER(mpi%MPI_COMM,ierr)
#endif
       END DO
    END DO

183 184 185
    RETURN
  END SUBROUTINE eigenso
END MODULE m_eigenso