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 SUBROUTINE eigenso(eig_id,mpi,DIMENSION,stars,vacuum,atoms,sphhar,& obsolete,sym,cell,noco,input,kpts,oneD,vTot,enpara,results) USE m_types USE m_eig66_io, ONLY : read_eig,write_eig USE m_spnorb USE m_alineso USE m_judft #ifdef CPP_MPI USE m_mpi_bc_pot #endif IMPLICIT NONE 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 ! .. ! .. Scalar Arguments .. INTEGER, INTENT (IN) :: eig_id ! .. ! .. ! .. Local Scalars .. INTEGER i,j,nk,jspin,n ,l ! INTEGER n_loc,n_plus,i_plus, INTEGER n_end,nsz,nmat,n_stride LOGICAL l_socvec !,l_all INTEGER wannierspin TYPE(t_usdus):: usdus ! .. ! .. Local Arrays.. CHARACTER*3 chntype TYPE(t_rsoc) :: rsoc REAL, ALLOCATABLE :: eig_so(:) COMPLEX, ALLOCATABLE :: zso(:,:,:) TYPE(t_mat)::zmat TYPE(t_lapw)::lapw 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 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)) IF (input%l_wann.OR.l_socvec) THEN wannierspin = 2 ELSE wannierspin = input%jspins ENDIF ! !---> set up and solve the eigenvalue problem ! ---> radial k-idp s-o matrix elements calc. and storage ! #if defined(CPP_MPI) !RMA synchronization CALL MPI_BARRIER(mpi%MPI_COMM,ierr) #endif CALL timestart("eigenso: spnorb") ! .. !Get spin-orbit coupling matrix elements CALL spnorb( atoms,noco,input,mpi, enpara,vTot%mt,usdus,rsoc,.TRUE.) ! ALLOCATE( eig_so(2*DIMENSION%neigd) ) rsoc%soangl(:,:,:,:,:,:) = CONJG(rsoc%soangl(:,:,:,:,:,:)) CALL timestop("eigenso: spnorb") ! !---> loop over k-points: each can be a separate task ! !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 ! #if defined(CPP_MPI) n_stride = kpts%nkpt/mpi%n_groups #else n_stride = 1 #endif n_end = kpts%nkpt !write(*,'(4i12)') mpi%irank, mpi%n_groups, n_stride, mpi%n_start ! !---> start loop k-pts ! ! DO nk = mpi%irank+1,n_end,mpi%isize DO nk = mpi%n_start,n_end,n_stride 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) CALL timestart("eigenso: alineso") CALL alineso(eig_id,lapw, mpi,DIMENSION,atoms,sym,kpts,& input,noco,cell,oneD,nk,usdus,rsoc,nsz,nmat, eig_so,zso) 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) 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) ENDDO ! DO nk ! 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 RETURN END SUBROUTINE eigenso END MODULE m_eigenso