Commit b7cf3c84 authored by Gregor Michalicek's avatar Gregor Michalicek

Minor cleanup in cdn/cdnval.F90

parent f9e91577
......@@ -395,30 +395,23 @@ CONTAINS
lapw%k3(:,jspin),sym,dimension,nbands,cell,eig,noco, ksym,jsym,zMat)
END IF
!--dw now write k-point data to tmp_dos
CALL write_dos(eig_id,ikpt,jspin,regCharges%qal(:,:,:,jspin),regCharges%qvac(:,:,ikpt,jspin),regCharges%qis(:,ikpt,jspin),&
regCharges%qvlay(:,:,:,ikpt,jspin),regCharges%qstars,ksym,jsym,mcd%mcd,slab%qintsl,&
slab%qmtsl(:,:),orbcomp%qmtp(:,:),orbcomp%comp)
CALL write_dos(eig_id,ikpt,jspin,regCharges,slab,orbcomp,ksym,jsym,mcd%mcd)
CALL timestop("cdnval: write_info")
!-new_sl
END IF
END DO !---> end of k-point loop
DEALLOCATE (we)
!+t3e
#ifdef CPP_MPI
CALL timestart("cdnval: mpi_col_den")
DO ispin = jsp_start,jsp_end
CALL mpi_col_den(mpi,sphhar,atoms,oneD,stars,vacuum,&
input,noco,l_fmpl,ispin,llpd, den%vacxy(1,1,1,ispin),&
den%vacz(1,1,ispin),den%pw(1,ispin),regCharges,&
CALL mpi_col_den(mpi,sphhar,atoms,oneD,stars,vacuum,input,noco,l_fmpl,ispin,llpd,regCharges,&
results,denCoeffs,orb,denCoeffsOffdiag,den,den%mmpMat(:,:,:,jspin))
END DO
CALL timestop("cdnval: mpi_col_den")
#endif
IF (mpi%irank==0) THEN
CALL cdnmt(dimension%jspd,atoms,sphhar,llpd,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,&
usdus,orb,denCoeffsOffdiag,moments,den%mt)
......@@ -435,13 +428,6 @@ CONTAINS
END IF
DO ispin = jsp_start,jsp_end
IF (.NOT.sliceplot%slice) THEN
DO n=1,atoms%ntype
enpara%el1(0:3,n,ispin)=regCharges%ener(0:3,n,ispin)/regCharges%sqal(0:3,n,ispin)
IF (atoms%nlo(n)>0) enpara%ello1(:atoms%nlo(n),n,ispin)=regCharges%enerlo(:atoms%nlo(n),n,ispin)/regCharges%sqlo(:atoms%nlo(n),n,ispin)
END DO
IF (input%film) enpara%evac1(:vacuum%nvac,ispin)=regCharges%pvac(:vacuum%nvac,ispin)/regCharges%svac(:vacuum%nvac,ispin)
END IF
!---> check continuity of charge density
IF (input%cdinf) THEN
......@@ -451,14 +437,14 @@ CONTAINS
CALL checkDOPAll(input,dimension,sphhar,stars,atoms,sym,vacuum,oneD,cell,den,ispin)
CALL timestop("cdnval: cdninf-stuff")
END IF
!+for
!---> forces of equ. A8 of Yu et al.
IF ((input%l_f)) THEN
CALL timestart("cdnval: force_a8")
CALL force_a8(input,atoms,sphhar,ispin,vTot%mt(:,:,:,ispin),den%mt,force,results)
CALL timestop("cdnval: force_a8")
END IF
!-for
END DO ! end of loop ispin = jsp_start,jsp_end
CALL closeXMLElement('mtCharges')
......
!--------------------------------------------------------------------------------
! 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_calcDenCoeffs
CONTAINS
......
......@@ -10,7 +10,7 @@ MODULE m_cdnmt
! Philipp Kurz 2000-02-03
!***********************************************************************
CONTAINS
SUBROUTINE cdnmt(jspd,atoms,sphhar,llpd, noco,l_fmpl,jsp_start,jsp_end, epar,&
SUBROUTINE cdnmt(jspd,atoms,sphhar,noco,l_fmpl,jsp_start,jsp_end, epar,&
ello,vr,denCoeffs,usdus,orb,denCoeffsOffdiag,moments,rho)
use m_constants,only: sfp_const
USE m_rhosphnlo
......@@ -26,7 +26,6 @@ CONTAINS
TYPE(t_moments), INTENT(INOUT) :: moments
! .. Scalar Arguments ..
INTEGER, INTENT (IN) :: llpd
INTEGER, INTENT (IN) :: jsp_start,jsp_end,jspd
LOGICAL, INTENT (IN) :: l_fmpl
! ..
......
......@@ -20,9 +20,8 @@
< n_bands,n_size)
USE m_eig66_io, ONLY : read_eig
IMPLICIT NONE
!
! Arguments ...
!
INTEGER, INTENT (IN) :: eig_id,irank,isize
INTEGER, INTENT (IN) :: jspin,jspins
LOGICAL, INTENT (IN) :: l_noco
......@@ -34,20 +33,17 @@
INTEGER isp
IF (l_noco) THEN
CALL read_eig(eig_id,1,1,
< neig=n_bands(1))
ELSE
CALL read_eig(eig_id,1,jspin,
< neig=n_bands(1))
ENDIF
c
isp = MERGE(1,jspin,l_noco)
CALL read_eig(eig_id,1,isp,neig=n_bands(1))
c n_size is the number of records per k-point,
c n_bands(i) the number of ev's processed on n_rank=0...i-1
c
n_size = 1
n_bands(0) = 0
END SUBROUTINE cdn_read0
!
!--------------------------------------------------------------------
......@@ -83,26 +79,13 @@ c
INTEGER mpiierr
#endif
isp = MERGE(1,jspin,l_noco.OR.l_ss)
isp = MERGE(1,jspin,l_noco)
! For Non-Collinear, Spin-Spirals
CALL timestart("cdn_read")
IF (l_ss.OR.l_noco) THEN
CALL read_eig(eig_id,ikpt,isp, neig=nbands)
CALL read_eig(eig_id,ikpt,isp,n_start=n_start,n_end=n_end,
< eig=eig,zmat=zmat)
! For Collinear
ELSE
IF (zmat%l_real) THEN
zmat%z_r=0
ELSE
zmat%z_c=0
ENDIF
CALL read_eig(eig_id,ikpt,isp,n_start=n_start,n_end=n_end,
< neig=nbands,eig=eig,zmat=zmat)
ENDIF
CALL read_eig(eig_id,ikpt,isp,n_start=n_start,n_end=n_end,
< neig=nbands,eig=eig,zmat=zmat)
CALL timestop("cdn_read")
! IF (nbands>neigd) CALL juDFT_error("nbands.GT.neigd",calledby
......
......@@ -167,28 +167,37 @@ CONTAINS
CALL timestop("IO (write)")
END SUBROUTINE write_eig
SUBROUTINE write_dos(id,nk,jspin,qal,qvac,qis,qvlay,qstars,ksym,jsym,mcd,qintsl,qmtsl,qmtp,orbcomp)
SUBROUTINE write_dos(id,nk,jspin,regCharges,slab,orbcomp,ksym,jsym,mcd)
USE m_eig66_hdf,ONLY:write_dos_hdf=>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_MPI,ONLY:write_dos_MPI=>write_dos
USE m_types
IMPLICIT NONE
INTEGER, INTENT(IN) :: id,nk,jspin
REAL,INTENT(IN) :: qal(:,:,:),qvac(:,:),qis(:),qvlay(:,:,:)
COMPLEX,INTENT(IN) :: qstars(:,:,:,:)
TYPE(t_regionCharges), INTENT(IN) :: regCharges
TYPE(t_orbcomp), INTENT(IN) :: orbcomp
TYPE(t_slab), INTENT(IN) :: slab
INTEGER,INTENT(IN) :: ksym(:),jsym(:)
REAL,INTENT(IN),OPTIONAL :: mcd(:,:,:)
REAL,INTENT(IN),OPTIONAL :: qintsl(:,:),qmtsl(:,:),qmtp(:,:),orbcomp(:,:,:)
CALL timestart("IO (dos-write)")
SELECT CASE (eig66_data_mode(id))
CASE (da_mode)
CALL write_dos_DA(id,nk,jspin,qal,qvac,qis,qvlay,qstars,ksym,jsym,mcd,qintsl,qmtsl,qmtp,orbcomp)
CALL write_dos_DA(id,nk,jspin,regCharges%qal(:,:,:,jspin),regCharges%qvac(:,:,nk,jspin),&
regCharges%qis(:,nk,jspin),regCharges%qvlay(:,:,:,nk,jspin),regCharges%qstars,&
ksym,jsym,mcd,slab%qintsl,slab%qmtsl,orbcomp%qmtp,orbcomp%comp)
CASE (hdf_mode)
CALL write_dos_HDF(id,nk,jspin,qal,qvac,qis,qvlay,qstars,ksym,jsym,mcd,qintsl,qmtsl,qmtp,orbcomp)
CALL write_dos_HDF(id,nk,jspin,regCharges%qal(:,:,:,jspin),regCharges%qvac(:,:,nk,jspin),&
regCharges%qis(:,nk,jspin),regCharges%qvlay(:,:,:,nk,jspin),regCharges%qstars,&
ksym,jsym,mcd,slab%qintsl,slab%qmtsl,orbcomp%qmtp,orbcomp%comp)
CASE (mem_mode)
CALL write_dos_Mem(id,nk,jspin,qal,qvac,qis,qvlay,qstars,ksym,jsym,mcd,qintsl,qmtsl,qmtp,orbcomp)
CALL write_dos_Mem(id,nk,jspin,regCharges%qal(:,:,:,jspin),regCharges%qvac(:,:,nk,jspin),&
regCharges%qis(:,nk,jspin),regCharges%qvlay(:,:,:,nk,jspin),regCharges%qstars,&
ksym,jsym,mcd,slab%qintsl,slab%qmtsl,orbcomp%qmtp,orbcomp%comp)
CASE (MPI_mode)
CALL write_dos_MPI(id,nk,jspin,qal,qvac,qis,qvlay,qstars,ksym,jsym,mcd,qintsl,qmtsl,qmtp,orbcomp)
CALL write_dos_MPI(id,nk,jspin,regCharges%qal(:,:,:,jspin),regCharges%qvac(:,:,nk,jspin),&
regCharges%qis(:,nk,jspin),regCharges%qvlay(:,:,:,nk,jspin),regCharges%qstars,&
ksym,jsym,mcd,slab%qintsl,slab%qmtsl,orbcomp%qmtp,orbcomp%comp)
CASE (-1)
CALL juDFT_error("Could not write DOS to eig-file before opening", calledby = "eig66_io")
END SELECT
......
......@@ -110,6 +110,8 @@ SUBROUTINE cdngen(eig_id,mpi,input,banddos,sliceplot,vacuum,&
CALL juDFT_end("slice OK",mpi%irank)
END IF
CALL enpara%calcOutParams(input,atoms,vacuum,regCharges)
IF (mpi%irank.EQ.0) THEN
CALL openXMLElementNoAttributes('allElectronCharges')
CALL qfix(stars,atoms,sym,vacuum,sphhar,input,cell,oneD,outDen,noco%l_noco,.TRUE.,.true.,fix)
......
......@@ -10,7 +10,7 @@ MODULE m_mpi_col_den
!
CONTAINS
SUBROUTINE mpi_col_den(mpi,sphhar,atoms,oneD,stars,vacuum,&
input, noco,l_fmpl,jspin,llpd,rhtxy,rht,qpw,regCharges,&
input, noco,l_fmpl,jspin,llpd,regCharges,&
results,denCoeffs,orb,denCoeffsOffdiag,den,n_mmp)
#include"cpp_double.h"
......@@ -35,9 +35,6 @@ CONTAINS
LOGICAL, INTENT (IN) :: l_fmpl
! ..
! .. Array Arguments ..
COMPLEX, INTENT (INOUT) :: qpw(stars%ng3)
COMPLEX, INTENT (INOUT) :: rhtxy(vacuum%nmzxyd,oneD%odi%n2d-1,2)
REAL, INTENT (INOUT) :: rht(vacuum%nmzd,2)
COMPLEX,INTENT(INOUT) :: n_mmp(-lmaxU_const:lmaxU_const,-lmaxU_const:lmaxU_const,atoms%n_u)
TYPE (t_orb), INTENT(INOUT) :: orb
TYPE (t_denCoeffs), INTENT(INOUT) :: denCoeffs
......@@ -55,36 +52,33 @@ CONTAINS
! .. External Subroutines
EXTERNAL CPP_BLAS_scopy,CPP_BLAS_ccopy,MPI_REDUCE
!
! -> Collect qpw()
!
! -> Collect den%pw(:,jspin)
n = stars%ng3
ALLOCATE(c_b(n))
CALL MPI_REDUCE(qpw,c_b,n,CPP_MPI_COMPLEX,MPI_SUM,0, MPI_COMM_WORLD,ierr)
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, qpw, 1)
CALL CPP_BLAS_ccopy(n, c_b, 1, den%pw(:,jspin), 1)
ENDIF
DEALLOCATE (c_b)
!
! -> Collect rhtxy()
!
! -> Collect den%vacxy(:,:,:,jspin)
IF (input%film) THEN
n = vacuum%nmzxyd*(oneD%odi%n2d-1)*2
ALLOCATE(c_b(n))
CALL MPI_REDUCE(rhtxy,c_b,n,CPP_MPI_COMPLEX,MPI_SUM,0, MPI_COMM_WORLD,ierr)
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, rhtxy, 1)
CALL CPP_BLAS_ccopy(n, c_b, 1, den%vacxy(:,:,:,jspin), 1)
ENDIF
DEALLOCATE (c_b)
!
! -> Collect rht()
!
! -> Collect den%vacz(:,:,jspin)
n = vacuum%nmzd*2
ALLOCATE(r_b(n))
CALL MPI_REDUCE(rht,r_b,n,CPP_MPI_REAL,MPI_SUM,0, MPI_COMM_WORLD,ierr)
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, rht, 1)
CALL CPP_BLAS_scopy(n, r_b, 1, den%vacz(:,:,jspin), 1)
ENDIF
DEALLOCATE (r_b)
......
......@@ -31,6 +31,7 @@ MODULE m_types_enpara
PROCEDURE :: read
PROCEDURE :: write
PROCEDURE :: mix
PROCEDURE :: calcOutParams
END TYPE t_enpara
......@@ -527,5 +528,25 @@ CONTAINS
END SUBROUTINE mix
SUBROUTINE calcOutParams(enpara,input,atoms,vacuum,regCharges)
USE m_types_setup
USE m_types_cdnval
IMPLICIT NONE
CLASS(t_enpara),INTENT(INOUT) :: enpara
TYPE(t_input),INTENT(IN) :: input
TYPE(t_atoms),INTENT(IN) :: atoms
TYPE(t_vacuum),INTENT(IN) :: vacuum
TYPE(t_regionCharges),INTENT(IN) :: regCharges
INTEGER :: ispin, n
DO ispin = 1,input%jspins
DO n=1,atoms%ntype
enpara%el1(0:3,n,ispin)=regCharges%ener(0:3,n,ispin)/regCharges%sqal(0:3,n,ispin)
IF (atoms%nlo(n)>0) enpara%ello1(:atoms%nlo(n),n,ispin)=regCharges%enerlo(:atoms%nlo(n),n,ispin)/regCharges%sqlo(:atoms%nlo(n),n,ispin)
END DO
IF (input%film) enpara%evac1(:vacuum%nvac,ispin)=regCharges%pvac(:vacuum%nvac,ispin)/regCharges%svac(:vacuum%nvac,ispin)
END DO
END SUBROUTINE calcOutParams
END MODULE m_types_enpara
Markdown is supported
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