Commit 329bfac7 authored by Gregor Michalicek's avatar Gregor Michalicek

Introduce t_slab type to cdn/cdnval.F90

parent 0ca1d03d
......@@ -73,8 +73,6 @@ CONTAINS
USE m_orbmom ! coeffd for orbital moments
USE m_qmtsl ! These subroutines divide the input%film into vacuum%layers
USE m_qintsl ! (slabs) and intergate the DOS in these vacuum%layers
USE m_slabdim ! (mt + interstitial)
USE m_slabgeom ! (written by Yu.Koroteev, 2003/2004)
USE m_orbcomp ! calculate corbital composition (like p_x,p_y,p_z)
USE m_Ekwritesl ! and write to file.
USE m_abcrot2
......@@ -127,49 +125,47 @@ CONTAINS
TYPE(t_lapw):: lapw
INTEGER :: llpd
REAL wronk,emcd_lo,emcd_up
INTEGER i,ie,iv,ivac,j,k,l,l1,lh ,n,ilo,isp,nat,&
INTEGER i,ie,iv,ivac,j,k,l,n,ilo,isp,&
nbands,noded,nodeu,noccbd,nslibd,na,&
ikpt,jsp_start,jsp_end,ispin
INTEGER skip_t,skip_tt
INTEGER n_size,i_rec,n_rank ,ncored,n_start,n_end,noccbd_l
COMPLEX,parameter:: czero=(0.0,0.0)
LOGICAL l_fmpl,l_mcd,l_evp,l_orbcomprot
! ...Local Arrays ..
INTEGER n_bands(0:dimension%neigd),ncore(atoms%ntype)
REAL cartk(3),e_mcd(atoms%ntype,input%jspins,dimension%nstd)
REAL e_mcd(atoms%ntype,input%jspins,dimension%nstd)
REAL eig(dimension%neigd)
REAL vz0(2)
REAL uuilon(atoms%nlod,atoms%ntype),duilon(atoms%nlod,atoms%ntype)
REAL ulouilopn(atoms%nlod,atoms%nlod,atoms%ntype)
INTEGER, PARAMETER :: n2max_nstm3=13
INTEGER nsld,nsl
!
INTEGER, ALLOCATABLE :: nmtsl(:,:),nslat(:,:)
REAL, ALLOCATABLE :: zsl(:,:),volsl(:)
REAL, ALLOCATABLE :: volintsl(:)
REAL, ALLOCATABLE :: qintsl(:,:),qmtsl(:,:)
!orbcomp
REAL, ALLOCATABLE :: orbcomp(:,:,:),qmtp(:,:)
REAL, ALLOCATABLE :: qis(:,:,:)
!-new_sl
!-dw
INTEGER, ALLOCATABLE :: gvac1d(:),gvac2d(:)
INTEGER, ALLOCATABLE :: jsym(:),ksym(:)
REAL, ALLOCATABLE :: we(:)
! radial functions
REAL, ALLOCATABLE :: f(:,:,:,:),g(:,:,:,:),flo(:,:,:,:)
REAL, ALLOCATABLE :: sqlo(:,:,:)
REAL, ALLOCATABLE :: qal(:,:,:,:),sqal(:,:,:),ener(:,:,:)
REAL, ALLOCATABLE :: svac(:,:),pvac(:,:),mcd(:,:,:)
REAL, ALLOCATABLE :: enerlo(:,:,:),qmat(:,:,:,:)
COMPLEX, ALLOCATABLE :: acof(:,:,:,:),bcof(:,:,:,:),ccof(:,:,:,:,:)
COMPLEX, ALLOCATABLE :: qstars(:,:,:,:),m_mcd(:,:,:,:)
TYPE (t_orb) :: orb
TYPE (t_denCoeffs) :: denCoeffs
TYPE (t_denCoeffsOffdiag) :: denCoeffsOffdiag
TYPE (t_force) :: force
TYPE (t_slab) :: slab
TYPE (t_usdus) :: usdus
TYPE (t_zMat) :: zMat
......@@ -322,30 +318,20 @@ CONTAINS
8002 FORMAT (i3,f10.5,2 (5x,1p,2e16.7,i5),1p,2e16.7)
IF (input%film) vz0(:) = vTot%vacz(vacuum%nmz,:,jspin)
nsld=1
!+q_sl
CALL slab%init(banddos,dimension,atoms,cell)
IF ((banddos%ndir.EQ.-3).AND.banddos%dos) THEN
IF (oneD%odi%d1) CALL juDFT_error("layer-resolved feature does not work with 1D",calledby ="cdnval")
CALL slab_dim(atoms, nsld)
ALLOCATE ( nmtsl(atoms%ntype,nsld),nslat(atoms%nat,nsld) )
ALLOCATE ( zsl(2,nsld),volsl(nsld) )
ALLOCATE ( volintsl(nsld) )
CALL slabgeom(atoms,cell,nsld,&
nsl,zsl,nmtsl,nslat,volsl,volintsl)
ALLOCATE ( qintsl(nsld,dimension%neigd))
ALLOCATE ( qmtsl(nsld,dimension%neigd))
ALLOCATE ( orbcomp(dimension%neigd,23,atoms%nat) )
ALLOCATE ( qmtp(dimension%neigd,atoms%nat) )
IF (.NOT.input%film) qvac(:,:,:,jspin) = 0.0
ELSE
ALLOCATE(nmtsl(1,1),nslat(1,1),zsl(1,1),volsl(1),volintsl(1))
ALLOCATE(qintsl(1,1),qmtsl(1,1),orbcomp(1,1,1),qmtp(1,1))
ALLOCATE(orbcomp(1,1,1),qmtp(1,1))
END IF
!-q_sl
!
!--> loop over k-points: each can be a separate task
!
IF (kpts%nkpt < mpi%isize) THEN
l_evp = .true.
IF (l_mcd) THEN
......@@ -552,8 +538,7 @@ CONTAINS
!
IF (banddos%dos.AND.(banddos%ndir.EQ.-3)) THEN
IF (.NOT.((jspin.EQ.2) .AND. noco%l_noco)) THEN
CALL q_int_sl(jspin,stars,atoms,sym, volsl,volintsl,&
cell,noccbd,lapw, nsl,zsl,nmtsl,oneD, qintsl(:,:),zMat)
CALL q_int_sl(jspin,stars,atoms,sym,cell,noccbd,lapw,slab,oneD,zMat)
END IF
END IF
!-new c
......@@ -632,9 +617,8 @@ CONTAINS
!---> from the mt-sphere region of the film
!
IF (banddos%dos.AND.(banddos%ndir.EQ.-3)) THEN
CALL q_mt_sl(ispin,atoms,noccbd,nsld,ikpt,noccbd,ccof(-atoms%llod,1,1,1,ispin),&
skip_t,noccbd,acof(:,0:,:,ispin),bcof(:,0:,:,ispin),usdus,&
nmtsl,nsl,qmtsl(:,:))
CALL q_mt_sl(ispin,atoms,noccbd,ikpt,noccbd,ccof(-atoms%llod,1,1,1,ispin),&
skip_t,noccbd,acof(:,0:,:,ispin),bcof(:,0:,:,ispin),usdus,slab)
INQUIRE (file='orbcomprot',exist=l_orbcomprot)
IF (l_orbcomprot) THEN ! rotate ab-coeffs
......@@ -705,27 +689,23 @@ CONTAINS
199 CONTINUE
IF ((banddos%dos .OR. banddos%vacdos .OR. input%cdinf) ) THEN
CALL timestart("cdnval: write_info")
!
!---> calculate charge distribution of each state (l-character ...)
!---> and write the information to the files dosinp and vacdos
!---> 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!
!
cartk=matmul(lapw%bkpt,cell%bmat)
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
!
!--dw now write k-point data to tmp_dos
!
CALL write_dos(eig_id,ikpt,jspin,qal(:,:,:,jspin),qvac(:,:,ikpt,jspin),qis(:,ikpt,jspin),&
qvlay(:,:,:,ikpt,jspin),qstars,ksym,jsym,mcd,qintsl,&
qmtsl(:,:),qmtp(:,:),orbcomp)
qvlay(:,:,:,ikpt,jspin),qstars,ksym,jsym,mcd,slab%qintsl,&
slab%qmtsl(:,:),qmtp(:,:),orbcomp)
CALL timestop("cdnval: write_info")
!-new_sl
......@@ -767,10 +747,9 @@ CONTAINS
IF (mpi%irank==0) THEN
CALL doswrite(eig_id,dimension,kpts,atoms,vacuum,input,banddos,&
sliceplot,noco,sym,cell,l_mcd,ncored,ncore,e_mcd,&
results%ef,results%bandgap,nsld,oneD)
results%ef,results%bandgap,slab%nsld,oneD)
IF (banddos%dos.AND.(banddos%ndir.EQ.-3)) THEN
CALL Ek_write_sl(eig_id,dimension,kpts,atoms,vacuum,&
nsld,input,jspin,sym,cell,nsl,nslat)
CALL Ek_write_sl(eig_id,dimension,kpts,atoms,vacuum,input,jspin,sym,cell,slab)
END IF
END IF
#ifdef CPP_MPI
......
MODULE m_qintsl
USE m_juDFT
CONTAINS
SUBROUTINE q_int_sl(isp,stars,atoms,sym, volsl,volintsl, cell,&
ne,lapw, nsl,zsl,nmtsl,oneD, qintslk,zMat)
SUBROUTINE q_int_sl(isp,stars,atoms,sym,cell,ne,lapw,slab,oneD,zMat)
! *******************************************************
! calculate the charge of the En(k) state
! in the interstitial region of each leyer
......@@ -21,15 +20,10 @@ CONTAINS
TYPE(t_cell),INTENT(IN) :: cell
TYPE(t_atoms),INTENT(IN) :: atoms
TYPE(t_zMat),INTENT(IN) :: zMat
TYPE(t_slab),INTENT(INOUT):: slab
!
! .. Scalar Arguments ..
INTEGER, INTENT (IN) :: ne,isp ,nsl
! ..
! .. Array Arguments ..
INTEGER, INTENT (IN) :: nmtsl(atoms%ntype,nsl)
REAL, INTENT (IN) :: volintsl(atoms%nat)
REAL, INTENT (IN) :: zsl(2,atoms%nat) ,volsl(atoms%nat)
REAL, INTENT (OUT):: qintslk(:,:)!(nsl,dimension%neigd)
INTEGER, INTENT (IN) :: ne,isp
! ..
! .. Local Scalars ..
REAL q1,zsl1,zsl2,qi,volsli,volintsli
......@@ -47,19 +41,19 @@ CONTAINS
!
! ----> g=0 star
!
ALLOCATE ( stfunint(stars%ng3,nsl), z_z(stars%ng3) )
ALLOCATE ( stfunint(stars%ng3,slab%nsl), z_z(stars%ng3) )
!
! -----> calculate the integrals of star functions over
! the layer interstitial
!
DO i = 1,nsl
zsl1 = zsl(1,i)
zsl2 = zsl(2,i)
volsli = volsl(i)
volintsli = volintsl(i)
DO i = 1,slab%nsl
zsl1 = slab%zsl(1,i)
zsl2 = slab%zsl(2,i)
volsli = slab%volsl(i)
volintsli = slab%volintsl(i)
DO j = 1,stars%ng3
CALL pwint_sl(stars,atoms,sym,zsl1,zsl2,&
volsli,volintsli,cell,nmtsl(1,i),stars%kv3(1,j),x)
volsli,volintsli,cell,slab%nmtsl(1,i),stars%kv3(1,j),x)
stfunint(j,i) = x*stars%nstr(j)
ENDDO ! over 3D stars
ENDDO ! over vacuum%layers
......@@ -106,12 +100,12 @@ CONTAINS
ENDDO
! ----> calculate a charge in the layer interstitial region of the film
!
DO i = 1,nsl
DO i = 1,slab%nsl
qi = 0.0
DO j = 1,stars%ng3
qi = qi + z_z(j)*stfunint(j,i)
ENDDO
qintslk(i,n) = qi
slab%qintsl(i,n) = qi
ENDDO ! over vacuum%layers
ENDDO ! over states
......
......@@ -8,24 +8,21 @@ CONTAINS
!
!***********************************************************************
!
SUBROUTINE q_mt_sl(jsp,atoms,nobd,nsld, ikpt,ne,ccof, skip_t,noccbd,acof,bcof,usdus, &
nmtsl,nsl, qmtslk)
SUBROUTINE q_mt_sl(jsp,atoms,nobd,ikpt,ne,ccof, skip_t,noccbd,acof,bcof,usdus,slab)
USE m_types
IMPLICIT NONE
TYPE(t_usdus),INTENT(IN) :: usdus
TYPE(t_atoms),INTENT(IN) :: atoms
TYPE(t_usdus),INTENT(IN) :: usdus
TYPE(t_atoms),INTENT(IN) :: atoms
TYPE(t_slab), INTENT(INOUT) :: slab
! ..
! .. Scalar Arguments ..
INTEGER, INTENT (IN) :: nobd,jsp
INTEGER, INTENT (IN) :: ne,ikpt ,skip_t,noccbd
INTEGER, INTENT (IN) :: nsl,nsld
! ..
! .. Array Arguments ..
COMPLEX, INTENT (IN) :: ccof(-atoms%llod:atoms%llod,nobd,atoms%nlod,atoms%nat)
COMPLEX, INTENT (IN) :: acof(:,0:,:)!(nobd,0:dimension%lmd,atoms%nat)
COMPLEX, INTENT (IN) :: bcof(:,0:,:)!(nobd,0:dimension%lmd,atoms%nat)
INTEGER, INTENT (IN) :: nmtsl(atoms%ntype,atoms%nat)
REAL, INTENT (OUT) :: qmtslk(:,:)!(nsl,dimension%neigd)
! ..
! .. Local Scalars ..
INTEGER i,l,lo ,natom,nn,ntyp,nt1,nt2,m
......@@ -41,9 +38,9 @@ CONTAINS
INTRINSIC conjg,cmplx
ALLOCATE ( qlo(nobd,atoms%nlod,atoms%ntype),qmt(atoms%ntype,SIZE(qmtslk,2)) )
ALLOCATE ( qlo(nobd,atoms%nlod,atoms%ntype),qmt(atoms%ntype,SIZE(slab%qmtsl,2)) )
ALLOCATE ( qaclo(nobd,atoms%nlod,atoms%ntype),qbclo(nobd,atoms%nlod,atoms%ntype) )
ALLOCATE ( qmttot(atoms%ntype,SIZE(qmtslk,2)),qmtlo(atoms%ntype,SIZE(qmtslk,2)) )
ALLOCATE ( qmttot(atoms%ntype,SIZE(slab%qmtsl,2)),qmtlo(atoms%ntype,SIZE(slab%qmtsl,2)) )
!
!---> l-decomposed density for each valence state
!
......@@ -136,12 +133,12 @@ CONTAINS
ENDDO
!
DO i = 1,ne
DO nl = 1,nsl
DO nl = 1,slab%nsl
qq = 0.0
DO ntyp = 1,atoms%ntype
qq = qq + qmttot(ntyp,i)*nmtsl(ntyp,nl)
qq = qq + qmttot(ntyp,i)*slab%nmtsl(ntyp,nl)
ENDDO
qmtslk(nl,i) = qq
slab%qmtsl(nl,i) = qq
ENDDO
ENDDO
! DO ntyp = 1,ntype
......
MODULE m_slabdim
USE m_juDFT
CONTAINS
SUBROUTINE slab_dim( atoms,nsld)
SUBROUTINE slab_dim(atoms,nsld)
!***********************************************************************
! This subroutine calculates the number of layers in the slab
!
......@@ -20,7 +20,7 @@ CONTAINS
! the nsl-layer
!-----------------------------------------------------------------------
!
USE m_types
USE m_types_setup
IMPLICIT NONE
TYPE(t_atoms),INTENT(IN) :: atoms
......
......@@ -32,7 +32,7 @@ CONTAINS
! the nsl-layer
!-----------------------------------------------------------------------
!
USE m_types
USE m_types_setup
IMPLICIT NONE
TYPE(t_cell),INTENT(IN) :: cell
TYPE(t_atoms),INTENT(IN) :: atoms
......
......@@ -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)
init/compile_descr.F90 init/kpoints.f90 io/xmlOutput.F90 init/brzone2.f90 cdn/slab_dim.f90 cdn/slabgeom.f90)
set(fleur_SRC ${fleur_F90} ${fleur_F77})
......
MODULE m_Ekwritesl
use m_juDFT
CONTAINS
SUBROUTINE Ek_write_sl(eig_id,dimension,kpts,atoms,vacuum,nsld,&
input,jspin, sym,cell, nsl,nslat)
SUBROUTINE Ek_write_sl(eig_id,dimension,kpts,atoms,vacuum,input,jspin,sym,cell,slab)
!-----------------------------------------------------------------
!-- now write E(k) for all kpts if on T3E
!-- now read data from tmp_dos and write of E(k) in ek_orbcomp
......@@ -17,13 +16,11 @@ CONTAINS
TYPE(t_cell),INTENT(IN) :: cell
TYPE(t_kpts),INTENT(IN) :: kpts
TYPE(t_atoms),INTENT(IN) :: atoms
TYPE(t_slab),INTENT(IN) :: slab
! ..
! .. Scalar Arguments ..
INTEGER, INTENT (IN) :: nsld,eig_id
INTEGER, INTENT (IN) :: nsl ,jspin
! ..
! .. Array Arguments ..
INTEGER, INTENT (IN) :: nslat(atoms%nat,nsld)
INTEGER, INTENT (IN) :: eig_id
INTEGER, INTENT (IN) :: jspin
! ..
! .. Local Scalars
INTEGER :: nbands,ikpt,kspin,j,i,n,it ,na,iband,mt,l
......@@ -31,7 +28,7 @@ CONTAINS
REAL :: wk
! ..
! .. Local Arrays
INTEGER norb(23),iqsl(nsld),iqvacpc(2)
INTEGER norb(23),iqsl(slab%nsld),iqvacpc(2)
REAL qvact(2)
REAL, ALLOCATABLE :: eig(:),qvac(:,:,:,:),orbcomp(:,:,:,:,:)
REAL, ALLOCATABLE :: qal(:,:,:),qis(:),qvlay(:,:,:)
......@@ -41,12 +38,12 @@ CONTAINS
CHARACTER (len=2) :: chntype
CHARACTER (len=99) :: chform
! ..
IF (nsl.GT.nsld) THEN
IF (slab%nsl.GT.slab%nsld) THEN
CALL juDFT_error("nsl.GT.nsld",calledby="Ek_write_sl")
ENDIF
ALLOCATE(eig(dimension%neigd),orbcomp(dimension%neigd,23,atoms%nat,kpts%nkpt,dimension%jspd))
ALLOCATE(qvac(dimension%neigd,2,kpts%nkpt,dimension%jspd),qintsl(nsld,dimension%neigd,kpts%nkpt,dimension%jspd))
ALLOCATE(qmtsl(nsld,dimension%neigd,kpts%nkpt,dimension%jspd),qmtp(dimension%neigd,atoms%nat,kpts%nkpt,dimension%jspd))
ALLOCATE(qvac(dimension%neigd,2,kpts%nkpt,dimension%jspd),qintsl(slab%nsld,dimension%neigd,kpts%nkpt,dimension%jspd))
ALLOCATE(qmtsl(slab%nsld,dimension%neigd,kpts%nkpt,dimension%jspd),qmtp(dimension%neigd,atoms%nat,kpts%nkpt,dimension%jspd))
ALLOCATE(qal(4,atoms%ntype,dimension%neigd),qis(dimension%neigd),qvlay(dimension%neigd,vacuum%layerd,2))
ALLOCATE(qstars(vacuum%nstars,dimension%neigd,vacuum%layerd,2))
ALLOCATE(ksym(dimension%neigd),jsym(dimension%neigd))
......@@ -59,17 +56,17 @@ CONTAINS
!
! -----> write bandstructure to ek_orbcomp - file
!
WRITE (chntype,'(i2)') nsl
WRITE (chntype,'(i2)') slab%nsl
chform = "('E',i3,'= ',f10.4,4x,'vac ( vacuum%layers ) vac = ',i3,' ('&
& ,"//chntype//"(i3,2x),')',i3))"
WRITE (130,FMT=901)
WRITE (130,FMT=902)
WRITE (130,FMT=901)
WRITE (130,FMT=903) nsl,vacuum%nvac,kpts%nkpt
WRITE (130,FMT=903) slab%nsl,vacuum%nvac,kpts%nkpt
WRITE (130,FMT=904) atoms%ntype,(atoms%neq(n),n=1,atoms%ntype)
WRITE (130,FMT=805)
DO j=1,nsl
WRITE (130,FMT=806) j,(nslat(i,j),i=1,atoms%nat)
DO j=1,slab%nsl
WRITE (130,FMT=806) j,(slab%nslat(i,j),i=1,atoms%nat)
ENDDO
DO kspin = 1,input%jspins
WRITE (130,FMT=907) kspin,input%jspins
......@@ -99,21 +96,21 @@ CONTAINS
ENDDO
IF (sym%invs .OR. sym%zrfs) qvact(2) = qvact(1)
iqvacpc(:) = nint(qvact(:)*100.0)
DO j = 1,nsl
DO j = 1,slab%nsl
iqsl(j) = nint( ( qintsl(j,iband,ikpt,kspin) + &
& qmtsl(j,iband,ikpt,kspin) )*100.0 )
ENDDO
WRITE (130,FMT=chform) iband,eig(iband),iqvacpc(2),&
& (iqsl(l),l=1,nsl),iqvacpc(1)
& (iqsl(l),l=1,slab%nsl),iqvacpc(1)
WRITE(130,FMT=9)
WRITE(130,FMT=8)
WRITE(130,FMT=9)
DO n = 1,nsl
DO n = 1,slab%nsl
mt=0
DO it=1,atoms%ntype
DO m=1,atoms%neq(it)
mt=mt+1
na = nslat(mt,n)
na = slab%nslat(mt,n)
IF (na.EQ.1) THEN
DO j=1,23
norb(j) = &
......
......@@ -118,7 +118,22 @@ PRIVATE
PROCEDURE,PASS :: init2 => force_init2
END TYPE t_force
PUBLIC t_orb, t_denCoeffs, t_denCoeffsOffdiag, t_force
TYPE t_slab
INTEGER :: nsld, nsl
INTEGER, ALLOCATABLE :: nmtsl(:,:)
INTEGER, ALLOCATABLE :: nslat(:,:)
REAL, ALLOCATABLE :: zsl(:,:)
REAL, ALLOCATABLE :: volsl(:)
REAL, ALLOCATABLE :: volintsl(:)
REAL, ALLOCATABLE :: qintsl(:,:)
REAL, ALLOCATABLE :: qmtsl(:,:)
CONTAINS
PROCEDURE,PASS :: init => slab_init
END TYPE t_slab
PUBLIC t_orb, t_denCoeffs, t_denCoeffsOffdiag, t_force, t_slab
CONTAINS
......@@ -434,4 +449,46 @@ SUBROUTINE force_init2(thisForce,noccbd,input,atoms)
END SUBROUTINE force_init2
SUBROUTINE slab_init(thisSlab,banddos,dimension,atoms,cell)
USE m_types_setup
USE m_slabdim
USE m_slabgeom
IMPLICIT NONE
CLASS(t_slab), INTENT(INOUT) :: thisSlab
TYPE(t_banddos), INTENT(IN) :: banddos
TYPE(t_dimension), INTENT(IN) :: dimension
TYPE(t_atoms), INTENT(IN) :: atoms
TYPE(t_cell), INTENT(IN) :: cell
INTEGER :: nsld
nsld=1
IF ((banddos%ndir.EQ.-3).AND.banddos%dos) THEN
CALL slab_dim(atoms, nsld)
ALLOCATE (thisSlab%nmtsl(atoms%ntype,nsld))
ALLOCATE (thisSlab%nslat(atoms%nat,nsld))
ALLOCATE (thisSlab%zsl(2,nsld))
ALLOCATE (thisSlab%volsl(nsld))
ALLOCATE (thisSlab%volintsl(nsld))
ALLOCATE (thisSlab%qintsl(nsld,dimension%neigd))
ALLOCATE (thisSlab%qmtsl(nsld,dimension%neigd))
CALL slabgeom(atoms,cell,nsld,thisSlab%nsl,thisSlab%zsl,thisSlab%nmtsl,&
thisSlab%nslat,thisSlab%volsl,thisSlab%volintsl)
ELSE
ALLOCATE (thisSlab%nmtsl(1,1))
ALLOCATE (thisSlab%nslat(1,1))
ALLOCATE (thisSlab%zsl(1,1))
ALLOCATE (thisSlab%volsl(1))
ALLOCATE (thisSlab%volintsl(1))
ALLOCATE (thisSlab%qintsl(1,1))
ALLOCATE (thisSlab%qmtsl(1,1))
END IF
thisSlab%nsld = nsld
END SUBROUTINE slab_init
END MODULE m_types_cdnval
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