Commit ee533762 authored by Daniel Wortmann's avatar Daniel Wortmann

Merge branch 'develop' of iffgit.fz-juelich.de:fleur/fleur into develop

parents c3137481 c9a840fc
...@@ -11,7 +11,7 @@ USE m_juDFT ...@@ -11,7 +11,7 @@ USE m_juDFT
CONTAINS CONTAINS
SUBROUTINE cdnval(eig_id, mpi,kpts,jspin,sliceplot,noco, input,banddos,cell,atoms,enpara,stars,& SUBROUTINE cdnval(eig_id, mpi,kpts,jspin,sliceplot,noco, input,banddos,cell,atoms,enpara,stars,&
vacuum,dimension,sphhar,sym,obsolete,vTot,oneD,coreSpecInput,cdnvalKLoop,den,regCharges,results,& vacuum,dimension,sphhar,sym,obsolete,vTot,oneD,coreSpecInput,cdnvalKLoop,den,regCharges,dos,results,&
moments,mcd,slab) moments,mcd,slab)
!************************************************************************************ !************************************************************************************
...@@ -76,6 +76,7 @@ SUBROUTINE cdnval(eig_id, mpi,kpts,jspin,sliceplot,noco, input,banddos,cell,atom ...@@ -76,6 +76,7 @@ SUBROUTINE cdnval(eig_id, mpi,kpts,jspin,sliceplot,noco, input,banddos,cell,atom
TYPE(t_cdnvalKLoop), INTENT(IN) :: cdnvalKLoop TYPE(t_cdnvalKLoop), INTENT(IN) :: cdnvalKLoop
TYPE(t_potden), INTENT(INOUT) :: den TYPE(t_potden), INTENT(INOUT) :: den
TYPE(t_regionCharges), INTENT(INOUT) :: regCharges TYPE(t_regionCharges), INTENT(INOUT) :: regCharges
TYPE(t_dos), INTENT(INOUT) :: dos
TYPE(t_moments), INTENT(INOUT) :: moments TYPE(t_moments), INTENT(INOUT) :: moments
TYPE(t_mcd), INTENT(INOUT) :: mcd TYPE(t_mcd), INTENT(INOUT) :: mcd
TYPE(t_slab), INTENT(INOUT) :: slab TYPE(t_slab), INTENT(INOUT) :: slab
...@@ -212,7 +213,7 @@ SUBROUTINE cdnval(eig_id, mpi,kpts,jspin,sliceplot,noco, input,banddos,cell,atom ...@@ -212,7 +213,7 @@ SUBROUTINE cdnval(eig_id, mpi,kpts,jspin,sliceplot,noco, input,banddos,cell,atom
CALL MPI_BARRIER(mpi%mpi_comm,iErr) ! Synchronizes the RMA operations CALL MPI_BARRIER(mpi%mpi_comm,iErr) ! Synchronizes the RMA operations
#endif #endif
IF (noccbd.LE.0) GO TO 199 ! Note: This jump has to be after the MPI_BARRIER is called IF (noccbd.LE.0) CYCLE ! Note: This jump has to be after the MPI_BARRIER is called
CALL gVacMap%init(dimension,sym,atoms,vacuum,stars,lapw,input,cell,kpts,enpara,vTot,ikpt,jspin) CALL gVacMap%init(dimension,sym,atoms,vacuum,stars,lapw,input,cell,kpts,enpara,vTot,ikpt,jspin)
...@@ -220,17 +221,17 @@ SUBROUTINE cdnval(eig_id, mpi,kpts,jspin,sliceplot,noco, input,banddos,cell,atom ...@@ -220,17 +221,17 @@ SUBROUTINE cdnval(eig_id, mpi,kpts,jspin,sliceplot,noco, input,banddos,cell,atom
IF (.NOT.((jspin.EQ.2).AND.noco%l_noco)) THEN IF (.NOT.((jspin.EQ.2).AND.noco%l_noco)) THEN
! valence density in the interstitial region ! valence density in the interstitial region
CALL pwden(stars,kpts,banddos,oneD,input,mpi,noco,cell,atoms,sym,ikpt,& CALL pwden(stars,kpts,banddos,oneD,input,mpi,noco,cell,atoms,sym,ikpt,&
jspin,lapw,noccbd,we,eig,den,regCharges%qis,results,force%f_b8,zMat) jspin,lapw,noccbd,we,eig,den,dos%qis,results,force%f_b8,zMat)
! charge of each valence state in this k-point of the SBZ in the layer interstitial region of the film ! charge of each valence state in this k-point of the SBZ in the layer interstitial region of the film
IF (l_dosNdir) CALL q_int_sl(jspin,stars,atoms,sym,cell,noccbd,lapw,slab,oneD,zMat) IF (l_dosNdir) CALL q_int_sl(jspin,stars,atoms,sym,cell,noccbd,lapw,slab,oneD,zMat)
! valence density in the vacuum region ! valence density in the vacuum region
IF (input%film) THEN IF (input%film) THEN
CALL vacden(vacuum,dimension,stars,oneD, kpts,input,sym,cell,atoms,noco,banddos,& CALL vacden(vacuum,dimension,stars,oneD, kpts,input,sym,cell,atoms,noco,banddos,&
gVacMap,we,ikpt,jspin,vTot%vacz(:,:,jspin),noccbd,lapw,enpara%evac0,eig,& gVacMap,we,ikpt,jspin,vTot%vacz(:,:,jspin),noccbd,lapw,enpara%evac0,eig,&
den,regCharges%qvac,regCharges%qvlay,regCharges%qstars,zMat) den,dos%qvac,dos%qvlay,dos%qstars,zMat)
END IF END IF
END IF END IF
IF (input%film) CALL regCharges%sumBandsVac(vacuum,noccbd,ikpt,jsp_start,jsp_end,eig,we) IF (input%film) CALL regCharges%sumBandsVac(vacuum,dos,noccbd,ikpt,jsp_start,jsp_end,eig,we)
! valence density in the atomic spheres ! valence density in the atomic spheres
CALL eigVecCoeffs%init(dimension,atoms,noco,jspin,noccbd) CALL eigVecCoeffs%init(dimension,atoms,noco,jspin,noccbd)
...@@ -244,9 +245,9 @@ SUBROUTINE cdnval(eig_id, mpi,kpts,jspin,sliceplot,noco, input,banddos,cell,atom ...@@ -244,9 +245,9 @@ SUBROUTINE cdnval(eig_id, mpi,kpts,jspin,sliceplot,noco, input,banddos,cell,atom
! perform Brillouin zone integration and summation over the ! perform Brillouin zone integration and summation over the
! bands in order to determine the energy parameters for each atom and angular momentum ! bands in order to determine the energy parameters for each atom and angular momentum
CALL eparas(ispin,atoms,noccbd,mpi,ikpt,noccbd,we,eig,& CALL eparas(ispin,atoms,noccbd,mpi,ikpt,noccbd,we,eig,&
skip_t,cdnvalKLoop%l_evp,eigVecCoeffs,usdus,regCharges,mcd,banddos%l_mcd) skip_t,cdnvalKLoop%l_evp,eigVecCoeffs,usdus,regCharges,dos,mcd,banddos%l_mcd)
IF (noco%l_mperp.AND.(ispin==jsp_end)) CALL qal_21(dimension,atoms,input,noccbd,noco,eigVecCoeffs,denCoeffsOffdiag,regCharges) IF (noco%l_mperp.AND.(ispin==jsp_end)) CALL qal_21(dimension,atoms,input,noccbd,noco,eigVecCoeffs,denCoeffsOffdiag,ikpt,dos)
! layer charge of each valence state in this k-point of the SBZ from the mt-sphere region of the film ! layer charge of each valence state in this k-point of the SBZ from the mt-sphere region of the film
IF (l_dosNdir) THEN IF (l_dosNdir) THEN
...@@ -268,12 +269,11 @@ SUBROUTINE cdnval(eig_id, mpi,kpts,jspin,sliceplot,noco, input,banddos,cell,atom ...@@ -268,12 +269,11 @@ SUBROUTINE cdnval(eig_id, mpi,kpts,jspin,sliceplot,noco, input,banddos,cell,atom
END DO ! end loop over ispin END DO ! end loop over ispin
IF (noco%l_mperp) CALL denCoeffsOffdiag%calcCoefficients(atoms,sphhar,sym,eigVecCoeffs,we,noccbd) IF (noco%l_mperp) CALL denCoeffsOffdiag%calcCoefficients(atoms,sphhar,sym,eigVecCoeffs,we,noccbd)
199 CONTINUE
IF ((banddos%dos.OR.banddos%vacdos.OR.input%cdinf)) THEN 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! ! 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,ksym,jsym,zMat)
CALL write_dos(eig_id,ikpt,jspin,regCharges,slab,orbcomp,ksym,jsym,mcd%mcd) CALL write_dos(eig_id,ikpt,jspin,dos,slab,orbcomp,ksym,jsym,mcd%mcd)
END IF END IF
END DO ! end of k-point loop END DO ! end of k-point loop
......
...@@ -24,7 +24,7 @@ MODULE m_eparas ...@@ -24,7 +24,7 @@ MODULE m_eparas
! !
CONTAINS CONTAINS
SUBROUTINE eparas(jsp,atoms,noccbd, mpi,ikpt,ne,we,eig,skip_t,l_evp,eigVecCoeffs,& SUBROUTINE eparas(jsp,atoms,noccbd, mpi,ikpt,ne,we,eig,skip_t,l_evp,eigVecCoeffs,&
usdus,regCharges,mcd,l_mcd) usdus,regCharges,dos,mcd,l_mcd)
USE m_types USE m_types
IMPLICIT NONE IMPLICIT NONE
TYPE(t_usdus), INTENT(IN) :: usdus TYPE(t_usdus), INTENT(IN) :: usdus
...@@ -32,6 +32,7 @@ CONTAINS ...@@ -32,6 +32,7 @@ CONTAINS
TYPE(t_atoms), INTENT(IN) :: atoms TYPE(t_atoms), INTENT(IN) :: atoms
TYPE(t_eigVecCoeffs), INTENT(IN) :: eigVecCoeffs TYPE(t_eigVecCoeffs), INTENT(IN) :: eigVecCoeffs
TYPE(t_regionCharges), INTENT(INOUT) :: regCharges TYPE(t_regionCharges), INTENT(INOUT) :: regCharges
TYPE(t_dos), INTENT(INOUT) :: dos
TYPE(t_mcd), INTENT(INOUT) :: mcd TYPE(t_mcd), INTENT(INOUT) :: mcd
! .. ! ..
! .. Scalar Arguments .. ! .. Scalar Arguments ..
...@@ -64,9 +65,9 @@ CONTAINS ...@@ -64,9 +65,9 @@ CONTAINS
ENDIF ENDIF
regCharges%ener(:,:,jsp) = 0.0 regCharges%ener(:,:,jsp) = 0.0
regCharges%sqal(:,:,jsp) = 0.0 regCharges%sqal(:,:,jsp) = 0.0
regCharges%qal(:,:,:,jsp) = 0.0
regCharges%enerlo(:,:,jsp) = 0.0 regCharges%enerlo(:,:,jsp) = 0.0
regCharges%sqlo(:,:,jsp) = 0.0 regCharges%sqlo(:,:,jsp) = 0.0
dos%qal(:,:,:,ikpt,jsp) = 0.0
END IF END IF
! !
!---> l-decomposed density for each occupied state !---> l-decomposed density for each occupied state
...@@ -109,7 +110,7 @@ CONTAINS ...@@ -109,7 +110,7 @@ CONTAINS
ENDDO ENDDO
ENDIF ! end MCD ENDIF ! end MCD
ENDDO ENDDO
regCharges%qal(l,n,i,jsp) = (suma+sumb*usdus%ddn(l,n,jsp))/atoms%neq(n) dos%qal(l,n,i,ikpt,jsp) = (suma+sumb*usdus%ddn(l,n,jsp))/atoms%neq(n)
ENDDO ENDDO
nt1 = nt1 + atoms%neq(n) nt1 = nt1 + atoms%neq(n)
ENDDO ENDDO
...@@ -122,8 +123,8 @@ CONTAINS ...@@ -122,8 +123,8 @@ CONTAINS
DO l = 0,3 DO l = 0,3
DO n = 1,atoms%ntype DO n = 1,atoms%ntype
DO i = (skip_t+1),noccbd DO i = (skip_t+1),noccbd
regCharges%ener(l,n,jsp) = regCharges%ener(l,n,jsp) + regCharges%qal(l,n,i,jsp)*we(i)*eig(i) regCharges%ener(l,n,jsp) = regCharges%ener(l,n,jsp) + dos%qal(l,n,i,ikpt,jsp)*we(i)*eig(i)
regCharges%sqal(l,n,jsp) = regCharges%sqal(l,n,jsp) + regCharges%qal(l,n,i,jsp)*we(i) regCharges%sqal(l,n,jsp) = regCharges%sqal(l,n,jsp) + dos%qal(l,n,i,ikpt,jsp)*we(i)
ENDDO ENDDO
ENDDO ENDDO
ENDDO ENDDO
...@@ -176,7 +177,7 @@ CONTAINS ...@@ -176,7 +177,7 @@ CONTAINS
! llo > 3 used for unoccupied states only ! llo > 3 used for unoccupied states only
IF( l .GT. 3 ) CYCLE IF( l .GT. 3 ) CYCLE
DO i = 1,ne DO i = 1,ne
regCharges%qal(l,ntyp,i,jsp)= regCharges%qal(l,ntyp,i,jsp) + ( 1.0/atoms%neq(ntyp) )* (& dos%qal(l,ntyp,i,ikpt,jsp)= dos%qal(l,ntyp,i,ikpt,jsp) + ( 1.0/atoms%neq(ntyp) )* (&
qaclo(i,lo,ntyp)*usdus%uulon(lo,ntyp,jsp)+qbclo(i,lo,ntyp)*usdus%dulon(lo,ntyp,jsp) ) qaclo(i,lo,ntyp)*usdus%uulon(lo,ntyp,jsp)+qbclo(i,lo,ntyp)*usdus%dulon(lo,ntyp,jsp) )
END DO END DO
DO lop = 1,atoms%nlo(ntyp) DO lop = 1,atoms%nlo(ntyp)
...@@ -184,7 +185,7 @@ CONTAINS ...@@ -184,7 +185,7 @@ CONTAINS
DO i = 1,ne DO i = 1,ne
regCharges%enerlo(lo,ntyp,jsp) = regCharges%enerlo(lo,ntyp,jsp) +qlo(i,lop,lo,ntyp)*we(i)*eig(i) regCharges%enerlo(lo,ntyp,jsp) = regCharges%enerlo(lo,ntyp,jsp) +qlo(i,lop,lo,ntyp)*we(i)*eig(i)
regCharges%sqlo(lo,ntyp,jsp) = regCharges%sqlo(lo,ntyp,jsp) + qlo(i,lop,lo,ntyp)*we(i) regCharges%sqlo(lo,ntyp,jsp) = regCharges%sqlo(lo,ntyp,jsp) + qlo(i,lop,lo,ntyp)*we(i)
regCharges%qal(l,ntyp,i,jsp)= regCharges%qal(l,ntyp,i,jsp) + ( 1.0/atoms%neq(ntyp) ) *& dos%qal(l,ntyp,i,ikpt,jsp)= dos%qal(l,ntyp,i,ikpt,jsp) + ( 1.0/atoms%neq(ntyp) ) *&
qlo(i,lop,lo,ntyp)*usdus%uloulopn(lop,lo,ntyp,jsp) qlo(i,lop,lo,ntyp)*usdus%uloulopn(lop,lo,ntyp,jsp)
ENDDO ENDDO
ENDIF ENDIF
......
...@@ -5,7 +5,7 @@ MODULE m_qal21 ...@@ -5,7 +5,7 @@ MODULE m_qal21
!*********************************************************************** !***********************************************************************
! !
CONTAINS CONTAINS
SUBROUTINE qal_21(dimension,atoms,input,noccbd,noco,eigVecCoeffs,denCoeffsOffdiag,regCharges) SUBROUTINE qal_21(dimension,atoms,input,noccbd,noco,eigVecCoeffs,denCoeffsOffdiag,ikpt,dos)
USE m_rotdenmat USE m_rotdenmat
USE m_types USE m_types
...@@ -16,10 +16,10 @@ CONTAINS ...@@ -16,10 +16,10 @@ CONTAINS
TYPE(t_atoms), INTENT(IN) :: atoms TYPE(t_atoms), INTENT(IN) :: atoms
TYPE(t_eigVecCoeffs), INTENT(IN) :: eigVecCoeffs TYPE(t_eigVecCoeffs), INTENT(IN) :: eigVecCoeffs
TYPE(t_denCoeffsOffdiag), INTENT(IN) :: denCoeffsOffdiag TYPE(t_denCoeffsOffdiag), INTENT(IN) :: denCoeffsOffdiag
TYPE(t_regionCharges), INTENT(INOUT) :: regCharges TYPE(t_dos), INTENT(INOUT) :: dos
! .. Scalar Arguments .. ! .. Scalar Arguments ..
INTEGER, INTENT (IN) :: noccbd INTEGER, INTENT (IN) :: noccbd,ikpt
! .. Local Scalars .. ! .. Local Scalars ..
INTEGER i,l,lo,lop ,natom,nn,ntyp INTEGER i,l,lo,lop ,natom,nn,ntyp
...@@ -149,11 +149,10 @@ CONTAINS ...@@ -149,11 +149,10 @@ CONTAINS
state : DO i = 1, noccbd state : DO i = 1, noccbd
lls : DO l = 0,3 lls : DO l = 0,3
CALL rot_den_mat(noco%alph(n),noco%beta(n),& CALL rot_den_mat(noco%alph(n),noco%beta(n),&
regCharges%qal(l,n,i,1),regCharges%qal(l,n,i,2),qal21(l,n,i)) dos%qal(l,n,i,ikpt,1),dos%qal(l,n,i,ikpt,2),qal21(l,n,i))
IF (.FALSE.) THEN IF (.FALSE.) THEN
IF (n==1) WRITE(*,'(3i3,4f10.5)') l,n,i,qal21(l,n,i),& IF (n==1) WRITE(*,'(3i3,4f10.5)') l,n,i,qal21(l,n,i),dos%qal(l,n,i,ikpt,:)
regCharges%qal(l,n,i,:) q_loc(1,1) = dos%qal(l,n,i,ikpt,1); q_loc(2,2) = dos%qal(l,n,i,ikpt,2)
q_loc(1,1) = regCharges%qal(l,n,i,1); q_loc(2,2) = regCharges%qal(l,n,i,2)
q_loc(1,2) = qal21(l,n,i); q_loc(2,1) = CONJG(q_loc(1,2)) q_loc(1,2) = qal21(l,n,i); q_loc(2,1) = CONJG(q_loc(1,2))
q_hlp = MATMUL( TRANSPOSE( CONJG(chi) ) ,q_loc) q_hlp = MATMUL( TRANSPOSE( CONJG(chi) ) ,q_loc)
q_loc = MATMUL(q_hlp,chi) q_loc = MATMUL(q_hlp,chi)
......
...@@ -70,14 +70,14 @@ CONTAINS ...@@ -70,14 +70,14 @@ CONTAINS
INTEGER,PARAMETER :: n2max=13 INTEGER,PARAMETER :: n2max=13
REAL,PARAMETER :: emax=2.0/hartree_to_ev_const REAL,PARAMETER :: emax=2.0/hartree_to_ev_const
! .. Array Arguments .. ! .. Array Arguments ..
REAL, INTENT(IN) :: evac(2,DIMENSION%jspd) REAL, INTENT(IN) :: evac(2,DIMENSION%jspd)
REAL, INTENT(OUT) :: qvlay(DIMENSION%neigd,vacuum%layerd,2,kpts%nkpt,DIMENSION%jspd) REAL, INTENT(OUT) :: qvlay(DIMENSION%neigd,vacuum%layerd,2,kpts%nkpt,DIMENSION%jspd)
REAL, INTENT(INOUT) :: qvac(DIMENSION%neigd,2,kpts%nkpt,DIMENSION%jspd) REAL, INTENT(INOUT) :: qvac(DIMENSION%neigd,2,kpts%nkpt,DIMENSION%jspd)
REAL, INTENT(IN) :: we(DIMENSION%neigd) REAL, INTENT(IN) :: we(DIMENSION%neigd)
REAL :: vz(vacuum%nmzd,2) ! Note this breaks the INTENT(IN) from cdnval. It may be read from a file in this subroutine. REAL :: vz(vacuum%nmzd,2) ! Note this breaks the INTENT(IN) from cdnval. It may be read from a file in this subroutine.
! STM-Arguments ! STM-Arguments
REAL, INTENT (IN) :: eig(DIMENSION%neigd) REAL, INTENT (IN) :: eig(DIMENSION%neigd)
COMPLEX, INTENT (OUT):: stcoeff(vacuum%nstars,DIMENSION%neigd,vacuum%layerd,2) COMPLEX, INTENT (INOUT) :: stcoeff(vacuum%nstars,DIMENSION%neigd,vacuum%layerd,2,kpts%nkpt,input%jspins)
! !
! local STM variables ! local STM variables
INTEGER nv2(DIMENSION%jspd) INTEGER nv2(DIMENSION%jspd)
...@@ -170,8 +170,6 @@ CONTAINS ...@@ -170,8 +170,6 @@ CONTAINS
! ------------------ ! ------------------
! WRITE (16,'(a,i2)') 'nstars=',nstars ! WRITE (16,'(a,i2)') 'nstars=',nstars
stcoeff(:,:,:,:) = CMPLX(0.0,0.0)
! -----> set up mapping arrays ! -----> set up mapping arrays
IF (noco%l_ss) THEN IF (noco%l_ss) THEN
jsp_start = 1 jsp_start = 1
...@@ -1198,7 +1196,7 @@ CONTAINS ...@@ -1198,7 +1196,7 @@ CONTAINS
!============================================================= !=============================================================
! !
! calculate 1. to nstars. starcoefficient for each k and energy eigenvalue ! calculate 1. to nstars. starcoefficient for each k and energy eigenvalue
! to stcoeff(ne,layer,ivac) if starcoeff=T (the star coefficient values are written to vacdos) ! to stcoeff(ne,layer,ivac,ikpt) if starcoeff=T (the star coefficient values are written to vacdos)
! !
IF (vacuum%starcoeff .AND. banddos%vacdos) THEN IF (vacuum%starcoeff .AND. banddos%vacdos) THEN
DO n=1,ne DO n=1,ne
...@@ -1229,9 +1227,9 @@ CONTAINS ...@@ -1229,9 +1227,9 @@ CONTAINS
uej = ue(vacuum%izlay(jj,1),l1,jspin) uej = ue(vacuum%izlay(jj,1),l1,jspin)
t1 = aa*ui*uj + bb*uei*uej +ba*ui*uej + ab*uei*uj t1 = aa*ui*uj + bb*uei*uej +ba*ui*uej + ab*uei*uj
IF (ind2.GE.2.AND.ind2.LE.vacuum%nstars) & IF (ind2.GE.2.AND.ind2.LE.vacuum%nstars) &
stcoeff(ind2-1,n,jj,ivac) = stcoeff(ind2-1,n,jj,ivac)+ t1*phs/stars%nstr2(ind2) stcoeff(ind2-1,n,jj,ivac,ikpt,jspin) = stcoeff(ind2-1,n,jj,ivac,ikpt,jspin)+ t1*phs/stars%nstr2(ind2)
IF (ind2p.GE.2.AND.ind2p.LE.vacuum%nstars) & IF (ind2p.GE.2.AND.ind2p.LE.vacuum%nstars) &
stcoeff(ind2p-1,n,jj,ivac) = stcoeff(ind2p-1,n,jj,ivac) +CONJG(t1)*phs/stars%nstr2(ind2p) stcoeff(ind2p-1,n,jj,ivac,ikpt,jspin) = stcoeff(ind2p-1,n,jj,ivac,ikpt,jspin) +CONJG(t1)*phs/stars%nstr2(ind2p)
END DO END DO
END IF END IF
ENDDO ENDDO
......
...@@ -167,7 +167,7 @@ CONTAINS ...@@ -167,7 +167,7 @@ CONTAINS
CALL timestop("IO (write)") CALL timestop("IO (write)")
END SUBROUTINE write_eig END SUBROUTINE write_eig
SUBROUTINE write_dos(id,nk,jspin,regCharges,slab,orbcomp,ksym,jsym,mcd) SUBROUTINE write_dos(id,nk,jspin,dos,slab,orbcomp,ksym,jsym,mcd)
USE m_eig66_hdf,ONLY:write_dos_hdf=>write_dos USE m_eig66_hdf,ONLY:write_dos_hdf=>write_dos
USE m_eig66_DA ,ONLY:write_dos_DA=>write_dos USE m_eig66_DA ,ONLY:write_dos_DA=>write_dos
USE m_eig66_mem,ONLY:write_dos_MEM=>write_dos USE m_eig66_mem,ONLY:write_dos_MEM=>write_dos
...@@ -175,28 +175,28 @@ CONTAINS ...@@ -175,28 +175,28 @@ CONTAINS
USE m_types USE m_types
IMPLICIT NONE IMPLICIT NONE
INTEGER, INTENT(IN) :: id,nk,jspin INTEGER, INTENT(IN) :: id,nk,jspin
TYPE(t_regionCharges), INTENT(IN) :: regCharges TYPE(t_dos), INTENT(IN) :: dos
TYPE(t_orbcomp), INTENT(IN) :: orbcomp TYPE(t_orbcomp), INTENT(IN) :: orbcomp
TYPE(t_slab), INTENT(IN) :: slab TYPE(t_slab), INTENT(IN) :: slab
INTEGER,INTENT(IN) :: ksym(:),jsym(:) INTEGER,INTENT(IN) :: ksym(:),jsym(:)
REAL,INTENT(IN),OPTIONAL :: mcd(:,:,:) REAL,INTENT(IN),OPTIONAL :: mcd(:,:,:)
CALL timestart("IO (dos-write)") CALL timestart("IO (dos-write)")
SELECT CASE (eig66_data_mode(id)) SELECT CASE (eig66_data_mode(id))
CASE (da_mode) CASE (da_mode)
CALL write_dos_DA(id,nk,jspin,regCharges%qal(:,:,:,jspin),regCharges%qvac(:,:,nk,jspin),& CALL write_dos_DA(id,nk,jspin,dos%qal(:,:,:,nk,jspin),dos%qvac(:,:,nk,jspin),&
regCharges%qis(:,nk,jspin),regCharges%qvlay(:,:,:,nk,jspin),regCharges%qstars,& dos%qis(:,nk,jspin),dos%qvlay(:,:,:,nk,jspin),dos%qstars(:,:,:,:,nk,jspin),&
ksym,jsym,mcd,slab%qintsl,slab%qmtsl,orbcomp%qmtp,orbcomp%comp) ksym,jsym,mcd,slab%qintsl,slab%qmtsl,orbcomp%qmtp,orbcomp%comp)
CASE (hdf_mode) CASE (hdf_mode)
CALL write_dos_HDF(id,nk,jspin,regCharges%qal(:,:,:,jspin),regCharges%qvac(:,:,nk,jspin),& CALL write_dos_HDF(id,nk,jspin,dos%qal(:,:,:,nk,jspin),dos%qvac(:,:,nk,jspin),&
regCharges%qis(:,nk,jspin),regCharges%qvlay(:,:,:,nk,jspin),regCharges%qstars,& dos%qis(:,nk,jspin),dos%qvlay(:,:,:,nk,jspin),dos%qstars(:,:,:,:,nk,jspin),&
ksym,jsym,mcd,slab%qintsl,slab%qmtsl,orbcomp%qmtp,orbcomp%comp) ksym,jsym,mcd,slab%qintsl,slab%qmtsl,orbcomp%qmtp,orbcomp%comp)
CASE (mem_mode) CASE (mem_mode)
CALL write_dos_Mem(id,nk,jspin,regCharges%qal(:,:,:,jspin),regCharges%qvac(:,:,nk,jspin),& CALL write_dos_Mem(id,nk,jspin,dos%qal(:,:,:,nk,jspin),dos%qvac(:,:,nk,jspin),&
regCharges%qis(:,nk,jspin),regCharges%qvlay(:,:,:,nk,jspin),regCharges%qstars,& dos%qis(:,nk,jspin),dos%qvlay(:,:,:,nk,jspin),dos%qstars(:,:,:,:,nk,jspin),&
ksym,jsym,mcd,slab%qintsl,slab%qmtsl,orbcomp%qmtp,orbcomp%comp) ksym,jsym,mcd,slab%qintsl,slab%qmtsl,orbcomp%qmtp,orbcomp%comp)
CASE (MPI_mode) CASE (MPI_mode)
CALL write_dos_MPI(id,nk,jspin,regCharges%qal(:,:,:,jspin),regCharges%qvac(:,:,nk,jspin),& CALL write_dos_MPI(id,nk,jspin,dos%qal(:,:,:,nk,jspin),dos%qvac(:,:,nk,jspin),&
regCharges%qis(:,nk,jspin),regCharges%qvlay(:,:,:,nk,jspin),regCharges%qstars,& dos%qis(:,nk,jspin),dos%qvlay(:,:,:,nk,jspin),dos%qstars(:,:,:,:,nk,jspin),&
ksym,jsym,mcd,slab%qintsl,slab%qmtsl,orbcomp%qmtp,orbcomp%comp) ksym,jsym,mcd,slab%qintsl,slab%qmtsl,orbcomp%qmtp,orbcomp%comp)
CASE (-1) CASE (-1)
CALL juDFT_error("Could not write DOS to eig-file before opening", calledby = "eig66_io") CALL juDFT_error("Could not write DOS to eig-file before opening", calledby = "eig66_io")
......
...@@ -70,6 +70,7 @@ SUBROUTINE cdngen(eig_id,mpi,input,banddos,sliceplot,vacuum,& ...@@ -70,6 +70,7 @@ SUBROUTINE cdngen(eig_id,mpi,input,banddos,sliceplot,vacuum,&
! Local type instances ! Local type instances
TYPE(t_noco) :: noco_new TYPE(t_noco) :: noco_new
TYPE(t_regionCharges) :: regCharges TYPE(t_regionCharges) :: regCharges
TYPE(t_dos) :: dos
TYPE(t_moments) :: moments TYPE(t_moments) :: moments
TYPE(t_mcd) :: mcd TYPE(t_mcd) :: mcd
TYPE(t_slab) :: slab TYPE(t_slab) :: slab
...@@ -80,7 +81,8 @@ SUBROUTINE cdngen(eig_id,mpi,input,banddos,sliceplot,vacuum,& ...@@ -80,7 +81,8 @@ SUBROUTINE cdngen(eig_id,mpi,input,banddos,sliceplot,vacuum,&
REAL :: fix, qtot, dummy REAL :: fix, qtot, dummy
INTEGER :: jspin, jspmax INTEGER :: jspin, jspmax
CALL regCharges%init(input,atoms,dimension,kpts,vacuum) CALL regCharges%init(input,atoms)
CALL dos%init(input,atoms,dimension,kpts,vacuum)
CALL moments%init(input,atoms) CALL moments%init(input,atoms)
IF (mpi%irank.EQ.0) CALL openXMLElementNoAttributes('valenceDensity') IF (mpi%irank.EQ.0) CALL openXMLElementNoAttributes('valenceDensity')
...@@ -94,7 +96,7 @@ SUBROUTINE cdngen(eig_id,mpi,input,banddos,sliceplot,vacuum,& ...@@ -94,7 +96,7 @@ SUBROUTINE cdngen(eig_id,mpi,input,banddos,sliceplot,vacuum,&
DO jspin = 1,jspmax DO jspin = 1,jspmax
CALL cdnvalKLoop%init(mpi,input,kpts,banddos,noco,results,jspin,sliceplot) CALL cdnvalKLoop%init(mpi,input,kpts,banddos,noco,results,jspin,sliceplot)
CALL cdnval(eig_id,mpi,kpts,jspin,sliceplot,noco,input,banddos,cell,atoms,enpara,stars,vacuum,dimension,& CALL cdnval(eig_id,mpi,kpts,jspin,sliceplot,noco,input,banddos,cell,atoms,enpara,stars,vacuum,dimension,&
sphhar,sym,obsolete,vTot,oneD,coreSpecInput,cdnvalKLoop,outDen,regCharges,results,moments,mcd,slab) sphhar,sym,obsolete,vTot,oneD,coreSpecInput,cdnvalKLoop,outDen,regCharges,dos,results,moments,mcd,slab)
END DO END DO
IF (mpi%irank.EQ.0) THEN IF (mpi%irank.EQ.0) THEN
......
...@@ -18,6 +18,7 @@ types/types_usdus.F90 ...@@ -18,6 +18,7 @@ types/types_usdus.F90
types/types_cdnval.f90 types/types_cdnval.f90
types/types_field.F90 types/types_field.F90
types/types_regionCharges.f90 types/types_regionCharges.f90
types/types_dos.f90
types/types_denCoeffsOffdiag.f90 types/types_denCoeffsOffdiag.f90
types/types_force.f90 types/types_force.f90
) )
...@@ -40,6 +41,7 @@ types/types_setup.F90 ...@@ -40,6 +41,7 @@ types/types_setup.F90
types/types_usdus.F90 types/types_usdus.F90
types/types_cdnval.f90 types/types_cdnval.f90
types/types_regionCharges.f90 types/types_regionCharges.f90
types/types_dos.f90
types/types_denCoeffsOffdiag.f90 types/types_denCoeffsOffdiag.f90
types/types_force.f90 types/types_force.f90
) )
...@@ -22,6 +22,7 @@ MODULE m_types ...@@ -22,6 +22,7 @@ MODULE m_types
USE m_types_cdnval USE m_types_cdnval
USE m_types_field USE m_types_field
USE m_types_regionCharges USE m_types_regionCharges
USE m_types_dos
USE m_types_denCoeffsOffdiag USE m_types_denCoeffsOffdiag
USE m_types_force USE m_types_force
END MODULE m_types END MODULE m_types
......
!--------------------------------------------------------------------------------
! Copyright (c) 2018 Peter Grünberg Institut, Forschungszentrum Jülich, Germany
! This file is part of FLEUR and available as free software under the conditions
! of the MIT license as expressed in the LICENSE file in more detail.
!--------------------------------------------------------------------------------
MODULE m_types_dos
IMPLICIT NONE
PRIVATE
TYPE t_dos
REAL, ALLOCATABLE :: qis(:,:,:)
REAL, ALLOCATABLE :: qal(:,:,:,:,:)
REAL, ALLOCATABLE :: qvac(:,:,:,:)
REAL, ALLOCATABLE :: qvlay(:,:,:,:,:)
COMPLEX, ALLOCATABLE :: qstars(:,:,:,:,:,:)
CONTAINS
PROCEDURE,PASS :: init => dos_init
END TYPE t_dos
PUBLIC t_dos
CONTAINS
SUBROUTINE dos_init(thisDOS,input,atoms,dimension,kpts,vacuum)
USE m_types_setup
USE m_types_kpts
IMPLICIT NONE
CLASS(t_dos), INTENT(INOUT) :: thisDOS
TYPE(t_input), INTENT(IN) :: input
TYPE(t_atoms), INTENT(IN) :: atoms
TYPE(t_dimension), INTENT(IN) :: dimension
TYPE(t_kpts), INTENT(IN) :: kpts
TYPE(t_vacuum), INTENT(IN) :: vacuum
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%qis = 0.0
thisDOS%qal = 0.0
thisDOS%qvac = 0.0
thisDOS%qvlay = 0.0
thisDOS%qstars = CMPLX(0.0,0.0)
END SUBROUTINE dos_init
END MODULE m_types_dos
...@@ -12,20 +12,12 @@ PRIVATE ...@@ -12,20 +12,12 @@ PRIVATE
TYPE t_regionCharges TYPE t_regionCharges
REAL, ALLOCATABLE :: qis(:,:,:)
REAL, ALLOCATABLE :: qal(:,:,:,:)
REAL, ALLOCATABLE :: sqal(:,:,:) REAL, ALLOCATABLE :: sqal(:,:,:)
REAL, ALLOCATABLE :: ener(:,:,:) REAL, ALLOCATABLE :: ener(:,:,:)
REAL, ALLOCATABLE :: sqlo(:,:,:) REAL, ALLOCATABLE :: sqlo(:,:,:)
REAL, ALLOCATABLE :: enerlo(:,:,:) REAL, ALLOCATABLE :: enerlo(:,:,:)
REAL, ALLOCATABLE :: qvac(:,:,:,:)
REAL, ALLOCATABLE :: svac(:,:) REAL, ALLOCATABLE :: svac(:,:)
REAL, ALLOCATABLE :: pvac(:,:) REAL, ALLOCATABLE :: pvac(:,:)
REAL, ALLOCATABLE :: qvlay(:,:,:,:,:)
COMPLEX, ALLOCATABLE :: qstars(:,:,:,:)
CONTAINS CONTAINS
PROCEDURE,PASS :: init => regionCharges_init PROCEDURE,PASS :: init => regionCharges_init
...@@ -36,60 +28,43 @@ PUBLIC t_regionCharges ...@@ -36,60 +28,43 @@ PUBLIC t_regionCharges
CONTAINS CONTAINS
SUBROUTINE regionCharges_init(thisRegCharges,input,atoms,dimension,kpts,vacuum) SUBROUTINE regionCharges_init(thisRegCharges,input,atoms)
USE m_types_setup USE m_types_setup
USE m_types_kpts
IMPLICIT NONE