Commit 4588e4a6 authored by Daniel Wortmann's avatar Daniel Wortmann

Refactoring continued

parent 6276e9a5
......@@ -2,19 +2,20 @@
CONTAINS
SUBROUTINE checkolap(atoms,lmaxc,lmaxcd,nindxc,maxindxc,&
& core1,core2,hybrid,&
& bas1,bas2,nkpti,kpts,&
SUBROUTINE checkolap(atoms,hybdat,&
& hybrid,&
& nkpti,kpts,&
& dimension,mpi,irank2,skip_kpt,&
& input,sym,noco,&
& cell,lapw,jsp,&
& maxbands,nbands)
& cell,lapw,jsp)
USE m_util , ONLY: intgrf,intgrf_init,chr,sphbessel,harmonicsr
USE m_constants
USE m_apws
USE m_types
IMPLICIT NONE
TYPE(t_hybdat),INTENT(IN) :: hybdat
TYPE(t_mpi),INTENT(IN) :: mpi
TYPE(t_dimension),INTENT(IN) :: dimension
TYPE(t_hybrid),INTENT(IN) :: hybrid
......@@ -28,21 +29,13 @@
! - scalars -
INTEGER, INTENT(IN) :: jsp
INTEGER, INTENT(IN) :: lmaxcd
INTEGER, INTENT(IN) :: maxindxc ,maxbands
INTEGER, INTENT(IN) :: nkpti
! - arrays -
INTEGER, INTENT(IN) :: lmaxc(atoms%ntype)
INTEGER, INTENT(IN) :: nindxc(0:lmaxcd,atoms%ntype)
INTEGER, INTENT(IN) :: nbands(nkpti)
INTEGER, INTENT(IN) :: irank2(nkpti)
REAL , INTENT(IN) :: bas1 (atoms%jmtd,hybrid%maxindx ,0:atoms%lmaxd ,atoms%ntype),&
& bas2 (atoms%jmtd,hybrid%maxindx ,0:atoms%lmaxd ,atoms%ntype)
REAL , INTENT(IN) :: core1(atoms%jmtd,maxindxc,0:lmaxcd,atoms%ntype),&
& core2(atoms%jmtd,maxindxc,0:lmaxcd,atoms%ntype)
LOGICAL, INTENT(IN) :: skip_kpt(nkpti)
! - local scalars -
......@@ -68,9 +61,8 @@
REAL :: q(3)
REAL :: integrand(atoms%jmtd)
REAL :: bkpt(3)
REAL :: rarr(maxbands)
REAL :: rarr(maxval(hybdat%nbands))
REAL :: rtaual(3)
REAL , ALLOCATABLE :: gridf(:,:)
REAL , ALLOCATABLE :: olapcb(:)
REAL , ALLOCATABLE :: olapcv_avg(:,:,:,:),olapcv_max(:,:,:,:)
#ifdef CPP_INVERSION
......@@ -98,7 +90,7 @@
cmt = 0
! initialize gridf
CALL intgrf_init(atoms%ntype,atoms%jmtd,atoms%jri,atoms%dx,atoms%rmsh,gridf)
CALL intgrf_init(atoms%ntype,atoms%jmtd,atoms%jri,atoms%dx,atoms%rmsh,hybdat%gridf)
! read in cmt
irecl_cmt = dimension%neigd*hybrid%maxlmindx*atoms%nat*16
......@@ -116,15 +108,15 @@
DO itype=1,atoms%ntype
IF(atoms%ntype.gt.1 .AND. mpi%irank==0) &
& WRITE(6,'(A,I3)') ' Atom type',itype
DO l=0,lmaxc(itype)
DO i=1,nindxc(l,itype)
DO l=0,hybdat%lmaxc(itype)
DO i=1,hybdat%nindxc(l,itype)
IF ( mpi%irank == 0 )&
& WRITE(6,'(1x,I1,A,2X)',advance='no') i+l,lchar(l)
DO j=1,i
integrand = core1(:,i,l,itype)*core1(:,j,l,itype)&
& + core2(:,i,l,itype)*core2(:,j,l,itype)
integrand = hybdat%core1(:,i,l,itype)*hybdat%core1(:,j,l,itype)&
& + hybdat%core2(:,i,l,itype)*hybdat%core2(:,j,l,itype)
IF ( mpi%irank == 0 ) WRITE(6,'(F10.6)', advance='no')&
& intgrf(integrand,atoms%jri,atoms%jmtd,atoms%rmsh,atoms%dx,atoms%ntype,itype,gridf)
& intgrf(integrand,atoms%jri,atoms%jmtd,atoms%rmsh,atoms%dx,atoms%ntype,itype,hybdat%gridf)
END DO
IF ( mpi%irank == 0 ) WRITE(6,*)
END DO
......@@ -132,29 +124,29 @@
END DO
IF ( mpi%irank == 0 ) WRITE(6,'(/A)') ' Overlap <core|basis>'
ALLOCATE( olapcb(hybrid%maxindx),olapcv(maxbands,nkpti),&
& olapcv_avg( -lmaxcd:lmaxcd,maxindxc,0:lmaxcd,atoms%ntype),&
& olapcv_max( -lmaxcd:lmaxcd,maxindxc,0:lmaxcd,atoms%ntype),&
& olapcv_loc(2,-lmaxcd:lmaxcd,maxindxc,0:lmaxcd,atoms%ntype) )
ALLOCATE( olapcb(hybrid%maxindx),olapcv(maxval(hybdat%nbands),nkpti),&
& olapcv_avg( -hybdat%lmaxcd:hybdat%lmaxcd,hybdat%maxindxc,0:hybdat%lmaxcd,atoms%ntype),&
& olapcv_max( -hybdat%lmaxcd:hybdat%lmaxcd,hybdat%maxindxc,0:hybdat%lmaxcd,atoms%ntype),&
& olapcv_loc(2,-hybdat%lmaxcd:hybdat%lmaxcd,hybdat%maxindxc,0:hybdat%lmaxcd,atoms%ntype) )
DO itype=1,atoms%ntype
IF(atoms%ntype.gt.1 .AND. mpi%irank==0) &
& WRITE(6,'(A,I3)') ' Atom type',itype
DO l=0,lmaxc(itype)
DO l=0,hybdat%lmaxc(itype)
IF(l.gt.atoms%lmax(itype)) EXIT ! very improbable case
IF ( mpi%irank == 0 ) &
& WRITE(6,"(9X,'u(',A,')',4X,'udot(',A,')',:,3X,'ulo(',A,"//&
& "') ...')") (lchar(l),i=1,min(3,hybrid%nindx(l,itype)))
DO i=1,nindxc(l,itype)
DO i=1,hybdat%nindxc(l,itype)
IF ( mpi%irank == 0 )&
& WRITE(6,'(1x,I1,A,2X)',advance='no') i+l,lchar(l)
DO j=1,hybrid%nindx(l,itype)
integrand = core1(:,i,l,itype)*bas1(:,j,l,itype)&
& + core2(:,i,l,itype)*bas2(:,j,l,itype)
integrand = hybdat%core1(:,i,l,itype)*hybdat%bas1(:,j,l,itype)&
& + hybdat%core2(:,i,l,itype)*hybdat%bas2(:,j,l,itype)
olapcb(j) = &
& intgrf(integrand,atoms%jri,atoms%jmtd,atoms%rmsh,atoms%dx,atoms%ntype,itype,gridf)
& intgrf(integrand,atoms%jri,atoms%jmtd,atoms%rmsh,atoms%dx,atoms%ntype,itype,hybdat%gridf)
IF ( mpi%irank == 0 )&
& WRITE(6,'(F10.6)',advance='no') olapcb(j)
......@@ -167,13 +159,13 @@
DO j=1,hybrid%nindx(l,itype)
lm = lm + 1
olapcv(:,:) = olapcv(:,:) + &
& olapcb(j)*cmt(:maxbands,lm,iatom,:nkpti)
& olapcb(j)*cmt(:maxval(hybdat%nbands),lm,iatom,:nkpti)
END DO
rdum = sum ( abs(olapcv(:,:))**2 )
rdum1 = maxval ( abs(olapcv(:,:)) )
iarr = maxloc ( abs(olapcv(:,:)) )
olapcv_avg( m,i,l,itype) = &
& sqrt( rdum / nkpti / sum(nbands(:nkpti)) * nkpti )
& sqrt( rdum / nkpti / sum(hybdat%nbands(:nkpti)) * nkpti )
olapcv_max( m,i,l,itype) = rdum1
olapcv_loc(:,m,i,l,itype) = iarr
END DO
......@@ -187,8 +179,8 @@
WRITE(6,'(/A)') ' Average overlap <core|val>'
DO itype=1,atoms%ntype
IF(atoms%ntype.gt.1) write(6,'(A,I3)') ' Atom type',itype
DO l=0,lmaxc(itype)
DO i=1,nindxc(l,itype)
DO l=0,hybdat%lmaxc(itype)
DO i=1,hybdat%nindxc(l,itype)
WRITE(6,'(1x,I1,A,2X)',advance='no') i+l,lchar(l)
WRITE(6,'('//chr(2*l+1)//'F10.6)') &
& olapcv_avg(-l:l,i,l,itype)
......@@ -199,8 +191,8 @@
WRITE(6,'(/A)') ' Maximum overlap <core|val> at (band/kpoint)'
DO itype=1,atoms%ntype
IF(atoms%ntype.gt.1) write(6,'(A,I3)') ' Atom type',itype
DO l=0,lmaxc(itype)
DO i=1,nindxc(l,itype)
DO l=0,hybdat%lmaxc(itype)
DO i=1,hybdat%nindxc(l,itype)
WRITE(6,'(1x,I1,A,2X)',advance='no') i+l,lchar(l)
WRITE(6,'('//chr(2*l+1)//&
& '(F10.6,'' ('',I3.3,''/'',I4.3,'')''))')&
......@@ -231,11 +223,11 @@
END SELECT
END IF
DO j=1,i
integrand = bas1(:,i,l,itype)*bas1(:,j,l,itype)&
& + bas2(:,i,l,itype)*bas2(:,j,l,itype)
integrand = hybdat%bas1(:,i,l,itype)*hybdat%bas1(:,j,l,itype)&
& + hybdat%bas2(:,i,l,itype)*hybdat%bas2(:,j,l,itype)
IF ( mpi%irank == 0 ) WRITE(6,'(F10.6)',advance='no')&
& intgrf(integrand,atoms%jri,atoms%jmtd,atoms%rmsh,atoms%dx,atoms%ntype,itype,gridf)
& intgrf(integrand,atoms%jri,atoms%jmtd,atoms%rmsh,atoms%dx,atoms%ntype,itype,hybdat%gridf)
END DO
IF ( mpi%irank == 0 ) WRITE(6,*)
END DO
......@@ -246,9 +238,9 @@
IF ( mpi%irank == 0 ) WRITE(6,'(/A)') &
& 'Mismatch of wave functions at the MT-sphere boundaries'
ALLOCATE (carr1(maxbands,(atoms%lmaxd+1)**2))
ALLOCATE (carr2(maxbands,(atoms%lmaxd+1)**2))
ALLOCATE (carr3(maxbands,(atoms%lmaxd+1)**2))
ALLOCATE (carr1(maxval(hybdat%nbands),(atoms%lmaxd+1)**2))
ALLOCATE (carr2(maxval(hybdat%nbands),(atoms%lmaxd+1)**2))
ALLOCATE (carr3(maxval(hybdat%nbands),(atoms%lmaxd+1)**2))
#ifdef CPP_INVERSION
irecl_z = dimension%nbasfcn*dimension%neigd*8
......@@ -302,7 +294,7 @@
cdum = 4*pi_const*img**l/sqrt(cell%omtil) * sphbes(l) * cexp
DO m = -l,l
lm = lm + 1
DO iband = 1,nbands(ikpt)
DO iband = 1,hybdat%nbands(ikpt)
carr2(iband,lm) = carr2(iband,lm) + cdum * z(igpt,iband,ikpt) * y(lm)
END DO
END DO
......@@ -317,8 +309,8 @@
lm = lm + 1
DO n = 1,hybrid%nindx(l,itype)
lm1 = lm1 + 1
rdum = bas1(atoms%jri(itype),n,l,itype) / atoms%rmt(itype)
DO iband = 1,nbands(ikpt)
rdum = hybdat%bas1(atoms%jri(itype),n,l,itype) / atoms%rmt(itype)
DO iband = 1,hybdat%nbands(ikpt)
carr3(iband,lm) = carr3(iband,lm) + cmt(iband,lm1,iatom,ikpt) * rdum
END DO
END DO
......
......@@ -170,11 +170,10 @@ module m_eigen_hf_setup
& atoms,el_eig,&
& ello_eig,cell,dimension,&
& hybrid,vr0,&
& hybdat%kveclo_eig,&
& hybdat,&
& noco,oneD,mpi,irank2,&
& hybdat%nbands,input,jsp,&
& zmat,&
& hybdat%bas1,hybdat%bas2,hybdat%bas1_MT,hybdat%drbas1_MT)
& input,jsp,&
& zmat)
! generate core wave functions (-> core1/2(jmtd,hybdat%nindxc,0:lmaxc,ntype) )
CALL corewf(atoms,jsp,input,dimension,vr0,&
......@@ -189,13 +188,11 @@ module m_eigen_hf_setup
!
! check olap between core-basis/core-valence/basis-basis
!
CALL checkolap(atoms,hybdat%lmaxc,hybdat%lmaxcd,hybdat%nindxc,hybdat%maxindxc,&
& hybdat%core1,hybdat%core2,hybrid,hybdat%bas1,&
& hybdat%bas2,kpts%nkpt,kpts,&
CALL checkolap(atoms,hybdat,hybrid,&
& kpts%nkpt,kpts,&
& dimension,mpi,irank2,skip_kpt,&
& input,sym,&
& noco,cell,lapw,jsp,&
& maxval(hybdat%nbands),hybdat%nbands)
& noco,cell,lapw,jsp)
!
! set up pointer pntgpt
......
This diff is collapsed.
This diff is collapsed.
......@@ -13,11 +13,10 @@
& nkpti,kpts,it,sym,&
& atoms,el_eig,ello_eig,cell,&
& dimension,hybrid,vr0,&
& kveclo_eig,&
& hybdat,&
& noco,oneD,mpi,irank2,&
& nbands,input,jsp,&
& zmat,&
& bas1,bas2,bas1_MT,drbas1_MT)
& input,jsp,&
& zmat)
! nkpti :: number of irreducible k-points
......@@ -33,16 +32,18 @@
USE m_olap
USE m_types
IMPLICIT NONE
TYPE(t_mpi),INTENT(IN) :: mpi
TYPE(t_hybdat),INTENT(INOUT) :: hybdat
TYPE(t_mpi),INTENT(IN) :: mpi
TYPE(t_dimension),INTENT(IN) :: dimension
TYPE(t_oneD),INTENT(IN) :: oneD
TYPE(t_hybrid),INTENT(IN) :: hybrid
TYPE(t_input),INTENT(IN) :: input
TYPE(t_noco),INTENT(IN) :: noco
TYPE(t_sym),INTENT(IN) :: sym
TYPE(t_cell),INTENT(IN) :: cell
TYPE(t_kpts),INTENT(IN) :: kpts
TYPE(t_atoms),INTENT(IN) :: atoms
TYPE(t_oneD),INTENT(IN) :: oneD
TYPE(t_hybrid),INTENT(IN) :: hybrid
TYPE(t_input),INTENT(IN) :: input
TYPE(t_noco),INTENT(IN) :: noco
TYPE(t_sym),INTENT(IN) :: sym
TYPE(t_cell),INTENT(IN) :: cell
TYPE(t_kpts),INTENT(IN) :: kpts
TYPE(t_atoms),INTENT(IN) :: atoms
! - - scalars - -
INTEGER,INTENT(IN) :: nkpti ,it
......@@ -55,25 +56,15 @@
! - - arrays - -
INTEGER,INTENT(IN) :: irank2(nkpti)
! arrays for abcoff
INTEGER,INTENT(IN) :: kveclo_eig(atoms%nlotot,nkpti)
! arrays for apws
INTEGER,INTENT(IN) :: nbands(nkpti)
REAL,INTENT(IN) :: vr0(:,:,:)!(jmtd,ntype,jspd)
REAL,INTENT(IN) :: el_eig(0:atoms%lmaxd,atoms%ntype)
REAL,INTENT(IN) :: ello_eig(atoms%nlod,atoms%ntype)
REAL,INTENT(INOUT) :: bas1(atoms%jmtd,hybrid%maxindx,0:atoms%lmaxd,atoms%ntype),&
& bas2(atoms%jmtd,hybrid%maxindx,0:atoms%lmaxd,atoms%ntype)
REAL,INTENT(INOUT) :: bas1_MT(hybrid%maxindx,0:atoms%lmaxd,atoms%ntype),&
& drbas1_MT(hybrid%maxindx,0:atoms%lmaxd,atoms%ntype)
TYPE(t_zmat),INTENT(IN) :: zmat(:) !for all kpoints
! - - local scalars - -
INTEGER :: ilo,idum,maxlmindx,m
INTEGER :: ilo,idum ,m,maxlmindx
REAL :: rdum,merror
COMPLEX :: cdum,cdum1,cdum2
......@@ -212,15 +203,15 @@
usdus%us(l,itype,1),usdus%dus(l,itype,1),nodem,usdus%uds(l,itype,1),&
usdus%duds(l,itype,1),noded,usdus%ddn(l,itype,1),wronk
bas1(1:ng,1,l,itype) = f(1:ng,1,l)
bas2(1:ng,1,l,itype) = f(1:ng,2,l)
bas1(1:ng,2,l,itype) = df(1:ng,1,l)
bas2(1:ng,2,l,itype) = df(1:ng,2,l)
hybdat%bas1(1:ng,1,l,itype) = f(1:ng,1,l)
hybdat%bas2(1:ng,1,l,itype) = f(1:ng,2,l)
hybdat%bas1(1:ng,2,l,itype) = df(1:ng,1,l)
hybdat%bas2(1:ng,2,l,itype) = df(1:ng,2,l)
bas1_MT(1,l,itype) = usdus%us(l,itype,1)
drbas1_MT(1,l,itype) = usdus%dus(l,itype,1)
bas1_MT(2,l,itype) = usdus%uds(l,itype,1)
drbas1_MT(2,l,itype) = usdus%duds(l,itype,1)
hybdat%bas1_MT(1,l,itype) = usdus%us(l,itype,1)
hybdat%drbas1_MT(1,l,itype) = usdus%dus(l,itype,1)
hybdat%bas1_MT(2,l,itype) = usdus%uds(l,itype,1)
hybdat%drbas1_MT(2,l,itype) = usdus%duds(l,itype,1)
END DO
IF (atoms%nlo(itype).GE.1) THEN
......@@ -232,14 +223,14 @@
DO ilo=1,atoms%nlo(itype)
iarr(atoms%llo(ilo,itype),itype) = iarr(atoms%llo(ilo,itype),itype) + 1
bas1(1:ng,iarr(atoms%llo(ilo,itype),itype),atoms%llo(ilo,itype),itype)&
hybdat%bas1(1:ng,iarr(atoms%llo(ilo,itype),itype),atoms%llo(ilo,itype),itype)&
& = flo(1:ng,1,ilo)
bas2(1:ng,iarr(atoms%llo(ilo,itype),itype),atoms%llo(ilo,itype),itype)&
hybdat%bas2(1:ng,iarr(atoms%llo(ilo,itype),itype),atoms%llo(ilo,itype),itype)&
& = flo(1:ng,2,ilo)
bas1_MT(iarr(atoms%llo(ilo,itype),itype),atoms%llo(ilo,itype),itype)&
hybdat%bas1_MT(iarr(atoms%llo(ilo,itype),itype),atoms%llo(ilo,itype),itype)&
& = usdus%ulos(ilo,itype,1)
drbas1_MT(iarr(atoms%llo(ilo,itype),itype),atoms%llo(ilo,itype),itype)&
hybdat%drbas1_MT(iarr(atoms%llo(ilo,itype),itype),atoms%llo(ilo,itype),itype)&
& = usdus%dulos(ilo,itype,1)
END DO
......@@ -298,9 +289,9 @@
IF( ok .ne. 0 ) STOP 'gen_wavf: failure allocation bcof'
ALLOCATE( ccof(-atoms%llod:atoms%llod,dimension%neigd,atoms%nlod,atoms%nat),stat=ok )
IF( ok .ne. 0 ) STOP 'gen_wavf: failure allocation ccof'
ALLOCATE ( cmt(dimension%neigd,hybrid%maxlmindx,atoms%nat), stat=ok)
ALLOCATE ( cmt(dimension%neigd,maxlmindx,atoms%nat), stat=ok)
IF( ok .ne. 0 ) STOP 'gen_wavf: Failure allocation cmt'
ALLOCATE ( cmthlp(dimension%neigd,hybrid%maxlmindx,atoms%nat), stat=ok)
ALLOCATE ( cmthlp(dimension%neigd,maxlmindx,atoms%nat), stat=ok)
IF( ok .ne. 0) STOP 'gen_wavf: failure allocation cmthlp'
if (zmat(1)%l_real) THEN
ALLOCATE ( zhlp_r(dimension%nbasfcn,dimension%neigd), stat=ok)
......@@ -309,7 +300,7 @@
ENDIF
IF( ok .ne. 0) STOP 'gen_wavf: failure allocation zhlp'
irecl_cmt = dimension%neigd*hybrid%maxlmindx*atoms%nat*16
irecl_cmt = dimension%neigd*maxlmindx*atoms%nat*16
OPEN(unit=777,file='cmt',form='unformatted',access='direct',&
& recl=irecl_cmt)
......@@ -328,9 +319,9 @@
! abcof calculates the wavefunction coefficients
! stored in acof,bcof,ccof
CALL abcof(&
input,atoms,nbands(ikpt0),sym, cell, Kpts%bk(:,ikpt0), lapw, &
ngpt(jsp,ikpt0)+nbands(ikpt0),usdus,noco,jsp,kveclo_eig(:,ikpt0),&
oneD,acof(:nbands(ikpt0),:,:),bcof(:nbands(ikpt0),:,:),ccof(:,:nbands(ikpt0),:,:),&
input,atoms,hybdat%nbands(ikpt0),sym, cell, Kpts%bk(:,ikpt0), lapw, &
ngpt(jsp,ikpt0)+hybdat%nbands(ikpt0),usdus,noco,jsp,hybdat%kveclo_eig(:,ikpt0),&
oneD,acof(: hybdat%nbands(ikpt0),:,:),bcof(: hybdat%nbands(ikpt0),:,:),ccof(:,: hybdat%nbands(ikpt0),:,:),&
zmat(ikpt))
......@@ -348,11 +339,11 @@
! rotate them in the global one
CALL abcrot(&
atoms,nbands(ikpt0),dimension,&
nbands(ikpt0),sym,&
atoms,hybdat%nbands(ikpt0),dimension,&
hybdat%nbands(ikpt0),sym,&
cell,oneD,&
acof(:nbands(ikpt0),:,:),bcof(:nbands(ikpt0),:,:),&
ccof(:,:nbands(ikpt0),:,:) )
acof(: hybdat%nbands(ikpt0),:,:),bcof(: hybdat%nbands(ikpt0),:,:),&
ccof(:,: hybdat%nbands(ikpt0),:,:) )
! CALL cpu_time(time3)
......@@ -437,7 +428,7 @@
CALL waveftrafo_genwavf( cmthlp,zhlp_r,zhlp_c,&
& cmt(:,:,:),zmat(1)%l_real,zmat(ikpt0)%z_r(:,:),zmat(ikpt0)%z_c(:,:),ikpt0,iop,atoms,&
& hybrid,kpts,sym,&
& jsp,dimension,nbands(ikpt0),&
& jsp,dimension,hybdat%nbands(ikpt0),&
& cell,gpt(:,:ngpt(jsp,ikpt0),jsp,ikpt0),&
& ngpt(:,ikpt0),gpt(:,:ngpt(jsp,ikpt),jsp,ikpt),&
& ngpt(:,ikpt),.true.)
......
This diff is collapsed.
This diff is collapsed.
......@@ -6,22 +6,15 @@
CONTAINS
SUBROUTINE read_core( atoms, lmaxc,nindxc,maxindxc,core1,core2)
SUBROUTINE read_core( atoms, hybdat )
USE m_types
IMPLICIT NONE
TYPE(t_atoms),INTENT(IN) :: atoms
! - scalars -
INTEGER,INTENT(INOUT) :: maxindxc
! -arrays -
INTEGER,INTENT(INOUT) :: lmaxc(:)
INTEGER,ALLOCATABLE,INTENT(INOUT) :: nindxc(:,:)
TYPE(t_hybdat),INTENT(INOUT) :: hybdat
TYPE(t_atoms),INTENT(IN) :: atoms
REAL,ALLOCATABLE,INTENT(INOUT) :: core1(:,:,:,:),&
& core2(:,:,:,:)
! - local scalars -
INTEGER :: ncst
......@@ -49,7 +42,7 @@
IF( ok .ne. 0 ) STOP 'mhsfock: failure allocation nindxcr'
nindxcr = 0
lmaxc = 0
hybdat%lmaxc = 0
l_qn = 0
ncst = 0
DO itype=1,atoms%ntype
......@@ -59,13 +52,13 @@
READ(77) n_qn(i,itype),l_qn(i,itype),j_qn(i,itype)
nindxcr(l_qn(i,itype),itype) = nindxcr(l_qn(i,itype),itype)+1
END DO
lmaxc(itype) = maxval(l_qn(:,itype))
hybdat%lmaxc(itype) = maxval(l_qn(:,itype))
END DO
ALLOCATE( core1r(atoms%jmtd,0:maxval(lmaxc),maxval(nindxcr),atoms%ntype) )
ALLOCATE( core2r(atoms%jmtd,0:maxval(lmaxc),maxval(nindxcr),atoms%ntype) )
ALLOCATE( core1r(atoms%jmtd,0:maxval(hybdat%lmaxc),maxval(nindxcr),atoms%ntype) )
ALLOCATE( core2r(atoms%jmtd,0:maxval(hybdat%lmaxc),maxval(nindxcr),atoms%ntype) )
core1r = 0
core2r = 0
REWIND(77)
......@@ -87,60 +80,60 @@
ALLOCATE( nindxc(0:maxval(lmaxc),atoms%ntype),stat=ok )
ALLOCATE( hybdat%nindxc(0:maxval(hybdat%lmaxc),atoms%ntype),stat=ok )
IF( ok .ne. 0 ) STOP 'mhsfock: failure allocation nindxc'
ALLOCATE( core1(atoms%jmtd,0:maxval(lmaxc),maxval(nindxcr(0,:),&
ALLOCATE( hybdat%core1(atoms%jmtd,0:maxval(hybdat%lmaxc),maxval(nindxcr(0,:),&
& nint((maxval(nindxcr)/2.0))),atoms%ntype),stat=ok )
IF( ok .ne. 0 ) STOP 'mhsfock: failure allocation core1'
ALLOCATE( core2(atoms%jmtd,0:maxval(lmaxc),maxval(nindxcr(0,:),&
ALLOCATE( hybdat%core2(atoms%jmtd,0:maxval(hybdat%lmaxc),maxval(nindxcr(0,:),&
& nint((maxval(nindxcr)/2.0))),atoms%ntype),stat=ok )
IF( ok .ne. 0 ) STOP 'mhsfock: failure allocation core2'
nindxc = 0 ; core1 = 0 ; core2 = 0
hybdat%nindxc = 0 ; hybdat%core1 = 0 ; hybdat%core2 = 0
! average over core states that only differ in j
! core functions with l-qn equal 0 doesnot change during averaging
nindxc(0,:) = nindxcr(0,:)
hybdat%nindxc(0,:) = nindxcr(0,:)
DO itype=1,atoms%ntype
core1(:,0,:nindxc(0,itype),itype)&
& = core1r(:,0,:nindxc(0,itype),itype)
core2(:,0,:nindxc(0,itype),itype)&
& = core2r(:,0,:nindxc(0,itype),itype)
hybdat%core1(:,0,:hybdat%nindxc(0,itype),itype)&
& = core1r(:,0,:hybdat%nindxc(0,itype),itype)
hybdat%core2(:,0,:hybdat%nindxc(0,itype),itype)&
& = core2r(:,0,:hybdat%nindxc(0,itype),itype)
END DO
DO itype=1,atoms%ntype
DO l=1,lmaxc(itype)
DO l=1,hybdat%lmaxc(itype)
weight1 = 2*(l-0.5) + 1
weight2 = 2*(l+0.5) + 1
IF( modulo(nindxcr(l,itype),2) .eq. 0 ) THEN
DO i=1,nindxcr(l,itype),2
nindxc(l,itype) = nindxc(l,itype) + 1
core1(:atoms%jri(itype),l,nindxc(l,itype),itype) =&
hybdat%nindxc(l,itype) = hybdat%nindxc(l,itype) + 1
hybdat%core1(:atoms%jri(itype),l,hybdat%nindxc(l,itype),itype) =&
& (weight1*core1r(:atoms%jri(itype),l,i ,itype) +&
& weight2*core1r(:atoms%jri(itype),l,i+1,itype))&
& / (weight1+weight2)
core2(:atoms%jri(itype),l,nindxc(l,itype),itype) =&
hybdat%core2(:atoms%jri(itype),l,hybdat%nindxc(l,itype),itype) =&
& (weight1*core2r(:atoms%jri(itype),l,i ,itype) +&
& weight2*core2r(:atoms%jri(itype),l,i+1,itype))&
& / (weight1+weight2)
END DO
ELSE
DO i=1,nindxcr(l,itype)-1,2
nindxc(l,itype) = nindxc(l,itype) + 1
core1(:atoms%jri(itype),l,nindxc(l,itype),itype) =&
hybdat%nindxc(l,itype) = hybdat%nindxc(l,itype) + 1
hybdat%core1(:atoms%jri(itype),l,hybdat%nindxc(l,itype),itype) =&
& (weight1*core1r(:atoms%jri(itype),l,i ,itype) +&
& weight2*core1r(:atoms%jri(itype),l,i+1,itype))&
& / (weight1+weight2)
core2(:atoms%jri(itype),l,nindxc(l,itype),itype) =&
hybdat%core2(:atoms%jri(itype),l,hybdat%nindxc(l,itype),itype) =&
& (weight1*core2r(:atoms%jri(itype),l,i ,itype) +&
& weight2*core2r(:atoms%jri(itype),l,i+1,itype))&
& / (weight1+weight2)
END DO
nindxc(l,itype) = nindxc(l,itype) + 1
core1(:atoms%jri(itype),l,nindxc(l,itype),itype)&
hybdat%nindxc(l,itype) = hybdat%nindxc(l,itype) + 1
hybdat%core1(:atoms%jri(itype),l,hybdat%nindxc(l,itype),itype)&
& = core1r(:atoms%jri(itype),l,nindxcr(l,itype),itype)
core2(:atoms%jri(itype),l,nindxc(l,itype),itype)&
hybdat%core2(:atoms%jri(itype),l,hybdat%nindxc(l,itype),itype)&
& = core2r(:atoms%jri(itype),l,nindxcr(l,itype),itype)
END IF
......@@ -149,7 +142,7 @@
DEALLOCATE( nindxcr, core1r,core2r )
maxindxc = maxval(nindxc)
hybdat%maxindxc = maxval(hybdat%nindxc)
CLOSE(77)
END SUBROUTINE read_core
......@@ -477,8 +470,7 @@
END SUBROUTINE calcorewf
SUBROUTINE core_init( dimension,input,atoms,&
& lmaxcd,maxindxc)
SUBROUTINE core_init( dimension,input,atoms, lmaxcd,maxindxc)
USE m_intgr, ONLY : intgr3,intgr0,intgr1
......@@ -487,13 +479,13 @@
USE m_differ
USE m_types
IMPLICIT NONE
TYPE(t_dimension),INTENT(IN) :: dimension
TYPE(t_input),INTENT(IN) :: input
TYPE(t_atoms),INTENT(IN) :: atoms
! - scalars -
INTEGER, INTENT (OUT):: lmaxcd,maxindxc
TYPE(t_dimension),INTENT(IN) :: dimension
TYPE(t_input),INTENT(IN) :: input
TYPE(t_atoms),INTENT(IN) :: atoms
INTEGER,INTENT(OUT) :: maxindxc,lmaxcd
! - local scalars -
INTEGER :: i,j,itype,korb,ncmsh,nst,ierr
REAL :: e,fj,fl,fn,t,bmu,c
......@@ -501,9 +493,9 @@
! - local arrays -
INTEGER :: kappa(dimension%nstd),nprnc(dimension%nstd)
INTEGER :: nindxcr(0:dimension%nstd,atoms%ntype),lmaxc(atoms%ntype)
INTEGER :: nindxcr(0:dimension%nstd,atoms%ntype)
REAL :: occ(dimension%nstd),occ_h(dimension%nstd,2),a(dimension%msh),b(dimension%msh)
INTEGER :: lmaxc(atoms%ntype)
! - intrinsic functions -
......@@ -519,8 +511,7 @@
z = atoms%zatom(itype)
dxx = atoms%dx(itype)
bmu = 0.0
CALL setcor(itype,input%jspins,atoms,input,bmu,&
& nst,kappa,nprnc,occ_h)
CALL setcor(itype,input%jspins,atoms,input,bmu, nst,kappa,nprnc,occ_h)
occ(1:nst) = occ_h(1:nst,1)
......@@ -532,8 +523,8 @@
nst = atoms%ncst(itype)
DO 80 korb = 1,nst
IF (occ(korb).EQ.0) GOTO 80
DO korb = 1,nst
IF (occ(korb).EQ.0) CYCLE
fn = nprnc(korb)
fj = iabs(kappa(korb)) - .5e0
......@@ -542,7 +533,7 @@
nindxcr(NINT(fl),itype) = nindxcr(NINT(fl),itype) + 1
lmaxc(itype) = max(lmaxc(itype),NINT(fl))
80 END DO
END DO
END DO
......
This diff is collapsed.
......@@ -16,11 +16,10 @@
CONTAINS
SUBROUTINE symm_hf(kpts,nkpti,nk,sym,&
& dimension,ne_eig,eig_irr,nbands,&
& atoms,hybrid,bas1,bas2,cell,&
& dimension,hybdat,eig_irr,&
& atoms,hybrid,cell,&
& lapw,jsp,&
& gpt,&
& lmaxcd,&
& mpi,irank2,&
& nsymop,psym,nkpt_EIBZ,n_q,parent,&
& symop,degenerat,pointer_EIBZ,maxndb,nddb,&
......@@ -34,6 +33,8 @@
USE m_types
IMPLICIT NONE
TYPE(t_hybdat),INTENT(IN) :: hybdat
TYPE(t_mpi),INTENT(IN) :: mpi