Commit fe411e52 authored by Gregor Michalicek's avatar Gregor Michalicek

Introduce t_gVacMap type to cdn/cdnval.F90

+more cleanup
parent 401d204f
......@@ -55,7 +55,6 @@ CONTAINS
USE m_abcof
USE m_nmat ! calculate density matrix for LDA + U
USE m_vacden
USE m_nstm3
USE m_pwden
USE m_forcea8
USE m_forcea12
......@@ -122,7 +121,6 @@ CONTAINS
LOGICAL :: l_fmpl,l_evp,l_orbcomprot,l_real, l_write
! ...Local Arrays ..
INTEGER, ALLOCATABLE :: gvac1d(:),gvac2d(:)
INTEGER, ALLOCATABLE :: jsym(:),ksym(:)
REAL, ALLOCATABLE :: we(:)
REAL, ALLOCATABLE :: eig(:)
......@@ -139,6 +137,7 @@ CONTAINS
TYPE (t_usdus) :: usdus
TYPE (t_zMat) :: zMat
TYPE (t_orbcomp) :: orbcomp
TYPE (t_gVacMap) :: gVacMap
l_real = sym%invs.AND.(.NOT.noco%l_soc).AND.(.NOT.noco%l_noco)
......@@ -163,7 +162,6 @@ CONTAINS
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) )
ALLOCATE ( gvac1d(dimension%nv2d),gvac2d(dimension%nv2d) )
! --> Initializations
......@@ -256,10 +254,7 @@ CONTAINS
eig(1:noccbd) = results%eig(nStart:nEnd,ikpt,jsp)
IF (vacuum%nstm.EQ.3.AND.input%film) THEN
CALL nstm3(sym,atoms,vacuum,stars,lapw,ikpt,input,jspin,kpts,&
cell,enpara%evac0(1,jspin),vTot%vacz(:,:,jspin),gvac1d,gvac2d)
END IF
CALL gVacMap%init(dimension,sym,atoms,vacuum,stars,lapw,input,cell,kpts,enpara,vTot,ikpt,jspin)
IF (noccbd.EQ.0) GO TO 199
......@@ -290,7 +285,7 @@ CONTAINS
IF (.NOT.((jspin.EQ.2) .AND. noco%l_noco)) THEN
CALL timestart("cdnval: vacden")
CALL vacden(vacuum,dimension,stars,oneD, kpts,input, cell,atoms,noco,banddos,&
gvac1d,gvac2d, 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)
CALL timestop("cdnval: vacden")
END IF
......
......@@ -5,14 +5,9 @@ MODULE m_vacden
! vacuum charge density. speed up by r. wu 1992
! *************************************************************
CONTAINS
SUBROUTINE vacden(&
vacuum,DIMENSION,stars,oneD,&
kpts,input,cell,atoms,noco,banddos,&
gvac1,gvac2,&
we,ikpt,jspin,vz,&
ne,lapw,&
evac,eig,den,qvac,qvlay,&
stcoeff,zMat)
SUBROUTINE vacden(vacuum,DIMENSION,stars,oneD,kpts,input,cell,atoms,noco,banddos,&
gVacMap,we,ikpt,jspin,vz,ne,lapw,evac,eig,den,qvac,qvlay,&
stcoeff,zMat)
!***********************************************************************
! ****** change vacden(....,q) for vacuum density of states shz Jan.96
......@@ -65,6 +60,7 @@ CONTAINS
TYPE(t_kpts),INTENT(IN) :: kpts
TYPE(t_atoms),INTENT(IN) :: atoms
TYPE(t_zMat),INTENT(IN) :: zMat
TYPE(t_gVacMap),INTENT(IN) :: gVacMap
TYPE(t_potden),INTENT(INOUT) :: den
! .. Scalar Arguments ..
INTEGER, INTENT (IN) :: jspin
......@@ -80,7 +76,6 @@ CONTAINS
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
REAL, INTENT (IN) :: eig(DIMENSION%neigd)
INTEGER, INTENT (IN) :: gvac1(DIMENSION%nv2d),gvac2(DIMENSION%nv2d)
COMPLEX, INTENT (OUT):: stcoeff(vacuum%nstars,DIMENSION%neigd,vacuum%layerd,2)
!
! local STM variables
......@@ -244,17 +239,14 @@ CONTAINS
DO j=1, n2max
mapg2k(j)=j
DO i=1, nv2(jspin)
IF ( kvac1(i,jspin).EQ.gvac1(j) .AND.&
& kvac2(i,jspin).EQ.gvac2(j) ) &
& mapg2k(j)=i
IF (kvac1(i,jspin).EQ.gVacMap%gvac1d(j).AND.kvac2(i,jspin).EQ.gVacMap%gvac2d(j)) mapg2k(j)=i
END DO
END DO
END IF
!
!-dw
IF (noco%l_noco) THEN
OPEN (25,FILE='potmat',FORM='unformatted',&
& STATUS='old')
OPEN (25,FILE='potmat',FORM='unformatted',STATUS='old')
!---> skip the four components of the interstitial potential matrix
DO ipot = 1,3
READ (25)
......
......@@ -54,7 +54,7 @@ set(inpgen_F90 ${inpgen_F90} global/constants.f90 io/xsf_io.f90
eigen/vec_for_lo.f90 eigen/orthoglo.F90 juDFT/usage_data.F90
global/enpara.f90 global/chkmt.f90 inpgen/inpgen.f90 inpgen/set_inp.f90 inpgen/inpgen_help.f90 io/rw_inp.f90 juDFT/juDFT.F90 global/find_enpara.f90
juDFT/info.F90 juDFT/stop.F90 juDFT/args.F90 juDFT/time.F90 juDFT/init.F90 juDFT/sysinfo.F90 io/w_inpXML.f90 init/julia.f90 global/utility.F90
init/compile_descr.F90 init/kpoints.f90 io/xmlOutput.F90 init/brzone2.f90 cdn/slab_dim.f90 cdn/slabgeom.f90)
init/compile_descr.F90 init/kpoints.f90 io/xmlOutput.F90 init/brzone2.f90 cdn/slab_dim.f90 cdn/slabgeom.f90 dos/nstm3.f90)
set(fleur_SRC ${fleur_F90} ${fleur_F77})
......
......@@ -13,7 +13,9 @@ CONTAINS
cell,evac,vz,gvac1d,gvac2d)
USE m_sort
USE m_types
USE m_types_setup
USE m_types_lapw
USE m_types_kpts
IMPLICIT NONE
TYPE(t_input),INTENT(IN) :: input
......
......@@ -17,6 +17,7 @@ types/types_setup.F90
types/types_usdus.F90
types/types_cdnval.f90
types/types_field.F90
types/types_regionCharges.f90
)
set(inpgen_F90 ${inpgen_F90}
......@@ -36,4 +37,5 @@ types/types_enpara.F90
types/types_setup.F90
types/types_usdus.F90
types/types_cdnval.f90
types/types_regionCharges.f90
)
......@@ -21,4 +21,5 @@ MODULE m_types
USE m_types_forcetheo
USE m_types_cdnval
USE m_types_field
USE m_types_regionCharges
END MODULE m_types
......@@ -154,27 +154,6 @@ PRIVATE
PROCEDURE,PASS :: init1 => mcd_init1
END TYPE t_mcd
TYPE t_regionCharges
REAL, ALLOCATABLE :: qis(:,:,:)
REAL, ALLOCATABLE :: qal(:,:,:,:)
REAL, ALLOCATABLE :: sqal(:,:,:)
REAL, ALLOCATABLE :: ener(:,:,:)
REAL, ALLOCATABLE :: sqlo(:,:,:)
REAL, ALLOCATABLE :: enerlo(:,:,:)
REAL, ALLOCATABLE :: qvac(:,:,:,:)
REAL, ALLOCATABLE :: svac(:,:)
REAL, ALLOCATABLE :: pvac(:,:)
REAL, ALLOCATABLE :: qvlay(:,:,:,:,:)
COMPLEX, ALLOCATABLE :: qstars(:,:,:,:)
CONTAINS
PROCEDURE,PASS :: init => regionCharges_init
END TYPE t_regionCharges
TYPE t_moments
REAL, ALLOCATABLE :: chmom(:,:)
......@@ -212,9 +191,17 @@ PRIVATE
PROCEDURE,PASS :: init => cdnvalKLoop_init
END TYPE t_cdnvalKLoop
TYPE t_gVacMap
INTEGER, ALLOCATABLE :: gvac1d(:)
INTEGER, ALLOCATABLE :: gvac2d(:)
CONTAINS
PROCEDURE,PASS :: init => gVacMap_init
END TYPE t_gVacMap
PUBLIC t_orb, t_denCoeffs, t_denCoeffsOffdiag, t_force, t_slab, t_eigVecCoeffs
PUBLIC t_mcd, t_regionCharges, t_moments, t_orbcomp, t_cdnvalKLoop
PUBLIC t_mcd, t_moments, t_orbcomp, t_cdnvalKLoop, t_gVacMap
CONTAINS
......@@ -638,52 +625,6 @@ SUBROUTINE mcd_init1(thisMCD,banddos,dimension,input,atoms)
END SUBROUTINE mcd_init1
SUBROUTINE regionCharges_init(thisRegCharges,input,atoms,dimension,kpts,vacuum)
USE m_types_setup
USE m_types_kpts
IMPLICIT NONE
CLASS(t_regionCharges), INTENT(INOUT) :: thisRegCharges
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(thisRegCharges%qis(dimension%neigd,kpts%nkpt,input%jspins))
ALLOCATE(thisRegCharges%qal(0:3,atoms%ntype,dimension%neigd,input%jspins))
ALLOCATE(thisRegCharges%sqal(0:3,atoms%ntype,input%jspins))
ALLOCATE(thisRegCharges%ener(0:3,atoms%ntype,input%jspins))
ALLOCATE(thisRegCharges%sqlo(atoms%nlod,atoms%ntype,input%jspins))
ALLOCATE(thisRegCharges%enerlo(atoms%nlod,atoms%ntype,input%jspins))
ALLOCATE(thisRegCharges%qvac(dimension%neigd,2,kpts%nkpt,input%jspins))
ALLOCATE(thisRegCharges%svac(2,input%jspins))
ALLOCATE(thisRegCharges%pvac(2,input%jspins))
ALLOCATE(thisRegCharges%qvlay(dimension%neigd,vacuum%layerd,2,kpts%nkpt,input%jspins))
ALLOCATE(thisRegCharges%qstars(vacuum%nstars,dimension%neigd,vacuum%layerd,2))
thisRegCharges%qis = 0.0
thisRegCharges%qal = 0.0
thisRegCharges%sqal = 0.0
thisRegCharges%ener = 0.0
thisRegCharges%sqlo = 0.0
thisRegCharges%enerlo = 0.0
thisRegCharges%qvac = 0.0
thisRegCharges%svac = 0.0
thisRegCharges%pvac = 0.0
thisRegCharges%qvlay = 0.0
thisRegCharges%qstars = CMPLX(0.0,0.0)
END SUBROUTINE regionCharges_init
SUBROUTINE moments_init(thisMoments,input,atoms)
USE m_types_setup
......@@ -870,4 +811,47 @@ SUBROUTINE cdnvalKLoop_init(thisCdnvalKLoop,mpi,input,kpts,banddos,noco,results,
END SUBROUTINE cdnvalKLoop_init
SUBROUTINE gVacMap_init(thisGVacMap,dimension,sym,atoms,vacuum,stars,lapw,input,cell,kpts,enpara,vTot,ikpt,jspin)
USE m_types_setup
USE m_types_lapw
USE m_types_enpara
USE m_types_potden
USE m_types_kpts
USE m_nstm3
IMPLICIT NONE
CLASS(t_gVacMap), INTENT(INOUT) :: thisGVacMap
TYPE(t_dimension), INTENT(IN) :: dimension
TYPE(t_sym), INTENT(IN) :: sym
TYPE(t_atoms), INTENT(IN) :: atoms
TYPE(t_vacuum), INTENT(IN) :: vacuum
TYPE(t_stars), INTENT(IN) :: stars
TYPE(t_lapw), INTENT(IN) :: lapw
TYPE(t_input), INTENT(IN) :: input
TYPE(t_cell), INTENT(IN) :: cell
TYPE(t_kpts), INTENT(IN) :: kpts
TYPE(t_enpara), INTENT(IN) :: enpara
TYPE(t_potden), INTENT(IN) :: vTot
INTEGER, INTENT(IN) :: ikpt
INTEGER, INTENT(IN) :: jspin
IF (ALLOCATED(thisGVacMap%gvac1d)) DEALLOCATE(thisGVacMap%gvac1d)
IF (ALLOCATED(thisGVacMap%gvac2d)) DEALLOCATE(thisGVacMap%gvac2d)
ALLOCATE(thisGVacMap%gvac1d(dimension%nv2d))
ALLOCATE(thisGVacMap%gvac2d(dimension%nv2d))
thisGVacMap%gvac1d = 0
thisGVacMap%gvac2d = 0
IF (vacuum%nstm.EQ.3.AND.input%film) THEN
CALL nstm3(sym,atoms,vacuum,stars,lapw,ikpt,input,jspin,kpts,&
cell,enpara%evac0(1,jspin),vTot%vacz(:,:,jspin),thisGVacMap%gvac1d,thisGVacMap%gvac2d)
END IF
END SUBROUTINE gVacMap_init
END MODULE m_types_cdnval
......@@ -530,7 +530,7 @@ CONTAINS
SUBROUTINE calcOutParams(enpara,input,atoms,vacuum,regCharges)
USE m_types_setup
USE m_types_cdnval
USE m_types_regionCharges
IMPLICIT NONE
CLASS(t_enpara),INTENT(INOUT) :: enpara
TYPE(t_input),INTENT(IN) :: input
......
!--------------------------------------------------------------------------------
! 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_regionCharges
IMPLICIT NONE
PRIVATE
TYPE t_regionCharges
REAL, ALLOCATABLE :: qis(:,:,:)
REAL, ALLOCATABLE :: qal(:,:,:,:)
REAL, ALLOCATABLE :: sqal(:,:,:)
REAL, ALLOCATABLE :: ener(:,:,:)
REAL, ALLOCATABLE :: sqlo(:,:,:)
REAL, ALLOCATABLE :: enerlo(:,:,:)
REAL, ALLOCATABLE :: qvac(:,:,:,:)
REAL, ALLOCATABLE :: svac(:,:)
REAL, ALLOCATABLE :: pvac(:,:)
REAL, ALLOCATABLE :: qvlay(:,:,:,:,:)
COMPLEX, ALLOCATABLE :: qstars(:,:,:,:)
CONTAINS
PROCEDURE,PASS :: init => regionCharges_init
END TYPE t_regionCharges
PUBLIC t_regionCharges
CONTAINS
SUBROUTINE regionCharges_init(thisRegCharges,input,atoms,dimension,kpts,vacuum)
USE m_types_setup
USE m_types_kpts
IMPLICIT NONE
CLASS(t_regionCharges), INTENT(INOUT) :: thisRegCharges
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(thisRegCharges%qis(dimension%neigd,kpts%nkpt,input%jspins))
ALLOCATE(thisRegCharges%qal(0:3,atoms%ntype,dimension%neigd,input%jspins))
ALLOCATE(thisRegCharges%sqal(0:3,atoms%ntype,input%jspins))
ALLOCATE(thisRegCharges%ener(0:3,atoms%ntype,input%jspins))
ALLOCATE(thisRegCharges%sqlo(atoms%nlod,atoms%ntype,input%jspins))
ALLOCATE(thisRegCharges%enerlo(atoms%nlod,atoms%ntype,input%jspins))
ALLOCATE(thisRegCharges%qvac(dimension%neigd,2,kpts%nkpt,input%jspins))
ALLOCATE(thisRegCharges%svac(2,input%jspins))
ALLOCATE(thisRegCharges%pvac(2,input%jspins))
ALLOCATE(thisRegCharges%qvlay(dimension%neigd,vacuum%layerd,2,kpts%nkpt,input%jspins))
ALLOCATE(thisRegCharges%qstars(vacuum%nstars,dimension%neigd,vacuum%layerd,2))
thisRegCharges%qis = 0.0
thisRegCharges%qal = 0.0
thisRegCharges%sqal = 0.0
thisRegCharges%ener = 0.0
thisRegCharges%sqlo = 0.0
thisRegCharges%enerlo = 0.0
thisRegCharges%qvac = 0.0
thisRegCharges%svac = 0.0
thisRegCharges%pvac = 0.0
thisRegCharges%qvlay = 0.0
thisRegCharges%qstars = CMPLX(0.0,0.0)
END SUBROUTINE regionCharges_init
END MODULE m_types_regionCharges
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