Commit 401d204f authored by Gregor Michalicek's avatar Gregor Michalicek

More cleanup in cdn/cdnval.F90

parent b7cf3c84
...@@ -73,7 +73,7 @@ CONTAINS ...@@ -73,7 +73,7 @@ CONTAINS
USE m_Ekwritesl ! and write to file. USE m_Ekwritesl ! and write to file.
USE m_abcrot2 USE m_abcrot2
USE m_doswrite USE m_doswrite
USE m_cdnread, ONLY : cdn_read0, cdn_read USE m_eig66_io, ONLY : read_eig
USE m_corespec, only : l_cs ! calculation of core spectra (EELS) USE m_corespec, only : l_cs ! calculation of core spectra (EELS)
USE m_corespec_io, only : corespec_init USE m_corespec_io, only : corespec_init
USE m_corespec_eval, only : corespec_gaunt,corespec_rme,corespec_dos,corespec_ddscs USE m_corespec_eval, only : corespec_gaunt,corespec_rme,corespec_dos,corespec_ddscs
...@@ -112,23 +112,20 @@ CONTAINS ...@@ -112,23 +112,20 @@ CONTAINS
#ifdef CPP_MPI #ifdef CPP_MPI
INCLUDE 'mpif.h' INCLUDE 'mpif.h'
LOGICAL :: mpi_flag, mpi_status
#endif #endif
! .. Local Scalars .. ! .. Local Scalars ..
INTEGER :: llpd,ikpt,jsp_start,jsp_end,ispin,jsp INTEGER :: ikpt,jsp_start,jsp_end,ispin,jsp
INTEGER :: i,ie,iv,ivac,j,k,l,n,ilo,isp,nbands,noccbd INTEGER :: i,ie,ivac,j,k,l,n,ilo,nbands,noccbd
INTEGER :: skip_t,skip_tt INTEGER :: skip_t,skip_tt
INTEGER :: nStart,nEnd,nbasfcn INTEGER :: nStart,nEnd,nbasfcn
LOGICAL :: l_fmpl,l_evp,l_orbcomprot,l_real, l_write LOGICAL :: l_fmpl,l_evp,l_orbcomprot,l_real, l_write
! ...Local Arrays ..
INTEGER :: noccbd_in(kpts%nkpt)
INTEGER :: nStart_in(kpts%nkpt)
INTEGER :: nEnd_in(kpts%nkpt)
REAL :: eig(dimension%neigd)
! ...Local Arrays ..
INTEGER, ALLOCATABLE :: gvac1d(:),gvac2d(:) INTEGER, ALLOCATABLE :: gvac1d(:),gvac2d(:)
INTEGER, ALLOCATABLE :: jsym(:),ksym(:) INTEGER, ALLOCATABLE :: jsym(:),ksym(:)
REAL, ALLOCATABLE :: we(:) REAL, ALLOCATABLE :: we(:)
REAL, ALLOCATABLE :: eig(:)
REAL, ALLOCATABLE :: f(:,:,:,:),g(:,:,:,:),flo(:,:,:,:) ! radial functions REAL, ALLOCATABLE :: f(:,:,:,:),g(:,:,:,:),flo(:,:,:,:) ! radial functions
TYPE (t_lapw) :: lapw TYPE (t_lapw) :: lapw
...@@ -145,7 +142,6 @@ CONTAINS ...@@ -145,7 +142,6 @@ CONTAINS
l_real = sym%invs.AND.(.NOT.noco%l_soc).AND.(.NOT.noco%l_noco) l_real = sym%invs.AND.(.NOT.noco%l_soc).AND.(.NOT.noco%l_noco)
llpd=(atoms%lmaxd*(atoms%lmaxd+3))/2
!---> l_fmpl is meant as a switch to to a plot of the full magnet. !---> l_fmpl is meant as a switch to to a plot of the full magnet.
!---> density without the atomic sphere approximation for the magnet. !---> density without the atomic sphere approximation for the magnet.
!---> density. It is not completely implemented (lo's missing). !---> density. It is not completely implemented (lo's missing).
...@@ -223,18 +219,18 @@ CONTAINS ...@@ -223,18 +219,18 @@ CONTAINS
skip_tt = dot_product(enpara%skiplo(:atoms%ntype,jspin),atoms%neq(:atoms%ntype)) skip_tt = dot_product(enpara%skiplo(:atoms%ntype,jspin),atoms%neq(:atoms%ntype))
IF (noco%l_soc.OR.noco%l_noco) skip_tt = 2 * skip_tt IF (noco%l_soc.OR.noco%l_noco) skip_tt = 2 * skip_tt
ALLOCATE (we(MAXVAL(cdnvalKLoop%noccbd(:)))) ALLOCATE (we(MAXVAL(cdnvalKLoop%noccbd(:))))
ALLOCATE (eig(MAXVAL(cdnvalKLoop%noccbd(:))))
jsp = MERGE(1,jspin,noco%l_noco) jsp = MERGE(1,jspin,noco%l_noco)
DO ikpt = cdnvalKLoop%ikptStart, cdnvalKLoop%nkptExtended, cdnvalKLoop%ikptIncrement DO ikpt = cdnvalKLoop%ikptStart, cdnvalKLoop%nkptExtended, cdnvalKLoop%ikptIncrement
IF (ikpt.GT.kpts%nkpt) THEN IF (ikpt.GT.kpts%nkpt) THEN
#ifdef CPP_MPI #ifdef CPP_MPI
! Synchronizes the RMA operations CALL MPI_BARRIER(mpi%mpi_comm,ie) ! Synchronizes the RMA operations
CALL MPI_BARRIER(mpi%mpi_comm,ie)
#endif #endif
EXIT EXIT
END IF END IF
! -> Gu test: distribute ev's among the processors...
CALL lapw%init(input,noco, kpts,atoms,sym,ikpt,cell,.false., mpi) CALL lapw%init(input,noco, kpts,atoms,sym,ikpt,cell,.false., mpi)
skip_t = skip_tt skip_t = skip_tt
noccbd = cdnvalKLoop%noccbd(ikpt) noccbd = cdnvalKLoop%noccbd(ikpt)
...@@ -242,12 +238,8 @@ CONTAINS ...@@ -242,12 +238,8 @@ CONTAINS
nEnd = cdnvalKLoop%nEnd(ikpt) nEnd = cdnvalKLoop%nEnd(ikpt)
we=0.0 we=0.0
IF(noccbd.GT.0) THEN IF(noccbd.GT.0) we(1:noccbd) = results%w_iks(nStart:nEnd,ikpt,jsp)
we(1:noccbd) = results%w_iks(nStart:nEnd,ikpt,jsp) IF ((sliceplot%slice).AND.(input%pallst)) we(:) = kpts%wtkpt(ikpt)
END IF
IF ((sliceplot%slice).AND.(input%pallst)) THEN
we(:) = kpts%wtkpt(ikpt)
END IF
IF (cdnvalKLoop%l_evp) THEN IF (cdnvalKLoop%l_evp) THEN
IF (nStart > skip_tt) skip_t = 0 IF (nStart > skip_tt) skip_t = 0
...@@ -257,20 +249,16 @@ CONTAINS ...@@ -257,20 +249,16 @@ CONTAINS
nbasfcn = MERGE(lapw%nv(1)+lapw%nv(2)+2*atoms%nlotot,lapw%nv(1)+atoms%nlotot,noco%l_noco) nbasfcn = MERGE(lapw%nv(1)+lapw%nv(2)+2*atoms%nlotot,lapw%nv(1)+atoms%nlotot,noco%l_noco)
CALL zMat%init(l_real,nbasfcn,noccbd) CALL zMat%init(l_real,nbasfcn,noccbd)
CALL cdn_read(eig_id,dimension%nvd,dimension%jspd,mpi%irank,mpi%isize,& CALL read_eig(eig_id,ikpt,jsp,n_start=nStart,n_end=nEnd,neig=nbands,zmat=zMat)
ikpt,jspin,zmat%nbasfcn,noco%l_ss,noco%l_noco,&
noccbd,nStart,nEnd,nbands,eig,zMat)
#ifdef CPP_MPI #ifdef CPP_MPI
! Synchronizes the RMA operations CALL MPI_BARRIER(mpi%mpi_comm,ie) ! Synchronizes the RMA operations
CALL MPI_BARRIER(mpi%mpi_comm,ie)
#endif #endif
eig(1:noccbd) = results%eig(nStart:nEnd,ikpt,jsp) eig(1:noccbd) = results%eig(nStart:nEnd,ikpt,jsp)
IF (vacuum%nstm.EQ.3.AND.input%film) THEN IF (vacuum%nstm.EQ.3.AND.input%film) THEN
CALL nstm3(sym,atoms,vacuum,stars,ikpt,lapw%nv(jspin),input,jspin,kpts,& CALL nstm3(sym,atoms,vacuum,stars,lapw,ikpt,input,jspin,kpts,&
cell,kpts%wtkpt(ikpt),lapw%k1(:,jspin),lapw%k2(:,jspin),& cell,enpara%evac0(1,jspin),vTot%vacz(:,:,jspin),gvac1d,gvac2d)
enpara%evac0(1,jspin),vTot%vacz(:,:,jspin),gvac1d,gvac2d)
END IF END IF
IF (noccbd.EQ.0) GO TO 199 IF (noccbd.EQ.0) GO TO 199
...@@ -386,14 +374,8 @@ CONTAINS ...@@ -386,14 +374,8 @@ CONTAINS
!---> and write the information to the files dosinp and vacdos !---> and write the information to the files dosinp and vacdos
!---> for dos and bandstructure plots !---> for dos and bandstructure plots
!--dw parallel writing of vacdos,dosinp....
! write data to direct access file first, write to formated file later by PE 0 only!
!--dw since z is no longer an argument of cdninf sympsi has to be called here! !--dw since z is no longer an argument of cdninf sympsi has to be called here!
IF (banddos%ndir.GT.0) CALL sympsi(lapw,jspin,sym,dimension,nbands,cell,eig,noco,ksym,jsym,zMat)
IF (banddos%ndir.GT.0) THEN
CALL sympsi(lapw%bkpt,lapw%nv(jspin),lapw%k1(:,jspin),lapw%k2(:,jspin),&
lapw%k3(:,jspin),sym,dimension,nbands,cell,eig,noco, ksym,jsym,zMat)
END IF
CALL write_dos(eig_id,ikpt,jspin,regCharges,slab,orbcomp,ksym,jsym,mcd%mcd) CALL write_dos(eig_id,ikpt,jspin,regCharges,slab,orbcomp,ksym,jsym,mcd%mcd)
...@@ -404,7 +386,7 @@ CONTAINS ...@@ -404,7 +386,7 @@ CONTAINS
#ifdef CPP_MPI #ifdef CPP_MPI
CALL timestart("cdnval: mpi_col_den") CALL timestart("cdnval: mpi_col_den")
DO ispin = jsp_start,jsp_end DO ispin = jsp_start,jsp_end
CALL mpi_col_den(mpi,sphhar,atoms,oneD,stars,vacuum,input,noco,l_fmpl,ispin,llpd,regCharges,& CALL mpi_col_den(mpi,sphhar,atoms,oneD,stars,vacuum,input,noco,l_fmpl,ispin,regCharges,&
results,denCoeffs,orb,denCoeffsOffdiag,den,den%mmpMat(:,:,:,jspin)) results,denCoeffs,orb,denCoeffsOffdiag,den,den%mmpMat(:,:,:,jspin))
END DO END DO
CALL timestop("cdnval: mpi_col_den") CALL timestop("cdnval: mpi_col_den")
...@@ -412,8 +394,7 @@ CONTAINS ...@@ -412,8 +394,7 @@ CONTAINS
IF (mpi%irank==0) THEN IF (mpi%irank==0) THEN
CALL cdnmt(dimension%jspd,atoms,sphhar,noco,l_fmpl,jsp_start,jsp_end,& CALL cdnmt(dimension%jspd,atoms,sphhar,noco,l_fmpl,jsp_start,jsp_end,&
enpara%el0,enpara%ello0,vTot%mt(:,0,:,:),denCoeffs,& enpara,vTot%mt(:,0,:,:),denCoeffs,usdus,orb,denCoeffsOffdiag,moments,den%mt)
usdus,orb,denCoeffsOffdiag,moments,den%mt)
IF(l_cs) CALL corespec_ddscs(jspin,input%jspins) IF(l_cs) CALL corespec_ddscs(jspin,input%jspins)
...@@ -459,7 +440,7 @@ CONTAINS ...@@ -459,7 +440,7 @@ CONTAINS
END IF ! end of (mpi%irank==0) END IF ! end of (mpi%irank==0)
#ifdef CPP_MPI #ifdef CPP_MPI
CALL MPI_BARRIER(mpi%mpi_comm,ie) CALL MPI_BARRIER(mpi%mpi_comm,ie) ! Synchronizes the RMA operations
#endif #endif
IF ((jsp_end.EQ.input%jspins)) THEN IF ((jsp_end.EQ.input%jspins)) THEN
......
...@@ -10,8 +10,8 @@ MODULE m_cdnmt ...@@ -10,8 +10,8 @@ MODULE m_cdnmt
! Philipp Kurz 2000-02-03 ! Philipp Kurz 2000-02-03
!*********************************************************************** !***********************************************************************
CONTAINS CONTAINS
SUBROUTINE cdnmt(jspd,atoms,sphhar,noco,l_fmpl,jsp_start,jsp_end, epar,& SUBROUTINE cdnmt(jspd,atoms,sphhar,noco,l_fmpl,jsp_start,jsp_end,enpara,&
ello,vr,denCoeffs,usdus,orb,denCoeffsOffdiag,moments,rho) vr,denCoeffs,usdus,orb,denCoeffsOffdiag,moments,rho)
use m_constants,only: sfp_const use m_constants,only: sfp_const
USE m_rhosphnlo USE m_rhosphnlo
USE m_radfun USE m_radfun
...@@ -23,6 +23,7 @@ CONTAINS ...@@ -23,6 +23,7 @@ CONTAINS
TYPE(t_noco), INTENT(IN) :: noco TYPE(t_noco), INTENT(IN) :: noco
TYPE(t_sphhar), INTENT(IN) :: sphhar TYPE(t_sphhar), INTENT(IN) :: sphhar
TYPE(t_atoms), INTENT(IN) :: atoms TYPE(t_atoms), INTENT(IN) :: atoms
TYPE(t_enpara), INTENT(IN) :: enpara
TYPE(t_moments), INTENT(INOUT) :: moments TYPE(t_moments), INTENT(INOUT) :: moments
! .. Scalar Arguments .. ! .. Scalar Arguments ..
...@@ -30,9 +31,7 @@ CONTAINS ...@@ -30,9 +31,7 @@ CONTAINS
LOGICAL, INTENT (IN) :: l_fmpl LOGICAL, INTENT (IN) :: l_fmpl
! .. ! ..
! .. Array Arguments .. ! .. Array Arguments ..
REAL, INTENT (IN) :: epar(0:atoms%lmaxd,atoms%ntype,jspd)
REAL, INTENT (IN) :: vr(atoms%jmtd,atoms%ntype,jspd) REAL, INTENT (IN) :: vr(atoms%jmtd,atoms%ntype,jspd)
REAL, INTENT (IN) :: ello(atoms%nlod,atoms%ntype,jspd)
REAL, INTENT (INOUT) :: rho(:,0:,:,:)!(toms%jmtd,0:sphhar%nlhd,atoms%ntype,jspd) REAL, INTENT (INOUT) :: rho(:,0:,:,:)!(toms%jmtd,0:sphhar%nlhd,atoms%ntype,jspd)
TYPE (t_orb), INTENT(IN) :: orb TYPE (t_orb), INTENT(IN) :: orb
TYPE (t_denCoeffs), INTENT(IN) :: denCoeffs TYPE (t_denCoeffs), INTENT(IN) :: denCoeffs
...@@ -66,7 +65,7 @@ CONTAINS ...@@ -66,7 +65,7 @@ CONTAINS
!$OMP PARALLEL DEFAULT(none) & !$OMP PARALLEL DEFAULT(none) &
!$OMP SHARED(usdus,rho,moments,rho21,qmtl) & !$OMP SHARED(usdus,rho,moments,rho21,qmtl) &
!$OMP SHARED(atoms,jsp_start,jsp_end,epar,vr,denCoeffs,sphhar,ello)& !$OMP SHARED(atoms,jsp_start,jsp_end,enpara,vr,denCoeffs,sphhar)&
!$OMP SHARED(orb,noco,l_fmpl,denCoeffsOffdiag,jspd)& !$OMP SHARED(orb,noco,l_fmpl,denCoeffsOffdiag,jspd)&
!$OMP PRIVATE(itype,na,ispin,l,f,g,nodeu,noded,wronk,i,j,s,qmtllo,qmtt,nd,lh,lp,llp,cs) !$OMP PRIVATE(itype,na,ispin,l,f,g,nodeu,noded,wronk,i,j,s,qmtllo,qmtt,nd,lh,lp,llp,cs)
IF (noco%l_mperp) THEN IF (noco%l_mperp) THEN
...@@ -87,7 +86,7 @@ CONTAINS ...@@ -87,7 +86,7 @@ CONTAINS
!---> spherical component !---> spherical component
DO ispin = jsp_start,jsp_end DO ispin = jsp_start,jsp_end
DO l = 0,atoms%lmax(itype) DO l = 0,atoms%lmax(itype)
CALL radfun(l,itype,ispin,epar(l,itype,ispin),vr(1,itype,ispin),atoms,& CALL radfun(l,itype,ispin,enpara%el0(l,itype,ispin),vr(1,itype,ispin),atoms,&
f(1,1,l,ispin),g(1,1,l,ispin),usdus, nodeu,noded,wronk) f(1,1,l,ispin),g(1,1,l,ispin),usdus, nodeu,noded,wronk)
DO j = 1,atoms%jri(itype) DO j = 1,atoms%jri(itype)
s = denCoeffs%uu(l,itype,ispin)*( f(j,1,l,ispin)*f(j,1,l,ispin)+f(j,2,l,ispin)*f(j,2,l,ispin) )& s = denCoeffs%uu(l,itype,ispin)*( f(j,1,l,ispin)*f(j,1,l,ispin)+f(j,2,l,ispin)*f(j,2,l,ispin) )&
...@@ -106,7 +105,7 @@ CONTAINS ...@@ -106,7 +105,7 @@ CONTAINS
CALL rhosphnlo(itype,atoms,sphhar,& CALL rhosphnlo(itype,atoms,sphhar,&
usdus%uloulopn(1,1,itype,ispin),usdus%dulon(1,itype,ispin),& usdus%uloulopn(1,1,itype,ispin),usdus%dulon(1,itype,ispin),&
usdus%uulon(1,itype,ispin),ello(1,itype,ispin),& usdus%uulon(1,itype,ispin),enpara%ello0(1,itype,ispin),&
vr(1,itype,ispin),denCoeffs%aclo(1,itype,ispin),denCoeffs%bclo(1,itype,ispin),& vr(1,itype,ispin),denCoeffs%aclo(1,itype,ispin),denCoeffs%bclo(1,itype,ispin),&
denCoeffs%cclo(1,1,itype,ispin),denCoeffs%acnmt(0,1,1,itype,ispin),& denCoeffs%cclo(1,1,itype,ispin),denCoeffs%acnmt(0,1,1,itype,ispin),&
denCoeffs%bcnmt(0,1,1,itype,ispin),denCoeffs%ccnmt(1,1,1,itype,ispin),& denCoeffs%bcnmt(0,1,1,itype,ispin),denCoeffs%ccnmt(1,1,1,itype,ispin),&
......
...@@ -9,13 +9,9 @@ MODULE m_nstm3 ...@@ -9,13 +9,9 @@ MODULE m_nstm3
! !
!*********************************************************************** !***********************************************************************
CONTAINS CONTAINS
SUBROUTINE nstm3(& SUBROUTINE nstm3(sym,atoms,vacuum,stars,lapw,ikpt,input,jspin,kpts,&
& sym,atoms,vacuum,stars,ikpt,nv,& cell,evac,vz,gvac1d,gvac2d)
& input,jspin,kpts,&
& cell,wk,k1,k2,&
& evac,vz,&
& gvac1d,gvac2d)
!
USE m_sort USE m_sort
USE m_types USE m_types
IMPLICIT NONE IMPLICIT NONE
...@@ -24,17 +20,16 @@ CONTAINS ...@@ -24,17 +20,16 @@ CONTAINS
TYPE(t_vacuum),INTENT(IN) :: vacuum TYPE(t_vacuum),INTENT(IN) :: vacuum
TYPE(t_sym),INTENT(IN) :: sym TYPE(t_sym),INTENT(IN) :: sym
TYPE(t_stars),INTENT(IN) :: stars TYPE(t_stars),INTENT(IN) :: stars
TYPE(t_lapw),INTENT(IN) :: lapw
TYPE(t_cell),INTENT(IN) :: cell TYPE(t_cell),INTENT(IN) :: cell
TYPE(t_kpts),INTENT(IN) :: kpts TYPE(t_kpts),INTENT(IN) :: kpts
TYPE(t_atoms),INTENT(IN) :: atoms TYPE(t_atoms),INTENT(IN) :: atoms
! .. ! ..
! .. Scalar Arguments .. ! .. Scalar Arguments ..
INTEGER, INTENT (IN) :: ikpt,nv INTEGER, INTENT (IN) :: ikpt
INTEGER, INTENT (IN) :: jspin INTEGER, INTENT (IN) :: jspin
REAL, INTENT (IN) :: wk
! .. ! ..
! .. Array Arguments .. ! .. Array Arguments ..
INTEGER, INTENT (IN) :: k1(:),k2(:)
REAL, INTENT (IN) :: evac(2) REAL, INTENT (IN) :: evac(2)
REAL, INTENT (IN) :: vz(:,:)!(vacuum%nmzd,2) REAL, INTENT (IN) :: vz(:,:)!(vacuum%nmzd,2)
INTEGER, INTENT (OUT) :: gvac1d(:),gvac2d(:) !(dimension%nv2d) INTEGER, INTENT (OUT) :: gvac1d(:),gvac2d(:) !(dimension%nv2d)
...@@ -50,17 +45,17 @@ CONTAINS ...@@ -50,17 +45,17 @@ CONTAINS
! !
IF (ikpt.EQ.1) THEN IF (ikpt.EQ.1) THEN
n2 = 0 n2 = 0
k_loop: DO k = 1,nv k_loop: DO k = 1,lapw%nv(jspin)
DO j = 1,n2 DO j = 1,n2
IF (k1(k).EQ.gvac1(j).AND.k2(k).EQ.gvac2(j)) THEN IF (lapw%k1(k,jspin).EQ.gvac1(j).AND.lapw%k2(k,jspin).EQ.gvac2(j)) THEN
CYCLE k_loop CYCLE k_loop
END IF END IF
ENDDO ENDDO
n2 = n2 + 1 n2 = n2 + 1
gvac1(n2) = k1(k) gvac1(n2) = lapw%k1(k,jspin)
gvac2(n2) = k2(k) gvac2(n2) = lapw%k2(k,jspin)
DO i=1,2 DO i=1,2
gvac(i)=k1(k)*cell%bmat(1,i)+k2(k)*cell%bmat(2,i) gvac(i)=lapw%k1(k,jspin)*cell%bmat(1,i)+lapw%k2(k,jspin)*cell%bmat(2,i)
END DO END DO
gvacl(n2) = SQRT(REAL(gvac(1)**2+gvac(2)**2)) gvacl(n2) = SQRT(REAL(gvac(1)**2+gvac(2)**2))
ENDDO k_loop ENDDO k_loop
...@@ -120,7 +115,7 @@ CONTAINS ...@@ -120,7 +115,7 @@ CONTAINS
! only write here if not on T3E ! only write here if not on T3E
WRITE (87,'(i3,1x,f12.6)') ikpt,wk WRITE (87,'(i3,1x,f12.6)') ikpt,kpts%wtkpt(ikpt)
END SUBROUTINE nstm3 END SUBROUTINE nstm3
END MODULE m_nstm3 END MODULE m_nstm3
...@@ -18,13 +18,14 @@ MODULE m_sympsi ...@@ -18,13 +18,14 @@ MODULE m_sympsi
! Jussi Enkovaara, Juelich 2004 ! Jussi Enkovaara, Juelich 2004
CONTAINS CONTAINS
SUBROUTINE sympsi(bkpt,nv,kx,ky,kz,sym,DIMENSION,ne,cell,eig,noco, ksym,jsym,zMat) SUBROUTINE sympsi(lapw,jspin,sym,DIMENSION,ne,cell,eig,noco, ksym,jsym,zMat)
USE m_grp_k USE m_grp_k
USE m_inv3 USE m_inv3
USE m_types USE m_types
IMPLICIT NONE IMPLICIT NONE
TYPE(t_lapw),INTENT(IN) :: lapw
TYPE(t_dimension),INTENT(IN) :: DIMENSION TYPE(t_dimension),INTENT(IN) :: DIMENSION
TYPE(t_noco),INTENT(IN) :: noco TYPE(t_noco),INTENT(IN) :: noco
TYPE(t_sym),INTENT(IN) :: sym TYPE(t_sym),INTENT(IN) :: sym
...@@ -32,11 +33,10 @@ CONTAINS ...@@ -32,11 +33,10 @@ CONTAINS
TYPE(t_zMat),INTENT(IN) :: zMat TYPE(t_zMat),INTENT(IN) :: zMat
! !
! .. Scalar Arguments .. ! .. Scalar Arguments ..
INTEGER, INTENT (IN) :: nv,ne INTEGER, INTENT (IN) :: ne,jspin
! .. ! ..
! .. Array Arguments .. ! .. Array Arguments ..
INTEGER, INTENT (IN) :: kx(:),ky(:),kz(:)!(nvd) REAL, INTENT (IN) :: eig(DIMENSION%neigd)
REAL, INTENT (IN) :: bkpt(3),eig(DIMENSION%neigd)
INTEGER, INTENT (OUT):: jsym(DIMENSION%neigd),ksym(DIMENSION%neigd) INTEGER, INTENT (OUT):: jsym(DIMENSION%neigd),ksym(DIMENSION%neigd)
! .. ! ..
...@@ -72,9 +72,9 @@ CONTAINS ...@@ -72,9 +72,9 @@ CONTAINS
IF (soc) THEN IF (soc) THEN
ALLOCATE(su(2,2,2*sym%nop)) ALLOCATE(su(2,2,2*sym%nop))
CALL grp_k(sym,mrot_k,cell,bkpt,nclass,nirr,c_table, grpname,irrname,su) CALL grp_k(sym,mrot_k,cell,lapw%bkpt,nclass,nirr,c_table, grpname,irrname,su)
ELSE ELSE
CALL grp_k(sym,mrot_k,cell,bkpt,nclass,nirr,c_table, grpname,irrname) CALL grp_k(sym,mrot_k,cell,lapw%bkpt,nclass,nirr,c_table, grpname,irrname)
ENDIF ENDIF
ALLOCATE(csum(ne,ne,nclass)) ALLOCATE(csum(ne,ne,nclass))
ALLOCATE(chars(ne,nclass)) ALLOCATE(chars(ne,nclass))
...@@ -97,25 +97,25 @@ CONTAINS ...@@ -97,25 +97,25 @@ CONTAINS
gmap=0 gmap=0
DO c=1,nclass DO c=1,nclass
CALL inv3(mrot_k(:,:,c),mtmpinv,d) CALL inv3(mrot_k(:,:,c),mtmpinv,d)
kloop: DO k=1,nv kloop: DO k=1,lapw%nv(jspin)
kv(1)=kx(k) kv(1)=lapw%k1(k,jspin)
kv(2)=ky(k) kv(2)=lapw%k2(k,jspin)
kv(3)=kz(k) kv(3)=lapw%k3(k,jspin)
kv=kv+bkpt kv=kv+lapw%bkpt
kvtest=MATMUL(kv,mtmpinv) kvtest=MATMUL(kv,mtmpinv)
! kvtest=MATMUL(kv,mrot_k(:,:,c)) ! kvtest=MATMUL(kv,mrot_k(:,:,c))
DO i = 1,nv DO i = 1,lapw%nv(jspin)
kv(1)=kx(i) kv(1)=lapw%k1(i,jspin)
kv(2)=ky(i) kv(2)=lapw%k2(i,jspin)
kv(3)=kz(i) kv(3)=lapw%k3(i,jspin)
kv=kv+bkpt kv=kv+lapw%bkpt
IF (ABS(kvtest(1)-kv(1)).LT.small.AND.& IF (ABS(kvtest(1)-kv(1)).LT.small.AND.&
ABS(kvtest(2)-kv(2)).LT.small.AND. ABS(kvtest(3)-kv(3)).LT.small) THEN ABS(kvtest(2)-kv(2)).LT.small.AND. ABS(kvtest(3)-kv(3)).LT.small) THEN
gmap(k,c)=i gmap(k,c)=i
CYCLE kloop CYCLE kloop
ENDIF ENDIF
ENDDO ENDDO
WRITE(6,*) 'Problem in symcheck, cannot find rotated kv for', k,kx(k),ky(k),kz(k) WRITE(6,*) 'Problem in symcheck, cannot find rotated kv for', k,lapw%k1(k,jspin),lapw%k2(k,jspin),lapw%k3(k,jspin)
RETURN RETURN
ENDDO kloop ENDDO kloop
ENDDO ENDDO
...@@ -124,16 +124,16 @@ CONTAINS ...@@ -124,16 +124,16 @@ CONTAINS
DO i=1,ne DO i=1,ne
norm(i)=0.0 norm(i)=0.0
IF (soc) THEN IF (soc) THEN
DO k=1,nv*2 DO k=1,lapw%nv(jspin)*2
norm(i)=norm(i)+ABS(zMat%z_c(k,i))**2 norm(i)=norm(i)+ABS(zMat%z_c(k,i))**2
ENDDO ENDDO
ELSE ELSE
IF (zmat%l_real) THEN IF (zmat%l_real) THEN
DO k=1,nv DO k=1,lapw%nv(jspin)
norm(i)=norm(i)+ABS(zMat%z_r(k,i))**2 norm(i)=norm(i)+ABS(zMat%z_r(k,i))**2
ENDDO ENDDO
ELSE ELSE
DO k=1,nv DO k=1,lapw%nv(jspin)
norm(i)=norm(i)+ABS(zMat%z_c(k,i))**2 norm(i)=norm(i)+ABS(zMat%z_c(k,i))**2
ENDDO ENDDO
ENDIF ENDIF
...@@ -161,21 +161,21 @@ CONTAINS ...@@ -161,21 +161,21 @@ CONTAINS
DO n1=1,ndeg DO n1=1,ndeg
DO n2=1,ndeg DO n2=1,ndeg
IF (zmat%l_real) THEN IF (zmat%l_real) THEN
DO k=1,nv DO k=1,lapw%nv(jspin)
csum(n1,n2,c)=csum(n1,n2,c)+zMat%z_r(k,deg(n1))*& csum(n1,n2,c)=csum(n1,n2,c)+zMat%z_r(k,deg(n1))*&
zMat%z_r(gmap(k,c),deg(n2))/(norm(deg(n1))*norm(deg(n2))) zMat%z_r(gmap(k,c),deg(n2))/(norm(deg(n1))*norm(deg(n2)))
END DO END DO
ELSE ELSE
IF (soc) THEN IF (soc) THEN
DO k=1,nv DO k=1,lapw%nv(jspin)
csum(n1,n2,c)=csum(n1,n2,c)+(CONJG(zMat%z_c(k,deg(n1)))*& csum(n1,n2,c)=csum(n1,n2,c)+(CONJG(zMat%z_c(k,deg(n1)))*&
(su(1,1,c)*zMat%z_c(gmap(k,c),deg(n2))+ su(1,2,c)*zMat%z_c(gmap(k,c)+nv,deg(n2)))+& (su(1,1,c)*zMat%z_c(gmap(k,c),deg(n2))+ su(1,2,c)*zMat%z_c(gmap(k,c)+lapw%nv(jspin),deg(n2)))+&
CONJG(zMat%z_c(k+nv,deg(n1)))* (su(2,1,c)*zMat%z_c(gmap(k,c),deg(n2))+& CONJG(zMat%z_c(k+lapw%nv(jspin),deg(n1)))* (su(2,1,c)*zMat%z_c(gmap(k,c),deg(n2))+&
su(2,2,c)*zMat%z_c(gmap(k,c)+nv,deg(n2))))/ (norm(deg(n1))*norm(deg(n2))) su(2,2,c)*zMat%z_c(gmap(k,c)+lapw%nv(jspin),deg(n2))))/ (norm(deg(n1))*norm(deg(n2)))
END DO END DO
ELSE ELSE
DO k=1,nv DO k=1,lapw%nv(jspin)
csum(n1,n2,c)=csum(n1,n2,c)+CONJG(zMat%z_c(k,deg(n1)))*& csum(n1,n2,c)=csum(n1,n2,c)+CONJG(zMat%z_c(k,deg(n1)))*&
zMat%z_c(gmap(k,c),deg(n2))/(norm(deg(n1))*norm(deg(n2))) zMat%z_c(gmap(k,c),deg(n2))/(norm(deg(n1))*norm(deg(n2)))
END DO END DO
...@@ -217,7 +217,7 @@ CONTAINS ...@@ -217,7 +217,7 @@ CONTAINS
!> !>
IF (.NOT.char_written) THEN IF (.NOT.char_written) THEN
WRITE(444,124) bkpt WRITE(444,124) lapw%bkpt
WRITE(444,*) 'Group is ' ,grpname WRITE(444,*) 'Group is ' ,grpname
DO c=1,nirr DO c=1,nirr
IF (zmat%l_real)THEN IF (zmat%l_real)THEN
......
...@@ -10,7 +10,7 @@ MODULE m_mpi_col_den ...@@ -10,7 +10,7 @@ MODULE m_mpi_col_den
! !
CONTAINS CONTAINS
SUBROUTINE mpi_col_den(mpi,sphhar,atoms,oneD,stars,vacuum,& SUBROUTINE mpi_col_den(mpi,sphhar,atoms,oneD,stars,vacuum,&
input, noco,l_fmpl,jspin,llp