Skip to content
GitLab
Commit bd99a389 authored by Gregor Michalicek's avatar Gregor Michalicek
Browse files

Remove requirement for read_dos, write_dos subroutines (part 1) 

(at the moment this is broken)
parent 9ffd69d4
Hide whitespace changes
Inline Side-by-side
cdn/cdnval.F90
View file @ bd99a389
......@@ -95,7 +95,6 @@ SUBROUTINE cdnval(eig_id, mpi,kpts,jspin,sliceplot,noco, input,banddos,cell,atom
LOGICAL :: l_orbcomprot, l_real, l_write, l_dosNdir
! Local Arrays
INTEGER, ALLOCATABLE :: jsym(:),ksym(:)
REAL, ALLOCATABLE :: we(:)
REAL, ALLOCATABLE :: eig(:)
REAL, ALLOCATABLE :: f(:,:,:,:),g(:,:,:,:),flo(:,:,:,:) ! radial functions
......@@ -131,7 +130,6 @@ SUBROUTINE cdnval(eig_id, mpi,kpts,jspin,sliceplot,noco, input,banddos,cell,atom
ALLOCATE (f(atoms%jmtd,2,0:atoms%lmaxd,jsp_start:jsp_end)) ! Deallocation before mpi_col_den
ALLOCATE (g(atoms%jmtd,2,0:atoms%lmaxd,jsp_start:jsp_end))
ALLOCATE (flo(atoms%jmtd,2,atoms%nlod,dimension%jspd))
ALLOCATE (jsym(dimension%neigd),ksym(dimension%neigd))
! Initializations
CALL usdus%init(atoms,input%jspins)
......@@ -271,15 +269,15 @@ SUBROUTINE cdnval(eig_id, mpi,kpts,jspin,sliceplot,noco, input,banddos,cell,atom
IF ((banddos%dos.OR.banddos%vacdos.OR.input%cdinf)) THEN
! 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) CALL sympsi(lapw,jspin,sym,dimension,nbands,cell,eig,noco,dos%ksym(:,ikpt,jspin),dos%jsym(:,ikpt,jspin),zMat)
CALL write_dos(eig_id,ikpt,jspin,dos,slab,orbcomp,ksym,jsym,mcd%mcd)
CALL write_dos(eig_id,ikpt,jspin,dos,slab,orbcomp,dos%ksym(:,ikpt,jspin),dos%jsym(:,ikpt,jspin),mcd%mcd)
END IF
END DO ! end of k-point loop
#ifdef CPP_MPI
DO ispin = jsp_start,jsp_end
CALL mpi_col_den(mpi,sphhar,atoms,oneD,stars,vacuum,input,noco,ispin,regCharges,&
CALL mpi_col_den(mpi,sphhar,atoms,oneD,stars,vacuum,input,noco,ispin,regCharges,dos,&
results,denCoeffs,orb,denCoeffsOffdiag,den,den%mmpMat(:,:,:,jspin))
END DO
#endif
......
dos/doswrite.f90
View file @ bd99a389
......@@ -12,7 +12,7 @@ MODULE m_doswrite
!
CONTAINS
SUBROUTINE doswrite(eig_id,DIMENSION,kpts,atoms,vacuum,input,banddos,&
sliceplot,noco,sym,cell,mcd,results,nsld,oneD)
sliceplot,noco,sym,cell,dos,mcd,results,nsld,oneD)
USE m_eig66_io,ONLY:read_dos,read_eig
USE m_evaldos
USE m_cdninf
......@@ -28,6 +28,7 @@ CONTAINS
TYPE(t_noco),INTENT(IN) :: noco
TYPE(t_sym),INTENT(IN) :: sym
TYPE(t_cell),INTENT(IN) :: cell
TYPE(t_dos),INTENT(IN) :: dos
TYPE(t_kpts),INTENT(IN) :: kpts
TYPE(t_atoms),INTENT(IN) :: atoms
TYPE(t_mcd),INTENT(IN) :: mcd
......@@ -71,13 +72,11 @@ CONTAINS
ENDIF
IF ((banddos%dos.AND.(banddos%ndir.GE.0)).OR.input%cdinf) THEN
!
! write bandstructure or cdn-info to output-file
!
DO kspin = 1,input%jspins
IF (banddos%dos.AND.(banddos%ndir.GE.0)) THEN
!--- > write header information to vacdos & dosinp
!
! write header information to vacdos & dosinp
IF (input%film) THEN
WRITE (85,FMT=8080) vacuum%nvac,kpts%nkpt
ELSE
......@@ -93,47 +92,40 @@ CONTAINS
ENDIF
DO ikpt=1,kpts%nkpt
call read_eig(eig_id,ikpt,kspin,neig=ne,eig=eig)
call read_dos(eig_id,ikpt,kspin,qal(:,:,:,kspin),qvac(:,:,ikpt,kspin),&
qis(:,ikpt,kspin),qvlay(:,:,:),qstars,ksym,jsym)
! call read_eig(eig_id,ikpt,kspin,neig=ne,eig=eig)
! call read_dos(eig_id,ikpt,kspin,qal(:,:,:,kspin),qvac(:,:,ikpt,kspin),&
! qis(:,ikpt,kspin),qvlay(:,:,:),qstars,ksym,jsym)
CALL cdninf(input,sym,noco,kspin,atoms,vacuum,sliceplot,banddos,ikpt,kpts%bk(:,ikpt),&
kpts%wtkpt(ikpt),cell,kpts,ne,eig,qal(0:,:,:,kspin),qis,qvac,&
qvlay(:,:,:),qstars,ksym,jsym)
ENDDO
kpts%wtkpt(ikpt),cell,kpts,results%neig(ikpt,kspin),results%eig(:,ikpt,kspin),dos%qal(0:,:,:,ikpt,kspin),dos%qis,dos%qvac,&
dos%qvlay(:,:,:,ikpt,kspin),dos%qstars(:,:,:,:,ikpt,kspin),dos%ksym(:,ikpt,kspin),dos%jsym(:,ikpt,kspin))
END DO
ENDDO ! end spin loop (kspin = 1,input%jspins)
END DO ! end spin loop (kspin = 1,input%jspins)
ENDIF
END IF
IF (banddos%dos.AND.(banddos%ndir.GE.0)) THEN
CLOSE(85)
RETURN
! ok, all done in the bandstructure/cdninf case
ENDIF
!
! write DOS/VACDOS
!
!
END IF
! write DOS/VACDOS
IF (banddos%dos.AND.(banddos%ndir.LT.0)) THEN
CALL evaldos(eig_id,input,banddos,vacuum,kpts,atoms,sym,noco,oneD,cell,&
DIMENSION,results%ef,results%bandgap,&
banddos%l_mcd,mcd%ncore,mcd%e_mcd,nsld)
ENDIF
!
! Now write to vacwave if nstm=3
! all data
! has been written to tmp_vacwave and must be written now
! by PE=0 only!
!
CALL evaldos(eig_id,input,banddos,vacuum,kpts,atoms,sym,noco,oneD,cell,results,dos,&
DIMENSION,results%ef,results%bandgap,banddos%l_mcd,mcd%ncore,mcd%e_mcd,nsld)
END IF
! Now write to vacwave if nstm=3
! all data has been written to tmp_vacwave and must be written now by PE=0 only!
IF (vacuum%nstm.EQ.3) THEN
call juDFT_error("nstm=3 not implemented in doswrite")
!OPEN (89,file='tmp_vacwave',status='old',access='direct')!, recl=reclength_vw)
ALLOCATE ( ac(n2max,DIMENSION%neigd),bc(n2max,DIMENSION%neigd) )
DO ikpt = 1,kpts%nkpt
WRITE(*,*) 'Read rec',ikpt,'from vacwave'
READ(89,rec=ikpt) wk,ne,bkpt(1),bkpt(2),&
& eig,ac,bc
READ(89,rec=ikpt) wk,ne,bkpt(1),bkpt(2),eig,ac,bc
WRITE (87,'(i3,1x,f12.6)') ikpt,wk
i=0
DO n = 1, ne
......
dos/evaldos.f90
View file @ bd99a389
MODULE m_evaldos
CONTAINS
SUBROUTINE evaldos(eig_id,input,banddos,vacuum,kpts,atoms,sym,noco,oneD,cell,&
dimension,efermiarg,bandgap,l_mcd,ncore,e_mcd,nsld)
SUBROUTINE evaldos(eig_id,input,banddos,vacuum,kpts,atoms,sym,noco,oneD,cell,results,dos,&
dimension,efermiarg,bandgap,l_mcd,ncore,e_mcd,nsld)
!----------------------------------------------------------------------
!
! vk: k-vectors
......@@ -39,6 +39,8 @@
TYPE(t_noco),INTENT(IN) :: noco
TYPE(t_sym),INTENT(IN) :: sym
TYPE(t_cell),INTENT(IN) :: cell
TYPE(t_results),INTENT(IN) :: results
TYPE(t_dos),INTENT(IN) :: dos
TYPE(t_kpts),INTENT(IN) :: kpts
TYPE(t_atoms),INTENT(IN) :: atoms
......
main/cdngen.F90
View file @ bd99a389
......@@ -102,7 +102,7 @@ SUBROUTINE cdngen(eig_id,mpi,input,banddos,sliceplot,vacuum,&
IF (mpi%irank.EQ.0) THEN
IF (banddos%dos.or.banddos%vacdos.or.input%cdinf) THEN
CALL timestart("cdngen: dos")
CALL doswrite(eig_id,dimension,kpts,atoms,vacuum,input,banddos,sliceplot,noco,sym,cell,mcd,results,slab%nsld,oneD)
CALL doswrite(eig_id,dimension,kpts,atoms,vacuum,input,banddos,sliceplot,noco,sym,cell,dos,mcd,results,slab%nsld,oneD)
IF (banddos%dos.AND.(banddos%ndir.EQ.-3)) THEN
CALL Ek_write_sl(eig_id,dimension,kpts,atoms,vacuum,input,jspmax,sym,cell,slab)
END IF
......
mpi/mpi_col_den.F90
View file @ bd99a389
......@@ -9,7 +9,7 @@ MODULE m_mpi_col_den
! collect all data calculated in cdnval on different pe's on pe 0
!
CONTAINS
SUBROUTINE mpi_col_den(mpi,sphhar,atoms,oneD,stars,vacuum,input,noco,jspin,regCharges,&
SUBROUTINE mpi_col_den(mpi,sphhar,atoms,oneD,stars,vacuum,input,noco,jspin,regCharges,dos,&
results,denCoeffs,orb,denCoeffsOffdiag,den,n_mmp)
#include"cpp_double.h"
......@@ -39,6 +39,7 @@ CONTAINS
TYPE (t_denCoeffs), INTENT(INOUT) :: denCoeffs
TYPE (t_denCoeffsOffdiag), INTENT(INOUT) :: denCoeffsOffdiag
TYPE (t_regionCharges), INTENT(INOUT) :: regCharges
TYPE (t_dos), INTENT(INOUT) :: dos
! ..
! .. Local Scalars ..
INTEGER :: n
......@@ -47,6 +48,7 @@ CONTAINS
INTEGER :: ierr(3)
COMPLEX, ALLOCATABLE :: c_b(:)
REAL, ALLOCATABLE :: r_b(:)
INTEGER, ALLOCATABLE :: i_b(:)
! ..
! .. External Subroutines
EXTERNAL CPP_BLAS_scopy,CPP_BLAS_ccopy,MPI_REDUCE
......@@ -57,121 +59,122 @@ CONTAINS
n = stars%ng3
ALLOCATE(c_b(n))
CALL MPI_REDUCE(den%pw(:,jspin),c_b,n,CPP_MPI_COMPLEX,MPI_SUM,0, MPI_COMM_WORLD,ierr)
IF (mpi%irank.EQ.0) THEN
CALL CPP_BLAS_ccopy(n, c_b, 1, den%pw(:,jspin), 1)
ENDIF
IF (mpi%irank.EQ.0) CALL CPP_BLAS_ccopy(n, c_b, 1, den%pw(:,jspin), 1)
DEALLOCATE (c_b)
! -> Collect den%vacxy(:,:,:,jspin)
IF (input%film) THEN
n = vacuum%nmzxyd*(oneD%odi%n2d-1)*2
ALLOCATE(c_b(n))
CALL MPI_REDUCE(den%vacxy(:,:,:,jspin),c_b,n,CPP_MPI_COMPLEX,MPI_SUM,0, MPI_COMM_WORLD,ierr)
IF (mpi%irank.EQ.0) THEN
CALL CPP_BLAS_ccopy(n, c_b, 1, den%vacxy(:,:,:,jspin), 1)
ENDIF
IF (mpi%irank.EQ.0) CALL CPP_BLAS_ccopy(n, c_b, 1, den%vacxy(:,:,:,jspin), 1)
DEALLOCATE (c_b)
! -> Collect den%vacz(:,:,jspin)
n = vacuum%nmzd*2
ALLOCATE(r_b(n))
CALL MPI_REDUCE(den%vacz(:,:,jspin),r_b,n,CPP_MPI_REAL,MPI_SUM,0, MPI_COMM_WORLD,ierr)
IF (mpi%irank.EQ.0) THEN
CALL CPP_BLAS_scopy(n, r_b, 1, den%vacz(:,:,jspin), 1)
ENDIF
IF (mpi%irank.EQ.0) CALL CPP_BLAS_scopy(n, r_b, 1, den%vacz(:,:,jspin), 1)
DEALLOCATE (r_b)
ENDIF
!
! -> Collect uu(),ud() and dd()
!
n = (atoms%lmaxd+1)*atoms%ntype
ALLOCATE(r_b(n))
CALL MPI_REDUCE(denCoeffs%uu(0:,:,jspin),r_b,n,CPP_MPI_REAL,MPI_SUM,0, MPI_COMM_WORLD,ierr)
IF (mpi%irank.EQ.0) THEN
CALL CPP_BLAS_scopy(n, r_b, 1, denCoeffs%uu(0:,:,jspin), 1)
ENDIF
IF (mpi%irank.EQ.0) CALL CPP_BLAS_scopy(n, r_b, 1, denCoeffs%uu(0:,:,jspin), 1)
CALL MPI_REDUCE(denCoeffs%du(0:,:,jspin),r_b,n,CPP_MPI_REAL,MPI_SUM,0, MPI_COMM_WORLD,ierr)
IF (mpi%irank.EQ.0) THEN
CALL CPP_BLAS_scopy(n, r_b, 1, denCoeffs%du(0:,:,jspin), 1)
ENDIF
IF (mpi%irank.EQ.0) CALL CPP_BLAS_scopy(n, r_b, 1, denCoeffs%du(0:,:,jspin), 1)
CALL MPI_REDUCE(denCoeffs%dd(0:,:,jspin),r_b,n,CPP_MPI_REAL,MPI_SUM,0, MPI_COMM_WORLD,ierr)
IF (mpi%irank.EQ.0) THEN
CALL CPP_BLAS_scopy(n, r_b, 1, denCoeffs%dd(0:,:,jspin), 1)
ENDIF
IF (mpi%irank.EQ.0) CALL CPP_BLAS_scopy(n, r_b, 1, denCoeffs%dd(0:,:,jspin), 1)
DEALLOCATE (r_b)
!
!--> Collect uunmt,udnmt,dunmt,ddnmt
!
n = (((atoms%lmaxd*(atoms%lmaxd+3))/2)+1)*sphhar%nlhd*atoms%ntype
ALLOCATE(r_b(n))
CALL MPI_REDUCE(denCoeffs%uunmt(0:,:,:,jspin),r_b,n,CPP_MPI_REAL,MPI_SUM,0, MPI_COMM_WORLD,ierr)
IF (mpi%irank.EQ.0) THEN
CALL CPP_BLAS_scopy(n, r_b, 1, denCoeffs%uunmt(0:,:,:,jspin), 1)
ENDIF
IF (mpi%irank.EQ.0) CALL CPP_BLAS_scopy(n, r_b, 1, denCoeffs%uunmt(0:,:,:,jspin), 1)
CALL MPI_REDUCE(denCoeffs%udnmt(0:,:,:,jspin),r_b,n,CPP_MPI_REAL,MPI_SUM,0, MPI_COMM_WORLD,ierr)
IF (mpi%irank.EQ.0) THEN
CALL CPP_BLAS_scopy(n, r_b, 1, denCoeffs%udnmt(0:,:,:,jspin), 1)
ENDIF
IF (mpi%irank.EQ.0) CALL CPP_BLAS_scopy(n, r_b, 1, denCoeffs%udnmt(0:,:,:,jspin), 1)
CALL MPI_REDUCE(denCoeffs%dunmt(0:,:,:,jspin),r_b,n,CPP_MPI_REAL,MPI_SUM,0, MPI_COMM_WORLD,ierr)
IF (mpi%irank.EQ.0) THEN
CALL CPP_BLAS_scopy(n, r_b, 1, denCoeffs%dunmt(0:,:,:,jspin), 1)
ENDIF
IF (mpi%irank.EQ.0) CALL CPP_BLAS_scopy(n, r_b, 1, denCoeffs%dunmt(0:,:,:,jspin), 1)
CALL MPI_REDUCE(denCoeffs%ddnmt(0:,:,:,jspin),r_b,n,CPP_MPI_REAL,MPI_SUM,0, MPI_COMM_WORLD,ierr)
IF (mpi%irank.EQ.0) THEN
CALL CPP_BLAS_scopy(n, r_b, 1, denCoeffs%ddnmt(0:,:,:,jspin), 1)
ENDIF
IF (mpi%irank.EQ.0) CALL CPP_BLAS_scopy(n, r_b, 1, denCoeffs%ddnmt(0:,:,:,jspin), 1)
DEALLOCATE (r_b)
!
!--> ener & sqal
!
n=4*atoms%ntype
ALLOCATE(r_b(n))
CALL MPI_REDUCE(regCharges%ener(:,:,jspin),r_b,n,CPP_MPI_REAL,MPI_SUM,0, MPI_COMM_WORLD,ierr)
IF (mpi%irank.EQ.0) THEN
CALL CPP_BLAS_scopy(n, r_b, 1, regCharges%ener(:,:,jspin), 1)
ENDIF
IF (mpi%irank.EQ.0) CALL CPP_BLAS_scopy(n, r_b, 1, regCharges%ener(:,:,jspin), 1)
CALL MPI_REDUCE(regCharges%sqal(:,:,jspin),r_b,n,CPP_MPI_REAL,MPI_SUM,0, MPI_COMM_WORLD,ierr)
IF (mpi%irank.EQ.0) THEN
CALL CPP_BLAS_scopy(n, r_b, 1, regCharges%sqal(:,:,jspin), 1)
ENDIF
IF (mpi%irank.EQ.0) CALL CPP_BLAS_scopy(n, r_b, 1, regCharges%sqal(:,:,jspin), 1)
DEALLOCATE (r_b)
!
!--> svac & pvac
!
IF ( input%film ) THEN
n=2
ALLOCATE(r_b(n))
CALL MPI_REDUCE(regCharges%svac(:,jspin),r_b,n,CPP_MPI_REAL,MPI_SUM,0, MPI_COMM_WORLD,ierr)
IF (mpi%irank.EQ.0) THEN
CALL CPP_BLAS_scopy(n, r_b, 1, regCharges%svac(:,jspin), 1)
ENDIF
IF (mpi%irank.EQ.0) CALL CPP_BLAS_scopy(n, r_b, 1, regCharges%svac(:,jspin), 1)
CALL MPI_REDUCE(regCharges%pvac(:,jspin),r_b,n,CPP_MPI_REAL,MPI_SUM,0, MPI_COMM_WORLD,ierr)
IF (mpi%irank.EQ.0) THEN
CALL CPP_BLAS_scopy(n, r_b, 1, regCharges%pvac(:,jspin), 1)
ENDIF
IF (mpi%irank.EQ.0) CALL CPP_BLAS_scopy(n, r_b, 1, regCharges%pvac(:,jspin), 1)
DEALLOCATE (r_b)
ENDIF
!
!collect DOS stuff
n = SIZE(dos%jsym,1)*SIZE(dos%jsym,2)
ALLOCATE(i_b(n))
CALL MPI_REDUCE(dos%jsym(:,:,jspin),i_b,n,MPI_INTEGER,MPI_SUM,0, MPI_COMM_WORLD,ierr)
IF (mpi%irank.EQ.0) CALL CPP_BLAS_scopy(n, i_b, 1, dos%jsym(:,:,jspin), 1)
DEALLOCATE (i_b)
n = SIZE(dos%ksym,1)*SIZE(dos%ksym,2)
ALLOCATE(i_b(n))
CALL MPI_REDUCE(dos%ksym(:,:,jspin),i_b,n,MPI_INTEGER,MPI_SUM,0, MPI_COMM_WORLD,ierr)
IF (mpi%irank.EQ.0) CALL CPP_BLAS_scopy(n, i_b, 1, dos%ksym(:,:,jspin), 1)
DEALLOCATE (i_b)
n = SIZE(dos%qis,1)*SIZE(dos%qis,2)
ALLOCATE(r_b(n))
CALL MPI_REDUCE(dos%qis(:,:,jspin),r_b,n,CPP_MPI_REAL,MPI_SUM,0, MPI_COMM_WORLD,ierr)
IF (mpi%irank.EQ.0) CALL CPP_BLAS_scopy(n, r_b, 1, dos%qis(:,:,jspin), 1)
DEALLOCATE (r_b)
n = SIZE(dos%qal,1)*SIZE(dos%qal,2)*SIZE(dos%qal,3)*SIZE(dos%qal,4)
ALLOCATE(r_b(n))
CALL MPI_REDUCE(dos%qal(0:,:,:,:,jspin),r_b,n,CPP_MPI_REAL,MPI_SUM,0, MPI_COMM_WORLD,ierr)
IF (mpi%irank.EQ.0) CALL CPP_BLAS_scopy(n, r_b, 1, dos%qal(0:,:,:,:,jspin), 1)
DEALLOCATE (r_b)
n = SIZE(dos%qvac,1)*SIZE(dos%qvac,2)*SIZE(dos%qvac,3)
ALLOCATE(r_b(n))
CALL MPI_REDUCE(dos%qvac(:,:,:,jspin),r_b,n,CPP_MPI_REAL,MPI_SUM,0, MPI_COMM_WORLD,ierr)
IF (mpi%irank.EQ.0) CALL CPP_BLAS_scopy(n, r_b, 1, dos%qvac(:,:,:,jspin), 1)
DEALLOCATE (r_b)
n = SIZE(dos%qvlay,1)*SIZE(dos%qvlay,2)*SIZE(dos%qvlay,3)*SIZE(dos%qvlay,4)
ALLOCATE(r_b(n))
CALL MPI_REDUCE(dos%qvlay(:,:,:,:,jspin),r_b,n,CPP_MPI_REAL,MPI_SUM,0, MPI_COMM_WORLD,ierr)
IF (mpi%irank.EQ.0) CALL CPP_BLAS_scopy(n, r_b, 1, dos%qvlay(:,:,:,:,jspin), 1)
DEALLOCATE (r_b)
n = SIZE(dos%qstars,1)*SIZE(dos%qstars,2)*SIZE(dos%qstars,3)*SIZE(dos%qstars,4)*SIZE(dos%qstars,5)
ALLOCATE(c_b(n))
CALL MPI_REDUCE(dos%qstars(:,:,:,:,:,jspin),c_b,n,CPP_MPI_COMPLEX,MPI_SUM,0, MPI_COMM_WORLD,ierr)
IF (mpi%irank.EQ.0) CALL CPP_BLAS_scopy(n, c_b, 1, dos%qstars(:,:,:,:,:,jspin), 1)
DEALLOCATE (c_b)
! -> Collect force
!
IF (input%l_f) THEN
n=3*atoms%ntype
ALLOCATE(r_b(n))
CALL MPI_REDUCE(results%force(1,1,jspin),r_b,n,CPP_MPI_REAL,MPI_SUM,0, MPI_COMM_WORLD,ierr)
IF (mpi%irank.EQ.0) THEN
CALL CPP_BLAS_scopy(n, r_b, 1, results%force(1,1,jspin), 1)
ENDIF
IF (mpi%irank.EQ.0) CALL CPP_BLAS_scopy(n, r_b, 1, results%force(1,1,jspin), 1)
DEALLOCATE (r_b)
ENDIF
!
! -> Optional the LO-coefficients: aclo,bclo,enerlo,cclo,acnmt,bcnmt,ccnmt
!
IF (atoms%nlod.GE.1) THEN
n=atoms%nlod*atoms%ntype
......@@ -223,11 +226,9 @@ CONTAINS
DEALLOCATE (r_b)
ENDIF
!
! -> Now the SOC - stuff: orb, orblo and orblo
!
IF (noco%l_soc) THEN
!
! orb
n=(atoms%lmaxd+1)*(2*atoms%lmaxd+1)*atoms%ntype
ALLOCATE (r_b(n))
......@@ -312,9 +313,7 @@ CONTAINS
ENDIF
!
! -> Collect the noco staff:
!
IF ( noco%l_noco .AND. jspin.EQ.1 ) THEN
n = stars%ng3
......@@ -347,9 +346,8 @@ CONTAINS
IF (noco%l_mperp) THEN
!
! --> for (spin)-off diagonal part of muffin-tin
!
n = (atoms%lmaxd+1) * atoms%ntype
ALLOCATE(c_b(n))
CALL MPI_REDUCE(denCoeffsOffdiag%uu21(:,:),c_b,n,CPP_MPI_COMPLEX, MPI_SUM,0,MPI_COMM_WORLD,ierr)
......@@ -369,9 +367,8 @@ CONTAINS
CALL CPP_BLAS_ccopy(n, c_b, 1, denCoeffsOffdiag%dd21(:,:), 1)
ENDIF
DEALLOCATE (c_b)
!
! --> lo,u coeff's:
!
n = atoms%nlod * atoms%ntype
ALLOCATE(c_b(n))
CALL MPI_REDUCE(denCoeffsOffdiag%uulo21(:,:),c_b,n,CPP_MPI_COMPLEX, MPI_SUM,0,MPI_COMM_WORLD,ierr)
......@@ -391,9 +388,8 @@ CONTAINS
CALL CPP_BLAS_ccopy(n, c_b, 1, denCoeffsOffdiag%ulod21(:,:), 1)
ENDIF
DEALLOCATE (c_b)
!
! --> lo,lo' coeff's:
!
n = atoms%nlod*atoms%nlod*atoms%ntype
ALLOCATE(c_b(n))
CALL MPI_REDUCE(denCoeffsOffdiag%uloulop21,c_b,n,CPP_MPI_COMPLEX, MPI_SUM,0,MPI_COMM_WORLD,ierr)
......@@ -403,9 +399,8 @@ CONTAINS
DEALLOCATE (c_b)
IF (denCoeffsOffdiag%l_fmpl) THEN
!
!--> Full magnetization plots: Collect uunmt21, etc.
!
n = (atoms%lmaxd+1)**2 *sphhar%nlhd*atoms%ntype
ALLOCATE(c_b(n))
CALL MPI_REDUCE(denCoeffsOffdiag%uunmt21,c_b,n,CPP_MPI_COMPLEX,MPI_SUM,0 ,MPI_COMM_WORLD,ierr)
......
types/types_dos.f90
View file @ bd99a389
......@@ -11,6 +11,8 @@ IMPLICIT NONE
PRIVATE
TYPE t_dos
INTEGER, ALLOCATABLE :: jsym(:,:,:)
INTEGER, ALLOCATABLE :: ksym(:,:,:)
REAL, ALLOCATABLE :: qis(:,:,:)
REAL, ALLOCATABLE :: qal(:,:,:,:,:)
REAL, ALLOCATABLE :: qvac(:,:,:,:)
......@@ -39,12 +41,16 @@ SUBROUTINE dos_init(thisDOS,input,atoms,dimension,kpts,vacuum)
TYPE(t_kpts), INTENT(IN) :: kpts
TYPE(t_vacuum), INTENT(IN) :: vacuum
ALLOCATE(thisDOS%jsym(dimension%neigd,kpts%nkpt,input%jspins))
ALLOCATE(thisDOS%ksym(dimension%neigd,kpts%nkpt,input%jspins))
ALLOCATE(thisDOS%qis(dimension%neigd,kpts%nkpt,input%jspins))
ALLOCATE(thisDOS%qal(0:3,atoms%ntype,dimension%neigd,kpts%nkpt,input%jspins))
ALLOCATE(thisDOS%qvac(dimension%neigd,2,kpts%nkpt,input%jspins))
ALLOCATE(thisDOS%qvlay(dimension%neigd,vacuum%layerd,2,kpts%nkpt,input%jspins))
ALLOCATE(thisDOS%qstars(vacuum%nstars,dimension%neigd,vacuum%layerd,2,kpts%nkpt,input%jspins))
thisDOS%jsym = 0
thisDOS%ksym = 0
thisDOS%qis = 0.0
thisDOS%qal = 0.0
thisDOS%qvac = 0.0
......
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment